From 0795afa33b3f029ea17d44811a9042ee6c5a113f Mon Sep 17 00:00:00 2001 From: morsch Date: Mon, 10 Dec 2001 10:55:20 +0000 Subject: [PATCH] First commit. --- ISAJET/Makefile | 65 + ISAJET/code/alqcd.F | 31 + ISAJET/code/amass.F | 136 ++ ISAJET/code/amgmw.F | 36 + ISAJET/code/charge.F | 30 + ISAJET/code/ctxc2i.F | 17 + ISAJET/code/ctxi2c.F | 17 + ISAJET/code/ctxin.F | 201 ++ ISAJET/code/ctxout.F | 207 ++ ISAJET/code/datime.F | 14 + ISAJET/code/dblpcm.F | 19 + ISAJET/code/dblvec.F | 28 + ISAJET/code/dboost.F | 32 + ISAJET/code/decay.F | 293 +++ ISAJET/code/decjet.F | 380 ++++ ISAJET/code/decps1.F | 75 + ISAJET/code/decps2.F | 76 + ISAJET/code/decss3.F | 163 ++ ISAJET/code/dectau.F | 190 ++ ISAJET/code/decva.F | 44 + ISAJET/code/dhelas.F | 3748 ++++++++++++++++++++++++++++++++ ISAJET/code/dincgm.F | 31 + ISAJET/code/domssm.F | 296 +++ ISAJET/code/drllyn.F | 421 ++++ ISAJET/code/ebeam.F | 65 + ISAJET/code/eebeg.F | 16 + ISAJET/code/eemax.F | 91 + ISAJET/code/elctrn.F | 169 ++ ISAJET/code/epf.F | 16 + ISAJET/code/estruc.F | 40 + ISAJET/code/evol01.F | 60 + ISAJET/code/evol02.F | 56 + ISAJET/code/evol03.F | 125 ++ ISAJET/code/evol05.F | 59 + ISAJET/code/evol06.F | 96 + ISAJET/code/evol07.F | 142 ++ ISAJET/code/evol11.F | 74 + ISAJET/code/evolms.F | 33 + ISAJET/code/evolve.F | 102 + ISAJET/code/fbrbm.F | 16 + ISAJET/code/flavor.F | 204 ++ ISAJET/code/fortop.F | 21 + ISAJET/code/frgjet.F | 147 ++ ISAJET/code/frgmnt.F | 344 +++ ISAJET/code/gamma.F | 33 + ISAJET/code/getpt.F | 13 + ISAJET/code/gettot.F | 140 ++ ISAJET/code/heavyx.F | 46 + ISAJET/code/hevolv.F | 265 +++ ISAJET/code/higgs.F | 39 + ISAJET/code/idanti.F | 60 + ISAJET/code/idgen.F | 60 + ISAJET/code/iframs.F | 61 + ISAJET/code/inisap.F | 121 ++ ISAJET/code/ipartns.F | 206 ++ ISAJET/code/ipjset.F | 29 + ISAJET/code/iprtns.F | 54 + ISAJET/code/irmov0.F | 42 + ISAJET/code/isabeg.F | 210 ++ ISAJET/code/isabg2.F | 209 ++ ISAJET/code/isaend.F | 14 + ISAJET/code/isaevt.F | 312 +++ ISAJET/code/isaini.F | 40 + ISAJET/code/isajet.F | 78 + ISAJET/code/isasrt.F | 44 + ISAJET/code/ispjet.F | 175 ++ ISAJET/code/istrad.F | 41 + ISAJET/code/iswdky.F | 181 ++ ISAJET/code/jetgen.F | 189 ++ ISAJET/code/kkgf1.F | 13 + ISAJET/code/kkgf2.F | 12 + ISAJET/code/kkgf3.F | 12 + ISAJET/code/label.F | 254 +++ ISAJET/code/lboost.F | 19 + ISAJET/code/logerr.F | 90 + ISAJET/code/logic.F | 278 +++ ISAJET/code/logmgm.F | 34 + ISAJET/code/logmgy.F | 48 + ISAJET/code/logmij.F | 56 + ISAJET/code/logp.F | 32 + ISAJET/code/logphi.F | 62 + ISAJET/code/logphw.F | 52 + ISAJET/code/logpt.F | 42 + ISAJET/code/logqm.F | 46 + ISAJET/code/logqt.F | 55 + ISAJET/code/logthw.F | 61 + ISAJET/code/logx.F | 92 + ISAJET/code/logxw.F | 43 + ISAJET/code/logyth.F | 100 + ISAJET/code/logyw.F | 52 + ISAJET/code/lstsq.F | 21 + ISAJET/code/mbias.F | 375 ++++ ISAJET/code/mbset.F | 76 + ISAJET/code/mginit.F | 64 + ISAJET/code/muljet.F | 192 ++ ISAJET/code/nogood.F | 153 ++ ISAJET/code/ordecr.F | 34 + ISAJET/code/order.F | 98 + ISAJET/code/prtevt.F | 172 ++ ISAJET/code/prtlim.F | 359 +++ ISAJET/code/ptfun.F | 181 ++ ISAJET/code/qcdini.F | 398 ++++ ISAJET/code/qcdint.F | 184 ++ ISAJET/code/qcdinz.F | 114 + ISAJET/code/qcdjet.F | 291 +++ ISAJET/code/qcdt.F | 136 ++ ISAJET/code/qcdz.F | 246 +++ ISAJET/code/qfunc.F | 364 ++++ ISAJET/code/ranfgt.F | 24 + ISAJET/code/ranfmt.F | 22 + ISAJET/code/ranfst.F | 24 + ISAJET/code/readin.F | 1097 ++++++++++ ISAJET/code/rejfrg.F | 39 + ISAJET/code/rejjet.F | 29 + ISAJET/code/rescal.F | 62 + ISAJET/code/reset.F | 216 ++ ISAJET/code/setcon.F | 12 + ISAJET/code/setdky.F | 305 +++ ISAJET/code/seth.F | 205 ++ ISAJET/code/sethss.F | 102 + ISAJET/code/setkkg.F | 20 + ISAJET/code/setnxt.F | 33 + ISAJET/code/settyp.F | 496 +++++ ISAJET/code/setw.F | 233 ++ ISAJET/code/sigdy.F | 347 +++ ISAJET/code/sigdy2.F | 332 +++ ISAJET/code/sigee.F | 200 ++ ISAJET/code/sigfil.F | 18 + ISAJET/code/siggam.F | 113 + ISAJET/code/sigh.F | 366 ++++ ISAJET/code/sigh2.F | 104 + ISAJET/code/sigh3.F | 270 +++ ISAJET/code/sighss.F | 139 ++ ISAJET/code/sigint.F | 108 + ISAJET/code/sigkkg.F | 171 ++ ISAJET/code/sigqcd.F | 300 +++ ISAJET/code/sigsse.F | 908 ++++++++ ISAJET/code/sigssl.F | 630 ++++++ ISAJET/code/sigssy.F | 359 +++ ISAJET/code/sigssz.F | 802 +++++++ ISAJET/code/sigtc.F | 214 ++ ISAJET/code/sigtc2.F | 31 + ISAJET/code/sigtc3.F | 178 ++ ISAJET/code/sigwh.F | 200 ++ ISAJET/code/sigwhs.F | 304 +++ ISAJET/code/sigww.F | 343 +++ ISAJET/code/sigww2.F | 432 ++++ ISAJET/code/smszg.F | 36 + ISAJET/code/spline.F | 65 + ISAJET/code/ssfel.F | 101 + ISAJET/code/ssgst.F | 34 + ISAJET/code/ssgt.F | 36 + ISAJET/code/struc.F | 591 +++++ ISAJET/code/strucw.F | 230 ++ ISAJET/code/szjj1.F | 97 + ISAJET/code/szjj2.F | 97 + ISAJET/code/szjj3.F | 97 + ISAJET/code/szjj4.F | 98 + ISAJET/code/szjj5.F | 98 + ISAJET/code/szjj6.F | 95 + ISAJET/code/szjj7.F | 97 + ISAJET/code/timer.F | 56 + ISAJET/code/twojet.F | 369 ++++ ISAJET/code/twokin.F | 65 + ISAJET/code/visaje.F | 7 + ISAJET/code/whiggs.F | 231 ++ ISAJET/code/wpair.F | 261 +++ ISAJET/code/wwkin.F | 43 + ISAJET/code/wwss.F | 55 + ISAJET/code/wwst.F | 64 + ISAJET/code/wwtt.F | 20 + ISAJET/code/wzss.F | 78 + ISAJET/code/wzst.F | 94 + ISAJET/code/wzsu.F | 101 + ISAJET/code/wztu.F | 121 ++ ISAJET/code/xwwww.F | 196 ++ ISAJET/code/xwwzz.F | 198 ++ ISAJET/code/xzzww.F | 194 ++ ISAJET/code/xzzzz.F | 158 ++ ISAJET/code/ygenj.F | 26 + ISAJET/code/zjj.F | 420 ++++ ISAJET/code/zjj0.F | 577 +++++ ISAJET/code/zjj1.F | 85 + ISAJET/code/zjj2.F | 104 + ISAJET/code/zjj3.F | 104 + ISAJET/code/zjj4.F | 107 + ISAJET/code/zjj5.F | 94 + ISAJET/code/zjj6.F | 106 + ISAJET/code/zjj7.F | 104 + ISAJET/code/zzall.F | 97 + ISAJET/code/zzstar.F | 49 + ISAJET/data/decay.cpp | 1459 +++++++++++++ ISAJET/doc/changes.doc | 423 ++++ ISAJET/doc/decay.doc | 50 + ISAJET/doc/higher.doc | 189 ++ ISAJET/doc/ident.doc | 447 ++++ ISAJET/doc/input.doc | 777 +++++++ ISAJET/doc/intro.doc | 115 + ISAJET/doc/isassdoc.doc | 245 +++ ISAJET/doc/main.doc | 300 +++ ISAJET/doc/output.doc | 328 +++ ISAJET/doc/patchy.doc | 275 +++ ISAJET/doc/physics.doc | 788 +++++++ ISAJET/doc/sample.doc | 338 +++ ISAJET/doc/susy.doc | 306 +++ ISAJET/doc/tape.doc | 62 + ISAJET/doc/ztext.doc | 706 ++++++ ISAJET/isadata/aldata.F | 250 +++ ISAJET/isajet/brembm.inc | 11 + ISAJET/isajet/calor.inc | 22 + ISAJET/isajet/const.inc | 11 + ISAJET/isajet/dkyss3.inc | 38 + ISAJET/isajet/dkytab.inc | 21 + ISAJET/isajet/dylim.inc | 16 + ISAJET/isajet/dypar.inc | 12 + ISAJET/isajet/eepar.inc | 13 + ISAJET/isajet/final.inc | 12 + ISAJET/isajet/force.inc | 14 + ISAJET/isajet/frame.inc | 12 + ISAJET/isajet/frgpar.inc | 16 + ISAJET/isajet/getjet.inc | 18 + ISAJET/isajet/hcon.inc | 22 + ISAJET/isajet/hcon1.inc | 11 + ISAJET/isajet/hcon2.inc | 11 + ISAJET/isajet/hepevt.inc | 32 + ISAJET/isajet/idrun.inc | 11 + ISAJET/isajet/isabnk.inc | 23 + ISAJET/isajet/isalnk.inc | 17 + ISAJET/isajet/isapw.inc | 12 + ISAJET/isajet/isaunt.inc | 13 + ISAJET/isajet/isloop.inc | 11 + ISAJET/isajet/ita.inc | 11 + ISAJET/isajet/itapes.inc | 11 + ISAJET/isajet/izisab.inc | 10 + ISAJET/isajet/izisac.inc | 10 + ISAJET/isajet/izisae.inc | 10 + ISAJET/isajet/izisaf.inc | 10 + ISAJET/isajet/izisaj.inc | 10 + ISAJET/isajet/izisal.inc | 10 + ISAJET/isajet/izisam.inc | 10 + ISAJET/isajet/izisaq.inc | 10 + ISAJET/isajet/iziscl.inc | 10 + ISAJET/isajet/iziscm.inc | 14 + ISAJET/isajet/izisjt.inc | 14 + ISAJET/isajet/izismr.inc | 14 + ISAJET/isajet/izisp1.inc | 10 + ISAJET/isajet/izisp2.inc | 10 + ISAJET/isajet/izisp3.inc | 10 + ISAJET/isajet/izisrc.inc | 17 + ISAJET/isajet/izisv1.inc | 10 + ISAJET/isajet/izisv2.inc | 10 + ISAJET/isajet/izpjet.inc | 14 + ISAJET/isajet/izpjhd.inc | 14 + ISAJET/isajet/izpjpt.inc | 14 + ISAJET/isajet/jetlim.inc | 29 + ISAJET/isajet/jetpar.inc | 18 + ISAJET/isajet/jetset.inc | 19 + ISAJET/isajet/jetsig.inc | 18 + ISAJET/isajet/jwork.inc | 15 + ISAJET/isajet/jwork2.inc | 14 + ISAJET/isajet/keys.inc | 20 + ISAJET/isajet/kkgrav.inc | 14 + ISAJET/isajet/l2cal.inc | 11 + ISAJET/isajet/l2dky.inc | 11 + ISAJET/isajet/l2getj.inc | 11 + ISAJET/isajet/l2jset.inc | 11 + ISAJET/isajet/l2part.inc | 11 + ISAJET/isajet/l2sigs.inc | 11 + ISAJET/isajet/l2zevl.inc | 11 + ISAJET/isajet/l2zout.inc | 11 + ISAJET/isajet/limevl.inc | 12 + ISAJET/isajet/listss.inc | 32 + ISAJET/isajet/lkpjet.inc | 41 + ISAJET/isajet/lstprt.inc | 11 + ISAJET/isajet/mbgen.inc | 15 + ISAJET/isajet/mbpar.inc | 12 + ISAJET/isajet/mgcoms.inc | 37 + ISAJET/isajet/mgkin.inc | 13 + ISAJET/isajet/mglims.inc | 14 + ISAJET/isajet/mgsigs.inc | 22 + ISAJET/isajet/myhist.inc | 11 + ISAJET/isajet/nodcay.inc | 11 + ISAJET/isajet/partcl.inc | 19 + ISAJET/isajet/pi.inc | 17 + ISAJET/isajet/pinits.inc | 12 + ISAJET/isajet/pjets.inc | 15 + ISAJET/isajet/primar.inc | 12 + ISAJET/isajet/prtout.inc | 11 + ISAJET/isajet/ptpar.inc | 11 + ISAJET/isajet/q1q2.inc | 14 + ISAJET/isajet/qcdpar.inc | 12 + ISAJET/isajet/qlmass.inc | 12 + ISAJET/isajet/qsave.inc | 11 + ISAJET/isajet/quest.inc | 13 + ISAJET/isajet/rectp.inc | 11 + ISAJET/isajet/seed.inc | 11 + ISAJET/isajet/ssinf.inc | 10 + ISAJET/isajet/sslun.inc | 11 + ISAJET/isajet/ssmode.inc | 24 + ISAJET/isajet/sspar.inc | 55 + ISAJET/isajet/sspols.inc | 17 + ISAJET/isajet/sssm.inc | 20 + ISAJET/isajet/sstmp.inc | 13 + ISAJET/isajet/sstype.inc | 33 + ISAJET/isajet/sugmg.inc | 37 + ISAJET/isajet/sugnu.inc | 18 + ISAJET/isajet/sugpas.inc | 16 + ISAJET/isajet/sugxin.inc | 23 + ISAJET/isajet/tcpar.inc | 11 + ISAJET/isajet/times.inc | 11 + ISAJET/isajet/totals.inc | 12 + ISAJET/isajet/types.inc | 16 + ISAJET/isajet/w50510.inc | 14 + ISAJET/isajet/w50517.inc | 14 + ISAJET/isajet/wcon.inc | 25 + ISAJET/isajet/wcon1.inc | 11 + ISAJET/isajet/wcon2.inc | 11 + ISAJET/isajet/wgen.inc | 13 + ISAJET/isajet/wsig.inc | 11 + ISAJET/isajet/wwpar.inc | 21 + ISAJET/isajet/wwpar1.inc | 13 + ISAJET/isajet/wwpar2.inc | 13 + ISAJET/isajet/wwsig.inc | 11 + ISAJET/isajet/xmssm.inc | 29 + ISAJET/isajet/zebcom.inc | 27 + ISAJET/isajet/zevel.inc | 23 + ISAJET/isajet/zlinka.inc | 16 + ISAJET/isajet/zvout.inc | 15 + ISAJET/isarun/dialog.F | 1250 +++++++++++ ISAJET/isarun/isaset.F | 20 + ISAJET/isasusy/ssalfs.F | 28 + ISAJET/isasusy/ssb0.F | 11 + ISAJET/isasusy/ssb1.F | 37 + ISAJET/isasusy/ssdhll.F | 550 +++++ ISAJET/isasusy/ssdint.F | 143 ++ ISAJET/isasusy/ssdlam.F | 19 + ISAJET/isasusy/ssf0.F | 77 + ISAJET/isasusy/ssglbf.F | 1395 ++++++++++++ ISAJET/isasusy/ssgwq1.F | 26 + ISAJET/isasusy/ssgwq2.F | 33 + ISAJET/isasusy/ssgwt1.F | 31 + ISAJET/isasusy/ssgwt2.F | 34 + ISAJET/isasusy/ssgwt3.F | 35 + ISAJET/isasusy/ssgwt4.F | 44 + ISAJET/isasusy/ssgwt5.F | 43 + ISAJET/isasusy/ssgwt6.F | 45 + ISAJET/isasusy/ssgwt7.F | 44 + ISAJET/isasusy/ssgwt8.F | 42 + ISAJET/isasusy/ssgx1.F | 33 + ISAJET/isasusy/ssgx10.F | 46 + ISAJET/isasusy/ssgx11.F | 46 + ISAJET/isasusy/ssgx2.F | 42 + ISAJET/isasusy/ssgx3.F | 32 + ISAJET/isasusy/ssgx4.F | 41 + ISAJET/isasusy/ssgx5.F | 42 + ISAJET/isasusy/ssgx6.F | 41 + ISAJET/isasusy/ssgx7.F | 33 + ISAJET/isasusy/ssgx8.F | 44 + ISAJET/isasusy/ssgx9.F | 42 + ISAJET/isasusy/ssgzg1.F | 27 + ISAJET/isasusy/ssgzg2.F | 27 + ISAJET/isasusy/ssgzg3.F | 27 + ISAJET/isasusy/ssgzt.F | 46 + ISAJET/isasusy/sshcc.F | 147 ++ ISAJET/isasusy/sshff.F | 186 ++ ISAJET/isasusy/sshff1.F | 50 + ISAJET/isasusy/sshgl.F | 330 +++ ISAJET/isasusy/sshgm.F | 549 +++++ ISAJET/isasusy/sshgm1.F | 35 + ISAJET/isasusy/sshhx.F | 198 ++ ISAJET/isasusy/sshibf.F | 58 + ISAJET/isasusy/sshnn.F | 157 ++ ISAJET/isasusy/sshsf.F | 676 ++++++ ISAJET/isasusy/sshww.F | 139 ++ ISAJET/isasusy/sshww1.F | 32 + ISAJET/isasusy/sshww2.F | 33 + ISAJET/isasusy/ssl1st.F | 23 + ISAJET/isasusy/sslpbf.F | 976 +++++++++ ISAJET/isasusy/sslrt1.F | 44 + ISAJET/isasusy/ssmass.F | 245 +++ ISAJET/isasusy/ssme3.F | 59 + ISAJET/isasusy/ssmhc.F | 557 +++++ ISAJET/isasusy/ssmhn.F | 454 ++++ ISAJET/isasusy/ssmqcd.F | 65 + ISAJET/isasusy/ssmssm.F | 173 ++ ISAJET/isasusy/ssn1st.F | 23 + ISAJET/isasusy/ssnorm.F | 24 + ISAJET/isasusy/sspole.F | 35 + ISAJET/isasusy/ssqkbf.F | 412 ++++ ISAJET/isasusy/sssave.F | 51 + ISAJET/isasusy/sssnws.F | 23 + ISAJET/isasusy/ssstbf.F | 335 +++ ISAJET/isasusy/sstest.F | 137 ++ ISAJET/isasusy/sstpbf.F | 163 ++ ISAJET/isasusy/sswibf.F | 1140 ++++++++++ ISAJET/isasusy/sswwf1.F | 31 + ISAJET/isasusy/sswzbf.F | 64 + ISAJET/isasusy/sswzf1.F | 29 + ISAJET/isasusy/sswzf2.F | 26 + ISAJET/isasusy/sswzf3.F | 30 + ISAJET/isasusy/sswzf4.F | 37 + ISAJET/isasusy/sswzf5.F | 31 + ISAJET/isasusy/sswzf6.F | 30 + ISAJET/isasusy/sswzf7.F | 35 + ISAJET/isasusy/ssxint.F | 125 ++ ISAJET/isasusy/ssxlam.F | 19 + ISAJET/isasusy/sszhx.F | 27 + ISAJET/isasusy/sszibf.F | 1893 ++++++++++++++++ ISAJET/isasusy/sszwf1.F | 29 + ISAJET/isasusy/sszzf1.F | 39 + ISAJET/isasusy/sszzf2.F | 32 + ISAJET/isasusy/sszzf3.F | 38 + ISAJET/isasusy/sszzf4.F | 31 + ISAJET/isasusy/sszzf5.F | 36 + ISAJET/isasusy/sualfe.F | 32 + ISAJET/isasusy/sualfs.F | 66 + ISAJET/isasusy/sugeff.F | 113 + ISAJET/isasusy/sugfrz.F | 72 + ISAJET/isasusy/sugmas.F | 240 ++ ISAJET/isasusy/sugra.F | 521 +++++ ISAJET/isasusy/sugrge.F | 282 +++ ISAJET/isasusy/surg06.F | 155 ++ ISAJET/isasusy/surg26.F | 449 ++++ ISAJET/isatape/bufin.F | 57 + ISAJET/isatape/bufout.F | 53 + ISAJET/isatape/edit.F | 8 + ISAJET/isatape/isahep.F | 279 +++ ISAJET/isatape/isawbg.F | 81 + ISAJET/isatape/isawev.F | 13 + ISAJET/isatape/isawnd.F | 31 + ISAJET/isatape/itrans.F | 212 ++ ISAJET/isatape/movlev.F | 38 + ISAJET/isatape/prtlst.F | 67 + ISAJET/isatape/rdbeg.F | 69 + ISAJET/isatape/rdtape.F | 19 + ISAJET/isatape/rend.F | 16 + ISAJET/isatape/rgens.F | 146 ++ ISAJET/isatape/wgens.F | 149 ++ ISAJET/isatape/zerol.F | 12 + ISAJET/openfile/openfile.F | 51 + ISAJET/pdfinit/pdfinit.F | 50 + ISAJET/utils/cern_lib/ddilog.F | 100 + ISAJET/utils/cern_lib/eisrs1.F | 26 + ISAJET/utils/cern_lib/rkstp.F | 66 + ISAJET/utils/cern_lib/sorttf.F | 56 + ISAJET/utils/cern_lib/tql2.F | 102 + ISAJET/utils/cern_lib/tred2.F | 92 + 447 files changed, 58994 insertions(+) create mode 100644 ISAJET/Makefile create mode 100644 ISAJET/code/alqcd.F create mode 100644 ISAJET/code/amass.F create mode 100644 ISAJET/code/amgmw.F create mode 100644 ISAJET/code/charge.F create mode 100644 ISAJET/code/ctxc2i.F create mode 100644 ISAJET/code/ctxi2c.F create mode 100644 ISAJET/code/ctxin.F create mode 100644 ISAJET/code/ctxout.F create mode 100644 ISAJET/code/datime.F create mode 100644 ISAJET/code/dblpcm.F create mode 100644 ISAJET/code/dblvec.F create mode 100644 ISAJET/code/dboost.F create mode 100644 ISAJET/code/decay.F create mode 100644 ISAJET/code/decjet.F create mode 100644 ISAJET/code/decps1.F create mode 100644 ISAJET/code/decps2.F create mode 100644 ISAJET/code/decss3.F create mode 100644 ISAJET/code/dectau.F create mode 100644 ISAJET/code/decva.F create mode 100644 ISAJET/code/dhelas.F create mode 100644 ISAJET/code/dincgm.F create mode 100644 ISAJET/code/domssm.F create mode 100644 ISAJET/code/drllyn.F create mode 100644 ISAJET/code/ebeam.F create mode 100644 ISAJET/code/eebeg.F create mode 100644 ISAJET/code/eemax.F create mode 100644 ISAJET/code/elctrn.F create mode 100644 ISAJET/code/epf.F create mode 100644 ISAJET/code/estruc.F create mode 100644 ISAJET/code/evol01.F create mode 100644 ISAJET/code/evol02.F create mode 100644 ISAJET/code/evol03.F create mode 100644 ISAJET/code/evol05.F create mode 100644 ISAJET/code/evol06.F create mode 100644 ISAJET/code/evol07.F create mode 100644 ISAJET/code/evol11.F create mode 100644 ISAJET/code/evolms.F create mode 100644 ISAJET/code/evolve.F create mode 100644 ISAJET/code/fbrbm.F create mode 100644 ISAJET/code/flavor.F create mode 100644 ISAJET/code/fortop.F create mode 100644 ISAJET/code/frgjet.F create mode 100644 ISAJET/code/frgmnt.F create mode 100644 ISAJET/code/gamma.F create mode 100644 ISAJET/code/getpt.F create mode 100644 ISAJET/code/gettot.F create mode 100644 ISAJET/code/heavyx.F create mode 100644 ISAJET/code/hevolv.F create mode 100644 ISAJET/code/higgs.F create mode 100644 ISAJET/code/idanti.F create mode 100644 ISAJET/code/idgen.F create mode 100644 ISAJET/code/iframs.F create mode 100644 ISAJET/code/inisap.F create mode 100644 ISAJET/code/ipartns.F create mode 100644 ISAJET/code/ipjset.F create mode 100644 ISAJET/code/iprtns.F create mode 100644 ISAJET/code/irmov0.F create mode 100644 ISAJET/code/isabeg.F create mode 100644 ISAJET/code/isabg2.F create mode 100644 ISAJET/code/isaend.F create mode 100644 ISAJET/code/isaevt.F create mode 100644 ISAJET/code/isaini.F create mode 100644 ISAJET/code/isajet.F create mode 100644 ISAJET/code/isasrt.F create mode 100644 ISAJET/code/ispjet.F create mode 100644 ISAJET/code/istrad.F create mode 100644 ISAJET/code/iswdky.F create mode 100644 ISAJET/code/jetgen.F create mode 100644 ISAJET/code/kkgf1.F create mode 100644 ISAJET/code/kkgf2.F create mode 100644 ISAJET/code/kkgf3.F create mode 100644 ISAJET/code/label.F create mode 100644 ISAJET/code/lboost.F create mode 100644 ISAJET/code/logerr.F create mode 100644 ISAJET/code/logic.F create mode 100644 ISAJET/code/logmgm.F create mode 100644 ISAJET/code/logmgy.F create mode 100644 ISAJET/code/logmij.F create mode 100644 ISAJET/code/logp.F create mode 100644 ISAJET/code/logphi.F create mode 100644 ISAJET/code/logphw.F create mode 100644 ISAJET/code/logpt.F create mode 100644 ISAJET/code/logqm.F create mode 100644 ISAJET/code/logqt.F create mode 100644 ISAJET/code/logthw.F create mode 100644 ISAJET/code/logx.F create mode 100644 ISAJET/code/logxw.F create mode 100644 ISAJET/code/logyth.F create mode 100644 ISAJET/code/logyw.F create mode 100644 ISAJET/code/lstsq.F create mode 100644 ISAJET/code/mbias.F create mode 100644 ISAJET/code/mbset.F create mode 100644 ISAJET/code/mginit.F create mode 100644 ISAJET/code/muljet.F create mode 100644 ISAJET/code/nogood.F create mode 100644 ISAJET/code/ordecr.F create mode 100644 ISAJET/code/order.F create mode 100644 ISAJET/code/prtevt.F create mode 100644 ISAJET/code/prtlim.F create mode 100644 ISAJET/code/ptfun.F create mode 100644 ISAJET/code/qcdini.F create mode 100644 ISAJET/code/qcdint.F create mode 100644 ISAJET/code/qcdinz.F create mode 100644 ISAJET/code/qcdjet.F create mode 100644 ISAJET/code/qcdt.F create mode 100644 ISAJET/code/qcdz.F create mode 100644 ISAJET/code/qfunc.F create mode 100644 ISAJET/code/ranfgt.F create mode 100644 ISAJET/code/ranfmt.F create mode 100644 ISAJET/code/ranfst.F create mode 100644 ISAJET/code/readin.F create mode 100644 ISAJET/code/rejfrg.F create mode 100644 ISAJET/code/rejjet.F create mode 100644 ISAJET/code/rescal.F create mode 100644 ISAJET/code/reset.F create mode 100644 ISAJET/code/setcon.F create mode 100644 ISAJET/code/setdky.F create mode 100644 ISAJET/code/seth.F create mode 100644 ISAJET/code/sethss.F create mode 100644 ISAJET/code/setkkg.F create mode 100644 ISAJET/code/setnxt.F create mode 100644 ISAJET/code/settyp.F create mode 100644 ISAJET/code/setw.F create mode 100644 ISAJET/code/sigdy.F create mode 100644 ISAJET/code/sigdy2.F create mode 100644 ISAJET/code/sigee.F create mode 100644 ISAJET/code/sigfil.F create mode 100644 ISAJET/code/siggam.F create mode 100644 ISAJET/code/sigh.F create mode 100644 ISAJET/code/sigh2.F create mode 100644 ISAJET/code/sigh3.F create mode 100644 ISAJET/code/sighss.F create mode 100644 ISAJET/code/sigint.F create mode 100644 ISAJET/code/sigkkg.F create mode 100644 ISAJET/code/sigqcd.F create mode 100644 ISAJET/code/sigsse.F create mode 100644 ISAJET/code/sigssl.F create mode 100644 ISAJET/code/sigssy.F create mode 100644 ISAJET/code/sigssz.F create mode 100644 ISAJET/code/sigtc.F create mode 100644 ISAJET/code/sigtc2.F create mode 100644 ISAJET/code/sigtc3.F create mode 100644 ISAJET/code/sigwh.F create mode 100644 ISAJET/code/sigwhs.F create mode 100644 ISAJET/code/sigww.F create mode 100644 ISAJET/code/sigww2.F create mode 100644 ISAJET/code/smszg.F create mode 100644 ISAJET/code/spline.F create mode 100644 ISAJET/code/ssfel.F create mode 100644 ISAJET/code/ssgst.F create mode 100644 ISAJET/code/ssgt.F create mode 100644 ISAJET/code/struc.F create mode 100644 ISAJET/code/strucw.F create mode 100644 ISAJET/code/szjj1.F create mode 100644 ISAJET/code/szjj2.F create mode 100644 ISAJET/code/szjj3.F create mode 100644 ISAJET/code/szjj4.F create mode 100644 ISAJET/code/szjj5.F create mode 100644 ISAJET/code/szjj6.F create mode 100644 ISAJET/code/szjj7.F create mode 100644 ISAJET/code/timer.F create mode 100644 ISAJET/code/twojet.F create mode 100644 ISAJET/code/twokin.F create mode 100644 ISAJET/code/visaje.F create mode 100644 ISAJET/code/whiggs.F create mode 100644 ISAJET/code/wpair.F create mode 100644 ISAJET/code/wwkin.F create mode 100644 ISAJET/code/wwss.F create mode 100644 ISAJET/code/wwst.F create mode 100644 ISAJET/code/wwtt.F create mode 100644 ISAJET/code/wzss.F create mode 100644 ISAJET/code/wzst.F create mode 100644 ISAJET/code/wzsu.F create mode 100644 ISAJET/code/wztu.F create mode 100644 ISAJET/code/xwwww.F create mode 100644 ISAJET/code/xwwzz.F create mode 100644 ISAJET/code/xzzww.F create mode 100644 ISAJET/code/xzzzz.F create mode 100644 ISAJET/code/ygenj.F create mode 100644 ISAJET/code/zjj.F create mode 100644 ISAJET/code/zjj0.F create mode 100644 ISAJET/code/zjj1.F create mode 100644 ISAJET/code/zjj2.F create mode 100644 ISAJET/code/zjj3.F create mode 100644 ISAJET/code/zjj4.F create mode 100644 ISAJET/code/zjj5.F create mode 100644 ISAJET/code/zjj6.F create mode 100644 ISAJET/code/zjj7.F create mode 100644 ISAJET/code/zzall.F create mode 100644 ISAJET/code/zzstar.F create mode 100644 ISAJET/data/decay.cpp create mode 100644 ISAJET/doc/changes.doc create mode 100644 ISAJET/doc/decay.doc create mode 100644 ISAJET/doc/higher.doc create mode 100644 ISAJET/doc/ident.doc create mode 100644 ISAJET/doc/input.doc create mode 100644 ISAJET/doc/intro.doc create mode 100644 ISAJET/doc/isassdoc.doc create mode 100644 ISAJET/doc/main.doc create mode 100644 ISAJET/doc/output.doc create mode 100644 ISAJET/doc/patchy.doc create mode 100644 ISAJET/doc/physics.doc create mode 100644 ISAJET/doc/sample.doc create mode 100644 ISAJET/doc/susy.doc create mode 100644 ISAJET/doc/tape.doc create mode 100644 ISAJET/doc/ztext.doc create mode 100644 ISAJET/isadata/aldata.F create mode 100644 ISAJET/isajet/brembm.inc create mode 100644 ISAJET/isajet/calor.inc create mode 100644 ISAJET/isajet/const.inc create mode 100644 ISAJET/isajet/dkyss3.inc create mode 100644 ISAJET/isajet/dkytab.inc create mode 100644 ISAJET/isajet/dylim.inc create mode 100644 ISAJET/isajet/dypar.inc create mode 100644 ISAJET/isajet/eepar.inc create mode 100644 ISAJET/isajet/final.inc create mode 100644 ISAJET/isajet/force.inc create mode 100644 ISAJET/isajet/frame.inc create mode 100644 ISAJET/isajet/frgpar.inc create mode 100644 ISAJET/isajet/getjet.inc create mode 100644 ISAJET/isajet/hcon.inc create mode 100644 ISAJET/isajet/hcon1.inc create mode 100644 ISAJET/isajet/hcon2.inc create mode 100644 ISAJET/isajet/hepevt.inc create mode 100644 ISAJET/isajet/idrun.inc create mode 100644 ISAJET/isajet/isabnk.inc create mode 100644 ISAJET/isajet/isalnk.inc create mode 100644 ISAJET/isajet/isapw.inc create mode 100644 ISAJET/isajet/isaunt.inc create mode 100644 ISAJET/isajet/isloop.inc create mode 100644 ISAJET/isajet/ita.inc create mode 100644 ISAJET/isajet/itapes.inc create mode 100644 ISAJET/isajet/izisab.inc create mode 100644 ISAJET/isajet/izisac.inc create mode 100644 ISAJET/isajet/izisae.inc create mode 100644 ISAJET/isajet/izisaf.inc create mode 100644 ISAJET/isajet/izisaj.inc create mode 100644 ISAJET/isajet/izisal.inc create mode 100644 ISAJET/isajet/izisam.inc create mode 100644 ISAJET/isajet/izisaq.inc create mode 100644 ISAJET/isajet/iziscl.inc create mode 100644 ISAJET/isajet/iziscm.inc create mode 100644 ISAJET/isajet/izisjt.inc create mode 100644 ISAJET/isajet/izismr.inc create mode 100644 ISAJET/isajet/izisp1.inc create mode 100644 ISAJET/isajet/izisp2.inc create mode 100644 ISAJET/isajet/izisp3.inc create mode 100644 ISAJET/isajet/izisrc.inc create mode 100644 ISAJET/isajet/izisv1.inc create mode 100644 ISAJET/isajet/izisv2.inc create mode 100644 ISAJET/isajet/izpjet.inc create mode 100644 ISAJET/isajet/izpjhd.inc create mode 100644 ISAJET/isajet/izpjpt.inc create mode 100644 ISAJET/isajet/jetlim.inc create mode 100644 ISAJET/isajet/jetpar.inc create mode 100644 ISAJET/isajet/jetset.inc create mode 100644 ISAJET/isajet/jetsig.inc create mode 100644 ISAJET/isajet/jwork.inc create mode 100644 ISAJET/isajet/jwork2.inc create mode 100644 ISAJET/isajet/keys.inc create mode 100644 ISAJET/isajet/kkgrav.inc create mode 100644 ISAJET/isajet/l2cal.inc create mode 100644 ISAJET/isajet/l2dky.inc create mode 100644 ISAJET/isajet/l2getj.inc create mode 100644 ISAJET/isajet/l2jset.inc create mode 100644 ISAJET/isajet/l2part.inc create mode 100644 ISAJET/isajet/l2sigs.inc create mode 100644 ISAJET/isajet/l2zevl.inc create mode 100644 ISAJET/isajet/l2zout.inc create mode 100644 ISAJET/isajet/limevl.inc create mode 100644 ISAJET/isajet/listss.inc create mode 100644 ISAJET/isajet/lkpjet.inc create mode 100644 ISAJET/isajet/lstprt.inc create mode 100644 ISAJET/isajet/mbgen.inc create mode 100644 ISAJET/isajet/mbpar.inc create mode 100644 ISAJET/isajet/mgcoms.inc create mode 100644 ISAJET/isajet/mgkin.inc create mode 100644 ISAJET/isajet/mglims.inc create mode 100644 ISAJET/isajet/mgsigs.inc create mode 100644 ISAJET/isajet/myhist.inc create mode 100644 ISAJET/isajet/nodcay.inc create mode 100644 ISAJET/isajet/partcl.inc create mode 100644 ISAJET/isajet/pi.inc create mode 100644 ISAJET/isajet/pinits.inc create mode 100644 ISAJET/isajet/pjets.inc create mode 100644 ISAJET/isajet/primar.inc create mode 100644 ISAJET/isajet/prtout.inc create mode 100644 ISAJET/isajet/ptpar.inc create mode 100644 ISAJET/isajet/q1q2.inc create mode 100644 ISAJET/isajet/qcdpar.inc create mode 100644 ISAJET/isajet/qlmass.inc create mode 100644 ISAJET/isajet/qsave.inc create mode 100644 ISAJET/isajet/quest.inc create mode 100644 ISAJET/isajet/rectp.inc create mode 100644 ISAJET/isajet/seed.inc create mode 100644 ISAJET/isajet/ssinf.inc create mode 100644 ISAJET/isajet/sslun.inc create mode 100644 ISAJET/isajet/ssmode.inc create mode 100644 ISAJET/isajet/sspar.inc create mode 100644 ISAJET/isajet/sspols.inc create mode 100644 ISAJET/isajet/sssm.inc create mode 100644 ISAJET/isajet/sstmp.inc create mode 100644 ISAJET/isajet/sstype.inc create mode 100644 ISAJET/isajet/sugmg.inc create mode 100644 ISAJET/isajet/sugnu.inc create mode 100644 ISAJET/isajet/sugpas.inc create mode 100644 ISAJET/isajet/sugxin.inc create mode 100644 ISAJET/isajet/tcpar.inc create mode 100644 ISAJET/isajet/times.inc create mode 100644 ISAJET/isajet/totals.inc create mode 100644 ISAJET/isajet/types.inc create mode 100644 ISAJET/isajet/w50510.inc create mode 100644 ISAJET/isajet/w50517.inc create mode 100644 ISAJET/isajet/wcon.inc create mode 100644 ISAJET/isajet/wcon1.inc create mode 100644 ISAJET/isajet/wcon2.inc create mode 100644 ISAJET/isajet/wgen.inc create mode 100644 ISAJET/isajet/wsig.inc create mode 100644 ISAJET/isajet/wwpar.inc create mode 100644 ISAJET/isajet/wwpar1.inc create mode 100644 ISAJET/isajet/wwpar2.inc create mode 100644 ISAJET/isajet/wwsig.inc create mode 100644 ISAJET/isajet/xmssm.inc create mode 100644 ISAJET/isajet/zebcom.inc create mode 100644 ISAJET/isajet/zevel.inc create mode 100644 ISAJET/isajet/zlinka.inc create mode 100644 ISAJET/isajet/zvout.inc create mode 100644 ISAJET/isarun/dialog.F create mode 100644 ISAJET/isarun/isaset.F create mode 100644 ISAJET/isasusy/ssalfs.F create mode 100644 ISAJET/isasusy/ssb0.F create mode 100644 ISAJET/isasusy/ssb1.F create mode 100644 ISAJET/isasusy/ssdhll.F create mode 100644 ISAJET/isasusy/ssdint.F create mode 100644 ISAJET/isasusy/ssdlam.F create mode 100644 ISAJET/isasusy/ssf0.F create mode 100644 ISAJET/isasusy/ssglbf.F create mode 100644 ISAJET/isasusy/ssgwq1.F create mode 100644 ISAJET/isasusy/ssgwq2.F create mode 100644 ISAJET/isasusy/ssgwt1.F create mode 100644 ISAJET/isasusy/ssgwt2.F create mode 100644 ISAJET/isasusy/ssgwt3.F create mode 100644 ISAJET/isasusy/ssgwt4.F create mode 100644 ISAJET/isasusy/ssgwt5.F create mode 100644 ISAJET/isasusy/ssgwt6.F create mode 100644 ISAJET/isasusy/ssgwt7.F create mode 100644 ISAJET/isasusy/ssgwt8.F create mode 100644 ISAJET/isasusy/ssgx1.F create mode 100644 ISAJET/isasusy/ssgx10.F create mode 100644 ISAJET/isasusy/ssgx11.F create mode 100644 ISAJET/isasusy/ssgx2.F create mode 100644 ISAJET/isasusy/ssgx3.F create mode 100644 ISAJET/isasusy/ssgx4.F create mode 100644 ISAJET/isasusy/ssgx5.F create mode 100644 ISAJET/isasusy/ssgx6.F create mode 100644 ISAJET/isasusy/ssgx7.F create mode 100644 ISAJET/isasusy/ssgx8.F create mode 100644 ISAJET/isasusy/ssgx9.F create mode 100644 ISAJET/isasusy/ssgzg1.F create mode 100644 ISAJET/isasusy/ssgzg2.F create mode 100644 ISAJET/isasusy/ssgzg3.F create mode 100644 ISAJET/isasusy/ssgzt.F create mode 100644 ISAJET/isasusy/sshcc.F create mode 100644 ISAJET/isasusy/sshff.F create mode 100644 ISAJET/isasusy/sshff1.F create mode 100644 ISAJET/isasusy/sshgl.F create mode 100644 ISAJET/isasusy/sshgm.F create mode 100644 ISAJET/isasusy/sshgm1.F create mode 100644 ISAJET/isasusy/sshhx.F create mode 100644 ISAJET/isasusy/sshibf.F create mode 100644 ISAJET/isasusy/sshnn.F create mode 100644 ISAJET/isasusy/sshsf.F create mode 100644 ISAJET/isasusy/sshww.F create mode 100644 ISAJET/isasusy/sshww1.F create mode 100644 ISAJET/isasusy/sshww2.F create mode 100644 ISAJET/isasusy/ssl1st.F create mode 100644 ISAJET/isasusy/sslpbf.F create mode 100644 ISAJET/isasusy/sslrt1.F create mode 100644 ISAJET/isasusy/ssmass.F create mode 100644 ISAJET/isasusy/ssme3.F create mode 100644 ISAJET/isasusy/ssmhc.F create mode 100644 ISAJET/isasusy/ssmhn.F create mode 100644 ISAJET/isasusy/ssmqcd.F create mode 100644 ISAJET/isasusy/ssmssm.F create mode 100644 ISAJET/isasusy/ssn1st.F create mode 100644 ISAJET/isasusy/ssnorm.F create mode 100644 ISAJET/isasusy/sspole.F create mode 100644 ISAJET/isasusy/ssqkbf.F create mode 100644 ISAJET/isasusy/sssave.F create mode 100644 ISAJET/isasusy/sssnws.F create mode 100644 ISAJET/isasusy/ssstbf.F create mode 100644 ISAJET/isasusy/sstest.F create mode 100644 ISAJET/isasusy/sstpbf.F create mode 100644 ISAJET/isasusy/sswibf.F create mode 100644 ISAJET/isasusy/sswwf1.F create mode 100644 ISAJET/isasusy/sswzbf.F create mode 100644 ISAJET/isasusy/sswzf1.F create mode 100644 ISAJET/isasusy/sswzf2.F create mode 100644 ISAJET/isasusy/sswzf3.F create mode 100644 ISAJET/isasusy/sswzf4.F create mode 100644 ISAJET/isasusy/sswzf5.F create mode 100644 ISAJET/isasusy/sswzf6.F create mode 100644 ISAJET/isasusy/sswzf7.F create mode 100644 ISAJET/isasusy/ssxint.F create mode 100644 ISAJET/isasusy/ssxlam.F create mode 100644 ISAJET/isasusy/sszhx.F create mode 100644 ISAJET/isasusy/sszibf.F create mode 100644 ISAJET/isasusy/sszwf1.F create mode 100644 ISAJET/isasusy/sszzf1.F create mode 100644 ISAJET/isasusy/sszzf2.F create mode 100644 ISAJET/isasusy/sszzf3.F create mode 100644 ISAJET/isasusy/sszzf4.F create mode 100644 ISAJET/isasusy/sszzf5.F create mode 100644 ISAJET/isasusy/sualfe.F create mode 100644 ISAJET/isasusy/sualfs.F create mode 100644 ISAJET/isasusy/sugeff.F create mode 100644 ISAJET/isasusy/sugfrz.F create mode 100644 ISAJET/isasusy/sugmas.F create mode 100644 ISAJET/isasusy/sugra.F create mode 100644 ISAJET/isasusy/sugrge.F create mode 100644 ISAJET/isasusy/surg06.F create mode 100644 ISAJET/isasusy/surg26.F create mode 100644 ISAJET/isatape/bufin.F create mode 100644 ISAJET/isatape/bufout.F create mode 100644 ISAJET/isatape/edit.F create mode 100644 ISAJET/isatape/isahep.F create mode 100644 ISAJET/isatape/isawbg.F create mode 100644 ISAJET/isatape/isawev.F create mode 100644 ISAJET/isatape/isawnd.F create mode 100644 ISAJET/isatape/itrans.F create mode 100644 ISAJET/isatape/movlev.F create mode 100644 ISAJET/isatape/prtlst.F create mode 100644 ISAJET/isatape/rdbeg.F create mode 100644 ISAJET/isatape/rdtape.F create mode 100644 ISAJET/isatape/rend.F create mode 100644 ISAJET/isatape/rgens.F create mode 100644 ISAJET/isatape/wgens.F create mode 100644 ISAJET/isatape/zerol.F create mode 100644 ISAJET/openfile/openfile.F create mode 100644 ISAJET/pdfinit/pdfinit.F create mode 100644 ISAJET/utils/cern_lib/ddilog.F create mode 100644 ISAJET/utils/cern_lib/eisrs1.F create mode 100644 ISAJET/utils/cern_lib/rkstp.F create mode 100644 ISAJET/utils/cern_lib/sorttf.F create mode 100644 ISAJET/utils/cern_lib/tql2.F create mode 100644 ISAJET/utils/cern_lib/tred2.F diff --git a/ISAJET/Makefile b/ISAJET/Makefile new file mode 100644 index 00000000000..8bdb631f5a6 --- /dev/null +++ b/ISAJET/Makefile @@ -0,0 +1,65 @@ +############################### PDF Makefile ################################## + +# Include machine specific definitions + +include $(ALICE_ROOT)/conf/GeneralDef +include $(ALICE_ROOT)/conf/MachineDef.$(ALICE_TARGET) + +PACKAGE = ISAJET + +PDFDIRS = code isadata isarun isasusy isatape test openfile pdfinit utils/cern_lib + +# C++ sources + +SRCS = + +FSRCS = $(wildcard $(patsubst %,%/*.F,$(PDFDIRS))) + +FOBJS = $(patsubst %.F,tgt_$(ALICE_TARGET)/%.o,$(FSRCS)) + +SRCS = $(FSRCS) +OBJS = $(FOBJS) + +# C++ compilation flags + +CXXFLAGS = $(CXXOPTS) $(CLIBCXXOPTS) $(CLIBDEFS) -I. + +# C compilation flags + +CFLAGS = $(COPT) $(CLIBCOPT) $(CLIBDEFS) -I. + +# FORTRAN compilation flags + +FFLAGS = $(FOPT) $(CLIBFOPT) $(CLIBDEFS) -DCERNLIB_DOUBLE -DCERNLIB_PDFLIB -I. + +# Target + +SLIBRARY = $(LIBDIR)/libisajet.$(SL) +ALIBRARY = $(LIBDIR)/libisajet.a + +default: $(SLIBRARY) + +$(LIBDIR)/libisajet.$(SL): $(OBJS) + +depend: $(SRCS) + +TOCLEAN = $(OBJS) + +############################### General Macros ################################ + +include $(ALICE_ROOT)/conf/GeneralMacros + +############################ Dependencies ##################################### + +-include tgt_$(ALICE_TARGET)/Make-depend + + + + + + + + + + + diff --git a/ISAJET/code/alqcd.F b/ISAJET/code/alqcd.F new file mode 100644 index 00000000000..08e4c29e60f --- /dev/null +++ b/ISAJET/code/alqcd.F @@ -0,0 +1,31 @@ +#include "isajet/pilot.h" + FUNCTION ALQCD(Q2) +C----------------------------------------------------------------------- +C Strong coupling formula from page 201 of Barger and Phillips: +C (using ALQCD4 for 4 flavor Lambda) +C----------------------------------------------------------------------- + REAL Q2,AS,TH5,TH6,PI,ALQCD4 + LOGICAL FIRST + SAVE FIRST,PI,TH5,TH6,ALQCD4 + DATA FIRST/.TRUE./ +C + IF(FIRST) THEN + PI=4.*ATAN(1.) + TH5=4*AMASS(5)**2 + TH6=4*AMASS(6)**2 + ALQCD4=0.177 + FIRST=.FALSE. + ENDIF + IF (Q2.LE.TH5)THEN + AS=12*PI/(25*LOG(Q2/ALQCD4**2)) + ELSE IF(Q2.GT.TH5.AND.Q2.LE.TH6) THEN + AS=25*LOG(Q2/ALQCD4**2)-2*LOG(Q2/TH5) + AS=12*PI/AS + ELSEIF(Q2.GT.TH6)THEN + AS=25*LOG(Q2/ALQCD4**2) + AS=AS-2*(LOG(Q2/TH5)+LOG(Q2/TH6)) + AS=12*PI/AS + ENDIF + ALQCD=AS + RETURN + END diff --git a/ISAJET/code/amass.F b/ISAJET/code/amass.F new file mode 100644 index 00000000000..1584440fe95 --- /dev/null +++ b/ISAJET/code/amass.F @@ -0,0 +1,136 @@ +#include "isajet/pilot.h" + FUNCTION AMASS(ID) +C +C Returns the mass of the particle with IDENT code ID. +C Quark-based IDENT code. +C Ver 7.10: Update masses and split B baryon degeneracy. +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/qlmass.inc" + INTEGER ID + REAL AMASS + REAL AMMES0(10),AMMES1(10),AMBAR0(30),AMBAR1(30) + INTEGER IFL1,IFL2,IFL3,JSPIN,INDEX,IFL1A,IFL2A,IFL3A,IDA +C +C 0- meson mass table +C pi0, pi+, eta, k+, k0, etap, ad0, d-, ds-, etac +C + DATA AMMES0/.13496,.13957,.54745,.49367,.49767,.95775,1.8645 + $,1.8693,1.9688,2.9788/ +C +C 1- meson mass table +C rho0, rho+, omega, k*+, k*0, phi, ad*0, d*-, d*s-, jpsi +C + DATA AMMES1/.7681,.7681,.78195,.89159,.89610,1.0194,2.0071 + $,2.0101,2.1103,3.0969/ +C +C 1/2+ baryon mass table +C x,p,n,-,-,s+,s0,s-,l,xi0,xi-,x,x,x +C sc++,sc+,sc0,lc+,usc.,dsc.,ssc.,sdc.,suc.,ucc.,dcc.,scc. +C + DATA AMBAR0/-1.,.93828,.93957,2*-1.,1.1894,1.1925,1.1974 + $,1.1156,1.3149,1.3213,3*-1.,2.4527,2.4529,2.4525,2.2849 + $,2.50,2.50,2.60,2.40,2.40,3.55,3.55,3.70,4*-1./ +C +C 3/2+ baryon mass table +C dl++,dl+,dl0,dl-,-,s*+,s*0,s*-,x,xi*0,xi*-,om-,x,x +C uuc*,udc*,ddc*,x,usc*,dsc*,ssc*,x,x,,ucc*,dcc*,scc*,ccc* +C + DATA AMBAR1/1.232,1.232,1.232,1.232,-1.,1.3823,1.3820 + $,1.3875,-1.,1.5318,1.5350,1.6722,2*-1. + $,2.63,2.63,2.63,-1.,2.70,2.70,2.80,2*-1.,3.75,3.75 + $,3.90,4.80,3*-1./ +C +C Entry +C + AMASS=-1. + CALL FLAVOR(ID,IFL1,IFL2,IFL3,JSPIN,INDEX) + IDA=IABS(ID) + IFL1A=IABS(IFL1) + IFL2A=IABS(IFL2) + IFL3A=IABS(IFL3) + IF(IDA.GT.10000.OR.JSPIN.GT.1) GO TO 500 +C +C Diquarks +C + IF(ID.NE.0.AND.MOD(ID,100).EQ.0) THEN + AMASS=AMLEP(IFL1A)+AMLEP(IFL2A) +C +C b and t particles. Only a few b masses are known, but we +C guess a few others to make sure decays are allowed: +C + ELSEIF(IFL3A.GT.4) THEN + IF(IDA.EQ.150.OR.IDA.EQ.250) THEN + AMASS=5.2786 + ELSEIF(IDA.EQ.151.OR.IDA.EQ.251) THEN + AMASS=5.3246 + ELSEIF(IDA.EQ.350) THEN + AMASS=5.3693 + ELSEIF(IDA.EQ.351) THEN + AMASS=5.3693+0.04 + ELSEIF(IDA.EQ.2150) THEN + AMASS=5.641 + ELSEIF(IDA.EQ.1150.OR.IDA.EQ.1250.OR.IDA.EQ.2250) THEN + AMASS=5.641+0.171 + ELSEIF(IDA.EQ.2151) THEN + AMASS=5.641+.04 + ELSEIF(IDA.EQ.1151.OR.IDA.EQ.1251.OR.IDA.EQ.2251) THEN + AMASS=5.641+0.171+0.04 + ELSE + AMASS=AMLEP(IFL2A)+AMLEP(IFL3A)-.03+.04*JSPIN + IF(IFL1.NE.0) AMASS=AMASS+AMLEP(IFL1A) + ENDIF +C +C Quarks and leptons +C + ELSEIF(IFL2.EQ.0) THEN + AMASS=AMLEP(INDEX) +C +C Mesons +C + ELSEIF(IFL1.EQ.0) THEN + INDEX=INDEX-36*JSPIN-NQLEP + INDEX=INDEX-13 + AMASS=(1-JSPIN)*AMMES0(INDEX)+JSPIN*AMMES1(INDEX) +C +C Baryons +C + ELSE + INDEX=INDEX-109*JSPIN-36*NMES-NQLEP + INDEX=INDEX-13 + AMASS=(1-JSPIN)*AMBAR0(INDEX)+JSPIN*AMBAR1(INDEX) + ENDIF + RETURN +C +C Special hadrons - used only in B decays +C +500 IF(IDA.EQ.10121.OR.IDA.EQ.10111) THEN + AMASS=1.230 + ELSEIF(IDA.EQ.10131.OR.IDA.EQ.10231) THEN + AMASS=1.273 + ELSEIF(IDA.EQ.30131.OR.IDA.EQ.30231) THEN + AMASS=1.412 + ELSEIF(IDA.EQ.132) THEN + AMASS=1.4254 + ELSEIF(IDA.EQ.232) THEN + AMASS=1.4324 + ELSEIF(IDA.EQ.10110) THEN + AMASS=0.980+0.020 + ELSEIF(IDA.EQ.112) THEN + AMASS=1.275 + ELSEIF(IDA.EQ.10441) THEN + AMASS=3.686 + ELSEIF(IDA.EQ.20440) THEN + AMASS=3.4151 + ELSEIF(IDA.EQ.20441) THEN + AMASS=3.51053 + ELSEIF(IDA.EQ.20442) THEN + AMASS=3.56617 + ELSE + AMASS=0 + ENDIF + RETURN + END diff --git a/ISAJET/code/amgmw.F b/ISAJET/code/amgmw.F new file mode 100644 index 00000000000..479278f1620 --- /dev/null +++ b/ISAJET/code/amgmw.F @@ -0,0 +1,36 @@ +#include "isajet/pilot.h" + FUNCTION AMGMW(I,J) +C +C Get masses and widths from ISAJET commons for MadGraph +C I = particle IDENT +C J = 1 for mass +C = 2 for width +C = 3 for sin^2(theta) +C Needed to avoid common block name clashes with MadGraph +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/wcon.inc" +#include "isajet/hcon.inc" +#include "isajet/sstype.inc" + INTEGER I,J + REAL AMGMW,AMASS +C + IF(J.EQ.1) THEN + AMGMW=AMASS(I) + ELSEIF(J.EQ.2.AND.I.EQ.IDW) THEN + AMGMW=WGAM(2) + ELSEIF(J.EQ.2.AND.I.EQ.IDZ) THEN + AMGMW=WGAM(4) + ELSEIF(J.EQ.2.AND.I.EQ.IDH) THEN + AMGMW=HGAM + ELSEIF(J.EQ.3.AND.I.EQ.1) THEN + AMGMW=SIN2W + ELSE + WRITE(ITLIS,*) 'ERROR IN AMGMW: I,J =',I,J + STOP99 + ENDIF + RETURN + END diff --git a/ISAJET/code/charge.F b/ISAJET/code/charge.F new file mode 100644 index 00000000000..951333cc0e4 --- /dev/null +++ b/ISAJET/code/charge.F @@ -0,0 +1,30 @@ +#include "isajet/pilot.h" + FUNCTION CHARGE(ID) +C +C COMPUTE CHARGE OF PARTICLE WITH IDENT CODE ID +C ICHRG MUST BE DIMENSIONED NQLEP+13 +C +#include "isajet/itapes.inc" + DIMENSION ICHRG(75),IFL(3) +C 3 * charge + DATA ICHRG/0 + $,2,-1,-1,2,-1,2,-1,2,0,0, 0,-3,0,-3,0,-3,0,-3,0,0,0 + $,2,-1,-1,2,-1,2,-1,2,0,0, 0,-3,0,-3,0,-3,0,-3,3,0 + $,2,-1,-1,2,-1,2,-1,2,3,0, 0,-3,0,-3,0,-3,0,-3,3,0 + $,3,0,0,0,0,0,3,3,6,6,0,0,0/ +C + IDABS=IABS(ID) + CALL FLAVOR(ID,IFL(1),IFL(2),IFL(3),JSPIN,INDEX) + IF(IDABS.LT.100) GO TO 200 +C + ISUM=0 + DO 100 I=1,3 + ISUM=ISUM+ICHRG(IABS(IFL(I))+1)*ISIGN(1,IFL(I)) + 100 CONTINUE + CHARGE=ISUM/3. + RETURN +C +200 CHARGE=ICHRG(INDEX+1)*ISIGN(1,ID) + CHARGE=CHARGE/3. + RETURN + END diff --git a/ISAJET/code/ctxc2i.F b/ISAJET/code/ctxc2i.F new file mode 100644 index 00000000000..add374e0806 --- /dev/null +++ b/ISAJET/code/ctxc2i.F @@ -0,0 +1,17 @@ +#include "isajet/pilot.h" + SUBROUTINE CTXC2I(CVAL,IVAL,NSIZE) +C----------------------------------------------------------------------- +C Convert character variable CVAL to integer array IVAL +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + CHARACTER*(*) CVAL + INTEGER I,NSIZE + INTEGER IVAL(NSIZE) +C + DO 100 I=1,NSIZE +100 IVAL(I)=ICHAR(CVAL(I:I)) +C + RETURN + END diff --git a/ISAJET/code/ctxi2c.F b/ISAJET/code/ctxi2c.F new file mode 100644 index 00000000000..741a74d5855 --- /dev/null +++ b/ISAJET/code/ctxi2c.F @@ -0,0 +1,17 @@ +#include "isajet/pilot.h" + SUBROUTINE CTXI2C(IVAL,CVAL,NSIZE) +C----------------------------------------------------------------------- +C Convert integer array IVAL to character variable CVAL +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + CHARACTER*(*) CVAL + INTEGER I,NSIZE + INTEGER IVAL(NSIZE) +C + DO 100 I=1,NSIZE +100 CVAL(I:I)=CHAR(IVAL(I)) +C + RETURN + END diff --git a/ISAJET/code/ctxin.F b/ISAJET/code/ctxin.F new file mode 100644 index 00000000000..47a199d39b5 --- /dev/null +++ b/ISAJET/code/ctxin.F @@ -0,0 +1,201 @@ +#include "isajet/pilot.h" + SUBROUTINE CTXIN(NVC,VC,MXVC) +C----------------------------------------------------------------------- +C Purpose: +C Restore the context for an ISAJET job: +C Restore NVC words of VC all common blocks NOT associated only +C with a single event. Call CTXOUT and this to generate mixed +C events. +C PARAMETER (MXVC=20000) +C REAL VC(MXVC) +C ... +C CALL CTXIN(NVC,VC,MXVC) +C +C Note that the MSSM common blocks are not saved, so different +C SUSY runs cannot be mixed. +C +C Ver. 7.02: Equivalenced dummy variables to avoid mixed +C arguments in MOVLEV or multiple EQUIVALENCEd +C arguments to CTXIN/CTXOUT. +C +C Author: +C F.E. Paige, April 1992 +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/dkytab.inc" +#include "isajet/dylim.inc" +#include "isajet/dypar.inc" +#include "isajet/eepar.inc" +#include "isajet/final.inc" +#include "isajet/force.inc" +#include "isajet/frgpar.inc" +#include "isajet/hcon.inc" +#include "isajet/idrun.inc" +#include "isajet/isloop.inc" +#include "isajet/itapes.inc" +#include "isajet/jetlim.inc" +#include "isajet/keys.inc" +#include "isajet/limevl.inc" +#include "isajet/lstprt.inc" +#include "isajet/mbgen.inc" +#include "isajet/mbpar.inc" +#include "isajet/nodcay.inc" +#include "isajet/primar.inc" +#include "isajet/prtout.inc" +#include "isajet/ptpar.inc" +#include "isajet/q1q2.inc" +#include "isajet/qcdpar.inc" +#include "isajet/qlmass.inc" +#include "isajet/tcpar.inc" +#include "isajet/times.inc" +#include "isajet/totals.inc" +#include "isajet/types.inc" +#include "isajet/wcon.inc" +C + INTEGER NVC,MXVC,NC,NN,I + REAL VC(MXVC) + CHARACTER*8 CLIST(290) + EQUIVALENCE (CLIST(1),PARTYP(1)) +C +C Dummy real variables for integers + REAL VLOOK(MXLOOK+6*MXDKY) + EQUIVALENCE (VLOOK(1),LOOK(1)) + REAL VNKINF(5) + EQUIVALENCE (VNKINF(1),NKINF) + REAL VFORCE(9*MXFORC+1) + EQUIVALENCE (VFORCE(1),NFORCE) + REAL VIDVER(5) + EQUIVALENCE (VIDVER(1),IDVER) + REAL VEVOLV(4) + EQUIVALENCE (VEVOLV(1),NEVOLV) + REAL VITDKY(4) + EQUIVALENCE (VITDKY(1),ITDKY) + REAL VIKEYS(12) + EQUIVALENCE (VIKEYS(1),IKEYS) + REAL VSTPRT + EQUIVALENCE (VSTPRT,LSTPRT) + REAL VNJET(9) + EQUIVALENCE (VNJET(1),NJET) + REAL VEVPRT(2) + EQUIVALENCE (VEVPRT(1),NEVPRT) + REAL VKINPT(5) + EQUIVALENCE (VKINPT(1),NKINPT) + REAL VLOC(100) + EQUIVALENCE (VLOC(1),LOC(1)) +C Dummy real variables for logicals + REAL VFLW(13) + EQUIVALENCE (VFLW(1),FLW) + REAL VNODCY(6) + EQUIVALENCE (VNODCY(1),NODCAY) + REAL VGOQ(3*MXGOQ+135) + EQUIVALENCE (VGOQ(1),GOQ(1,1)) +C + NC=0 +C DKYTAB + NN=MXLOOK+6*MXDKY + CALL MOVLEV(VC(NC+1),VLOOK(1),NN) + NC=NC+NN +C DYLIM + CALL MOVLEV(VC(NC+1),QMIN,24) + NC=NC+24 +C DYPAR + CALL MOVLEV(VC(NC+1),VFLW(1),13) + NC=NC+13 +C EEPAR + CALL MOVLEV(VC(NC+1),SGMXEE,1) + NC=NC+1 +C FINAL + CALL MOVLEV(VC(NC+1),VNKINF(1),5) + NC=NC+5 +C FORCE + NN=9*MXFORC+1 + CALL MOVLEV(VC(NC+1),VFORCE(1),NN) + NC=NC+NN +C FRGPAR + CALL MOVLEV(VC(NC+1),PUD,41) + NC=NC+41 +C HCON + CALL MOVLEV(VC(NC+1),HMASS,69) + NC=NC+69 +C IDRUN + CALL MOVLEV(VC(NC+1),VIDVER(1),5) + NC=NC+5 +C ISLOOP + CALL MOVLEV(VC(NC+1),VEVOLV(1),4) + NC=NC+4 +C ITAPES + CALL MOVLEV(VC(NC+1),VITDKY(1),4) + NC=NC+4 +C JETLIM + CALL MOVLEV(VC(NC+1),PMIN(1),72) + NC=NC+72 +C KEYS + CALL MOVLEV(VC(NC+1),VIKEYS(1),12) + NC=NC+12 + CALL CTXI2C(VC(NC+1),REAC,8) + NC=NC+8 +C LIMEVL + CALL MOVLEV(VC(NC+1),ETTHRS,3) + NC=NC+3 +C LSTPRT + CALL MOVLEV(VC(NC+1),VSTPRT,1) + NC=NC+1 +C MBGEN + NN=4*LIMPOM+8 + CALL MOVLEV(VC(NC+1),POMWT(1),NN) + NC=NC+NN +C MBPAR + CALL MOVLEV(VC(NC+1),PUD0,19) + NC=NC+19 +C NODCAY + CALL MOVLEV(VC(NC+1),VNODCY(1),6) + NC=NC+6 +C PRIMAR + CALL MOVLEV(VC(NC+1),VNJET(1),9) + NC=NC+9 +C PRTOUT + CALL MOVLEV(VC(NC+1),VEVPRT(1),2) + NC=NC+2 +C PTPAR + CALL MOVLEV(VC(NC+1),PTFUN1,6) + NC=NC+6 +C Q1Q2 + CALL MOVLEV(VC(NC+1),VGOQ(1),3*MXGOQ+135) + NC=NC+3*MXGOQ+135 +C QCDPAR + CALL MOVLEV(VC(NC+1),ALAM,4) + NC=NC+4 +C QLMASS + CALL MOVLEV(VC(NC+1),AMLEP(1),55) + NC=NC+55 +C TCPAR + CALL MOVLEV(VC(NC+1),TCMRHO,2) + NC=NC+2 +C TIMES + CALL MOVLEV(VC(NC+1),TIME1,2) + NC=NC+2 +C TOTALS + CALL MOVLEV(VC(NC+1),VKINPT(1),5) + NC=NC+5 +C TYPES + CALL MOVLEV(VC(NC+1),VLOC(1),100) + NC=NC+100 + DO 100 I=1,290 + CALL CTXI2C(VC(NC+1),CLIST(I),8) + NC=NC+8 +100 CONTINUE +C WCON +#if defined(CERNLIB_SINGLE) + NN=514 +#endif +#if defined(CERNLIB_DOUBLE) + NN=514+97 +#endif + CALL MOVLEV(VC(NC+1),SIN2W,NN) + NC=NC+NN +C + NVC=NC + RETURN + END diff --git a/ISAJET/code/ctxout.F b/ISAJET/code/ctxout.F new file mode 100644 index 00000000000..4a2c0d7a93e --- /dev/null +++ b/ISAJET/code/ctxout.F @@ -0,0 +1,207 @@ +#include "isajet/pilot.h" + SUBROUTINE CTXOUT(NVC,VC,MXVC) +C----------------------------------------------------------------------- +C Purpose: +C Save the context for an ISAJET job: +C Save in NVC words of VC all common blocks NOT associated only +C with a single event. Call this and CTXIN to generate mixed +C events. +C PARAMETER (MXVC=20000) +C REAL VC(MXVC) +C ... +C CALL CTXIN(NVC,VC,MXVC) +C +C Note that the MSSM common blocks are not saved, so different +C SUSY runs cannot be mixed. +C +C Ver. 7.02: Equivalenced dummy variables to avoid mixed +C arguments in MOVLEV or multiple EQUIVALENCEd +C arguments to CTXIN/CTXOUT. +C +C Author: +C F.E. Paige, April 1992 +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/dkytab.inc" +#include "isajet/dylim.inc" +#include "isajet/dypar.inc" +#include "isajet/eepar.inc" +#include "isajet/final.inc" +#include "isajet/force.inc" +#include "isajet/frgpar.inc" +#include "isajet/hcon.inc" +#include "isajet/idrun.inc" +#include "isajet/isloop.inc" +#include "isajet/itapes.inc" +#include "isajet/jetlim.inc" +#include "isajet/keys.inc" +#include "isajet/limevl.inc" +#include "isajet/lstprt.inc" +#include "isajet/mbgen.inc" +#include "isajet/mbpar.inc" +#include "isajet/nodcay.inc" +#include "isajet/primar.inc" +#include "isajet/prtout.inc" +#include "isajet/ptpar.inc" +#include "isajet/q1q2.inc" +#include "isajet/qcdpar.inc" +#include "isajet/qlmass.inc" +#include "isajet/tcpar.inc" +#include "isajet/times.inc" +#include "isajet/totals.inc" +#include "isajet/types.inc" +#include "isajet/wcon.inc" +C + INTEGER NVC,MXVC,NC,NN,I + REAL VC(MXVC) + CHARACTER*8 CLIST(290) + EQUIVALENCE (CLIST(1),PARTYP(1)) +C +C Dummy real variables for integers + REAL VLOOK(MXLOOK+6*MXDKY) + EQUIVALENCE (VLOOK(1),LOOK(1)) + REAL VNKINF(5) + EQUIVALENCE (VNKINF(1),NKINF) + REAL VFORCE(9*MXFORC+1) + EQUIVALENCE (VFORCE(1),NFORCE) + REAL VIDVER(5) + EQUIVALENCE (VIDVER(1),IDVER) + REAL VEVOLV(4) + EQUIVALENCE (VEVOLV(1),NEVOLV) + REAL VITDKY(4) + EQUIVALENCE (VITDKY(1),ITDKY) + REAL VIKEYS(12) + EQUIVALENCE (VIKEYS(1),IKEYS) + REAL VSTPRT + EQUIVALENCE (VSTPRT,LSTPRT) + REAL VNJET(9) + EQUIVALENCE (VNJET(1),NJET) + REAL VEVPRT(2) + EQUIVALENCE (VEVPRT(1),NEVPRT) + REAL VKINPT(5) + EQUIVALENCE (VKINPT(1),NKINPT) + REAL VLOC(100) + EQUIVALENCE (VLOC(1),LOC(1)) +C Dummy real variables for logicals + REAL VFLW(13) + EQUIVALENCE (VFLW(1),FLW) + REAL VNODCY(6) + EQUIVALENCE (VNODCY(1),NODCAY) + REAL VGOQ(3*MXGOQ+135) + EQUIVALENCE (VGOQ(1),GOQ(1,1)) +C + NC=0 +C DKYTAB + NN=MXLOOK+6*MXDKY + CALL MOVLEV(VLOOK(1),VC(NC+1),NN) + NC=NC+NN +C DYLIM + CALL MOVLEV(QMIN,VC(NC+1),24) + NC=NC+24 +C DYPAR + CALL MOVLEV(VFLW(1),VC(NC+1),13) + NC=NC+13 +C EEPAR + CALL MOVLEV(SGMXEE,VC(NC+1),1) + NC=NC+1 +C FINAL + CALL MOVLEV(VNKINF(1),VC(NC+1),5) + NC=NC+5 +C FORCE + NN=9*MXFORC+1 + CALL MOVLEV(VFORCE(1),VC(NC+1),NN) + NC=NC+NN +C FRGPAR + CALL MOVLEV(PUD,VC(NC+1),41) + NC=NC+41 +C HCON + CALL MOVLEV(HMASS,VC(NC+1),69) + NC=NC+69 +C IDRUN + CALL MOVLEV(VIDVER(1),VC(NC+1),5) + NC=NC+5 +C ISLOOP + CALL MOVLEV(VEVOLV(1),VC(NC+1),4) + NC=NC+4 +C ITAPES + CALL MOVLEV(VITDKY(1),VC(NC+1),4) + NC=NC+4 +C JETLIM + CALL MOVLEV(PMIN(1),VC(NC+1),72) + NC=NC+72 +C KEYS + CALL MOVLEV(VIKEYS(1),VC(NC+1),12) + NC=NC+12 + CALL CTXC2I(REAC,VC(NC+1),8) + NC=NC+8 +C LIMEVL + CALL MOVLEV(ETTHRS,VC(NC+1),3) + NC=NC+3 +C LSTPRT + CALL MOVLEV(VSTPRT,VC(NC+1),1) + NC=NC+1 +C MBGEN + NN=4*LIMPOM+8 + CALL MOVLEV(POMWT(1),VC(NC+1),NN) + NC=NC+NN +C MBPAR + CALL MOVLEV(PUD0,VC(NC+1),19) + NC=NC+19 +C NODCAY + CALL MOVLEV(VNODCY(1),VC(NC+1),6) + NC=NC+6 +C PRIMAR + CALL MOVLEV(VNJET(1),VC(NC+1),9) + NC=NC+9 +C PRTOUT + CALL MOVLEV(VEVPRT(1),VC(NC+1),2) + NC=NC+2 +C PTPAR + CALL MOVLEV(PTFUN1,VC(NC+1),6) + NC=NC+6 +C Q1Q2 + CALL MOVLEV(VGOQ(1),VC(NC+1),3*MXGOQ+135) + NC=NC+3*MXGOQ+135 +C QCDPAR + CALL MOVLEV(ALAM,VC(NC+1),4) + NC=NC+4 +C QLMASS + CALL MOVLEV(AMLEP(1),VC(NC+1),55) + NC=NC+55 +C TCPAR + CALL MOVLEV(TCMRHO,VC(NC+1),2) + NC=NC+2 +C TIMES + CALL MOVLEV(TIME1,VC(NC+1),2) + NC=NC+2 +C TOTALS + CALL MOVLEV(VKINPT(1),VC(NC+1),5) + NC=NC+5 +C TYPES + CALL MOVLEV(VLOC(1),VC(NC+1),100) + NC=NC+100 + DO 100 I=1,290 + CALL CTXC2I(CLIST(I),VC(NC+1),8) + NC=NC+8 +100 CONTINUE +C WCON +#if defined(CERNLIB_SINGLE) + NN=514 +#endif +#if defined(CERNLIB_DOUBLE) + NN=514+97 +#endif + CALL MOVLEV(SIN2W,VC(NC+1),NN) + NC=NC+NN +C + IF(NC.LE.MXVC) THEN + NVC=NC + RETURN + ELSE + WRITE(ITLIS,9000) NC +9000 FORMAT(//' ERROR IN CTXOUT, NC = ',I5) + STOP99 + ENDIF + END diff --git a/ISAJET/code/datime.F b/ISAJET/code/datime.F new file mode 100644 index 00000000000..90395dd1c9a --- /dev/null +++ b/ISAJET/code/datime.F @@ -0,0 +1,14 @@ +#include "isajet/pilot.h" +#if (defined(CERNLIB_VAX))&&(defined(CERNLIB_NOCERN)) + SUBROUTINE DATIME(ID,IT) +C CALL VAX DATE AND TIME. +#include "isajet/itapes.inc" + CHARACTER*8 BUF + CALL IDATE(IMON,IDAY,IYR) + CALL TIME(BUF) + ID=10000*IYR+100*IMON+IDAY + READ(BUF,'(I2,1X,I2,1X,I2)') K1,K2,K3 + IT=10000*K1+100*K2+K3 + RETURN + END +#endif diff --git a/ISAJET/code/dblpcm.F b/ISAJET/code/dblpcm.F new file mode 100644 index 00000000000..b3f4a4dd7c9 --- /dev/null +++ b/ISAJET/code/dblpcm.F @@ -0,0 +1,19 @@ +#include "isajet/pilot.h" + FUNCTION DBLPCM(A,B,C) +C Calculate com momentum for A-->B+C with double precision. +C Needed to fix bug on 32-bit machines at high energy. +C Ver. 7.27: Rewrite order and then take abs value to be sure. +#include "isajet/itapes.inc" +#if defined(CERNLIB_DOUBLE) + DOUBLE PRECISION DA,DB,DC,DVAL +#endif +C Convert to double precision + DA=A + DB=B + DC=C + DVAL=(DA-(DB+DC))*(DA+(DB+DC))*(DA-(DB-DC))*(DA+(DB-DC)) +C Convert back to single precision + VAL=DVAL + DBLPCM=SQRT(ABS(VAL))/(2.*A) + RETURN + END diff --git a/ISAJET/code/dblvec.F b/ISAJET/code/dblvec.F new file mode 100644 index 00000000000..a2b657bc2a9 --- /dev/null +++ b/ISAJET/code/dblvec.F @@ -0,0 +1,28 @@ +#include "isajet/pilot.h" + SUBROUTINE DBLVEC(P,DP) +C +C Calculate double precision vector DP for 5-vector P. +C Exact components are 1,2,5 and larger of +,- +C Ver 6.44: Always use this, even if IF=SINGLE. +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + REAL P(5) + DOUBLE PRECISION DP(5),DPPL,DPMN + INTEGER K +C + DO 100 K=1,5 +100 DP(K)=P(K) + IF(DP(4)+ABS(DP(3)).EQ.0.) RETURN + IF(DP(3).GT.0.) THEN + DPPL=DP(4)+DP(3) + DPMN=(DP(1)**2+DP(2)**2+DP(5)**2)/DPPL + ELSE + DPMN=DP(4)-DP(3) + DPPL=(DP(1)**2+DP(2)**2+DP(5)**2)/DPMN + ENDIF + DP(3)=0.5D0*(DPPL-DPMN) + DP(4)=0.5D0*(DPPL+DPMN) + RETURN + END diff --git a/ISAJET/code/dboost.F b/ISAJET/code/dboost.F new file mode 100644 index 00000000000..373b4abcbed --- /dev/null +++ b/ISAJET/code/dboost.F @@ -0,0 +1,32 @@ +#include "isajet/pilot.h" + SUBROUTINE DBOOST(ISIGN,F,P) +C +C DOUBLE PRECISION BOOST OF 5-VECTOR P BY 5-VECTOR F WITH SIGN +C OF ISIGN. EXACT COMPONENTS ARE 1,2,5 AND LARGER OF +,- +C + DIMENSION F(5),P(5) + DOUBLE PRECISION DF(5),DFPL,DFMN,DP(5),DPPL,DPMN,DBP,DSIGN +C COPY TO DOUBLE PRECISION + DO 100 K=1,5 + DF(K)=F(K) +100 DP(K)=P(K) + IF(ISIGN.GT.0) THEN + DSIGN=1.D0 + ELSE + DSIGN=-1.D0 + ENDIF +C PUT ON DOUBLE PRECISION SHELL + CALL DBLVEC(P,DP) +C BOOST + DBP=0.D0 + DO 110 K=1,3 +110 DBP=DBP+DF(K)*DP(K) + DBP=DBP/DF(5) + DO 120 K=1,3 +120 DP(K)=DP(K)+DSIGN*DF(K)*DP(4)/DF(5)+DF(K)*DBP/(DF(4)+DF(5)) + DP(4)=DF(4)*DP(4)/DF(5)+DSIGN*DBP +C COPY BACK + DO 130 K=1,4 +130 P(K)=DP(K) + RETURN + END diff --git a/ISAJET/code/decay.F b/ISAJET/code/decay.F new file mode 100644 index 00000000000..f03d2dd3dea --- /dev/null +++ b/ISAJET/code/decay.F @@ -0,0 +1,293 @@ +#include "isajet/pilot.h" + SUBROUTINE DECAY(IP) +C +C Decay particle IP from /PARTCL/ using /DKYTAB/ branching +C ratios and add decay products to /PARTCL/ with IORIG=IP. +C Forced decay modes are flagged by LOOK<0. +C +C Auxiliary routines: +C DECPS1: generate masses for phase space +C DECPS2: generate 2-body decays and boosts for phase space +C DECVA: V-A matrix elements +C DECTAU: tau decay matrix elements with polarization +C DECSS3: 3-body SUSY matrix element using /DKYSS3/ +C DECJET: Hadronize partons from decay. +C +C Matrix element for Dalitz decays and W mass for TP -> W BT +C are generated explicitly. W width is included. +C +C Requirements for decay modes: +C (1) For Dalitz decays, particle 1 must be GM. +C (2) For V-A quark or lepton decays, particles 1 and 2 must +C be from (virtual) W. +C (3) For any decay into quarks, they must appear last. +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/wcon.inc" +#include "isajet/partcl.inc" +#include "isajet/dkytab.inc" +#include "isajet/jetset.inc" +#include "isajet/jwork.inc" +#include "isajet/const.inc" +#include "isajet/primar.inc" +#include "isajet/idrun.inc" +#include "isajet/force.inc" +#include "isajet/sstype.inc" +#include "isajet/dkyss3.inc" +C + REAL PGEN(5,5),BETA(3),REDUCE(5),WPROP,Z,TRY,RANF,AMASS,TWOME + REAL PSUM(5),SUM,PREST(4,6),DOT,PCM + REAL AMEE,REE,WTEE,SWAP,WT,A,B,C,GAMMA + REAL SMAX,SMIN,SVAL,TANMAX,TANMIN,TANVAL + LOGICAL WDECAY,DECVA,DECTAU,DECJET + INTEGER IDLV1,IFL1,IFL2,IFL3,JSPIN,INDEX,IPOINT,ID1,I1,I2 + INTEGER NADD,NSTART,NEW,NADD1,J,IP,I,IDABS(5) + INTEGER K,JETIP,IDANTI,NPASS,MEIP,MEA + REAL DBLPCM,DECSS3,VAL +C + DATA REDUCE/1.,1.,2.,5.,15./ + DATA PSUM/5*0./ + DATA TWOME/1.022006E-3/ + DATA PREST/24*0./ +C +C Function definitions. +C Use double precision for PCM on 32-bit machines +C +#if defined(CERNLIB_SINGLE) + PCM(A,B,C)=SQRT((A**2-B**2-C**2)**2-(2.*B*C)**2)/(2.*A) +#endif +#if defined(CERNLIB_DOUBLE) + PCM(A,B,C)=DBLPCM(A,B,C) +#endif + DOT(I1,I2)=PREST(4,I1)*PREST(4,I2)-PREST(1,I1)*PREST(1,I2) + $-PREST(2,I1)*PREST(2,I2)-PREST(3,I1)*PREST(3,I2) +C Charged W propagator. + WPROP(Z)=(Z-WMASS(2)**2)**2+(WMASS(2)*WGAM(2))**2 +C---------------------------------------------------------------------- +C Select decay mode. Note IDENT(NPTCL+1)...IDENT(NPTCL+5) +C are always defined even if zero. +C---------------------------------------------------------------------- + IF(IDCAY(IP).NE.0) RETURN + IDLV1=IDENT(IP) + CALL FLAVOR(IDLV1,IFL1,IFL2,IFL3,JSPIN,INDEX) +C FLAVOR returns 0 for quark, but want IFL3=6 for top + IF(IABS(IDLV1).LT.10) IFL3=IDLV1 + NPASS=0 +1 CONTINUE + NPASS=NPASS+1 + WDECAY=.FALSE. + IF(NPASS.GT.NTRIES) GO TO 9998 + IPOINT=LOOK(INDEX) + IF(IPOINT.EQ.0) RETURN +C IPOINT<0 flags a forced decay. + IF(IPOINT.LT.0) THEN + I=1 + IF(IDENT(IP).LT.0) I=2 + IPOINT=LOOK2(I,IABS(IPOINT)) + ENDIF +C +C Select mode. +C + TRY=RANF() + IPOINT=IPOINT-1 +100 IPOINT=IPOINT+1 + IF(TRY.GT.CBR(IPOINT)) GO TO 100 + NADD=0 + SUM=0. + NSTART=NPTCL+1 + IF(NPTCL+5.GT.MXPTCL) GO TO 9999 +C +C Set up masses and IDENT codes. +C + MEIP=MELEM(IPOINT) + DO 110 I=1,5 + NEW=NPTCL+I + IDENT(NEW)=MODE(I,IPOINT) + IDABS(I)=IABS(IDENT(NEW)) + IF(MODE(I,IPOINT).EQ.0) GO TO 110 + NADD=NADD+1 + IDLV1=IDENT(NEW) + PPTCL(5,NEW)=AMASS(IDLV1) + SUM=SUM+PPTCL(5,NEW) +110 CONTINUE + NADD1=NADD-1 + DO 120 J=1,5 + PGEN(J,1)=PPTCL(J,IP) +120 CONTINUE + PGEN(5,NADD)=PPTCL(5,NPTCL+NADD) +C---------------------------------------------------------------------- +C Carry out appropriate decay +C---------------------------------------------------------------------- +C +C 1-body decays. +C + IF(NADD.EQ.1) THEN + DO 200 J=1,5 + PPTCL(J,NPTCL+1)=PPTCL(J,IP) +200 CONTINUE + GO TO 300 + ENDIF +C +C 2-body phase space decays +C + IF(NADD.EQ.2.AND.MEIP.EQ.0) THEN + CALL DECPS2(IP,NADD,PGEN,PREST,BETA,GAMMA) + GO TO 300 + ENDIF +C +C N-body phase space decays +C + IF(NADD.GT.2.AND.MEIP.EQ.0) THEN + CALL DECPS1(IP,NADD,PGEN) + CALL DECPS2(IP,NADD,PGEN,PREST,BETA,GAMMA) + GO TO 300 + ENDIF +C +C Dalitz decays +C + IF(NADD.EQ.3.AND.MEIP.EQ.1) THEN +210 AMEE=TWOME*(PPTCL(5,IP)/TWOME)**RANF() + REE=(TWOME/AMEE)**2 + WTEE=(1.-(AMEE/PPTCL(5,IP))**2)**3*SQRT(1.-REE)*(1.+.5*REE) + IF(WTEE.LT.RANF()) GO TO 210 + PGEN(5,2)=AMEE + CALL DECPS2(IP,NADD,PGEN,PREST,BETA,GAMMA) + GO TO 300 + ENDIF +C +C omega/phi decays (for reasons lost in history...) +C + IF(NADD.EQ.3.AND.MEIP.EQ.2) THEN +220 CALL DECPS1(IP,NADD,PGEN) + CALL DECPS2(IP,NADD,PGEN,PREST,BETA,GAMMA) + WT=(PPTCL(5,NPTCL+1)*PPTCL(5,NPTCL+2)*PPTCL(5,NPTCL+3))**2 + $ -(PPTCL(5,NPTCL+1)*DOT(2,3))**2 + $ -(PPTCL(5,NPTCL+2)*DOT(1,3))**2 + $ -(PPTCL(5,NPTCL+3)*DOT(1,2))**2 + $ +2.*DOT(1,2)*DOT(2,3)*DOT(1,3) + IF(WT.LT.RANF()*PPTCL(5,IP)**6/108.) GO TO 220 + GO TO 300 + ENDIF +C +C V-A decays +C + IF(NADD.EQ.3.AND.MEIP.EQ.3) THEN +230 CALL DECPS1(IP,NADD,PGEN) + CALL DECPS2(IP,NADD,PGEN,PREST,BETA,GAMMA) + IF(.NOT.DECVA(IP,NADD,IDABS,PREST)) GO TO 230 + GO TO 300 + ENDIF +C +C Top decays +C Generate mass for TP -> W BT with Breit-Wigner. +C W couples to 1+2 so swap 1<->3. Then m2+m3 < m < m0-m1. +C + IF(NADD.EQ.3.AND.MEIP.EQ.4) THEN + WDECAY=.TRUE. + SWAP=PPTCL(5,NPTCL+1) + PPTCL(5,NPTCL+1)=PPTCL(5,NPTCL+3) + PPTCL(5,NPTCL+3)=SWAP + SMAX=(PPTCL(5,IP)-PPTCL(5,NPTCL+1))**2 + SMIN=(PPTCL(5,NPTCL+2)+PPTCL(5,NPTCL+3))**2 + TANMAX=ATAN((SMAX-WMASS(2)**2)/(WMASS(2)*WGAM(2))) + TANMIN=ATAN((SMIN-WMASS(2)**2)/(WMASS(2)*WGAM(2))) +240 TANVAL=RANF()*(TANMAX-TANMIN)+TANMIN + SVAL=WMASS(2)**2+WMASS(2)*WGAM(2)*TAN(TANVAL) + IF(SVAL.LT.SMIN.OR.SVAL.GT.SMAX) GO TO 240 + PGEN(5,2)=SQRT(SVAL) + PGEN(5,3)=PPTCL(5,NPTCL+3) + CALL DECPS2(IP,NADD,PGEN,PREST,BETA,GAMMA) + IF(.NOT.DECVA(IP,NADD,IDABS,PREST)) GO TO 240 + DO 241 K=1,5 + SWAP=PPTCL(K,NPTCL+1) + PPTCL(K,NPTCL+1)=PPTCL(K,NPTCL+3) + PPTCL(K,NPTCL+3)=SWAP +241 CONTINUE + PGEN(5,3)=PPTCL(5,NPTCL+3) + DO 242 K=1,4 + SWAP=PREST(K,1) + PREST(K,1)=PREST(K,3) + PREST(K,3)=SWAP +242 CONTINUE + GO TO 300 + ENDIF +C +C TAU decays. These are special because they take polarization +C into account. +C + IF(MEIP.EQ.5.OR.MEIP.EQ.6.OR.MEIP.EQ.7) THEN +250 CALL DECPS1(IP,NADD,PGEN) + CALL DECPS2(IP,NADD,PGEN,PREST,BETA,GAMMA) + IF(.NOT.DECTAU(IP,NADD,MEIP,IDABS,PREST)) GO TO 250 + GO TO 300 + ENDIF +C +C 3-body SUSY decays +C + IF(MEIP.LT.0.AND.NADD.EQ.3) THEN + MEA=IABS(MEIP) + IF(WTSS3(MEA).LE.0) THEN + DO 260 I=1,1000 + CALL DECPS1(IP,NADD,PGEN) + CALL DECPS2(IP,NADD,PGEN,PREST,BETA,GAMMA) + VAL=DECSS3(IP,MEA) + WTSS3(MEA)=MAX(WTSS3(MEA),VAL) +260 CONTINUE + IF(WTSS3(MEA).LE.0) GO TO 9998 + ENDIF +261 CALL DECPS1(IP,NADD,PGEN) + CALL DECPS2(IP,NADD,PGEN,PREST,BETA,GAMMA) + VAL=DECSS3(IP,MEA) + WTSS3(MEA)=MAX(WTSS3(MEA),VAL) + IF(VAL.LT.WTSS3(MEA)*RANF()) GO TO 261 + GO TO 300 + ENDIF +C +C Should never fall through +C + GO TO 9998 +C---------------------------------------------------------------------- +C Swap particles and antiparticles if IDENT(IP)<0 +C Note forced modes for antiparticles are conjugated in table. +C---------------------------------------------------------------------- +300 CONTINUE + IF(IDENT(IP).LT.0.AND.IDENT(IP).NE.-20) THEN + DO 310 I=1,NADD + ID1=IDENT(NPTCL+I) + IDENT(NPTCL+I)=IDANTI(ID1) +310 CONTINUE + ENDIF +C +C Set IORIG and IDCAY. +C + NPTCL=NPTCL+NADD + IDCAY(IP)=IPACK*NSTART+NPTCL + JETIP=IABS(IORIG(IP))/IPACK + DO 320 I=NSTART,NPTCL + IORIG(I)=IP + IDCAY(I)=0 +320 CONTINUE +C +C Evolve and hadronize partons. If it fails, start over. +C + IF(IDABS(NADD).LT.10.OR.MOD(IDENT(NPTCL),100).EQ.0) THEN + IF(.NOT.DECJET(IP,NADD,IDABS,PREST,WDECAY,BETA,GAMMA)) + $ GO TO 1 + ENDIF +C + RETURN +C---------------------------------------------------------------------- +C Error messages. +C---------------------------------------------------------------------- +9999 CALL PRTEVT(0) + WRITE(ITLIS,99990) NPTCL +99990 FORMAT(//5X,'ERROR IN DECAY...NPTCL > ',I6) + RETURN +9998 CALL PRTEVT(0) + WRITE(ITLIS,99980) IP +99980 FORMAT(//5X,'ERROR IN DECAY...NO DECAY FOUND FOR PARTICLE',I6) + RETURN + END diff --git a/ISAJET/code/decjet.F b/ISAJET/code/decjet.F new file mode 100644 index 00000000000..03454b1a7d8 --- /dev/null +++ b/ISAJET/code/decjet.F @@ -0,0 +1,380 @@ +#include "isajet/pilot.h" + LOGICAL FUNCTION DECJET(IP,NADD,IDABS,PREST,WDECAY,BETA,GAMMA) +C +C Auxiliary routine for DECAY. Evolve and hadronize partons. +C Check conservation laws. Return TRUE if OK, FALSE otherwise. +C +C IP = particle to be decayed. +C NADD = number of products (NPTCL+1, ..., NPTCL+NADD). +C IDABS = absolute values of decay IDENT's. +C PREST = 4-momenta in rest frame. +C WDECAY = logical flag for real W decay. +C BETA,GAMMA = boost parameters. +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/wcon.inc" +#include "isajet/partcl.inc" +#include "isajet/dkytab.inc" +#include "isajet/jetset.inc" +#include "isajet/jwork.inc" +#include "isajet/const.inc" +C + REAL PGEN(5,5),RND(5),U(3),BETA(3),IDQK(3),ROT(3,3),PSAVE(3) + 1,REDUCE(5),WPROP,Z,TRY,RANF,AMASS,TWOME,CHARGE + REAL PSUM(5),POLD(4),PNEW(4),SUM,WTMAX,SUM1,SUM2 + REAL PREST(4,6),PWREST(5),BETAW(3),DOT,PCM + REAL AMEE,REE,WTEE,SWAP,RNEW,WT,QCM,PHI,S12,S12MAX,GAMMAW,BP + REAL PJET,CTHQK,STHQK,CPHIQK,SPHIQK,SUMQ,A,B,C,GAMMA + REAL CHARGW + LOGICAL WDECAY + INTEGER IDLV1,IFL1,IFL2,IFL3,JSPIN,INDEX,IPOINT,ID1,I1,I2,I3 + INTEGER NADD,NSTART,NEW,NADD1,J,IP,I,IDABS(5),NEXT + INTEGER JJ1,II,K1,K,NJSAVE,NJSAV1,NJSAV2,NJ1,NPRTN,KK,NHDRN1 + INTEGER IFAIL,JSAVE,JETIP,JET,NJADD,NPTLV1,IDANTI,NPJET(5) + INTEGER NHDRN,NPJET3,NPTCLW,NPBEG(5) +C +C Copy decay products into /JETSET/ and do QCD evolution. +C + IF(NJSET+NADD.GT.MXJSET) GO TO 9998 + NJSAVE=NJSET + NSTART=NPTCL-NADD+1 + NPTCL=NSTART-1 + DO 100 I=1,NADD + NJSET=NJSET+1 + DO 110 K=1,4 +110 PJSET(K,NJSET)=PREST(K,I) + PJSET(5,NJSET)=PPTCL(5,NPTCL+I) + JORIG(NJSET)=JPACK*I + JTYPE(NJSET)=IDENT(NPTCL+I) + JDCAY(NJSET)=0 + JMATCH(NJSET)=JPACK*(NJSAVE+1)+NJSAVE+NADD +100 CONTINUE +C +C For heavy quarks match 1+2 and 3+(1+2). Boost 1+2 to rest. +C + IF(WDECAY) THEN + JMATCH(NJSAVE+1)=NJSAVE+2 + JMATCH(NJSAVE+2)=NJSAVE+1 + NJSET=NJSET+1 + DO 120 K=1,4 + PWREST(K)=PJSET(K,NJSAVE+1)+PJSET(K,NJSAVE+2) + PJSET(K,NJSET)=PWREST(K) +120 CONTINUE + PWREST(5)=SQRT(PWREST(4)**2-PWREST(1)**2-PWREST(2)**2 + $ -PWREST(3)**2) + PJSET(5,NJSET)=PWREST(5) + JMATCH(NJSAVE+3)=NJSAVE+4 + JMATCH(NJSAVE+4)=NJSAVE+3 + JORIG(NJSAVE+4)=-1 + IDLV1=JTYPE(NJSAVE+1) + CHARGW=CHARGE(IDLV1) + IDLV1=JTYPE(NJSAVE+2) + CHARGW=CHARGW+CHARGE(IDLV1) + JTYPE(NJSAVE+4)=80*SIGN(1.,CHARGW) + JDCAY(NJSAVE+4)=0 +C Boost W vectors to rest. + DO 130 K=1,3 +130 BETAW(K)=PWREST(K)/PWREST(4) + GAMMAW=PWREST(4)/PWREST(5) + NJSAV1=NJSAVE+1 + NJSAV2=NJSAVE+2 + DO 140 J=NJSAV1,NJSAV2 + BP=BETAW(1)*PJSET(1,J)+BETAW(2)*PJSET(2,J)+BETAW(3)*PJSET(3,J) + DO 141 K=1,3 +141 PJSET(K,J)=PJSET(K,J)-GAMMAW*BETAW(K)*(PJSET(4,J) + $ -BP*GAMMAW/(GAMMAW+1.)) + PJSET(4,J)=GAMMAW*(PJSET(4,J)-BP) +140 CONTINUE + ENDIF +C +C Do evolution and save new W momentum. Start from parent +C mass or NADD*energy. + NJSAV1=NJSAVE+1 + DO 150 J=NJSAV1,NJSET + IF(IABS(JTYPE(J)).LT.10.OR.MOD(JTYPE(J),100).EQ.0) THEN + JDCAY(J)=-1 + PJSET(5,J)=AMIN1(PPTCL(5,IP),NADD*PJSET(4,J)) + ENDIF +150 CONTINUE +C + CALL QCDJET(NJSAVE+1) +C + IF(WDECAY) THEN + PWREST(4)=PJSET(4,NJSAVE+4) + GAMMAW=PWREST(4)/PWREST(5) + DO 200 K=1,3 + PWREST(K)=PJSET(K,NJSAVE+4) + BETAW(K)=PWREST(K)/PWREST(4) +200 CONTINUE + ENDIF +C +C Put final partons in particle table - temporary IORIG. +C Also include virtual or real W momentum for quark decays. +C + NJ1=NJSAVE+1 + IF(WDECAY) THEN +C Real or virtual W. + NPTCL=NPTCL+1 + NPTCLW=NPTCL + DO 210 K=1,5 +210 PPTCL(K,NPTCL)=PJSET(K,NJSAVE+4) + IORIG(NPTCL)=IP + IDENT(NPTCL)=JTYPE(NJSAVE+4) + IDCAY(NPTCL)=0 +C Jet 3 + NPBEG(3)=NPTCL+1 + DO 220 J=NJ1,NJSET + IF(JDCAY(J).NE.0) GO TO 220 + IF(JORIG(J)/JPACK.NE.3) GO TO 220 + NPTCL=NPTCL+1 + DO 221 K=1,5 +221 PPTCL(K,NPTCL)=PJSET(K,J) + IORIG(NPTCL)=3*IPACK+IP + IDENT(NPTCL)=JTYPE(J) + IDCAY(NPTCL)=0 +220 CONTINUE +C Jets 1 and 2 + NPJET3=NPTCL + DO 230 JET=1,2 + NPBEG(JET)=NPTCL+1 + DO 240 J=NJ1,NJSET + IF(JDCAY(J).NE.0) GO TO 240 + IF(JORIG(J)/JPACK.NE.JET) GO TO 240 + NPTCL=NPTCL+1 + BP=BETAW(1)*PJSET(1,J)+BETAW(2)*PJSET(2,J) + $ +BETAW(3)*PJSET(3,J) + DO 241 K=1,3 +241 PPTCL(K,NPTCL)=PJSET(K,J)+GAMMAW*BETAW(K)*(PJSET(4,J) + $ +BP*GAMMAW/(GAMMAW+1.)) + PPTCL(4,NPTCL)=GAMMAW*(PJSET(4,J)+BP) + PPTCL(5,NPTCL)=PJSET(5,J) + IORIG(NPTCL)=IPACK*(JORIG(J)/JPACK)+NPTCLW + IDENT(NPTCL)=JTYPE(J) + IDCAY(NPTCL)=0 +240 CONTINUE +230 CONTINUE +C Quark decays to W plus jet 3; then W decays. + IDCAY(IP)=IPACK*NPTCLW+NPJET3 + IDCAY(NPTCLW)=IPACK*(NPJET3+1)+NPTCL + ELSE +C Not quark decay, so just copy partons. + DO 250 JET=1,NADD + NPBEG(JET)=NPTCL+1 + DO 260 J=NJ1,NJSET + IF(JDCAY(J).NE.0) GO TO 260 + IF(JORIG(J)/JPACK.NE.JET) GO TO 260 + NPTCL=NPTCL+1 + DO 261 K=1,5 +261 PPTCL(K,NPTCL)=PJSET(K,J) + IORIG(NPTCL)=IPACK*(JORIG(J)/JPACK)+IP + IDENT(NPTCL)=JTYPE(J) + IDCAY(NPTCL)=0 +260 CONTINUE +250 CONTINUE + IDCAY(IP)=NSTART*IPACK+NPTCL + ENDIF + NHDRN=NPTCL +C +C Hadronize quarks and rotate to proper angles. +C + DO 300 JET=1,NADD + NPRTN=NPBEG(JET)-1 + DO 310 I=NJ1,NJSET + IF(JDCAY(I).NE.0) GO TO 310 + IF(JORIG(I)/JPACK.NE.JET) GO TO 310 + NPRTN=NPRTN+1 + IF(IABS(JTYPE(I)).GE.10.AND.MOD(JTYPE(I),100).NE.0) + $ GO TO 330 +C +C Fragment parton: + NEXT=NPTCL+1 + PJET=SQRT(PJSET(1,I)**2+PJSET(2,I)**2+PJSET(3,I)**2) + CTHQK=PJSET(3,I)/PJET + STHQK=1.-CTHQK**2 + IF(STHQK.LT.1) THEN + STHQK=SQRT(STHQK) + CPHIQK=PJSET(1,I)/(PJET*STHQK) + SPHIQK=PJSET(2,I)/(PJET*STHQK) + ELSE + STHQK=0 + CPHIQK=1 + SPHIQK=0 + ENDIF + CALL JETGEN(I) + IF(NEXT.GT.NPTCL) GO TO 310 + ROT(1,1)=CPHIQK*CTHQK + ROT(2,1)=SPHIQK*CTHQK + ROT(3,1)=-STHQK + ROT(1,2)=-SPHIQK + ROT(2,2)=CPHIQK + ROT(3,2)=0. + ROT(1,3)=CPHIQK*STHQK + ROT(2,3)=SPHIQK*STHQK + ROT(3,3)=CTHQK +C + DO 320 II=NEXT,NPTCL + DO 321 K=1,3 + PSAVE(K)=PPTCL(K,II) + PPTCL(K,II)=0. +321 CONTINUE + DO 322 K=1,3 + DO 322 KK=1,3 +322 PPTCL(K,II)=PPTCL(K,II)+ROT(K,KK)*PSAVE(KK) + IORIG(II)=IPACK*JET+NPRTN + IDCAY(II)=0 +320 CONTINUE + IDCAY(NPRTN)=NEXT*IPACK+NPTCL + GO TO 310 +C +C or add lepton: +330 NPTCL=NPTCL+1 + DO 331 K=1,5 +331 PPTCL(K,NPTCL)=PJSET(K,I) + IORIG(NPTCL)=IPACK*JET+NPRTN + IDENT(NPTCL)=JTYPE(I) + IDCAY(NPTCL)=0 + IDCAY(NPRTN)=NPTCL*IPACK+NPTCL +310 CONTINUE + NPJET(JET)=NPTCL +300 CONTINUE +C +C Reset NJSET so decay jets do not appear in /JETSET/ + NJADD=NJSET + NJSET=NJSAVE +C +C Check for at least two particles + IF(NPTCL.LT.NHDRN+2) THEN + NPTCL=NSTART-1 + DECJET=.FALSE. + RETURN + ENDIF +C +C Conserve charge +C + SUMQ=0. + NHDRN1=NHDRN+1 + DO 400 I=NHDRN1,NPTCL + IDLV1=IDENT(I) + SUMQ=SUMQ+CHARGE(IDLV1) +400 CONTINUE + IDLV1=IDENT(IP) + SUMQ=SUMQ-CHARGE(IDLV1) +C + IF(SUMQ.EQ.0.) GO TO 500 +C +C Charge wrong--fix it by swapping UP and DN quarks. + DO 410 I=NHDRN1,NPTCL + ID1=IDENT(I) + IF(IABS(ID1).GT.1000) GO TO 410 + I1=MOD(IABS(ID1)/100,10) + I2=MOD(IABS(ID1)/10,10) + I3=MOD(IABS(ID1),10) + IF(I1.EQ.1.AND.I2.GT.2.AND.SUMQ*ID1.GT.0.) THEN + IDENT(I)=ISIGN(200+10*I2+I3,ID1) + ELSEIF(I1.EQ.2.AND.I2.GT.2.AND.SUMQ*ID1.LT.0.) THEN + IDENT(I)=ISIGN(100+10*I2+I3,ID1) + ELSEIF(I1.EQ.1.AND.I2.EQ.2.AND.SUMQ*ID1.GT.0.) THEN + IDENT(I)=110+I3 + ELSEIF(I1.EQ.1.AND.I2.EQ.1) THEN + IDENT(I)=(120+I3)*(-SIGN(1.,SUMQ)) + ELSE + GO TO 410 + ENDIF + SUMQ=SIGN(ABS(SUMQ)-1.,SUMQ) + IDLV1=IDENT(I) + PPTCL(5,I)=AMASS(IDLV1) + PPTCL(4,I)=SQRT(PPTCL(1,I)**2+PPTCL(2,I)**2+PPTCL(3,I)**2 + $ +PPTCL(5,I)**2) +C Sum cannot vanish for fractionally charged initial particle. + IF(ABS(SUMQ).LT.1.) GO TO 500 +410 CONTINUE +C Failed to conserve charge. + NPTCL=NSTART-1 + DECJET=.FALSE. + RETURN +C +C Rescale momenta for correct mass +C +500 CONTINUE + IF(WDECAY) THEN +C Quark decay. First rescale jet3 + W + DO 510 K=1,5 +510 PPTCL(K,NPTCL+1)=PPTCL(K,NPTCLW) + NPTLV1=NPTCL+1 + DO 520 K=1,3 +520 PSUM(K)=0. + PSUM(4)=PPTCL(5,IP) + PSUM(5)=PSUM(4) + CALL RESCAL(NPJET(2)+1,NPTLV1,PSUM,IFAIL) + IF(IFAIL.NE.0) THEN + NPTCL=NSTART-1 + DECJET=.FALSE. + RETURN + ENDIF + DO 530 K=1,3 +530 BETAW(K)=PPTCL(K,NPTCL+1)/PPTCL(4,NPTCL+1) + GAMMAW=PPTCL(4,NPTCL+1)/PPTCL(5,NPTCL+1) +C Then rescale W + PSUM(4)=PPTCL(5,NPTCLW) + PSUM(5)=PSUM(4) + CALL RESCAL(NHDRN1,NPJET(2),PSUM,IFAIL) + IF(IFAIL.NE.0) THEN + NPTCL=NSTART-1 + DECJET=.FALSE. + RETURN + ENDIF + ELSE +C General decay with no W. + DO 550 K=1,3 +550 PSUM(K)=0. + PSUM(4)=PPTCL(5,IP) + PSUM(5)=PSUM(4) + NPTLV1=NPTCL + CALL RESCAL(NHDRN1,NPTLV1,PSUM,IFAIL) + IF(IFAIL.NE.0) THEN + NPTCL=NSTART-1 + DECJET=.FALSE. + RETURN + ENDIF + ENDIF +C +C Boost back to lab frame. Reset IORIG. +C + IF(WDECAY) THEN + DO 600 I=NHDRN1,NPTCL + JET=IORIG(I)/IPACK + IF(JET.NE.1.AND.JET.NE.2) GO TO 600 + BP=BETAW(1)*PPTCL(1,I)+BETAW(2)*PPTCL(2,I)+BETAW(3)*PPTCL(3,I) + DO 610 J=1,3 +610 PPTCL(J,I)=PPTCL(J,I)+GAMMAW*BETAW(J)*(PPTCL(4,I) + $ +BP*GAMMAW/(GAMMAW+1.)) + PPTCL(4,I)=GAMMAW*(PPTCL(4,I)+BP) +600 CONTINUE + ENDIF +C + DO 620 I=NSTART,NPTCL + IORIG(I)=MOD(IORIG(I),IPACK) + BP=BETA(1)*PPTCL(1,I)+BETA(2)*PPTCL(2,I)+BETA(3)*PPTCL(3,I) + DO 621 J=1,3 + PPTCL(J,I)=PPTCL(J,I)+GAMMA*BETA(J)*(PPTCL(4,I) + $ +BP*GAMMA/(GAMMA+1.)) +621 CONTINUE + PPTCL(4,I)=GAMMA*(PPTCL(4,I)+BP) +620 CONTINUE +C +C Normal exit +C + DECJET=.TRUE. + RETURN +C +C Error messages. +C +9998 DECJET=.FALSE. + CALL PRTEVT(0) + WRITE(ITLIS,99980) NJSET +99980 FORMAT(//5X,'ERROR IN DECJET...NJSET > ',I5) + RETURN + END diff --git a/ISAJET/code/decps1.F b/ISAJET/code/decps1.F new file mode 100644 index 00000000000..1b5131ea365 --- /dev/null +++ b/ISAJET/code/decps1.F @@ -0,0 +1,75 @@ +#include "isajet/pilot.h" + SUBROUTINE DECPS1(IP,NADD,PGEN) +C +C Generate masses for uniform NADD-body phase space in DECPS2. +C Auxiliary routine for DECAY. +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +C +#include "isajet/itapes.inc" +#include "isajet/partcl.inc" +C + INTEGER IP,NADD + REAL PGEN(5,5) + REAL REDUCE(5),RND(5) + REAL RANF,PCM,DBLPCM + REAL WTMAX,SUM1,SUM2,SUM,RNEW,WT,A,B,C + INTEGER I,NADD1,J,I1,JJ1,JSAVE +C +C Function definitions. +C +#if defined(CERNLIB_SINGLE) + PCM(A,B,C)=SQRT((A-B-C)*(A+B+C)*(A-B+C)*(A+B-C))/(2.*A) +#endif +#if defined(CERNLIB_DOUBLE) + PCM(A,B,C)=DBLPCM(A,B,C) +#endif +C + DATA REDUCE/1.,1.,2.,5.,15./ +C +C Calculate maximum phase-space weight. +C + IF(NADD.LE.2) RETURN + NADD1=NADD-1 + WTMAX=1./REDUCE(NADD) + SUM=0 + DO 100 I=1,NADD + SUM=SUM+PPTCL(5,NPTCL+I) +100 CONTINUE + SUM1=PGEN(5,1) + SUM2=SUM-PPTCL(5,NPTCL+1) + DO 110 I=1,NADD1 + WTMAX=WTMAX*PCM(SUM1,SUM2,PPTCL(5,NPTCL+I)) + SUM1=SUM1-PPTCL(5,NPTCL+I) + SUM2=SUM2-PPTCL(5,NPTCL+I+1) +110 CONTINUE +C +C Generate masses for uniform NADD-body phase space. +C +200 CONTINUE + RND(1)=1. + DO 210 I=2,NADD1 + RNEW=RANF() + I1=I-1 + DO 220 JJ1=1,I1 + J=I-JJ1 + JSAVE=J+1 + IF(RNEW.LE.RND(J)) GO TO 210 + RND(JSAVE)=RND(J) +220 CONTINUE +210 RND(JSAVE)=RNEW + RND(NADD)=0. + WT=1. + SUM1=SUM + DO 230 I=2,NADD + SUM1=SUM1-PPTCL(5,NPTCL+I-1) + PGEN(5,I)=SUM1+RND(I)*(PGEN(5,1)-SUM) + IF(PGEN(5,I-1).LE.PGEN(5,I)+PPTCL(5,NPTCL+I-1)) GO TO 200 + WT=WT*PCM(PGEN(5,I-1),PGEN(5,I),PPTCL(5,NPTCL+I-1)) +230 CONTINUE + IF(WT.LT.RANF()*WTMAX) GO TO 200 +C + RETURN + END diff --git a/ISAJET/code/decps2.F b/ISAJET/code/decps2.F new file mode 100644 index 00000000000..8c1a60d2407 --- /dev/null +++ b/ISAJET/code/decps2.F @@ -0,0 +1,76 @@ +#include "isajet/pilot.h" + SUBROUTINE DECPS2(IP,NADD,PGEN,PREST,BETA,GAMMA) +C +C Carry out decays using masses from DECPS1 or special matrix +C elements. +C Auxiliary routine for DECAY. +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +C +#include "isajet/itapes.inc" +#include "isajet/partcl.inc" +#include "isajet/const.inc" +C + INTEGER IP,NADD + REAL PGEN(5,5),PREST(4,6) + REAL PCM,DBLPCM,RANF + REAL U(3),BETA(3) + REAL QCM,PHI,A,B,C,GAMMA,BP + INTEGER I,J,NADD1,II,K,K1 +C +C Function definitions. +C +#if defined(CERNLIB_SINGLE) + PCM(A,B,C)=SQRT((A-B-C)*(A+B+C)*(A-B+C)*(A+B-C))/(2.*A) +#endif +#if defined(CERNLIB_DOUBLE) + PCM(A,B,C)=DBLPCM(A,B,C) +#endif +C +C Carry out two-body decays in PGEN frames. +C + NADD1=NADD-1 +100 CONTINUE + DO 110 I=1,NADD1 + QCM=PCM(PGEN(5,I),PGEN(5,I+1),PPTCL(5,NPTCL+I)) + U(3)=2.*RANF()-1. + PHI=2.*PI*RANF() + U(1)=SQRT(1.-U(3)**2)*COS(PHI) + U(2)=SQRT(1.-U(3)**2)*SIN(PHI) + DO 120 J=1,3 + PPTCL(J,NPTCL+I)=QCM*U(J) + PGEN(J,I+1)=-PPTCL(J,NPTCL+I) +120 CONTINUE + PPTCL(4,NPTCL+I)=SQRT(QCM**2+PPTCL(5,NPTCL+I)**2) + PGEN(4,I+1)=SQRT(QCM**2+PGEN(5,I+1)**2) +110 CONTINUE +C + DO 130 J=1,4 + PPTCL(J,NPTCL+NADD)=PGEN(J,NADD) +130 CONTINUE +C +C Boost PGEN frames to lab frame, saving momenta in rest frame. +C + DO 200 II=1,NADD1 + I=NADD-II + DO 210 J=1,3 + BETA(J)=PGEN(J,I)/PGEN(4,I) +210 CONTINUE + GAMMA=PGEN(4,I)/PGEN(5,I) + DO 220 K=I,NADD + K1=NPTCL+K + BP=BETA(1)*PPTCL(1,K1)+BETA(2)*PPTCL(2,K1)+BETA(3)*PPTCL(3,K1) + DO 230 J=1,3 + PREST(J,K)=PPTCL(J,K1) + PPTCL(J,K1)=PPTCL(J,K1)+GAMMA*BETA(J)*(PPTCL(4,K1) + $ +BP*GAMMA/(GAMMA+1.)) +230 CONTINUE + PREST(4,K)=PPTCL(4,K1) + PPTCL(4,K1)=GAMMA*(PPTCL(4,K1)+BP) +220 CONTINUE +200 CONTINUE +C + RETURN + END diff --git a/ISAJET/code/decss3.F b/ISAJET/code/decss3.F new file mode 100644 index 00000000000..5ab808fbd86 --- /dev/null +++ b/ISAJET/code/decss3.F @@ -0,0 +1,163 @@ +#include "isajet/pilot.h" + FUNCTION DECSS3(IP,MEA) +C +C Compute matrix element for mode MEA of particle IP using +C poles and couplings in /DKYSS3/. +C Auxiliary routine for DECAY. +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +C +#include "isajet/itapes.inc" +#include "isajet/partcl.inc" +#include "isajet/const.inc" +#include "isajet/dkyss3.inc" +C + LOGICAL KIN(4),KINP(4) + INTEGER IP,MEA,I,J,JP,II,PTYPE1,PTYPE2 + REAL DECSS3 + REAL AM0SQ,AM1SQ,AM2SQ,AM3SQ,S12,S13,S23 + REAL D12,D13,D23,D01,D02,D03,AS,BS,CS,DS,MSQ + REAL DOT4 + COMPLEX A,B,C,D,AC,BC,CC,DC,AP,BP,CP,DP,APC,BPC,CPC,DPC,MMPD +C + DOT4(I,J)=PPTCL(4,I)*PPTCL(4,J)-PPTCL(1,I)*PPTCL(1,J)- + $PPTCL(2,I)*PPTCL(2,J)-PPTCL(3,I)*PPTCL(3,J) +C +C Kinematics +C + AM0SQ=PPTCL(5,IP)**2 + AM1SQ=PPTCL(5,NPTCL+1)**2 + AM2SQ=PPTCL(5,NPTCL+2)**2 + AM3SQ=PPTCL(5,NPTCL+3)**2 + D12=DOT4(NPTCL+1,NPTCL+2) + D13=DOT4(NPTCL+1,NPTCL+3) + D23=DOT4(NPTCL+2,NPTCL+3) + D01=DOT4(IP,NPTCL+1) + D02=DOT4(IP,NPTCL+2) + D03=DOT4(IP,NPTCL+3) + S12=2*D12+AM1SQ+AM2SQ + S13=2*D13+AM1SQ+AM3SQ + S23=2*D23+AM2SQ+AM3SQ +C +C Generic matrix element +C +C Loop over diagrams + DECSS3=0. + DO J=J1SS3(MEA),J2SS3(MEA) + PTYPE1=KSS3(J) + A=ZISS3(1,J) + B=ZISS3(2,J) + C=ZFSS3(1,J) + D=ZFSS3(2,J) + AC=CONJG(A) + BC=CONJG(B) + CC=CONJG(C) + DC=CONJG(D) + AS=A*AC + BS=B*BC + CS=C*CC + DS=D*DC + DO JP=J,J2SS3(MEA) + MSQ=0. + DO II=1,4 + KIN(II)=.FALSE. + KINP(II)=.FALSE. + END DO + IF ((PPTCL(5,IP)-PPTCL(5,NPTCL+1)).LT.AMSS3(J)) KIN(1)=.TRUE. + IF ((PPTCL(5,IP)-PPTCL(5,NPTCL+3)).LT.AMSS3(J)) KIN(2)=.TRUE. + IF ((PPTCL(5,IP)-PPTCL(5,NPTCL+2)).LT.AMSS3(J)) KIN(3)=.TRUE. + IF ((PPTCL(5,IP)-PPTCL(5,NPTCL+1)).LT.AMSS3(J)) KIN(4)=.TRUE. + IF ((PPTCL(5,IP)-PPTCL(5,NPTCL+1)).LT.AMSS3(JP)) KINP(1)=.TRUE. + IF ((PPTCL(5,IP)-PPTCL(5,NPTCL+3)).LT.AMSS3(JP)) KINP(2)=.TRUE. + IF ((PPTCL(5,IP)-PPTCL(5,NPTCL+2)).LT.AMSS3(JP)) KINP(3)=.TRUE. + IF ((PPTCL(5,IP)-PPTCL(5,NPTCL+1)).LT.AMSS3(JP)) KINP(4)=.TRUE. + IF (J.EQ.JP) THEN + IF (PTYPE1.EQ.1.AND.KIN(1)) THEN + MSQ=32*(((AS+BS)*(CS+DS)+4*REAL(A*BC*C*DC))*D03*D12+ + $ ((AS+BS)*(CS+DS)-4*REAL(A*BC*C*DC))*D02*D13+ + $ (BS-AS)*(CS+DS)*SQRT(AM0SQ*AM1SQ)*D23)/ + $ (S23-AMSS3(J)**2)**2 + ELSE IF (PTYPE1.EQ.2.AND.KIN(2)) THEN + MSQ=16*(AS+BS)*(CS+DS)*D03*D12/(S12-AMSS3(J)**2)**2 + ELSE IF (PTYPE1.EQ.3.AND.KIN(3)) THEN + MSQ=16*(AS+BS)*(CS+DS)*D02*D13/(S13-AMSS3(J)**2)**2 + ELSE IF (PTYPE1.EQ.4.AND.KIN(4)) THEN + MSQ=16*((AS+BS)*(CS+DS)*D01*D23+(AS-BS)*(CS+DS)*D23* + $ SQRT(AM0SQ*AM1SQ))/(S23-AMSS3(J)**2)**2 + END IF + END IF + IF (J.NE.JP) THEN + PTYPE2=KSS3(JP) + AP=ZISS3(1,JP) + BP=ZISS3(2,JP) + CP=ZFSS3(1,JP) + DP=ZFSS3(2,JP) + APC=CONJG(AP) + BPC=CONJG(BP) + CPC=CONJG(CP) + DPC=CONJG(DP) + IF (PTYPE1.EQ.2.AND.PTYPE2.EQ.2.AND.KIN(2).AND.KINP(2)) THEN + MMPD=16*D12*D03*(A*APC+B*BPC)*(C*CPC+D*DPC)/ + $ (S12-AMSS3(J)**2)/(S12-AMSS3(JP)**2) + MSQ=2*REAL(MMPD) + END IF + IF (PTYPE1.EQ.3.AND.PTYPE2.EQ.3.AND.KIN(3).AND.KINP(3)) THEN + MMPD=16*D13*D02*(A*APC+B*BPC)*(C*CPC+D*DPC)/ + $ (S13-AMSS3(J)**2)/(S13-AMSS3(JP)**2) + MSQ=2*REAL(MMPD) + END IF + IF (PTYPE1.EQ.4.AND.PTYPE2.EQ.4.AND.KIN(4).AND.KINP(4)) THEN + MMPD=16*D23*(D01*(A*APC+B*BPC)*(C*CPC+D*DPC)+ + $ SQRT(AM0SQ*AM1SQ)*(A*APC-B*BPC)*(C*CPC-D*DPC))/ + $ (S23-AMSS3(J)**2)/(S23-AMSS3(JP)**2) + MSQ=2*REAL(MMPD) + END IF + IF (PTYPE1.EQ.1.AND.PTYPE2.EQ.3.AND.KIN(1).AND.KINP(3)) THEN + MMPD=(16*D13*D02*((A*C-B*D)*(-APC*CPC+BPC*DPC)+ + $ (A*D-B*C)*(APC*DPC-BPC*CPC))+ + $ 8*D23*SQRT(AM0SQ*AM1SQ)*((A*C+B*D)*(APC*CPC-BPC*DPC)- + $ (A*D+B*C)*(APC*DPC-BPC*CPC)))/ + $ (S23-AMSS3(J)**2)/(S13-AMSS3(JP)**2) + MSQ=2*REAL(MMPD) + END IF + IF (PTYPE1.EQ.1.AND.PTYPE2.EQ.2.AND.KIN(1).AND.KINP(2)) THEN + MMPD=(16*D12*D03*((A*C+B*D)*(-APC*CPC+BPC*DPC)+ + $ (A*D+B*C)*(APC*DPC-BPC*CPC))+ + $ 8*D23*SQRT(AM0SQ*AM1SQ)*((A*C-B*D)*(APC*CPC-BPC*DPC)+ + $ (-A*D+B*C)*(APC*DPC+BPC*CPC)))/ + $ (S23-AMSS3(J)**2)/(S12-AMSS3(JP)**2) + MSQ=2*REAL(MMPD) + END IF + IF (PTYPE1.EQ.3.AND.PTYPE2.EQ.4.AND.KIN(3).AND.KINP(4)) THEN + MMPD=((8*D13*D23+4*D23*AM1SQ)*((A*C+B*D)*(APC*CPC+BPC*DPC)+ + $ (A*D+B*C)*(APC*DPC+BPC*CPC))+ + $ 4*D23*SQRT(AM0SQ*AM1SQ)*((A*C+B*D)*(APC*CPC-BPC*DPC)+ + $ (A*D+B*C)*(APC*DPC-BPC*CPC)))/ + $ (S13-AMSS3(J)**2)/(S23-AMSS3(JP)**2) + MSQ=2*REAL(MMPD) + END IF + IF (PTYPE1.EQ.2.AND.PTYPE2.EQ.4.AND.KIN(2).AND.KINP(4)) THEN + MMPD=-((8*D12*D23+4*D23*AM1SQ)*((A*C+B*D)*(APC*CPC+BPC*DPC)+ + $ (A*D+B*C)*(APC*DPC+BPC*CPC))+ + $ 4*D23*SQRT(AM0SQ*AM1SQ)*((A*C+B*D)*(APC*CPC-BPC*DPC)+ + $ (A*D+B*C)*(APC*DPC-BPC*CPC)))/ + $ (S12-AMSS3(J)**2)/(S23-AMSS3(JP)**2) + MSQ=2*REAL(MMPD) + END IF + IF (PTYPE1.EQ.2.AND.PTYPE2.EQ.3.AND.KIN(2).AND.KINP(3)) THEN + MMPD=((8*D12*D13-4*D23*AM1SQ)*((A*C+B*D)*(APC*CPC+BPC*DPC)+ + $ (A*D+B*C)*(APC*DPC+BPC*CPC))- + $ 4*D23*SQRT(AM0SQ*AM1SQ)*((A*C-B*D)*(APC*CPC-BPC*DPC)+ + $ (A*D-B*C)*(APC*DPC-BPC*CPC)))/ + $ (S12-AMSS3(J)**2)/(S13-AMSS3(JP)**2) + MSQ=2*REAL(MMPD) + END IF + END IF + DECSS3=DECSS3+MSQ + END DO + END DO +C + RETURN + END diff --git a/ISAJET/code/dectau.F b/ISAJET/code/dectau.F new file mode 100644 index 00000000000..b2b73256e9a --- /dev/null +++ b/ISAJET/code/dectau.F @@ -0,0 +1,190 @@ +#include "isajet/pilot.h" + LOGICAL FUNCTION DECTAU(IP,NADD,MEIP,IDABS,PREST) +C +C Compute matrix elements for polarized tau decay. +C Polarization determined by tau parent. +C Auxiliary routine for DECAY. +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/wcon.inc" +#include "isajet/partcl.inc" +#include "isajet/dkytab.inc" +#include "isajet/const.inc" +#include "isajet/pjets.inc" +#include "isajet/keys.inc" +#include "isajet/xmssm.inc" +#include "isajet/sspols.inc" +#include "isajet/primar.inc" +C + REAL PREST(4,6),WT,TAUHEL,S12,S12MAX,PIP,CTHNU,PSUM(4),AMV2,WT1 + REAL DOT,DOT3,RANF,Z + INTEGER IP,NADD,IDABS(5),IPAR,IDPAR,JET,INU,I,K,I1,I2,IDSIB + INTEGER IDLV1,IFL1,IFL2,IFL3,JSPIN,INDEX,IDIP + INTEGER MEIP,IPX,IP1,IP2 +C + DOT(I1,I2)=PREST(4,I1)*PREST(4,I2)-PREST(1,I1)*PREST(1,I2) + $-PREST(2,I1)*PREST(2,I2)-PREST(3,I1)*PREST(3,I2) + DOT3(I1,I2)=PREST(1,I1)*PREST(1,I2)+PREST(2,I1)*PREST(2,I2) + $+PREST(3,I1)*PREST(3,I2) +C + IDIP=IDENT(IP) + DECTAU=.TRUE. + IF(IABS(IDIP).NE.16) GO TO 999 +C +C Use PREST(K,6) for spin vector +C + PIP=SQRT(PPTCL(1,IP)**2+PPTCL(2,IP)**2+PPTCL(3,IP)**2) + DO 100 K=1,3 + PREST(K,6)=PPTCL(K,IP)/PIP +100 CONTINUE + PREST(4,6)=0. +C +C Take helicity TAUHEL=0 unless TAU parent is TP, W+-, H+-, +C or some SUSY particles. +C Take account of 1-particle decays! +C + + IPX=IP + TAUHEL=0. + IPAR=0 + IDPAR=0 +110 IF(IORIG(IPX).GT.0) THEN + IPAR=MOD(IORIG(IPX),IPACK) + IDPAR=IDENT(IPAR) + IF(IDPAR.EQ.IDIP) THEN + IP1=IDCAY(IPAR)/IPACK + IP2=MOD(IDCAY(IPAR),IPACK) + IF(IP1.EQ.IP2) THEN + IPX=IPAR + GO TO 110 + ENDIF + ENDIF + IDPAR=IABS(IDPAR) + IDSIB=0 +C W/top parent + IF(IDPAR.GT.100.AND.MOD(IDPAR/10,10).GE.6) THEN + TAUHEL=-1. + ELSEIF(IDPAR.EQ.80) THEN + TAUHEL=-1. +C Charged Higgs parent + ELSEIF(IDPAR.EQ.86) THEN + TAUHEL=+1. +C SUSY parent - polarization also depends on sibling IDSIB + ELSEIF(GOMSSM.AND.IDPAR.GT.20.AND.IDPAR.LT.80) THEN + I1=IDCAY(IPAR)/IPACK + I2=MOD(IDCAY(IPAR),IPACK) + DO 120 I=I1,I2 + IF(IABS(IDENT(I)).GT.20.AND.IABS(IDENT(I)).LT.80) + $ IDSIB=IABS(IDENT(I)) +120 CONTINUE + IF (IDPAR.EQ.35) THEN + TAUHEL=-1. + ELSEIF (IDPAR.EQ.36) THEN + IF (IDSIB.EQ.30) TAUHEL=PTAU1(1) + IF (IDSIB.EQ.40) TAUHEL=PTAU1(2) + IF (IDSIB.EQ.50) TAUHEL=PTAU1(3) + IF (IDSIB.EQ.60) TAUHEL=PTAU1(4) + ELSEIF (IDPAR.EQ.56) THEN + IF (IDSIB.EQ.30) TAUHEL=PTAU2(1) + IF (IDSIB.EQ.40) TAUHEL=PTAU2(2) + IF (IDSIB.EQ.50) TAUHEL=PTAU2(3) + IF (IDSIB.EQ.60) TAUHEL=PTAU2(4) + ELSEIF (IDPAR.EQ.39) THEN + IF(IDSIB.EQ.35) TAUHEL=-1. + IF(IDSIB.EQ.30) TAUHEL=PTAUWZ + ELSEIF (IDPAR.EQ.49.AND.IDSIB.EQ.35) THEN + TAUHEL=-1. + ELSEIF (IDPAR.EQ.40) THEN + IF(IDSIB.EQ.36) TAUHEL=PTAUZ2(1) + IF(IDSIB.EQ.56) TAUHEL=PTAUZ2(2) + IF(IDSIB.EQ.30) TAUHEL=PTAUZZ + ELSEIF (IDPAR.EQ.50) THEN + IF(IDSIB.EQ.36) TAUHEL=PTAUZ3(1) + IF(IDSIB.EQ.56) TAUHEL=PTAUZ3(2) + ELSEIF (IDPAR.EQ.60) THEN + IF(IDSIB.EQ.36) TAUHEL=PTAUZ4(1) + IF(IDSIB.EQ.56) TAUHEL=PTAUZ4(2) + ENDIF + END IF + ELSE + IF(KEYS(3)) THEN + IF(IABS(IDENTW).EQ.80) TAUHEL=-1. + ELSE + JET=IABS(IORIG(IP))/IPACK + IF(JET.GT.0.AND.JET.LE.NJET) THEN + IF(IDJETS(JET).EQ.80) TAUHEL=-1. + ENDIF + ENDIF + ENDIF +C +C Leptonic decays. DECTAU is always called for TAU- decay +C products, so selection is independent of IDENT(IP). +C + IF(MEIP.EQ.5) THEN + IF(IDENT(NPTCL+1).LT.0) THEN + WT=PPTCL(5,IP)*(PREST(4,1)-TAUHEL*DOT(1,6))*DOT(2,3) + ELSEIF(IDENT(NPTCL+2).LT.0) THEN + WT=PPTCL(5,IP)*(PREST(4,2)-TAUHEL*DOT(2,6))*DOT(1,3) + ELSE + WT=PPTCL(5,IP)*(PREST(4,3)-TAUHEL*DOT(3,6))*DOT(1,2) + ENDIF + IF(WT.LT.RANF()*PPTCL(5,IP)**4/8.) THEN + DECTAU=.FALSE. + ELSE + DECTAU=.TRUE. + ENDIF + RETURN +C +C Decay to PI + NUT, K + NUT +C + ELSEIF(MEIP.EQ.6) THEN + INU=1 + IF(IDABS(2).EQ.15) INU=2 + CTHNU=DOT3(INU,6)/SQRT(DOT3(INU,INU)) + WT=1.-TAUHEL*CTHNU + IF(WT.LT.RANF()*2.) THEN + DECTAU=.FALSE. + ELSE + DECTAU=.TRUE. + ENDIF + RETURN +C +C Decay to RHO + NUT, A1 + NUT, K* + NUT +C + ELSEIF(MEIP.EQ.7) THEN + DO 210 I=1,NADD +210 IF(IDABS(I).EQ.15) INU=I + DO 220 K=1,4 + PSUM(K)=0. + DO 221 I=1,NADD + IF(I.EQ.INU) GO TO 221 + PSUM(K)=PSUM(K)+PREST(K,I) +221 CONTINUE +220 CONTINUE + AMV2=PSUM(4)**2-PSUM(1)**2-PSUM(2)**2-PSUM(3)**2 + WT1=2.*AMV2/(2.*AMV2+PPTCL(5,IP)**2) + CTHNU=DOT3(INU,6)/SQRT(DOT3(INU,INU)) + WT=WT1*(1.+TAUHEL*CTHNU)+(1.-WT1)*(1-TAUHEL*CTHNU) + IF(WT.LT.RANF()*2.) THEN + DECTAU=.FALSE. + ELSE + DECTAU=.TRUE. + ENDIF + RETURN +C +C Ignore matrix element for all other decays +C + ELSE + DECTAU=.TRUE. + RETURN + ENDIF +C +C Error +C +999 CALL PRTEVT(0) + WRITE(ITLIS,99999) IP +99999 FORMAT(//5X,'ERROR IN DECTAU FOR PARTICLE',I6) + END diff --git a/ISAJET/code/decva.F b/ISAJET/code/decva.F new file mode 100644 index 00000000000..64b9cf3ecf7 --- /dev/null +++ b/ISAJET/code/decva.F @@ -0,0 +1,44 @@ +#include "isajet/pilot.h" + LOGICAL FUNCTION DECVA(IP,NADD,IDABS,PREST) +C +C Compute matrix element unpolarized for V-A. +C Auxiliary routine for DECAY. +C +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/wcon.inc" +#include "isajet/partcl.inc" +#include "isajet/dkytab.inc" +#include "isajet/jetset.inc" +#include "isajet/jwork.inc" +#include "isajet/const.inc" +#include "isajet/keys.inc" +#include "isajet/pjets.inc" +#include "isajet/xmssm.inc" +#include "isajet/sspols.inc" +C + REAL PREST(4,6) + REAL DOT,RANF,WT + INTEGER IP,NADD,IDABS(5),I,K,I1,I2,IDIPA +C + DOT(I1,I2)=PREST(4,I1)*PREST(4,I2)-PREST(1,I1)*PREST(1,I2) + $-PREST(2,I1)*PREST(2,I2)-PREST(3,I1)*PREST(3,I2) +C + IDIPA=IABS(IDENT(IP)) + IF(IDENT(NPTCL+1).LT.0) THEN + WT=PPTCL(5,IP)*PREST(4,1)*DOT(2,3) + ELSEIF(IDENT(NPTCL+2).LT.0) THEN + WT=PPTCL(5,IP)*PREST(4,2)*DOT(1,3) + ELSE + WT=PPTCL(5,IP)*PREST(4,3)*DOT(1,2) + ENDIF + IF(WT.LT.RANF()*PPTCL(5,IP)**4/16.) THEN + DECVA=.FALSE. + ELSE + DECVA=.TRUE. + ENDIF + RETURN + END diff --git a/ISAJET/code/dhelas.F b/ISAJET/code/dhelas.F new file mode 100644 index 00000000000..17058afc197 --- /dev/null +++ b/ISAJET/code/dhelas.F @@ -0,0 +1,3748 @@ +#include "isajet/pilot.h" +C ********************************************************************* +C *** *** +C *** coded by H. Murayama & I. Watanabe *** +C *** For the formalism and notations, see the following reference: *** +C *** H. Murayama, I. Watanabe and K. Hagiwara *** +C *** "HELAS: HELicity Amplitude Subroutines *** +C *** for Feynman diagram evaluation" *** +C *** KEK Report 91-11, December 1991 *** +C *** *** +C ********************************************************************* +C +C Converted to double precision by W. Long and T. Seltzer for MadGraph. +C +C Minor changes for portability by FEP, July 1999. The code is not ANSI +C standard, but that cannot be helped if MadGraph compatibility is to +C be maintained. +C +C ====================================================================== +C + SUBROUTINE BOOSTX(P,Q , PBOOST) +C +C this subroutine performs the lorentz boost of a four-momentum. the +C momentum p is assumed to be given in the rest frame of q. pboost is +C the momentum p boosted to the frame in which q is given. q must be a +C timelike momentum. +C +C input: +C real p(0:3) : four-momentum p in the q rest frame +C real q(0:3) : four-momentum q in the boosted frame +C +C output: +C real pboost(0:3) : four-momentum p in the boosted frame +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + REAL*8 P(0:3),Q(0:3),PBOOST(0:3),PQ,QQ,M,LF + REAL*8 RXZERO + PARAMETER( RXZERO=0.0D0 ) +C + QQ=Q(1)**2+Q(2)**2+Q(3)**2 +C + IF ( QQ .NE. RXZERO ) THEN + PQ=P(1)*Q(1)+P(2)*Q(2)+P(3)*Q(3) + M=SQRT(Q(0)**2-QQ) + LF=((Q(0)-M)*PQ/QQ+P(0))/M + PBOOST(0) = (P(0)*Q(0)+PQ)/M + PBOOST(1) = P(1)+Q(1)*LF + PBOOST(2) = P(2)+Q(2)*LF + PBOOST(3) = P(3)+Q(3)*LF + ELSE + PBOOST(0)=P(0) + PBOOST(1)=P(1) + PBOOST(2)=P(2) + PBOOST(3)=P(3) + ENDIF +C + RETURN + END +C +C ********************************************************************** +C + SUBROUTINE COUP1X(SW2 , GW,GWWA,GWWZ) +C +C this subroutine sets up the coupling constants of the gauge bosons in +C the standard model. +C +C input: +C real sw2 : square of sine of the weak angle +C +C output: +C real gw : weak coupling constant +C real gwwa : dimensionless coupling of w-,w+,a +C real gwwz : dimensionless coupling of w-,w+,z +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + REAL*8 SW2,GW,GWWA,GWWZ,ALPHA,FOURPI,EE,SW,CW + REAL*8 RXONE, RXFOUR, RXOTE, RXPI, RIALPH + PARAMETER( RXONE=1.0D0, RXFOUR=4.0D0, RXOTE=128.0D0 ) + PARAMETER( RXPI=3.14159265358979323846D0, RIALPH=137.0359895D0 ) +C + ALPHA = RXONE / RXOTE +C alpha = r_one / r_ialph + FOURPI = RXFOUR * RXPI + EE=SQRT( ALPHA * FOURPI ) + SW=SQRT( SW2 ) + CW=SQRT( RXONE - SW2 ) +C + GW = EE/SW + GWWA = EE + GWWZ = EE*CW/SW +C + RETURN + END +C +C ---------------------------------------------------------------------- +C + SUBROUTINE COUP2X(SW2 , GAL,GAU,GAD,GWF,GZN,GZL,GZU,GZD,G1) +C +C this subroutine sets up the coupling constants for the fermion- +C fermion-vector vertices in the standard model. the array of the +C couplings specifies the chirality of the flowing-in fermion. g??(1) +C denotes a left-handed coupling, and g??(2) a right-handed coupling. +C +C input: +C real sw2 : square of sine of the weak angle +C +C output: +C real gal(2) : coupling with a of charged leptons +C real gau(2) : coupling with a of up-type quarks +C real gad(2) : coupling with a of down-type quarks +C real gwf(2) : coupling with w-,w+ of fermions +C real gzn(2) : coupling with z of neutrinos +C real gzl(2) : coupling with z of charged leptons +C real gzu(2) : coupling with z of up-type quarks +C real gzd(2) : coupling with z of down-type quarks +C real g1(2) : unit coupling of fermions +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + REAL*8 GAL(2),GAU(2),GAD(2),GWF(2),GZN(2),GZL(2),GZU(2),GZD(2), + & G1(2),SW2,ALPHA,FOURPI,EE,SW,CW,EZ,EY +C + REAL*8 RXZERO, RXHALF, RXONE, RXTWO, RTHREE, RXFOUR, RXOTE + REAL*8 RXPI, RIALPH + PARAMETER( RXZERO=0.0D0, RXHALF=0.5D0, RXONE=1.0D0, RXTWO=2.0D0, + $ RTHREE=3.0D0 ) + PARAMETER( RXFOUR=4.0D0, RXOTE=128.0D0 ) + PARAMETER( RXPI=3.14159265358979323846D0, RIALPH=137.0359895D0 ) +C + ALPHA = RXONE / RXOTE +C alpha = r_one / r_ialph + FOURPI = RXFOUR * RXPI + EE=SQRT( ALPHA * FOURPI ) + SW=SQRT( SW2 ) + CW=SQRT( RXONE - SW2 ) + EZ=EE/(SW*CW) + EY=EE*(SW/CW) +C + GAL(1) = EE + GAL(2) = EE + GAU(1) = -EE*RXTWO/RTHREE + GAU(2) = -EE*RXTWO/RTHREE + GAD(1) = EE /RTHREE + GAD(2) = EE /RTHREE + GWF(1) = -EE/SQRT(RXTWO*SW2) + GWF(2) = RXZERO + GZN(1) = -EZ* RXHALF + GZN(2) = RXZERO + GZL(1) = -EZ*(-RXHALF+SW2) + GZL(2) = -EY + GZU(1) = -EZ*( RXHALF-SW2*RXTWO/RTHREE) + GZU(2) = EY* RXTWO/RTHREE + GZD(1) = -EZ*(-RXHALF+SW2 /RTHREE) + GZD(2) = -EY /RTHREE + G1(1) = RXONE + G1(2) = RXONE +C + RETURN + END +C +C ---------------------------------------------------------------------- +C + SUBROUTINE COUP3X(SW2,ZMASS,HMASS , + & GWWH,GZZH,GHHH,GWWHH,GZZHH,GHHHH) +C +C this subroutine sets up the coupling constants of the gauge bosons and +C higgs boson in the standard model. +C +C input: +C real sw2 : square of sine of the weak angle +C real zmass : mass of z +C real hmass : mass of higgs +C +C output: +C real gwwh : dimensionful coupling of w-,w+,h +C real gzzh : dimensionful coupling of z, z, h +C real ghhh : dimensionful coupling of h, h, h +C real gwwhh : dimensionful coupling of w-,w+,h, h +C real gzzhh : dimensionful coupling of z, z, h, h +C real ghhhh : dimensionless coupling of h, h, h, h +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + REAL*8 SW2,ZMASS,HMASS,GWWH,GZZH,GHHH,GWWHH,GZZHH,GHHHH, + & ALPHA,FOURPI,EE2,SC2,V +C + REAL*8 RXHALF, RXONE, RXTWO, RTHREE, RXFOUR, RXOTE + REAL*8 RXPI, RIALPH + PARAMETER( RXHALF=0.5D0, RXONE=1.0D0, RXTWO=2.0D0, RTHREE=3.0D0 ) + PARAMETER( RXFOUR=4.0D0, RXOTE=128.0D0 ) + PARAMETER( RXPI=3.14159265358979323846D0, RIALPH=137.0359895D0 ) +C + ALPHA = RXONE / RXOTE +C alpha = r_one / r_ialph + FOURPI = RXFOUR * RXPI + EE2=ALPHA*FOURPI + SC2=SW2*( RXONE - SW2 ) + V = RXTWO * ZMASS*SQRT(SC2)/SQRT(EE2) +C + GWWH = EE2/SW2*RXHALF*V + GZZH = EE2/SC2*RXHALF*V + GHHH = -HMASS**2/V*RTHREE + GWWHH = EE2/SW2*RXHALF + GZZHH = EE2/SC2*RXHALF + GHHHH = -(HMASS/V)**2*RTHREE +C + RETURN + END +C +C ---------------------------------------------------------------------- +C + SUBROUTINE COUP4X(SW2,ZMASS,FMASS , GCHF) +C +C This subroutine sets up the coupling constant for the fermion-fermion- +C Higgs vertex in the STANDARD MODEL. The coupling is COMPLEX and the +C array of the coupling specifies the chirality of the flowing-IN +C fermion. GCHF(1) denotes a left-handed coupling, and GCHF(2) a right- +C handed coupling. +C +C INPUT: +C real SW2 : square of sine of the weak angle +C real ZMASS : Z mass +C real FMASS : fermion mass +C +C OUTPUT: +C complex GCHF(2) : coupling of fermion and Higgs +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + COMPLEX*16 GCHF(2) + REAL*8 SW2,ZMASS,FMASS,ALPHA,FOURPI,EZ,G +C + ALPHA=1.D0/128.D0 +C ALPHA=1./REAL(137.0359895) + FOURPI=4.D0*3.14159265358979323846D0 + EZ=SQRT(ALPHA*FOURPI)/SQRT(SW2*(1.D0-SW2)) + G=EZ*FMASS*0.5D0/ZMASS +C + GCHF(1) = DCMPLX( -G ) + GCHF(2) = DCMPLX( -G ) +C + RETURN + END +C +C ====================================================================== +C + SUBROUTINE EAIXXX(EB,EA,SHLF,CHLF,PHI,NHE,NHA , EAI) +C +C This subroutine computes an off-shell electron wavefunction after +C emitting a photon from the electron beam, with a special care for the +C small angle region. The momenta are measured in the laboratory frame, +C where the e- beam is along the positive z axis. +C +C INPUT: +C real EB : energy (GeV) of beam e- +C real EA : energy (GeV) of final photon +C real SHLF : sin(theta/2) of final photon +C real CHLF : cos(theta/2) of final photon +C real PHI : azimuthal angle of final photon +C integer NHE = -1 or 1 : helicity of beam e- +C integer NHA = -1 or 1 : helicity of final photon +C +C OUTPUT: +C complex EAI(6) : off-shell electron |e',A,e> +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + COMPLEX*16 EAI(6),PHS + REAL*8 EB,EA,SHLF,CHLF,PHI,ME,ALPHA,GAL,RNHE,X,C,S,D,COEFF, + & XNNP,XNNM,SNP,CSP + INTEGER NHE,NHA,NN +C + ME = 0.51099906D-3 + ALPHA=1./128. + GAL =SQRT(ALPHA*4.*3.14159265D0) +C + NN=NHA*NHE + RNHE=NHE + X=EA/EB + C=(CHLF+SHLF)*(CHLF-SHLF) + S=2.*CHLF*SHLF + D=-1./(EA*EB*(4.*SHLF**2+(ME/EB)**2*C)) + COEFF=-NN*GAL*SQRT(EB)*D + XNNP=X*(1+NN) + XNNM=X*(1-NN) + SNP=SIN(PHI) + CSP=COS(PHI) + PHS=DCMPLX( CSP , RNHE*SNP ) +C + EAI((5-3*NHE)/2) = -RNHE*COEFF*ME*S*(1.+XNNP*.5) + EAI((5-NHE)/2) = XNNP*COEFF*ME*CHLF**2*PHS + EAI((5+NHE)/2) = RNHE*COEFF*EB*S*(-2.+XNNM) + EAI((5+3*NHE)/2) = XNNM*COEFF*EB*SHLF**2*PHS*2. +C + EAI(5) = EB*DCMPLX( 1.-X , 1.-X*C ) + EAI(6) = -EB*X*S*DCMPLX( CSP , SNP ) +C + RETURN + END +C +C ---------------------------------------------------------------------- +C + SUBROUTINE EAOXXX(EB,EA,SHLF,CHLF,PHI,NHE,NHA , EAO) +C +C This subroutine computes an off-shell positron wavefunction after +C emitting a photon from the positron beam, with a special care for the +C small angle region. The momenta are measured in the laboratory frame, +C where the e+ beam is along the negative z axis. +C +C INPUT: +C real EB : energy (GeV) of beam e+ +C real EA : energy (GeV) of final photon +C real SHLF : sin(theta/2) of final photon +C real CHLF : cos(theta/2) of final photon +C real PHI : azimuthal angle of final photon +C integer NHE = -1 or 1 : helicity of beam e+ +C integer NHA = -1 or 1 : helicity of final photon +C +C OUTPUT: +C complex EAO(6) : off-shell positron +C complex*16 sc(3) : input scalar s +C complex*16 gc(2) : coupling constants gchf +C real*8 fmass : mass of output fermion f' +C real*8 fwidth : width of output fermion f' +C +C output: +C complex fsi(6) : off-shell fermion |f',s,fi> +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + COMPLEX*16 FI(6),SC(3),FSI(6),GC(2),SL1,SL2,SR1,SR2,DS + REAL*8 PF(0:3),FMASS,FWIDTH,PF2,P0P3,P0M3 +C + FSI(5) = FI(5)-SC(2) + FSI(6) = FI(6)-SC(3) +C + PF(0)=DBLE( FSI(5)) + PF(1)=DBLE( FSI(6)) + PF(2)=DIMAG(FSI(6)) + PF(3)=DIMAG(FSI(5)) + PF2=PF(0)**2-(PF(1)**2+PF(2)**2+PF(3)**2) +C + DS=-SC(1)/DCMPLX(PF2-FMASS**2,MAX(DSIGN(FMASS*FWIDTH ,PF2),0D0)) + P0P3=PF(0)+PF(3) + P0M3=PF(0)-PF(3) + SL1=GC(1)*(P0P3*FI(1)+DCONJG(FSI(6))*FI(2)) + SL2=GC(1)*(P0M3*FI(2) +FSI(6) *FI(1)) + SR1=GC(2)*(P0M3*FI(3)-DCONJG(FSI(6))*FI(4)) + SR2=GC(2)*(P0P3*FI(4) -FSI(6) *FI(3)) +C + FSI(1) = ( GC(1)*FMASS*FI(1) + SR1 )*DS + FSI(2) = ( GC(1)*FMASS*FI(2) + SR2 )*DS + FSI(3) = ( GC(2)*FMASS*FI(3) + SL1 )*DS + FSI(4) = ( GC(2)*FMASS*FI(4) + SL2 )*DS +C + RETURN + END +C +C ---------------------------------------------------------------------- +C + SUBROUTINE FSOXXX(FO,SC,GC,FMASS,FWIDTH , FSO) +C +C this subroutine computes an off-shell fermion wavefunction from a +C flowing-out external fermion and a vector boson. +C +C input: +C complex*16 fo(6) : flow-out fermion +C complex vc(6) : input vector v +C real g(2) : coupling constants gvf +C real fmass : mass of output fermion f' +C real fwidth : width of output fermion f' +C +C output: +C complex fvi(6) : off-shell fermion |f',v,fi> +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + COMPLEX*16 FI(6),VC(6),FVI(6),SL1,SL2,SR1,SR2,D + REAL*8 G(2),PF(0:3),FMASS,FWIDTH,PF2 + REAL*8 RXZERO, RXONE + PARAMETER( RXZERO=0.0D0, RXONE=1.0D0 ) + COMPLEX*16 CXIMAG +C + LOGICAL FIRST + SAVE CXIMAG,FIRST + DATA FIRST/.TRUE./ +C +C Fix compilation with g77 + IF(FIRST) THEN + FIRST=.FALSE. + CXIMAG=DCMPLX( RXZERO, RXONE ) + ENDIF +C + FVI(5) = FI(5)-VC(5) + FVI(6) = FI(6)-VC(6) +C + PF(0)=DBLE( FVI(5)) + PF(1)=DBLE( FVI(6)) + PF(2)=DIMAG(FVI(6)) + PF(3)=DIMAG(FVI(5)) + PF2=PF(0)**2-(PF(1)**2+PF(2)**2+PF(3)**2) +C + D=-RXONE/DCMPLX( PF2-FMASS**2,MAX(SIGN(FMASS*FWIDTH,PF2),RXZERO)) + SL1= (VC(1)+ VC(4))*FI(1) + & +(VC(2)-CXIMAG*VC(3))*FI(2) + SL2= (VC(2)+CXIMAG*VC(3))*FI(1) + & +(VC(1)- VC(4))*FI(2) +C + IF ( G(2) .NE. RXZERO ) THEN + SR1= (VC(1)- VC(4))*FI(3) + & -(VC(2)-CXIMAG*VC(3))*FI(4) + SR2=-(VC(2)+CXIMAG*VC(3))*FI(3) + & +(VC(1)+ VC(4))*FI(4) +C + FVI(1) = ( G(1)*((PF(0)-PF(3))*SL1 -DCONJG(FVI(6))*SL2) + & +G(2)*FMASS*SR1)*D + FVI(2) = ( G(1)*( -FVI(6)*SL1 +(PF(0)+PF(3))*SL2) + & +G(2)*FMASS*SR2)*D + FVI(3) = ( G(2)*((PF(0)+PF(3))*SR1 +DCONJG(FVI(6))*SR2) + & +G(1)*FMASS*SL1)*D + FVI(4) = ( G(2)*( FVI(6)*SR1 +(PF(0)-PF(3))*SR2) + & +G(1)*FMASS*SL2)*D +C + ELSE + FVI(1) = G(1)*((PF(0)-PF(3))*SL1 -DCONJG(FVI(6))*SL2)*D + FVI(2) = G(1)*( -FVI(6)*SL1 +(PF(0)+PF(3))*SL2)*D + FVI(3) = G(1)*FMASS*SL1*D + FVI(4) = G(1)*FMASS*SL2*D + END IF +C + RETURN + END +C +C ---------------------------------------------------------------------- +C + SUBROUTINE FVOXXX(FO,VC,G,FMASS,FWIDTH , FVO) +C +C this subroutine computes an off-shell fermion wavefunction from a +C flowing-out external fermion and a vector boson. +C +C input: +C complex fo(6) : flow-out fermion +C complex fo(6) : flow-out fermion ) +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + COMPLEX*16 FI(6),FO(6),HIO(3),GC(2),DN + REAL*8 Q(0:3),SMASS,SWIDTH,Q2 +C + HIO(2) = FO(5)-FI(5) + HIO(3) = FO(6)-FI(6) +C + Q(0)=DBLE( HIO(2)) + Q(1)=DBLE( HIO(3)) + Q(2)=DIMAG(HIO(3)) + Q(3)=DIMAG(HIO(2)) + Q2=Q(0)**2-(Q(1)**2+Q(2)**2+Q(3)**2) +C + DN=-DCMPLX(Q2-SMASS**2,DMAX1(DSIGN(SMASS*SWIDTH,Q2),0.D0)) +C + HIO(1) = ( GC(1)*(FO(1)*FI(1)+FO(2)*FI(2)) + & +GC(2)*(FO(3)*FI(3)+FO(4)*FI(4)) )/DN +C + RETURN + END +C ---------------------------------------------------------------------- +C + SUBROUTINE HSSSXX(S1,S2,S3,G,SMASS,SWIDTH , HSSS) +C +C This subroutine computes an off-shell scalar current from the four- +C scalar coupling. +C +C INPUT: +C complex S1(3) : first scalar S1 +C complex S2(3) : second scalar S2 +C complex S3(3) : third scalar S3 +C real G : coupling constant GHHHH +C real SMASS : mass of OUTPUT scalar S' +C real SWIDTH : width of OUTPUT scalar S' +C +C OUTPUT: +C complex HSSS(3) : scalar current J(S':S1,S2,S3) +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + COMPLEX*16 S1(3),S2(3),S3(3),HSSS(3),DG + REAL*8 Q(0:3),G,SMASS,SWIDTH,Q2 +C + HSSS(2) = S1(2)+S2(2)+S3(2) + HSSS(3) = S1(3)+S2(3)+S3(3) +C + Q(0)=DBLE( HSSS(2)) + Q(1)=DBLE( HSSS(3)) + Q(2)=DIMAG(HSSS(3)) + Q(3)=DIMAG(HSSS(2)) + Q2=Q(0)**2-(Q(1)**2+Q(2)**2+Q(3)**2) +C + DG=-G/DCMPLX( Q2-SMASS**2,MAX(SIGN(SMASS*SWIDTH ,Q2),0.D0)) +C + HSSS(1) = DG * S1(1)*S2(1)*S3(1) +C + RETURN + END +C ---------------------------------------------------------------------- +C + SUBROUTINE HSSXXX(S1,S2,G,SMASS,SWIDTH , HSS) +C +C This subroutine computes an off-shell scalar current from the three- +C scalar coupling. +C +C INPUT: +C complex S1(3) : first scalar S1 +C complex S2(3) : second scalar S2 +C real G : coupling constant GHHH +C real SMASS : mass of OUTPUT scalar S' +C real SWIDTH : width of OUTPUT scalar S' +C +C OUTPUT: +C complex HSS(3) : scalar current J(S':S1,S2) +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + COMPLEX*16 S1(3),S2(3),HSS(3),DG + REAL*8 Q(0:3),G,SMASS,SWIDTH,Q2 +C + HSS(2) = S1(2)+S2(2) + HSS(3) = S1(3)+S2(3) +C + Q(0)=DBLE( HSS(2)) + Q(1)=DBLE( HSS(3)) + Q(2)=DIMAG(HSS(3)) + Q(3)=DIMAG(HSS(2)) + Q2=Q(0)**2-(Q(1)**2+Q(2)**2+Q(3)**2) +C + DG=-G/DCMPLX( Q2-SMASS**2, MAX(SIGN(SMASS*SWIDTH ,Q2),0.D0)) +C + HSS(1) = DG*S1(1)*S2(1) +C + RETURN + END +C +C ====================================================================== +C ---------------------------------------------------------------------- +C + SUBROUTINE HVSXXX(VC,SC,G,SMASS,SWIDTH , HVS) +C +C this subroutine computes an off-shell scalar current from the vector- +C scalar-scalar coupling. the coupling is absent in the minimal sm in +C unitary gauge. +C +C input: +C complex vc(6) : input vector v +C complex sc(3) : input scalar s +C complex g : coupling constant (s charge) +C real smass : mass of output scalar s' +C real swidth : width of output scalar s' +C +C examples of the coupling constant g for susy particles are as follows: +C ----------------------------------------------------------- +C | s1 | (q,i3) of s1 || v=a | v=z | v=w | +C ----------------------------------------------------------- +C | nu~_l | ( 0 , +1/2) || --- | gzn(1) | gwf(1) | +C | e~_l | ( -1 , -1/2) || gal(1) | gzl(1) | gwf(1) | +C | u~_l | (+2/3 , +1/2) || gau(1) | gzu(1) | gwf(1) | +C | d~_l | (-1/3 , -1/2) || gad(1) | gzd(1) | gwf(1) | +C ----------------------------------------------------------- +C | e~_r-bar | ( +1 , 0 ) || -gal(2) | -gzl(2) | -gwf(2) | +C | u~_r-bar | (-2/3 , 0 ) || -gau(2) | -gzu(2) | -gwf(2) | +C | d~_r-bar | (+1/3 , 0 ) || -gad(2) | -gzd(2) | -gwf(2) | +C ----------------------------------------------------------- +C where the sc charge is defined by the flowing-out quantum number. +C +C output: +C complex hvs(3) : scalar current j(s':v,s) +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + COMPLEX*16 VC(6),SC(3),HVS(3),DG,QVV,QPV,G + REAL*8 QV(0:3),QP(0:3),QA(0:3),SMASS,SWIDTH,Q2 +C + HVS(2) = VC(5)+SC(2) + HVS(3) = VC(6)+SC(3) +C + QV(0)=DBLE( VC(5)) + QV(1)=DBLE( VC(6)) + QV(2)=DIMAG( VC(6)) + QV(3)=DIMAG( VC(5)) + QP(0)=DBLE( SC(2)) + QP(1)=DBLE( SC(3)) + QP(2)=DIMAG( SC(3)) + QP(3)=DIMAG( SC(2)) + QA(0)=DBLE( HVS(2)) + QA(1)=DBLE( HVS(3)) + QA(2)=DIMAG(HVS(3)) + QA(3)=DIMAG(HVS(2)) + Q2=QA(0)**2-(QA(1)**2+QA(2)**2+QA(3)**2) +C + DG=-G/DCMPLX( Q2-SMASS**2 , MAX(DSIGN( SMASS*SWIDTH ,Q2),0D0) ) + QVV=QV(0)*VC(1)-QV(1)*VC(2)-QV(2)*VC(3)-QV(3)*VC(4) + QPV=QP(0)*VC(1)-QP(1)*VC(2)-QP(2)*VC(3)-QP(3)*VC(4) +C + HVS(1) = DG*(2D0*QPV+QVV)*SC(1) +C + RETURN + END +C +C ---------------------------------------------------------------------- +C + SUBROUTINE HVVXXX(V1,V2,G,SMASS,SWIDTH , HVV) +C +C this subroutine computes an off-shell scalar current from the vector- +C vector-scalar coupling. +C +C input: +C complex v1(6) : first vector v1 +C complex v2(6) : second vector v2 +C real g : coupling constant gvvh +C real smass : mass of output scalar s +C real swidth : width of output scalar s +C +C output: +C complex hvv(3) : off-shell scalar current j(s:v1,v2) +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + COMPLEX*16 V1(6),V2(6),HVV(3),DG + REAL*8 Q(0:3),G,SMASS,SWIDTH,Q2 + REAL*8 RXZERO + PARAMETER( RXZERO=0.0D0 ) +C + HVV(2) = V1(5)+V2(5) + HVV(3) = V1(6)+V2(6) +C + Q(0)=DBLE( HVV(2)) + Q(1)=DBLE( HVV(3)) + Q(2)=DIMAG(HVV(3)) + Q(3)=DIMAG(HVV(2)) + Q2=Q(0)**2-(Q(1)**2+Q(2)**2+Q(3)**2) +C + DG=-G/DCMPLX( Q2-SMASS**2 , MAX(SIGN( SMASS*SWIDTH ,Q2),RXZERO) ) +C + HVV(1) = DG*(V1(1)*V2(1)-V1(2)*V2(2)-V1(3)*V2(3)-V1(4)*V2(4)) +C + RETURN + END +C +C ====================================================================== +C + SUBROUTINE IOSXXX(FI,FO,SC,GC , VERTEX) +C +C This subroutine computes an amplitude of the fermion-fermion-scalar +C coupling. +C +C INPUT: +C complex FI(6) : flow-in fermion |FI> +C complex FO(6) : flow-out fermion +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + COMPLEX*16 FI(6),FO(6),SC(3),GC(2),VERTEX +C + VERTEX = SC(1)*( GC(1)*(FI(1)*FO(1)+FI(2)*FO(2)) + & +GC(2)*(FI(3)*FO(3)+FI(4)*FO(4)) ) +C + RETURN + END +C +C ====================================================================== +C + SUBROUTINE IOVXXX(FI,FO,VC,G , VERTEX) +C +C this subroutine computes an amplitude of the fermion-fermion-vector +C coupling. +C +C input: +C complex fi(6) : flow-in fermion |fi> +C complex fo(6) : flow-out fermion +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + COMPLEX*16 FI(6),FO(6),VC(6),VERTEX + REAL*8 G(2) + REAL*8 RXZERO, RXONE + PARAMETER( RXZERO=0.0D0, RXONE=1.0D0 ) + COMPLEX*16 CXIMAG + LOGICAL FIRST + SAVE CXIMAG,FIRST + DATA FIRST/.TRUE./ +C +C Fix compilation with g77 + IF(FIRST) THEN + FIRST=.FALSE. + CXIMAG=DCMPLX( RXZERO, RXONE ) + ENDIF +C + + VERTEX = G(1)*( (FO(3)*FI(1)+FO(4)*FI(2))*VC(1) + & +(FO(3)*FI(2)+FO(4)*FI(1))*VC(2) + & -(FO(3)*FI(2)-FO(4)*FI(1))*VC(3)*CXIMAG + & +(FO(3)*FI(1)-FO(4)*FI(2))*VC(4) ) +C + IF ( G(2) .NE. RXZERO ) THEN + VERTEX = VERTEX + & + G(2)*( (FO(1)*FI(3)+FO(2)*FI(4))*VC(1) + & -(FO(1)*FI(4)+FO(2)*FI(3))*VC(2) + & +(FO(1)*FI(4)-FO(2)*FI(3))*VC(3)*CXIMAG + & -(FO(1)*FI(3)-FO(2)*FI(4))*VC(4) ) + END IF +C + RETURN + END +C +C Subroutine returns the desired fermion or +C anti-fermion spinor. ie., |f> +C A replacement for the HELAS routine IXXXXX +C +C Adam Duff, 1992 August 31 +C +C + SUBROUTINE IXXXXX(P,FMASS,NHEL,NSF,FI) +C P IN: FOUR VECTOR MOMENTUM +C FMASS IN: FERMION MASS +C NHEL IN: SPINOR HELICITY, -1 OR 1 +C NSF IN: -1=ANTIFERMION, 1=FERMION +C FI OUT: FERMION WAVEFUNCTION +C +C declare input/output variables +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + COMPLEX*16 FI(6) + INTEGER*4 NHEL, NSF + REAL*8 P(0:3), FMASS + REAL*8 RXZERO, RXONE, RXTWO + PARAMETER( RXZERO=0.0D0, RXONE=1.0D0, RXTWO=2.0D0 ) + REAL*8 PLAT, PABS, OMEGAP, OMEGAM, RS2PA, SPAZ + COMPLEX*16 CXZERO +C +C declare local variables +C + LOGICAL FIRST + SAVE CXZERO,FIRST + DATA FIRST/.TRUE./ +C +C Fix compilation with g77 + IF(FIRST) THEN + FIRST=.FALSE. + CXZERO=DCMPLX( RXZERO, RXZERO ) + ENDIF +C +C define kinematic parameters +C + FI(5) = DCMPLX( P(0), P(3) ) * NSF + FI(6) = DCMPLX( P(1), P(2) ) * NSF + PLAT = SQRT( P(1)**2 + P(2)**2 ) + PABS = SQRT( P(1)**2 + P(2)**2 + P(3)**2 ) + OMEGAP = SQRT( P(0) + PABS ) +C +C do massive fermion case +C + IF ( FMASS .NE. RXZERO ) THEN + OMEGAM = FMASS / OMEGAP + IF ( NSF .EQ. 1 ) THEN + IF ( NHEL .EQ. 1 ) THEN + IF ( P(3) .GE. RXZERO ) THEN + IF ( PLAT .EQ. RXZERO ) THEN + FI(1) = DCMPLX( OMEGAM, RXZERO ) + FI(2) = CXZERO + FI(3) = DCMPLX( OMEGAP, RXZERO ) + FI(4) = CXZERO + ELSE + RS2PA = RXONE / SQRT( RXTWO * PABS ) + SPAZ = SQRT( PABS + P(3) ) + FI(1) = OMEGAM * RS2PA + & * DCMPLX( SPAZ, RXZERO ) + FI(2) = OMEGAM * RS2PA / SPAZ + & * DCMPLX( P(1), P(2) ) + FI(3) = OMEGAP * RS2PA + & * DCMPLX( SPAZ, RXZERO ) + FI(4) = OMEGAP * RS2PA / SPAZ + & * DCMPLX( P(1), P(2) ) + END IF + ELSE + IF ( PLAT .EQ. RXZERO ) THEN + FI(1) = CXZERO + FI(2) = DCMPLX( OMEGAM, RXZERO ) + FI(3) = CXZERO + FI(4) = DCMPLX( OMEGAP, RXZERO ) + ELSE + RS2PA = RXONE / SQRT( RXTWO * PABS ) + SPAZ = SQRT( PABS - P(3) ) + FI(1) = OMEGAM * RS2PA / SPAZ + & * DCMPLX( PLAT, RXZERO ) + FI(2) = OMEGAM * RS2PA * SPAZ / PLAT + & * DCMPLX( P(1), P(2) ) + FI(3) = OMEGAP * RS2PA / SPAZ + & * DCMPLX( PLAT, RXZERO ) + FI(4) = OMEGAP * RS2PA * SPAZ / PLAT + & * DCMPLX( P(1), P(2) ) + END IF + END IF + ELSE IF ( NHEL .EQ. -1 ) THEN + IF ( P(3) .GE. RXZERO ) THEN + IF ( PLAT .EQ. RXZERO ) THEN + FI(1) = CXZERO + FI(2) = DCMPLX( OMEGAP, RXZERO ) + FI(3) = CXZERO + FI(4) = DCMPLX( OMEGAM, RXZERO ) + ELSE + RS2PA = RXONE / SQRT( RXTWO * PABS ) + SPAZ = SQRT( PABS + P(3) ) + FI(1) = OMEGAP * RS2PA / SPAZ + & * DCMPLX( -P(1), P(2) ) + FI(2) = OMEGAP * RS2PA + & * DCMPLX( SPAZ, RXZERO ) + FI(3) = OMEGAM * RS2PA / SPAZ + & * DCMPLX( -P(1), P(2) ) + FI(4) = OMEGAM * RS2PA + & * DCMPLX( SPAZ, RXZERO ) + END IF + ELSE + IF ( PLAT .EQ. RXZERO ) THEN + FI(1) = DCMPLX( -OMEGAP, RXZERO ) + FI(2) = CXZERO + FI(3) = DCMPLX( -OMEGAM, RXZERO ) + FI(4) = CXZERO + ELSE + RS2PA = RXONE / SQRT( RXTWO * PABS ) + SPAZ = SQRT( PABS - P(3) ) + FI(1) = OMEGAP * RS2PA * SPAZ / PLAT + & * DCMPLX( -P(1), P(2) ) + FI(2) = OMEGAP * RS2PA / SPAZ + & * DCMPLX( PLAT, RXZERO ) + FI(3) = OMEGAM * RS2PA * SPAZ / PLAT + & * DCMPLX( -P(1), P(2) ) + FI(4) = OMEGAM * RS2PA / SPAZ + & * DCMPLX( PLAT, RXZERO ) + END IF + END IF + ELSE + STOP 'IXXXXX: FERMION HELICITY MUST BE +1,-1' + END IF + ELSE IF ( NSF .EQ. -1 ) THEN + IF ( NHEL .EQ. 1 ) THEN + IF ( P(3) .GE. RXZERO ) THEN + IF ( PLAT .EQ. RXZERO ) THEN + FI(1) = CXZERO + FI(2) = DCMPLX( -OMEGAP, RXZERO ) + FI(3) = CXZERO + FI(4) = DCMPLX( OMEGAM, RXZERO ) + ELSE + RS2PA = RXONE / SQRT( RXTWO * PABS ) + SPAZ = SQRT( PABS + P(3) ) + FI(1) = -OMEGAP * RS2PA / SPAZ + & * DCMPLX( -P(1), P(2) ) + FI(2) = -OMEGAP * RS2PA + & * DCMPLX( SPAZ, RXZERO ) + FI(3) = OMEGAM * RS2PA / SPAZ + & * DCMPLX( -P(1), P(2) ) + FI(4) = OMEGAM * RS2PA + & * DCMPLX( SPAZ, RXZERO ) + END IF + ELSE + IF ( PLAT .EQ. RXZERO ) THEN + FI(1) = DCMPLX( OMEGAP, RXZERO ) + FI(2) = CXZERO + FI(3) = DCMPLX( -OMEGAM, RXZERO ) + FI(4) = CXZERO + ELSE + RS2PA = RXONE / SQRT( RXTWO * PABS ) + SPAZ = SQRT( PABS - P(3) ) + FI(1) = -OMEGAP * RS2PA * SPAZ / PLAT + & * DCMPLX( -P(1), P(2) ) + FI(2) = -OMEGAP * RS2PA / SPAZ + & * DCMPLX( PLAT, RXZERO ) + FI(3) = OMEGAM * RS2PA * SPAZ / PLAT + & * DCMPLX( -P(1), P(2) ) + FI(4) = OMEGAM * RS2PA / SPAZ + & * DCMPLX( PLAT, RXZERO ) + END IF + END IF + ELSE IF ( NHEL .EQ. -1 ) THEN + IF ( P(3) .GE. RXZERO ) THEN + IF ( PLAT .EQ. RXZERO ) THEN + FI(1) = DCMPLX( OMEGAM, RXZERO ) + FI(2) = CXZERO + FI(3) = DCMPLX( -OMEGAP, RXZERO ) + FI(4) = CXZERO + ELSE + RS2PA = RXONE / SQRT( RXTWO * PABS ) + SPAZ = SQRT( PABS + P(3) ) + FI(1) = OMEGAM * RS2PA + & * DCMPLX( SPAZ, RXZERO ) + FI(2) = OMEGAM * RS2PA / SPAZ + & * DCMPLX( P(1), P(2) ) + FI(3) = -OMEGAP * RS2PA + & * DCMPLX( SPAZ, RXZERO ) + FI(4) = -OMEGAP * RS2PA / SPAZ + & * DCMPLX( P(1), P(2) ) + END IF + ELSE + IF ( PLAT .EQ. RXZERO ) THEN + FI(1) = CXZERO + FI(2) = DCMPLX( OMEGAM, RXZERO ) + FI(3) = CXZERO + FI(4) = DCMPLX( -OMEGAP, RXZERO ) + ELSE + RS2PA = RXONE / SQRT( RXTWO * PABS ) + SPAZ = SQRT( PABS - P(3) ) + FI(1) = OMEGAM * RS2PA / SPAZ + & * DCMPLX( PLAT, RXZERO ) + FI(2) = OMEGAM * RS2PA * SPAZ / PLAT + & * DCMPLX( P(1), P(2) ) + FI(3) = -OMEGAP * RS2PA / SPAZ + & * DCMPLX( PLAT, RXZERO ) + FI(4) = -OMEGAP * RS2PA * SPAZ / PLAT + & * DCMPLX( P(1), P(2) ) + END IF + END IF + ELSE + STOP 'IXXXXX: FERMION HELICITY MUST BE +1,-1' + END IF + ELSE + STOP 'IXXXXX: FERMION TYPE MUST BE +1,-1' + END IF +C +C do massless fermion case +C + ELSE + IF ( NSF .EQ. 1 ) THEN + IF ( NHEL .EQ. 1 ) THEN + IF ( P(3) .GE. RXZERO ) THEN + IF ( PLAT .EQ. RXZERO ) THEN + FI(1) = CXZERO + FI(2) = CXZERO + FI(3) = DCMPLX( OMEGAP, RXZERO ) + FI(4) = CXZERO + ELSE + SPAZ = SQRT( PABS + P(3) ) + FI(1) = CXZERO + FI(2) = CXZERO + FI(3) = DCMPLX( SPAZ, RXZERO ) + FI(4) = RXONE / SPAZ + & * DCMPLX( P(1), P(2) ) + END IF + ELSE + IF ( PLAT .EQ. RXZERO ) THEN + FI(1) = CXZERO + FI(2) = CXZERO + FI(3) = CXZERO + FI(4) = DCMPLX( OMEGAP, RXZERO ) + ELSE + SPAZ = SQRT( PABS - P(3) ) + FI(1) = CXZERO + FI(2) = CXZERO + FI(3) = RXONE / SPAZ + & * DCMPLX( PLAT, RXZERO ) + FI(4) = SPAZ / PLAT + & * DCMPLX( P(1), P(2) ) + END IF + END IF + ELSE IF ( NHEL .EQ. -1 ) THEN + IF ( P(3) .GE. RXZERO ) THEN + IF ( PLAT .EQ. RXZERO ) THEN + FI(1) = CXZERO + FI(2) = DCMPLX( OMEGAP, RXZERO ) + FI(3) = CXZERO + FI(4) = CXZERO + ELSE + SPAZ = SQRT( PABS + P(3) ) + FI(1) = RXONE / SPAZ + & * DCMPLX( -P(1), P(2) ) + FI(2) = DCMPLX( SPAZ, RXZERO ) + FI(3) = CXZERO + FI(4) = CXZERO + END IF + ELSE + IF ( PLAT .EQ. RXZERO ) THEN + FI(1) = DCMPLX( -OMEGAP, RXZERO ) + FI(2) = CXZERO + FI(3) = CXZERO + FI(4) = CXZERO + ELSE + SPAZ = SQRT( PABS - P(3) ) + FI(1) = SPAZ / PLAT + & * DCMPLX( -P(1), P(2) ) + FI(2) = RXONE / SPAZ + & * DCMPLX( PLAT, RXZERO ) + FI(3) = CXZERO + FI(4) = CXZERO + END IF + END IF + ELSE + STOP 'IXXXXX: FERMION HELICITY MUST BE +1,-1' + END IF + ELSE IF ( NSF .EQ. -1 ) THEN + IF ( NHEL .EQ. 1 ) THEN + IF ( P(3) .GE. RXZERO ) THEN + IF ( PLAT .EQ. RXZERO ) THEN + FI(1) = CXZERO + FI(2) = DCMPLX( -OMEGAP, RXZERO ) + FI(3) = CXZERO + FI(4) = CXZERO + ELSE + SPAZ = SQRT( PABS + P(3) ) + FI(1) = -RXONE / SPAZ + & * DCMPLX( -P(1), P(2) ) + FI(2) = DCMPLX( -SPAZ, RXZERO ) + FI(3) = CXZERO + FI(4) = CXZERO + END IF + ELSE + IF ( PLAT .EQ. RXZERO ) THEN + FI(1) = DCMPLX( OMEGAP, RXZERO ) + FI(2) = CXZERO + FI(3) = CXZERO + FI(4) = CXZERO + ELSE + SPAZ = SQRT( PABS - P(3) ) + FI(1) = -SPAZ / PLAT + & * DCMPLX( -P(1), P(2) ) + FI(2) = -RXONE / SPAZ + & * DCMPLX( PLAT, RXZERO ) + FI(3) = CXZERO + FI(4) = CXZERO + END IF + END IF + ELSE IF ( NHEL .EQ. -1 ) THEN + IF ( P(3) .GE. RXZERO ) THEN + IF ( PLAT .EQ. RXZERO ) THEN + FI(1) = CXZERO + FI(2) = CXZERO + FI(3) = DCMPLX( -OMEGAP, RXZERO ) + FI(4) = CXZERO + ELSE + SPAZ = SQRT( PABS + P(3) ) + FI(1) = CXZERO + FI(2) = CXZERO + FI(3) = DCMPLX( -SPAZ, RXZERO ) + FI(4) = -RXONE / SPAZ + & * DCMPLX( P(1), P(2) ) + END IF + ELSE + IF ( PLAT .EQ. RXZERO ) THEN + FI(1) = CXZERO + FI(2) = CXZERO + FI(3) = CXZERO + FI(4) = DCMPLX( -OMEGAP, RXZERO ) + ELSE + SPAZ = SQRT( PABS - P(3) ) + FI(1) = CXZERO + FI(2) = CXZERO + FI(3) = -RXONE / SPAZ + & * DCMPLX( PLAT, RXZERO ) + FI(4) = -SPAZ / PLAT + & * DCMPLX( P(1), P(2) ) + END IF + END IF + ELSE + STOP 'IXXXXX: FERMION HELICITY MUST BE +1,-1' + END IF + ELSE + STOP 'IXXXXX: FERMION TYPE MUST BE +1,-1' + END IF + END IF +C +C done +C + RETURN + END +C +C ---------------------------------------------------------------------- +C + SUBROUTINE J3XXXX(FI,FO,GAF,GZF,ZMASS,ZWIDTH , J3) +C +C this subroutine computes the sum of photon and z currents with the +C suitable weights ( j(w3) = cos(theta_w) j(z) + sin(theta_w) j(a) ). +C the output j3 is useful as an input of vvvxxx, jvvxxx or w3w3xx. +C the photon propagator is given in feynman gauge, and the z propagator +C is given in unitary gauge. +C +C input: +C complex fi(6) : flow-in fermion |fi> +C complex fo(6) : flow-out fermion ) +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + COMPLEX*16 FI(6),FO(6),J3(6), + & C0L,C1L,C2L,C3L,CSL,C0R,C1R,C2R,C3R,CSR,DZ,DDIF + REAL*8 GAF(2),GZF(2),Q(0:3),ZMASS,ZWIDTH,ZM2,ZMW,Q2,DA,WW, + & CW,SW,GN,GZ3L,GA3L +C + REAL*8 RXZERO, RXONE + PARAMETER( RXZERO=0.0D0, RXONE=1.0D0 ) + COMPLEX*16 CXIMAG + LOGICAL FIRST + SAVE CXIMAG,FIRST + DATA FIRST/.TRUE./ +C +C Fix compilation with g77 + IF(FIRST) THEN + FIRST=.FALSE. + CXIMAG=DCMPLX( RXZERO, RXONE ) + ENDIF +C + J3(5) = FO(5)-FI(5) + J3(6) = FO(6)-FI(6) +C + Q(0)=-DBLE( J3(5)) + Q(1)=-DBLE( J3(6)) + Q(2)=-DIMAG(J3(6)) + Q(3)=-DIMAG(J3(5)) + Q2=Q(0)**2-(Q(1)**2+Q(2)**2+Q(3)**2) + ZM2=ZMASS**2 + ZMW=ZMASS*ZWIDTH +C + DA=RXONE/Q2 + WW=MAX(DSIGN( ZMW ,Q2),RXZERO) + DZ=RXONE/DCMPLX( Q2-ZM2 , WW ) + DDIF=DCMPLX( -ZM2 , WW )*DA*DZ +C +C ddif is the difference : ddif=da-dz +C for the running width, use below instead of the above ww,dz and ddif. +C ww=max( zwidth*q2/zmass ,r_zero) +C dz=r_one/dcmplx( q2-zm2 , ww ) +C ddif=dcmplx( -zm2 , ww )*da*dz +C + CW=RXONE/SQRT(RXONE+(GZF(2)/GAF(2))**2) + SW=SQRT((RXONE-CW)*(RXONE+CW)) + GN=GAF(2)*SW + GZ3L=GZF(1)*CW + GA3L=GAF(1)*SW + C0L= FO(3)*FI(1)+FO(4)*FI(2) + C0R= FO(1)*FI(3)+FO(2)*FI(4) + C1L=-(FO(3)*FI(2)+FO(4)*FI(1)) + C1R= FO(1)*FI(4)+FO(2)*FI(3) + C2L= (FO(3)*FI(2)-FO(4)*FI(1))*CXIMAG + C2R=(-FO(1)*FI(4)+FO(2)*FI(3))*CXIMAG + C3L= -FO(3)*FI(1)+FO(4)*FI(2) + C3R= FO(1)*FI(3)-FO(2)*FI(4) + CSL=(Q(0)*C0L-Q(1)*C1L-Q(2)*C2L-Q(3)*C3L)/ZM2 + CSR=(Q(0)*C0R-Q(1)*C1R-Q(2)*C2R-Q(3)*C3R)/ZM2 +C + J3(1) = GZ3L*DZ*(C0L-CSL*Q(0))+GA3L*C0L*DA + & + GN*(C0R*DDIF-CSR*Q(0)*DZ) + J3(2) = GZ3L*DZ*(C1L-CSL*Q(1))+GA3L*C1L*DA + & + GN*(C1R*DDIF-CSR*Q(1)*DZ) + J3(3) = GZ3L*DZ*(C2L-CSL*Q(2))+GA3L*C2L*DA + & + GN*(C2R*DDIF-CSR*Q(2)*DZ) + J3(4) = GZ3L*DZ*(C3L-CSL*Q(3))+GA3L*C3L*DA + & + GN*(C3R*DDIF-CSR*Q(3)*DZ) +C + RETURN + END +C +C ---------------------------------------------------------------------- +C + SUBROUTINE JEEXXX(EB,EF,SHLF,CHLF,PHI,NHB,NHF,NSF , JEE) +C +C This subroutine computes an off-shell photon wavefunction emitted from +C the electron or positron beam, with a special care for the small angle +C region. The momenta are measured in the laboratory frame, where the +C e- (e+) beam is along the positive (negative) z axis. +C +C INPUT: +C real EB : energy (GeV) of beam e-/e+ +C real EF : energy (GeV) of final e-/e+ +C real SHLF : sin(theta/2) of final e-/e+ +C real CHLF : cos(theta/2) of final e-/e+ +C real PHI : azimuthal angle of final e-/e+ +C integer NHB = -1 or 1 : helicity of beam e-/e+ +C integer NHF = -1 or 1 : helicity of final e-/e+ +C integer NSF = -1 or 1 : +1 for electron, -1 for positron +C +C OUTPUT: +C complex JEE(6) : off-shell photon J^mu() +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + COMPLEX*16 JEE(6),COEFF + REAL*8 CS(2),EB,EF,SHLF,CHLF,PHI,ME,ALPHA,GAL,HI,SF,SFH,X,ME2,Q2, + & RFP,RFM,SNP,CSP,RXC,C,S + INTEGER NHB,NHF,NSF +C + ME =0.51099906D-3 + ALPHA=1./128. + GAL =SQRT(ALPHA*4.*3.14159265D0) +C + HI =NHB + SF =NSF + SFH=NHB*NSF + CS((3+NSF)/2)=SHLF + CS((3-NSF)/2)=CHLF +C CS(1)=CHLF and CS(2)=SHLF for electron +C CS(1)=SHLF and CS(2)=CHLF for positron + X=EF/EB + ME2=ME**2 + Q2=-4.*CS(2)**2*(EF*EB-ME2) + & +SF*(1.-X)**2/X*(SHLF+CHLF)*(SHLF-CHLF)*ME2 + RFP=(1+NSF) + RFM=(1-NSF) + SNP=SIN(PHI) + CSP=COS(PHI) +C + IF (NHB.EQ.NHF) THEN + RXC=2.*X/(1.-X)*CS(1)**2 + COEFF= GAL*2.*EB*SQRT(X)*CS(2)/Q2 + & *(DCMPLX( RFP )-RFM*DCMPLX( CSP ,-SNP*HI ))*.5 + JEE(1) = DCMPLX( 0.D0 ) + JEE(2) = COEFF*DCMPLX( (1.+RXC)*CSP ,-SFH*SNP ) + JEE(3) = COEFF*DCMPLX( (1.+RXC)*SNP , SFH*CSP ) + JEE(4) = COEFF*(-SF*RXC/CS(1)*CS(2)) + ELSE + COEFF= GAL*ME/Q2/SQRT(X) + & *(DCMPLX( RFP )+RFM*DCMPLX( CSP , SNP*HI ))*.5*HI + JEE(1) = -COEFF*(1.+X)*CS(2)*DCMPLX( CSP , SFH*SNP ) + JEE(2) = COEFF*(1.-X)*CS(1) + JEE(3) = JEE(2)*DCMPLX( 0.D0 , SFH ) + JEE(4) = JEE(1)*SF*(1.-X)/(1.+X) + ENDIF +C + C=(CHLF+SHLF)*(CHLF-SHLF) + S=2.*CHLF*SHLF +C + JEE(5) = -EB*DCMPLX( 1.-X , SF-X*C ) + JEE(6) = EB*X*S*DCMPLX( CSP , SNP ) +C + RETURN + END +C +C +C ---------------------------------------------------------------------- +C + SUBROUTINE JGGGXX(W1,W2,W3,G, JW3W) +C +C this subroutine computes an off-shell w+, w-, w3, z or photon current +C from the four-point gauge boson coupling, including the contributions +C of w exchange diagrams. the vector propagator is given in feynman +C gauge for a photon and in unitary gauge for w and z bosons. if one +C sets wmass=0.0, then the ggg-->g current is given (see sect 2.9.1 of +C the manual). +C +C input: +C complex w1(6) : first vector w1 +C complex w2(6) : second vector w2 +C complex w3(6) : third vector w3 +C real g : first coupling constant +C (see the table below) +C +C output: +C complex jw3w(6) : w current j^mu(w':w1,w2,w3) +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + COMPLEX*16 W1(6),W2(6),W3(6),JW3W(6) + COMPLEX*16 DW1(0:3),DW2(0:3),DW3(0:3), + & JJ(0:3),DV,W32,W13 + REAL*8 P1(0:3),P2(0:3),P3(0:3),Q(0:3),G,DG2,Q2 +C + REAL*8 RXZERO + PARAMETER( RXZERO=0.0D0 ) +C + JW3W(5) = W1(5)+W2(5)+W3(5) + JW3W(6) = W1(6)+W2(6)+W3(6) +C + DW1(0)=DCMPLX(W1(1)) + DW1(1)=DCMPLX(W1(2)) + DW1(2)=DCMPLX(W1(3)) + DW1(3)=DCMPLX(W1(4)) + DW2(0)=DCMPLX(W2(1)) + DW2(1)=DCMPLX(W2(2)) + DW2(2)=DCMPLX(W2(3)) + DW2(3)=DCMPLX(W2(4)) + DW3(0)=DCMPLX(W3(1)) + DW3(1)=DCMPLX(W3(2)) + DW3(2)=DCMPLX(W3(3)) + DW3(3)=DCMPLX(W3(4)) + P1(0)=DBLE( W1(5)) + P1(1)=DBLE( W1(6)) + P1(2)=DBLE(DIMAG(W1(6))) + P1(3)=DBLE(DIMAG(W1(5))) + P2(0)=DBLE( W2(5)) + P2(1)=DBLE( W2(6)) + P2(2)=DBLE(DIMAG(W2(6))) + P2(3)=DBLE(DIMAG(W2(5))) + P3(0)=DBLE( W3(5)) + P3(1)=DBLE( W3(6)) + P3(2)=DBLE(DIMAG(W3(6))) + P3(3)=DBLE(DIMAG(W3(5))) + Q(0)=-(P1(0)+P2(0)+P3(0)) + Q(1)=-(P1(1)+P2(1)+P3(1)) + Q(2)=-(P1(2)+P2(2)+P3(2)) + Q(3)=-(P1(3)+P2(3)+P3(3)) + + Q2 =Q(0)**2 -(Q(1)**2 +Q(2)**2 +Q(3)**2) + + DG2=DBLE(G)*DBLE(G) +C + DV = 1.0D0/DCMPLX( Q2 ) + +C for the running width, use below instead of the above dv. +C dv = 1.0d0/dcmplx( q2 -mv2 , dmax1(dwv*q2/dmv,0.d0) ) +C + W32=DW3(0)*DW2(0)-DW3(1)*DW2(1)-DW3(2)*DW2(2)-DW3(3)*DW2(3) +C +C + W13=DW1(0)*DW3(0)-DW1(1)*DW3(1)-DW1(2)*DW3(2)-DW1(3)*DW3(3) +C + JJ(0)=DG2*( DW1(0)*W32 - DW2(0)*W13 ) + JJ(1)=DG2*( DW1(1)*W32 - DW2(1)*W13 ) + JJ(2)=DG2*( DW1(2)*W32 - DW2(2)*W13 ) + JJ(3)=DG2*( DW1(3)*W32 - DW2(3)*W13 ) +C + JW3W(1) = DCMPLX( JJ(0)*DV ) + JW3W(2) = DCMPLX( JJ(1)*DV ) + JW3W(3) = DCMPLX( JJ(2)*DV ) + JW3W(4) = DCMPLX( JJ(3)*DV ) +C + RETURN + END +C +C ---------------------------------------------------------------------- +C + SUBROUTINE JGGXXX(V1,V2,G, JVV) +C +C this subroutine computes an off-shell vector current from the three- +C point gauge boson coupling. the vector propagator is given in feynman +C gauge for a massless vector and in unitary gauge for a massive vector. +C +C input: +C complex v1(6) : first vector v1 +C complex v2(6) : second vector v2 +C real g : coupling constant (see the table below) +C +C output: +C complex jvv(6) : vector current j^mu(v:v1,v2) +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + COMPLEX*16 V1(6),V2(6),JVV(6),J12(0:3), + & SV1,SV2,V12 + REAL*8 P1(0:3),P2(0:3),Q(0:3),G,GS,S +C + REAL*8 RXZERO + PARAMETER( RXZERO=0.0D0 ) +C + JVV(5) = V1(5)+V2(5) + JVV(6) = V1(6)+V2(6) +C + P1(0)=DBLE( V1(5)) + P1(1)=DBLE( V1(6)) + P1(2)=DIMAG(V1(6)) + P1(3)=DIMAG(V1(5)) + P2(0)=DBLE( V2(5)) + P2(1)=DBLE( V2(6)) + P2(2)=DIMAG(V2(6)) + P2(3)=DIMAG(V2(5)) + Q(0)=-DBLE( JVV(5)) + Q(1)=-DBLE( JVV(6)) + Q(2)=-DIMAG(JVV(6)) + Q(3)=-DIMAG(JVV(5)) + S=Q(0)**2-(Q(1)**2+Q(2)**2+Q(3)**2) +C + V12=V1(1)*V2(1)-V1(2)*V2(2)-V1(3)*V2(3)-V1(4)*V2(4) + SV1= (P2(0)-Q(0))*V1(1) -(P2(1)-Q(1))*V1(2) + & -(P2(2)-Q(2))*V1(3) -(P2(3)-Q(3))*V1(4) + SV2=-(P1(0)-Q(0))*V2(1) +(P1(1)-Q(1))*V2(2) + & +(P1(2)-Q(2))*V2(3) +(P1(3)-Q(3))*V2(4) + J12(0)=(P1(0)-P2(0))*V12 +SV1*V2(1) +SV2*V1(1) + J12(1)=(P1(1)-P2(1))*V12 +SV1*V2(2) +SV2*V1(2) + J12(2)=(P1(2)-P2(2))*V12 +SV1*V2(3) +SV2*V1(3) + J12(3)=(P1(3)-P2(3))*V12 +SV1*V2(4) +SV2*V1(4) +C + GS=-G/S +C + JVV(1) = GS*J12(0) + JVV(2) = GS*J12(1) + JVV(3) = GS*J12(2) + JVV(4) = GS*J12(3) +C + RETURN + END +C +C ---------------------------------------------------------------------- +C + SUBROUTINE JIOXXX(FI,FO,G,VMASS,VWIDTH , JIO) +C +C this subroutine computes an off-shell vector current from an external +C fermion pair. the vector boson propagator is given in feynman gauge +C for a massless vector and in unitary gauge for a massive vector. +C +C input: +C complex fi(6) : flow-in fermion |fi> +C complex fo(6) : flow-out fermion ) +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + COMPLEX*16 FI(6),FO(6),JIO(6),C0,C1,C2,C3,CS,D + REAL*8 G(2),Q(0:3),VMASS,VWIDTH,Q2,VM2,DD +C + REAL*8 RXZERO, RXONE + PARAMETER( RXZERO=0.0D0, RXONE=1.0D0 ) + COMPLEX*16 CXIMAG + LOGICAL FIRST + SAVE CXIMAG,FIRST + DATA FIRST/.TRUE./ +C +C Fix compilation with g77 + IF(FIRST) THEN + FIRST=.FALSE. + CXIMAG=DCMPLX( RXZERO, RXONE ) + ENDIF +C + JIO(5) = FO(5)-FI(5) + JIO(6) = FO(6)-FI(6) +C + Q(0)=DBLE( JIO(5)) + Q(1)=DBLE( JIO(6)) + Q(2)=DIMAG(JIO(6)) + Q(3)=DIMAG(JIO(5)) + Q2=Q(0)**2-(Q(1)**2+Q(2)**2+Q(3)**2) + VM2=VMASS**2 +C + IF (VMASS.NE.RXZERO) THEN +C + D=RXONE/DCMPLX( Q2-VM2 , MAX(SIGN( VMASS*VWIDTH ,Q2),RXZERO) ) +C for the running width, use below instead of the above d. +C d=r_one/dcmplx( q2-vm2 , max( vwidth*q2/vmass ,r_zero) ) +C + IF (G(2).NE.RXZERO) THEN +C + C0= G(1)*( FO(3)*FI(1)+FO(4)*FI(2)) + & +G(2)*( FO(1)*FI(3)+FO(2)*FI(4)) + C1= -G(1)*( FO(3)*FI(2)+FO(4)*FI(1)) + & +G(2)*( FO(1)*FI(4)+FO(2)*FI(3)) + C2=( G(1)*( FO(3)*FI(2)-FO(4)*FI(1)) + & +G(2)*(-FO(1)*FI(4)+FO(2)*FI(3)))*CXIMAG + C3= G(1)*(-FO(3)*FI(1)+FO(4)*FI(2)) + & +G(2)*( FO(1)*FI(3)-FO(2)*FI(4)) + ELSE +C + D=D*G(1) + C0= FO(3)*FI(1)+FO(4)*FI(2) + C1= -FO(3)*FI(2)-FO(4)*FI(1) + C2=( FO(3)*FI(2)-FO(4)*FI(1))*CXIMAG + C3= -FO(3)*FI(1)+FO(4)*FI(2) + END IF +C + CS=(Q(0)*C0-Q(1)*C1-Q(2)*C2-Q(3)*C3)/VM2 +C + JIO(1) = (C0-CS*Q(0))*D + JIO(2) = (C1-CS*Q(1))*D + JIO(3) = (C2-CS*Q(2))*D + JIO(4) = (C3-CS*Q(3))*D +C + ELSE + DD=RXONE/Q2 +C + IF (G(2).NE.RXZERO) THEN + JIO(1) = ( G(1)*( FO(3)*FI(1)+FO(4)*FI(2)) + & +G(2)*( FO(1)*FI(3)+FO(2)*FI(4)) )*DD + JIO(2) = (-G(1)*( FO(3)*FI(2)+FO(4)*FI(1)) + & +G(2)*( FO(1)*FI(4)+FO(2)*FI(3)) )*DD + JIO(3) = ( G(1)*( FO(3)*FI(2)-FO(4)*FI(1)) + & +G(2)*(-FO(1)*FI(4)+FO(2)*FI(3))) + $ *DCMPLX(RXZERO,DD) + JIO(4) = ( G(1)*(-FO(3)*FI(1)+FO(4)*FI(2)) + & +G(2)*( FO(1)*FI(3)-FO(2)*FI(4)) )*DD +C + ELSE + DD=DD*G(1) +C + JIO(1) = ( FO(3)*FI(1)+FO(4)*FI(2))*DD + JIO(2) = -( FO(3)*FI(2)+FO(4)*FI(1))*DD + JIO(3) = ( FO(3)*FI(2)-FO(4)*FI(1))*DCMPLX(RXZERO,DD) + JIO(4) = (-FO(3)*FI(1)+FO(4)*FI(2))*DD + END IF + END IF +C + RETURN + END +C ---------------------------------------------------------------------- +C + SUBROUTINE JSSXXX(S1,S2,G,VMASS,VWIDTH , JSS) +C +C This subroutine computes an off-shell vector current from the vector- +C scalar-scalar coupling. The coupling is absent in the minimal SM in +C unitary gauge. The propagator is given in Feynman gauge for a +C massless vector and in unitary gauge for a massive vector. +C +C INPUT: +C complex S1(3) : first scalar S1 +C complex S2(3) : second scalar S2 +C real G : coupling constant (S1 charge) +C real VMASS : mass of OUTPUT vector V +C real VWIDTH : width of OUTPUT vector V +C +C Examples of the coupling constant G for SUSY particles are as follows: +C ----------------------------------------------------------- +C | S1 | (Q,I3) of S1 || V=A | V=Z | V=W | +C ----------------------------------------------------------- +C | nu~_L | ( 0 , +1/2) || --- | GZN(1) | GWF(1) | +C | e~_L | ( -1 , -1/2) || GAL(1) | GZL(1) | GWF(1) | +C | u~_L | (+2/3 , +1/2) || GAU(1) | GZU(1) | GWF(1) | +C | d~_L | (-1/3 , -1/2) || GAD(1) | GZD(1) | GWF(1) | +C ----------------------------------------------------------- +C | e~_R-bar | ( +1 , 0 ) || -GAL(2) | -GZL(2) | -GWF(2) | +C | u~_R-bar | (-2/3 , 0 ) || -GAU(2) | -GZU(2) | -GWF(2) | +C | d~_R-bar | (+1/3 , 0 ) || -GAD(2) | -GZD(2) | -GWF(2) | +C ----------------------------------------------------------- +C where the S1 charge is defined by the flowing-OUT quantum number. +C +C OUTPUT: +C complex JSS(6) : vector current J^mu(V:S1,S2) +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + COMPLEX*16 S1(3),S2(3),JSS(6),DG,ADG + REAL*8 PP(0:3),PA(0:3),Q(0:3),G,VMASS,VWIDTH,Q2,VM2,MP2,MA2,M2D +C + JSS(5) = S1(2)+S2(2) + JSS(6) = S1(3)+S2(3) +C + Q(0)=DBLE( JSS(5)) + Q(1)=DBLE( JSS(6)) + Q(2)=DIMAG(JSS(6)) + Q(3)=DIMAG(JSS(5)) + Q2=Q(0)**2-(Q(1)**2+Q(2)**2+Q(3)**2) + VM2=VMASS**2 +C + IF (VMASS.EQ.0.) GOTO 10 +C + DG=G/DCMPLX( Q2-VM2, MAX(SIGN( VMASS*VWIDTH ,Q2),0.D0)) +C For the running width, use below instead of the above DG. +C DG=G/dCMPLX( Q2-VM2 , MAX( VWIDTH*Q2/VMASS ,0.) ) +C + ADG=DG*S1(1)*S2(1) +C + PP(0)=DBLE( S1(2)) + PP(1)=DBLE( S1(3)) + PP(2)=DIMAG(S1(3)) + PP(3)=DIMAG(S1(2)) + PA(0)=DBLE( S2(2)) + PA(1)=DBLE( S2(3)) + PA(2)=DIMAG(S2(3)) + PA(3)=DIMAG(S2(2)) + MP2=PP(0)**2-(PP(1)**2+PP(2)**2+PP(3)**2) + MA2=PA(0)**2-(PA(1)**2+PA(2)**2+PA(3)**2) + M2D=MP2-MA2 +C + JSS(1) = ADG*( (PP(0)-PA(0)) - Q(0)*M2D/VM2) + JSS(2) = ADG*( (PP(1)-PA(1)) - Q(1)*M2D/VM2) + JSS(3) = ADG*( (PP(2)-PA(2)) - Q(2)*M2D/VM2) + JSS(4) = ADG*( (PP(3)-PA(3)) - Q(3)*M2D/VM2) +C + RETURN +C + 10 ADG=G*S1(1)*S2(1)/Q2 +C + JSS(1) = ADG*DBLE( S1(2)-S2(2)) + JSS(2) = ADG*DBLE( S1(3)-S2(3)) + JSS(3) = ADG*DIMAG(S1(3)-S2(3)) + JSS(4) = ADG*DIMAG(S1(2)-S2(2)) +C + RETURN + END +C +C +C ---------------------------------------------------------------------- +C + SUBROUTINE JTIOXX(FI,FO,G , JIO) +C +C this subroutine computes an off-shell vector current from an external +C fermion pair. the vector boson propagator is not included in this +C routine. +C +C input: +C complex fi(6) : flow-in fermion |fi> +C complex fo(6) : flow-out fermion ) +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + COMPLEX*16 FI(6),FO(6),JIO(6) + REAL*8 G(2) +C + REAL*8 RXZERO, RXONE + PARAMETER( RXZERO=0.0D0, RXONE=1.0D0 ) + COMPLEX*16 CXIMAG + LOGICAL FIRST + SAVE CXIMAG,FIRST + DATA FIRST/.TRUE./ +C +C Fix compilation with g77 + IF(FIRST) THEN + FIRST=.FALSE. + CXIMAG=DCMPLX( RXZERO, RXONE ) + ENDIF +C + JIO(5) = FO(5)-FI(5) + JIO(6) = FO(6)-FI(6) +C + IF ( G(2) .NE. RXZERO ) THEN + JIO(1) = ( G(1)*( FO(3)*FI(1)+FO(4)*FI(2)) + & +G(2)*( FO(1)*FI(3)+FO(2)*FI(4)) ) + JIO(2) = (-G(1)*( FO(3)*FI(2)+FO(4)*FI(1)) + & +G(2)*( FO(1)*FI(4)+FO(2)*FI(3)) ) + JIO(3) = ( G(1)*( FO(3)*FI(2)-FO(4)*FI(1)) + & +G(2)*(-FO(1)*FI(4)+FO(2)*FI(3)) )*CXIMAG + JIO(4) = ( G(1)*(-FO(3)*FI(1)+FO(4)*FI(2)) + & +G(2)*( FO(1)*FI(3)-FO(2)*FI(4)) ) +C + ELSE + JIO(1) = ( FO(3)*FI(1)+FO(4)*FI(2))*G(1) + JIO(2) = -( FO(3)*FI(2)+FO(4)*FI(1))*G(1) + JIO(3) = ( FO(3)*FI(2)-FO(4)*FI(1))*DCMPLX(RXZERO,G(1)) + JIO(4) = (-FO(3)*FI(1)+FO(4)*FI(2))*G(1) + END IF +C + RETURN + END +C ---------------------------------------------------------------------- +C + SUBROUTINE JVSSXX(VC,S1,S2,G,VMASS,VWIDTH , JVSS) +C +C This subroutine computes an off-shell vector current from the vector- +C vector-scalar-scalar coupling. The vector propagator is given in +C Feynman gauge for a massless vector and in unitary gauge for a massive +C vector. +C +C INPUT: +C complex VC(6) : input vector V +C complex S1(3) : first scalar S1 +C complex S2(3) : second scalar S2 +C real G : coupling constant GVVHH +C real VMASS : mass of OUTPUT vector V' +C real VWIDTH : width of OUTPUT vector V' +C +C OUTPUT: +C complex JVSS(6) : vector current J^mu(V':V,S1,S2) +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + COMPLEX*16 VC(6),S1(3),S2(3),JVSS(6),DG + REAL*8 Q(0:3),G,VMASS,VWIDTH,Q2,VK,VM2 +C + JVSS(5) = VC(5)+S1(2)+S2(2) + JVSS(6) = VC(6)+S1(3)+S2(3) +C + Q(0)=DBLE( JVSS(5)) + Q(1)=DBLE( JVSS(6)) + Q(2)=DIMAG(JVSS(6)) + Q(3)=DIMAG(JVSS(5)) + Q2=Q(0)**2-(Q(1)**2+Q(2)**2+Q(3)**2) + VM2=VMASS**2 +C + IF (VMASS.EQ.0.) GOTO 10 +C + DG=G*S1(1)*S2(1)/DCMPLX( Q2-VM2,MAX(SIGN( VMASS*VWIDTH,Q2),0.D0)) +C For the running width, use below instead of the above DG. +C DG=G*S1(1)*S2(1)/CMPLX( Q2-VM2 , MAX( VWIDTH*Q2/VMASS ,0.)) +C + VK=(Q(0)*VC(1)-Q(1)*VC(2)-Q(2)*VC(3)-Q(3)*VC(4))/VM2 +C + JVSS(1) = DG*(VC(1)-VK*Q(0)) + JVSS(2) = DG*(VC(2)-VK*Q(1)) + JVSS(3) = DG*(VC(3)-VK*Q(2)) + JVSS(4) = DG*(VC(4)-VK*Q(3)) +C + RETURN +C + 10 DG= G*S1(1)*S2(1)/Q2 +C + JVSS(1) = DG*VC(1) + JVSS(2) = DG*VC(2) + JVSS(3) = DG*VC(3) + JVSS(4) = DG*VC(4) +C + RETURN + END +C +C +C ---------------------------------------------------------------------- +C + SUBROUTINE JVSXXX(VC,SC,G,VMASS,VWIDTH , JVS) +C +C this subroutine computes an off-shell vector current from the vector- +C vector-scalar coupling. the vector propagator is given in feynman +C gauge for a massless vector and in unitary gauge for a massive vector. +C +C input: +C complex vc(6) : input vector v +C complex sc(3) : input scalar s +C real g : coupling constant gvvh +C real vmass : mass of output vector v' +C real vwidth : width of output vector v' +C +C output: +C complex jvs(6) : vector current j^mu(v':v,s) +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + COMPLEX*16 VC(6),SC(3),JVS(6),DG,VK + REAL*8 Q(0:3),VMASS,VWIDTH,Q2,VM2,G +C + JVS(5) = VC(5)+SC(2) + JVS(6) = VC(6)+SC(3) +C + Q(0)=DBLE( JVS(5)) + Q(1)=DBLE( JVS(6)) + Q(2)=DIMAG(JVS(6)) + Q(3)=DIMAG(JVS(5)) + Q2=Q(0)**2-(Q(1)**2+Q(2)**2+Q(3)**2) + VM2=VMASS**2 +C + IF (VMASS.EQ.0.) GOTO 10 +C + DG=G*SC(1)/DCMPLX( Q2-VM2 , MAX(DSIGN( VMASS*VWIDTH ,Q2),0.D0) ) +C for the running width, use below instead of the above dg. +C dg=g*sc(1)/dcmplx( q2-vm2 , max( vwidth*q2/vmass ,0.) ) +C + VK=(-Q(0)*VC(1)+Q(1)*VC(2)+Q(2)*VC(3)+Q(3)*VC(4))/VM2 +C + JVS(1) = DG*(Q(0)*VK+VC(1)) + JVS(2) = DG*(Q(1)*VK+VC(2)) + JVS(3) = DG*(Q(2)*VK+VC(3)) + JVS(4) = DG*(Q(3)*VK+VC(4)) +C + RETURN +C + 10 DG=G*SC(1)/Q2 +C + JVS(1) = DG*VC(1) + JVS(2) = DG*VC(2) + JVS(3) = DG*VC(3) + JVS(4) = DG*VC(4) +C + RETURN + END + + +C +C ---------------------------------------------------------------------- +C + SUBROUTINE JVVXXX(V1,V2,G,VMASS,VWIDTH , JVV) +C +C this subroutine computes an off-shell vector current from the three- +C point gauge boson coupling. the vector propagator is given in feynman +C gauge for a massless vector and in unitary gauge for a massive vector. +C +C input: +C complex v1(6) : first vector v1 +C complex v2(6) : second vector v2 +C real g : coupling constant (see the table below) +C real vmass : mass of output vector v +C real vwidth : width of output vector v +C +C the possible sets of the inputs are as follows: +C ------------------------------------------------------------------ +C | v1 | v2 | jvv | g | vmass | vwidth | +C ------------------------------------------------------------------ +C | w- | w+ | a/z | gwwa/gwwz | 0./zmass | 0./zwidth | +C | w3/a/z | w- | w+ | gw/gwwa/gwwz | wmass | wwidth | +C | w+ | w3/a/z | w- | gw/gwwa/gwwz | wmass | wwidth | +C ------------------------------------------------------------------ +C where all the bosons are defined by the flowing-out quantum number. +C +C output: +C complex jvv(6) : vector current j^mu(v:v1,v2) +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + COMPLEX*16 V1(6),V2(6),JVV(6),J12(0:3),JS,DG, + & SV1,SV2,S11,S12,S21,S22,V12 + REAL*8 P1(0:3),P2(0:3),Q(0:3),G,VMASS,VWIDTH,GS,S,VM2,M1,M2 +C + REAL*8 RXZERO + PARAMETER( RXZERO=0.0D0 ) +C + JVV(5) = V1(5)+V2(5) + JVV(6) = V1(6)+V2(6) +C + P1(0)=DBLE( V1(5)) + P1(1)=DBLE( V1(6)) + P1(2)=DIMAG(V1(6)) + P1(3)=DIMAG(V1(5)) + P2(0)=DBLE( V2(5)) + P2(1)=DBLE( V2(6)) + P2(2)=DIMAG(V2(6)) + P2(3)=DIMAG(V2(5)) + Q(0)=-DBLE( JVV(5)) + Q(1)=-DBLE( JVV(6)) + Q(2)=-DIMAG(JVV(6)) + Q(3)=-DIMAG(JVV(5)) + S=Q(0)**2-(Q(1)**2+Q(2)**2+Q(3)**2) +C + V12=V1(1)*V2(1)-V1(2)*V2(2)-V1(3)*V2(3)-V1(4)*V2(4) + SV1= (P2(0)-Q(0))*V1(1) -(P2(1)-Q(1))*V1(2) + & -(P2(2)-Q(2))*V1(3) -(P2(3)-Q(3))*V1(4) + SV2=-(P1(0)-Q(0))*V2(1) +(P1(1)-Q(1))*V2(2) + & +(P1(2)-Q(2))*V2(3) +(P1(3)-Q(3))*V2(4) + J12(0)=(P1(0)-P2(0))*V12 +SV1*V2(1) +SV2*V1(1) + J12(1)=(P1(1)-P2(1))*V12 +SV1*V2(2) +SV2*V1(2) + J12(2)=(P1(2)-P2(2))*V12 +SV1*V2(3) +SV2*V1(3) + J12(3)=(P1(3)-P2(3))*V12 +SV1*V2(4) +SV2*V1(4) +C + IF ( VMASS .NE. RXZERO ) THEN + VM2=VMASS**2 + M1=P1(0)**2-(P1(1)**2+P1(2)**2+P1(3)**2) + M2=P2(0)**2-(P2(1)**2+P2(2)**2+P2(3)**2) + S11=P1(0)*V1(1)-P1(1)*V1(2)-P1(2)*V1(3)-P1(3)*V1(4) + S12=P1(0)*V2(1)-P1(1)*V2(2)-P1(2)*V2(3)-P1(3)*V2(4) + S21=P2(0)*V1(1)-P2(1)*V1(2)-P2(2)*V1(3)-P2(3)*V1(4) + S22=P2(0)*V2(1)-P2(1)*V2(2)-P2(2)*V2(3)-P2(3)*V2(4) + JS=(V12*(-M1+M2) +S11*S12 -S21*S22)/VM2 +C + DG=-G/DCMPLX( S-VM2 , MAX(SIGN( VMASS*VWIDTH ,S),RXZERO) ) +C +C for the running width, use below instead of the above dg. +C dg=-g/dcmplx( s-vm2 , max( vwidth*s/vmass ,r_zero) ) +C + JVV(1) = DG*(J12(0)-Q(0)*JS) + JVV(2) = DG*(J12(1)-Q(1)*JS) + JVV(3) = DG*(J12(2)-Q(2)*JS) + JVV(4) = DG*(J12(3)-Q(3)*JS) +C + ELSE + GS=-G/S +C + JVV(1) = GS*J12(0) + JVV(2) = GS*J12(1) + JVV(3) = GS*J12(2) + JVV(4) = GS*J12(3) + END IF +C + RETURN + END +C +C ---------------------------------------------------------------------- +C + SUBROUTINE JW3WXX(W1,W2,W3,G1,G2,WMASS,WWIDTH,VMASS,VWIDTH , JW3W) +C +C this subroutine computes an off-shell w+, w-, w3, z or photon current +C from the four-point gauge boson coupling, including the contributions +C of w exchange diagrams. the vector propagator is given in feynman +C gauge for a photon and in unitary gauge for w and z bosons. if one +C sets wmass=0.0, then the ggg-->g current is given (see sect 2.9.1 of +C the manual). +C +C input: +C complex w1(6) : first vector w1 +C complex w2(6) : second vector w2 +C complex w3(6) : third vector w3 +C real g1 : first coupling constant +C real g2 : second coupling constant +C (see the table below) +C real wmass : mass of internal w +C real wwidth : width of internal w +C real vmass : mass of output w' +C real vwidth : width of output w' +C +C the possible sets of the inputs are as follows: +C ------------------------------------------------------------------- +C | w1 | w2 | w3 | g1 | g2 |wmass|wwidth|vmass|vwidth || jw3w | +C ------------------------------------------------------------------- +C | w- | w3 | w+ | gw |gwwz|wmass|wwidth|zmass|zwidth || z | +C | w- | w3 | w+ | gw |gwwa|wmass|wwidth| 0. | 0. || a | +C | w- | z | w+ |gwwz|gwwz|wmass|wwidth|zmass|zwidth || z | +C | w- | z | w+ |gwwz|gwwa|wmass|wwidth| 0. | 0. || a | +C | w- | a | w+ |gwwa|gwwz|wmass|wwidth|zmass|zwidth || z | +C | w- | a | w+ |gwwa|gwwa|wmass|wwidth| 0. | 0. || a | +C ------------------------------------------------------------------- +C | w3 | w- | w3 | gw | gw |wmass|wwidth|wmass|wwidth || w+ | +C | w3 | w+ | w3 | gw | gw |wmass|wwidth|wmass|wwidth || w- | +C | w3 | w- | z | gw |gwwz|wmass|wwidth|wmass|wwidth || w+ | +C | w3 | w+ | z | gw |gwwz|wmass|wwidth|wmass|wwidth || w- | +C | w3 | w- | a | gw |gwwa|wmass|wwidth|wmass|wwidth || w+ | +C | w3 | w+ | a | gw |gwwa|wmass|wwidth|wmass|wwidth || w- | +C | z | w- | z |gwwz|gwwz|wmass|wwidth|wmass|wwidth || w+ | +C | z | w+ | z |gwwz|gwwz|wmass|wwidth|wmass|wwidth || w- | +C | z | w- | a |gwwz|gwwa|wmass|wwidth|wmass|wwidth || w+ | +C | z | w+ | a |gwwz|gwwa|wmass|wwidth|wmass|wwidth || w- | +C | a | w- | a |gwwa|gwwa|wmass|wwidth|wmass|wwidth || w+ | +C | a | w+ | a |gwwa|gwwa|wmass|wwidth|wmass|wwidth || w- | +C ------------------------------------------------------------------- +C where all the bosons are defined by the flowing-out quantum number. +C +C output: +C complex jw3w(6) : w current j^mu(w':w1,w2,w3) +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + COMPLEX*16 W1(6),W2(6),W3(6),JW3W(6) + COMPLEX*16 DW1(0:3),DW2(0:3),DW3(0:3), + & JJ(0:3),J4(0:3), + & DV,W12,W32,W13, + & JQ + REAL*8 G1,G2,WMASS,WWIDTH,VMASS,VWIDTH + REAL*8 P1(0:3),P2(0:3),P3(0:3),Q(0:3), + & DG2,DMV,DWV,MV2,Q2 +C + REAL*8 RXZERO + PARAMETER( RXZERO=0.0D0 ) +C + JW3W(5) = W1(5)+W2(5)+W3(5) + JW3W(6) = W1(6)+W2(6)+W3(6) +C + DW1(0)=DCMPLX(W1(1)) + DW1(1)=DCMPLX(W1(2)) + DW1(2)=DCMPLX(W1(3)) + DW1(3)=DCMPLX(W1(4)) + DW2(0)=DCMPLX(W2(1)) + DW2(1)=DCMPLX(W2(2)) + DW2(2)=DCMPLX(W2(3)) + DW2(3)=DCMPLX(W2(4)) + DW3(0)=DCMPLX(W3(1)) + DW3(1)=DCMPLX(W3(2)) + DW3(2)=DCMPLX(W3(3)) + DW3(3)=DCMPLX(W3(4)) + P1(0)=DBLE( W1(5)) + P1(1)=DBLE( W1(6)) + P1(2)=DBLE(DIMAG(W1(6))) + P1(3)=DBLE(DIMAG(W1(5))) + P2(0)=DBLE( W2(5)) + P2(1)=DBLE( W2(6)) + P2(2)=DBLE(DIMAG(W2(6))) + P2(3)=DBLE(DIMAG(W2(5))) + P3(0)=DBLE( W3(5)) + P3(1)=DBLE( W3(6)) + P3(2)=DBLE(DIMAG(W3(6))) + P3(3)=DBLE(DIMAG(W3(5))) + Q(0)=-(P1(0)+P2(0)+P3(0)) + Q(1)=-(P1(1)+P2(1)+P3(1)) + Q(2)=-(P1(2)+P2(2)+P3(2)) + Q(3)=-(P1(3)+P2(3)+P3(3)) + + + Q2 =Q(0)**2 -(Q(1)**2 +Q(2)**2 +Q(3)**2) + DG2=DBLE(G1)*DBLE(G2) + DMV=DBLE(VMASS) + DWV=DBLE(VWIDTH) + MV2=DMV**2 + IF (VMASS.EQ. RXZERO) THEN + DV = 1.0D0/DCMPLX( Q2 ) + ELSE + DV = 1.0D0/DCMPLX( Q2 -MV2 , DMAX1(DSIGN(DMV*DWV,Q2 ),0.D0) ) + ENDIF +C for the running width, use below instead of the above dv. +C dv = 1.0d0/dcmplx( q2 -mv2 , dmax1(dwv*q2/dmv,0.d0) ) +C + W12=DW1(0)*DW2(0)-DW1(1)*DW2(1)-DW1(2)*DW2(2)-DW1(3)*DW2(3) + W32=DW3(0)*DW2(0)-DW3(1)*DW2(1)-DW3(2)*DW2(2)-DW3(3)*DW2(3) +C + IF ( WMASS .NE. RXZERO ) THEN + W13=DW1(0)*DW3(0)-DW1(1)*DW3(1)-DW1(2)*DW3(2)-DW1(3)*DW3(3) +C + J4(0)=DG2*( DW1(0)*W32 + DW3(0)*W12 - 2.D0*DW2(0)*W13 ) + J4(1)=DG2*( DW1(1)*W32 + DW3(1)*W12 - 2.D0*DW2(1)*W13 ) + J4(2)=DG2*( DW1(2)*W32 + DW3(2)*W12 - 2.D0*DW2(2)*W13 ) + J4(3)=DG2*( DW1(3)*W32 + DW3(3)*W12 - 2.D0*DW2(3)*W13 ) +C + JJ(0)=J4(0) + JJ(1)=J4(1) + JJ(2)=J4(2) + JJ(3)=J4(3) + + ELSE +C + W12=DW1(0)*DW2(0)-DW1(1)*DW2(1)-DW1(2)*DW2(2)-DW1(3)*DW2(3) + W32=DW3(0)*DW2(0)-DW3(1)*DW2(1)-DW3(2)*DW2(2)-DW3(3)*DW2(3) + W13=DW1(0)*DW3(0)-DW1(1)*DW3(1)-DW1(2)*DW3(2)-DW1(3)*DW3(3) +C + J4(0)=DG2*( DW1(0)*W32 - DW2(0)*W13 ) + J4(1)=DG2*( DW1(1)*W32 - DW2(1)*W13 ) + J4(2)=DG2*( DW1(2)*W32 - DW2(2)*W13 ) + J4(3)=DG2*( DW1(3)*W32 - DW2(3)*W13 ) +C + JJ(0)=J4(0) + JJ(1)=J4(1) + JJ(2)=J4(2) + JJ(3)=J4(3) + + END IF +C + IF ( VMASS .NE. RXZERO ) THEN +C + JQ=(JJ(0)*Q(0)-JJ(1)*Q(1)-JJ(2)*Q(2)-JJ(3)*Q(3))/MV2 +C + JW3W(1) = DCMPLX( (JJ(0)-JQ*Q(0))*DV ) + JW3W(2) = DCMPLX( (JJ(1)-JQ*Q(1))*DV ) + JW3W(3) = DCMPLX( (JJ(2)-JQ*Q(2))*DV ) + JW3W(4) = DCMPLX( (JJ(3)-JQ*Q(3))*DV ) +C + ELSE +C + JW3W(1) = DCMPLX( JJ(0)*DV ) + JW3W(2) = DCMPLX( JJ(1)*DV ) + JW3W(3) = DCMPLX( JJ(2)*DV ) + JW3W(4) = DCMPLX( JJ(3)*DV ) + END IF +C + RETURN + END +C +C ---------------------------------------------------------------------- +C + SUBROUTINE JWWWXX(W1,W2,W3,GWWA,GWWZ,ZMASS,ZWIDTH,WMASS,WWIDTH , + & JWWW) +C +C this subroutine computes an off-shell w+/w- current from the four- +C point gauge boson coupling, including the contributions of photon and +C z exchanges. the vector propagators for the output w and the internal +C z bosons are given in unitary gauge, and that of the internal photon +C is given in feynman gauge. +C +C input: +C complex w1(6) : first vector w1 +C complex w2(6) : second vector w2 +C complex w3(6) : third vector w3 +C real gwwa : coupling constant of w and a gwwa +C real gwwz : coupling constant of w and z gwwz +C real zmass : mass of internal z +C real zwidth : width of internal z +C real wmass : mass of output w +C real wwidth : width of output w +C +C the possible sets of the inputs are as follows: +C ------------------------------------------------------------------- +C | w1 | w2 | w3 |gwwa|gwwz|zmass|zwidth|wmass|wwidth || jwww | +C ------------------------------------------------------------------- +C | w- | w+ | w- |gwwa|gwwz|zmass|zwidth|wmass|wwidth || w+ | +C | w+ | w- | w+ |gwwa|gwwz|zmass|zwidth|wmass|wwidth || w- | +C ------------------------------------------------------------------- +C where all the bosons are defined by the flowing-out quantum number. +C +C output: +C complex jwww(6) : w current j^mu(w':w1,w2,w3) +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + COMPLEX*16 W1(6),W2(6),W3(6),JWWW(6) + COMPLEX*16 DW1(0:3),DW2(0:3),DW3(0:3), + & JJ(0:3),JS(0:3),JT(0:3),J4(0:3), + & JT12(0:3),JT32(0:3),J12(0:3),J32(0:3), + & DZS,DZT,DW,W12,W32,W13,P1W2,P2W1,P3W2,P2W3, + & JK12,JK32,JSW3,JTW1,P3JS,KSW3,P1JT,KTW1,JQ + REAL*8 GWWA,GWWZ,ZMASS,ZWIDTH,WMASS,WWIDTH + REAL*8 P1(0:3),P2(0:3),P3(0:3),Q(0:3),KS(0:3),KT(0:3), + & DGWWA2,DGWWZ2,DGW2,DMZ,DWZ,DMW,DWW,MZ2,MW2,Q2,KS2,KT2, + & DAS,DAT +C + JWWW(5) = W1(5)+W2(5)+W3(5) + JWWW(6) = W1(6)+W2(6)+W3(6) +C + DW1(0)=DCMPLX(W1(1)) + DW1(1)=DCMPLX(W1(2)) + DW1(2)=DCMPLX(W1(3)) + DW1(3)=DCMPLX(W1(4)) + DW2(0)=DCMPLX(W2(1)) + DW2(1)=DCMPLX(W2(2)) + DW2(2)=DCMPLX(W2(3)) + DW2(3)=DCMPLX(W2(4)) + DW3(0)=DCMPLX(W3(1)) + DW3(1)=DCMPLX(W3(2)) + DW3(2)=DCMPLX(W3(3)) + DW3(3)=DCMPLX(W3(4)) + P1(0)=DBLE( W1(5)) + P1(1)=DBLE( W1(6)) + P1(2)=DBLE(DIMAG(W1(6))) + P1(3)=DBLE(DIMAG(W1(5))) + P2(0)=DBLE( W2(5)) + P2(1)=DBLE( W2(6)) + P2(2)=DBLE(DIMAG(W2(6))) + P2(3)=DBLE(DIMAG(W2(5))) + P3(0)=DBLE( W3(5)) + P3(1)=DBLE( W3(6)) + P3(2)=DBLE(DIMAG(W3(6))) + P3(3)=DBLE(DIMAG(W3(5))) + Q(0)=-(P1(0)+P2(0)+P3(0)) + Q(1)=-(P1(1)+P2(1)+P3(1)) + Q(2)=-(P1(2)+P2(2)+P3(2)) + Q(3)=-(P1(3)+P2(3)+P3(3)) + KS(0)=P1(0)+P2(0) + KS(1)=P1(1)+P2(1) + KS(2)=P1(2)+P2(2) + KS(3)=P1(3)+P2(3) + KT(0)=P2(0)+P3(0) + KT(1)=P2(1)+P3(1) + KT(2)=P2(2)+P3(2) + KT(3)=P2(3)+P3(3) + Q2 =Q(0)**2 -(Q(1)**2 +Q(2)**2 +Q(3)**2) + KS2=KS(0)**2-(KS(1)**2+KS(2)**2+KS(3)**2) + KT2=KT(0)**2-(KT(1)**2+KT(2)**2+KT(3)**2) + DGWWA2=DBLE(GWWA)**2 + DGWWZ2=DBLE(GWWZ)**2 + DGW2 =DGWWA2+DGWWZ2 + DMZ=DBLE(ZMASS) + DWZ=DBLE(ZWIDTH) + DMW=DBLE(WMASS) + DWW=DBLE(WWIDTH) + MZ2=DMZ**2 + MW2=DMW**2 +C + DAS=-DGWWA2/KS2 + DAT=-DGWWA2/KT2 + DZS=-DGWWZ2/DCMPLX( KS2-MZ2 , DMAX1(DSIGN(DMZ*DWZ,KS2),0.D0) ) + DZT=-DGWWZ2/DCMPLX( KT2-MZ2 , DMAX1(DSIGN(DMZ*DWZ,KT2),0.D0) ) + DW =-1.0D0/DCMPLX( Q2 -MW2 , DMAX1(DSIGN(DMW*DWW,Q2 ),0.D0) ) +C for the running width, use below instead of the above dw. +C dw =-1.0d0/dcmplx( q2 -mw2 , dmax1(dww*q2/dmw,0.d0) ) +C + W12=DW1(0)*DW2(0)-DW1(1)*DW2(1)-DW1(2)*DW2(2)-DW1(3)*DW2(3) + W32=DW3(0)*DW2(0)-DW3(1)*DW2(1)-DW3(2)*DW2(2)-DW3(3)*DW2(3) +C + P1W2= (P1(0)+KS(0))*DW2(0)-(P1(1)+KS(1))*DW2(1) + & -(P1(2)+KS(2))*DW2(2)-(P1(3)+KS(3))*DW2(3) + P2W1= (P2(0)+KS(0))*DW1(0)-(P2(1)+KS(1))*DW1(1) + & -(P2(2)+KS(2))*DW1(2)-(P2(3)+KS(3))*DW1(3) + P3W2= (P3(0)+KT(0))*DW2(0)-(P3(1)+KT(1))*DW2(1) + & -(P3(2)+KT(2))*DW2(2)-(P3(3)+KT(3))*DW2(3) + P2W3= (P2(0)+KT(0))*DW3(0)-(P2(1)+KT(1))*DW3(1) + & -(P2(2)+KT(2))*DW3(2)-(P2(3)+KT(3))*DW3(3) +C + JT12(0)= (P1(0)-P2(0))*W12 + P2W1*DW2(0) - P1W2*DW1(0) + JT12(1)= (P1(1)-P2(1))*W12 + P2W1*DW2(1) - P1W2*DW1(1) + JT12(2)= (P1(2)-P2(2))*W12 + P2W1*DW2(2) - P1W2*DW1(2) + JT12(3)= (P1(3)-P2(3))*W12 + P2W1*DW2(3) - P1W2*DW1(3) + JT32(0)= (P3(0)-P2(0))*W32 + P2W3*DW2(0) - P3W2*DW3(0) + JT32(1)= (P3(1)-P2(1))*W32 + P2W3*DW2(1) - P3W2*DW3(1) + JT32(2)= (P3(2)-P2(2))*W32 + P2W3*DW2(2) - P3W2*DW3(2) + JT32(3)= (P3(3)-P2(3))*W32 + P2W3*DW2(3) - P3W2*DW3(3) +C + JK12=(JT12(0)*KS(0)-JT12(1)*KS(1)-JT12(2)*KS(2)-JT12(3)*KS(3))/MZ2 + JK32=(JT32(0)*KT(0)-JT32(1)*KT(1)-JT32(2)*KT(2)-JT32(3)*KT(3))/MZ2 +C + J12(0)=JT12(0)*(DAS+DZS)-KS(0)*JK12*DZS + J12(1)=JT12(1)*(DAS+DZS)-KS(1)*JK12*DZS + J12(2)=JT12(2)*(DAS+DZS)-KS(2)*JK12*DZS + J12(3)=JT12(3)*(DAS+DZS)-KS(3)*JK12*DZS + J32(0)=JT32(0)*(DAT+DZT)-KT(0)*JK32*DZT + J32(1)=JT32(1)*(DAT+DZT)-KT(1)*JK32*DZT + J32(2)=JT32(2)*(DAT+DZT)-KT(2)*JK32*DZT + J32(3)=JT32(3)*(DAT+DZT)-KT(3)*JK32*DZT +C + JSW3=J12(0)*DW3(0)-J12(1)*DW3(1)-J12(2)*DW3(2)-J12(3)*DW3(3) + JTW1=J32(0)*DW1(0)-J32(1)*DW1(1)-J32(2)*DW1(2)-J32(3)*DW1(3) +C + P3JS= (P3(0)-Q(0))*J12(0)-(P3(1)-Q(1))*J12(1) + & -(P3(2)-Q(2))*J12(2)-(P3(3)-Q(3))*J12(3) + KSW3= (KS(0)-Q(0))*DW3(0)-(KS(1)-Q(1))*DW3(1) + & -(KS(2)-Q(2))*DW3(2)-(KS(3)-Q(3))*DW3(3) + P1JT= (P1(0)-Q(0))*J32(0)-(P1(1)-Q(1))*J32(1) + & -(P1(2)-Q(2))*J32(2)-(P1(3)-Q(3))*J32(3) + KTW1= (KT(0)-Q(0))*DW1(0)-(KT(1)-Q(1))*DW1(1) + & -(KT(2)-Q(2))*DW1(2)-(KT(3)-Q(3))*DW1(3) +C + JS(0)= (KS(0)-P3(0))*JSW3 + P3JS*DW3(0) - KSW3*J12(0) + JS(1)= (KS(1)-P3(1))*JSW3 + P3JS*DW3(1) - KSW3*J12(1) + JS(2)= (KS(2)-P3(2))*JSW3 + P3JS*DW3(2) - KSW3*J12(2) + JS(3)= (KS(3)-P3(3))*JSW3 + P3JS*DW3(3) - KSW3*J12(3) + JT(0)= (KT(0)-P1(0))*JTW1 + P1JT*DW1(0) - KTW1*J32(0) + JT(1)= (KT(1)-P1(1))*JTW1 + P1JT*DW1(1) - KTW1*J32(1) + JT(2)= (KT(2)-P1(2))*JTW1 + P1JT*DW1(2) - KTW1*J32(2) + JT(3)= (KT(3)-P1(3))*JTW1 + P1JT*DW1(3) - KTW1*J32(3) +C + W13=DW1(0)*DW3(0)-DW1(1)*DW3(1)-DW1(2)*DW3(2)-DW1(3)*DW3(3) +C + J4(0)=DGW2*( DW1(0)*W32 + DW3(0)*W12 - 2.D0*DW2(0)*W13 ) + J4(1)=DGW2*( DW1(1)*W32 + DW3(1)*W12 - 2.D0*DW2(1)*W13 ) + J4(2)=DGW2*( DW1(2)*W32 + DW3(2)*W12 - 2.D0*DW2(2)*W13 ) + J4(3)=DGW2*( DW1(3)*W32 + DW3(3)*W12 - 2.D0*DW2(3)*W13 ) +C +C jj(0)=js(0)+jt(0)+j4(0) +C jj(1)=js(1)+jt(1)+j4(1) +C jj(2)=js(2)+jt(2)+j4(2) +C jj(3)=js(3)+jt(3)+j4(3) + + JJ(0)=J4(0) + JJ(1)=J4(1) + JJ(2)=J4(2) + JJ(3)=J4(3) +C + JQ=(JJ(0)*Q(0)-JJ(1)*Q(1)-JJ(2)*Q(2)-JJ(3)*Q(3))/MW2 +C + + JWWW(1) = DCMPLX( (JJ(0)-JQ*Q(0))*DW ) + JWWW(2) = DCMPLX( (JJ(1)-JQ*Q(1))*DW ) + JWWW(3) = DCMPLX( (JJ(2)-JQ*Q(2))*DW ) + JWWW(4) = DCMPLX( (JJ(3)-JQ*Q(3))*DW ) +C + RETURN + END + +C +C ---------------------------------------------------------------------- +C + SUBROUTINE MOM2CX(ESUM,MASS1,MASS2,COSTH1,PHI1 , P1,P2) +C +C This subroutine sets up two four-momenta in the two particle rest +C frame. +C +C INPUT: +C real ESUM : energy sum of particle 1 and 2 +C real MASS1 : mass of particle 1 +C real MASS2 : mass of particle 2 +C real COSTH1 : cos(theta) of particle 1 +C real PHI1 : azimuthal angle of particle 1 +C +C OUTPUT: +C real P1(0:3) : four-momentum of particle 1 +C real P2(0:3) : four-momentum of particle 2 +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + REAL*8 P1(0:3),P2(0:3), + & ESUM,MASS1,MASS2,COSTH1,PHI1,MD2,ED,PP,SINTH1 +C + MD2=(MASS1-MASS2)*(MASS1+MASS2) + ED=MD2/ESUM + IF (MASS1*MASS2.EQ.0.) THEN + PP=(ESUM-ABS(ED))*0.5D0 +C + ELSE + PP=SQRT((MD2/ESUM)**2-2.0D0*(MASS1**2+MASS2**2)+ESUM**2)*0.5D0 + ENDIF + SINTH1=SQRT((1.0D0-COSTH1)*(1.0D0+COSTH1)) +C + P1(0) = MAX((ESUM+ED)*0.5D0,0.D0) + P1(1) = PP*SINTH1*COS(PHI1) + P1(2) = PP*SINTH1*SIN(PHI1) + P1(3) = PP*COSTH1 +C + P2(0) = MAX((ESUM-ED)*0.5D0,0.D0) + P2(1) = -P1(1) + P2(2) = -P1(2) + P2(3) = -P1(3) +C + RETURN + END +C ********************************************************************** +C + SUBROUTINE MOMNTX(ENERGY,MASS,COSTH,PHI , P) +C +C This subroutine sets up a four-momentum from the four inputs. +C +C INPUT: +C real ENERGY : energy +C real MASS : mass +C real COSTH : cos(theta) +C real PHI : azimuthal angle +C +C OUTPUT: +C real P(0:3) : four-momentum +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + REAL*8 P(0:3),ENERGY,MASS,COSTH,PHI,PP,SINTH +C + P(0) = ENERGY + IF (ENERGY.EQ.MASS) THEN + P(1) = 0. + P(2) = 0. + P(3) = 0. + ELSE + PP=SQRT((ENERGY-MASS)*(ENERGY+MASS)) + SINTH=SQRT((1.-COSTH)*(1.+COSTH)) + P(3) = PP*COSTH + IF (PHI.EQ.0.) THEN + P(1) = PP*SINTH + P(2) = 0. + ELSE + P(1) = PP*SINTH*COS(PHI) + P(2) = PP*SINTH*SIN(PHI) + ENDIF + ENDIF + RETURN + END +C +C +C +C Subroutine returns the desired fermion or +C anti-fermion anti-spinor. ie., +C + SUBROUTINE OXXXXX(P,FMASS,NHEL,NSF,FO) +C +C P IN: FOUR VECTOR MOMENTUM +C FMASS IN: FERMION MASS +C NHEL IN: ANTI-SPINOR HELICITY, -1 OR 1 +C NSF IN: -1=ANTIFERMION, 1=FERMION +C FO OUT: FERMION WAVEFUNCTION +C +C declare input/output variables +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + COMPLEX*16 FO(6) + INTEGER*4 NHEL, NSF + REAL*8 P(0:3), FMASS +C +C declare local variables +C + REAL*8 RXZERO, RXONE, RXTWO + PARAMETER( RXZERO=0.0D0, RXONE=1.0D0, RXTWO=2.0D0 ) + REAL*8 PLAT, PABS, OMEGAP, OMEGAM, RS2PA, SPAZ + COMPLEX*16 CXZERO + LOGICAL FIRST + SAVE CXZERO,FIRST + DATA FIRST/.TRUE./ +C +C Fix compilation with g77 + IF(FIRST) THEN + FIRST=.FALSE. + CXZERO=DCMPLX( RXZERO, RXZERO ) + ENDIF +C +C define kinematic parameters +C + FO(5) = DCMPLX( P(0), P(3) ) * NSF + FO(6) = DCMPLX( P(1), P(2) ) * NSF + PLAT = SQRT( P(1)**2 + P(2)**2 ) + PABS = SQRT( P(1)**2 + P(2)**2 + P(3)**2 ) + OMEGAP = SQRT( P(0) + PABS ) +C +C do massive fermion case +C + IF ( FMASS .NE. RXZERO ) THEN + OMEGAM = FMASS / OMEGAP + IF ( NSF .EQ. 1 ) THEN + IF ( NHEL .EQ. 1 ) THEN + IF ( P(3) .GE. RXZERO ) THEN + IF ( PLAT .EQ. RXZERO ) THEN + FO(1) = DCMPLX( OMEGAP, RXZERO ) + FO(2) = CXZERO + FO(3) = DCMPLX( OMEGAM, RXZERO ) + FO(4) = CXZERO + ELSE + RS2PA = RXONE / SQRT( RXTWO * PABS ) + SPAZ = SQRT( PABS + P(3) ) + FO(1) = OMEGAP * RS2PA + & * DCMPLX( SPAZ, RXZERO ) + FO(2) = OMEGAP * RS2PA / SPAZ + & * DCMPLX( P(1), -P(2) ) + FO(3) = OMEGAM * RS2PA + & * DCMPLX( SPAZ, RXZERO ) + FO(4) = OMEGAM * RS2PA / SPAZ + & * DCMPLX( P(1), -P(2) ) + END IF + ELSE + IF ( PLAT .EQ. RXZERO ) THEN + FO(1) = CXZERO + FO(2) = DCMPLX( OMEGAP, RXZERO ) + FO(3) = CXZERO + FO(4) = DCMPLX( OMEGAM, RXZERO ) + ELSE + RS2PA = RXONE / SQRT( RXTWO * PABS ) + SPAZ = SQRT( PABS - P(3) ) + FO(1) = OMEGAP * RS2PA / SPAZ + & * DCMPLX( PLAT, RXZERO ) + FO(2) = OMEGAP * RS2PA * SPAZ / PLAT + & * DCMPLX( P(1), -P(2) ) + FO(3) = OMEGAM * RS2PA / SPAZ + & * DCMPLX( PLAT, RXZERO ) + FO(4) = OMEGAM * RS2PA * SPAZ / PLAT + & * DCMPLX( P(1), -P(2) ) + END IF + END IF + ELSE IF ( NHEL .EQ. -1 ) THEN + IF ( P(3) .GE. RXZERO ) THEN + IF ( PLAT .EQ. RXZERO ) THEN + FO(1) = CXZERO + FO(2) = DCMPLX( OMEGAM, RXZERO ) + FO(3) = CXZERO + FO(4) = DCMPLX( OMEGAP, RXZERO ) + ELSE + RS2PA = RXONE / SQRT( RXTWO * PABS ) + SPAZ = SQRT( PABS + P(3) ) + FO(1) = OMEGAM * RS2PA / SPAZ + & * DCMPLX( -P(1), -P(2) ) + FO(2) = OMEGAM * RS2PA + & * DCMPLX( SPAZ, RXZERO ) + FO(3) = OMEGAP * RS2PA / SPAZ + & * DCMPLX( -P(1), -P(2) ) + FO(4) = OMEGAP * RS2PA + & * DCMPLX( SPAZ, RXZERO ) + END IF + ELSE + IF ( PLAT .EQ. RXZERO ) THEN + FO(1) = DCMPLX( -OMEGAM, RXZERO ) + FO(2) = CXZERO + FO(3) = DCMPLX( -OMEGAP, RXZERO ) + FO(4) = CXZERO + ELSE + RS2PA = RXONE / SQRT( RXTWO * PABS ) + SPAZ = SQRT( PABS - P(3) ) + FO(1) = OMEGAM * RS2PA * SPAZ / PLAT + & * DCMPLX( -P(1), -P(2) ) + FO(2) = OMEGAM * RS2PA / SPAZ + & * DCMPLX( PLAT, RXZERO ) + FO(3) = OMEGAP * RS2PA * SPAZ / PLAT + & * DCMPLX( -P(1), -P(2) ) + FO(4) = OMEGAP * RS2PA / SPAZ + & * DCMPLX( PLAT, RXZERO ) + END IF + END IF + ELSE + STOP 'OXXXXX: FERMION HELICITY MUST BE +1,-1' + END IF + ELSE IF ( NSF .EQ. -1 ) THEN + IF ( NHEL .EQ. 1 ) THEN + IF ( P(3) .GE. RXZERO ) THEN + IF ( PLAT .EQ. RXZERO ) THEN + FO(1) = CXZERO + FO(2) = DCMPLX( OMEGAM, RXZERO ) + FO(3) = CXZERO + FO(4) = DCMPLX( -OMEGAP, RXZERO ) + ELSE + RS2PA = RXONE / SQRT( RXTWO * PABS ) + SPAZ = SQRT( PABS + P(3) ) + FO(1) = OMEGAM * RS2PA / SPAZ + & * DCMPLX( -P(1), -P(2) ) + FO(2) = OMEGAM * RS2PA + & * DCMPLX( SPAZ, RXZERO ) + FO(3) = -OMEGAP * RS2PA / SPAZ + & * DCMPLX( -P(1), -P(2) ) + FO(4) = -OMEGAP * RS2PA + & * DCMPLX( SPAZ, RXZERO ) + END IF + ELSE + IF ( PLAT .EQ. RXZERO ) THEN + FO(1) = DCMPLX( -OMEGAM, RXZERO ) + FO(2) = CXZERO + FO(3) = DCMPLX( OMEGAP, RXZERO ) + FO(4) = CXZERO + ELSE + RS2PA = RXONE / SQRT( RXTWO * PABS ) + SPAZ = SQRT( PABS - P(3) ) + FO(1) = OMEGAM * RS2PA * SPAZ / PLAT + & * DCMPLX( -P(1), -P(2) ) + FO(2) = OMEGAM * RS2PA / SPAZ + & * DCMPLX( PLAT, RXZERO ) + FO(3) = -OMEGAP * RS2PA * SPAZ / PLAT + & * DCMPLX( -P(1), -P(2) ) + FO(4) = -OMEGAP * RS2PA / SPAZ + & * DCMPLX( PLAT, RXZERO ) + END IF + END IF + ELSE IF ( NHEL .EQ. -1 ) THEN + IF ( P(3) .GE. RXZERO ) THEN + IF ( PLAT .EQ. RXZERO ) THEN + FO(1) = DCMPLX( -OMEGAP, RXZERO ) + FO(2) = CXZERO + FO(3) = DCMPLX( OMEGAM, RXZERO ) + FO(4) = CXZERO + ELSE + RS2PA = RXONE / SQRT( RXTWO * PABS ) + SPAZ = SQRT( PABS + P(3) ) + FO(1) = -OMEGAP * RS2PA + & * DCMPLX( SPAZ, RXZERO ) + FO(2) = -OMEGAP * RS2PA / SPAZ + & * DCMPLX( P(1), -P(2) ) + FO(3) = OMEGAM * RS2PA + & * DCMPLX( SPAZ, RXZERO ) + FO(4) = OMEGAM * RS2PA / SPAZ + & * DCMPLX( P(1), -P(2) ) + END IF + ELSE + IF ( PLAT .EQ. RXZERO ) THEN + FO(1) = CXZERO + FO(2) = DCMPLX( -OMEGAP, RXZERO ) + FO(3) = CXZERO + FO(4) = DCMPLX( OMEGAM, RXZERO ) + ELSE + RS2PA = RXONE / SQRT( RXTWO * PABS ) + SPAZ = SQRT( PABS - P(3) ) + FO(1) = -OMEGAP * RS2PA / SPAZ + & * DCMPLX( PLAT, RXZERO ) + FO(2) = -OMEGAP * RS2PA * SPAZ / PLAT + & * DCMPLX( P(1), -P(2) ) + FO(3) = OMEGAM * RS2PA / SPAZ + & * DCMPLX( PLAT, RXZERO ) + FO(4) = OMEGAM * RS2PA * SPAZ / PLAT + & * DCMPLX( P(1), -P(2) ) + END IF + END IF + ELSE + STOP 'OXXXXX: FERMION HELICITY MUST BE +1,-1' + END IF + ELSE + STOP 'OXXXXX: FERMION TYPE MUST BE +1,-1' + END IF +C +C do massless case +C + ELSE + IF ( NSF .EQ. 1 ) THEN + IF ( NHEL .EQ. 1 ) THEN + IF ( P(3) .GE. RXZERO ) THEN + IF ( PLAT .EQ. RXZERO ) THEN + FO(1) = DCMPLX( OMEGAP, RXZERO ) + FO(2) = CXZERO + FO(3) = CXZERO + FO(4) = CXZERO + ELSE + SPAZ = SQRT( PABS + P(3) ) + FO(1) = DCMPLX( SPAZ, RXZERO ) + FO(2) = RXONE / SPAZ + & * DCMPLX( P(1), -P(2) ) + FO(3) = CXZERO + FO(4) = CXZERO + END IF + ELSE + IF ( PLAT .EQ. RXZERO ) THEN + FO(1) = CXZERO + FO(2) = DCMPLX( OMEGAP, RXZERO ) + FO(3) = CXZERO + FO(4) = CXZERO + ELSE + SPAZ = SQRT( PABS - P(3) ) + FO(1) = RXONE / SPAZ + & * DCMPLX( PLAT, RXZERO ) + FO(2) = SPAZ / PLAT + & * DCMPLX( P(1), -P(2) ) + FO(3) = CXZERO + FO(4) = CXZERO + END IF + END IF + ELSE IF ( NHEL .EQ. -1 ) THEN + IF ( P(3) .GE. RXZERO ) THEN + IF ( PLAT .EQ. RXZERO ) THEN + FO(1) = CXZERO + FO(2) = CXZERO + FO(3) = CXZERO + FO(4) = DCMPLX( OMEGAP, RXZERO ) + ELSE + SPAZ = SQRT( PABS + P(3) ) + FO(1) = CXZERO + FO(2) = CXZERO + FO(3) = RXONE / SPAZ + & * DCMPLX( -P(1), -P(2) ) + FO(4) = DCMPLX( SPAZ, RXZERO ) + END IF + ELSE + IF ( PLAT .EQ. RXZERO ) THEN + FO(1) = CXZERO + FO(2) = CXZERO + FO(3) = DCMPLX( -OMEGAP, RXZERO ) + FO(4) = CXZERO + ELSE + SPAZ = SQRT( PABS - P(3) ) + FO(1) = CXZERO + FO(2) = CXZERO + FO(3) = SPAZ / PLAT + & * DCMPLX( -P(1), -P(2) ) + FO(4) = RXONE / SPAZ + & * DCMPLX( PLAT, RXZERO ) + END IF + END IF + ELSE + STOP 'OXXXXX: FERMION HELICITY MUST BE +1,-1' + END IF + ELSE IF ( NSF .EQ. -1 ) THEN + IF ( NHEL .EQ. 1 ) THEN + IF ( P(3) .GE. RXZERO ) THEN + IF ( PLAT .EQ. RXZERO ) THEN + FO(1) = CXZERO + FO(2) = CXZERO + FO(3) = CXZERO + FO(4) = DCMPLX( -OMEGAP, RXZERO ) + ELSE + SPAZ = SQRT( PABS + P(3) ) + FO(1) = CXZERO + FO(2) = CXZERO + FO(3) = -RXONE / SPAZ + & * DCMPLX( -P(1), -P(2) ) + FO(4) = DCMPLX( -SPAZ, RXZERO ) + END IF + ELSE + IF ( PLAT .EQ. RXZERO ) THEN + FO(1) = CXZERO + FO(2) = CXZERO + FO(3) = DCMPLX( OMEGAP, RXZERO ) + FO(4) = CXZERO + ELSE + SPAZ = SQRT( PABS - P(3) ) + FO(1) = CXZERO + FO(2) = CXZERO + FO(3) = -SPAZ / PLAT + & * DCMPLX( -P(1), -P(2) ) + FO(4) = -RXONE / SPAZ + & * DCMPLX( PLAT, RXZERO ) + END IF + END IF + ELSE IF ( NHEL .EQ. -1 ) THEN + IF ( P(3) .GE. RXZERO ) THEN + IF ( PLAT .EQ. RXZERO ) THEN + FO(1) = DCMPLX( -OMEGAP, RXZERO ) + FO(2) = CXZERO + FO(3) = CXZERO + FO(4) = CXZERO + ELSE + SPAZ = SQRT( PABS + P(3) ) + FO(1) = DCMPLX( -SPAZ, RXZERO ) + FO(2) = -RXONE / SPAZ + & * DCMPLX( P(1), -P(2) ) + FO(3) = CXZERO + FO(4) = CXZERO + END IF + ELSE + IF ( PLAT .EQ. RXZERO ) THEN + FO(1) = CXZERO + FO(2) = DCMPLX( -OMEGAP, RXZERO ) + FO(3) = CXZERO + FO(4) = CXZERO + ELSE + SPAZ = SQRT( PABS - P(3) ) + FO(1) = -RXONE / SPAZ + & * DCMPLX( PLAT, RXZERO ) + FO(2) = -SPAZ / PLAT + & * DCMPLX( P(1), -P(2) ) + FO(3) = CXZERO + FO(4) = CXZERO + END IF + END IF + ELSE + STOP 'OXXXXX: FERMION HELICITY MUST BE +1,-1' + END IF + ELSE + STOP 'OXXXXX: FERMION TYPE MUST BE +1,-1' + END IF + END IF +C +C done +C + RETURN + END +C +C ---------------------------------------------------------------------- +C + SUBROUTINE ROTXXX(P,Q , PROT) +C +C this subroutine performs the spacial rotation of a four-momentum. +C the momentum p is assumed to be given in the frame where the spacial +C component of q points the positive z-axis. prot is the momentum p +C rotated to the frame where q is given. +C +C input: +C real p(0:3) : four-momentum p in q(1)=q(2)=0 frame +C real q(0:3) : four-momentum q in the rotated frame +C +C output: +C real prot(0:3) : four-momentum p in the rotated frame +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + REAL*8 P(0:3),Q(0:3),PROT(0:3),QT2,QT,PSGN,QQ,P1 +C + REAL*8 RXZERO, RXONE + PARAMETER( RXZERO=0.0D0, RXONE=1.0D0 ) +C + PROT(0) = P(0) +C + QT2=Q(1)**2+Q(2)**2 +C + IF ( QT2 .EQ. RXZERO ) THEN + IF ( Q(3) .EQ. RXZERO ) THEN + PROT(1) = P(1) + PROT(2) = P(2) + PROT(3) = P(3) + ELSE + PSGN=DSIGN(RXONE,Q(3)) + PROT(1) = P(1)*PSGN + PROT(2) = P(2)*PSGN + PROT(3) = P(3)*PSGN + ENDIF + ELSE + QQ=SQRT(QT2+Q(3)**2) + QT=SQRT(QT2) + P1=P(1) + PROT(1) = Q(1)*Q(3)/QQ/QT*P1 -Q(2)/QT*P(2) +Q(1)/QQ*P(3) + PROT(2) = Q(2)*Q(3)/QQ/QT*P1 +Q(1)/QT*P(2) +Q(2)/QQ*P(3) + PROT(3) = -QT/QQ*P1 +Q(3)/QQ*P(3) + ENDIF +C + RETURN + END +C ====================================================================== +C + SUBROUTINE SSSSXX(S1,S2,S3,S4,G , VERTEX) +C +C This subroutine computes an amplitude of the four-scalar coupling. +C +C INPUT: +C complex S1(3) : first scalar S1 +C complex S2(3) : second scalar S2 +C complex S3(3) : third scalar S3 +C complex S4(3) : fourth scalar S4 +C real G : coupling constant GHHHH +C +C OUTPUT: +C complex VERTEX : amplitude Gamma(S1,S2,S3,S4) +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + COMPLEX*16 S1(3),S2(3),S3(3),S4(3),VERTEX + REAL*8 G +C + VERTEX = G*S1(1)*S2(1)*S3(1)*S4(1) +C + RETURN + END +C +C ====================================================================== +C + SUBROUTINE SSSXXX(S1,S2,S3,G , VERTEX) +C +C This subroutine computes an amplitude of the three-scalar coupling. +C +C INPUT: +C complex S1(3) : first scalar S1 +C complex S2(3) : second scalar S2 +C complex S3(3) : third scalar S3 +C real G : coupling constant GHHH +C +C OUTPUT: +C complex VERTEX : amplitude Gamma(S1,S2,S3) +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + COMPLEX*16 S1(3),S2(3),S3(3),VERTEX + REAL*8 G +C + VERTEX = G*S1(1)*S2(1)*S3(1) +C + RETURN + END +C +C +C ---------------------------------------------------------------------- +C + SUBROUTINE SXXXXX(P,NSS , SC) +C +C This subroutine computes a complex SCALAR wavefunction. +C +C INPUT: +C real P(0:3) : four-momentum of scalar boson +C integer NSS = -1 or 1 : +1 for final, -1 for initial +C +C OUTPUT: +C complex SC(3) : scalar wavefunction S +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + COMPLEX*16 SC(3) + REAL*8 P(0:3) + INTEGER NSS +C + SC(1) = DCMPLX( 1.0 ) + SC(2) = DCMPLX(P(0),P(3))*NSS + SC(3) = DCMPLX(P(1),P(2))*NSS +C + RETURN + END +C +C ====================================================================== +C + SUBROUTINE VSSXXX(VC,S1,S2,G , VERTEX) +C +C this subroutine computes an amplitude from the vector-scalar-scalar +C coupling. the coupling is absent in the minimal sm in unitary gauge. +C +C complex vc(6) : input vector v +C complex s1(3) : first scalar s1 +C complex s2(3) : second scalar s2 +C complex g : coupling constant (s1 charge) +C +C examples of the coupling constant g for susy particles are as follows: +C ----------------------------------------------------------- +C | s1 | (q,i3) of s1 || v=a | v=z | v=w | +C ----------------------------------------------------------- +C | nu~_l | ( 0 , +1/2) || --- | gzn(1) | gwf(1) | +C | e~_l | ( -1 , -1/2) || gal(1) | gzl(1) | gwf(1) | +C | u~_l | (+2/3 , +1/2) || gau(1) | gzu(1) | gwf(1) | +C | d~_l | (-1/3 , -1/2) || gad(1) | gzd(1) | gwf(1) | +C ----------------------------------------------------------- +C | e~_r-bar | ( +1 , 0 ) || -gal(2) | -gzl(2) | -gwf(2) | +C | u~_r-bar | (-2/3 , 0 ) || -gau(2) | -gzu(2) | -gwf(2) | +C | d~_r-bar | (+1/3 , 0 ) || -gad(2) | -gzd(2) | -gwf(2) | +C ----------------------------------------------------------- +C where the s1 charge is defined by the flowing-out quantum number. +C +C output: +C complex vertex : amplitude gamma(v,s1,s2) +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + COMPLEX*16 VC(6),S1(3),S2(3),VERTEX,G + REAL*8 P(0:3) +C + P(0)=DBLE( S1(2)-S2(2)) + P(1)=DBLE( S1(3)-S2(3)) + P(2)=DIMAG(S1(3)-S2(3)) + P(3)=DIMAG(S1(2)-S2(2)) +C + VERTEX = G*S1(1)*S2(1) + & *(VC(1)*P(0)-VC(2)*P(1)-VC(3)*P(2)-VC(4)*P(3)) +C + RETURN + END +C + SUBROUTINE VVSSXX(V1,V2,S1,S2,G , VERTEX) +C +C This subroutine computes an amplitude of the vector-vector-scalar- +C scalar coupling. +C +C INPUT: +C complex V1(6) : first vector V1 +C complex V2(6) : second vector V2 +C complex S1(3) : first scalar S1 +C complex S2(3) : second scalar S2 +C real G : coupling constant GVVHH +C +C OUTPUT: +C complex VERTEX : amplitude Gamma(V1,V2,S1,S2) +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + COMPLEX*16 V1(6),V2(6),S1(3),S2(3),VERTEX + REAL*8 G +C + VERTEX = G*S1(1)*S2(1) + & *(V1(1)*V2(1)-V1(2)*V2(2)-V1(3)*V2(3)-V1(4)*V2(4)) +C + RETURN + END +C +C +C ====================================================================== +C + SUBROUTINE VVSXXX(V1,V2,SC,G , VERTEX) +C +C this subroutine computes an amplitude of the vector-vector-scalar +C coupling. +C +C input: +C complex v1(6) : first vector v1 +C complex v2(6) : second vector v2 +C complex sc(3) : input scalar s +C real g : coupling constant gvvh +C +C output: +C complex vertex : amplitude gamma(v1,v2,s) +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + COMPLEX*16 V1(6),V2(6),SC(3),VERTEX + REAL*8 G +C + VERTEX = G*SC(1)*(V1(1)*V2(1)-V1(2)*V2(2)-V1(3)*V2(3)-V1(4)*V2(4)) +C + RETURN + END +C +C ====================================================================== +C + SUBROUTINE VVVXXX(WM,WP,W3,G , VERTEX) +C +C this subroutine computes an amplitude of the three-point coupling of +C the gauge bosons. +C +C input: +C complex wm(6) : vector flow-out w- +C complex wp(6) : vector flow-out w+ +C complex w3(6) : vector j3 or a or z +C real g : coupling constant gw or gwwa or gwwz +C +C output: +C complex vertex : amplitude gamma(wm,wp,w3) +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + COMPLEX*16 WM(6),WP(6),W3(6),VERTEX, + & XV1,XV2,XV3,V12,V23,V31,P12,P13,P21,P23,P31,P32 + REAL*8 PWM(0:3),PWP(0:3),PW3(0:3),G +C + REAL*8 RXZERO, RTENTH + PARAMETER( RXZERO=0.0D0, RTENTH=0.1D0 ) +C + PWM(0)=DBLE( WM(5)) + PWM(1)=DBLE( WM(6)) + PWM(2)=DIMAG(WM(6)) + PWM(3)=DIMAG(WM(5)) + PWP(0)=DBLE( WP(5)) + PWP(1)=DBLE( WP(6)) + PWP(2)=DIMAG(WP(6)) + PWP(3)=DIMAG(WP(5)) + PW3(0)=DBLE( W3(5)) + PW3(1)=DBLE( W3(6)) + PW3(2)=DIMAG(W3(6)) + PW3(3)=DIMAG(W3(5)) +C + V12=WM(1)*WP(1)-WM(2)*WP(2)-WM(3)*WP(3)-WM(4)*WP(4) + V23=WP(1)*W3(1)-WP(2)*W3(2)-WP(3)*W3(3)-WP(4)*W3(4) + V31=W3(1)*WM(1)-W3(2)*WM(2)-W3(3)*WM(3)-W3(4)*WM(4) + XV1=RXZERO + XV2=RXZERO + XV3=RXZERO + IF ( ABS(WM(1)) .NE. RXZERO ) THEN + IF (ABS(WM(1)).GE.MAX(ABS(WM(2)),ABS(WM(3)),ABS(WM(4))) + $ *RTENTH) + & XV1=PWM(0)/WM(1) + ENDIF + IF ( ABS(WP(1)) .NE. RXZERO) THEN + IF (ABS(WP(1)).GE.MAX(ABS(WP(2)),ABS(WP(3)),ABS(WP(4))) + $ *RTENTH) + & XV2=PWP(0)/WP(1) + ENDIF + IF ( ABS(W3(1)) .NE. RXZERO) THEN + IF ( ABS(W3(1)).GE.MAX(ABS(W3(2)),ABS(W3(3)),ABS(W3(4))) + $ *RTENTH) + & XV3=PW3(0)/W3(1) + ENDIF + P12= (PWM(0)-XV1*WM(1))*WP(1)-(PWM(1)-XV1*WM(2))*WP(2) + & -(PWM(2)-XV1*WM(3))*WP(3)-(PWM(3)-XV1*WM(4))*WP(4) + P13= (PWM(0)-XV1*WM(1))*W3(1)-(PWM(1)-XV1*WM(2))*W3(2) + & -(PWM(2)-XV1*WM(3))*W3(3)-(PWM(3)-XV1*WM(4))*W3(4) + P21= (PWP(0)-XV2*WP(1))*WM(1)-(PWP(1)-XV2*WP(2))*WM(2) + & -(PWP(2)-XV2*WP(3))*WM(3)-(PWP(3)-XV2*WP(4))*WM(4) + P23= (PWP(0)-XV2*WP(1))*W3(1)-(PWP(1)-XV2*WP(2))*W3(2) + & -(PWP(2)-XV2*WP(3))*W3(3)-(PWP(3)-XV2*WP(4))*W3(4) + P31= (PW3(0)-XV3*W3(1))*WM(1)-(PW3(1)-XV3*W3(2))*WM(2) + & -(PW3(2)-XV3*W3(3))*WM(3)-(PW3(3)-XV3*W3(4))*WM(4) + P32= (PW3(0)-XV3*W3(1))*WP(1)-(PW3(1)-XV3*W3(2))*WP(2) + & -(PW3(2)-XV3*W3(3))*WP(3)-(PW3(3)-XV3*W3(4))*WP(4) +C + VERTEX = -(V12*(P13-P23)+V23*(P21-P31)+V31*(P32-P12))*G +C + RETURN + END +C +C +C Subroutine returns the value of evaluated +C helicity basis boson polarisation wavefunction. +C Replaces the HELAS routine VXXXXX +C +C Adam Duff, 1992 September 3 +C +C + SUBROUTINE VXXXXX(P,VMASS,NHEL,NSV,VC) +C +C P IN: BOSON FOUR MOMENTUM +C VMASS IN: BOSON MASS +C NHEL IN: BOSON HELICITY +C NSV IN: INCOMING (-1) OR OUTGOING (+1) +C VC OUT: BOSON WAVEFUNCTION +C +C declare input/output variables +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + COMPLEX*16 VC(6) + INTEGER*4 NHEL, NSV + REAL*8 P(0:3), VMASS +C +C declare local variables +C + REAL*8 RXZERO, RXONE, RXTWO + PARAMETER( RXZERO=0.0D0, RXONE=1.0D0, RXTWO=2.0D0 ) + REAL*8 PLAT, PABS, RS2, RPLAT, RPABS, RDEN + COMPLEX*16 CXZERO + LOGICAL FIRST + SAVE CXZERO,FIRST + DATA FIRST/.TRUE./ +C +C Fix compilation with g77 + IF(FIRST) THEN + FIRST=.FALSE. + CXZERO=DCMPLX( RXZERO, RXZERO ) + ENDIF +C +C define internal/external momenta +C + IF ( NSV**2 .NE. 1 ) THEN + STOP 'VXXXXX: NSV IS NOT ONE OF -1, +1' + END IF +C + RS2 = SQRT( RXONE / RXTWO ) + VC(5) = DCMPLX( P(0), P(3) ) * NSV + VC(6) = DCMPLX( P(1), P(2) ) * NSV + PLAT = SQRT( P(1)**2 + P(2)**2 ) + PABS = SQRT( P(1)**2 + P(2)**2 + P(3)**2 ) +C +C calculate polarisation four vectors +C + IF ( NHEL**2 .EQ. 1 ) THEN + IF ( (PABS .EQ. RXZERO) .OR. (PLAT .EQ. RXZERO) ) THEN + VC(1) = CXZERO + VC(2) = DCMPLX( -NHEL * RS2 * DSIGN( RXONE, P(3) ), RXZERO ) + VC(3) = DCMPLX( RXZERO, NSV * RS2 ) + VC(4) = CXZERO + ELSE + RPLAT = RXONE / PLAT + RPABS = RXONE / PABS + VC(1) = CXZERO + VC(2) = DCMPLX( -NHEL * RS2 * RPABS * RPLAT * P(1) * P(3), + & -NSV * RS2 * RPLAT * P(2) ) + VC(3) = DCMPLX( -NHEL * RS2 * RPABS * RPLAT * P(2) * P(3), + & NSV * RS2 * RPLAT * P(1) ) + VC(4) = DCMPLX( NHEL * RS2 * RPABS * PLAT, + & RXZERO ) + END IF + ELSE IF ( NHEL .EQ. 0 ) THEN + IF ( VMASS .GT. RXZERO ) THEN + IF ( PABS .EQ. RXZERO ) THEN + VC(1) = CXZERO + VC(2) = CXZERO + VC(3) = CXZERO + VC(4) = DCMPLX( RXONE, RXZERO ) + ELSE + RDEN = P(0) / ( VMASS * PABS ) + VC(1) = DCMPLX( PABS / VMASS, RXZERO ) + VC(2) = DCMPLX( RDEN * P(1), RXZERO ) + VC(3) = DCMPLX( RDEN * P(2), RXZERO ) + VC(4) = DCMPLX( RDEN * P(3), RXZERO ) + END IF + ELSE + STOP 'VXXXXX: NHEL = 0 IS ONLY FOR MASSIVE BOSONS' + END IF + ELSE IF ( NHEL .EQ. 4 ) THEN + IF ( VMASS .GT. RXZERO ) THEN + RDEN = RXONE / VMASS + VC(1) = DCMPLX( RDEN * P(0), RXZERO ) + VC(2) = DCMPLX( RDEN * P(1), RXZERO ) + VC(3) = DCMPLX( RDEN * P(2), RXZERO ) + VC(4) = DCMPLX( RDEN * P(3), RXZERO ) + ELSEIF (VMASS .EQ. RXZERO) THEN + RDEN = RXONE / P(0) + VC(1) = DCMPLX( RDEN * P(0), RXZERO ) + VC(2) = DCMPLX( RDEN * P(1), RXZERO ) + VC(3) = DCMPLX( RDEN * P(2), RXZERO ) + VC(4) = DCMPLX( RDEN * P(3), RXZERO ) + ELSE + STOP 'VXXXXX: NHEL = 4 IS ONLY FOR M>=0' + END IF + ELSE + STOP 'VXXXXX: NHEL IS NOT ONE OF -1, 0, 1 OR 4' + END IF +C +C done +C + RETURN + END +C +C ---------------------------------------------------------------------- +C + SUBROUTINE W3W3XX(WM,W31,WP,W32,G31,G32,WMASS,WWIDTH , VERTEX) +C +C this subroutine computes an amplitude of the four-point coupling of +C the w-, w+ and two w3/z/a. the amplitude includes the contributions +C of w exchange diagrams. the internal w propagator is given in unitary +C gauge. if one sets wmass=0.0, then the gggg vertex is given (see sect +C 2.9.1 of the manual). +C +C input: +C complex wm(0:3) : flow-out w- wm +C complex w31(0:3) : first w3/z/a w31 +C complex wp(0:3) : flow-out w+ wp +C complex w32(0:3) : second w3/z/a w32 +C real g31 : coupling of w31 with w-/w+ +C real g32 : coupling of w32 with w-/w+ +C (see the table below) +C real wmass : mass of w +C real wwidth : width of w +C +C the possible sets of the inputs are as follows: +C ------------------------------------------- +C | wm | w31 | wp | w32 | g31 | g32 | +C ------------------------------------------- +C | w- | w3 | w+ | w3 | gw | gw | +C | w- | w3 | w+ | z | gw | gwwz | +C | w- | w3 | w+ | a | gw | gwwa | +C | w- | z | w+ | z | gwwz | gwwz | +C | w- | z | w+ | a | gwwz | gwwa | +C | w- | a | w+ | a | gwwa | gwwa | +C ------------------------------------------- +C where all the bosons are defined by the flowing-out quantum number. +C +C output: +C complex vertex : amplitude gamma(wm,w31,wp,w32) +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + COMPLEX*16 WM(6),W31(6),WP(6),W32(6),VERTEX + COMPLEX*16 DV1(0:3),DV2(0:3),DV3(0:3),DV4(0:3),DVERTX, + & V12,V13,V14,V23,V24,V34 + REAL*8 G31,G32,WMASS,WWIDTH +C + REAL*8 RXZERO, RXONE + PARAMETER( RXZERO=0.0D0, RXONE=1.0D0 ) + + DV1(0)=DCMPLX(WM(1)) + DV1(1)=DCMPLX(WM(2)) + DV1(2)=DCMPLX(WM(3)) + DV1(3)=DCMPLX(WM(4)) + DV2(0)=DCMPLX(W31(1)) + DV2(1)=DCMPLX(W31(2)) + DV2(2)=DCMPLX(W31(3)) + DV2(3)=DCMPLX(W31(4)) + DV3(0)=DCMPLX(WP(1)) + DV3(1)=DCMPLX(WP(2)) + DV3(2)=DCMPLX(WP(3)) + DV3(3)=DCMPLX(WP(4)) + DV4(0)=DCMPLX(W32(1)) + DV4(1)=DCMPLX(W32(2)) + DV4(2)=DCMPLX(W32(3)) + DV4(3)=DCMPLX(W32(4)) +C + IF ( DBLE(WMASS) .NE. RXZERO ) THEN +C dm2inv = r_one / dmw2 +C + V12= DV1(0)*DV2(0)-DV1(1)*DV2(1)-DV1(2)*DV2(2)-DV1(3)*DV2(3) + V13= DV1(0)*DV3(0)-DV1(1)*DV3(1)-DV1(2)*DV3(2)-DV1(3)*DV3(3) + V14= DV1(0)*DV4(0)-DV1(1)*DV4(1)-DV1(2)*DV4(2)-DV1(3)*DV4(3) + V23= DV2(0)*DV3(0)-DV2(1)*DV3(1)-DV2(2)*DV3(2)-DV2(3)*DV3(3) + V24= DV2(0)*DV4(0)-DV2(1)*DV4(1)-DV2(2)*DV4(2)-DV2(3)*DV4(3) + V34= DV3(0)*DV4(0)-DV3(1)*DV4(1)-DV3(2)*DV4(2)-DV3(3)*DV4(3) +C + DVERTX = V12*V34 +V14*V23 -2.D0*V13*V24 +C + VERTEX = DCMPLX( DVERTX ) * (G31*G32) +C + ELSE + V12= DV1(0)*DV2(0)-DV1(1)*DV2(1)-DV1(2)*DV2(2)-DV1(3)*DV2(3) + V13= DV1(0)*DV3(0)-DV1(1)*DV3(1)-DV1(2)*DV3(2)-DV1(3)*DV3(3) + V14= DV1(0)*DV4(0)-DV1(1)*DV4(1)-DV1(2)*DV4(2)-DV1(3)*DV4(3) + V23= DV2(0)*DV3(0)-DV2(1)*DV3(1)-DV2(2)*DV3(2)-DV2(3)*DV3(3) + V24= DV2(0)*DV4(0)-DV2(1)*DV4(1)-DV2(2)*DV4(2)-DV2(3)*DV4(3) + V34= DV3(0)*DV4(0)-DV3(1)*DV4(1)-DV3(2)*DV4(2)-DV3(3)*DV4(3) +C + + DVERTX = V14*V23 -V13*V24 +C + VERTEX = DCMPLX( DVERTX ) * (G31*G32) + END IF +C + RETURN + END +C +C ====================================================================== +C + SUBROUTINE WWWWXX(WM1,WP1,WM2,WP2,GWWA,GWWZ,ZMASS,ZWIDTH , VERTEX) +C +C this subroutine computes an amplitude of the four-point w-/w+ +C coupling, including the contributions of photon and z exchanges. the +C photon propagator is given in feynman gauge and the z propagator is +C given in unitary gauge. +C +C input: +C complex wm1(0:3) : first flow-out w- wm1 +C complex wp1(0:3) : first flow-out w+ wp1 +C complex wm2(0:3) : second flow-out w- wm2 +C complex wp2(0:3) : second flow-out w+ wp2 +C real gwwa : coupling constant of w and a gwwa +C real gwwz : coupling constant of w and z gwwz +C real zmass : mass of z +C real zwidth : width of z +C +C output: +C complex vertex : amplitude gamma(wm1,wp1,wm2,wp2) +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + COMPLEX*16 WM1(6),WP1(6),WM2(6),WP2(6),VERTEX + COMPLEX*16 DV1(0:3),DV2(0:3),DV3(0:3),DV4(0:3), + & J12(0:3),J34(0:3),J14(0:3),J32(0:3),DVERTX, + & SV1,SV2,SV3,SV4,TV1,TV2,TV3,TV4,DZS,DZT, + & V12,V13,V14,V23,V24,V34,JS12,JS34,JS14,JS32,JS,JT + REAL*8 PWM1(0:3),PWP1(0:3),PWM2(0:3),PWP2(0:3), + & GWWA,GWWZ,ZMASS,ZWIDTH + REAL*8 Q(0:3),K(0:3),DP1(0:3),DP2(0:3),DP3(0:3),DP4(0:3), + & DGWWA2,DGWWZ2,DGW2,DMZ,DWIDTH,S,T,DAS,DAT +C + REAL*8 RXZERO, RXONE, RXTWO + PARAMETER( RXZERO=0.0D0, RXONE=1.0D0, RXTWO=2.0D0 ) +C + PWM1(0)=DBLE( WM1(5)) + PWM1(1)=DBLE( WM1(6)) + PWM1(2)=DIMAG(WM1(6)) + PWM1(3)=DIMAG(WM1(5)) + PWP1(0)=DBLE( WP1(5)) + PWP1(1)=DBLE( WP1(6)) + PWP1(2)=DIMAG(WP1(6)) + PWP1(3)=DIMAG(WP1(5)) + PWM2(0)=DBLE( WM2(5)) + PWM2(1)=DBLE( WM2(6)) + PWM2(2)=DIMAG(WM2(6)) + PWM2(3)=DIMAG(WM2(5)) + PWP2(0)=DBLE( WP2(5)) + PWP2(1)=DBLE( WP2(6)) + PWP2(2)=DIMAG(WP2(6)) + PWP2(3)=DIMAG(WP2(5)) +C + DV1(0)=DCMPLX(WM1(1)) + DV1(1)=DCMPLX(WM1(2)) + DV1(2)=DCMPLX(WM1(3)) + DV1(3)=DCMPLX(WM1(4)) + DP1(0)=DBLE(PWM1(0)) + DP1(1)=DBLE(PWM1(1)) + DP1(2)=DBLE(PWM1(2)) + DP1(3)=DBLE(PWM1(3)) + DV2(0)=DCMPLX(WP1(1)) + DV2(1)=DCMPLX(WP1(2)) + DV2(2)=DCMPLX(WP1(3)) + DV2(3)=DCMPLX(WP1(4)) + DP2(0)=DBLE(PWP1(0)) + DP2(1)=DBLE(PWP1(1)) + DP2(2)=DBLE(PWP1(2)) + DP2(3)=DBLE(PWP1(3)) + DV3(0)=DCMPLX(WM2(1)) + DV3(1)=DCMPLX(WM2(2)) + DV3(2)=DCMPLX(WM2(3)) + DV3(3)=DCMPLX(WM2(4)) + DP3(0)=DBLE(PWM2(0)) + DP3(1)=DBLE(PWM2(1)) + DP3(2)=DBLE(PWM2(2)) + DP3(3)=DBLE(PWM2(3)) + DV4(0)=DCMPLX(WP2(1)) + DV4(1)=DCMPLX(WP2(2)) + DV4(2)=DCMPLX(WP2(3)) + DV4(3)=DCMPLX(WP2(4)) + DP4(0)=DBLE(PWP2(0)) + DP4(1)=DBLE(PWP2(1)) + DP4(2)=DBLE(PWP2(2)) + DP4(3)=DBLE(PWP2(3)) + DGWWA2=DBLE(GWWA)**2 + DGWWZ2=DBLE(GWWZ)**2 + DGW2 =DGWWA2+DGWWZ2 + DMZ =DBLE(ZMASS) + DWIDTH=DBLE(ZWIDTH) +C + V12= DV1(0)*DV2(0)-DV1(1)*DV2(1)-DV1(2)*DV2(2)-DV1(3)*DV2(3) + V13= DV1(0)*DV3(0)-DV1(1)*DV3(1)-DV1(2)*DV3(2)-DV1(3)*DV3(3) + V14= DV1(0)*DV4(0)-DV1(1)*DV4(1)-DV1(2)*DV4(2)-DV1(3)*DV4(3) + V23= DV2(0)*DV3(0)-DV2(1)*DV3(1)-DV2(2)*DV3(2)-DV2(3)*DV3(3) + V24= DV2(0)*DV4(0)-DV2(1)*DV4(1)-DV2(2)*DV4(2)-DV2(3)*DV4(3) + V34= DV3(0)*DV4(0)-DV3(1)*DV4(1)-DV3(2)*DV4(2)-DV3(3)*DV4(3) +C + Q(0)=DP1(0)+DP2(0) + Q(1)=DP1(1)+DP2(1) + Q(2)=DP1(2)+DP2(2) + Q(3)=DP1(3)+DP2(3) + K(0)=DP1(0)+DP4(0) + K(1)=DP1(1)+DP4(1) + K(2)=DP1(2)+DP4(2) + K(3)=DP1(3)+DP4(3) +C + S=Q(0)**2-Q(1)**2-Q(2)**2-Q(3)**2 + T=K(0)**2-K(1)**2-K(2)**2-K(3)**2 +C + DAS=-RXONE/S + DAT=-RXONE/T + DZS=-RXONE/DCMPLX( S-DMZ**2 , DMAX1(DSIGN(DMZ*DWIDTH,S),RXZERO) ) + DZT=-RXONE/DCMPLX( T-DMZ**2 , DMAX1(DSIGN(DMZ*DWIDTH,T),RXZERO) ) +C + SV1= (DP2(0)+Q(0))*DV1(0) -(DP2(1)+Q(1))*DV1(1) + & -(DP2(2)+Q(2))*DV1(2) -(DP2(3)+Q(3))*DV1(3) + SV2=-(DP1(0)+Q(0))*DV2(0) +(DP1(1)+Q(1))*DV2(1) + & +(DP1(2)+Q(2))*DV2(2) +(DP1(3)+Q(3))*DV2(3) + SV3= (DP4(0)-Q(0))*DV3(0) -(DP4(1)-Q(1))*DV3(1) + & -(DP4(2)-Q(2))*DV3(2) -(DP4(3)-Q(3))*DV3(3) + SV4=-(DP3(0)-Q(0))*DV4(0) +(DP3(1)-Q(1))*DV4(1) + & +(DP3(2)-Q(2))*DV4(2) +(DP3(3)-Q(3))*DV4(3) +C + TV1= (DP4(0)+K(0))*DV1(0) -(DP4(1)+K(1))*DV1(1) + & -(DP4(2)+K(2))*DV1(2) -(DP4(3)+K(3))*DV1(3) + TV2=-(DP3(0)-K(0))*DV2(0) +(DP3(1)-K(1))*DV2(1) + & +(DP3(2)-K(2))*DV2(2) +(DP3(3)-K(3))*DV2(3) + TV3= (DP2(0)-K(0))*DV3(0) -(DP2(1)-K(1))*DV3(1) + & -(DP2(2)-K(2))*DV3(2) -(DP2(3)-K(3))*DV3(3) + TV4=-(DP1(0)+K(0))*DV4(0) +(DP1(1)+K(1))*DV4(1) + & +(DP1(2)+K(2))*DV4(2) +(DP1(3)+K(3))*DV4(3) +C + J12(0)=(DP1(0)-DP2(0))*V12 +SV1*DV2(0) +SV2*DV1(0) + J12(1)=(DP1(1)-DP2(1))*V12 +SV1*DV2(1) +SV2*DV1(1) + J12(2)=(DP1(2)-DP2(2))*V12 +SV1*DV2(2) +SV2*DV1(2) + J12(3)=(DP1(3)-DP2(3))*V12 +SV1*DV2(3) +SV2*DV1(3) + J34(0)=(DP3(0)-DP4(0))*V34 +SV3*DV4(0) +SV4*DV3(0) + J34(1)=(DP3(1)-DP4(1))*V34 +SV3*DV4(1) +SV4*DV3(1) + J34(2)=(DP3(2)-DP4(2))*V34 +SV3*DV4(2) +SV4*DV3(2) + J34(3)=(DP3(3)-DP4(3))*V34 +SV3*DV4(3) +SV4*DV3(3) +C + J14(0)=(DP1(0)-DP4(0))*V14 +TV1*DV4(0) +TV4*DV1(0) + J14(1)=(DP1(1)-DP4(1))*V14 +TV1*DV4(1) +TV4*DV1(1) + J14(2)=(DP1(2)-DP4(2))*V14 +TV1*DV4(2) +TV4*DV1(2) + J14(3)=(DP1(3)-DP4(3))*V14 +TV1*DV4(3) +TV4*DV1(3) + J32(0)=(DP3(0)-DP2(0))*V23 +TV3*DV2(0) +TV2*DV3(0) + J32(1)=(DP3(1)-DP2(1))*V23 +TV3*DV2(1) +TV2*DV3(1) + J32(2)=(DP3(2)-DP2(2))*V23 +TV3*DV2(2) +TV2*DV3(2) + J32(3)=(DP3(3)-DP2(3))*V23 +TV3*DV2(3) +TV2*DV3(3) +C + JS12=Q(0)*J12(0)-Q(1)*J12(1)-Q(2)*J12(2)-Q(3)*J12(3) + JS34=Q(0)*J34(0)-Q(1)*J34(1)-Q(2)*J34(2)-Q(3)*J34(3) + JS14=K(0)*J14(0)-K(1)*J14(1)-K(2)*J14(2)-K(3)*J14(3) + JS32=K(0)*J32(0)-K(1)*J32(1)-K(2)*J32(2)-K(3)*J32(3) +C + JS=J12(0)*J34(0)-J12(1)*J34(1)-J12(2)*J34(2)-J12(3)*J34(3) + JT=J14(0)*J32(0)-J14(1)*J32(1)-J14(2)*J32(2)-J14(3)*J32(3) +C + DVERTX = (V12*V34 +V14*V23 -RXTWO*V13*V24)*DGW2 + +C & +(dzs*dgwwz2+das*dgwwa2)*js -dzs*dgwwz2*js12*js34/dmz**2 +C & +(dzt*dgwwz2+dat*dgwwa2)*jt -dzt*dgwwz2*js14*js32/dmz**2 +C + VERTEX = -DCMPLX( DVERTX ) +C + RETURN + END diff --git a/ISAJET/code/dincgm.F b/ISAJET/code/dincgm.F new file mode 100644 index 00000000000..c624c0a0ae2 --- /dev/null +++ b/ISAJET/code/dincgm.F @@ -0,0 +1,31 @@ +#include "isajet/pilot.h" + DOUBLE PRECISION FUNCTION DINCGM(A,X,EPS) +C*********************************************************************** +C* Series expansion of incomplete gamma function, from Abramowitz and * +C* Stegun. A and X are the two arguments, while EPS is the relative * +C* precision. More accurately, if X > 0, EPS is the ratio of the last * +C* term in the series and the sum; note that for X > 0, the series is * +C* alternating. For X < 0, this ratio is required to be < EPS/100. * +C*********************************************************************** + + DOUBLE PRECISION A,X,EPS,SUM,TERM,XN +C IF(DABS(A).LT.1.D-10) THEN +C WRITE(*,*) ' Function diverges for A = 0!' +C DINCGM = 1.D50 +C RETURN +C ENDIF + SUM = 1.D0/A + TERM = 1.D0 !Term for n = 0 + H = 1.D0 + XN = 1.D0 + + 1 H = -H*X/XN + TERM = H/(A+XN) + XN = XN+1.D0 + SUM = SUM+TERM + IF((DABS(TERM/SUM).GT.EPS.AND.X.GE.0.D0).OR. + & (DABS(TERM/SUM).GT.1.D-2*EPS.AND.X.LE.0.D0)) GOTO 1 + + DINCGM = SUM*(X**A) + RETURN + END diff --git a/ISAJET/code/domssm.F b/ISAJET/code/domssm.F new file mode 100644 index 00000000000..ea3da40d558 --- /dev/null +++ b/ISAJET/code/domssm.F @@ -0,0 +1,296 @@ +#include "isajet/pilot.h" + SUBROUTINE DOMSSM +C----------------------------------------------------------------------- +C Initialize MSSM masses and decay modes from ISASUSY. +C Check for validity with ISAJET masses. +C Decay modes are transfered to /DKYTAB/ by /SETDKY/. +C +C F.E. Paige, November, 1992 +C +C Ver. 7.01: Add test so that AMASS is not called if ID = 0 +C Ver. 7.07: Add checking for LEP bounds. +C Ver. 7.10: Add SUGRA interface +C Ver. 7.32: Extend to large tanb solution +C Ver. 7.33: Add gauge-mediated SUSY model +C Ver. 7.38: NOGRAV turns off gravitino and weaker decays +C +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +C ISAJET common blocks +#include "isajet/itapes.inc" +#include "isajet/qlmass.inc" +#include "isajet/xmssm.inc" +#include "isajet/nodcay.inc" +C ISASUSY common blocks +#include "isajet/sslun.inc" +#include "isajet/ssmode.inc" +#include "isajet/sspar.inc" +#include "isajet/sstype.inc" +#include "isajet/sugmg.inc" +#include "isajet/sugpas.inc" +#include "isajet/sugxin.inc" +C + INTEGER NOUT + PARAMETER (NOUT=33) + INTEGER IDOUT(NOUT) + REAL AMASS,AMPL + REAL AMI,SUMGAM,SUMMJ,WIDMX + INTEGER I,J,K,IFL1,IFL2,IFL3,JSPIN,INDEX,IALLOW,IITEST +C + DATA IDOUT/ + $IDTP,ISGL,ISUPL,ISDNL,ISSTL,ISCHL,ISBT1,ISTP1,ISUPR,ISDNR, + $ISSTR,ISCHR,ISBT2,ISTP2,ISEL,ISMUL,ISTAU1,ISNEL,ISNML,ISNTL, + $ISER,ISMUR,ISTAU2,ISZ1,ISZ2,ISZ3,ISZ4,ISW1,ISW2, + $ISHL,ISHH,ISHA,ISHC/ + DATA AMPL/2.4E18/,IAL3UN/0/ +C +C Generate masses and decays +C +C FIRST SET HIGH SCALE FOR SUSY BCs; default is M_GUT + XSUGIN(7)=XSBCS + IF (XMGVTO.LT.1.E19) AMGVSS=XMGVTO + IF(.NOT.GOMSSM) RETURN + LOUT=ITLIS + IF (AL3UNI) IAL3UN=1 + IF(GOSUG) THEN +C SUGRA input +C First solve renormalization group equations + IF (XMAJNR.LT.1.E19) THEN + XNRIN(1)=XMN3NR + XNRIN(2)=XMAJNR + XNRIN(3)=XANSS + XNRIN(4)=XNRSS + ELSE + XNRIN(2)=1.E20 + END IF + IF (GOAMSB) THEN + XA0SU=0. + CALL SUGRA(XM0SU,XMHSU,XA0SU,XTGBSU,XSMUSU,AMASS(6),7) + ELSE + CALL SUGRA(XM0SU,XMHSU,XA0SU,XTGBSU,XSMUSU,AMASS(6),1) + END IF + IF (NOGOOD.EQ.1) THEN + WRITE(LOUT,*) 'SUGRA BAD POINT: TACHYONIC PARTICLES!' + ELSE IF (NOGOOD.EQ.2) THEN + WRITE(LOUT,*) 'SUGRA BAD POINT: NO EW SYMMETRY BREAKING!' + ELSE IF (NOGOOD.EQ.3) THEN + WRITE(LOUT,*) 'SUGRA BAD POINT: M(H_P)^2<0!' + ELSE IF (NOGOOD.EQ.4) THEN + WRITE(LOUT,*) 'SUGRA BAD POINT: YUKAWA>10!' + ELSE IF (NOGOOD.EQ.5) THEN + WRITE(LOUT,*) 'SUGRA BAD POINT: Z1SS NOT LSP!' + ELSE IF (NOGOOD.EQ.7) THEN + WRITE(LOUT,*) 'SUGRA BAD POINT: XT EWSB IS BAD!' + ELSE IF (NOGOOD.EQ.8) THEN + WRITE(LOUT,*) 'SUGRA BAD POINT: MHL^2<0!' + END IF + IF(NOGOOD.NE.0) STOP99 + IF(ITACHY.NE.0) THEN + WRITE(LOUT,*) 'WARNING: TACHYONIC SLEPTONS AT GUT SCALE' + WRITE(LOUT,*) ' POINT MAY BE INVALID' + ENDIF +C Then calculate masses and decays + CALL SSMSSM(XISAIN(1),XISAIN(2),XISAIN(3), + $ XISAIN(4),XISAIN(5),XISAIN(6),XISAIN(7),XISAIN(8),XISAIN(9), + $ XISAIN(10),XISAIN(11),XISAIN(12),XISAIN(13),XISAIN(14), + $ XISAIN(15),XISAIN(16),XISAIN(17),XISAIN(18),XISAIN(19), + $ XISAIN(20),XISAIN(21),XISAIN(22),XISAIN(23),XISAIN(24), + $ AMASS(6),IALLOW,1) + ELSE IF(GOGMSB) THEN +C GMSB input + XGMIN(8)=XRSLGM + XGMIN(9)=XDHDGM + XGMIN(10)=XDHUGM + XGMIN(11)=XDYGM + XGMIN(12)=XN51GM + XGMIN(13)=XN52GM + XGMIN(14)=XN53GM +C First solve renormalization group equations + CALL SUGRA(XLAMGM,XMESGM,XN5GM,XTGBSU,XSMUSU,AMASS(6),2) + IF (NOGOOD.EQ.1) THEN + WRITE(LOUT,*) 'GMSB BAD POINT: TACHYONIC PARTICLES!' + ELSE IF (NOGOOD.EQ.2) THEN + WRITE(LOUT,*) 'GMSB BAD POINT: NO EW SYMMETRY BREAKING!' + ELSE IF (NOGOOD.EQ.3) THEN + WRITE(LOUT,*) 'GMSB BAD POINT: M(H_P)^2<0!' + ELSE IF (NOGOOD.EQ.4) THEN + WRITE(LOUT,*) 'GMSB BAD POINT: YUKAWA>100!' + ELSE IF (NOGOOD.EQ.7) THEN + WRITE(LOUT,*) 'GMSB BAD POINT: XT EWSB IS BAD!' + ELSE IF (NOGOOD.EQ.8) THEN + WRITE(LOUT,*) 'GMSB BAD POINT: MHL^2<0!' + END IF + IF(NOGOOD.NE.0) STOP99 + IF(ITACHY.NE.0) THEN + WRITE(LOUT,*) 'WARNING: TACHYONIC SLEPTONS AT HIGH SCALE' + WRITE(LOUT,*) ' POINT MAY BE INVALID' + ENDIF +C Then calculate masses and decays + AMGVSS=XLAMGM*XMESGM*XCMGV/SQRT(3.)/AMPL + CALL SSMSSM(XISAIN(1),XISAIN(2),XISAIN(3), + $ XISAIN(4),XISAIN(5),XISAIN(6),XISAIN(7),XISAIN(8),XISAIN(9), + $ XISAIN(10),XISAIN(11),XISAIN(12),XISAIN(13),XISAIN(14), + $ XISAIN(15),XISAIN(16),XISAIN(17),XISAIN(18),XISAIN(19), + $ XISAIN(20),XISAIN(21),XISAIN(22),XISAIN(23),XISAIN(24), + $ AMASS(6),IALLOW,2) + ELSE +C Weak scale input +C Values of 1.E20 indicate that SSMASS should calculate +C M_1 and M_2 from M_3 + CALL SSMSSM(XGLSS,XMUSS,XHASS,XTBSS,XQ1SS,XDRSS,XURSS,XL1SS, + $ XERSS,XQ2SS,XSRSS,XCRSS,XL2SS,XMRSS,XQ3SS,XBRSS,XTRSS,XL3SS, + $ XTARSS,XATSS,XABSS,XATASS,XM1SS,XM2SS,AMASS(6),IALLOW,1) + ENDIF +C +C Test parameters +C + IF(IALLOW.NE.0) THEN + WRITE(LOUT,1000) +1000 FORMAT(//' MSSM WARNING: Z1SS IS NOT LSP') + ENDIF + CALL SSTEST(IALLOW) + IITEST=IALLOW/2 + IF(MOD(IITEST,2).NE.0) THEN + WRITE(LOUT,1002) +1002 FORMAT(' MSSM WARNING: Z -> Z1SS Z1SS TOO BIG') + ENDIF + IITEST=IITEST/2 + IF(MOD(IITEST,2).NE.0) THEN + WRITE(LOUT,1004) +1004 FORMAT(' MSSM WARNING: Z -> CHARGINOS ALLOWED') + ENDIF + IITEST=IITEST/2 + IF(MOD(IITEST,2).NE.0) THEN + WRITE(LOUT,1008) +1008 FORMAT(' MSSM WARNING: Z -> Z1SS Z2SS TOO BIG') + ENDIF + IITEST=IITEST/2 + IF(MOD(IITEST,2).NE.0) THEN + WRITE(LOUT,1008) +1016 FORMAT(' MSSM WARNING: Z -> SQUARKS OR SLEPTONS') + ENDIF + IITEST=IITEST/2 + IF(MOD(IITEST,2).NE.0) THEN + WRITE(LOUT,1032) +1032 FORMAT(' MSSM WARNING: Z -> Z* HL0 TOO BIG') + ENDIF + IITEST=IITEST/2 + IF(MOD(IITEST,2).NE.0) THEN + WRITE(LOUT,1064) +1064 FORMAT(' MSSM WARNING: Z -> HL0 HA0 ALLOWED') + ENDIF + IITEST=IITEST/2 + IF(MOD(IITEST,2).NE.0) THEN + WRITE(LOUT,1128) +1128 FORMAT(' MSSM WARNING: Z -> H+ H- ALLOWED') + ENDIF +C +C Store masses in /QLMASS/ +C + CALL FLAVOR(ISUPL,IFL1,IFL2,IFL3,JSPIN,INDEX) + AMLEP(INDEX)=AMULSS + CALL FLAVOR(ISDNL,IFL1,IFL2,IFL3,JSPIN,INDEX) + AMLEP(INDEX)=AMDLSS + CALL FLAVOR(ISSTL,IFL1,IFL2,IFL3,JSPIN,INDEX) + AMLEP(INDEX)=AMSLSS + CALL FLAVOR(ISCHL,IFL1,IFL2,IFL3,JSPIN,INDEX) + AMLEP(INDEX)=AMCLSS + CALL FLAVOR(ISBT1,IFL1,IFL2,IFL3,JSPIN,INDEX) + AMLEP(INDEX)=AMB1SS + CALL FLAVOR(ISTP1,IFL1,IFL2,IFL3,JSPIN,INDEX) + AMLEP(INDEX)=AMT1SS + CALL FLAVOR(ISUPR,IFL1,IFL2,IFL3,JSPIN,INDEX) + AMLEP(INDEX)=AMURSS + CALL FLAVOR(ISDNR,IFL1,IFL2,IFL3,JSPIN,INDEX) + AMLEP(INDEX)=AMDRSS + CALL FLAVOR(ISSTR,IFL1,IFL2,IFL3,JSPIN,INDEX) + AMLEP(INDEX)=AMSRSS + CALL FLAVOR(ISCHR,IFL1,IFL2,IFL3,JSPIN,INDEX) + AMLEP(INDEX)=AMCRSS + CALL FLAVOR(ISBT2,IFL1,IFL2,IFL3,JSPIN,INDEX) + AMLEP(INDEX)=AMB2SS + CALL FLAVOR(ISTP2,IFL1,IFL2,IFL3,JSPIN,INDEX) + AMLEP(INDEX)=AMT2SS +C + CALL FLAVOR(ISNEL,IFL1,IFL2,IFL3,JSPIN,INDEX) + AMLEP(INDEX)=AMN1SS + CALL FLAVOR(ISEL,IFL1,IFL2,IFL3,JSPIN,INDEX) + AMLEP(INDEX)=AMELSS + CALL FLAVOR(ISNML,IFL1,IFL2,IFL3,JSPIN,INDEX) + AMLEP(INDEX)=AMN2SS + CALL FLAVOR(ISMUL,IFL1,IFL2,IFL3,JSPIN,INDEX) + AMLEP(INDEX)=AMMLSS + CALL FLAVOR(ISNTL,IFL1,IFL2,IFL3,JSPIN,INDEX) + AMLEP(INDEX)=AMN3SS + CALL FLAVOR(ISTAU1,IFL1,IFL2,IFL3,JSPIN,INDEX) + AMLEP(INDEX)=AML1SS + CALL FLAVOR(ISER,IFL1,IFL2,IFL3,JSPIN,INDEX) + AMLEP(INDEX)=AMERSS + CALL FLAVOR(ISMUR,IFL1,IFL2,IFL3,JSPIN,INDEX) + AMLEP(INDEX)=AMMRSS + CALL FLAVOR(ISTAU2,IFL1,IFL2,IFL3,JSPIN,INDEX) + AMLEP(INDEX)=AML2SS +C + CALL FLAVOR(ISGL,IFL1,IFL2,IFL3,JSPIN,INDEX) + AMLEP(INDEX)=ABS(AMGLSS) + CALL FLAVOR(ISZ1,IFL1,IFL2,IFL3,JSPIN,INDEX) + AMLEP(INDEX)=ABS(AMZ1SS) + CALL FLAVOR(ISZ2,IFL1,IFL2,IFL3,JSPIN,INDEX) + AMLEP(INDEX)=ABS(AMZ2SS) + CALL FLAVOR(ISZ3,IFL1,IFL2,IFL3,JSPIN,INDEX) + AMLEP(INDEX)=ABS(AMZ3SS) + CALL FLAVOR(ISZ4,IFL1,IFL2,IFL3,JSPIN,INDEX) + AMLEP(INDEX)=ABS(AMZ4SS) + CALL FLAVOR(ISW1,IFL1,IFL2,IFL3,JSPIN,INDEX) + AMLEP(INDEX)=ABS(AMW1SS) + CALL FLAVOR(ISW2,IFL1,IFL2,IFL3,JSPIN,INDEX) + AMLEP(INDEX)=ABS(AMW2SS) +C + CALL FLAVOR(ISHL,IFL1,IFL2,IFL3,JSPIN,INDEX) + AMLEP(INDEX)=ABS(AMHL) + CALL FLAVOR(ISHH,IFL1,IFL2,IFL3,JSPIN,INDEX) + AMLEP(INDEX)=ABS(AMHH) + CALL FLAVOR(ISHA,IFL1,IFL2,IFL3,JSPIN,INDEX) + AMLEP(INDEX)=ABS(AMHA) + CALL FLAVOR(ISHC,IFL1,IFL2,IFL3,JSPIN,INDEX) + AMLEP(INDEX)=ABS(AMHC) +C +C Check decays with ISAJET masses +C NOGRAV turns off gravitino decays and all weaker ones +C + WIDMX=0 + IF(NOGRAV) THEN + DO 90 J=1,NSSMOD + DO 91 K=1,5 + IF(JSSMOD(K,J).EQ.ISGRAV) WIDMX=MAX(WIDMX,GSSMOD(J)) +91 CONTINUE +90 CONTINUE + ENDIF + WIDMX=1.01*WIDMX +C + DO 100 I=1,NOUT + SUMGAM=0 + AMI=AMASS(IDOUT(I)) + DO 110 J=1,NSSMOD + IF(IDOUT(I).NE.ISSMOD(J)) GO TO 110 + SUMMJ=0 + DO 111 K=1,5 + IF(JSSMOD(K,J).NE.0) SUMMJ=SUMMJ+AMASS(JSSMOD(K,J)) +111 CONTINUE + IF(SUMMJ.GE.AMI.OR.GSSMOD(J).LT.WIDMX) GSSMOD(J)=0 + SUMGAM=SUMGAM+GSSMOD(J) +110 CONTINUE + DO 120 J=1,NSSMOD + IF(IDOUT(I).NE.ISSMOD(J)) GO TO 120 + IF(SUMGAM.NE.0) THEN + BSSMOD(J)=GSSMOD(J)/SUMGAM + ELSE + BSSMOD(J)=0 + ENDIF +120 CONTINUE +100 CONTINUE +C + RETURN + END diff --git a/ISAJET/code/drllyn.F b/ISAJET/code/drllyn.F new file mode 100644 index 00000000000..1474d63054c --- /dev/null +++ b/ISAJET/code/drllyn.F @@ -0,0 +1,421 @@ +#include "isajet/pilot.h" + SUBROUTINE DRLLYN +C +C Generate QMW (and QTW) for DRELLYAN or HIGGS event using +C integrated cross section. Then generate decay -- for HIGGS, +C the mode must be chosen using the integrated cross sections +C because of interference with W+W->W+W scattering. +C +C Note that NOGOOD calls the cross section. +C +C Ver. 6.40: Add technicolor resonances. Use logs for QDEN, +C PTDEN, WTFAC, etc. Also scale QMW generation by QMAX. +C +C Ver. 7.01: Correct QDEN to correspond to correct fit form: +C SIGMA = ANOMR(K)*(QMAX**2/Q**2)**QPOW +C See QFUNC. +C +C Ver. 7.14: Add SUSY Higgs +C Ver. 7.15: Fix bug with THETAW limits by adding epsilon to +C allowed range. Check for possible invalid Higgs decays. +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/jetsig.inc" +#include "isajet/totals.inc" +#include "isajet/q1q2.inc" +#include "isajet/partcl.inc" +#include "isajet/pjets.inc" +#include "isajet/pinits.inc" +#include "isajet/wcon.inc" +#include "isajet/primar.inc" +#include "isajet/dylim.inc" +#include "isajet/const.inc" +#include "isajet/jetpar.inc" +#include "isajet/jetlim.inc" +#include "isajet/wgen.inc" +#include "isajet/dypar.inc" +#include "isajet/keys.inc" +#include "isajet/hcon.inc" +#include "isajet/isloop.inc" +#include "isajet/idrun.inc" +#include "isajet/xmssm.inc" +#include "isajet/listss.inc" +C + DIMENSION X(2) + EQUIVALENCE (X(1),X1) + DIMENSION PREST(5),PL(5),EL(3),EML(3),EMSQL(3) + DIMENSION WTFAC(3) + LOGICAL NOGOOD + LOGICAL YGENJ + DIMENSION BRANCH(29),LISTJ(29),LISTW(5) + REAL ACOSH,XXX,ASINH,CHOOSE,RANF,SUM,WTFAC,PTDEN,QDEN,ETA,QPW, + $S12,BRANCH,SUMBR,BRMODE,AMASS,BRINV,TRY,EMSQL,EL,PL12,PREST, + $COSTHL,THL,PHL,PTL,SGN,PL,BP,PLPL,PLMN,AMINI,AMFIN,PINI,PFIN, + $ QPL,QMN,AM1SQ,AM2SQ,ROOT,P1PL,P1MN,P2PL,P2MN,X,EML + INTEGER NTRY,K,IQ1,IQ2,IFL1,IFL2,LISTJ,IQ,NTRY2,IFL,LISTW,I + REAL ZZSTAR + INTEGER IZSTAR,JVIR,N0J +C + DATA LISTJ/ + $9,1,-1,2,-2,3,-3,4,-4,5,-5,6,-6, + $11,-11,12,-12,13,-13,14,-14,15,-15,16,-16, + $10,80,-80,90/ + DATA LISTW/10,80,-80,90,92/ + ACOSH(XXX)=ALOG(XXX+SQRT(XXX**2-1.)) + ASINH(XXX)=ALOG(XXX+SQRT(XXX**2+1.)) +C +C Entry +C + NPTCL=0 + NTRY=0 +200 CONTINUE + SIGMA=0. + WT=1. + 1 CONTINUE + NTRY=NTRY+1 + IF(NTRY.GT.NTRIES) GO TO 999 + SUMWT=SUMWT+SIGMA*WT/(NEVOLV*NFRGMN) + NKINPT=NKINPT+1 + SIGMA=0. + WT=1. + DO 2 K=1,3 + 2 SIGSL(K)=0 +C Choose interval for cross section calculation + CHOOSE=RANF() + SUM=0. + DO 3 K=NKL,NKH + SUM=SUM+QSELWT(K) + IF(CHOOSE.LE.SUM) GO TO 30 +3 CONTINUE +30 KSEL=K +C Generate QTW in selected region + IF(.NOT.FIXQT) THEN + ETA=(PTGN(1,K)+PTGN(2,K)*RANF())**PTGN(3,K) + PTSEL(K)=SQRT(ETA-RNU2(K)) + PTDEN=ALOG(ETA)*PTPOW(K) + WTFAC(1)=ALOG(ABS(PTGN(2,K)))+ALOG(ABS(PTGN(3,K))) + 1 +ALOG(ABS(PTSEL(K)**2+RNU2(K)))*((PTGN(3,K)-1.)/PTGN(3,K)) + PT(3)=PTSEL(K) + ELSE + PTDEN=0. + WTFAC(1)=-1000. + ENDIF +C Generate QMW + IF(.NOT.FIXQM) THEN + IF(.NOT.K.EQ.2) THEN + QSEL(K)=QMAX**2*(QGEN(1,K)+QGEN(2,K)*RANF())**QGEN(3,K) + QDEN=ALOG(QSEL(K)/QMAX**2)*QPOW(K) + WTFAC(2)=ALOG(ABS(QGEN(2,K)))+ALOG(ABS(QGEN(3,K))) + 1 +ALOG(QSEL(K)/QMAX**2)*((QGEN(3,K)-1.)/QGEN(3,K)) + 2 +ALOG(QMAX**2) + QSEL(K)=SQRT(QSEL(K)) + QMW=QSEL(K) + ELSE + ETA=QGEN(3,K)*TAN(QGEN(1,K)+QGEN(2,K)*RANF()) + QSEL(K)=SQRT(ETA+EMSQ) + WTFAC(2)=ALOG(QGEN(2,K))+ALOG(QGEN(3,K)) + 1 +ALOG((ETA/QGEN(3,K))**2+1.) + QMW=QSEL(K) + QDEN=ALOG((QMW**2-EMSQ)**2+EMGAM**2) + ENDIF + ELSE + QDEN=0. + WTFAC(2)=-1000. + ENDIF + SIGSL(K)=EXP(ANORM(K)-PTDEN-QDEN) +C + IF(STDDY) THEN + WT=EXP(WTFAC(2)-ALOG(QSELWT(K))) + ELSE + WT=EXP(WTFAC(1)+WTFAC(2)-ALOG(QSELWT(K))) + ENDIF + QTW=PT(3) + YW=YWMIN+(YWMAX-YWMIN)*RANF() + WT=WT*(YWMAX-YWMIN) + PHIW=PHWMIN+(PHWMAX-PHWMIN)*RANF() + PHI(3)=AMOD(PHIW+PI,2.*PI) + QPW=SQRT(QTW**2+QMW**2)*SINH(YW) + QW=SQRT(QTW**2+QPW**2) + THW=QPW/QW + IF(ABS(THW).GT.1.) THW=SIGN(1.,THW) + THW=ACOS(THW) + IF(THW.LT.THWMIN-1.E-6.OR.THW.GT.THWMAX+1.E-6) GOTO 1 + XW=QPW/HALFE + IF(XW.LT.XWMIN.OR.XW.GT.XWMAX) GOTO 1 + IF(.NOT.STDDY) THEN + IF(.NOT.YGENJ(3)) GOTO 1 + P(3)=PT(3)/STH(3) + XJ(3)=P(3)*CTH(3)/HALFE + IF(XJ(3).LT.XJMIN(3).OR.XJ(3).GT.XJMAX(3)) GOTO 1 + ENDIF +C +C Check integrated cross section +C + IF(NOGOOD(2)) GO TO 1 + SUMWT=SUMWT+SIGMA*WT/(NEVOLV*NFRGMN) + NWGEN=NWGEN+1 + S12=QMW**2 +C +C No decay for KKG: +C For compatibility reasons, the jet is still the 3rd one. +C Jets 1 and 2 (W decay products) are voided; no decay step. +C + IF(KEYS(11)) THEN + DO 50 I=1,2 + P(I)=0. + PT(I)=0. + CTH(I)=0. + PHI(I)=0. + EMSQL(I)=0. + IDJETS(I)=0 +50 CONTINUE + GOTO 350 + ENDIF +C +C Select W decay mode +C QMW dependence neglected in branching ratios +C BRANCH is cum. br. with heavy modes subtracted. +C + IF(KEYS(3)) THEN + BRANCH(1)=0. + SUMBR=0. + DO 105 IQ1=2,25 + IQ2=MATCH(IQ1,JWTYP) + IF(IQ2.EQ.0) THEN + BRMODE=0. + ELSE + BRMODE=WCBR(IQ1,JWTYP)-WCBR(IQ1-1,JWTYP) + IFL1=LISTJ(IQ1) + IFL2=LISTJ(IQ2) + IF(S12.LE.(AMASS(IFL1)+AMASS(IFL2))**2) BRMODE=0. + ENDIF + BRANCH(IQ1)=BRANCH(IQ1-1)+BRMODE + SUMBR=SUMBR+BRMODE +105 CONTINUE + BRINV=1./SUMBR +C + TRY=RANF() + DO 110 IQ=1,25 + IF(TRY.LT.BRANCH(IQ)*BRINV.AND.MATCH(IQ,JWTYP).NE.0) THEN + JETTYP(1)=IQ + JETTYP(2)=MATCH(IQ,JWTYP) + GO TO 120 + ENDIF +110 CONTINUE + ENDIF +C +120 IF(GOMSSM) THEN + IFL1=LISTSS(JETTYP(1)) + IFL2=LISTSS(JETTYP(2)) + ELSE + IFL1=LISTJ(JETTYP(1)) + IFL2=LISTJ(JETTYP(2)) + ENDIF +C +C Select masses of decay products. These are just normal masses +C except for Z Z* decay of Higgs, where one is virtual. +C + EML(1)=AMASS(IFL1) + EML(2)=AMASS(IFL2) + IF(KEYS(7).AND.EML(1)+EML(2).GT.QMW) THEN +C WW* or ZZ* decay - generate/check W* or Z* mass + IF((IABS(IFL1).EQ.80.AND.IABS(IFL2).EQ.80) + $ .OR.(IFL1.EQ.90.AND.IFL2.EQ.90)) THEN + IZSTAR=3-2*RANF() + IF(GOMSSM) THEN + JVIR=JETTYP(IZSTAR)-76 + ELSE + JVIR=JETTYP(IZSTAR)-25 + ENDIF + EML(IZSTAR)=ZZSTAR(QMW,JVIR) + IF(EML(IZSTAR).LT.ZSTARS(JVIR,IZSTAR)) GO TO 200 +C Other decay - invalid for this QMW + ELSE + GO TO 200 + ENDIF + ENDIF +C +C Generate W decay in its rest frame and compare with SIGDY2. +C First set up momenta of decay products: +C + EMSQL(1)=EML(1)**2 + EMSQL(2)=EML(2)**2 + EL(1)=(S12+EMSQL(1)-EMSQL(2))/(2.*QMW) + EL(2)=(S12+EMSQL(2)-EMSQL(1))/(2.*QMW) + PL12=SQRT((S12-(EML(1)+EML(2))**2)*(S12-(EML(1)-EML(2))**2)) + $/(2.*QMW) +C W momentum + PREST(1)=QTW*COS(PHIW) + PREST(2)=QTW*SIN(PHIW) + PREST(3)=QPW + PREST(4)=SQRT(QW**2+QMW**2) + PREST(5)=QMW + NTRY2=0 +C Generate next W decay +20 CONTINUE + NTRY2=NTRY2+1 + IF(NTRY2.GT.NTRIES) GO TO 999 + COSTHL=2.*RANF()-1. + THL=ACOS(COSTHL) + PHL=2.*PI*RANF() + PTL=PL12*SIN(THL) +C + DO 300 I=1,2 + SGN=3-2*I + PL(1)=SGN*PTL*COS(PHL) + PL(2)=SGN*PTL*SIN(PHL) + PL(3)=SGN*PL12*COSTHL + PL(4)=EL(I) + PL(5)=EML(I) +C Boost with W momentum + BP=0. + DO 310 K=1,3 +310 BP=BP+PL(K)*PREST(K) + BP=BP/PREST(5) + DO 320 K=1,3 +320 PL(K)=PL(K)+PREST(K)*PL(4)/PREST(5) + $ +PREST(K)*BP/(PREST(4)+PREST(5)) + PL(4)=PL(4)*PREST(4)/PREST(5)+BP +C Fill common blocks + PT(I)=SQRT(PL(1)**2+PL(2)**2) + P(I)=SQRT(PT(I)**2+PL(3)**2) + IF(PT(I).GT.0.) THEN + PHI(I)=ATAN2(PL(2),PL(1)) + ELSE + PHI(I)=(I-1)*PI + ENDIF + IF(PHI(I).LT.0.) PHI(I)=PHI(I)+2.*PI + CTH(I)=PL(3)/P(I) + STH(I)=PT(I)/P(I) + TH(I)=ACOS(CTH(I)) + XJ(I)=PL(3)/HALFE + IF(CTH(I).GT.0.) THEN + PLPL=PL(4)+PL(3) + PLMN=(PT(I)**2+EMSQL(I))/PLPL + ELSE + PLMN=PL(4)-PL(3) + PLPL=(PT(I)**2+EMSQL(I))/PLMN + ENDIF + YJ(I)=.5*ALOG(PLPL/PLMN) +300 CONTINUE +C +C Test cross section +C Extra kinematics for W+W->W+W +C + IF(KEYS(7).OR.KEYS(9)) THEN + SHAT=S12 + IF(GOMSSM) THEN + AMINI=AMASS(LISTSS(INITYP(1))) + ELSE + AMINI=AMASS(LISTJ(INITYP(1))) + ENDIF + AMFIN=EML(1) + PINI=.5*SQRT(S12-4.*AMINI**2) + PFIN=PL12 + THAT=AMINI**2+AMFIN**2-.5*S12+2.*PINI*PFIN*COSTHL + UHAT=AMINI**2+AMFIN**2-.5*S12-2.*PINI*PFIN*COSTHL + ENDIF +C +C Check W decay +C + IF(NOGOOD(3)) GO TO 20 +C +C Check W decay with kinematic limits +C + IF(NOGOOD(4)) GO TO 200 +350 NKEEP=NKEEP+1 +C +C Set PBEAM +C + PBEAM(1)=(1.-X1)*HALFE + PBEAM(2)=(1.-X2)*HALFE + IF(NJET.LT.3) GO TO 502 + IFL=LISTJ(JETTYP(3)) + EMSQL(3)=AMASS(IFL)**2 +502 CONTINUE +C +C Set PJETS +C + IF(KEYS(11)) THEN + N0J=3 + ELSE + N0J=1 + ENDIF + DO 501 I=N0J,NJET + PJETS(3,I)=P(I)*CTH(I) + PJETS(1,I)=PT(I)*COS(PHI(I)) + PJETS(2,I)=PT(I)*SIN(PHI(I)) + PJETS(4,I)=SQRT(P(I)**2+EMSQL(I)) + PJETS(5,I)=SQRT(EMSQL(I)) + IF(KEYS(7).AND.GOMSSM) THEN + IDJETS(I)=LISTSS(JETTYP(I)) + ELSE + IDJETS(I)=LISTJ(JETTYP(I)) + ENDIF +501 CONTINUE +C No technicolor IDENT's defined, so... + IF(KEYS(3)) THEN + IDENTW=LISTW(JWTYP) + ELSEIF(KEYS(7).AND..NOT.GOMSSM) THEN + IDENTW=81 + ELSEIF(KEYS(7).AND.GOMSSM) THEN + IDENTW=IHTYPE + ELSEIF(KEYS(11)) THEN + IDENTW=92 + ELSE + IDENTW=0 + ENDIF +C W momentum in /PJETS/ + IF(KEYS(11)) THEN + QWJET(1)=QTW*COS(PHIW) + QWJET(2)=QTW*SIN(PHIW) + QWJET(3)=QPW + QWJET(4)=SQRT(QW**2+QMW**2) + QWJET(5)=QMW + ELSE + DO 503 K=1,4 +503 QWJET(K)=PJETS(K,1)+PJETS(K,2) + QWJET(5)=QMW + ENDIF +C +C Set PINITS + DO 504 I=1,2 + IF(KEYS(7).AND.GOMSSM) THEN + IDINIT(I)=LISTSS(INITYP(I)) + ELSE + IDINIT(I)=LISTJ(INITYP(I)) + ENDIF + PINITS(5,I)=AMASS(IDINIT(I)) + PINITS(1,I)=0. + PINITS(2,I)=0. +504 CONTINUE +C Calculate total momentum + QPL=QWJET(4)+QWJET(3) + QMN=QWJET(4)-QWJET(3) + IF(NJET.EQ.3) THEN + QPL=QPL+PJETS(4,3)+PJETS(3,3) + QMN=QMN+PJETS(4,3)-PJETS(3,3) + ENDIF +C and solve initial kinematics + AM1SQ=PINITS(5,1)**2 + AM2SQ=PINITS(5,2)**2 + ROOT=SQRT((QPL*QMN-AM1SQ-AM2SQ)**2-4.*AM1SQ*AM2SQ) + P1PL=(QPL*QMN+AM1SQ-AM2SQ+ROOT)/(2.*QMN) + P1MN=AM1SQ/P1PL + P2MN=(QPL*QMN+AM2SQ-AM1SQ+ROOT)/(2.*QPL) + P2PL=AM2SQ/P2MN + PINITS(3,1)=.5*(P1PL-P1MN) + PINITS(4,1)=.5*(P1PL+P1MN) + PINITS(3,2)=.5*(P2PL-P2MN) + PINITS(4,2)=.5*(P2PL+P2MN) + RETURN +C +999 CALL PRTEVT(0) + WRITE(ITLIS,9999) NTRIES +9999 FORMAT(//' IT IS TAKING MORE THAN',I5,' TRIES TO GENERATE AN', + C' EVENT. CHECK LIMITS OR INCREASE NTRIES') + STOP 99 + END diff --git a/ISAJET/code/ebeam.F b/ISAJET/code/ebeam.F new file mode 100644 index 00000000000..c313ac73eef --- /dev/null +++ b/ISAJET/code/ebeam.F @@ -0,0 +1,65 @@ +#include "isajet/pilot.h" + FUNCTION EBEAM(X,E) +C*********************************************************************** +C* Modified from contributed subroutine by M. Drees (1/8/99) +C* Computes the effective single elctrn spectrum from beamstrahlung at * +C* e+e- colliders, using Chen's approximate expressions, for a given * +C* beamstrahlung parameter Y; is supposed to work for Y <= 10 or so. * +C* The quantities in the COMMON block are the beamstrahlungs parameter * +C* Y, the bunch length XL in GeV, the number of photons NGAM, and the * +C* parameters NUCL, NUGAM, W, XKAPPA defined by Chen, as well as the * +C* pre-factor FAC. Y, E and XLMM are read in by BEAM when it is called * +C* for the first time, with INIT=1; in this first run the other para- * +C* meters are then computed, and simply used in later calls with * +C* INIT = 0. This COMMON block should be present in the main program * +C* in order to guarantee the survival of these parameters. Finally, X * +C* is the electron energy in units of the nominal beam energy. Notice * +C* that BEAMEL is only the part which is NOT proportional to * +C* delta(1-X); the coefficient of the delta-function is simply * +C* (1-exp(-NGAM))/NGAM. * +C*********************************************************************** +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/eepar.inc" +C + REAL XLMM,XL,GAM,RE,XKAPPA,NUCL,NUGAM,NGAM,X,NUBAR, + $ETA,EPS,HFAC,RAT,MTERM,TERM,HBAR,XN,EBEAM,Y,E,GAMMA + DOUBLE PRECISION DINCGM +C + Y=UPSLON + XLMM=SIGZ + XLMM = 2.E0*SQRT(3.E0)*XLMM + XL = XLMM*1.E12/.197327E0 + GAM = E/5.11E-4 + RE = 1.E0/(137.E0*5.11E-4) + XKAPPA = 2.E0/(3.E0*Y) + NUCL = 2.5E0*Y/(SQRT(3.E0)*137.E0**2*GAM*RE) + NUGAM = NUCL/SQRT(1.E0+Y**.6666666E0) + NGAM = .5E0*NUGAM*XL + IF(X.LT.1.E-5) X=1.E-5 + IF(X.GT..99999) X=.99999 + NUBAR = X*NUCL + (1.0-X)*NUGAM + ETA = XKAPPA*(1.0/X-1.0) + IF(ETA.GT.5.E1) THEN + EBEAM = 1.E-20 + RETURN + ENDIF + EPS = 1.E-4 + HFAC = EXP(-ETA)/(NGAM*(1.E0-X)) + IF(HFAC.LT.1.E0) EPS = EPS/SQRT(HFAC) + RAT = NUBAR/NUGAM*(ETA**.33333333E0) + MTERM = RAT + TERM = MTERM/GAMMA(.33333E0)*DINCGM(2.D0,DBLE(NGAM),DBLE(EPS)) + HBAR = TERM + XN = 1.0 +1 XN = XN+1.0 + MTERM = MTERM*RAT/XN + TERM = MTERM/GAMMA(XN/3.)* + $DINCGM(DBLE(XN)+1.D0,DBLE(NGAM),DBLE(EPS)) + HBAR = HBAR+TERM + IF(ABS(TERM/HBAR).GT.EPS) GO TO 1 + EBEAM = HFAC * HBAR + IF(EBEAM.LT.0.) EBEAM = 1.E-20 + RETURN + END diff --git a/ISAJET/code/eebeg.F b/ISAJET/code/eebeg.F new file mode 100644 index 00000000000..351bf134930 --- /dev/null +++ b/ISAJET/code/eebeg.F @@ -0,0 +1,16 @@ +#include "isajet/pilot.h" + SUBROUTINE EEBEG +C INITIALIZE E+E- EVENTS FOR DOLOG +#include "isajet/itapes.inc" +#include "isajet/primar.inc" +#include "isajet/jetlim.inc" +#include "isajet/jetpar.inc" + DO 100 I=1,2 + PMIN(I)=HALFE + PMAX(I)=-1.E9 +100 CONTINUE + QSQ=SCM + IDIN(1)=-12 + IDIN(2)=12 + RETURN + END diff --git a/ISAJET/code/eemax.F b/ISAJET/code/eemax.F new file mode 100644 index 00000000000..b4b455c620c --- /dev/null +++ b/ISAJET/code/eemax.F @@ -0,0 +1,91 @@ +#include "isajet/pilot.h" + SUBROUTINE EEMAX +C FIND UPPER BOUND FOR E+E- CROSS SECTION SUMMED OVER ALLOWED +C TYPES. +C VER 7.17: ENSURE XJMIN < XX < XJMAX +C VER 7.42: ENACT BREMSSTRAHLUNG EFFECT +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/jetsig.inc" +#include "isajet/eepar.inc" +#include "isajet/jetlim.inc" +#include "isajet/jetpar.inc" +#include "isajet/primar.inc" +#include "isajet/xmssm.inc" +#include "isajet/sssm.inc" +#include "isajet/brembm.inc" +C + REAL ETEST(3),XDI(3),RSH,XD,XDUMMY,SSFEL,DX,XX + INTEGER NET,NXD,NX,NX1,IET,IXD,IX,I +C + NET=1 + NXD=1 + ETEST(1)=ECM +C Initialize beam/brem spectra convolution and fit + IF (IBEAM) THEN + QSQBM=RSHMAX**2 + EB=RSHMAX/2. + WRITE(ITLIS,*) ' BEGINNING BREM/BEAM CONVOLUTION AND FIT...' + XDUMMY=SSFEL(.1,1) + END IF + IF (IBREM) THEN + NET=3 + NXD=3 + ETEST(1)=RSHMIN + IF (RSHMAX.GT.AMZ.AND.RSHMIN.LT.AMZ) THEN + ETEST(2)=AMZ + ELSE + ETEST(2)=RSHMIN+(RSHMAX-RSHMIN)/2. + END IF + ETEST(3)=MIN(RSHMAX,.999*ECM) + END IF + SGMXEE=0. + NX=50 + IF(FIXYJ(1)) NX=1 + NX1=NX+1 + DX=(XJMAX(1)-XJMIN(1))/NX +C SCAN IN X=COS(THETA) + DO IET=1,NET + RSH=ETEST(IET) + SHAT=RSH*RSH + XDI(1)=-(1.-SHAT/SCM) + XDI(2)=0. + XDI(3)=-XDI(1) + DO IXD=1,NXD + XD=XDI(IXD) + X1=(XD+SQRT(XD**2+4*SHAT/SCM))/2. + X2=X1-XD + DO 100 IX=1,NX1 + XX=XJMIN(1)+DX*(IX-1) + IF(XX.LT.XJMIN(1)) XX=XJMIN(1) + IF(XX.GT.XJMAX(1)) XX=XJMAX(1) + CTH(1)=XX + CTH(2)=-XX + DO 110 I=1,2 + XJ(I)=CTH(I) + TH(I)=ACOS(CTH(I)) + STH(I)=SIN(TH(I)) + PT(I)=HALFE*STH(I) + IF(IX.EQ.1) YJ(I)=YJMIN(I) + IF(IX.EQ.NX1) YJ(I)=YJMAX(I) + IF(IX.GT.1.AND.IX.LT.NX1) + 1 YJ(I)=.5*ALOG((1.+CTH(I))/(1.-CTH(I))) +110 CONTINUE +C COMPUTE CROSS SECTION + IF (GOMSSM) THEN + CALL SIGSSE + ELSE + CALL SIGEE + END IF + IF(SIGMA.GT.SGMXEE) SGMXEE=SIGMA +100 CONTINUE + END DO + END DO +C REQUIRE CROSS SECTION BE POSITIVE + WRITE(ITLIS,1000) SGMXEE +1000 FORMAT(///' MAXIMUM D(SIGMA)/D(COS THETA) = ',E12.4) + IF(SGMXEE.GT.0) RETURN + STOP 99 + END diff --git a/ISAJET/code/elctrn.F b/ISAJET/code/elctrn.F new file mode 100644 index 00000000000..c5e8a2d7ab3 --- /dev/null +++ b/ISAJET/code/elctrn.F @@ -0,0 +1,169 @@ +#include "isajet/pilot.h" + SUBROUTINE ELCTRN +C GENERATE E+ E- ----> QK QB EVENT USING SIGEE CROSS SECTION. +#include "isajet/itapes.inc" +#include "isajet/jetsig.inc" +#include "isajet/eepar.inc" +#include "isajet/primar.inc" +#include "isajet/pjets.inc" +#include "isajet/pinits.inc" +#include "isajet/jetpar.inc" +#include "isajet/jetlim.inc" +#include "isajet/const.inc" +#include "isajet/totals.inc" +#include "isajet/partcl.inc" +#include "isajet/xmssm.inc" +#include "isajet/sstype.inc" + REAL AMQ(2),SSXLAM,RSH,XD,GAM,V,DUMMY + INTEGER MSUPL,MSDNL,MSSTL,MSCHL,MSBT1,MSTP1, + $MSUPR,MSDNR,MSSTR,MSCHR,MSBT2,MSTP2,MSW1,MSW2, + $MSNEL,MSEL,MSNML,MSMUL,MSNTL,MSTAU1,MSER,MSMUR,MSTAU2,IDSS(85) + PARAMETER (MSUPL=-ISUPL) + PARAMETER (MSDNL=-ISDNL) + PARAMETER (MSSTL=-ISSTL) + PARAMETER (MSCHL=-ISCHL) + PARAMETER (MSBT1=-ISBT1) + PARAMETER (MSTP1=-ISTP1) + PARAMETER (MSUPR=-ISUPR) + PARAMETER (MSDNR=-ISDNR) + PARAMETER (MSSTR=-ISSTR) + PARAMETER (MSCHR=-ISCHR) + PARAMETER (MSBT2=-ISBT2) + PARAMETER (MSTP2=-ISTP2) + PARAMETER (MSW1=-ISW1) + PARAMETER (MSW2=-ISW2) + PARAMETER (MSNEL=-ISNEL) + PARAMETER (MSEL=-ISEL) + PARAMETER (MSNML=-ISNML) + PARAMETER (MSMUL=-ISMUL) + PARAMETER (MSNTL=-ISNTL) + PARAMETER (MSTAU1=-ISTAU1) + PARAMETER (MSER=-ISER) + PARAMETER (MSMUR=-ISMUR) + PARAMETER (MSTAU2=-ISTAU2) + DIMENSION LISTJ(29) + DATA LISTJ/9,1,-1,2,-2,3,-3,4,-4,5,-5,6,-6, + 111,-11,12,-12,13,-13,14,-14,15,-15,16,-16,10,80,-80,90/ + DATA IDSS/0, + $ISUPL,MSUPL,ISDNL,MSDNL,ISSTL,MSSTL,ISCHL,MSCHL,ISBT1,MSBT1, + $ISTP1,MSTP1, + $ISUPR,MSUPR,ISDNR,MSDNR,ISSTR,MSSTR,ISCHR,MSCHR,ISBT2,MSBT2, + $ISTP2,MSTP2,ISW1,MSW1,ISW2,MSW2,ISZ1,ISZ2,ISZ3,ISZ4, + $ISNEL,MSNEL,ISEL,MSEL,ISNML,MSNML,ISMUL,MSMUL, + $ISNTL,MSNTL,ISTAU1,MSTAU1,ISER,MSER,ISMUR,MSMUR, + $ISTAU2,MSTAU2, + $9,1,-1,2,-2,3,-3,4,-4,5,-5,6,-6,11,-11,12,-12,13,-13, + $14,-14,15,-15,16,-16,10,80,-80,90,82,83,84,86,-86/ +C ENTRY + NPTCL=0 + NREJ=-1 + SIGMA=0. + NSIGS=0 + DO 10 I=1,MXSIGS +10 SIGS(I)=0. + WT=1. +C GENERATE NEXT KINEMATIC POINT +100 CONTINUE + NREJ=NREJ+1 + IF(NREJ.GT.NTRIES) GO TO 9999 + NKINPT=NKINPT+1 + SUMWT=SUMWT+SIGMA*WT + IF (IBREM) THEN + RSH=RSHMIN+(RSHMAX-RSHMIN)*RANF() + SHAT=RSH**2 + QSQ=SHAT + XD=(1.-SHAT/SCM)*(-1.+2*RANF()) + X1=(XD+SQRT(XD**2+4*SHAT/SCM))/2. + X2=X1-XD + ELSE + SHAT=SCM + RSH=SQRT(SHAT) + END IF + PHI(1)=PHIMIN(1)+(PHIMAX(1)-PHIMIN(1))*RANF() + PHI(2)=AMOD(PHI(1)+PI,2.*PI) + CTH(1)=XJMIN(1)+(XJMAX(1)-XJMIN(1))*RANF() + CTH(2)=-CTH(1) + DO 110 I=1,2 + TH(I)=ACOS(CTH(I)) + STH(I)=SIN(TH(I)) + PT(I)=HALFE*STH(I) + YJ(I)=.5*ALOG((1+CTH(I))/(1-CTH(I))) + XJ(I)=CTH(I) +110 CONTINUE +C CALCULATE CROSS SECTION + IF (GOMSSM) THEN + CALL SIGSSE + ELSE + CALL SIGEE + END IF + WT=XJMAX(1)-XJMIN(1) +C TEST CROSS SECTION + IF(SIGMA.GT.SGMXEE) SGMXEE=SIGMA + IF(SIGMA.LT.SGMXEE*RANF()) GO TO 100 + SUMWT=SUMWT+SIGMA*WT + NKEEP=NKEEP+1 +C SELECT JET TYPES + SIGINV=1./SIGMA + TRY=RANF() + SUM=0. + DO 200 I=1,NSIGS + SUM=SUM+SIGS(I)*SIGINV + IF(SUM.LT.TRY) GO TO 200 +C FIND REACTION + ISIGS=I + SIGEVT=SIGS(ISIGS) + II=INOUT(I)/IOPAK**2 + JETTYP(1)=MOD(II,IOPAK) + II=II/IOPAK + JETTYP(2)=MOD(II,IOPAK) + GO TO 210 +200 CONTINUE + GO TO 9998 +C SET PJETS. RESET P AND PT INCLUDING MASSES. +210 CONTINUE + IF (GOMSSM) THEN + AMQ(1)=AMASS(IDSS(JETTYP(1))) + AMQ(2)=AMASS(IDSS(JETTYP(2))) + ELSE + AMQ(1)=AMASS(LISTJ(JETTYP(1))) + AMQ(2)=AMASS(LISTJ(JETTYP(2))) + END IF + PCM=SQRT(SSXLAM(SHAT,AMQ(1)**2,AMQ(2)**2))/2./RSH + DO 220 I=1,2 + PJETS(1,I)=PCM*STH(I)*COS(PHI(I)) + PJETS(2,I)=PCM*STH(I)*SIN(PHI(I)) + PJETS(3,I)=PCM*CTH(I) + PJETS(4,I)=SQRT(PCM**2+AMQ(I)**2) + PJETS(5,I)=AMQ(I) + IF (GOMSSM) THEN + IDJETS(I)=IDSS(JETTYP(I)) + ELSE + IDJETS(I)=LISTJ(JETTYP(I)) + END IF + P(I)=PCM + PT(I)=P(I)*STH(I) +220 CONTINUE +C IF BREMSSTRAHLUNG, THEN BOOST TO LAB FRAME + IF (IBREM) THEN + GAM=(X1+X2)*ECM/2./RSH + V=-SIGN(1.,(X1-X2))*SQRT(ABS(1.-1./GAM)*(1.+1./GAM)) + DO I=1,2 + DUMMY=PJETS(4,I) + PJETS(4,I)=GAM*(PJETS(4,I)-V*PJETS(3,I)) + PJETS(3,I)=GAM*(PJETS(3,I)-V*DUMMY) + END DO + END IF + RETURN +C ERROR MESSAGES +9998 CONTINUE + CALL PRTEVT(0) + WRITE(ITLIS,1010) +1010 FORMAT(//' ERROR IN ELCTRN...NO GOOD JET TYPES FOUND') + STOP 99 +9999 CONTINUE + CALL PRTEVT(0) + WRITE(ITLIS,1020) NTRIES +1020 FORMAT(//' IT IS TAKING MORE THAN',I5,' TRIES TO GENERATE AN', + $' EVENT. CHECK LIMITS OR INCREASE NTRIES.') + STOP 99 + END diff --git a/ISAJET/code/epf.F b/ISAJET/code/epf.F new file mode 100644 index 00000000000..d13bc1e7533 --- /dev/null +++ b/ISAJET/code/epf.F @@ -0,0 +1,16 @@ +#include "isajet/pilot.h" + FUNCTION EPF(A,B,C,D) +C CALCULATE TOTALLY ANTISYMMETRIC TENSOR EPSILON CONTRACTED +C WITH FOUR 4-VECTORS. +#include "isajet/itapes.inc" + DIMENSION A(4),B(4),C(4),D(4) +#if defined(CERNLIB_DOUBLE) + DOUBLE PRECISION EPF + DOUBLE PRECISION A,B,C,D,CD,BCD +#endif + CD(I,J)=C(I)*D(J)-C(J)*D(I) + BCD(I,J,K)=B(I)*CD(J,K)-B(J)*CD(I,K)+B(K)*CD(I,J) + EPF=A(1)*BCD(2,3,4)-A(2)*BCD(1,3,4)+A(3)*BCD(1,2,4) + 1-A(4)*BCD(1,2,3) + RETURN + END diff --git a/ISAJET/code/estruc.F b/ISAJET/code/estruc.F new file mode 100644 index 00000000000..f032361f774 --- /dev/null +++ b/ISAJET/code/estruc.F @@ -0,0 +1,40 @@ +#include "isajet/pilot.h" + FUNCTION ESTRUC(X,QS) +C +C THIS IS ELECTRON PARTON DISTRIBUTION FUNCTION; +C SAME AS USED IN PYTHIA; NOTE! ESTRUC=0 FOR X>.999999 +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + REAL ESTRUC,AL,PI,AME,QS,X,BT,XM,T,A,B +C + AL=1./128. + PI=4*ATAN(1.) + AME=.511E-3 + BT=2*AL/PI*(LOG(QS/AME/AME)-1.) +C KLEISS/SJOSTRAND PRESCRIPTION +C IF (X.LE..9999) THEN +C ESTRUC=BT/2.*(1.-X)**(BT/2.-1.) +C ELSE IF (X.LE..999999.AND.X.GT..9999) THEN +C ESTRUC=100.**(BT/2.)/(100.**(BT/2.)-1.)*BT/2.* +C $ (1.-X)**(BT/2.-1.) +C ELSE +C ESTRUC=0. +C END IF +C FADIN-KURAEV/DREES PRESCRIPTION + XM=.998 + IF(X.GT.XM) THEN + T = (1.+.375*BT)*(1.-XM)**(BT/2.) + A = ((1.0-BT/2.)*T + & -.25*BT*(1.5-XM*(1.+XM/2.)))/(1.-XM) + & +.25*BT*(1.0+XM) + A = 2*A/(1.-XM) + B = .5*BT*T/(1.-XM) - .25*BT*(1.+XM) - A*XM + ESTRUC = A*X+B + ELSE + ESTRUC = .5*BT*((1.-X)**(.5*BT-1.)) * (1.+.375*BT) + & -.25*BT*(1.+X) + ENDIF + RETURN + END diff --git a/ISAJET/code/evol01.F b/ISAJET/code/evol01.F new file mode 100644 index 00000000000..d140d2f9d59 --- /dev/null +++ b/ISAJET/code/evol01.F @@ -0,0 +1,60 @@ +#include "isajet/pilot.h" + SUBROUTINE EVOL01 +C---------------------------------------------------------------------- +C- +C- Purpose and Methods : +C- Setup for process 1 (TWOJET) +C- Lorentz frames and perform initial and final QCD jet +C- evolution in leading-log approximation. +C- +C- Created 13-AUG-1991 Frank E. Paige,Serban D. Protopopescu +C- +C---------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/primar.inc" +#include "isajet/jetpar.inc" +#include "isajet/pjets.inc" +#include "isajet/jetset.inc" +#include "isajet/jwork.inc" +#include "isajet/jwork2.inc" +#include "isajet/frame.inc" + REAL EVOLMS + INTEGER I,K,J,NJSAVE,NJFINL +C---------------------------------------------------------------------- +C +C Copy momenta from /PJETS/ to /JETSET/ + N0JETS=NJSET+1 + CALL IPJSET + NJSAVE=NJSET +C +C Set flags and maximum off-shell masses and generate +C initial QCD parton shower. +C + CALL ISTRAD(1.0) +C + IF(NJSET.LT.0) RETURN +C +C Final state evolution. +C Define Lorentz frames and JMATCH pointers for jet evolution +C and fragmentation. +C + CALL IFRAMS(N0JETS,NJSAVE,1,.FALSE.) +C +C Set maximum off-shell masses and JDCAY flags. +C + NJFINL=N0JETS + DO 310 J=N0JETS,NJSAVE + IF(IABS(JTYPE(J)).LT.10) THEN + PJSET(5,J)=EVOLMS(J,1.0) + JDCAY(J)=-1 + ENDIF +310 CONTINUE +C +C Produce final-state QCD parton cascade +C + CALL QCDJET(NJFINL) +C + RETURN + END diff --git a/ISAJET/code/evol02.F b/ISAJET/code/evol02.F new file mode 100644 index 00000000000..5771f97abb8 --- /dev/null +++ b/ISAJET/code/evol02.F @@ -0,0 +1,56 @@ +#include "isajet/pilot.h" + SUBROUTINE EVOL02 +C---------------------------------------------------------------------- +C- +C- Purpose and Methods : +C- Setup for process 2 (E+E-) +C- Lorentz frames and perform initial and final QCD jet +C- evolution in leading-log approximation. +C- +C- Created 13-AUG-1991 Frank E. Paige,Serban D. Protopopescu +C- +C---------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/primar.inc" +#include "isajet/jetpar.inc" +#include "isajet/pjets.inc" +#include "isajet/jetset.inc" +#include "isajet/jwork.inc" +#include "isajet/jwork2.inc" +#include "isajet/keys.inc" +#include "isajet/frame.inc" + REAL EVOLMS + INTEGER I,K,J,NJSAVE,NJFINL +C---------------------------------------------------------------------- +C +C Copy momenta from /PJETS/ to /JETSET/ + N0JETS=NJSET+1 + CALL IPJSET + NJSAVE=NJSET +C +C Final state evolution. +C Define Lorentz frames and JMATCH pointers for jet evolution +C and fragmentation. +C + CALL IFRAMS(N0JETS,NJSAVE,1,.FALSE.) +C +C Set maximum off-shell masses and JDCAY flags. +C + NJFINL=N0JETS + DO 310 J=N0JETS,NJSAVE + IF((IABS(JTYPE(J)).LT.10).OR. + $ (IABS(JTYPE(J)).GE.21.AND.IABS(JTYPE(J)).LE.29).OR. + $ (IABS(JTYPE(J)).GE.41.AND.IABS(JTYPE(J)).LE.46))THEN + PJSET(5,J)=EVOLMS(J,1.0) + JDCAY(J)=-1 + ENDIF +310 CONTINUE +C +C Produce final-state QCD parton cascade +C + CALL QCDJET(NJFINL) +C + RETURN + END diff --git a/ISAJET/code/evol03.F b/ISAJET/code/evol03.F new file mode 100644 index 00000000000..735b6def6fb --- /dev/null +++ b/ISAJET/code/evol03.F @@ -0,0 +1,125 @@ +#include "isajet/pilot.h" + SUBROUTINE EVOL03 +C---------------------------------------------------------------------- +C- +C- Purpose and Methods : +C- Setup for process 3 (DRELLYAN) +C- Lorentz frames and perform initial and final QCD jet +C- evolution in leading-log approximation. +C- +C- Created 13-AUG-1991 Frank E. Paige,Serban D. Protopopescu +C- +C---------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/primar.inc" +#include "isajet/jetpar.inc" +#include "isajet/pjets.inc" +#include "isajet/jetset.inc" +#include "isajet/jwork.inc" +#include "isajet/jwork2.inc" +#include "isajet/q1q2.inc" +#include "isajet/frame.inc" +#include "isajet/wcon.inc" + REAL EVOLMS,BP + INTEGER I,K,J,NJFINL +C---------------------------------------------------------------------- +C +C Add W momentum and recoil jets + N0JETS=NJSET+1 + IF(.NOT.STDDY) THEN + DO 101 I=3,NJET + NJSET=NJSET+1 + JORIG(NJSET)=JPACK*I + JTYPE(NJSET)=IDJETS(I) + JDCAY(NJSET)=0 + DO 105 K=1,5 +105 PJSET(K,NJSET)=PJETS(K,I) + IFRAME(I)=1 +101 CONTINUE + NJSET=NJSET+1 + N0W=NJSET + JORIG(NJSET)=0 + JTYPE(NJSET)=IDENTW + JDCAY(NJSET)=(N0W+1)*JPACK+N0W+2 + DO 120 K=1,5 +120 PJSET(K,NJSET)=QWJET(K) + ENDIF +C +C Add W decays + DO 110 I=1,2 + NJSET=NJSET+1 + JORIG(NJSET)=JPACK*I + JTYPE(NJSET)=IDJETS(I) + JDCAY(NJSET)=0 + DO 115 K=1,5 +115 PJSET(K,NJSET)=PJETS(K,I) + IFRAME(I)=2 + IF(STDDY) IFRAME(I)=1 +110 CONTINUE +C +C Set flags and maximum off-shell masses and generate +C initial QCD parton shower. +C + CALL ISTRAD(WFUDGE) +C + IF(NJSET.LT.0) RETURN +C +C Final state evolution. +C Define Lorentz frames and JMATCH pointers for jet evolution +C and fragmentation. +C + IF(STDDY) THEN + CALL IFRAMS(3,4,1,.FALSE.) + ELSE + CALL IFRAMS(N0W+1,N0W+2,2,.FALSE.) + CALL IFRAMS(N0JETS,N0W,1,.FALSE.) + ENDIF +C +C Set maximum off-shell masses and JDCAY flags. +C + IF(STDDY) THEN + NJFINL=3 + DO 310 J=3,4 + IF(IABS(JTYPE(J)).LT.10) THEN + PJSET(5,J)=QMW + JDCAY(J)=-1 + ENDIF +310 CONTINUE + ELSE + NJFINL=N0JETS + DO 320 J=N0W+1,N0W+2 + IF(IABS(JTYPE(J)).LT.10) THEN + PJSET(5,J)=QMW + JDCAY(J)=-1 + ENDIF +320 CONTINUE +C Need fudge factor for DRELLYAN + DO 321 J=N0JETS,N0W + IF(IABS(JTYPE(J)).LT.10) THEN + PJSET(5,J)=EVOLMS(J,WFUDGE) + JDCAY(J)=-1 + ENDIF +321 CONTINUE + ENDIF +C +C Produce final-state QCD parton cascade +C + CALL QCDJET(NJFINL) +C +C Reset FRAME using W momentum modified by evolution + IF(.NOT.STDDY) THEN + BP=0. + DO 400 K=1,3 +400 BP=BP+FRAME(K,1)*PJSET(K,N0W) + BP=BP/FRAME(5,1) + DO 410 K=1,3 + FRAME(K,2)=PJSET(K,N0W)+FRAME(K,1)*PJSET(4,N0W)/FRAME(5,1) + $ +FRAME(K,1)*BP/(FRAME(4,1)+FRAME(5,1)) +410 CONTINUE + FRAME(4,2)=FRAME(4,1)*PJSET(4,N0W)/FRAME(5,1)+BP + ENDIF +C + RETURN + END diff --git a/ISAJET/code/evol05.F b/ISAJET/code/evol05.F new file mode 100644 index 00000000000..fa19e8e9265 --- /dev/null +++ b/ISAJET/code/evol05.F @@ -0,0 +1,59 @@ +#include "isajet/pilot.h" + SUBROUTINE EVOL05 +C---------------------------------------------------------------------- +C- +C- Purpose and Methods : +C- Setup for process 5 (SUPERSYM) +C- Lorentz frames and perform initial and final QCD jet +C- evolution in leading-log approximation. +C- +C- Created 13-AUG-1991 Frank E. Paige,Serban D. Protopopescu +C- +C---------------------------------------------------------------------- +#include "isajet/primar.inc" +#include "isajet/jetpar.inc" +#include "isajet/pjets.inc" +#include "isajet/jetset.inc" +#include "isajet/jwork.inc" +#include "isajet/jwork2.inc" +#include "isajet/frame.inc" + REAL EVOLMS + INTEGER I,K,J,NJSAVE,NJFINL,JTABS +C---------------------------------------------------------------------- +C +C Copy momenta from /PJETS/ to /JETSET/ + N0JETS=NJSET+1 + CALL IPJSET + NJSAVE=NJSET +C +C Set flags and maximum off-shell masses and generate +C initial QCD parton shower. +C + CALL ISTRAD(1.0) +C + IF(NJSET.LT.0) RETURN +C +C +C Final state evolution. +C Define Lorentz frames and JMATCH pointers for jet evolution +C and fragmentation. +C + CALL IFRAMS(N0JETS,NJSAVE,1,.FALSE.) +C +C Set maximum off-shell masses and JDCAY flags. +C + NJFINL=N0JETS + DO 325 J=N0JETS,NJSAVE + JTABS=IABS(JTYPE(J)) + IF(JTABS.GT.20.AND.JTABS.LT.30) THEN + PJSET(5,J)=EVOLMS(J,1.0) + JDCAY(J)=-1 + ENDIF +325 CONTINUE +C +C Produce final-state QCD parton cascade +C + CALL QCDJET(NJFINL) +C + RETURN + END diff --git a/ISAJET/code/evol06.F b/ISAJET/code/evol06.F new file mode 100644 index 00000000000..2798dc4ecbf --- /dev/null +++ b/ISAJET/code/evol06.F @@ -0,0 +1,96 @@ +#include "isajet/pilot.h" + SUBROUTINE EVOL06 +C---------------------------------------------------------------------- +C- +C- Purpose and Methods : +C- Setup for process 6 (WPAIR) +C- Lorentz frames and perform initial and final QCD jet +C- evolution in leading-log approximation. +C- +C- Created 13-AUG-1991 Frank E. Paige,Serban D. Protopopescu +C- +C---------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/primar.inc" +#include "isajet/jetpar.inc" +#include "isajet/pjets.inc" +#include "isajet/jetset.inc" +#include "isajet/jwork.inc" +#include "isajet/jwork2.inc" +#include "isajet/keys.inc" +#include "isajet/frame.inc" + REAL OFF,BP + INTEGER I,K,J,NJSAVE,NJFINL,JTRUE +C---------------------------------------------------------------------- +C +C Copy momenta from /PJETS/ to /JETSET/ + N0JETS=NJSET+1 + CALL IPJSET +C +C Add extra momenta for WPAIR + N0PAIR=NJSET+1 + DO 130 J=1,NPAIR + NJSET=NJSET+1 + JORIG(NJSET)=JPACK*JPAIR(J) + JTYPE(NJSET)=IDPAIR(J) + JDCAY(NJSET)=0 + DO 135 K=1,5 +135 PJSET(K,NJSET)=PPAIR(K,J) +130 CONTINUE + DO 140 J=1,NPAIR,2 + JET=JPAIR(J) + JTRUE=N0PAIR+J-1 + JDCAY(N0JETS+JET-1)=JTRUE*JPACK+JTRUE+1 +140 CONTINUE + NJSAVE=NJSET +C +C Set flags and maximum off-shell masses and generate +C initial QCD parton shower. +C + CALL ISTRAD(1.0) +C + IF(NJSET.LT.0) RETURN +C +C Final state evolution. +C Define Lorentz frames and JMATCH pointers for jet evolution +C and fragmentation. +C + DO 200 I=3,NJSAVE,2 + JMATCH(I)=I+1 +200 JMATCH(I+1)=I + DO 230 I=1,2 + DO 231 K=1,5 +231 FRAME(K,I)=PJSET(K,N0JETS+I-1) + IFRAME(I)=I +230 CONTINUE +C +C Set up and generate final state QCD parton shower. +C Boost PJSET with -FRAME. +C + DO 240 J=1,NJSAVE + JET=JORIG(J)/JPACK + IF(JET.EQ.0) JET=3 + IF(JET.GT.10) GO TO 240 + IF(IDJETS(JET).EQ.10) GO TO 240 +C Do this boost in double precision for 32-bit machines + CALL DBOOST(-1,FRAME(1,JET),PJSET(1,J)) +240 CONTINUE +C +C Set maximum off-shell masses and JDCAY flags. +C + NJFINL=N0PAIR + DO 330 J=1,NPAIR + IF(IABS(JTYPE(N0PAIR+J-1)).LT.10) THEN + PJSET(5,N0PAIR+J-1)=PJETS(5,JPAIR(J)) + JDCAY(N0PAIR+J-1)=-1 + ENDIF +330 CONTINUE +C +C Produce final-state QCD parton cascade +C + CALL QCDJET(NJFINL) +C + RETURN + END diff --git a/ISAJET/code/evol07.F b/ISAJET/code/evol07.F new file mode 100644 index 00000000000..a5ee0039c64 --- /dev/null +++ b/ISAJET/code/evol07.F @@ -0,0 +1,142 @@ +#include "isajet/pilot.h" + SUBROUTINE EVOL07 +C---------------------------------------------------------------------- +C- +C- Purpose and Methods : +C- Setup for process 7 (HIGGS) +C- Lorentz frames and perform initial and final QCD jet +C- evolution in leading-log approximation. +C- +C- Created 13-AUG-1991 Frank E. Paige,Serban D. Protopopescu +C- +C---------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/primar.inc" +#include "isajet/jetpar.inc" +#include "isajet/pjets.inc" +#include "isajet/pinits.inc" +#include "isajet/jetset.inc" +#include "isajet/jwork.inc" +#include "isajet/jwork2.inc" +#include "isajet/frame.inc" + REAL EVOLMS,BP + INTEGER I,K,J,NJSAVE,NJFINL,JTRUE + DOUBLE PRECISION DPASS(5),DSUM(5) + INTEGER IDABS1,IDABS2 +C---------------------------------------------------------------------- +C +C Copy momenta from /PJETS/ to /JETSET/ + N0JETS=NJSET+1 + CALL IPJSET +C +C Add extra momenta for WPAIR + IDABS1=IABS(IDJETS(1)) + IDABS2=IABS(IDJETS(2)) + IF(IDABS1.EQ.80.OR.IDABS1.EQ.90.OR.IDABS2.EQ.80.OR. + $IDABS2.EQ.90) THEN + N0PAIR=NJSET+1 + DO 130 J=1,NPAIR + NJSET=NJSET+1 + JORIG(NJSET)=JPACK*JPAIR(J) + JTYPE(NJSET)=IDPAIR(J) + JDCAY(NJSET)=0 + DO 135 K=1,5 +135 PJSET(K,NJSET)=PPAIR(K,J) +130 CONTINUE + DO 140 J=1,NPAIR,2 + JET=JPAIR(J) + JTRUE=N0PAIR+J-1 + JDCAY(N0JETS+JET-1)=JTRUE*JPACK+JTRUE+1 +140 CONTINUE + ENDIF + NJSAVE=NJSET +C +C Set flags and maximum off-shell masses and generate +C initial QCD parton shower. +C + IF(IABS(IDINIT(1)).LT.80) THEN + CALL ISTRAD(1.0) + IF(NJSET.LT.0) RETURN +C +C +C Special initial state evolution for W-W fusion. + ELSE + CALL HEVOLV + IF(NJSET.LT.0) RETURN + DO 141 J=1,NJSET +141 JMATCH(J)=0 + DO 142 JET=1,2 + J=NJSET+1-2*JET + PJSET(5,J)=-PJSET(5,JET) +142 JDCAY(J)=-2 + CALL QCDINI(NJSET-3,NJSET-1) + IF(NJSET.LT.0) RETURN + ENDIF +C +C +C Final state evolution. +C Define Lorentz frames and JMATCH pointers for jet evolution +C and fragmentation. +C + DO 200 I=3,NJSAVE,2 + JMATCH(I)=I+1 + JMATCH(I+1)=I +200 CONTINUE + IF(NPAIR.EQ.0) THEN + CALL DBLVEC(PJSET(1,N0JETS),DSUM) + CALL DBLVEC(PJSET(1,N0JETS+1),DPASS) + DO 231 K=1,4 +231 DSUM(K)=DSUM(K)+DPASS(K) + DSUM(5)=DSQRT(DSUM(4)**2-DSUM(1)**2-DSUM(2)**2-DSUM(3)**2) + DO 232 K=1,5 + FRAME(K,1)=DSUM(K) + FRAME(K,2)=FRAME(K,1) +232 CONTINUE + ELSE + DO 233 I=1,2 + DO 234 K=1,5 + FRAME(K,I)=PJSET(K,N0JETS+I-1) +234 CONTINUE + IFRAME(I)=I +233 CONTINUE + ENDIF +C +C Set up and generate final state QCD parton shower. +C Boost PJSET with -FRAME. +C + DO 240 J=1,NJSAVE + JET=JORIG(J)/JPACK + IF(JET.EQ.0) JET=3 + IF(JET.GT.10) GO TO 240 +C Do this boost in double precision for 32-bit machines + CALL DBOOST(-1,FRAME(1,JET),PJSET(1,J)) +240 CONTINUE +C +C Set maximum off-shell masses and JDCAY flags. +C + IF(NPAIR.EQ.0) THEN + NJFINL=N0JETS + DO 340 J=N0JETS,NJSAVE + IF(IABS(JTYPE(J)).LT.10) THEN + PJSET(5,J)=EVOLMS(J,1.0) + JDCAY(J)=-1 + ENDIF +340 CONTINUE + ELSE + NJFINL=N0PAIR + DO 341 J=1,NPAIR + IF(IABS(JTYPE(N0PAIR+J-1)).LT.10) THEN + PJSET(5,N0PAIR+J-1)=PJETS(5,JPAIR(J)) + JDCAY(N0PAIR+J-1)=-1 + ENDIF +341 CONTINUE + ENDIF +C +C Produce final-state QCD parton cascade +C + CALL QCDJET(NJFINL) +C + RETURN + END diff --git a/ISAJET/code/evol11.F b/ISAJET/code/evol11.F new file mode 100644 index 00000000000..b2cf3eaf8e1 --- /dev/null +++ b/ISAJET/code/evol11.F @@ -0,0 +1,74 @@ +#include "isajet/pilot.h" + SUBROUTINE EVOL11 +C---------------------------------------------------------------------- +C- +C- Purpose and Methods : +C- Setup for process 11 (EXTRADIM) +C- Lorentz frames and perform initial and final QCD jet +C- evolution in leading-log approximation. +C- +C---------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/primar.inc" +#include "isajet/jetpar.inc" +#include "isajet/pjets.inc" +#include "isajet/jetset.inc" +#include "isajet/jwork.inc" +#include "isajet/jwork2.inc" +#include "isajet/q1q2.inc" +#include "isajet/frame.inc" +#include "isajet/wcon.inc" +C + INTEGER K,NJFINL,J + REAL EVOLMS +C---------------------------------------------------------------------- +C +C Add recoil jet (jet 3) + NJSET=NJSET+1 + N0JETS=NJSET + JORIG(NJSET)=JPACK*3 + JTYPE(NJSET)=IDJETS(3) + JDCAY(NJSET)=0 + DO 105 K=1,5 +105 PJSET(K,NJSET)=PJETS(K,3) + IFRAME(3)=1 + +C Add W (=KKG) + NJSET=NJSET+1 + N0W=NJSET + JORIG(NJSET)=0 + JTYPE(NJSET)=IDENTW + JDCAY(NJSET)=0 + DO 120 K=1,5 +120 PJSET(K,NJSET)=QWJET(K) +C +C Set flags and maximum off-shell masses and generate +C initial QCD parton shower. +C + CALL ISTRAD(1.0) + IF(NJSET.LT.0) RETURN +C +C Final state evolution. +C Define Lorentz frames and JMATCH pointers for jet evolution +C and fragmentation. +C + CALL IFRAMS(N0JETS,N0W,1,.FALSE.) +C +C Set maximum off-shell masses and JDCAY flags. +C + NJFINL=N0JETS + DO 321 J=N0JETS,N0W + IF(IABS(JTYPE(J)).LT.10) THEN + PJSET(5,J)=EVOLMS(J,WFUDGE) + JDCAY(J)=-1 + ENDIF +321 CONTINUE +C +C Produce final-state QCD parton cascade +C + CALL QCDJET(NJFINL) +C + RETURN + END diff --git a/ISAJET/code/evolms.F b/ISAJET/code/evolms.F new file mode 100644 index 00000000000..1ee38988b58 --- /dev/null +++ b/ISAJET/code/evolms.F @@ -0,0 +1,33 @@ +#include "isajet/pilot.h" + FUNCTION EVOLMS(J,FUDGE) +C---------------------------------------------------------------------- +C- +C- Purpose and Methods : +C- Set evolution mass scale for parton J +C- +C- Returned value : maximum mass +C- +C- Inputs : +C- J = index to PJSET array +C- FUDGE= fudge factor +C- +C- Created 16-AUG-1991 Serban D. Protopopescu +C- +C---------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + REAL EVOLMS,FUDGE + INTEGER J +#include "isajet/limevl.inc" +#include "isajet/jetset.inc" +#include "isajet/jetpar.inc" +C---------------------------------------------------------------------- +C + IF ( USELIM ) THEN + EVOLMS=SQRT(PJSET(1,J)**2+PJSET(2,J)**2)*CONCUT + ELSE + EVOLMS=FUDGE*SQRT(QSQ) + ENDIF + 999 RETURN + END diff --git a/ISAJET/code/evolve.F b/ISAJET/code/evolve.F new file mode 100644 index 00000000000..b3585e7a7e0 --- /dev/null +++ b/ISAJET/code/evolve.F @@ -0,0 +1,102 @@ +#include "isajet/pilot.h" + SUBROUTINE EVOLVE +C---------------------------------------------------------------------- +C- +C- Purpose and Methods : +C- Call for each process a subroutine to set up +C- Lorentz frames and perform initial and final QCD jet +C- evolution in leading-log approximation. +C- +C- Created 13-AUG-1991 Frank E. Paige,Serban D. Protopopescu +C- +C---------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/primar.inc" +#include "isajet/jetpar.inc" +#include "isajet/pjets.inc" +#include "isajet/pinits.inc" +#include "isajet/jetset.inc" +#include "isajet/jwork.inc" +#include "isajet/jwork2.inc" +#include "isajet/keys.inc" +#include "isajet/frame.inc" + REAL BP,PINCOM + INTEGER I,K,J,JJET,IFR +C---------------------------------------------------------------------- +C Initialize + NJSET=0 + N0JETS=0 + N0W=0 + N0PAIR=0 +C +C Copy momenta from /PINITS/ to /JETSET/ + IF(.NOT.KEYS(2)) THEN + DO 100 I=1,2 + NJSET=NJSET+1 + JORIG(NJSET)=JPACK*(10+I) + JTYPE(NJSET)=IDINIT(I) + JDCAY(NJSET)=JPACK*I+I + DO 105 K=1,5 +105 PJSET(K,NJSET)=PINITS(K,I) +100 CONTINUE + ENDIF +C +C Handle each process separately +C + IF(KEYS(1).OR.KEYS(8)) THEN + CALL EVOL01 + ELSEIF(KEYS(2)) THEN + CALL EVOL02 + ELSEIF(KEYS(3)) THEN + CALL EVOL03 + ELSEIF(KEYS(5)) THEN + CALL EVOL05 + ELSEIF(KEYS(6).OR.KEYS(10)) THEN + CALL EVOL06 + ELSEIF(KEYS(7).OR.KEYS(9)) THEN + CALL EVOL07 + ELSEIF(KEYS(11)) THEN + CALL EVOL11 + ELSEIF(KEYS(12)) THEN + CALL EVOL01 + ENDIF +C + IF(NJSET.LT.0) RETURN +C +C Boost /JETSET/ partons back to PP COM +C + DO 500 J=1,NJSET + JJET=JORIG(J)/JPACK + IF ( JJET.EQ.0 ) THEN + IFR=1 + ELSE + IF(JJET.GT.10) GO TO 500 + IF(IDJETS(JJET).EQ.10.AND.KEYS(6)) GO TO 500 + IFR=IFRAME(JJET) + ENDIF + BP=0. + DO 505 K=1,3 +505 BP=BP+FRAME(K,IFR)*PJSET(K,J) + BP=BP/FRAME(5,IFR) + DO 510 K=1,3 +510 PJSET(K,J)=PJSET(K,J)+FRAME(K,IFR)*PJSET(4,J)/FRAME(5,IFR) + 1 +FRAME(K,IFR)*BP/(FRAME(4,IFR)+FRAME(5,IFR)) + PJSET(4,J)=FRAME(4,IFR)*PJSET(4,J)/FRAME(5,IFR)+BP +500 CONTINUE +C +C Reset PBEAM + DO 530 J=1,NJSET + IF(JDCAY(J).EQ.JPACK*J+J) THEN + JJET=JORIG(J)/JPACK-10 + PINCOM=.5*(PJSET(4,J)+ABS(PJSET(3,J))) + PBEAM(JJET)=HALFE-PINCOM + ENDIF +530 CONTINUE +C +C Check for zero energy partons + CALL IRMOV0 +C + RETURN + END diff --git a/ISAJET/code/fbrbm.F b/ISAJET/code/fbrbm.F new file mode 100644 index 00000000000..b50ee5dce9f --- /dev/null +++ b/ISAJET/code/fbrbm.F @@ -0,0 +1,16 @@ +#include "isajet/pilot.h" + REAL FUNCTION FBRBM(X) +C +C Integrand for convolution of +C bremsstrahlung with beamstrahlung spectra +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/brembm.inc" +C + REAL EBEAM,ESTRUC,X +C + FBRBM=EBEAM(X,EB)*ESTRUC(XMIN/X,QSQBM)/X + RETURN + END diff --git a/ISAJET/code/flavor.F b/ISAJET/code/flavor.F new file mode 100644 index 00000000000..159bb82abd7 --- /dev/null +++ b/ISAJET/code/flavor.F @@ -0,0 +1,204 @@ +#include "isajet/pilot.h" + SUBROUTINE FLAVOR(ID,IFL1,IFL2,IFL3,JSPIN,INDEX) +C +C This subroutine unpacks the IDENT code ID=+/-IJKL +C +C Mesons-- +C I=0, J<=K, +/- is sign for J +C ID=110 for PI0, ID=220 for ETA, etc. +C +C Baryons-- +C I<=J<=K in general +C J 1000 but K = 0 + IF(K.EQ.0.AND.JSPIN.EQ.0) GO TO 300 +C +C Baryons +C Only X,Y baryons are QQX, QQY, Q=U,D,S. +C + IF(I.GT.K.OR.J.GT.K.OR.J.EQ.0) GO TO 400 + IF(K.GT.6.AND.(I.GT.3.OR.J.GT.3)) GO TO 400 + IFL1=ISIGN(I,ID) + IFL2=ISIGN(J,ID) + IFL3=ISIGN(K,ID) + IF(K.LE.6) THEN + INDEX=MAX0(I-1,J-1)**2+I+MAX0(I-J,0)+(K-1)*K*(2*K-1)/6 + 1 +109*JSPIN+36*NMES+NQLEP+13 + ELSE + INDEX=MAX0(I-1,J-1)**2+I+MAX0(I-J,0)+9*(K-7)+91 + 1 +109*JSPIN+36*NMES+NQLEP+13 + ENDIF + RETURN +C +C Mesons +C +100 CONTINUE + IF(J.GT.K) GO TO 400 + IF(J.EQ.K.AND.ID.LT.0) GO TO 400 + IFL1=0 + IFL2=ISIGN(J,ID) + IFL3=ISIGN(K,-ID) + INDEX=J+K*(K-1)/2+36*JSPIN+NQLEP + INDEX=INDEX+13 + RETURN +C +C Quarks, leptons, etc +C +200 CONTINUE + IFL1=0 + IFL2=0 + IFL3=0 + JSPIN=0 + INDEX=IDABS + IF(IDABS.LT.20) RETURN +C Define INDEX=20 for KS, INDEX=21 for KL + INDEX=IDABS+1 + IF(ID.EQ.20) INDEX=20 +C INDEX=NQLEP+1,...,NQLEP+13 for W+, Higgs, Z0, GVSS, GRAV + IF(IDABS.LT.80) RETURN + INDEX=NQLEP+IDABS-79 + RETURN +C +C Diquarks +C +300 IF(JSPIN.GT.0.OR.I.GT.J) GO TO 400 + IF(I.GT.6.OR.J.GT.6) GO TO 400 + IFL1=ISIGN(I,ID) + IFL2=ISIGN(J,ID) + IFL3=0 + JSPIN=0 + INDEX=109*NBARY+36*NMES+NQLEP+13+I+J*(J-1)/2 + RETURN +C +C Error +C +400 CONTINUE + IFL1=0 + IFL2=0 + IFL3=0 + JSPIN=0 + INDEX=0 + RETURN +C +C Special mesons - used only for B decays +C +500 INDXSP=400 + IF(IDABS.EQ.10121) THEN + INDEX=INDXSP+1 + ELSEIF(IDABS.EQ.10111) THEN + INDEX=INDXSP+2 + ELSEIF(IDABS.EQ.10131) THEN + INDEX=INDXSP+3 + ELSEIF(IDABS.EQ.10231) THEN + INDEX=INDXSP+4 + ELSEIF(IDABS.EQ.30131) THEN + INDEX=INDXSP+5 + ELSEIF(IDABS.EQ.30231) THEN + INDEX=INDXSP+6 + ELSEIF(IDABS.EQ.132) THEN + INDEX=INDXSP+7 + ELSEIF(IDABS.EQ.232) THEN + INDEX=INDXSP+8 + ELSEIF(IDABS.EQ.10110) THEN + INDEX=INDXSP+9 + ELSEIF(IDABS.EQ.112) THEN + INDEX=INDXSP+10 + ELSEIF(IDABS.EQ.10441) THEN + INDEX=INDXSP+11 + ELSEIF(IDABS.EQ.20440) THEN + INDEX=INDXSP+12 + ELSEIF(IDABS.EQ.20441) THEN + INDEX=INDXSP+13 + ELSEIF(IDABS.EQ.20442) THEN + INDEX=INDXSP+14 + ELSE + INDEX=0 + ENDIF + IF(INDEX.GT.0) THEN + IFL1=0 + IFL2=ISIGN(J,ID) + IFL3=ISIGN(K,-ID) + ELSE + IFL1=0 + IFL2=0 + IFL3=0 + ENDIF +C + RETURN + END diff --git a/ISAJET/code/fortop.F b/ISAJET/code/fortop.F new file mode 100644 index 00000000000..091f9fdaf27 --- /dev/null +++ b/ISAJET/code/fortop.F @@ -0,0 +1,21 @@ +#include "isajet/pilot.h" + SUBROUTINE FORTOP +C---------------------------------------------------------------------- +C- +C- Purpose and Methods : +C- add to force list forced decays for all heavy q particles +C- if there was a request to force a heavy q decay +C- Zero IFORCE after use +C- +C- Created 15-DEC-1989 Serban D. Protopopescu +C- +C Ver 7.30: Decay top quark rather than hadron, so no longer needed. +C---------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/force.inc" +C---------------------------------------------------------------------- + RETURN + END diff --git a/ISAJET/code/frgjet.F b/ISAJET/code/frgjet.F new file mode 100644 index 00000000000..66ca68235e8 --- /dev/null +++ b/ISAJET/code/frgjet.F @@ -0,0 +1,147 @@ +#include "isajet/pilot.h" + SUBROUTINE FRGJET(JET) +C +C Hadronize all partons in /JETSET/ corresponding to jet JET. +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/primar.inc" +#include "isajet/jetpar.inc" +#include "isajet/pjets.inc" +#include "isajet/pinits.inc" +#include "isajet/partcl.inc" +#include "isajet/const.inc" +#include "isajet/jetset.inc" +#include "isajet/jwork.inc" +#include "isajet/keys.inc" +#include "isajet/q1q2.inc" +#include "isajet/frame.inc" +C + REAL ROT(3,3),POLD(5),PNEW(5),PSUM(5) + REAL CPHI,SPHI,AMSUM,ESUM,PJ,CTHJ,STHJ,PTJ + INTEGER K,K1,K2,IP,NPLV1,IFAIL,NBEGIN,JET,NFRAG,NFRGMX,JETJ, + $JTABS,NFIRST,J +C + DATA PSUM/5*0./ +C +C NFRAG counter protects against possible infinite loop. +C + NFRAG=0 + NFRGMX=10*MXJSET +201 NBEGIN=NPTCL+1 + NFRAG=NFRAG+1 +C +C Loop over partons +C + ESUM=0. + DO 220 J=1,NJSET + IF(JDCAY(J).NE.0) GO TO 220 + JETJ=JORIG(J)/JPACK + IF(JETJ.NE.JET) GO TO 220 + ESUM=ESUM+PJSET(4,J) +C +C Generate Field-Feynman jet for each quark or gluon, or... +C + JTABS = IABS(JTYPE(J)) + IF(JTABS.LT.10) THEN + NFIRST=NPTCL+1 + CALL JETGEN(J) + IF(NPTCL.LT.NFIRST) GO TO 220 +C +C Rotate hadrons to parton direction +C + PTJ=PJSET(1,J)**2+PJSET(2,J)**2 + PJ=SQRT(PTJ+PJSET(3,J)**2) + PTJ=SQRT(PTJ) +C Following is to fix occasional bug on 32-bit machines + IF(PJ.GT.0.) THEN + CTHJ=PJSET(3,J)/PJ + STHJ=PTJ/PJ + ELSE + CTHJ=1. + STHJ=0. + ENDIF + IF(PTJ.GT.0.) THEN + CPHI=PJSET(1,J)/PTJ + SPHI=PJSET(2,J)/PTJ + ELSE + CPHI=SIGN(1.,PJSET(3,J)) + SPHI=0. + ENDIF + ROT(1,1)=CPHI*CTHJ + ROT(2,1)=SPHI*CTHJ + ROT(3,1)=-STHJ + ROT(1,2)=-SPHI + ROT(2,2)=CPHI + ROT(3,2)=0. + ROT(1,3)=CPHI*STHJ + ROT(2,3)=SPHI*STHJ + ROT(3,3)=CTHJ + DO 230 IP=NFIRST,NPTCL + DO 235 K=1,3 + POLD(K)=PPTCL(K,IP) + PPTCL(K,IP)=0 +235 CONTINUE + DO 240 K1=1,3 + DO 240 K2=1,3 +240 PPTCL(K1,IP)=PPTCL(K1,IP)+ROT(K1,K2)*POLD(K2) +230 CONTINUE +C +C ... hadronize all other partons with delta function. +C + ELSE + IF((IABS(JTYPE(J)).EQ.80.OR.IABS(JTYPE(J)).EQ.90).AND. + $ .NOT.KEYS(2).AND..NOT.KEYS(12)) GO TO 210 + IF(NPTCL.GE.MXPTCL) GO TO 9999 + NPTCL=NPTCL+1 + DO 255 K=1,5 + PPTCL(K,NPTCL)=PJSET(K,J) +255 CONTINUE + IORIG(NPTCL)=-J + IDENT(NPTCL)=JTYPE(J) + IDCAY(NPTCL)=0 + ENDIF +220 CONTINUE +C +C Sum masses and insert jet label +C + AMSUM=0. + DO 260 IP=NBEGIN,NPTCL + AMSUM=AMSUM+PPTCL(5,IP) + IORIG(IP)=ISIGN(IABS(IORIG(IP))+IPACK*JET,IORIG(IP)) +260 CONTINUE +C +C Require sum of masses less than jet energy. +C + IF(AMSUM.GT.ESUM.AND.NBEGIN.NE.NPTCL.AND.NFRAG.LT.NFRGMX) THEN + NPTCL=NBEGIN-1 + GO TO 201 + ENDIF +C +C For WPAIR events rescale jet to W mass. +C + IF((KEYS(6).OR.KEYS(7).OR.KEYS(9).OR.KEYS(10)).AND.JET.LT.10) + $ THEN + IF(IABS(JTYPE(JET+N0JETS-1)).LT.80) RETURN + IF(AMSUM.GE.PJSET(5,JET+N0JETS-1)) THEN + IF(NFRAG.GT.NFRGMX) RETURN + NPTCL=NBEGIN-1 + GO TO 201 + ENDIF + PSUM(4)=PJSET(5,JET+N0JETS-1) + PSUM(5)=PSUM(4) + NPLV1=NPTCL + CALL RESCAL(NBEGIN,NPLV1,PSUM,IFAIL) + ENDIF +C +210 RETURN +C +C Error +C +9999 CALL PRTEVT(0) + WRITE(ITLIS,9998) NPTCL +9998 FORMAT(//' ERROR IN FRGJET ... NPTCL > ',I6) + RETURN + END diff --git a/ISAJET/code/frgmnt.F b/ISAJET/code/frgmnt.F new file mode 100644 index 00000000000..e6483e8ff48 --- /dev/null +++ b/ISAJET/code/frgmnt.F @@ -0,0 +1,344 @@ +#include "isajet/pilot.h" + SUBROUTINE FRGMNT +C +C Control jet fragmentation. Boost to frames defined in +C EVOLVE and call JETGEN. +C +C EVOLVE initializes /PJSET/ as follows-- +C 1 - 2 = PINITS (except for E+E-) +C N0W - N0W = QWJET (for DRELLYAN, NJET=3) +C N0JETS - N0JETS+NJET = PJETS +C N0PAIR - N0PAIR+NPAIR = PPAIR (for WPAIR) +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/primar.inc" +#include "isajet/jetpar.inc" +#include "isajet/pjets.inc" +#include "isajet/pinits.inc" +#include "isajet/partcl.inc" +#include "isajet/const.inc" +#include "isajet/jetset.inc" +#include "isajet/jwork.inc" +#include "isajet/keys.inc" +#include "isajet/q1q2.inc" +#include "isajet/frame.inc" +C + REAL PSUM(5),PALLJ(5),P12(5),PIN(5,2),PWREST(5),PADD(5) + REAL POLD(5),PNEW(5) + REAL PINPL,PINMN,BP,PT2AVE,PTADD,RANF,PHIADD,PALLPL,PALLMN + REAL PALLX,PALLY + INTEGER K,J,JJET,NZERO,IB,NPTCL1,NPTCL2,IFAIL,JET,NPJET1,NPLV1 + INTEGER NPJET3,IP,NP1,NP2,NFIRST,IP1,IFR,NLJ + DOUBLE PRECISION DSUM(5),DPASS(5) +C +C Initialize + DO 100 K=1,5 +100 DSUM(K)=0. + NLJ=NJET + IF(KEYS(3)) NLJ=NJET+1 + DO 101 J=1,NLJ + JJET=N0JETS+J-1 + IF(JJET.EQ.N0W) GOTO 101 + CALL DBLVEC(PJSET(1,JJET),DPASS) + DO 102 K=1,4 +102 DSUM(K)=DSUM(K)+DPASS(K) +101 CONTINUE + DSUM(5)=DSQRT(DSUM(4)**2-DSUM(1)**2-DSUM(2)**2-DSUM(3)**2) + DO 103 K=1,5 +103 PALLJ(K)=DSUM(K) +C + NZERO=NPTCL+1 +C +C Fragment partons from initial state shower +C + IF(.NOT.KEYS(2)) THEN + DO 110 J=1,NJSET + IF(JDCAY(J).EQ.JPACK*J+J) THEN + IB=JORIG(J)/JPACK-10 + DO 120 K=1,5 +120 PIN(K,IB)=PJSET(K,J) + ENDIF +110 CONTINUE +C + CALL FRGJET(11) + CALL FRGJET(12) +C + NPTCL1=NPTCL+1 + NPTCL2=NPTCL1+1 + IF(NPTCL1.GT.MXPTCL) GO TO 9999 + PINPL=.5*(PIN(4,1)+PIN(3,1)+PIN(4,2)+PIN(3,2)) + PINMN=.5*(PIN(4,1)-PIN(3,1)+PIN(4,2)-PIN(3,2)) + PPTCL(1,NPTCL1)=0. + PPTCL(2,NPTCL1)=0. + PPTCL(3,NPTCL1)=HALFE-PINPL + PPTCL(4,NPTCL1)=HALFE-PINPL + PPTCL(5,NPTCL1)=0. + PPTCL(1,NPTCL2)=0. + PPTCL(2,NPTCL2)=0. + PPTCL(3,NPTCL2)=-(HALFE-PINMN) + PPTCL(4,NPTCL2)=HALFE-PINMN + PPTCL(5,NPTCL2)=0. + DO 130 K=1,4 +130 PSUM(K)=-PALLJ(K) + PSUM(4)=PSUM(4)+ECM + PSUM(5)=PSUM(4)**2-PSUM(1)**2-PSUM(2)**2-PSUM(3)**2 + IF(PSUM(5).GE.0.) THEN + PSUM(5)=SQRT(PSUM(5)) + CALL RESCAL(NZERO,NPTCL2,PSUM,IFAIL) + ENDIF +C + DO 140 K=1,4 +140 PBEAMS(K)=PPTCL(K,NPTCL1)+PPTCL(K,NPTCL2) + PBEAMS(5)=SQRT(PBEAMS(4)**2-PBEAMS(1)**2-PBEAMS(2)**2 + $ -PBEAMS(3)**2) + ENDIF +C +C Boost partons from final jets with -FRAME +C +200 DO 210 J=1,NJSET + JET=JORIG(J)/JPACK + IF ( JET.EQ.0 ) THEN + IFR=1 + ELSE + IF(JET.GT.10) GO TO 210 + IF(KEYS(6)) THEN + IF(IDJETS(JET).EQ.10) GO TO 210 + ENDIF + IFR=IFRAME(JET) + ENDIF +C +C Do this boost in double precision for 32-bit machines + CALL DBOOST(-1,FRAME(1,IFR),PJSET(1,J)) +210 CONTINUE +C +C Fragment partons from final jets +C + NPJET1=NPTCL+1 + DO 220 K=1,4 +220 PSUM(K)=0 +C +C Conserve mass of 1+2 for DRELLYAN (automatic for WPAIR) +C + IF(KEYS(3)) THEN + CALL FRGJET(1) + CALL FRGJET(2) + IF(STDDY) THEN + DO 230 K=1,4 + PSUM(K)=PJSET(K,3)+PJSET(K,4) + 230 CONTINUE + ELSE + DO 240 K=1,4 + PSUM(K)=PJSET(K,N0W+1)+PJSET(K,N0W+2) + 240 CONTINUE + ENDIF + PSUM(5)=SQRT(PSUM(4)**2-PSUM(1)**2-PSUM(2)**2-PSUM(3)**2) + NPLV1=NPTCL + CALL RESCAL(NPJET1,NPLV1,PSUM,IFAIL) +C EXTRADIM has only jet3 + graviton + ELSEIF(KEYS(11)) THEN + CALL FRGJET(3) + CALL FRGJET(0) + NPLV1=NPTCL + DO 241 K=1,4 + PSUM(K)=PJSET(K,3)+PJSET(K,4) +241 CONTINUE + PSUM(5)=SQRT(PSUM(4)**2-PSUM(1)**2-PSUM(2)**2-PSUM(3)**2) + CALL RESCAL (NPJET1,NPLV1,PSUM,IFAIL) + ELSE +C All other processes + DO 242 J=1,NJET + JJET=N0JETS+J-1 + CALL FRGJET(J) + DO 243 K=1,4 + 243 PSUM(K)=PSUM(K)+PJSET(K,JJET) + 242 CONTINUE + PSUM(5)=SQRT(PSUM(4)**2-PSUM(1)**2-PSUM(2)**2-PSUM(3)**2) + NPLV1=NPTCL + CALL RESCAL(NPJET1,NPLV1,PSUM,IFAIL) + ENDIF +C +C Add extra jets for DRELLYAN + IF(KEYS(3).AND..NOT.STDDY) THEN + NPJET3=NPTCL+1 + DO 245 J=3,NJET +245 CALL FRGJET(J) + NPTCL1=NPTCL+1 + IF(NPTCL1.GT.MXPTCL) GO TO 9999 + DO 250 K=1,4 + PPTCL(K,NPTCL1)=PJSET(K,N0W) +250 PSUM(K)=PJSET(K,N0W) + PPTCL(5,NPTCL1)=PJSET(5,N0W) + DO 246 J=3,NJET + JJET=N0JETS+J-3 + DO 246 K=1,4 + PSUM(K)=PSUM(K)+PJSET(K,JJET) + 246 CONTINUE + PSUM(5)=SQRT(PSUM(4)**2-PSUM(1)**2-PSUM(2)**2-PSUM(3)**2) + CALL RESCAL(NPJET3,NPTCL1,PSUM,IFAIL) + DO 260 K=1,5 +260 PWREST(K)=PPTCL(K,NPTCL1) + ENDIF +C +C Boost partons back to PP COM +C + DO 300 J=1,NJSET + JET=JORIG(J)/JPACK + IF ( JET.EQ.0 ) THEN + IFR=1 + ELSE + IF(JET.GT.10) GO TO 300 + IF(KEYS(6)) THEN + IF(IDJETS(JET).EQ.10) GO TO 300 + ENDIF + IFR=IFRAME(JET) + ENDIF + BP=0. + DO 305 K=1,3 +305 BP=BP+FRAME(K,IFR)*PJSET(K,J) + BP=BP/FRAME(5,IFR) + DO 310 K=1,3 +310 PJSET(K,J)=PJSET(K,J)+FRAME(K,IFR)*PJSET(4,J)/FRAME(5,IFR) + $ +FRAME(K,IFR)*BP/(FRAME(4,IFR)+FRAME(5,IFR)) + PJSET(4,J)=FRAME(4,IFR)*PJSET(4,J)/FRAME(5,IFR)+BP +300 CONTINUE +C +C Reset FRAME to boost hadrons to PP COM +C + IF(KEYS(1).OR.KEYS(2).OR.(KEYS(3).AND.NJET.EQ.2).OR.KEYS(5) + $.OR.(KEYS(7).AND.NPAIR.EQ.0).OR.KEYS(8)) THEN + DO 410 K=1,5 + FRAME(K,1)=PALLJ(K) +410 CONTINUE + ELSEIF(KEYS(3).AND.NJET.GT.2) THEN + DO 420 K=1,5 +420 FRAME(K,1)=PALLJ(K) + BP=0. + DO 430 K=1,3 +430 BP=BP+FRAME(K,1)*PWREST(K) + BP=BP/FRAME(5,1) + DO 440 K=1,3 + FRAME(K,2)=PWREST(K)+FRAME(K,1)*PWREST(4)/FRAME(5,1) + $ +FRAME(K,1)*BP/(FRAME(4,1)+FRAME(5,1)) +440 CONTINUE + FRAME(4,2)=FRAME(4,1)*PWREST(4)/FRAME(5,1)+BP + ENDIF +C +C Boost hadrons back to PP COM +C + DO 500 IP=NZERO,NPTCL + JET=IABS(IORIG(IP))/IPACK + IF(JET.GT.10) GO TO 500 + IF(KEYS(6)) THEN + IF(IDJETS(JET).EQ.10) GO TO 500 + ENDIF + IF(JET.EQ.0) THEN + IFR=1 + ELSE + IFR=IFRAME(JET) + ENDIF + BP=0. + DO 510 K=1,3 +510 BP=BP+FRAME(K,IFR)*PPTCL(K,IP) + BP=BP/FRAME(5,IFR) + DO 520 K=1,3 +520 PPTCL(K,IP)=PPTCL(K,IP)+FRAME(K,IFR)*PPTCL(4,IP)/FRAME(5,IFR) + $ +FRAME(K,IFR)*BP/(FRAME(4,IFR)+FRAME(5,IFR)) + PPTCL(4,IP)=FRAME(4,IFR)*PPTCL(4,IP)/FRAME(5,IFR)+BP +500 CONTINUE +C +C Add intrinsic PT +C + IF(.NOT.KEYS(2)) THEN + PT2AVE=.1*SQRT(QSQ) + PTADD=SQRT(-PT2AVE*ALOG(RANF())) + PHIADD=2.*PI*RANF() + PADD(1)=2.*PTADD*COS(PHIADD) + PADD(2)=2.*PTADD*SIN(PHIADD) +C Must use large and small components carefully to calculate +C mass on 32-bit machines. + PALLPL=0. + PALLMN=0. + PALLX=0. + PALLY=0. + DO 525 IP=NZERO,NPTCL + PALLX=PALLX+PPTCL(1,IP) + PALLY=PALLY+PPTCL(2,IP) + IF(PPTCL(3,IP).GT.0.) THEN + PALLPL=PALLPL+(PPTCL(4,IP)+PPTCL(3,IP)) + PALLMN=PALLMN+(PPTCL(1,IP)**2+PPTCL(2,IP)**2+PPTCL(5,IP)**2) + $ /(PPTCL(4,IP)+PPTCL(3,IP)) + ELSE + PALLMN=PALLMN+(PPTCL(4,IP)-PPTCL(3,IP)) + PALLPL=PALLPL+(PPTCL(1,IP)**2+PPTCL(2,IP)**2+PPTCL(5,IP)**2) + $ /(PPTCL(4,IP)-PPTCL(3,IP)) + ENDIF +525 CONTINUE + POLD(1)=PALLX + POLD(2)=PALLY + POLD(3)=.5*(PALLPL-PALLMN) + POLD(4)=.5*(PALLPL+PALLMN) + POLD(5)=SQRT(PALLPL*PALLMN-PALLX**2-PALLY**2) + PNEW(1)=PADD(1)+POLD(1) + PNEW(2)=PADD(2)+POLD(2) + PNEW(3)=POLD(3) + PNEW(4)=SQRT(PNEW(1)**2+PNEW(2)**2+PNEW(3)**2+POLD(5)**2) + PNEW(5)=POLD(5) +C + DO 530 IP=NZERO,NPTCL + BP=0. + DO 531 K=1,3 +531 BP=BP+POLD(K)*PPTCL(K,IP) + BP=BP/POLD(5) + DO 532 K=1,3 +532 PPTCL(K,IP)=PPTCL(K,IP)-POLD(K)*PPTCL(4,IP)/POLD(5) + $ +POLD(K)*BP/(POLD(4)+POLD(5)) + PPTCL(4,IP)=PPTCL(4,IP)*POLD(4)/POLD(5)-BP +C + BP=0. + DO 533 K=1,3 +533 BP=BP+PNEW(K)*PPTCL(K,IP) + BP=BP/PNEW(5) + DO 534 K=1,3 +534 PPTCL(K,IP)=PPTCL(K,IP)+PNEW(K)*PPTCL(4,IP)/PNEW(5) + $ +PNEW(K)*BP/(PNEW(4)+PNEW(5)) + PPTCL(4,IP)=PPTCL(4,IP)*PNEW(4)/PNEW(5)+BP +530 CONTINUE +C +C Add opposite PT to beam jets + DO 541 K=1,4 +541 PBEAMS(K)=-PNEW(K) + PBEAMS(4)=PBEAMS(4)+ECM + PBEAMS(5)=PBEAMS(4)**2-PBEAMS(1)**2-PBEAMS(2)**2 -PBEAMS(3)**2 + IF ( PBEAMS(5).GT.0 ) THEN + PBEAMS(5)=SQRT(PBEAMS(5)) + ELSE + PBEAMS(4)=SQRT(PBEAMS(4)**2-PBEAMS(5)+4.) + PBEAMS(5)=2. + ENDIF + ENDIF +C +C Decay hadrons +C + NP1=NZERO +600 NP2=NPTCL + DO 610 IP=NP1,NP2 + NFIRST=NPTCL+1 + JET=IABS(IORIG(IP))/IPACK + CALL DECAY(IP) + DO 620 IP1=NFIRST,NPTCL +620 IORIG(IP1)=ISIGN(IABS(IORIG(IP1))+IPACK*JET,IORIG(IP1)) +610 CONTINUE + NP1=NP2+1 + IF(NP1.LE.NPTCL) GO TO 600 + RETURN +C +C Error +C +9999 CALL PRTEVT(0) + WRITE(ITLIS,9998) NPTCL +9998 FORMAT(//' ERROR IN FRGMNT ... NPTCL > ',I6) + RETURN + END diff --git a/ISAJET/code/gamma.F b/ISAJET/code/gamma.F new file mode 100644 index 00000000000..82c089baae1 --- /dev/null +++ b/ISAJET/code/gamma.F @@ -0,0 +1,33 @@ +#include "isajet/pilot.h" + FUNCTION GAMMA(X) +#include "isajet/itapes.inc" + DIMENSION C(13) + DATA C + 1/ 0.00053 96989 58808, 0.00261 93072 82746, 0.02044 96308 23590, + 2 0.07309 48364 14370, 0.27964 36915 78538, 0.55338 76923 85769, + 3 0.99999 99999 99998,-0.00083 27247 08684, 0.00469 86580 79622, + 4 0.02252 38347 47260,-0.17044 79328 74746,-0.05681 03350 86194, + 5 1.13060 33572 86556/ + Z=X + IF(X .GT. 0.0) GO TO 1 + IF(X .EQ. AINT(X)) GO TO 5 + Z=1.0-Z + 1 F=1.0/Z + IF(Z .LE. 1.0) GO TO 4 + F=1.0 + 2 IF(Z .LT. 2.0) GO TO 3 + Z=Z-1.0 + F=F*Z + GO TO 2 + 3 Z=Z-1.0 + 4 GAMMA= + 1 F*((((((C(1)*Z+C(2))*Z+C(3))*Z+C(4))*Z+C(5))*Z+C(6))*Z+C(7))/ + 2 ((((((C(8)*Z+C(9))*Z+C(10))*Z+C(11))*Z+C(12))*Z+C(13))*Z+1.0) + IF(X .GT. 0.0) RETURN + GAMMA=3.141592653589793/(SIN(3.141592653589793*X)*GAMMA) + RETURN + 5 GAMMA=0. + WRITE(ITLIS,10) X + RETURN + 10 FORMAT(1X,'GAMMA ... ARGUMENT IS NON-POSITIVE INTEGER = ',E20.5) + END diff --git a/ISAJET/code/getpt.F b/ISAJET/code/getpt.F new file mode 100644 index 00000000000..8eabe5b8d44 --- /dev/null +++ b/ISAJET/code/getpt.F @@ -0,0 +1,13 @@ +#include "isajet/pilot.h" + SUBROUTINE GETPT(PT0,PTMEAN) +C GENERATE PT WITH 1/(1+B*PT**2)**4 DISTRIBUTION +C (APPROXIMATELY AN EXPONENTIAL FOR PT < 2 GEV.) +C CON1=16/(3*PI) +C CON2=-1/3 +#include "isajet/itapes.inc" + DATA CON1/1.697652726/,CON2/-.3333333333/ + R=RANF() + ARG=AMAX1(R**CON2-1.,0.) + PT0=PTMEAN*CON1*SQRT(ARG) + RETURN + END diff --git a/ISAJET/code/gettot.F b/ISAJET/code/gettot.F new file mode 100644 index 00000000000..b653c887ff1 --- /dev/null +++ b/ISAJET/code/gettot.F @@ -0,0 +1,140 @@ +#include "isajet/pilot.h" + SUBROUTINE GETTOT(PRFLAG) +C +C Calculate total cross section within jet limits. +C If PRFLAG=.TRUE. print summary. +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/final.inc" +#include "isajet/times.inc" +#include "isajet/totals.inc" +#include "isajet/keys.inc" +#include "isajet/q1q2.inc" +#include "isajet/const.inc" +#include "isajet/jetlim.inc" +#include "isajet/dylim.inc" +#include "isajet/types.inc" +#include "isajet/idrun.inc" +#include "isajet/seed.inc" +#include "isajet/primar.inc" +#include "isajet/isloop.inc" +#include "isajet/mgsigs.inc" +C + REAL DELPHI,SIGF2,FRAC,TMEAN,ALUM2,SIGF3 + LOGICAL PRFLAG + INTEGER I,II,KK + REAL TMP + LOGICAL MGFLAG +C +C Calculate jet cross sections +C + SIGF=0. + ALUM=0. + ACCEPT=0. + NKINF=NKINPT +C For 2-body processes we can use the totals. +C For MadGraph we must sum the partial cross sections. + MGFLAG=KEYS(12) + IF(NKINPT.GT.0.AND..NOT.MGFLAG) THEN + SIGF=SUMWT/NKINPT + DELPHI=2.*PI + IF(KEYS(1).OR.KEYS(2).OR.KEYS(5).OR.KEYS(6).OR.KEYS(8) + $ .OR.KEYS(9)) THEN + DELPHI=PHIMAX(1)-PHIMIN(1) + ELSEIF(KEYS(3).AND..NOT.STDDY) THEN + DELPHI=PHWMAX-PHWMIN + ENDIF + SIGF=SIGF*DELPHI/(2.*PI) + ELSEIF(MGFLAG) THEN + DO 10 I=1,NSIG8 + SIGF=SIGF+WTSUM8(I)/NWT8(I) +10 CONTINUE + ENDIF +C +C Print summary if desired +C + IF(.NOT.PRFLAG) RETURN +C +C Print header and title + WRITE(ITLIS,100) +100 FORMAT('1',30('*')/' *',28X,'*'/ + 1' *',5X,'ISAJET RUN SUMMARY',5X,'*'/ + 2' *',28X,'*'/1X,30('*')//) + WRITE(ITLIS,101) TITLE +101 FORMAT(//11X,10A8) + IF(NKINPT.EQ.0) GO TO 300 +C +C Print cross section + WRITE(ITLIS,102) NKINPT +102 FORMAT(//' NO. KINEMATIC POINTS GENERATED =',I13) + SIGF2=SIGF*NEVOLV*NFRGMN + WRITE(ITLIS,103) SIGF2 +103 FORMAT(//' MONTE CARLO JET CROSS SECTION =',E13.4,' MB') + IF(SIGF.EQ.0.) WRITE(ITLIS,111) +111 FORMAT(' CROSS SECTION IS ZERO IF VARIABLES ARE FIXED') +C +C Print W decay acceptance + IF(KEYS(3)) THEN + ACCEPT=FLOAT(NKEEP)/FLOAT(NWGEN) + WRITE(ITLIS,105) ACCEPT +105 FORMAT(//' ACCEPTANCE FOR W DECAYS =',E13.4) + ELSEIF(KEYS(7)) THEN + ACCEPT=FLOAT(NKEEP)/FLOAT(NWGEN) + WRITE(ITLIS,106) ACCEPT +106 FORMAT(//' ACCEPTANCE FOR H DECAYS =',E13.4) + ENDIF +C +C Print luminosity + IF(SIGF.GT.0.) THEN + ALUM=NEVENT/SIGF + IF(KEYS(4)) ALUM=NKINPT/SIGF + WRITE(ITLIS,104) ALUM +104 FORMAT(//' EQUIVALENT INTEGRAL LUMINOSITY =',E13.4, + $ ' /MB') + ENDIF +C +C Print final multijet cross sections + IF(KEYS(12)) THEN + WRITE(ITLIS,9001) +9001 FORMAT(//6X,'FINAL MULTIJET CROSS SECTIONS'/ + $ 6X,'PROCESS',18X,'SIGMA',10X,'MAX(SIGMA)') + DO 992 I=1,NSIG8 + II=ISORT8(I) + TMP=WTSUM8(II)/NWT8(II) + WRITE(ITLIS,9002) (IDENT8(KK,II),KK=1,5),TMP,WTMAX8(II) +9002 FORMAT(2X,5I5,2E15.5) +992 CONTINUE + WRITE(ITLIS,*) + ENDIF +C +C Print statistics for multiple evolution and fragmentation + IF(NEVOLV.GT.1.OR.NFRGMN.GT.1) THEN + FRAC=FLOAT(IEVGEN)/FLOAT(IEVT) + WRITE(ITLIS,201) IEVGEN +201 FORMAT(//' NUMBER OF ACCEPTED EVENTS =',I13) + WRITE(ITLIS,202) FRAC +202 FORMAT(' FRACTION OF ACCEPTED EVENTS =',E13.4) + SIGF3=SIGF2*FRAC + WRITE(ITLIS,203) SIGF3 +203 FORMAT(' CROSS SECTION FOR ACCEPTED EVENTS =',E13.4) + ENDIF +C +C Print mean time per event +300 TMEAN=(TIME2-TIME1)/NEVENT + WRITE(ITLIS,301) TMEAN +301 FORMAT(//' MEAN TIME PER GENERATED EVENT =',E13.4, + $' SEC') +C +C Print final seed + CALL RANFMT + WRITE(ITLIS,302) XSEED +302 FORMAT(//' FINAL RANDOM NUMBER SEED =',A24) +C +C Print run identifier + WRITE(ITLIS,303) IDG +303 FORMAT(//' END OF ISAJET RUN =',2I9.6) + RETURN + END diff --git a/ISAJET/code/heavyx.F b/ISAJET/code/heavyx.F new file mode 100644 index 00000000000..ba15e1d5dc9 --- /dev/null +++ b/ISAJET/code/heavyx.F @@ -0,0 +1,46 @@ +#include "isajet/pilot.h" + SUBROUTINE HEAVYX(X,EPS) +C +C GENERATE X FOR HEAVY PARTICLE FRAGMENTATION ACCORDING TO +C THE PETERSON FORM +C D(X)=1/(X*(1-1/X-EPS/(1-X))**2) +C =D0(X)*D1(X)*D2(X) +C D0(X)=(1-X)**2/((1-X)**2+EPS)**2 +C D1(X)=X +C D2(X)=(((1-X)**2+EPS)/((1-X)**2+EPS*X))**2 +C USING X=1-Y**POW +C + DATA ALN4/1.3863/ +C +C CHOOSE POW FOR X=1-Y**POW. +C GENERATE FLAT IN X IF EPS>1. + IF(EPS.LT.1.) THEN + POW=ALOG((3.+EPS)/EPS)/ALN4 + YMX=(EPS*(3.*POW-1.)/(POW+1.))**(.5/POW) + ZMX=1-YMX**POW + D0MX=(1-ZMX)**2/((1.-ZMX)**2+EPS)**2*POW*YMX**(POW-1.) + D2MX=2./(2.-SQRT(EPS)) + ELSE + POW=1. + ZMX=0. + D0MX=(1.-ZMX)**2/((1.-ZMX)**2+EPS)**2 + D2MX=1.+EPS + ENDIF +C +C GENERATE Z ACCORDING TO (1-Z)**2/((1-Z)**2+EPS*Z)**2 +1 CONTINUE + Y=RANF() + Z=1.-Y**POW +C + D0Z=(1.-Z)**2/((1.-Z)**2+EPS)**2*POW*Y**(POW-1.) + IF(D0Z.LT.RANF()*D0MX) GO TO 1 +C +C CHECK REMAINING FACTORS + D1=Z + D2=(((1.-Z)**2+EPS)/((1.-Z)**2+EPS*Z))**2 + IF(D1*D2.LT.RANF()*D2MX) GO TO 1 +C +C GOOD X + X=Z + RETURN + END diff --git a/ISAJET/code/hevolv.F b/ISAJET/code/hevolv.F new file mode 100644 index 00000000000..fda51c4a3d4 --- /dev/null +++ b/ISAJET/code/hevolv.F @@ -0,0 +1,265 @@ +#include "isajet/pilot.h" + SUBROUTINE HEVOLV +C +C CARRY OUT BACKWARDS EVOLUTION QK --> QK + W FOR LONGITUDINAL +C W-W FUSION, GENERATING Z AND KT**2 FROM RELATION OF W AND +C QUARK STRUCTURE FUNCTIONS. +C +#include "isajet/itapes.inc" +#include "isajet/qcdpar.inc" +#include "isajet/jetpar.inc" +#include "isajet/pjets.inc" +#include "isajet/jetset.inc" +#include "isajet/primar.inc" +#include "isajet/wcon.inc" +#include "isajet/const.inc" +#include "isajet/idrun.inc" +#include "isajet/hcon.inc" +C + DIMENSION X(2) + EQUIVALENCE (X1,X(1)) + DIMENSION FZIQ(13),IWPICK(2),PFINAL(5),BST1(5),BST2(5),B2B1(5) + DIMENSION PSAVE(5,2) +C LAMBDA FUNCTION + ALAMF(A,B,C)=SQRT((A-B-C)**2-4.*B*C) +C + NJSAVE=NJSET + NREJ2=-1 +C +C INITIALIZE + DO 10 I=1,2 + DO 10 K=1,5 +10 PSAVE(K,I)=PJSET(K,I) +20 CONTINUE + DO 30 I=1,2 + DO 30 K=1,5 +30 PJSET(K,I)=PSAVE(K,I) + DO 40 K=1,5 +40 PFINAL(K)=QWJET(K) + NJSET=NJSAVE +C +C CHOOSE A W AND DO BACKWARDS EVOLUTION FOR QK -> QK + W. +C + IF(RANF().LT..5) THEN + IWPICK(1)=1 + IWPICK(2)=2 + SGN=+1. + ELSE + IWPICK(1)=2 + IWPICK(2)=1 + SGN=-1. + ENDIF + DO 100 JJ=1,2 +C +C OTHER PARTICLE IS W FOR JJ=1, QUARK FOR JJ=2: + IF(JJ.EQ.1) THEN + J1=IWPICK(1) + J2=IWPICK(2) + ELSE + J1=IWPICK(2) + J2=NJSAVE+1 + SGN=-SGN + ENDIF + JTLV1=JTYPE(J1) + IF(JTLV1.EQ.10) THEN + IW=1 + ELSEIF(JTLV1.EQ.80) THEN + IW=2 + ELSEIF(JTLV1.EQ.-80) THEN + IW=3 + ELSEIF(JTLV1.EQ.90) THEN + IW=4 + ENDIF + XV=(PJSET(4,J1)+ABS(PJSET(3,J1)))/ECM + AMV=AMASS(JTLV1) +C +C GENERATE VARIABLES FOR BRANCHING +C FIND MAXIMUM OF INTEGRAND USING 20 POINTS IN LOG(Z) + FMAX=0. + ZMULT=(1./XV)**.05 + ZIZ=XV + DO 110 IZ=1,19 + ZIZ=ZIZ*ZMULT + FSUM=0. + DO 115 IQ=2,13 + IF(MATCH(IQ,IW).NE.0) THEN + IFL=IQ/2 + CIQ=AQ(IFL,IW)**2+BQ(IFL,IW)**2 + FSUM=FSUM+CIQ*(1.-ZIZ)/ZIZ*STRUC(XV/ZIZ,AMV**2,IQ,IDIN(J1)) + ENDIF +115 CONTINUE + FMAX=AMAX1(FMAX,FSUM) +110 CONTINUE +C GENERATE Z UNIFORMLY IN (XV,1) AND TEST + NREJ1=-1 +120 ZV=XV+(1.-XV)*RANF() + FZ=0. + DO 130 IQ=2,13 + IF(MATCH(IQ,IW).NE.0) THEN + IFL=IQ/2 + CIQ=AQ(IFL,IW)**2+BQ(IFL,IW)**2 + FZIQ(IQ)=CIQ*(1.-ZV)/ZV*STRUC(XV/ZV,AMV**2,IQ,IDIN(J1)) + ELSE + FZIQ(IQ)=0. + ENDIF +130 FZ=FZ+FZIQ(IQ) + IF(FZ.LT.FMAX*RANF()) THEN + NREJ1=NREJ1+1 + IF(NREJ1.GT.NTRIES) GO TO 9999 + GO TO 120 + ENDIF +C DETERMINE QUARK TYPE + TRY=RANF() + SUM=0. + DO 140 IQ=2,13 + IQ1=IQ + SUM=SUM+FZIQ(IQ)/FZ +140 IF(SUM.GT.TRY) GO TO 150 +150 IQ3=MATCH(IQ1,IW) + IQ3=MATCH(IQ3,4) +C GENERATE T=-K**2 AND UNIFORM PHI + T=AMV**2*(1./RANF()-1.) + PHIK=2.*PI*RANF() +C +C SOLVE KINEMATICS FOR THIS SIDE + S=(PJSET(4,J1)+PJSET(4,J2))**2-(PJSET(1,J1)+PJSET(1,J2))**2 + $-(PJSET(2,J1)+PJSET(2,J2))**2-(PJSET(3,J1)+PJSET(3,J2))**2 + SP=S/ZV + IFL1=IQ1/2 + IFL2=JTYPE(J2) + IFL3=IQ3/2 + AM1=AMASS(IFL1) + AM2=PJSET(5,J2) + AM3=AMASS(IFL3) + AM1SQ=AM1**2 + AM2SQ=AM2**2 + AM3SQ=AM3**2 + IF(SGN.LT.0.) THEN + P2PL=PJSET(4,J2)+PJSET(3,J2) + P2MN=AM2SQ/P2PL + ELSE + P2MN=PJSET(4,J2)-PJSET(3,J2) + P2PL=AM2SQ/P2MN + ENDIF +C STEP 1: SOLVE FOR PP1=PJSET(K,NEWV) + IF(SGN.GT.0.) THEN + PP1PL=(SP-AM1SQ-AM2SQ+ALAMF(SP,AM1SQ,AM2SQ))/(2.*P2MN) + PP1MN=AM1SQ/PP1PL + ELSE + PP1MN=(SP-AM1SQ-AM2SQ+ALAMF(SP,AM1SQ,AM2SQ))/(2.*P2PL) + PP1PL=AM1SQ/PP1MN + ENDIF +C STEP 2: SOLVE FOR K = VIRTUAL W MOMENTUM + DEN=PP1PL*P2MN-PP1MN*P2PL + AKPL=(+PP1PL*(S+T-AM2SQ)+P2PL*(T+AM3SQ-AM1SQ))/DEN + AKMN=(-PP1MN*(S+T-AM2SQ)-P2MN*(T+AM3SQ-AM1SQ))/DEN + WPL=PP1PL-AKPL + WMN=PP1MN-AKMN + AKT2=T+AKPL*AKMN +C STEP 3: START OVER IF AKT2 UNPHYSICAL + IF(AKT2.LE.0..OR.PP1PL.GE.ECM.OR.PP1MN.GE.ECM.OR. + $P2PL.GE.ECM.OR.P2MN.GE.ECM) THEN + NREJ2=NREJ2+1 + IF(NREJ2.GT.NTRIES) GO TO 9999 + GO TO 20 + ENDIF +C +C SAVE NEW VECTORS + NJ1=NJSET+1 + NJ2=NJSET+2 + AKT=SQRT(AKT2) + AKX=AKT*COS(PHIK) + AKY=AKT*SIN(PHIK) + PJSET(1,J1)=AKX + PJSET(2,J1)=AKY + PJSET(3,J1)=.5*(AKPL-AKMN) + PJSET(4,J1)=.5*(AKPL+AKMN) + PJSET(5,J1)=-SQRT(T) + JDCAY(J1)=JPACK*NJ1+NJ2 + JET=IABS(JORIG(J1))/JPACK +C + PJSET(1,NJ1)=0. + PJSET(2,NJ1)=0. + PJSET(3,NJ1)=.5*(PP1PL-PP1MN) + PJSET(4,NJ1)=.5*(PP1PL+PP1MN) + PJSET(5,NJ1)=AM1 + JORIG(NJ1)=JPACK*JET+J1 + JTYPE(NJ1)=IFL1 + JDCAY(NJ1)=0 +C + PJSET(1,NJ2)=-AKX + PJSET(2,NJ2)=-AKY + PJSET(3,NJ2)=.5*(WPL-WMN) + PJSET(4,NJ2)=.5*(WPL+WMN) + PJSET(5,NJ2)=AM3 + JORIG(NJ2)=JPACK*JET+J1 + JTYPE(NJ2)=IFL3 + JDCAY(NJ2)=0 +C +C BOOST OTHER VECTORS TO NEW FRAME GIVEN BY DIFFERENCE OF +C OLD AND NEW FINAL MOMENTA. + DO 200 K=1,4 + BST1(K)=PFINAL(K) +200 BST2(K)=PJSET(K,J1)+PJSET(K,J2) + BMASS=PFINAL(5) + BST1(5)=BMASS + BST2(5)=BMASS +C +C PARAMETERS FOR COMBINED BOOSTS. + BDOTB=BST1(4)*BST2(4)-BST1(1)*BST2(1)-BST1(2)*BST2(2) + $-BST1(3)*BST2(3) + DO 210 K=1,4 +210 B2B1(K)=BST2(K)-BST1(K) +C + B44=BDOTB/BMASS**2 + BI41=1./BMASS + BI42=(BDOTB-BMASS**2-B2B1(4)*BMASS)/(BMASS**2*(BST2(4)+BMASS)) + B4K1=BI41 + B4K2=(BMASS**2-BDOTB-B2B1(4)*BMASS)/(BMASS**2*(BST1(4)+BMASS)) + BIK1=-1./(BMASS*(BST1(4)+BMASS)) + BIK2=1./(BMASS*(BST2(4)+BMASS)) + BIK3=(BMASS**2-BDOTB)/(BMASS**2*(BST1(4)+BMASS) + $*(BST2(4)+BMASS)) +C +C BOOST FINAL JETS + DO 220 J=1,NJSET + IF(J.EQ.J1.OR.J.EQ.J2) GO TO 220 + IF(PJSET(5,J).LT.0.) GO TO 220 + BP1=0. + BP21=0. + DO 221 K=1,3 + BP1=BP1+BST1(K)*PJSET(K,J) +221 BP21=BP21+B2B1(K)*PJSET(K,J) + DO 222 K=1,3 +222 PJSET(K,J)=PJSET(K,J) + $+(B2B1(K)*BI41+BST2(K)*BI42)*PJSET(4,J) + $+B2B1(K)*BP1*BIK1+BST2(K)*BP21*BIK2+BST2(K)*BP1*BIK3 + PJSET(4,J)=B44*PJSET(4,J)+BP21*B4K1+BP1*B4K2 +220 CONTINUE +C +C RESET VIRTUAL MOMENTA + DO 230 J=1,NJSET + IF(J.EQ.J1.OR.J.EQ.J2) GO TO 230 + IF(PJSET(5,J).GE.0.) GO TO 230 + JX1=JDCAY(J)/JPACK + JX2=JDCAY(J)-JPACK*JX1 + DO 231 K=1,4 +231 PJSET(K,J)=PJSET(K,JX1)-PJSET(K,JX2) + AMJ=PJSET(4,J)**2-PJSET(1,J)**2-PJSET(2,J)**2-PJSET(3,J)**2 + PJSET(5,J)=-SQRT(ABS(AMJ)) +230 CONTINUE +C +C RESET PFINAL AND NJSET + DO 240 K=1,4 +240 PFINAL(K)=PJSET(K,J2)+PJSET(K,NJ1) + PFINAL(5)=SQRT(SP) + NJSET=NJSET+2 +100 CONTINUE + RETURN +C +9999 CONTINUE + WRITE(ITLIS,9998) IEVT +9998 FORMAT(/' ***** ERROR IN HEVOLV ... EVENT',I8,' DISCARDED *****') + NJSET=-1 + RETURN + END diff --git a/ISAJET/code/higgs.F b/ISAJET/code/higgs.F new file mode 100644 index 00000000000..902170a74f8 --- /dev/null +++ b/ISAJET/code/higgs.F @@ -0,0 +1,39 @@ +#include "isajet/pilot.h" + SUBROUTINE HIGGS +C +C FINISH HIGGS GENERATION STARTED BY DRLLYN FOR DECAY +C HIGGS --> W W. +C +C VER 7.14: TEST BOTH JET1 AND JET2 FOR W,Z FOR SAFETY +C +#include "isajet/itapes.inc" +#include "isajet/qcdpar.inc" +#include "isajet/jetpar.inc" +#include "isajet/pjets.inc" +#include "isajet/primar.inc" +#include "isajet/q1q2.inc" +#include "isajet/jetsig.inc" +#include "isajet/qsave.inc" +#include "isajet/wcon.inc" +#include "isajet/const.inc" +#include "isajet/hcon.inc" +C + DIMENSION X(2) + EQUIVALENCE (X(1),X1) +C + IDABS1=IABS(IDJETS(1)) + IDABS2=IABS(IDJETS(2)) + IF(IDABS1.NE.80.AND.IDABS1.NE.90.AND. + $IDABS2.NE.80.AND.IDABS2.NE.90) THEN + NPAIR=0 + DO 100 I=1,4 + IDPAIR(I)=0 + JPAIR(I)=0 + DO 110 K=1,5 +110 PPAIR(K,I)=0. +100 CONTINUE + ELSE + CALL WPAIR + ENDIF + RETURN + END diff --git a/ISAJET/code/idanti.F b/ISAJET/code/idanti.F new file mode 100644 index 00000000000..72ac219b176 --- /dev/null +++ b/ISAJET/code/idanti.F @@ -0,0 +1,60 @@ +#include "isajet/pilot.h" + INTEGER FUNCTION IDANTI(ID) +C---------------------------------------------------------------------- +C- +C- Purpose and Methods : +C- Return value of antiparticle id +C- +C- Inputs : +C- ID = particle id +C- +C- Created 1-JUN-1988 Serban D. Protopopescu +C- 3-Jan-1993: Expand self-conjugate list for MSSM and simplify +C structure. FEP +C 17-Mar-1997: Correctly handle mesons with IDENT>10000 +C- +C---------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + INTEGER ID,IFL1,IFL2,IFL3,IDABS + INTEGER NSELF,I + PARAMETER (NSELF=14) + INTEGER IDSELF(NSELF) + SAVE IDSELF + DATA IDSELF/9,10,20,29,30,40,50,60,81,82,83,84,90,91/ +C---------------------------------------------------------------------- + IDABS=IABS(ID) + IFL1=MOD(IDABS/1000,10) +C +C Baryons and diquarks +C + IF(IFL1.NE.0) THEN + IDANTI=-ID + RETURN + ENDIF +C +C Mesons +C + IF(IDABS.GT.100.AND.IFL1.EQ.0) THEN + IFL2=MOD(IDABS/100,10) + IFL3=MOD(IDABS/10,10) + IF(IFL2.EQ.IFL3) THEN + IDANTI=+ID + ELSE + IDANTI=-ID + ENDIF + RETURN + ENDIF +C +C Other particles +C + DO 100 I=1,NSELF + IF(IDABS.EQ.IDSELF(I)) THEN + IDANTI=+ID + RETURN + ENDIF +100 CONTINUE + IDANTI=-ID + RETURN + END diff --git a/ISAJET/code/idgen.F b/ISAJET/code/idgen.F new file mode 100644 index 00000000000..61379945502 --- /dev/null +++ b/ISAJET/code/idgen.F @@ -0,0 +1,60 @@ +#include "isajet/pilot.h" + SUBROUTINE IDGEN +C +C Call system date and time routines (non-standard) to set up +C run identification: +C IDVER=100*VERSN (integer ISAJET version number) +C IDG(1)=YYMMDD (integer year-month-day) +C IDG(2)=HHMMSS (integer hour-minute-second) +C +#include "isajet/itapes.inc" +#include "isajet/idrun.inc" +#if defined(CERNLIB_CDC)||defined(CERNLIB_ETA) + CHARACTER*10 CHAR,DATE,TIME +#endif +#if defined(CERNLIB_SUN)||defined(CERNLIB_SGI) + DIMENSION ISUN(3) +#endif +C Default run id is zero. + IYMD=0. + IHMS=0. +#if (defined(CERNLIB_CDC))&&(defined(CERNLIB_NOCERN)) +C Call CDC date and time and convert to integer. + CHAR=DATE() + READ(CHAR,'(1X,I2,1X,I2,1X,I2,1X)') IA,IB,IC + IYMD=10000*IC+100*IA+IB + CHAR=TIME() + READ(CHAR,'(1X,I2,1X,I2,1X,I2,1X)') IA,IB,IC + IHMS=10000*IA+100*IB+IC +#endif +#if (defined(CERNLIB_ETA))&&(defined(CERNLIB_NOCERN)) +C Call ETA date and time and convert to integer. + CHAR=DATE() + READ(CHAR,'(I2,1X,I2,1X,I2)') IA,IB,IC + IYMD=10000*IC+100*IA+IB + CHAR=TIME() + READ(CHAR,'(I2,1X,I2,1X,I2)') IA,IB,IC + IHMS=10000*IA+100*IB+IC +#endif +#if (defined(CERNLIB_SGI))&&(defined(CERNLIB_NOCERN)) +C Call Silicon Graphics date and time + CALL IDATE(ISUN(1),ISUN(2),ISUN(3)) + IYMD=10000*ISUN(3)+100*ISUN(2)+ISUN(1) + CALL ITIME(ISUN) + IHMS=10000*ISUN(1)+100*ISUN(2)+ISUN(3) +#endif +#if (defined(CERNLIB_SUN))&&(defined(CERNLIB_NOCERN)) +C Call SUN date and time + CALL IDATE(ISUN) + IYMD=10000*(MOD(ISUN(3),100))+100*ISUN(2)+ISUN(1) + CALL ITIME(ISUN) + IHMS=10000*ISUN(1)+100*ISUN(2)+ISUN(3) +#endif +#if defined(CERNLIB_IBM)||defined(CERNLIB_VAX)||defined(CERNLIB_CERN) +C Call DATIME for date and time. (In Cern library) + CALL DATIME(IYMD,IHMS) +#endif + IDG(1)=IYMD + IDG(2)=IHMS + RETURN + END diff --git a/ISAJET/code/iframs.F b/ISAJET/code/iframs.F new file mode 100644 index 00000000000..7bf6c2032c1 --- /dev/null +++ b/ISAJET/code/iframs.F @@ -0,0 +1,61 @@ +#include "isajet/pilot.h" + SUBROUTINE IFRAMS(N1,N2,IFR,PAIR) +C---------------------------------------------------------------------- +C- +C- Purpose and Methods : +C- Initialize a center of mass frame for partons N1 to N2 +C- partons must be consecutive unless PAIR is true +C- +C- Inputs : +C- N1 = first parton +C- N2 = last parton +C- IFR = index of frame +C- PAIR= if false N1, N2 denote a range +C- if true N1 and N2 form a pair +C- +C- Created 14-AUG-1991 Serban D. Protopopescu +C- +C---------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/pjets.inc" +#include "isajet/jetset.inc" +#include "isajet/jwork.inc" +#include "isajet/frame.inc" + INTEGER I,J,K,JADD,N1,N2,IFR + DOUBLE PRECISION DPASS(5),DSUM(5) + LOGICAL PAIR +C---------------------------------------------------------------------- +C + IF ( N2-N1.EQ.1.OR.PAIR ) THEN + JMATCH(N1)=N2 + JMATCH(N2)=N1 + JADD=N2-N1 + ELSE + JADD=1 + DO 201 I=N1,N2 + JMATCH(I)=JPACK*N1+N2 +201 CONTINUE + ENDIF +C Need double precision boosts + CALL DBLVEC(PJSET(1,N1),DSUM) + DO 211 I=N1+JADD,N2 + CALL DBLVEC(PJSET(1,I),DPASS) + DO 210 K=1,4 +210 DSUM(K)=DSUM(K)+DPASS(K) + DSUM(5)=DSQRT(DSUM(4)**2-DSUM(1)**2-DSUM(2)**2-DSUM(3)**2) +211 CONTINUE + DO 212 K=1,5 + FRAME(K,IFR)=DSUM(K) +212 CONTINUE +C +C Set up and generate final state QCD parton shower. +C Boost PJSET with -FRAME. +C + DO 240 J=N1,N2,JADD + CALL DBOOST(-1,FRAME(1,IFR),PJSET(1,J)) +240 CONTINUE +C +999 RETURN + END diff --git a/ISAJET/code/inisap.F b/ISAJET/code/inisap.F new file mode 100644 index 00000000000..66299807994 --- /dev/null +++ b/ISAJET/code/inisap.F @@ -0,0 +1,121 @@ +#include "isajet/pilot.h" + SUBROUTINE INISAP(CMSE,XREAC,BEAMS,WZ,NDCAYS,DCAYS, + $ ETMIN,RCONE,OK) +C---------------------------------------------------------------------- +C- +C- Purpose and Methods : +C- initialize ISAJET for externally supplied partons +C- Inputs : +C- CMSE = center of mass energy +C- XREAC = reaction +C- BEAMS(2) = chose 'P ' or 'AP' +C- ETMIN = minimum ET of supplied partons +C- RCONE = minimum cone (R) between supplied partons +C- WZ = option 'W' or 'Z', ' ' no W's or Z's +C- NDCAYS= number of decay options +C- DCAYS= list of particles W or Z are allowed to decay into +C- +C- Controls: +C- OK = true if initialization is possible +C- Created 8-OCT-1991 Serban D. Protopopescu +C- +C---------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/keys.inc" +#include "isajet/idrun.inc" +#include "isajet/limevl.inc" +#include "isajet/primar.inc" +#include "isajet/q1q2.inc" +#include "isajet/types.inc" +C + REAL CMSE + CHARACTER*8 XREAC + CHARACTER*2 BEAMS(2) + REAL ETMIN,RCONE + CHARACTER*1 WZ + INTEGER NDCAYS + CHARACTER*4 DCAYS(*) + LOGICAL OK + LOGICAL DUMY,SETTYP + INTEGER I +C---------------------------------------------------------------------- + OK=.TRUE. + CALL RESET + IEVT=0 + ECM=CMSE + SCM=ECM**2 + HALFE=ECM/2. + ETTHRS=ETMIN +C fudge factor 1.5 to approximate ET distributions and widths + CONCUT=SIN(RCONE)/1.5 + IF(RCONE.GT.1.5) CONCUT=1.0 + USELIM=.TRUE. + IKEYS=0 + DO 18 I=1,8 +18 KEYS(I)=.FALSE. + KEYON=.FALSE. + REAC=XREAC +C + IF(XREAC.EQ.'TWOJET ') THEN + KEYS(1)=.TRUE. + IKEYS=1 +C + ELSEIF(XREAC.EQ.'DRELLYAN') THEN + KEYS(3)=.TRUE. + IKEYS=3 + IF(WZ.EQ.'Z') GODY(4)=.TRUE. + IF(WZ.EQ.'W') THEN + GODY(2)=.TRUE. + GODY(3)=.TRUE. + ENDIF + NJTTYP(1)=NDCAYS + NJTTYP(2)=0 + NJTTYP(3)=0 + DO 21 I=1,NDCAYS + JETYP(I,1)=DCAYS(I) + 21 CONTINUE +C + ELSEIF(XREAC.EQ.'MINBIAS ') THEN + KEYS(4)=.TRUE. + IKEYS=4 +C + ELSEIF(XREAC.EQ.'SUPERSYM'.OR.XREAC.EQ.'SUSY ') THEN + KEYS(5)=.TRUE. + IKEYS=5 +C + ELSEIF(XREAC.EQ.'WPAIR ') THEN + KEYS(6)=.TRUE. + IKEYS=6 +C + ELSEIF(XREAC.EQ.'HIGGS ') THEN + KEYS(7)=.TRUE. + IKEYS=7 +C + ELSEIF(XREAC.EQ.'PHOTON ') THEN + KEYS(8)=.TRUE. + IKEYS=8 + ENDIF +C + IF(IKEYS.EQ.0) THEN + OK=.FALSE. + GOTO 999 + ENDIF +C + CALL SETCON + IDIN(1)=1120 + IDIN(2)=-1120 + IF (BEAMS(1).EQ.'P ') IDIN(1)=1120 + IF (BEAMS(2).EQ.'P ') IDIN(2)=1120 + IF (BEAMS(1).EQ.'AP') IDIN(1)=-1120 + IF (BEAMS(2).EQ.'AP') IDIN(2)=-1120 + DUMY=SETTYP(0) + CALL SETW + CALL IDGEN + CALL SETDKY(.FALSE.) + CALL MBSET + CALL PRTLIM + CALL TIMER(1) + 999 RETURN + END diff --git a/ISAJET/code/ipartns.F b/ISAJET/code/ipartns.F new file mode 100644 index 00000000000..dc597c8b989 --- /dev/null +++ b/ISAJET/code/ipartns.F @@ -0,0 +1,206 @@ +#include "isajet/pilot.h" + SUBROUTINE IPARTNS(NPRTNS,IDS,PRTNS,IDQ,WEIGHT,WZDK) +C---------------------------------------------------------------------- +C- +C- Purpose and Methods : +C- fill PJETS array from a list of input partons +C- Inputs : +C- NPRTNS = number of partons +C- IDS(NPRTNS) = parton ids +C- PRTNS(4,NPRTNS) = parton 4 vectors +C- IDQ(2) = initial partons +C- WEIGHT = weight +C- WZDK = if true last 2 partons are from W,Z decay +C- +C- +C- Created 8-OCT-1991 Serban D. Protopopescu +C- Updated 17-APR-1996 Serban D. Protopopescu +C- added entry evcuts to supply evolution limits +C- modified DrellYan (keys(3)) to stay within VECBOS jet ranking +C- Updated 16-JUN-1998 F. Paige +C- Removed ISAZEB dependence: use ISPJET and do not call ISPETA +C- +C---------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + INTEGER NPRTNS,IDS(NPRTNS),IDQ(2) + REAL PRTNS(4,NPRTNS),WEIGHT + LOGICAL WZDK +#include "isajet/final.inc" +#include "isajet/idrun.inc" +#include "isajet/jetpar.inc" +#include "isajet/keys.inc" +#include "isajet/nodcay.inc" +#include "isajet/partcl.inc" +#include "isajet/pjets.inc" +#include "isajet/primar.inc" +#include "isajet/q1q2.inc" +#include "isajet/totals.inc" + REAL SUM(4),AMASS + INTEGER K,J,IWZ,ID,NQS + INTEGER MAXQ + PARAMETER (MAXQ=15) + INTEGER I,NP,JDORD(MAXQ),JIORD(MAXQ),NPJ + REAL ETAQ(MAXQ),PHIQ(MAXQ),THQ(MAXQ),PTQ(MAXQ) + REAL ETCUT,ETIN,RCUT,RIN,R + REAL PPI + REAL PXPT(MAXQ),PXETA(MAXQ),PXPHI(MAXQ) + LOGICAL DOEVOL,DOEVIN + DOUBLE PRECISION PI, TWOPI, HALFPI, RADIAN + PARAMETER (PI= 3.1415 92653 58979 32384 6 D0) + PARAMETER (TWOPI= 6.2831 85307 17958 64769 3 D0) + PARAMETER (HALFPI= 1.5707 96326 79489 66192 3 D0) + PARAMETER (RADIAN= 0.0174532 92519 94329 5769237 D0) +C---------------------------------------------------------------------- +C + NJET=0 +C +C handle W's and Z's +C + IEVT=IEVT+1 + IWZ=0 + NQS=NPRTNS + IF(WZDK) NQS=NPRTNS-2 + DO 1 J=1,NPRTNS + ID=IABS(IDS(J)) + IF(ID.GT.79) THEN + IF(ID.EQ.90) JWTYP=4 + IF(IDS(J).EQ.80) JWTYP=2 + IF(IDS(J).EQ.-80) JWTYP=3 + IDENTW=IDS(J) + DO 2 K=1,4 + QWJET(K)=PRTNS(K,J) + 2 CONTINUE + QWJET(5)=SQRT(QWJET(4)**2-QWJET(1)**2-QWJET(2)**2-QWJET(3)**2) + IWZ=J + ENDIF + 1 CONTINUE + DO 4 J=NQS+1,NPRTNS + ID=IABS(IDS(J)) + NJET=NJET+1 + DO 3 K=1,4 + PJETS(K,NJET)=PRTNS(K,J) + 3 CONTINUE + IDJETS(NJET)=IDS(J) + PJETS(5,NJET)=AMASS(ID) + 4 CONTINUE +C W,Z decays were not in input + IF(IWZ.NE.0.AND.NJET.EQ.0) THEN + NJET=2 + CALL ISWDKY + ENDIF +C +C fill with the other partons +C + DO 5 K=1,4 + SUM(K)=0 + 5 CONTINUE + DO 11 J=1,NQS + ID=IABS(IDS(J)) + IF(IWZ.NE.J.AND.ID.LT.11) THEN + NJET=NJET+1 + IDJETS(NJET)=IDS(J) + DO 12 K=1,4 + PJETS(K,NJET)=PRTNS(K,J) + 12 CONTINUE + PJETS(5,NJET)=PRTNS(4,J)**2-PRTNS(1,J)**2-PRTNS(2,J)**2- + $ PRTNS(3,J)**2 + IF ( PJETS(5,NJET).GT.0. ) THEN + PJETS(5,NJET)=SQRT(PJETS(5,NJET)) + ELSE + PJETS(4,NJET)=SQRT(PRTNS(4,J)**2-PJETS(5,NJET)) + PJETS(5,NJET)=0. + ENDIF + ENDIF + DO 13 K=1,4 + SUM(K)=SUM(K)+PRTNS(K,J) + 13 CONTINUE + 11 CONTINUE +C +C eta and phi of incoming partons + IF(DOEVOL) THEN + NP=NQS-1 + DO 114 I=1,NP + PPI=SQRT(PRTNS(1,I)**2+PRTNS(2,I)**2+PRTNS(3,I)**2) + IF(PPI.GT.0.AND.PPI.GT.ABS(PRTNS(3,I))) THEN + THQ(I)=ACOS(PRTNS(3,I)/PPI) + ETAQ(I)=-LOG(TAN(THQ(I)/2)) + ELSE + THQ(I)=0 + ETAQ(I)=SIGN(999.,PRTNS(3,I)) + ENDIF + PTQ(I)=SQRT(PRTNS(1,I)**2+PRTNS(2,I)**2) + IF(PTQ(I).GT.0) THEN + PHIQ(I)=ATAN2(PRTNS(2,I),PRTNS(1,I)) + IF(PHIQ(I).LT.0) PHIQ(I)=PHIQ(I)+TWOPI + ELSE + PHIQ(I)=0 + ENDIF + 114 CONTINUE +C +C ... Order partons in pt +C + DO 115 I = 1 , NP + JIORD(I) = I + PXPT(I)=PTQ(I) + 115 CONTINUE + CALL ISASRT(PXPT(1),NP,JIORD) + DO 116 I = 1 , NP + PXPT(I)=PTQ(I) + PXETA(I)=ETAQ(I) + PXPHI(I)=PHIQ(I) + JDORD(I) = JIORD(NP-I+1) + 116 CONTINUE + DO 117 I = 1 , NP + PTQ(I)=PXPT(JDORD(I)) + ETAQ(I)=PXETA(JDORD(I)) + PHIQ(I)=PXPHI(JDORD(I)) + 117 CONTINUE + ENDIF +C +C + 15 CONTINUE + PBEAM(1)=(ECM-SUM(4)-SUM(3))/2. + PBEAM(2)=(ECM-SUM(4)+SUM(3))/2. + QSQ=SQRT(SUM(4)**2-SUM(3)**2-SUM(2)**2-SUM(1)**2) + CALL RANFMT + NPTCL=0 + IF(KEYS(3)) THEN + STDDY=.FALSE. + IF(NQS.EQ.1.OR.NJET.LT.3) STDDY=.TRUE. + ENDIF + CALL IPRTNS(NQS,PRTNS,IDQ) + IF(.NOT.NOEVOL) THEN + CALL EVOLVE +C +C special check for VECBOS + IF(DOEVOL) THEN +C Find parton jets + CALL ISPJET(RCUT,ETCUT,NPJ,PXPT,PXPHI,PXETA) + IF(NPJ.GE.NP.AND.PXPT(NP).GT.PTQ(NP)) THEN + R=SQRT((PXETA(NP)-ETAQ(NP))**2+(PXPHI(NP)-PHIQ(NP))**2) + IF(R.GT.RCUT) GOTO 15 + ENDIF + ENDIF +C + IF(.NOT.NOHADR) THEN + CALL FRGMNT + CALL MBIAS + ENDIF + ENDIF + WT=WEIGHT + SUMWT=SUMWT+WT + SIGF=SUMWT + NKINF=IEVT + NEVENT=IEVT + 999 RETURN +C +C Entry point to set parameters +C + ENTRY EVCUTS(RIN,ETIN,DOEVIN) + RCUT=RIN + ETCUT=ETIN + DOEVOL=DOEVIN + RETURN + END diff --git a/ISAJET/code/ipjset.F b/ISAJET/code/ipjset.F new file mode 100644 index 00000000000..9139022d04f --- /dev/null +++ b/ISAJET/code/ipjset.F @@ -0,0 +1,29 @@ +#include "isajet/pilot.h" + SUBROUTINE IPJSET +C---------------------------------------------------------------------- +C- +C- Purpose and Methods : +C- Initialize PJSET starting from PJETS +C- +C- Created 14-AUG-1991 Serban D. Protopopescu +C- +C---------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/primar.inc" +#include "isajet/pjets.inc" +#include "isajet/jetset.inc" + INTEGER I,K +C---------------------------------------------------------------------- + DO 110 I=1,NJET + NJSET=NJSET+1 + JORIG(NJSET)=JPACK*I + JTYPE(NJSET)=IDJETS(I) + JDCAY(NJSET)=0 + DO 115 K=1,5 +115 PJSET(K,NJSET)=PJETS(K,I) + IFRAME(I)=1 +110 CONTINUE + 999 RETURN + END diff --git a/ISAJET/code/iprtns.F b/ISAJET/code/iprtns.F new file mode 100644 index 00000000000..bb972a94c10 --- /dev/null +++ b/ISAJET/code/iprtns.F @@ -0,0 +1,54 @@ +#include "isajet/pilot.h" + SUBROUTINE IPRTNS(NPRTNS,PRTNS,IDQ) +C---------------------------------------------------------------------- +C- +C- Purpose and Methods : +C- Fill PINITS common block +C- Inputs : +C- IDQ(2)= id's of partons starting reaction +C- +C- Created 10-OCT-1991 Serban D. Protopopescu +C- Renamed from IPINIT to avoid name clash with Cern Library +C- +C---------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + INTEGER NPRTNS,IDQ(2) + REAL PRTNS(4,NPRTNS) +#include "isajet/jetpar.inc" +#include "isajet/pinits.inc" + REAL AMASS, AM1SQ,AM2SQ,ROOT,QPL,QMN,P1PL,P1MN,P2PL,P2MN + INTEGER I +C---------------------------------------------------------------------- +C sum P+ and P-, shat +C assumes sum of transverse momenta is zero + QPL=0 + QMN=0 + DO 1 I=1,NPRTNS + QPL=QPL+PRTNS(4,I)+PRTNS(3,I) + QMN=QMN+PRTNS(4,I)-PRTNS(3,I) + 1 CONTINUE + SHAT=QPL*QMN +C +C fill PINITS + DO 2 I=1,2 + IDINIT(I)=IDQ(I) + PINITS(5,I)=AMASS(IDQ(I)) + PINITS(1,I)=0. + PINITS(2,I)=0. + 2 CONTINUE +C and solve initial kinematics + AM1SQ=PINITS(5,1)**2 + AM2SQ=PINITS(5,2)**2 + ROOT=SQRT((QPL*QMN-AM1SQ-AM2SQ)**2-4.*AM1SQ*AM2SQ) + P1PL=(QPL*QMN+AM1SQ-AM2SQ+ROOT)/(2.*QMN) + P1MN=AM1SQ/P1PL + P2MN=(QPL*QMN+AM2SQ-AM1SQ+ROOT)/(2.*QPL) + P2PL=AM2SQ/P2MN + PINITS(3,1)=.5*(P1PL-P1MN) + PINITS(4,1)=.5*(P1PL+P1MN) + PINITS(3,2)=.5*(P2PL-P2MN) + PINITS(4,2)=.5*(P2PL+P2MN) + 999 RETURN + END diff --git a/ISAJET/code/irmov0.F b/ISAJET/code/irmov0.F new file mode 100644 index 00000000000..fcf2622b81f --- /dev/null +++ b/ISAJET/code/irmov0.F @@ -0,0 +1,42 @@ +#include "isajet/pilot.h" + SUBROUTINE IRMOV0 +C---------------------------------------------------------------------- +C- +C- Purpose and Methods : +C- remove 0's from PJSET +C- +C- Created 15-OCT-1991 Serban D. Protopopescu +C- +C---------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/jetset.inc" +#include "isajet/jwork.inc" + INTEGER NCOUNT,I,J,K +C---------------------------------------------------------------------- +C +C remove zeroes + NCOUNT=NJSET + DO 160 I=3,NJSET + 151 IF (PJSET(4,I).EQ.0.AND.I.LT.NCOUNT) THEN + DO 155 K=I+1,NCOUNT + DO 154 J=1,5 + PJSET(J,K-1)=PJSET(J,K) + 154 CONTINUE + JORIG(K-1)=JORIG(K) + JTYPE(K-1)=JTYPE(K) + JDCAY(K-1)=JDCAY(K) + ZZC(K-1)=ZZC(K) + JMATCH(K-1)=JMATCH(K) + IF(JMATCH(K-1).GT.I) JMATCH(K-1)=JMATCH(K-1)-1 + 155 CONTINUE + NCOUNT=NCOUNT-1 + GOTO 151 + ENDIF + 160 CONTINUE + NJSET=NCOUNT +C remove last one if 0 + IF(PJSET(4,NJSET).EQ.0) NJSET=NJSET-1 + 999 RETURN + END diff --git a/ISAJET/code/isabeg.F b/ISAJET/code/isabeg.F new file mode 100644 index 00000000000..d8bdd00f09d --- /dev/null +++ b/ISAJET/code/isabeg.F @@ -0,0 +1,210 @@ +#include "isajet/pilot.h" + SUBROUTINE ISABEG(IFL) +C---------------------------------------------------------------------- +C- +C- Purpose and Methods : +C- Initialize a process before event generation +C- +C- Created 5-FEB-1988 Serban D. Protopopescu +C- +C Ver 7.14: Do logic after setting physics parameters +C---------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/nodcay.inc" +#include "isajet/idrun.inc" +#include "isajet/keys.inc" +#include "isajet/primar.inc" +#include "isajet/jetpar.inc" +#include "isajet/isloop.inc" +#include "isajet/xmssm.inc" +#include "isajet/isapw.inc" +C + INTEGER IFL,I + LOGICAL FIRST + SAVE FIRST + CHARACTER*30 ISAPW2 + SAVE ISAPW2 + DATA FIRST/.TRUE./ +C ISAPW2 is used to check whether ALDATA is loaded + DATA ISAPW2/'ALDATA REQUIRED BY FORTRAN G,H'/ +C +C Initialize +C + IF(ISAPW1.NE.ISAPW2) THEN + PRINT*, ' ISABEG ERROR: BLOCK DATA ALDATA HAS NOT BEEN LOADED.' + PRINT*, ' ISAJET CANNOT RUN WITHOUT IT.' + PRINT*, ' PLEASE READ THE FINE MANUAL FOR ISAJET.' + STOP99 + ENDIF +C + IF (FIRST) THEN + FIRST=.FALSE. + ELSE + CALL SETNXT + ENDIF + IEVT=0 + IEVGEN=0 + NEVENT=0 + IEVOL=1 + IFRG=1 +C +C Read in user data and decay table +C + + CALL READIN(IFL) + IF(IFL.NE.0) GOTO 999 + CALL IDGEN + IF(GOMSSM) THEN + CALL DOMSSM + ENDIF + IF (KEYS(10).AND..NOT.GOMSSM) THEN + CALL SETH + END IF + CALL SETDKY(.FALSE.) +C +C Generate NSIGMA unevolved events for SIGF calculation +C +C TWOJET events + IF(KEYS(1)) THEN + CALL MBSET + CALL SETW + CALL LOGIC + CALL PRTLIM + CALL PTFUN + DO 105 I=1,NSIGMA +105 CALL TWOJET + CALL TIMER(1) +C +C E+E- events + ELSE IF(KEYS(2)) THEN + CALL SETW + CALL LOGIC + CALL PRTLIM + CALL EEBEG + CALL EEMAX + DO 205 I=1,NSIGMA +205 CALL ELCTRN + CALL TIMER(1) +C +C DRELLYAN events + ELSE IF(KEYS(3)) THEN + CALL SETW + CALL MBSET + CALL LOGIC + CALL PRTLIM + CALL QFUNC + DO 305 I=1,NSIGMA +305 CALL DRLLYN + CALL TIMER(1) +C +C MINBIAS events + ELSE IF(KEYS(4)) THEN + PBEAM(1)=HALFE + PBEAM(2)=HALFE + CALL PRTLIM + CALL MBSET + CALL TIMER(1) +C +C SUPERSYM events + ELSE IF(KEYS(5)) THEN + CALL SETW + CALL MBSET + CALL LOGIC + CALL PRTLIM + CALL PTFUN + DO 505 I=1,NSIGMA +505 CALL TWOJET + CALL TIMER(1) +C +C WPAIR events + ELSE IF(KEYS(6)) THEN + CALL SETW + CALL MBSET + CALL LOGIC + CALL PRTLIM + CALL PTFUN + DO 605 I=1,NSIGMA + CALL TWOJET +605 CALL WPAIR + CALL TIMER(1) +C +C HIGGS events + ELSE IF(KEYS(7)) THEN + CALL SETW + IF(GOMSSM) THEN + CALL SETHSS + ELSE + CALL SETH + ENDIF + CALL MBSET + CALL LOGIC + CALL PRTLIM + CALL QFUNC + DO 705 I=1,NSIGMA +705 CALL DRLLYN + CALL TIMER(1) +C +C PHOTON events + ELSEIF(KEYS(8)) THEN + CALL MBSET + CALL SETW + CALL LOGIC + CALL PRTLIM + CALL PTFUN + DO 805 I=1,NSIGMA +805 CALL TWOJET + CALL TIMER(1) +C +C TCOLOR events + ELSE IF(KEYS(9)) THEN + CALL SETW + CALL MBSET + CALL LOGIC + CALL PRTLIM + CALL QFUNC + DO 905 I=1,NSIGMA +905 CALL DRLLYN + CALL TIMER(1) +C +C WHIGGS events + ELSE IF(KEYS(10)) THEN + CALL SETW + CALL MBSET + CALL LOGIC + CALL PRTLIM + CALL PTFUN + DO 906 I=1,NSIGMA + CALL TWOJET +906 CALL WHIGGS + CALL TIMER(1) +C +C EXTRADIM events + ELSE IF(KEYS(11)) THEN + CALL SETW + CALL SETKKG + CALL MBSET + CALL LOGIC + CALL PRTLIM + CALL QFUNC + DO 1105 I=1,NSIGMA + CALL DRLLYN +1105 CONTINUE + CALL TIMER(1) +C +C ZJJ events +C ZJJ0 initializes cross sections, so no event loop + ELSEIF(KEYS(12)) THEN + CALL SETW + CALL MGINIT + CALL MBSET + CALL LOGIC + CALL PRTLIM + CALL ZJJ0 + CALL TIMER(1) + ELSE + STOP 99 + ENDIF +999 RETURN + END diff --git a/ISAJET/code/isabg2.F b/ISAJET/code/isabg2.F new file mode 100644 index 00000000000..1ed37168c76 --- /dev/null +++ b/ISAJET/code/isabg2.F @@ -0,0 +1,209 @@ +#include "isajet/pilot.h" + SUBROUTINE ISABG2(IFL) +C---------------------------------------------------------------------- +C- +C- Purpose and Methods : +C- Initialize a process before event generation +C- +C- Created 5-FEB-1988 Serban D. Protopopescu +C- +C Ver 7.14: Do logic after setting physics parameters +C---------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/nodcay.inc" +#include "isajet/idrun.inc" +#include "isajet/keys.inc" +#include "isajet/primar.inc" +#include "isajet/jetpar.inc" +#include "isajet/isloop.inc" +#include "isajet/xmssm.inc" +#include "isajet/isapw.inc" +C + INTEGER IFL,I + LOGICAL FIRST + SAVE FIRST + CHARACTER*30 ISAPW2 + SAVE ISAPW2 + DATA FIRST/.TRUE./ +C ISAPW2 is used to check whether ALDATA is loaded + DATA ISAPW2/'ALDATA REQUIRED BY FORTRAN G,H'/ +C +C Initialize +C + IF(ISAPW1.NE.ISAPW2) THEN + PRINT*, ' ISABEG ERROR: BLOCK DATA ALDATA HAS NOT BEEN LOADED.' + PRINT*, ' ISAJET CANNOT RUN WITHOUT IT.' + PRINT*, ' PLEASE READ THE FINE MANUAL FOR ISAJET.' + STOP99 + ENDIF +C + IF (FIRST) THEN + FIRST=.FALSE. + ELSE + CALL SETNXT + ENDIF + IEVT=0 + IEVGEN=0 + NEVENT=0 + IEVOL=1 + IFRG=1 +C +C Read in user data and decay table +C +C CALL READIN(IFL) +C IF(IFL.NE.0) GOTO 999 + CALL IDGEN + IF(GOMSSM) THEN + CALL DOMSSM + ENDIF + IF (KEYS(10).AND..NOT.GOMSSM) THEN + CALL SETH + END IF + CALL SETDKY(.FALSE.) +C +C Generate NSIGMA unevolved events for SIGF calculation +C +C TWOJET events + IF(KEYS(1)) THEN + CALL MBSET + CALL SETW + CALL LOGIC + CALL PRTLIM + CALL PTFUN + DO 105 I=1,NSIGMA +105 CALL TWOJET + CALL TIMER(1) +C +C E+E- events + ELSE IF(KEYS(2)) THEN + CALL SETW + CALL LOGIC + CALL PRTLIM + CALL EEBEG + CALL EEMAX + DO 205 I=1,NSIGMA +205 CALL ELCTRN + CALL TIMER(1) +C +C DRELLYAN events + ELSE IF(KEYS(3)) THEN + CALL SETW + CALL MBSET + CALL LOGIC + CALL PRTLIM + CALL QFUNC + DO 305 I=1,NSIGMA +305 CALL DRLLYN + CALL TIMER(1) +C +C MINBIAS events + ELSE IF(KEYS(4)) THEN + PBEAM(1)=HALFE + PBEAM(2)=HALFE + CALL PRTLIM + CALL MBSET + CALL TIMER(1) +C +C SUPERSYM events + ELSE IF(KEYS(5)) THEN + CALL SETW + CALL MBSET + CALL LOGIC + CALL PRTLIM + CALL PTFUN + DO 505 I=1,NSIGMA +505 CALL TWOJET + CALL TIMER(1) +C +C WPAIR events + ELSE IF(KEYS(6)) THEN + CALL SETW + CALL MBSET + CALL LOGIC + CALL PRTLIM + CALL PTFUN + DO 605 I=1,NSIGMA + CALL TWOJET +605 CALL WPAIR + CALL TIMER(1) +C +C HIGGS events + ELSE IF(KEYS(7)) THEN + CALL SETW + IF(GOMSSM) THEN + CALL SETHSS + ELSE + CALL SETH + ENDIF + CALL MBSET + CALL LOGIC + CALL PRTLIM + CALL QFUNC + DO 705 I=1,NSIGMA +705 CALL DRLLYN + CALL TIMER(1) +C +C PHOTON events + ELSEIF(KEYS(8)) THEN + CALL MBSET + CALL SETW + CALL LOGIC + CALL PRTLIM + CALL PTFUN + DO 805 I=1,NSIGMA +805 CALL TWOJET + CALL TIMER(1) +C +C TCOLOR events + ELSE IF(KEYS(9)) THEN + CALL SETW + CALL MBSET + CALL LOGIC + CALL PRTLIM + CALL QFUNC + DO 905 I=1,NSIGMA +905 CALL DRLLYN + CALL TIMER(1) +C +C WHIGGS events + ELSE IF(KEYS(10)) THEN + CALL SETW + CALL MBSET + CALL LOGIC + CALL PRTLIM + CALL PTFUN + DO 906 I=1,NSIGMA + CALL TWOJET +906 CALL WHIGGS + CALL TIMER(1) +C +C EXTRADIM events + ELSE IF(KEYS(11)) THEN + CALL SETW + CALL SETKKG + CALL MBSET + CALL LOGIC + CALL PRTLIM + CALL QFUNC + DO 1105 I=1,NSIGMA + CALL DRLLYN +1105 CONTINUE + CALL TIMER(1) +C +C ZJJ events +C ZJJ0 initializes cross sections, so no event loop + ELSEIF(KEYS(12)) THEN + CALL SETW + CALL MGINIT + CALL MBSET + CALL LOGIC + CALL PRTLIM + CALL ZJJ0 + CALL TIMER(1) + ELSE + STOP 99 + ENDIF +999 RETURN + END diff --git a/ISAJET/code/isaend.F b/ISAJET/code/isaend.F new file mode 100644 index 00000000000..5011e1f2f01 --- /dev/null +++ b/ISAJET/code/isaend.F @@ -0,0 +1,14 @@ +#include "isajet/pilot.h" + SUBROUTINE ISAEND +C---------------------------------------------------------------------- +C- +C- Purpose and Methods : +C- Terminate an ISAJET run +C- +C- Created 4-FEB-1988 Serban D. Protopopescu +C- +C---------------------------------------------------------------------- + CALL TIMER(2) + CALL GETTOT(.TRUE.) + 999 RETURN + END diff --git a/ISAJET/code/isaevt.F b/ISAJET/code/isaevt.F new file mode 100644 index 00000000000..c7988887d56 --- /dev/null +++ b/ISAJET/code/isaevt.F @@ -0,0 +1,312 @@ +#include "isajet/pilot.h" + SUBROUTINE ISAEVT(I,OK,DONE) +C---------------------------------------------------------------------- +C- +C- Purpose and Methods : +C- +C- Normal operation: +C- Generate one ISAJET event and return. +C- +C- "ISALEP" generation: +C- Generate a TWOJET or DRELLYAN hard scattering. Then make NEVOLVE +C- evolutions and NHADRON fragmentations, rejecting events which +C- fail the desired cuts using logical functions +C- REJJET() tests the QCD evolution stage, e.g. by requiring +C- a heavy quark. +C- REJFRG() tests the fragmentation stage, e.g. by requiring +C- a high-pt lepton. +C- These functions default to .FALSE.; i.e. they do not reject any +C- events. Note that one hard scattering can give more than one +C- event. You must choose NEVOLVE and NHADRON carefully. +C- IEVT = event number. This is incremented NEVOLVE * NHADRON +C- times for each hard scattering; i.e. it counts the +C- number of potential events. +C- IEVGEN = counter for generated events. +C- NEVENT = maximum value of hard scatterings. Hence the limit +C- for IEVT is NEVENT * NEVOLVE * NHADRON. +C- The cross section SIGF contains an extra factor of +C- 1 / (NEVOLVE * NHADRON) +C- to produce the correct final cross section using the weight +C- SIGF / NEVENT +C- +C- Input: +C- I = number used to control printout +C- Output: +C- OK = logical flag for good event. +C- DONE = logical flag for job completion. +C- +C- Created 3-FEB-1988 Serban D. Protopopescu +C- Updated 17-APR-1990 Serban D. Protopopescu (add ISALEP option) +C- 22-JUL-1992: Move PRTEVT and GETTOT statements to end so they +C- work for TWOJET and DRELLYAN with NOVOLVE. (FEP) +C- +C---------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/idrun.inc" +#include "isajet/keys.inc" +#include "isajet/nodcay.inc" +#include "isajet/primar.inc" +#include "isajet/jetpar.inc" +#include "isajet/partcl.inc" +#include "isajet/jetset.inc" +#include "isajet/isloop.inc" +C + LOGICAL REJJET,REJFRG,OK,DONE + INTEGER NPASS,I,NLIMIT +C + NPASS=0 + OK=.TRUE. + DONE=.FALSE. + NLIMIT=NEVENT*NEVOLV*NFRGMN +C +C Twojet or Drell-Yan events. The evolution and fragmentation +C loops are done with GO TO statements so that we can exit +C the loops with a good event and reenter them. +C + IF(KEYS(1).OR.KEYS(3)) THEN +100 CONTINUE + IF(IEVOL.EQ.1.AND.IFRG.EQ.1) THEN + NPASS=NPASS+1 + IF(NPASS.GT.NTRIES) THEN + WRITE(ITLIS,1001) NTRIES +1001 FORMAT(//' IT IS TAKING MORE THAN',I6,' TRIES TO MAKE', + $ ' AN EVENT IN ISAEVT.'/ + $ ' CHECK YOUR LIMITS OR OR INCREASE NTRIES.'/ + $ ' CHECK NEVOLVE, NHADRON, AND YOUR REJJET AND REJFRG', + $ ' FUNCTIONS IF ANY.'/ + $ ' JOB TERMINATED.') + STOP 99 + ENDIF + CALL RANFMT +C Generate appropriate hard scattering + IF(KEYS(1)) THEN + CALL TWOJET + ELSE + CALL DRLLYN + ENDIF + ENDIF +C QCD evolution + IF(NOEVOL) THEN + IEVT=IEVT+NEVOLV*NFRGMN + GOTO 9999 + ENDIF +C Continue if in fragmentation loop + IF(IFRG.NE.1) GO TO 120 +C Begin multiple evolution loop +110 CONTINUE + NJSET=0 + IEVT=IEVT+1 + CALL EVOLVE + IEVT=IEVT-1 + IF(NJSET.LT.0) THEN + IEVT=IEVT+NFRGMN + GO TO 111 + ENDIF + IF(REJJET()) THEN + IEVT=IEVT+NFRGMN + GO TO 111 + ENDIF + IF(NOHADR) THEN + IEVT=IEVT+NFRGMN + GO TO 9999 + ENDIF +C Begin multiple fragmentation loop +120 CONTINUE + NPTCL=0 + CALL FRGMNT + IEVT=IEVT+1 + IF(REJFRG()) GO TO 121 +C Finish good event + CALL MBIAS + IFRG=IFRG+1 + IF(IFRG.GT.NFRGMN) IFRG=1 + IF(IFRG.EQ.1) THEN + IEVOL=IEVOL+1 + IF(IEVOL.GT.NEVOLV) IEVOL=1 + ENDIF + GOTO 9999 +C Fragmentation failed - increment counter and loop +121 IFRG=IFRG+1 + IF(IFRG.GT.NFRGMN) THEN + IFRG=1 + ELSE + GO TO 120 + ENDIF +C End of multiple fragmentation loop +C Evolution failed - increment counter and loop +111 IEVOL=IEVOL+1 + IF(IEVOL.GT.NEVOLV) THEN + IEVOL=1 + IFRG=1 + GO TO 100 + ELSE + GO TO 110 + ENDIF +C +C E+E- events +C + ELSE IF(KEYS(2)) THEN + IEVT=IEVT+1 + CALL RANFMT + CALL ELCTRN + IF(.NOT.NOEVOL) THEN + CALL EVOLVE + IF(.NOT.NOHADR) CALL FRGMNT + ENDIF +C +C MINBIAS events +C + ELSE IF(KEYS(4)) THEN + IEVT=IEVT+1 + CALL RANFMT + NPTCL=0 + IF(.NOT.(NOEVOL.OR.NOHADR)) CALL MBIAS +C +C SUPERSYM events +C + ELSE IF(KEYS(5)) THEN + IEVT=IEVT+1 + CALL RANFMT + CALL TWOJET + IF(.NOT.NOEVOL) THEN + CALL EVOLVE + IF(NJSET.LT.0) GO TO 9999 + IF(.NOT.NOHADR) THEN + CALL FRGMNT + CALL MBIAS + ENDIF + ENDIF +C +C WPAIR events +C + ELSE IF(KEYS(6)) THEN + IEVT=IEVT+1 + CALL RANFMT + CALL TWOJET + CALL WPAIR +C + IF(.NOT.NOEVOL) THEN + CALL EVOLVE + IF(NJSET.LT.0) GO TO 9999 + IF(.NOT.NOHADR) THEN + CALL FRGMNT + CALL MBIAS + ENDIF + ENDIF +C +C HIGGS events +C + ELSE IF(KEYS(7)) THEN + IEVT=IEVT+1 + CALL RANFMT + CALL DRLLYN + CALL HIGGS + IF(.NOT.NOEVOL) THEN + CALL EVOLVE + IF(NJSET.LT.0) GOTO 9999 + IF(.NOT.NOHADR) THEN + CALL FRGMNT + CALL MBIAS + ENDIF + ENDIF +C +C PHOTON events +C + ELSEIF(KEYS(8)) THEN + IEVT=IEVT+1 + CALL RANFMT + CALL TWOJET + IF(.NOT.NOEVOL) THEN + CALL EVOLVE + IF(NJSET.LT.0) GOTO 9999 + IF(.NOT.NOHADR) THEN + CALL FRGMNT + CALL MBIAS + ENDIF + ENDIF +C +C TCOLOR events, e.g. techni-rho +C + ELSEIF(KEYS(9)) THEN + IEVT=IEVT+1 + CALL RANFMT + CALL DRLLYN + CALL HIGGS + IF(.NOT.NOEVOL) THEN + CALL EVOLVE + IF(NJSET.LT.0) GOTO 9999 + IF(.NOT.NOHADR) THEN + CALL FRGMNT + CALL MBIAS + ENDIF + ENDIF +C +C WHIGGS events +C + ELSE IF(KEYS(10)) THEN + IEVT=IEVT+1 + CALL RANFMT + CALL TWOJET + CALL WHIGGS +C + IF(.NOT.NOEVOL) THEN + CALL EVOLVE + IF(NJSET.LT.0) GO TO 9999 + IF(.NOT.NOHADR) THEN + CALL FRGMNT + CALL MBIAS + ENDIF + ENDIF +C +C EXTRADIM events +C + ELSE IF(KEYS(11)) THEN + IEVT=IEVT+1 + CALL RANFMT + CALL DRLLYN +C + IF(.NOT.NOEVOL) THEN + CALL EVOLVE + IF(NJSET.LT.0) GO TO 9999 + IF(.NOT.NOHADR) THEN + CALL FRGMNT + CALL MBIAS + ENDIF + ENDIF +C +C ZJJ events +C + ELSEIF(KEYS(12)) THEN + IEVT=IEVT+1 + CALL RANFMT + CALL ZJJ +C + IF(.NOT.NOEVOL) THEN + CALL EVOLVE + IF(NJSET.LT.0) GO TO 9999 + IF(.NOT.NOHADR) THEN + CALL FRGMNT + CALL MBIAS + ENDIF + ENDIF + ENDIF +C +C Event complete +C + 9999 IEVGEN=IEVGEN+1 + IF(NJSET.LT.0) OK=.FALSE. + IF(IEVT.GT.NLIMIT) THEN + OK=.FALSE. + DONE=.TRUE. + ELSEIF(IEVT.EQ.NLIMIT) THEN + DONE=.TRUE. + ENDIF + IF(OK) THEN + CALL PRTEVT(I) + CALL GETTOT(.FALSE.) + ENDIF + RETURN + END diff --git a/ISAJET/code/isaini.F b/ISAJET/code/isaini.F new file mode 100644 index 00000000000..0a311a399e9 --- /dev/null +++ b/ISAJET/code/isaini.F @@ -0,0 +1,40 @@ +#include "isajet/pilot.h" + SUBROUTINE ISAINI(JTDKY,JTEVT,JTCOM,JTLIS) +C---------------------------------------------------------------------- +C- +C- Purpose and Methods : +C- INITIALIZE PROCESSES +C- +C- Inputs : +C JTDKY = +/- UNIT NUMBER FOR DECAY TABLE FILE. +C IF IT IS NEGATIVE, DECAY TABLE IS NOT PRINTED. +C JTEVT = +/- UNIT NUMBER FOR OUTPUT EVENT FILE. +C IF IT IS NEGATIVE, ONLY STABLE PARTICLES ARE +C WRITTEN ON IT. +C JTCOM = UNIT NUMBER FOR COMMAND FILE. +C JTLIS = UNIT NUMBER FOR LISTING. +C- +C- Created 3-FEB-1988 Serban D. Protopopescu +C- +C---------------------------------------------------------------------- +C +#include "isajet/idrun.inc" +#include "isajet/itapes.inc" +C +C ENTRY. + ITDKY=IABS(JTDKY) + ITEVT=JTEVT + ITCOM=IABS(JTCOM) + ITLIS=IABS(JTLIS) +C + IEVT=0 + CALL SETCON + CALL RESET + IF(JTDKY.GT.0) THEN + CALL SETDKY(.TRUE.) + ELSE + CALL SETDKY(.FALSE.) + ENDIF +C + 999 RETURN + END diff --git a/ISAJET/code/isajet.F b/ISAJET/code/isajet.F new file mode 100644 index 00000000000..47f67a7b28b --- /dev/null +++ b/ISAJET/code/isajet.F @@ -0,0 +1,78 @@ +#include "isajet/pilot.h" + SUBROUTINE ISAJET(JTDKY,JTEVT,JTCOM,JTLIS) +C +C Main subroutine for ISAJET, a Monte Carlo event generator +C for P P , AP P , and E+ E- interactions at high energy. +C +C Frank E. Paige and Serban D. Protopopescu +C Brookhaven National Laboratory +C Upton, New York, USA +C +C JTDKY = +/- unit number for decay table file. +C If it is negative, decay table is not printed. +C JTEVT = +/- unit number for output event file. +C If it is negative, only stable particles are +C written on it. +C JTCOM = unit number for command file. +C JTLIS = unit number for listing. +C +C Instead of calling this subroutine the user may wish to +C control the program himself using: +C ISAINI overall initialization +C ISABEG run initialization +C ISAEVT generation of one event +C ISAEND run termination +C ISAWBG initial record writing +C ISAWEV event record writing +C ISAWND end record writing +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/idrun.inc" +#include "isajet/primar.inc" +#include "isajet/isloop.inc" +C + INTEGER JTDKY,JTEVT,JTCOM,JTLIS,IFL,ILOOP + LOGICAL OK,DONE + SAVE ILOOP +C +C Initialize ISAJET +C + CALL ISAINI(JTDKY,JTEVT,JTCOM,JTLIS) +C +C Read instructions; terminate for STOP command or error. +C + 1 IFL=0 + CALL ISABEG(IFL) + IF(IFL.NE.0) RETURN +C Write begin-run record + CALL ISAWBG +C +C Event loop +C + ILOOP=0 + 101 CONTINUE + ILOOP=ILOOP+1 +C Generate one event - discard if .NOT.OK + CALL ISAEVT(ILOOP,OK,DONE) +C Write event record + IF(OK) CALL ISAWEV + IF(.NOT.DONE) GO TO 101 +C +C Calculate cross section and luminosity +C + CALL ISAEND +C Write end-of-run record + CALL ISAWND + GO TO 1 +C +C Entry point for error recovery. +C CALL RSTART will continue generation on next event. +C + ENTRY RSTART + IF(IEVT.EQ.0) RETURN + IF(IEVT.GE.NEVENT*NEVOLV*NFRGMN) GO TO 1 + GO TO 101 + END diff --git a/ISAJET/code/isasrt.F b/ISAJET/code/isasrt.F new file mode 100644 index 00000000000..5d7856c49fb --- /dev/null +++ b/ISAJET/code/isasrt.F @@ -0,0 +1,44 @@ +#include "isajet/pilot.h" + SUBROUTINE ISASRT(X,NCH,IMAP) +C---------------------------------------------------------------------- +C- +C- Purpose and Methods : Sorts a floating point array X into ascending order. +C- The array IMAP contains ordered list of pointers +C- +C- Inputs : X - Floating point array +C- NCH - Number of elements in X +C- Outputs : IMAP - pointer to ordered list in X +C- Controls: None +C- +C- Created 3-OCT-1988 Rajendran Raja +C- Based on the Algorithm of D.L.Shell, High speed sorting +C- procedure , Communications of the ACM, Vol 2, July 1959, PP 30-32 +C---------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + REAL X(*) + REAL TEMP + INTEGER IMAP(*),NCH,M,I,J,K,IM,IT +C---------------------------------------------------------------------- + M=NCH + 10 M=M/2 !binary chop + IF(M.EQ.0)GO TO 999 + K=NCH-M + J=1 + 20 I=J + 30 IM=I+M + IF(X(I).LE.X(IM))GO TO 40 + TEMP = X(I) + X(I) = X(IM) + X(IM) = TEMP + IT = IMAP(I) + IMAP(I)=IMAP(IM) + IMAP(IM)=IT + I = I-M + IF(I.GE.1)GO TO 30 + 40 J=J+1 + IF(J.GT.K)GO TO 10 + GO TO 20 + 999 RETURN + END diff --git a/ISAJET/code/ispjet.F b/ISAJET/code/ispjet.F new file mode 100644 index 00000000000..feb197bac99 --- /dev/null +++ b/ISAJET/code/ispjet.F @@ -0,0 +1,175 @@ +#include "isajet/pilot.h" + SUBROUTINE ISPJET(DRCUT,ETCUT,NPJ,PJPT,PJPHI,PJETA) +C---------------------------------------------------------------------- +C- +C- Purpose and Methods : COMBINES PARTONS INTO PARTON JETS +C- based on PJCONE +C- Inputs +C- DRCUT - dR=sqrt(dETA**2+dPHI**2) cut around Leading Partons. +C- ETCUT - Transverse Energy cut (minimum for defining a JET ). +C- +C- Outputs : +C- NPJ = No. of Parton Jets found. +C- PJPT(NPJ) = pt of partons +C- PJPHI(NPJ)= phi " +C- PJETA(NPJ)= eta " +C- +C- created 16-APR-1996 Serban D. Protopopescu +C- Updated 16-JUN-1998 F. Paige +C- Copy of ISAZEB routine ISA_PJETS to be used by IPARTNS +C- +C---------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/pjets.inc" +#include "isajet/jetset.inc" +C + INTEGER NPJ + REAL DRCUT + REAL PJPHI(*), PJETA(*), PJPT(*) + INTEGER NP, JP, J, JO, JOP1, JOP2, JP1, JP2, ISKP, IP + REAL X1, Y1, PHI1, PHI2,TH + REAL DETA, DPHI, DR, ETCUT + INTEGER NPMAX + PARAMETER (NPMAX=50) + INTEGER JIORD(NPMAX), JDORD(NPMAX), JCNN(NPMAX,NPMAX) + INTEGER JSKP(NPMAX) + INTEGER I, JJ, K + REAL PJIN(4,NPMAX), PINPHI(NPMAX), PINETA(NPMAX) + REAL PINPT(NPMAX),PDMPT(NPMAX) + REAL PJ(4,NPMAX) + REAL EPS + DOUBLE PRECISION PI, TWOPI, HALFPI, RADIAN +C +C last significant (correctly rounded) decimal place on VAX: +C | +C V + PARAMETER (PI= 3.1415 92653 58979 32384 6 D0) + PARAMETER (TWOPI= 6.2831 85307 17958 64769 3 D0) + PARAMETER (HALFPI= 1.5707 96326 79489 66192 3 D0) + PARAMETER (RADIAN= 0.0174532 92519 94329 5769237 D0) +C + PARAMETER( EPS = 1.0E-5 ) +C---------------------------------------------------------------------- +C + NP=0 + DO 10 I=1,NJSET + IF(JDCAY(I).EQ.0.AND.IABS(JTYPE(I)).LT.10) THEN + NP = NP + 1 + DO 11 K=1,4 + PJIN(K,NP)=PJSET(K,I) + 11 CONTINUE + PINPT(NP) = SQRT( PJIN(1,NP)**2+PJIN(2,NP)**2 ) + PINPHI(NP) = ATAN2 (PJIN(2,NP),PJIN(1,NP)+EPS) + IF(PINPHI(NP).LT.0.)PINPHI(NP)=PINPHI(NP)+TWOPI + TH = ATAN2 (PINPT(NP),PJIN(3,NP)+EPS) + PINETA(NP) = -ALOG ( ABS(TAN(TH/2.)) + EPS ) + IF(NP.GE.NPMAX) GOTO 35 + ENDIF + 10 CONTINUE + 35 CONTINUE ! jump here if more than NPMAX partons +C +C ... Order partons in pt +C + DO 100 JP = 1 , NP + JIORD(JP) = JP + 100 PDMPT(JP)=PINPT(JP) + CALL ISASRT(PDMPT(1),NP,JIORD) + DO 105 JP = 1 , NP + 105 JDORD(JP) = JIORD(NP-JP+1) +C +C ... Combine partons close in r space +C + DO 110 J = 1 , NP + JO=JDORD(J) + 110 JCNN(JO,1)=0 + ISKP=0 + DO 120 JP1 = 1 , NP-1 + JOP1=JDORD(JP1) +C ... Check if parton already connected to other one + IF ( JCNN(JOP1,1).EQ.-1 ) GOTO 120 + DO 130 JP2 = JP1+1 , NP + JOP2=JDORD(JP2) +C ... Check if parton already connected to other one + IF ( JCNN(JOP2,1).EQ.-1 ) GOTO 130 + DETA = PINETA(JOP1) - PINETA(JOP2) + PHI1 = PINPHI(JOP1) + PHI2 = PINPHI(JOP2) + X1 = COS(PHI2-PHI1) + Y1 = SIN(PHI2-PHI1) + IF(X1.EQ.0.0) THEN + DPHI = HALFPI + ELSE + DPHI = ATAN2(Y1,X1) + END IF + DR = SQRT(DETA**2+DPHI**2) +C --- Criterion for combining partons + IF ( DR.LT.DRCUT ) THEN + JCNN(JOP1,1)=JCNN(JOP1,1)+1 + JCNN(JOP2,1)=-1 + JCNN(JOP1,JCNN(JOP1,1)+1)=JOP2 + ISKP=ISKP+JCNN(JOP1,1) + JSKP(ISKP)=JOP2 + ELSE + GOTO 130 + ENDIF + 130 CONTINUE + 120 CONTINUE +C +C ... Bookkeeping for parton jets +C + DO 150 IP = 1 , NPJ + PJPHI(IP)=0. + PJETA(IP)=0. + PJPT(IP) =0. + 150 CONTINUE + NPJ=0 + DO 200 JP1 = 1 , NP + JOP1=JDORD(JP1) +C ... Already connected, single parton, or has others to connect to + IF ( JCNN(JOP1,1).GE.0 ) THEN + NPJ=NPJ+1 + DO 151 K=1,4 + PJ(K,NPJ)=PJIN(K,JOP1) + 151 CONTINUE + PJPHI(NPJ) = PINPHI(JOP1) + PJETA(NPJ) = PINETA(JOP1) + PJPT(NPJ) = PINPT(JOP1) + IF ( JCNN(JOP1,1).EQ.0 ) GOTO 205 + DO 210 JJ = 1 , JCNN(JOP1,1) + PJ(1,NPJ) = PJ(1,NPJ) + PJIN(1,JCNN(JOP1,JJ+1)) + PJ(2,NPJ) = PJ(2,NPJ) + PJIN(2,JCNN(JOP1,JJ+1)) + PJ(3,NPJ) = PJ(3,NPJ) + PJIN(3,JCNN(JOP1,JJ+1)) + PJ(4,NPJ) = PJ(4,NPJ) + PJIN(4,JCNN(JOP1,JJ+1)) + 210 CONTINUE + PJPT(NPJ) = SQRT( PJ(1,NPJ)**2 + PJ(2,NPJ)**2 ) + PJPHI(NPJ) = ATAN2 (PJ(2,NPJ),PJ(1,NPJ)+EPS) + IF(PJPHI(NPJ).LT.0.)PJPHI(NPJ)=PJPHI(NPJ)+TWOPI + TH = ATAN2 (PJPT(NPJ),PJ(3,NPJ)+EPS) + PJETA(NPJ) = -ALOG ( ABS(TAN(TH/2.)) + EPS ) +C ... Criterion for dropping a parton jet ( et < etcut ) + 205 IF ( PJPT(NPJ).GT.ETCUT ) GOTO 200 + NPJ=NPJ-1 + ENDIF + 200 CONTINUE +C +C ... Order pjets in pt +C + DO 300 JP = 1 , NPJ + JIORD(JP) = JP + 300 PDMPT(JP)=PJPT(JP) + CALL ISASRT(PDMPT(1),NPJ,JIORD) + DO 305 JP = 1 , NPJ + PINPT(JP)=PJPT(JP) + PINETA(JP)=PJETA(JP) + PINPHI(JP)=PJPHI(JP) + 305 JDORD(JP) = JIORD(NPJ-JP+1) + DO 306 JP = 1 , NPJ + PJPT(JP)=PINPT(JDORD(JP)) + PJETA(JP)=PINETA(JDORD(JP)) + PJPHI(JP)=PINPHI(JDORD(JP)) + 306 CONTINUE +C- + 999 RETURN + END diff --git a/ISAJET/code/istrad.F b/ISAJET/code/istrad.F new file mode 100644 index 00000000000..12dd11d33b1 --- /dev/null +++ b/ISAJET/code/istrad.F @@ -0,0 +1,41 @@ +#include "isajet/pilot.h" + SUBROUTINE ISTRAD(FUDGE) +C---------------------------------------------------------------------- +C- +C- Purpose and Methods : +C- Set parameters and call QCDINI to generate initial +C- state radiation +C- Inputs : +C- FUDGE= fudge factor +C- +C- Created 16-AUG-1991 Serban D. Protopopescu +C- +C---------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + REAL FUDGE +#include "isajet/limevl.inc" +#include "isajet/jetset.inc" +#include "isajet/jwork.inc" +#include "isajet/jetpar.inc" + REAL OFF + INTEGER I +C---------------------------------------------------------------------- +C + IF ( USELIM.AND.CONCUT.LT.1.0 ) THEN + OFF=ETTHRS + ELSEIF( .NOT.USELIM) THEN + OFF=SQRT(QSQ)*FUDGE + ELSE + OFF=SQRT(QSQ) + ENDIF + DO 150 I=1,2 + PJSET(5,I)=-OFF +150 JDCAY(I)=-2 + JMATCH(1)=0 + JMATCH(2)=0 +C + CALL QCDINI(1,2) + 999 RETURN + END diff --git a/ISAJET/code/iswdky.F b/ISAJET/code/iswdky.F new file mode 100644 index 00000000000..470515a6418 --- /dev/null +++ b/ISAJET/code/iswdky.F @@ -0,0 +1,181 @@ +#include "isajet/pilot.h" + SUBROUTINE ISWDKY +C---------------------------------------------------------------------- +C- +C- Purpose and Methods : +C- decay W's and Z's as done in ISAJET +C- +C- Created 6-MAY-1991 Serban D. Protopopescu +C- +C---------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/const.inc" +#include "isajet/frame.inc" +#include "isajet/jetpar.inc" +#include "isajet/jetset.inc" +#include "isajet/jwork.inc" +#include "isajet/pjets.inc" +#include "isajet/partcl.inc" +#include "isajet/primar.inc" +#include "isajet/wcon.inc" + REAL X(2) + EQUIVALENCE (X(1),X1) + REAL PREST(5),PL(5),EL(3),EML(3),EMSQL(3) + REAL WTFAC(3) + REAL BRANCH(29) + INTEGER LISTJ(29),LISTW(4) + REAL RANF,SUM,PTDEN,QDEN,ETA, + $S12,SUMBR,BRMODE,AMASS,BRINV,TRY,PL12, + $COSTHL,THL,PHL,PTL,SGN,BP,PLPL,PLMN,AMINI,AMFIN,PINI,PFIN, + $ QPL,QMN,AM1SQ,AM2SQ,ROOT,P1PL,P1MN,P2PL,P2MN + INTEGER NADD,K,IQ1,IQ2,IFL1,IFL2,IQ,IFL,I + REAL EY + REAL QWPL,QWMN +C + DATA LISTJ/ + $9,1,-1,2,-2,3,-3,4,-4,5,-5,6,-6, + $11,-11,12,-12,13,-13,14,-14,15,-15,16,-16, + $10,80,-80,90/ + DATA LISTW/10,80,-80,90/ +C---------------------------------------------------------------------- +C +C Entry +C + NPTCL=0 +C +C Kinematics. Note that YW is the true rapidity and QW is +C the true 3-momentum. See DRLLYN. +C + QMW=QWJET(5) + QTW=SQRT(QWJET(1)**2+QWJET(2)**2) + QW=SQRT(QWJET(1)**2+QWJET(2)**2+QWJET(3)**2) + IF(QTW.NE.0) THEN + PHIW=ATAN2(QWJET(2),QWJET(1)) + IF(PHIW.LT.0) PHIW=PHIW+2*PI + ELSE + PHIW=0 + ENDIF + QWPL=QWJET(4)+QWJET(3) + QWMN=QWJET(4)-QWJET(3) + IF(QWPL.GT.0..AND.QWMN.GT.0.) THEN + YW=0.5*ALOG(QWPL/QWMN) + ELSE + YW=999.*SIGN(1.,QWJET(3)) + ENDIF + IF(QW.NE.0.) THEN + THW=ACOS(QWJET(3)/QW) + ELSE + THW=0. + ENDIF +C +C Select W decay mode +C QMW dependence neglected in branching ratios +C BRANCH is cum. br. with heavy modes subtracted. +C + S12=QMW**2 + BRANCH(1)=0. + SUMBR=0. + DO 105 IQ1=2,25 + IQ2=MATCH(IQ1,JWTYP) + IF(IQ2.EQ.0) THEN + BRMODE=0. + ELSE + BRMODE=WCBR(IQ1,JWTYP)-WCBR(IQ1-1,JWTYP) + IFL1=LISTJ(IQ1) + IFL2=LISTJ(IQ2) + IF(S12.LE.(AMASS(IFL1)+AMASS(IFL2))**2) BRMODE=0. + ENDIF + BRANCH(IQ1)=BRANCH(IQ1-1)+BRMODE + SUMBR=SUMBR+BRMODE +105 CONTINUE + BRINV=1./SUMBR +C + TRY=RANF() + DO 110 IQ=1,25 + IF(TRY.LT.BRANCH(IQ)*BRINV.AND.MATCH(IQ,JWTYP).NE.0) THEN + JETTYP(1)=IQ + JETTYP(2)=MATCH(IQ,JWTYP) + GO TO 120 + ENDIF +110 CONTINUE +C +120 IFL1=LISTJ(JETTYP(1)) + IFL2=LISTJ(JETTYP(2)) +C +C Select masses of decay products. +C + EML(1)=AMASS(IFL1) + EML(2)=AMASS(IFL2) +C +C Generate W decay in its rest frame +C First set up momenta of decay products: +C + EMSQL(1)=EML(1)**2 + EMSQL(2)=EML(2)**2 + EL(1)=(S12+EMSQL(1)-EMSQL(2))/(2.*QMW) + EL(2)=(S12+EMSQL(2)-EMSQL(1))/(2.*QMW) + PL12=SQRT((S12-(EML(1)+EML(2))**2)*(S12-(EML(1)-EML(2))**2)) + $/(2.*QMW) +C W momentum + DO 140 K=1,5 +140 PREST(K)=QWJET(K) +C Generate next W decay +20 CONTINUE + COSTHL=2.*RANF()-1. + THL=ACOS(COSTHL) + PHL=2.*PI*RANF() + PTL=PL12*SIN(THL) +C + DO 300 I=1,2 + SGN=3-2*I + PL(1)=SGN*PTL*COS(PHL) + PL(2)=SGN*PTL*SIN(PHL) + PL(3)=SGN*PL12*COSTHL + PL(4)=EL(I) + PL(5)=EML(I) +C Boost with W momentum + BP=0. + DO 310 K=1,3 +310 BP=BP+PL(K)*PREST(K) + BP=BP/PREST(5) + DO 320 K=1,3 +320 PL(K)=PL(K)+PREST(K)*PL(4)/PREST(5) + $ +PREST(K)*BP/(PREST(4)+PREST(5)) + PL(4)=PL(4)*PREST(4)/PREST(5)+BP +C Fill common blocks + PT(I)=SQRT(PL(1)**2+PL(2)**2) + P(I)=SQRT(PT(I)**2+PL(3)**2) + IF(PT(I).GT.0.) THEN + PHI(I)=ATAN2(PL(2),PL(1)) + ELSE + PHI(I)=(I-1)*PI + ENDIF + IF(PHI(I).LT.0.) PHI(I)=PHI(I)+2.*PI + CTH(I)=PL(3)/P(I) + STH(I)=PT(I)/P(I) + TH(I)=ACOS(CTH(I)) + XJ(I)=PL(3)/HALFE + IF(CTH(I).GT.0.) THEN + PLPL=PL(4)+PL(3) + PLMN=(PT(I)**2+EMSQL(I))/PLPL + ELSE + PLMN=PL(4)-PL(3) + PLPL=(PT(I)**2+EMSQL(I))/PLMN + ENDIF + YJ(I)=.5*ALOG(PLPL/PLMN) +300 CONTINUE +C +C Set PJETS +C + DO 501 I=1,2 + PJETS(3,I)=P(I)*CTH(I) + PJETS(1,I)=PT(I)*COS(PHI(I)) + PJETS(2,I)=PT(I)*SIN(PHI(I)) + PJETS(4,I)=SQRT(P(I)**2+EMSQL(I)) + PJETS(5,I)=SQRT(EMSQL(I)) + IDJETS(I)=LISTJ(JETTYP(I)) +501 CONTINUE + 999 RETURN + END diff --git a/ISAJET/code/jetgen.F b/ISAJET/code/jetgen.F new file mode 100644 index 00000000000..cc03a1e5624 --- /dev/null +++ b/ISAJET/code/jetgen.F @@ -0,0 +1,189 @@ +#include "isajet/pilot.h" + SUBROUTINE JETGEN(J) +C +C FRAGMENT JET J IN /JETSET/ INTO PRIMARY HADRONS USING THE +C ALGORITHM OF FIELD AND FEYNMAN WITH +C F(X)=1-XGEN(1)+XGEN(1)*(XGEN(2)+1)*(1-X)**XGEN(2) +C FOR LIGHT QUARKS AND THE PETERSON F(X) WITH +C EPSILON=XGEN(I)*AMASS(I)**2 +C FOR HEAVY QUARKS. +C INCLUDE BARYONS USING DIQUARKS WITH PROBABILITY PBARY. +C PROBABILITY PSPIN1 FOR SPIN 1 DEPENDS ON HEAVIEST FLAVOR. +C FRAGMENT A GLUON LIKE A RANDOM QUARK. +C +C Ver 7.30: Use delta function fragmentation for top quark. +C +C +#include "isajet/itapes.inc" +#include "isajet/jetset.inc" +#include "isajet/partcl.inc" +#include "isajet/frgpar.inc" +#include "isajet/const.inc" +#include "isajet/mbpar.inc" +C + LOGICAL HEAVY + NBEGIN=NPTCL+1 + PSUM=0. + IFLBEG=JTYPE(J) + HEAVY=.FALSE. + IF(IABS(IFLBEG).GT.3.AND.IFLBEG.NE.9) HEAVY=.TRUE. + PBEG=SQRT(PJSET(1,J)**2+PJSET(2,J)**2+PJSET(3,J)**2) +C TOP QUARK... + IF(IABS(IFLBEG).GE.6.AND.IABS(IFLBEG).LE.8) THEN + NPTCL=NPTCL+1 + PPTCL(1,NPTCL)=0 + PPTCL(2,NPTCL)=0 + PPTCL(3,NPTCL)=PBEG + PPTCL(4,NPTCL)=PJSET(4,J) + PPTCL(5,NPTCL)=PJSET(5,J) + IORIG(NPTCL)=-J + IDCAY(NPTCL)=0 + IDENT(NPTCL)=JTYPE(J) + RETURN + ENDIF +C EQUIVALENT QUARK FOR GLUON + IF(IFLBEG.NE.9) GO TO 200 + IFLBEG=INT(RANF()/PUD)+1 + IF(RANF().GT..5) IFLBEG=-IFLBEG +C CONSTRUCT FIRST QUARK +200 LOOP=0 + IFL1=IFLBEG + CALL GETPT(PT1,SIGQT) + PHI1=2.*PI*RANF() + PX1=PT1*COS(PHI1) + PY1=PT1*SIN(PHI1) + PPLUS=PBEG+PJSET(4,J) + PTRUE=PPLUS +935 CONTINUE +C CONSTRUCT NEXT QUARK +300 LOOP=LOOP+1 + IF(PPLUS.LT.PEND.OR.LOOP.GT.10000) RETURN +C IFL2 CAN BE DIQUARK ONLY IF IFL1 IS NOT + IF(MOD(IFL1,100).EQ.0) GO TO 305 + IF(RANF().LT.PBARY) GO TO 310 + IFL2=ISIGN(INT(RANF()/PUD)+1,-IFL1) + GO TO 320 +305 IFL2=ISIGN(INT(RANF()/PUD)+1,+IFL1) + GO TO 320 +310 IQ1=INT(RANF()/PUD)+1 + IQ2=INT(RANF()/PUD)+1 + IF(IQ1.LE.IQ2) GO TO 315 + ISWAP=IQ1 + IQ1=IQ2 + IQ2=ISWAP +315 IFL2=ISIGN(1000*IQ1+100*IQ2,IFL1) +320 CONTINUE + CALL GETPT(PT2,SIGQT) + PHI2=2.*PI*RANF() + PX2=PT2*COS(PHI2) + PY2=PT2*SIN(PHI2) +C CONSTRUCT MESON WITH FLAVOR MIXING +C SPECIAL CASE - SUPERSYM + IFLABS=IABS(IFL1) + IF(IFLABS.GT.20.AND.IFLABS.LT.30) THEN + IDHAD=IFL1 + GOTO 470 + ENDIF + IF(MOD(IFL1,100).EQ.0) GO TO 420 + IF(MOD(IFL2,100).EQ.0) GO TO 425 + IHIGH=MAX0(IABS(IFL1),IABS(IFL2)) + JSPIN=INT(RANF()+PSPIN1(IHIGH)) + ID1=IFL1 + ID2=IFL2 + IF(ID1+ID2.NE.0) GO TO 400 + RND=RANF() + ID1=IABS(ID1) + ID1=INT(PMIX1(ID1,JSPIN+1)+RND)+INT(PMIX2(ID1,JSPIN+1)+RND)+1 + ID2=-ID1 +400 IF(IABS(ID1).LE.IABS(ID2)) GO TO 410 + ISAVE=ID1 + ID1=ID2 + ID2=ISAVE +410 IDHAD=ISIGN(100*IABS(ID1)+10*IABS(ID2)+JSPIN,ID1) + GO TO 470 +C CONSTRUCT BARYON IDENT. +420 ID3=MOD(IFL1/100,10) + ID2=IFL1/1000 + ID1=IFL2 + GO TO 430 +425 ID3=MOD(IFL2/100,10) + ID2=IFL2/1000 + ID1=IFL1 +430 IF(IABS(ID1).LE.IABS(ID2)) GO TO 431 + ISWAP=ID1 + ID1=ID2 + ID2=ISWAP +431 IF(IABS(ID2).LE.IABS(ID3)) GO TO 432 + ISWAP=ID2 + ID2=ID3 + ID3=ISWAP +432 IF(IABS(ID1).LE.IABS(ID2)) GO TO 440 + ISWAP=ID1 + ID1=ID2 + ID2=ISWAP +440 JSPIN=1 + IF(ID1.EQ.ID2.AND.ID2.EQ.ID3) GO TO 450 + IHIGH=IABS(ID3) + JSPIN=INT(RANF()+PSPIN1(IHIGH)) +450 IF(JSPIN.EQ.1.OR.ID1.EQ.ID2.OR.ID2.EQ.ID3) GO TO 460 + IF(RANF().GT.PISPN) GO TO 460 + ISWAP=ID1 + ID1=ID2 + ID2=ISWAP +460 IDHAD=1000*IABS(ID1)+100*IABS(ID2)+10*IABS(ID3)+JSPIN + IDHAD=ISIGN(IDHAD,IFL1) +470 CONTINUE + AM=AMASS(IDHAD) + PX=PX1+PX2 + PY=PY1+PY2 + AMT2=PX**2+PY**2+AM**2 +C IF LEADING PARTICLE, FIND MINIMUM X + XMIN=0. + IF(LOOP.EQ.1) XMIN=AMIN1(SQRT(AMT2)/PPLUS,1.) +C SELECT X +C USE FIELD-FEYNMAN FUNCTION FOR LIGHT QUARKS. +C USE PETERSON FRAGMENTATION FOR HEAVY QUARKS. +C USE DISTRIBUTION FOR HEAVIER QUARK FOR DIQUARKS. + II1=IABS(IFL1) + IF(MOD(II1,100).EQ.0) II1=MOD(II1/100,10) + IF(II1.LE.3) THEN + X=RANF() + IF(RANF().LT.XGEN(1)) X=1.-X**(1./(XGEN(2)+1.)) + ELSEIF(II1.LE.9) THEN + CALL HEAVYX(X,XGEN(II1)/AM**2) + ELSEIF(II1.GT.20.AND.II1.LT.30) THEN + CALL HEAVYX(X,XGENSS(II1-20)/AM**2) + ENDIF + X=XMIN+(1.-XMIN)*X + QPLUS=X*PPLUS + QPLUS=AMAX1(QPLUS,1.E-6) + QMINUS=AMT2/QPLUS + P0=.5*(QPLUS+QMINUS) + PZ=.5*(QPLUS-QMINUS) +C DISCARD PARTICLE IF PZ<0 + IF(PZ.LT.0..AND..NOT.(HEAVY.AND.LOOP.EQ.1)) GO TO 500 +C ADD PARTICLE TO /PARTCL/ + IF(NPTCL.GE.MXPTCL) GO TO 9999 + NPTCL=NPTCL+1 + PPTCL(1,NPTCL)=PX + PPTCL(2,NPTCL)=PY + PPTCL(3,NPTCL)=PZ + PPTCL(4,NPTCL)=P0 + PPTCL(5,NPTCL)=AM + IORIG(NPTCL)=-J + IDCAY(NPTCL)=0 + IDENT(NPTCL)=IDHAD + PSUM=PSUM+QPLUS +C SWAP QUARKS AND CONTINUE IF SUFFICIENT PPLUS +500 CONTINUE + PX1=-PX2 + PY1=-PY2 + IFL1=-IFL2 + PPLUS=(1.-X)*PPLUS + GO TO 300 +C +9999 CALL PRTEVT(0) + WRITE(ITLIS,10) NPTCL +10 FORMAT(//5X,'ERROR IN JETGEN...NPTCL >',I5) + RETURN + END diff --git a/ISAJET/code/kkgf1.F b/ISAJET/code/kkgf1.F new file mode 100644 index 00000000000..1417c97bd71 --- /dev/null +++ b/ISAJET/code/kkgf1.F @@ -0,0 +1,13 @@ +#include "isajet/pilot.h" + REAL FUNCTION KKGF1(S,T,M2) + REAL S,T,M2 + REAL XG,YG + XG = T/S + YG = M2/S + KKGF1 = + & ( -4.*XG*(1.+XG)*(1.+2.*XG+2.*XG**2) + & + YG*(1.+6.*XG+18.*XG**2+16.*XG**3) + & - 6.*YG**2*XG*(1.+2.*XG) + YG**3*(1.+4.*XG) ) / + & ( XG*(YG-1.-XG) ) + RETURN + END diff --git a/ISAJET/code/kkgf2.F b/ISAJET/code/kkgf2.F new file mode 100644 index 00000000000..336a46eabdc --- /dev/null +++ b/ISAJET/code/kkgf2.F @@ -0,0 +1,12 @@ +#include "isajet/pilot.h" + REAL FUNCTION KKGF2(S,T,M2) + REAL S,T,M2 + REAL XG,YG + XG = T/S + YG = M2/S + KKGF2 = + & ( -4.*XG*(1.+XG**2) + YG*(1.+XG)*(1.+8.*XG+XG**2) - + & 3.*YG**2*(1.+4.*XG+XG**2) + 4.*YG**3*(1.+XG) - 2.*YG**4 ) / + & ( XG*(YG-1.-XG) ) + RETURN + END diff --git a/ISAJET/code/kkgf3.F b/ISAJET/code/kkgf3.F new file mode 100644 index 00000000000..39ec91df525 --- /dev/null +++ b/ISAJET/code/kkgf3.F @@ -0,0 +1,12 @@ +#include "isajet/pilot.h" + REAL FUNCTION KKGF3(S,T,M2) + REAL S,T,M2 + REAL XG,YG + XG = T/S + YG = M2/S + KKGF3 = + & ( 1. + 2.*XG + 3.*XG**2 + 2.*XG**3 + XG**4 - 2.*YG*(1.+XG**3) + & + 3.*YG**2*(1.+XG**2) - 2.*YG**3*(1.+XG) + YG**4 ) / + & ( XG*(YG-1.-XG) ) + RETURN + END diff --git a/ISAJET/code/label.F b/ISAJET/code/label.F new file mode 100644 index 00000000000..38c04f36e04 --- /dev/null +++ b/ISAJET/code/label.F @@ -0,0 +1,254 @@ +#include "isajet/pilot.h" + FUNCTION LABEL(ID) +C +C Return the CHARACTER*8 label for the particle ID. +C Quark-based IDENT code. +C MSSM names for squarks, sleptons, Higgs bosons. +C +C Ver. 7.49: Offset of INDEX must match that in FLAVOR. +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/qlmass.inc" +C +#if defined(CERNLIB_LEVEL2) +C DUMMY COMMON BLOCK TO ALLOW LEVEL2 STORAGE. + COMMON/XLABEL/LLEP,LMES0,LMES1,LBAR0,LABAR0,LBAR1,LABAR1,LQQ,LAQQ + LEVEL2,/XLABEL/ +#endif + INTEGER ID + CHARACTER*8 LABEL + CHARACTER*8 LLEP,LMES0,LMES1,LBAR0,LABAR0,LBAR1,LABAR1 + CHARACTER*8 LQQ,LAQQ + DIMENSION LLEP(149) + DIMENSION LMES0(64),LMES1(64) + DIMENSION LBAR0(109),LABAR0(109),LBAR1(109),LABAR1(109) + DIMENSION LQQ(21),LAQQ(21) + INTEGER IFL1,IFL2,IFL3,JSPIN,INDEX,I,J,IDABS +C +C Diquark labels +C + DATA LQQ/ + 1'UU0. ','UD0. ','DD0. ','US0. ','DS0. ','SS0. ','UC0. ','DC0. ', + 2'SC0. ','CC0. ','UB0. ','DB0. ','SB0. ','CB0. ','BB0. ','UT0. ', + 3'DT0. ','ST0. ','CT0. ','BT0. ','TT0. '/ + DATA LAQQ/ + 1'AUU0.','AUD0.','ADD0.','AUS0.','ADS0.','ASS0.','AUC0.','ADC0.', + 2'ASC0.','ACC0.','AUB0.','ADB0.','ASB0.','ACB0.','ABB0.','AUT0.', + 3'ADT0.','AST0.','ACT0.','ABT0.','ATT0.'/ +C +C Quark and lepton labels +C + DATA LLEP/ + $' ','UP ','UB ','DN ','DB ','ST ','SB ','CH ', + $'CB ','BT ','BB ','TP ','TB ','Y ','YB ','X ', + $'XB ','GL ','ERR ','GM ','ERR ','NUE ','ANUE ','E- ', + $'E+ ','NUM ','ANUM ','MU- ','MU+ ','NUT ','ANUT ','TAU- ', + $'TAU+ ','ERR ','ERR ','ERR ','ERR ','ERR ','ERR ','KS ', + $'ERR ','ERR ','KL ', + $'UPL ','UBL ','DNL ','DBL ','STL ','SBL ','CHL ','CBL ', + $'BT1 ','BB1 ','TP1 ','TB1 ','ERR ','ERR ','ERR ','ERR ', + $'GLSS ','ERR ','Z1SS ','ERR ','NUEL ','ANUEL','EL- ','EL+ ', + $'NUML ','ANUML','MUL- ','MUL+ ','NUTL ','ANUTL','TAU1-','TAU1+', + $'ERR ','ERR ','ERR ','ERR ','W1SS+','W1SS-','Z2SS ','ERR ', + $'UPR ','UBR ','DNR ','DBR ','STR ','SBR ','CHR ','CBR ', + $'BT2 ','BB2 ','TP2 ','TB2 ','ERR ','ERR ','ERR ','ERR ', + $'W2SS+','W2SS-','Z3SS ','ERR ','NUER ','ANUER','ER- ','ER+ ', + $'NUMR ','ANUMR','MUR- ','MUR+ ','NUTR ','ANUTR','TAU2-','TAU2+', + $'ERR ','ERR ','ERR ','ERR ','ERR ','ERR ','Z4SS ','ERR ', + $'W+ ','W- ','HIGGS','ERR ','HL0 ','ERR ','HH0 ','ERR ', + $'HA0 ','ERR ','H40 ','AH40 ','H+ ','H- ','H2+ ','H2- ', + $'H1++ ','H1-- ','H2++ ','H2-- ','Z0 ','ERR ','GVSS ','ERR ', + $'GRAV ','ERR '/ +C +C 0- meson labels +C + DATA LMES0/ + 1'PI0 ','PI+ ','ETA ','PI- ','K+ ','K0 ','ETAP ','AK0 ', + 2'K- ','AD0 ','D- ','DS- ','ETAC ','DS+ ','D+ ','D0 ', + 2'B+ ','B0 ','BS ','BC ','ETAB ','ABC ','ABS ','AB0 ', + 3'B- ','UT. ','DT. ','ST. ','CT. ','BT. ','TT. ','TB. ', + 4'TC. ','TS. ','TD. ','TU. ','UY. ','DY. ','SY. ','CY. ', + 5'BY. ','TY. ','YY. ','YT. ','YB. ','YC. ','YS. ','YD. ', + 6'YU. ','UX. ','DX. ','SX. ','CX. ','BX. ','TX. ','YX. ', + 7'XX. ','XY. ','XT. ','XB. ','XC. ','XS. ','XD. ','XU. '/ +C +C 1- meson labels +C + DATA LMES1/ + 1'RHO0 ','RHO+ ','OMEG ','RHO- ','K*+ ','K*0 ','PHI ','AK*0 ', + 2'K*- ','AD*0 ','D*- ','DS*- ','JPSI ','DS*+ ','D*+ ','D*0 ', + 3'B*+ ','B*0 ','BS* ','BC* ','UPSL ','ABC* ','ABS* ','AB0* ', + 4'B*- ','UT* ','DT* ','ST* ','CT* ','BT* ','TT* ','TB* ', + 5'TC* ','TS* ','TD* ','TU* ','UY* ','DY* ','SY* ','CY* ', + 6'BY* ','TY* ','YY* ','YT* ','YB* ','YC* ','YS* ','YD* ', + 7'YU* ','UX* ','DX* ','SX* ','CX* ','BX* ','TX* ','YX* ', + 8'XX* ','XY* ','XT* ','XB* ','XC* ','XS* ','XD* ','XU* '/ +C +C 1/2+ baryon labels +C + DATA LBAR0/ + 1'ERR ','P ','N ','ERR ','ERR ','S+ ','S0 ','S- ', + 2'L ','XI0 ','XI- ','ERR ','ERR ','ERR ','SC++ ','SC+ ', + 3'SC0 ','LC+ ','USC. ','DSC. ','SSC. ','SDC. ','SUC. ','UCC. ', + 4'DCC. ','SCC. ','ERR ','ERR ','ERR ','ERR ','UUB. ','UDB. ', + 5'DDB. ','DUB. ','USB. ','DSB. ','SSB. ','SDB. ','SUB. ','UCB. ', + 6'DCB. ','SCB. ','CCB. ','CSB. ','CDB. ','CUB. ','UBB. ','DBB. ', + 7'SBB. ','CBB. ','ERR ','ERR ','ERR ','ERR ','ERR ','UUT. ', + 8'UDT. ','DDT. ','DUT. ','UST. ','DST. ','SST. ','SDT. ','SUT. ', + 9'UCT. ','DCT. ','SCT. ','CCT. ','CST. ','CDT. ','CUT. ','UBT. ', + 1'DBT. ','SBT. ','CBT. ','BBT. ','BCT. ','BST. ','BDT. ','BUT. ', + 2'UTT. ','DTT. ','STT. ','CTT. ','BTT. ','ERR ','ERR ','ERR ', + 3'ERR ','ERR ','ERR ','UUY. ','UDY. ','DDY. ','DUY. ','USY. ', + 4'DSY. ','SSY. ','SDY. ','SUY. ','UUX. ','UDX. ','DDX. ','DUX. ', + 5'USX. ','DSX. ','SSX. ','SDX. ','SUX. '/ + DATA LABAR0/ + 1'ERR ','AP ','AN ','ERR ','ERR ','AS- ','AS0 ','AS+ ', + 2'AL ','AXI0 ','AXI+ ','ERR ','ERR ','ERR ','ASC--','ASC- ', + 3'ASC0 ','ALC- ','AUSC.','ADSC.','ASSC.','ASDC.','ASUC.','AUCC.', + 4'ADCC.','ASCC.','ERR ','ERR ','ERR ','ERR ','AUUB.','AUDB.', + 5'ADDB.','ADUB.','AUSB.','ADSB.','ASSB.','ASDB.','ASUB.','AUCB.', + 6'ADCB.','ASCB.','ACCB.','ACSB.','ACDB.','ACUB.','AUBB.','ADBB.', + 7'ASBB.','ACBB.','ERR ','ERR ','ERR ','ERR ','ERR ','AUUT.', + 8'AUDT.','ADDT.','ADUT.','AUST.','ADST.','ASST.','ASDT.','ASUT.', + 9'AUCT.','ADCT.','ASCT.','ACCT.','ACST.','ACDT.','ACUT.','AUBT.', + 1'ADBT.','ASBT.','ACBT.','ABBT.','ABCT.','ABST.','ABDT.','ABUT.', + 2'AUTT.','ADTT.','ASTT.','ACTT.','ABTT.','ERR ','ERR ','ERR ', + 3'ERR ','ERR ','ERR ','AUUY.','AUDY.','ADDY.','ADUY.','AUSY.', + 4'ADSY.','ASSY.','ASDY.','ASUY.','AUUX.','AUDX.','ADDX.','ADUX.', + 5'AUSX.','ADSX.','ASSX.','ASDX.','ASUX.'/ +C +C 3/2+ baryon labels +C + DATA LBAR1/ + 1'DL++ ','DL+ ','DL0 ','DL- ','ERR ','S*+ ','S*0 ','S*- ', + 2'ERR ','XI*0 ','XI*- ','OM- ','ERR ','ERR ','UUC* ','UDC* ', + 3'DDC* ','ERR ','USC* ','DSC* ','SSC* ','ERR ','ERR ','UCC* ', + 4'DCC* ','SCC* ','CCC* ','ERR ','ERR ','ERR ','UUB* ','UDB* ', + 5'DDB* ','ERR ','USB* ','DSB* ','SSB* ','ERR ','ERR ','UCB* ', + 6'DCB* ','SCB* ','CCB* ','ERR ','ERR ','ERR ','UBB* ','DBB* ', + 7'SBB* ','CBB* ','BBB* ','ERR ','ERR ','ERR ','ERR ','UUT* ', + 8'UDT* ','DDT* ','ERR ','UST* ','DST* ','SST* ','ERR ','ERR ', + 9'UCT* ','DCT* ','SCT* ','CCT* ','ERR ','ERR ','ERR ','UBT* ', + 1'DBT* ','SBT* ','CBT* ','BBT* ','ERR ','ERR ','ERR ','ERR ', + 2'UTT* ','DTT* ','STT* ','CTT* ','BTT* ','TTT* ','ERR ','ERR ', + 3'ERR ','ERR ','ERR ','UUY* ','UDY* ','DDY* ','ERR ','USY* ', + 4'DSY* ','SSY* ','ERR ','ERR ','UUX* ','UDX* ','DDX* ','ERR ', + 5'USX* ','DSX* ','SSX* ','ERR ','ERR '/ + DATA LABAR1/ + 1'ADL--','ADL- ','ADL0 ','ADL+ ','ERR ','AS*- ','AS*0 ','AS*+ ', + 2'ERR ','AXI*0','AXI*+','AOM+ ','ERR ','ERR ','AUUC*','AUDC*', + 3'ADDC*','ERR ','AUSC*','ADSC*','ASSC*','ERR ','ERR ','AUCC*', + 4'ADCC*','ASCC*','ACCC*','ERR ','ERR ','ERR ','AUUB*','AUDB*', + 5'ADDB*','ERR ','AUSB*','ADSB*','ASSB*','ERR ','ERR ','AUCB*', + 6'ADCB*','ASCB*','ACCB*','ERR ','ERR ','ERR ','AUBB*','ADBB*', + 7'ASBB*','ACBB*','ABBB*','ERR ','ERR ','ERR ','ERR ','AUUT*', + 8'AUDT*','ADDT*','ERR ','AUST*','ADST*','ASST*','ERR ','ERR ', + 9'AUCT*','ADCT*','ASCT*','ACCT*','ERR ','ERR ','ERR ','AUBT*', + 1'ADBT*','ASBT*','ACBT*','ABBT*','ERR ','ERR ','ERR ','ERR ', + 2'AUTT*','ADTT*','ASTT*','ACTT*','ABTT*','ATTT*','ERR ','ERR ', + 3'ERR ','ERR ','ERR ','AUUY*','AUDY*','ADDY*','ERR ','AUSY*', + 4'ADSY*','ASSY*','ERR ','ERR ','AUUX*','AUDX*','ADDX*','ERR ', + 5'AUSX*','ADSX*','ASSX*','ERR ','ERR '/ +C +C Entry +C + LABEL='ERR' + IDABS=IABS(ID) + IF(IDABS.EQ.0) THEN + LABEL=' ' + RETURN + ENDIF + CALL FLAVOR(ID,IFL1,IFL2,IFL3,JSPIN,INDEX) + IF(INDEX.LE.0) RETURN + IF(IDABS.GT.10000.OR.JSPIN.GT.1) GO TO 500 + IF(IDABS.LT.100) GO TO 200 + IF(IDABS.LT.1000) GO TO 100 + IF(ID.NE.0.AND.MOD(ID,100).EQ.0) GO TO 300 +C +C Baryons +C + INDEX=INDEX-109*JSPIN-36*NMES-NQLEP + INDEX=INDEX-13 + IF(JSPIN.EQ.0.AND.ID.GT.0) LABEL=LBAR0(INDEX) + IF(JSPIN.EQ.0.AND.ID.LT.0) LABEL=LABAR0(INDEX) + IF(JSPIN.EQ.1.AND.ID.GT.0) LABEL=LBAR1(INDEX) + IF(JSPIN.EQ.1.AND.ID.LT.0) LABEL=LABAR1(INDEX) + GO TO 999 +C +C Mesons +C +100 CONTINUE + I=MAX0(IFL2,IFL3) + J=-MIN0(IFL2,IFL3) + INDEX=MAX0(I-1,J-1)**2+I+MAX0(I-J,0) + IF(JSPIN.EQ.0) LABEL=LMES0(INDEX) + IF(JSPIN.EQ.1) LABEL=LMES1(INDEX) + GO TO 999 +C +C Quarks, leptons, etc. +C +200 CONTINUE + INDEX=2*INDEX + IF(ID.LE.0) INDEX=INDEX+1 + LABEL=LLEP(INDEX) + GO TO 999 +300 I=IABS(IFL1) + J=IABS(IFL2) + INDEX=I+J*(J-1)/2 + IF(ID.GT.0) LABEL=LQQ(INDEX) + IF(ID.LT.0) LABEL=LAQQ(INDEX) + RETURN +C +C Special hadrons - used only in B decays +C +500 CONTINUE + IF(ID.EQ.10121) THEN + LABEL='A1+' + ELSEIF(ID.EQ.-10121) THEN + LABEL='A1-' + ELSEIF(ID.EQ.10111) THEN + LABEL='A10' + ELSEIF(ID.EQ.10131) THEN + LABEL='K1+' + ELSEIF(ID.EQ.-10131) THEN + LABEL='K1-' + ELSEIF(ID.EQ.10231) THEN + LABEL='K10' + ELSEIF(ID.EQ.-10231) THEN + LABEL='AK10' + ELSEIF(ID.EQ.30131) THEN + LABEL='K1*+' + ELSEIF(ID.EQ.-30131) THEN + LABEL='K1*-' + ELSEIF(ID.EQ.30231) THEN + LABEL='K1*0' + ELSEIF(ID.EQ.-30231) THEN + LABEL='AK1*0' + ELSEIF(ID.EQ.132) THEN + LABEL='K2*+' + ELSEIF(ID.EQ.-132) THEN + LABEL='K2*-' + ELSEIF(ID.EQ.232) THEN + LABEL='K2*0' + ELSEIF(ID.EQ.-232) THEN + LABEL='AK2*0' + ELSEIF(ID.EQ.10110) THEN + LABEL='F0' + ELSEIF(ID.EQ.112) THEN + LABEL='F2' + ELSEIF(ID.EQ.10441) THEN + LABEL='PSI2' + ELSEIF(ID.EQ.20440) THEN + LABEL='CHI0' + ELSEIF(ID.EQ.20441) THEN + LABEL='CHI1' + ELSEIF(ID.EQ.20442) THEN + LABEL='CHI2' + ELSE + LABEL='ERR' + ENDIF +999 RETURN + END diff --git a/ISAJET/code/lboost.F b/ISAJET/code/lboost.F new file mode 100644 index 00000000000..3f987ec08d4 --- /dev/null +++ b/ISAJET/code/lboost.F @@ -0,0 +1,19 @@ +#include "isajet/pilot.h" + SUBROUTINE LBOOST(PREST,N,P1,P2) +C +C BOOST 4-VECTORS P1 TO PREST REST FRAME +C PUT RESULTING 4-VECTORS IN P2 +C +#include "isajet/itapes.inc" + DIMENSION PREST(4),P1(4,N),P2(4,N) + DO 1 I=1,N + WCN=SQRT(PREST(4)**2-PREST(1)**2-PREST(2)**2-PREST(3)**2) + II=(I-1)*4 + P2(4,I)=(P1(4,I)*PREST(4)-P1(1,I)*PREST(1)-P1(2,I)*PREST(2) + 1 -P1(3,I)*PREST(3))/WCN + FACT=(P2(4,I)+P1(4,I))/(WCN+PREST(4)) + DO 2 K=1,3 + 2 P2(K,I)=P1(K,I)-FACT*PREST(K) + 1 CONTINUE + RETURN + END diff --git a/ISAJET/code/logerr.F b/ISAJET/code/logerr.F new file mode 100644 index 00000000000..248f1b13762 --- /dev/null +++ b/ISAJET/code/logerr.F @@ -0,0 +1,90 @@ +#include "isajet/pilot.h" + SUBROUTINE LOGERR(IMSG,I,IERR) +C +C ERROR MESSAGES +C +#include "isajet/itapes.inc" +#include "isajet/jetlim.inc" +#include "isajet/primar.inc" +#include "isajet/jetpar.inc" +#include "isajet/const.inc" +#include "isajet/dylim.inc" +#include "isajet/keys.inc" +#include "isajet/q1q2.inc" + +C +C ERRORS IN JET PARAMETERS +C + IERR=IERR+1 + IF(IMSG.EQ.0) WRITE(ITLIS,81) +81 FORMAT(//5X,'DEFAULT LIMITS HAVE BEEN SET') + IF(IMSG.EQ.1) WRITE(ITLIS,1001) I,PMIN(I),PMAX(I) + 1001 FORMAT(//10X,'BAD LIMITS FOR P(',I2,')=',2E12.4) + IF(IMSG.EQ.2) WRITE(ITLIS,1002) I,PTMIN(I),PTMAX(I) + 1002 FORMAT(//10X,'BAD LIMITS FOR PT(',I2,')=',2E12.4) + IF(IMSG.EQ.3) WRITE(ITLIS,1003) I,THMIN(I),THMAX(I) + 1003 FORMAT(//10X,'BAD LIMITS FOR THETA(',I2,')=',2E12.4) + IF(IMSG.EQ.4) WRITE(ITLIS,1004) I,XJMIN(I),XJMAX(I) + 1004 FORMAT(//10X,'BAD LIMITS FOR X(',I2,')=',2E12.4) + IF(IMSG.EQ.5) WRITE(ITLIS,1005) I,XJ(I),P(I) + 1005 FORMAT(//5X,'X AND P FOR JET',I2,' ARE INCOMPATIBLE',2E12.4) + IF(IMSG.EQ.6) WRITE(ITLIS,1006) I,THMIN(I),THMAX(I) + 1006 FORMAT(//10X,'LIMITS FOR THETA MUST BE .GT.0 AND .LT.PI. PRESENT' + C ,' LIMITS FOR JET NO.',I3,' ARE',2E12.4) + IF(IMSG.EQ.7) WRITE(ITLIS,1007) I,XJ(I),X1,X2 + 1007 FORMAT(//5X,'FIXED X VALUE FOR JET NO.',I3,' IS',E12.4,2X, + C 'THIS IS INCOMPATIBLE WITH ALLOWED X LIMITS',2E12.4) +C +C ERRORS IN W(Z0) PARAMETERS +C + IF(IMSG.EQ.101) WRITE(ITLIS,901) XW,XWMIN,XWMAX + 901 FORMAT(//5X,'CHOICE OF PARAMETERS GIVES A FIXED XW',E12.4, + C ' ,THIS VALUE IS INCOMPATIBLE WITH THE LIMITS',2E12.4) + IF(IMSG.EQ.102) WRITE(ITLIS,902) YW,YWMIN,YWMAX + 902 FORMAT(//5X,'CHOICE OF PARAMETERS GIVES A FIXED YW', + C E12.4,' ,THIS VALUE IS INCOMPATIBLE WITH THE LIMITS ') + IF(IMSG.EQ.103) WRITE(ITLIS,903) QMW,QMIN,QMAX + 903 FORMAT(//5X,'CHOICE OF PARAMETERS GIVES A FIXED QMW', + C E12.4,' ,THIS VALUE IS INCOMPATIBLE WITH THE LIMITS', + C E12.4) + IF(IMSG.EQ.104) WRITE(ITLIS,904) XW,YW,QTW + 904 FORMAT(//5X,'FIXED VALUES FOR XW,YW,AND QTW',3E12.4, + C ' ARE UNPHYSICAL') + IF(IMSG.EQ.105) WRITE(ITLIS,905) QTW,QTMIN,QTMAX + 905 FORMAT(//5X,'CHOICE OF PARAMETERS GIVES A FIXED QTW',E12.4 + C ,' ,THIS VALUE IS INCOMPATIBLE WITH THE LIMITS',2E12.4) + IF(IMSG.EQ.106) WRITE(ITLIS,906) XW,YW,QMW + 906 FORMAT(//5X,'FIXED VALUS FOR XW,YW,AND QMW',3E12.4, + C ' ARE UNPHYSICAL') + IF(IMSG.EQ.107) WRITE(ITLIS,907) QTMIN,QTMAX + 907 FORMAT(//5X,'BAD LIMITS FOR QTW',2E12.4) + IF(IMSG.EQ.108) WRITE(ITLIS,908) QMIN,QMAX + 908 FORMAT(//5X,'BAD LIMITS FOR QMW',2E12.4) + IF(IMSG.EQ.109) WRITE(ITLIS,909) THWMIN,THWMAX + 909 FORMAT(//5X,'BAD LIMITS FOR THW',2E12.4,2X,' REMEMBER TH MUST', + C ' BE IN RADIANS AND LIE BETWEEN 0 AND PI') + IF(IMSG.EQ.110) WRITE(ITLIS,910) PHWMIN,PHWMAX + 910 FORMAT(//5X,'BAD LIMITS FOR PHW',2E12.4,' ,REMEMBER PHW MUST', + C ' BE IN RADIANS AND PHMAX-PHMIN MUST BE LESS THAN 2PI') + IF(IMSG.EQ.111) WRITE(ITLIS,911) XWMIN,XWMAX + 911 FORMAT(//5X,'BAD LIMITS FOR XW',2E12.4) + IF(IMSG.EQ.112) WRITE(ITLIS,912) YWMIN,YWMAX + 912 FORMAT(//5X,'BAD LIMITS FOR YW',2E12.4) + IF(IMSG.EQ.113) WRITE(ITLIS,913) + 913 FORMAT(//5X,'SORRY, BUT YOU CANNOT FIX THETA FOR DRELLYAN EVENTS.' + C,' THINK OF SOMETHING ELSE.') + IF(IMSG.EQ.114) WRITE(ITLIS,914) + 914 FORMAT(//5X,'YOU CANNOT FIX PARAMETERS FOR THE DECAY OF A', + C ' DRELL YAN JET') + IF(IMSG.EQ.115) WRITE(ITLIS,915) + 915 FORMAT(//5X,'YOU CANNOT FIX QTW,QMW,YW AND XW SIMULTANEUOSLY') +C +C ERRORS IN E+E- PARAMETERS +C + IF(IMSG.EQ.116) + 1WRITE(ITLIS,631) THMIN(1),THMAX(1),THMIN(2),THMAX(2) +631 FORMAT(//10X,'THETA LIMITS',2E12.4,' FOR JET 1 AND',2E12.4 + C ,' FOR JET 2 ARE INCOMPATIBLE') +C + RETURN + END diff --git a/ISAJET/code/logic.F b/ISAJET/code/logic.F new file mode 100644 index 00000000000..30fdaab6f1b --- /dev/null +++ b/ISAJET/code/logic.F @@ -0,0 +1,278 @@ +#include "isajet/pilot.h" + SUBROUTINE LOGIC +C +C 10/ 3/80 +C STARTING FROM USER DATA FIND OUT WHICH PARAMETERS SHOULD +C BE FIXED AND WHICH LIMITS SHOULD BE SET +C +#include "isajet/itapes.inc" +#include "isajet/jetlim.inc" +#include "isajet/primar.inc" +#include "isajet/jetpar.inc" +#include "isajet/const.inc" +#include "isajet/dylim.inc" +#include "isajet/keys.inc" +#include "isajet/q1q2.inc" + LOGICAL COMB(8) + DIMENSION DELPH(3) +C +C LOGICAL FUNCTIONS +C + LOGICAL LOGP,LOGPT,LOGYTH,LOGX,LOGPHI + LOGICAL LOGQM,LOGQT,LOGYW,LOGTHW,LOGPHW,LOGXW + LOGICAL LOGMIJ,LOGMGM,LOGMGY + DATA UNDEF/-.9E9/ + DATA ZERO/.00001/,ONE/.99999/ +C +C INVERSE HYPERBOLIC COSINE FUNCTION + ACOSH(X)=ALOG(X+SQRT(X**2-1.0)) +C INVERSE HYPERBOLIC SINE FUNCTION + ASINH(X)=ALOG(X+SQRT(X**2+1.0)) +C +C INITIALIZE CONSTANTS +C + HALFPI=PI/2. + IFATAL=0 + IERR=0 + DO 1 I=1,36 + SETLMJ(I)=.TRUE. + IF(BLIMS(I).GT.UNDEF) SETLMJ(I)=.FALSE. + 1 CONTINUE + DO 2 I=1,12 + SETLMQ(I)=.TRUE. + IF(BLIM1(I).GT.UNDEF) SETLMQ(I)=.FALSE. + 2 CONTINUE +C +C SET STANDARD DRELL-YAN IF FIXED QTW=0. + IF(KEYS(3)) THEN + IF(QTMIN.EQ.0..AND.QTMAX.LT.UNDEF) THEN + STDDY=.TRUE. + ELSE + STDDY=.FALSE. + ENDIF + ELSEIF(KEYS(7).OR.KEYS(9)) THEN + STDDY=.TRUE. + ELSEIF(KEYS(11)) THEN + STDDY=.FALSE. + ENDIF +C + IF(STDDY) THEN + NJET=2 + FIXPT(3)=.TRUE. + PT(3)=0. + PTMIN(3)=0. + PTMAX(3)=0. + FIXPHI(3)=.FALSE. + PHIMIN(3)=0. + PHIMAX(3)=2.*PI + DELPH(3)=2.*PI + FIXPHW=.TRUE. + PHWMIN=0. + PHWMAX=-1.E9 + PHIW=0. + QTMIN=0. + QTMAX=-1.E9 + QTW=0. + FIXQT=.FALSE. + ENDIF +C +C CHECK THAT PARAMETER RANGES MAKE SENSE +C +C DO LOGIC FOR P + IF(.NOT.LOGP(IERR)) IFATAL=IFATAL+1 +C DO LOGIC FOR PT + IF(.NOT.LOGPT(IERR)) IFATAL=IFATAL+1 +C DO LOGIC FOR THETA AND YJ(RAPIDITY) + IF(.NOT.LOGYTH(IERR)) IFATAL=IFATAL+1 +C DO LOGIC FOR XJ(FEYNMAN X) +C XJ LIMITS DO NOT REDEFINE PT LIMITS + IF(.NOT.LOGX(IERR)) IFATAL=IFATAL+1 +C DO LOGIC FOR PHI +C NOTE THAT PHI INTERVAL IS DEFINED BY PHIMAX-PHIMIN + IF(.NOT.LOGPHI(IERR,DELPH)) IFATAL=IFATAL+1 +C +C DO LOGIC FOR MADGRAPH IF APPLICABLE + IF(KEYS(12)) THEN + IF(.NOT.LOGMGM(IERR)) IFATAL=IFATAL+1 + IF(.NOT.LOGMGY(IERR)) IFATAL=IFATAL+1 + IF(.NOT.LOGMIJ(IERR)) IFATAL=IFATAL+1 + ENDIF +C +C SET DEFAULT PT LIMITS IF NONE WERE SET + IF((KEYS(1).OR.KEYS(5).OR.KEYS(6).OR.KEYS(10)).AND. + $(PTMAX(1).GT..99*HALFE).AND.(PTMAX(2).GT..99*HALFE)) THEN + PTMIN(1)=0.1*HALFE + PTMIN(2)=PTMIN(1) + PTMAX(1)=0.4*HALFE + PTMAX(2)=PTMAX(1) + CALL LOGERR(0,1,IERR) + ENDIF +C +C CHECK Y LIMITS WITH FINAL PT LIMITS. + IF(KEYS(1).OR.KEYS(5).OR.KEYS(6).OR.KEYS(10)) THEN + YMXPT=ALOG(ECM/PTMIN(1)) + DO 11 I=1,2 + YJMAX(I)=AMIN1(YJMAX(I),YMXPT) +11 YJMIN(I)=AMAX1(YJMIN(I),-YMXPT) + ENDIF +C +C DO LOGIC FOR DRELL YAN VARIABLES + IF(KEYS(3).OR.KEYS(7).OR.KEYS(9).OR.KEYS(11)) THEN +C DO LOGIC FOR QM + IF(.NOT.LOGQM(IERR)) IFATAL=IFATAL+1 +C DO LOGIC FOR QT + IF(.NOT.LOGQT(IERR)) IFATAL=IFATAL+1 +C DO LOGIC FOR YW + IF(.NOT.LOGYW(IERR)) IFATAL=IFATAL+1 +C DO LOGIC FOR THETA + IF(.NOT.LOGTHW(IERR)) IFATAL=IFATAL+1 +C DO LOGIC FOR PHW +C NOTE THAT PHW INTERVAL DEFINED BY PHWMAX-PHWMIN + IF(.NOT.LOGPHW(IERR,DELPH)) IFATAL=IFATAL+1 +C DO LOGIC FOR XW + IF(.NOT.LOGXW(IERR)) IFATAL=IFATAL+1 +C + ENDIF +C +C CHECK FOR INCONSISTENCIES + DO 21 I=1,NJET + SMIN=SIN(THMIN(I)) + SMAX=SIN(THMAX(I)) + IF(SMAX.LT.SMIN) SMIN=SMAX + PT1=PMIN(I)*SMIN + IF(PT1.GT.PTMIN(I)) PTMIN(I)=PT1 + SMAX=1.0 + IF(THMAX(I).LT.ONE*HALFPI) SMAX=SIN(ONE*THMAX(I)) + IF(THMIN(I).GT.ONE*HALFPI) SMAX=SIN(ONE*THMIN(I)) + PT1=PMAX(I)*SMAX + IF(PT1.LT.ONE*PTMAX(I)) PTMAX(I)=PT1 + IF(PTMAX(I).LT.ONE*PTMIN(I)) CALL LOGERR(2,I,IFATAL) + IF(PMAX(I).LT.ONE*PMIN(I)) CALL LOGERR(1,I,IFATAL) + IF(THMAX(I).LT.ONE*THMIN(I)) CALL LOGERR(3,I,IFATAL) + IF(XJMAX(I).LT.ONE*XJMIN(I)) CALL LOGERR(4,I,IFATAL) + IF(ABS(XJMAX(I)).GT.1.0+ZERO.OR.ABS(XJMIN(I)).GT.1.0+ZERO) + 1 CALL LOGERR(4,I,IFATAL) + IF(THMIN(I).LT.-ZERO.OR.THMAX(I).GT.PI+ZERO) + $CALL LOGERR(6,I,IFATAL) +C + IF(FIXXJ(I)) THEN + X1=PMAX(I)*COS(THMIN(I))/HALFE + X2=PMIN(I)*COS(THMAX(I))/HALFE + X3=PMAX(I)*COS(THMIN(I))/HALFE + IF(X3.LT.X2) X2=X3 + IF(X1.EQ.X2) XJ(I)=X1 + IF(XJ(I).LT.ONE*X2.OR.XJ(I).GT.X1/ONE) CALL LOGERR(7,I,IFATAL) + ENDIF +C + 21 CONTINUE +C +C CHECK THAT PARAMETERS FOR DRELL YAN ARE CONSISTENT +C + IF(KEYS(3)) THEN + COMB(1)=.FALSE. + DO 31 I=1,2 + COMB(1)=COMB(1).OR.FIXP(I).OR.FIXPT(I).OR.FIXYJ(I).OR.FIXPHI(I) + 1 .OR.FIXXJ(I) + 31 CONTINUE + IF(COMB(1)) CALL LOGERR(114,1,IFATAL) + COMB(1)=FIXQT.AND.FIXQM + COMB(2)=FIXQT.AND.FIXYW + COMB(3)=FIXQM.AND.FIXYW + COMB(4)=COMB(1).AND.FIXYW + COMB(5)=COMB(1).AND.FIXXW + COMB(6)=COMB(2).AND.FIXXW + COMB(7)=COMB(3).AND.FIXXW + IF(COMB(4).AND.FIXXW) CALL LOGERR(115,1,IFATAL) + IF(COMB(4)) FIXXW=.TRUE. +C + IF(COMB(4)) THEN + FIXXW=.TRUE. + XW=SQRT(QTW**2+QMW**2)*SINH(YW)/HALFE + IF(XW.LT.XWMIN-ZERO.OR.XW.GT.XWMAX+ZERO) + $ CALL LOGERR(101,1,IFATAL) + XWMIN=XW + XWMAX=XW + ENDIF +C + IF(COMB(5)) THEN + FIXYW=.TRUE. + YW=ASINH(HALFE*XW/SQRT(QTW**2+QMW**2)) + IF(YW.LT.YWMIN-ZERO.OR.YW.GT.YWMAX+ZERO) + $CALL LOGERR(102,1,IFATAL) + YWMIN=YW + YWMAX=YW + ENDIF +C + IF(COMB(6)) THEN + IF(XW.NE.0.) THEN + QMW2=((XW*HALFE)/SINH(YW))**2-QTW**2 + IF(QMW2.GE.0) THEN + QMW=SQRT(QMW2) + IF(QMW.LT.ONE*QMIN.OR.QMW.GT.QMAX/ONE) + $CALL LOGERR(103,1,IFATAL) + ENDIF + CALL LOGERR(104,1,IFATAL) + ENDIF + ENDIF +C + IF(COMB(7).AND.(YW.NE.0)) THEN + FIXQT=.TRUE. + FIXPT(3)=.TRUE. + QTW2=((XW*HALFE)/SINH(YW))**2-QMW**2 + IF(QTW2.GE.0) THEN + QTW=SQRT(QTW2) + PT(3)=QTW + IF(QTW.LT.ONE*QTMIN.OR.QTW.GT.QTMAX/ONE) + $CALL LOGERR(105,1,IFATAL) + ENDIF + CALL LOGERR(106,1,IFATAL) + ENDIF +C + IF(QTMIN.GT.QTMAX/ONE) CALL LOGERR(107,1,IFATAL) + IF(QMIN.GT.QMAX/ONE) CALL LOGERR(108,1,IFATAL) + IF(THWMIN.GT.THWMAX/ONE) CALL LOGERR(109,1,IFATAL) + IF(PHWMIN.GT.PHWMAX/ONE) CALL LOGERR(110,1,IFATAL) + IF(XWMIN.GT.XWMAX/ONE) CALL LOGERR(111,1,IFATAL) + IF(YWMIN.GT.YWMAX+ZERO) CALL LOGERR(112,1,IFATAL) + IF(ABS(XWMIN).GT.1.0+ZERO.OR.ABS(XWMAX).GT.1.0+ZERO) + 1 CALL LOGERR(111,1,IFATAL) + IF(THWMIN.LT.-ZERO.OR.THWMAX.GT.PI+ZERO) + $CALL LOGERR(109,1,IFATAL) + ENDIF +C +C SPECIAL LOGIC FOR E+E- EVENTS +C + IF(KEYS(2)) THEN + THLOW=AMAX1(THMIN(1),PI-THMAX(2)) + THHIGH=AMAX1(THMAX(1),PI-THMIN(2)) + IF(THHIGH-THLOW.LT.ZERO.AND..NOT.(FIXYJ(1).OR.FIXYJ(2))) THEN + CALL LOGERR(116,1,IFATAL) + ELSE + DO 61 I=1,2 + FIXYJ(I)=FIXYJ(1).OR.FIXYJ(2) + FIXXJ(I)=FIXXJ(1).OR.FIXXJ(2) + FIXPT(I)=FIXPT(1).OR.FIXPT(2) + THMIN(I)=THLOW + THMAX(I)=THHIGH + IF(FIXYJ(I)) THMAX(I)=THMIN(I) + XJMIN(I)=COS(THMAX(I)) + XJMAX(I)=COS(THMIN(I)) + PTMIN(I)=HALFE*AMIN1(SIN(THMIN(I)),SIN(THMAX(I))) + IF(ABS(XJMAX(I)).LT.1.) YJMAX(I)= + 1 .5*ALOG((1.+XJMAX(I))/(1.-XJMAX(I))) + IF(ABS(XJMIN(I)).LT.1.) YJMIN(I)= + 1 .5*ALOG((1.+XJMIN(I))/(1.-XJMIN(I))) + 61 CONTINUE + ENDIF + ENDIF +C +C + IF(IFATAL.NE.0) THEN + WRITE(ITLIS,1020) IFATAL + 1020 FORMAT(////10X,I10,' FATAL ERRORS, JOB TERMINATED') + STOP 99 + ENDIF +C +C + RETURN + END diff --git a/ISAJET/code/logmgm.F b/ISAJET/code/logmgm.F new file mode 100644 index 00000000000..acb202da245 --- /dev/null +++ b/ISAJET/code/logmgm.F @@ -0,0 +1,34 @@ +#include "isajet/pilot.h" + LOGICAL FUNCTION LOGMGM(IERR) +C +C Set and check limits for multijet mass +C +C Note we use the convention that not setting an upper limit +C gives a fixed variable, even though that currently is not +C implemented in N-jet phase space. +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/jetlim.inc" +#include "isajet/primar.inc" +#include "isajet/jetpar.inc" +#include "isajet/const.inc" +#include "isajet/dylim.inc" +#include "isajet/keys.inc" +#include "isajet/q1q2.inc" +#include "isajet/mglims.inc" +C + REAL UNDEF + INTEGER IERR + DATA UNDEF/-.9E9/ +C + LOGMGM=.TRUE. +C + IF(EHMGMN.LT.UNDEF.OR.EHMGMX.LT.UNDEF) THEN + LOGMGM=.FALSE. + ENDIF +C + RETURN + END diff --git a/ISAJET/code/logmgy.F b/ISAJET/code/logmgy.F new file mode 100644 index 00000000000..ed3de1ca466 --- /dev/null +++ b/ISAJET/code/logmgy.F @@ -0,0 +1,48 @@ +#include "isajet/pilot.h" + LOGICAL FUNCTION LOGMGY(IERR) +C +C Set and check limits for dijet masses. +C +C Note we use the convention that not setting an upper limit +C gives a fixed variable, even though that currently is not +C implemented in N-jet phase space. +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/jetlim.inc" +#include "isajet/primar.inc" +#include "isajet/jetpar.inc" +#include "isajet/const.inc" +#include "isajet/dylim.inc" +#include "isajet/keys.inc" +#include "isajet/q1q2.inc" +#include "isajet/mglims.inc" +C + REAL UNDEF + INTEGER IERR + DATA UNDEF/-.9E9/ +C + LOGMGY=.TRUE. +C +C Attempt to fix YHMG +C + IF(YHMGMN.GT.UNDEF.AND.YHMGMX.LT.UNDEF) THEN + LOGMGY=.FALSE. + RETURN + ENDIF +C +C No limits +C + IF(EHMGMN.LT.0.OR.EHMGMX.LT.0) THEN + LOGMGY=.FALSE. + RETURN + ENDIF + IF(YHMGMN.LT.UNDEF) THEN + YHMGMX=LOG(ECM/EHMGMN) + YHMGMN=-YHMGMX + ENDIF +C + RETURN + END diff --git a/ISAJET/code/logmij.F b/ISAJET/code/logmij.F new file mode 100644 index 00000000000..be475bd5e94 --- /dev/null +++ b/ISAJET/code/logmij.F @@ -0,0 +1,56 @@ +#include "isajet/pilot.h" + LOGICAL FUNCTION LOGMIJ(IERR) +C +C Set and check limits for dijet masses. +C +C Note we use the convention that not setting an upper limit +C gives a fixed variable, even though that currently is not +C implemented in N-jet phase space. +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/jetlim.inc" +#include "isajet/primar.inc" +#include "isajet/jetpar.inc" +#include "isajet/const.inc" +#include "isajet/dylim.inc" +#include "isajet/keys.inc" +#include "isajet/q1q2.inc" +#include "isajet/mglims.inc" +C + REAL AMLOW,UNDEF + INTEGER I,J,IERR + DATA AMLOW/1.0/ + DATA UNDEF/-.9E9/ +C + LOGMIJ=.TRUE. +C + DO 100 I=1,MXLIM + DO 101 J=I+1,MXLIM + FIXMIJ(I,J)=.FALSE. + FIXMIJ(J,I)=.FALSE. + IF(AMIJMN(I,J).LT.UNDEF.AND.AMIJMX(I,J).LT.UNDEF) THEN + AMIJMX(I,J)=ECM + AMIJMX(J,I)=ECM + ENDIF + IF(AMIJMX(I,J).GT.ECM) THEN + AMIJMX(I,J)=ECM + AMIJMX(J,I)=ECM + ENDIF + IF(AMIJMX(I,J).LT.UNDEF) THEN + AMIJMX(I,J)=AMIJMN(I,J) + FIXMIJ(I,J)=.TRUE. + AMIJMX(J,I)=AMIJMN(I,J) + FIXMIJ(J,I)=.TRUE. + ENDIF + IF(AMIJMN(I,J).LT.UNDEF) THEN + AMIJMN(I,J)=AMLOW + AMIJMN(J,I)=AMLOW + ENDIF +101 CONTINUE +100 CONTINUE +C + RETURN + END diff --git a/ISAJET/code/logp.F b/ISAJET/code/logp.F new file mode 100644 index 00000000000..0347e2ed735 --- /dev/null +++ b/ISAJET/code/logp.F @@ -0,0 +1,32 @@ +#include "isajet/pilot.h" + LOGICAL FUNCTION LOGP(IERR) +C +C SET AND CHECK LIMITS FOR JET MOMENTA +C +#include "isajet/itapes.inc" +#include "isajet/jetlim.inc" +#include "isajet/primar.inc" +#include "isajet/jetpar.inc" +#include "isajet/const.inc" +#include "isajet/dylim.inc" +#include "isajet/keys.inc" +#include "isajet/q1q2.inc" + DATA PLOW/1.0/ + DATA UNDEF/-.9E9/ +C + LOGP=.TRUE. + DO 10 I=1,NJET + FIXP(I)=.FALSE. + IF(PMIN(I).LT.UNDEF.AND.PMAX(I).LT.UNDEF) PMAX(I)=HALFE + IF(PMAX(I).GT.HALFE) PMAX(I)=HALFE + IF(PMAX(I).LT.UNDEF) FIXP(I)=.TRUE. + IF(PMIN(I).LT.UNDEF) PMIN(I)=PLOW + IF(FIXP(I)) THEN + PMAX(I)=PMIN(I) + P(I)=PMIN(I) + ENDIF + IF(KEYS(3).AND.I.EQ.3.AND.QTMIN.GT.0) PMIN(I)=QTMIN + 10 CONTINUE +C + RETURN + END diff --git a/ISAJET/code/logphi.F b/ISAJET/code/logphi.F new file mode 100644 index 00000000000..36f4ce21f4f --- /dev/null +++ b/ISAJET/code/logphi.F @@ -0,0 +1,62 @@ +#include "isajet/pilot.h" + LOGICAL FUNCTION LOGPHI(IERR,DELPH) +C +C SET AND CHECK LIMITS FOR JET PHI +C +#include "isajet/itapes.inc" +#include "isajet/jetlim.inc" +#include "isajet/primar.inc" +#include "isajet/jetpar.inc" +#include "isajet/const.inc" +#include "isajet/dylim.inc" +#include "isajet/keys.inc" +#include "isajet/q1q2.inc" + DIMENSION DELPH(3) + DATA UNDEF/-.9E9/ +C + LOGPHI=.TRUE. +C +C + DO 50 I=1,NJET + FIXPHI(I)=.FALSE. +C + IF(PHIMAX(I).LT.UNDEF.AND.PHIMIN(I).LT.UNDEF) THEN + PHIMIN(I)=0. + PHIMAX(I)=2.*PI + DELPH(I)=PHIMAX(I) + ELSE + IF(PHIMAX(I).LT.UNDEF) FIXPHI(I)=.TRUE. +C + IF(FIXPHI(I)) THEN + PHI(I)=PHIMIN(I) + PHIMAX(I)=PHIMIN(I) + IF(KEYS(3).AND.I.LT.3) THEN + LOGPHI=.FALSE. + CALL LOGERR(105,I,IERR) + ENDIF + IF(I.EQ.2) THEN + FIXPHI(1)=.TRUE. + PHIMIN(1)=PHIMIN(2) + PHIMAX(1)=PHIMIN(1) + ENDIF + ENDIF +C + DELPH(I)=PHIMAX(I)-PHIMIN(I) +C + IF(DELPH(I).GT.2.*PI.OR.DELPH(I).LT.0) THEN + LOGPHI=.FALSE. + CALL LOGERR(8,I,IERR) + ENDIF +C + ENDIF +C + 50 CONTINUE +C +C + IF(KEYS(1).AND.DELPH(1).GT.DELPH(2)) THEN + PHIMIN(1)=PHIMIN(2)+PI + PHIMAX(1)=PHIMIN(1)+DELPH(2) + ENDIF +C + RETURN + END diff --git a/ISAJET/code/logphw.F b/ISAJET/code/logphw.F new file mode 100644 index 00000000000..73cb19ba905 --- /dev/null +++ b/ISAJET/code/logphw.F @@ -0,0 +1,52 @@ +#include "isajet/pilot.h" + LOGICAL FUNCTION LOGPHW(IERR,DELPH) +C +C SET AND CHECK LIMITS FOR W(Z0) PHI +C +#include "isajet/itapes.inc" +#include "isajet/jetlim.inc" +#include "isajet/primar.inc" +#include "isajet/jetpar.inc" +#include "isajet/const.inc" +#include "isajet/dylim.inc" +#include "isajet/keys.inc" +#include "isajet/q1q2.inc" + DIMENSION DELPH(3) + DATA UNDEF/-.9E9/ +C + LOGPHW=.TRUE. + FIXPHW=.FALSE. +C + IF(FIXPHI(3)) THEN + FIXPHW=.TRUE. + PHIW=AMOD(PHI(3)+PI,2.*PI) + ELSEIF(PHWMIN.LT.UNDEF.AND.PHWMAX.LT.UNDEF) THEN + PHWMIN=0. + PHWMAX=2.*PI + ELSEIF(PHWMAX.LT.UNDEF) THEN + FIXPHW=.TRUE. + PHW=PHWMIN + FIXPHI(3)=.TRUE. + PHWMAX=PHWMIN + PHI(3)=PHIW+PI + PHIMIN(3)=PHIW + PHIMAX(3)=PHIW + ENDIF +C + DELPHW=PHWMAX-PHWMIN +C + IF(DELPHW.LT.0.OR.DELPHW.GT.2.*PI) THEN + CALL LOGERR(110,1,IERR) + LOGPHW=.FALSE. + ENDIF +C + IF(DELPHW.LE.DELPH(3)) THEN + PHIMIN(3)=PHWMIN+PI + PHIMAX(3)=PHIMIN(3)+DELPHW + ELSE + PHWMIN=PHIMIN(3)+PI + PHWMAX=PHWMIN+DELPH(3) + ENDIF +C + RETURN + END diff --git a/ISAJET/code/logpt.F b/ISAJET/code/logpt.F new file mode 100644 index 00000000000..7417e987ef0 --- /dev/null +++ b/ISAJET/code/logpt.F @@ -0,0 +1,42 @@ +#include "isajet/pilot.h" + LOGICAL FUNCTION LOGPT(IERR) +C +C SET AND CHECK LIMITS FOR JET PT +C +#include "isajet/itapes.inc" +#include "isajet/jetlim.inc" +#include "isajet/primar.inc" +#include "isajet/jetpar.inc" +#include "isajet/const.inc" +#include "isajet/dylim.inc" +#include "isajet/keys.inc" +#include "isajet/q1q2.inc" + DATA PTLOW/1.0/ + DATA UNDEF/-.9E9/ +C + LOGPT=.TRUE. + DO 20 I=1,NJET + FIXPT(I)=.FALSE. +C + IF(PTMIN(I).LT.UNDEF.AND.PTMAX(I).LT.UNDEF) THEN + PTMAX(I)=PMAX(I) + PTMIN(I)=PTLOW + IF(KEYS(3).AND.I.EQ.3.AND.QTMIN.GT.0.) PTMIN(I)=QTMIN + IF(PMIN(I).LT.PTMIN(I)) PMIN(I)=PTMIN(I) + ELSEIF(PTMAX(I).LT.UNDEF) THEN + FIXPT(I)=.TRUE. + PTMAX(I)=PTMIN(I) + ELSEIF(PTMIN(I).LT.UNDEF) THEN + PTMIN(I)=PTLOW + IF(KEYS(3).AND.I.EQ.3.AND.QTMIN.GT.0.) PTMIN(I)=QTMIN + ENDIF +C + IF(FIXPT(I)) PTMAX(I)=PTMIN(I) + IF(FIXPT(I)) PT(I)=PTMIN(I) + IF(PTMAX(I).GT.PMAX(I)) PTMAX(I)=PMAX(I) + IF(PMIN(I).LT.PTMIN(I)) PMIN(I)=PTMIN(I) +C + 20 CONTINUE +C + RETURN + END diff --git a/ISAJET/code/logqm.F b/ISAJET/code/logqm.F new file mode 100644 index 00000000000..4b9a89718b0 --- /dev/null +++ b/ISAJET/code/logqm.F @@ -0,0 +1,46 @@ +#include "isajet/pilot.h" + LOGICAL FUNCTION LOGQM(IERR) +C +C Set and check limits for gamma*/W/Z0/Higgs mass range +C Ver 7.14: Use HMASS+-5*HGAM for MSSM default range +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/jetlim.inc" +#include "isajet/primar.inc" +#include "isajet/jetpar.inc" +#include "isajet/const.inc" +#include "isajet/dylim.inc" +#include "isajet/keys.inc" +#include "isajet/q1q2.inc" +#include "isajet/hcon.inc" +#include "isajet/xmssm.inc" +C + REAL UNDEF + INTEGER IERR + DATA UNDEF/-.9E9/ +C + LOGQM=.TRUE. + FIXQM=.FALSE. + IF(QMIN.LT.UNDEF.AND.QMAX.LT.UNDEF) THEN + IF(KEYS(7).AND.GOMSSM) THEN +C For MSSM Higgs, set default limits around Higgs + QMAX=HMASS+5*HGAM + QMIN=HMASS-5*HGAM + ELSE +C Set default QMW limits if none were set. + QMAX=0.2*ECM + QMIN=0.05*ECM + ENDIF + CALL LOGERR(0,1,IERR) + ENDIF + IF(QMAX.LT.UNDEF) FIXQM=.TRUE. + IF(FIXQM) THEN + QMW=QMIN + QMAX=QMIN + ENDIF +C + RETURN + END diff --git a/ISAJET/code/logqt.F b/ISAJET/code/logqt.F new file mode 100644 index 00000000000..4185d45ebe2 --- /dev/null +++ b/ISAJET/code/logqt.F @@ -0,0 +1,55 @@ +#include "isajet/pilot.h" + LOGICAL FUNCTION LOGQT(IERR) +C +C SET AND CHECK W(Z0) PT RANGE +C +#include "isajet/itapes.inc" +#include "isajet/jetlim.inc" +#include "isajet/primar.inc" +#include "isajet/jetpar.inc" +#include "isajet/const.inc" +#include "isajet/dylim.inc" +#include "isajet/keys.inc" +#include "isajet/q1q2.inc" + DATA UNDEF/-.9E9/ +C + LOGQT=.TRUE. + FIXQT=.FALSE. + IF(QTMIN.LT.UNDEF.AND.QTMAX.LT.UNDEF) THEN + QTMAX=PTMAX(3) + QTMIN=PTMIN(3) +C SET DEFAULT QTW LIMITS IF NONE WERE SET + IF(QTMAX.GT.0.99*HALFE) THEN + NJET=2 + QTMIN=0. + QTMAX=0. + QTW=0. + STDDY=.TRUE. + FIXQT=.TRUE. + PTMIN(3)=0. + PTMAX(3)=0. + FIXPT(3)=.TRUE. + CALL LOGERR(0,1,IERR) + ENDIF + ELSEIF(FIXPT(3)) THEN + QTW=PT(3) + QTMIN=PTMIN(3) + QTMAX=QTMIN + FIXQT=.TRUE. + ELSEIF(QTMAX.LT.UNDEF) THEN + FIXQT=.TRUE. + QTW=QTMIN + QTMAX=QTMIN + FIXPT(3)=.TRUE. + PT(3)=QTW + PTMIN(3)=QTMIN + PTMAX(3)=QTMAX + ELSE + IF(QTMAX.LT.PTMAX(3)) PTMAX(3)=QTMAX + IF(QTMIN.GT.PTMIN(3)) PTMIN(3)=QTMIN + IF(QTMAX.GT.PTMAX(3)) QTMAX=PTMAX(3) + IF(QTMIN.LT.PTMIN(3)) QTMIN=PTMIN(3) + ENDIF +C + RETURN + END diff --git a/ISAJET/code/logthw.F b/ISAJET/code/logthw.F new file mode 100644 index 00000000000..32a601b9d43 --- /dev/null +++ b/ISAJET/code/logthw.F @@ -0,0 +1,61 @@ +#include "isajet/pilot.h" + LOGICAL FUNCTION LOGTHW(IERR) +C +C SET AND CHECK THETA LIMITS FOR W(Z0) +C +#include "isajet/itapes.inc" +#include "isajet/jetlim.inc" +#include "isajet/primar.inc" +#include "isajet/jetpar.inc" +#include "isajet/const.inc" +#include "isajet/dylim.inc" +#include "isajet/keys.inc" +#include "isajet/q1q2.inc" + DATA UNDEF/-.9E9/ +C +C INVERSE HYPERBOLIC COSINE FUNCTION + ACOSH(X)=ALOG(X+SQRT(X**2-1.0)) +C INVERSE HYPERBOLIC SINE FUNCTION + ASINH(X)=ALOG(X+SQRT(X**2+1.0)) +C + HALFPI=PI/2. + LOGTHW=.TRUE. +C + IF(THWMIN.LT.UNDEF.AND.THWMAX.LT.UNDEF) THEN + THWMIN=2.*ATAN(EXP(-YWMAX)) + THWMAX=2.*ATAN(EXP(-YWMIN)) + ELSEIF(THWMIN.GT.UNDEF) THEN + IF(THWMAX.GT.UNDEF) THEN + LOGTHW=.FALSE. + CALL LOGERR(113,1,IERR) + ELSE + TAMIN=TAN(THWMIN) + TAMAX=TAN(THWMAX) + IF(THWMIN.LT.HALFPI) + 1 YWMX=ASINH(QTMAX/SQRT(QTMAX**2+QMIN**2)/TAMIN) + IF(THWMIN.GE.HALFPI) + 1 YWMX=ASINH(QTMIN/SQRT(QTMIN**2+QMAX**2)/TAMIN) + IF(THWMAX.GT.HALFPI) + 1 YWMN=ASINH(QTMAX/SQRT(QTMAX**2+QMIN**2)/TAMAX) + IF(THWMAX.LT.HALFPI) + 1 YWMN=ASINH(QTMIN/SQRT(QTMIN**2+QMAX**2)/TAMAX) + IF(YWMIN.LT.YWMN) YWMIN=YWMN + IF(YWMAX.GT.YWMX) YWMAX=YWMX + IF(FIXYW.AND.(YW.LT.YWMIN.OR.YW.GT.YWMAX)) THEN + CALL LOGERR(102,1,IERR) + LOGTHW=.FALSE. + ENDIF + ENDIF + ENDIF +C + IF(YWMIN.LT.0) THWMAX=ATAN2(QTMIN,SQRT(QTMIN**2+QMAX**2)* + 1 SINH(YWMIN)) + IF(YWMIN.GE.0) THWMAX=ATAN2(QTMAX,SQRT(QTMAX**2+QMIN**2)* + 1 SINH(YWMIN)) + IF(YWMAX.GE.0) THWMIN=ATAN2(QTMIN,SQRT(QTMIN**2+QMAX**2)* + U SINH(YWMAX)) + IF(YWMAX.LT.0) THWMIN=ATAN2(QTMAX,SQRT(QTMAX**2+QMIN**2)* + 1 SINH(YWMAX)) +C + RETURN + END diff --git a/ISAJET/code/logx.F b/ISAJET/code/logx.F new file mode 100644 index 00000000000..2d8e122c0bc --- /dev/null +++ b/ISAJET/code/logx.F @@ -0,0 +1,92 @@ +#include "isajet/pilot.h" + LOGICAL FUNCTION LOGX(IERR) +C +C SET AND CHECK LIMITS FOR JET FEYNMAN X +C +#include "isajet/itapes.inc" +#include "isajet/jetlim.inc" +#include "isajet/primar.inc" +#include "isajet/jetpar.inc" +#include "isajet/const.inc" +#include "isajet/dylim.inc" +#include "isajet/keys.inc" +#include "isajet/q1q2.inc" + DATA UNDEF/-.9E9/ +C + HALFPI=PI/2. + LOGX=.TRUE. +C + DO 40 I=1,NJET + FIXXJ(I)=.FALSE. + IF(FIXYJ(I).AND.(FIXP(I).OR.FIXPT(I)))FIXXJ(I)=.TRUE. + IF(FIXXJ(I)) GOTO 40 +C + IF(XJMIN(I).LT.UNDEF.AND.XJMAX(I).LT.UNDEF) THEN + XJMAX(I)=1.0 + XJMIN(I)=-1.0 + ENDIF +C + IF(XJMAX(I).LT.UNDEF) FIXXJ(I)=.TRUE. + IF(FIXXJ(I)) XJMAX(I)=XJMIN(I) +C + IF(.NOT.FIXXJ(I)) THEN + IF(THMIN(I).LT.HALFPI) X1=PMAX(I)*COS(THMIN(I))/HALFE + IF(THMIN(I).GE.HALFPI) X1=PMIN(I)*COS(THMIN(I))/HALFE + IF(THMAX(I).GT.HALFPI) X2=PMAX(I)*COS(THMAX(I))/HALFE + IF(THMAX(I).LT.HALFPI) X2=PMIN(I)*COS(THMAX(I))/HALFE + IF(X1.LT.XJMAX(I)) XJMAX(I)=X1 + IF(X2.GT.XJMIN(I)) XJMIN(I)=X2 + ELSE +C + XJ(I)=XJMIN(I) +C + IF(FIXP(I)) THEN + CTH(I)=XJ(I)*HALFE/P(I) + IF(ABS(CTH(I)).LE.1.0) THEN + STH(I)=SQRT(1.-CTH(I)**2) + TH(I)=ATAN2(STH(I),CTH(I)) + YJ(I)=-ALOG(TAN(TH(I)/2.)) + FIXYJ(I)=.TRUE. + PT(I)=P(I)*STH(I) + FIXPT(I)=.TRUE. + YJMIN(I)=YJ(I) + YJMAX(I)=YJ(I) + PTMIN(I)=PT(I) + PTMAX(I)=PT(I) + ELSE + LOGX=.FALSE. + CALL LOGERR(5,I,IERR) + ENDIF + ENDIF +C + IF(FIXPT(I)) THEN + TH(I)=ATAN(PT(I)/XJ(I)/HALFE) + FIXYJ(I)=.TRUE. + YJ(I)=-ALOG(TAN(TH(I)/2.)) + CTH(I)=COS(TH(I)) + STH(I)=SIN(TH(I)) + P(I)=PT(I)/STH(I) + FIXP(I)=.TRUE. + YJMIN(I)=YJ(I) + YJMAX(I)=YJ(I) + PMAX(I)=P(I) + PMIN(I)=P(I) + ENDIF +C + IF(FIXYJ(I)) THEN + FIXPT(I)=.TRUE. + P(I)=XJ(I)*HALFE/CTH(I) + PT(I)=P(I)*STH(I) + FIXP(I)=.TRUE. + PTMIN(I)=PT(I) + PTMAX(I)=PT(I) + PMAX(I)=P(I) + PMIN(I)=P(I) + ENDIF +C + ENDIF +C + 40 CONTINUE +C + RETURN + END diff --git a/ISAJET/code/logxw.F b/ISAJET/code/logxw.F new file mode 100644 index 00000000000..b50d4f17761 --- /dev/null +++ b/ISAJET/code/logxw.F @@ -0,0 +1,43 @@ +#include "isajet/pilot.h" + LOGICAL FUNCTION LOGXW(IERR) +C +C SET AND CHECK X LIMITS FOR W(Z0) +C +#include "isajet/itapes.inc" +#include "isajet/jetlim.inc" +#include "isajet/primar.inc" +#include "isajet/jetpar.inc" +#include "isajet/const.inc" +#include "isajet/dylim.inc" +#include "isajet/keys.inc" +#include "isajet/q1q2.inc" + DATA UNDEF/-.9E9/ +C + LOGXW=.TRUE. + FIXXW=.FALSE. +C + IF(XWMIN.LT.UNDEF.AND.XWMAX.LT.UNDEF) THEN + XWMIN=-1.0 + XWMAX=1.0 + ELSEIF(XWMAX.GT.UNDEF) THEN + FIXXW=.TRUE. + XW=XWMIN + XWMAX=XW +C IF XW=0 THEN YW=0 + IF(XW.NE.0) THEN + FIXYW=.TRUE. + YW=0 + YWMIN=0 + YWMAX=0 + ENDIF + ENDIF +C +C IF YW=0 THAN XW=0 + IF(YW.EQ.0) THEN + FIXXW=.TRUE. + XW=0 + XWMAX=0 + ENDIF +C + RETURN + END diff --git a/ISAJET/code/logyth.F b/ISAJET/code/logyth.F new file mode 100644 index 00000000000..01c5a6e9461 --- /dev/null +++ b/ISAJET/code/logyth.F @@ -0,0 +1,100 @@ +#include "isajet/pilot.h" + LOGICAL FUNCTION LOGYTH(IERR) +C +C SET AND CHECK LIMITS FOR JET Y AND THETA +C +#include "isajet/itapes.inc" +#include "isajet/jetlim.inc" +#include "isajet/primar.inc" +#include "isajet/jetpar.inc" +#include "isajet/const.inc" +#include "isajet/dylim.inc" +#include "isajet/keys.inc" +#include "isajet/q1q2.inc" + DATA UNDEF/-.9E9/ +C +C INVERSE HYPERBOLIC COSINE FUNCTION + ACOSH(X)=ALOG(X+SQRT(X**2-1.0)) +C INVERSE HYPERBOLIC SINE FUNCTION + ASINH(X)=ALOG(X+SQRT(X**2+1.0)) +C + HALFPI=PI/2. + LOGYTH=.TRUE. +C + DO 30 I=1,NJET + FIXYJ(I)=.FALSE. +C + IF(FIXP(I).AND.FIXPT(I)) THEN + STH(I)=PT(I)/P(I) + CTHS(1,I)=SQRT(1.-STH(I)**2) + CTHS(2,I)=-CTHS(1,I) + THS(1,I)=ATAN2(STH(I),CTHS(1,I)) + THS(2,I)=ATAN2(STH(I),CTHS(2,I)) + YJS(1,I)=-ALOG(TAN(THS(1,I)/2.)) + YJS(2,I)=-ALOG(TAN(THS(2,I)/2.)) + XJS(1,I)=P(I)*CTHS(1,I)/HALFE + XJS(2,I)=P(I)*CTHS(2,I)/HALFE + YJMAX(I)=YJS(2,I) + THMAX(I)=THS(1,I) + THMIN(I)=THS(2,I) + IF(YJMIN(I).EQ.YJMAX(I)) FIXYJ(I)=.TRUE. + ENDIF +C +C + IF(YJMIN(I).LT.UNDEF.AND.YJMAX(I).LT.UNDEF) THEN +C + IF(THMIN(I).LT.UNDEF.AND.THMAX(I).LT.UNDEF) THEN + YJMAX(I)=ACOSH(HALFE/PTMIN(I)) + YJMIN(I)=-YJMAX(I) + THMIN(I)=2.*ATAN(EXP(-YJMAX(I))) + THMAX(I)=2.*ATAN(EXP(-YJMIN(I))) + ENDIF +C + IF(THMAX(I).LT.UNDEF) FIXYJ(I)=.TRUE. + IF(THMIN(I).LT.UNDEF) THMIN(I)=.001 + IF(FIXYJ(I)) THMAX(I)=THMIN(I) + YJMIN(I)=-ALOG(TAN(THMAX(I)/2.)) + YJMAX(I)=-ALOG(TAN(THMIN(I)/2.)) + THMIN(I)=2.*ATAN(EXP(-YJMAX(I))) + THMAX(I)=2.*ATAN(EXP(-YJMIN(I))) + ENDIF +C +C + IF(YJMAX(I).LT.UNDEF) FIXYJ(I)=.TRUE. + IF(YJMIN(I).LT.UNDEF) YJMIN(I)=-YJMAX(I) + IF(FIXYJ(I)) YJMAX(I)=YJMIN(I) + THMIN(I)=2.*ATAN(EXP(-YJMAX(I))) + THMAX(I)=2.*ATAN(EXP(-YJMIN(I))) +C + IF(FIXYJ(I)) THEN + YJ(I)=YJMIN(I) + TH(I)=THMIN(I) + STH(I)=SIN(TH(I)) + CTH(I)=COS(TH(I)) + IF(FIXPT(I)) P(I)=PT(I)/STH(I) + IF(FIXP(I)) PT(I)=P(I)*STH(I) +C + IF((FIXP(I).OR.FIXPT(I))) THEN + XJ(I)=P(I)*CTH(I)/HALFE + XJMIN(I)=XJ(I) + XJMAX(I)=XJ(I) + ENDIF +C + ENDIF +C +C CHECK PT LIMITS WITH P AND THETA LIMITS + IF(.NOT.FIXPT(I)) THEN + THETA1=AMIN1(THMIN(I),PI-THMAX(I)) + THETA2=HALFPI + IF(THMAX(I).LT.HALFPI) THETA2=THMAX(I) + IF(THMIN(I).GT.HALFPI) THETA2=THMIN(I) + PT1=PMIN(I)*SIN(THETA1) + PTMIN(I)=AMAX1(PTMIN(I),PT1) + PT2=PMAX(I)*SIN(THETA2) + PTMAX(I)=AMIN1(PTMAX(I),PT2) + ENDIF +C + 30 CONTINUE +C + RETURN + END diff --git a/ISAJET/code/logyw.F b/ISAJET/code/logyw.F new file mode 100644 index 00000000000..5b71e4a02df --- /dev/null +++ b/ISAJET/code/logyw.F @@ -0,0 +1,52 @@ +#include "isajet/pilot.h" + LOGICAL FUNCTION LOGYW(IERR) +C +C SET AND CHECK Y LIMITS FOR W(Z0) +C +#include "isajet/itapes.inc" +#include "isajet/jetlim.inc" +#include "isajet/primar.inc" +#include "isajet/jetpar.inc" +#include "isajet/const.inc" +#include "isajet/dylim.inc" +#include "isajet/keys.inc" +#include "isajet/q1q2.inc" + LOGICAL COMB(2) + DATA UNDEF/-.9E9/ +C +C INVERSE HYPERBOLIC COSINE FUNCTION + ACOSH(X)=ALOG(X+SQRT(X**2-1.0)) +C INVERSE HYPERBOLIC SINE FUNCTION + ASINH(X)=ALOG(X+SQRT(X**2+1.0)) + YW=1.0 + LOGYW=.TRUE. + FIXYW=.FALSE. +C + IF(YWMIN.LT.UNDEF.AND.YWMAX.LT.UNDEF) THEN + YWMAX=ACOSH(HALFE/SQRT(QTMIN**2+QMIN**2)) + YWMIN=-YWMAX + ENDIF +C + IF(YWMAX.LT.UNDEF) THEN + FIXYW=.TRUE. + YW=YWMIN + YWMAX=YWMIN + ENDIF +C + YWMX=ACOSH(HALFE/SQRT(QTMIN**2+QMIN**2)) + YWMN=-YWMX + COMB(1)=YWMX.LT.YWMAX + COMB(2)=YWMN.GT.YWMIN +C + IF(FIXYW.AND.(COMB(1).OR.COMB(2))) THEN + LOGYW=.FALSE. + CALL LOGERR(102,1,IERR) + ENDIF +C + IF(.NOT.FIXYW) THEN + IF(COMB(1)) YWMAX=YWMX + IF(COMB(2)) YWMIN=YWMN + ENDIF +C + RETURN + END diff --git a/ISAJET/code/lstsq.F b/ISAJET/code/lstsq.F new file mode 100644 index 00000000000..523265c9b09 --- /dev/null +++ b/ISAJET/code/lstsq.F @@ -0,0 +1,21 @@ +#include "isajet/pilot.h" + SUBROUTINE LSTSQ(X,Y,NPT,A,B) +C +C DO LEAST SQUARE FIT TO A STRAIGHT LINE Y=A+B*X +C +#include "isajet/itapes.inc" + DIMENSION X(NPT),Y(NPT) + SUM1=0 + SUM2=0 + SUM3=0 + SUM4=0 + DO 1 I=1,NPT + SUM1=SUM1+X(I) + SUM2=SUM2+Y(I) + SUM3=SUM3+X(I)**2 + SUM4=SUM4+X(I)*Y(I) + 1 CONTINUE + B=(SUM2*SUM1-SUM4*NPT)/(SUM1**2-SUM3*NPT) + A=(SUM2-B*SUM1)/NPT + RETURN + END diff --git a/ISAJET/code/mbias.F b/ISAJET/code/mbias.F new file mode 100644 index 00000000000..e87eb1ba93c --- /dev/null +++ b/ISAJET/code/mbias.F @@ -0,0 +1,375 @@ +#include "isajet/pilot.h" + SUBROUTINE MBIAS +C +C Generate minbias event or beam jets for high-pt event using +C parameters set in MBSET: +C +C (1) Select number NPOM of cut pomerons -- cf cut Reggeon +C field theory of Abramovskii, Kanchelli, and Gribov. +C (2) Generate xf for leading baryons including 1/(1-xf) +C diffractive term and guessed NPOM dependence, +C F(XF)=(1-XF)**(A+B/NPOM) +C (3) Select xf for each half of each Pomeron. then fragment +C each half Pomeron into mesons and baryons independently +C in the Pomeron-Pomeron center of mass. This avoids +C making xf=0 a singular point. +C +C Note that multiple cut Pomerons give approximate KNO scaling. +C The only short-range correlations are from resonances. +C +C Ver. 7.09: Add traps on free loops and IMPLICIT NONE. +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/keys.inc" +#include "isajet/mbgen.inc" +#include "isajet/primar.inc" +#include "isajet/jetpar.inc" +#include "isajet/const.inc" +#include "isajet/partcl.inc" +#include "isajet/mbpar.inc" +C + DIMENSION IFL(3),IFLEXC(2),PXEXC(2),PYEXC(2),SIGN(2) + DIMENSION PSUM(5) + DIMENSION LDIFFR(2) + LOGICAL LDIFFR + REAL RANF,AMASS + REAL RND,XX,XSUM,P0,PPOM,PXEXC,PSUM,SIGN,PYEXC,GAM,BETA,X, + $AM,PPLUS,EPSDIF,PEND0,TRY,PX,PY,PX2,PY2,QMINUS,PZ,QPLUS,PT1, + $PHI1,XBGEN,PT2,PHI2,PX1,PY1,AMT2 + INTEGER ID1,ID2,IFL1,IFL2,IMOD1,IMOD2,ITWIST,IPOM,LOOP,NFIRST, + $ID3,IFLEXC,IFL,I,NP2,IP,NP1,IFAIL,NPTLV1,IDHAD,IB,NEW,JSPIN, + $INDEX,NBEGIN,IPASS,MXPASS,N,IDIFF,IPASSB,IFLNEW,ISWAP + DATA SIGN/1.,-1./,PEND0/.14/ + DATA PSUM/5*0./ + DATA MXPASS/200/ +C +C Start + NBEGIN=NPTCL+1 + IPASS=1 + IPASSB=1 +C +C Select number of cut Pomerons. +C +1 CONTINUE + TRY=RANF() + DO 10 N=MNPOM,MXPOM + NPOM=N + IF(POMGEN(N).GT.TRY) GO TO 20 +10 CONTINUE +20 CONTINUE +C +C Decide if diffractive event + IF(RANF().LT.PDIFFR) THEN + IDIFF=INT(1.99999*RANF())+1 + LDIFFR(IDIFF)=.TRUE. + LDIFFR(3-IDIFF)=.FALSE. + ELSE + LDIFFR(1)=.FALSE. + LDIFFR(2)=.FALSE. + ENDIF +C +C Generate leading baryons. +C + DO 100 IB=1,2 + PPLUS=2.*PBEAM(IB) +C +C Special treatment for diffractive beam. + IF(LDIFFR(IB)) THEN + IDHAD=IDIN(IB) + AM=AMASS(IDHAD) + CALL FLAVOR(IDIN(IB),IFL(1),IFL(2),IFL(3),JSPIN,INDEX) + NEW=INT(3.*RANF())+1 + IFLEXC(1)=+IFL(NEW) + IFLEXC(2)=-IFL(NEW) + EPSDIF=2./SCM + DXBARY(IB)=EPSDIF**RANF() + XBARY(IB)=1.-DXBARY(IB) + GO TO 115 + ENDIF +C +C If not diffractive, construct IDENT of leading baryon + CALL FLAVOR(IDIN(IB),IFL(1),IFL(2),IFL(3),JSPIN,INDEX) + NEW=INT(3.*RANF())+1 + IFLNEW=ISIGN(INT(RANF()/PUD0)+1,IDIN(IB)) + IFLEXC(1)=IFL(NEW) + IFLEXC(2)=-IFLNEW + IFL(NEW)=IFLNEW + IF(IABS(IFL(1)).GT.IABS(IFL(2))) THEN + ISWAP=IFL(1) + IFL(1)=IFL(2) + IFL(2)=ISWAP + ENDIF + IF(IABS(IFL(2)).GT.IABS(IFL(3))) THEN + ISWAP=IFL(2) + IFL(2)=IFL(3) + IFL(3)=ISWAP + ENDIF + IF(IABS(IFL(1)).GT.IABS(IFL(2))) THEN + ISWAP=IFL(1) + IFL(1)=IFL(2) + IFL(2)=ISWAP + ENDIF + JSPIN=1 + IF(IFL(1).EQ.IFL(2).AND.IFL(2).EQ.IFL(3)) THEN + JSPIN=1 + ELSE + JSPIN=INT(RANF()+PJSPN) + ENDIF + IF(JSPIN.EQ.0.AND.IFL(1).NE.IFL(2).AND.IFL(2).NE.IFL(3)) THEN + IF(RANF().GT.PISPN) THEN + ISWAP=IFL(1) + IFL(1)=IFL(2) + IFL(2)=ISWAP + ENDIF + ENDIF + IDHAD=1000*IABS(IFL(1))+100*IABS(IFL(2))+10*IABS(IFL(3))+JSPIN + IDHAD=ISIGN(IDHAD,IDIN(IB)) + AM=AMASS(IDHAD) +C +C Select xf for nondiffractive baryon, flat for NPOM=1 and +C like mesons for NPOM=infinity. +110 XBGEN=XGEN0(2)*(1.-1./NPOM) + DXBARY(IB)=RANF()**(1./(XBGEN+1.)) + XBARY(IB)=1.-DXBARY(IB) +C +C Select transverse momentum of baryon +115 CALL GETPT(PT1,SIGQT0) + PHI1=2.*PI*RANF() + PX1=PT1*COS(PHI1) + PY1=PT1*SIN(PHI1) + PXEXC(1)=PX1 + PYEXC(1)=PY1 + CALL GETPT(PT2,SIGQT0) + PHI2=2.*PI*RANF() + PX2=PT2*COS(PHI2) + PY2=PT2*SIN(PHI2) + PXEXC(2)=PX2 + PYEXC(2)=PY2 + PX=-PX1-PX2 + PY=-PY1-PY2 + AMT2=PX**2+PY**2+AM**2 +C + QPLUS=XBARY(IB)*PPLUS + QPLUS=AMAX1(QPLUS,1.E-6) + QMINUS=AMT2/QPLUS + PZ=.5*(QPLUS-QMINUS) + P0=.5*(QPLUS+QMINUS) +C +C Add baryon to /PARTCL/ if PZ>0. + IF(NPTCL.GE.MXPTCL) GO TO 9999 + IF(PZ.GE.0.) THEN + NPTCL=NPTCL+1 + PPTCL(1,NPTCL)=PX + PPTCL(2,NPTCL)=PY + PPTCL(3,NPTCL)=PZ*SIGN(IB) + PPTCL(4,NPTCL)=P0 + PPTCL(5,NPTCL)=AM + IORIG(NPTCL)=0 + IDCAY(NPTCL)=0 + IDENT(NPTCL)=IDHAD + ELSE + IPASSB=IPASSB+1 + IF(IPASSB.LT.MXPASS) GO TO 110 +C Just give up if it fails MXPASS times + WRITE(ITLIS,998) +998 FORMAT(//5X,'ERROR IN MBIAS ... COULD NOT MAKE BARYON') + XBARY(IB)=0. + DXBARY(IB)=1. + ENDIF +C +C Having accepted baryon, set up XPOM array for cut Pomerons, +C rescaling to 1.-XBARY(IB). + XSUM=0. + DO 120 N=1,NPOM + XX=RANF() + XPOM(N,IB)=XX + XSUM=XSUM+XX +120 CONTINUE + XSUM=1./XSUM + DO 130 N=1,NPOM + XPOM(N,IB)=XSUM*XPOM(N,IB)*DXBARY(IB) +130 CONTINUE +100 CONTINUE +C +C Fragment each Pomeron into mesons and baryon pairs in the +C Pomeron-Pomeron center of mass. +C + DO 1000 IB=1,2 + DO 2000 IPOM=1,NPOM + PPOM=SQRT(PBEAM(1)*XPOM(IPOM,1)*PBEAM(2)*XPOM(IPOM,2)) + PPLUS=2.*PPOM + NFIRST=NPTCL+1 + LOOP=0 +C +200 CONTINUE + ITWIST=INT(1.99999*RANF())+1 + LOOP=LOOP+1 +C +C Select new quark or diquark. Old diquark implies new quark. +C Old quark implies new diquark with probability PBARY0. + IFL1=IFLEXC(ITWIST) + IF(MOD(IFL1,100).EQ.0) THEN + IFL2=ISIGN(INT(RANF()/PUD0)+1,+IFL1) + ELSEIF(RANF().GT.PBARY0) THEN + IFL2=ISIGN(INT(RANF()/PUD0)+1,-IFL1) + ELSE + ID1=INT(RANF()/PUD0)+1 + ID2=INT(RANF()/PUD0)+1 + IF(IABS(ID1).GT.IABS(ID2)) THEN + ISWAP=ID1 + ID1=ID2 + ID2=ISWAP + ENDIF + IFL2=ISIGN(1000*ID1+100*ID2,IFL1) + ENDIF + IFLEXC(ITWIST)=-IFL2 +C Construct meson from quark+antiquark. Else, construct baryon +C IDENT from quark+diquark. + IMOD1=MOD(IFL1,100) + IMOD2=MOD(IFL2,100) + IF(IMOD1.NE.0.AND.IMOD2.NE.0) THEN + JSPIN=INT(RANF()+PJSPN) + ID1=IFL1 + ID2=IFL2 + IF(ID1+ID2.EQ.0) THEN + RND=RANF() + ID1=IABS(ID1) + ID1=INT(PMIX01(ID1,JSPIN+1)+RND) + $ +INT(PMIX02(ID1,JSPIN+1)+RND)+1 + ID2=-ID1 + ELSEIF(IABS(ID1).GT.IABS(ID2)) THEN + ISWAP=ID1 + ID1=ID2 + ID2=ISWAP + ENDIF + IDHAD=ISIGN(100*IABS(ID1)+10*IABS(ID2)+JSPIN,ID1) + ELSE + IF(IMOD1.EQ.0) THEN + ID3=MOD(IFL1/100,10) + ID2=IFL1/1000 + ID1=IFL2 + ELSE + ID3=MOD(IFL2/100,10) + ID2=IFL2/1000 + ID1=IFL1 + ENDIF + IF(IABS(ID1).GT.IABS(ID2)) THEN + ISWAP=ID1 + ID1=ID2 + ID2=ISWAP + ENDIF + IF(IABS(ID2).GT.IABS(ID3)) THEN + ISWAP=ID2 + ID2=ID3 + ID3=ISWAP + ENDIF + IF(IABS(ID1).GT.IABS(ID2)) THEN + ISWAP=ID1 + ID1=ID2 + ID2=ISWAP + ENDIF + IF(ID1.EQ.ID2.AND.ID2.EQ.ID3) THEN + JSPIN=1 + ELSE + JSPIN=INT(RANF()+PJSPN) + ENDIF + IF(JSPIN.EQ.0.AND.ID1.NE.ID2.AND.ID2.NE.ID3) THEN + IF(RANF().LT.PISPN) THEN + ISWAP=ID1 + ID1=ID2 + ID2=ISWAP + ENDIF + ENDIF + IDHAD=1000*IABS(ID1)+100*IABS(ID2)+10*IABS(ID3)+JSPIN + IDHAD=ISIGN(IDHAD,IFL1) + ENDIF +C + AM=AMASS(IDHAD) + PX1=PXEXC(ITWIST) + PY1=PYEXC(ITWIST) + CALL GETPT(PT2,SIGQT0) + PHI2=2.*PI*RANF() + PX2=PT2*COS(PHI2) + PY2=PT2*SIN(PHI2) + PXEXC(ITWIST)=PX2 + PYEXC(ITWIST)=PY2 + PX=PX1-PX2 + PY=PY1-PY2 + AMT2=PX**2+PY**2+AM**2 +C +C Select x -- same distribution for all particles. + X=RANF() + IF(RANF().LT.XGEN0(1)) X=1.-X**(1./(XGEN0(2)+1.)) + QPLUS=X*PPLUS + QPLUS=AMAX1(QPLUS,1.E-6) + QMINUS=AMT2/QPLUS + P0=.5*(QPLUS+QMINUS) + PZ=.5*(QPLUS-QMINUS) +C +C Add particle to /PARTCL/ if PZ>0. + IF(NPTCL.GE.MXPTCL) GO TO 9999 + IF(PZ.GE.0.) THEN + NPTCL=NPTCL+1 + PPTCL(1,NPTCL)=PX + PPTCL(2,NPTCL)=PY + PPTCL(3,NPTCL)=PZ*SIGN(IB) + PPTCL(4,NPTCL)=P0 + PPTCL(5,NPTCL)=AM + IORIG(NPTCL)=0 + IDCAY(NPTCL)=0 + IDENT(NPTCL)=IDHAD + ENDIF +C +C Continue if sufficient pplus + PPLUS=(1.-X)*PPLUS + IF(PPLUS.GT.PEND0.AND.LOOP.LT.MXPTCL) GO TO 200 +C +C Boost hadrons to lab frame. + IF(NPTCL.LT.NFIRST) GO TO 2000 + BETA=(XPOM(IPOM,1)*PBEAM(1)-XPOM(IPOM,2)*PBEAM(2))/(2.*PPOM) + GAM=(XPOM(IPOM,1)*PBEAM(1)+XPOM(IPOM,2)*PBEAM(2))/(2.*PPOM) + DO 400 IP=NFIRST,NPTCL + P0=GAM*PPTCL(4,IP)+BETA*PPTCL(3,IP) + PZ=BETA*PPTCL(4,IP)+GAM*PPTCL(3,IP) + PPTCL(3,IP)=PZ + PPTCL(4,IP)=P0 +400 CONTINUE +C +2000 CONTINUE +1000 CONTINUE +C +C Rescale hadron momenta for correct four-momentum. +C + NPTLV1=NPTCL + IF(KEYS(4)) THEN + PSUM(4)=ECM + PSUM(5)=ECM + CALL RESCAL(NBEGIN,NPTLV1,PSUM,IFAIL) + ELSE + CALL RESCAL(NBEGIN,NPTLV1,PBEAMS,IFAIL) + ENDIF + IF(IFAIL.NE.0.AND.IPASS.LT.MXPASS) THEN + IPASS=IPASS+1 + NPTCL=NBEGIN-1 + GO TO 1 + ENDIF +C +C Decay hadrons +C + NP1=NBEGIN +500 NP2=NPTCL + DO 510 I=NP1,NP2 + CALL DECAY(I) +510 CONTINUE + NP1=NP2+1 + IF(NP1.LE.NPTCL) GO TO 500 + RETURN +C +9999 CALL PRTEVT(0) + WRITE(ITLIS,999) NPTCL +999 FORMAT(//5X,'ERROR IN MBIAS...NPTCL >',I5) + RETURN + END diff --git a/ISAJET/code/mbset.F b/ISAJET/code/mbset.F new file mode 100644 index 00000000000..64cbccb350d --- /dev/null +++ b/ISAJET/code/mbset.F @@ -0,0 +1,76 @@ +#include "isajet/pilot.h" + SUBROUTINE MBSET +C +C SET PARAMETERS FOR GENERATING MINBIAS EVENTS OR BEAM JETS, +C ALLOWING DIFFERENT PARAMETERS FOR TWO CASES. +C +#include "isajet/itapes.inc" +#include "isajet/mbpar.inc" +#include "isajet/mbgen.inc" +#include "isajet/primar.inc" +#include "isajet/totals.inc" +#include "isajet/keys.inc" +C +C +C DN/DY INCREASES WITH LOG(S). INCLUDED IN SPLITTING FUNCTION +C BECAUSE AVERAGE MULTIPLICITY COMES FROM SINGLE CHAIN GRAPH. + XGEN0(1)=.9 + XGEN0(2)=1.+0.35*ALOG(ECM/60.) +C +C POMWT ARE (RELATIVE) PROBABILITIES FOR N CUT POMERONS. +C PDIFFR IS DIFFRACTIVE PROBABILITY. +C SIGQT0 IS MEAN PT. + IF(KEYS(4)) THEN + PDIFFR=.15 + SIGQT0=.35 + PSUM=0. + DO 100 I=1,LIMPOM + POMWT(I)=(1.+4.*I**2)*EXP(-1.8*I) + PSUM=PSUM+POMWT(I) +100 CONTINUE + ELSE + PDIFFR=0. + SIGQT0=.45 + PSUM=0. + DO 110 I=1,LIMPOM + POMWT(I)=(1.+4.*I**2)*EXP(-1.8*I) + PSUM=PSUM+POMWT(I) +110 CONTINUE + POMWT(1)=.1*POMWT(1) + POMWT(2)=.2*POMWT(2) + POMWT(3)=.5*POMWT(3) + ENDIF +C +C RENORMALIZE POMWT. + PSUM=1./PSUM + DO 200 I=1,LIMPOM + POMWT(I)=PSUM*POMWT(I) +200 CONTINUE + PSUM=0. + DO 210 I=MNPOM,MXPOM + PSUM=PSUM+POMWT(I) +210 CONTINUE +C +C POMGEN IS USED TO SELECT NUMBER OF POMERONS. + PGEN=0. + PSUM=1./PSUM + DO 300 I=1,LIMPOM + POMGEN(I)=0. +300 CONTINUE + DO 310 I=MNPOM,MXPOM + PGEN=PGEN+PSUM*POMWT(I) + POMGEN(I)=PGEN +310 CONTINUE + POMGEN(MXPOM)=1. +C +C SET /TOTALS/ FOR MINBIAS EVENTS USING LOG**2(S) FIT TO +C TOTAL CROSS SECTION. + IF(KEYS(4)) THEN + SIGTOT=25.65*(1.+.0102*ALOG(SCM/1.76)**2) + SIGTOT=PSUM*SIGTOT + NKINPT=NEVENT + SUMWT=SIGTOT*NKINPT + ENDIF +C + RETURN + END diff --git a/ISAJET/code/mginit.F b/ISAJET/code/mginit.F new file mode 100644 index 00000000000..0785ef5788d --- /dev/null +++ b/ISAJET/code/mginit.F @@ -0,0 +1,64 @@ +#include "isajet/pilot.h" + SUBROUTINE MGINIT +C +C Initialize common blocks for MadGraph code in ISAJET +C Note the QCD coupling constant is g=1. +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +C +#include "isajet/itapes.inc" +#include "isajet/sstype.inc" +#include "isajet/mgcoms.inc" +C + INTEGER I + REAL AMGMW + REAL*8 SW2 +C +C Fermion masses and widths +C + FMASS(1) = AMGMW(IDE,1) + FMASS(2) = 0D0 + FMASS(3) = AMGMW(IDUP,1) + FMASS(4) = AMGMW(IDDN,1) + FMASS(5) = AMGMW(IDMU,1) + FMASS(6) = 0D0 + FMASS(7) = AMGMW(IDCH,1) + FMASS(8) = AMGMW(IDST,1) + FMASS(9) = AMGMW(IDTAU,1) + FMASS(10)= 0D0 + FMASS(11)= AMGMW(IDTP,1) + FMASS(12)= AMGMW(IDBT,1) + DO 100 I=1,12 + FWIDTH(I)=0D0 +100 CONTINUE +C +C Boson masses and widths +C + AMASS=0D0 + AWIDTH=0D0 + WMASS=AMGMW(IDW,1) + WWIDTH=AMGMW(IDW,2) + ZMASS=AMGMW(IDZ,1) + ZWIDTH=AMGMW(IDZ,2) + HMASS=AMGMW(IDH,1) + HWIDTH=AMGMW(IDH,2) + SW2=AMGMW(1,3) +C +C Calls to Helas routines to set couplings +C + CALL COUP1X(SW2,GW,GWWA,GWWZ) + CALL COUP2X(SW2,GAL,GAU,GAD,GWF,GZN,GZL,GZU,GZD,G1) + CALL COUP3X(SW2,ZMASS,HMASS,GWWH,GZZH,GHHH,GWWHH,GZZHH,GHHHH) + DO 110 I=1,12 + CALL COUP4X(SW2,ZMASS,FMASS(I),GCHF(1,I)) +110 CONTINUE +C +C QCD couplings +C + G = 1D0 + GG(1)=-G + GG(2)=-G + RETURN + END diff --git a/ISAJET/code/muljet.F b/ISAJET/code/muljet.F new file mode 100644 index 00000000000..bb6493b2868 --- /dev/null +++ b/ISAJET/code/muljet.F @@ -0,0 +1,192 @@ +#include "isajet/pilot.h" + SUBROUTINE MULJET(WT) +C +C Using masses from /MGKIN/, generate NJET<=MXJETS body phase +C space point satisfying cuts: +C (1) Generate kinematic point using successive 2-body decays +C with Jacobean +C dPhi_N(p1...pN) = dQ1 p1/(4*pi) dPhi_(N-1)(q1...pN) +C (2) Apply individual jet cuts from /JETLIM/ and dijet +C cuts from /MGLIMS/ to ensure IR-safe cross section. +C (3) Return weight WT or 0 if outside limits. +C +C Note that WT contains various constant factors that were +C dropped in DECAY: +C 1/(2*SHMG) Jacobean +C Jacobean for dQ = (EHMG-SUM)*dRANF +C Factors of 4pi +C +C MadGraph/Helas notation: +C PJETS8(0:3,1:2) = initial momenta +C PJETS8(0:3,3:NJET+2) = final momenta +C Note: ANSI extensions, e.g. REAL*8 P(0:3) are required for +C compatibility with Helas and MadGraph. :-( +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +C +#include "isajet/itapes.inc" +#include "isajet/jetlim.inc" +#include "isajet/mglims.inc" +#include "isajet/pjets.inc" +#include "isajet/mgkin.inc" +#include "isajet/primar.inc" +C +C Local variables; MXJETS defined in /PJETS/ +C + REAL*8 PGEN(0:3,MXJETS),AMGEN(MXJETS),RND(MXJETS) + REAL*8 SHMG,EHMG,YHMG,SUM,SUM1,RNEW,WT,QCM,PI, + $U(3),PHI,BETA(3),GAMMA,BP,PTI,PPI,YI,XJI,PHII,AMIJ + REAL*8 CYHMG,SYHMG,E1,E2,P12,DELTAQ + REAL*8 PCM,A,B,C + INTEGER NJET1,I,JJ1,NTRY,J,JSAVE,II,K + REAL RANF +C +C Function definition +C + PCM(A,B,C)=SQRT((A-B-C)*(A+B+C)*(A-B+C)*(A+B-C))/(2.*A) +C +C +C Generate COM mass and rapidity +C + PI=4.D0*DATAN(1.D0) +100 CONTINUE + SHMG=EHMGMN**2+(EHMGMX**2-EHMGMN**2)*RANF() + EHMG=SQRT(SHMG) + YHMG=YHMGMN+(YHMGMX-YHMGMN)*RANF() + IF(EHMG*EXP(ABS(YHMG)).GT.ECM) GO TO 999 + IF(EHMG.LT.AMJET8(1)+AMJET8(2)) GO TO 999 + CYHMG=DCOSH(YHMG) + SYHMG=SINH(YHMG) + AMGEN(1)=EHMG + PGEN(1,1)=0 + PGEN(2,1)=0 + PGEN(3,1)=EHMG*SYHMG + PGEN(0,1)=EHMG*CYHMG + E1=(EHMG**2+AMJET8(1)**2-AMJET8(2)**2)/(2*EHMG) + E2=(EHMG**2-AMJET8(1)**2+AMJET8(2)**2)/(2*EHMG) + P12=PCM(EHMG,AMJET8(1),AMJET8(2)) +C Initial momenta + PJETS8(1,1)=0 + PJETS8(2,1)=0 + PJETS8(3,1)=SYHMG*E1+CYHMG*P12 + PJETS8(0,1)=CYHMG*E1+SYHMG*P12 + PJETS8(1,2)=0 + PJETS8(2,2)=0 + PJETS8(3,2)=SYHMG*E1-CYHMG*P12 + PJETS8(0,2)=CYHMG*E1-SYHMG*P12 +C + NJET1=NJET-1 + SUM=0 + DO 110 I=1,NJET + SUM=SUM+AMJET8(I+2) +110 CONTINUE + IF(SUM.GE.EHMG) GO TO 999 + DELTAQ=EHMG-SUM +C +C Generate masses for uniform NJET-body phase space. +C + NTRY=0 +200 CONTINUE + NTRY=NTRY+1 + IF(NTRY.GT.NTRIES) THEN + WRITE(ITLIS,9999) NTRY +9999 FORMAT(//2X,'ERROR IN MULJET ... NTRY = ',I8) + STOP99 + ENDIF + RND(1)=1 + DO 210 I=2,NJET1 + RNEW=RANF() + DO 220 JJ1=1,I-1 + J=I-JJ1 + JSAVE=J+1 + IF(RNEW.LE.RND(J)) GO TO 210 + RND(JSAVE)=RND(J) +220 CONTINUE +210 RND(JSAVE)=RNEW + RND(NJET)=0 +C Jacobean for d(shmg)d(yhmg) and overall 1/(2*shmg) + WT=(EHMGMX**2-EHMGMN**2)*(YHMGMX-YHMGMN)/(2*SHMG) + SUM1=SUM + DO 230 I=2,NJET + SUM1=SUM1-AMJET8(I-1+2) + AMGEN(I)=SUM1+RND(I)*(AMGEN(1)-SUM) + IF(AMGEN(I-1).LE.AMGEN(I)+AMJET8(I-1+2)) GO TO 200 +C Jacobean for sigma_n -> sigma_n-1 + WT=WT*PCM(AMGEN(I-1),AMGEN(I),AMJET8(I-1+2))*DELTAQ/(4*PI**2) +230 CONTINUE +C Jacobean for final 2-body decay differs by this factor + WT=WT*PI/(DELTAQ*EHMG) +C +C Carry out 2-body decays +C + DO 310 I=1,NJET1 + QCM=PCM(AMGEN(I),AMGEN(I+1),AMJET8(I+2)) + U(3)=2.*RANF()-1 + PHI=2*PI*RANF() + U(1)=SQRT(1-U(3)**2)*COS(PHI) + U(2)=SQRT(1-U(3)**2)*SIN(PHI) + DO 320 J=1,3 + PJETS8(J,I+2)=QCM*U(J) + PGEN(J,I+1)=-PJETS8(J,I+2) +320 CONTINUE + PJETS8(0,I+2)=SQRT(QCM**2+AMJET8(I+2)**2) + PGEN(0,I+1)=SQRT(QCM**2+AMGEN(I+1)**2) +310 CONTINUE +C + DO 330 J=0,3 + PJETS8(J,NJET+2)=PGEN(J,NJET) +330 CONTINUE +C +C Boost PGEN frames to lab frame. +C + DO 400 II=1,NJET1 + I=NJET-II + DO 410 J=1,3 + BETA(J)=PGEN(J,I)/PGEN(0,I) +410 CONTINUE + GAMMA=PGEN(0,I)/AMGEN(I) + DO 420 K=I,NJET + BP=BETA(1)*PJETS8(1,K+2)+BETA(2)*PJETS8(2,K+2)+ + $ BETA(3)*PJETS8(3,K+2) + DO 430 J=1,3 + PJETS8(J,K+2)=PJETS8(J,K+2)+GAMMA*BETA(J)*(PJETS8(0,K+2) + $ +BP*GAMMA/(GAMMA+1.)) +430 CONTINUE + PJETS8(0,K+2)=GAMMA*(PJETS8(0,K+2)+BP) +420 CONTINUE +400 CONTINUE +C +C Check limits +C + DO 500 I=1,NJET + PTI=SQRT(PJETS8(1,I+2)**2+PJETS8(2,I+2)**2) + IF(PTI.LE.PTMIN(I).OR.PTI.GE.PTMAX(I)) GO TO 999 + PPI=SQRT(PTI**2+PJETS8(3,I+2)**2) + IF(PPI.LE.PMIN(I).OR.PPI.GE.PMAX(I)) GO TO 999 + XJI=PJETS8(3,I+2)/PPI + IF(XJI.LE.XJMIN(I).OR.XJI.GE.XJMAX(I)) GO TO 999 + PHII=ATAN2(PJETS8(2,I+2),PJETS8(1,I+2)) + IF(PHII.LT.0) PHII=PHII+2*PI + IF(PHII.LE.PHIMIN(I).OR.PHII.GE.PHIMAX(I)) GO TO 999 + YI=-LOG(TAN(ACOS(XJI)/2)) + IF(YI.LE.YJMIN(I).OR.YI.GE.YJMAX(I)) GO TO 999 +500 CONTINUE +C + DO 510 I=1,NJET + DO 520 J=I+1,NJET + AMIJ=(PJETS8(0,I+2)+PJETS8(0,J+2))**2 + $ -(PJETS8(1,I+2)+PJETS8(1,J+2))**2 + $ -(PJETS8(2,I+2)+PJETS8(2,J+2))**2 + $ -(PJETS8(3,I+2)+PJETS8(3,J+2))**2 + AMIJ=SIGN(SQRT(ABS(AMIJ)),AMIJ) + IF(AMIJ.LE.AMIJMN(I,J).OR.AMIJ.GE.AMIJMX(I,J)) GO TO 999 +520 CONTINUE +510 CONTINUE +C + RETURN +C +999 WT=0 + RETURN + END diff --git a/ISAJET/code/nogood.F b/ISAJET/code/nogood.F new file mode 100644 index 00000000000..5ff92daaef3 --- /dev/null +++ b/ISAJET/code/nogood.F @@ -0,0 +1,153 @@ +#include "isajet/pilot.h" + LOGICAL FUNCTION NOGOOD(KK) +C +C Insure proper distribution and check kinematics. +C Select jet types. +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/keys.inc" +#include "isajet/wcon.inc" +#include "isajet/const.inc" +#include "isajet/wsig.inc" +#include "isajet/wgen.inc" +#include "isajet/dylim.inc" +#include "isajet/jetlim.inc" +#include "isajet/jetpar.inc" +#include "isajet/jetsig.inc" +#include "isajet/ptpar.inc" +#include "isajet/hcon.inc" +#include "isajet/xmssm.inc" +C + REAL RANF,SIGINV,SUM,TRY,BRANCH + INTEGER KK,I,II,K,IFL +C + NOGOOD=.TRUE. + GO TO (1,2,3,4,5,6),KK +C +C TWOJET, SUPERSYM, WPAIR or PHOTON events +C +1 CONTINUE + IF(KEYS(1)) THEN + CALL SIGQCD + ELSEIF(KEYS(5)) THEN + CALL SIGSSY + ELSEIF(KEYS(6)) THEN + CALL SIGWW + ELSEIF(KEYS(8)) THEN + CALL SIGGAM + ELSEIF(KEYS(10)) THEN + CALL SIGWH + ENDIF + IF(SIGMA.LE.0) RETURN + IF(SIGMAX*RANF().GT.SIGMA) RETURN + NOGOOD=.FALSE. + SIGINV=1./SIGMA + SUM=0. + TRY=RANF() + DO 100 I=1,NSIGS + SUM=SUM+SIGS(I)*SIGINV + IF(SUM.LT.TRY) GO TO 100 +C Find reaction + ISIGS=I + SIGEVT=SIGS(ISIGS) + II=INOUT(I) + DO 110 K=1,2 + INITYP(K)=MOD(II,IOPAK) +110 II=II/IOPAK + DO 120 K=1,2 + JETTYP(K)=MOD(II,IOPAK) +120 II=II/IOPAK + RETURN +100 CONTINUE + RETURN +C +C DRELLYAN events--test of SIGDY +C +2 CONTINUE + IF(KEYS(3)) THEN + CALL SIGDY + ELSEIF(KEYS(7).AND..NOT.GOMSSM) THEN + CALL SIGH + ELSEIF(KEYS(7).AND.GOMSSM) THEN + CALL SIGHSS + ELSEIF(KEYS(9)) THEN + CALL SIGTC + ELSEIF(KEYS(11)) THEN + CALL SIGKKG + ENDIF + IF(SIGMA.LE.0.) RETURN + IF(SIGSL(KSEL)*RANF().GT.SIGMA) RETURN + NOGOOD=.FALSE. + SIGINV=1./SIGMA + SUM=0. + TRY=RANF() +C Find reaction. + DO 200 I=1,NSIGS + SUM=SUM+SIGS(I)*SIGINV + IF(SUM.LT.TRY) GO TO 200 + ISIGS=I + SIGEVT=SIGS(ISIGS) + GO TO 210 +200 CONTINUE +C Unpack INOUT to find JETTYP and INITYP +210 IF(KEYS(3).OR.KEYS(11)) THEN + II=INOUT(I) + DO 220 K=1,2 + INITYP(K)=MOD(II,IOPAK) +220 II=II/IOPAK + JWTYP=MOD(II,IOPAK) + II=II/IOPAK + JETTYP(3)=MOD(II,IOPAK) + ELSEIF(KEYS(7).OR.KEYS(9)) THEN + II=INOUT(ISIGS) + DO 230 I=1,2 + INITYP(I)=MOD(II,IOPAK) +230 II=II/IOPAK + DO 240 I=1,2 + JETTYP(I)=MOD(II,IOPAK) +240 II=II/IOPAK + ENDIF + RETURN +C +C DRELLYAN events--test of SIGDY2 +C +3 CONTINUE + IF(KEYS(3)) THEN + CALL SIGDY2 + IFL=JETTYP(1)/2 + BRANCH=(AQ(IFL,JWTYP)**2+BQ(IFL,JWTYP)**2)/COUT(JWTYP) + ELSEIF(KEYS(7).AND..NOT.GOMSSM) THEN + CALL SIGH2 + BRANCH=1. + ELSEIF(KEYS(7).AND.GOMSSM) THEN + SIGLLQ=SIGMA/(4*PI) + NOGOOD=.FALSE. + RETURN + ELSEIF(KEYS(9)) THEN + CALL SIGTC2 + BRANCH=1. + ENDIF + IF(SIGLLQ.GT.SIGS(ISIGS)*BRANCH*3.*RANF()/(4.*PI)) + 1NOGOOD=.FALSE. + RETURN +C +C DRELLYAN events--test of kinematics +C +4 CONTINUE + DO 400 I=1,2 + IF(P(I).LT.PMIN(I).OR.P(I).GT.PMAX(I)) GO TO 410 + IF(PT(I).LT.PTMIN(I).OR.PT(I).GT.PTMAX(I)) GO TO 410 + IF(YJ(I).LT.YJMIN(I).OR.YJ(I).GT.YJMAX(I)) GO TO 410 + IF(PHI(I).LT.PHIMIN(I).OR.PHI(I).GT.PHIMAX(I)) GO TO 410 +400 CONTINUE + NOGOOD=.FALSE. +410 RETURN +C +5 CONTINUE +6 CONTINUE + RETURN +C + END diff --git a/ISAJET/code/ordecr.F b/ISAJET/code/ordecr.F new file mode 100644 index 00000000000..9e320e379c4 --- /dev/null +++ b/ISAJET/code/ordecr.F @@ -0,0 +1,34 @@ +#include "isajet/pilot.h" + SUBROUTINE ORDECR(IA,IB,N) +C---------------------------------------------------------------------- +C- +C- Purpose and Methods : +C- return an ordered array (by size of absolute values) +C- Warning: input array is destroyed +C- +C- Inputs : +C- IA(N) = input array +C- Outputs : +C- IB(N) = output ordered array +C- +C- Created 9-MAY-1988 Serban D. Protopopescu +C- +C---------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + INTEGER IA(*),IB(*),N,I,J,JSEL +C---------------------------------------------------------------------- + DO 2 I=1,N + JSEL=0 + IB(I)=0 + DO 1 J=1,N + IF(IABS(IA(J)).GT.IABS(IB(I))) THEN + IB(I)=IA(J) + JSEL=J + ENDIF + 1 CONTINUE + IF(JSEL.GT.0) IA(JSEL)=0 + 2 CONTINUE + 999 RETURN + END diff --git a/ISAJET/code/order.F b/ISAJET/code/order.F new file mode 100644 index 00000000000..301b17faad2 --- /dev/null +++ b/ISAJET/code/order.F @@ -0,0 +1,98 @@ +#include "isajet/pilot.h" + SUBROUTINE ORDER(ID,MODEIN,MODOUT,MEOUT) +C +C Search for mode MODEIN of particle ID in standard /DKYTAB/. +C If found, return MODOUT = standard order and MEOUT=MELEM. +C Otherwise return MODOUT = MODEIN and MEOUT=0. +C If ID<0, use antiparticles instead. +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +C +#include "isajet/itapes.inc" +#include "isajet/dkytab.inc" +#include "isajet/force.inc" +C + INTEGER ID,MODEIN(5),MODOUT(5),MODTST(5) + INTEGER IFL1,IFL2,IFL3,JSPIN,INDEX,LOOK0,IUSE(5),ISAME,I,J, + $NADD,NADDI,K,K1,K2,IDANTI,MEOUT +C +C Find standard starting point +C + CALL FLAVOR(ID,IFL1,IFL2,IFL3,JSPIN,INDEX) + IF(LOOK(INDEX).GT.0) THEN + LOOK0=LOOK(INDEX) + ELSEIF(LOOK(INDEX).LT.0) THEN + LOOK0=LOOKST(-LOOK(INDEX)) + ELSE + ISAME=0 + GO TO 300 + ENDIF +C +C Find NADD +C + DO 100 I=1,5 +100 IF(MODEIN(I).NE.0) NADD=I +C +C If ID<0, compare antiparticles +C + IF(ID.GE.0) THEN + DO 110 K=1,NADD +110 MODTST(K)=MODEIN(K) + ELSE + DO 120 K=1,NADD +120 MODTST(K)=IDANTI(MODEIN(K)) + ENDIF +C +C Scan all modes starting at LOOK0. Check for correct NADD. +C Then check that particles match in arbitrary order. +C + IF(LOOK0.LE.0) GO TO 300 + DO 200 I=LOOK0,MXDKY + DO 210 K=1,5 +210 IF(MODE(K,I).NE.0) NADDI=K + IF(NADDI.EQ.NADD) THEN + DO 220 K=1,5 +220 IUSE(K)=0 +C + DO 230 K1=1,NADD + DO 240 K2=1,NADD + IF(MODTST(K1).EQ.MODE(K2,I).AND.IUSE(K2).EQ.0) THEN + IUSE(K2)=K1 + GO TO 230 + ENDIF +240 CONTINUE + GO TO 201 +230 CONTINUE +C + ISAME=I + GO TO 300 + ENDIF +201 IF(CBR(I).GE.1.) THEN + ISAME=0 + GO TO 300 + ENDIF +200 CONTINUE + STOP 99 +C +C Return matching mode or original mode. +C +300 IF(ISAME.EQ.0) THEN + WRITE(ITLIS,3001) +3001 FORMAT(' ***** WARNING: NONSTANDARD MODE') + DO 310 K=1,5 +310 MODOUT(K)=MODEIN(K) + MEOUT=0 + ELSEIF(ID.GT.0) THEN + DO 320 K=1,5 +320 MODOUT(K)=MODE(K,ISAME) + MEOUT=MELEM(ISAME) + ELSE + DO 330 K=1,5 +330 MODOUT(K)=IDANTI(MODE(K,ISAME)) + MEOUT=MELEM(ISAME) + ENDIF +C + RETURN + END diff --git a/ISAJET/code/prtevt.F b/ISAJET/code/prtevt.F new file mode 100644 index 00000000000..8819a1b0839 --- /dev/null +++ b/ISAJET/code/prtevt.F @@ -0,0 +1,172 @@ +#include "isajet/pilot.h" + SUBROUTINE PRTEVT(IPRT) +C +C PRINT THE EVENT STORED IN /PJETS/, /JETSET/, AND /PARTCL/ +C IF IPRT IS SELECTED BY NEVPRT AND NJUMP. +C IPRT=0 ALWAYS PRINTS EVENT +C IPRT<0 PRINTS ONLY JET PARAMETERS +C +#include "isajet/itapes.inc" +#include "isajet/mbgen.inc" +#include "isajet/pjets.inc" +#include "isajet/pinits.inc" +#include "isajet/jetset.inc" +#include "isajet/idrun.inc" +#include "isajet/jetsig.inc" +#include "isajet/keys.inc" +#include "isajet/jetpar.inc" +#include "isajet/lstprt.inc" +#include "isajet/partcl.inc" +#include "isajet/primar.inc" +#include "isajet/prtout.inc" +#include "isajet/wsig.inc" +#include "isajet/seed.inc" +C +C LABELS ARE CHARACTER*8 + CHARACTER*8 LABEL,LW,LJET,LPTCL + INTEGER N0J +C +C DECIDE WHETHER TO PRINT + IF(IPRT.GT.NJUMP*NEVPRT) THEN + IF(NJUMP.GT.0) THEN + IF(MOD(IPRT,NJUMP).EQ.0) WRITE(ITLIS,5) IDG,IEVT,XSEED +5 FORMAT(/6X,'RUN ID',2I10,5X,'EVENT NO',I8,5X,'SEED',2X,A24) + ENDIF + RETURN + ENDIF + IF(IPRT.GT.1.AND.MOD(IPRT,NJUMP).NE.0) RETURN + IF(IEVT.EQ.LSTPRT) RETURN + PI=4.*ATAN(1.) + LSTPRT=IEVT +C PRINT EVENT NUMBER + WRITE(ITLIS,10) IDG,IEVT,XSEED +10 FORMAT('1',5X,'RUN ID',2I10.6,5X,'EVENT NO',I8,5X,'SEED',2X,A24) +C +C PRINT JET PARAMETERS + IF(NJET.EQ.0) GO TO 300 + WRITE(ITLIS,20) +20 FORMAT(//20X,'JET PARAMETERS'//3X,'JET',4X,'TYPE ', + 18X,'PX',8X,'PY',8X,'PZ',8X,'P0',8X,'PT', + 25X,'THETA',7X,'PHI',9X,'X',9X,'Y') + IF(KEYS(3).OR.KEYS(7).OR.KEYS(11)) THEN + LW=LABEL(IDENTW) + WRITE(ITLIS,31) LW,(QWJET(K),K=1,4),QTW,THW,PHIW,XW,YW +31 FORMAT(5X,'-',4X,A5,5F10.2,4F10.4) + ENDIF + IF(KEYS(11)) THEN + N0J=3 + ELSE + N0J=1 + ENDIF + DO 100 I=N0J,NJET + LJET=LABEL(IDJETS(I)) + WRITE(ITLIS,30) I,LJET,(PJETS(K,I),K=1,4),PT(I),TH(I),PHI(I), + $XJ(I),YJ(I) +30 FORMAT(1X,I5,4X,A5,5F10.2,4F10.4) +100 CONTINUE +C PRINT WPAIR DECAY PARAMETERS + IF(KEYS(6).OR.KEYS(7).OR.KEYS(10)) THEN + IF(NPAIR.NE.0) THEN + WRITE(ITLIS,101) +101 FORMAT(//20X,'WPAIR DECAY PARAMETERS'//3X,'JET',4X,'TYPE ', + $ 8X,'PX',8X,'PY',8X,'PZ',8X,'P0',8X,'PT', + $ 5X,'THETA',7X,'PHI',9X,'X',9X,'Y') + DO 102 I=1,NPAIR + JET=JPAIR(I) + LJET=LABEL(IDPAIR(I)) + PTPRT=SQRT(PPAIR(1,I)**2+PPAIR(2,I)**2) + THPRT=ACOS(PPAIR(3,I)/SQRT(PTPRT**2+PPAIR(3,I)**2)) + PHIPRT=ATAN2(PPAIR(2,I),PPAIR(1,I)) + XPRT=2*PPAIR(3,I)/ECM + YPRT=-ALOG(TAN(THPRT/2.)) + WRITE(ITLIS,30) JET,LJET,(PPAIR(K,I),K=1,4), + $ PTPRT,THPRT,PHIPRT,XPRT,YPRT +102 CONTINUE + ENDIF + ENDIF + IF(IPRT.LT.0) RETURN +C +C PRINT JET CROSS SECTIONS +201 CONTINUE + IF(KEYS(1).OR.KEYS(5).OR.KEYS(6).OR.KEYS(10)) THEN + WRITE(ITLIS,39) SIGEVT +39 FORMAT(//5X,'D(SIGMA)/D(PT**2)D(Y1)D(Y2) = ',E12.4) + ENDIF + IF(KEYS(3).OR.KEYS(7).OR.KEYS(11)) THEN + IF(NJET.EQ.3) THEN + WRITE(ITLIS,38) LW,QMW,SIGEVT,SIGLLQ +38 FORMAT(//5X,'MASS OF ',A8,' = ',F10.3// + C 5X,'D(SIGMA)/D(Q**2)D(QT**2)D(YW)D(YJ) = ',E12.4/ + C 5X,'D(SIGMA)/D(Q**2)D(QT**2)D(YW)D(YJ)D(OMEGA) = ',E12.4) + ELSE + WRITE(ITLIS,37) LW,QMW,SIGEVT,SIGLLQ +37 FORMAT(//5X,'MASS OF ',A8,' = ',F10.3// + 1 5X,'D(SIGMA)/D(Q**2)D(YW) =',E12.4/ + 2 5X,'D(SIGMA)/D(Q**2)D(YW)D(OMEGA) =',E12.4) + ENDIF + ENDIF + IF(KEYS(2)) THEN + WRITE(ITLIS,32) SIGEVT +32 FORMAT(//5X,'D(SIGMA)/D(COS THETA) = ',E12.4) + ENDIF +C +C PRINT /JETSET/ PARAMETERS + IF(KEYS(4)) GO TO 300 + IF(NJSET.EQ.0) GO TO 300 + WRITE(ITLIS,70) +70 FORMAT(//20X,'PARTON CASCADE PARAMETERS'// + C 6X,'I',3X,'JET',4X,'ORIG',4X,'TYPE',9X,'DECAY', + C 8X,'PX',8X,'PY',8X,'PZ',8X,'P0',6X,'MASS') + DO 310 I=1,NJSET + JET=JORIG(I)/JPACK + I1=MOD(JORIG(I),JPACK) + JTLV1=JTYPE(I) + LJET=LABEL(JTLV1) + J1=JDCAY(I)/JPACK + J2=MOD(JDCAY(I),JPACK) + IF(JDCAY(I).EQ.0) THEN + WRITE(ITLIS,71) I,JET,I1,LJET,(PJSET(K,I),K=1,5) +71 FORMAT(1X,I6,I6,I8,4X,A5,8X,'FINAL',5F10.2) + ELSEIF(J1.NE.J2) THEN + WRITE(ITLIS,72) I,JET,I1,LJET,J1,J2,(PJSET(K,I),K=1,5) +72 FORMAT(1X,I6,I6,I8,4X,A5,4X,I4,'-',I4,5F10.2) + ELSE + WRITE(ITLIS,73) I,JET,I1,LJET,(PJSET(K,I),K=1,5) +73 FORMAT(1X,I6,I6,I8,4X,A5,6X,'INITIAL',5F10.2) + ENDIF +310 CONTINUE +C +C PRINT HADRON PARAMETERS +300 IF(NPTCL.EQ.0) RETURN + IF(.NOT.KEYS(2)) WRITE(ITLIS,45) NPOM +45 FORMAT(//' NUMBER OF POMERONS =',I5) + WRITE(ITLIS,40) +40 FORMAT(//20X,'HADRON PARAMETERS'//7X,'I',3X,'JET',5X,'ORIG' + C ,4X,'TYPE',11X,'DECAY',8X,'PX',8X,'PY',8X,'PZ',8X,'P0' + C ,8X,'PT',5X,'THETA',7X,'PHI') + DO 200 I=1,NPTCL + I1=IABS(IORIG(I)) + JET=I1/IPACK + I1=I1-IPACK*JET + I1=ISIGN(I1,IORIG(I)) + IDLV1=IDENT(I) + LPTCL=LABEL(IDLV1) + J1=IDCAY(I)/IPACK + J2=MOD(IDCAY(I),IPACK) + PTHAD=SQRT(PPTCL(1,I)**2+PPTCL(2,I)**2) + PHAD=SQRT(PPTCL(3,I)**2+PTHAD**2) + PHIHAD=ATAN2(PPTCL(2,I),PPTCL(1,I)) + IF(PHIHAD.LT.0.) PHIHAD=2.*PI+PHIHAD + THHAD=ACOS(PPTCL(3,I)/PHAD) + IF(IDCAY(I).EQ.0) THEN + WRITE(ITLIS,50) I,JET,I1,LPTCL,(PPTCL(K,I),K=1,4),PTHAD,THHAD, + $ PHIHAD +50 FORMAT(1X,I7,I6,I9,4X,A5,9X,'STABLE',5F10.2,2F10.4) + ELSE + WRITE(ITLIS,60) I,JET,I1,LPTCL,J1,J2,(PPTCL(K,I),K=1,4), + $ PTHAD,THHAD,PHIHAD +60 FORMAT(1X,I7,I6,I9,4X,A5,4X,I5,'-',I5,5F10.2,2F10.4) + ENDIF +200 CONTINUE + RETURN + END diff --git a/ISAJET/code/prtlim.F b/ISAJET/code/prtlim.F new file mode 100644 index 00000000000..a9593467e93 --- /dev/null +++ b/ISAJET/code/prtlim.F @@ -0,0 +1,359 @@ +#include "isajet/pilot.h" + SUBROUTINE PRTLIM +C +C Print initial conditions and limits for generating jets +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/force.inc" +#include "isajet/mbgen.inc" +#include "isajet/qcdpar.inc" +#include "isajet/qlmass.inc" +#include "isajet/wcon.inc" +#include "isajet/jetpar.inc" +#include "isajet/keys.inc" +#include "isajet/kkgrav.inc" +#include "isajet/frgpar.inc" +#include "isajet/nodcay.inc" +#include "isajet/prtout.inc" +#include "isajet/seed.inc" +#include "isajet/types.inc" +#include "isajet/q1q2.inc" +#include "isajet/jetlim.inc" +#include "isajet/primar.inc" +#include "isajet/ptpar.inc" +#include "isajet/idrun.inc" +#include "isajet/dylim.inc" +#include "isajet/hcon.inc" +#include "isajet/isloop.inc" +#include "isajet/xmssm.inc" +C + INTEGER I,II,K,NPRT,I1,I2,I3,J1,INDEX,IQ,KK,KKK,NN,N0J + REAL AMASS + CHARACTER*8 LSTRUC(6),LMODE(5),STUF(6),IDFMT(2) + CHARACTER*8 WTITL(4) + CHARACTER*8 LABEL,L0 + CHARACTER*8 BLANK + CHARACTER*40 V,VISAJE + REAL AM(6),AML(6) + INTEGER NPRSS + PARAMETER (NPRSS=32) + INTEGER IDPRSS(NPRSS) + REAL AMPRSS(NPRSS) + CHARACTER*8 LPRSS(NPRSS) + DATA LSTRUC/'OWENS','BAIER','EICHTEN','DUKE','CTEQ2L','CTEQ3L'/ + DATA WTITL/'GM','W+','W-','Z0'/ + DATA BLANK/' '/ + DATA IDPRSS/21,22,23,24,25,26,41,42,43,44,45,46, + $31,32,33,34,35,36,52,54,56, + $29,30,40,50,60,39,49,82,83,84,86/ +C +C Print version + V=VISAJE() + WRITE(ITLIS,1000) V +1000 FORMAT('1',44('*')/' *',42X,'*'/ + C ' * ',A40,' *'/ + C ' *',42X,'*'/' ',44('*')/) +C +C Print title, reaction, energy, number, run id + WRITE(ITLIS,1010) TITLE +1010 FORMAT(/11X,10A8) + WRITE(ITLIS,1020) NJET +1020 FORMAT(/2X,'NUMBER OF JETS TO BE GENERATED PER EVENT',I3) + DO 100 I=1,2 + IDFMT(I)=LABEL(IDIN(I)) +100 CONTINUE + WRITE(ITLIS,1030) IDFMT(1),IDFMT(2),ECM +1030 FORMAT(/2X,A8,' ON ',A8,' AT COM ENERGY',E15.4) + WRITE(ITLIS,1040) REAC,NEVENT +1040 FORMAT(/2X,'NUMBER OF ',A8,' EVENTS TO BE GENERATED',I10) + IF(NEVPRT.GT.0) WRITE(ITLIS,1050) NEVPRT,NJUMP +1050 FORMAT(/2X,'PRINT A MAXIMUM OF ',I6, + C ' EVENTS SKIPPING ',I6,' EVENTS AT A TIME') + WRITE(ITLIS,1060) IDG +1060 FORMAT(/2X,'RUN ID ',2I10.6) +C +C Print W/Higgs parameters +C + IF(KEYS(3).OR.KEYS(7).OR.KEYS(11)) THEN + IF(KEYS(3)) THEN + II=0 + DO 200 I=1,4 + IF(.NOT.GODY(I)) GOTO 200 + II=II+1 + STUF(II)=WTITL(I) +200 CONTINUE + ELSEIF(KEYS(11)) THEN + II=1 + STUF(II)='GRAV' + ELSE + II=1 + STUF(II)='HIGGS' + IF(IHTYPE.EQ.82) STUF(II)='HL0' + IF(IHTYPE.EQ.83) STUF(II)='HH0' + IF(IHTYPE.EQ.84) STUF(II)='HA0' + ENDIF + WRITE(ITLIS,2000) (STUF(K),K=1,II) +2000 FORMAT(//10X,'PARAMETERS FOR',4(2X,A8)) + WRITE(ITLIS,2010) QMIN,QMAX +2010 FORMAT(' MASS LIMITS',15X,2E15.4) + WRITE(ITLIS,3020) QTMIN,QTMAX + WRITE(ITLIS,3030) THWMIN,THWMAX + WRITE(ITLIS,3040) PHWMIN,PHWMAX + WRITE(ITLIS,3050) YWMIN,YWMAX + WRITE(ITLIS,3060) XWMIN,XWMAX + NPRT=0 + IF(FIXQT) THEN + NPRT=NPRT+1 + STUF(NPRT)='QTW ' + ENDIF + IF(FIXQM) THEN + NPRT=NPRT+1 + STUF(NPRT)='QMW ' + ENDIF + IF(FIXYW) THEN + NPRT=NPRT+1 + STUF(NPRT)='YW ' + ENDIF + IF(FIXXW) THEN + NPRT=NPRT+1 + STUF(NPRT)='XW ' + ENDIF + IF(FIXPHW) THEN + NPRT=NPRT+1 + STUF(NPRT)='PHW ' + ENDIF + IF(NPRT.NE.0) WRITE(ITLIS,2070) (STUF(K),K=1,NPRT) + ENDIF +C +C Print jet parameters +C + DO 300 I=1,6 +300 STUF(I)=BLANK + IF(KEYS(11)) THEN + N0J=3 + ELSE + N0J=1 + ENDIF + DO 310 I=N0J,NJET + NPRT=0 + WRITE(ITLIS,3000) I +3000 FORMAT(//10X,'JET NO.',I3,/) + WRITE(ITLIS,3010) PMIN(I),PMAX(I) +3010 FORMAT(' MOMENTUM LIMITS',11X,2E15.4) + WRITE(ITLIS,3020) PTMIN(I),PTMAX(I) +3020 FORMAT(' TRANSVERSE MOMENTUM LIMITS',2E15.4) + WRITE(ITLIS,3030) THMIN(I),THMAX(I) +3030 FORMAT(' THETA LIMITS',14X,2E15.4) + WRITE(ITLIS,3040) PHIMIN(I),PHIMAX(I) +3040 FORMAT(' PHI LIMITS',16X,2E15.4) + WRITE(ITLIS,3050) YJMIN(I),YJMAX(I) +3050 FORMAT(' RAPIDITY (Y) LIMITS',7X,2E15.4) + WRITE(ITLIS,3060) XJMIN(I),XJMAX(I) +3060 FORMAT(' FEYNMAN X LIMITS',10X,2E15.4) + IF(.NOT.GOALL(I)) WRITE(ITLIS,3070) (JETYP(K,I),K=1,NJTTYP(I)) +3070 FORMAT(' JET TYPE',23X,A8,1X,A8,1X,A8,1X,A8,1X,A8) + IF((KEYS(6).OR.KEYS(7)).AND..NOT.ALLWW(I)) + $ WRITE(ITLIS,3080) (WWTYP(K,I),K=1,NWWTYP(I)) +3080 FORMAT(' DECAY MODES',20X,A8,1X,A8,1X,A8,1X,A8,1X,A8) + IF(FIXP(I)) THEN + NPRT=NPRT+1 + STUF(NPRT)='P ' + ENDIF + IF(FIXPT(I)) THEN + NPRT=NPRT+1 + STUF(NPRT)='PT ' + ENDIF + IF(FIXYJ(I)) THEN + NPRT=NPRT+1 + STUF(NPRT)='TH ' + NPRT=NPRT+1 + STUF(NPRT)='Y ' + ENDIF + IF(FIXPHI(I)) THEN + NPRT=NPRT+1 + STUF(NPRT)='PHI ' + ENDIF + IF(FIXXJ(I)) THEN + NPRT=NPRT+1 + STUF(NPRT)='X ' + ENDIF + IF(NPRT.EQ.0) GOTO 310 + WRITE(ITLIS,2070) (STUF(K),K=1,NPRT) +2070 FORMAT(/5X,'FOLLOWING PARAMETERS HAVE BEEN FIXED ',6A8) +310 CONTINUE +C +C Print structure functions, QCD parameters, W parameters, +C and other parameters changed from their default values. +C + IF(KEYS(1).OR.KEYS(3).OR.KEYS(5).OR.KEYS(6).OR.KEYS(7) + $.OR.KEYS(8).OR.KEYS(9).OR.KEYS(11).OR.KEYS(12)) THEN + IF(ISTRUC.GT.0) THEN + WRITE(ITLIS,4000) LSTRUC(ISTRUC) +4000 FORMAT(//1X,A8,' STRUCTURE FUNCTIONS') + ELSEIF(ISTRUC.EQ.-999) THEN + WRITE(ITLIS,4001) +4001 FORMAT(//1X,' PDFLIB STRUCTURE FUNCTIONS') + ENDIF + ENDIF + WRITE(ITLIS,4010) ALAM,CUTJET +4010 FORMAT(//' QCD LAMBDA =',F10.4,10X,'JET CUTOFF MASS =',F10.3) + WRITE(ITLIS,4020) AMLEP(6),AMLEP(7),AMLEP(8) +4020 FORMAT(/' HEAVY QUARK MASSES =',3F8.2) + IF(LOC(36).NE.0) THEN + CALL FLAVOR(80,I1,I2,I3,J1,INDEX) + WRITE(ITLIS,4030) (AMLEP(INDEX+K),K=1,9) +4030 FORMAT(/' HIGGS MASSES =',6F8.2/15X,3F8.2) + ENDIF +C Supersymmetry + IF(KEYS(5).AND..NOT.GOMSSM) THEN + DO 410 IQ=1,6 + AM(IQ)=AMASS(20+IQ) + AML(IQ)=AMASS(30+IQ) +410 CONTINUE + WRITE(ITLIS,4040) (AM(KK),KK=1,6) +4040 FORMAT(//' SQUARK MASSES ',7F9.2) + WRITE(ITLIS,4050) (AML(KK),KK=1,6) +4050 FORMAT(' SLEPTON MASSES ',7F9.2) + AM(1)=AMASS(29) + AM(2)=AMASS(30) + AM(3)=AMASS(39) + AM(4)=AMASS(40) + WRITE(ITLIS,4060) (AM(KK),KK=1,4) +4060 FORMAT(' GAUGINO MASSES (WITH SIGNS) ',7F9.2) + IF(LOC(44).NE.0) WRITE(ITLIS,4070) XGENSS(9), + $ (XGENSS(KK),KK=1,8) +4070 FORMAT(/' FRAG. PARAM. XGENSS = ',9F8.3) + ENDIF +C MSSM model + IF(GOMSSM) THEN + DO 420 I=1,NPRSS + LPRSS(I)=LABEL(IDPRSS(I)) + AMPRSS(I)=AMASS(IDPRSS(I)) +420 CONTINUE + WRITE(ITLIS,4100) (LPRSS(I),AMPRSS(I),I=1,NPRSS) +4100 FORMAT(/' MSSM MASSES (WITHOUT SIGNS):'/ + $ 10(' M(',A5,') = ',F10.3,5X,'M(',A5,') = ',F10.3, + $ 5X,'M(',A5,') = ',F10.3/), + $ ' M(',A5,') = ',F10.3,5X,'M(',A5,') = ',F10.3) + IF(.NOT.GOSUG) THEN + WRITE(ITLIS,4110) XTBSS,XMUSS,XATSS +4110 FORMAT(/' OTHER MSSM PARAMETERS:'/ + $ ' TAN(BETA) = ',F10.3,5X,'MU = ',F10.3,5X,'A_t = ',F10.3) + ENDIF + IF(GOSUG) THEN + WRITE(ITLIS,4120) XM0SU,XMHSU,XA0SU,XTGBSU,XSMUSU +4120 FORMAT(/' DETERMINED FROM SUGRA INPUT:'/ + $ ' M_0 =',F10.3,' M_(1/2) =',F10.3,' A_0 =',F10.3/ + $ ' TAN(BETA) =',F10.4,' SGN(MU) =',F6.1) + ENDIF + ENDIF +C +C Other parameters +C + IF(LOC(30).NE.0) WRITE(ITLIS,4200) XGEN +4200 FORMAT(/' FRAGMENTATION PARAMETER XGEN =',6F8.3) + IF(LOC(31).NE.0) WRITE(ITLIS,4210) SIGQT +4210 FORMAT(/' FRAGMENTATION PARAMETER SIGQT =',F8.3) + IF(KEYS(2).OR.KEYS(3).OR.KEYS(6).OR.KEYS(7)) THEN + WRITE(ITLIS,4220) SIN2W,WMASS(2),WMASS(4),WGAM(2),WGAM(4) +4220 FORMAT(//' WEINBERG MODEL',5X,'SIN**2(THETA-W)=',F8.4/ + $ ' MASSES = ',F8.2,',',F8.2,' WIDTHS = ',F8.3,',',F8.3) + ENDIF + IF(KEYS(3)) THEN + IF(.NOT.STDDY) WRITE(ITLIS,4230) CUTOFF,CUTPOW +4230 FORMAT(/' CUTOFF FUNCTION IS QT**2=',E11.4,'*Q**',E11.4) + IF(LOC(50).NE.0) WRITE(ITLIS,4240) WFUDGE +4240 FORMAT(/' W fudge factor (WFUDGE) = ',F8.3) + ENDIF + IF(KEYS(7)) THEN + WRITE(ITLIS,4250) HMASS,HGAM +4250 FORMAT(/' HIGGS MASS = ',F8.2,' WIDTH = ',F8.3) + ENDIF + WRITE(ITLIS,4260) XSEED +4260 FORMAT(/' SEED FOR RANDOM NUMBER GENERATOR = ',A24) + IF(LOC(13).NE.0) WRITE(ITLIS,4270) FRPAR +4270 FORMAT(//' FRAGMENTATION PARAMETERS ',8E11.3,2(/,26X,8E11.3)) + IF(LOC(34).NE.0) WRITE(ITLIS,4280) MNPOM,MXPOM +4280 FORMAT(//' NUMBER OF POMERONS =',I4,' TO',I4) +C +C Print KKG parameters + IF(KEYS(11)) THEN + WRITE(ITLIS,4291) NEXTRAD + WRITE(ITLIS,4292) MASSD + WRITE(ITLIS,4296) SURFD + WRITE(ITLIS,4295) KKGSD + WRITE(ITLIS,4297) UVCUT +4291 FORMAT(//' NB EXTRA-DIMENSIONS',7X,I4) +4292 FORMAT(' SCALE M_D',15X,E15.4) +4295 FORMAT(' KKGSD FACTOR',12X,E15.4) +4296 FORMAT(' SD SURFACE',14X,E15.4) +4297 FORMAT(' UV CUTOFF',17X,I4) + ENDIF +C +C Decay switches +C + IF(LOC(46).NE.0) THEN + WRITE(ITLIS,4300) +4300 FORMAT(//' SECONDARY W DECAY MODES:') + NN=MAX0(NWMODE(1),1) + WRITE(ITLIS,4310) (WMODES(KKK,1),KKK=1,NN) +4310 FORMAT(' W+ --> ' + $ ,A8,1X,A8,1X,A8,1X,A8,1X,A8,1X,A8,1X,A8,1X,A8) + NN=MAX0(NWMODE(2),1) + WRITE(ITLIS,4320) (WMODES(KKK,2),KKK=1,NN) +4320 FORMAT(' W- --> ' + $ ,A8,1X,A8,1X,A8,1X,A8,1X,A8,1X,A8,1X,A8,1X,A8) + WRITE(ITLIS,4330) (WMODES(KKK,3),KKK=1,NN) +4330 FORMAT(' Z0 --> ' + $ ,A8,1X,A8,1X,A8,1X,A8,1X,A8,1X,A8,1X,A8,1X,A8) + ENDIF +C + IF(NODCAY) WRITE(ITLIS,4400) +4400 FORMAT(//' NO DECAYS OF HADRONS WILL BE GENERATED') + IF(NOETA) WRITE(ITLIS,4410) +4410 FORMAT(//' NO DECAYS OF ETAS WILL BE GENERATED') + IF(NOPI0) WRITE(ITLIS,4420) +4420 FORMAT(//' NO DECAYS OF PI0S WILL BE GENERATED') + IF(NONUNU) WRITE(ITLIS,4430) +4430 FORMAT(//' NO DECAYS Z0---->NU+NU WILL BE GENERATED') + IF(NOEVOL) WRITE(ITLIS,4440) +4440 FORMAT(//' NO QCD JET EVOLUTION WILL BE DONE') + IF(NOHADR) WRITE(ITLIS,4450) +4450 FORMAT(//' NO JET HADRONIZATION WILL BE DONE') + IF(GOGMSB.AND.NOGRAV) WRITE(ITLIS,4460) +4460 FORMAT(//' NO GRAVITINO DECAYS WILL BE GENERATED') +C +C Print forced decay modes and M.E. flag +C + IF(NFORCE.NE.0) THEN + WRITE(ITLIS,4500) +4500 FORMAT(//7X,'FORCED DECAY MODES (MATRIX ELEMENT FLAGS)'/ + $ 2X,'PART',6X,'DECAY MODE') + DO 450 I=1,NFORCE + IF(IFORCE(I).EQ.0) GOTO 450 + L0=LABEL(IFORCE(I)) + DO 451 K=1,5 + LMODE(K)=BLANK + IF(MFORCE(K,I).EQ.0) GO TO 451 + LMODE(K)=LABEL(MFORCE(K,I)) +451 CONTINUE + WRITE(ITLIS,4510) L0,(LMODE(K),K=1,5),MEFORC(I) +4510 FORMAT(2X,6A10,'(M.E. =',I5,')') +450 CONTINUE + ENDIF +C +C Print multiple evolution/fragmentation information +C + IF(NEVOLV.NE.1.OR.NFRGMN.NE.1) THEN + WRITE(ITLIS,4600) NEVOLV,NFRGMN +4600 FORMAT(//, + $ ' MULTIPLE EVOLUTION AND FRAGMENTATION VERSION'/ + $ ' EVENTS WILL BE EVOLVED',I6,' TIMES'/ + $ ' AND FRAGMENTED ',I6,' TIMES'/) + ENDIF +C + RETURN + END diff --git a/ISAJET/code/ptfun.F b/ISAJET/code/ptfun.F new file mode 100644 index 00000000000..52af3b51b48 --- /dev/null +++ b/ISAJET/code/ptfun.F @@ -0,0 +1,181 @@ +#include "isajet/pilot.h" + SUBROUTINE PTFUN +C +C Calculate an envelope +C D(SIGMA)/D(PT**2)D(Y1)D(Y2) < PTFUN1*PT**PTFUN2 +C used to generate initial PT values. +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/keys.inc" +#include "isajet/const.inc" +#include "isajet/jetlim.inc" +#include "isajet/ptpar.inc" +#include "isajet/jetpar.inc" +#include "isajet/jetsig.inc" +C + REAL PCPY(24) + EQUIVALENCE(P(1),PCPY(1)) + REAL PTS(51),SIGSAV(51),STOR(24),DPT,DPTMIN,A,B,DEVMAX,DEV + REAL DY1,DY2,B1 + INTEGER I,NPT,NDIV1,NDIV2,I1,I2 +C + DATA DPTMIN/0.2/ +C +C Initialize + DO 89 I=1,24 + 89 STOR(I)=PCPY(I) + YJ(1)=0 + YJ(2)=0 + TH(1)=PI/2. + TH(2)=PI/2. + STH(1)=1. + STH(2)=1. + CTH(1)=0. + CTH(2)=0. + PHI(1)=0. + PHI(2)=PI + IF(FIXPT(1).OR.FIXPT(2)) GOTO 300 + DPT=(PTMAX(1)-PTMIN(1))/25. + IF(DPT.LT.DPTMIN) DPT=DPTMIN + NPT=(PTMAX(1)-PTMIN(1))/DPT+1 + IF(NPT.GT.51) NPT=50 + IF(NPT.LE.1) NPT=2 +C +C Calculate sigma vs PT at Y1=Y2=0 + DO 100 I=1,NPT + PT(1)=PTMIN(1)+DPT*(I-1) + PT(2)=PT(1) + P(1)=PT(1) + P(2)=PT(2) + IF(KEYS(1)) THEN + CALL SIGQCD + ELSEIF(KEYS(5)) THEN + CALL SIGSSY + ELSEIF(KEYS(6)) THEN + CALL SIGWW + ELSEIF(KEYS(8)) THEN + CALL SIGGAM + ELSEIF(KEYS(10)) THEN + CALL SIGWH + ENDIF + IF(SIGMA.EQ.0.) GO TO 9999 + SIGSAV(I)=ALOG(SIGMA) + PTS(I)=ALOG(PT(1)) + 100 CONTINUE +C +C Fit to power and shift to get envelope +C + CALL LSTSQ(PTS,SIGSAV,NPT,A,B) + DEVMAX=0. + DO 101 I=1,NPT + DEV=SIGSAV(I)-A-B*PTS(I) + IF(DEV.GT.DEVMAX) DEVMAX=DEV + 101 CONTINUE +C +C Scan in Y1, Y2 for 3 PT values +C + DO 104 I=1,3 + IF(I.EQ.1) PT(1)=PTMIN(1) + IF(I.EQ.2) PT(1)=(PTMIN(1)+PTMAX(1))/2. + IF(I.EQ.3) PT(1)=PTMAX(1) + PT(2)=PT(1) + NDIV1=YJMAX(1)-YJMIN(1) + IF(NDIV1.GT.20) NDIV1=20 + NDIV2=YJMAX(2)-YJMIN(2) + IF(NDIV2.GT.20) NDIV2=20 + IF(NDIV1.LE.1) NDIV1=2 + IF(NDIV2.LE.1) NDIV2=2 + DY1=(YJMAX(1)-YJMIN(1))/(NDIV1-1) + DY2=(YJMAX(2)-YJMIN(2))/(NDIV2-1) + IF(FIXYJ(1)) NDIV1=1 + IF(FIXYJ(2)) NDIV2=1 +C + DO 103 I1=1,NDIV1 + YJ(1)=YJMIN(1)+(I1-1)*DY1 + CTH(1)=TANH(YJ(1)) + STH(1)=SQRT(1.-CTH(1)**2) + IF(STH(1).EQ.0) GOTO 103 + TH(1)=ACOS(CTH(1)) + P(1)=PT(1)/STH(1) +C + DO 102 I2=1,NDIV2 + YJ(2)=YJMIN(2)+(I2-1)*DY2 + CTH(2)=TANH(YJ(2)) + STH(2)=SQRT(1.-CTH(2)**2) + IF(STH(2).EQ.0) GOTO 103 + TH(2)=ACOS(CTH(2)) + P(2)=PT(2)/STH(2) + IF(KEYS(1)) THEN + CALL SIGQCD + ELSEIF(KEYS(5)) THEN + CALL SIGSSY + ELSEIF(KEYS(6)) THEN + CALL SIGWW + ELSEIF(KEYS(8)) THEN + CALL SIGGAM + ELSEIF(KEYS(10)) THEN + CALL SIGWH + ENDIF + IF(SIGMA.EQ.0.) GO TO 102 + DEV=ALOG(SIGMA)-A-B*ALOG(PT(1)) + IF(DEV.GT.DEVMAX) DEVMAX=DEV + 102 CONTINUE + 103 CONTINUE + 104 CONTINUE +C + A=A+DEVMAX + B1=B+2. + PTFUN1=EXP(A) + PTFUN2=B +C +C Use envelope to generate initial PT values +C + PTGEN1=PTMIN(1)**B1 + PTGEN2=PTMAX(1)**B1-PTGEN1 + PTGEN3=1./B1 + DO 109 I=1,24 + 109 PCPY(I)=STOR(I) +C +C Write envelope parameters on listing +C + WRITE(ITLIS,200) PTFUN1,PTFUN2,PTGEN1,PTGEN2,PTGEN3 +200 FORMAT(//10X,'FIT AT Y1=Y2=0 IS D(SIGMA)/D(PT**2)D(Y1)D(Y2)=' + C ,E11.5,'*PT**(',E11.5,')'// + C 10X,'PT FIRST GENERATED BY PT=(',E11.5,'+',E11.5,'*RANF)**(', + C E11.5,')') +C + RETURN +C +C Fixed PT +C + 300 CONTINUE + IF(FIXPT(1)) PT(2)=PT(1) + IF(FIXPT(2)) PT(1)=PT(2) + P(1)=PT(1) + P(2)=PT(2) + IF(KEYS(1)) THEN + CALL SIGQCD + ELSEIF(KEYS(5)) THEN + CALL SIGSSY + ELSEIF(KEYS(6)) THEN + CALL SIGWW + ELSEIF(KEYS(8)) THEN + CALL SIGGAM + ELSEIF(KEYS(10)) THEN + CALL SIGWH + ENDIF + SIGMAX=SIGMA + DO 301 I=1,24 +301 PCPY(I)=STOR(I) +C + RETURN +C +C Fit fails if SIGMA=0 in specified range +9999 WRITE(ITLIS,1010) PT(1) +1010 FORMAT(//' ERROR IN PTFUN...SIGMA=0 FOR PT = ',E12.4/ + 1' CHECK YOUR LIMITS.') + STOP 99 + END diff --git a/ISAJET/code/qcdini.F b/ISAJET/code/qcdini.F new file mode 100644 index 00000000000..5e18ac65e34 --- /dev/null +++ b/ISAJET/code/qcdini.F @@ -0,0 +1,398 @@ +#include "isajet/pilot.h" + SUBROUTINE QCDINI(JIN1,JIN2) +C +C GENERATE INITIAL-STATE QCD CASCADE USING BACKWARDS +C EVOLUTION OF GOTTSCHALK AND OF SJOSTRAND. +C +C IF QCDINI FAILS WHEN ATTEMPTING TO FORCE GL-->QK+QB FOR +C HEAVY QUARKS, THEN RETURN NJSET=-1. +C +C VER. 6.40: TRAP W1LIM > 0 TO PREVENT ROUNDING ERRORS. +C +#include "isajet/itapes.inc" +#include "isajet/idrun.inc" +#include "isajet/pinits.inc" +#include "isajet/jetpar.inc" +#include "isajet/qcdpar.inc" +#include "isajet/jetset.inc" +#include "isajet/jwork.inc" +#include "isajet/jwork2.inc" +#include "isajet/const.inc" +#include "isajet/primar.inc" +#include "isajet/keys.inc" +C + DIMENSION BOOST1(5),BOOST2(5),B2B1(5),DBL1(5),DBL2(5) + DIMENSION FXOLD(2),FXNEW(2) + DIMENSION PJKEEP(5,12),JINS(2),JLIST(16),PFKEEP(5) +#if defined(CERNLIB_DOUBLE) + DOUBLE PRECISION DBL1,DBL2,DBLM +#endif +C +C CONVERT IDENT+7 TO JETTYP + DATA JLIST/13,11,9,7,5,3,0,2,4,6,8,10,12,0,0,1/ + ALAMF(A,B,C)=SQRT((A-B-C)**2-4.*B*C) +C +C INITIALIZE +C + JINS(1)=JIN1 + JINS(2)=JIN2 + DO 97 K=1,4 +97 PFKEEP(K)=PJSET(K,JIN1)+PJSET(K,JIN2) +C EXCEPT FOR HIGGS, PFKEEP**2=SHAT + IF(KEYS(7).OR.KEYS(9)) THEN + S1KEEP=PFKEEP(4)**2-PFKEEP(1)**2-PFKEEP(2)**2-PFKEEP(3)**2 + PFKEEP(5)=SQRT(S1KEEP) + PPKEEP=PFKEEP(4)+PFKEEP(3) + PMKEEP=PFKEEP(4)-PFKEEP(3) + ELSE + S1KEEP=SHAT + PFKEEP(5)=SQRT(S1KEEP) + IF(PFKEEP(3).GT.0.) THEN + PPKEEP=PFKEEP(4)+PFKEEP(3) + PMKEEP=(S1KEEP+PFKEEP(1)**2+PFKEEP(2)**2)/PPKEEP + ELSE + PMKEEP=PFKEEP(4)-PFKEEP(3) + PPKEEP=(S1KEEP+PFKEEP(1)**2+PFKEEP(2)**2)/PMKEEP + ENDIF + PFKEEP(4)=.5*(PPKEEP+PMKEEP) + PFKEEP(3)=.5*(PPKEEP-PMKEEP) + ENDIF + DO 98 I=1,NJSET + DO 98 K=1,5 +98 PJKEEP(K,I)=PJSET(K,I) + NJKEEP=NJSET + NPASS=0 + NPASS1=0 +C +1 CONTINUE + NPASS1=NPASS1+1 + IF(NPASS1.GT.100) GO TO 9999 + NJSET=NJKEEP + DO 99 I=1,NJSET + DO 99 K=1,5 +99 PJSET(K,I)=PJKEEP(K,I) +C + DO 100 K=1,5 +100 PFINAL(K)=PFKEEP(K) + S1=S1KEEP + PTOTPL=PPKEEP + PTOTMN=PMKEEP + TCUT=CUTJET**2 + DO 101 I=1,2 + JI=JINS(I) + XOLD=(PJSET(4,JI)+ABS(PJSET(3,JI)))/ECM + JT=JLIST(JTYPE(JI)+7) + FXOLD(I)=STRUC(XOLD,QSQ,JT,IDIN(I)) +101 CONTINUE +C +C DO FIRST EVOLUTION + DO 110 I=1,2 + SGN=3-2*I + JET=10+I + JI=JINS(I) + ZMIN=(PJSET(4,JI)+ABS(PJSET(3,JI)))/ECM + ZMAX=1./(1.+TCUT/S1) +C DZMAX=1.-ZMAX + DZMAX=ZMAX*TCUT/S1 + IF(ZMIN.GE.ZMAX) ZMIN=.5*ZMAX + CALL QCDINT(JI) + JVIR(I)=JI +110 CONTINUE +C +C SOLVE INITIAL KINEMATICS + AM1SQ=PJSET(5,JVIR(1))**2*SIGN(1.,PJSET(5,JVIR(1))) + AM2SQ=PJSET(5,JVIR(2))**2*SIGN(1.,PJSET(5,JVIR(2))) + P1PL=(S1+AM1SQ-AM2SQ+ALAMF(S1,AM1SQ,AM2SQ))/(2.*PTOTMN) + P1MN=AM1SQ/P1PL + P2MN=(S1+AM2SQ-AM1SQ+ALAMF(S1,AM1SQ,AM2SQ))/(2.*PTOTPL) + P2PL=AM2SQ/P2MN + PJSET(3,JVIR(1))=.5*(P1PL-P1MN) + PJSET(4,JVIR(1))=.5*(P1PL+P1MN) + PJSET(3,JVIR(2))=.5*(P2PL-P2MN) + PJSET(4,JVIR(2))=.5*(P2PL+P2MN) +C +C TEST WHETHER NEW MASS IS PLAUSIBLE + DO 111 I=1,2 + JI=JINS(I) + XNEW=(PJSET(4,JI)+ABS(PJSET(3,JI)))/ECM + IF(XNEW.GE.1.) THEN + FXNEW(I)=0. + ELSE + JT=JLIST(JTYPE(JI)+7) + FXNEW(I)=STRUC(XNEW,QSQ,JT,IDIN(I)) + ENDIF +111 CONTINUE + DO 112 I=1,2 + IF(FXNEW(I).LT.FXOLD(I)*RANF()) GO TO 1 +112 CONTINUE +C +C FIND JVIR (SPACE-LIKE PARTON) WITH LARGER (-MASS) FOR NEXT +C BRANCHING. +10 IF(JDCAY(JVIR(1)).GE.0.AND.JDCAY(JVIR(2)).GE.0) RETURN + NPASS=NPASS+1 + IF(NPASS.GT.20*NJSET) GO TO 9999 + IF(-PJSET(5,JVIR(1)).GE.-PJSET(5,JVIR(2))) THEN + IVIR=JVIR(1) + IVIR2=JVIR(2) + SGN=+1. + JET=11 + ELSE + IVIR=JVIR(2) + IVIR2=JVIR(1) + SGN=-1. + JET=12 + ENDIF +C + T1=PJSET(5,IVIR)**2 + ZMIN=(PJSET(4,IVIR)+SGN*PJSET(3,IVIR))/ECM + ZMAX=1./(1.+T1/S1) + DZMAX=ZMAX*T1/S1 + IF(ZMIN.GE.ZMAX) GO TO 1 +C +C GENERATE Z AND NEW PARTONS. +C NEWV=SPACELIKE, NEWF=TIMELIKE. + NEWV=NJSET+1 + NEWF=NJSET+2 + CALL QCDINZ(IVIR) +C +C IF Z FAILS (BECAUSE OF STRUCTURE FUNCTION) SET NEWV=IVIR, +C NEWF=NULL AND RE-SOLVE KINEMATICS. +15 IF(.NOT.ZGOOD) THEN + CALL QCDINT(IVIR) +C + PP1PL=PJSET(4,IVIR2)+PJSET(3,IVIR2) + PP1MN=PJSET(4,IVIR2)-PJSET(3,IVIR2) + AMSQ=PJSET(5,IVIR)**2*SIGN(1.,PJSET(5,IVIR)) + AMPSQ=PJSET(5,IVIR2)**2*SIGN(1.,PJSET(5,IVIR2)) + IF(SGN.GT.0) THEN + P2PL=(S1-AMSQ-AMPSQ+ALAMF(S1,AMSQ,AMPSQ))/(2.*PP1MN) + P2MN=AMSQ/P2PL + ELSE + P2MN=(S1-AMSQ-AMPSQ+ALAMF(S1,AMSQ,AMPSQ))/(2.*PP1PL) + P2PL=AMSQ/P2MN + ENDIF + PJSET(3,IVIR)=.5*(P2PL-P2MN) + PJSET(4,IVIR)=.5*(P2PL+P2MN) +C + NEWV=IVIR + DO 120 K=1,5 +120 PJSET(K,NEWF)=0. + GO TO 30 + ENDIF +C +C EVOLVE NEW SPACELIKE PARTON. + PJSET(5,NEWV)=PJSET(5,IVIR) + S2=S1/ZZC(IVIR) + ZMIN=ZMIN/ZZC(IVIR) + ZMAX=1./(1.+TCUT/S2) + DZMAX=ZMAX*TCUT/S2 + IF(ZMIN.GE.ZMAX) GO TO 1 + CALL QCDINT(NEWV) +C +C CALCULATE APPROXIMATE MASS LIMIT AND DO TIMELIKE EVOLUTION. +C VER. 6.40: TRAP W1LIM < 0 FROM ROUNDING ERRORS. + W1LIM=T1*(1./(ZZC(IVIR)*(1.+T1/S1))-1.) + W1LIM=AMIN1(W1LIM,T1) + PJSET(5,NEWF)=SQRT(ABS(W1LIM)) + JDCAY(NEWF)=-1 +20 CALL QCDT(NEWF) +C +C SOLVE KINEMATICS USING +(PL) AND -(MN) COMPONENTS FOR +C PJSET(K,NEWV)+PJSET(K,IVIR2)-->PJSET(K,NEWF)+PFINAL +C STEP 1: SOLVE FOR P2=PJSET(K,NEWV) + PP1PL=PJSET(4,IVIR2)+PJSET(3,IVIR2) + PP1MN=PJSET(4,IVIR2)-PJSET(3,IVIR2) + AMSQ=PJSET(5,NEWV)**2*SIGN(1.,PJSET(5,NEWV)) + AMPSQ=PJSET(5,IVIR2)**2*SIGN(1.,PJSET(5,IVIR2)) + W1=PJSET(5,NEWF)**2 + IF(SGN.GT.0) THEN + P2PL=(S2-AMSQ-AMPSQ+ALAMF(S2,AMSQ,AMPSQ))/(2.*PP1MN) + P2MN=AMSQ/P2PL + ELSE + P2MN=(S2-AMSQ-AMPSQ+ALAMF(S2,AMSQ,AMPSQ))/(2.*PP1PL) + P2PL=AMSQ/P2MN + ENDIF +C +C STEP 2: SOLVE FOR Q1(K)=PJSET(K,IVIR) + DEN=P2PL*PP1MN-P2MN*PP1PL + Q1PL=(+P2PL*(S1+T1-AMPSQ)+PP1PL*(W1+T1-AMSQ))/DEN + Q1MN=(-P2MN*(S1+T1-AMPSQ)-PP1MN*(W1+T1-AMSQ))/DEN + WPL=P2PL-Q1PL + WMN=P2MN-Q1MN +C CALCULATE TRANSVERSE MOMENTUM AND REJECT IF UNPHYSICAL. + Q1TR2=T1+Q1PL*Q1MN + IF(Q1TR2.LT.0.) THEN + IF(JDCAY(NEWF).EQ.-1) GO TO 20 + ZGOOD=.FALSE. + GO TO 15 + ENDIF +C +C DO ONE TIMELIKE BRANCHING TO INSURE CORRECT MASS. MUST FIRST +C SHIFT NJSET TO PUT DECAY PRODUCTS IN CORRECT PLACE. + IF(JDCAY(NEWF).EQ.-1) THEN + NJSET=NJSET+2 + CALL QCDZ(NEWF) + NJSET=NJSET-2 + Z1=ZZC(NEWF) + E0=.5*(WPL+WMN) + P0=SQRT(.25*(WPL-WMN)**2+Q1TR2) + WM0=PJSET(5,NEWF) + ZLIM=AMAX1((WM0/(E0+P0))**2,CUTJET/(E0+P0)) + IF(Z1.LE.ZLIM.OR.Z1.GE.1.-ZLIM) GO TO 20 + NEWF1=NEWF+1 + NEWF2=NEWF+2 + JDCAY(NEWF)=NEWF1*JPACK+NEWF2 + CALL QCDT(NEWF1) + CALL QCDT(NEWF2) + JORIG(NEWF1)=JPACK*JET+NEWF + JORIG(NEWF2)=JORIG(NEWF1) + DO 130 K=1,4 + PJSET(K,NEWF1)=0. +130 PJSET(K,NEWF2)=0. + ENDIF +C +C GOOD BRANCHING! + PHIQ1=2.*PI*RANF() + Q1TR=SQRT(Q1TR2) + + Q1X=Q1TR*COS(PHIQ1) + Q1Y=Q1TR*SIN(PHIQ1) +C + PJSET(1,IVIR)=Q1X + PJSET(2,IVIR)=Q1Y + PJSET(3,IVIR)=.5*(Q1PL-Q1MN) + PJSET(4,IVIR)=.5*(Q1PL+Q1MN) + JDCAY(IVIR)=JPACK*NEWV+NEWF +C + PJSET(1,NEWV)=0. + PJSET(2,NEWV)=0. + PJSET(3,NEWV)=.5*(P2PL-P2MN) + PJSET(4,NEWV)=.5*(P2PL+P2MN) + JORIG(NEWV)=JPACK*JET+IVIR +C + PJSET(1,NEWF)=-Q1X + PJSET(2,NEWF)=-Q1Y + PJSET(3,NEWF)=.5*(WPL-WMN) + PJSET(4,NEWF)=.5*(WPL+WMN) + JORIG(NEWF)=JPACK*JET+IVIR +C +C BOOST ALL FINAL VECTORS (EXCEPT NEW ONES) AND RECALCULATE +C VIRTUAL MOMENTA. BOOST IS DETERMINED BY DIFFERENCE OF +C NEW AND OLD TOTAL FINAL MOMENTA, B2B1=BOOST2-BOOST1. +C +30 CONTINUE + DO 201 K=1,4 +201 BOOST1(K)=PFINAL(K) + BMASS=PFINAL(5) + DO 202 K=1,4 +202 BOOST2(K)=PJSET(K,NEWV)+PJSET(K,IVIR2)-PJSET(K,NEWF) +C +C PARAMETERS FOR COMBINED BOOSTS. +#if defined(CERNLIB_SINGLE) + BDOTB=BOOST1(4)*BOOST2(4)-BOOST1(1)*BOOST2(1)-BOOST1(2)*BOOST2(2) + $-BOOST1(3)*BOOST2(3) + DO 203 K=1,4 +203 B2B1(K)=BOOST2(K)-BOOST1(K) +#endif +#if defined(CERNLIB_DOUBLE) +C DOUBLE PRECISION FOR 32-BIT MACHINES USING 3-VECTORS AND MASS +C AS EXACT. + DO 204 K=1,3 + DBL1(K)=BOOST1(K) +204 DBL2(K)=BOOST2(K) + DBLM=BMASS + DBL1(4)=DSQRT(DBL1(1)**2+DBL1(2)**2+DBL1(3)**2+DBLM**2) + DBL2(4)=DSQRT(DBL2(1)**2+DBL2(2)**2+DBL2(3)**2+DBLM**2) + BDOTB=DBL1(4)*DBL2(4)-DBL1(1)*DBL2(1)-DBL1(2)*DBL2(2) + $-DBL1(3)*DBL2(3) + DO 205 K=1,4 +205 B2B1(K)=DBL2(K)-DBL1(K) +#endif + B44=BDOTB/BMASS**2 + BI41=1./BMASS + BI42=(BDOTB-BMASS**2-B2B1(4)*BMASS)/(BMASS**2*(BOOST2(4)+BMASS)) + B4K1=BI41 + B4K2=(BMASS**2-BDOTB-B2B1(4)*BMASS)/(BMASS**2*(BOOST1(4)+BMASS)) + BIK1=-1./(BMASS*(BOOST1(4)+BMASS)) + BIK2=1./(BMASS*(BOOST2(4)+BMASS)) + BIK3=(BMASS**2-BDOTB)/(BMASS**2*(BOOST1(4)+BMASS) + $*(BOOST2(4)+BMASS)) +C +C BOOST FINAL JETS + DO 210 J=1,NJSET + IF(J.EQ.IVIR.OR.J.EQ.IVIR2) GO TO 210 + IF(PJSET(5,J).LT.0.) GO TO 210 + IF(JDCAY(J).EQ.-1) GO TO 210 + BP1=0. + BP21=0. + DO 215 K=1,3 + BP1=BP1+BOOST1(K)*PJSET(K,J) +215 BP21=BP21+B2B1(K)*PJSET(K,J) + DO 220 K=1,3 +220 PJSET(K,J)=PJSET(K,J) + $+(B2B1(K)*BI41+BOOST2(K)*BI42)*PJSET(4,J) + $+B2B1(K)*BP1*BIK1+BOOST2(K)*BP21*BIK2+BOOST2(K)*BP1*BIK3 + PJSET(4,J)=B44*PJSET(4,J)+BP21*B4K1+BP1*B4K2 +210 CONTINUE +C +C SET PFINAL TO BOOST2 + DO 230 K=1,4 +230 PFINAL(K)=BOOST2(K) + PFINAL(5)=BMASS +C +C RESET REMAINING VECTORS + DO 240 J=NJSET,1,-1 + IF(J.EQ.IVIR.OR.J.EQ.IVIR2) GO TO 240 + IF(PJSET(5,J).GE.0.) GO TO 240 + JX1=JDCAY(J)/JPACK + JX2=JDCAY(J)-JPACK*JX1 + DO 250 K=1,4 + PJSET(K,J)=PJSET(K,JX1)-PJSET(K,JX2) +250 DBL1(K)=PJSET(K,J) +#if defined(CERNLIB_SINGLE) + AMJ=SQRT(ABS(DBL1(4)**2-DBL1(1)**2-DBL1(2)**2-DBL1(3)**2)) +#endif +#if defined(CERNLIB_DOUBLE) + AMJ=DSQRT(ABS(DBL1(4)**2-DBL1(1)**2-DBL1(2)**2-DBL1(3)**2)) +#endif + PJSET(5,J)=-AMJ +240 CONTINUE +C +C RESET PFINAL, ETC. +#if defined(CERNLIB_SINGLE) + DO 300 K=1,4 +300 PFINAL(K)=PFINAL(K)+PJSET(K,NEWF) + S1=PFINAL(4)**2-PFINAL(1)**2-PFINAL(2)**2-PFINAL(3)**2 + IF(S1.LT.0.) GO TO 9999 + PFINAL(5)=SQRT(S1) + PTOTPL=PJSET(4,NEWV)+PJSET(3,NEWV)+PJSET(4,IVIR2)+PJSET(3,IVIR2) + PTOTMN=PJSET(4,NEWV)-PJSET(3,NEWV)+PJSET(4,IVIR2)-PJSET(3,IVIR2) +#endif +#if defined(CERNLIB_DOUBLE) +C NEED DOUBLE PRECISION ON 32-BIT MACHINES + CALL DBLVEC(PFINAL,DBL1) + CALL DBLVEC(PJSET(1,NEWF),DBL2) + DO 300 K=1,4 + DBL1(K)=DBL1(K)+DBL2(K) +300 PFINAL(K)=DBL1(K) + S1=DBL1(4)**2-DBL1(1)**2-DBL1(2)**2-DBL1(3)**2 + PFINAL(5)=SQRT(S1) + IF(S1.LT.0.) GO TO 9999 + PFINAL(5)=SQRT(S1) + PTOTPL=PJSET(4,NEWV)+PJSET(3,NEWV)+PJSET(4,IVIR2)+PJSET(3,IVIR2) + PTOTMN=PJSET(4,NEWV)-PJSET(3,NEWV)+PJSET(4,IVIR2)-PJSET(3,IVIR2) +#endif +C +C SET NJSET AND POINTERS IF Z WAS GOOD + IF(.NOT.ZGOOD) GO TO 10 + NJSET=NJSET+2 + IF(JDCAY(NEWF).GT.0) NJSET=NJSET+2 + JVIR(JET-10)=NEWV + GO TO 10 +C ERROR -- DISCARD EVENT. +9999 CONTINUE + WRITE(ITLIS,9998) IEVT +9998 FORMAT(/' ***** ERROR IN QCDINI ... EVENT',I8,' DISCARDED *****') + NJSET=-1 + RETURN + END diff --git a/ISAJET/code/qcdint.F b/ISAJET/code/qcdint.F new file mode 100644 index 00000000000..3bfebddde20 --- /dev/null +++ b/ISAJET/code/qcdint.F @@ -0,0 +1,184 @@ +#include "isajet/pilot.h" + SUBROUTINE QCDINT(J0) +C +C AUXILIARY ROUTINE FOR QCDINI. GENERATE A NEW MASS FOR +C SPACELIKE PARTON J0. +C +#include "isajet/itapes.inc" +#include "isajet/jetset.inc" +#include "isajet/jwork.inc" +#include "isajet/jwork2.inc" +#include "isajet/qcdpar.inc" +#include "isajet/primar.inc" +C + DIMENSION GAMS(13),FX0S(13) + DATA CA/3./,CF/1.333333333/ +C +C FUNCTIONS -- USE DZMAX FOR PRECISION + GQQ(Z,DZ)=CF*(-2.*ALOG(DZ)+Z*(-1.-.5*Z)) + GQG(Z)=CF*(+2.*ALOG(Z)+Z*(-2.+.5*Z)) + GGQ(Z)=(Z**3-(1.-Z)**3)/6. + GGG(Z,DZ)=2.*CA*(ALOG(Z/DZ)+Z*(-2.+Z*(.5-Z/3.))) + GBQQ(RZ,DZ)=CF*(2.*ALOG((1.+RZ)**2/DZ)+RZ*(-2.-2./3.*RZ**2)) + GBQG(RZ)=CF*(-4./RZ+RZ*(-4.+2./3.*RZ**2)) +C + GLFORC(JET-10)=.FALSE. + IDABS=IABS(JTYPE(J0)) + IF(JTYPE(J0).EQ.9) THEN + ITYP=1 + ELSEIF(JTYPE(J0).GT.0) THEN + ITYP=2*IDABS + ELSE + ITYP=2.*IDABS+1 + ENDIF + IBEAM=JET-10 + AM0=ABS(PJSET(5,J0)) +1 T0=AM0**2 + X0=ZMIN + ANF=3 + DO 110 I=4,6 + AMQ2=AMASS(I)**2 +110 ANF=ANF+T0/(AMQ2+T0) + B0=11.-2.*ANF/3. +C +C SET UP ANOMALOUS DIMENSIONS. ALSO USE THESE TO DETERMINE TYPE +C OF INCOMING PARTON (TO BE USED IN QCDINZ). +C +C GLUON + IF(IDABS.EQ.9) THEN + AMQ=0. + GAMG=GGG(ZMAX,DZMAX)-GGG(ZMIN,1.-ZMIN) + GAMS(1)=GAMG + FX0=STRUC(X0,T0,1,IDIN(IBEAM)) + FX0S(1)=FX0 + GAMFAC=(GBQG(SQRT(ZMAX))-GBQG(SQRT(ZMIN)))/FX0 + GAMQ=0. + DO 210 IQ=2,13 + FX0S(IQ)=STRUC(X0,T0,IQ,IDIN(IBEAM)) + GAMS(IQ)=GAMFAC*FX0S(IQ) +210 GAMQ=GAMQ+GAMS(IQ) + GAM=GAMG+GAMQ + AM1=CUTJET +C + TRY=RANF() + SUM=0. + DO 220 IQ=1,13 + SUM=SUM+GAMS(IQ)/GAM + IF(SUM.LT.TRY) GO TO 220 + JIN(J0)=IQ + FXTEST(J0)=FX0S(IQ) + GO TO 300 +220 CONTINUE +C +C LIGHT QUARK + ELSEIF(IDABS.LE.3) THEN + AMQ=AMASS(IDABS) + GAMQ=GBQQ(SQRT(ZMAX),DZMAX)-GBQQ(SQRT(ZMIN),1.-ZMIN) + FX0=STRUC(X0,T0,ITYP,IDIN(IBEAM)) + FXG=STRUC(X0,T0,1,IDIN(IBEAM)) + GAMFAC=FXG/FX0 + GAMG=GAMFAC*(GGQ(ZMAX)-GGQ(ZMIN)) + GAM=GAMQ+GAMG + AM1=AMQ+CUTJET +C + IF(GAMQ/GAM.GT.RANF()) THEN + JIN(J0)=ITYP + FXTEST(J0)=FX0 + ELSE + JIN(J0)=1 + FXTEST(J0)=FXG + ENDIF +C +C HEAVY QUARK -- SPECIAL TREATMENT NEEDED TO ALWAYS FORCE +C GL-->QK+QB BEFORE END OF EVOLUTION. +C USE SMALLER MASS FOR FORCED DECAYS TO PREVENT INFINITE LOOP. + ELSE + AMQ=AMASS(IDABS) + THRESH=4.*AMQ**2*X0/(1.-X0) + THRESH=(SQRT(THRESH)+CUTJET)**2 + IF(STRUC(X0,T0,ITYP,IDIN(IBEAM)).LE.0..OR. + $ T0.LE.THRESH) THEN + PJSET(5,J0)=-AM0*SQRT(RANF())-ALAM + GLFORC(JET-10)=.TRUE. + JDCAY(J0)=-2 + JIN(J0)=1 + FXTEST(J0)=1. + RETURN + ENDIF + T1=SQRT(T0*THRESH) +230 AM1=SQRT(T1) + FX0=STRUC(X0,T1,ITYP,IDIN(IBEAM)) + IF(FX0.LE.0.) THEN + T1=SQRT(T1*T0) + GO TO 230 + ENDIF + FXG=STRUC(X0,T1,1,IDIN(IBEAM)) + GAMFAC=FXG/FX0 + GAMQ=GQQ(ZMAX,DZMAX)-GQQ(ZMIN,1.-ZMIN) + GAMG=GAMFAC*(GGQ(ZMAX)-GGQ(ZMIN)) + GAM=GAMQ+GAMG +C + IF(GAMQ/GAM.GT.RANF()) THEN + JIN(J0)=ITYP + FXTEST(J0)=FX0 + ELSE + JIN(J0)=1 + FXTEST(J0)=FXG + ENDIF + ENDIF +C +C LEADING-LOG MASS GENERATION. +C +300 GB=2.*GAM/B0 + IF(AM1.GT.ALAM.AND.AM0.GT.ALAM) THEN + PROBL=GB*ALOG(ALOG(AM1/ALAM)/ALOG(AM0/ALAM)) + ELSE + PROBL=0. + ENDIF + IF(PROBL.GT.0.) THEN + PROB=1. + ELSEIF(PROBL.GT.-50.) THEN + PROB=EXP(PROBL) + ELSE + PROB=0. + ENDIF + IF(PROB.GT.RANF()) THEN + IF(IDABS.LE.3.OR.IDABS.EQ.9) THEN + PJSET(5,J0)=AMQ + JDCAY(J0)=JPACK*J0+J0 + RETURN + ELSEIF(AM0.LT.AM1+CUTJET) THEN + PJSET(5,J0)=-SQRT(T0) + GLFORC(JET-10)=.TRUE. + JDCAY(J0)=-2 + JIN(J0)=1 + FXTEST(J0)=1 + RETURN + ELSE + AM0=AM1 + GO TO 1 + ENDIF + ELSE + POW=(1.-(1.-PROB)*RANF())**(1./GB) + AMNEW=ALAM*(AM0/ALAM)**POW + IF(AMNEW.GE.AM1) THEN + PJSET(5,J0)=-AMNEW + JDCAY(J0)=-2 + RETURN + ELSEIF(IDABS.LE.3.OR.IDABS.EQ.9) THEN + PJSET(5,J0)=AMQ + JDCAY(J0)=JPACK*J0+J0 + RETURN + ELSEIF(AM0.LT.AM1+CUTJET) THEN + PJSET(5,J0)=-AM0*SQRT(RANF())-ALAM + GLFORC(JET-10)=.TRUE. + JDCAY(J0)=-2 + JIN(J0)=1 + FXTEST(J0)=1 + RETURN + ELSE + AM0=AM1 + GO TO 1 + ENDIF + ENDIF + END diff --git a/ISAJET/code/qcdinz.F b/ISAJET/code/qcdinz.F new file mode 100644 index 00000000000..1059349c8de --- /dev/null +++ b/ISAJET/code/qcdinz.F @@ -0,0 +1,114 @@ +#include "isajet/pilot.h" + SUBROUTINE QCDINZ(J0) +C +C AUXILIARY ROUTINE FOR QCDINI. GENERATE A Z AND TWO DAUGHTER +C PARTONS FOR SPACELIKE PARTON J0. +C +#include "isajet/itapes.inc" +#include "isajet/jetset.inc" +#include "isajet/jwork.inc" +#include "isajet/jwork2.inc" +#include "isajet/qcdpar.inc" +#include "isajet/primar.inc" +C + DATA CA/3./,CF/1.333333333/ +C FUNCTIONS. + PQQ(Z)=CF*(1.+Z**2)/(1.-Z) + PQG(Z)=CF*(1.+(1.-Z)**2)/Z + PGQ(Z)=.5*(Z**2+(1.-Z)**2) + PGG(Z)=2.*CA*(1.-Z*(1.-Z))**2/(Z*(1.-Z)) +C +C INITIALIZE + IDABS=IABS(JTYPE(J0)) + AM0=ABS(PJSET(5,J0)) + T0=AM0**2 + JIN0=JIN(J0) + X0=(PJSET(4,J0)+SGN*PJSET(3,J0))/ECM + ZGOOD=.FALSE. + IF(ZMIN.GE.ZMAX) RETURN +C +C SELECT BRANCHING AND GENERATE Z ACCORDING TO ALTARELLI-PARISI +C FUNCTIONS. THEN CHECK WITH STRUCTURE FUNCTIONS +C +C GLUON +C + IF(IDABS.EQ.9) THEN +C +C GL->GL+GL + IF(JIN0.EQ.1) THEN +110 ZGEN=DZMAX/ZMAX*(ZMAX*(1.-ZMIN)/(ZMIN*DZMAX))**RANF() + Z=1./(1.+ZGEN) + DZ=ZGEN/(1.+ZGEN) + GZ=2.*CA/(Z*DZ) + PGGZ=2.*CA*(1.-Z*(1.-Z))**2/(Z*DZ) + IF(PGGZ.LT.GZ*RANF()) GO TO 110 + JTYPE(NJSET+1)=9 + JTYPE(NJSET+2)=9 + ZZC(J0)=Z +C + X1=X0/Z + FX1=STRUC(X1,T0,1,IDIN(JET-10)) + FX0=FXTEST(J0) + IF(FX1/FX0.GT.RANF()) ZGOOD=.TRUE. +C +C QK->GL+QK + ELSE +120 RZMAX=SQRT(ZMAX) + RZMIN=SQRT(ZMIN) + ZGEN=1./RZMAX-RANF()*(1./RZMAX-1./RZMIN) + Z=1./ZGEN**2 + RZ=SQRT(Z) + GZ=2.*CF/RZ**3 + IF(PQG(Z)/RZ.LT.GZ*RANF()) GO TO 120 + IFL=JIN0/2 + IF(JIN0.NE.2*IFL) IFL=-IFL + JTYPE(NJSET+1)=IFL + JTYPE(NJSET+2)=IFL + ZZC(J0)=Z +C + X1=X0/Z + FX1=STRUC(X1,T0,JIN0,IDIN(JET-10)) + FX0=FXTEST(J0) + IF(RZ*FX1/FX0.GT.RANF()) ZGOOD=.TRUE. + ENDIF +C +C QUARK +C + ELSE +C +C GL->QK+QB + IF(JIN0.EQ.1) THEN +130 Z=ZMIN+(ZMAX-ZMIN)*RANF() + IF(PGQ(Z).LT..5*RANF()) GO TO 130 + JTYPE(NJSET+1)=9 + JTYPE(NJSET+2)=-JTYPE(J0) + ZZC(J0)=Z +C + X1=X0/Z + FX1=STRUC(X1,T0,1,IDIN(JET-10)) + FX0=FXTEST(J0) + IF(FX1/FX0.GT.RANF().OR.GLFORC(JET-10)) ZGOOD=.TRUE. +C +C QK->QK+GL + ELSE +140 DZ=DZMAX*((1.-ZMIN)/DZMAX)**RANF() + Z=1.-DZ + GZ=2.*CF/DZ + RZ=1. + IF(IDABS.LE.3) RZ=SQRT(Z) + PQQZ=CF*(1.+Z**2)/DZ + IF(PQQZ/RZ.LT.GZ*RANF()) GO TO 140 + JTYPE(NJSET+1)=JTYPE(J0) + JTYPE(NJSET+2)=9 + ZZC(J0)=Z +C + X1=X0/Z + FX1=STRUC(X1,T0,JIN0,IDIN(JET-10)) + FX0=FXTEST(J0) + IF(RZ*FX1/FX0.GT.RANF()) ZGOOD=.TRUE. + ENDIF + ENDIF + JMATCH(NJSET+1)=0 + JMATCH(NJSET+2)=0 + RETURN + END diff --git a/ISAJET/code/qcdjet.F b/ISAJET/code/qcdjet.F new file mode 100644 index 00000000000..37ac084ee8e --- /dev/null +++ b/ISAJET/code/qcdjet.F @@ -0,0 +1,291 @@ +#include "isajet/pilot.h" + SUBROUTINE QCDJET(NJMIN) +C +C Carry out final state QCD jet evolution using the algorithm +C of Fox and Wolfram. Evolve each parton in T with fixed ZC +C and iterate as follows-- +C +C (0) Evolve initial partons. +C (1) Pick I and find matching J>I. +C (2) Solve kinematics. +C (3) For K=I,J, generate Z(K) and evolve T(K1), T(K2). If no +C good, evolve T(K). Otherwise, add K1 and K2 to /JETSET/. +C (4) If I or J no good, then (2). +C (5) Then (1). +C +C Use Z=(E+P)/(E0+P0) and a large TCUT. +C JMATCH(J1)=J2 if J1 and J2 match. +C JMATCH(J)=JPACK*J1+J2 if J1,...,J2 match. Used for multiple +C initial partons. +C JMATCH(J)=0 for initial jet partons +C +C Include W+- and Z0 radiation. +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/partcl.inc" +#include "isajet/qcdpar.inc" +#include "isajet/jetset.inc" +#include "isajet/jwork.inc" +#include "isajet/const.inc" +C + INTEGER J,NJMIN,JPRNT,JI1,JI2,NJI,JI,NJ1,NJ2,L,K,NPTLV1,IFAIL,J0 + REAL AM0,AM1,AM2,RANF,AMSUM,PCM2,POLD2,RATIO,PSUM,P12CM,E0,P0,Z1, + $E1MAX,P1MAX,ZMAX,E1MIN,P1MIN,ZMIN,ZEP,E1,P1,CTHCMZ,Z2,E2MAX,P2MAX, + $E2MIN,P2MIN,P2,E2,CTHCM,STHCM,PHICM,CPHICM,SPHICM,PT0,CTH0,STH0, + $CPHI0,SPHI0,SGN,BP,ZLIM,ZLIM1 + DIMENSION PSUM(5) + DATA PSUM/5*0./ +C +C (0) Evolve initial parton masses. +C + DO 100 J=NJMIN,NJSET + J1=J + J2=JMATCH(J) + IF(J2.GT.JPACK) GO TO 150 + IF(J2.LE.J1) GO TO 100 +C Two partons + IF(JDCAY(J1).EQ.-1) CALL QCDT(J1) + IF(JDCAY(J2).EQ.-1) CALL QCDT(J2) + JPRNT=MOD(JORIG(J),JPACK) + IF(JPRNT.EQ.0) THEN + AM0=PJSET(4,J1)+PJSET(4,J2) + ELSE + AM0=PJSET(5,JPRNT) + ENDIF +110 AM1=PJSET(5,J1) + AM2=PJSET(5,J2) + IF(AM0.LE.AM1+AM2) THEN + J3=J1 + IF(RANF().GT..5) J3=J2 + IF(JDCAY(J3).EQ.-1) CALL QCDT(J3) + GO TO 110 + ENDIF + GO TO 100 +C More than two partons +150 JI1=JMATCH(J)/JPACK + IF(J.NE.JI1) GO TO 100 + JI2=JMATCH(J)-JPACK*JI1 + NJI=JI2-JI1+1 + AM0=0. + AMSUM=0. + DO 160 JI=JI1,JI2 + IF(JDCAY(JI).EQ.-1) CALL QCDT(JI) + AM0=AM0+PJSET(4,JI) + AMSUM=AMSUM+PJSET(5,JI) +160 CONTINUE +170 IF(AM0.LT.AMSUM) THEN + J3=NJI*RANF()+JI1 + AMSUM=AMSUM-PJSET(5,J3) + IF(JDCAY(J3).EQ.-1) CALL QCDT(J3) + AMSUM=AMSUM+PJSET(5,J3) + GO TO 170 + ENDIF +100 CONTINUE +C +C (1) Loop over active partons +C + NJ1=NJMIN +1 NJ2=NJSET + DO 200 J=NJ1,NJ2 + J1=J + J2=JMATCH(J1) + NJI=2 + IF(J2.LE.J1) GO TO 200 +C +C (2) Solve kinematics. +C +C Initial partons--keep directions fixed. +210 IF(MOD(JORIG(J),JPACK).NE.0) GO TO 230 + IF(JMATCH(J).GT.JPACK) GO TO 400 + AM0=PJSET(4,J1)+PJSET(4,J2) + AM1=PJSET(5,J1) + AM2=PJSET(5,J2) + PJSET(4,J1)=(AM0**2+AM1**2-AM2**2)/(2*AM0) + PJSET(4,J2)=(AM0**2+AM2**2-AM1**2)/(2*AM0) + PCM2=((AM0**2-AM1**2-AM2**2)**2-(2*AM1*AM2)**2)/(4*AM0**2) + DO 220 L=1,2 + POLD2=PJSET(1,JJ(L))**2+PJSET(2,JJ(L))**2+PJSET(3,JJ(L))**2 + RATIO=SQRT(PCM2/POLD2) + DO 225 K=1,3 +225 PJSET(K,JJ(L))=RATIO*PJSET(K,JJ(L)) +220 CONTINUE + GO TO 300 +C +C NJI.LE.5 initial partons +400 CONTINUE + JI1=JMATCH(J)/JPACK + IF(J.NE.JI1) GO TO 200 + JI2=JMATCH(J)-JPACK*JI1 + NJI=JI2-JI1+1 + AM0=0. + DO 410 JI=JI1,JI2 + AM0=AM0+PJSET(4,JI) + JJ(JI-JI1+1)=JI + PJSET(4,JI)=SQRT(PJSET(1,JI)**2+PJSET(2,JI)**2+PJSET(3,JI)**2 + 1 +PJSET(5,JI)**2) + DO 420 K=1,5 +420 PPTCL(K,NPTCL+JI-JI1+1)=PJSET(K,JI) +410 CONTINUE + PSUM(4)=AM0 + PSUM(5)=PSUM(4) + NPTLV1=NPTCL + CALL RESCAL(NPTLV1+1,NPTLV1+NJI,PSUM,IFAIL) + DO 430 JI=JI1,JI2 + DO 430 K=1,5 + PJSET(K,JI)=PPTCL(K,NPTCL+JI-JI1+1) +430 CONTINUE + GO TO 300 +C +C Solve kinematics for general partons. +C +230 J0=MOD(JORIG(J),JPACK) + AM0=PJSET(5,J0) + AM1=PJSET(5,J1) + AM2=PJSET(5,J2) + E1CM=(AM0**2+AM1**2-AM2**2)/(2*AM0) + E2CM=(AM0**2+AM2**2-AM1**2)/(2*AM0) + P12CM=SQRT((AM0**2-AM1**2-AM2**2)**2-(2*AM1*AM2)**2)/(2*AM0) + NJI=2 +C Determine E1, P1, and COS(THCM) from Z(J0). +C Occasionally COS(TH)>1. If so then reset Z. + E0=PJSET(4,J0) + P0=SQRT(PJSET(1,J0)**2+PJSET(2,J0)**2+PJSET(3,J0)**2) + Z1=ZZC(J0) + IF(Z1.GT.0.5) THEN + E1MAX=(E0*E1CM+P0*P12CM)/AM0 + P1MAX=(P0*E1CM+E0*P12CM)/AM0 + ZMAX=(E1MAX+P1MAX)/(E0+P0) + E1MIN=(E0*E1CM-P0*P12CM)/AM0 + P1MIN=(P0*E1CM-E0*P12CM)/AM0 + P1MIN=ABS(P1MIN) + ZMIN=(E1MIN+P1MIN)/(E0+P0) + IF(Z1.LT.ZMIN.OR.Z1.GT.ZMAX) Z1=ZMIN+Z1*(ZMAX-ZMIN) + ZZC(J0)=Z1 + ZEP=Z1*(E0+P0) + P1=(ZEP**2-AM1**2)/(2.*ZEP) + E1=(ZEP**2+AM1**2)/(2.*ZEP) + CTHCM=(E1*AM0-E0*E1CM)/(P0*P12CM) + ELSE + Z2=1.-Z1 + E2MAX=(E0*E2CM+P0*P12CM)/AM0 + P2MAX=(P0*E2CM+E0*P12CM)/AM0 + ZMAX=(E2MAX+P2MAX)/(E0+P0) + E2MIN=(E0*E2CM-P0*P12CM)/AM0 + P2MIN=(P0*E2CM-E0*P12CM)/AM0 + P2MIN=ABS(P2MIN) + ZMIN=(E2MIN+P2MIN)/(E0+P0) + IF(Z2.LT.ZMIN.OR.Z2.GT.ZMAX) Z2=ZMIN+Z2*(ZMAX-ZMIN) + ZZC(J0)=Z2 + ZEP=Z2*(E0+P0) + P2=(ZEP**2-AM2**2)/(2.*ZEP) + E2=(ZEP**2+AM2**2)/(2.*ZEP) + CTHCM=-(E2*AM0-E0*E2CM)/(P0*P12CM) + ENDIF +C Avoid disaster + IF(ABS(CTHCM).GT.1.) CTHCM=SIGN(RANF(),CTHCM) + STHCM=SQRT(1.-CTHCM**2) + PHICM=2*PI*RANF() + CPHICM=COS(PHICM) + SPHICM=SIN(PHICM) +C +C Construct cm momenta. + PT0=SQRT(PJSET(1,J0)**2+PJSET(2,J0)**2) + CTH0=PJSET(3,J0)/P0 + STH0=PT0/P0 + CPHI0=PJSET(1,J0)/PT0 + SPHI0=PJSET(2,J0)/PT0 + P1CM(1)=P12CM*(CPHI0*(CTH0*CPHICM*STHCM+STH0*CTHCM) + 1 -SPHI0*SPHICM*STHCM) + P1CM(2)=P12CM*(SPHI0*(CTH0*CPHICM*STHCM+STH0*CTHCM) + 1 +CPHI0*SPHICM*STHCM) + P1CM(3)=P12CM*(-STH0*CPHICM*STHCM+CTH0*CTHCM) +C Boost with P0 to get lab momenta + DO 240 L=1,2 + SGN=3-2*L + BP=0 + DO 241 K=1,3 +241 BP=BP+PJSET(K,J0)*SGN*P1CM(K) + BP=BP/AM0 + PJSET(4,JJ(L))=PJSET(4,J0)*EE(L)/PJSET(5,J0)+BP + DO 242 K=1,3 +242 PJSET(K,JJ(L))=SGN*P1CM(K)+PJSET(K,J0)*EE(L)/PJSET(5,J0) + 1 +PJSET(K,J0)*BP/(PJSET(4,J0)+PJSET(5,J0)) +240 CONTINUE +C +C (3) Pick Z and decay partons. Check. +C +300 CONTINUE + TNEW=.FALSE. + DO 310 L=1,NJI + IF(JDCAY(JJ(L)).GE.0) GO TO 310 + IF(NJSET+2.GT.MXJSET) GO TO 9999 + CALL QCDZ(JJ(L)) + CALL QCDT(NJSET+1) + CALL QCDT(NJSET+2) +C +C Check whether masses allowed. + AM0=PJSET(5,JJ(L)) + AM1=PJSET(5,NJSET+1) + AM2=PJSET(5,NJSET+2) + IF(AM1+AM2.GE.AM0) GO TO 320 +C +C Check whether Z allowed. + E1CM=(AM0**2+AM1**2-AM2**2)/(2*AM0) + E2CM=(AM0**2+AM2**2-AM1**2)/(2.*AM0) + P12CM=SQRT((AM0**2-AM1**2-AM2**2)**2-(2*AM1*AM2)**2)/(2*AM0) + E0=PJSET(4,JJ(L)) + P0=SQRT(PJSET(1,JJ(L))**2+PJSET(2,JJ(L))**2+PJSET(3,JJ(L))**2) + IF(ZZC(JJ(L)).GT.0.5) THEN + ZEP=ZZC(JJ(L))*(E0+P0) + P1=(ZEP**2-AM1**2)/(2.*ZEP) + E1=(ZEP**2+AM1**2)/(2.*ZEP) + CTHCM=(E1*AM0-E0*E1CM)/(P0*P12CM) + IF((ABS(CTHCM).GE.1..OR.P1.LE.0.).AND.IABS(JTYPE(JJ(L))) + $ .LT.80) GO TO 320 + ELSE + ZEP=(1.-ZZC(JJ(L)))*(E0+P0) + P2=(ZEP**2-AM2**2)/(2.*ZEP) + E2=(ZEP**2+AM2**2)/(2.*ZEP) + CTHCM=-(E2*AM0-E0*E2CM)/(P0*P12CM) + IF((ABS(CTHCM).GE.1..OR.P2.LE.0.).AND.IABS(JTYPE(JJ(L))) + $ .LT.80) GO TO 320 + ENDIF +C +C Require Z and 1-Z within kinematic limits. +C + ZLIM=(AM0/(E0+P0))**2 + ZLIM1=CUTJET/(E0+P0) + ZLIM=AMAX1(ZLIM,ZLIM1) + IF((ZZC(JJ(L)).GT.ZLIM.AND.ZZC(JJ(L)).LT.(1.-ZLIM)).OR. + $ IABS(JTYPE(JJ(L))).GE.80) THEN +C Add new partons to /JETSET/. + JDCAY(JJ(L))=JPACK*(NJSET+1)+(NJSET+2) + NJSET=NJSET+2 + GO TO 310 + ENDIF +C Discard partons and evolve JJ(L) again. +320 TNEW=.TRUE. + CALL QCDT(JJ(L)) +310 CONTINUE +C +C (4) Resolve kinematics if any parton mass is changed. +C + IF(TNEW) GO TO 210 +200 CONTINUE +C +C (5) Iterate entire proceedure. +C + NJ1=NJ2+1 + IF(NJ1.LE.NJSET) GO TO 1 + RETURN +C +C Error message +C +9999 CALL PRTEVT(0) + WRITE(ITLIS,10) NJSET +10 FORMAT(//' ERROR IN QCDJET...NJSET > ',I4) + RETURN + END diff --git a/ISAJET/code/qcdt.F b/ISAJET/code/qcdt.F new file mode 100644 index 00000000000..c0540e9bb3a --- /dev/null +++ b/ISAJET/code/qcdt.F @@ -0,0 +1,136 @@ +#include "isajet/pilot.h" + SUBROUTINE QCDT(J) +C +C Auxiliary routine for QCDJET. Calculate ZC and store in +C ZZC(J). Generate new mass with ZC and store in PJSET(5,J). +C +C Must include 1/2 symmetry factor in GAMGG. No fix is needed +C in QCDZ since GAMGG+2*GAMQQ is used as the normalization. +C +C Include GM, W+, W-, and Z0 radiation. +C +C Ver 7.20: Anomalous dimensions were coded incorrectly! +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/jetset.inc" +#include "isajet/jwork.inc" +#include "isajet/qcdpar.inc" +#include "isajet/const.inc" +#include "isajet/wcon.inc" +#include "isajet/primar.inc" +C + REAL AM0,AM1,AM2,AMASS,T0,T1,T2,ZC,B0,GAMEW,GAMQQ,GAMGG,GAM,GAMZC + REAL AM1W,AM2W,T1W,T2W,TERM,GB,PROB,RANF,RND,POW,AMNEW,AMOLD + REAL POWEW + INTEGER J,JTLV1,NF,IQ,JTABS,IW,JT0,JT1,IFL1,I + INTEGER JWTYPE(4) + DATA JWTYPE/10,80,-80,90/ +C +C Set ZC = 0 and return for W+- or Z0 +C + JTABS=IABS(JTYPE(J)) + IF(JTABS.GE.80.AND.JTABS.LE.90) THEN + ZZC(J)=0. + RETURN + ENDIF +C +C Calculate ZC +C + AM0=PJSET(5,J) + JTLV1=JTYPE(J) + AM1=AMASS(JTLV1)+CUTJET + AM2=CUTJET + IF(AM1+AM2.GE.AM0) GO TO 300 + T0=AM0**2 + T1=AM1**2 + T2=AM2**2 + ZC=(T0-T1+T2-SQRT((T0-T1-T2)**2-4*T1*T2))/(2*T0) + ZZC(J)=ZC +C Count light fermions + NF=3 + DO 110 IQ=4,6 + IF(AM0.LT.2*AMASS(IQ)) GO TO 120 + NF=NF+1 +110 CONTINUE +120 B0=11.-2.*NF/3. +C +C Calculate GAMMA(ZC) and GAMEW for quarks +C + GAMEW=0. +C +C Initial gluon + IF(JTABS.EQ.9) THEN + GAMQQ=(1.-2.*ZC)*(1.-ZC*(1.-ZC))/3. + GAMGG=12.*ALOG((1.-ZC)/ZC)-9.*(1.-2.*ZC)-6.*GAMQQ + GAMGG=0.5*GAMGG + GAM=GAMGG+NF*GAMQQ +C +C Initial quark + ELSEIF(JTABS.LT.9) THEN + GAMZC=2.*ALOG((1-ZC)/ZC)-1.5*(1.-2.*ZC) + GAM=4./3.*GAMZC + GAMEW=ALFA/(2.*PI)*AQ(JTABS,1)**2*GAMZC + IF(AM0.GT.WMASS(4)) THEN + DO 130 IW=2,4 + JT0=2*IABS(JTYPE(J)) + IF(JTYPE(J).LT.0) JT0=JT0+1 + JT1=MATCH(JT0,IW) + IF(JT1.EQ.0) GO TO 130 + JT1=MATCH(JT1,4) + IFL1=JT1/2 + AM1W=AMASS(IFL1) + AM2W=AMASS(JWTYPE(IW)) + IF(AM1W+AM2W.GE.AM0) GO TO 130 + T1W=AM1W**2 + T2W=AM2W**2 + ZC=(T0-T1W+T2W-SQRT((T0-T1W-T2W)**2-4*T1W*T2W))/(2*T0) + GAMZC=2.*ALOG((1-ZC)/ZC)-1.5*(1.-2.*ZC) + TERM=(AQ(JTABS,IW)**2+BQ(JTABS,IW)**2)*GAMZC + GAMEW=GAMEW+ALFA/(2.*PI)*TERM +130 CONTINUE + ENDIF +C +C Initial diquark + ELSEIF(MOD(JTABS,100).EQ.0) THEN + GAM=8./3.*ALOG((1-ZC)/ZC)-2.*(1.-2.*ZC) +C +C Initial gluino + ELSEIF(JTABS.EQ.29) THEN + GAM=6.*ALOG((1.-ZC)/ZC)-9./2.*(1.-2.*ZC) +C +C Initial squark + ELSEIF(JTABS.GT.20.AND.JTABS.LT.29) THEN + GAM = 8./3.*(ALOG((1.-ZC)/ZC)-(1.-2.*ZC)) + ENDIF +C +C Generate new mass +C + GB=2*GAM/B0 + PROB=(ALOG(AM1/ALAM)/ALOG(AM0/ALAM))**GB + PROB=PROB*(AM1/AM0)**(2.*GAMEW) + IF(PROB.GT.RANF()) GO TO 300 + RND=RANF() + POW=(1.-(1.-PROB)*RND)**(1./GB) + AMNEW=ALAM*(AM0/ALAM)**POW +C For quark, add effect of GM, W+-, Z0 radiation + IF(IABS(JTYPE(J)).LT.9) THEN + DO 200 I=1,NTRIES + AMOLD=AMNEW + POWEW=POW/((AMOLD/AM0)**(2.*GAMEW))**(1./GB) + AMNEW=ALAM*(AM0/ALAM)**POWEW + IF(ABS(AMNEW-AMOLD).LT.0.001*AMOLD) GO TO 210 +200 CONTINUE + ENDIF +210 IF(AMNEW.LE.AM1) GO TO 300 + PJSET(5,J)=AMNEW + RETURN +C +C Final parton -- set mass to physical value +C +300 PJSET(5,J)=AM1-CUTJET + JDCAY(J)=0 + RETURN + END diff --git a/ISAJET/code/qcdz.F b/ISAJET/code/qcdz.F new file mode 100644 index 00000000000..8e8f4a470f3 --- /dev/null +++ b/ISAJET/code/qcdz.F @@ -0,0 +1,246 @@ +#include "isajet/pilot.h" + SUBROUTINE QCDZ(J) +C +C Auxiliary routine for QCDJET. Generate Z for parton J and +C store in ZZC(J). Add possible new partons to /JETSET/. +C +C Include GM, W+, W-, and Z0 radiation. +C +C Ver 7.20: Anomalous dimensions were coded incorrectly! +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/jetset.inc" +#include "isajet/jwork.inc" +#include "isajet/qcdpar.inc" +#include "isajet/wcon.inc" +#include "isajet/const.inc" +#include "isajet/q1q2.inc" +C + REAL PQQ,PGQ,PQG,PGG,Z,PGSGS,PQSQS,ALFAS,QQ,AM0,ZC,AMASS + REAL GAMQQ,GAMGG,PROBG,PROBQ,RND,RANF,ZGEN,GZ + REAL GAMZC,GAMSUM,AM1W,AM2W,T1W,T2W,ZCW,T0,GAMZCW,TERM,SUM + REAL SUMBR,BRMODE,TRY,HELPL,HELMN,HEL,PZ + INTEGER NF,J,JTABS,IQ,IFL,IW,JT0,JT1,IFL1,IFL2 + INTEGER IWTYPE,JET,JW,IQ1,IQ2,JPAR,IFLPAR,NJ1,NJ2,IDABS1,IDABS2 + REAL GAMSAV(5),ZCSAV(5),BRANCH(25) + INTEGER JSAV(5),LISTW(5),LISTJ(25) + DATA LISTW/9,10,80,-80,90/ + DATA LISTJ/9,1,-1,2,-2,3,-3,4,-4,5,-5,6,-6, + $11,-11,12,-12,13,-13,14,-14,15,-15,16,-16/ +C +C Altarelli-Parisi functions. + PQQ(Z)=4*(1+Z**2)/(3*(1-Z)) + PGQ(Z)=.5*(Z**2+(1-Z)**2) + PGG(Z)=6*(1-Z*(1-Z))**2/(Z*(1-Z)) + PGSGS(Z)=3.*(1.+Z**2)/(1.-Z) + PQSQS(Z)=8./3.*Z/(1.-Z) + ALFAS(QQ)=12.*PI/((33.-2.*NF)*ALOG(QQ/ALAM2)) +C +C Initialize. +C + AM0=PJSET(5,J) + ZC=ZZC(J) + JTABS=IABS(JTYPE(J)) + NF=3 + DO 110 IQ=4,6 + IF(AM0.LT.2*AMASS(IQ)) GO TO 120 + NF=NF+1 +110 CONTINUE +120 CONTINUE + NJ1=NJSET+1 + NJ2=NJSET+2 +C +C Initial gluon +C + IF (JTABS.EQ.9) THEN + GAMQQ=(1-2*ZC)*(1-ZC*(1-ZC))/3. + GAMGG=12*ALOG((1-ZC)/ZC)-9*(1-2*ZC)-6*GAMQQ + PROBG=GAMGG/(GAMGG+2*NF*GAMQQ) + PROBQ=GAMQQ/(GAMGG+2*NF*GAMQQ) + RND=RANF() +C GL--->GL+GL + IF(PROBG.GT.RND) THEN +130 ZGEN=(ZC/(1-ZC))**(1-2*RANF()) + Z=ZGEN/(1.+ZGEN) + GZ=6./(Z*(1.-Z)) + IF(PGG(Z).LT.GZ*RANF()) GO TO 130 + JTYPE(NJ1)=9 + JTYPE(NJ2)=9 + ZZC(J)=Z +C GL--->QK+QB + ELSE +140 Z=RANF() + IF(PGQ(Z).LT.0.5*RANF()) GO TO 140 + IFL=(RND-PROBG)/PROBQ+1. + IF(IFL.GT.NF) IFL=NF-IFL + JTYPE(NJ1)=IFL + JTYPE(NJ2)=-IFL + ZZC(J)=Z + ENDIF +C +C Initial quark - may radiate GL, GM, W+-, Z0 +C + ELSEIF(JTABS.LT.9) THEN +C Gluon + GAMZC=2.*ALOG((1-ZC)/ZC)-1.5*(1.-2.*ZC) + GAMSAV(1)=4./3.*ALFAS(AM0**2)*GAMZC + ZCSAV(1)=ZC + JSAV(1)=JTYPE(J) +C Photon + GAMSAV(2)=ALFA*AQ(JTABS,1)**2*GAMZC + ZCSAV(2)=ZC + GAMSUM=GAMSAV(1)+GAMSAV(2) + JSAV(2)=JTYPE(J) +C W+- and Z0 + IF(AM0.GT.WMASS(4)) THEN + DO 200 IW=2,4 + GAMSAV(IW+1)=0. + ZCSAV(IW+1)=.5 + JSAV(IW+1)=0 + JT0=2*IABS(JTYPE(J)) + IF(JTYPE(J).LT.0) JT0=JT0+1 + JT1=MATCH(JT0,IW) + IF(JT1.EQ.0) GO TO 200 + JT1=MATCH(JT1,4) + IFL1=JT1/2 + AM1W=AMASS(IFL1) + AM2W=AMASS(LISTW(IW+1)) + IF(AM1W+AM2W.GE.AM0) GO TO 200 + T0=AM0**2 + T1W=AM1W**2 + T2W=AM2W**2 + ZCW=(T0-T1W+T2W-SQRT((T0-T1W-T2W)**2-4*T1W*T2W))/(2*T0) + GAMZCW=2.*ALOG((1-ZCW)/ZCW)-2.*(1.-2.*ZCW) + TERM=(AQ(JTABS,IW)**2+BQ(JTABS,IW)**2)*ALFA*GAMZCW + GAMSAV(IW+1)=TERM + ZCSAV(IW+1)=ZCW + JSAV(IW+1)=IFL1*ISIGN(1,JTYPE(J)) + GAMSUM=GAMSUM+TERM +200 CONTINUE + ELSE + DO 210 IW=2,4 + GAMSAV(IW+1)=0. + ZCSAV(IW+1)=.5 + JSAV(IW+1)=0 +210 CONTINUE + ENDIF +C Select decay mode + RND=RANF() + SUM=0. + DO 220 IW=1,5 + IWTYPE=IW + SUM=SUM+GAMSAV(IW)/GAMSUM + IF(RND.LT.SUM) GO TO 230 +220 CONTINUE +C Generate Z +230 CONTINUE + Z=1-(ZC/(1-ZC))**RANF()*(1-ZC) + GZ=8./(3.*(1-Z)) + IF(PQQ(Z).LT.GZ*RANF()) GO TO 230 + IF(Z.LT.ZCSAV(IWTYPE).OR.Z.GT.1.-ZCSAV(IWTYPE)) GO TO 230 + JTYPE(NJ1)=JSAV(IWTYPE) + JTYPE(NJ2)=LISTW(IWTYPE) + ZZC(J)=Z +C +C Initial diquark +C + ELSEIF(MOD(JTABS,100).EQ.0) THEN +300 CONTINUE + Z=1-(ZC/(1-ZC))**RANF()*(1-ZC) + GZ=8./(3.*(1-Z)) + IF(PQQ(Z).LT.GZ*RANF()) GO TO 300 + JTYPE(NJ1)=JTYPE(J) + JTYPE(NJ2)=9 + ZZC(J)=Z +C +C Initial gluino +C + ELSEIF (JTABS.EQ.29) THEN +400 Z=1.-(ZC/(1.-ZC))**RANF()*(1.-ZC) + GZ=6./(1.-Z) + IF(PGSGS(Z) .LT. GZ*RANF()) GOTO 400 + JTYPE(NJ1)=JTYPE(J) + JTYPE(NJ2)=9 + ZZC(J)=Z +C +C Initial squark +C + ELSEIF(JTABS.GT.20.AND.JTABS.LT.29) THEN +500 CONTINUE + Z=1-(ZC/(1-ZC))**RANF()*(1-ZC) + GZ=8./(3.*(1-Z)) + IF(PQSQS(Z).LT.GZ*RANF()) GO TO 500 + JTYPE(NJ1)=JTYPE(J) + JTYPE(NJ2)=9 + ZZC(J)=Z +C +C Initial W+, W-, or Z0 +C + ELSEIF(JTABS.EQ.80.OR.JTABS.EQ.90) THEN +C Select decay mode + IF(JTYPE(J).EQ.+80) JW=2 + IF(JTYPE(J).EQ.-80) JW=3 + IF(JTYPE(J).EQ.+90) JW=4 + TRY=RANF() + DO 610 IQ=2,25 + IF(TRY.LT.CUMWBR(IQ,JW-1)) THEN + IQ1=IQ + IQ2=MATCH(IQ,JW) + GO TO 620 + ENDIF +610 CONTINUE +620 JTYPE(NJ1)=LISTJ(IQ1) + JTYPE(NJ2)=LISTJ(IQ2) +C Select W helicity + JPAR=MOD(JORIG(J),JPACK) + IFLPAR=IABS(JTYPE(JPAR)) + HELPL=(AQ(IFLPAR,JW)-BQ(IFLPAR,JW))**2 + HELMN=(AQ(IFLPAR,JW)+BQ(IFLPAR,JW))**2 + IF(RANF()*(HELPL+HELMN).LT.HELMN) THEN + HEL=-ISIGN(1,JTYPE(NJ1)) + ELSE + HEL=+ISIGN(1,JTYPE(NJ1)) + ENDIF +630 Z=RANF() + PZ=(1.+HEL*(2.*Z-1.))**2 + IF(PZ.LT.4.*RANF()) GO TO 630 + ZZC(J)=Z + ENDIF +C +C Set masses and flags. +C + JET=IABS(JORIG(J))/JPACK + JORIG(NJ1)=JPACK*JET+J + JORIG(NJ2)=JPACK*JET+J + IDABS1=IABS(JTYPE(NJ1)) + IDABS2=IABS(JTYPE(NJ2)) + JMATCH(NJ1)=NJ2 + JMATCH(NJ2)=NJ1 +C JDCAY=-1 implies further decay + IF(IDABS1.LE.9.OR.(IDABS1.GT.20.AND.IDABS1.LT.30.).OR. + $MOD(IDABS1,100).EQ.0) THEN + PJSET(5,NJ1)=Z*AM0 + JDCAY(NJ1)=-1 + ELSEIF(IDABS1.GE.80.OR.IDABS1.LE.90) THEN + PJSET(5,NJ1)=AMASS(IDABS1) + JDCAY(NJ1)=-1 + ELSE + PJSET(5,NJ1)=AMASS(IDABS1) + JDCAY(NJ1)=0 + ENDIF + IF(IDABS2.LE.9.OR.(IDABS2.GT.20.AND.IDABS2.LT.30.).OR. + $MOD(IDABS2,100).EQ.0) THEN + PJSET(5,NJ2)=(1.-Z)*AM0 + JDCAY(NJ2)=-1 + ELSEIF(IDABS2.EQ.80.OR.IDABS2.EQ.90) THEN + PJSET(5,NJ2)=AMASS(IDABS2) + JDCAY(NJ2)=-1 + ELSE + PJSET(5,NJ2)=AMASS(IDABS2) + JDCAY(NJ2)=0 + ENDIF + RETURN + END diff --git a/ISAJET/code/qfunc.F b/ISAJET/code/qfunc.F new file mode 100644 index 00000000000..eb810f84a9a --- /dev/null +++ b/ISAJET/code/qfunc.F @@ -0,0 +1,364 @@ +#include "isajet/pilot.h" + SUBROUTINE QFUNC +C +C Find approximate QMW and QTW dependence for DRELLYAN. +C Set up /WGEN/ to generate QMW and QTW. Fit is +C Non-resonant: +C SIGMA=ANORM/(Q2/QMAX**2)**QPOW/(PT**2+RNU2)**PTPOW +C Resonant: +C SIGMA=ANORM/((Q**2-M**2)**2+M**2*GAM**2) +C with appropriate M and GAM. +C +C Ver. 6.23: Remove extension of region 1 under region 2 +C to avoid discontinuity in d(sigma)/d(M) +C Ver. 6.40: Scale Q**2 fit by QMAX**2 to avoid underflow +C problems. Must also change DRLLYN +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/dypar.inc" +#include "isajet/dylim.inc" +#include "isajet/jetpar.inc" +#include "isajet/jetlim.inc" +#include "isajet/q1q2.inc" +#include "isajet/wcon.inc" +#include "isajet/wgen.inc" +#include "isajet/jetsig.inc" +#include "isajet/keys.inc" +#include "isajet/hcon.inc" +#include "isajet/tcpar.inc" +#include "isajet/xmssm.inc" +C + REAL QT2CUT,DPT,QMN,QMX,EM,GAM,DELM,QSTOR,SUMS,DQ,ETAX,ETA, + $Q2,XI,ALI,SIGSAV,T1,T2,T3,T4,T5,DET,DEVMAX,PTNU,ALPTNU,ALQ2,FIT, + $DEV,DY3,DYW,SIG00,FACTOR,FAC1,C1,B1,SUM,AL1,QMAX2 + INTEGER NDIV1,NDIV2,K,I,NQS,J,N,NDIV3,NDIV4,IW,I3,II + DIMENSION SUMS(9) + DIMENSION QMN(3),QMX(3) + DIMENSION SIGSAV(20,20) +C +C QT cutoff function + QT2CUT(QMW)=CUTOFF*QMW**CUTPOW +C +C Entry +C + IF(FIXQM) THEN + NDIV1=1 + ELSE + NDIV1=20 + ENDIF + IF(FIXQT) THEN + NDIV2=1 + ELSE + NDIV2=20 + ENDIF +C + DPT=(PTMAX(3)-PTMIN(3))/NDIV2 + YJ(3)=0 + YW=0. + CTH(3)=0. + STH(3)=1. + IF(GODY(4)) JWTYP=4 + NKL=1 + NKH=1 + QMN(1)=QMIN + QMX(1)=QMAX + QMAX2=QMAX**2 +C +C Define resonance region +C + IF(KEYS(3)) THEN + IF(JWTYP.EQ.1) GO TO 99 + EM=WMASS(JWTYP) + GAM=WGAM(JWTYP) + DELM=20. + ELSEIF(KEYS(7)) THEN + EM=HMASS + GAM=HGAM + DELM=.201357*EM + DELM=AMIN1(DELM,1.5*HGAM) + DELM=AMAX1(DELM,.1*EM) + ELSEIF(KEYS(9)) THEN + EM=TCMRHO + GAM=TCGRHO + DELM=.201357*EM + DELM=AMIN1(DELM,1.5*TCGRHO) + DELM=AMAX1(DELM,.1*EM) +C No resonance region for KKG + ELSEIF(KEYS(11)) THEN + EM=QMAX + GAM=0. + DELM=0. + ENDIF + EMGAM=EM*GAM + EMSQ=EM**2 +C Region limits + QMN(2)=EM-DELM + QMN(3)=EM+DELM + QMX(1)=QMN(2) + QMX(2)=QMN(3) + NKL=1 + NKH=3 + IF(QMAX.LE.QMN(3)) NKH=2 + IF(QMAX.LE.QMN(2)) NKH=1 + IF(QMIN.GE.QMN(2)) NKL=2 + IF(QMIN.GE.QMN(3)) NKL=3 + QMX(NKH)=QMAX + QMN(NKL)=QMIN + 99 CONTINUE +C +C Fit over regions NKL to NKH +C Region 1 is below resonance +C Region 2 is inside resonance +C Region 3 is above resonance +C FIT=ANORM/(Q2/QMAX**2)**QPOW/(PT**2+RNU2)**PTPOW +C + DO 100 K=1,3 + ANORM(K)=0. + PTPOW(K)=0. + QPOW(K)=0. + RNU2(K)=QT2CUT(QMIN) +100 CONTINUE +C +C Loop over regions +C + DO 200 K=NKL,NKH + DO 210 I=1,9 +210 SUMS(I)=0 + DQ=(QMX(K)-QMN(K))/NDIV1 + NQS=NDIV1 + DO 220 I=1,NDIV2 + PT(3)=PTMIN(3)+(I-1)*DPT + QTW=PT(3) + P(3)=PT(3) + RNU2(K)=QT2CUT(QMN(K)) + ETAX=PT(3)**2+RNU2(K) + ETA=ALOG(ETAX) + DO 230 J=1,NQS + QMW=QMN(K)+(J-1)*DQ + Q2=QMW*QMW + XI=ALOG(Q2/QMAX2) + SUMS(1)=SUMS(1)+XI + SUMS(2)=SUMS(2)+ETA + SUMS(5)=SUMS(5)+ETA*ETA + SUMS(4)=SUMS(4)+XI**2 + SUMS(7)=SUMS(7)+XI*ETA +C Cross section + IF(KEYS(3)) THEN + CALL SIGDY + ELSEIF(KEYS(7).AND..NOT.GOMSSM) THEN + CALL SIGH + ELSEIF(KEYS(7).AND.GOMSSM) THEN + CALL SIGHSS + ELSEIF(KEYS(9)) THEN + CALL SIGTC + ELSEIF(KEYS(11)) THEN + CALL SIGKKG + ENDIF + IF(SIGMA.EQ.0.) GO TO 999 + AL1=ALOG(SIGMA) + SIGSAV(I,J)=AL1 + IF(K.EQ.2) AL1=AL1+ALOG((Q2-EM**2)**2+EMGAM**2) + SUMS(3)=SUMS(3)+AL1 + SUMS(8)=SUMS(8)+AL1*XI + SUMS(9)=SUMS(9)+AL1*ETA +230 CONTINUE +220 CONTINUE +C +C Find coefficients minimizing chisq +C + N=NQS*NDIV2 + T1=N*SUMS(7)-SUMS(1)*SUMS(2) + T2=N*SUMS(5)-SUMS(2)**2 + T3=N*SUMS(4)-SUMS(1)**2 + T4=N*SUMS(8)-SUMS(1)*SUMS(3) + T5=N*SUMS(9)-SUMS(2)*SUMS(3) + IF((FIXQM.OR.K.EQ.2).AND.FIXQT) THEN + PTPOW(K)=0. + QPOW(K)=0. + ELSEIF(FIXQT) THEN + PTPOW(K)=0. + QPOW(K)=-T4/T3 + ELSEIF(FIXQM.OR.K.EQ.2) THEN + PTPOW(K)=-T5/T2 + QPOW(K)=0. + ELSE + DET=T1**2-T2*T3 + PTPOW(K)=(T5*T3-T4*T1)/DET + QPOW(K)=(T4*T2-T1*T5)/DET + ENDIF + ANORM(K)=(QPOW(K)*SUMS(1)+PTPOW(K)*SUMS(2)+SUMS(3))/N +C +C Shift fit to obtain envelope for SIGDY +C + DEVMAX=0. + DO 240 I=1,NDIV2 + PT(3)=PTMIN(3)+(I-1)*DPT + PTNU=PT(3)**2+RNU2(K) + DO 250 J=1,NDIV1 + QMW=QMN(K)+(J-1)*DQ + Q2=QMW**2 + ALPTNU=ALOG(PTNU) + ALQ2=ALOG(Q2/QMAX2) + IF(K.EQ.2) THEN + FIT=EXP(ANORM(K)-PTPOW(K)*ALPTNU + $ -ALOG((Q2-EM**2)**2+EMGAM**2)) + ELSE + FIT=EXP(ANORM(K)-PTPOW(K)*ALPTNU-QPOW(K)*ALQ2) + ENDIF + DEV=SIGSAV(I,J)-ALOG(FIT) + IF(DEV.GT.DEVMAX) DEVMAX=DEV +250 CONTINUE +240 CONTINUE + ANORM(K)=ANORM(K)+DEVMAX +200 CONTINUE +C +C Shift fit to obtain envelope in YW + NDIV3=20 + IF(STDDY) THEN + NDIV4=1 + DY3=0. + ELSE + NDIV4=20 + DY3=(YJMAX(3)-YJMIN(3))/(NDIV4-1) + ENDIF + DYW=(YWMAX-YWMIN)/(NDIV3-1) +C + DO 300 K=NKL,NKH + QMW=QMN(K) + Q2=QMW**2 + QTW=QTMIN + PT(3)=QTW + P(3)=PT(3) + YW=0. + YJ(3)=0. + CTH(3)=0. + STH(3)=1. + IF(KEYS(3)) THEN + CALL SIGDY + ELSEIF(KEYS(7).AND..NOT.GOMSSM) THEN + CALL SIGH + ELSEIF(KEYS(7).AND.GOMSSM) THEN + CALL SIGHSS + ELSEIF(KEYS(9)) THEN + CALL SIGTC + ELSEIF(KEYS(11)) THEN + CALL SIGKKG + ENDIF + SIG00=SIGMA + FACTOR=1. + DO 310 IW=1,NDIV3 + YW=YWMIN+(IW-1)*DYW + DO 320 I3=1,NDIV4 + IF(.NOT.STDDY) THEN + YJ(3)=YJMIN(3)+(I3-1)*DY3 + CTH(3)=TANH(YJ(3)) + STH(3)=SQRT(1.-CTH(3)**2) + IF(STH(3).EQ.0.) GO TO 320 + TH(3)=ACOS(CTH(3)) + P(3)=PT(3)/STH(3) + ENDIF + IF(KEYS(3)) THEN + CALL SIGDY + ELSEIF(KEYS(7).AND..NOT.GOMSSM) THEN + CALL SIGH + ELSEIF(KEYS(7).AND.GOMSSM) THEN + CALL SIGHSS + ELSEIF(KEYS(9)) THEN + CALL SIGTC + ELSEIF(KEYS(11)) THEN + CALL SIGKKG + ENDIF + FAC1=SIGMA/SIG00 + FACTOR=AMAX1(FACTOR,FAC1) +320 CONTINUE +310 CONTINUE + ANORM(K)=ALOG(FACTOR)+ANORM(K) +300 CONTINUE +C +C Set up generating constants for PT**2 and QMW**2 +C + DO 400 K=NKL,NKH + C1=1.-PTPOW(K) + PTGN(1,K)=(PTMIN(3)**2+RNU2(K))**C1 + PTGN(2,K)=(PTMAX(3)**2+RNU2(K))**C1-PTGN(1,K) + PTGN(3,K)=1./C1 + IF(K.EQ.2) THEN + QGEN(1,2)=ATAN((QMN(2)**2-EMSQ)/EMGAM) + QGEN(2,2)=ATAN((QMX(2)**2-EMSQ)/EMGAM)-QGEN(1,2) + QGEN(3,2)=EMGAM + ELSE + B1=1.-QPOW(K) + QGEN(1,K)=(QMN(K)/QMAX)**(2.*B1) + QGEN(2,K)=(QMX(K)/QMAX)**(2.*B1)-QGEN(1,K) + QGEN(3,K)=1./B1 + ENDIF +400 CONTINUE +C + DO 410 K=1,3 +410 QSELWT(K)=0. + SUM=0. +C + DO 420 K=NKL,NKH + QSELWT(K)=1. + IF(.NOT.FIXQT) QSELWT(K)=QSELWT(K)*PTGN(2,K)*PTGN(3,K) + IF(.NOT.FIXQM) THEN + IF(K.EQ.2) THEN + QSELWT(K)=QSELWT(K)*QGEN(2,K)/EMGAM + ELSE + QSELWT(K)=QMAX**2*QSELWT(K)*QGEN(2,K)*QGEN(3,K) + ENDIF + ENDIF + QSELWT(K)=EXP(ALOG(QSELWT(K))+ANORM(K)) + SUM=SUM+QSELWT(K) +420 CONTINUE +C + DO 430 K=1,3 + QSELWT(K)=QSELWT(K)/SUM +430 CONTINUE +C +C Write fit to output +C + WRITE(ITLIS,4301) +4301 FORMAT(//10X,' QT AND Q FIRST GENERATED BY--'/) + DO 440 K=NKL,NKH + WRITE(ITLIS,4402) K,QMN(K),QMX(K) +4402 FORMAT(//5X,' REGION',I2,5X,E11.4,' < Q < ',E11.5) + WRITE(ITLIS,4403) (PTGN(II,K),II=1,3),RNU2(K) +4403 FORMAT(/' QT**2 = (',E11.4,' + ',E11.4,' * RANF) ** ',E11.4, + $ ' - ',E11.4) + IF(K.NE.2) THEN + WRITE(ITLIS,4404) QMAX2,(QGEN(II,K),II=1,3) +4404 FORMAT(/' Q**2 = ',E11.4,' * (',E11.4,' + ',E11.4, + $ ' * RANF) ** ',E11.4) + ELSE + WRITE(ITLIS,4505) QGEN(3,K),QGEN(1,K),QGEN(2,K),EMSQ +4505 FORMAT(/' Q**2 = ',E11.4,' * TAN(',E11.4,' + ',E11.4, + $ ' * RANF) + ',E11.4) + ENDIF + WRITE(ITLIS,4506) QSELWT(K) +4506 FORMAT(/' WEIGHT = ',E11.4) +440 CONTINUE +C +C Set fixed limits if any +C + IF(FIXQT) THEN + PTMAX(3)=PTMIN(3) + PT(3)=PTMIN(3) + QTW=PT(3) + ENDIF + IF(FIXQM) THEN + QMAX=QMIN + QMW=QMIN + ENDIF + RETURN +C +C Fit fails if SIGMA=0 in allowed range +C +999 WRITE(ITLIS,9990) QMW,QTW +9990 FORMAT(//' ERROR IN QFUNC...SIGMA=0 FOR QMW = ',E12.4,' , QTW = ', + 1E12.4/' CHECK YOUR LIMITS') + STOP 99 + END diff --git a/ISAJET/code/ranfgt.F b/ISAJET/code/ranfgt.F new file mode 100644 index 00000000000..52da68a6de9 --- /dev/null +++ b/ISAJET/code/ranfgt.F @@ -0,0 +1,24 @@ +#include "isajet/pilot.h" + SUBROUTINE RANFGT(SEED) +C +C Get seed for RANF() in real or double precision SEED. +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#if defined(CERNLIB_SINGLE) + REAL SEED +#endif +#if defined(CERNLIB_DOUBLE) + DOUBLE PRECISION SEED +#endif +#if defined(CERNLIB_RANFCALL) + CALL RANGET(SEED) +#endif +#if defined(CERNLIB_CRAY) + INTEGER ISEED,RANGET,IDUMMY + ISEED=RANGET(IDUMMY) + SEED=ISEED +#endif + RETURN + END diff --git a/ISAJET/code/ranfmt.F b/ISAJET/code/ranfmt.F new file mode 100644 index 00000000000..22712eb329c --- /dev/null +++ b/ISAJET/code/ranfmt.F @@ -0,0 +1,22 @@ +#include "isajet/pilot.h" + SUBROUTINE RANFMT +C +C Get RANF seed and translate it to a character variable +C to ensure exactly the same seed with a formatted read. +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/seed.inc" +#if defined(CERNLIB_SINGLE) +* REAL SEED +#endif +#if defined(CERNLIB_DOUBLE) +* DOUBLE PRECISION SEED +#endif +* CALL RANFGT(SEED) +* WRITE(XSEED,'(E24.15)') SEED +* READ(XSEED,'(E24.15)') SEED +* CALL RANFST(SEED) + RETURN + END diff --git a/ISAJET/code/ranfst.F b/ISAJET/code/ranfst.F new file mode 100644 index 00000000000..7be7535c383 --- /dev/null +++ b/ISAJET/code/ranfst.F @@ -0,0 +1,24 @@ +#include "isajet/pilot.h" + SUBROUTINE RANFST(SEED) +C +C Set seed for RANF() from real or double precision SEED +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#if defined(CERNLIB_SINGLE) + REAL SEED +#endif +#if defined(CERNLIB_DOUBLE) + DOUBLE PRECISION SEED +#endif +#if defined(CERNLIB_RANFCALL) + CALL RANSET(SEED) +#endif +#if defined(CERNLIB_CRAY) + INTEGER ISEED + ISEED=SEED + CALL RANSET(ISEED) +#endif + RETURN + END diff --git a/ISAJET/code/readin.F b/ISAJET/code/readin.F new file mode 100644 index 00000000000..824d4e34552 --- /dev/null +++ b/ISAJET/code/readin.F @@ -0,0 +1,1097 @@ +#include "isajet/pilot.h" + SUBROUTINE READIN(IFL) +C +C Read in user data and execute SETTYP if appropriate values +C are set. IFL return values: +C IFL = 0 Good parameter set +C IFL = 1001 Stop +C IFL > 0 Error. Program will continue reading data but +C will exit when END or unrecognizable keyword +C is found. +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/mbgen.inc" +#include "isajet/force.inc" +#include "isajet/dkytab.inc" +#include "isajet/qcdpar.inc" +#include "isajet/eepar.inc" +#include "isajet/idrun.inc" +#include "isajet/frgpar.inc" +#include "isajet/keys.inc" +#include "isajet/kkgrav.inc" +#include "isajet/prtout.inc" +#include "isajet/seed.inc" +#include "isajet/types.inc" +#include "isajet/primar.inc" +#include "isajet/jetlim.inc" +#include "isajet/nodcay.inc" +#include "isajet/wcon.inc" +#include "isajet/dylim.inc" +#include "isajet/qlmass.inc" +#include "isajet/q1q2.inc" +#include "isajet/jetpar.inc" +#include "isajet/isloop.inc" +#include "isajet/tcpar.inc" +#include "isajet/xmssm.inc" +#include "isajet/sugnu.inc" +#if defined(CERNLIB_PDFLIB) +#include "isajet/w50510.inc" +* Ignoring t=pass +#endif +#if defined(CERNLIB_PDFLIB) +#include "isajet/w50517.inc" +* Ignoring t=pass +#endif +#include "isajet/hcon.inc" +#include "isajet/mglims.inc" +C + LOGICAL SETTYP,DUMY + CHARACTER*8 TTL(10),WORD,LSTRUC,BLANK + CHARACTER*8 WTYP(4),RDID(2) + CHARACTER*40 V,VISAJE + INTEGER NLAP(3,17) + INTEGER IDANTI,ID,IDB + INTEGER IFL,I1,I2,I3,J1,I,IKEY,IJ,J,KK,IDABS + INTEGER IDXQKL,IDXQKR + INTEGER NSEL,K,KFORCE(5),INDEX,IDG1,IDG2,IDG3,IDG4,IDXLEP + REAL AMW,AMZ + CHARACTER*8 HTYPE + INTEGER JLIM1,JLIM2 + REAL AMLIM1,AMLIM2 +#if defined(CERNLIB_SINGLE) + REAL SEED +#endif +#if defined(CERNLIB_DOUBLE) + DOUBLE PRECISION SEED +#endif +#if defined(CERNLIB_PDFLIB) + CHARACTER*20 PDFPAR(20) +#endif +#if (defined(CERNLIB_PDFLIB))&&(defined(CERNLIB_SINGLE)) + REAL PDFVAL(20) + REAL DX,DSCALE,DXPDF(-6:6) +#endif +#if (defined(CERNLIB_PDFLIB))&&(defined(CERNLIB_DOUBLE)) + DOUBLE PRECISION PDFVAL(20) + DOUBLE PRECISION DX,DSCALE,DXPDF(-6:6) +#endif +C +C Overlapping variable flags. + DATA NLAP/1,2,3, 1,2,7 ,1,2,8, 1,3,5, 1,3,6, 1,3,7, 1,3,8, 1,5,7, + X 1,5,8, 1,6,7, 1,6,8, 2,3,7, 2,3,8, 3,5,7, 3,6,7, 3,5,8, + X 3,6,8/ + DATA BLANK/' '/ +C +C Entry + IFL=0 + V=VISAJE() + WRITE(ITLIS,10) V +10 FORMAT('1',//5X,'***** ',A40,' *****') + WRITE(ITLIS,11) + 11 FORMAT(////30X,' COMMANDS READ BY READIN') +C +C Read title +C + READ(ITCOM,1) TTL + 1 FORMAT(10A8) + WRITE(ITLIS,2) TTL + 2 FORMAT(' ',10A8) + IF(TTL(1).EQ.'STOP ') THEN + IFL=1001 + RETURN + ENDIF +C +C Read energy and no. of events +C + READ(ITCOM,*) ECM,NEVENT,NEVPRT,NJUMP + WRITE(ITLIS,*) ECM,NEVENT,NEVPRT,NJUMP +C +C Reset all variables and set process if title is not 'SAME' +C + IF(TTL(1).NE.'SAME ') THEN + DO 20 I=1,10 + 20 TITLE(I)=TTL(I) + CALL RESET + KEYON=.FALSE. +C Read reaction + READ(ITCOM,3) REAC + 3 FORMAT(A8) + WRITE(ITLIS,4) REAC + 4 FORMAT(1X,A8) + DO 18 I=1,MXKEYS +18 KEYS(I)=.FALSE. + KEYON=.FALSE. +C Set KEYS and NJET + IF(REAC.EQ.'TWOJET ') THEN + KEYS(1)=.TRUE. + IKEY=1 + NJET=2 + ELSEIF(REAC.EQ.'E+E- ') THEN + KEYS(2)=.TRUE. + IKEY=2 + NJET=2 + ELSEIF(REAC.EQ.'DRELLYAN') THEN + KEYS(3)=.TRUE. + IKEY=3 + NJET=3 + ELSEIF(REAC.EQ.'MINBIAS ') THEN + KEYS(4)=.TRUE. + IKEY=4 + NJET=0 + ELSEIF(REAC.EQ.'SUPERSYM'.OR.REAC.EQ.'SUSY ') THEN + KEYS(5)=.TRUE. + IKEY=5 + NJET=2 + ELSEIF(REAC.EQ.'WPAIR ') THEN + KEYS(6)=.TRUE. + IKEY=6 + NJET=2 + ELSEIF(REAC.EQ.'HIGGS ') THEN + KEYS(7)=.TRUE. + IKEY=7 + NJET=2 + ELSEIF(REAC.EQ.'PHOTON ') THEN + KEYS(8)=.TRUE. + IKEY=8 + NJET=2 + ELSEIF(REAC.EQ.'TCOLOR ') THEN + KEYS(9)=.TRUE. + IKEYS=9 + NJET=2 + ELSEIF(REAC.EQ.'WHIGGS ') THEN + KEYS(10)=.TRUE. + IKEY=10 + NJET=2 + ELSEIF(REAC.EQ.'EXTRADIM') THEN + KEYS(11)=.TRUE. + IKEY=11 + NJET=3 + ELSEIF(REAC.EQ.'ZJJ ') THEN + KEYS(12)=.TRUE. + IKEY=12 + NJET=3 + ELSE + KEYON=.FALSE. + 890 WRITE(ITLIS,1999) + IFL=9 + RETURN + ENDIF + ENDIF +C + SCM=ECM**2 + HALFE=ECM/2 + NSEL=0 +C +C Read keyword. For each recognized keyword read corresponding +C variables and set LOC flag. +C + NSEL=0 +100 CONTINUE + READ(ITCOM,3) WORD + WRITE(ITLIS,4) WORD + NSEL=NSEL+1 +C +C Keyword END + IF(WORD.EQ.'END ') THEN +C Check for previous error + IF(IFL.NE.0) RETURN +C Check inconsistent limits + IF(LOC(2)*LOC(5).NE.0.OR.LOC(2)*LOC(6).NE.0) THEN + WRITE(ITLIS,2001) + IFL=11 + ENDIF +C Set and check jet types + IF(LOC(15).NE.0.OR.LOC(37).NE.0.OR.LOC(46).NE.0) THEN + IF(SETTYP(0)) THEN + WRITE(ITLIS,2006) + IFL=12 + ENDIF + ENDIF +C Check MSSM/SUGRA conflict + IF((LOC(51).NE.0.OR.LOC(52).NE.0.OR.LOC(53).NE.0).AND. + $ LOC(55).NE.0) THEN + WRITE(ITLIS,2007) + IFL=29 + ENDIF +C Check overlapping limits + DO 120 I=1,17 + I1=NLAP(1,I) + I2=NLAP(2,I) + I3=NLAP(3,I) + IF(LOC(I1)*LOC(I2)*LOC(I3).NE.0) WRITE(ITLIS,1001) + 120 CONTINUE +C Setup PDFLIB +#if defined(CERNLIB_PDFLIB) + IF(ISTRUC.EQ.-999) THEN + WRITE(ITLIS,1200) +1200 FORMAT(// + $ '1********************************'/ + $ ' * *'/ + $ ' * INITIALIZE PDFLIB FOR ISAJET *'/ + $ ' * *'/ + $ ' ********************************'/) + N6=ITLIS + IFLPRT=2 + CALL PDFSET(PDFPAR,PDFVAL) + CALL PFTOPDG(0.5D0,1.0D2,DXPDF) + IFLPRT=0 + ENDIF +#endif +C Check EXTRADIM parameters are set + IF(KEYS(11).AND.LOC(72).EQ.0) THEN + WRITE(ITLIS,*) 'YOU FORGOT TO SET EXTRAD PARAMETERS' + IFL=72 + ENDIF +C + RETURN + ENDIF +C +C Keyword P + IF(WORD.EQ.'P ') THEN + READ(ITCOM,*) (PMIN(K),PMAX(K),K=1,NJET) + WRITE(ITLIS,*) (PMIN(K),PMAX(K),K=1,NJET) + LOC(1)=NSEL + GO TO 100 + ENDIF +C +C Keyword Y + IF(WORD.EQ.'Y ') THEN + READ(ITCOM,*) (YJMIN(K),YJMAX(K),K=1,NJET) + WRITE(ITLIS,*) (YJMIN(K),YJMAX(K),K=1,NJET) + LOC(2)=NSEL + GO TO 100 + ENDIF +C +C Keyword X + IF(WORD.EQ.'X ') THEN + READ(ITCOM,*) (XJMIN(K),XJMAX(K),K=1,NJET) + WRITE(ITLIS,*) (XJMIN(K),XJMAX(K),K=1,NJET) + LOC(3)=NSEL + GO TO 100 + ENDIF +C +C Keyword PHI + IF(WORD.EQ.'PHI ') THEN + READ(ITCOM,*) (PHIMIN(K),PHIMAX(K),K=1,NJET) + WRITE(ITLIS,*) (PHIMIN(K),PHIMAX(K),K=1,NJET) + LOC(4)=NSEL + GO TO 100 + ENDIF +C +C Keyword TH + IF(WORD.EQ.'TH '.OR.WORD.EQ.'THETA ') THEN + READ(ITCOM,*) (THMIN(K),THMAX(K),K=1,NJET) + WRITE(ITLIS,*) (THMIN(K),THMAX(K),K=1,NJET) + LOC(5)=NSEL + LOC(6)=NSEL + GO TO 100 + ENDIF +C +C Keyword PT + IF(WORD.EQ.'PT '.OR.WORD.EQ.'PPERP ') THEN + READ(ITCOM,*) (PTMIN(K),PTMAX(K),K=1,NJET) + WRITE(ITLIS,*) (PTMIN(K),PTMAX(K),K=1,NJET) + LOC(7)=NSEL + LOC(8)=NSEL + GO TO 100 + ENDIF +C +C Keyword NODECAY + IF(WORD.EQ.'NODECAY ') THEN + READ(ITCOM,571) NODCAY +571 FORMAT(L1) + WRITE(ITLIS,572) NODCAY +572 FORMAT(' ',L1) + LOC(9)=NSEL + GO TO 100 + ENDIF +C +C Keyword NOETA + IF(WORD.EQ.'NOETA ') THEN + READ(ITCOM,571) NOETA + WRITE(ITLIS,572) NOETA + LOC(10)=NSEL + GO TO 100 + ENDIF +C +C Keyword NOPI0 + IF(WORD.EQ.'NOPI0 ') THEN + READ(ITCOM,571) NOPI0 + WRITE(ITLIS,572) NOPI0 + LOC(11)=NSEL + GO TO 100 + ENDIF +C +C Keyword BEAMS + IF(WORD.EQ.'BEAMS ') THEN + READ(ITCOM,*) RDID(1),RDID(2) + WRITE(ITLIS,*) RDID(1),RDID(2) + IDIN(1)=0 + IDIN(2)=0 + DO 123 K=1,2 + IF(RDID(K).EQ.'P ') IDIN(K)=+1120 + IF(RDID(K).EQ.'AP ') IDIN(K)=-1120 + IF(RDID(K).EQ.'N ') IDIN(K)=+1220 + IF(RDID(K).EQ.'AN ') IDIN(K)=-1220 +123 CONTINUE + IF(IDIN(1)*IDIN(2).EQ.0) THEN + WRITE(ITLIS,2002) + IFL=13 + ENDIF + LOC(12)=NSEL + GO TO 100 + ENDIF +C +C Keyword FRAGMENT + IF(WORD.EQ.'FRAGMENT') THEN + READ(ITCOM,*) FRPAR + WRITE(ITLIS,*) FRPAR + LOC(13)=NSEL + GO TO 100 + ENDIF +C +C Keyword SEED + IF(WORD.EQ.'SEED ') THEN + READ(ITCOM,*) SEED + WRITE(ITLIS,*) SEED + CALL RANFST(SEED) + WRITE(XSEED,'(E24.15)') SEED + LOC(14)=NSEL + GO TO 100 + ENDIF +C +C Keywords JETTYPE1, JETTYPE2, JETTYPE3, ... +C (Yes, this is ugly) + IF(WORD.EQ.'JETTYPE1'.OR.WORD.EQ.'JETTYPE2'.OR. + $WORD.EQ.'JETTYPE3'.OR.WORD.EQ.'JETTYPE4'.OR. + $WORD.EQ.'JETTYPE5'.OR.WORD.EQ.'JETTYPE6'.OR. + $WORD.EQ.'JETTYPE7'.OR.WORD.EQ.'JETTYPE8') THEN + IF(WORD.EQ.'JETTYPE1') IJ=1 + IF(WORD.EQ.'JETTYPE2') IJ=2 + IF(WORD.EQ.'JETTYPE3') IJ=3 + IF(WORD.EQ.'JETTYPE4') IJ=4 + IF(WORD.EQ.'JETTYPE5') IJ=5 + IF(WORD.EQ.'JETTYPE6') IJ=6 + IF(WORD.EQ.'JETTYPE7') IJ=7 + IF(WORD.EQ.'JETTYPE8') IJ=8 + DO 151 K=1,30 + JETYP(K,IJ)=BLANK +151 CONTINUE + READ(ITCOM,*) (JETYP(K,IJ),K=1,30) + DO 152 K=1,25 +152 IF(JETYP(K,IJ).NE.BLANK) NJTTYP(IJ)=NJTTYP(IJ)+1 + WRITE(ITLIS,*) (JETYP(K,IJ),K=1,NJTTYP(IJ)) + LOC(15)=NSEL + GO TO 100 + ENDIF +C +C Keyword SIN2W + IF(WORD.EQ.'SIN2W ') THEN + READ(ITCOM,*) SIN2W + WRITE(ITLIS,*) SIN2W + LOC(17)=NSEL + GO TO 100 + ENDIF +C +C Keyword TMASS + IF(WORD.EQ.'TMASS ') THEN + READ(ITCOM,*) AMLEP(6),AMLEP(7),AMLEP(8) + WRITE(ITLIS,*) AMLEP(6),AMLEP(7),AMLEP(8) + LOC(18)=NSEL + GO TO 100 + ENDIF +C +C Keyword QMH + IF(WORD.EQ.'QMH ') THEN + READ(ITCOM,*) QMIN,QMAX + WRITE(ITLIS,*) QMIN,QMAX + LOC(19)=NSEL + GO TO 100 + ENDIF +C +C Keyword QMW + IF(WORD.EQ.'QMW ') THEN + READ(ITCOM,*) QMIN,QMAX + WRITE(ITLIS,*) QMIN,QMAX + LOC(19)=NSEL + GO TO 100 + ENDIF +C +C Keyword QTW + IF(WORD.EQ.'QTW ') THEN + READ(ITCOM,*) QTMIN,QTMAX + WRITE(ITLIS,*) QTMIN,QTMAX + LOC(20)=NSEL + GO TO 100 + ENDIF +C +C Keyword YW + IF(WORD.EQ.'YW ') THEN + READ(ITCOM,*) YWMIN,YWMAX + WRITE(ITLIS,*) YWMIN,YWMAX + LOC(21)=NSEL + GO TO 100 + ENDIF +C +C Keyword XW + IF(WORD.EQ.'XW ') THEN + READ(ITCOM,*) XWMIN,XWMAX + WRITE(ITLIS,*) XWMIN,XWMAX + LOC(22)=NSEL + GO TO 100 + ENDIF +C +C Keyword THW + IF(WORD.EQ.'THW ') THEN + READ(ITCOM,*) THWMIN,THWMAX + WRITE(ITLIS,*) THWMIN,THWMAX + LOC(23)=NSEL + GO TO 100 + ENDIF +C +C Keyword PHIW + IF(WORD.EQ.'PHIW ') THEN + READ(ITCOM,*) PHWMIN,PHWMAX + WRITE(ITLIS,*) PHWMIN,PHWMAX + LOC(24)=NSEL + GO TO 100 + ENDIF +C +C Keyword NONUNU + IF(WORD.EQ.'NONUNU ') THEN + READ(ITCOM,571) NONUNU + WRITE(ITLIS,572) NONUNU + LOC(25)=NSEL + GO TO 100 + ENDIF +C +C Keyword WTYPE + IF(WORD.EQ.'WTYPE ') THEN + DO 261 J=1,4 + WTYP(J)=BLANK + GODY(J)=.FALSE. +261 CONTINUE + READ(ITCOM,*) WTYP + WRITE(ITLIS,*) WTYP + DO 262 K=1,4 + IF(WTYP(K).EQ.'GM ') GODY(1)=.TRUE. + IF(WTYP(K).EQ.'W+ ') GODY(2)=.TRUE. + IF(WTYP(K).EQ.'W- ') GODY(3)=.TRUE. + IF(WTYP(K).EQ.'Z0 ') GODY(4)=.TRUE. + 262 CONTINUE + IF(GODY(1)) JWTYP=1 + IF(GODY(2).OR.GODY(3)) JWTYP=3 + IF(GODY(4)) JWTYP=4 + IF((GODY(2).OR.GODY(3)).AND.(GODY(1).OR.GODY(4))) THEN + WRITE(ITLIS,2003) + IFL=13 + ENDIF + LOC(26)=NSEL + GO TO 100 + ENDIF +C +C Keyword LAMBDA + IF(WORD.EQ.'LAMBDA ') THEN + READ(ITCOM,*) ALAM + WRITE(ITLIS,*) ALAM + ALAM2=ALAM**2 + LOC(27)=NSEL + GO TO 100 + ENDIF +C +C Keyword NTRIES + IF(WORD.EQ.'NTRIES ') THEN + READ(ITCOM,*) NTRIES + WRITE(ITLIS,*) NTRIES + LOC(28)=NSEL + GO TO 100 + ENDIF +C +C Keyword CUTOFF + IF(WORD.EQ.'CUTOFF ') THEN + READ(ITCOM,*) CUTOFF,CUTPOW + WRITE(ITLIS,*) CUTOFF,CUTPOW + LOC(29)=NSEL + GO TO 100 + ENDIF +C +C Keyword XGEN + IF(WORD.EQ.'XGEN ') THEN + READ(ITCOM,*) XGEN + WRITE(ITLIS,*) XGEN + LOC(30)=NSEL + GO TO 100 + ENDIF +C +C Keyword SIGQT + IF(WORD.EQ.'SIGQT ') THEN + READ(ITCOM,*) SIGQT + WRITE(ITLIS,*) SIGQT + LOC(31)=NSEL + GO TO 100 + ENDIF +C +C Keyword CUTJET + IF(WORD.EQ.'CUTJET ') THEN + READ(ITCOM,*) CUTJET + WRITE(ITLIS,*) CUTJET + LOC(32)=NSEL + GO TO 100 + ENDIF +C +C Keyword WFUDGE + IF(WORD.EQ.'WFUDGE ') THEN + READ(ITCOM,*) WFUDGE + WRITE(ITLIS,*) WFUDGE + LOC(50)=NSEL + GO TO 100 + ENDIF +C +C Keyword STRUC + IF(WORD.EQ.'STRUC ') THEN + ISTRUC=0 + READ(ITCOM,*) LSTRUC + WRITE(ITLIS,4) LSTRUC + IF(LSTRUC.EQ.'OWENS ') ISTRUC=1 + IF(LSTRUC.EQ.'BAIER ') ISTRUC=2 + IF(LSTRUC.EQ.'EICHTEN '.OR.LSTRUC.EQ.'EHLQ ') ISTRUC=3 + IF(LSTRUC.EQ.'DUKE '.OR.LSTRUC.EQ.'DO ') ISTRUC=4 + IF(LSTRUC.EQ.'CTEQ2L ') ISTRUC=5 + IF(LSTRUC.EQ.'CTEQ '.OR.LSTRUC.EQ.'CTEQ3L ') ISTRUC=6 + IF(ISTRUC.EQ.0) THEN + WRITE(ITLIS,2002) + IFL=13 + ENDIF + LOC(33)=NSEL + GO TO 100 + ENDIF +C +C Keyword NPOMERON + IF(WORD.EQ.'NPOMERON') THEN + READ(ITCOM,*) MNPOM,MXPOM + WRITE(ITLIS,*) MNPOM,MXPOM + IF(MNPOM.LT.1.OR.MNPOM.GT.MXPOM.OR.MXPOM.GT.LIMPOM) THEN + WRITE(ITLIS,2004) + IFL=14 + ENDIF + LOC(34)=NSEL + GO TO 100 + ENDIF +C +C Keyword FORCE + IF(WORD.EQ.'FORCE ') THEN + NFORCE=NFORCE+1 + IF(NFORCE.GT.MXFORC-1) THEN + WRITE(ITLIS,2004) + IFL=14 + ENDIF + DO 351 K=1,5 +351 KFORCE(K)=0 + READ(ITCOM,*) IFORCE(NFORCE),(KFORCE(K),K=1,5) + CALL ORDER(IFORCE(NFORCE),KFORCE,MFORCE(1,NFORCE), + $ MEFORC(NFORCE)) + WRITE(ITLIS,*) IFORCE(NFORCE),(MFORCE(K,NFORCE),K=1,5) + ID=IFORCE(NFORCE) + IDABS=IABS(ID) + IF(IDABS.LT.6) THEN + WRITE(ITLIS,2005) + IFL=15 + ENDIF + IDB=IDANTI(ID) + IF(IDB.NE.ID) THEN + IFORCE(NFORCE+1)=IDB + DO 352 K=1,5 + 352 MFORCE(K,NFORCE+1)=IDANTI(MFORCE(K,NFORCE)) + NFORCE=NFORCE+1 + ENDIF + LOC(35)=NSEL + GO TO 100 + ENDIF +C +C Keyword FORCE1 + IF(WORD.EQ.'FORCE1 ') THEN + NFORCE=NFORCE+1 + IF(NFORCE.GT.MXFORC) THEN + WRITE(ITLIS,2004) + IFL=14 + ENDIF + DO 353 K=1,5 +353 KFORCE(K)=0 + READ(ITCOM,*) IFORCE(NFORCE),(KFORCE(K),K=1,5) + CALL ORDER(IFORCE(NFORCE),KFORCE,MFORCE(1,NFORCE), + $ MEFORC(NFORCE)) + WRITE(ITLIS,*) IFORCE(NFORCE),(MFORCE(K,NFORCE),K=1,5) + IF(IABS(IFORCE(NFORCE)).LT.6) THEN + WRITE(ITLIS,2005) + IFL=15 + ENDIF + LOC(35)=NSEL + GO TO 100 + ENDIF +C +C Keyword HMASSES - also see HMASS + IF(WORD.EQ.'HMASSES ') THEN + CALL FLAVOR(80,I1,I2,I3,J1,INDEX) + READ(ITCOM,*) (AMLEP(INDEX+K),K=1,9) + WRITE(ITLIS,*) (AMLEP(INDEX+K),K=1,9) + LOC(36)=NSEL + GO TO 100 + ENDIF +C +C Keywords WMODE1,WMODE2 + IF(WORD.EQ.'WMODE1 '.OR.WORD.EQ.'WMODE2 ') THEN + IF(WORD.EQ.'WMODE1 ') IJ=1 + IF(WORD.EQ.'WMODE2 ') IJ=2 + READ(ITCOM,*) (WWTYP(K,IJ),K=1,25) + DO 372 K=1,25 +372 IF(WWTYP(K,IJ).NE.BLANK) NWWTYP(IJ)=NWWTYP(IJ)+1 + WRITE(ITLIS,*) (WWTYP(K,IJ),K=1,NWWTYP(IJ)) + LOC(37)=NSEL + GO TO 100 + ENDIF +C +C Keyword NOEVOLVE + IF(WORD.EQ.'NOEVOLVE') THEN + READ (ITCOM,571) NOEVOL + WRITE(ITLIS,572) NOEVOL + LOC(38)=NSEL + GO TO 100 + ENDIF +C +C Keyword NOHADRON + IF(WORD.EQ.'NOHADRON') THEN + READ (ITCOM,571) NOHADR + WRITE(ITLIS,572) NOHADR + LOC(39)=NSEL + GO TO 100 + ENDIF +C +C Keyword GAUGINO + IF(WORD.EQ.'GAUGINO ') THEN + CALL FLAVOR(29,I1,I2,I3,J1,IDG1) + CALL FLAVOR(30,I1,I2,I3,J1,IDG2) + CALL FLAVOR(39,I1,I2,I3,J1,IDG3) + CALL FLAVOR(40,I1,I2,I3,J1,IDG4) + READ(ITCOM,*) AMLEP(IDG1),AMLEP(IDG2),AMLEP(IDG3),AMLEP(IDG4) + WRITE(ITLIS,*) AMLEP(IDG1),AMLEP(IDG2),AMLEP(IDG3),AMLEP(IDG4) + LOC(40)=NSEL + GO TO 100 + ENDIF +C +C Keyword SQUARK + IF(WORD.EQ.'SQUARK ') THEN + CALL FLAVOR(21,I1,I2,I3,J1,IDXQKL) + READ(ITCOM,*) (AMLEP(IDXQKL+K-1),K=1,6) + WRITE(ITLIS,*) (AMLEP(IDXQKL+K-1),K=1,6) + CALL FLAVOR(41,I1,I2,I3,J1,IDXQKR) + DO 411 K=1,6 + AMLEP(IDXQKR+K-1)=AMLEP(IDXQKL+K-1) +411 CONTINUE + LOC(41)=NSEL + GO TO 100 + ENDIF +C +C Keyword SLEPTON + IF(WORD.EQ.'SLEPTON ') THEN + CALL FLAVOR(31,I1,I2,I3,J1,IDXLEP) + READ(ITCOM,*) (AMLEP(IDXLEP+K-1),K=1,6) + WRITE(ITLIS,*) (AMLEP(IDXLEP+K-1),K=1,6) + LOC(42)=NSEL + GO TO 100 + ENDIF +C +C Keyword NSIGMA + IF(WORD.EQ.'NSIGMA ') THEN + READ(ITCOM,*) NSIGMA + WRITE(ITLIS,*) NSIGMA + LOC(43)=NSEL + GO TO 100 + ENDIF +C +C Keyword XGENSS + IF(WORD.EQ.'XGENSS ') THEN + READ(ITCOM,*) XGENSS(9),(XGENSS(KK),KK=1,8) + WRITE(ITLIS,*) XGENSS(9),(XGENSS(KK),KK=1,8) + LOC(44)=NSEL + GO TO 100 + ENDIF +C +C Keyword HMASS - just standard Higgs + IF(WORD.EQ.'HMASS ') THEN + CALL FLAVOR(81,I1,I2,I3,J1,INDEX) + READ(ITCOM,*) AMLEP(INDEX) + WRITE(ITLIS,*) AMLEP(INDEX) + LOC(45)=NSEL + GO TO 100 + ENDIF +C +C Keywords WPMODE, WMMODE, Z0MODE + IF(WORD.EQ.'WPMODE '.OR.WORD.EQ.'WMMODE ' + $.OR.WORD.EQ.'Z0MODE ') THEN + IF(WORD.EQ.'WPMODE ') IJ=1 + IF(WORD.EQ.'WMMODE ') IJ=2 + IF(WORD.EQ.'Z0MODE ') IJ=3 + READ(ITCOM,*) (WMODES(K,IJ),K=1,25) + DO 463 K=1,25 +463 IF(WMODES(K,IJ).NE.BLANK) NWMODE(IJ)=NWMODE(IJ)+1 + WRITE(ITLIS,*) (WMODES(K,IJ),K=1,NWMODE(IJ)) + LOC(46)=NSEL + GO TO 100 + ENDIF +C +C Keyword WMASS + IF(WORD.EQ.'WMASS ') THEN + READ(ITCOM,*) AMW,AMZ + WRITE(ITLIS,*) AMW,AMZ + WMASS(1)=0. + WMASS(2)=AMW + WMASS(3)=AMW + WMASS(4)=AMZ + CALL FLAVOR(80,I1,I2,I3,J,INDEX) + AMLEP(INDEX)=AMW + CALL FLAVOR(90,I1,I2,I3,J,INDEX) + AMLEP(INDEX)=AMZ + LOC(47)=NSEL + GO TO 100 + ENDIF +C +C Keyword NEVOLVE + IF(WORD.EQ.'NEVOLVE ') THEN + READ(ITCOM,*) NEVOLV + WRITE(ITLIS,*) NEVOLV + LOC(48)=NSEL + GO TO 100 + ENDIF +C +C Keyword NHADRON + IF(WORD.EQ.'NHADRON ') THEN + READ(ITCOM,*) NFRGMN + WRITE(ITLIS,*) NFRGMN + LOC(49)=NSEL + GO TO 100 + ENDIF +C +C Keyword TCMASS + IF(WORD.EQ.'TCMASS ') THEN + READ(ITCOM,*) TCMRHO,TCGRHO + WRITE(ITLIS,*) TCMRHO,TCGRHO + LOC(50)=NSEL + GO TO 100 + ENDIF +C +C Keyword MSSMA: gluino, mu, mha, tanb + IF(WORD.EQ.'MSSMA ') THEN + READ(ITCOM,*) XGLSS,XMUSS,XHASS,XTBSS + WRITE(ITLIS,*) XGLSS,XMUSS,XHASS,XTBSS + GOMSSM=.TRUE. + LOC(51)=NSEL + GO TO 100 + ENDIF +C +C Keyword MSSMB: 1st generation soft terms + IF(WORD.EQ.'MSSMB ') THEN + READ(ITCOM,*) XQ1SS,XDRSS,XURSS,XL1SS,XERSS + WRITE(ITLIS,*) XQ1SS,XDRSS,XURSS,XL1SS,XERSS + LOC(52)=NSEL + GOMSSM=.TRUE. + GO TO 100 + ENDIF +C +C Keyword MSSMC: 3rd generation soft terms + IF(WORD.EQ.'MSSMC ') THEN + READ(ITCOM,*)XQ3SS,XBRSS,XTRSS,XL3SS,XTARSS,XATSS,XABSS,XATASS + WRITE(ITLIS,*)XQ3SS,XBRSS,XTRSS,XL3SS,XTARSS,XATSS,XABSS,XATASS + LOC(53)=NSEL + GOMSSM=.TRUE. + GO TO 100 + ENDIF +C +C Keyword PDFLIB: parameters for PDFLIB +#if defined(CERNLIB_PDFLIB) + IF(WORD.EQ.'PDFLIB ') THEN + DO 541 I=1,20 + PDFPAR(I)=' ' + PDFVAL(I)=0 +541 CONTINUE + READ(ITCOM,*) (PDFPAR(I),PDFVAL(I),I=1,20) + DO 542 I=1,20 + IF(PDFPAR(I).NE.' ') THEN + WRITE(ITLIS,*) PDFPAR(I),PDFVAL(I) + ENDIF +542 CONTINUE + ISTRUC=-999 + LOC(54)=NSEL + GO TO 100 + ENDIF +#endif +C +C Keyword SUGRA + IF(WORD.EQ.'SUGRA ') THEN + READ(ITCOM,*) XM0SU,XMHSU,XA0SU,XTGBSU,XSMUSU + WRITE(ITLIS,*) XM0SU,XMHSU,XA0SU,XTGBSU,XSMUSU + LOC(55)=NSEL + GOMSSM=.TRUE. + GOSUG=.TRUE. + GO TO 100 + ENDIF +C +C Keyword HTYPE + IF(WORD.EQ.'HTYPE ') THEN + READ(ITCOM,*) HTYPE + WRITE(ITLIS,*) HTYPE + LOC(56)=NSEL + IHTYPE=0 + IF(HTYPE.EQ.'HL0 ') IHTYPE=82 + IF(HTYPE.EQ.'HH0 ') IHTYPE=83 + IF(HTYPE.EQ.'HA0 ') IHTYPE=84 + IF(IHTYPE.EQ.0) THEN + WRITE(ITLIS,2000) HTYPE + IFL=16 + ENDIF + GO TO 100 + ENDIF +C +C Keyword EPOL + IF(WORD.EQ.'EPOL ') THEN + READ(ITCOM,*) PLEM,PLEP + WRITE(ITLIS,*) PLEM,PLEP + LOC(57)=NSEL + GO TO 100 + ENDIF +C +C Keyword MSSMD: optional 2nd geenration soft terms + IF(WORD.EQ.'MSSMD ') THEN + READ(ITCOM,*) XQ2SS,XSRSS,XCRSS,XL2SS,XMRSS + WRITE(ITLIS,*) XQ2SS,XSRSS,XCRSS,XL2SS,XMRSS + LOC(58)=NSEL + GO TO 100 + ENDIF +C +C Keyword MSSME: optional U(1) and SU(2) gaugino masses + IF(WORD.EQ.'MSSME ') THEN + READ(ITCOM,*) XM1SS,XM2SS + WRITE(ITLIS,*) XM1SS,XM2SS + LOC(59)=NSEL + GO TO 100 + ENDIF +C +C Keyword GMSB: gauge-mediated SUSY breaking model + IF(WORD.EQ.'GMSB ') THEN + READ(ITCOM,*) XLAMGM,XMESGM,XN5GM,XTGBSU,XSMUSU,XCMGV + WRITE(ITLIS,*) XLAMGM,XMESGM,XN5GM,XTGBSU,XSMUSU,XCMGV + GOMSSM=.TRUE. + GOGMSB=.TRUE. + LOC(60)=NSEL + GO TO 100 + ENDIF +C +C Keyword NUSUG1: optional GUT scale gaugino masses + IF(WORD.EQ.'NUSUG1 ') THEN + READ(ITCOM,*) XNUSUG(1),XNUSUG(2),XNUSUG(3) + WRITE(ITLIS,*) XNUSUG(1),XNUSUG(2),XNUSUG(3) + LOC(61)=NSEL + GO TO 100 + ENDIF +C +C Keyword NUSUG2: optional GUT scale A terms + IF(WORD.EQ.'NUSUG2 ') THEN + READ(ITCOM,*) XNUSUG(6),XNUSUG(5),XNUSUG(4) + WRITE(ITLIS,*) XNUSUG(6),XNUSUG(5),XNUSUG(4) + LOC(62)=NSEL + GO TO 100 + ENDIF +C +C Keyword NUSUG3: optional GUT scale Higgs masses + IF(WORD.EQ.'NUSUG3 ') THEN + READ(ITCOM,*) XNUSUG(7),XNUSUG(8) + WRITE(ITLIS,*) XNUSUG(7),XNUSUG(8) + LOC(63)=NSEL + GO TO 100 + ENDIF +C +C Keyword NUSUG4: optional GUT scale 1st/2nd gen. masses + IF(WORD.EQ.'NUSUG4 ') THEN + READ(ITCOM,*) XNUSUG(13),XNUSUG(11),XNUSUG(12),XNUSUG(10) + $,XNUSUG(9) + WRITE(ITLIS,*) XNUSUG(13),XNUSUG(11),XNUSUG(12),XNUSUG(10) + $,XNUSUG(9) + LOC(64)=NSEL + GO TO 100 + ENDIF +C +C Keyword NUSUG5: optional GUT scale 3rd gen. masses + IF(WORD.EQ.'NUSUG5 ') THEN + READ(ITCOM,*) XNUSUG(18),XNUSUG(16),XNUSUG(17),XNUSUG(15) + $,XNUSUG(14) + WRITE(ITLIS,*) XNUSUG(18),XNUSUG(16),XNUSUG(17),XNUSUG(15) + $,XNUSUG(14) + LOC(65)=NSEL + GO TO 100 + ENDIF +C +C Keyword NOGRAV: No gravitino decays + IF(WORD.EQ.'NOGRAV ') THEN + READ(ITCOM,571) NOGRAV + WRITE(ITLIS,572) NOGRAV + LOC(66)=NSEL + GO TO 100 + ENDIF +C +C Keyword MGVTNO: Sets the gravitino mass + IF(WORD.EQ.'MGVTNO ') THEN + READ(ITCOM,*) XMGVTO + WRITE(ITLIS,*) XMGVTO + LOC(67)=NSEL + GO TO 100 + ENDIF +C +C Keyword AL3UNI: Impose alpha_s unification at M_GUT + IF(WORD.EQ.'AL3UNI ') THEN + READ(ITCOM,571) AL3UNI + WRITE(ITLIS,572) AL3UNI + LOC(68)=NSEL + GO TO 100 + ENDIF +C +C Keyword GMSB2: additional GMSB parameters + IF(WORD.EQ.'GMSB2 ') THEN + READ(ITCOM,*) XRSLGM,XDHDGM,XDHUGM,XDYGM,XN51GM,XN52GM,XN53GM + WRITE(ITLIS,*) XRSLGM,XDHDGM,XDHUGM,XDYGM,XN51GM,XN52GM,XN53GM + LOC(69)=NSEL + GO TO 100 + ENDIF +C +C Keyword EEBREM: invoke bremsstrahlung in e+e- reactions + IF(WORD.EQ.'EEBREM ') THEN + READ(ITCOM,*) RSHMIN,RSHMAX + WRITE(ITLIS,*) RSHMIN,RSHMAX + IBREM=.TRUE. + LOC(70)=NSEL + GO TO 100 + ENDIF +C +C Keyword EEBEAM: invoke beamstrahlung in e+e- reactions + IF(WORD.EQ.'EEBEAM ') THEN + READ(ITCOM,*) RSHMIN,RSHMAX,UPSLON,SIGZ + WRITE(ITLIS,*) RSHMIN,RSHMAX,UPSLON,SIGZ + IBREM=.TRUE. + IBEAM=.TRUE. + LOC(71)=NSEL + GO TO 100 + ENDIF +C +C Keyword QMKKG (QMW for EXTRADIM) + IF(WORD.EQ.'QMKKG ') THEN + READ(ITCOM,*) QMIN,QMAX + WRITE(ITLIS,*) QMIN,QMAX + LOC(19)=NSEL + GO TO 100 + ENDIF +C +C Keyword QTKKG (QTW for EXTRADIM) + IF(WORD.EQ.'QTKKG ') THEN + READ(ITCOM,*) QTMIN,QTMAX + WRITE(ITLIS,*) QTMIN,QTMAX + LOC(20)=NSEL + GO TO 100 + ENDIF +C +C Keyword EXTRAD for EXTRADIM + IF(WORD.EQ.'EXTRAD ') THEN + READ(ITCOM,*) NEXTRAD,MASSD,UVCUT + WRITE(ITLIS,*) NEXTRAD,MASSD,UVCUT + LOC(72)=NSEL + GO TO 100 + ENDIF +C +C Keyword MIJLIM + IF(WORD.EQ.'MIJLIM ') THEN + READ(ITCOM,*) JLIM1,JLIM2,AMLIM1,AMLIM2 + WRITE(ITLIS,*) JLIM1,JLIM2,AMLIM1,AMLIM2 + IF(JLIM1.EQ.0.AND.JLIM2.EQ.0) THEN + DO 720 I=1,NJET + DO 721 J=1,NJET + AMIJMN(I,J)=AMLIM1 + AMIJMX(I,J)=AMLIM2 +721 CONTINUE +720 CONTINUE + ELSEIF(JLIM1.GT.0.AND.JLIM1.LE.NJET.AND.JLIM2.GT.0.AND. + $ JLIM2.LE.NJET) THEN + AMIJMN(JLIM1,JLIM2)=AMLIM1 + AMIJMN(JLIM2,JLIM1)=AMLIM1 + AMIJMX(JLIM1,JLIM2)=AMLIM2 + AMIJMX(JLIM2,JLIM1)=AMLIM2 + ELSE + WRITE(ITLIS,2008) + IFL=73 + ENDIF + LOC(73)=NSEL + GO TO 100 + ENDIF +C +C Keyword MTOT + IF(WORD.EQ.'MTOT ') THEN + READ(ITCOM,*) EHMGMN,EHMGMX + WRITE(ITLIS,*) EHMGMN,EHMGMX + LOC(74)=NSEL + GO TO 100 + ENDIF +C +C Keyword SUGRHN + IF(WORD.EQ.'SUGRHN ') THEN + READ(ITCOM,*) XMN3NR,XMAJNR,XANSS,XNRSS + WRITE(ITLIS,*) XMN3NR,XMAJNR,XANSS,XNRSS + LOC(75)=NSEL + GO TO 100 + ENDIF +C +C Keyword AMSB + IF(WORD.EQ.'AMSB ') THEN + READ(ITCOM,*) XM0SU,XMHSU,XTGBSU,XSMUSU + WRITE(ITLIS,*) XM0SU,XMHSU,XTGBSU,XSMUSU + LOC(76)=NSEL + GOMSSM=.TRUE. + GOSUG=.TRUE. + GOAMSB=.TRUE. + GO TO 100 + ENDIF +C +C Keyword SSBCSC + IF(WORD.EQ.'SSBCSC ') THEN + READ(ITCOM,*) XSBCS + WRITE(ITLIS,*) XSBCS + LOC(77)=NSEL + GO TO 100 + ENDIF +C +C None of the above +C + WRITE(ITLIS,2000) WORD + IFL=10 + RETURN +C +C Error message or warnings +C + 1001 FORMAT(//2X,'YOU HAVE GIVEN LIMITS FOR AN OVERLAPPING SET', + $ ' OF VARIABLES. SET MINIMIZING PPERP INTERVAL WILL BE USED.') + 1999 FORMAT(//' YOU FORGOT TO SELECT A PROCESS FOR GENERATION.' + $ /' AVAILABLE AT PRESENT ARE ', + $ /' TWOJET E+E- DRELLYAN MINBIAS WPAIR SUPERSYM,' + $ /' HIGGS PHOTON TCOLOR') + 2000 FORMAT(//2X,A8,' IS NOT A RECOGNIZABLE PARAMETER. JOB TERMINATED') + 2001 FORMAT(//2X,' YOU CANNOT GIVE LIMITS FOR BOTH THETA AND Y.', + $ ' MAKE UP YOUR MIND. JOB TERMINATED.') + 2002 FORMAT(/' WHAT IS THAT SUPPOSED TO BE') + 2003 FORMAT(/' YOU CANNOT RUN WS AND Z0 OR GAMMAS AT THE', + $ ' SAME TIME. JOB TERMINATED') + 2004 FORMAT(//' PARAMETER OUT OF RANGE. JOB TERMINATED.') + 2005 FORMAT(//' YOU CANNOT FORCE DECAY OF A QUARK, YOU MUST CHOSE ' + $,' A PARTICLE') + 2006 FORMAT(//2X,' INVALID JETTYPE VALUES. JOB TERMINATED.') + 2007 FORMAT(//2X,'YOU CANNOT USE MSSM AND SUGRA SIMULTANEOUSLY') + 2008 FORMAT(//2X,'INVALID JET-JET MASS LIMITS. JOB TERMINATED.') +C + END diff --git a/ISAJET/code/rejfrg.F b/ISAJET/code/rejfrg.F new file mode 100644 index 00000000000..206be506a0a --- /dev/null +++ b/ISAJET/code/rejfrg.F @@ -0,0 +1,39 @@ +#include "isajet/pilot.h" + LOGICAL FUNCTION REJFRG() +C----------------------------------------------------------------------- +C- +C- This is called after FRGMNT for TWOJET and DRELLYAN events +C- to test the fragmentation. REJFRG=.FALSE. keeps the event. +C- +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/partcl.inc" + INTEGER I,ID + REAL PTL,CUTLEP,CUTNU + DATA CUTLEP/50./,CUTNU/100./ + REJFRG=.FALSE. +C*************************************** +C Sample REJFRG function which keeps the event if it contains +C any lepton satisfying +C PT > CUTLEP (charged lepton) +C PT > CUTNU (neutrino) +C Appropriate values of the cuts must be set by the user. +C REJFRG=.TRUE. +C DO 1 I=1,NPTCL +C IF(IDCAY(I).NE.0) GO TO 1 +C ID=IABS(IDENT(I)) +C IF(ID.LE.10.OR.ID.GE.20) GO TO 1 +C PTL=SQRT(PPTCL(1,I)**2+PPTCL(2,I)**2) +C IF((ID.EQ.11.OR.ID.EQ.13.OR.ID.EQ.15).AND.PTL.GT.CUTNU) THEN +C REJFRG=.FALSE. +C RETURN +C ELSEIF((ID.EQ.12..OR.ID.EQ.14).AND.PTL.GT.CUTLEP) THEN +C REJFRG=.FALSE. +C RETURN +C ENDIF +C 1 CONTINUE +C*************************************** + RETURN + END diff --git a/ISAJET/code/rejjet.F b/ISAJET/code/rejjet.F new file mode 100644 index 00000000000..b99134d3b7e --- /dev/null +++ b/ISAJET/code/rejjet.F @@ -0,0 +1,29 @@ +#include "isajet/pilot.h" + LOGICAL FUNCTION REJJET() +C----------------------------------------------------------------------- +C- +C- This is called after EVOLVE for TWOJET and DRELLYAN events +C- to test the partons (jets). REJJET=.FALSE. keeps the event. +C- +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/jetset.inc" + INTEGER I,IFLAV + REJJET=.FALSE. +C*************************************** +C Sample REJJET function which keeps the event if one of the +C outgoing partons is a heavy quark. +C REJJET=.TRUE. +C DO 1 I=1,NJSET +C IF(JDCAY(I).NE.0) GO TO 1 +C IFLAV=IABS(JTYPE(I)) +C IF(IFLAV.GE.4.AND.IFLAV.LT.9) THEN +C REJJET=.FALSE. +C RETURN +C ENDIF +C 1 CONTINUE +C*************************************** + RETURN + END diff --git a/ISAJET/code/rescal.F b/ISAJET/code/rescal.F new file mode 100644 index 00000000000..3b03fff199b --- /dev/null +++ b/ISAJET/code/rescal.F @@ -0,0 +1,62 @@ +#include "isajet/pilot.h" + SUBROUTINE RESCAL(N1,N2,PSUM,IFAIL) +C RESCALE MOMENTA OF PARTICLES N1...N2 TO GIVE TOTAL +C FOUR-MOMENTUM PSUM. +C RETURN IFAIL=0 IF OK, IFAIL=1 IF NO GOOD. +#include "isajet/itapes.inc" +#include "isajet/partcl.inc" + DIMENSION PSUM(5),PADD(5),BETA(3) + DATA ERRLIM/.0001/ +C ORIGIONAL MOMENTUM IS PADD. + IFAIL=1 + IF(N1.GE.N2) RETURN + DO 100 K=1,5 +100 PADD(K)=0. + DO 110 IP=N1,N2 + DO 110 K=1,5 + PADD(K)=PADD(K)+PPTCL(K,IP) +110 CONTINUE + IF(PADD(5).GE.PSUM(5)) RETURN + PADD(5)=PADD(4)**2-PADD(1)**2-PADD(2)**2-PADD(3)**2 + IF(PADD(5).LE.0) RETURN + PADD(5)=SQRT(PADD(5)) + DO 120 K=1,3 +120 BETA(K)=-PADD(K)/PADD(5) + GAMMA=PADD(4)/PADD(5) +C BOOST PARTICLES TO REST. +200 CONTINUE + DO 210 IP=N1,N2 + BP=0. + DO 220 K=1,3 +220 BP=BP+PPTCL(K,IP)*BETA(K) + DO 230 K=1,3 +230 PPTCL(K,IP)=PPTCL(K,IP)+BETA(K)*PPTCL(4,IP) + $+BETA(K)*BP/(GAMMA+1.) + PPTCL(4,IP)=GAMMA*PPTCL(4,IP)+BP +210 CONTINUE + IF(IFAIL.EQ.0) RETURN +C RESCALE MOMENTA IN REST FRAME. + SCAL=1. + DO 301 IPASS=1,200 + SUM=0. + DO 310 IP=N1,N2 + DO 320 K=1,3 +320 PPTCL(K,IP)=SCAL*PPTCL(K,IP) + PPTCL(4,IP)=SQRT(PPTCL(1,IP)**2+PPTCL(2,IP)**2+PPTCL(3,IP)**2 + $+PPTCL(5,IP)**2) + SUM=SUM+PPTCL(4,IP) +310 CONTINUE + SCAL=PSUM(5)/SUM +301 IF(ABS(SCAL-1.).LE.ERRLIM) GO TO 300 +300 CONTINUE +C BOOST BACK WITH PSUM. + BMAG=0. + DO 400 K=1,3 + BETA(K)=PSUM(K)/PSUM(5) + BMAG=BMAG+ABS(BETA(K)) +400 CONTINUE + GAMMA=PSUM(4)/PSUM(5) + IFAIL=0 + IF(BMAG.EQ.0.) RETURN + GO TO 200 + END diff --git a/ISAJET/code/reset.F b/ISAJET/code/reset.F new file mode 100644 index 00000000000..78a56694b30 --- /dev/null +++ b/ISAJET/code/reset.F @@ -0,0 +1,216 @@ +#include "isajet/pilot.h" + SUBROUTINE RESET +C RESET ALL USER DEFINED VARIABLES +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/qcdpar.inc" +#include "isajet/dylim.inc" +#include "isajet/frgpar.inc" +#include "isajet/hcon.inc" +#include "isajet/jetlim.inc" +#include "isajet/jetpar.inc" +#include "isajet/nodcay.inc" +#include "isajet/primar.inc" +#include "isajet/qlmass.inc" +#include "isajet/q1q2.inc" +#include "isajet/seed.inc" +#include "isajet/sspar.inc" +#include "isajet/tcpar.inc" +#include "isajet/types.inc" +#include "isajet/wcon.inc" +#include "isajet/force.inc" +#include "isajet/mbgen.inc" +#include "isajet/isloop.inc" +#include "isajet/limevl.inc" +#include "isajet/xmssm.inc" +#include "isajet/eepar.inc" +#include "isajet/mglims.inc" +C + INTEGER I,I1,I2,I3,J1,INDEX,J,K + REAL UNDEF,AMASS + CHARACTER*8 BLANK + DATA BLANK/' '/ + DATA UNDEF/-1.E9/ +C RESET DYLIM + DO 110 I=1,12 + BLIM1(I)=UNDEF + SETLMQ(I)=.TRUE. +110 CONTINUE +C RESET FRGPAR + PUD=.43 + PBARY=.10 + SIGQT=.35 + PEND=.14 + XGEN(1)=.96 + XGEN(2)=3. + XGEN(3)=0. + XGEN(4)=.8 + XGEN(5)=.5 + XGEN(6)=.5 + XGEN(7)=.5 + XGEN(8)=.5 + DO 111 K=1,9 +111 XGENSS(K)=.5 + PSPIN1(1)=.5 + PSPIN1(2)=.5 + PSPIN1(3)=.5 + PSPIN1(4)=.75 + PSPIN1(5)=.75 + PSPIN1(6)=.75 + PSPIN1(7)=.75 + PSPIN1(8)=.75 + PMIXX1(1)=.25 + PMIXX1(2)=.25 + PMIXX1(3)=.5 + PMIXX1(4)=0. + PMIXX1(5)=.5 + PMIXX1(6)=1. + PMIXX2(1)=.5 + PMIXX2(2)=.5 + PMIXX2(3)=1. + PMIXX2(4)=0. + PMIXX2(5)=0. + PMIXX2(6)=1. +C RESET ISLOOP + NEVOLV=1 + NFRGMN=1 +C RESET JETLIM + DO 120 I=1,12*MXLIM + BLIMS(I)=UNDEF + SETLMJ(I)=.TRUE. +120 CONTINUE +C RESET NODCAY + NODCAY=.FALSE. + NOETA=.FALSE. + NOPI0=.FALSE. + NONUNU=.FALSE. + NOEVOL=.FALSE. + NOHADR=.FALSE. + NOGRAV=.FALSE. +C RESET PRIMAR + IDIN(1)=1120 + IDIN(2)=1120 + NTRIES=1000 + NSIGMA=20 +C RESET QCDPAR + ALAM=.2 + ALAM2=ALAM**2 + CUTJET=6. + ISTRUC=6 +C RESET QLMASS + AMLEP(6)=175. + AMLEP(7)=-1. + AMLEP(8)=-1. + DO 125 I=1,9 + CALL FLAVOR(80+I,I1,I2,I3,J1,INDEX) +125 AMLEP(INDEX)=0. + CALL FLAVOR(29,I1,I2,I3,J1,INDEX) + AMLEP(INDEX)=100. + CALL FLAVOR(30,I1,I2,I3,J1,INDEX) + AMLEP(INDEX)=0. + CALL FLAVOR(39,I1,I2,I3,J1,INDEX) + AMLEP(INDEX)=100. + CALL FLAVOR(40,I1,I2,I3,J1,INDEX) + AMLEP(INDEX)=100. + DO 126 I=1,6 + CALL FLAVOR(20+I,I1,I2,I3,J1,INDEX) + AMLEP(INDEX)=100.+AMASS(I) + CALL FLAVOR(30+I,I1,I2,I3,J1,INDEX) + AMLEP(INDEX)=100.+AMASS(I+10) +126 CONTINUE +C RESET Q1Q2 + DO 130 I=1,MXGOQ + DO 130 J=1,MXGOJ +130 GOQ(I,J)=.TRUE. + DO 131 I=1,MXGOJ +131 GOALL(I)=.TRUE. + GODY(1)=.TRUE. + GODY(2)=.FALSE. + GODY(3)=.FALSE. + GODY(4)=.TRUE. + DO 132 I=1,2 + ALLWW(I)=.TRUE. + DO 132 J=1,25 +132 GOWW(J,I)=.TRUE. + DO 133 I=1,3 + DO 133 J=1,25 +133 GOWMOD(J,I)=.TRUE. +C RESET TCPAR + TCMRHO=1000. + TCGRHO=100. +C RESET TYPES + DO 140 I=1,NTYP +140 LOC(I)=0 + DO 141 I=1,MXTYPE + NJTTYP(I)=0 + JETYP(1,I)='ALL ' + DO 141 K=2,30 +141 JETYP(K,I)=BLANK + JWTYP=4 + DO 142 I=1,2 + NWWTYP(I)=0 + WWTYP(1,I)='ALL ' + DO 142 K=2,4 +142 WWTYP(K,I)=BLANK + DO 143 I=1,3 + NWMODE(I)=0 + WMODES(1,I)='ALL ' + DO 143 K=2,30 +143 WMODES(K,I)=BLANK +C RESET WCON + SIN2W=.232 + WMASS(2)=80.2 + WMASS(3)=WMASS(2) + WMASS(4)=91.19 + CALL FLAVOR(80,I1,I2,I3,J,INDEX) + AMLEP(INDEX)=WMASS(2) + CALL FLAVOR(90,I1,I2,I3,J,INDEX) + AMLEP(INDEX)=WMASS(4) + CUTOFF=.200 + CUTPOW=1.0 + WFUDGE=1.75 +C RESET MBGEN + MNPOM=1 + MXPOM=LIMPOM +C RESET FORCE + NFORCE=0 +C +C RESET QCD EVOLUTION CUTS + USELIM=.FALSE. + CONCUT=1.0 +C +C RESET SSPAR + AMGVSS=1.E20 +C +C RESET XMSSM + GOMSSM=.FALSE. + GOSUG=.FALSE. + GOAMSB=.FALSE. + XM1SS=1.E20 + XM2SS=1.E20 + XMAJNR=1.E20 + XMGVTO=1.E20 +C +C RESET HCON + IHTYPE=0 +C +C RESET EEPAR + PLEP=0. + PLEM=0. +C +C RESET MGLIMS + EHMGMN=-1.E9 + EHMGMX=-1.E9 + YHMGMN=-1.E9 + YHMGMX=-1.E9 + DO 150 I=1,MXLIM + DO 151 J=1,MXLIM + AMIJMN(I,J)=-1.E9 + AMIJMX(I,J)=-1.E9 +151 CONTINUE +150 CONTINUE +C + RETURN + END diff --git a/ISAJET/code/setcon.F b/ISAJET/code/setcon.F new file mode 100644 index 00000000000..1006941b00a --- /dev/null +++ b/ISAJET/code/setcon.F @@ -0,0 +1,12 @@ +#include "isajet/pilot.h" + SUBROUTINE SETCON +C THIS SUBROUTINE SETS THE CONSTANTS IN /CONST/. +#include "isajet/itapes.inc" +#include "isajet/const.inc" + PI=4.*ATAN(1.) + SQRT2=SQRT(2.) + ALFA=1./137.036 + GF=1.16570E-5 + UNITS=1./2.56815 + RETURN + END diff --git a/ISAJET/code/setdky.F b/ISAJET/code/setdky.F new file mode 100644 index 00000000000..66daeb53ab6 --- /dev/null +++ b/ISAJET/code/setdky.F @@ -0,0 +1,305 @@ +#include "isajet/pilot.h" + SUBROUTINE SETDKY(LPRINT) +C +C Read in decay table from tape ITDKY and set up /DKYTAB/. +C Then append forced decay modes and set LOOK to negative +C number pointing to LOOK2, which points to table. +C Forced decays for antiparticles are stored in conjugated +C form so that DECAY can always conjugate them. +C +C Logical flag LPRINT controls printing of table. +C +C Ver 7.41: Check version of decay table. Also read matrix +C element flags and save in MELEM: +C MELEM=0: Phase space +C MELEM=1: Dalitz decay +C MELEM=2: omega/phi decay +C MELEM=3: V-A +C MELEM=4: V-A plus W propagator (for top) +C MELEM=5: tau -> ell nu nu +C MELEM=6: tau -> nu pi/K +C MELEM=7: tau -> nu rho/a1 +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/force.inc" +#include "isajet/dkytab.inc" +#include "isajet/nodcay.inc" +#include "isajet/ssmode.inc" +#include "isajet/sstype.inc" +#include "isajet/xmssm.inc" +#include "isajet/keys.inc" +C + INTEGER IMODE(6),LOOP,IOLD,I,IRES,ITYPE,K,J,IPOINT + INTEGER IFL1,IFL2,IFL3,JSPIN,INDEX,ID1,IDANTI,KTYPE,IRES2 + REAL BR + CHARACTER*8 LABEL,LMODE(6),LRES + CHARACTER*8 IBLANK,LREAD(10),IQUIT + LOGICAL LPRINT + INTEGER NOUT,NTHAD + PARAMETER (NOUT=33) + PARAMETER (NTHAD=12) + INTEGER IDOUT(NOUT),ITHAD(NTHAD),IDUMMY(5),MEOUT + REAL SUMBR,SUMBR2,SUMGAM + CHARACTER*40,V,VOLD,VISAJE +C + DATA IDOUT/ + $IDTP,ISGL,ISUPL,ISDNL,ISSTL,ISCHL,ISBT1,ISTP1,ISUPR,ISDNR, + $ISSTR,ISCHR,ISBT2,ISTP2,ISEL,ISMUL,ISTAU1,ISNEL,ISNML,ISNTL, + $ISER,ISMUR,ISTAU2,ISZ1,ISZ2,ISZ3,ISZ4,ISW1,ISW2, + $ISHL,ISHH,ISHA,ISHC/ + DATA IQUIT/'////'/,IBLANK/' '/ + DATA ITHAD/-160,-260,-360, + $ 1160,1260,2260,2160,1360,2360,3160,3260,3360/ +C +C Print header for table. +C + IF(LPRINT) WRITE(ITLIS,10) +10 FORMAT('1',30('*')/' *',28X,'*'/ + 1' *',5X,'ISAJET DECAY TABLE',5X,'*'/ + 2' *',28X,'*'/' ',30('*')// + 33X,'PART',16X,'DECAY MODE',16X,'CUM BR',10X,'IDENT',18X, + 4'DECAY IDENT'/) +C +C Initialize. LOOP is the decay mode counter. +C + LOOP=0 + IOLD=0 + DO 100 I=1,MXLOOK + LOOK(I)=0 +100 CONTINUE + DO 110 I=1,MXFORC + LOOK2(1,I)=0 + LOOK2(2,I)=0 +110 CONTINUE +C +C Read in table, checking for valid version. +C + IF(NODCAY.OR.ITDKY.EQ.0) RETURN + REWIND ITDKY +C + VOLD=VISAJE() + READ(ITDKY,*) V + IF(V.NE.VOLD) THEN + WRITE(ITLIS,2000) V,VOLD +2000 FORMAT(// + $ ' ***WARNING: DECAY TABLE DOES NOT MATCH ISAJET VERSION'/ + $ ' ***DECAY VERSION : ',A40/ + $ ' ***PROGRAM VERSION: ',A40) + ENDIF +C +200 LOOP=LOOP+1 + IF(LOOP.GT.MXDKY) GO TO 9999 +220 DO 210 I=1,5 + IMODE(I)=0 + LMODE(I)=IBLANK +210 CONTINUE + READ(ITDKY,*) IRES,ITYPE,BR,IMODE +C + IF(IRES.NE.0) THEN + IF(NOPI0.AND.IRES.EQ.110) GO TO 220 + IF(NOETA.AND.IRES.EQ.220) GO TO 220 + IF(IRES.NE.IOLD) THEN + CALL FLAVOR(IRES,IFL1,IFL2,IFL3,JSPIN,INDEX) + LOOK(INDEX)=LOOP + ENDIF + IOLD=IRES + CBR(LOOP)=BR + MELEM(LOOP)=ITYPE + DO 240 I=1,5 + MODE(I,LOOP)=IMODE(I) + IF(IMODE(I).NE.0) LMODE(I)=LABEL(IMODE(I)) +240 CONTINUE + LRES=LABEL(IRES) + IF(LPRINT) WRITE(ITLIS,20) LRES,(LMODE(K),K=1,5), + 1 BR,IRES,(IMODE(K),K=1,5) +20 FORMAT(3X,A5,4X,5(A5,2X),F8.5,10X,I5,4X,5(I7,2X)) + GO TO 200 + ENDIF +C +C Add HIGGS FOR WHIGGS +C + IF(KEYS(10).AND..NOT.GOMSSM) THEN + SUMGAM=0 + SUMBR=0 + DO 244 J=1,NSSMOD + IF(ISSMOD(J).EQ.81.AND.GSSMOD(J).GT.0) THEN + SUMGAM=SUMGAM+GSSMOD(J) + ENDIF +244 CONTINUE + DO 245 J=1,NSSMOD + IF(ISSMOD(J).EQ.81.AND.GSSMOD(J).GT.0) THEN + BSSMOD(J)=GSSMOD(J)/SUMGAM + ENDIF +245 CONTINUE + DO 246 J=1,NSSMOD + IF(ISSMOD(J).EQ.81.AND.BSSMOD(J).GT.0) THEN + SUMBR=SUMBR+BSSMOD(J) + ENDIF +246 CONTINUE +C If modes exist, add them + IF(SUMBR.LE.0) GO TO 249 + IRES=81 + LRES=LABEL(IRES) + CALL FLAVOR(IRES,IFL1,IFL2,IFL3,JSPIN,INDEX) + LOOK(INDEX)=LOOP+1 + SUMBR2=0 + DO 247 J=1,NSSMOD + IF(ISSMOD(J).EQ.81.AND.BSSMOD(J).GT.0) THEN + LOOP=LOOP+1 + SUMBR2=SUMBR2+BSSMOD(J) + BR=SUMBR2/SUMBR + CBR(LOOP)=BR + MELEM(LOOP)=0 + DO 248 K=1,5 + MODE(K,LOOP)=JSSMOD(K,J) + LMODE(K)=LABEL(MODE(K,LOOP)) +248 CONTINUE + IF(LPRINT) WRITE(ITLIS,20) LRES,(LMODE(K),K=1,5), + $ BR,IRES,(MODE(K,LOOP),K=1,5) + ENDIF +247 CONTINUE +249 CONTINUE + END IF +C +C Add MSSM decay modes if applicable, OR H_SM FOR WHIGGS +C + IF(GOMSSM) THEN + DO 250 I=1,NOUT +C Check for modes + SUMBR=0 + DO 251 J=1,NSSMOD + IF(ISSMOD(J).EQ.IDOUT(I).AND.BSSMOD(J).GT.0) THEN + SUMBR=SUMBR+BSSMOD(J) + ENDIF +251 CONTINUE +C If modes exist, add them + IF(SUMBR.LE.0) GO TO 250 + IRES=IDOUT(I) + LRES=LABEL(IRES) + CALL FLAVOR(IRES,IFL1,IFL2,IFL3,JSPIN,INDEX) + LOOK(INDEX)=LOOP+1 + SUMBR2=0 + DO 252 J=1,NSSMOD + IF(ISSMOD(J).EQ.IDOUT(I).AND.BSSMOD(J).GT.0) THEN + LOOP=LOOP+1 + SUMBR2=SUMBR2+BSSMOD(J) + BR=SUMBR2/SUMBR + CBR(LOOP)=BR + MELEM(LOOP)=MSSMOD(J) + DO 253 K=1,5 + MODE(K,LOOP)=JSSMOD(K,J) + LMODE(K)=LABEL(MODE(K,LOOP)) +253 CONTINUE + IF(LPRINT) WRITE(ITLIS,20) LRES,(LMODE(K),K=1,5), + $ BR,IRES,(MODE(K,LOOP),K=1,5) + ENDIF +252 CONTINUE +250 CONTINUE +C +C Top hadron decays +C + DO 260 I=1,NTHAD +C Check for modes + SUMBR=0 + DO 261 J=1,NSSMOD + IF(ISSMOD(J).EQ.6.AND.BSSMOD(J).GT.0) THEN + SUMBR=SUMBR+BSSMOD(J) + ENDIF +261 CONTINUE +C If modes exist, add them -- conjugate for antimesons + IF(SUMBR.LE.0) GO TO 260 + IRES=IABS(ITHAD(I)) + LRES=LABEL(IRES) + CALL FLAVOR(IRES,IFL1,IFL2,IFL3,JSPIN,INDEX) + LOOK(INDEX)=LOOP+1 + SUMBR2=0 + DO 262 J=1,NSSMOD + IF(ISSMOD(J).EQ.6.AND.BSSMOD(J).GT.0) THEN + LOOP=LOOP+1 + SUMBR2=SUMBR2+BSSMOD(J) + BR=SUMBR2/SUMBR + CBR(LOOP)=BR + IF(IABS(JSSMOD(1,J)).LT.20.AND.IABS(JSSMOD(2,J)).LT.20 + $ .AND.IABS(JSSMOD(3,J)).LT.20.AND.IABS(JSSMOD(4,J)).LT.20 + $ .AND.IABS(JSSMOD(5,J)).LT.20) THEN + MELEM(LOOP)=4 + ELSE + MELEM(LOOP)=0 + ENDIF + DO 263 K=1,5 + IF(ITHAD(I).GT.0) THEN + MODE(K,LOOP)=JSSMOD(K,J) + ELSE + MODE(K,LOOP)=IDANTI(JSSMOD(K,J)) + ENDIF + LMODE(K)=LABEL(MODE(K,LOOP)) +263 CONTINUE + IF(LPRINT) WRITE(ITLIS,20) LRES,(LMODE(K),K=1,5), + $ BR,IRES,(MODE(K,LOOP),K=1,5) + ENDIF +262 CONTINUE +260 CONTINUE + ENDIF +C +C Set forced decay modes. +C LOOK(INDEX) = -IRES, where LOOK2(K,IRES) points to entries in +C decay table for IDENT>0 and IDENT<0. +C LOOKST(IRES) = standard LOOK value. +C + IF(NFORCE.EQ.0) GO TO 400 +C Append each forced decay to table + IRES=0 + DO 310 I=1,NFORCE + IF(IFORCE(I).EQ.0) GO TO 310 + LOOP=LOOP+1 + IF(LOOP.GT.MXDKY) GO TO 9999 + CALL FLAVOR(IFORCE(I),IFL1,IFL2,IFL3,JSPIN,INDEX) + IF(IFORCE(I).GT.0) THEN + KTYPE=1 + ELSE + KTYPE=2 + ENDIF +C + IF(LOOK(INDEX).GE.0) THEN + IRES=IRES+1 + IF(IRES.GT.MXFORC) GO TO 9998 + LOOKST(IRES)=LOOK(INDEX) + LOOK2(KTYPE,IRES)=LOOP + LOOK2(3-KTYPE,IRES)=LOOKST(IRES) + LOOK(INDEX)=-IRES + ELSE + IRES2=-LOOK(INDEX) + IF(IRES2.GT.MXFORC) GO TO 9998 + LOOK2(KTYPE,IRES2)=LOOP + ENDIF +C Set forced decay mode - conjugate if necessary + IF(KTYPE.EQ.1) THEN + DO 320 K=1,5 +320 MODE(K,LOOP)=MFORCE(K,I) + ELSE + DO 330 K=1,5 +330 MODE(K,LOOP)=IDANTI(MFORCE(K,I)) + ENDIF + CBR(LOOP)=1. +C Set matrix element flag + CALL ORDER(IFORCE(I),MFORCE(1,I),IDUMMY,MEOUT) + MELEM(LOOP)=MEOUT + MEFORC(I)=MEOUT +310 CONTINUE +C +400 RETURN +C +C Errors +C +9999 WRITE(ITLIS,3001) LOOP +3001 FORMAT(//' ***** ERROR IN SETDKY ... DECAY COUNTER LOOP = ', + $I6,' *****') + STOP 99 +9998 WRITE(ITLIS,3002) IRES +3002 FORMAT(//' ***** ERROR IN SETDKY ... FORCE COUNTER IRES = ', + $I6,' *****') + STOP 99 + END diff --git a/ISAJET/code/seth.F b/ISAJET/code/seth.F new file mode 100644 index 00000000000..d9f507d21d8 --- /dev/null +++ b/ISAJET/code/seth.F @@ -0,0 +1,205 @@ +#include "isajet/pilot.h" + SUBROUTINE SETH +C +C Set the standard Weinberg-Salam Higgs parameters in /HCON/. +C HMASS = Higgs mass +C HGAM = Higgs width +C HGAMS = Higgs partial width +C ZSTARS = minimum allowed mass for Z* +C +C IQ = 1 2 3 4 5 6 7 8 9 10 11 12 13 +C GL UP UB DN DB ST SB CH CB BT BB TP TB +C IQ = 14 15 16 17 18 19 20 21 22 23 24 25 +C NUE ANUE E- E+ NUMU ANUM MU- MU+ NUT ANUT TAU- TAU+ +C IQ = 26 27 28 29 +C GM W+ W- Z0 +C +C Ver 6.25: Added H -> GM GM. +C Ver 6.26: Added H -> Z0 Z* from Keung and Marciano, Phys. +C Rev. D30, 248 (1984). +C Ver 6.30: Fixed sign of FFR in H -> GM GM for TAU<1. Added +C H -> W W* to total width but not to partial widths +C to get right branching ratios. +C Ver 7.38: Add H_SM decay modes to SSSAVE for use in WHIGGS +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/keys.inc" +#include "isajet/wcon.inc" +#include "isajet/qlmass.inc" +#include "isajet/q1q2.inc" +#include "isajet/nodcay.inc" +#include "isajet/const.inc" +#include "isajet/hcon.inc" +C + REAL GAMFCN,X,AMASS,AMQ,GAMQ,AML,WM,GAMWW,TAU,FFR,FFI,FR,FI, + $ROOT,ROOTLN,TM,SUMBR,TERM,ETAR,ETAI,RQ,RQLOG,PHIR,PHII + REAL EPS,FEPS,AM12 + INTEGER IQ,IQ1,IQ2,I,IW + INTEGER LISTJ(25),LISTW(4) + DATA LISTJ/ + $9,1,-1,2,-2,3,-3,4,-4,5,-5,6,-6, + $11,-11,12,-12,13,-13,14,-14,15,-15,16,-16/ + DATA LISTW/10,80,-80,90/ +C + GAMFCN(X)=SQRT(1.-4*X**2)*(1.-4.*X**2+12.*X**4) +C +C Calculate Higgs mass and width +C + HMASS=AMASS(81) + HGAM=0. + DO 100 IQ=1,29 +100 HGAMS(IQ)=0. +C +C Quarks and leptons + DO 110 IQ=1,6 + AMQ=AMASS(IQ) + IF(AMQ.GT.0..AND.AMQ.LT..5*HMASS) THEN + GAMQ=3.*GF*AMQ**2*HMASS/(4.*PI*SQRT2) + $ *(SQRT(1.-4.*AMQ**2/HMASS**2))**3 + HGAM=HGAM+GAMQ + HGAMS(2*IQ)=.5*GAMQ + HGAMS(2*IQ+1)=.5*GAMQ + CALL SSSAVE(81,GAMQ,IQ,-IQ,0,0,0) + ENDIF + AML=AMASS(IQ+10) + IF(AML.GT.0..AND.AML.LT..5*HMASS) THEN + GAMQ=GF*AML**2*HMASS/(4.*PI*SQRT2) + $ *(SQRT(1.-4.*AML**2/HMASS**2))**3 + HGAM=HGAM+GAMQ + HGAMS(2*IQ+12)=.5*GAMQ + HGAMS(2*IQ+13)=.5*GAMQ + CALL SSSAVE(81,GAMQ,IQ+10,-(IQ+10),0,0,0) + ENDIF +110 CONTINUE +C +C W+ W- and Z0 Z0, including W W* and Z Z*. + WM=WMASS(2) + IF(HMASS.GT.2.*WM) THEN + GAMWW=GF*HMASS**3*GAMFCN(WM/HMASS)/(8.*PI*SQRT2) + HGAM=HGAM+GAMWW + HGAMS(27)=.5*GAMWW + HGAMS(28)=.5*GAMWW + CALL SSSAVE(81,GAMWW,80,-80,0,0,0) + ELSEIF(HMASS.GT.WM) THEN + EPS=WM/HMASS + FEPS=3.*(1.-8.*EPS**2+20.*EPS**4)/SQRT(4.*EPS**2-1.) + $ *ACOS((3.*EPS**2-1.)/(2.*EPS**3)) + $ -(1.-EPS**2)*(47./2.*EPS**2-13./2.+1./EPS**2) + $ -3.*(1.-6.*EPS**2+4.*EPS**4)*ALOG(EPS) + GAMWW=3.*ALFA**2*HMASS/(32.*PI*SIN2W**2)*FEPS + HGAM=HGAM+GAMWW + HGAMS(27)=.5*GAMWW + HGAMS(28)=.5*GAMWW + CALL SSSAVE(81,GAMWW/18.,80,12,-11,0,0) + CALL SSSAVE(81,GAMWW/18.,-80,-12,11,0,0) + CALL SSSAVE(81,GAMWW/18.,80,14,-13,0,0) + CALL SSSAVE(81,GAMWW/18.,-80,-14,13,0,0) + CALL SSSAVE(81,GAMWW/18.,80,16,-15,0,0) + CALL SSSAVE(81,GAMWW/18.,-80,-16,15,0,0) + CALL SSSAVE(81,GAMWW/6.,80,-1,2,0,0) + CALL SSSAVE(81,GAMWW/6.,-80,1,-2,0,0) + CALL SSSAVE(81,GAMWW/6.,80,-4,3,0,0) + CALL SSSAVE(81,GAMWW/6.,-80,4,-3,0,0) + ENDIF + WM=WMASS(4) + IF(HMASS.GT.2.*WM) THEN + GAMWW=GF*HMASS**3*GAMFCN(WM/HMASS)/(16.*PI*SQRT2) + HGAM=HGAM+GAMWW + HGAMS(29)=GAMWW + CALL SSSAVE(81,GAMWW,90,90,0,0,0) + ELSEIF(HMASS.GT.WM) THEN + EPS=WM/HMASS + FEPS=3.*(1.-8.*EPS**2+20.*EPS**4)/SQRT(4.*EPS**2-1.) + $ *ACOS((3.*EPS**2-1.)/(2.*EPS**3)) + $ -(1.-EPS**2)*(47./2.*EPS**2-13./2.+1./EPS**2) + $ -3.*(1.-6.*EPS**2+4.*EPS**4)*ALOG(EPS) + GAMWW=ALFA**2*HMASS/(128.*PI*SIN2W**2*(1.-SIN2W)**2) + $ *(7.-40./3.*SIN2W+160./9.*SIN2W**2)*FEPS + HGAM=HGAM+GAMWW + HGAMS(29)=GAMWW + CALL SSSAVE(81,.11922*GAMWW,90,-1,1,0,0) + CALL SSSAVE(81,.15375*GAMWW,90,-2,2,0,0) + CALL SSSAVE(81,.15375*GAMWW,90,-3,3,0,0) + CALL SSSAVE(81,.11922*GAMWW,90,-4,4,0,0) + CALL SSSAVE(81,.15375*GAMWW,90,-5,5,0,0) + CALL SSSAVE(81,.06668*GAMWW,90,-11,11,0,0) + CALL SSSAVE(81,.03343*GAMWW,90,-12,12,0,0) + CALL SSSAVE(81,.06668*GAMWW,90,-13,13,0,0) + CALL SSSAVE(81,.03343*GAMWW,90,-14,14,0,0) + CALL SSSAVE(81,.06668*GAMWW,90,-15,15,0,0) + CALL SSSAVE(81,.03343*GAMWW,90,-16,16,0,0) + ENDIF +C W* and Z* mass limits + DO 120 I=1,2 + ZSTARS(1,I)=0. + DO 130 IW=2,4 + ZSTARS(IW,I)=AMASS(LISTW(IW)) + DO 140 IQ1=2,25 + IQ2=MATCH(IQ1,IW) + IF(IQ2.EQ.0) GO TO 140 + IF(GOWW(IQ1,1).AND.GOWW(IQ2,2)) THEN + AM12=AMASS(LISTJ(IQ1))+AMASS(LISTJ(IQ2)) + ZSTARS(IW,I)=MIN(ZSTARS(IW,I),AM12) + ENDIF +140 CONTINUE +130 CONTINUE +120 CONTINUE +C +C GM GM -- W loop term + WM=WMASS(2) + TAU=4.*WM**2/HMASS**2 + IF(TAU.GE.1.0) THEN + FFR=(ASIN(1./SQRT(TAU)))**2 + FFI=0. + ELSE + ROOT=SQRT(1.-TAU) + ROOTLN=ALOG((1.+ROOT)/(1.-ROOT)) + FFR=-0.25*(ROOTLN**2-PI**2) + FFI=0.5*PI*ROOTLN + ENDIF + FR=2.+3.*TAU+3.*TAU*(2.-TAU)*FFR + FI=3.*TAU*(2.-TAU)*FFI +C Top loop term + TM=AMASS(6) + TAU=4.*TM**2/HMASS**2 + IF(TAU.GE.1.0) THEN + FFR=(ASIN(1./SQRT(TAU)))**2 + FFI=0. + ELSE + ROOT=SQRT(1.-TAU) + ROOTLN=ALOG((1.+ROOT)/(1.-ROOT)) + FFR=-0.25*(ROOTLN**2-PI**2) + FFI=0.5*PI*ROOTLN + ENDIF + FR=FR-8./3.*TAU*(1.+(1.-TAU)*FFR) + FI=FI-8./3.*TAU*(1.-TAU)*FFI +C Total GM GM + HGAMS(26)=ALFA**3/(256.*PI**2*SIN2W)*HMASS**3/WM**2*(FR**2+FI**2) + HGAM=HGAM+HGAMS(26) + CALL SSSAVE(81,HGAMS(26),10,10,0,0,0) +C +C Calculate Higgs-gluon-gluon coupling +C + ETAR=0. + ETAI=0. + DO 300 IQ=1,8 + AMQ=AMASS(IQ) + IF(AMQ.LE.0.) GO TO 300 + RQ=(2.*AMQ/HMASS)**2 + IF(RQ.GE.1.) THEN + ETAR=ETAR+.5*RQ*(1.+(1.-RQ)*ASIN(1./SQRT(RQ))**2) + ELSE + RQLOG=ALOG((1.+SQRT(1.-RQ))/(1.-SQRT(1.-RQ))) + PHIR=.25*(RQLOG**2-PI**2) + ETAR=ETAR+.5*RQ*(1.+(RQ-1.)*PHIR) + PHII=.5*PI*RQLOG + ETAI=ETAI+.5*RQ*(1.+(RQ-1.)*PHII) + ENDIF +300 CONTINUE + ETAHGG=ETAR**2+ETAI**2 +C + RETURN + END diff --git a/ISAJET/code/sethss.F b/ISAJET/code/sethss.F new file mode 100644 index 00000000000..606a26cf6ed --- /dev/null +++ b/ISAJET/code/sethss.F @@ -0,0 +1,102 @@ +#include "isajet/pilot.h" + SUBROUTINE SETHSS +C +C Set the MSSM Higgs parameters in /HCON/. +C HMASS = Higgs mass for HTYPE +C HGAM = Higgs width +C HGAMSS = Higgs partial widths. Note HGAMSS is not +C necessarily diagonal for SUSY decays. +C ZSTARS = minimum allowed mass for Z* +C +C Note LISTSS(78) => W+, LISTSS(79) => W-, LISTSS(80) => Z0 +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/hcon.inc" +#include "isajet/listss.inc" +#include "isajet/q1q2.inc" +#include "isajet/ssmode.inc" +#include "isajet/sstype.inc" +#include "isajet/wcon.inc" +C + REAL AMASS + REAL AM12 + INTEGER I,J,N,IQ1,IQ2,IW,K + INTEGER LISTJ(25),LISTW(4) +C + DATA LISTJ/9,1,-1,2,-2,3,-3,4,-4,5,-5,6,-6, + $11,-11,12,-12,13,-13,14,-14,15,-15,16,-16/ + DATA LISTW/10,80,-80,90/ +C +C Initialize +C + IF(IHTYPE.EQ.0) THEN + WRITE(ITLIS,*) ' YOU MUST SELECT AN HTYPE FOR SUSY HIGGS' + WRITE(ITLIS,*) ' JOB TERMINATED' + STOP99 + ENDIF + HMASS=AMASS(IHTYPE) + HGAM=0. + DO 100 I=1,85 + DO 110 J=1,85 + HGAMSS(I,J)=0 +110 CONTINUE +100 CONTINUE +C +C Extract widths from SSMODE common block +C Note the only 3-body modes are Zff or Wff +C These are added to the ZZ and WW entries in HCONSS, +C and the Z* or W* decay is generated later, as for SM Higgs +C + DO 200 N=1,NSSMOD + IF(ISSMOD(N).NE.IHTYPE) GO TO 200 + HGAM=HGAM+GSSMOD(N) + IF(JSSMOD(3,N).NE.0) THEN +C 3-body modes + IF(IABS(JSSMOD(1,N)).EQ.80) THEN + HGAMSS(78,79)=HGAMSS(78,79)+0.5*GSSMOD(N) + HGAMSS(79,78)=HGAMSS(79,78)+0.5*GSSMOD(N) + ELSEIF(JSSMOD(1,N).EQ.90) THEN + HGAMSS(80,80)=HGAMSS(80,80)+GSSMOD(N) + ELSE + WRITE(ITLIS,1000) ISSMOD(N),(JSSMOD(K,N),K=1,5) +1000 FORMAT(' SETHSS: UNEXPECTED MODE ',I8,' --> ',5I8) + STOP 99 + ENDIF + GO TO 200 + ELSE +C 2-body modes + DO 210 I=1,85 + IF(JSSMOD(1,N).NE.LISTSS(I)) GO TO 210 + DO 220 J=1,85 + IF(JSSMOD(2,N).NE.LISTSS(J)) GO TO 220 + HGAMSS(I,J)=HGAMSS(I,J)+.5*GSSMOD(N) + HGAMSS(J,I)=HGAMSS(J,I)+.5*GSSMOD(N) + GO TO 200 +220 CONTINUE +210 CONTINUE + ENDIF + WRITE(ITLIS,1000) ISSMOD(N),(JSSMOD(K,N),K=1,5) + STOP99 +200 CONTINUE +C +C W* and Z* mass limits +C + DO 300 I=1,2 + ZSTARS(1,I)=0. + DO 310 IW=2,4 + ZSTARS(IW,I)=AMASS(LISTW(IW)) + DO 320 IQ1=2,25 + IQ2=MATCH(IQ1,IW) + IF(IQ2.EQ.0) GO TO 320 + IF(GOWW(IQ1,I).AND.GOWW(IQ2,I)) THEN + AM12=AMASS(LISTJ(IQ1))+AMASS(LISTJ(IQ2))+1.0 + ZSTARS(IW,I)=MIN(ZSTARS(IW,I),AM12) + ENDIF +320 CONTINUE +310 CONTINUE +300 CONTINUE + RETURN + END diff --git a/ISAJET/code/setkkg.F b/ISAJET/code/setkkg.F new file mode 100644 index 00000000000..70c606ea103 --- /dev/null +++ b/ISAJET/code/setkkg.F @@ -0,0 +1,20 @@ +#include "isajet/pilot.h" + SUBROUTINE SETKKG +C +C Set the standard KKG parameters in /KKGRAVI/. +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/kkgrav.inc" +#include "isajet/const.inc" +C + REAL DIM2,GMMA,GAMMA + EXTERNAL GAMMA +C Calculate D-surface: + DIM2 = (NEXTRAD*1.0)/2. + GMMA = GAMMA(DIM2) + SURFD = (2.*PI**DIM2) / GMMA + KKGSD = SURFD / (MASSD**(NEXTRAD+2)) + RETURN + END diff --git a/ISAJET/code/setnxt.F b/ISAJET/code/setnxt.F new file mode 100644 index 00000000000..6e18b825440 --- /dev/null +++ b/ISAJET/code/setnxt.F @@ -0,0 +1,33 @@ +#include "isajet/pilot.h" + SUBROUTINE SETNXT +C +C RESET LIMITS BEFORE NEXT SET +C +#include "isajet/itapes.inc" +#include "isajet/lstprt.inc" +#include "isajet/totals.inc" +#include "isajet/dylim.inc" +#include "isajet/jetlim.inc" +#include "isajet/primar.inc" +#include "isajet/jetset.inc" +#include "isajet/partcl.inc" + DATA UNDEF/-1.E9/ + DO 1 I=1,36 + IF(SETLMJ(I)) BLIMS(I)=UNDEF + 1 CONTINUE + DO 2 I=1,12 + IF(SETLMQ(I)) BLIM1(I)=UNDEF + 2 CONTINUE +C RESET /TOTALS/ + NKINPT=0 + NWGEN=0 + NKEEP=0 + SUMWT=0. +C RESET /LSTPRT/ + LSTPRT=0 +C RESET NJSET AND NPTCL + NJSET=0 + NPTCL=0 + NPAIR=0 + RETURN + END diff --git a/ISAJET/code/settyp.F b/ISAJET/code/settyp.F new file mode 100644 index 00000000000..58f522e4708 --- /dev/null +++ b/ISAJET/code/settyp.F @@ -0,0 +1,496 @@ +#include "isajet/pilot.h" + LOGICAL FUNCTION SETTYP(LPRT) +C +C Set JETTYPE flags and WMODE flags for WPAIR. +C Set WMODES and ZMODES flags for secondary W+- and Z0. +C Return .FALSE. if no error, .TRUE. otherwise. +C +C Ver 7.18: Initialize all GOQ to false (limit = MXGOQ) +C Use LISTSS for Higgs if GOMSSM +C Ver 7.29: SUSY Higgs decays are done in SETHSS and SIGHSS +C using LISTSS order, so SUSY list should be used. +C I.e., 7.18 fix was wrong. +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/keys.inc" +#include "isajet/types.inc" +#include "isajet/q1q2.inc" +#include "isajet/xmssm.inc" +C + INTEGER JET,K,I,IW,LPRT + INTEGER NLIST + CHARACTER*8 WORD,BLANK,LIST(30),LISTW(4),LISTXY(4),LISTSS(85) + DATA BLANK/' '/ + DATA LIST/'GL','UP','UB','DN','DB','ST','SB','CH','CB','BT','BB', + $'TP','TB','NUE','ANUE','E-','E+','NUM','ANUM','MU-','MU+', + $'NUT','ANUT','TAU-','TAU+','GM','W+','W-','Z0','HIGGS'/ + DATA LISTW/'GM','W+','W-','Z0'/ + DATA LISTXY/'Y','YB','X','XB'/ + DATA LISTSS/'GLSS', + $'UPSSL','UBSSL','DNSSL','DBSSL','STSSL','SBSSL','CHSSL','CBSSL', + $'BTSS1','BBSS1','TPSS1','TBSS1', + $'UPSSR','UBSSR','DNSSR','DBSSR','STSSR','SBSSR','CHSSR','CBSSR', + $'BTSS2','BBSS2','TPSS2','TBSS2', + $'W1SS+','W1SS-','W2SS+','W2SS-','Z1SS','Z2SS','Z3SS','Z4SS', + $'NUEL','ANUEL','EL-','EL+','NUML','ANUML','MUL-','MUL+', + $'NUTL','ANUTL','TAU1-','TAU1+','ER-','ER+','MUR-','MUR+', + $'TAU2-','TAU2+', + $'GL','UP','UB','DN','DB','ST','SB','CH','CB','BT','BB', + $'TP','TB','NUE','ANUE','E-','E+','NUM','ANUM','MU-','MU+', + $'NUT','ANUT','TAU-','TAU+','GM','W+','W-','Z0', + $'HL0','HH0','HA0','H+','H-'/ +C + SETTYP=.FALSE. +C + IF(KEYS(5)) GO TO 5 + IF(KEYS(2).AND.GOMSSM) GO TO 5 + IF(KEYS(6).OR.KEYS(9)) GO TO 6 + IF(KEYS(7).AND..NOT.GOMSSM) GO TO 7 + IF(KEYS(7).AND.GOMSSM) GO TO 5 + IF(KEYS(10).AND.GOMSSM) GO TO 5 +C +C JETTYPE flags all processes except WPAIR and HIGGS. +C NJTTYP is set in READIN to number of non-blank values read. +C Check for legal jet type names and set appropriate flags. +C + DO 1000 JET=1,MXGOJ + IF(NJTTYP(JET).EQ.0) GO TO 1000 +C Initialize everything to .FALSE. + GOALL(JET)=.FALSE. + DO 1100 K=1,MXGOQ + GOQ(K,JET)=.FALSE. +1100 CONTINUE +C Loop over non-blank JETTYPE entries + DO 1200 I=1,NJTTYP(JET) + WORD=JETYP(I,JET) +C Blank + IF(WORD.EQ.BLANK) THEN + GO TO 1200 + ENDIF +C All + IF(WORD.EQ.'ALL ') THEN + GOALL(JET)=.TRUE. + DO 1210 K=1,MXGOQ +1210 GOQ(K,JET)=.TRUE. + GO TO 1000 + ENDIF +C Quarks + IF(WORD.EQ.'QUARKS ') THEN + DO 1220 K=2,13 +1220 GOQ(K,JET)=.TRUE. + GO TO 1200 + ENDIF +C Charged leptons + IF(WORD.EQ.'LEPTONS ') THEN + DO 1230 K=16,24,4 + GOQ(K,JET)=.TRUE. +1230 GOQ(K+1,JET)=.TRUE. + GO TO 1200 + ENDIF +C Neutrinos + IF(WORD.EQ.'NUS ') THEN + DO 1240 K=14,22,4 + GOQ(K,JET)=.TRUE. +1240 GOQ(K+1,JET)=.TRUE. + GO TO 1200 + ENDIF +C Explicit types +C E+E- now also contains W+, W-, Z0 + IF(KEYS(10).OR.KEYS(11).OR.KEYS(12)) THEN + NLIST=30 + ELSE IF(KEYS(2)) THEN + NLIST=29 + ELSE + NLIST=25 + ENDIF + DO 1250 K=1,NLIST + IF(WORD.EQ.LIST(K)) THEN + GOQ(K,JET)=.TRUE. + GO TO 1200 + ENDIF +1250 CONTINUE +C Special types for TWOJET + DO 1270 K=1,4 + IF(KEYS(1).AND.WORD.EQ.LISTXY(K)) THEN + GOQ(13+K,JET)=.TRUE. + GO TO 1200 + ENDIF +1270 CONTINUE +C Special type for PHOTON + IF(KEYS(8).AND.WORD.EQ.LISTW(1)) THEN + GOQ(26,JET)=.TRUE. + GO TO 1200 + ENDIF +C Error + WRITE(ITLIS,1300) WORD,JET +1300 FORMAT(1X,A8,' IS NOT RECOGNIZABLE FOR JETTYPE',I1) + SETTYP=.TRUE. +1200 CONTINUE +1000 CONTINUE + GO TO 4000 +C +C JETTYPE flags for SUSY +C +5 DO 5000 JET=1,2 + IF(NJTTYP(JET).EQ.0) GO TO 5000 + GOALL(JET)=.FALSE. + DO 5100 K=1,MXGOQ +5100 GOQ(K,JET)=.FALSE. + DO 5200 I=1,NJTTYP(JET) + WORD=JETYP(I,JET) +C Blank + IF(WORD.EQ.BLANK) THEN + GO TO 5200 + ENDIF +C All + IF(WORD.EQ.'ALL ') THEN + GOALL(JET)=.TRUE. + DO 5210 K=1,85 +5210 GOQ(K,JET)=.TRUE. + GO TO 5000 + ENDIF +C Squarks + IF(WORD.EQ.'SQUARKS ') THEN + DO 5220 K=2,25 +5220 GOQ(K,JET)=.TRUE. + GO TO 5200 + ENDIF +C Gauginos + IF(WORD.EQ.'GAUGINOS') THEN + DO 5230 K=26,33 +5230 GOQ(K,JET)=.TRUE. + GO TO 5200 + ENDIF +C Sleptons + IF(WORD.EQ.'SLEPTONS') THEN + DO 5240 K=34,51 +5240 GOQ(K,JET)=.TRUE. + GO TO 5200 + ENDIF +C Explicit susy types + DO 5300 K=1,85 + IF(WORD.EQ.LISTSS(K)) THEN + GOQ(K,JET)=.TRUE. + GO TO 5200 + ENDIF +5300 CONTINUE +5200 CONTINUE +5000 CONTINUE + GO TO 4000 +C +C JETTYPE and WMODE flags for WPAIR +C NJTTYP and NWWTYP are the number of non-blank values. +C +6 DO 2000 JET=1,2 + IF(NJTTYP(JET).EQ.0) GO TO 2300 +C Initialize to FALSE + GOALL(JET)=.FALSE. + DO 2100 K=1,4 +2100 GOQ(K,JET)=.FALSE. +C +C Loop over non-blank JETTYPE flags +C + DO 2200 I=1,NJTTYP(JET) + WORD=JETYP(I,JET) +C Blank + IF(WORD.EQ.BLANK) THEN + GO TO 2200 + ENDIF +C All + IF(WORD.EQ.'ALL ') THEN + GOALL(JET)=.TRUE. + DO 2210 K=1,4 +2210 GOQ(K,JET)=.TRUE. + GO TO 2300 + ENDIF +C Explicit types + DO 2220 K=1,4 + IF(WORD.EQ.LISTW(K)) THEN + GOQ(K,JET)=.TRUE. + GO TO 2200 + ENDIF +2220 CONTINUE +C Error + WRITE(ITLIS,1300) WORD,JET + SETTYP=.TRUE. +2200 CONTINUE +C +C Loop over nonblank WMODE flags +C +2300 IF(NWWTYP(JET).EQ.0) GO TO 2000 + ALLWW(JET)=.FALSE. +C Initialize everything to FALSE + DO 2350 K=1,25 +2350 GOWW(K,JET)=.FALSE. +C + DO 2400 I=1,NWWTYP(JET) + WORD=WWTYP(I,JET) + IF(WORD.NE.BLANK) NWWTYP(JET)=I +C Blank + IF(WORD.EQ.BLANK) THEN + GO TO 2400 + ENDIF +C All + IF(WORD.EQ.'ALL ') THEN + ALLWW(JET)=.TRUE. + DO 2410 K=1,25 +2410 GOWW(K,JET)=.TRUE. + GO TO 2000 + ENDIF +C Quarks + IF(WORD.EQ.'QUARKS ') THEN + DO 2420 K=2,13 +2420 GOWW(K,JET)=.TRUE. + GO TO 2400 + ENDIF +C Charged leptons + IF(WORD.EQ.'LEPTONS ') THEN + DO 2430 K=16,24,4 + GOWW(K,JET)=.TRUE. +2430 GOWW(K+1,JET)=.TRUE. + GO TO 2400 + ENDIF +C Neutrinos + IF(WORD.EQ.'NUS ') THEN + DO 2440 K=14,22,4 + GOWW(K,JET)=.TRUE. +2440 GOWW(K+1,JET)=.TRUE. + GO TO 2400 + ENDIF +C Explicit types + DO 2450 K=1,25 + IF(WORD.EQ.LIST(K)) THEN + GOWW(K,JET)=.TRUE. + GO TO 2400 + ENDIF +2450 CONTINUE +C Error + WRITE(ITLIS,2500) WORD,JET +2500 FORMAT(1X,A8,' IS NOT A VALID CODE FOR WMODE',I1) + SETTYP=.TRUE. +2400 CONTINUE +2000 CONTINUE + GO TO 4000 +C +C JETTYPE and WMODE flags for HIGGS +C SUSY HIGGS uses LISTSS order and hence SUSY part +C +7 DO 3000 JET=1,2 + IF(NJTTYP(JET).EQ.0) GO TO 3300 +C Initialize to FALSE + GOALL(JET)=.FALSE. + DO 3100 K=1,MXGOQ +3100 GOQ(K,JET)=.FALSE. +C +C Loop over non-blank JETTYPE flags +C + DO 3200 I=1,NJTTYP(JET) + WORD=JETYP(I,JET) +C Blank + IF(WORD.EQ.BLANK) THEN + GO TO 3200 + ENDIF +C All + IF(WORD.EQ.'ALL ') THEN + GOALL(JET)=.TRUE. + DO 3210 K=1,MXGOQ +3210 GOQ(K,JET)=.TRUE. + GO TO 3300 + ENDIF +C Quarks + IF(WORD.EQ.'QUARKS ') THEN + DO 3220 K=2,13 +3220 GOQ(K,JET)=.TRUE. + GO TO 3200 + ENDIF +C Charged leptons + IF(WORD.EQ.'LEPTONS ') THEN + DO 3240 K=16,24,4 + GOQ(K,JET)=.TRUE. +3240 GOQ(K+1,JET)=.TRUE. + GO TO 3200 + ENDIF + DO 3250 K=1,85 + IF(WORD.EQ.LIST(K)) THEN + GOQ(K,JET)=.TRUE. + GO TO 3200 + ENDIF +3250 CONTINUE +C Error + WRITE(ITLIS,1300) WORD,JET + SETTYP=.TRUE. +3200 CONTINUE +C +C Loop over nonblank WMODE flags +C +3300 IF(NWWTYP(JET).EQ.0) GO TO 3000 + ALLWW(JET)=.FALSE. +C Initialize everything to FALSE + DO 3350 K=1,25 +3350 GOWW(K,JET)=.FALSE. +C + DO 3400 I=1,NWWTYP(JET) + WORD=WWTYP(I,JET) + IF(WORD.NE.BLANK) NWWTYP(JET)=I +C Blank + IF(WORD.EQ.BLANK) THEN + GO TO 3400 + ENDIF +C All + IF(WORD.EQ.'ALL ') THEN + ALLWW(JET)=.TRUE. + DO 3410 K=1,25 +3410 GOWW(K,JET)=.TRUE. + GO TO 3000 + ENDIF +C Quarks + IF(WORD.EQ.'QUARKS ') THEN + DO 3420 K=2,13 +3420 GOWW(K,JET)=.TRUE. + GO TO 3400 + ENDIF +C Charged leptons + IF(WORD.EQ.'LEPTONS ') THEN + DO 3430 K=16,24,4 + GOWW(K,JET)=.TRUE. +3430 GOWW(K+1,JET)=.TRUE. + GO TO 3400 + ENDIF +C Neutrinos + IF(WORD.EQ.'NUS ') THEN + DO 3440 K=14,22,4 + GOWW(K,JET)=.TRUE. +3440 GOWW(K+1,JET)=.TRUE. + GO TO 3400 + ENDIF +C Explicit types + DO 3450 K=1,25 + IF(WORD.EQ.LIST(K)) THEN + GOWW(K,JET)=.TRUE. + GO TO 3400 + ENDIF +3450 CONTINUE +C Error + WRITE(ITLIS,2500) WORD,JET +3500 FORMAT(1X,A8,' IS NOT A VALID CODE FOR WMODE',I1) + SETTYP=.TRUE. +3400 CONTINUE +3000 CONTINUE +C +C Set WMODES and ZMODES flags for secondary W+- and Z0 +C +4000 DO 4100 IW=1,3 + IF(NWMODE(IW).EQ.0) GO TO 4100 +C Initialize everything to .FALSE. + DO 4200 K=1,25 +4200 GOWMOD(K,IW)=.FALSE. +C Loop over non-blank WMODE entries + DO 4300 I=1,NWMODE(IW) + WORD=WMODES(I,IW) +C Blank + IF(WORD.EQ.BLANK) THEN + GO TO 4300 + ENDIF +C All + IF(WORD.EQ.'ALL ') THEN + DO 4310 K=1,25 +4310 GOWMOD(K,IW)=.TRUE. + GO TO 4100 + ENDIF +C Quarks + IF(WORD.EQ.'QUARKS ') THEN + DO 4320 K=2,13 +4320 GOWMOD(K,IW)=.TRUE. + GO TO 4300 + ENDIF +C Charged leptons + IF(WORD.EQ.'LEPTONS ') THEN + DO 4330 K=16,24,4 + GOWMOD(K,IW)=.TRUE. +4330 GOWMOD(K+1,IW)=.TRUE. + GO TO 4300 + ENDIF +C Neutrinos + IF(WORD.EQ.'NUS ') THEN + DO 4340 K=14,22,4 + GOWMOD(K,IW)=.TRUE. +4340 GOWMOD(K+1,IW)=.TRUE. + GO TO 4300 + ENDIF +C Explicit types + DO 4350 K=1,25 + IF(WORD.EQ.LIST(K)) THEN + GOWMOD(K,IW)=.TRUE. + GO TO 4300 + ENDIF +4350 CONTINUE +C Error + WRITE(ITLIS,4380) WORD +4380 FORMAT(1X,A8,' IS NOT RECOGNIZABLE FOR SECONDARY WS') + SETTYP=.TRUE. +4300 CONTINUE +4100 CONTINUE +C +C Loop over nonblank WMODE flags FOR WHIGGS +C + IF (KEYS(10)) THEN + DO 6000 JET=1,2 +6300 IF(NWWTYP(JET).EQ.0) GO TO 6000 + ALLWW(JET)=.FALSE. +C Initialize everything to FALSE + DO 6350 K=1,25 +6350 GOWW(K,JET)=.FALSE. +C + DO 6400 I=1,NWWTYP(JET) + WORD=WWTYP(I,JET) + IF(WORD.NE.BLANK) NWWTYP(JET)=I +C Blank + IF(WORD.EQ.BLANK) THEN + GO TO 6400 + ENDIF +C All + IF(WORD.EQ.'ALL ') THEN + ALLWW(JET)=.TRUE. + DO 6410 K=1,25 +6410 GOWW(K,JET)=.TRUE. + GO TO 6000 + ENDIF +C Quarks + IF(WORD.EQ.'QUARKS ') THEN + DO 6420 K=2,13 +6420 GOWW(K,JET)=.TRUE. + GO TO 6400 + ENDIF +C Charged leptons + IF(WORD.EQ.'LEPTONS ') THEN + DO 6430 K=16,24,4 + GOWW(K,JET)=.TRUE. +6430 GOWW(K+1,JET)=.TRUE. + GO TO 6400 + ENDIF +C Neutrinos + IF(WORD.EQ.'NUS ') THEN + DO 6440 K=14,22,4 + GOWW(K,JET)=.TRUE. +6440 GOWW(K+1,JET)=.TRUE. + GO TO 6400 + ENDIF +C Explicit types + DO 6450 K=1,25 + IF(WORD.EQ.LIST(K)) THEN + GOWW(K,JET)=.TRUE. + GO TO 6400 + ENDIF +6450 CONTINUE +C Error + WRITE(ITLIS,6500) WORD,JET +6500 FORMAT(1X,A8,' IS NOT A VALID CODE FOR WMODE',I1) + SETTYP=.TRUE. +6400 CONTINUE +6000 CONTINUE + END IF + RETURN + END diff --git a/ISAJET/code/setw.F b/ISAJET/code/setw.F new file mode 100644 index 00000000000..efa6c0acae1 --- /dev/null +++ b/ISAJET/code/setw.F @@ -0,0 +1,233 @@ +#include "isajet/pilot.h" + SUBROUTINE SETW +C +C Set the W parameters in /WCON/. +C SIN2W = sin**2(theta-sub-w) +C AQ, BQ = vector, axial couplings normalized to ALFA. +C MATCH(IQ1,IW) = Cabibbo favored type for W --> QK1 + QK2. +C WCBR(IQ,IW) = cumulative branching ratio for JETTYP(1)=IQ +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/keys.inc" +#include "isajet/wcon.inc" +#include "isajet/qlmass.inc" +#include "isajet/q1q2.inc" +#include "isajet/nodcay.inc" +#include "isajet/const.inc" +#include "isajet/xmssm.inc" +C + REAL SINW,COSW,AMW,AMZ,AW,FACZ,GAMW,GAMZ,TERM,SUM,AM1,AMASS,AM2 + INTEGER I1,I2,I3,J,INDEX,IFL,NGAM,NUP,IW,IQ1,IQ2,IFL1,JET,IQ,IFL2 + INTEGER IW1 + REAL T3(12),EQ3(12) + INTEGER NUTYP(25),LISTJ(25) +#if defined(CERNLIB_SINGLE) + REAL SIN2WD,SINWD,COSWD,AWD,FACZD +#endif +#if defined(CERNLIB_DOUBLE) + DOUBLE PRECISION SIN2WD,SINWD,COSWD,AWD,FACZD +#endif + DATA T3/.5,-.5,-.5,.5,-.5,.5,.5,-.5,.5,-.5,.5,-.5/ + DATA EQ3/2.,-1.,-1.,2.,-1.,2.,0.,-3.,0.,-3.,0.,-3./ + DATA NUTYP/13*0,1,1,0,0,1,1,0,0,1,1,0,0/ + DATA LISTJ/9,1,-1,2,-2,3,-3,4,-4,5,-5,6,-6, + $11,-11,12,-12,13,-13,14,-14,15,-15,16,-16/ +C +C Masses can be changed with WMASS +C + SINW=SQRT(SIN2W) + COSW=SQRT(1.-SIN2W) + AMW=WMASS(2) + AMZ=WMASS(4) +C +C Couplings for Weinberg-Salam model +C + AW=1./(2.*SQRT2*SINW) + FACZ=1./(2.*SINW*COSW) + EZ=SQRT((1.-SIN2W)/SIN2W) + DO 110 IFL=1,12 + AQ(IFL,1)=EQ3(IFL)/3. + BQ(IFL,1)=0. + AQ(IFL,2)=AW + BQ(IFL,2)=AW + AQ(IFL,3)=AW + BQ(IFL,3)=AW + AQ(IFL,4)=FACZ*(T3(IFL)-2.*EQ3(IFL)/3.*SIN2W) + BQ(IFL,4)=FACZ*T3(IFL) +110 CONTINUE +#if defined(CERNLIB_SINGLE) +C Double precision couplings not needed. + EZDP=EZ + DO 120 IW=1,4 + DO 120 IFL=1,12 + AQDP(IFL,IW)=AQ(IFL,IW) + BQDP(IFL,IW)=BQ(IFL,IW) +120 CONTINUE +#endif +#if defined(CERNLIB_DOUBLE) +C Double precision couplings for 32-bit machines. + SIN2WD=SIN2W + SINWD=DSQRT(SIN2WD) + COSWD=DSQRT(1.-SIN2WD) + AWD=1./(2.*DSQRT(2.D0)*SINWD) + FACZD=1./(2.*SINWD*COSWD) + EZDP=COSWD/SINWD + DO 120 IFL=1,12 + AQDP(IFL,1)=EQ3(IFL)/3.D0 + BQDP(IFL,1)=0. + AQDP(IFL,2)=AWD + BQDP(IFL,2)=AWD + AQDP(IFL,3)=AWD + BQDP(IFL,3)=AWD + AQDP(IFL,4)=FACZD*(T3(IFL)-2.D0*EQ3(IFL)/3.D0*SIN2WD) + BQDP(IFL,4)=FACZD*T3(IFL) +120 CONTINUE +#endif +C +C Widths +C + NGAM=12 + IF(AMLEP(5)+AMLEP(6).GT.AMW) NGAM=9 + GAMW=GF*AMW**3/(6.*PI*SQRT2)*NGAM + NUP=3 + IF(2.*AMLEP(6).GT.AMZ) NUP=2 + GAMZ=NUP*3.*(AQ(1,4)**2+BQ(1,4)**2)+3.*3.*(AQ(2,4)**2+BQ(2,4)**2) + 1+3.*(AQ(7,4)**2+BQ(7,4)**2+AQ(8,4)**2+BQ(8,4)**2) + GAMZ=GAMZ*2./FACZ**2 + GAMZ=GAMZ*GF*AMZ**3/(12.*PI*SQRT2) + WGAM(1)=0. + WGAM(2)=GAMW + WGAM(3)=GAMW + WGAM(4)=GAMZ +C +C Branching ratios for secondary W+- and Z0 +C + DO 210 IW=2,4 + IW1=IW-1 + SUM=0. + CUMWBR(1,IW1)=0. + DO 220 IQ1=2,25 + CUMWBR(IQ1,IW1)=CUMWBR(IQ1-1,IW1) + IQ2=MATCH(IQ1,IW) + IF(IQ2.EQ.0) GO TO 220 + IF(.NOT.(GOWMOD(IQ1,IW-1).AND.GOWMOD(IQ2,IW-1))) GO TO 220 + IFL1=LISTJ(IQ1) + IFL2=LISTJ(IQ2) + AM1=AMASS(IFL1) + AM2=AMASS(IFL2) + IF(AM1+AM2.GE.WMASS(IW)) GO TO 220 + TERM=AQ(IQ1/2,IW)**2+BQ(IQ1/2,IW)**2 + IF(IQ1.LE.13) TERM=3.*TERM + CUMWBR(IQ1,IW1)=CUMWBR(IQ1-1,IW1)+TERM + SUM=SUM+TERM +220 CONTINUE + IF(SUM.LE.0.) THEN + WRITE(ITLIS,2000) IW +2000 FORMAT(//' ***** NO ALLOWED DECAY MODE FOR SECONDARY W TYPE', + $ I2,' *****') + STOP 99 + ENDIF + DO 230 IQ1=2,25 + CUMWBR(IQ1,IW1)=CUMWBR(IQ1,IW1)/SUM +230 CONTINUE +210 CONTINUE +C +C Decay channels for DRELLYAN +C + IF(KEYS(3)) THEN + DO 310 IW=1,4 + COUT(IW)=0. + IF(.NOT.GODY(IW)) GO TO 310 + DO 320 IQ1=2,25 + IQ2=MATCH(IQ1,IW) + IF(IQ2.EQ.0) GO TO 320 + IF(.NOT.(GOQ(IQ1,1).AND.GOQ(IQ2,2))) GO TO 320 + IF(NUTYP(IQ1)*NUTYP(IQ2).EQ.1.AND.NONUNU) GO TO 320 + IFL1=IQ1/2 + TERM=.5*(AQ(IFL1,IW)**2+BQ(IFL1,IW)**2) + IF(IQ1.LE.13) TERM=3.*TERM + COUT(IW)=COUT(IW)+TERM +320 CONTINUE + IF(COUT(IW).EQ.0.) THEN + WRITE(ITLIS,3000) IW +3000 FORMAT(//' ***** ERROR IN SETW ... NO ALLOWED DECAY MODE ', + $ 'FOR W TYPE',I2,' *****') + STOP 99 + ENDIF +310 CONTINUE +C W branching ratios + DO 330 IW=1,4 + IF(.NOT.GODY(IW)) GO TO 330 + SUM=0. + DO 340 IQ1=1,25 + WCBR(IQ1,IW)=SUM + IQ2=MATCH(IQ1,IW) + IF(IQ2.EQ.0) GO TO 340 + IF(.NOT.(GOQ(IQ1,1).AND.GOQ(IQ2,2))) GO TO 340 + IF(NUTYP(IQ1)*NUTYP(IQ2).EQ.1.AND.NONUNU) GO TO 340 + IFL1=IQ1/2 + TERM=.5*(AQ(IFL1,IW)**2+BQ(IFL1,IW)**2)/COUT(IW) + IF(IQ1.LE.13) TERM=3.*TERM + SUM=SUM+TERM + WCBR(IQ1,IW)=SUM +340 CONTINUE +330 CONTINUE + ENDIF +C +C Calculate branching ratios for WPAIR events summed over +C modes allowed by WMODE cards. +C TBRWW = total allowed branching ratio. +C RBRWW = relative branching ratios. +C TBRWW*RBRWW = physical branching ratios. +C + IF((KEYS(2).AND.(.NOT.GOMSSM)).OR.KEYS(6) + ,.OR.KEYS(7).OR.KEYS(9).OR.KEYS(10)) THEN + DO 400 JET=1,2 + TBRWW(1,JET)=1. + DO 410 IW=2,4 + TBRWW(IW,JET)=0. + IF(KEYS(6).OR.KEYS(9)) THEN + IF(.NOT.GOQ(IW,JET)) GO TO 410 + ELSEIF((KEYS(2).OR.KEYS(7).OR.KEYS(10)).AND..NOT.GOMSSM)THEN + IF(.NOT.GOQ(IW+25,JET)) GO TO 410 + ELSEIF((KEYS(7).OR.KEYS(10)).AND.GOMSSM) THEN + IF(.NOT.GOQ(IW+76,JET)) GO TO 410 + ENDIF + SUM=0. + DO 420 IQ=1,12 + RBRWW(IQ,IW,JET)=0. + IQ1=2*IQ + IQ2=MATCH(IQ1,IW) + IF(IQ2.EQ.0) GO TO 420 + IFL1=IQ1/2 + IF(IQ1.GT.13) IFL1=IFL1+4 + IFL2=IQ2/2 + IF(IQ2.GT.13) IFL2=IFL2+4 + AM1=AMASS(IFL1) + AM2=AMASS(IFL2) + IF(AM1+AM2.GE.WMASS(IW)) GO TO 420 + TERM=AQ(IQ1/2,IW)**2+BQ(IQ1/2,IW)**2 + IF(IQ1.LE.13) TERM=3*TERM + SUM=SUM+TERM + IF(.NOT.(GOWW(IQ1,JET).AND.GOWW(IQ2,JET))) GO TO 420 + RBRWW(IQ,IW,JET)=TERM + TBRWW(IW,JET)=TBRWW(IW,JET)+TERM +420 CONTINUE + TBRWW(IW,JET)=TBRWW(IW,JET)/SUM + IF(TBRWW(IW,JET).GT.0.) THEN + DO 430 IQ=1,12 +430 RBRWW(IQ,IW,JET)=RBRWW(IQ,IW,JET)/(SUM*TBRWW(IW,JET)) + ELSE + WRITE(ITLIS,445) IW,JET +445 FORMAT(/' ***** NO ALLOWED MODE FOR W TYPE ',I2, + $ ' IN JET ',I2,' *****'/) + STOP 99 + ENDIF +410 CONTINUE +400 CONTINUE + ENDIF + RETURN + END diff --git a/ISAJET/code/sigdy.F b/ISAJET/code/sigdy.F new file mode 100644 index 00000000000..9908f9ee725 --- /dev/null +++ b/ISAJET/code/sigdy.F @@ -0,0 +1,347 @@ +#include "isajet/pilot.h" + SUBROUTINE SIGDY +C +C Compute the Drell-Yan and Drell-Yan plus jet cross sections +C d(sigma)/d(qmw**2)d(qtw**2)d(yw)d(yj) +C +C SIGMA = cross section summed over quark types allowed by +C JETTYPE3 and WTYPE cards. +C SIGS(I) = partial cross section for I1 + I2 --> I3 + I4. +C INOUT(I) = IOPAK**3*I4 + IOPAK**2*I3 + IOPAK*I2 + I1 +C using JETTYPE code. +C +C QT cutoff for W+JET taken from Parisi and Petronzio, +C Nucl Phys B154, 427 +C qk + gl --> qk + w suppressed at low QTW by extra factor +C of qtw**2/(qtw**2+qt2cut(qmw)) +C +C Ver 7.17: include top mass for gb --> Wt and gt --> Zt +C with no extra qt suppression factor. Note we do NOT include +C gt --> Wb; while this process makes sense for qt >> m_t, +C it has a pole in the physical region at low qt from the +C on-shell decay t --> Wb. We let Q**2 --> Q**2 + m_t**2 +C in the scale for the parton distributions. +C +C Ver 7.32: Rewrite AJLWT for gb --> Wt, etc., in terms of +C scaled variables, and restore SWT**5 later to avoid +C floating errors on VMS. +C +C Ver 7.41: Recalculate COUT for each mass(!). +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/qcdpar.inc" +#include "isajet/jetpar.inc" +#include "isajet/primar.inc" +#include "isajet/q1q2.inc" +#include "isajet/jetsig.inc" +#include "isajet/qsave.inc" +#include "isajet/wcon.inc" +#include "isajet/const.inc" +#include "isajet/nodcay.inc" +C + REAL X(2) + REAL Z,S,T,U,QMW2,QZW,EHAT,Q2SAVE,YHAT,EY,P3Z,P1,P2,AMASS,ANEFF, + $SIG0,DENOM,QT2CUT,SIGT,SIGU,FAC,PROP,FACTOR,SIG,AMT,AMT2,SWT, + $P1WT,P2WT,X1WT,X2WT,TWT,UWT,Q2,QFCN,STRUC,XX,ACOSH,ATANH,P2M,P1M + REAL AMI2,AMF2,EFWT + REAL AJLWT,AJLZT1,AJLZT2,A2,A2B2,QQ,TM2 + INTEGER I,IQ,IH,IQ1,IFL,IQ2,IW + INTEGER NZERO(4) + REAL AMFAC(13) + INTEGER NUTYP(25) + INTEGER IFL1,IFL2 + REAL TERM + EQUIVALENCE (S,SHAT),(T,THAT),(U,UHAT),(X(1),X1) +C + DATA NZERO/11,9,9,11/ + DATA AMFAC/11*0.,2*1./ + DATA NUTYP/13*0,1,1,0,0,1,1,0,0,1,1,0,0/ +C +C Functions + ACOSH(Z)=ALOG(Z+SQRT(Z**2-1.)) + ATANH(Z)=.5*ALOG((1.+Z)/(1.-Z)) + PROP(I)=1./((QMW2-WMASS(I)**2)**2+(WMASS(I)*WGAM(I))**2) +C Qt cutoff function + QT2CUT(QMW)=CUTOFF*QMW**CUTPOW +C Parton distributions + QFCN(XX,IQ,IH)=STRUC(XX,QSQ+AMT2,IQ,IDIN(IH))/XX +C Integrated matrix elements JLint from FORM + AJLWT(S,T,QQ,TM2)= + $ - 32*QQ**3*S*T + 32*QQ**3*S*TM2 + 32*QQ**2*S**2*T + $ + 32*QQ**2*S*T**2 - 16*QQ**2*S*T*TM2 - 16*QQ**2*S*TM2**2 + $ - 16*QQ*S**3*T + 16*QQ*S**3*TM2 - 16*QQ*S**2*T*TM2 + $ - 16*QQ*S*T**3 + 32*QQ*S*T**2*TM2 - 16*QQ*S*T*TM2**2 + $ - 8*S**3*T*TM2 + 8*S**3*TM2**2 - 16*S**2*T**2*TM2 + $ + 16*S**2*T*TM2**2 - 16*S**2*TM2**3 - 8*S*T**3*TM2 + $ + 8*S*T**2*TM2**2 - 8*S*T*TM2**3 + 8*S*TM2**4 +C + AJLZT1(S,T,QQ,TM2)= + $ + A2 * ( - 96*QQ**2*S*T*TM2 + 96*QQ**2*S*TM2**2 + $ + 96*QQ**2*T*TM2**2 - 96*QQ**2*TM2**3 + 96*QQ*S**2*T*TM2 + $ + 96*QQ*S*T**2*TM2 - 192*QQ*S*T*TM2**2 - 96*QQ*S*TM2**3 + $ - 96*QQ*T*TM2**3 + 192*QQ*TM2**4 + 16*S**3*T*TM2 + $ - 16*S**3*TM2**2 + 32*S**2*T**2*TM2 - 112*S**2*T*TM2**2 + $ + 80*S**2*TM2**3 + 16*S*T**3*TM2 - 112*S*T**2*TM2**2 + $ + 224*S*T*TM2**3 - 128*S*TM2**4 - 16*T**3*TM2**2 + $ + 80*T**2*TM2**3 - 128*T*TM2**4 + 64*TM2**5 ) + AJLZT2(S,T,QQ,TM2)= + $ + A2B2 * ( - 16*QQ**3*S*T + 16*QQ**3*S*TM2 + 16*QQ**3*T*TM2 + $ - 16*QQ**3*TM2**2 + 16*QQ**2*S**2*T + 16*QQ**2*S*T**2 + $ + 32*QQ**2*S*T*TM2 - 80*QQ**2*S*TM2**2 - 80*QQ**2*T*TM2**2 + $ + 96*QQ**2*TM2**3 - 8*QQ*S**3*T + 8*QQ*S**3*TM2 + $ - 40*QQ*S**2*T*TM2 - 24*QQ*S**2*TM2**2 - 8*QQ*S*T**3 + $ - 40*QQ*S*T**2*TM2 + 80*QQ*S*T*TM2**2 + 96*QQ*S*TM2**3 + $ + 8*QQ*T**3*TM2 - 24*QQ*T**2*TM2**2 + 96*QQ*T*TM2**3 + $ - 144*QQ*TM2**4 - 16*S**3*T*TM2 + 16*S**3*TM2**2 + $ - 32*S**2*T**2*TM2 + 112*S**2*T*TM2**2 - 80*S**2*TM2**3 + $ - 16*S*T**3*TM2 + 112*S*T**2*TM2**2 - 224*S*T*TM2**3 + $ + 128*S*TM2**4 + 16*T**3*TM2**2 - 80*T**2*TM2**3 + $ + 128*T*TM2**4 - 64*TM2**5 ) +C +C Kinematics +C + QMW2=QMW**2 + QTMW=SQRT(QMW2+QTW**2) + Q0W=QTMW*COSH(YW) + QZW=QTMW*SINH(YW) + QW=SQRT(QZW**2+QTW**2) +C Protect against errors + IF(QW.NE.0.) THEN + CTHW=QZW/QW + STHW=QTW/QW + IF(ABS(CTHW).LT.1.) THEN + THW=ACOS(CTHW) + ELSE + CTHW=0. + STHW=1. + THW=.5*PI + ENDIF + ELSE + CTHW=0. + STHW=1. + THW=.5*PI + ENDIF +C + IF(STDDY) THEN +C Kinematics for standard Drell-Yan + EHAT=QMW + SHAT=QMW**2 + QSQ=SHAT + Q2SAVE=QSQ + YHAT=YW + EY=EXP(YHAT) + X1=EHAT/ECM*EY + X2=EHAT/(ECM*EY) + ELSE +C Kinematics for Drell-Yan plus jet + P3Z=P(3)*CTH(3) + SHAT=QMW2+2.*Q0W*P(3)-2.*QZW*P3Z+2.*PT(3)**2 + P1=.5*(P(3)+P3Z+Q0W+QZW) + P2=.5*(P(3)-P3Z+Q0W-QZW) + X1=P1/HALFE + X2=P2/HALFE + THAT=-2.*P1*(P(3)-P3Z) + UHAT=-2.*P2*(P(3)+P3Z) + QSQ=QTW**2 + QSQ=AMAX1(QSQ,4.) + ANEFF=4.+QSQ/(QSQ+AMASS(5)**2)+QSQ/(QSQ+AMASS(6)**2) + ALFQSQ=12.*PI/((33.-2.*ANEFF)*ALOG(QSQ/ALAM2)) + Q2SAVE=QSQ + QSQ=SHAT + ENDIF +C +C Initialize +C + SIGMA=0. + NSIGS=0 + DO 100 I=1,MXSIGS + SIGS(I)=0. +100 CONTINUE + IF(X1.GE.1..OR.X2.GE.1.) RETURN +C +C Compute structure functions +C + DO 110 IH=1,2 + DO 120 IQ=1,11 + QSAVE(IQ,IH)=STRUC(X(IH),QSQ,IQ,IDIN(IH))/X(IH) +120 CONTINUE + QSAVE(12,IH)=0 + QSAVE(13,IH)=0 +110 CONTINUE + QSQ=Q2SAVE +C +C Recompute COUT for this mass +C + DO 130 IW=1,4 + COUT(IW)=0. + IF(.NOT.GODY(IW)) GO TO 130 + DO 140 IQ1=2,25 + IQ2=MATCH(IQ1,IW) + IF(IQ2.EQ.0) GO TO 140 + IF(.NOT.(GOQ(IQ1,1).AND.GOQ(IQ2,2))) GO TO 140 + IF(NUTYP(IQ1)*NUTYP(IQ2).EQ.1.AND.NONUNU) GO TO 140 + IFL1=IQ1/2 + IFL2=IQ2/2 + IF(AMASS(IFL1)+AMASS(IFL2).GE.QMW) GO TO 140 + TERM=.5*(AQ(IFL1,IW)**2+BQ(IFL1,IW)**2) + IF(IQ1.LE.13) TERM=3.*TERM + COUT(IW)=COUT(IW)+TERM +140 CONTINUE +130 CONTINUE +C + IF(STDDY) GO TO 400 +C +C Compute cross section for types allowed by WTYPE and +C JETTYPE cards. +C +C qk + gl --> qk + W +C + SIG0=ALFA**2*ALFQSQ*QMW2/(9.*SCM*S)*UNITS + DENOM=S**2*EXP(.5*ALOG(QTW**4+QT2CUT(QMW)**2)) + SIGT=SIG0*(S**2+U**2+2.*T*QMW2)*(-T)/DENOM + SIGU=SIG0*(S**2+T**2+2.*U*QMW2)*(-U)/DENOM + DO 200 IW=1,4 + IF(.NOT.GODY(IW)) GO TO 200 + FAC=COUT(IW)*PROP(IW) + DO 210 IQ=2,NZERO(IW) + IF(.NOT.GOQ(IQ,3)) GO TO 210 + IQ1=MATCH(IQ,4) + IQ1=MATCH(IQ1,IW) + IF(IQ1.EQ.0) GO TO 210 + IFL=IQ/2 + FACTOR=FAC*(AQ(IFL,IW)**2+BQ(IFL,IW)**2) + $ *QTW**2/(QTW**2+QT2CUT(QMW)) + SIG=FACTOR*SIGT*QSAVE(IQ1,1)*QSAVE(1,2) + CALL SIGFIL(SIG,IQ1,1,IW,IQ) + SIG=FACTOR*SIGU*QSAVE(IQ1,2)*QSAVE(1,1) + CALL SIGFIL(SIG,1,IQ1,IW,IQ) +210 CONTINUE +200 CONTINUE +C +C bt,tp + gl -> bt,tp + W,Z +C + AMT=AMASS(6) + AMT2=AMT**2 + Q2=QMW2 + DO 220 IW=2,4 + IF(.NOT.GODY(IW)) GO TO 220 + DO 230 IQ=NZERO(IW)+1,13 + IF(.NOT.GOQ(IQ,3)) GO TO 230 + IQ1=MATCH(IQ,4) + IQ1=MATCH(IQ1,IW) + IF(IQ1.EQ.0) GO TO 230 + IF(IQ1.GE.12.AND.IW.NE.4) GO TO 230 +C Assign zero or top masses for initial/final quarks + AMF2=AMT2*AMFAC(IQ) + AMI2=AMT2*AMFAC(IQ1) + EFWT=SQRT(P(3)**2+AMF2) + SWT=QMW2+AMF2+2.*Q0W*EFWT-2.*QZW*P3Z+2.*PT(3)**2 +C +C qk + gl initial state +C Do kinematics using p(small) = 0 for gluon +C + P1WT=EFWT+P3Z+Q0W+QZW + P1M=AMI2/P1WT + P2WT=EFWT-P3Z+Q0W-QZW-P1M + X1WT=.5*P1WT/HALFE + X2WT=.5*P2WT/HALFE + TWT=-P1WT*(EFWT-P3Z)-P1M*(EFWT+P3Z)+AMI2+AMF2 + UWT=-P2WT*(EFWT+P3Z)+AMF2 + IF(X1WT.LT.0.OR.X1WT.GT.1.OR.X2WT.LT.0.OR.X2WT.GT.1) + $ GO TO 240 +C Cross sections + IF(IW.EQ.2.OR.IW.EQ.3) THEN + SIG0=ALFA**2*ALFQSQ/(144*SCM*SWT)*UNITS + SIG0=SIG0*(AQ(5,IW)**2+BQ(5,IW)**2)*COUT(IW)*PROP(IW) + SIGU=SIG0*AJLWT(SWT/SWT,UWT/SWT,Q2/SWT,AMT2/SWT)*SWT* + $ (SWT/(SWT-AMI2))**2*(SWT/(UWT-AMF2))**2 + SIG=SIGU*QFCN(X1WT,IQ1,1)*QFCN(X2WT,1,2) + CALL SIGFIL(SIG,IQ1,1,IW,IQ) + ELSEIF(IW.EQ.4) THEN + SIG0=ALFA**2*ALFQSQ/(144*SCM*SWT)*UNITS + SIG0=SIG0*COUT(IW)*PROP(IW) + A2=AQ(6,IW)**2 + A2B2=AQ(6,IW)**2+BQ(6,IW)**2 + SIGU=SIG0*(AJLZT1(SWT/SWT,UWT/SWT,Q2/SWT,AMT2/SWT)+ + $ AJLZT2(SWT/SWT,UWT/SWT,Q2/SWT,AMT2/SWT))*SWT* + $ (SWT/(SWT-AMI2))**2*(SWT/(UWT-AMF2))**2 + SIG=SIGU*QFCN(X1WT,IQ1,1)*QFCN(X2WT,1,2) + CALL SIGFIL(SIG,IQ1,1,IW,IQ) + ENDIF +C +C gl + qk initial state +C Do kinematics using p(small) = 0 for gluon +C +240 P2WT=EFWT-P3Z+Q0W-QZW + P2M=AMI2/P2WT + P1WT=EFWT+P3Z+Q0W+QZW-P2M + X1WT=.5*P1WT/HALFE + X2WT=.5*P2WT/HALFE + TWT=-P1WT*(EFWT-P3Z)+AMF2 + UWT=-P2WT*(EFWT+P3Z)-P2M*(EFWT-P3Z)+AMI2+AMF2 + IF(X1WT.LT.0.OR.X1WT.GT.1.OR.X2WT.LT.0.OR.X2WT.GT.1) + $ GO TO 230 +C Cross sections + IF(IW.EQ.2.OR.IW.EQ.3) THEN + SIG0=ALFA**2*ALFQSQ/(144*SCM*SWT)*UNITS + SIG0=SIG0*(AQ(5,IW)**2+BQ(5,IW)**2)*COUT(IW)*PROP(IW) + SIGT=SIG0*AJLWT(SWT/SWT,TWT/SWT,Q2/SWT,AMT2/SWT)*SWT* + $ (SWT/(SWT-AMI2))**2*(SWT/(TWT-AMF2)**2) + SIG=SIGT*QFCN(X1WT,1,1)*QFCN(X2WT,IQ1,2) + CALL SIGFIL(SIG,1,IQ1,IW,IQ) + ELSEIF(IW.EQ.4) THEN + SIG0=ALFA**2*ALFQSQ/(144*SCM*SWT)*UNITS + SIG0=SIG0*COUT(IW)*PROP(IW) + A2=AQ(6,IW)**2 + A2B2=AQ(6,IW)**2+BQ(6,IW)**2 + SIGU=SIG0*(AJLZT1(SWT/SWT,TWT/SWT,Q2/SWT,AMT2/SWT)+ + $ AJLZT2(SWT/SWT,TWT/SWT,Q2/SWT,AMT2/SWT))*SWT* + $ (SWT/(SWT-AMI2))**2*(SWT/(TWT-AMF2))**2 + SIG=SIGU*QFCN(X1WT,1,1)*QFCN(X2WT,IQ1,2) + CALL SIGFIL(SIG,1,IQ1,IW,IQ) + ENDIF +230 CONTINUE +220 CONTINUE +C +C qk + qb --> gl + W +C + IF(.NOT.GOQ(1,3)) RETURN + SIG0=8.*ALFA**2*ALFQSQ*QMW2/(27.*SCM*S)*UNITS + DENOM=S*EXP(.5*ALOG(QTW**4+QT2CUT(QMW)**2)) + SIG0=SIG0*(T**2+U**2+2.*S*QMW2)/DENOM + DO 300 IW=1,4 + IF(.NOT.GODY(IW)) GO TO 300 + FAC=COUT(IW)*PROP(IW) + DO 310 IQ1=2,11 + IQ2=MATCH(IQ1,IW) + IF(IQ2.EQ.0) GO TO 310 + IFL=IQ1/2 + SIG=FAC*SIG0*(AQ(IFL,IW)**2+BQ(IFL,IW)**2) + $ *QSAVE(IQ1,1)*QSAVE(IQ2,2) + CALL SIGFIL(SIG,IQ1,IQ2,IW,1) +310 CONTINUE +300 CONTINUE + RETURN +C +C Standard Drell-Yan for QT=0. +C +400 CONTINUE + SIG0=4.*PI*ALFA**2*QMW2/(9.*SCM)*UNITS + DO 410 IW=1,4 + IF(.NOT.GODY(IW)) GO TO 410 + FAC=COUT(IW)*PROP(IW) + DO 420 IQ1=2,13 + IQ2=MATCH(IQ1,IW) + IF(IQ2.EQ.0) GO TO 420 + IFL=IQ1/2 + SIG=FAC*SIG0*(AQ(IFL,IW)**2+BQ(IFL,IW)**2) + $ *QSAVE(IQ1,1)*QSAVE(IQ2,2) + CALL SIGFIL(SIG,IQ1,IQ2,IW,0) +420 CONTINUE +410 CONTINUE +C + RETURN + END diff --git a/ISAJET/code/sigdy2.F b/ISAJET/code/sigdy2.F new file mode 100644 index 00000000000..415a9d1908f --- /dev/null +++ b/ISAJET/code/sigdy2.F @@ -0,0 +1,332 @@ +#include "isajet/pilot.h" + SUBROUTINE SIGDY2 +C +C Compute the lepton-lepton-jet cross or quark-antiquark-jet +C cross section +C d(sigma)/d(qmw**2)d(qtw**2)d(yw)d(yj)d(omega*) +C for the specified W and jet types +C +C Also fix the incoming partons to be the selected types. +C +C QT cutoff from Parisi and Petronzio, Nucl Phys B154, 427 +C qk+gl-->qk+w suppressed at low QTW +C +C Ver 6.40: Fix underflow in standard Drell-Yan +C +C Ver 7.17: include top mass for gb --> Wt and gt --> Zt +C with no extra qt suppression factor. Note we do NOT include +C gt --> Wb; while this process makes sense for qt >> m_t, +C it has a pole in the physical region at low qt from the +C on-shell decay t --> Wb. We let Q**2 --> Q**2 + m_t**2 +C in the scale for the parton distributions. +C +C Ver 7.32: Rewrite AJLWT for gb --> Wt, etc., in terms of +C scaled variables, and restore SWT**5 later to avoid +C floating errors on VMS. +C +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/jetpar.inc" +#include "isajet/primar.inc" +#include "isajet/q1q2.inc" +#include "isajet/jetsig.inc" +#include "isajet/wsig.inc" +#include "isajet/qsave.inc" +#include "isajet/wcon.inc" +#include "isajet/const.inc" +C + REAL PROP,AJLWT,FCDIR,FCINT,QT2CUT,QFCN,AMASS,STRUC + REAL AJLZT1,AJLZT2,AJLZT3,AJLZT4 + REAL X1WT,X2WT,P1WT,P2WT,SWT,TWT,UWT,QZW,P3Z, + $S,T,U,S1,T1,U1,TDIR,UDIR,TINT,UINT,COUPL,DENOM, + $AMT,AMT2,TERM1,TERM2,SIG0,QMW2,Q2,XX,S1WT,T1WT,U1WT,P1M,P2M, + $AMI2,AMF2,EFWT,A2,A2B2,AB,AL2BL2,ALBL,QQ,TM2 + REAL AMFAC(13) + INTEGER I,JF,IFLQ,JQK,IQ1,IQ2,IFL1,IQ,IFLL,IH,IQ3 + INTEGER NZERO(4) + EQUIVALENCE (S,SHAT),(T,THAT),(U,UHAT) + EQUIVALENCE (S1,SHAT1),(T1,THAT1),(U1,UHAT1) +C + DATA NZERO/13,9,9,11/ + DATA AMFAC/11*0.,2*1./ + +C Functions. FCDIR and FCINT are direct and interference +C terms for virtual Compton cross section. +C + PROP(I)=1./((QMW2-WMASS(I)**2)**2+(WMASS(I)*WGAM(I))**2) + FCDIR(S,T,U,S1,T1,U1)=COUPL*(S*(2.*S1**2-2.*S1*U1-2.*T1*U1) + 1+T*(-2.*S1*T1-4.*S1*U1-2.*T1*U1)+U*(2.*U1**2-2.*S1*T1-2.*S1*U1) + 2+QMW2*(S**2+U**2+2.*T*QMW2))*(-T)/DENOM + FCINT(S,T,U,S1,T1,U1)=-COUPL*(S1*(S*T-T*U+T*QMW2+QMW2**2) + 1+T1*(-S**2+U**2+2.*S*QMW2-2.*U*QMW2)+U1*(S*T-T*U-T*QMW2-QMW2**2)) + 2*(-T)/DENOM +C QT cutoff function + QT2CUT(QMW)=CUTOFF*QMW**CUTPOW +C Parton distributions for top processes + QFCN(XX,IQ,IH)=STRUC(XX,QSQ+AMT2,IQ,IDIN(IH))/XX +C Matrix elements JL/128 from FORM + AJLWT(S,T,T1,U1,QQ,TM2)= + $ + 2*QQ**3*S*T - 2*QQ**3*S*TM2 - 2*QQ**2*S**2*TM2 + $ - 2*QQ**2*S*T**2 + 4*QQ**2*S*T*T1 + 2*QQ**2*S*T*U1 + $ - 4*QQ**2*S*T1*TM2 - 2*QQ**2*S*U1*TM2 + 2*QQ**2*S*TM2**2 + $ + QQ*S**2*T*TM2 - 4*QQ*S**2*T1*TM2 + QQ*S**2*TM2**2 + $ + QQ*S*T**3 - 2*QQ*S*T**2*T1 - QQ*S*T**2*TM2 + 2*QQ*S*T*T1**2 + $ + 2*QQ*S*T*T1*U1 - 2*QQ*S*T*T1*TM2 + QQ*S*T*U1**2 + $ - 3*QQ*S*T*U1*TM2 + QQ*S*T*TM2**2 - 2*QQ*S*T1**2*TM2 + $ - 2*QQ*S*T1*U1*TM2 + 4*QQ*S*T1*TM2**2 - QQ*S*U1**2*TM2 + $ + 3*QQ*S*U1*TM2**2 - QQ*S*TM2**3 + S**2*T*T1*TM2 + $ - S**2*T*U1*TM2 - 2*S**2*T1**2*TM2 + S**2*T1*TM2**2 + $ + S**2*U1*TM2**2 + S*T**2*T1*TM2 - 2*S*T*T1**2*TM2 + $ - 2*S*T*T1*U1*TM2 - S*T*U1**2*TM2 + S*T*U1*TM2**2 + $ + 2*S*T1**2*TM2**2 + 2*S*T1*U1*TM2**2 - S*T1*TM2**3 + $ + S*U1**2*TM2**2 - S*U1*TM2**3 +C + AJLZT1(S,T,T1,U1,QQ,TM2)= + $ + A2*AL2BL2 * ( 8*QQ**2*S*T*TM2 - 8*QQ**2*S*TM2**2 + $ - 8*QQ**2*T*TM2**2 + 8*QQ**2*TM2**3 - 8*QQ*S**2*T*TM2 + $ - 8*QQ*S*T**2*TM2 + 16*QQ*S*T*TM2**2 + 8*QQ*S*TM2**3 + $ + 8*QQ*T*TM2**3 - 16*QQ*TM2**4 + 8*S**2*T*U1*TM2 + $ - 8*S**2*U1*TM2**2 + 8*S*T**2*U1*TM2 + 8*S*T*U1**2*TM2 + $ - 32*S*T*U1*TM2**2 - 8*S*U1**2*TM2**2 + 24*S*U1*TM2**3 + $ - 8*T**2*U1*TM2**2 - 8*T*U1**2*TM2**2 + 24*T*U1*TM2**3 + $ + 8*U1**2*TM2**3 - 16*U1*TM2**4 )/8. + AJLZT2(S,T,T1,U1,QQ,TM2)= + $ + A2B2*AL2BL2 * ( 2*QQ**3*S*T - 2*QQ**3*S*TM2 + $ - 2*QQ**3*T*TM2 + 2*QQ**3*TM2**2 - 2*QQ**2*S**2*TM2 + $ - 2*QQ**2*S*T**2 + 4*QQ**2*S*T*T1 + 2*QQ**2*S*T*U1 + $ - 8*QQ**2*S*T*TM2 - 4*QQ**2*S*T1*TM2 - 2*QQ**2*S*U1*TM2 + $ + 14*QQ**2*S*TM2**2 - 4*QQ**2*T*T1*TM2 - 2*QQ**2*T*U1*TM2 + $ + 12*QQ**2*T*TM2**2 + 4*QQ**2*T1*TM2**2 + 2*QQ**2*U1*TM2**2 + $ - 14*QQ**2*TM2**3 + QQ*S**3*T - QQ*S**3*TM2 + 2*QQ*S**2*T*T1 + $ + 2*QQ*S**2*T*U1 - QQ*S**2*T*TM2 - 6*QQ*S**2*T1*TM2 + $ - 2*QQ*S**2*U1*TM2 + 9*QQ*S**2*TM2**2 + QQ*S*T**3 + $ - 2*QQ*S*T**2*T1 + 3*QQ*S*T**2*TM2 + 4*QQ*S*T*T1**2 + $ + 4*QQ*S*T*T1*U1 - 16*QQ*S*T*T1*TM2 + 2*QQ*S*T*U1**2 + $ - 12*QQ*S*T*U1*TM2 + 10*QQ*S*T*TM2**2 - 4*QQ*S*T1**2*TM2 + $ - 4*QQ*S*T1*U1*TM2 + 26*QQ*S*T1*TM2**2 - 2*QQ*S*U1**2*TM2 + $ + 12*QQ*S*U1*TM2**2 - 30*QQ*S*TM2**3 - QQ*T**3*TM2 + $ - 2*QQ*T**2*T1*TM2 - 4*QQ*T**2*U1*TM2 + 5*QQ*T**2*TM2**2 + $ - 4*QQ*T*T1**2*TM2 - 4*QQ*T*T1*U1*TM2 + 22*QQ*T*T1*TM2**2 + $ - 2*QQ*T*U1**2*TM2 + 18*QQ*T*U1*TM2**2 )/8. + AJLZT3(S,T,T1,U1,QQ,TM2)= + $ + A2B2*AL2BL2 * ( - 26*QQ*T*TM2**3 + 4*QQ*T1**2*TM2**2 + $ + 4*QQ*T1*U1*TM2**2 - 24*QQ*T1*TM2**3 + 2*QQ*U1**2*TM2**2 + $ - 14*QQ*U1*TM2**3 + 30*QQ*TM2**4 - 8*S**2*T*U1*TM2 + $ - 4*S**2*T1**2*TM2 + 8*S**2*T1*TM2**2 + 8*S**2*U1*TM2**2 + $ - 4*S**2*TM2**3 - 8*S*T**2*U1*TM2 - 8*S*T*T1**2*TM2 + $ - 8*S*T*T1*U1*TM2 + 16*S*T*T1*TM2**2 - 8*S*T*U1**2*TM2 + $ + 40*S*T*U1*TM2**2 - 8*S*T*TM2**3 + 16*S*T1**2*TM2**2 + $ + 8*S*T1*U1*TM2**2 - 32*S*T1*TM2**3 + 8*S*U1**2*TM2**2 + $ - 32*S*U1*TM2**3 + 16*S*TM2**4 - 4*T**2*T1**2*TM2 + $ - 8*T**2*T1*U1*TM2 + 8*T**2*T1*TM2**2 - 4*T**2*U1**2*TM2 + $ + 16*T**2*U1*TM2**2 - 4*T**2*TM2**3 + 16*T*T1**2*TM2**2 + $ + 24*T*T1*U1*TM2**2 - 32*T*T1*TM2**3 + 16*T*U1**2*TM2**2 + $ - 48*T*U1*TM2**3 + 16*T*TM2**4 - 16*T1**2*TM2**3 + $ - 16*T1*U1*TM2**3 + 32*T1*TM2**4 - 12*U1**2*TM2**3 + $ + 32*U1*TM2**4 - 16*TM2**5 )/8. + AJLZT4(S,T,T1,U1,QQ,TM2)= + $ + AB*ALBL * ( 8*QQ**3*S*T - 8*QQ**3*S*TM2 - 8*QQ**3*T*TM2 + $ + 8*QQ**3*TM2**2 - 8*QQ**2*S**2*TM2 - 8*QQ**2*S*T**2 + $ + 16*QQ**2*S*T*T1 + 8*QQ**2*S*T*U1 - 16*QQ**2*S*T*TM2 + $ - 16*QQ**2*S*T1*TM2 - 8*QQ**2*S*U1*TM2 + 40*QQ**2*S*TM2**2 + $ - 16*QQ**2*T*T1*TM2 - 8*QQ**2*T*U1*TM2 + 32*QQ**2*T*TM2**2 + $ + 16*QQ**2*T1*TM2**2 + 8*QQ**2*U1*TM2**2 - 40*QQ**2*TM2**3 + $ - 4*QQ*S**3*T + 4*QQ*S**3*TM2 - 8*QQ*S**2*T*T1 + $ - 8*QQ*S**2*T*U1 + 20*QQ*S**2*T*TM2 - 8*QQ*S**2*T1*TM2 + $ + 8*QQ*S**2*U1*TM2 - 4*QQ*S**2*TM2**2 + 4*QQ*S*T**3 + $ - 8*QQ*S*T**2*T1 - 4*QQ*S*T**2*TM2 + 40*QQ*S*T1*TM2**2 + $ - 32*QQ*S*TM2**3 - 4*QQ*T**3*TM2 - 8*QQ*T**2*T1*TM2 + $ - 16*QQ*T**2*U1*TM2 + 20*QQ*T**2*TM2**2 + 40*QQ*T*T1*TM2**2 + $ + 40*QQ*T*U1*TM2**2 - 48*QQ*T*TM2**3 - 48*QQ*T1*TM2**3 + $ - 24*QQ*U1*TM2**3 + 48*QQ*TM2**4 )/8. +C +C Find whether JETTYP(1) or JETTYP(2) is particle +C + JF=1 + IF(2*(JETTYP(1)/2).NE.JETTYP(1)) JF=2 +C +C Kinematics +C + QMW2=QMW**2 + QZW=QTMW*SINH(YW) + Q0W=QTMW*COSH(YW) + QW=SQRT(QZW**2+QTW**2) + + T1=-X2*ECM*PT(JF)*EXP(YJ(JF)) + U1=-X1*ECM*PT(JF)*EXP(-YJ(JF)) + S1=-T1-U1-QMW2 + SIGLLQ=0. + IF(STDDY) GO TO 400 +C +C qk + qb --> gl + w +C + IF(JETTYP(3).EQ.1) THEN + IFLL=JETTYP(1)/2 + COUPL=-ALFA**2*ALFQSQ*PROP(JWTYP)/(9.*PI*SCM*S) + DENOM=S**2*EXP(.5*ALOG(QTW**4+QT2CUT(QMW)**2)) + TDIR=FCDIR(T,S,U,T1,S1,U1)*(AQ(IFLL,JWTYP)**2+BQ(IFLL,JWTYP)**2) + UDIR=FCDIR(U,S,T,U1,S1,T1)*(AQ(IFLL,JWTYP)**2+BQ(IFLL,JWTYP)**2) + TINT=FCINT(T,S,U,T1,S1,U1)*2.*AQ(IFLL,JWTYP)*BQ(IFLL,JWTYP) + UINT=FCINT(U,S,T,U1,S1,T1)*2.*AQ(IFLL,JWTYP)*BQ(IFLL,JWTYP) + IQ1=INITYP(1) + IQ2=INITYP(2) + IFL1=IQ1/2 + IF(2*IFL1.EQ.IQ1) THEN + TERM1=TDIR*(AQ(IFL1,JWTYP)**2+BQ(IFL1,JWTYP)**2) + $ *QSAVE(IQ1,1)*QSAVE(IQ2,2) + TERM2=TINT*2.*AQ(IFL1,JWTYP)*BQ(IFL1,JWTYP) + $ *QSAVE(IQ1,1)*QSAVE(IQ2,2) + SIGLLQ=SIGLLQ+TERM1+TERM2 + ELSE + TERM1=UDIR*(AQ(IFL1,JWTYP)**2+BQ(IFL1,JWTYP)**2) + $ *QSAVE(IQ1,1)*QSAVE(IQ2,2) + TERM2=UINT*2.*AQ(IFL1,JWTYP)*BQ(IFL1,JWTYP) + $ *QSAVE(IQ1,1)*QSAVE(IQ2,2) + SIGLLQ=SIGLLQ+TERM1+TERM2 + ENDIF + SIGLLQ=SIGLLQ*UNITS + IF(JETTYP(1).LE.13) SIGLLQ=3.*SIGLLQ + RETURN +C +C qk + gl --> qk + w +C + ELSEIF(JETTYP(3).LE.NZERO(JWTYP)) THEN + JQK=MATCH(JETTYP(3),4) + JQK=MATCH(JQK,JWTYP) + IF(JQK.EQ.0) RETURN + COUPL=ALFA**2*ALFQSQ*PROP(JWTYP)/(24.*PI*SCM*S) + DENOM=S**2*EXP(.5*ALOG(QTW**4+QT2CUT(QMW)**2)) + IFLQ=JQK/2 + IFLL=JETTYP(1)/2 + IF(INITYP(2).EQ.1) THEN + TDIR=FCDIR(S,T,U,S1,T1,U1)*QSAVE(JQK,1)*QSAVE(1,2) + ELSE + TDIR=FCDIR(S,U,T,S1,U1,T1)*QSAVE(JQK,2)*QSAVE(1,1) + ENDIF + TDIR=TDIR*(AQ(IFLQ,JWTYP)**2+BQ(IFLQ,JWTYP)**2) + $ *(AQ(IFLL,JWTYP)**2+BQ(IFLL,JWTYP)**2) + IF(INITYP(2).EQ.1) THEN + TINT=FCINT(S,T,U,S1,T1,U1)*QSAVE(JQK,1)*QSAVE(1,2) + ELSE + TINT=FCINT(S,U,T,S1,U1,T1)*QSAVE(JQK,2)*QSAVE(1,1) + ENDIF + TINT=TINT*4.*AQ(IFLQ,JWTYP)*BQ(IFLQ,JWTYP)*AQ(IFLL,JWTYP) + $ *BQ(IFLL,JWTYP) + SIGLLQ=TDIR+TINT + SIGLLQ=SIGLLQ*UNITS + IF(JETTYP(1).LE.13) SIGLLQ=3.*SIGLLQ + SIGLLQ=SIGLLQ*QTW**2/(QTW**2+QT2CUT(QMW)) + RETURN +C +C bt,tp + gl --> bt,tp + W,Z +C + ELSEIF(JETTYP(3).GE.NZERO(JWTYP)+1) THEN + IQ3=JETTYP(3) + JQK=MATCH(IQ3,4) + JQK=MATCH(JQK,JWTYP) + IF(JQK.EQ.0) RETURN + AMT=AMASS(6) + AMT2=AMT**2 + Q2=QMW2 + AMF2=AMFAC(IQ3)*AMT2 + AMI2=AMFAC(JQK)*AMT2 + EFWT=SQRT(P(3)**2+AMF2) + P3Z=P(3)*CTH(3) + SWT=QMW2+AMF2+2.*Q0W*EFWT-2.*QZW*P3Z+2.*PT(3)**2 +C Kinematics + IF(INITYP(2).EQ.1) THEN + P1WT=EFWT+P3Z+Q0W+QZW + P1M=AMI2/P1WT + P2WT=EFWT-P3Z+Q0W-QZW-P1M + X1WT=.5*P1WT/HALFE + X2WT=.5*P2WT/HALFE + TWT=-P1WT*(EFWT-P3Z)-P1M*(P(3)+P3Z)+AMI2+AMF2 + UWT=-P2WT*(EFWT+P3Z)+AMF2 + T1WT=-X2WT*ECM*PT(JF)*EXP(YJ(JF)) + U1WT=-X1WT*ECM*PT(JF)*EXP(-YJ(JF))-P1M*PT(JF)*EXP(YJ(JF)) + S1WT=-T1WT-U1WT-QMW2+AMI2+AMF2 + ELSE + P2WT=EFWT-P3Z+Q0W-QZW + P2M=AMI2/P2WT + P1WT=EFWT+P3Z+Q0W+QZW-P2M + X1WT=.5*P1WT/HALFE + X2WT=.5*P2WT/HALFE + TWT=-P1WT*(EFWT-P3Z)+AMF2 + UWT=-P2WT*(EFWT+P3Z)-P2M*(EFWT-P3Z)+AMI2+AMF2 + T1WT=-X2WT*ECM*PT(JF)*EXP(YJ(JF))-P2M*PT(JF)*EXP(-YJ(JF)) + U1WT=-X1WT*ECM*PT(JF)*EXP(-YJ(JF)) + S1WT=-T1WT-U1WT-QMW2+AMI2+AMF2 + ENDIF +C Cross section + SIG0=-ALFA**2*ALFQSQ/(12*PI*SCM*SWT)*PROP(JWTYP)*UNITS + IF(JETTYP(1).LE.13) SIG0=3*SIG0 + IF(JWTYP.EQ.2.OR.JWTYP.EQ.3) THEN + SIG0=SIG0*(AQ(6,JWTYP)**2+BQ(6,JWTYP)**2)**2 + IF(INITYP(2).EQ.1.AND.(IQ3.EQ.12.OR.IQ3.EQ.13)) THEN + SIGLLQ=AJLWT(SWT/SWT,TWT/SWT,T1WT/SWT,U1WT/SWT,Q2/SWT, + $ AMT2/SWT) + SIGLLQ=SIGLLQ*SWT*(SWT/(SWT-AMI2))**2*(SWT/(TWT-AMF2))**2 + SIGLLQ=SIGLLQ*SIG0*QFCN(X1WT,JQK,1)*QFCN(X2WT,1,2) + ELSEIF(INITYP(1).EQ.1.AND.(IQ3.EQ.12.OR.IQ3.EQ.13)) THEN + SIGLLQ=AJLWT(SWT/SWT,UWT/SWT,U1WT/SWT,T1WT/SWT,Q2/SWT, + $ AMT2/SWT) + SIGLLQ=SIGLLQ*SWT*(SWT/(SWT-AMI2))**2*(SWT/(TWT-AMF2))**2 + SIGLLQ=SIGLLQ*SIG0*QFCN(X1WT,JQK,2)*QFCN(X2WT,1,1) + ENDIF + ELSEIF(JWTYP.EQ.4) THEN + A2=AQ(6,JWTYP)**2 + A2B2=AQ(6,JWTYP)**2+BQ(6,JWTYP)**2 + AB=AQ(6,JWTYP)*BQ(6,JWTYP) + AL2BL2=AQ(JETTYP(1)/2,JWTYP)**2+BQ(JETTYP(1)/2,JWTYP)**2 + ALBL=AQ(JETTYP(1)/2,JWTYP)*BQ(JETTYP(1)/2,JWTYP) + IF(INITYP(2).EQ.1) THEN + SIGLLQ=AJLZT1(SWT/SWT,TWT/SWT,T1WT/SWT,U1WT/SWT, + $ Q2/SWT,AMT2/SWT) + SIGLLQ=SIGLLQ+AJLZT2(SWT/SWT,TWT/SWT,T1WT/SWT,U1WT/SWT, + $ Q2/SWT,AMT2/SWT) + SIGLLQ=SIGLLQ+AJLZT3(SWT/SWT,TWT/SWT,T1WT/SWT,U1WT/SWT, + $ Q2/SWT,AMT2/SWT) + SIGLLQ=SIGLLQ+AJLZT4(SWT/SWT,TWT/SWT,T1WT/SWT,U1WT/SWT, + $ Q2/SWT,AMT2/SWT) + SIGLLQ=SIGLLQ*SWT*(SWT/(SWT-AMI2))**2*(SWT/(TWT-AMF2))**2 + SIGLLQ=SIGLLQ*SIG0*QFCN(X1WT,JQK,1)*QFCN(X2WT,1,2) + ELSEIF(INITYP(1).EQ.1) THEN + SIGLLQ=AJLZT1(SWT/SWT,UWT/SWT,U1WT/SWT,T1WT/SWT, + $ Q2/SWT,AMT2/SWT) + SIGLLQ=SIGLLQ+AJLZT2(SWT/SWT,UWT/SWT,U1WT/SWT,T1WT/SWT, + $ Q2/SWT,AMT2/SWT) + SIGLLQ=SIGLLQ+AJLZT3(SWT/SWT,UWT/SWT,U1WT/SWT,T1WT/SWT, + $ Q2/SWT,AMT2/SWT) + SIGLLQ=SIGLLQ+AJLZT4(SWT/SWT,UWT/SWT,U1WT/SWT,T1WT/SWT, + $ Q2/SWT,AMT2/SWT) + SIGLLQ=SIGLLQ*SWT*(SWT/(SWT-AMI2))**2*(SWT/(UWT-AMF2))**2 + SIGLLQ=SIGLLQ*SIG0*QFCN(X1WT,JQK,2)*QFCN(X2WT,1,1) + ENDIF + ENDIF + ENDIF + RETURN +C +C Standard Drell-Yan with QT=0. +C +400 CONTINUE + IFLL=JETTYP(1)/2 + COUPL=ALFA**2*PROP(JWTYP)*UNITS + TDIR=COUPL*(AQ(IFLL,JWTYP)**2+BQ(IFLL,JWTYP)**2) + $*((U1**2+T1**2)/(6.*SCM*QMW2)) + TINT=COUPL*2.*AQ(IFLL,JWTYP)*BQ(IFLL,JWTYP) + $*((U1**2-T1**2)/(6.*SCM*QMW2)) + IQ1=INITYP(1) + IQ2=INITYP(2) + IFL1=IQ1/2 + TERM1=TDIR*(AQ(IFL1,JWTYP)**2+BQ(IFL1,JWTYP)**2) + $*QSAVE(IQ1,1)*QSAVE(IQ2,2) + TERM2=-TINT*2.*AQ(IFL1,JWTYP)*BQ(IFL1,JWTYP) + $*QSAVE(IQ1,1)*QSAVE(IQ2,2) + IF(2*IFL1.EQ.IQ1) SIGLLQ=SIGLLQ+TERM1+TERM2 + IF(2*IFL1.NE.IQ1) SIGLLQ=SIGLLQ+TERM1-TERM2 + IF(JETTYP(1).LE.13) SIGLLQ=3.*SIGLLQ + RETURN + END diff --git a/ISAJET/code/sigee.F b/ISAJET/code/sigee.F new file mode 100644 index 00000000000..63cd5d579cd --- /dev/null +++ b/ISAJET/code/sigee.F @@ -0,0 +1,200 @@ +#include "isajet/pilot.h" + SUBROUTINE SIGEE +C +C Compute d(sigma)/d(cos theta) with interference +C and polarization for +C E+ E- --> GM, Z0 ----> QK QB, L LB, N NB, W+ W-, Z Z +C +C SIGS(I) = partial cross section for I1 + I2 --> I3 + I4. +C INOUT(I) = IOPAK**3*I4 + IOPAK**2*I3 + IOPAK*I2 + I1 +C USING JETTYPE CODE. +C +C Extra factor of 1/2 needed because all jets are treated +C as identical. +C Version 7.42 includes bremsstrahlung contribution; +C also, beamstrahlung +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/jetsig.inc" +#include "isajet/eepar.inc" +#include "isajet/primar.inc" +#include "isajet/jetpar.inc" +#include "isajet/q1q2.inc" +#include "isajet/const.inc" +#include "isajet/wcon.inc" +#include "isajet/brembm.inc" +C + REAL FLEP,FLEM,FREP,FREM,PROPZ,REDZ,SH,E,G,GP,COS2W, + $TNTHW,CTTHW,ALQ(2),BEQ(2),ALL(2),BEL(2),AE,BE,EQ,AMQ,AMQ2, + $PCM,Z,AF,BF,PHILRG,PHILRZ,PHILRI,PHIRLG,PHIRLZ,PHIRLI, + $THT,UH,RSH,UT,PHIRL,PHILR,SIGLR,SIGRL,SIG,AMASS, + $ALFAEM,AMZ,GAMZ,AMW,JAC,ESTRUC,SSFEL + INTEGER I,IQ,IQ2,IFL,ISGN,IQ2EQ(25) + DATA IQ2EQ/0,2,-2,-1,1,-1,1,2,-2,-1,1,2,-2,0,0,-3,3, + $0,0,-3,3,0,0,-3,3/ +C Fractional polarizations + FLEP=(1.+PLEP)/2. + FLEM=(1.+PLEM)/2. + FREP=(1.-PLEP)/2. + FREM=(1.-PLEM)/2. +C FUNCTIONS + ALFAEM=1./128. + AMZ=WMASS(4) + GAMZ=WGAM(4) + AMW=WMASS(3) + IF (IBREM) THEN + SH=SHAT + JAC=2*(1.-SHAT/SCM)*2*SQRT(SH)*(RSHMAX-RSHMIN)/SCM/(X1+X2) + ELSE + SH=SCM + END IF + PROPZ=(SH-AMZ**2)**2+AMZ**2*GAMZ**2 + REDZ=(SH-AMZ**2)/PROPZ +C +C CONSTANTS + RSH=SQRT(SH) + EB=RSH/2. + QSQBM=QSQ + E=SQRT(4*PI*ALFAEM) + G=SQRT(4*PI*ALFAEM/SIN2W) + GP=G*SQRT(SIN2W/(1.-SIN2W)) + COS2W=1.-SIN2W + TNTHW=SQRT(SIN2W/COS2W) + CTTHW=1./TNTHW + ALQ(1)=CTTHW/4.-5*TNTHW/12. + BEQ(1)=-(CTTHW+TNTHW)/4. + ALQ(2)=TNTHW/12.-CTTHW/4. + BEQ(2)=-BEQ(1) + ALL(1)=(CTTHW+TNTHW)/4. + BEL(1)=-(CTTHW+TNTHW)/4. + ALL(2)=(3*TNTHW-CTTHW)/4. + BEL(2)=-BEL(1) + AE=ALL(2) + BE=BEL(2) +C +C ENTRY + SIG=0. + SIGMA=0. + NSIGS=0 + DO 10 I=1,MXSIGS +10 SIGS(I)=0. +C +C Sum over allowed jet types. IQ labels JETTYPE1. +C + DO 100 IQ=2,25 + IQ2=MATCH(IQ,4) + IF(.NOT.(GOQ(IQ,1).AND.GOQ(IQ2,2))) GO TO 100 + IFL=IQ/2 + EQ=ABS(FLOAT(IQ2EQ(IQ))/3.) + IF (EQ.LT..5.OR.EQ.GT..8) EQ=-EQ + ISGN=1 + IF(2*IFL.NE.IQ) ISGN=2 + AMQ=AMASS(IFL) + AMQ2=AMQ**2 + IF(2.*AMQ.GE.ECM) GO TO 100 + PCM=.5*SQRT(SH-4.*AMQ2) + Z=CTH(ISGN) + IF (IQ.LE.13.AND.ABS(EQ).GT..5) THEN + AF=ALQ(1) + BF=BEQ(1) + ELSE IF (IQ.LE.13.AND.ABS(EQ).LT..5) THEN + AF=ALQ(2) + BF=BEQ(2) + ELSE IF (IQ.GT.13.AND.ABS(EQ).EQ.0.) THEN + AF=ALL(1) + BF=BEL(1) + ELSE + AF=ALL(2) + BF=BEL(2) + END IF + PHILRG=EQ**2/SH**2*(EB**2*(1.+Z**2)+AMQ2*(1.-Z**2)) + PHILRZ=(AE-BE)**2/PROPZ*((AF**2+BF**2)*(EB**2+PCM**2*Z**2)- + , 4*AF*BF*EB*PCM*Z+(AF**2-BF**2)*AMQ2) + PHILRI=-2*EQ*(AE-BE)*REDZ/SH* + , (AF*(EB**2*(1.+Z**2)+AMQ2*(1.-Z**2))-2*BF*EB*PCM*Z) + PHILR=E**4*(PHILRG+PHILRZ+PHILRI) + PHIRLG=PHILRG + PHIRLZ=(AE+BE)**2/PROPZ*((AF**2+BF**2)*(EB**2+PCM**2*Z**2)+ + , 4*AF*BF*EB*PCM*Z+(AF**2-BF**2)*AMQ2) + PHIRLI=-2*EQ*(AE+BE)*REDZ/SH* + , (AF*(EB**2*(1.+Z**2)+AMQ2*(1.-Z**2))+2*BF*EB*PCM*Z) + PHIRL=E**4*(PHIRLG+PHIRLZ+PHIRLI) + SIGLR=4*PCM*PHILR/16./PI/EB + SIGRL=4*PCM*PHIRL/16./PI/EB + SIG=(FLEM*FREP*SIGLR+FREM*FLEP*SIGRL)*UNITS/2. + IF (IQ.LE.13) SIG=3*SIG + IF (IBREM.AND..NOT.IBEAM) THEN + SIG=SIG*ESTRUC(X1,QSQ)*ESTRUC(X2,QSQ)*JAC + ELSE IF (IBEAM) THEN + SIG=SIG*SSFEL(X1,0)*SSFEL(X2,0)*JAC + END IF + CALL SIGFIL(SIG,0,0,IQ,IQ2) +100 CONTINUE +C Z Z Cross section + IF(.NOT.(GOQ(29,1).AND.GOQ(29,2))) GO TO 200 + PCM=.5*SQRT(SH-4.*AMZ**2) + THT=AMZ**2-SH/2.+RSH*PCM*CTH(1) + UH=2*AMZ**2-SH-THT + SIGLR=4*E**4*(AE-BE)**4*PCM/16./PI/SH/RSH* + , (UH/THT+THT/UH+4*AMZ**2*SH/UH/THT-AMZ**4*(1./THT**2+1./UH**2)) + SIGRL=4*E**4*(AE+BE)**4*PCM/16./PI/SH/RSH* + , (UH/THT+THT/UH+4*AMZ**2*SH/UH/THT-AMZ**4*(1./THT**2+1./UH**2)) + SIG=(FLEM*FREP*SIGLR+FREM*FLEP*SIGRL)*UNITS/2. + IF (IBREM.AND..NOT.IBEAM) THEN + SIG=SIG*ESTRUC(X1,QSQ)*ESTRUC(X2,QSQ)*JAC + ELSE IF (IBEAM) THEN + SIG=SIG*SSFEL(X1,0)*SSFEL(X2,0)*JAC + END IF + CALL SIGFIL(SIG,0,0,29,29) +200 CONTINUE +C W W Cross section + IF(.NOT.(GOQ(27,1).AND.GOQ(28,2))) GO TO 300 + PCM=.5*SQRT(SH-4.*AMW**2) + THT=AMW**2-SH/2.+RSH*PCM*CTH(2) + UH=2*AMW**2-SH-THT + UT=UH*THT-AMW**4 + PHIRL=4*(AE+BE)**2*TNTHW**2/SH/SH/PROPZ* + , (UT*(PCM**2*SH+3*AMW**4)+4*AMW**2*PCM**2*SH*SH) + PHILR=UT/SH/SH*(3.+2*(AE-BE)*TNTHW*(SH-6*AMW**2)*REDZ+ + , 4*(AE-BE)**2*TNTHW**2*(PCM**2*SH+3*AMW**4)/PROPZ)+ + , 8*(AE-BE)*TNTHW*AMW**2*REDZ+16*(AE-BE)**2*TNTHW**2* + , AMW**2*PCM**2/PROPZ+2*(1.-2*(AE-BE)*TNTHW*AMW**2*REDZ)* + , (UT/SH/THT-2*AMW**2/THT)+UT/THT**2 + SIGLR=4*E**4*PCM/64./PI/SH/RSH/SIN2W**2*PHILR + SIGRL=4*E**4*PCM/64./PI/SH/RSH/SIN2W**2*PHIRL + SIG=(FLEM*FREP*SIGLR+FREM*FLEP*SIGRL)*UNITS/2. + IF (IBREM.AND..NOT.IBEAM) THEN + SIG=SIG*ESTRUC(X1,QSQ)*ESTRUC(X2,QSQ)*JAC + ELSE IF (IBEAM) THEN + SIG=SIG*SSFEL(X1,0)*SSFEL(X2,0)*JAC + END IF + CALL SIGFIL(SIG,0,0,27,28) +300 CONTINUE + IF(.NOT.(GOQ(28,1).AND.GOQ(27,2))) GO TO 400 + PCM=.5*SQRT(SH-4.*AMW**2) + THT=AMW**2-SH/2.+RSH*PCM*CTH(1) + UH=2*AMW**2-SH-THT + UT=UH*THT-AMW**4 + PHIRL=4*(AE+BE)**2*TNTHW**2/SH/SH/PROPZ* + , (UT*(PCM**2*SH+3*AMW**4)+4*AMW**2*PCM**2*SH*SH) + PHILR=UT/SH/SH*(3.+2*(AE-BE)*TNTHW*(SH-6*AMW**2)*REDZ+ + , 4*(AE-BE)**2*TNTHW**2*(PCM**2*SH+3*AMW**4)/PROPZ)+ + , 8*(AE-BE)*TNTHW*AMW**2*REDZ+16*(AE-BE)**2*TNTHW**2* + , AMW**2*PCM**2/PROPZ+2*(1.-2*(AE-BE)*TNTHW*AMW**2*REDZ)* + , (UT/SH/THT-2*AMW**2/THT)+UT/THT**2 + SIGLR=4*E**4*PCM/64./PI/SH/RSH/SIN2W**2*PHILR + SIGRL=4*E**4*PCM/64./PI/SH/RSH/SIN2W**2*PHIRL + SIG=(FLEM*FREP*SIGLR+FREM*FLEP*SIGRL)*UNITS/2. + IF (IBREM.AND..NOT.IBEAM) THEN + SIG=SIG*ESTRUC(X1,QSQ)*ESTRUC(X2,QSQ)*JAC + ELSE IF (IBEAM) THEN + SIG=SIG*SSFEL(X1,0)*SSFEL(X2,0)*JAC + END IF + CALL SIGFIL(SIG,0,0,28,27) +400 CONTINUE +C----------------------------------------------------------------------- + RETURN + END diff --git a/ISAJET/code/sigfil.F b/ISAJET/code/sigfil.F new file mode 100644 index 00000000000..91bc4ff8a61 --- /dev/null +++ b/ISAJET/code/sigfil.F @@ -0,0 +1,18 @@ +#include "isajet/pilot.h" + SUBROUTINE SIGFIL(SIG,I1,I2,I3,I4) +C Fill /JETSIG/ arrays if SIG > 0 +C Write error message if SIG < 0 +#include "isajet/itapes.inc" +#include "isajet/jetsig.inc" +C + IF(SIG.GT.0) THEN + NSIGS=NSIGS+1 + SIGMA=SIGMA+SIG + SIGS(NSIGS)=SIG + INOUT(NSIGS)=I1+IOPAK*(I2+IOPAK*(I3+IOPAK*I4)) + ELSEIF(SIG.LT.0.) THEN + WRITE(ITLIS,1010) SIG,I1,I2,I3,I4 +1010 FORMAT(' ERROR IN SIGFIL ... SIG = ',E12.5,' FOR ',4I6) + ENDIF + RETURN + END diff --git a/ISAJET/code/siggam.F b/ISAJET/code/siggam.F new file mode 100644 index 00000000000..bf0ea255e8e --- /dev/null +++ b/ISAJET/code/siggam.F @@ -0,0 +1,113 @@ +#include "isajet/pilot.h" + SUBROUTINE SIGGAM +C +C Compute D(SIGMA)/D(PT**2)D(Y1)D(Y2) for gamma + jet and +C gamma + gamma. +C +C SIGMA = cross section summed over quark types allowed by +C JETTYPE card. +C SIGS(I) = partial cross section for I1 + I2 --> I3 + I4. +C INOUT(I) = IOPAK**3*I4 + IOPAK**2*I3 + IOPAK*I2 + I1 +C using JETTYPE code. +C +C Cross sections from Berger, Bratten, and Field, Nucl. Phys. +C B239, 52 (1984), Table 2. Masses are neglected. +C +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/qcdpar.inc" +#include "isajet/jetpar.inc" +#include "isajet/primar.inc" +#include "isajet/q1q2.inc" +#include "isajet/jetsig.inc" +#include "isajet/const.inc" +#include "isajet/wcon.inc" +C + REAL BBF1,BBF2,BBF3,S,T,U,FJAC,STRUC,SIG0,SIG,BBF3TU,BBF3UT + INTEGER I,IH,IQ,IFL + REAL X(2),QSAVE(13,2) + INTEGER LISTJ(13) + EQUIVALENCE (X(1),X1),(S,SHAT),(T,THAT),(U,UHAT) + DATA LISTJ/9,1,-1,2,-2,3,-3,4,-4,5,-5,6,-6/ +C +C Cross sections with couplings and Jacobean removed. + BBF1(S,T,U)=8./9.*(U/T+T/U) + BBF2(S,T,U)=2./3.*(U/T+T/U) + BBF3(S,T,U)=-1./3.*(U/S+S/U) +C +C Initialize cross sections. +C + SIGMA=0. + NSIGS=0 + DO 100 I=1,MXSIGS + SIGS(I)=0. +100 CONTINUE +C +C Kinematics and structure functions for CH and lighter quarks +C + CALL TWOKIN(0.,0.,0.,0.) + FJAC=SHAT/SCM*UNITS*PI/SHAT**2 + IF(X1.GE.1.0.OR.X2.GE.1.0) RETURN + DO 110 IH=1,2 + DO 110 IQ=1,9 + QSAVE(IQ,IH)=STRUC(X(IH),QSQ,IQ,IDIN(IH))/X(IH) +110 CONTINUE +C +C Compute cross sections summed over all types allowed by +C JETTYPE card. +C + IF(.NOT.(GOQ(26,1).OR.GOQ(26,2))) RETURN +C +C Gluon-photon +C + IF((GOQ(1,1).AND.GOQ(26,2)).OR.(GOQ(26,1).AND.GOQ(1,2))) THEN + SIG0=.5*FJAC*ALFQSQ*ALFA*BBF1(S,T,U) + DO 210 I=1,4 + IFL=LISTJ(2*I) + SIG=SIG0*AQ(IFL,1)**2*QSAVE(2*I,1)*QSAVE(2*I+1,2) + IF(GOQ(26,1).AND.GOQ(1,2)) CALL SIGFIL(SIG,2*I,2*I+1,26,1) + IF(GOQ(1,1).AND.GOQ(26,2)) CALL SIGFIL(SIG,2*I,2*I+1,1,26) + SIG=SIG0*AQ(IFL,1)**2*QSAVE(2*I+1,1)*QSAVE(2*I,2) + IF(GOQ(26,1).AND.GOQ(1,2)) CALL SIGFIL(SIG,2*I+1,2*I,26,1) + IF(GOQ(1,1).AND.GOQ(26,2)) CALL SIGFIL(SIG,2*I+1,2*I,1,26) +210 CONTINUE + ENDIF +C +C Photon-photon +C + IF(GOQ(26,1).AND.GOQ(26,2)) THEN + SIG0=.5*FJAC*ALFA**2*BBF2(S,T,U) + DO 220 I=1,4 + IFL=LISTJ(2*I) + SIG=SIG0*AQ(IFL,1)**4*QSAVE(2*I,1)*QSAVE(2*I+1,2) + CALL SIGFIL(SIG,2*I,2*I+1,26,26) + SIG=SIG0*AQ(IFL,1)**4*QSAVE(2*I+1,1)*QSAVE(2*I,2) + CALL SIGFIL(SIG,2*I+1,2*I,26,26) +220 CONTINUE + ENDIF +C +C Quark-photon +C + BBF3TU=.5*FJAC*ALFA*ALFQSQ*BBF3(S,T,U) + BBF3UT=.5*FJAC*ALFA*ALFQSQ*BBF3(S,U,T) + DO 230 I=2,9 + IFL=IABS(LISTJ(I)) + IF(GOQ(26,1).AND.GOQ(I,2)) THEN + SIG=BBF3TU*AQ(IFL,1)**2*QSAVE(I,1)*QSAVE(1,2) + CALL SIGFIL(SIG,I,1,26,I) + SIG=BBF3UT*AQ(IFL,1)**2*QSAVE(1,1)*QSAVE(I,2) + CALL SIGFIL(SIG,1,I,26,I) + ENDIF + IF(GOQ(I,1).AND.GOQ(26,2)) THEN + SIG=BBF3UT*AQ(IFL,1)**2*QSAVE(I,1)*QSAVE(1,2) + CALL SIGFIL(SIG,I,1,I,26) + SIG=BBF3TU*AQ(IFL,1)**2*QSAVE(1,1)*QSAVE(I,2) + CALL SIGFIL(SIG,1,I,I,26) + ENDIF +230 CONTINUE +C + RETURN + END diff --git a/ISAJET/code/sigh.F b/ISAJET/code/sigh.F new file mode 100644 index 00000000000..6bbeb68cc3c --- /dev/null +++ b/ISAJET/code/sigh.F @@ -0,0 +1,366 @@ +#include "isajet/pilot.h" + SUBROUTINE SIGH +C +C COMPUTE THE INTEGRATED WEINBERG-SALAM HIGGS CROSS SECTION +C D(SIGMA)/D(QMW**2)D(YW) +C +C SIGMA = CROSS SECTION SUMMED OVER QUARK TYPES ALLOWED BY +C JETTYPE3 AND WTYPE CARDS. +C SIGS(I) = PARTIAL CROSS SECTION FOR I1 + I2 --> I3 + I4. +C INOUT(I) = IOPAK**3*I4 + IOPAK**2*I3 + IOPAK*I2 + I1 +C USING JETTYPE CODE. +C +C VER. 7.14: CHECK INITIAL QUARK MASS IS ALLOWED +C +#include "isajet/itapes.inc" +#include "isajet/qcdpar.inc" +#include "isajet/jetpar.inc" +#include "isajet/primar.inc" +#include "isajet/q1q2.inc" +#include "isajet/jetsig.inc" +#include "isajet/qsave.inc" +#include "isajet/wcon.inc" +#include "isajet/const.inc" +#include "isajet/jetlim.inc" +#include "isajet/hcon.inc" +C + DIMENSION AMQCUR(6),LISTW(4),WTHELI(4),FINT(9) + DIMENSION X(2) + EQUIVALENCE (S,SHAT),(T,THAT),(U,UHAT),(X(1),X1) +#if defined(CERNLIB_DOUBLE) + DOUBLE PRECISION C,TERM,SUM,FINT,ZLIM +#endif + DATA AMQCUR/.005,.009,.175,1.25,4.50,30./ + DATA LISTW/10,80,-80,90/ +C WTHELI ARE WEIGHTS OF HELICITY AMPLITUDES IN SIGMA. + DATA WTHELI/1.,2.,2.,4./ +C +C FUNCTIONS + ACOSH(Z)=ALOG(Z+SQRT(Z**2-1.)) + ATANH(Z)=.5*ALOG((1.+Z)/(1.-Z)) +C +C KINEMATICS (IDENTICAL TO DRELL-YAN) +C + AMQCUR(6)=AMASS(6) + QMW2=QMW**2 + QTMW=SQRT(QMW2+QTW**2) + Q0W=QTMW*COSH(YW) + QZW=QTMW*SINH(YW) + QW=SQRT(QZW**2+QTW**2) + IF(QW.NE.0.) THEN + CTHW=QZW/QW + STHW=QTW/QW + IF(ABS(CTHW).LT.1.) THEN + THW=ACOS(CTHW) + ELSE + CTHW=0. + STHW=1. + THW=.5*PI + ENDIF + ELSE + CTHW=0. + STHW=1. + THW=.5*PI + ENDIF + EHAT=QMW + SHAT=QMW**2 + QSQ=SHAT + ANEFF=4.+QSQ/(QSQ+AMASS(5)**2)+QSQ/(QSQ+AMASS(6)**2) + ALFQSQ=12.*PI/((33.-ANEFF)*ALOG(QSQ/ALAM2)) + Q2SAVE=QSQ + YHAT=YW + EY=EXP(YHAT) + X1=EHAT/ECM*EY + X2=EHAT/(ECM*EY) +C +C INITIALIZE +C + SIGMA=0. + NSIGS=0 + DO 100 I=1,MXSIGS +100 SIGS(I)=0 +C + IF(X1.GE.1..OR.X2.GE.1.) RETURN +C +C COMPUTE STRUCTURE FUNCTIONS + DO 110 IH=1,2 + DO 120 IQ=1,13 +120 QSAVE(IQ,IH)=STRUC(X(IH),QSQ,IQ,IDIN(IH))/X(IH) + DO 130 IQ=14,26 +130 QSAVE(IQ,IH)=0. + DO 140 IW=2,4 + AMW=AMASS(LISTW(IW)) + IF(QMW.GT.2.*AMW) THEN + QSAVE(25+IW,IH)=STRUCW(X(IH),IW,IDIN(IH))/X(IH) + ELSE + QSAVE(25+IW,IH)=0. + ENDIF +140 CONTINUE +110 CONTINUE +C +C CALCULATE HIGGS-GLUON-GLUON COUPLING FOR GIVEN Q**2 + ETAR=0. + ETAI=0. + DO 150 IQ=1,8 + AMQ=AMASS(IQ) + IF(AMQ.LE.0.) GO TO 150 + RQ=(2.*AMQ/HMASS)**2 + IF(RQ.GE.1.) THEN + ETAR=ETAR+.5*RQ*(1.+(1.-RQ)*ASIN(1./SQRT(RQ))**2) + ELSE + RQLOG=ALOG((1.+SQRT(1.-RQ))/(1.-SQRT(1.-RQ))) + PHIR=.25*(RQLOG**2-PI**2) + ETAR=ETAR+.5*RQ*(1.+(RQ-1.)*PHIR) + PHII=.5*PI*RQLOG + ETAI=ETAI+.5*RQ*(RQ-1.)*PHII + ENDIF +150 CONTINUE + ETAHGG=ETAR**2+ETAI**2 +C +C GL + GL --> HIGGS +C + SIG0=GF*ALFQSQ**2/(32.*PI*SQRT2)*ETAHGG*X1*X2*UNITS + SIG0=SIG0*S/(PI*HMASS*((S-HMASS**2)**2+(HMASS*HGAM)**2)) + SIG0=SIG0*QSAVE(1,1)*QSAVE(1,2) + DO 160 IQ1=2,29 + IQ2=MATCHH(IQ1) + IF(GOQ(IQ1,1).AND.GOQ(IQ2,2)) THEN + SIG=SIG0*HGAMS(IQ1) + IF(IQ1.GT.25) SIG=SIG*TBRWW(IQ1-25,1)*TBRWW(IQ2-25,2) + CALL SIGFIL(SIG,1,1,IQ1,IQ2) + ENDIF +160 CONTINUE +C +C QK + QB --> HIGGS +C + SIG0=PI*GF/(3.*SQRT2*HMASS**2)*X1*X2*UNITS + SIG0=SIG0*S/(PI*HMASS*((S-HMASS**2)**2+(HMASS*HGAM)**2)) + DO 210 IQ1=2,13 + IQ2=MATCHH(IQ1) + AMQ=AMQCUR(IQ1/2) + IF(QMW.LE.2*AMQ) GO TO 210 + SIG1=SIG0*AMQ**2*QSAVE(IQ1,1)*QSAVE(IQ2,2) + DO 220 IQ3=2,29 + IQ4=MATCHH(IQ3) + IF(GOQ(IQ3,1).AND.GOQ(IQ4,2)) THEN + SIG=SIG1*HGAMS(IQ3) + IF(IQ3.GT.25) SIG=SIG*TBRWW(IQ3-25,1)*TBRWW(IQ4-25,2) + CALL SIGFIL(SIG,IQ1,IQ2,IQ3,IQ4) + ENDIF +220 CONTINUE +210 CONTINUE +C +C W+W FUSION AND W+W->W+W IN EFFECTIVE W APPROXIMATION WITH +C ANGULAR DISTRIBUTION CUT OFF BY PTMIN. +C Z0 Z0 FINAL STATE HAS SYMMETRY FACTOR OF .5 +C + IF(QMW.LE.2.*AMASS(80)) GO TO 500 +C +C W+ W- --> W+ W- +C + IF(.NOT.((GOQ(27,1).AND.GOQ(28,2)).OR.(GOQ(28,1).AND.GOQ(27,2)))) + $GO TO 400 + WM=AMASS(80) + PWWCM=.5*SQRT(QMW**2-4.*WM**2) + STHLIM=PTMIN(1)/PWWCM + IF(STHLIM.LE.1) THEN + ZLIM=SQRT(1.-STHLIM**2) + ELSE + GO TO 400 + ENDIF +C SET UP AMPLITUDES + CALL XWWWW +C SUM CROSS SECTION TERMS. I,J RUN OVER AMPLITUDE TERMS. +C L RUNS OVER HELICITY STATES. N RUNS OVER POWERS. +C REMEMBER THAT L=4 IS MISSING SIN(THETA)/SQRT(2) + SUM=0. + DO 311 I=1,4 + DO 311 J=I,4 + CALL SIGINT(FINT,ZLIM,ADWWWW(1,I),ADWWWW(2,I),ADWWWW(1,J), + $ADWWWW(2,J)) + DO 312 L=1,4 + TERM=0. + DO 313 N=0,6 + C=0. + N1=MAX(N-3,0) + N2=MIN(3,N) + DO 314 K=N1,N2 +314 C=C+ANWWWW(K+1,I,L)*ANWWWW(N-K+1,J,L) + C=C*WTHELI(L) + IF(J.NE.I) C=2.*C + IF(L.EQ.4) THEN + TERM=TERM+.5*C*FINT(N+1)-.5*C*FINT(N+3) + ELSE + TERM=TERM+C*FINT(N+1) + ENDIF +313 CONTINUE + SUM=SUM+TERM +312 CONTINUE +311 CONTINUE +C ADD INTEGRAL OF IMAGINARY PART SQUARED. + SUM=SUM+2.*ZLIM*(WTHELI(1)*AIWWWW(1)**2+WTHELI(2)*AIWWWW(2)**2 + $+WTHELI(3)*AIWWWW(3)**2+WTHELI(4)*AIWWWW(4)**2) +C CROSS SECTION + SIG0=SUM/(32.*PI*S*SCM)*UNITS + SIG1=.5*SIG0*QSAVE(27,1)*QSAVE(28,2) + IF(GOQ(27,1).AND.GOQ(28,2)) THEN + SIG=SIG1*TBRWW(2,1)*TBRWW(3,2) + CALL SIGFIL(SIG,27,28,27,28) + ENDIF + IF(GOQ(28,1).AND.GOQ(27,2)) THEN + SIG=SIG1*TBRWW(3,1)*TBRWW(2,2) + CALL SIGFIL(SIG,27,28,28,27) + ENDIF + SIG1=.5*SIG0*QSAVE(28,1)*QSAVE(27,2) + IF(GOQ(27,1).AND.GOQ(28,2)) THEN + SIG=SIG1*TBRWW(2,1)*TBRWW(3,2) + CALL SIGFIL(SIG,28,27,27,28) + ENDIF + IF(GOQ(28,1).AND.GOQ(27,2)) THEN + SIG=SIG1*TBRWW(3,1)*TBRWW(2,2) + CALL SIGFIL(SIG,28,27,28,27) + ENDIF +C +C Z0 Z0 --> W+ W- +C +C SET UP AMPLITUDES + IF(QMW.LE.2.*AMASS(90)) GO TO 500 + CALL XZZWW +C SUM CROSS SECTION TERMS. I,J RUN OVER AMPLITUDE TERMS. +C L RUNS OVER HELICITY STATES. N RUNS OVER POWERS. +C REMEMBER THAT L=4 IS MISSING SIN(THETA)/SQRT(2) + SUM=0. + DO 321 I=1,4 + DO 321 J=I,4 + CALL SIGINT(FINT,ZLIM,ADWWWW(1,I),ADWWWW(2,I),ADWWWW(1,J), + $ADWWWW(2,J)) + DO 322 L=1,4 + TERM=0. + DO 323 N=0,6 + C=0. + N1=MAX(N-3,0) + N2=MIN(3,N) + DO 324 K=N1,N2 +324 C=C+ANWWWW(K+1,I,L)*ANWWWW(N-K+1,J,L) + C=C*WTHELI(L) + IF(J.NE.I) C=2.*C + IF(L.EQ.4) THEN + TERM=TERM+.5*C*FINT(N+1)-.5*C*FINT(N+3) + ELSE + TERM=TERM+C*FINT(N+1) + ENDIF +323 CONTINUE + SUM=SUM+TERM +322 CONTINUE +321 CONTINUE +C ADD INTEGRAL OF IMAGINARY PART SQUARED. + SUM=SUM+2.*ZLIM*(WTHELI(1)*AIWWWW(1)**2+WTHELI(2)*AIWWWW(2)**2 + $+WTHELI(3)*AIWWWW(3)**2+WTHELI(4)*AIWWWW(4)**2) +C CROSS SECTION + SIG0=SUM/(32.*PI*S*SCM)*UNITS + SIG1=.5*SIG0*QSAVE(29,1)*QSAVE(29,2) + IF(GOQ(27,1).AND.GOQ(28,2)) THEN + SIG=SIG1*TBRWW(2,1)*TBRWW(3,2) + CALL SIGFIL(SIG,29,29,27,28) + ENDIF + IF(GOQ(28,1).AND.GOQ(27,2)) THEN + SIG=SIG1*TBRWW(3,1)*TBRWW(2,2) + CALL SIGFIL(SIG,29,29,28,27) + ENDIF +C +C W+ W- --> Z0 Z0 +C +400 IF(QMW.LE.2.*AMASS(90)) GO TO 500 + IF(.NOT.(GOQ(29,1).AND.GOQ(29,2))) GO TO 500 + WM=AMASS(90) + PWWCM=.5*SQRT(QMW**2-4.*WM**2) + STHLIM=PTMIN(1)/PWWCM + IF(STHLIM.LE.1) THEN + ZLIM=SQRT(1.-STHLIM**2) + ELSE + GO TO 500 + ENDIF +C SET UP AMPLITUDES + CALL XWWZZ +C SUM CROSS SECTION TERMS. I,J RUN OVER AMPLITUDE TERMS. +C L RUNS OVER HELICITY STATES. N RUNS OVER POWERS. +C REMEMBER THAT L=4 IS MISSING SIN(THETA)/SQRT(2) + SUM=0. + DO 411 I=1,4 + DO 411 J=I,4 + CALL SIGINT(FINT,ZLIM,ADWWWW(1,I),ADWWWW(2,I),ADWWWW(1,J), + $ADWWWW(2,J)) + DO 412 L=1,4 + TERM=0. + DO 413 N=0,6 + C=0. + N1=MAX(N-3,0) + N2=MIN(3,N) + DO 414 K=N1,N2 +414 C=C+ANWWWW(K+1,I,L)*ANWWWW(N-K+1,J,L) + C=C*WTHELI(L) + IF(J.NE.I) C=2.*C + IF(L.EQ.4) THEN + TERM=TERM+.5*C*FINT(N+1)-.5*C*FINT(N+3) + ELSE + TERM=TERM+C*FINT(N+1) + ENDIF +413 CONTINUE + SUM=SUM+TERM +412 CONTINUE +411 CONTINUE +C ADD INTEGRAL OF IMAGINARY PART SQUARED. + SUM=SUM+2.*ZLIM*(WTHELI(1)*AIWWWW(1)**2+WTHELI(2)*AIWWWW(2)**2 + $+WTHELI(3)*AIWWWW(3)**2+WTHELI(4)*AIWWWW(4)**2) +C CROSS SECTION + SIG0=SUM/(32.*PI*S*SCM)*UNITS + SIG0=.5*SIG0 + SIG0=SIG0*TBRWW(4,1)*TBRWW(4,2) + SIG=SIG0*QSAVE(27,1)*QSAVE(28,2) + CALL SIGFIL(SIG,27,28,29,29) + SIG=SIG0*QSAVE(28,1)*QSAVE(27,2) + CALL SIGFIL(SIG,28,27,29,29) +C +C Z0 Z0 --> Z0 Z0 +C +C SET UP AMPLITUDES + CALL XZZZZ +C SUM CROSS SECTION TERMS. I,J RUN OVER AMPLITUDE TERMS. +C L RUNS OVER HELICITY STATES. N RUNS OVER POWERS. +C REMEMBER THAT L=4 IS MISSING SIN(THETA)/SQRT(2) + SUM=0. + DO 421 I=1,4 + DO 421 J=I,4 + CALL SIGINT(FINT,ZLIM,ADWWWW(1,I),ADWWWW(2,I),ADWWWW(1,J), + $ADWWWW(2,J)) + DO 422 L=1,4 + TERM=0. + DO 423 N=0,6 + C=0. + N1=MAX(N-3,0) + N2=MIN(3,N) + DO 424 K=N1,N2 +424 C=C+ANWWWW(K+1,I,L)*ANWWWW(N-K+1,J,L) + C=C*WTHELI(L) + IF(J.NE.I) C=2.*C + IF(L.EQ.4) THEN + TERM=TERM+.5*C*FINT(N+1)-.5*C*FINT(N+3) + ELSE + TERM=TERM+C*FINT(N+1) + ENDIF +423 CONTINUE + SUM=SUM+TERM +422 CONTINUE +421 CONTINUE +C ADD INTEGRAL OF IMAGINARY PART SQUARED. + SUM=SUM+2.*ZLIM*(WTHELI(1)*AIWWWW(1)**2+WTHELI(2)*AIWWWW(2)**2 + $+WTHELI(3)*AIWWWW(3)**2+WTHELI(4)*AIWWWW(4)**2) +C CROSS SECTION + SIG0=SUM/(32.*PI*S*SCM)*UNITS + SIG0=.5*SIG0 + SIG0=SIG0*TBRWW(4,1)*TBRWW(4,2) + SIG=SIG0*QSAVE(29,1)*QSAVE(29,2) + CALL SIGFIL(SIG,29,29,29,29) +C +500 RETURN + END diff --git a/ISAJET/code/sigh2.F b/ISAJET/code/sigh2.F new file mode 100644 index 00000000000..9e7054a73be --- /dev/null +++ b/ISAJET/code/sigh2.F @@ -0,0 +1,104 @@ +#include "isajet/pilot.h" + SUBROUTINE SIGH2 +C +C COMPUTE THE WEINBERG-SALAM HIGGS CROSS SECTION +C D(SIGMA)/D(QMW**2)D(YW)D(OMEGA) +C FOR THE SPECIFIED JET TYPES. TRIVIAL EXCEPT FOR W W FUSION, +C WHICH HAS INTERFERENCE WITH W W SCATTERING. +C +#include "isajet/itapes.inc" +#include "isajet/qcdpar.inc" +#include "isajet/jetpar.inc" +#include "isajet/pjets.inc" +#include "isajet/primar.inc" +#include "isajet/q1q2.inc" +#include "isajet/jetsig.inc" +#include "isajet/wsig.inc" +#include "isajet/qsave.inc" +#include "isajet/wcon.inc" +#include "isajet/const.inc" +#include "isajet/hcon.inc" +C + DIMENSION X(2),LISTJ(29),WTHELI(4) + EQUIVALENCE (S,SHAT),(T,THAT),(U,UHAT),(X(1),X1) +#if defined(CERNLIB_DOUBLE) + DOUBLE PRECISION C,TERM,SUM,DENOM,ZCM +#endif +C +C WTHELI ARE WEIGHTS OF HELICITY AMPLITUDES IN SIGMA. + DATA WTHELI/1.,2.,2.,4./ + DATA LISTJ/ + $9,1,-1,2,-2,3,-3,4,-4,5,-5,6,-6, + $11,-11,12,-12,13,-13,14,-14,15,-15,16,-16, + $10,80,-80,90/ +C +C QUARK OR GLUON FUSION TO HIGGS +C + IF(INITYP(1).LE.25) THEN + SIGLLQ=SIGEVT/(4.*PI) + RETURN + ENDIF +C +C W+W FUSION AND W+W->W+W IN EFFECTIVE W APPROXIMATION. +C +C KINEMATICS + IFL1=LISTJ(JETTYP(1)) + IFL2=LISTJ(JETTYP(2)) + IFIN1=LISTJ(INITYP(1)) + IFIN2=LISTJ(INITYP(2)) + WMF=AMASS(IFL1) + WMI=AMASS(IFIN1) + PINPF=SQRT((S-4.*WMI**2)*(S-4.*WMF**2)) + ZCM=(.5*S+T-WMI**2-WMF**2)/(.5*PINPF) +C RESET COEFFICIENTS FOR SELECTED PROCESS + IABSI=IABS(IFIN1) + IABSF=IABS(IFL1) + IF(IABSI.EQ.80) THEN + IF(IABSF.EQ.80) THEN + CALL XWWWW + ELSE + CALL XWWZZ + ENDIF + ELSE + IF(IABSF.EQ.80) THEN + CALL XZZWW + ELSE + CALL XZZZZ + ENDIF + ENDIF +C SUM CROSS SECTION TERMS. I,J RUN OVER AMPLITUDE TERMS. +C L RUNS OVER HELICITY STATES. N RUNS OVER POWERS. +C REMEMBER THAT L=4 IS MISSING SIN(THETA)/SQRT(2) + SUM=0. + DO 111 I=1,4 + DO 111 J=I,4 + DENOM=1./((ADWWWW(1,I)+ADWWWW(2,I)*ZCM) + $*(ADWWWW(1,J)+ADWWWW(2,J)*ZCM)) + DO 112 L=1,4 + TERM=0. + DO 113 N=0,6 + C=0. + N1=MAX(N-3,0) + N2=MIN(3,N) + DO 114 K=N1,N2 +114 C=C+ANWWWW(K+1,I,L)*ANWWWW(N-K+1,J,L) + C=C*WTHELI(L) + IF(J.NE.I) C=2.*C + TERM=TERM+C*ZCM**N +113 CONTINUE + IF(L.EQ.4) TERM=TERM*(1.-ZCM**2)/2. + TERM=TERM*DENOM + SUM=SUM+TERM +112 CONTINUE +111 CONTINUE +C ADD IMAGINARY PART SQUARED. + SUM=SUM+WTHELI(1)*AIWWWW(1)**2+WTHELI(2)*AIWWWW(2)**2 + $+WTHELI(3)*AIWWWW(3)**2+WTHELI(4)*AIWWWW(4)**2 +C CROSS SECTION. NOTE D(OMEGA)=2.*PI*D(Z) + SIG0=SUM/(64.*PI**2*S*SCM)*UNITS + SIG0=SIG0*TBRWW(JETTYP(1)-25,1)*TBRWW(JETTYP(2)-25,2) +C SYMMETRY FACTOR + IF(IABSF.EQ.90) SIG0=.5*SIG0 + SIGLLQ=SIG0*QSAVE(INITYP(1),1)*QSAVE(INITYP(2),2) + RETURN + END diff --git a/ISAJET/code/sigh3.F b/ISAJET/code/sigh3.F new file mode 100644 index 00000000000..cb44c4761c8 --- /dev/null +++ b/ISAJET/code/sigh3.F @@ -0,0 +1,270 @@ +#include "isajet/pilot.h" + SUBROUTINE SIGH3 +C +C Calculate angular distributions for W decays from Higgs, +C d(sigma)/d(qmw**2)d(yw)d(omega)d(omega1)d(omega2) +C +C Ver 7.14: Only modification needed for MSSM is to check +C GOMSSM flag instead of INITYP +C +#include "isajet/itapes.inc" +#include "isajet/qcdpar.inc" +#include "isajet/jetpar.inc" +#include "isajet/pjets.inc" +#include "isajet/primar.inc" +#include "isajet/q1q2.inc" +#include "isajet/jetsig.inc" +#include "isajet/wsig.inc" +#include "isajet/wwsig.inc" +#include "isajet/qsave.inc" +#include "isajet/wcon.inc" +#include "isajet/const.inc" +#include "isajet/wwpar.inc" +#include "isajet/hcon.inc" +#include "isajet/xmssm.inc" +C + EQUIVALENCE (S,SHAT),(T,THAT),(U,UHAT) + DIMENSION IDADDR(4),IW(2),LAM(3),LISTJ(29) + $,T12(3,3),T34(3,3),FTERM(4),FR(3,3),FI(3,3) + $,CPHI12(3),SPHI12(3),CPHI34(3),SPHI34(3) + DIMENSION PFCM(5,4),PWCM(5,2) +#if defined(CERNLIB_DOUBLE) + DOUBLE PRECISION TERM,FTERM,ZCM +#endif + DATA LAM/0,1,-1/ + DATA LISTJ/ + $9,1,-1,2,-2,3,-3,4,-4,5,-5,6,-6, + $11,-11,12,-12,13,-13,14,-14,15,-15,16,-16, + $10,80,-80,90/ +C +C FUNCTIONS + DOTP(I,J)=PPAIR(4,I)*PPAIR(4,J)-PPAIR(1,I)*PPAIR(1,J) + $-PPAIR(2,I)*PPAIR(2,J)-PPAIR(3,I)*PPAIR(3,J) +C +C ENTRY + IF(NPAIR.NE.4) RETURN +C +C RECONSTRUCT W-->FF DECAY ANGLES +C +C INITIALIZE PFCM AND PWCM + DO 10 I=1,4 + DO 10 K=1,5 +10 PFCM(K,I)=PPAIR(K,I) + DO 11 I=1,2 + DO 11 K=1,5 +11 PWCM(K,I)=PJETS(K,I) +C +C Z BOOST TO WW CENTER OF MASS + CHWW=QWJET(4)/QWJET(5) + SHWW=QWJET(3)/QWJET(5) + DO 20 I=1,4 + TMP=CHWW*PFCM(4,I)-SHWW*PFCM(3,I) + PFCM(3,I)=-SHWW*PFCM(4,I)+CHWW*PFCM(3,I) +20 PFCM(4,I)=TMP + DO 21 I=1,2 + TMP=CHWW*PWCM(4,I)-SHWW*PWCM(3,I) + PWCM(3,I)=-SHWW*PWCM(4,I)+CHWW*PWCM(3,I) +21 PWCM(4,I)=TMP +C +C ROTATE W1 TO +Z AXIS + PTW1=SQRT(PWCM(1,1)**2+PWCM(2,1)**2) + CPHIW1=PWCM(1,1)/PTW1 + SPHIW1=PWCM(2,1)/PTW1 + PW1=SQRT(PTW1**2+PWCM(3,1)**2) + CTHW1=PWCM(3,1)/PW1 + STHW1=PTW1/PW1 +C Z ROTATION + DO 30 I=1,4 + TMP=CPHIW1*PFCM(1,I)+SPHIW1*PFCM(2,I) + PFCM(2,I)=-SPHIW1*PFCM(1,I)+CPHIW1*PFCM(2,I) +30 PFCM(1,I)=TMP +C Y ROTATION + DO 31 I=1,4 + TMP=CTHW1*PFCM(1,I)-STHW1*PFCM(3,I) + PFCM(3,I)=STHW1*PFCM(1,I)+CTHW1*PFCM(3,I) +31 PFCM(1,I)=TMP +C +C BOOST TO W REST FRAMES + CHW1=PWCM(4,1)/PWCM(5,1) + SHW1=PW1/PWCM(5,1) + DO 40 I=1,4 + IF(I.LE.2) THEN + SHWI=SHW1 + ELSE + SHWI=-SHW1 + ENDIF + TMP=CHW1*PFCM(4,I)-SHWI*PFCM(3,I) + PFCM(3,I)=-SHWI*PFCM(4,I)+CHW1*PFCM(3,I) +40 PFCM(4,I)=TMP +C +C COMPUTE ANGLES + TH12=ACOS(PFCM(3,1)/SQRT(PFCM(1,1)**2+PFCM(2,1)**2+PFCM(3,1)**2)) + PHI12=ATAN2(PFCM(2,1),PFCM(1,1)) + TH34=ACOS(PFCM(3,3)/SQRT(PFCM(1,3)**2+PFCM(2,3)**2+PFCM(3,3)**2)) + PHI34=ATAN2(PFCM(2,3),PFCM(1,3)) +C +C COMPUTE DECAY ANGULAR DISTRIBUTIONS. +C + DO 100 I=1,4 + IDADDR(I)=IABS(IDPAIR(I)) +100 IF(IDADDR(I).GE.11) IDADDR(I)=IDADDR(I)-4 + IF(GOMSSM) THEN + IW(1)=JETTYP(1)-76 + IW(2)=JETTYP(2)-76 + ELSE + IW(1)=JETTYP(1)-25 + IW(2)=JETTYP(2)-25 + ENDIF +C + AMV=PJETS(5,1) + GAMV=WGAM(IW(1)) + QMH=QMW +C COUPLINGS + A12=AQ(IDADDR(1),IW(1)) + B12=BQ(IDADDR(1),IW(1)) + A34=AQ(IDADDR(3),IW(2)) + B34=BQ(IDADDR(3),IW(2)) +C DECAY DISTRIBUTIONS + TVV12=8.*PI*ALFA*(A12**2+B12**2) + TVA12=16.*PI*ALFA*A12*B12 + COS12=COS(TH12) + SIN12=SIN(TH12) + T12(1,1)=TVV12*SIN12**2 + T12(1,2)=TVV12*SIN12*COS12/SQRT2+TVA12*SIN12/SQRT2 + T12(1,3)=-TVV12*SIN12*COS12/SQRT2+TVA12*SIN12/SQRT2 + T12(2,1)=T12(1,2) + T12(2,2)=TVV12*(.5+.5*COS12**2)+TVA12*COS12 + T12(2,3)=TVV12*.5*SIN12**2 + T12(3,1)=T12(1,3) + T12(3,2)=T12(2,3) + T12(3,3)=TVV12*(.5+.5*COS12**2)-TVA12*COS12 +C + TVV34=8.*PI*ALFA*(A34**2+B34**2) + TVA34=16.*PI*ALFA*A34*B34 + COS34=COS(TH34) + SIN34=SIN(TH34) + T34(1,1)=TVV34*SIN34**2 + T34(1,2)=TVV34*SIN34*COS34/SQRT2+TVA34*SIN34/SQRT2 + T34(1,3)=-TVV34*SIN34*COS34/SQRT2+TVA34*SIN34/SQRT2 + T34(2,1)=T34(1,2) + T34(2,2)=TVV34*(.5+.5*COS34**2)+TVA34*COS34 + T34(2,3)=TVV34*.5*SIN34**2 + T34(3,1)=T34(1,3) + T34(3,2)=T34(2,3) + T34(3,3)=TVV34*(.5+.5*COS34**2)-TVA34*COS34 +C + CPHI12(1)=1. + CPHI12(2)=COS(PHI12) + CPHI12(3)=COS(2.*PHI12) + SPHI12(1)=0. + SPHI12(2)=SIN(PHI12) + SPHI12(3)=SIN(2.*PHI12) + CPHI34(1)=1. + CPHI34(2)=COS(PHI34) + CPHI34(3)=COS(2.*PHI34) + SPHI34(1)=0. + SPHI34(2)=SIN(PHI34) + SPHI34(3)=SIN(2.*PHI34) +C + TCPHI=CPHI12(2)*CPHI34(2)-SPHI12(2)*SPHI34(2) + TSPHI=SPHI12(2)*CPHI34(2)+CPHI12(2)*SPHI34(2) + TC2PHI=CPHI12(3)*CPHI34(3)-SPHI12(3)*SPHI34(3) + TS2PHI=SPHI12(3)*CPHI34(3)+CPHI12(3)*SPHI34(3) +C +C PURE HIGGS --> W W. CALCULATE ANGULAR DISTRIBUTION FOR +C HIGGS DECAY AND MULTIPLY BY CROSS SECTION. +C + IF(INITYP(1).LE.25.OR.GOMSSM) THEN + F0=.5*QMH**2/AMV**2-1. + F1=1. + TOTAL=(8.*PI/3.)**2*TVV12*TVV34*(F0**2+2.*F1**2) + DIFF=F0**2*T12(1,1)*T34(1,1) + $ +F0*F1*(2.*T12(1,2)*T34(1,2)+2.*T12(1,3)*T34(1,3))*TCPHI + $ +F1**2*(T12(2,2)*T34(1,2)+T12(3,3)*T34(3,3) + $ +2.*T12(2,3)*T34(2,3)*TC2PHI) + WWSIG=SIGLLQ*DIFF/TOTAL + RETURN + ENDIF +C +C W W FUSION. CALCULATE ANGULAR DISTRIUBTION FOR DECAY +C INCLUDING ALL GRAPHS. +C +C KINEMATICS + IFL1=LISTJ(JETTYP(1)) + IFL2=LISTJ(JETTYP(2)) + IFIN1=LISTJ(INITYP(1)) + IFIN2=LISTJ(INITYP(2)) + WMF=AMASS(IFL1) + WMI=AMASS(IFIN1) + PINPF=SQRT((S-4.*WMI**2)*(S-4.*WMF**2)) + ZCM=(.5*S+T-WMI**2-WMF**2)/(.5*PINPF) +C PRODUCTION AMPLITUDES. REMEMBER MISSING SIN(THETA)/SQRT(2) + DO 110 L=1,4 + FTERM(L)=0. + DO 120 J=1,4 + TERM=0. + DO 130 I=1,4 +130 TERM=TERM+ANWWWW(I,J,L)*ZCM**(I-1) + TERM=TERM/(ADWWWW(1,J)+ADWWWW(2,J)*ZCM) +120 FTERM(L)=FTERM(L)+TERM +110 CONTINUE + FTERM(4)=FTERM(4)*SQRT(ABS(1.-ZCM**2))/SQRT2 +C HELICITY AMPLITUDES. NOTATION IS 0,+,- + FR(1,1)=FTERM(1) + FI(1,1)=AIWWWW(1) + FR(1,2)=FTERM(4) + FI(1,2)=AIWWWW(4) + FR(2,2)=FTERM(3) + FI(2,2)=AIWWWW(3) + FR(2,3)=FTERM(2) + FI(2,3)=AIWWWW(2) +C + FR(1,3)=FR(1,2) + FI(1,3)=FI(1,2) + FR(3,1)=FR(1,3) + FI(3,1)=FI(1,3) + FR(2,1)=FR(1,2) + FI(2,1)=FI(1,2) +C + FR(3,3)=FR(2,2) + FI(3,3)=FI(2,2) + FR(3,2)=FR(2,3) + FI(3,2)=FI(2,3) +C +C DIFFERENTIAL DISTRIBUTION FROM DENSITY MATRIX + DIFF=0. + DO 140 I1=1,3 + L1=LAM(I1) + DO 140 I2=1,3 + L2=LAM(I2) + DO 140 I3=1,3 + L3=LAM(I3) + DO 140 I4=1,3 + L4=LAM(I4) + L12=L1-L2 + I12=IABS(L12)+1 + IF(I12.EQ.0) I12=3 + L34=L3-L4 + I34=IABS(L34)+1 + IF(I34.EQ.0) I34=3 + C1234=CPHI12(I12)*CPHI34(I34) + $-SPHI12(I12)*ISIGN(1,L12)*SPHI34(I34)*ISIGN(1,L34) + S1234=SPHI12(I12)*ISIGN(1,L12)*CPHI34(I34) + $+CPHI12(I12)*SPHI34(I34)*ISIGN(1,L34) + DIFF=DIFF+(FR(I1,I2)*FR(I3,I4)+FI(I1,I2)*FI(I3,I4)) + $*T12(I3,I1)*T34(I4,I2)*C1234 + $+(FR(I1,I2)*FI(I3,I4)-FI(I1,I2)*FR(I3,I4)) + $*T12(I3,I1)*T34(I4,I2)*S1234 +140 CONTINUE +C INTEGRATED DISTRIBUTION + TOTAL=0. + DO 150 I1=1,3 + DO 150 I2=1,3 + TOTAL=TOTAL+FR(I1,I2)**2+FI(I1,I2)**2 +150 CONTINUE + FAC=(16.*PI/3.*4.*PI*ALFA)**2 + FAC=FAC*(A12**2+B12**2)*(A34**2+B34**2) + TOTAL=TOTAL*FAC + WWSIG=DIFF/TOTAL*SIGLLQ + RETURN + END diff --git a/ISAJET/code/sighss.F b/ISAJET/code/sighss.F new file mode 100644 index 00000000000..b1f20ee27f3 --- /dev/null +++ b/ISAJET/code/sighss.F @@ -0,0 +1,139 @@ +#include "isajet/pilot.h" + SUBROUTINE SIGHSS +C +C Compute the integrated MSSM Higgs cross section +C d(sigma)/d(QMW**2)d(YW) +C Since SUSY Higgs are always narrow, can use the widths to +C determine couplings and ignore interference with continuum. +C +C SIGMA = cross section summed over quark types allowed by +C JETTYPE and WTYPE cards. +C SIGS(I) = partial cross section for I1 + I2 --> I3 + I4. +C INOUT(I) = IOPAK**3*I4 + IOPAK**2*I3 + IOPAK*I2 + I1 +C using JETTYPE code from LISTSS. +C +C Ver 7.18: Correct GOQ's and include TBRWW for W/Z modes. +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/qcdpar.inc" +#include "isajet/jetpar.inc" +#include "isajet/primar.inc" +#include "isajet/q1q2.inc" +#include "isajet/jetsig.inc" +#include "isajet/qsave.inc" +#include "isajet/wcon.inc" +#include "isajet/const.inc" +#include "isajet/jetlim.inc" +#include "isajet/hcon.inc" +C + REAL X(2) + REAL AMASS,STRUC + REAL AM1,AM2,S,T,U,Q2SAVE,YHAT,EY,ANEFF,QMW2,QZW,EHAT,SIG0,SIG, + $AMW + INTEGER JT1,JT2,I,J,IH,IQ,I1,I2,JTGL,JTOFF + EQUIVALENCE (S,SHAT),(T,THAT),(U,UHAT),(X(1),X1) +C +C Kinematics (identical to Drell-Yan) +C + QMW2=QMW**2 + QTMW=SQRT(QMW2+QTW**2) + Q0W=QTMW*COSH(YW) + QZW=QTMW*SINH(YW) + QW=SQRT(QZW**2+QTW**2) + IF(QW.NE.0.) THEN + CTHW=QZW/QW + STHW=QTW/QW + IF(ABS(CTHW).LT.1.) THEN + THW=ACOS(CTHW) + ELSE + CTHW=0. + STHW=1. + THW=.5*PI + ENDIF + ELSE + CTHW=0. + STHW=1. + THW=.5*PI + ENDIF + EHAT=QMW + SHAT=QMW**2 + QSQ=SHAT + ANEFF=4.+QSQ/(QSQ+AMASS(5)**2)+QSQ/(QSQ+AMASS(6)**2) + ALFQSQ=12.*PI/((33.-ANEFF)*ALOG(QSQ/ALAM2)) + Q2SAVE=QSQ + YHAT=YW + EY=EXP(YHAT) + X1=EHAT/ECM*EY + X2=EHAT/(ECM*EY) +C +C Initialize +C + SIGMA=0. + NSIGS=0 + DO 100 I=1,MXSIGS +100 SIGS(I)=0 + IF(X1.GE.1..OR.X2.GE.1.) RETURN +C +C Compute structure functions +C + DO 110 IH=1,2 + DO 120 IQ=1,13 +120 QSAVE(IQ,IH)=STRUC(X(IH),QSQ,IQ,IDIN(IH))/X(IH) + DO 130 IQ=14,26 +130 QSAVE(IQ,IH)=0. +110 CONTINUE +C +C gl + gl -> Higgs +C + JTGL=52 + SIG0=PI*HMASS**2/(8*S**2)*HGAMSS(JTGL,JTGL)*X1*X2*UNITS + $/((S-HMASS**2)**2+(HMASS*HGAM)**2) + SIG0=SIG0*QSAVE(1,1)*QSAVE(1,2) + DO 200 I=1,85 + DO 210 J=1,85 + IF(HGAMSS(I,J).EQ.0) GO TO 210 + IF(.NOT.(GOQ(I,1).AND.GOQ(J,2))) GO TO 210 + SIG=SIG0*HGAMSS(I,J) +C Include W/Z branching ratios + IF((I.GE.78.AND.I.LE.80).AND.(J.GE.78.AND.J.LE.80)) THEN + SIG=SIG*TBRWW(I-76,1)*TBRWW(J-76,2) + ENDIF + CALL SIGFIL(SIG,JTGL,JTGL,I,J) +210 CONTINUE +200 CONTINUE +C +C qk + qb -> Higgs +C + JTOFF=51 +C Note I1,I2 run over quarks; JT1,JT2,I,J over LISTSS + DO 300 I1=2,13 + AM1=AMASS(I1/2) + JT1=I1+JTOFF + DO 310 I2=2,13 + AM2=AMASS(I2/2) + JT2=I2+JTOFF + IF(HGAMSS(JT1,JT2).LE.0) GO TO 310 + SIG0=4*PI*HMASS**2/(9*S**2)*HGAMSS(JT1,JT2)*X1*X2*UNITS + $ /((S-HMASS**2)**2+(HMASS*HGAM)**2) + SIG0=SIG0*QSAVE(I1,1)*QSAVE(I2,2) +C Decay partial cross sections + DO 320 I=1,85 + DO 330 J=1,85 + IF(HGAMSS(I,J).EQ.0) GO TO 330 + IF(.NOT.(GOQ(I,1).AND.GOQ(J,2))) GO TO 330 + SIG=SIG0*HGAMSS(I,J) +C Include W/Z branching ratios + IF((I.GE.78.AND.I.LE.80).AND.(J.GE.78.AND.J.LE.80)) THEN + SIG=SIG*TBRWW(I-76,1)*TBRWW(J-76,2) + ENDIF + CALL SIGFIL(SIG,JT1,JT2,I,J) +330 CONTINUE +320 CONTINUE +310 CONTINUE +300 CONTINUE +C + RETURN + END diff --git a/ISAJET/code/sigint.F b/ISAJET/code/sigint.F new file mode 100644 index 00000000000..86e02d1efa1 --- /dev/null +++ b/ISAJET/code/sigint.F @@ -0,0 +1,108 @@ +#include "isajet/pilot.h" + SUBROUTINE SIGINT(F,Z,A1S,B1S,A2S,B2S) +C +C F(N+1) = INT(-Z,Z)(DX X**N/((A1+B1*X)*A2+B2*X))) +C F(8) = F(9) = 0 (DUMMY VALUES) +C + DIMENSION F(9) +#if defined(CERNLIB_DOUBLE) + DOUBLE PRECISION A1,B1,A2,B2,A,B,C,Z,F,A1S,B1S,A2S,B2S +#endif +C + A1=A1S + B1=B1S + A2=A2S + B2=B2S + F(8)=0. + F(9)=0. +C +C SPECIAL CASE: X**N/(A1*A2) + IF(B1.EQ.0..AND.B2.EQ.0.) THEN + F(1)=2.*Z/(A1*A2) + F(2)=0. + F(3)=2.*Z**3/(3.*A1*A2) + F(4)=0. + F(5)=2.*Z**5/(5.*A1*A2) + F(6)=0. + F(7)=2.*Z**7/(7.*A1*A2) + RETURN + ENDIF +C +C SPECIAL CASE: X**N/(A+BX) + IF(B1.EQ.0..OR.B2.EQ.0.) THEN + IF(B1.EQ.0.) THEN + A=A2/B2 + C=1./(A1*B2) + ELSE + A=A1/B1 + C=1./(A2*B1) + ENDIF + F(1)=LOG((A+Z)/(A-Z)) + F(1)=F(1)*C + F(2)=-A*LOG((A+Z)/(A-Z))+2.*Z + F(2)=F(2)*C + F(3)=A**2*LOG((A+Z)/(A-Z))-2.*A*Z + F(3)=F(3)*C + F(4)=-A**3*LOG((A+Z)/(A-Z))+2.*A**2*Z+2.*Z**3/3. + F(4)=F(4)*C + F(5)=A**4*LOG((A+Z)/(A-Z))-2.*A**3*Z-2.*A*Z**3/3. + F(5)=F(5)*C + F(6)=-A**5*LOG((A+Z)/(A-Z))+2.*A**4*Z+2.*A**2*Z**3/3.+2.*Z**5/5. + F(6)=F(6)*C + F(7)=A**6*LOG((A+Z)/(A-Z))-2.*A**5*Z-2.*A**3*Z**3/3. + $ -2.*A*Z**5/5. + F(7)=F(7)*C + RETURN + ENDIF +C +C B1 AND B2 NONZERO + A1=A1/B1 + A2=A2/B2 + C=1./(B1*B2) +C +C SPECIAL CASE: X**N/(A+B*X)**2 + IF(A1.EQ.A2) THEN + A=A1 + F(1)=2.*Z/(A**2-Z**2) + F(1)=F(1)*C + F(2)=-2.*A*Z/(A**2-Z**2)+LOG((A+Z)/(A-Z)) + F(2)=F(2)*C + F(3)=(4.*A**2*Z-2.*Z**3)/(A**2-Z**2)-2.*A*LOG((A+Z)/(A-Z)) + F(3)=F(3)*C + F(4)=(4.*A*Z**3-6.*A**3*Z)/(A**2-Z**2)+3.*A**2*LOG((A+Z)/(A-Z)) + F(4)=F(4)*C + F(5)=(-16.*A**2*Z**3/3.+8.*A**4*Z-2.*Z**5/3.)/(A**2-Z**2) + $ -4.*A**3*LOG((A+Z)/(A-Z)) + F(5)=F(5)*C + F(6)=(4.*A*Z**5/3.+20.*A**3*Z**3/3.-10.*A**5*Z)/(A**2-Z**2) + $ +5*A**4*LOG((A+Z)/(A-Z)) + F(6)=F(6)*C + F(7)=(-8.*A**2*Z**5/5.-8.*A**4*Z**3+12.*A**6*Z-2.*Z**7/5.) + $ /(A**2-Z**2)-6.*A**5*LOG((A+Z)/(A-Z)) + F(7)=F(7)*C + RETURN + ENDIF +C +C GENERAL CASE + F(1)=(-LOG((A1+Z)/(A1-Z))+LOG((A2+Z)/(A2-Z)))/(A1-A2) + F(1)=F(1)*C + F(2)=(A1*LOG((A1+Z)/(A1-Z))-A2*LOG((A2+Z)/(A2-Z)))/(A1-A2) + F(2)=F(2)*C + F(3)=(-A1**2*LOG((A1+Z)/(A1-Z))+A2**2*LOG((A2+Z)/(A2-Z)))/(A1-A2) + $+2.*Z + F(3)=F(3)*C + F(4)=(A1**3*LOG((A1+Z)/(A1-Z))-A2**3*LOG((A2+Z)/(A2-Z)))/(A1-A2) + $+2.*Z*(-A1-A2) + F(4)=F(4)*C + F(5)=(-A1**4*LOG((A1+Z)/(A1-Z))+A2**4*LOG((A2+Z)/(A2-Z)))/(A1-A2) + $+2.*Z*(A1*A2+A1**2+A2**2)+2.*Z**3/3. + F(5)=F(5)*C + F(6)=(A1**5*LOG((A1+Z)/(A1-Z))-A2**5*LOG((A2+Z)/(A2-Z)))/(A1-A2) + $+2.*Z*(-A1*A2**2-A1**2*A2-A1**3-A2**3)+2.*Z**3/3.*(-A1-A2) + F(6)=F(6)*C + F(7)=(-A1**6*LOG((A1+Z)/(A1-Z))+A2**6*LOG((A2+Z)/(A2-Z)))/(A1-A2) + $+2.*Z*(A1*A2**3+A1**2*A2**2+A1**3*A2+A1**4+A2**4) + $+2.*Z**3/3.*(A1*A2+A1**2+A2**2)+2.*Z**5/5. + F(7)=F(7)*C + RETURN + END diff --git a/ISAJET/code/sigkkg.F b/ISAJET/code/sigkkg.F new file mode 100644 index 00000000000..5df8f9e5da1 --- /dev/null +++ b/ISAJET/code/sigkkg.F @@ -0,0 +1,171 @@ +#include "isajet/pilot.h" + SUBROUTINE SIGKKG +C +C Compute the KK graviton direct production cross-section +C d(sigma)/d(m**2)d(pT**2)d(y3)d(y4) +C X-sections: G.F.Giudice et al. hep-ph/9811291 +C Kinematics: sigdy.car (Drell-Yan + jet) +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +C +#include "isajet/itapes.inc" +#include "isajet/qcdpar.inc" +#include "isajet/jetpar.inc" +#include "isajet/primar.inc" +#include "isajet/q1q2.inc" +#include "isajet/jetsig.inc" +#include "isajet/qsave.inc" +#include "isajet/wcon.inc" +#include "isajet/const.inc" +#include "isajet/nodcay.inc" +#include "isajet/kkgrav.inc" +C + REAL X(2) + REAL Z,S,T,U,QMW2,QZW,EHAT,Q2SAVE,YHAT,EY,P3Z,P1,P2,AMASS,ANEFF, + $SIG0,DENOM,QT2CUT,SIGT,SIGU,FAC,PROP,FACTOR,SIG,AMT,AMT2,SWT, + $P1WT,P2WT,X1WT,X2WT,TWT,UWT,Q2,QFCN,STRUC,XX,ACOSH,ATANH,P2M,P1M + REAL AMI2,AMF2,EFWT + REAL AJLWT,AJLZT1,AJLZT2,A2,A2B2,QQ,TM2 + INTEGER I,IQ,IH,IQ1,IFL,IQ2,IW,IQ3 + INTEGER NZERO(4) + REAL AMFAC(13) + INTEGER NUTYP(25) + INTEGER IFL1,IFL2 + REAL TERM + REAL KKGF1,KKGF2,KKGF3,SIG1,SIG2,XG,YG,F1,F2T,F2U,F3 + EQUIVALENCE (S,SHAT),(T,THAT),(U,UHAT),(X(1),X1) +C Electric charge: + REAL CHARGE + EXTERNAL CHARGE +C +C Kinematics: (Drell-Yan plus jet) +C + QMW2=QMW**2 + QTMW=SQRT(QMW2+QTW**2) + Q0W=QTMW*COSH(YW) + QZW=QTMW*SINH(YW) + QW=SQRT(QZW**2+QTW**2) +C Protect against errors + IF(QW.NE.0.) THEN + CTHW=QZW/QW + STHW=QTW/QW + IF(ABS(CTHW).LT.1.) THEN + THW=ACOS(CTHW) + ELSE + CTHW=0. + STHW=1. + THW=.5*PI + ENDIF + ELSE + CTHW=0. + STHW=1. + THW=.5*PI + ENDIF +c Drell-Yan plus jet + P3Z=P(3)*CTH(3) + SHAT=QMW2+2.*Q0W*P(3)-2.*QZW*P3Z+2.*PT(3)**2 + P1=.5*(P(3)+P3Z+Q0W+QZW) + P2=.5*(P(3)-P3Z+Q0W-QZW) + X1=P1/HALFE + X2=P2/HALFE + THAT=-2.*P1*(P(3)-P3Z) + UHAT=-2.*P2*(P(3)+P3Z) + QSQ=QTW**2 + QSQ=AMAX1(QSQ,4.) + ANEFF=4.+QSQ/(QSQ+AMASS(5)**2)+QSQ/(QSQ+AMASS(6)**2) + ALFQSQ=12.*PI/((33.-2.*ANEFF)*ALOG(QSQ/ALAM2)) + Q2SAVE=QSQ + QSQ=SHAT +C +C Initialize +C + SIGMA=0. + NSIGS=0 + DO 100 I=1,MXSIGS + SIGS(I)=0. +100 CONTINUE + IF(X1.GE.1..OR.X2.GE.1.) RETURN +C +C Structure functions +C + DO 110 IH=1,2 + DO 120 IQ=1,11 + QSAVE(IQ,IH)=STRUC(X(IH),QSQ,IQ,IDIN(IH))/X(IH) +120 CONTINUE + QSAVE(12,IH)=0 + QSAVE(13,IH)=0 +110 CONTINUE + QSQ=Q2SAVE +C + IF((THAT/SHAT).EQ.0.) RETURN + IF(ABS(THAT/SHAT+1).LT.1.E-06) RETURN + F1=KKGF1(SHAT,THAT,QMW2) + F2T=KKGF2(SHAT,THAT,QMW2) + F2U=KKGF2(SHAT,UHAT,QMW2) + F3=KKGF3(SHAT,THAT,QMW2) + IF(F1.LE.0.OR.F2T.LE.0.OR.F2U.LE.0.OR.F3.LE.0) RETURN +C + SIG0=UNITS*0.5*KKGSD*ALFQSQ*QMW**(NEXTRAD-2)/SCM +C +C Jet 3 = gamma: +C + IF(GOQ(26,3)) THEN + SIG1=UNITS*0.5*KKGSD*ALFA*QMW**(NEXTRAD-2)/SCM + SIG1=SIG1*F1/48.0 +C qk + qb --> gamma + KKG + DO 410 IFL=1,5 + IQ1=2*IFL + IQ2=IQ1+1 + SIG2=SIG1*ABS(CHARGE(IFL)) + SIG=SIG2*QSAVE(IQ1,1)*QSAVE(IQ2,2) + IF(UVCUT.AND.SHAT.GE.(MASSD**2)) SIG=SIG*(MASSD**2/SHAT)**2 + CALL SIGFIL(SIG,IQ1,IQ2,5,26) + SIG=SIG2*QSAVE(IQ2,1)*QSAVE(IQ1,2) + IF(UVCUT.AND.SHAT.GE.(MASSD**2)) SIG=SIG*(MASSD**2/SHAT)**2 + CALL SIGFIL(SIG,IQ2,IQ1,5,26) +410 CONTINUE + ENDIF +C +C Jet 3 = gluon: +C + IF(GOQ(1,3)) THEN + SIG1=SIG0*F1/36.0 +C qk + qb --> gl + KKG + DO 210 IFL=1,5 + IQ1=2*IFL + IQ2=IQ1+1 + SIG=SIG1*QSAVE(IQ1,1)*QSAVE(IQ2,2) + IF(UVCUT.AND.SHAT.GE.(MASSD**2)) SIG=SIG*(MASSD**2/SHAT)**2 + CALL SIGFIL(SIG,IQ1,IQ2,5,1) + SIG=SIG1*QSAVE(IQ2,1)*QSAVE(IQ1,2) + IF(UVCUT.AND.SHAT.GE.(MASSD**2)) SIG=SIG*(MASSD**2/SHAT)**2 + CALL SIGFIL(SIG,IQ1,IQ1,5,1) +210 CONTINUE +C gl + gl --> gl + KKG + SIG1=SIG0*F3*3.0/16.0 + SIG=SIG1*QSAVE(1,1)*QSAVE(1,2) + IF(UVCUT.AND.SHAT.GE.(MASSD**2)) SIG=SIG*(MASSD**2/SHAT)**2 + CALL SIGFIL(SIG,1,1,5,1) + ENDIF +C +C Jet 3 = quark: +C + SIGT=SIG0*F2T/96.0 + SIGU=SIG0*F2U/96.0 +C qk + gl --> qk + KKG + DO 310 IQ1=2,11 + IQ3=IQ1 + IF(GOQ(IQ3,3)) THEN + SIG=SIGU*QSAVE(IQ1,1)*QSAVE(1,2) + IF(UVCUT.AND.SHAT.GE.(MASSD**2)) SIG=SIG*(MASSD**2/SHAT)**2 + CALL SIGFIL(SIG,IQ1,1,5,IQ3) + SIG=SIGT*QSAVE(IQ1,2)*QSAVE(1,1) + IF(UVCUT.AND.SHAT.GE.(MASSD**2)) SIG=SIG*(MASSD**2/SHAT)**2 + CALL SIGFIL(SIG,1,IQ1,5,IQ3) + ENDIF +310 CONTINUE +C + RETURN + END diff --git a/ISAJET/code/sigqcd.F b/ISAJET/code/sigqcd.F new file mode 100644 index 00000000000..5b3f58d3bbe --- /dev/null +++ b/ISAJET/code/sigqcd.F @@ -0,0 +1,300 @@ +#include "isajet/pilot.h" + SUBROUTINE SIGQCD +C +C Compute D(SIGMA)/D(PT**2)D(Y1)D(Y2) +C Include quark masses for ch, bt, and tp and 4th generation. +C Note ch is now treated as heavy. +C +C SIGMA = cross section summed over quark types allowed by +C JETTYPE card. +C SIGS(I) = partial cross section for I1 + I2 --> I3 + I4. +C INOUT(I) = IOPAK**3*I4 + IOPAK**2*I3 + IOPAK*I2 + I1 +C using JETTYPE code. +C +C Cross sections from Feynman, Field and Fox, P.R. D18, 3320 +C Massive cross sections from B. Combridge, N.P. B151, 429. +C Extra factor of 1/2 needed for non-identical jets since all +C all jets are treated as identical. +C +C Ver 6.35: Fix kinematics for gl + tp -> gl + tp, etc. +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/qcdpar.inc" +#include "isajet/jetpar.inc" +#include "isajet/primar.inc" +#include "isajet/q1q2.inc" +#include "isajet/jetsig.inc" +#include "isajet/const.inc" +C + REAL X(2),QSAVE(13,2),EBT(2) + EQUIVALENCE (X(1),X1),(S,SHAT),(T,THAT),(U,UHAT) + REAL FFF1,FFF2,FFF3,FFF4,FFF5,FFF6,FFF7,S,T,U,FGQ,AM2,FQQ, + $ QFCN,STRUC,FJAC,SIG,AMASS,SIG1,AMQ,FJACBT,SIG2,QQ,XQMIN, + $ E1,E2 + INTEGER IQ,IH,I,J,IFL,JTYP1,JTYP2,IQ1,IQ2 +C +C Elementary cross sections from Feynman, Field, and Fox. +C + FFF1(S,T,U)=4./9.*(S**2+U**2)/T**2 + FFF2(S,T,U)=4./9.*((S**2+U**2)/T**2+(S**2+T**2)/U**2) + 1-8./27.*S**2/(U*T) + FFF3(S,T,U)=4./9.*((S**2+U**2)/T**2+(T**2+U**2)/S**2) + 1-8./27.*U**2/(S*T) + FFF4(S,T,U)=32./27.*(U**2+T**2)/(U*T)-8./3.*(U**2+T**2)/S**2 + FFF5(S,T,U)=1./6.*(U**2+T**2)/(U*T)-3./8.*(U**2+T**2)/S**2 + FFF6(S,T,U)=-4./9.*(U**2+S**2)/(U*S)+(U**2+S**2)/T**2 + FFF7(S,T,U)=9./2.*(3.-U*T/S**2-U*S/T**2-S*T/U**2) +C Heavy quark cross sections from Combridge + FGQ(S,T,U)=2.*(S-AM2)*(AM2-U)/T**2 + 1+4./9.*((S-AM2)*(AM2-U)+2.*AM2*(S+AM2))/(S-AM2)**2 + 2+4./9.*((S-AM2)*(AM2-U)+2.*AM2*(AM2+U))/(AM2-U)**2 + 3+1./9.*AM2*(4.*AM2-T)/((S-AM2)*(AM2-U)) + 4+((S-AM2)*(AM2-U)+AM2*(S-U))/(T*(S-AM2)) + 5-((S-AM2)*(AM2-U)-AM2*(S-U))/(T*(AM2-U)) + FQQ(S,T,U)=4./9.*((AM2-U)**2+(S-AM2)**2+2.*AM2*T)/T**2 + QFCN(IQ,IH)=STRUC(X(IH),QSQ,IQ,IDIN(IH))/X(IH) +C +C Use massless kinematics for ch and lighter quarks. +C + CALL TWOKIN(0.,0.,0.,0.) + FJAC=SHAT/SCM*UNITS + FJAC=FJAC*PI*ALFQSQ**2/SHAT**2 +C +C Initialize cross sections. +C + SIGMA=0. + NSIGS=0 + DO 100 I=1,MXSIGS + SIGS(I)=0. +100 CONTINUE + IF(X1.GE.1.0.OR.X2.GE.1.0) RETURN +C Compute structure functions + DO 110 IH=1,2 + DO 110 IQ=1,7 + QSAVE(IQ,IH)=STRUC(X(IH),QSQ,IQ,IDIN(IH))/X(IH) +110 CONTINUE +C +C Compute cross sections summed over quark types allowed by +C JETTYPE card. +C +C Gluon-gluon + IF(.NOT.(GOQ(1,1).AND.GOQ(1,2))) GO TO 210 + SIG=.5*FJAC*QSAVE(1,1)*QSAVE(1,2)*FFF7(S,T,U) + CALL SIGFIL(SIG,1,1,1,1) +C + DO 201 I=1,3 + SIG=.5*FJAC*QSAVE(2*I,1)*QSAVE(2*I+1,2)*FFF4(S,T,U) + CALL SIGFIL(SIG,2*I,2*I+1,1,1) + SIG=.5*FJAC*QSAVE(2*I+1,1)*QSAVE(2*I,2)*FFF4(S,U,T) + CALL SIGFIL(SIG,2*I+1,2*I,1,1) +201 CONTINUE +C +C Quark-gluon +210 CONTINUE + DO 211 I=2,7 + IF(.NOT.(GOQ(I,1).AND.GOQ(1,2))) GO TO 212 + SIG=.5*FJAC*QSAVE(I,1)*QSAVE(1,2)*FFF6(S,T,U) + CALL SIGFIL(SIG,I,1,I,1) + SIG=.5*FJAC*QSAVE(1,1)*QSAVE(I,2)*FFF6(S,U,T) + CALL SIGFIL(SIG,1,I,I,1) +212 CONTINUE + IF(.NOT.(GOQ(1,1).AND.GOQ(I,2))) GO TO 211 + SIG=.5*FJAC*QSAVE(1,1)*QSAVE(I,2)*FFF6(S,T,U) + CALL SIGFIL(SIG,1,I,1,I) + SIG=.5*FJAC*QSAVE(I,1)*QSAVE(1,2)*FFF6(S,U,T) + CALL SIGFIL(SIG,I,1,1,I) +211 CONTINUE +C +C Identical quark-quark + DO 220 I=2,7 + IF(.NOT.(GOQ(I,1).AND.GOQ(I,2))) GO TO 220 + SIG=.5*FJAC*QSAVE(I,1)*QSAVE(I,2)*FFF2(S,T,U) + CALL SIGFIL(SIG,I,I,I,I) +220 CONTINUE +C +C Identical quark-antiquark + DO 230 I=1,3 + IF(SHAT.LT.4.*AMASS(I)**2) GO TO 230 + IF(.NOT.(GOQ(2*I,1).AND.GOQ(2*I+1,2))) GO TO 235 + SIG=.5*FJAC*QSAVE(1,1)*QSAVE(1,2)*FFF5(S,T,U) + CALL SIGFIL(SIG,1,1,2*I,2*I+1) + DO 231 J=1,3 + IF(J.EQ.I) GO TO 231 + SIG=.5*FJAC*QSAVE(2*J,1)*QSAVE(2*J+1,2)*FFF1(T,S,U) + CALL SIGFIL(SIG,2*J,2*J+1,2*I,2*I+1) + SIG=.5*FJAC*QSAVE(2*J+1,1)*QSAVE(2*J,2)*FFF1(T,S,U) + CALL SIGFIL(SIG,2*J+1,2*J,2*I,2*I+1) +231 CONTINUE + SIG=.5*FJAC*QSAVE(2*I,1)*QSAVE(2*I+1,2)*FFF3(S,T,U) + CALL SIGFIL(SIG,2*I,2*I+1,2*I,2*I+1) + SIG=.5*FJAC*QSAVE(2*I+1,1)*QSAVE(2*I,2)*FFF3(S,U,T) + CALL SIGFIL(SIG,2*I+1,2*I,2*I,2*I+1) +C +235 CONTINUE + IF(.NOT.(GOQ(2*I+1,1).AND.GOQ(2*I,2))) GO TO 230 + SIG=.5*FJAC*QSAVE(1,1)*QSAVE(1,2)*FFF5(S,T,U) + CALL SIGFIL(SIG,1,1,2*I+1,2*I) + DO 236 J=1,3 + IF(J.EQ.I) GO TO 236 + SIG=.5*FJAC*QSAVE(2*J,1)*QSAVE(2*J+1,2)*FFF1(T,S,U) + CALL SIGFIL(SIG,2*J,2*J+1,2*I+1,2*I) + SIG=.5*FJAC*QSAVE(2*J+1,1)*QSAVE(2*J,2)*FFF1(T,S,U) + CALL SIGFIL(SIG,2*J+1,2*J,2*I+1,2*I) +236 CONTINUE + SIG1=.5*FJAC*QSAVE(2*I,1)*QSAVE(2*I+1,2)*FFF3(S,U,T) + CALL SIGFIL(SIG1,2*I,2*I+1,2*I+1,2*I) + SIG=.5*FJAC*QSAVE(2*I+1,1)*QSAVE(2*I,2)*FFF3(S,T,U) + CALL SIGFIL(SIG,2*I+1,2*I,2*I+1,2*I) +230 CONTINUE +C +C General massless quark-quark + DO 240 I=2,7 + DO 241 J=2,7 + IF(.NOT.(GOQ(I,1).AND.GOQ(J,2))) GO TO 241 + IF((I/2).EQ.(J/2)) GO TO 241 + SIG=.5*FJAC*QSAVE(I,1)*QSAVE(J,2)*FFF1(S,T,U) + CALL SIGFIL(SIG,I,J,I,J) + SIG=.5*FJAC*QSAVE(J,1)*QSAVE(I,2)*FFF1(S,U,T) + CALL SIGFIL(SIG,I,J,J,I) +241 CONTINUE +240 CONTINUE +C +C CH+CB, BT+BB, and TP+TB cross sections. +C Y=-log(tan(theta/2)), so Jacobean contains P1*P2/E1*E2. +C Also fourth generation. +C + DO 250 IQ=1,5 + IFL=IQ+3 + JTYP1=2*IFL + JTYP2=JTYP1+1 + IF(.NOT.((GOQ(JTYP1,1).AND.GOQ(JTYP2,2)).OR. + 1 (GOQ(JTYP2,1).AND.GOQ(JTYP1,2)))) GO TO 250 + AMQ=AMASS(IFL) + IF(AMQ.LT.0.) GO TO 250 + AM2=AMQ**2 + CALL TWOKIN(0.,0.,AMQ,AMQ) + IF(X(1).GE.1..OR.X(2).GE.1.) GO TO 250 + EBT(1)=SQRT(P(1)**2+AM2) + EBT(2)=SQRT(P(2)**2+AM2) + FJACBT=.5*S/SCM*UNITS*P(1)*P(2)/(EBT(1)*EBT(2)) + SIG1=12.*(AM2-T)*(AM2-U)/S**2 + 1 +8./3.*((AM2-T)*(AM2-U)-2.*AM2*(AM2+T))/(AM2-T)**2 + 2 +8./3.*((AM2-T)*(AM2-U)-2.*AM2*(AM2+U))/(AM2-U)**2 + 3 -2./3.*AM2*(S-4.*AM2)/((AM2-T)*(AM2-U)) + 4 -6.*((AM2-T)*(AM2-U)+AM2*(U-T))/(S*(AM2-T)) + 5 -6.*((AM2-T)*(AM2-U)+AM2*(T-U))/(S*(AM2-U)) + SIG1=SIG1*PI**2*ALFQSQ**2/(16.*PI*S**2) + SIG=FJACBT*SIG1*STRUC(X(1),QSQ,1,IDIN(1))/X(1) + 1 *STRUC(X(2),QSQ,1,IDIN(2))/X(2) + IF(GOQ(JTYP1,1).AND.GOQ(JTYP2,2)) + $ CALL SIGFIL(SIG,1,1,JTYP1,JTYP2) + IF(GOQ(JTYP2,1).AND.GOQ(JTYP1,2)) + $ CALL SIGFIL(SIG,1,1,JTYP2,JTYP1) +C + SIG2=((AM2-T)**2+(AM2-U)**2+2.*S*AM2)/S**2 + SIG2=FJACBT*SIG2*64.*PI**2*ALFQSQ**2/(9.*16.*PI*S**2) + DO 255 I=1,3 + QQ=STRUC(X(1),QSQ,2*I,IDIN(1))*STRUC(X(2),QSQ,2*I+1,IDIN(2)) + SIG=SIG2*QQ/(X(1)*X(2)) + IF(GOQ(JTYP1,1).AND.GOQ(JTYP2,2)) + $ CALL SIGFIL(SIG,2*I,2*I+1,JTYP1,JTYP2) + IF(GOQ(JTYP2,1).AND.GOQ(JTYP1,2)) + $ CALL SIGFIL(SIG,2*I,2*I+1,JTYP2,JTYP1) + QQ=STRUC(X(1),QSQ,2*I+1,IDIN(1))*STRUC(X(2),QSQ,2*I,IDIN(2)) + SIG=SIG2*QQ/(X(1)*X(2)) + IF(GOQ(JTYP1,1).AND.GOQ(JTYP2,2)) + $ CALL SIGFIL(SIG,2*I+1,2*I,JTYP1,JTYP2) + IF(GOQ(JTYP2,1).AND.GOQ(JTYP1,2)) + $ CALL SIGFIL(SIG,2*I+1,2*I,JTYP2,JTYP1) +255 CONTINUE +250 CONTINUE +C +C Gluon + heavy quark + DO 300 IQ=8,13. + IF(.NOT.(GOQ(1,1).AND.GOQ(IQ,2))) GO TO 310 + AMQ=AMASS(IQ/2) + AM2=AMQ**2 + XQMIN=AMQ/ECM + E1=P(1) + E2=SQRT(P(2)**2+AM2) + FJAC=.5*S/SCM*UNITS*PI*ALFQSQ**2/S**2 + CALL TWOKIN(0.,AMQ,0.,AMQ) + IF(X(1).LT.1..AND.X(2).LT.1..AND.X(2).GT.XQMIN) THEN + SIG=FJAC*P(1)*P(2)/(E1*E2)*FGQ(S,T,U)*QFCN(1,1)*QFCN(IQ,2) + CALL SIGFIL(SIG,1,IQ,1,IQ) + ENDIF + CALL TWOKIN(AMQ,0.,0.,AMQ) + IF(X(1).LT.1..AND.X(2).LT.1..AND.X(1).GT.XQMIN) THEN + SIG=FJAC*P(1)*P(2)/(E1*E2)*FGQ(S,U,T)*QFCN(IQ,1)*QFCN(1,2) + CALL SIGFIL(SIG,IQ,1,1,IQ) + ENDIF +C +310 IF(.NOT.(GOQ(IQ,1).AND.GOQ(1,2))) GO TO 300 + AMQ=AMASS(IQ/2) + AM2=AMQ**2 + XQMIN=AMQ/ECM + E1=SQRT(P(1)**2+AM2) + E2=P(2) + FJAC=.5*S/SCM*UNITS*PI*ALFQSQ**2/S**2 + CALL TWOKIN(0.,AMQ,AMQ,0.) + IF(X(1).LT.1..AND.X(2).LT.1..AND.X(2).GT.XQMIN) THEN + SIG=FJAC*P(1)*P(2)/(E1*E2)*FGQ(S,U,T)*QFCN(1,1)*QFCN(IQ,2) + CALL SIGFIL(SIG,1,IQ,IQ,1) + ENDIF + CALL TWOKIN(AMQ,0.,AMQ,0.) + IF(X(1).LT.1..AND.X(2).LT.1..AND.X(1).GT.XQMIN) THEN + SIG=FJAC*P(1)*P(2)/(E1*E2)*FGQ(S,T,U)*QFCN(IQ,1)*QFCN(1,2) + CALL SIGFIL(SIG,IQ,1,IQ,1) + ENDIF +300 CONTINUE +C +C Light quark + heavy quark + DO 320 IQ1=2,7 + DO 330 IQ2=8,13 + IF(.NOT.(GOQ(IQ1,1).AND.GOQ(IQ2,2))) GO TO 340 + AMQ=AMASS(IQ2/2) + AM2=AMQ**2 + XQMIN=AMQ/ECM + E1=P(1) + E2=SQRT(P(2)**2+AM2) + FJAC=.5*S/SCM*UNITS*PI*ALFQSQ**2/S**2 + CALL TWOKIN(0.,AMQ,0.,AMQ) + IF(X(1).LT.1..AND.X(2).LT.1..AND.X(2).GT.XQMIN) THEN + SIG=FJAC*P(1)*P(2)/(E1*E2)*FQQ(S,T,U)*QFCN(IQ1,1) + $ *QFCN(IQ2,2) + CALL SIGFIL(SIG,IQ1,IQ2,IQ1,IQ2) + ENDIF + CALL TWOKIN(AMQ,0.,0.,AMQ) + IF(X(1).LT.1..AND.X(2).LT.1..AND.X(1).GT.XQMIN) THEN + SIG=FJAC*P(1)*P(2)/(E1*E2)*FQQ(S,U,T)*QFCN(IQ1,2) + $ *QFCN(IQ2,1) + CALL SIGFIL(SIG,IQ2,IQ1,IQ1,IQ2) + ENDIF +C +340 IF(.NOT.(GOQ(IQ1,2).AND.GOQ(IQ2,1))) GO TO 330 + AMQ=AMASS(IQ2/2) + AM2=AMQ**2 + XQMIN=AMQ/ECM + E1=SQRT(P(1)**2+AM2) + E2=P(2) + FJAC=.5*S/SCM*UNITS*PI*ALFQSQ**2/S**2 + CALL TWOKIN(0.,AMQ,AMQ,0.) + IF(X(1).LT.1..AND.X(2).LT.1..AND.X(2).GT.XQMIN) THEN + SIG=FJAC*P(1)*P(2)/(E1*E2)*FQQ(S,U,T)*QFCN(IQ1,1) + $ *QFCN(IQ2,2) + CALL SIGFIL(SIG,IQ1,IQ2,IQ2,IQ1) + ENDIF + CALL TWOKIN(AMQ,0.,AMQ,0.) + IF(X(1).LT.1..AND.X(2).LT.1..AND.X(1).GT.XQMIN) THEN + SIG=FJAC*P(1)*P(2)/(E1*E2)*FQQ(S,T,U)*QFCN(IQ1,2) + $ *QFCN(IQ2,1) + CALL SIGFIL(SIG,IQ2,IQ1,IQ2,IQ1) + ENDIF +330 CONTINUE +320 CONTINUE +C + RETURN + END diff --git a/ISAJET/code/sigsse.F b/ISAJET/code/sigsse.F new file mode 100644 index 00000000000..f28b8e7da11 --- /dev/null +++ b/ISAJET/code/sigsse.F @@ -0,0 +1,908 @@ +#include "isajet/pilot.h" + SUBROUTINE SIGSSE +C +C Compute d(sigma)/d(cos theta) for +C e+ e- ----> SUSY particles +C See Baer et. al., IJMP A4, 4111 (1989) for sigma's +C Polarized cross sections added 9/18/95 hb +C Mixed sbottoms and staus included 10/23/96 hb +C +C SIGMA = cross section summed over quark types allowed by +C JETTYPE and WTYPE cards. +C SIGS(I) = partial cross section for I1 + I2 --> I3 + I4. +C INOUT(I) = IOPAK**3*I4 + IOPAK**2*I3 + IOPAK*I2 + I1 +C using JETTYPE code. +C +C Extra factor of 1/2 needed because all jets are treated +C as identical. +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/jetsig.inc" +#include "isajet/eepar.inc" +#include "isajet/primar.inc" +#include "isajet/jetpar.inc" +#include "isajet/q1q2.inc" +#include "isajet/wcon.inc" +#include "isajet/const.inc" +#include "isajet/sspar.inc" +#include "isajet/sssm.inc" +#include "isajet/sstype.inc" +#include "isajet/brembm.inc" +C + REAL ALQ(2),BEQ(2),E,CS2THW,TNTHW,CTTHW,AE,BE,AM1,AM2, + $EQ,ALR,Z,PHIZ,PROPZ,SIG,PCM,AMASS,ALL(2),BEL(2), + $G,MSNE,TM2,TM3,TM4,TM5,TM6,AZJ,AZI,MEL,MER, + $AEZS,BEZS,SR2,GP,AN,BN,AEZJS,BEZJS,SSXLAM, + $TGG,TNN,TGN,TZN,AMWI,XS,YS,XC,YC,SINGL,SINGR, + $COSGL,COSGR,XM,YM,THX,THY,XI,DEL,AMWISS(2),KK, + $AMZIZ1,AMZIZ2,SIGLL,SIGRR,SIGLZ,SIGRZ,SSGT,SSGST, + $FAC1,EZ0,BETA,EEL,EER, + $FLEP,FLEM,FREP,FREM,SIGLR,SIGRL,PHIZLR,PHIZRL, + $TM1LR,TM1RL,TZZRL,TZZLR,TGZLR,TGZRL,SIGZZL,SIGZZR, + $FACLR,FACRL,RSH,JAC,ESTRUC,SH,SSFEL + COMPLEX AEZ(4),BEZ(4),ZI,ZONE,WIJ + INTEGER IS2UD(25),IUD(13),JS2JT(25),IQ1,IQ2,IFL1,IFL2, + $IFLQ,IFM,I,IDQSS(25),MATCHL(18),IL2JS(18),IS2LN(18), + $I1,I2,IL1,IL2,IDL1,IDL2,IZ,IZ1,IP,ITHZ(4),IDLSS(18), + $IW2JS(4),IW1,JW1,JTW1,JTW2,IZ2JS(4), + $IZ2,JTYPZ1,JTYPZ2 + INTEGER MSUPL,MSDNL,MSSTL,MSCHL,MSBT1,MSTP1, + $MSUPR,MSDNR,MSSTR,MSCHR,MSBT2,MSTP2,MSW1,MSW2, + $MSNEL,MSEL,MSNML,MSMUL,MSNTL,MSTAU1,MSER,MSMUR,MSTAU2 + PARAMETER (MSUPL=-ISUPL) + PARAMETER (MSDNL=-ISDNL) + PARAMETER (MSSTL=-ISSTL) + PARAMETER (MSCHL=-ISCHL) + PARAMETER (MSBT1=-ISBT1) + PARAMETER (MSTP1=-ISTP1) + PARAMETER (MSUPR=-ISUPR) + PARAMETER (MSDNR=-ISDNR) + PARAMETER (MSSTR=-ISSTR) + PARAMETER (MSCHR=-ISCHR) + PARAMETER (MSBT2=-ISBT2) + PARAMETER (MSTP2=-ISTP2) + PARAMETER (MSW1=-ISW1) + PARAMETER (MSW2=-ISW2) + PARAMETER (MSNEL=-ISNEL) + PARAMETER (MSEL=-ISEL) + PARAMETER (MSNML=-ISNML) + PARAMETER (MSMUL=-ISMUL) + PARAMETER (MSNTL=-ISNTL) + PARAMETER (MSTAU1=-ISTAU1) + PARAMETER (MSER=-ISER) + PARAMETER (MSMUR=-ISMUR) + PARAMETER (MSTAU2=-ISTAU2) + DATA IDQSS/0, + $ISUPL,MSUPL,ISDNL,MSDNL,ISSTL,MSSTL,ISCHL,MSCHL,ISBT1,MSBT1, + $ISTP1,MSTP1, + $ISUPR,MSUPR,ISDNR,MSDNR,ISSTR,MSSTR,ISCHR,MSCHR,ISBT2,MSBT2, + $ISTP2,MSTP2/ + DATA IDLSS/ISNEL,MSNEL,ISEL,MSEL,ISNML,MSNML,ISMUL,MSMUL, + $ISNTL,MSNTL,ISTAU1,MSTAU1,ISER,MSER,ISMUR,MSMUR, + $ISTAU2,MSTAU2/ + DATA IS2UD/0,1,1,2,2,2,2,1,1,2,2,1,1,1,1,2,2,2,2,1,1,2,2,1,1/ + DATA IUD/0,1,-1,2,-2,2,-2,1,-1,2,-2,1,-1/ + DATA JS2JT/1, + $2,3,4,5,6,7,8,9,10,11,12,13,2,3,4,5,6,7,8,9,10,11,12,13/ + DATA MATCHL/2,1,4,3,6,5,8,7,10,9,12,11,14,13,16,15,18,17/ + DATA IL2JS/34,35,36,37,38,39,40,41,42,43,44,45,46,47, + $48,49,50,51/ + DATA IS2LN/1,1,2,2,1,1,2,2,1,1,2,2,2,2,2,2,2,2/ + DATA IW2JS/26,27,28,29/ + DATA IZ2JS/30,31,32,33/ + DATA ZONE,ZI/(1.,0.),(0.,1.)/ +C +C FUNCTIONS + IF (IBREM) THEN + SH=SHAT + JAC=2*(1.-SHAT/SCM)*2*SQRT(SHAT)*(RSHMAX-RSHMIN)/SCM/(X1+X2) + ELSE + SH=SCM + END IF + PROPZ=(SH-AMZ**2)**2+AMZ**2*GAMZ**2 +C +C CONSTANTS + RSH=SQRT(SH) + EB=RSH/2. + QSQBM=QSQ + E=SQRT(4*PI*ALFAEM) + G=SQRT(4*PI*ALFAEM/SN2THW) + GP=G*SQRT(SN2THW/(1.-SN2THW)) + BETA=ATAN(1./RV2V1) + SR2=SQRT(2.) + CS2THW=1.-SN2THW + TNTHW=SQRT(SN2THW/CS2THW) + CTTHW=1./TNTHW + ALQ(1)=CTTHW/4.-5*TNTHW/12. + BEQ(1)=-(CTTHW+TNTHW)/4. + ALQ(2)=TNTHW/12.-CTTHW/4. + BEQ(2)=-BEQ(1) + ALL(1)=(CTTHW+TNTHW)/4. + BEL(1)=-(CTTHW+TNTHW)/4. + ALL(2)=(3*TNTHW-CTTHW)/4. + BEL(2)=-BEL(1) + AE=ALL(2) + BE=BEL(2) + AN=ALL(1) + BN=BEL(1) + FLEP=(1.+PLEP)/2. + FLEM=(1.+PLEM)/2. + FREP=(1.-PLEP)/2. + FREM=(1.-PLEM)/2. + MEL=AMASS(ISEL) + MER=AMASS(ISER) + MSNE=AMASS(ISNEL) + XM=1./TAN(GAMMAL) + YM=1./TAN(GAMMAR) + THX=SIGN(1.,XM) + THY=SIGN(1.,YM) + AMWISS(1)=ABS(AMW1SS) + AMWISS(2)=ABS(AMW2SS) + DO 5 IZ=1,4 + ITHZ(IZ)=0 + IF (AMZISS(IZ).LT.0.) ITHZ(IZ)=1 + AEZ(IZ)=-1*ZI**(ITHZ(IZ)-1)*(-1)**(ITHZ(IZ)+1)* + $ (G*ZMIXSS(3,IZ)+GP*ZMIXSS(4,IZ))/SR2 + BEZ(IZ)=-1*ZI**(ITHZ(IZ)-1)*SR2*GP*ZMIXSS(4,IZ) +5 CONTINUE +C +C ENTRY + SIG=0. + SIGMA=0. + NSIGS=0 + DO 10 I=1,MXSIGS + SIGS(I)=0. +10 CONTINUE +C +C First do squark pairs: IQ1 labels JETTYPE1. +C + DO 100 IQ1=2,25 + IQ2=MATCH(IQ1,4) + IF(.NOT.(GOQ(IQ1,1).AND.GOQ(IQ2,2))) GO TO 100 + IFL1=IDQSS(IQ1) + IFL2=IDQSS(IQ2) + AM1=AMASS(IFL1) + AM2=AMASS(IFL2) + IF((AM1+AM2).GE.RSH) GO TO 100 + IFLQ=IS2UD(IQ1) + IF (IFLQ.EQ.1) THEN + EQ=2./3. + ELSE + EQ=-1./3. + END IF +C Left squarks + IF(IQ1.LE.9) THEN + ALR=2*(ALQ(IFLQ)-BEQ(IFLQ)) +C Right squarks + ELSEIF(IQ1.GE.14.AND.IQ1.LE.21) THEN + ALR=2*(ALQ(IFLQ)+BEQ(IFLQ)) +C Mixed stops and sbottoms + ELSEIF(IQ1.EQ.10.OR.IQ1.EQ.11) THEN + ALR=2*(ALQ(IFLQ)-BEQ(IFLQ)*COS(2*THETAB)) + ELSEIF(IQ1.EQ.12.OR.IQ1.EQ.13) THEN + ALR=2*(ALQ(IFLQ)-BEQ(IFLQ)*COS(2*THETAT)) + ELSEIF(IQ1.EQ.22.OR.IQ1.EQ.23) THEN + ALR=2*(ALQ(IFLQ)+BEQ(IFLQ)*COS(2*THETAB)) + ELSEIF(IQ1.EQ.24.OR.IQ1.EQ.25) THEN + ALR=2*(ALQ(IFLQ)+BEQ(IFLQ)*COS(2*THETAT)) + END IF + PCM=.5*SQRT(SH-4.*AM1**2) + IFM=ISIGN(1,IUD(JS2JT(IQ1))) + IF (IFM.GT.0) THEN + Z=CTH(1) + ELSE + Z=-CTH(1) + END IF +C Calculate d(sigma)/d(cos theta) in mb + PHIZLR=2*E**4*(1.-Z**2)*(8*EQ**2/SH+(2*ALR**2*(AE-BE)**2* + $ SH-8*(AE-BE)*EQ*ALR*(SH-AMZ**2))/PROPZ) + PHIZRL=2*E**4*(1.-Z**2)*(8*EQ**2/SH+(2*ALR**2*(AE+BE)**2* + $ SH-8*(AE+BE)*EQ*ALR*(SH-AMZ**2))/PROPZ) + SIGLR=3*PCM**3/512./PI/EB**3*PHIZLR + SIGRL=3*PCM**3/512./PI/EB**3*PHIZRL + SIG=(FLEM*FREP*SIGLR+FREM*FLEP*SIGRL)*UNITS/2. + IF (IBREM.AND..NOT.IBEAM) THEN + SIG=SIG*ESTRUC(X1,QSQ)*ESTRUC(X2,QSQ)*JAC + ELSE IF (IBEAM) THEN + SIG=SIG*SSFEL(X1,0)*SSFEL(X2,0)*JAC + END IF + CALL SIGFIL(SIG,0,0,IQ1,IQ2) +100 CONTINUE +C Mixed sbottom_1 and sbottom_2 production + IF ((AMB1SS+AMB2SS).LT.RSH) THEN + Z=CTH(1) + PCM=SQRT(SSXLAM(SH,AMB1SS**2,AMB2SS**2))/2./RSH + SIGLR=2*3*8*PI*ALFAEM**2*BEQ(2)**2*COS(THETAB)**2* + $ SIN(THETAB)**2*(AE-BE)**2*PCM**3*(1.-Z**2)/RSH/PROPZ + SIGRL=2*3*8*PI*ALFAEM**2*BEQ(2)**2*COS(THETAB)**2* + $ SIN(THETAB)**2*(AE+BE)**2*PCM**3*(1.-Z**2)/RSH/PROPZ + SIG=(FLEM*FREP*SIGLR+FREM*FLEP*SIGRL)*UNITS/2. + IF (IBREM.AND..NOT.IBEAM) THEN + SIG=SIG*ESTRUC(X1,QSQ)*ESTRUC(X2,QSQ)*JAC + ELSE IF (IBEAM) THEN + SIG=SIG*SSFEL(X1,0)*SSFEL(X2,0)*JAC + END IF + IF(GOQ(10,1).AND.GOQ(23,2)) THEN + CALL SIGFIL(SIG,0,0,10,23) + END IF + IF(GOQ(23,1).AND.GOQ(10,2)) THEN + CALL SIGFIL(SIG,0,0,23,10) + END IF + IF(GOQ(11,1).AND.GOQ(22,2)) THEN + CALL SIGFIL(SIG,0,0,11,22) + END IF + IF(GOQ(22,1).AND.GOQ(11,2)) THEN + CALL SIGFIL(SIG,0,0,22,11) + END IF + ENDIF +C Mixed stop_1 and stop_2 production + IF ((AMT1SS+AMT2SS).LT.RSH) THEN + Z=CTH(1) + PCM=SQRT(SSXLAM(SH,AMT1SS**2,AMT2SS**2))/2./RSH + SIGLR=2*3*8*PI*ALFAEM**2*BEQ(1)**2*COS(THETAT)**2* + $ SIN(THETAT)**2*(AE-BE)**2*PCM**3*(1.-Z**2)/RSH/PROPZ + SIGRL=2*3*8*PI*ALFAEM**2*BEQ(1)**2*COS(THETAT)**2* + $ SIN(THETAT)**2*(AE+BE)**2*PCM**3*(1.-Z**2)/RSH/PROPZ + SIG=(FLEM*FREP*SIGLR+FREM*FLEP*SIGRL)*UNITS/2. + IF (IBREM.AND..NOT.IBEAM) THEN + SIG=SIG*ESTRUC(X1,QSQ)*ESTRUC(X2,QSQ)*JAC + ELSE IF (IBEAM) THEN + SIG=SIG*SSFEL(X1,0)*SSFEL(X2,0)*JAC + END IF + IF(GOQ(12,1).AND.GOQ(25,2)) THEN + CALL SIGFIL(SIG,0,0,12,25) + END IF + IF(GOQ(25,1).AND.GOQ(12,2)) THEN + CALL SIGFIL(SIG,0,0,25,12) + END IF + IF(GOQ(13,1).AND.GOQ(24,2)) THEN + CALL SIGFIL(SIG,0,0,13,24) + END IF + IF(GOQ(24,1).AND.GOQ(13,2)) THEN + CALL SIGFIL(SIG,0,0,24,13) + END IF + ENDIF +C +C 2nd and 3rd generation sleptons: IL1 labels JETTYPE1. +C + DO 200 I=5,16 + I1=I + IF (I1.GE.13) I1=I1+2 + I2=MATCHL(I1) + IL1=IL2JS(I1) + IL2=IL2JS(I2) + IF(.NOT.(GOQ(IL1,1).AND.GOQ(IL2,2))) GO TO 200 + IDL1=IDLSS(I1) + IDL2=IDLSS(I2) + AM1=AMASS(IDL1) + AM2=AMASS(IDL2) + IF((AM1+AM2).GE.RSH) GO TO 200 + IFL1=IS2LN(I1) + IFL2=IS2LN(I2) + IF (IFL1.EQ.1) THEN + EQ=0. + ELSE + EQ=-1. + END IF + IF (I1.EQ.15.OR.I1.EQ.16) THEN + ALR=2*(ALL(IFL1)+BEL(IFL1)) + ELSE IF (I1.GE.5.AND.I1.LE.10) THEN + ALR=2*(ALL(IFL1)-BEL(IFL1)) + ELSE IF (I1.EQ.11.OR.I1.EQ.12) THEN + ALR=2*(ALL(IFL1)-BEL(IFL1)*COS(2*THETAL)) + ELSE IF (I1.EQ.17.OR.I1.EQ.18) THEN + ALR=2*(ALL(IFL1)+BEL(IFL1)*COS(2*THETAL)) + END IF + PCM=.5*SQRT(SH-4.*AM1**2) + IFM=ISIGN(1,IDL1) + IF (IFM.GT.0) THEN + Z=CTH(1) + ELSE + Z=-CTH(1) + END IF +C Calculate d(sigma)/d(cos theta) in mb + PHIZLR=2*E**4*(1.-Z**2)*(8*EQ**2/SH+(2*ALR**2*(AE-BE)**2* + $ SH-8*(AE-BE)*EQ*ALR*(SH-AMZ**2))/PROPZ) + PHIZRL=2*E**4*(1.-Z**2)*(8*EQ**2/SH+(2*ALR**2*(AE+BE)**2* + $ SH-8*(AE+BE)*EQ*ALR*(SH-AMZ**2))/PROPZ) + SIGLR=PCM**3/512./PI/EB**3*PHIZLR + SIGRL=PCM**3/512./PI/EB**3*PHIZRL + SIG=(FLEM*FREP*SIGLR+FREM*FLEP*SIGRL)*UNITS/2. + IF (IBREM.AND..NOT.IBEAM) THEN + SIG=SIG*ESTRUC(X1,QSQ)*ESTRUC(X2,QSQ)*JAC + ELSE IF (IBEAM) THEN + SIG=SIG*SSFEL(X1,0)*SSFEL(X2,0)*JAC + END IF + CALL SIGFIL(SIG,0,0,IL1,IL2) +200 CONTINUE +C Mixed stau_1 and stau_2 production + IF ((AML1SS+AML2SS).LT.RSH) THEN + Z=CTH(1) + PCM=SQRT(SSXLAM(SH,AML1SS**2,AML2SS**2))/2./RSH + SIGLR=2*8*PI*ALFAEM**2*BEL(2)**2*COS(THETAL)**2* + $ SIN(THETAL)**2*(AE-BE)**2*PCM**3*(1.-Z**2)/RSH/PROPZ + SIGRL=2*8*PI*ALFAEM**2*BEL(2)**2*COS(THETAL)**2* + $ SIN(THETAL)**2*(AE+BE)**2*PCM**3*(1.-Z**2)/RSH/PROPZ + SIG=(FLEM*FREP*SIGLR+FREM*FLEP*SIGRL)*UNITS/2. + IF (IBREM.AND..NOT.IBEAM) THEN + SIG=SIG*ESTRUC(X1,QSQ)*ESTRUC(X2,QSQ)*JAC + ELSE IF (IBEAM) THEN + SIG=SIG*SSFEL(X1,0)*SSFEL(X2,0)*JAC + END IF + IF(GOQ(44,1).AND.GOQ(51,2)) THEN + CALL SIGFIL(SIG,0,0,44,51) + END IF + IF(GOQ(51,1).AND.GOQ(44,2)) THEN + CALL SIGFIL(SIG,0,0,51,44) + END IF + IF(GOQ(45,1).AND.GOQ(50,2)) THEN + CALL SIGFIL(SIG,0,0,45,50) + END IF + IF(GOQ(50,1).AND.GOQ(45,2)) THEN + CALL SIGFIL(SIG,0,0,50,45) + END IF + ENDIF +C +C Next do 1st generation sleptons +C +C Sneutrino_e pairs + DO 210 I1=1,2 + I2=MATCHL(I1) + IL1=IL2JS(I1) + IL2=IL2JS(I2) + IF(.NOT.(GOQ(IL1,1).AND.GOQ(IL2,2))) GO TO 210 + MSNE=AMASS(ISNEL) + IF((2*MSNE).GE.RSH) GO TO 210 + IF (I1.EQ.1) THEN + Z=CTH(1) + ELSE + Z=-CTH(1) + END IF + PCM=.5*SQRT(SH-4*MSNE**2) + TM1LR=32*E**4*(AN-BN)**2*(AE-BE)**2/PROPZ + TM1RL=32*E**4*(AN-BN)**2*(AE+BE)**2/PROPZ + TM2=8*G**4*SIN(GAMMAR)**4/(2*EB*(EB-PCM*Z)+AMW1SS**2-MSNE**2)**2 + TM3=8*G**4*COS(GAMMAR)**4/(2*EB*(EB-PCM*Z)+AMW2SS**2-MSNE**2)**2 + TM4=-32*E**2*(AN-BN)*G**2*SIN(GAMMAR)**2*(SH-AMZ**2)*(AE-BE)/ + $ PROPZ/(2*EB*(EB-PCM*Z)+AMW1SS**2-MSNE**2) + TM5=-32*E**2*(AN-BN)*G**2*COS(GAMMAR)**2*(SH-AMZ**2)*(AE-BE)/ + $ PROPZ/(2*EB*(EB-PCM*Z)+AMW2SS**2-MSNE**2) + TM6=16*G**4*SIN(GAMMAR)**2*COS(GAMMAR)**2/ + $ (2*EB*(EB-PCM*Z)+AMW1SS**2-MSNE**2)/ + $ (2*EB*(EB-PCM*Z)+AMW2SS**2-MSNE**2) + SIGLR=2*PCM**3*EB*(1.-Z**2)/128./PI/SH* + $ (TM1LR+TM2+TM3+TM4+TM5+TM6) + SIGRL=2*PCM**3*EB*(1.-Z**2)/128./PI/SH*TM1RL + SIG=(FLEM*FREP*SIGLR+FREM*FLEP*SIGRL)*UNITS/2. + IF (IBREM.AND..NOT.IBEAM) THEN + SIG=SIG*ESTRUC(X1,QSQ)*ESTRUC(X2,QSQ)*JAC + ELSE IF (IBEAM) THEN + SIG=SIG*SSFEL(X1,0)*SSFEL(X2,0)*JAC + END IF + CALL SIGFIL(SIG,0,0,IL1,IL2) +210 CONTINUE +C E_L~ pairs + DO 220 I1=3,4 + I2=MATCHL(I1) + IL1=IL2JS(I1) + IL2=IL2JS(I2) + IF(.NOT.(GOQ(IL1,1).AND.GOQ(IL2,2))) GO TO 220 + IF(2*MEL.GE.RSH) GO TO 220 + PCM=.5*SQRT(SH-4.*MEL**2) + EQ=-1. + ALR=2*(AE-BE) + IF (I1.EQ.3) THEN + Z=CTH(1) + ELSE + Z=-CTH(1) + END IF + PHIZLR=E**4*(1.-Z**2)*(8*EQ**2/SH+(2*ALR**2*(AE-BE)**2* + $ SH-8*(AE-BE)*EQ*ALR*(SH-AMZ**2))/PROPZ) + PHIZRL=E**4*(1.-Z**2)*(8*EQ**2/SH+(2*ALR**2*(AE+BE)**2* + $ SH-8*(AE+BE)*EQ*ALR*(SH-AMZ**2))/PROPZ) + DO 221 IZ1=1,4 + AEZS=AEZ(IZ1)*CONJG(AEZ(IZ1)) + PHIZLR=PHIZLR+2*AEZS**2*SH*(1.-Z**2)/(2*EB*(EB-PCM*Z)- + $ MEL**2+AMZISS(IZ1)**2)**2-4*E**2*(1.-Z**2)*AEZS/ + $ (2*EB*(EB-PCM*Z)-MEL**2+AMZISS(IZ1)**2)*(2.+(AE-BE)*ALR* + $ SH*(SH-AMZ**2)/PROPZ) + IF (IZ1.LE.3) THEN + DO 222 IP=IZ1+1,4 + AEZJS=AEZ(IP)*CONJG(AEZ(IP)) + PHIZLR=PHIZLR+4*AEZS*AEZJS*SH*(1.-Z**2)/ + $ (2*EB*(EB-PCM*Z)-MEL**2+AMZISS(IZ1)**2)/ + $ (2*EB*(EB-PCM*Z)-MEL**2+AMZISS(IP)**2) +222 CONTINUE + END IF +221 CONTINUE + SIGLR=2*PCM**3/512./PI/EB**3*PHIZLR + SIGRL=2*PCM**3/512./PI/EB**3*PHIZRL + SIG=(FLEM*FREP*SIGLR+FREM*FLEP*SIGRL)*UNITS/2. + IF (IBREM.AND..NOT.IBEAM) THEN + SIG=SIG*ESTRUC(X1,QSQ)*ESTRUC(X2,QSQ)*JAC + ELSE IF (IBEAM) THEN + SIG=SIG*SSFEL(X1,0)*SSFEL(X2,0)*JAC + END IF + CALL SIGFIL(SIG,0,0,IL1,IL2) +220 CONTINUE +C E_R~ pairs + DO 230 I1=13,14 + I2=MATCHL(I1) + IL1=IL2JS(I1) + IL2=IL2JS(I2) + IF(.NOT.(GOQ(IL1,1).AND.GOQ(IL2,2))) GO TO 230 + IF(2*MER.GE.RSH) GO TO 230 + PCM=.5*SQRT(SH-4.*MER**2) + EQ=-1. + ALR=2*(AE+BE) + IF (I1.EQ.13) THEN + Z=CTH(1) + ELSE + Z=-CTH(1) + END IF + PHIZLR=E**4*(1.-Z**2)*(8*EQ**2/SH+(2*ALR**2*(AE-BE)**2* + $ SH-8*(AE-BE)*EQ*ALR*(SH-AMZ**2))/PROPZ) + PHIZRL=E**4*(1.-Z**2)*(8*EQ**2/SH+(2*ALR**2*(AE+BE)**2* + $ SH-8*(AE+BE)*EQ*ALR*(SH-AMZ**2))/PROPZ) + DO 231 IZ1=1,4 + BEZS=BEZ(IZ1)*CONJG(BEZ(IZ1)) + PHIZRL=PHIZRL+2*BEZS**2*SH*(1.-Z**2)/(2*EB*(EB-PCM*Z)- + $ MER**2+AMZISS(IZ1)**2)**2-4*E**2*(1.-Z**2)*BEZS/ + $ (2*EB*(EB-PCM*Z)-MER**2+AMZISS(IZ1)**2)*(2.+(AE+BE)*ALR* + $ SH*(SH-AMZ**2)/PROPZ) + IF (IZ1.LE.3) THEN + DO 232 IP=IZ1+1,4 + BEZJS=BEZ(IP)*CONJG(BEZ(IP)) + PHIZRL=PHIZRL+4*BEZS*BEZJS*SH*(1.-Z**2)/ + $ (2*EB*(EB-PCM*Z)-MER**2+AMZISS(IZ1)**2)/ + $ (2*EB*(EB-PCM*Z)-MER**2+AMZISS(IP)**2) +232 CONTINUE + END IF +231 CONTINUE + SIGLR=2*PCM**3/512./PI/EB**3*PHIZLR + SIGRL=2*PCM**3/512./PI/EB**3*PHIZRL + SIG=(FLEM*FREP*SIGLR+FREM*FLEP*SIGRL)*UNITS/2. + IF (IBREM.AND..NOT.IBEAM) THEN + SIG=SIG*ESTRUC(X1,QSQ)*ESTRUC(X2,QSQ)*JAC + ELSE IF (IBEAM) THEN + SIG=SIG*SSFEL(X1,0)*SSFEL(X2,0)*JAC + END IF + CALL SIGFIL(SIG,0,0,IL1,IL2) +230 CONTINUE +C E_L~+E_R~bar and E_R~+E_L~bar pairs; now has MEL =/ MER ! + IF((MEL+MER).GE.RSH) GO TO 270 + IF(GOQ(36,1).AND.GOQ(47,2)) THEN + PCM=SQRT(SSXLAM(SH,MEL**2,MER**2))/4./EB + EEL=SQRT(PCM**2+MEL**2) + Z=CTH(1) + PHIZ=0. + DO 241 IZ1=1,4 + BEZS=BEZ(IZ1)*CONJG(BEZ(IZ1)) + AEZS=AEZ(IZ1)*CONJG(AEZ(IZ1)) + AZI=(AMZISS(IZ1)**2-MEL**2)/2./EB + PHIZ=PHIZ+AEZS*BEZS*AMZISS(IZ1)**2/(EEL-PCM*Z+AZI)**2 + IF (IZ1.LE.3) THEN + DO 242 IP=IZ1+1,4 + AZJ=(AMZISS(IP)**2-MEL**2)/2./EB + PHIZ=PHIZ+2*ABS(AMZISS(IZ1)*AMZISS(IP))* + $ REAL(AEZ(IZ1)*CONJG(AEZ(IP))*CONJG(BEZ(IZ1))*BEZ(IP))/ + $ (EEL-PCM*Z+AZI)/(EEL-PCM*Z+AZJ) +242 CONTINUE + END IF +241 CONTINUE + SIG=4*PCM/128./PI/SH/EB*PHIZ + SIG=FLEM*FLEP*SIG*UNITS/2. + IF (IBREM.AND..NOT.IBEAM) THEN + SIG=SIG*ESTRUC(X1,QSQ)*ESTRUC(X2,QSQ)*JAC + ELSE IF (IBEAM) THEN + SIG=SIG*SSFEL(X1,0)*SSFEL(X2,0)*JAC + END IF + CALL SIGFIL(SIG,0,0,36,47) + ENDIF + IF(GOQ(46,1).AND.GOQ(37,2)) THEN + PCM=SQRT(SSXLAM(SH,MEL**2,MER**2))/4./EB + EER=SQRT(PCM**2+MER**2) + Z=CTH(1) + PHIZ=0. + DO 243 IZ1=1,4 + BEZS=BEZ(IZ1)*CONJG(BEZ(IZ1)) + AEZS=AEZ(IZ1)*CONJG(AEZ(IZ1)) + AZI=(AMZISS(IZ1)**2-MER**2)/2./EB + PHIZ=PHIZ+AEZS*BEZS*AMZISS(IZ1)**2/(EER-PCM*Z+AZI)**2 + IF (IZ1.LE.3) THEN + DO 244 IP=IZ1+1,4 + AZJ=(AMZISS(IP)**2-MER**2)/2./EB + PHIZ=PHIZ+2*ABS(AMZISS(IZ1)*AMZISS(IP))* + $ REAL(AEZ(IZ1)*CONJG(AEZ(IP))*CONJG(BEZ(IZ1))*BEZ(IP))/ + $ (EER-PCM*Z+AZI)/(EER-PCM*Z+AZJ) +244 CONTINUE + END IF +243 CONTINUE + SIG=4*PCM/128./PI/SH/EB*PHIZ + SIG=FREM*FREP*SIG*UNITS/2. + IF (IBREM.AND..NOT.IBEAM) THEN + SIG=SIG*ESTRUC(X1,QSQ)*ESTRUC(X2,QSQ)*JAC + ELSE IF (IBEAM) THEN + SIG=SIG*SSFEL(X1,0)*SSFEL(X2,0)*JAC + END IF + CALL SIGFIL(SIG,0,0,46,37) + ENDIF +C E_R~bar+E_L~ and E_L~bar+E_R~ pairs; now assumes MEL =/ MER ! + IF(GOQ(47,1).AND.GOQ(36,2)) THEN + PCM=SQRT(SSXLAM(SH,MEL**2,MER**2))/4./EB + EEL=SQRT(PCM**2+MEL**2) + Z=-CTH(1) + PHIZ=0. + DO 251 IZ1=1,4 + BEZS=BEZ(IZ1)*CONJG(BEZ(IZ1)) + AEZS=AEZ(IZ1)*CONJG(AEZ(IZ1)) + AZI=(AMZISS(IZ1)**2-MEL**2)/2./EB + PHIZ=PHIZ+AEZS*BEZS*AMZISS(IZ1)**2/(EEL-PCM*Z+AZI)**2 + IF (IZ1.LE.3) THEN + DO 252 IP=IZ1+1,4 + AZJ=(AMZISS(IP)**2-MEL**2)/2./EB + PHIZ=PHIZ+2*ABS(AMZISS(IZ1)*AMZISS(IP))* + $ REAL(AEZ(IZ1)*CONJG(AEZ(IP))*CONJG(BEZ(IZ1))*BEZ(IP))/ + $ (EEL-PCM*Z+AZI)/(EEL-PCM*Z+AZJ) +252 CONTINUE + END IF +251 CONTINUE + SIG=4*PCM/128./PI/SH/EB*PHIZ + SIG=FLEM*FLEP*SIG*UNITS/2. + IF (IBREM.AND..NOT.IBEAM) THEN + SIG=SIG*ESTRUC(X1,QSQ)*ESTRUC(X2,QSQ)*JAC + ELSE IF (IBEAM) THEN + SIG=SIG*SSFEL(X1,0)*SSFEL(X2,0)*JAC + END IF + CALL SIGFIL(SIG,0,0,47,36) + ENDIF + IF(GOQ(37,1).AND.GOQ(46,2)) THEN + PCM=SQRT(SSXLAM(SH,MEL**2,MER**2))/4./EB + EER=SQRT(PCM**2+MER**2) + Z=-CTH(1) + PHIZ=0. + DO 253 IZ1=1,4 + BEZS=BEZ(IZ1)*CONJG(BEZ(IZ1)) + AEZS=AEZ(IZ1)*CONJG(AEZ(IZ1)) + AZI=(AMZISS(IZ1)**2-MER**2)/2./EB + PHIZ=PHIZ+AEZS*BEZS*AMZISS(IZ1)**2/(EER-PCM*Z+AZI)**2 + IF (IZ1.LE.3) THEN + DO 254 IP=IZ1+1,4 + AZJ=(AMZISS(IP)**2-MER**2)/2./EB + PHIZ=PHIZ+2*ABS(AMZISS(IZ1)*AMZISS(IP))* + $ REAL(AEZ(IZ1)*CONJG(AEZ(IP))*CONJG(BEZ(IZ1))*BEZ(IP))/ + $ (EER-PCM*Z+AZI)/(EER-PCM*Z+AZJ) +254 CONTINUE + END IF +253 CONTINUE + SIG=4*PCM/128./PI/SH/EB*PHIZ + SIG=FREM*FREP*SIG*UNITS/2. + IF (IBREM.AND..NOT.IBEAM) THEN + SIG=SIG*ESTRUC(X1,QSQ)*ESTRUC(X2,QSQ)*JAC + ELSE IF (IBEAM) THEN + SIG=SIG*SSFEL(X1,0)*SSFEL(X2,0)*JAC + END IF + CALL SIGFIL(SIG,0,0,37,46) + ENDIF +270 CONTINUE +C +C Chargino pair production +C + DO 300 IW1=1,4 + JW1=(IW1+1)/2 + AMWI=ABS(AMWISS(JW1)) + JTW1=IW2JS(IW1) + JTW2=IW2JS(MATCHL(IW1)) + IF (.NOT.(GOQ(JTW1,1).AND.GOQ(JTW2,2))) GO TO 300 + IF((2*AMWI).GE.RSH) GO TO 300 + PCM=SQRT(SSXLAM(SH,AMWI**2,AMWI**2))/4./EB + Z=CTH(1) + IF (IW1.EQ.1.OR.IW1.EQ.3) Z=-CTH(1) + SINGR=SIN(GAMMAR) + COSGR=COS(GAMMAR) + SINGL=SIN(GAMMAL) + COSGL=COS(GAMMAL) + XC=1.-(COSGL**2+COSGR**2)/4./CS2THW + YC=(COSGR**2-COSGL**2)/4./CS2THW + XS=1.-(SINGL**2+SINGR**2)/4./CS2THW + YS=(SINGR**2-SINGL**2)/4./CS2THW + IF (IW1.GE.3) THEN + XC=XS + YC=YS + SINGR=COSGR + END IF + TGG=16*E**4/SH*(EB**2*(1.+Z**2)+AMWI**2*(1.-Z**2)) + TZZLR=16*E**4*CTTHW**2*SH/PROPZ*((XC**2+YC**2)*(AE-BE)**2* + $ (EB**2*(1.+Z**2)+AMWI**2*(1.-Z**2))- + $ 2*YC**2*(AE-BE)**2*AMWI**2+4*XC*YC*(AE-BE)**2*EB*PCM*Z) + TZZRL=16*E**4*CTTHW**2*SH/PROPZ*((XC**2+YC**2)*(AE+BE)**2* + $ (EB**2*(1.+Z**2)+AMWI**2*(1.-Z**2))- + $ 2*YC**2*(AE+BE)**2*AMWI**2-4*XC*YC*(AE+BE)**2*EB*PCM*Z) + TGZLR=-32*E**4*CTTHW*(SH-AMZ**2)/PROPZ*((AE-BE)*XC* + $ (EB**2*(1.+Z**2)+AMWI**2*(1.-Z**2))-2*(BE-AE)*YC*EB*PCM*Z) + TGZRL=-32*E**4*CTTHW*(SH-AMZ**2)/PROPZ*((AE+BE)*XC* + $ (EB**2*(1.+Z**2)+AMWI**2*(1.-Z**2))-2*(BE+AE)*YC*EB*PCM*Z) + TNN=2*E**4*SINGR**4*SH*(EB-PCM*Z)**2/SN2THW**2/ + $ (EB**2+PCM**2-2*EB*PCM*Z+MSNE**2)**2 + TGN=-8*E**4*SINGR**2*((EB-PCM*Z)**2+AMWI**2)/SN2THW/ + $ (EB**2+PCM**2-2*EB*PCM*Z+MSNE**2) + TZN=8*E**4*CTTHW*SINGR**2*(SH-AMZ**2)*(AE-BE)*SH/ + $ SN2THW/PROPZ*((XC-YC)*((EB-PCM*Z)**2+AMWI**2)+2*YC*AMWI**2)/ + $ (EB**2+PCM**2-2*EB*PCM*Z+MSNE**2) + SIGLR=2*PCM/128./PI/SH/EB*(TGG+TZZLR+TGZLR+TNN+TGN+TZN) + SIGRL=2*PCM/128./PI/SH/EB*(TGG+TZZRL+TGZRL) + SIG=(FLEM*FREP*SIGLR+FREM*FLEP*SIGRL)*UNITS/2. + IF (IBREM.AND..NOT.IBEAM) THEN + SIG=SIG*ESTRUC(X1,QSQ)*ESTRUC(X2,QSQ)*JAC + ELSE IF (IBEAM) THEN + SIG=SIG*SSFEL(X1,0)*SSFEL(X2,0)*JAC + END IF + CALL SIGFIL(SIG,0,0,JTW1,JTW2) +300 CONTINUE +C +C Chargino_1 + chargino_2 pair production + IF((ABS(AMW1SS)+ABS(AMW2SS)).GE.RSH) GO TO 340 + PCM=SQRT(SSXLAM(SH,AMW1SS**2,AMW2SS**2))/4./EB + XC=(THX*SIN(GAMMAL)*COS(GAMMAL)-THY*SIN(GAMMAR)*COS(GAMMAR))/2. + YC=(THX*SIN(GAMMAL)*COS(GAMMAL)+THY*SIN(GAMMAR)*COS(GAMMAR))/2. + DEL=(AMW2SS**2-AMW1SS**2)/4./EB + XI=-1.*SIGN(1.,AMWISS(1))*SIGN(1.,AMWISS(2)) + IF (.NOT.(GOQ(27,1).AND.GOQ(28,2))) GO TO 310 + Z=CTH(1) + TZZLR=4*(CTTHW+TNTHW)**2/PROPZ*((XC**2+YC**2)*(AE-BE)**2* + $ (EB**2+PCM**2*Z**2-DEL**2-XI*ABS(AMW1SS*AMW2SS))+ + $ 2*XC**2*XI*(AE-BE)**2*ABS(AMW1SS*AMW2SS)+ + $ 4*XC*YC*(AE-BE)**2*EB*PCM*Z) + TZZRL=4*(CTTHW+TNTHW)**2/PROPZ*((XC**2+YC**2)*(AE+BE)**2* + $ (EB**2+PCM**2*Z**2-DEL**2-XI*ABS(AMW1SS*AMW2SS))+ + $ 2*XC**2*XI*(AE+BE)**2*ABS(AMW1SS*AMW2SS)- + $ 4*XC*YC*(AE+BE)**2*EB*PCM*Z) + TNN=2*SIN(GAMMAR)**2*COS(GAMMAR)**2*((EB-PCM*Z)**2-DEL**2)/ + $ SN2THW**2/(2*EB*(EB-DEL)-2*EB*PCM*Z+MSNE**2-AMW1SS**2)**2 + TZN=-4*THY*(CTTHW+TNTHW)*SIN(GAMMAR)*COS(GAMMAR)*(SH-AMZ**2) + $ *(AE-BE)/SN2THW/PROPZ*((XC-YC)*((EB-PCM*Z)**2-DEL**2- + $ XI*ABS(AMW1SS*AMW2SS))+2*XC*XI*ABS(AMW1SS*AMW2SS))/ + $ (2*EB*(EB-DEL)-2*EB*PCM*Z+MSNE**2-AMW1SS**2) + SIGLR=2*E**4*PCM/128./PI/EB*(TZZLR+TNN+TZN) + SIGRL=2*E**4*PCM/128./PI/EB*TZZRL + SIG=(FLEM*FREP*SIGLR+FREM*FLEP*SIGRL)*UNITS/2. + IF (IBREM.AND..NOT.IBEAM) THEN + SIG=SIG*ESTRUC(X1,QSQ)*ESTRUC(X2,QSQ)*JAC + ELSE IF (IBEAM) THEN + SIG=SIG*SSFEL(X1,0)*SSFEL(X2,0)*JAC + END IF + CALL SIGFIL(SIG,0,0,27,28) +310 CONTINUE + IF (.NOT.(GOQ(28,1).AND.GOQ(27,2))) GO TO 320 + Z=-CTH(1) + TZZLR=4*(CTTHW+TNTHW)**2/PROPZ*((XC**2+YC**2)*(AE-BE)**2* + $ (EB**2+PCM**2*Z**2-DEL**2-XI*ABS(AMW1SS*AMW2SS))+ + $ 2*XC**2*XI*(AE-BE)**2*ABS(AMW1SS*AMW2SS)+ + $ 4*XC*YC*(AE-BE)**2*EB*PCM*Z) + TZZRL=4*(CTTHW+TNTHW)**2/PROPZ*((XC**2+YC**2)*(AE+BE)**2* + $ (EB**2+PCM**2*Z**2-DEL**2-XI*ABS(AMW1SS*AMW2SS))+ + $ 2*XC**2*XI*(AE+BE)**2*ABS(AMW1SS*AMW2SS)- + $ 4*XC*YC*(AE+BE)**2*EB*PCM*Z) + TNN=2*SIN(GAMMAR)**2*COS(GAMMAR)**2*((EB-PCM*Z)**2-DEL**2)/ + $ SN2THW**2/(2*EB*(EB-DEL)-2*EB*PCM*Z+MSNE**2-AMW1SS**2)**2 + TZN=-4*THY*(CTTHW+TNTHW)*SIN(GAMMAR)*COS(GAMMAR)*(SH-AMZ**2) + $ *(AE-BE)/SN2THW/PROPZ*((XC-YC)*((EB-PCM*Z)**2-DEL**2- + $ XI*ABS(AMW1SS*AMW2SS))+2*XC*XI*ABS(AMW1SS*AMW2SS))/ + $ (2*EB*(EB-DEL)-2*EB*PCM*Z+MSNE**2-AMW1SS**2) + SIGLR=2*E**4*PCM/128./PI/EB*(TZZLR+TNN+TZN) + SIGRL=2*E**4*PCM/128./PI/EB*TZZRL + SIG=(FLEM*FREP*SIGLR+FREM*FLEP*SIGRL)*UNITS/2. + IF (IBREM.AND..NOT.IBEAM) THEN + SIG=SIG*ESTRUC(X1,QSQ)*ESTRUC(X2,QSQ)*JAC + ELSE IF (IBEAM) THEN + SIG=SIG*SSFEL(X1,0)*SSFEL(X2,0)*JAC + END IF + CALL SIGFIL(SIG,0,0,28,27) +320 CONTINUE + IF (.NOT.(GOQ(29,1).AND.GOQ(26,2))) GO TO 330 + Z=CTH(1) + TZZLR=4*(CTTHW+TNTHW)**2/PROPZ*((XC**2+YC**2)*(AE-BE)**2* + $ (EB**2+PCM**2*Z**2-DEL**2-XI*ABS(AMW1SS*AMW2SS))+ + $ 2*XC**2*XI*(AE-BE)**2*ABS(AMW1SS*AMW2SS)+ + $ 4*XC*YC*(AE-BE)**2*EB*PCM*Z) + TZZRL=4*(CTTHW+TNTHW)**2/PROPZ*((XC**2+YC**2)*(AE+BE)**2* + $ (EB**2+PCM**2*Z**2-DEL**2-XI*ABS(AMW1SS*AMW2SS))+ + $ 2*XC**2*XI*(AE+BE)**2*ABS(AMW1SS*AMW2SS)- + $ 4*XC*YC*(AE+BE)**2*EB*PCM*Z) + TNN=2*SIN(GAMMAR)**2*COS(GAMMAR)**2*((EB-PCM*Z)**2-DEL**2)/ + $ SN2THW**2/(2*EB*(EB-DEL)-2*EB*PCM*Z+MSNE**2-AMW1SS**2)**2 + TZN=-4*THY*(CTTHW+TNTHW)*SIN(GAMMAR)*COS(GAMMAR)*(SH-AMZ**2) + $ *(AE-BE)/SN2THW/PROPZ*((XC-YC)*((EB-PCM*Z)**2-DEL**2- + $ XI*ABS(AMW1SS*AMW2SS))+2*XC*XI*ABS(AMW1SS*AMW2SS))/ + $ (2*EB*(EB-DEL)-2*EB*PCM*Z+MSNE**2-AMW1SS**2) + SIGLR=2*E**4*PCM/128./PI/EB*(TZZLR+TNN+TZN) + SIGRL=2*E**4*PCM/128./PI/EB*TZZRL + SIG=(FLEM*FREP*SIGLR+FREM*FLEP*SIGRL)*UNITS/2. + IF (IBREM.AND..NOT.IBEAM) THEN + SIG=SIG*ESTRUC(X1,QSQ)*ESTRUC(X2,QSQ)*JAC + ELSE IF (IBEAM) THEN + SIG=SIG*SSFEL(X1,0)*SSFEL(X2,0)*JAC + END IF + CALL SIGFIL(SIG,0,0,29,26) +330 CONTINUE + IF (.NOT.(GOQ(26,1).AND.GOQ(29,2))) GO TO 340 + Z=-CTH(1) + TZZLR=4*(CTTHW+TNTHW)**2/PROPZ*((XC**2+YC**2)*(AE-BE)**2* + $ (EB**2+PCM**2*Z**2-DEL**2-XI*ABS(AMW1SS*AMW2SS))+ + $ 2*XC**2*XI*(AE-BE)**2*ABS(AMW1SS*AMW2SS)+ + $ 4*XC*YC*(AE-BE)**2*EB*PCM*Z) + TZZRL=4*(CTTHW+TNTHW)**2/PROPZ*((XC**2+YC**2)*(AE+BE)**2* + $ (EB**2+PCM**2*Z**2-DEL**2-XI*ABS(AMW1SS*AMW2SS))+ + $ 2*XC**2*XI*(AE+BE)**2*ABS(AMW1SS*AMW2SS)- + $ 4*XC*YC*(AE+BE)**2*EB*PCM*Z) + TNN=2*SIN(GAMMAR)**2*COS(GAMMAR)**2*((EB-PCM*Z)**2-DEL**2)/ + $ SN2THW**2/(2*EB*(EB-DEL)-2*EB*PCM*Z+MSNE**2-AMW1SS**2)**2 + TZN=-4*THY*(CTTHW+TNTHW)*SIN(GAMMAR)*COS(GAMMAR)*(SH-AMZ**2) + $ *(AE-BE)/SN2THW/PROPZ*((XC-YC)*((EB-PCM*Z)**2-DEL**2- + $ XI*ABS(AMW1SS*AMW2SS))+2*XC*XI*ABS(AMW1SS*AMW2SS))/ + $ (2*EB*(EB-DEL)-2*EB*PCM*Z+MSNE**2-AMW1SS**2) + SIGLR=2*E**4*PCM/128./PI/EB*(TZZLR+TNN+TZN) + SIGRL=2*E**4*PCM/128./PI/EB*TZZRL + SIG=(FLEM*FREP*SIGLR+FREM*FLEP*SIGRL)*UNITS/2. + IF (IBREM.AND..NOT.IBEAM) THEN + SIG=SIG*ESTRUC(X1,QSQ)*ESTRUC(X2,QSQ)*JAC + ELSE IF (IBEAM) THEN + SIG=SIG*SSFEL(X1,0)*SSFEL(X2,0)*JAC + END IF + CALL SIGFIL(SIG,0,0,26,29) +340 CONTINUE +C +C Neutralino pair production +C + DO 400 IZ1=1,4 + AMZIZ1=ABS(AMZISS(IZ1)) + JTYPZ1=IZ2JS(IZ1) + DO 410 IZ2=1,4 + AMZIZ2=ABS(AMZISS(IZ2)) + JTYPZ2=IZ2JS(IZ2) + IF(.NOT.(GOQ(JTYPZ1,1).AND.GOQ(JTYPZ2,2))) GO TO 410 + IF((AMZIZ1+AMZIZ2).GE.RSH) GO TO 410 + WIJ=SQRT(G**2+GP**2)*ZI**(ITHZ(IZ2))*(-ZI)**(ITHZ(IZ1))* + $ (ZMIXSS(1,IZ1)*ZMIXSS(1,IZ2)-ZMIXSS(2,IZ1)* + $ ZMIXSS(2,IZ2))/4. + KK=SQRT(SH*SH+(AMZIZ1**2-AMZIZ2**2)**2-2*SH* + $ (AMZIZ1**2+AMZIZ2**2))/4./EB + Z=CTH(1) + SIGLL=2*AEZ(IZ1)*CONJG(AEZ(IZ1))*AEZ(IZ2)*CONJG(AEZ(IZ2))* + $ SSGT(SH,MEL,Z,IZ1,IZ2) + SIGRR=2*BEZ(IZ1)*CONJG(BEZ(IZ1))*BEZ(IZ2)*CONJG(BEZ(IZ2))* + $ SSGT(SH,MER,Z,IZ1,IZ2) + SIGZZL=4*E**2*WIJ*CONJG(WIJ)*(AE-BE)**2* + $ (SH*SH-(AMZIZ1**2-AMZIZ2**2)**2+4*(-1.)**(ITHZ(IZ1)+ + $ ITHZ(IZ2)+1)*SH*AMZIZ1*AMZIZ2+4*SH*KK*KK*Z*Z)/PROPZ + SIGZZR=4*E**2*WIJ*CONJG(WIJ)*(AE+BE)**2* + $ (SH*SH-(AMZIZ1**2-AMZIZ2**2)**2+4*(-1.)**(ITHZ(IZ1)+ + $ ITHZ(IZ2)+1)*SH*AMZIZ1*AMZIZ2+4*SH*KK*KK*Z*Z)/PROPZ + SIGLZ=-E*(AE-BE)*(SH-AMZ**2)/2./PROPZ* + $ (REAL(WIJ*CONJG(AEZ(IZ1))*AEZ(IZ2))* + $ SSGST(SH,MEL,Z,IZ1,IZ2)+(-1.)**(ITHZ(IZ1)+ITHZ(IZ2))* + $ REAL(WIJ*AEZ(IZ1)*CONJG(AEZ(IZ2)))* + $ SSGST(SH,MEL,-Z,IZ1,IZ2)) + SIGRZ=-E*(-1.)**(ITHZ(IZ1)+ITHZ(IZ2)+1)* + $ (AE+BE)*(SH-AMZ**2)/2./PROPZ* + $ (REAL(WIJ*CONJG(BEZ(IZ1))*BEZ(IZ2))* + $ SSGST(SH,MER,Z,IZ1,IZ2)+(-1.)**(ITHZ(IZ1)+ITHZ(IZ2))* + $ REAL(WIJ*BEZ(IZ1)*CONJG(BEZ(IZ2)))* + $ SSGST(SH,MER,-Z,IZ1,IZ2)) + SIGLR=2*KK/16./PI/SH/SQRT(SH)*(SIGLL+SIGZZL+SIGLZ) + SIGRL=2*KK/16./PI/SH/SQRT(SH)*(SIGRR+SIGZZR+SIGRZ) +C BELOW FACTOR OF 2 FOR ID PARTICLES AND JETTYP SWITCH + SIG=(FLEM*FREP*SIGLR+FREM*FLEP*SIGRL)*UNITS/2. + IF (IBREM.AND..NOT.IBEAM) THEN + SIG=SIG*ESTRUC(X1,QSQ)*ESTRUC(X2,QSQ)*JAC + ELSE IF (IBEAM) THEN + SIG=SIG*SSFEL(X1,0)*SSFEL(X2,0)*JAC + END IF + CALL SIGFIL(SIG,0,0,JTYPZ1,JTYPZ2) +410 CONTINUE +400 CONTINUE +C +C Higgs boson mechanisms +C +C E+ E- --> Z H_L; symmetric in cos(theta) + IF((AMZ+AMHL).LT.RSH) THEN + FACLR=E**2*G**2*(SIN(ALFAH+BETA))**2*(AE-BE)**2/CS2THW + FACRL=E**2*G**2*(SIN(ALFAH+BETA))**2*(AE+BE)**2/CS2THW + Z=CTH(1) + PCM=SQRT(SSXLAM(SH,AMZ**2,AMHL**2))/4./EB + EZ0=SQRT(PCM**2+AMZ**2) + FAC1=AMZ**2+EZ0**2-PCM**2*Z**2 + SIGLR=2*FACLR/32./PI/PROPZ/SQRT(SH)*PCM*FAC1 + SIGRL=2*FACRL/32./PI/PROPZ/SQRT(SH)*PCM*FAC1 + SIG=(FLEM*FREP*SIGLR+FREM*FLEP*SIGRL)*UNITS/2. + IF (IBREM.AND..NOT.IBEAM) THEN + SIG=SIG*ESTRUC(X1,QSQ)*ESTRUC(X2,QSQ)*JAC + ELSE IF (IBEAM) THEN + SIG=SIG*SSFEL(X1,0)*SSFEL(X2,0)*JAC + END IF + IF(GOQ(80,1).AND.GOQ(81,2)) CALL SIGFIL(SIG,0,0,80,81) + IF(GOQ(81,1).AND.GOQ(80,2)) CALL SIGFIL(SIG,0,0,81,80) + ENDIF +C E+ E- --> Z H_H; symmetric in cos(theta) + IF((AMZ+AMHH).LT.RSH) THEN + FACLR=E**2*G**2*(COS(ALFAH+BETA))**2*(AE-BE)**2/CS2THW + FACRL=E**2*G**2*(COS(ALFAH+BETA))**2*(AE+BE)**2/CS2THW + Z=CTH(1) + PCM=SQRT(SSXLAM(SH,AMZ**2,AMHH**2))/4./EB + EZ0=SQRT(PCM**2+AMZ**2) + FAC1=AMZ**2+EZ0**2-PCM**2*Z**2 + SIGLR=2*FACLR/32./PI/PROPZ/SQRT(SH)*PCM*FAC1 + SIGRL=2*FACRL/32./PI/PROPZ/SQRT(SH)*PCM*FAC1 + SIG=(FLEM*FREP*SIGLR+FREM*FLEP*SIGRL)*UNITS/2. + IF (IBREM.AND..NOT.IBEAM) THEN + SIG=SIG*ESTRUC(X1,QSQ)*ESTRUC(X2,QSQ)*JAC + ELSE IF (IBEAM) THEN + SIG=SIG*SSFEL(X1,0)*SSFEL(X2,0)*JAC + END IF + IF(GOQ(80,1).AND.GOQ(82,2)) CALL SIGFIL(SIG,0,0,80,82) + IF(GOQ(82,1).AND.GOQ(80,2)) CALL SIGFIL(SIG,0,0,82,80) + ENDIF +C E+ E- --> H_P H_L; symmetric in cos(theta) + IF((AMHA+AMHL).LT.RSH) THEN + PCM=SQRT(SSXLAM(SH,AMHA**2,AMHL**2))/4./EB + Z=CTH(1) + FAC1=PCM**3*(1.-Z**2) + FACLR=E**4*(COS(ALFAH+BETA))**2*(AE-BE)**2*FAC1 + FACRL=E**4*(COS(ALFAH+BETA))**2*(AE+BE)**2*FAC1 + SIGLR=2*FACLR/32./PI/SQRT(SH)/SN2THW/CS2THW/PROPZ + SIGRL=2*FACRL/32./PI/SQRT(SH)/SN2THW/CS2THW/PROPZ + SIG=(FLEM*FREP*SIGLR+FREM*FLEP*SIGRL)*UNITS/2. + IF (IBREM.AND..NOT.IBEAM) THEN + SIG=SIG*ESTRUC(X1,QSQ)*ESTRUC(X2,QSQ)*JAC + ELSE IF (IBEAM) THEN + SIG=SIG*SSFEL(X1,0)*SSFEL(X2,0)*JAC + END IF + IF(GOQ(81,1).AND.GOQ(83,2)) CALL SIGFIL(SIG,0,0,81,83) + IF(GOQ(83,1).AND.GOQ(81,2)) CALL SIGFIL(SIG,0,0,83,81) + ENDIF +C E+ E- --> H_P H_H; SYMMETRIC IN COS(THETA) + IF((AMHA+AMHH).LT.RSH) THEN + PCM=SQRT(SSXLAM(SH,AMHA**2,AMHH**2))/4./EB + Z=CTH(1) + FAC1=PCM**3*(1.-Z**2) + FACLR=E**4*(SIN(ALFAH+BETA))**2*(AE-BE)**2*FAC1 + FACRL=E**4*(SIN(ALFAH+BETA))**2*(AE+BE)**2*FAC1 + SIGLR=2*FACLR/32./PI/SQRT(SH)/SN2THW/CS2THW/PROPZ + SIGRL=2*FACRL/32./PI/SQRT(SH)/SN2THW/CS2THW/PROPZ + SIG=(FLEM*FREP*SIGLR+FREM*FLEP*SIGRL)*UNITS/2. + IF (IBREM.AND..NOT.IBEAM) THEN + SIG=SIG*ESTRUC(X1,QSQ)*ESTRUC(X2,QSQ)*JAC + ELSE IF (IBEAM) THEN + SIG=SIG*SSFEL(X1,0)*SSFEL(X2,0)*JAC + END IF + IF(GOQ(82,1).AND.GOQ(83,2)) CALL SIGFIL(SIG,0,0,82,83) + IF(GOQ(83,1).AND.GOQ(82,2)) CALL SIGFIL(SIG,0,0,83,82) + ENDIF +C E+ E- --> H^+ H^-; symmetric in cos(theta) + IF((2*AMHC).LT.RSH) THEN + PCM=SQRT(SSXLAM(SH,AMHC**2,AMHC**2))/4./EB + Z=CTH(1) + FAC1=PCM**3*(1.-Z**2) + FACLR=FAC1*(1./SH**2+(2*SN2THW-1.)**2/SN2THW/CS2THW* + $(AE-BE)**2/4./PROPZ+(2*SN2THW-1.)*(AE-BE)*(SH-AMZ**2)/SH/ + $SQRT(SN2THW*CS2THW)/PROPZ) + FACRL=FAC1*(1./SH**2+(2*SN2THW-1.)**2/SN2THW/CS2THW* + $(AE+BE)**2/4./PROPZ+(2*SN2THW-1.)*(AE+BE)*(SH-AMZ**2)/SH/ + $SQRT(SN2THW*CS2THW)/PROPZ) + SIGLR=2*E**4*FACLR/8./PI/SQRT(SH) + SIGRL=2*E**4*FACRL/8./PI/SQRT(SH) + SIG=(FLEM*FREP*SIGLR+FREM*FLEP*SIGRL)*UNITS/2. + IF (IBREM.AND..NOT.IBEAM) THEN + SIG=SIG*ESTRUC(X1,QSQ)*ESTRUC(X2,QSQ)*JAC + ELSE IF (IBEAM) THEN + SIG=SIG*SSFEL(X1,0)*SSFEL(X2,0)*JAC + END IF + IF(GOQ(84,1).AND.GOQ(85,2)) CALL SIGFIL(SIG,0,0,84,85) + IF(GOQ(85,1).AND.GOQ(84,2)) CALL SIGFIL(SIG,0,0,85,84) + ENDIF +C + RETURN + END diff --git a/ISAJET/code/sigssl.F b/ISAJET/code/sigssl.F new file mode 100644 index 00000000000..892cc20f76e --- /dev/null +++ b/ISAJET/code/sigssl.F @@ -0,0 +1,630 @@ +#include "isajet/pilot.h" + SUBROUTINE SIGSSL +C +C Calculate d(sigma)/d(pt**2)d(y1)d(y2) for supersymmetric +C sleptons and sneutrinos in MSSM using cross +C sections from Baer and Tata. +C +C SIGMA = cross section summed over types allowed by +C JETTYPE cards. +C SIGS(I) = partial cross section for I1 + I2 --> I3 + I4 +C INOUT(I) = IOPAK**3*I4 + IOPAK**2*I3 + IOPAK*I2 +I1 +C JETTYP -> IDENT mapping: +C GLSS, UPSSL, UBSSL, ..., UPSSR, UBSSR, ..., +C W1SS+, W1SS-, WS22+, W2SS-, Z1SS, Z2SS, Z3SS, Z4SS +C NUEL, ANUEL, EL-, ..., TAUL+ +C +C Extra factor of 1/2 needed for nonidentical final jets. +C Y=-log(tan(theta/2)) gives jacobean P1*P2/E1*E2 +C +C Called from SIGSSY and so does not reinitialize /JETSIG/. +C +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/const.inc" +#include "isajet/jetpar.inc" +#include "isajet/jetsig.inc" +#include "isajet/primar.inc" +#include "isajet/q1q2.inc" +#include "isajet/qcdpar.inc" +#include "isajet/sspar.inc" +#include "isajet/sssm.inc" +#include "isajet/sstype.inc" +#include "isajet/wcon.inc" +C + REAL X(2) + EQUIVALENCE (X(1),X1) + EQUIVALENCE (S,SHAT),(T,THAT),(U,UHAT) + INTEGER JS2JT(25),IW2JS(4),IW2IM(4),IZ2JS(4),IS2UD(25) + SAVE JS2JT,IW2JS,IW2IM,IZ2JS,IS2UD + INTEGER IDLSS(18) + SAVE IDLSS + INTEGER IL2JS(18),IS2LN(18),II + SAVE IL2JS,IS2LN + REAL SIG,S,T,U,FAC,AM22,AM12,TT,GP,G, + $E1,E2 + INTEGER IQ,IQ1,IQ2,IH + REAL QFCN,STRUC,PSIFCN,AMASS + REAL SR2,AML,AMN,SIGW,PROPZ + REAL CS2THW,TNTHW,CTTHW,AL(2),BE(2),ESQ,XWI(2),YWI(2) + REAL ALL(2),BEL(2),EL1 + REAL EQ1,XMGG,XMZZ,XMGZ,XM,CTH2L + REAL SIGUT,SIGTU,EHAT,PHAT,EBM,TPP,AMWI,AMQ,PROPW + REAL A,B,ASPBS,ASMBS,TM1,TM2,TM3,COTB,TANB + INTEGER JTYP1,JTYP2,IFLQ,IUD(13) + INTEGER IFLL,IL,IN,IDL,IDN,IL1,IL2,JTYPL1,JTYPL2,IDL1,IDL2 +C +C IDENT codes from /SSTYPE/. (Fortran 77 allows - signs in +C parameter statements but not data statements.) + INTEGER MSUPL,MSDNL,MSSTL,MSCHL,MSBT1,MSTP1, + $MSUPR,MSDNR,MSSTR,MSCHR,MSBT2,MSTP2,MSW1,MSW2, + $MSNEL,MSEL,MSNML,MSMUL,MSNTL,MSTAU1,MSER,MSMUR,MSTAU2 + PARAMETER (MSUPL=-ISUPL) + PARAMETER (MSDNL=-ISDNL) + PARAMETER (MSSTL=-ISSTL) + PARAMETER (MSCHL=-ISCHL) + PARAMETER (MSBT1=-ISBT1) + PARAMETER (MSTP1=-ISTP1) + PARAMETER (MSUPR=-ISUPR) + PARAMETER (MSDNR=-ISDNR) + PARAMETER (MSSTR=-ISSTR) + PARAMETER (MSCHR=-ISCHR) + PARAMETER (MSBT2=-ISBT2) + PARAMETER (MSTP2=-ISTP2) + PARAMETER (MSW1=-ISW1) + PARAMETER (MSW2=-ISW2) + PARAMETER (MSNEL=-ISNEL) + PARAMETER (MSEL=-ISEL) + PARAMETER (MSNML=-ISNML) + PARAMETER (MSMUL=-ISMUL) + PARAMETER (MSNTL=-ISNTL) + PARAMETER (MSTAU1=-ISTAU1) + PARAMETER (MSER=-ISER) + PARAMETER (MSMUR=-ISMUR) + PARAMETER (MSTAU2=-ISTAU2) + DATA IDLSS/ISNEL,MSNEL,ISEL,MSEL,ISNML,MSNML,ISMUL,MSMUL, + $ISNTL,MSNTL,ISTAU1,MSTAU1,ISER,MSER,ISMUR,MSMUR, + $ISTAU2,MSTAU2/ + DATA IUD/0,1,-1,2,-2,2,-2,1,-1,2,-2,1,-1/ +C +C JS2JT: Susy jettype -> normal jettype + DATA JS2JT/1, + $2,3,4,5,6,7,8,9,10,11,12,13,2,3,4,5,6,7,8,9,10,11,12,13/ +C IW2JS: Wino index -> susy jettype + DATA IW2JS/26,27,28,29/ +C IW2IM: Wino index -> match code + DATA IW2IM/2,3,2,3/ +C IZ2JS: Zino index -> susy jettype + DATA IZ2JS/30,31,32,33/ +C IS2UD: Susy jettype -> u/d code + DATA IS2UD/0,1,1,2,2,2,2,1,1,2,2,1,1,1,1,2,2,2,2,1,1,2,2,1,1/ + DATA IS2LN/1,1,2,2,1,1,2,2,1,1,2,2,2,2,2,2,2,2/ + DATA IL2JS/34,35,36,37,38,39,40,41,42,43,44,45,46,47, + $48,49,50,51/ +C +C Functions + QFCN(IQ,IH)=STRUC(X(IH),QSQ,IQ,IDIN(IH))/X(IH) + PSIFCN(AM12,AM22,TT)=((S+TT-AM12)/(2*S) + $-AM12*(AM22-TT)/(AM12-TT)**2 + $+(TT*(AM22-AM12)+AM22*(S-AM22+AM12))/(S*(AM12-TT))) +C +C Constants from Baer and Tata, +C + G=SQRT(4*PI*ALFAEM/SN2THW) + GP=G*SQRT(SN2THW/(1.-SN2THW)) +C Quark couplings to Z + CS2THW=1.-SN2THW + TNTHW=SQRT(SN2THW/CS2THW) + CTTHW=1./TNTHW + AL(1)=(CTTHW/4.-5*TNTHW/12.) + AL(2)=(TNTHW/12.-CTTHW/4.) + BE(1)=-(CTTHW+TNTHW)/4. + BE(2)=-BE(1) + ALL(1)=(CTTHW+TNTHW)/4. + ALL(2)=(-CTTHW+3*TNTHW)/4. + BEL(1)=-(CTTHW+TNTHW)/4. + BEL(2)=-BEL(1) + ESQ=4*PI*ALFAEM + SR2=SQRT(2.) + COTB=RV2V1 + TANB=1./COTB +C +C qk qb --> slss slbss +C +C +C Left-leftbar slepton pair production +C + DO 200 IL=1,6 + IL1=2*IL-1 + IL2=IL1+1 + AML=AMASS(IDLSS(IL1)) + JTYPL1=IL2JS(IL1) + JTYPL2=IL2JS(IL2) + IDL1=IDLSS(IL1) + IDL2=IDLSS(IL2) + IF (.NOT.(GOQ(JTYPL1,1).AND.GOQ(JTYPL2,2))) GO TO 210 + CALL TWOKIN(0.,0.,AML,AML) + IF (X1.GE.1..OR.X2.GE.1.) GO TO 210 + E1=SQRT(P(1)**2+AML**2) + E2=SQRT(P(2)**2+AML**2) + FAC=1./(16.*PI*S**2) + FAC=FAC*S/SCM*(P(1)*P(2)/(E1*E2))*UNITS + DO 220 IQ1=2,11 + IFLQ=IS2UD(IQ1) + IFLL=IS2LN(IL1) + IF (IFLQ.EQ.1) THEN + EQ1=2./3. + ELSE + EQ1=-1./3. + END IF + IF (IFLL.EQ.1) THEN + EL1=0. + ELSE + EL1=-1. + END IF + IQ2=MATCH(IQ1,4) + PROPZ=(S-AMZ**2)**2+AMZ**2*GAMZ**2 + IF (IQ2.EQ.0.OR.IQ2.GE.12) GO TO 220 + XMGG=EL1**2*EQ1**2/S/S + CTH2L=1. + IF (JTYPL1.EQ.44) CTH2L=COS(2*THETAL) + XMZZ=(AL(IFLQ)**2+BE(IFLQ)**2)*(ALL(IFLL)-BEL(IFLL)* + $ CTH2L)**2/PROPZ + XMGZ=2*EL1*EQ1*AL(IFLQ)*(ALL(IFLL)-BEL(IFLL)*CTH2L)* + $ (S-AMZ**2)/S/PROPZ + XM=2*ESQ*ESQ*(U*T-AML**4)/3. + SIG=XM*(XMGG+XMZZ+XMGZ) + SIG=SIG*FAC*QFCN(IQ1,1)*QFCN(IQ2,2) + SIG=.5*SIG + CALL SIGFIL(SIG,IQ1,IQ2,JTYPL1,JTYPL2) +220 CONTINUE +210 CONTINUE +200 CONTINUE +C stau_1 + stau_2 bar + IF (GOQ(44,1).AND.GOQ(51,2)) THEN + CALL TWOKIN(0.,0.,AML1SS,AML2SS) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 231 + E1=SQRT(P(1)**2+AML1SS**2) + E2=SQRT(P(2)**2+AML2SS**2) + FAC=1./(16.*PI*S**2) + FAC=FAC*S/SCM*(P(1)*P(2)/(E1*E2))*UNITS + PROPZ=(S-AMZ**2)**2+AMZ**2*GAMZ**2 + DO 230 IQ1=2,11 + IFLQ=IS2UD(IQ1) + IQ2=MATCH(IQ1,4) + IF (IQ2.EQ.0.OR.IQ2.GE.12) GO TO 230 + SIG=2*ESQ**2*(AL(IFLQ)**2+BE(IFLQ)**2)*BEL(2)**2* + $ SIN(2*THETAL)**2*(U*T-AML1SS**2*AML2SS**2)/3./PROPZ + SIG=.5*SIG*FAC*QFCN(IQ1,1)*QFCN(IQ2,2) + CALL SIGFIL(SIG,IQ1,IQ2,44,51) +230 CONTINUE +231 CONTINUE + END IF +C +C +C Right-rightbar slepton pair production +C + DO 300 IL=1,3 + IL1=11+2*IL + IL2=IL1+1 + AML=AMASS(IDLSS(IL1)) + JTYPL1=IL2JS(IL1) + JTYPL2=IL2JS(IL2) + IDL1=IDLSS(IL1) + IDL2=IDLSS(IL2) + IF (.NOT.(GOQ(JTYPL1,1).AND.GOQ(JTYPL2,2))) GO TO 310 + CALL TWOKIN(0.,0.,AML,AML) + IF (X1.GE.1..OR.X2.GE.1.) GO TO 310 + E1=SQRT(P(1)**2+AML**2) + E2=SQRT(P(2)**2+AML**2) + FAC=1./(16.*PI*S**2) + FAC=FAC*S/SCM*(P(1)*P(2)/(E1*E2))*UNITS + DO 320 IQ1=2,11 + IFLQ=IS2UD(IQ1) + IFLL=IS2LN(IL1) + IF (IFLQ.EQ.1) THEN + EQ1=2./3. + ELSE + EQ1=-1./3. + END IF + IF (IFLL.EQ.1) THEN + EL1=0. + ELSE + EL1=-1. + END IF + IQ2=MATCH(IQ1,4) + PROPZ=(S-AMZ**2)**2+AMZ**2*GAMZ**2 + IF (IQ2.EQ.0.OR.IQ2.GE.12) GO TO 320 + XMGG=EL1**2*EQ1**2/S/S + CTH2L=1. + IF (JTYPL1.EQ.50) CTH2L=COS(2*THETAL) + XMZZ=(AL(IFLQ)**2+BE(IFLQ)**2)*(ALL(IFLL)+BEL(IFLL)* + $ CTH2L)**2/PROPZ + XMGZ=2*EL1*EQ1*AL(IFLQ)*(ALL(IFLL)+BEL(IFLL)*CTH2L)* + $ (S-AMZ**2)/S/PROPZ + XM=2*ESQ*ESQ*(U*T-AML**4)/3. + SIG=XM*(XMGG+XMZZ+XMGZ) + SIG=SIG*FAC*QFCN(IQ1,1)*QFCN(IQ2,2) + SIG=.5*SIG + CALL SIGFIL(SIG,IQ1,IQ2,JTYPL1,JTYPL2) +320 CONTINUE +310 CONTINUE +300 CONTINUE +C stau_2 bar + stau_1 + IF (GOQ(51,1).AND.GOQ(44,2)) THEN + CALL TWOKIN(0.,0.,AML2SS,AML1SS) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 331 + E1=SQRT(P(1)**2+AML2SS**2) + E2=SQRT(P(2)**2+AML1SS**2) + FAC=1./(16.*PI*S**2) + FAC=FAC*S/SCM*(P(1)*P(2)/(E1*E2))*UNITS + PROPZ=(S-AMZ**2)**2+AMZ**2*GAMZ**2 + DO 330 IQ1=2,11 + IFLQ=IS2UD(IQ1) + IQ2=MATCH(IQ1,4) + IF (IQ2.EQ.0.OR.IQ2.GE.12) GO TO 330 + SIG=2*ESQ**2*(AL(IFLQ)**2+BE(IFLQ)**2)*BEL(2)**2* + $ SIN(2*THETAL)**2*(U*T-AML1SS**2*AML2SS**2)/3./PROPZ + SIG=.5*SIG*FAC*QFCN(IQ1,1)*QFCN(IQ2,2) + CALL SIGFIL(SIG,IQ1,IQ2,51,44) +330 CONTINUE +331 CONTINUE + END IF +C +C +C Leftbar-left slepton pair production +C + DO 400 IL=1,6 + IL1=2*IL + IL2=IL1-1 + AML=AMASS(IDLSS(IL1)) + JTYPL1=IL2JS(IL1) + JTYPL2=IL2JS(IL2) + IDL1=IDLSS(IL1) + IDL2=IDLSS(IL2) + IF (.NOT.(GOQ(JTYPL1,1).AND.GOQ(JTYPL2,2))) GO TO 410 + CALL TWOKIN(0.,0.,AML,AML) + IF (X1.GE.1..OR.X2.GE.1.) GO TO 410 + E1=SQRT(P(1)**2+AML**2) + E2=SQRT(P(2)**2+AML**2) + FAC=1./(16.*PI*S**2) + FAC=FAC*S/SCM*(P(1)*P(2)/(E1*E2))*UNITS + DO 420 IQ1=2,11 + IFLQ=IS2UD(IQ1) + IFLL=IS2LN(IL1) + IF (IFLQ.EQ.1) THEN + EQ1=2./3. + ELSE + EQ1=-1./3. + END IF + IF (IFLL.EQ.1) THEN + EL1=0. + ELSE + EL1=-1. + END IF + IQ2=MATCH(IQ1,4) + PROPZ=(S-AMZ**2)**2+AMZ**2*GAMZ**2 + IF (IQ2.EQ.0.OR.IQ2.GE.12) GO TO 420 + XMGG=EL1**2*EQ1**2/S/S + CTH2L=1. + IF (JTYPL1.EQ.45) CTH2L=COS(2*THETAL) + XMZZ=(AL(IFLQ)**2+BE(IFLQ)**2)*(ALL(IFLL)-BEL(IFLL)* + $ CTH2L)**2/PROPZ + XMGZ=2*EL1*EQ1*AL(IFLQ)*(ALL(IFLL)-BEL(IFLL)*CTH2L)* + $ (S-AMZ**2)/S/PROPZ + XM=2*ESQ*ESQ*(U*T-AML**4)/3. + SIG=XM*(XMGG+XMZZ+XMGZ) + SIG=SIG*FAC*QFCN(IQ1,1)*QFCN(IQ2,2) + SIG=.5*SIG + CALL SIGFIL(SIG,IQ1,IQ2,JTYPL1,JTYPL2) +420 CONTINUE +410 CONTINUE +400 CONTINUE +C stau_1 bar + stau_2 + IF (GOQ(45,1).AND.GOQ(50,2)) THEN + CALL TWOKIN(0.,0.,AML1SS,AML2SS) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 431 + E1=SQRT(P(1)**2+AML1SS**2) + E2=SQRT(P(2)**2+AML2SS**2) + FAC=1./(16.*PI*S**2) + FAC=FAC*S/SCM*(P(1)*P(2)/(E1*E2))*UNITS + PROPZ=(S-AMZ**2)**2+AMZ**2*GAMZ**2 + DO 430 IQ1=2,11 + IFLQ=IS2UD(IQ1) + IQ2=MATCH(IQ1,4) + IF (IQ2.EQ.0.OR.IQ2.GE.12) GO TO 430 + SIG=2*ESQ**2*(AL(IFLQ)**2+BE(IFLQ)**2)*BEL(2)**2* + $ SIN(2*THETAL)**2*(U*T-AML1SS**2*AML2SS**2)/3./PROPZ + SIG=.5*SIG*FAC*QFCN(IQ1,1)*QFCN(IQ2,2) + CALL SIGFIL(SIG,IQ1,IQ2,45,50) +430 CONTINUE +431 CONTINUE + END IF +C +C +C Rightbar-right slepton pair production +C + DO 500 IL=1,3 + IL1=12+2*IL + IL2=IL1-1 + AML=AMASS(IDLSS(IL1)) + JTYPL1=IL2JS(IL1) + JTYPL2=IL2JS(IL2) + IDL1=IDLSS(IL1) + IDL2=IDLSS(IL2) + IF (.NOT.(GOQ(JTYPL1,1).AND.GOQ(JTYPL2,2))) GO TO 510 + CALL TWOKIN(0.,0.,AML,AML) + IF (X1.GE.1..OR.X2.GE.1.) GO TO 510 + E1=SQRT(P(1)**2+AML**2) + E2=SQRT(P(2)**2+AML**2) + FAC=1./(16.*PI*S**2) + FAC=FAC*S/SCM*(P(1)*P(2)/(E1*E2))*UNITS + DO 520 IQ1=2,11 + IFLQ=IS2UD(IQ1) + IFLL=IS2LN(IL1) + IF (IFLQ.EQ.1) THEN + EQ1=2./3. + ELSE + EQ1=-1./3. + END IF + IF (IFLL.EQ.1) THEN + EL1=0. + ELSE + EL1=-1. + END IF + IQ2=MATCH(IQ1,4) + PROPZ=(S-AMZ**2)**2+AMZ**2*GAMZ**2 + IF (IQ2.EQ.0.OR.IQ2.GE.12) GO TO 520 + XMGG=EL1**2*EQ1**2/S/S + CTH2L=1. + IF (JTYPL1.EQ.51) CTH2L=COS(2*THETAL) + XMZZ=(AL(IFLQ)**2+BE(IFLQ)**2)*(ALL(IFLL)+BEL(IFLL)* + $ CTH2L)**2/PROPZ + XMGZ=2*EL1*EQ1*AL(IFLQ)*(ALL(IFLL)+BEL(IFLL)*CTH2L)* + $ (S-AMZ**2)/S/PROPZ + XM=2*ESQ*ESQ*(U*T-AML**4)/3. + SIG=XM*(XMGG+XMZZ+XMGZ) + SIG=SIG*FAC*QFCN(IQ1,1)*QFCN(IQ2,2) + SIG=.5*SIG + CALL SIGFIL(SIG,IQ1,IQ2,JTYPL1,JTYPL2) +520 CONTINUE +510 CONTINUE +500 CONTINUE +C stau_2 + stau_1 bar + IF (GOQ(50,1).AND.GOQ(45,2)) THEN + CALL TWOKIN(0.,0.,AML2SS,AML1SS) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 531 + E1=SQRT(P(1)**2+AML2SS**2) + E2=SQRT(P(2)**2+AML1SS**2) + FAC=1./(16.*PI*S**2) + FAC=FAC*S/SCM*(P(1)*P(2)/(E1*E2))*UNITS + PROPZ=(S-AMZ**2)**2+AMZ**2*GAMZ**2 + DO 530 IQ1=2,11 + IFLQ=IS2UD(IQ1) + IQ2=MATCH(IQ1,4) + IF (IQ2.EQ.0.OR.IQ2.GE.12) GO TO 530 + SIG=2*ESQ**2*(AL(IFLQ)**2+BE(IFLQ)**2)*BEL(2)**2* + $ SIN(2*THETAL)**2*(U*T-AML1SS**2*AML2SS**2)/3./PROPZ + SIG=.5*SIG*FAC*QFCN(IQ1,1)*QFCN(IQ2,2) + CALL SIGFIL(SIG,IQ1,IQ2,50,45) +530 CONTINUE +531 CONTINUE + END IF +C +C slepton+sneutrino-bar via W-* +C + DO 600 II=1,3 + IL=4*II-1 + IN=IL-1 + IDL=IDLSS(IL) + IDN=IDLSS(IN) + AML=AMASS(IDL) + AMN=AMASS(IDN) + JTYP1=IL2JS(IL) + JTYP2=IL2JS(IN) + IF(.NOT.(GOQ(JTYP1,1).AND.GOQ(JTYP2,2))) GO TO 610 + CALL TWOKIN(0.,0.,AML,AMN) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 610 + E1=SQRT(P(1)**2+AML**2) + E2=SQRT(P(2)**2+AMN**2) + FAC=1./(16.*PI*S**2) + FAC=FAC*S/SCM*(P(1)*P(2)/(E1*E2))*UNITS + PROPW=(S-AMW**2)**2+AMW**2*GAMW**2 + SIGW=G**4*(U*T-AML**2*AMN**2)/12./PROPW + IF (JTYP1.EQ.44) SIGW=SIGW*COS(THETAL)**2 + SIG=.5*SIGW*FAC*QFCN(3,1)*QFCN(4,2) + CALL SIGFIL(SIG,3,4,JTYP1,JTYP2) + SIG=.5*SIGW*FAC*QFCN(4,1)*QFCN(3,2) + CALL SIGFIL(SIG,4,3,JTYP1,JTYP2) + SIG=.5*SIGW*FAC*QFCN(9,1)*QFCN(6,2) + CALL SIGFIL(SIG,9,6,JTYP1,JTYP2) + SIG=.5*SIGW*FAC*QFCN(6,1)*QFCN(9,2) + CALL SIGFIL(SIG,6,9,JTYP1,JTYP2) +610 CONTINUE +600 CONTINUE +C stau_2 +nu_tau bar + IF (GOQ(50,1).AND.GOQ(43,2)) THEN + CALL TWOKIN(0.,0.,AML2SS,AMN3SS) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 620 + E1=SQRT(P(1)**2+AML2SS**2) + E2=SQRT(P(2)**2+AMN3SS**2) + FAC=1./(16.*PI*S**2) + FAC=FAC*S/SCM*(P(1)*P(2)/(E1*E2))*UNITS + PROPW=(S-AMW**2)**2+AMW**2*GAMW**2 + SIGW=G**4*(U*T-AML2SS**2*AMN3SS**2)/12./PROPW + SIGW=SIGW*SIN(THETAL)**2 + SIG=.5*SIGW*FAC*QFCN(3,1)*QFCN(4,2) + CALL SIGFIL(SIG,3,4,50,43) + SIG=.5*SIGW*FAC*QFCN(4,1)*QFCN(3,2) + CALL SIGFIL(SIG,4,3,50,43) + SIG=.5*SIGW*FAC*QFCN(9,1)*QFCN(6,2) + CALL SIGFIL(SIG,9,6,50,43) + SIG=.5*SIGW*FAC*QFCN(6,1)*QFCN(9,2) + CALL SIGFIL(SIG,6,9,50,43) +620 CONTINUE + END IF +C +C sneutrino-bar+slepton via W-* +C + DO 700 II=1,3 + IN=4*II-2 + IL=IN+1 + IDL=IDLSS(IL) + IDN=IDLSS(IN) + AML=AMASS(IDL) + AMN=AMASS(IDN) + JTYP1=IL2JS(IN) + JTYP2=IL2JS(IL) + IF(.NOT.(GOQ(JTYP1,1).AND.GOQ(JTYP2,2))) GO TO 710 + CALL TWOKIN(0.,0.,AMN,AML) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 710 + E1=SQRT(P(1)**2+AMN**2) + E2=SQRT(P(2)**2+AML**2) + FAC=1./(16.*PI*S**2) + FAC=FAC*S/SCM*(P(1)*P(2)/(E1*E2))*UNITS + PROPW=(S-AMW**2)**2+AMW**2*GAMW**2 + SIGW=G**4*(U*T-AML**2*AMN**2)/12./PROPW + IF (JTYP2.EQ.44) SIGW=SIGW*COS(THETAL)**2 + SIG=.5*SIGW*FAC*QFCN(3,1)*QFCN(4,2) + CALL SIGFIL(SIG,3,4,JTYP1,JTYP2) + SIG=.5*SIGW*FAC*QFCN(4,1)*QFCN(3,2) + CALL SIGFIL(SIG,4,3,JTYP1,JTYP2) + SIG=.5*SIGW*FAC*QFCN(9,1)*QFCN(6,2) + CALL SIGFIL(SIG,9,6,JTYP1,JTYP2) + SIG=.5*SIGW*FAC*QFCN(6,1)*QFCN(9,2) + CALL SIGFIL(SIG,6,9,JTYP1,JTYP2) +710 CONTINUE +700 CONTINUE +C nu_tau bar + STAU_2 + IF (GOQ(43,1).AND.GOQ(50,2)) THEN + CALL TWOKIN(0.,0.,AMN3SS,AML2SS) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 720 + E1=SQRT(P(1)**2+AMN3SS**2) + E2=SQRT(P(2)**2+AML2SS**2) + FAC=1./(16.*PI*S**2) + FAC=FAC*S/SCM*(P(1)*P(2)/(E1*E2))*UNITS + PROPW=(S-AMW**2)**2+AMW**2*GAMW**2 + SIGW=G**4*(U*T-AML2SS**2*AMN3SS**2)/12./PROPW + SIGW=SIGW*SIN(THETAL)**2 + SIG=.5*SIGW*FAC*QFCN(3,1)*QFCN(4,2) + CALL SIGFIL(SIG,3,4,43,50) + SIG=.5*SIGW*FAC*QFCN(4,1)*QFCN(3,2) + CALL SIGFIL(SIG,4,3,43,50) + SIG=.5*SIGW*FAC*QFCN(9,1)*QFCN(6,2) + CALL SIGFIL(SIG,9,6,43,50) + SIG=.5*SIGW*FAC*QFCN(6,1)*QFCN(9,2) + CALL SIGFIL(SIG,6,9,43,50) +720 CONTINUE + END IF +C +C slepton-bar+sneutrino via W+* +C + DO 800 II=1,3 + IL=4*II + IN=IL-3 + IDL=IDLSS(IL) + IDN=IDLSS(IN) + AML=AMASS(IDL) + AMN=AMASS(IDN) + JTYP1=IL2JS(IL) + JTYP2=IL2JS(IN) + IF(.NOT.(GOQ(JTYP1,1).AND.GOQ(JTYP2,2))) GO TO 810 + CALL TWOKIN(0.,0.,AML,AMN) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 810 + E1=SQRT(P(1)**2+AML**2) + E2=SQRT(P(2)**2+AMN**2) + FAC=1./(16.*PI*S**2) + FAC=FAC*S/SCM*(P(1)*P(2)/(E1*E2))*UNITS + PROPW=(S-AMW**2)**2+AMW**2*GAMW**2 + SIGW=G**4*(U*T-AML**2*AMN**2)/12./PROPW + IF (JTYP1.EQ.45) SIGW=SIGW*COS(THETAL)**2 + SIG=.5*SIGW*FAC*QFCN(2,1)*QFCN(5,2) + CALL SIGFIL(SIG,2,5,JTYP1,JTYP2) + SIG=.5*SIGW*FAC*QFCN(5,1)*QFCN(2,2) + CALL SIGFIL(SIG,5,2,JTYP1,JTYP2) + SIG=.5*SIGW*FAC*QFCN(8,1)*QFCN(7,2) + CALL SIGFIL(SIG,8,7,JTYP1,JTYP2) + SIG=.5*SIGW*FAC*QFCN(7,1)*QFCN(8,2) + CALL SIGFIL(SIG,7,8,JTYP1,JTYP2) +810 CONTINUE +800 CONTINUE +C stau_2 bar+nu_tau + IF (GOQ(51,1).AND.GOQ(42,2)) THEN + CALL TWOKIN(0.,0.,AML2SS,AMN3SS) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 820 + E1=SQRT(P(1)**2+AML2SS**2) + E2=SQRT(P(2)**2+AMN3SS**2) + FAC=1./(16.*PI*S**2) + FAC=FAC*S/SCM*(P(1)*P(2)/(E1*E2))*UNITS + PROPW=(S-AMW**2)**2+AMW**2*GAMW**2 + SIGW=G**4*(U*T-AML2SS**2*AMN3SS**2)/12./PROPW + SIGW=SIGW*SIN(THETAL)**2 + SIG=.5*SIGW*FAC*QFCN(2,1)*QFCN(5,2) + CALL SIGFIL(SIG,2,5,51,42) + SIG=.5*SIGW*FAC*QFCN(5,1)*QFCN(2,2) + CALL SIGFIL(SIG,5,2,51,42) + SIG=.5*SIGW*FAC*QFCN(8,1)*QFCN(7,2) + CALL SIGFIL(SIG,8,7,51,42) + SIG=.5*SIGW*FAC*QFCN(7,1)*QFCN(8,2) + CALL SIGFIL(SIG,7,8,51,42) +820 CONTINUE + END IF +C +C sneutrino+slepton-bar via W+* +C + DO 900 II=1,3 + IN=4*II-3 + IL=IN+3 + IDL=IDLSS(IL) + IDN=IDLSS(IN) + AML=AMASS(IDL) + AMN=AMASS(IDN) + JTYP1=IL2JS(IN) + JTYP2=IL2JS(IL) + IF(.NOT.(GOQ(JTYP1,1).AND.GOQ(JTYP2,2))) GO TO 910 + CALL TWOKIN(0.,0.,AMN,AML) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 910 + E1=SQRT(P(1)**2+AMN**2) + E2=SQRT(P(2)**2+AML**2) + FAC=1./(16.*PI*S**2) + FAC=FAC*S/SCM*(P(1)*P(2)/(E1*E2))*UNITS + PROPW=(S-AMW**2)**2+AMW**2*GAMW**2 + SIGW=G**4*(U*T-AML**2*AMN**2)/12./PROPW + IF (JTYP2.EQ.45) SIGW=SIGW*COS(THETAL)**2 + SIG=.5*SIGW*FAC*QFCN(2,1)*QFCN(5,2) + CALL SIGFIL(SIG,2,5,JTYP1,JTYP2) + SIG=.5*SIGW*FAC*QFCN(5,1)*QFCN(2,2) + CALL SIGFIL(SIG,5,2,JTYP1,JTYP2) + SIG=.5*SIGW*FAC*QFCN(8,1)*QFCN(7,2) + CALL SIGFIL(SIG,8,7,JTYP1,JTYP2) + SIG=.5*SIGW*FAC*QFCN(7,1)*QFCN(8,2) + CALL SIGFIL(SIG,7,8,JTYP1,JTYP2) +910 CONTINUE +900 CONTINUE +C nu_tau + stau_2 bar + IF (GOQ(42,1).AND.GOQ(51,2)) THEN + CALL TWOKIN(0.,0.,AMN3SS,AML2SS) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 920 + E1=SQRT(P(1)**2+AMN3SS**2) + E2=SQRT(P(2)**2+AML2SS**2) + FAC=1./(16.*PI*S**2) + FAC=FAC*S/SCM*(P(1)*P(2)/(E1*E2))*UNITS + PROPW=(S-AMW**2)**2+AMW**2*GAMW**2 + SIGW=G**4*(U*T-AML2SS**2*AMN3SS**2)/12./PROPW + SIGW=SIGW*SIN(THETAL)**2 + SIG=.5*SIGW*FAC*QFCN(2,1)*QFCN(5,2) + CALL SIGFIL(SIG,2,5,42,51) + SIG=.5*SIGW*FAC*QFCN(5,1)*QFCN(2,2) + CALL SIGFIL(SIG,5,2,42,51) + SIG=.5*SIGW*FAC*QFCN(8,1)*QFCN(7,2) + CALL SIGFIL(SIG,8,7,42,51) + SIG=.5*SIGW*FAC*QFCN(7,1)*QFCN(8,2) + CALL SIGFIL(SIG,7,8,42,51) +920 CONTINUE + END IF +C + RETURN + END diff --git a/ISAJET/code/sigssy.F b/ISAJET/code/sigssy.F new file mode 100644 index 00000000000..6a6b195e222 --- /dev/null +++ b/ISAJET/code/sigssy.F @@ -0,0 +1,359 @@ +#include "isajet/pilot.h" + SUBROUTINE SIGSSY +C +C Calculate d(sigma)/d(pt**2)d(y1)d(y2) for supersymmetric +C particle pairs, including gluinos, gauginos, and squarks. +C +C SIGMA = cross section summed over types allowed by +C JETTYPE cards (with natural equivalence.) +C SIGS(I) = partial cross section for I1 + I2 --> I3 + I4 +C INOUT(I) = IOPAK**3*I4 + IOPAK**2*I3 + IOPAK*I2 +I1 +C +C Extra factor of 1/2 needed for nonidentical final jets. +C Y=-log(tan(theta/2)) gives jacobean P1*P2/E1*E2 +C +C Dec. 1992: Use cross sections from Baer and Tata, Phys. +C Lett. 160B, 159; Phys. Rev. D42, 2259. These papers +C separate L and R squarks. +C +C Gauginos are included only for MSSM. The cross sections are +C calculated in SIGSSZ, which is called from here. +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/qcdpar.inc" +#include "isajet/jetpar.inc" +#include "isajet/primar.inc" +#include "isajet/q1q2.inc" +#include "isajet/jetsig.inc" +#include "isajet/const.inc" +#include "isajet/qsave.inc" +#include "isajet/wcon.inc" +#include "isajet/sstype.inc" +#include "isajet/xmssm.inc" +C + REAL X(2) + INTEGER IDQ(13),IDQSS(25),JS2JT(25) + EQUIVALENCE (X(1),X1) + LOGICAL LLRR + REAL QFCN,STRUC,AMASS,FQG + REAL AMG,SIG0,SIGR,AM1,SIG,FAC,AMQ,AM,AM2,AMQ2,S,T,U,AMG2,E1,E2, + $AMSQ,AM1SQ,AM2SQ,SIGL + INTEGER IFL1,IFL2,IQ1,IQ2,JQ1,JQ2,I,IFLQ1,IFLQ2,IH,IQ, + $JQ,JQIN1,JQIN2 +C +C IDENT codes from /SSTYPE/. (Fortran 77 allows - signs in +C parameter statements but not data statements.) + INTEGER MSUPL,MSDNL,MSSTL,MSCHL,MSBT1,MSTP1, + $MSUPR,MSDNR,MSSTR,MSCHR,MSBT2,MSTP2, + $MDUP,MDDN,MDST,MDCH,MDBT,MDTP + PARAMETER (MSUPL=-ISUPL) + PARAMETER (MSDNL=-ISDNL) + PARAMETER (MSSTL=-ISSTL) + PARAMETER (MSCHL=-ISCHL) + PARAMETER (MSBT1=-ISBT1) + PARAMETER (MSTP1=-ISTP1) + PARAMETER (MSUPR=-ISUPR) + PARAMETER (MSDNR=-ISDNR) + PARAMETER (MSSTR=-ISSTR) + PARAMETER (MSCHR=-ISCHR) + PARAMETER (MSBT2=-ISBT2) + PARAMETER (MSTP2=-ISTP2) + PARAMETER (MDUP=-IDUP) + PARAMETER (MDDN=-IDDN) + PARAMETER (MDST=-IDST) + PARAMETER (MDCH=-IDCH) + PARAMETER (MDBT=-IDBT) + PARAMETER (MDTP=-IDTP) + DATA IDQSS/0, + $ISUPL,MSUPL,ISDNL,MSDNL,ISSTL,MSSTL,ISCHL,MSCHL,ISBT1,MSBT1, + $ISTP1,MSTP1, + $ISUPR,MSUPR,ISDNR,MSDNR,ISSTR,MSSTR,ISCHR,MSCHR,ISBT2,MSBT2, + $ISTP2,MSTP2/ + DATA IDQ/IDGL,IDUP,MDUP,IDDN,MDDN,IDST,MDST,IDCH,MDCH, + $IDBT,MDBT,IDTP,MDTP/ +C JS2JT: Susy jettype -> normal jettype + DATA JS2JT/1, + $2,3,4,5,6,7,8,9,10,11,12,13,2,3,4,5,6,7,8,9,10,11,12,13/ +C +C Functions + QFCN(IQ,IH)=STRUC(X(IH),QSQ,IQ,IDIN(IH))/X(IH) + FQG(S,T,U)=((16./3.)*(1./(U*T)**2+1./(S*U)**2) + $+2.*(-2./3.)/(S*T*U**2))*(-U*S*T**2+2.*U*S*T*(AMG2-AMQ2) + $-2.*U*S*(AMG2-AMQ2)**2-2.*S**2*AMG2*(AMG2-AMQ2)) +C +C Initialize +C + SIGMA=0. + NSIGS=0 + DO 100 I=1,MXSIGS + SIGS(I)=0. +100 CONTINUE +C +C Gluino + gluino +C + IF(.NOT.(GOQ(1,1).AND.GOQ(1,2))) GO TO 300 + AM=AMASS(ISGL) + CALL TWOKIN(0.,0.,AM,AM) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 300 + AM2=AM**2 + S=SHAT + T=THAT + U=UHAT + E1=SQRT(P(1)**2+AM2) + E2=SQRT(P(2)**2+AM2) + FAC=PI*ALFQSQ**2/S**2 + FAC=FAC*(S/SCM)*(P(1)*P(2)/(E1*E2))*UNITS +C +C gl gl ---> glss glss + SIG=9./4.*(2.*(T-AM2)*(U-AM2)/S**2 + $+((T-AM2)*(U-AM2)-2.*AM2*(T+AM2))/(T-AM2)**2 + $+((U-AM2)*(T-AM2)-2.*AM2*(U+AM2))/(U-AM2)**2 + $+((T-AM2)*(U-AM2)+AM2*(U-T))/(S*(T-AM2)) + $+((U-AM2)*(T-AM2)+AM2*(T-U))/(S*(U-AM2)) + $+AM2*(S-4*AM2)/((T-AM2)*(U-AM2))) + SIG=.5*FAC*SIG*QFCN(1,1)*QFCN(1,2) + CALL SIGFIL(SIG,1,1,1,1) +C +C qk qb ---> glss glss + DO 220 IQ=1,5 + IQ1=2*IQ + IQ2=IQ1+1 +C Left squark exchange + AMQ=AMASS(IDQSS(IQ1)) + AMQ2=AMQ**2 + SIGL=(8./3.)*((T-AM2)**2+(U-AM2)**2+2.*AM2*S)/(S**2) + $ +(32./27.)*(T-AM2)**2/(T-AMQ2)**2 + $ +(32./27.)*(U-AM2)**2/(U-AMQ2)**2 + $ +(8./3.)*((T-AM2)**2+AM2*S)/(S*(T-AMQ2)) + $ +(8./3.)*((U-AM2)**2+AM2*S)/(S*(U-AMQ2)) + $ +(8./27.)*AM2*S/((T-AMQ2)*(U-AMQ2)) + SIGL=.5*FAC*SIGL +C Right squark exchange + AMQ=AMASS(IDQSS(IQ1+12)) + AMQ2=AMQ**2 + SIGR=(8./3.)*((T-AM2)**2+(U-AM2)**2+2.*AM2*S)/(S**2) + $ +(32./27.)*(T-AM2)**2/(T-AMQ2)**2 + $ +(32./27.)*(U-AM2)**2/(U-AMQ2)**2 + $ +(8./3.)*((T-AM2)**2+AM2*S)/(S*(T-AMQ2)) + $ +(8./3.)*((U-AM2)**2+AM2*S)/(S*(U-AMQ2)) + $ +(8./27.)*AM2*S/((T-AMQ2)*(U-AMQ2)) + SIGR=.5*FAC*SIGR + SIG0=.5*(SIGL+SIGR) +C Total + SIG=SIG0*QFCN(IQ1,1)*QFCN(IQ2,2) + CALL SIGFIL(SIG,IQ1,IQ2,1,1) + SIG=SIG0*QFCN(IQ2,1)*QFCN(IQ1,2) + CALL SIGFIL(SIG,IQ2,IQ1,1,1) +220 CONTINUE +C +C Scalar quark + scalar (anti)quark +C +300 CONTINUE + AMG=AMASS(ISGL) + AMG2=AMG**2 +C IQ1 and IQ2 loop over left and right (anti)squarks + DO 310 IQ1=2,25 + DO 320 IQ2=2,25 + IF(.NOT.(GOQ(IQ1,1).AND.GOQ(IQ2,2))) GO TO 320 + JQ1=JS2JT(IQ1) + JQ2=JS2JT(IQ2) +C IF(JQ1.GE.12.OR.JQ2.GE.12) GO TO 320 + IFL1=IDQSS(IQ1) + IFL2=IDQSS(IQ2) + IFLQ1=IDQ(JQ1) + IFLQ2=IDQ(JQ2) +C LLRR is true for left-left or right-right + IF((IQ1.LE.13.AND.IQ2.LE.13).OR.(IQ1.GT.13.AND.IQ2.GT.13)) + $ THEN + LLRR=.TRUE. + ELSE + LLRR=.FALSE. + ENDIF +C Kinematics + AM1=AMASS(IFL1) + AM2=AMASS(IFL2) + AM=AM1 + CALL TWOKIN(0.,0.,AM1,AM2) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 320 + AMSQ=AM**2 + AM1SQ=AM1**2 + AM2SQ=AM2**2 + S=SHAT + T=THAT + U=UHAT + E1=SQRT(P(1)**2+AM1SQ) + E2=SQRT(P(2)**2+AM2SQ) + FAC=PI*ALFQSQ**2/S**2 + FAC=FAC*(S/SCM)*(P(1)*P(2)/(E1*E2))*UNITS +C +C gl gl ---> qkss qbss +C + IF(IFL1.EQ.-IFL2) THEN + SIG=(7./48.+3.*(U-T)**2/(16.*S**2)) + $ *(1.+2.*AMSQ*T/(T-AMSQ)**2+2.*AMSQ*U/(U-AMSQ)**2 + $ +4.*AMSQ**2/((T-AMSQ)*(U-AMSQ))) + SIG=SIG*FAC*QFCN(1,1)*QFCN(1,2) + SIG=.5*SIG +C Another .5 to sum over L and R + SIG=.5*SIG + CALL SIGFIL(SIG,1,1,IQ1,IQ2) + ENDIF +C +C qk qb ---> qkss qbss +C + IF(IFLQ1.EQ.-IFLQ2.AND.LLRR) THEN +C Identical squark-antisquark, LL or RR + SIG=(2./9.)*(1/(T-AMG2)**2+2/S**2-2/(3*S*(T-AMG2))) + $ *(-S*T-(T-AMSQ)**2)*FAC*QFCN(JQ1,1)*QFCN(JQ2,2) + SIG=.5*SIG + CALL SIGFIL(SIG,JQ1,JQ2,IQ1,IQ2) + SIG=(2./9.)*(1/(U-AMG2)**2+2/S**2-2/(3*S*(U-AMG2))) + $ *(-S*U-(U-AMSQ)**2)*FAC*QFCN(JQ2,1)*QFCN(JQ1,2) + SIG=.5*SIG + CALL SIGFIL(SIG,JQ2,JQ1,IQ1,IQ2) + ELSEIF(IFLQ1.EQ.-IFLQ2.AND..NOT.LLRR) THEN +C Identical squark-antisquark, LR or RL + SIG=(2./9.)*AMG2*S/(T-AMG2)**2*FAC*QFCN(JQ1,1)*QFCN(JQ2,2) + SIG=.5*SIG + CALL SIGFIL(SIG,JQ1,JQ2,IQ1,IQ2) + SIG=(2./9.)*AMG2*S/(U-AMG2)**2*FAC*QFCN(JQ2,1)*QFCN(JQ1,2) + SIG=.5*SIG + CALL SIGFIL(SIG,JQ2,JQ1,IQ1,IQ2) + ELSEIF(IFLQ1.EQ.IFLQ2.AND.LLRR) THEN +C Identical squark-squark, LL or RR + SIG=(1./9.)*AMG2*S*(1/(T-AMG2)**2+1/(U-AMG2)**2 + $ -(2./3.)/((T-AMG2)*(U-AMG2)))*FAC*QFCN(JQ1,1)*QFCN(JQ2,2) + CALL SIGFIL(SIG,JQ1,JQ2,IQ1,IQ2) + ELSEIF(IFLQ1.EQ.IFLQ2.AND..NOT.LLRR) THEN +C Identical squark-squark, LR or RL + SIG=(2./9.)*(1/(T-AMG2)**2*(-S*T-(T-AM1SQ)*(T-AM2SQ)) + $ +1/(U-AMG2)**2*(-S*U-(U-AM1SQ)*(U-AM2SQ))) + $ *FAC*QFCN(JQ1,1)*QFCN(JQ2,2) + CALL SIGFIL(SIG,JQ1,JQ2,IQ1,IQ2) + ELSEIF(IFL1*IFL2.LT.0.AND.LLRR) THEN +C Nonidentical squark-antisquark, LL or RR + SIG=(2./9.)*(-S*T-(T-AM1SQ)*(T-AM2SQ))/(T-AMG2)**2*FAC + $ *QFCN(JQ1,1)*QFCN(JQ2,2) + SIG=.5*SIG + CALL SIGFIL(SIG,JQ1,JQ2,IQ1,IQ2) + SIG=(2./9.)*(-S*U-(U-AM1SQ)*(U-AM2SQ))/(U-AMG2)**2*FAC + $ *QFCN(JQ2,1)*QFCN(JQ1,2) + SIG=.5*SIG + CALL SIGFIL(SIG,JQ2,JQ1,IQ1,IQ2) + ELSEIF(IFL1*IFL2.LT.0.AND..NOT.LLRR) THEN +C Nonidentical squark-antisquark, LR or RL + SIG=(2./9.)*AMG2*S/(T-AMG2)**2*FAC*QFCN(JQ1,1)*QFCN(JQ2,2) + SIG=.5*SIG + CALL SIGFIL(SIG,JQ1,JQ2,IQ1,IQ2) + SIG=(2./9.)*AMG2*S/(U-AMG2)**2*FAC*QFCN(JQ2,1)*QFCN(JQ1,2) + SIG=.5*SIG + CALL SIGFIL(SIG,JQ2,JQ1,IQ1,IQ2) + ELSEIF(IFL1*IFL2.GT.0.AND.LLRR) THEN +C Nonidentical squark-squark, LL or RR + SIG=(2./9.)*AMG2*S/(T-AMG2)**2*FAC*QFCN(JQ1,1)*QFCN(JQ2,2) + SIG=.5*SIG + CALL SIGFIL(SIG,JQ1,JQ2,IQ1,IQ2) + SIG=(2./9.)*AMG2*S/(U-AMG2)**2*FAC*QFCN(JQ2,1)*QFCN(JQ1,2) + SIG=.5*SIG + CALL SIGFIL(SIG,JQ2,JQ1,IQ1,IQ2) + ELSEIF(IFL1*IFL2.GT.0.AND..NOT.LLRR) THEN +C Nonidentical squark-squark, LR or RL + SIG=(2./9.)*(-S*T-(T-AM1SQ)*(T-AM2SQ))/(T-AMG2)**2*FAC + $ *QFCN(JQ1,1)*QFCN(JQ2,2) + SIG=.5*SIG + CALL SIGFIL(SIG,JQ1,JQ2,IQ1,IQ2) + SIG=(2./9.)*(-S*U-(U-AM1SQ)*(U-AM2SQ))/(U-AMG2)**2*FAC + $ *QFCN(JQ2,1)*QFCN(JQ1,2) + SIG=.5*SIG + CALL SIGFIL(SIG,JQ2,JQ1,IQ1,IQ2) + ELSE + STOP99 + ENDIF +C +C q1 + q1bar --> q2ss + q2ssbar +C + IF(IFLQ1.EQ.-IFLQ2.AND.LLRR) THEN + DO 330 JQIN1=2,10,2 + IF(JQIN1.EQ.JQ1.OR.JQIN1.EQ.JQ2) GO TO 330 + JQIN2=MATCH(JQIN1,4) + SIG=(4./9.)*(-S*T-(T-AM1SQ)**2)/S**2*FAC + $ *QFCN(JQIN1,1)*QFCN(JQIN2,2) + SIG=.5*SIG + CALL SIGFIL(SIG,JQIN1,JQIN2,IQ1,IQ2) + SIG=(4./9.)*(-S*U-(U-AM1SQ)**2)/S**2*FAC + $ *QFCN(JQIN2,1)*QFCN(JQIN1,2) + SIG=.5*SIG + CALL SIGFIL(SIG,JQIN2,JQIN1,IQ1,IQ2) +330 CONTINUE + ENDIF +320 CONTINUE +310 CONTINUE +C +C Scalar quark + gluino +C + AMG=AMASS(ISGL) + AMG2=AMG**2 + DO 400 IQ=2,25 + AMQ=AMASS(IDQSS(IQ)) + AMQ2=AMQ**2 + JQ=JS2JT(IQ) +C +C Jet 1 = scalar quark + IF(.NOT.(GOQ(JQ,1).AND.GOQ(1,2))) GO TO 410 + CALL TWOKIN(0.,0.,AMQ,AMG) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 410 + S=SHAT + E1=SQRT(P(1)**2+AMQ2) + E2=SQRT(P(2)**2+AMG2) + FAC=PI*ALFQSQ**2/S**2 + FAC=FAC*S/SCM*P(1)*P(2)/(E1*E2)*UNITS +C + T=THAT-AMQ2 + U=UHAT-AMG2 + SIG=FQG(S,T,U)*FAC/12.*QFCN(JQ,1)*QFCN(1,2) + SIG=.5*SIG + SIG=.5*SIG + CALL SIGFIL(SIG,JQ,1,IQ,1) +C + T=UHAT-AMQ2 + U=THAT-AMG2 + SIG=FQG(S,T,U)*FAC/12.*QFCN(1,1)*QFCN(JQ,2) + SIG=.5*SIG + SIG=.5*SIG + CALL SIGFIL(SIG,1,JQ,IQ,1) +C +C Jet 2 = scalar quark +410 IF(.NOT.(GOQ(1,1).AND.GOQ(JQ,2))) GO TO 400 + CALL TWOKIN(0.,0.,AMG,AMQ) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 400 + S=SHAT + E1=SQRT(P(1)**2+AMG2) + E2=SQRT(P(2)**2+AMQ2) + FAC=PI*ALFQSQ**2/S**2 + FAC=FAC*S/SCM*P(1)*P(2)/(E1*E2)*UNITS +C + T=UHAT-AMQ2 + U=THAT-AMG2 + SIG=FQG(S,T,U)*FAC/12.*QFCN(1,1)*QFCN(JQ,2) + SIG=.5*SIG + SIG=.5*SIG + CALL SIGFIL(SIG,1,JQ,1,IQ) +C + T=THAT-AMQ2 + U=UHAT-AMG2 + SIG=FQG(S,T,U)*FAC/12.*QFCN(JQ,1)*QFCN(1,2) + SIG=.5*SIG + SIG=.5*SIG + CALL SIGFIL(SIG,JQ,1,1,IQ) +400 CONTINUE +C +C Calculate gaugino AND slepton cross sections only for MSSM +C + IF(GOMSSM) CALL SIGSSZ + IF(GOMSSM) CALL SIGSSL +C + RETURN + END diff --git a/ISAJET/code/sigssz.F b/ISAJET/code/sigssz.F new file mode 100644 index 00000000000..cd9c5481763 --- /dev/null +++ b/ISAJET/code/sigssz.F @@ -0,0 +1,802 @@ +#include "isajet/pilot.h" + SUBROUTINE SIGSSZ +C +C Calculate d(sigma)/d(pt**2)d(y1)d(y2) for supersymmetric +C zino or wino plus squark or gluino in MSSM using cross +C sections from Baer, Karatas, and Tata, PR D42, 2259. +C Also include wino and zino pairs. +C +C SIGMA = cross section summed over types allowed by +C JETTYPE cards. +C SIGS(I) = partial cross section for I1 + I2 --> I3 + I4 +C INOUT(I) = IOPAK**3*I4 + IOPAK**2*I3 + IOPAK*I2 +I1 +C JETTYP -> IDENT mapping: +C GLSS, UPSSL, UBSSL, ..., UPSSR, UBSSR, ..., +C W1SS+, W1SS-, WS22+, W2SS-, Z1SS, Z2SS, Z3SS, Z4SS +C +C Extra factor of 1/2 needed for nonidentical final jets. +C Y=-log(tan(theta/2)) gives jacobean P1*P2/E1*E2 +C +C Called from SIGSSY and so does not reinitialize /JETSIG/. +C +C Ver 7.23: Add test setting SIG=0 for Z_i pairs if +C ABS(ZZ)>0.999 and SIG<0. +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/const.inc" +#include "isajet/jetpar.inc" +#include "isajet/jetsig.inc" +#include "isajet/primar.inc" +#include "isajet/q1q2.inc" +#include "isajet/qcdpar.inc" +#include "isajet/sspar.inc" +#include "isajet/sssm.inc" +#include "isajet/sstype.inc" +#include "isajet/wcon.inc" +C + REAL X(2) + EQUIVALENCE (X(1),X1) + COMPLEX AQZ(2,4),BQZ(2,4),AQW(2,2),WIJ + EQUIVALENCE (S,SHAT),(T,THAT),(U,UHAT) + INTEGER JS2JT(25),IW2JS(4),IW2IM(4),IZ2JS(4),IS2UD(25) + SAVE JS2JT,IW2JS,IW2IM,IZ2JS,IS2UD + INTEGER IDQSS(25),IDZSS(4),IDWSS(4) + SAVE IDQSS,IDZSS,IDWSS + INTEGER ITHZ(4),ITHW(2) + REAL AMWISS(2) + REAL XZIWJ(4,2),YZIWJ(4,2) + REAL SIG,SIG0,CON,AMQIQ,S,T,U,AMWIW,FAC,AM22,AM12,TT,GP,G, + $E1,E2,AMG,YM,XM,GS,THX,THY,AMZIZ,AMSQK + INTEGER IX,JQ,IQ,IQ1,IQ2,JW,IW,JTYPW,IH,JTYPZ,IZ,ITHG,IWM + COMPLEX ZONE,ZI + SAVE ZONE,ZI + REAL QFCN,STRUC,PSIFCN,AMASS + REAL CON11,CON22,CON12,AMQIQ1,AMQIQ2 + INTEGER IX1,IX2 + REAL CS2THW,TNTHW,CTTHW,AL(2),BE(2),ESQ,XWI(2),YWI(2) + REAL X12,Y12,SN12,AMWIW1,AMWIW2,EQ1,ZZ,XMGG,XMZZ + REAL XMGZ,XMUU,XMGU,XMZU,XMDD,XMGD,XMZD,DEL,RSH,SR2 + REAL SIGUT,SIGTU,EHAT,PHAT,EBM,TPP,AMWI,AMQ,PROPW + REAL SIGUT1,SIGUT2,SIGUT3,SGUT12,SGUT13,SGUT23 + REAL SIGTU1,SIGTU2,SIGTU3,SGTU12,SGTU13,SGTU23 + REAL AMSQL,AMSQR,KK,AMZIZ1,AMZIZ2 + REAL SIGLL,SIGRR,SIGZZ,SIGLZ,SIGRZ,SSGT,SSGST,PROPZ,SSXLAM + INTEGER IZ1,JTYPZ1,IZ2,JTYPZ2 + INTEGER IW1,JW1,JTYPW1,IDW1,IW2,JW2,JTYPW2,IDW2,IFLQ,IUD(13) +C +C IDENT codes from /SSTYPE/. (Fortran 77 allows - signs in +C parameter statements but not data statements.) + INTEGER MSUPL,MSDNL,MSSTL,MSCHL,MSBT1,MSTP1, + $MSUPR,MSDNR,MSSTR,MSCHR,MSBT2,MSTP2,MSW1,MSW2 + PARAMETER (MSUPL=-ISUPL) + PARAMETER (MSDNL=-ISDNL) + PARAMETER (MSSTL=-ISSTL) + PARAMETER (MSCHL=-ISCHL) + PARAMETER (MSBT1=-ISBT1) + PARAMETER (MSTP1=-ISTP1) + PARAMETER (MSUPR=-ISUPR) + PARAMETER (MSDNR=-ISDNR) + PARAMETER (MSSTR=-ISSTR) + PARAMETER (MSCHR=-ISCHR) + PARAMETER (MSBT2=-ISBT2) + PARAMETER (MSTP2=-ISTP2) + PARAMETER (MSW1=-ISW1) + PARAMETER (MSW2=-ISW2) + DATA IDQSS/0, + $ISUPL,MSUPL,ISDNL,MSDNL,ISSTL,MSSTL,ISCHL,MSCHL,ISBT1,MSBT1, + $ISTP1,MSTP1, + $ISUPR,MSUPR,ISDNR,MSDNR,ISSTR,MSSTR,ISCHR,MSCHR,ISBT2,MSBT2, + $ISTP2,MSTP2/ + DATA IDZSS/ISZ1,ISZ2,ISZ3,ISZ4/ + DATA IDWSS/ISW1,MSW1,ISW2,MSW2/ + DATA IUD/0,1,-1,2,-2,2,-2,1,-1,2,-2,1,-1/ +C +C JS2JT: Susy jettype -> normal jettype + DATA JS2JT/1, + $2,3,4,5,6,7,8,9,10,11,12,13,2,3,4,5,6,7,8,9,10,11,12,13/ +C IW2JS: Wino index -> susy jettype + DATA IW2JS/26,27,28,29/ +C IW2IM: Wino index -> match code + DATA IW2IM/2,3,2,3/ +C IZ2JS: Zino index -> susy jettype + DATA IZ2JS/30,31,32,33/ +C IS2UD: Susy jettype -> u/d code + DATA IS2UD/0,1,1,2,2,2,2,1,1,2,2,1,1,1,1,2,2,2,2,1,1,2,2,1,1/ +C + DATA ZONE,ZI/(1.,0.),(0.,1.)/ +C +C Functions + QFCN(IQ,IH)=STRUC(X(IH),QSQ,IQ,IDIN(IH))/X(IH) + PSIFCN(AM12,AM22,TT)=((S+TT-AM12)/(2*S) + $-AM12*(AM22-TT)/(AM12-TT)**2 + $+(TT*(AM22-AM12)+AM22*(S-AM22+AM12))/(S*(AM12-TT))) +C +C Constants from Baer, Barger, Karatas, and Tata, +C PR D36, 96, using results from SSMIX +C + G=SQRT(4*PI*ALFAEM/SN2THW) + GP=G*SQRT(SN2THW/(1.-SN2THW)) +C GS=SQRT(4.*PI*ALFA3) + XM=1./TAN(GAMMAL) + YM=1./TAN(GAMMAR) + THX=SIGN(1.,XM) + THY=SIGN(1.,YM) + AMG=AMASS(ISGL) + ITHG=+1 +C Signed masses + AMWISS(1)=AMW1SS + AMWISS(2)=AMW2SS +C Zi couplings + DO 100 IZ=1,4 + ITHZ(IZ)=0 + IF(AMZISS(IZ).LT.0) ITHZ(IZ)=1 + AQZ(1,IZ)=ZI**(ITHZ(IZ)-1)*(-ZONE)**(ITHZ(IZ)+1) + $ *(+G/SQRT2*ZMIXSS(3,IZ)+GP/(3*SQRT2)*ZMIXSS(4,IZ)) + AQZ(2,IZ)=ZI**(ITHZ(IZ)-1)*(-ZONE)**(ITHZ(IZ)+1) + $ *(-G/SQRT2*ZMIXSS(3,IZ)+GP/(3*SQRT2)*ZMIXSS(4,IZ)) + BQZ(1,IZ)=+(4./3.)*ZI**(ITHZ(IZ)-1)*GP/SQRT2*ZMIXSS(4,IZ) + BQZ(2,IZ)=-(2./3.)*ZI**(ITHZ(IZ)-1)*GP/SQRT2*ZMIXSS(4,IZ) +100 CONTINUE +C Wi couplings + ITHW(1)=0 + IF(AMW1SS.LT.0.) ITHW(1)=1 + AQW(1,1)=ZI*G*SIN(GAMMAL) + AQW(2,1)=ZI*G*(-ZONE)**ITHW(1)*SIN(GAMMAR) + ITHW(2)=0 + IF(AMW2SS.LT.0.) ITHW(2)=1 + AQW(1,2)=ZI*G*THX*COS(GAMMAL) + AQW(2,2)=ZI*G*(-ZONE)**ITHW(2)*THY*COS(GAMMAR) +C Quark couplings to Z + CS2THW=1.-SN2THW + TNTHW=SQRT(SN2THW/CS2THW) + CTTHW=1./TNTHW + AL(1)=CTTHW/4.-5*TNTHW/12. + AL(2)=TNTHW/12.-CTTHW/4. + BE(1)=-(CTTHW+TNTHW)/4. + BE(2)=-BE(1) + ESQ=4*PI*ALFAEM +C Chargino couplings to Z + XWI(1)=1.-(COS(GAMMAL)**2+COS(GAMMAR)**2)/4./CS2THW + XWI(2)=1.-(SIN(GAMMAL)**2+SIN(GAMMAR)**2)/4./CS2THW + YWI(1)=(COS(GAMMAR)**2-COS(GAMMAL)**2)/4./CS2THW + YWI(2)=(SIN(GAMMAR)**2-SIN(GAMMAL)**2)/4./CS2THW + X12=.5*(THX*SIN(GAMMAL)*COS(GAMMAL)- + $ THY*SIN(GAMMAR)*COS(GAMMAR)) + Y12=.5*(THX*SIN(GAMMAL)*COS(GAMMAL)+ + $ THY*SIN(GAMMAR)*COS(GAMMAR)) + SN12=-1.*SIGN(1.,AMW1SS)*SIGN(1.,AMW2SS) +C +C qk qb --> ziss glss +C + DO 200 IZ=1,4 + AMZIZ=ABS(AMZISS(IZ)) + JTYPZ=IZ2JS(IZ) +C Jet 1 = ziss, jet 2 = glss + IF(.NOT.(GOQ(JTYPZ,1).AND.GOQ(1,2))) GO TO 220 + CALL TWOKIN(0.,0.,AMZIZ,AMG) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 220 + GS=SQRT(4*PI*ALFQSQ) + E1=SQRT(P(1)**2+AMZIZ**2) + E2=SQRT(P(2)**2+AMG**2) + FAC=1./(16.*PI*S**2) + FAC=FAC*S/SCM*(P(1)*P(2)/(E1*E2))*UNITS +C Sum over initial quarks (no top quarks) + DO 210 IQ=2,11 + IQ1=IQ + IQ2=MATCH(IQ1,4) + AMQIQ=AMASS(IDQSS(IQ)) + SIG0=(AMZIZ**2-T)*(AMG**2-T)/(AMQIQ**2-T)**2 + $ +(AMZIZ**2-U)*(AMG**2-U)/(AMQIQ**2-U)**2 + $ -2*(-1)**(ITHZ(IZ)+ITHG)*AMG*AMZIZ*S + $ /((AMQIQ**2-T)*(AMQIQ**2-U)) + SIG0=SIG0*2*GS**2/9 + CON=AQZ(IS2UD(IQ),IZ)*CONJG(AQZ(IS2UD(IQ),IZ)) + $ +BQZ(IS2UD(IQ),IZ)*CONJG(BQZ(IS2UD(IQ),IZ)) + SIG=FAC*CON*SIG0*QFCN(IQ1,1)*QFCN(IQ2,2) + SIG=.5*SIG + CALL SIGFIL(SIG,IQ1,IQ2,JTYPZ,1) +210 CONTINUE +C Jet 1 = glss, jet 2 = ziss +220 IF(.NOT.(GOQ(1,1).AND.GOQ(JTYPZ,2))) GO TO 200 + CALL TWOKIN(0.,0.,AMG,AMZIZ) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 200 + GS=SQRT(4*PI*ALFQSQ) + E1=SQRT(P(1)**2+AMG**2) + E2=SQRT(P(2)**2+AMZIZ**2) + FAC=1./(16.*PI*S**2) + FAC=FAC*S/SCM*(P(1)*P(2)/(E1*E2))*UNITS + DO 230 IQ=2,11 + IQ1=IQ + IQ2=MATCH(IQ1,4) + AMQIQ=AMASS(IDQSS(IQ)) + SIG0=(AMZIZ**2-T)*(AMG**2-T)/(AMQIQ**2-T)**2 + $ +(AMZIZ**2-U)*(AMG**2-U)/(AMQIQ**2-U)**2 + $ -2*(-1)**(ITHZ(IZ)+ITHG)*AMG*AMZIZ*S + $ /((AMQIQ**2-T)*(AMQIQ**2-U)) + SIG0=SIG0*2*GS**2/9 + CON=AQZ(IS2UD(IQ),IZ)*CONJG(AQZ(IS2UD(IQ),IZ)) + $ +BQZ(IS2UD(IQ),IZ)*CONJG(BQZ(IS2UD(IQ),IZ)) + SIG=FAC*CON*SIG0*QFCN(IQ1,1)*QFCN(IQ2,2) + SIG=.5*SIG + CALL SIGFIL(SIG,IQ1,IQ2,1,JTYPZ) +230 CONTINUE +200 CONTINUE +C +C qk gl -> ziss qkss +C + DO 300 IZ=1,4 + AMZIZ=ABS(AMZISS(IZ)) + JTYPZ=IZ2JS(IZ) + DO 310 IQ=2,25 + JQ=JS2JT(IQ) + IF(IABS(JQ).GE.12) GO TO 310 + AMQIQ=AMASS(IDQSS(IQ)) +C Jet 1 = ziss, jet 2 = qkss + IF(.NOT.(GOQ(JTYPZ,1).AND.GOQ(IQ,2))) GO TO 320 + CALL TWOKIN(0.,0.,AMZIZ,AMQIQ) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 320 + GS=SQRT(4*PI*ALFQSQ) + E1=SQRT(P(1)**2+AMZIZ**2) + E2=SQRT(P(2)**2+AMQIQ**2) + FAC=1./(16.*PI*S**2) + FAC=FAC*S/SCM*(P(1)*P(2)/(E1*E2))*UNITS + IX=IS2UD(IQ) +C Use AQZ for left squarks, BQZ for right + IF(IQ.LE.13) THEN + CON=AQZ(IX,IZ)*CONJG(AQZ(IX,IZ)) + ELSE + CON=BQZ(IX,IZ)*CONJG(BQZ(IX,IZ)) + ENDIF + SIG=GS**2/6*FAC*CON*PSIFCN(AMQIQ**2,AMZIZ**2,T) + $ *QFCN(JQ,1)*QFCN(1,2) + SIG=.5*SIG + CALL SIGFIL(SIG,JQ,1,JTYPZ,IQ) + SIG=GS**2/6*FAC*CON*PSIFCN(AMQIQ**2,AMZIZ**2,U) + $ *QFCN(1,1)*QFCN(JQ,2) + SIG=.5*SIG + CALL SIGFIL(SIG,1,JQ,JTYPZ,IQ) +C Jet 1 = qkss, jet 2 = ziss +320 IF(.NOT.(GOQ(IQ,1).AND.GOQ(JTYPZ,2))) GO TO 310 + CALL TWOKIN(0.,0.,AMQIQ,AMZIZ) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 310 + GS=SQRT(4*PI*ALFQSQ) + E1=SQRT(P(1)**2+AMQIQ**2) + E2=SQRT(P(2)**2+AMZIZ**2) + FAC=1./(16.*PI*S**2) + FAC=FAC*S/SCM*(P(1)*P(2)/(E1*E2))*UNITS + IX=IS2UD(IQ) +C Use AQZ for left squarks, BQZ for right + IF(IQ.LE.13) THEN + CON=AQZ(IX,IZ)*CONJG(AQZ(IX,IZ)) + ELSE + CON=BQZ(IX,IZ)*CONJG(BQZ(IX,IZ)) + ENDIF + SIG=GS**2/6*CON*FAC*PSIFCN(AMQIQ**2,AMZIZ**2,U) + $ *QFCN(JQ,1)*QFCN(1,2) + SIG=.5*SIG + CALL SIGFIL(SIG,JQ,1,IQ,JTYPZ) + SIG=GS**2/6*CON*FAC*PSIFCN(AMQIQ**2,AMZIZ**2,T) + $ *QFCN(1,1)*QFCN(JQ,2) + SIG=.5*SIG + CALL SIGFIL(SIG,1,JQ,IQ,JTYPZ) +310 CONTINUE +300 CONTINUE +C +C qk gl -> wiss qkss +C + DO 400 IW=1,4 + JW=(IW+1)/2 + AMWIW=ABS(AMWISS(JW)) + JTYPW=IW2JS(IW) + IWM=IW2IM(IW) +C Left squarks only - + DO 410 IQ=2,11 + AMQIQ=AMASS(IDQSS(IQ)) +C JQ is the matching incoming quark + JQ=JS2JT(IQ) + JQ=MATCH(JQ,4) + JQ=MATCH(JQ,IWM) + IF(JQ.EQ.0.OR.JQ.GE.12) GO TO 410 +C Jet 1 = wiss, jet 2 = qkss + IF(.NOT.(GOQ(JTYPW,1).AND.GOQ(IQ,2))) GO TO 420 + CALL TWOKIN(0.,0.,AMWIW,AMQIQ) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 420 + GS=SQRT(4*PI*ALFQSQ) + E1=SQRT(P(1)**2+AMWIW**2) + E2=SQRT(P(2)**2+AMQIQ**2) + FAC=1./(16.*PI*S**2) + FAC=FAC*S/SCM*(P(1)*P(2)/(E1*E2))*UNITS + IX=IS2UD(JQ) + CON=AQW(IX,JW)*CONJG(AQW(IX,JW)) + SIG=GS**2/6*FAC*CON*PSIFCN(AMQIQ**2,AMWIW**2,T) + $ *QFCN(JQ,1)*QFCN(1,2) + SIG=.5*SIG + CALL SIGFIL(SIG,JQ,1,JTYPW,IQ) + SIG=GS**2/6*FAC*CON*PSIFCN(AMQIQ**2,AMWIW**2,U) + $ *QFCN(1,1)*QFCN(JQ,2) + SIG=.5*SIG + CALL SIGFIL(SIG,1,JQ,JTYPW,IQ) +C Jet 1 = qkss, jet 2 = wiss +420 IF(.NOT.(GOQ(IQ,1).AND.GOQ(JTYPW,2))) GO TO 410 + CALL TWOKIN(0.,0.,AMQIQ,AMWIW) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 410 + GS=SQRT(4*PI*ALFQSQ) + E1=SQRT(P(1)**2+AMQIQ**2) + E2=SQRT(P(2)**2+AMWIW**2) + FAC=1./(16.*PI*S**2) + FAC=FAC*S/SCM*(P(1)*P(2)/(E1*E2))*UNITS + IX=IS2UD(JQ) + CON=AQW(IX,JW)*CONJG(AQW(IX,JW)) + SIG=GS**2/6*FAC*CON*PSIFCN(AMQIQ**2,AMWIW**2,U) + $ *QFCN(JQ,1)*QFCN(1,2) + SIG=.5*SIG + CALL SIGFIL(SIG,JQ,1,IQ,JTYPW) + SIG=GS**2/6*FAC*CON*PSIFCN(AMQIQ**2,AMWIW**2,T) + $ *QFCN(1,1)*QFCN(JQ,2) + SIG=.5*SIG + CALL SIGFIL(SIG,1,JQ,IQ,JTYPW) +410 CONTINUE +400 CONTINUE +C +C qk qb -> wiss glss +C + DO 500 IW=1,4 + JW=(IW+1)/2 + AMWIW=ABS(AMWISS(JW)) + JTYPW=IW2JS(IW) + IWM=IW2IM(IW) +C Jet 1 = wiss, jet 2 = glss + IF(.NOT.(GOQ(JTYPW,1).AND.GOQ(1,2))) GO TO 520 + CALL TWOKIN(0.,0.,AMWIW,AMG) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 520 + GS=SQRT(4*PI*ALFQSQ) + E1=SQRT(P(1)**2+AMWIW**2) + E2=SQRT(P(2)**2+AMG**2) + FAC=1./(16.*PI*S**2) + FAC=FAC*S/SCM*(P(1)*P(2)/(E1*E2))*UNITS +C Loop over quarks (no top quarks) + DO 510 IQ=2,11 + IQ1=IQ + IQ2=MATCH(IQ1,IWM) + IF(IQ2.EQ.0.OR.IQ2.GE.12) GO TO 510 + AMQIQ1=AMASS(IDQSS(IQ1)) + IX1=IS2UD(IQ1) + AMQIQ2=AMASS(IDQSS(IQ2)) + IX2=IS2UD(IQ2) + CON11=AQW(IX1,JW)*CONJG(AQW(IX1,JW)) + CON22=AQW(IX2,JW)*CONJG(AQW(IX2,JW)) + CON12=2*(-1)**ITHG*REAL(AQW(IX1,JW)*AQW(IX2,JW)) + SIG=CON11*(AMWIW**2-T)*(AMG**2-T)/(AMQIQ2**2-T)**2 + $ +CON22*(AMWIW**2-U)*(AMG**2-U)/(AMQIQ1**2-U)**2 + $ +CON12*AMG*AMWIW*S/((AMQIQ2**2-T)*(AMQIQ1**2-U)) + SIG=2*GS**2/9*SIG*FAC*QFCN(IQ1,1)*QFCN(IQ2,2) + SIG=.5*SIG + CALL SIGFIL(SIG,IQ1,IQ2,JTYPW,1) +C No interchange needed here +510 CONTINUE +C Jet 1 = glss, jet 2 = wiss +520 IF(.NOT.(GOQ(1,1).AND.GOQ(JTYPW,2))) GO TO 500 + CALL TWOKIN(0.,0.,AMG,AMWIW) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 500 + GS=SQRT(4*PI*ALFQSQ) + E1=SQRT(P(1)**2+AMG**2) + E2=SQRT(P(2)**2+AMWIW**2) + FAC=1./(16.*PI*S**2) + FAC=FAC*S/SCM*(P(1)*P(2)/(E1*E2))*UNITS +C Loop over quarks (no top quarks) + DO 530 IQ=2,11 + IQ1=IQ + IQ2=MATCH(IQ1,IWM) + IF(IQ2.EQ.0.OR.IQ2.GE.12) GO TO 530 + AMQIQ1=AMASS(IDQSS(IQ1)) + IX1=IS2UD(IQ1) + AMQIQ2=AMASS(IDQSS(IQ2)) + IX2=IS2UD(IQ2) + CON11=AQW(IX1,JW)*CONJG(AQW(IX1,JW)) + CON22=AQW(IX2,JW)*CONJG(AQW(IX2,JW)) + CON12=2*(-1)**ITHG*REAL(AQW(IX1,JW)*AQW(IX2,JW)) + SIG=CON11*(AMWIW**2-U)*(AMG**2-U)/(AMQIQ2**2-U)**2 + $ +CON22*(AMWIW**2-T)*(AMG**2-T)/(AMQIQ1**2-T)**2 + $ +CON12*AMG*AMWIW*S/((AMQIQ2**2-U)*(AMQIQ1**2-T)) + SIG=2*GS**2/9*SIG*FAC*QFCN(IQ1,1)*QFCN(IQ2,2) + SIG=.5*SIG + CALL SIGFIL(SIG,IQ1,IQ2,1,JTYPW) +C NO INTERCHANGE NEEDED HERE +530 CONTINUE +500 CONTINUE +C +C Gaugino pair production. The W,Z poles are assumed +C to be outside the physical region. +C Constants from SSWZBF: +C + SR2=SQRT(2.) + DO 601 IZ=1,4 + XZIWJ(IZ,1)=.5*(SIGN(1.,AMWISS(1))*SIGN(1.,AMZISS(IZ)) + $ *(COS(GAMMAR)*ZMIXSS(1,IZ)/SR2+SIN(GAMMAR)*ZMIXSS(3,IZ)) + $ -COS(GAMMAL)*ZMIXSS(2,IZ)/SR2+SIN(GAMMAL)*ZMIXSS(3,IZ)) + YZIWJ(IZ,1)=.5*(-SIGN(1.,AMWISS(1))*SIGN(1.,AMZISS(IZ)) + $ *(COS(GAMMAR)*ZMIXSS(1,IZ)/SR2+SIN(GAMMAR)*ZMIXSS(3,IZ)) + $ -COS(GAMMAL)*ZMIXSS(2,IZ)/SR2+SIN(GAMMAL)*ZMIXSS(3,IZ)) + XZIWJ(IZ,2)=.5*(SIGN(1.,AMWISS(2))*SIGN(1.,AMZISS(IZ))*THY + $ *(-SIN(GAMMAR)*ZMIXSS(1,IZ)/SR2+COS(GAMMAR)*ZMIXSS(3,IZ)) + $ +THX*(SIN(GAMMAL)*ZMIXSS(2,IZ)/SR2+COS(GAMMAL)*ZMIXSS(3,IZ))) + YZIWJ(IZ,2)=.5*(-SIGN(1.,AMWISS(2))*SIGN(1.,AMZISS(IZ)) + $ *THY*(-SIN(GAMMAR)*ZMIXSS(1,IZ)/SR2+COS(GAMMAR)*ZMIXSS(3,IZ)) + $ +THX*(SIN(GAMMAL)*ZMIXSS(2,IZ)/SR2+COS(GAMMAL)*ZMIXSS(3,IZ))) +601 CONTINUE +C +C Zino + wino: W* and squark graphs included +C + DO 610 IW=1,4 + JW=(IW+1)/2 + AMWIW=ABS(AMWISS(JW)) + JTYPW=IW2JS(IW) + IWM=IW2IM(IW) + DO 620 IZ=1,4 + AMZIZ=ABS(AMZISS(IZ)) + JTYPZ=IZ2JS(IZ) + AMQ=AMASS(IDQSS(2)) +C Jet 1 = wiss, jet 2 = zjss + IF(.NOT.(GOQ(JTYPW,1).AND.GOQ(JTYPZ,2))) GO TO 630 + CALL TWOKIN(0.,0.,AMWIW,AMZIZ) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 630 + E1=SQRT(P(1)**2+AMWIW**2) + E2=SQRT(P(2)**2+AMZIZ**2) + FAC=1./(16.*PI*S**2) + FAC=FAC*S/SCM*(P(1)*P(2)/(E1*E2))*UNITS +C Loop over quarks (no top quarks) + SIGUT1=(XZIWJ(IZ,JW)**2+YZIWJ(IZ,JW)**2) + $ *((AMWIW**2-U)*(AMZIZ**2-U)+(AMWIW**2-T)*(AMZIZ**2-T))/4. + $ +2*XZIWJ(IZ,JW)*YZIWJ(IZ,JW) + $ *((AMWIW**2-U)*(AMZIZ**2-U)-(AMWIW**2-T)*(AMZIZ**2-T))/4. + $ +AMWIW*AMZIZ*(XZIWJ(IZ,JW)**2-YZIWJ(IZ,JW)**2)*S/2. + PROPW=(S-AMW**2)**2+AMW**2*GAMW**2 + SIGUT1=2*G**4/3./PROPW*SIGUT1 + SIGUT2=(AQZ(2,IZ)*CONJG(AQZ(2,IZ)))* + $ (AQW(1,JW)*CONJG(AQW(1,JW))) + $ *(AMWIW**2-U)*(AMZIZ**2-U)/4./3./(U-AMQ**2)**2 + SIGUT3=(AQZ(1,IZ)*CONJG(AQZ(1,IZ)))* + $ (AQW(2,JW)*CONJG(AQW(2,JW))) + $ *(AMWIW**2-T)*(AMZIZ**2-T)/4./3./(T-AMQ**2)**2 + SGUT12=-G**2*SR2*(S-AMW**2)/PROPW/(U-AMQ**2)/12.* + $ REAL(CONJG(AQZ(2,IZ))*AQW(1,JW)*(-ZI)**(ITHZ(IZ)))* + $ (8*(XZIWJ(IZ,JW)+YZIWJ(IZ,JW))*(AMZIZ**2-U)*(AMWIW**2-U)/4. + $ +4*(XZIWJ(IZ,JW)-YZIWJ(IZ,JW))*AMWIW*AMZIZ*S/2.) + SGUT13=G**2*SR2*(S-AMW**2)/PROPW/(T-AMQ**2)/12.* + $ REAL(CONJG(AQW(2,JW))*AQZ(1,IZ)*(-ZI)**(ITHZ(IZ)))* + $ (8*(XZIWJ(IZ,JW)-YZIWJ(IZ,JW))*(AMZIZ**2-T)*(AMWIW**2-T)/4. + $ +4*(XZIWJ(IZ,JW)+YZIWJ(IZ,JW))*AMWIW*AMZIZ*S/2.) + SGUT23=-4*AMWIW*AMZIZ*S/2./(U-AMQ**2)/(T-AMQ**2)/12.* + $ REAL(AQZ(1,IZ)*AQZ(2,IZ)*CONJG(AQW(1,JW)*AQW(2,JW))) + SIGUT=SIGUT1+SIGUT2+SIGUT3+SGUT12+SGUT13+SGUT23 +C + SIGTU1=(XZIWJ(IZ,JW)**2+YZIWJ(IZ,JW)**2) + $ *((AMWIW**2-T)*(AMZIZ**2-T)+(AMWIW**2-U)*(AMZIZ**2-U))/4. + $ +2*XZIWJ(IZ,JW)*YZIWJ(IZ,JW) + $ *((AMWIW**2-T)*(AMZIZ**2-T)-(AMWIW**2-U)*(AMZIZ**2-U))/4. + $ +AMWIW*AMZIZ*(XZIWJ(IZ,JW)**2-YZIWJ(IZ,JW)**2)*S/2. + SIGTU1=2*G**4/3./PROPW*SIGTU1 + SIGTU2=(AQZ(2,IZ)*CONJG(AQZ(2,IZ)))* + $ (AQW(1,JW)*CONJG(AQW(1,JW))) + $ *(AMWIW**2-T)*(AMZIZ**2-T)/4./3./(T-AMQ**2)**2 + SIGTU3=(AQZ(1,IZ)*CONJG(AQZ(1,IZ)))* + $ (AQW(2,JW)*CONJG(AQW(2,JW))) + $ *(AMWIW**2-U)*(AMZIZ**2-U)/4./3./(U-AMQ**2)**2 + SGTU12=-G**2*SR2*(S-AMW**2)/PROPW/(T-AMQ**2)/12.* + $ REAL(CONJG(AQZ(2,IZ))*AQW(1,JW)*(-ZI)**(ITHZ(IZ)))* + $ (8*(XZIWJ(IZ,JW)+YZIWJ(IZ,JW))*(AMZIZ**2-T)*(AMWIW**2-T)/4. + $ +4*(XZIWJ(IZ,JW)-YZIWJ(IZ,JW))*AMWIW*AMZIZ*S/2.) + SGTU13=G**2*SR2*(S-AMW**2)/PROPW/(U-AMQ**2)/12.* + $ REAL(CONJG(AQW(2,JW))*AQZ(1,IZ)*(-ZI)**(ITHZ(IZ)))* + $ (8*(XZIWJ(IZ,JW)-YZIWJ(IZ,JW))*(AMZIZ**2-U)*(AMWIW**2-U)/4. + $ +4*(XZIWJ(IZ,JW)+YZIWJ(IZ,JW))*AMWIW*AMZIZ*S/2.) + SGTU23=-4*AMWIW*AMZIZ*S/2./(T-AMQ**2)/(U-AMQ**2)/12.* + $ REAL(AQZ(1,IZ)*AQZ(2,IZ)*CONJG(AQW(1,JW)*AQW(2,JW))) + SIGTU=SIGTU1+SIGTU2+SIGTU3+SGTU12+SGTU13+SGTU23 + IF (IWM.EQ.2) THEN + SIG=.5*SIGUT*FAC*QFCN(5,1)*QFCN(2,2) + CALL SIGFIL(SIG,5,2,JTYPW,JTYPZ) + SIG=.5*SIGUT*FAC*QFCN(7,1)*QFCN(8,2) + CALL SIGFIL(SIG,7,8,JTYPW,JTYPZ) + SIG=.5*SIGTU*FAC*QFCN(2,1)*QFCN(5,2) + CALL SIGFIL(SIG,2,5,JTYPW,JTYPZ) + SIG=.5*SIGTU*FAC*QFCN(8,1)*QFCN(7,2) + CALL SIGFIL(SIG,8,7,JTYPW,JTYPZ) + ELSE + SIG=.5*SIGTU*FAC*QFCN(4,1)*QFCN(3,2) + CALL SIGFIL(SIG,4,3,JTYPW,JTYPZ) + SIG=.5*SIGTU*FAC*QFCN(6,1)*QFCN(9,2) + CALL SIGFIL(SIG,6,9,JTYPW,JTYPZ) + SIG=.5*SIGUT*FAC*QFCN(3,1)*QFCN(4,2) + CALL SIGFIL(SIG,3,4,JTYPW,JTYPZ) + SIG=.5*SIGUT*FAC*QFCN(9,1)*QFCN(6,2) + CALL SIGFIL(SIG,9,6,JTYPW,JTYPZ) + END IF +C Jet 1 = zjss, jet 2 = wiss +630 IF(.NOT.(GOQ(JTYPZ,1).AND.GOQ(JTYPW,2))) GO TO 620 + CALL TWOKIN(0.,0.,AMZIZ,AMWIW) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 610 + E1=SQRT(P(1)**2+AMZIZ**2) + E2=SQRT(P(2)**2+AMWIW**2) + FAC=1./(16.*PI*S**2) + FAC=FAC*S/SCM*(P(1)*P(2)/(E1*E2))*UNITS +C Loop over quarks (no top quarks) + SIGUT1=(XZIWJ(IZ,JW)**2+YZIWJ(IZ,JW)**2) + $ *((AMWIW**2-U)*(AMZIZ**2-U)+(AMWIW**2-T)*(AMZIZ**2-T))/4. + $ +2*XZIWJ(IZ,JW)*YZIWJ(IZ,JW) + $ *((AMWIW**2-U)*(AMZIZ**2-U)-(AMWIW**2-T)*(AMZIZ**2-T))/4. + $ +AMWIW*AMZIZ*(XZIWJ(IZ,JW)**2-YZIWJ(IZ,JW)**2)*S/2. + PROPW=(S-AMW**2)**2+AMW**2*GAMW**2 + SIGUT1=2*G**4/3./PROPW*SIGUT1 + SIGUT2=(AQZ(2,IZ)*CONJG(AQZ(2,IZ)))* + $ (AQW(1,JW)*CONJG(AQW(1,JW))) + $ *(AMWIW**2-U)*(AMZIZ**2-U)/4./3./(U-AMQ**2)**2 + SIGUT3=(AQZ(1,IZ)*CONJG(AQZ(1,IZ)))* + $ (AQW(2,JW)*CONJG(AQW(2,JW))) + $ *(AMWIW**2-T)*(AMZIZ**2-T)/4./3./(T-AMQ**2)**2 + SGUT12=-G**2*SR2*(S-AMW**2)/PROPW/(U-AMQ**2)/12.* + $ REAL(CONJG(AQZ(2,IZ))*AQW(1,JW)*(-ZI)**(ITHZ(IZ)))* + $ (8*(XZIWJ(IZ,JW)+YZIWJ(IZ,JW))*(AMZIZ**2-U)*(AMWIW**2-U)/4. + $ +4*(XZIWJ(IZ,JW)-YZIWJ(IZ,JW))*AMWIW*AMZIZ*S/2.) + SGUT13=G**2*SR2*(S-AMW**2)/PROPW/(T-AMQ**2)/12.* + $ REAL(CONJG(AQW(2,JW))*AQZ(1,IZ)*(-ZI)**(ITHZ(IZ)))* + $ (8*(XZIWJ(IZ,JW)-YZIWJ(IZ,JW))*(AMZIZ**2-T)*(AMWIW**2-T)/4. + $ +4*(XZIWJ(IZ,JW)+YZIWJ(IZ,JW))*AMWIW*AMZIZ*S/2.) + SGUT23=-4*AMWIW*AMZIZ*S/2./(U-AMQ**2)/(T-AMQ**2)/12.* + $ REAL(AQZ(1,IZ)*AQZ(2,IZ)*CONJG(AQW(1,JW)*AQW(2,JW))) + SIGUT=SIGUT1+SIGUT2+SIGUT3+SGUT12+SGUT13+SGUT23 +C + SIGTU1=(XZIWJ(IZ,JW)**2+YZIWJ(IZ,JW)**2) + $ *((AMWIW**2-T)*(AMZIZ**2-T)+(AMWIW**2-U)*(AMZIZ**2-U))/4. + $ +2*XZIWJ(IZ,JW)*YZIWJ(IZ,JW) + $ *((AMWIW**2-T)*(AMZIZ**2-T)-(AMWIW**2-U)*(AMZIZ**2-U))/4. + $ +AMWIW*AMZIZ*(XZIWJ(IZ,JW)**2-YZIWJ(IZ,JW)**2)*S/2. + SIGTU1=2*G**4/3./PROPW*SIGTU1 + SIGTU2=(AQZ(2,IZ)*CONJG(AQZ(2,IZ)))* + $ (AQW(1,JW)*CONJG(AQW(1,JW))) + $ *(AMWIW**2-T)*(AMZIZ**2-T)/4./3./(T-AMQ**2)**2 + SIGTU3=(AQZ(1,IZ)*CONJG(AQZ(1,IZ)))* + $ (AQW(2,JW)*CONJG(AQW(2,JW))) + $ *(AMWIW**2-U)*(AMZIZ**2-U)/4./3./(U-AMQ**2)**2 + SGTU12=-G**2*SR2*(S-AMW**2)/PROPW/(T-AMQ**2)/12.* + $ REAL(CONJG(AQZ(2,IZ))*AQW(1,JW)*(-ZI)**(ITHZ(IZ)))* + $ (8*(XZIWJ(IZ,JW)+YZIWJ(IZ,JW))*(AMZIZ**2-T)*(AMWIW**2-T)/4. + $ +4*(XZIWJ(IZ,JW)-YZIWJ(IZ,JW))*AMWIW*AMZIZ*S/2.) + SGTU13=G**2*SR2*(S-AMW**2)/PROPW/(U-AMQ**2)/12.* + $ REAL(CONJG(AQW(2,JW))*AQZ(1,IZ)*(-ZI)**(ITHZ(IZ)))* + $ (8*(XZIWJ(IZ,JW)-YZIWJ(IZ,JW))*(AMZIZ**2-U)*(AMWIW**2-U)/4. + $ +4*(XZIWJ(IZ,JW)+YZIWJ(IZ,JW))*AMWIW*AMZIZ*S/2.) + SGTU23=-4*AMWIW*AMZIZ*S/2./(T-AMQ**2)/(U-AMQ**2)/12.* + $ REAL(AQZ(1,IZ)*AQZ(2,IZ)*CONJG(AQW(1,JW)*AQW(2,JW))) + SIGTU=SIGTU1+SIGTU2+SIGTU3+SGTU12+SGTU13+SGTU23 + IF (IWM.EQ.2) THEN + SIG=.5*SIGTU*FAC*QFCN(5,1)*QFCN(2,2) + CALL SIGFIL(SIG,5,2,JTYPZ,JTYPW) + SIG=.5*SIGTU*FAC*QFCN(7,1)*QFCN(8,2) + CALL SIGFIL(SIG,7,8,JTYPZ,JTYPW) + SIG=.5*SIGUT*FAC*QFCN(2,1)*QFCN(5,2) + CALL SIGFIL(SIG,2,5,JTYPZ,JTYPW) + SIG=.5*SIGUT*FAC*QFCN(8,1)*QFCN(7,2) + CALL SIGFIL(SIG,8,7,JTYPZ,JTYPW) + ELSE + SIG=.5*SIGUT*FAC*QFCN(4,1)*QFCN(3,2) + CALL SIGFIL(SIG,4,3,JTYPZ,JTYPW) + SIG=.5*SIGUT*FAC*QFCN(6,1)*QFCN(9,2) + CALL SIGFIL(SIG,6,9,JTYPZ,JTYPW) + SIG=.5*SIGTU*FAC*QFCN(3,1)*QFCN(4,2) + CALL SIGFIL(SIG,3,4,JTYPZ,JTYPW) + SIG=.5*SIGTU*FAC*QFCN(9,1)*QFCN(6,2) + CALL SIGFIL(SIG,9,6,JTYPZ,JTYPW) + END IF +620 CONTINUE +610 CONTINUE +C +C Chargino pair production +C added squark exchange contribution 7/11/97 +C + DO 700 IW1=1,4 + JW1=(IW1+1)/2 + AMWIW1=ABS(AMWISS(JW1)) + JTYPW1=IW2JS(IW1) + IDW1=IDWSS(IW1) + DO 710 IW2=1,4 + JW2=(IW2+1)/2 + AMWIW2=ABS(AMWISS(JW2)) + JTYPW2=IW2JS(IW2) + IDW2=IDWSS(IW2) + IF (.NOT.(GOQ(JTYPW1,1).AND.GOQ(JTYPW2,2))) GO TO 710 + CALL TWOKIN(0.,0.,AMWIW1,AMWIW2) + IF (X1.GE.1..OR.X2.GE.1.) GO TO 710 + E1=SQRT(P(1)**2+AMWIW1**2) + E2=SQRT(P(2)**2+AMWIW2**2) + FAC=1./(16.*PI*S**2) + FAC=FAC*S/SCM*(P(1)*P(2)/(E1*E2))*UNITS + DO 720 IQ1=2,11 + IFLQ=IS2UD(IQ1) + IF (IFLQ.EQ.1) THEN + EQ1=2./3. + ELSE + EQ1=-1./3. + END IF + IQ2=MATCH(IQ1,4) + IF (IQ1.EQ.2.OR.IQ1.EQ.3) AMSQK=AMDLSS + IF (IQ1.EQ.4.OR.IQ1.EQ.5) AMSQK=AMULSS + IF (IQ1.EQ.6.OR.IQ1.EQ.7) AMSQK=AMCLSS + IF (IQ1.EQ.8.OR.IQ1.EQ.9) AMSQK=AMSLSS + IF (IQ1.EQ.10.OR.IQ1.EQ.11) AMSQK=AMB1SS + IF (IQ2.EQ.0.OR.IQ2.GE.12) GO TO 720 + IF (IDW1.EQ.-IDW2) THEN +C Convert ISAJET t_hat to particle-particle t_hat + IF (IUD(IQ1)*IDW1.GT.0) THEN + TPP=U + ELSE + TPP=T + END IF + ZZ=(2*TPP-2*AMWIW1**2+S)/SQRT(S*S-4*S*AMWIW1**2) + EHAT=SQRT(S)/2. + PHAT=SQRT(EHAT**2-AMWIW1**2) + XMGG=16.*ESQ*ESQ*(EHAT**2*(1.+ZZ**2)+ + $ AMWIW1**2*(1.-ZZ**2))/S*EQ1**2 + XMZZ=16*ESQ*ESQ*CTTHW**2*S/((S-AMZ**2)**2+ + $ (GAMZ*AMZ)**2)*((XWI(JW1)**2+YWI(JW1)**2)* + $ (AL(IFLQ)**2+BE(IFLQ)**2)* + $ (EHAT**2*(1.+ZZ**2)+AMWIW1**2*(1.-ZZ**2))-2.* + $ YWI(JW1)**2*(AL(IFLQ)**2+ + $ BE(IFLQ)**2)*AMWIW1**2-8*XWI(JW1)*YWI(JW1)* + $ AL(IFLQ)*BE(IFLQ)*EHAT*PHAT*ZZ) + XMGZ=(-EQ1)*(-32.)*ESQ*ESQ*CTTHW*(S-AMZ**2)/ + $ ((S-AMZ**2)**2+(GAMZ*AMZ)**2)* + $ (AL(IFLQ)*XWI(JW1)*(EHAT**2* + $ (1.+ZZ**2)+AMWIW1**2*(1.-ZZ**2))-2* + $ BE(IFLQ)*YWI(JW1)*EHAT*PHAT*ZZ) + XMUU=ESQ*ESQ*SIN(GAMMAR)**4*S*(EHAT-PHAT*ZZ)**2/ + $ SN2THW**2/(EHAT**2+PHAT**2-2*EHAT*PHAT*ZZ+ + $ AMSQK**2)**2 + XMGU=EQ1*4*ESQ*ESQ*SIN(GAMMAR)**2* + $ ((EHAT-PHAT*ZZ)**2+AMWIW1**2)/SN2THW/ + $ (EHAT**2+PHAT**2-2*EHAT*PHAT*ZZ+AMSQK**2) + XMZU=4*ESQ*ESQ*CTTHW*SIN(GAMMAR)**2*(S-AMZ**2) + $ *(AL(IFLQ)-BE(IFLQ))*S/SN2THW/((S-AMZ**2)**2+ + $ (GAMZ*AMZ)**2)*((XWI(JW1)-YWI(JW1))* + $ ((EHAT-PHAT*ZZ)**2+AMWIW1**2)+2*YWI(JW1)* + $ AMWIW1**2)/(EHAT**2+PHAT**2-2*EHAT*PHAT*ZZ+ + $ AMSQK**2) + XMDD=ESQ*ESQ*SIN(GAMMAL)**4*S*(EHAT+PHAT*ZZ)**2/ + $ SN2THW**2/(EHAT**2+PHAT**2+2*EHAT*PHAT*ZZ+ + $ AMSQK**2)**2 + XMGD=-4*EQ1*ESQ*ESQ*SIN(GAMMAL)**2* + $ ((EHAT+PHAT*ZZ)**2+AMWIW1**2)/SN2THW/ + $ (EHAT**2+PHAT**2+2*EHAT*PHAT*ZZ+AMSQK**2) + XMZD=-4*ESQ*ESQ*CTTHW*SIN(GAMMAL)**2*(S-AMZ**2) + $ *(AL(IFLQ)-BE(IFLQ))*S/SN2THW/((S-AMZ**2)**2+ + $ (GAMZ*AMZ)**2)*((XWI(JW1)+YWI(JW1))* + $ ((EHAT+PHAT*ZZ)**2+AMWIW1**2)-2*YWI(JW1)* + $ AMWIW1**2)/(EHAT**2+PHAT**2+2*EHAT*PHAT*ZZ+ + $ AMSQK**2) + IF (IFLQ.EQ.1) THEN + SIG=(XMGG+XMZZ+XMGZ+XMDD+XMGD+XMZD)/12. + ELSE + SIG=(XMGG+XMZZ+XMGZ+XMUU+XMGU+XMZU)/12. + END IF + SIG=SIG*FAC*QFCN(IQ1,1)*QFCN(IQ2,2) + SIG=.5*SIG +C IF(SIG.LT.0.AND.ABS(ZZ).GT.0.999) SIG=0 + CALL SIGFIL(SIG,IQ1,IQ2,JTYPW1,JTYPW2) + ELSEIF (IDW1*IDW2.LT.0) THEN + PHAT=SQRT(S*S+AMWIW1**4+AMWIW2**4-2*S*AMWIW1**2 + $ -2*S*AMWIW2**2-2*AMWIW1**2*AMWIW2**2)/2./SQRT(S) + IF (IUD(IQ1)*IDW1.GT.0) THEN + TPP=U + ELSE + TPP=T + END IF + IF (IDW1.LT.0) THEN + AMWI=AMWIW1 + ELSE + AMWI=AMWIW2 + END IF + EHAT=SQRT(PHAT**2+AMWI**2) + EBM=SQRT(S)/2. + ZZ=(TPP-AMWI**2+SQRT(S)*EHAT)/SQRT(S)/PHAT + DEL=(AMW2SS**2-AMW1SS**2)/4./EBM + XMZZ=4*(CTTHW+TNTHW)**2/((S-AMZ**2)**2+ + $ (GAMZ*AMZ)**2)*((X12**2+Y12**2)* + $ (AL(IFLQ)**2+BE(IFLQ)**2)* + $ (EBM**2+PHAT**2*ZZ**2-DEL**2-SN12*AMWIW1*AMWIW2)+ + $ 2*X12**2*SN12*(AL(IFLQ)**2+ BE(IFLQ)**2)*AMWIW1* + $ AMWIW2-8*X12*Y12*AL(IFLQ)*BE(IFLQ)*EBM*PHAT*ZZ) + XMUU=SIN(GAMMAR)**2*COS(GAMMAR)**2*((EBM-PHAT*ZZ) + $ **2-DEL**2)/SN2THW**2/(2*EBM*(EBM-DEL)-2*EBM*PHAT* + $ ZZ+AMSQK**2-AMW1SS**2)**2 + XMZU=-2*THY*(CTTHW+TNTHW)*SIN(GAMMAR)*COS(GAMMAR)* + $ (S-AMZ**2)*(AL(IFLQ)-BE(IFLQ))/SN2THW/((S-AMZ**2) + $ **2+(GAMZ*AMZ)**2)*((X12-Y12)*((EBM-PHAT*ZZ)**2- + $ DEL**2-SN12*AMWIW1*AMWIW2)+2*X12*SN12*AMWIW1* + $ AMWIW2)/(2*EBM*(EBM-DEL)-2*EBM*PHAT*ZZ+AMSQK**2 + $ -AMW1SS**2) + XMDD=SIN(GAMMAL)**2*COS(GAMMAL)**2*((EBM+PHAT*ZZ) + $ **2-DEL**2)/SN2THW**2/(2*EBM*(EBM-DEL)+2*EBM*PHAT* + $ ZZ+AMSQK**2-AMW1SS**2)**2 + XMZD=-2*THX*(CTTHW+TNTHW)*SIN(GAMMAL)*COS(GAMMAL)* + $ (S-AMZ**2)*(AL(IFLQ)-BE(IFLQ))/SN2THW/((S-AMZ**2) + $ **2+(GAMZ*AMZ)**2)*((X12+Y12)*((EBM+PHAT*ZZ)**2- + $ DEL**2+SN12*AMWIW1*AMWIW2)-2*Y12*SN12*AMWIW1* + $ AMWIW2)/(2*EBM*(EBM-DEL)+2*EBM*PHAT*ZZ+AMSQK**2 + $ -AMW1SS**2) + IF (IFLQ.EQ.1) THEN + SIG=ESQ*ESQ*(XMZZ+XMDD+XMZD)*S/12. + ELSE + SIG=ESQ*ESQ*(XMZZ+XMUU+XMZU)*S/12. + END IF + SIG=SIG*FAC*QFCN(IQ1,1)*QFCN(IQ2,2) + SIG=.5*SIG + CALL SIGFIL(SIG,IQ1,IQ2,JTYPW1,JTYPW2) + END IF +720 CONTINUE +710 CONTINUE +700 CONTINUE +C +C qk qb --> ziss zjss +C + DO 800 IZ1=1,4 + AMZIZ1=ABS(AMZISS(IZ1)) + JTYPZ1=IZ2JS(IZ1) + DO 810 IZ2=1,4 + AMZIZ2=ABS(AMZISS(IZ2)) + JTYPZ2=IZ2JS(IZ2) + IF(.NOT.(GOQ(JTYPZ1,1).AND.GOQ(JTYPZ2,2))) GO TO 810 + CALL TWOKIN(0.,0.,AMZIZ1,AMZIZ2) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 810 + E1=SQRT(P(1)**2+AMZIZ1**2) + E2=SQRT(P(2)**2+AMZIZ2**2) + FAC=1./(16.*PI*S**2) + FAC=FAC*S/SCM*(P(1)*P(2)/(E1*E2))*UNITS + WIJ=SQRT(G**2+GP**2)*ZI**(ITHZ(IZ2))*(-ZI)**(ITHZ(IZ1))* + $ (ZMIXSS(1,IZ1)*ZMIXSS(1,IZ2)-ZMIXSS(2,IZ1)* + $ ZMIXSS(2,IZ2))/4. + RSH=SQRT(S) + PROPZ=(S-AMZ**2)**2+AMZ**2*GAMZ**2 + KK=SQRT(S*S+(AMZIZ1**2-AMZIZ2**2)**2-2*S* + $ (AMZIZ1**2+AMZIZ2**2))/2./RSH +C Sum over initial quarks (no top quarks) + DO 820 IQ=2,11 + IQ1=IQ + IQ2=MATCH(IQ1,4) + AMSQL=AMASS(IDQSS(IQ)) + AMSQR=AMASS(IDQSS(IQ+12)) + PHAT=SQRT(SSXLAM(S,AMZIZ1**2,AMZIZ2**2))/2./RSH + EHAT=SQRT(PHAT**2+AMZIZ1**2) + ZZ=(T-AMZIZ1**2+RSH*EHAT)/RSH/PHAT + IF (IUD(IQ).LT.0) ZZ=-ZZ + IFLQ=IS2UD(IQ) + SIGLL=AQZ(IFLQ,IZ1)*CONJG(AQZ(IFLQ,IZ1))*AQZ(IFLQ,IZ2)* + $ CONJG(AQZ(IFLQ,IZ2))*SSGT(S,AMSQL,ZZ,IZ1,IZ2) + SIGRR=BQZ(IFLQ,IZ1)*CONJG(BQZ(IFLQ,IZ1))*BQZ(IFLQ,IZ2)* + $ CONJG(BQZ(IFLQ,IZ2))*SSGT(S,AMSQR,ZZ,IZ1,IZ2) + SIGZZ=4*ESQ*WIJ*CONJG(WIJ)*(AL(IFLQ)**2+BE(IFLQ)**2)* + $ (S*S-(AMZIZ1**2-AMZIZ2**2)**2+4*(-1.)**(ITHZ(IZ1)+ + $ ITHZ(IZ2)+1)*S*AMZIZ1*AMZIZ2+4*S*KK*KK*ZZ*ZZ)/PROPZ + SIGLZ=-SQRT(ESQ)*(AL(IFLQ)-BE(IFLQ))*(S-AMZ**2)/2./ + $ PROPZ*(REAL(WIJ*CONJG(AQZ(IFLQ,IZ1))*AQZ(IFLQ,IZ2))* + $ SSGST(S,AMSQL,ZZ,IZ1,IZ2)+(-1.)**(ITHZ(IZ1)+ITHZ(IZ2))* + $ REAL(WIJ*AQZ(IFLQ,IZ1)*CONJG(AQZ(IFLQ,IZ2)))* + $ SSGST(S,AMSQL,-ZZ,IZ1,IZ2)) + SIGRZ=-SQRT(ESQ)*(-1.)**(ITHZ(IZ1)+ITHZ(IZ2)+1)* + $ (AL(IFLQ)+BE(IFLQ))*(S-AMZ**2)/2./ + $ PROPZ*(REAL(WIJ*CONJG(BQZ(IFLQ,IZ1))*BQZ(IFLQ,IZ2))* + $ SSGST(S,AMSQR,ZZ,IZ1,IZ2)+(-1.)**(ITHZ(IZ1)+ITHZ(IZ2))* + $ REAL(WIJ*BQZ(IFLQ,IZ1)*CONJG(BQZ(IFLQ,IZ2)))* + $ SSGST(S,AMSQR,-ZZ,IZ1,IZ2)) + SIG=KK*(SIGLL+SIGRR+SIGZZ+SIGLZ+SIGRZ)/3./PHAT +C Below factor of 2 for id particles and jettyp switch + SIG=SIG*FAC*QFCN(IQ1,1)*QFCN(IQ2,2)/2. + IF(SIG.LT.0.AND.ABS(ZZ).GT.0.999) SIG=0 + CALL SIGFIL(SIG,IQ1,IQ2,JTYPZ1,JTYPZ2) +820 CONTINUE +810 CONTINUE +800 CONTINUE + RETURN + END diff --git a/ISAJET/code/sigtc.F b/ISAJET/code/sigtc.F new file mode 100644 index 00000000000..93cc277958f --- /dev/null +++ b/ISAJET/code/sigtc.F @@ -0,0 +1,214 @@ +#include "isajet/pilot.h" + SUBROUTINE SIGTC +C +C Compute the integrated technirho cross section +C d(sigma)/d(qmw**2)d(yw) = d(sigma)/d(qmw**2)*f(x1)*f(x2)/scm +C including W-technirho mixing from EHLQ 6.22 and 6.23 and +C elastic resonance in longitudinal WW fusion. +C +C Use WTYPE for control with +C WTYPE = 2 3 4 +C rho+ rho- rho0 +C +C SIGMA = cross section summed over allowed types. +C SIGS(I) = partial cross section for I1 + I2 --> I3 + I4. +C INOUT(I) = IOPAK**3*I4 + IOPAK**2*I3 + IOPAK*I2 + I1 +C using JETTYPE code. +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/qcdpar.inc" +#include "isajet/jetpar.inc" +#include "isajet/primar.inc" +#include "isajet/q1q2.inc" +#include "isajet/jetsig.inc" +#include "isajet/qsave.inc" +#include "isajet/wcon.inc" +#include "isajet/const.inc" +#include "isajet/jetlim.inc" +#include "isajet/hcon.inc" +#include "isajet/tcpar.inc" +C + REAL AMQCUR(6),WTHELI(4),FINT(9),X(2) + EQUIVALENCE (S,SHAT),(T,THAT),(U,UHAT),(X(1),X1) + INTEGER MATCHT(4,4) + REAL ACOSH,Z,ATANH,AMASS,QMW2,QMZ,EHAT,ANEFF,Q2SAVE,YHAT,EY,AMW, + $AMZ,STRUC,STRUCW,WM,ZM,PWWCM,SIG0,S,T,U,FACINV,RATZ,Q1L,Q1R,SIG1, + $SIG,QZW + INTEGER I,IH,IQ,IW,IQ1,IQ2,IQ3,IQ4,IRHO,LISTW(4) +C + DATA AMQCUR/.005,.009,.175,1.25,4.50,30./ + DATA LISTW/10,80,-80,90/ + DATA MATCHT/0,0,0,0, 0,29,0,27, 0,0,29,28, 0,28,27,0/ +C +C Functions + ACOSH(Z)=ALOG(Z+SQRT(Z**2-1.)) + ATANH(Z)=.5*ALOG((1.+Z)/(1.-Z)) +C +C Kinematics (identical to Drell-Yan) +C + AMQCUR(6)=AMASS(6) + QMW2=QMW**2 + QTMW=SQRT(QMW2+QTW**2) + Q0W=QTMW*COSH(YW) + QZW=QTMW*SINH(YW) + QW=SQRT(QZW**2+QTW**2) + IF(QW.NE.0.) THEN + CTHW=QZW/QW + STHW=QTW/QW + IF(ABS(CTHW).LT.1.) THEN + THW=ACOS(CTHW) + ELSE + CTHW=0. + STHW=1. + THW=.5*PI + ENDIF + ELSE + CTHW=0. + STHW=1. + THW=.5*PI + ENDIF + EHAT=QMW + SHAT=QMW**2 + QSQ=SHAT + ANEFF=4.+QSQ/(QSQ+AMASS(5)**2)+QSQ/(QSQ+AMASS(6)**2) + ALFQSQ=12.*PI/((33.-ANEFF)*ALOG(QSQ/ALAM2)) + Q2SAVE=QSQ + YHAT=YW + EY=EXP(YHAT) + X1=EHAT/ECM*EY + X2=EHAT/(ECM*EY) +C +C Initialize +C + SIGMA=0. + NSIGS=0 + DO 100 I=1,MXSIGS +100 SIGS(I)=0 +C + IF(X1.GE.1..OR.X2.GE.1.) RETURN + AMW=WMASS(2) + AMZ=WMASS(4) +C +C Compute structure functions +C + DO 110 IH=1,2 + DO 120 IQ=1,13 +120 QSAVE(IQ,IH)=STRUC(X(IH),QSQ,IQ,IDIN(IH))/X(IH) + DO 130 IQ=14,26 +130 QSAVE(IQ,IH)=0. + DO 140 IW=2,4 + AMW=AMASS(LISTW(IW)) + IF(QMW.GT.2.*AMW) THEN + QSAVE(25+IW,IH)=STRUCW(X(IH),IW,IDIN(IH))/X(IH) + ELSE + QSAVE(25+IW,IH)=0. + ENDIF +140 CONTINUE +110 CONTINUE +C +C qk + qb --> technirho0 +C + IF(.NOT.((GOQ(27,1).AND.GOQ(28,2)).OR.(GOQ(28,1).AND.GOQ(27,2)))) + $GO TO 300 + WM=WMASS(2) + ZM=WMASS(4) + IF(QMW.LE.2.*AMW) GO TO 300 + PWWCM=.5*SQRT(QMW**2-4.*WM**2) + SIG0=PI*ALFA**2/(72.*SIN2W*S)*(2.*PWWCM/QMW)**3*X1*X2*UNITS + SIG0=SIG0*TCMRHO**2/((S-TCMRHO**2)**2+TCMRHO**2*TCGRHO**2) +C Initial state sum + DO 210 IQ1=2,13 + IQ2=MATCH(IQ1,4) + IF(IQ2.EQ.0) GO TO 210 + FACINV=2.*SQRT(SIN2W*(1.-SIN2W)) + RATZ=S/(S-ZM**2) + Q1L=AQ(IQ1/2,4)*FACINV + Q1R=BQ(IQ1/2,4)*FACINV + SIG1=.25*SIG0*(1.-RATZ*Q1L/(Q1R*(1.-SIN2W)) + $ +RATZ**2*(Q1L**2+Q1R**2)/(4.*(1-SIN2W)**2)) + $ *QSAVE(IQ1,1)*QSAVE(IQ2,2) +C Final state sum + DO 220 IQ3=27,28 + IQ4=MATCHT(IQ3-25,4) + IF(GOQ(IQ3,1).AND.GOQ(IQ4,2)) THEN + SIG=SIG1*TBRWW(IQ3-25,1)*TBRWW(IQ4-25,2) + CALL SIGFIL(SIG,IQ1,IQ2,IQ3,IQ4) + ENDIF +220 CONTINUE +210 CONTINUE +C +C W+ + W- -> technirho0 -> W+ + W- +C + SIG0=12*PI/PWWCM**2*TCGRHO**2*X1*X2*UNITS + $/((S-TCMRHO**2)**2+TCMRHO**2*TCGRHO**2) +C Initial state sum + DO 230 IQ1=27,28 + IQ2=MATCHT(IQ1-25,4) + SIG1=.25*SIG0*QSAVE(IQ1,1)*QSAVE(IQ2,2) +C Final state sum + DO 240 IQ3=27,28 + IQ4=MATCHT(IQ3-25,4) + IF(GOQ(IQ3,1).AND.GOQ(IQ4,2)) THEN + SIG=SIG1*TBRWW(IQ3-25,1)*TBRWW(IQ4-25,2) + CALL SIGFIL(SIG,IQ1,IQ2,IQ3,IQ4) + ENDIF +240 CONTINUE +230 CONTINUE +C +C q + qbar -> technirho+- +C +300 IF(.NOT.((GOQ(27,1).AND.GOQ(29,2)).OR.(GOQ(28,1).AND.GOQ(29,2)) + $.OR.(GOQ(29,1).AND.GOQ(27,2)).OR.(GOQ(29,1).AND.GOQ(28,2)))) + $GO TO 400 + WM=WMASS(2) + ZM=WMASS(4) + IF(QMW.LE.WM+ZM) GO TO 400 + PWWCM=SQRT((S-WM**2-ZM**2)**2-4.*WM**2*ZM**2)/(2.*QMW) + SIG0=PI*ALFA**2/(144.*SIN2W)*S/(S-WM**2)**2*(2.*PWWCM/QMW)**3 + $*X1*X2*UNITS + SIG0=SIG0*TCMRHO**2/((S-TCMRHO**2)**2+TCMRHO**2*TCGRHO**2) + DO 310 IRHO=2,3 +C Initial state sum + DO 320 IQ1=2,13 + IQ2=MATCH(IQ1,IRHO) + IF(IQ2.EQ.0) GO TO 320 + SIG1=.25*SIG0*QSAVE(IQ1,1)*QSAVE(IQ2,2) +C Final state sum + DO 330 IQ3=27,28 + IQ4=MATCHT(IQ3-25,IRHO) + IF(IQ4.EQ.0) GO TO 330 + IF(GOQ(IQ3,1).AND.GOQ(IQ4,2)) THEN + SIG=SIG1*TBRWW(IQ3-25,1)*TBRWW(IQ4-25,2) + CALL SIGFIL(SIG,IQ1,IQ2,IQ3,IQ4) + ENDIF +330 CONTINUE +320 CONTINUE +310 CONTINUE +C +C W+- + Z0 -> technirho+- -> W+- + Z0 +C + SIG0=12*PI/PWWCM**2*TCGRHO**2*X1*X2*UNITS + $/((S-TCMRHO**2)**2+TCMRHO**2*TCGRHO**2) + DO 340 IRHO=2,3 +C Initial state sum + DO 350 IQ1=27,29 + IQ2=MATCHT(IQ1-25,IRHO) + IF(IQ2.EQ.0) GO TO 350 + SIG1=.25*SIG0*QSAVE(IQ1,1)*QSAVE(IQ2,2) +C Final state sum + DO 360 IQ3=27,29 + IQ4=MATCHT(IQ3-25,IRHO) + IF(IQ4.EQ.0) GO TO 360 + IF(GOQ(IQ3,1).AND.GOQ(IQ4,2)) THEN + SIG=SIG1*TBRWW(IQ3-25,1)*TBRWW(IQ4-25,2) + CALL SIGFIL(SIG,IQ1,IQ2,IQ3,IQ4) + ENDIF +360 CONTINUE +350 CONTINUE +340 CONTINUE +C +400 RETURN + END diff --git a/ISAJET/code/sigtc2.F b/ISAJET/code/sigtc2.F new file mode 100644 index 00000000000..50eb111d996 --- /dev/null +++ b/ISAJET/code/sigtc2.F @@ -0,0 +1,31 @@ +#include "isajet/pilot.h" + SUBROUTINE SIGTC2 +C +C Compute the techni-rho decay distribution cross section +C D(SIGMA)/D(QMW**2)D(YW)D(OMEGA) +C for the specified jet types. This is trivial but done for +C compatibility with Drell-Yan and Higgs. +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/const.inc" +#include "isajet/jetpar.inc" +#include "isajet/jetsig.inc" +#include "isajet/pjets.inc" +#include "isajet/wsig.inc" +#include "isajet/tcpar.inc" +C + REAL AM12,AM22,ANGFAC,S,T,U + EQUIVALENCE (S,SHAT),(T,THAT),(U,UHAT) +C +C Angfac is (1-z**2), and is determined in terms of S,T,U. +C Note that both rho+- and rho0 are always elastic. + AM12=PJETS(5,1)**2 + AM22=PJETS(5,2)**2 + ANGFAC=4.*(T*U-AM12*AM22)/((S-AM12-AM22)**2-4.*AM12*AM22) +C Differential cross section + SIGLLQ=SIGEVT*ANGFAC*3./(8.*PI) + RETURN + END diff --git a/ISAJET/code/sigtc3.F b/ISAJET/code/sigtc3.F new file mode 100644 index 00000000000..8682f3c279d --- /dev/null +++ b/ISAJET/code/sigtc3.F @@ -0,0 +1,178 @@ +#include "isajet/pilot.h" + SUBROUTINE SIGTC3 +C +C Calculate angular distributions for W decays from technirho: +C d(sigma)/d(qmw**2)d(yw)d(omega)d(omega1)d(omega2) +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +C +#include "isajet/itapes.inc" +#include "isajet/qcdpar.inc" +#include "isajet/jetpar.inc" +#include "isajet/pjets.inc" +#include "isajet/primar.inc" +#include "isajet/q1q2.inc" +#include "isajet/jetsig.inc" +#include "isajet/wsig.inc" +#include "isajet/wwsig.inc" +#include "isajet/wcon.inc" +#include "isajet/const.inc" +#include "isajet/wwpar.inc" +#include "isajet/tcpar.inc" +C + EQUIVALENCE (S,SHAT),(T,THAT),(U,UHAT) + INTEGER I,K,IDADDR(4),IW(2) + REAL T12(3,3),T34(3,3),FR(3,3),FI(3,3),CPHI12(3),SPHI12(3), + $CPHI34(3),SPHI34(3),PFCM(5,4),PWCM(5,2),CHWW,SHWW,TMP,PTW1, + $CPHIW1,SPHIW1,PW1,CTHW1,STHW1,CHW1,SHW1,SHWI,TH12,PHI12,TH34, + $PHI34,AMV,GAMV,QMH,A12,B12,A34,B34,TVV12,TVA12,COS12,SIN12, + $TVV34,TVA34,COS34,SIN34,TCPHI,TSPHI,TC2PHI,TS2PHI,F0,F1,TOTAL, + $DIFF,T,U,S +C + IF(NPAIR.NE.4) RETURN +C +C Reconstruct W-->FF decay angles +C +C Initialize PFCM and PWCM + DO 10 I=1,4 + DO 10 K=1,5 + PFCM(K,I)=PPAIR(K,I) +10 CONTINUE + DO 11 I=1,2 + DO 11 K=1,5 + PWCM(K,I)=PJETS(K,I) +11 CONTINUE +C +C Z boost to WW center of mass + CHWW=QWJET(4)/QWJET(5) + SHWW=QWJET(3)/QWJET(5) + DO 20 I=1,4 + TMP=CHWW*PFCM(4,I)-SHWW*PFCM(3,I) + PFCM(3,I)=-SHWW*PFCM(4,I)+CHWW*PFCM(3,I) + PFCM(4,I)=TMP +20 CONTINUE + DO 21 I=1,2 + TMP=CHWW*PWCM(4,I)-SHWW*PWCM(3,I) + PWCM(3,I)=-SHWW*PWCM(4,I)+CHWW*PWCM(3,I) + PWCM(4,I)=TMP +21 CONTINUE +C +C Rotate W1 to +z axis + PTW1=SQRT(PWCM(1,1)**2+PWCM(2,1)**2) + CPHIW1=PWCM(1,1)/PTW1 + SPHIW1=PWCM(2,1)/PTW1 + PW1=SQRT(PTW1**2+PWCM(3,1)**2) + CTHW1=PWCM(3,1)/PW1 + STHW1=PTW1/PW1 +C Z rotation + DO 30 I=1,4 + TMP=CPHIW1*PFCM(1,I)+SPHIW1*PFCM(2,I) + PFCM(2,I)=-SPHIW1*PFCM(1,I)+CPHIW1*PFCM(2,I) + PFCM(1,I)=TMP +30 CONTINUE +C Y rotation + DO 31 I=1,4 + TMP=CTHW1*PFCM(1,I)-STHW1*PFCM(3,I) + PFCM(3,I)=STHW1*PFCM(1,I)+CTHW1*PFCM(3,I) + PFCM(1,I)=TMP +31 CONTINUE +C +C Boost to W rest frames + CHW1=PWCM(4,1)/PWCM(5,1) + SHW1=PW1/PWCM(5,1) + DO 40 I=1,4 + IF(I.LE.2) THEN + SHWI=SHW1 + ELSE + SHWI=-SHW1 + ENDIF + TMP=CHW1*PFCM(4,I)-SHWI*PFCM(3,I) + PFCM(3,I)=-SHWI*PFCM(4,I)+CHW1*PFCM(3,I) + PFCM(4,I)=TMP +40 CONTINUE +C +C Compute angles + TH12=ACOS(PFCM(3,1)/SQRT(PFCM(1,1)**2+PFCM(2,1)**2+PFCM(3,1)**2)) + PHI12=ATAN2(PFCM(2,1),PFCM(1,1)) + TH34=ACOS(PFCM(3,3)/SQRT(PFCM(1,3)**2+PFCM(2,3)**2+PFCM(3,3)**2)) + PHI34=ATAN2(PFCM(2,3),PFCM(1,3)) +C +C Compute decay angular distributions. +C + DO 100 I=1,4 + IDADDR(I)=IABS(IDPAIR(I)) + IF(IDADDR(I).GE.11) IDADDR(I)=IDADDR(I)-4 +100 CONTINUE + IW(1)=JETTYP(1)-25 + IW(2)=JETTYP(2)-25 +C + AMV=PJETS(5,1) + GAMV=WGAM(IW(1)) + QMH=QMW +C COUPLINGS + A12=AQ(IDADDR(1),IW(1)) + B12=BQ(IDADDR(1),IW(1)) + A34=AQ(IDADDR(3),IW(2)) + B34=BQ(IDADDR(3),IW(2)) +C DECAY DISTRIBUTIONS + TVV12=8.*PI*ALFA*(A12**2+B12**2) + TVA12=16.*PI*ALFA*A12*B12 + COS12=COS(TH12) + SIN12=SIN(TH12) + T12(1,1)=TVV12*SIN12**2 + T12(1,2)=TVV12*SIN12*COS12/SQRT2+TVA12*SIN12/SQRT2 + T12(1,3)=-TVV12*SIN12*COS12/SQRT2+TVA12*SIN12/SQRT2 + T12(2,1)=T12(1,2) + T12(2,2)=TVV12*(.5+.5*COS12**2)+TVA12*COS12 + T12(2,3)=TVV12*.5*SIN12**2 + T12(3,1)=T12(1,3) + T12(3,2)=T12(2,3) + T12(3,3)=TVV12*(.5+.5*COS12**2)-TVA12*COS12 +C + TVV34=8.*PI*ALFA*(A34**2+B34**2) + TVA34=16.*PI*ALFA*A34*B34 + COS34=COS(TH34) + SIN34=SIN(TH34) + T34(1,1)=TVV34*SIN34**2 + T34(1,2)=TVV34*SIN34*COS34/SQRT2+TVA34*SIN34/SQRT2 + T34(1,3)=-TVV34*SIN34*COS34/SQRT2+TVA34*SIN34/SQRT2 + T34(2,1)=T34(1,2) + T34(2,2)=TVV34*(.5+.5*COS34**2)+TVA34*COS34 + T34(2,3)=TVV34*.5*SIN34**2 + T34(3,1)=T34(1,3) + T34(3,2)=T34(2,3) + T34(3,3)=TVV34*(.5+.5*COS34**2)-TVA34*COS34 +C + CPHI12(1)=1. + CPHI12(2)=COS(PHI12) + CPHI12(3)=COS(2.*PHI12) + SPHI12(1)=0. + SPHI12(2)=SIN(PHI12) + SPHI12(3)=SIN(2.*PHI12) + CPHI34(1)=1. + CPHI34(2)=COS(PHI34) + CPHI34(3)=COS(2.*PHI34) + SPHI34(1)=0. + SPHI34(2)=SIN(PHI34) + SPHI34(3)=SIN(2.*PHI34) +C + TCPHI=CPHI12(2)*CPHI34(2)-SPHI12(2)*SPHI34(2) + TSPHI=SPHI12(2)*CPHI34(2)+CPHI12(2)*SPHI34(2) + TC2PHI=CPHI12(3)*CPHI34(3)-SPHI12(3)*SPHI34(3) + TS2PHI=SPHI12(3)*CPHI34(3)+CPHI12(3)*SPHI34(3) +C +C Pure technirho --> WW. Calculate angular distribution for +C decay and multiply by cross section. +C + F0=.5*QMH**2/AMV**2-1. + F1=1. + TOTAL=(8.*PI/3.)**2*TVV12*TVV34*(F0**2+2.*F1**2) + DIFF=F0**2*T12(1,1)*T34(1,1) + $+F0*F1*(2.*T12(1,2)*T34(1,2)+2.*T12(1,3)*T34(1,3))*TCPHI + $+F1**2*(T12(2,2)*T34(1,2)+T12(3,3)*T34(3,3) + $ +2.*T12(2,3)*T34(2,3)*TC2PHI) + WWSIG=SIGLLQ*DIFF/TOTAL + RETURN + END diff --git a/ISAJET/code/sigwh.F b/ISAJET/code/sigwh.F new file mode 100644 index 00000000000..025ae90b685 --- /dev/null +++ b/ISAJET/code/sigwh.F @@ -0,0 +1,200 @@ +#include "isajet/pilot.h" + SUBROUTINE SIGWH +C +C Calculate d(sigma)/d(pt**2)d(y1)d(y2) for WH and ZH +C associated production. +C +C SIGMA = cross section summed over types allowed by +C JETTYPE cards. +C SIGS(I) = partial cross section for I1 + I2 --> I3 + I4 +C INOUT(I) = IOPAK**3*I4 + IOPAK**2*I3 + IOPAK*I2 +I1 +C +C Extra factor of 1/2 needed for nonidentical final jets. +C Y=-log(tan(theta/2)) gives jacobean P1*P2/E1*E2 +C +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/const.inc" +#include "isajet/jetpar.inc" +#include "isajet/jetsig.inc" +#include "isajet/primar.inc" +#include "isajet/q1q2.inc" +#include "isajet/qcdpar.inc" +#include "isajet/wcon.inc" +#include "isajet/hcon.inc" +#include "isajet/xmssm.inc" +C + REAL X(2) + EQUIVALENCE (X(1),X1) + EQUIVALENCE (S,SHAT),(T,THAT),(U,UHAT) + REAL SIG,S,T,U,FAC,AMW,AMZ,AMW2,AMZ2,E1,E2 + REAL QFCN,STRUC,SIGHW + REAL PROPZ,PROPW,GV(2),GA(2),AMH,AMH2,GAMW,GAMZ + INTEGER IS2UD(25),IQ,IH,I,IQ1,IQ2,IFLQ + SAVE IS2UD +C +C IS2UD: Susy jettype -> u/d code + DATA IS2UD/0,1,1,2,2,2,2,1,1,2,2,1,1,1,1,2,2,2,2,1,1,2,2,1,1/ + +C Functions + QFCN(IQ,IH)=STRUC(X(IH),QSQ,IQ,IDIN(IH))/X(IH) +C + IF (GOMSSM) THEN + CALL SIGWHS + RETURN + END IF +C Initialize + DO 10 I=1,MXSIGS +10 SIGS(I)=0. + SIGMA=0. + NSIGS=0 +C + AMW=WMASS(2) + AMW2=AMW**2 + AMZ=WMASS(4) + AMZ2=AMZ**2 + AMH=HMASS + AMH2=AMH**2 + GAMW=WGAM(2) + GAMZ=WGAM(4) + GV(1)=.25-2*SIN2W/3. + GV(2)=-.25+SIN2W/3. + GA(1)=-.25 + GA(2)=.25 +C +C WH production via W-* +C + IF (GOQ(28,1).AND.GOQ(30,2)) THEN + CALL TWOKIN(0.,0.,AMW,AMH) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 100 + E1=SQRT(P(1)**2+AMW**2) + E2=SQRT(P(2)**2+AMH**2) + FAC=1./(12.*PI*S**2) + FAC=FAC*S/SCM*(P(1)*P(2)/(E1*E2))*UNITS + PROPW=(S-AMW**2)**2+AMW**2*GAMW**2 + SIGHW=GF**2*AMW**8*(S/AMW2+(1.-T/AMW2)*(1.-U/AMW2))/ + $ PROPW*TBRWW(3,1) + SIG=.5*SIGHW*FAC*QFCN(3,1)*QFCN(4,2) + CALL SIGFIL(SIG,3,4,28,30) + SIG=.5*SIGHW*FAC*QFCN(4,1)*QFCN(3,2) + CALL SIGFIL(SIG,4,3,28,30) + SIG=.5*SIGHW*FAC*QFCN(9,1)*QFCN(6,2) + CALL SIGFIL(SIG,9,6,28,30) + SIG=.5*SIGHW*FAC*QFCN(6,1)*QFCN(9,2) + CALL SIGFIL(SIG,6,9,28,30) +100 CONTINUE + END IF +C + IF (GOQ(30,1).AND.GOQ(28,2)) THEN + CALL TWOKIN(0.,0.,AMH,AMW) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 110 + E1=SQRT(P(1)**2+AMH**2) + E2=SQRT(P(2)**2+AMW**2) + FAC=1./(12.*PI*S**2) + FAC=FAC*S/SCM*(P(1)*P(2)/(E1*E2))*UNITS + PROPW=(S-AMW**2)**2+AMW**2*GAMW**2 + SIGHW=GF**2*AMW**8*(S/AMW2+(1.-T/AMW2)*(1.-U/AMW2))/ + $ PROPW*TBRWW(3,2) + SIG=.5*SIGHW*FAC*QFCN(3,1)*QFCN(4,2) + CALL SIGFIL(SIG,3,4,30,28) + SIG=.5*SIGHW*FAC*QFCN(4,1)*QFCN(3,2) + CALL SIGFIL(SIG,4,3,30,28) + SIG=.5*SIGHW*FAC*QFCN(9,1)*QFCN(6,2) + CALL SIGFIL(SIG,9,6,30,28) + SIG=.5*SIGHW*FAC*QFCN(6,1)*QFCN(9,2) + CALL SIGFIL(SIG,6,9,30,28) +110 CONTINUE + END IF +C +C +C WH production via W+* +C + IF (GOQ(27,1).AND.GOQ(30,2)) THEN + CALL TWOKIN(0.,0.,AMW,AMH) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 120 + E1=SQRT(P(1)**2+AMW**2) + E2=SQRT(P(2)**2+AMH**2) + FAC=1./(12.*PI*S**2) + FAC=FAC*S/SCM*(P(1)*P(2)/(E1*E2))*UNITS + PROPW=(S-AMW**2)**2+AMW**2*GAMW**2 + SIGHW=GF**2*AMW**8*(S/AMW2+(1.-T/AMW2)*(1.-U/AMW2))/ + $ PROPW*TBRWW(2,1) + SIG=.5*SIGHW*FAC*QFCN(2,1)*QFCN(5,2) + CALL SIGFIL(SIG,2,5,27,30) + SIG=.5*SIGHW*FAC*QFCN(5,1)*QFCN(2,2) + CALL SIGFIL(SIG,5,2,27,30) + SIG=.5*SIGHW*FAC*QFCN(8,1)*QFCN(7,2) + CALL SIGFIL(SIG,8,7,27,30) + SIG=.5*SIGHW*FAC*QFCN(7,1)*QFCN(8,2) + CALL SIGFIL(SIG,7,8,27,30) +120 CONTINUE + END IF +C + IF (GOQ(30,1).AND.GOQ(27,2)) THEN + CALL TWOKIN(0.,0.,AMH,AMW) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 130 + E1=SQRT(P(1)**2+AMH**2) + E2=SQRT(P(2)**2+AMW**2) + FAC=1./(12.*PI*S**2) + FAC=FAC*S/SCM*(P(1)*P(2)/(E1*E2))*UNITS + PROPW=(S-AMW**2)**2+AMW**2*GAMW**2 + SIGHW=GF**2*AMW**8*(S/AMW2+(1.-T/AMW2)*(1.-U/AMW2))/ + $ PROPW*TBRWW(2,2) + SIG=.5*SIGHW*FAC*QFCN(2,1)*QFCN(5,2) + CALL SIGFIL(SIG,2,5,30,27) + SIG=.5*SIGHW*FAC*QFCN(5,1)*QFCN(2,2) + CALL SIGFIL(SIG,5,2,30,27) + SIG=.5*SIGHW*FAC*QFCN(8,1)*QFCN(7,2) + CALL SIGFIL(SIG,8,7,30,27) + SIG=.5*SIGHW*FAC*QFCN(7,1)*QFCN(8,2) + CALL SIGFIL(SIG,7,8,30,27) +130 CONTINUE + END IF +C +C ZH production via Z* +C + IF (GOQ(29,1).AND.GOQ(30,2)) THEN + CALL TWOKIN(0.,0.,AMZ,AMH) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 200 + E1=SQRT(P(1)**2+AMZ2) + E2=SQRT(P(2)**2+AMH2) + FAC=1./(3.*PI*S**2) + FAC=FAC*S/SCM*(P(1)*P(2)/(E1*E2))*UNITS + PROPZ=(S-AMZ**2)**2+AMZ**2*GAMZ**2 + DO 210 IQ1=2,11 + IFLQ=IS2UD(IQ1) + IQ2=MATCH(IQ1,4) + IF (IQ2.EQ.0.OR.IQ2.GE.12) GO TO 210 + SIG=GF**2*AMZ**8*(GV(IFLQ)**2+GA(IFLQ)**2)* + $ (S/AMZ2+(1.-T/AMZ2)*(1.-U/AMZ2))/PROPZ*TBRWW(4,1) + SIG=.5*SIG*FAC*QFCN(IQ1,1)*QFCN(IQ2,2) + CALL SIGFIL(SIG,IQ1,IQ2,29,30) +210 CONTINUE +200 CONTINUE + END IF +C HZ production via Z* +C + IF (GOQ(30,1).AND.GOQ(29,2)) THEN + CALL TWOKIN(0.,0.,AMH,AMZ) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 220 + E1=SQRT(P(1)**2+AMH2) + E2=SQRT(P(2)**2+AMZ2) + FAC=1./(3.*PI*S**2) + FAC=FAC*S/SCM*(P(1)*P(2)/(E1*E2))*UNITS + PROPZ=(S-AMZ**2)**2+AMZ**2*GAMZ**2 + DO 230 IQ1=2,11 + IFLQ=IS2UD(IQ1) + IQ2=MATCH(IQ1,4) + IF (IQ2.EQ.0.OR.IQ2.GE.12) GO TO 230 + SIG=GF**2*AMZ**8*(GV(IFLQ)**2+GA(IFLQ)**2)* + $ (S/AMZ2+(1.-T/AMZ2)*(1.-U/AMZ2))/PROPZ*TBRWW(4,2) + SIG=.5*SIG*FAC*QFCN(IQ1,1)*QFCN(IQ2,2) + CALL SIGFIL(SIG,IQ1,IQ2,30,29) +230 CONTINUE +220 CONTINUE + END IF + RETURN + END diff --git a/ISAJET/code/sigwhs.F b/ISAJET/code/sigwhs.F new file mode 100644 index 00000000000..506602ff175 --- /dev/null +++ b/ISAJET/code/sigwhs.F @@ -0,0 +1,304 @@ +#include "isajet/pilot.h" + SUBROUTINE SIGWHS +C +C Calculate d(sigma)/d(pt**2)d(y1)d(y2) for +C Wh, WH, Zh, ZH, hA, HA and H+H- production in SUSY +C +C SIGMA = cross section summed over types allowed by +C JETTYPE cards. +C SIGS(I) = partial cross section for I1 + I2 --> I3 + I4 +C INOUT(I) = IOPAK**3*I4 + IOPAK**2*I3 + IOPAK*I2 +I1 +C +C Extra factor of 1/2 needed for nonidentical final jets. +C Y=-log(tan(theta/2)) gives jacobean P1*P2/E1*E2 +C +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/const.inc" +#include "isajet/jetpar.inc" +#include "isajet/jetsig.inc" +#include "isajet/primar.inc" +#include "isajet/q1q2.inc" +#include "isajet/qcdpar.inc" +#include "isajet/wcon.inc" +#include "isajet/sspar.inc" +C + REAL X(2) + EQUIVALENCE (X(1),X1) + EQUIVALENCE (S,SHAT),(T,THAT),(U,UHAT) + REAL SIG,S,T,U,FAC,AMW,AMZ,AMW2,AMZ2,E1,E2,EQ1 + REAL QFCN,STRUC,SIGHW,SCFAC,BETA,SINW,COS2W + REAL PROPZ,PROPW,GV(2),GA(2),AMH,GAMW,GAMZ + INTEGER IS2UD(25),IQ,IH,I,IQ1,IQ2,IFLQ + SAVE IS2UD +C +C IS2UD: Susy jettype -> u/d code + DATA IS2UD/0,1,1,2,2,2,2,1,1,2,2,1,1,1,1,2,2,2,2,1,1,2,2,1,1/ + +C Functions + QFCN(IQ,IH)=STRUC(X(IH),QSQ,IQ,IDIN(IH))/X(IH) +C +C Initialize + DO 10 I=1,MXSIGS +10 SIGS(I)=0. + SIGMA=0. + NSIGS=0 +C + BETA=ATAN(1./RV2V1) + AMW=WMASS(2) + AMW2=AMW**2 + AMZ=WMASS(4) + AMZ2=AMZ**2 + GAMW=WGAM(2) + GAMZ=WGAM(4) + GV(1)=.25-2*SIN2W/3. + GV(2)=-.25+SIN2W/3. + GA(1)=-.25 + GA(2)=.25 + SINW=SQRT(SIN2W) + THW=ASIN(SINW) + COS2W=COS(2*THW) + DO IH=81,82 + IF (IH.EQ.81) THEN + SCFAC=SIN(ALFAH+BETA)**2 + AMH=AMHL + ELSE + SCFAC=COS(ALFAH+BETA)**2 + AMH=AMHH + END IF +C +C Wh, WH production via W-* +C + IF (GOQ(79,1).AND.GOQ(IH,2)) THEN + CALL TWOKIN(0.,0.,AMW,AMH) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 100 + E1=SQRT(P(1)**2+AMW**2) + E2=SQRT(P(2)**2+AMH**2) + FAC=1./(12.*PI*S**2) + FAC=FAC*S/SCM*(P(1)*P(2)/(E1*E2))*UNITS + PROPW=(S-AMW**2)**2+AMW**2*GAMW**2 + SIGHW=GF**2*AMW**8*(S/AMW2+(1.-T/AMW2)*(1.-U/AMW2))/ + $ PROPW*TBRWW(3,1)*SCFAC + SIG=.5*SIGHW*FAC*QFCN(3,1)*QFCN(4,2) + CALL SIGFIL(SIG,3,4,79,IH) + SIG=.5*SIGHW*FAC*QFCN(4,1)*QFCN(3,2) + CALL SIGFIL(SIG,4,3,79,IH) + SIG=.5*SIGHW*FAC*QFCN(9,1)*QFCN(6,2) + CALL SIGFIL(SIG,9,6,79,IH) + SIG=.5*SIGHW*FAC*QFCN(6,1)*QFCN(9,2) + CALL SIGFIL(SIG,6,9,79,IH) +100 CONTINUE + END IF +C + IF (GOQ(IH,1).AND.GOQ(79,2)) THEN + CALL TWOKIN(0.,0.,AMH,AMW) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 110 + E1=SQRT(P(1)**2+AMH**2) + E2=SQRT(P(2)**2+AMW**2) + FAC=1./(12.*PI*S**2) + FAC=FAC*S/SCM*(P(1)*P(2)/(E1*E2))*UNITS + PROPW=(S-AMW**2)**2+AMW**2*GAMW**2 + SIGHW=GF**2*AMW**8*(S/AMW2+(1.-T/AMW2)*(1.-U/AMW2))/ + $ PROPW*TBRWW(3,2)*SCFAC + SIG=.5*SIGHW*FAC*QFCN(3,1)*QFCN(4,2) + CALL SIGFIL(SIG,3,4,IH,79) + SIG=.5*SIGHW*FAC*QFCN(4,1)*QFCN(3,2) + CALL SIGFIL(SIG,4,3,IH,79) + SIG=.5*SIGHW*FAC*QFCN(9,1)*QFCN(6,2) + CALL SIGFIL(SIG,9,6,IH,79) + SIG=.5*SIGHW*FAC*QFCN(6,1)*QFCN(9,2) + CALL SIGFIL(SIG,6,9,IH,79) +110 CONTINUE + END IF +C +C +C Wh, WH production via W+* +C + IF (GOQ(78,1).AND.GOQ(IH,2)) THEN + CALL TWOKIN(0.,0.,AMW,AMH) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 120 + E1=SQRT(P(1)**2+AMW**2) + E2=SQRT(P(2)**2+AMH**2) + FAC=1./(12.*PI*S**2) + FAC=FAC*S/SCM*(P(1)*P(2)/(E1*E2))*UNITS + PROPW=(S-AMW**2)**2+AMW**2*GAMW**2 + SIGHW=GF**2*AMW**8*(S/AMW2+(1.-T/AMW2)*(1.-U/AMW2))/ + $ PROPW*TBRWW(2,1)*SCFAC + SIG=.5*SIGHW*FAC*QFCN(2,1)*QFCN(5,2) + CALL SIGFIL(SIG,2,5,78,IH) + SIG=.5*SIGHW*FAC*QFCN(5,1)*QFCN(2,2) + CALL SIGFIL(SIG,5,2,78,IH) + SIG=.5*SIGHW*FAC*QFCN(8,1)*QFCN(7,2) + CALL SIGFIL(SIG,8,7,78,IH) + SIG=.5*SIGHW*FAC*QFCN(7,1)*QFCN(8,2) + CALL SIGFIL(SIG,7,8,78,IH) +120 CONTINUE + END IF +C + IF (GOQ(IH,1).AND.GOQ(78,2)) THEN + CALL TWOKIN(0.,0.,AMH,AMW) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 130 + E1=SQRT(P(1)**2+AMH**2) + E2=SQRT(P(2)**2+AMW**2) + FAC=1./(12.*PI*S**2) + FAC=FAC*S/SCM*(P(1)*P(2)/(E1*E2))*UNITS + PROPW=(S-AMW**2)**2+AMW**2*GAMW**2 + SIGHW=GF**2*AMW**8*(S/AMW2+(1.-T/AMW2)*(1.-U/AMW2))/ + $ PROPW*TBRWW(2,2)*SCFAC + SIG=.5*SIGHW*FAC*QFCN(2,1)*QFCN(5,2) + CALL SIGFIL(SIG,2,5,IH,78) + SIG=.5*SIGHW*FAC*QFCN(5,1)*QFCN(2,2) + CALL SIGFIL(SIG,5,2,IH,78) + SIG=.5*SIGHW*FAC*QFCN(8,1)*QFCN(7,2) + CALL SIGFIL(SIG,8,7,IH,78) + SIG=.5*SIGHW*FAC*QFCN(7,1)*QFCN(8,2) + CALL SIGFIL(SIG,7,8,IH,78) +130 CONTINUE + END IF +C +C Zh, ZH production via Z* +C + IF (GOQ(80,1).AND.GOQ(IH,2)) THEN + CALL TWOKIN(0.,0.,AMZ,AMH) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 200 + E1=SQRT(P(1)**2+AMZ2) + E2=SQRT(P(2)**2+AMH**2) + FAC=1./(3.*PI*S**2) + FAC=FAC*S/SCM*(P(1)*P(2)/(E1*E2))*UNITS + PROPZ=(S-AMZ**2)**2+AMZ**2*GAMZ**2 + DO 210 IQ1=2,11 + IFLQ=IS2UD(IQ1) + IQ2=MATCH(IQ1,4) + IF (IQ2.EQ.0.OR.IQ2.GE.12) GO TO 210 + SIG=GF**2*AMZ**8*(GV(IFLQ)**2+GA(IFLQ)**2)* + $ (S/AMZ2+(1.-T/AMZ2)*(1.-U/AMZ2))/PROPZ*TBRWW(4,1)*SCFAC + SIG=.5*SIG*FAC*QFCN(IQ1,1)*QFCN(IQ2,2) + CALL SIGFIL(SIG,IQ1,IQ2,80,IH) +210 CONTINUE +200 CONTINUE + END IF +C hZ, HZ production via Z* +C + IF (GOQ(IH,1).AND.GOQ(80,2)) THEN + CALL TWOKIN(0.,0.,AMH,AMZ) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 220 + E1=SQRT(P(1)**2+AMH**2) + E2=SQRT(P(2)**2+AMZ2) + FAC=1./(3.*PI*S**2) + FAC=FAC*S/SCM*(P(1)*P(2)/(E1*E2))*UNITS + PROPZ=(S-AMZ**2)**2+AMZ**2*GAMZ**2 + DO 230 IQ1=2,11 + IFLQ=IS2UD(IQ1) + IQ2=MATCH(IQ1,4) + IF (IQ2.EQ.0.OR.IQ2.GE.12) GO TO 230 + SIG=GF**2*AMZ**8*(GV(IFLQ)**2+GA(IFLQ)**2)* + $ (S/AMZ2+(1.-T/AMZ2)*(1.-U/AMZ2))/PROPZ*TBRWW(4,2)*SCFAC + SIG=.5*SIG*FAC*QFCN(IQ1,1)*QFCN(IQ2,2) + CALL SIGFIL(SIG,IQ1,IQ2,IH,80) +230 CONTINUE +220 CONTINUE + END IF +C +C Next, do Ah and AH production +C + IF (GOQ(83,1).AND.GOQ(IH,2)) THEN + CALL TWOKIN(0.,0.,AMHA,AMH) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 240 + E1=SQRT(P(1)**2+AMHA**2) + E2=SQRT(P(2)**2+AMH**2) + FAC=1./(12.*PI*S**2) + FAC=FAC*S/SCM*(P(1)*P(2)/(E1*E2))*UNITS + PROPZ=(S-AMZ**2)**2+AMZ**2*GAMZ**2 + DO 250 IQ1=2,11 + IFLQ=IS2UD(IQ1) + IQ2=MATCH(IQ1,4) + IF (IQ2.EQ.0.OR.IQ2.GE.12) GO TO 250 + SIG=GF**2*AMZ**4*(GV(IFLQ)**2+GA(IFLQ)**2)* + $ ((AMHA**2+U-T-AMH**2)*(AMHA**2+T-U-AMH**2)- + $ S*(2*AMHA**2+2*AMH**2-S))/PROPZ*SCFAC + SIG=.5*SIG*FAC*QFCN(IQ1,1)*QFCN(IQ2,2) + CALL SIGFIL(SIG,IQ1,IQ2,83,IH) +250 CONTINUE +240 CONTINUE + END IF + IF (GOQ(IH,1).AND.GOQ(83,2)) THEN + CALL TWOKIN(0.,0.,AMH,AMHA) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 260 + E1=SQRT(P(1)**2+AMH**2) + E2=SQRT(P(2)**2+AMHA**2) + FAC=1./(12.*PI*S**2) + FAC=FAC*S/SCM*(P(1)*P(2)/(E1*E2))*UNITS + PROPZ=(S-AMZ**2)**2+AMZ**2*GAMZ**2 + DO 270 IQ1=2,11 + IFLQ=IS2UD(IQ1) + IQ2=MATCH(IQ1,4) + IF (IQ2.EQ.0.OR.IQ2.GE.12) GO TO 270 + SIG=GF**2*AMZ**4*(GV(IFLQ)**2+GA(IFLQ)**2)* + $ ((AMHA**2+U-T-AMH**2)*(AMHA**2+T-U-AMH**2)- + $ S*(2*AMHA**2+2*AMH**2-S))/PROPZ*SCFAC + SIG=.5*SIG*FAC*QFCN(IQ1,1)*QFCN(IQ2,2) + CALL SIGFIL(SIG,IQ1,IQ2,IH,83) +270 CONTINUE +260 CONTINUE + END IF + END DO +C +C Next, do H+H- production +C + IF (GOQ(84,1).AND.GOQ(85,2)) THEN + CALL TWOKIN(0.,0.,AMHC,AMHC) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 300 + E1=SQRT(P(1)**2+AMHC**2) + E2=SQRT(P(2)**2+AMHC**2) + FAC=1./(96.*PI*S**2) + FAC=FAC*S/SCM*(P(1)*P(2)/(E1*E2))*UNITS + PROPZ=(S-AMZ**2)**2+AMZ**2*GAMZ**2 + DO 310 IQ1=2,11 + IFLQ=IS2UD(IQ1) + IQ2=MATCH(IQ1,4) + IF (IFLQ.EQ.1) THEN + EQ1=2./3. + ELSE + EQ1=-1./3. + END IF + IF (IQ2.EQ.0.OR.IQ2.GE.12) GO TO 310 + SIG=((4*PI*ALFA)**2*EQ1**2/S/S+32*PI*ALFA*EQ1*GF*AMZ**2* + $ COS2W*GV(IFLQ)*(S-AMZ**2)/S/PROPZ/SQRT2+8*GF**2* + $ AMZ**4*COS2W**2*(GV(IFLQ)**2+GA(IFLQ)**2)/PROPZ)* + $ ((U-T)*(T-U)-S*(4*AMHC**2-S)) + SIG=.5*SIG*FAC*QFCN(IQ1,1)*QFCN(IQ2,2) + CALL SIGFIL(SIG,IQ1,IQ2,84,85) +310 CONTINUE +300 CONTINUE + END IF + IF (GOQ(85,1).AND.GOQ(84,2)) THEN + CALL TWOKIN(0.,0.,AMHC,AMHC) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 320 + E1=SQRT(P(1)**2+AMHC**2) + E2=SQRT(P(2)**2+AMHC**2) + FAC=1./(96.*PI*S**2) + FAC=FAC*S/SCM*(P(1)*P(2)/(E1*E2))*UNITS + PROPZ=(S-AMZ**2)**2+AMZ**2*GAMZ**2 + DO 330 IQ1=2,11 + IFLQ=IS2UD(IQ1) + IQ2=MATCH(IQ1,4) + IF (IFLQ.EQ.1) THEN + EQ1=2./3. + ELSE + EQ1=-1./3. + END IF + IF (IQ2.EQ.0.OR.IQ2.GE.12) GO TO 330 + SIG=((4*PI*ALFA)**2*EQ1**2/S/S+32*PI*ALFA*EQ1*GF*AMZ**2* + $ COS2W*GV(IFLQ)*(S-AMZ**2)/S/PROPZ/SQRT2+8*GF**2* + $ AMZ**4*COS2W**2*(GV(IFLQ)**2+GA(IFLQ)**2)/PROPZ)* + $ ((U-T)*(T-U)-S*(4*AMHC**2-S)) + SIG=.5*SIG*FAC*QFCN(IQ1,1)*QFCN(IQ2,2) + CALL SIGFIL(SIG,IQ1,IQ2,85,84) +330 CONTINUE +320 CONTINUE + END IF + RETURN + END diff --git a/ISAJET/code/sigww.F b/ISAJET/code/sigww.F new file mode 100644 index 00000000000..11f840a2e36 --- /dev/null +++ b/ISAJET/code/sigww.F @@ -0,0 +1,343 @@ +#include "isajet/pilot.h" + SUBROUTINE SIGWW +C +C Calculate D(SIGMA)/D(PT**2)D(Y1)D(Y2) for QK+QB-->W+W +C summed over W types allowed on JETTYPE cards and +C including branching ratio implied by WMODE cards. +C +C SIGMA = cross section summed over quark types allowed by +C JETTYPE card. +C SIGS(I) = partial cross section for I1 + I2 --> I3 + I4. +C INOUT(I) = IOPAK**3*I4 + IOPAK**2*I3 + IOPAK*I2 + I1 +C using JETTYPE code. +C +C Cross sections from Brown and Mikaelian, +C Phys Rev D19, 922, D20, 1164. +C Include extra factor of 1/2 for double counting. +C +C Double precision needed for 32-bit machines. +C +C Ver. 6.22: Modified to used W + GM decay distributions from +C Cortes, Hagiwara, and Herzog, NP B278, 26 (1986) +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/qcdpar.inc" +#include "isajet/jetpar.inc" +#include "isajet/primar.inc" +#include "isajet/q1q2.inc" +#include "isajet/jetsig.inc" +#include "isajet/const.inc" +#include "isajet/qsave.inc" +#include "isajet/wcon.inc" +#include "isajet/wwpar.inc" +C + DIMENSION X(2),LISTW(4),QSGN(6) + EQUIVALENCE (X(1),X1) + EQUIVALENCE (S,SWW),(T,TWW),(U,UWW) +#if defined(CERNLIB_SINGLE) + REAL S,T,U,TX,UX,TT,UU + $,WWA,WWI,WWE,WZA,WZI,WZE,TERM + $,GA,GI,GE,GJ,GZ +#endif +#if defined(CERNLIB_DOUBLE) + DOUBLE PRECISION S,T,U,TX,UX,TT,UU + $,WWA,WWI,WWE,WZA,WZI,WZE,TERM + $,GA,GI,GE,GJ,GZ +#endif + REAL WM2S,ZM2S,X,STRUC,FJAC,SGN,QSGN,SIG,FACTOR,EQ3(12) + INTEGER I,IH,IQ,IW1,IW2,JW,JZ,IW,IQ1,IQ2,JG,LISTW,IFOUR + INTEGER IFLI,IFLJ + LOGICAL LQK1 +C + DATA LISTW/10,80,-80,90/ + DATA QSGN/1.,-1.,-1.,1.,-1.,1./ + DATA EQ3/2.,-1.,-1.,2.,-1.,2.,0.,-3.,0.,-3.,0.,-3./ +C +C Functions for W+W- + WWA(S,T,U)=(U*T/WM2**2-1.)*(.25-WM2/S+3.*(WM2/S)**2)+S/WM2-4. + WWI(S,T,U)=(U*T/WM2**2-1.)*(.25-.5*WM2/S-WM2**2/(S*T)) + $+S/WM2-2.+2.*WM2/T + WWE(S,T,U)=(U*T/WM2**2-1.)*(.25+(WM2/T)**2)+S/WM2 +C Functions for W+-Z0 + WZA(S,T,U)=(U*T/(WM2*ZM2)-1.)*(.25-(WM2+ZM2)/(2.*S) + $+((WM2+ZM2)**2+8.*WM2*ZM2)/(4.*S**2)) + $+(WM2+ZM2)/(WM2*ZM2)*(.5*S-WM2-ZM2+(WM2-ZM2)**2/(2.*S)) + WZI(S,T,U)=.25*(U*T/(WM2*ZM2)-1.)*(1.-(WM2+ZM2)/S + $-4.*WM2*ZM2/(S*T)) + $+(WM2+ZM2)/(2.*WM2*ZM2)*(S-WM2-ZM2+2.*WM2*ZM2/T) + WZE(S,T,U)=.25*(U*T/(WM2*ZM2)-1.)+.5*S*(WM2+ZM2)/(WM2*ZM2) +C +C Initialize + DO 10 I=1,MXSIGS +10 SIGS(I)=0. + SIGMA=0. + NSIGS=0 +C +C Convention is that even for double precision single +C precision mass is exact. + WM2=WMASS(2) + WM2=WM2**2 + ZM2=WMASS(4) + ZM2=ZM2**2 +C Also need single precision mass**2. + WM2S=WM2 + ZM2S=ZM2 +C +C W+ W- pairs +C + IF(.NOT.((GOQ(2,1).AND.GOQ(3,2)).OR.(GOQ(3,1).AND.GOQ(2,2)))) + $GO TO 200 + CALL WWKIN(WMASS(2),WMASS(2)) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 200 + DO 110 IH=1,2 + DO 110 IQ=2,9 +110 QSAVE(IQ,IH)=STRUC(X(IH),QSQ,IQ,IDIN(IH))/X(IH) + FJAC=S/SCM*UNITS + FJAC=FJAC*PI*ALFA**2/(3.*S**2) + FJAC=FJAC*P(1)*P(2)/SQRT((P(1)**2+WM2S)*(P(2)**2+WM2S)) + FJAC=.5*FJAC +C Sum over jet1 = W+ and jet2 = W+. +C Swap t and u in latter case. + DO 120 IW1=2,3 + IW2=5-IW1 + IF(.NOT.(GOQ(IW1,1).AND.GOQ(IW2,2))) GO TO 120 + IF(IW1.EQ.3) GO TO 121 + TX=T + UX=U + GO TO 122 +121 TX=U + UX=T +C +C Sum over quarks, swapping t and u for negative charge. +122 DO 130 IQ=1,4 + GA=2.*(AQDP(IQ,1)+EZDP*AQDP(IQ,4)*S/(S-ZM2))**2 + $+2.*(EZDP*BQDP(IQ,4)*S/(S-ZM2))**2 + GI=8.*(AQDP(IQ,1)+EZDP*(AQDP(IQ,4)+BQDP(IQ,4))*S/(S-ZM2)) + $*(AQDP(IQ,2))**2 + GE=16.*(AQDP(IQ,2))**4 + SGN=QSGN(IQ) + IF(SGN.LT.0.) GO TO 131 + TT=TX + UU=UX + GO TO 132 +131 TT=UX + UU=TX +132 SIG=QSAVE(2*IQ,1)*QSAVE(2*IQ+1,2)*FJAC*TBRWW(IW1,1)*TBRWW(IW2,2) + $*(GA*WWA(S,TT,UU)-SGN*GI*WWI(S,TT,UU)+GE*WWE(S,TT,UU)) + CALL SIGFIL(SIG,2*IQ,2*IQ+1,IW1,IW2) + SIG=QSAVE(2*IQ+1,1)*QSAVE(2*IQ,2)*FJAC*TBRWW(IW1,1)*TBRWW(IW2,2) + $*(GA*WWA(S,UU,TT)-SGN*GI*WWI(S,UU,TT)+GE*WWE(S,UU,TT)) + CALL SIGFIL(SIG,2*IQ+1,2*IQ,IW1,IW2) +130 CONTINUE +120 CONTINUE +C +C Z0 Z0 pairs +C +200 IF(.NOT.(GOQ(4,1).AND.GOQ(4,2))) GO TO 300 + CALL WWKIN(WMASS(4),WMASS(4)) + IF(X1.GE.1..OR.X2.GE.1.) RETURN + DO 210 IH=1,2 + DO 210 IQ=2,9 +210 QSAVE(IQ,IH)=STRUC(X(IH),QSQ,IQ,IDIN(IH))/X(IH) +C Jacobean -- including factor of 1/2 for identical particles. + FJAC=.5*S/SCM*UNITS + FJAC=FJAC*PI*ALFA**2/(3.*S**2) + FJAC=FJAC*P(1)*P(2)/SQRT((P(1)**2+ZM2S)*(P(2)**2+ZM2S)) + DO 220 IQ=1,4 + GZ=2.*(AQDP(IQ,4)**4+BQDP(IQ,4)**4 + $+6.*AQDP(IQ,4)**2*BQDP(IQ,4)**2) + FACTOR=(T/U+U/T+4.*ZM2*S/(T*U)-ZM2**2*(1./T**2+1./U**2)) + FACTOR=FACTOR*FJAC*GZ*TBRWW(4,1)*TBRWW(4,2) + SIG=FACTOR*QSAVE(2*IQ,1)*QSAVE(2*IQ+1,2) + CALL SIGFIL(SIG,2*IQ,2*IQ+1,4,4) + SIG=FACTOR*QSAVE(2*IQ+1,1)*QSAVE(2*IQ,2) + CALL SIGFIL(SIG,2*IQ+1,2*IQ,4,4) +220 CONTINUE +C +C W+- Z0 pairs +C +C JW and JZ are W+- and Z0 jet numbers. +300 DO 310 JW=1,2 + JZ=3-JW + IF(.NOT.((GOQ(2,JW).OR.GOQ(3,JW)).AND.GOQ(4,JZ))) GO TO 310 +C +C Must swap t and u if JW=2. + IF(JW.EQ.1) THEN + CALL WWKIN(WMASS(2),WMASS(4)) + TX=T + UX=U + FJAC=S/SCM*UNITS + FJAC=FJAC*PI*ALFA**2/(3.*S**2) + FJAC=.5*FJAC + FJAC=FJAC*P(1)*P(2)/SQRT((P(1)**2+WM2S)*(P(2)**2+ZM2S)) + ELSE + CALL WWKIN(WMASS(4),WMASS(2)) + TX=U + UX=T + FJAC=S/SCM*UNITS + FJAC=FJAC*PI*ALFA**2/(3.*S**2) + FJAC=.5*FJAC + FJAC=FJAC*P(1)*P(2)/SQRT((P(1)**2+ZM2S)*(P(2)**2+WM2S)) + ENDIF + IF(X1.GE.1..OR.X2.GE.1.) GO TO 310 + DO 320 IH=1,2 + DO 320 IQ=1,9 +320 QSAVE(IQ,IH)=STRUC(X(IH),QSQ,IQ,IDIN(IH))/X(IH) +C +C Sum over W+ and W- + DO 340 IW=2,3 + IF(IW.EQ.2) THEN + SGN=+1 + ELSE + SGN=+1 + ENDIF +C +C Sum over quarks, swapping t and u as needed. + DO 350 IQ1=2,9 + IQ2=MATCH(IQ1,IW) + IF(IQ2.EQ.0) GO TO 350 + IQ=IQ1/2 + IF(2*IQ.EQ.IQ1) THEN + LQK1=.TRUE. + ELSE + LQK1=.FALSE. + ENDIF + IF((LQK1.AND.IW.EQ.3).OR.(.NOT.LQK1.AND.IW.EQ.2)) THEN + TT=TX + UU=UX + IFLI=IQ1/2 + IFLJ=IQ2/2 + ELSE + TT=UX + UU=TX + IFLI=IQ2/2 + IFLJ=IQ1/2 + ENDIF +C + GA=AQDP(IQ,IW)*EZDP*S/(S-WM2) + GI=AQDP(IQ,IW)*(AQDP(IFLI,4)+BQDP(IFLI,4)) + GJ=AQDP(IQ,IW)*(AQDP(IFLJ,4)+BQDP(IFLJ,4)) + TERM=GA**2*WZA(S,TT,UU) + TERM=TERM+2.*GA*SGN*(-GJ*WZI(S,TT,UU)+GI*WZI(S,UU,TT)) + TERM=TERM+(GI-GJ)**2*WZE(S,TT,UU) + TERM=TERM+GI**2*(UU*TT-WM2*ZM2)/UU**2 + $ +2.*GI*GJ*S*(WM2+ZM2)/(TT*UU)+GJ**2*(UU*TT-WM2*ZM2)/TT**2 + TERM=TERM*4.*FJAC*QSAVE(IQ1,1)*QSAVE(IQ2,2) + TERM=TERM*TBRWW(IW,JW)*TBRWW(4,JZ) + SIG=TERM + IF(JW.EQ.1) THEN + CALL SIGFIL(SIG,IQ1,IQ2,IW,4) + ELSE + CALL SIGFIL(SIG,IQ1,IQ2,4,IW) + ENDIF +350 CONTINUE +340 CONTINUE +310 CONTINUE +C +C W+- GM pairs. +C +400 DO 410 JW=1,2 + JG=3-JW + IF(.NOT.((GOQ(2,JW).OR.GOQ(3,JW)).AND.GOQ(1,JG))) GO TO 410 +C +C Must swap t and u if JW=2. + IF(JW.EQ.1) THEN + CALL WWKIN(WMASS(2),0.) + TX=T + UX=U + FJAC=S/SCM*UNITS + FJAC=FJAC*PI*ALFA**2/S**2 + FJAC=.5*FJAC + FJAC=FJAC*P(1)/SQRT(P(1)**2+WM2S) + ELSE + CALL WWKIN(0.,WMASS(2)) + TX=U + UX=T + FJAC=S/SCM*UNITS + FJAC=FJAC*PI*ALFA**2/S**2 + FJAC=.5*FJAC + FJAC=FJAC*P(2)/SQRT(P(2)**2+WM2S) + ENDIF +C + IF(X1.GE.1..OR.X2.GE.1.) GO TO 410 + DO 420 IH=1,2 + DO 420 IQ=1,9 +420 QSAVE(IQ,IH)=STRUC(X(IH),QSQ,IQ,IDIN(IH))/X(IH) +C +C Sum over W+ and W- + DO 440 IW=2,3 +C +C Sum over quarks, swapping t and u as needed. + DO 450 IQ1=2,9 + IQ2=MATCH(IQ1,IW) + IF(IQ2.EQ.0) GO TO 450 + IQ=IQ1/2 + IF(2*IQ.EQ.IQ1) THEN + LQK1=.TRUE. + ELSE + LQK1=.FALSE. + ENDIF + IF((LQK1.AND.IW.EQ.3).OR.(.NOT.LQK1.AND.IW.EQ.2)) THEN + TT=TX + UU=UX + ELSE + TT=UX + UU=TX + ENDIF +C + SIG=TBRWW(IW,JW)/(6.*SIN2W)*(-1./3.+UU/(TT+UU))**2 + $ *(UU**2+TT**2+2.*S*WM2)/(TT*UU) + SIG=SIG*FJAC*QSAVE(IQ1,1)*QSAVE(IQ2,2) + IF(JW.EQ.1) CALL SIGFIL(SIG,IQ1,IQ2,IW,1) + IF(JW.EQ.2) CALL SIGFIL(SIG,IQ1,IQ2,1,IW) +450 CONTINUE +440 CONTINUE +410 CONTINUE +C +C Z0 GM pairs +C + IF (GOQ(4,1).AND.GOQ(1,2)) THEN + CALL WWKIN(WMASS(4),0.) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 500 + DO 510 IH=1,2 + DO 510 IQ=2,9 +510 QSAVE(IQ,IH)=STRUC(X(IH),QSQ,IQ,IDIN(IH))/X(IH) + FJAC=S/SCM*P(1)/SQRT(P(1)**2+ZM2S)*UNITS + FJAC=FJAC*PI*ALFA**2/(3.*S**2) + DO 520 IQ=1,4 + GZ=AQDP(IQ,4)**2+(AQDP(IQ,4)-BQDP(IQ,4))**2 + FACTOR=(S**2+ZM2**2)/2./T/U+1. + FACTOR=(EQ3(IQ)/3.)**2*FACTOR*FJAC*GZ*TBRWW(4,1) + SIG=FACTOR*QSAVE(2*IQ,1)*QSAVE(2*IQ+1,2) + CALL SIGFIL(SIG,2*IQ,2*IQ+1,4,1) + SIG=FACTOR*QSAVE(2*IQ+1,1)*QSAVE(2*IQ,2) + CALL SIGFIL(SIG,2*IQ+1,2*IQ,4,1) +520 CONTINUE +500 CONTINUE + END IF +C + IF (GOQ(1,1).AND.GOQ(4,2)) THEN + CALL WWKIN(0.,WMASS(4)) + IF(X1.GE.1..OR.X2.GE.1.) GO TO 600 + DO 610 IH=1,2 + DO 610 IQ=2,9 +610 QSAVE(IQ,IH)=STRUC(X(IH),QSQ,IQ,IDIN(IH))/X(IH) + FJAC=S/SCM*P(2)/SQRT(P(2)**2+ZM2S)*UNITS + FJAC=FJAC*PI*ALFA**2/(3.*S**2) + DO 620 IQ=1,4 + GZ=AQDP(IQ,4)**2+(AQDP(IQ,4)-BQDP(IQ,4))**2 + FACTOR=(S**2+ZM2**2)/2./T/U+1. + FACTOR=(EQ3(IQ)/3.)**2*FACTOR*FJAC*GZ*TBRWW(4,2) + SIG=FACTOR*QSAVE(2*IQ,1)*QSAVE(2*IQ+1,2) + CALL SIGFIL(SIG,2*IQ,2*IQ+1,1,4) + SIG=FACTOR*QSAVE(2*IQ+1,1)*QSAVE(2*IQ,2) + CALL SIGFIL(SIG,2*IQ+1,2*IQ,1,4) +620 CONTINUE +600 CONTINUE + END IF +C + RETURN + END diff --git a/ISAJET/code/sigww2.F b/ISAJET/code/sigww2.F new file mode 100644 index 00000000000..8e24175625b --- /dev/null +++ b/ISAJET/code/sigww2.F @@ -0,0 +1,432 @@ +#include "isajet/pilot.h" + SUBROUTINE SIGWW2 +C +C Calculate WPAIR decay distribution +C D(SIGMA)/D(PT**2)D(Y1)D(Y2)D(OMEGA1)D(OMEGA2) +C for modes selected in WPAIR. +C +C Also fix the initial parton types to those selected. +C +C Cross sections from SCHOONSCHIP (1980) neglecting W width +C and quark masses. Hence use zero-mass vectors PZERO from +C WPAIR to define kinematics. +C QK(P1) + QB(P2) --> W1(P3) + W2(P4) +C W1(P3) --> QK(Q1) + QB(Q2) +C W2(P4) --> QK(Q3) + QB(Q4) +C S=(P3+P4)**2, T=(P3-P1)**2, U=(P3-P2)**2 +C S1=(Q1+P4)**2, T1=(Q1-P1)**2, U1=(Q1-P2)**2 +C S3=(Q3+P3)**2, T3=(Q3-P2)**2, U3=(Q3-P1)**2 +C S13=(Q1+Q3)**2 +C Note that the W+- final couplings have been set equal to 1. +C in the SCHOONSCHIP formulas and must be restored. +C +C Need double precision for 32-bit machines. +C +C Ver. 5.35 - correct symmetrization for DN DB -> W+ W-. +C Ver. 6.22 - use W + GM decay distributions from +C Cortes, Hagiwara, and Herzog, NP B278, 26 (1986) +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/qcdpar.inc" +#include "isajet/jetpar.inc" +#include "isajet/primar.inc" +#include "isajet/q1q2.inc" +#include "isajet/const.inc" +#include "isajet/qsave.inc" +#include "isajet/wcon.inc" +#include "isajet/pjets.inc" +#include "isajet/pinits.inc" +#include "isajet/wwsig.inc" +#include "isajet/wwpar.inc" +C + DIMENSION P1(5),P2(5),QSGN(6),PP1(4),PP2(4) + EQUIVALENCE (S,SWW),(T,TWW),(U,UWW) + EQUIVALENCE (P1(1),P1WW(1)),(P2(1),P2WW(1)) +C Double precision kinematics for 32-bit. +#if defined(CERNLIB_SINGLE) + REAL S,T,U,T1,U1,T3,U3,P1,P2 + 1,TX,UX,TT,UU,TT1,UU1,TT3,UU3,PP1,PP2 + REAL TERM,WWSS,WWST,WWTT,ZZALL,WZSS,WZST,WZSU,WZTU + 1,WGSS,WGST,WGSU,WGTU +#endif +#if defined(CERNLIB_DOUBLE) + DOUBLE PRECISION S,T,U,T1,U1,T3,U3,P1,P2 + 1,TX,UX,TT,UU,TT1,UU1,TT3,UU3,PP1,PP2 + DOUBLE PRECISION TERM,WWSS,WWST,WWTT,ZZALL,WZSS,WZST,WZSU,WZTU + 1,WGSS,WGST,WGSU,WGTU +#endif + REAL P3IS3,P3IS4,FJAC,AMW1,AMW2,GAM1,GAM2,SGN,QSGN,AMASS3 + REAL P1DQ2,P2DQ1 + REAL A1,B1,A2,B2,ES,SMS,SMSZG,EQ3(12) + REAL Q(5),QB(5),KK(5),E(5),EB(5) + INTEGER K,JQ1,JQ3,JW1,JW2,IW1,IW2,IQ1,IQ2,IQ,ISWAPQ,JW,JZ,ISGN + INTEGER IFLI,IFLJ,JG,IL,IW + LOGICAL LQK1 +C + DATA QSGN/1.,-1.,-1.,1.,-1.,1./ + DATA EQ3/2.,-1.,-1.,2.,-1.,2.,0.,-3.,0.,-3.,0.,-3./ +C +C Entry +C + ES=4*PI*ALFA + WWSIG=0. + IF(IDJETS(1).EQ.10.OR.IDJETS(2).EQ.10) GO TO 2 +C Normal case + IF((IDJETS(1).EQ.80.AND.IDJETS(2).EQ.-80).OR. + $(IDJETS(1).EQ.90.AND.IDJETS(2).EQ.90).OR. + $(IABS(IDJETS(1)).EQ.80.AND.IDJETS(2).EQ.90)) THEN + DO 10 K=1,4 + P3(K)=P3WW(K) + Q1(K)=PZERO(K,1) + Q3(K)=PZERO(K,3) +10 CONTINUE + P3IS3=1. + P3IS4=0. + JQ1=1 + JQ3=3 + JW1=1 + JW2=2 + TX=T + UX=U +C Crossed case + ELSE + DO 20 K=1,4 + P3(K)=P4WW(K) + Q1(K)=PZERO(K,3) + Q3(K)=PZERO(K,1) +20 CONTINUE + P3IS3=0. + P3IS4=1. + JQ1=3 + JQ3=1 + JW1=2 + JW2=1 + TX=U + UX=T + ENDIF +C Variables + T1=-2.*(Q1(4)*P1(4)-Q1(1)*P1(1)-Q1(2)*P1(2)-Q1(3)*P1(3)) + U1=-2.*(Q1(4)*P2(4)-Q1(1)*P2(1)-Q1(2)*P2(2)-Q1(3)*P2(3)) + T3=-2.*(Q3(4)*P2(4)-Q3(1)*P2(1)-Q3(2)*P2(2)-Q3(3)*P2(3)) + U3=-2.*(Q3(4)*P1(4)-Q3(1)*P1(1)-Q3(2)*P1(2)-Q3(3)*P1(3)) + S13=2.*(Q1(4)*Q3(4)-Q1(1)*Q3(1)-Q1(2)*Q3(2)-Q1(3)*Q3(3)) +C Jacobean for 4-body cross section in terms of squared +C matrix exement in narrow resonance approximation-- +C 1/((P**2-M**2)**2+M**2*GAM**2)=1/(2*M*GAM)*DELTA(P**2-M**2) + FJAC=S/SCM*UNITS + FJAC=FJAC*ALFA**4/(256.*PI*3.*S**2) + AMW1=PJETS(5,1) + AMW2=PJETS(5,2) + GAM1=WGAM(JETTYP(1)) + GAM2=WGAM(JETTYP(2)) + FJAC=FJAC/(AMW1*GAM1*AMW2*GAM2) + FJAC=FJAC*P(1)*P(2)/SQRT((P(1)**2+AMW1**2)*(P(2)**2+AMW2**2)) +C Color factor + IF(IABS(IDPAIR(1)).LT.10) FJAC=3.*FJAC + IF(IABS(IDPAIR(3)).LT.10) FJAC=3.*FJAC +C +C W+ W- pair decays +C Standard order is UP + UB --> W+ + W- +C + IF(.NOT.((JETTYP(1).EQ.2.AND.JETTYP(2).EQ.3).OR.(JETTYP(1).EQ.3 + 1.AND.JETTYP(2).EQ.2))) GO TO 200 + FJAC=.5*FJAC*AQ(2,2)**4 +C +C Select W+ W- OR W- W+, swapping T and U for latter. + IW1=JETTYP(1) + IW2=JETTYP(2) +C +C Select quarks + IQ1=INITYP(1) + IQ2=INITYP(2) + IQ=IQ1/2 + CQ=AQDP(IQ,2)**2 + CV=AQDP(IQ,1)/S+EZDP*AQDP(IQ,4)/(S-ZM2) + CA=EZDP*BQDP(IQ,4)/(S-ZM2) + SGN=QSGN(IQ) + ISWAPQ=1 + IF(SGN.LT.0.) ISWAPQ=-1 + IF(ISWAPQ.GT.0) THEN + TT=TX + UU=UX + TT1=T1 + UU1=U1 + TT3=T3 + UU3=U3 + DO 122 K=1,4 + PP1(K)=P1(K) + PP2(K)=P2(K) + P3(K)=P3IS3*P3WW(K)+P3IS4*P4WW(K) + Q1(K)=PZERO(K,JQ1) + Q3(K)=PZERO(K,JQ3) +122 CONTINUE + ELSE + TT=UX + UU=TX + TT1=U3 + UU1=T3 + TT3=U1 + UU3=T1 + DO 123 K=1,4 + PP1(K)=P1(K) + PP2(K)=P2(K) + P3(K)=P3IS4*P3WW(K)+P3IS3*P4WW(K) + Q1(K)=PZERO(K,JQ3) + Q3(K)=PZERO(K,JQ1) +123 CONTINUE + ENDIF +C + IF(IQ1.EQ.2*IQ) THEN + TERM=WWTT(TT,UU,TT1,UU1,TT3,UU3) + TERM=TERM-SGN*WWST(TT,UU,TT1,UU1,TT3,UU3,PP1,PP2) + TERM=TERM+WWSS(TT,UU,TT1,UU1,TT3,UU3) + WWSIG=TERM*QSAVE(2*IQ,1)*QSAVE(2*IQ+1,2)*FJAC + ELSE + TERM=WWTT(UU,TT,UU1,TT1,UU3,TT3) + TERM=TERM-SGN*WWST(UU,TT,UU1,TT1,UU3,TT3,PP2,PP1) + TERM=TERM+WWSS(UU,TT,UU1,TT1,UU3,TT3) + WWSIG=TERM*QSAVE(2*IQ+1,1)*QSAVE(2*IQ,2)*FJAC + ENDIF +C + RETURN +C +C Z0 Z0 pair decays +C Standard order is UP + UB --> Z0 + Z0 +C +200 IF(.NOT.(JETTYP(1).EQ.4.AND.JETTYP(2).EQ.4)) GO TO 300 + FJAC=.5*FJAC +C +C Select quarks + IQ1=INITYP(1) + IQ2=INITYP(2) + IQ=IQ1/2 + CV=AQDP(IQ,4)**2+BQDP(IQ,4)**2 + CA=2.*AQDP(IQ,4)*BQDP(IQ,4) + CV1=AQDP(JQWW(1),4)**2+BQDP(JQWW(1),4)**2 + CA1=2.*AQDP(JQWW(1),4)*BQDP(JQWW(1),4) + CV3=AQDP(JQWW(2),4)**2+BQDP(JQWW(2),4)**2 + CA3=2.*AQDP(JQWW(2),4)*BQDP(JQWW(2),4) +C + TERM=ZZALL(TX,UX,T1,U1,T3,U3,P1,P2) + IF(INITYP(1).EQ.2*IQ) THEN + WWSIG=TERM*QSAVE(2*IQ,1)*QSAVE(2*IQ+1,2)*FJAC + ELSE + WWSIG=TERM*QSAVE(2*IQ+1,1)*QSAVE(2*IQ,2)*FJAC + ENDIF +C + RETURN +C +C W+- Z0 pair decays +C Standard order is DN + UB --> W- + Z0 +C +300 JW=JW1 + JZ=JW2 + ISGN=-ISIGN(1,IDJETS(JW)) + SGN=ISGN + CV3=AQDP(JQWW(JZ),4)**2+BQDP(JQWW(JZ),4)**2 + CA3=2.*AQDP(JQWW(JZ),4)*BQDP(JQWW(JZ),4) + FJAC=.5*FJAC*AQ(1,2)**2 +C +C Select quarks. Formulas are for DN UB --> W- Z0. +C Use symmetry for other cases. + IQ1=INITYP(1) + IQ2=INITYP(2) + IQ=IQ1/2 +C Find whether IQ1 should be fermion or antifermion. + IF(IQ1.EQ.2*(IQ1/2)) THEN + ISWAPQ=+1 + IFLI=IQ1/2 + IFLJ=IQ2/2 + ELSE + ISWAPQ=-1 + IFLI=IQ2/2 + IFLJ=IQ1/2 + ENDIF +C + CS=AQDP(IQ,JETTYP(JW))*EZDP/(S-WM2) + CT=AQDP(IQ,JETTYP(JW))*(AQDP(IFLJ,4)+BQDP(IFLJ,4)) + CU=AQDP(IQ,JETTYP(JW))*(AQDP(IFLI,4)+BQDP(IFLI,4)) +C +C SWAP T AND U AS NEEDED + IF(ISWAPQ*ISGN.GT.0) THEN + TT=TX + UU=UX + TT1=T1 + UU1=U1 + TT3=T3 + UU3=U3 + DO 321 K=1,4 + PP1(K)=P1(K) + PP2(K)=P2(K) +321 CONTINUE + ELSE + TT=UX + UU=TX + TT1=U1 + UU1=T1 + TT3=U3 + UU3=T3 + DO 323 K=1,4 + PP1(K)=P2(K) + PP2(K)=P1(K) +323 CONTINUE + ENDIF +C + TERM=WZSS(TT,UU,TT1,UU1,TT3,UU3,PP1,PP2) + TERM=TERM-SGN*WZST(TT,UU,TT1,UU1,TT3,UU3,PP1,PP2) + TERM=TERM-SGN*WZSU(TT,UU,TT1,UU1,TT3,UU3,PP1,PP2) + TERM=TERM+WZTU(TT,UU,TT1,UU1,TT3,UU3,PP1,PP2) + WWSIG=TERM*QSAVE(IQ1,1)*QSAVE(IQ2,2)*FJAC +C + RETURN +C +C Do Z+gamma or W+gamma 3-body subprocesses +C +2 CONTINUE +C +C Z+gamma +C Standard order is UP + UB --> Z0 + gamma +C + IF(.NOT.(JETTYP(1).EQ.4.AND.JETTYP(2).EQ.1)) GO TO 505 + FJAC=S/SCM*P(1)/SQRT(P(1)**2+WMASS(4)**2)*UNITS +C +C Select quarks + IQ1=INITYP(1) + IQ2=INITYP(2) + IQ=IQ1/2 + A1=-AQ(IQ,4) + B1=BQ(IQ,4) + A2=-AQ(JQWW(1),4) + B2=BQ(JQWW(1),4) + DO K=1,5 + Q(K)=SNGL(P1WW(K)) + QB(K)=SNGL(P2WW(K)) + KK(K)=SNGL(P4WW(K)) + E(K)=SNGL(PZERO(K,1)) + EB(K)=SNGL(PZERO(K,2)) + END DO +C + IF(INITYP(1).EQ.2*IQ) THEN + SMS=SMSZG(Q,QB,KK,E,EB,A1,B1,A2,B2) + TERM=ES**3*(EQ3(IQ)/3.)**2*SMS/192./PI**4/WMASS(4)/WGAM(4)/S**2 + WWSIG=TERM*QSAVE(2*IQ,1)*QSAVE(2*IQ+1,2)*FJAC/2. + ELSE + SMS=SMSZG(QB,Q,KK,E,EB,A1,B1,A2,B2) + TERM=ES**3*(EQ3(IQ)/3.)**2*SMS/192./PI**4/WMASS(4)/WGAM(4)/S**2 + WWSIG=TERM*QSAVE(2*IQ+1,1)*QSAVE(2*IQ,2)*FJAC/2. + ENDIF +505 IF(.NOT.(JETTYP(1).EQ.1.AND.JETTYP(2).EQ.4)) GO TO 509 + FJAC=S/SCM*P(2)/SQRT(P(2)**2+WMASS(4)**2)*UNITS +C +C Select quarks + IQ1=INITYP(1) + IQ2=INITYP(2) + IQ=IQ1/2 + A1=-AQ(IQ,4) + B1=BQ(IQ,4) + A2=-AQ(JQWW(2),4) + B2=BQ(JQWW(2),4) + DO K=1,5 + Q(K)=SNGL(P1WW(K)) + QB(K)=SNGL(P2WW(K)) + KK(K)=SNGL(P3WW(K)) + E(K)=SNGL(PZERO(K,1)) + EB(K)=SNGL(PZERO(K,2)) + END DO +C + IF(INITYP(1).EQ.2*IQ) THEN + SMS=SMSZG(Q,QB,KK,E,EB,A1,B1,A2,B2) + TERM=ES**3*(EQ3(IQ)/3.)**2*SMS/192./PI**4/WMASS(4)/WGAM(4)/S**2 + WWSIG=TERM*QSAVE(2*IQ,1)*QSAVE(2*IQ+1,2)*FJAC/2. + ELSE + SMS=SMSZG(QB,Q,KK,E,EB,A1,B1,A2,B2) + TERM=ES**3*(EQ3(IQ)/3.)**2*SMS/192./PI**4/WMASS(4)/WGAM(4)/S**2 + WWSIG=TERM*QSAVE(2*IQ+1,1)*QSAVE(2*IQ,2)*FJAC/2. + ENDIF + +C W+- GM pair decays +C Standard order is DN + UB --> W- + GM +C +C Swap if W is jet 2 +509 IF (ABS(IDJETS(1)).EQ.80.OR.ABS(IDJETS(2)).EQ.80) THEN + IF(IDJETS(2).EQ.10) THEN + DO 510 K=1,4 + P3(K)=P3WW(K) + Q1(K)=PZERO(K,1) +510 CONTINUE + AMASS3=PJETS(5,1) + JW=1 + JG=2 + TX=T + UX=U + ELSE + DO 520 K=1,4 + P3(K)=P4WW(K) + Q1(K)=PZERO(K,1) +520 CONTINUE + AMASS3=PJETS(5,2) + JW=2 + JG=1 + TX=U + UX=T + ENDIF + IF(IDJETS(JW).EQ.80) THEN + IW=2 + ELSE + IW=3 + ENDIF +C + T1=-2.*(Q1(4)*P1(4)-Q1(1)*P1(1)-Q1(2)*P1(2)-Q1(3)*P1(3)) + U1=-2.*(Q1(4)*P2(4)-Q1(1)*P2(1)-Q1(2)*P2(2)-Q1(3)*P2(3)) +C Jacobean + FJAC=S/SCM*UNITS + FJAC=FJAC*P(JW)/SQRT(P(JW)**2+WM2) +C Sum over quarks. Formulas are for DN UB --> W- GM. +C Use symmetry for other cases. + IQ1=INITYP(1) + IQ2=INITYP(2) + IQ=IQ1/2 + IF(2*IQ.EQ.IQ1) THEN + LQK1=.TRUE. + ELSE + LQK1=.FALSE. + ENDIF +C Swap t and u as necessary + IF((LQK1.AND.IW.EQ.3).OR.(.NOT.LQK1.AND.IW.EQ.2)) THEN + TT=TX + UU=UX + TT1=T1 + UU1=U1 + ELSE + TT=UX + UU=TX + TT1=U1 + UU1=T1 + ENDIF +C Lepton or quark pointer + IL=IABS(IDPAIR(1)) + IF(IL.GT.6) IL=IL-4 +C +C Matrix element - properly crossed variables. +C Remember PZERO(K,1) is always the fermion. + IF(LQK1) THEN + P1DQ2=P1(4)*PZERO(4,2)-P1(1)*PZERO(1,2)-P1(2)*PZERO(2,2) + $ -P1(3)*PZERO(3,2) + P2DQ1=P2(4)*PZERO(4,1)-P2(1)*PZERO(1,1)-P2(2)*PZERO(2,1) + $ -P2(3)*PZERO(3,1) + ELSE + P1DQ2=P2(4)*PZERO(4,2)-P2(1)*PZERO(1,2)-P2(2)*PZERO(2,2) + $ -P2(3)*PZERO(3,2) + P2DQ1=P1(4)*PZERO(4,1)-P1(1)*PZERO(1,1)-P1(2)*PZERO(2,1) + $ -P1(3)*PZERO(3,1) + ENDIF + TERM=ALFA**2/(8.*SIN2W*S**2)*TBRWW(IW,JW)*RBRWW(IL,IW,JW) + $*(-1./3.+UU/(TT+UU))**2/(TT*UU)*(4.*P2DQ1**2+4.*P1DQ2**2) + WWSIG=TERM*QSAVE(IQ1,1)*QSAVE(IQ2,2)*FJAC + END IF +C + RETURN + END diff --git a/ISAJET/code/smszg.F b/ISAJET/code/smszg.F new file mode 100644 index 00000000000..cbfa7640d1d --- /dev/null +++ b/ISAJET/code/smszg.F @@ -0,0 +1,36 @@ +#include "isajet/pilot.h" + FUNCTION SMSZG(Q,QB,K,E,EB,AQ,BQ,AE,BE) + IMPLICIT NONE +C +C This does squared matrix element for q+qb -> Z+gamma +C where Z-> e+eb +C I have factored out 128*e^6*Q_q^2*|D_Z(z^2)| from +C the expression. Also 1/12 from spin/color ave. is out. +C + REAL Q(5),QB(5),K(5),E(5),EB(5),AQ,BQ,AE,BE,SMSZG + REAL M1S,M2S,M12 + REAL EDQ,EBDK,EBDQ,EDK,QBDK,EDQB,EBDQB,QDK,QDQB + EDQ=E(4)*Q(4)-E(1)*Q(1)-E(2)*Q(2)-E(3)*Q(3) + EBDK=EB(4)*K(4)-EB(1)*K(1)-EB(2)*K(2)-EB(3)*K(3) + EBDQ=EB(4)*Q(4)-EB(1)*Q(1)-EB(2)*Q(2)-EB(3)*Q(3) + EDK=E(4)*K(4)-E(1)*K(1)-E(2)*K(2)-E(3)*K(3) + QBDK=QB(4)*K(4)-QB(1)*K(1)-QB(2)*K(2)-QB(3)*K(3) + EDQB=E(4)*QB(4)-E(1)*QB(1)-E(2)*QB(2)-E(3)*QB(3) + EBDQB=EB(4)*QB(4)-EB(1)*QB(1)-EB(2)*QB(2)-EB(3)*QB(3) + QDK=Q(4)*K(4)-Q(1)*K(1)-Q(2)*K(2)-Q(3)*K(3) + QDQB=Q(4)*QB(4)-Q(1)*QB(1)-Q(2)*QB(2)-Q(3)*QB(3) + M1S=(((AQ**2+BQ**2)*(AE**2+BE**2)-4*AQ*BQ*AE*BE)*EDQ*EBDK+ + $((AQ**2+BQ**2)*(AE**2+BE**2)+4*AQ*BQ*AE*BE)*EBDQ*EDK)/ + $4./QBDK + M2S=(((AQ**2+BQ**2)*(AE**2+BE**2)+4*AQ*BQ*AE*BE)*EDQB*EBDK+ + $((AQ**2+BQ**2)*(AE**2+BE**2)-4*AQ*BQ*AE*BE)*EBDQB*EDK)/ + $4./QDK + M12=(2*(AQ**2+BQ**2)*(AE**2+BE**2)*(EDQ*EBDQ*QBDK+EDQB*EBDQB*QDK) + $+((AQ**2+BQ**2)*(AE**2+BE**2)-4*AQ*BQ*AE*BE)*(2*EDQ*EBDQB*QDQB+ + $EDQ*EBDK*QDQB-EDK*EBDQB*QDQB+EDQ*EBDQB*QDK-EDQ*EBDQB*QBDK)+ + $((AQ**2+BQ**2)*(AE**2+BE**2)+4*AQ*BQ*AE*BE)*(2*EDQB*EBDQ*QDQB- + $EDQB*EBDK*QDQB+EDK*EBDQ*QDQB+EDQB*EBDQ*QDK-EDQB*EBDQ*QBDK))/ + $4./QBDK/QDK + SMSZG=M1S+M2S+M12 + RETURN + END diff --git a/ISAJET/code/spline.F b/ISAJET/code/spline.F new file mode 100644 index 00000000000..f40c1b41ee5 --- /dev/null +++ b/ISAJET/code/spline.F @@ -0,0 +1,65 @@ +#include "isajet/pilot.h" + SUBROUTINE SPLINE(X,C,N,IBCBEG,IBCEND) +C********************************************************************** +C* Computes the coefficient of a cubic interpolating spline. The X(i),* +C* i=1,...,N, are the knots or x-values of data points; C(1,i) are * +C* the corresponding y-values. N is the number of data points (>3!). * +C* IBCBEG = 0 means that the slope at X(1) is unknown, in which case * +C* it is determined from requiring a smooth 3rd derivative at x(2); * +C* IBCBEG = 1 means that the slope is known, in which case it has to * +C* be stored in C(1,2). IBCEND has the same meaning for the end of * +C* x-region; if IBCEND = 1, the slope is to be stored in C(2,N). The * +C* routine then computes the coefficients C(l,i) of the i-th spline, * +C* written in the form * +C* f_i(x) = C(1,i) + h_i C(2,i) + h_i^2 C(3,i) + h_i^3 C(4,i), where * +C* h_i = x - X(I). * +C Modified from contributed subroutine by M. Drees, 1/14/99 +C********************************************************************** +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + INTEGER N,IBCBEG,IBCEND,I,L,M,J + REAL C(4,N),X(N),G,DTAU,DIVDF1,DIVDF3 +C + L = N - 1 + DO 10 M = 2, N + C(3,M) = X(M) - X(M-1) + 10 C(4,M) = (C(1,M) - C(1,M-1))/C(3,M) +C First slope unknown + IF(IBCBEG.EQ.0) THEN + C(4,1) = C(3,3) + C(3,1) = C(3,2) + C(3,3) + C(2,1) = ( (C(3,2)+2.0*C(3,1))*C(4,2)*C(3,3) + + & C(3,2)**2*C(4,3) )/C(3,1) +C First slope already known + ELSE + C(4,1) = 1.0 + C(3,1) = 0.0 + ENDIF +C Forward pass of Gauss elimination + DO 20 M = 2, L + G = -C(3,M+1)/C(4,M-1) + C(2,M) = G*C(2,M-1) + 3.0*(C(3,M)*C(4,M+1)+C(3,M+1)*C(4,M)) + 20 C(4,M) = G*C(3,M-1) + 2.0*(C(3,M)+C(3,M+1)) + + IF(IBCEND.EQ.0) THEN + G = C(3,N-1) + C(3,N) + C(2,N) = ( (C(3,N)+2.0*G)*C(4,N)*C(3,N-1) + + & C(3,N)**2*(C(1,N-1)-C(1,N-2))/C(3,N-1) )/G + G = -G/C(4,N-1) + C(4,N) = (G+1.0)*C(3,N-1) + C(4,N) + C(2,N) = ( G*C(2,N-1) + C(2,N) )/C(4,N) + ENDIF +C Back substitution + DO 30 J = L,1,-1 + 30 C(2,J) = ( C(2,J) - C(3,J)*C(2,J+1) )/C(4,J) +C Computation of coefficients + DO 40 I = 2,N + DTAU = C(3,I) + DIVDF1 = (C(1,I)-C(1,I-1))/DTAU + DIVDF3 = C(2,I-1) + C(2,I) - 2.0*DIVDF1 + C(3,I-1) = ( DIVDF1 - C(2,I-1) - DIVDF3 ) / DTAU + 40 C(4,I-1) = DIVDF3/DTAU/DTAU +C + RETURN + END diff --git a/ISAJET/code/ssfel.F b/ISAJET/code/ssfel.F new file mode 100644 index 00000000000..d3d36748e51 --- /dev/null +++ b/ISAJET/code/ssfel.F @@ -0,0 +1,101 @@ +#include "isajet/pilot.h" + FUNCTION SSFEL(X,INIT) +C*********************************************************************** +C* Computes the electron spectrum as a convolution of the beam- and * +C* bremsstrahlung-spectra, including leading-log summation for the lat-* +C* ter (in one-loop order), and Chen's approximate expression for the * +C* former. X is the e energy in units of the nominal beam energy, and * +C* BETA is 2 alpha_em / pi (log s/me^2 - 1). If more than 99.5% of all * +C* electrons are in the delta-peak, beamstrahlung is ignored. Other- * +C* wise, beamstrahlung is included. In the latter case, the complete * +C* spectrum is computed at the first call (with INIT=1), and fitted in * +C* a cubic spline; in later calls (with INIT=0), only the spline is * +C* used. This reduces the necessary amount of CPU time considerably. * +C* This subroutine needs the programs BEAMEL, SIMAU8, and SPLINE. * +C*********************************************************************** +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/eepar.inc" +#include "isajet/brembm.inc" +C + REAL X,SSFEL + INTEGER INIT + REAL Y,XLMM,XL,GAM,RE,XKAPPA,NUCL,NUGAM,NGAM,DC, + $DX,TAU(100),C(4,100),XM,Z,RES,SSXINT,Y2,H,S,ESTRUC,Y1 + INTEGER I + SAVE DC,NGAM,C,TAU + EXTERNAL FBRBM +C + IF(INIT.NE.0) THEN +C Compute delta function contribution + Y=UPSLON + XLMM=SIGZ + XLMM = 2*SQRT(3.)*XLMM + XL = XLMM*1.E12/.197327 + GAM = EB/5.11E-4 + RE = 1./(137.*5.11E-4) + XKAPPA = 2./(3.*Y) + NUCL = 2.5*Y/(SQRT(3.)*137.**2*GAM*RE) + NUGAM = NUCL/SQRT(1.+Y**.6666666) + NGAM=.5*NUGAM*XL + DC = (1.-EXP(-NGAM))/NGAM + SSFEL=0. +C No initialization needed if >.995 included in delta peak + IF(DC.GT..995) RETURN + +C *** Computation of 'knots' *** + + DX = .05 + DO 100 I = 1, 19 + 100 TAU(I) = FLOAT(I-1)*DX + DO 110 I = 1, 9 + 110 TAU(19+I) = .9 + FLOAT(I)*1.E-2 + DO 120 I = 1, 5 + 120 TAU(28+I) = .99 + FLOAT(I)*1.E-3 + DO 121 I = 1, 12 + 121 TAU(33+I) = .995 + FLOAT(I)*2.5E-4 + DO 130 I = 1, 20 + 130 TAU(45+I) = .998 + FLOAT(I)*1.E-4 + +C *** Computation of corresponding y-values (electron densities) *** + + XM = TAU(65) + DO 140 I = 1,65 + Z = TAU(I) + XMIN = Z + RES=SSXINT(Z,FBRBM,XM) +140 C(1,I) = RES +DC*ESTRUC(Z,QSQBM) + +C *** Computation of derivative at zero *** + + Z = 1.E-5 + XMIN = Z + RES=SSXINT(Z,FBRBM,XM) + Y1 = RES + DC*ESTRUC(Z,QSQBM) + Z = 1.E-4 + XMIN = Z + RES=SSXINT(Z,FBRBM,XM) + Y2 = RES + DC*ESTRUC(Z,QSQBM) + C(1,2) = (Y2-Y1)/(1.E-4 - 1.E-5) +147 CALL SPLINE(TAU,C,65,1,0) + RETURN + ENDIF + IF(X.GT..999999) THEN + Z = .999999 + ELSE + Z = X + ENDIF + DC = (1.-EXP(-NGAM))/NGAM + IF(DC.GT..995) THEN + SSFEL = DC*ESTRUC(Z,QSQBM) + RETURN + ENDIF + + DO 2 I = 1, 64 + 2 IF(Z.LT.TAU(I+1)) GOTO 3 + 3 H = Z - TAU(I) + S = C(1,I) + H * ( C(2,I) + H*(C(3,I)+H*C(4,I)) ) + SSFEL = S + RETURN + END diff --git a/ISAJET/code/ssgst.F b/ISAJET/code/ssgst.F new file mode 100644 index 00000000000..76e71f56573 --- /dev/null +++ b/ISAJET/code/ssgst.F @@ -0,0 +1,34 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSGST(S,AMSQ,Z,I,J) +C----------------------------------------------------------------------- +C Function for Sig(qqbar->z_i + z_j +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" + REAL S,AMSQ,K,Z,MZI,MZJ,RS,TP,BT + INTEGER I,J,ITHI,ITHJ +C + MZI=ABS(AMZISS(I)) + MZJ=ABS(AMZISS(J)) + IF (AMZISS(I).LT.0.) THEN + ITHI=1 + ELSE + ITHI=0 + END IF + IF (AMZISS(J).LT.0.) THEN + ITHJ=1 + ELSE + ITHJ=0 + END IF + RS=SQRT(S) + K=SQRT(S*S+(MZI**2-MZJ**2)**2-2*S*(MZI**2+MZJ**2))/ + $ 2./RS + TP=S*S-(MZI**2-MZJ**2)**2-4*K*S**1.5*Z+4*K*K*S*Z*Z+ + $ 4*(-1.)**(ITHI+ITHJ+1)*MZI*MZJ*S + BT=(S-MZI**2-MZJ**2)/2.-RS*K*Z+AMSQ**2 + SSGST=TP/BT + RETURN + END diff --git a/ISAJET/code/ssgt.F b/ISAJET/code/ssgt.F new file mode 100644 index 00000000000..8d3f28a9223 --- /dev/null +++ b/ISAJET/code/ssgt.F @@ -0,0 +1,36 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSGT(S,AMSQ,Z,I,J) +C----------------------------------------------------------------------- +C Function for Sig(qqbar->z_i + z_j +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" + REAL S,AMSQ,K,Z,MZI,MZJ,RS,TPP,TPM,BTP,BTM + INTEGER I,J,ITHI,ITHJ +C + MZI=ABS(AMZISS(I)) + MZJ=ABS(AMZISS(J)) + IF (AMZISS(I).LT.0.) THEN + ITHI=1 + ELSE + ITHI=0 + END IF + IF (AMZISS(J).LT.0.) THEN + ITHJ=1 + ELSE + ITHJ=0 + END IF + RS=SQRT(S) + K=SQRT(S*S+(MZI**2-MZJ**2)**2-2*S*(MZI**2+MZJ**2))/ + $ 2./RS + TPP=S*S-(MZI**2-MZJ**2)**2-4*K*S**1.5*Z+4*K*K*S*Z*Z + TPM=S*S-(MZI**2-MZJ**2)**2+4*K*S**1.5*Z+4*K*K*S*Z*Z + BTP=(S-MZI**2-MZJ**2)/2.-RS*K*Z+AMSQ**2 + BTM=(S-MZI**2-MZJ**2)/2.+RS*K*Z+AMSQ**2 + SSGT=(TPP/BTP**2+TPM/BTM**2-8*(-1.)**(ITHI+ITHJ)* + $ MZI*MZJ*S/BTM/BTP)/16. + RETURN + END diff --git a/ISAJET/code/struc.F b/ISAJET/code/struc.F new file mode 100644 index 00000000000..0df95f8a6b7 --- /dev/null +++ b/ISAJET/code/struc.F @@ -0,0 +1,591 @@ +#include "isajet/pilot.h" + FUNCTION STRUC(X,QSQ,IQ,IH) + +C +C Compute structure functions X*F(X,QSQ) +C ISTRUC=1,2 obsolete +C ISTRUC=3 for Eichten, Hinchliffe, Lane, and Quigg (1984) +C solution 1 +C ISTRUC=4 Duke and Owens, Phys. Rev. D30, 49. +C solution 1 +C ISTRUC=5 CTEQ Collaboration, Phys. Lett. 304B, 159 +C fit CTEQ2L (lowest order QCD) +C ISTRUC=6 CTEQ Collaboration, Phys. Rev. D51, 4763 (1995) +C fit CTEQ3L (lowest order QCD) +C ISTRUC=-999 PDFLIB interface. Parameters are passed by call +C to PDFSET in READIN. +C Quark types-- +C IQ=1 2 3 4 5 6 7 8 9 10 11 12 13 +C GL UP UB DN DB ST SB CH CB BT BB TP TB +C Hadron types-- +C IH=+1120 -1120 +1220 -1220 +C P AP N AN +C +C For IBM compatibility require STRUC > SFMIN = 1.E-10 +C Ver. 7.23: Simplify type mapping and fix PDF error for pbar +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/qcdpar.inc" +C E1STRC contains all the coefficients for Eichten, etal, +C solution 1. It is equivalenced to arrays for the 16 sets of +C coefficients. + DIMENSION E1STRC(6,6,16),E1POW(8),IE1FIT(13) + DIMENSION E1UPHI(6,6),E1DNHI(6,6),E1UBHI(6,6),E1GLHI(6,6), + $E1STHI(6,6),E1CHHI(6,6),E1BTHI(6,6),E1TPHI(6,6) + DIMENSION E1UPLO(6,6),E1DNLO(6,6),E1UBLO(6,6),E1GLLO(6,6), + $E1STLO(6,6),E1CHLO(6,6),E1BTLO(6,6),E1TPLO(6,6) + EQUIVALENCE (E1UPHI(1,1),E1STRC(1,1,1)) + EQUIVALENCE (E1DNHI(1,1),E1STRC(1,1,2)) + EQUIVALENCE (E1UBHI(1,1),E1STRC(1,1,3)) + EQUIVALENCE (E1GLHI(1,1),E1STRC(1,1,4)) + EQUIVALENCE (E1STHI(1,1),E1STRC(1,1,5)) + EQUIVALENCE (E1CHHI(1,1),E1STRC(1,1,6)) + EQUIVALENCE (E1BTHI(1,1),E1STRC(1,1,7)) + EQUIVALENCE (E1TPHI(1,1),E1STRC(1,1,8)) + EQUIVALENCE (E1UPLO(1,1),E1STRC(1,1,9)) + EQUIVALENCE (E1DNLO(1,1),E1STRC(1,1,10)) + EQUIVALENCE (E1UBLO(1,1),E1STRC(1,1,11)) + EQUIVALENCE (E1GLLO(1,1),E1STRC(1,1,12)) + EQUIVALENCE (E1STLO(1,1),E1STRC(1,1,13)) + EQUIVALENCE (E1CHLO(1,1),E1STRC(1,1,14)) + EQUIVALENCE (E1BTLO(1,1),E1STRC(1,1,15)) + EQUIVALENCE (E1TPLO(1,1),E1STRC(1,1,16)) + DIMENSION CHEBX(6),CHEBQ(6) +C + REAL X,QSQ,STRUC + REAL BETA,CHEB1,CHEB2,CHEB3,CHEB4,CHEB5,AMASS,E1POW,FD,CHEBX, + $E1STRC,E1UPHI,CHEBQ,AD,ETA3,GUD,ETA2,ETA4,FUD,AUD,GD,E1GLLO, + $E1UBLO,E1DNLO,E1STLO,E1TPLO,E1BTLO,E1CHLO,E1UPLO,E1GLHI,E1UBHI, + $E1DNHI,E1STHI,E1TPHI,E1BTHI,ETA1,T,TMAX,TMIN,AMQ,Q2MIN,W2,W1, + $SFMIN,T1,A1,A0,SS,B1,C2,B2,A2,S,X1,TERM,E1CHHI,Q2,GAMMA + INTEGER IQ,IH + INTEGER IE1FIT,IFIT,IFIT2,JX,JQ,ISHFT,IIQ +C CTEQ declarations + REAL A3,A4,A5,SBL,QI,Q,SB,SB2,SB3 + INTEGER IFL + INTEGER IQPB(13),IQN(13),IQNB(13) +#if defined(CERNLIB_SINGLE) + REAL SEA,VAL,P012,P34,P5 +#endif +#if defined(CERNLIB_DOUBLE) + DOUBLE PRECISION SEA,VAL,P012,P34,P5 +#endif +C PDFLIB declarations +#if (defined(CERNLIB_PDFLIB))&&(defined(CERNLIB_SINGLE)) + REAL DX,DSCALE,DXPDF(-6:6) +#endif +#if (defined(CERNLIB_PDFLIB))&&(defined(CERNLIB_DOUBLE)) + DOUBLE PRECISION DX,DSCALE,DXPDF(-6:6) +#endif +#if defined(CERNLIB_PDFLIB) + INTEGER IQMAP(13) + DATA IQMAP/0,2,-2,1,-1,3,-3,4,-4,5,-5,6,-6/ +#endif +C +C Map pbar, n, nbar types to p type + DATA IQPB/1,3,2,5,4,7,6,9,8,11,10,13,12/ + DATA IQN /1,4,5,2,3,6,7,8,9,10,11,12,13/ + DATA IQNB/1,5,4,3,2,7,6,9,8,11,10,13,12/ +C +C Eichten etal solution 1 constants +C corrected coefficients from Ian Hinchliffe, 3 June 1986. + DATA E1UPHI/ + $ 0.76772, -0.20874, -0.33026, -0.02517, -0.01570, -0.00010, + $ -0.53259, -0.26612, 0.32007, 0.11918, 0.02434, 0.00762, + $ 0.21618, 0.18812, -0.08375, -0.06515, -0.01743, -0.00504, + $ -0.09211, -0.09952, 0.01373, 0.02506, 0.00877, 0.00255, + $ 0.03670, 0.04409, 0.00096, -0.00796, -0.00342, -0.00105, + $ -0.01549, -0.02026, -0.00306, 0.00222, 0.00124, 0.00041/ + DATA E1DNHI/ + $ 0.38130, -0.08090, -0.16336, -0.02185, -0.00843, -0.00062, + $ -0.29475, -0.14348, 0.16650, 0.06638, 0.01473, 0.00408, + $ 0.12518, 0.10422, -0.04722, -0.03683, -0.01038, -0.00286, + $ -0.05478, -0.05678, 0.00890, 0.01484, 0.00534, 0.00152, + $ 0.02220, 0.02567, -0.00003, -0.00497, -0.00216, -0.00065, + $ -0.00953, -0.01204, -0.00151, 0.00151, 0.00083, 0.00027/ + DATA E1UBHI/ + $ 0.06870, -0.06861, 0.02973, -0.00540, 0.00378, -0.00097, + $ -0.01802, 0.00014, 0.00649, -0.00854, 0.00122, -0.00175, + $ -0.00465, 0.00148, -0.00593, 0.00060, -0.00103, -0.00008, + $ 0.00644, 0.00257, 0.00283, 0.00115, 0.00071, 0.00033, + $ -0.00393, -0.00254, -0.00116, -0.00077, -0.00036, -0.00019, + $ 0.00234, 0.00193, 0.00053, 0.00037, 0.00016, 0.00009/ + DATA E1GLHI/ + $ 0.94819, -0.95779, 0.10085, -0.10510, 0.03456, -0.03054, + $ -0.96265, 0.53790, 0.33684, -0.09525, 0.01488, -0.02051, + $ 0.43004, -0.08306, -0.33719, 0.04902, -0.00916, 0.01041, + $ -0.19249, -0.01790, 0.21830, 0.00749, 0.00414, -0.00186, + $ 0.08183, 0.01926, -0.10718, -0.01944, -0.00277, -0.00052, + $ -0.03884, -0.01234, 0.05410, 0.01879, 0.00335, 0.00104/ + DATA E1STHI/ + $ 0.04968, -0.04173, 0.02102, -0.00327, 0.00324, -0.00067, + $ -0.00615, -0.01294, 0.00674, -0.00689, 0.00090, -0.00151, + $ -0.00858, 0.00505, -0.00490, -0.00016, -0.00094, -0.00015, + $ 0.00784, 0.00151, 0.00222, 0.00140, 0.00070, 0.00035, + $ -0.00441, -0.00222, -0.00089, -0.00085, -0.00036, -0.00020, + $ 0.00252, 0.00184, 0.00041, 0.00039, 0.00016, 0.00009/ + DATA E1CHHI/ + $ 0.00927, -0.01817, 0.00959, -0.00639, 0.00169, -0.00154, + $ 0.00571, -0.01188, 0.00609, -0.00465, 0.00124, -0.00131, + $ -0.00396, 0.00710, -0.00359, 0.00184, -0.00039, 0.00034, + $ 0.00112, -0.00196, 0.00112, -0.00048, 0.00010, -0.00004, + $ 0.00004, -0.00003, -0.00018, 0.00009, -0.00005, -0.00002, + $ -0.00042, 0.00073, -0.00016, 0.00005, 0.00005, 0.00005/ + DATA E1BTHI/ + $ 0.00901, -0.01401, 0.00715, -0.00413, 0.00126, -0.00104, + $ 0.00628, -0.00932, 0.00478, -0.00289, 0.00091, -0.00082, + $ -0.00293, 0.00409, -0.00189, 0.00076, -0.00023, 0.00014, + $ 0.00039, -0.00120, 0.00044, -0.00025, 0.00002, -0.00002, + $ 0.00026, 0.00014, -0.00008, 0.00010, 0.00001, 0.00001, + $ -0.00026, 0.00032, 0.00001, -0.00001, 0.00001, -0.00001/ + DATA E1TPHI/ + $ 0.00441, -0.00748, 0.00377, -0.00258, 0.00073, -0.00071, + $ 0.00384, -0.00605, 0.00303, -0.00203, 0.00058, -0.00059, + $ -0.00088, 0.00166, -0.00075, 0.00047, -0.00010, 0.00010, + $ -0.00008, -0.00015, 0.00012, -0.00009, 0.00003, 0.00000, + $ 0.00013, -0.00022, -0.00002, -0.00002, -0.00002, -0.00002, + $ -0.00007, 0.00019, -0.00004, 0.00002, 0.00000, 0.00000/ + DATA E1UPLO/ + $ 0.23946, 0.29055, 0.09778, 0.02149, 0.00344, 0.00050, + $ 0.01751, -0.00609, -0.02687, -0.01916, -0.00797, -0.00275, + $ -0.00576, -0.00504, 0.00108, 0.00249, 0.00153, 0.00075, + $ 0.00174, 0.00196, 0.00030, -0.00034, -0.00029, -0.00018, + $ -0.00053, -0.00064, -0.00017, 0.00004, 0.00006, 0.00004, + $ 0.00017, 0.00022, 0.00008, 0.00001, -0.00001, -0.00001/ + DATA E1DNLO/ + $ 0.12613, 0.13542, 0.03958, 0.00824, 0.00166, 0.00045, + $ 0.00389, -0.01159, -0.01625, -0.00961, -0.00371, -0.00126, + $ -0.00191, -0.00056, 0.00159, 0.00159, 0.00084, 0.00039, + $ 0.00064, 0.00049, -0.00015, -0.00029, -0.00018, -0.00010, + $ -0.00020, -0.00019, 0.00000, 0.00006, 0.00004, 0.00003, + $ 0.00007, 0.00008, 0.00002, -0.00001, -0.00001, -0.00001/ + DATA E1UBLO/ + $ 1.01386, -1.10585, 0.33739, -0.07444, 0.00885, -0.00087, + $ 0.92334, -1.28541, 0.44755, -0.09786, 0.01419, -0.00112, + $ 0.04888, -0.12708, 0.08606, -0.02608, 0.00478, -0.00060, + $ -0.02691, 0.04887, -0.01771, 0.00162, 0.00025, -0.00006, + $ 0.00704, -0.01113, 0.00159, 0.00070, -0.00020, 0.00000, + $ -0.00171, 0.00229, 0.00038, -0.00035, 0.00004, 0.00001/ + DATA E1GLLO/ + $ 29.47734,-39.02468, 14.63570, -3.33516, 0.50538, -0.05915, + $ 25.58960,-39.54527, 16.61420, -4.29861, 0.69036, -0.08243, + $ -1.66291, 1.17624, 1.11844, -0.70986, 0.19481, -0.02404, + $ -0.21679, 0.81705, -0.71688, 0.18507, -0.01924, -0.00325, + $ 0.20880, -0.43547, 0.22391, -0.02446, -0.00362, 0.00191, + $ -0.09097, 0.16009, -0.05681, -0.00250, 0.00258, -0.00047/ + DATA E1STLO/ + $ 0.92351, -1.08483, 0.34642, -0.07210, 0.00914, -0.00091, + $ 0.93146, -1.27376, 0.45122, -0.09775, 0.01380, -0.00131, + $ 0.04739, -0.12960, 0.08482, -0.02642, 0.00476, -0.00057, + $ -0.02653, 0.04953, -0.01735, 0.00175, 0.00028, -0.00006, + $ 0.00694, -0.01132, 0.00148, 0.00065, -0.00021, 0.00000, + $ -0.00168, 0.00234, 0.00042, -0.00034, 0.00005, 0.00001/ + DATA E1CHLO/ + $ 0.80983, -1.04168, 0.33980, -0.06824, 0.00876, -0.00090, + $ 0.89606, -1.21708, 0.43386, -0.09287, 0.01304, -0.00129, + $ 0.03058, -0.10402, 0.07604, -0.02415, 0.00460, -0.00050, + $ -0.02451, 0.04432, -0.01651, 0.00143, 0.00012, -0.00010, + $ 0.01122, -0.01457, 0.00268, 0.00058, -0.00012, 0.00003, + $ -0.00773, 0.00733, -0.00076, -0.00024, 0.00001, 0.00000/ + DATA E1BTLO/ + $ 0.80288, -1.07532, 0.37920, -0.07843, 0.01007, -0.00109, + $ 0.79033, -1.09887, 0.41532, -0.09301, 0.01317, -0.00141, + $ -0.01704, -0.01130, 0.02882, -0.01341, 0.00304, -0.00036, + $ -0.00072, 0.00723, -0.00516, 0.00108, -0.00005, -0.00004, + $ 0.00305, -0.00461, 0.00166, -0.00013, -0.00001, 0.00001, + $ -0.00436, 0.00523, -0.00161, 0.00020, -0.00002, 0.00000/ + DATA E1TPLO/ + $ 0.66233, -0.92481, 0.35193, -0.07930, 0.01110, -0.00118, + $ 0.63797, -0.90619, 0.35816, -0.08479, 0.01265, -0.00139, + $ -0.02581, 0.02125, 0.00419, -0.00498, 0.00149, -0.00021, + $ 0.00071, 0.00053, -0.00127, 0.00039, -0.00005, -0.00001, + $ 0.00385, -0.00506, 0.00186, -0.00035, 0.00004, 0.00000, + $ -0.00353, 0.00446, -0.00150, 0.00027, -0.00003, 0.00000/ +C E1POW gives powers of (1-x). +C IE1FIT points to fit for each value of IQ. + DATA E1POW/3.,4.,7.,5.,7.,7.,7.,7./ + DATA IE1FIT/4,1,3,2,3,5,5,6,6,7,7,8,8/ +C Minimum value for STRUC + DATA SFMIN/1.E-10/ +C +C + BETA(W1,W2)=GAMMA(W1)*GAMMA(W2)/GAMMA(W1+W2) +C Chebyshev polynomials + CHEB1(X)=X + CHEB2(X)=2.*X**2-1. + CHEB3(X)=X*(-3.+4.*X**2) + CHEB4(X)=1.+X**2*(-8.+8.*X**2) + CHEB5(X)=X*(5.+X**2*(-20.+16.*X**2)) +C +C Entry -- check for unphysical X +C + IF(X.LE.0..OR.X.GE..9999) THEN + STRUC=0. + GO TO 9999 + ENDIF +C +C Determine equivalent quark type IIQ for proton +C + IF(IH.EQ.1120) THEN + IIQ=IQ + ELSEIF(IH.EQ.-1120) THEN + IIQ=IQPB(IQ) + ELSEIF(IH.EQ.1220) THEN + IIQ=IQN(IQ) + ELSEIF(IH.EQ.-1220) THEN + IIQ=IQNB(IQ) + ELSE +C This should never happen + STRUC=0 + RETURN + ENDIF +C +C Select structure function fit. +C + IF(ISTRUC.EQ.3) GO TO 1000 + IF(ISTRUC.EQ.4) GO TO 2000 + IF(ISTRUC.EQ.5) GO TO 3000 + IF(ISTRUC.EQ.6) GO TO 3100 +#if defined(CERNLIB_PDFLIB) + IF(ISTRUC.EQ.-999) GO TO 9000 +#endif + STRUC=0. + GO TO 9999 +C +C Calculate Eichten etal structure fcn for type IIQ +C +1000 STRUC=0. + Q2=QSQ + IF(Q2.LT.5.) Q2=5. + T=ALOG(Q2/ALAM2) + TMAX=ALOG(1.E8/ALAM2) + IF(IIQ.GT.9) GO TO 1001 + Q2MIN=5. + GO TO 1002 +1001 AMQ=AMASS(IIQ/2) + Q2MIN=4.*AMQ**2/(1.-X) + IF(Q2.LT.Q2MIN) GO TO 9999 +1002 TMIN=ALOG(Q2MIN/ALAM2) + T1=(2.*T-(TMAX+TMIN))/(TMAX-TMIN) + CHEBQ(1)=1. + CHEBQ(2)=CHEB1(T1) + CHEBQ(3)=CHEB2(T1) + CHEBQ(4)=CHEB3(T1) + CHEBQ(5)=CHEB4(T1) + CHEBQ(6)=CHEB5(T1) +C x.gt.0.1 + IF(X.LT.0.1) GO TO 1010 + X1=(2.*X-1.1)/.9 + ISHFT=0 + GO TO 1020 +C x.lt.0.1 +1010 X1=(2.*ALOG(X)+11.51293)/6.90776 + ISHFT=8 +C IFIT is pointer for Eichten quark type. +C IFIT2 is pointer for function -- shifted by 8 for x<0.1 +1020 IFIT=IE1FIT(IIQ) + IFIT2=IFIT+ISHFT + CHEBX(1)=1. + CHEBX(2)=CHEB1(X1) + CHEBX(3)=CHEB2(X1) + CHEBX(4)=CHEB3(X1) + CHEBX(5)=CHEB4(X1) + CHEBX(6)=CHEB5(X1) + TERM=0. + DO 1030 JQ=1,6 + DO 1030 JX=1,6 +1030 TERM=TERM+E1STRC(JX,JQ,IFIT2)*CHEBQ(JQ)*CHEBX(JX) + TERM=TERM*(1.-X)**E1POW(IFIT) + STRUC=ABS(TERM) + IF(IFIT.GT.2) GO TO 9999 +C Add sea term for valence quarks + TERM=0. + DO 1040 JQ=1,6 + DO 1040 JX=1,6 +1040 TERM=TERM+E1STRC(JX,JQ,3+ISHFT)*CHEBQ(JQ)*CHEBX(JX) + TERM=TERM*(1.-X)**E1POW(3) + STRUC=STRUC+ABS(TERM) + GO TO 9999 +C +C Calculate Duke-Owens structure function for type IIQ. +C +2000 STRUC=0. + Q2=QSQ + IF(Q2.LT.4.) Q2=4. + S=ALOG(ALOG(Q2/ALAM2)/ALOG(4./ALAM2)) + SS=S*S +C x*f(x) for gl + IF(IIQ.EQ.1) THEN + A0=1.56-1.71*S+.638*SS + A1=-0.949*S+.325*SS + B1=6.+1.44*S-1.05*SS + A2=9.-7.19*S+.255*SS + B2=-16.5*S+10.9*SS + C2=15.3*S-10.1*SS + STRUC=A0*X**A1*(1.-X)**B1*(1.+A2*X+B2*X**2+C2*X**3) +C x*f(x) for up,ub,dn,db,st,sb + ELSEIF(IIQ.LE.7) THEN + A0=1.265-1.132*S+.293*SS + A1=-.372*S-.029*SS + B1=8.05+1.59*S-.153*SS + A2=6.31*S-.273*SS + B2=-10.5*S-3.17*SS + C2=14.7*S+9.80*SS + STRUC=A0*X**A1*(1.-X)**B1*(1.+A2*X+B2*X**2+C2*X**3)/6. + IF(IIQ.EQ.2.OR.IIQ.EQ.4) THEN + ETA1=.419+.004*S-.007*SS + ETA2=3.46+.724*S-.066*SS + GUD=4.40-4.86*S+1.33*SS + ETA3=.763-.237*S+.026*SS + ETA4=4.00+.627*S-.019*SS + GD=-.421*S+.033*SS + AUD=3./(BETA(ETA1,ETA2+1.)*(1.+GUD*ETA1/(ETA1+ETA2+1.))) + FUD=AUD*X**ETA1*(1.-X)**ETA2*(1.+GUD*X) + AD=1./(BETA(ETA3,ETA4+1.)*(1.+GD*ETA3/(ETA3+ETA4+1.))) + FD=AD*X**ETA3*(1.-X)**ETA4*(1.+GD*X) + IF(IIQ.EQ.2) STRUC=STRUC+FUD-FD + IF(IIQ.EQ.4) STRUC=STRUC+FD + ENDIF +C x*f(x) for ch,cb + ELSEIF(IIQ.LE.9) THEN + A0=.135*S-.0075*SS + A1=-.036-.222*S-.058*SS + B1=6.35+3.26*S-.909*SS + A2=-3.03*S+1.50*SS + B2=17.4*S-11.3*SS + C2=-17.9*S+15.6*SS + STRUC=A0*X**A1*(1.-X)**B1*(1.+A2*X+B2*X**2+C2*X**3) +C x*f(x)=0 for bt,bb,tp,tb + ELSE + STRUC=0. + ENDIF + GO TO 9999 +C +C Calculate CTEQ2L distribution for type IIQ +C +3000 STRUC=0 + IFL=IIQ/2 +C Set up thresholds + Q=SQRT(QSQ) + IF(IFL.LE.4) THEN + QI=1.6 + ELSEIF(IFL.EQ.5) THEN + QI=5.0 + ELSEIF(IFL.EQ.6) THEN + QI=180 + ELSE + RETURN + ENDIF + IF(Q.LT.QI) THEN + Q=QI + IF(IFL.GE.4) GO TO 9999 + ENDIF +C Hard code lambda=0.190 + SBL=LOG(Q/0.190)/LOG(QI/0.190) + SB=LOG (SBL) + SB2=SB*SB + SB3=SB2*SB +C Calculate sea part + IF(IFL.EQ.0) THEN + A0=EXP(-0.6510E+00-0.1128E+01*SB-0.6239E-01*SB2-0.8838E-01*SB3) + A1=-0.2590E+00+0.1822E+00*SB-0.2682E+00*SB2+0.9422E-01*SB3 + A2= 0.4607E+01+0.7792E+00*SB+0.8937E+00*SB2-0.5553E+00*SB3 + A3= 0.1627E+02-0.1114E+02*SB+0.4928E+01*SB2-0.1715E+01*SB3 + A4= 0.1236E+01+0.1945E+00*SB-0.3297E+00*SB2+0.6489E-01*SB3 + A5= 0.0000E+00+0.3346E+01*SB-0.2337E+01*SB2+0.7850E+00*SB3 + ELSEIF(IFL.EQ.1) THEN + A0=EXP(-0.1508E+01-0.5560E+00*SB-0.3523E+00*SB2+0.6562E-01*SB3) + A1=-0.3223E+00+0.2095E-01*SB-0.2049E-02*SB2-0.3475E-01*SB3 + A2= 0.9469E+01-0.3923E+01*SB+0.4333E+01*SB2-0.1654E+01*SB3 + A3= 0.1646E+02-0.1082E+02*SB+0.8941E+01*SB2-0.5494E+01*SB3 + A4= 0.2908E+01+0.2162E+01*SB-0.3233E+01*SB2+0.1267E+01*SB3 + A5=-0.5819E+00+0.3914E+00*SB+0.6460E+00*SB2-0.3239E+00*SB3 + ELSEIF(IFL.EQ.2) THEN + A0=EXP(-0.1951E+01-0.3435E+01*SB+0.3424E+01*SB2-0.1249E+01*SB3) + A1=-0.2942E+00+0.4408E+00*SB-0.5453E+00*SB2+0.1552E+00*SB3 + A2= 0.9782E+01-0.3454E+01*SB+0.4510E+01*SB2-0.1649E+01*SB3 + A3= 0.4999E+02-0.1993E+02*SB-0.2039E+01*SB2+0.5694E+00*SB3 + A4= 0.1938E+01-0.1351E+01*SB+0.1386E+01*SB2-0.5324E+00*SB3 + A5=-0.2410E+00+0.3434E+01*SB-0.3334E+01*SB2+0.1067E+01*SB3 + ELSEIF(IFL.EQ.3) THEN + A0=EXP(-0.1804E+01-0.4381E+01*SB-0.3699E+00*SB2+0.3878E+00*SB3) + A1=-0.1000E-02-0.9334E+00*SB+0.7156E+00*SB2-0.2029E+00*SB3 + A2= 0.6896E+01+0.2462E+01*SB-0.2885E+01*SB2+0.8701E+00*SB3 + A3= 0.0000E+00+0.5589E+01*SB+0.1047E+02*SB2+0.3000E+02*SB3 + A4= 0.1000E-02-0.5600E-02*SB+0.5618E-02*SB2+0.6598E-02*SB3 + A5= 0.0000E+00-0.3151E+01*SB+0.4025E+01*SB2-0.1232E+01*SB3 + ELSEIF(IFL.EQ.4) THEN + A0=SB**0.7860E+00*EXP(-0.5041E+01-0.3357E+00*SB-0.4718E+00*SB2) + A1=-0.4989E+00+0.9571E+00*SB-0.1359E+01*SB2+0.5384E+00*SB3 + A2= 0.5986E+01-0.8541E+01*SB+0.1274E+02*SB2-0.5275E+01*SB3 + A3= 0.8121E+01-0.1753E+02*SB+0.2194E+02*SB2-0.8538E+01*SB3 + A4= 0.9290E-01-0.4390E+00*SB+0.6162E+00*SB2-0.2231E+00*SB3 + A5=-0.1257E+01+0.5677E+01*SB-0.5977E+01*SB2+0.2387E+01*SB3 + ELSEIF(IFL.EQ.5) THEN + A0=SB**0.4537E+00*EXP(-0.3269E+01-0.5398E+01*SB+0.2893E+01*SB2) + A1=-0.1977E+00-0.4126E+00*SB+0.7058E+00*SB2-0.4038E+00*SB3 + A2= 0.4522E+01+0.6167E-01*SB-0.1849E+00*SB2+0.7345E+00*SB3 + A3=-0.1003E+01+0.1531E+01*SB+0.4515E+01*SB2-0.4368E+01*SB3 + A4= 0.3579E-01+0.1919E+00*SB-0.7268E+00*SB2+0.5192E+00*SB3 + A5= 0.5129E+00+0.2447E+01*SB-0.1989E+01*SB2+0.7529E+00*SB3 + ELSEIF(IFL.EQ.6) THEN + A0=SB**0.7178E+00*EXP(-0.7327E+01+0.2277E+01*SB+0.3913E+01*SB2) + A1=-0.9842E-01-0.2362E+01*SB+0.8851E+01*SB2-0.7208E+01*SB3 + A2= 0.5552E+01-0.8935E+01*SB+0.2676E+02*SB2-0.1344E+02*SB3 + A3= 0.1593E+01-0.3505E+01*SB-0.1234E+01*SB2-0.1867E+02*SB3 + A4=-0.1723E+00+0.1530E+01*SB+0.2323E+01*SB2-0.9344E+01*SB3 + A5= 0.2081E+01+0.1939E+01*SB-0.3273E+01*SB2+0.9935E+01*SB3 + ENDIF + P012=A0*(X**A1)*((1.-X)**A2) + P34=(1.+A3*(X**A4)) + P5=(LOG(1.+1./X))**A5 + SEA=P012*P34*P5 +C Add valence part + IF(IIQ.NE.2.AND.IIQ.NE.4) THEN + STRUC=SEA + GO TO 9999 + ELSEIF(IIQ.EQ.2) THEN + A0=EXP(-0.1806E+01-0.6672E-01*SB-0.2605E+00*SB2+0.2341E-01*SB3) + A1= 0.1750E+00+0.3872E-01*SB-0.2189E-01*SB2+0.1415E-01*SB3 + A2= 0.3322E+01+0.7786E+00*SB-0.2902E+00*SB2+0.1517E+00*SB3 + A3= 0.4414E+02-0.1987E+02*SB+0.2597E+01*SB2+0.2670E+01*SB3 + A4= 0.9610E+00-0.2864E+00*SB-0.5524E-01*SB2+0.6229E-01*SB3 + A5= 0.0000E+00+0.2658E+00*SB-0.4728E-02*SB2+0.6048E-01*SB3 + ELSEIF(IIQ.EQ.4) THEN + A0=EXP( 0.8000E-01+0.7364E+00*SB-0.2714E+01*SB2+0.1311E+01*SB3) + A1= 0.4930E+00-0.2001E+00*SB+0.5784E+00*SB2-0.2915E+00*SB3 + A2= 0.3001E+01+0.3538E+01*SB-0.6155E+01*SB2+0.3083E+01*SB3 + A3=-0.1000E+01+0.3871E+01*SB-0.8334E+01*SB2+0.4219E+01*SB3 + A4= 0.2986E+01+0.1597E+01*SB-0.3368E+01*SB2+0.1644E+01*SB3 + A5= 0.0000E+00-0.9256E+00*SB+0.3570E+01*SB2-0.1777E+01*SB3 + ENDIF + P012=A0*(X**A1)*((1.-X)**A2) + P34=(1.+A3*(X**A4)) + P5=(LOG(1.+1./X))**A5 + VAL=P012*P34*P5 + STRUC=VAL+SEA + GO TO 9999 +C +C Calculate CTEQ3L distribution for type IIQ +C +3100 STRUC=0 + IFL=IIQ/2 +C Set up thresholds + Q=SQRT(QSQ) + IF(IFL.LE.4) THEN + QI=1.6 + ELSEIF(IFL.EQ.5) THEN + QI=5.0 + ELSEIF(IFL.EQ.6) THEN + QI=180 + ELSE + RETURN + ENDIF + IF(Q.LT.QI) THEN + Q=QI + IF(IFL.GE.4) GO TO 9999 + ENDIF +C Hard code lambda=0.177 + SBL=LOG(Q/0.177)/LOG(QI/0.177) + SB=LOG (SBL) + SB2=SB*SB + SB3=SB2*SB +C Calculate sea part + IF(IFL.EQ.0) THEN + A0=Exp(-0.7631E+00-0.7241E+00*SB -0.1170E+01*SB2+0.5343E+00*SB3) + A1=-0.3573E+00+0.3469E+00*SB -0.3396E+00*SB2+0.9188E-01*SB3 + A2= 0.5604E+01+0.7458E+00*SB -0.5082E+00*SB2+0.1844E+00*SB3 + A3= 0.1549E+02-0.1809E+02*SB +0.1162E+02*SB2-0.3483E+01*SB3 + A4= 0.9881E+00+0.1364E+00*SB -0.4421E+00*SB2+0.2051E+00*SB3 + A5=-0.9505E-01+0.3259E+01*SB -0.1547E+01*SB2+0.2918E+00*SB3 + ELSEIF(IFL.EQ.1) THEN + A0=Exp(-0.2740E+01-0.7987E-01*SB -0.9015E+00*SB2-0.9872E-01*SB3) + A1=-0.3909E+00+0.1244E+00*SB -0.4487E-01*SB2+0.1277E-01*SB3 + A2= 0.9163E+01+0.2823E+00*SB -0.7720E+00*SB2-0.9360E-02*SB3 + A3= 0.1080E+02-0.3915E+01*SB -0.1153E+01*SB2+0.2649E+01*SB3 + A4= 0.9894E+00-0.1647E+00*SB -0.9426E-02*SB2+0.2945E-02*SB3 + A5=-0.3395E+00+0.6998E+00*SB +0.7000E+00*SB2-0.6730E-01*SB3 + ELSEIF(IFL.EQ.2) THEN + A0=Exp(-0.2449E+01-0.3513E+01*SB +0.4529E+01*SB2-0.2031E+01*SB3) + A1=-0.4050E+00+0.3411E+00*SB -0.3669E+00*SB2+0.1109E+00*SB3 + A2= 0.7470E+01-0.2982E+01*SB +0.5503E+01*SB2-0.2419E+01*SB3 + A3= 0.1503E+02+0.1638E+01*SB -0.8772E+01*SB2+0.3852E+01*SB3 + A4= 0.1137E+01-0.1006E+01*SB +0.1485E+01*SB2-0.6389E+00*SB3 + A5=-0.5299E+00+0.3160E+01*SB -0.3104E+01*SB2+0.1219E+01*SB3 + ELSEIF(IFL.EQ.3) THEN + A0=Exp(-0.3640E+01+0.1250E+01*SB -0.2914E+01*SB2+0.8390E+00*SB3) + A1=-0.3595E+00-0.5259E-01*SB +0.3122E+00*SB2-0.1642E+00*SB3 + A2= 0.7305E+01+0.9727E+00*SB -0.9788E+00*SB2-0.5193E-01*SB3 + A3= 0.1198E+02-0.1799E+02*SB +0.2614E+02*SB2-0.1091E+02*SB3 + A4= 0.9882E+00-0.6101E+00*SB +0.9737E+00*SB2-0.4935E+00*SB3 + A5=-0.1186E+00-0.3231E+00*SB +0.3074E+01*SB2-0.1274E+01*SB3 + ELSEIF(IFL.EQ.4) THEN + A0=SB**0.1122E+01*Exp(-0.3718E+01-0.1335E+01*SB +0.1651E-01*SB2) + A1=-0.4719E+00+0.7509E+00*SB -0.8420E+00*SB2+0.2901E+00*SB3 + A2= 0.6194E+01-0.1641E+01*SB +0.4907E+01*SB2-0.2523E+01*SB3 + A3= 0.4426E+01-0.4270E+01*SB +0.6581E+01*SB2-0.3474E+01*SB3 + A4= 0.2683E+00+0.9876E+00*SB -0.7612E+00*SB2+0.1780E+00*SB3 + A5=-0.4547E+00+0.4410E+01*SB -0.3712E+01*SB2+0.1245E+01*SB3 + ELSEIF(IFL.EQ.5) THEN + A0=SB**0.9838E+00*Exp(-0.2548E+01-0.7660E+01*SB +0.3702E+01*SB2) + A1=-0.3122E+00-0.2120E+00*SB +0.5716E+00*SB2-0.3773E+00*SB3 + A2= 0.6257E+01-0.8214E-01*SB -0.2537E+01*SB2+0.2981E+01*SB3 + A3=-0.6723E+00+0.2131E+01*SB +0.9599E+01*SB2-0.7910E+01*SB3 + A4= 0.9169E-01+0.4295E-01*SB -0.5017E+00*SB2+0.3811E+00*SB3 + A5= 0.2402E+00+0.2656E+01*SB -0.1586E+01*SB2+0.2880E+00*SB3 + ELSEIF(IFL.EQ.6) THEN + A0=SB**0.1001E+01*Exp(-0.6934E+01+0.3050E+01*SB -0.6943E+00*SB2) + A1=-0.1713E+00-0.5167E+00*SB +0.1241E+01*SB2-0.1703E+01*SB3 + A2= 0.6169E+01+0.3023E+01*SB -0.1972E+02*SB2+0.1069E+02*SB3 + A3= 0.4439E+01-0.1746E+02*SB +0.1225E+02*SB2+0.8350E+00*SB3 + A4= 0.5458E+00-0.4586E+00*SB +0.9089E+00*SB2-0.4049E+00*SB3 + A5= 0.3207E+01-0.3362E+01*SB +0.5877E+01*SB2-0.7659E+01*SB3 + ENDIF + P012=A0*(X**A1)*((1.-X)**A2) + P34=(1.+A3*(X**A4)) + P5=(LOG(1.+1./X))**A5 + SEA=P012*P34*P5 +C Add valence part + IF(IIQ.NE.2.AND.IIQ.NE.4) THEN + STRUC=SEA + GO TO 9999 + ELSEIF(IIQ.EQ.2) THEN + A0=Exp( 0.1907E+00+0.4205E-01*SB +0.2752E+00*SB2-0.3171E+00*SB3) + A1= 0.4611E+00+0.2331E-01*SB -0.3403E-01*SB2+0.3174E-01*SB3 + A2= 0.3504E+01+0.5739E+00*SB +0.2676E+00*SB2-0.1553E+00*SB3 + A3= 0.7452E+01-0.6742E+01*SB +0.2849E+01*SB2-0.1964E+00*SB3 + A4= 0.1116E+01-0.3435E+00*SB +0.2865E+00*SB2-0.1288E+00*SB3 + A5= 0.6659E-01+0.2714E+00*SB -0.2688E+00*SB2+0.2763E+00*SB3 + ELSEIF(IIQ.EQ.4) THEN + A0=Exp( 0.1141E+00+0.4764E+00*SB -0.1745E+01*SB2+0.7728E+00*SB3) + A1= 0.4275E+00-0.1290E+00*SB +0.3609E+00*SB2-0.1689E+00*SB3 + A2= 0.3000E+01+0.2946E+01*SB -0.4117E+01*SB2+0.1989E+01*SB3 + A3=-0.1302E+01+0.2322E+01*SB -0.4258E+01*SB2+0.2109E+01*SB3 + A4= 0.2586E+01-0.1920E+00*SB -0.3754E+00*SB2+0.2731E+00*SB3 + A5=-0.2251E+00-0.5374E+00*SB +0.2245E+01*SB2-0.1034E+01*SB3 + ENDIF + P012=A0*(X**A1)*((1.-X)**A2) + P34=(1.+A3*(X**A4)) + P5=(LOG(1.+1./X))**A5 + VAL=P012*P34*P5 + STRUC=VAL+SEA + GO TO 9999 +C +C Calculate PDFLIB distributions and return one for type IIQ. +C +#if defined(CERNLIB_PDFLIB) +9000 CONTINUE + DX=X + DSCALE=DSQRT(DBLE(QSQ)) + CALL PFTOPDG(DX,DSCALE,DXPDF) + STRUC=DXPDF(IQMAP(IIQ)) +#endif +C +C Require minimum value for STRUC +C +9999 IF(STRUC.LT.SFMIN) STRUC=SFMIN + RETURN + END diff --git a/ISAJET/code/strucw.F b/ISAJET/code/strucw.F new file mode 100644 index 00000000000..a0389339f2b --- /dev/null +++ b/ISAJET/code/strucw.F @@ -0,0 +1,230 @@ +#include "isajet/pilot.h" + FUNCTION STRUCW(XW,IW,IH) +C +C LONGITUDINAL W STRUCTURE FUNCTIONS CALCULATED BY CONVOLUTION +C OF EHLQ STRUCTURE FUNCTIONS AT Q**2=AMW**2 WITH F(W/Q) FROM +C DAWSON, N.P. B249, 42 (1985). +C IW = 1 2 3 4 +C GM W+ W- Z0 +C WARNING: DEFAULT VALUES ONLY FOR LAMBDA, SIN2W, ETC. +C +#if defined(CERNLIB_DOUBLE) + DOUBLE PRECISION X,XLOG +#endif +C FOLLOWING CONSTANTS ARE (CV**2+CA**2)/(4*PI**2) + DATA CVAW/2.701E-3/,CVAZUU/1.017E-3/,CVAZDD/1.298E-3/ +C +C STATEMENT FUNCTIONS CALCULATED BY INTEGRATING EACH TERM IN +C EHLQ PARAMETERIZATION USING SMP 1.5.0. +C +C FROM STRUCW2.EX + FUVAL(X) = 5.769575427 - 10.13681547*X + 3.042561145*XLOG - + $ 0.2798411214*(1./X) - 0.3404284678*(XLOG/X) + 8.296794608*(X**2) + $ - 6.017283047*(X**3) + 3.548706099*(X**4) - 1.560232679*(X**5) + $ + 0.4342326806*(X**6) - 0.05513649922*(X**7) +C + FDVAL(X) = 2.533753356 - 4.57001915*X + 0.9589133982*XLOG - + $ 0.307417692*(1./X) - 0.1793690733*(XLOG/X) + 4.566485508*(X**2) + $ - 3.937617129*(X**3) + 2.773480477*(X**4) - 1.540248513*(X**5) + $ + 0.6183097947*(X**6) - 0.1542126064*(X**7) + + $ 0.0174859553*(X**8) +C + FUSEA(X) = -5.503869566 + 15.20985662*X - 5.166205929*XLOG - + $ 1.728208206*(1./X) - 0.4215945253*(XLOG/X) - 18.82164974*(X**2) + $ + 24.27679709*(X**3) - 27.22445715*(X**4) + 24.98752188*(X**5) + $ - 18.12394891*(X**6) + 10.06144542*(X**7) - 4.106763252*(X**8) + $ + 1.15847115*(X**9) - 0.2014529514*(X**10) + + $ 0.01625760301*(X**11) +C + FDSEA(X) = -5.478593775 + 15.1097528*X - 5.581750835*XLOG - + $ 1.987547927*(1./X) - 0.4944113864*(XLOG/X) - 17.23528157*(X**2) + $ + 20.59071315*(X**3) - 21.48775889*(X**4) + 18.40750425*(X**5) + $ - 12.46901771*(X**6) + 6.45303238*(X**7) - 2.445316084*(X**8) + + $ 0.6363027326*(X**9) - 0.1011660335*(X**10) + + $ 0.007376682094*(X**11) +C + GUVAL1(X) = 6.650062246 + 1.480836233*X - 3.536793901*XLOG - + $ 5.08758928*(1./X) - 2.458893299*(XLOG/X) - + $ 0.4159265541*(XLOG**2/X) - 0.03949356966*(XLOG**3/X) - + $ 0.002175877338*(XLOG**4/X) - 6.382577207E-5*(XLOG**5/X) - + $ 7.324244818E-7*(XLOG**6/X) + 0.575121435*(X*XLOG) + + $ 0.09704190061*(X*XLOG**2) + 791./90953.*(X *XLOG**3) + GUVAL2(X) = + $ 3.962955366E-4*(X*XLOG**4) + 6.591820335E-6*(X *XLOG**5) - + $ 0.07706665525*(X**2*XLOG) - 0.01260088982*(X**2*XLOG**2) - + $ 0.001080476729*(X**2*XLOG**3) - 4.647425231E-5*(X**2*XLOG**4) - + $ 7.324244829E-7*(X**2*XLOG**5) - 0.2027508558*(X**2) - + $ 0.6721633358*(XLOG**2) - 0.07339139987*(XLOG**3) - + $ 0.004744695259*(XLOG**4) - 1.651100349E-4*XLOG**5 - + $ 2.197273446E-6*XLOG**6 +C + GDVAL1(X) = 2.403815112 + 1.359504335*X - 2.144999226*XLOG - + $ 2.357471591*(1./X) - 1.13339787*(XLOG/X) - + $ 0.2003574358*(XLOG**2/X) - 0.02221455952*(XLOG**3/X) - + $ 0.001601991722*(XLOG**4/X) - 6.878677010E-5*(XLOG**5/X) - + $ 1.323789434E-6*(XLOG**6/X) + 0.4984901703*(X*XLOG) + + $ 0.09080940556*(X*XLOG**2) + 0.01045471879*(X *XLOG**3) + GDVAL2(X) = + $ 7.339489291E-4*(X*XLOG**4) + 2.382820980E-5*(X *XLOG**5) - + $ 0.1348586553*(X**2*XLOG) - 0.02441501092*(X**2*XLOG**2) - + $ 0.002734669503*(X**2*XLOG**3) - 1.807502877E-4*(X**2*XLOG**4) - + $ 5.295157736E-6*(X**2*XLOG**5) + 0.01826324487*(X**3*XLOG) + + $ 0.003291926818*(X**3*XLOG**2) + 3.636001057E-4*(X**3*XLOG**3) + + $ 2.342115438E-5*(X**3*XLOG**4) + 6.618947159E-7*(X**3*XLOG**5) - + $ 0.3679347826*(X**2) + 0.04985470259*(X**3) - + $ 0.3928663839*(XLOG**2) - 0.04732954832*(XLOG**3) - + $ 0.003974205548*( XLOG**4) - 2.116051876E-4*XLOG**5 - + $ 5.295157736E-6*XLOG**6 +C + GUSEA1(X) = -0.8251281831 + 1.555766474*X - 0.476618796*XLOG - + $ 0.157877015*(1./X) + 0.3273497735*(XLOG/X) + + $ 0.1184829659*(XLOG**2/X) + 0.01147973292*(XLOG**3/X) + + $ 0.001370332595*(XLOG**4/X) + 4.084139287E-5*(XLOG**5/X) + + $ 2.284079310E-6*(XLOG**6/X) - 1.681676555*(X*XLOG) + + $ 0.01771802464*(X*XLOG**2) - 0.04546554244*(X *XLOG**3) - + $ 3.454606694E-4*(X*XLOG**4) - 1.438969965E-4*(X *XLOG**5) + + $ 0.8875664376*(X**2*XLOG) + 0.04051742981*(X**2 *XLOG**2) + GUSEA2(X) = + $ 0.0254151271*(X**2*XLOG**3) + 4.583985126E-4*(X**2*XLOG**4) + + $ 7.994277584E-5*(X**2*XLOG**5) - 0.4492144518*(X**3*XLOG) - + $ 0.02965496152*(X**3*XLOG**2) - 0.01288679853*(X**3*XLOG**3) - + $ 2.791634921E-4*(X**3*XLOG**4) - 3.997138792E-5*(X**3*XLOG**5) + + $ 0.1638328221*(X**4*XLOG) + 0.01250393016*(X**4*XLOG**2) + + $ 0.004685172364*(X**4*XLOG**3) + 1.100919901E-4*(X**4*XLOG**4) + + $ 1.438969967E-5*(X**4*XLOG**5) - 0.0367848506*(X**5*XLOG) - + $ 0.003035305139*(X**5*XLOG**2) - 0.001048416117*(X**5*XLOG**3) - + $ 2.579726667E-5*(X**5*XLOG**4) - 3.197711036E-6*(X**5*XLOG**5) + + $ 0.003783780648*(X**6*XLOG) + 3.278296157E-4*(X**6*XLOG**2) + + $ 1.075296502E-4*(X**6*XLOG**3) + 2.725601849E-6*(X**6*XLOG**4) + GUSEA3(X) = + $ 3.262970444E-7*(X**6*XLOG**5) - 0.2259054436*(X**2) + + $ 0.003364712414*(X**3) + 0.01992787001*(X**4) - 0.007399430903* + $ (X**5) + 9.652150086E-4*X**6 + 0.554652844*(XLOG**2) + + $ 0.011217842*(XLOG**3) + 0.007692743973*(XLOG**4) + + $ 9.402708800E-5*XLOG**5 + 1.598855517E-5*XLOG**6 +C + GDSEA1(X) = -0.9201807217 + 2.243479849*X - 0.899698589*XLOG - + $ 0.3970657521*(1./X) + 0.2818290666*(XLOG/X) + + $ 0.120664241*(XLOG**2/X) + 0.01043451714 *(XLOG**3/X) + + $ 0.001191246128*(XLOG**4/X) + 3.001102810E-5*(XLOG**5/X) + + $ 2.039937816E-6*(XLOG**6/X) - 1.787863927*(X*XLOG) + + $ 826./63247.*(X*XLOG**2) - 0.04263009293*(X*XLOG**3) + + $ 3.087205491E-5*( X*XLOG**4) - 1.285160824E-4*(X*XLOG**5) + + $ 0.9517638436*(X**2*XLOG) + 0.04047432532*(X**2*XLOG**2) + + $ 0.02332032497*(X**2*XLOG**3) + 2.208416029E-4*(X**2*XLOG**4) + GDSEA2(X) = + $ 7.139782355E-5*(X**2*XLOG**5) - 0.4816526149*(X**3*XLOG) - + $ 0.02893293689*(X**3*XLOG**2) - 0.01172595961*(X**3*XLOG**3) - + $ 1.550444419E-4*(X**3*XLOG**4) - 3.569891178E-5*(X**3*XLOG**5) + + $ 0.1755025883*(X**4*XLOG) + 0.01209064681*(X**4*XLOG**2) + + $ 0.004244259809*(X**4*XLOG**3) + 6.438373778E-5*(X**4*XLOG**4) + + $ 1.285160826E-5*(X**4*XLOG**5) - 0.03937044174*(X**5*XLOG) - + $ 0.002920614679*(X**5*XLOG**2) - 9.471446970E-4*(X**5*XLOG**3) - + $ 1.549746135E-5*(X**5*XLOG**4) - 2.855912944E-6*(X**5*XLOG**5) + GDSEA3(X) = + $ 0.004046756409*(X**6*XLOG) + 3.144555106E-4*(X**6*XLOG**2) + + $ 9.696129739E-5*(X**6*XLOG**3) + 1.664636351E-6*(X**6*XLOG**4) + + $ 2.914196881E-7*(X**6*XLOG**5) - 0.5703745807*(X**2) + + $ 0.1676594704*(X**3) - 0.03765961644*(X**4) + + $ 0.005180399826*(X**5) - 3.032419889E-4*X**6 + + $ 0.5916013402*(XLOG**2) + 0.0113078292*(XLOG**3) + + $ 0.007094724813*( XLOG**4) + 3.872242009E-5*XLOG**5 + + $ 1.427956471E-5*XLOG**6 +C + EUVAL(X) = -3.398748694 + 0.6266420937*(1./X) + EDVAL(X) = -1.300464877 + 0.2267175031*(1./X) + EUSEA(X) = -0.4281951222 + 0.0600001177*(1./X) + EDSEA(X) = -0.5744690066 + 0.08143317382*(1./X) +C +C ENTRY +C + IF(XW.LE.0..OR.XW.GE.1.) THEN + STRUCW=0. + RETURN + ENDIF + X=XW + XLOG=LOG(X) +C + IIW=IW + IF(IH.EQ.-1120) THEN + IF(IW.EQ.2) IIW=3 + IF(IW.EQ.3) IIW=2 + ELSEIF(IH.EQ.1220) THEN + IF(IW.EQ.2) IIW=3 + IF(IW.EQ.3) IIW=2 + ENDIF +C + IF(XW.GT..1) GO TO 1000 +C +C STRUCW = XW*F(XW) FOR IIW=W+ IN PROTON, XW<.1 + IF(IIW.EQ.2) THEN + G1=GUVAL1(X) + G1=G1+GUVAL2(X) + G2=GUSEA1(X) + G2=G2+GUSEA2(X) + G2=G2+GUSEA3(X) + G3=GDSEA1(X) + G3=G3+GDSEA2(X) + G3=G3+GDSEA3(X) + SUM=G1+G2+G3+EUVAL(X)+EUSEA(X)+EDSEA(X) + STRUCW=X*CVAW*SUM +C STRUCW = XW*F(XW) FOR IIW=W- IN PROTON, XW<.1 + ELSEIF(IIW.EQ.3) THEN + G1=GDVAL1(X) + G1=G1+GDVAL2(X) + G2=GDSEA1(X) + G2=G2+GDSEA2(X) + G2=G2+GDSEA3(X) + G3=GUSEA1(X) + G3=G3+GUSEA2(X) + G3=G3+GUSEA3(X) + SUM=G1+G2+G3+EDVAL(X)+EDSEA(X)+EUSEA(X) + STRUCW=X*CVAW*SUM +C STRUCW=XW*F(XW) FOR IIW=Z0 IN PROTON, XW<.1 + ELSEIF(IIW.EQ.4) THEN + G1=GUVAL1(X) + G1=G1+GUVAL2(X) + G2=GUSEA1(X) + G2=G2+GUSEA2(X) + G2=G2+GUSEA3(X) + SUMU=G1+2.*G2+EUVAL(X)+2.*EUSEA(X) + G1=GDVAL1(X) + G1=G1+GDVAL2(X) + G2=GDSEA1(X) + G2=G2+GDSEA2(X) + G2=G2+GDSEA3(X) + SUMD=G1+2.*G2+EDVAL(X)+2.*EDSEA(X) + STRUCW=X*(CVAZUU*SUMU+CVAZDD*SUMD) + ENDIF + IF(STRUCW.LT.0.) STRUCW=0. + RETURN +C +1000 CONTINUE +C +C STRUCW=XW*F(XW) FOR IIW=W+ IN PROTON, XW>.1 + IF(IIW.EQ.2) THEN + F1=FUVAL(X) + F2=FUSEA(X) + F3=FDSEA(X) + SUM=F1+F2+F3 + STRUCW=X*CVAW*SUM +C STRUCW=XW*F(XW) FOR IIW=W- IN PROTON, XW>.1 + ELSEIF(IIW.EQ.3) THEN + F1=FDVAL(X) + F2=FDSEA(X) + F3=FUSEA(X) + SUM=F1+F2+F3 + STRUCW=X*CVAW*SUM +C STRUCW=XW*F(XW) FOR IIW=Z0 IN PROTON, XW>.1 + ELSEIF(IIW.EQ.4) THEN + F1=FUVAL(X) + F2=FUSEA(X) + SUMU=F1+2.*F2 + F1=FDVAL(X) + F2=FDSEA(X) + SUMD=F1+2.*F2 + STRUCW=X*(CVAZUU*SUMU+CVAZDD*SUMD) + ENDIF + IF(STRUCW.LT.0.) STRUCW=0. + RETURN + END diff --git a/ISAJET/code/szjj1.F b/ISAJET/code/szjj1.F new file mode 100644 index 00000000000..d61706f8ec4 --- /dev/null +++ b/ISAJET/code/szjj1.F @@ -0,0 +1,97 @@ +#include "isajet/pilot.h" + REAL*8 FUNCTION SZJJ1(P1, P2, P3, P4, P5,IM1,IM2) +C +C Function generated by Madgraph + hand coding +C Returns amplitude squared summed/avg over colors +C and helicities +C for the point in phase space P1,P2,P3,P4,... +C for process : q(im1) q~(im1) -> z q(im2) q~(im2) +C with Madgraph codes IM1 != IM2 +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +C +C CONSTANTS +C + INTEGER NEXTERNAL, NCOMB + PARAMETER (NEXTERNAL=5, NCOMB= 48) +C +C ARGUMENTS +C + REAL*8 P1(0:3),P2(0:3),P3(0:3),P4(0:3),P5(0:3) + INTEGER IM1,IM2 +C +C LOCAL VARIABLES +C + INTEGER NHEL(NEXTERNAL,NCOMB),NTRY + REAL*8 T + REAL*8 ZJJ1 + INTEGER IHEL + LOGICAL GOODHEL(NCOMB) + DATA GOODHEL/NCOMB*.FALSE./ + DATA NTRY/0/ + DATA (NHEL(IHEL, 1),IHEL=1,5) / -1, -1, -1, -1, -1/ + DATA (NHEL(IHEL, 2),IHEL=1,5) / -1, -1, -1, -1, 1/ + DATA (NHEL(IHEL, 3),IHEL=1,5) / -1, -1, -1, 1, -1/ + DATA (NHEL(IHEL, 4),IHEL=1,5) / -1, -1, -1, 1, 1/ + DATA (NHEL(IHEL, 5),IHEL=1,5) / -1, -1, 0, -1, -1/ + DATA (NHEL(IHEL, 6),IHEL=1,5) / -1, -1, 0, -1, 1/ + DATA (NHEL(IHEL, 7),IHEL=1,5) / -1, -1, 0, 1, -1/ + DATA (NHEL(IHEL, 8),IHEL=1,5) / -1, -1, 0, 1, 1/ + DATA (NHEL(IHEL, 9),IHEL=1,5) / -1, -1, 1, -1, -1/ + DATA (NHEL(IHEL, 10),IHEL=1,5) / -1, -1, 1, -1, 1/ + DATA (NHEL(IHEL, 11),IHEL=1,5) / -1, -1, 1, 1, -1/ + DATA (NHEL(IHEL, 12),IHEL=1,5) / -1, -1, 1, 1, 1/ + DATA (NHEL(IHEL, 13),IHEL=1,5) / -1, 1, -1, -1, -1/ + DATA (NHEL(IHEL, 14),IHEL=1,5) / -1, 1, -1, -1, 1/ + DATA (NHEL(IHEL, 15),IHEL=1,5) / -1, 1, -1, 1, -1/ + DATA (NHEL(IHEL, 16),IHEL=1,5) / -1, 1, -1, 1, 1/ + DATA (NHEL(IHEL, 17),IHEL=1,5) / -1, 1, 0, -1, -1/ + DATA (NHEL(IHEL, 18),IHEL=1,5) / -1, 1, 0, -1, 1/ + DATA (NHEL(IHEL, 19),IHEL=1,5) / -1, 1, 0, 1, -1/ + DATA (NHEL(IHEL, 20),IHEL=1,5) / -1, 1, 0, 1, 1/ + DATA (NHEL(IHEL, 21),IHEL=1,5) / -1, 1, 1, -1, -1/ + DATA (NHEL(IHEL, 22),IHEL=1,5) / -1, 1, 1, -1, 1/ + DATA (NHEL(IHEL, 23),IHEL=1,5) / -1, 1, 1, 1, -1/ + DATA (NHEL(IHEL, 24),IHEL=1,5) / -1, 1, 1, 1, 1/ + DATA (NHEL(IHEL, 25),IHEL=1,5) / 1, -1, -1, -1, -1/ + DATA (NHEL(IHEL, 26),IHEL=1,5) / 1, -1, -1, -1, 1/ + DATA (NHEL(IHEL, 27),IHEL=1,5) / 1, -1, -1, 1, -1/ + DATA (NHEL(IHEL, 28),IHEL=1,5) / 1, -1, -1, 1, 1/ + DATA (NHEL(IHEL, 29),IHEL=1,5) / 1, -1, 0, -1, -1/ + DATA (NHEL(IHEL, 30),IHEL=1,5) / 1, -1, 0, -1, 1/ + DATA (NHEL(IHEL, 31),IHEL=1,5) / 1, -1, 0, 1, -1/ + DATA (NHEL(IHEL, 32),IHEL=1,5) / 1, -1, 0, 1, 1/ + DATA (NHEL(IHEL, 33),IHEL=1,5) / 1, -1, 1, -1, -1/ + DATA (NHEL(IHEL, 34),IHEL=1,5) / 1, -1, 1, -1, 1/ + DATA (NHEL(IHEL, 35),IHEL=1,5) / 1, -1, 1, 1, -1/ + DATA (NHEL(IHEL, 36),IHEL=1,5) / 1, -1, 1, 1, 1/ + DATA (NHEL(IHEL, 37),IHEL=1,5) / 1, 1, -1, -1, -1/ + DATA (NHEL(IHEL, 38),IHEL=1,5) / 1, 1, -1, -1, 1/ + DATA (NHEL(IHEL, 39),IHEL=1,5) / 1, 1, -1, 1, -1/ + DATA (NHEL(IHEL, 40),IHEL=1,5) / 1, 1, -1, 1, 1/ + DATA (NHEL(IHEL, 41),IHEL=1,5) / 1, 1, 0, -1, -1/ + DATA (NHEL(IHEL, 42),IHEL=1,5) / 1, 1, 0, -1, 1/ + DATA (NHEL(IHEL, 43),IHEL=1,5) / 1, 1, 0, 1, -1/ + DATA (NHEL(IHEL, 44),IHEL=1,5) / 1, 1, 0, 1, 1/ + DATA (NHEL(IHEL, 45),IHEL=1,5) / 1, 1, 1, -1, -1/ + DATA (NHEL(IHEL, 46),IHEL=1,5) / 1, 1, 1, -1, 1/ + DATA (NHEL(IHEL, 47),IHEL=1,5) / 1, 1, 1, 1, -1/ + DATA (NHEL(IHEL, 48),IHEL=1,5) / 1, 1, 1, 1, 1/ +C ---------- +C BEGIN CODE +C ---------- + SZJJ1 = 0D0 + NTRY=NTRY+1 + DO IHEL=1,NCOMB + IF (GOODHEL(IHEL) .OR. NTRY .LT. 10) THEN + T=ZJJ1(P1, P2, P3, P4, P5,NHEL(1,IHEL),IM1,IM2) + SZJJ1 = SZJJ1 + T + IF (T .GT. 0D0 .AND. .NOT. GOODHEL(IHEL)) THEN + GOODHEL(IHEL)=.TRUE. + ENDIF + ENDIF + ENDDO + SZJJ1 = SZJJ1 / 4D0 + END diff --git a/ISAJET/code/szjj2.F b/ISAJET/code/szjj2.F new file mode 100644 index 00000000000..e61c6d74d22 --- /dev/null +++ b/ISAJET/code/szjj2.F @@ -0,0 +1,97 @@ +#include "isajet/pilot.h" + REAL*8 FUNCTION SZJJ2(P1, P2, P3, P4, P5, IM) +C +C Function generated by Madgraph + hand coding +C Returns amplitude squared summed/ave over colors +C for the point in phase space P1,P2,P3,P4,P5 +C and helicity NHEL(1)... +C for the process: g g -> z q(im) qb(im) +C with Madgraph code IM +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +C +C CONSTANTS +C + INTEGER NEXTERNAL, NCOMB + PARAMETER (NEXTERNAL=5, NCOMB= 48) +C +C ARGUMENTS +C + REAL*8 P1(0:3),P2(0:3),P3(0:3),P4(0:3),P5(0:3) + INTEGER IM +C +C LOCAL VARIABLES +C + INTEGER NHEL(NEXTERNAL,NCOMB),NTRY + REAL*8 T + REAL*8 ZJJ2 + INTEGER IHEL + LOGICAL GOODHEL(NCOMB) + DATA GOODHEL/NCOMB*.FALSE./ + DATA NTRY/0/ + DATA (NHEL(IHEL, 1),IHEL=1,5) / -1, -1, -1, -1, -1/ + DATA (NHEL(IHEL, 2),IHEL=1,5) / -1, -1, -1, -1, 1/ + DATA (NHEL(IHEL, 3),IHEL=1,5) / -1, -1, -1, 1, -1/ + DATA (NHEL(IHEL, 4),IHEL=1,5) / -1, -1, -1, 1, 1/ + DATA (NHEL(IHEL, 5),IHEL=1,5) / -1, -1, 0, -1, -1/ + DATA (NHEL(IHEL, 6),IHEL=1,5) / -1, -1, 0, -1, 1/ + DATA (NHEL(IHEL, 7),IHEL=1,5) / -1, -1, 0, 1, -1/ + DATA (NHEL(IHEL, 8),IHEL=1,5) / -1, -1, 0, 1, 1/ + DATA (NHEL(IHEL, 9),IHEL=1,5) / -1, -1, 1, -1, -1/ + DATA (NHEL(IHEL, 10),IHEL=1,5) / -1, -1, 1, -1, 1/ + DATA (NHEL(IHEL, 11),IHEL=1,5) / -1, -1, 1, 1, -1/ + DATA (NHEL(IHEL, 12),IHEL=1,5) / -1, -1, 1, 1, 1/ + DATA (NHEL(IHEL, 13),IHEL=1,5) / -1, 1, -1, -1, -1/ + DATA (NHEL(IHEL, 14),IHEL=1,5) / -1, 1, -1, -1, 1/ + DATA (NHEL(IHEL, 15),IHEL=1,5) / -1, 1, -1, 1, -1/ + DATA (NHEL(IHEL, 16),IHEL=1,5) / -1, 1, -1, 1, 1/ + DATA (NHEL(IHEL, 17),IHEL=1,5) / -1, 1, 0, -1, -1/ + DATA (NHEL(IHEL, 18),IHEL=1,5) / -1, 1, 0, -1, 1/ + DATA (NHEL(IHEL, 19),IHEL=1,5) / -1, 1, 0, 1, -1/ + DATA (NHEL(IHEL, 20),IHEL=1,5) / -1, 1, 0, 1, 1/ + DATA (NHEL(IHEL, 21),IHEL=1,5) / -1, 1, 1, -1, -1/ + DATA (NHEL(IHEL, 22),IHEL=1,5) / -1, 1, 1, -1, 1/ + DATA (NHEL(IHEL, 23),IHEL=1,5) / -1, 1, 1, 1, -1/ + DATA (NHEL(IHEL, 24),IHEL=1,5) / -1, 1, 1, 1, 1/ + DATA (NHEL(IHEL, 25),IHEL=1,5) / 1, -1, -1, -1, -1/ + DATA (NHEL(IHEL, 26),IHEL=1,5) / 1, -1, -1, -1, 1/ + DATA (NHEL(IHEL, 27),IHEL=1,5) / 1, -1, -1, 1, -1/ + DATA (NHEL(IHEL, 28),IHEL=1,5) / 1, -1, -1, 1, 1/ + DATA (NHEL(IHEL, 29),IHEL=1,5) / 1, -1, 0, -1, -1/ + DATA (NHEL(IHEL, 30),IHEL=1,5) / 1, -1, 0, -1, 1/ + DATA (NHEL(IHEL, 31),IHEL=1,5) / 1, -1, 0, 1, -1/ + DATA (NHEL(IHEL, 32),IHEL=1,5) / 1, -1, 0, 1, 1/ + DATA (NHEL(IHEL, 33),IHEL=1,5) / 1, -1, 1, -1, -1/ + DATA (NHEL(IHEL, 34),IHEL=1,5) / 1, -1, 1, -1, 1/ + DATA (NHEL(IHEL, 35),IHEL=1,5) / 1, -1, 1, 1, -1/ + DATA (NHEL(IHEL, 36),IHEL=1,5) / 1, -1, 1, 1, 1/ + DATA (NHEL(IHEL, 37),IHEL=1,5) / 1, 1, -1, -1, -1/ + DATA (NHEL(IHEL, 38),IHEL=1,5) / 1, 1, -1, -1, 1/ + DATA (NHEL(IHEL, 39),IHEL=1,5) / 1, 1, -1, 1, -1/ + DATA (NHEL(IHEL, 40),IHEL=1,5) / 1, 1, -1, 1, 1/ + DATA (NHEL(IHEL, 41),IHEL=1,5) / 1, 1, 0, -1, -1/ + DATA (NHEL(IHEL, 42),IHEL=1,5) / 1, 1, 0, -1, 1/ + DATA (NHEL(IHEL, 43),IHEL=1,5) / 1, 1, 0, 1, -1/ + DATA (NHEL(IHEL, 44),IHEL=1,5) / 1, 1, 0, 1, 1/ + DATA (NHEL(IHEL, 45),IHEL=1,5) / 1, 1, 1, -1, -1/ + DATA (NHEL(IHEL, 46),IHEL=1,5) / 1, 1, 1, -1, 1/ + DATA (NHEL(IHEL, 47),IHEL=1,5) / 1, 1, 1, 1, -1/ + DATA (NHEL(IHEL, 48),IHEL=1,5) / 1, 1, 1, 1, 1/ +C ---------- +C BEGIN CODE +C ---------- + SZJJ2 = 0D0 + NTRY=NTRY+1 + DO IHEL=1,NCOMB + IF (GOODHEL(IHEL) .OR. NTRY .LT. 10) THEN + T=ZJJ2(P1, P2, P3, P4, P5,NHEL(1,IHEL),IM) + SZJJ2 = SZJJ2 + T + IF (T .GT. 0D0 .AND. .NOT. GOODHEL(IHEL)) THEN + GOODHEL(IHEL)=.TRUE. + ENDIF + ENDIF + ENDDO + SZJJ2 = SZJJ2 / 4D0 + END diff --git a/ISAJET/code/szjj3.F b/ISAJET/code/szjj3.F new file mode 100644 index 00000000000..268f3f1d534 --- /dev/null +++ b/ISAJET/code/szjj3.F @@ -0,0 +1,97 @@ +#include "isajet/pilot.h" + REAL*8 FUNCTION SZJJ3(P1, P2, P3, P4, P5, IM) +C +C Function generated by Madgraph + hand coding +C Returns amplitude squared summed/ave over colors +C for the point in phase space P1,P2,P3,P4,P5 +C and helicity NHEL(1)... +C for the process: q(im) qb(im) -> z g g +C with Madgraph code IM +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +C +C CONSTANTS +C + INTEGER NEXTERNAL, NCOMB + PARAMETER (NEXTERNAL=5, NCOMB= 48) +C +C ARGUMENTS +C + REAL*8 P1(0:3),P2(0:3),P3(0:3),P4(0:3),P5(0:3) + INTEGER IM +C +C LOCAL VARIABLES +C + INTEGER NHEL(NEXTERNAL,NCOMB),NTRY + REAL*8 T + REAL*8 ZJJ3 + INTEGER IHEL + LOGICAL GOODHEL(NCOMB) + DATA GOODHEL/NCOMB*.FALSE./ + DATA NTRY/0/ + DATA (NHEL(IHEL, 1),IHEL=1,5) / -1, -1, -1, -1, -1/ + DATA (NHEL(IHEL, 2),IHEL=1,5) / -1, -1, -1, -1, 1/ + DATA (NHEL(IHEL, 3),IHEL=1,5) / -1, -1, -1, 1, -1/ + DATA (NHEL(IHEL, 4),IHEL=1,5) / -1, -1, -1, 1, 1/ + DATA (NHEL(IHEL, 5),IHEL=1,5) / -1, -1, 0, -1, -1/ + DATA (NHEL(IHEL, 6),IHEL=1,5) / -1, -1, 0, -1, 1/ + DATA (NHEL(IHEL, 7),IHEL=1,5) / -1, -1, 0, 1, -1/ + DATA (NHEL(IHEL, 8),IHEL=1,5) / -1, -1, 0, 1, 1/ + DATA (NHEL(IHEL, 9),IHEL=1,5) / -1, -1, 1, -1, -1/ + DATA (NHEL(IHEL, 10),IHEL=1,5) / -1, -1, 1, -1, 1/ + DATA (NHEL(IHEL, 11),IHEL=1,5) / -1, -1, 1, 1, -1/ + DATA (NHEL(IHEL, 12),IHEL=1,5) / -1, -1, 1, 1, 1/ + DATA (NHEL(IHEL, 13),IHEL=1,5) / -1, 1, -1, -1, -1/ + DATA (NHEL(IHEL, 14),IHEL=1,5) / -1, 1, -1, -1, 1/ + DATA (NHEL(IHEL, 15),IHEL=1,5) / -1, 1, -1, 1, -1/ + DATA (NHEL(IHEL, 16),IHEL=1,5) / -1, 1, -1, 1, 1/ + DATA (NHEL(IHEL, 17),IHEL=1,5) / -1, 1, 0, -1, -1/ + DATA (NHEL(IHEL, 18),IHEL=1,5) / -1, 1, 0, -1, 1/ + DATA (NHEL(IHEL, 19),IHEL=1,5) / -1, 1, 0, 1, -1/ + DATA (NHEL(IHEL, 20),IHEL=1,5) / -1, 1, 0, 1, 1/ + DATA (NHEL(IHEL, 21),IHEL=1,5) / -1, 1, 1, -1, -1/ + DATA (NHEL(IHEL, 22),IHEL=1,5) / -1, 1, 1, -1, 1/ + DATA (NHEL(IHEL, 23),IHEL=1,5) / -1, 1, 1, 1, -1/ + DATA (NHEL(IHEL, 24),IHEL=1,5) / -1, 1, 1, 1, 1/ + DATA (NHEL(IHEL, 25),IHEL=1,5) / 1, -1, -1, -1, -1/ + DATA (NHEL(IHEL, 26),IHEL=1,5) / 1, -1, -1, -1, 1/ + DATA (NHEL(IHEL, 27),IHEL=1,5) / 1, -1, -1, 1, -1/ + DATA (NHEL(IHEL, 28),IHEL=1,5) / 1, -1, -1, 1, 1/ + DATA (NHEL(IHEL, 29),IHEL=1,5) / 1, -1, 0, -1, -1/ + DATA (NHEL(IHEL, 30),IHEL=1,5) / 1, -1, 0, -1, 1/ + DATA (NHEL(IHEL, 31),IHEL=1,5) / 1, -1, 0, 1, -1/ + DATA (NHEL(IHEL, 32),IHEL=1,5) / 1, -1, 0, 1, 1/ + DATA (NHEL(IHEL, 33),IHEL=1,5) / 1, -1, 1, -1, -1/ + DATA (NHEL(IHEL, 34),IHEL=1,5) / 1, -1, 1, -1, 1/ + DATA (NHEL(IHEL, 35),IHEL=1,5) / 1, -1, 1, 1, -1/ + DATA (NHEL(IHEL, 36),IHEL=1,5) / 1, -1, 1, 1, 1/ + DATA (NHEL(IHEL, 37),IHEL=1,5) / 1, 1, -1, -1, -1/ + DATA (NHEL(IHEL, 38),IHEL=1,5) / 1, 1, -1, -1, 1/ + DATA (NHEL(IHEL, 39),IHEL=1,5) / 1, 1, -1, 1, -1/ + DATA (NHEL(IHEL, 40),IHEL=1,5) / 1, 1, -1, 1, 1/ + DATA (NHEL(IHEL, 41),IHEL=1,5) / 1, 1, 0, -1, -1/ + DATA (NHEL(IHEL, 42),IHEL=1,5) / 1, 1, 0, -1, 1/ + DATA (NHEL(IHEL, 43),IHEL=1,5) / 1, 1, 0, 1, -1/ + DATA (NHEL(IHEL, 44),IHEL=1,5) / 1, 1, 0, 1, 1/ + DATA (NHEL(IHEL, 45),IHEL=1,5) / 1, 1, 1, -1, -1/ + DATA (NHEL(IHEL, 46),IHEL=1,5) / 1, 1, 1, -1, 1/ + DATA (NHEL(IHEL, 47),IHEL=1,5) / 1, 1, 1, 1, -1/ + DATA (NHEL(IHEL, 48),IHEL=1,5) / 1, 1, 1, 1, 1/ +C ---------- +C BEGIN CODE +C ---------- + SZJJ3 = 0D0 + NTRY=NTRY+1 + DO IHEL=1,NCOMB + IF (GOODHEL(IHEL) .OR. NTRY .LT. 10) THEN + T=ZJJ3(P1, P2, P3, P4, P5,NHEL(1,IHEL),IM) + SZJJ3 = SZJJ3 + T + IF (T .GT. 0D0 .AND. .NOT. GOODHEL(IHEL)) THEN + GOODHEL(IHEL)=.TRUE. + ENDIF + ENDIF + ENDDO + SZJJ3 = SZJJ3 / 4D0 + END diff --git a/ISAJET/code/szjj4.F b/ISAJET/code/szjj4.F new file mode 100644 index 00000000000..3ea2cecc5df --- /dev/null +++ b/ISAJET/code/szjj4.F @@ -0,0 +1,98 @@ +#include "isajet/pilot.h" + REAL*8 FUNCTION SZJJ4(P1, P2, P3, P4, P5,IM) +C +C Function generated by Madgraph + hand coding +C Returns amplitude squared summed/ave over colors +C for the point in phase space P1,P2,P3,P4,P5 +C and helicity NHEL(1)... +C for the process: q(im) qb(im) -> z q(im) qb(im) +C with Madgraph code IM +C +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +C +C CONSTANTS +C + INTEGER NEXTERNAL, NCOMB + PARAMETER (NEXTERNAL=5, NCOMB= 48) +C +C ARGUMENTS +C + REAL*8 P1(0:3),P2(0:3),P3(0:3),P4(0:3),P5(0:3) + INTEGER IM +C +C LOCAL VARIABLES +C + INTEGER NHEL(NEXTERNAL,NCOMB),NTRY + REAL*8 T + REAL*8 ZJJ4 + INTEGER IHEL + LOGICAL GOODHEL(NCOMB) + DATA GOODHEL/NCOMB*.FALSE./ + DATA NTRY/0/ + DATA (NHEL(IHEL, 1),IHEL=1,5) / -1, -1, -1, -1, -1/ + DATA (NHEL(IHEL, 2),IHEL=1,5) / -1, -1, -1, -1, 1/ + DATA (NHEL(IHEL, 3),IHEL=1,5) / -1, -1, -1, 1, -1/ + DATA (NHEL(IHEL, 4),IHEL=1,5) / -1, -1, -1, 1, 1/ + DATA (NHEL(IHEL, 5),IHEL=1,5) / -1, -1, 0, -1, -1/ + DATA (NHEL(IHEL, 6),IHEL=1,5) / -1, -1, 0, -1, 1/ + DATA (NHEL(IHEL, 7),IHEL=1,5) / -1, -1, 0, 1, -1/ + DATA (NHEL(IHEL, 8),IHEL=1,5) / -1, -1, 0, 1, 1/ + DATA (NHEL(IHEL, 9),IHEL=1,5) / -1, -1, 1, -1, -1/ + DATA (NHEL(IHEL, 10),IHEL=1,5) / -1, -1, 1, -1, 1/ + DATA (NHEL(IHEL, 11),IHEL=1,5) / -1, -1, 1, 1, -1/ + DATA (NHEL(IHEL, 12),IHEL=1,5) / -1, -1, 1, 1, 1/ + DATA (NHEL(IHEL, 13),IHEL=1,5) / -1, 1, -1, -1, -1/ + DATA (NHEL(IHEL, 14),IHEL=1,5) / -1, 1, -1, -1, 1/ + DATA (NHEL(IHEL, 15),IHEL=1,5) / -1, 1, -1, 1, -1/ + DATA (NHEL(IHEL, 16),IHEL=1,5) / -1, 1, -1, 1, 1/ + DATA (NHEL(IHEL, 17),IHEL=1,5) / -1, 1, 0, -1, -1/ + DATA (NHEL(IHEL, 18),IHEL=1,5) / -1, 1, 0, -1, 1/ + DATA (NHEL(IHEL, 19),IHEL=1,5) / -1, 1, 0, 1, -1/ + DATA (NHEL(IHEL, 20),IHEL=1,5) / -1, 1, 0, 1, 1/ + DATA (NHEL(IHEL, 21),IHEL=1,5) / -1, 1, 1, -1, -1/ + DATA (NHEL(IHEL, 22),IHEL=1,5) / -1, 1, 1, -1, 1/ + DATA (NHEL(IHEL, 23),IHEL=1,5) / -1, 1, 1, 1, -1/ + DATA (NHEL(IHEL, 24),IHEL=1,5) / -1, 1, 1, 1, 1/ + DATA (NHEL(IHEL, 25),IHEL=1,5) / 1, -1, -1, -1, -1/ + DATA (NHEL(IHEL, 26),IHEL=1,5) / 1, -1, -1, -1, 1/ + DATA (NHEL(IHEL, 27),IHEL=1,5) / 1, -1, -1, 1, -1/ + DATA (NHEL(IHEL, 28),IHEL=1,5) / 1, -1, -1, 1, 1/ + DATA (NHEL(IHEL, 29),IHEL=1,5) / 1, -1, 0, -1, -1/ + DATA (NHEL(IHEL, 30),IHEL=1,5) / 1, -1, 0, -1, 1/ + DATA (NHEL(IHEL, 31),IHEL=1,5) / 1, -1, 0, 1, -1/ + DATA (NHEL(IHEL, 32),IHEL=1,5) / 1, -1, 0, 1, 1/ + DATA (NHEL(IHEL, 33),IHEL=1,5) / 1, -1, 1, -1, -1/ + DATA (NHEL(IHEL, 34),IHEL=1,5) / 1, -1, 1, -1, 1/ + DATA (NHEL(IHEL, 35),IHEL=1,5) / 1, -1, 1, 1, -1/ + DATA (NHEL(IHEL, 36),IHEL=1,5) / 1, -1, 1, 1, 1/ + DATA (NHEL(IHEL, 37),IHEL=1,5) / 1, 1, -1, -1, -1/ + DATA (NHEL(IHEL, 38),IHEL=1,5) / 1, 1, -1, -1, 1/ + DATA (NHEL(IHEL, 39),IHEL=1,5) / 1, 1, -1, 1, -1/ + DATA (NHEL(IHEL, 40),IHEL=1,5) / 1, 1, -1, 1, 1/ + DATA (NHEL(IHEL, 41),IHEL=1,5) / 1, 1, 0, -1, -1/ + DATA (NHEL(IHEL, 42),IHEL=1,5) / 1, 1, 0, -1, 1/ + DATA (NHEL(IHEL, 43),IHEL=1,5) / 1, 1, 0, 1, -1/ + DATA (NHEL(IHEL, 44),IHEL=1,5) / 1, 1, 0, 1, 1/ + DATA (NHEL(IHEL, 45),IHEL=1,5) / 1, 1, 1, -1, -1/ + DATA (NHEL(IHEL, 46),IHEL=1,5) / 1, 1, 1, -1, 1/ + DATA (NHEL(IHEL, 47),IHEL=1,5) / 1, 1, 1, 1, -1/ + DATA (NHEL(IHEL, 48),IHEL=1,5) / 1, 1, 1, 1, 1/ +C ---------- +C BEGIN CODE +C ---------- + SZJJ4 = 0D0 + NTRY=NTRY+1 + DO IHEL=1,NCOMB + IF (GOODHEL(IHEL) .OR. NTRY .LT. 10) THEN + T=ZJJ4(P1, P2, P3, P4, P5,NHEL(1,IHEL),IM) + SZJJ4 = SZJJ4 + T + IF (T .GT. 0D0 .AND. .NOT. GOODHEL(IHEL)) THEN + GOODHEL(IHEL)=.TRUE. + ENDIF + ENDIF + ENDDO + SZJJ4 = SZJJ4 / 4D0 + END diff --git a/ISAJET/code/szjj5.F b/ISAJET/code/szjj5.F new file mode 100644 index 00000000000..23ce125ce52 --- /dev/null +++ b/ISAJET/code/szjj5.F @@ -0,0 +1,98 @@ +#include "isajet/pilot.h" + REAL*8 FUNCTION SZJJ5(P1, P2, P3, P4, P5, IM1, IM2) +C +C Function generated by Madgraph + hand coding +C Returns amplitude squared summed/avg over colors +C and helicities +C for the point in phase space p1,p2,p3,p4,... +C +C for process : q(im1) q(im2) -> z q(im1) q(im2) +C with Madgraph codes IM1 != IM2 +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +C +C CONSTANTS +C + INTEGER NEXTERNAL, NCOMB + PARAMETER (NEXTERNAL=5, NCOMB= 48) +C +C ARGUMENTS +C + REAL*8 P1(0:3),P2(0:3),P3(0:3),P4(0:3),P5(0:3) + INTEGER IM1,IM2 +C +C LOCAL VARIABLES +C + INTEGER NHEL(NEXTERNAL,NCOMB),NTRY + REAL*8 T + REAL*8 ZJJ5 + INTEGER IHEL + LOGICAL GOODHEL(NCOMB) + DATA GOODHEL/NCOMB*.FALSE./ + DATA NTRY/0/ + DATA (NHEL(IHEL, 1),IHEL=1,5) / -1, -1, -1, -1, -1/ + DATA (NHEL(IHEL, 2),IHEL=1,5) / -1, -1, -1, -1, 1/ + DATA (NHEL(IHEL, 3),IHEL=1,5) / -1, -1, -1, 1, -1/ + DATA (NHEL(IHEL, 4),IHEL=1,5) / -1, -1, -1, 1, 1/ + DATA (NHEL(IHEL, 5),IHEL=1,5) / -1, -1, 0, -1, -1/ + DATA (NHEL(IHEL, 6),IHEL=1,5) / -1, -1, 0, -1, 1/ + DATA (NHEL(IHEL, 7),IHEL=1,5) / -1, -1, 0, 1, -1/ + DATA (NHEL(IHEL, 8),IHEL=1,5) / -1, -1, 0, 1, 1/ + DATA (NHEL(IHEL, 9),IHEL=1,5) / -1, -1, 1, -1, -1/ + DATA (NHEL(IHEL, 10),IHEL=1,5) / -1, -1, 1, -1, 1/ + DATA (NHEL(IHEL, 11),IHEL=1,5) / -1, -1, 1, 1, -1/ + DATA (NHEL(IHEL, 12),IHEL=1,5) / -1, -1, 1, 1, 1/ + DATA (NHEL(IHEL, 13),IHEL=1,5) / -1, 1, -1, -1, -1/ + DATA (NHEL(IHEL, 14),IHEL=1,5) / -1, 1, -1, -1, 1/ + DATA (NHEL(IHEL, 15),IHEL=1,5) / -1, 1, -1, 1, -1/ + DATA (NHEL(IHEL, 16),IHEL=1,5) / -1, 1, -1, 1, 1/ + DATA (NHEL(IHEL, 17),IHEL=1,5) / -1, 1, 0, -1, -1/ + DATA (NHEL(IHEL, 18),IHEL=1,5) / -1, 1, 0, -1, 1/ + DATA (NHEL(IHEL, 19),IHEL=1,5) / -1, 1, 0, 1, -1/ + DATA (NHEL(IHEL, 20),IHEL=1,5) / -1, 1, 0, 1, 1/ + DATA (NHEL(IHEL, 21),IHEL=1,5) / -1, 1, 1, -1, -1/ + DATA (NHEL(IHEL, 22),IHEL=1,5) / -1, 1, 1, -1, 1/ + DATA (NHEL(IHEL, 23),IHEL=1,5) / -1, 1, 1, 1, -1/ + DATA (NHEL(IHEL, 24),IHEL=1,5) / -1, 1, 1, 1, 1/ + DATA (NHEL(IHEL, 25),IHEL=1,5) / 1, -1, -1, -1, -1/ + DATA (NHEL(IHEL, 26),IHEL=1,5) / 1, -1, -1, -1, 1/ + DATA (NHEL(IHEL, 27),IHEL=1,5) / 1, -1, -1, 1, -1/ + DATA (NHEL(IHEL, 28),IHEL=1,5) / 1, -1, -1, 1, 1/ + DATA (NHEL(IHEL, 29),IHEL=1,5) / 1, -1, 0, -1, -1/ + DATA (NHEL(IHEL, 30),IHEL=1,5) / 1, -1, 0, -1, 1/ + DATA (NHEL(IHEL, 31),IHEL=1,5) / 1, -1, 0, 1, -1/ + DATA (NHEL(IHEL, 32),IHEL=1,5) / 1, -1, 0, 1, 1/ + DATA (NHEL(IHEL, 33),IHEL=1,5) / 1, -1, 1, -1, -1/ + DATA (NHEL(IHEL, 34),IHEL=1,5) / 1, -1, 1, -1, 1/ + DATA (NHEL(IHEL, 35),IHEL=1,5) / 1, -1, 1, 1, -1/ + DATA (NHEL(IHEL, 36),IHEL=1,5) / 1, -1, 1, 1, 1/ + DATA (NHEL(IHEL, 37),IHEL=1,5) / 1, 1, -1, -1, -1/ + DATA (NHEL(IHEL, 38),IHEL=1,5) / 1, 1, -1, -1, 1/ + DATA (NHEL(IHEL, 39),IHEL=1,5) / 1, 1, -1, 1, -1/ + DATA (NHEL(IHEL, 40),IHEL=1,5) / 1, 1, -1, 1, 1/ + DATA (NHEL(IHEL, 41),IHEL=1,5) / 1, 1, 0, -1, -1/ + DATA (NHEL(IHEL, 42),IHEL=1,5) / 1, 1, 0, -1, 1/ + DATA (NHEL(IHEL, 43),IHEL=1,5) / 1, 1, 0, 1, -1/ + DATA (NHEL(IHEL, 44),IHEL=1,5) / 1, 1, 0, 1, 1/ + DATA (NHEL(IHEL, 45),IHEL=1,5) / 1, 1, 1, -1, -1/ + DATA (NHEL(IHEL, 46),IHEL=1,5) / 1, 1, 1, -1, 1/ + DATA (NHEL(IHEL, 47),IHEL=1,5) / 1, 1, 1, 1, -1/ + DATA (NHEL(IHEL, 48),IHEL=1,5) / 1, 1, 1, 1, 1/ +C ---------- +C BEGIN CODE +C ---------- + SZJJ5 = 0d0 + NTRY=NTRY+1 + DO IHEL=1,NCOMB + IF (GOODHEL(IHEL) .OR. NTRY .LT. 10) THEN + T=ZJJ5(P1, P2, P3, P4, P5,NHEL(1,IHEL), IM1,IM2) + SZJJ5 = SZJJ5 + T + IF (T .GT. 0D0 .AND. .NOT. GOODHEL(IHEL)) THEN + GOODHEL(IHEL)=.TRUE. + ENDIF + ENDIF + ENDDO + SZJJ5 = SZJJ5 / 4D0 + END diff --git a/ISAJET/code/szjj6.F b/ISAJET/code/szjj6.F new file mode 100644 index 00000000000..33c43c5926f --- /dev/null +++ b/ISAJET/code/szjj6.F @@ -0,0 +1,95 @@ +#include "isajet/pilot.h" + REAL*8 FUNCTION SZJJ6(P1, P2, P3, P4, P5, IM1) +C +C Function generated by Madgraph + hand coding +C Returns amplitude squared summed/avg over colors +C and helicities +C for the point in phase space p1,p2,p3,p4,... +C +C for process : q(im1) q(im1) -> z q(im1) q(im1) +C + IMPLICIT NONE +C +C CONSTANTS +C + INTEGER NEXTERNAL, NCOMB + PARAMETER (NEXTERNAL=5, NCOMB= 48) +C +C ARGUMENTS +C + REAL*8 P1(0:3),P2(0:3),P3(0:3),P4(0:3),P5(0:3) + INTEGER IM1 +C +C LOCAL VARIABLES +C + INTEGER NHEL(NEXTERNAL,NCOMB),NTRY + REAL*8 T + REAL*8 ZJJ6 + INTEGER IHEL + LOGICAL GOODHEL(NCOMB) + DATA GOODHEL/NCOMB*.FALSE./ + DATA NTRY/0/ + DATA (NHEL(IHEL, 1),IHEL=1,5) / -1, -1, -1, -1, -1/ + DATA (NHEL(IHEL, 2),IHEL=1,5) / -1, -1, -1, -1, 1/ + DATA (NHEL(IHEL, 3),IHEL=1,5) / -1, -1, -1, 1, -1/ + DATA (NHEL(IHEL, 4),IHEL=1,5) / -1, -1, -1, 1, 1/ + DATA (NHEL(IHEL, 5),IHEL=1,5) / -1, -1, 0, -1, -1/ + DATA (NHEL(IHEL, 6),IHEL=1,5) / -1, -1, 0, -1, 1/ + DATA (NHEL(IHEL, 7),IHEL=1,5) / -1, -1, 0, 1, -1/ + DATA (NHEL(IHEL, 8),IHEL=1,5) / -1, -1, 0, 1, 1/ + DATA (NHEL(IHEL, 9),IHEL=1,5) / -1, -1, 1, -1, -1/ + DATA (NHEL(IHEL, 10),IHEL=1,5) / -1, -1, 1, -1, 1/ + DATA (NHEL(IHEL, 11),IHEL=1,5) / -1, -1, 1, 1, -1/ + DATA (NHEL(IHEL, 12),IHEL=1,5) / -1, -1, 1, 1, 1/ + DATA (NHEL(IHEL, 13),IHEL=1,5) / -1, 1, -1, -1, -1/ + DATA (NHEL(IHEL, 14),IHEL=1,5) / -1, 1, -1, -1, 1/ + DATA (NHEL(IHEL, 15),IHEL=1,5) / -1, 1, -1, 1, -1/ + DATA (NHEL(IHEL, 16),IHEL=1,5) / -1, 1, -1, 1, 1/ + DATA (NHEL(IHEL, 17),IHEL=1,5) / -1, 1, 0, -1, -1/ + DATA (NHEL(IHEL, 18),IHEL=1,5) / -1, 1, 0, -1, 1/ + DATA (NHEL(IHEL, 19),IHEL=1,5) / -1, 1, 0, 1, -1/ + DATA (NHEL(IHEL, 20),IHEL=1,5) / -1, 1, 0, 1, 1/ + DATA (NHEL(IHEL, 21),IHEL=1,5) / -1, 1, 1, -1, -1/ + DATA (NHEL(IHEL, 22),IHEL=1,5) / -1, 1, 1, -1, 1/ + DATA (NHEL(IHEL, 23),IHEL=1,5) / -1, 1, 1, 1, -1/ + DATA (NHEL(IHEL, 24),IHEL=1,5) / -1, 1, 1, 1, 1/ + DATA (NHEL(IHEL, 25),IHEL=1,5) / 1, -1, -1, -1, -1/ + DATA (NHEL(IHEL, 26),IHEL=1,5) / 1, -1, -1, -1, 1/ + DATA (NHEL(IHEL, 27),IHEL=1,5) / 1, -1, -1, 1, -1/ + DATA (NHEL(IHEL, 28),IHEL=1,5) / 1, -1, -1, 1, 1/ + DATA (NHEL(IHEL, 29),IHEL=1,5) / 1, -1, 0, -1, -1/ + DATA (NHEL(IHEL, 30),IHEL=1,5) / 1, -1, 0, -1, 1/ + DATA (NHEL(IHEL, 31),IHEL=1,5) / 1, -1, 0, 1, -1/ + DATA (NHEL(IHEL, 32),IHEL=1,5) / 1, -1, 0, 1, 1/ + DATA (NHEL(IHEL, 33),IHEL=1,5) / 1, -1, 1, -1, -1/ + DATA (NHEL(IHEL, 34),IHEL=1,5) / 1, -1, 1, -1, 1/ + DATA (NHEL(IHEL, 35),IHEL=1,5) / 1, -1, 1, 1, -1/ + DATA (NHEL(IHEL, 36),IHEL=1,5) / 1, -1, 1, 1, 1/ + DATA (NHEL(IHEL, 37),IHEL=1,5) / 1, 1, -1, -1, -1/ + DATA (NHEL(IHEL, 38),IHEL=1,5) / 1, 1, -1, -1, 1/ + DATA (NHEL(IHEL, 39),IHEL=1,5) / 1, 1, -1, 1, -1/ + DATA (NHEL(IHEL, 40),IHEL=1,5) / 1, 1, -1, 1, 1/ + DATA (NHEL(IHEL, 41),IHEL=1,5) / 1, 1, 0, -1, -1/ + DATA (NHEL(IHEL, 42),IHEL=1,5) / 1, 1, 0, -1, 1/ + DATA (NHEL(IHEL, 43),IHEL=1,5) / 1, 1, 0, 1, -1/ + DATA (NHEL(IHEL, 44),IHEL=1,5) / 1, 1, 0, 1, 1/ + DATA (NHEL(IHEL, 45),IHEL=1,5) / 1, 1, 1, -1, -1/ + DATA (NHEL(IHEL, 46),IHEL=1,5) / 1, 1, 1, -1, 1/ + DATA (NHEL(IHEL, 47),IHEL=1,5) / 1, 1, 1, 1, -1/ + DATA (NHEL(IHEL, 48),IHEL=1,5) / 1, 1, 1, 1, 1/ +C ---------- +C BEGIN CODE +C ---------- + SZJJ6 = 0d0 + NTRY=NTRY+1 + DO IHEL=1,NCOMB + IF (GOODHEL(IHEL) .OR. NTRY .LT. 10) THEN + T=ZJJ6(P1, P2, P3, P4, P5,NHEL(1,IHEL),IM1) + SZJJ6 = SZJJ6 + T + IF (T .GT. 0D0 .AND. .NOT. GOODHEL(IHEL)) THEN + GOODHEL(IHEL)=.TRUE. + ENDIF + ENDIF + ENDDO + SZJJ6 = SZJJ6 / 4D0 + END diff --git a/ISAJET/code/szjj7.F b/ISAJET/code/szjj7.F new file mode 100644 index 00000000000..21098ab79f8 --- /dev/null +++ b/ISAJET/code/szjj7.F @@ -0,0 +1,97 @@ +#include "isajet/pilot.h" + REAL*8 FUNCTION SZJJ7(P1, P2, P3, P4, P5, IM1) +C +C Function generated by Madgraph +C Returns amplitude squared summed/avg over colors +C and helicities +C for the point in phase space p1,p2,p3,p4,... +C +C for process : g q(im1) -> z g q(im1) +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +C +C CONSTANTS +C + INTEGER NEXTERNAL, NCOMB + PARAMETER (NEXTERNAL=5, NCOMB= 48) +C +C ARGUMENTS +C + REAL*8 P1(0:3),P2(0:3),P3(0:3),P4(0:3),P5(0:3) + INTEGER IM1 +C +C LOCAL VARIABLES +C + INTEGER NHEL(NEXTERNAL,NCOMB),NTRY + REAL*8 T + REAL*8 ZJJ7 + INTEGER IHEL + LOGICAL GOODHEL(NCOMB) + DATA GOODHEL/NCOMB*.FALSE./ + DATA NTRY/0/ + DATA (NHEL(IHEL, 1),IHEL=1,5) / -1, -1, -1, -1, -1/ + DATA (NHEL(IHEL, 2),IHEL=1,5) / -1, -1, -1, -1, 1/ + DATA (NHEL(IHEL, 3),IHEL=1,5) / -1, -1, -1, 1, -1/ + DATA (NHEL(IHEL, 4),IHEL=1,5) / -1, -1, -1, 1, 1/ + DATA (NHEL(IHEL, 5),IHEL=1,5) / -1, -1, 0, -1, -1/ + DATA (NHEL(IHEL, 6),IHEL=1,5) / -1, -1, 0, -1, 1/ + DATA (NHEL(IHEL, 7),IHEL=1,5) / -1, -1, 0, 1, -1/ + DATA (NHEL(IHEL, 8),IHEL=1,5) / -1, -1, 0, 1, 1/ + DATA (NHEL(IHEL, 9),IHEL=1,5) / -1, -1, 1, -1, -1/ + DATA (NHEL(IHEL, 10),IHEL=1,5) / -1, -1, 1, -1, 1/ + DATA (NHEL(IHEL, 11),IHEL=1,5) / -1, -1, 1, 1, -1/ + DATA (NHEL(IHEL, 12),IHEL=1,5) / -1, -1, 1, 1, 1/ + DATA (NHEL(IHEL, 13),IHEL=1,5) / -1, 1, -1, -1, -1/ + DATA (NHEL(IHEL, 14),IHEL=1,5) / -1, 1, -1, -1, 1/ + DATA (NHEL(IHEL, 15),IHEL=1,5) / -1, 1, -1, 1, -1/ + DATA (NHEL(IHEL, 16),IHEL=1,5) / -1, 1, -1, 1, 1/ + DATA (NHEL(IHEL, 17),IHEL=1,5) / -1, 1, 0, -1, -1/ + DATA (NHEL(IHEL, 18),IHEL=1,5) / -1, 1, 0, -1, 1/ + DATA (NHEL(IHEL, 19),IHEL=1,5) / -1, 1, 0, 1, -1/ + DATA (NHEL(IHEL, 20),IHEL=1,5) / -1, 1, 0, 1, 1/ + DATA (NHEL(IHEL, 21),IHEL=1,5) / -1, 1, 1, -1, -1/ + DATA (NHEL(IHEL, 22),IHEL=1,5) / -1, 1, 1, -1, 1/ + DATA (NHEL(IHEL, 23),IHEL=1,5) / -1, 1, 1, 1, -1/ + DATA (NHEL(IHEL, 24),IHEL=1,5) / -1, 1, 1, 1, 1/ + DATA (NHEL(IHEL, 25),IHEL=1,5) / 1, -1, -1, -1, -1/ + DATA (NHEL(IHEL, 26),IHEL=1,5) / 1, -1, -1, -1, 1/ + DATA (NHEL(IHEL, 27),IHEL=1,5) / 1, -1, -1, 1, -1/ + DATA (NHEL(IHEL, 28),IHEL=1,5) / 1, -1, -1, 1, 1/ + DATA (NHEL(IHEL, 29),IHEL=1,5) / 1, -1, 0, -1, -1/ + DATA (NHEL(IHEL, 30),IHEL=1,5) / 1, -1, 0, -1, 1/ + DATA (NHEL(IHEL, 31),IHEL=1,5) / 1, -1, 0, 1, -1/ + DATA (NHEL(IHEL, 32),IHEL=1,5) / 1, -1, 0, 1, 1/ + DATA (NHEL(IHEL, 33),IHEL=1,5) / 1, -1, 1, -1, -1/ + DATA (NHEL(IHEL, 34),IHEL=1,5) / 1, -1, 1, -1, 1/ + DATA (NHEL(IHEL, 35),IHEL=1,5) / 1, -1, 1, 1, -1/ + DATA (NHEL(IHEL, 36),IHEL=1,5) / 1, -1, 1, 1, 1/ + DATA (NHEL(IHEL, 37),IHEL=1,5) / 1, 1, -1, -1, -1/ + DATA (NHEL(IHEL, 38),IHEL=1,5) / 1, 1, -1, -1, 1/ + DATA (NHEL(IHEL, 39),IHEL=1,5) / 1, 1, -1, 1, -1/ + DATA (NHEL(IHEL, 40),IHEL=1,5) / 1, 1, -1, 1, 1/ + DATA (NHEL(IHEL, 41),IHEL=1,5) / 1, 1, 0, -1, -1/ + DATA (NHEL(IHEL, 42),IHEL=1,5) / 1, 1, 0, -1, 1/ + DATA (NHEL(IHEL, 43),IHEL=1,5) / 1, 1, 0, 1, -1/ + DATA (NHEL(IHEL, 44),IHEL=1,5) / 1, 1, 0, 1, 1/ + DATA (NHEL(IHEL, 45),IHEL=1,5) / 1, 1, 1, -1, -1/ + DATA (NHEL(IHEL, 46),IHEL=1,5) / 1, 1, 1, -1, 1/ + DATA (NHEL(IHEL, 47),IHEL=1,5) / 1, 1, 1, 1, -1/ + DATA (NHEL(IHEL, 48),IHEL=1,5) / 1, 1, 1, 1, 1/ +C ---------- +C BEGIN CODE +C ---------- + SZJJ7 = 0d0 + NTRY=NTRY+1 + DO IHEL=1,NCOMB + IF (GOODHEL(IHEL) .OR. NTRY .LT. 10) THEN + T=ZJJ7(P1, P2, P3, P4, P5,NHEL(1,IHEL),IM1) + SZJJ7 = SZJJ7 + T + IF (T .GT. 0D0 .AND. .NOT. GOODHEL(IHEL)) THEN + GOODHEL(IHEL)=.TRUE. + ENDIF + ENDIF + ENDDO + SZJJ7 = SZJJ7 / 4D0 + END diff --git a/ISAJET/code/timer.F b/ISAJET/code/timer.F new file mode 100644 index 00000000000..ee0e5812f4e --- /dev/null +++ b/ISAJET/code/timer.F @@ -0,0 +1,56 @@ +#include "isajet/pilot.h" + SUBROUTINE TIMER(IT) +C +C CALL SYSTEM CPU CLOCK -- MACHINE DEPENDENT. +C IT=1 FOR RUN START TIME. +C IT=2 FOR RUN STOP TIME. +C +#include "isajet/itapes.inc" +#include "isajet/times.inc" + DIMENSION TIMES(2) + EQUIVALENCE (TIMES(1),TIME1) + DIMENSION TTT(2) +#if defined(CERNLIB_VAX) + INTEGER CPUTIM(2),ITMLST(4),NHSEC + EXTERNAL JPI$_CPUTIM +#endif +C +C DEFAULT IS TO RETURN ZERO. + TNOW=0. +#if (defined(CERNLIB_CDC))&&(defined(CERNLIB_NOCERN)) +C SECOND GIVES CPU TIME ON CDC. + CALL SECOND(TNOW) +#endif +#if (defined(CERNLIB_ETA))&&(defined(CERNLIB_NOCERN)) +C SECOND GIVES CPU TIME ON ETA. + TNOW=SECOND() +#endif +#if (defined(CERNLIB_IBMRT))&&(defined(CERNLIB_NOCERN)) +C MCLOCK GIVES CPU TIME ON IBM RS/6000. + TNOW=FLOAT(MCLOCK())/60. +#endif +#if (defined(CERNLIB_SGI))&&(defined(CERNLIB_NOCERN)) +C ETIME GIVES CPU TIME ON SILICON GRAPHICS. + TNOW=ETIME(TTT) +#endif +#if (defined(CERNLIB_SUN))&&(defined(CERNLIB_NOCERN)) +C ETIME GIVES CPU TIME ON SUN. + TNOW=ETIME(TTT) +#endif +#if (defined(CERNLIB_VAX))&&(defined(CERNLIB_NOCERN)) +C VAX HAS NO FORTRAN FUNCTION FOR CPU TIME. +C FOLLOWING PROVIDED BY T. KILLIAN + ITMLST(1)=ISHFT(%LOC(JPI$_CPUTIM),16)+4 + ITMLST(2)=%LOC(NHSEC) + ITMLST(3)=0 + ITMLST(4)=0 + CALL SYS$GETJPI(,,,ITMLST,,,) + TNOW=.01*NHSEC +#endif +#if defined(CERNLIB_CERN) + CALL TIMEST(1.E7) + CALL TIMEX(TNOW) +#endif + TIMES(IT)=TNOW + RETURN + END diff --git a/ISAJET/code/twojet.F b/ISAJET/code/twojet.F new file mode 100644 index 00000000000..339c43e3912 --- /dev/null +++ b/ISAJET/code/twojet.F @@ -0,0 +1,369 @@ +#include "isajet/pilot.h" + SUBROUTINE TWOJET +C +C Driving routine to generate initial parameters for jets, +C assuming zero initial transverse momentum, ie PT(1)=PT(2). +C +C Parameters are PT,YJ,PHI with P,YJ,XJ as dependent variables, +C where YJ=RAPIDITY, XJ=Feynman X. +C All parameters are stored in COMMON/JETPAR/. +C Cross section is called from NOGOOD. +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/idrun.inc" +#include "isajet/itapes.inc" +#include "isajet/keys.inc" +#include "isajet/mbpar.inc" +#include "isajet/pjets.inc" +#include "isajet/pinits.inc" +#include "isajet/jetlim.inc" +#include "isajet/ptpar.inc" +#include "isajet/jetpar.inc" +#include "isajet/primar.inc" +#include "isajet/partcl.inc" +#include "isajet/const.inc" +#include "isajet/jetsig.inc" +#include "isajet/totals.inc" +#include "isajet/isloop.inc" +#include "isajet/sstype.inc" +#include "isajet/xmssm.inc" +C + REAL ACOSH,XXX,WTFCN,PPP,RANF,SIGN,SGN,AMQ1,AMASS,AMQ2 + REAL PPLUS,PMINUS,PSUM3,PSUM4,PPL,PMN,SQ1,SQ2,ROOT,P1PL,P1MN + REAL P2PL,P2MN,AMI1,AMI2 + INTEGER NREJ,I,II,IS,IFL1,IFL2 + REAL X(2) + EQUIVALENCE (X(1),X1) + LOGICAL NOGOOD + LOGICAL YGENJ + INTEGER LISTJ(17),LISTW(4),LISTSS(85),LISTSM(30) +C +C SUSY IDENT codes from /SSTYPE/. (Fortran 77 allows - signs +C in parameter statements but not data statements.) + INTEGER MSUPL,MSDNL,MSSTL,MSCHL,MSBT1,MSTP1, + $MSUPR,MSDNR,MSSTR,MSCHR,MSBT2,MSTP2,MSW1,MSW2, + $MSNEL,MSEL,MSNML,MSMUL,MSNTL,MSTAU1,MSER,MSMUR,MSTAU2 + PARAMETER (MSUPL=-ISUPL) + PARAMETER (MSDNL=-ISDNL) + PARAMETER (MSSTL=-ISSTL) + PARAMETER (MSCHL=-ISCHL) + PARAMETER (MSBT1=-ISBT1) + PARAMETER (MSTP1=-ISTP1) + PARAMETER (MSUPR=-ISUPR) + PARAMETER (MSDNR=-ISDNR) + PARAMETER (MSSTR=-ISSTR) + PARAMETER (MSCHR=-ISCHR) + PARAMETER (MSBT2=-ISBT2) + PARAMETER (MSTP2=-ISTP2) + PARAMETER (MSW1=-ISW1) + PARAMETER (MSW2=-ISW2) + PARAMETER (MSNEL=-ISNEL) + PARAMETER (MSEL=-ISEL) + PARAMETER (MSNML=-ISNML) + PARAMETER (MSMUL=-ISMUL) + PARAMETER (MSNTL=-ISNTL) + PARAMETER (MSTAU1=-ISTAU1) + PARAMETER (MSER=-ISER) + PARAMETER (MSMUR=-ISMUR) + PARAMETER (MSTAU2=-ISTAU2) +C + DATA LISTSS/ISGL, + $ISUPL,MSUPL,ISDNL,MSDNL,ISSTL,MSSTL,ISCHL,MSCHL,ISBT1,MSBT1, + $ISTP1,MSTP1, + $ISUPR,MSUPR,ISDNR,MSDNR,ISSTR,MSSTR,ISCHR,MSCHR,ISBT2,MSBT2, + $ISTP2,MSTP2, + $ISW1,MSW1,ISW2,MSW2,ISZ1,ISZ2,ISZ3,ISZ4, + $ISNEL,MSNEL,ISEL,MSEL,ISNML,MSNML,ISMUL,MSMUL,ISNTL,MSNTL, + $ISTAU1,MSTAU1,ISER,MSER,ISMUR,MSMUR,ISTAU2,MSTAU2, + $9,1,-1,2,-2,3,-3,4,-4,5,-5,6,-6,11,-11,12,-12,13,-13, + $14,-14,15,-15,16,-16,10,80,-80,90,82,83,84,86,-86/ + DATA LISTSM/9,1,-1,2,-2,3,-3,4,-4,5,-5,6,-6,11,-11,12,-12,13,-13, + $14,-14,15,-15,16,-16,10,80,-80,90,81/ + DATA LISTJ/9,1,-1,2,-2,3,-3,4,-4,5,-5,6,-6,7,-7,8,-8/ + DATA LISTW/10,80,-80,90/ +C Inverse hyperbolic cosine function + ACOSH(XXX)=ALOG(XXX+SQRT(XXX**2-1.)) + WTFCN(PPP)=2.*PPP*PTGEN2*PTGEN3*PPP**((PTGEN3-1.)/PTGEN3) +C +C Initialize +C + NPTCL=0 + PHI(1)=PHIMIN(1)+(PHIMAX(1)-PHIMIN(1))*RANF() + PHI(2)=AMOD(PHI(1)+PI,2.*PI) + NREJ=-1 + SIGMA=0. + WT=1. + IF(.NOT.FIXPT(2)) GOTO 101 + FIXPT(1)=.TRUE. + PT(1)=PT(2) + 101 CONTINUE + IF(FIXPT(1)) GOTO 400 + DO 110 I=1,2 + IF(FIXP(I)) GOTO 200 + IF(FIXXJ(I)) GOTO 300 + 110 CONTINUE +C +C Genetate PT and YJ with no variables fixed +C + 111 NREJ=NREJ+1 + IF(NREJ.GT.NTRIES) GO TO 910 + SUMWT=SUMWT+SIGMA*WT/(NEVOLV*NFRGMN) + NKINPT=NKINPT+1 + SIGMA=0. + WT=1. +C Generate PT with a power law distribution + PT(1)=(PTGEN1+PTGEN2*RANF())**PTGEN3 + PT(2)=PT(1) + SIGMAX=PTFUN1*PT(1)**PTFUN2 +C GENERATE FLAT IN YJ, CALCULATE CORRESPONDING TH + DO 115 I=1,2 + IF(FIXYJ(I)) GOTO 115 + IF(.NOT.YGENJ(I)) GOTO 111 + 115 CONTINUE + DO 116 I=1,2 + P(I)=PT(I)/STH(I) + IF(P(I).LT.PMIN(I).OR.P(I).GT.PMAX(I)) GOTO 111 + XJ(I)=P(I)*CTH(I)/HALFE + IF(XJ(I).LT.XJMIN(I).OR.XJ(I).GT.XJMAX(I)) GOTO 111 + 116 CONTINUE + WT=WT*WTFCN(PT(1)) + IF(NOGOOD(1)) GOTO 111 + SUMWT=SUMWT+SIGMA*WT/(NEVOLV*NFRGMN) + NKEEP=NKEEP+1 + GO TO 500 +C +C Generate PT and YJ fixing P +C + 200 CONTINUE + II=3-I + 211 NREJ=NREJ+1 + IF(NREJ.GT.NTRIES) GO TO 910 + NKINPT=NKINPT+1 + WT=0. + IF(FIXYJ(I)) GOTO 212 +C Generate PT with a power law distribution + PT(1)=(PTGEN1+PTGEN2*RANF())**PTGEN3 + SIGMAX=PTFUN1*PT(1)**PTFUN2 + PT(2)=PT(1) +C Given PT, TH is fixed except for a sign + STH(I)=PT(I)/P(I) + SIGN=1.0 + IF(RANF().GT.0.5) SIGN=-1.0 + CTH(I)=SIGN*SQRT(1.-STH(I)**2) + TH(I)=ATAN2(STH(I),CTH(I)) + YJ(I)=-ALOG(TAN(TH(I)/2.)) + IF(YJ(I).LT.YJMIN(I).OR.YJ(I).GT.YJMAX(I)) GOTO 211 + GOTO 213 + 212 PT(1)=P(I)*STH(I) + 213 CONTINUE + XJ(I)=P(I)*CTH(I)/HALFE + IF(XJ(I).LT.XJMIN(I).OR.XJ(I).GT.XJMAX(I)) GOTO 211 + IF(FIXP(II)) GOTO 220 + IF(FIXXJ(II)) GOTO 230 + IF(FIXYJ(II)) GOTO 215 + IF(.NOT.YGENJ(II)) GOTO 211 + 215 CONTINUE + P(II)=PT(II)/STH(II) + IF(P(II).LT.PMIN(II).OR.P(II).GT.PMAX(II)) GOTO 211 + XJ(II)=P(II)*CTH(II)/HALFE + IF(XJ(II).LT.XJMIN(II).OR.XJ(II).GT.XJMAX(II)) GOTO 211 + GOTO 250 +220 STH(II)=PT(II)/P(II) + SGN=1.0 + IF(RANF().GT.0.5) SGN=-1.0 + CTH(II)=SGN*SQRT(1.-STH(II)**2) + TH(II)=ATAN2(STH(II),CTH(II)) + YJ(II)=-ALOG(TAN(TH(II)/2.)) + IF(YJ(II).LT.YJMIN(II).OR.YJ(II).GT.YJMAX(II)) GOTO 211 + XJ(II)=P(II)*CTH(II)/HALFE + IF(XJ(II).LT.XJMIN(II).OR.XJ(II).GT.XJMAX(II)) GOTO 211 + GOTO 250 + 230 TH(II)=ATAN2(PT(II),XJ(II)*HALFE) + YJ(II)=-ALOG(TAN(TH(II)/2.)) + IF(YJ(II).LT.YJMIN(II).OR.YJ(II).GT.YJMAX(II)) GOTO 211 + CTH(II)=COS(TH(II)) + STH(II)=SIN(TH(II)) + 250 CONTINUE + IF(NOGOOD(1)) GOTO 211 + NKEEP=NKEEP+1 + GO TO 500 +C +C Generate PT and YJ at fixed XJ +C + 300 CONTINUE + II=3-I + 311 NREJ=NREJ+1 + IF(NREJ.GT.NTRIES) GO TO 910 + NKINPT=NKINPT+1 + WT=0. +C Generate PT with a power law distribution + PT(1)=(PTGEN1+PTGEN2*RANF())**PTGEN3 + SIGMAX=PTFUN1*PT(1)**PTFUN2 + PT(2)=PT(1) + TH(I)=ATAN2(PT(I),XJ(I)*HALFE) + YJ(I)=-ALOG(TAN(TH(I)/2.)) + IF(YJ(I).LT.YJMIN(I).OR.YJ(I).GT.YJMAX(I)) GOTO 311 + CTH(I)=COS(TH(I)) + STH(I)=SIN(TH(I)) + P(I)=PT(I)/STH(I) + IF(FIXYJ(II)) GOTO 315 + IF(FIXP(II)) GOTO 314 + YJ(II)=YJMIN(II)+(YJMAX(II)-YJMIN(II))*RANF() + TH(II)=2.*ATAN(EXP(-YJ(II))) + CTH(II)=COS(TH(II)) + STH(II)=SIN(TH(II)) + GOTO 315 + 314 CONTINUE + STH(II)=PT(II)/P(II) + CTH(II)=SQRT(1.-STH(II)**2) + IF(RANF().GT.0.5) CTH(II)=-CTH(II) + TH(II)=ATAN2(STH(II),CTH(II)) + YJ(II)=-ALOG(TAN(TH(II)/2.)) + 315 CONTINUE + P(II)=PT(II)/STH(II) + XJ(II)=P(II)*CTH(II)/HALFE + IF(XJ(II).LT.XJMIN(II).OR.XJ(II).GT.XJMAX(II)) GOTO 311 + IF(NOGOOD(1)) GOTO 311 + NKEEP=NKEEP+1 + GO TO 500 +C +C Generate YJ at fixed PT +C + 400 CONTINUE + PT(2)=PT(1) + 411 NREJ=NREJ+1 + IF(NREJ.GT.NTRIES) GO TO 910 + NKINPT=NKINPT+1 + WT=0. + DO 415 I=1,2 + IF(FIXYJ(I)) GOTO 415 + IF(FIXP(I)) GOTO 413 + IF(.NOT.YGENJ(I)) GO TO 411 + GOTO 414 + 413 CONTINUE + IS=1 + IF(RANF().GT.0.5) IS=2 + CTH(I)=CTHS(IS,I) + TH(I)=THS(IS,I) + YJ(I)=YJS(IS,I) + 414 CONTINUE + P(I)=PT(I)/STH(I) + XJ(I)=P(I)*CTH(I)/HALFE + 415 CONTINUE + IF(NOGOOD(1)) GOTO 411 + NKEEP=NKEEP+1 +C +C Reset /JETPAR/ +C + 500 CONTINUE + IF(KEYS(1)) THEN + IFL1=LISTJ(JETTYP(1)) + IFL2=LISTJ(JETTYP(2)) + AMQ1=AMASS(IFL1) + AMQ2=AMASS(IFL2) + AMI1=AMASS(LISTJ(INITYP(1))) + AMI2=AMASS(LISTJ(INITYP(2))) + CALL TWOKIN(AMI1,AMI2,AMQ1,AMQ2) + ELSEIF(KEYS(5).OR.(KEYS(10).AND.GOMSSM)) THEN + IFL1=LISTSS(JETTYP(1)) + IFL2=LISTSS(JETTYP(2)) + AMQ1=AMASS(IFL1) + AMQ2=AMASS(IFL2) + CALL TWOKIN(0.,0.,AMQ1,AMQ2) + ELSEIF(KEYS(6)) THEN + IFL1=LISTW(JETTYP(1)) + IFL2=LISTW(JETTYP(2)) + AMQ1=AMASS(IFL1) + AMQ2=AMASS(IFL2) + CALL TWOKIN(0.,0.,AMQ1,AMQ2) + ELSEIF(KEYS(8)) THEN + IF(JETTYP(1).LE.13) THEN + IFL1=LISTJ(JETTYP(1)) + ELSE + IFL1=10 + ENDIF + IF(JETTYP(2).LE.13) THEN + IFL2=LISTJ(JETTYP(2)) + ELSE + IFL2=10 + ENDIF + AMQ1=AMASS(IFL1) + AMQ2=AMASS(IFL2) + CALL TWOKIN(0.,0.,AMQ1,AMQ2) + ELSEIF(KEYS(10).AND.(.NOT.GOMSSM)) THEN + IFL1=LISTSM(JETTYP(1)) + IFL2=LISTSM(JETTYP(2)) + AMQ1=AMASS(IFL1) + AMQ2=AMASS(IFL2) + CALL TWOKIN(0.,0.,AMQ1,AMQ2) + ENDIF +C +C Set PBEAM and PJETS +C + PBEAM(1)=(1.-X1)*HALFE + PBEAM(2)=(1.-X2)*HALFE + DO 501 I=1,2 + PJETS(3,I)=P(I)*CTH(I) + PJETS(1,I)=PT(I)*COS(PHI(I)) + PJETS(2,I)=PT(I)*SIN(PHI(I)) + IF(KEYS(1)) THEN + IDJETS(I)=LISTJ(JETTYP(I)) + ELSEIF(KEYS(5).OR.(KEYS(10).AND.GOMSSM)) THEN + IDJETS(I)=LISTSS(JETTYP(I)) + ELSEIF(KEYS(6)) THEN + IDJETS(I)=LISTW(JETTYP(I)) + ELSEIF(KEYS(8)) THEN + IDJETS(1)=IFL1 + IDJETS(2)=IFL2 + ELSEIF(KEYS(10)) THEN + IDJETS(I)=LISTSM(JETTYP(I)) + ENDIF + PJETS(5,I)=AMASS(IDJETS(I)) + PJETS(4,I)=SQRT(P(I)**2+PJETS(5,I)**2) + 501 CONTINUE +C +C Set PINITS +C + DO 600 I=1,2 + IDINIT(I)=LISTJ(INITYP(I)) + PINITS(5,I)=AMASS(IDINIT(I)) + PPLUS=X(I)*ECM + PMINUS=PINITS(5,I)**2/PPLUS + PINITS(4,I)=.5*(PPLUS+PMINUS) + PINITS(3,I)=.5*(PPLUS-PMINUS)*(3-2*I) + PINITS(2,I)=0. + PINITS(1,I)=0. +600 CONTINUE +C Calculate PINITS exactly. + PSUM3=PJETS(3,1)+PJETS(3,2) + PSUM4=PJETS(4,1)+PJETS(4,2) + IF(PSUM3.GT.0.) THEN + PPL=PSUM4+PSUM3 + PMN=SHAT/PPL + ELSE + PMN=PSUM4-PSUM3 + PPL=SHAT/PMN + ENDIF + SQ1=PINITS(5,1)**2 + SQ2=PINITS(5,2)**2 + ROOT=SQRT((PPL*PMN-SQ1-SQ2)**2-4.*SQ1*SQ2) + P1PL=(PPL*PMN+SQ1-SQ2+ROOT)/(2.*PMN) + P1MN=SQ1/P1PL + P2MN=(PPL*PMN+SQ2-SQ1+ROOT)/(2.*PPL) + P2PL=SQ2/P2MN + PINITS(4,1)=.5*(P1PL+P1MN) + PINITS(3,1)=.5*(P1PL-P1MN) + PINITS(4,2)=.5*(P2PL+P2MN) + PINITS(3,2)=.5*(P2PL-P2MN) + RETURN +C +C Error +C +910 CALL PRTEVT(0) + WRITE(ITLIS,1000) NREJ + 1000 FORMAT(//' IT IS TAKING MORE THAN',I5,' TRIES TO GENERATE AN', + $' EVENT. CHECK LIMITS OR INCREASE NTRIES.') + STOP 99 + END diff --git a/ISAJET/code/twokin.F b/ISAJET/code/twokin.F new file mode 100644 index 00000000000..4e2d7f9e3e8 --- /dev/null +++ b/ISAJET/code/twokin.F @@ -0,0 +1,65 @@ +#include "isajet/pilot.h" + SUBROUTINE TWOKIN(AMI1,AMI2,AM1,AM2) +C +C Given P,PT,TH,PHI, and initial and final masses AMI1, AMI2, +C AM1,AM2, set X1, X2, SHAT, etc. +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/primar.inc" +#include "isajet/jetpar.inc" +#include "isajet/qcdpar.inc" +#include "isajet/const.inc" +C + REAL AMI1,AMI2,AM1,AM2,P1PL,P1MN,P2PL,P2MN,E1,E2,PPL,PMN, + $ PI1PL,PI1MN,PI2PL,PI2MN,ANEFF,AMASS,ALAMFN +C + E1=SQRT(P(1)**2+AM1**2) + E2=SQRT(P(2)**2+AM2**2) +C +C For 32-bit machines must use large and small components +C carefully, with pbig*psmall = pt**2+am**2. +C + IF(CTH(1).GT.0.) THEN + P1PL=E1+P(1)*CTH(1) + P1MN=(PT(1)**2+AM1**2)/P1PL + ELSE + P1MN=E1-P(1)*CTH(1) + P1PL=(PT(1)**2+AM1**2)/P1MN + ENDIF + IF(CTH(2).GT.0.) THEN + P2PL=E2+P(2)*CTH(2) + P2MN=(PT(2)**2+AM2**2)/P2PL + ELSE + P2MN=E2-P(2)*CTH(2) + P2PL=(PT(2)**2+AM2**2)/P2MN + ENDIF +C +C Initial light cone momenta. Not symmetric if AMI1 /= AMI2. +C + PPL=P1PL+P2PL + PMN=P1MN+P2MN + SHAT=PPL*PMN + ALAMFN=SQRT((SHAT-AMI1**2-AMI2**2)**2-4.*(AMI1*AMI2)**2) + PI1PL=(SHAT+AMI1**2-AMI2**2+ALAMFN)/(2.*PMN) + PI1MN=AMI1**2/PI1PL + PI2MN=(SHAT+AMI2**2-AMI1**2+ALAMFN)/(2.*PPL) + PI2PL=AMI2**2/PI2MN + X1=PI1PL/ECM + X2=PI2MN/ECM +C +C t=(p1-pi1)**2, u=(p1-pi2)**2 +C + THAT=AM1**2+AMI1**2-P1PL*PI1MN-P1MN*PI1PL + UHAT=AM1**2+AMI2**2-P1PL*PI2MN-P1MN*PI2PL +C +C Q**2 variable from Field, Fox, Wolfram +C + QSQ=2.*SHAT*THAT*UHAT/(SHAT**2+THAT**2+UHAT**2) + QSQ=AMAX1(QSQ,(AM1+AM2)**2) + ANEFF=4.+QSQ/(QSQ+AMASS(5)**2)+QSQ/(QSQ+AMASS(6)**2) + ALFQSQ=12.*PI/((33.-2.*ANEFF)*ALOG(QSQ/ALAM2)) + RETURN + END diff --git a/ISAJET/code/visaje.F b/ISAJET/code/visaje.F new file mode 100644 index 00000000000..c52d44afbfe --- /dev/null +++ b/ISAJET/code/visaje.F @@ -0,0 +1,7 @@ +#include "isajet/pilot.h" + CHARACTER*40 FUNCTION VISAJE() +#include "isajet/idrun.inc" + VISAJE = ' ISAJET V7.51 10-MAY-2000 20:15:21' + IDVER = 751 + RETURN + END diff --git a/ISAJET/code/whiggs.F b/ISAJET/code/whiggs.F new file mode 100644 index 00000000000..584b60c3331 --- /dev/null +++ b/ISAJET/code/whiggs.F @@ -0,0 +1,231 @@ +#include "isajet/pilot.h" + SUBROUTINE WHIGGS +C +C Finish generation of whiggs events started bY TWOJET. +C Select W decay modes as allowed by WMODE1, WMODE2. +C Generate W decay angles and put vectors in PPAIR. +C +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/qcdpar.inc" +#include "isajet/jetpar.inc" +#include "isajet/primar.inc" +#include "isajet/q1q2.inc" +#include "isajet/jetsig.inc" +#include "isajet/const.inc" +#include "isajet/qsave.inc" +#include "isajet/wcon.inc" +#include "isajet/pjets.inc" +#include "isajet/pinits.inc" +#include "isajet/keys.inc" +#include "isajet/hcon.inc" +#include "isajet/wwpar.inc" +#include "isajet/xmssm.inc" +C + DIMENSION X(2),LIST(25),P1WCM(4),P2WCM(4),P1LAB(4),P2LAB(4) + 1,PBOOST(4) + EQUIVALENCE (X(1),X1) + DIMENSION JWWTYP(2) + REAL GVQ(2),GAQ(2),GVL(2),GAL(2) + REAL X,RND,RANF,CBRWW,AMASS,AM0,AM1,AM2, + $E1CM,E2CM,P12CM,CTHCM,STHCM,PHICM,CPHICM,SPHICM,P1WCM,P2WCM, + $PBOOST,P1LAB,P2LAB,ZHSIG,ZHMAX + INTEGER JWWTYP,JET,JWT,JQ,IQ1,IQ2,LIST,NREJ,NJ0,K + REAL BRANCH(12),SUMBR,BETAWH,GAMWH,PZWHCM,CTHD,WHSIG + INTEGER IDABS,IDABS1,IDABSJ,IDIABS +C + DATA LIST/9,1,-1,2,-2,3,-3,4,-4,5,-5,6,-6, + $11,-11,12,-12,13,-13,14,-14,15,-15,16,-16/ +C + GVQ(1)=.25-2*SIN2W/3. + GVQ(2)=-.25+SIN2W/3. + GAQ(1)=-.25 + GAQ(2)=.25 + GVL(1)=.25 + GVL(2)=-.25+SIN2W + GAL(1)=-.25 + GAL(2)=.25 + NPAIR=0 + IF(KEYS(10).AND..NOT.GOMSSM) THEN + JWWTYP(1)=JETTYP(1)-25 + JWWTYP(2)=JETTYP(2)-25 + ELSEIF(KEYS(10).AND.GOMSSM) THEN + JWWTYP(1)=JETTYP(1)-76 + JWWTYP(2)=JETTYP(2)-76 + ENDIF +C +C Select W decay modes and put in /JETSET/. First particle +C is always the fermion. + + DO 200 JET=1,2 + IDABS=IABS(IDJETS(JET)) + IF(IDABS.NE.80.AND.IDABS.NE.90) GO TO 200 + RND=RANF() + JWT=JWWTYP(JET) +C Must only consider allowed decays for this mass + SUMBR=0. + DO 201 JQ=1,12 + IQ1=2*JQ + IQ2=MATCH(IQ1,JWT) + IF(IQ2.EQ.0) THEN + BRANCH(JQ)=0. + GO TO 201 + ENDIF + AM1=AMASS(LIST(IQ1)) + AM2=AMASS(LIST(IQ2)) + IF(AM1+AM2.LT.PJETS(5,JET)) THEN + BRANCH(JQ)=RBRWW(JQ,JWT,JET) + SUMBR=SUMBR+BRANCH(JQ) + ELSE + BRANCH(JQ)=0. + ENDIF +201 CONTINUE + IF(SUMBR.LE.0.) GO TO 998 + DO 202 JQ=1,12 +202 BRANCH(JQ)=BRANCH(JQ)/SUMBR +C + CBRWW=0. + DO 210 JQ=1,12 + CBRWW=CBRWW+BRANCH(JQ) + IF(RND.GT.CBRWW) GO TO 210 + IQ1=2*JQ + IQ2=MATCH(IQ1,JWT) + IDPAIR(NPAIR+1)=LIST(IQ1) + IDPAIR(NPAIR+2)=LIST(IQ2) + PPAIR(5,NPAIR+1)=AMASS(LIST(IQ1)) + PPAIR(5,NPAIR+2)=AMASS(LIST(IQ2)) + JPAIR(NPAIR+1)=JET + JPAIR(NPAIR+2)=JET + NPAIR=NPAIR+2 + JQWW(JET)=JQ + GO TO 200 +210 CONTINUE +200 CONTINUE +C +C Generate decay uniformly in angle and put in PPAIR. +C Will check cross section later. +C + NREJ=0 +300 NJ0=2 + DO 310 JET=1,2 + IDABS=IABS(IDJETS(JET)) + IF(IDABS.NE.80.AND.IDABS.NE.90) GO TO 310 +C Construct W com momenta. + IDABSJ=IDABS + AM0=PJETS(5,JET) + AM1=PPAIR(5,NJ0-1) + AM2=PPAIR(5,NJ0) + E1CM=(AM0**2+AM1**2-AM2**2)/(2.*AM0) + E2CM=(AM0**2+AM2**2-AM1**2)/(2.*AM0) + P12CM=(AM0**2-AM1**2-AM2**2)**2-4.*(AM1*AM2)**2 + P12CM=SQRT(P12CM)/(2.*AM0) + CTHCM=2.*RANF()-1. + STHCM=SQRT(1.-CTHCM**2) + PHICM=2.*PI*RANF() + CPHICM=COS(PHICM) + SPHICM=SIN(PHICM) + P1WCM(1)=P12CM*STHCM*CPHICM + P2WCM(1)=-P1WCM(1) + P1WCM(2)=P12CM*STHCM*SPHICM + P2WCM(2)=-P1WCM(2) + P1WCM(3)=P12CM*CTHCM + P2WCM(3)=-P1WCM(3) + P1WCM(4)=E1CM + P2WCM(4)=E2CM +C Boost to lab frame. + DO 320 K=1,3 +320 PBOOST(K)=-PJETS(K,JET) + PBOOST(4)=PJETS(4,JET) + CALL LBOOST(PBOOST,1,P1WCM,P1LAB) + CALL LBOOST(PBOOST,1,P2WCM,P2LAB) + DO 330 K=1,4 + PPAIR(K,NJ0-1)=P1LAB(K) + PPAIR(K,NJ0)=P2LAB(K) +330 CONTINUE + NJ0=NJ0+2 +310 CONTINUE +C +C Impose simple (1+-cos(theta))**2 decay distribution for WH +C Must use P1 in WH CoM frame + IF (IDABSJ.NE.80.AND.IDABSJ.NE.90) GO TO 400 + BETAWH=(PJETS(3,1)+PJETS(3,2))/(PJETS(4,1)+PJETS(4,2)) + GAMWH=1./SQRT(1.-BETAWH**2) + PZWHCM=GAMWH*(P1LAB(3)-BETAWH*P1LAB(4)) + CTHD=PZWHCM/SQRT(P1LAB(1)**2+P1LAB(2)**2+PZWHCM**2) + IF (IDINIT(1).LT.0) CTHD=-CTHD + IDIABS=IABS(IDINIT(1)) + IDABS1=IABS(IDPAIR(1)) + IF (IDABSJ.EQ.80) THEN + WHSIG=(1.+CTHD)**2 + IF(WHSIG.GT.4*RANF()) GO TO 400 + END IF + IF (IDABSJ.EQ.90) THEN + IF (IDIABS.EQ.1.OR.IDIABS.EQ.4) THEN + IF (IDABS1.EQ.1.OR.IDABS1.EQ.4) THEN + ZHSIG=(GVQ(1)**2+GAQ(1)**2)**2*(1.+CTHD**2) + $ +8*GVQ(1)*GAQ(1)*GVQ(1)*GAQ(1)*CTHD + ZHMAX=2*(GVQ(1)**2+GAQ(1)**2)**2 + $ +8*GVQ(1)*GAQ(1)*GVQ(1)*GAQ(1) + ELSEIF (IDABS1.EQ.2.OR.IDABS1.EQ.3.OR.IDABS1.EQ.5) THEN + ZHSIG=(GVQ(1)**2+GAQ(1))*(GVQ(2)**2+GAQ(2)**2)*(1.+CTHD**2) + $ +8*GVQ(1)*GAQ(1)*GVQ(2)*GAQ(2)*CTHD + ZHMAX=(GVQ(1)**2+GAQ(1))*(GVQ(2)**2+GAQ(2)**2)*2 + $ +8*GVQ(1)*GAQ(1)*GVQ(2)*GAQ(2) + ELSEIF (IDABS1.EQ.11.OR.IDABS1.EQ.13.OR.IDABS1.EQ.15) THEN + ZHSIG=(GVQ(1)**2+GAQ(1))*(GVL(1)**2+GAL(1)**2)*(1.+CTHD**2) + $ +8*GVQ(1)*GAQ(1)*GVL(1)*GAL(1)*CTHD + ZHMAX=(GVQ(1)**2+GAQ(1))*(GVL(1)**2+GAL(1)**2)*2 + $ +8*GVQ(1)*GAQ(1)*GVL(1)*GAL(1) + ELSEIF (IDABS1.EQ.12.OR.IDABS1.EQ.14.OR.IDABS1.EQ.16) THEN + ZHSIG=(GVQ(1)**2+GAQ(1))*(GVL(2)**2+GAL(2)**2)*(1.+CTHD**2) + $ +8*GVQ(1)*GAQ(1)*GVL(2)*GAL(2)*CTHD + ZHMAX=(GVQ(1)**2+GAQ(1))*(GVL(2)**2+GAL(2)**2)*2 + $ +8*GVQ(1)*GAQ(1)*GVL(2)*GAL(2) + END IF + ELSE IF (IDIABS.EQ.2.OR.IDIABS.EQ.3.OR.IDIABS.EQ.5) THEN + IF (IDABS1.EQ.1.OR.IDABS1.EQ.4) THEN + ZHSIG=(GVQ(2)**2+GAQ(2)**2)**2*(1.+CTHD**2) + $ +8*GVQ(2)*GAQ(2)*GVQ(1)*GAQ(1)*CTHD + ZHMAX=(GVQ(2)**2+GAQ(2)**2)**2*2 + $ +8*GVQ(2)*GAQ(2)*GVQ(1)*GAQ(1) + ELSEIF (IDABS1.EQ.2.OR.IDABS1.EQ.3.OR.IDABS1.EQ.5) THEN + ZHSIG=(GVQ(2)**2+GAQ(2))*(GVQ(2)**2+GAQ(2)**2)*(1.+CTHD**2) + $ +8*GVQ(2)*GAQ(2)*GVQ(2)*GAQ(2)*CTHD + ZHMAX=(GVQ(2)**2+GAQ(2))*(GVQ(2)**2+GAQ(2)**2)*2 + $ +8*GVQ(2)*GAQ(2)*GVQ(2)*GAQ(2) + ELSEIF (IDABS1.EQ.11.OR.IDABS1.EQ.13.OR.IDABS1.EQ.15) THEN + ZHSIG=(GVQ(2)**2+GAQ(2))*(GVL(1)**2+GAL(1)**2)*(1.+CTHD**2) + $ +8*GVQ(2)*GAQ(2)*GVL(1)*GAL(1)*CTHD + ZHMAX=(GVQ(2)**2+GAQ(2))*(GVL(1)**2+GAL(1)**2)*2 + $ +8*GVQ(2)*GAQ(2)*GVL(1)*GAL(1) + ELSEIF (IDABS1.EQ.12.OR.IDABS1.EQ.14.OR.IDABS1.EQ.16) THEN + ZHSIG=(GVQ(2)**2+GAQ(2))*(GVL(2)**2+GAL(2)**2)*(1.+CTHD**2) + $ +8*GVQ(2)*GAQ(2)*GVL(2)*GAL(2)*CTHD + ZHMAX=(GVQ(2)**2+GAQ(2))*(GVL(2)**2+GAL(2)**2)*2 + $ +8*GVQ(2)*GAQ(2)*GVL(2)*GAL(2) + END IF + END IF + IF(ZHSIG.GT.RANF()*ZHMAX) GO TO 400 + END IF + NREJ=NREJ+1 + IF(NREJ.LT.NTRIES) GO TO 300 + GO TO 999 +C +C Good event +C +400 CONTINUE + RETURN +C +999 CALL PRTEVT(0) + WRITE(ITLIS,9991) NREJ +9991 FORMAT(//' IT IS TAKING MORE THAN',I5,' TRIES TO GENERATE ', + 1'A GOOD WHIGGS EVENT.'/' CHECK LIMITS OR INCREASE NTRIES.') + STOP 99 +998 CALL PRTEVT(0) + WRITE(ITLIS,9981) JET +9981 FORMAT(//' ERROR IN WHIGGS ... NO DECAY POSSIBLE FOR JET',I3) + STOP 99 + END diff --git a/ISAJET/code/wpair.F b/ISAJET/code/wpair.F new file mode 100644 index 00000000000..322714d1642 --- /dev/null +++ b/ISAJET/code/wpair.F @@ -0,0 +1,261 @@ +#include "isajet/pilot.h" + SUBROUTINE WPAIR +C +C Finish generation of wpair events started bY TWOJET. +C Select W decay modes as allowed by WMODE1, WMODE2. +C Generate W decay angles and put vectors in PPAIR. +C +C Also generate massless decay vectors PZERO for matrix +C element -- double precision for 32-bit machines. +C +C Ver 6.26: Check kinematics for W -> ff decay, since Z0 from +C Higgs decay can be virtual. +C Ver. 6.30: Added check in loop 201. +C Ver. 7.14: Add MSSM Higgs hooks +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/qcdpar.inc" +#include "isajet/jetpar.inc" +#include "isajet/primar.inc" +#include "isajet/q1q2.inc" +#include "isajet/jetsig.inc" +#include "isajet/wwsig.inc" +#include "isajet/wwpar.inc" +#include "isajet/const.inc" +#include "isajet/qsave.inc" +#include "isajet/wcon.inc" +#include "isajet/pjets.inc" +#include "isajet/pinits.inc" +#include "isajet/keys.inc" +#include "isajet/wsig.inc" +#include "isajet/hcon.inc" +#include "isajet/xmssm.inc" +C + DIMENSION X(2),LIST(25),P1WCM(4),P2WCM(4),P1LAB(4),P2LAB(4) + $,P1CM0(4),P2CM0(4),P1LAB0(4),P2LAB0(4) + 1,PBOOST(4) + EQUIVALENCE (X(1),X1) + DIMENSION PWW(5,2) + EQUIVALENCE (PWW(1,1),P3WW(1)) + DIMENSION JWWTYP(2),THWFF(2),PHIWFF(2) +#if defined(CERNLIB_SINGLE) + REAL P1CM0,P2CM0,DPHI,DCTH,DSTH,DAM0,PWW,BOOST +#endif +#if defined(CERNLIB_DOUBLE) + DOUBLE PRECISION P1CM0,P2CM0,DPHI,DCTH,DSTH,DAM0,PWW,BOOST +#endif + REAL AMWW1,AMWW2,X,STRUC,STRUCW,RND,RANF,CBRWW,AMASS,AM0,AM1,AM2, + $E1CM,E2CM,P12CM,CTHCM,STHCM,PHICM,CPHICM,SPHICM,P1WCM,P2WCM, + $PBOOST,P1LAB,P2LAB,AFX,SGWWMX,P1LAB0,P2LAB0,THWFF,PHIWFF + INTEGER IH,IQ,JWWTYP,JET,JWT,JQ,IQ1,IQ2,LIST,NREJ,NJ0,K + REAL BRANCH(12),SUMBR + INTEGER IDABS,IDABS1,IDABS2 +C + DATA LIST/9,1,-1,2,-2,3,-3,4,-4,5,-5,6,-6, + $11,-11,12,-12,13,-13,14,-14,15,-15,16,-16/ +C +C Initialize for given W type. + AMWW1=PJETS(5,1) + AMWW2=PJETS(5,2) + CALL WWKIN(AMWW1,AMWW2) + NPAIR=0 +C +C Calculate and save structure functions. + DO 120 IH=1,2 + DO 121 IQ=1,13 +121 QSAVE(IQ,IH)=STRUC(X(IH),QSQ,IQ,IDIN(IH))/X(IH) + DO 122 IQ=14,25 +122 QSAVE(IQ,IH)=0. + IF(KEYS(7).OR.KEYS(9)) THEN + DO 123 IQ=26,29 +123 QSAVE(IQ,IH)=STRUCW(X(IH),IQ-25,IDIN(IH))/X(IH) + ENDIF +120 CONTINUE +C JWWTYP points to W types 1,2,3,4 + IF(KEYS(6)) THEN + JWWTYP(1)=JETTYP(1) + JWWTYP(2)=JETTYP(2) + ELSEIF((KEYS(7).AND..NOT.GOMSSM).OR.KEYS(9)) THEN + JWWTYP(1)=JETTYP(1)-25 + JWWTYP(2)=JETTYP(2)-25 + ELSEIF(KEYS(7).AND.GOMSSM) THEN + JWWTYP(1)=JETTYP(1)-76 + JWWTYP(2)=JETTYP(2)-76 + ENDIF +C +C Select W decay modes and put in /JETSET/. First particle +C is always the fermion. + + DO 200 JET=1,2 + IDABS=IABS(IDJETS(JET)) + IF(IDABS.NE.80.AND.IDABS.NE.90) GO TO 200 + RND=RANF() + JWT=JWWTYP(JET) +C Must only consider allowed decays for this mass + SUMBR=0. + DO 201 JQ=1,12 + IQ1=2*JQ + IQ2=MATCH(IQ1,JWT) + IF(IQ2.EQ.0) THEN + BRANCH(JQ)=0. + GO TO 201 + ENDIF + AM1=AMASS(LIST(IQ1)) + AM2=AMASS(LIST(IQ2)) + IF(AM1+AM2.LT.PJETS(5,JET)) THEN + BRANCH(JQ)=RBRWW(JQ,JWT,JET) + SUMBR=SUMBR+BRANCH(JQ) + ELSE + BRANCH(JQ)=0. + ENDIF +201 CONTINUE + IF(SUMBR.LE.0.) GO TO 998 + DO 202 JQ=1,12 +202 BRANCH(JQ)=BRANCH(JQ)/SUMBR +C + CBRWW=0. + DO 210 JQ=1,12 + CBRWW=CBRWW+BRANCH(JQ) + IF(RND.GT.CBRWW) GO TO 210 + IQ1=2*JQ + IQ2=MATCH(IQ1,JWT) + IDPAIR(NPAIR+1)=LIST(IQ1) + IDPAIR(NPAIR+2)=LIST(IQ2) + PPAIR(5,NPAIR+1)=AMASS(LIST(IQ1)) + PPAIR(5,NPAIR+2)=AMASS(LIST(IQ2)) + JPAIR(NPAIR+1)=JET + JPAIR(NPAIR+2)=JET + NPAIR=NPAIR+2 + JQWW(JET)=JQ + GO TO 200 +210 CONTINUE +200 CONTINUE +C +C Generate decay uniformly in angle and put in PPAIR. +C Will check cross section later. +C + NREJ=0 +300 NJ0=2 + DO 310 JET=1,2 + IDABS=IABS(IDJETS(JET)) + IF(IDABS.NE.80.AND.IDABS.NE.90) GO TO 310 +C Construct W com momenta. + AM0=PJETS(5,JET) + AM1=PPAIR(5,NJ0-1) + AM2=PPAIR(5,NJ0) + E1CM=(AM0**2+AM1**2-AM2**2)/(2.*AM0) + E2CM=(AM0**2+AM2**2-AM1**2)/(2.*AM0) + P12CM=(AM0**2-AM1**2-AM2**2)**2-4.*(AM1*AM2)**2 + P12CM=SQRT(P12CM)/(2.*AM0) + CTHCM=2.*RANF()-1. + STHCM=SQRT(1.-CTHCM**2) + PHICM=2.*PI*RANF() + CPHICM=COS(PHICM) + SPHICM=SIN(PHICM) + P1WCM(1)=P12CM*STHCM*CPHICM + P2WCM(1)=-P1WCM(1) + P1WCM(2)=P12CM*STHCM*SPHICM + P2WCM(2)=-P1WCM(2) + P1WCM(3)=P12CM*CTHCM + P2WCM(3)=-P1WCM(3) + P1WCM(4)=E1CM + P2WCM(4)=E2CM +C Also construct zero mass vectors at same angle +#if defined(CERNLIB_SINGLE) +C Single precision. + P1CM0(1)=.5*AM0*STHCM*CPHICM + P2CM0(1)=-P1CM0(1) + P1CM0(2)=.5*AM0*STHCM*SPHICM + P2CM0(2)=-P1CM0(2) + P1CM0(3)=.5*AM0*CTHCM + P2CM0(3)=-P1CM0(3) + P1CM0(4)=.5*AM0 + P2CM0(4)=P1CM0(4) +#endif +#if defined(CERNLIB_DOUBLE) +C Double precision. + DAM0=AM0 + DCTH=CTHCM + DSTH=DSQRT(1.D0-DCTH**2) + DPHI=PHICM + P1CM0(1)=.5*AM0*DSTH*DCOS(DPHI) + P2CM0(1)=-P1CM0(1) + P1CM0(2)=.5*AM0*DSTH*DSIN(DPHI) + P2CM0(2)=-P1CM0(2) + P1CM0(3)=.5*AM0*DCTH + P2CM0(3)=-P1CM0(3) + P1CM0(4)=.5*AM0 + P2CM0(4)=P1CM0(4) +#endif +C Boost to lab frame. + DO 320 K=1,3 +320 PBOOST(K)=-PJETS(K,JET) + PBOOST(4)=PJETS(4,JET) + CALL LBOOST(PBOOST,1,P1WCM,P1LAB) + CALL LBOOST(PBOOST,1,P2WCM,P2LAB) + DO 330 K=1,4 + PPAIR(K,NJ0-1)=P1LAB(K) + PPAIR(K,NJ0)=P2LAB(K) +330 CONTINUE +C Boost zero mass vectors -- double precision for 32 bits. + PZERO(4,NJ0-1)=(P1CM0(4)*PWW(4,JET)+P1CM0(1)*PWW(1,JET) + $ +P1CM0(2)*PWW(2,JET)+P1CM0(3)*PWW(3,JET))/PWW(5,JET) + BOOST=(P1CM0(4)+PZERO(4,NJ0-1))/(PWW(4,JET)+PWW(5,JET)) + DO 340 K=1,3 +340 PZERO(K,NJ0-1)=P1CM0(K)+BOOST*PWW(K,JET) + PZERO(4,NJ0)=(P2CM0(4)*PWW(4,JET)+P2CM0(1)*PWW(1,JET) + $ +P2CM0(2)*PWW(2,JET)+P2CM0(3)*PWW(3,JET))/PWW(5,JET) + BOOST=(P2CM0(4)+PZERO(4,NJ0))/(PWW(4,JET)+PWW(5,JET)) + DO 350 K=1,3 +350 PZERO(K,NJ0)=P2CM0(K)+BOOST*PWW(K,JET) + NJ0=NJ0+2 +310 CONTINUE +C +C Calculate cross section SIGWW2 containing TBRWW*RBRWW. +C Compare with WW cross section containing TBRWW. Ratio +C must be bounded by 3/(4*PI) for each W. +C + AFX=3./(2.*PI) + IF(KEYS(6)) THEN + CALL SIGWW2 + SGWWMX=SIGEVT + IF(IDJETS(1).NE.10) SGWWMX=SGWWMX*RBRWW(JQWW(1),JWWTYP(1),1)*AFX + IF(IDJETS(2).NE.10) SGWWMX=SGWWMX*RBRWW(JQWW(2),JWWTYP(2),2)*AFX + ELSEIF(KEYS(7)) THEN +C Note that except for WW -> WW processes, SIGH3 just computes +C the decay angular distribution, so it can be used for both +C for SM and SUSY HL0/HH0 decays; HA0 -> WW is forbidden. +C For Z + HL0 decays, we just return, ie use phase space. + IDABS1=IABS(IDJETS(1)) + IDABS2=IABS(IDJETS(2)) + IF(.NOT.(IDABS1.EQ.10.OR.IDABS1.EQ.80.OR.IDABS1.EQ.90)) RETURN + IF(.NOT.(IDABS2.EQ.10.OR.IDABS2.EQ.80.OR.IDABS2.EQ.90)) RETURN + CALL SIGH3 + SGWWMX=SIGLLQ*AFX**2 + ELSEIF(KEYS(9)) THEN + CALL SIGTC3 + SGWWMX=SIGLLQ*AFX**2 + ENDIF + IF(WWSIG.GT.SGWWMX*RANF()) GO TO 400 + NREJ=NREJ+1 + IF(NREJ.LT.NTRIES) GO TO 300 + GO TO 999 +C +C Good event +C +400 CONTINUE + RETURN +C +999 CALL PRTEVT(0) + WRITE(ITLIS,9991) NREJ +9991 FORMAT(//' IT IS TAKING MORE THAN',I5,' TRIES TO GENERATE ', + 1'A GOOD WPAIR EVENT.'/' CHECK LIMITS OR INCREASE NTRIES.') + STOP 99 +998 CALL PRTEVT(0) + WRITE(ITLIS,9981) JET +9981 FORMAT(//' ERROR IN WPAIR ... NO DECAY POSSIBLE FOR JET',I3) + STOP 99 + END diff --git a/ISAJET/code/wwkin.F b/ISAJET/code/wwkin.F new file mode 100644 index 00000000000..701a2e92fd4 --- /dev/null +++ b/ISAJET/code/wwkin.F @@ -0,0 +1,43 @@ +#include "isajet/pilot.h" + SUBROUTINE WWKIN(AM1,AM2) +C WPAIR KINEMATICS, INCLUDING DOUBLE PRECISION CONVERSION FOR +C 32-BIT MACHINES. CONVENTION IS THAT SINGLE PRECISION MASSES +C AM1,AM2 ARE EXACT. +#include "isajet/itapes.inc" +#include "isajet/wwpar.inc" +#include "isajet/jetpar.inc" +C BASIC KINEMATICS FROM TWOKIN + CALL TWOKIN(0.,0.,AM1,AM2) +C WPAIR KINEMATICS -- JUST A COPY FOR CDC BUT CONSTRUCTS A +C CONSISTENT SET OF DOUBLE PRECISION VARIABLES FOR 32-BIT +C MACHINES. + P3WW(1)=PT(1)*COS(PHI(1)) + P3WW(2)=PT(1)*SIN(PHI(1)) + P3WW(3)=P(1)*CTH(1) + P3WW(5)=AM1 + P4WW(1)=-P3WW(1) + P4WW(2)=-P3WW(2) + P4WW(3)=P(2)*CTH(2) + P4WW(5)=AM2 +#if defined(CERNLIB_SINGLE) + P3WW(4)=SQRT(P3WW(1)**2+P3WW(2)**2+P3WW(3)**2+P3WW(5)**2) + P4WW(4)=SQRT(P4WW(1)**2+P4WW(2)**2+P4WW(3)**2+P4WW(5)**2) +#endif +#if defined(CERNLIB_DOUBLE) + P3WW(4)=DSQRT(P3WW(1)**2+P3WW(2)**2+P3WW(3)**2+P3WW(5)**2) + P4WW(4)=DSQRT(P4WW(1)**2+P4WW(2)**2+P4WW(3)**2+P4WW(5)**2) +#endif + P1WW(1)=0. + P1WW(2)=0. + P1WW(4)=.5*(P3WW(4)+P3WW(3)+P4WW(4)+P4WW(3)) + P1WW(3)=P1WW(4) + P2WW(1)=0. + P2WW(2)=0. + P2WW(4)=.5*(P3WW(4)-P3WW(3)+P4WW(4)-P4WW(3)) + P2WW(3)=-P2WW(4) +C INVARIANTS + SWW=+2.*(P1WW(4)*P2WW(4)-P1WW(3)*P2WW(3)) + TWW=-2.*(P1WW(4)*P3WW(4)-P1WW(3)*P3WW(3))+P3WW(5)**2 + UWW=-2.*(P2WW(4)*P3WW(4)-P2WW(3)*P3WW(3))+P3WW(5)**2 + RETURN + END diff --git a/ISAJET/code/wwss.F b/ISAJET/code/wwss.F new file mode 100644 index 00000000000..bb5477f5f1c --- /dev/null +++ b/ISAJET/code/wwss.F @@ -0,0 +1,55 @@ +#include "isajet/pilot.h" + FUNCTION WWSS(T,U,T1,U1,T3,U3) +C DECAY DISTRIBUTION FOR W+ W- PAIRS FROM SCHOONSCHIP(1980). +C SQUARE OF S GRAPH. +#include "isajet/itapes.inc" +#include "isajet/wwpar.inc" +#if defined(CERNLIB_DOUBLE) + DOUBLE PRECISION WWSS + DOUBLE PRECISION T,U,T1,U1,T3,U3 + DOUBLE PRECISION CV2A2 +#endif + CV2A2=CV**2+CA**2 + WWSS= + 1 +CV*CA*T*(-64.*T1*U1*T3+64.*T1*U1*U3+64.*T1*T3*U3+64.*T1*T3**2-6 + 1 4.*T1**2*T3-64.*U1*T3*U3-64.*U1*U3**2+64.*U1**2*U3) + 1 +CV*CA*T*U*(-128.*T1*U3-64.*T1*S13+128.*U1*T3+64.*U1*S13+64.*T3* + 1 S13-64.*U3*S13) + 1 +CV*CA*T*WM2*(128.*T1*U3+64.*T1*S13-64.*T1**2-128.*U1*T3+64.*U1* + 1 S13+64.*U1**2-64.*T3*S13+64.*T3**2-64.*U3*S13-64.*U3**2) + 1 +CV*CA*T**2*(-64.*T1*U3-64.*T1*S13+64.*U1*T3+64.*T3*S13) + 1 +CV*CA*U*(-64.*T1*U1*T3+64.*T1*U1*U3+64.*T1*T3*U3+64.*T1*T3**2-6 + 1 4.*T1**2*T3-64.*U1*T3*U3-64.*U1*U3**2+64.*U1**2*U3) + WWSS=WWSS + 1 +CV*CA*U*WM2*(128.*T1*U3-64.*T1*S13-64.*T1**2-128.*U1*T3-64.*U1* + 1 S13+64.*U1**2+64.*T3*S13+64.*T3**2+64.*U3*S13-64.*U3**2) + 1 +CV*CA*U**2*(-64.*T1*U3+64.*U1*T3+64.*U1*S13-64.*U3*S13) + 1 +CV*CA*WM2*(128.*T1*U1*T3-128.*T1*U1*U3-128.*T1*T3*U3-128.*T1*T3 + 1 **2+128.*T1**2*T3+128.*U1*T3*U3+128.*U1*U3**2-128.*U1**2*U3) + 1 +CV*CA*WM2**2*(128.*T1*S13+128.*T1**2-128.*U1*S13-128.*U1**2-128 + 1 .*T3*S13-128.*T3**2+128.*U3*S13+128.*U3**2) + 1 +CV2A2*(128.*T1*U1*T3*U3-64.*T1**2*T3**2-64.*U1**2*U3**2) + WWSS=WWSS + 1 +CV2A2*T*(-32.*T1*U1*T3-32.*T1*U1*U3-32.*T1*T3*U3-64.*T1*T3*S13+ + 1 32.*T1*T3**2+32.*T1**2*T3-32.*U1*T3*U3+64.*U1*U3*S13+32.*U1*U3** + 1 2+32.*U1**2*U3) + 1 +CV2A2*T*U*(64.*T1*U3+32.*T1*S13+64.*U1*T3+32.*U1*S13+32.*T3*S13 + 1 +32.*U3*S13+64.*S13**2) + 1 +CV2A2*T*WM2*(-64.*T1*U3-32.*T1*S13+32.*T1**2-64.*U1*T3+32.*U1*S + 1 13+32.*U1**2-32.*T3*S13+32.*T3**2+32.*U3*S13+32.*U3**2) + 1 +CV2A2*T**2*(32.*T1*U3+32.*T1*S13+32.*U1*T3+32.*T3*S13) + WWSS=WWSS + 1 +CV2A2*U*(-32.*T1*U1*T3-32.*T1*U1*U3-32.*T1*T3*U3+64.*T1*T3*S13+ + 1 32.*T1*T3**2+32.*T1**2*T3-32.*U1*T3*U3-64.*U1*U3*S13+32.*U1*U3** + 1 2+32.*U1**2*U3) + 1 +CV2A2*U*WM2*(-64.*T1*U3+32.*T1*S13+32.*T1**2-64.*U1*T3-32.*U1*S + 1 13+32.*U1**2+32.*T3*S13+32.*T3**2-32.*U3*S13+32.*U3**2) + 1 +CV2A2*U**2*(32.*T1*U3+32.*U1*T3+32.*U1*S13+32.*U3*S13) + 1 +CV2A2*WM2*(64.*T1*U1*T3+64.*T1*U1*U3+64.*T1*T3*U3-64.*T1*T3**2- + 1 64.*T1**2*T3+64.*U1*T3*U3-64.*U1*U3**2-64.*U1**2*U3) + WWSS=WWSS + 1 +CV2A2*WM2**2*(-64.*T1*S13-64.*T1**2-64.*U1*S13-64.*U1**2-64.*T3 + 1 *S13-64.*T3**2-64.*U3*S13-64.*U3**2-64.*S13**2) + WWSS=2.*WWSS + RETURN + END diff --git a/ISAJET/code/wwst.F b/ISAJET/code/wwst.F new file mode 100644 index 00000000000..3b6c80d0395 --- /dev/null +++ b/ISAJET/code/wwst.F @@ -0,0 +1,64 @@ +#include "isajet/pilot.h" + FUNCTION WWST(T,U,T1,U1,T3,U3,P1,P2) +C DECAY DISTRIBUTION FOR W+ W- PAIRS FROM SCHOONSCHIP(1980). +C INTERFERENCE OF T AND S GRAPHS. +#include "isajet/itapes.inc" +#include "isajet/wwpar.inc" + DIMENSION P1(4),P2(4) +#if defined(CERNLIB_DOUBLE) + DOUBLE PRECISION WWST + DOUBLE PRECISION T,U,T1,U1,T3,U3,P1,P2 + DOUBLE PRECISION CVACQ,EPF +#endif + CVACQ=(CV+CA)*CQ + WWST= + 1 +CVACQ*(-256.*T1*U1*T3*U3+256.*T1**2*T3**2) + 1 +CVACQ*T*(256.*T1*U1*T3+256.*T1*T3*S13-256.*T1*T3**2+128.*U1*T3* + 1 U3-128.*U1*U3*S13-128.*U1**2*U3) + 1 +CVACQ*T*U*(-256.*U1*T3-128.*U1*S13-128.*T3*S13-128.*S13**2) + 1 +CVACQ*T*WM2*(384.*U1*T3-128.*U1*S13-128.*U1**2+256.*T3*S13-256. + 1 *T3**2) + 1 +CVACQ*T**2*(-256.*U1*T3-256.*T3*S13) + 1 +CVACQ*U*(128.*T1*U1*T3-128.*T1*T3*S13-128.*T1*T3**2) + WWST=WWST + 1 +CVACQ*U*WM2*(128.*U1*T3-128.*T3*S13-128.*T3**2) + 1 +CVACQ*WM2*(-256.*T1*U1*T3+512.*T1*T3**2-256.*U1*T3*U3) + 1 +CVACQ*WM2**2*(256.*U1*S13+128.*U1**2+256.*T3*S13+384.*T3**2+128 + 1 .*S13**2) + 1 +EPF(P1,P2,P3,Q1)*CVACQ*(128.*T3*U3+128.*T3*S13+64.*T3**2+128.*U + 1 3*S13+64.*U3**2) + 1 +EPF(P1,P2,P3,Q1)*CVACQ*T*(-32.*T3-32.*U3-64.*S13) + 1 -32.*EPF(P1,P2,P3,Q1)*CVACQ*T*WM2 + WWST=WWST + 1 +EPF(P1,P2,P3,Q1)*CVACQ*U*(-32.*T3-32.*U3-64.*S13) + 1 -32.*EPF(P1,P2,P3,Q1)*CVACQ*U*WM2 + 1 +EPF(P1,P2,P3,Q1)*CVACQ*WM2*(128.*T3+128.*U3+128.*S13) + 1 +64.*EPF(P1,P2,P3,Q1)*CVACQ*WM2**2 + 1 -32.*EPF(P1,P2,P3,Q3)*CVACQ*T*WM2 + 1 -32.*EPF(P1,P2,P3,Q3)*CVACQ*U*WM2 + 1 +EPF(P1,P2,P3,Q3)*CVACQ*WM2*(64.*T3+64.*U3) + 1 +64.*EPF(P1,P2,P3,Q3)*CVACQ*WM2**2 + WWST=WWST + 1 +EPF(P1,P3,Q1,Q3)*CVACQ*(128.*U1*T3+128.*U1*U3) + 1 +EPF(P1,P3,Q1,Q3)*CVACQ*T*(-64.*U1) + 1 +32.*EPF(P1,P3,Q1,Q3)*CVACQ*T*U + 1 -32.*EPF(P1,P3,Q1,Q3)*CVACQ*T*WM2 + 1 +EPF(P1,P3,Q1,Q3)*CVACQ*U*(-64.*U1-64.*T3-64.*U3) + 1 -96.*EPF(P1,P3,Q1,Q3)*CVACQ*U*WM2 + 1 +32.*EPF(P1,P3,Q1,Q3)*CVACQ*U**2 + 1 +EPF(P1,P3,Q1,Q3)*CVACQ*WM2*(128.*U1+64.*T3+64.*U3) + WWST=WWST + 1 +64.*EPF(P1,P3,Q1,Q3)*CVACQ*WM2**2 + 1 +EPF(P2,P3,Q1,Q3)*CVACQ*(-128.*T1*T3-128.*T1*U3) + 1 +EPF(P2,P3,Q1,Q3)*CVACQ*T*(64.*T1+64.*T3+64.*U3) + 1 -32.*EPF(P2,P3,Q1,Q3)*CVACQ*T*U + 1 +96.*EPF(P2,P3,Q1,Q3)*CVACQ*T*WM2 + 1 -32.*EPF(P2,P3,Q1,Q3)*CVACQ*T**2 + 1 +EPF(P2,P3,Q1,Q3)*CVACQ*U*(64.*T1) + 1 +32.*EPF(P2,P3,Q1,Q3)*CVACQ*U*WM2 + 1 +EPF(P2,P3,Q1,Q3)*CVACQ*WM2*(-128.*T1-64.*T3-64.*U3) + 1 -64.*EPF(P2,P3,Q1,Q3)*CVACQ*WM2**2 + WWST=WWST/T + WWST=2.*WWST + RETURN + END diff --git a/ISAJET/code/wwtt.F b/ISAJET/code/wwtt.F new file mode 100644 index 00000000000..fe2458d1e91 --- /dev/null +++ b/ISAJET/code/wwtt.F @@ -0,0 +1,20 @@ +#include "isajet/pilot.h" + FUNCTION WWTT(T,U,T1,U1,T3,U3) +C DECAY DISTRIBUTION FOR W+ W- PAIRS FROM SCHOONSCHIP(1980). +C SQUARE OF T GRAPH. +#include "isajet/itapes.inc" +#include "isajet/wwpar.inc" +#if defined(CERNLIB_DOUBLE) + DOUBLE PRECISION WWTT + DOUBLE PRECISION T,U,T1,U1,T3,U3 +#endif + WWTT= + 1(+CQ**2*(-512.*T1**2*T3**2) + 1 +CQ**2*T*(-512.*T1*U1*T3-512.*T1*T3*S13+512.*T1*T3**2) + 1 +CQ**2*T*WM2*(-512.*U1*T3-512.*T3*S13+512.*T3**2) + 1 +CQ**2*T**2*(512.*U1*T3+512.*T3*S13) + 1 +CQ**2*WM2*(-1024.*T1*T3**2) + 1 +CQ**2*WM2**2*(-512.*T3**2))/T**2 + WWTT=2.*WWTT + RETURN + END diff --git a/ISAJET/code/wzss.F b/ISAJET/code/wzss.F new file mode 100644 index 00000000000..65047268414 --- /dev/null +++ b/ISAJET/code/wzss.F @@ -0,0 +1,78 @@ +#include "isajet/pilot.h" + FUNCTION WZSS(T,U,T1,U1,T3,U3,P1,P2) +C DECAY DISTRIBUTION FOR W- Z0 PAIRS FROM SCHOONSCHIP(1980). +C SQUARE OF S GRAPH. +#include "isajet/itapes.inc" +#include "isajet/wwpar.inc" + DIMENSION P1(4),P2(4) +#if defined(CERNLIB_DOUBLE) + DOUBLE PRECISION WZSS + DOUBLE PRECISION T,U,T1,U1,T3,U3,P1,P2 + DOUBLE PRECISION WM4,ZM4,WZM2,CSXCS +#endif + WM4=WM2**2 + ZM4=ZM2**2 + WZM2=WM2*ZM2 + CSXCS=CS**2 + WZSS= + 1 +CSXCS*CV3*(-32.*WM2*ZM2*WM4-32.*WM2*ZM2*ZM4-128.*WM2*T1*T3**2-1 + 1 28.*WM2*T1*ZM4+128.*WM2*U1*T3*U3-64.*WM2*T3*ZM4-64.*WM2*S13*ZM4+ + 1 64.*ZM2*T1*U1*T3+64.*ZM2*T1*U1*U3-64.*ZM2*T1*WM4-64.*ZM2*T1**2*T + 1 3-64.*ZM2*U1**2*U3-128.*ZM2*T3*WM4-64.*ZM2*S13*WM4+128.*T1*U1*T3 + 1 *U3-192.*T1*T3*WZM2-64.*T1*S13*WZM2-64.*T1**2*T3**2-32.*T1**2*WZ + 1 M2-32.*T1**2*ZM4+64.*U1*U3*WZM2-64.*U1*S13*WZM2-64.*U1**2*U3**2- + 1 32.*U1**2*WZM2-32.*U1**2*ZM4-128.*T3*S13*WZM2-64.*T3**2*WZM2-64. + 1 *T3**2*WM4-64.*S13**2*WZM2-96.*WM4*ZM4) + WZSS=WZSS + 1 +CSXCS*CV3*T*(64.*WM2*T1*T3-32.*WM2*U1*T3-32.*WM2*U1*U3-64.*WM2* + 1 T3*S13+64.*WM2*T3**2+96.*WM2*ZM4+64.*ZM2*T1*T3-32.*ZM2*T1*S13+32 + 1 .*ZM2*T1**2-32.*ZM2*U1*T3-32.*ZM2*U1*U3+32.*ZM2*U1*S13+32.*ZM2*U + 1 1**2+96.*ZM2*WM4-32.*T1*U1*T3-32.*T1*U1*U3-64.*T1*T3*S13+64.*T1* + 1 T3**2+128.*T1*WZM2+32.*T1*ZM4+32.*T1**2*T3-64.*U1*T3*U3+64.*U1*U + 1 3*S13+32.*U1**2*U3+128.*T3*WZM2+32.*T3*WM4+32.*S13*WZM2) + + WZSS=WZSS + 1 +CSXCS*CV3*T*U*(-32.*WM2*T3+32.*WM2*S13-32.*ZM2*T1+32.*ZM2*S13-3 + 1 2.*T1*T3+32.*T1*S13+64.*U1*T3+32.*U1*U3+32.*U1*S13+64.*T3*S13+64 + 1 .*S13**2-32.*WZM2) + 1 +CSXCS*CV3*T**2*(-32.*WM2*T3+32.*WM2*S13-32.*ZM2*T1+32.*ZM2*S13- + 1 32.*T1*T3+32.*T1*S13+32.*U1*T3+32.*U1*U3+64.*T3*S13-64.*WZM2) + 1 +CSXCS*CV3*T**2*U*(-32.*S13) + 1 +CSXCS*CV3*T**3*(-32.*S13) + WZSS=WZSS + 1 +CSXCS*CV3*U*(64.*WM2*T1*T3-32.*WM2*U1*T3-32.*WM2*U1*U3+64.*WM2* + 1 T3*S13+64.*WM2*T3**2+32.*WM2*ZM4+64.*ZM2*T1*T3+32.*ZM2*T1*S13+32 + 1 .*ZM2*T1**2-32.*ZM2*U1*T3-32.*ZM2*U1*U3-32.*ZM2*U1*S13+32.*ZM2*U + 1 1**2+32.*ZM2*WM4-32.*T1*U1*T3-32.*T1*U1*U3+64.*T1*T3*S13+64.*T1* + 1 T3**2+64.*T1*WZM2+32.*T1*ZM4+32.*T1**2*T3-64.*U1*T3*U3-64.*U1*U3 + 1 *S13+32.*U1**2*U3+64.*T3*WZM2+32.*T3*WM4+32.*S13*WZM2) + 1 +CSXCS*CV3*U**2*(32.*U1*T3+32.*U1*S13) + WZSS=WZSS + 1 +CSXCS*CA3*(32.*WM2*ZM2*WM4+32.*WM2*ZM2*ZM4+128.*WM2*T1*ZM4+64.* + 1 WM2*T3*ZM4+64.*WM2*S13*ZM4+64.*ZM2*T1*U1*T3-64.*ZM2*T1*U1*U3+64. + 1 *ZM2*T1*WM4+64.*ZM2*T1**2*T3-64.*ZM2*U1**2*U3+128.*ZM2*T3*WM4+64 + 1 .*ZM2*S13*WM4+192.*T1*T3*WZM2+64.*T1*S13*WZM2+32.*T1**2*WZM2+32. + 1 *T1**2*ZM4-64.*U1*U3*WZM2-64.*U1*S13*WZM2-32.*U1**2*WZM2-32.*U1* + 1 *2*ZM4+96.*WM4*ZM4) + WZSS=WZSS + 1 +CSXCS*CA3*T*(-64.*WM2*T1*T3-32.*WM2*U1*T3+32.*WM2*U1*U3-96.*WM2 + 1 *ZM4-64.*ZM2*T1*T3+32.*ZM2*T1*S13-32.*ZM2*T1**2-32.*ZM2*U1*T3+32 + 1 .*ZM2*U1*U3+32.*ZM2*U1*S13+32.*ZM2*U1**2-96.*ZM2*WM4-32.*T1*U1*T + 1 3+32.*T1*U1*U3-128.*T1*WZM2-32.*T1*ZM4-32.*T1**2*T3+32.*U1**2*U3 + 1 -128.*T3*WZM2-32.*T3*WM4-32.*S13*WZM2) + 1 +CSXCS*CA3*T*U*(32.*WM2*T3-32.*WM2*S13+32.*ZM2*T1-32.*ZM2*S13+32 + 1 .*T1*T3-32.*T1*S13+64.*U1*T3-32.*U1*U3+32.*U1*S13+32.*WZM2) + WZSS=WZSS + 1 +CSXCS*CA3*T**2*(32.*WM2*T3-32.*WM2*S13+32.*ZM2*T1-32.*ZM2*S13+3 + 1 2.*T1*T3-32.*T1*S13+32.*U1*T3-32.*U1*U3+64.*WZM2) + 1 +CSXCS*CA3*T**2*U*(32.*S13) + 1 +CSXCS*CA3*T**3*(32.*S13) + WZSS=WZSS + 1 +CSXCS*CA3*U*(-64.*WM2*T1*T3-32.*WM2*U1*T3+32.*WM2*U1*U3-32.*WM2 + 1 *ZM4-64.*ZM2*T1*T3-32.*ZM2*T1*S13-32.*ZM2*T1**2-32.*ZM2*U1*T3+32 + 1 .*ZM2*U1*U3-32.*ZM2*U1*S13+32.*ZM2*U1**2-32.*ZM2*WM4-32.*T1*U1*T + 1 3+32.*T1*U1*U3-64.*T1*WZM2-32.*T1*ZM4-32.*T1**2*T3+32.*U1**2*U3- + 1 64.*T3*WZM2-32.*T3*WM4-32.*S13*WZM2) + 1 +CSXCS*CA3*U**2*(32.*U1*T3+32.*U1*S13) + RETURN + END diff --git a/ISAJET/code/wzst.F b/ISAJET/code/wzst.F new file mode 100644 index 00000000000..edbf09b6b97 --- /dev/null +++ b/ISAJET/code/wzst.F @@ -0,0 +1,94 @@ +#include "isajet/pilot.h" + FUNCTION WZST(T,U,T1,U1,T3,U3,P1,P2) +C DECAY DISTRIBUTION FOR W- Z0 PAIRS FROM SCHOONSCHIP(1980). +C INTERFERENCE OF S AND T GRAPHS. +#include "isajet/itapes.inc" +#include "isajet/wwpar.inc" + DIMENSION P1(4),P2(4) +#if defined(CERNLIB_DOUBLE) + DOUBLE PRECISION WZST + DOUBLE PRECISION T,U,T1,U1,T3,U3,P1,P2 + DOUBLE PRECISION WM4,ZM4,WZM2,CSXCT,EPF +#endif + WM4=WM2**2 + ZM4=ZM2**2 + WZM2=WM2*ZM2 + CSXCT=CS*CT/T + WZST= + 1 +CSXCT*CV3*(32.*WM2*ZM2*WM4+32.*WM2*ZM2*ZM4+256.*WM2*T1*T3**2+19 + 1 2.*WM2*T1*ZM4-128.*WM2*U1*T3*U3+64.*WM2*T3*ZM4+64.*WM2*S13*ZM4-6 + 1 4.*ZM2*T1*U1*T3-64.*ZM2*T1*U1*U3+64.*ZM2*T1*WM4+128.*ZM2*T1**2*T + 1 3+192.*ZM2*T3*WM4+64.*ZM2*S13*WM4-128.*T1*U1*T3*U3+320.*T1*T3*WZ + 1 M2+64.*T1*S13*WZM2+128.*T1**2*T3**2+32.*T1**2*WZM2+64.*T1**2*ZM4 + 1 -64.*U1*U3*WZM2+64.*U1*S13*WZM2+32.*U1**2*WZM2+128.*T3*S13*WZM2+ + 1 64.*T3**2*WZM2+128.*T3**2*WM4+64.*S13**2*WZM2+128.*WM4*ZM4) + WZST=WZST + 1 +CSXCT*CV3*T*(-128.*WM2*T1*T3+64.*WM2*U1*T3+32.*WM2*U1*U3+128.*W + 1 M2*T3*S13-128.*WM2*T3**2-128.*WM2*ZM4-128.*ZM2*T1*T3+64.*ZM2*T1* + 1 S13-64.*ZM2*T1**2+32.*ZM2*U1*T3+32.*ZM2*U1*U3-32.*ZM2*U1*S13-32. + 1 *ZM2*U1**2-128.*ZM2*WM4+64.*T1*U1*T3+32.*T1*U1*U3+128.*T1*T3*S13 + 1 -128.*T1*T3**2-192.*T1*WZM2-64.*T1*ZM4-64.*T1**2*T3+64.*U1*T3*U3 + 1 -64.*U1*U3*S13-32.*U1**2*U3-192.*T3*WZM2-64.*T3*WM4) + WZST=WZST + 1 +CSXCT*CV3*T*U*(32.*WM2*T3-32.*WM2*S13+32.*ZM2*T1-32.*ZM2*S13+32 + 1 .*T1*T3-32.*T1*S13-64.*U1*T3-32.*U1*S13-64.*T3*S13-64.*S13**2+32 + 1 .*WZM2) + 1 +CSXCT*CV3*T**2*(64.*WM2*T3-64.*WM2*S13+64.*ZM2*T1-64.*ZM2*S13+6 + 1 4.*T1*T3-64.*T1*S13-64.*U1*T3-32.*U1*U3-128.*T3*S13+96.*WZM2) + 1 +CSXCT*CV3*T**2*U*(32.*S13) + WZST=WZST + 1 +CSXCT*CV3*T**3*(64.*S13) + 1 +CSXCT*CV3*U*(-64.*WM2*T1*T3+32.*WM2*U1*T3-64.*WM2*T3*S13-64.*WM + 1 2*T3**2-32.*WM2*ZM4-64.*ZM2*T1*T3-32.*ZM2*T1*S13-32.*ZM2*T1**2-3 + 1 2.*ZM2*WM4+32.*T1*U1*T3-64.*T1*T3*S13-64.*T1*T3**2-64.*T1*WZM2-3 + 1 2.*T1*ZM4-32.*T1**2*T3-64.*T3*WZM2-32.*T3*WM4-32.*S13*WZM2) + WZST=WZST + 1 +CSXCT*CA3*(-32.*WM2*ZM2*WM4-32.*WM2*ZM2*ZM4-192.*WM2*T1*ZM4-64. + 1 *WM2*T3*ZM4-64.*WM2*S13*ZM4-64.*ZM2*T1*U1*T3+64.*ZM2*T1*U1*U3-64 + 1 .*ZM2*T1*WM4-128.*ZM2*T1**2*T3-192.*ZM2*T3*WM4-64.*ZM2*S13*WM4-3 + 1 20.*T1*T3*WZM2-64.*T1*S13*WZM2-32.*T1**2*WZM2-64.*T1**2*ZM4+64.* + 1 U1*U3*WZM2+64.*U1*S13*WZM2+32.*U1**2*WZM2-128.*WM4*ZM4) + WZST=WZST + 1 +CSXCT*CA3*T*(128.*WM2*T1*T3+64.*WM2*U1*T3-32.*WM2*U1*U3+128.*WM + 1 2*ZM4+128.*ZM2*T1*T3-64.*ZM2*T1*S13+64.*ZM2*T1**2+32.*ZM2*U1*T3- + 1 32.*ZM2*U1*U3-32.*ZM2*U1*S13-32.*ZM2*U1**2+128.*ZM2*WM4+64.*T1*U + 1 1*T3-32.*T1*U1*U3+192.*T1*WZM2+64.*T1*ZM4+64.*T1**2*T3-32.*U1**2 + 1 *U3+192.*T3*WZM2+64.*T3*WM4) + WZST=WZST + 1 +CSXCT*CA3*T*U*(-32.*WM2*T3+32.*WM2*S13-32.*ZM2*T1+32.*ZM2*S13-3 + 1 2.*T1*T3+32.*T1*S13-64.*U1*T3-32.*U1*S13-32.*WZM2) + 1 +CSXCT*CA3*T**2*(-64.*WM2*T3+64.*WM2*S13-64.*ZM2*T1+64.*ZM2*S13- + 1 64.*T1*T3+64.*T1*S13-64.*U1*T3+32.*U1*U3-96.*WZM2) + 1 +CSXCT*CA3*T**2*U*(-32.*S13) + 1 +CSXCT*CA3*T**3*(-64.*S13) + WZST=WZST + 1 +CSXCT*CA3*U*(64.*WM2*T1*T3+32.*WM2*U1*T3+32.*WM2*ZM4+64.*ZM2*T1 + 1 *T3+32.*ZM2*T1*S13+32.*ZM2*T1**2+32.*ZM2*WM4+32.*T1*U1*T3+64.*T1 + 1 *WZM2+32.*T1*ZM4+32.*T1**2*T3+64.*T3*WZM2+32.*T3*WM4+32.*S13*WZM + 1 2) + 1 +EPF(P1,P2,P3,Q1)*CSXCT*CV3*(64.*ZM2*T3+64.*ZM2*U3+64.*ZM2*S13+6 + 1 4.*T3*U3+64.*T3*S13+32.*T3**2+64.*U3*S13+32.*U3**2+32.*ZM4) + WZST=WZST + 1 +EPF(P1,P2,P3,Q1)*CSXCT*CV3*T*(-16.*ZM2-16.*T3-16.*U3-32.*S13) + 1 +EPF(P1,P2,P3,Q1)*CSXCT*CV3*U*(-16.*ZM2-16.*T3-16.*U3-32.*S13) + 1 +EPF(P1,P2,P3,Q3)*CSXCT*CV3*(32.*WM2*T3+32.*WM2*U3+32.*WZM2) + 1 +EPF(P1,P2,P3,Q3)*CSXCT*CV3*T*(-16.*WM2) + 1 +EPF(P1,P2,P3,Q3)*CSXCT*CV3*U*(-16.*WM2) + 1 +EPF(P1,P3,Q1,Q3)*CSXCT*CV3*(32.*WM2*T3+32.*WM2*U3+64.*ZM2*U1+64 + 1 .*U1*T3+64.*U1*U3+32.*WZM2) + WZST=WZST + 1 +EPF(P1,P3,Q1,Q3)*CSXCT*CV3*T*(-16.*WM2-32.*U1) + 1 +16.*EPF(P1,P3,Q1,Q3)*CSXCT*CV3*T*U + 1 +EPF(P1,P3,Q1,Q3)*CSXCT*CV3*U*(-16.*WM2-32.*ZM2-32.*U1-32.*T3-32 + 1 .*U3) + 1 +16.*EPF(P1,P3,Q1,Q3)*CSXCT*CV3*U**2 + 1 +EPF(P2,P3,Q1,Q3)*CSXCT*CV3*(-32.*WM2*T3-32.*WM2*U3-64.*ZM2*T1-6 + 1 4.*T1*T3-64.*T1*U3-32.*WZM2) + WZST=WZST + 1 +EPF(P2,P3,Q1,Q3)*CSXCT*CV3*T*(16.*WM2+32.*ZM2+32.*T1+32.*T3+32. + 1 *U3) + 1 -16.*EPF(P2,P3,Q1,Q3)*CSXCT*CV3*T*U + 1 -16.*EPF(P2,P3,Q1,Q3)*CSXCT*CV3*T**2 + 1 +EPF(P2,P3,Q1,Q3)*CSXCT*CV3*U*(16.*WM2+32.*T1) + RETURN + END diff --git a/ISAJET/code/wzsu.F b/ISAJET/code/wzsu.F new file mode 100644 index 00000000000..30c7f75104e --- /dev/null +++ b/ISAJET/code/wzsu.F @@ -0,0 +1,101 @@ +#include "isajet/pilot.h" + FUNCTION WZSU(T,U,T1,U1,T3,U3,P1,P2) +C DECAY DISTRIBUTION FOR W- Z0 PAIRS FROM SCHOONSCHIP(1980). +C INTERFERENCE OF S AND U GRAPHS. +#include "isajet/itapes.inc" +#include "isajet/wwpar.inc" + DIMENSION P1(4),P2(4) +#if defined(CERNLIB_DOUBLE) + DOUBLE PRECISION WZSU + DOUBLE PRECISION T,U,T1,U1,T3,U3,P1,P2 + DOUBLE PRECISION WM4,ZM4,WZM2,CSXCU,EPF +#endif + WM4=WM2**2 + ZM4=ZM2**2 + WZM2=WM2*ZM2 + CSXCU=CS*CU/U + WZSU= + 1 +CSXCU*CV3*(-32.*WM2*ZM2*WM4-32.*WM2*ZM2*ZM4-64.*WM2*T1*ZM4+128. + 1 *WM2*U1*T3*U3-64.*WM2*T3*ZM4-64.*WM2*S13*ZM4+64.*ZM2*T1*U1*T3+64 + 1 .*ZM2*T1*U1*U3-64.*ZM2*T1*WM4-128.*ZM2*U1**2*U3-64.*ZM2*T3*WM4-6 + 1 4.*ZM2*S13*WM4+128.*T1*U1*T3*U3-64.*T1*T3*WZM2-64.*T1*S13*WZM2-3 + 1 2.*T1**2*WZM2+64.*U1*U3*WZM2-64.*U1*S13*WZM2-128.*U1**2*U3**2-32 + 1 .*U1**2*WZM2-64.*U1**2*ZM4-128.*T3*S13*WZM2-64.*T3**2*WZM2-64.*S + 1 13**2*WZM2-64.*WM4*ZM4) + WZSU=WZSU + 1 +CSXCU*CV3*T*(-32.*WM2*U1*U3+64.*WM2*ZM4-32.*ZM2*U1*T3-32.*ZM2*U + 1 1*U3+32.*ZM2*U1*S13+32.*ZM2*U1**2+64.*ZM2*WM4-32.*T1*U1*U3+64.*T + 1 1*WZM2-64.*U1*T3*U3+64.*U1*U3*S13+32.*U1**2*U3+64.*T3*WZM2+64.*S + 1 13*WZM2) + 1 +CSXCU*CV3*T*U*(-32.*WM2*T3+32.*WM2*S13-32.*ZM2*T1+32.*ZM2*S13-3 + 1 2.*T1*T3+32.*T1*S13+64.*U1*T3+64.*U1*U3+32.*U1*S13+64.*T3*S13+64 + 1 .*S13**2-32.*WZM2) + WZSU=WZSU + 1 +CSXCU*CV3*T**2*(32.*U1*U3-32.*WZM2) + 1 +CSXCU*CV3*T**2*U*(-32.*S13) + WZSU=WZSU + 1 +CSXCU*CV3*U*(64.*WM2*T1*T3-32.*WM2*U1*T3-64.*WM2*U1*U3+64.*WM2* + 1 T3*S13+64.*WM2*T3**2+32.*WM2*ZM4+64.*ZM2*T1*T3+32.*ZM2*T1*S13+32 + 1 .*ZM2*T1**2-64.*ZM2*U1*T3-64.*ZM2*U1*U3-64.*ZM2*U1*S13+64.*ZM2*U + 1 1**2+32.*ZM2*WM4-32.*T1*U1*T3-64.*T1*U1*U3+64.*T1*T3*S13+64.*T1* + 1 T3**2+64.*T1*WZM2+32.*T1*ZM4+32.*T1**2*T3-128.*U1*T3*U3-128.*U1* + 1 U3*S13+64.*U1**2*U3+64.*T3*WZM2+32.*T3*WM4+32.*S13*WZM2) + WZSU=WZSU + 1 +CSXCU*CV3*U**2*(64.*U1*T3+64.*U1*S13) + 1 +CSXCU*CA3*(32.*WM2*ZM2*WM4+32.*WM2*ZM2*ZM4+64.*WM2*T1*ZM4+64.*W + 1 M2*T3*ZM4+64.*WM2*S13*ZM4+64.*ZM2*T1*U1*T3-64.*ZM2*T1*U1*U3+64.* + 1 ZM2*T1*WM4-128.*ZM2*U1**2*U3+64.*ZM2*T3*WM4+64.*ZM2*S13*WM4+64.* + 1 T1*T3*WZM2+64.*T1*S13*WZM2+32.*T1**2*WZM2-64.*U1*U3*WZM2-64.*U1* + 1 S13*WZM2-32.*U1**2*WZM2-64.*U1**2*ZM4+64.*WM4*ZM4) + WZSU=WZSU + 1 +CSXCU*CA3*T*(32.*WM2*U1*U3-64.*WM2*ZM4-32.*ZM2*U1*T3+32.*ZM2*U1 + 1 *U3+32.*ZM2*U1*S13+32.*ZM2*U1**2-64.*ZM2*WM4+32.*T1*U1*U3-64.*T1 + 1 *WZM2+32.*U1**2*U3-64.*T3*WZM2-64.*S13*WZM2) + 1 +CSXCU*CA3*T*U*(32.*WM2*T3-32.*WM2*S13+32.*ZM2*T1-32.*ZM2*S13+32 + 1 .*T1*T3-32.*T1*S13+64.*U1*T3-64.*U1*U3+32.*U1*S13+32.*WZM2) + 1 +CSXCU*CA3*T**2*(-32.*U1*U3+32.*WZM2) + WZSU=WZSU + 1 +CSXCU*CA3*T**2*U*(32.*S13) + 1 +CSXCU*CA3*U*(-64.*WM2*T1*T3-32.*WM2*U1*T3+64.*WM2*U1*U3-32.*WM2 + 1 *ZM4-64.*ZM2*T1*T3-32.*ZM2*T1*S13-32.*ZM2*T1**2-64.*ZM2*U1*T3+64 + 1 .*ZM2*U1*U3-64.*ZM2*U1*S13+64.*ZM2*U1**2-32.*ZM2*WM4-32.*T1*U1*T + 1 3+64.*T1*U1*U3-64.*T1*WZM2-32.*T1*ZM4-32.*T1**2*T3+64.*U1**2*U3- + 1 64.*T3*WZM2-32.*T3*WM4-32.*S13*WZM2) + WZSU=WZSU + 1 +CSXCU*CA3*U**2*(64.*U1*T3+64.*U1*S13) + 1 +EPF(P1,P2,P3,Q1)*CSXCU*CV3*(32.*ZM2*T1+32.*ZM2*U1+32.*WZM2) + 1 +EPF(P1,P2,P3,Q1)*CSXCU*CV3*T*(-16.*ZM2) + 1 +EPF(P1,P2,P3,Q1)*CSXCU*CV3*U*(-16.*ZM2) + 1 +EPF(P1,P2,P3,Q3)*CSXCU*CV3*(64.*WM2*T1+64.*WM2*U1+64.*WM2*S13+6 + 1 4.*T1*U1+64.*T1*S13+32.*T1**2+64.*U1*S13+32.*U1**2+32.*WM4) + WZSU=WZSU + 1 +EPF(P1,P2,P3,Q3)*CSXCU*CV3*T*(-16.*WM2-16.*T1-16.*U1-32.*S13) + 1 +EPF(P1,P2,P3,Q3)*CSXCU*CV3*U*(-16.*WM2-16.*T1-16.*U1-32.*S13) + 1 +EPF(P1,P2,Q1,Q3)*CSXCU*CV3*(64.*WM2*T3+64.*WM2*U3+64.*ZM2*T1+64 + 1 .*ZM2*U1+64.*T1*T3+64.*T1*U3+64.*U1*T3+64.*U1*U3+64.*WZM2) + 1 +EPF(P1,P2,Q1,Q3)*CSXCU*CV3*T*(-32.*WM2-32.*ZM2-32.*T1-32.*U1-32 + 1 .*T3-32.*U3) + WZSU=WZSU + 1 +32.*EPF(P1,P2,Q1,Q3)*CSXCU*CV3*T*U + 1 +16.*EPF(P1,P2,Q1,Q3)*CSXCU*CV3*T**2 + 1 +EPF(P1,P2,Q1,Q3)*CSXCU*CV3*U*(-32.*WM2-32.*ZM2-32.*T1-32.*U1-32 + 1 .*T3-32.*U3) + 1 +16.*EPF(P1,P2,Q1,Q3)*CSXCU*CV3*U**2 + 1 +EPF(P1,P3,Q1,Q3)*CSXCU*CV3*(-64.*WM2*T3-32.*ZM2*T1-32.*ZM2*U1-6 + 1 4.*T1*T3-64.*U1*T3-32.*WZM2) + WZSU=WZSU + 1 +EPF(P1,P3,Q1,Q3)*CSXCU*CV3*T*(32.*WM2+16.*ZM2+32.*T1+32.*U1+32. + 1 *T3) + 1 -16.*EPF(P1,P3,Q1,Q3)*CSXCU*CV3*T*U + 1 -16.*EPF(P1,P3,Q1,Q3)*CSXCU*CV3*T**2 + 1 +EPF(P1,P3,Q1,Q3)*CSXCU*CV3*U*(16.*ZM2+32.*T3) + 1 +EPF(P2,P3,Q1,Q3)*CSXCU*CV3*(64.*WM2*U3+32.*ZM2*T1+32.*ZM2*U1+64 + 1 .*T1*U3+64.*U1*U3+32.*WZM2) + WZSU=WZSU + 1 +EPF(P2,P3,Q1,Q3)*CSXCU*CV3*T*(-16.*ZM2-32.*U3) + 1 +16.*EPF(P2,P3,Q1,Q3)*CSXCU*CV3*T*U + 1 +EPF(P2,P3,Q1,Q3)*CSXCU*CV3*U*(-32.*WM2-16.*ZM2-32.*T1-32.*U1-32 + 1 .*U3) + 1 +16.*EPF(P2,P3,Q1,Q3)*CSXCU*CV3*U**2 + RETURN + END diff --git a/ISAJET/code/wztu.F b/ISAJET/code/wztu.F new file mode 100644 index 00000000000..07513f227fc --- /dev/null +++ b/ISAJET/code/wztu.F @@ -0,0 +1,121 @@ +#include "isajet/pilot.h" + FUNCTION WZTU(T,U,T1,U1,T3,U3,P1,P2) +C DECAY DISTRIBUTION FOR W- Z0 PAIRS FROM SCHOONSCHIP(1980). +C ALL T AND U GRAPH TERMS. +#include "isajet/itapes.inc" +#include "isajet/wwpar.inc" + DIMENSION P1(4),P2(4) +#if defined(CERNLIB_DOUBLE) + DOUBLE PRECISION WZTU + DOUBLE PRECISION T,U,T1,U1,T3,U3,P1,P2 + DOUBLE PRECISION WM4,ZM4,WZM2,CTXCT,CTXCU,CUXCU,EPF +#endif + WM4=WM2**2 + ZM4=ZM2**2 + WZM2=WM2*ZM2 + CTXCT=CT**2/T**2 + CTXCU=CT*CU/(T*U) + CUXCU=CU**2/U**2 + WZTU= + 1 +CTXCT*CV3*(-128.*WM2*T1*T3**2-64.*WM2*T1*ZM4-64.*ZM2*T1**2*T3-6 + 1 4.*ZM2*T3*WM4-128.*T1*T3*WZM2-64.*T1**2*T3**2-32.*T1**2*ZM4-64.* + 1 T3**2*WM4-32.*WM4*ZM4) + WZTU=WZTU + 1 +CTXCT*CV3*T*(64.*WM2*T1*T3-32.*WM2*U1*T3-64.*WM2*T3*S13+64.*WM2 + 1 *T3**2+32.*WM2*ZM4+64.*ZM2*T1*T3-32.*ZM2*T1*S13+32.*ZM2*T1**2+32 + 1 .*ZM2*WM4-32.*T1*U1*T3-64.*T1*T3*S13+64.*T1*T3**2+64.*T1*WZM2+32 + 1 .*T1*ZM4+32.*T1**2*T3+64.*T3*WZM2+32.*T3*WM4-32.*S13*WZM2) + 1 +CTXCT*CV3*T**2*(-32.*WM2*T3+32.*WM2*S13-32.*ZM2*T1+32.*ZM2*S13- + 1 32.*T1*T3+32.*T1*S13+32.*U1*T3+64.*T3*S13-32.*WZM2) + WZTU=WZTU + 1 +CTXCT*CV3*T**3*(-32.*S13) + 1 +CTXCT*CA3*(64.*WM2*T1*ZM4+64.*ZM2*T1**2*T3+64.*ZM2*T3*WM4+128.* + 1 T1*T3*WZM2+32.*T1**2*ZM4+32.*WM4*ZM4) + 1 +CTXCT*CA3*T*(-64.*WM2*T1*T3-32.*WM2*U1*T3-32.*WM2*ZM4-64.*ZM2*T + 1 1*T3+32.*ZM2*T1*S13-32.*ZM2*T1**2-32.*ZM2*WM4-32.*T1*U1*T3-64.*T + 1 1*WZM2-32.*T1*ZM4-32.*T1**2*T3-64.*T3*WZM2-32.*T3*WM4+32.*S13*WZ + 1 M2) + WZTU=WZTU + 1 +CTXCT*CA3*T**2*(32.*WM2*T3-32.*WM2*S13+32.*ZM2*T1-32.*ZM2*S13+3 + 1 2.*T1*T3-32.*T1*S13+32.*U1*T3+32.*WZM2) + 1 +CTXCT*CA3*T**3*(32.*S13) + WZTU=WZTU + 1 +CTXCU*CV3*(32.*WM2*ZM2*WM4+32.*WM2*ZM2*ZM4+64.*WM2*T1*ZM4-128.* + 1 WM2*U1*T3*U3+64.*WM2*T3*ZM4+64.*WM2*S13*ZM4-64.*ZM2*T1*U1*T3-64. + 1 *ZM2*T1*U1*U3+64.*ZM2*T1*WM4+64.*ZM2*T3*WM4+64.*ZM2*S13*WM4-128. + 1 *T1*U1*T3*U3+64.*T1*T3*WZM2+64.*T1*S13*WZM2+32.*T1**2*WZM2-64.*U + 1 1*U3*WZM2+64.*U1*S13*WZM2+32.*U1**2*WZM2+128.*T3*S13*WZM2+64.*T3 + 1 **2*WZM2+64.*S13**2*WZM2+64.*WM4*ZM4) + WZTU=WZTU + 1 +CTXCU*CV3*T*(32.*WM2*U1*U3-64.*WM2*ZM4+32.*ZM2*U1*T3+32.*ZM2*U1 + 1 *U3-32.*ZM2*U1*S13-32.*ZM2*U1**2-64.*ZM2*WM4+32.*T1*U1*U3-64.*T1 + 1 *WZM2+64.*U1*T3*U3-64.*U1*U3*S13-32.*U1**2*U3-64.*T3*WZM2-64.*S1 + 1 3*WZM2) + 1 +CTXCU*CV3*T*U*(32.*WM2*T3-32.*WM2*S13+32.*ZM2*T1-32.*ZM2*S13+32 + 1 .*T1*T3-32.*T1*S13-64.*U1*T3-32.*U1*S13-64.*T3*S13-64.*S13**2+32 + 1 .*WZM2) + WZTU=WZTU + 1 +CTXCU*CV3*T**2*(-32.*U1*U3+32.*WZM2) + 1 +CTXCU*CV3*T**2*U*(32.*S13) + 1 +CTXCU*CV3*U*(-64.*WM2*T1*T3+32.*WM2*U1*T3-64.*WM2*T3*S13-64.*WM + 1 2*T3**2-32.*WM2*ZM4-64.*ZM2*T1*T3-32.*ZM2*T1*S13-32.*ZM2*T1**2-3 + 1 2.*ZM2*WM4+32.*T1*U1*T3-64.*T1*T3*S13-64.*T1*T3**2-64.*T1*WZM2-3 + 1 2.*T1*ZM4-32.*T1**2*T3-64.*T3*WZM2-32.*T3*WM4-32.*S13*WZM2) + WZTU=WZTU + 1 +CTXCU*CA3*(-32.*WM2*ZM2*WM4-32.*WM2*ZM2*ZM4-64.*WM2*T1*ZM4-64.* + 1 WM2*T3*ZM4-64.*WM2*S13*ZM4-64.*ZM2*T1*U1*T3+64.*ZM2*T1*U1*U3-64. + 1 *ZM2*T1*WM4-64.*ZM2*T3*WM4-64.*ZM2*S13*WM4-64.*T1*T3*WZM2-64.*T1 + 1 *S13*WZM2-32.*T1**2*WZM2+64.*U1*U3*WZM2+64.*U1*S13*WZM2+32.*U1** + 1 2*WZM2-64.*WM4*ZM4) + WZTU=WZTU + 1 +CTXCU*CA3*T*(-32.*WM2*U1*U3+64.*WM2*ZM4+32.*ZM2*U1*T3-32.*ZM2*U + 1 1*U3-32.*ZM2*U1*S13-32.*ZM2*U1**2+64.*ZM2*WM4-32.*T1*U1*U3+64.*T + 1 1*WZM2-32.*U1**2*U3+64.*T3*WZM2+64.*S13*WZM2) + 1 +CTXCU*CA3*T*U*(-32.*WM2*T3+32.*WM2*S13-32.*ZM2*T1+32.*ZM2*S13-3 + 1 2.*T1*T3+32.*T1*S13-64.*U1*T3-32.*U1*S13-32.*WZM2) + 1 +CTXCU*CA3*T**2*(32.*U1*U3-32.*WZM2) + WZTU=WZTU + 1 +CTXCU*CA3*T**2*U*(-32.*S13) + 1 +CTXCU*CA3*U*(64.*WM2*T1*T3+32.*WM2*U1*T3+32.*WM2*ZM4+64.*ZM2*T1 + 1 *T3+32.*ZM2*T1*S13+32.*ZM2*T1**2+32.*ZM2*WM4+32.*T1*U1*T3+64.*T1 + 1 *WZM2+32.*T1*ZM4+32.*T1**2*T3+64.*T3*WZM2+32.*T3*WM4+32.*S13*WZM + 1 2) + 1 +CUXCU*CV3*(-64.*ZM2*U1**2*U3-64.*U1**2*U3**2-32.*U1**2*ZM4) + WZTU=WZTU + 1 +CUXCU*CV3*T*U*(32.*U1*U3) + 1 +CUXCU*CV3*U*(-32.*WM2*U1*U3-32.*ZM2*U1*T3-32.*ZM2*U1*U3-32.*ZM2 + 1 *U1*S13+32.*ZM2*U1**2-32.*T1*U1*U3-64.*U1*T3*U3-64.*U1*U3*S13+32 + 1 .*U1**2*U3) + 1 +CUXCU*CV3*U**2*(32.*U1*T3+32.*U1*S13) + 1 +CUXCU*CA3*(-64.*ZM2*U1**2*U3-32.*U1**2*ZM4) + WZTU=WZTU + 1 +CUXCU*CA3*T*U*(-32.*U1*U3) + 1 +CUXCU*CA3*U*(32.*WM2*U1*U3-32.*ZM2*U1*T3+32.*ZM2*U1*U3-32.*ZM2* + 1 U1*S13+32.*ZM2*U1**2+32.*T1*U1*U3+32.*U1**2*U3) + 1 +CUXCU*CA3*U**2*(32.*U1*T3+32.*U1*S13) + 1 +EPF(P1,P2,P3,Q1)*CTXCU*CV3*(-32.*ZM2*T1-16.*WZM2) + 1 +EPF(P1,P2,P3,Q1)*CTXCU*CV3*T*(16.*ZM2) + WZTU=WZTU + 1 +EPF(P1,P2,P3,Q3)*CTXCU*CV3*(-48.*WM2*T1-16.*WM2*U1-32.*WM2*S13- + 1 32.*T1*U1-64.*T1*S13-32.*T1**2-16.*WM4) + 1 +EPF(P1,P2,P3,Q3)*CTXCU*CV3*T*(16.*WM2+16.*T1+16.*U1+32.*S13) + 1 +EPF(P1,P2,Q1,Q3)*CTXCU*CV3*(-32.*WM2*T3-32.*WM2*U3-64.*ZM2*T1-6 + 1 4.*T1*T3-64.*T1*U3-32.*WZM2) + 1 +EPF(P1,P2,Q1,Q3)*CTXCU*CV3*T*(16.*WM2+32.*ZM2+32.*T1+32.*T3+32. + 1 *U3) + WZTU=WZTU + 1 -16.*EPF(P1,P2,Q1,Q3)*CTXCU*CV3*T*U + 1 -16.*EPF(P1,P2,Q1,Q3)*CTXCU*CV3*T**2 + 1 +EPF(P1,P2,Q1,Q3)*CTXCU*CV3*U*(16.*WM2+32.*T1) + 1 +EPF(P1,P3,Q1,Q3)*CTXCU*CV3*(32.*WM2*T3+32.*ZM2*T1+64.*T1*T3+16. + 1 *WZM2) + 1 +EPF(P1,P3,Q1,Q3)*CTXCU*CV3*T*(-16.*WM2-16.*ZM2-32.*T1-32.*T3) + WZTU=WZTU + 1 +16.*EPF(P1,P3,Q1,Q3)*CTXCU*CV3*T**2 + 1 +EPF(P2,P3,Q1,Q3)*CTXCU*CV3*(-32.*WM2*U3-32.*ZM2*T1-64.*T1*U3-16 + 1 .*WZM2) + 1 +EPF(P2,P3,Q1,Q3)*CTXCU*CV3*T*(16.*ZM2+32.*U3) + 1 -16.*EPF(P2,P3,Q1,Q3)*CTXCU*CV3*T*U + 1 +EPF(P2,P3,Q1,Q3)*CTXCU*CV3*U*(16.*WM2+32.*T1)+0. + RETURN + END diff --git a/ISAJET/code/xwwww.F b/ISAJET/code/xwwww.F new file mode 100644 index 00000000000..d284db5cec7 --- /dev/null +++ b/ISAJET/code/xwwww.F @@ -0,0 +1,196 @@ +#include "isajet/pilot.h" + SUBROUTINE XWWWW +C +C SET UP W+ W- -> W+ W- AMPLITUDES AS RATIONAL FUNCTIONS OF Z +C +C RE(F(Z,L)) = SUM(I,J)(ANWWWW(I+1,J,L)*Z**I +C /(ADWWWW(1,J)+ADWWWW(2,J)*Z)) +C IM(F(Z,L)) = AIWWWW(L) (INDEPENDENT OF Z) +C J LABELS PIECES WITH SAME DENOMINATOR. +C L=1 FOR 0,0; L=2 FOR 1,-1; L=3 FOR 1,1; L=4 FOR 0,1 +C +C *NOTE* A FACTOR OF SIN(THETA)/SQRT(2) IS REMOVED FROM F01 +C +#include "isajet/const.inc" +#include "isajet/jetpar.inc" +#include "isajet/wcon.inc" +#include "isajet/hcon.inc" +#if defined(CERNLIB_DOUBLE) + DOUBLE PRECISION WM,ZM,ZM2,ZM3,ZM4,ZM5,ZM6,HM,HM2,HM3,HM4,HG,HG2 + $,PROPH,RTS,S,S2,S3,SW,QQ0,QQI,QQF +#endif +C +C USE UNITS OF WM TO AVOID LARGE NUMBERS - NOTE ANWWWW/ADWWWW +C AND AIWWWW ARE DIMENSIONLESS + WM=WMASS(2) + ZM=WMASS(4)/WM + ZM2=ZM**2 + ZM3=ZM**3 + ZM4=ZM**4 + ZM5=ZM**5 + ZM6=ZM**6 + HM=HMASS/WM + HM2=HM**2 + HM3=HM**3 + HM4=HM**4 + HG=HGAM/WM + HG2=HG**2 + RTS=QMW/WM + S=RTS**2 + S2=S**2 + S3=S**3 + PROPH=(S-HM2)**2+(HM*HG)**2 +C + CW=1./ZM + CW2=CW**2 + SW2=1.-CW2 + SW=SQRT(SW2) + QQ0=.5*RTS + QQI=.5*SQRT(S-4.) + QQF=.5*SQRT(S-4.) + GSQ=4.*PI*ALFA/SW2 +C +C FROM WWWW3.EX + ANWWWW(1,1,1) = 8.00E+00 * S - 3.00E+00 * S2 - 1.60E+01 + $ * ( HM2 / PROPH) + 1.60E+01 * (S / PROPH) - 1.60E+01 * (S2 + $ / PROPH) + 4.00E+00 * (S3 / PROPH) + 1.60E+01 * ((HM2 * S) + $ / PROPH) - 4.00E+00 * ((HM2 * S2) / PROPH) + ANWWWW(1,1,2) = 2.00E+00 * S + ANWWWW(1,1,3) = -1.60E+01 + 6.00E+00 * S - 1.60E+01 * (HM2 + $ / PROPH) + 1.60E+01 * (S / PROPH) - 8.00E+00 * (S2 / PROPH) + $ + 8.00E+00 * ((HM2 * S) / PROPH) + ANWWWW(1,1,4) = -2.40E+01 * RTS + 6.40E+01 * (RTS / (S + $ - 1.00E+00 * ZM2)) + 1.60E+01 * ((RTS * S) / (S - 1.00E+00 + $ * ZM2)) - 8.00E+00 * ((RTS * S2) / (S - 1.00E+00 * ZM2)) + $ + 6.40E+01 * ((RTS * SW2) / S) - 6.40E+01 * ((RTS * SW2) / (S + $ - 1.00E+00 * ZM2)) - 1.60E+01 * ((RTS * S * SW2) / (S + $ - 1.00E+00 * ZM2)) + 8.00E+00 * ((RTS * S2 * SW2) / (S + $ - 1.00E+00 * ZM2)) + 6.00E+00 * RTS * S + 1.60E+01 * RTS + $ * SW2 - 8.00E+00 * RTS * S * SW2 + ANWWWW(1,2,1) = -6.40E+01 + 1.60E+01 * S - 1.20E+01 * S2 + $ + 3.00E+00 * S3 + 6.40E+01 * SW2 - 1.60E+01 * S * SW2 + $ + 1.20E+01 * S2 * SW2 - 3.00E+00 * S3 * SW2 + ANWWWW(1,2,2) = 6.40E+01 + 8.00E+00 * S - 2.00E+00 * S2 + $ - 6.40E+01 * SW2 - 8.00E+00 * S * SW2 + 2.00E+00 * S2 * SW2 + ANWWWW(1,2,3) = -6.40E+01 + 2.40E+01 * S - 6.00E+00 * S2 + $ + 6.40E+01 * SW2 - 2.40E+01 * S * SW2 + 6.00E+00 * S2 * SW2 + ANWWWW(1,2,4) = -9.60E+01 * RTS + 1.60E+01 * RTS * S + 2.00E+00 + $ * RTS * S2 + 9.60E+01 * RTS * SW2 - 1.60E+01 * RTS * S * SW2 + $ - 2.00E+00 * RTS * S2 * SW2 + ANWWWW(1,3,1) = -6.40E+01 * SW2 + 1.60E+01 * S * SW2 - 1.20E+01 + $ * S2 * SW2 + 3.00E+00 * S3 * SW2 + ANWWWW(1,3,2) = 6.40E+01 * SW2 + 8.00E+00 * S * SW2 - 2.00E+00 + $ * S2 * SW2 + ANWWWW(1,3,3) = -6.40E+01 * SW2 + 2.40E+01 * S * SW2 - 6.00E+00 + $ * S2 * SW2 + ANWWWW(1,3,4) = -9.60E+01 * RTS * SW2 + 1.60E+01 * RTS * S * SW2 + $ + 2.00E+00 * RTS * S2 * SW2 + ANWWWW(1,4,1) = -3.20E+01 + 1.60E+01 * S - 2.00E+00 * S2 + ANWWWW(1,4,2) = -4.00E+00 * S + ANWWWW(1,4,3) = 4.00E+00 * S + ANWWWW(1,4,4) = -1.60E+01 * RTS + 4.00E+00 * RTS * S + ANWWWW(2,1,1) = -2.40E+01 * S + 6.00E+00 * S2 + 4.80E+01 * SW2 + $ + 6.40E+01 * (1.00E+00 / (S - 1.00E+00 * ZM2)) + 4.80E+01 * (S + $ / (S - 1.00E+00 * ZM2)) - 4.00E+00 * (S3 / (S - 1.00E+00 + $ * ZM2)) + 6.40E+01 * (SW2 / S) - 6.40E+01 * (SW2 / (S + $ - 1.00E+00 * ZM2)) - 4.80E+01 * ((S * SW2) / (S - 1.00E+00 + $ * ZM2)) + 4.00E+00 * ((S3 * SW2) / (S - 1.00E+00 * ZM2)) + $ - 4.00E+00 * S2 * SW2 + ANWWWW(2,1,2) = 0.00E+00 + ANWWWW(2,1,3) = 1.60E+01 * SW2 + 6.40E+01 * (1.00E+00 / (S + $ - 1.00E+00 * ZM2)) + 1.60E+01 * (S / (S - 1.00E+00 * ZM2)) + $ - 8.00E+00 * (S2 / (S - 1.00E+00 * ZM2)) + 6.40E+01 * (SW2 + $ / S) - 6.40E+01 * (SW2 / (S - 1.00E+00 * ZM2)) - 1.60E+01 + $ * ((S * SW2) / (S - 1.00E+00 * ZM2)) + 8.00E+00 * ((S2 * SW2) + $ / (S - 1.00E+00 * ZM2)) - 8.00E+00 * S * SW2 + ANWWWW(2,1,4) = 2.00E+00 * RTS * S + ANWWWW(2,2,1) = -6.40E+01 - 1.12E+02 * S + 5.20E+01 * S2 + $ - 5.00E+00 * S3 + 6.40E+01 * SW2 + 1.12E+02 * S * SW2 + $ - 5.20E+01 * S2 * SW2 + 5.00E+00 * S3 * SW2 + ANWWWW(2,2,2) = -8.00E+00 * S + 2.00E+00 * S2 + 8.00E+00 * S + $ * SW2 - 2.00E+00 * S2 * SW2 + ANWWWW(2,2,3) = -5.60E+01 * S + 1.40E+01 * S2 + 5.60E+01 * S + $ * SW2 - 1.40E+01 * S2 * SW2 + ANWWWW(2,2,4) = 1.60E+02 * RTS - 8.00E+00 * RTS * S - 4.00E+00 + $ * RTS * S2 - 1.60E+02 * RTS * SW2 + 8.00E+00 * RTS * S * SW2 + $ + 4.00E+00 * RTS * S2 * SW2 + ANWWWW(2,3,1) = -6.40E+01 * SW2 - 1.12E+02 * S * SW2 + 5.20E+01 + $ * S2 * SW2 - 5.00E+00 * S3 * SW2 + ANWWWW(2,3,2) = -8.00E+00 * S * SW2 + 2.00E+00 * S2 * SW2 + ANWWWW(2,3,3) = -5.60E+01 * S * SW2 + 1.40E+01 * S2 * SW2 + ANWWWW(2,3,4) = 1.60E+02 * RTS * SW2 - 8.00E+00 * RTS * S * SW2 + $ - 4.00E+00 * RTS * S2 * SW2 + ANWWWW(2,4,1) = -1.60E+01 * S + 4.00E+00 * S2 + ANWWWW(2,4,2) = 0.00E+00 + ANWWWW(2,4,3) = 0.00E+00 + ANWWWW(2,4,4) = -4.00E+00 * RTS * S + ANWWWW(3,1,1) = S2 + ANWWWW(3,1,2) = -2.00E+00 * S + ANWWWW(3,1,3) = 2.00E+00 * S + ANWWWW(3,1,4) = 0.00E+00 + ANWWWW(3,2,1) = 1.60E+02 * S - 3.60E+01 * S2 + S3 - 1.60E+02 + $ * S * SW2 + 3.60E+01 * S2 * SW2 - 1.00E+00 * S3 * SW2 + ANWWWW(3,2,2) = -6.40E+01 - 8.00E+00 * S + 2.00E+00 * S2 + $ + 6.40E+01 * SW2 + 8.00E+00 * S * SW2 - 2.00E+00 * S2 * SW2 + ANWWWW(3,2,3) = 6.40E+01 + 4.00E+01 * S - 1.00E+01 * S2 + $ - 6.40E+01 * SW2 - 4.00E+01 * S * SW2 + 1.00E+01 * S2 * SW2 + ANWWWW(3,2,4) = -8.00E+00 * RTS * S + 2.00E+00 * RTS * S2 + $ + 8.00E+00 * RTS * S * SW2 - 2.00E+00 * RTS * S2 * SW2 + ANWWWW(3,3,1) = 1.60E+02 * S * SW2 - 3.60E+01 * S2 * SW2 + S3 + $ * SW2 + ANWWWW(3,3,2) = -6.40E+01 * SW2 - 8.00E+00 * S * SW2 + 2.00E+00 + $ * S2 * SW2 + ANWWWW(3,3,3) = 6.40E+01 * SW2 + 4.00E+01 * S * SW2 - 1.00E+01 + $ * S2 * SW2 + ANWWWW(3,3,4) = -8.00E+00 * RTS * S * SW2 + 2.00E+00 * RTS * S2 + $ * SW2 + ANWWWW(3,4,1) = -2.00E+00 * S2 + ANWWWW(3,4,2) = 4.00E+00 * S + ANWWWW(3,4,3) = -4.00E+00 * S + ANWWWW(3,4,4) = 0.00E+00 + ANWWWW(4,1,1) = 0.00E+00 + ANWWWW(4,1,2) = 0.00E+00 + ANWWWW(4,1,3) = 0.00E+00 + ANWWWW(4,1,4) = 0.00E+00 + ANWWWW(4,2,1) = -4.00E+00 * S2 + S3 + 4.00E+00 * S2 * SW2 + $ - 1.00E+00 * S3 * SW2 + ANWWWW(4,2,2) = 8.00E+00 * S - 2.00E+00 * S2 - 8.00E+00 * S + $ * SW2 + 2.00E+00 * S2 * SW2 + ANWWWW(4,2,3) = -8.00E+00 * S + 2.00E+00 * S2 + 8.00E+00 * S + $ * SW2 - 2.00E+00 * S2 * SW2 + ANWWWW(4,2,4) = 0.00E+00 + ANWWWW(4,3,1) = -4.00E+00 * S2 * SW2 + S3 * SW2 + ANWWWW(4,3,2) = 8.00E+00 * S * SW2 - 2.00E+00 * S2 * SW2 + ANWWWW(4,3,3) = -8.00E+00 * S * SW2 + 2.00E+00 * S2 * SW2 + ANWWWW(4,3,4) = 0.00E+00 + ANWWWW(4,4,1) = 0.00E+00 + ANWWWW(4,4,2) = 0.00E+00 + ANWWWW(4,4,3) = 0.00E+00 + ANWWWW(4,4,4) = 0.00E+00 +C + ADWWWW(1,1) = 1.00E+00 + ADWWWW(1,2) = -4.00E+00 + S + 2.00E+00 * ZM2 + ADWWWW(1,3) = -4.00E+00 + S + ADWWWW(1,4) = -4.00E+00 + 2.00E+00 * HM2 + S + ADWWWW(2,1) = 0.00E+00 + ADWWWW(2,2) = 4.00E+00 - 1.00E+00 * S + ADWWWW(2,3) = 4.00E+00 - 1.00E+00 * S + ADWWWW(2,4) = 4.00E+00 - 1.00E+00 * S +C + AIWWWW(1) = 1.60E+01 * ((HG * HM) / PROPH) - 1.60E+01 * ((HG + $ * HM * S) / PROPH) + 4.00E+00 * ((HG * HM * S2) / PROPH) + AIWWWW(2) = 0.00E+00 + AIWWWW(3) = 1.60E+01 * ((HG * HM) / PROPH) - 8.00E+00 * ((HG + $ * HM * S) / PROPH) + AIWWWW(4) = 0.00E+00 +C +C RESTORE MISSING FACTORS + DO 100 J=1,4 + AIWWWW(J)=AIWWWW(J)*GSQ/(16.) + DO 100 I=1,4 + DO 110 K=1,4 +110 ANWWWW(K,I,J)=ANWWWW(K,I,J)*GSQ/(16.) +100 CONTINUE +C + RETURN + END diff --git a/ISAJET/code/xwwzz.F b/ISAJET/code/xwwzz.F new file mode 100644 index 00000000000..476bcfc47cf --- /dev/null +++ b/ISAJET/code/xwwzz.F @@ -0,0 +1,198 @@ +#include "isajet/pilot.h" + SUBROUTINE XWWZZ +C +C SET UP W+ W- -> Z0 Z0 AMPLITUDES AS RATIONAL FUNCTIONS OF Z +C +C RE(F(Z,L)) = SUM(I,J)(ANWWWW(I+1,J,L)*Z**I +C /(ADWWWW(1,J)+ADWWWW(2,J)*Z)) +C IM(F(Z,L)) = AIWWWW(L) (INDEPENDENT OF Z) +C J LABELS PIECES WITH SAME DENOMINATOR. +C L=1 FOR 0,0; L=2 FOR 1,-1; L=3 FOR 1,1; L=4 FOR 0,1 +C +C *NOTE* A FACTOR OF SIN(THETA)/SQRT(2) IS REMOVED FROM F01 +C +#include "isajet/const.inc" +#include "isajet/jetpar.inc" +#include "isajet/wcon.inc" +#include "isajet/hcon.inc" +#if defined(CERNLIB_DOUBLE) + DOUBLE PRECISION WM,ZM,ZM2,ZM3,ZM4,ZM5,ZM6,HM,HM2,HM3,HM4,HG,HG2 + $,PROPH,RTS,S,S2,S3,SW,QQ0,QQI,QQF +#endif +C +C USE UNITS OF WM TO AVOID LARGE NUMBERS - NOTE ANWWWW/ADWWWW +C AND AIWWWW ARE DIMENSIONLESS + WM=WMASS(2) + ZM=WMASS(4)/WM + ZM2=ZM**2 + ZM3=ZM**3 + ZM4=ZM**4 + ZM5=ZM**5 + ZM6=ZM**6 + HM=HMASS/WM + HM2=HM**2 + HM3=HM**3 + HM4=HM**4 + HG=HGAM/WM + HG2=HG**2 + RTS=QMW/WM + S=RTS**2 + S2=S**2 + S3=S**3 + PROPH=(S-HM2)**2+(HM*HG)**2 +C CORRECT SIGN OF HIGGS AMPLITUDE. + PROPH=-PROPH +C + CW=1./ZM + CW2=CW**2 + SW2=1.-CW2 + SW=SQRT(SW2) + QQ0=.5*RTS + QQI=.5*SQRT(S-4.) + QQF=.5*SQRT(S-4.*ZM2) + GSQ=4.*PI*ALFA/SW2 +C +C FROM WWZZ3.EX + ANWWWW(1,1,1) = -1.60E+01 * ((HM2 * ZM3) / (CW * PROPH)) + $ + 1.60E+01 * ((S * ZM3) / (CW * PROPH) ) - 8.00E+00 * ((S2 + $ * ZM) / (CW * PROPH)) - 8.00E+00 * ((S2 * ZM3) / (CW * PROPH)) + $ + 4.00E+00 * ((S3 * ZM) / (CW * PROPH)) + 8.00E+00 * ((HM2 * S + $ * ZM) / (CW * PROPH)) + 8.00E+00 * ((HM2 * S * ZM3) / (CW + $ * PROPH)) - 4.00E+00 * ((HM2 * S2 * ZM) / (CW * PROPH)) + $ + 8.00E+00 * CW2 * S - 6.00E+00 * CW2 * S2 + 8.00E+00 * CW2 + $ * S * ZM2 + ANWWWW(1,1,2) = 4.00E+00 * CW2 * S * ZM2 + ANWWWW(1,1,3) = -1.60E+01 * ((HM2 * ZM3) / (CW * PROPH)) + $ + 1.60E+01 * ((S * ZM3) / (CW * PROPH) ) - 8.00E+00 * ((S2 + $ * ZM3) / (CW * PROPH)) + 8.00E+00 * ((HM2 * S * ZM3) / (CW + $ * PROPH)) - 3.20E+01 * CW2 * ZM2 + 1.20E+01 * CW2 * S * ZM2 + ANWWWW(1,1,4) = 0.00E+00 + ANWWWW(1,2,1) = -4.00E+00 * CW2 * S2 + 3.00E+00 * CW2 * S3 + $ - 9.60E+01 * CW2 * ZM4 + 3.20E+01 * CW2 * ZM6 + 8.00E+00 * CW2 + $ * S * ZM2 + 1.60E+01 * CW2 * S * ZM4 - 8.00E+00 * CW2 * S + $ * ZM6 - 1.00E+01 * CW2 * S2 * ZM2 + 2.00E+00 * CW2 * S2 * ZM4 + ANWWWW(1,2,2) = 6.40E+01 * CW2 * ZM2 + 1.20E+01 * CW2 * S * ZM2 + $ - 4.00E+00 * CW2 * S * ZM4 - 2.00E+00 * CW2 * S2 * ZM2 + ANWWWW(1,2,3) = -6.40E+01 * CW2 * ZM2 + 2.00E+01 * CW2 * S * ZM2 + $ + 4.00E+00 * CW2 * S * ZM4 - 6.00E+00 * CW2 * S2 * ZM2 + ANWWWW(1,2,4) = 1.92E+02 * CW2 * QQ0 * QQF * QQI * ZM + $ - 3.20E+01 * CW2 * QQ0 * QQF * QQI * ZM3 + 3.20E+01 * CW2 + $ * QQ0 * QQF * QQI * ZM5 + 1.60E+01 * CW2 * QQ0 * QQF * QQI * S + $ * ZM + ANWWWW(1,3,1) = -4.00E+00 * CW2 * S2 + 3.00E+00 * CW2 * S3 + $ - 9.60E+01 * CW2 * ZM4 + 3.20E+01 * CW2 * ZM6 + 8.00E+00 * CW2 + $ * S * ZM2 + 1.60E+01 * CW2 * S * ZM4 - 8.00E+00 * CW2 * S + $ * ZM6 - 1.00E+01 * CW2 * S2 * ZM2 + 2.00E+00 * CW2 * S2 * ZM4 + ANWWWW(1,3,2) = 6.40E+01 * CW2 * ZM2 + 1.20E+01 * CW2 * S * ZM2 + $ - 4.00E+00 * CW2 * S * ZM4 - 2.00E+00 * CW2 * S2 * ZM2 + ANWWWW(1,3,3) = -6.40E+01 * CW2 * ZM2 + 2.00E+01 * CW2 * S * ZM2 + $ + 4.00E+00 * CW2 * S * ZM4 - 6.00E+00 * CW2 * S2 * ZM2 + ANWWWW(1,3,4) = -1.92E+02 * CW2 * QQ0 * QQF * QQI * ZM + $ + 3.20E+01 * CW2 * QQ0 * QQF * QQI * ZM3 - 3.20E+01 * CW2 + $ * QQ0 * QQF * QQI * ZM5 - 1.60E+01 * CW2 * QQ0 * QQF * QQI * S + $ * ZM + ANWWWW(1,4,1) = 0.00E+00 + ANWWWW(1,4,2) = 0.00E+00 + ANWWWW(1,4,3) = 0.00E+00 + ANWWWW(1,4,4) = 0.00E+00 + ANWWWW(2,1,1) = 0.00E+00 + ANWWWW(2,1,2) = 0.00E+00 + ANWWWW(2,1,3) = 0.00E+00 + ANWWWW(2,1,4) = 8.00E+00 * CW2 * QQ0 * S * ZM + ANWWWW(2,2,1) = 4.80E+01 * CW2 * QQF * QQI * S - 2.00E+01 * CW2 + $ * QQF * QQI * S2 + 6.40E+01 * CW2 * QQF * QQI * ZM2 + 9.60E+01 + $ * CW2 * QQF * QQI * S * ZM2 - 1.60E+01 * CW2 * QQF * QQI * S + $ * ZM4 + ANWWWW(2,2,2) = 8.00E+00 * CW2 * QQF * QQI * S * ZM2 + ANWWWW(2,2,3) = 5.60E+01 * CW2 * QQF * QQI * S * ZM2 + ANWWWW(2,2,4) = 1.28E+02 * CW2 * QQ0 * ZM + 1.92E+02 * CW2 * QQ0 + $ * ZM3 - 3.20E+01 * CW2 * QQ0 * S * ZM + 2.40E+01 * CW2 * QQ0 + $ * S * ZM3 - 8.00E+00 * CW2 * QQ0 * S * ZM5 - 8.00E+00 * CW2 + $ * QQ0 * S2 * ZM + ANWWWW(2,3,1) = -4.80E+01 * CW2 * QQF * QQI * S + 2.00E+01 * CW2 + $ * QQF * QQI * S2 - 6.40E+01 * CW2 * QQF * QQI * ZM2 + $ - 9.60E+01 * CW2 * QQF * QQI * S * ZM2 + 1.60E+01 * CW2 * QQF + $ * QQI * S * ZM4 + ANWWWW(2,3,2) = -8.00E+00 * CW2 * QQF * QQI * S * ZM2 + ANWWWW(2,3,3) = -5.60E+01 * CW2 * QQF * QQI * S * ZM2 + ANWWWW(2,3,4) = 1.28E+02 * CW2 * QQ0 * ZM + 1.92E+02 * CW2 * QQ0 + $ * ZM3 - 3.20E+01 * CW2 * QQ0 * S * ZM + 2.40E+01 * CW2 * QQ0 + $ * S * ZM3 - 8.00E+00 * CW2 * QQ0 * S * ZM5 - 8.00E+00 * CW2 + $ * QQ0 * S2 * ZM + ANWWWW(2,4,1) = 0.00E+00 + ANWWWW(2,4,2) = 0.00E+00 + ANWWWW(2,4,3) = 0.00E+00 + ANWWWW(2,4,4) = 0.00E+00 + ANWWWW(3,1,1) = 2.00E+00 * CW2 * S2 + ANWWWW(3,1,2) = -4.00E+00 * CW2 * S * ZM2 + ANWWWW(3,1,3) = 4.00E+00 * CW2 * S * ZM2 + ANWWWW(3,1,4) = 0.00E+00 + ANWWWW(3,2,1) = 3.20E+01 * CW2 * S - 1.60E+01 * CW2 * S2 + CW2 + $ * S3 + 9.60E+01 * CW2 * S * ZM2 + 3.20E+01 * CW2 * S * ZM4 + $ - 2.20E+01 * CW2 * S2 * ZM2 + 2.00E+00 * CW2 * S2 * ZM4 + ANWWWW(3,2,2) = -6.40E+01 * CW2 * ZM2 - 1.20E+01 * CW2 * S + $ * ZM2 + 4.00E+00 * CW2 * S * ZM4 + 2.00E+00 * CW2 * S2 * ZM2 + ANWWWW(3,2,3) = 6.40E+01 * CW2 * ZM2 + 1.20E+01 * CW2 * S * ZM2 + $ + 2.80E+01 * CW2 * S * ZM4 - 1.00E+01 * CW2 * S2 * ZM2 + ANWWWW(3,2,4) = 1.60E+01 * CW2 * QQ0 * QQF * QQI * S * ZM + ANWWWW(3,3,1) = 3.20E+01 * CW2 * S - 1.60E+01 * CW2 * S2 + CW2 + $ * S3 + 9.60E+01 * CW2 * S * ZM2 + 3.20E+01 * CW2 * S * ZM4 + $ - 2.20E+01 * CW2 * S2 * ZM2 + 2.00E+00 * CW2 * S2 * ZM4 + ANWWWW(3,3,2) = -6.40E+01 * CW2 * ZM2 - 1.20E+01 * CW2 * S + $ * ZM2 + 4.00E+00 * CW2 * S * ZM4 + 2.00E+00 * CW2 * S2 * ZM2 + ANWWWW(3,3,3) = 6.40E+01 * CW2 * ZM2 + 1.20E+01 * CW2 * S * ZM2 + $ + 2.80E+01 * CW2 * S * ZM4 - 1.00E+01 * CW2 * S2 * ZM2 + ANWWWW(3,3,4) = -1.60E+01 * CW2 * QQ0 * QQF * QQI * S * ZM + ANWWWW(3,4,1) = 0.00E+00 + ANWWWW(3,4,2) = 0.00E+00 + ANWWWW(3,4,3) = 0.00E+00 + ANWWWW(3,4,4) = 0.00E+00 + ANWWWW(4,1,1) = 0.00E+00 + ANWWWW(4,1,2) = 0.00E+00 + ANWWWW(4,1,3) = 0.00E+00 + ANWWWW(4,1,4) = 0.00E+00 + ANWWWW(4,2,1) = 4.00E+00 * CW2 * QQF * QQI * S2 + ANWWWW(4,2,2) = -8.00E+00 * CW2 * QQF * QQI * S * ZM2 + ANWWWW(4,2,3) = 8.00E+00 * CW2 * QQF * QQI * S * ZM2 + ANWWWW(4,2,4) = 0.00E+00 + ANWWWW(4,3,1) = -4.00E+00 * CW2 * QQF * QQI * S2 + ANWWWW(4,3,2) = 8.00E+00 * CW2 * QQF * QQI * S * ZM2 + ANWWWW(4,3,3) = -8.00E+00 * CW2 * QQF * QQI * S * ZM2 + ANWWWW(4,3,4) = 0.00E+00 + ANWWWW(4,4,1) = 0.00E+00 + ANWWWW(4,4,2) = 0.00E+00 + ANWWWW(4,4,3) = 0.00E+00 + ANWWWW(4,4,4) = 0.00E+00 +C + ADWWWW(1,1) = 1.00E+00 + ADWWWW(1,2) = S - 2.00E+00 * ZM2 + ADWWWW(1,3) = S - 2.00E+00 * ZM2 + ADWWWW(1,4) = 1.00E+00 + ADWWWW(2,1) = 0.00E+00 + ADWWWW(2,2) = -1.00E+00 * S + 4.00E+00 * (S / (S + 4.00E+00 + $ * QQF * QQI)) - 1.60E+01 * (ZM2 / (S + 4.00E+00 * QQF * QQI)) + $ + 4.00E+00 * ((S * ZM2) / (S + 4.00E+00 * QQF * QQI)) + ADWWWW(2,3) = S - 4.00E+00 * (S / (S + 4.00E+00 * QQF * QQI)) + $ + 1.60E+01 * (ZM2 / (S + 4.00E+00 * QQF * QQI)) - 4.00E+00 + $ * ((S * ZM2) / (S + 4.00E+00 * QQF * QQI)) + ADWWWW(2,4) = 0.00E+00 +C + AIWWWW(1) = 1.60E+01 * ((HG * HM * ZM3) / (CW * PROPH)) + $ - 8.00E+00 * ((HG * HM * S * ZM) / (CW * PROPH)) - 8.00E+00 + $ * ((HG * HM * S * ZM3) / (CW * PROPH)) + 4.00E+00 * ((HG * HM + $ * S2 * ZM) / (CW * PROPH)) + AIWWWW(2) = 0.00E+00 + AIWWWW(3) = 1.60E+01 * ((HG * HM * ZM3) / (CW * PROPH)) + $ - 8.00E+00 * ((HG * HM * S * ZM3) / (CW * PROPH)) + AIWWWW(4) = 0.00E+00 +C +C RESTORE MISSING FACTORS + DO 100 J=1,4 + AIWWWW(J)=AIWWWW(J)*GSQ/(16.*ZM2) + DO 100 I=1,4 + DO 110 K=1,4 +110 ANWWWW(K,I,J)=ANWWWW(K,I,J)*GSQ/(16.*ZM2) +100 CONTINUE +C + RETURN + END diff --git a/ISAJET/code/xzzww.F b/ISAJET/code/xzzww.F new file mode 100644 index 00000000000..404c017eccb --- /dev/null +++ b/ISAJET/code/xzzww.F @@ -0,0 +1,194 @@ +#include "isajet/pilot.h" + SUBROUTINE XZZWW +C +C SET UP Z0 Z0 -> W+ W- AMPLITUDES AS RATIONAL FUNCTIONS OF Z +C +C RE(F(Z,L)) = SUM(I,J)(ANWWWW(I+1,J,L)*Z**I +C /(ADWWWW(1,J)+ADWWWW(2,J)*Z)) +C IM(F(Z,L)) = AIWWWW(L) (INDEPENDENT OF Z) +C J LABELS PIECES WITH SAME DENOMINATOR. +C L=1 FOR 0,0; L=2 FOR 1,-1; L=3 FOR 1,1; L=4 FOR 0,1 +C +C *NOTE* A FACTOR OF SIN(THETA)/SQRT(2) IS REMOVED FROM F01 +C +#include "isajet/const.inc" +#include "isajet/jetpar.inc" +#include "isajet/wcon.inc" +#include "isajet/hcon.inc" +#if defined(CERNLIB_DOUBLE) + DOUBLE PRECISION WM,ZM,ZM2,ZM3,ZM4,ZM5,ZM6,HM,HM2,HM3,HM4,HG,HG2 + $,PROPH,RTS,S,S2,S3,SW,QQ0,QQI,QQF +#endif +C +C USE UNITS OF WM TO AVOID LARGE NUMBERS - NOTE ANWWWW/ADWWWW +C AND AIWWWW ARE DIMENSIONLESS + WM=WMASS(2) + ZM=WMASS(4)/WM + ZM2=ZM**2 + ZM3=ZM**3 + ZM4=ZM**4 + ZM5=ZM**5 + ZM6=ZM**6 + HM=HMASS/WM + HM2=HM**2 + HM3=HM**3 + HM4=HM**4 + HG=HGAM/WM + HG2=HG**2 + RTS=QMW/WM + S=RTS**2 + S2=S**2 + S3=S**3 + PROPH=(S-HM2)**2+(HM*HG)**2 +C CORRECT SIGN OF HIGGS AMPLITUDE. + PROPH=-PROPH +C + CW=1./ZM + CW2=CW**2 + SW2=1.-CW2 + SW=SQRT(SW2) + QQ0=.5*RTS + QQI=.5*SQRT(S-4.*ZM2) + QQF=.5*SQRT(S-4.) + GSQ=4.*PI*ALFA/SW2 +C +C FROM ZZWW3.EX + ANWWWW(1,1,1) = -1.60E+01 * ((HM2 * ZM3) / (CW * PROPH)) + $ + 1.60E+01 * ((S * ZM3) / (CW * PROPH) ) - 8.00E+00 * ((S2 + $ * ZM) / (CW * PROPH)) - 8.00E+00 * ((S2 * ZM3) / (CW * PROPH)) + $ + 4.00E+00 * ((S3 * ZM) / (CW * PROPH)) + 8.00E+00 * ((HM2 * S + $ * ZM) / (CW * PROPH)) + 8.00E+00 * ((HM2 * S * ZM3) / (CW + $ * PROPH)) - 4.00E+00 * ((HM2 * S2 * ZM) / (CW * PROPH)) + $ + 8.00E+00 * CW2 * S - 6.00E+00 * CW2 * S2 + 8.00E+00 * CW2 + $ * S * ZM2 + ANWWWW(1,1,2) = 4.00E+00 * CW2 * S + ANWWWW(1,1,3) = -1.60E+01 * ((HM2 * ZM3) / (CW * PROPH)) + $ + 1.60E+01 * ((S * ZM3) / (CW * PROPH) ) - 8.00E+00 * ((S2 + $ * ZM) / (CW * PROPH)) + 8.00E+00 * ((HM2 * S * ZM) / (CW + $ * PROPH)) + 1.20E+01 * CW2 * S - 3.20E+01 * CW2 * ZM2 + ANWWWW(1,1,4) = 0.00E+00 + ANWWWW(1,2,1) = -4.00E+00 * CW2 * S2 + 3.00E+00 * CW2 * S3 + $ - 9.60E+01 * CW2 * ZM4 + 3.20E+01 * CW2 * ZM6 + 8.00E+00 * CW2 + $ * S * ZM2 + 1.60E+01 * CW2 * S * ZM4 - 8.00E+00 * CW2 * S + $ * ZM6 - 1.00E+01 * CW2 * S2 * ZM2 + 2.00E+00 * CW2 * S2 * ZM4 + ANWWWW(1,2,2) = -4.00E+00 * CW2 * S - 2.00E+00 * CW2 * S2 + $ + 6.40E+01 * CW2 * ZM4 + 1.20E+01 * CW2 * S * ZM2 + ANWWWW(1,2,3) = 4.00E+00 * CW2 * S - 6.00E+00 * CW2 * S2 + $ - 6.40E+01 * CW2 * ZM4 + 2.00E+01 * CW2 * S * ZM2 + ANWWWW(1,2,4) = 6.40E+01 * CW2 * QQ0 * QQF * QQI + 1.60E+01 + $ * CW2 * QQ0 * QQF * QQI * S + 9.60E+01 * CW2 * QQ0 * QQF * QQI + $ * ZM2 + 3.20E+01 * CW2 * QQ0 * QQF * QQI * ZM4 + ANWWWW(1,3,1) = -4.00E+00 * CW2 * S2 + 3.00E+00 * CW2 * S3 + $ - 9.60E+01 * CW2 * ZM4 + 3.20E+01 * CW2 * ZM6 + 8.00E+00 * CW2 + $ * S * ZM2 + 1.60E+01 * CW2 * S * ZM4 - 8.00E+00 * CW2 * S + $ * ZM6 - 1.00E+01 * CW2 * S2 * ZM2 + 2.00E+00 * CW2 * S2 * ZM4 + ANWWWW(1,3,2) = -4.00E+00 * CW2 * S - 2.00E+00 * CW2 * S2 + $ + 6.40E+01 * CW2 * ZM4 + 1.20E+01 * CW2 * S * ZM2 + ANWWWW(1,3,3) = 4.00E+00 * CW2 * S - 6.00E+00 * CW2 * S2 + $ - 6.40E+01 * CW2 * ZM4 + 2.00E+01 * CW2 * S * ZM2 + ANWWWW(1,3,4) = -6.40E+01 * CW2 * QQ0 * QQF * QQI - 1.60E+01 + $ * CW2 * QQ0 * QQF * QQI * S - 9.60E+01 * CW2 * QQ0 * QQF * QQI + $ * ZM2 - 3.20E+01 * CW2 * QQ0 * QQF * QQI * ZM4 + ANWWWW(1,4,1) = 0.00E+00 + ANWWWW(1,4,2) = 0.00E+00 + ANWWWW(1,4,3) = 0.00E+00 + ANWWWW(1,4,4) = 0.00E+00 + ANWWWW(2,1,1) = 0.00E+00 + ANWWWW(2,1,2) = 0.00E+00 + ANWWWW(2,1,3) = 0.00E+00 + ANWWWW(2,1,4) = 8.00E+00 * CW2 * QQ0 * S + ANWWWW(2,2,1) = 4.80E+01 * CW2 * QQF * QQI * S - 2.00E+01 * CW2 + $ * QQF * QQI * S2 + 6.40E+01 * CW2 * QQF * QQI * ZM2 + 9.60E+01 + $ * CW2 * QQF * QQI * S * ZM2 - 1.60E+01 * CW2 * QQF * QQI * S + $ * ZM4 + ANWWWW(2,2,2) = 8.00E+00 * CW2 * QQF * QQI * S + ANWWWW(2,2,3) = 5.60E+01 * CW2 * QQF * QQI * S + ANWWWW(2,2,4) = -8.00E+00 * CW2 * QQ0 * S2 + 1.92E+02 * CW2 + $ * QQ0 * ZM2 + 1.28E+02 * CW2 * QQ0 * ZM4 - 8.00E+00 * CW2 + $ * QQ0 * S * ZM2 - 8.00E+00 * CW2 * QQ0 * S * ZM4 + ANWWWW(2,3,1) = -4.80E+01 * CW2 * QQF * QQI * S + 2.00E+01 * CW2 + $ * QQF * QQI * S2 - 6.40E+01 * CW2 * QQF * QQI * ZM2 + $ - 9.60E+01 * CW2 * QQF * QQI * S * ZM2 + 1.60E+01 * CW2 * QQF + $ * QQI * S * ZM4 + ANWWWW(2,3,2) = -8.00E+00 * CW2 * QQF * QQI * S + ANWWWW(2,3,3) = -5.60E+01 * CW2 * QQF * QQI * S + ANWWWW(2,3,4) = -8.00E+00 * CW2 * QQ0 * S2 + 1.92E+02 * CW2 + $ * QQ0 * ZM2 + 1.28E+02 * CW2 * QQ0 * ZM4 - 8.00E+00 * CW2 + $ * QQ0 * S * ZM2 - 8.00E+00 * CW2 * QQ0 * S * ZM4 + ANWWWW(2,4,1) = 0.00E+00 + ANWWWW(2,4,2) = 0.00E+00 + ANWWWW(2,4,3) = 0.00E+00 + ANWWWW(2,4,4) = 0.00E+00 + ANWWWW(3,1,1) = 2.00E+00 * CW2 * S2 + ANWWWW(3,1,2) = -4.00E+00 * CW2 * S + ANWWWW(3,1,3) = 4.00E+00 * CW2 * S + ANWWWW(3,1,4) = 0.00E+00 + ANWWWW(3,2,1) = 3.20E+01 * CW2 * S - 1.60E+01 * CW2 * S2 + CW2 + $ * S3 + 9.60E+01 * CW2 * S * ZM2 + 3.20E+01 * CW2 * S * ZM4 + $ - 2.20E+01 * CW2 * S2 * ZM2 + 2.00E+00 * CW2 * S2 * ZM4 + ANWWWW(3,2,2) = 4.00E+00 * CW2 * S + 2.00E+00 * CW2 * S2 + $ - 6.40E+01 * CW2 * ZM4 - 1.20E+01 * CW2 * S * ZM2 + ANWWWW(3,2,3) = 2.80E+01 * CW2 * S - 1.00E+01 * CW2 * S2 + $ + 6.40E+01 * CW2 * ZM4 + 1.20E+01 * CW2 * S * ZM2 + ANWWWW(3,2,4) = 1.60E+01 * CW2 * QQ0 * QQF * QQI * S + ANWWWW(3,3,1) = 3.20E+01 * CW2 * S - 1.60E+01 * CW2 * S2 + CW2 + $ * S3 + 9.60E+01 * CW2 * S * ZM2 + 3.20E+01 * CW2 * S * ZM4 + $ - 2.20E+01 * CW2 * S2 * ZM2 + 2.00E+00 * CW2 * S2 * ZM4 + ANWWWW(3,3,2) = 4.00E+00 * CW2 * S + 2.00E+00 * CW2 * S2 + $ - 6.40E+01 * CW2 * ZM4 - 1.20E+01 * CW2 * S * ZM2 + ANWWWW(3,3,3) = 2.80E+01 * CW2 * S - 1.00E+01 * CW2 * S2 + $ + 6.40E+01 * CW2 * ZM4 + 1.20E+01 * CW2 * S * ZM2 + ANWWWW(3,3,4) = -1.60E+01 * CW2 * QQ0 * QQF * QQI * S + ANWWWW(3,4,1) = 0.00E+00 + ANWWWW(3,4,2) = 0.00E+00 + ANWWWW(3,4,3) = 0.00E+00 + ANWWWW(3,4,4) = 0.00E+00 + ANWWWW(4,1,1) = 0.00E+00 + ANWWWW(4,1,2) = 0.00E+00 + ANWWWW(4,1,3) = 0.00E+00 + ANWWWW(4,1,4) = 0.00E+00 + ANWWWW(4,2,1) = 4.00E+00 * CW2 * QQF * QQI * S2 + ANWWWW(4,2,2) = -8.00E+00 * CW2 * QQF * QQI * S + ANWWWW(4,2,3) = 8.00E+00 * CW2 * QQF * QQI * S + ANWWWW(4,2,4) = 0.00E+00 + ANWWWW(4,3,1) = -4.00E+00 * CW2 * QQF * QQI * S2 + ANWWWW(4,3,2) = 8.00E+00 * CW2 * QQF * QQI * S + ANWWWW(4,3,3) = -8.00E+00 * CW2 * QQF * QQI * S + ANWWWW(4,3,4) = 0.00E+00 + ANWWWW(4,4,1) = 0.00E+00 + ANWWWW(4,4,2) = 0.00E+00 + ANWWWW(4,4,3) = 0.00E+00 + ANWWWW(4,4,4) = 0.00E+00 +C + ADWWWW(1,1) = 1.00E+00 + ADWWWW(1,2) = S - 2.00E+00 * ZM2 + ADWWWW(1,3) = S - 2.00E+00 * ZM2 + ADWWWW(1,4) = 1.00E+00 + ADWWWW(2,1) = 0.00E+00 + ADWWWW(2,2) = -1.00E+00 * S + 4.00E+00 * (S / (S + 4.00E+00 + $ * QQF * QQI)) - 1.60E+01 * (ZM2 / (S + 4.00E+00 * QQF * QQI)) + $ + 4.00E+00 * ((S * ZM2) / (S + 4.00E+00 * QQF * QQI)) + ADWWWW(2,3) = S - 4.00E+00 * (S / (S + 4.00E+00 * QQF * QQI)) + $ + 1.60E+01 * (ZM2 / (S + 4.00E+00 * QQF * QQI)) - 4.00E+00 + $ * ((S * ZM2) / (S + 4.00E+00 * QQF * QQI)) + ADWWWW(2,4) = 0.00E+00 +C + AIWWWW(1) = 1.60E+01 * ((HG * HM * ZM3) / (CW * PROPH)) + $ - 8.00E+00 * ((HG * HM * S * ZM) / (CW * PROPH)) + $ - 8.00E+00 * ((HG * HM * S * ZM3) / (CW * PROPH)) + 4.00E+00 + $ * ((HG * HM * S2 * ZM) / (CW * PROPH)) + AIWWWW(2) = 0.00E+00 + AIWWWW(3) = 1.60E+01 * ((HG * HM * ZM3) / (CW * PROPH)) + $ - 8.00E+00 * ((HG * HM * S * ZM) / (CW * PROPH)) + AIWWWW(4) = 0.00E+00 +C +C RESTORE MISSING FACTORS + DO 100 J=1,4 + AIWWWW(J)=AIWWWW(J)*GSQ/(16.*ZM2) + DO 100 I=1,4 + DO 110 K=1,4 +110 ANWWWW(K,I,J)=ANWWWW(K,I,J)*GSQ/(16.*ZM2) +100 CONTINUE +C + RETURN + END diff --git a/ISAJET/code/xzzzz.F b/ISAJET/code/xzzzz.F new file mode 100644 index 00000000000..abc1995218c --- /dev/null +++ b/ISAJET/code/xzzzz.F @@ -0,0 +1,158 @@ +#include "isajet/pilot.h" + SUBROUTINE XZZZZ +C +C SET UP Z0 Z0 -> Z0 Z0 AMPLITUDES AS RATIONAL FUNCTIONS OF Z +C +C RE(F(Z,L)) = SUM(I,J)(ANWWWW(I+1,J,L)*Z**I +C /(ADWWWW(1,J)+ADWWWW(2,J)*Z)) +C IM(F(Z,L)) = AIWWWW(L) (INDEPENDENT OF Z) +C J LABELS PIECES WITH SAME DENOMINATOR. +C L=1 FOR 0,0; L=2 FOR 1,-1; L=3 FOR 1,1; L=4 FOR 0,1 +C +C *NOTE* A FACTOR OF SIN(THETA)/SQRT(2) IS REMOVED FROM F01 +C +#include "isajet/const.inc" +#include "isajet/jetpar.inc" +#include "isajet/wcon.inc" +#include "isajet/hcon.inc" +#if defined(CERNLIB_DOUBLE) + DOUBLE PRECISION WM,ZM,ZM2,ZM3,ZM4,ZM5,ZM6,HM,HM2,HM3,HM4,HG,HG2 + $,PROPH,RTS,S,S2,S3,SW,QQ0,QQI,QQF +#endif +C +C USE UNITS OF WM TO AVOID LARGE NUMBERS - NOTE ANWWWW/ADWWWW +C AND AIWWWW ARE DIMENSIONLESS + WM=WMASS(2) + ZM=WMASS(4)/WM + ZM2=ZM**2 + ZM3=ZM**3 + ZM4=ZM**4 + ZM5=ZM**5 + ZM6=ZM**6 + HM=HMASS/WM + HM2=HM**2 + HM3=HM**3 + HM4=HM**4 + HG=HGAM/WM + HG2=HG**2 + RTS=QMW/WM + S=RTS**2 + S2=S**2 + S3=S**3 + PROPH=(S-HM2)**2+(HM*HG)**2 +C + CW=1./ZM + CW2=CW**2 + SW2=1.-CW2 + SW=SQRT(SW2) + QQ0=.5*RTS + QQI=.5*SQRT(S-4.*ZM2) + QQF=.5*SQRT(S-4.*ZM2) + GSQ=4.*PI*ALFA/SW2 +C +C FROM ZZZZ3.EX + ANWWWW(1,1,1) = -1.60E+01 * ((HM2 * ZM6) / (CW2 * PROPH)) + $ + 1.60E+01 * ((S * ZM6) / (CW2 * PROPH )) - 1.60E+01 * ((S2 + $ * ZM4) / (CW2 * PROPH)) + 4.00E+00 * ((S3 * ZM2) / (CW2 + $ * PROPH)) + 1.60E+01 * ((HM2 * S * ZM4) / (CW2 * PROPH)) + $ - 4.00E+00 * ((HM2 * S2 * ZM2) / (CW2 * PROPH)) + ANWWWW(1,1,2) = 0.00E+00 + ANWWWW(1,1,3) = -1.60E+01 * ((HM2 * ZM6) / (CW2 * PROPH)) + $ + 1.60E+01 * ((S * ZM6) / (CW2 * PROPH )) - 8.00E+00 * ((S2 + $ * ZM4) / (CW2 * PROPH)) + 8.00E+00 * ((HM2 * S * ZM4) / (CW2 + $ * PROPH)) + ANWWWW(1,1,4) = 0.00E+00 + ANWWWW(1,2,1) = -3.20E+01 * (ZM6 / CW2) + 1.60E+01 * ((S * ZM4) + $ / CW2) - 2.00E+00 * ((S2 * ZM2) / CW2) + ANWWWW(1,2,2) = -4.00E+00 * ((S * ZM4) / CW2) + ANWWWW(1,2,3) = 4.00E+00 * ((S * ZM4) / CW2) + ANWWWW(1,2,4) = -3.20E+01 * ((QQ0 * ZM5) / CW2) + 8.00E+00 + $ * ((QQ0 * S * ZM3) / CW2) + ANWWWW(1,3,1) = -3.20E+01 * (ZM6 / CW2) + 1.60E+01 * ((S * ZM4) + $ / CW2) - 2.00E+00 * ((S2 * ZM2) / CW2) + ANWWWW(1,3,2) = -4.00E+00 * ((S * ZM4) / CW2) + ANWWWW(1,3,3) = 4.00E+00 * ((S * ZM4) / CW2) + ANWWWW(1,3,4) = 3.20E+01 * ((QQ0 * ZM5) / CW2) - 8.00E+00 + $ * ((QQ0 * S * ZM3) / CW2) + ANWWWW(1,4,1) = 0.00E+00 + ANWWWW(1,4,2) = 0.00E+00 + ANWWWW(1,4,3) = 0.00E+00 + ANWWWW(1,4,4) = 0.00E+00 + ANWWWW(2,1,1) = 0.00E+00 + ANWWWW(2,1,2) = 0.00E+00 + ANWWWW(2,1,3) = 0.00E+00 + ANWWWW(2,1,4) = 0.00E+00 + ANWWWW(2,2,1) = -1.60E+01 * ((S * ZM4) / CW2) + 4.00E+00 * ((S2 + $ * ZM2) / CW2) + ANWWWW(2,2,2) = 0.00E+00 + ANWWWW(2,2,3) = 0.00E+00 + ANWWWW(2,2,4) = -8.00E+00 * ((QQ0 * S * ZM3) / CW2 ) + ANWWWW(2,3,1) = 1.60E+01 * ((S * ZM4) / CW2) - 4.00E+00 * ((S2 + $ * ZM2) / CW2) + ANWWWW(2,3,2) = 0.00E+00 + ANWWWW(2,3,3) = 0.00E+00 + ANWWWW(2,3,4) = -8.00E+00 * ((QQ0 * S * ZM3) / CW2 ) + ANWWWW(2,4,1) = 0.00E+00 + ANWWWW(2,4,2) = 0.00E+00 + ANWWWW(2,4,3) = 0.00E+00 + ANWWWW(2,4,4) = 0.00E+00 + ANWWWW(3,1,1) = 0.00E+00 + ANWWWW(3,1,2) = 0.00E+00 + ANWWWW(3,1,3) = 0.00E+00 + ANWWWW(3,1,4) = 0.00E+00 + ANWWWW(3,2,1) = -2.00E+00 * ((S2 * ZM2) / CW2) + ANWWWW(3,2,2) = 4.00E+00 * ((S * ZM4) / CW2) + ANWWWW(3,2,3) = -4.00E+00 * ((S * ZM4) / CW2) + ANWWWW(3,2,4) = 0.00E+00 + ANWWWW(3,3,1) = -2.00E+00 * ((S2 * ZM2) / CW2) + ANWWWW(3,3,2) = 4.00E+00 * ((S * ZM4) / CW2) + ANWWWW(3,3,3) = -4.00E+00 * ((S * ZM4) / CW2) + ANWWWW(3,3,4) = 0.00E+00 + ANWWWW(3,4,1) = 0.00E+00 + ANWWWW(3,4,2) = 0.00E+00 + ANWWWW(3,4,3) = 0.00E+00 + ANWWWW(3,4,4) = 0.00E+00 + ANWWWW(4,1,1) = 0.00E+00 + ANWWWW(4,1,2) = 0.00E+00 + ANWWWW(4,1,3) = 0.00E+00 + ANWWWW(4,1,4) = 0.00E+00 + ANWWWW(4,2,1) = 0.00E+00 + ANWWWW(4,2,2) = 0.00E+00 + ANWWWW(4,2,3) = 0.00E+00 + ANWWWW(4,2,4) = 0.00E+00 + ANWWWW(4,3,1) = 0.00E+00 + ANWWWW(4,3,2) = 0.00E+00 + ANWWWW(4,3,3) = 0.00E+00 + ANWWWW(4,3,4) = 0.00E+00 + ANWWWW(4,4,1) = 0.00E+00 + ANWWWW(4,4,2) = 0.00E+00 + ANWWWW(4,4,3) = 0.00E+00 + ANWWWW(4,4,4) = 0.00E+00 +C + ADWWWW(1,1) = 1.00E+00 + ADWWWW(1,2) = 2.00E+00 * HM2 + S - 4.00E+00 * ZM2 + ADWWWW(1,3) = 2.00E+00 * HM2 + S - 4.00E+00 * ZM2 + ADWWWW(1,4) = 1.00E+00 + ADWWWW(2,1) = 0.00E+00 + ADWWWW(2,2) = -1.00E+00 * S + 4.00E+00 * ZM2 + ADWWWW(2,3) = S - 4.00E+00 * ZM2 + ADWWWW(2,4) = 0.00E+00 +C + AIWWWW(1) = 1.60E+01 * ((HG * HM * ZM6) / (CW2 * PROPH)) + $ - 1.60E+01 * ((HG * HM * S * ZM4) / (CW2 * PROPH)) + $ + 4.00E+00 * ((HG * HM * S2 * ZM2) / (CW2 * PROPH)) + AIWWWW(2) = 0.00E+00 + AIWWWW(3) = 1.60E+01 * ((HG * HM * ZM6) / (CW2 * PROPH)) + $ - 8.00E+00 * ((HG * HM * S * ZM4) / (CW2 * PROPH)) + AIWWWW(4) = 0.00E+00 +C +C RESTORE MISSING FACTORS + DO 100 J=1,4 + AIWWWW(J)=AIWWWW(J)*GSQ/(16.*ZM4) + DO 100 I=1,4 + DO 110 K=1,4 +110 ANWWWW(K,I,J)=ANWWWW(K,I,J)*GSQ/(16.*ZM4) +100 CONTINUE +C + RETURN + END diff --git a/ISAJET/code/ygenj.F b/ISAJET/code/ygenj.F new file mode 100644 index 00000000000..c98de042779 --- /dev/null +++ b/ISAJET/code/ygenj.F @@ -0,0 +1,26 @@ +#include "isajet/pilot.h" + LOGICAL FUNCTION YGENJ(I) +C +C GENERATE Y FOR TWOJET +C +#include "isajet/itapes.inc" +#include "isajet/jetlim.inc" +#include "isajet/jetpar.inc" +#include "isajet/primar.inc" +#include "isajet/ptpar.inc" +#include "isajet/totals.inc" + ACOSH(X)=ALOG(X+SQRT(X**2-1.0)) + YGENJ=.TRUE. + YMAX=ACOSH(HALFE/PT(I)) + YMIN=-YMAX + IF(YMAX.LT.YJMIN(I).OR.YMIN.GT.YJMAX(I)) GOTO 10 + YJ(I)=YJMIN(I)+(YJMAX(I)-YJMIN(I))*RANF() + IF(YJ(I).LT.YMIN.OR.YJ(I).GT.YMAX) GOTO 10 + TH(I)=2.*ATAN(EXP(-YJ(I))) + CTH(I)=COS(TH(I)) + STH(I)=SIN(TH(I)) + WT=WT*(YJMAX(I)-YJMIN(I)) + RETURN + 10 YGENJ=.FALSE. + RETURN + END diff --git a/ISAJET/code/zjj.F b/ISAJET/code/zjj.F new file mode 100644 index 00000000000..4f21527c346 --- /dev/null +++ b/ISAJET/code/zjj.F @@ -0,0 +1,420 @@ +#include "isajet/pilot.h" + SUBROUTINE ZJJ +C----------------------------------------------------------------------- +C +C Use MadGraph/Helas to generate Z + 2 jets after setup by +C ZJJ0 using cross section routines from MadGraph: +C ZJJ1: q1 q1b -> Z q2 q2b, q1 != q2 +C ZJJ2: g g -> Z q2 q2b +C ZJJ3: q1 q1b -> Z g g +C ZJJ4: q1 q1b -> Z q1 q1b +C ZJJ5: q1 q2 -> Z q1 q2 +C ZJJ6: q1 q1 -> Z q1 q1 +C ZJJ7: g q -> Z g q +C +C Note: The Z is always jet1, but the other two jets are +C symmetrized so a symmetry factor of 1/2 is needed for every +C subprocess. This is included by MadGraph for identical +C particles! +C +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/const.inc" +#include "isajet/q1q2.inc" +#include "isajet/itapes.inc" +#include "isajet/jetlim.inc" +#include "isajet/jetpar.inc" +#include "isajet/jetset.inc" +#include "isajet/partcl.inc" +#include "isajet/pinits.inc" +#include "isajet/pjets.inc" +#include "isajet/primar.inc" +#include "isajet/sstype.inc" +#include "isajet/totals.inc" +#include "isajet/mgkin.inc" +#include "isajet/mgcoms.inc" +#include "isajet/mgsigs.inc" +C + INTEGER IMAD(6) + REAL*8 P1(0:3),P2(0:3),P3(0:3),P4(0:3),P5(0:3) + EQUIVALENCE (P1(0),PJETS8(0,1)) + EQUIVALENCE (P2(0),PJETS8(0,2)) + EQUIVALENCE (P3(0),PJETS8(0,3)) + EQUIVALENCE (P4(0),PJETS8(0,4)) + EQUIVALENCE (P5(0),PJETS8(0,5)) + REAL QFCN,XX,QQ,RND,RANF,SIG,FJAC,STRUC,ALQCD + REAL*8 SZJJ1,WT8,TERM,SUM,SZJJ2,SZJJ3,SZJJ4,SIG8,SIGI8 + REAL*8 SZJJ5,SZJJ6,SZJJ7 + INTEGER IQ,IH,ISIG8,IFL1,IFL2,IM1,IM2,IQ1,IQ2,NTRY,I,II,K,IWT8 +C +C Map Jettype/2 to MadGraph + DATA IMAD/3,4,8,7,12,11/ +C +C Parton distributions + QFCN(XX,IQ,IH)=STRUC(XX,QQ,IQ,IDIN(IH))/XX +C +C Begin +C + NTRY=0 + NJSET=0 + NPTCL=0 +C +C Select process +C + RND=RANF() + ISIG8=0 + SIG=0 + DO 10 I=1,NSIG8 + SIG=SIG+WTSUM8(I)/NWT8(I) +10 CONTINUE + SUM=0 + DO 20 I=1,NSIG8 + II=ISORT8(NSIG8+1-I) + SUM=SUM+WTSUM8(II)/NWT8(II) + IF(SUM.GE.RND*SIG) THEN + ISIG8=II + GO TO 100 + ENDIF +20 CONTINUE + WRITE(ITLIS,*) 'ERROR IN ZJJ: NO MODE FOUND' + STOP99 +C +100 CONTINUE + SIG8=0 + FJAC=UNITS/SCM + NTRY=NTRY+1 + IF(NTRY.GT.NTRIES) THEN + WRITE(ITLIS,*) 'ERROR IN ZJJ: NTRY = ',NTRY + WRITE(ITLIS,*) 'PROCESS WAS ',(IDENT8(K,ISIG8),K=1,5) + SIGI8=WTSUM8(ISIG8)/NWT8(ISIG8) + WRITE(ITLIS,*) 'PROCESS SIGMA/MAX = ',SIGI8,WTMAX8(ISIG8) + WRITE(ITLIS,*) 'CHECK YOUR LIMITS OR INCREASE NTRIES' + STOP99 + ENDIF +C +C Cases 1,4: q1 q1b -> z q2 q2b +C + IF(IFUNC8(ISIG8).EQ.1.OR.IFUNC8(ISIG8).EQ.4) THEN + AMJET8(3)=ZMASS + IFL1=IABS(IDENT8(1,ISIG8)) + IM1=IMAD(IFL1) + IQ1=2*IFL1 + IQ2=IQ1+1 + AMJET8(1)=FMASS(IM1) + AMJET8(2)=FMASS(IM1) + IFL2=IABS(IDENT8(4,ISIG8)) + IM2=IMAD(IFL2) + AMJET8(4)=FMASS(IM2) + AMJET8(5)=FMASS(IM2) + DO 210 I=1,NTRIES + IWT8=I + CALL MULJET(WT8) + IF(WT8.GT.0) GO TO 220 +210 CONTINUE + WRITE(ITLIS,*) 'ERROR IN ZJJ: NO PHASE SPACE POINT IN ', + $ NTRIES,' TRIES' + STOP99 +220 NWTTOT=NWTTOT+IWT8-1 + NWT8(ISIG8)=NWT8(ISIG8)+IWT8-1 + X1=(P1(0)+P1(3))/ECM + X2=(P2(0)-P2(3))/ECM + QQ=P3(1)**2+P3(2)**2+P4(1)**2+P4(2)**2+P5(1)**2+ + $ P5(2)**2+AMJET8(3)**2+AMJET8(4)**2+AMJET8(5)**2 +C +C Subcases +C + IF(IDENT8(1,ISIG8).GT.0.AND.IDENT8(4,ISIG8).GT.0) THEN + IF(IFUNC8(ISIG8).EQ.1) THEN + TERM=SZJJ1(P1,P2,P3,P4,P5,IM1,IM2) + ELSE + TERM=SZJJ4(P1,P2,P3,P4,P5,IM1) + ENDIF + TERM=TERM*(4*PI*ALQCD(REAL(QQ)))**2 + TERM=TERM*WT8*FJAC*QFCN(X1,IQ1,1)*QFCN(X2,IQ2,2) + ELSEIF(IDENT8(1,ISIG8).GT.0.AND.IDENT8(4,ISIG8).LT.0) THEN + IF(IFUNC8(ISIG8).EQ.1) THEN + TERM=SZJJ1(P1,P2,P3,P5,P4,IM1,IM2) + ELSE + TERM=SZJJ4(P1,P2,P3,P5,P4,IM1) + ENDIF + TERM=TERM*(4*PI*ALQCD(REAL(QQ)))**2 + TERM=TERM*WT8*FJAC*QFCN(X1,IQ1,1)*QFCN(X2,IQ2,2) + ELSEIF(IDENT8(1,ISIG8).LT.0.AND.IDENT8(4,ISIG8).GT.0) THEN + IF(IFUNC8(ISIG8).EQ.1) THEN + TERM=SZJJ1(P1,P2,P3,P4,P5,IM1,IM2) + ELSE + TERM=SZJJ4(P1,P2,P3,P4,P5,IM1) + ENDIF + TERM=TERM*(4*PI*ALQCD(REAL(QQ)))**2 + TERM=TERM*WT8*FJAC*QFCN(X1,IQ2,1)*QFCN(X2,IQ1,2) + ELSEIF(IDENT8(1,ISIG8).LT.0.AND.IDENT8(4,ISIG8).LT.0) THEN + IF(IFUNC8(ISIG8).EQ.1) THEN + TERM=SZJJ1(P1,P2,P3,P5,P4,IM1,IM2) + ELSE + TERM=SZJJ4(P1,P2,P3,P5,P4,IM1) + ENDIF + TERM=TERM*(4*PI*ALQCD(REAL(QQ)))**2 + TERM=TERM*WT8*FJAC*QFCN(X1,IQ2,1)*QFCN(X2,IQ1,2) + ELSE + WRITE(ITLIS,*) 'ERROR IN ZJJ...INVALID FLAVOR FOR ZJJ1' + STOP99 + ENDIF + SIG8=0.5*TERM + GO TO 900 + ENDIF +C +C Case 2: g g -> z q2 q2b +C + IF(IFUNC8(ISIG8).EQ.2) THEN + AMJET8(3)=ZMASS + IFL1=IABS(IDENT8(1,ISIG8)) + AMJET8(1)=0 + AMJET8(2)=0 + IFL2=IABS(IDENT8(4,ISIG8)) + IM2=IMAD(IFL2) + AMJET8(4)=FMASS(IM2) + AMJET8(5)=FMASS(IM2) + DO 310 I=1,NTRIES + IWT8=I + CALL MULJET(WT8) + IF(WT8.GT.0) GO TO 320 +310 CONTINUE + WRITE(ITLIS,*) 'ERROR IN ZJJ: NO PHASE SPACE POINT IN ', + $ NTRIES,' TRIES' + STOP99 +320 NWTTOT=NWTTOT+IWT8-1 + NWT8(ISIG8)=NWT8(ISIG8)+IWT8-1 + X1=(P1(0)+P1(3))/ECM + X2=(P2(0)-P2(3))/ECM + QQ=P3(1)**2+P3(2)**2+P4(1)**2+P4(2)**2+P5(1)**2+ + $ P5(2)**2+AMJET8(3)**2+AMJET8(4)**2+AMJET8(5)**2 +C +C Subcases +C + IF(IDENT8(4,ISIG8).GT.0) THEN + TERM=SZJJ2(P1,P2,P3,P4,P5,IM2) + TERM=TERM*(4*PI*ALQCD(REAL(QQ)))**2 + TERM=TERM*WT8*FJAC*QFCN(X1,1,1)*QFCN(X2,1,2) + ELSEIF(IDENT8(4,ISIG8).LT.0) THEN + TERM=SZJJ2(P1,P2,P3,P5,P4,IM2) + TERM=TERM*(4*PI*ALQCD(REAL(QQ)))**2 + TERM=TERM*WT8*FJAC*QFCN(X1,1,1)*QFCN(X2,1,2) + ELSE + WRITE(ITLIS,*) 'ERROR IN ZJJ...INVALID FLAVOR FOR ZJJ2' + STOP99 + ENDIF + SIG8=0.5*TERM + GO TO 900 + ENDIF +C +C Case 3: q1 q1b -> z g g +C + IF(IFUNC8(ISIG8).EQ.3) THEN + AMJET8(3)=ZMASS + IFL1=IABS(IDENT8(1,ISIG8)) + IQ1=2*IFL1 + IQ2=IQ1+1 + IM1=IMAD(IFL1) + AMJET8(1)=FMASS(IM1) + AMJET8(2)=FMASS(IM1) + IFL2=9 + AMJET8(4)=0 + AMJET8(5)=0 + DO 410 I=1,NTRIES + IWT8=I + CALL MULJET(WT8) + IF(WT8.GT.0) GO TO 420 +410 CONTINUE + WRITE(ITLIS,*) 'ERROR IN ZJJ: NO PHASE SPACE POINT IN ', + $ NTRIES,' TRIES' + STOP99 +420 NWTTOT=NWTTOT+IWT8-1 + NWT8(ISIG8)=NWT8(ISIG8)+IWT8-1 + X1=(P1(0)+P1(3))/ECM + X2=(P2(0)-P2(3))/ECM + QQ=P3(1)**2+P3(2)**2+P4(1)**2+P4(2)**2+P5(1)**2+ + $ P5(2)**2+AMJET8(3)**2+AMJET8(4)**2+AMJET8(5)**2 +C +C Subcases +C + IF(IDENT8(1,ISIG8).GT.0) THEN + TERM=SZJJ3(P1,P2,P3,P4,P5,IM1) + TERM=TERM*(4*PI*ALQCD(REAL(QQ)))**2 + TERM=TERM*WT8*FJAC*QFCN(X1,IQ1,1)*QFCN(X2,IQ2,2) + ELSEIF(IDENT8(1,ISIG8).LT.0) THEN + TERM=SZJJ3(P2,P1,P3,P4,P5,IM1) + TERM=TERM*(4*PI*ALQCD(REAL(QQ)))**2 + TERM=TERM*WT8*FJAC*QFCN(X1,IQ2,1)*QFCN(X2,IQ1,2) + ELSE + WRITE(ITLIS,*) 'ERROR IN ZJJ...INVALID FLAVOR FOR ZJJ3' + STOP99 + ENDIF + SIG8=TERM + GO TO 900 + ENDIF +C +C Cases 5,6: q1 q2 -> z q1 q2 +C + IF(IFUNC8(ISIG8).EQ.5.OR.IFUNC8(ISIG8).EQ.6) THEN + IFL1=IABS(IDENT8(1,ISIG8)) + IM1=IMAD(IFL1) + IFL2=IABS(IDENT8(2,ISIG8)) + IM2=IMAD(IFL2) + IQ1=2*IFL1 + IQ2=2*IFL2 + IF(IDENT8(1,ISIG8).LT.0) IQ1=IQ1+1 + IF(IDENT8(2,ISIG8).LT.0) IQ2=IQ2+1 + AMJET8(1)=FMASS(IM1) + AMJET8(2)=FMASS(IM2) + AMJET8(3)=ZMASS + AMJET8(4)=FMASS(IM1) + AMJET8(5)=FMASS(IM2) + DO 510 I=1,NTRIES + IWT8=I + CALL MULJET(WT8) + IF(WT8.GT.0) GO TO 520 +510 CONTINUE + WRITE(ITLIS,*) 'ERROR IN ZJJ: NO PHASE SPACE POINT IN ', + $ NTRIES,' TRIES' + STOP99 +520 NWTTOT=NWTTOT+IWT8-1 + NWT8(ISIG8)=NWT8(ISIG8)+IWT8-1 + X1=(P1(0)+P1(3))/ECM + X2=(P2(0)-P2(3))/ECM + QQ=P3(1)**2+P3(2)**2+P4(1)**2+P4(2)**2+P5(1)**2+ + $ P5(2)**2+AMJET8(3)**2+AMJET8(4)**2+AMJET8(5)**2 +C +C Subcases +C + IF(IDENT8(1,ISIG8).EQ.IDENT8(4,ISIG8)) THEN + IF(IFUNC8(ISIG8).EQ.5) THEN + TERM=SZJJ5(P1,P2,P3,P4,P5,IM1,IM2) + ELSE + TERM=SZJJ6(P1,P2,P3,P4,P5,IM1) + ENDIF + TERM=TERM*(4*PI*ALQCD(REAL(QQ)))**2 + TERM=TERM*WT8*FJAC*QFCN(X1,IQ1,1)*QFCN(X2,IQ2,2) + ELSEIF(IDENT8(1,ISIG8).EQ.IDENT8(5,ISIG8)) THEN + TERM=SZJJ5(P1,P2,P3,P5,P4,IM1,IM2) + TERM=TERM*(4*PI*ALQCD(REAL(QQ)))**2 + TERM=TERM*WT8*FJAC*QFCN(X1,IQ1,1)*QFCN(X2,IQ2,2) + ELSE + WRITE(ITLIS,*) 'ERROR IN ZJJ...INVALID FLAVOR FOR ZJJ1' + STOP99 + ENDIF + SIG8=TERM + IF(IFL1.NE.IFL2) SIG8=0.5*SIG8 + GO TO 900 + ENDIF +C +C Case 7: g q -> z g q +C + IF(IFUNC8(ISIG8).EQ.7) THEN + IF(IDENT8(1,ISIG8).EQ.9) THEN + IFL1=IABS(IDENT8(2,ISIG8)) + IM1=IMAD(IFL1) + AMJET8(1)=0 + AMJET8(2)=FMASS(IM1) + IQ1=1 + IQ2=2*IFL1 + IF(IDENT8(2,ISIG8).LT.0) IQ2=IQ2+1 + ELSE + IFL1=IABS(IDENT8(1,ISIG8)) + IM1=IMAD(IFL1) + AMJET8(1)=FMASS(IM1) + AMJET8(2)=0 + IQ2=1 + IQ1=2*IFL1 + IF(IDENT8(1,ISIG8).LT.0) IQ1=IQ1+1 + ENDIF + AMJET8(3)=ZMASS + IF(IDENT8(4,ISIG8).EQ.9) THEN + AMJET8(4)=0 + AMJET8(5)=FMASS(IM1) + ELSE + AMJET8(4)=FMASS(IM1) + AMJET8(5)=0 + ENDIF + DO 610 I=1,NTRIES + IWT8=I + CALL MULJET(WT8) + IF(WT8.GT.0) GO TO 620 +610 CONTINUE + WRITE(ITLIS,*) 'ERROR IN ZJJ: NO PHASE SPACE POINT IN ', + $ NTRIES,' TRIES' + STOP99 +620 NWTTOT=NWTTOT+IWT8-1 + NWT8(ISIG8)=NWT8(ISIG8)+IWT8-1 + X1=(P1(0)+P1(3))/ECM + X2=(P2(0)-P2(3))/ECM + QQ=P3(1)**2+P3(2)**2+P4(1)**2+P4(2)**2+P5(1)**2+ + $ P5(2)**2+AMJET8(3)**2+AMJET8(4)**2+AMJET8(5)**2 +C +C Subcases +C + IF(IDENT8(1,ISIG8).EQ.9.AND.IDENT8(4,ISIG8).EQ.9) THEN + TERM=SZJJ7(P1,P2,P3,P4,P5,IM1) + TERM=TERM*(4*PI*ALQCD(REAL(QQ)))**2 + TERM=TERM*WT8*FJAC*QFCN(X1,IQ1,1)*QFCN(X2,IQ2,2) + ELSEIF(IDENT8(2,ISIG8).EQ.9.AND.IDENT8(4,ISIG8).EQ.9) THEN + TERM=SZJJ7(P2,P1,P3,P4,P5,IM1) + TERM=TERM*(4*PI*ALQCD(REAL(QQ)))**2 + TERM=TERM*WT8*FJAC*QFCN(X1,IQ1,1)*QFCN(X2,IQ2,2) + ELSEIF(IDENT8(1,ISIG8).EQ.9.AND.IDENT8(5,ISIG8).EQ.9) THEN + TERM=SZJJ7(P1,P2,P3,P5,P4,IM1) + TERM=TERM*(4*PI*ALQCD(REAL(QQ)))**2 + TERM=TERM*WT8*FJAC*QFCN(X1,IQ1,1)*QFCN(X2,IQ2,2) + ELSEIF(IDENT8(2,ISIG8).EQ.9.AND.IDENT8(5,ISIG8).EQ.9) THEN + TERM=SZJJ7(P2,P1,P3,P5,P4,IM1) + TERM=TERM*(4*PI*ALQCD(REAL(QQ)))**2 + TERM=TERM*WT8*FJAC*QFCN(X1,IQ1,1)*QFCN(X2,IQ2,2) + ELSE + WRITE(ITLIS,*) 'ERROR IN ZJJ...INVALID FLAVOR FOR ZJJ1' + STOP99 + ENDIF + SIG8=0.5*TERM + GO TO 900 + ENDIF +C +C Increment totals and test +C +900 WTTOT8=WTTOT8+SIG8 + NWTTOT=NWTTOT+1 + WTSUM8(ISIG8)=WTSUM8(ISIG8)+SIG8 + WTMAX8(ISIG8)=MAX(WTMAX8(ISIG8),SIG8) + NWT8(ISIG8)=NWT8(ISIG8)+1 + IF(SIG8.LT.RANF()*WTMAX8(ISIG8)) GO TO 100 +C +C Good event +C + DO 910 I=1,3 + DO 911 K=1,3 + PJETS(K,I)=PJETS8(K,I+2) +911 CONTINUE + PJETS(4,I)=PJETS8(0,I+2) + PJETS(5,I)=AMJET8(I+2) + IDJETS(I)=IDENT8(I+2,ISIG8) +910 CONTINUE + DO 920 I=1,2 + DO 921 K=1,3 + PINITS(K,I)=PJETS8(K,I) +921 CONTINUE + PINITS(4,I)=PJETS8(0,I) + PINITS(5,I)=AMJET8(I) + IDINIT(I)=IDENT8(I,ISIG8) +920 CONTINUE +C + QSQ=QQ + SHAT=(P1(0)+P2(0))**2-(P1(3)+P2(3))**2 + PBEAM(1)=(1.-X1)*HALFE + PBEAM(2)=(1.-X2)*HALFE +C +C Set /TOTALS/ +C + NKINPT=NWTTOT + SUMWT=WTTOT8 +C + RETURN + END diff --git a/ISAJET/code/zjj0.F b/ISAJET/code/zjj0.F new file mode 100644 index 00000000000..b074def6d23 --- /dev/null +++ b/ISAJET/code/zjj0.F @@ -0,0 +1,577 @@ +#include "isajet/pilot.h" + SUBROUTINE ZJJ0 +C----------------------------------------------------------------------- +C +C Initialize MadGraph/Helas to generate Z + 2 jets. +C Cross section routines from MadGraph: +C ZJJ1: q1 q1b -> Z q2 q2b, q1 != q2 +C ZJJ2: g g -> Z q2 q2b +C ZJJ3: q1 q1b -> Z g g +C ZJJ4: q1 q1b -> Z q1 q1b +C ZJJ5: q1 q2 -> Z q1 q2 +C ZJJ6: q1 q1 -> Z q1 q1 +C ZJJ7: g q -> Z g q +C +C Note: The Z is always jet1, but the other two jets are +C symmetrized so a symmetry factor of 1/2 is needed for every +C subprocess. This is included by MadGraph for identical +C particles! +C +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/const.inc" +#include "isajet/q1q2.inc" +#include "isajet/itapes.inc" +#include "isajet/jetlim.inc" +#include "isajet/primar.inc" +#include "isajet/sstype.inc" +#include "isajet/mgkin.inc" +#include "isajet/mgcoms.inc" +#include "isajet/mgsigs.inc" +C + INTEGER IMAD(6) + INTEGER IQ1,IQ2,IQ4,IQ5,IFL1,IFL2,IM1,IM2,I,NEV,KK,II,J + REAL*8 P1(0:3),P2(0:3),P3(0:3),P4(0:3),P5(0:3) + EQUIVALENCE (P1(0),PJETS8(0,1)) + EQUIVALENCE (P2(0),PJETS8(0,2)) + EQUIVALENCE (P3(0),PJETS8(0,3)) + EQUIVALENCE (P4(0),PJETS8(0,4)) + EQUIVALENCE (P5(0),PJETS8(0,5)) + REAL*8 WT,TERM,FJAC,SZJJ1,SZJJ2,SZJJ3,SZJJ4,SUM + REAL*8 SZJJ5,SZJJ6,SZJJ7 + REAL X1,X2,XX,QQ,TMP(MXSIG8),QFCN,STRUC,ALQCD + INTEGER IQ,IH,NPT,NNN,ISUM +C +C Map Jettype/2 to MadGraph + DATA IMAD/3,4,8,7,12,11/ +C +C Parton distributions + QFCN(XX,IQ,IH)=STRUC(XX,QQ,IQ,IDIN(IH))/XX +C +C Begin +C + NPT=MAX(NSIGMA,100) + WRITE(ITLIS,1000) NTRIES,NPT +1000 FORMAT(//' INITIALIZING CROSS SECTIONS WITH',I6, + $' TRIES FOR',I6,' POINTS EACH:') + FJAC=UNITS/SCM + WTTOT8=0 + NSIG8=0 +C +C Cases 1,4: q1 q1b -> z q2 q2b +C + AMJET8(3)=ZMASS + DO 100 IFL1=1,5 + IM1=IMAD(IFL1) + IQ1=2*IFL1 + IQ2=IQ1+1 + AMJET8(1)=FMASS(IM1) + AMJET8(2)=FMASS(IM1) + DO 110 IFL2=1,6 + IM2=IMAD(IFL2) + IQ4=2*IFL2 + IQ5=IQ4+1 + AMJET8(4)=FMASS(IM2) + AMJET8(5)=FMASS(IM2) +C +C Subcase 1a: 3=z, 4=q, 5=qb +C + IF(GOQ(IQ4,2).AND.GOQ(IQ5,3)) THEN + IF(NSIG8+2.GT.MXSIG8) GO TO 999 + DO 120 I=1,2 + WTSUM8(NSIG8+I)=0 + WTMAX8(NSIG8+I)=0 + NWT8(NSIG8+I)=0 + IDENT8(1,NSIG8+I)=(3-2*I)*IFL1 + IDENT8(2,NSIG8+I)=-(3-2*I)*IFL1 + IDENT8(3,NSIG8+I)=IDZ + IDENT8(4,NSIG8+I)=IFL2 + IDENT8(5,NSIG8+I)=-IFL2 + IF(IFL1.EQ.IFL2) THEN + IFUNC8(NSIG8+I)=4 + ELSE + IFUNC8(NSIG8+I)=1 + ENDIF + NNN=0 + DO 125 NEV=1,NTRIES + IF(NNN.GT.NPT) GO TO 120 + CALL MULJET(WT) + NWT8(NSIG8+I)=NWT8(NSIG8+I)+1 + NWTTOT=NWTTOT+1 + IF(WT.GT.0) THEN + NNN=NNN+1 + X1=(P1(0)+P1(3))/ECM + X2=(P2(0)-P2(3))/ECM + QQ=P3(1)**2+P3(2)**2+P4(1)**2+P4(2)**2+P5(1)**2+ + $ P5(2)**2+AMJET8(3)**2+AMJET8(4)**2+AMJET8(5)**2 + IF(I.EQ.1) THEN + IF(IFL2.EQ.IFL1) THEN + TERM=SZJJ4(P1,P2,P3,P4,P5,IM1) + ELSE + TERM=SZJJ1(P1,P2,P3,P4,P5,IM1,IM2) + ENDIF + TERM=TERM*(4*PI*ALQCD(REAL(QQ)))**2 + TERM=TERM*WT*FJAC*QFCN(X1,IQ1,1)*QFCN(X2,IQ2,2) + ELSE + IF(IFL2.EQ.IFL1) THEN + TERM=SZJJ4(P2,P1,P3,P4,P5,IM1) + ELSE + TERM=SZJJ1(P2,P1,P3,P4,P5,IM1,IM2) + ENDIF + TERM=TERM*(4*PI*ALQCD(REAL(QQ)))**2 + TERM=TERM*WT*FJAC*QFCN(X1,IQ2,1)*QFCN(X2,IQ1,2) + ENDIF + TERM=0.5*TERM + WTTOT8=WTTOT8+TERM + WTSUM8(NSIG8+I)=WTSUM8(NSIG8+I)+TERM + WTMAX8(NSIG8+I)=MAX(WTMAX8(NSIG8+I),TERM) + ENDIF +125 CONTINUE + WRITE(ITLIS,*) ' ZJJ0 WARNING: INSUFFICIENT TRIES FOR ', + $ (IDENT8(KK,NSIG8+I),KK=1,5) +120 CONTINUE + NSIG8=NSIG8+2 + ENDIF +C +C Subcase 1b: 3=z, 4=qb, 5=q +C + IF(GOQ(IQ5,2).AND.GOQ(IQ4,3)) THEN + IF(NSIG8+2.GT.MXSIG8) GO TO 999 + DO 130 I=1,2 + WTSUM8(NSIG8+I)=0 + WTMAX8(NSIG8+I)=0 + NWT8(NSIG8+I)=0 + IDENT8(1,NSIG8+I)=(3-2*I)*IFL1 + IDENT8(2,NSIG8+I)=-(3-2*I)*IFL1 + IDENT8(3,NSIG8+I)=IDZ + IDENT8(4,NSIG8+I)=-IFL2 + IDENT8(5,NSIG8+I)=IFL2 + IF(IFL1.EQ.IFL2) THEN + IFUNC8(NSIG8+I)=4 + ELSE + IFUNC8(NSIG8+I)=1 + ENDIF + NNN=0 + DO 135 NEV=1,NTRIES + IF(NNN.GT.NPT) GO TO 130 + CALL MULJET(WT) + NWT8(NSIG8+I)=NWT8(NSIG8+I)+1 + NWTTOT=NWTTOT+1 + IF(WT.GT.0) THEN + NNN=NNN+1 + X1=(P1(0)+P1(3))/ECM + X2=(P2(0)-P2(3))/ECM + QQ=P3(1)**2+P3(2)**2+P4(1)**2+P4(2)**2+P5(1)**2+ + $ P5(2)**2+AMJET8(3)**2+AMJET8(4)**2+AMJET8(5)**2 + IF(I.EQ.1) THEN + IF(IFL1.EQ.IFL2) THEN + TERM=SZJJ4(P1,P2,P3,P5,P4,IM1) + ELSE + TERM=SZJJ1(P1,P2,P3,P5,P4,IM1,IM2) + ENDIF + TERM=TERM*(4*PI*ALQCD(REAL(QQ)))**2 + TERM=TERM*WT*FJAC*QFCN(X1,IQ1,1)*QFCN(X2,IQ2,2) + ELSE + IF(IFL1.EQ.IFL2) THEN + TERM=SZJJ4(P2,P1,P3,P5,P4,IM1) + ELSE + TERM=SZJJ1(P2,P1,P3,P5,P4,IM1,IM2) + ENDIF + TERM=TERM*(4*PI*ALQCD(REAL(QQ)))**2 + TERM=TERM*WT*FJAC*QFCN(X1,IQ2,1)*QFCN(X2,IQ1,2) + ENDIF + TERM=0.5*TERM + WTTOT8=WTTOT8+TERM + WTSUM8(NSIG8+I)=WTSUM8(NSIG8+I)+TERM + WTMAX8(NSIG8+I)=MAX(WTMAX8(NSIG8+I),TERM) + ENDIF +135 CONTINUE + WRITE(ITLIS,*) ' ZJJ0 WARNING: INSUFFICIENT TRIES FOR ', + $ (IDENT8(KK,NSIG8+I),KK=1,5) +130 CONTINUE + NSIG8=NSIG8+2 + ENDIF +110 CONTINUE +100 CONTINUE +C +C Case 2: g g -> z q2 q2b +C + AMJET8(3)=ZMASS + IFL1=9 + AMJET8(1)=0 + AMJET8(2)=0 + DO 210 IFL2=1,6 + IM2=IMAD(IFL2) + IQ4=2*IFL2 + IQ5=IQ4+1 + AMJET8(4)=FMASS(IM2) + AMJET8(5)=FMASS(IM2) +C +C Subcase 2a: 3=z, 4=q, 5=qb +C + IF(GOQ(IQ4,2).AND.GOQ(IQ5,3)) THEN + IF(NSIG8+1.GT.MXSIG8) GO TO 999 + WTSUM8(NSIG8+1)=0 + WTMAX8(NSIG8+1)=0 + NWT8(NSIG8+1)=0 + IDENT8(1,NSIG8+1)=IDGL + IDENT8(2,NSIG8+1)=IDGL + IDENT8(3,NSIG8+1)=IDZ + IDENT8(4,NSIG8+1)=IFL2 + IDENT8(5,NSIG8+1)=-IFL2 + IFUNC8(NSIG8+1)=2 + NNN=0 + DO 225 NEV=1,NTRIES + IF(NNN.GT.NPT) GO TO 220 + CALL MULJET(WT) + NWT8(NSIG8+1)=NWT8(NSIG8+1)+1 + NWTTOT=NWTTOT+1 + IF(WT.GT.0) THEN + NNN=NNN+1 + X1=(P1(0)+P1(3))/ECM + X2=(P2(0)-P2(3))/ECM + QQ=P3(1)**2+P3(2)**2+P4(1)**2+P4(2)**2+P5(1)**2+ + $ P5(2)**2+AMJET8(3)**2+AMJET8(4)**2+AMJET8(5)**2 + TERM=SZJJ2(P1,P2,P3,P4,P5,IM2) + TERM=TERM*(4*PI*ALQCD(REAL(QQ)))**2 + TERM=TERM*WT*FJAC*QFCN(X1,1,1)*QFCN(X2,1,2) + TERM=0.5*TERM + WTTOT8=WTTOT8+TERM + WTSUM8(NSIG8+1)=WTSUM8(NSIG8+1)+TERM + WTMAX8(NSIG8+1)=MAX(WTMAX8(NSIG8+1),TERM) + ENDIF +225 CONTINUE + WRITE(ITLIS,*) ' ZJJ0 WARNING: INSUFFICIENT TRIES FOR ', + $ (IDENT8(KK,NSIG8+1),KK=1,5) +220 CONTINUE + NSIG8=NSIG8+1 + ENDIF +C +C Subcase 2b: 3=z, 4=qb, 5=q +C + IF(GOQ(IQ5,2).AND.GOQ(IQ4,3)) THEN + IF(NSIG8+1.GT.MXSIG8) GO TO 999 + WTSUM8(NSIG8+1)=0 + WTMAX8(NSIG8+1)=0 + NWT8(NSIG8+1)=0 + IDENT8(1,NSIG8+1)=IDGL + IDENT8(2,NSIG8+1)=IDGL + IDENT8(3,NSIG8+1)=IDZ + IDENT8(4,NSIG8+1)=-IFL2 + IDENT8(5,NSIG8+1)=IFL2 + IFUNC8(NSIG8+1)=2 + NNN=0 + DO 235 NEV=1,NTRIES + IF(NNN.GT.NPT) GO TO 230 + CALL MULJET(WT) + NWT8(NSIG8+1)=NWT8(NSIG8+1)+1 + NWTTOT=NWTTOT+1 + IF(WT.GT.0) THEN + NNN=NNN+1 + X1=(P1(0)+P1(3))/ECM + X2=(P2(0)-P2(3))/ECM + QQ=P3(1)**2+P3(2)**2+P4(1)**2+P4(2)**2+P5(1)**2+ + $ P5(2)**2+AMJET8(3)**2+AMJET8(4)**2+AMJET8(5)**2 + TERM=SZJJ2(P1,P2,P3,P5,P4,IM2) + TERM=TERM*(4*PI*ALQCD(REAL(QQ)))**2 + TERM=TERM*WT*FJAC*QFCN(X1,1,1)*QFCN(X2,1,2) + TERM=0.5*TERM + WTTOT8=WTTOT8+TERM + WTSUM8(NSIG8+1)=WTSUM8(NSIG8+1)+TERM + WTMAX8(NSIG8+1)=MAX(WTMAX8(NSIG8+1),TERM) + ENDIF +235 CONTINUE + WRITE(ITLIS,*) ' ZJJ0 WARNING: INSUFFICIENT TRIES FOR ', + $ (IDENT8(KK,NSIG8+1),KK=1,5) +230 CONTINUE + NSIG8=NSIG8+1 + ENDIF +210 CONTINUE +C +C Case 3: q1 q1b -> z g g +C + AMJET8(3)=ZMASS + AMJET8(4)=0 + AMJET8(5)=0 + DO 310 IFL1=1,5 + IM1=IMAD(IFL1) + IQ1=2*IFL1 + IQ2=IQ1+1 + AMJET8(1)=FMASS(IM1) + AMJET8(2)=FMASS(IM1) +C + IF(GOQ(1,2).AND.GOQ(1,3)) THEN + IF(NSIG8+2.GT.MXSIG8) GO TO 999 + DO 320 I=1,2 + WTSUM8(NSIG8+I)=0 + WTMAX8(NSIG8+I)=0 + NWT8(NSIG8+I)=0 + IDENT8(1,NSIG8+I)=(3-2*I)*IFL1 + IDENT8(2,NSIG8+I)=-(3-2*I)*IFL1 + IDENT8(3,NSIG8+I)=IDZ + IDENT8(4,NSIG8+I)=IDGL + IDENT8(5,NSIG8+I)=IDGL + IFUNC8(NSIG8+I)=3 + NNN=0 + DO 325 NEV=1,NTRIES + IF(NNN.GT.NPT) GO TO 320 + CALL MULJET(WT) + NWT8(NSIG8+I)=NWT8(NSIG8+I)+1 + NWTTOT=NWTTOT+1 + IF(WT.GT.0) THEN + NNN=NNN+1 + X1=(P1(0)+P1(3))/ECM + X2=(P2(0)-P2(3))/ECM + QQ=P3(1)**2+P3(2)**2+P4(1)**2+P4(2)**2+P5(1)**2+ + $ P5(2)**2+AMJET8(3)**2+AMJET8(4)**2+AMJET8(5)**2 + IF(I.EQ.1) THEN + TERM=SZJJ3(P1,P2,P3,P4,P5,IM1) + TERM=TERM*(4*PI*ALQCD(REAL(QQ)))**2 + TERM=TERM*WT*FJAC*QFCN(X1,IQ1,1)*QFCN(X2,IQ2,2) + ELSE + TERM=SZJJ3(P2,P1,P3,P4,P5,IM1) + TERM=TERM*(4*PI*ALQCD(REAL(QQ)))**2 + TERM=TERM*WT*FJAC*QFCN(X1,IQ2,1)*QFCN(X2,IQ1,2) + ENDIF + WTTOT8=WTTOT8+TERM + WTSUM8(NSIG8+I)=WTSUM8(NSIG8+I)+TERM + WTMAX8(NSIG8+I)=MAX(WTMAX8(NSIG8+I),TERM) + ENDIF +325 CONTINUE + WRITE(ITLIS,*) ' ZJJ0 WARNING: INSUFFICIENT TRIES FOR ', + $ (IDENT8(KK,NSIG8+I),KK=1,5) +320 CONTINUE + NSIG8=NSIG8+2 + ENDIF +310 CONTINUE +C +C Cases 5,6: q1 q2 -> Z q1 q2, q1 != q2 +C Since we integrate over the Z decay, we can use the same +C cross sections for quarks (I=1) and antiquarks (I=2). +C + DO 400 IFL1=1,5 + IM1=IMAD(IFL1) + DO 410 IFL2=1,5 + IM2=IMAD(IFL2) + AMJET8(1)=FMASS(IM1) + AMJET8(2)=FMASS(IM2) + AMJET8(3)=ZMASS + AMJET8(4)=FMASS(IM1) + AMJET8(5)=FMASS(IM2) + DO 420 I=1,2 + IQ1=2*IFL1+I-1 + IQ2=2*IFL2+I-1 + IF(GOQ(IQ1,1).AND.GOQ(IQ2,2)) THEN + WTSUM8(NSIG8+1)=0 + WTMAX8(NSIG8+1)=0 + NWT8(NSIG8+1)=0 + IDENT8(1,NSIG8+1)=(3-2*I)*IFL1 + IDENT8(2,NSIG8+1)=(3-2*I)*IFL2 + IDENT8(3,NSIG8+1)=IDZ + IDENT8(4,NSIG8+1)=(3-2*I)*IFL1 + IDENT8(5,NSIG8+1)=(3-2*I)*IFL2 + IF(IFL1.EQ.IFL2) THEN + IFUNC8(NSIG8+1)=6 + ELSE + IFUNC8(NSIG8+1)=5 + ENDIF + NNN=0 + DO 425 NEV=1,NTRIES + IF(NNN.GT.NPT) THEN + NSIG8=NSIG8+1 + GO TO 420 + ENDIF + CALL MULJET(WT) + NWT8(NSIG8+1)=NWT8(NSIG8+1)+1 + NWTTOT=NWTTOT+1 + IF(WT.GT.0) THEN + NNN=NNN+1 + X1=(P1(0)+P1(3))/ECM + X2=(P2(0)-P2(3))/ECM + QQ=P3(1)**2+P3(2)**2+P4(1)**2+P4(2)**2+P5(1)**2+ + $ P5(2)**2+AMJET8(3)**2+AMJET8(4)**2+AMJET8(5)**2 + IF(IFL1.EQ.IFL2) THEN + TERM=SZJJ6(P1,P2,P3,P4,P5,IM1) + TERM=TERM*(4*PI*ALQCD(REAL(QQ)))**2 + TERM=TERM*WT*FJAC*QFCN(X1,IQ1,1)*QFCN(X2,IQ2,2) + ELSE + TERM=SZJJ5(P2,P1,P3,P4,P5,IM1,IM2) + TERM=TERM*(4*PI*ALQCD(REAL(QQ)))**2 + TERM=TERM*WT*FJAC*QFCN(X1,IQ2,1)*QFCN(X2,IQ1,2) + TERM=0.5*TERM + ENDIF + WTTOT8=WTTOT8+TERM + WTSUM8(NSIG8+1)=WTSUM8(NSIG8+1)+TERM + WTMAX8(NSIG8+1)=MAX(WTMAX8(NSIG8+1),TERM) + ENDIF +425 CONTINUE + WRITE(ITLIS,*) ' ZJJ0 WARNING: INSUFFICIENT TRIES FOR ', + $ (IDENT8(KK,NSIG8+1),KK=1,5) + NSIG8=NSIG8+1 + ENDIF +420 CONTINUE +410 CONTINUE +400 CONTINUE +C +C Case 7: g q -> z g q +C Since we integrate over the Z decay, we can use the same +C cross sections for quarks (I=1) and antiquarks (I=2). +C + DO 500 IFL2=1,5 + IM2=IMAD(IFL2) + DO 510 I=1,2 + IQ5=2*IFL2+I-1 +C +C Subcase 7a: 3=z, 4=g, 5=q (J=1,2 for initial states) +C + IF(GOQ(1,2).AND.GOQ(IQ5,3)) THEN + IF(NSIG8+2.GT.MXSIG8) GO TO 999 + AMJET8(3)=ZMASS + AMJET8(4)=0 + AMJET8(5)=FMASS(IM2) + DO 520 J=1,2 + WTSUM8(NSIG8+J)=0 + WTMAX8(NSIG8+J)=0 + NWT8(NSIG8+J)=0 + IF(J.EQ.1) THEN + IDENT8(1,NSIG8+J)=IDGL + IDENT8(2,NSIG8+J)=(3-2*I)*IFL2 + IQ1=1 + IQ2=IQ5 + AMJET8(1)=0 + AMJET8(2)=FMASS(IM2) + ELSE + IDENT8(2,NSIG8+J)=IDGL + IDENT8(1,NSIG8+J)=(3-2*I)*IFL2 + IQ1=IQ5 + IQ2=1 + AMJET8(2)=0 + AMJET8(1)=FMASS(IM2) + ENDIF + IDENT8(3,NSIG8+J)=IDZ + IDENT8(4,NSIG8+J)=IDGL + IDENT8(5,NSIG8+J)=(3-2*I)*IFL2 + IFUNC8(NSIG8+J)=7 + NNN=0 + DO 525 NEV=1,NTRIES + IF(NNN.GT.NPT) GO TO 520 + CALL MULJET(WT) + NWT8(NSIG8+J)=NWT8(NSIG8+J)+1 + NWTTOT=NWTTOT+1 + IF(WT.GT.0) THEN + NNN=NNN+1 + X1=(P1(0)+P1(3))/ECM + X2=(P2(0)-P2(3))/ECM + QQ=P3(1)**2+P3(2)**2+P4(1)**2+P4(2)**2+P5(1)**2+ + $ P5(2)**2+AMJET8(3)**2+AMJET8(4)**2+AMJET8(5)**2 + IF(J.EQ.1) THEN + TERM=SZJJ7(P1,P2,P3,P4,P5,IM2) + ELSE + TERM=SZJJ7(P2,P1,P3,P4,P5,IM2) + ENDIF + TERM=TERM*(4*PI*ALQCD(REAL(QQ)))**2 + TERM=TERM*WT*FJAC*QFCN(X1,IQ1,1)*QFCN(X2,IQ2,2) + TERM=0.5*TERM + WTTOT8=WTTOT8+TERM + WTSUM8(NSIG8+J)=WTSUM8(NSIG8+J)+TERM + WTMAX8(NSIG8+J)=MAX(WTMAX8(NSIG8+J),TERM) + ENDIF +525 CONTINUE + WRITE(ITLIS,*) ' ZJJ0 WARNING: INSUFFICIENT TRIES FOR ', + $ (IDENT8(KK,NSIG8+1),KK=1,5) +520 CONTINUE + NSIG8=NSIG8+2 + ENDIF +C +C Subcase 7b: 3=z, 4=q, 5=g +C + IF(GOQ(IQ5,2).AND.GOQ(1,3)) THEN + IF(NSIG8+2.GT.MXSIG8) GO TO 999 + AMJET8(3)=ZMASS + AMJET8(4)=FMASS(IM2) + AMJET8(5)=0 + DO 530 J=1,2 + WTSUM8(NSIG8+J)=0 + WTMAX8(NSIG8+J)=0 + NWT8(NSIG8+J)=0 + IF(J.EQ.1) THEN + IDENT8(1,NSIG8+J)=IDGL + IDENT8(2,NSIG8+J)=(3-2*I)*IFL2 + IQ1=1 + IQ2=IQ5 + AMJET8(1)=0 + AMJET8(2)=FMASS(IM2) + ELSE + IDENT8(2,NSIG8+J)=IDGL + IDENT8(1,NSIG8+J)=(3-2*I)*IFL2 + IQ1=IQ5 + IQ2=1 + AMJET8(2)=0 + AMJET8(1)=FMASS(IM2) + ENDIF + IDENT8(3,NSIG8+J)=IDZ + IDENT8(4,NSIG8+J)=(3-2*I)*IFL2 + IDENT8(5,NSIG8+J)=IDGL + IFUNC8(NSIG8+J)=7 + NNN=0 + DO 535 NEV=1,NTRIES + IF(NNN.GT.NPT) GO TO 530 + CALL MULJET(WT) + NWT8(NSIG8+J)=NWT8(NSIG8+J)+1 + NWTTOT=NWTTOT+1 + IF(WT.GT.0) THEN + NNN=NNN+1 + X1=(P1(0)+P1(3))/ECM + X2=(P2(0)-P2(3))/ECM + QQ=P3(1)**2+P3(2)**2+P4(1)**2+P4(2)**2+P5(1)**2+ + $ P5(2)**2+AMJET8(3)**2+AMJET8(4)**2+AMJET8(5)**2 + IF(J.EQ.1) THEN + TERM=SZJJ2(P1,P2,P3,P5,P4,IM2) + ELSE + TERM=SZJJ2(P2,P1,P3,P5,P4,IM2) + ENDIF + TERM=TERM*(4*PI*ALQCD(REAL(QQ)))**2 + TERM=TERM*WT*FJAC*QFCN(X1,1,1)*QFCN(X2,1,2) + TERM=0.5*TERM + WTTOT8=WTTOT8+TERM + WTSUM8(NSIG8+J)=WTSUM8(NSIG8+J)+TERM + WTMAX8(NSIG8+J)=MAX(WTMAX8(NSIG8+J),TERM) + ENDIF +535 CONTINUE + WRITE(ITLIS,*) ' ZJJ0 WARNING: INSUFFICIENT TRIES FOR ', + $ (IDENT8(KK,NSIG8+1),KK=1,5) +530 CONTINUE + NSIG8=NSIG8+2 + ENDIF +510 CONTINUE +500 CONTINUE +C +C Sort using initial cross sections +C + SUM=0 + ISUM=0 + DO 991 I=1,NSIG8 + ISORT8(I)=NSIG8+1-I + TMP(I)=WTSUM8(I)/NWT8(I) + SUM=SUM+WTSUM8(I) + ISUM=ISUM+NWT8(I) +991 CONTINUE + IF(NSIG8.GT.1) CALL SORTTF(TMP,ISORT8,NSIG8) + WRITE(ITLIS,*) + WRITE(ITLIS,9001) +9001 FORMAT(6X,'INITIAL MULTIJET CROSS SECTIONS'/ + $6X,'PROCESS',18X,'SIGMA',10X,'MAX(SIGMA)') + DO 992 I=1,NSIG8 + II=ISORT8(I) + WRITE(ITLIS,9002) (IDENT8(KK,II),KK=1,5),TMP(II),WTMAX8(II) +9002 FORMAT(2X,5I5,2E15.5) +992 CONTINUE + RETURN +C +C Errors +C +999 WRITE(ITLIS,*) 'ERROR IN ZJJ0, NSIG8 = ',NSIG8 + STOP 99 + END diff --git a/ISAJET/code/zjj1.F b/ISAJET/code/zjj1.F new file mode 100644 index 00000000000..07f5a3054d8 --- /dev/null +++ b/ISAJET/code/zjj1.F @@ -0,0 +1,85 @@ +#include "isajet/pilot.h" + REAL*8 FUNCTION ZJJ1(P1, P2, P3, P4, P5,NHEL,IM1,IM2) +C +C Function generated by Madgraph + hand coding +C Returns amplitude squared summed/avg over colors +C for the point in phase space P1,P2,P3,P4,... +C and helicity NHEL(1),NHEL(2),.... +C for process : q(im1) q~(im1) -> z q(im2) q~(im2) +C with Madgraph codes IM1 != IM2 +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +C +C CONSTANTS +C + INTEGER NGRAPHS, NEIGEN, NEXTERNAL + PARAMETER (NGRAPHS= 4,NEIGEN= 1,NEXTERNAL=5) + REAL*8 ZERO + PARAMETER (ZERO=0D0) +C +C ARGUMENTS +C + REAL*8 P1(0:3),P2(0:3),P3(0:3),P4(0:3),P5(0:3) + INTEGER NHEL(NEXTERNAL) + INTEGER IM1,IM2 +C +C LOCAL VARIABLES +C + INTEGER I,J + REAL*8 EIGEN_VAL(NEIGEN), EIGEN_VEC(NGRAPHS,NEIGEN) + COMPLEX*16 ZTEMP + COMPLEX*16 AMP(NGRAPHS) + COMPLEX*16 W1(6) , W2(6) , W3(6) , W4(6) , W5(6) + COMPLEX*16 W6(6) , W7(6) , W8(6) , W9(6) , W10(6) + COMPLEX*16 W11(6) , W12(6) +C +C GLOBAL VARIABLES +C +#include "isajet/mgcoms.inc" +C +C COLOR DATA +C + DATA EIGEN_VAL(1 )/ 8.8888888888888884D-01 / + DATA EIGEN_VEC(1 ,1 )/ -5.0000000000000000D-01 / + DATA EIGEN_VEC(2 ,1 )/ -5.0000000000000000D-01 / + DATA EIGEN_VEC(3 ,1 )/ -5.0000000000000000D-01 / + DATA EIGEN_VEC(4 ,1 )/ -5.0000000000000000D-01 / +C ---------- +C BEGIN CODE +C ---------- + CALL IXXXXX(P1 ,FMASS(IM1),NHEL(1 ), 1,W1 ) + CALL OXXXXX(P2 ,FMASS(IM1),NHEL(2 ),-1,W2 ) + CALL VXXXXX(P3 ,ZMASS,NHEL(3 ), 1,W3 ) + CALL OXXXXX(P4 ,FMASS(IM2),NHEL(4 ), 1,W4 ) + CALL IXXXXX(P5 ,FMASS(IM2),NHEL(5 ),-1,W5 ) + IF(IM1.EQ.3.OR.IM1.EQ.7.OR.IM1.EQ.11) THEN + CALL FVOXXX(W2 ,W3 ,GZD,FMASS(IM1),FWIDTH(IM1),W6 ) + ELSE + CALL FVOXXX(W2 ,W3 ,GZU,FMASS(IM1),FWIDTH(IM1),W6 ) + ENDIF + CALL JIOXXX(W1 ,W6 ,GG,ZERO,ZERO,W7 ) + CALL IOVXXX(W5 ,W4 ,W7 ,GG,AMP(1 )) + CALL FVIXXX(W1 ,W3 ,GZD,FMASS(IM1),FWIDTH(IM2),W8 ) + CALL JIOXXX(W8 ,W2 ,GG,ZERO,ZERO,W9 ) + CALL IOVXXX(W5 ,W4 ,W9 ,GG,AMP(2 )) + CALL JIOXXX(W1 ,W2 ,GG,ZERO,ZERO,W10 ) + CALL FVOXXX(W4 ,W10 ,GG,FMASS(IM2),FWIDTH(IM2),W11 ) + CALL IOVXXX(W5 ,W11 ,W3 ,GZD,AMP(3 )) + IF(IM2.EQ.3.OR.IM2.EQ.7.OR.IM2.EQ.11) THEN + CALL FVOXXX(W4 ,W3 ,GZD,FMASS(IM2),FWIDTH(IM2),W12 ) + ELSE + CALL FVOXXX(W4 ,W3 ,GZU,FMASS(IM2),FWIDTH(IM2),W12 ) + ENDIF + CALL IOVXXX(W5 ,W12 ,W10 ,GG,AMP(4 )) + ZJJ1 = 0.D0 + DO I = 1, NEIGEN + ZTEMP = (0.D0,0.D0) + DO J = 1, NGRAPHS + ZTEMP = ZTEMP + EIGEN_VEC(J,I)*AMP(J) + ENDDO + ZJJ1 =ZJJ1+ZTEMP*EIGEN_VAL(I)*CONJG(ZTEMP) + ENDDO +C CALL GAUGECHECK(AMP,ZTEMP,EIGEN_VEC,EIGEN_VAL,NGRAPHS,NEIGEN) + END diff --git a/ISAJET/code/zjj2.F b/ISAJET/code/zjj2.F new file mode 100644 index 00000000000..431521a6522 --- /dev/null +++ b/ISAJET/code/zjj2.F @@ -0,0 +1,104 @@ +#include "isajet/pilot.h" + REAL*8 FUNCTION ZJJ2(P1, P2, P3, P4, P5,NHEL,IM) +C +C Function generated by Madgraph + hand coding +C Returns amplitude squared summed/ave over colors +C for the point in phase space P1,P2,P3,P4,P5 +C and helicity NHEL(1)... +C for the process: g g -> z q(im) qb(im) +C with Madgraph code IM +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +C +C CONSTANTS +C + INTEGER NGRAPHS, NEIGEN, NEXTERNAL + PARAMETER (NGRAPHS= 8,NEIGEN= 2,NEXTERNAL=5) + REAL*8 ZERO + PARAMETER (ZERO=0D0) +C +C ARGUMENTS +C + REAL*8 P1(0:3),P2(0:3),P3(0:3),P4(0:3),P5(0:3) + INTEGER NHEL(NEXTERNAL) + INTEGER IM +C +C LOCAL VARIABLES +C + INTEGER I,J + REAL*8 EIGEN_VAL(NEIGEN), EIGEN_VEC(NGRAPHS,NEIGEN) + COMPLEX*16 ZTEMP + COMPLEX*16 AMP(NGRAPHS) + COMPLEX*16 W1(6) , W2(6) , W3(6) , W4(6) , W5(6) + COMPLEX*16 W6(6) , W7(6) , W8(6) , W9(6) , W10(6) + COMPLEX*16 W11(6) , W12(6) , W13(6) + REAL*8 GZUD(2) +C +C GLOBAL VARIABLES +C +#include "isajet/mgcoms.inc" +C +C COLOR DATA +C + DATA EIGEN_VAL(1 )/ 2.1875000000000006D-01 / + DATA EIGEN_VEC(1 ,1 )/ -4.0824829046386291D-01 / + DATA EIGEN_VEC(2 ,1 )/ -4.0824829046386291D-01 / + DATA EIGEN_VEC(3 ,1 )/ -4.0824829046386307D-01 / + DATA EIGEN_VEC(4 ,1 )/ -4.0824829046386307D-01 / + DATA EIGEN_VEC(5 ,1 )/ -4.0824829046386307D-01 / + DATA EIGEN_VEC(6 ,1 )/ -4.0824829046386291D-01 / + DATA EIGEN_VEC(7 ,1 )/ 0.0000000000000000D+00 / + DATA EIGEN_VEC(8 ,1 )/ 0.0000000000000000D+00 / + DATA EIGEN_VAL(2 )/ 6.5624999999999967D-01 / + DATA EIGEN_VEC(1 ,2 )/ -2.6726124191242451D-01 / + DATA EIGEN_VEC(2 ,2 )/ -2.6726124191242451D-01 / + DATA EIGEN_VEC(3 ,2 )/ 2.6726124191242440D-01 / + DATA EIGEN_VEC(4 ,2 )/ 2.6726124191242440D-01 / + DATA EIGEN_VEC(5 ,2 )/ 2.6726124191242440D-01 / + DATA EIGEN_VEC(6 ,2 )/ -2.6726124191242451D-01 / + DATA EIGEN_VEC(7 ,2 )/ -5.3452248382484857D-01 / + DATA EIGEN_VEC(8 ,2 )/ -5.3452248382484857D-01 / +C ---------- +C BEGIN CODE +C ---------- + IF(IM.EQ.4.OR.IM.EQ.8.OR.IM.EQ.12) THEN + GZUD(1)=GZD(1) + GZUD(2)=GZD(2) + ELSE + GZUD(1)=GZU(1) + GZUD(2)=GZU(2) + ENDIF +C + CALL VXXXXX(P1 , ZERO,NHEL(1 ),-1,W1 ) + CALL VXXXXX(P2 , ZERO,NHEL(2 ),-1,W2 ) + CALL VXXXXX(P3 ,ZMASS,NHEL(3 ), 1,W3 ) + CALL OXXXXX(P4 ,FMASS(IM),NHEL(4 ), 1,W4 ) + CALL IXXXXX(P5 ,FMASS(IM),NHEL(5 ),-1,W5 ) + CALL FVOXXX(W4 ,W1 ,GG,FMASS(IM),FWIDTH(IM),W6 ) + CALL FVIXXX(W5 ,W2 ,GG,FMASS(IM),FWIDTH(IM),W7 ) + CALL IOVXXX(W7 ,W6 ,W3 ,GZUD,AMP(1 )) + CALL FVIXXX(W5 ,W3 ,GZUD,FMASS(IM),FWIDTH(IM),W8 ) + CALL IOVXXX(W8 ,W6 ,W2 ,GG,AMP(2 )) + CALL FVOXXX(W4 ,W2 ,GG,FMASS(IM),FWIDTH(IM),W9 ) + CALL FVIXXX(W5 ,W1 ,GG,FMASS(IM),FWIDTH(IM),W10 ) + CALL IOVXXX(W10 ,W9 ,W3 ,GZUD,AMP(3 )) + CALL IOVXXX(W8 ,W9 ,W1 ,GG,AMP(4 )) + CALL FVOXXX(W4 ,W3 ,GZUD,FMASS(IM),FWIDTH(IM),W11 ) + CALL IOVXXX(W10 ,W11 ,W2 ,GG,AMP(5 )) + CALL IOVXXX(W7 ,W11 ,W1 ,GG,AMP(6 )) + CALL JGGXXX(W1 ,W2 ,G,W12 ) + CALL FVOXXX(W4 ,W12 ,GG,FMASS(IM),FWIDTH(IM),W13 ) + CALL IOVXXX(W5 ,W13 ,W3 ,GZUD,AMP(7 )) + CALL IOVXXX(W5 ,W11 ,W12 ,GG,AMP(8 )) + ZJJ2 = 0.D0 + DO I = 1, NEIGEN + ZTEMP = (0.D0,0.D0) + DO J = 1, NGRAPHS + ZTEMP = ZTEMP + EIGEN_VEC(J,I)*AMP(J) + ENDDO + ZJJ2 =ZJJ2+ZTEMP*EIGEN_VAL(I)*CONJG(ZTEMP) + ENDDO +C CALL GAUGECHECK(AMP,ZTEMP,EIGEN_VEC,EIGEN_VAL,NGRAPHS,NEIGEN) + END diff --git a/ISAJET/code/zjj3.F b/ISAJET/code/zjj3.F new file mode 100644 index 00000000000..085735098ff --- /dev/null +++ b/ISAJET/code/zjj3.F @@ -0,0 +1,104 @@ +#include "isajet/pilot.h" + REAL*8 FUNCTION ZJJ3(P1, P2, P3, P4, P5,NHEL,IM) +C +C Function generated by Madgraph + hand coding +C Returns amplitude squared summed/ave over colors +C for the point in phase space P1,P2,P3,P4,P5 +C and helicity NHEL(1)... +C for the process: q(im) qb(im) -> z g g +C with Madgraph code IM +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +C +C CONSTANTS +C + INTEGER NGRAPHS, NEIGEN, NEXTERNAL + PARAMETER (NGRAPHS= 8,NEIGEN= 2,NEXTERNAL=5) + REAL*8 ZERO + PARAMETER (ZERO=0D0) +C +C ARGUMENTS +C + REAL*8 P1(0:3),P2(0:3),P3(0:3),P4(0:3),P5(0:3) + INTEGER NHEL(NEXTERNAL),IM +C +C LOCAL VARIABLES +C + INTEGER I,J + REAL*8 EIGEN_VAL(NEIGEN), EIGEN_VEC(NGRAPHS,NEIGEN) + COMPLEX*16 ZTEMP + COMPLEX*16 AMP(NGRAPHS) + COMPLEX*16 W1(6) , W2(6) , W3(6) , W4(6) , W5(6) + COMPLEX*16 W6(6) , W7(6) , W8(6) , W9(6) , W10(6) + COMPLEX*16 W11(6) , W12(6) , W13(6) , W14(6) , W15(6) + REAL*8 GZUD(2) +C +C GLOBAL VARIABLES +C +#include "isajet/mgcoms.inc" +C +C COLOR DATA +C + DATA EIGEN_VAL(1 )/ 7.7777777777777746D-01 / + DATA EIGEN_VEC(1 ,1 )/ -4.0824829046386302D-01 / + DATA EIGEN_VEC(2 ,1 )/ -4.0824829046386307D-01 / + DATA EIGEN_VEC(3 ,1 )/ 0.0000000000000000D+00 / + DATA EIGEN_VEC(4 ,1 )/ -4.0824829046386307D-01 / + DATA EIGEN_VEC(5 ,1 )/ -4.0824829046386302D-01 / + DATA EIGEN_VEC(6 ,1 )/ -4.0824829046386307D-01 / + DATA EIGEN_VEC(7 ,1 )/ 0.0000000000000000D+00 / + DATA EIGEN_VEC(8 ,1 )/ -4.0824829046386302D-01 / + DATA EIGEN_VAL(2 )/ 2.3333333333333321D+00 / + DATA EIGEN_VEC(1 ,2 )/ 2.6726124191242445D-01 / + DATA EIGEN_VEC(2 ,2 )/ -2.6726124191242440D-01 / + DATA EIGEN_VEC(3 ,2 )/ -5.3452248382484879D-01 / + DATA EIGEN_VEC(4 ,2 )/ -2.6726124191242440D-01 / + DATA EIGEN_VEC(5 ,2 )/ 2.6726124191242445D-01 / + DATA EIGEN_VEC(6 ,2 )/ -2.6726124191242440D-01 / + DATA EIGEN_VEC(7 ,2 )/ -5.3452248382484879D-01 / + DATA EIGEN_VEC(8 ,2 )/ 2.6726124191242445D-01 / +C ---------- +C BEGIN CODE +C ---------- + IF(IM.EQ.4.OR.IM.EQ.8.OR.IM.EQ.12) THEN + GZUD(1)=GZD(1) + GZUD(2)=GZD(2) + ELSE + GZUD(1)=GZU(1) + GZUD(2)=GZU(2) + ENDIF +C + CALL IXXXXX(P1 ,FMASS(IM),NHEL(1 ), 1,W1 ) + CALL OXXXXX(P2 ,FMASS(IM),NHEL(2 ),-1,W2 ) + CALL VXXXXX(P3 ,ZMASS,NHEL(3 ), 1,W3 ) + CALL VXXXXX(P4 , ZERO,NHEL(4 ), 1,W4 ) + CALL VXXXXX(P5 , ZERO,NHEL(5 ), 1,W5 ) + CALL FVOXXX(W2 ,W3 ,GZUD,FMASS(IM),FWIDTH(IM),W6 ) + CALL FVOXXX(W6 ,W4 ,GG,FMASS(IM),FWIDTH(IM),W7 ) + CALL IOVXXX(W1 ,W7 ,W5 ,GG,AMP(1 )) + CALL FVIXXX(W1 ,W4 ,GG,FMASS(IM),FWIDTH(IM),W8 ) + CALL FVOXXX(W2 ,W5 ,GG,FMASS(IM),FWIDTH(IM),W9 ) + CALL IOVXXX(W8 ,W9 ,W3 ,GZUD,AMP(2 )) + CALL JIOXXX(W1 ,W6 ,GG,ZERO,ZERO,W10 ) + CALL GGGXXX(W5 ,W4 ,W10 ,G,AMP(3 )) + CALL IOVXXX(W8 ,W6 ,W5 ,GG,AMP(4 )) + CALL FVOXXX(W2 ,W4 ,GG,FMASS(IM),FWIDTH(IM),W11 ) + CALL FVIXXX(W1 ,W5 ,GG,FMASS(IM),FWIDTH(IM),W12 ) + CALL IOVXXX(W12 ,W11 ,W3 ,GZUD,AMP(5 )) + CALL FVIXXX(W1 ,W3 ,GZUD,FMASS(IM),FWIDTH(IM),W13 ) + CALL FVIXXX(W13 ,W4 ,GG,FMASS(IM),FWIDTH(IM),W14 ) + CALL IOVXXX(W14 ,W2 ,W5 ,GG,AMP(6 )) + CALL JIOXXX(W13 ,W2 ,GG,ZERO,ZERO,W15 ) + CALL GGGXXX(W5 ,W4 ,W15 ,G,AMP(7 )) + CALL IOVXXX(W13 ,W11 ,W5 ,GG,AMP(8 )) + ZJJ3 = 0.D0 + DO I = 1, NEIGEN + ZTEMP = (0.D0,0.D0) + DO J = 1, NGRAPHS + ZTEMP = ZTEMP + EIGEN_VEC(J,I)*AMP(J) + ENDDO + ZJJ3 =ZJJ3+ZTEMP*EIGEN_VAL(I)*CONJG(ZTEMP) + ENDDO + END diff --git a/ISAJET/code/zjj4.F b/ISAJET/code/zjj4.F new file mode 100644 index 00000000000..fdfdb7bb691 --- /dev/null +++ b/ISAJET/code/zjj4.F @@ -0,0 +1,107 @@ +#include "isajet/pilot.h" + REAL*8 FUNCTION ZJJ4(P1, P2, P3, P4, P5,NHEL,IM) +C +C Function generated by Madgraph + hand coding +C Returns amplitude squared summed/ave over colors +C for the point in phase space P1,P2,P3,P4,P5 +C and helicity NHEL(1)... +C for the process: q(im) qb(im) -> z q(im) qb(im) +C with Madgraph code IM +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +C +C CONSTANTS +C + INTEGER NGRAPHS, NEIGEN, NEXTERNAL + PARAMETER (NGRAPHS= 8,NEIGEN= 2,NEXTERNAL=5) + REAL*8 ZERO + PARAMETER (ZERO=0D0) +C +C ARGUMENTS +C + REAL*8 P1(0:3),P2(0:3),P3(0:3),P4(0:3),P5(0:3) + INTEGER NHEL(NEXTERNAL),IM +C +C LOCAL VARIABLES +C + INTEGER I,J + REAL*8 EIGEN_VAL(NEIGEN), EIGEN_VEC(NGRAPHS,NEIGEN) + COMPLEX*16 ZTEMP + COMPLEX*16 AMP(NGRAPHS) + COMPLEX*16 W1(6) , W2(6) , W3(6) , W4(6) , W5(6) + COMPLEX*16 W6(6) , W7(6) , W8(6) , W9(6) , W10(6) + COMPLEX*16 W11(6) , W12(6) , W13(6) , W14(6) , W15(6) + COMPLEX*16 W16(6) + REAL*8 GZUD(2) +C +C GLOBAL VARIABLES +C +#include "isajet/mgcoms.inc" +C +C COLOR DATA +C + DATA EIGEN_VAL(1 )/ 5.9259259259259234D-01 / + DATA EIGEN_VEC(1 ,1 )/ -3.5355339059327379D-01 / + DATA EIGEN_VEC(2 ,1 )/ 3.5355339059327379D-01 / + DATA EIGEN_VEC(3 ,1 )/ -3.5355339059327379D-01 / + DATA EIGEN_VEC(4 ,1 )/ -3.5355339059327379D-01 / + DATA EIGEN_VEC(5 ,1 )/ 3.5355339059327379D-01 / + DATA EIGEN_VEC(6 ,1 )/ -3.5355339059327379D-01 / + DATA EIGEN_VEC(7 ,1 )/ 3.5355339059327379D-01 / + DATA EIGEN_VEC(8 ,1 )/ 3.5355339059327379D-01 / + DATA EIGEN_VAL(2 )/ 1.1851851851851847D+00 / + DATA EIGEN_VEC(1 ,2 )/ -3.5355339059327379D-01 / + DATA EIGEN_VEC(2 ,2 )/ -3.5355339059327379D-01 / + DATA EIGEN_VEC(3 ,2 )/ -3.5355339059327379D-01 / + DATA EIGEN_VEC(4 ,2 )/ -3.5355339059327379D-01 / + DATA EIGEN_VEC(5 ,2 )/ -3.5355339059327379D-01 / + DATA EIGEN_VEC(6 ,2 )/ -3.5355339059327379D-01 / + DATA EIGEN_VEC(7 ,2 )/ -3.5355339059327379D-01 / + DATA EIGEN_VEC(8 ,2 )/ -3.5355339059327379D-01 / +C ---------- +C BEGIN CODE +C ---------- + IF(IM.EQ.4.OR.IM.EQ.8.OR.IM.EQ.12) THEN + GZUD(1)=GZD(1) + GZUD(2)=GZD(2) + ELSE + GZUD(1)=GZU(1) + GZUD(2)=GZU(2) + ENDIF +C + CALL IXXXXX(P1 ,FMASS(IM),NHEL(1 ), 1,W1 ) + CALL OXXXXX(P2 ,FMASS(IM),NHEL(2 ),-1,W2 ) + CALL VXXXXX(P3 ,ZMASS,NHEL(3 ), 1,W3 ) + CALL OXXXXX(P4 ,FMASS(IM),NHEL(4 ), 1,W4 ) + CALL IXXXXX(P5 ,FMASS(IM),NHEL(5 ),-1,W5 ) + CALL JIOXXX(W1 ,W4 ,GG,ZERO,ZERO,W6 ) + CALL FVIXXX(W5 ,W3 ,GZUD,FMASS(IM),FWIDTH(IM),W7 ) + CALL IOVXXX(W7 ,W2 ,W6 ,GG,AMP(1 )) + CALL FVOXXX(W2 ,W3 ,GZUD,FMASS(IM),FWIDTH(IM),W8 ) + CALL JIOXXX(W1 ,W8 ,GG,ZERO,ZERO,W9 ) + CALL IOVXXX(W5 ,W4 ,W9 ,GG,AMP(2 )) + CALL IOVXXX(W5 ,W8 ,W6 ,GG,AMP(3 )) + CALL FVIXXX(W1 ,W3 ,GZUD,FMASS(IM),FWIDTH(IM),W10 ) + CALL JIOXXX(W10 ,W4 ,GG,ZERO,ZERO,W11 ) + CALL IOVXXX(W5 ,W2 ,W11 ,GG,AMP(4 )) + CALL JIOXXX(W10 ,W2 ,GG,ZERO,ZERO,W12 ) + CALL IOVXXX(W5 ,W4 ,W12 ,GG,AMP(5 )) + CALL FVOXXX(W4 ,W3 ,GZUD,FMASS(IM),FWIDTH(IM),W13 ) + CALL JIOXXX(W5 ,W2 ,GG,ZERO,ZERO,W14 ) + CALL IOVXXX(W1 ,W13 ,W14 ,GG,AMP(6 )) + CALL JIOXXX(W1 ,W2 ,GG,ZERO,ZERO,W15 ) + CALL FVOXXX(W4 ,W15 ,GG,FMASS(IM),FWIDTH(IM),W16 ) + CALL IOVXXX(W5 ,W16 ,W3 ,GZUD,AMP(7 )) + CALL IOVXXX(W5 ,W13 ,W15 ,GG,AMP(8 )) + ZJJ4 = 0.D0 + DO I = 1, NEIGEN + ZTEMP = (0.D0,0.D0) + DO J = 1, NGRAPHS + ZTEMP = ZTEMP + EIGEN_VEC(J,I)*AMP(J) + ENDDO + ZJJ4 =ZJJ4+ZTEMP*EIGEN_VAL(I)*CONJG(ZTEMP) + ENDDO +C CALL GAUGECHECK(AMP,ZTEMP,EIGEN_VEC,EIGEN_VAL,NGRAPHS,NEIGEN) + END diff --git a/ISAJET/code/zjj5.F b/ISAJET/code/zjj5.F new file mode 100644 index 00000000000..4068bdd2e6b --- /dev/null +++ b/ISAJET/code/zjj5.F @@ -0,0 +1,94 @@ +#include "isajet/pilot.h" + REAL*8 FUNCTION ZJJ5(P1, P2, P3, P4, P5,NHEL,IM1,IM2) +C +C Function generated by Madgraph +C Returns amplitude squared summed/avg over colors +C for the point in phase space p1,p2,p3,p4,... +C and helicity NHEL(1),NHEL(2),.... +C +C for process : q(im1) q(im2) -> z q(im1) q(im2) +C with IM1 != IM2 +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +C +C CONSTANTS +C + INTEGER NGRAPHS, NEIGEN, NEXTERNAL + PARAMETER (NGRAPHS= 4,NEIGEN= 1,NEXTERNAL=5) + REAL*8 ZERO + PARAMETER (ZERO=0D0) +C +C ARGUMENTS +C + REAL*8 P1(0:3),P2(0:3),P3(0:3),P4(0:3),P5(0:3) + INTEGER NHEL(NEXTERNAL) + INTEGER IM1,IM2 +C +C LOCAL VARIABLES +C + INTEGER I,J + REAL*8 EIGEN_VAL(NEIGEN), EIGEN_VEC(NGRAPHS,NEIGEN) + COMPLEX*16 ZTEMP + COMPLEX*16 AMP(NGRAPHS) + COMPLEX*16 W1(6) , W2(6) , W3(6) , W4(6) , W5(6) + COMPLEX*16 W6(6) , W7(6) , W8(6) , W9(6) , W10(6) + COMPLEX*16 W11(6) , W12(6) + REAL*8 GZUD1(2),GZUD2(2) +C +C GLOBAL VARIABLES +C +#include "isajet/mgcoms.inc" +C +C COLOR DATA +C + DATA EIGEN_VAL(1 )/ 8.8888888888888884D-01 / + DATA EIGEN_VEC(1 ,1 )/ -5.0000000000000000D-01 / + DATA EIGEN_VEC(2 ,1 )/ -5.0000000000000000D-01 / + DATA EIGEN_VEC(3 ,1 )/ -5.0000000000000000D-01 / + DATA EIGEN_VEC(4 ,1 )/ -5.0000000000000000D-01 / +C ---------- +C BEGIN CODE +C ---------- + IF(IM1.EQ.3.OR.IM1.EQ.7.OR.IM1.EQ.11) THEN + GZUD1(1)=GZD(1) + GZUD1(2)=GZD(2) + ELSE + GZUD1(1)=GZU(1) + GZUD1(2)=GZU(2) + ENDIF + IF(IM2.EQ.3.OR.IM2.EQ.7.OR.IM2.EQ.11) THEN + GZUD2(1)=GZD(1) + GZUD2(2)=GZD(2) + ELSE + GZUD2(1)=GZU(1) + GZUD2(2)=GZU(2) + ENDIF +C + CALL IXXXXX(P1 ,FMASS(IM1),NHEL(1 ), 1,W1 ) + CALL IXXXXX(P2 ,FMASS(IM2),NHEL(2 ), 1,W2 ) + CALL VXXXXX(P3 ,ZMASS,NHEL(3 ), 1,W3 ) + CALL OXXXXX(P4 ,FMASS(IM1),NHEL(4 ), 1,W4 ) + CALL OXXXXX(P5 ,FMASS(IM2),NHEL(5 ), 1,W5 ) + CALL JIOXXX(W1 ,W4 ,GG,ZERO,ZERO,W6 ) + CALL FVOXXX(W5 ,W3 ,GZUD2,FMASS(IM2),FWIDTH(IM2),W7 ) + CALL IOVXXX(W2 ,W7 ,W6 ,GG,AMP(1 )) + CALL FVIXXX(W2 ,W3 ,GZUD2,FMASS(IM2),FWIDTH(IM2),W8 ) + CALL IOVXXX(W8 ,W5 ,W6 ,GG,AMP(2 )) + CALL FVIXXX(W1 ,W3 ,GZUD1,FMASS(IM1),FWIDTH(IM1),W9 ) + CALL JIOXXX(W9 ,W4 ,GG,ZERO,ZERO,W10 ) + CALL IOVXXX(W2 ,W5 ,W10 ,GG,AMP(3 )) + CALL FVOXXX(W4 ,W3 ,GZUD1,FMASS(IM1),FWIDTH(IM1),W11 ) + CALL JIOXXX(W2 ,W5 ,GG,ZERO,ZERO,W12 ) + CALL IOVXXX(W1 ,W11 ,W12 ,GG,AMP(4 )) + ZJJ5 = 0.D0 + DO I = 1, NEIGEN + ZTEMP = (0.D0,0.D0) + DO J = 1, NGRAPHS + ZTEMP = ZTEMP + EIGEN_VEC(J,I)*AMP(J) + ENDDO + ZJJ5 =ZJJ5+ZTEMP*EIGEN_VAL(I)*CONJG(ZTEMP) + ENDDO +C CALL GAUGECHECK(AMP,ZTEMP,EIGEN_VEC,EIGEN_VAL,NGRAPHS,NEIGEN) + END diff --git a/ISAJET/code/zjj6.F b/ISAJET/code/zjj6.F new file mode 100644 index 00000000000..b3173b1b41b --- /dev/null +++ b/ISAJET/code/zjj6.F @@ -0,0 +1,106 @@ +#include "isajet/pilot.h" + REAL*8 FUNCTION ZJJ6(P1, P2, P3, P4, P5,NHEL,IM1) +C +C Function generated by Madgraph + hand coding +C Returns amplitude squared summed/avg over colors +C for the point in phase space p1,p2,p3,p4,... +C and helicity NHEL(1),NHEL(2),.... +C +C FOR PROCESS : q(im1) q(im1) -> z q(im1) q(im1) +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +C +C CONSTANTS +C + INTEGER NGRAPHS, NEIGEN, NEXTERNAL + PARAMETER (NGRAPHS= 8,NEIGEN= 2,NEXTERNAL=5) + REAL*8 ZERO + PARAMETER (ZERO=0D0) +C +C ARGUMENTS +C + REAL*8 P1(0:3),P2(0:3),P3(0:3),P4(0:3),P5(0:3) + INTEGER NHEL(NEXTERNAL) + INTEGER IM1 +C +C LOCAL VARIABLES +C + INTEGER I,J + REAL*8 EIGEN_VAL(NEIGEN), EIGEN_VEC(NGRAPHS,NEIGEN) + COMPLEX*16 ZTEMP + COMPLEX*16 AMP(NGRAPHS) + COMPLEX*16 W1(6) , W2(6) , W3(6) , W4(6) , W5(6) + COMPLEX*16 W6(6) , W7(6) , W8(6) , W9(6) , W10(6) + COMPLEX*16 W11(6) , W12(6) , W13(6) , W14(6) , W15(6) + REAL*8 GZUD(2) +C +C GLOBAL VARIABLES +C +#include "isajet/mgcoms.inc" +C +C COLOR DATA +C + DATA EIGEN_VAL(1 )/ 2.9629629629629617D-01 / + DATA EIGEN_VEC(1 ,1 )/ -3.5355339059327379D-01 / + DATA EIGEN_VEC(2 ,1 )/ 3.5355339059327379D-01 / + DATA EIGEN_VEC(3 ,1 )/ 3.5355339059327379D-01 / + DATA EIGEN_VEC(4 ,1 )/ 3.5355339059327379D-01 / + DATA EIGEN_VEC(5 ,1 )/ -3.5355339059327379D-01 / + DATA EIGEN_VEC(6 ,1 )/ -3.5355339059327379D-01 / + DATA EIGEN_VEC(7 ,1 )/ -3.5355339059327379D-01 / + DATA EIGEN_VEC(8 ,1 )/ 3.5355339059327379D-01 / + DATA EIGEN_VAL(2 )/ 5.9259259259259234D-01 / + DATA EIGEN_VEC(1 ,2 )/ -3.5355339059327379D-01 / + DATA EIGEN_VEC(2 ,2 )/ -3.5355339059327379D-01 / + DATA EIGEN_VEC(3 ,2 )/ -3.5355339059327379D-01 / + DATA EIGEN_VEC(4 ,2 )/ -3.5355339059327379D-01 / + DATA EIGEN_VEC(5 ,2 )/ -3.5355339059327379D-01 / + DATA EIGEN_VEC(6 ,2 )/ -3.5355339059327379D-01 / + DATA EIGEN_VEC(7 ,2 )/ -3.5355339059327379D-01 / + DATA EIGEN_VEC(8 ,2 )/ -3.5355339059327379D-01 / +C ---------- +C BEGIN CODE +C ---------- + IF(IM1.EQ.3.OR.IM1.EQ.7.OR.IM1.EQ.11) THEN + GZUD(1)=GZD(1) + GZUD(2)=GZD(2) + ELSE + GZUD(1)=GZU(1) + GZUD(2)=GZU(2) + ENDIF +C + CALL IXXXXX(P1 ,FMASS(IM1),NHEL(1 ), 1,W1 ) + CALL IXXXXX(P2 ,FMASS(IM1),NHEL(2 ), 1,W2 ) + CALL VXXXXX(P3 ,ZMASS,NHEL(3 ), 1,W3 ) + CALL OXXXXX(P4 ,FMASS(IM1),NHEL(4 ), 1,W4 ) + CALL OXXXXX(P5 ,FMASS(IM1),NHEL(5 ), 1,W5 ) + CALL FVIXXX(W2 ,W3 ,GZUD,FMASS(IM1),FWIDTH(IM1),W6 ) + CALL JIOXXX(W6 ,W4 ,GG,ZERO,ZERO,W7 ) + CALL IOVXXX(W1 ,W5 ,W7 ,GG,AMP(1 )) + CALL JIOXXX(W1 ,W4 ,GG,ZERO,ZERO,W8 ) + CALL FVOXXX(W5 ,W3 ,GZUD,FMASS(IM1),FWIDTH(IM1),W9 ) + CALL IOVXXX(W2 ,W9 ,W8 ,GG,AMP(2 )) + CALL IOVXXX(W6 ,W5 ,W8 ,GG,AMP(3 )) + CALL FVIXXX(W1 ,W3 ,GZUD,FMASS(IM1),FWIDTH(IM1),W10 ) + CALL JIOXXX(W10 ,W4 ,GG,ZERO,ZERO,W11 ) + CALL IOVXXX(W2 ,W5 ,W11 ,GG,AMP(4 )) + CALL JIOXXX(W2 ,W4 ,GG,ZERO,ZERO,W12 ) + CALL IOVXXX(W1 ,W9 ,W12 ,GG,AMP(5 )) + CALL IOVXXX(W10 ,W5 ,W12 ,GG,AMP(6 )) + CALL FVOXXX(W4 ,W3 ,GZUD,FMASS(IM1),FWIDTH(IM1),W13 ) + CALL JIOXXX(W1 ,W5 ,GG,ZERO,ZERO,W14 ) + CALL IOVXXX(W2 ,W13 ,W14 ,GG,AMP(7 )) + CALL JIOXXX(W2 ,W5 ,GG,ZERO,ZERO,W15 ) + CALL IOVXXX(W1 ,W13 ,W15 ,GG,AMP(8 )) + ZJJ6 = 0.D0 + DO I = 1, NEIGEN + ZTEMP = (0.D0,0.D0) + DO J = 1, NGRAPHS + ZTEMP = ZTEMP + EIGEN_VEC(J,I)*AMP(J) + ENDDO + ZJJ6 =ZJJ6+ZTEMP*EIGEN_VAL(I)*CONJG(ZTEMP) + ENDDO +C CALL GAUGECHECK(AMP,ZTEMP,EIGEN_VEC,EIGEN_VAL,NGRAPHS,NEIGEN) + END diff --git a/ISAJET/code/zjj7.F b/ISAJET/code/zjj7.F new file mode 100644 index 00000000000..c9d4f253970 --- /dev/null +++ b/ISAJET/code/zjj7.F @@ -0,0 +1,104 @@ +#include "isajet/pilot.h" + REAL*8 FUNCTION ZJJ7(P1, P2, P3, P4, P5,NHEL,IM1) +C +C FUNCTION GENERATED BY MADGRAPH +C RETURNS AMPLITUDE SQUARED SUMMED/AVG OVER COLORS +C FOR THE POINT IN PHASE SPACE P1,P2,P3,P4,... +C AND HELICITY NHEL(1),NHEL(2),.... +C +C FOR PROCESS : g u -> z g u +C + IMPLICIT NONE +C +C CONSTANTS +C + INTEGER NGRAPHS, NEIGEN, NEXTERNAL + PARAMETER (NGRAPHS= 8,NEIGEN= 2,NEXTERNAL=5) + REAL*8 ZERO + PARAMETER (ZERO=0D0) +C +C ARGUMENTS +C + REAL*8 P1(0:3),P2(0:3),P3(0:3),P4(0:3),P5(0:3) + INTEGER NHEL(NEXTERNAL) + INTEGER IM1 +C +C LOCAL VARIABLES +C + INTEGER I,J + REAL*8 EIGEN_VAL(NEIGEN), EIGEN_VEC(NGRAPHS,NEIGEN) + COMPLEX*16 ZTEMP + COMPLEX*16 AMP(NGRAPHS) + COMPLEX*16 W1(6) , W2(6) , W3(6) , W4(6) , W5(6) + COMPLEX*16 W6(6) , W7(6) , W8(6) , W9(6) , W10(6) + COMPLEX*16 W11(6) , W12(6) , W13(6) , W14(6) , W15(6) + REAL*8 GZUD(2) +C +C GLOBAL VARIABLES +C +#include "isajet/mgcoms.inc" +C +C COLOR DATA +C + DATA EIGEN_VAL(1 )/ 5.8333333333333270D-01 / + DATA EIGEN_VEC(1 ,1 )/ 4.0824829046386285D-01 / + DATA EIGEN_VEC(2 ,1 )/ 0.0000000000000000D+00 / + DATA EIGEN_VEC(3 ,1 )/ 4.0824829046386318D-01 / + DATA EIGEN_VEC(4 ,1 )/ 0.0000000000000000D+00 / + DATA EIGEN_VEC(5 ,1 )/ 4.0824829046386285D-01 / + DATA EIGEN_VEC(6 ,1 )/ 4.0824829046386285D-01 / + DATA EIGEN_VEC(7 ,1 )/ 4.0824829046386318D-01 / + DATA EIGEN_VEC(8 ,1 )/ 4.0824829046386318D-01 / + DATA EIGEN_VAL(2 )/ 1.7499999999999991D+00 / + DATA EIGEN_VEC(1 ,2 )/ 2.6726124191242445D-01 / + DATA EIGEN_VEC(2 ,2 )/ -5.3452248382484879D-01 / + DATA EIGEN_VEC(3 ,2 )/ -2.6726124191242434D-01 / + DATA EIGEN_VEC(4 ,2 )/ -5.3452248382484879D-01 / + DATA EIGEN_VEC(5 ,2 )/ 2.6726124191242445D-01 / + DATA EIGEN_VEC(6 ,2 )/ 2.6726124191242445D-01 / + DATA EIGEN_VEC(7 ,2 )/ -2.6726124191242434D-01 / + DATA EIGEN_VEC(8 ,2 )/ -2.6726124191242434D-01 / +C ---------- +C BEGIN CODE +C ---------- + IF(IM1.EQ.3.OR.IM1.EQ.7.OR.IM1.EQ.11) THEN + GZUD(1)=GZD(1) + GZUD(2)=GZD(2) + ELSE + GZUD(1)=GZU(1) + GZUD(2)=GZU(2) + ENDIF +C + CALL VXXXXX(P1 , ZERO,NHEL(1 ),-1,W1 ) + CALL IXXXXX(P2 ,FMASS(IM1),NHEL(2 ), 1,W2 ) + CALL VXXXXX(P3 ,ZMASS,NHEL(3 ), 1,W3 ) + CALL VXXXXX(P4 , ZERO,NHEL(4 ), 1,W4 ) + CALL OXXXXX(P5 ,FMASS(IM1),NHEL(5 ), 1,W5 ) + CALL FVIXXX(W2 ,W3 ,GZUD,FMASS(IM1),FWIDTH(IM1),W6 ) + CALL FVIXXX(W6 ,W4 ,GG,FMASS(IM1),FWIDTH(IM1),W7 ) + CALL IOVXXX(W7 ,W5 ,W1 ,GG,AMP(1 )) + CALL JGGXXX(W4 ,W1 ,G,W8 ) + CALL FVOXXX(W5 ,W3 ,GZUD,FMASS(IM1),FWIDTH(IM1),W9 ) + CALL IOVXXX(W2 ,W9 ,W8 ,GG,AMP(2 )) + CALL FVIXXX(W6 ,W1 ,GG,FMASS(IM1),FWIDTH(IM1),W10 ) + CALL IOVXXX(W10 ,W5 ,W4 ,GG,AMP(3 )) + CALL IOVXXX(W6 ,W5 ,W8 ,GG,AMP(4 )) + CALL FVIXXX(W2 ,W4 ,GG,FMASS(IM1),FWIDTH(IM1),W11 ) + CALL FVOXXX(W5 ,W1 ,GG,FMASS(IM1),FWIDTH(IM1),W12 ) + CALL IOVXXX(W11 ,W12 ,W3 ,GZUD,AMP(5 )) + CALL IOVXXX(W11 ,W9 ,W1 ,GG,AMP(6 )) + CALL FVIXXX(W2 ,W1 ,GG,FMASS(IM1),FWIDTH(IM1),W13 ) + CALL FVIXXX(W13 ,W4 ,GG,FMASS(IM1),FWIDTH(IM1),W14 ) + CALL IOVXXX(W14 ,W5 ,W3 ,GZUD,AMP(7 )) + CALL FVIXXX(W13 ,W3 ,GZUD,FMASS(IM1),FWIDTH(IM1),W15 ) + CALL IOVXXX(W15 ,W5 ,W4 ,GG,AMP(8 )) + ZJJ7 = 0.D0 + DO I = 1, NEIGEN + ZTEMP = (0.D0,0.D0) + DO J = 1, NGRAPHS + ZTEMP = ZTEMP + EIGEN_VEC(J,I)*AMP(J) + ENDDO + ZJJ7 =ZJJ7+ZTEMP*EIGEN_VAL(I)*CONJG(ZTEMP) + ENDDO +C CALL GAUGECHECK(AMP,ZTEMP,EIGEN_VEC,EIGEN_VAL,NGRAPHS,NEIGEN) + END diff --git a/ISAJET/code/zzall.F b/ISAJET/code/zzall.F new file mode 100644 index 00000000000..001d032e244 --- /dev/null +++ b/ISAJET/code/zzall.F @@ -0,0 +1,97 @@ +#include "isajet/pilot.h" + FUNCTION ZZALL(T,U,T1,U1,T3,U3,P1,P2) +C DECAY DISTRIBUTION FOR Z0 Z0 PAIRS FROM SCHOONSCHIP(1980). +C INCLUDES TT, TU, AND UU TERMS. +#include "isajet/itapes.inc" +#include "isajet/wwpar.inc" + DIMENSION P1(4),P2(4) +#if defined(CERNLIB_DOUBLE) + DOUBLE PRECISION ZZALL + DOUBLE PRECISION T,U,T1,U1,T3,U3,P1,P2 + DOUBLE PRECISION CVAVA,DVAVA,CVVVV,CVVAA,TT,TU,UU,EPF +#endif + TTUU=(T*U)**2 + CVAVA=CV*CA*(CV1*CA3+CA1*CV3)/TTUU + DVAVA=CV*CA*(CV1*CA3-CA1*CV3)/TTUU + CVVVV=(CV**2+CA**2)*CV1*CV3/TTUU + CVVAA=(CV**2+CA**2)*CA1*CA3/TTUU + TT=T**2 + TU=T*U + UU=U**2 + ZZALL= + 1 +CVAVA*T*U*(-16.*ZM2*T1*U1*T3+16.*ZM2*T1*U1*U3+16.*ZM2*T1*T3*U3- + 1 16.*ZM2*U1*T3*U3-16.*ZM2**2*T1*S13-8.*ZM2**2*T1**2+16.*ZM2**2*U1 + 1 *S13+8.*ZM2**2*U1**2+16.*ZM2**2*T3*S13+8.*ZM2**2*T3**2-16.*ZM2** + 1 2*U3*S13-8.*ZM2**2*U3**2) + 1 +CVAVA*T*U**2*(16.*ZM2*T1*S13-16.*ZM2*T3*S13) + 1 +CVAVA*T**2*(16.*ZM2*U1*U3**2-16.*ZM2*U1**2*U3-8.*ZM2**2*U1**2+8 + 1 .*ZM2**2*U3**2) + 1 +CVAVA*T**2*U*(-16.*ZM2*U1*S13+16.*ZM2*U3*S13) + 1 +CVAVA*U**2*(-16.*ZM2*T1*T3**2+16.*ZM2*T1**2*T3+8.*ZM2**2*T1**2- + 1 8.*ZM2**2*T3**2) + ZZALL=ZZALL + 1 +DVAVA*T*U*(-16.*ZM2*T1*U1*T3+16.*ZM2*T1*U1*U3-16.*ZM2*T1*T3*U3+ + 1 16.*ZM2*U1*T3*U3-32.*ZM2**2*T1*T3-16.*ZM2**2*T1*S13-8.*ZM2**2*T1 + 1 **2+32.*ZM2**2*U1*U3+16.*ZM2**2*U1*S13+8.*ZM2**2*U1**2-16.*ZM2** + 1 2*T3*S13-8.*ZM2**2*T3**2+16.*ZM2**2*U3*S13+8.*ZM2**2*U3**2-32.*Z + 1 M2**3*T1+32.*ZM2**3*U1-32.*ZM2**3*T3+32.*ZM2**3*U3) + 1 +DVAVA*T*U**2*(16.*ZM2*T1*S13+16.*ZM2*T3*S13-16.*ZM2**2*U1-16.*Z + 1 M2**2*U3-32.*ZM2**3) + 1 +DVAVA*T*U**3*(8.*ZM2**2) + ZZALL=ZZALL + 1 +DVAVA*T**2*(-16.*ZM2*U1*U3**2-16.*ZM2*U1**2*U3-32.*ZM2**2*U1*U3 + 1 -8.*ZM2**2*U1**2-8.*ZM2**2*U3**2-16.*ZM2**3*U1-16.*ZM2**3*U3-8.* + 1 ZM2**4) + 1 +DVAVA*T**2*U*(-16.*ZM2*U1*S13-16.*ZM2*U3*S13+16.*ZM2**2*T1+16.* + 1 ZM2**2*T3+32.*ZM2**3) + 1 +DVAVA*T**3*U*(-8.*ZM2**2) + 1 +DVAVA*U**2*(16.*ZM2*T1*T3**2+16.*ZM2*T1**2*T3+32.*ZM2**2*T1*T3+ + 1 8.*ZM2**2*T1**2+8.*ZM2**2*T3**2+16.*ZM2**3*T1+16.*ZM2**3*T3+8.*Z + 1 M2**4) + ZZALL=ZZALL + 1 +CVVVV*T*U*(-16.*ZM2*T1*U1*T3-16.*ZM2*T1*U1*U3-16.*ZM2*T1*T3*U3- + 1 16.*ZM2*U1*T3*U3+16.*ZM2**2*T1*S13+8.*ZM2**2*T1**2+16.*ZM2**2*U1 + 1 *S13+8.*ZM2**2*U1**2+16.*ZM2**2*T3*S13+8.*ZM2**2*T3**2+16.*ZM2** + 1 2*U3*S13+8.*ZM2**2*U3**2+16.*ZM2**2*S13**2+16.*ZM2**3*T1+16.*ZM2 + 1 **3*U1+16.*ZM2**3*T3+16.*ZM2**3*U3+32.*ZM2**3*S13+32.*ZM2**4-32. + 1 *T1*U1*T3*U3) + 1 +CVVVV*T*U**2*(-16.*ZM2*T1*S13-16.*ZM2*T3*S13-8.*ZM2**2*U1-8.*ZM + 1 2**2*U3-16.*ZM2**2*S13-16.*ZM2**3-32.*T1*T3*S13) + ZZALL=ZZALL + 1 +CVVVV*T*U**3*(4.*ZM2**2) + 1 +CVVVV*T**2*(-16.*ZM2*U1*U3**2-16.*ZM2*U1**2*U3-16.*ZM2**2*U1*U3 + 1 -8.*ZM2**2*U1**2-8.*ZM2**2*U3**2-8.*ZM2**3*U1-8.*ZM2**3*U3-4.*ZM + 1 2**4-16.*U1**2*U3**2) + 1 +CVVVV*T**2*U*(-16.*ZM2*U1*S13-16.*ZM2*U3*S13-8.*ZM2**2*T1-8.*ZM + 1 2**2*T3-16.*ZM2**2*S13-16.*ZM2**3-32.*U1*U3*S13) + 1 +CVVVV*T**2*U**2*(-16.*S13**2) + 1 +CVVVV*T**3*U*(4.*ZM2**2) + ZZALL=ZZALL + 1 +CVVVV*U**2*(-16.*ZM2*T1*T3**2-16.*ZM2*T1**2*T3-16.*ZM2**2*T1*T3 + 1 -8.*ZM2**2*T1**2-8.*ZM2**2*T3**2-8.*ZM2**3*T1-8.*ZM2**3*T3-4.*ZM + 1 2**4-16.*T1**2*T3**2) + 1 +CVVAA*T*U*(-16.*ZM2**3*T1-16.*ZM2**3*U1-16.*ZM2**3*T3-16.*ZM2** + 1 3*U3-32.*ZM2**3*S13-32.*ZM2**4) + 1 +CVVAA*T*U**2*(8.*ZM2**2*U1+8.*ZM2**2*U3+16.*ZM2**2*S13+16.*ZM2* + 1 *3) + 1 +CVVAA*T*U**3*(-4.*ZM2**2) + ZZALL=ZZALL + 1 +CVVAA*T**2*(16.*ZM2**2*U1*U3+8.*ZM2**3*U1+8.*ZM2**3*U3+4.*ZM2** + 1 4) + 1 +CVVAA*T**2*U*(8.*ZM2**2*T1+8.*ZM2**2*T3+16.*ZM2**2*S13+16.*ZM2* + 1 *3) + 1 +CVVAA*T**3*U*(-4.*ZM2**2) + 1 +CVVAA*U**2*(16.*ZM2**2*T1*T3+8.*ZM2**3*T1+8.*ZM2**3*T3+4.*ZM2** + 1 4) +C THE EPF TERMS FROM SCHOONSCHIP DID NOT CONTAIN CVAVA, ETC., +C BUT DID CONTAIN AN EXPLICIT T*U. THIS WAS REPLACED BY HAND +C BY 1./TU. + ZZALL=ZZALL + 1 +EPF(P1,P2,P3,Q3)/TU*(-32.*CV*CA*CV1*CV3*T1*S13) + 1 +EPF(P1,P2,Q1,Q3)/TU*(-32.*ZM2*CV*CA*CV1*CV3*T1-32.*CV*CA*CV1*C + 1 V3*T1*T3-32.*CV*CA*CV1*CV3*T1*U3) + 1 +EPF(P1,P3,Q1,Q3)/TU*(32.*CV*CA*CV1*CV3*T1*T3) + 1 +EPF(P2,P3,Q1,Q3)/TU*(-32.*CV*CA*CV1*CV3*T1*U3)+0. + ZZALL=2.*ZZALL + RETURN + END diff --git a/ISAJET/code/zzstar.F b/ISAJET/code/zzstar.F new file mode 100644 index 00000000000..0e6ce68b5ae --- /dev/null +++ b/ISAJET/code/zzstar.F @@ -0,0 +1,49 @@ +#include "isajet/pilot.h" + FUNCTION ZZSTAR(HM,IW) +C +C Generate W* or Z* mass for H -> W W* or H -> Z Z* decay, +C including the W or Z width in the propagator. +C Ref: Marciano and Sirlin, Phys. Rev. D30, 248 (1984). +C +C HM = generated Higgs mass, i.e. QMW**2 +C IW = 2 3 4 +C W+ W- Z0 +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +C +#include "isajet/itapes.inc" +#include "isajet/hcon.inc" +#include "isajet/wcon.inc" +#include "isajet/primar.inc" +C + REAL HM,WM,WG,ZZSTAR,EPS,FBAR,R1,R2,RANF,X,F,DELTA,R,XM1 + INTEGER I,IW +C WM and WG are the W or Z mass and width + WM=WMASS(IW) + WG=WGAM(IW) + EPS=WM/HM + DELTA=WM*WG/HM**2 +C FBAR is maximum of F below + FBAR=12.*EPS**2*(1.-EPS)**2*(1.-EPS**2) + R1=(2.*EPS-1.)/DELTA + R2=EPS**2/DELTA + R1=ATAN(R1) + R2=ATAN(R2) +C Generate Breit-Wigner and test remainder F against FBAR + DO 100 I=1,NTRIES + R=R1-RANF()*(R1-R2) + XM1=DELTA*TAN(R) + X=XM1+1. + F=SQRT((X-2.*EPS)*(X+2.*EPS)) + $ *(X**2-12.*EPS**2*X+8.*EPS**2+12.*EPS**4) + XM1=SQRT(XM1) + ZZSTAR=HM*SQRT((EPS-XM1)*(EPS+XM1)) + IF(F.GT.FBAR*RANF()) RETURN +100 CONTINUE +C + WRITE(ITLIS,9999) NTRIES +9999 FORMAT(' ERROR IN ZZSTAR ... NO MASS FOUND') + STOP 99 + END diff --git a/ISAJET/data/decay.cpp b/ISAJET/data/decay.cpp new file mode 100644 index 00000000000..bec33f24e90 --- /dev/null +++ b/ISAJET/data/decay.cpp @@ -0,0 +1,1459 @@ +' ISAJET V7.51 10-MAY-2000 20:15:21' + 110, 0, .98850, 10, 10, 0, 0, 0/ + 110, 1, 1.00000, 10, 12, -12, 0, 0/ + 220, 0, .38000, 10, 10, 0, 0, 0/ + 220, 0, .71000, 110, 110, 110, 0, 0/ + 220, 0, .94600, 120, -120, 110, 0, 0/ + 220, 0, .99500, 120, -120, 10, 0, 0/ + 220, 1, 1.00000, 10, 12, -12, 0, 0/ + 330, 0, .44100, 220, 120, -120, 0, 0/ + 330, 0, .66100, 220, 110, 110, 0, 0/ + 330, 0, .95900, 111, 10, 0, 0, 0/ + 330, 0, .98000, 221, 10, 0, 0, 0/ + 330, 0, 1.00000, 10, 10, 0, 0, 0/ + 121, 0, 1.00000, 120, 110, 0, 0, 0/ + 111, 0, .99989, 120, -120, 0, 0, 0/ + 111, 0, .99993, 12, -12, 0, 0, 0/ + 111, 0, 1.00000, 14, -14, 0, 0, 0/ + 221, 2, .89900, 120, -120, 110, 0, 0/ + 221, 0, .91200, 120, -120, 0, 0, 0/ + 221, 0, .99992, 110, 10, 0, 0, 0/ + 221, 0, 1.00000, 12, -12, 0, 0, 0/ + 331, 0, .48600, 130, -130, 0, 0, 0/ + 331, 0, .83700, 20, -20, 0, 0, 0/ + 331, 2, .98400, 120, -120, 110, 0, 0/ + 331, 0, .99944, 220, 10, 0, 0, 0/ + 331, 0, .99975, 12, -12, 0, 0, 0/ + 331, 0, 1.00000, 14, -14, 0, 0, 0/ + 10110, 0, .52000, 120, -120, 0, 0, 0/ + 10110, 0, .78000, 110, 110, 0, 0, 0/ + 10110, 0, .89000, 130, -130, 0, 0, 0/ + 10110, 0, 1.00000, -20, 20, 0, 0, 0/ + 10121, 0, .49200, 111, 120, 0, 0, 0/ + 10121, 0, 1.00000, 121, 110, 0, 0, 0/ + 10111, 0, .50000, 121, -120, 0, 0, 0/ + 10111, 0, 1.00000, -121, 120, 0, 0, 0/ + 112, 0, .56700, 120, -120, 0, 0, 0/ + 112, 0, .85100, 110, 110, 0, 0, 0/ + 112, 0, .87900, 120, -120, 120, -120, 0/ + 112, 0, .94500, 120, -120, 110, 110, 0/ + 112, 0, .94800, 110, 110, 110, 110, 0/ + 112, 0, .97200, 130, -130, 0, 0, 0/ + 112, 0, .99600, -20, 20, 0, 0, 0/ + 112, 0, 1.00000, 220, 220, 0, 0, 0/ + 230, 0, .50000, 20, 0, 0, 0, 0/ + 230, 0, 1.00000, -20, 0, 0, 0, 0/ + 131, 0, .66670, 230, 120, 0, 0, 0/ + 131, 0, 1.00000, 130, 110, 0, 0, 0/ + 231, 0, .66670, 130, -120, 0, 0, 0/ + 231, 0, 1.00000, 230, 110, 0, 0, 0/ + 10231, 0, .28000, 130, -121, 0, 0, 0/ + 10231, 0, .42000, 230, 111, 0, 0, 0/ + 10231, 0, .52670, 131, -120, 0, 0, 0/ + 10231, 0, .58000, 231, 110, 0, 0, 0/ + 10231, 0, .69000, 230, 120, -120, 110, 0/ + 10231, 0, .83440, 230, 120, -120, 0, 0/ + 10231, 0, .95880, 130, -120, 110, 0, 0/ + 10231, 0, 1.00000, 230, 110, 110, 0, 0/ + 10131, 0, .28000, 230, 121, 0, 0, 0/ + 10131, 0, .42000, 130, 111, 0, 0, 0/ + 10131, 0, .52670, 231, 120, 0, 0, 0/ + 10131, 0, .58000, 131, 110, 0, 0, 0/ + 10131, 0, .69000, 130, 120, -120, 110, 0/ + 10131, 0, .83440, 130, 120, -120, 0, 0/ + 10131, 0, .95880, 230, 120, 110, 0, 0/ + 10131, 0, 1.00000, 130, 110, 110, 0, 0/ + 30231, 0, .63000, 131, -120, 0, 0, 0/ + 30231, 0, .94000, 231, 110, 0, 0, 0/ + 30231, 0, .96000, 130, -121, 0, 0, 0/ + 30231, 0, .97000, 230, 111, 0, 0, 0/ + 30231, 0, .98000, 230, 221, 0, 0, 0/ + 30231, 0, .99330, 230, 120, -120, 0, 0/ + 30231, 0, 1.00000, 230, 110, 110, 0, 0/ + 30131, 0, .63000, 231, 120, 0, 0, 0/ + 30131, 0, .94000, 131, 110, 0, 0, 0/ + 30131, 0, .96000, 230, -121, 0, 0, 0/ + 30131, 0, .97000, 130, 111, 0, 0, 0/ + 30131, 0, .98000, 130, 221, 0, 0, 0/ + 30131, 0, .99330, 130, 120, -120, 0, 0/ + 30131, 0, 1.00000, 130, 110, 110, 0, 0/ + 132, 0, .33100, 230, 120, 0, 0, 0/ + 132, 0, .49700, 130, 110, 0, 0, 0/ + 132, 0, .66500, 231, 120, 0, 0, 0/ + 132, 0, .74900, 131, 110, 0, 0, 0/ + 132, 0, .80300, 231, 120, 110, 0, 0/ + 132, 0, .85700, 131, 120, -120, 0, 0/ + 132, 0, .91100, 131, 110, 110, 0, 0/ + 132, 0, .97000, 230, 121, 0, 0, 0/ + 132, 0, 1.00000, 130, 111, 0, 0, 0/ + 232, 0, .33100, 130, -120, 0, 0, 0/ + 232, 0, .49700, 230, 110, 0, 0, 0/ + 232, 0, .66500, 131, -120, 0, 0, 0/ + 232, 0, .74900, 231, 110, 0, 0, 0/ + 232, 0, .80300, 231, 120, -120, 0, 0/ + 232, 0, .85700, 231, 110, 110, 0, 0/ + 232, 0, .91100, 131, -120, 110, 0, 0/ + 232, 0, .97000, 130, -121, 0, 0, 0/ + 232, 0, 1.00000, 230, 111, 0, 0, 0/ + 16, 5, .18000, -11, 12, 15, 0, 0/ + 16, 5, .35510, -13, 14, 15, 0, 0/ + 16, 6, .46550, -120, 15, 0, 0, 0/ + 16, 7, .71700, -121, 15, 0, 0, 0/ + 16, 7, .88020, -10121, 15, 0, 0, 0/ + 16, 6, .88740, -130, 15, 0, 0, 0/ + 16, 7, .90080, -131, 15, 0, 0, 0/ + 16, 0, .95450, -120, -120, 120, 110, 15/ + 16, 0, .96850, -120, 110, 110, 110, 15/ + 16, 0, .96990, -120, 111, 111, 15, 0/ + 16, 0, .97200, -130, -120, 130, 15, 0/ + 16, 0, .97400, 230, -120, -230, 15, 0/ + 16, 0, .97420, -130, 230, 110, 15, 0/ + 16, 0, .97530, 110, 110, -130, 15, 0/ + 16, 0, .98090, -130, -120, 120, 15, 0/ + 16, 0, .98650, -120, -230, 110, 15, 0/ + 16, 0, .98820, 220, -120, 110, 15, 0/ + 16, 0, .98960, -120, 110, 10, 15, 0/ + 16, 0, .99100, -120, -121, 121, 15, 0/ + 16, 0, .99300, 221, -120, 110, 110, 15/ + 16, 0, .99400, -121, 110, 110, 110, 15/ + 16, 0, .99800, -120, 221, 110, 15, 0/ + 16, 0, 1.00000, -130, 230, 15, 0, 0/ + 240, 3, .01140, -11, 12, 231, 0, 0/ + 240, 3, .02280, -11, 12, 231, 0, 0/ + 240, 3, .05040, -11, 12, 231, 0, 0/ + 240, 3, .14330, -11, 12, 230, 0, 0/ + 240, 3, .14690, -11, 12, 10231, 0, 0/ + 240, 3, .15070, -11, 12, 232, 0, 0/ + 240, 3, .15710, -11, 12, 110, 0, 0/ + 240, 3, .15990, -11, 12, 220, 0, 0/ + 240, 3, .16100, -11, 12, 330, 0, 0/ + 240, 3, .16400, -11, 12, 111, 0, 0/ + 240, 3, .16690, -11, 12, 221, 0, 0/ + 240, 3, .17830, -13, 14, 231, 0, 0/ + 240, 3, .18970, -13, 14, 231, 0, 0/ + 240, 3, .21730, -13, 14, 231, 0, 0/ + 240, 3, .31020, -13, 14, 230, 0, 0/ + 240, 3, .31380, -13, 14, 10231, 0, 0/ + 240, 3, .31760, -13, 14, 232, 0, 0/ + 240, 3, .32400, -13, 14, 110, 0, 0/ + 240, 3, .32680, -13, 14, 220, 0, 0/ + 240, 3, .32790, -13, 14, 330, 0, 0/ + 240, 3, .33090, -13, 14, 111, 0, 0/ + 240, 3, .33380, -13, 14, 221, 0, 0/ + 240, 0, .33470, 14, -13, 0, 0, 0/ + 240, 0, .33710, 16, -15, 0, 0, 0/ + 240, 0, .36630, 230, -120, 0, 0, 0/ + 240, 0, .43850, 230, -121, 0, 0, 0/ + 240, 0, .51920, 230, -10121, 0, 0, 0/ + 240, 0, .54050, 231, -120, 0, 0, 0/ + 240, 0, .59130, 30231, -120, 0, 0, 0/ + 240, 0, .62580, 232, -120, 0, 0, 0/ + 240, 0, .67610, 231, -121, 0, 0, 0/ + 240, 0, .73090, 130, -120, -120, 0, 0/ + 240, 0, .74640, 230, 110, -120, 0, 0/ + 240, 0, .75640, 230, 220, -120, 0, 0/ + 240, 0, .76140, 230, 111, -120, 0, 0/ + 240, 0, .76640, 230, 221, -120, 0, 0/ + 240, 0, .77600, 130, -121, -120, 0, 0/ + 240, 0, .79600, 131, -120, -120, 0, 0/ + 240, 0, .80600, 231, 110, -120, 0, 0/ + 240, 0, .81600, 231, 220, -120, 0, 0/ + 240, 0, .82380, 231, 111, -120, 0, 0/ + 240, 0, .82880, 231, 221, -120, 0, 0/ + 240, 0, .83880, 131, -121, -120, 0, 0/ + 240, 0, .84480, 130, -120, -120, 110, 0/ + 240, 0, .85480, 230, -120, -120, 120, 0/ + 240, 0, .87480, 230, -120, 110, 110, 0/ + 240, 0, .87830, 130, -120, -120, -120, 120/ + 240, 0, .88180, 230, -120, -120, 120, 110/ + 240, 0, .88530, 130, -120, -120, 110, 110/ + 240, 0, .88880, 230, -120, 110, 110, 110/ + 240, 0, .90880, 230, 230, -130, 0, 0/ + 240, 0, .91580, 331, -120, 0, 0, 0/ + 240, 0, .92580, 331, -120, 110, 0, 0/ + 240, 0, .93400, 230, -130, 0, 0, 0/ + 240, 0, .93920, 231, -130, 0, 0, 0/ + 240, 0, .94440, 230, -131, 0, 0, 0/ + 240, 0, .95840, 231, -131, 0, 0, 0/ + 240, 0, .96240, -130, 130, -120, 0, 0/ + 240, 0, .96340, -130, 230, 110, 0, 0/ + 240, 0, .96440, 230, -230, -120, 0, 0/ + 240, 0, .96540, -131, 130, -120, 0, 0/ + 240, 0, .96640, -130, 131, -120, 0, 0/ + 240, 0, .96740, -131, 230, 110, 0, 0/ + 240, 0, .96840, -130, 231, 110, 0, 0/ + 240, 0, .96940, 231, -230, -120, 0, 0/ + 240, 0, .97040, 230, -231, -120, 0, 0/ + 240, 0, .97300, 110, -120, 0, 0, 0/ + 240, 0, .97320, 111, -120, 0, 0, 0/ + 240, 0, .97640, -120, -120, 120, 0, 0/ + 240, 0, .97940, -120, 110, 110, 0, 0/ + 240, 0, .98240, -120, -120, 120, 110, 0/ + 240, 0, .98440, -120, 110, 110, 110, 0/ + 240, 0, .99200, 220, -120, 0, 0, 0/ + 240, 0, .99500, 220, -120, 110, 0, 0/ + 240, 0, .99800, 220, -120, 120, -120, 0/ + 240, 0, 1.00000, 220, -120, 110, 110, 0/ + 140, 3, .00450, -11, 12, 131, 0, 0/ + 140, 3, .00900, -11, 12, 131, 0, 0/ + 140, 3, .01980, -11, 12, 131, 0, 0/ + 140, 3, .05620, -11, 12, 130, 0, 0/ + 140, 3, .05760, -11, 12, 10131, 0, 0/ + 140, 3, .05910, -11, 12, 132, 0, 0/ + 140, 3, .06410, -11, 12, 120, 0, 0/ + 140, 3, .06700, -11, 12, 121, 0, 0/ + 140, 3, .07150, -13, 14, 131, 0, 0/ + 140, 3, .07600, -13, 14, 131, 0, 0/ + 140, 3, .08680, -13, 14, 131, 0, 0/ + 140, 3, .12320, -13, 14, 130, 0, 0/ + 140, 3, .12460, -13, 14, 10131, 0, 0/ + 140, 3, .12610, -13, 14, 132, 0, 0/ + 140, 3, .13110, -13, 14, 120, 0, 0/ + 140, 3, .13400, -13, 14, 121, 0, 0/ + 140, 0, .17310, 130, -120, 0, 0, 0/ + 140, 0, .19510, 230, 110, 0, 0, 0/ + 140, 0, .20280, 230, 220, 0, 0, 0/ + 140, 0, .22020, 230, 330, 0, 0, 0/ + 140, 0, .24090, 230, 221, 0, 0, 0/ + 140, 0, .32500, 130, -121, 0, 0, 0/ + 140, 0, .33310, 230, 111, 0, 0, 0/ + 140, 0, .37190, 131, -120, 0, 0, 0/ + 140, 0, .39750, 231, 110, 0, 0, 0/ + 140, 0, .41340, 231, 220, 0, 0, 0/ + 140, 0, .41540, 231, 330, 0, 0, 0/ + 140, 0, .49520, 130, -10121, 0, 0, 0/ + 140, 0, .55520, 131, -121, 0, 0, 0/ + 140, 0, .57130, 231, 111, 0, 0, 0/ + 140, 0, .58240, 231, 221, 0, 0, 0/ + 140, 0, .59310, 10131, -120, 0, 0, 0/ + 140, 0, .60020, 10231, 110, 0, 0, 0/ + 140, 0, .60190, 130, -120, 110, 0, 0/ + 140, 0, .62320, 230, 120, -120, 0, 0/ + 140, 0, .63770, 230, 110, 110, 0, 0/ + 140, 0, .65510, 231, 120, -120, 0, 0/ + 140, 0, .66670, 231, 110, 110, 0, 0/ + 140, 0, .67670, 131, -120, 110, 0, 0/ + 140, 0, .68350, 130, -121, 110, 0, 0/ + 140, 0, .69030, 130, -120, 111, 0, 0/ + 140, 0, .72060, 130, -120, 221, 0, 0/ + 140, 0, .73060, 130, -120, 220, 0, 0/ + 140, 0, .73810, 130, -120, 330, 0, 0/ + 140, 0, .75240, 130, -120, 120, -120, 0/ + 140, 0, .79310, 230, 120, -120, 110, 0/ + 140, 0, .86290, 130, -120, 110, 110, 0/ + 140, 0, .88290, 230, 110, 110, 110, 0/ + 140, 0, .88670, 130, -120, 120, -120, 110/ + 140, 0, .89050, 130, -120, 110, 110, 110/ + 140, 0, .89430, 230, 120, -120, 120, -120/ + 140, 0, .89810, 230, 120, -120, 110, 110/ + 140, 0, .90690, 230, 331, 0, 0, 0/ + 140, 0, .91200, 230, 130, -130, 0, 0/ + 140, 0, .91300, 20, 20, 20, 0, 0/ + 140, 0, .91740, 130, -130, 0, 0, 0/ + 140, 0, .91800, 20, 20, 0, 0, 0/ + 140, 0, .91860, -20, -20, 0, 0, 0/ + 140, 0, .92060, -231, 230, 0, 0, 0/ + 140, 0, .92260, 231, -230, 0, 0, 0/ + 140, 0, .92450, 131, -130, 0, 0, 0/ + 140, 0, .92800, -131, 130, 0, 0, 0/ + 140, 0, .92900, 231, -231, 0, 0, 0/ + 140, 0, .93100, 230, 130, -120, 0, 0/ + 140, 0, .93500, -230, -130, 120, 0, 0/ + 140, 0, .93700, 331, 110, 0, 0, 0/ + 140, 0, .93950, 331, 120, -120, 0, 0/ + 140, 0, .94250, 130, -130, 120, -120, 0/ + 140, 0, .94550, 130, -130, 110, 110, 0/ + 140, 0, .94700, -230, 230, 120, -120, 0/ + 140, 0, .94850, -230, 230, 120, -120, 0/ + 140, 0, .95000, 120, -120, 0, 0, 0/ + 140, 0, .95090, 110, 110, 0, 0, 0/ + 140, 0, .95190, 220, 110, 0, 0, 0/ + 140, 0, .95290, 330, 110, 0, 0, 0/ + 140, 0, .95390, 220, 220, 0, 0, 0/ + 140, 0, .95790, 121, -120, 0, 0, 0/ + 140, 0, .96190, -121, 120, 0, 0, 0/ + 140, 0, .96390, 111, 110, 0, 0, 0/ + 140, 0, .96590, 120, -120, 110, 0, 0/ + 140, 0, .96690, 110, 110, 110, 0, 0/ + 140, 0, .97500, 120, 120, -120, -120, 0/ + 140, 0, .98000, 120, -120, 110, 110, 0/ + 140, 0, .99400, 120, -120, 120, -120, 110/ + 140, 0, 1.00000, 120, -120, 110, 110, 110/ + 340, 3, .00450, -11, 12, 331, 0, 0/ + 340, 3, .00900, -11, 12, 331, 0, 0/ + 340, 3, .02000, -11, 12, 331, 0, 0/ + 340, 3, .05880, -11, 12, 220, 0, 0/ + 340, 3, .07560, -11, 12, 330, 0, 0/ + 340, 3, .07830, -11, 12, 230, 0, 0/ + 340, 3, .07930, -11, 12, 231, 0, 0/ + 340, 3, .08380, -13, 14, 331, 0, 0/ + 340, 3, .08830, -13, 14, 331, 0, 0/ + 340, 3, .09930, -13, 14, 331, 0, 0/ + 340, 3, .13810, -13, 14, 220, 0, 0/ + 340, 3, .15490, -13, 14, 330, 0, 0/ + 340, 3, .15760, -13, 14, 230, 0, 0/ + 340, 3, .15860, -13, 14, 231, 0, 0/ + 340, 0, .16770, -13, 14, 0, 0, 0/ + 340, 0, .25870, -15, 16, 0, 0, 0/ + 340, 0, .29570, 331, -120, 0, 0, 0/ + 340, 0, .31570, 220, -120, 0, 0, 0/ + 340, 0, .36750, 330, -120, 0, 0, 0/ + 340, 0, .36850, 221, -120, 0, 0, 0/ + 340, 0, .36950, 111, -120, 0, 0, 0/ + 340, 0, .37150, -121, 110, 0, 0, 0/ + 340, 0, .37250, -120, 110, 0, 0, 0/ + 340, 0, .38290, 10110, -120, 0, 0, 0/ + 340, 0, .45170, 331, -121, 0, 0, 0/ + 340, 0, .55750, 220, -121, 0, 0, 0/ + 340, 0, .68480, 330, -121, 0, 0, 0/ + 340, 0, .69570, -120, 120, -120, 0, 0/ + 340, 0, .70070, -120, 110, 110, 0, 0/ + 340, 0, .72070, 331, -120, 110, 0, 0/ + 340, 0, .73070, 220, -120, 110, 0, 0/ + 340, 0, .74070, 330, -120, 110, 0, 0/ + 340, 0, .75620, 331, -120, 120, -120, 0/ + 340, 0, .76120, 331, -120, 110, 110, 0/ + 340, 0, .76620, 220, -120, 120, -120, 0/ + 340, 0, .77120, 220, -120, 110, 110, 0/ + 340, 0, .80860, 230, -130, 0, 0, 0/ + 340, 0, .84380, 231, -130, 0, 0, 0/ + 340, 0, .88820, 230, -131, 0, 0, 0/ + 340, 0, .94740, 231, -131, 0, 0, 0/ + 340, 0, .95670, -130, 130, -120, 0, 0/ + 340, 0, .96170, 230, -130, 110, 0, 0/ + 340, 0, .96370, 230, -130, -120, 120, 0/ + 340, 0, .96570, 230, -130, 110, 110, 0/ + 340, 0, .96870, 331, -130, 0, 0, 0/ + 340, 0, .97020, 220, -130, 0, 0, 0/ + 340, 0, .97370, 330, -130, 0, 0, 0/ + 340, 0, .97670, 220, -130, 110, 0, 0/ + 340, 0, .97870, 220, -130, -120, 120, 0/ + 340, 0, .98070, 330, -130, 110, 0, 0/ + 340, 0, .98170, 330, -130, -120, 120, 0/ + 340, 0, .98470, -130, 130, -130, 0, 0/ + 340, 0, .98720, -230, -120, 0, 0, 0/ + 340, 0, .98970, -230, -121, 0, 0, 0/ + 340, 0, .99070, -230, -120, 110, 0, 0/ + 340, 0, .99270, -230, -10121, 0, 0, 0/ + 340, 0, .99520, -231, -120, 0, 0, 0/ + 340, 0, .99770, -231, -121, 0, 0, 0/ + 340, 0, 1.00000, -231, -120, 110, 0, 0/ + 241, 0, .64000, 140, -120, 0, 0, 0/ + 241, 0, .92000, 240, 110, 0, 0, 0/ + 241, 0, 1.00000, 240, 10, 0, 0, 0/ + 141, 0, .55000, 140, 110, 0, 0, 0/ + 141, 0, 1.00000, 140, 10, 0, 0, 0/ + 341, 0, 1.00000, 340, 10, 0, 0, 0/ + 440, 0, .01200, 120, -120, 120, -120, 0/ + 440, 0, .01320, 1120, -1120, 0, 0, 0/ + 440, 0, .03320, 130, -130, 120, -120, 0/ + 440, 0, .05770, 220, 120, -120, 0, 0/ + 440, 0, .08220, 220, 110, 110, 0, 0/ + 440, 0, .10270, 330, 120, -120, 0, 0/ + 440, 0, .12320, 330, 110, 110, 0, 0/ + 440, 0, .13030, 331, 331, 0, 0, 0/ + 440, 0, .14430, 220, 130, -130, 0, 0/ + 440, 0, .16630, 110, 130, -130, 0, 0/ + 440, 0, .18830, 130, -230, -120, 0, 0/ + 440, 0, .21030, -130, 230, 120, 0, 0/ + 440, 0, .21460, 131, -131, 0, 0, 0/ + 440, 0, .21880, 231, -231, 0, 0, 0/ + 440, 0, .22880, 231, -130, 120, 0, 0/ + 440, 0, .23880, -231, 130, -120, 0, 0/ + 440, 0, .25180, 111, 111, 0, 0, 0/ + 440, 0, .26480, 121, -121, 0, 0, 0/ + 440, 0, .42810, 121, 110, -121, 0, 0/ + 440, 0, .59140, 120, 111, -121, 0, 0/ + 440, 0, .75470, 121, 111, -120, 0, 0/ + 440, 0, .81600, 121, -121, 0, 0, 0/ + 440, 0, .87730, 111, 111, 0, 0, 0/ + 440, 0, .93860, 131, -131, 0, 0, 0/ + 440, 0, 1.00000, 231, -231, 0, 0, 0/ + 441, 0, .06020, -12, 12, 0, 0, 0/ + 441, 0, .12030, -14, 14, 0, 0, 0/ + 441, 0, .13730, 120, -120, 110, 0, 0/ + 441, 0, .17360, 111, 111, 110, 0, 0/ + 441, 0, .20990, 121, -121, 110, 0, 0/ + 441, 0, .24620, 121, 111, -120, 0, 0/ + 441, 0, .28120, 111, 111, 111, 110, 0/ + 441, 0, .31620, 121, -121, 111, 110, 0/ + 441, 0, .35120, 111, 111, 121, -120, 0/ + 441, 0, .38620, 121, -121, 121, -120, 0/ + 441, 0, .41420, 111, 111, 111, 221, 0/ + 441, 0, .44220, 121, -121, 111, 221, 0/ + 441, 0, .44930, 130, -130, 110, 0, 0/ + 441, 0, .45640, 230, -230, 110, 0, 0/ + 441, 0, .46350, 130, -230, -120, 0, 0/ + 441, 0, .47060, 230, -130, 120, 0, 0/ + 441, 0, .47770, 131, -130, 110, 0, 0/ + 441, 0, .48480, 131, -230, -120, 0, 0/ + 441, 0, .49190, 231, -130, 120, 0, 0/ + 441, 0, .49900, 231, -230, 110, 0, 0/ + 441, 0, .50610, 130, -131, 110, 0, 0/ + 441, 0, .51320, 130, -231, -120, 0, 0/ + 441, 0, .52030, 230, -131, 120, 0, 0/ + 441, 0, .52740, 230, -231, 110, 0, 0/ + 441, 0, .53690, 131, -131, 110, 0, 0/ + 441, 0, .54640, 231, -231, 110, 0, 0/ + 441, 0, .55590, 131, 231, -120, 0, 0/ + 441, 0, .56540, 231, -131, 120, 0, 0/ + 441, 0, .58040, 131, -131, 111, 0, 0/ + 441, 0, .59540, 231, -231, 111, 0, 0/ + 441, 0, .61040, 131, 231, -121, 0, 0/ + 441, 0, .62540, 231, -131, 121, 0, 0/ + 441, 0, .64240, 120, -120, 220, 0, 0/ + 441, 0, .65940, 120, -120, 220, 220, 0/ + 441, 0, .70940, 111, 111, 220, 0, 0/ + 441, 0, .75940, 121, -121, 220, 0, 0/ + 441, 0, .80940, 121, -121, 111, 220, 0/ + 441, 0, .85940, 121, -121, 221, 220, 0/ + 441, 0, .86160, 1120, -1120, 0, 0, 0/ + 441, 0, .86380, 1220, -1220, 0, 0, 0/ + 441, 0, .87880, 1111, -1111, 0, 0, 0/ + 441, 0, .89380, 1121, -1121, 0, 0, 0/ + 441, 0, .90880, 1221, -1221, 0, 0, 0/ + 441, 0, .92380, 2221, -2221, 0, 0, 0/ + 441, 0, .94080, 10, 440, 0, 0, 0/ + 441, 0, .94910, 10, 121, -121, 0, 0/ + 441, 0, .95740, 10, 111, 111, 0, 0/ + 441, 0, .96640, 10, 220, 120, -120, 0/ + 441, 0, .98340, 10, 121, -121, 111, 0/ + 441, 0, 1.00000, 10, 111, 111, 111, 0/ + 10441, 0, .00830, -12, 12, 0, 0, 0/ + 10441, 0, .01660, -14, 14, 0, 0, 0/ + 10441, 0, .34060, 441, 120, -120, 0, 0/ + 10441, 0, .52460, 441, 110, 110, 0, 0/ + 10441, 0, .55160, 441, 220, 0, 0, 0/ + 10441, 0, .55260, 441, 110, 0, 0, 0/ + 10441, 0, .64560, 10, 20440, 0, 0, 0/ + 10441, 0, .73260, 10, 20441, 0, 0, 0/ + 10441, 0, .81060, 10, 20442, 0, 0, 0/ + 10441, 0, .81340, 10, 440, 0, 0, 0/ + 10441, 0, .81720, 111, 111, 110, 0, 0/ + 10441, 0, .82100, 121, -121, 110, 0, 0/ + 10441, 0, .82480, 121, 111, -120, 0, 0/ + 10441, 0, .82990, 111, 111, 111, 110, 0/ + 10441, 0, .83500, 121, -121, 111, 110, 0/ + 10441, 0, .84010, 111, 111, 121, -120, 0/ + 10441, 0, .84520, 121, -121, 121, -120, 0/ + 10441, 0, .87020, 111, 111, 111, 221, 0/ + 10441, 0, .89520, 121, -121, 111, 221, 0/ + 10441, 0, .89920, 130, -130, 110, 0, 0/ + 10441, 0, .90320, 230, -230, 110, 0, 0/ + 10441, 0, .90720, 130, -230, -120, 0, 0/ + 10441, 0, .91120, 230, -130, 120, 0, 0/ + 10441, 0, .91520, 131, -130, 110, 0, 0/ + 10441, 0, .91920, 131, -230, -120, 0, 0/ + 10441, 0, .92320, 231, -130, 120, 0, 0/ + 10441, 0, .92720, 231, -230, 110, 0, 0/ + 10441, 0, .93120, 130, -131, 110, 0, 0/ + 10441, 0, .93520, 130, -231, -120, 0, 0/ + 10441, 0, .93920, 230, -131, 120, 0, 0/ + 10441, 0, .94320, 230, -231, 110, 0, 0/ + 10441, 0, .94690, 231, -131, 120, 0, 0/ + 10441, 0, .95060, 131, -131, 111, 0, 0/ + 10441, 0, .95430, 231, -231, 111, 0, 0/ + 10441, 0, .95800, 131, 231, -121, 0, 0/ + 10441, 0, .96170, 231, -131, 121, 0, 0/ + 10441, 0, .96540, 120, -120, 220, 0, 0/ + 10441, 0, .96910, 120, -120, 220, 220, 0/ + 10441, 0, .97280, 111, 111, 220, 0, 0/ + 10441, 0, .97650, 121, -121, 220, 0, 0/ + 10441, 0, .98020, 121, -121, 111, 220, 0/ + 10441, 0, .98390, 121, -121, 221, 220, 0/ + 10441, 0, .98790, 1111, -1111, 0, 0, 0/ + 10441, 0, .99190, 1121, -1121, 0, 0, 0/ + 10441, 0, .99590, 1221, -1221, 0, 0, 0/ + 10441, 0, 1.00000, 2221, -2221, 0, 0, 0/ + 20440, 0, .00660, 10, 441, 0, 0, 0/ + 20440, 0, .01410, 120, -120, 0, 0, 0/ + 20440, 0, .05110, 120, -120, 120, -120, 0/ + 20440, 0, .06610, 120, -120, 120, -120, 120/ + 20440, 0, .08210, 111, 120, -120, 0, 0/ + 20440, 0, .09810, 121, -120, 110, 0, 0/ + 20440, 0, .11410, -121, 120, 110, 0, 0/ + 20440, 0, .12010, -231, 130, -120, 0, 0/ + 20440, 0, .12610, 231, -130, 120, 0, 0/ + 20440, 0, .13210, -230, 131, -120, 0, 0/ + 20440, 0, .13810, 230, -131, 120, 0, 0/ + 20440, 0, .14520, 130, -130, 0, 0, 0/ + 20440, 0, .17520, 120, -120, 130, -130, 0/ + 20440, 0, .18020, 120, -120, 1120, -1120, 0/ + 20440, 0, .36240, 121, 110, -121, 0, 0/ + 20440, 0, .54460, 120, 111, -121, 0, 0/ + 20440, 0, .72680, 121, 111, -120, 0, 0/ + 20440, 0, .79520, 121, -121, 0, 0, 0/ + 20440, 0, .86360, 111, 111, 0, 0, 0/ + 20440, 0, .93200, 131, -131, 0, 0, 0/ + 20440, 0, 1.00000, 231, -231, 0, 0, 0/ + 20441, 0, .27300, 10, 441, 0, 0, 0/ + 20441, 0, .28900, 120, -120, 120, -120, 0/ + 20441, 0, .31100, 120, -120, 120, -120, 120/ + 20441, 0, .32000, 120, -120, 130, -130, 0/ + 20441, 0, .32390, 111, 120, -120, 0, 0/ + 20441, 0, .32780, 121, -120, 110, 0, 0/ + 20441, 0, .33170, -121, 120, 110, 0, 0/ + 20441, 0, .33330, -231, 130, -120, 0, 0/ + 20441, 0, .33490, 231, -130, 120, 0, 0/ + 20441, 0, .33650, -230, 131, -120, 0, 0/ + 20441, 0, .33810, 230, -131, 120, 0, 0/ + 20441, 0, .33950, 120, -120, 1120, -1120, 0/ + 20441, 0, .48630, 121, 110, -121, 0, 0/ + 20441, 0, .63310, 120, 111, -121, 0, 0/ + 20441, 0, .77990, 121, 111, -120, 0, 0/ + 20441, 0, .83500, 121, -121, 0, 0, 0/ + 20441, 0, .89010, 111, 111, 0, 0, 0/ + 20441, 0, .94520, 131, -131, 0, 0, 0/ + 20441, 0, 1.00000, 231, -231, 0, 0, 0/ + 20442, 0, .13500, 10, 441, 0, 0, 0/ + 20442, 0, .13690, 120, -120, 0, 0, 0/ + 20442, 0, .15890, 120, -120, 120, -120, 0/ + 20442, 0, .17090, 120, -120, 120, -120, 120/ + 20442, 0, .17790, 111, 120, -120, 0, 0/ + 20442, 0, .18490, 121, -120, 110, 0, 0/ + 20442, 0, .19190, -121, 120, 110, 0, 0/ + 20442, 0, .19430, -231, 130, -120, 0, 0/ + 20442, 0, .19670, 231, -130, 120, 0, 0/ + 20442, 0, .19910, -230, 131, -120, 0, 0/ + 20442, 0, .20150, 230, -131, 120, 0, 0/ + 20442, 0, .20300, 130, -130, 0, 0, 0/ + 20442, 0, .22200, 120, -120, 130, -130, 0/ + 20442, 0, .22210, 1120, -1120, 0, 0, 0/ + 20442, 0, .22540, 120, -120, 1120, -1120, 0/ + 20442, 0, .39750, 121, 110, -121, 0, 0/ + 20442, 0, .56960, 120, 111, -121, 0, 0/ + 20442, 0, .74170, 121, 111, -120, 0, 0/ + 20442, 0, .80630, 121, -121, 0, 0, 0/ + 20442, 0, .87090, 111, 111, 0, 0, 0/ + 20442, 0, .93550, 131, -131, 0, 0, 0/ + 20442, 0, 1.00000, 231, -231, 0, 0, 0/ + 150, 3, .01150, 11, -12, 141, 0, 0/ + 150, 3, .02300, 11, -12, 141, 0, 0/ + 150, 3, .04900, 11, -12, 141, 0, 0/ + 150, 3, .06700, 11, -12, 140, 0, 0/ + 150, 0, .07930, 11, -12, 140, 110, 0/ + 150, 0, .10400, 11, -12, 240, 120, 0/ + 150, 3, .11550, 13, -14, 141, 0, 0/ + 150, 3, .12700, 13, -14, 141, 0, 0/ + 150, 3, .15300, 13, -14, 141, 0, 0/ + 150, 3, .17100, 13, -14, 140, 0, 0/ + 150, 0, .18330, 13, -14, 140, 110, 0/ + 150, 0, .20800, 13, -14, 240, 120, 0/ + 150, 3, .22400, 15, -16, 141, 0, 0/ + 150, 3, .23200, 15, -16, 140, 0, 0/ + 150, 0, .23300, 15, -16, 241, 120, 0/ + 150, 0, .23350, 15, -16, 141, 110, 0/ + 150, 0, .23450, 15, -16, 240, 120, 0/ + 150, 0, .23500, 15, -16, 140, 110, 0/ + 150, 0, .24000, 11, -12, -2140, 1120, 0/ + 150, 0, .24500, 13, -14, -2140, 1120, 0/ + 150, 0, .25440, -340, 140, 0, 0, 0/ + 150, 0, .26340, -340, 141, 0, 0, 0/ + 150, 0, .27280, -341, 140, 0, 0, 0/ + 150, 0, .29020, -341, 141, 0, 0, 0/ + 150, 0, .30020, -340, 240, 120, 0, 0/ + 150, 0, .30520, -340, 140, 110, 0, 0/ + 150, 0, .31520, -341, 240, 120, 0, 0/ + 150, 0, .32020, -341, 140, 110, 0, 0/ + 150, 0, .32570, -340, 240, 120, 110, 0/ + 150, 0, .33120, -340, 140, 120, -120, 0/ + 150, 0, .33260, -340, 140, 110, 110, 0/ + 150, 0, .33810, -341, 240, 120, 110, 0/ + 150, 0, .34360, -341, 140, 120, -120, 0/ + 150, 0, .34500, -341, 140, 110, 110, 0/ + 150, 0, .34600, -240, 140, 0, 0, 0/ + 150, 0, .34700, -240, 141, 0, 0, 0/ + 150, 0, .34800, -241, 140, 0, 0, 0/ + 150, 0, .34900, -241, 141, 0, 0, 0/ + 150, 0, .34940, -240, 240, 120, 0, 0/ + 150, 0, .34960, -240, 140, 110, 0, 0/ + 150, 0, .35000, -241, 240, 120, 0, 0/ + 150, 0, .35020, -241, 140, 110, 0, 0/ + 150, 0, .35050, -240, 240, 120, 110, 0/ + 150, 0, .35070, -240, 140, 110, 110, 0/ + 150, 0, .35100, -240, 140, 120, -120, 0/ + 150, 0, .36350, 111, 131, 111, 141, 0/ + 150, 0, .37600, 111, 131, 121, 241, 0/ + 150, 0, .38850, 121, 231, 111, 141, 0/ + 150, 0, .40100, 121, 231, 121, 241, 0/ + 150, 0, .42850, -2140, 1120, 121, 111, 0/ + 150, 0, .45600, -2140, 1120, 121, 221, 0/ + 150, 0, .45850, -2140, 1120, 111, 131, 0/ + 150, 0, .46100, -2140, 1120, 121, 231, 0/ + 150, 0, .46190, 441, 130, 0, 0, 0/ + 150, 0, .46350, 441, 131, 0, 0, 0/ + 150, 0, .46450, 441, 230, 120, 0, 0/ + 150, 0, .46500, 441, 130, 110, 0, 0/ + 150, 0, .46640, 441, 130, -120, 120, 0/ + 150, 0, .46710, 441, 230, 110, 120, 0/ + 150, 0, .46780, 441, 130, 110, 110, 0/ + 150, 0, .46920, 441, 111, 131, 0, 0/ + 150, 0, .47060, 441, 121, 231, 0, 0/ + 150, 0, .47130, 10441, 130, 0, 0, 0/ + 150, 0, .47280, 10441, 131, 0, 0, 0/ + 150, 0, .47310, 10441, 230, 120, 0, 0/ + 150, 0, .47330, 10441, 130, 110, 0, 0/ + 150, 0, .47370, 10441, 130, -120, 120, 0/ + 150, 0, .47390, 10441, 230, 110, 120, 0/ + 150, 0, .47410, 10441, 130, 110, 110, 0/ + 150, 0, .47510, 20440, 130, 0, 0, 0/ + 150, 0, .47660, 20440, 131, 0, 0, 0/ + 150, 0, .47690, 20440, 230, 120, 0, 0/ + 150, 0, .47710, 20440, 130, 110, 0, 0/ + 150, 0, .47740, 20440, 130, -120, 120, 0/ + 150, 0, .47760, 20440, 230, 110, 120, 0/ + 150, 0, .47780, 20440, 130, 110, 110, 0/ + 150, 0, .47880, 20441, 130, 0, 0, 0/ + 150, 0, .48030, 20441, 131, 0, 0, 0/ + 150, 0, .48060, 20441, 230, 120, 0, 0/ + 150, 0, .48080, 20441, 130, 110, 0, 0/ + 150, 0, .48110, 20441, 130, -120, 120, 0/ + 150, 0, .48130, 20441, 230, 110, 120, 0/ + 150, 0, .48150, 20441, 130, 110, 110, 0/ + 150, 0, .48200, 20442, 130, 0, 0, 0/ + 150, 0, .48300, 20442, 131, 0, 0, 0/ + 150, 0, .48320, 20442, 230, 120, 0, 0/ + 150, 0, .48330, 20442, 130, 110, 0, 0/ + 150, 0, .48360, 20442, 130, -120, 120, 0/ + 150, 0, .48380, 20442, 230, 110, 120, 0/ + 150, 0, .48400, 20442, 130, 110, 110, 0/ + 150, 0, .48420, 440, 130, 0, 0, 0/ + 150, 0, .48470, 440, 131, 0, 0, 0/ + 150, 0, .48480, 440, 230, 120, 0, 0/ + 150, 0, .48490, 440, 130, 110, 0, 0/ + 150, 0, .48500, 440, 130, -120, 120, 0/ + 150, 0, .48510, 440, 230, 110, 120, 0/ + 150, 0, .48520, 440, 130, 110, 110, 0/ + 150, 0, .49020, 141, 120, 0, 0, 0/ + 150, 0, .49500, 140, 120, 0, 0, 0/ + 150, 0, .50820, 140, 121, 0, 0, 0/ + 150, 0, .52290, 141, 121, 0, 0, 0/ + 150, 0, .52340, 240, 120, 120, 0, 0/ + 150, 0, .52390, 140, 110, 120, 0, 0/ + 150, 0, .52440, 241, 120, 120, 0, 0/ + 150, 0, .52490, 141, 110, 120, 0, 0/ + 150, 0, .52910, 140, 10121, 0, 0, 0/ + 150, 0, .53320, 140, 111, 120, 0, 0/ + 150, 0, .53730, 140, -120, 120, 120, 0/ + 150, 0, .55560, 141, 10121, 0, 0, 0/ + 150, 0, .55610, 141, 111, 120, 0, 0/ + 150, 0, .55660, 141, -120, 120, 120, 0/ + 150, 0, .55860, 240, 121, 120, 0, 0/ + 150, 0, .56060, 240, 110, 120, 120, 0/ + 150, 0, .56260, 241, 121, 120, 0, 0/ + 150, 0, .56460, 241, 110, 120, 120, 0/ + 150, 0, .56510, 141, 121, 110, 0, 0/ + 150, 0, .56560, 141, 121, 110, 110, 0/ + 150, 0, .67400, 111, 121, 111, 141, 0/ + 150, 0, .78240, 111, 121, 121, 241, 0/ + 150, 0, .89080, 221, 121, 111, 141, 0/ + 150, 0, 1.00000, 221, 121, 121, 241, 0/ + 250, 3, .01150, 11, -12, 241, 0, 0/ + 250, 3, .02300, 11, -12, 241, 0, 0/ + 250, 3, .04900, 11, -12, 241, 0, 0/ + 250, 3, .06700, 11, -12, 240, 0, 0/ + 250, 0, .07930, 11, -12, 240, 110, 0/ + 250, 0, .10400, 11, -12, 140, -120, 0/ + 250, 3, .11550, 13, -14, 241, 0, 0/ + 250, 3, .12700, 13, -14, 241, 0, 0/ + 250, 3, .15300, 13, -14, 241, 0, 0/ + 250, 3, .17100, 13, -14, 240, 0, 0/ + 250, 0, .18330, 13, -14, 240, 110, 0/ + 250, 0, .20800, 13, -14, 140, -120, 0/ + 250, 3, .22400, 15, -16, 241, 0, 0/ + 250, 3, .23200, 15, -16, 240, 0, 0/ + 250, 0, .23300, 15, -16, 141, -120, 0/ + 250, 0, .23350, 15, -16, 241, 110, 0/ + 250, 0, .23450, 15, -16, 140, -120, 0/ + 250, 0, .23500, 15, -16, 240, 110, 0/ + 250, 0, .24000, 11, -12, -2140, 1220, 0/ + 250, 0, .24500, 13, -14, -2140, 1220, 0/ + 250, 0, .25440, -340, 240, 0, 0, 0/ + 250, 0, .26340, -340, 241, 0, 0, 0/ + 250, 0, .27280, -341, 240, 0, 0, 0/ + 250, 0, .29020, -341, 241, 0, 0, 0/ + 250, 0, .29520, -340, 240, 110, 0, 0/ + 250, 0, .30520, -340, 140, -120, 0, 0/ + 250, 0, .31020, -341, 240, 110, 0, 0/ + 250, 0, .32020, -341, 140, -120, 0, 0/ + 250, 0, .32520, -340, 240, 120, -120, 0/ + 250, 0, .32890, -340, 240, 110, 110, 0/ + 250, 0, .33260, -340, 140, -120, 110, 0/ + 250, 0, .33760, -341, 240, 120, -120, 0/ + 250, 0, .34130, -341, 240, 110, 110, 0/ + 250, 0, .34500, -341, 140, -120, 110, 0/ + 250, 0, .34600, -240, 240, 0, 0, 0/ + 250, 0, .34700, -240, 241, 0, 0, 0/ + 250, 0, .34800, -241, 240, 0, 0, 0/ + 250, 0, .34900, -241, 241, 0, 0, 0/ + 250, 0, .34920, -240, 240, 110, 0, 0/ + 250, 0, .34960, -240, 140, -120, 0, 0/ + 250, 0, .34980, -241, 240, 110, 0, 0/ + 250, 0, .35020, -241, 140, -120, 0, 0/ + 250, 0, .35040, -240, 240, 110, 110, 0/ + 250, 0, .35070, -240, 240, -120, 120, 0/ + 250, 0, .35100, -240, 140, -120, 110, 0/ + 250, 0, .36350, 111, 131, -121, 141, 0/ + 250, 0, .37600, 111, 131, 111, 241, 0/ + 250, 0, .38850, 121, 231, -121, -141, 0/ + 250, 0, .40100, 121, 231, 111, 241, 0/ + 250, 0, .42850, -2140, 1220, 111, 121, 0/ + 250, 0, .45600, -2140, 1220, 221, 121, 0/ + 250, 0, .45850, -2140, 1220, 111, 131, 0/ + 250, 0, .46350, -2140, 1220, 121, 231, 0/ + 250, 0, .46440, 441, 230, 0, 0, 0/ + 250, 0, .46600, 441, 231, 0, 0, 0/ + 250, 0, .46700, 441, 130, -120, 0, 0/ + 250, 0, .46750, 441, 230, 110, 0, 0/ + 250, 0, .46920, 441, 230, -120, 120, 0/ + 250, 0, .46990, 441, 230, 110, 110, 0/ + 250, 0, .47060, 441, 130, -120, 110, 0/ + 250, 0, .47130, 441, -121, 131, 0, 0/ + 250, 0, .47270, 441, 111, 231, 0, 0/ + 250, 0, .47340, 10441, 230, 0, 0, 0/ + 250, 0, .47490, 10441, 231, 0, 0, 0/ + 250, 0, .47520, 10441, 130, -120, 0, 0/ + 250, 0, .47540, 10441, 230, 110, 0, 0/ + 250, 0, .47580, 10441, 230, -120, 120, 0/ + 250, 0, .47600, 10441, 230, 110, 110, 0/ + 250, 0, .47620, 10441, 130, -120, 110, 0/ + 250, 0, .47720, 20440, 230, 0, 0, 0/ + 250, 0, .47870, 20440, 231, 0, 0, 0/ + 250, 0, .47900, 20440, 130, -120, 0, 0/ + 250, 0, .47920, 20440, 230, 110, 0, 0/ + 250, 0, .47950, 20440, 230, -120, 120, 0/ + 250, 0, .47970, 20440, 230, 110, 110, 0/ + 250, 0, .47990, 20440, 130, -120, 110, 0/ + 250, 0, .48090, 20441, 230, 0, 0, 0/ + 250, 0, .48240, 20441, 231, 0, 0, 0/ + 250, 0, .48270, 20441, 130, -120, 0, 0/ + 250, 0, .48290, 20441, 230, 110, 0, 0/ + 250, 0, .48320, 20441, 230, -120, 120, 0/ + 250, 0, .48340, 20441, 230, 110, 110, 0/ + 250, 0, .48360, 20441, 130, -120, 110, 0/ + 250, 0, .48410, 20442, 230, 0, 0, 0/ + 250, 0, .48510, 20442, 231, 0, 0, 0/ + 250, 0, .48530, 20442, 130, -120, 0, 0/ + 250, 0, .48540, 20442, 230, 110, 0, 0/ + 250, 0, .48570, 20442, 230, -120, 120, 0/ + 250, 0, .48590, 20442, 230, 110, 110, 0/ + 250, 0, .48610, 20442, 130, -120, 110, 0/ + 250, 0, .48630, 440, 230, 0, 0, 0/ + 250, 0, .48680, 440, 231, 0, 0, 0/ + 250, 0, .48690, 440, 130, -120, 0, 0/ + 250, 0, .48700, 440, 230, 110, 0, 0/ + 250, 0, .48710, 440, 230, -120, 120, 0/ + 250, 0, .48720, 440, 230, 110, 110, 0/ + 250, 0, .48730, 440, 130, -120, 110, 0/ + 250, 0, .49000, 241, 120, 0, 0, 0/ + 250, 0, .49300, 240, 120, 0, 0, 0/ + 250, 0, .50120, 240, 121, 0, 0, 0/ + 250, 0, .50820, 241, 121, 0, 0, 0/ + 250, 0, .50830, 141, 110, 0, 0, 0/ + 250, 0, .50840, 140, 110, 0, 0, 0/ + 250, 0, .50850, 140, 111, 0, 0, 0/ + 250, 0, .50860, 141, 111, 0, 0, 0/ + 250, 0, .50960, 240, 120, 110, 0, 0/ + 250, 0, .51660, 241, 120, 110, 0, 0/ + 250, 0, .51760, 140, 120, -120, 0, 0/ + 250, 0, .51810, 140, 110, 110, 0, 0/ + 250, 0, .51910, 141, 120, -120, 0, 0/ + 250, 0, .51960, 141, 110, 110, 0, 0/ + 250, 0, .52560, 240, 10121, 0, 0, 0/ + 250, 0, .52670, 240, 111, 120, 0, 0/ + 250, 0, .52780, 240, 121, 110, 0, 0/ + 250, 0, .52880, 240, -120, 120, 120, 0/ + 250, 0, .52980, 240, 110, 120, 110, 0/ + 250, 0, .53080, 140, -120, 120, 110, 0/ + 250, 0, .53090, 140, 110, 110, 110, 0/ + 250, 0, .54310, 241, 10121, 0, 0, 0/ + 250, 0, .54410, 241, 111, 120, 0, 0/ + 250, 0, .54510, 241, 121, 110, 0, 0/ + 250, 0, .55280, 241, -120, 120, 120, 0/ + 250, 0, .55380, 241, 110, 120, 110, 0/ + 250, 0, .55480, 141, -120, 120, 110, 0/ + 250, 0, .55490, 141, 110, 110, 110, 0/ + 250, 0, .66340, 111, 121, -121, 141, 0/ + 250, 0, .77190, 111, 121, 111, 241, 0/ + 250, 0, .88040, 221, 121, -121, 141, 0/ + 250, 0, .98890, 221, 121, 111, 241, 0/ + 250, 0, .99250, -121, 121, 111, 141, 0/ + 250, 0, .99610, -121, 121, 121, 241, 0/ + 250, 0, .99970, 111, 111, 111, 141, 0/ + 250, 0, 1.00000, 111, 111, 121, 241, 0/ + 350, 3, .04600, 11, -12, 341, 0, 0/ + 350, 3, .06400, 11, -12, 340, 0, 0/ + 350, 0, .07520, 11, -12, 240, -230, 0/ + 350, 0, .08640, 11, -12, 140, -130, 0/ + 350, 3, .13240, 13, -14, 341, 0, 0/ + 350, 3, .15040, 13, -14, 340, 0, 0/ + 350, 0, .16160, 13, -14, 240, -230, 0/ + 350, 0, .17280, 13, -14, 140, -130, 0/ + 350, 0, .18030, 15, -16, -130, 140, 0/ + 350, 0, .18780, 15, -16, -230, 240, 0/ + 350, 0, .19500, 11, -12, -2140, 2130, 0/ + 350, 0, .20220, 13, -14, -2140, 2130, 0/ + 350, 0, .21720, -340, 340, 0, 0, 0/ + 350, 0, .23220, -340, 341, 0, 0, 0/ + 350, 0, .24720, -341, 340, 0, 0, 0/ + 350, 0, .26220, -341, 341, 0, 0, 0/ + 350, 0, .26720, 340, -140, 130, 0, 0/ + 350, 0, .27220, 340, -240, 230, 0, 0/ + 350, 0, .27720, -340, 140, -130, 0, 0/ + 350, 0, .28220, -340, 240, -230, 0, 0/ + 350, 0, .28470, 341, -140, 130, 0, 0/ + 350, 0, .28720, 341, -240, 230, 0, 0/ + 350, 0, .28970, -341, 140, -130, 0, 0/ + 350, 0, .29220, -341, 240, -230, 0, 0/ + 350, 0, .29470, 340, -141, 130, 0, 0/ + 350, 0, .29720, 340, -241, 230, 0, 0/ + 350, 0, .29970, -340, 141, -130, 0, 0/ + 350, 0, .30220, -340, 241, -230, 0, 0/ + 350, 0, .30420, 340, -240, 0, 0, 0/ + 350, 0, .30620, 341, -240, 0, 0, 0/ + 350, 0, .30820, 340, -241, 0, 0, 0/ + 350, 0, .31020, 341, -241, 0, 0, 0/ + 350, 0, .31170, 340, -240, 110, 0, 0/ + 350, 0, .31320, 340, -140, 120, 0, 0/ + 350, 0, .31470, 341, -240, 110, 0, 0/ + 350, 0, .31620, 341, -140, 120, 0, 0/ + 350, 0, .32870, 111, 131, -131, 141, 0/ + 350, 0, .34120, 111, 131, -231, 241, 0/ + 350, 0, .35370, 121, 231, -131, 141, 0/ + 350, 0, .36620, 121, 231, -231, 241, 0/ + 350, 0, .39370, -2140, 2130, 111, 121, 0/ + 350, 0, .42120, -2140, 2130, 221, 121, 0/ + 350, 0, .42370, -2140, 2130, 111, 131, 0/ + 350, 0, .42620, -2140, 2130, 121, 231, 0/ + 350, 0, .42760, 441, 331, 0, 0, 0/ + 350, 0, .42810, 441, 220, 0, 0, 0/ + 350, 0, .42910, 441, 330, 0, 0, 0/ + 350, 0, .42950, 441, 10110, 0, 0, 0/ + 350, 0, .42990, 441, 112, 0, 0, 0/ + 350, 0, .43030, 441, 331, 120, -120, 0/ + 350, 0, .43070, 441, 331, 110, 110, 0/ + 350, 0, .43090, 441, 220, 120, -120, 0/ + 350, 0, .43110, 441, 220, 110, 110, 0/ + 350, 0, .43150, 441, 330, 120, -120, 0/ + 350, 0, .43190, 441, 330, 110, 110, 0/ + 350, 0, .43230, 441, 130, -130, 0, 0/ + 350, 0, .43270, 441, 230, -230, 0, 0/ + 350, 0, .43290, 441, 120, -120, 0, 0/ + 350, 0, .43310, 441, 110, 110, 0, 0/ + 350, 0, .43450, 10441, 331, 0, 0, 0/ + 350, 0, .43500, 10441, 220, 0, 0, 0/ + 350, 0, .43600, 10441, 330, 0, 0, 0/ + 350, 0, .43640, 10441, 10110, 0, 0, 0/ + 350, 0, .43680, 10441, 112, 0, 0, 0/ + 350, 0, .43720, 10441, 331, 120, -120, 0/ + 350, 0, .43760, 10441, 331, 110, 110, 0/ + 350, 0, .43780, 10441, 220, 120, -120, 0/ + 350, 0, .43800, 10441, 220, 110, 110, 0/ + 350, 0, .43840, 10441, 330, 120, -120, 0/ + 350, 0, .43880, 10441, 330, 110, 110, 0/ + 350, 0, .43920, 10441, 130, -130, 0, 0/ + 350, 0, .43960, 10441, 230, -230, 0, 0/ + 350, 0, .43980, 10441, 120, -120, 0, 0/ + 350, 0, .44000, 10441, 110, 110, 0, 0/ + 350, 0, .44070, 20441, 331, 0, 0, 0/ + 350, 0, .44100, 20441, 220, 0, 0, 0/ + 350, 0, .44150, 20441, 330, 0, 0, 0/ + 350, 0, .44170, 20441, 10110, 0, 0, 0/ + 350, 0, .44190, 20441, 331, 120, -120, 0/ + 350, 0, .44210, 20441, 331, 110, 110, 0/ + 350, 0, .44220, 20441, 220, 120, -120, 0/ + 350, 0, .44230, 20441, 220, 110, 110, 0/ + 350, 0, .44250, 20441, 330, 120, -120, 0/ + 350, 0, .44270, 20441, 330, 110, 110, 0/ + 350, 0, .44290, 20441, 130, -130, 0, 0/ + 350, 0, .44310, 20441, 230, -230, 0, 0/ + 350, 0, .44380, 440, 331, 0, 0, 0/ + 350, 0, .44410, 440, 220, 0, 0, 0/ + 350, 0, .44460, 440, 330, 0, 0, 0/ + 350, 0, .44480, 440, 10110, 0, 0, 0/ + 350, 0, .44500, 440, 331, 120, -120, 0/ + 350, 0, .44520, 440, 331, 110, 110, 0/ + 350, 0, .44530, 440, 220, 120, -120, 0/ + 350, 0, .44540, 440, 220, 110, 110, 0/ + 350, 0, .44560, 440, 330, 120, -120, 0/ + 350, 0, .44580, 440, 330, 110, 110, 0/ + 350, 0, .44600, 440, 130, -130, 0, 0/ + 350, 0, .44620, 440, 230, -230, 0, 0/ + 350, 0, .45120, 341, 120, 0, 0, 0/ + 350, 0, .45500, 340, 120, 0, 0, 0/ + 350, 0, .46800, 340, 121, 0, 0, 0/ + 350, 0, .47800, 341, 121, 0, 0, 0/ + 350, 0, .48000, 340, 120, 110, 0, 0/ + 350, 0, .48200, 341, 120, 110, 0, 0/ + 350, 0, .48400, 240, -230, 120, 0, 0/ + 350, 0, .48600, 241, -230, 120, 0, 0/ + 350, 0, .48800, 140, -130, 120, 0, 0/ + 350, 0, .49000, 141, -130, 120, 0, 0/ + 350, 0, .49450, 340, 10121, 0, 0, 0/ + 350, 0, .49870, 340, 111, 120, 0, 0/ + 350, 0, .50290, 340, 121, 110, 0, 0/ + 350, 0, .50590, 340, -120, 120, 120, 0/ + 350, 0, .50790, 340, 110, 110, 120, 0/ + 350, 0, .51240, 341, 10121, 0, 0, 0/ + 350, 0, .51660, 341, 111, 120, 0, 0/ + 350, 0, .52080, 341, 121, 110, 0, 0/ + 350, 0, .52380, 341, 120, 120, 120, 0/ + 350, 0, .52580, 341, 110, 110, 120, 0/ + 350, 0, .72580, 111, 121, -131, 141, 0/ + 350, 0, .92580, 111, -231, 241, 0, 0/ + 350, 0, .94440, -131, 121, 111, 141, 0/ + 350, 0, .96300, -131, 121, 121, 241, 0/ + 350, 0, .98160, -231, 111, 111, 141, 0/ + 350, 0, 1.00000, -231, 111, 121, 241, 0/ + 151, 0, 1.00000, 150, 10, 0, 0, 0/ + 251, 0, 1.00000, 250, 10, 0, 0, 0/ + 351, 0, 1.00000, 350, 10, 0, 0, 0/ + 1230, 0, 1.00000, 2130, 10, 0, 0, 0/ + 1111, 0, 1.00000, 1120, 120, 0, 0, 0/ + 1121, 0, .66670, 1120, 110, 0, 0, 0/ + 1121, 0, 1.00000, 1220, 120, 0, 0, 0/ + 1221, 0, .66670, 1220, 110, 0, 0, 0/ + 1221, 0, 1.00000, 1120, -120, 0, 0, 0/ + 2221, 0, 1.00000, 1220, -120, 0, 0, 0/ + 1131, 0, .88000, 2130, 120, 0, 0, 0/ + 1131, 0, .94000, 1130, 110, 0, 0, 0/ + 1131, 0, 1.00000, 1230, 120, 0, 0, 0/ + 1231, 0, .88000, 2130, 110, 0, 0, 0/ + 1231, 0, .94000, 1130, -120, 0, 0, 0/ + 1231, 0, 1.00000, 2230, 120, 0, 0, 0/ + 2231, 0, .88000, 2130, -120, 0, 0, 0/ + 2231, 0, .94000, 1230, -120, 0, 0, 0/ + 2231, 0, 1.00000, 2230, 110, 0, 0, 0/ + 1331, 0, .66670, 2330, 120, 0, 0, 0/ + 1331, 0, 1.00000, 1330, 110, 0, 0, 0/ + 2331, 0, .66670, 1330, -120, 0, 0, 0/ + 2331, 0, 1.00000, 2330, 110, 0, 0, 0/ + 2140, 3, .01500, 11, -12, 2130, 0, 0/ + 2140, 3, .03000, 13, -14, 2130, 0, 0/ + 2140, 3, .03500, 11, -12, 1230, 0, 0/ + 2140, 3, .04000, 13, -14, 1230, 0, 0/ + 2140, 0, .04500, 11, -12, 1120, -130, 0/ + 2140, 0, .05000, 13, -14, 1120, -130, 0/ + 2140, 0, .05500, 11, -12, 1220, -230, 0/ + 2140, 0, .06000, 13, -14, 1220, -230, 0/ + 2140, 0, .06250, 11, -12, 1121, -130, 0/ + 2140, 0, .06500, 13, -14, 1121, -130, 0/ + 2140, 0, .06750, 11, -12, 1221, -230, 0/ + 2140, 0, .07000, 13, -14, 1221, -230, 0/ + 2140, 0, .09870, 1120, -130, 120, 0, 0/ + 2140, 0, .10730, 1120, -231, 0, 0, 0/ + 2140, 0, .11590, 1111, -130, 0, 0, 0/ + 2140, 0, .14060, 1120, -230, 110, 0, 0/ + 2140, 0, .14490, 1121, -230, 0, 0, 0/ + 2140, 0, .16590, 1120, -230, 0, 0, 0/ + 2140, 0, .18390, 1120, -230, 120, -120, 0/ + 2140, 0, .19090, 2130, 120, 0, 0, 0/ + 2140, 0, .23390, 2130, 120, 110, 0, 0/ + 2140, 0, .26190, 2130, 120, -120, 120, 0/ + 2140, 0, .27690, 2130, 120, 110, 110, 0/ + 2140, 0, .29090, 1230, 120, 0, 0, 0/ + 2140, 0, .34260, 1130, 120, -120, 0, 0/ + 2140, 0, .35120, 1130, 331, 0, 0, 0/ + 2140, 0, .35720, 2330, 130, 120, 0, 0/ + 2140, 0, .54720, 1131, 221, 0, 0, 0/ + 2140, 0, .73720, 1231, 221, 0, 0, 0/ + 2140, 0, .76720, 2130, 130, -230, 0, 0/ + 2140, 0, .81720, 1120, -131, 120, 0, 0/ + 2140, 0, .86720, 1120, -231, 110, 0, 0/ + 2140, 0, .88220, 1220, 110, 131, 0, 0/ + 2140, 0, .89720, 1220, 120, 231, 0, 0/ + 2140, 0, .93220, 1121, -131, 120, 0, 0/ + 2140, 0, .96720, 1121, -231, 110, 0, 0/ + 2140, 0, 1.00000, 1221, -231, 120, 0, 0/ + 1140, 0, 1.00000, 2140, 120, 0, 0, 0/ + 1240, 0, 1.00000, 2140, 110, 0, 0, 0/ + 2240, 0, 1.00000, 2140, -120, 0, 0, 0/ + 1340, 3, .03750, -12, 11, 1330, 0, 0/ + 1340, 3, .07500, -12, 11, 1331, 0, 0/ + 1340, 3, .11250, -14, 13, 1330, 0, 0/ + 1340, 3, .15000, -14, 13, 1331, 0, 0/ + 1340, 0, .19900, 1330, 120, 0, 0, 0/ + 1340, 0, .24800, 1231, -230, 0, 0, 0/ + 1340, 0, .28800, 1330, 120, 0, 0, 0/ + 1340, 0, .32800, 1131, -230, 0, 0, 0/ + 1340, 0, .36800, 1330, 121, 0, 0, 0/ + 1340, 0, .40800, 1130, -230, 0, 0, 0/ + 1340, 0, .44800, 1330, 120, 110, 0, 0/ + 1340, 0, .48800, 2330, 120, 120, 0, 0/ + 1340, 0, .52800, 1130, -130, 120, 0, 0/ + 1340, 0, .56800, 1130, -230, 110, 0, 0/ + 1340, 0, .60800, 1230, -230, 120, 0, 0/ + 1340, 0, .66400, 2130, -230, 120, 110, 0/ + 1340, 0, .72000, 2130, -130, 120, 120, 0/ + 1340, 0, .77600, 1130, -230, 120, 120, 0/ + 1340, 0, .83200, 1130, -230, 110, 110, 0/ + 1340, 0, .88800, 1330, 120, 120, -120, 0/ + 1340, 0, .94400, 1330, 120, 110, 110, 0/ + 1340, 0, 1.00000, 2330, 120, 120, 110, 0/ + 3140, 3, .03750, -12, 11, 1330, 0, 0/ + 3140, 3, .07500, -12, 11, 1331, 0, 0/ + 3140, 3, .11250, -14, 13, 1330, 0, 0/ + 3140, 3, .15000, -14, 13, 1331, 0, 0/ + 3140, 0, .19900, 1330, 120, 0, 0, 0/ + 3140, 0, .24800, 1231, -230, 0, 0, 0/ + 3140, 0, .28800, 1330, 120, 0, 0, 0/ + 3140, 0, .32800, 1131, -230, 0, 0, 0/ + 3140, 0, .36800, 1330, 121, 0, 0, 0/ + 3140, 0, .40800, 1130, -230, 0, 0, 0/ + 3140, 0, .44800, 1330, 120, 110, 0, 0/ + 3140, 0, .48800, 2330, 120, 120, 0, 0/ + 3140, 0, .52800, 1130, -130, 120, 0, 0/ + 3140, 0, .56800, 1130, -230, 110, 0, 0/ + 3140, 0, .60800, 1230, -230, 120, 0, 0/ + 3140, 0, .66400, 2130, -230, 120, 110, 0/ + 3140, 0, .72000, 2130, -130, 120, 120, 0/ + 3140, 0, .77600, 1130, -230, 120, 120, 0/ + 3140, 0, .83200, 1130, -230, 110, 110, 0/ + 3140, 0, .88800, 1330, 120, 120, -120, 0/ + 3140, 0, .94400, 1330, 120, 110, 110, 0/ + 3140, 0, 1.00000, 2330, 120, 120, 110, 0/ + 2340, 3, .03750, -12, 11, 2330, 0, 0/ + 2340, 3, .07500, -12, 11, 2331, 0, 0/ + 2340, 3, .11250, -14, 13, 2330, 0, 0/ + 2340, 3, .15000, -14, 13, 2331, 0, 0/ + 2340, 0, .17500, 2330, 120, 0, 0, 0/ + 2340, 0, .20000, 1330, 110, 0, 0, 0/ + 2340, 0, .22500, 1130, -130, 0, 0, 0/ + 2340, 0, .25000, 1230, -230, 0, 0, 0/ + 2340, 0, .29500, 2331, 120, 0, 0, 0/ + 2340, 0, .34000, 1331, 110, 0, 0, 0/ + 2340, 0, .38500, 1131, -130, 0, 0, 0/ + 2340, 0, .43000, 1231, -230, 0, 0, 0/ + 2340, 0, .47500, 2330, 121, 0, 0, 0/ + 2340, 0, .52000, 1330, 111, 0, 0, 0/ + 2340, 0, .56500, 1130, -131, 0, 0, 0/ + 2340, 0, .61000, 1230, -231, 0, 0, 0/ + 2340, 0, .64900, 2130, -230, 120, -120, 0/ + 2340, 0, .68800, 2130, -230, 110, 110, 0/ + 2340, 0, .72700, 2130, -130, 120, 110, 0/ + 2340, 0, .76600, 1130, -230, -120, 110, 0/ + 2340, 0, .80500, 1130, -130, 120, -120, 0/ + 2340, 0, .84400, 1130, -130, 110, 110, 0/ + 2340, 0, .88300, 1330, 120, -120, 110, 0/ + 2340, 0, .92200, 1330, 110, 110, 110, 0/ + 2340, 0, .96100, 2330, 120, 120, -120, 0/ + 2340, 0, 1.00000, 2330, 120, 110, 110, 0/ + 3240, 3, .03750, -12, 11, 2330, 0, 0/ + 3240, 3, .07500, -12, 11, 2331, 0, 0/ + 3240, 3, .11250, -14, 13, 2330, 0, 0/ + 3240, 3, .15000, -14, 13, 2331, 0, 0/ + 3240, 0, .17500, 2330, 120, 0, 0, 0/ + 3240, 0, .20000, 1330, 110, 0, 0, 0/ + 3240, 0, .22500, 1130, -130, 0, 0, 0/ + 3240, 0, .25000, 1230, -230, 0, 0, 0/ + 3240, 0, .29500, 2331, 120, 0, 0, 0/ + 3240, 0, .34000, 1331, 110, 0, 0, 0/ + 3240, 0, .38500, 1131, -130, 0, 0, 0/ + 3240, 0, .43000, 1231, -230, 0, 0, 0/ + 3240, 0, .47500, 2330, 121, 0, 0, 0/ + 3240, 0, .52000, 1330, 111, 0, 0, 0/ + 3240, 0, .56500, 1130, -131, 0, 0, 0/ + 3240, 0, .61000, 1230, -231, 0, 0, 0/ + 3240, 0, .64900, 2130, -230, 120, -120, 0/ + 3240, 0, .68800, 2130, -230, 110, 110, 0/ + 3240, 0, .72700, 2130, -130, 120, 110, 0/ + 3240, 0, .76600, 1130, -230, -120, 110, 0/ + 3240, 0, .80500, 1130, -130, 120, -120, 0/ + 3240, 0, .84400, 1130, -130, 110, 110, 0/ + 3240, 0, .88300, 1330, 120, -120, 110, 0/ + 3240, 0, .92200, 1330, 110, 110, 110, 0/ + 3240, 0, .96100, 2330, 120, 120, -120, 0/ + 3240, 0, 1.00000, 2330, 120, 110, 110, 0/ + 3340, 3, .07500, -12, 11, 3331, 0, 0/ + 3340, 3, .15000, -14, 13, 3331, 0, 0/ + 3340, 0, .25000, 1330, -230, 0, 0, 0/ + 3340, 0, .31000, 3331, 120, 0, 0, 0/ + 3340, 0, .37000, 1331, -230, 0, 0, 0/ + 3340, 0, .43000, 1330, -231, 0, 0, 0/ + 3340, 0, .49000, 2330, -230, 120, 0, 0/ + 3340, 0, .55000, 1330, -230, 110, 0, 0/ + 3340, 0, .61000, 1330, -130, 120, 0, 0/ + 3340, 0, .67500, 3331, 120, 120, -120, 0/ + 3340, 0, .74000, 3331, 120, 110, 110, 0/ + 3340, 0, .80500, 1330, -230, 120, -120, 0/ + 3340, 0, .87000, 1330, -230, 110, 110, 0/ + 3340, 0, .93500, 2330, -230, 120, 110, 0/ + 3340, 0, 1.00000, 2330, -130, 120, 120, 0/ + 1141, 0, 1.00000, 2140, 120, 0, 0, 0/ + 1241, 0, 1.00000, 2140, 110, 0, 0, 0/ + 2241, 0, 1.00000, 2140, -120, 0, 0, 0/ + 1341, 0, .66670, 2340, 120, 0, 0, 0/ + 1341, 0, 1.00000, 1340, 110, 0, 0, 0/ + 2341, 0, .66670, 1340, -120, 0, 0, 0/ + 2341, 0, 1.00000, 2340, 110, 0, 0, 0/ + 3341, 0, 1.00000, 3340, 110, 0, 0, 0/ + 1150, 3, .06000, 12, -11, 1140, 0, 0/ + 1150, 3, .12000, 12, -11, 1141, 0, 0/ + 1150, 3, .18000, 14, -13, 1140, 0, 0/ + 1150, 3, .24000, 14, -13, 1141, 0, 0/ + 1150, 3, .25500, 16, -15, 1140, 0, 0/ + 1150, 3, .27000, 16, -15, 1141, 0, 0/ + 1150, 0, .28925, 1140, -120, 0, 0, 0/ + 1150, 0, .30850, 1140, -121, 0, 0, 0/ + 1150, 0, .32775, 1141, -120, 0, 0, 0/ + 1150, 0, .34700, 1141, -121, 0, 0, 0/ + 1150, 0, .35775, 1140, 340, 0, 0, 0/ + 1150, 0, .36850, 1140, 341, 0, 0, 0/ + 1150, 0, .37925, 1141, 340, 0, 0, 0/ + 1150, 0, .39000, 1141, 341, 0, 0, 0/ + 1150, 0, .42050, 1140, -120, 110, 0, 0/ + 1150, 0, .45100, 1140, -120, 220, 0, 0/ + 1150, 0, .48150, 1140, -120, 111, 0, 0/ + 1150, 0, .51200, 1140, -120, 221, 0, 0/ + 1150, 0, .54250, 1140, -121, 110, 0, 0/ + 1150, 0, .57300, 1140, -121, 220, 0, 0/ + 1150, 0, .60350, 1140, -121, 111, 0, 0/ + 1150, 0, .63400, 1140, -121, 221, 0, 0/ + 1150, 0, .66450, 1141, -120, 110, 0, 0/ + 1150, 0, .69500, 1141, -120, 220, 0, 0/ + 1150, 0, .72550, 1141, -120, 111, 0, 0/ + 1150, 0, .75600, 1141, -120, 221, 0, 0/ + 1150, 0, .78650, 1141, -121, 110, 0, 0/ + 1150, 0, .81700, 1141, -121, 220, 0, 0/ + 1150, 0, .84750, 1141, -121, 111, 0, 0/ + 1150, 0, .87800, 1141, -121, 221, 0, 0/ + 1150, 0, .89325, 1140, -130, 230, 0, 0/ + 1150, 0, .90850, 1140, -130, 231, 0, 0/ + 1150, 0, .92375, 1140, -131, 230, 0, 0/ + 1150, 0, .93900, 1140, -131, 231, 0, 0/ + 1150, 0, .95425, 1141, -130, 230, 0, 0/ + 1150, 0, .96950, 1141, -130, 231, 0, 0/ + 1150, 0, .98475, 1141, -131, 230, 0, 0/ + 1150, 0, 1.00000, 1141, -131, 231, 0, 0/ + 1250, 3, .06000, 12, -11, 1240, 0, 0/ + 1250, 3, .12000, 12, -11, 1241, 0, 0/ + 1250, 3, .18000, 14, -13, 1240, 0, 0/ + 1250, 3, .24000, 14, -13, 1241, 0, 0/ + 1250, 3, .25500, 16, -15, 1240, 0, 0/ + 1250, 3, .27000, 16, -15, 1241, 0, 0/ + 1250, 0, .28925, 1240, -120, 0, 0, 0/ + 1250, 0, .30850, 1240, -121, 0, 0, 0/ + 1250, 0, .32775, 1241, -120, 0, 0, 0/ + 1250, 0, .34700, 1241, -121, 0, 0, 0/ + 1250, 0, .35775, 1240, 340, 0, 0, 0/ + 1250, 0, .36850, 1240, 341, 0, 0, 0/ + 1250, 0, .37925, 1241, 340, 0, 0, 0/ + 1250, 0, .39000, 1241, 341, 0, 0, 0/ + 1250, 0, .42050, 1240, -120, 110, 0, 0/ + 1250, 0, .45100, 1240, -120, 220, 0, 0/ + 1250, 0, .48150, 1240, -120, 111, 0, 0/ + 1250, 0, .51200, 1240, -120, 221, 0, 0/ + 1250, 0, .54250, 1240, -121, 110, 0, 0/ + 1250, 0, .57300, 1240, -121, 220, 0, 0/ + 1250, 0, .60350, 1240, -121, 111, 0, 0/ + 1250, 0, .63400, 1240, -121, 221, 0, 0/ + 1250, 0, .66450, 1241, -120, 110, 0, 0/ + 1250, 0, .69500, 1241, -120, 220, 0, 0/ + 1250, 0, .72550, 1241, -120, 111, 0, 0/ + 1250, 0, .75600, 1241, -120, 221, 0, 0/ + 1250, 0, .78650, 1241, -121, 110, 0, 0/ + 1250, 0, .81700, 1241, -121, 220, 0, 0/ + 1250, 0, .84750, 1241, -121, 111, 0, 0/ + 1250, 0, .87800, 1241, -121, 221, 0, 0/ + 1250, 0, .89325, 1240, -130, 230, 0, 0/ + 1250, 0, .90850, 1240, -130, 231, 0, 0/ + 1250, 0, .92375, 1240, -131, 230, 0, 0/ + 1250, 0, .93900, 1240, -131, 231, 0, 0/ + 1250, 0, .95425, 1241, -130, 230, 0, 0/ + 1250, 0, .96950, 1241, -130, 231, 0, 0/ + 1250, 0, .98475, 1241, -131, 230, 0, 0/ + 1250, 0, 1.00000, 1241, -131, 231, 0, 0/ + 1350, 3, .06000, 12, -11, 1340, 0, 0/ + 1350, 3, .12000, 12, -11, 1341, 0, 0/ + 1350, 3, .18000, 14, -13, 1340, 0, 0/ + 1350, 3, .24000, 14, -13, 1341, 0, 0/ + 1350, 3, .25500, 16, -15, 1340, 0, 0/ + 1350, 3, .27000, 16, -15, 1341, 0, 0/ + 1350, 0, .28925, 1340, -120, 0, 0, 0/ + 1350, 0, .30850, 1340, -121, 0, 0, 0/ + 1350, 0, .32775, 1341, -120, 0, 0, 0/ + 1350, 0, .34700, 1341, -121, 0, 0, 0/ + 1350, 0, .35775, 1340, 340, 0, 0, 0/ + 1350, 0, .36850, 1340, 341, 0, 0, 0/ + 1350, 0, .37925, 1341, 340, 0, 0, 0/ + 1350, 0, .39000, 1341, 341, 0, 0, 0/ + 1350, 0, .42050, 1340, -120, 110, 0, 0/ + 1350, 0, .45100, 1340, -120, 220, 0, 0/ + 1350, 0, .48150, 1340, -120, 111, 0, 0/ + 1350, 0, .51200, 1340, -120, 221, 0, 0/ + 1350, 0, .54250, 1340, -121, 110, 0, 0/ + 1350, 0, .57300, 1340, -121, 220, 0, 0/ + 1350, 0, .60350, 1340, -121, 111, 0, 0/ + 1350, 0, .63400, 1340, -121, 221, 0, 0/ + 1350, 0, .66450, 1341, -120, 110, 0, 0/ + 1350, 0, .69500, 1341, -120, 220, 0, 0/ + 1350, 0, .72550, 1341, -120, 111, 0, 0/ + 1350, 0, .75600, 1341, -120, 221, 0, 0/ + 1350, 0, .78650, 1341, -121, 110, 0, 0/ + 1350, 0, .81700, 1341, -121, 220, 0, 0/ + 1350, 0, .84750, 1341, -121, 111, 0, 0/ + 1350, 0, .87800, 1341, -121, 221, 0, 0/ + 1350, 0, .89325, 1340, -130, 230, 0, 0/ + 1350, 0, .90850, 1340, -130, 231, 0, 0/ + 1350, 0, .92375, 1340, -131, 230, 0, 0/ + 1350, 0, .93900, 1340, -131, 231, 0, 0/ + 1350, 0, .95425, 1341, -130, 230, 0, 0/ + 1350, 0, .96950, 1341, -130, 231, 0, 0/ + 1350, 0, .98475, 1341, -131, 230, 0, 0/ + 1350, 0, 1.00000, 1341, -131, 231, 0, 0/ + 2150, 3, .06000, 12, -11, 2140, 0, 0/ + 2150, 3, .12000, 12, -11, 1241, 0, 0/ + 2150, 3, .18000, 14, -13, 2140, 0, 0/ + 2150, 3, .24000, 14, -13, 1241, 0, 0/ + 2150, 3, .25500, 16, -15, 2140, 0, 0/ + 2150, 3, .27000, 16, -15, 1241, 0, 0/ + 2150, 0, .28925, 2140, -120, 0, 0, 0/ + 2150, 0, .30850, 2140, -121, 0, 0, 0/ + 2150, 0, .32775, 1241, -120, 0, 0, 0/ + 2150, 0, .34700, 1241, -121, 0, 0, 0/ + 2150, 0, .35775, 2140, 340, 0, 0, 0/ + 2150, 0, .36850, 2140, 341, 0, 0, 0/ + 2150, 0, .37925, 1241, 340, 0, 0, 0/ + 2150, 0, .39000, 1241, 341, 0, 0, 0/ + 2150, 0, .42050, 2140, -120, 110, 0, 0/ + 2150, 0, .45100, 2140, -120, 220, 0, 0/ + 2150, 0, .48150, 2140, -120, 111, 0, 0/ + 2150, 0, .51200, 2140, -120, 221, 0, 0/ + 2150, 0, .54250, 2140, -121, 110, 0, 0/ + 2150, 0, .57300, 2140, -121, 220, 0, 0/ + 2150, 0, .60350, 2140, -121, 111, 0, 0/ + 2150, 0, .63400, 2140, -121, 221, 0, 0/ + 2150, 0, .66450, 1241, -120, 110, 0, 0/ + 2150, 0, .69500, 1241, -120, 220, 0, 0/ + 2150, 0, .72550, 1241, -120, 111, 0, 0/ + 2150, 0, .75600, 1241, -120, 221, 0, 0/ + 2150, 0, .78650, 1241, -121, 110, 0, 0/ + 2150, 0, .81700, 1241, -121, 220, 0, 0/ + 2150, 0, .84750, 1241, -121, 111, 0, 0/ + 2150, 0, .87800, 1241, -121, 221, 0, 0/ + 2150, 0, .89325, 2140, -130, 230, 0, 0/ + 2150, 0, .90850, 2140, -130, 231, 0, 0/ + 2150, 0, .92375, 2140, -131, 230, 0, 0/ + 2150, 0, .93900, 2140, -131, 231, 0, 0/ + 2150, 0, .95425, 1241, -130, 230, 0, 0/ + 2150, 0, .96950, 1241, -130, 231, 0, 0/ + 2150, 0, .98475, 1241, -131, 230, 0, 0/ + 2150, 0, 1.00000, 1241, -131, 231, 0, 0/ + 2250, 3, .06000, 12, -11, 2240, 0, 0/ + 2250, 3, .12000, 12, -11, 2241, 0, 0/ + 2250, 3, .18000, 14, -13, 2240, 0, 0/ + 2250, 3, .24000, 14, -13, 2241, 0, 0/ + 2250, 3, .25500, 16, -15, 2240, 0, 0/ + 2250, 3, .27000, 16, -15, 2241, 0, 0/ + 2250, 0, .28925, 2240, -120, 0, 0, 0/ + 2250, 0, .30850, 2240, -121, 0, 0, 0/ + 2250, 0, .32775, 2241, -120, 0, 0, 0/ + 2250, 0, .34700, 2241, -121, 0, 0, 0/ + 2250, 0, .35775, 2240, 340, 0, 0, 0/ + 2250, 0, .36850, 2240, 341, 0, 0, 0/ + 2250, 0, .37925, 2241, 340, 0, 0, 0/ + 2250, 0, .39000, 2241, 341, 0, 0, 0/ + 2250, 0, .42050, 2240, -120, 110, 0, 0/ + 2250, 0, .45100, 2240, -120, 220, 0, 0/ + 2250, 0, .48150, 2240, -120, 111, 0, 0/ + 2250, 0, .51200, 2240, -120, 221, 0, 0/ + 2250, 0, .54250, 2240, -121, 110, 0, 0/ + 2250, 0, .57300, 2240, -121, 220, 0, 0/ + 2250, 0, .60350, 2240, -121, 111, 0, 0/ + 2250, 0, .63400, 2240, -121, 221, 0, 0/ + 2250, 0, .66450, 2241, -120, 110, 0, 0/ + 2250, 0, .69500, 2241, -120, 220, 0, 0/ + 2250, 0, .72550, 2241, -120, 111, 0, 0/ + 2250, 0, .75600, 2241, -120, 221, 0, 0/ + 2250, 0, .78650, 2241, -121, 110, 0, 0/ + 2250, 0, .81700, 2241, -121, 220, 0, 0/ + 2250, 0, .84750, 2241, -121, 111, 0, 0/ + 2250, 0, .87800, 2241, -121, 221, 0, 0/ + 2250, 0, .89325, 2240, -130, 230, 0, 0/ + 2250, 0, .90850, 2240, -130, 231, 0, 0/ + 2250, 0, .92375, 2240, -131, 230, 0, 0/ + 2250, 0, .93900, 2240, -131, 231, 0, 0/ + 2250, 0, .95425, 2241, -130, 230, 0, 0/ + 2250, 0, .96950, 2241, -130, 231, 0, 0/ + 2250, 0, .98475, 2241, -131, 230, 0, 0/ + 2250, 0, 1.00000, 2241, -131, 231, 0, 0/ + 2350, 3, .06000, 12, -11, 2340, 0, 0/ + 2350, 3, .12000, 12, -11, 2341, 0, 0/ + 2350, 3, .18000, 14, -13, 2340, 0, 0/ + 2350, 3, .24000, 14, -13, 2341, 0, 0/ + 2350, 3, .25500, 16, -15, 2340, 0, 0/ + 2350, 3, .27000, 16, -15, 2341, 0, 0/ + 2350, 0, .28925, 2340, -120, 0, 0, 0/ + 2350, 0, .30850, 2340, -121, 0, 0, 0/ + 2350, 0, .32775, 2341, -120, 0, 0, 0/ + 2350, 0, .34700, 2341, -121, 0, 0, 0/ + 2350, 0, .35775, 2340, 340, 0, 0, 0/ + 2350, 0, .36850, 2340, 341, 0, 0, 0/ + 2350, 0, .37925, 2341, 340, 0, 0, 0/ + 2350, 0, .39000, 2341, 341, 0, 0, 0/ + 2350, 0, .42050, 2340, -120, 110, 0, 0/ + 2350, 0, .45100, 2340, -120, 220, 0, 0/ + 2350, 0, .48150, 2340, -120, 111, 0, 0/ + 2350, 0, .51200, 2340, -120, 221, 0, 0/ + 2350, 0, .54250, 2340, -121, 110, 0, 0/ + 2350, 0, .57300, 2340, -121, 220, 0, 0/ + 2350, 0, .60350, 2340, -121, 111, 0, 0/ + 2350, 0, .63400, 2340, -121, 221, 0, 0/ + 2350, 0, .66450, 2341, -120, 110, 0, 0/ + 2350, 0, .69500, 2341, -120, 220, 0, 0/ + 2350, 0, .72550, 2341, -120, 111, 0, 0/ + 2350, 0, .75600, 2341, -120, 221, 0, 0/ + 2350, 0, .78650, 2341, -121, 110, 0, 0/ + 2350, 0, .81700, 2341, -121, 220, 0, 0/ + 2350, 0, .84750, 2341, -121, 111, 0, 0/ + 2350, 0, .87800, 2341, -121, 221, 0, 0/ + 2350, 0, .89325, 2340, -130, 230, 0, 0/ + 2350, 0, .90850, 2340, -130, 231, 0, 0/ + 2350, 0, .92375, 2340, -131, 230, 0, 0/ + 2350, 0, .93900, 2340, -131, 231, 0, 0/ + 2350, 0, .95425, 2341, -130, 230, 0, 0/ + 2350, 0, .96950, 2341, -130, 231, 0, 0/ + 2350, 0, .98475, 2341, -131, 230, 0, 0/ + 2350, 0, 1.00000, 2341, -131, 231, 0, 0/ + 3150, 3, .06000, 12, -11, 3140, 0, 0/ + 3150, 3, .12000, 12, -11, 1341, 0, 0/ + 3150, 3, .18000, 14, -13, 3140, 0, 0/ + 3150, 3, .24000, 14, -13, 1341, 0, 0/ + 3150, 3, .25500, 16, -15, 3140, 0, 0/ + 3150, 3, .27000, 16, -15, 1341, 0, 0/ + 3150, 0, .28925, 3140, -120, 0, 0, 0/ + 3150, 0, .30850, 3140, -121, 0, 0, 0/ + 3150, 0, .32775, 1341, -120, 0, 0, 0/ + 3150, 0, .34700, 1341, -121, 0, 0, 0/ + 3150, 0, .35775, 3140, 340, 0, 0, 0/ + 3150, 0, .36850, 3140, 341, 0, 0, 0/ + 3150, 0, .37925, 1341, 340, 0, 0, 0/ + 3150, 0, .39000, 1341, 341, 0, 0, 0/ + 3150, 0, .42050, 3140, -120, 110, 0, 0/ + 3150, 0, .45100, 3140, -120, 220, 0, 0/ + 3150, 0, .48150, 3140, -120, 111, 0, 0/ + 3150, 0, .51200, 3140, -120, 221, 0, 0/ + 3150, 0, .54250, 3140, -121, 110, 0, 0/ + 3150, 0, .57300, 3140, -121, 220, 0, 0/ + 3150, 0, .60350, 3140, -121, 111, 0, 0/ + 3150, 0, .63400, 3140, -121, 221, 0, 0/ + 3150, 0, .66450, 1341, -120, 110, 0, 0/ + 3150, 0, .69500, 1341, -120, 220, 0, 0/ + 3150, 0, .72550, 1341, -120, 111, 0, 0/ + 3150, 0, .75600, 1341, -120, 221, 0, 0/ + 3150, 0, .78650, 1341, -121, 110, 0, 0/ + 3150, 0, .81700, 1341, -121, 220, 0, 0/ + 3150, 0, .84750, 1341, -121, 111, 0, 0/ + 3150, 0, .87800, 1341, -121, 221, 0, 0/ + 3150, 0, .89325, 3140, -130, 230, 0, 0/ + 3150, 0, .90850, 3140, -130, 231, 0, 0/ + 3150, 0, .92375, 3140, -131, 230, 0, 0/ + 3150, 0, .93900, 3140, -131, 231, 0, 0/ + 3150, 0, .95425, 1341, -130, 230, 0, 0/ + 3150, 0, .96950, 1341, -130, 231, 0, 0/ + 3150, 0, .98475, 1341, -131, 230, 0, 0/ + 3150, 0, 1.00000, 1341, -131, 231, 0, 0/ + 3250, 0, .06000, 12, -11, 3240, 0, 0/ + 3250, 0, .12000, 12, -11, 2341, 0, 0/ + 3250, 0, .18000, 14, -13, 3240, 0, 0/ + 3250, 0, .24000, 14, -13, 2341, 0, 0/ + 3250, 0, .25500, 16, -15, 3240, 0, 0/ + 3250, 0, .27000, 16, -15, 2341, 0, 0/ + 3250, 0, .28925, 3240, -120, 0, 0, 0/ + 3250, 0, .30850, 3240, -121, 0, 0, 0/ + 3250, 0, .32775, 2341, -120, 0, 0, 0/ + 3250, 0, .34700, 2341, -121, 0, 0, 0/ + 3250, 0, .35775, 3240, 340, 0, 0, 0/ + 3250, 0, .36850, 3240, 341, 0, 0, 0/ + 3250, 0, .37925, 2341, 340, 0, 0, 0/ + 3250, 0, .39000, 2341, 341, 0, 0, 0/ + 3250, 0, .42050, 3240, -120, 110, 0, 0/ + 3250, 0, .45100, 3240, -120, 220, 0, 0/ + 3250, 0, .48150, 3240, -120, 111, 0, 0/ + 3250, 0, .51200, 3240, -120, 221, 0, 0/ + 3250, 0, .54250, 3240, -121, 110, 0, 0/ + 3250, 0, .57300, 3240, -121, 220, 0, 0/ + 3250, 0, .60350, 3240, -121, 111, 0, 0/ + 3250, 0, .63400, 3240, -121, 221, 0, 0/ + 3250, 0, .66450, 2341, -120, 110, 0, 0/ + 3250, 0, .69500, 2341, -120, 220, 0, 0/ + 3250, 0, .72550, 2341, -120, 111, 0, 0/ + 3250, 0, .75600, 2341, -120, 221, 0, 0/ + 3250, 0, .78650, 2341, -121, 110, 0, 0/ + 3250, 0, .81700, 2341, -121, 220, 0, 0/ + 3250, 0, .84750, 2341, -121, 111, 0, 0/ + 3250, 0, .87800, 2341, -121, 221, 0, 0/ + 3250, 0, .89325, 3240, -130, 230, 0, 0/ + 3250, 0, .90850, 3240, -130, 231, 0, 0/ + 3250, 0, .92375, 3240, -131, 230, 0, 0/ + 3250, 0, .93900, 3240, -131, 231, 0, 0/ + 3250, 0, .95425, 2341, -130, 230, 0, 0/ + 3250, 0, .96950, 2341, -130, 231, 0, 0/ + 3250, 0, .98475, 2341, -131, 230, 0, 0/ + 3250, 0, 1.00000, 2341, -131, 231, 0, 0/ + 3350, 3, .06000, 12, -11, 3340, 0, 0/ + 3350, 3, .12000, 12, -11, 3341, 0, 0/ + 3350, 3, .18000, 14, -13, 3340, 0, 0/ + 3350, 3, .24000, 14, -13, 3341, 0, 0/ + 3350, 3, .25500, 16, -15, 3340, 0, 0/ + 3350, 3, .27000, 16, -15, 3341, 0, 0/ + 3350, 0, .28925, 3340, -120, 0, 0, 0/ + 3350, 0, .30850, 3340, -121, 0, 0, 0/ + 3350, 0, .32775, 3341, -120, 0, 0, 0/ + 3350, 0, .34700, 3341, -121, 0, 0, 0/ + 3350, 0, .35775, 3340, 340, 0, 0, 0/ + 3350, 0, .36850, 3340, 341, 0, 0, 0/ + 3350, 0, .37925, 3341, 340, 0, 0, 0/ + 3350, 0, .39000, 3341, 341, 0, 0, 0/ + 3350, 0, .42050, 3340, -120, 110, 0, 0/ + 3350, 0, .45100, 3340, -120, 220, 0, 0/ + 3350, 0, .48150, 3340, -120, 111, 0, 0/ + 3350, 0, .51200, 3340, -120, 221, 0, 0/ + 3350, 0, .54250, 3340, -121, 110, 0, 0/ + 3350, 0, .57300, 3340, -121, 220, 0, 0/ + 3350, 0, .60350, 3340, -121, 111, 0, 0/ + 3350, 0, .63400, 3340, -121, 221, 0, 0/ + 3350, 0, .66450, 3341, -120, 110, 0, 0/ + 3350, 0, .69500, 3341, -120, 220, 0, 0/ + 3350, 0, .72550, 3341, -120, 111, 0, 0/ + 3350, 0, .75600, 3341, -120, 221, 0, 0/ + 3350, 0, .78650, 3341, -121, 110, 0, 0/ + 3350, 0, .81700, 3341, -121, 220, 0, 0/ + 3350, 0, .84750, 3341, -121, 111, 0, 0/ + 3350, 0, .87800, 3341, -121, 221, 0, 0/ + 3350, 0, .89325, 3340, -130, 230, 0, 0/ + 3350, 0, .90850, 3340, -130, 231, 0, 0/ + 3350, 0, .92375, 3340, -131, 230, 0, 0/ + 3350, 0, .93900, 3340, -131, 231, 0, 0/ + 3350, 0, .95425, 3341, -130, 230, 0, 0/ + 3350, 0, .96950, 3341, -130, 231, 0, 0/ + 3350, 0, .98475, 3341, -131, 230, 0, 0/ + 3350, 0, 1.00000, 3341, -131, 231, 0, 0/ + 1151, 0, 1.00000, 1150, 10, 0, 0, 0/ + 1251, 0, 1.00000, 1250, 10, 0, 0, 0/ + 2251, 0, 1.00000, 2250, 10, 0, 0, 0/ + 1351, 0, 1.00000, 1350, 10, 0, 0, 0/ + 2351, 0, 1.00000, 2350, 10, 0, 0, 0/ + 3351, 0, 1.00000, 3350, 10, 0, 0, 0/ + 6, 4, .33330, 1, -2, 5, 0, 0/ + 6, 4, .66660, 4, -3, 5, 0, 0/ + 6, 4, .77770, 11, -12, 5, 0, 0/ + 6, 4, .88880, 13, -14, 5, 0, 0/ + 6, 4, 1.00000, 15, -16, 5, 0, 0/ + 80, 0, .33330, 1, -2, 0, 0, 0/ + 80, 0, .66660, 4, -3, 0, 0, 0/ + 80, 0, .77770, 11, -12, 0, 0, 0/ + 80, 0, .88880, 13, -14, 0, 0, 0/ + 80, 0, 1.00000, 15, -16, 0, 0, 0/ + 90, 0, .11922, 1, -1, 0, 0, 0/ + 90, 0, .27297, 2, -2, 0, 0, 0/ + 90, 0, .42672, 3, -3, 0, 0, 0/ + 90, 0, .54595, 4, -4, 0, 0, 0/ + 90, 0, .69969, 5, -5, 0, 0, 0/ + 90, 0, .76637, 11, -11, 0, 0, 0/ + 90, 0, .79979, 12, -12, 0, 0, 0/ + 90, 0, .86647, 13, -13, 0, 0, 0/ + 90, 0, .89989, 14, -14, 0, 0, 0/ + 90, 0, .96657, 15, -15, 0, 0, 0/ + 90, 0, 1.00000, 16, -16, 0, 0, 0/ + 0/ diff --git a/ISAJET/doc/changes.doc b/ISAJET/doc/changes.doc new file mode 100644 index 00000000000..6e2fe0982bd --- /dev/null +++ b/ISAJET/doc/changes.doc @@ -0,0 +1,423 @@ +\newpage +\section{Changes in Recent Versions} + + This section contains a record of changes in recently released +versions of ISAJET, taken from the memoranda distributed to users. +Note that the released version numbers are not necessarily consecutive. + +\subsection{Version~7.51, May 2000} + + Several improvements in the SUSY RGE's have been made. All +two-loop terms including both gauge and Yukawa couplings and the +contributions from right-handed neutrinos are now included. There is a +new keyword \verb|SSBCSC| to specify a scale other than the GUT scale +for the RGE boundary conditions. + + The process $Z+\gamma$ is now included in \verb|WPAIR|. (This +was omitted because it has no contribution from triple gauge boson +couplings.) + + An incorrect type declaration produced unphysical results for +beamsstrahlung on some computers. This has been fixed. While the bug is +serious for $e^+e^-$ with the \verb|EEBEAM| option, it has no effect on +other processes. Some other minor bugs have also been fixed. + +\subsection{Version~7.47, December 1999} + + There are several improvements in the treatment of +supersymmetry. The Anomaly Mediated SUSY Breaking model of of Randall +and Sundrum and of Gherghetta, Giudice, and Wells (hep-ph/9904378) has +been added. The parameters of the model are a universal scalar mass +$m_0$ at the GUT scale, a gravitino mass $m_{3/2}$, and the usual +$\tan\beta$ and $\sgn\mu$. These are set by the \verb|AMSB| keyword. The +renormalization group equations have been extended to include two-loop +Yukawa terms and right-handed sneutrinos (with default masses above the +Planck scale). The $\tilde\nu_R$ play a role in the evolution for the +inverted hierarchy models of Bagger, Feng, and Polonsky, hep-ph/9905292. +SUSY loop corrections to Yukawa couplings have been incorporated in the +SUSY mass calculations. + + The Helas library of Murayama, Watanabe, and Hagiwara has been +incorporated together with a simple multi-body phase space generator. +This makes it possible to use code generated by MadGraph to produce +multi-body hard scattering processes. As a first example, a \verb|ZJJ| +process that generates $Z + \hbox{2 jets}$ has been added, with the $Z$ +treated as a narrow resonance. Additional processes may be added in +future releases. + + A new \verb|EXTRADIM| process has been added to generate +Kaluza-Klein graviton production in association with a jet or photon in +models with extra dimensions at the TeV scale. The cross sections are +from G.F.Giudice et al., hep-ph/9811291. We thank I. Hinchliffe and L. +Vacavant for providing this. + + A number of bugs have been fixed, including in particular one in +the decay $\widetilde W_i \to \widetilde Z_j \tau \nu$. + +\subsection{Version~7.44, April 1999} + + A serious bug introduced in Version~7.42 that could lead to +matrix elements being stored for the wrong mode has been corrected. +Some sign errors in the matrix elements for gaugino decays have also +been corrected. + +\subsection{Version~7.42, January 1999} + + Beginning with this version, matrix elements are taken into +account in the event generator as well as in the calculation of decay +widths for MSSM three-body decays of the form $\tilde A \to \tilde B f +\bar f$, where $\tilde A$ and $\tilde B$ are gluinos, charginos, or +neutralinos. This is implemented by having ISASUSY save the poles and +their couplings when calculating the decay width and then using these +to reconstruct the matrix element. Other three-body decays may be +included in the future. Decays selected with \verb|FORCE| use the +appropriate matrix elements. + + As part of the changes to implement these matrix elements, the +format of the decay table has changed. It now starts with a header +line; if this does not match the internal version, then a warning is +printed. The decay table now includes an index MELEM that specifies the +matrix element to be used for all processes. This is also used for +\verb|FORCE| decays and is printed on the run listing for them. SUSY +3-body decays have internally generated negative values of MELEM. + + This version also includes both initial state radiation and +beamstrahlung for $e^+e^-$ interactions. For initial state radiation +(bremsstrahlung), if the \verb|EEBREM| keyword is selected, an electron +structure function will be used. For a convolution of both +bremsstrahlung and beamstrahlung, the keyword \verb|EEBEAM| must be +used, with appropriate inputs (see documentation). + +\subsection{Version~7.40, October 1998} + + A new process WHIGGS generates $W^\pm+H$ and $Z+H$ events for +both the Standard Model and SUSY models and also Higgs pair production +for SUSY models. The types and $W$ decay modes are selected with +JETTYPE and WMODE as for WPAIR events. This process is of particular +interest for producing fairly light Higgs bosons at the Tevatron. See +the documentation for more details. + + Some non-minimal GMSB models can be generated using a new +keyword GMSB2. The optional parameters are an extra factor between the +gaugino and scalar masses, shifts in the Higgs masses, a $D$-term +proportional to hypercharge, and independent numbers of messenger +fields for the three gauge groups. The documentation gives more +details and references. + + The default for SUGRA models has been changed to use +$\alpha_s(M_Z)=0.118$, the experimental value. This means that the +couplings do not exactly unify at the GUT scale, presumably because of +the effects of heavy particles. The keyword AL3UNI can be used to +select exact unification, which produces too large a value for +$\alpha_s(M_Z)$. + + A number of three-body slepton decays that occur through +left-right mixing are now included. These are obviously small but +might compete with gravitino decays. In particular, a decay like +$\tilde\mu_R \to \tilde\tau_1 \nu\bar\nu$ might lead to a wrong +momentum measurement in the muon system. So far we have found no case +in which this is probable. + + The new release also includes a separate Unix tar file +\verb|mcpp.tar| containing C++ code to read a standard ISAJET output +file and copy all the information into C++ classes. The tar file +contains makefiles for Software Release Tools, documentation, and +examples as well as the code. + +\subsection{Version~7.37, April 1998} + + Version~7.37 incorporates Gauge Mediated SUSY Breaking models +for the first time. In these models, SUSY is broken in a hidden sector +at a relatively low scale, and the masses of the MSSM fields are then +produced through ordinary gauge interactions with messenger fields. +The parameters of the GMSB model in ISAJET are $M_m$, the messenger +mass scale; $\Lambda_m = F_m/M_m$, where $F_m$ is the SUSY breaking +scale in the messenger sector; $N_5$, the number of messenger fields; +the usual $\tan\beta$ and $\sgn\mu$; and $C_{\rm grav} \ge 1$, a +factor which scales the gravitino mass and hence the lifetime for the +lightest MSSM particle to decay into it. + + GMSB models have a light gravitino $\tilde G$ as the lightest +SUSY particle. The phenomenology of the model depends mainly on the +nature of the next lightest SUSY particle, a $\tilde\chi_1^0$ or a +$\tilde\tau_1$, which changes with the number $N_5$ of messengers. The +phenomenology also depends on the lifetime for the $\tilde\chi_1^0 \to +\tilde G \gamma$ or $\tilde\tau_1 \to \tilde G \tau$ decay; this +lifetime can be short or very long. All the relevant decays are +included except for $\tilde\mu \to \nu \nu \tilde\tau_1$, which is very +suppressed. + + The keyword MGVTNO allows the user to independently input a +gravitino gravitino mass for the MSSM option. This allows studies of +SUGRA (or other types) of models where the gravitino is the LSP. + + Version~7.37 also contains an extension of the SUGRA model +with a variety of non-universal gaugino and sfermion masses and $A$ +terms at the GUT scale. This makes it possible to study, for example, +how well the SUGRA assumptions can be tested. + + Two significant bugs have also been corrected. The decay modes +for $B^*$ mesons were missing from the decay table since Version~7.29 +and have been restored. A sign error in the interference term for +chargino production has been corrected, leading to a larger chargino +pair cross section at the Tevatron. + +\subsection{Version 7.32, November 1997} + + This version makes several corrections in various chargino and +neutralino widths, thus changing the branching ratios for large +$\tan\beta$. For $\tilde\chi_2^0$, for example, the $\tilde\chi_1^0 +b\bar b$ branching ratio is decreased significantly, while the +$\tilde\chi_1^0 \tau^+ \tau^-$ one is increased. Thus the SUGRA +phenomenology for $\tan\beta \sim 30$ is modified substantially. + + The new version also fixes a few bugs, including a possible +numerical precision problem in the Drell-Yan process at high mass and +$q_T$. It also includes a missing routine for the Zebra interface. + +\subsection{Version 7.31, August 1997} + + Version fixes a couple of bugs in Version~7.29. In +particular, the JETTYPE selection did not work correctly for +supersymmetric Higgs bosons, and there was an error in the interactive +interface for MSSM input. Since these could lead to incorrect results, +users should replace the old version. We thank Art Kreymer for finding +these problems. + + Since top quarks decay before they have time to hadronize, +they are now put directly onto the particle list. Top hadrons ($t\bar +u$, $t\bar d$, etc.) no longer appear, and FORCE should be used +directly for the top quark, i.e. +\begin{verbatim} +FORCE +6,11,-12,5/ +\end{verbatim} + + The documentation has been converted to LaTeX. Run either +LaTeX~2.09 or LaTeX~2e three times to resolve all the forward +references. Either US (8.5x11 inch) or A4 size paper can be used. + +\subsection{Version 7.30, July 1997} + + This version fixes a couple of bugs in the previous version. +In particular, the JETTYPE selection did not work correctly for +supersymmetric Higgs bosons, and there was an error in the interactive +interface for MSSM input. Since these could lead to incorrect results, +users should replace the old version. We thank Art Kreymer for finding +these problems. + + Since top quarks decay before they have time to hadronize, +they are now put directly onto the particle list. Top hadrons ($t\bar +u$, $tud$, etc.) no longer appear, and FORCE should be used directly +for the top quark, i.e. +\begin{verbatim} +FORCE +6,11,-12,5/ +\end{verbatim} + + The documentation has been converted to \LaTeX. Run either +\LaTeX~2.09 or \LaTeX~2e three times to resolve all the forward +references. Either US ($8.5\times11$~inch) or A4 size paper can be +used. + +\subsection{Version 7.29, May 1997} + + While the previous version was applicable for large as well as +small $\tan\beta$, it did contain approximations for the 3-body decays +$\tilde g \to t \bar b \tilde W_i$, $\tilde Z_i \to b \bar b \tilde +Z_j, \tau \tau \tilde Z_j$, and $\tilde W_i \to \tau \nu \tilde Z_j$. +The complete tree-level calculations for three body decays of the +gluino, chargino and neutralino, with all Yukawa couplings and +mixings, have now been included (thanks mainly to M. Drees). We have +compared our branching ratios with those calculated by A.~Bartl and +collaborators; the agreement is generally good. + + The decay patterns of gluinos, charginos and neutralinos may +differ from previous expectations if $\tan\beta$ is large. In +particular, decays into $\tau$'s and $b$'s are often enhanced, while +decays into $e$'s and $\mu$'s are reduced. It could be important for +experiments to study new types of signatures, since the cross sections +for conventional signatures may be considerably reduced. + + We have also corrected several bugs, including a fairly +serious one in the selection of jet types for SUSY Higgs. We thank +A.~Kreymer for pointing this out to us. + +\subsection{Version 7.27, January 1997} + + The new version contains substantial improvements in the +treatment of the Minimal Supersymmetric Standard Model (MSSM) and the +SUGRA model. The squarks of the first two generations are no longer +assumed to be degenerate. The mass splittings and all the two-body +decay modes are now correctly calculated for large $\tan\beta$. While +there are still some approximations for three-body modes, ISAJET is +now usable for the whole range $1 \simle \tan\beta \simle M_t/M_b$. The +most interesting new feature for large $\tan\beta$ is that third +generation modes can be strongly enhanced or even completely dominant. + + To accomodate these changes it was necessary to change the +MSSM input parameters. To avoid confusion, the MSSM keywords have +been renamed MSSM[A-C] instead of MSSM[1-3], and the order of the +parameters has been changed. See the input section of the manual for +details. + + Treatment of the MSSM Higgs sector has also been improved. In +the renormalization group equations the Higgs couplings are frozen at +a higher scale, $Q = \sqrt{M(\tilde t_L)M(\tilde t_R)}$. Running +$t$, $b$ and $\tau$ masses evaluated at that scale are used to +reproduce the dominant 2-loop effects. There is some sensitivity to +the choice of $Q$; our choice seems to give fairly stable results over +a wide range of parameters and reasonable agreement with other +calculations. In particular, the resulting light Higgs masses are +significantly lower than those from Version~7.22. + + The default parton distributions have been updated to CTEQ3L. +A bug in the PDFLIB interface and other minor bugs have been fixed. + +\subsection{Version 7.22, July 1996} + + The new version fixes errors in $\tilde b \to \tilde W t$ and in +some $\tilde t$ decays and Higgs decays. It also contains a new decay +table with updated $\tau$, $c$, and $b$ decays, based loosely on the +QQ decay package from CLEO. The updated decays are less detailed than +the full CLEO QQ program but an improvement over what existed before. +The new decays involve a number of additional resonances, including +$f_0(980)$, $a_1(1260)$, $f_2(1270)$, $K_1(1270)$, $K_1^*(1400)$, +$K_2^*(1430)$, $\chi_{c1,2,3}$, and $\psi(2S)$, so users may have to +change their interface routines. + + A number of other small bugs have been corrected. + +\subsection{Version 7.20, June 1996} + + The new version corrects both errors introduced in Version~7.19 +and longstanding errors in the final state QCD shower algorithm. It +also includes the top mass in the cross sections for $g b \to W t$ and +$g t \to Z t$. When the $t$ mass is taken into account, the process $g +t \to W b$ can have a pole in the physical region, so it has been +removed; see the documentation for more discussion. + + Steve Tether recently pointed out to us that the anomalous +dimension for the $q \to q g$ branching used in the final state QCD +branching algorithm was incorrect. In investigating this we found an +additional error, a missing factor of $1/3$ in the $g \to q \bar q$ +branching. The first error produces a small but non-negligible +underestimate of gluon radiation from quarks. The second overestimates +quark pair production from gluons by about a factor of 3. In +particular, this means that backgrounds from heavy quarks $Q$ coming +from $g \to Q \bar Q$ have been overestimated. + + The new version also allows the user to set arbitrary masses +for the $U(1)$ and $SU(2)$ gaugino mases in the MSSM rather than +deriving these from the gluino mass using grand unification. This +could be useful in studying one of the SUSY interpretations of a CDF +$ee\gamma\gamma\etmiss$ event recently suggested by Ambrosanio, Kane, +Kribs, Martin and Mrenna. Note, however, that radiative decay are +{\it not} included, although the user can force them and multiply by +the appropriate branching ratios calculated by Haber and Wyler, +Nucl.{} Phys.{} B323, 267 (1989). No explicit provision for the decay +$\tilde Z_1 \to \tilde G \gamma$ of the lightest zino into a gravitino +or goldstino and a photon has been made, but forcing the decay $\tilde +Z_1 \to \nu\gamma$ has the same effect for any collider detector. + + A number of other minor bugs have also been corrected. + +\subsection{Version 7.16, October 1995} + + The new version includes $e^+e^-$ cross sections for both SUSY +and Standard Model particles with polarized beams. The $e^-$ and $e^+$ +polarizations are specified with a new keyword EPOL. Polarization +appears to be quite useful in studying SUSY particles at an $e^+e^-$ +collider. + + The new release also includes some bug fixes for $pp$ reactions, +so you should upgrade even if you do not plan to use the polarized +$e^+e^-$ cross sections. + +\subsection{Version 7.13, September 1994} + + Version 7.13 of ISAJET fixes a bug that we introduced in the +recently released 7.11 and another bug in $\tilde g \to \tilde q \bar +q$. We felt it was essential to fix these bugs despite the +proliferation of versions. + + The new version includes the cross sections for the $e^+e^-$ +production of squarks, sleptons, gauginos, and Higgs bosons in Minimal +Supersymmetric Standard Model (MSSM) or the minimal supergravity +(SUGRA) model, including the effects of cascade decays. To generate +such events, select the \verb|E+E-| reaction type and either SUGRA or +MSSM, e.g., +\begin{verbatim} +SAMPLE E+E- JOB +300.,50000,10,100/ +E+E- +SUGRA +100,100,0,2,-1/ +TMASS +170,-1,1/ +END +STOP +\end{verbatim} +The effects of spin correlations in the production and decay, e.g., in +$e^+e^- \to \widetilde W_1^+ \widetilde W_1^-$, are not included. + + It should be noted that the Standard Model $e^+e^-$ generator in +ISAJET does not include Bhabba scattering or $W^+W^-$ and $Z^0Z^0$ +production. Also, its hadronization model is cruder than that +available in some other generators. + +\subsection{Version 7.11, September 1994} + + The new version includes the cross sections for the $e^+e^-$ +production of squarks, sleptons, gauginos, and Higgs bosons in Minimal +Supersymmetric Standard Model (MSSM) or the minimal supergravity +(SUGRA) model including the effects of cascade decays. To generate +such events, select the \verb|E+E-| reaction type and either SUGRA or +MSSM, e.g., +\begin{verbatim} +SAMPLE E+E- JOB +300.,50000,10,100/ +E+E- +SUGRA +100,100,0,2,-1/ +TMASS +170,-1,1/ +END +STOP +\end{verbatim} +The effects of spin correlations in the production and decay, e.g., in +$e^+e^- \to \widetilde W_1^+ \widetilde W_1^-$, are not included. + + It should be noted that the Standard Model $e^+e^-$ generator in +ISAJET does not include Bhabba scattering or $W^+W^-$ and $Z^0Z^0$ +production. Also, its hadronization model is cruder than that +available in some other generators. + +\subsection{Version 7.10, July 1994} + + This version adds a new option that solves the renormalization group +equations to calculate the Minimal Supersymmetric Standard Model (MSSM) +parameters in the minimal supergravity (SUGRA) model, assuming only that the +low energy theory has the minimal particle content, that electroweak +symmetry is radiatively broken, and that R-parity is conserved. The minimal +SUGRA model has just four parameters, which are taken to be the common +scalar mass $m_0$, the common gaugino mass $m_{1/2}$, the common trilinear +SUSY breaking term $A_0$, all defined at the GUT scale, and $\tan\beta$; the +sign of $\mu$ must also be given. The renormalization group equations are +solved iteratively using Runge-Kutta integration including the correct +thresholds. This program can be used either alone or as part of the event +generator. In the latter case, the parameters are specified using +\begin{verse} +SUGRA\\ +$m_0$, $m_{1/2}$, $A_0$, $\tan\beta$, $\sgn\mu$ +\end{verse} +While the SUGRA option is less general than the MSSM, it is theoretically +attractive and provides a much more managable parameter space. + + In addition there have been a number of improvements and bug fixes. An +occasional infinite loop in the minimum bias generator has been fixed. A few +SUSY cross sections and decay modes and the JETTYPE flags for SUSY +particles have been corrected. The treatment of $B$ baryons has been +improved somewhat. + +\end{document} diff --git a/ISAJET/doc/decay.doc b/ISAJET/doc/decay.doc new file mode 100644 index 00000000000..2226df58f72 --- /dev/null +++ b/ISAJET/doc/decay.doc @@ -0,0 +1,50 @@ +\newpage +\section{Decay Table\label{DECAY}} + + ISAJET uses an external table of decay modes. Particles can be +put into the table in arbitrary order, but all modes for each particle +must be grouped together. The table is rewound and read in before each +run with a READ* format. Beginning with Version 7.41, the decay table +must begin with a comment of the form +\begin{verbatim} +' ISAJET V7.41 11-JAN-1999 20:41:57' +\end{verbatim} +If this does not match the internal version number, a warning is +printed. After this initial line, each entry must have the form +\begin{verbatim} +IDENT,MELEM,CBR,ID1,ID2,ID3,ID4,ID5/ +\end{verbatim} +where IDENT is the code for the parent particle, MELEM specifies the +decay matrix element, CBR is the cumulative branching ratio, and +ID1,\dots,ID5 are the IDENT codes for the decay products. The +currently defined values of MELEM are: +\begin{center} +\begin{tabular}{cl} +\hline +MELEM &\quad Matrix Element \\ +\hline +0 &\quad Phase Space \\ +1 &\quad Dalitz decay \\ +2 &\quad $\omega/\phi$ decay \\ +3 &\quad $V-A$ decay \\ +4 &\quad top decay: $V-A$ plus $W$ propagator \\ +5 &\quad $\tau \to \ell \nu \bar \nu$ \\ +6 &\quad $\tau \to \nu \pi$, $\nu K$ \\ +7 &\quad $\tau \to \nu \rho$, $\nu a_1$ \\ +\hline +\end{tabular} +\end{center} +The parent IDENT must be positive; the charge conjugate mode is used +for the antiparticle. The values of CBR must of course be positive and +monotonically increasing for each mode, with the last value being 1.00 +for each parent IDENT. The last parent IDENT code must be zero. Care +should be taken in adding new modes, since there is no checking for +validity. In some cases order is important; note in particular that +quarks and gluons must always appear last so that they can be removed +and fragmented into hadrons. + + The format of the decay table for Versions 7.41 and later is +incompatible with that for Versions 7.40 and earlier. Using an +obsolete decay table will produce incorrect results. + + The decay table is contained in patch ISADECAY. diff --git a/ISAJET/doc/higher.doc b/ISAJET/doc/higher.doc new file mode 100644 index 00000000000..9896ec3ac29 --- /dev/null +++ b/ISAJET/doc/higher.doc @@ -0,0 +1,189 @@ +\newpage +\section{Higher Order Processes\label{HIGHER}} + + Higher order processes can be generated either by the QCD +evolution or by supplying partons from an external generator. + + Frequently it is interesting to generate higher-order processes +with a particular branching in the QCD evolution or with a particular +particle or group of particles being produced from the fragmentation. +Examples include +\begin{enumerate} +\item Branching of jets into heavy quarks (e.g., $g \to b + \bar b$); +\item Decay of such a heavy quark into a lepton or neutrino; +\item Radiation of a photon, $W$, or $Z$ from a jet. +\end{enumerate} +It is important to realize that all of the cross sections and the QCD +evolution in ISAJET are based on leading-log QCD, so generating such +processes does not give the correct higher order QCD cross sections or +``K factors'', even though it may produce better agreement with them in +some cases. + + ISAJET does produce events with particular topologies which +in many cases are the most important effect of higher order processes. +In the heavy quark example, the lowest order process +$$ +g + g \to Q + \bar Q +$$ +produces back-to-back heavy quark pairs, whereas the splitting process +$$ +g + g \to g + g, \quad g \to Q + \bar Q +$$ +produces collinear pairs. Such collinear pairs are essential to obtain +agreement with experimental data on $b \bar b$ production, and they +often are the dominant background for processes of interest. + + Branchings such as the emission of a heavy quark pair, a photon, +or a $W^\pm$ or $Z^0$ are rare, and since they may occur at any step +in the evolution, one cannot force them to occur. Therefore, +generation of such events is very slow. M. Della Negra (UA1) suggested +first doing $n_1$ QCD evolutions for each hard scattering and +rejecting events without the desired partons, then doing $n_2$ +fragmentations for each successful evolution. This generates the +equivalent of $n_1 n_2$ events for each hard scattering, so the cross +section must be divided by $n_1 n_2$. This algorithm can speed up the +generation of $g \to b + \bar b$ splitting by a factor of ten for $n_1 += n_2 = 10$. + + Since the evolution and fragmentation steps are executed $n_1n_2$ +times even if good events are found, a single hard scattering can lead +to multiple events. This does not change the inclusive cross sections, +but it does mean that the fluctuations may be larger than expected. +Hence it is important to choose the numbers $n_1$ and $n_2$ carefully. + + The following entities are used in ISAJET for generating events +with multiple evolution and fragmentation: + + \verb|NEVENT|: The number of primary hard scatterings to be +generated. Set as usual on the input line with the energy. + + \verb|SIGF|: The cross section for the selected hard +scatterings divided by $n_1 \times n_2$. Hence the correct weight is +SIGF/NEVENT, just as for normal running. (The cross section printed at +the end of a run does not contain this factor.) + + \verb|NEVOLVE|: The number $n_1$ of evolutions per hard +scattering. This should never be set unless you supply a REJJET +function. Do not confuse this with NOEVOLVE. + + \verb|NHADRON|: The number $n_2$ of fragmentations for a given +evolution. This should never be set unless you supply a REJFRG +function. Do not confuse this with NOHADRON. + + \verb|REJJET|: A logical function which if true causes the +evolution to be rejected. The user must supply one to make the +selections which he wants. The default always .FALSE. but includes an +example as a comment. + + \verb|REJFRG|: A logical function which if true causes the +fragmentation to be rejected. The user must supply one to make the +selections which he wants. The default always .FALSE. but includes an +example as a comment. + +\noindent Note that one can also use function EDIT to make a final +selection of the events. Of course ISAJET must be relinked if EDIT, +REJJET or REJFRG is modified. + + At the end of a run, the jet cross section, the cross section for +the selected events, and the number and fraction of events selected are +printed. The cross section SIGF stored internally is divided by $n_1 +\times n_2$ so that if the events are used to make histograms, then +the correct weight per event is +\begin{verbatim} + SIGF/NEVENT +\end{verbatim} +just as for normal events. Of course NEVENT now has a different meaning; +it is in general larger than the number of events in the file but might +be smaller if NEVOLVE and NHADRON are badly chosen. + + NEVOLVE and NHADRON are set as parameters in the input. One wants +to choose them to give better acceptance of the primary hard scatterings +but not to give multiple events for one hard scattering. For lepton +production from heavy quarks the values +\begin{verbatim} +NEVOLVE +10/ +NHADRON +10/ +\end{verbatim} +seem appropriate, giving reasonable efficiency. For radiation of photons +from jets, NEVOLVE can be somewhat larger but NHADRON should be one, and +REJFRG should always return .FALSE., since the selection is just on the +parton process, not on the hadronization. + + The loops over evolutions and fragmentations are done inside of +subroutine ISAEVT and are always executed the same number of times even +though ISAEVT returns after each generated event. Logical flag OK +signals a good event, and logical flag DONE signals that the run is +finished. If you control the event generation loop yourself, you should +make use of these flags as in the following extract from subroutine +ISAJET: +\begin{verbatim} + ILOOP=0 + 101 CONTINUE + ILOOP=ILOOP+1 + CALL ISAEVT(ILOOP,OK,DONE) + IF(OK) CALL ISAWEV + IF(.NOT.DONE) GO TO 101 +\end{verbatim} +Otherwise you may get the wrong weights. + + It is possible to supply to ISAJET events with partons generated +by some other program that may have more accurate matrix elements for +higher order processes. Because any such calculation must involve +cutoffs ISAJET assumes that the partons were generated imposing some +$R$ cutoff, where $R=\sqrt{\phi^2+\eta^2}$, and some $E_t$ cutoff. +Given that information ISAJET will generate initial state radiation +partons only below the Et cutoff and final state radiation inside the +$R$ cutoff. The external partons can be supplied to ISAJET by calls to +2 subroutines. To initialize ISAJET for externally supplied partons, +use +\begin{verbatim} + CALL INISAP(CMSE,REACTION,BEAMS,WZ,NDCAYS,DCAYS,ETMIN,RCONE,OK) +\end{verbatim} +where the inputs are + +\smallskip\noindent +\begin{tabular}{lcl} + CMSE &=& center of mass energy\\ + REACTION &=& reaction (only TWOJET and DRELLYAN are \\ + && implemented so far)\\ + BEAMS(2) &=& chose 'P ' or 'AP'\\ + ETMIN &=& minimum ET of supplied partons\\ + RCONE &=& minimum cone (R) between supplied partons\\ + WZ &=& option 'W', 'Z', or ' ' no $W$'s or $Z$'s\\ + NDCAYS &=& number of decay options (if 0, assume decay has\\ + && already been done)\\ + DCAYS &=& list of particles W or Z can decay into\\ +\end{tabular} +\smallskip + +\noindent and the output is + +\smallskip\noindent +\begin{tabular}{lcl} + OK &=& TRUE if initialization is possible\\ +\end{tabular} +\smallskip + +\noindent Then for each event use +\begin{verbatim} + CALL IPARTNS(NPRTNS,IDS,PRTNS,IDQ,WEIGHT,WZDK) +\end{verbatim} +where the inputs are + +\smallskip\noindent +\begin{tabular}{lcl} + NPRTNS &=& number of partons, $\le10$\\ + IDS(NPRTNS) &=& ids of final partons\\ + PRTNS(4,NPRTNS) &=& parton 4 vectors\\ + IDQ(2) &=& ids of initial partons\\ + WEIGHT &=& weight\\ + WZDK &=& if true last 2 partons are from W,Z decay\\ +\end{tabular} +\smallskip + + Further QCD radiation is then generated consistent with +ETMIN and RCONE, and the partons are fragmented into hadrons as usual. +If RCONE is set to a value greater than 1.5 no cone restriction is +applied during parton evolution. diff --git a/ISAJET/doc/ident.doc b/ISAJET/doc/ident.doc new file mode 100644 index 00000000000..a17c318cfe1 --- /dev/null +++ b/ISAJET/doc/ident.doc @@ -0,0 +1,447 @@ +\newpage +\section{IDENT Codes\label{IDENT}} + + ISAJET uses a numerical ident code for particle types. Quarks +and leptons are numbered in order of mass: +\begin{verbatim} + UP = 1 NUE = 11 + DN = 2 E- = 12 + ST = 3 NUM = 13 + CH = 4 MU- = 14 + BT = 5 NUT = 15 + TP = 6 TAU- = 16 +\end{verbatim} +with a negative sign for antiparticles. Arbitrary conventions are: +\begin{verbatim} + GL = 9 + GM = 10 + KS = 20 + KL =-20 + W+ = 80 + Z0 = 90 +\end{verbatim} +The supersymmetric particle IDENT codes distinguish between the +partners of left and right handed fermions and include the Higgs +sector of the minimal supersymmetric model: +\begin{verbatim} + UPSSL ... TPSS1 = 21 ... 26 + NUEL ... TAU1- = 31 ... 36 + UPSSR ... TPSS2 = 41 ... 46 + NUER ... TAU2- = 51 ... 56 + GLSS = 29 + Z1SS = 30 Z2SS = 40 + Z3SS = 50 Z4SS = 60 + W1SS+ = 39 W2SS+ = 49 + + HL0 = 82 HH0 = 83 + HA0 = 84 H+ = 86 +\end{verbatim} +Finally, the gravitino and graviton are +\begin{verbatim} + GVSS = 91 GRAV = 92 +\end{verbatim} +The same symbol is used for the graviton and its (possible) Kaluza-Klein +excitations. + + The code for a meson is a compound integer +-JKL, where J.LE.K are +the quarks and L is the spin. The sign is for the J quark. Glueball +IDENT codes have not been selected, but the choice GL=9 clearly allows +990, 9990, etc. Flavor singlet mesons are ordered by mass, +\begin{verbatim} + PI0 = 110 + ETA = 220 + ETAP = 330 + ETAC = 440 +\end{verbatim} +which is natural for the heavy quarks. Similarly, the code for a +baryon is a compound integer +-IJKL formed from the three quarks I,J,K +and a spin label L=0,1. The code for a diquark is +-IJ00. Additional +states are distinguished by a fifth integer, e.g., +\begin{verbatim} + A1+ = 10121 +\end{verbatim} +These and a few J=2 mesons are used in some of the B decays. + + A routine PRTLST is provided to print out a complete list of valid +IDENT codes and associated information. The usage is + CALL PRTLST(LUN, AMY, AMX) +where LUN is the unit number and AMY and AMX are the masses of the Y and +X quarks respectively. This routine should be linked with the ISAJET +library and with ALDATA. + + The complete list of ident codes follows. (Hadrons containing $t$ +quarks are defined but are no longer listed since the $t$ quark is +treated as a particle.) +\begin{verbatim} + IDENT LABEL MASS CHARGE + 1 UP .30000E+00 .67 + -1 UB .30000E+00 -.67 + 2 DN .30000E+00 -.33 + -2 DB .30000E+00 .33 + 3 ST .50000E+00 -.33 + -3 SB .50000E+00 .33 + 4 CH .16000E+01 .67 + -4 CB .16000E+01 -.67 + 5 BT .49000E+01 -.33 + -5 BB .49000E+01 .33 + 6 TP .17500E+03 .67 + -6 TB .17500E+03 -.67 + + 9 GL 0. 0.00 + + 10 GM 0. 0.00 + + 11 NUE 0. 0.00 + -11 ANUE 0. 0.00 + 12 E- .51100E-03 -1.00 + -12 E+ .51100E-03 1.00 + 13 NUM 0. 0.00 + -13 ANUM 0. 0.00 + 14 MU- .10566E+00 -1.00 + -14 MU+ .10566E+00 1.00 + 15 NUT 0. 0.00 + -15 ANUT 0. 0.00 + 16 TAU- .18070E+01 -1.00 + -16 TAU+ .18070E+01 1.00 + + 20 KS .49767E+00 0.00 + -20 KL .49767E+00 0.00 + + 21 UPSSL none 0.67 + -21 UBSSL none -0.67 + 22 DNSSL none -0.33 + -22 DBSSL none 0.33 + 23 STSSL none -0.33 + 23 SBSSL none 0.33 + 24 CHSSL none 0.67 + -24 CBSSL none -0.67 + 25 BTSS1 none -0.33 + -25 BBSS1 none 0.33 + 26 TPSS1 none 0.67 + -26 TBSS1 none -0.67 + + 29 GLSS none 0.00 + 30 Z1SS none 0.00 + + 31 NUEL none 0.00 + -31 ANUEL none 0.00 + 32 EL- none -1.00 + -32 EL+ none +1.00 + 33 NUML none 0.00 + -33 ANUML none 0.00 + 34 MUL- none -1.00 + -34 MUL+ none +1.00 + 35 NUTL none 0.00 + -35 ANUTL none 0.00 + 36 TAU1- none -1.00 + -36 TAU1+ none -1.00 + + 39 W1SS+ none 1.00 + -39 W1SS- none -1.00 + 40 Z2SS none 0.00 + + 41 UPSSR none 0.67 + -41 UBSSR none -0.67 + 42 DNSSR none -0.33 + -42 DBSSR none 0.33 + 43 STSSR none -0.33 + 43 SBSSR none 0.33 + 44 CHSSR none 0.67 + -44 CBSSR none -0.67 + 45 BTSS2 none -0.33 + -45 BBSS2 none 0.33 + 46 TPSS2 none 0.67 + -46 TBSS2 none -0.67 + + 49 W2SS+ none 1.00 + -49 W2SS- none -1.00 + 50 Z3SS none 0.00 + + 51 NUER none 0.00 + -51 ANUER none 0.00 + 52 ER- none -1.00 + -52 ER+ none +1.00 + 53 NUMR none 0.00 + -53 ANUMR none 0.00 + 54 MUR- none -1.00 + -54 MUR+ none +1.00 + 55 NUTR none 0.00 + -55 ANUTR none 0.00 + 56 TAU2- none -1.00 + -56 TAU2+ none -1.00 + 60 Z4SS none 0.00 + + 80 W+ .80200E+02 1.00 + 81 HIGGS .80200E+02 0.00 + 82 HL0 none 0.00 + 83 HH0 none 0.00 + 84 HA0 none 0.00 + 86 H+ none 1.00 + 90 Z0 .91190E+02 0.00 + 91 GVSS 0 0.00 + 92 GRAV 0 0.00 + + + 110 PI0 .13496E+00 0.00 + 120 PI+ .13957E+00 1.00 + -120 PI- .13957E+00 -1.00 + 220 ETA .54745E+00 0.00 + 130 K+ .49367E+00 1.00 + -130 K- .49367E+00 -1.00 + 230 K0 .49767E+00 0.00 + -230 AK0 .49767E+00 0.00 + 330 ETAP .95760E+00 0.00 + 140 AD0 .18645E+01 0.00 + -140 D0 .18645E+01 0.00 + 240 D- .18693E+01 -1.00 + -240 D+ .18693E+01 1.00 + 340 F- .19688E+01 -1.00 + -340 F+ .19688E+01 1.00 + 440 ETAC .29788E+01 0.00 + 150 UB. .51700E+01 1.00 + -150 BU. .51700E+01 -1.00 + 250 DB. .51700E+01 0.00 + -250 BD. .51700E+01 0.00 + 350 SB. .53700E+01 0.00 + -350 BS. .53700E+01 0.00 + 450 CB. .64700E+01 1.00 + -450 BC. .64700E+01 -1.00 + 550 BB. .97700E+01 0.00 + + 111 RHO0 .76810E+00 0.00 + 121 RHO+ .76810E+00 1.00 + -121 RHO- .76810E+00 -1.00 + 221 OMEG .78195E+00 0.00 + 131 K*+ .89159E+00 1.00 + -131 K*- .89159E+00 -1.00 + 231 K*0 .89610E+00 0.00 + -231 AK*0 .89610E+00 0.00 + 331 PHI .10194E+01 0.00 + 141 AD*0 .20071E+01 0.00 + -141 D*0 .20071E+01 0.00 + 241 D*- .20101E+01 -1.00 + -241 D*+ .20101E+01 1.00 + 341 F*- .21103E+01 -1.00 + -341 F*+ .21103E+01 1.00 + 441 JPSI .30969E+01 0.00 + 151 UB* .52100E+01 1.00 + -151 BU* .52100E+01 -1.00 + 251 DB* .52100E+01 0.00 + -251 BD* .52100E+01 0.00 + 351 SB* .54100E+01 0.00 + -351 BS* .54100E+01 0.00 + 451 CB* .65100E+01 1.00 + -451 BC* .65100E+01 -1.00 + 551 UPSL .98100E+01 0.00 + + 112 F2 .12750E+01 0.00 + 132 K2*+ .14254E+01 1.00 + -132 K2*- .14254E+01 -1.00 + 232 K2*0 .14324E+01 0.00 + -232 AK2*0 .14324E+01 0.00 + + 10110 F0 .98000E+00 0.00 + + 10111 A10 .12300E+01 0.00 + 10121 A1+ .12300E+01 1.00 + -10121 A1- .12300E+01 -1.00 + 10131 K1+ .12730E+01 1.00 + -10131 K1- .12730E+01 -1.00 + 10231 K10 .12730E+01 0.00 + -10231 AK10 .12730E+01 0.00 + 30131 K1*+ .14120E+01 1.00 + -30131 K1*- .14120E+01 -1.00 + 30231 K1*0 .14120E+01 0.00 + -30231 AK1*0 .14120E+01 0.00 + + 10441 PSI(2S) .36860E+01 0.00 + + 20440 CHI0 .34151E+01 0.00 + 20441 CHI1 .35105E+01 0.00 + 20442 CHI2 .35662E+01 0.00 + + + 1120 P .93828E+00 1.00 + -1120 AP .93828E+00 -1.00 + 1220 N .93957E+00 0.00 + -1220 AN .93957E+00 0.00 + 1130 S+ .11894E+01 1.00 + -1130 AS- .11894E+01 -1.00 + 1230 S0 .11925E+01 0.00 + -1230 AS0 .11925E+01 0.00 + 2130 L .11156E+01 0.00 + -2130 AL .11156E+01 0.00 + 2230 S- .11974E+01 -1.00 + -2230 AS+ .11974E+01 1.00 + 1330 XI0 .13149E+01 0.00 + -1330 AXI0 .13149E+01 0.00 + 2330 XI- .13213E+01 -1.00 + -2330 AXI+ .13213E+01 1.00 + 1140 SC++ .24527E+01 2.00 + -1140 ASC-- .24527E+01 -2.00 + 1240 SC+ .24529E+01 1.00 + -1240 ASC- .24529E+01 -1.00 + 2140 LC+ .22849E+01 1.00 + -2140 ALC- .22849E+01 -1.00 + 2240 SC0 .24525E+01 0.00 + -2240 ASC0 .24525E+01 0.00 + 1340 USC. .25000E+01 1.00 + -1340 AUSC. .25000E+01 -1.00 + 3140 SUC. .24000E+01 1.00 + -3140 ASUC. .24000E+01 -1.00 + 2340 DSC. .25000E+01 0.00 + -2340 ADSC. .25000E+01 0.00 + 3240 SDC. .24000E+01 0.00 + -3240 ASDC. .24000E+01 0.00 + 3340 SSC. .26000E+01 0.00 + -3340 ASSC. .26000E+01 0.00 + 1440 UCC. .35500E+01 2.00 + -1440 AUCC. .35500E+01 -2.00 + 2440 DCC. .35500E+01 1.00 + -2440 ADCC. .35500E+01 -1.00 + 3440 SCC. .37000E+01 1.00 + -3440 ASCC. .37000E+01 -1.00 + 1150 UUB. .54700E+01 1.00 + -1150 AUUB. .54700E+01 -1.00 + 1250 UDB. .54700E+01 0.00 + -1250 AUDB. .54700E+01 0.00 + 2150 DUB. .54700E+01 0.00 + -2150 ADUB. .54700E+01 0.00 + 2250 DDB. .54700E+01 -1.00 + -2250 ADDB. .54700E+01 1.00 + 1350 USB. .56700E+01 0.00 + -1350 AUSB. .56700E+01 0.00 + 3150 SUB. .56700E+01 0.00 + -3150 ASUB. .56700E+01 0.00 + 2350 DSB. .56700E+01 -1.00 + -2350 ADSB. .56700E+01 1.00 + 3250 SDB. .56700E+01 -1.00 + -3250 ASDB. .56700E+01 1.00 + 3350 SSB. .58700E+01 -1.00 + -3350 ASSB. .58700E+01 1.00 + 1450 UCB. .67700E+01 1.00 + -1450 AUCB. .67700E+01 -1.00 + 4150 CUB. .67700E+01 1.00 + -4150 ACUB. .67700E+01 -1.00 + 2450 DCB. .67700E+01 0.00 + -2450 ADCB. .67700E+01 0.00 + 4250 CDB. .67700E+01 0.00 + -4250 ACDB. .67700E+01 0.00 + 3450 SCB. .69700E+01 0.00 + -3450 ASCB. .69700E+01 0.00 + 4350 CSB. .69700E+01 0.00 + -4350 ACSB. .69700E+01 0.00 + 4450 CCB. .80700E+01 1.00 + -4450 ACCB. .80700E+01 -1.00 + 1550 UBB. .10070E+02 0.00 + -1550 AUBB. .10070E+02 0.00 + 2550 DBB. .10070E+02 -1.00 + -2550 ADBB. .10070E+02 1.00 + 3550 SBB. .10270E+02 -1.00 + -3550 ASBB. .10270E+02 1.00 + 4550 CBB. .11370E+02 0.00 + -4550 ACBB. .11370E+02 0.00 + + 1111 DL++ .12320E+01 2.00 + -1111 ADL-- .12320E+01 -2.00 + 1121 DL+ .12320E+01 1.00 + -1121 ADL- .12320E+01 -1.00 + 1221 DL0 .12320E+01 0.00 + -1221 ADL0 .12320E+01 0.00 + 2221 DL- .12320E+01 -1.00 + -2221 ADL+ .12320E+01 1.00 + 1131 S*+ .13823E+01 1.00 + -1131 AS*- .13823E+01 -1.00 + 1231 S*0 .13820E+01 0.00 + -1231 AS*0 .13820E+01 0.00 + 2231 S*- .13875E+01 -1.00 + -2231 AS*+ .13875E+01 1.00 + 1331 XI*0 .15318E+01 0.00 + -1331 AXI*0 .15318E+01 0.00 + 2331 XI*- .15350E+01 -1.00 + -2331 AXI*+ .15350E+01 1.00 + 3331 OM- .16722E+01 -1.00 + -3331 AOM+ .16722E+01 1.00 + 1141 UUC* .26300E+01 2.00 + -1141 AUUC* .26300E+01 -2.00 + 1241 UDC* .26300E+01 1.00 + -1241 AUDC* .26300E+01 -1.00 + 2241 DDC* .26300E+01 0.00 + -2241 ADDC* .26300E+01 0.00 + 1341 USC* .27000E+01 1.00 + -1341 AUSC* .27000E+01 -1.00 + 2341 DSC* .27000E+01 0.00 + -2341 ADSC* .27000E+01 0.00 + 3341 SSC* .28000E+01 0.00 + -3341 ASSC* .28000E+01 0.00 + 1441 UCC* .37500E+01 2.00 + -1441 AUCC* .37500E+01 -2.00 + 2441 DCC* .37500E+01 1.00 + -2441 ADCC* .37500E+01 -1.00 + 3441 SCC* .39000E+01 1.00 + -3441 ASCC* .39000E+01 -1.00 + 4441 CCC* .48000E+01 2.00 + -4441 ACCC* .48000E+01 -2.00 + 1151 UUB* .55100E+01 1.00 + -1151 AUUB* .55100E+01 -1.00 + 1251 UDB* .55100E+01 0.00 + -1251 AUDB* .55100E+01 0.00 + 2251 DDB* .55100E+01 -1.00 + -2251 ADDB* .55100E+01 1.00 + 1351 USB* .57100E+01 0.00 + -1351 AUSB* .57100E+01 0.00 + 2351 DSB* .57100E+01 -1.00 + -2351 ADSB* .57100E+01 1.00 + 3351 SSB* .59100E+01 -1.00 + -3351 ASSB* .59100E+01 1.00 + 1451 UCB* .68100E+01 1.00 + -1451 AUCB* .68100E+01 -1.00 + 2451 DCB* .68100E+01 0.00 + -2451 ADCB* .68100E+01 0.00 + 3451 SCB* .70100E+01 0.00 + -3451 ASCB* .70100E+01 0.00 + 4451 CCB* .81100E+01 1.00 + -4451 ACCB* .81100E+01 -1.00 + 1551 UBB* .10110E+02 0.00 + -1551 AUBB* .10110E+02 0.00 + 2551 DBB* .10110E+02 -1.00 + -2551 ADBB* .10110E+02 1.00 + 3551 SBB* .10310E+02 -1.00 + -3551 ASBB* .10310E+02 1.00 + 4551 CBB* .11410E+02 0.00 + -4551 ACBB* .11410E+02 0.00 + 5551 BBB* .14710E+02 -1.00 + -5551 ABBB* .14710E+02 1.00 + + + 1100 UU0. .60000E+00 0.67 + -1100 AUU0. .60000E+00 -0.67 + 1200 UD0. .60000E+00 0.33 + -1200 AUD0. .60000E+00 -0.33 + 2200 DD0. .60000E+00 -0.67 + -2200 ADD0. .60000E+00 0.67 + 1300 US0. .80000E+00 0.33 + -1300 AUS0. .80000E+00 -0.33 + 2300 DS0. .80000E+00 -0.67 + -2300 ADS0. .80000E+00 0.67 + 3300 SS0. .10000E+01 -0.67 + -3300 ASS0. .10000E+01 0.67 + 1400 UC0. .19000E+01 1.33 + -1400 AUC0. .19000E+01 -1.33 + 2400 DC0. .19000E+01 0.33 + -2400 ADC0. .19000E+01 -0.33 + 3400 SC0. .21000E+01 0.33 + -3400 ASC0. .21000E+01 -0.33 + 4400 CC0. .32000E+01 1.33 + -4400 ACC0. .32000E+01 -1.33 + 1500 UB0. .49000E+01 0.33 + -1500 AUB0. .49000E+01 -0.33 + 2500 DB0. .49000E+01 -0.67 + -2500 ADB0. .49000E+01 0.67 + 3500 SB0. .51000E+01 -0.67 + -3500 ASB0. .51000E+01 0.67 + 4500 CB0. .65000E+01 0.33 + -4500 ACB0. .65000E+01 -0.33 + 5500 BB0. .98000E+01 -0.67 + -5500 ABB0. .98000E+01 0.67 +\end{verbatim} diff --git a/ISAJET/doc/input.doc b/ISAJET/doc/input.doc new file mode 100644 index 00000000000..e367b23e862 --- /dev/null +++ b/ISAJET/doc/input.doc @@ -0,0 +1,777 @@ +\newpage +\section{Input\label{INPUT}} + +\subsection{Input Format} + + ISAJET is controlled by commands read from the specified input +file by subroutine READIN. (In the interactive version, this file is +first created by subroutine DIALOG.) Syntax errors will generate a +message and stop execution. Based on these commands, subroutine LOGIC +will setup limits for all variables and check for inconsistencies. +Several runs with different parameters can be combined into one job. +The required input format is: +\begin{verbatim} +Title +Ecm,Nevent,Nprint,Njump/ +Reaction +(Optional parameters) +END +(Optional additional runs) +STOP +\end{verbatim} +with all lines starting in column 1 and typed in {\it upper} case. These +lines are explained below. + + Title line: Up to 80 characters long. If the first four letters +are STOP, control is returned to main program. If the first four letters +are SAME, the parameters from previous run are used excepting those +which are explicitly changed. + + Ecm line: This line must always be given even if the title is +SAME. It must give the center of mass energy (Ecm) and the number of +events (Nevent) to be generated. One may also specify the number of +events to be printed (Nprint) and the increment (Njump) for printing. +The first event is always printed if Nprint $>$ 0. For example: +\begin{verbatim} +800.,1000,10,100/ +\end{verbatim} +generates 1000 events at $E_{\rm cm} = 800\,\GeV$ and prints 10 +events. The events printed are: 1,100,200,\dots. Note that an event +typically takes several pages of output. This line is read with a list +directed format (READ*). + + After Nprint events have been printed, a single line containing the +run number, the event number, and the random number seed is printed +every Njump events (if Njump is nonzero). This seed can be used to start +a new job with the given event if in the new run NSIGMA is set equal to +zero: +\begin{verbatim} +SEED +value/ +NSIGMA +0/ +\end{verbatim} +In general the same events will only be generated on the same type of +computer. + + Reaction line: This line must be given unless title is SAME, when +it must be omitted. It selects the type of events to be generated. The +present version can generate TWOJET, E+E-, DRELLYAN, MINBIAS, WPAIR, +SUPERSYM, HIGGS, PHOTON, TCOLOR, or WHIGGS events. This line is read +with an A8 format. + +\subsection{Optional Parameters} + + Each optional parameter requires two lines. +The first line is a keyword specifying the parameter and the second +line gives the values for the parameter. The parameters can be given in +any order. Numerical values are read with a list directed format +(READ*), jet and particle types are read with a character format and +must be enclosed in quotes, and logical flags with an L1 format. All +momenta are in GeV and all angles are in radians. + + The parameters can be classified in several groups: +\begin{center} +\begin{tabular}{lllll} +\hline\hline +Jet Limits: & W/H Limits: & Decays: & Constants: & Other: \\ +\hline +JETTYPE1 & HTYPE & FORCE & AMSB & BEAMS \\ +JETTYPE2 & PHIW & FORCE1 & CUTJET & EPOL \\ +JETTYPE3 & QMH & NODECAY & CUTOFF & EEBEAM \\ +MIJLIM & QMW & NOETA & EXTRAD & EEBREM \\ +MTOT & QTW & NOEVOLVE & FRAGMENT & NPOMERON \\ +P & THW & NOFRGMNT & GAUGINO & NSIGMA \\ +PHI & WTYPE & NOGRAV & GMSB & NTRIES \\ +PT & XW & NOPI0 & GMSB2 & PDFLIB \\ +TH & YW & & HMASS & SEED \\ +X & & & HMASSES & STRUC \\ +Y & & & LAMBDA & WFUDGE \\ +WMODE1 & & & MGVTNO & WMMODE \\ +WMODE2 & & & MSSMA & WPMODE \\ + & & & MSSMB & Z0MODE \\ + & & & MSSMC & \\ + & & & MSSMD & \\ + & & & MSSME & \\ + & & & NUSUG1 & \\ + & & & NUSUG2 & \\ + & & & NUSUG3 & \\ + & & & NUSUG4 & \\ + & & & NUSUG5 & \\ + & & & SIGQT & \\ + & & & SIN2W & \\ + & & & SLEPTON & \\ + & & & SQUARK & \\ + & & & SSBCSC & \\ + & & & SUGRA & \\ + & & & SUGRHN & \\ + & & & TCMASS & \\ + & & & TMASS & \\ + & & & WMASS & \\ +\hline\hline +\end{tabular} +\end{center} + + It may be helpful to know that the TWOJET, WPAIR, PHOTON, +SUPERSYM, and WHIGGS processes use the same controlling routines and +so share many of the same variables. In particular, PT limits should +normally be set for these processes, and JETTYPE1 and JETTYPE2 are +used to select the reactions. Similarly, the DRELLYAN, HIGGS, and +TCOLOR processes use the same controlling routines since they all +generate s-channel resonances. The mass limits for these processes are +set by QMW. Normally the QMW limits will surround the $W^\pm$, $Z^0$, +or Higgs mass, but this is not required. (QMH acts like QMW for the +Higgs process.) For historical reasons, JETTYPE1 and JETTYPE2 are used +to select the W decay modes in DRELLYAN, while WMODE1 and WMODE2 select +the W decay modes for WPAIR, HIGGS, and WHIGGS. Also, QTW can be used +to generate DRELLYAN events with non-zero transverse momentum, whereas +HIGGS automatically fixes QTW to be zero. (Of course, non-zero +transverse momentum will be generated by gluon radiation.) + + For example the lines +\begin{verbatim} +P +40.,50.,10.,100./ +\end{verbatim} +would set limits for the momentum of jet 1 between 40 and 50 GeV, and +for jet 2 between 10 and 100 GeV. As another example the lines +\begin{verbatim} +WTYPE +'W+'/ +\end{verbatim} +would specify that for DRELLYAN events only W+ events will be generated. +If for a kinematic variable only the lower limit is specified then that +parameter is fixed to the given value. Thus the lines +\begin{verbatim} +P +40.,,10./ +\end{verbatim} +will fix the momentum for jet 1 to be 40 GeV and for jet 2 to be 10 +GeV. If only the upper limit is specified then the default value is used +for the lower limit. Jet 1 or jet 2 parameters for DRELLYAN events refer +to the W decay products and cannot be fixed. If QTW is fixed to 0, then +standard Drell-Yan events are generated. + + A complete list of keywords and their default values follows. + +\newpage +\begin{center} +\begin{tabular}{lll} +\hline\hline +Keyword & & Explanation \\ +Values & Default values & \\ +\hline +AMSB & & Anomaly-mediated SUSY breaking \\ +$m_0$,$m_{3/2}$,$\tan\beta$,$\sgn\mu$ & none & scalar mass, gravitino mass, \\ + & & VEV ratio, sign \\ + & & \\ +BEAMS & & Initial beams. Allowed are \\ +type$_1$,type$_2$ & 'P','P' & 'P','AP','N','AN'. \\ + & & \\ +CUTJET & & Cutoff mass for QCD jet \\ +$\mu_c$ & 6. & evolution. \\ + & & \\ +CUTOFF & & Cutoff $qt^2=\mu^2Q^\nu$ for \\ +$\mu^2$, $\nu$ & .200,1.0 & DRELLYAN events. \\ + & & \\ +EEBEAM & & impose brem/beamstrahlung \\ +$\sqrt{\hat{s}}_{min}$, $\sqrt{\hat{s}}_{max}$, $\Upsilon$, $\sigma_z$ & +none & min and max subprocess energy, \\ + & & beamstrahlung parameter $\Upsilon$ \\ + & & longitudinal beam size $\sigma_z$ in mm \\ + & & \\ +EEBREM & & impose bremsstrahlung for $e^+e^-$ \\ +$\sqrt{\hat{s}}_{min}$, $\sqrt{\hat{s}}_{max}$ & none & min and max subprocess +energy \\ + & & \\ +EPOL & & Polarization of $e^-$ ($e^+$) beam, \\ +$P_L(e^-),P_L(e^+)$ & 0,0 & $P_L(e)=(n_L-n_R)/(n_L-n_R)$, \\ + & & so that $-1 \le P_L \le 1$ \\ + & & \\ +EXTRAD & & Parameters for EXTRADIM process\\ +$\delta$,$M_D$,UVCUT & None & UVCUT is logical flag \\ + & & \\ +FORCE & & Force decay of particles, \\ +$i,i_1,...,i_5$/ & None & $\pm i \to \pm(i1+...+i5)$. \\ + & & Can call 20 times. \\ + & & See note for $i$ = quark. \\ + & & \\ +FORCE1 & & Force decay $i \to i1+...+i5$. \\ +$i,i_1,...,i_5$/ & None & Can call 40 times. \\ + & & See note for $i$ = quark. \\ + & & \\ +FRAGMENT & & Fragmentation parameters. \\ +$P_{ud}$,\dots & .4,\dots & See also SIGQT, etc. \\ + & & \\ +GAUGINO & & Masses for $\tilde g$, +$\tilde\gamma$, \\ +$m_1$,$m_2$,$m_3,m_4$ & 50,0,100,100 & $\tilde W^+$, and $\tilde Z^0$ \\ +\hline\hline +\end{tabular} +\end{center} + +\newpage +\begin{center} +\begin{tabular}{lll} +\hline\hline +GMSB & & GMSB messenger SUSY breaking, \\ +$\Lambda_m$,$M_m$,$N_5$ & none & mass, number of $5+\bar5$, VEV \\ +$\tan\beta$,$\sgn\mu$,$C_{\rm gr}$ & & ratio, sign, gravitino scale \\ + & & \\ +GMSB2 & & non-minimal GMSB parameters \\ +$\slashchar{R}$,$\delta M_{H_d}^2$,$\delta M_{H_u}^2$,$D_Y(M)$ & 1,0,0,0 & +gaugino mass multiplier \\ +$N_{5_1}$,$N_{5_2}$,$N_{5_3}$ & $N_5$ & Higgs mass shifts, D-term mass$^2$\\ + & & indep. gauge group messengers \\ + & & \\ +HMASS & 0 & Mass for standard Higgs. \\ +$m$ & & \\ + & & \\ +HMASSES & & Higgs meson masses for \\ +$m_1$,\dots,$m_9$ & 0,...,0 & charges 0,0,0,0,0,1,1,2,2. \\ +HTYPE & & One MSSM Higgs type ('HL0', \\ +'HL0'/ or... & none & 'HH0', or 'HA0') \\ + & & \\ +JETTYPE1 & & )Select types for jets: \\ +'GL','UP',... & 'ALL' & )'ALL'; 'GL'; 'QUARKS'='UP', \\ + & & )'UB','DN','DB','ST','SB', \\ +JETTYPE2 & & )'CH','CB','BT','BB','TP', \\ +'GL','UP',... & 'ALL' & )'TB','X','XB','Y','YB'; \\ + & & )'LEPTONS'='E-','E+','MU-', \\ +JETTYPE3 & & )'MU+','TAU-','TAU+'; 'NUS'; \\ +'GL','UP',... & 'ALL' & )'GM','W+','W-','Z0' \\ + & & ) See note for SUSY types. \\ + & & \\ +LAMBDA & & QCD scale \\ +$\Lambda$ & .2 & \\ + & & \\ +MGVTNO & & Gravitino mass -- ignored for \\ +$M_{\rm gravitino}$ & $10^{20}$~GeV & GMSB model \\ + & & \\ +MIJLIM & & Multimet mass limits \\ +$i$,$j$,$M_{\rm min}$,$M_{\rm max}$ & 0,0,$1\,\GeV$,$1\,\GeV$ & \\ + & & \\ +MSSMA & & MSSM parameters -- \\ +$m(\tilde g)$,$\mu$, & Required & Gluino mass, $\mu$, $A$ mass, \\ +$m(A)$,$\tan\beta$ & & $\tan\beta$ \\ + & & \\ +MSSMB & & MSSM 1st generation -- \\ +$m(q_1)$,$m(d_r)$,$m(u_r)$, & Required & Left and right soft squark and \\ +$m(l_1)$,$m(e_r)$ & & slepton masses \\ +\hline\hline +\end{tabular} +\end{center} + +\newpage +\begin{center} +\begin{tabular}{lll} +\hline\hline +MSSMC & & MSSM 3rd generation -- \\ +$m(q_3)$,$m(b_r)$,$m(t_r)$, & Required & Soft squark masses, slepton \\ +$m(l_3)$,$m(\tau_r)$, & & masses, and squark and slepton \\ +$A_t$,$A_b$,$A_\tau$ & & mixings \\ + & & \\ +MSSMD & & MSSM 2nd generation -- \\ +$m(q_2)$,$m(s_r)$,$m(c_r)$, & from MSSMB & Left and right soft squark and \\ +$m(l_2)$,$m(mu_r)$ & & slepton masses \\ + & & \\ +MSSME & & MSSM gaugino masses -- \\ +$M_1$,$M_2$ & MSSMA + GUT & Default is to scale from gluino\\ + & & \\ +MTOT & & Mass range for multiparton \\ +$M_{\rm min}$,$M_{\rm max}$ & None & processes \\ + & & \\ +NODECAY & & Suppress all decays. \\ +TRUE or FALSE & FALSE & \\ + & & \\ +NOETA & & Suppress eta decays. \\ +TRUE or FALSE & FALSE & \\ + +NOEVOLVE & & Suppress QCD evolution and \\ +TRUE or FALSE & FALSE & hadronization. \\ + & & \\ +NOGRAV & & Suppress gravitino decays in \\ +TRUE or FALSE & FALSE & GMSB model \\ + & & \\ +NOHADRON & & Suppress hadronization of \\ +TRUE or FALSE & FALSE & jets and beam jets. \\ + & & \\ +NONUNU & & Suppress $Z^0$ neutrino decays.\\ +TRUE or FALSE & FALSE & \\ + & & \\ +NOPI0 & &Suppress $\pi^0$ decays. \\ +TRUE or FALSE & FALSE & \\ + & & \\ +NPOMERON & & Allow $n_1\dimen1 % #1 is bigger + \rlap{\hbox to \dimen0{\hfil/\hfil}} % so center / in box + #1 % and print #1 + \else % / is bigger + \rlap{\hbox to \dimen1{\hfil$#1$\hfil}} % so center #1 + / % and print / + \fi} % + +% \simge and \simle make the "greater than about" and the "less +% than about" symbols with spacing as relations. +\def\simge{% ``greater than about'' symbol + \mathrel{\rlap{\raise 0.511ex + \hbox{$>$}}{\lower 0.511ex \hbox{$\sim$}}}} +\def\simle{% ``less than about'' symbol + \mathrel{\rlap{\raise 0.511ex + \hbox{$<$}}{\lower 0.511ex \hbox{$\sim$}}}} + +\begin{document} + +\centerline{\Large\bf ISAJET 7.51} +\bigskip +\centerline{\Large\bf A Monte Carlo Event Generator} +\smallskip +\centerline{\Large\bf for $pp$, $\bar pp$, and $e^+e^-$ Reactions} +\bigskip\bigskip +\centerline{\bf Frank E. Paige and Serban D. Protopopescu} +\smallskip +\centerline{Physics Department} +\centerline{Brookhaven National Laboratory} +\centerline{Upton, NY 11973, USA} +\bigskip +\centerline{\bf Howard Baer} +\smallskip +\centerline{Department of Physics} +\centerline{Florida State University} +\centerline{Talahassee, FL 32306} +\bigskip +\centerline{\bf Xerxes Tata} +\centerline{Department of Physics and Astronomy} +\centerline{University of Hawaii} +\centerline{Honolulu, HI 96822} + +\bigskip\bigskip +\tableofcontents + +\newpage +\section{Introduction\label{INTRO}} + + ISAJET is a Monte Carlo program which simulates $pp$, +$\bar pp$ and $e^+e^-$ interactions at high energies. +ISAJET is based on +perturbative QCD plus phenomenological models for parton and beam jet +fragmentation. Events are generated in four distinct steps: +\begin{itemize} +\item A primary hard scattering is generated according to the +appropriate QCD cross section. +\item QCD radiative corrections are added for both the initial and the +final state. +\item Partons are fragmented into hadrons independently, and particles +with lifetimes less than about $10^{-12}$ seconds are decayed. +\item Beam jets are added assuming that these are identical to a +minimum bias event at the remaining energy. +\end{itemize} + + ISAJET incorporates ISASUSY, which evaluates branching ratios for +the minimal supersymmetric extension of the standard model. H.~Baer and +X.~Tata are coauthors of this package, and they have done the original +calculations with various collaborators. See the ISASUSY documentation +in the patch Section~\ref{SUSY}. + + ISAJET is supported for ANSI Fortran and for Cray, DEC Ultrix, +DEC VMS, HP/9000 7xx, IBM VM/CMS 370 and 30xx, IBM AIX RS/6000, Linux, +Silicon Graphics 4D, and Sun computers. The CDC 7600 and ETA 10 +versions are obsolete and are no longer supported. It is written +mainly in ANSI standard FORTRAN 77, but it does contain some +extensions except in the ANSI version. The code is maintained with a +combination of RCS, the Revision Control System, and the Patchy code +management system, which is part of the CERN Library. The original +sources are kept on physgi01.phy.bnl.gov in +\verb|~isajet/isalibrary/RCS|; decks revised in release \verb|n.nn| +are kept in \verb|~isajet/isalibrary/nnn|. ISAJET is supplied to BNL, +CERN, Fermilab, and SLAC; it is also available by anonymous ftp from +\begin{verbatim} +ftp://penguin.phy.bnl.gov/pub/isajet +\end{verbatim} +or by request from the authors. + + Patch ISAPLT contains the skeleton of an HBOOK histogramming +job, a trivial calorimeter simulation, and a jet-finding algorithm. +(The default is HBOOK4; HBOOK3 can be selected with a Patchy switch.) +These are provided for convenience only and are not supported. diff --git a/ISAJET/doc/isassdoc.doc b/ISAJET/doc/isassdoc.doc new file mode 100644 index 00000000000..269123ee4a0 --- /dev/null +++ b/ISAJET/doc/isassdoc.doc @@ -0,0 +1,245 @@ +* +* $Id$ +* +* $Log$ +* Revision 1.2 1996/12/04 17:39:53 cernlib +* Version 7.22 from author +* +* +* This directory was created from /afs/cern.ch/user/m/mclareni/isajet/isajet.car patch isassdoc + ISASUSY 7.21 + Decay Modes in the Minimal Supersymmetric Model + + Howard Baer + Florida State University + Talahassee, FL 32306 + + Frank E. Paige + Brookhaven National Laboratory + Upton, NY 11973 + + S.D. Protopopescu + Brookhaven National Laboratory + Upton, NY 11973 + + Xerxes Tata + University of Hawaii + Honolulu, HI 96822 + + + + The code in patch ISASUSY of ISAJET calculates decay modes of +supersymmetric particles based on the work of H. Baer, M. Bisset, D. +Dzialo (Karatas), X. Tata, J. Woodside, and their collaborators. The +calculations assume the minimal supersymmetric extension of the +standard model. Supersymmetric grand unification is assumed by +default in the chargino and neutralino mass matrices, although the +user can override this by specifying arbitrary U(1) and SU(2) gaugino +masses at the weak scale. The squark, left and right slepton and +sneutrino masses are treated as arbitrary. Soft breaking masses are +input for the 3rd generation; mass eigenstates are computed from +these. Most calculations are done at the tree level, but one-loop +results for gluino loop decays, H -> GM GM and H -> GL GL, loop +corrections to the Higgs mass spectrum and couplings, and QCD +corrections to H -> q qbar are included. The Higgs masses have been +calculated using the effective potential approximation including both +top and bottom Yukawa and mixing effects. Mike Bisset and Xerxes Tata +have contributed the Higgs mass, couplings, and decay routines. Note +that e+e- annihilation to SUSY particles and SUSY Higgs bosons have +been included in ISAJET versions >7.11. The following are NOT included +in this version: + + * WH and ZH Higgs production mechanisms in hadronic collisions + + * Large tan(beta) solution (tan(beta)<=10 should be chosen) + + * Non-degenerate 1st and 2nd generation sfermions + +These and other processes may be added in future versions as the physics +interest warrants. Note that the details of the masses and the decay +modes can be quite sensitive to choices of standard model parameters +such as the QCD coupling ALFA3 and the quark masses. To change these, +you must modify subroutine SSMSSM. By default, ALFA3=.12. + + All the mass spectrum and branching ratio calculations in ISASUSY +are performed by the call to + + SUBROUTINE SSMSSM(XM1,XM2,XMG,XMS,XMTL,XMTR,XMLL,XMLR,XMNL + $,XTANB,XMHA,XMU,XMT,XAT,XMBR,XAB,IALLOW) + +where the following are taken to be independent parameters: + + XM1 = U(1) gaugino mass + = computed from XMG if > 1E19 + XM2 = SU(2) gaugino mass + = computed from XMG if > 1E19 + XMG = gluino mass + XMS = common u,d,s,c squark mass + XMTL = left soft breaking stop mass + XMTR = right soft breaking stop mass + XMBR = right soft breaking sbottom mass + XMLL = left slepton mass + XMLR = right slepton mass + XMNL = sneutrino mass + XTANB = tan(beta) = ratio of vev's + = 1/R (of old Baer-Tata notation). + XMU = mu = SUSY Higgs mass + = -2*m_1 of Baer et al. + XMHA = pseudo-scalar Higgs mass + XMT = top quark mass + XAT = stop squark trilinear term + XAB = sbottom squark trilinear term + +The variable IALLOW is returned: + + IALLOW = 1 if Z1SS is not LSP, 0 otherwise + +All variables are of type REAL except IALLOW, which is INTEGER, and all +masses are in GeV. The notation is taken to correspond to that of Haber +and Kane, although the Tata Lagrangian is used internally. All other +standard model parameters are hard wired in this subroutine; they are +not obtained from the rest of ISAJET. The theoretically favored range of +these parameters is + + 50 < M(gluino) < 2000 GeV + 50 < M(squark) < 2000 GeV + 50 < M(slepton) < 2000 GeV + -1000 < mu < 1000 GeV + 1 < tan(beta) < mt/mb + 100 < M(top) < 200 GeV + 50 < M(HA) < 1000 GeV + M(t_l), M(t_r) < M(squark) + M(b_r) ~ M(squark) + -1000 < A_t < 1000 GeV + -1000 < A_b < 1000 GeV + +It is assumed that the lightest supersymmetric particle is the lightest +neutralino Z1. Some choices of the above parameters may violate this +assumption, yielding a light chargino or light stop squark lighter than +Z1SS. In such cases SSMSSM does not compute any branching ratios and +returns IALLOW = 1. + + SSMSSM does not check the parameters or resulting masses against +existing experimental data. SSTEST provides a minimal test. This routine +is called after SSMSSM by ISAJET and ISASUSY and prints suitable warning +messages. + + SSMSSM first calculates the other SUSY masses and mixings and puts +them in the common block /SSPAR/: + +#include "sspar.inc" + +It then calculates the widths and branching ratios and puts them in the +common block /SSMODE/: + +#include "ssmode.inc" + +Decay modes for a given particle are not necessarily adjacent in this +common block. Note that the branching ratio calculations use the full +matrix elements, which in general will give nonuniform distributions in +phase space, but this information is not saved in /SSMODE/. In +particular, the decays H -> Z + Z* -> Z + f + fbar give no indication +that the f + fbar mass is strongly peaked near the upper limit. + + All IDENT codes are defined by parameter statements in the PATCHY +keep sequence SSTYPE: + +#include "sstype.inc" + +These are based on standard ISAJET but can be changed to interface with +other generators. Since masses except the t mass are hard wired, one +should check the kinematics for any decay before using it with possibly +different masses. + + Instead of specifying all the SUSY parameters at the electroweak +scale using the MSSMi commands, one can instead use the SUGRA parameter +to specify in the minimal supergravity framework the common scalar mass +M_0, the common gaugino mass M_(1/2), and the soft trilinear SUSY +breaking parameter A_0 at the GUT scale, the ratio tan(beta) of Higgs +vacuum expectation values at the electroweak scale, and sign(mu), the +sign of the Higgsino mass term. The renormalization group equations are +solved iteratively using Runge-Kutta numerical integration, as follows: + + (1) The RGE's are run from the weak scale M_Z up to the GUT scale, + where alpha_1 = alpha_2, taking all thresholds into account. We use + two loop RGE equations for the gauge couplings only. + + (2) The GUT scale boundary conditions are imposed, and the RGE's + are run back to M_Z, again taking thresholds into account. + + (3) The masses of the SUSY particles and the values of the soft + breaking parameters B and mu needed for radiative symmetry are + computed, e.g. + mu**2(M_Z) = (M_H1**2 - M_H2**2 * tan**2(beta)) + /(tan**2(beta)-1) - M_Z**2/2 + + (4) The 1-loop radiative corrections are computed. + + (5) The process is then interated until stable results are + obtained. + +This is essentially identical to the procedure used by several other +groups. Other possible constraints such as b-tau unification and limits +on proton decay have not been included. + + Patch ISASSRUN of ISAJET provides a main program SSRUN and some +utility programs to produce human readable output. These utilities must +be rewritten if the IDENT codes in /SSTYPE/ are modified. To create the +stand-alone version of ISASUSY with SSRUN, run YPATCHY on isajet.pam +with the following cradle: + +\+USE,*ISASUSY. Select all code +\+USE,NOCERN. No CERN Library +\+USE,IMPNONE. Use IMPLICIT NONE +\+EXE. Write everything to ASM +\+PAM. Read PAM file +\+QUIT. Quit + +Compile, link, and run the resulting program, and follow the prompts for +input. Patch ISASSRUN also contains a main program SUGRUN that reads +the SUGRA parameters, solves the renormalization group equations, and +calculates the masses and branching ratios. To create the stand-alone +version of ISASUGRA, run YPATCHY with the following cradle: + +\+USE,*ISASUGRA. Select all code +\+USE,NOCERN. No CERN Library +\+USE,IMPNONE. Use IMPLICIT NONE +\+EXE. Write everything to ASM +\+PAM. Read PAM file +\+QUIT. Quit + +To produce the documentation, run YPATCHY with the following cradle: + +\+USE,CDESUSY,ISASSDOC +\+EXE +\+PAM +\+QUIT + +This documentation is automatically appended to that for ISAJET. + + ISASUSY is written in ANSI standard Fortran 77 except that +IMPLICIT NONE is used if +USE,IMPNONE is selected in the Patchy cradle. +All variables are explicitly typed, and variables starting with +I,J,K,L,M,N are not necessarily integers. All external names such as +the names of subroutines and common blocks start with the letters SS. +Most calculations are done in double precision. If +USE,NOCERN is +selected in the Patchy cradle, then the Cernlib routines EISRS1 and its +auxiliaries to calculate the eigenvalues of a real symmetric matrix and +DDILOG to calculate the dilogarithm function are included. Hence it is +not necessary to link with Cernlib. + + The physics assumptions and details of incorporating the Minimal +Supersymmetric Model into ISAJET have appeared in a conference +proceedings entitled + + H. Baer, F. Paige, S. Protopopescu and X. Tata, + "Simulating Supersymmetry with ISAJET 7.0/ISASUSY 1.0", + +which has appeared in the proceedings of the workshop on "Physics at +Current Accelerators and Supercolliders", ed. J. Hewett, A. White and +D. Zeppenfeld, (Argonne National Laboratory, 1993). Detailed +references may be found therein. Users wishing to cite an appropriate +source may cite the above report. + + + diff --git a/ISAJET/doc/main.doc b/ISAJET/doc/main.doc new file mode 100644 index 00000000000..ed79dd3a8f9 --- /dev/null +++ b/ISAJET/doc/main.doc @@ -0,0 +1,300 @@ +\newpage +\section{Main Program\label{MAIN}} + + A main program is not supplied with ISAJET. To generate events +and write them to disk, the user should provide a main program which +opens the files and then calls subroutine ISAJET. In the following +sample, i,j,m,n are arbitrary unit numbers. + + Main program for VMS: +\begin{verbatim} + PROGRAM RUNJET +C +C MAIN PROGRAM FOR ISAJET ON BNL VAX CLUSTER. +C + OPEN(UNIT=i,FILE='$2$DUA14:[ISAJET.ISALIBRARY]DECAY.DAT', + $STATUS='OLD',FORM='FORMATTED',READONLY) + OPEN(UNIT=j,FILE='myjob.dat',STATUS='NEW',FORM='UNFORMATTED') + OPEN(UNIT=m,FILE='myjob.par',STATUS='OLD',FORM='FORMATTED') + OPEN(UNIT=n,FILE='myjob.lis',STATUS='NEW',FORM='FORMATTED') +C + CALL ISAJET(+-i,+-j,m,n) +C + STOP + END +\end{verbatim} + + Main program for IBM (VM/CMS) +\begin{verbatim} + PROGRAM RUNJET +C +C MAIN PROGRAM FOR ISAJET ON IBM ASSUMING FILES HAVE BEEN +C OPENED WITH FILEDEF. +C + CALL ISAJET(+-i,+-j,m,n) +C + STOP + END +\end{verbatim} + + Main program for Unix: +\begin{verbatim} + PROGRAM RUNJET +C +C Main program for ISAJET on Unix +C + CHARACTER*60 FNAME +C +C Open user files + READ 1000, FNAME +1000 FORMAT(A) + PRINT 1020, FNAME +1020 FORMAT(1X,'Data file = ',A) + OPEN(2,FILE=FNAME,STATUS='NEW',FORM='UNFORMATTED') + READ 1000, FNAME + PRINT 1030, FNAME +1030 FORMAT(1X,'Parameter file = ',A) + OPEN(3,FILE=FNAME,STATUS='OLD',FORM='FORMATTED') + READ 1000, FNAME + PRINT 1040, FNAME +1040 FORMAT(1X,'Listing file = ',A) + OPEN(4,FILE=FNAME,STATUS='NEW',FORM='FORMATTED') +C Open decay table + READ 1000, FNAME + OPEN(1,FILE=FNAME,STATUS='OLD',FORM='FORMATTED') +C +C Run ISAJET + CALL ISAJET(-1,2,3,4) +C + STOP + END +\end{verbatim} + + The arguments of ISAJET are tape numbers for files, all of which +should be opened by the main program. + + \verb|TAPEi|: Decay table (formatted). A positive sign prints +the decay table on the output listing. A negative sign suppress +printing of the decay table. + + \verb|TAPEj|: Output file for events (unformatted). A positive +sign writes out both resonances and stable particles. A negative sign +writes out only stable particles. + + \verb|TAPEm|: Commands as defined in Section 6 (formatted). + + \verb|TAPEn|: Output listing (formatted). + +\noindent In the sample jobs in Section 3, TAPEm is the default +Fortran input, and TAPEn is the default Fortran output. + +\subsection{Interactive Interface} + + To use the interactive interface, replace the call to ISAJET in +the above main program by +\begin{verbatim} + CALL ISASET(+-i,+-j,m,n) + CALL ISAJET(+-i,+-j,m,n) +\end{verbatim} +ISASET calls DIALOG, which prompts the user for possible commands, +does a limited amount of error checking, and writes a command file on +TAPEm. This command file is rewound for execution by ISAJET. A main +program is included in patch ISARUN to open the necessary files and to +call ISASET and ISAJET. + +\subsection{User Control of Event Loop} + + If the user wishes to integrate ISAJET with another program and +have control over the event generation, he can call the driving +subroutines himself. The driving subroutines are: + + \verb|ISAINI(+-i,+-j,m,n)|: initialize ISAJET. The arguments are +the same as for subroutine ISAJET. + + \verb|ISABEG(IFL)|: begin a run. IFL is a return flag: IFL=0 +for a good set of commands; IFL=1001 for a STOP; any other value means +an error. + + \verb|ISAEVT(I,OK,DONE)| generate event I. Logical flag OK +signifies a good event (almost always .TRUE.); logical flag DONE +signifies the end of a run. + + \verb|ISAEND|: end a run. + +\noindent There are also subroutines provided to write standard ISAJET +records, or Zebra records if the Zebra option is selected: + + \verb|ISAWBG| to write a begin-of-run record, should be called +immediately after ISABEG + + \verb|ISAWEV| to write an event record, should be called +immediately after ISAEVT + + \verb|ISAWND| to write an end-of-run record, should be called +immediately after ISAEND + + The control of the event loop is somewhat complicated to +accomodate multiple evolution and fragmentation as described in +Section 11. Note in particular that after calling ISAEVT one should +process or write out the event only if OK=.TRUE. The check on the DONE +flag is essential if one is doing multiple evolution and +fragmentation. The following example indicates how events might be +generated, analyzed, and discarded (replace \verb|&| by \verb|+| +everywhere): +\begin{verbatim} + PROGRAM SAMPLE +C +&SELF,IF=IMPNONE + IMPLICIT NONE +&SELF +&CDE,ITAPES +&CDE,IDRUN +&CDE,PRIMAR +&CDE,ISLOOP +C + INTEGER JTDKY,JTEVT,JTCOM,JTLIS,IFL,ILOOP + LOGICAL OK,DONE + SAVE ILOOP +C--------------------------------------------------------------------- +C> Open files as above +C> Call user initialization +C--------------------------------------------------------------------- +C +C Initialize ISAJET +C + CALL ISAINI(-i,0,m,n) + 1 IFL=0 + CALL ISABEG(IFL) + IF(IFL.NE.0) STOP +C +C Event loop +C + ILOOP=0 + 101 CONTINUE + ILOOP=ILOOP+1 +C Generate one event - discard if .NOT.OK + CALL ISAEVT(ILOOP,OK,DONE) + IF(OK) THEN +C--------------------------------------------------------------------- +C> Call user analysis for event +C--------------------------------------------------------------------- + ENDIF + IF(.NOT.DONE) GO TO 101 +C +C Calculate cross section and luminosity +C + CALL ISAEND +C--------------------------------------------------------------------- +C> Call user summary +C--------------------------------------------------------------------- + GO TO 1 + END +\end{verbatim} + +\subsection{Multiple Event Streams} + + It may be desirable to generate several different kinds of events +simultaneously to study pileup effects. While normally one would want +to superimpose minimum bias or low-pt jet events on a signal of +interest, other combinations might also be interesting. It would be +very inefficient to reinitialize ISAJET for each event. Therefore, a +pair of subroutines is provided to save and restore the context, i.e. +all of the initialization information, in an array. The syntax is +\begin{verbatim} + CALL CTXOUT(NC,VC,MC) + CALL CTXIN(NC,VC,MC) +\end{verbatim} +where VC is a real array of dimension MC and NC is the number of words +used, about 20000 in the standard case. If NC exceeds MC, a warning is +printed and the job is terminated. The use of these routines is +illustrated in the following example, which opens the files with names +read from the standard input and then superimposes on each event of +the signal sample three events of a pileup sample. It is assumed that +a large number of events is specified in the parameter file for the +pileup sample so that it does not terminate. +\begin{verbatim} + PROGRAM SAMPLE +C +C Example of generating two kinds of events. +C + CHARACTER*60 FNAME + REAL VC1(20000),VC2(20000) + LOGICAL OK1,DONE1,OK2,DONE2 + INTEGER NC1,NC2,IFL,ILOOP,I2,ILOOP2 +C +C Open decay table + READ 1000, FNAME +1000 FORMAT(A) + OPEN(1,FILE=FNAME,STATUS='OLD',FORM='FORMATTED') +C Open user files + READ 1000, FNAME + OPEN(3,FILE=FNAME,STATUS='OLD',FORM='FORMATTED') + READ 1000, FNAME + OPEN(4,FILE=FNAME,STATUS='NEW',FORM='FORMATTED') + READ 1000,FNAME + OPEN(13,FILE=FNAME,STATUS='OLD',FORM='FORMATTED') + READ 1000,FNAME + OPEN(14,FILE=FNAME,STATUS='NEW',FORM='FORMATTED') +C +C Initialize ISAJET + CALL ISAINI(-1,0,3,4) + CALL CTXOUT(NC1,VC1,20000) + CALL ISAINI(-1,0,13,14) + IFL=0 + CALL ISABEG(IFL) + IF(IFL.NE.0) STOP1 + CALL CTXOUT(NC2,VC2,20000) + ILOOP2=0 + CALL user_initialization_routine +C +1 IFL=0 + CALL CTXIN(NC1,VC1,20000) + CALL ISABEG(IFL) + CALL CTXOUT(NC1,VC1,20000) + IF(IFL.NE.0) GO TO 999 + ILOOP=0 +C +C Main event +C +101 CONTINUE + ILOOP=ILOOP+1 + CALL CTXIN(NC1,VC1,20000) + CALL ISAEVT(ILOOP,OK1,DONE1) + CALL CTXOUT(NC1,VC1,20000) + IF(.NOT.OK1) GO TO 101 + CALL user_analysis_routine +C +C Pileup +C + CALL CTXIN(NC2,VC2,20000) + I2=0 +201 CONTINUE + ILOOP2=ILOOP2+1 + CALL ISAEVT(ILOOP2,OK2,DONE2) + IF(OK2) I2=I2+1 + IF(DONE2) STOP2 + CALL user_analysis_routine + IF(I2.LT.3) GO TO 201 + CALL CTXOUT(NC2,VC2,20000) +C + IF(.NOT.DONE1) GO TO 101 +C +C Calculate cross section and luminosity +C + CALL CTXIN(NC1,VC1,20000) + CALL ISAEND + GO TO 1 +C +999 CALL CTXIN(NC2,VC2,20000) + CALL ISAEND + CALL user_termination_routine + STOP + END +\end{verbatim} +It is possible to superimpose arbitrary combinations of events, +including events of the same reaction type with different parameters. +In general the number of events would be selected randomly based on the +cross sections and the luminosity. + + At this time CTXOUT and CTXIN cannot be used with the Zebra +output routines. diff --git a/ISAJET/doc/output.doc b/ISAJET/doc/output.doc new file mode 100644 index 00000000000..736482328f0 --- /dev/null +++ b/ISAJET/doc/output.doc @@ -0,0 +1,328 @@ +\newpage +\section{Output\label{OUTPUT}} + + The output tape or file contains three types of records. A +beginning record is written by a call to ISAWBG before generating a set +of events; an event record is written by a call to ISAWEV for each +event; and an end record is written for each run by a call to ISAWND. +These subroutines load the common blocks described below into a single +\begin{verbatim} +COMMON/ZEVEL/ZEVEL(1024) +\end{verbatim} +and write it out when it is full. A subroutine RDTAPE, described in +the next section, inverts this process so that the user can analyze +the event. + + ZEVEL is written out to TAPEj by a call to BUFOUT. For the CDC +version IF = PAIRPAK is selected; BUFOUT first packs two words from +ZEVEL into one word in +\begin{verbatim} +COMMON/ZVOUT/ZVOUT(512) +\end{verbatim} +using subroutine PAIRPAK and then does a buffer out of ZVOUT to TAPEj. +Typically at least two records are written per event. For all other +computers IF=STDIO is selected, and ZEVEL is written out with a +standard FORTRAN unformatted write. + +\subsection{Beginning Record} + + At the start of each run ISAWBG is called. It writes out the +following common blocks: +\begin{verbatim} +#include "dylim.inc" +\end{verbatim} +\begin{tabular}{lcl} +QMIN,QMAX &=& $W$ mass limits\\ +QTMIN,QTMAX &=& $W$ $q_t$ limits\\ +YWMIN,YWMAX &=& $W$ $\eta$ rapidity limits\\ +XWMIN,XWMAX &=& $W$ $x_F$ limits\\ +THWMIN,THWMAX &=& $W$ $\theta$ limits\\ +PHWMIN,PHWMAX &=& $W$ $\phi$ limits\\ +\end{tabular} + +\begin{verbatim} +#include "idrun.inc" +\end{verbatim} +\begin{tabular}{lcl} +IDVER &=& program version\\ +IDG(1) &=& run date (10000$\times$month+100$\times$day+year)\\ +IDG(2) &=& run time (10000$\times$hour+100$\times$minute+second)\\ +IEVT &=& event number\\ +\end{tabular} + +\begin{verbatim} +#include "jetlim.inc" +\end{verbatim} +\begin{tabular}{lcl} +PMIN,PMAX &=& jet momentum limits\\ +PTMIN,PTMAX &=& jet $p_t$ limits\\ +YJMIN,YJMAX &=& jet $\eta$ rapidity limits\\ +PHIMIN,PHIMAX &=& jet $\phi$ limits\\ +THMIN,THMAX &=& jet $\theta$ limits\\ +\end{tabular} + +\begin{verbatim} +#include "keys.inc" +\end{verbatim} +\begin{tabular}{lcl} +KEYON &=& normally TRUE, FALSE if no good reaction\\ +KEYS &=& TRUE if reaction I is chosen\\ + && 1 for TWOJET\\ + && 2 for E+E-\\ + && 3 for DRELLYAN\\ + && 4 for MINBIAS\\ + && 5 for SUPERSYM\\ + && 6 for WPAIR\\ +REAC &=& character reaction code\\ +\end{tabular} + +\begin{verbatim} +#include "primar.inc" +\end{verbatim} +\begin{tabular}{lcl} +NJET &=& number of jets per event\\ +SCM &=& square of com energy\\ +HALFE &=& beam energy\\ +ECM &=& com energy\\ +IDIN &=& ident code for initial beams\\ +NEVENT &=& number of events to be generated\\ +NTRIES &=& maximum number of tries for good jet parameters\\ +NSIGMA &=& number of extra events to determine SIGF\\ +\end{tabular} + +\begin{verbatim} +#include "q1q2.inc" +\end{verbatim} +\begin{tabular}{lcl} +GOQ(I,K) &=& TRUE if quark type I allowed for jet k\\ + && I = 1 2 3 4 5 6 7 8 9 10 11 12 13\\ + && \ \ $\Rightarrow$ $g$ $u$ $\bar u$ $d$ $\bar d$ $s$ + $\bar s$ $c$ $\bar c$ $b$ $\bar b$ $t$ $\bar t$\\ + && I = 14 15 16 17 18 19 20 21 22 23 24 25\\ + && \ \ $\Rightarrow$ $\nu_e$ $\bar\nu_e$ $e^-$ $e^+$ + $\nu_\mu$ $\bar\nu_\mu$ $\mu^-$ $\mu^+$ $\nu_\tau$ + $\bar\nu_\tau$ $\tau^-$ $\tau^+$\\ +GOALL(K) &=& TRUE if all jet types allowed\\ +GODY(I) &=& TRUE if $W$ type I is allowed.\\ + I= 1 2 3 4\\ + GM W+ W- Z0\\ +STDDY &=& TRUE if standard DRELLYAN\\ +GOWW(I,K) &=& TRUE if I is allowed in the decay of K for WPAIR.\\ +ALLWW(K) &=& TRUE if all allowed in the decay of K for WPAIR.\\ +\end{tabular} + +\begin{verbatim} +#include "qcdpar.inc" +\end{verbatim} +\begin{tabular}{lcl} +ALAM &=& QCD scale $\Lambda$\\ +ALAM2 &=& QCD scale $\Lambda^2$\\ +CUTJET &=& cutoff for generating secondary partons\\ +ISTRUC &=& 3 for Eichten (EHLQ), \\ + &=& 4 for Duke (DO) \\ + &=& 5 for CTEQ 2L\\ + &=& 6 for CTEQ 3L\\ + &=& $-999$ for PDFLIB\\ +\end{tabular} + +\begin{verbatim} +#include "qlmass.inc" +\end{verbatim} +\begin{tabular}{lcl} +AMLEP(6:8) &=& $t$,$y$,$x$ masses, only elements written\\ +\end{tabular} + +\subsection{Event Record} + + For each event ISAWEV is called. It writes out the following +common blocks: +\begin{verbatim} +#include "final.inc" +\end{verbatim} +\begin{tabular}{lcl} +SIGF &=& integrated cross section, only element written\\ +\end{tabular} + +\begin{verbatim} +#include "idrun.inc" +\end{verbatim} +\begin{tabular}{lcl} +IDVER &=& program version\\ +IDG &=& run identification\\ +IEVT &=& event number\\ +\end{tabular} + +\begin{verbatim} +#include "jetpar.inc" +\end{verbatim} +\begin{tabular}{lcl} +P &=& jet momentum $\vert\vec p\vert$\\ +PT &=& jet $p_t$\\ +YJ &=& jet $\eta$ rapidity\\ +PHI &=& jet $\phi$\\ +XJ &=& jet $x_F$\\ +TH &=& jet $\theta$\\ +CTH &=& jet $\cos(\theta)$\\ +STH &=& jet $\sin(\theta)$\\ +JETTYP &=& jet type. The code is listed under /Q1Q2/ above\\ + && {\it continued\dots}\\ +\end{tabular} + +\begin{tabular}{lcl} +SHAT,THAT,UHAT &=& hard scattering $\hat s$, $\hat t$, $\hat u$\\ +QSQ &=& effective $Q^2$\\ +X1,X2 &=& initial parton $x_F$\\ +PBEAM &=& remaining beam momentum\\ +QMW &=& $W$ mass\\ +QW &=& $W$ momentum\\ +QTW &=& $W$ transverse momentum\\ +YW &=& $W$ rapidity\\ +XW &=& $W$ $x_F$\\ +THW &=& $W$ $\theta$\\ +QTMW &=& $\sqrt{q_{t,W}^2+Q^2}$\\ +PHIW &=& $W$ $\phi$\\ +SHAT1,THAT1,UHAT1 &=& invariants for $W$ decay\\ +JWTYP &=& $W$ type. The code is listed under /Q1Q2/ above.\\ +ALFQSQ &=& QCD coupling $\alpha_s(Q^2)$\\ +CTHW &=& $W$ $\cos(\theta)$\\ +STHW &=& $W$ $\sin(\theta)$\\ +Q0W &=& $W$ energy\\ +\end{tabular} + +\begin{verbatim} +#include "jetset.inc" +\end{verbatim} +\begin{tabular}{lcl} +NJSET &=& number of partons\\ +PJSET(1,I) &=& $p_x$ of parton I\\ +PJSET(2,I) &=& $p_y$ of parton I\\ +PJSET(3,I) &=& $p_z$ of parton I\\ +PJSET(4,I) &=& $p_0$ of parton I\\ +PJSET(5,I) &=& mass of parton I\\ +JORIG(I) &=& JPACK*JET+K if I is a decay product of K.\\ + && IF K=0 then I is a primary parton.\\ + && (JET = 1,2,3 for final jets.)\\ + && (JET = 11,12 for initial jets.)\\ +JTYPE(I) &=& IDENT code for parton I\\ +JDCAY(I) &=& JPACK*K1+K2 if K1 and K2 are decay products of I.\\ + && If JDCAY(I)=0 then I is a final parton\\ +MXJSET &=& dimension for /JETSET/ arrays.\\ +JPACK &=& packing integer for /JETSET/ arrays.\\ +\end{tabular} + +\begin{verbatim} +#include "jetsig.inc" +\end{verbatim} +\begin{tabular}{lcl} +SIGMA &=& cross section summed over types\\ +SIGS(I) &=& cross section for reaction I (not written)\\ +NSIGS &=& number of nonzero cross sections (not written)\\ +INOUT(I) &=& packed partons for process I (not written)\\ +MXSIGS &=& dimension for JETSIG arrays (not written)\\ +SIGEVT &=& partial cross section for selected channel\\ +\end{tabular} + +\begin{verbatim} +#include "partcl.inc" +\end{verbatim} +\begin{tabular}{lcl} +NPTCL &=& number of particles\\ +PPTCL(1,I) &=& $p_x$ for particle I\\ +PPTCL(2,I) &=& $p_y$ for particle I\\ +PPTCL(3,I) &=& $p_z$ for particle I\\ +PPTCL(4,I) &=& $p_0$ for particle I\\ +PPTCL(5,I) &=& mass for particle I\\ +IORIG(I) &=& IPACK*JET+K if I is a decay product of K.\\ + &=& -(IPACK*JET+K) if I is a primary particle from\\ + && parton K in /JETSET/.\\ + &=& 0 if I is a primary beam particle.\\ + && (JET = 1,2,3 for final jets.)\\ + && (JET = 11,12 for initial jets.)\\ +IDENT(I) &=& IDENT code for particle I\\ +IDCAY(I) &=& IPACK*K1+K2 if decay products are K1-K2 inclusive.\\ + && If IDCAY(I)=0 then particle I is stable.\\ +MXPTCL &=& dimension for /PARTCL/ arrays.\\ +IPACK &=& packing integer for /PARTCL/ arrays.\\ +\end{tabular} + +\begin{verbatim} +#include "pinits.inc" +\end{verbatim} +\begin{tabular}{lcl} +PINITS(1,I) &=& $p_x$ for initial parton I\\ +PINITS(2,I) &=& $p_y$ for initial parton I\\ +PINITS(3,I) &=& $p_z$ for initial parton I\\ +PINITS(4,I) &=& $p_0$ for initial parton I\\ +PINITS(5,I) &=& mass for initial parton I\\ +IDINIT(I) &=& IDENT for initial parton I\\ +\end{tabular} + +\begin{verbatim} +#include "pjets.inc" +\end{verbatim} +\begin{tabular}{lcl} +PJETS(1,I) &=& $p_x$ for jet I\\ +PJETS(2,I) &=& $p_y$ for jet I\\ +PJETS(3,I) &=& $p_z$ for jet I\\ +PJETS(4,I) &=& $p_0$ for jet I\\ +PJETS(5,I) &=& mass for jet I\\ +IDJETS(I) &=& IDENT code for jet I\\ +QWJET(1) &=& $p_x$ for $W$\\ +QWJET(2) &=& $p_y$ for $W$\\ +QWJET(3) &=& $p_z$ for $W$\\ +QWJET(4) &=& $p_0$ for $W$\\ +QWJET(5) &=& mass for $W$\\ +IDENTW &=& IDENT CODE for $W$\\ +PPAIR(1,I) &=& $p_x$ for WPAIR decay product I\\ +PPAIR(2,I) &=& $p_y$ for WPAIR decay product I\\ +PPAIR(3,I) &=& $p_z$ for WPAIR decay product I\\ +PPAIR(4,I) &=& $p_0$ for WPAIR decay product I\\ +PPAIR(5,I) &=& mass for WPAIR decay product I\\ +IDPAIR(I) &=& IDENT code for WPAIR product I\\ +JPAIR(I) &=& JETTYPE code for WPAIR product I\\ +NPAIR &=& 2 for $W^\pm\gamma$ events, 4 for $WW$ events\\ +\end{tabular} + +\begin{verbatim} +#include "totals.inc" +\end{verbatim} +\begin{tabular}{lcl} +NKINPT &=& number of kinematic points generated.\\ +NWGEN &=& number of W+jet events accepted.\\ +NKEEP &=& number of events kept.\\ +SUMWT &=& sum of weighted cross sections.\\ +WT &=& current weight. (SIGMA$\times$WT = event weight.)\\ +\end{tabular} + +\begin{verbatim} +#include "wsig.inc" +\end{verbatim} +\begin{tabular}{lcl} +SIGLLQ &=& cross section for $W$ decay.\\ +\end{tabular} + + Of course irrelevant common blocks such as /WSIG/ for TWOJET +events are not written out. + +\subsection{End Record} + + At the end of a set ISAWND is called. It writes out the +following common block: +\begin{verbatim} +#include "final.inc" +\end{verbatim} +\begin{tabular}{lcl} +NKINF &=& number of points generated to calculate SIGF\\ +SIGF &=& integrated cross section for this run\\ +ALUM &=& equivalent luminosity for this run\\ +ACCEPT &=& ratio of events kept over events generated\\ +NRECS &=& number of physical records for this run\\ +\end{tabular} + + Events within a given run have uniform weight. Separate runs can +be combined together using SIGF/NEVENT as the weight per event. This +gives a true cross section in mb units. + + The user can replace subroutines ISAWBG, ISAWEV, and ISAWND to +write out the events in a different format or to update histograms +using HBOOK or any similar package. diff --git a/ISAJET/doc/patchy.doc b/ISAJET/doc/patchy.doc new file mode 100644 index 00000000000..401658a2e65 --- /dev/null +++ b/ISAJET/doc/patchy.doc @@ -0,0 +1,275 @@ +\newpage +\section{Patchy and PAM Organization\label{PATCHY}} + + Patchy is a code management system developed at CERN and used to +maintain the CERN Library. It is used to provide versions of ISAJET for +a wide variety of computers. Instructions for using PATCHY are +available from \verb|http://wwwinfo.cern.ch/asdoc/Welcome.html|. + + A master source file in Patchy is called a ``PAM.'' The ISAJET +PAM contains all the source code and documentation plus Patchy +commands to include common blocks and to select the desired version. It +is divided into the following patches: + + \verb|ISACDE|: contains all common blocks, etc. These are divided +into decks based on their usage. + + \verb|ISADATA|: contains block data ALDATA. This must always be +loaded when using ISAJET. + + \verb|ISAJET|: contains the code for generating events. Each +subroutine is in a separate deck with the same name. + + \verb|ISASSRUN|: contains the main program for ISASUSY, which +prompts for input parameters and prints out all the decay modes. It is +selected by \verb|*ISASUSY|. + + \verb|ISASUSY|: contains code to calculate all the decay widths +and branching fractions in the minimal supersymmetric model. + + \verb|ISATAPE|: contains the code for reading and writing tapes, +again with each subroutine on a separate deck. + + \verb|ISARUN|: contains a main program and a simple interactive +interface. It is selected by \verb|IF=INTERACT|. + + \verb|ISAZEB|: contains Zebra format output routines, an +alternative to the ISATAPE routines. + + \verb|ISZRUN|: contains the analog of ISAPLT for the Zebra +format. + + \verb|ISAPLT|: contains a simple calorimeter simulation and the +skeleton of a histogramming job using HBOOK. + + \verb|ISATEXT|: contains the instructions for using ISAJET, i.e. +the text of this document. It also includes the documentation for +ISASUSY. + + \verb|ISZTEXT|: contains the instructions for the Zebra output +routines and a description of the Zebra banks. + + \verb|ISADECAY|: contains the input decay table. + + The code is actually maintained using RCS on a Silicon Graphics +computer at BNL. Patchy is used primarily to handle common blocks and +machine dependent code. + + The input to YPATCHY must contain both \verb|+USE| cards, which +define the wanted program version, and \verb|+EXE| cards, which +determine which patches or decks are written to the ASM file. To +facilitate this selection, the ISAJET PAM contains the following pilot +patches: + + \verb|*ISADECAY|: USE selects ISADECAY and all corrections to it. + + \verb|*ISAJET|: USE selects ISACDE, ISADATA, ISAJET, ISATAPE, +ISARUN and all corrections to them. Note that ISARUN is not actually +selected without \verb|+USE,INTERACT|. + + \verb|*ISAPLT|: USE selects ISACDE, ISAPLT, and all corrections +to them. + + \verb|*ISASUSY|: USE selects CDESUSY, ISASUSY, and ISASSRUN to +create a program to calculate all the MSSM decay modes. + + \verb|*ISATEXT|: USE selects ISACDE, ISATEXT, and all corrections +to them. + + \verb|*ISAZEB|: USE selects ISAJET with a Zebra output format. + + \verb|*ISZRUN|: USE selects the Zebra analysis package. + + Patches are provided to select the machine dependent features for +specific computers or operating systems: + + \verb|ANSI|: ANSI standard Fortran (no time or date functions) + + \verb|APOLLO|: APOLLO -- only tested by CERN + + \verb|CDC|: CDC 7600 and 60-bit CYBER (obsolete) + + \verb|CRAY|: CRAY with UNICOS + + \verb|DECS|: DEC Station with Ultrix + + \verb|ETA|: ETA 10 running Unix System V (obsolete) + + \verb|HPUX|: HP/9000 7xx running Unix System V + + \verb|IBM|: IBM 370 and 30xx running VM/CMS + + \verb|IBMRT|: IBM RS/6000 running AIX 3.x or 4.x + + \verb|LINUX|: PC running Linux with f2c/gcc or g77 compiler + + \verb|SGI|: Silicon Graphics running IRIX + + \verb|SUN|: Sun Sparcstation running SUNOS or Solaris + + \verb|VAX|: DEC VAX or Alpha running VMS + +\noindent These patches in turn select a variety of patches and IF +flags, allowing one to select more specific features, as indicated +below. (Replace \verb|&| by \verb|+| everywhere.) +\begin{verbatim} +&PATCH,ANSI. GENERIC ANSI FORTRAN. +&USE,DOUBLE. DOUBLE PRECISION. +&USE,STDIO. STANDARD FORTRAN 77 TAPE INPUT/OUTPUT. +&USE,MOVEFTN. FORTRAN REPLACEMENT FOR MOVLEV. +&USE,RANFFTN,IF=-CERN. FORTRAN RANF. +&USE,RANFCALL. STANDARD RANSET AND RANGET CALLS. +&USE,NOCERN,IF=-CERN. NO CERN LIBRARY. +&EOD + +&PATCH,APOLLO. +&DECK,BLANKDEK. +&USE,DOUBLE. DOUBLE PRECISION. +&USE,STDIO. STANDARD FORTRAN 77 TAPE INPUT/OUTPUT. +&USE,MOVEFTN. FORTRAN REPLACEMENT FOR MOVLEV. +&USE,RANFFTN,IF=-CERN. FORTRAN RANF. +&USE,RANFCALL. STANDARD RANSET AND RANGET CALLS. +&USE,NOCERN,IF=-CERN. NO CERN LIBRARY. +&USE,IMPNONE. IMPLICIT NONE +&EOD. + +&PATCH,CDC. CDC 7600 OR CYBER 175. +&USE,SINGLE. SINGLE PRECISION. +&USE,LEVEL2. LEVEL 2 STORAGE. +&USE,CDCPACK. PACK 2 WORDS PER WORD FOR INPUT/OUTPUT. +&USE,RANFCALL. STANDARD RANSET AND RANGET CALLS. +&USE,NOCERN,IF=-CERN. NO CERN LIBRARY. +&EOD + +&PATCH,CRAY. CRAY XMP OR 2. +&USE,SINGLE. SINGLE PRECISION. +&USE,STDIO. STANDARD FORTRAN 77 TAPE INPUT/OUTPUT. +&USE,MOVEFTN. FORTRAN REPLACEMENT FOR MOVLEV. +&USE,NOCERN,IF=-CERN. NO CERN LIBRARY. +&EOD + +&PATCH,DECS. DEC STATION (ULTRIX) +&USE,SUN. +&EOD + +&PATCH,ETA. ETA-10. +&USE,SINGLE. SINGLE PRECISION. +&USE,STDIO. STANDARD FORTRAN 77 TAPE INPUT/OUTPUT. +&USE,MOVEFTN. FORTRAN REPLACEMENT FOR MOVLEV. +&USE,RANFCALL. STANDARD RANSET AND RANGET CALLS. +&USE,NOCERN,IF=-CERN. NO CERN LIBRARY. +&EOD + +&PATCH,HPUX. HP/9000 7XX RUNNING UNIX. +&USE,DOUBLE. DOUBLE PRECISION. +&USE,STDIO. STANDARD FORTRAN 77 TAPE INPUT/OUTPUT. +&USE,MOVEFTN. FORTRAN REPLACEMENT FOR MOVLEV. +&USE,RANFFTN,IF=-CERN. FORTRAN RANF. +&USE,RANFCALL. STANDARD RANSET AND RANGET CALLS. +&USE,NOCERN,IF=-CERN. NO CERN LIBRARY. +&USE,IMPNONE. IMPLICIT NONE +&EOD + +&PATCH,IBM. IBM 370 OR 30XX. +&USE,DOUBLE. DOUBLE PRECISION. +&USE,STDIO. STANDARD FORTRAN 77 TAPE INPUT/OUTPUT. +&USE,MOVEFTN. FORTRAN REPLACEMENT FOR MOVLEV. +&USE,RANFFTN,IF=-CERN. FORTRAN RANF. +&USE,RANFCALL. STANDARD RANSET AND RANGET CALLS. +&USE,NOCERN,IF=-CERN. NO CERN LIBRARY. +&EOD + +&PATCH,IBMRT. IBM RS/6000 WITH AIX 3.1 +&USE,DOUBLE. DOUBLE PRECISION. +&USE,STDIO. STANDARD FORTRAN 77 TAPE INPUT/OUTPUT. +&USE,MOVEFTN. FORTRAN REPLACEMENT FOR MOVLEV. +&USE,RANFFTN,IF=-CERN. FORTRAN RANF. +&USE,RANFCALL. STANDARD RANSET AND RANGET CALLS. +&USE,NOCERN,IF=-CERN. NO CERN LIBRARY. +&USE,IMPNONE. IMPLICIT NONE +&EOD + +&PATCH,LINUX. IBM PC WITH LINUX 1.X +&USE,DOUBLE. DOUBLE PRECISION. +&USE,STDIO. STANDARD FORTRAN 77 TAPE INPUT/OUTPUT. +&USE,MOVEFTN. FORTRAN REPLACEMENT FOR MOVLEV. +&USE,RANFFTN,IF=-CERN. FORTRAN RANF. +&USE,RANFCALL. STANDARD RANSET AND RANGET CALLS. +&USE,NOCERN,IF=-CERN. NO CERN LIBRARY. +&USE,IMPNONE. IMPLICIT NONE +&EOD + +&PATCH,SGI. +SILICON GRAPHICS 4D/XX. +&USE,DOUBLE. DOUBLE PRECISION. +&USE,STDIO. STANDARD FORTRAN 77 TAPE INPUT/OUTPUT. +&USE,MOVEFTN. FORTRAN REPLACEMENT FOR MOVLEV. +&USE,RANFFTN,IF=-CERN. FORTRAN RANF. +&USE,RANFCALL. STANDARD RANSET AND RANGET CALLS. +&USE,NOCERN,IF=-CERN. NO CERN LIBRARY. +&EOD + +&PATCH,SUN. SUN (SPARC) +&USE,DOUBLE. DOUBLE PRECISION. +&USE,STDIO. STANDARD FORTRAN 77 TAPE INPUT/OUTPUT. +&USE,MOVEFTN. FORTRAN REPLACEMENT FOR MOVLEV. +&USE,RANFFTN,IF=-CERN. FORTRAN RANF. +&USE,RANFCALL. STANDARD RANSET AND RANGET CALLS. +&USE,NOCERN,IF=-CERN. NO CERN LIBRARY. +&EOD + +&PATCH,VAX. DEC VAX 11/780 OR 8600. +&USE,DOUBLE. DOUBLE PRECISION. +&USE,STDIO. STANDARD FORTRAN 77 TAPE INPUT/OUTPUT. +&USE,MOVEFTN. FORTRAN REPLACEMENT FOR MOVLEV. +&USE,RANFFTN,IF=-CERN. FORTRAN RANF. +&USE,RANFCALL. STANDARD RANSET AND RANGET CALLS. +&USE,NOCERN,IF=-CERN. NO CERN LIBRARY. +&USE,IMPNONE. IMPLICIT NONE +&EOD +\end{verbatim} + + An empty patch INTERACT selects a main program and an interactive +interface which will prompt the user for parameters and do some error +checking. A patch CERN allows ISAJET to take the random number generator +RANF and several other routines from the CERN Library; to use this +include the Patchy command +\begin{verbatim} +&USE,CERN. +\end{verbatim} +Similarly, a patch PDFLIB enables the interface to the PDFLIB parton +distribution compilation by H. Plothow-Besch: +\begin{verbatim} +&USE,PDFLIB +\end{verbatim} +The only internal links with PDFLIB are calls to the routines PDFSET, +PFTOPDG, and DXPDF, and the common blocks W50510 and W50517, +\begin{verbatim} +#if defined(CERNLIB_PDFLIB) +#include "w50510.inc" +* Ignoring t=pass +#endif +#if defined(CERNLIB_PDFLIB) +#include "w50517.inc" +* Ignoring t=pass +#endif +\end{verbatim} +which are used to specify the level of output messages and the logical +unit number for them. + + In general it should be sufficient to run YPATCHY with the +following cradle (replace \verb|&| with \verb|+| everywhere): +\begin{verbatim} +&USE,(*ISAJET,*ISATEXT,*ISADECAY,*ISAPLT). CHOOSE ONE. +&USE,ANSI,DECS,HPUX,IBM,IBMRT,SGI,SUN,.... CHOOSE ONE. +&[USE,INTERACT]. FOR INTERACTIVE MODE. +&[USE,CERN.] FOR CERN LIBRARY. +&[USE,HBOOK3.] HBOOK 3 FOR ISAPLT. +&EXE. +&PAM. +&QUIT. +\end{verbatim} + + The input to YPATCHY can also contain changes by the user. It is +suggested that these not be made permanent parts of the PAM to avoid +possible conflicts with later corrections. diff --git a/ISAJET/doc/physics.doc b/ISAJET/doc/physics.doc new file mode 100644 index 00000000000..03ad097b090 --- /dev/null +++ b/ISAJET/doc/physics.doc @@ -0,0 +1,788 @@ +\newpage +\section{Physics\label{PHYSICS}} + + ISAJET is a Monte Carlo program which simulates $pp$, $\bar pp$ +and $e^+e^-$ interactions at high energy. +The program incorporates +perturbative QCD cross sections, initial state and final state QCD +radiative corrections in the leading log approximation, independent +fragmentation of quarks and gluons into hadrons, and a +phenomenological model tuned to minimum bias and hard scattering data +for the beam jets. + +\subsection{Hard Scattering\label{hard}} + + The first step in simulating an event is to generate a primary +hard scattering according to some QCD cross section. This has the +general form +$$ +\sigma = \sigma_0 F(x_1,Q^2) F(x_2,Q^2) +$$ +where $\sigma_0$ is a cross section calculated in QCD perturbation +theory, $F(x,Q^2)$ is a structure function incorporating QCD scaling +violations, $x_1$ and $x_2$ are the usual parton model momentum +fractions, and $Q^2$ is an appropriate momentum transfer scale. + + For each of the processes included in ISAJET, the basic cross +section $\sigma_0$ is a two-body one, and the user can set limits on +the kinematic variables and type for each of the two primary jets. For +DRELLYAN and WPAIR events the full matrix element for the decay of the +W's into leptons or quarks is also included. + + The following processes are available: + +\subsubsection{Minbias} No hard scattering at all, so that the event +consists only of beam jets. Note that at high energy the jet cross +sections become large. To represent the total cross section it is +better to use a sample of TWOJET events with the lower limit on pt +chosen to give a cross section equal to the inelastic cross section or +to use a mixture of MINBIAS and TWOJET events. + +\subsubsection{Twojet} All order $\alpha_s^2$ QCD processes, which +give rise in lowest order to two high-$p_t$ jets. Included are, e.g. +\begin{eqnarray*} +g + g &\to& g + g\\ +g + q &\to& g + q \\ +g + g &\to& q + \bar q +\end{eqnarray*} +Masses are neglected for $c$ and lighter quarks but are taken into +account for $b$ and $t$ quarks. The $Q^2$ scale is taken to be +$$ +Q^2 = 2stu/(s^2+t^2+u^2) +$$ +The default parton distributions are those of the CTEQ Collaboration, +fit CTEQ3L, using lowest order QCD evolution. Two older fits, Eichten, +Hinchliffe, Lane and Quigg (EHLQ), Set~1, and Duke and Owens, Set~1, +are also included. There is also an interface to the CERN PDFLIB +compilation of parton distributions. Note that structure functions for +heavy quarks are included, so that processes like +$$ +g + t \to g + t +$$ +can be generated. The Duke-Owens parton distributions do not contain b +or t quarks. + + Since the $t$ is so heavy, it decays before it can hadronize, so +instead of $t$ hadrons a $t$ quark appears in the particle list. It is +decayed using the $V-A$ matrix element including the $W$ propagator +with a nonzero width, so the same decays should be used for $m_t < m_W$ +and $m_t > m_W$; the $W$ should {\it not} be listed as part of the decay +mode. The partons are then evolved and fragmented as usual; see +below. The real or virtual $W$ and the final partons from the decay, +including any radiated gluons, are listed in the particle table, +followed by their fragmentation products. Note that for semileptonic +decays the leptons appear twice: the lepton parton decays into a +single particle of the same type but in general somewhat different +momentum. In all cases only particles with $\verb|IDCAY| = 0$ should be +included in the final state. + + A fourth generation $x,y$ is also allowed. Fourth generation +quarks are produced only by gluon fusion. Decay modes are not included +in the decay table; for a sequential fourth generation they would be +very similar to the t decays. In decays involving quarks, it is +essential that the quarks appear last. + +\subsubsection{Drellyan} Production of a $W$ in the standard model, +including a virtual $\gamma$, a $W^+$, a $W^-$, or a $Z^0$, and its +decay into quarks or leptons. If the transverse momentum QTW of the +$W$ is fixed equal to zero then the process simulated is +\begin{eqnarray*} +q + \bar q \to W &\to& q + \bar q \\ + &\to& \ell + \bar\ell +\end{eqnarray*} +Thus the $W$ has zero transverse momentum until initial state QCD +corrections are taken into account. If non-zero limits on the +transverse momentum $q_t$ for the $W$ are set, then instead the +processes +\begin{eqnarray*} +q + \bar q &\to& W + g \\ +g + q &\to& W + q +\end{eqnarray*} +are simulated, including the full matrix element for the $W$ decay. +These are the dominant processes at high $q_t$, but they are of course +singular at $q_t=0$. A cutoff of the $1/q_t^2$ singularity is made by +the replacement +$$ +1/q_t^2 \to 1/\sqrt{q_t^4+q_{t0}^4} \quad q_{t0}^2 = (.2\,\GeV) M +$$ +This cutoff is chosen to reproduce approximately the $q_t$ dependence +calculated by the summation of soft gluons and to give about the right +integrated cross section. Thus this option can be used for low as well +as high transverse momenta. + + The scale for QCD evolution is taken to be proportional to the +mass for lowest order Drell-Yan and to the transverse momentum for +high-$p_t$ Drell-Yan. The constant is adjusted to get reasonable +agreement with the $W + n\,{\rm jet}$ cross sections calculated from +the full QCD matrix elements by F.A. Berends, et al., Phys.\ +Lett.\ B224, 237 (1989). + + For the processes $g + b \to W + t$ and $g + t \to Z + t$, cross +sections with a non-zero top mass are used for the production and the +$W/Z$ decay. These were calculated using FORM 1.1 by J.~Vermaseren. The +process $g + t \to W + b$ is {\it not} included. Both $g + b \to W^- + +t$ and $g + \bar t \to W^- + \bar b$ of course give the same $W^- + t ++\BARB_FINALSTATEAFTERQCDEVOLUTION +needed to describe the $m_t = 0$(!) mass singularity for $q_t \gg +m_t$, it has a pole in the physical region at low $q_t$ from on-shell +$t \to W + b$ decays. There is no obvious way to avoid this without +introducing an arbitrary cutoff. Hence, selecting only $W + b$ will +produce a zero cross section. The $Q^2$ scale for the parton +distributions in these processes is replaced by $Q^2 + m_t^2$; this +seems physically sensible and prevents the cross sections from +vanishing at small $q_t$. + +\subsubsection{Photon} Single and double photon production through the +lowest order QCD processes +\begin{eqnarray*} +g + q &\to& \gamma + q \\ +q + \bar q &\to& \gamma + g \\ +q + \bar q &\to& \gamma + \gamma +\end{eqnarray*} +Higher order corrections are not included. But $\gamma$'s, $W$'s, and +$Z$'s are radiated from final state quarks in all processes, allowing +study of the bremsstrahlung contributions. + +\subsubsection{Wpair} Production of pairs of W bosons in the standard +model through quark-antiquark annihilation, +\begin{eqnarray*} +q + \bar q &\to& W^+ + W^- \\ + &\to& Z^0 + Z^0 \\ + &\to& W^+ + Z^0, W^- + Z^0 \\ + &\to& W^+ + \gamma, W^- + \gamma \\ + &\to& Z^0 + \gamma +\end{eqnarray*} +The full matrix element for the W decays, calculated in the narrow +resonance approximation, is included. However, the higher order +processes, e.g. +$$ +q + q \to q + q + W^+ + W^- +$$ +are ignored, although they in fact dominate at high enough mass. +Specific decay modes can be selected using the WMODEi keywords. + +\subsubsection{Higgs} Production and decay of the standard model Higgs +boson. The production processes are +\begin{eqnarray*} +g + g &\to& H \quad\hbox{(through a quark loop)} \\ +q + \bar q &\to& H \quad\hbox{(with $t + \bar t$ dominant)} \\ +W^+ + W^- &\to& H \quad\hbox{ (with longitudinally polarized $W$)} \\ +Z^0 + Z^0 &\to& H \quad\hbox{ (with longitudinally polarized $Z$)} +\end{eqnarray*} +If the (Standard Model) Higgs is lighter than $2 M_W$, then it will +decay into pairs of fermions with branching ratios proportional to +$m_f^2$. If it is heavier than $2 M_W$, then it will decay primarily +into $W^+ W^-$ and $Z^0 Z^0$ pairs with widths given approximately by +\begin{eqnarray*} +\Gamma(H \to W^+ W^-) &=& {G_F M_H^3 \over 8 \pi \sqrt{2} } \\ +\Gamma(H \to Z^0 Z^0) &=& {G_F M_H^3 \over 16 \pi \sqrt{2} } +\end{eqnarray*} +Numerically these give approximately +$$ +\Gamma_H = 0.5\,{\rm TeV} \left({M_H \over 1\,{\rm TeV}}\right)^3 +$$ +The width proportional to $M_H^3$ arises from decays into longitudinal +gauge bosons, which like Higgs bosons have couplings proportional to +mass. + + Since a heavy Higgs is wide, the narrow resonance approximation is +not valid. To obtain a cross section with good high energy behavior, it +is necessary to include a complete gauge-invariant set of graphs for the +processes +\begin{eqnarray*} +W^+ W^- &\to& W^+ W^- \\ +W^+ W^- &\to& Z^0 Z^0 \\ +Z^0 Z^0 &\to& W^+ W^- \\ +Z^0 Z^0 &\to& Z^0 Z^0 +\end{eqnarray*} +with longitudinally polarized $W^+$, $W^-$, and $Z^0$ bosons in the +initial state. This set of graphs and the corresponding angular +distributions for the $W^+$, $W^-$, and $Z^0$ decays have been +calculated in the effective $W$ approximation and included in HIGGS. +The $W$ structure functions are obtained by integrating the EHLQ +parameterization of the quark ones term by term. The Cabibbo-allowed +branchings +\begin{eqnarray*} +q &\to& W^+ + q' \\ +q &\to& W^- + q' \\ +q &\to& Z^0 + q +\end{eqnarray*} +are generated by backwards evolution, and the standard QCD evolution is +performed. This correctly describes the $W$ collinear singularity and +so contains the same physics as the effective $W$ approximation. + + If the Higgs is lighter than $2M_W$, then its decay to +$\gamma\gamma$ through $W$ and $t$ loops may be important. This is +also included in the HIGGS process and may be selected by choosing +\verb|GM| as the jet type for the decay. + + If the Higgs has $M_Z < M_H < 2M_Z$, then decays into one real +and one virtual $Z^0$ are generated if the \verb|Z0 Z0| decay mode is +selected, using the calculation of Keung and Marciano, Phys.\ Rev.\ +D30, 248 (1984). Since the calculation assumes that one $Z^0$ is +exactly on shell, it is not reliable within of order the $Z^0$ width +of $M_H = 2M_Z$; Higgs and and $Z^0 Z^0$ masses in this region should +be avoided. The analogous Higgs decays into one real and one virtual +charged W are not included. + + Note that while HIGGS contains the dominant graphs for Higgs +production and graphs for $W$ pair production related by gauge invariance, +it does not contain the processes +\begin{eqnarray*} +q + \bar q &\to& W^+ W^- \\ +q + \bar q &\to& Z^0 Z^0 +\end{eqnarray*} +which give primarily transverse gauge bosons. These must be generated +with WPAIR. + + If the \verb|MSSMi| or \verb|SUGRA| keywords are used with +HIGGS, then one of the three MSSM neutral Higgs is generated instead +using gluon-gluon and quark-antiquark fusion with the appropriate SUSY +couplings. Since heavy CP even SUSY Higgs are weakly coupled to W +pairs and CP odd ones are completely decoupled, $WW$ fusion and $WW +\to WW$ scattering are not included in the SUSY case. ($WW \to WW$ can +be generated using the Standard Model process with a light Higgs mass, +say 100 GeV.) The MSSM Higgs decays into both Standard Model and SUSY +modes as calculated by ISASUSY are included. For more discussion see +the SUSY subsection below and the writeup for ISASUSY. The user must +select which Higgs to generate using HTYPE; see Section 6 below. If a +mass range is not specified, then the range mass $M_H \pm 5\Gamma_H$ +is used by default. (This cannot be done for the Standard Model Higgs +because it is so wide for large masses.) Decay modes may be selected +in the usual way. + +\subsubsection{WHiggs} Generates associated production of gauge and +Higgs bosons, i.e., +$$ +q + \bar q \to H + W, H + Z\,, +$$ +in the narrow resonance approximation. The desired subprocesses can be +selected with JETTYPEi, and specific decay modes of the $W$ and/or $Z$ +can be selected using the WMODEi keywords. Standard Model couplings are +assumed unless SUSY parameters are specified, in which case the SUSY +couplings are used. + +\subsubsection{SUSY} Generates pairs of supersymmetric particles from +gluon-quark or quark-antiquark fusion. If the MSSMi or SUGRA +parameters defined in Section 6 below are not specified, then only +gluinos and squarks are generated: +\begin{eqnarray*} +g + g &\to& \tilde g + \tilde g \\ +q + \bar q &\to& \tilde g + \tilde g \\ +g + q &\to& \tilde g + \tilde q \\ +g + g &\to& \tilde q + \tilde{\bar q} \\ +q + \bar q &\to& \tilde q + \tilde{\bar q} \\ +q + q &\to& \tilde q + \tilde q +\end{eqnarray*} +Left and right squarks are distinguished but assumed to be degenerate. +Masses can be specified using the \verb|GAUGINO|, \verb|SQUARK|, and +\verb|SLEPTON| parameters described in Section 6. No decay modes are +specified, since these depend strongly on the masses. The user can +either add new modes to the decay table (see Section 9) or use the +\verb|FORCE| or \verb|FORCE1| commands (see Section 6). + + If \verb|MSSMA|, \verb|MSSMB|, and \verb|MSSMC| are specified, +then the ISASUSY package is used to calculate the masses and decay +modes in the minimal supersymmetric extension of the standard model +(MSSM), assuming SUSY grand unification constraints in the neutralino +and chargino mass matrix but allowing some additional flexibility in +the masses. The scalar particle soft masses are input via +\verb|MSSMi|, so that the physical masses will be somewhat different +due to $D$-term contributions and mixings for 3rd generation sparticles. +$\tilde t_1$ and $\tilde t_2$ production and decays are now included. +The lightest SUSY particle is assumed to be the lightest neutralino +$\tilde Z_1$. If the \verb|MSSMi| parameters are specified, then the +following additional processes are included using the MSSM couplings +for the production cross sections: +\begin{eqnarray*} +g + q &\to& \tilde Z_i + \tilde q, \quad \tilde W_i + \tilde q \\ +q + \bar q &\to& \tilde Z_i + \tilde g, \quad \tilde W_i + \tilde g \\ +q + \bar q &\to& \tilde W_i + \tilde Z_j \\ +q + \bar q &\to& \tilde W_i^+ + \tilde W_j^- \\ +q + \bar q &\to& \tilde Z_i + \tilde Z_j \\ +q + \bar q &\to& \tilde\ell^+ + \tilde\ell^-, \quad \tilde\nu + \tilde\nu +\end{eqnarray*} +Processes can be selected using the optional parameters described in +Section 6 below. + + Beginning with Version 7.42, matrix elements are taken into +account in the event generator as well as in the calculation of decay +widths for MSSM three-body decays of the form $\tilde A \to \tilde B f +\bar f$, where $\tilde A$ and $\tilde B$ are gluinos, charginos, or +neutralinos. This is implemented by having ISASUSY save the poles and +their couplings when calculating the decay width and then using these +to reconstruct the matrix element. Other three-body decays may be +included in the future. Decays selected with \verb|FORCE| use the +appropriate matrix elements. + + An optional keyword \verb|MSSMD| can be used to specify the second +generation masses, which otherwise are assumed degenerate with the first +generation. An optional keyword \verb|MSSME| can be used to specify +values of the $U(1)$ and $SU(2)$ gaugino masses at the weak scale rather +than using the default grand unification values. The chargino and +neutralino masses and mixings are then computed using these values. + + Instead of using the \verb|MSSMi| parameters, one can use the +\verb|SUGRA| parameter to specify in the minimal supergravity framework. +This assumes that the gauge couplings unify at a GUT scale and that SUSY +breaking occurs at that scale with universal soft breaking terms, which +are related to the weak scale using the renormalization group. The +renormalization group equations now include all the two-loop terms for +both gauge and Yukawa couplings and the possible contributions from +right-handed neutrinos. The parameters of the model are +\begin{itemize} +\item $m_0$: the common scalar mass at the GUT scale; +\item $m_{1/2}$: the common gaugino mass at the GUT scale; +\item $A_0$: the common soft trilinear SUSY breaking parameter at the +GUT scale; +\item $\tan\beta$: the ratio of Higgs vacuum expectation values at the +electroweak scale; +\item $\sgn\mu=\pm1$: the sign of the Higgsino mass term. +\end{itemize} +The renormalization group equations are solved iteratively to determine +all the electroweak SUSY parameters from these data assuming radiative +electroweak symmetry breaking but not other possible constraints such as +b-tau unification or limits on proton decay. + + The assumption of universality at the GUT scale is rather +restrictive and may not be valid. A variety of non-universal SUGRA +(NUSUGRA) models can be generated using the \verb|NUSUG1|, \dots, +\verb|NUSUG5| keywords. These might be used to study how well one could +test the minimal SUGRA model. The keyword \verb|SSBCSC| can be used to +specify an alternative scale (i.e., not the coupling constant +unification scale) for the RGE boundary conditions. + + An alternative to the SUGRA model is the Gauge Mediated SUSY +Breaking (GMSB) model of Dine, Nelson, and collaborators. In this model +SUSY breaking is communicated through gauge interactions with messenger +fields at a scale $M_m$ small compared to the Planck scale and are +proportional to gauge couplings times $\Lambda_m$. The messenger fields +should form complete $SU(5)$ representations to preserve the unification +of the coupling constants. The parameters of the GMSB model, which are +specified by the \verb|GMSB| keyword, are +\begin{itemize} +\item $\Lambda_m = F_m/M_m$: the scale of SUSY breaking, typically +10--$100\,{\rm TeV}$; +\item $M_m > \Lambda_m$: the messenger mass scale; +\item $N_5$: the equivalent number of $5+\bar5$ messenger fields. +\item $\tan\beta$: the ratio of Higgs vacuum expectation values at the +electroweak scale; +\item $\sgn\mu=\pm1$: the sign of the Higgsino mass term; +\item $C_{\rm grav}\ge1$: the ratio of the gravitino mass to the value it +would have had if the only SUSY breaking scale were $F_m$. +\end{itemize} +In GMSB models the lightest SUSY particle is always the nearly massless +gravitino $\tilde G$. The parameter $C_{\rm grav}$ scales the gravitino +mass and hence the lifetime of the next lightest SUSY particle to decay +into it. The \verb|NOGRAV| keyword can be used to turn off gravitino +decays. + + A variety of non-minimal GMSB models can be generated using +additional parameters set with the GMSB2 keyword. These additional +parameters are +\begin{itemize} +\item $\slashchar{R}$, an extra factor multiplying the gaugino masses +at the messenger scale. (Models with multiple spurions generally have +$\slashchar{R}<1$.) +\item $\delta M_{H_d}^2$, $\delta M_{H_u}^2$, Higgs mass-squared +shifts relative to the minimal model at the messenger scale. (These +might be expected in models which generate $\mu$ realistically.) +\item $D_Y(M)$, a $U(1)_Y$ messenger scale mass-squared term +($D$-term) proportional to the hypercharge $Y$. +\item $N_{5_1}$, $N_{5_2}$, and $N_{5_3}$, independent numbers of +gauge group messengers. They can be non-integer in general. +\end{itemize} +For discussions of these additional parameters, see S. Dimopoulos, S. +Thomas, and J.D. Wells, hep-ph/9609434, Nucl.\ Phys.\ {\bf B488}, 39 +(1997), and S.P. Martin, hep-ph/9608224, Phys.\ Rev.\ {\bf D55}, 3177 +(1997). + + Gravitino decays can be included in the general MSSM framework by +specifying a gravitino mass with \verb|MGVTNO|. The default is that such +decays do not occur. + +Another alternative SUSY model choice allowed is +anomaly-mediated SUSY breaking, developed by Randall and Sundrum. +In this model, it is assumed that SUSY breaking takes place +in other dimensions, and SUSY breaking is communicated to the visible sector +via the superconformal anomaly. In this model, the lightest SUSY particle +is usually the neutralino which is nearly pure wino-like. The chargino +is nearly mass degenerate with the lightest neutralino. It can be +very long lived, or decay into a very soft pion plus missing energy. +The model incorporated in ISAJET, based on work by +Ghergetta, Giudice and Wells (hep-ph/9904378), +and by Feng and Moroi (hep-ph/9907319) adds a universal contribution +$m_0^2$ to all scalar masses to avoid problems with tachyonic scalars. +The parameter set is $m_0,\ m_{3/2},\ \tan\beta ,\ sign(\mu )$, and +can be input via the $AMSB$ keyword. Care should be taken with the chargino +decay, since it may have macroscopic decay lengths, or even decay +outside the detector. + +Since neutrinos seem to have mass, the effect of a massive right-handed +neutrino has been included in ISAJET, when calculating the sparticle +mass spectrum. If the keyword $SUGRHN$ is used, then the user +must input the 3rd generation neutrino mass (at scale $M_Z$) in units +of GeV, and the intermediate scale right handed neutrino Majorana mass $M_N$, +also in GeV. In addition, one must specify the soft SUSY-breaking masses +$A_n$ and $m_{\tilde\nu_R}$ valid at the GUT scale. Then the neutrino +Yukawa coupling is computed in the simple see-saw model, and +renormalization group evolution includes these effects between +$M_{GUT}$ and $M_N$. Finally, to facilitate modeling of $SO(10)$ +SUSY-GUT models, loop corrections to 3rd generation fermion masses have +been included in the ISAJET SUSY models. + + The ISASUSY program can also be used independently of the rest of +ISAJET, either to produce a listing of decays or in conjunction with +another event generator. Its physics assumptions are described in more +detail in Section~\ref{SUSY}. The ISASUGRA program can also be used +independently to solve the renormalization group equations with SUGRA, +GMSB, or NUSUGRA boundary conditions and then to call ISASUSY to +calculate the decay modes. + + Generally the MSSM, SUGRA, or GMSB option should be used to study +supersymmetry signatures; the SUGRA or GMSB parameter space is clearly +more manageable. The more general option may be useful to study +alternative SUSY models. It can also be used, e.g., to generate +pointlike color-3 leptoquarks in technicolor models by selecting squark +production and setting the gluino mass to be very large. The MSSM or +SUGRA option may also be used with top pair production to simulate top +decays to SUSY particles. + +\subsubsection{$e^+e^-$} An $e^+e^-$ event generator is also included in +ISAJET. The +Standard Model processes included are $e^+e^-$ annihilation through +$\gamma$ and $Z$ to quarks and leptons, and production of $W^+W^-$ and +$Z^0Z^0$ pairs. In contrast to WPAIR and HIGGS for the hadronic +processes, the produced $W$'s and $Z$'s are treated as particles, so +their spins are not properly taken into account in their decays. +(Because the $W$'s and $Z$'s are treated as particles, their decay +modes can be selected using \verb|FORCE| or \verb|FORCE1|, not +\verb|WMODEi|. See Section [6] below.) Other Standard Model +processes, including $e^+ e^- \to e^+ e^-$ ($t$-channel graph) and $e^+ e^- +\to \gamma \gamma$, are not included. Once the primary reaction has been +generated, QCD radiation and hadronization are done as for hadronic +processes. + +The $e^+e^-$ generator can be run assuming no initial state +radiation (the default), or an initial state electron structure function +can be used for bremsstrahlung or the combination bremsstrahlung/beamstrahlung +effect. Bremsstrahlung is implemented using the Fadin-Kuraev +$e^-$ distribution function, and can be turned on using the \verb|EEBREM| +command while stipulating the minimal and maximal subprocess energy. +Beamstrahlung is implemented by invoking the \verb|EEBEAM| keyword. +In this case, in addition the beamstrahlung parameter $\Upsilon$ and +longitudinal beam size $\sigma_z$ (in mm) must be given. +The definition for $\Upsilon$ in terms of other beam parameters can be +found in the article Phys. Rev. D49, 3209 (1994) by Chen, Barklow and Peskin. +The bremsstrahlung structure function is then convoluted with the +beamstrahlung distribution (as calculated by P. Chen) and a spline fit +is created. Since the cross section can contain large spikes, event generation +can be slow if a huge range of subprocess energy is selected for light +particles; in these scenarios, \verb|NTRIES| must be increased well beyond +the default value. + + $e^+e^-$ annihilation to SUSY particles is included as well with +complete lowest order diagrams, and cascade decays. The processes +include +\begin{eqnarray*} +e^+ e^- &\to& \tilde q \tilde q \\ +e^+ e^- &\to& \tilde\ell \tilde\ell \\ +e^+ e^- &\to& \tilde W_i \tilde W_j \\ +e^+ e^- &\to& \tilde Z_i \tilde Z_j \\ +e^+ e^- &\to& H_L^0+Z^0,H_H^0+Z^0,H_A^0+H_L^0,H_A^0+H_H^0,H^++H^- +\end{eqnarray*} +Note that SUSY Higgs production via $WW$ and $ZZ$ fusion, which can +dominate Higgs production processes at $\sqrt{s} > 500\,\GeV$, +is not included. Spin correlations are neglected, although +3-body sparticle decay matrix elements are included. + + $e^+e^-$ cross sections with polarized beams are included for +both Standard Model and SUSY processes. The keyword \verb|EPOL| is +used to set $P_L(e^-)$ and $P_L(e^+)$, where +$$ +P_L(e) = (n_L-n_R)/(n_L+n_R) +$$ +so that $-1 \le P_L \le +1$. Thus, setting \verb|EPOL| to $-.9,0$ will +yield a 95\% right polarized electron beam scattering on an unpolarized +positron beam. + +\subsubsection{Technicolor} Production of a technirho of arbitrary +mass and width decaying into $W^\pm Z^0$ or $W^+ W^-$ pairs. The cross +section is based on an elastic resonance in the $WW$ cross section +with the effective $W$ approximation plus a $W$ mixing term taken from +EHLQ. Additional technicolor processes may be added in the future. + +\subsubsection{Extra Dimensions} The possibility that there might be +more than four space-time dimensions at a distance scale $R$ much larger +than $G_N^{1/2}$ has recently attracted interest. In these theories, +$$ +G_N = {1 \over 8\pi R^\delta M_D^{2+\delta}}\,, +$$ +where $\delta$ is the number of extra dimensions and $M_D$ is the +$4+\delta$ Planck scale. Gravity deviates from the standard theory at a +distance $R \sim 10^{22/\delta-19}\,{\rm m}$, so $\delta\ge2$ is +required. If $M_D$ is of order $1\,{\rm TeV}$, then the usual heirarchy +problem is solved, although there is then a new heirarchy problem of why +$R$ is so large. + + In such models the graviton will have many Kaluza-Klein +excitations with a mass splitting of order $1/R$. While any individual +mode is suppressed by the four-dimensional Planck mass, the large number +of modes produces a cross section suppressed only by $1/M_D^2$. The +signature is an invisible massive graviton plus a jet, photon, or other +Standard Model particle. The \verb|EXTRADIM| process implements this +reaction using the cross sections of Giudice, Rattazzi, and Wells, +hep-ph/9811291. The number $\delta$ of extra dimensions, the mass scale +$M_D$, and the logical flag \verb|UVCUT| are specified using the keyword +\verb|EXTRAD|. If \verb|UVCUT| is \verb|TRUE|, the cross section is cut +off above the scale $M_D$; the model is not valid if the results depend +on this flag. + +\subsection{Multiparton Hard Scattering} + + All the processes listed in Section~\ref{hard} are either $2\to2$ +processes like \verb|TWOJET| or $2\to1$ $s$-channel resonance processes +followed by a 2-body decay like \verb|DRELLYAN|. The QCD parton shower +described in Section~\ref{qcdshower} below generates multi-parton final +states starting from these, but it relies on an approximation which is +valid only if the additional partons are collinear either with the +initial or with the final primary ones. Since the QCD shower uses exact +non-colliear kinematics, it in fact works pretty well in a larger region +of phase space, but it is not exact. + + Non-collinear multiparton final states are interesting both in +their own right and as backgrounds for other signatures. Both the matrix +elements and the phase space for multiparton processes are complicated; +they have been incorporated into ISAJET for the first time in +Version~7.45. To calculate the matrix elements we have used the MadGraph +package by Stelzer and Long, Comput.\ Phys.\ Commun.\ {\bf81}, 357 +(1994), hep-ph/9401258. This automatically generates the amplitude using +\verb|HELAS|, a formalism by Murayama, Watanabe, and Hagiwarak +KEK-91-11, that calculates the amplitude for any Feynman diagram in +terms of spinnors, vertices, and propagators. The MadGraph code has been +edited to incorporate summations over quark flavors. To do the phase +space integration, we have used a simple recursive algorithm to generate +$n$-body phase space. We have included limits on the total mass of the +final state using the \verb|MTOT| keyword. Limits on the $p_T$ and +rapidity of each final parton can be set via the \verb|PT| and \verb|Y| +keyworks, while limits on the mass of any pair of final partons can be +set via the \verb|MIJTOT| keyword. These limits are sufficient to shield +the infrared and collinear singularities and to render the result +finite. However, the parton shower populates all regions of phase space, +so careful thought is needed to combine the parton-shower based and +multiparton based results. + + While the multiparton formalism is rather general, it still takes +a substantial amount of effort to implement any particular process. So +far only one process has been implemented. + +\subsubsection{$Z + {\rm 2\ jets}$} The \verb|ZJJ| process generates a +$Z$ boson plus two jets, including the $q\bar{q} \to Z q \bar{q}$, $gg +\to Z q\bar{q}$, $q\bar{q} \to Zgg$, $qq \to Zqq$, and $gq \to Z gq$ +processes. The $Z$ is defined to be jet 1; it is treated in the narrow +resonance approximation and is decayed isotropically. The quarks, +antiquarks, and gluons are defined to be jets 2 and 3 and are +symmetrized in the usual way. + +\subsection{QCD Radiative Corrections\label{qcdshower}} + + After the primary hard scattering is generated, QCD radiative +corrections are added to allow the possibility of many jets. This is +essential to get the correct event structure, especially at high +energy. + + Consider the emission of one extra gluon from an initial or a +final quark line, +$$ +q(p) \to q(p_1) + g(p_2) +$$ +From QCD perturbation theory, for small $p^2$ the cross section is +given by the lowest order cross section multiplied by a factor +$$ +\sigma = \sigma_0 \alpha_s(p^2)/(2\pi p^2) P(z) +$$ +where $z=p_1/p$ and $P(z)$ is an Altarelli-Parisi function. The same +form holds for the other allowed branchings, +\begin{eqnarray*} +g(p) &\to& g(p_1) + g(p_2) \\ +g(p) &\to& q(p_1) + \bar q(p_2) +\end{eqnarray*} +These factors represent the collinear singularities of perturbation +theory, and they produce the leading log QCD scaling violations for the +structure functions and the jet fragmentation functions. They also +determine the shape of a QCD jet, since the jet $M^2$ is of order +$\alpha_s p_t^2$ and hence small. + + The branching approximation consists of keeping just these +factors which dominate in the collinear limit but using exact, +non-collinear kinematics. Thus higher order QCD is reduced to a +classical cascade process, which is easy to implement in a Monte Carlo +program. To avoid infrared and collinear singularities, each parton in +the cascade is required to have a mass (spacelike or timelike) greater +than some cutoff $t_c$. The assumption is that all physics at lower +scales is incorporated in the nonperturbative model for hadronization. +In ISAJET the cutoff is taken to be a rather large value, +$(6\,\GeV)^2$, because independent fragmentation is used for the jet +fragmentation; a low cutoff would give too many hadrons from +overlapping partons. It turns out that the branching approximation not +only incorporates the correct scaling violations and jet structure but +also reproduces the exact three-jet cross section within factors of +order 2 over all of phase space. + + This approximation was introduced for final state radiation by +Fox and Wolfram. The QCD cascade is determined by the probability for +going from mass $t_0$ to mass $t_1$ emitting no resolvable radiation. +For a resolution cutoff $z_c < z < 1-z_c$, this is given by a simple +expression, +$$ +P(t_0,t_1)=\left(\alpha_s(t_0)/\alpha_s(t_1)\right)^{2\gamma(z_c)/b_0} +$$ +where +$$ +\gamma(z_c)=\int_{z_c}^{1-z_c} dz\,P(z),\qquad +b_0=(33-2n_f)/(12\pi) +$$ +Clearly if $P(t_0,t_1)$ is the integral probability, then $dP/dt_1$ is +the probability for the first radiation to occur at $t_1$. It is +straightforward to generate this distribution and then iteratively to +correct it to get a cutoff at fixed $t_c$ rather than at fixed $z_c$. + + For the initial state it is necessary to take account of the +spacelike kinematics and of the structure functions. Sjostrand has +shown how to do this by starting at the hard scattering and evolving +backwards, forcing the ordering of the spacelike masses $t$. The +probability that a given step does not radiate can be derived from the +Altarelli-Parisi equations for the structure functions. It has a form +somewhat similar to $P(t_0,t_1)$ but involving a ratio of the structure +functions for the new and old partons. It is possible to find a bound +for this ratio in each case and so to generate a new $t$ and $z$ as for +the final state. Then branchings for which the ratio is small are +rejected in the usual Monte Carlo fashion. This ratio suppresses the +radiation of very energetic partons. It also forces the branching $g +\to t + \bar t$ for a $t$ quark if the $t$ structure function vanishes +at small momentum transfer. + + At low energies, the branching of an initial heavy quark into a +gluon sometimes fails; these events are discarded and a warning is +printed. + + Since $t_c$ is quite large, the radiation of soft gluons is cut +off. To compensate for this, equal and opposite transverse boosts are +made to the jet system and to the beam jets after fragmentation with a +mean value +$$ +\langle p_t^2\rangle = (.1\,\GeV) \sqrt{Q^2} +$$ +The dependence on $Q^2$ is the same as the cutoff used for DRELLYAN and +the coefficient is adjusted to fit the $p_t$ distribution for the $W$. + + Radiation of gluons from gluinos and scalar quarks is also +included in the same approximation, but the production of gluino or +scalar quark pairs from gluons is ignored. Very little radiation is +expected for heavy particles produced near threshold. + + Radiation of photons, $W$'s, and $Z$'s from final state quarks is +treated in the same approximation as QCD radiation except that the +coupling constant is fixed. Initial state electroweak radiation is not +included; it seems rather unimportant. The $W^+$'s, $W^-$'s and $Z$'s +are decayed into the modes allowed by the \verb|WPMODE|, \verb|WMMODE|, +and \verb|Z0MODE| commands respectively. {\it Warning:} The branching +ratios implied by these commands are not included in the cross section +because an arbitrary number of $W$'s and $Z$'s can in principle be +radiated. + +\subsection{Jet Fragmentation:} + + Quarks and gluons are fragmented into hadrons using the +independent fragmentation ansatz of Field and Feynman. For a quark +$q$, a new quark-antiquark pair $q_1 \bar q_1$ is generated with +$$ +u : d : s = .43 : .43 : .14 +$$ +A meson $q \bar q_1$ is formed carrying a fraction $z$ of the momentum, +$$ +E' + p_z' = z (E + p_z) +$$ +and having a transverse momentum $p_t$ with $\langle p_t \rangle = +0.35\,\GeV$. Baryons are included by generating a diquark with +probability 0.10 instead of a quark; adjacent diquarks are not +allowed, so no exotic mesons are formed. For light quarks $z$ is +generated with the splitting function +$$ +f(z) = 1-a + a(b+1)(1-z)^b, \qquad +a = 0.96, b = 3 +$$ +while for heavy quarks the Peterson form +$$ +f(z) = x (1-x)^2 / ( (1-x)^2 + \epsilon x )^2 +$$ +is used with $\epsilon = .80 / m_c^2$ for $c$ and $\epsilon = .50 / +m_q^2$ for $q = b, t, y, x$. These values of $\epsilon$ have been +determined by fitting PEP, PETRA, and LEP data with ISAJET and should +not be compared with values from other fits. Hadrons with longitudinal +momentum less than zero are discarded. The procedure is then iterated +for the new quark $q_1$ until all the momentum is used. A gluon is +fragmented like a randomly selected $u$, $d$, or $s$ quark or +antiquark. + + In the fragmentation of gluinos and scalar quarks, supersymmetric +hadrons are not distinguished from partons. This should not matter +except possibly for very light masses. The Peterson form for $f(x)$ is +used with the same value of epsilon as for heavy quarks, $\epsilon = +0.5 / m^2$. + + Independent fragmentation correctly describes the fast hadrons in +a jet, but it fails to conserve energy or flavor exactly. Energy +conservation is imposed after the event is generated by boosting the +hadrons to the appropriate rest frame, rescaling all of the +three-momenta, and recalculating the energies. + +\subsection{Beam Jets} + + There is now experimental evidence that beam jets are different in +minimum bias events and in hard scattering events. ISAJET therefore uses +similar a algorithm but different parameters in the two cases. + + The standard models of particle production are based on pulling +pairs of particles out of the vacuum by the QCD confining field, +leading naturally to only short-range rapidity correlations and to +essentially Poisson multiplicity fluctuations. The minimum bias data +exhibit KNO scaling and long-range correlations. A natural explanation +of this was given by the model of Abramovskii, Kanchelli and Gribov. +In their model the basic amplitude is a single cut Pomeron with +Poisson fluctuations around an average multiplicity $\langle n +\rangle$, but unitarity then produces graphs giving $K$ cut Pomerons +with multiplicity $K\langle n \rangle$. + + A simplified version of the AKG model is used in ISAJET. The +number of cut Pomerons is chosen with a distribution adjusted to fit the +data. For a minimum bias event this distribution is +$$ +P(K) = ( 1 + 4 K^2 ) \exp{-1.8 K} +$$ +while for hard scattering +$$ +P(1) \to 0.1 P(1),\quad P(2) \to 0.2 P(2),\quad P(3) \to 0.5 P(3) +$$ +For each side of each event an $x_0$ for the leading baryon is selected +with a distribution varying from flat for $K = 1$ to like that for +mesons for large K: +$$ +f(x) = N(K) (1- x_0)^c(K),\qquad c(K) = 1/K + ( 1 - 1/K ) b(s) +$$ +The $x_i$ for the cut Pomerons are generated uniformly and then +rescaled to $1-x_0$. Each cut Pomeron is then hadronized in its own +center of mass using a modified independent fragmentation model with +an energy dependent splitting function to reproduce the rise in +$dN/dy$: +$$ +f(x) = 1 - a + a(b(s) + 1)^ b(s),\qquad +b(s) = b_0 + b_1 \log(s) +$$ +The energy dependence is put into $f(x)$ rather than $P(K)$ because in +the AKG scheme the single particle distribution comes only from the +single chain. The probabilities for different flavors are taken to be +$$ +u : d : s = .46 : .46 : .08 +$$ +to reproduce the experimental $K/\pi$ ratio. diff --git a/ISAJET/doc/sample.doc b/ISAJET/doc/sample.doc new file mode 100644 index 00000000000..1af9b8a897f --- /dev/null +++ b/ISAJET/doc/sample.doc @@ -0,0 +1,338 @@ +\newpage +\section{Sample Jobs\label{SAMPLE}} + + The simplest ISAJET job reads a user-supplied parameter file and +writes a data file and a listing file. The following is an example of +a parameter file which generates each type of event: +\begin{verbatim} +SAMPLE TWOJET JOB +800.,100,2,50/ +TWOJET +PT +50,100,50,100/ +JETTYPE1 +'GL'/ +JETTYPE2 +'UP','UB','DN','DB','ST','SB'/ +END +SAMPLE DRELLYAN JOB +800.,100,2,50/ +DRELLYAN +QMW +80,100/ +WTYPE +'W+','W-'/ +END +SAMPLE MINBIAS JOB +800.,100,2,50/ +MINBIAS +END +SAMPLE WPAIR JOB +800.,100,2,50/ +WPAIR +PT +50,100,50,100/ +JETTYPE1 +'W+','W-','Z0'/ +JETTYPE2 +'W+','W-','Z0'/ +WMODE1 +'E+','E-','NUS'/ +WMODE2 +'QUARKS'/ +END +SAMPLE HIGGS JOB FOR SSC +40000,100,1,1/ +HIGGS +QMH +400,1600/ +HMASS +800/ +JETTYPE1 +'Z0'/ +JETTYPE2 +'Z0'/ +WMODE1 +'MU+','MU-'/ +WMODE2 +'E+','E-'/ +PT +50,20000,50,20000/ +END +SAMPLE SUSY JOB +1800,100,1,10/ +SUPERSYM +PT +50,100,50,100/ +JETTYPE1 +'GLSS','SQUARKS'/ +JETTYPE2 +'GLSS','SQUARKS'/ +GAUGINO +60,1,40,40/ +SQUARK +80.3,80.3,80.5,81.6,85,110/ +FORCE +29,30,1,-1/ +FORCE +21,29,1/ +FORCE +22,29,2/ +FORCE +23,29,3/ +FORCE +24,29,4/ +FORCE +25,29,5/ +FORCE +26,29,6/ +END +SAMPLE MSSM JOB FOR TEVATRON +1800.,100,1,1/ +SUPERSYM +BEAMS +'P','AP'/ +MSSMA +200,-200,500,2/ +MSSMB +200,200,200,200,200/ +MSSMC +200,200,200,200,200,0,0,0/ +JETTYPE1 +'GLSS'/ +JETTYPE2 +'SQUARKS'/ +PT +100,300,100,300/ +END +SAMPLE MSSM SUGRA JOB FOR LHC +14000,100,1,10/ +SUPERSYM +PT +50,500,50,500/ +SUGRA +247,302,-617.5,10,-1/ +TMASS +175/ +END +SAMPLE SUGRA HIGGS JOB USING DEFAULT QMH RANGE +14000,100,20,50/ +HIGGS +SUGRA +200,200,0,2,+1/ +HTYPE +'HA0'/ +JETTYPE1 +'GAUGINOS','SLEPTONS'/ +JETTYPE2 +'GAUGINOS','SLEPTONS'/ +END +SAMPLE E+E- TO SUGRA JOB WITH POLARIZED BEAMS AND BREM/BEAMSTRAHLUNG +500.,100,1,1/ +E+E- +SUGRA +125,125,0,3,1/ +TMASS +175,-1,1/ +EPOL +-.9,0./ +EEBEAM +200.,500.,.1072,.12/ +JETTYPE1 +'ALL'/ +JETTYPE2 +'ALL'/ +NTRIES +10000/ +END +SAMPLE WH JOB +2000,100,0,0/ +WHIGGS +BEAMS +'P','AP'/ +HMASS +100./ +JETTYPE1 +'W+','W-','HIGGS'/ +JETTYPE2 +'W+','W-','HIGGS'/ +WMODE1 +'ALL'/ +WMODE2 +'ALL'/ +PT +10,300,10,300/ +END +SAMPLE EXTRA DIMENSIONS JOB +14000,100,1,100/ +EXTRADIM +QMW +5,1000/ +QTW +500,1000/ +EXTRAD +2,1000,.FALSE./ +END +SAMPLE ZJJ JOB AT LHC +14000,100,1,100/ +ZJJ +PT +20,7000,20,7000,20,7000/ +MIJLIM +0,0,20,7000/ +MTOT +100,500/ +NSIGMA +200/ +NTRIES +10000/ +END +STOP +\end{verbatim} +\noindent See Section~\ref{INPUT} of this manual for a complete list +of the possible commands in a parameter file. Note that all input to +ISAJET must be in {\it UPPER} case only. + + Subroutine RDTAPE is supplied to read events from an ISAJET data +file, which is a machine-dependent binary file. It restores the event +data to the FORTRAN common blocks described in Section~\ref{OUTPUT}. +The skeleton of an analysis job using HBOOK and PAW from the CERN +Program Library is provided in patch ISAPLT but is not otherwise +supported. A Zebra output format based on code from the D0 +Collaboration is also provided in patch ISAZEB; see the separate +documentation in patch ISZTEXT. + +\subsection{DEC VMS} + + On a VAX or ALPHA running VMS, ISAJET can be compiled by +executing the .COM file contained in P=ISAUTIL,D=MAKEVAX. Extract this +deck as ISAMAKE.COM and type +\begin{verbatim} +@ISAMAKE +\end{verbatim} +This will run YPATCHY with the pilot patches described in +Section~\ref{PATCHY} and the VAX flag to extract the source code, +decay table, and documentation. The source code is compiled and made +into a library, which is linked with the following main program, +\begin{verbatim} + PROGRAM ISARUN +C MAIN PROGRAM FOR ISAJET + OPEN(UNIT=1,STATUS='OLD',FORM='FORMATTED',READONLY) + OPEN(UNIT=2,STATUS='NEW',FORM='UNFORMATTED') + OPEN(UNIT=3,STATUS='OLD',FORM='FORMATTED') + OPEN(UNIT=4,STATUS='NEW',FORM='FORMATTED') + CALL ISAJET(-1,2,3,4) + STOP + END +\end{verbatim} +to produce ISAJET.EXE. Two other executables, ISASUSY.EXE and +ISASUGRA.EXE, will also be produced to calculate SUSY masses and decay +modes without generating events. Temporary files can be removed by +typing +\begin{verbatim} +@ISAMAKE CLEAN +\end{verbatim} + + Create an input file \verb|JOBNAME.PAR| following the examples +above or the instructions in Section~\ref{INPUT} and run ISAJET with +the command +\begin{verbatim} +@ISAJET JOBNAME +\end{verbatim} +using the ISAJET.COM file contained P=ISAUTIL,D=RUNVAX. This will +create a binary output file \verb|JOBNAME.DAT| and a listing file +\verb|JOBNAME.LIS|. Analyze the output data using the commands +described in Section~\ref{TAPE}. + + There is also an simple interactive interface to ISAJET which +will prompt the user for commands, write a parameter file, and +optionally execute it. + +\subsection{IBM VM/CMS} + + On an IBM mainframe running VM/CMS, run YPATCHY with the pilot +patches described in Section~\ref{PATCHY} and the IBM flag to extract +the source code, decay table, and documentation. Compile the source +code and link it with the main program +\begin{verbatim} + PROGRAM ISARUN +C MAIN PROGRAM FOR ISAJET + OPEN(UNIT=1,STATUS='OLD',FORM='FORMATTED') + OPEN(UNIT=2,STATUS='NEW',FORM='UNFORMATTED') + OPEN(UNIT=3,STATUS='OLD',FORM='FORMATTED') + OPEN(UNIT=4,STATUS='NEW',FORM='FORMATTED') + CALL ISAJET(-1,2,3,4) + STOP + END +\end{verbatim} +to make ISAJET MODULE. + + Create a file called \verb|JOBNAME INPUT| containing ISAJET +input commands following the examples above or the instructions in +Section~\ref{INPUT}. Then run ISAJET using ISAJET EXEC, which is +contained in P=ISAUTIL,D=RUNIBM. The events will be produced on +\verb|JOBNAME DATA A| and the listing on \verb|JOBNAME OUTPUT A|. + +\subsection{Unix} + + The Makefile contained in P=ISAUTIL,D=MAKEUNIX has been tested +on DEC Ultrix, Hewlett Packard HP-UX, IBM RS/6000 AIX, Linux, Silicon +Graphics IRIX, Sun SunOS, and Sun Solaris. It should work with minor +modifications on almost any Unix system with /bin/csh, \verb|ypatchy| +or \verb|nypatchy|, and a reasonable Fortran 77 compiler. Extract the +Makefile and edit it, changing the installation parameters to reflect +your system. Note in particular that CERNlib is usually compiled with +underscores postpended to all external names; you must choose the +appropriate compiler option if you intend to link with it. Then type +\begin{verbatim} +make +\end{verbatim} +This should produce an executable \verb|isajet.x| for the event +generator, which links the code with the following main program: +\begin{verbatim} + PROGRAM RUNJET + CHARACTER*60 FNAME + READ 1000, FNAME +1000 FORMAT(A) + PRINT 1020, FNAME +1020 FORMAT(1X,'Data file = ',A) + OPEN(2,FILE=FNAME,STATUS='NEW',FORM='UNFORMATTED') + READ 1000, FNAME + PRINT 1030, FNAME +1030 FORMAT(1X,'Parameter file = ',A) + OPEN(3,FILE=FNAME,STATUS='OLD',FORM='FORMATTED') + READ 1000, FNAME + PRINT 1040, FNAME +1040 FORMAT(1X,'Listing file = ',A) + OPEN(4,FILE=FNAME,STATUS='NEW',FORM='FORMATTED') + READ 1000, FNAME + OPEN(1,FILE=FNAME,STATUS='OLD',FORM='FORMATTED') + CALL ISAJET(-1,2,3,4) + STOP + END +\end{verbatim} +Two other executables, \verb|isasusy.x| and \verb|isasugra.x|, will +also be produced to calculate SUSY masses and decay modes without +generating events. Type +\begin{verbatim} +make clean +\end{verbatim} +to delete the temporary files. + + Most Unix systems do not allow two jobs to read the same decay +table file at the same time. The shell script in P=ISAUTIL,D=RUNUNIX +copies the decay table to a temporary file to avoid this problem. +Extract this file as \verb|isajet|. Create an input file +\verb|jobname.par| following the examples above or the instructions in +Section~\ref{INPUT} and run ISAJET with the command +\begin{verbatim} +isajet jobname +\end{verbatim} +This will create a binary output file \verb|jobname.dat| and a listing +file \verb|jobname.lis|. Analyze the output data using the commands +described in Section~\ref{TAPE}. + + This section only describes running ISAJET as a standalone +program and generating output in machine-dependent binary form. The +user may elect to analyze events as they are generated; this is +discussed in Section~\ref{MAIN} of this manual. diff --git a/ISAJET/doc/susy.doc b/ISAJET/doc/susy.doc new file mode 100644 index 00000000000..4a70d9258d6 --- /dev/null +++ b/ISAJET/doc/susy.doc @@ -0,0 +1,306 @@ +\newpage +\section{ISASUSY: Decay Modes in the Minimal Supersymmetric +Model\label{SUSY}} + + The code in patch ISASUSY of ISAJET calculates decay modes of +supersymmetric particles based on the work of H. Baer, M. Bisset, M. +Drees, D. Dzialo (Karatas), X. Tata, J. Woodside, and their +collaborators. The calculations assume the minimal supersymmetric +extension of the standard model. The user specifies the gluino mass, +the pseudoscalar Higgs mass, the Higgsino mass parameter $\mu$, +$\tan\beta$, the soft breaking masses for the first and third +generation left-handed squark and slepton doublets and right-handed +singlets, and the third generation mixing parameters $A_t$, $A_b$, and +$A_\tau$. Supersymmetric grand unification is assumed by default in +the chargino and neutralino mass matrices, although the user can +optionally specify arbitrary $U(1)$ and $SU(2)$ gaugino masses at the +weak scale. The first and second generations are assumed by default to +be degenerate, but the user can optionally specify different values. +These inputs are then used to calculate the mass eigenstates, mixings, +and decay modes. + + Most calculations are done at the tree level, but one-loop +results for gluino loop decays, $H \to \gamma\gamma$ and $H \to gg$, loop +corrections to the Higgs mass spectrum and couplings, and leading-log +QCD corrections to $H \to q \bar q$ are included. The Higgs masses have +been calculated using the effective potential approximation including +both top and bottom Yukawa and mixing effects. Mike Bisset and Xerxes +Tata have contributed the Higgs mass, couplings, and decay routines. +Manuel Drees has calculated several of the three-body decays including +the full Yukawa contribution, which is important for large tan(beta). +Note that e+e- annihilation to SUSY particles and SUSY Higgs bosons +have been included in ISAJET versions $>7.11$. ISAJET versions $>7.22$ +include the large $\tan\beta$ solution as well as non-degenerate +sfermion masses. + +Other processes may be added in future versions as the physics +interest warrants. Note that +the details of the masses and the decay modes can be quite sensitive +to choices of standard model parameters such as the QCD coupling ALFA3 +and the quark masses. To change these, you must modify subroutine +SSMSSM. By default, ALFA3=.12. + + All the mass spectrum and branching ratio calculations in ISASUSY +are performed by a call to subroutine SSMSSM. Effective with version 7.23, +the calling sequence is +\begin{verbatim} + SUBROUTINE SSMSSM(XMG,XMU,XMHA,XTANB,XMQ1,XMDR,XMUR, + $XML1,XMER,XMQ2,XMSR,XMCR,XML2,XMMR,XMQ3,XMBR,XMTR, + $XML3,XMLR,XAT,XAB,XAL,XM1,XM2,XMT,IALLOW) +\end{verbatim} +where the following are taken to be independent parameters: + +\smallskip\noindent +\begin{tabular}{lcl} + XMG &=& gluino mass\\ + XMU &=& $\mu$ = SUSY Higgs mass\\ + &=& $-2*m_1$ of Baer et al.\\ + XMHA &=& pseudo-scalar Higgs mass\\ + XTANB &=& $\tan\beta$, ratio of vev's\\ + &=& $1/R$ (of old Baer-Tata notation).\\ +\end{tabular} + +\noindent +\begin{tabular}{lcl} + XMQ1 &=& $\tilde q_l$ soft mass, 1st generation\\ + XMDR &=& $\tilde d_r$ mass, 1st generation\\ + XMUR &=& $\tilde u_r$ mass, 1st generation\\ + XML1 &=& $\tilde \ell_l$ mass, 1st generation\\ + XMER &=& $\tilde e_r$ mass, 1st generation\\ +\\ + XMQ2 &=& $\tilde q_l$ soft mass, 2nd generation\\ + XMSR &=& $\tilde s_r$ mass, 2nd generation\\ + XMCR &=& $\tilde c_r$ mass, 2nd generation\\ + XML2 &=& $\tilde \ell_l$ mass, 2nd generation\\ + XMMR &=& $\tilde\mu_r$ mass, 2nd generation\\ +\\ + XMQ3 &=& $\tilde q_l$ soft mass, 3rd generation\\ + XMBR &=& $\tilde b_r$ mass, 3rd generation\\ + XMTR &=& $\tilde t_r$ mass, 3rd generation\\ + XML3 &=& $\tilde \ell_l$ mass, 3rd generation\\ + XMTR &=& $\tilde \tau_r$ mass, 3rd generation\\ + XAT &=& stop trilinear term $A_t$\\ + XAB &=& sbottom trilinear term $A_b$\\ + XAL &=& stau trilinear term $A_\tau$\\ +\\ + XM1 &=& U(1) gaugino mass\\ + &=& computed from XMG if > 1E19\\ + XM2 &=& SU(2) gaugino mass\\ + &=& computed from XMG if > 1E19\\ +\\ + XMT &=& top quark mass\\ +\end{tabular} +\smallskip + +\noindent The variable IALLOW is returned: + +\smallskip\noindent +\begin{tabular}{lcl} + IALLOW &=& 1 if Z1SS is not LSP, 0 otherwise\\ +\end{tabular} +\smallskip + +\noindent All variables are of type REAL except IALLOW, which is +INTEGER, and all masses are in GeV. The notation is taken to +correspond to that of Haber and Kane, although the Tata Lagrangian is +used internally. All other standard model parameters are hard wired in +this subroutine; they are not obtained from the rest of ISAJET. The +theoretically favored range of these parameters is +\begin{eqnarray*} +& 50 < M(\tilde g) < 2000\,\GeV &\\ +& 50 < M(\tilde q) < 2000\,\GeV &\\ +& 50 < M(\tilde\ell) < 2000\,\GeV &\\ +& -1000 < \mu < 1000\,\GeV &\\ +& 1 < \tan\beta < m_t/m_b &\\ +& M(t) \approx 175\,\GeV &\\ +& 50 < M(A) < 2000\,\GeV &\\ +& M(\tilde t_l), M(t_r) < M(\tilde q) &\\ +& M(\tilde b_r) \sim M(\tilde q) &\\ +& -1000 < A_t < 1000\,\GeV &\\ +& -1000 < A_b < 1000\,\GeV & +\end{eqnarray*} +It is assumed that the lightest supersymmetric particle is the lightest +neutralino $\tilde Z_1$, the lighter stau $\tilde\tau_1$, or the +gravitino $\tilde G$ in GMSB models. Some choices of the above +parameters may violate this assumption, yielding a light chargino or +light stop squark lighter than $\tilde Z_1$. In such cases SSMSSM does +not compute any branching ratios and returns IALLOW = 1. + + SSMSSM does not check the parameters or resulting masses against +existing experimental data. SSTEST provides a minimal test. This routine +is called after SSMSSM by ISAJET and ISASUSY and prints suitable warning +messages. + + SSMSSM first calculates the other SUSY masses and mixings and puts +them in the common block /SSPAR/: +\begin{verbatim} +#include "sspar.inc" +\end{verbatim} +It then calculates the widths and branching ratios and puts them in the +common block /SSMODE/: +\begin{verbatim} +#include "ssmode.inc" +\end{verbatim} +Decay modes for a given particle are not necessarily adjacent in this +common block. Note that the branching ratio calculations use the full +matrix elements, which in general will give nonuniform distributions in +phase space, but this information is not saved in /SSMODE/. In +particular, the decays $H \to Z + Z^* \to Z + f + \bar f$ give no +indication that the $f \bar f$ mass is strongly peaked near the upper +limit. + + All IDENT codes are defined by parameter statements in the PATCHY +keep sequence SSTYPE: +\begin{verbatim} +#include "sstype.inc" +\end{verbatim} +These are based on standard ISAJET but can be changed to interface with +other generators. Since masses except the t mass are hard wired, one +should check the kinematics for any decay before using it with possibly +different masses. + + Instead of specifying all the SUSY parameters at the electroweak +scale using the MSSMi commands, one can instead use the SUGRA parameter +to specify in the minimal supergravity framework the common scalar mass +$m_0$, the common gaugino mass $m_{1/2}$, and the soft trilinear SUSY +breaking parameter $A_0$ at the GUT scale, the ratio $\tan\beta$ of +Higgs vacuum expectation values at the electroweak scale, and $\sgn\mu$, +the sign of the Higgsino mass term. The \verb|NUSUGi| keywords allow one +to break the assumption of universality in various ways. \verb|NUSUG1| +sets the gaugino masses; \verb|NUSUG2| sets the $A$ terms; \verb|NUSUG3| +sets the Higgs masses; \verb|NUSUG4| sets the first generation squark +and slepton masses; and \verb|NUSUG5| sets the third generation masses. +The keyword \verb|SSBCSC| can be used to specify an alternative scale +(i.e., not the coupling constant unification scale) for the RGE boundary +conditions. + + The renormalization group equations now include all the two-loop +terms for both gauge and Yukawa couplings and the possible contributions +from right-handed neutrinos. These equations are solved iteratively using +Runge-Kutta numerical integration to determine the weak scale parameters +from the GUT scale ones: +\begin{enumerate} +% +\item The RGE's are run from the weak scale $M_Z$ up to the GUT scale, +where $\alpha_1 = \alpha_2$, taking all thresholds into account. We use +two loop RGE equations for the gauge couplings only. +% +\item The GUT scale boundary conditions are imposed, and the RGE's are +run back to $M_Z$, again taking thresholds into account. +% +\item The masses of the SUSY particles and the values of the soft +breaking parameters B and mu needed for radiative symmetry are +computed, e.g. +$$ +\mu^2(M_Z) = {M_{H_1}^2 - M_{H_2}^2 \tan^2\beta \over +\tan^2\beta-1} - M_Z^2/2 +$$ +These couplings are frozen out at the scale $\sqrt{M(t_L)M(t_R)}$. +% +\item The 1-loop radiative corrections are computed. +% +\item The process is then iterated until stable results are obtained. +\end{enumerate} +This is essentially identical to the procedure used by several other +groups. Other possible constraints such as $b$-$\tau$ unification and +limits on proton decay have not been included. + + An alternative to the SUGRA model is the Gauge Mediated SUSY +Breaking (GMSB) model of Dine and Nelson, Phys.\ Rev.\ {\bf D48}, 1277 +(1973); Dine, Nelson, Nir, and Shirman, Phys.\ Rev.\ {\bf D53}, 2658 +(1996). In this model SUSY is broken dynamically and communicated to the +MSSM through messenger fields at a messenger mass scale $M_m$ much less +than the Planck scale. If the messenger fields are in complete +representations of $SU(5$), then the unification of couplings suggested +by the LEP data is preserved. The simplest model has a single $5+\bar5$ +messenger sector with a mass $M_m$ and and a SUSY-breaking VEV $F_m$ of +its auxiliary field $F$. Gauginos get masses from one-loop graphs +proportional to $\Lambda_m = F_m / M_m$ times the appropriate gauge +coupling $\alpha_i$; sfermions get squared-masses from two-loop graphs +proportional to $\Lambda_m$ times the square of the appropriate +$\alpha_i$. If there are $N_5$ messenger fields, the gaugino masses and +sfermion masses-squared each contain a factor of $N_5$. + + The parameters of the GMSB model implemented in ISAJET are +\begin{itemize} +\item $\Lambda_m = F_m/M_m$: the scale of SUSY breaking, typically +10--$100\,{\rm TeV}$; +\item $M_m > \Lambda_m$: the messenger mass scale, at which the boundary +conditions for the renormalization group equations are imposed; +\item $N_5$: the equivalent number of $5+\bar5$ messenger fields. +\item $\tan\beta$: the ratio of Higgs vacuum expectation values at the +electroweak scale; +\item $\sgn\mu=\pm1$: the sign of the Higgsino mass term; +\item $C_{\rm grav}\ge1$: the ratio of the gravitino mass to the value it +would have had if the only SUSY breaking scale were $F_m$. +\end{itemize} +The solution of the renormalization group equations is essentially the +same as for SUGRA; only the boundary conditions are changed. In +particular it is assumed that electroweak symmetry is broken radiatively +by the top Yukawa coupling. + + In GMSB models the lightest SUSY particle is always the nearly +massless gravitino $\tilde G$. The phenomenology depends on the nature +of the next lightest SUSY particle (NLSP) and on its lifetime to decay +to a gravitino. The NLSP can be either a neutralino $\tilde\chi_1^0$ or +a slepton $\tilde\tau_1$. Its lifetime depends on the gravitino mass, +which is determined by the scale of SUSY breaking not just in the +messenger sector but also in any other hidden sector. If this is set by +the messenger scale $F_m$, i.e., if $C_{\rm grav}\approx1$, then this +lifetime is generally short. However, if the messenger SUSY breaking +scale $F_m$ is related by a small coupling constant to a much larger +SUSY breaking scale $F_b$, then $C_{\rm grav}\gg1$ and the NLSP can be +long-lived. The correct scale is not known, so $C_{\rm grav}$ should be +treated as an arbitrary parameter. More complicated GMSB models may be +run by using the GMSB2 keyword. + + Patch ISASSRUN of ISAJET provides a main program SSRUN and some +utility programs to produce human readable output. These utilities must +be rewritten if the IDENT codes in /SSTYPE/ are modified. To create the +stand-alone version of ISASUSY with SSRUN, run YPATCHY on isajet.car +with the following cradle (with \verb|&| replaced by \verb|+|): +\begin{verbatim} +&USE,*ISASUSY. Select all code +&USE,NOCERN. No CERN Library +&USE,IMPNONE. Use IMPLICIT NONE +&EXE. Write everything to ASM +&PAM,T=C. Read PAM file +&QUIT. Quit +\end{verbatim} +Compile, link, and run the resulting program, and follow the prompts for +input. Patch ISASSRUN also contains a main program SUGRUN that reads +the minimal SUGRA, non-universal SUGRA, or GMSB parameters, solves the +renormalization group equations, and calculates the masses and branching +ratios. To create the stand-alone version of ISASUGRA, run YPATCHY with +the following cradle: +\begin{verbatim} +&USE,*ISASUGRA. Select all code +&USE,NOCERN. No CERN Library +&USE,IMPNONE. Use IMPLICIT NONE +&EXE. Write everything to ASM +&PAM. Read PAM file +&QUIT. Quit +\end{verbatim} +The documentation for ISASUSY and ISASUGRA is included with that for +ISAJET. + + ISASUSY is written in ANSI standard Fortran 77 except that +IMPLICIT NONE is used if +USE,IMPNONE is selected in the Patchy cradle. +All variables are explicitly typed, and variables starting with +I,J,K,L,M,N are not necessarily integers. All external names such as +the names of subroutines and common blocks start with the letters SS. +Most calculations are done in double precision. If +USE,NOCERN is +selected in the Patchy cradle, then the Cernlib routines EISRS1 and its +auxiliaries to calculate the eigenvalues of a real symmetric matrix and +DDILOG to calculate the dilogarithm function are included. Hence it is +not necessary to link with Cernlib. + + The physics assumptions and details of incorporating the Minimal +Supersymmetric Model into ISAJET have appeared in a conference +proceedings entitled ``Simulating Supersymmetry with ISAJET 7.0/ISASUSY +1.0'' by H. Baer, F. Paige, S. Protopopescu and X. Tata; this has +appeared in the proceedings of the workshop on {\sl Physics at Current +Accelerators and Supercolliders}, ed.\ J. Hewett, A. White and D. +Zeppenfeld, (Argonne National Laboratory, 1993). Detailed references +may be found therein. Users wishing to cite an appropriate source may +cite the above report. diff --git a/ISAJET/doc/tape.doc b/ISAJET/doc/tape.doc new file mode 100644 index 00000000000..f8e45404169 --- /dev/null +++ b/ISAJET/doc/tape.doc @@ -0,0 +1,62 @@ +\newpage +\section{File Reading\label{TAPE}} + + The FORTRAN instruction +\begin{verbatim} + CALL RDTAPE(IDEV,IFL) +\end{verbatim} +will read a beginning record, an end record or an event (which can be +more than one record). IDEV is the tape number and +\begin{verbatim} + IFL=0 for a good read, + IFL=-1 for an end of file. +\end{verbatim} +The information is restored to the common blocks described above. The +type of record is contained in +\begin{verbatim} +#include "rectp.inc" +\end{verbatim} +\begin{tabular}{lcl} +IRECTP &=& 100 for an event record\\ +IRECTP &=& 200 for a beginning record\\ +IRECTP &=& 300 for an end record\\ +IREC &=& no. of physical records in event record, 0 + otherwise\\ +\end{tabular} + + The parton momenta from the primary hard scattering are +contained in /PJETS/. The parton momenta generated by the QCD cascade +are contained in /JETSET/. The hadron momenta both from the QCD jets +and from the beam jets are contained in /PARTCL/. The final hadron +momenta and the associated pointers should be used to calculate the +jet momenta, since they are changed both by the QCD cascade and by +hadronization. Particles with IDCAY=0 are stable, while the others are +resonances. + + The weight per event needed to produce a weighted histogram in +millibarn units is SIGF/NEVENT. The integrated cross section SIGF is +calculated by Monte Carlo integration during the run for the given +kinematic limits and JETTYPE, WTYPE, and WMODE selections. Any of three +methods can be used to find the value of SIGF: + + (1) The current value, which is written out with each event, can +be used. To prevent enormous fluctuations at the beginning of a run, +NSIGMA extra primary parton events are generated first. The default +value, NSIGMA = 20, gives negligible overhead but may not be large +enough for good accuracy. + + (2) The value SIGF calculated with the full statistics of the run +can be obtained by reading through the tape until an end record +(IRECTP=300) is found. After SIGF is saved with a different name, the +first event record for the run can be found by backspacing the tape +NRECS times. + + (3) Unweighted histograms can be made for the run and the weight +added after the end record is found. An implementation of this using +special features of HBOOK is contained in ISAPLT. + + The functions AMASS(IDENT), CHARGE(IDENT), and LABEL(IDENT) are +available to determine the mass, charge, and character label in A8 +format. Subroutine FLAVOR returns the quark content of any hadron and +may be useful to convert IDENT codes to other schemes. CALL PRTEVT(0) +prints an event. diff --git a/ISAJET/doc/ztext.doc b/ISAJET/doc/ztext.doc new file mode 100644 index 00000000000..9c4dea75f94 --- /dev/null +++ b/ISAJET/doc/ztext.doc @@ -0,0 +1,706 @@ +* +* $Id$ +* +* $Log$ +* Revision 1.1.1.1 1996/03/08 17:27:17 mclareni +* Isajet714 +* +* + + ISAJET ZEBRA INTERFACE + F.E. Paige and S.D. Protopopescu + Physics Department + Brookhaven National Laboratory + Upton, NY 11973 + March 30, 1991 + + + [1] Overview + ============ + + The ZEBRA version of ISAJET contains subroutines which replace the +usual output package for ISAJET with one using the CERN package ZEBRA. +This version provides some features which are not part of the standard +ISAJET output. Momenta and masses of the partons are rescaled from the +final particles so that they match exactly (this is not so in ISAJET). +Resonances decaying strongly are not part of the particle list while +particles with heavy quarks decaying weakly are part of a vertex list with +the corresponding vertex position and appropriate links to the particles +belonging to that vertex. Thus there is no need to generate secondary +vertices for charmed or other heavy quark particles and the event structure +makes it easy to find which particles come from the decay of a heavy quark. +The association of particles with parent partons is also made easy by +reference links. For simple calorimeter studies banks are also provided +with energy sums over calorimeter cells and banks containing only the +leptons (see below). If only those are written instead of particle banks +the resulting files are more compact and require considerably less CPU time +to analyze (albeit the information is rather limited). In addition jets are +calculated by using a cone algorithm on the partons, these can be useful +for studying efficiencies of jet finding algorithms and comparing results +to theoretical jets. The results of parton jets are in Zebra banks PJET. + + NOTE: The present version can only handle one run at a time, so you +cannot supply a command file with many runs for now. This problem will be +fixed in a future release. + + [2] Creating and running a job + ============================== + + There are command files in BNLCL6::$2$DUA14:[ISAJET.ISALIBRARY] to make +EXE files for event generation and analysis. + + To make an EXE generating ISAJET events which are then written to +a file in ZEBRA format users should run command file: + +$ @isa$area:MAKE_ISAJET_ZEBRA + +this starts from ISAJET.PAM and makes ISAJET_ZEBRA.FOR, ISAJET_ZEBRA.OLB +and ISAJET_ZEBRA.EXE. It requires that ISA$AREA de defined as the area +where ISAJET.PAM and command files reside. It also requires that CERN$AREA +be defined as the area for the CERN libraries. The above command file +assumes symbol YPATCHY is defined. If running on a machine other than a VAX +looking at the command file should give a pretty good idea of what needs to +be done. + +If you already have ISAJET_ZEBRA.OLB you can run command file + +$ @isa$area:LINK_ISAJET_ZEBRA + +to make ISAJET_ZEBRA.EXE, this program runs with an interactive +dialog to generate ISAJET instructions. You can supply your own +ISARUN main program if you wish to bypass the dialog, see command +file MAKE_ISAJET.COM for the simplest example. + +User can provide any of 3 logical functions to reduce the +size of output files: +1) EDIT(I) = if false event will not be written out + I is event number + Zebra banks have not yet been generated, so + user must work from standard ISAJET common blocks +2) ISEDIT() = same as EDIT but Zebra banks have been filled +3) PEDIT(ID,P) = if false particle will not be included in + the list of particles written out + ID= particle ID, P(4)= particle momentum vector + + +To generate a user program that reads an ISAJET output file in ZEBRA +format users should run + +$ @isa$area:MAKE_ISZRUN +this makes a sample user analysis subroutine ISZUSR and an ISZRUN.EXE +program. ISZUSR gives an example of how to use the utility subroutines +mentioned in next section for analysis. + +If user already has an ISZUSR subroutine he can generate ISZRUN.EXE by + +$ @isa$area:LINK_ISZRUN + + + [3] Utilities + ============= + + A number of utilities are provided for the user to make it easier for +him to use the information in ZEBRA form without him having to learn much +about ZEBRA. It is nevertheless recommended that the user familiarize +himself with ZEBRA by reading the first chapter of the ZEBRA manual. Also +to make full use of the power of ZEBRA users may eventually want to +familiarize themselves with some of the utilities provided with it such as +MZDROP and ZSORT. + +o For every ZEBRA bank of name ISxx (most ISAJET ZEBRA banks start with + IS) there exist: + 1) GZISxx : an integer function returning pointer to first bank in + the linear structure + 2) GTISxx : a subroutine returning the contents of the bank + 3) PRISxx : a subroutine generating a printout of the banks with name ISxx + +o To generate a full dump: + CALL PRTEVZ(unit #) + This subroutine calls all the PRISxx subroutines. + +o Users can provide a primary vertex for each event by: + CALL SETVTX(XYZ) + where XYZ is a 3-vector with values x,y,z + To supply a function for the vertex user should supply subroutine + INTVTX(XYZ) which returns an XYZ vector with each call. The + default returns 0,0,0. + +o The parameters for generating PJET banks can be controlled by + CALL PJPSET(N,ALG,ETCUT,DRCUT,MAXIT,IR,MUON) + where + Default values + N = NUMBER OF PJET ALGORITHMS 1 + ALG = ALGORITHM TPYE 'CONE' OR 'ANGLE' 'CONE' + ETCUT = ET CUT FR PJET JETS 5.0 + DRCUT = CONE CUT (IN R OR ANGLE) 0.45 + MAXIT = MAXIMUM NUMBER OF ITERATIONS 1 + IR = INIT RADIATION FLAG 0=USE IR, 1=NO IR 0 + MUON = MUON FLAG 0=NO MUONS, 1=use MUONS in PJET 0 + + + Other subroutines of interest are: +o ISZJET find jets using ISCL banks +o ISZUSR example of a user subroutine for analysis + + + + [4] Other Subroutines + ===================== + + We list here the subroutines that are part of ISAJET_ZEBRA: + +GENVTX generate secondary vertices (for heavy quark decays) +ISABFL fill ISAB bank (begin of run bank) +ISACFL fill ISAC and ISCL banks (calorimeter description and + calorimeter cells with non-zero energy deposited). + Entry point ISACIN calculates all numbers needed for + calorimeter description. +ISAEFL fill ISAE bank (main header) +ISAFFL fill ISAF bank (end of run bank) +ISAJFL fill ISAJ banks (primary jets) +ISALFL fill ISAL banks (leptons) +ISAPFL fill ISV1 and ISP1 banks (vertices and particles) +ISAQFL fill ISAQ banks (secondary partons, both initial and final) +ISCMFL fill ISCM (copy of command instructions) +ISMEAR generates smeared calorimeter data (modifies ISCL banks) +PJETFL fill PJET banks (jets obtained from partons) +QRECAL to recalculate momenta and masses of partons starting + from the final particles + + + + + + [5] Brief description of Zebra banks + ==================================== + + The beginning and end of run records have Zebra banks named ISAB and +ISAF while the whole event hangs from Zebra bank ISAE. A complete +description of the banks is given in section [6]. + +ISAB data describing event generation (in beginning record) +ISCM copy of command file used for event generation( " ) +ISAF cumulative results from run (in end record) +ISAE general event information such as weight, type, etc. +ISAJ primary jet momenta and masses +ISAQ final and initial partons (momenta and masses) +ISV1 primary and short lived vertices (heavy quarks), includes + id,mass and 4-momenta of decaying particle +ISP1 particles associated with ISV1 (connected via a structural link) + id,mass and 4-momenta +ISAC simple calorimeter description (no depth) +ISCL energy deposition and cell description in calorimeter cell +ISMR description of smearing parameters +ISAL stable leptons (including neutrinos):id,mass and 4-momenta + with reference links to calorimeter cell and ISP1 if they + exist +ISJT jets found by subroutine ISZJET. +PJHD header for PJET banks +PJET jets found adding over partons +PJPT pointers to parton banks (ISAQ) contributing to a jet in PJET + + Whether banks ISV1,ISP1,ISAC,ISCL and ISAL are written out is +optional. The ISARUN job asks user to chose an option ISAP, ISAC or ISAL. +If ISAP is selected then ISV1 and ISP1 are written out, if ISAC then ISAC +and ISCL are written out and if ISAL then ISAL is written out. Any +combination can be selected, the instruction ISAPISACISAL causes all banks +to be written out. + + The banks ISJT are created by calling ISZJET, the banks ISAC and ISCL +must be available. One can create the banks ISAC,ISCL and/or ISAL starting +from a file containing ISV1 and ISP1 by calling ISACFL and/or ISALFL for +each event. + + + + [6] Zebra banks documentation + ============================= + + + +------------------+ + | ISAE | + | event descriptor | + | | + +------------------+ + struc. link ||| | | + ||| | +------------------------------+ + ||| +-----------------------------+ | + +-------+------------+| | | + | | | | | + ______ ______ ______ ______ | | + | ISAJ \ | ISAQ \ | ISV1 | | ISV1 \ | | + | -1 > | -2 > | -3 |--| (-3) > | | + |______/ |______/ |______| |______/ | | + : ^ | :...<..: | | | + : : | [-2] | | | + [PJET -1].<.. : | | | | + : [-2] ______ ______ | | + :.....| ISP1 \ | ISP1 \ | | + [PJET -3] ..<........| -1 > | -1 > | | + |______/ |______/ | | + : |[-1] : : : | | + [-4]: v <....: : :[-4] | | + : free <......: : | | + v v | | + ISV2 ISV2 | | + (end vertex) (end vertex) | | + | | + +------------+---------------------+ | + | | | + | | | + _________ ______ ______ + | ISAC | | ISAL \ | PJHD \ + | -6 | | -7 > | -8 > + |_________| |______/ |______/ + | | + +-------+---------+--+ ______ + | | | [ISAQ -1]..>.....| PJET \ + ______ ______ ______ | -1 > + | ISCL \ | ISMR \ | ISJT \ |______/ + | -1 > | -2 > | -3 > | + |______/ |______/ |______/ ______ + | PJPT | + [ISAQ]...<...| -1 | + |______| + + +-----------+ +-----------+ + | ISAB | | ISAF | + | begin run | | end run | + | | | | + +-----------+ +-----------+ + | + +----------+ + | ISCM | + | -1 | + +----------+ + + + +C======================================================================= +C +C Bank name: ISAC +C Author : SDP +C Date : June 14,1989 +C +C Calorimeter descriptor +C +C LQ Q/IQ +C ___________________________________________________________________________ +C -3 struct. to ISJT (jets found using ISZJET) +C -2 struct. to smearing parameters (ISMR) +C -1 struct. to calorimeter cells (ISCL) +C 0 next to next ISAC (only one at present) +C +1 up to ISAE +C +2 origin to ISAE for first and previous ISAC for others +C ............................................................................ +C I-5 calorimeter number +C -4 bank name, 'ISAC' +C -3 NL=2 +C -2 NS=0 +C -1 ND=6 +C 0 STATUS +C +1 I number of phi cells +C 2 I " eta " +C 3 F phi cell size +C 4 F eta " " +C 5 F minimum eta +C 6 F maximum eta +C======================================================================= + + + +C======================================================================= +C +C Bank name: ISAE +C Author : SDP +C Date : June 19,1986 DH add ISAM +C +C Top level bank and event descriptor for ISAZEB +C +C LQ Q/IQ +C ___________________________________________________________________________ +C -8 struct. to PJHD (parton jet structure header) +C -7 struct. to lepton bank (ISAL) +C -6 struct. to pseudo cal. (ISAC) +C -5 struct. to unassociated particles (ISP3) +C -4 struct. to long lived vertices (ISV2) +C -3 struct. to short " " (ISV1) +C -2 struct. to final/initial bank (ISAQ) +C -1 struct. to primary jet (ISAJ) +C 0 next to next ISAE +C +1 up +C +2 origin +C ............................................................................ +C I-5 bank number +C -4 bank name, 'ISAE' +C -3 NL=7 +C -2 NS=7 +C -1 ND=18 +C 0 STATUS +C +1 I event id(1) +C 2 I event id(2) +C 3 I event number +C 4 I reaction type +C 5 I number of primary jet banks +C 6 I " of stable parton banks (final+initial) +C 7 I " of PJET banks +C 8 I " of particle banks +C 9 I " of vertex banks +C 10 I " of lepton banks +C 11 F cross section in microbarns +C 12 F weight +C 13 F effective q**2 +C 14 F hard scattering invariant s +C 15 F " " " t +C 16 F " " " u +C 17 D Seed (part 1) +C 18 D Seed (part 2) +C======================================================================= + + + +C======================================================================= +C +C Bank name: ISAJ +C Author : SDP +C Date : June 19,1986 +C +C Primary jet information +C +C LQ Q/IQ +C ___________________________________________________________________________ +C L-1 ref. to parent primary (ISAJ) (0 if original) +C +0 next to next jet (ISAJ) +C +1 up to ISAE +C +2 origin to ISAE +C ............................................................................ +C I-5 Primary jet number +C -4 bank name, 'ISAJ' +C -3 NL=0 +C -2 NS=0 +C -1 ND=9 +C 0 STATUS +C +1 I jet ID +C 2 F px +C 3 F py +C 4 F pz +C 5 F p +C 6 F mass +C 7 F phi +C 8 F theta +C 9 F eta +C======================================================================= + + + +C======================================================================= +C +C Bank name: ISAL +C Author : SDP +C Date : June 19,1986 +C +C Lepton bank (from primary and short lived vertices) +C +C LQ Q/IQ +C ___________________________________________________________________________ +C L-4 ref. to particle bank (ISP1) +C -3 ref. to primary jet (ISAJ) +C -2 ref. to initial parton (ISAQ) +C -1 struct. (free) +C 0 next to next ISAL +C +1 up to ISAE +C +2 origin to ISAE for first and previous ISAL for others +C ............................................................................ +C I-5 particle number +C -4 bank name, 'ISAL' +C -3 NL=4 +C -2 NS=1 +C -1 ND=9 +C 0 STATUS +C +1 I ISAJET particle ID +C 2 F px +C 3 F py +C 4 F pz +C 5 F p +C 6 F mass +C 7 F phi +C 8 F theta +C 9 F eta +C======================================================================= + + + +C======================================================================= +C +C Bank name: ISAQ +C Author : SDP +C Date : June 19,1986 +C +C Final and initial partons +C +C LQ Q/IQ +C ___________________________________________________________________________ +C L-2 ref. to PJET (parton structure jets) +C -1 ref. to primary jet (ISAJ) +C 0 for initial parton +C 0 next to next ISAQ +C +1 up to ISAE +C +2 origin to ISAE for first and previous ISAQ for others +C ............................................................................ +C I-5 final/initial parton number +C -4 bank name, 'ISAQ' +C -3 NL=2 +C -2 NS=0 +C -1 ND=9 +C 0 STATUS +C +1 I final/initial parton type +C 2 F px +C 3 F py +C 4 F pz +C 5 F E +C 6 F mass +C 7 F phi +C 8 F theta +C 9 F eta +C======================================================================= + + + +C======================================================================= +C +C Bank name: ISCL +C Author : SDP +C Date : June 19,1986 +C +C Calorimeter cell bank +C +C LQ Q/IQ +C ___________________________________________________________________________ +C L-2 ref. to reconstructed jet (ISJT) +C -1 ref. to parent parton (ISAQ) +C 0 next to next ISCL +C +1 up to ISAC +C +2 origin to ISAC for first and previous ISAL for others +C ............................................................................ +C I-5 cell number (ordinal) +C -4 bank name, 'ISCL' +C -3 NL=2 +C -2 NS=0 +C -1 ND=10 +C 0 STATUS +C +1 I 10000*(phi index) + y index +C 2 I 10000*(# of charged trks) + # of gammas +C 3 F e.m. energy deposited +C 4 F had. " " +C 5 F sin(theta) at center of cell +C 6 F cos(theta) " +C 7 F sin(phi) " +C 8 F cos(phi) " +C 9 F phi " +C 10 F eta " +C=========================================================================== + + + + +C======================================================================= +C +C Bank name: ISJT +C Author : SDP +C Date : June 19,1986 +C +C Jets found by ISZJET +C +C LQ Q/IQ +C ___________________________________________________________________________ +C -1 to possible parent parton (ISAQ) +C +0 next to next jet (ISJT) +C +1 up to ISJT +C +2 origin to ISAC +C ............................................................................ +C I-5 jet number +C -4 bank name, 'ISJT' +C -3 NL=0 +C -2 NS=0 +C -1 ND=6 +C 0 STATUS +C +1 F ET (transverse energy) +C 2 F px +C 3 F py +C 4 F pz +C 5 F E +C 6 F mass +C 7 F phi +C 8 F theta +C 9 F eta +C======================================================================= + + + + +C======================================================================= +C +C Bank name: ISP1 +C Author : SDP +C Date : June 19,1986 +C +C Particle bank (from primary and short lived vertices) +C +C LQ Q/IQ +C ___________________________________________________________________________ +C L-5 ref. to GCAH +C L-4 ref. to secondary vertex (ISV2) +C -3 ref. to primary jet (ISAJ) +C -2 ref. to initial parton (ISAQ) +C -1 struct. (free) +C 0 next to next ISP1 +C +1 up to ISV1 +C +2 origin to ISV1 for first and previous ISP1 for others +C ............................................................................ +C I-5 particle number +C -4 bank name, 'ISP1' +C -3 NL=4 +C -2 NS=1 +C -1 ND=9 +C 0 STATUS +C +1 I ISAJET particle ID +C 2 F px +C 3 F py +C 4 F pz +C 5 F E +C 6 F mass +C 7 F phi +C 8 F theta +C 9 F eta +C======================================================================= + + + +C======================================================================= +C +C Bank Name : PJET +C Author : Chip Stewart +C Date : 7-NOV-1989 18:10:09.84 +C Version : 2.0 +C +C Bank description : PARTON JET BANK +C PJET is constructed by applying a jet algorithm (CONE or +C OPENING ANGLE) to either Partons given in the ISAQ bank +C or Paricles given in the ISP1 bank. +C +C LQ Q/IQ +C----------------------------------------------------------------------- +C +2 Down link to SPARE +C -1 Down link to PJPT +C 0 Next link to +C +1 Up link to PJHD +C +2 Origin link to PJHD +C....................................................................... +C -5 Bank number +C -4 Bank name, 'PJET' +C -3 NL = 2 +C -2 NS = 2 +C -1 ND = 12 +C 0 Status +C +1 I NV = 2 Version Number +C 2 F Et ( =Pt in version NV=1 ) +C 3 F Px +C 4 F Py +C 5 F Pz +C 6 F E +C 7 F mass +C 8 F phi +C 9 F theta +C 10 F eta +C 11 I CLASS - (eg. for mapping PJET with RECO ) +C 12 I NEXT +C======================================================================= +C +C Definitions: +C ----------- +C +C E - Sum(Ei) over all the Partons/Particles included in the jet. +C +C Px - Sum(Pxi). +C Py - Sum(Pyi). +C Pz - Sum(Pzi). +C +C Et - Sum[Ei*sin(Thetai)] +C +C Comment: In version NV=1 word 2 was Pt = SQRT ( Px**2 + Py**2 ) +C +C Mass - SQRT [ E**2 - ( Px**2 + Py**2 + Pz**2 )] +C +C For Theta, Phi and Eta the following code was used +C to calculate them from Px,Py,Pz +C +C PARAMETER( SMALL = 1.0E-5 ) +C Phi=ATAN2(Py,Px+SMALL) ; IF(Phi.LT.0) Phi=Phi+TWOPI +C Theta=ACOS((Pz+SMALL)/(SQRT(Px*Px+Py*Py+Pz*Pz)+SMALL)) +C Eta=-ALOG(TAN(Theta/2.)+SMALL) +C +C======================================================================= + + + +C======================================================================= +C +C Bank Name : PJHD +C Author : Chip Stewart +C Date : 7-NOV-1989 17:57:58.00 +C +C Bank description : Header for PJET structure +C +C LQ Q/IQ +C----------------------------------------------------------------------- +C -2 DOWN spare +C -1 DOWN LINK TO PJET +C 0 Next link to PJHD +C +1 Up link to ISAE +C +2 Origin link to ISAE +C....................................................................... +C -5 Bank number +C -4 Bank name, 'PJHD' +C -3 NL = 2 +C -2 NS = 2 +C -1 ND = 8 +C 0 Status +C 1 I NV=2 Version number +C 2 I N_ALG - 1 for DR CONE , 2 for CMS OPEN ANGLE +C 3 I NJET - NUMBER OF PARTON JETS +C 4 F algorithm parameters DR_CONE_CUT/OPENING_ANGLE_CUT +C 5 F algorithm parameters JET_ET_CUT +C 6 I algorithm parameters MAX ITERATIONS +C 7 I Initial Radiation switch 0-use IR 1-no IR +C 8 I MUON switch (IF NV=1 MUON NOT USED) +C 0-no MUONS 1-use MUONS +C======================================================================= + + + +C======================================================================= +C +C Bank Name : PJPT +C Author : Chip Stewart +C Date : 15-Dec-1989 +C +C Bank description : pointers to Partons (ISAQ) in a given jet +C +C LQ Q/IQ +C----------------------------------------------------------------------- +C -N+1 Ref Link to parton bank ISAQ for Nth parton in this PJET +C -2 Ref Link to parton bank ISAQ for 1st " " " " +C -1 not used +C 0 Next link to none +C +1 Up link to PJET +C +2 Origin link to PJET +C....................................................................... +C -5 Bank number +C -4 Bank name, 'PJPT' +C -3 NL = N+1 +C -2 NS = 0 +C -1 ND = 1 - number of data words in PJPT bank = 1 +C 0 Status +C +1 I Bank version (=1) +C======================================================================= + diff --git a/ISAJET/isadata/aldata.F b/ISAJET/isadata/aldata.F new file mode 100644 index 00000000000..44f6e3943b6 --- /dev/null +++ b/ISAJET/isadata/aldata.F @@ -0,0 +1,250 @@ +#include "isajet/pilot.h" + BLOCK DATA ALDATA +C INITIALIZE ALL COMMON BLOCKS +C....................................................................... +C WARNINGS: MANY VARIABLES SET IN ALDATA ARE ALSO SET BY . +C SUBROUTINE RESET. . +C . +C ALDATA SHOULD ALWAYS BE LOADED WHEN USING ISAJET OR WHEN . +C READING AN ISAJET TAPE. . +C....................................................................... +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/pjets.inc" +#include "isajet/pinits.inc" +#include "isajet/lstprt.inc" +#include "isajet/dkytab.inc" +#include "isajet/dylim.inc" +#include "isajet/eepar.inc" +#include "isajet/frgpar.inc" +#include "isajet/idrun.inc" +#include "isajet/jetlim.inc" +#include "isajet/jetpar.inc" +#include "isajet/jetset.inc" +#include "isajet/jetsig.inc" +#include "isajet/limevl.inc" +#include "isajet/mbpar.inc" +#include "isajet/nodcay.inc" +#include "isajet/partcl.inc" +#include "isajet/primar.inc" +#include "isajet/prtout.inc" +#include "isajet/qcdpar.inc" +#include "isajet/qlmass.inc" +#include "isajet/q1q2.inc" +#include "isajet/seed.inc" +#include "isajet/sspar.inc" +#include "isajet/tcpar.inc" +#include "isajet/totals.inc" +#include "isajet/types.inc" +#include "isajet/wcon.inc" +#include "isajet/mbgen.inc" +#include "isajet/force.inc" +#include "isajet/zevel.inc" +#include "isajet/final.inc" +#include "isajet/keys.inc" +#include "isajet/hcon.inc" +#include "isajet/xmssm.inc" +#include "isajet/sugnu.inc" +#include "isajet/isapw.inc" +#include "isajet/sstype.inc" +#include "isajet/listss.inc" +C + INTEGER III,JJJ + INTEGER MXGOQJ + PARAMETER (MXGOQJ=MXGOJ*MXGOQ) + INTEGER MXGOWJ + PARAMETER (MXGOWJ=25*MXGOJ) + INTEGER MXT29 + PARAMETER (MXT29=29*MXTYPE) +C SUSY IDENT codes from /SSTYPE/ + INTEGER MSUPL,MSDNL,MSSTL,MSCHL,MSBT1,MSTP1, + $MSUPR,MSDNR,MSSTR,MSCHR,MSBT2,MSTP2,MSW1,MSW2, + $MSNEL,MSEL,MSNML,MSMUL,MSNTL,MSTAU1,MSER,MSMUR,MSTAU2 + PARAMETER (MSUPL=-ISUPL) + PARAMETER (MSDNL=-ISDNL) + PARAMETER (MSSTL=-ISSTL) + PARAMETER (MSCHL=-ISCHL) + PARAMETER (MSBT1=-ISBT1) + PARAMETER (MSTP1=-ISTP1) + PARAMETER (MSUPR=-ISUPR) + PARAMETER (MSDNR=-ISDNR) + PARAMETER (MSSTR=-ISSTR) + PARAMETER (MSCHR=-ISCHR) + PARAMETER (MSBT2=-ISBT2) + PARAMETER (MSTP2=-ISTP2) + PARAMETER (MSW1=-ISW1) + PARAMETER (MSW2=-ISW2) + PARAMETER (MSNEL=-ISNEL) + PARAMETER (MSEL=-ISEL) + PARAMETER (MSNML=-ISNML) + PARAMETER (MSMUL=-ISMUL) + PARAMETER (MSNTL=-ISNTL) + PARAMETER (MSTAU1=-ISTAU1) + PARAMETER (MSER=-ISER) + PARAMETER (MSMUR=-ISMUR) + PARAMETER (MSTAU2=-ISTAU2) +C +C DATA FOR IDRUN +C IDVER=100*VERSION+CYCLE +C DATA IDVER/600/ +C +C DATA FOR ITAPES + DATA ITDKY,ITEVT,ITCOM,ITLIS/1,2,5,6/ +C +C DATA FOR QLMASS +C AMLEP LABELED BY INDEX...SEE FLAVOR +C SETW RESETS W+- AND Z0 MASSES + DATA AMLEP/.3,.3,.5,1.6,5.0,175.,-1.,-1.,0.,0., + $0.,.511003E-3,0.,.105661,0.,1.777,3*-1.,.49767,.49767, + $79*0./ + DATA NQLEP,NMES,NBARY/61,2,2/ +C +C DATA FOR PJETS + DATA IDJETS/MXJETS*0/,IDENTW/0/ +C +C DATA FOR PINITS + DATA IDINIT/2*0/ +C +C DATA FOR LSTPRT + DATA LSTPRT/0/ +C +C DATA FOR MBPAR + DATA PUD0/.45/,PJSPN,PISPN/2*.5/,SIGQT0/.35/,XGEN0/.9,1./,PMIX01/ + $.25,.25,.5,0.,.5,1./,PMIX02/.5,.5,1.,0.,0.,1./ + DATA PBARY0/.075/ +C +C DATA FOR MBGEN + DATA MNPOM,MXPOM/1,LIMPOM/ +C +C DATA FOR SEED + DATA XSEED/'0'/ +C +C DATA FOR TCPAR + DATA TCMRHO,TCGRHO/1000.,100./ +C +C DATA FOR FRGPAR +C F(X)=1-XGEN(1)+XGEN(1)*(XGEN(2)+1)*(1-X)**XGEN(2) FOR U,D,S +C PETERSON FRAGMENTATION, EPSILON=XGEN(I)*M(I)**2 FOR C,B,T + DATA PUD,PBARY/.43,.10/ + DATA SIGQT,PEND/.35,.14/ + DATA XGEN/.96,3.,0.,.8,.5,.5,.5,.5/ + DATA PSPIN1/.5,.5,.5,.75,.75,.75,.75,.75/ + DATA PMIX1/.25,.25,.5,0.,.5,1./,PMIX2/.5,.5,1.,0.,0.,1./ + DATA XGENSS/9*.5/ +C +C DATA FOR JETLIM + DATA BLIMS/MXLX12*-1.E9/ +C +C DATA FOR NODCAY + DATA NODCAY,NOETA,NOPI0,NONUNU,NOEVOL,NOHADR/6*.FALSE./ + DATA NOGRAV/.FALSE./ +C +C DATA FOR TYPES + DATA LOC/100*0/,NTYP/100/ + DATA NJTTYP/MXTYPE*0/ + DATA (JETYP(1,JJJ),JJJ=1,MXTYPE)/MXTYPE*'ALL '/, + $((JETYP(III,JJJ),III=2,30),JJJ=1,MXTYPE)/MXT29*' '/ + DATA NWWTYP/2*0/ + DATA (WWTYP(1,JJJ),JJJ=1,2)/2*'ALL '/, + $((WWTYP(III,JJJ),III=2,30),JJJ=1,2)/58*' '/ + DATA JWTYP/4/ +C +C DATA FOR PRIMAR + DATA IDIN/1120,1120/ + DATA NTRIES/1000/ + DATA NSIGMA/20/ +C +C DATA FOR DKYTAB + DATA LOOK/MXLOOK*0/ + DATA CBR/MXDKY*0./ + DATA MODE/MXDKY*0,MXDKY*0,MXDKY*0,MXDKY*0,MXDKY*0/ +C +C DATA FOR Q1Q2 + DATA GOQ/MXGOQJ*.TRUE./ + DATA GOALL/MXGOJ*.TRUE./ + DATA GODY/.TRUE.,.FALSE.,.FALSE.,.TRUE./ + DATA GOWW/50*.TRUE./,ALLWW/2*.TRUE./ + DATA GOWMOD/MXGOWJ*.TRUE./ +C +C DATA FOR WCON + DATA MATCH/ + $0,3,2,5,4,7,6,9,8,11,10,13,12,0,0,17,16,0,0,21,20,0,0,25,24, + $0,5,0,0,2,0,8,7,0,0,12,11,0,17,0,0,14,21,0,0,18,25,0,0,22, + $0,0,4,3,0,9,0,0,6,13,0,0,10,0,16,15,0,0,20,19,0,0,24,23,0, + $0,3,2,5,4,7,6,9,8,11,10,13,12,15,14,17,16,19,18,21,20,23,22,25,24/ + DATA CUTOFF,CUTPOW/.200,1.0/ + DATA WMASS/0.,80.2,80.2,91.19/ + DATA WFUDGE/1.85/ +C +C DATA FOR TOTALS + DATA NKINPT,NWGEN,NKEEP/3*0/,SUMWT/0./ +C +C DATA FOR DYLIM + DATA BLIM1/12*-1.E9/ +C +C DATA FOR EEPAR + DATA PLEP/0./,PLEM/0./,IBREM/.FALSE./,IBEAM/.FALSE./ +C +C DATA FOR PARTCL + DATA NPTCL/0/ +C +C DATA FOR PRTOUT + DATA NEVPRT,NJUMP/1,1/ +C +C DATA FOR JETSET + DATA NJSET/0/ +C +C DATA FOR QCDPAR + DATA ALAM,ALAM2/.2,.04/,CUTJET/6./,ISTRUC/6/ +C +C DATA FOR FORCE + DATA NFORCE/0/ +C +C DATA FOR NRECS + DATA NRECS/0/ +C +C DATA FOR KEYS + DATA KEYS/MXKEYS*.FALSE./ +C +C DATA FOR MATCHH + DATA MATCHH/ + $1,3,2,5,4,7,6,9,8,11,10,13,12, + $15,14,17,16,19,18,21,20,23,22,25,24, + $26,28,27,29/ + DATA USELIM/.FALSE./ + DATA CONCUT/1.0/ +C +C DATA FOR SSPAR + DATA AMGVSS/1.E20/ +C +C DATA FOR XMSSM + DATA GOMSSM/.FALSE./,GOSUG/.FALSE./,GOGMSB/.FALSE./ + DATA GOAMSB/.FALSE./ + DATA AL3UNI/.FALSE./ + DATA XM1SS,XM2SS/1.E20,1.E20/ + DATA XMGVTO/1.E20/ + DATA XQ2SS,XSRSS,XCRSS,XL2SS,XMRSS/1.E20,1.E20,1.E20,1.E20,1.E20/ + DATA XRSLGM,XDHDGM,XDHUGM,XDYGM/1.,0.,0.,0./ + DATA XN51GM,XN52GM,XN53GM/0.,0.,0./ + DATA XMN3NR/0./,XMAJNR/1.E20/,XANSS/0./,XNRSS/0./,XSBCS/0./ +C DATA FOR SUGNU + DATA XNUSUG/18*1.E20/ +C +C DATA FOR ISAPW + DATA ISAPW1/'ALDATA REQUIRED BY FORTRAN G,H'/ +C +C DATA FOR LISTSS + DATA LISTSS/ISGL, + $ISUPL,MSUPL,ISDNL,MSDNL,ISSTL,MSSTL,ISCHL,MSCHL,ISBT1,MSBT1, + $ISTP1,MSTP1, + $ISUPR,MSUPR,ISDNR,MSDNR,ISSTR,MSSTR,ISCHR,MSCHR,ISBT2,MSBT2, + $ISTP2,MSTP2, + $ISW1,MSW1,ISW2,MSW2,ISZ1,ISZ2,ISZ3,ISZ4, + $ISNEL,MSNEL,ISEL,MSEL,ISNML,MSNML,ISMUL,MSMUL,ISNTL,MSNTL, + $ISTAU1,MSTAU1,ISER,MSER,ISMUR,MSMUR,ISTAU2,MSTAU2, + $9,1,-1,2,-2,3,-3,4,-4,5,-5,6,-6,11,-11,12,-12,13,-13, + $14,-14,15,-15,16,-16,10,80,-80,90,82,83,84,86,-86/ +C + END diff --git a/ISAJET/isajet/brembm.inc b/ISAJET/isajet/brembm.inc new file mode 100644 index 00000000000..5573245bc2c --- /dev/null +++ b/ISAJET/isajet/brembm.inc @@ -0,0 +1,11 @@ +#ifndef CERNLIB_ISAJET_BREMBM_INC +#define CERNLIB_ISAJET_BREMBM_INC +* +* +* brembm.inc +* + COMMON/BREMBM/QSQBM,EB,XMIN + REAL QSQBM,EB,XMIN + SAVE /BREMBM/ + +#endif diff --git a/ISAJET/isajet/calor.inc b/ISAJET/isajet/calor.inc new file mode 100644 index 00000000000..9757eb4fa11 --- /dev/null +++ b/ISAJET/isajet/calor.inc @@ -0,0 +1,22 @@ +#ifndef CERNLIB_ISAJET_CALOR_INC +#define CERNLIB_ISAJET_CALOR_INC +* +* +* calor.inc +* + REAL DELY,YCMIN,YCMAX + INTEGER NCY + PARAMETER (NCY=80,DELY=.1,YCMIN=-4.,YCMAX=4.) + REAL DELPHI + INTEGER NCPHI + PARAMETER (NCPHI=72,DELPHI=.087267) + COMMON/CALOR/ET(NCY,NCPHI),ETEM(NCY,NCPHI), + $CTHCAL(NCY),STHCAL(NCY),CPHCAL(NCPHI),SPHCAL(NCPHI) + SAVE /CALOR/ +#if defined(CERNLIB_LEVEL2) +#include "isajet/l2cal.inc" +* Ignoring t=pass +#endif + REAL ET,ETEM,CTHCAL,STHCAL,CPHCAL,SPHCAL + +#endif diff --git a/ISAJET/isajet/const.inc b/ISAJET/isajet/const.inc new file mode 100644 index 00000000000..39760efce24 --- /dev/null +++ b/ISAJET/isajet/const.inc @@ -0,0 +1,11 @@ +#ifndef CERNLIB_ISAJET_CONST_INC +#define CERNLIB_ISAJET_CONST_INC +* +* +* const.inc +* + COMMON/CONST/PI,SQRT2,ALFA,GF,UNITS + SAVE /CONST/ + REAL PI,SQRT2,ALFA,GF,UNITS + +#endif diff --git a/ISAJET/isajet/dkyss3.inc b/ISAJET/isajet/dkyss3.inc new file mode 100644 index 00000000000..a4c7d3f3c47 --- /dev/null +++ b/ISAJET/isajet/dkyss3.inc @@ -0,0 +1,38 @@ +#ifndef CERNLIB_ISAJET_DKYSS3_INC +#define CERNLIB_ISAJET_DKYSS3_INC +* +* +* dkyss3.inc +* +C +C Data for SUSY 3-body matrix elements. There is a double +C pointer structure, first to modes, and then to poles that +C make up the matrix element for that mode: +C MELEM=-I in /DKYTAB/ points to the mode information: +C J1SS3(I) = start of pole list for this mode +C J2SS3(I) = end of pole list for this mode +C WTSS3(I) = maximum weight for this mode +C J1SS3 gaugino f fbar, the pole types are +C KSS3=1: spin-1 pole in f-fbar channel +C KSS3=2: spin-0 pole in gaugino-f channel +C KSS3=3: spin-0 pole in gaugino-fbar channel +C KSS3=4: spin-0 pole in f-fbar channel +C The two couplings are the coefficients of 1,gamma_5 or of +C gamma_mu,gamma_mu*gamma_5. +C + INTEGER MXMSS3,MXPSS3 + PARAMETER (MXMSS3=1000) + PARAMETER (MXPSS3=2000) + COMMON/DKYSS3/NMSS3,NPSS3, + $J1SS3(MXMSS3),J2SS3(MXMSS3),WTSS3(MXMSS3), + $KSS3(MXPSS3),AMSS3(MXPSS3),ZISS3(2,MXPSS3),ZFSS3(2,MXPSS3) + INTEGER NMSS3,NPSS3,KSS3,J1SS3,J2SS3 + REAL WTSS3,AMSS3 + COMPLEX ZISS3,ZFSS3 + +#endif diff --git a/ISAJET/isajet/dkytab.inc b/ISAJET/isajet/dkytab.inc new file mode 100644 index 00000000000..16286ce60a1 --- /dev/null +++ b/ISAJET/isajet/dkytab.inc @@ -0,0 +1,21 @@ +#ifndef CERNLIB_ISAJET_DKYTAB_INC +#define CERNLIB_ISAJET_DKYTAB_INC +* +* +* dkytab.inc +* +C LOOK must be dimensioned to the maximum value of INDEX. + INTEGER MXLOOK + PARAMETER (MXLOOK=500) + INTEGER MXDKY + PARAMETER (MXDKY=3000) + COMMON/DKYTAB/LOOK(MXLOOK),CBR(MXDKY),MODE(5,MXDKY),MELEM(MXDKY) + SAVE /DKYTAB/ +#if defined(CERNLIB_LEVEL2) +#include "isajet/l2dky.inc" +* Ignoring t=pass +#endif + INTEGER LOOK,MODE,MELEM + REAL CBR + +#endif diff --git a/ISAJET/isajet/dylim.inc b/ISAJET/isajet/dylim.inc new file mode 100644 index 00000000000..41a6b6d676f --- /dev/null +++ b/ISAJET/isajet/dylim.inc @@ -0,0 +1,16 @@ +#ifndef CERNLIB_ISAJET_DYLIM_INC +#define CERNLIB_ISAJET_DYLIM_INC +* +* +* dylim.inc +* + COMMON/DYLIM/QMIN,QMAX,QTMIN,QTMAX,YWMIN,YWMAX,XWMIN,XWMAX,THWMIN, + 2 THWMAX,PHWMIN,PHWMAX + 3 ,SETLMQ(12) + SAVE /DYLIM/ + LOGICAL SETLMQ + EQUIVALENCE(BLIM1(1),QMIN) + REAL QMIN,QMAX,QTMIN,QTMAX,YWMIN,YWMAX,XWMIN,XWMAX,THWMIN, + + THWMAX,PHWMIN,PHWMAX,BLIM1(12) + +#endif diff --git a/ISAJET/isajet/dypar.inc b/ISAJET/isajet/dypar.inc new file mode 100644 index 00000000000..fa34a4c066a --- /dev/null +++ b/ISAJET/isajet/dypar.inc @@ -0,0 +1,12 @@ +#ifndef CERNLIB_ISAJET_DYPAR_INC +#define CERNLIB_ISAJET_DYPAR_INC +* +* +* dypar.inc +* + COMMON/DYPAR/FLW,RNU2(3),ANORM(3),QPOW(3),PTPOW(3) + SAVE /DYPAR/ + LOGICAL FLW + REAL RNU2,ANORM,QPOW,PTPOW + +#endif diff --git a/ISAJET/isajet/eepar.inc b/ISAJET/isajet/eepar.inc new file mode 100644 index 00000000000..16c6230e080 --- /dev/null +++ b/ISAJET/isajet/eepar.inc @@ -0,0 +1,13 @@ +#ifndef CERNLIB_ISAJET_EEPAR_INC +#define CERNLIB_ISAJET_EEPAR_INC +* +* +* eepar.inc +* + COMMON/EEPAR/SGMXEE,PLEP,PLEM,RSHMIN,RSHMAX, + $UPSLON,SIGZ,IBREM,IBEAM + SAVE /EEPAR/ + REAL SGMXEE,PLEP,PLEM,RSHMIN,RSHMAX,UPSLON,SIGZ + LOGICAL IBREM,IBEAM + +#endif diff --git a/ISAJET/isajet/final.inc b/ISAJET/isajet/final.inc new file mode 100644 index 00000000000..d88fb83facb --- /dev/null +++ b/ISAJET/isajet/final.inc @@ -0,0 +1,12 @@ +#ifndef CERNLIB_ISAJET_FINAL_INC +#define CERNLIB_ISAJET_FINAL_INC +* +* +* final.inc +* + COMMON/FINAL/NKINF,SIGF,ALUM,ACCEPT,NRECS + SAVE /FINAL/ + INTEGER NKINF,NRECS + REAL SIGF,ALUM,ACCEPT + +#endif diff --git a/ISAJET/isajet/force.inc b/ISAJET/isajet/force.inc new file mode 100644 index 00000000000..3df9a93ce80 --- /dev/null +++ b/ISAJET/isajet/force.inc @@ -0,0 +1,14 @@ +#ifndef CERNLIB_ISAJET_FORCE_INC +#define CERNLIB_ISAJET_FORCE_INC +* +* +* force.inc +* + INTEGER MXFORC + PARAMETER (MXFORC=40) + COMMON/FORCE/NFORCE,IFORCE(MXFORC),MFORCE(5,MXFORC) + $,LOOK2(2,MXFORC),LOOKST(MXFORC),MEFORC(MXFORC) + SAVE /FORCE/ + INTEGER NFORCE,IFORCE,MFORCE,LOOK2,LOOKST,MEFORC + +#endif diff --git a/ISAJET/isajet/frame.inc b/ISAJET/isajet/frame.inc new file mode 100644 index 00000000000..dac0eeb690f --- /dev/null +++ b/ISAJET/isajet/frame.inc @@ -0,0 +1,12 @@ +#ifndef CERNLIB_ISAJET_FRAME_INC +#define CERNLIB_ISAJET_FRAME_INC +* +* +* frame.inc +* + COMMON/FRAME/FRAME(5,3),N0JETS,N0W,N0PAIR + SAVE /FRAME/ + INTEGER N0JETS,N0W,N0PAIR + REAL FRAME + +#endif diff --git a/ISAJET/isajet/frgpar.inc b/ISAJET/isajet/frgpar.inc new file mode 100644 index 00000000000..de73532ff1c --- /dev/null +++ b/ISAJET/isajet/frgpar.inc @@ -0,0 +1,16 @@ +#ifndef CERNLIB_ISAJET_FRGPAR_INC +#define CERNLIB_ISAJET_FRGPAR_INC +* +* +* frgpar.inc +* + COMMON/FRGPAR/PUD,PBARY,SIGQT,PEND,XGEN(8),PSPIN1(8), + $PMIX1(3,2),PMIX2(3,2),XGENSS(9) + SAVE /FRGPAR/ + EQUIVALENCE (PMIX1(1,1),PMIXX1(1)) + EQUIVALENCE (PMIX2(1,1),PMIXX2(1)) + EQUIVALENCE(FRPAR(1),PUD) + REAL PUD,PBARY,SIGQT,PEND,XGEN,PSPIN1,PMIX1,PMIX2,XGENSS, + + PMIXX1(6),PMIXX2(6),FRPAR(32) + +#endif diff --git a/ISAJET/isajet/getjet.inc b/ISAJET/isajet/getjet.inc new file mode 100644 index 00000000000..0bb1e871c14 --- /dev/null +++ b/ISAJET/isajet/getjet.inc @@ -0,0 +1,18 @@ +#ifndef CERNLIB_ISAJET_GETJET_INC +#define CERNLIB_ISAJET_GETJET_INC +* +* +* getjet.inc +* + INTEGER NJMAX + PARAMETER (NJMAX=50) + COMMON/GETCOM/JETNO(NCY,NCPHI),NCJET,PCJET(4,NJMAX),ETJET(NJMAX) + SAVE /GETCOM/ +#if defined(CERNLIB_LEVEL2) +#include "isajet/l2getj.inc" +* Ignoring t=pass +#endif + INTEGER JETNO,NCJET + REAL PCJET,ETJET + +#endif diff --git a/ISAJET/isajet/hcon.inc b/ISAJET/isajet/hcon.inc new file mode 100644 index 00000000000..85e0817c790 --- /dev/null +++ b/ISAJET/isajet/hcon.inc @@ -0,0 +1,22 @@ +#ifndef CERNLIB_ISAJET_HCON_INC +#define CERNLIB_ISAJET_HCON_INC +* +* +* hcon.inc +* + COMMON/HCON/ANWWWW(4,4,4),ADWWWW(2,4),AIWWWW(4) + $,HMASS,HGAM,HGAMS(29),ETAHGG,MATCHH(29),ZSTARS(4,2) + $,IHTYPE,HGAMSS(85,85) + SAVE /HCON/ +#if defined(CERNLIB_DOUBLE) +#include "isajet/hcon2.inc" +* Ignoring t=pass +#endif +#if defined(CERNLIB_SINGLE) +#include "isajet/hcon1.inc" +* Ignoring t=pass +#endif + INTEGER MATCHH,IHTYPE + REAL HMASS,HGAM,HGAMS,ETAHGG,ZSTARS,HGAMSS + +#endif diff --git a/ISAJET/isajet/hcon1.inc b/ISAJET/isajet/hcon1.inc new file mode 100644 index 00000000000..0588ce151c1 --- /dev/null +++ b/ISAJET/isajet/hcon1.inc @@ -0,0 +1,11 @@ +#ifndef CERNLIB_ISAJET_HCON1_INC +#define CERNLIB_ISAJET_HCON1_INC +* +* +* hcon1.inc +* +#if defined(CERNLIB_SINGLE) + REAL ANWWWW,ADWWWW,AIWWWW +#endif + +#endif diff --git a/ISAJET/isajet/hcon2.inc b/ISAJET/isajet/hcon2.inc new file mode 100644 index 00000000000..bc994baa5d3 --- /dev/null +++ b/ISAJET/isajet/hcon2.inc @@ -0,0 +1,11 @@ +#ifndef CERNLIB_ISAJET_HCON2_INC +#define CERNLIB_ISAJET_HCON2_INC +* +* +* hcon2.inc +* +#if defined(CERNLIB_DOUBLE) + DOUBLE PRECISION ANWWWW,ADWWWW,AIWWWW +#endif + +#endif diff --git a/ISAJET/isajet/hepevt.inc b/ISAJET/isajet/hepevt.inc new file mode 100644 index 00000000000..8f95e9c605d --- /dev/null +++ b/ISAJET/isajet/hepevt.inc @@ -0,0 +1,32 @@ +#ifndef CERNLIB_ISAJET_HEPEVT_INC +#define CERNLIB_ISAJET_HEPEVT_INC +* +* +* hepevt.inc +* + INTEGER NMXHEP + PARAMETER (NMXHEP=4000) + COMMON/HEPEVT/NEVHEP,NHEP,ISTHEP(NMXHEP),IDHEP(NMXHEP), + $JMOHEP(2,NMXHEP),JDAHEP(2,NMXHEP),PHEP(5,NMXHEP),VHEP(4,NMXHEP) + INTEGER NEVHEP,NHEP,ISTHEP,IDHEP,JMOHEP,JDAHEP + REAL PHEP,VHEP + SAVE /HEPEVT/ +C... NEVHEP - event number +C... NHEP - number of entries in this event +C... ISTHEP(..) - status code +C... IDHEP(..) - particle ID, P.D.G. standard +C... JMOHEP(1,..) - position of mother particle in list +C... JMOHEP(2,..) - position of second mother particle in list +C... JDAHEP(1,..) - position of first daughter in list +C... JDAHEP(2,..) - position of last daughter in list +C... PHEP(1,..) - x momentum in GeV/c +C... PHEP(2,..) - y momentum in GeV/c +C... PHEP(3,..) - z momentum in GeV/c +C... PHEP(4,..) - energy in GeV +C... PHEP(5,..) - mass in GeV/c**2 +C... VHEP(1,..) - x vertex position in mm +C... VHEP(2,..) - y vertex position in mm +C... VHEP(3,..) - z vertex position in mm +C... VHEP(4,..) - production time in mm/c + +#endif diff --git a/ISAJET/isajet/idrun.inc b/ISAJET/isajet/idrun.inc new file mode 100644 index 00000000000..2234bba16ea --- /dev/null +++ b/ISAJET/isajet/idrun.inc @@ -0,0 +1,11 @@ +#ifndef CERNLIB_ISAJET_IDRUN_INC +#define CERNLIB_ISAJET_IDRUN_INC +* +* +* idrun.inc +* + COMMON/IDRUN/IDVER,IDG(2),IEVT,IEVGEN + SAVE /IDRUN/ + INTEGER IDVER,IDG,IEVT,IEVGEN + +#endif diff --git a/ISAJET/isajet/isabnk.inc b/ISAJET/isajet/isabnk.inc new file mode 100644 index 00000000000..61c00887b3f --- /dev/null +++ b/ISAJET/isajet/isabnk.inc @@ -0,0 +1,23 @@ +#ifndef CERNLIB_ISAJET_ISABNK_INC +#define CERNLIB_ISAJET_ISABNK_INC +* +* +* isabnk.inc +* +C + COMMON/ISABNK/BANK,FILISA,FILIS2 + SAVE /ISABNK/ + CHARACTER*12 BANK + CHARACTER*80 FILISA,FILIS2 +C +C If BANK='ISAP' Zebra bank ISAP (particles) will be written out +C if BANK='ISAC' " ISAC (pseudo calorimeter) will be written out +C If BANK='ISAL' " ISAL (leptons) will be written out +C if BANK='ISAPISAC' both groups will be written out +C if BANK='ISAPISACISAL' all groups will be written out +C +C FILISA= name of ISAJET events file (ZEBRA) +C FILIS2= name of second file if needed for output +C + +#endif diff --git a/ISAJET/isajet/isalnk.inc b/ISAJET/isajet/isalnk.inc new file mode 100644 index 00000000000..fe7b41b8456 --- /dev/null +++ b/ISAJET/isajet/isalnk.inc @@ -0,0 +1,17 @@ +#ifndef CERNLIB_ISAJET_ISALNK_INC +#define CERNLIB_ISAJET_ISALNK_INC +* +* +* isalnk.inc +* + INTEGER NVD,MQREF,MPQREF + PARAMETER (NVD=100) + PARAMETER (MQREF=200) + PARAMETER (MPQREF=10) + COMMON/ISALNK/LVD(NVD),QREF(MQREF),PQREF(MPQREF) + SAVE /ISALNK/ + INTEGER LVD ! vertex links + INTEGER QREF ! initial and final parton links + INTEGER PQREF ! links to primary jets + +#endif diff --git a/ISAJET/isajet/isapw.inc b/ISAJET/isajet/isapw.inc new file mode 100644 index 00000000000..4678eb59520 --- /dev/null +++ b/ISAJET/isajet/isapw.inc @@ -0,0 +1,12 @@ +#ifndef CERNLIB_ISAJET_ISAPW_INC +#define CERNLIB_ISAJET_ISAPW_INC +* +* +* isapw.inc +* +C ISAPW1 is used to check whether ALDATA is loaded + COMMON/ISAPW/ISAPW1 + CHARACTER*30 ISAPW1 + SAVE /ISAPW/ + +#endif diff --git a/ISAJET/isajet/isaunt.inc b/ISAJET/isajet/isaunt.inc new file mode 100644 index 00000000000..b0ee32852f1 --- /dev/null +++ b/ISAJET/isajet/isaunt.inc @@ -0,0 +1,13 @@ +#ifndef CERNLIB_ISAJET_ISAUNT_INC +#define CERNLIB_ISAJET_ISAUNT_INC +* +* +* isaunt.inc +* + COMMON/ISAUNT/ISUNIT,ISWRIT + SAVE /ISAUNT/ + INTEGER ISUNIT,ISWRIT +C ISUNIT=file number to write(read) ISAJET ZEBRA output +C ISWRIT= " to write if ISUNIT used for reading + +#endif diff --git a/ISAJET/isajet/isloop.inc b/ISAJET/isajet/isloop.inc new file mode 100644 index 00000000000..29d76d25892 --- /dev/null +++ b/ISAJET/isajet/isloop.inc @@ -0,0 +1,11 @@ +#ifndef CERNLIB_ISAJET_ISLOOP_INC +#define CERNLIB_ISAJET_ISLOOP_INC +* +* +* isloop.inc +* + COMMON/ISLOOP/NEVOLV,NFRGMN,IEVOL,IFRG + SAVE /ISLOOP/ + INTEGER NEVOLV,NFRGMN,IEVOL,IFRG + +#endif diff --git a/ISAJET/isajet/ita.inc b/ISAJET/isajet/ita.inc new file mode 100644 index 00000000000..51dbb1d422f --- /dev/null +++ b/ISAJET/isajet/ita.inc @@ -0,0 +1,11 @@ +#ifndef CERNLIB_ISAJET_ITA_INC +#define CERNLIB_ISAJET_ITA_INC +* +* +* ita.inc +* + COMMON/ITA/ITA,ITB + SAVE /ITA/ + INTEGER ITA,ITB + +#endif diff --git a/ISAJET/isajet/itapes.inc b/ISAJET/isajet/itapes.inc new file mode 100644 index 00000000000..183d60d8086 --- /dev/null +++ b/ISAJET/isajet/itapes.inc @@ -0,0 +1,11 @@ +#ifndef CERNLIB_ISAJET_ITAPES_INC +#define CERNLIB_ISAJET_ITAPES_INC +* +* +* itapes.inc +* + COMMON/ITAPES/ITDKY,ITEVT,ITCOM,ITLIS + SAVE /ITAPES/ + INTEGER ITDKY,ITEVT,ITCOM,ITLIS + +#endif diff --git a/ISAJET/isajet/izisab.inc b/ISAJET/isajet/izisab.inc new file mode 100644 index 00000000000..1b8f39f3e39 --- /dev/null +++ b/ISAJET/isajet/izisab.inc @@ -0,0 +1,10 @@ +#ifndef CERNLIB_ISAJET_IZISAB_INC +#define CERNLIB_ISAJET_IZISAB_INC +* +* +* izisab.inc +* + INTEGER IZISAB + PARAMETER (IZISAB=17) + +#endif diff --git a/ISAJET/isajet/izisac.inc b/ISAJET/isajet/izisac.inc new file mode 100644 index 00000000000..52a00f318e3 --- /dev/null +++ b/ISAJET/isajet/izisac.inc @@ -0,0 +1,10 @@ +#ifndef CERNLIB_ISAJET_IZISAC_INC +#define CERNLIB_ISAJET_IZISAC_INC +* +* +* izisac.inc +* + INTEGER IZISAC + PARAMETER (IZISAC=6) + +#endif diff --git a/ISAJET/isajet/izisae.inc b/ISAJET/isajet/izisae.inc new file mode 100644 index 00000000000..a85d0a60102 --- /dev/null +++ b/ISAJET/isajet/izisae.inc @@ -0,0 +1,10 @@ +#ifndef CERNLIB_ISAJET_IZISAE_INC +#define CERNLIB_ISAJET_IZISAE_INC +* +* +* izisae.inc +* + INTEGER IZISAE + PARAMETER (IZISAE=17) + +#endif diff --git a/ISAJET/isajet/izisaf.inc b/ISAJET/isajet/izisaf.inc new file mode 100644 index 00000000000..4053ca5163b --- /dev/null +++ b/ISAJET/isajet/izisaf.inc @@ -0,0 +1,10 @@ +#ifndef CERNLIB_ISAJET_IZISAF_INC +#define CERNLIB_ISAJET_IZISAF_INC +* +* +* izisaf.inc +* + INTEGER IZISAF + PARAMETER (IZISAF=17) + +#endif diff --git a/ISAJET/isajet/izisaj.inc b/ISAJET/isajet/izisaj.inc new file mode 100644 index 00000000000..515f6c9985c --- /dev/null +++ b/ISAJET/isajet/izisaj.inc @@ -0,0 +1,10 @@ +#ifndef CERNLIB_ISAJET_IZISAJ_INC +#define CERNLIB_ISAJET_IZISAJ_INC +* +* +* izisaj.inc +* + INTEGER IZISAJ + PARAMETER (IZISAJ=1) + +#endif diff --git a/ISAJET/isajet/izisal.inc b/ISAJET/isajet/izisal.inc new file mode 100644 index 00000000000..cb041dc0323 --- /dev/null +++ b/ISAJET/isajet/izisal.inc @@ -0,0 +1,10 @@ +#ifndef CERNLIB_ISAJET_IZISAL_INC +#define CERNLIB_ISAJET_IZISAL_INC +* +* +* izisal.inc +* + INTEGER IZISAL + PARAMETER (IZISAL=7) + +#endif diff --git a/ISAJET/isajet/izisam.inc b/ISAJET/isajet/izisam.inc new file mode 100644 index 00000000000..5e688b98c66 --- /dev/null +++ b/ISAJET/isajet/izisam.inc @@ -0,0 +1,10 @@ +#ifndef CERNLIB_ISAJET_IZISAM_INC +#define CERNLIB_ISAJET_IZISAM_INC +* +* +* izisam.inc +* + INTEGER IZISAM + PARAMETER (IZISAM=9) + +#endif diff --git a/ISAJET/isajet/izisaq.inc b/ISAJET/isajet/izisaq.inc new file mode 100644 index 00000000000..11cfaf061d6 --- /dev/null +++ b/ISAJET/isajet/izisaq.inc @@ -0,0 +1,10 @@ +#ifndef CERNLIB_ISAJET_IZISAQ_INC +#define CERNLIB_ISAJET_IZISAQ_INC +* +* +* izisaq.inc +* + INTEGER IZISAQ + PARAMETER (IZISAQ=2) + +#endif diff --git a/ISAJET/isajet/iziscl.inc b/ISAJET/isajet/iziscl.inc new file mode 100644 index 00000000000..62fe9cb29f0 --- /dev/null +++ b/ISAJET/isajet/iziscl.inc @@ -0,0 +1,10 @@ +#ifndef CERNLIB_ISAJET_IZISCL_INC +#define CERNLIB_ISAJET_IZISCL_INC +* +* +* iziscl.inc +* + INTEGER IZISCL + PARAMETER (IZISCL=1) + +#endif diff --git a/ISAJET/isajet/iziscm.inc b/ISAJET/isajet/iziscm.inc new file mode 100644 index 00000000000..d0d519a2974 --- /dev/null +++ b/ISAJET/isajet/iziscm.inc @@ -0,0 +1,14 @@ +#ifndef CERNLIB_ISAJET_IZISCM_INC +#define CERNLIB_ISAJET_IZISCM_INC +* +* +* iziscm.inc +* +C----------------------------------------------------------------------- +C Created 13-DEC-1989 10:20:16.28 Chip Stewart +C Link offset of bank ISCM in mother bank ISAB +C----------------------------------------------------------------------- + INTEGER IZISCM + PARAMETER ( IZISCM = 1) + +#endif diff --git a/ISAJET/isajet/izisjt.inc b/ISAJET/isajet/izisjt.inc new file mode 100644 index 00000000000..39b151d53bd --- /dev/null +++ b/ISAJET/isajet/izisjt.inc @@ -0,0 +1,14 @@ +#ifndef CERNLIB_ISAJET_IZISJT_INC +#define CERNLIB_ISAJET_IZISJT_INC +* +* +* izisjt.inc +* +C----------------------------------------------------------------------- +C Created 29-JAN-1990 Serban D. Protopopescu +C Link offset of bank ISJT in mother bank (ISAC) +C----------------------------------------------------------------------- + INTEGER IZISJT + PARAMETER ( IZISJT = 3 ) + +#endif diff --git a/ISAJET/isajet/izismr.inc b/ISAJET/isajet/izismr.inc new file mode 100644 index 00000000000..d71a29fcbd4 --- /dev/null +++ b/ISAJET/isajet/izismr.inc @@ -0,0 +1,14 @@ +#ifndef CERNLIB_ISAJET_IZISMR_INC +#define CERNLIB_ISAJET_IZISMR_INC +* +* +* izismr.inc +* +C----------------------------------------------------------------------- +C Created 18-MAY-1989 Serban D. Protopopescu +C Link offset of bank ISMR in mother bank +C----------------------------------------------------------------------- + INTEGER IZISMR + PARAMETER ( IZISMR = 2 ) + +#endif diff --git a/ISAJET/isajet/izisp1.inc b/ISAJET/isajet/izisp1.inc new file mode 100644 index 00000000000..aa82fefc767 --- /dev/null +++ b/ISAJET/isajet/izisp1.inc @@ -0,0 +1,10 @@ +#ifndef CERNLIB_ISAJET_IZISP1_INC +#define CERNLIB_ISAJET_IZISP1_INC +* +* +* izisp1.inc +* + INTEGER IZISP1 + PARAMETER (IZISP1=1) + +#endif diff --git a/ISAJET/isajet/izisp2.inc b/ISAJET/isajet/izisp2.inc new file mode 100644 index 00000000000..3aced877399 --- /dev/null +++ b/ISAJET/isajet/izisp2.inc @@ -0,0 +1,10 @@ +#ifndef CERNLIB_ISAJET_IZISP2_INC +#define CERNLIB_ISAJET_IZISP2_INC +* +* +* izisp2.inc +* + INTEGER IZISP2 + PARAMETER (IZISP2=1) + +#endif diff --git a/ISAJET/isajet/izisp3.inc b/ISAJET/isajet/izisp3.inc new file mode 100644 index 00000000000..d058a76e24e --- /dev/null +++ b/ISAJET/isajet/izisp3.inc @@ -0,0 +1,10 @@ +#ifndef CERNLIB_ISAJET_IZISP3_INC +#define CERNLIB_ISAJET_IZISP3_INC +* +* +* izisp3.inc +* + INTEGER IZISP3 + PARAMETER (IZISP3=5) + +#endif diff --git a/ISAJET/isajet/izisrc.inc b/ISAJET/isajet/izisrc.inc new file mode 100644 index 00000000000..47756417328 --- /dev/null +++ b/ISAJET/isajet/izisrc.inc @@ -0,0 +1,17 @@ +#ifndef CERNLIB_ISAJET_IZISRC_INC +#define CERNLIB_ISAJET_IZISRC_INC +* +* +* izisrc.inc +* +C DEC/CMS REPLACEMENT HISTORY, Element IZISRC.LINK +C *1 25-JAN-1990 14:08:41 CSTEWART "Chip Stewart: LINK FILE FOR ISRC BANK" +C DEC/CMS REPLACEMENT HISTORY, Element IZISRC.LINK +C----------------------------------------------------------------------- +C Created 11-JAN-1990 16:49:35.86 Chip Stewart +C Link offset of bank ISRC in mother bank ISAB +C----------------------------------------------------------------------- + INTEGER IZISRC + PARAMETER ( IZISRC = 2) + +#endif diff --git a/ISAJET/isajet/izisv1.inc b/ISAJET/isajet/izisv1.inc new file mode 100644 index 00000000000..acde821f4a5 --- /dev/null +++ b/ISAJET/isajet/izisv1.inc @@ -0,0 +1,10 @@ +#ifndef CERNLIB_ISAJET_IZISV1_INC +#define CERNLIB_ISAJET_IZISV1_INC +* +* +* izisv1.inc +* + INTEGER IZISV1 + PARAMETER (IZISV1=3) + +#endif diff --git a/ISAJET/isajet/izisv2.inc b/ISAJET/isajet/izisv2.inc new file mode 100644 index 00000000000..afccab9ac74 --- /dev/null +++ b/ISAJET/isajet/izisv2.inc @@ -0,0 +1,10 @@ +#ifndef CERNLIB_ISAJET_IZISV2_INC +#define CERNLIB_ISAJET_IZISV2_INC +* +* +* izisv2.inc +* + INTEGER IZISV2 + PARAMETER (IZISV2=4) + +#endif diff --git a/ISAJET/isajet/izpjet.inc b/ISAJET/isajet/izpjet.inc new file mode 100644 index 00000000000..a17281b21da --- /dev/null +++ b/ISAJET/isajet/izpjet.inc @@ -0,0 +1,14 @@ +#ifndef CERNLIB_ISAJET_IZPJET_INC +#define CERNLIB_ISAJET_IZPJET_INC +* +* +* izpjet.inc +* +C----------------------------------------------------------------------- +C Created 7-NOV-1989 18:10:09.84 Chip Stewart +C Link offset of bank PJET in mother bank PJHD +C----------------------------------------------------------------------- + INTEGER IZPJET + PARAMETER ( IZPJET = 1) + +#endif diff --git a/ISAJET/isajet/izpjhd.inc b/ISAJET/isajet/izpjhd.inc new file mode 100644 index 00000000000..dbeea330f08 --- /dev/null +++ b/ISAJET/isajet/izpjhd.inc @@ -0,0 +1,14 @@ +#ifndef CERNLIB_ISAJET_IZPJHD_INC +#define CERNLIB_ISAJET_IZPJHD_INC +* +* +* izpjhd.inc +* +C----------------------------------------------------------------------- +C Created 7-NOV-1989 17:57:58.00 Chip Stewart +C Link offset of bank PJHD in mother bank ISAE +C----------------------------------------------------------------------- + INTEGER IZPJHD + PARAMETER ( IZPJHD = 8) + +#endif diff --git a/ISAJET/isajet/izpjpt.inc b/ISAJET/isajet/izpjpt.inc new file mode 100644 index 00000000000..bda6c0fa0d1 --- /dev/null +++ b/ISAJET/isajet/izpjpt.inc @@ -0,0 +1,14 @@ +#ifndef CERNLIB_ISAJET_IZPJPT_INC +#define CERNLIB_ISAJET_IZPJPT_INC +* +* +* izpjpt.inc +* +C----------------------------------------------------------------------- +C Created 7-NOV-1989 18:10:09.84 Chip Stewart +C Link offset of bank PJPT in mother bank PJHD +C----------------------------------------------------------------------- + INTEGER IZPJPT + PARAMETER ( IZPJPT = 1) + +#endif diff --git a/ISAJET/isajet/jetlim.inc b/ISAJET/isajet/jetlim.inc new file mode 100644 index 00000000000..8038aa03cee --- /dev/null +++ b/ISAJET/isajet/jetlim.inc @@ -0,0 +1,29 @@ +#ifndef CERNLIB_ISAJET_JETLIM_INC +#define CERNLIB_ISAJET_JETLIM_INC +* +* +* jetlim.inc +* +C Jet limits + INTEGER MXLIM + PARAMETER (MXLIM=8) + INTEGER MXLX12 + PARAMETER (MXLX12=12*MXLIM) + COMMON/JETLIM/PMIN(MXLIM),PMAX(MXLIM),PTMIN(MXLIM),PTMAX(MXLIM), + $YJMIN(MXLIM),YJMAX(MXLIM),PHIMIN(MXLIM),PHIMAX(MXLIM), + $XJMIN(MXLIM),XJMAX(MXLIM),THMIN(MXLIM),THMAX(MXLIM), + $SETLMJ(12*MXLIM) + SAVE /JETLIM/ + COMMON/FIXPAR/FIXP(MXLIM),FIXPT(MXLIM),FIXYJ(MXLIM), + $FIXPHI(MXLIM),FIXXJ(MXLIM),FIXQM,FIXQT,FIXYW,FIXXW,FIXPHW + SAVE /FIXPAR/ + COMMON/SGNPAR/CTHS(2,MXLIM),THS(2,MXLIM),YJS(2,MXLIM),XJS(2,MXLIM) + SAVE /SGNPAR/ + REAL PMIN,PMAX,PTMIN,PTMAX,YJMIN,YJMAX,PHIMIN,PHIMAX,XJMIN, + + XJMAX,THMIN,THMAX,BLIMS(12*MXLIM),CTHS,THS,YJS,XJS + LOGICAL SETLMJ + LOGICAL FIXQM,FIXQT,FIXYW,FIXXW,FIXPHW + LOGICAL FIXP,FIXPT,FIXYJ,FIXPHI,FIXXJ + EQUIVALENCE(BLIMS(1),PMIN(1)) + +#endif diff --git a/ISAJET/isajet/jetpar.inc b/ISAJET/isajet/jetpar.inc new file mode 100644 index 00000000000..41141ccf9e3 --- /dev/null +++ b/ISAJET/isajet/jetpar.inc @@ -0,0 +1,18 @@ +#ifndef CERNLIB_ISAJET_JETPAR_INC +#define CERNLIB_ISAJET_JETPAR_INC +* +* +* jetpar.inc +* + COMMON/JETPAR/P(3),PT(3),YJ(3),PHI(3),XJ(3),TH(3),CTH(3),STH(3) + 1 ,JETTYP(3),SHAT,THAT,UHAT,QSQ,X1,X2,PBEAM(2) + 2 ,QMW,QW,QTW,YW,XW,THW,QTMW,PHIW,SHAT1,THAT1,UHAT1,JWTYP + 3 ,ALFQSQ,CTHW,STHW,Q0W + 4 ,INITYP(2),ISIGS,PBEAMS(5) + SAVE /JETPAR/ + INTEGER JETTYP,JWTYP,INITYP,ISIGS + REAL P,PT,YJ,PHI,XJ,TH,CTH,STH,SHAT,THAT,UHAT,QSQ,X1,X2, + + PBEAM,QMW,QW,QTW,YW,XW,THW,QTMW,PHIW,SHAT1,THAT1,UHAT1, + + ALFQSQ,CTHW,STHW,Q0W,PBEAMS + +#endif diff --git a/ISAJET/isajet/jetset.inc b/ISAJET/isajet/jetset.inc new file mode 100644 index 00000000000..a754a139945 --- /dev/null +++ b/ISAJET/isajet/jetset.inc @@ -0,0 +1,19 @@ +#ifndef CERNLIB_ISAJET_JETSET_INC +#define CERNLIB_ISAJET_JETSET_INC +* +* +* jetset.inc +* + INTEGER MXJSET,JPACK + PARAMETER (MXJSET=400,JPACK=1000) + COMMON/JETSET/NJSET,PJSET(5,MXJSET),JORIG(MXJSET),JTYPE(MXJSET), + $JDCAY(MXJSET) + SAVE /JETSET/ +#if defined(CERNLIB_LEVEL2) +#include "isajet/l2jset.inc" +* Ignoring t=pass +#endif + INTEGER NJSET,JORIG,JTYPE,JDCAY + REAL PJSET + +#endif diff --git a/ISAJET/isajet/jetsig.inc b/ISAJET/isajet/jetsig.inc new file mode 100644 index 00000000000..9534de1e9c6 --- /dev/null +++ b/ISAJET/isajet/jetsig.inc @@ -0,0 +1,18 @@ +#ifndef CERNLIB_ISAJET_JETSIG_INC +#define CERNLIB_ISAJET_JETSIG_INC +* +* +* jetsig.inc +* + INTEGER MXSIGS,IOPAK + PARAMETER (MXSIGS=3000,IOPAK=100) + COMMON/JETSIG/SIGMA,SIGS(MXSIGS),NSIGS,INOUT(MXSIGS),SIGEVT + SAVE /JETSIG/ +#if defined(CERNLIB_LEVEL2) +#include "isajet/l2sigs.inc" +* Ignoring t=pass +#endif + INTEGER NSIGS,INOUT + REAL SIGMA,SIGS,SIGEVT + +#endif diff --git a/ISAJET/isajet/jwork.inc b/ISAJET/isajet/jwork.inc new file mode 100644 index 00000000000..d899dee44e5 --- /dev/null +++ b/ISAJET/isajet/jwork.inc @@ -0,0 +1,15 @@ +#ifndef CERNLIB_ISAJET_JWORK_INC +#define CERNLIB_ISAJET_JWORK_INC +* +* +* jwork.inc +* + COMMON/JWORK/ZZC(MXJSET),JMATCH(MXJSET),TNEW,P1CM(4), + 1J1,J2,J3,J4,J5,E1CM,E2CM,E3CM,E4CM,E5CM + SAVE /JWORK/ + LOGICAL TNEW + EQUIVALENCE (J1,JJ(1)),(E1CM,EE(1)) + INTEGER JMATCH,J1,J2,J3,J4,J5,JJ(5) + REAL ZZC,P1CM,E1CM,E2CM,E3CM,E4CM,E5CM,EE(5) + +#endif diff --git a/ISAJET/isajet/jwork2.inc b/ISAJET/isajet/jwork2.inc new file mode 100644 index 00000000000..3566192d04a --- /dev/null +++ b/ISAJET/isajet/jwork2.inc @@ -0,0 +1,14 @@ +#ifndef CERNLIB_ISAJET_JWORK2_INC +#define CERNLIB_ISAJET_JWORK2_INC +* +* +* jwork2.inc +* + COMMON/JWORK2/JVIR(2),PFINAL(5),SGN,ZMIN,ZMAX,DZMAX,JET,GLFORC(2), + $ZGOOD,JIN(400),FXTEST(MXJSET) + SAVE /JWORK2/ + LOGICAL GLFORC,ZGOOD + INTEGER JVIR,JET,JIN + REAL PFINAL,SGN,ZMIN,ZMAX,DZMAX,FXTEST + +#endif diff --git a/ISAJET/isajet/keys.inc b/ISAJET/isajet/keys.inc new file mode 100644 index 00000000000..cc0c411f6ea --- /dev/null +++ b/ISAJET/isajet/keys.inc @@ -0,0 +1,20 @@ +#ifndef CERNLIB_ISAJET_KEYS_INC +#define CERNLIB_ISAJET_KEYS_INC +* +* +* keys.inc +* + INTEGER MXKEYS + PARAMETER (MXKEYS=20) + COMMON/KEYS/IKEYS,KEYON,KEYS(MXKEYS) + COMMON/XKEYS/REAC + SAVE /KEYS/,/XKEYS/ + LOGICAL KEYS + LOGICAL KEYON + CHARACTER*8 REAC + INTEGER IKEYS + +#endif + + + diff --git a/ISAJET/isajet/kkgrav.inc b/ISAJET/isajet/kkgrav.inc new file mode 100644 index 00000000000..b0eacd8d4a5 --- /dev/null +++ b/ISAJET/isajet/kkgrav.inc @@ -0,0 +1,14 @@ +#ifndef CERNLIB_ISAJET_KKGRAV_INC +#define CERNLIB_ISAJET_KKGRAV_INC +* +* +* kkgrav.inc +* +C KKGravity common + COMMON/KKGRAV/NEXTRAD,MASSD,KKGSD,SURFD,UVCUT + INTEGER NEXTRAD + REAL MASSD,KKGSD,SURFD + LOGICAL UVCUT + SAVE /KKGRAV/ + +#endif diff --git a/ISAJET/isajet/l2cal.inc b/ISAJET/isajet/l2cal.inc new file mode 100644 index 00000000000..e20837060d0 --- /dev/null +++ b/ISAJET/isajet/l2cal.inc @@ -0,0 +1,11 @@ +#ifndef CERNLIB_ISAJET_L2CAL_INC +#define CERNLIB_ISAJET_L2CAL_INC +* +* +* l2cal.inc +* +#if defined(CERNLIB_LEVEL2) + LEVEL2,/CALOR/ +#endif + +#endif diff --git a/ISAJET/isajet/l2dky.inc b/ISAJET/isajet/l2dky.inc new file mode 100644 index 00000000000..6c2650b1e98 --- /dev/null +++ b/ISAJET/isajet/l2dky.inc @@ -0,0 +1,11 @@ +#ifndef CERNLIB_ISAJET_L2DKY_INC +#define CERNLIB_ISAJET_L2DKY_INC +* +* +* l2dky.inc +* +#if defined(CERNLIB_LEVEL2) + LEVEL 2,/DKYTAB/ +#endif + +#endif diff --git a/ISAJET/isajet/l2getj.inc b/ISAJET/isajet/l2getj.inc new file mode 100644 index 00000000000..35f66b0d848 --- /dev/null +++ b/ISAJET/isajet/l2getj.inc @@ -0,0 +1,11 @@ +#ifndef CERNLIB_ISAJET_L2GETJ_INC +#define CERNLIB_ISAJET_L2GETJ_INC +* +* +* l2getj.inc +* +#if defined(CERNLIB_LEVEL2) + LEVEL2,/GETCOM/ +#endif + +#endif diff --git a/ISAJET/isajet/l2jset.inc b/ISAJET/isajet/l2jset.inc new file mode 100644 index 00000000000..5ff296584d8 --- /dev/null +++ b/ISAJET/isajet/l2jset.inc @@ -0,0 +1,11 @@ +#ifndef CERNLIB_ISAJET_L2JSET_INC +#define CERNLIB_ISAJET_L2JSET_INC +* +* +* l2jset.inc +* +#if defined(CERNLIB_LEVEL2) + LEVEL2,/JETSET/ +#endif + +#endif diff --git a/ISAJET/isajet/l2part.inc b/ISAJET/isajet/l2part.inc new file mode 100644 index 00000000000..b2e8cbecdde --- /dev/null +++ b/ISAJET/isajet/l2part.inc @@ -0,0 +1,11 @@ +#ifndef CERNLIB_ISAJET_L2PART_INC +#define CERNLIB_ISAJET_L2PART_INC +* +* +* l2part.inc +* +#if defined(CERNLIB_LEVEL2) + LEVEL2,/PARTCL/ +#endif + +#endif diff --git a/ISAJET/isajet/l2sigs.inc b/ISAJET/isajet/l2sigs.inc new file mode 100644 index 00000000000..b44bd04a320 --- /dev/null +++ b/ISAJET/isajet/l2sigs.inc @@ -0,0 +1,11 @@ +#ifndef CERNLIB_ISAJET_L2SIGS_INC +#define CERNLIB_ISAJET_L2SIGS_INC +* +* +* l2sigs.inc +* +#if defined(CERNLIB_LEVEL2) + LEVEL2,/JETSIG/ +#endif + +#endif diff --git a/ISAJET/isajet/l2zevl.inc b/ISAJET/isajet/l2zevl.inc new file mode 100644 index 00000000000..458173e5a2d --- /dev/null +++ b/ISAJET/isajet/l2zevl.inc @@ -0,0 +1,11 @@ +#ifndef CERNLIB_ISAJET_L2ZEVL_INC +#define CERNLIB_ISAJET_L2ZEVL_INC +* +* +* l2zevl.inc +* +#if defined(CERNLIB_LEVEL2) + LEVEL2, /ZEVEL/ +#endif + +#endif diff --git a/ISAJET/isajet/l2zout.inc b/ISAJET/isajet/l2zout.inc new file mode 100644 index 00000000000..95c76e18b6e --- /dev/null +++ b/ISAJET/isajet/l2zout.inc @@ -0,0 +1,11 @@ +#ifndef CERNLIB_ISAJET_L2ZOUT_INC +#define CERNLIB_ISAJET_L2ZOUT_INC +* +* +* l2zout.inc +* +#if defined(CERNLIB_LEVEL2) + LEVEL2,/ZVOUT/ +#endif + +#endif diff --git a/ISAJET/isajet/limevl.inc b/ISAJET/isajet/limevl.inc new file mode 100644 index 00000000000..8a430fc9472 --- /dev/null +++ b/ISAJET/isajet/limevl.inc @@ -0,0 +1,12 @@ +#ifndef CERNLIB_ISAJET_LIMEVL_INC +#define CERNLIB_ISAJET_LIMEVL_INC +* +* +* limevl.inc +* + COMMON /LIMEVL/ ETTHRS,CONCUT,USELIM + SAVE /LIMEVL/ + REAL ETTHRS,CONCUT + LOGICAL USELIM + +#endif diff --git a/ISAJET/isajet/listss.inc b/ISAJET/isajet/listss.inc new file mode 100644 index 00000000000..32b16b2f526 --- /dev/null +++ b/ISAJET/isajet/listss.inc @@ -0,0 +1,32 @@ +#ifndef CERNLIB_ISAJET_LISTSS_INC +#define CERNLIB_ISAJET_LISTSS_INC +* +* +* listss.inc +* +C LISTSS IDENT and JETTYPE codes +C ISGL ISUPL -ISUPL ISDNL -ISDNL ISSTL -ISSTL ISCHL -ISCHL +C 1 2 3 4 5 6 7 8 9 +C ISBT1 -ISBT1 ISTP1 -ISTP1 ISUPR -ISUPR ISDNR -ISDNR ISSTR +C 10 11 12 13 14 15 16 17 18 +C -ISSTR ISCHR -ISCHR ISBT2 -ISBT2 ISTP2 -ISTP2 ISW1 -ISW1 +C 19 20 21 22 23 24 25 26 27 +C ISW2 -ISW2 ISZ1 ISZ2 ISZ3 ISZ4 ISNEL -ISNEL ISEL +C 28 29 30 31 32 33 34 35 36 +C -ISEL ISNML -ISNML ISMUL -ISMUL ISNTL -ISNTL ISTAU1-ISTAU1 +C 37 38 39 40 41 42 43 44 45 +C ISER -ISER ISMUR -ISMUR ISTAU2-ISTAU2 9 1 -1 +C 46 47 48 49 50 51 52 53 54 +C 2 -2 3 -3 4 -4 5 -5 6 +C 55 56 57 58 59 60 61 62 63 +C -6 11 -11 12 -12 13 -13 14 -14 +C 64 65 66 67 68 69 70 71 72 +C 15 -15 16 -16 10 80 -80 90 ISHL +C 73 74 75 76 77 78 79 80 81 +C ISHH ISHA ISHC -ISHC +C 82 83 84 85 + COMMON/LISTSS/LISTSS(85) + INTEGER LISTSS + SAVE /LISTSS/ + +#endif diff --git a/ISAJET/isajet/lkpjet.inc b/ISAJET/isajet/lkpjet.inc new file mode 100644 index 00000000000..0ca87850ed0 --- /dev/null +++ b/ISAJET/isajet/lkpjet.inc @@ -0,0 +1,41 @@ +#ifndef CERNLIB_ISAJET_LKPJET_INC +#define CERNLIB_ISAJET_LKPJET_INC +* +* +* lkpjet.inc +* +C---------------------------------------------------------------------- +C- +C- Name LKPJET.INC +C- Purpose Temporary link area for PJET banks +C- Created 5-DEC-1989 CHIP STEWART (HBP) +C- Updated 13-JAN-1990 Harrison B. Prosper +C- Updated 6-NOV-1990 Chip Stewart - ADDED ISP1,ISV1 +C- +C---------------------------------------------------------------------- +C +C **** JPJET(1) User flag +C **** JPJET(2) System word +C **** JPJET(3) First link in area (= KPJET(1)) +C + INTEGER PJLON + PARAMETER( PJLON = 1 ) ! Activate link area +C + INTEGER PJLOFF + PARAMETER( PJLOFF= 0 ) ! De-activate link area +C + INTEGER MXPJET + PARAMETER( MXPJET = 8 ) + INTEGER LPJHD,LPJET,LPJPT,LISAQ,LISAJ,LISP1,LISV1 + INTEGER JPJET,KPJET(MXPJET) + EQUIVALENCE ( LPJHD, KPJET(1) ) + EQUIVALENCE ( LPJET, KPJET(2) ) + EQUIVALENCE ( LPJPT, KPJET(3) ) + EQUIVALENCE ( LISAQ, KPJET(5) ) + EQUIVALENCE ( LISAJ, KPJET(6) ) + EQUIVALENCE ( LISP1, KPJET(7) ) + EQUIVALENCE ( LISV1, KPJET(8) ) + COMMON /LKPJET/ JPJET(2),KPJET + SAVE /LKPJET/ + +#endif diff --git a/ISAJET/isajet/lstprt.inc b/ISAJET/isajet/lstprt.inc new file mode 100644 index 00000000000..aa995da6418 --- /dev/null +++ b/ISAJET/isajet/lstprt.inc @@ -0,0 +1,11 @@ +#ifndef CERNLIB_ISAJET_LSTPRT_INC +#define CERNLIB_ISAJET_LSTPRT_INC +* +* +* lstprt.inc +* + COMMON/LSTPRT/LSTPRT + SAVE /LSTPRT/ + INTEGER LSTPRT + +#endif diff --git a/ISAJET/isajet/mbgen.inc b/ISAJET/isajet/mbgen.inc new file mode 100644 index 00000000000..be68347ef02 --- /dev/null +++ b/ISAJET/isajet/mbgen.inc @@ -0,0 +1,15 @@ +#ifndef CERNLIB_ISAJET_MBGEN_INC +#define CERNLIB_ISAJET_MBGEN_INC +* +* +* mbgen.inc +* + INTEGER LIMPOM + PARAMETER (LIMPOM=20) + COMMON/MBGEN/POMWT(LIMPOM),POMGEN(LIMPOM),MNPOM,MXPOM,PDIFFR, + $NPOM,XBARY(2),DXBARY(2),XPOM(LIMPOM,2) + SAVE /MBGEN/ + INTEGER MNPOM,MXPOM,NPOM + REAL POMWT,POMGEN,PDIFFR,XBARY,DXBARY,XPOM + +#endif diff --git a/ISAJET/isajet/mbpar.inc b/ISAJET/isajet/mbpar.inc new file mode 100644 index 00000000000..363ea63a9bc --- /dev/null +++ b/ISAJET/isajet/mbpar.inc @@ -0,0 +1,12 @@ +#ifndef CERNLIB_ISAJET_MBPAR_INC +#define CERNLIB_ISAJET_MBPAR_INC +* +* +* mbpar.inc +* + COMMON/MBPAR/PUD0,PJSPN,PISPN,SIGQT0,XGEN0(2),PMIX01(3,2) + 1,PMIX02(3,2),PBARY0 + SAVE /MBPAR/ + REAL PUD0,PJSPN,PISPN,SIGQT0,XGEN0,PMIX01,PMIX02,PBARY0 + +#endif diff --git a/ISAJET/isajet/mgcoms.inc b/ISAJET/isajet/mgcoms.inc new file mode 100644 index 00000000000..e50e51bf292 --- /dev/null +++ b/ISAJET/isajet/mgcoms.inc @@ -0,0 +1,37 @@ +#ifndef CERNLIB_ISAJET_MGCOMS_INC +#define CERNLIB_ISAJET_MGCOMS_INC +* +* +* mgcoms.inc +* +C===== Begin common blocks used by MadGraph + REAL*8 GW, GWWA, GWWZ + COMMON /COUP1/ GW, GWWA, GWWZ + SAVE /COUP1/ + REAL*8 GAL(2),GAU(2),GAD(2),GWF(2) + COMMON /COUP2A/ GAL, GAU, GAD, GWF + SAVE /COUP2A/ + REAL*8 GZN(2),GZL(2),GZU(2),GZD(2),G1(2) + COMMON /COUP2B/ GZN, GZL, GZU, GZD, G1 + SAVE /COUP2B/ + REAL*8 GWWH,GZZH,GHHH,GWWHH,GZZHH,GHHHH + COMMON /COUP3/ GWWH,GZZH,GHHH,GWWHH,GZZHH,GHHHH + SAVE /COUP3/ + COMPLEX*16 GCHF(2,12) + COMMON /COUP4/ GCHF + SAVE /COUP4/ + REAL*8 WMASS,WWIDTH,ZMASS,ZWIDTH + COMMON /VMASS1/ WMASS,WWIDTH,ZMASS,ZWIDTH + SAVE /VMASS1/ + REAL*8 AMASS,AWIDTH,HMASS,HWIDTH + COMMON /VMASS2/ AMASS,AWIDTH,HMASS,HWIDTH + SAVE /VMASS2/ + REAL*8 FMASS(12), FWIDTH(12) + COMMON /FERMIONS/ FMASS, FWIDTH + SAVE /FERMIONS/ + REAL*8 GG(2), G + COMMON /COUPQCD/ GG, G + SAVE /COUPQCD/ +C===== End common blocks used by MadGraph + +#endif diff --git a/ISAJET/isajet/mgkin.inc b/ISAJET/isajet/mgkin.inc new file mode 100644 index 00000000000..5cfab2d505e --- /dev/null +++ b/ISAJET/isajet/mgkin.inc @@ -0,0 +1,13 @@ +#ifndef CERNLIB_ISAJET_MGKIN_INC +#define CERNLIB_ISAJET_MGKIN_INC +* +* +* mgkin.inc +* +C Double precision PJETS; MXJETS defined in /JETLIM/ +C Format matches MadGraph + COMMON/MGKIN/PJETS8(0:3,MXLIM+2),AMJET8(MXLIM+2) + REAL*8 PJETS8,AMJET8 + SAVE /MGKIN/ + +#endif diff --git a/ISAJET/isajet/mglims.inc b/ISAJET/isajet/mglims.inc new file mode 100644 index 00000000000..3130c069896 --- /dev/null +++ b/ISAJET/isajet/mglims.inc @@ -0,0 +1,14 @@ +#ifndef CERNLIB_ISAJET_MGLIMS_INC +#define CERNLIB_ISAJET_MGLIMS_INC +* +* +* mglims.inc +* +C Limits for MadGraph multiparton processes + COMMON/MGLIMS/EHMGMN,EHMGMX,YHMGMN,YHMGMX, + $AMIJMN(MXLIM,MXLIM),AMIJMX(MXLIM,MXLIM),FIXMIJ(MXLIM,MXLIM) + SAVE /MGLIMS/ + REAL EHMGMN,EHMGMX,YHMGMN,YHMGMX,AMIJMN,AMIJMX + LOGICAL FIXMIJ + +#endif diff --git a/ISAJET/isajet/mgsigs.inc b/ISAJET/isajet/mgsigs.inc new file mode 100644 index 00000000000..402f4c4f7bf --- /dev/null +++ b/ISAJET/isajet/mgsigs.inc @@ -0,0 +1,22 @@ +#ifndef CERNLIB_ISAJET_MGSIGS_INC +#define CERNLIB_ISAJET_MGSIGS_INC +* +* +* mgsigs.inc +* +C +C Running totals for MadGraph cross sections +C WTTOT8/NWTTOT = total cross section +C WTSUM8/NWT8 = channel cross section +C IFUNC8, IDENT8 = MadGraph function code channel flavors +C + INTEGER MXSIG8 + PARAMETER (MXSIG8=1000) + COMMON /MGSIGS/WTTOT8,WTSUM8(MXSIG8),WTMAX8(MXSIG8),NSIG8, + $NWTTOT,NWT8(MXSIG8),IFUNC8(MXSIG8),IDENT8(MXLIM+2,MXSIG8), + $ISORT8(MXSIG8) + REAL*8 WTTOT8,WTSUM8,WTMAX8 + INTEGER NSIG8,NWTTOT,NWT8,IFUNC8,IDENT8,ISORT8 + SAVE /MGSIGS/ + +#endif diff --git a/ISAJET/isajet/myhist.inc b/ISAJET/isajet/myhist.inc new file mode 100644 index 00000000000..0c9780bdd97 --- /dev/null +++ b/ISAJET/isajet/myhist.inc @@ -0,0 +1,11 @@ +#ifndef CERNLIB_ISAJET_MYHIST_INC +#define CERNLIB_ISAJET_MYHIST_INC +* +* +* myhist.inc +* + COMMON/MYHIST/MXHIST,NHSHFT + SAVE /MYHIST/ + INTEGER MXHIST,NHSHFT + +#endif diff --git a/ISAJET/isajet/nodcay.inc b/ISAJET/isajet/nodcay.inc new file mode 100644 index 00000000000..84a1515fa0a --- /dev/null +++ b/ISAJET/isajet/nodcay.inc @@ -0,0 +1,11 @@ +#ifndef CERNLIB_ISAJET_NODCAY_INC +#define CERNLIB_ISAJET_NODCAY_INC +* +* +* nodcay.inc +* + COMMON/NODCAY/NODCAY,NOETA,NOPI0,NONUNU,NOEVOL,NOHADR,NOGRAV + SAVE /NODCAY/ + LOGICAL NODCAY,NOETA,NOPI0,NONUNU,NOEVOL,NOHADR,NOGRAV + +#endif diff --git a/ISAJET/isajet/partcl.inc b/ISAJET/isajet/partcl.inc new file mode 100644 index 00000000000..ae05a81c1f8 --- /dev/null +++ b/ISAJET/isajet/partcl.inc @@ -0,0 +1,19 @@ +#ifndef CERNLIB_ISAJET_PARTCL_INC +#define CERNLIB_ISAJET_PARTCL_INC +* +* +* partcl.inc +* + INTEGER MXPTCL,IPACK + PARAMETER (MXPTCL=4000,IPACK=10000) + COMMON/PARTCL/NPTCL,PPTCL(5,MXPTCL),IORIG(MXPTCL),IDENT(MXPTCL) + 1,IDCAY(MXPTCL) + SAVE /PARTCL/ +#if defined(CERNLIB_LEVEL2) +#include "isajet/l2part.inc" +* Ignoring t=pass +#endif + INTEGER NPTCL,IORIG,IDENT,IDCAY + REAL PPTCL + +#endif diff --git a/ISAJET/isajet/pi.inc b/ISAJET/isajet/pi.inc new file mode 100644 index 00000000000..d511b13c47b --- /dev/null +++ b/ISAJET/isajet/pi.inc @@ -0,0 +1,17 @@ +#ifndef CERNLIB_ISAJET_PI_INC +#define CERNLIB_ISAJET_PI_INC +* +* +* pi.inc +* + DOUBLE PRECISION PI, TWOPI, HALFPI, RADIAN +C +C last significant (correctly rounded) decimal place on VAX: +C | +C V + PARAMETER (PI= 3.1415 92653 58979 32384 6) + PARAMETER (TWOPI= 6.2831 85307 17958 64769 3) + PARAMETER (HALFPI= 1.5707 96326 79489 66192 3) + PARAMETER (RADIAN= 0.0174532 92519 94329 5769237) + +#endif diff --git a/ISAJET/isajet/pinits.inc b/ISAJET/isajet/pinits.inc new file mode 100644 index 00000000000..eb4de724328 --- /dev/null +++ b/ISAJET/isajet/pinits.inc @@ -0,0 +1,12 @@ +#ifndef CERNLIB_ISAJET_PINITS_INC +#define CERNLIB_ISAJET_PINITS_INC +* +* +* pinits.inc +* + COMMON/PINITS/PINITS(5,2),IDINIT(2) + SAVE /PINITS/ + INTEGER IDINIT + REAL PINITS + +#endif diff --git a/ISAJET/isajet/pjets.inc b/ISAJET/isajet/pjets.inc new file mode 100644 index 00000000000..e7a4fbce21d --- /dev/null +++ b/ISAJET/isajet/pjets.inc @@ -0,0 +1,15 @@ +#ifndef CERNLIB_ISAJET_PJETS_INC +#define CERNLIB_ISAJET_PJETS_INC +* +* +* pjets.inc +* + INTEGER MXJETS + PARAMETER (MXJETS=10) + COMMON/PJETS/PJETS(5,MXJETS),IDJETS(MXJETS),QWJET(5),IDENTW + $,PPAIR(5,4),IDPAIR(4),JPAIR(4),NPAIR,IFRAME(MXJETS) + SAVE /PJETS/ + INTEGER IDJETS,IDENTW,IDPAIR,JPAIR,NPAIR,IFRAME + REAL PJETS,QWJET,PPAIR + +#endif diff --git a/ISAJET/isajet/primar.inc b/ISAJET/isajet/primar.inc new file mode 100644 index 00000000000..16f7c0828aa --- /dev/null +++ b/ISAJET/isajet/primar.inc @@ -0,0 +1,12 @@ +#ifndef CERNLIB_ISAJET_PRIMAR_INC +#define CERNLIB_ISAJET_PRIMAR_INC +* +* +* primar.inc +* + COMMON/PRIMAR/NJET,SCM,HALFE,ECM,IDIN(2),NEVENT,NTRIES,NSIGMA + SAVE /PRIMAR/ + INTEGER NJET,IDIN,NEVENT,NTRIES,NSIGMA + REAL SCM,HALFE,ECM + +#endif diff --git a/ISAJET/isajet/prtout.inc b/ISAJET/isajet/prtout.inc new file mode 100644 index 00000000000..f29a73dcc6a --- /dev/null +++ b/ISAJET/isajet/prtout.inc @@ -0,0 +1,11 @@ +#ifndef CERNLIB_ISAJET_PRTOUT_INC +#define CERNLIB_ISAJET_PRTOUT_INC +* +* +* prtout.inc +* + COMMON/PRTOUT/NEVPRT,NJUMP + SAVE /PRTOUT/ + INTEGER NEVPRT,NJUMP + +#endif diff --git a/ISAJET/isajet/ptpar.inc b/ISAJET/isajet/ptpar.inc new file mode 100644 index 00000000000..243d1a1fca9 --- /dev/null +++ b/ISAJET/isajet/ptpar.inc @@ -0,0 +1,11 @@ +#ifndef CERNLIB_ISAJET_PTPAR_INC +#define CERNLIB_ISAJET_PTPAR_INC +* +* +* ptpar.inc +* + COMMON/PTPAR/PTFUN1,PTFUN2,PTGEN1,PTGEN2,PTGEN3,SIGMAX + SAVE /PTPAR/ + REAL PTFUN1,PTFUN2,PTGEN1,PTGEN2,PTGEN3,SIGMAX + +#endif diff --git a/ISAJET/isajet/q1q2.inc b/ISAJET/isajet/q1q2.inc new file mode 100644 index 00000000000..d6710c8ce96 --- /dev/null +++ b/ISAJET/isajet/q1q2.inc @@ -0,0 +1,14 @@ +#ifndef CERNLIB_ISAJET_Q1Q2_INC +#define CERNLIB_ISAJET_Q1Q2_INC +* +* +* q1q2.inc +* + INTEGER MXGOQ,MXGOJ + PARAMETER (MXGOQ=85,MXGOJ=8) + COMMON/Q1Q2/GOQ(MXGOQ,MXGOJ),GOALL(MXGOJ),GODY(4),STDDY, + $GOWW(25,2),ALLWW(2),GOWMOD(25,MXGOJ) + SAVE /Q1Q2/ + LOGICAL GOQ,GOALL,GODY,STDDY,GOWW,ALLWW,GOWMOD + +#endif diff --git a/ISAJET/isajet/qcdpar.inc b/ISAJET/isajet/qcdpar.inc new file mode 100644 index 00000000000..3be92a3bc5c --- /dev/null +++ b/ISAJET/isajet/qcdpar.inc @@ -0,0 +1,12 @@ +#ifndef CERNLIB_ISAJET_QCDPAR_INC +#define CERNLIB_ISAJET_QCDPAR_INC +* +* +* qcdpar.inc +* + COMMON/QCDPAR/ALAM,ALAM2,CUTJET,ISTRUC + SAVE /QCDPAR/ + INTEGER ISTRUC + REAL ALAM,ALAM2,CUTJET + +#endif diff --git a/ISAJET/isajet/qlmass.inc b/ISAJET/isajet/qlmass.inc new file mode 100644 index 00000000000..35a6d60caf6 --- /dev/null +++ b/ISAJET/isajet/qlmass.inc @@ -0,0 +1,12 @@ +#ifndef CERNLIB_ISAJET_QLMASS_INC +#define CERNLIB_ISAJET_QLMASS_INC +* +* +* qlmass.inc +* + COMMON/QLMASS/AMLEP(100),NQLEP,NMES,NBARY + SAVE /QLMASS/ + INTEGER NQLEP,NMES,NBARY + REAL AMLEP + +#endif diff --git a/ISAJET/isajet/qsave.inc b/ISAJET/isajet/qsave.inc new file mode 100644 index 00000000000..8b9d23a32b7 --- /dev/null +++ b/ISAJET/isajet/qsave.inc @@ -0,0 +1,11 @@ +#ifndef CERNLIB_ISAJET_QSAVE_INC +#define CERNLIB_ISAJET_QSAVE_INC +* +* +* qsave.inc +* + COMMON/QSAVE/QSAVE(29,2) + SAVE /QSAVE/ + REAL QSAVE + +#endif diff --git a/ISAJET/isajet/quest.inc b/ISAJET/isajet/quest.inc new file mode 100644 index 00000000000..5b9f99b04ed --- /dev/null +++ b/ISAJET/isajet/quest.inc @@ -0,0 +1,13 @@ +#ifndef CERNLIB_ISAJET_QUEST_INC +#define CERNLIB_ISAJET_QUEST_INC +* +* +* quest.inc +* +C +C Zebra common, returns status information + COMMON /QUEST/ IQUEST(100) + SAVE /QUEST/ + INTEGER IQUEST + +#endif diff --git a/ISAJET/isajet/rectp.inc b/ISAJET/isajet/rectp.inc new file mode 100644 index 00000000000..4386f2e0e82 --- /dev/null +++ b/ISAJET/isajet/rectp.inc @@ -0,0 +1,11 @@ +#ifndef CERNLIB_ISAJET_RECTP_INC +#define CERNLIB_ISAJET_RECTP_INC +* +* +* rectp.inc +* + COMMON/RECTP/IRECTP,IREC + SAVE /RECTP/ + INTEGER IRECTP,IREC + +#endif diff --git a/ISAJET/isajet/seed.inc b/ISAJET/isajet/seed.inc new file mode 100644 index 00000000000..d9b3942dea6 --- /dev/null +++ b/ISAJET/isajet/seed.inc @@ -0,0 +1,11 @@ +#ifndef CERNLIB_ISAJET_SEED_INC +#define CERNLIB_ISAJET_SEED_INC +* +* +* seed.inc +* + COMMON/SEED/XSEED + SAVE /SEED/ + CHARACTER*24 XSEED + +#endif diff --git a/ISAJET/isajet/ssinf.inc b/ISAJET/isajet/ssinf.inc new file mode 100644 index 00000000000..8a450093e68 --- /dev/null +++ b/ISAJET/isajet/ssinf.inc @@ -0,0 +1,10 @@ +#ifndef CERNLIB_ISAJET_SSINF_INC +#define CERNLIB_ISAJET_SSINF_INC +* +* +* ssinf.inc +* + COMMON/SSINF/XLAM + DOUBLE PRECISION XLAM + +#endif diff --git a/ISAJET/isajet/sslun.inc b/ISAJET/isajet/sslun.inc new file mode 100644 index 00000000000..8803753592f --- /dev/null +++ b/ISAJET/isajet/sslun.inc @@ -0,0 +1,11 @@ +#ifndef CERNLIB_ISAJET_SSLUN_INC +#define CERNLIB_ISAJET_SSLUN_INC +* +* +* sslun.inc +* + COMMON/SSLUN/LOUT + INTEGER LOUT + SAVE /SSLUN/ + +#endif diff --git a/ISAJET/isajet/ssmode.inc b/ISAJET/isajet/ssmode.inc new file mode 100644 index 00000000000..b36b9289e5f --- /dev/null +++ b/ISAJET/isajet/ssmode.inc @@ -0,0 +1,24 @@ +#ifndef CERNLIB_ISAJET_SSMODE_INC +#define CERNLIB_ISAJET_SSMODE_INC +* +* +* ssmode.inc +* +C MXSS = maximum number of modes +C NSSMOD = number of modes +C ISSMOD = initial particle +C JSSMOD = final particles +C GSSMOD = width +C BSSMOD = branching ratio +C MSSMOD = decay matrix element pointer +C LSSMOD = logical flag used internally by SSME3 + INTEGER MXSS + PARAMETER (MXSS=1000) + COMMON/SSMODE/NSSMOD,ISSMOD(MXSS),JSSMOD(5,MXSS),GSSMOD(MXSS) + $,BSSMOD(MXSS),MSSMOD(MXSS),LSSMOD + INTEGER NSSMOD,ISSMOD,JSSMOD,MSSMOD + REAL GSSMOD,BSSMOD + LOGICAL LSSMOD + SAVE /SSMODE/ + +#endif diff --git a/ISAJET/isajet/sspar.inc b/ISAJET/isajet/sspar.inc new file mode 100644 index 00000000000..e9035eaed7a --- /dev/null +++ b/ISAJET/isajet/sspar.inc @@ -0,0 +1,55 @@ +#ifndef CERNLIB_ISAJET_SSPAR_INC +#define CERNLIB_ISAJET_SSPAR_INC +* +* +* sspar.inc +* +C SUSY parameters +C AMGLSS = gluino mass +C AMULSS = up-left squark mass +C AMELSS = left-selectron mass +C AMERSS = right-slepton mass +C AMNiSS = sneutrino mass for generation i +C TWOM1 = Higgsino mass = - mu +C RV2V1 = ratio v2/v1 of vev's +C AMTLSS,AMTRSS = left,right stop masses +C AMT1SS,AMT2SS = light,heavy stop masses +C AMBLSS,AMBRSS = left,right sbottom masses +C AMB1SS,AMB2SS = light,heavy sbottom masses +C AMLLSS,AMLRSS = left,right stau masses +C AML1SS,AML2SS = light,heavy stau masses +C AMZiSS = signed mass of Zi +C ZMIXSS = Zi mixing matrix +C AMWiSS = signed Wi mass +C GAMMAL,GAMMAR = Wi left, right mixing angles +C AMHL,AMHH,AMHA = neutral Higgs h0, H0, A0 masses +C AMHC = charged Higgs H+ mass +C ALFAH = Higgs mixing angle +C AAT = stop trilinear term +C THETAT = stop mixing angle +C AAB = sbottom trilinear term +C THETAB = sbottom mixing angle +C AAL = stau trilinear term +C THETAL = stau mixing angle +C AMGVSS = gravitino mass + COMMON/SSPAR/AMGLSS,AMULSS,AMURSS,AMDLSS,AMDRSS,AMSLSS + $,AMSRSS,AMCLSS,AMCRSS,AMBLSS,AMBRSS,AMB1SS,AMB2SS + $,AMTLSS,AMTRSS,AMT1SS,AMT2SS,AMELSS,AMERSS,AMMLSS,AMMRSS + $,AMLLSS,AMLRSS,AML1SS,AML2SS,AMN1SS,AMN2SS,AMN3SS + $,TWOM1,RV2V1,AMZ1SS,AMZ2SS,AMZ3SS,AMZ4SS,ZMIXSS(4,4) + $,AMW1SS,AMW2SS + $,GAMMAL,GAMMAR,AMHL,AMHH,AMHA,AMHC,ALFAH,AAT,THETAT + $,AAB,THETAB,AAL,THETAL,AMGVSS + REAL AMGLSS,AMULSS,AMURSS,AMDLSS,AMDRSS,AMSLSS + $,AMSRSS,AMCLSS,AMCRSS,AMBLSS,AMBRSS,AMB1SS,AMB2SS + $,AMTLSS,AMTRSS,AMT1SS,AMT2SS,AMELSS,AMERSS,AMMLSS,AMMRSS + $,AMLLSS,AMLRSS,AML1SS,AML2SS,AMN1SS,AMN2SS,AMN3SS + $,TWOM1,RV2V1,AMZ1SS,AMZ2SS,AMZ3SS,AMZ4SS,ZMIXSS + $,AMW1SS,AMW2SS + $,GAMMAL,GAMMAR,AMHL,AMHH,AMHA,AMHC,ALFAH,AAT,THETAT + $,AAB,THETAB,AAL,THETAL,AMGVSS + REAL AMZISS(4) + EQUIVALENCE (AMZISS(1),AMZ1SS) + SAVE /SSPAR/ + +#endif diff --git a/ISAJET/isajet/sspols.inc b/ISAJET/isajet/sspols.inc new file mode 100644 index 00000000000..4f29bc951f7 --- /dev/null +++ b/ISAJET/isajet/sspols.inc @@ -0,0 +1,17 @@ +#ifndef CERNLIB_ISAJET_SSPOLS_INC +#define CERNLIB_ISAJET_SSPOLS_INC +* +* +* sspols.inc +* +C Polarizations in SUSY decays +C PTAUj(i) = P_tau for tauj -> ziss tau +C PTAUZi(j) = P_tau for ziss -> tauj tau +C PTAUZZ = P_tau for z2ss -> z1ss tau tau +C PTAUWZ = P_tau for w1ss -> z1ss tau nutau + COMMON/SSPOLS/PTAU1(4),PTAU2(4),PTAUZ2(2),PTAUZ3(2),PTAUZ4(2), + $PTAUZZ,PTAUWZ + SAVE /SSPOLS/ + REAL PTAU1,PTAU2,PTAUZ2,PTAUZ3,PTAUZ4,PTAUZZ,PTAUWZ + +#endif diff --git a/ISAJET/isajet/sssm.inc b/ISAJET/isajet/sssm.inc new file mode 100644 index 00000000000..af870768b34 --- /dev/null +++ b/ISAJET/isajet/sssm.inc @@ -0,0 +1,20 @@ +#ifndef CERNLIB_ISAJET_SSSM_INC +#define CERNLIB_ISAJET_SSSM_INC +* +* +* sssm.inc +* +C Standard model parameters +C AMUP,...,AMTP = quark masses +C AME,AMMU,AMTAU = lepton masses +C AMW,AMZ = W,Z masses +C GAMW,GAMZ = W,Z widths +C ALFAEM,SN2THW,ALFA3 = SM couplings +C ALQCD4 = 4 flavor lambda + COMMON/SSSM/AMUP,AMDN,AMST,AMCH,AMBT,AMTP,AME,AMMU,AMTAU + $,AMW,AMZ,GAMW,GAMZ,ALFAEM,SN2THW,ALFA2,ALFA3,ALQCD4 + REAL AMUP,AMDN,AMST,AMCH,AMBT,AMTP,AME,AMMU,AMTAU + $,AMW,AMZ,GAMW,GAMZ,ALFAEM,SN2THW,ALFA2,ALFA3,ALQCD4 + SAVE /SSSM/ + +#endif diff --git a/ISAJET/isajet/sstmp.inc b/ISAJET/isajet/sstmp.inc new file mode 100644 index 00000000000..8ee3417613b --- /dev/null +++ b/ISAJET/isajet/sstmp.inc @@ -0,0 +1,13 @@ +#ifndef CERNLIB_ISAJET_SSTMP_INC +#define CERNLIB_ISAJET_SSTMP_INC +* +* +* sstmp.inc +* +C Temporary parameters for functions + COMMON/SSTMP/TMP(10),ITMP(10) + REAL TMP + INTEGER ITMP + SAVE /SSTMP/ + +#endif diff --git a/ISAJET/isajet/sstype.inc b/ISAJET/isajet/sstype.inc new file mode 100644 index 00000000000..2fd8a00bbb3 --- /dev/null +++ b/ISAJET/isajet/sstype.inc @@ -0,0 +1,33 @@ +#ifndef CERNLIB_ISAJET_SSTYPE_INC +#define CERNLIB_ISAJET_SSTYPE_INC +* +* +* sstype.inc +* +C SM ident code definitions. These are standard ISAJET but +C can be changed. + INTEGER IDUP,IDDN,IDST,IDCH,IDBT,IDTP + INTEGER IDNE,IDE,IDNM,IDMU,IDNT,IDTAU + INTEGER IDGL,IDGM,IDW,IDZ,IDH + PARAMETER (IDUP=1,IDDN=2,IDST=3,IDCH=4,IDBT=5,IDTP=6) + PARAMETER (IDNE=11,IDE=12,IDNM=13,IDMU=14,IDNT=15,IDTAU=16) + PARAMETER (IDGL=9,IDGM=10,IDW=80,IDZ=90,IDH=81) +C SUSY ident code definitions. They are chosen to be similar +C to those in versions < 6.50 but may be changed. + INTEGER ISUPL,ISDNL,ISSTL,ISCHL,ISBT1,ISTP1 + INTEGER ISNEL,ISEL,ISNML,ISMUL,ISNTL,ISTAU1 + INTEGER ISUPR,ISDNR,ISSTR,ISCHR,ISBT2,ISTP2 + INTEGER ISNER,ISER,ISNMR,ISMUR,ISNTR,ISTAU2 + INTEGER ISZ1,ISZ2,ISZ3,ISZ4,ISW1,ISW2,ISGL + INTEGER ISHL,ISHH,ISHA,ISHC + INTEGER ISGRAV + PARAMETER (ISUPL=21,ISDNL=22,ISSTL=23,ISCHL=24,ISBT1=25,ISTP1=26) + PARAMETER (ISNEL=31,ISEL=32,ISNML=33,ISMUL=34,ISNTL=35,ISTAU1=36) + PARAMETER (ISUPR=41,ISDNR=42,ISSTR=43,ISCHR=44,ISBT2=45,ISTP2=46) + PARAMETER (ISNER=51,ISER=52,ISNMR=53,ISMUR=54,ISNTR=55,ISTAU2=56) + PARAMETER (ISGL=29) + PARAMETER (ISZ1=30,ISZ2=40,ISZ3=50,ISZ4=60,ISW1=39,ISW2=49) + PARAMETER (ISHL=82,ISHH=83,ISHA=84,ISHC=86) + PARAMETER (ISGRAV=91) + +#endif diff --git a/ISAJET/isajet/sugmg.inc b/ISAJET/isajet/sugmg.inc new file mode 100644 index 00000000000..24ebb1ac04c --- /dev/null +++ b/ISAJET/isajet/sugmg.inc @@ -0,0 +1,37 @@ +#ifndef CERNLIB_ISAJET_SUGMG_INC +#define CERNLIB_ISAJET_SUGMG_INC +* +* +* sugmg.inc +* +C Frozen couplings from RG equations: +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 +C Masses: +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: +C MGUTSS = M_GUT GGUTSS = g_GUT AGUTSS = alpha_GUT + COMMON /SUGMG/ MSS(32),GSS(29),MGUTSS,GGUTSS,AGUTSS,FTGUT, + $FBGUT,FTAGUT,FNGUT + REAL MSS,GSS,MGUTSS,GGUTSS,AGUTSS,FTGUT,FBGUT,FTAGUT,FNGUT + SAVE /SUGMG/ + +#endif diff --git a/ISAJET/isajet/sugnu.inc b/ISAJET/isajet/sugnu.inc new file mode 100644 index 00000000000..120d4c5ce7f --- /dev/null +++ b/ISAJET/isajet/sugnu.inc @@ -0,0 +1,18 @@ +#ifndef CERNLIB_ISAJET_SUGNU_INC +#define CERNLIB_ISAJET_SUGNU_INC +* +* +* sugnu.inc +* +C XNUSUG contains non-universal GUT scale soft terms for SUGRA: +C XNUSUG(1)=M1 XNUSUG(2)=M2 XNUSUG(3)=M3 +C XNUSUG(4)=A_tau XNUSUG(5)=A_b XNUSUG(6)=A_t +C XNUSUG(7)=m_Hd XNUSUG(8)=m_Hu XNUSUG(9)=m_eR XNUSUG(10)=m_eL +C XNUSUG(11)=m_dR XNUSUG(12)=m_uR XNUSUG(13)=m_uL XNUSUG(14)=m_lR +C XNUSUG(15)=m_lL XNUSUG(16)=m_bR XNUSUG(17)=m_tR XNUSUG(18)=m_tL +C + COMMON /SUGNU/ XNUSUG(18) + REAL XNUSUG + SAVE /SUGNU/ + +#endif diff --git a/ISAJET/isajet/sugpas.inc b/ISAJET/isajet/sugpas.inc new file mode 100644 index 00000000000..61db3f9947e --- /dev/null +++ b/ISAJET/isajet/sugpas.inc @@ -0,0 +1,16 @@ +#ifndef CERNLIB_ISAJET_SUGPAS_INC +#define CERNLIB_ISAJET_SUGPAS_INC +* +* +* sugpas.inc +* + 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 + REAL XTANB,MSUSY,AMT,MGUT,MU,G2,GP,V,VP,XW, + $A1MZ,A2MZ,ASMZ,FTAMZ,FBMZ,B,SIN2B,FTMT,G3MT,VEV,HIGFRZ, + $FNMZ,AMNRMJ + INTEGER NOGOOD,IAL3UN,ITACHY + SAVE /SUGPAS/ + +#endif diff --git a/ISAJET/isajet/sugxin.inc b/ISAJET/isajet/sugxin.inc new file mode 100644 index 00000000000..53a3e5f9798 --- /dev/null +++ b/ISAJET/isajet/sugxin.inc @@ -0,0 +1,23 @@ +#ifndef CERNLIB_ISAJET_SUGXIN_INC +#define CERNLIB_ISAJET_SUGXIN_INC +* +* +* sugxin.inc +* +C XSUGIN contains the inputs to SUGRA: +C XSUGIN(1) = M_0 XSUGIN(2) = M_(1/2) XSUGIN(3) = A_0 +C XSUGIN(4) = tan(beta) XSUGIN(5) = sgn(mu) XSUGIN(6) = M_t +C XSUGIN(7) = SUG BC scale +C XGMIN(1) = LAM XGMIN(2) = M_MES XGMIN(3) = XN5 +C XGMIN(4) = tan(beta) XGMIN(5) = sgn(mu) XGMIN(6) = M_t +C XGMIN(7) = CGRAV XGMIN(8) =RSL XGMIN(9) = DEL_HD +C XGMIN(10) = DEL_HU XGMIN(11) = DY XGMIN(12) = N5_1 +C XGMIN(13) = N5_2 XGMIN(14) = N5_3 +C XNRIN(1) = M_N3 XNRIN(2) = M_MAJ XNRIN(3) = ANSS +C XNRIN(4) = M_N3SS +C XISAIN contains the MSSMi inputs in natural order. + COMMON /SUGXIN/ XISAIN(24),XSUGIN(7),XGMIN(14),XNRIN(4) + REAL XISAIN,XSUGIN,XGMIN,XNRIN + SAVE /SUGXIN/ + +#endif diff --git a/ISAJET/isajet/tcpar.inc b/ISAJET/isajet/tcpar.inc new file mode 100644 index 00000000000..337df0b65fd --- /dev/null +++ b/ISAJET/isajet/tcpar.inc @@ -0,0 +1,11 @@ +#ifndef CERNLIB_ISAJET_TCPAR_INC +#define CERNLIB_ISAJET_TCPAR_INC +* +* +* tcpar.inc +* + COMMON/TCPAR/TCMRHO,TCGRHO + SAVE /TCPAR/ + REAL TCMRHO,TCGRHO + +#endif diff --git a/ISAJET/isajet/times.inc b/ISAJET/isajet/times.inc new file mode 100644 index 00000000000..7fb7211b50d --- /dev/null +++ b/ISAJET/isajet/times.inc @@ -0,0 +1,11 @@ +#ifndef CERNLIB_ISAJET_TIMES_INC +#define CERNLIB_ISAJET_TIMES_INC +* +* +* times.inc +* + COMMON/TIMES/TIME1,TIME2 + SAVE /TIMES/ + REAL TIME1,TIME2 + +#endif diff --git a/ISAJET/isajet/totals.inc b/ISAJET/isajet/totals.inc new file mode 100644 index 00000000000..39df2e5e5b7 --- /dev/null +++ b/ISAJET/isajet/totals.inc @@ -0,0 +1,12 @@ +#ifndef CERNLIB_ISAJET_TOTALS_INC +#define CERNLIB_ISAJET_TOTALS_INC +* +* +* totals.inc +* + COMMON/TOTALS/NKINPT,NWGEN,NKEEP,SUMWT,WT + SAVE /TOTALS/ + INTEGER NKINPT,NWGEN,NKEEP + REAL SUMWT,WT + +#endif diff --git a/ISAJET/isajet/types.inc b/ISAJET/isajet/types.inc new file mode 100644 index 00000000000..91e21e550db --- /dev/null +++ b/ISAJET/isajet/types.inc @@ -0,0 +1,16 @@ +#ifndef CERNLIB_ISAJET_TYPES_INC +#define CERNLIB_ISAJET_TYPES_INC +* +* +* types.inc +* + INTEGER MXTYPE + PARAMETER (MXTYPE=8) + COMMON/TYPES/LOC(100),NTYP,NJTTYP(MXTYPE),NWWTYP(2),NWMODE(3) + COMMON/XTYPES/PARTYP(40),TITLE(10),JETYP(30,MXTYPE),WWTYP(30,2) + $,WMODES(30,3) + SAVE /TYPES/,/XTYPES/ + CHARACTER*8 JETYP,WWTYP,TITLE,PARTYP,WMODES + INTEGER LOC,NTYP,NJTTYP,NWWTYP,NWMODE + +#endif diff --git a/ISAJET/isajet/w50510.inc b/ISAJET/isajet/w50510.inc new file mode 100644 index 00000000000..02a7c6ab4a1 --- /dev/null +++ b/ISAJET/isajet/w50510.inc @@ -0,0 +1,14 @@ +#ifndef CERNLIB_ISAJET_W50510_INC +#define CERNLIB_ISAJET_W50510_INC +* +* +* w50510.inc +* +#if defined(CERNLIB_PDFLIB) +C Copy of PDFLIB common block + COMMON/W50510/IFLPRT + INTEGER IFLPRT + SAVE /W50510/ +#endif + +#endif diff --git a/ISAJET/isajet/w50517.inc b/ISAJET/isajet/w50517.inc new file mode 100644 index 00000000000..d3ee0c275d9 --- /dev/null +++ b/ISAJET/isajet/w50517.inc @@ -0,0 +1,14 @@ +#ifndef CERNLIB_ISAJET_W50517_INC +#define CERNLIB_ISAJET_W50517_INC +* +* +* w50517.inc +* +#if defined(CERNLIB_PDFLIB) +C Copy of PDFLIB common block + COMMON/W50517/N6 + INTEGER N6 + SAVE /W50517/ +#endif + +#endif diff --git a/ISAJET/isajet/wcon.inc b/ISAJET/isajet/wcon.inc new file mode 100644 index 00000000000..0615d798051 --- /dev/null +++ b/ISAJET/isajet/wcon.inc @@ -0,0 +1,25 @@ +#ifndef CERNLIB_ISAJET_WCON_INC +#define CERNLIB_ISAJET_WCON_INC +* +* +* wcon.inc +* + COMMON/WCON/SIN2W,WMASS(4),WGAM(4),AQ(12,4),BQ(12,4),COUT(4), + 1MATCH(25,4),WCBR(25,4),CUTOFF,CUTPOW,TBRWW(4,2),RBRWW(12,4,2),EZ, + 2AQDP(12,4),BQDP(12,4),EZDP,WFUDGE + SAVE /WCON/ +#if defined(CERNLIB_DOUBLE) +#include "isajet/wcon2.inc" +* Ignoring t=pass +#endif +#if defined(CERNLIB_SINGLE) +#include "isajet/wcon1.inc" +* Ignoring t=pass +#endif + INTEGER MATCH + REAL SIN2W,WMASS,WGAM,AQ,BQ,COUT,WCBR,CUTOFF,CUTPOW,TBRWW, + + RBRWW,EZ,WFUDGE + COMMON/WCON2/CUMWBR(25,3) + REAL CUMWBR + +#endif diff --git a/ISAJET/isajet/wcon1.inc b/ISAJET/isajet/wcon1.inc new file mode 100644 index 00000000000..8dbe57574c9 --- /dev/null +++ b/ISAJET/isajet/wcon1.inc @@ -0,0 +1,11 @@ +#ifndef CERNLIB_ISAJET_WCON1_INC +#define CERNLIB_ISAJET_WCON1_INC +* +* +* wcon1.inc +* +#if defined(CERNLIB_SINGLE) + REAL AQDP,BQDP,EZDP +#endif + +#endif diff --git a/ISAJET/isajet/wcon2.inc b/ISAJET/isajet/wcon2.inc new file mode 100644 index 00000000000..f461d7573ad --- /dev/null +++ b/ISAJET/isajet/wcon2.inc @@ -0,0 +1,11 @@ +#ifndef CERNLIB_ISAJET_WCON2_INC +#define CERNLIB_ISAJET_WCON2_INC +* +* +* wcon2.inc +* +#if defined(CERNLIB_DOUBLE) + DOUBLE PRECISION AQDP,BQDP,EZDP +#endif + +#endif diff --git a/ISAJET/isajet/wgen.inc b/ISAJET/isajet/wgen.inc new file mode 100644 index 00000000000..d2a631caea2 --- /dev/null +++ b/ISAJET/isajet/wgen.inc @@ -0,0 +1,13 @@ +#ifndef CERNLIB_ISAJET_WGEN_INC +#define CERNLIB_ISAJET_WGEN_INC +* +* +* wgen.inc +* + COMMON/WGEN/PTGN(3,3),QGEN(3,3),PTSEL(3),QSEL(3),SIGSL(3),NKL,NKH + 1,EMSQ,EMGAM,KSEL,QSELWT(3) + SAVE /WGEN/ + INTEGER NKL,NKH,KSEL + REAL PTGN,QGEN,PTSEL,QSEL,SIGSL,EMSQ,EMGAM,QSELWT + +#endif diff --git a/ISAJET/isajet/wsig.inc b/ISAJET/isajet/wsig.inc new file mode 100644 index 00000000000..12781ed3112 --- /dev/null +++ b/ISAJET/isajet/wsig.inc @@ -0,0 +1,11 @@ +#ifndef CERNLIB_ISAJET_WSIG_INC +#define CERNLIB_ISAJET_WSIG_INC +* +* +* wsig.inc +* + COMMON/WSIG/SIGLLQ + SAVE /WSIG/ + REAL SIGLLQ + +#endif diff --git a/ISAJET/isajet/wwpar.inc b/ISAJET/isajet/wwpar.inc new file mode 100644 index 00000000000..6623e8bcff1 --- /dev/null +++ b/ISAJET/isajet/wwpar.inc @@ -0,0 +1,21 @@ +#ifndef CERNLIB_ISAJET_WWPAR_INC +#define CERNLIB_ISAJET_WWPAR_INC +* +* +* wwpar.inc +* + COMMON/WWPAR/SWW,TWW,UWW,WM2,ZM2,P1WW(5),P2WW(5),P3WW(5),P4WW(5) + $,PZERO(4,4),S13,P3(5),Q1(5),Q3(5),JQWW(2) + $,CQ,CV,CA,CV1,CA1,CV3,CA3,CS,CT,CU + SAVE /WWPAR/ +#if defined(CERNLIB_DOUBLE) +#include "isajet/wwpar2.inc" +* Ignoring t=pass +#endif +#if defined(CERNLIB_SINGLE) +#include "isajet/wwpar1.inc" +* Ignoring t=pass +#endif + INTEGER JQWW + +#endif diff --git a/ISAJET/isajet/wwpar1.inc b/ISAJET/isajet/wwpar1.inc new file mode 100644 index 00000000000..44a3e11bd68 --- /dev/null +++ b/ISAJET/isajet/wwpar1.inc @@ -0,0 +1,13 @@ +#ifndef CERNLIB_ISAJET_WWPAR1_INC +#define CERNLIB_ISAJET_WWPAR1_INC +* +* +* wwpar1.inc +* +#if defined(CERNLIB_SINGLE) + REAL SWW,TWW,UWW,WM2,ZM2,P1WW,P2WW,P3WW,P4WW + $,PZERO,S13,P3,Q1,Q3 + $,CQ,CV,CA,CV1,CA1,CV3,CA3,CS,CT,CU +#endif + +#endif diff --git a/ISAJET/isajet/wwpar2.inc b/ISAJET/isajet/wwpar2.inc new file mode 100644 index 00000000000..f112886470d --- /dev/null +++ b/ISAJET/isajet/wwpar2.inc @@ -0,0 +1,13 @@ +#ifndef CERNLIB_ISAJET_WWPAR2_INC +#define CERNLIB_ISAJET_WWPAR2_INC +* +* +* wwpar2.inc +* +#if defined(CERNLIB_DOUBLE) + DOUBLE PRECISION SWW,TWW,UWW,WM2,ZM2,P1WW,P2WW,P3WW,P4WW + $,PZERO,S13,P3,Q1,Q3 + $,CQ,CV,CA,CV1,CA1,CV3,CA3,CS,CT,CU +#endif + +#endif diff --git a/ISAJET/isajet/wwsig.inc b/ISAJET/isajet/wwsig.inc new file mode 100644 index 00000000000..1408b8cd0fa --- /dev/null +++ b/ISAJET/isajet/wwsig.inc @@ -0,0 +1,11 @@ +#ifndef CERNLIB_ISAJET_WWSIG_INC +#define CERNLIB_ISAJET_WWSIG_INC +* +* +* wwsig.inc +* + COMMON/WWSIG/WWSIG + SAVE /WWSIG/ + REAL WWSIG + +#endif diff --git a/ISAJET/isajet/xmssm.inc b/ISAJET/isajet/xmssm.inc new file mode 100644 index 00000000000..56a571d84d1 --- /dev/null +++ b/ISAJET/isajet/xmssm.inc @@ -0,0 +1,29 @@ +#ifndef CERNLIB_ISAJET_XMSSM_INC +#define CERNLIB_ISAJET_XMSSM_INC +* +* +* xmssm.inc +* + COMMON/XMSSM/GOMSSM,GOSUG,GOGMSB,GOAMSB,AL3UNI + $,XGLSS,XMUSS,XHASS,XTBSS + $,XQ1SS,XDRSS,XURSS,XL1SS,XERSS + $,XQ2SS,XSRSS,XCRSS,XL2SS,XMRSS + $,XQ3SS,XBRSS,XTRSS,XL3SS,XTARSS,XATSS,XABSS,XATASS + $,XM1SS,XM2SS,XM0SU,XMHSU,XA0SU,XTGBSU,XSMUSU + $,XLAMGM,XMESGM,XN5GM,XCMGV,XMGVTO + $,XRSLGM,XDHDGM,XDHUGM,XDYGM,XN51GM,XN52GM,XN53GM + $,XMN3NR,XMAJNR,XANSS,XNRSS,XSBCS + SAVE /XMSSM/ + REAL XGLSS,XMUSS,XHASS,XTBSS + $,XQ1SS,XDRSS,XURSS,XL1SS,XERSS + $,XQ2SS,XSRSS,XCRSS,XL2SS,XMRSS + $,XQ3SS,XBRSS,XTRSS,XL3SS,XTARSS,XATSS,XABSS,XATASS + $,XM1SS,XM2SS + $,XM0SU,XMHSU,XA0SU,XTGBSU,XSMUSU + $,XLAMGM,XMESGM,XN5GM,XCMGV,XMGVTO + $,XRSLGM,XDHDGM,XDHUGM,XDYGM,XN51GM,XN52GM,XN53GM + $,XMN3NR,XMAJNR,XANSS,XNRSS,XSBCS + LOGICAL GOMSSM,GOSUG,GOGMSB,GOAMSB,AL3UNI + + +#endif diff --git a/ISAJET/isajet/zebcom.inc b/ISAJET/isajet/zebcom.inc new file mode 100644 index 00000000000..881b378f9df --- /dev/null +++ b/ISAJET/isajet/zebcom.inc @@ -0,0 +1,27 @@ +#ifndef CERNLIB_ISAJET_ZEBCOM_INC +#define CERNLIB_ISAJET_ZEBCOM_INC +* +* +* zebcom.inc +* +C +C ZEBCOM is the main zebra common block for event data storage +C + INTEGER NNQ,NREF + PARAMETER (NNQ=200000) + PARAMETER (NREF=9) + COMMON/ZEBCOM/IXCOM,IXMAIN,IXDVR,FENCE,LISAE,LISAB,LREF, + $ ZSTOR,ENDZS + SAVE /ZEBCOM/ + INTEGER IXCOM ! store number + $ ,IXMAIN ! event division number + $ ,IXDVR ! run division number + INTEGER FENCE(8),LREF(NREF),ZSTOR(NNQ),ENDZS + INTEGER LISAE ! pointer to ISAE bank + INTEGER LISAB ! pointer to ISAB bank + REAL Q(NNQ) + INTEGER IQ(NNQ),LQ(NNQ) + EQUIVALENCE (LISAE,LQ(1)),(LQ(9),IQ(1),Q(1)) +C + +#endif diff --git a/ISAJET/isajet/zevel.inc b/ISAJET/isajet/zevel.inc new file mode 100644 index 00000000000..c79525cca27 --- /dev/null +++ b/ISAJET/isajet/zevel.inc @@ -0,0 +1,23 @@ +#ifndef CERNLIB_ISAJET_ZEVEL_INC +#define CERNLIB_ISAJET_ZEVEL_INC +* +* +* zevel.inc +* + INTEGER MAXLEN + PARAMETER (MAXLEN=1024) + COMMON/ZEVEL/IZEVEL(MAXLEN) + SAVE /ZEVEL/ + EQUIVALENCE(ZEVEL(1),IZEVEL(1)) + EQUIVALENCE(LZEVEL(1),IZEVEL(1)) + EQUIVALENCE (IZVL1,IZEVEL(1)) + EQUIVALENCE (IZVL2,IZEVEL(2)) +#if defined(CERNLIB_LEVEL2) +#include "isajet/l2zevl.inc" +* Ignoring t=pass +#endif + INTEGER IZEVEL,IZVL1,IZVL2 + REAL ZEVEL(MAXLEN) + LOGICAL LZEVEL(MAXLEN) + +#endif diff --git a/ISAJET/isajet/zlinka.inc b/ISAJET/isajet/zlinka.inc new file mode 100644 index 00000000000..da8965f0ff0 --- /dev/null +++ b/ISAJET/isajet/zlinka.inc @@ -0,0 +1,16 @@ +#ifndef CERNLIB_ISAJET_ZLINKA_INC +#define CERNLIB_ISAJET_ZLINKA_INC +* +* +* zlinka.inc +* +C +C general Zebra link area +C use with utility subroutines GSLINK,GRLINK,RSLINK and RRLINK + INTEGER NSLINK,NRLINK,LSLINK,LRLINK + PARAMETER (NSLINK=100) + PARAMETER (NRLINK=100) + COMMON/ZLINKA/LSLINK(NSLINK),LRLINK(NRLINK) + SAVE /ZLINKA/ + +#endif diff --git a/ISAJET/isajet/zvout.inc b/ISAJET/isajet/zvout.inc new file mode 100644 index 00000000000..e7e0d495521 --- /dev/null +++ b/ISAJET/isajet/zvout.inc @@ -0,0 +1,15 @@ +#ifndef CERNLIB_ISAJET_ZVOUT_INC +#define CERNLIB_ISAJET_ZVOUT_INC +* +* +* zvout.inc +* + COMMON/ZVOUT/ZVOUT(512) + SAVE /ZVOUT/ +#if defined(CERNLIB_LEVEL2) +#include "isajet/l2zout.inc" +* Ignoring t=pass +#endif + REAL ZVOUT + +#endif diff --git a/ISAJET/isarun/dialog.F b/ISAJET/isarun/dialog.F new file mode 100644 index 00000000000..d078de7db1c --- /dev/null +++ b/ISAJET/isarun/dialog.F @@ -0,0 +1,1250 @@ +#include "isajet/pilot.h" + SUBROUTINE DIALOG +C +C Set up user data with interactive commands from standard +C Fortran input. +C +C V6.26: Fixed FORCE to allow automatic top decays and to use +C correct limit for maximum number. +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/mbgen.inc" +#include "isajet/force.inc" +#include "isajet/eepar.inc" +#include "isajet/dkytab.inc" +#include "isajet/qcdpar.inc" +#include "isajet/idrun.inc" +#include "isajet/frgpar.inc" +#include "isajet/keys.inc" +#include "isajet/prtout.inc" +#include "isajet/seed.inc" +#include "isajet/types.inc" +#include "isajet/primar.inc" +#include "isajet/jetlim.inc" +#include "isajet/nodcay.inc" +#include "isajet/wcon.inc" +#include "isajet/dylim.inc" +#include "isajet/qlmass.inc" +#include "isajet/q1q2.inc" +#include "isajet/jetpar.inc" +#include "isajet/isloop.inc" +#include "isajet/tcpar.inc" +#include "isajet/xmssm.inc" +#include "isajet/sugnu.inc" +#if defined(CERNLIB_PDFLIB) +#include "isajet/w50510.inc" +* Ignoring t=pass +#endif +#if defined(CERNLIB_PDFLIB) +#include "isajet/w50517.inc" +* Ignoring t=pass +#endif +#include "isajet/hcon.inc" +#include "isajet/kkgrav.inc" +#include "isajet/mglims.inc" +C +#include "isajet/const.inc" +C + LOGICAL SETTYP,DUMY + CHARACTER*8 TTL(10),WORD,LSTRUC,BLANK,LIST(29) + CHARACTER*8 WTYP(4),RDID(2) + CHARACTER*4 YN + INTEGER IFL,I1,I2,I3,J1,I,IKEY,IJ,J,KK,IDXQK + INTEGER NSEL,K,KFORCE(5),INDEX,IDG1,IDG2,IDG3,IDG4,IDXQ,IDXLEP +#if defined(CERNLIB_SINGLE) + REAL SEED +#endif +#if defined(CERNLIB_DOUBLE) + DOUBLE PRECISION SEED +#endif + INTEGER NLAP(3,17) + REAL EMIN,YLIM1,YLIM2,ANGL1,ANGL2,XLIM1,XLIM2,AMW,AMZ + INTEGER NFTEMP + CHARACTER*8 HTYPE +#if defined(CERNLIB_PDFLIB) + CHARACTER*20 PDFPAR(20) +#endif +#if (defined(CERNLIB_PDFLIB))&&(defined(CERNLIB_SINGLE)) + REAL PDFVAL(20) + REAL DX,DSCALE,DXPDF(-6:6) +#endif +#if (defined(CERNLIB_PDFLIB))&&(defined(CERNLIB_DOUBLE)) + DOUBLE PRECISION PDFVAL(20) + DOUBLE PRECISION DX,DSCALE,DXPDF(-6:6) +#endif + REAL AMLIM1,AMLIM2 + INTEGER JLIM1,JLIM2 +C +C Overlapping variable flags. + DATA NLAP/1,2,3, 1,2,7 ,1,2,8, 1,3,5, 1,3,6, 1,3,7, 1,3,8, 1,5,7, + X 1,5,8, 1,6,7, 1,6,8, 2,3,7, 2,3,8, 3,5,7, 3,6,7, 3,5,8, + X 3,6,8/ + DATA BLANK/' '/ +C Duplicate data to avoid requiring ALDATA + DATA LIST/'GL','UP','UB','DN','DB','ST','SB','CH','CB','BT','BB', + $'TP','TB','NUE','ANUE','E-','E+','NUM','ANUM','MU-','MU+', + $'NUT','ANUT','TAU-','TAU+','ALL','QUARKS','LEPTONS','NUS'/ +C +C Entry +C + IFL=0 + NFTEMP=0 +C +1111 PRINT 11 +11 FORMAT(//,10X,' Use CAPITAL LETTERS only for all commands.',//, + 1 10X,' Give title for this run.') +C +C Read title +C + READ 1,TTL + 1 FORMAT(10A8) + WRITE(ITCOM,1) TTL + IF(TTL(1).EQ.'STOP ') GOTO 999 +C +C Read energy and no. of events +C + PRINT*,' total energy, # of events, # to print, # to skip.' + READ*,ECM,NEVENT,NEVPRT,NJUMP + WRITE(ITCOM,*)ECM,NEVENT,NEVPRT,NJUMP +C +C Reset all variables if title is not 'SAME' +C + IF(TTL(1).NE.'SAME ') THEN + DO 20 I=1,10 + 20 TITLE(I)=TTL(I) + CALL RESET + KEYON=.FALSE. +C +C Read reaction and set keys and NJET +C + 21 PRINT 22 + 22 FORMAT(/,' Choose one of the following reactions:',/, + $' TWOJET E+E- DRELLYAN MINBIAS SUSY WPAIR HIGGS', + $' PHOTON TCOLOR WHIGGS') + READ 3,REAC + 3 FORMAT(A8) + DO 18 I=1,MXKEYS +18 KEYS(I)=.FALSE. + KEYON=.FALSE. +C + IF(REAC.EQ.'TWOJET ') THEN + KEYS(1)=.TRUE. + IKEY=1 + NJET=2 + ELSEIF(REAC.EQ.'E+E- ') THEN + KEYS(2)=.TRUE. + IKEY=2 + NJET=2 + ELSEIF(REAC.EQ.'DRELLYAN') THEN + KEYS(3)=.TRUE. + IKEY=3 + NJET=3 + ELSEIF(REAC.EQ.'MINBIAS ') THEN + KEYS(4)=.TRUE. + IKEY=4 + NJET=0 + ELSEIF(REAC.EQ.'SUPERSYM'.OR.REAC.EQ.'SUSY ') THEN + KEYS(5)=.TRUE. + IKEY=5 + NJET=2 + ELSEIF(REAC.EQ.'WPAIR ') THEN + KEYS(6)=.TRUE. + IKEY=6 + NJET=2 + ELSEIF(REAC.EQ.'HIGGS ') THEN + KEYS(7)=.TRUE. + IKEY=7 + NJET=2 + ELSEIF(REAC.EQ.'PHOTON ') THEN + KEYS(8)=.TRUE. + IKEY=8 + NJET=2 + ELSEIF(REAC.EQ.'TCOLOR ') THEN + KEYS(9)=.TRUE. + IKEYS=9 + NJET=2 + ELSEIF(REAC.EQ.'WHIGGS ') THEN + KEYS(10)=.TRUE. + IKEY=10 + NJET=2 + ELSE + PRINT* ,' You must choose a valid reaction, try again.' + GOTO 21 + ENDIF +C + WRITE(ITCOM,3) REAC + ENDIF +C + EMIN=1.0 + SCM=ECM**2 + HALFE=ECM/2 + YLIM2=ALOG(ECM) + YLIM1=-YLIM2 + NSEL=0 + ANGL1=0 + ANGL2=2*PI + XLIM1=-1.0 + XLIM2=1.0 +C +C Read keyword. For each recognized keyword read corresponding +C variables and set LOC flag. +C + NSEL=0 +1000 PRINT 99 +99 FORMAT(//, + $' Choose among the following:',/, + $' Jet limits:',/, + $' JETTYPE1 JETTYPE2 JETTYPE3 P PHI PT TH X Y WMODE1 WMODE2',/, + $' Drell Yan/Higgs limits:',/, + $' HTYPE PHIW QMH QMW QTW THW WTYPE XW YW',/, + $' Decays:',/, + $' FORCE FORCE1 NODECAY NOETA NOEVOLVE NOFRGMNT NOPI0',/, + $' Physics parameters:',/, + $' CUTJET CUTOFF FRAGMENT GAUGINO HMASS HMASSES LAMBDA',/, + $' MSSMA MSSMB MSSMC MSSMD MSSME SIGQT SIN2W SLEPTON SQUARK',/, + $' SUGRA TCMASS TMASS WMASS XGEN',/, + $' Other:',/, + $' BEAMS EPOL NPOMERON NSIGMA NTRIES PDFLIB SEED STRUC WFUDGE',/, + $' WMMODE WPMODE Z0MODE',/, + $' Terminate with END. Use HELP for help.',/) +C +100 PRINT* ,' Give a variable name.' + READ 3,WORD + IF(WORD.EQ.'HELP ') GO TO 1000 + NSEL=NSEL+1 +C +C Keyword END + IF(WORD.EQ.'END ') THEN +C +C End of run +C + WRITE(ITCOM,3) WORD + PRINT 889 + 889 FORMAT(//,10X,' NEW RUN',/,' If you are finished answer STOP.',/, + 1 ' If you answer SAME the parameters from previous run will be', + 2 ' used,',/,' unless you request otherwise.') + GO TO 101 + ENDIF +C +C Keyword P + IF(WORD.EQ.'P ') THEN + WRITE(ITCOM,3) WORD + PRINT 562 + PRINT 563,EMIN,HALFE + READ*, (PMIN(K),PMAX(K),K=1,NJET) + WRITE(ITCOM,*)(PMIN(K),PMAX(K),K=1,NJET) + LOC(1)=NSEL + GO TO 1000 + ENDIF +C +C Keyword Y + IF(WORD.EQ.'Y ') THEN + WRITE(ITCOM,3) WORD + PRINT 562 + PRINT 563,YLIM1,YLIM2 + READ*, (YJMIN(K),YJMAX(K),K=1,NJET) + WRITE(ITCOM,*)(YJMIN(K),YJMAX(K),K=1,NJET) + LOC(2)=NSEL + GO TO 1000 + ENDIF +C +C Keyword X + IF(WORD.EQ.'X ') THEN + WRITE(ITCOM,3) WORD + PRINT 562 + PRINT 563,XLIM1,XLIM2 + READ*, (XJMIN(K),XJMAX(K),K=1,NJET) + WRITE(ITCOM,*)(XJMIN(K),XJMAX(K),K=1,NJET) + LOC(3)=NSEL + GO TO 1000 + ENDIF +C +C Keyword PHI + IF(WORD.EQ.'PHI ') THEN + WRITE(ITCOM,3) WORD + PRINT 562 + PRINT 563,ANGL1,ANGL2 + READ*, (PHIMIN(K),PHIMAX(K),K=1,NJET) + WRITE(ITCOM,*)(PHIMIN(K),PHIMAX(K),K=1,NJET) + LOC(4)=NSEL + GO TO 1000 + ENDIF +C +C Keyword TH + IF(WORD.EQ.'TH '.OR.WORD.EQ.'THETA ') THEN + WRITE(ITCOM,3) WORD + PRINT 562 + PRINT 563,ANGL1,PI + READ*, (THMIN(K),THMAX(K),K=1,NJET) + WRITE(ITCOM,*)(THMIN(K),THMAX(K),K=1,NJET) + LOC(5)=NSEL + LOC(6)=NSEL + GO TO 1000 + ENDIF +C +C Keyword PT + IF(WORD.EQ.'PT '.OR.WORD.EQ.'PPERP ') THEN + WRITE(ITCOM,3) WORD + PRINT 562 + PRINT 563,EMIN,HALFE + READ*, (PTMIN(K),PTMAX(K),K=1,NJET) + WRITE(ITCOM,*)(PTMIN(K),PTMAX(K),K=1,NJET) + LOC(7)=NSEL + LOC(8)=NSEL + GO TO 1000 + ENDIF +C +C Keyword NODECAY + IF(WORD.EQ.'NODECAY ') THEN + WRITE(ITCOM,3) WORD + PRINT 572 + READ 571,NODCAY +571 FORMAT(L1) + WRITE(ITCOM,571) NODCAY + LOC(9)=NSEL + GO TO 1000 + ENDIF +C +C Keyword NOETA + IF(WORD.EQ.'NOETA ') THEN + WRITE(ITCOM,3) WORD + PRINT 572 + READ 571, NOETA + WRITE(ITCOM,571) NOETA + LOC(10)=NSEL + GO TO 1000 + ENDIF +C +C Keyword NOPI0 + IF(WORD.EQ.'NOPI0 ') THEN + WRITE(ITCOM,3) WORD + PRINT 572 + READ 571, NOPI0 + WRITE(ITCOM,571) NOPI0 + LOC(11)=NSEL + GO TO 1000 + ENDIF +C +C Keyword BEAMS + IF(WORD.EQ.'BEAMS ') THEN + WRITE(ITCOM,3) WORD + 58 PRINT*,' Select each beam enclosed in single quotes.' + PRINT*,' Allowed names are: P N AP AN' + READ *,RDID(1),RDID(2) + IDIN(1)=0 + IDIN(2)=0 + DO 583 K=1,2 + IF(RDID(K).EQ.'P ') IDIN(K)=+1120 + IF(RDID(K).EQ.'AP ') IDIN(K)=-1120 + IF(RDID(K).EQ.'N ') IDIN(K)=+1220 + IF(RDID(K).EQ.'AN ') IDIN(K)=-1220 +583 CONTINUE + IF(IDIN(1)*IDIN(2).EQ.0) GOTO 58 + LOC(12)=NSEL + WRITE(ITCOM,4) RDID(1),RDID(2) + GO TO 1000 + ENDIF +C +C Keyword FRAGMENT + IF(WORD.EQ.'FRAGMENT') THEN + WRITE(ITCOM,3) WORD + PRINT 584 + READ*, FRPAR + WRITE(ITCOM,*) FRPAR + LOC(13)=NSEL + GO TO 1000 + ENDIF +C +C Keyword SEED + IF(WORD.EQ.'SEED ') THEN + WRITE(ITCOM,3) WORD + PRINT 584 + READ*, SEED + WRITE(ITCOM,*) SEED + CALL RANFST(SEED) + LOC(14)=NSEL + GO TO 1000 + ENDIF +C +C Keywords JETTYPE1, JETTYPE2, JETTYPE3 + IF(WORD.EQ.'JETTYPE1'.OR.WORD.EQ.'JETTYPE2'.OR.WORD.EQ. + $'JETTYPE3') THEN + WRITE(ITCOM,3) WORD +C Print allowed types +60 IF(KEYS(6)) THEN + PRINT 6001 + PRINT 6002 +6001 FORMAT(' Give a list of jet types enclosed in single quotes ', + $ 'and separated by commas.',/,' Terminate list with a /') +6002 FORMAT(' The recognized W types are: W+, W-, Z0, GM and ALL') + ELSE + PRINT 6001 + PRINT 6003, LIST +6003 FORMAT(' The recognized jet types are:',/,4(1X,8A8,/),1X,5A8) + ENDIF + IF(KEYS(1)) THEN + PRINT 6004 +6004 FORMAT(' A fourth generation is also allowed:',/, + $ ' X, XB for up, Y, YB for down.',/, + $ ' The fourth generation is normally turned off.') + ENDIF + IF(WORD.EQ.'JETTYPE1') IJ=1 + IF(WORD.EQ.'JETTYPE2') IJ=2 + IF(WORD.EQ.'JETTYPE3') IJ=3 + READ*,(JETYP(K,IJ),K=1,25) + DO 61 K=1,25 +61 IF(JETYP(K,IJ).NE.BLANK) NJTTYP(IJ)=NJTTYP(IJ)+1 +C Check that only legal jet types are in the list + IF(SETTYP(0)) GOTO 60 + WRITE(ITCOM,4)(JETYP(K,IJ),K=1,NJTTYP(IJ)) + 4 FORMAT(1H',A,2H',) + IF(NJTTYP(IJ).LT.25) WRITE(ITCOM,*) '/' + LOC(15)=NSEL + GO TO 1000 + ENDIF +C +C Keyword SIN2W + IF(WORD.EQ.'SIN2W ') THEN + WRITE(ITCOM,3) WORD + PRINT 584 + READ*, SIN2W + WRITE(ITCOM,*) SIN2W + LOC(17)=NSEL + GO TO 1000 + ENDIF +C +C Keyword TMASS + IF(WORD.EQ.'TMASS ') THEN + WRITE(ITCOM,3) WORD + PRINT 584 + READ*, AMLEP(6),AMLEP(7),AMLEP(8) + WRITE(ITCOM,*) AMLEP(6),AMLEP(7),AMLEP(8) + LOC(18)=NSEL + GO TO 1000 + ENDIF +C +C Keyword QMH (note that it uses same variable as QMW) + IF(WORD.EQ.'QMH ') THEN + WRITE(ITCOM,3) WORD + PRINT*,' Give minimum and maximum MASS for Higgs.' + READ*,QMIN,QMAX + WRITE(ITCOM,*)QMIN,QMAX + LOC(19)=NSEL + GO TO 1000 + ENDIF +C +C Keyword QMW + IF(WORD.EQ.'QMW ') THEN + WRITE(ITCOM,3) WORD + PRINT*,' Give minimum and maximum MASS for W(Z0).' + READ*,QMIN,QMAX + WRITE(ITCOM,*)QMIN,QMAX + LOC(19)=NSEL + GO TO 1000 + ENDIF +C +C Keyword QTW + IF(WORD.EQ.'QTW ') THEN + WRITE(ITCOM,3) WORD + PRINT*,' Give minimum and maximum PT for W(Z0).' + PRINT 563,EMIN,HALFE + PRINT*,' Fix QTW to zero for standard Drell-Yan.' + READ*, QTMIN,QTMAX + WRITE(ITCOM,*) QTMIN,QTMAX + LOC(20)=NSEL + GO TO 1000 + ENDIF +C +C Keyword YW + IF(WORD.EQ.'YW ') THEN + WRITE(ITCOM,3) WORD + PRINT*,' Give minimum and maximum Y for W(Z0).' + PRINT 563,YLIM1,YLIM2 + READ*, YWMIN,YWMAX + WRITE(ITCOM,*)YWMIN,YWMAX + LOC(21)=NSEL + GO TO 1000 + ENDIF +C +C Keyword XW + IF(WORD.EQ.'XW ') THEN + WRITE(ITCOM,3) WORD + PRINT*,' Give minimum and maximum X for W(Z0).' + PRINT 563,XLIM1,XLIM2 + READ*, XWMIN,XWMAX + WRITE(ITCOM,*)XWMIN,XWMAX + LOC(22)=NSEL + GO TO 1000 + ENDIF +C +C Keyword THW + IF(WORD.EQ.'THW ') THEN + WRITE(ITCOM,3) WORD + PRINT*,' Give minimum and maximum THETA for W(Z0).' + PRINT 563,ANGL1,PI + READ*, THWMIN,THWMAX + WRITE(ITCOM,*)THWMIN,THWMAX + LOC(23)=NSEL + GO TO 1000 + ENDIF +C +C Keyword PHIW + IF(WORD.EQ.'PHIW ') THEN + WRITE(ITCOM,3) WORD + PRINT*,' Give minimum and maximum PHI for W(Z0).' + PRINT 563,ANGL1,ANGL2 + READ*, PHWMIN,PHWMAX + WRITE(ITCOM,*)PHWMIN,PHWMAX + LOC(24)=NSEL + GO TO 1000 + ENDIF +C +C Keyword NONUNU + IF(WORD.EQ.'NONUNU ') THEN + WRITE(ITCOM,3) WORD + PRINT 572 + READ 571,NONUNU + WRITE(ITCOM,571) NONUNU + LOC(25)=NSEL + GO TO 1000 + ENDIF +C +C Keyword WTYPE + IF(WORD.EQ.'WTYPE ') THEN + WRITE(ITCOM,3) WORD + 92 PRINT*,' Choose from one set of bosons: W+,W- or Z0,GM' + PRINT*,' Enclose each in single quotes and terminate with / ' + DO 191 J=1,4 + WTYP(J)=BLANK + 191 GODY(J)=.FALSE. + READ*,WTYP + DO 192 K=1,4 + IF(WTYP(K).EQ.'GM ') GODY(1)=.TRUE. + IF(WTYP(K).EQ.'W+ ') GODY(2)=.TRUE. + IF(WTYP(K).EQ.'W- ') GODY(3)=.TRUE. + IF(WTYP(K).EQ.'Z0 ') GODY(4)=.TRUE. + 192 CONTINUE + IF(GODY(1)) JWTYP=1 + IF(GODY(2).OR.GODY(3)) JWTYP=3 + IF(GODY(4)) JWTYP=4 + IF((GODY(3).OR.GODY(2)).AND.(GODY(1).OR.GODY(4)).OR.JWTYP + 1 .EQ.0) THEN + PRINT 2003 + GOTO 92 + ELSE + WRITE(ITCOM,4) WTYP + LOC(26)=NSEL + ENDIF + GO TO 1000 + ENDIF +C +C Keyword LAMBDA + IF(WORD.EQ.'LAMBDA ') THEN + WRITE(ITCOM,3) WORD + PRINT 584 + READ*, ALAM + WRITE(ITCOM,*) ALAM + ALAM2=ALAM**2 + LOC(27)=NSEL + GO TO 1000 + ENDIF +C +C Keyword NTRIES + IF(WORD.EQ.'NTRIES ') THEN + WRITE(ITCOM,3) WORD + PRINT 584 + READ*,NTRIES + WRITE(ITCOM,*)NTRIES + LOC(28)=NSEL + GO TO 1000 + ENDIF +C +C Keyword CUTOFF + IF(WORD.EQ.'CUTOFF ') THEN + WRITE(ITCOM,3) WORD + PRINT 584 + READ*,CUTOFF,CUTPOW + WRITE(ITCOM,*)CUTOFF,CUTPOW + LOC(29)=NSEL + GO TO 1000 + ENDIF +C +C Keyword XGEN + IF(WORD.EQ.'XGEN ') THEN + WRITE(ITCOM,3) WORD + PRINT 584 + READ*,XGEN + WRITE(ITCOM,*)XGEN + LOC(30)=NSEL + GO TO 1000 + ENDIF +C +C Keyword SIGQT + IF(WORD.EQ.'SIGQT ') THEN + WRITE(ITCOM,3) WORD + PRINT 584 + READ*,SIGQT + WRITE(ITCOM,*)SIGQT + LOC(31)=NSEL + GO TO 1000 + ENDIF +C +C Keyword CUTJET + IF(WORD.EQ.'CUTJET ') THEN + WRITE(ITCOM,3) WORD + PRINT 584 + READ*, CUTJET + WRITE(ITCOM,*) CUTJET + LOC(32)=NSEL + GO TO 1000 + ENDIF +C +C Keyword WFUDGE + IF(WORD.EQ.'WFUDGE ') THEN + WRITE(ITCOM,3) WORD + PRINT 584 + READ*, WFUDGE + WRITE(ITCOM,*) WFUDGE + LOC(50)=NSEL + GO TO 1000 + ENDIF +C +C Keyword STRUC + IF(WORD.EQ.'STRUC ') THEN + WRITE(ITCOM,3) WORD + ISTRUC=0 + 69 PRINT*,' Choose a structure function: OWENS, BAIER or EICHTEN' + PRINT*,' Enclose in single quotes' + READ*,LSTRUC + IF(LSTRUC.EQ.'OWENS ') ISTRUC=1 + IF(LSTRUC.EQ.'BAIER ') ISTRUC=2 + IF(LSTRUC.EQ.'EICHTEN ') ISTRUC=3 + IF(LSTRUC.EQ.'DUKE '.OR.LSTRUC.EQ.'DO ') ISTRUC=4 + IF(LSTRUC.EQ.'CTEQ2L ') ISTRUC=5 + IF(LSTRUC.EQ.'CTEQ '.OR.LSTRUC.EQ.'CTEQ3L ') ISTRUC=6 + IF(ISTRUC.EQ.0) GOTO 69 + WRITE(ITCOM,*) LSTRUC + LOC(33)=NSEL + GO TO 1000 + ENDIF +C +C Keyword NPOMERON + IF(WORD.EQ.'NPOMERON') THEN + WRITE(ITCOM,3) WORD + 93 PRINT*,' Give min and max; allowed range is 1 to 20.' + READ*,MNPOM,MXPOM + IF(MNPOM.LT.1.OR.MNPOM.GT.MXPOM.OR.MXPOM.GT.LIMPOM) + 1 GO TO 93 + WRITE(ITCOM,*)MNPOM,MXPOM + LOC(34)=NSEL + GO TO 1000 + ENDIF +C +C Keyword FORCE + IF(WORD.EQ.'FORCE ') THEN + PRINT*,' Force decay of a particle and its anti-particle.' + PRINT*,' Use FORCE1 if you want to decay only one of them.' + PRINT*,' Give a particle IDENT and IDENTs for decay mode.' + PRINT*,' Max. number of decay products is 5.' + NFTEMP=NFTEMP+2 + IF(NFTEMP.LE.MXFORC) THEN + WRITE(ITCOM,3) WORD + DO 72 K=1,5 + 72 MFORCE(K,NFTEMP)=0 + READ*,IFORCE(NFTEMP),(MFORCE(K,NFTEMP),K=1,5) + WRITE(ITCOM,*)IFORCE(NFTEMP),(MFORCE(K,NFTEMP),K=1,5) + LOC(35)=NSEL + ELSE + PRINT*,' You exceeded the maximum allowed forced decays.' + ENDIF + GO TO 1000 + ENDIF +C +C Keyword FORCE1 + IF(WORD.EQ.'FORCE1 ') THEN + PRINT*,' Force decay of a particle.' + PRINT*,' Give a particle IDENT and IDENTs for decay mode.' + PRINT*,' Max. number of decay products is 5.' + NFTEMP=NFTEMP+1 + IF(NFTEMP.LE.MXFORC) THEN + WRITE(ITCOM,3) WORD + DO 73 K=1,5 + 73 MFORCE(K,NFTEMP)=0 + READ*,IFORCE(NFTEMP),(MFORCE(K,NFTEMP),K=1,5) + WRITE(ITCOM,*)IFORCE(NFTEMP),(MFORCE(K,NFTEMP),K=1,5) + LOC(35)=NSEL + ELSE + PRINT*,' You exceeded the maximun allowed forced decays.' + ENDIF + GO TO 1000 + ENDIF +C +C Keyword HMASSES - also see HMASS + IF(WORD.EQ.'HMASSES ') THEN + WRITE(ITCOM,3) WORD + PRINT*, + $ ' Give Higgs masses (HIGGS,H10,H20,H30,H40,H1+,H2+,H1++,H2++)' + CALL FLAVOR(80,I1,I2,I3,J1,INDEX) + READ*,(AMLEP(INDEX+K),K=1,9) + WRITE(ITCOM,*)(AMLEP(INDEX+K),K=1,9) + LOC(36)=NSEL + GO TO 1000 + ENDIF +C +C Keywords WMODE1,WMODE2 + IF(WORD.EQ.'WMODE1 '.OR.WORD.EQ.'WMODE2 ') THEN + WRITE(ITCOM,3) WORD +95 PRINT 6001 + PRINT 6003, LIST + IF(WORD.EQ.'WMODE1 ') IJ=1 + IF(WORD.EQ.'WMODE2 ') IJ=2 + READ*,(WWTYP(K,IJ),K=1,25) + DO 372 K=1,25 +372 IF(WWTYP(K,IJ).NE.BLANK) NWWTYP(IJ)=NWWTYP(IJ)+1 + IF(SETTYP(0)) GOTO 95 + WRITE(ITCOM,4)(WWTYP(K,IJ),K=1,NWWTYP(IJ)) + IF(NWWTYP(IJ).LT.25) WRITE(ITCOM,*) '/' + LOC(37)=NSEL + GO TO 1000 + ENDIF +C +C Keyword NOEVOLVE + IF(WORD.EQ.'NOEVOLVE') THEN + WRITE(ITCOM,3) WORD + PRINT 572 + READ 571,NOEVOL + WRITE(ITCOM,571) NOEVOL + LOC(38)=NSEL + GO TO 1000 + ENDIF +C +C Keyword NOHADRON + IF(WORD.EQ.'NOHADRON') THEN + WRITE(ITCOM,3) WORD + PRINT 572 + READ 571,NOEVOL + WRITE(ITCOM,571) NOEVOL + LOC(39)=NSEL + GO TO 1000 + ENDIF +C +C Keyword GAUGINO + IF(WORD.EQ.'GAUGINO ') THEN + WRITE(ITCOM,3) WORD + PRINT*,' Give masses (GLSS,GMSS,W+SS,W-SS)' + CALL FLAVOR(29,I1,I2,I3,J1,IDG1) + CALL FLAVOR(30,I1,I2,I3,J1,IDG2) + CALL FLAVOR(39,I1,I2,I3,J1,IDG3) + CALL FLAVOR(40,I1,I2,I3,J1,IDG4) + READ*, AMLEP(IDG1),AMLEP(IDG2),AMLEP(IDG3),AMLEP(IDG4) + WRITE(ITCOM,*) AMLEP(IDG1),AMLEP(IDG2),AMLEP(IDG3),AMLEP(IDG4) + LOC(40)=NSEL + GO TO 1000 + ENDIF +C +C Keyword SQUARK + IF(WORD.EQ.'SQUARK ') THEN + WRITE(ITCOM,3) WORD + PRINT*,' Give masses (UPSS,DNSS,STSS,CHSS,BTSS,TPSS).' + CALL FLAVOR(21,I1,I2,I3,J1,IDXQK) + READ*, (AMLEP(IDXQK+K-1),K=1,6) + WRITE(ITCOM,*) (AMLEP(IDXQK+K-1),K=1,6) + LOC(41)=NSEL + GO TO 1000 + ENDIF +C +C Keyword SLEPTON + IF(WORD.EQ.'SLEPTON ') THEN + WRITE(ITCOM,3) WORD + PRINT*,' Give masses (NUESS,E-SS,NUMSS,MU-SS,NUTSS,T-SS).' + CALL FLAVOR(31,I1,I2,I3,J1,IDXLEP) + READ*, (AMLEP(IDXLEP+K-1),K=1,6) + WRITE(ITCOM,*) (AMLEP(IDXLEP+K-1),K=1,6) + LOC(42)=NSEL + GO TO 1000 + ENDIF +C +C Keyword NSIGMA + IF(WORD.EQ.'NSIGMA ') THEN + WRITE(ITCOM,3) WORD + PRINT 584 + READ*,NSIGMA + WRITE(ITCOM,*) NSIGMA + LOC(43)=NSEL + GO TO 1000 + ENDIF +C +C Keyword XGENSS + IF(WORD.EQ.'XGENSS ') THEN + WRITE(ITCOM,3) WORD + PRINT 584 + READ*, XGENSS(9),(XGENSS(KK),KK=1,8) + WRITE(ITCOM,*) XGENSS(9),(XGENSS(KK),KK=1,8) + LOC(44)=NSEL + GO TO 1000 + ENDIF +C +C Keyword HMASS - just standard Higgs + IF(WORD.EQ.'HMASS ') THEN + WRITE(ITCOM,3) WORD + PRINT 584 + CALL FLAVOR(81,I1,I2,I3,J1,INDEX) + READ *, AMLEP(INDEX) + WRITE(ITCOM,*) AMLEP(INDEX) + LOC(45)=NSEL + GO TO 1000 + ENDIF +C +C Keywords WPMODE, WMMODE, Z0MODE + IF(WORD.EQ.'WPMODE '.OR.WORD.EQ.'WMMODE ' + $.OR.WORD.EQ.'Z0MODE ') THEN + IF(WORD.EQ.'WPMODE ') IJ=1 + IF(WORD.EQ.'WMMODE ') IJ=2 + IF(WORD.EQ.'Z0MODE ') IJ=3 + WRITE(ITCOM,3) WORD + PRINT 6001 + PRINT 6003, LIST + READ *, (WMODES(K,IJ),K=1,25) + DO 463 K=1,25 +463 IF(WMODES(K,IJ).NE.BLANK) NWMODE(IJ)=NWMODE(IJ)+1 + WRITE(ITCOM,*) (WMODES(K,IJ),K=1,NWMODE(IJ)) + LOC(46)=NSEL + GO TO 1000 + ENDIF +C +C Keyword WMASS + IF(WORD.EQ.'WMASS ') THEN + PRINT 584 + READ*, AMW,AMZ + WRITE(ITCOM,*) AMW,AMZ + WMASS(1)=0. + WMASS(2)=AMW + WMASS(3)=AMW + WMASS(4)=AMZ + CALL FLAVOR(80,I1,I2,I3,J,INDEX) + AMLEP(INDEX)=AMW + CALL FLAVOR(90,I1,I2,I3,J,INDEX) + AMLEP(INDEX)=AMZ + LOC(47)=NSEL + GO TO 1000 + ENDIF +C +C Keyword NEVOLVE + IF(WORD.EQ.'NEVOLVE ') THEN + WRITE(ITCOM,3) WORD + PRINT 584 + READ*,NEVOLV + WRITE(ITCOM,*) NEVOLV + LOC(48)=NSEL + GO TO 1000 + ENDIF +C +C Keyword NHADRON + IF(WORD.EQ.'NHADRON ') THEN + WRITE(ITCOM,3) WORD + PRINT 584 + READ*,NFRGMN + WRITE(ITCOM,*)NFRGMN + LOC(49)=NSEL + GO TO 1000 + ENDIF +C +C Keyword TCMASS + IF(WORD.EQ.'TCMASS ') THEN + WRITE(ITCOM,3) WORD + PRINT 584 + READ*,TCMRHO,TCGRHO + WRITE(ITCOM,*) TCMRHO,TCGRHO + LOC(50)=NSEL + GO TO 1000 + ENDIF +C +C Keyword MSSMA + IF(WORD.EQ.'MSSMA ') THEN + WRITE(ITCOM,3) WORD + PRINT 585 + READ *, XGLSS,XMUSS,XHASS,XTBSS + WRITE(ITCOM,*) XGLSS,XMUSS,XHASS,XTBSS + LOC(51)=NSEL + GOMSSM=.TRUE. + GO TO 1000 + ENDIF +C +C Keyword MSSMB + IF(WORD.EQ.'MSSMB ') THEN + WRITE(ITCOM,3) WORD + PRINT 586 + READ*, XQ1SS,XDRSS,XURSS,XL1SS,XERSS + WRITE(ITCOM,*) XQ1SS,XDRSS,XURSS,XL1SS,XERSS + LOC(52)=NSEL + GOMSSM=.TRUE. + GO TO 1000 + ENDIF +C +C Keyword MSSMC + IF(WORD.EQ.'MSSMC ') THEN + WRITE(ITCOM,3) WORD + PRINT 587 + READ*, XQ3SS,XBRSS,XTRSS,XL3SS,XTARSS,XATSS,XABSS,XATASS + WRITE(ITCOM,*)XQ3SS,XBRSS,XTRSS,XL3SS,XTARSS,XATSS,XABSS,XATASS + LOC(53)=NSEL + GOMSSM=.TRUE. + GO TO 1000 + ENDIF +C +C Keyword PDFLIB: parameters for PDFLIB +#if defined(CERNLIB_PDFLIB) + IF(WORD.EQ.'PDFLIB ') THEN + WRITE(ITCOM,3) WORD + DO 541 I=1,20 + PDFPAR(I)=' ' + PDFVAL(I)=0 +541 CONTINUE + PRINT 588 + READ*, (PDFPAR(I),PDFVAL(I),I=1,20) + DO 542 I=1,20 + IF(PDFPAR(I).NE.' ') THEN + WRITE(ITCOM,5401) PDFPAR(I) +5401 FORMAT(1H',A,1H') + WRITE(ITCOM,*) PDFVAL(I) + ENDIF +542 CONTINUE + WRITE(ITCOM,*) '/' + ISTRUC=-999 + LOC(54)=NSEL + GO TO 1000 + ENDIF +#endif +C +C Keyword SUGRA + IF(WORD.EQ.'SUGRA ') THEN + WRITE(ITCOM,3) WORD + PRINT 589 + READ*, XM0SU,XMHSU,XA0SU,XTGBSU,XSMUSU + WRITE(ITCOM,*) XM0SU,XMHSU,XA0SU,XTGBSU,XSMUSU + LOC(55)=NSEL + GOMSSM=.TRUE. + GOSUG=.TRUE. + GO TO 1000 + ENDIF +C +C Keyword HTYPE + IF(WORD.EQ.'HTYPE ') THEN + PRINT*,' Enter Higgs type (HL0, HH0, HA0) in single quotes' + READ*, HTYPE + IHTYPE=0 + IF(HTYPE.EQ.'HL0 ') IHTYPE=82 + IF(HTYPE.EQ.'HH0 ') IHTYPE=83 + IF(HTYPE.EQ.'HA0 ') IHTYPE=84 + IF(IHTYPE.EQ.0) THEN + PRINT*, 'Invalid Higgs type - try again' + GO TO 1000 + ENDIF + WRITE(ITCOM,3) WORD + WRITE(ITCOM,*) HTYPE + LOC(56)=NSEL + GO TO 1000 + ENDIF +C +C Keyword EPOL + IF(WORD.EQ.'EPOL ') THEN + WRITE(ITCOM,3) WORD + PRINT 590 + READ*,PLEM,PLEP + WRITE(ITCOM,*) PLEM,PLEP + LOC(57)=NSEL + GO TO 1000 + ENDIF +C +C Keyword MSSMD + IF(WORD.EQ.'MSSMD ') THEN + WRITE(ITCOM,3) WORD + PRINT 591 + READ*,XQ2SS,XSRSS,XCRSS,XL2SS,XMRSS + WRITE(ITCOM,*) XQ2SS,XSRSS,XCRSS,XL2SS,XMRSS + LOC(58)=NSEL + GO TO 1000 + ENDIF +C +C Keyword MSSME + IF(WORD.EQ.'MSSME ') THEN + WRITE(ITCOM,3) WORD + PRINT 592 + READ*, XM1SS,XM2SS + WRITE(ITCOM,*) XM1SS,XM2SS + LOC(59)=NSEL + GO TO 100 + ENDIF +C +C Keyword GMSB + IF(WORD.EQ.'GMSB ') THEN + WRITE(ITCOM,3) WORD + PRINT 593 + READ*, XLAMGM,XMESGM,XN5GM,XTGBSU,XSMUSU,XCMGV + WRITE(ITCOM,*) XLAMGM,XMESGM,XN5GM,XTGBSU,XSMUSU,XCMGV + LOC(60)=NSEL + GOMSSM=.TRUE. + GOGMSB=.TRUE. + GO TO 1000 + ENDIF +C +C Keyword NUSUG1: optional GUT scale gaugino masses + IF(WORD.EQ.'NUSUG1 ') THEN + WRITE(ITCOM,3) WORD + PRINT 594 + READ*, XNUSUG(1),XNUSUG(2),XNUSUG(3) + WRITE(ITCOM,*) XNUSUG(1),XNUSUG(2),XNUSUG(3) + LOC(61)=NSEL + GO TO 100 + ENDIF +C +C Keyword NUSUG2: optional GUT scale A terms + IF(WORD.EQ.'NUSUG2 ') THEN + WRITE(ITCOM,3) WORD + PRINT 595 + READ*, XNUSUG(6),XNUSUG(5),XNUSUG(4) + WRITE(ITCOM,*) XNUSUG(6),XNUSUG(5),XNUSUG(4) + LOC(62)=NSEL + GO TO 100 + ENDIF +C +C Keyword NUSUG3: optional GUT scale Higgs masses + IF(WORD.EQ.'NUSUG3 ') THEN + WRITE(ITCOM,3) WORD + PRINT 596 + READ*, XNUSUG(7),XNUSUG(8) + WRITE(ITCOM,*) XNUSUG(7),XNUSUG(8) + LOC(63)=NSEL + GO TO 100 + ENDIF +C +C Keyword NUSUG4: optional GUT scale 1st/2nd gen. masses + IF(WORD.EQ.'NUSUG4 ') THEN + WRITE(ITCOM,3) WORD + PRINT 597 + READ*, XNUSUG(13),XNUSUG(11),XNUSUG(12),XNUSUG(10) + $,XNUSUG(9) + WRITE(ITCOM,*) XNUSUG(13),XNUSUG(11),XNUSUG(12),XNUSUG(10) + $,XNUSUG(9) + LOC(64)=NSEL + GO TO 100 + ENDIF +C +C Keyword NUSUG5: optional GUT scale 3rd gen. masses + IF(WORD.EQ.'NUSUG5 ') THEN + WRITE(ITCOM,3) WORD + PRINT 598 + READ*, XNUSUG(18),XNUSUG(16),XNUSUG(17),XNUSUG(15) + $,XNUSUG(14) + WRITE(ITCOM,*) XNUSUG(18),XNUSUG(16),XNUSUG(17),XNUSUG(15) + $,XNUSUG(14) + LOC(65)=NSEL + GO TO 100 + ENDIF +C +C Keyword NOGRAV: No gravitino decays + IF(WORD.EQ.'NOGRAV ') THEN + WRITE(ITCOM,3) WORD + PRINT 572 + READ 571,NOGRAV + WRITE(ITCOM,571) NOGRAV + LOC(66)=NSEL + GO TO 1000 + ENDIF +C +C Keyword MGVTNO: Sets the gravitino mass + IF(WORD.EQ.'MGVTNO ') THEN + WRITE(ITCOM,3) WORD + PRINT 599 + READ*, XMGVTO + WRITE(ITCOM,*) XMGVTO + LOC(67)=NSEL + GO TO 1000 + ENDIF +C +C Keyword AL3UNI: Impose alpha_s unification at M_GUT + IF(WORD.EQ.'AL3UNI ') THEN + WRITE(ITCOM,3) WORD + PRINT 600 + READ*, AL3UNI + WRITE(ITCOM,*) AL3UNI + LOC(68)=NSEL + GO TO 1000 + ENDIF +C +C Keyword GMSB2: additional GMSB parameters + IF(WORD.EQ.'GMSB2 ') THEN + WRITE(ITCOM,3) WORD + PRINT 601 + READ*, XRSLGM,XDHDGM,XDHUGM,XDYGM,XN51GM,XN52GM,XN53GM + WRITE(ITCOM,*) XRSLGM,XDHDGM,XDHUGM,XDYGM,XN51GM,XN52GM,XN53GM + LOC(69)=NSEL + GO TO 1000 + ENDIF +C +C Keyword EEBREM: do bremsstralung + IF(WORD.EQ.'EEBREM ') THEN + WRITE(ITCOM,3) WORD + PRINT 602 + READ*, RSHMIN,RSHMAX + WRITE(ITCOM,*) RSHMIN,RSHMAX + IBREM=.TRUE. + LOC(70)=NSEL + GO TO 1000 + ENDIF +C +C Keyword EEBEAM: do beamstralung + IF(WORD.EQ.'EEBEAM ') THEN + WRITE(ITCOM,3) WORD + PRINT 603 + READ*, RSHMIN,RSHMAX,UPSLON,SIGZ + WRITE(ITCOM,*) RSHMIN,RSHMAX,UPSLON,SIGZ + IBREM=.TRUE. + IBEAM=.TRUE. + LOC(71)=NSEL + GO TO 1000 + ENDIF +C +C Keyword QMKKG (QMW for EXTRADIM) + IF(WORD.EQ.'QMKKG ') THEN + WRITE(ITCOM,3) WORD + PRINT*,'KK graviton mass limits?' + READ*, QMIN,QMAX + WRITE(ITCOM,*) QMIN,QMAX + LOC(19)=NSEL + GO TO 1000 + ENDIF +C +C Keyword QTKKG (QTW for EXTRADIM) + IF(WORD.EQ.'QTKKG ') THEN + WRITE(ITCOM,3) WORD + PRINT*,'KK graviton qt limits?' + READ*, QTMIN,QTMAX + WRITE(ITCOM,*) QTMIN,QTMAX + LOC(20)=NSEL + GO TO 1000 + ENDIF +C +C Keyword EXTRAD for EXTRADIM + IF(WORD.EQ.'EXTRAD ') THEN + WRITE(ITCOM,3) WORD + PRINT*,'KK delta n, mass, UVCUT flag?' + READ*, NEXTRAD,MASSD,UVCUT + WRITE(ITCOM,*) NEXTRAD,MASSD,UVCUT + LOC(72)=NSEL + GO TO 1000 + ENDIF +C +C Keyword MIJLIM + IF(WORD.EQ.'MIJLIM ') THEN + WRITE(ITCOM,3) WORD + PRINT*,'Dijet pair mass limits i,j,min,max?' + READ*, JLIM1,JLIM2,AMLIM1,AMLIM2 + WRITE(ITCOM,*) JLIM1,JLIM2,AMLIM1,AMLIM2 + LOC(73)=NSEL + GO TO 1000 + ENDIF +C +C Keyword MTOT + IF(WORD.EQ.'MTOT ') THEN + WRITE(ITCOM,3) WORD + PRINT*,'Total mass limits?' + READ*, EHMGMN,EHMGMX + WRITE(ITCOM,*) EHMGMN,EHMGMX + LOC(74)=NSEL + GO TO 1000 + ENDIF +C +C Keyword SUGRHN: enter right-neutrino parameters + IF(WORD.EQ.'SUGRHN ') THEN + WRITE(ITCOM,3) WORD + PRINT 604 + READ*, XMN3NR,XMAJNR,XANSS,XNRSS + WRITE(ITCOM,*) XMN3NR,XMAJNR,XANSS,XNRSS + LOC(75)=NSEL + GO TO 1000 + ENDIF +C +C Keyword AMSB + IF(WORD.EQ.'AMSB ') THEN + WRITE(ITCOM,3) WORD + PRINT 605 + READ*, XM0SU,XMHSU,XTGBSU,XSMUSU + WRITE(ITCOM,*) XM0SU,XMHSU,XTGBSU,XSMUSU + LOC(76)=NSEL + GOMSSM=.TRUE. + GOSUG=.TRUE. + GOAMSB=.TRUE. + GO TO 1000 + ENDIF +C +C Keyword SSBCSC + IF(WORD.EQ.'SSBCSC ') THEN + WRITE(ITCOM,3) WORD + PRINT 606 + READ*, XSBCS + WRITE(ITCOM,*) XSBCS + LOC(77)=NSEL + GO TO 1000 + ENDIF +C +C None of the above +C + PRINT 99 + GO TO 1000 +C + 562 FORMAT(' Give jet limits: min1,max1,min2,max2, etc.', + 1' Terminate list with a /.',/, + 2' To fix a variable give only minimum value.',/) + 563 FORMAT(' Allowed range is ',F9.2,' - ',F9.2) + 572 FORMAT(' T or F?') + 584 FORMAT(' Value?') + 585 FORMAT(' Give M(gluino), mu, M(ha), tan(beta)') + 586 FORMAT(' Give M(ul), M(dr), M(ur), M(el), M(er), ') + 587 FORMAT(' Give M(tl), M(br), M(tr), M(taul), M(taur), A(t),', + $' A(b), A(tau)') + 588 FORMAT(' Give PDFLIB keyword, value, ...') + 589 FORMAT(' Give M_0, M_(1/2), A_0, tan(beta), sgn(mu)') + 590 FORMAT(' Give polarizations P_L(e-), P_L(e+)') + 591 FORMAT(' Give optional M(cl), M(sr), M(cr), M(mul), M(mur), ') + 592 FORMAT(' Give optional M_1, M_2') + 593 FORMAT(' Give LAM, M_MES, XN5, tan(beta), sgn(mu), C_mgv') + 594 FORMAT(' Give optional GUT scale M_1, M_2, M_3') + 595 FORMAT(' Give optional GUT scale A_t, A_b, A_tau') + 596 FORMAT(' Give optional GUT scale m_Hd, m_Hu') + 597 FORMAT(' Give optional M(ul), M(dr), M(ur), M(el), M(er), ') + 598 FORMAT(' Give optional M(tl), M(br), M(tr), M(Ll), M(Lr), ') + 599 FORMAT(' Enter optional m(gravitino), ') + 600 FORMAT(' Enter .TRUE. if alpha_s unification is wanted:, ') + 601 FORMAT(' Enter Rsl,dmH_d,dmH_u,RDY,n5_1,n5_2,n5_3: ') + 602 FORMAT(' Enter RSHMIN,RSHMAX for bremsstrahlung: ') + 603 FORMAT(' Enter RSHMIN,RSHMAX,UPSLON,SIGZ for beamstrahlung: ') + 604 FORMAT(' Enter M_N3, M_MAJ, A_N, M_NRSS for RHN model: ') + 605 FORMAT(' Give M_0, M_(3/2), tan(beta), sgn(mu)') + 606 FORMAT(' Enter Q_max= max scale choice for SUSY BCs') +C +C CHECK FOR ERRORS AND OVERLAPPING VARIABLES. +C PRINT ERROR MESSAGE OR WARNINGS + 101 CONTINUE + IF(LOC(2)*LOC(5).NE.0) PRINT 2001 + IF(LOC(2)*LOC(6).NE.0) PRINT 2001 + IF(LOC(15).NE.0.OR.LOC(37).NE.0) DUMY=SETTYP(0) + DO 120 I=1,17 + I1=NLAP(1,I) + I2=NLAP(2,I) + I3=NLAP(3,I) + IF(LOC(I1)*LOC(I2)*LOC(I3).NE.0) PRINT 1001 + 120 CONTINUE + 1001 FORMAT(//,2X,'YOU HAVE GIVEN LIMITS FOR AN OVERLAPPING SET OF', + C ' VARIABLES. SET MINIMIZING PPERP INTERVAL WILL BE USED') + 2001 FORMAT(//,2X,' YOU CANNOT GIVE LIMITS FOR BOTH THETA AND Y. MAKE', + C ' UP YOUR MIND. JOB TERMINATED') + 2003 FORMAT(/,' YOU CANNOT RUN WS AND Z0 OR GAMMAS AT THE SAME TIME') + 2004 FORMAT(//,' PARAMETER OUT OF RANGE. ') + GOTO 1111 + 999 REWIND ITCOM + RETURN + END diff --git a/ISAJET/isarun/isaset.F b/ISAJET/isarun/isaset.F new file mode 100644 index 00000000000..1bb11fd80d2 --- /dev/null +++ b/ISAJET/isarun/isaset.F @@ -0,0 +1,20 @@ +#include "isajet/pilot.h" + SUBROUTINE ISASET(IDKY,IEVT,ICOM,ILIS) +C +C SUBROUTINE TO SET UP ISAJET RUN THROUGH DIALOG +C IDKY, IEVT, ICOM, ILIS ARE TAPE NUMBERS AS FOR ISAJET. +C +#include "isajet/itapes.inc" +C SET TAPE NUMBERS + ITDKY=IABS(IDKY) + ITEVT=IABS(IEVT) + ITCOM=IABS(ICOM) + ITLIS=IABS(ILIS) +C INITIALIZE + CALL SETCON + CALL RESET +C READ COMMANDS INTERACTIVELY AND WRITE COMMAND FILE. + CALL DIALOG + REWIND ITCOM + RETURN + END diff --git a/ISAJET/isasusy/ssalfs.F b/ISAJET/isasusy/ssalfs.F new file mode 100644 index 00000000000..f11edcdc087 --- /dev/null +++ b/ISAJET/isasusy/ssalfs.F @@ -0,0 +1,28 @@ +#include "isajet/pilot.h" + DOUBLE PRECISION FUNCTION SSALFS(Q2) +C----------------------------------------------------------------------- +C Strong coupling formula from page 201 of Barger and Phillips: +C (using ALQCD4 for 4 flavor Lambda) +C +C Bisset's STRCPLH +C----------------------------------------------------------------------- +#include "isajet/sssm.inc" +C + DOUBLE PRECISION Q2,AS,TH5,TH6,PI + DATA PI/3.14159265D0/ +C + TH5=4*AMBT**2 + TH6=4*AMTP**2 + IF (Q2.LE.TH5)THEN + AS=12*PI/(25*LOG(Q2/ALQCD4**2)) + ELSE IF(Q2.GT.TH5.AND.Q2.LE.TH6) THEN + AS=25*LOG(Q2/ALQCD4**2)-2*LOG(Q2/TH5) + AS=12*PI/AS + ELSEIF(Q2.GT.TH6)THEN + AS=25*LOG(Q2/ALQCD4**2) + AS=AS-2*(LOG(Q2/TH5)+LOG(Q2/TH6)) + AS=12*PI/AS + ENDIF + SSALFS=AS + RETURN + END diff --git a/ISAJET/isasusy/ssb0.F b/ISAJET/isasusy/ssb0.F new file mode 100644 index 00000000000..9cde42a6160 --- /dev/null +++ b/ISAJET/isasusy/ssb0.F @@ -0,0 +1,11 @@ +#include "isajet/pilot.h" + COMPLEX*16 FUNCTION SSB0(QSQ,M1,M2) +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/ssinf.inc" + COMPLEX*16 SSF0 + REAL QSQ,M1,M2 + SSB0=XLAM*(1.D0,0.D0)-SSF0(QSQ,M1,M2) + RETURN + END diff --git a/ISAJET/isasusy/ssb1.F b/ISAJET/isasusy/ssb1.F new file mode 100644 index 00000000000..c3bf007071d --- /dev/null +++ b/ISAJET/isasusy/ssb1.F @@ -0,0 +1,37 @@ +#include "isajet/pilot.h" + COMPLEX*16 FUNCTION SSB1(XS,XMI,XMJ) +C Modified by M. Drees 10/26/95 +#include "isajet/ssinf.inc" + REAL XS,XMI,XMJ + DOUBLE PRECISION S,MI,MJ,A0MI,A0MJ + COMPLEX*16 SSB0 + S=XS + MI=XMI + MJ=XMJ + IF(S.GT.1.D-4*(MI**2+MJ**2)) THEN + IF(MI.GE.1.D-10) THEN + A0MI = MI**2*( 1.D0 - LOG(MI**2) + XLAM ) + ELSE + A0MI = 0.D0 + ENDIF + IF(MJ.GE.1.D-10) THEN + A0MJ = MJ**2*( 1.D0 - LOG(MJ**2) + XLAM ) + ELSE + A0MJ = 0.D0 + ENDIF + SSB1 = ( (S+MI**2-MJ**2)*SSB0(XS,XMI,XMJ) + A0MJ - A0MI )/2.D0/S + ELSE IF(ABS(MI-MJ).GT.1.D-4*MJ) THEN + IF(MI.GT.1.D-10.AND.MJ.GT.1.D-10) THEN + SSB1 = -(LOG(MI)*(MI**4-2.*MJ**2*MI**2) + MJ**4*LOG(MJ) + $ -MJ**4/4.D0-.75*MI**4 + MI**2*MJ**2) / (MI**2-MJ**2)**2 + $ + XLAM/2.D0 + ELSEIF(MI.GT.1.D-10) THEN + SSB1 = -LOG(MI) + .75 + .5*XLAM + ELSEIF(MJ.GT.1.D-10) THEN + SSB1 = -LOG(MJ) + .25 + .5*XLAM + ENDIF + ELSE IF(MI.NE.0.D0) THEN + SSB1 = -LOG(MI) + XLAM/2.D0 + ENDIF + RETURN + END diff --git a/ISAJET/isasusy/ssdhll.F b/ISAJET/isasusy/ssdhll.F new file mode 100644 index 00000000000..53a181761ce --- /dev/null +++ b/ISAJET/isasusy/ssdhll.F @@ -0,0 +1,550 @@ +#include "isajet/pilot.h" + SUBROUTINE SSDHLL(DELHLL) +C----------------------------------------------------------------------- +C +C Calculates radiative correction to the +C H_h-H_l-H_l vertex. +C calculated by M. Bisset +C +C This subroutine calculates the +C radiative correction to the +C H_h-H_l-H_l vertex which can be +C important in determining the +C H_h --> H_l H_l partial decay width. +C +C Both top and bottom couplings are now +C included. Non-degenerate mixed squark +C masses and A-terms are also included. +C The D-terms from the squark mass matrix +C (terms prop. to g**2 * Yukawa coupling) +C are included as an option: +C INRAD = 1 ==> D-TERMS ON +C INRAD = 2 ==> D-TERMS OFF . +C +C 10/18/93 D-terms are now turned on. +C INRAD = 1 +C +C There is an arbitrary mass scale that must +C chosen to avoid dimensionful logarithms. +C The choice does not matter if D-terms are +C not included, but it does matter if D-terms +C are included. +C +C 10/18/93 arbitrary mass scale set to H_h mass +C QQQ = AMHH +C +C It is assumed that the A-terms are real. +C +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sslun.inc" +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +C + REAL PI,PI2,SR2,G2,GP2,GGP,GG1,GG2 + REAL TANB,COTB,COSB,SINB,BE + REAL SINB2,COSB2,COS2B,SIN2B + REAL V2,VP2,V,VP,VVP,VPVM,VVPP,MT,MB + REAL MT2,MB2,FT2,FB2,FT,FB,FT4,FB4 + REAL MW2,ZAP,QQQ2,EP,EP2,RR,MHP2 + REAL ATI,ABI,ATR,ABR,AT2,AB2 + REAL MSTL2,MSTR2,MSBL2,MSBR2 + REAL TLRM,BLRM + REAL MST1SQ,MST2SQ,MSB1SQ,MSB2SQ + REAL RTT,RBB +C + REAL A0,A1,A2,A1P,A2P,A3,A4 + REAL B0,B1,B2,B1P,B2P,B3,B4 + REAL MT1R,MT2R,MB1R,MB2R + REAL MT1P,MT2P,MB1P,MB2P + REAL MT1RR,MT2RR,MB1RR,MB2RR + REAL MT1PP,MT2PP,MB1PP,MB2PP + REAL MT1RP,MT2RP,MB1RP,MB2RP + REAL MT1RRR,MT2RRR,MB1RRR,MB2RRR + REAL MT1PRR,MT2PRR,MB1PRR,MB2PRR + REAL MT1RPP,MT2RPP,MB1RPP,MB2RPP + REAL MT1PPP,MT2PPP,MB1PPP,MB2PPP +C + REAL SQVT1,SQVT2,SQVB1,SQVB2 + REAL SQVRRR,SQVPPP,SQVPRR,SQVRPP + REAL FVRRR,FVPPP + REAL VRRR,VPPP,VPRR,VRPP +C + REAL ALPHAT,GGP1SQ,ALPHAB,GGP2SQ,TEMPSQ,BSQ + REAL ASMB,MBMB,MBQ,ASMT,MTMT,MTQ,SUALFS,HIGFRZ + DOUBLE PRECISION SSMQCD +C + REAL CA2,SA2,DVHLL + DOUBLE PRECISION DELHLL +C + INTEGER INRAD,ISPECT,ISPECB +C + MW2=AMW**2 + HIGFRZ=SQRT(AMTLSS*AMTRSS) + QQQ2=HIGFRZ**2 + INRAD=1 + ZAP=1.0 +C + PI=4.*ATAN(1.) + PI2=PI**2 + SR2=SQRT(2.) + G2=4.*PI*ALFAEM/SN2THW + GP2=G2*SN2THW/(1.-SN2THW) + ASMB=SUALFS(AMBT**2,.36,AMTP,3) + MBMB=AMBT*(1.-4*ASMB/3./PI) + MBQ=SSMQCD(DBLE(MBMB),DBLE(HIGFRZ)) + HIGFRZ=SQRT(AMTLSS*AMTRSS) + ASMT=SUALFS(AMTP**2,.36,AMTP,3) + MTMT=AMTP/(1.+4*ASMT/3./PI+(16.11-1.04*(5.-6.63/AMTP))* + $(ASMT/PI)**2) + MTQ=SSMQCD(DBLE(MTMT),DBLE(HIGFRZ)) + MT=MTQ + MB=MBQ + MT2=MT**2 + MB2=MB**2 + EP=TWOM1 + EP2=EP**2 + MHP2=AMHA**2 + RR=RV2V1 + TANB=1.0/RR + COTB=RR + BE=ATAN(1./RV2V1) + SINB=SIN(BE) + COSB=COS(BE) + SINB2=SINB**2 + COSB2=COSB**2 + SIN2B=SIN(2.*BE) + COS2B=COS(2.*BE) + V2=2.0*MW2*SINB2/G2 + VP2=2.0*MW2*COSB2/G2 + V=SQRT(V2) + VP=SQRT(VP2) + VVP=SQRT(V2*VP2) + VPVM=VP2-V2 + GGP=G2+GP2 + GG1=G2-5.0*GP2/3.0 + GG2=G2-GP2/3.0 + VVPP=2.0*AMZ**2/GGP + FT2=MT2/V2 + FB2=MB2/VP2 + FT=SQRT(FT2) + FB=SQRT(FB2) + FT4 = FT2**2 + FB4 = FB2**2 +C +C (AAT and AAB are also assumed to be real) +C + ATR=AAT + ABR=AAB + ATI=0.0 + ABI=0.0 + AT2=ATR**2+ATI**2 + AB2=ABR**2+ABI**2 +C + MSTL2=AMTLSS**2 + MSTR2=AMTRSS**2 + MSBL2=AMBLSS**2 + MSBR2=AMBRSS**2 + TLRM=MSTL2-MSTR2 + BLRM=MSBL2-MSBR2 +C +C UNFORTUNATELY, I HAVE USED MY OLD CONVENTION +C FOR THE STOP AND SBOTTOM EIGENVALUES HERE +C (T1 <==> T2 OF NOTATION IN X. TATA'S AND OTHER +C PEOPLE'S NOTATION). SO THE NEXT FOUR LINES ARE +C A FIX-UP UNTIL I GO THROUGH AND CHANGE THE +C NOTATION THROUGHOUT THIS SUBROUTINE. +C + MST2SQ=AMT1SS**2 + MST1SQ=AMT2SS**2 + MSB2SQ=AMB1SS**2 + MSB1SQ=AMB2SS**2 +C +C +C Calculation of radiative correction to +C the H_H-H_l-H_l vertex +C +C +C STOP TERMS +C + ISPECT=0 + RTT=(TLRM+VPVM*ZAP*GG1/4.0)**2 + $ +4.0*MT2*(EP*COTB+ATR)**2+4.0*MT2*ATI**2 +C + IF(RTT.GT.0.0) THEN + A0=SQRT(RTT) + A1=-V*ZAP*GG1*(TLRM+ZAP*VPVM*GG1/4.0)/SR2 + A1=A1+4.0*SR2*FT*MT*(AT2+EP*ATR*COTB) + A2=-ZAP*GG1*(TLRM+ZAP*VPVM*GG1/4.0)/2.0 + A2=A2 +V2*ZAP*GG1**2/4.0 +4.0*FT2*AT2 + A1P=VP*ZAP*GG1*(TLRM+ZAP*VPVM*GG1/4.0)/SR2 + A1P=A1P+4.0*SR2*FT*MT*EP*(ATR+EP*COTB) + A2P=ZAP*GG1*(TLRM+ZAP*VPVM*GG1/4.0)/2.0 + A2P=A2P +VP2*ZAP*GG1**2/4.0 +4.0*FT2*EP2 + A3=SR2*ZAP*GG1**2/8.0 + A4=-VVP*ZAP*GG1**2/4.0 +4.0*FT2*EP*ATR +C + MT1R=SR2*FT*MT-SR2*V*ZAP*GGP/8.0 +A1/(4.0*A0) + MT2R=SR2*FT*MT-SR2*V*ZAP*GGP/8.0 -A1/(4.0*A0) + MT1P=SR2*VP*ZAP*GGP/8.0 +A1P/(4.0*A0) + MT2P=SR2*VP*ZAP*GGP/8.0 -A1P/(4.0*A0) + MT1RR=FT2 -ZAP*GGP/8.0 -A1**2/(8.0*A0**3) +A2/(4.0*A0) + MT2RR=FT2 -ZAP*GGP/8.0 +A1**2/(8.0*A0**3) -A2/(4.0*A0) + MT1PP=ZAP*GGP/8.0 -A1P**2/(8.0*A0**3) +A2P/(4.0*A0) + MT2PP=ZAP*GGP/8.0 +A1P**2/(8.0*A0**3) -A2P/(4.0*A0) + MT1RRR=3.0*A1**3/(16.0*A0**3) + MT1RRR=MT1RRR/(A0**2) -3.0*A1*A2/(8.0*A0**3) + $ +3.0*V*A3/(4.0*A0) + MT2RRR=-MT1RRR + MT1PPP=3.0*A1P**3/(16.0*A0**3) + MT1PPP=MT1PPP/(A0**2) -3.0*A1P*A2P/(8.0*A0**3) + $ +3.0*VP*A3/(4.0*A0) + MT2PPP=-MT1PPP + MT1RP=-A1*A1P/(8.0*A0**3) +A4/(4.0*A0) + MT2RP=-MT1RP + MT1PRR=3.0*A1P*A1**2/(16.0*A0**3) + MT1PRR=MT1PRR/(A0**2) + $ -(A2*A1P+2.0*A1*A4)/(8.0*A0**3) -VP*A3/(4.0*A0) + MT2PRR=-MT1PRR + MT1RPP=3.0*A1*A1P**2/(16.0*A0**3) + MT1RPP=MT1RPP/(A0**2) + $ -(A1*A2P+2.0*A1P*A4)/(8.0*A0**3) -V*A3/(4.0*A0) + MT2RPP=-MT1RPP + ELSEIF(RTT.EQ.0.0) THEN + IF(INRAD.EQ.2.OR.TANB.EQ.1.0) THEN + IF(EP.EQ.0.0.AND.TLRM.EQ.0.0) THEN + IF(ATR.EQ.0.0.AND.ATI.EQ.0.0) THEN + ISPECT=1 + MT1R=SR2*V*FT2 + MT2R=SR2*V*FT2 + MT1P=0.0 + MT2P=0.0 + MT1RR=FT2 + MT2RR=FT2 + MT1PP=0.0 + MT2PP=0.0 + MT1RRR=0.0 + MT2RRR=0.0 + MT1PPP=0.0 + MT2PPP=0.0 + MT1RP=0.0 + MT2RP=0.0 + MT1PRR=0.0 + MT2PRR=0.0 + MT1RPP=0.0 + MT2RPP=0.0 + ENDIF + ENDIF + ENDIF + ENDIF + IF(RTT.NE.0.0 .OR. ISPECT.EQ.1) THEN + SQVT1=2.0*(3.0*MT1R*MT1RR+MST1SQ*MT1RRR) + SQVT1=SQVT1*LOG(MST1SQ/QQQ2) + SQVT1=SQVT1 +2.0*MT1R**3/MST1SQ +9.0*MT1R*MT1RR + SQVT1=SQVT1+MST1SQ*MT1RRR + SQVT2=2.0*(3.0*MT2R*MT2RR+MST2SQ*MT2RRR) + SQVT2=SQVT2*LOG(MST2SQ/QQQ2) + SQVT2=SQVT2 +2.0*MT2R**3/MST2SQ +9.0*MT2R*MT2RR + SQVT2=SQVT2+MST2SQ*MT2RRR + SQVRRR=SQVT1+SQVT2 +C + SQVT1=2.0*(3.0*MT1P*MT1PP+MST1SQ*MT1PPP) + SQVT1=SQVT1*LOG(MST1SQ/QQQ2) + SQVT1=SQVT1 +2.0*MT1P**3/MST1SQ + 9.0*MT1P*MT1PP + SQVT1=SQVT1+MST1SQ*MT1PPP + SQVT2=2.0*(3.0*MT2P*MT2PP+MST2SQ*MT2PPP) + SQVT2=SQVT2*LOG(MST2SQ/QQQ2) + SQVT2=SQVT2 +2.0*MT2P**3/MST2SQ +9.0*MT2P*MT2PP + SQVT2=SQVT2 +MST2SQ*MT2PPP + SQVPPP = SQVT1 + SQVT2 +C + SQVT1=2.0*MT1R*MT1RP+MT1P*MT1RR+MST1SQ*MT1PRR + SQVT1=2.0*SQVT1*LOG(MST1SQ/QQQ2) + SQVT1=SQVT1 +2.0*MT1P*MT1R**2/MST1SQ + SQVT1=SQVT1+3.0*MT1P*MT1RR+6.0*MT1R*MT1RP + SQVT1=SQVT1+MST1SQ*MT1PRR + SQVT2=2.0*MT2R*MT2RP+MT2P*MT2RR+MST2SQ*MT2PRR + SQVT2=2.0*SQVT2*LOG(MST2SQ/QQQ2) + SQVT2=SQVT2 +2.0*MT2P*MT2R**2/MST2SQ + SQVT2=SQVT2+3.0*MT2P*MT2RR+6.0*MT2R*MT2RP + SQVT2=SQVT2+MST2SQ*MT2PRR + SQVPRR=SQVT1+SQVT2 +C + SQVT1=2.0*MT1P*MT1RP+MT1R*MT1PP+MST1SQ*MT1RPP + SQVT1=2.0*SQVT1*LOG(MST1SQ/QQQ2) + SQVT1=SQVT1 +2.0*MT1R*MT1P**2/MST1SQ + SQVT1=SQVT1+3.0*MT1R*MT1PP+6.0*MT1P*MT1RP + SQVT1=SQVT1+MST1SQ*MT1RPP + SQVT2=2.0*MT2P*MT2RP+MT2R*MT2PP+MST2SQ*MT2RPP + SQVT2=2.0*SQVT2*LOG(MST2SQ/QQQ2) + SQVT2=SQVT2 +2.0*MT2R*MT2P**2/MST2SQ + SQVT2=SQVT2+3.0*MT2R*MT2PP+6.0*MT2P*MT2RP + SQVT2=SQVT2+MST2SQ*MT2RPP + SQVRPP=SQVT1+SQVT2 +C + FVRRR=-2.0*SR2*FT4*V*(6.0*LOG(MT2/QQQ2) + 13.0) + ENDIF +C + IF(RTT.EQ.0.0 .AND. ISPECT.EQ.0) THEN + ALPHAT=(MSTL2 + MSTR2)/2.0 + MT2 + ALPHAT=ALPHAT +VP2*(1.0-TANB**2)*ZAP*GGP/8.0 + GGP1SQ= ZAP*GGP**2 +ZAP*GG1**2 +C + SQVRRR=12.0*FT4*LOG(ALPHAT/MT2) + TEMPSQ=-FT2*ZAP*GGP +GGP1SQ/16.0 + SQVRRR=SQVRRR +3.0*TEMPSQ*LOG(ALPHAT/QQQ2) + SQVRRR=SQVRRR -8.0*FT4 -9.0*FT2*ZAP*GGP/2.0 + SQVRRR=SQVRRR +9.0*GGP1SQ/32.0 + TEMPSQ=8.0*V2*(FT2-ZAP*GGP/8.0)**2 + TEMPSQ=TEMPSQ +3.0*V2*ZAP*GG1**2/8.0 + TEMPSQ=TEMPSQ +6.0*FT2*EP2*COTB**2 + SQVRRR=SQVRRR +TEMPSQ*(FT2-ZAP*GGP/8.0)/ALPHAT + SQVRRR=SQVRRR*SR2*V +C + SQVPPP=3.0*GGP1SQ*(2.0*LOG(ALPHAT/QQQ2)+3.0)/32.0 + TEMPSQ=ZAP*GGP*(ZAP*GGP**2+3.0*GG1**2)*VP2/ALPHAT/64.0 + SQVPPP=SQVPPP+TEMPSQ + TEMPSQ=3.0*FT2*EP2*ZAP*GGP/ALPHAT/4.0 + SQVPPP=(SQVPPP+TEMPSQ)*SR2*VP +C + TEMPSQ=FT2*ZAP*GGP -GGP1SQ/8.0 + SQVPRR=TEMPSQ*(2.0*LOG(ALPHAT/QQQ2)+3.0) + TEMPSQ=4.0*ZAP*GGP*(FT2-ZAP*GGP/8.0)-FT2*ZAP*GG1**2 + TEMPSQ=TEMPSQ +3.0*ZAP*GGP*GG1**2/16.0 + TEMPSQ=V2*TEMPSQ+EP2*FT2*ZAP*GGP*(2.0+COTB**2) + TEMPSQ=TEMPSQ-16.0*EP2*FT4 + SQVPRR=(SQVPRR+TEMPSQ/ALPHAT)*SR2*VP/4.0 +C + TEMPSQ=FT2*ZAP*GGP -GGP1SQ/8.0 + SQVRPP=TEMPSQ*(2.0*LOG(ALPHAT/QQQ2)+3.0) + TEMPSQ=GGP1SQ*(FT2-ZAP*GGP/8.0)-ZAP*GGP*GG1**2/4.0 + TEMPSQ=VP2*TEMPSQ/2.0 +8.0*EP2*FT4 + TEMPSQ=TEMPSQ+EP2*FT2*ZAP*GGP*(1.0+2.0*COTB**2) + SQVRPP=(SQVRPP+TEMPSQ/ALPHAT)*SR2*V/4.0 +C + FVRRR = 0.0 +C +C Fermion part (FRRR) is already combined +C with the squark part. +C + ENDIF +C +C +C SBOTTOM TERMS +C + ISPECB=0 + RBB=(BLRM-VPVM*ZAP*GG2/4.0)**2 + $ +4.0*MB2*(EP*TANB+ABR)**2+4.0*MB2*ABI**2 +C + IF(RBB.GT.0.0) THEN + B0=SQRT(RBB) + B1=V*ZAP*GG2*(BLRM-ZAP*VPVM*GG2/4.0)/SR2 + B1=B1+4.0*SR2*FB*MB*EP*(ABR+EP*TANB) + B2=ZAP*GG2*(BLRM-ZAP*VPVM*GG2/4.0)/2.0 + B2=B2 +V2*ZAP*GG2**2/4.0 +4.0*FB2*EP2 + B1P=-VP*ZAP*GG2*(BLRM-ZAP*VPVM*GG2/4.0)/SR2 + B1P=B1P+4.0*SR2*FB*MB*(AB2+EP*ABR*TANB) + B2P=-ZAP*GG2*(BLRM-ZAP*VPVM*GG2/4.0)/2.0 + B2P=B2P +VP2*ZAP*GG2**2/4.0 +4.0*FB2*AB2 + B3=SR2*ZAP*GG2**2/8.0 + B4=-VVP*ZAP*GG2**2/4.0 +4.0*FB2*EP*ABR +C + MB1R=SR2*V*ZAP*GGP/8.0 +B1/(4.0*B0) + MB2R=SR2*V*ZAP*GGP/8.0 -B1/(4.0*B0) + MB1P=SR2*FB*MB -SR2*VP*ZAP*GGP/8.0 +B1P/(4.0*B0) + MB2P=SR2*FB*MB -SR2*VP*ZAP*GGP/8.0 -B1P/(4.0*B0) + MB1RR=ZAP*GGP/8.0 -B1**2/(8.0*B0**3) +B2/(4.0*B0) + MB2RR=ZAP*GGP/8.0 +B1**2/(8.0*B0**3) -B2/(4.0*B0) + MB1PP=FB2 -ZAP*GGP/8.0 + MB2PP=MB1PP + MB1PP=MB1PP -B1P**2/(8.0*B0**3) +B2P/(4.0*B0) + MB2PP=MB2PP +B1P**2/(8.0*B0**3) -B2P/(4.0*B0) + MB1RRR=3.0*B1**3/(16.0*B0**3) + MB1RRR=MB1RRR/(B0**2) -3.0*B1*B2/(8.0*B0**3) + $ +3.0*V*B3/(4.0*B0) + MB2RRR=-MB1RRR + MB1PPP=3.0*B1P**3/(16.0*B0**3) + MB1PPP=MB1PPP/(B0**2) -3.0*B1P*B2P/(8.0*B0**3) + MB1PPP=MB1PPP +3.0*VP*B3/(4.0*B0) + MB2PPP=-MB1PPP + MB1RP=-B1*B1P/(8.0*B0**3) +B4/(4.0*B0) + MB2RP=-MB1RP + MB1PRR=3.0*B1P*B1**2/(16.0*B0**3) + MB1PRR=MB1PRR/(B0**2) -(B2*B1P+2.0*B1*B4)/(8.0*B0**3) + MB1PRR=MB1PRR -VP*B3/(4.0*B0) + MB2PRR=-MB1PRR + MB1RPP=3.0*B1*B1P**2/(16.0*B0**3) + MB1RPP=MB1RPP/(B0**2) -(B1*B2P+2.0*B1P*B4)/(8.0*B0**3) + MB1RPP=MB1RPP -V*B3/(4.0*B0) + MB2RPP=-MB1RPP + ELSEIF(RBB.EQ.0.0) THEN + IF(INRAD.EQ.2.OR.TANB.EQ.1.0) THEN + IF(EP.EQ.0.0.AND.BLRM.EQ.0.0) THEN + IF(ABR.EQ.0.0.AND.ABI.EQ.0.0) THEN + ISPECB=1 + MB1R=0.0 + MB2R=0.0 + MB1P=SR2*VP*FB2 + MB2P=SR2*VP*FB2 + MB1RR=0.0 + MB2RR=0.0 + MB1PP=FB2 + MB2PP=FB2 + MB1RRR=0.0 + MB2RRR=0.0 + MB1PPP=0.0 + MB2PPP=0.0 + MB1RP=0.0 + MB2RP=0.0 + MB1PRR=0.0 + MB1PRR=0.0 + MB2PRR=0.0 + MB1RPP=0.0 + MB2RPP=0.0 + ENDIF + ENDIF + ENDIF + ENDIF +C + IF(RBB.NE.0.0 .OR. ISPECB.EQ.1) THEN + SQVB1=2.0*(3.0*MB1R*MB1RR+MSB1SQ*MB1RRR) + SQVB1=SQVB1*LOG(MSB1SQ/QQQ2) + SQVB1=SQVB1 +2.0*MB1R**3/MSB1SQ +9.0*MB1R*MB1RR + SQVB1=SQVB1+MSB1SQ*MB1RRR + SQVB2=2.0*(3.0*MB2R*MB2RR+MSB2SQ*MB2RRR) + SQVB2=SQVB2*LOG(MSB2SQ/QQQ2) + SQVB2=SQVB2 +2.0*MB2R**3/MSB2SQ +9.0*MB2R*MB2RR + SQVB2=SQVB2+MSB2SQ*MB2RRR + SQVRRR = SQVRRR + SQVB1 + SQVB2 +C + SQVB1=2.0*(3.0*MB1P*MB1PP+MSB1SQ*MB1PPP) + SQVB1=SQVB1*LOG(MSB1SQ/QQQ2) + SQVB1=SQVB1 +2.0*MB1P**3/MSB1SQ +9.0*MB1P*MB1PP + SQVB1=SQVB1+MSB1SQ*MB1PPP + SQVB2=2.0*(3.0*MB2P*MB2PP+MSB2SQ*MB2PPP) + SQVB2=SQVB2*LOG(MSB2SQ/QQQ2) + SQVB2=SQVB2 +2.0*MB2P**3/MSB2SQ +9.0*MB2P*MB2PP + SQVB2=SQVB2+MSB2SQ*MB2PPP + SQVPPP= SQVPPP+SQVB1+SQVB2 +C + SQVB1=2.0*MB1R*MB1RP+MB1P*MB1RR+MSB1SQ*MB1PRR + SQVB1=2.0*SQVB1*LOG(MSB1SQ/QQQ2) + SQVB1=SQVB1 +2.0*MB1P*MB1R**2/MSB1SQ + SQVB1=SQVB1 +3.0*MB1P*MB1RR +6.0*MB1R*MB1RP + SQVB1=SQVB1+MSB1SQ*MB1PRR + SQVB2=2.0*MB2R*MB2RP+MB2P*MB2RR+MSB2SQ*MB2PRR + SQVB2=2.0*SQVB2*LOG(MSB2SQ/QQQ2) + SQVB2=SQVB2 +2.0*MB2P*MB2R**2/MSB2SQ + SQVB2=SQVB2 +3.0*MB2P*MB2RR +6.0*MB2R*MB2RP + SQVB2=SQVB2+MSB2SQ*MB2PRR + SQVPRR=SQVPRR+SQVB1+SQVB2 +C + SQVB1=2.0*MB1P*MB1RP+MB1R*MB1PP+MSB1SQ*MB1RPP + SQVB1=2.0*SQVB1*LOG(MSB1SQ/QQQ2) + SQVB1=SQVB1 +2.0*MB1R*MB1P**2/MSB1SQ + SQVB1=SQVB1+3.0*MB1R*MB1PP+6.0*MB1P*MB1RP + SQVB1=SQVB1+MSB1SQ*MB1RPP + SQVB2=2.0*MB2P*MB2RP+MB2R*MB2PP+MSB2SQ*MB2RPP + SQVB2=2.0*SQVB2*LOG(MSB2SQ/QQQ2) + SQVB2=SQVB2 +2.0*MB2R*MB2P**2/MSB2SQ + SQVB2=SQVB2 +3.0*MB2R*MB2PP +6.0*MB2P*MB2RP + SQVB2=SQVB2+MSB2SQ*MB2RPP + SQVRPP=SQVRPP+SQVB1+SQVB2 +C + IF(MB2.EQ.0.0) THEN + FVPPP=0.0 + ELSE IF(MB2.NE.0.0) THEN + FVPPP=-2.0*SR2*FB4*VP*(6.0*LOG(MB2/QQQ2)+13.0) + ENDIF +C + ENDIF +C + IF(RBB.EQ.0.0 .AND. ISPECB.EQ.0) THEN + ALPHAB=(MSBL2+MSBR2)/2.0 +MB2 + ALPHAB=ALPHAB -VP2*(1.0-TANB**2)*ZAP*GGP/8.0 + GGP2SQ=ZAP*GGP**2 +ZAP*GG2**2 +C + BSQ=3.0*GGP2SQ*(2.0*LOG(ALPHAB/QQQ2)+3.0)/8.0 + TEMPSQ=V2*(ZAP*GGP**2 +3.0*ZAP*GG2**2)/16.0 + $ +3.0*FB2*EP2 + BSQ=(BSQ +ZAP*GGP*TEMPSQ/ALPHAB)*SR2*V/4.0 + SQVRRR=SQVRRR+BSQ +C + BSQ=12.0*FB4*LOG(ALPHAB/MB2) -8.0*FB4 + TEMPSQ=-FB2*ZAP*GGP +GGP2SQ/16.0 + BSQ=BSQ+3.0*TEMPSQ*(LOG(ALPHAB/QQQ2)+1.5) + TEMPSQ=8.0*VP2*(FB2-ZAP*GGP/8.0)**2 + $ +3.0*VP2*ZAP*GG2**2/8.0 +6.0*FB2*EP2*TANB**2 + BSQ=BSQ +(FB2-ZAP*GGP/8.0)*TEMPSQ/ALPHAB + BSQ=BSQ*SR2*VP + SQVPPP=SQVPPP+BSQ +C + TEMPSQ=0.5*(FB2*ZAP*GGP -GGP2SQ/8.0) + BSQ=TEMPSQ*(LOG(ALPHAB/QQQ2)+1.5) + TEMPSQ=(FB2 -ZAP*GGP/8.0)*GGP2SQ -ZAP*GGP*GG2**2/4.0 + TEMPSQ=V2*TEMPSQ/4.0 +4.0*FB4*EP2 -FB2*EP2*ZAP*GGP/2.0 + TEMPSQ=(TEMPSQ-FB2*EP2*ZAP*GGP*TANB**2)/ALPHAB/2.0 + BSQ=(BSQ+TEMPSQ)*SR2*VP + SQVPRR=SQVPRR+BSQ +C + TEMPSQ=0.5*(FB2*ZAP*GGP -GGP2SQ/8.0) + BSQ=TEMPSQ*(LOG(ALPHAB/QQQ2)+1.5) + TEMPSQ=4.0*ZAP*GGP*(FB2 -ZAP*GGP/8.0)**2 + $ -FB2*ZAP*GG2**2 +3.0*ZAP*GGP*GG2**2/16.0 + TEMPSQ=VP2*TEMPSQ-16.0*FB4*EP2 + TEMPSQ=TEMPSQ+FB2*EP2*ZAP*GGP*(TANB**2 +0.5) + BSQ=(BSQ +TEMPSQ/ALPHAB/4.0)*SR2*V + SQVRPP=SQVRPP+BSQ +C + FVPPP=0.0 +C +C Fermion part (FPPP) is already combined +C with the squark part. +C + ENDIF +C +C + VRRR=3.0*(SQVRRR+FVRRR)/(32.0*PI2) + VRRR=VRRR/6.0 +C + VPPP=3.0*(SQVPPP+FVPPP)/(32.0*PI2) + VPPP=VPPP/6.0 +C + VPRR=3.0*(SQVPRR)/(32.0*PI2) + VPRR=VPRR/2.0 +C + VRPP=3.0*(SQVRPP)/(32.0*PI2) + VRPP=VRPP/2.0 +C +C +C Note in the following that the angle ALFAH +C calculated in the subroutine SSMHN must +C be input. +C + CA2=(COS(ALFAH))**2 + SA2=(SIN(ALFAH))**2 + DVHLL=-VRRR*CA2*SIN(ALFAH) + DVHLL=DVHLL +VPRR*(CA2-2.0*SA2)*COS(ALFAH) + DVHLL=DVHLL +VRPP*(2.0*CA2-SA2)*SIN(ALFAH) + DVHLL=DVHLL +VPPP*SA2*COS(ALFAH) +C + DVHLL=3.0*DVHLL + DVHLL=-DVHLL +C +C Finally, multiply bt the coefficient of the +C tree-level Lagrangian level term (COEFF.) +C so that the answer may be written as: +C DW = (COEFF.)**2 +C * (TREE-LEVEL ANGULAR DEPENDENCE + DVHLL) +C +C *(LAMBDA KINEMATIC FCN)**0.5/(8*PI*MHH**3) +C +C + DVHLL=4.0*SQRT((1.-SN2THW)/G2)*DVHLL/AMZ +C +C +1000 DELHLL=DVHLL + RETURN + END diff --git a/ISAJET/isasusy/ssdint.F b/ISAJET/isasusy/ssdint.F new file mode 100644 index 00000000000..50705bf3876 --- /dev/null +++ b/ISAJET/isasusy/ssdint.F @@ -0,0 +1,143 @@ +#include "isajet/pilot.h" + DOUBLE PRECISION FUNCTION SSDINT(XL,F,XR) +C----------------------------------------------------------------------- +C Integrate F over (XL,XR) using adaptive Gaussian quadrature. +C TOLABS = 1e-35: absolute error for convergence. +C TOLREL = 5e-5: relative error for convergence. +C TOLBIN = 1e-3: relative bin size limit. Set contribution to +C zero if bin falls below this. +C Note quadrature constants R and W have been converted to explicit +C double precision (.xxxxxDxx) form. +C +C Bisset's XINTH +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sslun.inc" + EXTERNAL F + INTEGER NMAX + DOUBLE PRECISION TOLABS,TOLREL,TOLBIN,XMIN,XLIMS(100) + DOUBLE PRECISION R(93),W(93) + INTEGER PTR(4),NORD(4) + INTEGER ICOUNT,IBAD + DOUBLE PRECISION XL,XR,F + DOUBLE PRECISION AA,BB,TVAL,VAL,TOL + INTEGER NLIMS,I,J,KKK +C + DATA PTR,NORD/4,10,22,46, 6,12,24,48/ + DATA (R(KKK),KKK=1,48)/ + $ .2386191860D0,.6612093865D0,.9324695142D0,.1252334085D0, + $ .3678314990D0,.5873179543D0,.7699026742D0,.9041172563D0, + $ .9815606342D0,.0640568929D0,.1911188675D0,.3150426797D0, + $ .4337935076D0,.5454214714D0,.6480936519D0,.7401241916D0, + $ .8200019860D0,.8864155270D0,.9382745520D0,.9747285560D0, + $ .9951872200D0,.0323801710D0,.0970046992D0,.1612223561D0, + $ .2247637903D0,.2873624873D0,.3487558863D0,.4086864820D0, + $ .4669029048D0,.5231609747D0,.5772247261D0,.6288673968D0, + $ .6778723796D0,.7240341309D0,.7671590325D0,.8070662040D0, + $ .8435882616D0,.8765720203D0,.9058791367D0,.9313866907D0, + $ .9529877032D0,.9705915925D0,.9841245837D0,.9935301723D0, + $ .9987710073D0,.0162767488D0,.0488129851D0,.0812974955D0/ + DATA (R(KKK),KKK=49,93)/ + $ .1136958501D0,.1459737146D0,.1780968824D0,.2100313105D0, + $ .2417431561D0,.2731988126D0,.3043649444D0,.3352085229D0, + $ .3656968614D0,.3957976498D0,.4254789884D0,.4547094222D0, + $ .4834579739D0,.5116941772D0,.5393881083D0,.5665104186D0, + $ .5930323648D0,.6189258401D0,.6441634037D0,.6687183100D0, + $ .6925645366D0,.7156768123D0,.7380306437D0,.7596023411D0, + $ .7803690438D0,.8003087441D0,.8194003107D0,.8376235112D0, + $ .8549590334D0,.8713885059D0,.8868945174D0,.9014606353D0, + $ .9150714231D0,.9277124567D0,.9393703398D0,.9500327178D0, + $ .9596882914D0,.9683268285D0,.9759391746D0,.9825172636D0, + $ .9880541263D0,.9925439003D0,.9959818430D0,.9983643759D0, + $ .9996895039/ + DATA (W(KKK),KKK=1,48)/ + $ .4679139346D0,.3607615730D0,.1713244924D0,.2491470458D0, + $ .2334925365D0,.2031674267D0,.1600783285D0,.1069393260D0, + $ .0471753364D0,.1279381953D0,.1258374563D0,.1216704729D0, + $ .1155056681D0,.1074442701D0,.0976186521D0,.0861901615D0, + $ .0733464814D0,.0592985849D0,.0442774388D0,.0285313886D0, + $ .0123412298D0,.0647376968D0,.0644661644D0,.0639242386D0, + $ .0631141923D0,.0620394232D0,.0607044392D0,.0591148397D0, + $ .0572772921D0,.0551995037D0,.0528901894D0,.0503590356D0, + $ .0476166585D0,.0446745609D0,.0415450829D0,.0382413511D0, + $ .0347772226D0,.0311672278D0,.0274265097D0,.0235707608D0, + $ .0196161605D0,.0155793157D0,.0114772346D0,.0073275539D0, + $ .0031533461D0,.0325506145D0,.0325161187D0,.0324471637D0/ + DATA (W(KKK),KKK=49,93)/ + $ .0323438226D0,.0322062048D0,.0320344562D0,.0318287589D0, + $ .0315893308D0,.0313164256D0,.0310103326D0,.0306713761D0, + $ .0302999154D0,.0298963441D0,.0294610900D0,.0289946142D0, + $ .0284974111D0,.0279700076D0,.0274129627D0,.0268268667D0, + $ .0262123407D0,.0255700360D0,.0249006332D0,.0242048418D0, + $ .0234833991D0,.0227370697D0,.0219666444D0,.0211729399D0, + $ .0203567972D0,.0195190811D0,.0186606796D0,.0177825023D0, + $ .0168854799D0,.0159705629D0,.0150387210D0,.0140909418D0, + $ .0131282296D0,.0121516047D0,.0111621020D0,.0101607705D0, + $ .0091486712D0,.0081268769D0,.0070964708D0,.0060585455D0, + $ .0050142027D0,.0039645543D0,.0029107318D0,.0018539608D0, + $ .0007967921/ +C + DATA TOLABS,TOLREL,TOLBIN,NMAX/1.D-35,5.D-5,1D-5,100/ +C + SSDINT=0 + NLIMS=2 + XLIMS(1)=XL + XLIMS(2)=XR + ICOUNT=0 + IBAD=0 + XMIN=TOLBIN*ABS(XR-XL) +C +10 AA=(XLIMS(NLIMS)-XLIMS(NLIMS-1))/2 + BB=(XLIMS(NLIMS)+XLIMS(NLIMS-1))/2 + TVAL=0 + DO 15 I=1,3 +15 TVAL=TVAL+W(I)*(F(BB+AA*R(I))+F(BB-AA*R(I))) + TVAL=TVAL*AA + DO 25 J=1,4 + VAL=0 + DO 20 I=PTR(J),PTR(J)-1+NORD(J) + ICOUNT=ICOUNT+1 + IF(ICOUNT.GT.1E5) THEN + WRITE(LOUT,*) 'ERROR IN SSDINT: SET SSDINT = 0' + SSDINT=0. + RETURN + ENDIF +20 VAL=VAL+W(I)*(F(BB+AA*R(I))+F(BB-AA*R(I))) + VAL=VAL*AA + TOL=MAX(TOLABS,TOLREL*ABS(VAL)) + IF(ABS(TVAL-VAL).LT.TOL) THEN + SSDINT=SSDINT+VAL + NLIMS=NLIMS-2 + IF (NLIMS.NE.0) GO TO 10 + GO TO 999 + ELSEIF(ABS(AA).LT.XMIN.AND.J.EQ.4) THEN +C Bin is too small -- set VAL = 0. -- FEP + IBAD=IBAD+1 + NLIMS=NLIMS-2 + IF (NLIMS.NE.0) GO TO 10 + GO TO 999 + ENDIF +25 TVAL=VAL + IF(NMAX.EQ.2) THEN + SSDINT=VAL + GO TO 999 + ENDIF + IF(NLIMS.GT.(NMAX-2)) THEN + WRITE(LOUT,50) SSDINT,NMAX,BB-AA,BB+AA +50 FORMAT (' ERROR IN SSDINT, SSDINT,NMAX,XL,XR=',G15.7,I5,2G15.7) + RETURN + ENDIF + XLIMS(NLIMS+1)=BB + XLIMS(NLIMS+2)=BB+AA + XLIMS(NLIMS)=BB + NLIMS=NLIMS+2 + GO TO 10 +C +999 IF(IBAD.GT.0) THEN + WRITE(LOUT,*) 'WARNING IN SSXINT: BAD CONVERGENCE FOR ',IBAD, + $ ' INTERVALS.' + ENDIF + RETURN + END diff --git a/ISAJET/isasusy/ssdlam.F b/ISAJET/isasusy/ssdlam.F new file mode 100644 index 00000000000..b5db20cb63a --- /dev/null +++ b/ISAJET/isasusy/ssdlam.F @@ -0,0 +1,19 @@ +#include "isajet/pilot.h" + DOUBLE PRECISION FUNCTION SSDLAM(A,B,C) +C----------------------------------------------------------------------- +C Kinematic function +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + DOUBLE PRECISION A,B,C +C Rewrite SSDLAM=A**2+B**2+C**2-2*A*B-2*A*C-2*B*C + IF(A.GE.B.AND.A.GE.C) THEN + SSDLAM=(A-B-C)**2-4*B*C + ELSEIF(B.GE.A.AND.B.GE.C) THEN + SSDLAM=(B-A-C)**2-4*A*C + ELSE + SSDLAM=(C-A-B)**2-4*A*B + ENDIF + RETURN + END diff --git a/ISAJET/isasusy/ssf0.F b/ISAJET/isasusy/ssf0.F new file mode 100644 index 00000000000..bd82fbfc98c --- /dev/null +++ b/ISAJET/isasusy/ssf0.F @@ -0,0 +1,77 @@ +#include "isajet/pilot.h" + COMPLEX*16 FUNCTION SSF0(XQSQ,XM1,XM2) +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + REAL XQSQ,XM1,XM2 + DOUBLE PRECISION QSQ,M1,M2,M1SQ,M2SQ,AQSQ,RE,XI,R + DOUBLE PRECISION PI,T1,T2,BETA,XL,T + DATA PI/3.14159265359D0/ + QSQ=XQSQ + M1=XM1 + M2=XM2 + M1SQ=M1*M1 + M2SQ=M2*M2 + AQSQ=ABS(QSQ) + IF(AQSQ.LT.1.D-6*(M1SQ+M2SQ)) THEN + IF(ABS(M1-M2).LT.1.D-6*M1) THEN + IF(M1SQ.LT.1.D-8) THEN + RE=LOG(1.D-8) + ELSE + RE=LOG(M1SQ)+.5*(M2SQ/M1SQ-1.D0) -QSQ/(6.*M1SQ) + ENDIF + ELSE + IF(M2SQ.LT.1.D-6*M1SQ) THEN + RE=LOG(M1SQ)-1.D0 + ELSE IF(M1SQ.LT.1.D-6*M2SQ) THEN + RE=LOG(M2SQ)-1.D0 + ELSEIF(M1SQ.GE.1.D-9*M2SQ) THEN + RE=LOG(M1*M2)+(M1SQ+M2SQ)/(M1SQ-M2SQ)*LOG(M1/M2)-1.D0 + $ -QSQ*(.5*(M1SQ+M2SQ)-M1SQ*M2SQ*LOG(M2SQ/M1SQ)/(M2SQ-M1SQ)) + $ /(M1SQ-M2SQ)**2 + ENDIF + ENDIF + XI=0.D0 + ELSE + IF(M1SQ.LT.1.D-6*AQSQ.OR.M2SQ.LT.1.D-6*AQSQ.OR. + $ M1SQ+M2SQ.LT.1.D-5*AQSQ) THEN + IF(M1SQ.LT.1.D-6*AQSQ) THEN + R=M2SQ/QSQ + ELSE + R=M1SQ/QSQ + ENDIF + IF(ABS(R-1.D0).GT.1.D-6.AND.ABS(R).GT.1.D-6.AND. + $ M1SQ+M2SQ.GT.1.D-5*AQSQ) THEN + RE=LOG(R*QSQ)-2.D0+(1.D0-R)*LOG(ABS(1.D0-1.D0/R)) + ELSE + RE=-2.D0+LOG(AQSQ) + ENDIF + IF(R.LT.1.D0.AND.R.GT.-1.D-10) THEN + XI=-PI*(1.D0-R) + ELSE + XI=0.D0 + ENDIF + ELSE + T1=(M1-M2)*(M1-M2) + T2=T1+4.0*M1*M2 + BETA=SQRT(ABS((1.D0-T1/QSQ)*(1.D0-T2/QSQ))) + IF(QSQ.GT.T2.OR.QSQ.LT.T1) THEN + XL=.5*BETA*LOG((QSQ*(1.D0+BETA)-M1SQ-M2SQ)/ + $ (QSQ*(1.D0-BETA)-M1SQ-M2SQ)) + ELSE + T=M1SQ+M2SQ-QSQ + IF(T.EQ.0.) T=1.D-10 + XL=BETA*ATAN(QSQ*BETA/T) + IF(T.LT.0.D0) XL = XL + PI*BETA + ENDIF + RE=LOG(M1*M2)-(M1SQ-M2SQ)/QSQ*LOG(M2/M1)-2.D0+XL + IF(QSQ.GT.T2) THEN + XI=-PI*BETA + ELSE + XI=0.D0 + ENDIF + ENDIF + ENDIF + SSF0=RE*(1.D0,0.D0)-XI*(0.D0,1.D0) + RETURN + END diff --git a/ISAJET/isasusy/ssglbf.F b/ISAJET/isasusy/ssglbf.F new file mode 100644 index 00000000000..009bac1260b --- /dev/null +++ b/ISAJET/isasusy/ssglbf.F @@ -0,0 +1,1395 @@ +#include "isajet/pilot.h" + SUBROUTINE SSGLBF +C----------------------------------------------------------------------- +C +C This subroutine gives gluino branching fractions to gauginos +C according to Baer,Barger,Karatas,Tata (Phys.Rev.D36,96(1987) +C (Now includes gluino->gluon+zino1,2,3,4 loop decays. Jan 1990) +C Also includes contribution due to non-degenerate t1-t2 stops +C Also includes contribution due to non-degenerate b_L and b_R +C Updated to include mixed sbottom states b1 and b2: 10/9/96 +C +C Auxiliary functions are called SSGxyi, where normally x +C indicates the SUSY particle, y the SM particle(s), and i is +C a counter. +C +C Baer's GLUBF +C +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sslun.inc" +#include "isajet/ssmode.inc" +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" +#include "isajet/sstype.inc" +C + EXTERNAL SSGWQ1,SSGWQ2,SSGZG1,SSGZG2,SSGZG3,SSGZT + EXTERNAL SSGWT1,SSGWT2,SSGWT3,SSGWT4,SSGWT5,SSGWT6, + $SSGWT7,SSGWT8 + EXTERNAL SSGX1,SSGX2,SSGX3,SSGX4,SSGX5,SSGX6,SSGX7,SSGX8 + $,SSGX9 + REAL WIDU,WIDD,WIDI,WIDL,WIDR + REAL SSXINT,SSXLAM,XUPPER,XTCON,SUM,GMQK,C,G,FT,GP + $,UPPER,GS,FB,TANB,PI,SR2,UPPR,ALF3 + REAL MW1,MW2,SNW1,SNW2,XM,YM,THX,THY,COST,SINT,COSB,SINB + REAL MZIZ,AUIZ,ADIZ,BUIZ,BDIZ + REAL WID,SNIZ,FACT + REAL XT1,XT2,XT3,XT4,XT5,XT6,XT7,XT8,XT9,AL1,AL2,BE1,BE2 + REAL XLL,XRR,XL1R1,XL2R2,XL1R2,XL2R1,XL1L2,XR1R2,XLR1 + REAL XMST1,XMST2,XMST12,XLR2,XMSB1,XMSB2,XMSB12 + REAL BW1,BW2,GT1,GT2,GT1T2,GB1,GB2,GT1B1,GT1B2,GT2B1,GT2B2 + REAL KUL,KUR,KDL,KDR,KCL,KCR,KSL,KSR,KBL,KBR,KT1,KT2 + REAL XKUL,XKUR,XKDL,XKDR,XKSL,XKSR,XKCL,XKCR,XKBL,XKBR, + $XKT1,XKT2 + REAL XI1UL,XI1UR,XI1DL,XI1DR,XI1SL,XI1SR,XI1CL,XI1CR, + $XI1BL,XI1BR,XI1T1,XI1T2,XIT1,XIT2 + REAL ALT1,ART1,ALT2,ART2,ALB1,ARB1,ALB2,ARB2 + REAL BETA,ASMB,MBMB,MBQ,ASMT,MTMT,MTQ,SUALFS,AMPL + INTEGER IZ,ISZI(4),THIZ + COMPLEX ZONE,ZI,ZAT1(2),ZAT2(2),ZADW1,ZADW2,ZAUW1,ZAUW2 + COMPLEX ZAUIZ,ZADIZ,ZBUIZ,ZBDIZ,Z1(2),Z2(2) + DOUBLE PRECISION SSALFS,SSMQCD + SAVE ZONE,ZI + DATA ZONE,ZI/(1.,0.),(0.,1.)/ + +C +C Partly duplicated from SSMASS. +C + AMPL=2.4E18 + PI=4.*ATAN(1.) + SR2=SQRT(2.) + G=SQRT(4*PI*ALFAEM/SN2THW) + GP=G*SQRT(SN2THW/(1.-SN2THW)) + ALF3=SSALFS(DBLE(AMGLSS**2)) + GS=SQRT(4.*PI*ALF3) + TANB=1./RV2V1 + BETA=ATAN(TANB) + ASMB=SUALFS(AMBT**2,.36,AMTP,3) + MBMB=AMBT*(1.-4*ASMB/3./PI) + MBQ=SSMQCD(DBLE(MBMB),DBLE(AMGLSS)) + ASMT=SUALFS(AMTP**2,.36,AMTP,3) + MTMT=AMTP/(1.+4*ASMT/3./PI+(16.11-1.04*(5.-6.63/AMTP))* + $(ASMT/PI)**2) + MTQ=SSMQCD(DBLE(MTMT),DBLE(AMGLSS)) + FB=G*MBQ/SR2/AMW/COS(BETA) + FT=G*MTQ/SR2/AMW/SIN(BETA) + MW1=ABS(AMW1SS) + MW2=ABS(AMW2SS) + SNW1=SIGN(1.,AMW1SS) + SNW2=SIGN(1.,AMW2SS) + XM=1./TAN(GAMMAL) + YM=1./TAN(GAMMAR) + THX=SIGN(1.,XM) + THY=SIGN(1.,YM) + COST=COS(THETAT) + SINT=SIN(THETAT) + COSB=COS(THETAB) + SINB=SIN(THETAB) +C + ZADW1=ZI*G*SNW1*SIN(GAMMAR) + ZAUW1=ZI*G*SIN(GAMMAL) + ZADW2=ZI*G*SNW2*COS(GAMMAR)*THY + ZAUW2=ZI*G*COS(GAMMAL)*THX + BW1=-FT*SNW1*COS(GAMMAR) + BW2=FT*SNW2*SIN(GAMMAR)*THY + ZAT1(1)=ZADW1*COST+ZI*BW1*SINT + ZAT2(1)=ZADW1*SINT-ZI*BW1*COST + ZAT1(2)=ZADW2*COST+ZI*BW2*SINT + ZAT2(2)=ZADW2*SINT-ZI*BW2*COST + C=SSALFS(DBLE(AMGLSS**2))*AMGLSS/8./PI**2 +C +C gluino --> w1 + qk + qb +C +C Now includes sbottom as well as stop mixing/Yukawa effects +C as of 3/31/97, thanks to M. Drees + TMP(1)=MW1 + UPPR=(AMGLSS**2-MW1**2)/2./AMGLSS + IF (AMGLSS.GT.(MW1+AMUP+AMDN)) THEN + IF (AMGLSS.LT.AMULSS.AND.AMGLSS.LT.AMDLSS) THEN + TMP(2)=AMULSS + WIDU=ZADW1*CONJG(ZADW1)*SSXINT(0.,SSGWQ1,UPPR) + TMP(2)=AMDLSS + WIDD=ZAUW1*CONJG(ZAUW1)*SSXINT(0.,SSGWQ1,UPPR) + WIDI=2*REAL(ZAUW1*ZADW1)*SSXINT(0.,SSGWQ2,UPPR) + WID=GS**2/2./AMGLSS/(2*PI)**5*(WIDU+WIDD+WIDI) + ELSE IF (AMGLSS.LT.AMULSS.AND.AMGLSS.GE.AMDLSS) THEN + TMP(2)=AMULSS + WIDU=ZADW1*CONJG(ZADW1)*SSXINT(0.,SSGWQ1,UPPR) + WID=GS**2/2./AMGLSS/(2*PI)**5*WIDU + ELSE IF (AMGLSS.LT.AMDLSS.AND.AMGLSS.GE.AMULSS) THEN + TMP(2)=AMDLSS + WIDD=ZAUW1*CONJG(ZAUW1)*SSXINT(0.,SSGWQ1,UPPR) + WID=GS**2/2./AMGLSS/(2*PI)**5*WIDD + ELSE + WID=0. + END IF + CALL SSSAVE(ISGL,WID,+ISW1,+IDDN,-IDUP,0,0) + CALL SSSAVE(ISGL,WID,-ISW1,+IDUP,-IDDN,0,0) + Z1(1)=1. + Z1(2)=-Z1(1) + Z2(1)=G*SIN(GAMMAL) + Z2(2)=Z2(1) + CALL SSME3(2,AMDLSS,Z1,Z2) + Z1(1)=G*SIN(GAMMAR) + Z1(2)=-Z1(1) + Z2(1)=1. + Z2(2)=Z2(1) + CALL SSME3(3,AMULSS,Z1,Z2) + END IF +C + IF (AMGLSS.GT.(MW1+AMST+AMCH)) THEN + IF (AMGLSS.LT.AMCLSS.AND.AMGLSS.LT.AMSLSS) THEN + TMP(2)=AMCLSS + WIDU=ZADW1*CONJG(ZADW1)*SSXINT(0.,SSGWQ1,UPPR) + TMP(2)=AMSLSS + WIDD=ZAUW1*CONJG(ZAUW1)*SSXINT(0.,SSGWQ1,UPPR) + WIDI=2*REAL(ZAUW1*ZADW1)*SSXINT(0.,SSGWQ2,UPPR) + WID=GS**2/2./AMGLSS/(2*PI)**5*(WIDU+WIDD+WIDI) + ELSE IF (AMGLSS.LT.AMCLSS.AND.AMGLSS.GE.AMSLSS) THEN + TMP(2)=AMCLSS + WIDU=ZADW1*CONJG(ZADW1)*SSXINT(0.,SSGWQ1,UPPR) + WID=GS**2/2./AMGLSS/(2*PI)**5*WIDU + ELSE IF (AMGLSS.LT.AMSLSS.AND.AMGLSS.GE.AMCLSS) THEN + TMP(2)=AMSLSS + WIDD=ZAUW1*CONJG(ZAUW1)*SSXINT(0.,SSGWQ1,UPPR) + WID=GS**2/2./AMGLSS/(2*PI)**5*WIDD + ELSE + WID=0. + END IF + CALL SSSAVE(ISGL,WID,+ISW1,+IDST,-IDCH,0,0) + CALL SSSAVE(ISGL,WID,-ISW1,+IDCH,-IDST,0,0) + Z1(1)=1. + Z1(2)=-Z1(1) + Z2(1)=G*SIN(GAMMAL) + Z2(2)=Z2(1) + CALL SSME3(2,AMSLSS,Z1,Z2) + Z1(1)=G*SIN(GAMMAR) + Z1(2)=-Z1(1) + Z2(1)=1. + Z2(2)=Z2(1) + CALL SSME3(3,AMCLSS,Z1,Z2) + END IF +C + IF (AMGLSS.GT.(MW1+AMTP+AMBT)) THEN + ALT1=-G*SIN(GAMMAR)*COST+FT*COS(GAMMAR)*SINT + ART1=-FB*COS(GAMMAL)*COST + ALT2=-G*SIN(GAMMAR)*SINT-FT*COS(GAMMAR)*COST + ART2=-FB*COS(GAMMAL)*SINT + ALB1=-G*SIN(GAMMAL)*COSB+FB*COS(GAMMAL)*SINB + ARB1=-FT*COS(GAMMAR)*COSB + ALB2=-G*SIN(GAMMAL)*SINB-FB*COS(GAMMAL)*COSB + ARB2=-FT*COS(GAMMAR)*SINB + UPPER=(AMGLSS**2+AMTP**2-(MW1+AMBT)**2)/2./AMGLSS + FACT=GS**2*PI**2/(2*PI)**5/2./AMGLSS + TMP(1)=MW1 + TMP(2)=AMGLSS + TMP(3)=AMTP + IF (AMGLSS.LT.(AMTP+AMT1SS)) THEN + TMP(6)=AMT1SS + TMP(7)=AMT1SS + GT1=(ALT1**2+ART1**2)*(SSXINT(AMTP,SSGWT1,UPPER)+ + , SIN(2*THETAT)*SSXINT(AMTP,SSGWT8,UPPER)) + TMP(7)=AMT2SS + GT1T2=2*(ALT1*ALT2+ART1*ART2)*(SINT**2-COST**2)* + , SSXINT(AMTP,SSGWT8,UPPER) + ELSE + GT1=0. + GT1T2=0. + END IF + IF (AMGLSS.LT.(AMTP+AMT2SS)) THEN + TMP(6)=AMT2SS + TMP(7)=AMT2SS + GT2=(ALT2**2+ART2**2)*(SSXINT(AMTP,SSGWT1,UPPER)- + , SIN(2*THETAT)*SSXINT(AMTP,SSGWT8,UPPER)) + ELSE + GT2=0. + END IF + IF (AMGLSS.LT.(AMB1SS+AMBT)) THEN + TMP(4)=AMB1SS + TMP(8)=SNW1 +C Rewrite UPPR=(AMGLSS**2+AMBT**2-(AMTP+MW1)**2)/2./AMGLSS + UPPR=((AMGLSS-AMTP-MW1)*(AMGLSS+AMTP+MW1)+AMBT**2)/(2*AMGLSS) + GB1=(ALB1**2+ARB1**2)*SSXINT(AMBT,SSGWT2,UPPR)- + , ALB1*ARB1*SSXINT(AMBT,SSGWT3,UPPR) + ELSE + GB1=0. + END IF + IF (AMGLSS.LT.(AMB2SS+AMBT)) THEN + TMP(4)=AMB2SS + TMP(8)=SNW1 +C Rewrite UPPR=(AMGLSS**2+AMBT**2-(AMTP+MW1)**2)/2./AMGLSS + UPPR=((AMGLSS-AMTP-MW1)*(AMGLSS+AMTP+MW1)+AMBT**2)/(2*AMGLSS) + GB2=(ALB2**2+ARB2**2)*SSXINT(AMBT,SSGWT2,UPPR)- + , ALB2*ARB2*SSXINT(AMBT,SSGWT3,UPPR) + ELSE + GB2=0. + END IF + IF (AMGLSS.LT.(AMTP+AMT1SS).AND.AMGLSS.LT. + $ (AMB1SS+AMBT)) THEN + TMP(4)=AMB1SS + TMP(6)=AMT1SS + TMP(8)=SNW1 + GT1B1=(COST*SINB*ART1*ALB1+SINT*COSB*ALT1*ARB1)* + , SSXINT(AMTP,SSGWT6,UPPER)- + , (COST*COSB*ALT1*ALB1+SINT*SINB*ART1*ARB1)* + , SSXINT(AMTP,SSGWT4,UPPER)+ + , (COST*COSB*ALT1*ARB1+SINT*SINB*ART1*ALB1)* + , SSXINT(AMTP,SSGWT5,UPPER)- + , (COST*SINB*ART1*ARB1+SINT*COSB*ALT1*ALB1)* + , SSXINT(AMTP,SSGWT7,UPPER) + ELSE + GT1B1=0. + END IF + IF (AMGLSS.LT.(AMTP+AMT1SS).AND.AMGLSS.LT. + $ (AMB2SS+AMBT)) THEN + TMP(4)=AMB2SS + TMP(6)=AMT1SS + TMP(8)=SNW1 + GT1B2=(-COST*COSB*ART1*ALB2+SINT*SINB*ALT1*ARB2)* + , SSXINT(AMTP,SSGWT6,UPPER)- + , (COST*COSB*ALT1*ALB2-SINT*COSB*ART1*ARB2)* + , SSXINT(AMTP,SSGWT4,UPPER)+ + , (COST*SINB*ALT1*ARB2-SINT*COSB*ART1*ALB2)* + , SSXINT(AMTP,SSGWT5,UPPER)- + , (-COST*COSB*ART1*ARB2+SINT*SINB*ALT1*ALB2)* + , SSXINT(AMTP,SSGWT7,UPPER) + ELSE + GT1B2=0. + END IF + IF (AMGLSS.LT.(AMTP+AMT2SS).AND.AMGLSS.LT. + $ (AMB1SS+AMBT)) THEN + TMP(4)=AMB1SS + TMP(6)=AMT2SS + TMP(8)=SNW1 + GT2B1=(SINT*SINB*ART2*ALB1-COST*COSB*ALT2*ARB1)* + , SSXINT(AMTP,SSGWT6,UPPER)- + , (SINT*COSB*ALT2*ALB1-COST*SINB*ART2*ARB1)* + , SSXINT(AMTP,SSGWT4,UPPER)+ + , (SINT*COSB*ALT2*ARB1-COST*SINB*ART2*ALB1)* + , SSXINT(AMTP,SSGWT5,UPPER)- + , (SINT*SINB*ART2*ARB1-COST*COSB*ALT2*ALB1)* + , SSXINT(AMTP,SSGWT7,UPPER) + ELSE + GT2B1=0. + END IF + IF (AMGLSS.LT.(AMTP+AMT2SS).AND.AMGLSS.LT. + $ (AMB2SS+AMBT)) THEN + TMP(4)=AMB2SS + TMP(6)=AMT2SS + TMP(8)=SNW1 + GT2B2=(-SINT*COSB*ART2*ALB2-COST*SINB*ALT2*ARB2)* + , SSXINT(AMTP,SSGWT6,UPPER)- + , (SINT*SINB*ALT2*ALB2+COST*COSB*ART2*ARB2)* + , SSXINT(AMTP,SSGWT4,UPPER)+ + , (SINT*SINB*ALT2*ARB2+COST*COSB*ART2*ALB2)* + , SSXINT(AMTP,SSGWT5,UPPER)- + , (-SINT*COSB*ART2*ARB2-COST*SINB*ALT2*ALB2)* + , SSXINT(AMTP,SSGWT7,UPPER) + ELSE + GT2B2=0. + END IF + WID=GT1+GT2+GT1T2+GB1+GB2+GT1B1+GT1B2+GT2B1+GT2B2 + WID=FACT*WID + IF (WID.GT.0.) THEN + CALL SSSAVE(ISGL,WID,+ISW1,+IDBT,-IDTP,0,0) + Z1(1)=SINT-COST + Z1(2)=SINT+COST + Z2(1)=ALT1+SNW1*ART1 + Z2(2)=ALT1-SNW1*ART1 + CALL SSME3(2,AMT1SS,Z1,Z2) + Z1(1)=-COST-SINT + Z1(2)=-COST+SINT + Z2(1)=ALT2+SNW1*ART2 + Z2(2)=ALT2-SNW1*ART2 + CALL SSME3(2,AMT2SS,Z1,Z2) + Z1(1)=SNW1*ALB1+ARB1 + Z1(2)=-SNW1*ALB1+ARB1 + Z2(1)=-COSB+SINB + Z2(2)=-COSB-SINB + CALL SSME3(3,AMB1SS,Z1,Z2) + Z1(1)=SNW1*ALB2+ARB2 + Z1(2)=-SNW1*ALB2+ARB2 + Z2(1)=-SINB-COSB + Z2(2)=-SINB+COSB + CALL SSME3(3,AMB2SS,Z1,Z2) + CALL SSSAVE(ISGL,WID,-ISW1,+IDTP,-IDBT,0,0) + Z1(1)=SINB-COSB + Z1(2)=SINB+COSB + Z2(1)=ALB1+SNW1*ARB1 + Z2(2)=ALB1-SNW1*ARB1 + CALL SSME3(2,AMB1SS,Z1,Z2) + Z1(1)=-COSB-SINB + Z1(2)=-COSB+SINB + Z2(1)=ALB2+SNW1*ARB2 + Z2(2)=ALB2-SNW1*ARB2 + CALL SSME3(2,AMB2SS,Z1,Z2) + Z1(1)=SNW1*ALT1+ART1 + Z1(2)=-SNW1*ALT1+ART1 + Z2(1)=-COST+SINT + Z2(2)=-COST-SINT + CALL SSME3(3,AMT1SS,Z1,Z2) + Z1(1)=SNW1*ALT2+ART2 + Z1(2)=-SNW1*ALT2+ART2 + Z2(1)=-SINT-COST + Z2(2)=-SINT+COST + CALL SSME3(3,AMT2SS,Z1,Z2) + END IF + END IF +C +C gluino --> w2 + qk + qb +C + TMP(1)=MW2 + UPPR=(AMGLSS**2-MW2**2)/2./AMGLSS + IF (AMGLSS.GT.(MW2+AMUP+AMDN)) THEN + IF (AMGLSS.LT.AMULSS.AND.AMGLSS.LT.AMDLSS) THEN + TMP(2)=AMULSS + WIDU=ZADW2*CONJG(ZADW2)*SSXINT(0.,SSGWQ1,UPPR) + TMP(2)=AMDLSS + WIDD=ZAUW2*CONJG(ZAUW2)*SSXINT(0.,SSGWQ1,UPPR) + WIDI=2*REAL(ZAUW2*ZADW2)*SSXINT(0.,SSGWQ2,UPPR) + WID=GS**2/2./AMGLSS/(2*PI)**5*(WIDU+WIDD+WIDI) + ELSE IF (AMGLSS.LT.AMULSS.AND.AMGLSS.GE.AMDLSS) THEN + TMP(2)=AMULSS + WIDU=ZADW2*CONJG(ZADW2)*SSXINT(0.,SSGWQ1,UPPR) + WID=GS**2/2./AMGLSS/(2*PI)**5*WIDU + ELSE IF (AMGLSS.LT.AMDLSS.AND.AMGLSS.GE.AMULSS) THEN + TMP(2)=AMDLSS + WIDD=ZAUW2*CONJG(ZAUW2)*SSXINT(0.,SSGWQ1,UPPR) + WID=GS**2/2./AMGLSS/(2*PI)**5*WIDD + ELSE + WID=0. + END IF + CALL SSSAVE(ISGL,WID,+ISW2,+IDDN,-IDUP,0,0) + CALL SSSAVE(ISGL,WID,-ISW2,+IDUP,-IDDN,0,0) + Z1(1)=1. + Z1(2)=-Z1(1) + Z2(1)=G*THX*COS(GAMMAL) + Z2(2)=Z2(1) + CALL SSME3(2,AMDLSS,Z1,Z2) + Z1(1)=G*THY*COS(GAMMAR) + Z1(2)=-Z1(1) + Z2(1)=1. + Z2(2)=Z2(1) + CALL SSME3(3,AMULSS,Z1,Z2) + END IF +C + IF (AMGLSS.GT.(MW2+AMST+AMCH)) THEN + IF (AMGLSS.LT.AMCLSS.AND.AMGLSS.LT.AMSLSS) THEN + TMP(2)=AMCLSS + WIDU=ZADW2*CONJG(ZADW2)*SSXINT(0.,SSGWQ1,UPPR) + TMP(2)=AMSLSS + WIDD=ZAUW2*CONJG(ZAUW2)*SSXINT(0.,SSGWQ1,UPPR) + WIDI=2*REAL(ZAUW2*ZADW2)*SSXINT(0.,SSGWQ2,UPPR) + WID=GS**2/2./AMGLSS/(2*PI)**5*(WIDU+WIDD+WIDI) + ELSE IF (AMGLSS.LT.AMCLSS.AND.AMGLSS.GE.AMSLSS) THEN + TMP(2)=AMCLSS + WIDU=ZADW2*CONJG(ZADW2)*SSXINT(0.,SSGWQ1,UPPR) + WID=GS**2/2./AMGLSS/(2*PI)**5*WIDU + ELSE IF (AMGLSS.LT.AMSLSS.AND.AMGLSS.GE.AMCLSS) THEN + TMP(2)=AMSLSS + WIDD=ZAUW2*CONJG(ZAUW2)*SSXINT(0.,SSGWQ1,UPPR) + WID=GS**2/2./AMGLSS/(2*PI)**5*WIDD + ELSE + WID=0. + END IF + CALL SSSAVE(ISGL,WID,+ISW2,+IDST,-IDCH,0,0) + CALL SSSAVE(ISGL,WID,-ISW2,+IDCH,-IDST,0,0) + Z1(1)=1. + Z1(2)=-Z1(1) + Z2(1)=G*THX*COS(GAMMAL) + Z2(2)=Z2(1) + CALL SSME3(2,AMSLSS,Z1,Z2) + Z1(1)=G*THY*COS(GAMMAR) + Z1(2)=-Z1(1) + Z2(1)=1. + Z2(2)=Z2(1) + CALL SSME3(3,AMCLSS,Z1,Z2) + END IF +C + IF (AMGLSS.GT.(MW2+AMTP+AMBT)) THEN + ALT1=-G*THY*COS(GAMMAR)*COST-FT*THY*SIN(GAMMAR)*SINT + ART1=FB*THX*SIN(GAMMAL)*COST + ALT2=-G*THY*COS(GAMMAR)*SINT+FT*THY*SIN(GAMMAR)*COST + ART2=FB*THX*SIN(GAMMAL)*SINT + ALB1=-G*THX*COS(GAMMAL)*COSB-FB*THX*SIN(GAMMAL)*SINB + ARB1=FT*THY*SIN(GAMMAR)*COSB + ALB2=-G*THX*COS(GAMMAL)*SINB+FB*THX*SIN(GAMMAL)*COSB + ARB2=FT*THY*SIN(GAMMAR)*SINB + UPPER=(AMGLSS**2+AMTP**2-(MW2+AMBT)**2)/2./AMGLSS + FACT=GS**2*PI**2/(2*PI)**5/2./AMGLSS + TMP(1)=MW2 + TMP(2)=AMGLSS + TMP(3)=AMTP + IF (AMGLSS.LT.(AMTP+AMT1SS)) THEN + TMP(6)=AMT1SS + TMP(7)=AMT1SS + GT1=(ALT1**2+ART1**2)*(SSXINT(AMTP,SSGWT1,UPPER)+ + , SIN(2*THETAT)*SSXINT(AMTP,SSGWT8,UPPER)) + TMP(7)=AMT2SS + GT1T2=2*(ALT1*ALT2+ART1*ART2)*(SINT**2-COST**2)* + , SSXINT(AMTP,SSGWT8,UPPER) + ELSE + GT1=0. + GT1T2=0. + END IF + IF (AMGLSS.LT.(AMTP+AMT2SS)) THEN + TMP(6)=AMT2SS + TMP(7)=AMT2SS + GT2=(ALT2**2+ART2**2)*(SSXINT(AMTP,SSGWT1,UPPER)- + , SIN(2*THETAT)*SSXINT(AMTP,SSGWT8,UPPER)) + ELSE + GT2=0. + END IF + IF (AMGLSS.LT.(AMB1SS+AMBT)) THEN + TMP(4)=AMB1SS + TMP(8)=SNW2 +C Rewrite UPPR=(AMGLSS**2+AMBT**2-(AMTP+MW2)**2)/2./AMGLSS + UPPR=((AMGLSS-AMTP-MW2)*(AMGLSS+AMTP+MW2)+AMBT**2)/(2*AMGLSS) + GB1=(ALB1**2+ARB1**2)*SSXINT(AMBT,SSGWT2,UPPR)- + , ALB1*ARB1*SSXINT(AMBT,SSGWT3,UPPR) + ELSE + GB1=0. + END IF + IF (AMGLSS.LT.(AMB2SS+AMBT)) THEN + TMP(4)=AMB2SS + TMP(8)=SNW2 + UPPR=((AMGLSS-AMTP-MW2)*(AMGLSS+AMTP+MW2)+AMBT**2)/(2*AMGLSS) + GB2=(ALB2**2+ARB2**2)*SSXINT(AMBT,SSGWT2,UPPR)- + , ALB2*ARB2*SSXINT(AMBT,SSGWT3,UPPR) + ELSE + GB2=0. + END IF + IF (AMGLSS.LT.(AMTP+AMT1SS).AND.AMGLSS.LT. + $ (AMB1SS+AMBT)) THEN + TMP(4)=AMB1SS + TMP(6)=AMT1SS + TMP(8)=SNW2 + GT1B1=(COST*SINB*ART1*ALB1+SINT*COSB*ALT1*ARB1)* + , SSXINT(AMTP,SSGWT6,UPPER)- + , (COST*COSB*ALT1*ALB1+SINT*SINB*ART1*ARB1)* + , SSXINT(AMTP,SSGWT4,UPPER)+ + , (COST*COSB*ALT1*ARB1+SINT*SINB*ART1*ALB1)* + , SSXINT(AMTP,SSGWT5,UPPER)- + , (COST*SINB*ART1*ARB1+SINT*COSB*ALT1*ALB1)* + , SSXINT(AMTP,SSGWT7,UPPER) + ELSE + GT1B1=0. + END IF + IF (AMGLSS.LT.(AMTP+AMT1SS).AND.AMGLSS.LT. + $ (AMB2SS+AMBT)) THEN + TMP(4)=AMB2SS + TMP(6)=AMT1SS + TMP(8)=SNW2 + GT1B2=(-COST*COSB*ART1*ALB2+SINT*SINB*ALT1*ARB2)* + , SSXINT(AMTP,SSGWT6,UPPER)- + , (COST*COSB*ALT1*ALB2-SINT*COSB*ART1*ARB2)* + , SSXINT(AMTP,SSGWT4,UPPER)+ + , (COST*SINB*ALT1*ARB2-SINT*COSB*ART1*ALB2)* + , SSXINT(AMTP,SSGWT5,UPPER)- + , (-COST*COSB*ART1*ARB2+SINT*SINB*ALT1*ALB2)* + , SSXINT(AMTP,SSGWT7,UPPER) + ELSE + GT1B2=0. + END IF + IF (AMGLSS.LT.(AMTP+AMT2SS).AND.AMGLSS.LT. + $ (AMB1SS+AMBT)) THEN + TMP(4)=AMB1SS + TMP(6)=AMT2SS + TMP(8)=SNW2 + GT2B1=(SINT*SINB*ART2*ALB1-COST*COSB*ALT2*ARB1)* + , SSXINT(AMTP,SSGWT6,UPPER)- + , (SINT*COSB*ALT2*ALB1-COST*SINB*ART2*ARB1)* + , SSXINT(AMTP,SSGWT4,UPPER)+ + , (SINT*COSB*ALT2*ARB1-COST*SINB*ART2*ALB1)* + , SSXINT(AMTP,SSGWT5,UPPER)- + , (SINT*SINB*ART2*ARB1-COST*COSB*ALT2*ALB1)* + , SSXINT(AMTP,SSGWT7,UPPER) + ELSE + GT2B1=0. + END IF + IF (AMGLSS.LT.(AMTP+AMT2SS).AND.AMGLSS.LT. + $ (AMB2SS+AMBT)) THEN + TMP(4)=AMB2SS + TMP(6)=AMT2SS + TMP(8)=SNW2 + GT2B2=(-SINT*COSB*ART2*ALB2-COST*SINB*ALT2*ARB2)* + , SSXINT(AMTP,SSGWT6,UPPER)- + , (SINT*SINB*ALT2*ALB2+COST*COSB*ART2*ARB2)* + , SSXINT(AMTP,SSGWT4,UPPER)+ + , (SINT*SINB*ALT2*ARB2+COST*COSB*ART2*ALB2)* + , SSXINT(AMTP,SSGWT5,UPPER)- + , (-SINT*COSB*ART2*ARB2-COST*SINB*ALT2*ALB2)* + , SSXINT(AMTP,SSGWT7,UPPER) + ELSE + GT2B2=0. + END IF + WID=GT1+GT2+GT1T2+GB1+GB2+GT1B1+GT1B2+GT2B1+GT2B2 + WID=FACT*WID + IF (WID.GT.0.) THEN + CALL SSSAVE(ISGL,WID,+ISW2,+IDBT,-IDTP,0,0) + Z1(1)=SINT-COST + Z1(2)=SINT+COST + Z2(1)=ALT1+SNW2*ART1 + Z2(2)=ALT1-SNW2*ART1 + CALL SSME3(2,AMT1SS,Z1,Z2) + Z1(1)=-COST-SINT + Z1(2)=-COST+SINT + Z2(1)=ALT2+SNW2*ART2 + Z2(2)=ALT2-SNW2*ART2 + CALL SSME3(2,AMT2SS,Z1,Z2) + Z1(1)=SNW2*ALB1+ARB1 + Z1(2)=-SNW2*ALB1+ARB1 + Z2(1)=-COSB+SINB + Z2(2)=-COSB-SINB + CALL SSME3(3,AMB1SS,Z1,Z2) + Z1(1)=SNW2*ALB2+ARB2 + Z1(2)=-SNW2*ALB2+ARB2 + Z2(1)=-SINB-COSB + Z2(2)=-SINB+COSB + CALL SSME3(3,AMB2SS,Z1,Z2) + CALL SSSAVE(ISGL,WID,-ISW2,+IDTP,-IDBT,0,0) + Z1(1)=SINB-COSB + Z1(2)=SINB+COSB + Z2(1)=ALB1+SNW2*ARB1 + Z2(2)=ALB1-SNW2*ARB1 + CALL SSME3(2,AMB1SS,Z1,Z2) + Z1(1)=-COSB-SINB + Z1(2)=-COSB+SINB + Z2(1)=ALB2+SNW2*ARB2 + Z2(2)=ALB2-SNW2*ARB2 + CALL SSME3(2,AMB2SS,Z1,Z2) + Z1(1)=SNW2*ALT1+ART1 + Z1(2)=-SNW2*ALT1+ART1 + Z2(1)=-COST+SINT + Z2(2)=-COST-SINT + CALL SSME3(3,AMT1SS,Z1,Z2) + Z1(1)=SNW2*ALT2+ART2 + Z1(2)=-SNW2*ALT2+ART2 + Z2(1)=-SINT-COST + Z2(2)=-SINT+COST + CALL SSME3(3,AMT2SS,Z1,Z2) + END IF + END IF +C +C gluino --> zi decays, zi = z1, z2, z3, z4 +C the auiz etc, below are Atilde's etc. of PRD 42,1568 (1990) +C + ISZI(1)=ISZ1 + ISZI(2)=ISZ2 + ISZI(3)=ISZ3 + ISZI(4)=ISZ4 + DO 100 IZ=1,4 + MZIZ=ABS(AMZISS(IZ)) + AUIZ=G/SR2*ZMIXSS(3,IZ)+GP/3./SR2*ZMIXSS(4,IZ) + ADIZ=-G/SR2*ZMIXSS(3,IZ)+GP/3./SR2*ZMIXSS(4,IZ) + BUIZ=4*GP*ZMIXSS(4,IZ)/3./SR2 + BDIZ=-2*GP/3./SR2*ZMIXSS(4,IZ) + SNIZ=SIGN(1.,AMZISS(IZ)) + THIZ=0 + IF (AMZISS(IZ).LT.0.) THIZ=1 + ZAUIZ=ZI**(THIZ-1)*SNIZ + $ *(-G/SR2*ZMIXSS(3,IZ)-GP/3./SR2*ZMIXSS(4,IZ)) + ZBUIZ=ZI**(THIZ-1)*4*GP*ZMIXSS(4,IZ)/3./SR2 + ZADIZ=ZI**(THIZ-1)*SNIZ + $ *(G/SR2*ZMIXSS(3,IZ)-GP/3./SR2*ZMIXSS(4,IZ)) + ZBDIZ=-2*ZI**(THIZ-1)*GP*ZMIXSS(4,IZ)/3./SR2 +C Radiative gluino --> gluon + zi loop decay + IF (AMGLSS.GT.MZIZ) THEN + IF (AMGLSS.LT.(AMT1SS+AMTP)) THEN + TMP(1)=AMTP + TMP(2)=MZIZ + TMP(3)=AMT1SS + XIT1=SSXINT(0.,SSGZG1,1.) + XI1T1=SSXINT(0.,SSGZG2,1.) + XKT1=SSXINT(0.,SSGZG3,1.) + ELSE + XIT1=0. + XI1T1=0. + XKT1=0. + END IF + IF (AMGLSS.LT.(AMT2SS+AMTP)) THEN + TMP(1)=AMTP + TMP(2)=MZIZ + TMP(3)=AMT2SS + XIT2=SSXINT(0.,SSGZG1,1.) + XI1T2=SSXINT(0.,SSGZG2,1.) + XKT2=SSXINT(0.,SSGZG3,1.) + ELSE + XIT2=0. + XI1T2=0. + XKT2=0. + END IF +C !!! NEEDS UPDATE FOR SBOTTOM MIXING !!! + IF (AMGLSS.LT.(AMB1SS+AMBT)) THEN + TMP(1)=AMBT + TMP(2)=MZIZ + TMP(3)=AMB1SS + XI1BL=SSXINT(0.,SSGZG2,1.) + XKBL=SSXINT(0.,SSGZG3,1.) + ELSE + XI1BL=0. + XKBL=0. + END IF + IF (AMGLSS.LT.(AMB2SS+AMBT)) THEN + TMP(1)=AMBT + TMP(2)=MZIZ + TMP(3)=AMB2SS + XI1BR=SSXINT(0.,SSGZG2,1.) + XKBR=SSXINT(0.,SSGZG3,1.) + ELSE + XI1BR=0. + XKBR=0. + END IF + IF (AMGLSS.LT.(AMULSS+AMUP)) THEN + TMP(1)=AMUP + TMP(2)=MZIZ + TMP(3)=AMULSS + XI1UL=SSXINT(0.,SSGZG2,1.) + XKUL=SSXINT(0.,SSGZG3,1.) + ELSE + XI1UL=0. + XKUL=0. + END IF + IF (AMGLSS.LT.(AMURSS+AMUP)) THEN + TMP(1)=AMUP + TMP(2)=MZIZ + TMP(3)=AMURSS + XI1UR=SSXINT(0.,SSGZG2,1.) + XKUR=SSXINT(0.,SSGZG3,1.) + ELSE + XI1UR=0. + XKUR=0. + END IF + IF (AMGLSS.LT.(AMDLSS+AMDN)) THEN + TMP(1)=AMDN + TMP(2)=MZIZ + TMP(3)=AMDLSS + XI1DL=SSXINT(0.,SSGZG2,1.) + XKDL=SSXINT(0.,SSGZG3,1.) + ELSE + XI1DL=0. + XKDL=0. + END IF + IF (AMGLSS.LT.(AMDRSS+AMDN)) THEN + TMP(1)=AMDN + TMP(2)=MZIZ + TMP(3)=AMDRSS + XI1DR=SSXINT(0.,SSGZG2,1.) + XKDR=SSXINT(0.,SSGZG3,1.) + ELSE + XI1DR=0. + XKDR=0. + END IF + IF (AMGLSS.LT.(AMSLSS+AMST)) THEN + TMP(1)=AMST + TMP(2)=MZIZ + TMP(3)=AMSLSS + XI1SL=SSXINT(0.,SSGZG2,1.) + XKSL=SSXINT(0.,SSGZG3,1.) + ELSE + XI1SL=0. + XKSL=0. + END IF + IF (AMGLSS.LT.(AMSRSS+AMST)) THEN + TMP(1)=AMST + TMP(2)=MZIZ + TMP(3)=AMSRSS + XI1SR=SSXINT(0.,SSGZG2,1.) + XKSR=SSXINT(0.,SSGZG3,1.) + ELSE + XI1SR=0. + XKSR=0. + END IF + IF (AMGLSS.LT.(AMCLSS+AMCH)) THEN + TMP(1)=AMCH + TMP(2)=MZIZ + TMP(3)=AMCLSS + XI1CL=SSXINT(0.,SSGZG2,1.) + XKCL=SSXINT(0.,SSGZG3,1.) + ELSE + XI1CL=0. + XKCL=0. + END IF + IF (AMGLSS.LT.(AMCRSS+AMCH)) THEN + TMP(1)=AMCH + TMP(2)=MZIZ + TMP(3)=AMCRSS + XI1CR=SSXINT(0.,SSGZG2,1.) + XKCR=SSXINT(0.,SSGZG3,1.) + ELSE + XI1CR=0. + XKCR=0. + END IF + KUL=AUIZ*(XKUL*(MZIZ-SNIZ*AMGLSS)+MZIZ*XI1UL) + KUR=-BUIZ*(XKUR*(MZIZ-SNIZ*AMGLSS)+MZIZ*XI1UR) + KDL=ADIZ*(XKDL*(MZIZ-SNIZ*AMGLSS)+MZIZ*XI1DL) + KDR=-BDIZ*(XKDR*(MZIZ-SNIZ*AMGLSS)+MZIZ*XI1DR) + KCL=AUIZ*(XKCL*(MZIZ-SNIZ*AMGLSS)+MZIZ*XI1CL) + KCR=-BUIZ*(XKCR*(MZIZ-SNIZ*AMGLSS)+MZIZ*XI1CR) + KSL=ADIZ*(XKSL*(MZIZ-SNIZ*AMGLSS)+MZIZ*XI1SL) + KSR=-BDIZ*(XKSR*(MZIZ-SNIZ*AMGLSS)+MZIZ*XI1SR) + KBL=ADIZ*(XKBL*(MZIZ-SNIZ*AMGLSS)+MZIZ*XI1BL) + KBR=-BDIZ*(XKBR*(MZIZ-SNIZ*AMGLSS)+MZIZ*XI1BR) + KT1=(MZIZ*(XKT1+XI1T1)*(AUIZ*COST-FT*ZMIXSS(1,IZ)*SINT) + $ -SNIZ*AMGLSS*XKT1*(AUIZ*COST-FT*ZMIXSS(1,IZ)*SINT)+ + $ SNIZ*AMTP*XIT1*(BUIZ*SINT+FT*ZMIXSS(1,IZ)*COST))*COST+ + $ (MZIZ*(XKT1+XI1T1)*(-BUIZ*SINT-FT*ZMIXSS(1,IZ)*COST) + $ -SNIZ*AMGLSS*XKT1*(-BUIZ*SINT-FT*ZMIXSS(1,IZ)*COST)- + $ SNIZ*AMTP*XIT1*(AUIZ*COST-FT*ZMIXSS(1,IZ)*SINT))*SINT + KT2=(MZIZ*(XKT2+XI1T2)*(AUIZ*SINT+FT*ZMIXSS(1,IZ)*COST) + $ -SNIZ*AMGLSS*XKT2*(AUIZ*SINT+FT*ZMIXSS(1,IZ)*COST)+ + $ SNIZ*AMTP*XIT2*(-BUIZ*COST+FT*ZMIXSS(1,IZ)*SINT))*SINT+ + $ (-MZIZ*(XKT2+XI1T2)*(BUIZ*COST-FT*ZMIXSS(1,IZ)*SINT) + $ +SNIZ*AMGLSS*XKT2*(BUIZ*COST-FT*ZMIXSS(1,IZ)*SINT)+ + $ SNIZ*AMTP*XIT2*(AUIZ*SINT+FT*ZMIXSS(1,IZ)*COST))*COST + SUM=(KUL+KUR+KDL+KDR+KSL+KSR+KCL+KCR+KBL+KBR+KT1+ + $ KT2)**2/AMGLSS**2 + WID=ALF3**2*AMGLSS*(1.-MZIZ**2/AMGLSS**2)/256./PI**3*SUM + CALL SSSAVE(ISGL,WID,ISZI(IZ),IDGL,0,0,0) + END IF +C 3 body gluino --> q + qb + zi decay, q=u,d + UPPR=(AMGLSS**2-MZIZ**2)/2./AMGLSS + IF (AMGLSS.GT.(MZIZ+2*AMUP)) THEN + IF (AMGLSS.LT.AMULSS.AND.AMGLSS.LT.AMURSS) THEN + TMP(1)=MZIZ + TMP(2)=AMULSS + WIDL=2*AUIZ**2*(SSXINT(0.,SSGWQ1,UPPR)-SNIZ* + $ SSXINT(0.,SSGWQ2,UPPR)) + TMP(2)=AMURSS + WIDR=2*BUIZ**2*(SSXINT(0.,SSGWQ1,UPPR)-SNIZ* + $ SSXINT(0.,SSGWQ2,UPPR)) + WID=WIDL+WIDR + ELSE IF (AMGLSS.LT.AMULSS.AND.AMGLSS.GE.AMURSS) THEN + TMP(2)=AMULSS + WID=2*AUIZ**2*(SSXINT(0.,SSGWQ1,UPPR)-SNIZ* + $ SSXINT(0.,SSGWQ2,UPPR)) + ELSE IF (AMGLSS.LT.AMURSS.AND.AMGLSS.GE.AMULSS) THEN + TMP(2)=AMURSS + WID=2*BUIZ**2*(SSXINT(0.,SSGWQ1,UPPR)-SNIZ* + $ SSXINT(0.,SSGWQ2,UPPR)) + ELSE + WID=0. + END IF + WID=GS**2/AMGLSS/2./(2*PI)**5*WID + IF (WID.GT.0.) THEN + CALL SSSAVE(ISGL,WID,ISZI(IZ),IDUP,-IDUP,0,0) +C Enter decay matrix element info + Z1(1)=1. + Z1(2)=-Z1(1) + Z2(1)=-CONJG(ZI**(THIZ-1)*(-1.)*(THIZ+1)*AUIZ) + Z2(2)=Z2(1) + CALL SSME3(2,AMULSS,Z1,Z2) + Z1(1)=1. + Z1(2)=Z1(1) + Z2(1)=-CONJG(ZI**(THIZ-1)*BUIZ) + Z2(2)=-Z2(1) + CALL SSME3(2,AMURSS,Z1,Z2) + Z1(1)=ZI**(THIZ-1)*(-1.)*(THIZ+1)*AUIZ + Z1(2)=-Z1(1) + Z2(1)=1. + Z2(2)=Z2(1) + CALL SSME3(3,AMULSS,Z1,Z2) + Z1(1)=ZI**(THIZ-1)*BUIZ + Z1(2)=Z1(1) + Z2(1)=1. + Z2(2)=-Z2(1) + CALL SSME3(3,AMURSS,Z1,Z2) + END IF + END IF +C + IF (AMGLSS.GT.(MZIZ+2*AMDN)) THEN + IF (AMGLSS.LT.AMDLSS.AND.AMGLSS.LT.AMDRSS) THEN + TMP(1)=MZIZ + TMP(2)=AMDLSS + WIDL=2*ADIZ**2*(SSXINT(0.,SSGWQ1,UPPR)-SNIZ* + $ SSXINT(0.,SSGWQ2,UPPR)) + TMP(2)=AMDRSS + WIDR=2*BDIZ**2*(SSXINT(0.,SSGWQ1,UPPR)-SNIZ* + $ SSXINT(0.,SSGWQ2,UPPR)) + WID=WIDL+WIDR + ELSE IF (AMGLSS.LT.AMDLSS.AND.AMGLSS.GE.AMDRSS) THEN + TMP(2)=AMDLSS + WID=2*ADIZ**2*(SSXINT(0.,SSGWQ1,UPPR)-SNIZ* + $ SSXINT(0.,SSGWQ2,UPPR)) + ELSE IF (AMGLSS.LT.AMDRSS.AND.AMGLSS.GE.AMDLSS) THEN + TMP(2)=AMDRSS + WID=2*BDIZ**2*(SSXINT(0.,SSGWQ1,UPPR)-SNIZ* + $ SSXINT(0.,SSGWQ2,UPPR)) + ELSE + WID=0. + END IF + WID=GS**2/AMGLSS/2./(2*PI)**5*WID + IF (WID.GT.0.) THEN + CALL SSSAVE(ISGL,WID,ISZI(IZ),IDDN,-IDDN,0,0) +C Enter decay matrix element info + Z1(1)=1. + Z1(2)=-Z1(1) + Z2(1)=-CONJG(ZI**(THIZ-1)*(-1.)*(THIZ+1)*ADIZ) + Z2(2)=Z2(1) + CALL SSME3(2,AMDLSS,Z1,Z2) + Z1(1)=1. + Z1(2)=Z1(1) + Z2(1)=-CONJG(ZI**(THIZ-1)*BDIZ) + Z2(2)=-Z2(1) + CALL SSME3(2,AMDRSS,Z1,Z2) + Z1(1)=ZI**(THIZ-1)*(-1.)*(THIZ+1)*ADIZ + Z1(2)=-Z1(1) + Z2(1)=1. + Z2(2)=Z2(1) + CALL SSME3(3,AMDLSS,Z1,Z2) + Z1(1)=ZI**(THIZ-1)*BDIZ + Z1(2)=Z1(1) + Z2(1)=1. + Z2(2)=-Z2(1) + CALL SSME3(3,AMDRSS,Z1,Z2) + END IF + END IF +C 3 body gluino --> q + qb + zi decay, q=s + IF (AMGLSS.GT.(MZIZ+2*AMST)) THEN + IF (AMGLSS.LT.AMSLSS.AND.AMGLSS.LT.AMSRSS) THEN + TMP(1)=MZIZ + TMP(2)=AMSLSS + WIDL=2*ADIZ**2*(SSXINT(0.,SSGWQ1,UPPR)-SNIZ* + $ SSXINT(0.,SSGWQ2,UPPR)) + TMP(2)=AMSRSS + WIDR=2*BDIZ**2*(SSXINT(0.,SSGWQ1,UPPR)-SNIZ* + $ SSXINT(0.,SSGWQ2,UPPR)) + WID=WIDL+WIDR + ELSE IF (AMGLSS.LT.AMSLSS.AND.AMGLSS.GE.AMSRSS) THEN + TMP(2)=AMSLSS + WID=2*ADIZ**2*(SSXINT(0.,SSGWQ1,UPPR)-SNIZ* + $ SSXINT(0.,SSGWQ2,UPPR)) + ELSE IF (AMGLSS.LT.AMSRSS.AND.AMGLSS.GE.AMSLSS) THEN + TMP(2)=AMSRSS + WID=2*BDIZ**2*(SSXINT(0.,SSGWQ1,UPPR)-SNIZ* + $ SSXINT(0.,SSGWQ2,UPPR)) + ELSE + WID=0. + END IF + WID=GS**2/AMGLSS/2./(2*PI)**5*WID + IF (WID.GT.0.) THEN + CALL SSSAVE(ISGL,WID,ISZI(IZ),IDST,-IDST,0,0) +C Enter decay matrix element info + Z1(1)=1. + Z1(2)=-Z1(1) + Z2(1)=-CONJG(ZI**(THIZ-1)*(-1.)*(THIZ+1)*ADIZ) + Z2(2)=Z2(1) + CALL SSME3(2,AMDLSS,Z1,Z2) + Z1(1)=1. + Z1(2)=Z1(1) + Z2(1)=-CONJG(ZI**(THIZ-1)*BDIZ) + Z2(2)=-Z2(1) + CALL SSME3(2,AMDRSS,Z1,Z2) + Z1(1)=ZI**(THIZ-1)*(-1.)*(THIZ+1)*ADIZ + Z1(2)=-Z1(1) + Z2(1)=1. + Z2(2)=Z2(1) + CALL SSME3(3,AMDLSS,Z1,Z2) + Z1(1)=ZI**(THIZ-1)*BDIZ + Z1(2)=Z1(1) + Z2(1)=1. + Z2(2)=-Z2(1) + CALL SSME3(3,AMDRSS,Z1,Z2) + END IF + END IF +C 3 body gluino --> q + qb + zi decay, q=c + IF (AMGLSS.GT.(MZIZ+2*AMCH)) THEN + IF (AMGLSS.LT.AMCLSS.AND.AMGLSS.LT.AMCRSS) THEN + TMP(1)=MZIZ + TMP(2)=AMCLSS + WIDL=2*AUIZ**2*(SSXINT(0.,SSGWQ1,UPPR)-SNIZ* + $ SSXINT(0.,SSGWQ2,UPPR)) + TMP(2)=AMCRSS + WIDR=2*BUIZ**2*(SSXINT(0.,SSGWQ1,UPPR)-SNIZ* + $ SSXINT(0.,SSGWQ2,UPPR)) + WID=WIDL+WIDR + ELSE IF (AMGLSS.LT.AMCLSS.AND.AMGLSS.GE.AMCRSS) THEN + TMP(2)=AMCLSS + WID=2*AUIZ**2*(SSXINT(0.,SSGWQ1,UPPR)-SNIZ* + $ SSXINT(0.,SSGWQ2,UPPR)) + ELSE IF (AMGLSS.LT.AMCRSS.AND.AMGLSS.GE.AMCLSS) THEN + TMP(2)=AMCRSS + WID=2*BUIZ**2*(SSXINT(0.,SSGWQ1,UPPR)-SNIZ* + $ SSXINT(0.,SSGWQ2,UPPR)) + ELSE + WID=0. + END IF + WID=GS**2/AMGLSS/2./(2*PI)**5*WID + IF (WID.GT.0.) THEN + CALL SSSAVE(ISGL,WID,ISZI(IZ),IDCH,-IDCH,0,0) +C Enter decay matrix element info + Z1(1)=1. + Z1(2)=-Z1(1) + Z2(1)=-CONJG(ZI**(THIZ-1)*(-1.)*(THIZ+1)*AUIZ) + Z2(2)=Z2(1) + CALL SSME3(2,AMULSS,Z1,Z2) + Z1(1)=1. + Z1(2)=Z1(1) + Z2(1)=-CONJG(ZI**(THIZ-1)*BUIZ) + Z2(2)=-Z2(1) + CALL SSME3(2,AMURSS,Z1,Z2) + Z1(1)=ZI**(THIZ-1)*(-1.)*(THIZ+1)*AUIZ + Z1(2)=-Z1(1) + Z2(1)=1. + Z2(2)=Z2(1) + CALL SSME3(3,AMULSS,Z1,Z2) + Z1(1)=ZI**(THIZ-1)*BUIZ + Z1(2)=Z1(1) + Z2(1)=1. + Z2(2)=-Z2(1) + CALL SSME3(3,AMURSS,Z1,Z2) + END IF + END IF +C 3 body gluino --> q + qb + zi decay, q=b + XTCON=ALF3/8./PI**4/AMGLSS + IF (AMGLSS.GT.(MZIZ+2*AMBT).AND.AMGLSS.LT. + $ (AMB1SS+AMBT)) THEN + TMP(1)=AMGLSS + TMP(2)=AMBT + TMP(3)=MZIZ + TMP(4)=AMB1SS + TMP(5)=AMB1SS + XUPPER=(AMGLSS**2+AMBT**2-(AMBT+MZIZ)**2)/2./AMGLSS + XT1=SSXINT(AMBT,SSGX1,XUPPER) + XT2=SSXINT(AMBT,SSGX2,XUPPER) + XT3=SSXINT(AMBT,SSGX3,XUPPER) + XT4=SSXINT(AMBT,SSGX4,XUPPER) + XT5=SSXINT(AMBT,SSGX5,XUPPER) + XT6=SSXINT(AMBT,SSGX6,XUPPER) + XT7=SSXINT(AMBT,SSGX7,XUPPER) + XT8=SSXINT(AMBT,SSGX8,XUPPER) + XT9=SSXINT(AMBT,SSGX9,XUPPER) + AL1=ADIZ*COSB-FB*ZMIXSS(2,IZ)*SINB + BE1=FB*ZMIXSS(2,IZ)*COSB+BDIZ*SINB +C ---- here, al2 is (-) al2 of tata notes----- + AL2=BDIZ*SINB+FB*ZMIXSS(2,IZ)*COSB + BE2=-FB*ZMIXSS(2,IZ)*SINB+ADIZ*COSB + XLL=(AL1**2+BE1**2)*XT1-4*AMBT*MZIZ*SNIZ*AL1* + $ BE1*XT3-AMGLSS*(SNIZ*MZIZ*(AL1**2*XT2/AMGLSS/ + $ MZIZ+BE1**2*AMBT**2*XT5)-AL1*BE1*AMBT*(XT4- + $ MZIZ**2*XT5)) + XRR=(AL2**2+BE2**2)*XT1-4*AMBT*MZIZ*SNIZ*AL2* + $ BE2*XT3-AMGLSS*(SNIZ*MZIZ*(AL2**2*XT2/AMGLSS/ + $ MZIZ+BE2**2*AMBT**2*XT5)-AL2*BE2*AMBT*(XT4- + $ MZIZ**2*XT5)) + XL1R1=-2*AMGLSS*AMBT*((AL1*AL2+BE1*BE2)*SNIZ*AMBT* + $ MZIZ*XT6-(AL2*BE1+AL1*BE2)*XT7) + XL2R2=XL1R1 + XL1R2=BE1*BE2*XT8+AL1*AL2*AMBT**2*XT4-AMBT*MZIZ* + $ SNIZ*(AL1*BE2+AL2*BE1)*XT9 + XL2R1=XL1R2 + XMSB1=COSB**2*XLL+SINB**2*XRR-SINB*COSB*(XL1R1+XL1R2+ + $ XL2R1+XL2R2) + ELSE + XMSB1=0. + END IF + IF (AMGLSS.GT.(MZIZ+2*AMBT).AND.AMGLSS.LT. + $ (AMB2SS+AMBT)) THEN + TMP(1)=AMGLSS + TMP(2)=AMBT + TMP(3)=MZIZ + TMP(4)=AMB2SS + TMP(5)=AMB2SS + XUPPER=(AMGLSS**2+AMBT**2-(AMBT+MZIZ)**2)/2./AMGLSS + XT1=SSXINT(AMBT,SSGX1,XUPPER) + XT2=SSXINT(AMBT,SSGX2,XUPPER) + XT3=SSXINT(AMBT,SSGX3,XUPPER) + XT4=SSXINT(AMBT,SSGX4,XUPPER) + XT5=SSXINT(AMBT,SSGX5,XUPPER) + XT6=SSXINT(AMBT,SSGX6,XUPPER) + XT7=SSXINT(AMBT,SSGX7,XUPPER) + XT8=SSXINT(AMBT,SSGX8,XUPPER) + XT9=SSXINT(AMBT,SSGX9,XUPPER) + AL1=ADIZ*SINB+FB*ZMIXSS(2,IZ)*COSB + BE1=FB*ZMIXSS(2,IZ)*SINB-BDIZ*COSB +C ---- here, al2 is (-) al2 of tata notes----- + AL2=-BDIZ*COSB+FB*ZMIXSS(2,IZ)*SINB + BE2=FB*ZMIXSS(2,IZ)*COSB+ADIZ*SINB + XLL=(AL1**2+BE1**2)*XT1-4*AMBT*MZIZ*SNIZ*AL1* + $ BE1*XT3-AMGLSS*(SNIZ*MZIZ*(AL1**2*XT2/AMGLSS/ + $ MZIZ+BE1**2*AMBT**2*XT5)-AL1*BE1*AMBT*(XT4- + $ MZIZ**2*XT5)) + XRR=(AL2**2+BE2**2)*XT1-4*AMBT*MZIZ*SNIZ*AL2* + $ BE2*XT3-AMGLSS*(SNIZ*MZIZ*(AL2**2*XT2/AMGLSS/ + $ MZIZ+BE2**2*AMBT**2*XT5)-AL2*BE2*AMBT*(XT4- + $ MZIZ**2*XT5)) + XL1R1=-2*AMGLSS*AMBT*((AL1*AL2+BE1*BE2)*SNIZ*AMBT* + $ MZIZ*XT6-(AL2*BE1+AL1*BE2)*XT7) + XL2R2=XL1R1 + XL1R2=BE1*BE2*XT8+AL1*AL2*AMBT**2*XT4-AMBT*MZIZ* + $ SNIZ*(AL1*BE2+AL2*BE1)*XT9 + XL2R1=XL1R2 + XMSB2=SINB**2*XLL+COSB**2*XRR+SINB*COSB*(XL1R1+XL1R2+ + $ XL2R1+XL2R2) + ELSE + XMSB2=0. + END IF +C ----cross term between b_1 and b_2 graphs ----------- + IF (AMGLSS.GT.(MZIZ+2*AMBT).AND.AMGLSS.LT. + $ (AMB1SS+AMBT)) THEN + TMP(1)=AMGLSS + TMP(2)=AMBT + TMP(3)=MZIZ + TMP(4)=AMB1SS + TMP(5)=AMB2SS + XUPPER=(AMGLSS**2+AMBT**2-(AMBT+MZIZ)**2)/2./AMGLSS + XT1=SSXINT(AMBT,SSGX1,XUPPER) + XT2=SSXINT(AMBT,SSGX2,XUPPER) + XT3=SSXINT(AMBT,SSGX3,XUPPER) + XT4=SSXINT(AMBT,SSGX4,XUPPER) + XT5=SSXINT(AMBT,SSGX5,XUPPER) + XT6=SSXINT(AMBT,SSGX6,XUPPER) + XT7=SSXINT(AMBT,SSGX7,XUPPER) + XT8=SSXINT(AMBT,SSGX8,XUPPER) + XT9=SSXINT(AMBT,SSGX9,XUPPER) + AL1=ADIZ*COSB-FB*ZMIXSS(2,IZ)*SINB + AL2=ADIZ*SINB+FB*ZMIXSS(2,IZ)*COSB + BE1=FB*ZMIXSS(2,IZ)*COSB+BDIZ*SINB + BE2=FB*ZMIXSS(2,IZ)*SINB-BDIZ*COSB + XL1L2=COSB*SINB*(2*(AL1*AL2+BE1*BE2)*XT1-4*SNIZ*AMBT* + $ MZIZ*(AL1*BE2+AL2*BE1)*XT3-AMGLSS*(2*MZIZ* + $ SNIZ*(AL1*AL2*XT2/AMGLSS/MZIZ+BE1*BE2*AMBT**2* + $ XT5)-(AL1*BE2+AL2*BE1)*AMBT*(XT4-MZIZ**2*XT5))) + AL1=-BDIZ*SINB-FB*ZMIXSS(2,IZ)*COSB + AL2=BDIZ*COSB-FB*ZMIXSS(2,IZ)*SINB + BE1=-FB*ZMIXSS(2,IZ)*SINB+ADIZ*COSB + BE2=FB*ZMIXSS(2,IZ)*COSB+ADIZ*SINB + XR1R2=-COSB*SINB*(2*(AL1*AL2+BE1*BE2)*XT1+4*SNIZ*AMBT* + $ MZIZ*(AL1*BE2+AL2*BE1)*XT3-AMGLSS*(2*MZIZ* + $ SNIZ*(AL1*AL2*XT2/AMGLSS/MZIZ+BE1*BE2*AMBT**2* + $ XT5)+(AL1*BE2+AL2*BE1)*AMBT*(XT4-MZIZ**2*XT5))) + AL1=ADIZ*COSB-FB*ZMIXSS(2,IZ)*SINB + AL2=BDIZ*COSB-FB*ZMIXSS(2,IZ)*SINB + BE1=FB*ZMIXSS(2,IZ)*COSB+BDIZ*SINB + BE2=FB*ZMIXSS(2,IZ)*COSB+ADIZ*SINB + XL1R1=2*AMGLSS*AMBT*COSB**2*(SNIZ*(AL1*AL2-BE1*BE2)* + $ AMBT*MZIZ*XT6-(AL2*BE1-AL1*BE2)*XT7) + XL1R2=COSB**2*(BE1*BE2*XT8-AL1*AL2*AMBT**2*XT4+AMBT* + $ MZIZ*SNIZ*XT9*(-AL1*BE2+BE1*AL2)) + XLR1=2*(XL1R1+XL1R2) + AL1=ADIZ*SINB+FB*ZMIXSS(2,IZ)*COSB + AL2=-BDIZ*SINB-FB*ZMIXSS(2,IZ)*COSB + BE1=FB*ZMIXSS(2,IZ)*SINB-BDIZ*COSB + BE2=-FB*ZMIXSS(2,IZ)*SINB+ADIZ*COSB + TMP(4)=AMB2SS + TMP(5)=AMB1SS + XT8=SSXINT(AMBT,SSGX8,XUPPER) + XT9=SSXINT(AMBT,SSGX9,XUPPER) + XL1R1=2*AMGLSS*AMBT*SINB**2*(SNIZ*(-AL1*AL2+BE1*BE2)* + $ AMBT*MZIZ*XT6+(AL2*BE1-AL1*BE2)*XT7) + XL1R2=-SINB**2*(BE1*BE2*XT8-AL1*AL2*AMBT**2*XT4+AMBT* + $ MZIZ*SNIZ*XT9*(-AL1*BE2+BE1*AL2)) + XLR2=2*(XL1R1+XL1R2) + XMSB12=XL1L2+XR1R2+XLR1+XLR2 + ELSE + XMSB12=0. + END IF + WID=XTCON*(XMSB1+XMSB2+XMSB12) + IF (WID.GT.0.) THEN + CALL SSSAVE(ISGL,WID,ISZI(IZ),IDBT,-IDBT,0,0) + Z1(1)=((ZI*ZADIZ-FB*ZMIXSS(2,IZ)*ZI**THIZ)*COSB- + $ (ZI*ZBDIZ-FB*ZMIXSS(2,IZ)*(-ZI)**THIZ)*SINB)/2. + Z1(2)=((-ZI*ZADIZ-FB*ZMIXSS(2,IZ)*ZI**THIZ)*COSB- + $ (ZI*ZBDIZ+FB*ZMIXSS(2,IZ)*(-ZI)**THIZ)*SINB)/2. + Z2(1)=(COSB-SINB)/2. + Z2(2)=-(COSB+SINB)/2. + CALL SSME3(3,AMB1SS,Z1,Z2) + Z1(1)=(COSB-SINB)/2. + Z1(2)=-(COSB+SINB)/2. + Z2(1)=CONJG((ZI*ZADIZ-FB*ZMIXSS(2,IZ)*ZI**THIZ)*COSB- + $ (ZI*ZBDIZ-FB*ZMIXSS(2,IZ)*(-ZI)**THIZ)*SINB)/2. + Z2(2)=-CONJG((-ZI*ZADIZ-FB*ZMIXSS(2,IZ)*ZI**THIZ)*COSB- + $ (ZI*ZBDIZ+FB*ZMIXSS(2,IZ)*(-ZI)**THIZ)*SINB)/2. + CALL SSME3(2,AMB1SS,Z1,Z2) + Z1(1)=((ZI*ZADIZ-FB*ZMIXSS(2,IZ)*ZI**THIZ)*SINB+ + $ (ZI*ZBDIZ-FB*ZMIXSS(2,IZ)*(-ZI)**THIZ)*COSB)/2. + Z1(2)=((-ZI*ZADIZ-FB*ZMIXSS(2,IZ)*ZI**THIZ)*SINB+ + $ (ZI*ZBDIZ+FB*ZMIXSS(2,IZ)*(-ZI)**THIZ)*COSB)/2. + Z2(1)=(COSB+SINB)/2. + Z2(2)=(COSB-SINB)/2. + CALL SSME3(3,AMB2SS,Z1,Z2) + Z1(1)=(COSB+SINB)/2. + Z1(2)=(COSB-SINB)/2. + Z2(1)=CONJG((ZI*ZADIZ-FB*ZMIXSS(2,IZ)*ZI**THIZ)*SINB+ + $ (ZI*ZBDIZ-FB*ZMIXSS(2,IZ)*(-ZI)**THIZ)*COSB)/2. + Z2(2)=-CONJG((-ZI*ZADIZ-FB*ZMIXSS(2,IZ)*ZI**THIZ)*SINB+ + $ (ZI*ZBDIZ+FB*ZMIXSS(2,IZ)*(-ZI)**THIZ)*COSB)/2. + CALL SSME3(2,AMB2SS,Z1,Z2) + END IF +C 3 body gluino --> q + qb + zi decay, q=t + IF (AMGLSS.GT.(MZIZ+2*AMTP).AND.AMGLSS.LT. + $ (AMT1SS+AMTP)) THEN + TMP(1)=AMGLSS + TMP(2)=AMTP + TMP(3)=MZIZ + TMP(4)=AMT1SS + TMP(5)=AMT1SS + XUPPER=(AMGLSS**2+AMTP**2-(AMTP+MZIZ)**2)/2./AMGLSS + XT1=SSXINT(AMTP,SSGX1,XUPPER) + XT2=SSXINT(AMTP,SSGX2,XUPPER) + XT3=SSXINT(AMTP,SSGX3,XUPPER) + XT4=SSXINT(AMTP,SSGX4,XUPPER) + XT5=SSXINT(AMTP,SSGX5,XUPPER) + XT6=SSXINT(AMTP,SSGX6,XUPPER) + XT7=SSXINT(AMTP,SSGX7,XUPPER) + XT8=SSXINT(AMTP,SSGX8,XUPPER) + XT9=SSXINT(AMTP,SSGX9,XUPPER) + AL1=AUIZ*COST-FT*ZMIXSS(1,IZ)*SINT + BE1=FT*ZMIXSS(1,IZ)*COST+BUIZ*SINT +C ---- here, al2 is (-) al2 of tata notes----- + AL2=BUIZ*SINT+FT*ZMIXSS(1,IZ)*COST + BE2=-FT*ZMIXSS(1,IZ)*SINT+AUIZ*COST + XLL=(AL1**2+BE1**2)*XT1-4*AMTP*MZIZ*SNIZ*AL1* + $ BE1*XT3-AMGLSS*(SNIZ*MZIZ*(AL1**2*XT2/AMGLSS/ + $ MZIZ+BE1**2*AMTP**2*XT5)-AL1*BE1*AMTP*(XT4- + $ MZIZ**2*XT5)) + XRR=(AL2**2+BE2**2)*XT1-4*AMTP*MZIZ*SNIZ*AL2* + $ BE2*XT3-AMGLSS*(SNIZ*MZIZ*(AL2**2*XT2/AMGLSS/ + $ MZIZ+BE2**2*AMTP**2*XT5)-AL2*BE2*AMTP*(XT4- + $ MZIZ**2*XT5)) + XL1R1=-2*AMGLSS*AMTP*((AL1*AL2+BE1*BE2)*SNIZ*AMTP* + $ MZIZ*XT6-(AL2*BE1+AL1*BE2)*XT7) + XL2R2=XL1R1 + XL1R2=BE1*BE2*XT8+AL1*AL2*AMTP**2*XT4-AMTP*MZIZ* + $ SNIZ*(AL1*BE2+AL2*BE1)*XT9 + XL2R1=XL1R2 + XMST1=COST**2*XLL+SINT**2*XRR-SINT*COST*(XL1R1+XL1R2+ + $ XL2R1+XL2R2) + ELSE + XMST1=0. + END IF + IF (AMGLSS.GT.(MZIZ+2*AMTP).AND.AMGLSS.LT. + $ (AMT2SS+AMTP)) THEN + TMP(1)=AMGLSS + TMP(2)=AMTP + TMP(3)=MZIZ + TMP(4)=AMT2SS + TMP(5)=AMT2SS + XUPPER=(AMGLSS**2+AMTP**2-(AMTP+MZIZ)**2)/2./AMGLSS + XT1=SSXINT(AMTP,SSGX1,XUPPER) + XT2=SSXINT(AMTP,SSGX2,XUPPER) + XT3=SSXINT(AMTP,SSGX3,XUPPER) + XT4=SSXINT(AMTP,SSGX4,XUPPER) + XT5=SSXINT(AMTP,SSGX5,XUPPER) + XT6=SSXINT(AMTP,SSGX6,XUPPER) + XT7=SSXINT(AMTP,SSGX7,XUPPER) + XT8=SSXINT(AMTP,SSGX8,XUPPER) + XT9=SSXINT(AMTP,SSGX9,XUPPER) + AL1=AUIZ*SINT+FT*ZMIXSS(1,IZ)*COST + BE1=FT*ZMIXSS(1,IZ)*SINT-BUIZ*COST +C ---- here, al2 is (-) al2 of tata notes----- + AL2=-BUIZ*COST+FT*ZMIXSS(1,IZ)*SINT + BE2=FT*ZMIXSS(1,IZ)*COST+AUIZ*SINT + XLL=(AL1**2+BE1**2)*XT1-4*AMTP*MZIZ*SNIZ*AL1* + $ BE1*XT3-AMGLSS*(SNIZ*MZIZ*(AL1**2*XT2/AMGLSS/ + $ MZIZ+BE1**2*AMTP**2*XT5)-AL1*BE1*AMTP*(XT4- + $ MZIZ**2*XT5)) + XRR=(AL2**2+BE2**2)*XT1-4*AMTP*MZIZ*SNIZ*AL2* + $ BE2*XT3-AMGLSS*(SNIZ*MZIZ*(AL2**2*XT2/AMGLSS/ + $ MZIZ+BE2**2*AMTP**2*XT5)-AL2*BE2*AMTP*(XT4- + $ MZIZ**2*XT5)) + XL1R1=-2*AMGLSS*AMTP*((AL1*AL2+BE1*BE2)*SNIZ*AMTP* + $ MZIZ*XT6-(AL2*BE1+AL1*BE2)*XT7) + XL2R2=XL1R1 + XL1R2=BE1*BE2*XT8+AL1*AL2*AMTP**2*XT4-AMTP*MZIZ* + $ SNIZ*(AL1*BE2+AL2*BE1)*XT9 + XL2R1=XL1R2 + XMST2=SINT**2*XLL+COST**2*XRR+SINT*COST*(XL1R1+XL1R2+ + $ XL2R1+XL2R2) + ELSE + XMST2=0. + END IF +C ----cross term between t_1 and t_2 graphs ----------- + IF (AMGLSS.GT.(MZIZ+2*AMTP).AND.AMGLSS.LT. + $ (AMT1SS+AMTP)) THEN + TMP(1)=AMGLSS + TMP(2)=AMTP + TMP(3)=MZIZ + TMP(4)=AMT1SS + TMP(5)=AMT2SS + XUPPER=(AMGLSS**2+AMTP**2-(AMTP+MZIZ)**2)/2./AMGLSS + XT1=SSXINT(AMTP,SSGX1,XUPPER) + XT2=SSXINT(AMTP,SSGX2,XUPPER) + XT3=SSXINT(AMTP,SSGX3,XUPPER) + XT4=SSXINT(AMTP,SSGX4,XUPPER) + XT5=SSXINT(AMTP,SSGX5,XUPPER) + XT6=SSXINT(AMTP,SSGX6,XUPPER) + XT7=SSXINT(AMTP,SSGX7,XUPPER) + XT8=SSXINT(AMTP,SSGX8,XUPPER) + XT9=SSXINT(AMTP,SSGX9,XUPPER) + AL1=AUIZ*COST-FT*ZMIXSS(1,IZ)*SINT + AL2=AUIZ*SINT+FT*ZMIXSS(1,IZ)*COST + BE1=FT*ZMIXSS(1,IZ)*COST+BUIZ*SINT + BE2=FT*ZMIXSS(1,IZ)*SINT-BUIZ*COST + XL1L2=COST*SINT*(2*(AL1*AL2+BE1*BE2)*XT1-4*SNIZ*AMTP* + $ MZIZ*(AL1*BE2+AL2*BE1)*XT3-AMGLSS*(2*MZIZ* + $ SNIZ*(AL1*AL2*XT2/AMGLSS/MZIZ+BE1*BE2*AMTP**2* + $ XT5)-(AL1*BE2+AL2*BE1)*AMTP*(XT4-MZIZ**2*XT5))) + AL1=-BUIZ*SINT-FT*ZMIXSS(1,IZ)*COST + AL2=BUIZ*COST-FT*ZMIXSS(1,IZ)*SINT + BE1=-FT*ZMIXSS(1,IZ)*SINT+AUIZ*COST + BE2=FT*ZMIXSS(1,IZ)*COST+AUIZ*SINT + XR1R2=-COST*SINT*(2*(AL1*AL2+BE1*BE2)*XT1+4*SNIZ*AMTP* + $ MZIZ*(AL1*BE2+AL2*BE1)*XT3-AMGLSS*(2*MZIZ* + $ SNIZ*(AL1*AL2*XT2/AMGLSS/MZIZ+BE1*BE2*AMTP**2* + $ XT5)+(AL1*BE2+AL2*BE1)*AMTP*(XT4-MZIZ**2*XT5))) + AL1=AUIZ*COST-FT*ZMIXSS(1,IZ)*SINT + AL2=BUIZ*COST-FT*ZMIXSS(1,IZ)*SINT + BE1=FT*ZMIXSS(1,IZ)*COST+BUIZ*SINT + BE2=FT*ZMIXSS(1,IZ)*COST+AUIZ*SINT + XL1R1=2*AMGLSS*AMTP*COST**2*(SNIZ*(AL1*AL2-BE1*BE2)* + $ AMTP*MZIZ*XT6-(AL2*BE1-AL1*BE2)*XT7) + XL1R2=COST**2*(BE1*BE2*XT8-AL1*AL2*AMTP**2*XT4+AMTP* + $ MZIZ*SNIZ*XT9*(-AL1*BE2+BE1*AL2)) + XLR1=2*(XL1R1+XL1R2) + AL1=AUIZ*SINT+FT*ZMIXSS(1,IZ)*COST + AL2=-BUIZ*SINT-FT*ZMIXSS(1,IZ)*COST + BE1=FT*ZMIXSS(1,IZ)*SINT-BUIZ*COST + BE2=-FT*ZMIXSS(1,IZ)*SINT+AUIZ*COST + TMP(4)=AMT2SS + TMP(5)=AMT1SS + XT8=SSXINT(AMTP,SSGX8,XUPPER) + XT9=SSXINT(AMTP,SSGX9,XUPPER) + XL1R1=2*AMGLSS*AMTP*SINT**2*(SNIZ*(-AL1*AL2+BE1*BE2)* + $ AMTP*MZIZ*XT6+(AL2*BE1-AL1*BE2)*XT7) + XL1R2=-SINT**2*(BE1*BE2*XT8-AL1*AL2*AMTP**2*XT4+AMTP* + $ MZIZ*SNIZ*XT9*(-AL1*BE2+BE1*AL2)) + XLR2=2*(XL1R1+XL1R2) + XMST12=XL1L2+XR1R2+XLR1+XLR2 + ELSE + XMST12=0. + END IF + WID=XTCON*(XMST1+XMST2+XMST12) + IF (WID.GT.0.) THEN + CALL SSSAVE(ISGL,WID,ISZI(IZ),IDTP,-IDTP,0,0) + Z1(1)=((ZI*ZAUIZ-FT*ZMIXSS(1,IZ)*ZI**THIZ)*COST- + $ (ZI*ZBUIZ-FT*ZMIXSS(1,IZ)*(-ZI)**THIZ)*SINT)/2. + Z1(2)=((-ZI*ZAUIZ-FT*ZMIXSS(1,IZ)*ZI**THIZ)*COST- + $ (ZI*ZBUIZ+FT*ZMIXSS(1,IZ)*(-ZI)**THIZ)*SINT)/2. + Z2(1)=(COST-SINT)/2. + Z2(2)=-(COST+SINT)/2. + CALL SSME3(3,AMT1SS,Z1,Z2) + Z1(1)=(COST-SINT)/2. + Z1(2)=-(COST+SINT)/2. + Z2(1)=CONJG((ZI*ZAUIZ-FT*ZMIXSS(1,IZ)*ZI**THIZ)*COST- + $ (ZI*ZBUIZ-FT*ZMIXSS(1,IZ)*(-ZI)**THIZ)*SINT)/2. + Z2(2)=-CONJG((-ZI*ZAUIZ-FT*ZMIXSS(1,IZ)*ZI**THIZ)*COST- + $ (ZI*ZBUIZ+FT*ZMIXSS(1,IZ)*(-ZI)**THIZ)*SINT)/2. + CALL SSME3(2,AMT1SS,Z1,Z2) + Z1(1)=((ZI*ZAUIZ-FT*ZMIXSS(1,IZ)*ZI**THIZ)*SINT+ + $ (ZI*ZBUIZ-FT*ZMIXSS(1,IZ)*(-ZI)**THIZ)*COST)/2. + Z1(2)=((-ZI*ZAUIZ-FT*ZMIXSS(1,IZ)*ZI**THIZ)*SINT+ + $ (ZI*ZBUIZ+FT*ZMIXSS(1,IZ)*(-ZI)**THIZ)*COST)/2. + Z2(1)=(COST+SINT)/2. + Z2(2)=(COST-SINT)/2. + CALL SSME3(3,AMT2SS,Z1,Z2) + Z1(1)=(COST+SINT)/2. + Z1(2)=(COST-SINT)/2. + Z2(1)=CONJG((ZI*ZAUIZ-FT*ZMIXSS(1,IZ)*ZI**THIZ)*SINT+ + $ (ZI*ZBUIZ-FT*ZMIXSS(1,IZ)*(-ZI)**THIZ)*COST)/2. + Z2(2)=-CONJG((-ZI*ZAUIZ-FT*ZMIXSS(1,IZ)*ZI**THIZ)*SINT+ + $ (ZI*ZBUIZ+FT*ZMIXSS(1,IZ)*(-ZI)**THIZ)*COST)/2. + CALL SSME3(2,AMT2SS,Z1,Z2) + END IF +100 CONTINUE +C +C gluino --> quark + squark mode +C + IF (AMGLSS.GT.(AMULSS+AMUP)) THEN + GMQK=ALF3*AMGLSS*(1.+AMUP**2/AMGLSS**2-AMULSS**2/AMGLSS**2)* + $ SQRT(SSXLAM(1.,AMUP**2/AMGLSS**2,AMULSS**2/AMGLSS**2))/8. + CALL SSSAVE(ISGL,GMQK,-ISUPL,+IDUP,0,0,0) + CALL SSSAVE(ISGL,GMQK,+ISUPL,-IDUP,0,0,0) + END IF + IF (AMGLSS.GT.(AMDLSS+AMDN)) THEN + GMQK=ALF3*AMGLSS*(1.+AMDN**2/AMGLSS**2-AMDLSS**2/AMGLSS**2)* + $ SQRT(SSXLAM(1.,AMDN**2/AMGLSS**2,AMDLSS**2/AMGLSS**2))/8. + CALL SSSAVE(ISGL,GMQK,-ISDNL,+IDDN,0,0,0) + CALL SSSAVE(ISGL,GMQK,+ISDNL,-IDDN,0,0,0) + END IF + IF (AMGLSS.GT.(AMURSS+AMUP)) THEN + GMQK=ALF3*AMGLSS*(1.+AMUP**2/AMGLSS**2-AMURSS**2/AMGLSS**2)* + $ SQRT(SSXLAM(1.,AMUP**2/AMGLSS**2,AMURSS**2/AMGLSS**2))/8. + CALL SSSAVE(ISGL,GMQK,-ISUPR,+IDUP,0,0,0) + CALL SSSAVE(ISGL,GMQK,+ISUPR,-IDUP,0,0,0) + END IF + IF (AMGLSS.GT.(AMDRSS+AMDN)) THEN + GMQK=ALF3*AMGLSS*(1.+AMDN**2/AMGLSS**2-AMDRSS**2/AMGLSS**2)* + $ SQRT(SSXLAM(1.,AMDN**2/AMGLSS**2,AMDRSS**2/AMGLSS**2))/8. + CALL SSSAVE(ISGL,GMQK,-ISDNR,+IDDN,0,0,0) + CALL SSSAVE(ISGL,GMQK,+ISDNR,-IDDN,0,0,0) + END IF +C + IF (AMGLSS.GT.(AMSLSS+AMST)) THEN + GMQK=ALF3*AMGLSS*(1.+AMST**2/AMGLSS**2-AMSLSS**2/AMGLSS**2)* + $ SQRT(SSXLAM(1.,AMST**2/AMGLSS**2,AMSLSS**2/AMGLSS**2))/8. + CALL SSSAVE(ISGL,GMQK,-ISSTL,+IDST,0,0,0) + CALL SSSAVE(ISGL,GMQK,+ISSTL,-IDST,0,0,0) + END IF + IF (AMGLSS.GT.(AMSRSS+AMST)) THEN + GMQK=ALF3*AMGLSS*(1.+AMST**2/AMGLSS**2-AMSRSS**2/AMGLSS**2)* + $ SQRT(SSXLAM(1.,AMST**2/AMGLSS**2,AMSRSS**2/AMGLSS**2))/8. + CALL SSSAVE(ISGL,GMQK,-ISSTR,+IDST,0,0,0) + CALL SSSAVE(ISGL,GMQK,+ISSTR,-IDST,0,0,0) + END IF +C + IF (AMGLSS.GT.(AMCLSS+AMCH)) THEN + GMQK=ALF3*AMGLSS*(1.+AMCH**2/AMGLSS**2-AMCLSS**2/AMGLSS**2)* + $ SQRT(SSXLAM(1.,AMCH**2/AMGLSS**2,AMCLSS**2/AMGLSS**2))/8. + CALL SSSAVE(ISGL,GMQK,-ISCHL,+IDCH,0,0,0) + CALL SSSAVE(ISGL,GMQK,+ISCHL,-IDCH,0,0,0) + END IF + IF (AMGLSS.GT.(AMCRSS+AMCH)) THEN + GMQK=ALF3*AMGLSS*(1.+AMCH**2/AMGLSS**2-AMCRSS**2/AMGLSS**2)* + $ SQRT(SSXLAM(1.,AMCH**2/AMGLSS**2,AMCRSS**2/AMGLSS**2))/8. + CALL SSSAVE(ISGL,GMQK,-ISCHR,+IDCH,0,0,0) + CALL SSSAVE(ISGL,GMQK,+ISCHR,-IDCH,0,0,0) + END IF +C +C !!! NEED MIXING ANGLE PIECE LIKE STOPS + IF (AMGLSS.GT.(AMB1SS+AMBT)) THEN + GMQK=ALF3*AMGLSS*(1.+AMBT**2/AMGLSS**2-AMB1SS**2/AMGLSS**2)* + $ SQRT(SSXLAM(1.,AMBT**2/AMGLSS**2,AMB1SS**2/AMGLSS**2))/8. + CALL SSSAVE(ISGL,GMQK,-ISBT1,+IDBT,0,0,0) + CALL SSSAVE(ISGL,GMQK,+ISBT1,-IDBT,0,0,0) + END IF +C + IF (AMGLSS.GT.(AMB2SS+AMBT)) THEN + GMQK=ALF3*AMGLSS*(1.+AMBT**2/AMGLSS**2-AMB2SS**2/AMGLSS**2)* + $ SQRT(SSXLAM(1.,AMBT**2/AMGLSS**2,AMB2SS**2/AMGLSS**2))/8. + CALL SSSAVE(ISGL,GMQK,-ISBT2,+IDBT,0,0,0) + CALL SSSAVE(ISGL,GMQK,+ISBT2,-IDBT,0,0,0) + END IF +C + IF (AMGLSS.GT.(AMT1SS+AMTP)) THEN + GMQK=ALF3*AMGLSS*(1.+AMTP**2/AMGLSS**2-AMT1SS**2/AMGLSS**2- + $ 2*SIN(2*THETAT)*AMTP/AMGLSS)* + $ SQRT(SSXLAM(1.,AMTP**2/AMGLSS**2,AMT1SS**2/AMGLSS**2))/8. + CALL SSSAVE(ISGL,GMQK,-ISTP1,+IDTP,0,0,0) + CALL SSSAVE(ISGL,GMQK,+ISTP1,-IDTP,0,0,0) + END IF +C + IF (AMGLSS.GT.(AMT2SS+AMTP)) THEN + GMQK=ALF3*AMGLSS*(1.+AMTP**2/AMGLSS**2-AMT2SS**2/AMGLSS**2+ + $ 2*SIN(2*THETAT)*AMTP/AMGLSS)* + $ SQRT(SSXLAM(1.,AMTP**2/AMGLSS**2,AMT2SS**2/AMGLSS**2))/8. + CALL SSSAVE(ISGL,GMQK,-ISTP2,+IDTP,0,0,0) + CALL SSSAVE(ISGL,GMQK,+ISTP2,-IDTP,0,0,0) + END IF +C +C Decay to gravitino +C + IF (AMGLSS.GT.AMGVSS) THEN + WID=AMGLSS**5/48./PI/(AMGVSS*AMPL)**2 + CALL SSSAVE(ISGL,WID,91,IDGL,0,0,0) + END IF +C +C Normalize branching ratios +C + CALL SSNORM(ISGL) +C + RETURN + END diff --git a/ISAJET/isasusy/ssgwq1.F b/ISAJET/isasusy/ssgwq1.F new file mode 100644 index 00000000000..39752c160d7 --- /dev/null +++ b/ISAJET/isasusy/ssgwq1.F @@ -0,0 +1,26 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSGWQ1(Q) +C----------------------------------------------------------------------- +C SSGLBF: glss -> wiss + qk + qb +C The function psi of PRD36, 96 (1987); Eq. 3.2 +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" + REAL Q,PI + DOUBLE PRECISION MZ,MG,MS,QS,MGS,MSS,MZS,FUN + PI=4*ATAN(1.) + MZ=TMP(1) + MS=TMP(2) + MG=AMGLSS + QS=Q*Q + MGS=MG*MG + MZS=MZ*MZ + MSS=MS*MS + FUN=QS*(MGS-2*MG*Q-MZS)**2/(MGS-2*MG*Q-MSS)**2/(MGS-2*MG*Q) + SSGWQ1=PI**2*MG*FUN + RETURN + END diff --git a/ISAJET/isasusy/ssgwq2.F b/ISAJET/isasusy/ssgwq2.F new file mode 100644 index 00000000000..2b98f2e3efc --- /dev/null +++ b/ISAJET/isasusy/ssgwq2.F @@ -0,0 +1,33 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSGWQ2(Q) +C----------------------------------------------------------------------- +C SSGLBF: glss -> wiss + qk + qb +C The function phi of PRD36, 96 (1987); Eq. 3.2 +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" + REAL Q,PI + DOUBLE PRECISION MZ,MG,MS,QS,MGS,MSS,MZS,FUN,TERM + PI=4*ATAN(1.) + MZ=TMP(1) + MS=TMP(2) + MG=AMGLSS + QS=Q*Q + MGS=MG*MG + MZS=MZ*MZ + MSS=MS*MS + TERM=(MSS*MG-2*MSS*Q-MG*MZS)/(MG-2*Q)/(MSS-2*MG*Q-MZS) + IF (TERM.LE.0.D0) THEN + SSGWQ2=0. + RETURN + ELSE + FUN=(-Q*(MGS-MZS-2*MG*Q)/(MGS-2*Q*MG)-(2*MG*Q-MSS+MZS)* + $ DLOG(TERM)/2.D0/MG)/(MGS-MSS-2*MG*Q) + SSGWQ2=PI**2*MG*MZ/2.*FUN + RETURN + END IF + END diff --git a/ISAJET/isasusy/ssgwt1.F b/ISAJET/isasusy/ssgwt1.F new file mode 100644 index 00000000000..6a62a09986c --- /dev/null +++ b/ISAJET/isasusy/ssgwt1.F @@ -0,0 +1,31 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSGWT1(E) +C----------------------------------------------------------------------- +C SSGLBF: glss -> wiss + tp + bb +C Baer's FTBW1 +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" + REAL E + DOUBLE PRECISION MWI,MG,MT,DFTBW,PT,ET,MST1,MST2,TOP,BOT +C + ET=E + MWI=TMP(1) + MG=TMP(2) + MT=TMP(3) + MST1=TMP(6) + MST2=TMP(7) +C +C Rewrite PT=DSQRT(ET**2-MT**2) + PT=DSQRT((ET-MT)*(ET+MT)) + TOP=(MG**2+MT**2-2*MG*ET-MWI**2)**2*ET*PT + BOT=(MG**2+MT**2-2*MG*ET-MST1**2)*(MG**2+MT**2-2*MG*ET- + $ MST2**2)*(MG**2+MT**2-2*ET*MG) + DFTBW=MG*TOP/BOT + SSGWT1=DFTBW + RETURN + END diff --git a/ISAJET/isasusy/ssgwt2.F b/ISAJET/isasusy/ssgwt2.F new file mode 100644 index 00000000000..f0a15df2d0a --- /dev/null +++ b/ISAJET/isasusy/ssgwt2.F @@ -0,0 +1,34 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSGWT2(E) +C----------------------------------------------------------------------- +C SSGLBF: glss -> wiss + tp + bb +C Drees' G_2 +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" + REAL E + DOUBLE PRECISION MWI,MG,MT,DFTBW,EB,TOP,BOT,MSB + DOUBLE PRECISION SSDLAM,TERM +C + EB=E + MWI=TMP(1) + MG=TMP(2) + MT=TMP(3) + MSB=TMP(4) +C + TOP=EB**2*(MG**2+AMBT**2-2*MG*EB-MWI**2-MT**2) + BOT=(MG**2+AMBT**2-2*MG*EB-MSB**2)**2* + $ (MG**2+AMBT**2-2*EB*MG) + TERM=SSDLAM((MG**2+AMBT**2-2*MG*EB),MWI**2,MT**2) + IF(TERM.GT.0.D0) THEN + DFTBW=MG*TOP/BOT*DSQRT(TERM) + ELSE + DFTBW=0.D0 + ENDIF + SSGWT2=DFTBW + RETURN + END diff --git a/ISAJET/isasusy/ssgwt3.F b/ISAJET/isasusy/ssgwt3.F new file mode 100644 index 00000000000..24c827730c2 --- /dev/null +++ b/ISAJET/isasusy/ssgwt3.F @@ -0,0 +1,35 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSGWT3(E) +C----------------------------------------------------------------------- +C SSGLBF: glss -> wiss + tp + bb +C Drees' G_3 +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" + REAL E + DOUBLE PRECISION MWI,MG,MT,EB,BOT,MSB + DOUBLE PRECISION SSDLAM,TERM,SN,DFTBW +C + EB=E + MWI=TMP(1) + MG=TMP(2) + MT=TMP(3) + MSB=TMP(4) + SN=TMP(8) +C + + BOT=(MG**2+AMBT**2-2*MG*EB-MSB**2)**2* + $ (MG**2+AMBT**2-2*EB*MG) + TERM=SSDLAM((MG**2+AMBT**2-2*MG*EB),MWI**2,MT**2) + IF(TERM.GT.0.D0) THEN + DFTBW=4*MG*MWI*MT*SN*EB*EB/BOT*DSQRT(TERM) + ELSE + DFTBW=0.D0 + ENDIF + SSGWT3=DFTBW + RETURN + END diff --git a/ISAJET/isasusy/ssgwt4.F b/ISAJET/isasusy/ssgwt4.F new file mode 100644 index 00000000000..eeef111c071 --- /dev/null +++ b/ISAJET/isasusy/ssgwt4.F @@ -0,0 +1,44 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSGWT4(E) +C----------------------------------------------------------------------- +C SSGLBF: glss -> wiss + tp + bb +C Baer's FTBW12; EQ. A.3D OF BTW, MODIFIED FOR MB=/0 +C Drees' G_4 +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" + REAL E + DOUBLE PRECISION ET,MWI,MG,MT,MSB,MST,PT,EBMX + DOUBLE PRECISION BOT,TOP,DFTBW,EBMN,XX + DOUBLE PRECISION MB,Z,RDL,DEN,R1,R2,R3,SSDLAM,SN +C + ET=E + MWI=TMP(1) + MG=TMP(2) + MT=TMP(3) + MSB=TMP(4) + MST=TMP(6) + SN=TMP(8) + MB=AMBT +C +C Rewrite PT=DSQRT(ET**2-MT**2) + PT=DSQRT((ET-MT)*(ET+MT)) + Z=(MG**2+MT**2-2*MG*ET+MB**2-MWI**2)/2. + R1=1.D0+MT**2/MG**2-2.D0*ET/MG + R2=MB**2/MG**2 + R3=MWI**2/MG**2 + RDL=DSQRT(DMAX1(0.D0,SSDLAM(R1,R2,R3))) + DEN=MG**2+MT**2-2*ET*MG + EBMX=(2*Z*(1.D0-ET/MG)+PT*MG*RDL)*MG/2.D0/DEN + EBMN=(2*Z*(1.D0-ET/MG)-PT*MG*RDL)*MG/2.D0/DEN + XX=(MSB**2+2*MG*EBMX-MG**2)/(MSB**2+2*MG*EBMN-MG**2) + TOP=EBMX-EBMN-(MSB**2-2*MG*ET+MT**2-MWI**2)*DLOG(XX)/2.D0/MG + BOT=(MG**2+MT**2-2*MG*ET-MST**2) + DFTBW=-SN*MG*MWI*TOP/BOT + SSGWT4=DFTBW + RETURN + END diff --git a/ISAJET/isasusy/ssgwt5.F b/ISAJET/isasusy/ssgwt5.F new file mode 100644 index 00000000000..46e9e124c31 --- /dev/null +++ b/ISAJET/isasusy/ssgwt5.F @@ -0,0 +1,43 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSGWT5(E) +C----------------------------------------------------------------------- +C SSGLBF: glss -> wiss + tp + bb +C Baer's FTBW12; EQ. A.3D OF BTW, MODIFIED FOR MB=/0 +C Drees' G_5 +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" + REAL E + DOUBLE PRECISION ET,MWI,MG,MT,MSB,MST,PT,EBMX + DOUBLE PRECISION BOT,TOP,DFTBW,EBMN,XX + DOUBLE PRECISION MB,Z,RDL,DEN,R1,R2,R3,SSDLAM +C + ET=E + MWI=TMP(1) + MG=TMP(2) + MT=TMP(3) + MSB=TMP(4) + MST=TMP(6) + MB=AMBT +C +C Rewrite PT=DSQRT(ET**2-MT**2) + PT=DSQRT((ET-MT)*(ET+MT)) + Z=(MG**2+MT**2-2*MG*ET+MB**2-MWI**2)/2. + R1=1.D0+MT**2/MG**2-2.D0*ET/MG + R2=MB**2/MG**2 + R3=MWI**2/MG**2 + RDL=DSQRT(DMAX1(0.D0,SSDLAM(R1,R2,R3))) + DEN=MG**2+MT**2-2*ET*MG + EBMX=(2*Z*(1.D0-ET/MG)+PT*MG*RDL)*MG/2.D0/DEN + EBMN=(2*Z*(1.D0-ET/MG)-PT*MG*RDL)*MG/2.D0/DEN + XX=(MSB**2+2*MG*EBMX-MG**2)/(MSB**2+2*MG*EBMN-MG**2) + TOP=(MG**2+MT**2-2*MG*ET-MWI**2)*DLOG(XX) + BOT=MG**2+MT**2-2*MG*ET-MST**2 + DFTBW=-0.5*MT*TOP/BOT + SSGWT5=DFTBW + RETURN + END diff --git a/ISAJET/isasusy/ssgwt6.F b/ISAJET/isasusy/ssgwt6.F new file mode 100644 index 00000000000..9611b62f0b9 --- /dev/null +++ b/ISAJET/isasusy/ssgwt6.F @@ -0,0 +1,45 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSGWT6(E) +C----------------------------------------------------------------------- +C SSGLBF: glss -> wiss + tp + bb +C Baer's FTBW23/Drees' G_6 +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" + REAL E + DOUBLE PRECISION ET,MWI,MG,MT,MSB,MST,PT,EBMX + DOUBLE PRECISION DEN,T1,DFTBW,EBMN,XX,XL + DOUBLE PRECISION MB,Z,RDL,DENO,R1,R2,R3,SSDLAM +C + ET=E + MWI=TMP(1) + MG=TMP(2) + MT=TMP(3) + MSB=TMP(4) + MST=TMP(6) + MB=AMBT +C +C Rewrite PT=DSQRT(ET**2-MT**2) + PT=DSQRT((ET-MT)*(ET+MT)) + Z=(MG**2+MT**2-2*MG*ET+MB**2-MWI**2)/2. + R1=1.D0+MT**2/MG**2-2.D0*ET/MG + R2=MB**2/MG**2 + R3=MWI**2/MG**2 + RDL=DSQRT(DMAX1(0.D0,SSDLAM(R1,R2,R3))) + DENO=MG**2+MT**2-2*ET*MG + EBMX=(2*Z*(1.D0-ET/MG)+PT*MG*RDL)*MG/2.D0/DENO + EBMN=(2*Z*(1.D0-ET/MG)-PT*MG*RDL)*MG/2.D0/DENO + XX=(MSB**2+2*MG*EBMX-MG**2)/(MSB**2+2*MG*EBMN-MG**2) + XL=DLOG(XX) + DEN=MG**2-2*MG*ET+MT**2-MST**2 + T1=(MG*(MG**2+MT**2-2*MG*ET-MWI**2)-(MSB**2-MG**2)* + $ (2*ET*MG-MT**2-MG**2)/MG)*XL+2*(2*ET*MG-MT**2-MG**2)* + $ (EBMX-EBMN) + DFTBW=.5D0*T1/DEN + SSGWT6=DFTBW + RETURN + END diff --git a/ISAJET/isasusy/ssgwt7.F b/ISAJET/isasusy/ssgwt7.F new file mode 100644 index 00000000000..8b8824c5e37 --- /dev/null +++ b/ISAJET/isasusy/ssgwt7.F @@ -0,0 +1,44 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSGWT7(E) +C----------------------------------------------------------------------- +C SSGLBF: glss -> wiss + tp + bb +C Baer's FTBW23/Drees' G_7 +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" + REAL E + DOUBLE PRECISION ET,MWI,MG,MT,MSB,MST,PT,EBMX + DOUBLE PRECISION DEN,T1,SN,DFTBW,EBMN,XX,XL + DOUBLE PRECISION MB,Z,RDL,DENO,R1,R2,R3,SSDLAM +C + ET=E + MWI=TMP(1) + MG=TMP(2) + MT=TMP(3) + MSB=TMP(4) + MST=TMP(6) + SN=TMP(8) + MB=AMBT +C +C Rewrite PT=DSQRT(ET**2-MT**2) + PT=DSQRT((ET-MT)*(ET+MT)) + Z=(MG**2+MT**2-2*MG*ET+MB**2-MWI**2)/2. + R1=1.D0+MT**2/MG**2-2.D0*ET/MG + R2=MB**2/MG**2 + R3=MWI**2/MG**2 + RDL=DSQRT(DMAX1(0.D0,SSDLAM(R1,R2,R3))) + DENO=MG**2+MT**2-2*ET*MG + EBMX=(2*Z*(1.D0-ET/MG)+PT*MG*RDL)*MG/2.D0/DENO + EBMN=(2*Z*(1.D0-ET/MG)-PT*MG*RDL)*MG/2.D0/DENO + XX=(MSB**2+2*MG*EBMX-MG**2)/(MSB**2+2*MG*EBMN-MG**2) + XL=DLOG(XX) + DEN=MG**2-2*MG*ET+MT**2-MST**2 + T1=2*(EBMX-EBMN)-(MSB**2-MG**2)*XL/MG + DFTBW=.5*SN*MWI*MT*T1/DEN + SSGWT7=DFTBW + RETURN + END diff --git a/ISAJET/isasusy/ssgwt8.F b/ISAJET/isasusy/ssgwt8.F new file mode 100644 index 00000000000..8f6e4ef7f56 --- /dev/null +++ b/ISAJET/isasusy/ssgwt8.F @@ -0,0 +1,42 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSGWT8(E) +C----------------------------------------------------------------------- +C SSGLBF: glss -> wiss + tp + bb +C Baer's FTBW13/ Drees' G_8 +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" + REAL E + DOUBLE PRECISION ET,MWI,MG,MT,MST1,MST2,PT,EBMX,EBMN + DOUBLE PRECISION TOP,BOT,DFTBW + DOUBLE PRECISION MB,Z,RDL,DEN,R1,R2,R3,SSDLAM +C + ET=E + MWI=TMP(1) + MG=TMP(2) + MT=TMP(3) + MST1=TMP(6) + MST2=TMP(7) + MB=AMBT +C +C Rewrite PT=DSQRT(ET**2-MT**2) + PT=DSQRT((ET-MT)*(ET+MT)) + Z=(MG**2+MT**2-2*MG*ET+MB**2-MWI**2)/2. + R1=1.D0+MT**2/MG**2-2.D0*ET/MG + R2=MB**2/MG**2 + R3=MWI**2/MG**2 + RDL=DSQRT(DMAX1(0.D0,SSDLAM(R1,R2,R3))) + DEN=MG**2+MT**2-2*ET*MG + EBMX=(2*Z*(1.D0-ET/MG)+PT*MG*RDL)*MG/2.D0/DEN + EBMN=(2*Z*(1.D0-ET/MG)-PT*MG*RDL)*MG/2.D0/DEN + TOP=(MG**2+MT**2-2*MG*ET-MWI**2)*(EBMX-EBMN) + BOT=(MG**2+MT**2-2*MG*ET-MST1**2)* + $ (MG**2+MT**2-2*MG*ET-MST2**2) + DFTBW=-MG*MT*TOP/BOT + SSGWT8=DFTBW + RETURN + END diff --git a/ISAJET/isasusy/ssgx1.F b/ISAJET/isasusy/ssgx1.F new file mode 100644 index 00000000000..b656dc8cc07 --- /dev/null +++ b/ISAJET/isasusy/ssgx1.F @@ -0,0 +1,33 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSGX1(ET) +C----------------------------------------------------------------------- +C SSGLBF: glss -> ziss + tp + tb +C Baer's XT1 - PSI- eq. a.6.a of prd45,142 (1992) +C Modified for t_1 and t_2 eigenstates +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" + REAL ET + DOUBLE PRECISION DET,DMG,DMT,DMZ,DMT1,DMT2,TOP + DOUBLE PRECISION BOT,PT,DXT1,SSDLAM,PI,TOPS + DATA PI/3.14159265D0/ + DET=ET + DMG=TMP(1) + DMT=TMP(2) + DMZ=TMP(3) + DMT1=TMP(4) + DMT2=TMP(5) + PT=DSQRT(DET**2-DMT**2) + TOPS=SSDLAM(DMG**2+DMT**2-2*DMG*DET,DMT**2,DMZ**2) + TOP=DSQRT(DMAX1(0.D0,TOPS)) + BOT=(DMG**2+DMT**2-2*DMG*DET-DMT1**2)* + $ (DMG**2+DMT**2-2*DMG*DET-DMT2**2) + DXT1=PI**2*DMG*DET*PT*(DMG**2-DMZ**2-2*DMG*DET)*TOP/BOT/ + $ (DMG**2-2*DMG*DET+DMT**2) + SSGX1=DXT1 + RETURN + END diff --git a/ISAJET/isasusy/ssgx10.F b/ISAJET/isasusy/ssgx10.F new file mode 100644 index 00000000000..d36346b58cf --- /dev/null +++ b/ISAJET/isasusy/ssgx10.F @@ -0,0 +1,46 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSGX10(ET) +C----------------------------------------------------------------------- +C SSGLBF: glss -> ziss + tp + tb +C Baer's XT10 +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" + REAL MG,MT,MZ,MST1,MST2,ET + DOUBLE PRECISION DET,DMG,DMT,DMZ,DMT1,DMT2,TOP,BOT,DXT10 + DOUBLE PRECISION XT,MUT,MUZ,XMIN,XMAX,EMIN,EMAX,SSDLAM + DOUBLE PRECISION PI + DATA PI/3.14159265D0/ + MG=TMP(1) + MT=TMP(2) + MZ=TMP(3) + MST1=TMP(4) + MST2=TMP(5) + DET=ET + DMG=TMP(1) + DMT=TMP(2) + DMZ=TMP(3) + DMT1=TMP(4) + DMT2=TMP(5) + XT=2*ET/MG + MUT=(MT/MG)**2 + MUZ=(MZ/MG)**2 + XMIN=((2.D0-XT)*(1.D0+2*MUT-MUZ-XT)-DSQRT(DMAX1(0.D0, + $ (XT**2-4*MUT)*SSDLAM((1.D0+MUT-XT),MUT,MUZ)))) + $ /2.D0/(1.D0-XT+MUT) + XMAX=((2.D0-XT)*(1.D0+2*MUT-MUZ-XT)+DSQRT(DMAX1(0.D0, + $ (XT**2-4*MUT)*SSDLAM((1.D0+MUT-XT),MUT,MUZ)))) + $ /2.D0/(1.D0-XT+MUT) + EMIN=XMIN*MG/2.D0 + EMAX=XMAX*MG/2.D0 + TOP=DMG**2-2*DMG*EMAX+DMT**2-DMT2**2 + BOT=DMG**2-2*DMG*EMIN+DMT**2-DMT2**2 + DXT10=(EMAX-EMIN-(DMG**2-2*DMG*DET+DMT2**2-DMT**2)/2.D0/DMG* + $ DLOG(TOP/BOT))*PI**2/2.D0/(DMG**2+DMT**2-2*DMG*DET-DMT1**2) + SSGX10=DXT10 + RETURN + END diff --git a/ISAJET/isasusy/ssgx11.F b/ISAJET/isasusy/ssgx11.F new file mode 100644 index 00000000000..1ad2ff628eb --- /dev/null +++ b/ISAJET/isasusy/ssgx11.F @@ -0,0 +1,46 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSGX11(ET) +C----------------------------------------------------------------------- +C SSGLBF: glss -> ziss + tp + tb +C Baer's XT11 +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" + REAL MG,MT,MZ,MST1,MST2,ET + DOUBLE PRECISION DET,DMG,DMT,DMZ,DMT1,DMT2,TOP,BOT,DXT11 + DOUBLE PRECISION XT,MUT,MUZ,XMIN,XMAX,EMIN,EMAX,SSDLAM + DOUBLE PRECISION PI + DATA PI/3.14159265D0/ + MG=TMP(1) + MT=TMP(2) + MZ=TMP(3) + MST1=TMP(4) + MST2=TMP(5) + DET=ET + DMG=TMP(1) + DMT=TMP(2) + DMZ=TMP(3) + DMT1=TMP(4) + DMT2=TMP(5) + XT=2*ET/MG + MUT=(MT/MG)**2 + MUZ=(MZ/MG)**2 + XMIN=((2.D0-XT)*(1.D0+2*MUT-MUZ-XT)-DSQRT(DMAX1(0.D0, + $ (XT**2-4*MUT)*SSDLAM((1.D0+MUT-XT),MUT,MUZ)))) + $ /2.D0/(1.D0-XT+MUT) + XMAX=((2.D0-XT)*(1.D0+2*MUT-MUZ-XT)+DSQRT(DMAX1(0.D0, + $ (XT**2-4*MUT)*SSDLAM((1.D0+MUT-XT),MUT,MUZ)))) + $ /2.D0/(1.D0-XT+MUT) + EMIN=XMIN*MG/2.D0 + EMAX=XMAX*MG/2.D0 + TOP=DMG**2-2*DMG*EMAX+DMT**2-DMT2**2 + BOT=DMG**2-2*DMG*EMIN+DMT**2-DMT2**2 + DXT11=-PI**2*DET*DLOG(TOP/BOT)/2.D0/(DMG**2-2*DMG*DET+DMT**2 + $ -DMT1**2) + SSGX11=DXT11 + RETURN + END diff --git a/ISAJET/isasusy/ssgx2.F b/ISAJET/isasusy/ssgx2.F new file mode 100644 index 00000000000..34a3f3dd1aa --- /dev/null +++ b/ISAJET/isasusy/ssgx2.F @@ -0,0 +1,42 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSGX2(ET) +C----------------------------------------------------------------------- +C SSGLBF: glss -> ziss + tp + tb +C Baer's XT2 - PHI- eq. a.6.b of prd45,142 (1992) +C Modified for t_1 and t_2 eigenstates +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" + REAL ET + DOUBLE PRECISION DET,DMG,DMT,DMZ,DMT1,DMT2,TOP,BOT,DXT2 + DOUBLE PRECISION XT,MUT,MUZ,XMIN,XMAX,EMIN,EMAX,SSDLAM,PI + DATA PI/3.14159265D0/ + DET=ET + DMG=TMP(1) + DMT=TMP(2) + DMZ=TMP(3) + DMT1=TMP(4) + DMT2=TMP(5) + XT=2*DET/DMG + MUT=(DMT/DMG)**2 + MUZ=(DMZ/DMG)**2 + XMIN=((2.D0-XT)*(1.D0+2*MUT-MUZ-XT)-DSQRT(DMAX1(0.D0, + $ (XT**2-4*MUT)*SSDLAM((1.D0+MUT-XT),MUT,MUZ)))) + $ /2.D0/(1.D0-XT+MUT) + XMAX=((2.D0-XT)*(1.D0+2*MUT-MUZ-XT)+DSQRT(DMAX1(0.D0, + $ (XT**2-4*MUT)*SSDLAM((1.D0+MUT-XT),MUT,MUZ)))) + $ /2.D0/(1.D0-XT+MUT) + EMIN=XMIN*DMG/2.D0 + EMAX=XMAX*DMG/2.D0 + TOP=DMG**2-2*DMG*EMAX+DMT**2-DMT2**2 + BOT=DMG**2-2*DMG*EMIN+DMT**2-DMT2**2 + DXT2=(-(EMAX-EMIN)-(2*DET*DMG+DMZ**2-DMT**2-DMT2**2)/2.D0/DMG* + $ DLOG(TOP/BOT))*PI**2/2.D0*DMG*DMZ/ + $ (DMG**2+DMT**2-DMT1**2-2*DMG*DET) + SSGX2=DXT2 + RETURN + END diff --git a/ISAJET/isasusy/ssgx3.F b/ISAJET/isasusy/ssgx3.F new file mode 100644 index 00000000000..e2d9510832f --- /dev/null +++ b/ISAJET/isasusy/ssgx3.F @@ -0,0 +1,32 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSGX3(ET) +C----------------------------------------------------------------------- +C SSGLBF: glss -> ziss + tp + tb +C Baer's XT3 - CHI- eq. a.6.c of prd45,142 (1992) +C Modified for t_1 and t_2 eigenstates +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" + REAL ET + DOUBLE PRECISION DET,DMG,DMT,DMZ,DMT1,DMT2,TOP,BOT + DOUBLE PRECISION PT,DXT3,SSDLAM,PI,TOPS + DATA PI/3.14159265D0/ + DET=ET + DMG=TMP(1) + DMT=TMP(2) + DMZ=TMP(3) + DMT1=TMP(4) + DMT2=TMP(5) + TOPS=SSDLAM(DMG**2+DMT**2-2*DMG*DET,DMT**2,DMZ**2) + TOP=DSQRT(DMAX1(1.D0,TOPS)) + BOT=(DMG**2+DMT**2-2*DMG*DET-DMT1**2)* + $ (DMG**2+DMT**2-2*DMG*DET-DMT2**2) + PT=DSQRT(DET**2-DMT**2) + DXT3=PI**2*DMG*DET*PT*TOP/BOT/(DMG**2-2*DMG*DET+DMT**2) + SSGX3=DXT3 + RETURN + END diff --git a/ISAJET/isasusy/ssgx4.F b/ISAJET/isasusy/ssgx4.F new file mode 100644 index 00000000000..68a0fe5d7f3 --- /dev/null +++ b/ISAJET/isasusy/ssgx4.F @@ -0,0 +1,41 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSGX4(ET) +C----------------------------------------------------------------------- +C SSGLBF: glss -> ziss + tp + tb +C Baer's XT4 - XI- eq. a.6.d of prd45,142 (1992) +C Modified for t_1 and t_2 eigenstates +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" + REAL ET + DOUBLE PRECISION DET,DMG,DMT,DMZ,DMT1,DMT2,TOP,BOT,DXT4 + DOUBLE PRECISION XT,MUT,MUZ,XMIN,XMAX,EMIN,EMAX,SSDLAM,PI + DATA PI/3.14159265D0/ + DET=ET + DMG=TMP(1) + DMT=TMP(2) + DMZ=TMP(3) + DMT1=TMP(4) + DMT2=TMP(5) + XT=2*ET/DMG + MUT=(DMT/DMG)**2 + MUZ=(DMZ/DMG)**2 + XMIN=((2.D0-XT)*(1.D0+2*MUT-MUZ-XT)-DSQRT(DMAX1(0.D0, + $ (XT**2-4*MUT)*SSDLAM((1.D0+MUT-XT),MUT,MUZ)))) + $ /2.D0/(1.D0-XT+MUT) + XMAX=((2.D0-XT)*(1.D0+2*MUT-MUZ-XT)+DSQRT(DMAX1(0.D0, + $ (XT**2-4*MUT)*SSDLAM((1.D0+MUT-XT),MUT,MUZ)))) + $ /2.D0/(1.D0-XT+MUT) + EMIN=XMIN*DMG/2.D0 + EMAX=XMAX*DMG/2.D0 + TOP=DMG**2-2*DMG*EMAX+DMT**2-DMT2**2 + BOT=DMG**2-2*DMG*EMIN+DMT**2-DMT2**2 + DXT4=(EMAX-EMIN-(DMG**2-2*DMG*DET+DMT2**2-DMT**2)/2.D0/DMG* + $ DLOG(TOP/BOT))*PI**2/2.D0/(DMG**2+DMT**2-2*DMG*DET-DMT1**2) + SSGX4=DXT4 + RETURN + END diff --git a/ISAJET/isasusy/ssgx5.F b/ISAJET/isasusy/ssgx5.F new file mode 100644 index 00000000000..9cb9498eaf5 --- /dev/null +++ b/ISAJET/isasusy/ssgx5.F @@ -0,0 +1,42 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSGX5(ET) +C----------------------------------------------------------------------- +C SSGLBF: glss -> ziss + tp + tb +C Baer's XT5 - RHO- eq. a.6.e of prd45,142 (1992) +C Modified for t_1 and t_2 eigenstates +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" + REAL ET + DOUBLE PRECISION DET,DMG,DMT,DMZ,DMT1,DMT2,TOP,BOT,DXT5 + DOUBLE PRECISION XT,MUT,MUZ,XMIN,XMAX,EMIN,EMAX,SSDLAM + DOUBLE PRECISION PI + DATA PI/3.14159265D0/ + DET=ET + DMG=TMP(1) + DMT=TMP(2) + DMZ=TMP(3) + DMT1=TMP(4) + DMT2=TMP(5) + XT=2*ET/DMG + MUT=(DMT/DMG)**2 + MUZ=(DMZ/DMG)**2 + XMIN=((2.D0-XT)*(1.D0+2*MUT-MUZ-XT)-DSQRT(DMAX1(0.D0, + $ (XT**2-4*MUT)*SSDLAM((1.D0+MUT-XT),MUT,MUZ)))) + $ /2.D0/(1.D0-XT+MUT) + XMAX=((2.D0-XT)*(1.D0+2*MUT-MUZ-XT)+DSQRT(DMAX1(0.D0, + $ (XT**2-4*MUT)*SSDLAM((1.D0+MUT-XT),MUT,MUZ)))) + $ /2.D0/(1.D0-XT+MUT) + EMIN=XMIN*DMG/2.D0 + EMAX=XMAX*DMG/2.D0 + TOP=DMG**2-2*DMG*EMAX+DMT**2-DMT2**2 + BOT=DMG**2-2*DMG*EMIN+DMT**2-DMT2**2 + DXT5=-PI**2*DLOG(TOP/BOT)/2.D0/DMG/(DMG**2-2*DMG*DET+DMT**2 + $ -DMT1**2) + SSGX5=DXT5 + RETURN + END diff --git a/ISAJET/isasusy/ssgx6.F b/ISAJET/isasusy/ssgx6.F new file mode 100644 index 00000000000..c353f437782 --- /dev/null +++ b/ISAJET/isasusy/ssgx6.F @@ -0,0 +1,41 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSGX6(ET) +C----------------------------------------------------------------------- +C SSGLBF: glss -> ziss + tp + tb +C Baer's XT6 - ZETA- eq. a.6.f of prd45,142 (1992) +C Modified for t_1 and t_2 eigenstates +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" + REAL ET + DOUBLE PRECISION DET,DMG,DMT,DMZ,DMT1,DMT2,T1,T2,DXT6 + DOUBLE PRECISION XT,MUT,MUZ,XMIN,XMAX,EMIN,EMAX,SSDLAM + DOUBLE PRECISION PI + DATA PI/3.14159265D0/ + DET=ET + DMG=TMP(1) + DMT=TMP(2) + DMZ=TMP(3) + DMT1=TMP(4) + DMT2=TMP(5) + XT=2*DET/DMG + MUT=(DMT/DMG)**2 + MUZ=(DMZ/DMG)**2 + XMIN=((2.D0-XT)*(1.D0+2*MUT-MUZ-XT)-DSQRT(DMAX1(0.D0, + $ (XT**2-4*MUT)*SSDLAM((1.D0+MUT-XT),MUT,MUZ)))) + $ /2.D0/(1.D0-XT+MUT) + XMAX=((2.D0-XT)*(1.D0+2*MUT-MUZ-XT)+DSQRT(DMAX1(0.D0, + $ (XT**2-4*MUT)*SSDLAM((1.D0+MUT-XT),MUT,MUZ)))) + $ /2.D0/(1.D0-XT+MUT) + EMIN=XMIN*DMG/2.D0 + EMAX=XMAX*DMG/2.D0 + T1=DMG**2+DMT**2-2*DMG*DET-DMT1**2 + T2=DMG**2+DMT**2-2*DMG*DET-DMT2**2 + DXT6=PI**2*(EMAX-EMIN)/T1/T2 + SSGX6=DXT6 + RETURN + END diff --git a/ISAJET/isasusy/ssgx7.F b/ISAJET/isasusy/ssgx7.F new file mode 100644 index 00000000000..0b07ce6ef3d --- /dev/null +++ b/ISAJET/isasusy/ssgx7.F @@ -0,0 +1,33 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSGX7(ET) +C----------------------------------------------------------------------- +C SSGLBF: glss -> ziss + tp + tb +C Baer's XT7 - X- eq. a.6.g of prd45,142 (1992) +C Modified for t_1 and t_2 eigenstates +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" + REAL ET + DOUBLE PRECISION DET,DMG,DMT,DMZ,DMT1,DMT2,TOP + DOUBLE PRECISION BOT,PT,DXT7,SSDLAM,PI,TOPS + DATA PI/3.14159265D0/ + DET=ET + DMG=TMP(1) + DMT=TMP(2) + DMZ=TMP(3) + DMT1=TMP(4) + DMT2=TMP(5) + PT=DSQRT(DET**2-DMT**2) + TOPS=SSDLAM(DMG**2+DMT**2-2*DMG*DET,DMT**2,DMZ**2) + TOP=DSQRT(DMAX1(0.D0,TOPS)) + BOT=(DMG**2+DMT**2-2*DMG*DET-DMT1**2)* + $ (DMG**2+DMT**2-2*DMG*DET-DMT2**2) + DXT7=PI**2/2.D0*PT*(DMG**2-DMZ**2-2*DMG*DET)/ + $ (DMG**2-2*DMG*DET+DMT**2)*TOP/BOT + SSGX7=DXT7 + RETURN + END diff --git a/ISAJET/isasusy/ssgx8.F b/ISAJET/isasusy/ssgx8.F new file mode 100644 index 00000000000..7a945a7e8c2 --- /dev/null +++ b/ISAJET/isasusy/ssgx8.F @@ -0,0 +1,44 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSGX8(ET) +C----------------------------------------------------------------------- +C SSGLBF: glss -> ziss + tp + tb +C Baer's XT8 - Y- eq. a.6.h of prd45,142 (1992) +C Modified for t_1 and t_2 eigenstates +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" + REAL ET + DOUBLE PRECISION DET,DMG,DMT,DMZ,DMT1,DMT2,TOP,BOT,DXT8 + DOUBLE PRECISION XT,MUT,MUZ,XMIN,XMAX,EMIN,EMAX,SSDLAM + DOUBLE PRECISION PI + DATA PI/3.14159265D0/ + DET=ET + DMG=TMP(1) + DMT=TMP(2) + DMZ=TMP(3) + DMT1=TMP(4) + DMT2=TMP(5) + XT=2*DET/DMG + MUT=(DMT/DMG)**2 + MUZ=(DMZ/DMG)**2 + XMIN=((2.D0-XT)*(1.D0+2*MUT-MUZ-XT)-DSQRT(DMAX1(0.D0, + $ (XT**2-4*MUT)*SSDLAM((1.D0+MUT-XT),MUT,MUZ)))) + $ /2.D0/(1.D0-XT+MUT) + XMAX=((2.D0-XT)*(1.D0+2*MUT-MUZ-XT)+DSQRT(DMAX1(0.D0, + $ (XT**2-4*MUT)*SSDLAM((1.D0+MUT-XT),MUT,MUZ)))) + $ /2.D0/(1.D0-XT+MUT) + EMIN=XMIN*DMG/2.D0 + EMAX=XMAX*DMG/2.D0 + TOP=DMG**2-2*DMG*EMAX+DMT**2-DMT2**2 + BOT=DMG**2-2*DMG*EMIN+DMT**2-DMT2**2 + DXT8=((EMAX-EMIN)*(DMG**2-2*DMG*DET+DMT**2)+ + $ (DMZ**2*DMG**2-DMT2**2*DMG**2+2*DMT2**2*DMG*DET+DMT**4 + $ -DMT2**2*DMT**2)/2.D0/DMG*DLOG(TOP/BOT))*PI**2/2.D0/ + $ (DMG**2+DMT**2-2*DMG*DET-DMT1**2) + SSGX8=DXT8 + RETURN + END diff --git a/ISAJET/isasusy/ssgx9.F b/ISAJET/isasusy/ssgx9.F new file mode 100644 index 00000000000..09bd5b6e85f --- /dev/null +++ b/ISAJET/isasusy/ssgx9.F @@ -0,0 +1,42 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSGX9(ET) +C----------------------------------------------------------------------- +C SSGLBF: glss -> ziss + tp + tb +C Baer's XT9 - XI'- eq. a.6.i of prd45,142 (1992) +C Modified for t_1 and t_2 eigenstates +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" + REAL ET + DOUBLE PRECISION DET,DMG,DMT,DMZ,DMT1,DMT2,TOP,BOT,DXT9 + DOUBLE PRECISION XT,MUT,MUZ,XMIN,XMAX,EMIN,EMAX,SSDLAM + DOUBLE PRECISION PI + DATA PI/3.14159265D0/ + DET=ET + DMG=TMP(1) + DMT=TMP(2) + DMZ=TMP(3) + DMT1=TMP(4) + DMT2=TMP(5) + XT=2*DET/DMG + MUT=(DMT/DMG)**2 + MUZ=(DMZ/DMG)**2 + XMIN=((2.D0-XT)*(1.D0+2*MUT-MUZ-XT)-DSQRT(DMAX1(0.D0, + $ (XT**2-4*MUT)*SSDLAM((1.D0+MUT-XT),MUT,MUZ)))) + $ /2.D0/(1.D0-XT+MUT) + XMAX=((2.D0-XT)*(1.D0+2*MUT-MUZ-XT)+DSQRT(DMAX1(0.D0, + $ (XT**2-4*MUT)*SSDLAM((1.D0+MUT-XT),MUT,MUZ)))) + $ /2.D0/(1.D0-XT+MUT) + EMIN=XMIN*DMG/2.D0 + EMAX=XMAX*DMG/2.D0 + TOP=DMG**2-2*DMG*EMAX+DMT**2-DMT1**2 + BOT=DMG**2-2*DMG*EMIN+DMT**2-DMT1**2 + DXT9=-PI**2*DET*DLOG(TOP/BOT)/2.D0/(DMG**2-2*DMG*DET+DMT**2 + $ -DMT2**2) + SSGX9=DXT9 + RETURN + END diff --git a/ISAJET/isasusy/ssgzg1.F b/ISAJET/isasusy/ssgzg1.F new file mode 100644 index 00000000000..3aa0a1d28e5 --- /dev/null +++ b/ISAJET/isasusy/ssgzg1.F @@ -0,0 +1,27 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSGZG1(XARG) +C----------------------------------------------------------------------- +C SSGLBF: glss -> ziss + gl +C Baer's FUNI- removed mass dependence to simplify +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" + REAL XARG + DOUBLE PRECISION TOP,BOT,XX,F,MQ,MX,MS,MG +C + MQ=TMP(1) + MX=TMP(2) + MS=TMP(3) + MG=AMGLSS +C + XX=XARG + TOP=-MG**2*XX*(1.D0-XX)+MS**2*XX+MQ**2*(1.D0-XX) + BOT=-MX**2*XX*(1.D0-XX)+MS**2*XX+MQ**2*(1.D0-XX) + F=DLOG(TOP/BOT)/XX + SSGZG1=F + RETURN + END diff --git a/ISAJET/isasusy/ssgzg2.F b/ISAJET/isasusy/ssgzg2.F new file mode 100644 index 00000000000..8d5d5568eb6 --- /dev/null +++ b/ISAJET/isasusy/ssgzg2.F @@ -0,0 +1,27 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSGZG2(XARG) +C----------------------------------------------------------------------- +C SSGLBF: glss -> ziss + gl +C Baer's FUNI1- removed masses to simplify +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" + REAL XARG + DOUBLE PRECISION TOP,BOT,XX,F,MQ,MX,MS,MG +C + MQ=TMP(1) + MX=TMP(2) + MS=TMP(3) + MG=AMGLSS +C + XX=XARG + TOP=-MG**2*XX*(1.D0-XX)+MS**2*XX+MQ**2*(1.D0-XX) + BOT=-MX**2*XX*(1.D0-XX)+MS**2*XX+MQ**2*(1.D0-XX) + F=DLOG(TOP/BOT) + SSGZG2=F + RETURN + END diff --git a/ISAJET/isasusy/ssgzg3.F b/ISAJET/isasusy/ssgzg3.F new file mode 100644 index 00000000000..6361a5d2312 --- /dev/null +++ b/ISAJET/isasusy/ssgzg3.F @@ -0,0 +1,27 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSGZG3(XARG) +C----------------------------------------------------------------------- +C SSGLBF: glss -> ziss + gl +C Baer's FUNK - remove masses to simplify +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" + REAL XARG + DOUBLE PRECISION TOP,BOT,XX,F,MQ,MX,MS,MG +C + MQ=TMP(1) + MX=TMP(2) + MS=TMP(3) + MG=AMGLSS +C + XX=XARG + TOP=-MG**2*XX*(1.D0-XX)+MS**2*XX+MQ**2*(1.D0-XX) + BOT=-MX**2*XX*(1.D0-XX)+MS**2*XX+MQ**2*(1.D0-XX) + F=-1.D0-BOT/(MG**2-MX**2)/XX/(1.D0-XX)*DLOG(TOP/BOT) + SSGZG3=F + RETURN + END diff --git a/ISAJET/isasusy/ssgzt.F b/ISAJET/isasusy/ssgzt.F new file mode 100644 index 00000000000..0474cc30181 --- /dev/null +++ b/ISAJET/isasusy/ssgzt.F @@ -0,0 +1,46 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSGZT(E) +C----------------------------------------------------------------------- +C SSGLBF: glss -> ziss + tp + tb +C Baer's TOPINT +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" +C + REAL E + DOUBLE PRECISION MG,MT,MS,MZ,SSDLAM,P,PSI,XLOG,PHI,SN,C1,C2 + DOUBLE PRECISION XT,MUT,MUZ,XMIN,XMAX,EMIN,EMAX +C Convert to double precision + MG=AMGLSS + C1=TMP(1) + C2=TMP(2) + MS=TMP(3) + MT=TMP(4) + MZ=TMP(5) + SN=TMP(6) +C + XT=2*E/MG + MUT=(MT/MG)**2 + MUZ=(MZ/MG)**2 + XMIN=((2.D0-XT)*(1.D0+2*MUT-MUZ-XT)-DSQRT((XT**2-4*MUT)* + $SSDLAM((1.D0+MUT-XT),MUT,MUZ)))/2.D0/(1.D0-XT+MUT) + XMAX=((2.D0-XT)*(1.D0+2*MUT-MUZ-XT)+DSQRT((XT**2-4*MUT)* + $SSDLAM((1.D0+MUT-XT),MUT,MUZ)))/2.D0/(1.D0-XT+MUT) + EMIN=XMIN*MG/2.D0 + EMAX=XMAX*MG/2.D0 + P=SQRT(E**2-MT**2) + PSI=P*E*(MG**2-MZ**2-2*MG*E)* + $DSQRT(SSDLAM((MG**2+MT**2-2*MG*E),MZ**2,MT**2))/MG/ + $(MG**2+MT**2-2*MG*E)/(MG**2+MT**2-2*MG*E-MS**2)**2 + XLOG=DLOG((MG**2+MT**2-2*MG*EMAX-MS**2)/ + $(MG**2+MT**2-2*MG*EMIN-MS**2)) + PHI=MZ*(-(EMAX-EMIN)-(2*E*MG+MZ**2-MT**2-MS**2)* + $XLOG/2.D0/MG)/ + $2.D0/MG/(MG**2+MT**2-MS**2-2*MG*E) + SSGZT=C1*PSI+SN*C2*PHI + RETURN + END diff --git a/ISAJET/isasusy/sshcc.F b/ISAJET/isasusy/sshcc.F new file mode 100644 index 00000000000..e11466bf73a --- /dev/null +++ b/ISAJET/isasusy/sshcc.F @@ -0,0 +1,147 @@ +#include "isajet/pilot.h" + SUBROUTINE SSHCC +C----------------------------------------------------------------------- +C Calculates the decay widths of all neutral Higgses into all +C possible pairs of charginos. +C +C Bisset's CHGINO +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sspar.inc" +#include "isajet/sssm.inc" +#include "isajet/sstype.inc" +C + DOUBLE PRECISION PI,SR2,XM,THETX,YM,THETY,SGL,CGL,SGR,CGR + $,MW1,MW2,THETM,THETP,G2,GP2,BETA,ALPHA,T1,MH,M1,M2,LAMB + $,DWID,TEMP,TEMPXY + DOUBLE PRECISION MHI(3),IDHI(3),SHP(3),SHM(3),SH(3),PH(3) + DOUBLE PRECISION SSDLAM + REAL WID + INTEGER NUMH,IDHHA +C + PI=4.*ATAN(1.D0) + SR2=SQRT(2.D0) + XM=1./TAN(GAMMAL) + THETX=SIGN(1.D0,XM) + YM=1./TAN(GAMMAR) + THETY=SIGN(1.D0,YM) + SGL=1/(DSQRT(1+XM**2)) + CGL=SGL*XM + SGR=1/(DSQRT(1+YM**2)) + CGR=SGR*YM + MW1=DBLE(ABS(AMW1SS)) + MW2=DBLE(ABS(AMW2SS)) + THETM=SIGN(1.,AMW1SS) + THETP=SIGN(1.,AMW2SS) + G2=4*PI*ALFAEM/SN2THW + GP2=4*PI*ALFAEM/(1-SN2THW) + BETA=ATAN(1.0/RV2V1) + ALPHA=ALFAH +C +C Arrays for loops +C + MHI(1)=AMHL + MHI(2)=AMHH + MHI(3)=AMHA + IDHI(1)=ISHL + IDHI(2)=ISHH + IDHI(3)=ISHA +C The following came from Bisset's MASZIN, but with L,H,P +C replaced by a generic H and a subscript. + TEMPXY=0.5*THETX*THETY*(-THETP) + SHP(1)=SIN(ALPHA)*CGR*SGL+COS(ALPHA)*CGL*SGR + SHP(1)=SHP(1)*TEMPXY + SHM(1)=SIN(ALPHA)*SGR*CGL+COS(ALPHA)*SGL*CGR + SHM(1)=SHM(1)*0.5*THETM + SH(1)=-THETX*SGR*SGL*SIN(ALPHA)*THETM + PH(1)=-SH(1) + T1=THETX*CGL*CGR*COS(ALPHA)*THETM + SH(1)=SH(1)+T1 + PH(1)=PH(1)-T1 + T1=THETY*SGL*SGR*COS(ALPHA)*THETP + SH(1)=SH(1)-T1 + PH(1)=PH(1)-T1 + T1=THETY*CGL*CGR*SIN(ALPHA)*THETP + SH(1)=SH(1)+T1 + PH(1)=PH(1)+T1 + SH(1)=0.5*SH(1) + PH(1)=0.5*PH(1) + SHP(2)=COS(ALPHA)*CGR*SGL-SIN(ALPHA)*CGL*SGR + SHP(2)=SHP(2)*TEMPXY + SHM(2)=COS(ALPHA)*SGR*CGL-SIN(ALPHA)*SGL*CGR + SHM(2)=SHM(2)*0.5*THETM + SH(2)=-THETX*SGR*SGL*COS(ALPHA)*THETM + PH(2)=-SH(2) + T1=THETX*CGL*CGR*SIN(ALPHA)*THETM + SH(2)=SH(2)-T1 + PH(2)=PH(2)+T1 + T1=THETY*SGL*SGR*SIN(ALPHA)*THETP + SH(2)=SH(2)+T1 + PH(2)=PH(2)+T1 + T1=THETY*CGL*CGR*COS(ALPHA)*THETP + SH(2)=SH(2)+T1 + PH(2)=PH(2)+T1 + SH(2)=0.5*SH(2) + PH(2)=0.5*PH(2) + SHP(3)=SIN(BETA)*CGR*SGL+COS(BETA)*CGL*SGR + SHP(3)=SHP(3)*0.5*THETX*THETY*(-THETP) + SHM(3)=SIN(BETA)*SGR*CGL+COS(BETA)*SGL*CGR + SHM(3)=SHM(3)*0.5*THETM + SH(3)=-THETX*SGR*SGL*SIN(BETA)*THETM + PH(3)=-SH(3) + T1=THETX*CGL*CGR*COS(BETA)*THETM + SH(3)=SH(3)+T1 + PH(3)=PH(3)-T1 + T1=THETY*SGL*SGR*COS(BETA)*THETP + SH(3)=SH(3)+T1 + PH(3)=PH(3)+T1 + T1=THETY*CGL*CGR*SIN(BETA)*THETP + SH(3)=SH(3)-T1 + PH(3)=PH(3)-T1 + SH(3)=0.5*SH(3) + PH(3)=0.5*PH(3) +C +C Loop over neutral Higgs +C + DO 100 NUMH=1,3 + MH=MHI(NUMH) + IDHHA=IDHI(NUMH) +C w1 + w1 + M1=ABS(AMW1SS) + M2=M1 + IF(MH.GT.M1+M2) THEN + LAMB=SSDLAM(MH**2,M1**2,M2**2) + TEMP=1-4*M1**2/MH**2 + DWID=G2*MH*SHM(NUMH)**2/(4.0*PI) + DWID=DWID*SQRT(TEMP**3) + WID=DWID + CALL SSSAVE(IDHHA,WID,ISW1,-ISW1,0,0,0) + ENDIF +C w2 + w2 + M1=ABS(AMW2SS) + M2=M1 + IF(MH.GT.M1+M2) THEN + TEMP=1-4*M1**2/MH**2 + DWID=G2*MH*SHP(NUMH)**2/(4*PI) + DWID=DWID*SQRT(TEMP**3) + WID=DWID + CALL SSSAVE(IDHHA,WID,ISW2,-ISW2,0,0,0) + ENDIF +C w1 + w2 + M1=ABS(AMW1SS) + M2=ABS(AMW2SS) + IF(MH.GT.M1+M2) THEN + LAMB=SSDLAM(MH**2,M1**2,M2**2) + DWID=PH(NUMH)**2*(MH**2-(M1-M2)**2) + DWID=DWID+SH(NUMH)**2*(MH**2-(M1+M2)**2) + DWID=DWID*G2*SQRT(LAMB)/(16.0*PI*(MH**3)) + WID=DWID + CALL SSSAVE(IDHHA,WID,ISW1,-ISW2,0,0,0) + CALL SSSAVE(IDHHA,WID,-ISW1,ISW2,0,0,0) + ENDIF +100 CONTINUE +C + RETURN + END diff --git a/ISAJET/isasusy/sshff.F b/ISAJET/isasusy/sshff.F new file mode 100644 index 00000000000..4cadd7704c5 --- /dev/null +++ b/ISAJET/isasusy/sshff.F @@ -0,0 +1,186 @@ +#include "isajet/pilot.h" + SUBROUTINE SSHFF +C----------------------------------------------------------------------- +C +C Calculate all decays higgs -> f fbar, including QCD radiative +C corrections for quarks. +C +C Bisset's SETFAC, WDHFFN, QCDRAD +C +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sslun.inc" +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstype.inc" +C + DOUBLE PRECISION PI,SR2,G2,DWID,MHIH,BETA,BEFAC,ALFAC,MH,MF + $,MFRUN,FACTOR,ALAM,MF1,MF2,SUM,MF1RUN,MF2RUN,COLOR,TEMP1 + $,QCDFAC + DOUBLE PRECISION MFIFF(9),MFIF1(6),MFIF2(6) + DOUBLE PRECISION SSDLAM,SSMQCD,SSHFF1 + REAL WID + INTEGER IH,IDIH,IFF,IDF,ID1,ID2 + INTEGER IDIFF(9),IDIF1(6),IDIF2(6) +C + PI=4.*ATAN(1.) + SR2=SQRT(2.) + BETA=ATAN(1./RV2V1) + G2=4.0*PI*ALFAEM/SN2THW +C +C Loop over HL, HH, HA and fermions +C + MFIFF(1)=AME + IDIFF(1)=IDE + MFIFF(2)=AMMU + IDIFF(2)=IDMU + MFIFF(3)=AMTAU + IDIFF(3)=IDTAU + MFIFF(4)=AMDN + IDIFF(4)=IDDN + MFIFF(5)=AMST + IDIFF(5)=IDST + MFIFF(6)=AMBT + IDIFF(6)=IDBT + MFIFF(7)=AMUP + IDIFF(7)=IDUP + MFIFF(8)=AMCH + IDIFF(8)=IDCH + MFIFF(9)=AMTP + IDIFF(9)=IDTP +C + DO 100 IH=1,3 + IF(IH.EQ.1) THEN + MH=AMHL + IDIH=ISHL + BEFAC=COS(BETA) + ALFAC=SIN(ALFAH) + ELSEIF(IH.EQ.2) THEN + MH=AMHH + IDIH=ISHH + BEFAC=COS(BETA) + ALFAC=COS(ALFAH) + ELSE + MH=AMHA + IDIH=ISHA + BEFAC=1/TAN(BETA) + ALFAC=1. + ENDIF +C +C Down type fermions +C + DO 110 IFF=1,6 + MF=MFIFF(IFF) + IDF=IDIFF(IFF) + FACTOR=1.-4.*MF**2/MH**2 + IF(FACTOR.LE.0) GO TO 110 + FACTOR=SQRT(FACTOR) + IF(IFF.GE.4) THEN + COLOR=3. + MFRUN=SSMQCD(MF,MH) + QCDFAC=SSHFF1(MH,MF,IH) + ELSE + COLOR=1. + MFRUN=MF + QCDFAC=1. + ENDIF + DWID=G2*MFRUN**2*MH*ALFAC**2/(32.*PI*AMW**2*BEFAC**2) + IF(IH.EQ.1.OR.IH.EQ.2) THEN + DWID=DWID*FACTOR**3 + ELSEIF(IH.EQ.3) THEN + DWID=DWID*FACTOR + ENDIF + DWID=DWID*COLOR*QCDFAC + WID=DWID + CALL SSSAVE(IDIH,WID,IDF,-IDF,0,0,0) +110 CONTINUE +C +C Up type fermions +C + IF(IH.EQ.1) THEN + BEFAC=SIN(BETA) + ALFAC=COS(ALFAH) + ELSEIF(IH.EQ.2) THEN + BEFAC=SIN(BETA) + ALFAC=SIN(ALFAH) + ELSE + BEFAC=TAN(BETA) + ALFAC=1. + ENDIF + DO 120 IFF=7,9 + MF=MFIFF(IFF) + IDF=IDIFF(IFF) + FACTOR=1.-4.*MF**2/MH**2 + IF(FACTOR.LE.0) GO TO 120 + FACTOR=SQRT(FACTOR) + MFRUN=SSMQCD(MF,MH) + QCDFAC=SSHFF1(MH,MF,IH) + DWID=G2*MFRUN**2*MH*ALFAC**2/(32.*PI*AMW**2*BEFAC**2) + IF(IH.EQ.1.OR.IH.EQ.2) THEN + DWID=DWID*FACTOR**3 + ELSEIF(IH.EQ.3) THEN + DWID=DWID*FACTOR + ENDIF + DWID=3.*DWID*QCDFAC + WID=DWID + CALL SSSAVE(IDIH,WID,IDF,-IDF,0,0,0) +120 CONTINUE +100 CONTINUE +C +C HC decays. F1 has Iz=+1/2, F2 has Iz=-1/2 +C + MFIF1(1)=0 + IDIF1(1)=IDNE + MFIF2(1)=AME + IDIF2(1)=IDE + MFIF1(2)=0 + IDIF1(2)=IDNM + MFIF2(2)=AMMU + IDIF2(2)=IDMU + MFIF1(3)=0 + IDIF1(3)=IDNT + MFIF2(3)=AMTAU + IDIF2(3)=IDTAU + MFIF1(4)=AMUP + IDIF1(4)=IDUP + MFIF2(4)=AMDN + IDIF2(4)=IDDN + MFIF1(5)=AMCH + IDIF1(5)=IDCH + MFIF2(5)=AMST + IDIF2(5)=IDST + MFIF1(6)=AMTP + IDIF1(6)=IDTP + MFIF2(6)=AMBT + IDIF2(6)=IDBT + MH=AMHC +C + DO 200 IFF=1,6 + MF1=MFIF1(IFF) + MF2=MFIF2(IFF) + ID1=IDIF1(IFF) + ID2=IDIF2(IFF) + SUM=MF1+MF2 + ALAM=SSDLAM(MH**2,MF1**2,MF2**2) + IF(ALAM.LE.0.OR.SUM.GE.MH) GO TO 200 + IF(IFF.LE.3) THEN + MF1RUN=MF1 + MF2RUN=MF2 + COLOR=1 + ELSE + MF1RUN=SSMQCD(MF1,MH) + MF2RUN=SSMQCD(MF2,MH) + COLOR=3 + ENDIF + TEMP1=MF1RUN**2*1./TAN(BETA)**2+MF2RUN**2*TAN(BETA)**2 + TEMP1=TEMP1*(MH**2-MF1**2-MF2**2)-4.*MF1**2*MF2**2 + IF (TEMP1.LT.0.0) GO TO 200 + DWID=G2*COLOR*SQRT(ALAM)*TEMP1/MH**3/(32.0*PI*AMW**2) + WID=DWID + CALL SSSAVE(ISHC,WID,ID1,-ID2,0,0,0) +200 CONTINUE +C + RETURN + END diff --git a/ISAJET/isasusy/sshff1.F b/ISAJET/isasusy/sshff1.F new file mode 100644 index 00000000000..369020b9289 --- /dev/null +++ b/ISAJET/isasusy/sshff1.F @@ -0,0 +1,50 @@ +#include "isajet/pilot.h" + DOUBLE PRECISION FUNCTION SSHFF1(MH,MF,NUMH) +C----------------------------------------------------------------------- +C Calculate QCD radiative correction factor, the square brackets +C in (4.5) of Drees and Hikasa, Phys. Lett. B240, 455 (1990). +C +C Bisset's QCDRAD (partial) +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +C + DOUBLE PRECISION MH,MF + DOUBLE PRECISION BETA00,LIXX,LI2PP,LI2MM,TEMP,DELTAP,AS,CF + $,INPOL,PI,ACAP,DELTAH + DOUBLE PRECISION DDILOG,SSALFS + INTEGER NUMH +C + PI=4*ATAN(1.D0) + BETA00=SQRT(1-4*MF**2/MH**2) + LIXX=(1-BETA00)/(1+BETA00) + LI2PP=DDILOG(LIXX) + LI2MM=DDILOG(-LIXX) + TEMP=-3*LOG(1/LIXX)*LOG(2/(1+BETA00)) + TEMP=TEMP-2*LOG(BETA00)*LOG(1/LIXX) + TEMP=TEMP+4*LI2PP+2*LI2MM + ACAP=(1+BETA00**2)*TEMP + ACAP=ACAP-3*BETA00*LOG(4/(1-BETA00**2)) + ACAP=ACAP-4*BETA00*LOG(BETA00) + IF (NUMH.EQ.3) THEN + TEMP=19+2*BETA00**2+3*BETA00**4 + TEMP=TEMP*LOG(1/LIXX)/(16*BETA00) + DELTAP=TEMP+3*(7-BETA00**2)/8 + DELTAP=DELTAP+ACAP/BETA00 + ELSE + TEMP=3+34*BETA00**2-13*BETA00**4 + TEMP=TEMP*LOG(1/LIXX)/(16*BETA00**3) + DELTAH=3*(-1+7*BETA00**2)/(8*BETA00**2) + DELTAH=DELTAH+TEMP+ACAP/BETA00 + ENDIF + IF (NUMH.EQ.3) THEN + INPOL=DELTAP+1.5D0*LOG(MH**2/MF**2) + ELSE + INPOL=DELTAH+1.5D0*LOG(MH**2/MF**2) + ENDIF + AS=SSALFS(MH**2) + CF=4.D0/3.D0 + SSHFF1=INPOL*CF*AS/PI+1 + RETURN + END diff --git a/ISAJET/isasusy/sshgl.F b/ISAJET/isasusy/sshgl.F new file mode 100644 index 00000000000..0232d6671e1 --- /dev/null +++ b/ISAJET/isasusy/sshgl.F @@ -0,0 +1,330 @@ +#include "isajet/pilot.h" + SUBROUTINE SSHGL +C----------------------------------------------------------------------- +C +C Calculate H -> gl gl decays including both SM particles and +C SUSY particles in loop. +C +C This subroutine uses the tau variable of the Higgs Hunters' +C Guide. Many other authors, including the paper cited in +C Higgs Hunters' Guide (PR. D. 38(11): 3481) and Collider Physics +C by Barger and Phillips use the variable lambda +C LAMBDA = ( MASS OF PARTICLE IN LOOP / MASS OF HIGGS )**2 +C TAU = 4.0 * LAMBDA +C +C Bisset's HGLGL +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstype.inc" +C + DOUBLE PRECISION ETAH,IITOT,RITOT,TAU,IFFF,RFFF + $,IFHALF,RFHALF,IF1,RF1,IF0,RF0,TW2,RHF,RHSF,RHSFL,RHSFR + $,IIHF,RIHF,IIHSFL,RIHSFL,IIHSFR,RIHSFR,AS,SUMISQ,DW + $,RHSF1,RHSF2,IIHSF1,IIHSF2,RIHSF1,RIHSF2 + DOUBLE PRECISION PI,SR2,XM,THETX,YM,THETY,SGL,CGL,SGR,CGR + $,MW1,MW2,THETM,THETP,G2,BETA,ALPHA,SW2,CW2,MH,AMSQ + DOUBLE PRECISION MFL(3),MFD(3),MFU(3) + DOUBLE PRECISION SSALFS + REAL WID + REAL ASMB,MBMB,MBQ,ASMT,MTMT,MTQ,SUALFS + DOUBLE PRECISION SSMQCD + INTEGER IJ,II,NUMOUT,NUMH,IDHHA +C +C Mass matrix parameters +C + PI=4.*ATAN(1.D0) + SR2=SQRT(2.D0) + XM=1./TAN(GAMMAL) + THETX=SIGN(1.D0,XM) + YM=1./TAN(GAMMAR) + THETY=SIGN(1.D0,YM) + SGL=1/(DSQRT(1+XM**2)) + CGL=SGL*XM + SGR=1/(DSQRT(1+YM**2)) + CGR=SGR*YM + MW1=DBLE(ABS(AMW1SS)) + MW2=DBLE(ABS(AMW2SS)) + THETM=SIGN(1.,AMW1SS) + THETP=SIGN(1.,AMW2SS) + G2=4.0*PI*ALFAEM/SN2THW + BETA=ATAN(1.0/RV2V1) + ALPHA=ALFAH + SW2=SN2THW + CW2=1.-SN2THW +C +C Loop over neutral Higgs bosons +C + DO 100 NUMH=1,3 + IF(NUMH.EQ.1) THEN + MH=AMHL + IDHHA=ISHL + ELSEIF(NUMH.EQ.2) THEN + MH=AMHH + IDHHA=ISHH + ELSE + MH=AMHA + IDHHA=ISHA + ENDIF + ETAH=1.0 + IITOT=0.0 + RITOT=0.0 +C + ASMB=SUALFS(AMBT**2,.36,AMTP,3) + MBMB=AMBT*(1.-4*ASMB/3./PI) + MBQ=SSMQCD(DBLE(MBMB),DBLE(MH)) + ASMT=SUALFS(AMTP**2,.36,AMTP,3) + MTMT=AMTP/(1.+4*ASMT/3./PI+(16.11-1.04*(5.-6.63/AMTP))* + $(ASMT/PI)**2) + MTQ=SSMQCD(DBLE(MTMT),DBLE(MH)) + +C + MFL(1)=DBLE(AME) + MFL(2)=DBLE(AMMU) + MFL(3)=DBLE(AMTAU) + MFD(1)=DBLE(AMDN) + MFD(2)=DBLE(AMST) + MFD(3)=DBLE(MBQ) + MFU(1)=DBLE(AMUP) + MFU(2)=DBLE(AMCH) + MFU(3)=DBLE(MTQ) +C +C +C Down-type quark loops +C + DO 20 II=1,3 + TAU=4.0*MFD(II)**2/MH**2 + CALL SSHGM1(TAU,IFFF,RFFF) + IFHALF=0.5*TAU*(1.0-TAU*ETAH)*IFFF + RFHALF=0.5*TAU*(ETAH+(1.0-TAU*ETAH)*RFFF) + IF(NUMH.EQ.1) THEN + RHF=SIN(ALPHA)/COS(BETA) + ELSEIF(NUMH.EQ.2) THEN + RHF=COS(ALPHA)/COS(BETA) + ELSE + RHF=TAN(BETA) + ENDIF + IIHF=RHF*IFHALF + RIHF=RHF*RFHALF + IITOT=IITOT+IIHF + RITOT=RITOT+RIHF +20 CONTINUE +C +C Up-type quark loops +C + DO 30 II=1,2 + TAU=4.0*MFU(II)**2/MH**2 + CALL SSHGM1(TAU,IFFF,RFFF) + IFHALF=0.5*TAU*(1.0-TAU*ETAH)*IFFF + RFHALF=0.5*TAU*(ETAH+(1.0-TAU*ETAH)*RFFF) + IF(NUMH.EQ.1) THEN + RHF=COS(ALPHA)/SIN(BETA) + ELSEIF(NUMH.EQ.2) THEN + RHF=-SIN(ALPHA)/SIN(BETA) + ELSE + RHF=TAN(BETA) + ENDIF + IIHF=RHF*IFHALF + RIHF=RHF*RFHALF + IITOT=IITOT+IIHF + RITOT=RITOT+RIHF +30 CONTINUE +C + TAU=4.0*MTQ**2/MH**2 + CALL SSHGM1(TAU,IFFF,RFFF) + IFHALF=0.5*TAU*(1.0-TAU*ETAH)*IFFF + RFHALF=0.5*TAU*(ETAH+(1.0-TAU*ETAH)*RFFF) + IF(NUMH.EQ.1) THEN + RHF=COS(ALPHA)/SIN(BETA) + ELSEIF(NUMH.EQ.2) THEN + RHF=-SIN(ALPHA)/SIN(BETA) + ELSE + RHF=1.0/TAN(BETA) + ENDIF + IIHF=RHF*IFHALF + RIHF=RHF*RFHALF + IITOT=IITOT+IIHF + RITOT=RITOT+RIHF +C +C Down-type squark loops +C Mixing between the sbottom squarks is included, so +C masses used here are the mixed masses (AMB1SS & AMB2SS) +C First do d_L and s_L squarks + TW2=SW2/CW2 + DO 50 II=1,2 + IF(NUMH.EQ.1) THEN + RHSF=2.0*(MFD(II)/AMW)**2*SIN(ALPHA)/COS(BETA) + RHSFL=(-1.0-TW2/3.0)*SIN(BETA-ALPHA)-RHSF + ELSEIF(NUMH.EQ.2) THEN + RHSF=2.0*(MFD(II)/AMW)**2*COS(ALPHA)/COS(BETA) + RHSFL=(-1.0-TW2/3.0)*(-1.0)*COS(BETA-ALPHA)-RHSF + ELSE + RHSF=0 + RHSFL=0 + ENDIF + IF (II.EQ.1) AMSQ=AMDLSS + IF (II.EQ.2) AMSQ=AMSLSS + TAU=4.0*AMSQ**2/MH**2 + CALL SSHGM1(TAU,IFFF,RFFF) + IF0=-TAU*TAU*IFFF + RF0=TAU*(1.0-TAU*RFFF) + IIHSFL=RHSFL*IF0*(AMW/AMSQ)**2/8.0 + RIHSFL=RHSFL*RF0*(AMW/AMSQ)**2/8.0 + IITOT=IITOT+IIHSFL + RITOT=RITOT+RIHSFL +50 CONTINUE +c Next, do R squarks + DO 51 II=1,2 + IF(NUMH.EQ.1) THEN + RHSF=2.0*(MFD(II)/AMW)**2*SIN(ALPHA)/COS(BETA) + RHSFR=(-2.0*TW2/3.0)*SIN(BETA-ALPHA)-RHSF + ELSEIF(NUMH.EQ.2) THEN + RHSF=2.0*(MFD(II)/AMW)**2*COS(ALPHA)/COS(BETA) + RHSFR=(-2.0*TW2/3.0)*(-1.0)*COS(BETA-ALPHA)-RHSF + ELSE + RHSF=0 + RHSFR=0 + ENDIF + IF (II.EQ.1) AMSQ=AMDRSS + IF (II.EQ.2) AMSQ=AMSRSS + TAU=4.0*AMSQ**2/MH**2 + CALL SSHGM1(TAU,IFFF,RFFF) + IF0=-TAU*TAU*IFFF + RF0=TAU*(1.0-TAU*RFFF) + IIHSFR=RHSFR*IF0*(AMW/AMSQ)**2/8.0 + RIHSFR=RHSFR*RF0*(AMW/AMSQ)**2/8.0 + IITOT=IITOT+IIHSFR + RITOT=RITOT+RIHSFR +51 CONTINUE + IF(NUMH.EQ.1) THEN + RHSF=2.0*(MBQ/AMW)**2*SIN(ALPHA)/COS(BETA) + RHSFL=(-1.0-TW2/3.0)*SIN(BETA-ALPHA)-RHSF + RHSFR=(-2.0*TW2/3.0)*SIN(BETA-ALPHA)-RHSF + ELSEIF(NUMH.EQ.2) THEN + RHSF=2.0*(MBQ/AMW)**2*COS(ALPHA)/COS(BETA) + RHSFL=(-1.0-TW2/3.0)*(-1.0)*COS(BETA-ALPHA)-RHSF + RHSFR=(-2.0*TW2/3.0)*(-1.0)*COS(BETA-ALPHA)-RHSF + ELSE + RHSF=0 + RHSFL=0 + RHSFR=0 + ENDIF + RHSF1=RHSFL*COS(THETAB)-RHSFR*SIN(THETAB) + RHSF2=RHSFL*SIN(THETAB)+RHSFR*COS(THETAB) + TAU=4.0*AMB1SS**2/MH**2 + CALL SSHGM1(TAU,IFFF,RFFF) + IF0=-TAU*TAU*IFFF + RF0=TAU*(1.0-TAU*RFFF) + IIHSF1=RHSF1*IF0*(AMW/AMB1SS)**2/8.0 + RIHSF1=RHSF1*RF0*(AMW/AMB1SS)**2/8.0 + IITOT=IITOT+IIHSF1 + RITOT=RITOT+RIHSF1 + TAU=4.0*AMB2SS**2/MH**2 + CALL SSHGM1(TAU,IFFF,RFFF) + IF0=-TAU*TAU*IFFF + RF0=TAU*(1.0-TAU*RFFF) + IIHSF2=RHSF2*IF0*(AMW/AMB2SS)**2/8.0 + RIHSF2=RHSF2*RF0*(AMW/AMB2SS)**2/8.0 + IITOT=IITOT+IIHSF2 + RITOT=RITOT+RIHSF2 +C +C Up-type squark loops +C Mixing between the stop squarks is included, so +C masses used here are the mixed masses (AMT1SS & AMT2SS) +C First do u_L and c_L + DO 60 II=1,2 + IF(NUMH.EQ.1) THEN + RHSF=2.0*(MFU(II)/AMW)**2*COS(ALPHA)/SIN(BETA) + RHSFL=(1.0-TW2/3.0)*SIN(BETA-ALPHA)-RHSF + ELSEIF(NUMH.EQ.2) THEN + RHSF=2.0*(MFU(II)/AMW)**2 + RHSF=RHSF*(-1.0)*SIN(ALPHA)/SIN(BETA) + RHSFL=(1.0-TW2/3.0)*(-1.0)*COS(BETA-ALPHA)-RHSF + ELSE + RHSF=0 + RHSFL=0 + ENDIF + IF (II.EQ.1) AMSQ=AMULSS + IF (II.EQ.2) AMSQ=AMCLSS + TAU=4.0*(AMSQ)**2/MH**2 + CALL SSHGM1(TAU,IFFF,RFFF) + IF0=-TAU*TAU*IFFF + RF0=TAU*(1.0-TAU*RFFF) + IIHSFL=RHSFL*IF0*(AMW/AMSQ)**2/8.0 + RIHSFL=RHSFL*RF0*(AMW/AMSQ)**2/8.0 + IITOT=IITOT+IIHSFL + RITOT=RITOT+RIHSFL +60 CONTINUE +C Next, do u_R and c_R + DO 61 II=1,2 + IF(NUMH.EQ.1) THEN + RHSF=2.0*(MFU(II)/AMW)**2*COS(ALPHA)/SIN(BETA) + RHSFR=(4.0*TW2/3.0)*SIN(BETA-ALPHA)-RHSF + ELSEIF(NUMH.EQ.2) THEN + RHSF=2.0*(MFU(II)/AMW)**2 + RHSF=RHSF*(-1.0)*SIN(ALPHA)/SIN(BETA) + RHSFR=(4.0*TW2/3.0)*(-1.0)*COS(BETA-ALPHA)-RHSF + ELSE + RHSF=0 + RHSFR=0 + ENDIF + IF (II.EQ.1) AMSQ=AMURSS + IF (II.EQ.2) AMSQ=AMCRSS + TAU=4.0*(AMSQ)**2/MH**2 + CALL SSHGM1(TAU,IFFF,RFFF) + IF0=-TAU*TAU*IFFF + RF0=TAU*(1.0-TAU*RFFF) + IIHSFR=RHSFR*IF0*(AMW/AMSQ)**2/8.0 + RIHSFR=RHSFR*RF0*(AMW/AMSQ)**2/8.0 + IITOT=IITOT+IIHSFR + RITOT=RITOT+RIHSFR +61 CONTINUE +C + IF(NUMH.EQ.1) THEN + RHSF=2.0*(MTQ/AMW)**2*COS(ALPHA)/SIN(BETA) + RHSFL=(1.0-TW2/3.0)*SIN(BETA-ALPHA)-RHSF + RHSFR=(4.0*TW2/3.0)*SIN(BETA-ALPHA)-RHSF + ELSEIF(NUMH.EQ.2) THEN + RHSF=2.0*(MTQ/AMW)**2 + RHSF=RHSF*(-1.0)*SIN(ALPHA)/SIN(BETA) + RHSFL=(1.0-TW2/3.0)*(-1.0)*COS(BETA-ALPHA)-RHSF + RHSFR=(4.0*TW2/3.0)*(-1.0)*COS(BETA-ALPHA)-RHSF + ELSE + RHSF=0 + RHSFL=0 + RHSFR=0 + ENDIF + RHSF1=RHSFL*COS(THETAT)-RHSFR*SIN(THETAT) + RHSF2=RHSFL*SIN(THETAT)+RHSFR*COS(THETAT) + TAU=4.0*AMT1SS**2/MH**2 + CALL SSHGM1(TAU,IFFF,RFFF) + IF0=-TAU*TAU*IFFF + RF0=TAU*(1.0-TAU*RFFF) + IIHSF1=RHSF1*IF0*(AMW/AMT1SS)**2/8.0 + RIHSF1=RHSF1*RF0*(AMW/AMT1SS)**2/8.0 + IITOT=IITOT+IIHSF1 + RITOT=RITOT+RIHSF1 + TAU=4.0*AMT2SS**2/MH**2 + CALL SSHGM1(TAU,IFFF,RFFF) + IF0=-TAU*TAU*IFFF + RF0=TAU*(1.0-TAU*RFFF) + IIHSF2=RHSF2*IF0*(AMW/AMT2SS)**2/8.0 + RIHSF2=RHSF2*RF0*(AMW/AMT2SS)**2/8.0 + IITOT=IITOT+IIHSF2 + RITOT=RITOT+RIHSF2 +C +C IITOT and RITOT now contain the total imaginary and +C real parts of the I function +C + SUMISQ=IITOT**2+RITOT**2 + AS=SSALFS(MH**2) + DW=AS**2*G2*MH**3/(32.0*(PI**3)*AMW**2) + WID=DW*SUMISQ + CALL SSSAVE(IDHHA,WID,IDGL,IDGL,0,0,0) +100 CONTINUE +C + RETURN + END diff --git a/ISAJET/isasusy/sshgm.F b/ISAJET/isasusy/sshgm.F new file mode 100644 index 00000000000..83e1ef8a214 --- /dev/null +++ b/ISAJET/isasusy/sshgm.F @@ -0,0 +1,549 @@ +#include "isajet/pilot.h" + SUBROUTINE SSHGM +C----------------------------------------------------------------------- +C +C Calculate H -> gm gm decays including both SM particles and +C SUSY particles in loop. +C +C This subroutine uses the tau variable of the Higgs Hunters' +C Guide. Many other authors, including the paper cited in +C Higgs Hunters' Guide (PR. D. 38(11): 3481) and Collider Physics +C by Barger and Phillips use the variable lambda +C LAMBDA = ( MASS OF PARTICLE IN LOOP / MASS OF HIGGS )**2 +C TAU = 4.0 * LAMBDA +C +C Bisset's HGAMGAM +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstype.inc" +C + DOUBLE PRECISION MW1,MW2 + DOUBLE PRECISION MFL(3),MFD(3),MFU(3) + DOUBLE PRECISION ETAH,IITOT,RITOT,TAU,IFFF,RFFF,IFHALF,RFHALF + $,IF1,RF1,IF0,RF0,NCC,EF,TEMPCH,RHF,RHW,RHCH,RHSF,RHSFL,RHSFR + $,TEMP,RHCNO,IIHF,RIHF,IIHW,RIHW,IIHCH,RIHCH,IIHSFL,RIHSFL + $,IIHSFR,RIHSFR,IIHCNO,RIHCNO + $,RHSF1,RHSF2,IIHSF1,IIHSF2,RIHSF1,RIHSF2 + DOUBLE PRECISION U11,U12,U21,U22,V11,V12,V21,V22,S11,Q11,S22,Q22 + $,SUMISQ,DW + DOUBLE PRECISION PI,SR2,XM,YM,CGL,SGL,CGR,SGR,G2,MH,BETA,ALPHA + $,THETX,THETY,THETM,THETP,CW2,AMSQ + REAL WID + REAL ASMB,MBMB,MBQ,ASMT,MTMT,MTQ,SUALFS + DOUBLE PRECISION SSMQCD + INTEGER NUMH,IJ,II,NUMOUT,IDHHA +C +C Mass matrix parameters +C + PI=4.*ATAN(1.D0) + SR2=SQRT(2.D0) + XM=1./TAN(GAMMAL) + THETX=SIGN(1.D0,XM) + YM=1./TAN(GAMMAR) + THETY=SIGN(1.D0,YM) + SGL=1/(DSQRT(1+XM**2)) + CGL=SGL*XM + SGR=1/(DSQRT(1+YM**2)) + CGR=SGR*YM + MW1=DBLE(ABS(AMW1SS)) + MW2=DBLE(ABS(AMW2SS)) + THETM=SIGN(1.,AMW1SS) + THETP=SIGN(1.,AMW2SS) + G2=4.0*PI*ALFAEM/SN2THW + BETA=ATAN(1.0/RV2V1) + ALPHA=ALFAH + CW2=1.-SN2THW +C +C Loop over neutral Higgs bosons +C + DO 100 NUMH=1,3 + IF(NUMH.EQ.1) THEN + MH=AMHL + IDHHA=ISHL + ELSEIF(NUMH.EQ.2) THEN + MH=AMHH + IDHHA=ISHH + ELSE + MH=AMHA + IDHHA=ISHA + ENDIF + ETAH=1.0 + IITOT=0.0 + RITOT=0.0 +C + ASMB=SUALFS(AMBT**2,.36,AMTP,3) + MBMB=AMBT*(1.-4*ASMB/3./PI) + MBQ=SSMQCD(DBLE(MBMB),DBLE(MH)) + ASMT=SUALFS(AMTP**2,.36,AMTP,3) + MTMT=AMTP/(1.+4*ASMT/3./PI+(16.11-1.04*(5.-6.63/AMTP))* + $(ASMT/PI)**2) + MTQ=SSMQCD(DBLE(MTMT),DBLE(MH)) +C + MFL(1)=DBLE(AME) + MFL(2)=DBLE(AMMU) + MFL(3)=DBLE(AMTAU) + MFD(1)=DBLE(AMDN) + MFD(2)=DBLE(AMST) + MFD(3)=DBLE(MBQ) + MFU(1)=DBLE(AMUP) + MFU(2)=DBLE(AMCH) + MFU(3)=DBLE(MTQ) +C +C Charged lepton loops +C + DO 10 II=1,3 + TAU=4*MFL(II)**2/MH**2 + CALL SSHGM1(TAU,IFFF,RFFF) + IFHALF=-2.0*TAU*(1.0-TAU*ETAH)*IFFF + RFHALF=-2.0*TAU*(ETAH+(1.0-TAU*ETAH)*RFFF) + NCC=1.0 + EF=-1.0 + IF(NUMH.EQ.1) THEN + RHF=SIN(ALPHA)/COS(BETA) + ELSEIF(NUMH.EQ.2) THEN + RHF=COS(ALPHA)/COS(BETA) + ELSE + RHF=TAN(BETA) + ENDIF + IIHF=NCC*EF**2*RHF*IFHALF + RIHF=NCC*EF**2*RHF*RFHALF + IITOT=IITOT+IIHF + RITOT=RITOT+RIHF +10 CONTINUE +C +C Down-type quark loops +C + DO 20 II=1,3 + TAU=4*MFD(II)**2/MH**2 + CALL SSHGM1(TAU,IFFF,RFFF) + IFHALF=-2.0*TAU*(1.0-TAU*ETAH)*IFFF + RFHALF=-2.0*TAU*(ETAH+(1.0-TAU*ETAH)*RFFF) + NCC=3.0 + EF=-1.0/3.0 + IF(NUMH.EQ.1) THEN + RHF=SIN(ALPHA)/COS(BETA) + ELSEIF(NUMH.EQ.2) THEN + RHF=COS(ALPHA)/COS(BETA) + ELSE + RHF=DTAN(BETA) + ENDIF + IIHF=NCC*EF**2*RHF*IFHALF + RIHF=NCC*EF**2*RHF*RFHALF + IITOT=IITOT+IIHF + RITOT=RITOT+RIHF +20 CONTINUE +C +C Up-type quark loops +C + DO 30 II=1,2 + TAU=4*MFU(II)**2/MH**2 + CALL SSHGM1(TAU,IFFF,RFFF) + IFHALF=-2.0*TAU*(1.0-TAU*ETAH)*IFFF + RFHALF=-2.0*TAU*(ETAH+(1.0-TAU*ETAH)*RFFF) + NCC=3.0 + EF=2.0/3.0 + IF(NUMH.EQ.1) THEN + RHF=COS(ALPHA)/SIN(BETA) + ELSEIF(NUMH.EQ.2) THEN + RHF=-SIN(ALPHA)/SIN(BETA) + ELSE + RHF=1.0/TAN(BETA) + ENDIF + IIHF=NCC*EF**2*RHF*IFHALF + RIHF=NCC*EF**2*RHF*RFHALF + IITOT=IITOT+IIHF + RITOT=RITOT+RIHF +30 CONTINUE +C + TAU=4*MFU(3)**2/MH**2 + CALL SSHGM1(TAU,IFFF,RFFF) + IFHALF=-2.0*TAU*(1.0-TAU*ETAH)*IFFF + RFHALF=-2.0*TAU*(ETAH+(1.0-TAU*ETAH)*RFFF) + NCC=3.0 + EF=2.0/3.0 + IF(NUMH.EQ.1) THEN + RHF=COS(ALPHA)/SIN(BETA) + ELSEIF(NUMH.EQ.2) THEN + RHF=-SIN(ALPHA)/SIN(BETA) + ELSE + RHF=1.0/TAN(BETA) + ENDIF + IIHF=NCC*EF**2*RHF*IFHALF + RIHF=NCC*EF**2*RHF*RFHALF + IITOT=IITOT+IIHF + RITOT=RITOT+RIHF +C +C W-boson loop +C + TAU=4*AMW**2/MH**2 + CALL SSHGM1(TAU,IFFF,RFFF) + IF1=3.0*TAU*(2.0-TAU)*IFFF + RF1=2.0+3.0*TAU+3.0*TAU*(2.0-TAU)*RFFF + IF(NUMH.EQ.1) THEN + RHW=SIN(BETA+ALPHA) + ELSEIF(NUMH.EQ.2) THEN + RHW=COS(BETA+ALPHA) + ELSE + RHW=0 + ENDIF + IIHW=RHW*IF1 + RIHW=RHW*RF1 + IITOT=IITOT+IIHW + RITOT=RITOT+RIHW +C +C Charged Higgs loop +C + TAU=4*AMHC**2/MH**2 + CALL SSHGM1(TAU,IFFF,RFFF) + IF0=-TAU*TAU*IFFF + RF0=TAU*(1.0-TAU*RFFF) + IF(NUMH.EQ.1) THEN + TEMPCH=SIN(BETA-ALPHA)*COS(2.0*BETA) + TEMPCH=TEMPCH/(2.0*CW2) + RHCH=TEMPCH+SIN(BETA+ALPHA) + ELSEIF(NUMH.EQ.2) THEN + TEMPCH=-COS(BETA-ALPHA)*COS(2.0*BETA) + TEMPCH=TEMPCH/(2.0*CW2) + RHCH=COS(BETA+ALPHA)+TEMPCH + ELSE + RHCH=0 + ENDIF + IIHCH=RHCH*IF0*AMW**2/AMHC**2 + RIHCH=RHCH*RF0*AMW**2/AMHC**2 + IITOT=IITOT+IIHCH + RITOT=RITOT+RIHCH +C +C Slepton loops +C The 3 L-type sneutrinos can be omitted since the sfermion +C decay width is proportional to the sfermion charge. +C ==> There are two sets of 3 degenerate sleptons. +C + NCC=1.0 + EF=-1.0 +C First, do e_L and mu_L sleptons + DO 40 II=1,2 + IF(NUMH.EQ.1) THEN + RHSF=(MFL(II)/AMZ)**2*SIN(ALPHA)/COS(BETA) + TEMP=(-0.5-EF*SN2THW)*SIN(BETA-ALPHA) + RHSFL=RHSF-TEMP + ELSEIF(NUMH.EQ.2) THEN + RHSF=(MFL(II)/AMZ)**2*COS(ALPHA)/COS(BETA) + TEMP=(-0.5-EF*SN2THW)*COS(BETA-ALPHA) + RHSFL=RHSF-TEMP + ELSE + RHSF=0 + RHSFL=0 + ENDIF + IF (II.EQ.1) AMSQ=AMELSS + IF (II.EQ.2) AMSQ=AMMLSS + TAU=4*AMSQ**2/MH**2 + CALL SSHGM1(TAU,IFFF,RFFF) + IF0=-TAU*TAU*IFFF + RF0=TAU*(1.0-TAU*RFFF) + IIHSFL=NCC*(EF**2)*RHSFL*IF0*(AMZ/AMSQ)**2 + RIHSFL=NCC*(EF**2)*RHSFL*RF0*(AMZ/AMSQ)**2 + IITOT=IITOT+IIHSFL + RITOT=RITOT+RIHSFL +40 CONTINUE +C Next, do e_R and mu_R + DO 41 II=1,2 + IF(NUMH.EQ.1) THEN + RHSF=(MFL(II)/AMZ)**2*SIN(ALPHA)/COS(BETA) + TEMP=-1.0*EF*SN2THW*SIN(BETA-ALPHA) + RHSFR=RHSF+TEMP + ELSEIF(NUMH.EQ.2) THEN + RHSF=(MFL(II)/AMZ)**2*COS(ALPHA)/COS(BETA) + TEMP=-1.0*EF*SN2THW*COS(BETA-ALPHA) + RHSFR=RHSF+TEMP + ELSE + RHSF=0 + RHSFR=0 + ENDIF + IF (II.EQ.1) AMSQ=AMERSS + IF (II.EQ.2) AMSQ=AMMRSS + TAU=4*AMSQ**2/MH**2 + CALL SSHGM1(TAU,IFFF,RFFF) + IF0=-TAU*TAU*IFFF + RF0=TAU*(1.0-TAU*RFFF) + IIHSFR=NCC*(EF**2)*RHSFR*IF0*(AMZ/AMSQ)**2 + RIHSFR=NCC*(EF**2)*RHSFR*RF0*(AMZ/AMSQ)**2 + IITOT=IITOT+IIHSFR + RITOT=RITOT+RIHSFR +41 CONTINUE +C Next, do stau_1 and stau_2 contribution + IF(NUMH.EQ.1) THEN + RHSF=(AMTAU/AMZ)**2*SIN(ALPHA)/COS(BETA) + TEMP=(-0.5-EF*SN2THW)*SIN(BETA-ALPHA) + RHSFL=RHSF-TEMP + TEMP=-1.0*EF*SN2THW*SIN(BETA-ALPHA) + RHSFR=RHSF+TEMP + ELSEIF(NUMH.EQ.2) THEN + RHSF=(AMTAU/AMZ)**2*COS(ALPHA)/COS(BETA) + TEMP=(-0.5-EF*SN2THW)*COS(BETA-ALPHA) + RHSFL=RHSF-TEMP + TEMP=-1.0*EF*SN2THW*COS(BETA-ALPHA) + RHSFR=RHSF+TEMP + ELSE + RHSF=0 + RHSFL=0 + RHSFR=0 + ENDIF + RHSF1=RHSFL*COS(THETAL)-RHSFR*SIN(THETAL) + RHSF2=RHSFL*SIN(THETAL)+RHSFR*COS(THETAL) + TAU=4*AML1SS**2/MH**2 + CALL SSHGM1(TAU,IFFF,RFFF) + IF0=-TAU*TAU*IFFF + RF0=TAU*(1.0-TAU*RFFF) + IIHSF1=NCC*(EF**2)*RHSF1*IF0*(AMZ/AML1SS)**2 + RIHSF1=NCC*(EF**2)*RHSF1*RF0*(AMZ/AML1SS)**2 + IITOT=IITOT+IIHSF1 + RITOT=RITOT+RIHSF1 + TAU=4*AML2SS**2/MH**2 + CALL SSHGM1(TAU,IFFF,RFFF) + IF0=-TAU*TAU*IFFF + RF0=TAU*(1.0-TAU*RFFF) + IIHSF2=NCC*(EF**2)*RHSF2*IF0*(AMZ/AML2SS)**2 + RIHSF2=NCC*(EF**2)*RHSF2*RF0*(AMZ/AML2SS)**2 + IITOT=IITOT+IIHSF2 + RITOT=RITOT+RIHSF2 +C +C Down-type squark loops +C Mixing between the sbottom squarks is also included, so +C masses used here are the mixed masses (AMB1SS & AMB2SS) +C + NCC=3.0 + EF=-1.0/3.0 +C First, do d_L and s_L squarks + DO 50 II=1,2 + IF(NUMH.EQ.1) THEN + RHSF=(MFD(II)/AMZ)**2*SIN(ALPHA)/COS(BETA) + TEMP=(-0.5-EF*SN2THW)*SIN(BETA-ALPHA) + RHSFL=RHSF-TEMP + ELSEIF(NUMH.EQ.2) THEN + RHSF=(MFD(II)/AMZ)**2*COS(ALPHA)/COS(BETA) + TEMP=(-0.5-EF*SN2THW)*COS(BETA-ALPHA) + RHSFL=RHSF-TEMP + ELSE + RHSF=0 + RHSFL=0 + ENDIF + IF (II.EQ.1) AMSQ=AMDLSS + IF (II.EQ.2) AMSQ=AMSLSS + TAU=4*AMSQ**2/MH**2 + CALL SSHGM1(TAU,IFFF,RFFF) + IF0=-TAU*TAU*IFFF + RF0=TAU*(1.0-TAU*RFFF) + IIHSFL=NCC*(EF**2)*RHSFL*IF0*(AMZ/AMSQ)**2 + RIHSFL=NCC*(EF**2)*RHSFL*RF0*(AMZ/AMSQ)**2 + IITOT=IITOT+IIHSFL + RITOT=RITOT+RIHSFL +50 CONTINUE +C Next, do d_R and s_R squarks + DO 51 II=1,2 + IF(NUMH.EQ.1) THEN + RHSF=(MFD(II)/AMZ)**2*SIN(ALPHA)/COS(BETA) + TEMP=-1.0*EF*SN2THW*SIN(BETA-ALPHA) + RHSFR=RHSF+TEMP + ELSEIF(NUMH.EQ.2) THEN + RHSF=(MFD(II)/AMZ)**2*COS(ALPHA)/COS(BETA) + TEMP=-1.0*EF*SN2THW*COS(BETA-ALPHA) + RHSFR=RHSF+TEMP + ELSE + RHSF=0 + RHSFR=0 + ENDIF + IF (II.EQ.1) AMSQ=AMDRSS + IF (II.EQ.2) AMSQ=AMSRSS + TAU=4*AMSQ**2/MH**2 + CALL SSHGM1(TAU,IFFF,RFFF) + IF0=-TAU*TAU*IFFF + RF0=TAU*(1.0-TAU*RFFF) + IIHSFR=NCC*(EF**2)*RHSFR*IF0*(AMZ/AMSQ)**2 + RIHSFR=NCC*(EF**2)*RHSFR*RF0*(AMZ/AMSQ)**2 + IITOT=IITOT+IIHSFR + RITOT=RITOT+RIHSFR +51 CONTINUE +C + NCC=3.0 + EF=-1.0/3.0 + IF(NUMH.EQ.1) THEN + RHSF=(MBQ/AMZ)**2*SIN(ALPHA)/COS(BETA) + TEMP=(-0.5-EF*SN2THW)*SIN(BETA-ALPHA) + RHSFL=RHSF-TEMP + TEMP=-1.0*EF*SN2THW*SIN(BETA-ALPHA) + RHSFR=RHSF+TEMP + ELSEIF(NUMH.EQ.2) THEN + RHSF=(MBQ/AMZ)**2*COS(ALPHA)/COS(BETA) + TEMP=(-0.5-EF*SN2THW)*COS(BETA-ALPHA) + RHSFL=RHSF-TEMP + TEMP=-1.0*EF*SN2THW*COS(BETA-ALPHA) + RHSFR=RHSF+TEMP + ELSE + RHSF=0 + RHSFL=0 + RHSFR=0 + ENDIF + RHSF1=RHSFL*COS(THETAB)-RHSFR*SIN(THETAB) + RHSF2=RHSFL*SIN(THETAB)+RHSFR*COS(THETAB) + TAU=4*AMB1SS**2/MH**2 + CALL SSHGM1(TAU,IFFF,RFFF) + IF0=-TAU*TAU*IFFF + RF0=TAU*(1.0-TAU*RFFF) + IIHSF1=NCC*(EF**2)*RHSF1*IF0*(AMZ/AMB1SS)**2 + RIHSF1=NCC*(EF**2)*RHSF1*RF0*(AMZ/AMB1SS)**2 + IITOT=IITOT+IIHSF1 + RITOT=RITOT+RIHSF1 + TAU=4*AMB2SS**2/MH**2 + CALL SSHGM1(TAU,IFFF,RFFF) + IF0=-TAU*TAU*IFFF + RF0=TAU*(1.0-TAU*RFFF) + IIHSF2=NCC*(EF**2)*RHSF2*IF0*(AMZ/AMB2SS)**2 + RIHSF2=NCC*(EF**2)*RHSF2*RF0*(AMZ/AMB2SS)**2 + IITOT=IITOT+IIHSF2 + RITOT=RITOT+RIHSF2 +C +C Up-type squark loops +C Mixing between the stop squarks is also included, so +C masses used here are the mixed masses (AMT1SS & AMT2SS) +C + NCC=3.0 + EF=2.0/3.0 +C First, do u_L and c_L squarks + DO 60 II=1,2 + IF(NUMH.EQ.1) THEN + RHSF=(MFU(II)/AMZ)**2*COS(ALPHA)/SIN(BETA) + TEMP=(0.5-EF*SN2THW)*SIN(BETA-ALPHA) + RHSFL=RHSF-TEMP + ELSEIF(NUMH.EQ.2) THEN + RHSF=(MFU(II)/AMZ)**2*(-1.0)*SIN(ALPHA)/SIN(BETA) + TEMP=(0.5-EF*SN2THW)*COS(BETA-ALPHA) + RHSFL=RHSF-TEMP + ELSE + RHSF=0 + RHSFL=0 + ENDIF + IF (II.EQ.1) AMSQ=AMULSS + IF (II.EQ.2) AMSQ=AMCLSS + TAU=4*AMSQ**2/MH**2 + CALL SSHGM1(TAU,IFFF,RFFF) + IF0=-TAU*TAU*IFFF + RF0=TAU*(1.0-TAU*RFFF) + IIHSFL=NCC*(EF**2)*RHSFL*IF0*(AMZ/AMSQ)**2 + RIHSFL=NCC*(EF**2)*RHSFL*RF0*(AMZ/AMSQ)**2 + IITOT=IITOT+IIHSFL + RITOT=RITOT+RIHSFL +60 CONTINUE +C Next, do u_R and c_R squarks + DO 61 II=1,2 + IF(NUMH.EQ.1) THEN + RHSF=(MFU(II)/AMZ)**2*COS(ALPHA)/SIN(BETA) + TEMP=-1.0*EF*SN2THW*SIN(BETA-ALPHA) + RHSFR=RHSF+TEMP + ELSEIF(NUMH.EQ.2) THEN + RHSF=(MFU(II)/AMZ)**2*(-1.0)*SIN(ALPHA)/SIN(BETA) + TEMP=-1.0*EF*SN2THW*COS(BETA-ALPHA) + RHSFR=RHSF+TEMP + ELSE + RHSF=0 + RHSFR=0 + ENDIF + IF (II.EQ.1) AMSQ=AMURSS + IF (II.EQ.2) AMSQ=AMCRSS + TAU=4*AMSQ**2/MH**2 + CALL SSHGM1(TAU,IFFF,RFFF) + IF0=-TAU*TAU*IFFF + RF0=TAU*(1.0-TAU*RFFF) + IIHSFR=NCC*(EF**2)*RHSFR*IF0*(AMZ/AMSQ)**2 + RIHSFR=NCC*(EF**2)*RHSFR*RF0*(AMZ/AMSQ)**2 + IITOT=IITOT+IIHSFR + RITOT=RITOT+RIHSFR +61 CONTINUE +C + NCC=3.0 + EF=2.0/3.0 + IF(NUMH.EQ.1) THEN + RHSF=(MTQ/AMZ)**2*COS(ALPHA)/SIN(BETA) + TEMP=(0.5-EF*SN2THW)*SIN(BETA-ALPHA) + RHSFL=RHSF-TEMP + TEMP=-1.0*EF*SN2THW*SIN(BETA-ALPHA) + RHSFR=RHSF+TEMP + ELSEIF(NUMH.EQ.2) THEN + RHSF=(MTQ/AMZ)**2*(-1.0)*SIN(ALPHA)/SIN(BETA) + TEMP=(0.5-EF*SN2THW)*COS(BETA-ALPHA) + RHSFL=RHSF-TEMP + TEMP=-1.0*EF*SN2THW*COS(BETA-ALPHA) + RHSFR=RHSF+TEMP + ELSE + RHSF=0 + RHSFL=0 + IIHSFL=0 + RIHSFL=0 + ENDIF + RHSF1=RHSFL*COS(THETAB)-RHSFR*SIN(THETAB) + RHSF2=RHSFL*SIN(THETAB)+RHSFR*COS(THETAB) + TAU=4*AMT1SS**2/MH**2 + CALL SSHGM1(TAU,IFFF,RFFF) + IF0=-TAU*TAU*IFFF + RF0=TAU*(1.0-TAU*RFFF) + IIHSF1=NCC*(EF**2)*RHSF1*IF0*(AMZ/AMT1SS)**2 + RIHSF1=NCC*(EF**2)*RHSF1*RF0*(AMZ/AMT1SS)**2 + IITOT=IITOT+IIHSF1 + RITOT=RITOT+RIHSF1 + TAU=4*AMT2SS**2/MH**2 + CALL SSHGM1(TAU,IFFF,RFFF) + IF0=-TAU*TAU*IFFF + RF0=TAU*(1.0-TAU*RFFF) + IIHSF2=NCC*(EF**2)*RHSF2*IF0*(AMZ/AMT2SS)**2 + RIHSF2=NCC*(EF**2)*RHSF2*RF0*(AMZ/AMT2SS)**2 + IITOT=IITOT+IIHSF2 + RITOT=RITOT+RIHSF2 +C +C Chargino loops +C + TAU=4.0*(MW1)**2/MH**2 + CALL SSHGM1(TAU,IFFF,RFFF) + IFHALF=-2.0*TAU*(1.0-TAU*ETAH)*IFFF + RFHALF=-2.0*TAU*(ETAH+(1.0-TAU*ETAH)*RFFF) + U11=SGL + U12=-CGL + V11=THETM*SGR + V12=-THETM*CGR + S11=U11*V12/SR2 + Q11=U12*V11/SR2 + RHCNO=2.0*(S11*COS(ALPHA)+Q11*SIN(ALPHA)) + IIHCNO=RHCNO*IFHALF*AMW/MW1 + RIHCNO=RHCNO*RFHALF*AMW/MW1 + IITOT=IITOT+IIHCNO + RITOT=RITOT+RIHCNO +C + TAU=4.0*(MW2)**2/MH**2 + CALL SSHGM1(TAU,IFFF,RFFF) + IFHALF=-2.0*TAU*(1.0-TAU*ETAH)*IFFF + RFHALF=-2.0*TAU*(ETAH+(1.0-TAU*ETAH)*RFFF) + U21=THETX*CGL + U22=THETX*SGL + V21=THETP*THETY*CGR + V22=THETP*THETY*SGR + S22=U21*V22/SR2 + Q22=U22*V21/SR2 + RHCNO=2.0*(S22*COS(ALPHA)+Q22*SIN(ALPHA)) + IIHCNO=RHCNO*IFHALF*AMW/MW2 + RIHCNO=RHCNO*RFHALF*AMW/MW2 + IITOT=IITOT+IIHCNO + RITOT=RITOT+RIHCNO +C +C IITOT and RITOT now contain the total imaginary and real +C parts of the I function +C + SUMISQ=IITOT**2+RITOT**2 + DW=ALFAEM**2*G2*MH**3/(1024.0*(PI**3)*AMW**2) + WID=DW*SUMISQ + CALL SSSAVE(IDHHA,WID,IDGM,IDGM,0,0,0) +100 CONTINUE +C + RETURN + END diff --git a/ISAJET/isasusy/sshgm1.F b/ISAJET/isasusy/sshgm1.F new file mode 100644 index 00000000000..5c56c03b74d --- /dev/null +++ b/ISAJET/isasusy/sshgm1.F @@ -0,0 +1,35 @@ +#include "isajet/pilot.h" + SUBROUTINE SSHGM1(TAU,IFFF,RFFF) +C----------------------------------------------------------------------- +C +C This subroutine uses the tau variable of the Higgs Hunters' +C Guide. Many other authors, including the paper cited in +C Higgs Hunters' Guide (PR. D. 38(11): 3481) and Collider Physics +C by Barger and Phillips use the variable lambda +C LAMBDA = ( MASS OF PARTICLE IN LOOP / MASS OF HIGGS )**2 +C TAU = 4.0 * LAMBDA +C Note also that what is defined as the f function by different +C authors varies by a constant factor. For example, +C f(Barger and Phillips) = -2 * f(Higgs Hunters' Guide) +C +C Bisset's FFF +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + DOUBLE PRECISION TAU,IFFF,RFFF,ETAP,ETAM,PI +C + PI=3.1415926536 + IFFF=0.0 + RFFF=0.0 + IF(TAU.GE.1.0) THEN + RFFF=(DASIN(DSQRT(1.0/TAU)))**2 + IFFF=0.0D0 + ELSE IF (TAU.LT.1.0) THEN + ETAP=1.0D0+SQRT(1.0D0-TAU) + ETAM=1.0D0-SQRT(1.0D0-TAU) + RFFF=-((DLOG(ETAP/ETAM))**2-PI**2)/4.0D0 + IFFF=PI*DLOG(ETAP/ETAM)/2.0D0 + ENDIF + RETURN + END diff --git a/ISAJET/isasusy/sshhx.F b/ISAJET/isasusy/sshhx.F new file mode 100644 index 00000000000..aa19d875ac5 --- /dev/null +++ b/ISAJET/isasusy/sshhx.F @@ -0,0 +1,198 @@ +#include "isajet/pilot.h" + SUBROUTINE SSHHX +C----------------------------------------------------------------------- +C Calculates the decays Hi -> Hj + X. +C +C Includes vertex corrections for triple Higgs couplings due +C to top and stop quarks effects. +C See Kunszt and Zwirner CERN-TH.6150/91 for all but hh-hc-hc +C correction which is in our Higgs-->SUSY paper: +C Baer et. al. FSU-HEP-920630 or UH-511-749-92. +C +C The hh-hl-hl vertex correction now includes both +C top & bottom and stop and sbottom squark +C (non-degenerate with mixing) effects. +C A-terms and mu=-2m1 are also included. +C +C +C Bisset's HIGPRO +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sspar.inc" +#include "isajet/sssm.inc" +#include "isajet/sstype.inc" +C + DOUBLE PRECISION PI,SR2,G2,GP2,BETA,ALPHA,SW2,CW2,LGTST,CBMA + $,SBMA,LAMB1,DWID,DELLPP,MH,M1,M2,LAMB,TEMP,DTEMPL,DTEMPR + $,DELHLL,DELHPP,DELHCC,CAB2,SAB2 + DOUBLE PRECISION SSDLAM + REAL WID,ASMT,MTMT,MTQ,SUALFS,HIGFRZ + DOUBLE PRECISION SSMQCD +C + PI=4.*ATAN(1.D0) + SR2=SQRT(2.D0) + G2=4.0*PI*ALFAEM/SN2THW + GP2=4*PI*ALFAEM/(1-SN2THW) + HIGFRZ=SQRT(AMTLSS*AMTRSS) + ASMT=SUALFS(AMTP**2,.36,AMTP,3) + MTMT=AMTP/(1.+4*ASMT/3./PI+(16.11-1.04*(5.-6.63/AMTP))* + $(ASMT/PI)**2) + MTQ=SSMQCD(DBLE(MTMT),DBLE(HIGFRZ)) + + BETA=ATAN(1.0/RV2V1) + ALPHA=ALFAH + SW2=SN2THW + CW2=1.-SN2THW +C + LGTST=(1+(AMTLSS/MTQ)**2)*(1+(AMTRSS/MTQ)**2) + LGTST=LOG(LGTST) + SBMA=SIN(BETA-ALPHA) + CBMA=COS(BETA-ALPHA) + CAB2=(DCOS(ALPHA+BETA))**2 + SAB2=1.0-CAB2 +C +C hl0 -> ha0 + ha0 +C + IF(AMHL.GT.2*AMHA) THEN + LAMB1=AMHL**2-4.0*AMHA**2 + DWID=SBMA*COS(2.0*BETA) +C Now add hl-hp-hp vertex correction + DELLPP=3.0*G2*CW2*(MTQ**4)*COS(ALPHA) + DELLPP=DELLPP*(COS(BETA)**2)/(16.0*(PI**2)) + DELLPP=DELLPP/((AMW**4)*(SIN(BETA))**3) + DELLPP=DELLPP*LGTST + DWID=(DWID+DELLPP)**2 + DWID=DWID*G2*(AMZ**2)/(128.0*PI*CW2*(AMHL**2)) + DWID=DWID*SQRT(LAMB1) + WID=DWID + CALL SSSAVE(ISHL,WID,ISHA,ISHA,0,0,0) + ENDIF +C +C hh -> ha + z +C + IF(AMHH.GT.AMHA+AMZ) THEN + MH=AMHH + M1=AMHA + M2=AMZ + LAMB=SSDLAM(MH**2,M1**2,M2**2) + DWID=SQRT(G2*CW2)+SQRT(GP2*SW2) + DWID=DWID**2*SAB2*SQRT(LAMB) + DWID=DWID/(64.0*PI*(AMZ**2)*(AMHH**3)) + DWID=DWID*LAMB + WID=DWID + CALL SSSAVE(ISHH,WID,ISHA,IDZ,0,0,0) + ENDIF +C +C hh -> hl + hl +C + IF(AMHH.GT.2*AMHL) THEN + LAMB1=AMHH**2-4.0*AMHL**2 + TEMP=CBMA*COS(2.0*ALPHA) + TEMP=TEMP+2.0*SBMA*SIN(2.0*ALPHA) +C +C Now add hh-hl-hl vertex correction +C +C The following 8 lines calculate the radiative +C hh-hl-hl vertex correction including only +C effects from tops and stop squarks. +C +C DTEMPL=3.0*LOG(1.0+(AMTLSS/MTQ)**2) +C DTEMPL=DTEMPL-2.0*AMTLSS**2/(AMTLSS**2+MTQ**2) +C DTEMPR=3.0*LOG(1.0+(AMTRSS/MTQ)**2) +C DTEMPR=DTEMPR-2.0*AMTRSS**2/(AMTRSS**2+MTQ**2) +C DELHLL=3.0*G2*CW2*(MTQ**4)*SIN(ALPHA) +C DELHLL=DELHLL*(COS(ALPHA)**2)/(PI**2) +C DELHLL=DELHLL/(16.0*(AMW**4)*(SIN(BETA))**3) +C DELHLL=DELHLL*(DTEMPL+DTEMPR) +C +C The subroutine SSHL calculates the radiative +C hh-hl-hl vertex correction including both +C top & bottom and stop and sbottom squark +C (non-degenerate with mixing) effects. +C A-terms and mu=-2m1 are also included. +C + CALL SSDHLL(DELHLL) +C +C Note: the variable TEMP in the line below +C this is the Lagrangian term (as noted on +C page 27 of Prof. Tata's personal Lagrangian +C term notes. Thus DELHLL must also be the +C Lagrangian entry - not the potential entry. +C The subroutine SSHLL IS set up to yield the +C the Lagrangian entry. (We must be very careful +C about the relative sign between TEMP and DELHLL.) +C + DWID=G2*(AMZ**2)*(TEMP+DELHLL)**2 + DWID=DWID/(128.0*PI*CW2*(AMHH**2)) + DWID=DWID*SQRT(LAMB1) + WID=DWID + CALL SSSAVE(ISHH,WID,ISHL,ISHL,0,0,0) + ENDIF +C +C hh -> ha + ha +C + IF(AMHH.GT.2*AMHA) THEN + LAMB1=AMHH**2-4.0*AMHA**2 + DWID=CBMA*COS(2*BETA) +C Now add hh-hp-hp vertex correction + DELHPP=3.0*G2*CW2*(MTQ**4)*SIN(ALPHA) + DELHPP=DELHPP*(COS(BETA)**2)/(16.0*(PI**2)) + DELHPP=DELHPP/((AMW**4)*(SIN(BETA))**3) + DELHPP=DELHPP*LGTST + DWID=G2*(AMZ**2)*(DWID+DELHPP)**2 + DWID=DWID/(128.0*PI*CW2*(AMHH**2)) + DWID=DWID*SQRT(LAMB1) + WID=DWID + CALL SSSAVE(ISHH,WID,ISHA,ISHA,0,0,0) + ENDIF +C +C hh -> hc+ + hc- +C + IF(AMHH.GT.2*AMHC) THEN + LAMB1=1.0-4.0*(AMHC**2)/(AMHH**2) + DWID=CBMA*COS(2.0*BETA)/(2.0*CW2) + DWID=COS(BETA+ALPHA)-DWID +C Now add hh-hc-hc vertex correction + DELHCC=3.0*G2*MTQ**4*SIN(ALPHA) + DELHCC=DELHCC/( SIN(BETA)*(DTAN(BETA))**2 ) + DELHCC=DELHCC/(32.0*PI**2*AMW**4) + DELHCC=DELHCC*LGTST + DWID=G2*AMW**2*(-DWID+DELHCC)**2 + DWID=DWID*SQRT(LAMB1)/(16.0*PI*AMHH) + WID=DWID + CALL SSSAVE(ISHH,WID,ISHC,-ISHC,0,0,0) + ENDIF +C +C ha -> hl + z +C + IF(AMHA.GT.AMHL+AMZ) THEN + MH=AMHA + M1=AMHL + M2=AMZ + LAMB=SSDLAM(MH**2,M1**2,M2**2) + DWID=SQRT(G2*CW2)+SQRT(GP2*SW2) + DWID=DWID**2*CAB2*SQRT(LAMB) + DWID=DWID/(64.0*PI*(AMZ**2)*(AMHA**3)) + DWID=DWID*LAMB + WID=DWID + CALL SSSAVE(ISHA,WID,ISHL,IDZ,0,0,0) + ENDIF +C +C hc+ -> w+ + hl +C + IF(AMHC.GT.AMW+AMHL) THEN + MH=AMHC + M1=AMW + M2=AMHL + LAMB=SSDLAM(MH**2,M1**2,M2**2) + DWID=G2*CAB2*SQRT(LAMB) + DWID=DWID/( 64.0*PI*(AMW**2)*(AMHC**3) ) + DWID=DWID*LAMB + WID=DWID + CALL SSSAVE(ISHC,WID,ISHL,IDW,0,0,0) + ENDIF +C + RETURN + END diff --git a/ISAJET/isasusy/sshibf.F b/ISAJET/isasusy/sshibf.F new file mode 100644 index 00000000000..b950a9c1788 --- /dev/null +++ b/ISAJET/isasusy/sshibf.F @@ -0,0 +1,58 @@ +#include "isajet/pilot.h" + SUBROUTINE SSHIBF +C----------------------------------------------------------------------- +C +C This subroutine calculates the decay widths for decays of the +C Higgs scalars present in the minimal SUSY model. +C +C NOTE: Decays into sfermions are not yet incorporated. +C +C Standard model parameters are hard wired in SSMSSM. To get +C the 1987-8 values corresponding to the Gunion et al. papers +C (Intl. J. Mod. Phys. 2(4):1035; Nucl. Phys. B307:445) you must +C change +C ALFA3 = 0.12 --> 0.136 +C AMW = 80.0 --> 81.3 +C AMZ = 91.17 --> 92.7 +C +C 2/9/91: +C I've modified the program slightly. The ALPHA3 = 0.12 value +C above is the recent empirical value from LEP. Using the equation +C from page 220 in Barger and Phillips yields ALPHA3 = 0.136. +C +C 10/1/92: +C Now includes vertex corrections for triple Higgs couplings. +C (See Kunszt and Zwirner, CERN-TH.6150/91 for all but HH-HC-HC +C correction which is in our Higgs --> SUSY paper: Baer et al. +C FSU-HEP-920630 or UH-511-749-92) +C +C Bisset's HIGSBF +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sstype.inc" +C +C Decays into fermions + CALL SSHFF +C Loop decays into photons and gluons + CALL SSHGM + CALL SSHGL +C Decays into WW(*), ZZ(*) + CALL SSHWW +C Decays into neutralinos and charginos + CALL SSHNN + CALL SSHCC +C Decays into other Higgs bosons + CALL SSHHX +C Decays to sfermions + CALL SSHSF +C Normalize branching ratios +C + CALL SSNORM(ISHL) + CALL SSNORM(ISHH) + CALL SSNORM(ISHA) + CALL SSNORM(ISHC) +C + RETURN + END diff --git a/ISAJET/isasusy/sshnn.F b/ISAJET/isasusy/sshnn.F new file mode 100644 index 00000000000..1599e95f245 --- /dev/null +++ b/ISAJET/isasusy/sshnn.F @@ -0,0 +1,157 @@ +#include "isajet/pilot.h" + SUBROUTINE SSHNN +C----------------------------------------------------------------------- +C Calculates the decay widths of all neutral Higgses into all +C possible pairs of neutralinos, and the decay widths of the +C charged Higgs into any neutralino and any chargino +C +C Bisset's NEUINO +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sspar.inc" +#include "isajet/sssm.inc" +#include "isajet/sstype.inc" +C + DOUBLE PRECISION XIJ,XJI,DIJ,TEMP,DWZN,TEMP2,T2,RWZ,SWZ + $,PI,SR2,XM,THETX,YM,THETY,SGL,CGL,SGR,CGR,MW1,MW2,THETM,THETP + $,G2,GP2,BETA,ALPHA,MH,M1,M2 + DOUBLE PRECISION SN1,SN2,DWID,LAMB + DOUBLE PRECISION A(4,4),MHI(3) + DOUBLE PRECISION SSDLAM + REAL WID + INTEGER II,NUMH,I1,I2,IZ,IW,ID1,ID2,IDHHA + INTEGER IDHI(3),IDZI(4) +C +C Mass matrix parameters +C + PI=4.*ATAN(1.D0) + SR2=SQRT(2.D0) + XM=1./TAN(GAMMAL) + THETX=SIGN(1.D0,XM) + YM=1./TAN(GAMMAR) + THETY=SIGN(1.D0,YM) + SGL=1/(DSQRT(1+XM**2)) + CGL=SGL*XM + SGR=1/(DSQRT(1+YM**2)) + CGR=SGR*YM + MW1=DBLE(ABS(AMW1SS)) + MW2=DBLE(ABS(AMW2SS)) + THETM=SIGN(1.,AMW1SS) + THETP=SIGN(1.,AMW2SS) + G2=4*PI*ALFAEM/SN2THW + GP2=4*PI*ALFAEM/(1-SN2THW) + BETA=ATAN(1.0/RV2V1) + ALPHA=ALFAH +C The following was calculated in Bisset's MASZIN + DO 10 II=1,4 + TEMP=SQRT(G2)*ZMIXSS(3,II)+SQRT(GP2)*ZMIXSS(4,II) + TEMP=TEMP/SR2 + A(1,II)=-TEMP*SGR-SQRT(G2)*ZMIXSS(1,II)*CGR + A(2,II)=TEMP*CGR-SQRT(G2)*ZMIXSS(1,II)*SGR + A(3,II)=-TEMP*SGL+SQRT(G2)*ZMIXSS(2,II)*CGL + A(4,II)=TEMP*CGL+SQRT(G2)*ZMIXSS(2,II)*SGL +10 CONTINUE +C +C Arrays for loops +C + MHI(1)=AMHL + MHI(2)=AMHH + MHI(3)=AMHA + IDHI(1)=ISHL + IDHI(2)=ISHH + IDHI(3)=ISHA + IDZI(1)=ISZ1 + IDZI(2)=ISZ2 + IDZI(3)=ISZ3 + IDZI(4)=ISZ4 +C +C Loop over neutral Higgs decays h(numh) into neutralino +C pairs zi(i1) and zi(i2) +C + DO 100 NUMH=1,3 + MH=MHI(NUMH) + IDHHA=IDHI(NUMH) + DO 110 I1=1,4 + M1=ABS(AMZISS(I1)) + ID1=IDZI(I1) + DO 120 I2=I1,4 + M2=ABS(AMZISS(I2)) + ID2=IDZI(I2) + IF(M1+M2.GE.MH) GO TO 120 + LAMB=SSDLAM(MH**2,M1**2,M2**2) + IF(I1.EQ.I2) THEN + DIJ = 0.5 + ELSE + DIJ = 1.0 + ENDIF + TEMP=-0.5*SIGN(1.,AMZISS(I1))*SIGN(1.,AMZISS(I2)) + XIJ=TEMP*(SQRT(G2)*ZMIXSS(3,I2)-SQRT(GP2)*ZMIXSS(4,I2)) + XJI=TEMP*(SQRT(G2)*ZMIXSS(3,I1)-SQRT(GP2)*ZMIXSS(4,I1)) + IF(NUMH.EQ.1) THEN + XIJ=XIJ*(ZMIXSS(2,I1)*SIN(ALPHA)-ZMIXSS(1,I1)*COS(ALPHA)) + XJI=XJI*(ZMIXSS(2,I2)*SIN(ALPHA)-ZMIXSS(1,I2)*COS(ALPHA)) + ELSEIF (NUMH .EQ. 2) THEN + XIJ=XIJ*(ZMIXSS(2,I1)*COS(ALPHA)+ZMIXSS(1,I1)*SIN(ALPHA)) + XJI=XJI*(ZMIXSS(2,I2)*COS(ALPHA)+ZMIXSS(1,I2)*SIN(ALPHA)) + ELSEIF(NUMH.EQ.3) THEN + XIJ=-XIJ*(ZMIXSS(2,I1)*SIN(BETA)-ZMIXSS(1,I1)*COS(BETA)) + XJI=-XJI*(ZMIXSS(2,I2)*SIN(BETA)-ZMIXSS(1,I2)*COS(BETA)) + ENDIF + DWID=DIJ*(XIJ+XJI)**2 + DWID=DWID*SQRT(LAMB)/(8.0*PI*(MH**3)) + IF(NUMH.EQ.1.OR.NUMH.EQ.2) THEN + TEMP2 = ((MH**2)-(M1-2.0*TEMP*M2)**2) + ELSEIF(NUMH.EQ.3) THEN + TEMP2=((MH**2)-(M1+2.0*TEMP*M2)**2) + ENDIF + DWID=DWID*TEMP2 + WID=DWID + CALL SSSAVE(IDHHA,WID,ID1,ID2,0,0,0) +120 CONTINUE +110 CONTINUE +100 CONTINUE +C +C Loop over h+ decays into wi(iw) + zi(iz) +C + MH=AMHC + DO 210 IW=1,2 + IF(IW.EQ.1) THEN + M1=ABS(AMW1SS) + ID1=ISW1 + SN1=SIGN(1.,AMW1SS) + ELSE + M1=ABS(AMW2SS) + ID1=ISW2 + SN1=SIGN(1.,AMW2SS) + ENDIF + DO 220 IZ=1,4 + M2=ABS(AMZISS(IZ)) + ID2=IDZI(IZ) + SN2=SIGN(1.,AMZISS(IZ)) + IF(M1+M2.GE.MH) GO TO 220 + LAMB=SSDLAM(MH**2,M1**2,M2**2) + T2=MH**2-M1**2-M2**2 + IF(IW.EQ.1) THEN + RWZ=COS(BETA)*A(2,IZ)*SN1 + TEMP=SIN(BETA)*A(4,IZ)*SN2 + SWZ=0.5*(RWZ+TEMP) + RWZ=0.5*(RWZ-TEMP) + ELSE + RWZ=COS(BETA)*A(1,IZ)*THETY*SN1 + TEMP=SIN(BETA)*A(3,IZ)*THETX*SN2 + SWZ=0.5*(RWZ+TEMP) + RWZ=0.5*(RWZ-TEMP) + ENDIF + DWID=RWZ**2+SWZ**2 + DWID=DWID*T2 + TEMP=2*M1*M2*(RWZ**2-SWZ**2) + DWID=(DWID-TEMP)/(8.0*PI*(MH**3)) + DWID=DWID*SQRT(LAMB) + WID=DWID + CALL SSSAVE(ISHC,WID,ID1,ID2,0,0,0) +220 CONTINUE +210 CONTINUE + RETURN + END diff --git a/ISAJET/isasusy/sshsf.F b/ISAJET/isasusy/sshsf.F new file mode 100644 index 00000000000..a3fab02cc11 --- /dev/null +++ b/ISAJET/isasusy/sshsf.F @@ -0,0 +1,676 @@ +#include "isajet/pilot.h" + SUBROUTINE SSHSF +C----------------------------------------------------------------------- +C +C Calculates the partial decay widths of +C the Higgs bosons into sfermions. +C calculated by X. Tata +C program by M. Bisset +C +C 10/23/93: modified by H. Baer, 10/8/96 +C Intra-flavor sfermion mixing is neglected +C for all flavors EXCEPT for stops, sbottoms and staus. +C +C +C 10/23/93 +C It is assumed that the A-terms are real. +C In addition, all coefficients of the sfermion +C trilinear terms from the superpotential +C EXCEPT the stop (AAT), sbottom (AAB) and stau (AAL) +C coefficients are set to zero. +C +C ===> Code for the general case removing all these +C artificial restrictions is present below. +C The preceeding restrictions are specified +C by giving special values to some variables +C This is discussed in two sections beginning +C with the symbols (*@&*) in the code below. +C +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sslun.inc" +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstype.inc" +C +C + REAL SR2,PI,GG,TW2,BETA,DSA,DCA,DSB,DCB,MH + REAL EP,TANB,COTB,ATERM,MSFMIX,THETSF,SIN2B + REAL TEMP,TEMP1,TEMP2,YA1,YA2 + REAL SINA,COSA,SINA2,COSA2,M1,M2,M12,LAMB + REAL SINAU,COSAU,SINAD,COSAD + REAL A11,A22,A12,B11,B22,B12,C11,C12,C21,C22 + REAL ASQ,BSQ,CSQ,DWSF + REAL DWSFL,DWSFH,DWSFP,DWSFC,SSXLAM + REAL ASMB,MBMB,MBQ,ASMT,MTMT,MTQ,SUALFS + DOUBLE PRECISION SSMQCD + DIMENSION ATERM(12),MSFMIX(12,2),THETSF(12) + DIMENSION ASQ(10,3),BSQ(9),CSQ(6,4) + DIMENSION DWSF(12,4),DWSFL(12,4),DWSFH(12,4) + DIMENSION DWSFP(12,4),DWSFC(6,4) + INTEGER II,IJ,JJ,IC,IJU,IJD,NUMH +C +C + SR2=SQRT(2.0) + PI=4.0*ATAN(1.0) + TW2=SN2THW/(1.0-SN2THW) + GG=SQRT(4.0*PI*ALFAEM/SN2THW) + EP=TWOM1 +C + TANB=1.0/RV2V1 + COTB=RV2V1 + BETA=ATAN(1.0/RV2V1) + DSA=SIN(ALFAH) + DCA=COS(ALFAH) + DSB=SIN(BETA) + DCB=COS(BETA) + SIN2B=2.0*DSB*DCB +C +C Set A-terms. +C (all A-terms are assumed to be real) +C The A-terms are loaded into the array ATERM(12) +C in the following way: +C ATERM(1)=selectron A-term +C ATERM(2)=smuon A-term +C ATERM(3)=stau A-term +C ATERM(4)=up squark A-term +C ATERM(5)=charm squark A-term +C ATERM(6)=down squark A-term +C ATERM(7)=strange squark A-term +C ATERM(8)=sbottom A-term +C ATERM(9)=stop A-term +C ATERM(10)=selectronic sneutrino A-term +C ATERM(11)=smuonic sneutrino A-term +C ATERM(12)=stauonic sneutrino A-term +C + DO 10 II=1,7 + ATERM(II)=0.0 +10 CONTINUE + ATERM(3)=AAL + ATERM(8)=AAB + ATERM(9)=AAT + DO 20 II=10,12 + ATERM(II)=0.0 +20 CONTINUE +C +C Set mixing parameters. +C The intra-flavor-mixed sfermion masses are loaded into +C the array MSFMIX(12,2) where (#,1) is the lighter +C mixed sfermion mass of a given flavor and (#,2) is the +C heavier sfermion mass. The sfermionic mixing angles are +C loaded into the array THETSF(12). The identities of the +C elements of these arrays are given below: +C MSFMIX(1,*)=mixed selectron masses +C THETSF(1)=selectron mixing angle +C MSFMIX(2,*)=mixed smuon masses +C THETSF(2)=smuon mixing angle +C MSFMIX(3,*)=mixed stau masses +C THETSF(3)=stau mixing angle +C MSFMIX(4,*)=mixed up squark masses +C THETSF(4)=up squark mixing angle +C MSFMIX(5,*)=mixed charm squark masses +C THETSF(5)=charm squark mixing angle +C MSFMIX(6,*)=mixed down squark masses +C THETSF(6)=down squark mixing angle +C MSFMIX(7,*)=mixed strange squark masses +C THETSF(7)=strange squark mixing angle +C MSFMIX(8,*)=mixed sbottom masses +C THETSF(8)=sbottom mixing angle +C MSFMIX(9,*)=mixed stop masses +C THETSF(9)=stop mixing angle +C For sneuterinos MSFMIX(#,2)=0.0, THETSF(#)=0.0 ; #=10-12 +C Yukawa contributions from D-terms to the sneutrino masses +C are supposed to be added in here. +C MSFMIX(10,1)= selectronic sneutrino mass with D-terms +C MSFMIX(11,1)= smuonic sneutrino mass with D-terms +C MSFMIX(12,1)= stauonic sneutrino mass with D-terms +C + DO 30 II=10,12 + MSFMIX(II,2)=0.0 + THETSF(II)=0.0 +30 CONTINUE +C +C +C (*@&*) 10/24/93 - Special conditions used --- +C set all mixing angles EXCEPT stop, sbottom, stau to zero. +C For all EXCEPT st, sb and stau, set mixed sfermion masses +C to bare sfermion masses: +C MSFMIX(#,1) = Left sfermion mass +C MSFMIX(#,2) = Right sfermion mass ; # = 1-8 +C but +C MSFMIX(9,1) = AMT1SS +C MSFMIX(9,2) = AMT2SS , etc. +C +C (The choice of which to call Left and which to call +C Right is based on the definition of the sfermion +C mixing angle theta_sf : +C sfermion_1 = cos(theta_sf) * sfermion_L +C - sin(theta_sf) * sfermion_R +C sfermion_2 = sin(theta_sf) * sfermion_L +C + cos(theta_sf) * sfermion_R +C Thus if we set theta_sf = 0, then +C sfermion_1 = sfermion_L +C and sfermion_2 = sfermion_R . ) +C + DO 40 II=1,7 + THETSF(II)=0.0 +40 CONTINUE + MSFMIX(1,1)=AMELSS + MSFMIX(1,2)=AMERSS + MSFMIX(2,1)=AMMLSS + MSFMIX(2,2)=AMMRSS + MSFMIX(3,1)=AML1SS + MSFMIX(3,2)=AML2SS + THETSF(3)=THETAL + MSFMIX(4,1)=AMULSS + MSFMIX(4,2)=AMURSS + MSFMIX(5,1)=AMCLSS + MSFMIX(5,2)=AMCRSS + MSFMIX(6,1)=AMDLSS + MSFMIX(6,2)=AMDRSS + MSFMIX(7,1)=AMSLSS + MSFMIX(7,2)=AMSRSS + MSFMIX(8,1)=AMB1SS + MSFMIX(8,2)=AMB2SS + THETSF(8)=THETAB + MSFMIX(9,1)=AMT1SS + MSFMIX(9,2)=AMT2SS + THETSF(9)=THETAT + MSFMIX(10,1)=AMN1SS + MSFMIX(11,1)=AMN2SS + MSFMIX(12,1)=AMN3SS +C + DO 1000 NUMH=1,4 + IF(NUMH.EQ.1) THEN + MH=AMHL + ELSE IF(NUMH.EQ.2) THEN + MH=AMHH + ELSE IF(NUMH.EQ.3) THEN + MH=AMHA + GO TO 233 + ELSE IF(NUMH.EQ.4) THEN + MH=AMHC + GO TO 333 + ENDIF + ASMB=SUALFS(AMBT**2,.36,AMTP,3) + MBMB=AMBT*(1.-4*ASMB/3./PI) + MBQ=SSMQCD(DBLE(MBMB),DBLE(MH)) + ASMT=SUALFS(AMTP**2,.36,AMTP,3) + MTMT=AMTP/(1.+4*ASMT/3./PI+(16.11-1.04*(5.-6.63/AMTP))* + $(ASMT/PI)**2) + MTQ=SSMQCD(DBLE(MTMT),DBLE(MH)) + +C +C Scalar neutral Higgses --> sfermions +C partial decay widths +C + IF(NUMH.EQ.1) THEN + TEMP=GG*AMW*SIN(BETA-ALFAH)/2.0 + YA1=DCA + YA2=DSA + ELSE IF(NUMH.EQ.2) THEN + TEMP=-GG*AMW*COS(BETA-ALFAH)/2.0 + YA1=-DSA + YA2=DCA + ENDIF +C + TEMP1=TEMP*(1.0-TW2/3.0) + TEMP2=GG*YA1/(AMW*DSB) + ASQ(4,1)=TEMP1-TEMP2*AMUP**2 + ASQ(5,1)=TEMP1-TEMP2*AMCH**2 + ASQ(9,1)=TEMP1-TEMP2*MTQ**2 +C + TEMP1=-TEMP*(1.0+TW2/3.0) + TEMP2=GG*YA2/(AMW*DCB) + ASQ(6,1)=-TEMP1-TEMP2*AMDN**2 + ASQ(7,1)=-TEMP1-TEMP2*AMST**2 + ASQ(8,1)=-TEMP1-TEMP2*MBQ**2 +C + ASQ(10,1)=TEMP*(1.0+TW2) + TEMP1=TEMP*(TW2-1.0) + TEMP2=GG*YA2/(AMW*DCB) + ASQ(1,1)=TEMP1-TEMP2*AME**2 + ASQ(2,1)=TEMP1-TEMP2*AMMU**2 + ASQ(3,1)=TEMP1-TEMP2*AMTAU**2 +C + TEMP1=4.0*TEMP*TW2/3.0 + TEMP2=GG*YA1/(AMW*DSB) + ASQ(4,2)=TEMP1-TEMP2*AMUP**2 + ASQ(5,2)=TEMP1-TEMP2*AMCH**2 + ASQ(9,2)=TEMP1-TEMP2*MTQ**2 +C + TEMP1=-2.0*TEMP*TW2/3.0 + TEMP2=GG*YA2/(AMW*DCB) + ASQ(6,2)=TEMP1-TEMP2*AMDN**2 + ASQ(7,2)=TEMP1-TEMP2*AMST**2 + ASQ(8,2)=TEMP1-TEMP2*MBQ**2 +C + ASQ(10,2)=0.0 + TEMP1=-2.0*TEMP*TW2 + TEMP2=GG*YA2/(AMW*DCB) + ASQ(1,2)=TEMP1-TEMP2*AME**2 + ASQ(2,2)=TEMP1-TEMP2*AMMU**2 + ASQ(3,2)=TEMP1-TEMP2*AMTAU**2 +C + TEMP1=GG/(2.0*AMW*DSB) + ASQ(4,3)=(EP*YA2 + ATERM(4)*YA1)*TEMP1*AMUP + ASQ(5,3)=(EP*YA2 + ATERM(5)*YA1)*TEMP1*AMCH + ASQ(9,3)=(EP*YA2 + ATERM(9)*YA1)*TEMP1*MTQ +C + TEMP1=GG/(2.0*AMW*DCB) + ASQ(6,3)=(ATERM(6)*YA2 + EP*YA1)*TEMP1*AMDN + ASQ(7,3)=(ATERM(7)*YA2 + EP*YA1)*TEMP1*AMST + ASQ(8,3)=(ATERM(8)*YA2 + EP*YA1)*TEMP1*MBQ +C + ASQ(10,3)=0.0 + ASQ(1,3)=(ATERM(1)*YA2 + EP*YA1)*TEMP1*AME + ASQ(2,3)=(ATERM(2)*YA2 + EP*YA1)*TEMP1*AMMU + ASQ(3,3)=(ATERM(3)*YA2 + EP*YA1)*TEMP1*AMTAU +C +C + DO 150 IJ=1,9 + IF(IJ.LT.4) THEN + TEMP1=1.0/(16.0*PI*MH**3) + ELSE + TEMP1=3.0/(16.0*PI*MH**3) + ENDIF + SINA=SIN(THETSF(IJ)) + COSA=COS(THETSF(IJ)) + SINA2=SINA**2 + COSA2=COSA**2 + M1=MSFMIX(IJ,1) + M2=MSFMIX(IJ,1) + M12=M1+M2 + IF(MH.GT.M12) THEN + A11=ASQ(IJ,1)*COSA2+ASQ(IJ,2)*SINA2 + $ -2.0*ASQ(IJ,3)*SINA*COSA + LAMB=SSXLAM(MH**2,M1**2,M2**2) + DWSF(IJ,1)=TEMP1*SQRT(LAMB)*A11**2 + ELSE IF(MH.LE.M12) THEN + DWSF(IJ,1)=0.0 + ENDIF +C + M1=MSFMIX(IJ,2) + M2=MSFMIX(IJ,2) + M12=M1+M2 + IF(MH.GT.M12) THEN + A22=ASQ(IJ,1)*SINA2+ASQ(IJ,2)*COSA2 + $ +2.0*ASQ(IJ,3)*SINA*COSA + LAMB=SSXLAM(MH**2,M1**2,M2**2) + DWSF(IJ,2)=TEMP1*SQRT(LAMB)*A22**2 + ELSE IF(MH.LE.M12) THEN + DWSF(IJ,2)=0.0 + ENDIF +C + M1=MSFMIX(IJ,1) + M2=MSFMIX(IJ,2) + M12=M1+M2 + IF(MH.GT.M12) THEN + A12=(ASQ(IJ,1)-ASQ(IJ,2))*SINA*COSA + $ +ASQ(IJ,3)*(COSA2-SINA2) + LAMB=SSXLAM(MH**2,M1**2,M2**2) + DWSF(IJ,3)=TEMP1*SQRT(LAMB)*A12**2 + ELSE IF(MH.LE.M12) THEN + DWSF(IJ,3)=0.0 + ENDIF +C + DWSF(IJ,4)=DWSF(IJ,3) +C + IF(NUMH.EQ.1) THEN + DO 121 JJ=1,4 + DWSFL(IJ,JJ)=DWSF(IJ,JJ) +121 CONTINUE + ELSE IF(NUMH.EQ.2) THEN + DO 122 JJ=1,4 + DWSFH(IJ,JJ)=DWSF(IJ,JJ) +122 CONTINUE + ENDIF +C +150 CONTINUE +C +C Now take care of sneutrinos. +C + DO 155 IJ=10,12 + M1=MSFMIX(IJ,1) + M2=MSFMIX(IJ,1) + M12=M1+M2 + IF(MH.GT.M12) THEN + LAMB=SSXLAM(MH**2,M1**2,M2**2) + DWSF(IJ,1)=SQRT(LAMB)*(ASQ(10,1))**2 + $ /(16.0*PI*MH**3) + ELSE IF(MH.LE.M12) THEN + DWSF(IJ,1) = 0.0 + ENDIF + DWSF(IJ,2)=0.0 + DWSF(IJ,3)=0.0 + DWSF(IJ,4)=0.0 + IF(NUMH.EQ.1) THEN + DO 151 JJ=1,4 + DWSFL(IJ,JJ)=DWSF(IJ,JJ) +151 CONTINUE + ELSE IF(NUMH.EQ.2) THEN + DO 152 JJ=1,4 + DWSFH(IJ,JJ)=DWSF(IJ,JJ) +152 CONTINUE + ENDIF +C +155 CONTINUE + GO TO 1000 +C +C +C Pseudocalar neutral Higgses --> sfermions +C partial decay widths +C +233 TEMP1=GG/(2.0*AMW) + BSQ(1)=TEMP1*AME*(EP-TANB*ATERM(1)) + BSQ(2)=TEMP1*AMMU*(EP-TANB*ATERM(2)) + BSQ(3)=TEMP1*AMTAU*(EP-TANB*ATERM(3)) + BSQ(4)=TEMP1*AMUP*(EP-COTB*ATERM(4)) + BSQ(5)=TEMP1*AMCH*(EP-COTB*ATERM(5)) + BSQ(6)=TEMP1*AMDN*(EP-TANB*ATERM(6)) + BSQ(7)=TEMP1*AMST*(EP-TANB*ATERM(7)) + BSQ(8)=TEMP1*MBQ*(EP-TANB*ATERM(8)) + BSQ(9)=TEMP1*MTQ*(EP-COTB*ATERM(9)) +C + DO 260 IJ=1,9 + IF(IJ.LT.4) THEN + TEMP1=1.0/(16.0*PI*MH**3) + ELSE + TEMP1=3.0/(16.0*PI*MH**3) + ENDIF + SINA=SIN(THETSF(IJ)) + COSA=COS(THETSF(IJ)) + SINA2=SINA**2 + COSA2=COSA**2 + M1=MSFMIX(IJ,1) + M2=MSFMIX(IJ,1) + M12=M1+M2 + IF(MH.GT.M12) THEN + B11=-2.0*COSA*SINA*BSQ(IJ) + LAMB=SSXLAM(MH**2,M1**2,M2**2) + DWSFP(IJ,1)=TEMP1*SQRT(LAMB)*B11**2 + ELSE IF(MH.LE.M12) THEN + DWSFP(IJ,1)=0.0 + ENDIF +C + M1=MSFMIX(IJ,2) + M2=MSFMIX(IJ,2) + M12=M1+M2 + IF(MH.GT.M12) THEN + B22=-B11 + LAMB=SSXLAM(MH**2,M1**2,M2**2) + DWSFP(IJ,2)=TEMP1*SQRT(LAMB)*B22**2 + ELSE IF(MH.LE.M12) THEN + DWSFP(IJ,2)=0.0 + ENDIF + M1=MSFMIX(IJ,1) + M2=MSFMIX(IJ,2) + M12=M1+M2 + IF(MH.GT.M12) THEN + B12=(COSA2-SINA2)*BSQ(IJ) + LAMB=SSXLAM(MH**2,M1**2,M2**2) + DWSFP(IJ,3)=TEMP1*SQRT(LAMB)*B12**2 + ELSE IF(MH.LE.M12) THEN + DWSFP(IJ,3)=0.0 + ENDIF + DWSFP(IJ,4)=DWSFP(IJ,3) +260 CONTINUE + DO 265 IJ=10,12 + DO 264 JJ=1,4 + DWSFP(IJ,JJ)=0.0 +264 CONTINUE +265 CONTINUE + GO TO 1000 +C +C Charged Higgses --> sfermions +C partial decay widths +C +333 TEMP1=-AMW*SIN2B + CSQ(1,1)=GG*(TEMP1+(TANB*AMDN**2 + COTB*AMUP**2)/AMW)/SR2 + CSQ(2,1)=GG*(TEMP1+(TANB*AMST**2 + COTB*AMCH**2)/AMW)/SR2 + CSQ(3,1)=GG*(TEMP1+(TANB*MBQ**2 + COTB*MTQ**2)/AMW)/SR2 + CSQ(4,1)=GG*(TEMP1 + (TANB*AME**2)/AMW)/SR2 + CSQ(5,1)=GG*(TEMP1 + (TANB*AMMU**2)/AMW)/SR2 + CSQ(6,1)=GG*(TEMP1 + (TANB*AMTAU**2)/AMW)/SR2 +C + TEMP1=GG*(COTB+TANB)/(SR2*AMW) + CSQ(1,2)=TEMP1*AMUP*AMDN + CSQ(2,2)=TEMP1*AMCH*AMST + CSQ(3,2)=TEMP1*MTQ*MBQ + CSQ(4,2)=0.0 + CSQ(5,2)=0.0 + CSQ(6,2)=0.0 +C + TEMP1=GG/(SR2*AMW) + CSQ(1,3)=TEMP1*AMUP*(EP-COTB*ATERM(4)) + CSQ(2,3)=TEMP1*AMCH*(EP-COTB*ATERM(5)) + CSQ(3,3)=TEMP1*MTQ*(EP-COTB*ATERM(9)) + CSQ(4,3)=0.0 + CSQ(5,3)=0.0 + CSQ(6,3)=0.0 +C + CSQ(1,4)=TEMP1* AMDN*(EP-TANB*ATERM(6)) + CSQ(2,4)=TEMP1* AMST*(EP-TANB*ATERM(7)) + CSQ(3,4)=TEMP1* MBQ*(EP-TANB*ATERM(8)) + CSQ(4,4)=TEMP1* AME*(EP-TANB*ATERM(1)) + CSQ(5,4)=TEMP1* AMMU*(EP-TANB*ATERM(2)) + CSQ(6,4)=TEMP1* AMTAU*(EP-TANB*ATERM(3)) +C + DO 350 IC=1,3 + TEMP1=3.0/(16.0*PI*MH**3) + IF(IC.EQ.1) THEN + IJU=4 + IJD=6 + ELSE IF(IC.EQ.2) THEN + IJU=5 + IJD=7 + ELSE IF(IC.EQ.3) THEN + IJU=9 + IJD=8 + ENDIF + SINAU=SIN(THETSF(IJU)) + COSAU=COS(THETSF(IJU)) + SINAD=SIN(THETSF(IJD)) + COSAD=COS(THETSF(IJD)) +C + M1=MSFMIX(IJU,1) + M2=MSFMIX(IJD,1) + M12=M1+M2 + IF(MH.GT.M12) THEN + C11=COSAU*COSAD*CSQ(IC,1) + $ + SINAU*SINAD*CSQ(IC,2) + $ - SINAU*COSAD*CSQ(IC,3) + $ - COSAU*SINAD*CSQ(IC,4) + LAMB=SSXLAM(MH**2,M1**2,M2**2) + DWSFC(IC,1)=TEMP1*SQRT(LAMB)*C11**2 + ELSE IF(MH.LE.M12) THEN + DWSFC(IC,1) = 0.0 + ENDIF +C + M1=MSFMIX(IJU,1) + M2=MSFMIX(IJD,2) + M12=M1+M2 + IF(MH.GT.M12) THEN + C12=COSAU*SINAD*CSQ(IC,1) + $ - SINAU*COSAD*CSQ(IC,2) + $ - SINAU*SINAD*CSQ(IC,3) + $ + COSAU*COSAD*CSQ(IC,4) + LAMB=SSXLAM(MH**2,M1**2,M2**2) + DWSFC(IC,2)=TEMP1*SQRT(LAMB)*C12**2 + ELSE IF(MH.LE.M12) THEN + DWSFC(IC,2)=0.0 + ENDIF +C + M1=MSFMIX(IJU,2) + M2=MSFMIX(IJD,1) + M12=M1+M2 + IF(MH.GT.M12) THEN + C21=SINAU*COSAD*CSQ(IC,1) + $ - COSAU*SINAD*CSQ(IC,2) + $ + COSAU*COSAD*CSQ(IC,3) + $ - SINAU*SINAD*CSQ(IC,4) + LAMB=SSXLAM(MH**2,M1**2,M2**2) + DWSFC(IC,3)=TEMP1*SQRT(LAMB)*C21**2 + ELSE IF(MH.LE.M12) THEN + DWSFC(IC,3)=0.0 + ENDIF +C + M1=MSFMIX(IJU,2) + M2=MSFMIX(IJD,2) + M12=M1+M2 + IF(MH.GT.M12) THEN + C22=SINAU*SINAD*CSQ(IC,1) + $ + COSAU*COSAD*CSQ(IC,2) + $ + COSAU*SINAD*CSQ(IC,3) + $ - SINAU*COSAD*CSQ(IC,4) + LAMB=SSXLAM(MH**2,M1**2,M2**2) + DWSFC(IC,4)=TEMP1*SQRT(LAMB)*C22**2 + ELSE IF(MH.LE.M12) THEN + DWSFC(IC,4)=0.0 + ENDIF +C +350 CONTINUE +C +C +C Now calculate the sleptonic +C partial decay widths of the +C charged Higgs. +C + DO 355 IC = 4,6 + TEMP1=1.0/(16.0*PI*MH**3) + IF(IC.EQ.4) THEN + IJU=10 + IJD=1 + ELSE IF(IC.EQ.5) THEN + IJU=11 + IJD=2 + ELSE IF(IC.EQ.6) THEN + IJU=12 + IJD=3 + ENDIF + SINAD=SIN(THETSF(IJD)) + COSAD=COS(THETSF(IJD)) +C + M1=MSFMIX(IJU,1) + M2=MSFMIX(IJD,1) + M12=M1+M2 + IF(MH.GT.M12) THEN + C11=COSAD*CSQ(IC,1)-SINAD*CSQ(IC,4) + LAMB=SSXLAM(MH**2,M1**2,M2**2) + DWSFC(IC,1)=TEMP1*SQRT(LAMB)*C11**2 + ELSE IF(MH.LE.M12) THEN + DWSFC(IC,1)=0.0 + ENDIF +C + M1=MSFMIX(IJU,1) + M2=MSFMIX(IJD,2) + M12=M1+M2 + IF(MH.GT.M12) THEN + C12=SINAD*CSQ(IC,1)+COSAD*CSQ(IC,4) + LAMB=SSXLAM(MH**2,M1**2,M2**2) + DWSFC(IC,2)=TEMP1*SQRT(LAMB)*C12**2 + ELSE IF(MH.LE.M12) THEN + DWSFC(IC,2)=0.0 + ENDIF + DWSFC(IC,3)=0.0 + DWSFC(IC,4)=0.0 +355 CONTINUE +1000 CONTINUE +C H_l decays + CALL SSSAVE(ISHL,DWSFL(1,1),ISEL,-ISEL,0,0,0) + CALL SSSAVE(ISHL,DWSFL(1,2),ISER,-ISER,0,0,0) + CALL SSSAVE(ISHL,DWSFL(2,1),ISMUL,-ISMUL,0,0,0) + CALL SSSAVE(ISHL,DWSFL(2,2),ISMUR,-ISMUR,0,0,0) + CALL SSSAVE(ISHL,DWSFL(3,1),ISTAU1,-ISTAU1,0,0,0) + CALL SSSAVE(ISHL,DWSFL(3,2),ISTAU2,-ISTAU2,0,0,0) + CALL SSSAVE(ISHL,DWSFL(3,3),ISTAU1,-ISTAU2,0,0,0) + CALL SSSAVE(ISHL,DWSFL(3,4),ISTAU2,-ISTAU1,0,0,0) + CALL SSSAVE(ISHL,DWSFL(4,1),ISUPL,-ISUPL,0,0,0) + CALL SSSAVE(ISHL,DWSFL(4,2),ISUPR,-ISUPR,0,0,0) + CALL SSSAVE(ISHL,DWSFL(5,1),ISCHL,-ISCHL,0,0,0) + CALL SSSAVE(ISHL,DWSFL(5,2),ISCHR,-ISCHR,0,0,0) + CALL SSSAVE(ISHL,DWSFL(6,1),ISDNL,-ISDNL,0,0,0) + CALL SSSAVE(ISHL,DWSFL(6,2),ISDNR,-ISDNR,0,0,0) + CALL SSSAVE(ISHL,DWSFL(7,1),ISSTL,-ISSTL,0,0,0) + CALL SSSAVE(ISHL,DWSFL(7,2),ISSTR,-ISSTR,0,0,0) + CALL SSSAVE(ISHL,DWSFL(8,1),ISBT1,-ISBT1,0,0,0) + CALL SSSAVE(ISHL,DWSFL(8,2),ISBT2,-ISBT2,0,0,0) + CALL SSSAVE(ISHL,DWSFL(8,3),ISBT1,-ISBT2,0,0,0) + CALL SSSAVE(ISHL,DWSFL(8,4),ISBT2,-ISBT1,0,0,0) + CALL SSSAVE(ISHL,DWSFL(9,1),ISTP1,-ISTP1,0,0,0) + CALL SSSAVE(ISHL,DWSFL(9,2),ISTP2,-ISTP2,0,0,0) + CALL SSSAVE(ISHL,DWSFL(9,3),ISTP1,-ISTP2,0,0,0) + CALL SSSAVE(ISHL,DWSFL(9,4),ISTP2,-ISTP1,0,0,0) + CALL SSSAVE(ISHL,DWSFL(10,1),ISNEL,-ISNEL,0,0,0) + CALL SSSAVE(ISHL,DWSFL(11,1),ISNML,-ISNML,0,0,0) + CALL SSSAVE(ISHL,DWSFL(12,1),ISNTL,-ISNTL,0,0,0) +C H_h decays + CALL SSSAVE(ISHH,DWSFH(1,1),ISEL,-ISEL,0,0,0) + CALL SSSAVE(ISHH,DWSFH(1,2),ISER,-ISER,0,0,0) + CALL SSSAVE(ISHH,DWSFH(2,1),ISMUL,-ISMUL,0,0,0) + CALL SSSAVE(ISHH,DWSFH(2,2),ISMUR,-ISMUR,0,0,0) + CALL SSSAVE(ISHH,DWSFH(3,1),ISTAU1,-ISTAU1,0,0,0) + CALL SSSAVE(ISHH,DWSFH(3,2),ISTAU2,-ISTAU2,0,0,0) + CALL SSSAVE(ISHH,DWSFH(3,3),ISTAU1,-ISTAU2,0,0,0) + CALL SSSAVE(ISHH,DWSFH(3,4),ISTAU2,-ISTAU1,0,0,0) + CALL SSSAVE(ISHH,DWSFH(4,1),ISUPL,-ISUPL,0,0,0) + CALL SSSAVE(ISHH,DWSFH(4,2),ISUPR,-ISUPR,0,0,0) + CALL SSSAVE(ISHH,DWSFH(5,1),ISCHL,-ISCHL,0,0,0) + CALL SSSAVE(ISHH,DWSFH(5,2),ISCHR,-ISCHR,0,0,0) + CALL SSSAVE(ISHH,DWSFH(6,1),ISDNL,-ISDNL,0,0,0) + CALL SSSAVE(ISHH,DWSFH(6,2),ISDNR,-ISDNR,0,0,0) + CALL SSSAVE(ISHH,DWSFH(7,1),ISSTL,-ISSTL,0,0,0) + CALL SSSAVE(ISHH,DWSFH(7,2),ISSTR,-ISSTR,0,0,0) + CALL SSSAVE(ISHH,DWSFH(8,1),ISBT1,-ISBT1,0,0,0) + CALL SSSAVE(ISHH,DWSFH(8,2),ISBT2,-ISBT2,0,0,0) + CALL SSSAVE(ISHH,DWSFH(8,3),ISBT1,-ISBT2,0,0,0) + CALL SSSAVE(ISHH,DWSFH(8,4),ISBT2,-ISBT1,0,0,0) + CALL SSSAVE(ISHH,DWSFH(9,1),ISTP1,-ISTP1,0,0,0) + CALL SSSAVE(ISHH,DWSFH(9,2),ISTP2,-ISTP2,0,0,0) + CALL SSSAVE(ISHH,DWSFH(9,3),ISTP1,-ISTP2,0,0,0) + CALL SSSAVE(ISHH,DWSFH(9,4),ISTP2,-ISTP1,0,0,0) + CALL SSSAVE(ISHH,DWSFH(10,1),ISNEL,-ISNEL,0,0,0) + CALL SSSAVE(ISHH,DWSFH(11,1),ISNML,-ISNML,0,0,0) + CALL SSSAVE(ISHH,DWSFH(12,1),ISNTL,-ISNTL,0,0,0) +C Decay of H_p + CALL SSSAVE(ISHA,DWSFP(1,3),ISEL,-ISER,0,0,0) + CALL SSSAVE(ISHA,DWSFP(1,4),ISER,-ISEL,0,0,0) + CALL SSSAVE(ISHA,DWSFP(2,3),ISMUL,-ISMUR,0,0,0) + CALL SSSAVE(ISHA,DWSFP(2,4),ISMUR,-ISMUL,0,0,0) + CALL SSSAVE(ISHA,DWSFP(3,1),ISTAU1,-ISTAU1,0,0,0) + CALL SSSAVE(ISHA,DWSFP(3,2),ISTAU2,-ISTAU2,0,0,0) + CALL SSSAVE(ISHA,DWSFP(3,3),ISTAU1,-ISTAU2,0,0,0) + CALL SSSAVE(ISHA,DWSFP(3,4),ISTAU2,-ISTAU1,0,0,0) + CALL SSSAVE(ISHA,DWSFP(4,3),ISUPL,-ISUPR,0,0,0) + CALL SSSAVE(ISHA,DWSFP(4,4),ISUPR,-ISUPL,0,0,0) + CALL SSSAVE(ISHA,DWSFP(5,3),ISCHL,-ISCHR,0,0,0) + CALL SSSAVE(ISHA,DWSFP(5,4),ISCHR,-ISCHL,0,0,0) + CALL SSSAVE(ISHA,DWSFP(6,3),ISDNL,-ISDNR,0,0,0) + CALL SSSAVE(ISHA,DWSFP(6,4),ISDNR,-ISDNL,0,0,0) + CALL SSSAVE(ISHA,DWSFP(7,3),ISSTL,-ISSTR,0,0,0) + CALL SSSAVE(ISHA,DWSFP(7,4),ISSTR,-ISSTL,0,0,0) + CALL SSSAVE(ISHA,DWSFP(8,1),ISBT1,-ISBT1,0,0,0) + CALL SSSAVE(ISHA,DWSFP(8,2),ISBT2,-ISBT2,0,0,0) + CALL SSSAVE(ISHA,DWSFP(8,3),ISBT1,-ISBT2,0,0,0) + CALL SSSAVE(ISHA,DWSFP(8,4),ISBT2,-ISBT1,0,0,0) + CALL SSSAVE(ISHA,DWSFP(9,1),ISTP1,-ISTP1,0,0,0) + CALL SSSAVE(ISHA,DWSFP(9,2),ISTP2,-ISTP2,0,0,0) + CALL SSSAVE(ISHA,DWSFP(9,3),ISTP1,-ISTP2,0,0,0) + CALL SSSAVE(ISHA,DWSFP(9,4),ISTP2,-ISTP1,0,0,0) +C Decay of H+ + CALL SSSAVE(ISHC,DWSFC(1,1),ISUPL,-ISDNL,0,0,0) + CALL SSSAVE(ISHC,DWSFC(1,2),ISUPR,-ISDNR,0,0,0) + CALL SSSAVE(ISHC,DWSFC(2,1),ISCHL,-ISSTL,0,0,0) + CALL SSSAVE(ISHC,DWSFC(2,2),ISCHR,-ISSTR,0,0,0) + CALL SSSAVE(ISHC,DWSFC(3,1),ISTP1,-ISBT1,0,0,0) + CALL SSSAVE(ISHC,DWSFC(3,2),ISTP1,-ISBT2,0,0,0) + CALL SSSAVE(ISHC,DWSFC(3,3),ISTP2,-ISBT1,0,0,0) + CALL SSSAVE(ISHC,DWSFC(3,4),ISTP2,-ISBT2,0,0,0) + CALL SSSAVE(ISHC,DWSFC(4,1),-ISEL,ISNEL,0,0,0) + CALL SSSAVE(ISHC,DWSFC(5,1),-ISMUL,ISNML,0,0,0) + CALL SSSAVE(ISHC,DWSFC(6,1),-ISTAU1,ISNTL,0,0,0) + CALL SSSAVE(ISHC,DWSFC(6,2),-ISTAU2,ISNTL,0,0,0) + RETURN + END diff --git a/ISAJET/isasusy/sshww.F b/ISAJET/isasusy/sshww.F new file mode 100644 index 00000000000..e61de101839 --- /dev/null +++ b/ISAJET/isasusy/sshww.F @@ -0,0 +1,139 @@ +#include "isajet/pilot.h" + SUBROUTINE SSHWW +C----------------------------------------------------------------------- +C Calculate HL, HH -> WW, ZZ, using either the on-shell matrix +C element if kinematically allowed or the WW* or ZZ* matrix +C element from Eqn.(6) for Keung and Marciano (PRD. 84: 248). +C For the latter, save the mode as W(Z) f fbar, and require that +C MH > MW + 2 * MB. +C +C Bisset's GBDCY +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sspar.inc" +#include "isajet/sssm.inc" +#include "isajet/sstmp.inc" +#include "isajet/sstype.inc" +C + EXTERNAL SSHWW1,SSHWW2 + DOUBLE PRECISION SSHWW1,SSHWW2 + DOUBLE PRECISION PI,SR2,G2,BETA,ALPHA,SW2,CW2,CAB2,SAB2,MW,MZ + $,MH,COUPL,LOWER,UPPER,FWW1,FWW2,FWW3,FWW,DWID,FZZ + DOUBLE PRECISION SSDINT,SSDLAM + REAL WID + REAL BRZN,BRZL,BRZU,BRZD,BRWL,BRWQ + INTEGER IDHHA,IH +C Hard wired Z branching ratios + DATA BRZN,BRZL,BRZU,BRZD/.06839,.03442,.11792,.15191/ + DATA BRWL,BRWQ/.11111,.33333/ +C +C Mass matrix parameters +C + PI=4*ATAN(1.D0) + SR2=SQRT(2.D0) + G2=4*PI*ALFAEM/SN2THW + BETA=ATAN(1.0/RV2V1) + ALPHA=ALFAH + SW2=SN2THW + CW2=1.-SN2THW + CAB2=(DCOS(ALPHA+BETA))**2 + SAB2=1.0-CAB2 + MW=AMW + MZ=AMZ +C +C WW* and ZZ* decays +C + DO 100 IH=1,2 + IF(IH.EQ.1) THEN + MH=AMHL + IDHHA=ISHL + COUPL=SAB2 + ELSE + MH=AMHH + IDHHA=ISHH + COUPL=CAB2 + ENDIF +C H -> W + W* -> W + f + fbar + TMP(1)=MH + IF(MH.GT.MW+2*AMBT.AND.MH.LE.2*MW) THEN + LOWER=2*MW/MH + UPPER=1+MW**2/MH**2 + IF (LOWER.LT.0.998D0) THEN + IF (UPPER.LE.1.001D0) THEN + FWW1=SSDINT(LOWER,SSHWW1,0.998D0) + FWW2=SSDINT(0.998D0,SSHWW1,UPPER) + FWW=FWW1+FWW2 + ELSEIF(UPPER.GT.1.001D0) THEN + FWW1=SSDINT(LOWER,SSHWW1,0.998D0) + FWW2=SSDINT(0.998D0,SSHWW1,1.001D0) + FWW3=SSDINT(1.001D0,SSHWW1,UPPER) + FWW=FWW1+FWW2+FWW3 + ENDIF + ELSE IF (0.998D0.LT.LOWER.AND.LOWER.LT.1.001D0) THEN + IF (UPPER.LE.1.001D0) THEN + FWW=SSDINT(LOWER,SSHWW1,UPPER) + ELSEIF(UPPER.GT.1.001D0) THEN + FWW1=SSDINT(LOWER,SSHWW1,1.001D0) + FWW2=SSDINT(1.001D0,SSHWW1,UPPER) + FWW=FWW1+FWW2 + ENDIF + ELSE IF (LOWER.GT.1.001D0) THEN + FWW=SSDINT(LOWER,SSHWW1,UPPER) + END IF + DWID=3*(G2**2)*MH*FWW/(512.0*PI**3) + WID=DWID*COUPL + CALL SSSAVE(IDHHA,0.5*BRWL*WID,IDW,IDE,-IDNE,0,0) + CALL SSSAVE(IDHHA,0.5*BRWL*WID,IDW,IDMU,-IDNM,0,0) + CALL SSSAVE(IDHHA,0.5*BRWL*WID,IDW,IDTAU,-IDNT,0,0) + CALL SSSAVE(IDHHA,0.5*BRWQ*WID,IDW,-IDUP,IDDN,0,0) + CALL SSSAVE(IDHHA,0.5*BRWQ*WID,IDW,-IDCH,IDST,0,0) + CALL SSSAVE(IDHHA,0.5*BRWL*WID,-IDW,-IDE,IDNE,0,0) + CALL SSSAVE(IDHHA,0.5*BRWL*WID,-IDW,-IDMU,IDNM,0,0) + CALL SSSAVE(IDHHA,0.5*BRWL*WID,-IDW,-IDTAU,IDNT,0,0) + CALL SSSAVE(IDHHA,0.5*BRWQ*WID,-IDW,IDUP,-IDDN,0,0) + CALL SSSAVE(IDHHA,0.5*BRWQ*WID,-IDW,IDCH,-IDST,0,0) + ENDIF +C H -> Z + Z* -> Z + f + fbar + IF(MH.GT.MZ+2*AMBT.AND.MH.LE.2*MZ) THEN + LOWER=2*MZ/MH + UPPER=1+MZ**2/MH**2 + FZZ=SSDINT(LOWER,SSHWW2,UPPER) + DWID=7.0-40*SW2/3+160*SW2**2/9 + DWID=DWID/CW2**2 + DWID=DWID*G2**2*MH*FZZ/(2048*PI**3) + WID=DWID*COUPL + CALL SSSAVE(IDHHA,BRZN*WID,IDZ,IDNE,-IDNE,0,0) + CALL SSSAVE(IDHHA,BRZN*WID,IDZ,IDNM,-IDNM,0,0) + CALL SSSAVE(IDHHA,BRZN*WID,IDZ,IDNT,-IDNT,0,0) + CALL SSSAVE(IDHHA,BRZL*WID,IDZ,IDE,-IDE,0,0) + CALL SSSAVE(IDHHA,BRZL*WID,IDZ,IDMU,-IDMU,0,0) + CALL SSSAVE(IDHHA,BRZL*WID,IDZ,IDTAU,-IDTAU,0,0) + CALL SSSAVE(IDHHA,BRZU*WID,IDZ,IDUP,-IDUP,0,0) + CALL SSSAVE(IDHHA,BRZU*WID,IDZ,IDCH,-IDCH,0,0) + CALL SSSAVE(IDHHA,BRZD*WID,IDZ,IDDN,-IDDN,0,0) + CALL SSSAVE(IDHHA,BRZD*WID,IDZ,IDST,-IDST,0,0) + CALL SSSAVE(IDHHA,BRZD*WID,IDZ,IDBT,-IDBT,0,0) + ENDIF +100 CONTINUE +C +C HH -> WW, ZZ +C If these are allowed, the WW* and ZZ* are not. +C + MH=AMHH + IF(MH.GT.2*MW) THEN + DWID=3+(MH/MW)**4/4-(MH/MW)**2 + DWID=DWID*G2*CAB2*MW**2/(16.0*PI*MH**3) + WID=DWID*SQRT(SSDLAM(MH**2,MW**2,MW**2)) + CALL SSSAVE(ISHH,WID,IDW,-IDW,0,0,0) + ENDIF + IF(MH.GT.2*MZ) THEN + DWID=3+(MH/MZ)**4/4-(MH/MZ)**2 + DWID=DWID*G2*CAB2*MW**2/(16.0*PI*MH**3)/(2.0*CW2**2) + WID=DWID*SQRT(SSDLAM(MH**2,MZ**2,MZ**2)) + CALL SSSAVE(ISHH,WID,IDZ,IDZ,0,0,0) + ENDIF +C + RETURN + END diff --git a/ISAJET/isasusy/sshww1.F b/ISAJET/isasusy/sshww1.F new file mode 100644 index 00000000000..0c1bdb9fb63 --- /dev/null +++ b/ISAJET/isasusy/sshww1.F @@ -0,0 +1,32 @@ +#include "isajet/pilot.h" + DOUBLE PRECISION FUNCTION SSHWW1(XX) +C----------------------------------------------------------------------- +C SSHWW: hi -> w + w* +C Bisset's FUNWW +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sspar.inc" +#include "isajet/sssm.inc" +#include "isajet/sstmp.inc" +C + DOUBLE PRECISION XX,EPLN,PROP,TEMP,FN,AAA,MW,DELTAW,MH +C + MW=AMW + DELTAW=GAMW + MH=TMP(1) +C + EPLN=MW/MH + PROP=(1.D0-XX)**2 + PROP=PROP+(EPLN**2)*DELTAW**2/MH**2 + TEMP=XX**2-12*XX*EPLN**2 + TEMP=TEMP+8*EPLN**2+12*EPLN**4 + AAA=XX**2-4*EPLN**2 + IF(AAA.LT.0) THEN + AAA=0 + ENDIF + FN=TEMP*SQRT(AAA)/PROP + SSHWW1=FN + RETURN + END diff --git a/ISAJET/isasusy/sshww2.F b/ISAJET/isasusy/sshww2.F new file mode 100644 index 00000000000..b0d4f764e2b --- /dev/null +++ b/ISAJET/isasusy/sshww2.F @@ -0,0 +1,33 @@ +#include "isajet/pilot.h" + DOUBLE PRECISION FUNCTION SSHWW2(XX) +C----------------------------------------------------------------------- +C SSHWW: hi -> z + z* +C Bisset's FUNZZ +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sspar.inc" +#include "isajet/sssm.inc" +#include "isajet/sstmp.inc" +C + DOUBLE PRECISION XX,EPLN,PROP,TEMP,FN,AAA,MZ,DELTAZ,MH +C +C + MZ=AMZ + DELTAZ=GAMZ + MH=TMP(1) +C + EPLN=MZ/MH + PROP=(1.D0-XX)**2 + PROP=PROP+(EPLN**2)*DELTAZ**2/MH**2 + TEMP=XX**2-12*XX*EPLN**2 + TEMP=TEMP+8*EPLN**2+12*EPLN**4 + AAA=XX**2-4*EPLN**2 + IF(AAA.LT.0) THEN + AAA=0 + ENDIF + FN=TEMP*SQRT(AAA)/PROP + SSHWW2=FN + RETURN + END diff --git a/ISAJET/isasusy/ssl1st.F b/ISAJET/isasusy/ssl1st.F new file mode 100644 index 00000000000..c4840361a08 --- /dev/null +++ b/ISAJET/isasusy/ssl1st.F @@ -0,0 +1,23 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSL1ST(SS) +C----------------------------------------------------------------------- +C SSL1ST: l_1 -> stau_1+nu_l+nutaubar: TATA F FUNCTION +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" + REAL SS + DOUBLE PRECISION S,M1,M2,MST1,ML1,WID + S=SS + M1=TMP(1) + M2=TMP(2) + MST1=TMP(3) + ML1=TMP(4) + WID=(S-MST1**2)**2/(S-M1**2)/(S-M2**2)*(S-ML1**2)**2 + $ /S/ML1**2 + SSL1ST=WID + RETURN + END diff --git a/ISAJET/isasusy/sslpbf.F b/ISAJET/isasusy/sslpbf.F new file mode 100644 index 00000000000..620919f8d77 --- /dev/null +++ b/ISAJET/isasusy/sslpbf.F @@ -0,0 +1,976 @@ +#include "isajet/pilot.h" + SUBROUTINE SSLPBF +C-------------------------------------------------------- +C +C This program gives slepton branching fractions to gauginos +C according to Baer,Bartl,Karatas,Majerotto,Tata +C (Int. J. Mod. Phys. A4,4111 (1989); updated 10/21/96 +C +C +C------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sslun.inc" +#include "isajet/ssmode.inc" +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstype.inc" +#include "isajet/sstmp.inc" +C + EXTERNAL SSLRT1,SSL1ST,SSN1ST,SSSNWS + REAL SSXLAM,SSXINT,SSLRT1,SSN1ST,SSL1ST,SSSNWS + REAL WID,SNZI,THIZ,XM,YM,THX,THY,BPLWI(2),CS2THW + REAL VS,PI,SR2,G,GP,VP,V,TANB,ANWI(2),ALWI(2) + REAL ANIZ,AEIZ,BEIZ,MZIZ,SINL,COSL,BETA,FL,AMPL + REAL MTAMTA,MTAMB,MTAMZ,SUALFE + REAL MW1,MW2,TN2THW,SNW1,SNW2,AS,BS,BH,COSA,SINA,A + REAL XLO,SUM1,SUM2,AEJZ,TERM,WID1,WID2,SINB,COSB,COS2B,ANJZ,EMAX + REAL MEME,MEMB,MEMZ,MMMM,MMUMB,MMUMZ,TANTHE,TANTHM,THETAE,THETAM + REAL AAE,FE,AAM,FM,AME1,AML1,APE1,APL1,TM1,TM2,TM3,AMM1,APM1 + REAL BME1,BPE1 + INTEGER IZ,JZ + INTEGER ISZIZ(4) + COMPLEX ZI,ZONE,ZA,ZB,ZALIZ,ZBLIZ,ZPP,ZPM + DATA ZONE/(1.,0.)/,ZI/(0.,1.)/ +C +C Partly duplicated from SSMASS +C + AMPL=2.4E18 + PI=4.*ATAN(1.) + SR2=SQRT(2.) + G=SQRT(4*PI*ALFAEM/SN2THW) + GP=G*SQRT(SN2THW/(1.-SN2THW)) + CS2THW=1.-SN2THW + TN2THW=SN2THW/CS2THW + VS=2*AMW**2/G/G/(1.+RV2V1**2) + V=SQRT(VS) + VP=RV2V1*V + TANB=1./RV2V1 + BETA=ATAN(TANB) + SINA=SIN(ALFAH) + COSA=COS(ALFAH) + SINB=SIN(BETA) + COSB=COS(BETA) + COS2B=COS(2*BETA) + XM=1./TAN(GAMMAL) + YM=1./TAN(GAMMAR) + THX=SIGN(1.,XM) + THY=SIGN(1.,YM) + MEME=AME*(1.-SUALFE(AME**2)/PI) + MEMB=MEME*(SUALFE(AMBT**2)/SUALFE(AME**2))**(-27./76.) + MEMZ=MEMB*(SUALFE(AMZ**2)/SUALFE(AMBT**2))**(-27./80.) + FE=G*MEMZ/SR2/AMW/COS(BETA) +C SINCE A_e not defined in ISAJET, use A_tau as approximation + AAE=AAL + TANTHE=(AMERSS**2-MEMZ**2+AMZ**2*COS2B*(.5-SN2THW)- + $AMELSS**2)/MEMZ/(TWOM1*SINB/COSB+AAE) + THETAE=ATAN(TANTHE) + MMMM=AMMU*(1.-SUALFE(AMMU**2)/PI) + MMUMB=MMMM*(SUALFE(AMBT**2)/SUALFE(AMMU**2))**(-27./76.) + MMUMZ=MMUMB*(SUALFE(AMZ**2)/SUALFE(AMBT**2))**(-27./80.) + FM=G*MMUMZ/SR2/AMW/COS(BETA) + AAM=AAL + TANTHM=(AMMRSS**2-MMUMZ**2+AMZ**2*COS2B*(.5-SN2THW)- + $AMMLSS**2)/MMUMZ/(TWOM1*SINB/COSB+AAM) + THETAM=ATAN(TANTHM) + MTAMTA=AMTAU*(1.-SUALFE(AMTAU**2)/PI) + MTAMB=MTAMTA*(SUALFE(AMBT**2)/SUALFE(AMTAU**2))**(-27./76.) + MTAMZ=MTAMB*(SUALFE(AMZ**2)/SUALFE(AMBT**2))**(-27./80.) + FL=G*MTAMZ/SR2/AMW/COS(BETA) + SINL=SIN(THETAL) + COSL=COS(THETAL) + SNW1=SIGN(1.,AMW1SS) + SNW2=SIGN(1.,AMW2SS) + BPLWI(1)=-FL*COS(GAMMAL) + BPLWI(2)=FL*THX*SIN(GAMMAL) + ANWI(1)=G*SIN(GAMMAL) + ALWI(1)=SNW1*G*SIN(GAMMAR) + ANWI(2)=G*THX*COS(GAMMAL) + ALWI(2)=SNW2*G*THY*COS(GAMMAR) +C Reconstruct masses from SSMASS + MW1=ABS(AMW1SS) + MW2=ABS(AMW2SS) +C +C Compute slepton branching fractions to zi +C + ISZIZ(1)=ISZ1 + ISZIZ(2)=ISZ2 + ISZIZ(3)=ISZ3 + ISZIZ(4)=ISZ4 + DO 100 IZ=1,4 + SNZI=SIGN(1.,AMZISS(IZ)) + IF (SNZI.EQ.1.) THEN + THIZ=0. + ELSE + THIZ=1. + END IF + MZIZ=ABS(AMZISS(IZ)) + ANIZ=G/SR2*ZMIXSS(3,IZ)-GP/SR2*ZMIXSS(4,IZ) + AEIZ=G/SR2*ZMIXSS(3,IZ)+GP/SR2*ZMIXSS(4,IZ) + BEIZ=SR2*GP*ZMIXSS(4,IZ) + ZALIZ=ZI**(THIZ-1.)*SNZI + $ *(G/SR2*ZMIXSS(3,IZ)+GP/SR2*ZMIXSS(4,IZ)) + ZBLIZ=-1*ZI**(THIZ-1.)*SR2*GP*ZMIXSS(4,IZ) + ZPP=ZI**THIZ + ZPM=(-ZI)**THIZ +C sLEPTON --> LEPTON + zi + IF (AMELSS.GT.(MZIZ+AME)) THEN + WID=AEIZ**2*(AMELSS**2-MZIZ**2-AME**2)/AMELSS**3 + $ /16./PI*SQRT(SSXLAM(AMELSS**2,MZIZ**2,AME**2)) + CALL SSSAVE(ISEL,WID,ISZIZ(IZ),IDE,0,0,0) + ENDIF + IF (AMMLSS.GT.(MZIZ+AMMU)) THEN + WID=AEIZ**2*(AMMLSS**2-MZIZ**2-AMMU**2)/AMMLSS**3 + $ /16./PI*SQRT(SSXLAM(AMMLSS**2,MZIZ**2,AMMU**2)) + CALL SSSAVE(ISMUL,WID,ISZIZ(IZ),IDMU,0,0,0) + ENDIF + IF (AMN1SS.GT.MZIZ) THEN + WID=ANIZ**2*AMN1SS*(1.-MZIZ**2/AMN1SS**2)**2/16./PI + CALL SSSAVE(ISNEL,WID,ISZIZ(IZ),IDNE,0,0,0) + ENDIF + IF (AMN2SS.GT.MZIZ) THEN + WID=ANIZ**2*AMN2SS*(1.-MZIZ**2/AMN2SS**2)**2/16./PI + CALL SSSAVE(ISNML,WID,ISZIZ(IZ),IDNM,0,0,0) + ENDIF + IF (AMN3SS.GT.MZIZ) THEN + WID=ANIZ**2*AMN3SS*(1.-MZIZ**2/AMN3SS**2)**2/16./PI + CALL SSSAVE(ISNTL,WID,ISZIZ(IZ),IDNT,0,0,0) + ENDIF + IF (AMERSS.GT.(MZIZ+AME)) THEN + WID=BEIZ**2*(AMERSS**2-MZIZ**2-AME**2)/AMERSS**3 + $ /16./PI*SQRT(SSXLAM(AMERSS**2,MZIZ**2,AME**2)) + CALL SSSAVE(ISER,WID,ISZIZ(IZ),IDE,0,0,0) + ENDIF + IF (AMMRSS.GT.(MZIZ+AMMU)) THEN + WID=BEIZ**2*(AMMRSS**2-MZIZ**2-AMMU**2)/AMMRSS**3 + $ /16./PI*SQRT(SSXLAM(AMMRSS**2,MZIZ**2,AMMU**2)) + CALL SSSAVE(ISMUR,WID,ISZIZ(IZ),IDMU,0,0,0) + ENDIF +C sTAU_1 --> TAU + zi + IF (AML1SS.GT.(MZIZ+AMTAU)) THEN + ZA=((ZI*ZALIZ-ZPP*FL*ZMIXSS(2,IZ))*COSL + $ -(ZI*ZBLIZ-ZPM*FL*ZMIXSS(2,IZ))*SINL)/2. + ZB=((-ZI*ZALIZ-ZPP*FL*ZMIXSS(2,IZ))*COSL + $ -(ZI*ZBLIZ+ZPM*FL*ZMIXSS(2,IZ))*SINL)/2. + AS=ZA*CONJG(ZA) + BS=ZB*CONJG(ZB) + WID=(AS*(AML1SS**2-(AMTAU+MZIZ)**2)+BS*(AML1SS**2- + $ (MZIZ-AMTAU)**2))/8./PI/AML1SS**3* + $ SQRT(SSXLAM(AML1SS**2,MZIZ**2,AMTAU**2)) + CALL SSSAVE(ISTAU1,WID,ISZIZ(IZ),IDTAU,0,0,0) + END IF + IF (AML2SS.GT.(MZIZ+AMTAU)) THEN + ZA=((ZI*ZALIZ-ZPP*FL*ZMIXSS(2,IZ))*SINL + $ +(ZI*ZBLIZ-ZPM*FL*ZMIXSS(2,IZ))*COSL)/2. + ZB=((-ZI*ZALIZ-ZPP*FL*ZMIXSS(2,IZ))*SINL + $ +(ZI*ZBLIZ+ZPM*FL*ZMIXSS(2,IZ))*COSL)/2. + AS=ZA*CONJG(ZA) + BS=ZB*CONJG(ZB) + WID=(AS*(AML2SS**2-(AMTAU+MZIZ)**2)+BS*(AML2SS**2- + $ (MZIZ-AMTAU)**2))/8./PI/AML2SS**3* + $ SQRT(SSXLAM(AML2SS**2,MZIZ**2,AMTAU**2)) + CALL SSSAVE(ISTAU2,WID,ISZIZ(IZ),IDTAU,0,0,0) + END IF +100 CONTINUE +C +C Compute branching fractions to wi --- theta-C = 0 +C + IF (AMELSS.GT.MW1) THEN + WID=ANWI(1)**2*AMELSS*(1.-MW1**2/AMELSS**2)**2/16./PI + CALL SSSAVE(ISEL,WID,-ISW1,IDNE,0,0,0) + END IF + IF (AMMLSS.GT.MW1) THEN + WID=ANWI(1)**2*AMMLSS*(1.-MW1**2/AMMLSS**2)**2/16./PI + CALL SSSAVE(ISMUL,WID,-ISW1,IDNM,0,0,0) + END IF + IF (AML1SS.GT.MW1) THEN + AS=(-ANWI(1)*COSL-BPLWI(1)*SINL)**2 + WID=AS*AML1SS*(1.-MW1**2/AML1SS**2)**2/16./PI + CALL SSSAVE(ISTAU1,WID,-ISW1,IDNT,0,0,0) + END IF + IF (AML2SS.GT.MW1) THEN + AS=(-ANWI(1)*SINL+BPLWI(1)*COSL)**2 + WID=AS*AML2SS*(1.-MW1**2/AML2SS**2)**2/16./PI + CALL SSSAVE(ISTAU2,WID,-ISW1,IDNT,0,0,0) + END IF +C + IF (AMN1SS.GT.(MW1+AME)) THEN + WID=ALWI(1)**2*(AMN1SS**2-MW1**2-AME**2)* + $ SQRT(SSXLAM(AMN1SS**2,MW1**2,AME**2))/16./PI/AMN1SS**3 + CALL SSSAVE(ISNEL,WID,ISW1,IDE,0,0,0) + END IF + IF (AMN2SS.GT.(MW1+AMMU)) THEN + WID=ALWI(1)**2*(AMN2SS**2-MW1**2-AMMU**2)* + $ SQRT(SSXLAM(AMN2SS**2,MW1**2,AMMU**2))/16./PI/AMN2SS**3 + CALL SSSAVE(ISNML,WID,ISW1,IDMU,0,0,0) + END IF +C + IF (AMN3SS.GT.(MW1+AMTAU)) THEN + WID=((ALWI(1)**2+BPLWI(1)**2)*(AMN3SS**2-MW1**2-AMTAU**2)+ + $ 4*MW1*AMTAU*BPLWI(1)*ALWI(1))* + $ SQRT(SSXLAM(AMN3SS**2,MW1**2,AMTAU**2))/16./PI/AMN3SS**3 + CALL SSSAVE(ISNTL,WID,ISW1,IDTAU,0,0,0) + END IF +C +C + IF (AMELSS.GT.MW2) THEN + WID=ANWI(2)**2*AMELSS*(1.-MW2**2/AMELSS**2)**2/16./PI + CALL SSSAVE(ISEL,WID,-ISW2,IDNE,0,0,0) + END IF + IF (AMMLSS.GT.MW2) THEN + WID=ANWI(2)**2*AMMLSS*(1.-MW2**2/AMMLSS**2)**2/16./PI + CALL SSSAVE(ISMUL,WID,-ISW2,IDNM,0,0,0) + END IF + IF (AML1SS.GT.MW2) THEN + AS=(-ANWI(2)*COSL-BPLWI(2)*SINL)**2 + WID=AS*AML1SS*(1.-MW2**2/AML1SS**2)**2/16./PI + CALL SSSAVE(ISTAU1,WID,-ISW2,IDNT,0,0,0) + END IF + IF (AML2SS.GT.MW2) THEN + AS=(-ANWI(2)*SINL+BPLWI(2)*COSL)**2 + WID=AS*AML2SS*(1.-MW2**2/AML2SS**2)**2/16./PI + CALL SSSAVE(ISTAU2,WID,-ISW2,IDNT,0,0,0) + END IF +C + IF (AMN1SS.GT.(MW2+AME)) THEN + WID=ALWI(2)**2*(AMN1SS**2-MW2**2-AME**2)* + $ SQRT(SSXLAM(AMN1SS**2,MW2**2,AME**2))/16./PI/AMN1SS**3 + CALL SSSAVE(ISNEL,WID,ISW2,IDE,0,0,0) + END IF + IF (AMN2SS.GT.(MW2+AMMU)) THEN + WID=ALWI(2)**2*(AMN2SS**2-MW2**2-AMMU**2)* + $ SQRT(SSXLAM(AMN2SS**2,MW2**2,AMMU**2))/16./PI/AMN2SS**3 + CALL SSSAVE(ISNML,WID,ISW2,IDMU,0,0,0) + END IF +C + IF (AMN3SS.GT.(MW2+AMTAU)) THEN + WID=((ALWI(2)**2+BPLWI(2)**2)*(AMN3SS**2-MW2**2-AMTAU**2)+ + $ 4*MW2*AMTAU*BPLWI(2)*ALWI(2))* + $ SQRT(SSXLAM(AMN3SS**2,MW2**2,AMTAU**2))/16./PI/AMN3SS**3 + CALL SSSAVE(ISNTL,WID,ISW2,IDTAU,0,0,0) + END IF +C +C DECAYS TO VECTOR BOSONS +C + IF (AMELSS.GT.(AMN1SS+AMW)) THEN + WID=G*G*(SSXLAM(AMELSS**2,AMN1SS**2,AMW**2))**1.5/ + $ 32./PI/AMELSS**3/AMW**2 + CALL SSSAVE(ISEL,WID,-IDW,ISNEL,0,0,0) + END IF +C + IF (AMMLSS.GT.(AMN2SS+AMW)) THEN + WID=G*G*(SSXLAM(AMMLSS**2,AMN2SS**2,AMW**2))**1.5/ + $ 32./PI/AMMLSS**3/AMW**2 + CALL SSSAVE(ISMUL,WID,-IDW,ISNML,0,0,0) + END IF +C + IF (AML1SS.GT.(AMN3SS+AMW)) THEN + WID=G*G*(SSXLAM(AML1SS**2,AMN3SS**2,AMW**2))**1.5/ + $ 32./PI/AML1SS**3/AMW**2*COSL**2 + CALL SSSAVE(ISTAU1,WID,-IDW,ISNTL,0,0,0) + END IF +C + IF (AML2SS.GT.(AMN3SS+AMW)) THEN + WID=G*G*(SSXLAM(AML2SS**2,AMN3SS**2,AMW**2))**1.5/ + $ 32./PI/AML2SS**3/AMW**2*SINL**2 + CALL SSSAVE(ISTAU2,WID,-IDW,ISNTL,0,0,0) + END IF +C + IF (AMN1SS.GT.(AMELSS+AMW)) THEN + WID=G*G*(SSXLAM(AMN1SS**2,AMELSS**2,AMW**2))**1.5/ + $ 32./PI/AMN1SS**3/AMW**2 + CALL SSSAVE(ISNEL,WID,IDW,ISEL,0,0,0) + END IF +C + IF (AMN2SS.GT.(AMMLSS+AMW)) THEN + WID=G*G*(SSXLAM(AMN2SS**2,AMMLSS**2,AMW**2))**1.5/ + $ 32./PI/AMN2SS**3/AMW**2 + CALL SSSAVE(ISNML,WID,IDW,ISMUL,0,0,0) + END IF +C + IF (AMN3SS.GT.(AML1SS+AMW)) THEN + WID=G*G*(SSXLAM(AMN3SS**2,AML1SS**2,AMW**2))**1.5/ + $ 32./PI/AMN3SS**3/AMW**2*COSL**2 + CALL SSSAVE(ISNTL,WID,IDW,ISTAU1,0,0,0) + END IF +C + IF (AMN3SS.GT.(AML2SS+AMW)) THEN + WID=G*G*(SSXLAM(AMN3SS**2,AML2SS**2,AMW**2))**1.5/ + $ 32./PI/AMN3SS**3/AMW**2*SINL**2 + CALL SSSAVE(ISNTL,WID,IDW,ISTAU2,0,0,0) + END IF +C + IF (AML2SS.GT.(AML1SS+AMZ)) THEN + WID=G*G*(SSXLAM(AML2SS**2,AML1SS**2,AMZ**2))**1.5/ + $ 64./PI/AML2SS**3/CS2THW/AMZ**2*SINL**2*COSL**2 + CALL SSSAVE(ISTAU2,WID,IDZ,ISTAU1,0,0,0) + END IF +C +C 3-body decay of l_R -> l+tau+stau_1 +C + XLO=(AML1SS+AMTAU)**2 + SUM1=0. + SUM2=0. + IF (AMERSS.GT.(AML1SS+AMTAU+AME)) THEN + DO IZ=1,4 + DO JZ=IZ,4 + TMP(1)=AMERSS + TMP(2)=-SR2*GP*ZMIXSS(4,IZ) + TMP(3)=-SR2*GP*ZMIXSS(4,JZ) + AEIZ=-(G*ZMIXSS(3,IZ)+GP*ZMIXSS(4,IZ))/SR2 + AEJZ=-(G*ZMIXSS(3,JZ)+GP*ZMIXSS(4,JZ))/SR2 + TMP(4)=AEIZ*COSL-FL*ZMIXSS(2,IZ)*SINL + TMP(5)=AEJZ*COSL-FL*ZMIXSS(2,JZ)*SINL + TMP(6)=TMP(2)*SINL+FL*ZMIXSS(2,IZ)*COSL + TMP(7)=TMP(3)*SINL+FL*ZMIXSS(2,JZ)*COSL + TMP(8)=AMZISS(IZ) + TMP(9)=AMZISS(JZ) + IF (AMERSS.LT.ABS(AMZISS(IZ)).AND. + , AMERSS.LT.ABS(AMZISS(JZ))) THEN + TERM=2*PI**2*SSXINT(XLO,SSLRT1,AMERSS**2)/AMERSS + ELSE + TERM=0. + END IF + IF (IZ.EQ.JZ) TERM=TERM/2. + SUM1=SUM1+TERM + TMP(4)=TMP(6) + TMP(5)=TMP(7) + TMP(6)=AEIZ*COSL-FL*ZMIXSS(2,IZ)*SINL + TMP(7)=AEJZ*COSL-FL*ZMIXSS(2,JZ)*SINL + IF (AMERSS.LT.ABS(AMZISS(IZ)).AND. + , AMERSS.LT.ABS(AMZISS(JZ))) THEN + TERM=2*PI**2*SSXINT(XLO,SSLRT1,AMERSS**2)/AMERSS + ELSE + TERM=0. + END IF + IF (IZ.EQ.JZ) TERM=TERM/2. + SUM2=SUM2+TERM + END DO + END DO + WID1=SUM1/2./AMERSS/(2*PI)**5 + WID2=SUM2/2./AMERSS/(2*PI)**5 + CALL SSSAVE(ISER,WID1,ISTAU1,IDE,-IDTAU,0,0) + CALL SSSAVE(ISER,WID2,-ISTAU1,IDE,IDTAU,0,0) + END IF + SUM1=0. + SUM2=0. + IF (AMMRSS.GT.(AML1SS+AMTAU+AMMU)) THEN + DO IZ=1,4 + DO JZ=IZ,4 + TMP(1)=AMMRSS + TMP(2)=-SR2*GP*ZMIXSS(4,IZ) + TMP(3)=-SR2*GP*ZMIXSS(4,JZ) + AEIZ=-(G*ZMIXSS(3,IZ)+GP*ZMIXSS(4,IZ))/SR2 + AEJZ=-(G*ZMIXSS(3,JZ)+GP*ZMIXSS(4,JZ))/SR2 + TMP(4)=AEIZ*COSL-FL*ZMIXSS(2,IZ)*SINL + TMP(5)=AEJZ*COSL-FL*ZMIXSS(2,JZ)*SINL + TMP(6)=TMP(2)*SINL+FL*ZMIXSS(2,IZ)*COSL + TMP(7)=TMP(3)*SINL+FL*ZMIXSS(2,JZ)*COSL + TMP(8)=AMZISS(IZ) + TMP(9)=AMZISS(JZ) + IF (AMMRSS.LT.ABS(AMZISS(IZ)).AND. + , AMMRSS.LT.ABS(AMZISS(JZ))) THEN + TERM=2*PI**2*SSXINT(XLO,SSLRT1,AMMRSS**2)/AMMRSS + ELSE + TERM=0. + END IF + IF (IZ.EQ.JZ) TERM=TERM/2. + SUM1=SUM1+TERM + TMP(4)=TMP(6) + TMP(5)=TMP(7) + TMP(6)=AEIZ*COSL-FL*ZMIXSS(2,IZ)*SINL + TMP(7)=AEJZ*COSL-FL*ZMIXSS(2,JZ)*SINL + IF (AMMRSS.LT.ABS(AMZISS(IZ)).AND. + , AMMRSS.LT.ABS(AMZISS(JZ))) THEN + TERM=2*PI**2*SSXINT(XLO,SSLRT1,AMMRSS**2)/AMMRSS + ELSE + TERM=0. + END IF + IF (IZ.EQ.JZ) TERM=TERM/2. + SUM2=SUM2+TERM + END DO + END DO + WID1=SUM1/2./AMMRSS/(2*PI)**5 + WID2=SUM2/2./AMMRSS/(2*PI)**5 + CALL SSSAVE(ISMUR,WID1,ISTAU1,IDMU,-IDTAU,0,0) + CALL SSSAVE(ISMUR,WID2,-ISTAU1,IDMU,IDTAU,0,0) + END IF +C +C 3-body decay of l_L -> l+tau+stau_1 +C + SUM1=0. + SUM2=0. + IF (AMELSS.GT.(AML1SS+AMTAU+AME)) THEN + DO IZ=1,4 + DO JZ=IZ,4 + TMP(1)=AMELSS + AEIZ=-(G*ZMIXSS(3,IZ)+GP*ZMIXSS(4,IZ))/SR2 + AEJZ=-(G*ZMIXSS(3,JZ)+GP*ZMIXSS(4,JZ))/SR2 + TMP(2)=AEIZ + TMP(3)=AEJZ + TMP(6)=AEIZ*COSL-FL*ZMIXSS(2,IZ)*SINL + TMP(7)=AEJZ*COSL-FL*ZMIXSS(2,JZ)*SINL + TMP(4)=-SR2*GP*ZMIXSS(4,IZ)*SINL+FL*ZMIXSS(2,IZ)*COSL + TMP(5)=-SR2*GP*ZMIXSS(4,JZ)*SINL+FL*ZMIXSS(2,JZ)*COSL + TMP(8)=AMZISS(IZ) + TMP(9)=AMZISS(JZ) + IF (AMELSS.LT.ABS(AMZISS(IZ)).AND. + , AMELSS.LT.ABS(AMZISS(JZ))) THEN + TERM=2*PI**2*SSXINT(XLO,SSLRT1,AMELSS**2)/AMELSS + ELSE + TERM=0. + END IF + IF (IZ.EQ.JZ) TERM=TERM/2. + SUM1=SUM1+TERM + TMP(4)=TMP(6) + TMP(5)=TMP(7) + TMP(6)=-SR2*GP*ZMIXSS(4,IZ)*SINL+FL*ZMIXSS(2,IZ)*COSL + TMP(7)=-SR2*GP*ZMIXSS(4,JZ)*SINL+FL*ZMIXSS(2,JZ)*COSL + IF (AMELSS.LT.ABS(AMZISS(IZ)).AND. + , AMELSS.LT.ABS(AMZISS(JZ))) THEN + TERM=2*PI**2*SSXINT(XLO,SSLRT1,AMELSS**2)/AMELSS + ELSE + TERM=0. + END IF + IF (IZ.EQ.JZ) TERM=TERM/2. + SUM2=SUM2+TERM + END DO + END DO + WID1=SUM1/2./AMELSS/(2*PI)**5 + WID2=SUM2/2./AMELSS/(2*PI)**5 + CALL SSSAVE(ISEL,WID1,ISTAU1,IDE,-IDTAU,0,0) + CALL SSSAVE(ISEL,WID2,-ISTAU1,IDE,IDTAU,0,0) + END IF + SUM1=0. + SUM2=0. + IF (AMMLSS.GT.(AML1SS+AMTAU+AMMU)) THEN + DO IZ=1,4 + DO JZ=IZ,4 + TMP(1)=AMMLSS + AEIZ=-(G*ZMIXSS(3,IZ)+GP*ZMIXSS(4,IZ))/SR2 + AEJZ=-(G*ZMIXSS(3,JZ)+GP*ZMIXSS(4,JZ))/SR2 + TMP(2)=AEIZ + TMP(3)=AEJZ + TMP(6)=AEIZ*COSL-FL*ZMIXSS(2,IZ)*SINL + TMP(7)=AEJZ*COSL-FL*ZMIXSS(2,JZ)*SINL + TMP(4)=-SR2*GP*ZMIXSS(4,IZ)*SINL+FL*ZMIXSS(2,IZ)*COSL + TMP(5)=-SR2*GP*ZMIXSS(4,JZ)*SINL+FL*ZMIXSS(2,JZ)*COSL + TMP(8)=AMZISS(IZ) + TMP(9)=AMZISS(JZ) + IF (AMMLSS.LT.ABS(AMZISS(IZ)).AND. + , AMMLSS.LT.ABS(AMZISS(JZ))) THEN + TERM=2*PI**2*SSXINT(XLO,SSLRT1,AMMLSS**2)/AMMLSS + ELSE + TERM=0. + END IF + IF (IZ.EQ.JZ) TERM=TERM/2. + SUM1=SUM1+TERM + TMP(4)=TMP(6) + TMP(5)=TMP(7) + TMP(6)=-SR2*GP*ZMIXSS(4,IZ)*SINL+FL*ZMIXSS(2,IZ)*COSL + TMP(7)=-SR2*GP*ZMIXSS(4,JZ)*SINL+FL*ZMIXSS(2,JZ)*COSL + IF (AMMLSS.LT.ABS(AMZISS(IZ)).AND. + , AMMLSS.LT.ABS(AMZISS(JZ))) THEN + TERM=2*PI**2*SSXINT(XLO,SSLRT1,AMMLSS**2)/AMMLSS + ELSE + TERM=0. + END IF + IF (IZ.EQ.JZ) TERM=TERM/2. + SUM2=SUM2+TERM + END DO + END DO + WID1=SUM1/2./AMMLSS/(2*PI)**5 + WID2=SUM2/2./AMMLSS/(2*PI)**5 + CALL SSSAVE(ISMUL,WID1,ISTAU1,IDMU,-IDTAU,0,0) + CALL SSSAVE(ISMUL,WID2,-ISTAU1,IDMU,IDTAU,0,0) + END IF +C +C 3-body decay of nu_eL -> nu_e+tau+stau_1 +C + SUM1=0. + SUM2=0. + IF (AMN1SS.GT.(AML1SS+AMTAU)) THEN + DO IZ=1,4 + DO JZ=IZ,4 + TMP(1)=AMN1SS + ANIZ=(G*ZMIXSS(3,IZ)-GP*ZMIXSS(4,IZ))/SR2 + ANJZ=(G*ZMIXSS(3,JZ)-GP*ZMIXSS(4,JZ))/SR2 + AEIZ=-(G*ZMIXSS(3,IZ)+GP*ZMIXSS(4,IZ))/SR2 + AEJZ=-(G*ZMIXSS(3,JZ)+GP*ZMIXSS(4,JZ))/SR2 + TMP(2)=ANIZ + TMP(3)=ANJZ + TMP(6)=AEIZ*COSL-FL*ZMIXSS(2,IZ)*SINL + TMP(7)=AEJZ*COSL-FL*ZMIXSS(2,JZ)*SINL + TMP(4)=-SR2*GP*ZMIXSS(4,IZ)*SINL+FL*ZMIXSS(2,IZ)*COSL + TMP(5)=-SR2*GP*ZMIXSS(4,JZ)*SINL+FL*ZMIXSS(2,JZ)*COSL + TMP(8)=AMZISS(IZ) + TMP(9)=AMZISS(JZ) + IF (AMN1SS.LT.ABS(AMZISS(IZ)).AND. + , AMN1SS.LT.ABS(AMZISS(JZ))) THEN + TERM=2*PI**2*SSXINT(XLO,SSLRT1,AMN1SS**2)/AMN1SS + ELSE + TERM=0. + END IF + IF (IZ.EQ.JZ) TERM=TERM/2. + SUM1=SUM1+TERM + TMP(4)=TMP(6) + TMP(5)=TMP(7) + TMP(6)=-SR2*GP*ZMIXSS(4,IZ)*SINL+FL*ZMIXSS(2,IZ)*COSL + TMP(7)=-SR2*GP*ZMIXSS(4,JZ)*SINL+FL*ZMIXSS(2,JZ)*COSL + IF (AMN1SS.LT.ABS(AMZISS(IZ)).AND. + , AMN1SS.LT.ABS(AMZISS(JZ))) THEN + TERM=2*PI**2*SSXINT(XLO,SSLRT1,AMN1SS**2)/AMN1SS + ELSE + TERM=0. + END IF + IF (IZ.EQ.JZ) TERM=TERM/2. + SUM2=SUM2+TERM + END DO + END DO + WID1=SUM1/2./AMN1SS/(2*PI)**5 + WID2=SUM2/2./AMN1SS/(2*PI)**5 + CALL SSSAVE(ISNEL,WID1,ISTAU1,IDNE,-IDTAU,0,0) + CALL SSSAVE(ISNEL,WID2,-ISTAU1,IDNE,IDTAU,0,0) + END IF +C +C 3-body decay of nu_muL -> nu_mu+tau+stau_1 +C + SUM1=0. + SUM2=0. + IF (AMN2SS.GT.(AML1SS+AMTAU)) THEN + DO IZ=1,4 + DO JZ=IZ,4 + TMP(1)=AMN2SS + ANIZ=(G*ZMIXSS(3,IZ)-GP*ZMIXSS(4,IZ))/SR2 + ANJZ=(G*ZMIXSS(3,JZ)-GP*ZMIXSS(4,JZ))/SR2 + AEIZ=-(G*ZMIXSS(3,IZ)+GP*ZMIXSS(4,IZ))/SR2 + AEJZ=-(G*ZMIXSS(3,JZ)+GP*ZMIXSS(4,JZ))/SR2 + TMP(2)=ANIZ + TMP(3)=ANJZ + TMP(6)=AEIZ*COSL-FL*ZMIXSS(2,IZ)*SINL + TMP(7)=AEJZ*COSL-FL*ZMIXSS(2,JZ)*SINL + TMP(4)=-SR2*GP*ZMIXSS(4,IZ)*SINL+FL*ZMIXSS(2,IZ)*COSL + TMP(5)=-SR2*GP*ZMIXSS(4,JZ)*SINL+FL*ZMIXSS(2,JZ)*COSL + TMP(8)=AMZISS(IZ) + TMP(9)=AMZISS(JZ) + IF (AMN2SS.LT.ABS(AMZISS(IZ)).AND. + , AMN2SS.LT.ABS(AMZISS(JZ))) THEN + TERM=2*PI**2*SSXINT(XLO,SSLRT1,AMN2SS**2)/AMN2SS + ELSE + TERM=0. + END IF + IF (IZ.EQ.JZ) TERM=TERM/2. + SUM1=SUM1+TERM + TMP(4)=TMP(6) + TMP(5)=TMP(7) + TMP(6)=-SR2*GP*ZMIXSS(4,IZ)*SINL+FL*ZMIXSS(2,IZ)*COSL + TMP(7)=-SR2*GP*ZMIXSS(4,JZ)*SINL+FL*ZMIXSS(2,JZ)*COSL + IF (AMN2SS.LT.ABS(AMZISS(IZ)).AND. + , AMN2SS.LT.ABS(AMZISS(JZ))) THEN + TERM=2*PI**2*SSXINT(XLO,SSLRT1,AMN2SS**2)/AMN2SS + ELSE + TERM=0. + END IF + IF (IZ.EQ.JZ) TERM=TERM/2. + SUM2=SUM2+TERM + END DO + END DO + WID1=SUM1/2./AMN2SS/(2*PI)**5 + WID2=SUM2/2./AMN2SS/(2*PI)**5 + CALL SSSAVE(ISNML,WID1,ISTAU1,IDNM,-IDTAU,0,0) + CALL SSSAVE(ISNML,WID2,-ISTAU1,IDNM,IDTAU,0,0) + END IF +C +C 3-body decay of nu_tauL -> nu_tau+tau+stau_1 +C Here, we include decay via Z_i, W_i and W*, but neglect +C some interference terms (Z_i-W* and W_i-W* and Z_i-W_i) +C until a future date. HB 8/24/98 +C + AME1=-G*SIN(GAMMAL)*COS(THETAE)+FE*COS(GAMMAL)*SIN(THETAE) + AML1=-G*SIN(GAMMAL)*COS(THETAL)+FL*COS(GAMMAL)*SIN(THETAL) + APE1=-G*THX*COS(GAMMAL)*COS(THETAE)-FE*THX*SIN(GAMMAL)* + $ SIN(THETAE) + APL1=-G*THX*COS(GAMMAL)*COS(THETAL)-FL*THX*SIN(GAMMAL)* + $ SIN(THETAL) + SUM1=0. + SUM2=0. + IF (AMN3SS.GT.(AML1SS+AMTAU)) THEN + DO IZ=1,4 + DO JZ=IZ,4 + TMP(1)=AMN3SS + ANIZ=(G*ZMIXSS(3,IZ)-GP*ZMIXSS(4,IZ))/SR2 + ANJZ=(G*ZMIXSS(3,JZ)-GP*ZMIXSS(4,JZ))/SR2 + AEIZ=-(G*ZMIXSS(3,IZ)+GP*ZMIXSS(4,IZ))/SR2 + AEJZ=-(G*ZMIXSS(3,JZ)+GP*ZMIXSS(4,JZ))/SR2 + TMP(2)=ANIZ + TMP(3)=ANJZ + TMP(6)=AEIZ*COSL-FL*ZMIXSS(2,IZ)*SINL + TMP(7)=AEJZ*COSL-FL*ZMIXSS(2,JZ)*SINL + TMP(4)=-SR2*GP*ZMIXSS(4,IZ)*SINL+FL*ZMIXSS(2,IZ)*COSL + TMP(5)=-SR2*GP*ZMIXSS(4,JZ)*SINL+FL*ZMIXSS(2,JZ)*COSL + TMP(8)=AMZISS(IZ) + TMP(9)=AMZISS(JZ) + IF (AMN3SS.LT.ABS(AMZISS(IZ)).AND. + , AMN3SS.LT.ABS(AMZISS(JZ))) THEN + TERM=2*PI**2*SSXINT(XLO,SSLRT1,AMN3SS**2)/AMN3SS + ELSE + TERM=0. + END IF + IF (IZ.EQ.JZ) TERM=TERM/2. + SUM1=SUM1+TERM + TMP(4)=TMP(6) + TMP(5)=TMP(7) + TMP(6)=-SR2*GP*ZMIXSS(4,IZ)*SINL+FL*ZMIXSS(2,IZ)*COSL + TMP(7)=-SR2*GP*ZMIXSS(4,JZ)*SINL+FL*ZMIXSS(2,JZ)*COSL + IF (AMN3SS.LT.ABS(AMZISS(IZ)).AND. + , AMN3SS.LT.ABS(AMZISS(JZ))) THEN + TERM=2*PI**2*SSXINT(XLO,SSLRT1,AMN3SS**2)/AMN3SS + ELSE + TERM=0. + END IF + IF (IZ.EQ.JZ) TERM=TERM/2. + SUM2=SUM2+TERM + END DO + END DO + WID1=SUM1/2./AMN3SS/(2*PI)**5 + WID2=SUM2/2./AMN3SS/(2*PI)**5 +C-----COMPUTE SNU_TAU --> TAU +STAU_1BAR +NU_TAU via W_i DECAYS -------------- + BME1=-FL*COS(GAMMAL) + BPE1=FL*THX*SIN(GAMMAL) + TMP(1)=MW1 + TMP(2)=MW1 + TMP(3)=AML1SS + TMP(4)=AMN3SS + IF (AMN3SS.LT.MW1) THEN + TM1=AML1**2*(AME1**2*MW1**2*SSXINT(AML1SS**2,SSN1ST,AMN3SS**2) + $+BME1**2*SSXINT(AML1SS**2,SSL1ST,AMN3SS**2)) + TMP(2)=MW2 + TM2=2*AML1*APL1*(SNW1*SNW2*AME1*APE1* + $ SSXINT(AML1SS**2,SSN1ST,AMN3SS**2)+BME1*BPE1* + $ SSXINT(AML1SS**2,SSL1ST,AMN3SS**2)) + ELSE + TM1=0. + TM2=0. + END IF + TMP(1)=MW2 + TMP(2)=MW2 + IF (AMN3SS.LT.MW2) THEN + TM3=APL1**2*(APE1**2*MW2**2*SSXINT(AML1SS**2,SSN1ST,AMN3SS**2) + $+BPE1**2*SSXINT(AML1SS**2,SSL1ST,AMN3SS**2)) + ELSE + TM3=0. + END IF + WID=PI**2*(TM1+TM2+TM3)/8./2./AMN3SS/(2.*PI)**5 + CALL SSSAVE(ISNTL,WID1+WID,ISTAU1,IDNT,-IDTAU,0,0) +C-----COMPUTE SNU_TAU --> TAUBAR +STAU_1 +NU_TAU via W* DECAYS -- + EMAX=(AML1SS**2+AMN3SS**2)/2./AMN3SS + TMP(1)=AMW + TMP(2)=AMW + TMP(3)=AML1SS + TMP(4)=AMN3SS + IF (AMN3SS.LT.(AMW+AML1SS)) THEN + TM1=G**4*COS(THETAL)**2*SSXINT(AML1SS,SSSNWS,EMAX) + ELSE + TM1=0. + END IF + WID=2*PI**2*TM1/3./2./AMN3SS/(2.*PI)**5 + CALL SSSAVE(ISNTL,WID2+WID,-ISTAU1,IDNT,IDTAU,0,0) + END IF +C-----Now impose all sneutrino 3 body decays via W* ------------ + TMP(1)=AMW + TMP(2)=AMW + TMP(3)=AML1SS + TMP(4)=AMN3SS + EMAX=(AML1SS**2+AMN3SS**2)/2./AMN3SS + IF (AMN3SS.GT.(AML1SS+AME).AND.AMN3SS.LT.(AMW+AML1SS)) THEN + TM1=G**4*COS(THETAL)**2*SSXINT(AML1SS,SSSNWS,EMAX) + WID=2*PI**2*TM1/3./2./AMN3SS/(2.*PI)**5 + CALL SSSAVE(ISNTL,WID,ISTAU1,IDNE,-IDE,0,0) + END IF + IF (AMN3SS.GT.(AML1SS+AMMU).AND.AMN3SS.LT.(AMW+AML1SS)) THEN + TM1=G**4*COS(THETAL)**2*SSXINT(AML1SS,SSSNWS,EMAX) + WID=2*PI**2*TM1/3./2./AMN3SS/(2.*PI)**5 + CALL SSSAVE(ISNTL,WID,ISTAU1,IDNM,-IDMU,0,0) + END IF + IF (AMN3SS.GT.(AML1SS+AMUP+AMDN).AND.AMN3SS.LT.(AMW+AML1SS)) THEN + TM1=G**4*COS(THETAL)**2*SSXINT(AML1SS,SSSNWS,EMAX) + WID=2*PI**2*TM1/3./2./AMN3SS/(2.*PI)**5 + CALL SSSAVE(ISNTL,3*WID,ISTAU1,IDUP,-IDDN,0,0) + END IF + IF (AMN3SS.GT.(AML1SS+AMCH+AMST).AND.AMN3SS.LT.(AMW+AML1SS)) THEN + TM1=G**4*COS(THETAL)**2*SSXINT(AML1SS,SSSNWS,EMAX) + WID=2*PI**2*TM1/3./2./AMN3SS/(2.*PI)**5 + CALL SSSAVE(ISNTL,3*WID,ISTAU1,IDCH,-IDST,0,0) + END IF + TMP(4)=AMN2SS + EMAX=(AMMLSS**2+AMN2SS**2)/2./AMN2SS + IF (AMN2SS.GT.(AMMLSS+AME).AND.AMN2SS.LT.(AMW+AML1SS)) THEN + TM1=G**4*COS(THETAL)**2*SSXINT(AMMLSS,SSSNWS,EMAX) + WID=2*PI**2*TM1/3./2./AMN2SS/(2.*PI)**5 + CALL SSSAVE(ISNML,WID,ISMUL,IDNE,-IDE,0,0) + END IF + IF (AMN2SS.GT.(AMMLSS+AMMU).AND.AMN2SS.LT.(AMW+AML1SS)) THEN + TM1=G**4*COS(THETAL)**2*SSXINT(AMMLSS,SSSNWS,EMAX) + WID=2*PI**2*TM1/3./2./AMN2SS/(2.*PI)**5 + CALL SSSAVE(ISNML,WID,ISMUL,IDNM,-IDMU,0,0) + END IF + IF (AMN2SS.GT.(AMMLSS+AMUP+AMDN).AND.AMN2SS.LT.(AMW+AML1SS)) THEN + TM1=G**4*COS(THETAL)**2*SSXINT(AMMLSS,SSSNWS,EMAX) + WID=2*PI**2*TM1/3./2./AMN2SS/(2.*PI)**5 + CALL SSSAVE(ISNML,3*WID,ISMUL,IDUP,-IDDN,0,0) + END IF + IF (AMN2SS.GT.(AMMLSS+AMCH+AMST).AND.AMN2SS.LT.(AMW+AML1SS)) THEN + TM1=G**4*COS(THETAL)**2*SSXINT(AMMLSS,SSSNWS,EMAX) + WID=2*PI**2*TM1/3./2./AMN2SS/(2.*PI)**5 + CALL SSSAVE(ISNML,3*WID,ISMUL,IDCH,-IDST,0,0) + END IF + TMP(4)=AMN1SS + EMAX=(AMELSS**2+AMN1SS**2)/2./AMN1SS + IF (AMN1SS.GT.(AMELSS+AME).AND.AMN1SS.LT.(AMW+AML1SS)) THEN + TM1=G**4*COS(THETAL)**2*SSXINT(AMELSS,SSSNWS,EMAX) + WID=2*PI**2*TM1/3./2./AMN1SS/(2.*PI)**5 + CALL SSSAVE(ISNEL,WID,ISEL,IDNE,-IDE,0,0) + END IF + IF (AMN1SS.GT.(AMELSS+AMMU).AND.AMN1SS.LT.(AMW+AML1SS)) THEN + TM1=G**4*COS(THETAL)**2*SSXINT(AMELSS,SSSNWS,EMAX) + WID=2*PI**2*TM1/3./2./AMN1SS/(2.*PI)**5 + CALL SSSAVE(ISNEL,WID,ISEL,IDNM,-IDMU,0,0) + END IF + IF (AMN1SS.GT.(AMELSS+AMUP+AMDN).AND.AMN1SS.LT.(AMW+AML1SS)) THEN + TM1=G**4*COS(THETAL)**2*SSXINT(AMELSS,SSSNWS,EMAX) + WID=2*PI**2*TM1/3./2./AMN1SS/(2.*PI)**5 + CALL SSSAVE(ISNEL,3*WID,ISEL,IDUP,-IDDN,0,0) + END IF + IF (AMN1SS.GT.(AMELSS+AMCH+AMST).AND.AMN1SS.LT.(AMW+AML1SS)) THEN + TM1=G**4*COS(THETAL)**2*SSXINT(AMELSS,SSSNWS,EMAX) + WID=2*PI**2*TM1/3./2./AMN1SS/(2.*PI)**5 + CALL SSSAVE(ISNEL,3*WID,ISEL,IDCH,-IDST,0,0) + END IF +C-----COMPUTE ER AND MUR--> STAU_1+NEUTRINOS DECAYS -------------- + IF (AMERSS.LT.AMELSS.AND.AMERSS.GT.AML1SS) THEN + TMP(1)=MW1 + TMP(2)=MW1 + TMP(3)=AML1SS + TMP(4)=AMERSS + IF (AMERSS.LT.MW1) THEN + TM1=AML1**2*AME1**2*SSXINT(AML1SS**2,SSL1ST,AMERSS**2) + TMP(2)=MW2 + TM2=2*AML1*AME1*APL1*APE1*SSXINT(AML1SS**2,SSL1ST,AMERSS**2) + ELSE + TM1=0. + TM2=0. + END IF + IF (AMERSS.LT.MW2) THEN + TMP(1)=MW2 + TMP(2)=MW2 + TM3=APL1**2*APE1**2*SSXINT(AML1SS**2,SSL1ST,AMERSS**2) + ELSE + TM3=0. + END IF + WID=PI**2*(TM1+TM2+TM3)/8./2./AMERSS/(2.*PI)**5 + CALL SSSAVE(ISER,WID,ISTAU1,IDNE,-IDNT,0,0) + END IF + IF (AMMRSS.LT.AMMLSS.AND.AMMRSS.GT.AML1SS) THEN + AMM1=-G*SIN(GAMMAL)*COS(THETAM)+FM*COS(GAMMAL)*SIN(THETAM) + AML1=-G*SIN(GAMMAL)*COS(THETAL)+FL*COS(GAMMAL)*SIN(THETAL) + APM1=-G*THX*COS(GAMMAL)*COS(THETAM)-FM*THX*SIN(GAMMAL)* + $ SIN(THETAM) + APL1=-G*THX*COS(GAMMAL)*COS(THETAL)-FL*THX*SIN(GAMMAL)* + $ SIN(THETAL) + TMP(1)=MW1 + TMP(2)=MW1 + TMP(3)=AML1SS + TMP(4)=AMMRSS + IF (AMMRSS.LT.MW1) THEN + TM1=AML1**2*AMM1**2*SSXINT(AML1SS**2,SSL1ST,AMMRSS**2) + TMP(2)=MW2 + TM2=2*AML1*AMM1*APL1*APM1*SSXINT(AML1SS**2,SSL1ST,AMMRSS**2) + ELSE + TM1=0. + TM2=0. + END IF + IF (AMMRSS.LT.MW2) THEN + TMP(1)=MW2 + TMP(2)=MW2 + TM3=APL1**2*APM1**2*SSXINT(AML1SS**2,SSL1ST,AMMRSS**2) + ELSE + TM3=0. + END IF + WID=PI**2*(TM1+TM2+TM3)/8./2./AMMRSS/(2.*PI)**5 + CALL SSSAVE(ISMUR,WID,ISTAU1,IDNM,-IDNT,0,0) + END IF +C-----COMPUTE SNU_E --> E +STAU_1BAR +NU_TAU DECAYS -------------- + AME1=-G*SIN(GAMMAL) + AML1=-G*SIN(GAMMAL)*COS(THETAL)+FL*COS(GAMMAL)*SIN(THETAL) + APE1=-G*THX*COS(GAMMAL) + APL1=-G*THX*COS(GAMMAL)*COS(THETAL)-FL*THX*SIN(GAMMAL)* + $ SIN(THETAL) + IF (AMN1SS.GT.(AME+AML1SS)) THEN + BME1=-FE*COS(GAMMAL) + BPE1=FE*THX*SIN(GAMMAL) + TMP(1)=MW1 + TMP(2)=MW1 + TMP(3)=AML1SS + TMP(4)=AMN1SS + IF (AMN1SS.LT.MW1) THEN + TM1=AML1**2*(AME1**2*MW1**2*SSXINT(AML1SS**2,SSN1ST,AMN1SS**2) + $+BME1**2*SSXINT(AML1SS**2,SSL1ST,AMN1SS**2)) + TMP(2)=MW2 + TM2=2*AML1*APL1*(SNW1*SNW2*AME1*APE1* + $ SSXINT(AML1SS**2,SSN1ST,AMN1SS**2)+BME1*BPE1* + $ SSXINT(AML1SS**2,SSL1ST,AMN1SS**2)) + ELSE + TM1=0. + TM2=0. + END IF + TMP(1)=MW2 + TMP(2)=MW2 + IF (AMN1SS.LT.MW2) THEN + TM3=APL1**2*(APE1**2*MW2**2*SSXINT(AML1SS**2,SSN1ST,AMN1SS**2) + $+BPE1**2*SSXINT(AML1SS**2,SSL1ST,AMN1SS**2)) + ELSE + TM3=0. + END IF + WID=PI**2*(TM1+TM2+TM3)/8./2./AMN1SS/(2.*PI)**5 + CALL SSSAVE(ISNEL,WID,-ISTAU1,IDE,IDNT,0,0) + END IF +C-----COMPUTE SNU_M --> MU +STAU_1BAR +NU_TAU DECAYS -------------- + IF (AMN2SS.GT.(AMMU+AML1SS)) THEN + BME1=-FM*COS(GAMMAL) + BPE1=FM*THX*SIN(GAMMAL) + TMP(1)=MW1 + TMP(2)=MW1 + TMP(3)=AML1SS + TMP(4)=AMN2SS + IF (AMN2SS.LT.MW1) THEN + TM1=AML1**2*(AME1**2*MW1**2*SSXINT(AML1SS**2,SSN1ST,AMN2SS**2) + $+BME1**2*SSXINT(AML1SS**2,SSL1ST,AMN2SS**2)) + TMP(2)=MW2 + TM2=2*AML1*APL1*(SNW1*SNW2*AME1*APE1* + $ SSXINT(AML1SS**2,SSN1ST,AMN2SS**2)+BME1*BPE1* + $ SSXINT(AML1SS**2,SSL1ST,AMN2SS**2)) + ELSE + TM1=0. + TM2=0. + END IF + TMP(1)=MW2 + TMP(2)=MW2 + IF (AMN2SS.LT.MW2) THEN + TM3=APL1**2*(APE1**2*MW2**2*SSXINT(AML1SS**2,SSN1ST,AMN2SS**2) + $+BPE1**2*SSXINT(AML1SS**2,SSL1ST,AMN2SS**2)) + ELSE + TM3=0. + END IF + WID=PI**2*(TM1+TM2+TM3)/8./2./AMN2SS/(2.*PI)**5 + CALL SSSAVE(ISNML,WID,-ISTAU1,IDMU,IDNT,0,0) + END IF +C +C +C decay to neutral higgs bosons +C + IF (AML2SS.GT.(AMHL+AML1SS)) THEN + BH=G*AMW*SIN(BETA-ALFAH)*(-1.+3*TN2THW)*SINL*COSL/2.+G* + $ AMTAU*(TWOM1*COSA+AAL*SINA)*COS(2*THETAL)/2./AMW/COS(BETA) + WID=BH**2*SQRT(SSXLAM(AML2SS**2,AMHL**2,AML1SS**2))/ + $ 16./PI/AML2SS**3 + CALL SSSAVE(ISTAU2,WID,ISHL,ISTAU1,0,0,0) + ENDIF +C + IF (AML2SS.GT.(AMHA+AML1SS)) THEN + BH=G*AMTAU*(TWOM1-AAL*TANB)/2./AMW + WID=BH**2*SQRT(SSXLAM(AML2SS**2,AMHA**2,AML1SS**2))/ + $ 16./PI/AML2SS**3 + CALL SSSAVE(ISTAU2,WID,ISHA,ISTAU1,0,0,0) + ENDIF +C + IF (AML2SS.GT.(AMHH+AML1SS)) THEN + BH=-G*AMW*COS(BETA-ALFAH)*(-1.+3*TN2THW)*SINL*COSL/2.+G* + $ AMTAU*(-TWOM1*SINA+AAL*COSA)*COS(2*THETAL)/2./AMW/COS(BETA) + WID=BH**2*SQRT(SSXLAM(AML2SS**2,AMHH**2,AML1SS**2))/ + $ 16./PI/AML2SS**3 + CALL SSSAVE(ISTAU2,WID,ISHH,ISTAU1,0,0,0) + ENDIF +C +C stau_i -> H^- stau_j +C + IF (AMN3SS.GT.(AML1SS+AMHC)) THEN + A=G/SR2/AMW*((AMTAU**2*TANB-AMW**2*SIN(2*BETA))*COSL- + $ AMTAU*(TWOM1-AAL*TANB)*SINL) + WID=A*A*SQRT(SSXLAM(AMN3SS**2,AML1SS**2,AMHC**2))/ + $ 16./PI/AMN3SS**3 + CALL SSSAVE(ISNTL,WID,ISHC,ISTAU1,0,0,0) + END IF +C + IF (AMN3SS.GT.(AML2SS+AMHC)) THEN + A=G/SR2/AMW*((AMTAU**2*TANB-AMW**2*SIN(2*BETA))*SINL+ + $ AMTAU*(TWOM1-AAL*TANB)*COSL) + WID=A*A*SQRT(SSXLAM(AMN3SS**2,AML2SS**2,AMHC**2))/ + $ 16./PI/AMN3SS**3 + CALL SSSAVE(ISNTL,WID,ISHC,ISTAU2,0,0,0) + END IF +C + IF (AML1SS.GT.(AMN3SS+AMHC)) THEN + A=G/SR2/AMW*((AMTAU**2*TANB-AMW**2*SIN(2*BETA))*COSL- + $ AMTAU*(TWOM1-AAL*TANB)*SINL) + WID=A*A*SQRT(SSXLAM(AML1SS**2,AMN3SS**2,AMHC**2))/ + $ 16./PI/AML1SS**3 + CALL SSSAVE(ISTAU1,WID,-ISHC,ISNTL,0,0,0) + END IF +C + IF (AML2SS.GT.(AMN3SS+AMHC)) THEN + A=G/SR2/AMW*((AMTAU**2*TANB-AMW**2*SIN(2*BETA))*SINL+ + $ AMTAU*(TWOM1-AAL*TANB)*COSL) + WID=A*A*SQRT(SSXLAM(AML2SS**2,AMN3SS**2,AMHC**2))/ + $ 16./PI/AML2SS**3 + CALL SSSAVE(ISTAU2,WID,-ISHC,ISNTL,0,0,0) + END IF +C +C Gauge mediated SUSY breaking model decays to gravitino + IF (AMERSS.GT.(AME+AMGVSS)) THEN + WID=(AMERSS**2-AME**2)**4/48./PI/AMERSS**3/(AMPL*AMGVSS)**2 + CALL SSSAVE(ISER,WID,IDE,91,0,0,0) + END IF + IF (AMMRSS.GT.(AMMU+AMGVSS)) THEN + WID=(AMMRSS**2-AMMU**2)**4/48./PI/AMMRSS**3/(AMPL*AMGVSS)**2 + CALL SSSAVE(ISMUR,WID,IDMU,91,0,0,0) + END IF + IF (AML1SS.GT.(AMTAU+AMGVSS)) THEN + WID=(AML1SS**2-AMTAU**2)**4/48./PI/AML1SS**3/(AMPL*AMGVSS)**2 + CALL SSSAVE(ISTAU1,WID,IDTAU,91,0,0,0) + END IF + IF (AMELSS.GT.(AME+AMGVSS)) THEN + WID=(AMELSS**2-AME**2)**4/48./PI/AMELSS**3/(AMPL*AMGVSS)**2 + CALL SSSAVE(ISEL,WID,IDE,91,0,0,0) + END IF + IF (AMMLSS.GT.(AMMU+AMGVSS)) THEN + WID=(AMMLSS**2-AMMU**2)**4/48./PI/AMMLSS**3/(AMPL*AMGVSS)**2 + CALL SSSAVE(ISMUL,WID,IDMU,91,0,0,0) + END IF + IF (AMN1SS.GT.AMGVSS) THEN + WID=AMN1SS**5/48./PI/(AMPL*AMGVSS)**2 + CALL SSSAVE(ISNEL,WID,IDNE,91,0,0,0) + END IF + IF (AMN2SS.GT.AMGVSS) THEN + WID=AMN2SS**5/48./PI/(AMPL*AMGVSS)**2 + CALL SSSAVE(ISNML,WID,IDNM,91,0,0,0) + END IF + IF (AMN3SS.GT.AMGVSS) THEN + WID=AMN3SS**5/48./PI/(AMPL*AMGVSS)**2 + CALL SSSAVE(ISNTL,WID,IDNT,91,0,0,0) + END IF +C +C Normalize branching ratios +C + CALL SSNORM(ISEL) + CALL SSNORM(ISMUL) + CALL SSNORM(ISTAU1) + CALL SSNORM(ISER) + CALL SSNORM(ISMUR) + CALL SSNORM(ISTAU2) + CALL SSNORM(ISNEL) + CALL SSNORM(ISNML) + CALL SSNORM(ISNTL) +C + RETURN + END diff --git a/ISAJET/isasusy/sslrt1.F b/ISAJET/isasusy/sslrt1.F new file mode 100644 index 00000000000..536fc666002 --- /dev/null +++ b/ISAJET/isasusy/sslrt1.F @@ -0,0 +1,44 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSLRT1(SS) +C----------------------------------------------------------------------- +C SSLRT1: l_R -> l+tau+stau_1 +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" + REAL SS + DOUBLE PRECISION ETMX,ETMN,S,MT1,MT,MLR,BEZI,BEZJ,TM, + ,AI,AJ,BI,BJ,MZI,MZJ,SNZI,SNZJ,XL,BK1,BK2,BK3,BK,WID,SSDLAM + S=SS + MT1=AML1SS + MT=AMTAU + MLR=TMP(1) + BEZI=TMP(2) + BEZJ=TMP(3) + AI=TMP(4) + AJ=TMP(5) + BI=TMP(6) + BJ=TMP(7) + MZI=ABS(TMP(8)) + MZJ=ABS(TMP(9)) + SNZI=SIGN(1.0,TMP(8)) + SNZJ=SIGN(1.0,TMP(9)) + TM=SSDLAM(S,MT**2,MT1**2) + XL=DSQRT(MAX(0.D0,TM)) + ETMN=(S+MT**2-MT1**2-XL*(MLR**2-S)/(MLR**2+S))*(MLR**2+S)/ + , (2*S)/(2*MLR) + ETMX=(S+MT**2-MT1**2+XL*(MLR**2-S)/(MLR**2+S))*(MLR**2+S)/ + , (2*S)/(2*MLR) + BK1=-(ETMX-ETMN)*((ETMX+ETMN)*MLR*S- + , (S+MT**2-MT1**2)*MLR**2)/2.D0 + BK2=(ETMX-ETMN)*((ETMX+ETMN)*MLR-S-MT**2+MT1**2)/2.D0 + BK3=SNZJ*BI*AJ*MZJ+SNZI*BJ*AI*MZI + BK=BI*BJ*BK1+AI*AJ*MZI*MZJ*SNZI*SNZJ*BK2+BK3*MT*(MLR**2-S)* + , (ETMX-ETMN)/2.D0 + WID=BEZI*BEZJ*BK/(S-MZI**2)/(S-MZJ**2) + SSLRT1=WID + RETURN + END diff --git a/ISAJET/isasusy/ssmass.F b/ISAJET/isasusy/ssmass.F new file mode 100644 index 00000000000..0f61b6cfc81 --- /dev/null +++ b/ISAJET/isasusy/ssmass.F @@ -0,0 +1,245 @@ +#include "isajet/pilot.h" + SUBROUTINE SSMASS(XM1,XM2,IALLOW,ILOOP,MHLNEG,MHCNEG,IMODEL) +C----------------------------------------------------------------------- +C +C Diagonalize neutralino, chargino, and Higgs mass matrices +C and save results in /SSPAR/. +C +C If XM1, XM2 < 1E19, use them for the U(1) and SU(2) mass +C terms. Otherwise calculate them from AMGLSS and unification. +C +C Return IALLOW = 1 if Z1SS is not LSP +C IALLOW = 0 otherwise +C +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sslun.inc" +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/ssinf.inc" +C + REAL XM1,XM2 + INTEGER IALLOW,MHLNEG,MHCNEG,IMODEL + REAL AR(4,4),WORK(4),WR(4) + REAL ZETA,ZETAS,YM,XM,COS2A,SINA,AL,SIN2A,COSA,MU2,GP,G, + $TEMP,VS,VP,V,MTAMTA,MTAMB,MTAMZ,ASMB,MBMB, + $ASMT,MTMT,SUALFE,SUALFS + REAL MW1,MW2,THX,THY,MU1 + REAL COSB,SINB,BE,COS2B,SIN2B,PI,SR2,HIGFRZ,MTQ,MBQ + REAL TERM1,TERM2,TERM3,TANTHT,AMGLMZ,SSPOLE,TANTHB,TANTHL + REAL CS2THW,DELCHI,AM2 + DOUBLE PRECISION SSMQCD + COMPLEX*16 SSB0,SSB1,ZZZ + REAL*8 REAL8 + INTEGER I,J,K,IERR,ILOOP +C + REAL8(ZZZ)=DREAL(ZZZ) + IALLOW=0 + PI=4.*ATAN(1.) + SR2=SQRT(2.) + G=SQRT(4.*PI*ALFAEM/SN2THW) + GP=G*SQRT(SN2THW/(1.-SN2THW)) + CS2THW=1.-SN2THW +C + BE=ATAN(1./RV2V1) + SINB=SIN(BE) + COSB=COS(BE) + SIN2B=SIN(2.*BE) + COS2B=COS(2.*BE) + HIGFRZ=MAX(AMZ,SQRT(AMTLSS*AMTRSS)) +C +C Compute m(tau), m(b) at z scale using qcd, qed +C + MTAMTA=AMTAU*(1.-SUALFE(AMTAU**2)/PI) + MTAMB=MTAMTA*(SUALFE(AMBT**2)/SUALFE(AMTAU**2))**(-27./76.) + MTAMZ=MTAMB*(SUALFE(AMZ**2)/SUALFE(AMBT**2))**(-27./80.) + ASMB=SUALFS(AMBT**2,.36,AMTP,3) + MBMB=AMBT*(1.-4*ASMB/3./PI) + MBQ=SSMQCD(DBLE(MBMB),DBLE(HIGFRZ)) + ASMT=SUALFS(AMTP**2,.36,AMTP,3) + MTMT=AMTP/(1.+4*ASMT/3./PI+(16.11-1.04*(5.-6.63/AMTP))* + $(ASMT/PI)**2) + MTQ=SSMQCD(DBLE(MTMT),DBLE(HIGFRZ)) +C +C Light/heavy stop states and mixing angle +C + TERM1=(AMTLSS**2+AMTRSS**2)/2.+AMZ**2*COS2B/4.+MTQ**2 + TERM2=((AMTLSS**2-AMTRSS**2)/2.+COS2B*(8.*AMW**2-5.*AMZ**2) + $/12.)**2 + TERM3=SQRT(TERM2+MTQ**2*(TWOM1*COSB/SINB+AAT)**2) + IF (TERM1.GT.TERM3) THEN + AMT1SS=SQRT(TERM1-TERM3) + ELSE + AMT1SS=0.1 + END IF + AMT2SS=SQRT(TERM1+TERM3) + IF (AAT.NE.TWOM1*COSB/SINB) THEN + TANTHT=(AMT1SS**2-MTQ**2+AMZ**2*COS2B*(-.5+2*SN2THW/3.)- + $ AMTLSS**2)/MTQ/(TWOM1*COSB/SINB+AAT) + THETAT=ATAN(TANTHT) + ELSE + THETAT=PI/2. + END IF +C +C Light/heavy sbottom states and mixing angle +C + TERM1=(AMBLSS**2+AMBRSS**2)/2.-AMZ**2*COS2B/4.+MBQ**2 + TERM2=((AMBLSS**2-AMBRSS**2)/2.-COS2B*(4.*AMW**2-AMZ**2) + $/12.)**2 + TERM3=SQRT(TERM2+MBQ**2*(TWOM1*SINB/COSB+AAB)**2) + IF (TERM1.GT.TERM3) THEN + AMB1SS=SQRT(TERM1-TERM3) + ELSE + AMB1SS=0.1 + END IF + AMB2SS=SQRT(TERM1+TERM3) + TANTHB=(AMB1SS**2-MBQ**2+AMZ**2*COS2B*(.5-SN2THW/3.)- + $AMBLSS**2)/MBQ/(TWOM1*SINB/COSB+AAB) + THETAB=ATAN(TANTHB) +C +C Light/heavy stau states and mixing angle +C + TERM1=(AMLLSS**2+AMLRSS**2)/2.-AMZ**2*COS2B/4.+MTAMZ**2 + TERM2=((AMLLSS**2-AMLRSS**2)/2.-COS2B*(4.*AMW**2-3*AMZ**2) + $/4.)**2 + TERM3=SQRT(TERM2+MTAMZ**2*(TWOM1*SINB/COSB+AAL)**2) +C if stau mass^2<0, then set to tiny mass so point is excluded + IF (TERM1.GT.TERM3) THEN + AML1SS=SQRT(TERM1-TERM3) + ELSE + AML1SS=0.1 + END IF + AML2SS=SQRT(TERM1+TERM3) + TANTHL=(AML1SS**2-MTAMZ**2+AMZ**2*COS2B*(.5-SN2THW)- + $AMLLSS**2)/MTAMZ/(TWOM1*SINB/COSB+AAL) + THETAL=ATAN(TANTHL) +C +C define msbar gluino mass at mz from physical gluino mass + AMGLMZ=SSPOLE(AMGLSS,AMZ**2,-ALFA3) + VS=2.*AMW**2/G**2/(1.+RV2V1**2) + V=SQRT(VS) + VP=RV2V1*V +C +C Use either explicit values or scaling to determine SU(2) +C and U(1) mass terms. NOTE SIGN CONVENTION! +C + IF(ABS(XM2).LT.1.E19.AND.ABS(XM1).LT.1.E19) THEN + MU2=-XM2 + MU1=-XM1 + ELSE + MU2=-ALFA2*AMGLMZ/ALFA3 + MU1=5*SN2THW/3./(1.-SN2THW)*MU2 + ENDIF +C +C Neutralino mass matrix +C + AR(1,1)=0. + AR(1,2)=-TWOM1 + AR(1,3)=-G*V/SR2 + AR(1,4)=GP*V/SR2 + AR(2,1)=-TWOM1 + AR(2,2)=0. + AR(2,3)=G*VP/SR2 + AR(2,4)=-GP*VP/SR2 + AR(3,1)=-G*V/SR2 + AR(3,2)=G*VP/SR2 + AR(3,3)=MU2 + AR(3,4)=0. + AR(4,1)=GP*V/SR2 + AR(4,2)=-GP*VP/SR2 + AR(4,3)=0. + AR(4,4)=MU1 +C + CALL EISRS1(4,4,AR,WR,ZMIXSS,IERR,WORK) + IF (IERR.NE.0) THEN + WRITE(LOUT,*) 'EISRS1 ERROR IN SSMASS, IERR=',IERR + STOP99 + END IF +C +C Sort eigenvectors and eigenvalues according to masses +C + DO 10 I=1,3 + DO 11 J=I+1,4 + IF (ABS(WR(I)).GT.ABS(WR(J))) THEN + TEMP=WR(J) + WR(J)=WR(I) + WR(I)=TEMP + DO 12 K=1,4 + TEMP=ZMIXSS(K,J) + ZMIXSS(K,J)=ZMIXSS(K,I) + ZMIXSS(K,I)=TEMP +12 CONTINUE + END IF +11 CONTINUE +10 CONTINUE +C + AMZ1SS=WR(1) + AMZ2SS=WR(2) + AMZ3SS=WR(3) + AMZ4SS=WR(4) +C +C Chargino mass matrix +C + AL=ATAN(RV2V1) + SINA=SIN(AL) + COSA=COS(AL) + SIN2A=SIN(2.*AL) + COS2A=COS(2.*AL) + ZETAS=(TWOM1**2-MU2**2)**2 + $+4*AMW**2*(AMW**2*COS2A**2+TWOM1**2+MU2**2+2*TWOM1*MU2*SIN2A) + ZETA=SQRT(ZETAS) + XM=-(TWOM1**2-MU2**2-2*AMW**2*COS2A-ZETA) + $/(2*SR2*AMW*(MU2*SINA+TWOM1*COSA)) + YM=-(TWOM1**2-MU2**2+2*AMW**2*COS2A-ZETA) + $/(2*SR2*AMW*(MU2*COSA+TWOM1*SINA)) + IF (XM.NE.0.) THEN + GAMMAL=ATAN(1./XM) + ELSE + GAMMAL=PI/2. + END IF + IF (YM.NE.0.) THEN + GAMMAR=ATAN(1./YM) + ELSE + GAMMAR=PI/2. + END IF + IF (GAMMAL.LT.0.) GAMMAL=GAMMAL+PI + IF (GAMMAR.LT.0.) GAMMAR=GAMMAR+PI + THX=SIGN(1.,XM) + THY=SIGN(1.,YM) + AMW2SS=THX*THY*(COS(GAMMAR)*(MU2*COS(GAMMAL)+G*VP*SIN(GAMMAL)) + $-SIN(GAMMAR)*(-G*V*COS(GAMMAL)-TWOM1*SIN(GAMMAL))) + AMW1SS=SIN(GAMMAR)*(MU2*SIN(GAMMAL)-G*VP*COS(GAMMAL)) + $+COS(GAMMAR)*(-G*V*SIN(GAMMAL)+TWOM1*COS(GAMMAL)) +C IMPLEMENT INO MASS SPLITTING FOR AMSB MODELS + AM2=ABS(XM2) + XLAM=LOG(MU2**2) + MW1=ABS(AMW1SS) + DELCHI=G**2*MW1/8./PI**2*(2*CS2THW*REAL8(SSB0(MW1**2,MW1,AMZ))+ + $2*SN2THW*REAL8(SSB0(MW1**2,MW1,0.))-2*REAL8(SSB0(MW1**2,MW1,AMW)) + $-CS2THW*REAL8(SSB1(MW1**2,MW1,AMZ))-SN2THW* + $REAL8(SSB1(MW1**2,MW1,0.))+REAL8(SSB1(MW1**2,MW1,AMW))) + AMW1SS=AMW1SS+SIGN(1.,AMW1SS)*DELCHI + MW1=ABS(AMW1SS) + MW2=ABS(AMW2SS) +C +C Check validity of parameters +C + IF (IMODEL.EQ.1.OR.IMODEL.EQ.7) THEN + IF(MW1.LE.ABS(AMZ1SS)) IALLOW=1 + IF(AMT1SS.LE.ABS(AMZ1SS)) IALLOW=1 + IF(AMB1SS.LE.ABS(AMZ1SS)) IALLOW=1 + IF(AML1SS.LE.ABS(AMZ1SS)) IALLOW=1 + END IF +C IF(IALLOW.NE.0) RETURN +C +C Higgs mass matrix +C + IF (ILOOP.EQ.1) THEN + CALL SSMHN(MHLNEG) + CALL SSMHC(MHCNEG) + END IF +C + RETURN + END diff --git a/ISAJET/isasusy/ssme3.F b/ISAJET/isasusy/ssme3.F new file mode 100644 index 00000000000..f34830e3ade --- /dev/null +++ b/ISAJET/isasusy/ssme3.F @@ -0,0 +1,59 @@ +#include "isajet/pilot.h" + SUBROUTINE SSME3(KTYP,AM,ZI,ZF) +C +C Give matrix element data for mode most recently saved by +C SSSAVE. Call this once for each pole in the matrix element, +C giving the pole type, mass, and couplings. See /DKYSS3/ +C for more comments. +C +C Assumes SUSY decay product is always FIRST. +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +C +#include "isajet/sslun.inc" +#include "isajet/ssmode.inc" +#include "isajet/dkyss3.inc" +C + INTEGER KTYP,I + REAL AM + COMPLEX ZI(2),ZF(2) +C +C If last SSSAVE failed, then skip the matrix element +C + IF(.NOT.LSSMOD) RETURN +C +C If MSSMOD(NSSMOD)=0, have not booked any poles yet for +C last mode saved. Increment mode counter, and set initial and +C final poles to next one. +C + IF(MSSMOD(NSSMOD).EQ.0) THEN + NMSS3=NMSS3+1 + IF(NMSS3.GT.MXMSS3) THEN + WRITE(LOUT,*) 'ERROR IN SSME3...TOO MANY MODES=',NMSS3 + STOP99 + ENDIF + MSSMOD(NSSMOD)=-NMSS3 + J1SS3(NMSS3)=NPSS3+1 + J2SS3(NMSS3)=NPSS3+1 + WTSS3(NMSS3)=0 + ENDIF +C +C Add pole to list and set second counter to last pole +C + NPSS3=NPSS3+1 + IF(NPSS3.GT.MXPSS3) THEN + WRITE(LOUT,*) 'ERROR IN SSME3...TOO MANY POLES=',NPSS3 + STOP99 + ENDIF + KSS3(NPSS3)=KTYP + AMSS3(NPSS3)=AM + DO 100 I=1,2 + ZISS3(I,NPSS3)=ZI(I) + ZFSS3(I,NPSS3)=ZF(I) +100 CONTINUE + J2SS3(NMSS3)=NPSS3 +C + RETURN + END diff --git a/ISAJET/isasusy/ssmhc.F b/ISAJET/isasusy/ssmhc.F new file mode 100644 index 00000000000..d71946993c4 --- /dev/null +++ b/ISAJET/isasusy/ssmhc.F @@ -0,0 +1,557 @@ +#include "isajet/pilot.h" + SUBROUTINE SSMHC(MHCNEG) +C----------------------------------------------------------------------- +C +C Calculates charged Higgs mass +C (scalar Higgs mixing angle) using radiative +C corrections calculated by M. Bisset +C and save results in /SSPAR/. +C +C Both top and bottom couplings are now +C included. Non-degenerate mixed squark +C masses and A-terms are also included. +C The D-terms from the squark mass matrix +C (terms prop. to g**2 * Yukawa coupling) +C are included by default. +C +C There is an arbitrary mass scale that must +C chosen to avoid dimensionful logarithms. +C The choice does not matter if D-terms are +C not included, but it does matter if D-terms +C are included. +C +C Arbitrary mass scale set to +C QQQ = HIGFRZ = SQRT(AMTLSS*AMTRSS) +C Updated to include running masses as 2-loop effect +C +C It is assumed that the A-terms are real. +C (Complex A-terms are taken into account +C much of the subroutine; but, not in all +C cases.) +C +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sslun.inc" +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +C + INTEGER MHCNEG + REAL PI,PI2,SR2,G2,GP2,GGP,GG1,GG2 + REAL GGPM,GG3,GG4 + REAL TANB,COTB,COSB,SINB,BE + REAL SINB2,COSB2,COS2B,SIN2B + REAL V2,VP2,V,VP,VVP,VPVM,VVPP,MT,MB + REAL MT2,MB2,MT4,MB4,FT2,FB2,FT,FB + REAL MW2,ZAP,QQQ2,EP,EP2,RR,MHP2 + REAL ATI,ABI,ATR,ABR,AT2,AB2 + REAL MSTL2,MSTR2,MSBL2,MSBR2 + REAL TLRM,BLRM,TLRP,BLRP + REAL MST1,MST2,MSB1,MSB2 + REAL MST1SQ,MST2SQ,MSB1SQ,MSB2SQ + REAL TTT1,TTT2,TTT3,BBB1,BBB2,BBB3 + REAL TEMPT,TEMPB,ROOTT,ROOTB,TM1B +C +C For non-degenerate squarks +C + REAL TERMT,TERMB,DHRT1,DHRT2,DHRB1,DHRB2 + REAL DHRPT1,DHRPT2,DHRPB1,DHRPB2 + REAL DHPST1,DHPST2,DHPSB1,DHPSB2 + REAL DHMST1,DHMST2,DHMSB1,DHMSB2 + REAL ATA1,ATA2,BTA1,BTA2,ABA1,ABA2,BBA1,BBA2 + REAL ATA1SQ,ATA2SQ,BTA1SQ,BTA2SQ + REAL ABA1SQ,ABA2SQ,BBA1SQ,BBA2SQ + REAL NABT1,NABT2,NABB1,NABB2 + REAL FTG,FBG,BABA,PT1B1,PT1B2,PT2B1,PT2B2 + REAL PDPST1,PDPST2,PDPSB1,PDPSB2 + REAL PDMST1,PDMST2,PDMSB1,PDMSB2 + REAL PDPMT1,PDPMT2,PDPMB1,PDPMB2 + REAL LMST1,LMST2,LMSB1,LMSB2 + REAL EMI1,EMI2,EM3,TEMPF + REAL DVRR,DVRPRP,DVRRP,TRACE,DETV + REAL TERMSQ,GOLD2,MHC2 + REAL HIGFRZ,ASMB,MBMB,MBQ,ASMT,MTMT,MTQ,SUALFS + DOUBLE PRECISION SSMQCD +C + MHCNEG=0 + PI=4.*ATAN(1.) + PI2=PI**2 + SR2=SQRT(2.) + G2=4.*PI*ALFAEM/SN2THW + GP2=G2*SN2THW/(1.-SN2THW) + HIGFRZ=SQRT(AMTLSS*AMTRSS) + ASMB=SUALFS(AMBT**2,.36,AMTP,3) + MBMB=AMBT*(1.-4*ASMB/3./PI) + MBQ=SSMQCD(DBLE(MBMB),DBLE(HIGFRZ)) + ASMT=SUALFS(AMTP**2,.36,AMTP,3) + MTMT=AMTP/(1.+4*ASMT/3./PI+(16.11-1.04*(5.-6.63/AMTP))* + $(ASMT/PI)**2) + MTQ=SSMQCD(DBLE(MTMT),DBLE(HIGFRZ)) + MT=MTQ + MB=MBQ + MT2=MT**2 + MB2=MB**2 + MT4=MT2**2 + MB4=MB2**2 + MW2=AMW**2 + EP=TWOM1 + EP2=EP**2 + RR=RV2V1 + MHP2=AMHA**2 + TANB=1.0/RR + COTB=RR + BE=ATAN(1./RV2V1) + SINB=SIN(BE) + COSB=COS(BE) + SINB2=SINB**2 + COSB2=COSB**2 + SIN2B=SIN(2.*BE) + COS2B=COS(2.*BE) + V2=2.0*MW2*SINB2/G2 + VP2=2.0*MW2*COSB2/G2 + V=SQRT(V2) + VP=SQRT(VP2) + VVP=SQRT(V2*VP2) + VPVM=VP2-V2 + GGP=G2+GP2 + GGPM=G2-GP2 + GG1=G2-5.0*GP2/3.0 + GG2=G2-GP2/3.0 + GG3=G2+5.0*GP2/3.0 + GG4=G2+GP2/3.0 +C + VVPP=2.0*AMZ**2/GGP + FT2=MT2/V2 + FB2=MB2/VP2 + FT=SQRT(FT2) + FB=SQRT(FB2) +C + MSTL2=AMTLSS**2 + MSTR2=AMTRSS**2 + MSBL2=AMBLSS**2 + MSBR2=AMBRSS**2 + TLRM=MSTL2-MSTR2 + BLRM=MSBL2-MSBR2 + TLRP=MSTL2+MSTR2 + BLRP=MSBL2+MSBR2 +C +C Charged Higgs mass calculation +C (AAT and AAB are also assumed to be real) +C + ATR=AAT + ABR=AAB + ATI=0.0 + ABI=0.0 + AT2=ATR**2+ATI**2 + AB2=ABR**2+ABI**2 +C +C UNFORTUNATELY, I HAVE USED MY OLD CONVENTION +C FOR THE STOP AND SBOTTOM EIGENVALUES HERE +C (T1 <==> T2 OF NOTATION IN X. TATA'S AND OTHER +C PEOPLE'S NOTATION). SO THE NEXT EIGHT LINES ARE +C A FIX-UP UNTIL I GO THROUGH AND CHANGE THE +C NOTATION THROUGHOUT THIS SUBROUTINE. +C + MST2=AMT1SS + MST1=AMT2SS + MSB2=AMB1SS + MSB1=AMB2SS + MST2SQ=AMT1SS**2 + MST1SQ=AMT2SS**2 + MSB2SQ=AMB1SS**2 + MSB1SQ=AMB2SS**2 +C + QQQ2=HIGFRZ**2 + ZAP=1 +C +C Non-degenerate squarks and/or D-terms. Since D-terms are +C always included, old dead code has been deleted. FEP +C +C ROOTT recast as a sum of squares. Note that ROOTT=0 +C could happen accidently and causes an error. + TTT1=0.5*(MSTL2+MSTR2)+MT2+ZAP*VPVM*GGP/8.0 + TTT2=TLRM+ZAP*GG1*VPVM/4.0 + TTT3=4.0*FT2*(EP2*VP2+2.0*EP*VVP*ATR+AT2*V2) + ROOTT=4*MT2*(COSB*EP + AAT*SINB)**2/SINB**2 + + $(AMTLSS**2 - AMTRSS**2 + + $AMW**2*(-5*GP2/3 + G2)*(COSB**2 - SINB**2)/(2*G2))**2 + ROOTT=0.5*SQRT(ROOTT) + IF(ROOTT.EQ.0.0) THEN + WRITE(LOUT,*) 'SSMHC: ERROR: ROOTT = 0,', + $ ' CANNOT CALCULATE H+ MASS FOR THIS CASE.' + STOP99 + ENDIF +C + BBB1=0.5*(MSBL2+MSBR2)+MB2-ZAP*VPVM*GGP/8.0 + BBB2=BLRM-ZAP*GG2*VPVM/4.0 + BBB3=4.0*FB2*(EP2*V2+2.0*EP*VVP*ABR+AB2*VP2) +C ROOTB recast as a sum of squares. + ROOTB=4*MB2*(AAB*COSB + EP*SINB)**2/COSB**2 + + $(AMBLSS**2 - AMBRSS**2 - + $AMW**2*(-GP2/3 + G2)*(COSB**2 - SINB**2)/(2*G2))**2 + ROOTB=0.5*SQRT(ROOTB) + IF(ROOTB.EQ.0.0) THEN + WRITE(LOUT,*) 'SSMHC: ERROR: ROOTB = 0,', + $ ' CANNOT CALCULATE H+ MASS FOR THIS CASE.' + STOP99 + ENDIF +C +C Calculate 2M1*B term +C + TEMPT=EP*FT2*VVP*ATI**2/(ROOTT**2) + TEMPB=EP*FB2*VVP*ABI**2/(ROOTB**2) + TM1B=-FT2*(TEMPT+ATR)*TTT1*LOG(MST1SQ/MST2SQ)/ROOTT + TM1B=TM1B-FT2*ATR*LOG(MST1SQ*MST2SQ/QQQ2/QQQ2) + TM1B=TM1B+FT2*(2.0*TEMPT-ATR) + TM1B=TM1B-FB2*(TEMPB+ABR)*BBB1*LOG(MSB1SQ/MSB2SQ)/ROOTB + TM1B=TM1B-FB2*ABR*LOG(MSB1SQ*MSB2SQ/QQQ2/QQQ2) + TM1B=TM1B+FB2*(2.0*TEMPB-ABR) + TM1B=3.0*EP*TM1B/32.0/PI2 + TM1B=TM1B-VVP*MHP2/VVPP +C +C Calculate derivatives w.r.t. H_R divided by v*sqrt(2) +C + TEMPT=ZAP*GG1*(TLRM+VPVM*GG1/4.0)/8.0 + TERMT=-TEMPT+FT2*(EP*COTB*ATR+AT2) + TERMT=TERMT/(2.0*ROOTT) + DHRT1=FT2-ZAP*GGP/8.0 + TERMT + DHRT2=FT2-ZAP*GGP/8.0 - TERMT +C + TEMPB=ZAP*GG2*(BLRM-VPVM*GG2/4.0)/8.0 + TERMB=TEMPB+FB2*EP*(EP+COTB*ABR) + TERMB=TERMB/(2.0*ROOTB) + DHRB1=ZAP*GGP/8.0 + TERMB + DHRB2=ZAP*GGP/8.0 - TERMB +C +C Calculate derivatives w.r.t. H_R' divided by v'*sqrt(2) +C + TERMT=TEMPT+FT2*EP*(EP+TANB*ATR) + TERMT=TERMT/(2.0*ROOTT) + DHRPT1=ZAP*GGP/8.0 + TERMT + DHRPT2=ZAP*GGP/8.0 - TERMT +C + TERMB=-TEMPB+FB2*(EP*TANB*ABR+AB2) + TERMB=TERMB/(2.0*ROOTB) + DHRPB1=FB2-ZAP*GGP/8.0 + TERMB + DHRPB2=FB2-ZAP*GGP/8.0 - TERMB +C +C Calculate second derivatives w.r.t. H_R^+ +C + TEMPT=(TLRM+ZAP*VPVM*GG1/4.0)/(4.0*ROOTT) + TERMT=TEMPT*(-FT2+ZAP*GG3/4.0) + DHPST1=FT2/2.0 + ZAP*GGPM/8.0 + TERMT + DHPST2=FT2/2.0 + ZAP*GGPM/8.0 - TERMT +C + TEMPB=(BLRM-ZAP*VPVM*GG2/4.0)/(4.0*ROOTB) + TERMB=TEMPB*(FT2-ZAP*GG4/4.0) + DHPSB1=FT2/2.0 - ZAP*GGPM/8.0 + TERMB + DHPSB2=FT2/2.0 - ZAP*GGPM/8.0 - TERMB +C +C Calculate second derivatives w.r.t. H_R'^- +C + TERMT=TEMPT*(FB2-ZAP*GG3/4.0) + DHMST1=FB2/2.0 - ZAP*GGPM/8.0 + TERMT + DHMST2=FB2/2.0 - ZAP*GGPM/8.0 - TERMT +C + TERMB=TEMPB*(-FB2+ZAP*GG4/4.0) + DHMSB1=FB2/2.0 + ZAP*GGPM/8.0 + TERMB + DHMSB2=FB2/2.0 + ZAP*GGPM/8.0 - TERMB +C +C From perturbative terms +C Here I assume A_t and A_b are real +C and therefore the eigenvectors are real +C +C Find stop eigenvector factors +C + TEMPT=-TLRM/2.0 - ZAP*VPVM*GG1/8.0 + ATA1=TEMPT+ROOTT + ATA2=TEMPT-ROOTT + BTA1=-MT*(EP*COTB + ATR) + BTA2=BTA1 + IF(ATA1.EQ.0.0 .AND. BTA1.EQ.0.0) THEN + ATA1=-BTA1 + BTA1 = TEMPT - ROOTT + IF(ATA1.EQ.0.0 .AND. BTA1.EQ.0.0) THEN + WRITE(LOUT,*) 'SSMHC: ERROR: ZERO EIGENVECTOR FOR MST1SQ' + STOP99 + ENDIF + ENDIF + IF(ATA2.EQ.0.0 .AND. BTA2.EQ.0.0) THEN + ATA2=-BTA2 + BTA2=TEMPT+ROOTT + IF(ATA2.EQ.0.0 .AND. BTA2.EQ.0.0) THEN + WRITE(LOUT,*) 'SSMHC: ERROR: ZERO EIGENVECTOR FOR MST2SQ' + STOP99 + ENDIF + ENDIF + ATA1SQ=ATA1**2 + BTA1SQ=BTA1**2 + ATA2SQ=ATA2**2 + BTA2SQ=BTA2**2 + NABT1=1.0/(ATA1SQ+BTA1SQ) + NABT2=1.0/(ATA2SQ+BTA2SQ) +C +C Find sbottom eigenvector factors +C + TEMPB=-BLRM/2.0 + ZAP*VPVM*GG2/8.0 + ABA1=TEMPB+ROOTB + ABA2=TEMPB-ROOTB + BBA1=-MB*(EP*TANB + ABR) + BBA2=BBA1 + IF(ABA1.EQ.0.0 .AND. BBA1.EQ.0.0) THEN + ABA1=-BBA1 + BBA1=TEMPB-ROOTB + IF(ABA1.EQ.0.0 .AND. BBA1.EQ.0.0) THEN + WRITE(LOUT,*) 'SSMHC: ERROR: ZERO EIGENVECTOR FOR MSB1SQ' + STOP99 + ENDIF + ENDIF + IF(ABA2.EQ.0.0 .AND. BBA2.EQ.0.0) THEN + ABA2=-BBA2 + BBA2=TEMPB+ROOTB + IF(ABA2.EQ.0.0 .AND. BBA2.EQ.0.0) THEN + WRITE(LOUT,*) 'SSMHC: ERROR ZERO EIGENVECTOR FOR MSB2SQ' + STOP99 + ENDIF + ENDIF + ABA1SQ=ABA1**2 + BBA1SQ=BBA1**2 + ABA2SQ=ABA2**2 + BBA2SQ=BBA2**2 + NABB1=1.0/(ABA1SQ+BBA1SQ) + NABB2=1.0/(ABA2SQ+BBA2SQ) +C +C Calculate perturbative terms +C from H_R^+2 derivative terms +C + FTG=FT2-ZAP*G2/2.0 + BABA=FT*FB*(VVP*FTG-EP*ATR) + PT1B1=V2*(FTG**2)*BTA1SQ*BBA1SQ + PT1B1=PT1B1+2.0*EP*FB*V*FTG*BTA1SQ*BBA1*ABA1 + PT1B1=PT1B1-2.0*ATR*MT*FTG*BTA1*ATA1*BBA1SQ + PT1B1=PT1B1+2.0*BABA*BTA1*ATA1*BBA1*ABA1 + PT1B1=PT1B1-2.0*ATR*FT2*MB*ATA1SQ*BBA1*ABA1 + PT1B1=PT1B1+2.0*EP*FT*FB*MB*BTA1*ATA1*ABA1SQ + PT1B1=PT1B1+FT2*AT2*ATA1SQ*BBA1SQ + PT1B1=PT1B1+FB2*EP2*BTA1SQ*ABA1SQ + PT1B1=PT1B1+FT2*MB2*ATA1SQ*ABA1SQ + PT1B1=PT1B1*NABT1*NABB1 +C + PT1B2=V2*(FTG**2)*BTA1SQ*BBA2SQ + PT1B2=PT1B2+2.0*EP*FB*V*FTG*BTA1SQ*BBA2*ABA2 + PT1B2=PT1B2-2.0*ATR*MT*FTG*BTA1*ATA1*BBA2SQ + PT1B2=PT1B2+2.0*BABA*BTA1*ATA1*BBA2*ABA2 + PT1B2=PT1B2-2.0*ATR*FT2*MB*ATA1SQ*BBA2*ABA2 + PT1B2=PT1B2+2.0*EP*FT*FB*MB*BTA1*ATA1*ABA2SQ + PT1B2=PT1B2+FT2*AT2*ATA1SQ*BBA2SQ + PT1B2=PT1B2+FB2*EP2*BTA1SQ*ABA2SQ + PT1B2=PT1B2+FT2*MB2*ATA1SQ*ABA2SQ + PT1B2=PT1B2*NABT1*NABB2 +C + PT2B1=V2*(FTG**2)*BTA2SQ*BBA1SQ + PT2B1=PT2B1+2.0*EP*FB*V*FTG*BTA2SQ*BBA1*ABA1 + PT2B1=PT2B1-2.0*ATR*MT*FTG*BTA2*ATA2*BBA1SQ + PT2B1=PT2B1+2.0*BABA*BTA2*ATA2*BBA1*ABA1 + PT2B1=PT2B1-2.0*ATR*FT2*MB*ATA2SQ*BBA1*ABA1 + PT2B1=PT2B1+2.0*EP*FT*FB*MB*BTA2*ATA2*ABA1SQ + PT2B1=PT2B1+FT2*AT2*ATA2SQ*BBA1SQ + PT2B1=PT2B1+FB2*EP2*BTA2SQ*ABA1SQ + PT2B1=PT2B1+FT2*MB2*ATA2SQ*ABA1SQ + PT2B1=PT2B1*NABT2*NABB1 +C + PT2B2=V2*(FTG**2)*BTA2SQ*BBA2SQ + PT2B2=PT2B2+2.0*EP*FB*V*FTG*BTA2SQ*BBA2*ABA2 + PT2B2=PT2B2-2.0*ATR*MT*FTG*BTA2*ATA2*BBA2SQ + PT2B2=PT2B2+2.0*BABA*BTA2*ATA2*BBA2*ABA2 + PT2B2=PT2B2-2.0*ATR*FT2*MB*ATA2SQ*BBA2*ABA2 + PT2B2=PT2B2+2.0*EP*FT*FB*MB*BTA2*ATA2*ABA2SQ + PT2B2=PT2B2+FT2*AT2*ATA2SQ*BBA2SQ + PT2B2=PT2B2+FB2*EP2*BTA2SQ*ABA2SQ + PT2B2=PT2B2+FT2*MB2*ATA2SQ*ABA2SQ + PT2B2=PT2B2*NABT2*NABB2 +C The following used to add 1e-8, but this may be less than +C machine precision. Multiply by 1.001 instead. + IF(MST1SQ.EQ.MSB1SQ) THEN + WRITE(LOUT,*) 'SSMHC: WARNING: MST1 = MSB1', + $ ' MST1 RAISED BY 0.0001' + MST1SQ = MST1SQ*1.0001 + ENDIF + IF(MST1SQ.EQ.MSB2SQ) THEN + WRITE(LOUT,*) 'SSMHC: WARNING: MST1 = MSB2', + $ ' MST1 RAISED BY 0.0001' + MST1SQ = MST1SQ*1.0001 + ENDIF + IF(MST2SQ.EQ.MSB1SQ) THEN + WRITE(LOUT,*) 'SSMHC: WARNING: MST2 = MSB1', + $ ' MST2 RAISED BY 0.0001' + MST2SQ = MST2SQ*1.0001 + ENDIF + IF(MST2SQ.EQ.MSB2SQ) THEN + WRITE(LOUT,*) 'SSMHC: WARNING: MST2 = MSB2', + $ ' MST2 RAISED BY 0.0001' + MST2SQ = MST2SQ*1.0001 + ENDIF +C + PDPST1=PT1B1/(MST1SQ-MSB1SQ) +PT1B2/(MST1SQ-MSB2SQ) + PDPST2=PT2B1/(MST2SQ-MSB1SQ) +PT2B2/(MST2SQ-MSB2SQ) + PDPSB1=PT1B1/(MSB1SQ-MST1SQ) +PT2B1/(MSB1SQ-MST2SQ) + PDPSB2=PT1B2/(MSB2SQ-MST1SQ) +PT2B2/(MSB2SQ-MST2SQ) +C +C Calculate perturbative terms +C from H_R'^-2 derivative terms +C + FBG=FB2-ZAP*G2/2.0 + BABA=FT*FB*(VVP*FBG-EP*ABR) + PT1B1=VP2*(FBG**2)*BTA1SQ*BBA1SQ + PT1B1=PT1B1-2.0*ABR*MB*FBG*BTA1SQ*BBA1*ABA1 + PT1B1=PT1B1+2.0*EP*FT*VP*FBG*BTA1*ATA1*BBA1SQ + PT1B1=PT1B1+2.0*BABA*BTA1*ATA1*BBA1*ABA1 + PT1B1=PT1B1+2.0*EP*FT*FB*MT*ATA1SQ*BBA1*ABA1 + PT1B1=PT1B1-2.0*ABR*FB2*MT*BTA1*ATA1*ABA1SQ + PT1B1=PT1B1+FT2*EP2*ATA1SQ*BBA1SQ + PT1B1=PT1B1+FB2*AB2*BTA1SQ*ABA1SQ + PT1B1=PT1B1+FB2*MT2*ATA1SQ*ABA1SQ + PT1B1=PT1B1*NABT1*NABB1 +C + PT1B2=VP2*(FBG**2)*BTA1SQ*BBA2SQ + PT1B2=PT1B2-2.0*ABR*MB*FBG*BTA1SQ*BBA2*ABA2 + PT1B2=PT1B2+2.0*EP*FT*VP*FBG*BTA1*ATA1*BBA2SQ + PT1B2=PT1B2+2.0*BABA*BTA1*ATA1*BBA2*ABA2 + PT1B2=PT1B2+2.0*EP*FT*FB*MT*ATA1SQ*BBA2*ABA2 + PT1B2=PT1B2-2.0*ABR*FB2*MT*BTA1*ATA1*ABA2SQ + PT1B2=PT1B2+FT2*EP2*ATA1SQ*BBA2SQ + PT1B2=PT1B2+FB2*AB2*BTA1SQ*ABA2SQ + PT1B2=PT1B2+FB2*MT2*ATA1SQ*ABA2SQ + PT1B2=PT1B2*NABT1*NABB2 +C + PT2B1=VP2*(FBG**2)*BTA2SQ*BBA1SQ + PT2B1=PT2B1-2.0*ABR*MB*FBG*BTA2SQ*BBA1*ABA1 + PT2B1=PT2B1+2.0*EP*FT*VP*FBG*BTA2*ATA2*BBA1SQ + PT2B1=PT2B1+2.0*BABA*BTA2*ATA2*BBA1*ABA1 + PT2B1=PT2B1+2.0*EP*FT*FB*MT*ATA2SQ*BBA1*ABA1 + PT2B1=PT2B1-2.0*ABR*FB2*MT*BTA2*ATA2*ABA1SQ + PT2B1=PT2B1+FT2*EP2*ATA2SQ*BBA1SQ + PT2B1=PT2B1+FB2*AB2*BTA2SQ*ABA1SQ + PT2B1=PT2B1+FB2*MT2*ATA2SQ*ABA1SQ + PT2B1=PT2B1*NABT2*NABB1 +C + PT2B2=VP2*(FBG**2)*BTA2SQ*BBA2SQ + PT2B2=PT2B2-2.0*ABR*MB*FBG*BTA2SQ*BBA2*ABA2 + PT2B2=PT2B2+2.0*EP*FT*VP*FBG*BTA2*ATA2*BBA2SQ + PT2B2=PT2B2+2.0*BABA*BTA2*ATA2*BBA2*ABA2 + PT2B2=PT2B2+2.0*EP*FT*FB*MT*ATA2SQ*BBA2*ABA2 + PT2B2=PT2B2-2.0*ABR*FB2*MT*BTA2*ATA2*ABA2SQ + PT2B2=PT2B2+FT2*EP2*ATA2SQ*BBA2SQ + PT2B2=PT2B2+FB2*AB2*BTA2SQ*ABA2SQ + PT2B2=PT2B2+FB2*MT2*ATA2SQ*ABA2SQ + PT2B2=PT2B2*NABT2*NABB2 +C + PDMST1=PT1B1/(MST1SQ-MSB1SQ) +PT1B2/(MST1SQ-MSB2SQ) + PDMST2=PT2B1/(MST2SQ-MSB1SQ) +PT2B2/(MST2SQ-MSB2SQ) + PDMSB1=PT1B1/(MSB1SQ-MST1SQ) +PT2B1/(MSB1SQ-MST2SQ) + PDMSB2=PT1B2/(MSB2SQ-MST1SQ) +PT2B2/(MSB2SQ-MST2SQ) +C +C Calculate perturbative terms +C from H_R^+ H_R'^- derivative terms +C + BABA=FT*FB*(V2*FTG+VP2*FBG+EP2+ATR*ABR) + PT1B1=-VVP*FTG*FBG*BTA1SQ*BBA1SQ + PT1B1=PT1B1+FB*(ABR*V*FTG-EP*VP*FBG)*BTA1SQ*BBA1*ABA1 + PT1B1=PT1B1-FT*(EP*V*FTG-ATR*VP*FBG)*BTA1*ATA1*BBA1SQ + PT1B1=PT1B1-BABA*BTA1*ATA1*BBA1*ABA1 + PT1B1=PT1B1+FT2*FB*(ATR*V-EP*VP)*ATA1SQ*BBA1*ABA1 + PT1B1=PT1B1+FT*FB2*(ABR*VP-EP*V)*BTA1*ATA1*ABA1SQ + PT1B1=PT1B1+FT2*EP*ATR*ATA1SQ*BBA1SQ + PT1B1=PT1B1+FB2*EP*ABR*BTA1SQ*ABA1SQ + PT1B1=PT1B1-FT*FB*MT*MB*ATA1SQ*ABA1SQ + PT1B1=PT1B1*NABT1*NABB1 +C + PT1B2=-VVP*FTG*FBG*BTA1SQ*BBA2SQ + PT1B2=PT1B2+FB*(ABR*V*FTG-EP*VP*FBG)*BTA1SQ*BBA2*ABA2 + PT1B2=PT1B2-FT*(EP*V*FTG-ATR*VP*FBG)*BTA1*ATA1*BBA2SQ + PT1B2=PT1B2-BABA*BTA1*ATA1*BBA2*ABA2 + PT1B2=PT1B2+FT2*FB*(ATR*V-EP*VP)*ATA1SQ*BBA2*ABA2 + PT1B2=PT1B2+FT*FB2*(ABR*VP-EP*V)*BTA1*ATA1*ABA2SQ + PT1B2=PT1B2+FT2*EP*ATR*ATA1SQ*BBA2SQ + PT1B2=PT1B2+FB2*EP*ABR*BTA1SQ*ABA2SQ + PT1B2=PT1B2-FT*FB*MT*MB*ATA1SQ*ABA2SQ + PT1B2=PT1B2*NABT1*NABB2 +C + PT2B1= -VVP*FTG*FBG*BTA2SQ*BBA1SQ + PT2B1= PT2B1 + FB*(ABR*V*FTG - EP*VP*FBG)*BTA2SQ*BBA1*ABA1 + PT2B1= PT2B1 - FT*(EP*V*FTG - ATR*VP*FBG)*BTA2*ATA2*BBA1SQ + PT2B1= PT2B1 - BABA*BTA2*ATA2*BBA1*ABA1 + PT2B1= PT2B1 + FT2*FB*(ATR*V - EP*VP)*ATA2SQ*BBA1*ABA1 + PT2B1= PT2B1 + FT*FB2*(ABR*VP - EP*V)*BTA2*ATA2*ABA1SQ + PT2B1= PT2B1 + FT2*EP*ATR*ATA2SQ*BBA1SQ + PT2B1= PT2B1 + FB2*EP*ABR*BTA2SQ*ABA1SQ + PT2B1= PT2B1 - FT*FB*MT*MB*ATA2SQ*ABA1SQ + PT2B1= PT2B1*NABT2*NABB1 +C + PT2B2=-VVP*FTG*FBG*BTA2SQ*BBA2SQ + PT2B2=PT2B2+FB*(ABR*V*FTG-EP*VP*FBG)*BTA2SQ*BBA2*ABA2 + PT2B2=PT2B2-FT*(EP*V*FTG-ATR*VP*FBG)*BTA2*ATA2*BBA2SQ + PT2B2=PT2B2-BABA*BTA2*ATA2*BBA2*ABA2 + PT2B2=PT2B2+FT2*FB*(ATR*V-EP*VP)*ATA2SQ*BBA2*ABA2 + PT2B2=PT2B2+FT*FB2*(ABR*VP-EP*V)*BTA2*ATA2*ABA2SQ + PT2B2=PT2B2+FT2*EP*ATR*ATA2SQ*BBA2SQ + PT2B2=PT2B2+FB2*EP*ABR*BTA2SQ*ABA2SQ + PT2B2=PT2B2-FT*FB*MT*MB*ATA2SQ*ABA2SQ + PT2B2=PT2B2*NABT2*NABB2 +C + PDPMT1=PT1B1/(MST1SQ-MSB1SQ) +PT1B2/(MST1SQ-MSB2SQ) + PDPMT2=PT2B1/(MST2SQ-MSB1SQ) +PT2B2/(MST2SQ-MSB2SQ) + PDPMB1=PT1B1/(MSB1SQ-MST1SQ) +PT2B1/(MSB1SQ-MST2SQ) + PDPMB2=PT1B2/(MSB2SQ-MST1SQ) +PT2B2/(MSB2SQ-MST2SQ) +C + MST1SQ=MST1**2 + MST2SQ=MST2**2 + LMST1=MST1SQ*(2.0*LOG(MST1SQ/QQQ2)+1.0) + LMST2=MST2SQ*(2.0*LOG(MST2SQ/QQQ2)+1.0) + LMSB1=MSB1SQ*(2.0*LOG(MSB1SQ/QQQ2)+1.0) + LMSB2=MSB2SQ*(2.0*LOG(MSB2SQ/QQQ2)+1.0) +C + EMI1=LMST1*(PDPST1+DHPST1-DHRT1) + EMI1=EMI1+LMST2*(PDPST2+DHPST2-DHRT2) + EMI1=EMI1+LMSB1*(PDPSB1+DHPSB1-DHRB1) + EMI1=EMI1+LMSB2*(PDPSB2+DHPSB2-DHRB2) +C + EMI2=LMST1*(PDMST1+DHMST1-DHRPT1) + EMI2=EMI2+LMST2*(PDMST2+DHMST2-DHRPT2) + EMI2=EMI2+LMSB1*(PDMSB1+DHMSB1-DHRPB1) + EMI2=EMI2+LMSB2*(PDMSB2+DHMSB2-DHRPB2) +C + EM3=LMST1*PDPMT1+LMST2*PDPMT2 + EM3=EM3+LMSB1*PDPMB1+LMSB2*PDPMB2 +C + TEMPF=MT2*LOG(MT2/QQQ2)-MB2*LOG(MB2/QQQ2) + DVRR=4.0*FT2*MB2*TEMPF/(MT2-MB2) + DVRR=3.0*(EMI1-DVRR-2.0*FT2*MB2)/32.0/PI2 + DVRR=-TM1B*COTB +VP2*G2/2.0 +DVRR +C + DVRPRP=4.0*FB2*MT2*TEMPF/(MT2-MB2) + DVRPRP=3.0*(EMI2-DVRPRP-2.0*FB2*MT2)/32.0/PI2 + DVRPRP=-TM1B*TANB +V2*G2/2.0 +DVRPRP +C + DVRRP=1.0 +(MT2+MB2)*LOG(MT2/MB2)/(MT2-MB2) + DVRRP=2.0*FT*FB*MT*MB*(DVRRP+LOG(MT2*MB2/(QQQ2**2))) + DVRRP=3.0*(EM3+DVRRP)/32.0/PI2 + DVRRP=TM1B -G2*VVP/2.0 +DVRRP +C + TRACE=DVRR+DVRPRP + DETV=4.0*(DVRR*DVRPRP-DVRRP**2) +C Rewrite TERMSQ=TRACE**2-DETV + TERMSQ=(DVRR-DVRPRP)**2+4*DVRRP**2 + TERMSQ=SQRT(TERMSQ)/2.0 + GOLD2=TRACE/2.0 -TERMSQ + MHC2=TRACE/2.0 +TERMSQ +C + IF(MHC2.LT.0.0) THEN + MHCNEG=1 + AMHC=0. + GO TO 1000 + ENDIF + AMHC=SQRT(MHC2) +1000 RETURN + END diff --git a/ISAJET/isasusy/ssmhn.F b/ISAJET/isasusy/ssmhn.F new file mode 100644 index 00000000000..5801f82659f --- /dev/null +++ b/ISAJET/isasusy/ssmhn.F @@ -0,0 +1,454 @@ +#include "isajet/pilot.h" + SUBROUTINE SSMHN(MHLNEG) +C----------------------------------------------------------------------- +C +C Calculate HL, HH masses and ALFAH +C (scalar Higgs mixing angle) using radiative +C corrections calculated by M. Bisset +C and save results in /SSPAR/. +C +C Both top and bottom couplings are now +C included. Non-degenerate mixed squark +C masses and A-terms are also included. +C The D-terms from the squark mass matrix +C (terms prop. to g**2 * Yukawa coupling) +C are included as an option: +C INRAD = 1 ==> D-TERMS ON +C INRAD = 2 ==> D-TERMS OFF . +C +C 10/18/93 D-terms are now turned on. +C INRAD = 1 +C +C There is an arbitrary mass scale that must +C chosen to avoid dimensionful logarithms. +C The choice does not matter if D-terms are +C not included, but it does matter if D-terms +C are included. +C +C Arbitrary mass scale updated to +C QQQ = HIGFRZ = SQRT(AMTLSS*AMTRSS) +C with running masses to include dominant 2-loop +C effects. 12/10/96 H. Baer +C +C It is assumed that the A-terms are real. +C Complex A-terms are allowed +C (unless RTT=0 or RBB=0 --see below) in +C this subroutine, but the imaginary parts +C are now set to zero. +C +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sslun.inc" +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +C + REAL PI,PI2,SR2,G2,GP2,GGP,GG1,GG2 + REAL TANB,COTB,COSB,SINB,BE + REAL SINB2,COSB2,COS2B,SIN2B + REAL V2,VP2,V,VP,VVP,VPVM,VVPP + REAL MT2,MB2,FT2,FB2,MW2,ZAP,QQQ2 + REAL EP,EP2,RR,MHP2 + REAL ATI,ABI,ATR,ABR,AT2,AB2 + REAL TLRM,BLRM,TLRP,BLRP + REAL MST1SQ,MST2SQ,MSB1SQ,MSB2SQ + + REAL RTT,TTT1,TEMPT,TM1BT + REAL TEMPS,T1RD,T2RD,T1RPD,T2RPD + REAL CT1,A1,A2,T1RR,T2RR + REAL CT5,A5,A6,T1RPRP,T2RPRP + REAL A9,T1RRP,T2RRP + REAL TEMPSQ,DT1,DT2,VRRT,VRPRPT,VRRPT + REAL ALPHAT,LAT +C + REAL RBB,BBB1,TEMPB,TM1BB + REAL B1RD,B2RD,B1RPD,B2RPD + REAL CB3,A3,A4,B1RR,B2RR + REAL CB7,A7,A8,B1RPRP,B2RPRP + REAL A10,B1RRP,B2RRP + REAL DB1,DB2,VRRB,VRPRPB,VRRPB + REAL ALPHAB,LAB +C + REAL DVRR,DVRPRP,DVRRP,TEMPH + REAL MHL2,MHH2,TRACEM,TPAL,TANAH + REAL ASMB,MBMB,MBQ,ASMT,MTMT,MTQ,SUALFS,HIGFRZ + DOUBLE PRECISION SSMQCD + INTEGER INRAD,MHLNEG +C + MHLNEG=0 + PI=4.*ATAN(1.) + PI2 = PI**2 + SR2=SQRT(2.) + G2=4.*PI*ALFAEM/SN2THW + GP2=G2*SN2THW/(1.-SN2THW) + HIGFRZ=SQRT(AMTLSS*AMTRSS) + ASMB=SUALFS(AMBT**2,.36,AMTP,3) + MBMB=AMBT*(1.-4*ASMB/3./PI) + MBQ=SSMQCD(DBLE(MBMB),DBLE(HIGFRZ)) + ASMT=SUALFS(AMTP**2,.36,AMTP,3) + MTMT=AMTP/(1.+4*ASMT/3./PI+(16.11-1.04*(5.-6.63/AMTP))* + $(ASMT/PI)**2) + MTQ=SSMQCD(DBLE(MTMT),DBLE(HIGFRZ)) + MT2=MTQ**2 + MB2=MBQ**2 + MW2=AMW**2 + EP=TWOM1 + EP2=EP**2 + RR=RV2V1 + MHP2=AMHA**2 + TANB=1.0/RR + COTB=RR + BE=ATAN(1./RV2V1) + SINB=SIN(BE) + COSB=COS(BE) + SINB2=SINB**2 + COSB2=COSB**2 + SIN2B=SIN(2.*BE) + COS2B=COS(2.*BE) + V2=2.0*MW2*SINB2/G2 + VP2=2.0*MW2*COSB2/G2 + V=SQRT(V2) + VP=SQRT(VP2) + VVP=SQRT(V2*VP2) + VPVM=VP2-V2 + GGP=G2+GP2 + GG1=G2-5.0*GP2/3.0 + GG2=G2-GP2/3.0 + VVPP=2.0*AMZ**2/GGP + FT2=MT2/V2 + FB2=MB2/VP2 +C + TLRM=AMTLSS**2-AMTRSS**2 + BLRM=AMBLSS**2-AMBRSS**2 + TLRP=AMTLSS**2+AMTRSS**2 + BLRP=AMBLSS**2+AMBRSS**2 +C +C Higgs mass matrix +C +C (AAT and AAB are also assumed to be real) +C + ATR=AAT + ABR=AAB + ATI=0.0 + ABI=0.0 + AT2=ATR**2+ATI**2 + AB2=ABR**2+ABI**2 +C + MST1SQ=AMT1SS**2 + MST2SQ=AMT2SS**2 + MSB1SQ=AMB1SS**2 + MSB2SQ=AMB2SS**2 + INRAD=1 + QQQ2=HIGFRZ**2 +C + ZAP = 1.0 +C +C STOP TERMS +C + RTT=(TLRM+VPVM*ZAP*GG1/4.0)**2 + $ +4.0*MT2*(EP*COTB+ATR)**2+4.0*MT2*ATI**2 + RTT=SQRT(RTT) +C +C calculate 2M1*B term +C + TTT1=0.5*TLRP+MT2+VPVM*ZAP*GGP/8.0 + IF(RTT.NE.0.0) THEN + TEMPT=4.0*EP*FT2*VVP*ATI**2/(RTT**2) + TM1BT=-2.0*FT2*(TEMPT+ATR)*TTT1 + $ *LOG(MST2SQ/MST1SQ)/RTT + TM1BT=TM1BT-FT2*ATR + $ *LOG(MST1SQ*MST2SQ/QQQ2/QQQ2) + TM1BT=TM1BT+FT2*(2.0*TEMPT-ATR) + TM1BT=3.0*EP*TM1BT/32.0/PI2 +C +C calculate first derivatives w.r.t H_R +C divided by sqrt(2) * v +C + TEMPS=-ZAP*GG1*(TLRM+ZAP*GG1*VPVM/4.0)/2.0 + TEMPS=TEMPS+4.0*FT2*(AT2+EP*COTB*ATR) + TEMPS=TEMPS/RTT/4.0 + T1RD=FT2-ZAP*GGP/8.0-TEMPS + T2RD=FT2-ZAP*GGP/8.0+TEMPS +C +C calculate first derivatives w.r.t H_R' +C divided by sqrt(2) * v' +C + TEMPS=ZAP*GG1*(TLRM+ZAP*GG1*VPVM/4.0)/2.0 + TEMPS=TEMPS+4.0*FT2*EP*(EP+TANB*ATR) + TEMPS=TEMPS/RTT/4.0 + T1RPD=ZAP*GGP/8.0-TEMPS + T2RPD=ZAP*GGP/8.0+TEMPS +C +C calculate second derivatives w.r.t. H_R +C + CT1=-V*ZAP*GG1*(TLRM+ZAP*GG1*VPVM/4.0)/SR2 + CT1=CT1+4.0*SR2*FT2*V*(EP*COTB*ATR+AT2) + A1=-CT1**2/(RTT**3)/8.0 + A2=-ZAP*GG1*(TLRM+ZAP*GG1*VPVM/4.0)/2.0 + A2=A2+V2*ZAP*GG1**2/4.0+4.0*FT2*AT2 + A2=A2/RTT/4.0 + T1RR=FT2-ZAP*GGP/8.0-A1-A2 + T2RR=FT2-ZAP*GGP/8.0+A1+A2 +C +C calculate second derivatives w.r.t. H_R' +C + CT5=VP*ZAP*GG1*(TLRM+ZAP*GG1*VPVM/4.0)/SR2 + CT5=CT5+4.0*SR2*FT2*VP*EP*(EP+TANB*ATR) + A5=-CT5**2/(RTT**3)/8.0 + A6=ZAP*GG1*(TLRM+ZAP*GG1*VPVM/4.0)/2.0 + A6=A6+VP2*ZAP*GG1**2/4.0+4.0*FT2*EP2 + A6=A6/RTT/4.0 + T1RPRP=ZAP*GGP/8.0-A5-A6 + T2RPRP=ZAP*GGP/8.0+A5+A6 +C +C calculate second derivatives w.r.t. H_R and H_R' +C + A9=-VVP*ZAP*(GG1**2)/4.0+4.0*FT2*EP*ATR + A9=A9/RTT/4.0 + T1RRP=CT1*CT5/(RTT**3)/8.0-A9 + T2RRP=-CT1*CT5/(RTT**3)/8.0+A9 +C +C calculate D^2 V / D^2 H_R +C + TEMPSQ=MST1SQ*(T1RR-T1RD) + DT1=2.0*(2.0*V2*T1RD**2+TEMPSQ)*LOG(MST1SQ/QQQ2) + DT1=DT1+6.0*V2*T1RD**2+TEMPSQ + TEMPSQ=MST2SQ*(T2RR-T2RD) + DT2=2.0*(2.0*V2*T2RD**2+TEMPSQ)*LOG(MST2SQ/QQQ2) + DT2=DT2+6.0*V2*T2RD**2+TEMPSQ + VRRT=DT1+DT2-8.0*FT2*MT2*LOG(MT2/QQQ2)-12.0*FT2*MT2 + VRRT=-TM1BT*COTB+3.0*VRRT/32.0/PI2 +C +C calculate D^2 V / D^2 H'_R +C + TEMPSQ=MST1SQ*(T1RPRP-T1RPD) + DT1=2.0*(2.0*VP2*T1RPD**2+TEMPSQ)*LOG(MST1SQ/QQQ2) + DT1=DT1+6.0*VP2*T1RPD**2+TEMPSQ + TEMPSQ=MST2SQ*(T2RPRP-T2RPD) + DT2=2.0*(2.0*VP2*T2RPD**2+TEMPSQ)*LOG(MST2SQ/QQQ2) + DT2=DT2+6.0*VP2*T2RPD**2+TEMPSQ + VRPRPT=-TM1BT*TANB+3.0*(DT1+DT2)/32.0/PI2 +C +C calculate D^2 V / D^H_R D^H_R' +C + DT1=2.0*VVP*T1RD*T1RPD+MST1SQ*T1RRP + DT1=2.0*DT1*LOG(MST1SQ/QQQ2) + DT1=DT1+6.0*VVP*T1RD*T1RPD+MST1SQ*T1RRP + DT2=2.0*VVP*T2RD*T2RPD+MST2SQ*T2RRP + DT2=2.0*DT2*LOG(MST2SQ/QQQ2) + DT2=DT2+6.0*VVP*T2RD*T2RPD+MST2SQ*T2RRP + VRRPT=TM1BT+3.0*(DT1+DT2)/32.0/PI2 +C + ELSE IF(RTT.EQ.0.0) THEN +C + ALPHAT=TLRP/2.0+MT2+ZAP*GGP*VPVM/8.0 + LAT=2.0*LOG(ALPHAT/QQQ2)+3.0 +C +C calculate D^2 V / D^2 H_R +C + VRRT=V2*(GGP**2+GG1**2)/16.0-MT2*GGP + VRRT=ZAP*VRRT*LAT+8.0*FT2*MT2*LOG(ALPHAT/MT2) + VRRT=3.0*VRRT/32.0/PI2 +C +C calculate D^2 V / D^2 H_R' +C + VRPRPT=ZAP*VP2*(GGP**2+GG1**2)/16.0 + VRPRPT=3.0*(VRPRPT*LAT)/32.0/PI2 +C +C calculate D^2 V / D^H_R D^H_R' +C + VRRPT=FT2*GGP-(GGP**2+GG1**2)/8.0 + VRRPT=ZAP*VVP*VRRPT*LAT/2.0 + VRRPT=3.0*VRRPT/32.0/PI2 +C +C + ENDIF +C +C SBOTTOM TERMS +C + RBB=(BLRM-VPVM*ZAP*GG2/4.0)**2 + $ +4.0*MB2*(EP*TANB+ABR)**2+4.0*MB2*ABI**2 + RBB=SQRT(RBB) +C IF(RBB.EQ.0.0.AND.ABI.NE.0.0) THEN +C WRITE(6,*) 'RBB=0, ABI NOT 0' +C WRITE(6,*) 'ERROR: THIS CASE NOT COVERED YET' +C GO TO 1000 +C ENDIF +C + IF(RBB.NE.0.0) THEN +C +C calculate 2M1*B term +C + BBB1=0.5*BLRP+MB2-VPVM*ZAP*GGP/8.0 + TEMPB=4.0*EP*FB2*VVP*ABI**2/(RBB**2) + TM1BB=-2.0*FB2*(TEMPB+ABR)*BBB1 + $ *LOG(MSB2SQ/MSB1SQ)/RBB + TM1BB=TM1BB-FB2*ABR + $ *LOG(MSB1SQ*MSB2SQ/QQQ2/QQQ2) + TM1BB=TM1BB+FB2*(2.0*TEMPB-ABR) + TM1BB=3.0*EP*TM1BB/32.0/PI2 +C +C calculate first derivatives w.r.t H_R +C divided by sqrt(2) * v +C + TEMPS=ZAP*GG2*(BLRM-ZAP*GG2*VPVM/4.0)/2.0 + TEMPS=TEMPS+4.0*FB2*EP*(EP+COTB*ABR) + TEMPS=TEMPS/RBB/4.0 + B1RD=ZAP*GGP/8.0-TEMPS + B2RD=ZAP*GGP/8.0+TEMPS + +C calculate first derivatives w.r.t H_R' +C divided by sqrt(2) * v' +C + TEMPS=-ZAP*GG2*(BLRM-ZAP*GG2*VPVM/4.0)/2.0 + TEMPS=TEMPS+4.0*FB2*(AB2+EP*TANB*ABR) + TEMPS=TEMPS/RBB/4.0 + B1RPD=FB2-ZAP*GGP/8.0-TEMPS + B2RPD=FB2-ZAP*GGP/8.0+TEMPS +C +C calculate second derivatives w.r.t. H_R +C + CB3=V*ZAP*GG2*(BLRM-ZAP*GG2*VPVM/4.0)/SR2 + CB3=CB3+4.0*SR2*FB2*V*EP*(EP+COTB*ABR) + A3=-CB3**2/(RBB**3)/8.0 + A4=ZAP*GG2*(BLRM-ZAP*GG2*VPVM/4.0)/2.0 + A4=A4+V2*ZAP*GG2**2/4.0+4.0*FB2*EP2 + A4=A4/RBB/4.0 + B1RR=ZAP*GGP/8.0-A3-A4 + B2RR=ZAP*GGP/8.0+A3+A4 +C +C calculate second derivatives w.r.t. H_R' +C + CB7=-VP*ZAP*GG2*(BLRM-ZAP*GG2*VPVM/4.0)/SR2 + CB7=CB7+4.0*SR2*FB2*VP*(AB2+EP*TANB*ABR) + A7=-CB7**2/(RBB**3)/8.0 + A8=-ZAP*GG2*(BLRM-ZAP*GG2*VPVM/4.0)/2.0 + A8=A8+VP2*ZAP*GG2**2/4.0+4.0*FB2*AB2 + A8=A8/RBB/4.0 + B1RPRP=FB2-ZAP*GGP/8.0-A7-A8 + B2RPRP=FB2-ZAP*GGP/8.0+A7+A8 +C +C calculate second derivatives w.r.t. H_R and H_R' +C + A10=-VVP*ZAP*(GG2**2)/4.0+4.0*FB2*EP*ABR + A10=A10/RBB/4.0 + B1RRP=CB3*CB7/(RBB**3)/8.0-A10 + B2RRP=-CB3*CB7/(RBB**3)/8.0+A10 +C +C calculate D^2 V / D^2 H_R +C + TEMPSQ=MSB1SQ*(B1RR-B1RD) + DB1=2.0*(2.0*V2*B1RD**2+TEMPSQ)*LOG(MSB1SQ/QQQ2) + DB1=DB1+6.0*V2*B1RD**2+TEMPSQ + TEMPSQ=MSB2SQ*(B2RR-B2RD) + DB2=2.0*(2.0*V2*B2RD**2+TEMPSQ)*LOG(MSB2SQ/QQQ2) + DB2=DB2+6.0*V2*B2RD**2+TEMPSQ + VRRB=-TM1BB*COTB+3.0*(DB1+DB2)/32.0/PI2 +C +C calculate D^2 V / D^2 H'_R +C + TEMPSQ=MSB1SQ*(B1RPRP-B1RPD) + DB1=2.0*(2.0*VP2*B1RPD**2+TEMPSQ)*LOG(MSB1SQ/QQQ2) + DB1=DB1+6.0*VP2*B1RPD**2+TEMPSQ + TEMPSQ=MSB2SQ*(B2RPRP-B2RPD) + DB2=2.0*(2.0*VP2*B2RPD**2+TEMPSQ)*LOG(MSB2SQ/QQQ2) + DB2=DB2+6.0*VP2*B2RPD**2+TEMPSQ + VRPRPB=DB1+DB2 + VRPRPB=DB1+DB2-8.0*FB2*MB2*LOG(MB2/QQQ2)-12.0*FB2*MB2 + VRPRPB=-TM1BB*TANB+3.0*VRPRPB/32.0/PI2 +C +C calculate D^2 V / D H_R D H'_R +C + DB1=2.0*VVP*B1RD*B1RPD+MSB1SQ*B1RRP + DB1=2.0*DB1*LOG(MSB1SQ/QQQ2) + DB1=DB1+6.0*VVP*B1RD*B1RPD+MSB1SQ*B1RRP + DB2=2.0*VVP*B2RD*B2RPD+MSB2SQ*B2RRP + DB2=2.0*DB2*LOG(MSB2SQ/QQQ2) + DB2=DB2+6.0*VVP*B2RD*B2RPD+MSB2SQ*B2RRP + VRRPB=TM1BB+3.0*(DB1+DB2)/32.0/PI2 + + ELSE IF(RBB.EQ.0.0) THEN +C + ALPHAB=BLRP/2.0+MB2-ZAP*GGP*VPVM/8.0 + LAB=2.0*LOG(ALPHAB/QQQ2)+3.0 +C +C calculate D^2 V / D^2 H_R +C + VRRB=ZAP*V2*(GGP**2 + GG2**2)/16.0 + VRRB=3.0*(VRRB*LAB)/32.0/PI2 +C +C calculate D^2 V / D^2 H_R' +C + VRPRPB=VP2*(GGP**2+GG2**2)/16.0-MB2*GGP + VRPRPB=ZAP*VRPRPB*LAB+8.0*FB2*MB2*LOG(ALPHAB/MB2) + VRPRPB=3.0*VRPRPB/32.0/PI2 +C +C calculate D^2 V / D^H_R D^H_R' +C + VRRPB=FB2*GGP-(GGP**2+GG2**2)/8.0 + VRRPB=ZAP*VVP*VRRPB*LAB/2.0 + VRRPB=3.0*VRRPB/32.0/PI2 +C + ENDIF +C + DVRR=VRRT+VRRB+VP2*MHP2/VVPP + V2*GGP/2.0 + DVRPRP=VRPRPT+VRPRPB+V2*MHP2/VVPP + VP2*GGP/2.0 + DVRRP=VRRPT+VRRPB-VVP*MHP2/VVPP - VVP*GGP/2.0 +C TEMPH is always non-negative: + TEMPH=(DVRR-DVRPRP)**2+4*DVRRP**2 + TEMPH=0.5*SQRT(TEMPH) + MHL2=0.5*(DVRR+DVRPRP)-TEMPH + MHH2=0.5*(DVRR+DVRPRP)+TEMPH + IF(MHL2.LT.0.0) THEN + MHLNEG=1 +C WRITE(LOUT,*) 'SSMHN: ERROR: MHL**2 < 0.0 FOR PARAMETERS:' +C WRITE(LOUT,*) 'MHP =', AMHA, 'TANB =', 1.0/RR +C WRITE(LOUT,*) 'MSTL=', AMTLSS, 'MSBL=', AMBLSS +C WRITE(LOUT,*) 'MSTR=', AMTRSS, 'MSBR=', AMBRSS +C WRITE(LOUT,*) 'AT=', AAT, 'AB=', AAB +C WRITE(LOUT,*) 'MU=-2M1=', -EP +C WRITE(LOUT,*) 'MT=', AMTP, 'MB=', AMBT +C WRITE(LOUT,*) 'D-TERMS? 1=YES 2=NO :', INRAD +C WRITE(LOUT,*) 'MASS SCALE (QQQ)=', SQRT(QQQ2) + AMHH=SQRT(MHH2) + AMHL=SQRT(ABS(MHL2)) + GO TO 1000 + ENDIF + AMHL=SQRT(MHL2) + AMHH=SQRT(MHH2) + +C +C Now calculate mixing angle ALFAH +C + TRACEM=DVRR-DVRPRP + TPAL=TRACEM**2 + 4.0*DVRRP**2 + TANAH=TRACEM+SQRT(TPAL) + IF(DVRRP.EQ.0.0) THEN + WRITE(LOUT,*) 'SSMHN: OFF-DIAGONAL TERM OF SCALAR HIGGS', + $ ' MASS MATRIX IS ZERO ' + IF(TANAH.NE.0.0) THEN + WRITE(LOUT,*) 'SSMHN: WARNING: TAN(ALFAH) FORMULA', + $ ' YIELDS INFINITY' + ELSE IF(TANAH.EQ.0.0) THEN + WRITE(LOUT,*) 'SSMHN: WARNING: TAN(ALFAH) FORMULA', + $ ' YIELDS 0/0 ' + ENDIF + IF(DVRR.GT.DVRPRP) THEN + WRITE(LOUT,*) 'SSMHN: DVRR > DVRPRP ==> SET ALFAH=PI/2' + ALFAH = PI/2.0 + ELSE IF (DVRR .LT. DVRPRP) THEN + WRITE(LOUT,*) 'SSMHN: DVRR < DVRPRP ==> SET ALFAH=0' + ALFAH = 0.0 + ELSE IF (DVRR .EQ. DVRPRP) THEN + WRITE(LOUT,*) 'SSMHN: DVRR = DVRPRP ==> ALFAH INDETERMINANT' + WRITE(LOUT,*) 'SETTING SCALAR MIXING ANGLE ALPHA=PI/4' + ALFAH=PI/4.0 + ENDIF + GO TO 1000 + ENDIF + TANAH = -0.5*TANAH/DVRRP + ALFAH = ATAN(TANAH) +C +1000 RETURN + END diff --git a/ISAJET/isasusy/ssmqcd.F b/ISAJET/isasusy/ssmqcd.F new file mode 100644 index 00000000000..3f7fcc6b1e5 --- /dev/null +++ b/ISAJET/isasusy/ssmqcd.F @@ -0,0 +1,65 @@ +#include "isajet/pilot.h" + DOUBLE PRECISION FUNCTION SSMQCD(DM,DQ) +C----------------------------------------------------------------------- +C Calculate leading-log running mass for quark with mass DM at +C scale Q, using alpha_s which is continuous across thresholds. +C See Drees and Hikasa, Phys. Lett. B240: 455-464, Eq. 4.5. +C +C Note the threshold is at Q = 2 m, not at Q = m as in MSbar. +C +C Bisset's QCDRAD, WDHFFC +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +C + DOUBLE PRECISION DM,DQ,DLAM4,DLAM5,DLAM6,DNEFF,POW,RENORM + $,DQBT,DQTP +C +C Do nothing for light quarks +C + IF(DM.LT.1.0) THEN + SSMQCD=DM + RETURN + ENDIF +C +C Calculate running mass +C + DLAM4=DBLE(ALQCD4) + DQBT=2*DBLE(AMBT) + DQTP=2*DBLE(AMTP) + SSMQCD=0 +C Q < 2 m(b) + DNEFF=4 + POW=12.D0/(33.D0-2.*DNEFF) + IF(DQ.LT.DQBT) THEN + RENORM=(LOG(2*DM/DLAM4)/LOG(DQ/DLAM4))**POW + SSMQCD=RENORM*DM + RETURN + ELSE + RENORM=(LOG(2*DM/DLAM4)/LOG(DQBT/DLAM4))**POW + ENDIF +C 2 m(b) < Q < 2 m(t) + DNEFF=5 + POW=12.D0/(33.D0-2.*DNEFF) + DLAM5=DEXP((25.D0*LOG(DLAM4)-LOG(DQBT**2))/23.D0) + IF(DQ.GE.DQBT.AND.DQ.LT.DQTP) THEN + RENORM=RENORM + $ *(LOG(DQBT/DLAM5)/LOG(DQ/DLAM5))**POW + SSMQCD=RENORM*DM + RETURN + ELSE + RENORM=RENORM + $ *(LOG(DQBT/DLAM5)/LOG(DQTP/DLAM5))**POW + ENDIF +C 2 m(t) < Q + DNEFF=6 + POW=12.D0/(33.D0-2.*DNEFF) + DLAM6=DEXP((25.D0*LOG(DLAM4)-LOG(DQBT**2) + $-LOG(4*AMTP**2))/21.D0) + RENORM=RENORM + $*(LOG(DQTP/DLAM6)/LOG(DQ/DLAM6))**POW + SSMQCD=RENORM*DM + RETURN + END diff --git a/ISAJET/isasusy/ssmssm.F b/ISAJET/isasusy/ssmssm.F new file mode 100644 index 00000000000..f7438f646d2 --- /dev/null +++ b/ISAJET/isasusy/ssmssm.F @@ -0,0 +1,173 @@ +#include "isajet/pilot.h" + SUBROUTINE SSMSSM(XMG,XMU,XMHA,XTANB,XMQ1,XMDR,XMUR, + $XML1,XMER,XMQ2,XMSR,XMCR,XML2,XMMR,XMQ3,XMBR,XMTR, + $XML3,XMLR,XAT,XAB,XAL,XM1,XM2,XMT,IALLOW,IMODEL) +C----------------------------------------------------------------------- +C +C Calculate MSSM masses and decays using parameters: +C XM1 = U(1) mass +C > 1e19: use scaling from XMG +C XM2 = SU(2) mass +C > 1e19: use scaling from XMG +C XMG = gluino mass +C XMQ1,... = 1st gen. su(2) soft squark mass,... +C XMTL = m(stop-left) +C XMTR = m(stop-right) +C XMBR = m(sbot-right) +C XML1 = left selectron mass +C XMER = right selectron mass +C XMN1 = 1st ge. sneutrino mass +C XTANB = v/v' = ratio of vev's +C XMU = -2*m_1 = SUSY Higgs mass +C XMHA = m(pseudo-scalar-Higgs) +C XMT = m(top) +C XAT = stop trilinear coupling +C XAB = sbottom trilinear coupling +C XAL = stau trilinear coupling +C IALLOW = 0 for valid point, 1 otherwise +C IMODEL = 1 for SUGRA or MSSM, 2 for GMSB +C +C Program outline: +C SSMSSM: Initialize standard model parameters in /SSSM/ and +C SUSY parameters in /SSPAR/. +C SSMASS: Calculate dependent SUSY masses and mixings. +C SSTPBF: Calculate top decays; save in /SSMODE/. +C SSSTBF: Calculate stop decays; save in /SSMODE/. +C SSGLBF: Calcualte gluino decays; save in /SSMODE/. +C SSQKBF: Calculate squark decays; save in /SSMODE/. +C SSWZBF: Calculate gaugino decays; save in /SSMODE/. +C SSHIBF: Calculate Higgs decays; save in /SSMODE/. +C +C Notes: +C 1) All particle ID codes are defined with symbolic names in +C /SSTYPE/, making it easy to change them. +C +C 2) /SSMODE/ contains the parent, the daughters, the width, and +C the branching ratio for each mode. Decay modes for a given parent +C need not be adjacent, so they must be sorted at the end. +C +C 3) Some of Baer's original routines used single precision and others +C double precision. To accomodate this, the variable names used in +C /SSSM/ and /SSPAR/ have all been changed to longer, more +C descriptive ones. +C +C 4) All routines have been strongly typed. +C +C Source: H. Baer, et al. +C Modified: F. Paige, Aug. 1992 +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sslun.inc" +#include "isajet/ssmode.inc" +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/dkyss3.inc" +C + REAL XR21,PI,SR2 + REAL XMG,XMU,XMHA,XTANB,XMQ1,XMDR,XMUR,XML1,XMER,XMQ2,XMSR, + $XMCR,XML2,XMMR,XMQ3,XMBR,XMTR,XML3,XMLR,XAT,XAB,XAL,XM1,XM2, + $XMT,MU1,MU2,BETA,COS2B + INTEGER IALLOW,MHLNEG,MHCNEG,IMODEL +C + NSSMOD=0 +C +C Standard model and SUSY parameters +C + IALLOW=0 + XR21=1./XTANB + PI=4.*ATAN(1.) + SR2=SQRT(2.) + AMDN=0.0099 + AMUP=0.0056 + AMST=0.199 + AMCH=1.35 + AMBT=5.0 + AMTP=XMT + AME=0.511E-3 + AMMU=0.105 + AMTAU=1.777 + AMW=80.0 + AMZ=91.17 + GAMW=2.12 + GAMZ=2.487 + ALFAEM=1./128. + SN2THW=0.232 + ALFA2=ALFAEM/SN2THW + BETA=ATAN(XTANB) + COS2B=COS(2*BETA) +C +C SU(2) and U(1) gaugino masses are reset in SSMASS if +C they are > 1e19. +C + MU2=XM2 + MU1=XM1 +C Set 2nd gen soft terms equal to 1st gen. soft terms +c unless previously set by user. + IF (XMQ2.GE.1.E19) THEN + XMQ2=XMQ1 + XMSR=XMDR + XMCR=XMUR + XML2=XML1 + XMMR=XMER + END IF +C +C The results can be quite sensitive to the choice of the +C 4-flavor QCD scale ALQCD4 and the expression for the QCD +C coupling ALFA3. Select among the following lines: +C + ALQCD4=0.177 + ALFA3=0.12 +C +C Calculate simple masses; other masses via SSMASS + AMGLSS=XMG + AMULSS=SQRT(XMQ1**2+AMUP**2+(.5-2.*SN2THW/3.)*AMZ**2*COS2B) + AMURSS=SQRT(XMUR**2+AMUP**2+2./3.*SN2THW*AMZ**2*COS2B) + AMDLSS=SQRT(XMQ1**2+AMDN**2+(-.5+SN2THW/3.)*AMZ**2*COS2B) + AMDRSS=SQRT(XMDR**2+AMDN**2-1./3.*SN2THW*AMZ**2*COS2B) + AMCLSS=SQRT(XMQ2**2+AMCH**2+(.5-2.*SN2THW/3.)*AMZ**2*COS2B) + AMCRSS=SQRT(XMCR**2+AMCH**2+2./3.*SN2THW*AMZ**2*COS2B) + AMSLSS=SQRT(XMQ2**2+AMST**2+(-.5+SN2THW/3.)*AMZ**2*COS2B) + AMSRSS=SQRT(XMSR**2+AMST**2-1./3.*SN2THW*AMZ**2*COS2B) + AMELSS=SQRT(XML1**2+AME**2-(.5-SN2THW)*AMZ**2*COS2B) + AMERSS=SQRT(XMER**2+AME**2-SN2THW*AMZ**2*COS2B) + AMMLSS=SQRT(XML2**2+AMMU**2-(.5-SN2THW)*AMZ**2*COS2B) + AMMRSS=SQRT(XMMR**2+AMMU**2-SN2THW*AMZ**2*COS2B) + AMN1SS=SQRT(XML1**2+.5*AMZ**2*COS2B) + AMN2SS=SQRT(XML2**2+.5*AMZ**2*COS2B) + AMN3SS=SQRT(XML3**2+.5*AMZ**2*COS2B) + AMTLSS=XMQ3 + AMTRSS=XMTR + AMBLSS=XMQ3 + AMBRSS=XMBR + AMLLSS=XML3 + AMLRSS=XMLR + AMHA=XMHA + AAT=XAT + AAB=XAB + AAL=XAL + TWOM1=-XMU + RV2V1=XR21 +C +C Calculate mass eigenstates and check Z1SS = LSP +C + CALL SSMASS(MU1,MU2,IALLOW,1,MHLNEG,MHCNEG,IMODEL) + IF (MHLNEG.EQ.1.OR.MHCNEG.EQ.1) IALLOW=10 +C IF(IALLOW.NE.0) RETURN +C +C Initialize counters for matrix elements +C Calculate decay widths and branching rations +C + NMSS3=0 + NPSS3=0 + CALL SSTPBF + CALL SSGLBF + CALL SSQKBF + CALL SSSTBF + CALL SSLPBF + CALL SSWZBF + CALL SSHIBF +C + RETURN + END diff --git a/ISAJET/isasusy/ssn1st.F b/ISAJET/isasusy/ssn1st.F new file mode 100644 index 00000000000..325224e7868 --- /dev/null +++ b/ISAJET/isasusy/ssn1st.F @@ -0,0 +1,23 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSN1ST(SS) +C----------------------------------------------------------------------- +C SSN1ST: l_1 -> stau_1+nu_l+nutaubar: TATA G FUNCTION +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" + REAL SS + DOUBLE PRECISION S,M1,M2,MST1,MN1,WID + S=SS + M1=TMP(1) + M2=TMP(2) + MST1=TMP(3) + MN1=TMP(4) + WID=(S-MST1**2)**2/(S-M1**2)/(S-M2**2)*(S-MN1**2)**2 + $ /S**2/MN1**2 + SSN1ST=WID + RETURN + END diff --git a/ISAJET/isasusy/ssnorm.F b/ISAJET/isasusy/ssnorm.F new file mode 100644 index 00000000000..5c0f5d51b45 --- /dev/null +++ b/ISAJET/isasusy/ssnorm.F @@ -0,0 +1,24 @@ +#include "isajet/pilot.h" + SUBROUTINE SSNORM(ID) +C----------------------------------------------------------------------- +C Normalize branching ratios for ID +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sslun.inc" +#include "isajet/ssmode.inc" +C + INTEGER ID,I + REAL GAMSUM +C + GAMSUM=0 + DO 100 I=1,NSSMOD + IF(ISSMOD(I).EQ.ID) GAMSUM=GAMSUM+GSSMOD(I) +100 CONTINUE + IF(GAMSUM.EQ.0) RETURN + DO 200 I=1,NSSMOD + IF(ISSMOD(I).EQ.ID) BSSMOD(I)=GSSMOD(I)/GAMSUM +200 CONTINUE + RETURN + END diff --git a/ISAJET/isasusy/sspole.F b/ISAJET/isasusy/sspole.F new file mode 100644 index 00000000000..0c817969037 --- /dev/null +++ b/ISAJET/isasusy/sspole.F @@ -0,0 +1,35 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSPOLE(MGMS,MUSQ,AS) +C********************************************************************* +C* Computes the on-shell (pole) gluino mass for given running (MSbar)* +C* gluino mass, defined at scale MUSQ, and given alpha_s (AS). The * +C* squark masses are stored in the SQUARK COMMON block. * +C* This function needs the complex functions B0 and B1. * +C* Contributed by M. Drees; modified by H. Baer * +C * +C Version 7.30: Cast COMPLEX*16 to REAL*8 in standard way. :-( * +C********************************************************************* +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" +#include "isajet/ssinf.inc" + REAL MGMS,MUSQ,AS,MGSQ,FAC + DOUBLE PRECISIONDMUSQ,DFAC + COMPLEX*16 SSB1 + DMUSQ=MUSQ + XLAM = LOG(DMUSQ) + MGSQ = MGMS*MGMS +C +C Cast COMPLEX*16 to REAL*8: +C + DFAC = -8*SSB1(MGSQ,0.,AMULSS) - (SSB1(MGSQ,AMTP,AMT1SS)+ + $SSB1(MGSQ,AMTP,AMT2SS)+SSB1(MGSQ,4.0,AMB1SS)+ + $SSB1(MGSQ,4.0,AMB2SS)) + DFAC = DFAC + 12.D0 + 9.D0*LOG(DMUSQ/MGSQ) + FAC=DFAC + SSPOLE = MGMS*(1.0 + .0796*AS*FAC ) + RETURN + END diff --git a/ISAJET/isasusy/ssqkbf.F b/ISAJET/isasusy/ssqkbf.F new file mode 100644 index 00000000000..8f3fffc4815 --- /dev/null +++ b/ISAJET/isasusy/ssqkbf.F @@ -0,0 +1,412 @@ +#include "isajet/pilot.h" + SUBROUTINE SSQKBF +C----------------------------------------------------------------------- +C +C This program gives squark branching fractions to gauginos +C according to Baer,Barger,Karatas,Tata (Phys.Rev.D36,96(1987) +C Updated for b_1,b_2 and non-degenerate sq masses 8/13/96 +C Baer's SQUBF +C +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sslun.inc" +#include "isajet/ssmode.inc" +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstype.inc" +C + COMPLEX ZI,ZONE,ZA,ZB,ZAUIZ,ZADIZ,ZBUIZ,ZBDIZ + DOUBLE PRECISION SSALFS,SSMQCD + REAL SSXLAM,WID,AUIZS,ADIZS,BUIZS,BDIZS + REAL PI,SR2,G,GP,COSA,SINA,SNZI,THIZ + $,TANB,COTB,XM,YM,THX,THY,FT,FB + REAL MZIZ,CS2THW,TN2THW,BETA,BH,A,AS + REAL ASMB,MBMB,MBQ,ASMT,MTMT,MTQ,SUALFS + INTEGER IZ + REAL MW1,MW2,SNW1,SNW2,COST,SINT,COSB,SINB + REAL AWD(2),AWU(2),BW(2),BWP(2) + INTEGER ISZIZ(4) + DATA ZI/(0.,1.)/,ZONE/(1.,0.)/ +C +C Partly duplicated from SSMASS +C + PI=4.*ATAN(1.) + SR2=SQRT(2.) + G=SQRT(4*PI*ALFAEM/SN2THW) + GP=G*SQRT(SN2THW/(1.-SN2THW)) + CS2THW=1.-SN2THW + TN2THW=SN2THW/CS2THW + TANB=1./RV2V1 + COTB=RV2V1 + BETA=ATAN(TANB) +C Reconstruct masses from SSMASS + MW1=ABS(AMW1SS) + MW2=ABS(AMW2SS) + COST=COS(THETAT) + SINT=SIN(THETAT) + COSB=COS(THETAB) + SINB=SIN(THETAB) + COSA=COS(ALFAH) + SINA=SIN(ALFAH) + SNW1=SIGN(1.,AMW1SS) + SNW2=SIGN(1.,AMW2SS) + XM=1./TAN(GAMMAL) + YM=1./TAN(GAMMAR) + THX=SIGN(1.,XM) + THY=SIGN(1.,YM) + ASMB=SUALFS(AMBT**2,.36,AMTP,3) + MBMB=AMBT*(1.-4*ASMB/3./PI) + MBQ=SSMQCD(DBLE(MBMB),DBLE(AMULSS)) + ASMT=SUALFS(AMTP**2,.36,AMTP,3) + MTMT=AMTP/(1.+4*ASMT/3./PI+(16.11-1.04*(5.-6.63/AMTP))* + $(ASMT/PI)**2) + MTQ=SSMQCD(DBLE(MTMT),DBLE(AMULSS)) + FB=G*MBQ/SR2/AMW/COS(BETA) + FT=G*MTQ/SR2/AMW/SIN(BETA) + AWD(1)=-G*SNW1*SIN(GAMMAR) + AWD(2)=-G*SNW2*THY*COS(GAMMAR) + AWU(1)=-G*SIN(GAMMAL) + AWU(2)=-G*THX*COS(GAMMAL) + BW(1)=-FT*SNW1*COS(GAMMAR) + BW(2)=FT*SNW2*THY*SIN(GAMMAR) + BWP(1)=-FB*COS(GAMMAL) + BWP(2)=FB*THX*SIN(GAMMAL) +C +C Compute squark branching fractions to zi +C + ISZIZ(1)=ISZ1 + ISZIZ(2)=ISZ2 + ISZIZ(3)=ISZ3 + ISZIZ(4)=ISZ4 + DO 100 IZ=1,4 + MZIZ=ABS(AMZISS(IZ)) + SNZI=SIGN(1.,AMZISS(IZ)) + IF (SNZI.EQ.1.) THEN + THIZ=0. + ELSE + THIZ=1. + END IF + ZAUIZ=ZI**(THIZ-1.)*(-1)*SNZI + $ *(G/SR2*ZMIXSS(3,IZ)+GP/3./SR2*ZMIXSS(4,IZ)) + ZBUIZ=ZI**(THIZ-1.)*4*GP*ZMIXSS(4,IZ)/3./SR2 + ZADIZ=ZI**(THIZ-1.)*(-1)*SNZI + $ *(-G/SR2*ZMIXSS(3,IZ)+GP/3./SR2*ZMIXSS(4,IZ)) + ZBDIZ=ZI**(THIZ-1.)*(-2)*GP*ZMIXSS(4,IZ)/3./SR2 + AUIZS=ZAUIZ*CONJG(ZAUIZ) + ADIZS=ZADIZ*CONJG(ZADIZ) + BUIZS=ZBUIZ*CONJG(ZBUIZ) + BDIZS=ZBDIZ*CONJG(ZBDIZ) +C squark --> q + qb + zi, q = u, d, s + IF (AMULSS.GT.MZIZ) THEN + WID=AUIZS*AMULSS*(1.-MZIZ**2/AMULSS**2)**2/16./PI + CALL SSSAVE(ISUPL,WID,ISZIZ(IZ),IDUP,0,0,0) + END IF + IF (AMDLSS.GT.MZIZ) THEN + WID=ADIZS*AMDLSS*(1.-MZIZ**2/AMDLSS**2)**2/16./PI + CALL SSSAVE(ISDNL,WID,ISZIZ(IZ),IDDN,0,0,0) + END IF + IF (AMSLSS.GT.MZIZ) THEN + WID=ADIZS*AMSLSS*(1.-MZIZ**2/AMSLSS**2)**2/16./PI + CALL SSSAVE(ISSTL,WID,ISZIZ(IZ),IDST,0,0,0) + END IF + IF (AMURSS.GT.MZIZ) THEN + WID=BUIZS*AMURSS*(1.-MZIZ**2/AMURSS**2)**2/16./PI + CALL SSSAVE(ISUPR,WID,ISZIZ(IZ),IDUP,0,0,0) + END IF + IF (AMDRSS.GT.MZIZ) THEN + WID=BDIZS*AMDRSS*(1.-MZIZ**2/AMDRSS**2)**2/16./PI + CALL SSSAVE(ISDNR,WID,ISZIZ(IZ),IDDN,0,0,0) + END IF + IF (AMSRSS.GT.MZIZ) THEN + WID=BDIZS*AMSRSS*(1.-MZIZ**2/AMSRSS**2)**2/16./PI + CALL SSSAVE(ISSTR,WID,ISZIZ(IZ),IDST,0,0,0) + END IF +C squark --> q + zi, q = c + IF (AMCLSS.GT.(MZIZ+AMCH)) THEN + WID=AUIZS*AMCLSS*(1.-MZIZ**2/AMCLSS**2-AMCH**2/AMCLSS**2) + $ *SQRT(SSXLAM(1.,MZIZ**2/AMCLSS**2,AMCH**2/AMCLSS**2))/16./PI + CALL SSSAVE(ISCHL,WID,ISZIZ(IZ),IDCH,0,0,0) + END IF + IF (AMCRSS.GT.(MZIZ+AMCH)) THEN + WID=BUIZS*AMCRSS*(1.-MZIZ**2/AMCRSS**2-AMCH**2/AMCRSS**2) + $ *SQRT(SSXLAM(1.,MZIZ**2/AMCRSS**2,AMCH**2/AMCRSS**2))/16./PI + CALL SSSAVE(ISCHR,WID,ISZIZ(IZ),IDCH,0,0,0) + END IF +C sbottom_1 --> b + zi + IF (AMB1SS.GT.(MZIZ+AMBT)) THEN + ZA=(ZI*ZADIZ-FB*ZMIXSS(2,IZ)*ZI**THIZ)*COSB/2.- + $ (ZI*ZBDIZ-FB*ZMIXSS(2,IZ)*(-ZI)**THIZ)*SINB/2. + ZB=(-ZI*ZADIZ-FB*ZMIXSS(2,IZ)*ZI**THIZ)*COSB/2.- + $ (ZI*ZBDIZ+FB*ZMIXSS(2,IZ)*(-ZI)**THIZ)*SINB/2. + WID=(ZA*CONJG(ZA)*(AMB1SS**2-(AMBT+MZIZ)**2)+ + $ ZB*CONJG(ZB)*(AMB1SS**2-(MZIZ-AMBT)**2))/8./PI/AMB1SS + $ *SQRT(SSXLAM(1.,MZIZ**2/AMB1SS**2,AMBT**2/AMB1SS**2)) + CALL SSSAVE(ISBT1,WID,ISZIZ(IZ),IDBT,0,0,0) + END IF +C sbottom_2 --> b + zi + IF (AMB2SS.GT.(MZIZ+AMBT)) THEN + ZA=(ZI*ZADIZ-FB*ZMIXSS(2,IZ)*ZI**THIZ)*SINB/2.+ + $ (ZI*ZBDIZ-FB*ZMIXSS(2,IZ)*(-ZI)**THIZ)*COSB/2. + ZB=(-ZI*ZADIZ-FB*ZMIXSS(2,IZ)*ZI**THIZ)*SINB/2.+ + $ (ZI*ZBDIZ+FB*ZMIXSS(2,IZ)*(-ZI)**THIZ)*COSB/2. + WID=(ZA*CONJG(ZA)*(AMB2SS**2-(AMBT+MZIZ)**2)+ + $ ZB*CONJG(ZB)*(AMB2SS**2-(MZIZ-AMBT)**2))/8./PI/AMB2SS + $ *SQRT(SSXLAM(1.,MZIZ**2/AMB2SS**2,AMBT**2/AMB2SS**2)) + CALL SSSAVE(ISBT2,WID,ISZIZ(IZ),IDBT,0,0,0) + END IF +100 CONTINUE +C +C Compute squark branching fractions to gluinos +C + IF (AMULSS.GT.AMGLSS) THEN + WID=2*SSALFS(DBLE(AMULSS**2))*AMULSS* + $ (1.-AMGLSS**2/AMULSS**2)**2/3. + CALL SSSAVE(ISUPL,WID,ISGL,IDUP,0,0,0) + END IF + IF (AMDLSS.GT.AMGLSS) THEN + WID=2*SSALFS(DBLE(AMDLSS**2))*AMDLSS* + $ (1.-AMGLSS**2/AMDLSS**2)**2/3. + CALL SSSAVE(ISDNL,WID,ISGL,IDDN,0,0,0) + END IF + IF (AMSLSS.GT.AMGLSS) THEN + WID=2*SSALFS(DBLE(AMSLSS**2))*AMSLSS* + $ (1.-AMGLSS**2/AMSLSS**2)**2/3. + CALL SSSAVE(ISSTL,WID,ISGL,IDST,0,0,0) + END IF + IF (AMURSS.GT.AMGLSS) THEN + WID=2*SSALFS(DBLE(AMURSS**2))*AMURSS* + $ (1.-AMGLSS**2/AMURSS**2)**2/3. + CALL SSSAVE(ISUPR,WID,ISGL,IDUP,0,0,0) + END IF + IF (AMDRSS.GT.AMGLSS) THEN + WID=2*SSALFS(DBLE(AMDRSS**2))*AMDRSS* + $ (1.-AMGLSS**2/AMDRSS**2)**2/3. + CALL SSSAVE(ISDNR,WID,ISGL,IDDN,0,0,0) + END IF + IF (AMSRSS.GT.AMGLSS) THEN + WID=2*SSALFS(DBLE(AMSRSS**2))*AMSRSS* + $ (1.-AMGLSS**2/AMSRSS**2)**2/3. + CALL SSSAVE(ISSTR,WID,ISGL,IDST,0,0,0) + END IF +C + IF (AMCLSS.GT.(AMGLSS+AMCH)) THEN + WID=2*SSALFS(DBLE(AMCLSS**2))*AMCLSS*(1.-AMGLSS**2/AMCLSS**2- + $ AMCH**2/AMCLSS**2)*SQRT(SSXLAM(1.,AMGLSS**2/AMCLSS**2, + $ AMCH**2/AMCLSS**2))/3. + CALL SSSAVE(ISCHL,WID,ISGL,IDCH,0,0,0) + END IF + IF (AMCRSS.GT.(AMGLSS+AMCH)) THEN + WID=2*SSALFS(DBLE(AMCRSS**2))*AMCRSS*(1.-AMGLSS**2/AMCRSS**2- + $ AMCH**2/AMCRSS**2)*SQRT(SSXLAM(1.,AMGLSS**2/AMCRSS**2, + $ AMCH**2/AMCRSS**2))/3. + CALL SSSAVE(ISCHR,WID,ISGL,IDCH,0,0,0) + END IF +C + IF (AMB1SS.GT.(AMGLSS+AMBT)) THEN + WID=2*SSALFS(DBLE(AMB1SS**2))*AMB1SS*(1.-AMGLSS**2/AMB1SS**2- + $ AMBT**2/AMB1SS**2)*SQRT(SSXLAM(1.,AMGLSS**2/AMB1SS**2, + $ AMBT**2/AMB1SS**2))/3. + CALL SSSAVE(ISBT1,WID,ISGL,IDBT,0,0,0) + END IF +C + IF (AMB2SS.GT.(AMGLSS+AMBT)) THEN + WID=2*SSALFS(DBLE(AMB2SS**2))*AMB2SS*(1.-AMGLSS**2/AMB2SS**2- + $ AMBT**2/AMB2SS**2)*SQRT(SSXLAM(1.,AMGLSS**2/AMB2SS**2, + $ AMBT**2/AMB2SS**2))/3. + CALL SSSAVE(ISBT2,WID,ISGL,IDBT,0,0,0) + END IF +C +C Compute branching fractions to wi --- theta-C = 0 +C + IF (AMULSS.GT.MW1) THEN + WID=G**2*SIN(GAMMAR)**2*AMULSS*(1.-MW1**2/AMULSS**2)**2/16./PI + CALL SSSAVE(ISUPL,WID,ISW1,IDDN,0,0,0) + END IF + IF (AMCLSS.GT.MW1) THEN + WID=G**2*SIN(GAMMAR)**2*AMCLSS*(1.-MW1**2/AMCLSS**2)**2/16./PI + CALL SSSAVE(ISCHL,WID,ISW1,IDST,0,0,0) + END IF + IF (AMDLSS.GT.MW1) THEN + WID=G**2*SIN(GAMMAL)**2*AMDLSS*(1.-MW1**2/AMDLSS**2)**2/16./PI + CALL SSSAVE(ISDNL,WID,-ISW1,IDUP,0,0,0) + END IF +C + IF (AMSLSS.GT.(MW1+AMCH)) THEN + WID=G**2*SIN(GAMMAL)**2*AMSLSS*(1.-MW1**2/AMSLSS**2 + $ -AMCH**2/AMSLSS**2) + $ *SQRT(SSXLAM(1.,MW1**2/AMSLSS**2,AMCH**2/AMSLSS**2))/16./PI + CALL SSSAVE(ISSTL,WID,-ISW1,IDCH,0,0,0) + ENDIF +C + IF (AMB1SS.GT.(MW1+AMTP)) THEN + A=AWU(1)*COSB-BWP(1)*SINB + AS=A*A + WID=AMB1SS*((AS+BW(1)**2*COSB**2)*(1.-MW1**2/AMB1SS**2 + $ -AMTP**2/AMB1SS**2)-4*AMTP*MW1*BW(1)*A*COSB/AMB1SS**2) + $ *SQRT(SSXLAM(1.,MW1**2/AMB1SS**2,AMTP**2/AMB1SS**2))/16./PI + CALL SSSAVE(ISBT1,WID,-ISW1,IDTP,0,0,0) + ENDIF +C + IF (AMB2SS.GT.(MW1+AMTP)) THEN + A=AWU(1)*SINB+BWP(1)*COSB + AS=A*A + WID=AMB2SS*((AS+BW(1)**2*SINB**2)*(1.-MW1**2/AMB2SS**2 + $ -AMTP**2/AMB2SS**2)-4*AMTP*MW1*BW(1)*A*SINB/AMB2SS**2) + $ *SQRT(SSXLAM(1.,MW1**2/AMB2SS**2,AMTP**2/AMB2SS**2))/16./PI + CALL SSSAVE(ISBT2,WID,-ISW1,IDTP,0,0,0) + ENDIF +C + IF (AMULSS.GT.MW2) THEN + WID=G**2*COS(GAMMAR)**2*AMULSS*(1.-MW2**2/AMULSS**2)**2/16./PI + CALL SSSAVE(ISUPL,WID,ISW2,IDDN,0,0,0) + END IF + IF (AMCLSS.GT.MW2) THEN + WID=G**2*COS(GAMMAR)**2*AMCLSS*(1.-MW2**2/AMCLSS**2)**2/16./PI + CALL SSSAVE(ISCHL,WID,ISW2,IDST,0,0,0) + END IF + IF (AMDLSS.GT.MW2) THEN + WID=G**2*COS(GAMMAL)**2*AMDLSS*(1.-MW2**2/AMDLSS**2)**2/16./PI + CALL SSSAVE(ISDNL,WID,-ISW2,IDUP,0,0,0) + END IF +C + IF (AMSLSS.GT.(MW2+AMCH)) THEN + WID=G**2*COS(GAMMAL)**2*AMSLSS*(1.-MW2**2/AMSLSS**2 + $ -AMCH**2/AMSLSS**2) + $ *SQRT(SSXLAM(1.,MW2**2/AMSLSS**2,AMCH**2/AMSLSS**2))/16./PI + CALL SSSAVE(ISSTL,WID,-ISW2,IDCH,0,0,0) + ENDIF +C + IF (AMB1SS.GT.(MW2+AMTP)) THEN + A=AWU(2)*COSB-BWP(2)*SINB + AS=A*A + WID=AMB1SS*((AS+BW(2)**2*COSB**2)*(1.-MW2**2/AMB1SS**2 + $ -AMTP**2/AMB1SS**2)-4*AMTP*MW2*BW(2)*A*COSB/AMB1SS**2) + $ *SQRT(SSXLAM(1.,MW2**2/AMB1SS**2,AMTP**2/AMB1SS**2))/16./PI + CALL SSSAVE(ISBT1,WID,-ISW2,IDTP,0,0,0) + ENDIF +C + IF (AMB2SS.GT.(MW2+AMTP)) THEN + A=AWU(2)*SINB+BWP(2)*COSB + AS=A*A + WID=AMB2SS*((AS+BW(2)**2*SINB**2)*(1.-MW2**2/AMB2SS**2 + $ -AMTP**2/AMB2SS**2)-4*AMTP*MW2*BW(2)*A*SINB/AMB2SS**2) + $ *SQRT(SSXLAM(1.,MW2**2/AMB2SS**2,AMTP**2/AMB2SS**2))/16./PI + CALL SSSAVE(ISBT2,WID,-ISW2,IDTP,0,0,0) + ENDIF +C + IF (AMB1SS.GT.(AMW+AMT1SS)) THEN + WID=G**2*COST**2*COSB**2*(SSXLAM(AMB1SS**2,AMW**2, + $ AMT1SS**2))**1.5/32./PI/AMB1SS**3/AMW**2 + CALL SSSAVE(ISBT1,WID,-IDW,ISTP1,0,0,0) + ENDIF +C + IF (AMB1SS.GT.(AMW+AMT2SS)) THEN + WID=G**2*SINT**2*COSB**2*(SSXLAM(AMB1SS**2,AMW**2, + $ AMT2SS**2))**1.5/32./PI/AMB1SS**3/AMW**2 + CALL SSSAVE(ISBT1,WID,-IDW,ISTP2,0,0,0) + ENDIF +C + IF (AMB2SS.GT.(AMW+AMT1SS)) THEN + WID=G**2*COST**2*SINB**2*(SSXLAM(AMB2SS**2,AMW**2, + $ AMT1SS**2))**1.5/32./PI/AMB2SS**3/AMW**2 + CALL SSSAVE(ISBT2,WID,-IDW,ISTP1,0,0,0) + ENDIF +C + IF (AMB2SS.GT.(AMW+AMT2SS)) THEN + WID=G**2*SINT**2*SINB**2*(SSXLAM(AMB2SS**2,AMW**2, + $ AMT2SS**2))**1.5/32./PI/AMB2SS**3/AMW**2 + CALL SSSAVE(ISBT2,WID,-IDW,ISTP2,0,0,0) + ENDIF +C + IF (AMB2SS.GT.(AMZ+AMB1SS)) THEN + WID=G**2*COSB**2*SINB**2*(SSXLAM(AMB2SS**2,AMZ**2, + $ AMB1SS**2))**1.5/64./PI/AMB2SS**3/AMZ**2/CS2THW + CALL SSSAVE(ISBT2,WID,IDZ,ISBT1,0,0,0) + ENDIF +C + IF (AMB2SS.GT.(AMHL+AMB1SS)) THEN + BH=G*AMW*SIN(BETA-ALFAH)*(-1.+TN2THW/3.)*SINB*COSB/2.+G* + $ AMBT*(TWOM1*COSA+AAB*SINA)*COS(2*THETAB)/2./AMW/COS(BETA) + WID=BH**2*SQRT(SSXLAM(AMB2SS**2,AMHL**2,AMB1SS**2))/ + $ 16./PI/AMB2SS**3 + CALL SSSAVE(ISBT2,WID,ISHL,ISBT1,0,0,0) + ENDIF +C + IF (AMB2SS.GT.(AMHA+AMB1SS)) THEN + BH=G*AMBT*(TWOM1-AAB*TANB)/2./AMW + WID=BH**2*SQRT(SSXLAM(AMB2SS**2,AMHA**2,AMB1SS**2))/ + $ 16./PI/AMB2SS**3 + CALL SSSAVE(ISBT2,WID,ISHA,ISBT1,0,0,0) + ENDIF +C + IF (AMB2SS.GT.(AMHH+AMB1SS)) THEN + BH=-G*AMW*COS(BETA-ALFAH)*(-1.+TN2THW/3.)*SINB*COSB/2.+G* + $ AMBT*(-TWOM1*SINA+AAB*COSA)*COS(2*THETAB)/2./AMW/COS(BETA) + WID=BH**2*SQRT(SSXLAM(AMB2SS**2,AMHH**2,AMB1SS**2))/ + $ 16./PI/AMB2SS**3 + CALL SSSAVE(ISBT2,WID,ISHH,ISBT1,0,0,0) + ENDIF +C +C b_i -> H^- t_i +C + IF (AMB1SS.GT.(AMT1SS+AMHC)) THEN + A=G/SR2/AMW*(AMTP*AMBT*(COTB+TANB)*SINT*SINB+ + $(AMBT**2*TANB+AMTP**2*COTB-AMW**2*SIN(2*BETA))* + $COST*COSB-AMTP*(TWOM1-AAT*COTB)*SINT*COSB-AMBT* + $(TWOM1-AAB*TANB)*SINB*COST) + AS=A*A + WID=AS*SQRT(SSXLAM(AMB1SS**2,AMT1SS**2,AMHC**2))/ + $ 16./PI/AMB1SS**3 + CALL SSSAVE(ISBT1,WID,-ISHC,ISTP1,0,0,0) + END IF +C + IF (AMB1SS.GT.(AMT2SS+AMHC)) THEN + A=G/SR2/AMW*(-AMTP*AMBT*(COTB+TANB)*COST*SINT+ + $(AMBT**2*TANB+AMTP**2*COTB-AMW**2*SIN(2*BETA))* + $SINT*COSB+AMTP*(TWOM1-AAT*COTB)*COST*COSB-AMBT* + $(TWOM1-AAB*TANB)*SINT*SINB) + AS=A*A + WID=AS*SQRT(SSXLAM(AMB1SS**2,AMT2SS**2,AMHC**2))/ + $ 16./PI/AMB1SS**3 + CALL SSSAVE(ISBT1,WID,-ISHC,ISTP2,0,0,0) + END IF +C + IF (AMB2SS.GT.(AMT1SS+AMHC)) THEN + A=G/SR2/AMW*(-AMTP*AMBT*(COTB+TANB)*SINT*COSB+ + $(AMBT**2*TANB+AMTP**2*COTB-AMW**2*SIN(2*BETA))* + $COST*SINB-AMTP*(TWOM1-AAT*COTB)*SINT*SINB+AMBT* + $(TWOM1-AAB*TANB)*COST*COSB) + AS=A*A + WID=AS*SQRT(SSXLAM(AMB2SS**2,AMT1SS**2,AMHC**2))/ + $ 16./PI/AMB2SS**3 + CALL SSSAVE(ISBT2,WID,-ISHC,ISTP1,0,0,0) + END IF +C + IF (AMB2SS.GT.(AMT2SS+AMHC)) THEN + A=G/SR2/AMW*(AMTP*AMBT*(COTB+TANB)*COST*COSB+ + $(AMBT**2*TANB+AMTP**2*COTB-AMW**2*SIN(2*BETA))* + $SINT*SINB+AMTP*(TWOM1-AAT*COTB)*SINB*COST+AMBT* + $(TWOM1-AAB*TANB)*COSB*SINT) + AS=A*A + WID=AS*SQRT(SSXLAM(AMB2SS**2,AMT2SS**2,AMHC**2))/ + $ 16./PI/AMB2SS**3 + CALL SSSAVE(ISBT2,WID,-ISHC,ISTP2,0,0,0) + END IF +C +C Normalize branching ratios +C + CALL SSNORM(ISUPL) + CALL SSNORM(ISDNL) + CALL SSNORM(ISSTL) + CALL SSNORM(ISCHL) + CALL SSNORM(ISBT1) + CALL SSNORM(ISUPR) + CALL SSNORM(ISDNR) + CALL SSNORM(ISSTR) + CALL SSNORM(ISCHR) + CALL SSNORM(ISBT2) +C + RETURN + END diff --git a/ISAJET/isasusy/sssave.F b/ISAJET/isasusy/sssave.F new file mode 100644 index 00000000000..e3e13fb27b3 --- /dev/null +++ b/ISAJET/isasusy/sssave.F @@ -0,0 +1,51 @@ +#include "isajet/pilot.h" + SUBROUTINE SSSAVE(IIN,GAM,IOUT1,IOUT2,IOUT3,IOUT4,IOUT5) +C----------------------------------------------------------------------- +C Store a SUSY decay mode in /SSMODE/ +C Ver 7.14: Increment NSSMOD only after test +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +C +#include "isajet/sslun.inc" +#include "isajet/ssmode.inc" +C + INTEGER IIN,IOUT1,IOUT2,IOUT3,IOUT4,IOUT5,I + REAL GAM +C + IF (GAM.LE.0.) THEN + IF(GAM.LT.0.) THEN + WRITE(LOUT,1000) IIN,IOUT1,IOUT2,IOUT3,IOUT4,IOUT5,GAM +1000 FORMAT(' WARNING: SSSAVE: ',I5,' --> ',5I5,E14.5) + ENDIF + LSSMOD=.FALSE. + GO TO 999 + ENDIF + NSSMOD=NSSMOD+1 + LSSMOD=.TRUE. + IF(NSSMOD.GT.MXSS) THEN + WRITE(LOUT,*) 'SSSAVE: TOO MANY MODES, IIN = ',IIN + STOP99 + ENDIF + ISSMOD(NSSMOD)=IIN + JSSMOD(1,NSSMOD)=IOUT1 + JSSMOD(2,NSSMOD)=IOUT2 + JSSMOD(3,NSSMOD)=IOUT3 + JSSMOD(4,NSSMOD)=IOUT4 + JSSMOD(5,NSSMOD)=IOUT5 + GSSMOD(NSSMOD)=GAM + BSSMOD(NSSMOD)=0. + MSSMOD(NSSMOD)=0 +C Check that quarks and gluons appear at end of list. + DO 100 I=1,4 + IF(IABS(JSSMOD(I,NSSMOD)).LE.9.AND. + $ IABS(JSSMOD(I+1,NSSMOD)).GT.9) THEN + WRITE(LOUT,1100) IIN,IOUT1,IOUT2,IOUT3,IOUT4,IOUT5 +1100 FORMAT(' WARNING: SSSAVE: BAD ORDER: ',I5,' --> ',5I5) + STOP99 + ENDIF +100 CONTINUE +C +999 RETURN + END diff --git a/ISAJET/isasusy/sssnws.F b/ISAJET/isasusy/sssnws.F new file mode 100644 index 00000000000..8a739ac51a9 --- /dev/null +++ b/ISAJET/isasusy/sssnws.F @@ -0,0 +1,23 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSSNWS(EE) +C----------------------------------------------------------------------- +C SSSNWS: sneutrino->stau_1+f+fb' via W* +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" + REAL EE + DOUBLE PRECISION E,M1,M2,MSN,ML1,WID + E=EE + M1=TMP(1) + M2=TMP(2) + ML1=TMP(3) + MSN=TMP(4) + WID=MSN**2*(E*E-ML1*ML1)**1.5/ + $ (MSN**2+ML1**2-2*MSN*E-M1**2)**2 + SSSNWS=WID + RETURN + END diff --git a/ISAJET/isasusy/ssstbf.F b/ISAJET/isasusy/ssstbf.F new file mode 100644 index 00000000000..bb42b2d8906 --- /dev/null +++ b/ISAJET/isasusy/ssstbf.F @@ -0,0 +1,335 @@ +#include "isajet/pilot.h" + SUBROUTINE SSSTBF +C----------------------------------------------------------------------- +C +C This program gives stop squark branching fractions to gauginos +C according to Baer and Tata. +C If no other modes are allowed, stop -> c z_i through loops is +C used as the default. +C +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sslun.inc" +#include "isajet/ssmode.inc" +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstype.inc" +C + COMPLEX ZI,ZONE,ZA,ZB,ZPP,ZPM,ZAUIZ,ZBUIZ + DOUBLE PRECISION SSALFS,SSMQCD + REAL SSXLAM + REAL WID,AWD(2),BW(2),FB,FT,XM,YM,THX,THY,AU1,MZ1,WIDC1 + REAL PI,SR2,G,GP,TANB,COTB,MPL,MMI,AH + REAL AUIZ,MZIZ,SINT,COST,AS,BS,SNZI,THIZ + INTEGER IZ,ISTOP,IDSTOP + REAL AMSTOP,BWP(2),A + REAL MW1,MW2,SNW1,SNW2,CS2THW,BETA,TN2THW,SINB,COSB + REAL ASMB,MBMB,MBQ,ASMT,MTMT,MTQ,SUALFS + INTEGER ISZIZ(4) + DATA ZONE/(1.,0.)/,ZI/(0.,1.)/ +C +C Partly duplicated from SSMASS +C + CS2THW=1.-SN2THW + TN2THW=SN2THW/CS2THW + PI=4.*ATAN(1.) + SR2=SQRT(2.) + G=SQRT(4*PI*ALFAEM/SN2THW) + GP=G*SQRT(SN2THW/(1.-SN2THW)) + TANB=1./RV2V1 + COTB=RV2V1 + BETA=ATAN(TANB) +C Reconstruct masses from SSMASS + ASMB=SUALFS(AMBT**2,.36,AMTP,3) + MBMB=AMBT*(1.-4*ASMB/3./PI) + MBQ=SSMQCD(DBLE(MBMB),DBLE(AMT1SS)) + ASMT=SUALFS(AMTP**2,.36,AMTP,3) + MTMT=AMTP/(1.+4*ASMT/3./PI+(16.11-1.04*(5.-6.63/AMTP))* + $(ASMT/PI)**2) + MTQ=SSMQCD(DBLE(MTMT),DBLE(AMT1SS)) + FB=G*MBQ/SR2/AMW/COS(BETA) + FT=G*MTQ/SR2/AMW/SIN(BETA) + MW1=ABS(AMW1SS) + MW2=ABS(AMW2SS) + SNW1=SIGN(1.,AMW1SS) + SNW2=SIGN(1.,AMW2SS) + XM=1./TAN(GAMMAL) + YM=1./TAN(GAMMAR) + THX=SIGN(1.,XM) + THY=SIGN(1.,YM) +C + AWD(1)=-G*SNW1*SIN(GAMMAR) + AWD(2)=-G*SNW2*THY*COS(GAMMAR) + BW(1)=-FT*SNW1*COS(GAMMAR) + BW(2)=FT*SNW2*THY*SIN(GAMMAR) + BWP(1)=-FB*COS(GAMMAL) + BWP(2)=FB*THX*SIN(GAMMAL) + MMI=AMW1SS + MPL=AMW2SS + COST=COS(THETAT) + SINT=SIN(THETAT) + COSB=COS(THETAB) + SINB=SIN(THETAB) +C +C Compute stop_i branching fractions to charm + zi if no other +C modes are allowed. WIDC1 is an unknown amplitude arbitrarily +C set equal to 1.0. +C + ISZIZ(1)=ISZ1 + ISZIZ(2)=ISZ2 + ISZIZ(3)=ISZ3 + ISZIZ(4)=ISZ4 + AU1=-G/SR2*ZMIXSS(3,1)-GP/3./SR2*ZMIXSS(4,1) + MZ1=ABS(AMZISS(1)) + DO 100 ISTOP=1,2 + IF(ISTOP.EQ.1) THEN + AMSTOP=AMT1SS + IDSTOP=ISTP1 + WIDC1=1.0E-6 + ELSE + AMSTOP=AMT2SS + IDSTOP=ISTP2 + WIDC1=1.0E-6 + ENDIF + IF(AMSTOP.LT.(MW1+AMBT).AND.AMSTOP.GT.(AMCH+MZ1)) THEN + DO 110 IZ=1,4 + MZIZ=ABS(AMZISS(IZ)) + AUIZ=-G/SR2*ZMIXSS(3,IZ)-GP/3./SR2*ZMIXSS(4,IZ) + IF (AMT1SS.GT.(AMCH+MZIZ)) THEN + WID=AUIZ**2*(AMSTOP**2-MZIZ**2)/AU1**2 + $ /(AMSTOP**2-MZ1**2)*WIDC1 + CALL SSSAVE(IDSTOP,WID,ISZIZ(IZ),IDCH,0,0,0) + END IF +110 CONTINUE + ELSEIF(AMSTOP.LT.(MW1+AMBT).AND.AMSTOP.LE.(AMCH+MZ1)) THEN + WRITE(LOUT,1000) ISTOP +1000 FORMAT(' ERROR IN SSSTBF: NO ALLOWED MODE FOR STOP',I2) + END IF +100 CONTINUE +C +C stop_i -> gluino + top +C + IF (AMT1SS.GT.(AMGLSS+AMTP)) THEN + WID=2*SSALFS(DBLE(AMT1SS**2))*AMT1SS*((1.-AMGLSS**2/AMT1SS**2- + $ AMTP**2/AMT1SS**2)-2*SIN(2*THETAT)*AMTP*AMGLSS/AMT1SS**2) + $ *SQRT(SSXLAM(1.,AMGLSS**2/AMT1SS**2,AMTP**2/AMT1SS**2))/3. + CALL SSSAVE(ISTP1,WID,ISGL,IDTP,0,0,0) + END IF +C + IF (AMT2SS.GT.(AMGLSS+AMTP)) THEN + WID=2*SSALFS(DBLE(AMT2SS**2))*AMT2SS*((1.-AMGLSS**2/AMT2SS**2- + $ AMTP**2/AMT2SS**2)+2*SIN(2*THETAT)*AMTP*AMGLSS/AMT2SS**2) + $ *SQRT(SSXLAM(1.,AMGLSS**2/AMT2SS**2,AMTP**2/AMT2SS**2))/3. + CALL SSSAVE(ISTP2,WID,ISGL,IDTP,0,0,0) + END IF +C +C stop_1 -> top + zino_i +C + DO 200 IZ=1,4 + MZIZ=ABS(AMZISS(IZ)) + SNZI=SIGN(1.,AMZISS(IZ)) + IF (SNZI.EQ.1.) THEN + THIZ=0. + ELSE + THIZ=1. + END IF + ZAUIZ=ZI**(THIZ-1.)*SNZI + $ *(-G/SR2*ZMIXSS(3,IZ)-GP/3./SR2*ZMIXSS(4,IZ)) + ZBUIZ=ZI**(THIZ-1.)*4*GP*ZMIXSS(4,IZ)/3./SR2 + ZPP=ZI**THIZ + ZPM=(-ZI)**THIZ + ZA=((ZI*ZAUIZ-ZPP*FT*ZMIXSS(1,IZ))*COST + $ -(ZI*ZBUIZ-ZPM*FT*ZMIXSS(1,IZ))*SINT)/2. + ZB=((-ZI*ZAUIZ-ZPP*FT*ZMIXSS(1,IZ))*COST + $ -(ZI*ZBUIZ+ZPM*FT*ZMIXSS(1,IZ))*SINT)/2. + AS=ZA*CONJG(ZA) + BS=ZB*CONJG(ZB) + IF (AMT1SS.GT.(AMTP+MZIZ)) THEN + WID=(AS*(AMT1SS**2-(AMTP+MZIZ)**2)+BS + $ *(AMT1SS**2-(AMTP-MZIZ)**2))/8./PI/AMT1SS + $ *SQRT(SSXLAM(1.,AMTP**2/AMT1SS**2,MZIZ**2/AMT1SS**2)) + CALL SSSAVE(ISTP1,WID,ISZIZ(IZ),IDTP,0,0,0) + END IF +200 CONTINUE +C +C Wino decays +C + IF (AMT1SS.GT.(AMBT+MW1)) THEN + A=AWD(1)*COST-BW(1)*SINT + AS=A*A + WID=AMT1SS*((AS+BWP(1)**2*COST**2)*(1.-MW1**2/AMT1SS**2- + $ AMBT**2/AMT1SS**2)-4*MW1*AMBT*BWP(1)*COST*A/AMT1SS**2) + $ *SQRT(SSXLAM(1.,MW1**2/AMT1SS**2,AMBT**2/AMT1SS**2))/16./PI + CALL SSSAVE(ISTP1,WID,ISW1,IDBT,0,0,0) + END IF + IF (AMT1SS.GT.(AMBT+MW2)) THEN + A=AWD(2)*COST-BW(2)*SINT + AS=A*A + WID=AMT1SS*((AS+BWP(2)**2*COST**2)*(1.-MW2**2/AMT1SS**2- + $ AMBT**2/AMT1SS**2)-4*MW2*AMBT*BWP(2)*COST*A/AMT1SS**2) + $ *SQRT(SSXLAM(1.,MW2**2/AMT1SS**2,AMBT**2/AMT1SS**2))/16./PI + CALL SSSAVE(ISTP1,WID,ISW2,IDBT,0,0,0) + END IF +C + IF (AMT2SS.GT.(AMBT+MW1)) THEN + A=AWD(1)*SINT+BW(1)*COST + AS=A*A + WID=AMT2SS*((AS+BWP(1)**2*SINT**2)*(1.-MW1**2/AMT2SS**2- + $ AMBT**2/AMT2SS**2)-4*MW1*AMBT*BWP(1)*SINT*A/AMT2SS**2) + $ *SQRT(SSXLAM(1.,MW1**2/AMT2SS**2,AMBT**2/AMT2SS**2))/16./PI + CALL SSSAVE(ISTP2,WID,ISW1,IDBT,0,0,0) + END IF + IF (AMT2SS.GT.(AMBT+MW2)) THEN + A=AWD(2)*SINT+BW(2)*COST + AS=A*A + WID=AMT2SS*((AS+BWP(2)**2*SINT**2)*(1.-MW2**2/AMT2SS**2- + $ AMBT**2/AMT2SS**2)-4*MW2*AMBT*BWP(2)*SINT*A/AMT2SS**2) + $ *SQRT(SSXLAM(1.,MW2**2/AMT2SS**2,AMBT**2/AMT2SS**2))/16./PI + CALL SSSAVE(ISTP2,WID,ISW2,IDBT,0,0,0) + END IF +C +C stop_2 -> stop_1 + X modes +C + IF (AMT2SS.GT.(AMT1SS+AMZ)) THEN + WID=G**2*COST**2*SINT**2 + $ *(SQRT(SSXLAM(AMT2SS**2,AMZ**2,AMT1SS**2)))**3 + $ /64./PI/CS2THW/AMT2SS**3/AMZ**2 + CALL SSSAVE(ISTP2,WID,IDZ,ISTP1,0,0,0) + END IF +C + IF (AMT2SS.GT.(AMT1SS+AMHL)) THEN + AH=G*AMW*SIN(BETA-ALFAH)*(1.-5.*TN2THW/3.)*SINT*COST/2. + $ +G*AMTP*COS(2.*THETAT)*(TWOM1*SIN(ALFAH)+AAT*COS(ALFAH))/2. + $ /AMW/SIN(BETA) + WID=AH**2/16./PI/AMT2SS**3 + $ *SQRT(SSXLAM(AMT2SS**2,AMHL**2,AMT1SS**2)) + CALL SSSAVE(ISTP2,WID,ISHL,ISTP1,0,0,0) + END IF +C + IF (AMT2SS.GT.(AMT1SS+AMHH)) THEN + AH=-G*AMW*COS(BETA-ALFAH)*(1.-5.*TN2THW/3.)*SINT*COST/2. + $ +G*AMTP*COS(2.*THETAT)*(TWOM1*COS(ALFAH)-AAT*SIN(ALFAH))/2. + $ /AMW/SIN(BETA) + WID=AH**2/16./PI/AMT2SS**3 + $ *SQRT(SSXLAM(AMT2SS**2,AMHH**2,AMT1SS**2)) + CALL SSSAVE(ISTP2,WID,ISHH,ISTP1,0,0,0) + END IF +C + IF (AMT2SS.GT.(AMT1SS+AMHA)) THEN + AH=G*AMTP*(TWOM1-AAT/TANB)/2./AMW + WID=AH**2/16./PI/AMT2SS**3 + $ *SQRT(SSXLAM(AMT2SS**2,AMHA**2,AMT1SS**2)) + CALL SSSAVE(ISTP2,WID,ISHA,ISTP1,0,0,0) + END IF +C +C t_i --> b_i + W decays +C + IF (AMT1SS.GT.(AMB1SS+AMW)) THEN + WID=G**2*COST**2*COSB**2*(SSXLAM(AMT1SS**2,AMB1SS**2, + $AMW**2))**1.5/32./PI/AMT1SS**3/AMW**2 + CALL SSSAVE(ISTP1,WID,IDW,ISBT1,0,0,0) + END IF +C + IF (AMT1SS.GT.(AMB2SS+AMW)) THEN + WID=G**2*COST**2*SINB**2*(SSXLAM(AMT1SS**2,AMB2SS**2, + $AMW**2))**1.5/32./PI/AMT1SS**3/AMW**2 + CALL SSSAVE(ISTP1,WID,IDW,ISBT2,0,0,0) + END IF +C + IF (AMT2SS.GT.(AMB1SS+AMW)) THEN + WID=G**2*SINT**2*COSB**2*(SSXLAM(AMT2SS**2,AMB1SS**2, + $AMW**2))**1.5/32./PI/AMT2SS**3/AMW**2 + CALL SSSAVE(ISTP2,WID,IDW,ISBT1,0,0,0) + END IF +C + IF (AMT2SS.GT.(AMB2SS+AMW)) THEN + WID=G**2*SINT**2*SINB**2*(SSXLAM(AMT2SS**2,AMB2SS**2, + $AMW**2))**1.5/32./PI/AMT2SS**3/AMW**2 + CALL SSSAVE(ISTP2,WID,IDW,ISBT2,0,0,0) + END IF +C +C t_i --> b_i + H+ decays +C + IF (AMT1SS.GT.(AMB1SS+AMHC)) THEN + A=G/SR2/AMW*(AMTP*AMBT*(COTB+TANB)*SINT*SINB+ + $(AMBT**2*TANB+AMTP**2*COTB-AMW**2*SIN(2*BETA))* + $COST*COSB-AMTP*(TWOM1-AAT*COTB)*SINT*COSB-AMBT* + $(TWOM1-AAB*TANB)*SINB*COST) + AS=A*A + WID=AS*SQRT(SSXLAM(AMT1SS**2,AMB1SS**2,AMHC**2))/ + $ 16./PI/AMT1SS**3 + CALL SSSAVE(ISTP1,WID,ISHC,ISBT1,0,0,0) + END IF +C + IF (AMT1SS.GT.(AMB2SS+AMHC)) THEN + A=G/SR2/AMW*(-AMTP*AMBT*(COTB+TANB)*SINT*COSB+ + $(AMBT**2*TANB+AMTP**2*COTB-AMW**2*SIN(2*BETA))* + $COST*SINB-AMTP*(TWOM1-AAT*COTB)*SINT*SINB+AMBT* + $(TWOM1-AAB*TANB)*COST*COSB) + AS=A*A + WID=AS*SQRT(SSXLAM(AMT1SS**2,AMB2SS**2,AMHC**2))/ + $ 16./PI/AMT1SS**3 + CALL SSSAVE(ISTP1,WID,ISHC,ISBT2,0,0,0) + END IF +C + IF (AMT2SS.GT.(AMB1SS+AMHC)) THEN + A=G/SR2/AMW*(-AMTP*AMBT*(COTB+TANB)*COST*SINT+ + $(AMBT**2*TANB+AMTP**2*COTB-AMW**2*SIN(2*BETA))* + $SINT*COSB+AMTP*(TWOM1-AAT*COTB)*COST*COSB-AMBT* + $(TWOM1-AAB*TANB)*SINT*SINB) + AS=A*A + WID=AS*SQRT(SSXLAM(AMT2SS**2,AMB1SS**2,AMHC**2))/ + $ 16./PI/AMT2SS**3 + CALL SSSAVE(ISTP2,WID,ISHC,ISBT1,0,0,0) + END IF +C + IF (AMT2SS.GT.(AMB2SS+AMHC)) THEN + A=G/SR2/AMW*(AMTP*AMBT*(COTB+TANB)*COST*COSB+ + $(AMBT**2*TANB+AMTP**2*COTB-AMW**2*SIN(2*BETA))* + $SINT*SINB+AMTP*(TWOM1-AAT*COTB)*SINB*COST+AMBT* + $(TWOM1-AAB*TANB)*COSB*SINT) + AS=A*A + WID=AS*SQRT(SSXLAM(AMT2SS**2,AMB2SS**2,AMHC**2))/ + $ 16./PI/AMT2SS**3 + CALL SSSAVE(ISTP2,WID,ISHC,ISBT2,0,0,0) + END IF +C +C +C stop_2 -> top + zino_i +C + DO 500 IZ=1,4 + MZIZ=ABS(AMZISS(IZ)) + SNZI=SIGN(1.,AMZISS(IZ)) + IF (SNZI.EQ.1.) THEN + THIZ=0. + ELSE + THIZ=1. + END IF + ZAUIZ=ZI**(THIZ-1.)*SNZI + $ *(-G/SR2*ZMIXSS(3,IZ)-GP/3./SR2*ZMIXSS(4,IZ)) + ZBUIZ=ZI**(THIZ-1.)*4*GP*ZMIXSS(4,IZ)/3./SR2 + ZPP=ZI**THIZ + ZPM=(-ZI)**THIZ + ZA=((ZI*ZAUIZ-ZPP*FT*ZMIXSS(1,IZ))*SINT + $ +(ZI*ZBUIZ-ZPM*FT*ZMIXSS(1,IZ))*COST)/2. + ZB=((-ZI*ZAUIZ-ZPP*FT*ZMIXSS(1,IZ))*SINT + $ +(ZI*ZBUIZ+ZPM*FT*ZMIXSS(1,IZ))*COST)/2. + AS=ZA*CONJG(ZA) + BS=ZB*CONJG(ZB) + IF (AMT2SS.GT.(AMTP+MZIZ)) THEN + WID=(AS*(AMT2SS**2-(AMTP+MZIZ)**2)+BS + $ *(AMT2SS**2-(AMTP-MZIZ)**2))/8./PI/AMT2SS + $ *SQRT(SSXLAM(1.,AMTP**2/AMT2SS**2,MZIZ**2/AMT2SS**2)) + CALL SSSAVE(ISTP2,WID,ISZIZ(IZ),IDTP,0,0,0) + END IF +500 CONTINUE +C +C Normalize branching ratios +C + CALL SSNORM(ISTP1) + CALL SSNORM(ISTP2) +C + RETURN + END diff --git a/ISAJET/isasusy/sstest.F b/ISAJET/isasusy/sstest.F new file mode 100644 index 00000000000..7b74ea64ff7 --- /dev/null +++ b/ISAJET/isasusy/sstest.F @@ -0,0 +1,137 @@ +#include "isajet/pilot.h" + SUBROUTINE SSTEST(IALLOW) +C +C Test MSSM parameters against existing bounds on SUSY from +C LEP and SLC: +C IALLOW = 1 Z1 is not LSP +C IALLOW = 2 Gamma(Z -> Z1SS Z1SS) < GAMINV +C IALLOW = 4 Z -> charginos allowed +C IALLOW = 8 BF(Z -> Z1SS Z2SS)>10^5 +C IALLOW = 16 Z -> squarks, sleptons +C IALLOW = 32 BR(Z -> Z* HL0) < B(Z -> Z* H(M=MHSM)) +C IALLOW = 64 BR(Z -> HL0 HA0) > 0 +C IALLOW = 128 M(H+) > M(Z)/2 +C where GAMINV is the present bound on the invisible width, +C and MHSM is the lower bound on the standard Higgs mass. +C +C Bounds on the other modes are only approximate, but the +C error in the allowed region of masses must be tiny. +C Updated by H. Baer on 5/25/95 +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sslun.inc" +#include "isajet/ssmode.inc" +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" +#include "isajet/sstype.inc" +#include "isajet/sugmg.inc" +#include "isajet/xmssm.inc" +C + INTEGER IALLOW + EXTERNAL SSZHX + REAL MHSM,GAMINV,PI,SR2,G,GP,MZ,MZ1,MZ2,MZ3,MZ4,MW1,MW2, + $TANB,BETA,COS2B,SIN2B,VS,V,VP,FT,MHL,ALPHA,SUSYCC, + $GAMSS,W11,GZ1Z1,GAMSM,SSXINT,SSXLAM,COS2W, + $W12,GZ1Z2,DGAMZ,BFZ,BFZ1Z2 +C +C Current bounds + DATA MHSM/64./,GAMINV/.0043/,DGAMZ/.0115/,BFZ/1.E-5/ +C +C Initialize +C + IALLOW=0 + PI=4.*ATAN(1.) + SR2=SQRT(2.) + G=SQRT(4*PI*ALFAEM/SN2THW) + GP=G*SQRT(SN2THW/(1.-SN2THW)) + COS2W=SQRT(1.-SN2THW) + MZ=AMZ + MZ1=ABS(AMZ1SS) + MZ2=ABS(AMZ2SS) + MZ3=ABS(AMZ3SS) + MZ4=ABS(AMZ4SS) + MW1=ABS(AMW1SS) + MW2=ABS(AMW2SS) +C +C Check that Z1SS is LSP +C + IF(MZ1.GT.MW1.OR.MZ1.GT.AMGLSS.OR.MZ1.GT.AMULSS + $.OR.MZ1.GT.AMERSS.OR.MZ1.GT.AMELSS.OR.MZ1.GT.AMN1SS + $.OR.MZ1.GT.AMB1SS.OR.MZ1.GT.AMT1SS.OR.MZ1.GT.AML1SS) THEN + IALLOW=IALLOW+1 + ENDIF +C +C Z -> Z1SS + Z1SS +C + IF (AMZ.GT.2*MZ1) THEN + W11=SQRT(G*G+GP*GP) + $ *(ZMIXSS(1,1)*ZMIXSS(1,1)-ZMIXSS(2,1)*ZMIXSS(2,1))/4. + GZ1Z1=SQRT(SSXLAM(MZ**2,MZ1**2,MZ1**2))/12./PI/MZ**3*W11**2 + $ *(2*MZ**2-MZ1**2-MZ1**2-(MZ1**2-MZ1**2)**2/MZ**2 + $ -6*MZ1*MZ1*SIGN(1.,AMZ1SS*AMZ1SS)) + IF(GZ1Z1.GT.GAMINV) THEN + IALLOW=IALLOW+2 + ENDIF + ENDIF +C +C Check for other allowed visible modes modes +C + IF(AMZ.GT.2*MW1) THEN + IALLOW=IALLOW+4 + ENDIF +C +C Check funny Z branching fractions +C + BFZ1Z2=0. + IF (AMZ.GT.MZ1+MZ2) THEN + W12=SQRT(G*G+GP*GP) + $ *(ZMIXSS(1,1)*ZMIXSS(1,2)-ZMIXSS(2,1)*ZMIXSS(2,2))/4. + GZ1Z2=SQRT(SSXLAM(MZ**2,MZ1**2,MZ2**2))/6./PI/MZ**3*W12**2 + $ *(2*MZ**2-MZ1**2-MZ2**2-(MZ1**2-MZ2**2)**2/MZ**2 + $ -6*MZ1*MZ2*SIGN(1.,AMZ1SS*AMZ2SS)) + BFZ1Z2=GZ1Z2/GAMZ + END IF + IF(BFZ1Z2.GT.BFZ) THEN + IALLOW=IALLOW+8 + ENDIF +C + IF(AMZ.GT.2*AMULSS.OR.AMZ.GT.2*AMELSS.OR.AMZ.GT.2*AMERSS + $.OR.AMZ.GT.2*AMN1SS.OR.AMZ.GT.2*AMB1SS.OR.AMZ.GT.2*AMT1SS)THEN + IALLOW=IALLOW+16 + ENDIF +C +C Z -> Higgs modes +C + TMP(1)=MHSM + GAMSM=SSXINT(2*MHSM/MZ,SSZHX,(1.+MHSM**2/MZ**2)) +C Z -> hl0 x + IF(AMZ.GT.AMHL) THEN + TANB=1./RV2V1 + BETA=ATAN(TANB) + COS2B=COS(2*BETA) + SIN2B=SIN(2*BETA) + VS=2*AMW**2/G**2/(1.+RV2V1**2) + V=SQRT(VS) + VP=RV2V1*V + FT=G*AMTP/SR2/AMW/V*SQRT(V**2+VP**2) + MHL=AMHL + ALPHA=ALFAH + SUSYCC=SIN(ALPHA+BETA) + TMP(1)=MHL + GAMSS=SSXINT(2*MHL/AMZ,SSZHX,(1.+MHL**2/AMZ**2))*SUSYCC**2 + IF(GAMSS.GE.GAMSM) IALLOW=IALLOW+32 + ENDIF +C Z -> hl0 ha0 + IF (AMZ.GT.(AMHL+AMHA)) THEN + IALLOW=IALLOW+64 + ENDIF +C Z -> H+ H- + IF(AMZ.GT.2*AMHC) THEN + IALLOW=IALLOW+128 + ENDIF +C + RETURN + END diff --git a/ISAJET/isasusy/sstpbf.F b/ISAJET/isasusy/sstpbf.F new file mode 100644 index 00000000000..e8822cfaa91 --- /dev/null +++ b/ISAJET/isasusy/sstpbf.F @@ -0,0 +1,163 @@ +#include "isajet/pilot.h" + SUBROUTINE SSTPBF +C----------------------------------------------------------------------- +C +C Calculate the top branching ratios. +C Source: H. Baer (modified by F. Paige) +C +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sslun.inc" +#include "isajet/ssmode.inc" +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstype.inc" +C + COMPLEX ZI,ZONE,ZA,ZB,ZPP,ZPM,ZAUIZ,ZBUIZ + REAL SSXLAM,G,AL2,BE2,TANB,COTB,GTBW,GTBH,BWLL,GF,BWQQ,PI,SR2 + REAL WID,AS,BS,MZIZ,CS2THW,GP,FT,FB,SNZI,THIZ + REAL SINT,COST,SINB,COSB,AWI,BWI,AMW1,AMW2,SNWI + REAL THX,THY,XM,YM,BETA,ASMB,MBMB,MBQ,ASMT,MTMT,MTQ,SUALFS + DOUBLE PRECISION SSMQCD + INTEGER IZ,ISZIZ(4) + DATA ZONE/(1.,0.)/,ZI/(0.,1.)/ +C + PI=4.*ATAN(1.) + SR2=SQRT(2.) + G=SQRT(4*PI*ALFAEM/SN2THW) + GP=G*SQRT(SN2THW/(1.-SN2THW)) + TANB=1./RV2V1 + COTB=1./TANB + BETA=ATAN(TANB) + CS2THW=1.-SN2THW + ASMB=SUALFS(AMBT**2,.36,AMTP,3) + MBMB=AMBT*(1.-4*ASMB/3./PI) + MBQ=SSMQCD(DBLE(MBMB),DBLE(AMTP)) + ASMT=SUALFS(AMTP**2,.36,AMTP,3) + MTMT=AMTP/(1.+4*ASMT/3./PI+(16.11-1.04*(5.-6.63/AMTP))* + $(ASMT/PI)**2) + MTQ=SSMQCD(DBLE(MTMT),DBLE(AMTP)) + FB=G*MBQ/SR2/AMW/COS(BETA) + FT=G*MTQ/SR2/AMW/SIN(BETA) + SINT=SIN(THETAT) + COST=COS(THETAT) + SINB=SIN(THETAB) + COSB=COS(THETAB) + ISZIZ(1)=ISZ1 + ISZIZ(2)=ISZ2 + ISZIZ(3)=ISZ3 + ISZIZ(4)=ISZ4 + XM=1./TAN(GAMMAL) + YM=1./TAN(GAMMAR) + THX=SIGN(1.,XM) + THY=SIGN(1.,YM) +C +C W decays +C + GF=1.16E-5 + GTBW=GF*AMTP**3*SSXLAM(1.,AMW**2/AMTP**2,AMBT**2/AMTP**2)* + $((1.-AMBT**2/AMTP**2)**2+AMW**2/AMTP**2*(1.+AMBT**2/AMTP**2) + $-2*AMW**4/AMTP**4)/(8.*PI*SR2) + BWQQ=3./9. + BWLL=1./9. + CALL SSSAVE(IDTP,BWQQ*GTBW,IDUP,-IDDN,IDBT,0,0) + CALL SSSAVE(IDTP,BWQQ*GTBW,IDCH,-IDST,IDBT,0,0) + CALL SSSAVE(IDTP,BWLL*GTBW,-IDE,IDNE,IDBT,0,0) + CALL SSSAVE(IDTP,BWLL*GTBW,-IDMU,IDNM,IDBT,0,0) + CALL SSSAVE(IDTP,BWLL*GTBW,-IDTAU,IDNT,IDBT,0,0) +C +C H+ decays +C + AL2=(G/2/SR2/AMW*(AMBT*TANB+AMTP*COTB))**2 + BE2=(G/2/SR2/AMW*(AMBT*TANB-AMTP*COTB))**2 + IF (AMTP.GT.(AMBT+AMHC)) THEN + GTBH=AMTP/16./PI*((AL2+BE2) + $ *(1.+AMBT**2/AMTP**2-AMHC**2/AMTP**2) + $ +2*(AL2-BE2)*AMBT/AMTP) + $ *SQRT(SSXLAM(1.,AMHC**2/AMTP**2,AMBT**2/AMTP**2)) + CALL SSSAVE(IDTP,GTBH,ISHC,IDBT,0,0,0) + END IF +C +C t->t_1 + z_i decays + DO 100 IZ=1,4 + MZIZ=ABS(AMZISS(IZ)) + SNZI=SIGN(1.,AMZISS(IZ)) + IF (SNZI.EQ.1.) THEN + THIZ=0. + ELSE + THIZ=1. + END IF + ZAUIZ=ZI**(THIZ-1.)*SNZI* + $(-G/SR2*ZMIXSS(3,IZ)-GP/3./SR2*ZMIXSS(4,IZ)) + ZBUIZ=ZI**(THIZ-1.)*4*GP*ZMIXSS(4,IZ)/3./SR2 + ZPP=ZI**THIZ + ZPM=(-ZI)**THIZ + ZA=((ZI*ZAUIZ-ZPP*FT*ZMIXSS(1,IZ))*COST- + $(ZI*ZBUIZ-ZPM*FT*ZMIXSS(1,IZ))*SINT)/2. + ZB=((-ZI*ZAUIZ-ZPP*FT*ZMIXSS(1,IZ))*COST- + $(ZI*ZBUIZ+ZPM*FT*ZMIXSS(1,IZ))*SINT)/2. + AS=ZA*CONJG(ZA) + BS=ZB*CONJG(ZB) + IF (AMTP.GT.(AMT1SS+MZIZ)) THEN + WID=(AS*((AMTP+MZIZ)**2-AMT1SS**2)+BS* + $((AMTP-MZIZ)**2-AMT1SS**2))/16./PI/AMTP* + $SQRT(SSXLAM(1.,AMT1SS**2/AMTP**2,MZIZ**2/AMTP**2)) + CALL SSSAVE(IDTP,WID,ISZIZ(IZ),ISTP1,0,0,0) + END IF +100 CONTINUE +C +C t -> sb_1 + sW_i +C + AMW1=ABS(AMW1SS) + AMW2=ABS(AMW2SS) + IF (AMTP.GT.(AMB1SS+AMW1)) THEN + SNWI=SIGN(1.,AMW1SS) + AWI=-G*SIN(GAMMAL)*COSB+FB*COS(GAMMAL)*SINB + BWI=-FT*(-SNWI)*COS(GAMMAR) + WID=AMTP*((AWI**2+BWI**2*COSB**2)*(1.+AMW1**2/AMTP**2 + $-AMB1SS**2/AMTP**2)+4*AMW1/AMTP*AWI*BWI*COST)/32./PI* + $SQRT(SSXLAM(1.,AMW1**2/AMTP**2,AMB1SS**2/AMTP**2)) + CALL SSSAVE(IDTP,WID,ISW1,ISBT1,0,0,0) + END IF +c + IF (AMTP.GT.(AMB1SS+AMW2)) THEN + SNWI=SIGN(1.,AMW2SS) + AWI=-G*THX*COS(GAMMAL)*COSB-FB*THX*SIN(GAMMAL)*SINB + BWI=FT*(-SNWI)*THY*SIN(GAMMAR) + WID=AMTP*((AWI**2+BWI**2*COSB**2)*(1.+AMW2**2/AMTP**2 + $-AMB1SS**2/AMTP**2)+4*AMW2/AMTP*AWI*BWI*COST)/32./PI* + $SQRT(SSXLAM(1.,AMW2**2/AMTP**2,AMB1SS**2/AMTP**2)) + CALL SSSAVE(IDTP,WID,ISW2,ISBT1,0,0,0) + END IF +C +C t -> sb_2 + sW_i +C + IF (AMTP.GT.(AMB2SS+AMW1)) THEN + SNWI=SIGN(1.,AMW1SS) + AWI=-G*SIN(GAMMAL)*SINB-FB*COS(GAMMAL)*COSB + BWI=-FT*(-SNWI)*COS(GAMMAR) + WID=AMTP*((AWI**2+BWI**2*SINB**2)*(1.+AMW1**2/AMTP**2 + $-AMB2SS**2/AMTP**2)+4*AMW1/AMTP*AWI*BWI*COST)/32./PI* + $SQRT(SSXLAM(1.,AMW1**2/AMTP**2,AMB2SS**2/AMTP**2)) + CALL SSSAVE(IDTP,WID,ISW1,ISBT2,0,0,0) + END IF +c + IF (AMTP.GT.(AMB2SS+AMW2)) THEN + SNWI=SIGN(1.,AMW2SS) + AWI=-G*THX*COS(GAMMAL)*SINB+FB*THX*SIN(GAMMAL)*COSB + BWI=FT*(-SNWI)*THY*SIN(GAMMAR) + WID=AMTP*((AWI**2+BWI**2*SINB**2)*(1.+AMW2**2/AMTP**2 + $-AMB2SS**2/AMTP**2)+4*AMW2/AMTP*AWI*BWI*COST)/32./PI* + $SQRT(SSXLAM(1.,AMW2**2/AMTP**2,AMB2SS**2/AMTP**2)) + CALL SSSAVE(IDTP,WID,ISW2,ISBT2,0,0,0) + END IF +C +C +C Normalize branching ratios +C + CALL SSNORM(IDTP) +C + RETURN + END diff --git a/ISAJET/isasusy/sswibf.F b/ISAJET/isasusy/sswibf.F new file mode 100644 index 00000000000..5c095911454 --- /dev/null +++ b/ISAJET/isasusy/sswibf.F @@ -0,0 +1,1140 @@ +#include "isajet/pilot.h" + SUBROUTINE SSWIBF +C----------------------------------------------------------------------- +C This subroutine calculates the chargino (wi) subset of +C SSWZBF, which was too long. +C Valid for all scalar masses (functions in double precision) +C Includes Higgs sector radiative corrections (Aug. 31) +C +C Auxiliary functions are called SSWxyi, SSZxyi, where normally +C x indicates the SUSY particle, y the SM particle(s), and i is +C a counter. +C +C Part of Baer's GAUGBF +C +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sslun.inc" +#include "isajet/ssmode.inc" +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstype.inc" +#include "isajet/sstmp.inc" +#include "isajet/sspols.inc" +C + EXTERNAL SSZWF1,SSZZF1,SSZZF2,SSZZF3,SSWZF1,SSWZF2,SSWZF3 + $,SSWZF4,SSWZF5,SSWZF6,SSWZF7,SSWWF1,SSZZF4,SSZZF5,SSGX1 + $,SSGX2,SSGX8 +C + REAL AUI(4),BUI(4),ADI(4),BDI(4),ALI(4),BLI(4),ANI(4),BNI(4) + $,WIJ(4,4),AUWI(4),ADWI(4),ANWI(4),ALWI(4),XIM(4),YIM(4) + $,XIP(4),YIP(4),SNIJ(4,4),XLIJ(4,4),HIJ(4,4) + $,V1I(4),V2I(4),V3I(4),V4I(4),XHIJ(4,4),XPIJ(4,4),AMWISS(2) +C + INTEGER ISZ(4),THJZ +C + REAL MWIW,SL,PP,SP,PL,PH,SH,COSB,SINB,COSA,SINA + $,FACTOR,MZJZ,ULIM,XINTGL,COSBE,SINBE + $,UPPER,CONST + REAL W21ZU,W21ZN,W21ZL,W21ZD,W21U,W21D,W21S,W21C,W21N1 + $,W21N2,W21N3,W21E,W21M,W21L,STHW,CTHW + REAL T3,XI2,CC,PSIINT,T2,T1,PHIINT,XI1,EF,A,Z,B + $,TANB,FB,FT,SR2,G,PI,GP,FL + $,MW2,SNW1,MW1,YM,BE,SNW2,XM,THX,THY + $,BTN,APD,APL,APU,BTD,BTL,APN,BTU,Y,MZ1,FPI + REAL TANW,COTW,XWINO,YWINO,SNIW,SNJZ + REAL SSXINT,SSXLAM + REAL WID,TERM1,TERM2,TERM3,TERM4,E,TERMH + REAL FACT,ALJZ1,ALJZ2,BEJZ1,BEJZ2 + REAL ALIW1,ALIW2,AHCJZ,BHCJZ,TERMW,TERMN,TERM12,TERMN1, + $TERMN2,TERMWN,TERMW1,TERMW2,TERMH1,TERMH2,TERMHN + REAL XIPM,YIPM,COSL,SINL,BPWI(2),BPLWI(2) + REAL BWI(2),AS,COST,SINT + REAL POLNL,POLNR,POL1L,POL1R,POL2L,POL2R,POL12L,POL12R, + $POLN1L,POLN1R,POLN2L,POLN2R + REAL ASMB,MBMB,MBQ,ASMT,MTMT,MTQ,SUALFS + REAL SUALFE,MTAMTA,MTAMB,MTAMZ,AMPL,AMPI + REAL FUDGE + DOUBLE PRECISION SSMQCD + COMPLEX ZI,ZONE,Z1(2),Z2(2) + INTEGER IW,JZ,IZ,ISZJZ,ISWIW + DATA FUDGE/1.0/,AMPI/.140/ + DATA ZONE/(1.,0.)/,ZI/(0.,1.)/,FPI/.1315/ +C +C Constants from neutralino mass matrix +C + AMPL=2.4E18 + PI=4.*ATAN(1.) + SR2=SQRT(2.) + G=SQRT(4*PI*ALFAEM/SN2THW) + GP=G*SQRT(SN2THW/(1.-SN2THW)) + E=SQRT(4*PI/128.) +C + TANW=SQRT(SN2THW/(1.-SN2THW)) + COTW=1./TANW + STHW=SQRT(SN2THW) + CTHW=SQRT(1.-SN2THW) + APL=.25*(3*TANW-COTW) + BTL=.25*(COTW+TANW) + APN=.25*(TANW+COTW) + BTN=-.25*(COTW+TANW) + APU=-5*TANW/12.+COTW/4. + BTU=-.25*(COTW+TANW) + APD=-COTW/4.+TANW/12. + BTD=.25*(COTW+TANW) +C + TANB=1./RV2V1 + BE=ATAN(1./RV2V1) + SINBE=SIN(BE) + COSBE=COS(BE) + XM=1./TAN(GAMMAL) + YM=1./TAN(GAMMAR) + THX=SIGN(1.,XM) + THY=SIGN(1.,YM) + ASMB=SUALFS(AMBT**2,.36,AMTP,3) + MBMB=AMBT*(1.-4*ASMB/3./PI) + MBQ=SSMQCD(DBLE(MBMB),DBLE(AMTP)) + ASMT=SUALFS(AMTP**2,.36,AMTP,3) + MTMT=AMTP/(1.+4*ASMT/3./PI+(16.11-1.04*(5.-6.63/AMTP))* + $(ASMT/PI)**2) + MTQ=SSMQCD(DBLE(MTMT),DBLE(AMTP)) + FB=G*MBQ/SR2/AMW/COS(BE) + FT=G*MTQ/SR2/AMW/SIN(BE) + MTAMTA=AMTAU*(1.-SUALFE(AMTAU**2)/PI) + MTAMB=MTAMTA*(SUALFE(AMBT**2)/SUALFE(AMTAU**2))**(-27./76.) + MTAMZ=MTAMB*(SUALFE(AMZ**2)/SUALFE(AMBT**2))**(-27./80.) + FL=G*MTAMZ/SR2/AMW/COS(BE) + SNW1=SIGN(1.,AMW1SS) + SNW2=SIGN(1.,AMW2SS) + AMWISS(1)=AMW1SS + AMWISS(2)=AMW2SS + BWI(1)=-FT*SNW1*COS(GAMMAR) + BWI(2)=FT*SNW2*THY*SIN(GAMMAR) + BPWI(1)=-FB*COS(GAMMAL) + BPWI(2)=FB*THX*SIN(GAMMAL) + BPLWI(1)=-FL*COS(GAMMAL) + BPLWI(2)=FL*THX*SIN(GAMMAL) + MW1=ABS(AMW1SS) + MW2=ABS(AMW2SS) + MZ1=ABS(AMZ1SS) + XWINO=.5*(THX*SIN(GAMMAL)*COS(GAMMAL) + $-THY*SIN(GAMMAR)*COS(GAMMAR)) + YWINO=.5*(THX*SIN(GAMMAL)*COS(GAMMAL) + $+THY*SIN(GAMMAR)*COS(GAMMAR)) + COST=COS(THETAT) + SINT=SIN(THETAT) + COSB=COS(THETAB) + SINB=SIN(THETAB) + COSL=COS(THETAL) + SINL=SIN(THETAL) +C +C Constants from Higgs mass matrix +C + SINA=SIN(ALFAH) + COSA=COS(ALFAH) +C +C Gaugino couplings +C + DO 100 IZ=1,4 + AUI(IZ)=G/SR2*ZMIXSS(3,IZ)+GP/3./SR2*ZMIXSS(4,IZ) + BUI(IZ)=4.*GP/3./SR2*ZMIXSS(4,IZ) + ADI(IZ)=-G/SR2*ZMIXSS(3,IZ)+GP/3./SR2*ZMIXSS(4,IZ) + BDI(IZ)=-2.*GP/3./SR2*ZMIXSS(4,IZ) + ALI(IZ)=G/SR2*ZMIXSS(3,IZ)+GP/SR2*ZMIXSS(4,IZ) + BLI(IZ)=-SR2*GP*ZMIXSS(4,IZ) + ANI(IZ)=G/SR2*ZMIXSS(3,IZ)-GP/SR2*ZMIXSS(4,IZ) + BNI(IZ)=0.0 +100 CONTINUE +C + DO 110 IZ=1,4 + DO 110 JZ=1,4 + IF(IZ.LT.JZ) THEN + WIJ(IZ,JZ)=SQRT(G**2+GP**2) + $ *(ZMIXSS(1,IZ)*ZMIXSS(1,JZ)-ZMIXSS(2,IZ)*ZMIXSS(2,JZ))/4. + ELSEIF(IZ.GT.JZ) THEN + WIJ(IZ,JZ)=-SQRT(G**2+GP**2) + $ *(ZMIXSS(1,IZ)*ZMIXSS(1,JZ)-ZMIXSS(2,IZ)*ZMIXSS(2,JZ))/4. + ENDIF +110 CONTINUE +C + AUWI(2)=G*THX*COS(GAMMAL) + ADWI(2)=SNW2*G*THY*COS(GAMMAR) + ALWI(2)=ADWI(2) + ANWI(2)=AUWI(2) + AUWI(1)=G*SIN(GAMMAL) + ADWI(1)=SNW1*G*SIN(GAMMAR) + ALWI(1)=ADWI(1) + ANWI(1)=AUWI(1) +C + DO 120 IZ=1,4 + XIM(IZ)=.5*(SNW1*SIGN(1.,AMZISS(IZ))*(COS(GAMMAR) + $ *ZMIXSS(1,IZ)/SR2+SIN(GAMMAR)*ZMIXSS(3,IZ))-COS(GAMMAL) + $ *ZMIXSS(2,IZ)/SR2+SIN(GAMMAL)*ZMIXSS(3,IZ)) + YIM(IZ)=.5*(-SNW1*SIGN(1.,AMZISS(IZ))*(COS(GAMMAR) + $ *ZMIXSS(1,IZ)/SR2+SIN(GAMMAR)*ZMIXSS(3,IZ))-COS(GAMMAL) + $ *ZMIXSS(2,IZ)/SR2+SIN(GAMMAL)*ZMIXSS(3,IZ)) + XIP(IZ)=.5*(SNW2*SIGN(1.,AMZISS(IZ))*THY*(-SIN(GAMMAR) + $ *ZMIXSS(1,IZ)/SR2+COS(GAMMAR)*ZMIXSS(3,IZ))+THX*(SIN(GAMMAL) + $ *ZMIXSS(2,IZ)/SR2+COS(GAMMAL)*ZMIXSS(3,IZ))) + YIP(IZ)=.5*(-SNW2*SIGN(1.,AMZISS(IZ))*THY*(-SIN(GAMMAR) + $ *ZMIXSS(1,IZ)/SR2+COS(GAMMAR)*ZMIXSS(3,IZ))+THX*(SIN(GAMMAL) + $ *ZMIXSS(2,IZ)/SR2+COS(GAMMAL)*ZMIXSS(3,IZ))) +120 CONTINUE +C + DO 130 IZ=1,4 + DO 130 JZ=1,4 + IF(IZ.NE.JZ) THEN + SNIJ(IZ,JZ)=-1.*SIGN(1.,AMZISS(IZ))*SIGN(1.,AMZISS(JZ)) + XLIJ(IZ,JZ)=-SIGN(1.,AMZISS(IZ))*SIGN(1.,AMZISS(JZ)) + $ *(ZMIXSS(2,IZ)*SINA-ZMIXSS(1,IZ)*COSA) + $ *(G*ZMIXSS(3,JZ)-GP*ZMIXSS(4,JZ))/2. + XHIJ(IZ,JZ)=-SIGN(1.,AMZISS(IZ))*SIGN(1.,AMZISS(JZ)) + $ *(ZMIXSS(2,IZ)*COSA+ZMIXSS(1,IZ)*SINA) + $ *(G*ZMIXSS(3,JZ)-GP*ZMIXSS(4,JZ))/2. + XPIJ(IZ,JZ)=SIGN(1.,AMZISS(IZ))*SIGN(1.,AMZISS(JZ)) + $ *(ZMIXSS(2,IZ)*SINBE-ZMIXSS(1,IZ)*COSBE) + $ *(G*ZMIXSS(3,JZ)-GP*ZMIXSS(4,JZ))/2. + HIJ(IZ,JZ)=-SIGN(1.,AMZISS(IZ))*SIGN(1.,AMZISS(JZ)) + $ *(ZMIXSS(2,IZ)*COSA+ZMIXSS(1,IZ)*SINA) + $ *(G*ZMIXSS(3,JZ)-GP*ZMIXSS(4,JZ))/2. + ENDIF +130 CONTINUE +C + SP=-.5*(-THY*SNW2*COSBE*SIN(GAMMAL)*SIN(GAMMAR)+ + $THY*SNW2*SINBE*COS(GAMMAL)*COS(GAMMAR)- + $THX*SNW1*COSBE*COS(GAMMAL)*COS(GAMMAR)+ + $THX*SNW1*SINBE*SIN(GAMMAL)*SIN(GAMMAR)) + PP=-.5*(-THY*SNW2*COSBE*SIN(GAMMAL)*SIN(GAMMAR)+ + $THY*SNW2*SINBE*COS(GAMMAL)*COS(GAMMAR)+ + $THX*SNW1*COSBE*COS(GAMMAL)*COS(GAMMAR)- + $THX*SNW1*SINBE*SIN(GAMMAL)*SIN(GAMMAR)) +C + SL=.5*(THY*SNW2*SINA*COS(GAMMAL)*COS(GAMMAR)- + $THY*SNW2*COSA*SIN(GAMMAL)*SIN(GAMMAR)+ + $THX*SNW1*COSA*COS(GAMMAL)*COS(GAMMAR)- + $THX*SNW1*SINA*SIN(GAMMAL)*SIN(GAMMAR)) + PL=.5*(THY*SNW2*SINA*COS(GAMMAL)*COS(GAMMAR)- + $THY*SNW2*COSA*SIN(GAMMAL)*SIN(GAMMAR)- + $THX*SNW1*COSA*COS(GAMMAL)*COS(GAMMAR)+ + $THX*SNW1*SINA*SIN(GAMMAL)*SIN(GAMMAR)) +C + SH=.5*(THY*SNW2*COSA*COS(GAMMAL)*COS(GAMMAR)+ + $THY*SNW2*SINA*SIN(GAMMAL)*SIN(GAMMAR)- + $THX*SNW1*SINA*COS(GAMMAL)*COS(GAMMAR)- + $THX*SNW1*COSA*SIN(GAMMAL)*SIN(GAMMAR)) + PH=.5*(THY*SNW2*COSA*COS(GAMMAL)*COS(GAMMAR)+ + $THY*SNW2*SINA*SIN(GAMMAL)*SIN(GAMMAR)+ + $THX*SNW1*SINA*COS(GAMMAL)*COS(GAMMAR)+ + $THX*SNW1*COSA*SIN(GAMMAL)*SIN(GAMMAR)) +C + DO 140 IZ=1,4 + V1I(IZ)=-SIN(GAMMAR)/SR2*(G*ZMIXSS(3,IZ)+GP*ZMIXSS(4,IZ)) + $ -G*COS(GAMMAR)*ZMIXSS(1,IZ) + V2I(IZ)=COS(GAMMAR)/SR2*(G*ZMIXSS(3,IZ)+GP*ZMIXSS(4,IZ)) + $ -G*SIN(GAMMAR)*ZMIXSS(1,IZ) + V3I(IZ)=-SIN(GAMMAL)/SR2*(G*ZMIXSS(3,IZ)+GP*ZMIXSS(4,IZ)) + $ +G*COS(GAMMAL)*ZMIXSS(2,IZ) + V4I(IZ)=COS(GAMMAL)/SR2*(G*ZMIXSS(3,IZ)+GP*ZMIXSS(4,IZ)) + $ +G*SIN(GAMMAL)*ZMIXSS(2,IZ) +140 CONTINUE +C +C----------------------------------------------------------------------- +C Generate Chargino Branching Fractions +C----------------------------------------------------------------------- + ISZ(1)=ISZ1 + ISZ(2)=ISZ2 + ISZ(3)=ISZ3 + ISZ(4)=ISZ4 +C FIRST TRY EXCLUSIVE DECAY TO SINGLE PION + IF (MW1.GT.(MZ1+AMPI).AND.MW1.LT.(MZ1+1.)) THEN + WID=G**4*FPI**2*SQRT(SSXLAM(MW1**2,MZ1**2,AMPI**2))/ + $ 128./MW1**3/PI/AMW**4*((XIM(1)**2+YIM(1)**2)* + $ (MW1-MZ1)**2*(MW1+MZ1)**2-AMPI**2*(XIM(1)**2*(MW1-MZ1)**2+ + $ YIM(1)**2*(MW1+MZ1)**2)) + CALL SSSAVE(ISW1,WID,ISZ(1),120,0,0,0) + END IF + DO 300 IW=1,2 +C Loop over w1, w2 + IF(IW.EQ.1) THEN + MWIW=MW1 + SNIW=SNW1 + ISWIW=ISW1 + ELSE + MWIW=MW2 + SNIW=SNW2 + ISWIW=ISW2 + ENDIF +C +C Decays to zj +C + DO 310 JZ=1,4 + MZJZ=ABS(AMZISS(JZ)) + ISZJZ=ISZ(JZ) + SNJZ=SIGN(1.,AMZISS(JZ)) + THJZ=0. + IF (AMZISS(JZ).LT.0.) THJZ=1. + IF(MWIW.LE.FUDGE*MZJZ) GOTO 310 +C Couplings + IF(IW.EQ.1) THEN + XIPM=XIM(JZ) + YIPM=YIM(JZ) + ELSE + XIPM=XIP(JZ) + YIPM=YIP(JZ) + ENDIF +C +C wi --> f + fbar + zj +C + IF (MWIW.GT.(MZJZ+AMUP+AMDN)) THEN + IF (IW.EQ.1.AND.JZ.EQ.1.AND.(MW1.LT.(MZ1+1.))) THEN +C EXIT HADRONIC MODE IF EXCLUSIVE PION DECAY ACTIVE + GO TO 200 + END IF + IF (MWIW.LT.(AMW+MZJZ)) THEN + TMP(1)=XIPM**2+YIPM**2 + TMP(2)=XIPM**2-YIPM**2 + TMP(3)=MWIW + TMP(4)=MZJZ + TERM1=SSXINT(MZJZ,SSWZF1,(MWIW**2+MZJZ**2)/2./MWIW)/ + $ 2./MWIW/(2*PI)**5*2*G**4*PI**2/3. + ELSE + TERM1=0. + END IF + ULIM=MWIW/2.*(1.-MZJZ**2/MWIW**2) + TMP(1)=MWIW + TMP(3)=MZJZ + IF (MWIW.LT.AMULSS) THEN + TMP(2)=AMULSS + PSIINT=SSXINT(0.,SSWZF2,ULIM) + T1=AUI(JZ)**2*ADWI(IW)**2*PSIINT + ELSE + T1=0. + END IF + IF (MWIW.LT.AMDLSS) THEN + TMP(2)=AMDLSS + PSIINT=SSXINT(0.,SSWZF2,ULIM) + T2=ADI(JZ)**2*AUWI(IW)**2*PSIINT + ELSE + T2=0. + END IF + IF (MWIW.LT.AMDLSS.AND.MWIW.LT.AMULSS) THEN + TMP(2)=0. + TMP(4)=AMDLSS + TMP(5)=AMULSS + PHIINT=SSXINT(0.,SSGX2,ULIM) + CC=2*SIGN(1.,AMZISS(JZ))*AUWI(IW)*ADWI(IW)*AUI(JZ)*ADI(JZ) + T3=CC*PHIINT + ELSE + T3=0. + END IF + TERM2=(T1+T2+T3)/2./MWIW/(2*PI)**5 + FACTOR=1./2./MWIW/(2*PI)**5*2*SR2*G**2 + TMP(1)=MWIW + TMP(3)=MZJZ + IF (MWIW.LT.(MZJZ+AMW).AND.MWIW.LT.AMULSS) THEN + TMP(2)=AMULSS + XI1=SSXINT(0.,SSWZF4,(MWIW-MZJZ)**2) + XI2=SSXINT(0.,SSWZF5,(MWIW-MZJZ)**2) + TERM3=FACTOR*ADWI(IW)*AUI(JZ)*((XIPM-YIPM)*XI1 + $ -(XIPM+YIPM)*XI2)*SIGN(1.,AMZISS(JZ)) + ELSE + TERM3=0. + END IF + IF (MWIW.LT.(MZJZ+AMW).AND.MWIW.LT.AMDLSS) THEN + TMP(2)=AMDLSS + XI1=SSXINT(0.,SSWZF4,(MWIW-MZJZ)**2) + XI2=SSXINT(0.,SSWZF5,(MWIW-MZJZ)**2) + TERM4=-FACTOR*AUWI(IW)*ADI(JZ)*((XIPM+YIPM)*XI1 + $ -(XIPM-YIPM)*XI2) + ELSE + TERM4=0. + END IF + WID=3*(TERM1+TERM2+TERM3+TERM4) + CALL SSSAVE(ISWIW,WID,ISZJZ,IDUP,-IDDN,0,0) +C Enter information for decay matrix element + Z1(1)=ZI**THJZ*G*XIPM + Z1(2)=ZI**THJZ*G*YIPM + Z2(1)=G/2./SR2 + Z2(2)=-G/2./SR2 + CALL SSME3(1,AMW,Z1,Z2) + Z1(1)=ZI*AUWI(IW)/2. + Z1(2)=Z1(1) + Z2(1)=-CONJG(ZI**(THJZ-1)*(-1.)**(THJZ+1)*ADI(JZ))/2. + Z2(2)=-Z2(1) + CALL SSME3(2,AMDLSS,Z1,Z2) + Z1(1)=CONJG(ZI*ADWI(IW))/2. + Z1(2)=-Z1(1) + Z2(1)=ZI**(THJZ-1)*(-1.)**(THJZ+1)*AUI(JZ)/2. + Z2(2)=Z2(1) + CALL SSME3(3,AMULSS,Z1,Z2) + END IF +C wi --> c + sbar + zj +200 IF (MWIW.GT.(MZJZ+AMCH+AMST)) THEN + IF (MWIW.LT.(AMW+MZJZ)) THEN + TMP(1)=XIPM**2+YIPM**2 + TMP(2)=XIPM**2-YIPM**2 + TMP(3)=MWIW + TMP(4)=MZJZ + TERM1=SSXINT(MZJZ,SSWZF1,(MWIW**2+MZJZ**2)/2./MWIW)/ + $ 2./MWIW/(2*PI)**5*2*G**4*PI**2/3. + ELSE + TERM1=0. + END IF + ULIM=MWIW/2.*(1.-MZJZ**2/MWIW**2) + TMP(1)=MWIW + TMP(3)=MZJZ + IF (MWIW.LT.AMCLSS) THEN + TMP(2)=AMCLSS + PSIINT=SSXINT(0.,SSWZF2,ULIM) + T1=AUI(JZ)**2*ADWI(IW)**2*PSIINT + ELSE + T1=0. + END IF + IF (MWIW.LT.AMSLSS) THEN + TMP(2)=AMSLSS + PSIINT=SSXINT(0.,SSWZF2,ULIM) + T2=ADI(JZ)**2*AUWI(IW)**2*PSIINT + ELSE + T2=0. + END IF + IF (MWIW.LT.AMSLSS.AND.MWIW.LT.AMCLSS) THEN + TMP(2)=0. + TMP(4)=AMSLSS + TMP(5)=AMCLSS + PHIINT=SSXINT(0.,SSGX2,ULIM) + CC=2*SIGN(1.,AMZISS(JZ))*AUWI(IW)*ADWI(IW)*AUI(JZ)*ADI(JZ) + T3=CC*PHIINT + ELSE + T3=0. + END IF + TERM2=(T1+T2+T3)/2./MWIW/(2*PI)**5 + FACTOR=1./2./MWIW/(2*PI)**5*2*SR2*G**2 + TMP(1)=MWIW + TMP(3)=MZJZ + IF (MWIW.LT.(MZJZ+AMW).AND.MWIW.LT.AMCLSS) THEN + TMP(2)=AMCLSS + XI1=SSXINT(0.,SSWZF4,(MWIW-MZJZ)**2) + XI2=SSXINT(0.,SSWZF5,(MWIW-MZJZ)**2) + TERM3=FACTOR*ADWI(IW)*AUI(JZ)*((XIPM-YIPM)*XI1 + $ -(XIPM+YIPM)*XI2)*SIGN(1.,AMZISS(JZ)) + ELSE + TERM3=0. + END IF + IF (MWIW.LT.(MZJZ+AMW).AND.MWIW.LT.AMSLSS) THEN + TMP(2)=AMSLSS + XI1=SSXINT(0.,SSWZF4,(MWIW-MZJZ)**2) + XI2=SSXINT(0.,SSWZF5,(MWIW-MZJZ)**2) + TERM4=-FACTOR*AUWI(IW)*ADI(JZ)*((XIPM+YIPM)*XI1 + $ -(XIPM-YIPM)*XI2) + ELSE + TERM4=0. + END IF + WID=3*(TERM1+TERM2+TERM3+TERM4) + CALL SSSAVE(ISWIW,WID,ISZJZ,IDCH,-IDST,0,0) +C Enter information for decay matrix element + Z1(1)=ZI**THJZ*G*XIPM + Z1(2)=ZI**THJZ*G*YIPM + Z2(1)=G/2./SR2 + Z2(2)=-G/2./SR2 + CALL SSME3(1,AMW,Z1,Z2) + Z1(1)=ZI*AUWI(IW)/2. + Z1(2)=Z1(1) + Z2(1)=-CONJG(ZI**(THJZ-1)*(-1.)**(THJZ+1)*ADI(JZ))/2. + Z2(2)=-Z2(1) + CALL SSME3(2,AMSLSS,Z1,Z2) + Z1(1)=CONJG(ZI*ADWI(IW))/2. + Z1(2)=-Z1(1) + Z2(1)=ZI**(THJZ-1)*(-1.)**(THJZ+1)*AUI(JZ)/2. + Z2(2)=Z2(1) + CALL SSME3(3,AMCLSS,Z1,Z2) + END IF +C wi -> t + bbar + zj neglected since 2-body modes should dominate +C wi --> nu_e + e + zj + IF (MWIW.GT.(MZJZ+AME)) THEN + IF (MWIW.LT.(AMW+MZJZ)) THEN + TMP(1)=XIPM**2+YIPM**2 + TMP(2)=XIPM**2-YIPM**2 + TMP(3)=MWIW + TMP(4)=MZJZ + TERM1=SSXINT(MZJZ,SSWZF1,(MWIW**2+MZJZ**2)/2./MWIW)/ + $ 2./MWIW/(2*PI)**5*2*G**4*PI**2/3. + ELSE + TERM1=0. + END IF + ULIM=MWIW/2.*(1.-MZJZ**2/MWIW**2) + TMP(1)=MWIW + TMP(3)=MZJZ + IF (MWIW.LT.AMN1SS) THEN + TMP(2)=AMN1SS + T1=ANI(JZ)**2*ALWI(IW)**2*SSXINT(0.,SSWZF2,ULIM) + ELSE + T1=0. + END IF + IF (MWIW.LT.AMELSS) THEN + TMP(2)=AMELSS + T2=ALI(JZ)**2*ANWI(IW)**2*SSXINT(0.,SSWZF2,ULIM) + ELSE + T2=0. + END IF + IF (MWIW.LT.AMELSS.AND.MWIW.LT.AMN1SS) THEN + TMP(2)=0. + TMP(4)=AMELSS + TMP(5)=AMN1SS + T3=-2*SIGN(1.,AMZISS(JZ))*ANWI(IW)*ALWI(IW)*ANI(JZ)* + $ ALI(JZ)*SSXINT(0.,SSGX2,ULIM) + ELSE + T3=0. + END IF + TERM2=(T1+T2+T3)/2./MWIW/(2*PI)**5 + FACTOR=1./2./MWIW/(2*PI)**5*2*SR2*G**2 + TMP(1)=MWIW + TMP(3)=MZJZ + IF (MWIW.LT.(MZJZ+AMW).AND.MWIW.LT.AMN1SS) THEN + TMP(2)=AMN1SS + XI1=SSXINT(0.,SSWZF4,(MWIW-MZJZ)**2) + XI2=SSXINT(0.,SSWZF5,(MWIW-MZJZ)**2) + TERM3=FACTOR*ALWI(IW)*ANI(JZ)*((XIPM-YIPM)*XI1 + $ -(XIPM+YIPM)*XI2)*SIGN(1.,AMZISS(JZ)) + ELSE + TERM3=0. + END IF + IF (MWIW.LT.(MZJZ+AMW).AND.MWIW.LT.AMELSS) THEN + TMP(2)=AMELSS + XI1=SSXINT(0.,SSWZF4,(MWIW-MZJZ)**2) + XI2=SSXINT(0.,SSWZF5,(MWIW-MZJZ)**2) + TERM4=FACTOR*ANWI(IW)*ALI(JZ)*((XIPM+YIPM)*XI1 + $ -(XIPM-YIPM)*XI2) + ELSE + TERM4=0. + END IF + WID=TERM1+TERM2+TERM3+TERM4 + CALL SSSAVE(ISWIW,WID,ISZJZ,-IDE,IDNE,0,0) +C Enter information for decay matrix element + Z1(1)=ZI**THJZ*G*XIPM + Z1(2)=ZI**THJZ*G*YIPM + Z2(1)=G/2./SR2 + Z2(2)=-G/2./SR2 + CALL SSME3(1,AMW,Z1,Z2) + Z1(1)=ZI*ANWI(IW)/2. + Z1(2)=Z1(1) + Z2(1)=-CONJG(ZI**(THJZ-1)*(-1.)**(THJZ+1)*ALI(JZ))/2. + Z2(2)=-Z2(1) + CALL SSME3(2,AMELSS,Z1,Z2) + Z1(1)=CONJG(ZI*ALWI(IW))/2. + Z1(2)=-Z1(1) + Z2(1)=ZI**(THJZ-1)*(-1.)**(THJZ+1)*ANI(JZ)/2. + Z2(2)=Z2(1) + CALL SSME3(3,AMN1SS,Z1,Z2) + END IF +C wi --> nu_mu + mu + zj + IF (MWIW.GT.(MZJZ+AMMU)) THEN + IF (MWIW.LT.(AMW+MZJZ)) THEN + TMP(1)=XIPM**2+YIPM**2 + TMP(2)=XIPM**2-YIPM**2 + TMP(3)=MWIW + TMP(4)=MZJZ + TERM1=SSXINT(MZJZ,SSWZF1,(MWIW**2+MZJZ**2)/2./MWIW)/ + $ 2./MWIW/(2*PI)**5*2*G**4*PI**2/3. + ELSE + TERM1=0. + END IF + ULIM=MWIW/2.*(1.-MZJZ**2/MWIW**2) + TMP(1)=MWIW + TMP(3)=MZJZ + IF (MWIW.LT.AMN2SS) THEN + TMP(2)=AMN2SS + T1=ANI(JZ)**2*ALWI(IW)**2*SSXINT(0.,SSWZF2,ULIM) + ELSE + T1=0. + END IF + IF (MWIW.LT.AMMLSS) THEN + TMP(2)=AMMLSS + T2=ALI(JZ)**2*ANWI(IW)**2*SSXINT(0.,SSWZF2,ULIM) + ELSE + T2=0. + END IF + IF (MWIW.LT.AMMLSS.AND.MWIW.LT.AMN2SS) THEN + TMP(2)=0. + TMP(4)=AMMLSS + TMP(5)=AMN2SS + T3=-2*SIGN(1.,AMZISS(JZ))*ANWI(IW)*ALWI(IW)*ANI(JZ)* + $ ALI(JZ)*SSXINT(0.,SSGX2,ULIM) + ELSE + T3=0. + END IF + TERM2=(T1+T2+T3)/2./MWIW/(2*PI)**5 + FACTOR=1./2./MWIW/(2*PI)**5*2*SR2*G**2 + TMP(1)=MWIW + TMP(3)=MZJZ + IF (MWIW.LT.(MZJZ+AMW).AND.MWIW.LT.AMN2SS) THEN + TMP(2)=AMN2SS + XI1=SSXINT(0.,SSWZF4,(MWIW-MZJZ)**2) + XI2=SSXINT(0.,SSWZF5,(MWIW-MZJZ)**2) + TERM3=FACTOR*ALWI(IW)*ANI(JZ)*((XIPM-YIPM)*XI1 + $ -(XIPM+YIPM)*XI2)*SIGN(1.,AMZISS(JZ)) + ELSE + TERM3=0. + END IF + IF (MWIW.LT.(MZJZ+AMW).AND.MWIW.LT.AMMLSS) THEN + TMP(2)=AMMLSS + XI1=SSXINT(0.,SSWZF4,(MWIW-MZJZ)**2) + XI2=SSXINT(0.,SSWZF5,(MWIW-MZJZ)**2) + TERM4=FACTOR*ANWI(IW)*ALI(JZ)*((XIPM+YIPM)*XI1 + $ -(XIPM-YIPM)*XI2) + ELSE + TERM4=0. + END IF + WID=TERM1+TERM2+TERM3+TERM4 + CALL SSSAVE(ISWIW,WID,ISZJZ,-IDMU,IDNM,0,0) +C Enter information for decay matrix element + Z1(1)=ZI**THJZ*G*XIPM + Z1(2)=ZI**THJZ*G*YIPM + Z2(1)=G/2./SR2 + Z2(2)=-G/2./SR2 + CALL SSME3(1,AMW,Z1,Z2) + Z1(1)=ZI*ANWI(IW)/2. + Z1(2)=Z1(1) + Z2(1)=-CONJG(ZI**(THJZ-1)*(-1.)**(THJZ+1)*ALI(JZ))/2. + Z2(2)=-Z2(1) + CALL SSME3(2,AMMLSS,Z1,Z2) + Z1(1)=CONJG(ZI*ALWI(IW))/2. + Z1(2)=-Z1(1) + Z2(1)=ZI**(THJZ-1)*(-1.)**(THJZ+1)*ANI(JZ)/2. + Z2(2)=Z2(1) + CALL SSME3(3,AMN2SS,Z1,Z2) + END IF +C wi --> nu_tau + tau + zj ; includes mixing and Yukawas + FACT=1./2./MWIW/(2*PI)**5 + ALJZ1=-ALI(JZ)*COSL-FL*ZMIXSS(2,JZ)*SINL + ALJZ2=-ALI(JZ)*SINL+FL*ZMIXSS(2,JZ)*COSL + BEJZ1=BLI(JZ)*SINL+FL*ZMIXSS(2,JZ)*COSL + BEJZ2=-BLI(JZ)*COSL+FL*ZMIXSS(2,JZ)*SINL + SNJZ=SIGN(1.,AMZISS(JZ)) +C Change ALWI def'ns in accord with Drees note + ALWI(1)=-G*SIN(GAMMAR) + ALWI(2)=-G*THY*COS(GAMMAR) +C Polarization for stau_1 -> z1ss+tau. +C See above for other cases. + IF(IW.EQ.1.AND.JZ.EQ.1) THEN + PTAU1(JZ)=(BEJZ1**2-ALJZ1**2)/(BEJZ1**2+ALJZ1**2) + PTAU2(JZ)=(BEJZ2**2-ALJZ2**2)/(BEJZ2**2+ALJZ2**2) + ENDIF + IF (IW.EQ.1) THEN + ALIW1=-G*SIN(GAMMAL)*COSL+FL*COS(GAMMAL)*SINL + ALIW2=-G*SIN(GAMMAL)*SINL-FL*COS(GAMMAL)*COSL + AHCJZ=COSBE*V2I(JZ) + BHCJZ=-SINBE*V4I(JZ) + ELSE IF (IW.EQ.2) THEN + ALIW1=(-G*COS(GAMMAL)*COSL-FL*SIN(GAMMAL)*SINL)*THX + ALIW2=(-G*COS(GAMMAL)*SINL+FL*SIN(GAMMAL)*COSL)*THX + AHCJZ=COSBE*V1I(JZ)*THY + BHCJZ=-SINBE*V3I(JZ)*THX + END IF + IF (MWIW.GT.(MZJZ+AMTAU)) THEN + IF (MWIW.LT.(AMW+MZJZ)) THEN + TMP(1)=XIPM**2+YIPM**2 + TMP(2)=XIPM**2-YIPM**2 + TMP(3)=MWIW + TMP(4)=MZJZ + TERMW=SSXINT(MZJZ,SSWZF1,(MWIW**2+MZJZ**2)/2./MWIW)* + $ FACT*2*G**4*PI**2/3. + ELSE + TERMW=0. + END IF + ULIM=(MWIW**2-MZJZ**2)/2./MWIW + TMP(1)=MWIW + TMP(3)=MZJZ + IF (MWIW.LT.AMN3SS) THEN + TMP(2)=AMN3SS + POLNL=FACT*ANI(JZ)**2*ALWI(IW)**2* + $ SSXINT(0.,SSWZF2,ULIM) + POLNR=POLNL*BPLWI(IW)**2/ALWI(IW)**2 + TERMN=POLNL+POLNR + ELSE + POLNL=0. + POLNR=0. + TERMN=0. + END IF + IF (MWIW.LT.AML1SS) THEN + TMP(2)=AML1SS + POL1L=FACT*ALJZ1**2*ALIW1**2*SSXINT(0.,SSWZF2,ULIM) + POL1R=POL1L*BEJZ1**2/ALJZ1**2 + TERM1=POL1L+POL1R + ELSE + POL1L=0. + POL1R=0. + TERM1=0. + END IF + IF (MWIW.LT.AML2SS) THEN + TMP(2)=AML2SS + POL2L=FACT*ALJZ2**2*ALIW2**2*SSXINT(0.,SSWZF2,ULIM) + POL2R=POL2L*BEJZ2**2/ALJZ2**2 + TERM2=POL2L+POL2R + ELSE + POL2L=0. + POL2R=0. + TERM2=0. + END IF + IF (MWIW.LT.AML1SS) THEN + TMP(2)=0. + TMP(3)=MZJZ + TMP(4)=AML1SS + TMP(5)=AML2SS + POL12L=FACT*2*ALIW1*ALIW2*ALJZ1*ALJZ2* + $ SSXINT(0.,SSGX1,ULIM) + POL12R=POL12L*BEJZ1*BEJZ2/ALJZ1/ALJZ2 + TERM12=POL12L+POL12R + ELSE + POL12L=0. + POL12R=0. + TERM12=0. + END IF + IF (MWIW.LT.(AMHC+MZJZ)) THEN + TMP(2)=AMHC + TMP(3)=MZJZ + TMP(4)=AHCJZ + TMP(5)=BHCJZ + TMP(6)=SIGN(1.,AMZISS(JZ))*SIGN(1.,AMWISS(IW)) + TERMH=FACT*PI**2*MWIW*(G*MTAMZ*TANB/AMW)**2/2.* + $ SSXINT(MZJZ,SSWZF6,(MWIW**2+MZJZ**2)/2./MWIW) + ELSE + TERMH=0. + END IF + IF (MWIW.LT.AML1SS.AND.MWIW.LT.AMN3SS) THEN + TMP(2)=0. + TMP(3)=MZJZ + TMP(4)=AMN3SS + TMP(5)=AML1SS + POLN1L=+2*FACT*ANI(JZ)*ALIW1*SNJZ*SNIW*ALWI(IW)* + $ ALJZ1*SSXINT(0.,SSGX2,ULIM) + POLN1R=-2*FACT*ANI(JZ)*ALIW1*BPLWI(IW)*BEJZ1* + $ SSXINT(0.,SSGX8,ULIM) + TERMN1=POLN1L+POLN1R + ELSE + POLN1L=0. + POLN1R=0. + TERMN1=0. + END IF + IF (MWIW.LT.AML2SS.AND.MWIW.LT.AMN3SS) THEN + TMP(2)=0. + TMP(3)=MZJZ + TMP(4)=AMN3SS + TMP(5)=AML2SS + POLN2L=+2*FACT*ANI(JZ)*ALIW2*SNJZ*SNIW*ALWI(IW)*ALJZ2* + $ SSXINT(0.,SSGX2,ULIM) + POLN2R=-2*FACT*ANI(JZ)*ALIW2*BPLWI(IW)*BEJZ2* + $ SSXINT(0.,SSGX8,ULIM) + TERMN2=POLN2L+POLN2R + ELSE + POLN2L=0. + POLN2R=0. + TERMN2=0. + END IF + TMP(1)=MWIW + TMP(3)=MZJZ + IF (MWIW.LT.(MZJZ+AMW).AND.MWIW.LT.AMN3SS) THEN + TMP(2)=AMN3SS + XI1=SSXINT(0.,SSWZF4,(MWIW-MZJZ)**2) + XI2=SSXINT(0.,SSWZF5,(MWIW-MZJZ)**2) + TERMWN=2*SR2*G**2*FACT*ALWI(IW)*ANI(JZ)*((XIPM- + $ YIPM)*XI1-(XIPM+YIPM)*XI2)*SIGN(1.,AMZISS(JZ)) + ELSE + TERMWN=0. + END IF + IF (MWIW.LT.(MZJZ+AMW).AND.MWIW.LT.AML1SS) THEN + TMP(2)=AML1SS + XI1=SSXINT(0.,SSWZF4,(MWIW-MZJZ)**2) + XI2=SSXINT(0.,SSWZF5,(MWIW-MZJZ)**2) + TERMW1=2*SR2*G**2*FACT*ALIW1*ALJZ1* + $ ((XIPM+YIPM)*XI1-(XIPM-YIPM)*XI2) + ELSE + TERMW1=0. + END IF + IF (MWIW.LT.(MZJZ+AMW).AND.MWIW.LT.AML2SS) THEN + TMP(2)=AML2SS + XI1=SSXINT(0.,SSWZF4,(MWIW-MZJZ)**2) + XI2=SSXINT(0.,SSWZF5,(MWIW-MZJZ)**2) + TERMW2=2*SR2*G**2*FACT*ALIW2*ALJZ2* + $ ((XIPM+YIPM)*XI1-(XIPM-YIPM)*XI2) + ELSE + TERMW2=0. + END IF + TMP(2)=MZJZ + TMP(3)=AMHC + TMP(5)=AHCJZ + TMP(6)=BHCJZ + TMP(7)=SNJZ*SNIW + IF (MWIW.LT.(AMHC+MZJZ).AND.MWIW.LT.AML1SS) THEN + TMP(4)=AML1SS + TERMH1=PI**2/2./MWIW*FACT*SR2*ALIW1*BEJZ1*G*MTAMZ* + $ TANB/AMW*SSXINT(0.,SSWZF7,(MWIW-MZJZ)**2) + ELSE + TERMH1=0. + END IF + IF (MWIW.LT.(AMHC+MZJZ).AND.MWIW.LT.AML2SS) THEN + TMP(4)=AML2SS + TERMH2=PI**2/2./MWIW*FACT*SR2*ALIW2*BEJZ2*G*MTAMZ* + $ TANB/AMW*SSXINT(0.,SSWZF7,(MWIW-MZJZ)**2) + ELSE + TERMH2=0. + END IF + IF (MWIW.LT.(AMHC+MZJZ).AND.MWIW.LT.AMN3SS) THEN + TMP(4)=AMN3SS + TERMHN=PI**2/2./MWIW*FACT*SR2*ANI(JZ)*BPLWI(IW)*G* + $ MTAMZ*TANB/AMW*SSXINT(0.,SSWZF7,(MWIW-MZJZ)**2) + ELSE + TERMHN=0. + END IF + WID=TERMW+TERMN+TERM1+TERM2+TERMH+TERMWN+TERMW1+ + $ TERMW2+TERM12+TERMN1+TERMN2+TERMH1+TERMH2+ + $ TERMHN +C tau polarization for 3-body w1 -> z1 tau nu + IF (IW.EQ.1.AND.JZ.EQ.1.AND.WID.GT.0.) THEN + PTAUWZ=(POLNR+POL1R+POL2R+POL12R+TERMH+POLN1R+ + $ POLN2R+TERMHN+TERMH1+TERMH2-(TERMW+POLNL+ + $ POL1L+POL2L+POL12L+POLN1L+POLN2L+TERMWN+ + $ TERMW1+TERMW2))/WID + END IF + CALL SSSAVE(ISWIW,WID,ISZJZ,-IDTAU,IDNT,0,0) + Z1(1)=ZI**THJZ*G*XIPM + Z1(2)=ZI**THJZ*G*YIPM + Z2(1)=-G/2./SR2 + Z2(2)=-Z2(1) + CALL SSME3(1,AMW,Z1,Z2) + Z1(1)=-(ZI)**THJZ*ALIW1/2. + Z1(2)=-Z1(1) + Z2(1)=(ALJZ1+(-1.)**THJZ*BEJZ1)/2. + Z2(2)=(ALJZ1-(-1.)**THJZ*BEJZ1)/2. + CALL SSME3(2,AML1SS,Z1,Z2) + Z1(1)=-(ZI)**THJZ*ALIW2/2. + Z1(2)=-Z1(1) + Z2(1)=(ALJZ2+(-1.)**THJZ*BEJZ2)/2. + Z2(2)=(ALJZ2-(-1.)**THJZ*BEJZ2)/2. + CALL SSME3(2,AML2SS,Z1,Z2) + Z1(1)=(-1.)**THJZ*ANI(JZ)/2. + Z1(2)=-Z1(1) + Z2(1)=(SNIW*ALWI(IW)+BPLWI(IW))/2. + Z2(2)=(SNIW*ALWI(IW)-BPLWI(IW))/2. + CALL SSME3(3,AMN3SS,Z1,Z2) + Z1(1)=ZI**THJZ*G*MTAMZ*TANB/SR2/AMW/2. + Z1(2)=-Z1(1) + Z2(1)=(SNIW*AHCJZ-SNJZ*BHCJZ)/2. + Z2(2)=(SNIW*AHCJZ+SNJZ*BHCJZ)/2. + CALL SSME3(4,AMHC,Z1,Z2) + END IF +C +C wi --> w + zj +C + IF (MWIW.GT.(MZJZ+AMW)) THEN + EF=MWIW**2+MZJZ**2-AMW**2+((MWIW**2-MZJZ**2)**2 + $ -AMW**4)/AMW/AMW + WID=G*G*SQRT(SSXLAM(MWIW**2,MZJZ**2,AMW**2))/32./PI/ + $ MWIW**3*(2.*EF*(XIPM**2+YIPM**2)-12*MWIW*MZJZ* + $ (XIPM**2-YIPM**2)) + CALL SSSAVE(ISWIW,WID,ISZJZ,IDW,0,0,0) + END IF +C +C wi --> h+ + zj +C + IF (MWIW.GT.(MZJZ+AMHC)) THEN + IF(IW.EQ.1) THEN + A=(SNW1*COSBE*V2I(JZ) + $ -SIGN(1.,AMZISS(JZ))*SINBE*V4I(JZ))/2. + B=(SNW1*COSBE*V2I(JZ) + $ +SIGN(1.,AMZISS(JZ))*SINBE*V4I(JZ))/2. + ELSE + A=(THY*SNW2*COSBE*V1I(JZ) + $ -THX*SIGN(1.,AMZISS(JZ))*SINBE*V3I(JZ))/2. + B=(THY*SNW2*COSBE*V1I(JZ) + $ +THX*SIGN(1.,AMZISS(JZ))*SINBE*V3I(JZ))/2. + ENDIF + WID=SQRT(MWIW**4+MZJZ**4+AMHC**4-2.*(MWIW*MZJZ)**2- + $ 2.*(MWIW*AMHC)**2-2.*(MZJZ*AMHC)**2)/8./PI/MWIW**3* + $ ((A*A+B*B)*(MWIW*MWIW+MZJZ*MZJZ-AMHC*AMHC)/2. + $ +(A*A-B*B)*MWIW*MZJZ) + CALL SSSAVE(ISWIW,WID,ISZJZ,ISHC,0,0,0) + ENDIF +310 CONTINUE +C +C wi --> quark + squark +C + IF(MWIW.GT.(AMULSS+AMDN)) THEN + WID=3.*ADWI(IW)**2/32./PI/MWIW*(1.+AMDN**2/MWIW**2- + $ AMULSS**2/MWIW**2)*SQRT(SSXLAM(MWIW**2,AMDN**2,AMULSS**2)) + CALL SSSAVE(ISWIW,WID,+ISUPL,-IDDN,0,0,0) + END IF + IF(MWIW.GT.(AMDLSS+AMUP)) THEN + WID=3.*AUWI(IW)**2/32./PI/MWIW*(1.+AMUP**2/MWIW**2- + $ AMDLSS**2/MWIW**2)*SQRT(SSXLAM(MWIW**2,AMUP**2,AMDLSS**2)) + CALL SSSAVE(ISWIW,WID,-ISDNL,+IDUP,0,0,0) + END IF + IF(MWIW.GT.(AMCLSS+AMST)) THEN + WID=3.*ADWI(IW)**2/32./PI/MWIW*(1.+AMST**2/MWIW**2- + $ AMCLSS**2/MWIW**2)*SQRT(SSXLAM(MWIW**2,AMST**2,AMCLSS**2)) + CALL SSSAVE(ISWIW,WID,+ISCHL,-IDST,0,0,0) + END IF + IF(MWIW.GT.(AMSLSS+AMCH)) THEN + WID=3.*AUWI(IW)**2/32./PI/MWIW*(1.+AMCH**2/MWIW**2- + $ AMCLSS**2/MWIW**2)*SQRT(SSXLAM(MWIW**2,AMCH**2,AMCLSS**2)) + CALL SSSAVE(ISWIW,WID,-ISSTL,+IDCH,0,0,0) + ENDIF + IF(MWIW.GT.(AMT1SS+AMBT)) THEN + AS=(-ADWI(IW)*COST-BWI(IW)*SINT)**2 + WID=3*((AS+BPWI(IW)**2*COST**2)*(MWIW**2+AMBT**2-AMT1SS**2) + $ +4*SQRT(AS)*BPWI(IW)*COST*AMBT*MWIW)/32./PI/MWIW**3* + $ SQRT(SSXLAM(MWIW**2,AMBT**2,AMT1SS**2)) + CALL SSSAVE(ISWIW,WID,ISTP1,-IDBT,0,0,0) + ENDIF + IF(MWIW.GT.(AMT2SS+AMBT)) THEN + AS=(-ADWI(IW)*SINT+BWI(IW)*COST)**2 + WID=3*((AS+BPWI(IW)**2*SINT**2)*(MWIW**2+AMBT**2-AMT2SS**2) + $ +4*SQRT(AS)*BPWI(IW)*SINT*AMBT*MWIW)/32./PI/MWIW**3* + $ SQRT(SSXLAM(MWIW**2,AMBT**2,AMT2SS**2)) + CALL SSSAVE(ISWIW,WID,ISTP2,-IDBT,0,0,0) + ENDIF + IF(MWIW.GT.(AMB1SS+AMTP)) THEN + AS=(-AUWI(IW)*COSB-BPWI(IW)*SINB)**2 + WID=3*((AS+BWI(IW)**2*COSB**2)*(MWIW**2+AMTP**2-AMB1SS**2) + $ +4*SQRT(AS)*BWI(IW)*COSB*AMTP*MWIW)/32./PI/MWIW**3* + $ SQRT(SSXLAM(MWIW**2,AMTP**2,AMB1SS**2)) + CALL SSSAVE(ISWIW,WID,-ISBT1,IDTP,0,0,0) + ENDIF + IF(MWIW.GT.(AMB2SS+AMTP)) THEN + AS=(-AUWI(IW)*SINB+BPWI(IW)*COSB)**2 + WID=3*((AS+BWI(IW)**2*SINB**2)*(MWIW**2+AMTP**2-AMB2SS**2) + $ +4*SQRT(AS)*BWI(IW)*SINB*AMTP*MWIW)/32./PI/MWIW**3* + $ SQRT(SSXLAM(MWIW**2,AMTP**2,AMB2SS**2)) + CALL SSSAVE(ISWIW,WID,-ISBT2,IDTP,0,0,0) + ENDIF +C +C wi --> lepton + slepton +C + IF(MWIW.GT.(AMN1SS+AME)) THEN + AS=(-ALWI(IW))**2 + WID=AS*(MWIW**2+AME**2-AMN1SS**2)/32./PI/MWIW**3* + $ SQRT(SSXLAM(MWIW**2,AME**2,AMN1SS**2)) + CALL SSSAVE(ISWIW,WID,ISNEL,-IDE,0,0,0) + END IF + IF(MWIW.GT.(AMN2SS+AMMU)) THEN + AS=(-ALWI(IW))**2 + WID=AS*(MWIW**2+AMMU**2-AMN2SS**2)/32./PI/MWIW**3* + $ SQRT(SSXLAM(MWIW**2,AMMU**2,AMN2SS**2)) + CALL SSSAVE(ISWIW,WID,ISNML,-IDMU,0,0,0) + END IF + IF(MWIW.GT.(AMN3SS+AMTAU)) THEN + AS=(-ALWI(IW))**2 + WID=((AS+BPLWI(IW)**2)*(MWIW**2+AMTAU**2-AMN3SS**2)+ + $ 4*SQRT(AS)*BPLWI(IW)*AMTAU*MWIW)/32./PI/MWIW**3* + $ SQRT(SSXLAM(MWIW**2,AMTAU**2,AMN3SS**2)) + CALL SSSAVE(ISWIW,WID,ISNTL,-IDTAU,0,0,0) + ENDIF + IF(MWIW.GT.AMELSS) THEN + WID=ANWI(IW)**2*(MWIW**2-AMELSS**2)**2/32./PI/MWIW**3 + CALL SSSAVE(ISWIW,WID,-ISEL,IDNE,0,0,0) + ENDIF + IF(MWIW.GT.AMMLSS) THEN + WID=ANWI(IW)**2*(MWIW**2-AMMLSS**2)**2/32./PI/MWIW**3 + CALL SSSAVE(ISWIW,WID,-ISMUL,IDNM,0,0,0) + END IF + IF(MWIW.GT.AML1SS) THEN + AS=(-ANWI(IW)*COSL-BPLWI(IW)*SINL)**2 + WID=AS*(MWIW**2-AML1SS**2)**2/32./PI/MWIW**3 + CALL SSSAVE(ISWIW,WID,-ISTAU1,IDNT,0,0,0) + END IF + IF(MWIW.GT.AML2SS) THEN + AS=(-ANWI(IW)*SINL+BPLWI(IW)*COSL)**2 + WID=AS*(MWIW**2-AML2SS**2)**2/32./PI/MWIW**3 + CALL SSSAVE(ISWIW,WID,-ISTAU2,IDNT,0,0,0) + END IF +300 CONTINUE +C +C w2 --> w1 + z +C w2 --> w1 + f + fbar +C + IF (MW2.GT.(MW1+AMZ)) THEN + EF=MW2**2+MW1**2-AMZ**2+((MW2**2-MW1**2)**2- + $ AMZ**4)/AMZ/AMZ + Y=(THX*SIN(GAMMAL)*COS(GAMMAL)-THY*SIN(GAMMAR)*COS(GAMMAR))/2. + Z=(THX*SIN(GAMMAL)*COS(GAMMAL)+THY*SIN(GAMMAR)*COS(GAMMAR))/2. + WID=(COTW+TANW)**2*SQRT(SSXLAM(MW2**2,MW1**2,AMZ**2))/ + $ 128./32./MW2**3*(2*EF*(Y*Y+Z*Z)+ + $ 12*MW2*MW1*(Y*Y-Z*Z)*SNW2*SNW1) + CALL SSSAVE(ISW2,WID,ISW1,IDZ,0,0,0) + W21ZL=0. + W21ZN=0. + W21ZU=0. + W21ZD=0. +C ...w1 + f + fbar + ELSE + CONST=E**4*(COTW+TANW)**2/96./PI**3/MW2 + UPPER=(MW2**2+MW1**2)/2./MW2 + TMP(1)=MW2 + TMP(2)=MW1 + TMP(3)=AMZ + TMP(4)=SNW1*SNW2 + TMP(5)=XWINO + TMP(6)=YWINO + XINTGL=SSXINT(MW1,SSWWF1,UPPER) + W21ZL=(APL**2+BTL**2)*CONST*XINTGL + W21ZN=(APN**2+BTN**2)*CONST*XINTGL + W21ZU=3*(APU**2+BTU**2)*CONST*XINTGL + W21ZD=3*(APD**2+BTD**2)*CONST*XINTGL + END IF +C do w2 ->w1+q+qbar via sq' + TMP(1)=MW2 + TMP(3)=MW1 + UPPER=(MW2**2-MW1**2)/2./MW2 + IF (MW2.LT.AMULSS) THEN + TMP(2)=AMULSS + XINTGL=SSXINT(0.,SSWZF2,UPPER) + W21D=3*(ADWI(2)*ADWI(1))**2*XINTGL/2./MW2/(2*PI)**5 + ELSE + W21D=0. + END IF + IF (MW2.LT.AMDLSS) THEN + TMP(2)=AMDLSS + XINTGL=SSXINT(0.,SSWZF2,UPPER) + W21U=3*(AUWI(2)*AUWI(1))**2*XINTGL/2./MW2/(2*PI)**5 + ELSE + W21U=0. + END IF + IF (MW2.LT.AMCLSS) THEN + TMP(2)=AMCLSS + XINTGL=SSXINT(0.,SSWZF2,UPPER) + W21S=3*(ADWI(2)*ADWI(1))**2*XINTGL/2./MW2/(2*PI)**5 + ELSE + W21S=0. + END IF + IF (MW2.LT.AMSLSS) THEN + TMP(2)=AMSLSS + XINTGL=SSXINT(0.,SSWZF2,UPPER) + W21C=3*(AUWI(2)*AUWI(1))**2*XINTGL/2./MW2/(2*PI)**5 + ELSE + W21C=0. + END IF + IF (MW2.LT.AMN1SS) THEN + TMP(2)=AMN1SS + XINTGL=SSXINT(0.,SSWZF2,UPPER) + W21E=(ALWI(2)*ALWI(1))**2*XINTGL/2./MW2/(2*PI)**5 + ELSE + W21E=0. + END IF + IF (MW2.LT.AMN2SS) THEN + TMP(2)=AMN2SS + XINTGL=SSXINT(0.,SSWZF2,UPPER) + W21M=(ALWI(2)*ALWI(1))**2*XINTGL/2./MW2/(2*PI)**5 + ELSE + W21M=0. + END IF + IF (MW2.LT.AMN3SS) THEN + TMP(2)=AMN3SS + XINTGL=SSXINT(0.,SSWZF2,UPPER) + W21L=(ALWI(2)*ALWI(1))**2*XINTGL/2./MW2/(2*PI)**5 + ELSE + W21L=0. + END IF + IF (MW2.LT.AMELSS) THEN + TMP(2)=AMELSS + XINTGL=SSXINT(0.,SSWZF2,UPPER) + W21N1=(ANWI(2)*ANWI(1))**2*XINTGL/2./MW2/(2*PI)**5 + ELSE + W21N1=0. + END IF + IF (MW2.LT.AMMLSS) THEN + TMP(2)=AMMLSS + XINTGL=SSXINT(0.,SSWZF2,UPPER) + W21N2=(ANWI(2)*ANWI(1))**2*XINTGL/2./MW2/(2*PI)**5 + ELSE + W21N2=0. + END IF +C !!! W2->W1+NU_TAU+NU_TAUBAR NEEDS UPDATING FOR STAU MIXING + IF (MW2.LT.AML1SS) THEN + TMP(2)=AML1SS + XINTGL=SSXINT(0.,SSWZF2,UPPER) + W21N3=(ANWI(2)*ANWI(1))**2*XINTGL/2./MW2/(2*PI)**5 + ELSE + W21N3=0. + END IF +C-----WINO-2 ->WINO-1 +BBBAR NEEDS UPDATE ------------------- +C-----WINO-2 ->WINO-1 +TTBAR NEEDS UPDATE ------------------- +C-----THESE ALL LACK INTERFERENCE TERMS AS WELL + W21D=W21D+W21ZD + W21U=W21U+W21ZU + W21S=W21S+W21ZD + W21C=W21C+W21ZU + W21N1=W21N1+W21ZN + W21N2=W21N2+W21ZN + W21N3=W21N3+W21ZN + W21E=W21E+W21ZL + W21M=W21M+W21ZL + W21L=W21L+W21ZL + IF(W21D.GT.0.) THEN + CALL SSSAVE(ISW2,W21D,ISW1,IDDN,-IDDN,0,0) + END IF + IF(MW2.GT.(MW1+2*AMST+1.)) THEN + CALL SSSAVE(ISW2,W21S,ISW1,IDST,-IDST,0,0) + END IF +C IF (MW2.GT.(MW1+2*AMBT+2.)) THEN +C CALL SSSAVE(ISW2,W21D,ISW1,IDBT,-IDBT,0,0) +C END IF + IF(W21U.GT.0.) THEN + CALL SSSAVE(ISW2,W21U,ISW1,IDUP,-IDUP,0,0) + END IF + IF (MW2.GT.(MW1+2*AMCH+1.)) THEN + CALL SSSAVE(ISW2,W21C,ISW1,IDCH,-IDCH,0,0) + ENDIF +C IF (MW2.GT.(MW1+2*AMTP+2.)) THEN +C CALL SSSAVE(ISW2,W21U,ISW1,IDTP,-IDTP,0,0) +C END IF + IF(W21N1.GT.0.) THEN + CALL SSSAVE(ISW2,W21N1,ISW1,IDNE,-IDNE,0,0) + ENDIF + IF(W21N2.GT.0.) THEN + CALL SSSAVE(ISW2,W21N2,ISW1,IDNM,-IDNM,0,0) + ENDIF + IF(W21N3.GT.0.) THEN + CALL SSSAVE(ISW2,W21N3,ISW1,IDNT,-IDNT,0,0) + ENDIF + IF(W21E.GT.0.) THEN + CALL SSSAVE(ISW2,W21E,ISW1,IDE,-IDE,0,0) + ENDIF + IF(MW2.GT.(MW1+2*AMMU+1.)) THEN + CALL SSSAVE(ISW2,W21M,ISW1,IDMU,-IDMU,0,0) + ENDIF + IF(MW2.GT.(MW1+2*AMTAU+1.)) THEN + CALL SSSAVE(ISW2,W21L,ISW1,IDTAU,-IDTAU,0,0) + ENDIF +C +C w2 --> w1 + higgs +C +C w2 --> w1 + hl + IF(MW2.GT.(MW1+AMHL)) THEN + WID=G*G/16./PI/MW2**3*SQRT(SSXLAM(MW2**2,MW1**2,AMHL**2))* + $ ((SL*SL+PL*PL)*(MW2*MW2+MW1*MW1-AMHL*AMHL)/2.+ + $ (SL*SL-PL*PL)*MW2*MW1) + CALL SSSAVE(ISW2,WID,ISW1,ISHL,0,0,0) + ENDIF +C w2 --> w1 + hh + IF(MW2.GT.(MW1+AMHH)) THEN + WID=G*G/16./PI/MW2**3*SQRT(SSXLAM(MW2**2,MW1**2,AMHH**2))* + $ ((SH*SH+PH*PH)*(MW2*MW2+MW1*MW1-AMHH*AMHH)/2.+ + $ (SH*SH-PH*PH)*MW2*MW1) + CALL SSSAVE(ISW2,WID,ISW1,ISHH,0,0,0) + ENDIF +C w2 --> w1 + ha + IF(MW2.GT.(MW1+AMHA)) THEN + WID=G*G/16./PI/MW2**3*SQRT(SSXLAM(MW2**2,MW1**2,AMHA**2))* + $ ((SP*SP+PP*PP)*(MW2*MW2+MW1*MW1-AMHA*AMHA)/2.+ + $ (SP*SP-PP*PP)*MW2*MW1) + CALL SSSAVE(ISW2,WID,ISW1,ISHA,0,0,0) + END IF +C +C Normalize wi branching ratios +C + CALL SSNORM(ISW1) + CALL SSNORM(ISW2) +C + RETURN + END diff --git a/ISAJET/isasusy/sswwf1.F b/ISAJET/isasusy/sswwf1.F new file mode 100644 index 00000000000..7b2247be11e --- /dev/null +++ b/ISAJET/isasusy/sswwf1.F @@ -0,0 +1,31 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSWWF1(EE) +C----------------------------------------------------------------------- +C SSWZBF: wiss -> zjss f fbar +C Baer's WIWFUN +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" +C + DOUBLE PRECISION E,MW2,MW1,MZ,SN,XX,YY,T1,T2,T3,T4 + REAL EE +C + E=EE + MW2=TMP(1) + MW1=TMP(2) + MZ=TMP(3) + SN=TMP(4) + XX=TMP(5) + YY=TMP(6) +C + T1=DSQRT(E**2-MW1**2)/(MW2**2+MW1**2-MZ**2-2*MW2*E)**2 + T2=3*E*MW2*(MW2**2+MW1**2)-2*MW2**2*MW1**2-4*MW2**2*E*E + T3=2*E*MW2-MW2**2-MW1**2 + T4=T1*((XX**2+YY**2)*T2-3*SN*(XX**2-YY**2)*MW2*MW1*T3) + SSWWF1=T4 + RETURN + END diff --git a/ISAJET/isasusy/sswzbf.F b/ISAJET/isasusy/sswzbf.F new file mode 100644 index 00000000000..4762e35067e --- /dev/null +++ b/ISAJET/isasusy/sswzbf.F @@ -0,0 +1,64 @@ +#include "isajet/pilot.h" + SUBROUTINE SSWZBF +C----------------------------------------------------------------------- +C This subroutine gives chargino (wi) and neutralino (zi) +C decays according to Baer, et al. +C Valid for all scalar masses (functions in double precision) +C Includes Higgs sector radiative corrections (Aug. 31) +C +C Auxiliary functions are called SSWxyi, SSZxyi, where normally +C x indicates the SUSY particle, y the SM particle(s), and i is +C a counter. +C +C Ver. 7.07: For w_i -> z_j or z_i -> w_j decays, require that +C decay be allowed by a factor FUDGE = 1.0 +C Ver. 7.28: Calculate full large tan(beta) decays. +C Calculate tau polarizations. +C Ver. 7.33: Add GMSB modes. +C Ver. 7.41: Add decay matrix elements. +C Split real work into sszibf and sswfbf. +C +C Baer's GAUGBF +C +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sslun.inc" +#include "isajet/ssmode.inc" +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstype.inc" +#include "isajet/sstmp.inc" +#include "isajet/sspols.inc" +C + INTEGER IZ +C +C Initialize polarizations to zero +C + DO 150 IZ=1,4 + PTAU1(IZ)=0 + PTAU2(IZ)=0 +150 CONTINUE + PTAUZZ=0 + PTAUWZ=0 +C----------------------------------------------------------------------- +C Generate Neutralino zi Branching Fractions +C----------------------------------------------------------------------- + CALL SSZIBF +C----------------------------------------------------------------------- +C Generate Chargino Branching Fractions +C----------------------------------------------------------------------- + CALL SSWIBF +C +C Set more neutralino polarizations +C + IF (ABS(AMZISS(2)).GT.(AMTAU+AML1SS)) PTAUZ2(1)=PTAU1(2) + IF (ABS(AMZISS(2)).GT.(AMTAU+AML2SS)) PTAUZ2(2)=PTAU2(2) + IF (ABS(AMZISS(3)).GT.(AMTAU+AML1SS)) PTAUZ3(1)=PTAU1(3) + IF (ABS(AMZISS(3)).GT.(AMTAU+AML2SS)) PTAUZ3(2)=PTAU2(3) + IF (ABS(AMZISS(4)).GT.(AMTAU+AML1SS)) PTAUZ4(1)=PTAU1(4) + IF (ABS(AMZISS(4)).GT.(AMTAU+AML2SS)) PTAUZ4(2)=PTAU2(4) +C + RETURN + END diff --git a/ISAJET/isasusy/sswzf1.F b/ISAJET/isasusy/sswzf1.F new file mode 100644 index 00000000000..5bd322e781a --- /dev/null +++ b/ISAJET/isasusy/sswzf1.F @@ -0,0 +1,29 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSWZF1(EE) +C----------------------------------------------------------------------- +C SSWZBF: wiss -> zjss f fbar +C Baer's WIWFUN +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" +C + REAL EE + DOUBLE PRECISION C1,C2,MWI,MZI,MW,PROP,T1,T2,E +C + E=EE + C1=TMP(1) + C2=TMP(2) + MWI=TMP(3) + MZI=TMP(4) + MW=AMW +C + PROP=(MWI**2+MZI**2-2*MWI*E-MW**2)**2 + T1=C1*(3*(MWI**2+MZI**2)*MWI*E-4*MWI**2*E*E-2*MWI**2*MZI**2) + T2=-3*C2*MWI*MZI*(MWI**2+MZI**2-2*MWI*E) + SSWZF1=SQRT(MAX(0.D0,E*E-MZI**2))/PROP*(T1+T2) + RETURN + END diff --git a/ISAJET/isasusy/sswzf2.F b/ISAJET/isasusy/sswzf2.F new file mode 100644 index 00000000000..0ada74be3e4 --- /dev/null +++ b/ISAJET/isasusy/sswzf2.F @@ -0,0 +1,26 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSWZF2(QQ) +C----------------------------------------------------------------------- +C SSWZBF: wiss -> zjss f fbar +C Baer's PSIFUN +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" +C + REAL QQ + DOUBLE PRECISION M1,M2,M3,PI,Q + DATA PI/3.14159265D0/ +C + Q=QQ + M1=TMP(1) + M2=TMP(2) + M3=TMP(3) +C + SSWZF2=PI**2*M1*Q*Q*(M1**2-2*M1*Q-M3**2)**2/ + $(M1**2-2*M1*Q-M2**2)**2/(M1**2-2*M1*Q) + RETURN + END diff --git a/ISAJET/isasusy/sswzf3.F b/ISAJET/isasusy/sswzf3.F new file mode 100644 index 00000000000..0ecd6078382 --- /dev/null +++ b/ISAJET/isasusy/sswzf3.F @@ -0,0 +1,30 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSWZF3(QQ) +C----------------------------------------------------------------------- +C SSWZBF: wiss -> zjss f fbar +C Baer's PHIFUN +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" +C + REAL QQ + DOUBLE PRECISION M1,M2,M3,T,B,XLOG,SQBKT,Q,PI + DATA PI/3.14159265D0/ +C + Q=QQ + M1=TMP(1) + M2=TMP(2) + M3=TMP(3) +C + T=M2**2*(M1-2*Q)-M1*M3**2 + B=(M1-2*Q)*(M2**2-2*M1*Q-M3**2) + XLOG=DLOG(T/B) + SQBKT=-Q*(M1**2-M3**2-2*M1*Q)/M1/(M1-2*Q)- + $(2*M1*Q-M2**2+M3**2)*XLOG/2./M1 + SSWZF3=.5*PI**2*M1*M3*SQBKT/(M1**2-M2**2-2*M1*Q) + RETURN + END diff --git a/ISAJET/isasusy/sswzf4.F b/ISAJET/isasusy/sswzf4.F new file mode 100644 index 00000000000..e50985b0665 --- /dev/null +++ b/ISAJET/isasusy/sswzf4.F @@ -0,0 +1,37 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSWZF4(SS) +C----------------------------------------------------------------------- +C SSWZBF: wiss -> zjss f fbar +C Baer's XI1FUN +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" +C----------------------------------------------------------------------- + REAL SS,PI + DOUBLE PRECISION M1,M2,M3,EQ,Q,XMUS,XLOG,TERM,S,MW + DATA PI/3.14159265/ +C + S=SS + M1=TMP(1) + M2=TMP(2) + M3=TMP(3) + MW=AMW +C + EQ=(S+M1**2-M3**2)/2./M1 + IF (EQ**2.GE.S) THEN + Q=DSQRT(EQ**2-S) + ELSE + Q=0.D0 + END IF + XMUS=M2**2+S-M3**2 + XLOG=DLOG((M1*(EQ+Q)-XMUS)/(M1*(EQ-Q)-XMUS)) + TERM=-.5*M1*EQ*Q-.5*(M2**2-M1**2-S)*Q- + $.25/M1*(M2**2-M3**2)*(M2**2-M1**2)*XLOG +C SS can stay single precision below + SSWZF4=PI**2/2./M1/(SS-MW**2)*TERM + RETURN + END diff --git a/ISAJET/isasusy/sswzf5.F b/ISAJET/isasusy/sswzf5.F new file mode 100644 index 00000000000..8f43d20f856 --- /dev/null +++ b/ISAJET/isasusy/sswzf5.F @@ -0,0 +1,31 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSWZF5(SS) +C----------------------------------------------------------------------- +C SSWZBF: wiss -> zjss f fbar +C Baer's XI2FUN +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" +C + REAL MW,PI,SS + DOUBLE PRECISION M1,M2,M3,EQ,Q,XMUS,D,XLOG,S + DATA PI/3.14159265/,MW/80./ +C + S=SS + M1=TMP(1) + M2=TMP(2) + M3=TMP(3) + MW=AMW +C + EQ=(S+M1**2-M3**2)/2./M1 + Q=DSQRT(MAX(0.D0,EQ**2-S)) + XMUS=M2**2+S-M3**2 + D=(M1*(EQ+Q)-XMUS)/(M1*(EQ-Q)-XMUS) + XLOG=DLOG(D) + SSWZF5=PI**2/2./M1*M3*S/4./(SS-MW**2)*XLOG + RETURN + END diff --git a/ISAJET/isasusy/sswzf6.F b/ISAJET/isasusy/sswzf6.F new file mode 100644 index 00000000000..5f42f78dfe5 --- /dev/null +++ b/ISAJET/isasusy/sswzf6.F @@ -0,0 +1,30 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSWZF6(EE) +C----------------------------------------------------------------------- +C SSWZBF: wiss -> zjss f fbar +C Drees' function for charged Higgs exchange +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" +C + REAL EE + DOUBLE PRECISION E,MW,MZ,MH,AL,BE,SN,RES +C + E=EE + MW=TMP(1) + MH=TMP(2) + MZ=TMP(3) + AL=TMP(4) + BE=TMP(5) + SN=TMP(6) +C + RES=SQRT(E**2-MZ**2)*(MW**2+MZ**2-2*MW*E)* + ,(E*(AL**2+BE**2)+2*SN*MZ*AL*BE)/ + ,(MW**2+MZ**2-2*MW*E-MH**2)**2 + SSWZF6=RES + RETURN + END diff --git a/ISAJET/isasusy/sswzf7.F b/ISAJET/isasusy/sswzf7.F new file mode 100644 index 00000000000..619f3cdf861 --- /dev/null +++ b/ISAJET/isasusy/sswzf7.F @@ -0,0 +1,35 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSWZF7(SS) +C----------------------------------------------------------------------- +C SSWZBF: wiss -> zjss f fbar +C Drees' function for charged Higgs/sfermion interference +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" +C + REAL SS + DOUBLE PRECISION S,MS,MW,MZ,MH,AL,BE,SN,RES, + $EQ,Q,MUS,XL,TERM +C + S=SS + MW=TMP(1) + MZ=TMP(2) + MH=TMP(3) + MS=TMP(4) + AL=TMP(5) + BE=TMP(6) + SN=TMP(7) +C + EQ=(S+MW**2-MZ**2)/2.D0/MW + Q=SQRT(MAX(0.D0,EQ**2-S)) + MUS=S+MS**2-MZ**2 + XL=LOG((MW*(EQ+Q)-MUS)/(MW*(EQ-Q)-MUS)) + TERM=BE*S*MS**2+SN*AL*MW*MZ*S + RES=(S*Q*BE/2.D0+TERM*XL/4.D0/MW)/(S-MH**2) + SSWZF7=RES + RETURN + END diff --git a/ISAJET/isasusy/ssxint.F b/ISAJET/isasusy/ssxint.F new file mode 100644 index 00000000000..b9cfb6a06af --- /dev/null +++ b/ISAJET/isasusy/ssxint.F @@ -0,0 +1,125 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSXINT(XL,F,XR) +C----------------------------------------------------------------------- +C Integrate F over (XL,XR) using adaptive Gaussian quadrature. +C TOLABS = 1e-35: absolute error for convergence. +C TOLREL = 5e-5: relative error for convergence. +C TOLBIN = 1e-3: relative bin size limit. Set contribution to +C zero if bin falls below this. +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sslun.inc" + EXTERNAL F + INTEGER NMAX + REAL TOLABS,TOLREL,TOLBIN,XMIN,XLIMS(100) + REAL R(93),W(93) + INTEGER PTR(4),NORD(4) + INTEGER ICOUNT,IBAD + REAL XL,XR,F + REAL AA,BB,TVAL,VAL,TOL + INTEGER NLIMS,I,J +C + DATA PTR,NORD/4,10,22,46, 6,12,24,48/ + DATA R/.2386191860,.6612093865,.9324695142, + 1 .1252334085,.3678314990,.5873179543,.7699026742,.9041172563, + 1 .9815606342,.0640568929,.1911188675,.3150426797,.4337935076, + 1 .5454214714,.6480936519,.7401241916,.8200019860,.8864155270, + 1 .9382745520,.9747285560,.9951872200,.0323801710,.0970046992, + 1 .1612223561,.2247637903,.2873624873,.3487558863,.4086864820, + 1 .4669029048,.5231609747,.5772247261,.6288673968,.6778723796, + 1 .7240341309,.7671590325,.8070662040,.8435882616,.8765720203, + 1 .9058791367,.9313866907,.9529877032,.9705915925,.9841245837, + 1 .9935301723,.9987710073,.0162767488,.0488129851,.0812974955, + 1 .1136958501,.1459737146,.1780968824,.2100313105,.2417431561, + 1 .2731988126,.3043649444,.3352085229,.3656968614,.3957976498, + 1 .4254789884,.4547094222,.4834579739,.5116941772,.5393881083, + 1 .5665104186,.5930323648,.6189258401,.6441634037,.6687183100, + 1 .6925645366,.7156768123,.7380306437,.7596023411,.7803690438, + 1 .8003087441,.8194003107,.8376235112,.8549590334,.8713885059, + 1 .8868945174,.9014606353,.9150714231,.9277124567,.9393703398, + 1 .9500327178,.9596882914,.9683268285,.9759391746,.9825172636, + 1 .9880541263,.9925439003,.9959818430,.9983643759,.9996895039/ + DATA W/.4679139346,.3607615730,.1713244924, + 1 .2491470458,.2334925365,.2031674267,.1600783285,.1069393260, + 1 .0471753364,.1279381953,.1258374563,.1216704729,.1155056681, + 1 .1074442701,.0976186521,.0861901615,.0733464814,.0592985849, + 1 .0442774388,.0285313886,.0123412298,.0647376968,.0644661644, + 1 .0639242386,.0631141923,.0620394232,.0607044392,.0591148397, + 1 .0572772921,.0551995037,.0528901894,.0503590356,.0476166585, + 1 .0446745609,.0415450829,.0382413511,.0347772226,.0311672278, + 1 .0274265097,.0235707608,.0196161605,.0155793157,.0114772346, + 1 .0073275539,.0031533461,.0325506145,.0325161187,.0324471637, + 1 .0323438226,.0322062048,.0320344562,.0318287589,.0315893308, + 1 .0313164256,.0310103326,.0306713761,.0302999154,.0298963441, + 1 .0294610900,.0289946142,.0284974111,.0279700076,.0274129627, + 1 .0268268667,.0262123407,.0255700360,.0249006332,.0242048418, + 1 .0234833991,.0227370697,.0219666444,.0211729399,.0203567972, + 1 .0195190811,.0186606796,.0177825023,.0168854799,.0159705629, + 1 .0150387210,.0140909418,.0131282296,.0121516047,.0111621020, + 1 .0101607705,.0091486712,.0081268769,.0070964708,.0060585455, + 1 .0050142027,.0039645543,.0029107318,.0018539608,.0007967921/ +C + DATA TOLABS,TOLREL,TOLBIN,NMAX/1.E-35,5.E-5,1E-3,100/ +C + SSXINT=0 + NLIMS=2 + XLIMS(1)=XL + XLIMS(2)=XR + ICOUNT = 0 + IBAD=0 + XMIN=TOLBIN*ABS(XR-XL) +C +10 AA=(XLIMS(NLIMS)-XLIMS(NLIMS-1))/2 + BB=(XLIMS(NLIMS)+XLIMS(NLIMS-1))/2 + TVAL=0 + DO 15 I=1,3 +15 TVAL=TVAL+W(I)*(F(BB+AA*R(I))+F(BB-AA*R(I))) + TVAL=TVAL*AA + DO 25 J=1,4 + VAL=0 + DO 20 I=PTR(J),PTR(J)-1+NORD(J) + ICOUNT = ICOUNT + 1 + IF (ICOUNT .GT. 1E5) THEN + WRITE(LOUT,*) 'ERROR IN SSXINT: SET SSXINT = 0' + SSXINT=0 + RETURN + ENDIF +20 VAL=VAL+W(I)*(F(BB+AA*R(I))+F(BB-AA*R(I))) + VAL=VAL*AA + TOL=MAX(TOLABS,TOLREL*ABS(VAL)) + IF (ABS(TVAL-VAL).LT.TOL) THEN + SSXINT=SSXINT+VAL + NLIMS=NLIMS-2 + IF (NLIMS.NE.0) GO TO 10 + GO TO 999 + ELSEIF(ABS(AA).LT.XMIN.AND.J.EQ.4) THEN +C Bin is too small -- set VAL = 0. -- FEP + IBAD=IBAD+1 + NLIMS=NLIMS-2 + IF (NLIMS.NE.0) GO TO 10 + GO TO 999 + ENDIF +25 TVAL=VAL + IF (NMAX.EQ.2) THEN + SSXINT=VAL + GO TO 999 + END IF + IF (NLIMS.GT.(NMAX-2)) THEN + WRITE(LOUT,50) SSXINT,NMAX,BB-AA,BB+AA +50 FORMAT (' ERROR IN SSXINT, SSXINT,NMAX,XL,XR=',G15.7,I5,2G15.7) + RETURN + END IF + XLIMS(NLIMS+1)=BB + XLIMS(NLIMS+2)=BB+AA + XLIMS(NLIMS)=BB + NLIMS=NLIMS+2 + GO TO 10 +C +999 IF(IBAD.GT.0) THEN + WRITE(LOUT,*) 'WARNING IN SSXINT: BAD CONVERGENCE FOR ',IBAD, + $ ' INTERVALS.' + ENDIF + RETURN + END diff --git a/ISAJET/isasusy/ssxlam.F b/ISAJET/isasusy/ssxlam.F new file mode 100644 index 00000000000..2ed6bc679f8 --- /dev/null +++ b/ISAJET/isasusy/ssxlam.F @@ -0,0 +1,19 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSXLAM(A,B,C) +C----------------------------------------------------------------------- +C Kinematic function +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + REAL A,B,C +C Rewrite SSXLAM=A**2+B**2+C**2-2*A*B-2*A*C-2*B*C + IF(A.GE.B.AND.A.GE.C) THEN + SSXLAM=(A-B-C)**2-4*B*C + ELSEIF(B.GE.A.AND.B.GE.C) THEN + SSXLAM=(B-A-C)**2-4*A*C + ELSE + SSXLAM=(C-A-B)**2-4*A*B + ENDIF + RETURN + END diff --git a/ISAJET/isasusy/sszhx.F b/ISAJET/isasusy/sszhx.F new file mode 100644 index 00000000000..676fa56e62c --- /dev/null +++ b/ISAJET/isasusy/sszhx.F @@ -0,0 +1,27 @@ +#include "isajet/pilot.h" + FUNCTION SSZHX(X) +C---------------------------------------------------------------- +C Auxiliary function for Z -> HL Z*. Called by SSTEST. +C---------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sslun.inc" +#include "isajet/ssmode.inc" +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" +#include "isajet/sstype.inc" +C + REAL X,SSZHX + REAL MHL,MZ,GZ,R,DEN,TERM +C + MHL=TMP(1) + MZ=AMZ + GZ=GAMZ + R=MHL/MZ + TERM=(1.-X+X**2/12.+2*R**2/3.)*SQRT(X**2-4*R**2) + DEN=(X-R**2)**2+(GZ/MZ)**2 + SSZHX=TERM/DEN + RETURN + END diff --git a/ISAJET/isasusy/sszibf.F b/ISAJET/isasusy/sszibf.F new file mode 100644 index 00000000000..3be1d6e2b14 --- /dev/null +++ b/ISAJET/isasusy/sszibf.F @@ -0,0 +1,1893 @@ +#include "isajet/pilot.h" + SUBROUTINE SSZIBF +C----------------------------------------------------------------------- +C This subroutine calculates the neutralino (zi) subset of +C SSWZBF, which was too long. +C Valid for all scalar masses (functions in double precision) +C Includes Higgs sector radiative corrections (Aug. 31) +C +C Auxiliary functions are called SSWxyi, SSZxyi, where normally +C x indicates the SUSY particle, y the SM particle(s), and i is +C a counter. +C +C Part of Baer's GAUGBF +C +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sslun.inc" +#include "isajet/ssmode.inc" +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstype.inc" +#include "isajet/sstmp.inc" +#include "isajet/sspols.inc" +C + EXTERNAL SSZWF1,SSZZF1,SSZZF2,SSZZF3,SSWZF1,SSWZF2,SSWZF3 + $,SSWZF4,SSWZF5,SSWZF6,SSWZF7,SSWWF1,SSZZF4,SSZZF5,SSGX1 + $,SSGX2,SSGX8 +C + REAL AUI(4),BUI(4),ADI(4),BDI(4),ALI(4),BLI(4),ANI(4),BNI(4) + $,WIJ(4,4),AUWI(4),ADWI(4),ANWI(4),ALWI(4),XIM(4),YIM(4) + $,XIP(4),YIP(4),SNIJ(4,4),XLIJ(4,4),HIJ(4,4) + $,V1I(4),V2I(4),V3I(4),V4I(4),XHIJ(4,4),XPIJ(4,4),AMWISS(2) +C + INTEGER ISZ(4),THIZ,THJZ +C + REAL MWIW,SL,PP,SP,PL,MZIZ,PH,SH,COSB,SINB,COSA,SINA + $,MZJZ,FAC,COSBE,SINBE + REAL STHW,CTHW + REAL EF,A,B,TANB,FB,FT,SR2,G,PI,GP,FL + $,MW2,SNW1,MW1,YM,BE,SNW2,XM,THX,THY + $,BTN,APD,APL,APU,BTD,BTL,APN,BTU + REAL TANW,COTW,XWINO,YWINO,SN,SNIW,SNJZ + REAL SSXINT,SSXLAM + REAL WID,WIDEE,E, + $TERMLL,TERMRR,TERMZZ,TERMLZ,TERMRZ,TERMLH + REAL FACT,ALIZ1,ALJZ1,ALIZ2,ALJZ2,BEIZ1,BEJZ1,BEIZ2,BEJZ2, + $SGNIJ,XUPPER,GLLF1,GRRF1,GLRF1,GF1,GLLF2,GRRF2,GLRF2,GF2, + $GLGL,GRGR,GLGR,GRGL,GF12,GF,TERMHL,TERMHH,TERMHA, + $TERM1Z,TERM2Z,TERM1L,TERM2L,TERM1H,TERM2H,TERM1A,TERM2A + REAL COSL,SINL,BPWI(2),BPLWI(2) + REAL BWI(2),AS,BS,COST,SINT,SNIZ + REAL GLLF1L,GRRF1R,GLGLL,GRGRR,GLLF2L,GRRF2R,TMZZRL,TMZZLR, + $TM1ZRL,TM1ZLR,TM2ZRL,TM2ZLR + REAL ASMB,MBMB,MBQ,ASMT,MTMT,MTQ,SUALFS + REAL SUALFE,MTAMTA,MTAMB,MTAMZ,AMPL + REAL FUDGE + DOUBLE PRECISION SSMQCD + COMPLEX ZI,ZONE,ZA,ZB,ZPP,ZPM,ZAUIZ,ZBUIZ,ZADIZ,ZBDIZ, + $ZALIZ,ZBLIZ,Z1(2),Z2(2) + INTEGER IW,JZ,IZ,ISZIZ,ISWIW + DATA FUDGE/1.0/ + DATA ZONE/(1.,0.)/,ZI/(0.,1.)/ +C +C Constants from neutralino mass matrix +C + AMPL=2.4E18 + PI=4.*ATAN(1.) + SR2=SQRT(2.) + G=SQRT(4*PI*ALFAEM/SN2THW) + GP=G*SQRT(SN2THW/(1.-SN2THW)) + E=SQRT(4*PI/128.) +C + TANW=SQRT(SN2THW/(1.-SN2THW)) + COTW=1./TANW + STHW=SQRT(SN2THW) + CTHW=SQRT(1.-SN2THW) + APL=.25*(3*TANW-COTW) + BTL=.25*(COTW+TANW) + APN=.25*(TANW+COTW) + BTN=-.25*(COTW+TANW) + APU=-5*TANW/12.+COTW/4. + BTU=-.25*(COTW+TANW) + APD=-COTW/4.+TANW/12. + BTD=.25*(COTW+TANW) +C + TANB=1./RV2V1 + BE=ATAN(1./RV2V1) + SINBE=SIN(BE) + COSBE=COS(BE) + XM=1./TAN(GAMMAL) + YM=1./TAN(GAMMAR) + THX=SIGN(1.,XM) + THY=SIGN(1.,YM) + ASMB=SUALFS(AMBT**2,.36,AMTP,3) + MBMB=AMBT*(1.-4*ASMB/3./PI) + MBQ=SSMQCD(DBLE(MBMB),DBLE(AMTP)) + ASMT=SUALFS(AMTP**2,.36,AMTP,3) + MTMT=AMTP/(1.+4*ASMT/3./PI+(16.11-1.04*(5.-6.63/AMTP))* + $(ASMT/PI)**2) + MTQ=SSMQCD(DBLE(MTMT),DBLE(AMTP)) + FB=G*MBQ/SR2/AMW/COS(BE) + FT=G*MTQ/SR2/AMW/SIN(BE) + MTAMTA=AMTAU*(1.-SUALFE(AMTAU**2)/PI) + MTAMB=MTAMTA*(SUALFE(AMBT**2)/SUALFE(AMTAU**2))**(-27./76.) + MTAMZ=MTAMB*(SUALFE(AMZ**2)/SUALFE(AMBT**2))**(-27./80.) + FL=G*MTAMZ/SR2/AMW/COS(BE) + SNW1=SIGN(1.,AMW1SS) + SNW2=SIGN(1.,AMW2SS) + AMWISS(1)=AMW1SS + AMWISS(2)=AMW2SS + BWI(1)=-FT*SNW1*COS(GAMMAR) + BWI(2)=FT*SNW2*THY*SIN(GAMMAR) + BPWI(1)=-FB*COS(GAMMAL) + BPWI(2)=FB*THX*SIN(GAMMAL) + BPLWI(1)=-FL*COS(GAMMAL) + BPLWI(2)=FL*THX*SIN(GAMMAL) + MW1=ABS(AMW1SS) + MW2=ABS(AMW2SS) + XWINO=.5*(THX*SIN(GAMMAL)*COS(GAMMAL) + $-THY*SIN(GAMMAR)*COS(GAMMAR)) + YWINO=.5*(THX*SIN(GAMMAL)*COS(GAMMAL) + $+THY*SIN(GAMMAR)*COS(GAMMAR)) + COST=COS(THETAT) + SINT=SIN(THETAT) + COSB=COS(THETAB) + SINB=SIN(THETAB) + COSL=COS(THETAL) + SINL=SIN(THETAL) +C +C Constants from Higgs mass matrix +C + SINA=SIN(ALFAH) + COSA=COS(ALFAH) +C +C Gaugino couplings +C + DO 100 IZ=1,4 + AUI(IZ)=G/SR2*ZMIXSS(3,IZ)+GP/3./SR2*ZMIXSS(4,IZ) + BUI(IZ)=4.*GP/3./SR2*ZMIXSS(4,IZ) + ADI(IZ)=-G/SR2*ZMIXSS(3,IZ)+GP/3./SR2*ZMIXSS(4,IZ) + BDI(IZ)=-2.*GP/3./SR2*ZMIXSS(4,IZ) + ALI(IZ)=G/SR2*ZMIXSS(3,IZ)+GP/SR2*ZMIXSS(4,IZ) + BLI(IZ)=-SR2*GP*ZMIXSS(4,IZ) + ANI(IZ)=G/SR2*ZMIXSS(3,IZ)-GP/SR2*ZMIXSS(4,IZ) + BNI(IZ)=0.0 +100 CONTINUE +C + DO 110 IZ=1,4 + DO 110 JZ=1,4 + IF(IZ.LT.JZ) THEN + WIJ(IZ,JZ)=SQRT(G**2+GP**2) + $ *(ZMIXSS(1,IZ)*ZMIXSS(1,JZ)-ZMIXSS(2,IZ)*ZMIXSS(2,JZ))/4. + ELSEIF(IZ.GT.JZ) THEN + WIJ(IZ,JZ)=-SQRT(G**2+GP**2) + $ *(ZMIXSS(1,IZ)*ZMIXSS(1,JZ)-ZMIXSS(2,IZ)*ZMIXSS(2,JZ))/4. + ENDIF +110 CONTINUE +C + AUWI(2)=G*THX*COS(GAMMAL) + ADWI(2)=SNW2*G*THY*COS(GAMMAR) + ALWI(2)=ADWI(2) + ANWI(2)=AUWI(2) + AUWI(1)=G*SIN(GAMMAL) + ADWI(1)=SNW1*G*SIN(GAMMAR) + ALWI(1)=ADWI(1) + ANWI(1)=AUWI(1) +C + DO 120 IZ=1,4 + XIM(IZ)=.5*(SNW1*SIGN(1.,AMZISS(IZ))*(COS(GAMMAR) + $ *ZMIXSS(1,IZ)/SR2+SIN(GAMMAR)*ZMIXSS(3,IZ))-COS(GAMMAL) + $ *ZMIXSS(2,IZ)/SR2+SIN(GAMMAL)*ZMIXSS(3,IZ)) + YIM(IZ)=.5*(-SNW1*SIGN(1.,AMZISS(IZ))*(COS(GAMMAR) + $ *ZMIXSS(1,IZ)/SR2+SIN(GAMMAR)*ZMIXSS(3,IZ))-COS(GAMMAL) + $ *ZMIXSS(2,IZ)/SR2+SIN(GAMMAL)*ZMIXSS(3,IZ)) + XIP(IZ)=.5*(SNW2*SIGN(1.,AMZISS(IZ))*THY*(-SIN(GAMMAR) + $ *ZMIXSS(1,IZ)/SR2+COS(GAMMAR)*ZMIXSS(3,IZ))+THX*(SIN(GAMMAL) + $ *ZMIXSS(2,IZ)/SR2+COS(GAMMAL)*ZMIXSS(3,IZ))) + YIP(IZ)=.5*(-SNW2*SIGN(1.,AMZISS(IZ))*THY*(-SIN(GAMMAR) + $ *ZMIXSS(1,IZ)/SR2+COS(GAMMAR)*ZMIXSS(3,IZ))+THX*(SIN(GAMMAL) + $ *ZMIXSS(2,IZ)/SR2+COS(GAMMAL)*ZMIXSS(3,IZ))) +120 CONTINUE +C + DO 130 IZ=1,4 + DO 130 JZ=1,4 + IF(IZ.NE.JZ) THEN + SNIJ(IZ,JZ)=-1.*SIGN(1.,AMZISS(IZ))*SIGN(1.,AMZISS(JZ)) + XLIJ(IZ,JZ)=-SIGN(1.,AMZISS(IZ))*SIGN(1.,AMZISS(JZ)) + $ *(ZMIXSS(2,IZ)*SINA-ZMIXSS(1,IZ)*COSA) + $ *(G*ZMIXSS(3,JZ)-GP*ZMIXSS(4,JZ))/2. + XHIJ(IZ,JZ)=-SIGN(1.,AMZISS(IZ))*SIGN(1.,AMZISS(JZ)) + $ *(ZMIXSS(2,IZ)*COSA+ZMIXSS(1,IZ)*SINA) + $ *(G*ZMIXSS(3,JZ)-GP*ZMIXSS(4,JZ))/2. + XPIJ(IZ,JZ)=SIGN(1.,AMZISS(IZ))*SIGN(1.,AMZISS(JZ)) + $ *(ZMIXSS(2,IZ)*SINBE-ZMIXSS(1,IZ)*COSBE) + $ *(G*ZMIXSS(3,JZ)-GP*ZMIXSS(4,JZ))/2. + HIJ(IZ,JZ)=-SIGN(1.,AMZISS(IZ))*SIGN(1.,AMZISS(JZ)) + $ *(ZMIXSS(2,IZ)*COSA+ZMIXSS(1,IZ)*SINA) + $ *(G*ZMIXSS(3,JZ)-GP*ZMIXSS(4,JZ))/2. + ENDIF +130 CONTINUE +C + SP=-.5*(-THY*SNW2*COSBE*SIN(GAMMAL)*SIN(GAMMAR)+ + $THY*SNW2*SINBE*COS(GAMMAL)*COS(GAMMAR)- + $THX*SNW1*COSBE*COS(GAMMAL)*COS(GAMMAR)+ + $THX*SNW1*SINBE*SIN(GAMMAL)*SIN(GAMMAR)) + PP=-.5*(-THY*SNW2*COSBE*SIN(GAMMAL)*SIN(GAMMAR)+ + $THY*SNW2*SINBE*COS(GAMMAL)*COS(GAMMAR)+ + $THX*SNW1*COSBE*COS(GAMMAL)*COS(GAMMAR)- + $THX*SNW1*SINBE*SIN(GAMMAL)*SIN(GAMMAR)) +C + SL=.5*(THY*SNW2*SINA*COS(GAMMAL)*COS(GAMMAR)- + $THY*SNW2*COSA*SIN(GAMMAL)*SIN(GAMMAR)+ + $THX*SNW1*COSA*COS(GAMMAL)*COS(GAMMAR)- + $THX*SNW1*SINA*SIN(GAMMAL)*SIN(GAMMAR)) + PL=.5*(THY*SNW2*SINA*COS(GAMMAL)*COS(GAMMAR)- + $THY*SNW2*COSA*SIN(GAMMAL)*SIN(GAMMAR)- + $THX*SNW1*COSA*COS(GAMMAL)*COS(GAMMAR)+ + $THX*SNW1*SINA*SIN(GAMMAL)*SIN(GAMMAR)) +C + SH=.5*(THY*SNW2*COSA*COS(GAMMAL)*COS(GAMMAR)+ + $THY*SNW2*SINA*SIN(GAMMAL)*SIN(GAMMAR)- + $THX*SNW1*SINA*COS(GAMMAL)*COS(GAMMAR)- + $THX*SNW1*COSA*SIN(GAMMAL)*SIN(GAMMAR)) + PH=.5*(THY*SNW2*COSA*COS(GAMMAL)*COS(GAMMAR)+ + $THY*SNW2*SINA*SIN(GAMMAL)*SIN(GAMMAR)+ + $THX*SNW1*SINA*COS(GAMMAL)*COS(GAMMAR)+ + $THX*SNW1*COSA*SIN(GAMMAL)*SIN(GAMMAR)) +C + DO 140 IZ=1,4 + V1I(IZ)=-SIN(GAMMAR)/SR2*(G*ZMIXSS(3,IZ)+GP*ZMIXSS(4,IZ)) + $ -G*COS(GAMMAR)*ZMIXSS(1,IZ) + V2I(IZ)=COS(GAMMAR)/SR2*(G*ZMIXSS(3,IZ)+GP*ZMIXSS(4,IZ)) + $ -G*SIN(GAMMAR)*ZMIXSS(1,IZ) + V3I(IZ)=-SIN(GAMMAL)/SR2*(G*ZMIXSS(3,IZ)+GP*ZMIXSS(4,IZ)) + $ +G*COS(GAMMAL)*ZMIXSS(2,IZ) + V4I(IZ)=COS(GAMMAL)/SR2*(G*ZMIXSS(3,IZ)+GP*ZMIXSS(4,IZ)) + $ +G*SIN(GAMMAL)*ZMIXSS(2,IZ) +140 CONTINUE +C----------------------------------------------------------------------- +C Generate Neutralino zi Branching Fractions +C----------------------------------------------------------------------- + ISZ(1)=ISZ1 + ISZ(2)=ISZ2 + ISZ(3)=ISZ3 + ISZ(4)=ISZ4 +C + DO 200 IZ=2,4 + MZIZ=ABS(AMZISS(IZ)) + SNIZ=SIGN(1.,AMZISS(IZ)) + IF (SNIZ.EQ.1.) THEN + THIZ=0 + ELSE + THIZ=1 + END IF + ISZIZ=ISZ(IZ) +C z2 --> z1 + photon +C !!! NEEDS UPDATING + IF (IZ.EQ.2.AND.(ABS(ZMIXSS(3,1)).LE.1.E-4).AND. + $ (ABS(ZMIXSS(4,1)).LE.1.E-4)) THEN + CALL SSSAVE(ISZ2,1.,ISZ1,IDGM,0,0,0) + GOTO 200 + END IF +C +C zi --> wi + x partial widths +C + DO 205 IW=1,2 +C Loop over w1, w2 + IF(IW.EQ.1) THEN + MWIW=MW1 + SNIW=SNW1 + ISWIW=ISW1 + ELSE + MWIW=MW2 + SNIW=SNW2 + ISWIW=ISW2 + ENDIF +C +C zi -> wj + w +C + IF(MZIZ.GT.MWIW+AMW) THEN + EF=MZIZ**2+MWIW**2-AMW**2+((MZIZ**2-MWIW**2)**2 + $ -AMW**4)/AMW/AMW + WID=G*G*SQRT(SSXLAM(MZIZ**2,AMW**2,MWIW**2))/32./PI/ + $ MZIZ**3*(2.*EF*(XIM(IZ)**2+YIM(IZ)**2)-12.* + $ MZIZ*MWIW*(XIM(IZ)**2-YIM(IZ)**2)) + CALL SSSAVE(ISZIZ,WID,+ISWIW,-IDW,0,0,0) + CALL SSSAVE(ISZIZ,WID,-ISWIW,+IDW,0,0,0) +C +C zi -> wj + f + fbar (w forbidden) ONLY W CONTRIBUTION INCLUDED! +C + ELSEIF(MZIZ.GT.FUDGE*MWIW) THEN + TMP(1)=MWIW + TMP(2)=MZIZ + IF(IW.EQ.1) THEN + TMP(3)=XIM(IZ) + TMP(4)=YIM(IZ) + ELSE + TMP(3)=XIP(IZ) + TMP(4)=YIP(IZ) + ENDIF + WID=G**4/96./PI**3/MZIZ + $ *SSXINT(MWIW,SSZWF1,(MWIW**2+MZIZ**2)/2./MZIZ) + CALL SSSAVE(ISZIZ,3.*WID,-ISWIW,IDUP,-IDDN,0,0) + Z1(1)=(-ZI)**THIZ*G*TMP(3) + Z1(2)=(-ZI)**THIZ*G*TMP(4) + Z2(1)=G/2./SR2 + Z2(2)=-Z2(1) + CALL SSME3(1,AMW,Z1,Z2) + CALL SSSAVE(ISZIZ,WID,-ISWIW,IDNE,-IDE,0,0) + CALL SSME3(1,AMW,Z1,Z2) + CALL SSSAVE(ISZIZ,WID,-ISWIW,IDNM,-IDMU,0,0) + CALL SSME3(1,AMW,Z1,Z2) + CALL SSSAVE(ISZIZ,3.*WID,ISWIW,IDDN,-IDUP,0,0) + CALL SSME3(1,AMW,Z1,Z2) + CALL SSSAVE(ISZIZ,WID,ISWIW,IDE,-IDNE,0,0) + CALL SSME3(1,AMW,Z1,Z2) + CALL SSSAVE(ISZIZ,WID,ISWIW,IDMU,-IDNM,0,0) + CALL SSME3(1,AMW,Z1,Z2) + IF (MZIZ.GT.(MWIW+AMCH+AMST)) THEN + CALL SSSAVE(ISZIZ,3.*WID,-ISWIW,IDCH,-IDST,0,0) + CALL SSME3(1,AMW,Z1,Z2) + CALL SSSAVE(ISZIZ,WID,-ISWIW,IDNT,-IDTAU,0,0) + CALL SSME3(1,AMW,Z1,Z2) + CALL SSSAVE(ISZIZ,3.*WID,ISWIW,IDST,-IDCH,0,0) + CALL SSME3(1,AMW,Z1,Z2) + CALL SSSAVE(ISZIZ,WID,ISWIW,IDTAU,-IDNT,0,0) + CALL SSME3(1,AMW,Z1,Z2) + ENDIF + ENDIF +C +C zi --> wj + hc +C + IF (MZIZ.GT.(MWIW+AMHC)) THEN + IF (IW.EQ.1) THEN + A=(SNW1*COSBE*V2I(IZ)-SIGN(1.,AMZISS(IZ)) + $ *SINBE*V4I(IZ))/2. + B=(SNW1*COSBE*V2I(IZ)+SIGN(1.,AMZISS(IZ)) + $ *SINBE*V4I(IZ))/2. + ELSE + A=(THY*SNW2*COSBE*V1I(IZ)-SIGN(1.,AMZISS(IZ)) + $ *THX*SINBE*V3I(IZ))/2. + B=(THY*SNW2*COSBE*V1I(IZ)+SIGN(1.,AMZISS(IZ)) + $ *THX*SINBE*V3I(IZ))/2. + END IF + WID=SQRT(MWIW**4+MZIZ**4+AMHC**4-2.*(MWIW*MZIZ)**2 + $ -2*(MWIW*AMHC)**2-2*(MZIZ*AMHC)**2)/8./PI/MZIZ**3 + $ *((A*A+B*B)*(MWIW*MWIW+MZIZ*MZIZ-AMHC*AMHC)/2. + $ +(A*A-B*B)*MWIW*MZIZ) + CALL SSSAVE(ISZIZ,WID,+ISWIW,-ISHC,0,0,0) + CALL SSSAVE(ISZIZ,WID,-ISWIW,+ISHC,0,0,0) + ENDIF +205 CONTINUE +C +C zi --> zj + z +C +C Note that if m(zi) > m(zj) + m(z), then the z terms are +C omitted from the zi -> zj + f + fbar calculation, so there +C is no double counting with zi -> zj + z. +C + DO 210 JZ=1,IZ-1 + MZJZ=ABS(AMZISS(JZ)) + IF(MZIZ.GT.(MZJZ+AMZ)) THEN + SN=-1.*SIGN(1.,AMZISS(IZ))*SIGN(1.,AMZISS(JZ)) + WID=WIJ(JZ,IZ)**2/(2.*PI)/(MZIZ)**3*SQRT(MZIZ**4+MZJZ**4 + $ +AMZ**4-2.*(MZIZ*MZJZ)**2-2.*(MZIZ*AMZ)**2-2.*(MZJZ*AMZ)**2) + $ *((MZIZ**2+MZJZ**2-AMZ**2)/2.+((MZIZ**2-MZJZ**2)**2-AMZ**4)/ + $ 2./AMZ**2-3.*SN*MZIZ*MZJZ) + CALL SSSAVE(ISZIZ,WID,ISZ(JZ),IDZ,0,0,0) + END IF +210 CONTINUE +C +C zi --> zj + f + fbar +C + DO 220 JZ=1,IZ-1 + MZJZ=ABS(AMZISS(JZ)) + SNJZ=SIGN(1.,AMZISS(JZ)) + IF (SNJZ.EQ.1.) THEN + THJZ=0 + ELSE + THJZ=1 + END IF + IF(MZIZ.LT.FUDGE*MZJZ) GO TO 220 + FAC=1./2./MZIZ/(2.*PI)**5*PI**2*MZIZ**2 +C Leptons -- Z decay allowed, so omit Z + TMP(1)=MZIZ + TMP(2)=MZJZ + TMP(4)=-SNIJ(JZ,IZ) + TMP(6)=0. +C zi -> zj + u + ubar + IF (MZIZ.GT.(MZJZ+2*AMUP)) THEN + IF (MZIZ.LT.AMULSS) THEN + TMP(3)=AMULSS + TERMLL=3*2*AUI(JZ)**2*AUI(IZ)**2*FAC*SSXINT(0.,SSZZF1,1.) + ELSE + TERMLL=0. + END IF + IF (MZIZ.LT.AMURSS) THEN + TMP(3)=AMURSS + TERMRR=3*2*BUI(JZ)**2*BUI(IZ)**2*FAC*SSXINT(0.,SSZZF1,1.) + ELSE + TERMRR=0. + END IF + IF (MZIZ.LT.(MZJZ+AMZ)) THEN + TMP(4)=+SNIJ(JZ,IZ) + TERMZZ=3*(APU**2+BTU**2)*E**2*WIJ(JZ,IZ)**2/MZIZ + $ *SSXINT(MZJZ,SSZZF2,(MZIZ**2+MZJZ**2)/2./MZIZ) + ELSE + TERMZZ=0. + END IF + IF (MZIZ.LT.AMULSS.AND.MZIZ.LT.(MZJZ+AMZ)) THEN + TMP(4)=+SNIJ(JZ,IZ) + TMP(3)=AMULSS + TERMLZ=3*8*E*(APU-BTU)*WIJ(JZ,IZ)*AUI(JZ)*AUI(IZ)/MZIZ + $ /(2*PI)**5*SSXINT(0.,SSZZF3,(MZIZ-MZJZ)**2) + ELSE + TERMLZ=0. + END IF + IF (MZIZ.LT.AMURSS.AND.MZIZ.LT.(MZJZ+AMZ)) THEN + TMP(4)=+SNIJ(JZ,IZ) + TMP(3)=AMURSS + TERMRZ=-3*8*E*(APU+BTU)*WIJ(JZ,IZ)*BUI(JZ)*BUI(IZ)/MZIZ + $ /(2*PI)**5*SSXINT(0.,SSZZF3,(MZIZ-MZJZ)**2) + ELSE + TERMRZ=0. + END IF + WID=TERMLL+TERMRR+TERMZZ+TERMLZ+TERMRZ + CALL SSSAVE(ISZIZ,WID,ISZ(JZ),IDUP,-IDUP,0,0) +C Enter information for decay matrix element + IF (-1.*SNIJ(JZ,IZ).GT.0.) THEN + Z1(1)=0. + Z1(2)=2*E*WIJ(JZ,IZ) + ELSE + Z1(1)=2*E*WIJ(JZ,IZ) + Z1(2)=0. + END IF + Z2(1)=APU + Z2(2)=BTU + CALL SSME3(1,AMZ,Z1,Z2) + Z1(1)=ZI**(THIZ-1)*(-1.)**(THIZ+1)*AUI(IZ)/2. + Z1(2)=-Z1(1) + Z2(1)=CONJG(ZI**(THJZ-1)*(-1.)**(THJZ+1)*AUI(JZ)/2.) + Z2(2)=Z2(1) + CALL SSME3(2,AMULSS,Z1,Z2) + Z1(1)=ZI**(THIZ-1)*BUI(IZ)/2. + Z1(2)=Z1(1) + Z2(1)=CONJG(ZI**(THJZ-1)*BUI(JZ)/2.) + Z2(2)=-Z2(1) + CALL SSME3(2,AMURSS,Z1,Z2) + Z1(1)=ZI**(THJZ-1)*(-1.)**(THJZ+1)*AUI(JZ)/2. + Z1(2)=-Z1(1) + Z2(1)=-CONJG(ZI**(THIZ-1)*(-1.)**(THIZ+1)*AUI(IZ)/2.) + Z2(2)=Z2(1) + CALL SSME3(3,AMULSS,Z1,Z2) + Z1(1)=ZI**(THJZ-1)*BUI(JZ)/2. + Z1(2)=Z1(1) + Z2(1)=-CONJG(ZI**(THIZ-1)*BUI(IZ)/2.) + Z2(2)=-Z2(1) + CALL SSME3(3,AMURSS,Z1,Z2) + END IF +C zi -> zj + d + dbar + TMP(4)=-SNIJ(JZ,IZ) + IF (MZIZ.GT.(MZJZ+2*AMDN)) THEN + IF (MZIZ.LT.AMDLSS) THEN + TMP(3)=AMDLSS + TERMLL=3*2*ADI(JZ)**2*ADI(IZ)**2*FAC*SSXINT(0.,SSZZF1,1.) + ELSE + TERMLL=0. + END IF + IF (MZIZ.LT.AMDRSS) THEN + TMP(3)=AMDRSS + TERMRR=3*2*BDI(JZ)**2*BDI(IZ)**2*FAC*SSXINT(0.,SSZZF1,1.) + ELSE + TERMRR=0. + END IF + IF (MZIZ.LT.(MZJZ+AMZ)) THEN + TMP(4)=+SNIJ(JZ,IZ) + TERMZZ=3*(APD**2+BTD**2)*E**2*WIJ(JZ,IZ)**2/MZIZ + $ *SSXINT(MZJZ,SSZZF2,(MZIZ**2+MZJZ**2)/2./MZIZ) + ELSE + TERMZZ=0. + END IF + IF (MZIZ.LT.AMDLSS.AND.MZIZ.LT.(MZJZ+AMZ)) THEN + TMP(4)=+SNIJ(JZ,IZ) + TMP(3)=AMDLSS + TERMLZ=3*8*E*(APD-BTD)*WIJ(JZ,IZ)*ADI(JZ)*ADI(IZ)/MZIZ + $ /(2*PI)**5*SSXINT(0.,SSZZF3,(MZIZ-MZJZ)**2) + ELSE + TERMLZ=0. + END IF + IF (MZIZ.LT.AMDRSS.AND.MZIZ.LT.(MZJZ+AMZ)) THEN + TMP(4)=+SNIJ(JZ,IZ) + TMP(3)=AMDRSS + TERMRZ=-3*8*E*(APD+BTD)*WIJ(JZ,IZ)*BDI(JZ)*BDI(IZ)/MZIZ + $ /(2*PI)**5*SSXINT(0.,SSZZF3,(MZIZ-MZJZ)**2) + ELSE + TERMRZ=0. + END IF + WID=TERMLL+TERMRR+TERMZZ+TERMLZ+TERMRZ + CALL SSSAVE(ISZIZ,WID,ISZ(JZ),IDDN,-IDDN,0,0) +C Enter information for decay matrix element + IF (-1.*SNIJ(JZ,IZ).GT.0.) THEN + Z1(1)=0. + Z1(2)=2*E*WIJ(JZ,IZ) + ELSE + Z1(1)=2*E*WIJ(JZ,IZ) + Z1(2)=0. + END IF + Z2(1)=APD + Z2(2)=BTD + CALL SSME3(1,AMZ,Z1,Z2) + Z1(1)=ZI**(THIZ-1)*(-1.)**(THIZ+1)*ADI(IZ)/2. + Z1(2)=-Z1(1) + Z2(1)=CONJG(ZI**(THJZ-1)*(-1.)**(THJZ+1)*ADI(JZ)/2.) + Z2(2)=Z2(1) + CALL SSME3(2,AMDLSS,Z1,Z2) + Z1(1)=ZI**(THIZ-1)*BDI(IZ)/2. + Z1(2)=Z1(1) + Z2(1)=CONJG(ZI**(THJZ-1)*BDI(JZ)/2.) + Z2(2)=-Z2(1) + CALL SSME3(2,AMDRSS,Z1,Z2) + Z1(1)=ZI**(THJZ-1)*(-1.)**(THJZ+1)*ADI(JZ)/2. + Z1(2)=-Z1(1) + Z2(1)=-CONJG(ZI**(THIZ-1)*(-1.)**(THIZ+1)*ADI(IZ)/2.) + Z2(2)=Z2(1) + CALL SSME3(3,AMDLSS,Z1,Z2) + Z1(1)=ZI**(THJZ-1)*BDI(JZ)/2. + Z1(2)=Z1(1) + Z2(1)=-CONJG(ZI**(THIZ-1)*BDI(IZ)/2.) + Z2(2)=-Z2(1) + CALL SSME3(3,AMDRSS,Z1,Z2) + END IF +C zi -> zj + s + sbar + TMP(4)=-SNIJ(JZ,IZ) + IF (MZIZ.GT.(MZJZ+2*AMST)) THEN + IF (MZIZ.LT.AMSLSS) THEN + TMP(3)=AMSLSS + TERMLL=3*2*ADI(JZ)**2*ADI(IZ)**2*FAC*SSXINT(0.,SSZZF1,1.) + ELSE + TERMLL=0. + END IF + IF (MZIZ.LT.AMSRSS) THEN + TMP(3)=AMSRSS + TERMRR=3*2*BDI(JZ)**2*BDI(IZ)**2*FAC*SSXINT(0.,SSZZF1,1.) + ELSE + TERMRR=0. + END IF + IF (MZIZ.LT.(MZJZ+AMZ)) THEN + TMP(4)=+SNIJ(JZ,IZ) + TERMZZ=3*(APD**2+BTD**2)*E**2*WIJ(JZ,IZ)**2/MZIZ + $ *SSXINT(MZJZ,SSZZF2,(MZIZ**2+MZJZ**2)/2./MZIZ) + ELSE + TERMZZ=0. + END IF + IF (MZIZ.LT.AMSLSS.AND.MZIZ.LT.(MZJZ+AMZ)) THEN + TMP(4)=+SNIJ(JZ,IZ) + TMP(3)=AMSLSS + TERMLZ=3*8*E*(APD-BTD)*WIJ(JZ,IZ)*ADI(JZ)*ADI(IZ)/MZIZ + $ /(2*PI)**5*SSXINT(0.,SSZZF3,(MZIZ-MZJZ)**2) + ELSE + TERMLZ=0. + END IF + IF (MZIZ.LT.AMSRSS.AND.MZIZ.LT.(MZJZ+AMZ)) THEN + TMP(4)=+SNIJ(JZ,IZ) + TMP(3)=AMSRSS + TERMRZ=-3*8*E*(APD+BTD)*WIJ(JZ,IZ)*BDI(JZ)*BDI(IZ)/MZIZ + $ /(2*PI)**5*SSXINT(0.,SSZZF3,(MZIZ-MZJZ)**2) + ELSE + TERMRZ=0. + END IF + WID=TERMLL+TERMRR+TERMZZ+TERMLZ+TERMRZ + CALL SSSAVE(ISZIZ,WID,ISZ(JZ),IDST,-IDST,0,0) +C Enter information for decay matrix element + IF (-1.*SNIJ(JZ,IZ).GT.0.) THEN + Z1(1)=0. + Z1(2)=2*E*WIJ(JZ,IZ) + ELSE + Z1(1)=2*E*WIJ(JZ,IZ) + Z1(2)=0. + END IF + Z2(1)=APD + Z2(2)=BTD + CALL SSME3(1,AMZ,Z1,Z2) + Z1(1)=ZI**(THIZ-1)*(-1.)**(THIZ+1)*ADI(IZ)/2. + Z1(2)=-Z1(1) + Z2(1)=CONJG(ZI**(THJZ-1)*(-1.)**(THJZ+1)*ADI(JZ)/2.) + Z2(2)=Z2(1) + CALL SSME3(2,AMSLSS,Z1,Z2) + Z1(1)=ZI**(THIZ-1)*BDI(IZ)/2. + Z1(2)=Z1(1) + Z2(1)=CONJG(ZI**(THJZ-1)*BDI(JZ)/2.) + Z2(2)=-Z2(1) + CALL SSME3(2,AMSRSS,Z1,Z2) + Z1(1)=ZI**(THJZ-1)*(-1.)**(THJZ+1)*ADI(JZ)/2. + Z1(2)=-Z1(1) + Z2(1)=-CONJG(ZI**(THIZ-1)*(-1.)**(THIZ+1)*ADI(IZ)/2.) + Z2(2)=Z2(1) + CALL SSME3(3,AMSLSS,Z1,Z2) + Z1(1)=ZI**(THJZ-1)*BDI(JZ)/2. + Z1(2)=Z1(1) + Z2(1)=-CONJG(ZI**(THIZ-1)*BDI(IZ)/2.) + Z2(2)=-Z2(1) + CALL SSME3(3,AMSRSS,Z1,Z2) + END IF +C zi -> zj + c + cbar + TMP(4)=-SNIJ(JZ,IZ) + IF (MZIZ.GT.(MZJZ+2*AMCH)) THEN + IF (MZIZ.LT.AMCLSS) THEN + TMP(3)=AMCLSS + TERMLL=3*2*AUI(JZ)**2*AUI(IZ)**2*FAC*SSXINT(0.,SSZZF1,1.) + ELSE + TERMLL=0. + END IF + IF (MZIZ.LT.AMCRSS) THEN + TMP(3)=AMCRSS + TERMRR=3*2*BUI(JZ)**2*BUI(IZ)**2*FAC*SSXINT(0.,SSZZF1,1.) + ELSE + TERMRR=0. + END IF + IF (MZIZ.LT.(MZJZ+AMZ)) THEN + TMP(4)=+SNIJ(JZ,IZ) + TERMZZ=3*(APU**2+BTU**2)*E**2*WIJ(JZ,IZ)**2/MZIZ + $ *SSXINT(MZJZ,SSZZF2,(MZIZ**2+MZJZ**2)/2./MZIZ) + ELSE + TERMZZ=0. + END IF + IF (MZIZ.LT.AMCLSS.AND.MZIZ.LT.(MZJZ+AMZ)) THEN + TMP(4)=+SNIJ(JZ,IZ) + TMP(3)=AMCLSS + TERMLZ=3*8*E*(APU-BTU)*WIJ(JZ,IZ)*AUI(JZ)*AUI(IZ)/MZIZ + $ /(2*PI)**5*SSXINT(0.,SSZZF3,(MZIZ-MZJZ)**2) + ELSE + TERMLZ=0. + END IF + IF (MZIZ.LT.AMCRSS.AND.MZIZ.LT.(MZJZ+AMZ)) THEN + TMP(4)=+SNIJ(JZ,IZ) + TMP(3)=AMCRSS + TERMRZ=-3*8*E*(APU+BTU)*WIJ(JZ,IZ)*BUI(JZ)*BUI(IZ)/MZIZ + $ /(2*PI)**5*SSXINT(0.,SSZZF3,(MZIZ-MZJZ)**2) + ELSE + TERMRZ=0. + END IF + WID=TERMLL+TERMRR+TERMZZ+TERMLZ+TERMRZ + CALL SSSAVE(ISZIZ,WID,ISZ(JZ),IDCH,-IDCH,0,0) +C Enter information for decay matrix element + IF (-1.*SNIJ(JZ,IZ).GT.0.) THEN + Z1(1)=0. + Z1(2)=2*E*WIJ(JZ,IZ) + ELSE + Z1(1)=2*E*WIJ(JZ,IZ) + Z1(2)=0. + END IF + Z2(1)=APU + Z2(2)=BTU + CALL SSME3(1,AMZ,Z1,Z2) + Z1(1)=ZI**(THIZ-1)*(-1.)**(THIZ+1)*AUI(IZ)/2. + Z1(2)=-Z1(1) + Z2(1)=CONJG(ZI**(THJZ-1)*(-1.)**(THJZ+1)*AUI(JZ)/2.) + Z2(2)=Z2(1) + CALL SSME3(2,AMCLSS,Z1,Z2) + Z1(1)=ZI**(THIZ-1)*BUI(IZ)/2. + Z1(2)=Z1(1) + Z2(1)=CONJG(ZI**(THJZ-1)*BUI(JZ)/2.) + Z2(2)=-Z2(1) + CALL SSME3(2,AMCRSS,Z1,Z2) + Z1(1)=ZI**(THJZ-1)*(-1.)**(THJZ+1)*AUI(JZ)/2. + Z1(2)=-Z1(1) + Z2(1)=-CONJG(ZI**(THIZ-1)*(-1.)**(THIZ+1)*AUI(IZ)/2.) + Z2(2)=Z2(1) + CALL SSME3(3,AMCLSS,Z1,Z2) + Z1(1)=ZI**(THJZ-1)*BUI(JZ)/2. + Z1(2)=Z1(1) + Z2(1)=-CONJG(ZI**(THIZ-1)*BUI(IZ)/2.) + Z2(2)=-Z2(1) + CALL SSME3(3,AMCRSS,Z1,Z2) + END IF +C zi -> zj + b+ bbar ; mixing/yukawa effects now included! +C thanks to M. Drees + FACT=1./2./(2*PI)**5/2./MZIZ + ALIZ1=ADI(IZ)*COSB-FB*ZMIXSS(2,IZ)*SINB + ALJZ1=ADI(JZ)*COSB-FB*ZMIXSS(2,JZ)*SINB + ALIZ2=ADI(IZ)*SINB+FB*ZMIXSS(2,IZ)*COSB + ALJZ2=ADI(JZ)*SINB+FB*ZMIXSS(2,JZ)*COSB + BEIZ1=BDI(IZ)*SINB+FB*ZMIXSS(2,IZ)*COSB + BEJZ1=BDI(JZ)*SINB+FB*ZMIXSS(2,JZ)*COSB + BEIZ2=-BDI(IZ)*COSB+FB*ZMIXSS(2,IZ)*SINB + BEJZ2=-BDI(JZ)*COSB+FB*ZMIXSS(2,JZ)*SINB + SGNIJ=-SNIJ(JZ,IZ) + XUPPER=(MZIZ**2+AMBT**2-(AMBT+MZJZ)**2)/2./MZIZ + IF (MZIZ.GT.(MZJZ+2*AMBT)) THEN + TMP(1)=MZIZ + TMP(2)=AMBT + TMP(3)=MZJZ + TMP(4)=AMB1SS + TMP(5)=AMB1SS + TMP(6)=AMBT + IF (MZIZ.LT.AMB1SS) THEN + GLLF1=4*ALIZ1**2*((ALJZ1**2+BEJZ1**2)* + , SSXINT(AMBT,SSGX1,XUPPER)+SGNIJ*ALJZ1**2* + , SSXINT(AMBT,SSGX2,XUPPER)) + GRRF1=4*BEIZ1**2*((ALJZ1**2+BEJZ1**2)* + , SSXINT(AMBT,SSGX1,XUPPER)+SGNIJ*BEJZ1**2* + , SSXINT(AMBT,SSGX2,XUPPER)) + GLRF1=-8*ALIZ1*BEIZ1*ALJZ1*BEJZ1* + , SSXINT(AMBT,SSGX8,XUPPER) + GF1=GLLF1+GRRF1+GLRF1 + ELSE + GF1=0. + END IF + IF (MZIZ.LT.AMB1SS) THEN + TMP(4)=AMB1SS + TMP(5)=AMB2SS + GLGL=8*ALIZ1*ALIZ2*(ALJZ1*ALJZ2+BEJZ1*BEJZ2)* + , SSXINT(AMBT,SSGX1,XUPPER)+SGNIJ*8*ALIZ1*ALIZ2* + , ALJZ1*ALJZ2*SSXINT(AMBT,SSGX2,XUPPER) + GRGR=8*BEIZ1*BEIZ2*(ALJZ1*ALJZ2+BEJZ1*BEJZ2)* + , SSXINT(AMBT,SSGX1,XUPPER)+SGNIJ*8*BEIZ1*BEIZ2* + , BEJZ1*BEJZ2*SSXINT(AMBT,SSGX2,XUPPER) + GLGR=-8*ALIZ1*BEIZ2*ALJZ2*BEJZ1* + , SSXINT(AMBT,SSGX8,XUPPER) + GRGL=-8*ALIZ2*BEIZ1*ALJZ1*BEJZ2* + , SSXINT(AMBT,SSGX8,XUPPER) + GF12=GLGL+GRGR+GLGR+GRGL + ELSE + GF12=0. + END IF + IF (MZIZ.LT.AMB2SS) THEN + TMP(4)=AMB2SS + TMP(5)=AMB2SS + GLLF2=4*ALIZ2**2*((ALJZ2**2+BEJZ2**2)* + , SSXINT(AMBT,SSGX1,XUPPER)+SGNIJ*ALJZ2**2* + , SSXINT(AMBT,SSGX2,XUPPER)) + GRRF2=4*BEIZ2**2*((ALJZ2**2+BEJZ2**2)* + , SSXINT(AMBT,SSGX1,XUPPER)+SGNIJ*BEJZ2**2* + , SSXINT(AMBT,SSGX2,XUPPER)) + GLRF2=-8*ALIZ2*BEIZ2*ALJZ2*BEJZ2* + , SSXINT(AMBT,SSGX8,XUPPER) + GF2=GLLF2+GRRF2+GLRF2 + ELSE + GF2=0. + END IF + GF=FACT*(GF1+GF2+GF12) + TMP(2)=MZJZ + IF (MZIZ.LT.(MZJZ+AMZ)) THEN + TMP(4)=+SNIJ(JZ,IZ) + TERMZZ=(APD**2+BTD**2)*E**2*WIJ(JZ,IZ)**2/MZIZ + $ *SSXINT(MZJZ,SSZZF2,(MZIZ**2+MZJZ**2-4*AMBT**2)/2./MZIZ) + ELSE + TERMZZ=0. + END IF + IF (MZIZ.LE.(MZJZ+AMHL)) THEN + TMP(3)=AMHL + TMP(5)=AMHL + TMP(4)=-SNIJ(JZ,IZ) + TERMHL=G**2/64./PI**3/MZIZ*(MBQ*SINA*(XLIJ(JZ,IZ)+ + $ XLIJ(IZ,JZ))/AMW/COSBE)**2* + $ SSXINT(MZJZ,SSZZF4,(MZIZ**2+MZJZ**2-4*AMBT**2)/2./MZIZ) + ELSE + TERMHL=0. + END IF + IF (MZIZ.LE.(MZJZ+AMHH)) THEN + TMP(3)=AMHH + TMP(5)=AMHH + TMP(4)=-SNIJ(JZ,IZ) + TERMHH=G**2/64./PI**3/MZIZ*(MBQ*COSA*(XHIJ(JZ,IZ)+ + $ XHIJ(IZ,JZ))/AMW/COSBE)**2* + $ SSXINT(MZJZ,SSZZF4,(MZIZ**2+MZJZ**2-4*AMBT**2)/2./MZIZ) + ELSE + TERMHH=0. + END IF + IF (MZIZ.LE.(MZJZ+AMHH).AND.MZIZ.LE.(MZJZ+AMHL)) THEN + TMP(3)=AMHL + TMP(5)=AMHH + TMP(4)=-SNIJ(JZ,IZ) + TERMLH=2*G**2/64./PI**3/MZIZ*(MBQ/AMW/COSBE)**2* + $ (COSA*(XHIJ(JZ,IZ)+XHIJ(IZ,JZ))*SINA* + $ (XLIJ(JZ,IZ)+XLIJ(IZ,JZ)))* + $ SSXINT(MZJZ,SSZZF4,(MZIZ**2+MZJZ**2-4*AMBT**2)/2./MZIZ) + ELSE + TERMLH=0. + END IF + IF (MZIZ.LE.(MZJZ+AMHA)) THEN + TMP(3)=AMHA + TMP(5)=AMHA + TMP(4)=SNIJ(JZ,IZ) + TERMHA=G**2*TANB**2/64./PI**3/MZIZ*(MBQ*(XPIJ(JZ,IZ)+ + $ XPIJ(IZ,JZ))/AMW)**2* + $ SSXINT(MZJZ,SSZZF4,(MZIZ**2+MZJZ**2-4*AMBT**2)/2./MZIZ) + ELSE + TERMHA=0. + END IF + IF (MZIZ.LT.AMB1SS.AND.MZIZ.LT.(MZJZ+AMZ)) THEN + TMP(4)=-SGNIJ + TMP(3)=AMB1SS + TERM1Z=8*E*WIJ(JZ,IZ)*(ALJZ1*ALIZ1*(APD-BTD)- + $ BEJZ1*BEIZ1*(APD+BTD))/MZIZ + $ /(2*PI)**5*SSXINT(4*AMBT**2,SSZZF3,(MZIZ-MZJZ)**2) + ELSE + TERM1Z=0. + END IF + IF (MZIZ.LT.AMB2SS.AND.MZIZ.LT.(MZJZ+AMZ)) THEN + TMP(4)=-SGNIJ + TMP(3)=AMB2SS + TERM2Z=8*E*WIJ(JZ,IZ)*(ALJZ2*ALIZ2*(APD-BTD)- + $ BEJZ2*BEIZ2*(APD+BTD))/MZIZ + $ /(2*PI)**5*SSXINT(4*AMBT**2,SSZZF3,(MZIZ-MZJZ)**2) + ELSE + TERM2Z=0. + END IF + IF (MZIZ.LT.AMB1SS.AND.MZIZ.LT.(MZJZ+AMHL)) THEN + TMP(3)=AMB1SS + TMP(4)=SGNIJ + TMP(5)=AMHL + TERM1L=2*PI*PI*G*MBQ*SINA*SGNIJ*(XLIJ(IZ,JZ)+ + $ XLIJ(JZ,IZ))*(ALIZ1*BEJZ1+ALJZ1*BEIZ1) + $ /MZIZ/AMW/COSBE*SSXINT(4*AMBT**2,SSZZF5,(MZIZ-MZJZ)**2) + TERM1L=FACT*TERM1L + ELSE + TERM1L=0. + END IF + IF (MZIZ.LT.AMB2SS.AND.MZIZ.LT.(MZJZ+AMHL)) THEN + TMP(3)=AMB2SS + TMP(4)=SGNIJ + TMP(5)=AMHL + TERM2L=2*PI*PI*G*MBQ*SINA*SGNIJ*(XLIJ(IZ,JZ)+ + $ XLIJ(JZ,IZ))*(ALIZ2*BEJZ2+ALJZ2*BEIZ2) + $ /MZIZ/AMW/COSBE*SSXINT(4*AMBT**2,SSZZF5,(MZIZ-MZJZ)**2) + TERM2L=FACT*TERM2L + ELSE + TERM2L=0. + END IF + IF (MZIZ.LT.AMB1SS.AND.MZIZ.LT.(MZJZ+AMHH)) THEN + TMP(3)=AMB1SS + TMP(4)=SGNIJ + TMP(5)=AMHH + TERM1H=2*PI*PI*G*MBQ*COSA*SGNIJ*(XHIJ(IZ,JZ)+ + $ XHIJ(JZ,IZ))*(ALIZ1*BEJZ1+ALJZ1*BEIZ1) + $ /MZIZ/AMW/COSBE*SSXINT(4*AMBT**2,SSZZF5,(MZIZ-MZJZ)**2) + TERM1H=FACT*TERM1H + ELSE + TERM1H=0. + END IF + IF (MZIZ.LT.AMB2SS.AND.MZIZ.LT.(MZJZ+AMHH)) THEN + TMP(3)=AMB2SS + TMP(4)=SGNIJ + TMP(5)=AMHH + TERM2H=2*PI*PI*G*MBQ*COSA*SGNIJ*(XHIJ(IZ,JZ)+ + $ XHIJ(JZ,IZ))*(ALIZ2*BEJZ2+ALJZ2*BEIZ2) + $ /MZIZ/AMW/COSBE*SSXINT(4*AMBT**2,SSZZF5,(MZIZ-MZJZ)**2) + TERM2H=FACT*TERM2H + ELSE + TERM2H=0. + END IF + IF (MZIZ.LT.AMB1SS.AND.MZIZ.LT.(MZJZ+AMHA)) THEN + TMP(3)=AMB1SS + TMP(4)=-SGNIJ + TMP(5)=AMHA + TERM1A=-2*PI*PI*G*MBQ*TANB*SGNIJ*(XPIJ(IZ,JZ)+ + $ XPIJ(JZ,IZ))*(ALIZ1*BEJZ1+ALJZ1*BEIZ1) + $ /MZIZ/AMW*SSXINT(4*AMBT**2,SSZZF5,(MZIZ-MZJZ)**2) + TERM1A=FACT*TERM1A + ELSE + TERM1A=0. + END IF + IF (MZIZ.LT.AMB2SS.AND.MZIZ.LT.(MZJZ+AMHA)) THEN + TMP(3)=AMB2SS + TMP(4)=-SGNIJ + TMP(5)=AMHA + TERM2A=-2*PI*PI*G*MBQ*TANB*SGNIJ*(XPIJ(IZ,JZ)+ + $ XPIJ(JZ,IZ))*(ALIZ2*BEJZ2+ALJZ2*BEIZ2) + $ /MZIZ/AMW*SSXINT(4*AMBT**2,SSZZF5,(MZIZ-MZJZ)**2) + TERM2A=FACT*TERM2A + ELSE + TERM2A=0. + END IF + WID=3*(GF+TERMZZ+TERMHL+TERMHH+TERMLH+TERMHA+TERM1Z+ + $ TERM2Z+TERM1L+TERM2L+TERM1H+TERM2H+TERM1A+TERM2A) + CALL SSSAVE(ISZIZ,WID,ISZ(JZ),IDBT,-IDBT,0,0) +C Enter information for decay matrix element + IF (-1.*SNIJ(JZ,IZ).GT.0.) THEN + Z1(1)=0. + Z1(2)=2*E*WIJ(JZ,IZ) + ELSE + Z1(1)=2*E*WIJ(JZ,IZ) + Z1(2)=0. + END IF + Z2(1)=APD + Z2(2)=BTD + CALL SSME3(1,AMZ,Z1,Z2) + Z1(1)=((ZI**(THIZ)*(-1.)**(THIZ+1)*ADI(IZ)- + $ FB*ZMIXSS(2,IZ)*ZI**THIZ)*COSB-(ZI**THIZ*BDI(IZ)- + $ FB*ZMIXSS(2,IZ)*(-ZI)**THIZ)*SINB)/2. + Z1(2)=((-ZI**(THIZ)*(-1.)**(THIZ+1)*ADI(IZ)- + $ FB*ZMIXSS(2,IZ)*ZI**THIZ)*COSB-(ZI**THIZ*BDI(IZ)+ + $ FB*ZMIXSS(2,IZ)*(-ZI)**THIZ)*SINB)/2. + Z2(1)=CONJG(((ZI**(THJZ)*(-1.)**(THJZ+1)*ADI(JZ)- + $ FB*ZMIXSS(2,JZ)*ZI**THJZ)*COSB-(ZI**THJZ*BDI(JZ)- + $ FB*ZMIXSS(2,JZ)*(-ZI)**THJZ)*SINB)/2.) + Z2(2)=-CONJG(((-ZI**(THJZ)*(-1.)**(THJZ+1)*ADI(JZ)- + $ FB*ZMIXSS(2,JZ)*ZI**THJZ)*COSB-(ZI**THJZ*BDI(JZ)+ + $ FB*ZMIXSS(2,JZ)*(-ZI)**THJZ)*SINB)/2.) + CALL SSME3(2,AMB1SS,Z1,Z2) + Z1(1)=((ZI**(THIZ)*(-1.)**(THIZ+1)*ADI(IZ)- + $ FB*ZMIXSS(2,IZ)*ZI**THIZ)*SINB+(ZI**THIZ*BDI(IZ)- + $ FB*ZMIXSS(2,IZ)*(-ZI)**THIZ)*COSB)/2. + Z1(2)=((-ZI**(THIZ)*(-1.)**(THIZ+1)*ADI(IZ)- + $ FB*ZMIXSS(2,IZ)*ZI**THIZ)*SINB+(ZI**THIZ*BDI(IZ)+ + $ FB*ZMIXSS(2,IZ)*(-ZI)**THIZ)*COSB)/2. + Z2(1)=CONJG(((ZI**(THJZ)*(-1.)**(THJZ+1)*ADI(JZ)- + $ FB*ZMIXSS(2,JZ)*ZI**THJZ)*SINB+(ZI**THJZ*BDI(JZ)- + $ FB*ZMIXSS(2,JZ)*(-ZI)**THJZ)*COSB)/2.) + Z2(2)=-CONJG(((-ZI**(THJZ)*(-1.)**(THJZ+1)*ADI(JZ)- + $ FB*ZMIXSS(2,JZ)*ZI**THJZ)*SINB+(ZI**THJZ*BDI(JZ)+ + $ FB*ZMIXSS(2,JZ)*(-ZI)**THJZ)*COSB)/2.) + CALL SSME3(2,AMB2SS,Z1,Z2) + Z1(1)=((ZI**(THJZ)*(-1.)**(THJZ+1)*ADI(JZ)- + $ FB*ZMIXSS(2,JZ)*ZI**THJZ)*COSB-(ZI**THJZ*BDI(JZ)- + $ FB*ZMIXSS(2,JZ)*(-ZI)**THJZ)*SINB)/2. + Z1(2)=((-ZI**(THJZ)*(-1.)**(THJZ+1)*ADI(JZ)- + $ FB*ZMIXSS(2,JZ)*ZI**THJZ)*COSB-(ZI**THJZ*BDI(JZ)+ + $ FB*ZMIXSS(2,JZ)*(-ZI)**THJZ)*SINB)/2. + Z2(1)=-CONJG(((ZI**(THIZ)*(-1.)**(THIZ+1)*ADI(IZ)- + $ FB*ZMIXSS(2,IZ)*ZI**THIZ)*COSB-(ZI**THIZ*BDI(IZ)- + $ FB*ZMIXSS(2,IZ)*(-ZI)**THIZ)*SINB)/2.) + Z2(2)=CONJG(((-ZI**(THIZ)*(-1.)**(THIZ+1)*ADI(IZ)- + $ FB*ZMIXSS(2,IZ)*ZI**THIZ)*COSB-(ZI**THIZ*BDI(IZ)+ + $ FB*ZMIXSS(2,IZ)*(-ZI)**THIZ)*SINB)/2.) + CALL SSME3(3,AMB1SS,Z1,Z2) + Z1(1)=((ZI**(THJZ)*(-1.)**(THJZ+1)*ADI(JZ)- + $ FB*ZMIXSS(2,JZ)*ZI**THJZ)*SINB+(ZI**THJZ*BDI(JZ)- + $ FB*ZMIXSS(2,JZ)*(-ZI)**THJZ)*COSB)/2. + Z1(2)=((-ZI**(THJZ)*(-1.)**(THJZ+1)*ADI(JZ)- + $ FB*ZMIXSS(2,JZ)*ZI**THJZ)*SINB+(ZI**THJZ*BDI(JZ)+ + $ FB*ZMIXSS(2,JZ)*(-ZI)**THJZ)*COSB)/2. + Z2(1)=-CONJG(((ZI**(THIZ)*(-1.)**(THIZ+1)*ADI(IZ)- + $ FB*ZMIXSS(2,IZ)*ZI**THIZ)*SINB+(ZI**THIZ*BDI(IZ)- + $ FB*ZMIXSS(2,IZ)*(-ZI)**THIZ)*COSB)/2.) + Z2(2)=CONJG(((-ZI**(THIZ)*(-1.)**(THIZ+1)*ADI(IZ)- + $ FB*ZMIXSS(2,IZ)*ZI**THIZ)*SINB+(ZI**THIZ*BDI(IZ)+ + $ FB*ZMIXSS(2,IZ)*(-ZI)**THIZ)*COSB)/2.) + CALL SSME3(3,AMB2SS,Z1,Z2) + IF (-1.*SNIJ(JZ,IZ).GT.0.) THEN + Z1(1)=(-ZI)**(THIZ+THJZ)*(XLIJ(IZ,JZ)+XLIJ(JZ,IZ)) + Z1(2)=0. + ELSE + Z1(1)=0. + Z1(2)=(-ZI)**(THIZ+THJZ)*(XLIJ(IZ,JZ)+XLIJ(JZ,IZ)) + END IF + Z2(1)=-G*MBQ*SINA/2./AMW/COSBE + Z2(2)=0. + CALL SSME3(4,AMHL,Z1,Z2) + IF (-1.*SNIJ(JZ,IZ).GT.0.) THEN + Z1(1)=(-ZI)**(THIZ+THJZ)*(XHIJ(IZ,JZ)+XHIJ(JZ,IZ)) + Z1(2)=0. + ELSE + Z1(1)=0. + Z1(2)=(-ZI)**(THIZ+THJZ)*(XHIJ(IZ,JZ)+XHIJ(JZ,IZ)) + END IF + Z2(1)=-G*MBQ*COSA/2./AMW/COSBE + Z2(2)=0. + CALL SSME3(4,AMHH,Z1,Z2) + IF (-SNIJ(JZ,IZ).GT.0.) THEN + Z1(1)=0. + Z1(2)=(-ZI)**(THIZ+THJZ+1)*(XPIJ(IZ,JZ)+XPIJ(JZ,IZ)) + ELSE + Z1(1)=(-ZI)**(THIZ+THJZ+1)*(XPIJ(IZ,JZ)+XPIJ(JZ,IZ)) + Z1(2)=0. + END IF + Z2(1)=0. + Z2(2)=ZI*G*MBQ*TANB/2./AMW + CALL SSME3(4,AMHA,Z1,Z2) + END IF +C zi -> zj + e + ebar + TMP(2)=MZJZ + TMP(4)=-SNIJ(JZ,IZ) + TMP(6)=0. + IF (MZIZ.GT.(MZJZ+2*AME)) THEN + IF (MZIZ.LT.AMELSS) THEN + TMP(3)=AMELSS + TERMLL=2*ALI(JZ)**2*ALI(IZ)**2*FAC*SSXINT(0.,SSZZF1,1.) + ELSE + TERMLL=0. + END IF + IF (MZIZ.LT.AMERSS) THEN + TMP(3)=AMERSS + TERMRR=2*BLI(JZ)**2*BLI(IZ)**2*FAC*SSXINT(0.,SSZZF1,1.) + ELSE + TERMRR=0. + END IF + IF (MZIZ.LT.(MZJZ+AMZ)) THEN + TMP(4)=+SNIJ(JZ,IZ) + TERMZZ=(APL**2+BTL**2)*E**2*WIJ(JZ,IZ)**2/MZIZ + $ *SSXINT(MZJZ,SSZZF2,(MZIZ**2+MZJZ**2)/2./MZIZ) + ELSE + TERMZZ=0. + END IF + IF (MZIZ.LT.AMELSS.AND.MZIZ.LT.(MZJZ+AMZ)) THEN + TMP(4)=+SNIJ(JZ,IZ) + TMP(3)=AMELSS + TERMLZ=8*E*(APL-BTL)*WIJ(JZ,IZ)*ALI(JZ)*ALI(IZ)/MZIZ + $ /(2*PI)**5*SSXINT(0.,SSZZF3,(MZIZ-MZJZ)**2) + ELSE + TERMLZ=0. + END IF + IF (MZIZ.LT.AMERSS.AND.MZIZ.LT.(MZJZ+AMZ)) THEN + TMP(4)=+SNIJ(JZ,IZ) + TMP(3)=AMERSS + TERMRZ=-8*E*(APL+BTL)*WIJ(JZ,IZ)*BLI(JZ)*BLI(IZ)/MZIZ + $ /(2*PI)**5*SSXINT(0.,SSZZF3,(MZIZ-MZJZ)**2) + ELSE + TERMRZ=0. + END IF + WID=TERMLL+TERMRR+TERMZZ+TERMLZ+TERMRZ + CALL SSSAVE(ISZIZ,WID,ISZ(JZ),IDE,-IDE,0,0) +C Enter information for decay matrix element + IF (-1.*SNIJ(JZ,IZ).GT.0.) THEN + Z1(1)=0. + Z1(2)=2*E*WIJ(JZ,IZ) + ELSE + Z1(1)=2*E*WIJ(JZ,IZ) + Z1(2)=0. + END IF + Z2(1)=APL + Z2(2)=BTL + CALL SSME3(1,AMZ,Z1,Z2) + Z1(1)=ZI**(THIZ-1)*(-1.)**(THIZ+1)*ALI(IZ)/2. + Z1(2)=-Z1(1) + Z2(1)=CONJG(ZI**(THJZ-1)*(-1.)**(THJZ+1)*ALI(JZ)/2.) + Z2(2)=Z2(1) + CALL SSME3(2,AMELSS,Z1,Z2) + Z1(1)=ZI**(THIZ-1)*BLI(IZ)/2. + Z1(2)=Z1(1) + Z2(1)=CONJG(ZI**(THJZ-1)*BLI(JZ)/2.) + Z2(2)=-Z2(1) + CALL SSME3(2,AMERSS,Z1,Z2) + Z1(1)=ZI**(THJZ-1)*(-1.)**(THJZ+1)*ALI(JZ)/2. + Z1(2)=-Z1(1) + Z2(1)=-CONJG(ZI**(THIZ-1)*(-1.)**(THIZ+1)*ALI(IZ)/2.) + Z2(2)=Z2(1) + CALL SSME3(3,AMELSS,Z1,Z2) + Z1(1)=ZI**(THJZ-1)*BLI(JZ)/2. + Z1(2)=Z1(1) + Z2(1)=-CONJG(ZI**(THIZ-1)*BLI(IZ)/2.) + Z2(2)=-Z2(1) + CALL SSME3(3,AMERSS,Z1,Z2) + END IF +C zi -> zj + mu + mubar + TMP(4)=-SNIJ(JZ,IZ) + IF (MZIZ.GT.(MZJZ+2*AMMU)) THEN + IF (MZIZ.LT.AMMLSS) THEN + TMP(3)=AMMLSS + TERMLL=2*ALI(JZ)**2*ALI(IZ)**2*FAC*SSXINT(0.,SSZZF1,1.) + ELSE + TERMLL=0. + END IF + IF (MZIZ.LT.AMMRSS) THEN + TMP(3)=AMMRSS + TERMRR=2*BLI(JZ)**2*BLI(IZ)**2*FAC*SSXINT(0.,SSZZF1,1.) + ELSE + TERMRR=0. + END IF + IF (MZIZ.LT.(MZJZ+AMZ)) THEN + TMP(4)=+SNIJ(JZ,IZ) + TERMZZ=(APL**2+BTL**2)*E**2*WIJ(JZ,IZ)**2/MZIZ + $ *SSXINT(MZJZ,SSZZF2,(MZIZ**2+MZJZ**2)/2./MZIZ) + ELSE + TERMZZ=0. + END IF + IF (MZIZ.LT.AMMLSS.AND.MZIZ.LT.(MZJZ+AMZ)) THEN + TMP(4)=+SNIJ(JZ,IZ) + TMP(3)=AMMLSS + TERMLZ=8*E*(APL-BTL)*WIJ(JZ,IZ)*ALI(JZ)*ALI(IZ)/MZIZ + $ /(2*PI)**5*SSXINT(0.,SSZZF3,(MZIZ-MZJZ)**2) + ELSE + TERMLZ=0. + END IF + IF (MZIZ.LT.AMMRSS.AND.MZIZ.LT.(MZJZ+AMZ)) THEN + TMP(4)=+SNIJ(JZ,IZ) + TMP(3)=AMMRSS + TERMRZ=-8*E*(APL+BTL)*WIJ(JZ,IZ)*BLI(JZ)*BLI(IZ)/MZIZ + $ /(2*PI)**5*SSXINT(0.,SSZZF3,(MZIZ-MZJZ)**2) + ELSE + TERMRZ=0. + END IF + WID=TERMLL+TERMRR+TERMZZ+TERMLZ+TERMRZ + CALL SSSAVE(ISZIZ,WID,ISZ(JZ),IDMU,-IDMU,0,0) +C Enter information for decay matrix element + IF (-1.*SNIJ(JZ,IZ).GT.0.) THEN + Z1(1)=0. + Z1(2)=2*E*WIJ(JZ,IZ) + ELSE + Z1(1)=2*E*WIJ(JZ,IZ) + Z1(2)=0. + END IF + Z2(1)=APL + Z2(2)=BTL + CALL SSME3(1,AMZ,Z1,Z2) + Z1(1)=ZI**(THIZ-1)*(-1.)**(THIZ+1)*ALI(IZ)/2. + Z1(2)=-Z1(1) + Z2(1)=CONJG(ZI**(THJZ-1)*(-1.)**(THJZ+1)*ALI(JZ)/2.) + Z2(2)=Z2(1) + CALL SSME3(2,AMMLSS,Z1,Z2) + Z1(1)=ZI**(THIZ-1)*BLI(IZ)/2. + Z1(2)=Z1(1) + Z2(1)=CONJG(ZI**(THJZ-1)*BLI(JZ)/2.) + Z2(2)=-Z2(1) + CALL SSME3(2,AMMRSS,Z1,Z2) + Z1(1)=ZI**(THJZ-1)*(-1.)**(THJZ+1)*ALI(JZ)/2. + Z1(2)=-Z1(1) + Z2(1)=-CONJG(ZI**(THIZ-1)*(-1.)**(THIZ+1)*ALI(IZ)/2.) + Z2(2)=Z2(1) + CALL SSME3(3,AMMLSS,Z1,Z2) + Z1(1)=ZI**(THJZ-1)*BLI(JZ)/2. + Z1(2)=Z1(1) + Z2(1)=-CONJG(ZI**(THIZ-1)*BLI(IZ)/2.) + Z2(2)=-Z2(1) + CALL SSME3(3,AMMRSS,Z1,Z2) + END IF +C zi -> zj + tau + taubar. +C Mixing/yukawa effects now included thanks to M. Drees + ALIZ1=-ALI(IZ)*COSL-FL*ZMIXSS(2,IZ)*SINL + ALJZ1=-ALI(JZ)*COSL-FL*ZMIXSS(2,JZ)*SINL + ALIZ2=-ALI(IZ)*SINL+FL*ZMIXSS(2,IZ)*COSL + ALJZ2=-ALI(JZ)*SINL+FL*ZMIXSS(2,JZ)*COSL + BEIZ1=BLI(IZ)*SINL+FL*ZMIXSS(2,IZ)*COSL + BEJZ1=BLI(JZ)*SINL+FL*ZMIXSS(2,JZ)*COSL + BEIZ2=-BLI(IZ)*COSL+FL*ZMIXSS(2,IZ)*SINL + BEJZ2=-BLI(JZ)*COSL+FL*ZMIXSS(2,JZ)*SINL + SGNIJ=-SNIJ(JZ,IZ) + XUPPER=(MZIZ**2+AMTAU**2-(AMTAU+MZJZ)**2)/2./MZIZ +C Polarization for stau_i -> z2ss+tau, z3ss+tau, z4ss+tau. +C See below for z1ss+tau. + IF(JZ.EQ.1) THEN + PTAU1(IZ)=(BEIZ1**2-ALIZ1**2)/(BEIZ1**2+ALIZ1**2) + PTAU2(IZ)=(BEIZ2**2-ALIZ2**2)/(BEIZ2**2+ALIZ2**2) + ENDIF + IF (MZIZ.GT.(MZJZ+2*AMTAU)) THEN + TMP(1)=MZIZ + TMP(2)=AMTAU + TMP(3)=MZJZ + TMP(4)=AML1SS + TMP(5)=AML1SS + TMP(6)=AMTAU + IF (MZIZ.LT.AML1SS) THEN + GLLF1=4*ALIZ1**2*((ALJZ1**2+BEJZ1**2)* + , SSXINT(AMTAU,SSGX1,XUPPER)+SGNIJ*ALJZ1**2* + , SSXINT(AMTAU,SSGX2,XUPPER)) + GLLF1L=FACT*4*ALIZ1**2*(ALJZ1**2* + , SSXINT(AMTAU,SSGX1,XUPPER)+SGNIJ*ALJZ1**2* + , SSXINT(AMTAU,SSGX2,XUPPER)) + GRRF1=4*BEIZ1**2*((ALJZ1**2+BEJZ1**2)* + , SSXINT(AMTAU,SSGX1,XUPPER)+SGNIJ*BEJZ1**2* + , SSXINT(AMTAU,SSGX2,XUPPER)) + GRRF1R=FACT*4*BEIZ1**2*(BEJZ1**2* + , SSXINT(AMTAU,SSGX1,XUPPER)+SGNIJ*BEJZ1**2* + , SSXINT(AMTAU,SSGX2,XUPPER)) + GLRF1=-8*ALIZ1*BEIZ1*ALJZ1*BEJZ1* + , SSXINT(AMTAU,SSGX8,XUPPER) + GF1=GLLF1+GRRF1+GLRF1 + ELSE + GLLF1L=0. + GRRF1R=0. + GF1=0. + END IF + IF (MZIZ.LT.AML1SS) THEN + TMP(4)=AML1SS + TMP(5)=AML2SS + GLGL=8*ALIZ1*ALIZ2*(ALJZ1*ALJZ2+BEJZ1*BEJZ2)* + , SSXINT(AMTAU,SSGX1,XUPPER)+SGNIJ*8*ALIZ1*ALIZ2* + , ALJZ1*ALJZ2*SSXINT(AMTAU,SSGX2,XUPPER) + GLGLL=FACT*(8*ALIZ1*ALIZ2*ALJZ1*ALJZ2* + , SSXINT(AMTAU,SSGX1,XUPPER)+SGNIJ*8*ALIZ1*ALIZ2* + , ALJZ1*ALJZ2*SSXINT(AMTAU,SSGX2,XUPPER)) + GRGR=8*BEIZ1*BEIZ2*(ALJZ1*ALJZ2+BEJZ1*BEJZ2)* + , SSXINT(AMTAU,SSGX1,XUPPER)+SGNIJ*8*BEIZ1*BEIZ2* + , BEJZ1*BEJZ2*SSXINT(AMTAU,SSGX2,XUPPER) + GRGRR=FACT*(8*BEIZ1*BEIZ2*BEJZ1*BEJZ2* + , SSXINT(AMTAU,SSGX1,XUPPER)+SGNIJ*8*BEIZ1*BEIZ2* + , BEJZ1*BEJZ2*SSXINT(AMTAU,SSGX2,XUPPER)) + GLGR=-8*ALIZ1*BEIZ2*ALJZ2*BEJZ1* + , SSXINT(AMTAU,SSGX8,XUPPER) + GRGL=-8*ALIZ2*BEIZ1*ALJZ1*BEJZ2* + , SSXINT(AMTAU,SSGX8,XUPPER) + GF12=GLGL+GRGR+GLGR+GRGL + ELSE + GLGLL=0. + GRGRR=0. + GF12=0. + END IF + IF (MZIZ.LT.AML2SS) THEN + TMP(4)=AML2SS + TMP(5)=AML2SS + GLLF2=4*ALIZ2**2*((ALJZ2**2+BEJZ2**2)* + , SSXINT(AMTAU,SSGX1,XUPPER)+SGNIJ*ALJZ2**2* + , SSXINT(AMTAU,SSGX2,XUPPER)) + GLLF2L=FACT*4*ALIZ2**2*(ALJZ2**2* + , SSXINT(AMTAU,SSGX1,XUPPER)+SGNIJ*ALJZ2**2* + , SSXINT(AMTAU,SSGX2,XUPPER)) + GRRF2=4*BEIZ2**2*((ALJZ2**2+BEJZ2**2)* + , SSXINT(AMTAU,SSGX1,XUPPER)+SGNIJ*BEJZ2**2* + , SSXINT(AMTAU,SSGX2,XUPPER)) + GRRF2R=FACT*4*BEIZ2**2*(BEJZ2**2* + , SSXINT(AMTAU,SSGX1,XUPPER)+SGNIJ*BEJZ2**2* + , SSXINT(AMTAU,SSGX2,XUPPER)) + GLRF2=-8*ALIZ2*BEIZ2*ALJZ2*BEJZ2* + , SSXINT(AMTAU,SSGX8,XUPPER) + GF2=GLLF2+GRRF2+GLRF2 + ELSE + GLLF2L=0. + GRRF2R=0. + GF2=0. + END IF + GF=FACT*(GF1+GF2+GF12) + TMP(2)=MZJZ + IF (MZIZ.LT.(MZJZ+AMZ)) THEN + TMP(4)=+SNIJ(JZ,IZ) + TERMZZ=(APL**2+BTL**2)*E**2*WIJ(JZ,IZ)**2/MZIZ + $ *SSXINT(MZJZ,SSZZF2,(MZIZ**2+MZJZ**2-4*AMTAU**2)/2./MZIZ) + TMZZRL=TERMZZ*(APL+BTL)**2/2./(APL**2+BTL**2) + TMZZLR=TERMZZ*(APL-BTL)**2/2./(APL**2+BTL**2) + ELSE + TERMZZ=0. + TMZZRL=0. + TMZZLR=0. + END IF + IF (MZIZ.LE.(MZJZ+AMHL)) THEN + TMP(3)=AMHL + TMP(5)=AMHL + TMP(4)=-SNIJ(JZ,IZ) + TERMHL=G**2/64./PI**3/MZIZ*(MTAMZ*SINA*(XLIJ(JZ,IZ)+ + $ XLIJ(IZ,JZ))/AMW/COSBE)**2* + $ SSXINT(MZJZ,SSZZF4,(MZIZ**2+MZJZ**2-4*AMTAU**2)/2./MZIZ) + ELSE + TERMHL=0. + END IF + IF (MZIZ.LE.(MZJZ+AMHH)) THEN + TMP(3)=AMHH + TMP(5)=AMHH + TMP(4)=-SNIJ(JZ,IZ) + TERMHH=G**2/64./PI**3/MZIZ*(MTAMZ*COSA*(XHIJ(JZ,IZ)+ + $ XHIJ(IZ,JZ))/AMW/COSBE)**2* + $ SSXINT(MZJZ,SSZZF4,(MZIZ**2+MZJZ**2-4*AMTAU**2)/2./MZIZ) + ELSE + TERMHH=0. + END IF + IF (MZIZ.LE.(MZJZ+AMHH).AND.MZIZ.LE.(MZJZ+AMHL)) THEN + TMP(3)=AMHL + TMP(5)=AMHH + TMP(4)=-SNIJ(JZ,IZ) + TERMLH=2*G**2/64./PI**3/MZIZ*(MTAMZ/AMW/COSBE)**2* + $ (COSA*(XHIJ(JZ,IZ)+XHIJ(IZ,JZ))*SINA* + $ (XLIJ(JZ,IZ)+XLIJ(IZ,JZ)))* + $ SSXINT(MZJZ,SSZZF4,(MZIZ**2+MZJZ**2-4*AMTAU**2)/2./MZIZ) + ELSE + TERMLH=0. + END IF + IF (MZIZ.LE.(MZJZ+AMHA)) THEN + TMP(3)=AMHA + TMP(5)=AMHA + TMP(4)=SNIJ(JZ,IZ) + TERMHA=G**2*TANB**2/64./PI**3/MZIZ*(MTAMZ*(XPIJ(JZ,IZ)+ + $ XPIJ(IZ,JZ))/AMW)**2* + $ SSXINT(MZJZ,SSZZF4,(MZIZ**2+MZJZ**2-4*AMTAU**2)/2./MZIZ) + ELSE + TERMHA=0. + END IF + IF (MZIZ.LT.AML1SS.AND.MZIZ.LT.(MZJZ+AMZ)) THEN + TMP(4)=-SGNIJ + TMP(3)=AML1SS + TERM1Z=8*E*WIJ(JZ,IZ)*(ALJZ1*ALIZ1*(APL-BTL)- + $ BEJZ1*BEIZ1*(APL+BTL))/MZIZ + $ /(2*PI)**5*SSXINT(4*AMTAU**2,SSZZF3,(MZIZ-MZJZ)**2) + TM1ZRL=-8*E*WIJ(JZ,IZ)*BEJZ1*BEIZ1*(APL+BTL)/MZIZ + $ /(2*PI)**5*SSXINT(4*AMTAU**2,SSZZF3,(MZIZ-MZJZ)**2) + TM1ZLR=8*E*WIJ(JZ,IZ)*ALJZ1*ALIZ1*(APL-BTL)/MZIZ + $ /(2*PI)**5*SSXINT(4*AMTAU**2,SSZZF3,(MZIZ-MZJZ)**2) + ELSE + TERM1Z=0. + TM1ZRL=0. + TM1ZLR=0. + END IF + IF (MZIZ.LT.AML2SS.AND.MZIZ.LT.(MZJZ+AMZ)) THEN + TMP(4)=-SGNIJ + TMP(3)=AML2SS + TERM2Z=8*E*WIJ(JZ,IZ)*(ALJZ2*ALIZ2*(APL-BTL)- + $ BEJZ2*BEIZ2*(APL+BTL))/MZIZ + $ /(2*PI)**5*SSXINT(4*AMTAU**2,SSZZF3,(MZIZ-MZJZ)**2) + TM2ZRL=-8*E*WIJ(JZ,IZ)*BEJZ2*BEIZ2*(APL+BTL)/MZIZ + $ /(2*PI)**5*SSXINT(4*AMTAU**2,SSZZF3,(MZIZ-MZJZ)**2) + TM2ZLR=8*E*WIJ(JZ,IZ)*ALJZ2*ALIZ2*(APL-BTL)/MZIZ + $ /(2*PI)**5*SSXINT(4*AMTAU**2,SSZZF3,(MZIZ-MZJZ)**2) + ELSE + TERM2Z=0. + TM2ZRL=0. + TM2ZLR=0. + END IF + IF (MZIZ.LT.AML1SS.AND.MZIZ.LT.(MZJZ+AMHL)) THEN + TMP(3)=AML1SS + TMP(4)=SGNIJ + TMP(5)=AMHL + TERM1L=2*PI*PI*G*MTAMZ*SINA*SGNIJ*(XLIJ(IZ,JZ)+ + $ XLIJ(JZ,IZ))*(ALIZ1*BEJZ1+ALJZ1*BEIZ1) + $ /MZIZ/AMW/COSBE*SSXINT(4*AMTAU**2,SSZZF5,(MZIZ-MZJZ)**2) + TERM1L=FACT*TERM1L + ELSE + TERM1L=0. + END IF + IF (MZIZ.LT.AML2SS.AND.MZIZ.LT.(MZJZ+AMHL)) THEN + TMP(3)=AML2SS + TMP(4)=SGNIJ + TMP(5)=AMHL + TERM2L=2*PI*PI*G*MTAMZ*SINA*SGNIJ*(XLIJ(IZ,JZ)+ + $ XLIJ(JZ,IZ))*(ALIZ2*BEJZ2+ALJZ2*BEIZ2) + $ /MZIZ/AMW/COSBE*SSXINT(4*AMTAU**2,SSZZF5,(MZIZ-MZJZ)**2) + TERM2L=FACT*TERM2L + ELSE + TERM2L=0. + END IF + IF (MZIZ.LT.AML1SS.AND.MZIZ.LT.(MZJZ+AMHH)) THEN + TMP(3)=AML1SS + TMP(4)=SGNIJ + TMP(5)=AMHH + TERM1H=2*PI*PI*G*MTAMZ*COSA*SGNIJ*(XHIJ(IZ,JZ)+ + $ XHIJ(JZ,IZ))*(ALIZ1*BEJZ1+ALJZ1*BEIZ1) + $ /MZIZ/AMW/COSBE*SSXINT(4*AMTAU**2,SSZZF5,(MZIZ-MZJZ)**2) + TERM1H=FACT*TERM1H + ELSE + TERM1H=0. + END IF + IF (MZIZ.LT.AML2SS.AND.MZIZ.LT.(MZJZ+AMHH)) THEN + TMP(3)=AML2SS + TMP(4)=SGNIJ + TMP(5)=AMHH + TERM2H=2*PI*PI*G*MTAMZ*COSA*SGNIJ*(XHIJ(IZ,JZ)+ + $ XHIJ(JZ,IZ))*(ALIZ2*BEJZ2+ALJZ2*BEIZ2) + $ /MZIZ/AMW/COSBE*SSXINT(4*AMTAU**2,SSZZF5,(MZIZ-MZJZ)**2) + TERM2H=FACT*TERM2H + ELSE + TERM2H=0. + END IF + IF (MZIZ.LT.AML1SS.AND.MZIZ.LT.(MZJZ+AMHA)) THEN + TMP(3)=AML1SS + TMP(4)=-SGNIJ + TMP(5)=AMHA + TERM1A=-2*PI*PI*G*MTAMZ*TANB*SGNIJ*(XPIJ(IZ,JZ)+ + $ XPIJ(JZ,IZ))*(ALIZ1*BEJZ1+ALJZ1*BEIZ1) + $ /MZIZ/AMW*SSXINT(4*AMTAU**2,SSZZF5,(MZIZ-MZJZ)**2) + TERM1A=FACT*TERM1A + ELSE + TERM1A=0. + END IF + IF (MZIZ.LT.AML2SS.AND.MZIZ.LT.(MZJZ+AMHA)) THEN + TMP(3)=AML2SS + TMP(4)=-SGNIJ + TMP(5)=AMHA + TERM2A=-2*PI*PI*G*MTAMZ*TANB*SGNIJ*(XPIJ(IZ,JZ)+ + $ XPIJ(JZ,IZ))*(ALIZ2*BEJZ2+ALJZ2*BEIZ2) + $ /MZIZ/AMW*SSXINT(4*AMTAU**2,SSZZF5,(MZIZ-MZJZ)**2) + TERM2A=FACT*TERM2A + ELSE + TERM2A=0. + END IF + WID=GF+TERMZZ+TERMHL+TERMHH+TERMLH+TERMHA+TERM1Z+ + $ TERM2Z+TERM1L+TERM2L+TERM1H+TERM2H+TERM1A+TERM2A +C tau polarization for 3-body z2 -> z1 tau tau + IF (IZ.EQ.2.AND.JZ.EQ.1.AND.WID.GT.0.) THEN + PTAUZZ=(GRRF1R+GRGRR+GRRF2R+TMZZRL+TM1ZRL+TM2ZRL- + $ (GLLF1L+GLGLL+GLLF2L+TMZZLR+TM1ZLR+TM2ZLR)) + $ /WID + END IF + CALL SSSAVE(ISZIZ,WID,ISZ(JZ),IDTAU,-IDTAU,0,0) +C Enter information for decay matrix element + IF (-1.*SNIJ(JZ,IZ).GT.0.) THEN + Z1(1)=0. + Z1(2)=2*E*WIJ(JZ,IZ) + ELSE + Z1(1)=2*E*WIJ(JZ,IZ) + Z1(2)=0. + END IF + Z2(1)=APL + Z2(2)=BTL + CALL SSME3(1,AMZ,Z1,Z2) + Z1(1)=((ZI**(THIZ)*(-1.)**(THIZ+1)*ALI(IZ)- + $ FL*ZMIXSS(2,IZ)*ZI**THIZ)*COSL-(ZI**THIZ*BLI(IZ)- + $ FL*ZMIXSS(2,IZ)*(-ZI)**THIZ)*SINL)/2. + Z1(2)=((-ZI**(THIZ)*(-1.)**(THIZ+1)*ALI(IZ)- + $ FL*ZMIXSS(2,IZ)*ZI**THIZ)*COSL-(ZI**THIZ*BLI(IZ)+ + $ FL*ZMIXSS(2,IZ)*(-ZI)**THIZ)*SINL)/2. + Z2(1)=CONJG(((ZI**(THJZ)*(-1.)**(THJZ+1)*ALI(JZ)- + $ FL*ZMIXSS(2,JZ)*ZI**THJZ)*COSL-(ZI**THJZ*BLI(JZ)- + $ FL*ZMIXSS(2,JZ)*(-ZI)**THJZ)*SINL)/2.) + Z2(2)=-CONJG(((-ZI**(THJZ)*(-1.)**(THJZ+1)*ALI(JZ)- + $ FL*ZMIXSS(2,JZ)*ZI**THJZ)*COSL-(ZI**THJZ*BLI(JZ)+ + $ FL*ZMIXSS(2,JZ)*(-ZI)**THJZ)*SINL)/2.) + CALL SSME3(2,AML1SS,Z1,Z2) + Z1(1)=((ZI**(THIZ)*(-1.)**(THIZ+1)*ALI(IZ)- + $ FL*ZMIXSS(2,IZ)*ZI**THIZ)*SINL+(ZI**THIZ*BLI(IZ)- + $ FL*ZMIXSS(2,IZ)*(-ZI)**THIZ)*COSL)/2. + Z1(2)=((-ZI**(THIZ)*(-1.)**(THIZ+1)*ALI(IZ)- + $ FL*ZMIXSS(2,IZ)*ZI**THIZ)*SINL+(ZI**THIZ*BLI(IZ)+ + $ FL*ZMIXSS(2,IZ)*(-ZI)**THIZ)*COSL)/2. + Z2(1)=CONJG(((ZI**(THJZ)*(-1.)**(THJZ+1)*ALI(JZ)- + $ FL*ZMIXSS(2,JZ)*ZI**THJZ)*SINL+(ZI**THJZ*BLI(JZ)- + $ FL*ZMIXSS(2,JZ)*(-ZI)**THJZ)*COSL)/2.) + Z2(2)=-CONJG(((-ZI**(THJZ)*(-1.)**(THJZ+1)*ALI(JZ)- + $ FL*ZMIXSS(2,JZ)*ZI**THJZ)*SINL+(ZI**THJZ*BLI(JZ)+ + $ FL*ZMIXSS(2,JZ)*(-ZI)**THJZ)*COSL)/2.) + CALL SSME3(2,AML2SS,Z1,Z2) + Z1(1)=((ZI**(THJZ)*(-1.)**(THJZ+1)*ALI(JZ)- + $ FL*ZMIXSS(2,JZ)*ZI**THJZ)*COSL-(ZI**THJZ*BLI(JZ)- + $ FL*ZMIXSS(2,JZ)*(-ZI)**THJZ)*SINL)/2. + Z1(2)=((-ZI**(THJZ)*(-1.)**(THJZ+1)*ALI(JZ)- + $ FL*ZMIXSS(2,JZ)*ZI**THJZ)*COSL-(ZI**THJZ*BLI(JZ)+ + $ FL*ZMIXSS(2,JZ)*(-ZI)**THJZ)*SINL)/2. + Z2(1)=-CONJG(((ZI**(THIZ)*(-1.)**(THIZ+1)*ALI(IZ)- + $ FL*ZMIXSS(2,IZ)*ZI**THIZ)*COSL-(ZI**THIZ*BLI(IZ)- + $ FL*ZMIXSS(2,IZ)*(-ZI)**THIZ)*SINL)/2.) + Z2(2)=CONJG(((-ZI**(THIZ)*(-1.)**(THIZ+1)*ALI(IZ)- + $ FL*ZMIXSS(2,IZ)*ZI**THIZ)*COSL-(ZI**THIZ*BLI(IZ)+ + $ FL*ZMIXSS(2,IZ)*(-ZI)**THIZ)*SINL)/2.) + CALL SSME3(3,AML1SS,Z1,Z2) + Z1(1)=((ZI**(THJZ)*(-1.)**(THJZ+1)*ALI(JZ)- + $ FL*ZMIXSS(2,JZ)*ZI**THJZ)*SINL+(ZI**THJZ*BLI(JZ)- + $ FL*ZMIXSS(2,JZ)*(-ZI)**THJZ)*COSL)/2. + Z1(2)=((-ZI**(THJZ)*(-1.)**(THJZ+1)*ALI(JZ)- + $ FL*ZMIXSS(2,JZ)*ZI**THJZ)*SINL+(ZI**THJZ*BLI(JZ)+ + $ FL*ZMIXSS(2,JZ)*(-ZI)**THJZ)*COSL)/2. + Z2(1)=-CONJG(((ZI**(THIZ)*(-1.)**(THIZ+1)*ALI(IZ)- + $ FL*ZMIXSS(2,IZ)*ZI**THIZ)*SINL+(ZI**THIZ*BLI(IZ)- + $ FL*ZMIXSS(2,IZ)*(-ZI)**THIZ)*COSL)/2.) + Z2(2)=CONJG(((-ZI**(THIZ)*(-1.)**(THIZ+1)*ALI(IZ)- + $ FL*ZMIXSS(2,IZ)*ZI**THIZ)*SINL+(ZI**THIZ*BLI(IZ)+ + $ FL*ZMIXSS(2,IZ)*(-ZI)**THIZ)*COSL)/2.) + CALL SSME3(3,AML2SS,Z1,Z2) + IF (-1.*SNIJ(JZ,IZ).GT.0.) THEN + Z1(1)=(-ZI)**(THIZ+THJZ)*(XLIJ(IZ,JZ)+XLIJ(JZ,IZ)) + Z1(2)=0. + ELSE + Z1(1)=0. + Z1(2)=(-ZI)**(THIZ+THJZ)*(XLIJ(IZ,JZ)+XLIJ(JZ,IZ)) + END IF + Z2(1)=-G*MTAMZ*SINA/2./AMW/COSBE + Z2(2)=0. + CALL SSME3(4,AMHL,Z1,Z2) + IF (-1.*SNIJ(JZ,IZ).GT.0.) THEN + Z1(1)=(-ZI)**(THIZ+THJZ)*(XHIJ(IZ,JZ)+XHIJ(JZ,IZ)) + Z1(2)=0. + ELSE + Z1(1)=0. + Z1(2)=(-ZI)**(THIZ+THJZ)*(XHIJ(IZ,JZ)+XHIJ(JZ,IZ)) + END IF + Z2(1)=-G*MTAMZ*COSA/2./AMW/COSBE + Z2(2)=0. + CALL SSME3(4,AMHH,Z1,Z2) + IF (-SNIJ(JZ,IZ).GT.0.) THEN + Z1(1)=0. + Z1(2)=(-ZI)**(THIZ+THJZ+1)*(XPIJ(IZ,JZ)+XPIJ(JZ,IZ)) + ELSE + Z1(1)=(-ZI)**(THIZ+THJZ+1)*(XPIJ(IZ,JZ)+XPIJ(JZ,IZ)) + Z1(2)=0. + END IF + Z2(1)=0. + Z2(2)=ZI*G*MTAMZ*TANB/2./AMW + CALL SSME3(4,AMHA,Z1,Z2) + END IF +C zi -> zj + nu_e + nu_e bar + TMP(6)=0. + IF (MZIZ.GT.MZJZ) THEN + IF (MZIZ.LT.AMN1SS) THEN + TMP(4)=-SNIJ(JZ,IZ) + TMP(3)=AMN1SS + TERMLL=2*ANI(JZ)**2*ANI(IZ)**2*FAC*SSXINT(0.,SSZZF1,1.) + ELSE + TERMLL=0. + END IF + IF (MZIZ.LT.(MZJZ+AMZ)) THEN + TMP(4)=+SNIJ(JZ,IZ) + TERMZZ=(APN**2+BTN**2)*E**2*WIJ(JZ,IZ)**2/MZIZ + $ *SSXINT(MZJZ,SSZZF2,(MZIZ**2+MZJZ**2)/2./MZIZ) + ELSE + TERMZZ=0. + END IF + IF (MZIZ.LT.AMN1SS.AND.MZIZ.LT.(MZJZ+AMZ)) THEN + TMP(4)=+SNIJ(JZ,IZ) + TMP(3)=AMN1SS + TERMLZ=8*E*(APN-BTN)*WIJ(JZ,IZ)*ANI(JZ)*ANI(IZ)/MZIZ + $ /(2*PI)**5*SSXINT(0.,SSZZF3,(MZIZ-MZJZ)**2) + ELSE + TERMLZ=0. + END IF + WID=TERMLL+TERMZZ+TERMLZ + CALL SSSAVE(ISZIZ,WID,ISZ(JZ),IDNE,-IDNE,0,0) +C Enter information for decay matrix element + IF (-1.*SNIJ(JZ,IZ).GT.0.) THEN + Z1(1)=0. + Z1(2)=2*E*WIJ(JZ,IZ) + ELSE + Z1(1)=2*E*WIJ(JZ,IZ) + Z1(2)=0. + END IF + Z2(1)=APN + Z2(2)=BTN + CALL SSME3(1,AMZ,Z1,Z2) + Z1(1)=ZI**(THIZ-1)*(-1.)**(THIZ+1)*ANI(IZ)/2. + Z1(2)=-Z1(1) + Z2(1)=CONJG(ZI**(THJZ-1)*(-1.)**(THJZ+1)*ANI(JZ)/2.) + Z2(2)=Z2(1) + CALL SSME3(2,AMN1SS,Z1,Z2) + Z1(1)=ZI**(THJZ-1)*(-1.)**(THJZ+1)*ANI(JZ)/2. + Z1(2)=-Z1(1) + Z2(1)=-CONJG(ZI**(THIZ-1)*(-1.)**(THIZ+1)*ANI(IZ)/2.) + Z2(2)=Z2(1) + CALL SSME3(3,AMN1SS,Z1,Z2) + END IF +C zi -> zj + nu_mu + nu_mu bar + IF (MZIZ.GT.MZJZ) THEN + IF (MZIZ.LT.AMN2SS) THEN + TMP(4)=-SNIJ(JZ,IZ) + TMP(3)=AMN2SS + TERMLL=2*ANI(JZ)**2*ANI(IZ)**2*FAC*SSXINT(0.,SSZZF1,1.) + ELSE + TERMLL=0. + END IF + IF (MZIZ.LT.(MZJZ+AMZ)) THEN + TMP(4)=+SNIJ(JZ,IZ) + TERMZZ=(APN**2+BTN**2)*E**2*WIJ(JZ,IZ)**2/MZIZ + $ *SSXINT(MZJZ,SSZZF2,(MZIZ**2+MZJZ**2)/2./MZIZ) + ELSE + TERMZZ=0. + END IF + IF (MZIZ.LT.AMN2SS.AND.MZIZ.LT.(MZJZ+AMZ)) THEN + TMP(4)=+SNIJ(JZ,IZ) + TMP(3)=AMN2SS + TERMLZ=8*E*(APN-BTN)*WIJ(JZ,IZ)*ANI(JZ)*ANI(IZ)/MZIZ + $ /(2*PI)**5*SSXINT(0.,SSZZF3,(MZIZ-MZJZ)**2) + ELSE + TERMLZ=0. + END IF + WID=TERMLL+TERMZZ+TERMLZ + CALL SSSAVE(ISZIZ,WID,ISZ(JZ),IDNM,-IDNM,0,0) +C Enter information for decay matrix element + IF (-1.*SNIJ(JZ,IZ).GT.0.) THEN + Z1(1)=0. + Z1(2)=2*E*WIJ(JZ,IZ) + ELSE + Z1(1)=2*E*WIJ(JZ,IZ) + Z1(2)=0. + END IF + Z2(1)=APN + Z2(2)=BTN + CALL SSME3(1,AMZ,Z1,Z2) + Z1(1)=ZI**(THIZ-1)*(-1.)**(THIZ+1)*ANI(IZ)/2. + Z1(2)=-Z1(1) + Z2(1)=CONJG(ZI**(THJZ-1)*(-1.)**(THJZ+1)*ANI(JZ)/2.) + Z2(2)=Z2(1) + CALL SSME3(2,AMN2SS,Z1,Z2) + Z1(1)=ZI**(THJZ-1)*(-1.)**(THJZ+1)*ANI(JZ)/2. + Z1(2)=-Z1(1) + Z2(1)=-CONJG(ZI**(THIZ-1)*(-1.)**(THIZ+1)*ANI(IZ)/2.) + Z2(2)=Z2(1) + CALL SSME3(3,AMN2SS,Z1,Z2) + END IF +C zi -> zj + nu_tau + nu_tau bar + IF (MZIZ.GT.MZJZ) THEN + IF (MZIZ.LT.AMN3SS) THEN + TMP(4)=-SNIJ(JZ,IZ) + TMP(3)=AMN3SS + TERMLL=2*ANI(JZ)**2*ANI(IZ)**2*FAC*SSXINT(0.,SSZZF1,1.) + ELSE + TERMLL=0. + END IF + IF (MZIZ.LT.(MZJZ+AMZ)) THEN + TMP(4)=+SNIJ(JZ,IZ) + TERMZZ=(APN**2+BTN**2)*E**2*WIJ(JZ,IZ)**2/MZIZ + $ *SSXINT(MZJZ,SSZZF2,(MZIZ**2+MZJZ**2)/2./MZIZ) + ELSE + TERMZZ=0. + END IF + IF (MZIZ.LT.AMN3SS.AND.MZIZ.LT.(MZJZ+AMZ)) THEN + TMP(4)=+SNIJ(JZ,IZ) + TMP(3)=AMN3SS + TERMLZ=8*E*(APN-BTN)*WIJ(JZ,IZ)*ANI(JZ)*ANI(IZ)/MZIZ + $ /(2*PI)**5*SSXINT(0.,SSZZF3,(MZIZ-MZJZ)**2) + ELSE + TERMLZ=0. + END IF + WID=TERMLL+TERMZZ+TERMLZ + CALL SSSAVE(ISZIZ,WID,ISZ(JZ),IDNT,-IDNT,0,0) +C Enter information for decay matrix element + IF (-1.*SNIJ(JZ,IZ).GT.0.) THEN + Z1(1)=0. + Z1(2)=2*E*WIJ(JZ,IZ) + ELSE + Z1(1)=2*E*WIJ(JZ,IZ) + Z1(2)=0. + END IF + Z2(1)=APN + Z2(2)=BTN + CALL SSME3(1,AMZ,Z1,Z2) + Z1(1)=ZI**(THIZ-1)*(-1.)**(THIZ+1)*ANI(IZ)/2. + Z1(2)=-Z1(1) + Z2(1)=CONJG(ZI**(THJZ-1)*(-1.)**(THJZ+1)*ANI(JZ)/2.) + Z2(2)=Z2(1) + CALL SSME3(2,AMN3SS,Z1,Z2) + Z1(1)=ZI**(THJZ-1)*(-1.)**(THJZ+1)*ANI(JZ)/2. + Z1(2)=-Z1(1) + Z2(1)=-CONJG(ZI**(THIZ-1)*(-1.)**(THIZ+1)*ANI(IZ)/2.) + Z2(2)=Z2(1) + CALL SSME3(3,AMN3SS,Z1,Z2) + END IF +220 CONTINUE +C +C zi --> zj + higgs +C + DO 230 JZ=1,IZ-1 +C zi --> zj + hl + MZJZ=ABS(AMZISS(JZ)) + IF (MZIZ.GT.(MZJZ+AMHL)) THEN + SN=SIGN(1.,AMZISS(JZ))*SIGN(1.,AMZISS(IZ)) + WID=(XLIJ(JZ,IZ)+XLIJ(IZ,JZ))**2/8./PI/(MZIZ)**3 + $ *SQRT(MZIZ**4+MZJZ**4+AMHL**4-2.*(MZIZ*MZJZ)**2 + $ -2.*(MZIZ*AMHL)**2-2.*(MZJZ*AMHL)**2)*((MZIZ**2+MZJZ**2 + $ -AMHL**2)/2.+SN*MZIZ*MZJZ) + CALL SSSAVE(ISZIZ,WID,ISZ(JZ),ISHL,0,0,0) + END IF +C zi --> zj + hh + IF (MZIZ.GT.(MZJZ+AMHH)) THEN + SN=SIGN(1.,AMZISS(JZ))*SIGN(1.,AMZISS(IZ)) + WID=(HIJ(JZ,IZ)+HIJ(IZ,JZ))**2/8./PI/(MZIZ)**3 + $ *SQRT(MZIZ**4+MZJZ**4+AMHH**4-2.*(MZIZ*MZJZ)**2 + $ -2.*(MZIZ*AMHH)**2-2.*(MZJZ*AMHH)**2) + $ *((MZIZ**2+MZJZ**2-AMHH**2)/2.+SN*MZIZ*MZJZ) + CALL SSSAVE(ISZIZ,WID,ISZ(JZ),ISHH,0,0,0) + END IF +C zi --> zj + ha + IF (MZIZ.GT.(MZJZ+AMHA)) THEN + SN=-SIGN(1.,AMZISS(JZ))*SIGN(1.,AMZISS(IZ)) + WID=(XPIJ(IZ,JZ)+XPIJ(JZ,IZ))**2/8./PI/(MZIZ)**3 + $ *SQRT(MZIZ**4+MZJZ**4+AMHA**4-2.*(MZIZ*MZJZ)**2 + $ -2.*(MZIZ*AMHA)**2-2.*(MZJZ*AMHA)**2)*((MZIZ**2+MZJZ**2 + $ -AMHA**2)/2.+SN*MZIZ*MZJZ) + CALL SSSAVE(ISZIZ,WID,ISZ(JZ),ISHA,0,0,0) + END IF +230 CONTINUE +200 CONTINUE +C +C zi --> squark + qbar; enlarge to include Z1 decays +C in case of models with light gravitino +C + DO 245 IZ=1,4 + MZIZ=ABS(AMZISS(IZ)) + SNIZ=SIGN(1.,AMZISS(IZ)) + IF (SNIZ.EQ.1.) THEN + THIZ=0 + ELSE + THIZ=1 + END IF + ISZIZ=ISZ(IZ) +C left squarks + IF (MZIZ.GT.(AMULSS+AMUP)) THEN + WID=3*AUI(IZ)**2*(MZIZ**2+AMUP**2-AMULSS**2)/MZIZ**3/ + $ 32./PI*SQRT(SSXLAM(MZIZ**2,AMUP**2,AMULSS**2)) + CALL SSSAVE(ISZIZ,WID,ISUPL,-IDUP,0,0,0) + CALL SSSAVE(ISZIZ,WID,-ISUPL,IDUP,0,0,0) + ENDIF + IF (MZIZ.GT.(AMDLSS+AMDN)) THEN + WID=3*ADI(IZ)**2*(MZIZ**2+AMDN**2-AMDLSS**2)/MZIZ**3/ + $ 32./PI*SQRT(SSXLAM(MZIZ**2,AMDN**2,AMDLSS**2)) + CALL SSSAVE(ISZIZ,WID,ISDNL,-IDDN,0,0,0) + CALL SSSAVE(ISZIZ,WID,-ISDNL,IDDN,0,0,0) + END IF + IF (MZIZ.GT.(AMSLSS+AMST)) THEN + WID=3*ADI(IZ)**2*(MZIZ**2+AMST**2-AMSLSS**2)/MZIZ**3/ + $ 32./PI*SQRT(SSXLAM(MZIZ**2,AMST**2,AMSLSS**2)) + CALL SSSAVE(ISZIZ,WID,ISSTL,-IDST,0,0,0) + CALL SSSAVE(ISZIZ,WID,-ISSTL,IDST,0,0,0) + END IF + IF (MZIZ.GT.(AMCLSS+AMCH)) THEN + WID=3*AUI(IZ)**2*(MZIZ**2+AMCH**2-AMCLSS**2)/MZIZ**3/ + $ 32./PI*SQRT(SSXLAM(MZIZ**2,AMCH**2,AMCLSS**2)) + CALL SSSAVE(ISZIZ,WID,ISCHL,-IDCH,0,0,0) + CALL SSSAVE(ISZIZ,WID,-ISCHL,IDCH,0,0,0) + ENDIF +C right squarks + IF (MZIZ.GT.(AMURSS+AMUP)) THEN + WID=3*BUI(IZ)**2*(MZIZ**2+AMUP**2-AMURSS**2)/MZIZ**3/ + $ 32./PI*SQRT(SSXLAM(MZIZ**2,AMUP**2,AMURSS**2)) + CALL SSSAVE(ISZIZ,WID,ISUPR,-IDUP,0,0,0) + CALL SSSAVE(ISZIZ,WID,-ISUPR,IDUP,0,0,0) + END IF + IF (MZIZ.GT.(AMDRSS+AMDN)) THEN + WID=3*BDI(IZ)**2*(MZIZ**2+AMDN**2-AMDRSS**2)/MZIZ**3/ + $ 32./PI*SQRT(SSXLAM(MZIZ**2,AMDN**2,AMDRSS**2)) + CALL SSSAVE(ISZIZ,WID,ISDNR,-IDDN,0,0,0) + CALL SSSAVE(ISZIZ,WID,-ISDNR,IDDN,0,0,0) + END IF + IF (MZIZ.GT.(AMSRSS+AMST)) THEN + WID=3*BDI(IZ)**2*(MZIZ**2+AMST**2-AMSRSS**2)/MZIZ**3/ + $ 32./PI*SQRT(SSXLAM(MZIZ**2,AMST**2,AMSRSS**2)) + CALL SSSAVE(ISZIZ,WID,ISSTR,-IDST,0,0,0) + CALL SSSAVE(ISZIZ,WID,-ISSTR,IDST,0,0,0) + END IF + IF(MZIZ.GT.(AMCRSS+AMCH)) THEN + WID=3*BUI(IZ)**2*(MZIZ**2+AMCH**2-AMCRSS**2)/MZIZ**3/ + $ 32./PI*SQRT(SSXLAM(MZIZ**2,AMCH**2,AMCRSS**2)) + CALL SSSAVE(ISZIZ,WID,ISCHR,-IDCH,0,0,0) + CALL SSSAVE(ISZIZ,WID,-ISCHR,IDCH,0,0,0) + ENDIF +C z_i --> sbottom + bottom +C + ZAUIZ=ZI**(THIZ-1)*SNIZ + $ *(-G/SR2*ZMIXSS(3,IZ)-GP/3./SR2*ZMIXSS(4,IZ)) + ZBUIZ=ZI**(THIZ-1)*4*GP*ZMIXSS(4,IZ)/3./SR2 + ZADIZ=ZI**(THIZ-1)*SNIZ + $ *(G/SR2*ZMIXSS(3,IZ)-GP/3./SR2*ZMIXSS(4,IZ)) + ZBDIZ=-2*ZI**(THIZ-1)*GP*ZMIXSS(4,IZ)/3./SR2 + ZALIZ=ZI**(THIZ-1)*SNIZ + $ *(G/SR2*ZMIXSS(3,IZ)+GP/SR2*ZMIXSS(4,IZ)) + ZBLIZ=-1*ZI**(THIZ-1)*SR2*GP*ZMIXSS(4,IZ) + ZPP=ZI**THIZ + ZPM=(-ZI)**THIZ + IF(MZIZ.GT.(AMB1SS+AMBT)) THEN + ZA=((ZI*ZADIZ-ZPP*FB*ZMIXSS(2,IZ))*COSB + $ -(ZI*ZBDIZ-ZPM*FB*ZMIXSS(2,IZ))*SINB)/2. + ZB=((-ZI*ZADIZ-ZPP*FB*ZMIXSS(2,IZ))*COSB + $ -(ZI*ZBDIZ+ZPM*FB*ZMIXSS(2,IZ))*SINB)/2. + AS=ZA*CONJG(ZA) + BS=ZB*CONJG(ZB) + WID=3*(AS*((AMBT+MZIZ)**2-AMB1SS**2)+BS*((MZIZ-AMBT)**2- + $ AMB1SS**2))/16./PI/MZIZ**3* + $ SQRT(SSXLAM(MZIZ**2,AMB1SS**2,AMBT**2)) + CALL SSSAVE(ISZIZ,WID,ISBT1,-IDBT,0,0,0) + CALL SSSAVE(ISZIZ,WID,-ISBT1,IDBT,0,0,0) + ENDIF + IF(MZIZ.GT.(AMB2SS+AMBT)) THEN + ZA=((ZI*ZADIZ-ZPP*FB*ZMIXSS(2,IZ))*SINB + $ +(ZI*ZBDIZ-ZPM*FB*ZMIXSS(2,IZ))*COSB)/2. + ZB=((-ZI*ZADIZ-ZPP*FB*ZMIXSS(2,IZ))*SINB + $ +(ZI*ZBDIZ+ZPM*FB*ZMIXSS(2,IZ))*COSB)/2. + AS=ZA*CONJG(ZA) + BS=ZB*CONJG(ZB) + WID=3*(AS*((AMBT+MZIZ)**2-AMB2SS**2)+BS*((MZIZ-AMBT)**2- + $ AMB2SS**2))/16./PI/MZIZ**3* + $ SQRT(SSXLAM(MZIZ**2,AMB2SS**2,AMBT**2)) + CALL SSSAVE(ISZIZ,WID,ISBT2,-IDBT,0,0,0) + CALL SSSAVE(ISZIZ,WID,-ISBT2,IDBT,0,0,0) + ENDIF +C z_i --> stop + top +C + IF(MZIZ.GT.AMT1SS+AMTP) THEN + ZA=((ZI*ZAUIZ-ZPP*FT*ZMIXSS(1,IZ))*COST + $ -(ZI*ZBUIZ-ZPM*FT*ZMIXSS(1,IZ))*SINT)/2. + ZB=((-ZI*ZAUIZ-ZPP*FT*ZMIXSS(1,IZ))*COST + $ -(ZI*ZBUIZ+ZPM*FT*ZMIXSS(1,IZ))*SINT)/2. + AS=ZA*CONJG(ZA) + BS=ZB*CONJG(ZB) + WID=3*(AS*((AMTP+MZIZ)**2-AMT1SS**2)+BS*((MZIZ-AMTP)**2- + $ AMT1SS**2))/16./PI/MZIZ**3* + $ SQRT(SSXLAM(MZIZ**2,AMT1SS**2,AMTP**2)) + CALL SSSAVE(ISZIZ,WID,ISTP1,-IDTP,0,0,0) + CALL SSSAVE(ISZIZ,WID,-ISTP1,IDTP,0,0,0) + ENDIF + IF(MZIZ.GT.AMT2SS+AMTP) THEN + ZA=((ZI*ZAUIZ-ZPP*FT*ZMIXSS(1,IZ))*SINT + $ +(ZI*ZBUIZ-ZPM*FT*ZMIXSS(1,IZ))*COST)/2. + ZB=((-ZI*ZAUIZ-ZPP*FT*ZMIXSS(1,IZ))*SINT + $ +(ZI*ZBUIZ+ZPM*FT*ZMIXSS(1,IZ))*COST)/2. + AS=ZA*CONJG(ZA) + BS=ZB*CONJG(ZB) + WID=3*(AS*((AMTP+MZIZ)**2-AMT2SS**2)+BS*((MZIZ-AMTP)**2- + $ AMT2SS**2))/16./PI/MZIZ**3* + $ SQRT(SSXLAM(MZIZ**2,AMT2SS**2,AMTP**2)) + CALL SSSAVE(ISZIZ,WID,ISTP2,-IDTP,0,0,0) + CALL SSSAVE(ISZIZ,WID,-ISTP2,IDTP,0,0,0) + ENDIF +C +C zi --> slepton + lepton +C + IF(MZIZ.GT.(AMELSS+AME)) THEN + WID=ALI(IZ)**2*(MZIZ**2+AME**2-AMELSS**2)/MZIZ**3/ + $ 32./PI*SQRT(SSXLAM(MZIZ**2,AME**2,AMELSS**2)) + CALL SSSAVE(ISZIZ,WID,ISEL,-IDE,0,0,0) + CALL SSSAVE(ISZIZ,WID,-ISEL,IDE,0,0,0) + END IF + IF(MZIZ.GT.(AMMLSS+AMMU)) THEN + WID=ALI(IZ)**2*(MZIZ**2+AMMU**2-AMMLSS**2)/MZIZ**3/ + $ 32./PI*SQRT(SSXLAM(MZIZ**2,AMMU**2,AMMLSS**2)) + CALL SSSAVE(ISZIZ,WID,ISMUL,-IDMU,0,0,0) + CALL SSSAVE(ISZIZ,WID,-ISMUL,IDMU,0,0,0) + END IF + IF(MZIZ.GT.(AMERSS+AME)) THEN + WID=BLI(IZ)**2*(MZIZ**2+AME**2-AMERSS**2)/MZIZ**3/ + $ 32./PI*SQRT(SSXLAM(MZIZ**2,AME**2,AMERSS**2)) + CALL SSSAVE(ISZIZ,WID,ISER,-IDE,0,0,0) + CALL SSSAVE(ISZIZ,WID,-ISER,IDE,0,0,0) + END IF + IF(MZIZ.GT.(AMMRSS+AMMU)) THEN + WID=BLI(IZ)**2*(MZIZ**2+AMMU**2-AMMRSS**2)/MZIZ**3/ + $ 32./PI*SQRT(SSXLAM(MZIZ**2,AMMU**2,AMMRSS**2)) + CALL SSSAVE(ISZIZ,WID,ISMUR,-IDMU,0,0,0) + CALL SSSAVE(ISZIZ,WID,-ISMUR,IDMU,0,0,0) + END IF + IF(MZIZ.GT.(AML1SS+AMTAU)) THEN + ZA=((ZI*ZALIZ-ZPP*FL*ZMIXSS(2,IZ))*COSL + $ -(ZI*ZBLIZ-ZPM*FL*ZMIXSS(2,IZ))*SINL)/2. + ZB=((-ZI*ZALIZ-ZPP*FL*ZMIXSS(2,IZ))*COSL + $ -(ZI*ZBLIZ+ZPM*FL*ZMIXSS(2,IZ))*SINL)/2. + AS=ZA*CONJG(ZA) + BS=ZB*CONJG(ZB) + WID=(AS*((AMTAU+MZIZ)**2-AML1SS**2)+BS*((MZIZ-AMTAU)**2- + $ AML1SS**2))/16./PI/MZIZ**3* + $ SQRT(SSXLAM(MZIZ**2,AML1SS**2,AMTAU**2)) + CALL SSSAVE(ISZIZ,WID,ISTAU1,-IDTAU,0,0,0) + CALL SSSAVE(ISZIZ,WID,-ISTAU1,IDTAU,0,0,0) + END IF + IF(MZIZ.GT.(AML2SS+AMTAU)) THEN + ZA=((ZI*ZALIZ-ZPP*FL*ZMIXSS(2,IZ))*SINL + $ +(ZI*ZBLIZ-ZPM*FL*ZMIXSS(2,IZ))*COSL)/2. + ZB=((-ZI*ZALIZ-ZPP*FL*ZMIXSS(2,IZ))*SINL + $ +(ZI*ZBLIZ+ZPM*FL*ZMIXSS(2,IZ))*COSL)/2. + AS=ZA*CONJG(ZA) + BS=ZB*CONJG(ZB) + WID=(AS*((AMTAU+MZIZ)**2-AML2SS**2)+BS*((MZIZ-AMTAU)**2- + $ AML2SS**2))/16./PI/MZIZ**3* + $ SQRT(SSXLAM(MZIZ**2,AML2SS**2,AMTAU**2)) + CALL SSSAVE(ISZIZ,WID,ISTAU2,-IDTAU,0,0,0) + CALL SSSAVE(ISZIZ,WID,-ISTAU2,IDTAU,0,0,0) + ENDIF + IF(MZIZ.GT.AMN1SS) THEN + WID=(MZIZ**2-AMN1SS**2)**2/32./PI/MZIZ**3 + CALL SSSAVE(ISZIZ,ANI(IZ)**2*WID,ISNEL,-IDNE,0,0,0) + CALL SSSAVE(ISZIZ,ANI(IZ)**2*WID,-ISNEL,IDNE,0,0,0) + END IF + IF(MZIZ.GT.AMN2SS) THEN + WID=(MZIZ**2-AMN2SS**2)**2/32./PI/MZIZ**3 + CALL SSSAVE(ISZIZ,ANI(IZ)**2*WID,ISNML,-IDNM,0,0,0) + CALL SSSAVE(ISZIZ,ANI(IZ)**2*WID,-ISNML,IDNM,0,0,0) + END IF + IF(MZIZ.GT.AMN3SS) THEN + WID=(MZIZ**2-AMN3SS**2)**2/32./PI/MZIZ**3 + CALL SSSAVE(ISZIZ,ANI(IZ)**2*WID,ISNTL,-IDNT,0,0,0) + CALL SSSAVE(ISZIZ,ANI(IZ)**2*WID,-ISNTL,IDNT,0,0,0) + END IF +245 CONTINUE +C +C Compute decays to gravitino for GMSB models +C + DO 250 IZ=1,4 + MZIZ=ABS(AMZISS(IZ)) + ISZIZ=ISZ(IZ) + IF (MZIZ.GT.AMGVSS) THEN + WID=(ZMIXSS(4,IZ)*CTHW+ZMIXSS(3,IZ)*STHW)**2*MZIZ**5/ + , 48./PI/(AMGVSS*AMPL)**2 + CALL SSSAVE(ISZIZ,WID,ISGRAV,IDGM,0,0,0) +C Dalitz decay + IF (MZIZ.GT.(AMGVSS+2*AME)) THEN + WIDEE=WID*2*ALFAEM/(3*PI)*LOG(MZIZ/AME) + CALL SSSAVE(ISZIZ,WIDEE,ISGRAV,IDE,-IDE,0,0) + END IF + END IF + IF (MZIZ.GT.(AMZ+AMGVSS)) THEN + WID=(2*(ZMIXSS(4,IZ)*STHW-ZMIXSS(3,IZ)*CTHW)**2+ + , (ZMIXSS(1,IZ)*SINBE-ZMIXSS(2,IZ)*COSBE)**2)* + , (MZIZ**2-AMZ**2)**4/96./PI/MZIZ**3/(AMGVSS*AMPL)**2 + CALL SSSAVE(ISZIZ,WID,ISGRAV,IDZ,0,0,0) + END IF + IF (MZIZ.GT.(AMHL+AMGVSS)) THEN + WID=(ZMIXSS(1,IZ)*COSA+ZMIXSS(2,IZ)*SINA)**2/6./ + , (AMGVSS*AMPL)**2*(MZIZ**2-AMHL**2)**4/16./PI/MZIZ**3 + CALL SSSAVE(ISZIZ,WID,ISGRAV,ISHL,0,0,0) + END IF + IF (MZIZ.GT.(AMHH+AMGVSS)) THEN + WID=(-ZMIXSS(1,IZ)*SINA+ZMIXSS(2,IZ)*COSA)**2/6./ + , (AMGVSS*AMPL)**2*(MZIZ**2-AMHH**2)**4/16./PI/MZIZ**3 + CALL SSSAVE(ISZIZ,WID,ISGRAV,ISHH,0,0,0) + END IF + IF (MZIZ.GT.(AMHA+AMGVSS)) THEN + WID=(ZMIXSS(1,IZ)*COSBE+ZMIXSS(2,IZ)*SINBE)**2/6./ + , (AMGVSS*AMPL)**2*(MZIZ**2-AMHA**2)**4/16./PI/MZIZ**3 + CALL SSSAVE(ISZIZ,WID,ISGRAV,ISHA,0,0,0) + END IF +250 CONTINUE +C +C Normalize zi branching ratios +C + CALL SSNORM(ISZ1) + CALL SSNORM(ISZ2) + CALL SSNORM(ISZ3) + CALL SSNORM(ISZ4) +C + RETURN + END diff --git a/ISAJET/isasusy/sszwf1.F b/ISAJET/isasusy/sszwf1.F new file mode 100644 index 00000000000..3993b596b6e --- /dev/null +++ b/ISAJET/isasusy/sszwf1.F @@ -0,0 +1,29 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSZWF1(E) +C----------------------------------------------------------------------- +C SSWZBF: ziss -> wiss f fbar +C Baer's Z2WFUN +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" +C + REAL MW,MZ,M,F1,F2,E,X,Y,WWID +C + MW=TMP(1) + MZ=TMP(2) + X=TMP(3) + Y=TMP(4) + M=AMW + WWID=GAMW +C + F1=SQRT(MAX(0.,E**2-MW**2))/ + $((MZ**2+MW**2-M**2-2*MZ*E)**2+WWID**2*M**2) + F2=(X**2+Y**2)*(3*(MZ**2+MW**2)*MZ*E-4*MZ**2*E*E-2*MZ**2*MW**2) + $-3*(X**2-Y**2)*MZ*MW*(MZ**2+MW**2-2*MZ*E) + SSZWF1=F1*F2 + RETURN + END diff --git a/ISAJET/isasusy/sszzf1.F b/ISAJET/isasusy/sszzf1.F new file mode 100644 index 00000000000..21db4527192 --- /dev/null +++ b/ISAJET/isasusy/sszzf1.F @@ -0,0 +1,39 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSZZF1(X) +C----------------------------------------------------------------------- +C SSWZBF: ziss -> zjss f fbar +C Baer's TFUNC +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sslun.inc" +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" +C + REAL X + DOUBLE PRECISION N,S,Q,D,SQBRKT,TERM1,QS + DOUBLE PRECISION MZ2,MZ1,M,DSN +C + MZ2=TMP(1) + MZ1=TMP(2) + M=TMP(3) + DSN=TMP(4) +C + N=MZ1**2/MZ2**2 + S=M**2/MZ2**2 + Q=X*(1.D0-N)/2. + QS=Q**2 + D=(S-2*S*Q-N)/((1.D0-2*Q)*(S-2*Q-N)) + IF(D.LE.0.) THEN + WRITE(LOUT,*) 'ERROR IN SSZZF1: D,S,Q,N=',D,S,Q,N + SSZZF1=0 + RETURN + END IF + SQBRKT=-Q*(1.D0-2*Q-N)/(1.D0-2*Q)-(2*Q-S+N)/2.D0*DLOG(D) + TERM1=QS*(1.D0-2*Q-N)**2/(1.D0-2*Q-S)**2/(1.D0-2*Q) + $+DSQRT(N)/2.D0/(1.D0-2*Q-S)*SQBRKT*DSN + SSZZF1=(1.D0-N)/2.D0*TERM1 + RETURN + END diff --git a/ISAJET/isasusy/sszzf2.F b/ISAJET/isasusy/sszzf2.F new file mode 100644 index 00000000000..70307ffc8c1 --- /dev/null +++ b/ISAJET/isasusy/sszzf2.F @@ -0,0 +1,32 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSZZF2(E) +C----------------------------------------------------------------------- +C SSWZBF: ziss -> zjss f fbar +C Baer's Z2ZFUN +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" +C + REAL E + DOUBLE PRECISION MZ1,MZ2,SN,M,PI,F1,F2,ZWID,MF,BF + DATA PI/3.14159265D0/ +C + MZ2=TMP(1) + MZ1=TMP(2) + SN=TMP(4) + MF=TMP(6) + M=AMZ + ZWID=GAMZ + BF=DSQRT(MAX(0.D0,1.D0-4*MF**2/(MZ2**2+MZ1**2-2*E*MZ2))) +C + F1=SQRT(MAX(0.D0,E**2-MZ1**2))/ + $((MZ1**2+MZ2**2-M**2-2*MZ2*E)**2+ZWID**2*M**2) + F2=E*(MZ1**2+MZ2**2+2*SN*MZ1*MZ2)-MZ2*(E**2+MZ1**2)- + $BF*MZ2*(E**2-MZ1**2)/3.D0-SN*MZ1*(MZ1**2+MZ2**2-2*MF**2) + SSZZF2=MZ2*BF*F1*F2/2.D0/PI**3 + RETURN + END diff --git a/ISAJET/isasusy/sszzf3.F b/ISAJET/isasusy/sszzf3.F new file mode 100644 index 00000000000..70d4105365b --- /dev/null +++ b/ISAJET/isasusy/sszzf3.F @@ -0,0 +1,38 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSZZF3(SP) +C----------------------------------------------------------------------- +C SSWZBF: ziss -> zjss f fbar +C Baer's FI +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" +C + REAL SP + DOUBLE PRECISION S,PI,M2,M1,MS,E,QS,MUS,BKT + DOUBLE PRECISION THZ,TERM,MZ,DFI,Q,MF,QP + DATA PI/3.14159265D0/ +C + MZ=AMZ + M2=TMP(1) + M1=TMP(2) + MS=TMP(3) + THZ=TMP(4) + MF=TMP(6) +C + S=SP + E=(S+M2**2-M1**2)/2.D0/M2 + QS=E**2-S + Q=DSQRT(MAX(0.D0,QS)) + QP=Q*DSQRT(MAX(0.D0,1.D0-4*MF**2/S)) + MUS=MS**2+S-M1**2-MF**2 + BKT=(MS**2-M1**2-MF**2)*(MS**2-M2**2-MF**2)+THZ*M1*M2*(S-2*MF**2) + TERM=DLOG((M2*(E+QP)-MUS)/(M2*(E-QP)-MUS)) + DFI=-.5D0*M2*E*QP-.5D0*(MS**2-M2**2-S-MF**2)*QP-BKT*TERM/4.D0/M2 + DFI=DFI*PI**2/2.D0/M2/(S-MZ**2) + SSZZF3=DFI + RETURN + END diff --git a/ISAJET/isasusy/sszzf4.F b/ISAJET/isasusy/sszzf4.F new file mode 100644 index 00000000000..59ae290f5d9 --- /dev/null +++ b/ISAJET/isasusy/sszzf4.F @@ -0,0 +1,31 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSZZF4(E) +C----------------------------------------------------------------------- +C Z_I -> Z_J +B +BBAR VIA HIGGS +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" +C + REAL E + DOUBLE PRECISION MZ1,MZ2,SN,EE,MH1,MH2,P,MF,BF,TM +C + MZ2=TMP(1) + MZ1=TMP(2) + MH1=TMP(3) + SN=TMP(4) + MH2=TMP(5) + MF=TMP(6) + EE=E +C + P=SQRT(MAX(0.D0,EE**2-MZ1**2)) + TM=1.D0-4*MF**2/(MZ2**2+MZ1**2-2*E*MZ2) + BF=DSQRT(MAX(0.D0,TM)) + SSZZF4=P*BF*(MZ2**2+MZ1**2-2*MZ2*EE-2*MF**2)* + $(MZ2*EE+SN*MZ2*MZ1)/(MZ2**2+MZ1**2-2*MZ2*EE-MH1**2)/ + $(MZ2**2+MZ1**2-2*MZ2*EE-MH2**2) + RETURN + END diff --git a/ISAJET/isasusy/sszzf5.F b/ISAJET/isasusy/sszzf5.F new file mode 100644 index 00000000000..7b1f538db86 --- /dev/null +++ b/ISAJET/isasusy/sszzf5.F @@ -0,0 +1,36 @@ +#include "isajet/pilot.h" + REAL FUNCTION SSZZF5(SP) +C----------------------------------------------------------------------- +C SSWZBF: ziss -> zjss f fbar +C Drees' I26 integrand for higgs-sfermion interference +C----------------------------------------------------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sssm.inc" +#include "isajet/sspar.inc" +#include "isajet/sstmp.inc" +C + REAL SP + DOUBLE PRECISION S,M2,M1,MS,E,QS,MUS,BKT + DOUBLE PRECISION THZ,TERM,MH,DFI,Q,MF,QP +C + M2=TMP(1) + M1=TMP(2) + MS=TMP(3) + MH=TMP(5) + THZ=TMP(4) + MF=TMP(6) +C + S=SP + E=(S+M2**2-M1**2)/2.D0/M2 + QS=E**2-S + Q=DSQRT(MAX(0.D0,QS)) + QP=Q*DSQRT(MAX(0.D0,1.D0-4*MF**2/S)) + MUS=MS**2+S-M1**2-MF**2 + BKT=S*MS**2-MF**2*(M1**2+M2**2)+THZ*M1*M2*(S-2*MF**2) + TERM=DLOG((M2*(E+QP)-MUS)/(M2*(E-QP)-MUS)) + DFI=(S*QP/2.D0+BKT*TERM/4.D0/M2)/(S-MH**2) + SSZZF5=DFI + RETURN + END diff --git a/ISAJET/isasusy/sualfe.F b/ISAJET/isasusy/sualfe.F new file mode 100644 index 00000000000..2100b401c9f --- /dev/null +++ b/ISAJET/isasusy/sualfe.F @@ -0,0 +1,32 @@ +#include "isajet/pilot.h" +C---------------------------------------------------------------------- + FUNCTION SUALFE(QS) +C---------------------------------------------------------------------- +C +C Returns the running EM coupling alpha_em(q**2) +C +C-----SEE BARGER/PHILLIPS, P. 202 --------------------------- +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sslun.inc" + REAL SUALFE + REAL PI,MB,SUM,A0,QD,QU,MS,ME,QS,MM,MD,MU,MTAU,MC + DATA ME/.0005/,MM/.105/,MTAU/1.784/,MU/.01/,MD/.01/ + DATA MS/.5/,MC/1.6/,MB/5.0/,PI/3.1415926/ +C + SUM=0. + QU=2./3. + QD=-1./3. + IF (QS.GT.4*ME**2) SUM=SUM+LOG(QS/4./ME**2) + IF (QS.GT.4*MM**2) SUM=SUM+LOG(QS/4./MM**2) + IF (QS.GT.4*MTAU**2) SUM=SUM+LOG(QS/4./MTAU**2) + IF (QS.GT.4*MU**2) SUM=SUM+3*QU**2*LOG(QS/4./MU**2) + IF (QS.GT.4*MD**2) SUM=SUM+3*QD**2*LOG(QS/4./MD**2) + IF (QS.GT.4*MS**2) SUM=SUM+3*QD**2*LOG(QS/4./MS**2) + IF (QS.GT.4*MC**2) SUM=SUM+3*QU**2*LOG(QS/4./MC**2) + IF (QS.GT.4*MB**2) SUM=SUM+3*QD**2*LOG(QS/4./MB**2) + A0=1./137. + SUALFE=A0/(1.-A0/3./PI*SUM) + RETURN + END diff --git a/ISAJET/isasusy/sualfs.F b/ISAJET/isasusy/sualfs.F new file mode 100644 index 00000000000..2eea088ac2d --- /dev/null +++ b/ISAJET/isasusy/sualfs.F @@ -0,0 +1,66 @@ +#include "isajet/pilot.h" +C---------------------------------------------------------------------- + FUNCTION SUALFS(QSQ,ALAM4,TMASS,LOOP) +C---------------------------------------------------------------------- +C +C This function returns the 1, 2, or 3-loop value of alpha_s +C Input: +C QSQ = Q**2 (real) +C ALAM4 = Lambda for 4 active quark flavors (real) +C TMASS = top quark mass to determine lambda-6 (real) +C LOOP = number of loops for alpha_s (= 1, 2 or 3) +C Parametrization of the strong coupling constant according to +C LOOP = 1, 2 : from the book; +C LOOP = 3: W. J. Marciano, Phys. Rev. D 29 (1984) 580. +C Note : threshold at 2*Mq +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sslun.inc" + REAL SUALFS, QSQ, ALAM4, TMASS + INTEGER LOOP + REAL PI, BMASS + REAL ANF, ALAM, ALAMSQ, ALAM5, T, TT, B0, B1, B2, X, ALPHAS + DATA PI/3.1415927/, BMASS/5.0/ +C + IF (QSQ .LT. 4.0*BMASS**2) THEN + ANF = 4.0 + ALAM = ALAM4 + ELSE IF (QSQ .LT. 4.0*TMASS**2) THEN + ANF = 5.0 + ALAM = ALAM4*(ALAM4/(2.0*BMASS))**(2.0/23.0) + 1 *(ALOG(4.0*BMASS**2/ALAM4**2))**(-963.0/13225.0) + ELSE + ANF = 6.0 + ALAM5 = ALAM4*(ALAM4/(2.0*BMASS))**(2.0/23.0) + 1 *(ALOG(4.0*BMASS**2/ALAM4**2))**(-963.0/13225.0) + ALAM = ALAM5*(ALAM5/(2.0*TMASS))**(2.0/21.0) + 1 *(ALOG(4.0*TMASS**2/ALAM5**2))**(-107.0/1127.0) + END IF + B0 = 11.0-2.0/3.0*ANF + ALAMSQ = ALAM**2 + T = ALOG(QSQ/ALAMSQ) + IF (T .LE. 1.0) T = ALOG(4.0/ALAMSQ) + ALPHAS = 4*PI/B0/T + IF (LOOP .EQ. 1) THEN + SUALFS = ALPHAS + ELSE IF (LOOP .EQ. 2) THEN + B1 = 102.0-38.0/3.0*ANF + X = B1/(B0**2*T) + TT = ALOG(T) + SUALFS = ALPHAS*(1.0-X*TT) + ELSE IF (LOOP .EQ. 3) THEN + B1 = 102.0-38.0/3.0*ANF + B2 = 0.5*(2857.0-5033.0/9.0*ANF+325.0/27.0*ANF**2) + X = B1/(B0**2*T) + TT = ALOG(T) + SUALFS = ALPHAS*(1.0-X*TT+X**2*((TT-0.5)**2 + $ +B2*B0/B1**2-1.25)) + ELSE + WRITE(LOUT,*) ' WRONG LOOP NUMBER IN ALPHA-S EVALUATION!' + STOP 99 + END IF +C + RETURN + END diff --git a/ISAJET/isasusy/sugeff.F b/ISAJET/isasusy/sugeff.F new file mode 100644 index 00000000000..793b691d77b --- /dev/null +++ b/ISAJET/isasusy/sugeff.F @@ -0,0 +1,113 @@ +#include "isajet/pilot.h" +C----------------------------------------------------------------- + SUBROUTINE SUGEFF(G0,SIG1,SIG2) +C----------------------------------------------------------------- +C +C Compute Higgs mass shift due to 1-loop effective potential +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sslun.inc" +#include "isajet/sugpas.inc" +#include "isajet/sugmg.inc" + REAL G0(29),SIG1,SIG2 + REAL DT1,DELT1S,SIG1T1,DMSDV2,FB,FT,MST2,MSB2,MSB1,SIG2B1, + $SIG1B1,SIG2B2,SIG1B2,DB1,SIG1T2,SIG2T1,DELB1S,SIG2T2,MST1,COS2W, + $MT,PI,COTB,TANB,MB,SIG2B,SIG1B,G,GGP,SIG2T,E,FAC,SIG1T,QS, + $BETA,SINB,COSB,FAC4,FL,ML,SIG1L,SIG2L,MSL1,MSL2, + $DELL1S,DL1,SIG1L1,SIG2L1,SIG1L2,SIG2L2 +C + G=G2 + TANB=XTANB + COS2W=1.-XW + COTB=1./TANB + BETA=ATAN(TANB) + SINB=SIN(BETA) + COSB=COS(BETA) + PI=4.*ATAN(1.) + FAC=3./8./PI**2 + FAC4=FAC/3. + E=EXP(1.) + QS=HIGFRZ**2 +C-----CALCULATE TOP AND BOTTOM CONTRIBUTIONS; USE RUNNING MASSES-- + FL=G0(4) + FB=G0(5) + FT=G0(6) + ML=FL*VEV*COSB + MT=FT*VEV*SINB + MB=FB*VEV*COSB + SIG1T=0. + SIG2T=-FAC*MT**2*G0(6)**2*LOG(MT**2/E/QS) + SIG1B=-FAC*MB**2*G0(5)**2*LOG(MB**2/E/QS) + SIG2B=0. + SIG1L=-FAC4*ML**2*G0(4)**2*LOG(ML**2/E/QS) + SIG2L=0. + GGP=(G**2+GP**2)/2. + MST1=MSS(12) + MST2=MSS(13) + MSB1=MSS(10) + MSB2=MSS(11) + MSL1=MSS(21) + MSL2=MSS(22) +C-----CALCULATE STOP_1 CONTRIBUTION ------------------------------- + DELT1S=(.5*(G0(24)-G0(23))+(8*COS2W-5.)*GGP* + $ (VP*VP-V*V)/12.)**2+G0(6)**2*V*V*(G0(12)-MU*COTB)**2 + DT1=.5*(G0(24)-G0(23))+(8*COS2W-5.)*GGP* + $ (VP*VP-V*V)/12. + DMSDV2=GGP/4.-(2*DT1*(8*COS2W-5.)*GGP/12.- + $ FT**2*MU*(G0(12)*TANB-MU))/2./SQRT(DELT1S) + SIG1T1=FAC/2.*MST1**2*LOG(MST1**2/E/QS)*DMSDV2 + DMSDV2=-GGP/4.+FT**2-(-2*DT1*(8*COS2W-5.)*GGP/12.+ + $ FT**2*G0(12)*(G0(12)-MU*COTB))/2./SQRT(DELT1S) + SIG2T1=FAC/2.*MST1**2*LOG(MST1**2/E/QS)*DMSDV2 +C-----CALCULATE STOP_2 CONTRIBUTION ------------------------------- + DMSDV2=GGP/4.+(2*DT1*(8*COS2W-5.)*GGP/12.- + $ FT**2*MU*(G0(12)*TANB-MU))/2./SQRT(DELT1S) + SIG1T2=FAC/2.*MST2**2*LOG(MST2**2/E/QS)*DMSDV2 + DMSDV2=-GGP/4.+FT**2+(-2*DT1*(8*COS2W-5.)*GGP/12.+ + $ FT**2*G0(12)*(G0(12)-MU*COTB))/2./SQRT(DELT1S) + SIG2T2=FAC/2.*MST2**2*LOG(MST2**2/E/QS)*DMSDV2 +C-----CALCULATE SBOT_1 CONTRIBUTION ------------------------------- + DELB1S=(.5*(G0(24)-G0(22))-(4*COS2W-1.)*GGP* + $ (VP*VP-V*V)/12.)**2+G0(5)**2*VP*VP*(G0(11)-MU*TANB)**2 + DB1=.5*(G0(24)-G0(22))-(4*COS2W-1.)*GGP* + $ (VP*VP-V*V)/12. + DMSDV2=-GGP/4.+FB**2-(-2*DB1*(4*COS2W-1.)*GGP/12.+ + $ FB**2*G0(11)*(G0(11)-MU*TANB))/2./SQRT(DELB1S) + SIG1B1=FAC/2.*MSB1**2*LOG(MSB1**2/E/QS)*DMSDV2 + DMSDV2=GGP/4.-(2*DB1*(4*COS2W-1.)*GGP/12.- + $ FB**2*MU*(G0(11)*COTB-MU))/2./SQRT(DELB1S) + SIG2B1=FAC/2.*MSB1**2*LOG(MSB1**2/E/QS)*DMSDV2 +C-----CALCULATE SBOT_2 CONTRIBUTION ------------------------------- + DMSDV2=-GGP/4.+FB**2+(-2*DB1*(4*COS2W-1.)*GGP/12.+ + $ FB**2*G0(11)*(G0(11)-MU*TANB))/2./SQRT(DELB1S) + SIG1B2=FAC/2.*MSB2**2*LOG(MSB2**2/E/QS)*DMSDV2 + DMSDV2=GGP/4.+(2*DB1*(4*COS2W-1.)*GGP/12.- + $ FB**2*MU*(G0(11)*COTB-MU))/2./SQRT(DELB1S) + SIG2B2=FAC/2.*MSB2**2*LOG(MSB2**2/E/QS)*DMSDV2 +C-----CALCULATE STAU_1 CONTRIBUTION ------------------------------- + DELL1S=(.5*(G0(21)-G0(20))-(4*COS2W-3.)*GGP* + $ (VP*VP-V*V)/4.)**2+G0(4)**2*VP*VP*(G0(10)-MU*TANB)**2 + DL1=.5*(G0(21)-G0(20))-(4*COS2W-3.)*GGP* + $ (VP*VP-V*V)/4. + DMSDV2=-GGP/4.+FL**2-(-2*DL1*(4*COS2W-3.)*GGP/4.+ + $ FL**2*G0(10)*(G0(10)-MU*TANB))/2./SQRT(DELL1S) + SIG1L1=FAC4/2.*MSL1**2*LOG(MSL1**2/E/QS)*DMSDV2 + DMSDV2=GGP/4.-(2*DL1*(4*COS2W-3.)*GGP/4.- + $ FL**2*MU*(G0(10)*COTB-MU))/2./SQRT(DELL1S) + SIG2L1=FAC4/2.*MSL1**2*LOG(MSL1**2/E/QS)*DMSDV2 +C-----CALCULATE STAU_2 CONTRIBUTION ------------------------------- + DMSDV2=-GGP/4.+FL**2+(-2*DL1*(4*COS2W-3.)*GGP/4.+ + $ FL**2*G0(10)*(G0(10)-MU*TANB))/2./SQRT(DELL1S) + SIG1L2=FAC4/2.*MSL2**2*LOG(MSL2**2/E/QS)*DMSDV2 + DMSDV2=GGP/4.+(2*DL1*(4*COS2W-3.)*GGP/4.- + $ FL**2*MU*(G0(10)*COTB-MU))/2./SQRT(DELL1S) + SIG2L2=FAC4/2.*MSL2**2*LOG(MSL2**2/E/QS)*DMSDV2 +C-----ADD ALL TERMS ------------------------------------------------ + SIG1=SIG1B+SIG1B1+SIG1B2+SIG1T+SIG1T1+SIG1T2+ + $SIG1L+SIG1L1+SIG1L2 + SIG2=SIG2B+SIG2B1+SIG2B2+SIG2T+SIG2T1+SIG2T2+ + $SIG2L+SIG2L1+SIG2L2 + RETURN + END diff --git a/ISAJET/isasusy/sugfrz.F b/ISAJET/isasusy/sugfrz.F new file mode 100644 index 00000000000..863984cc51e --- /dev/null +++ b/ISAJET/isasusy/sugfrz.F @@ -0,0 +1,72 @@ +#include "isajet/pilot.h" +C------------------------------------------------------------------ + SUBROUTINE SUGFRZ(Q,G,G0,IG) +C------------------------------------------------------------------ +C +C Freeze out final soft breaking parameters +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sslun.inc" +#include "isajet/sugpas.inc" + DIMENSION G(29),G0(29) + INTEGER IG(29) + REAL Q,MT + REAL G,G0,TANB + INTEGER I +C + TANB=XTANB + MT=AMT + DO 200 I=1,5 + G0(I)=G(I) +200 CONTINUE + IF (Q.LT.MT.AND.IG(6).EQ.0) THEN + G3MT=G(3) + G0(6)=G(6) + IG(6)=1 + END IF +C Freeze out running gluino mass at MGL + DO 210 I=7,12 + IF (Q.LT.ABS(G(I)).AND.IG(I).EQ.0) THEN + G0(I)=G(I) + IG(I)=1 + ELSE IF (IG(I).EQ.0) THEN + G0(I)=G(I) + END IF +210 CONTINUE +C Freeze out Higgs paremeters at HIGFRZ + DO 211 I=13,14 + IF (Q.LT.HIGFRZ.AND.IG(I).EQ.0) THEN + G0(I)=G(I) + IG(I)=1 + G0(I+12)=G(I+12) + IG(I+12)=1 + ELSE IF (IG(I).EQ.0) THEN + G0(I)=G(I) + G0(I+12)=G(I+12) + END IF +211 CONTINUE +C Freeze out rest at own masses + DO 220 I=15,24 +C IF (G(I).LT.0.) THEN +C G(I)=0. +C NOGOOD=1 +C GO TO 100 +C END IF + IF (Q.LT.SQRT(ABS(G(I))).AND.IG(I).EQ.0) THEN + G0(I)=G(I) + IG(I)=1 + ELSE IF (IG(I).EQ.0) THEN + G0(I)=G(I) + END IF +220 CONTINUE +C Freeze our N_R parameters at Majorana mass scale + DO 230 I=27,29 + IF (G(I).NE.0.) G0(I)=G(I) + IF (Q.LT.AMNRMJ.AND.IG(I).EQ.0.) THEN + IG(I)=1 + END IF +230 CONTINUE +100 RETURN + END diff --git a/ISAJET/isasusy/sugmas.F b/ISAJET/isasusy/sugmas.F new file mode 100644 index 00000000000..05674e09cb6 --- /dev/null +++ b/ISAJET/isasusy/sugmas.F @@ -0,0 +1,240 @@ +#include "isajet/pilot.h" +C--------------------------------------------------------------- + SUBROUTINE SUGMAS(G0,ILOOP,IMODEL) +C--------------------------------------------------------------- +C +C Compute tree level sparticle masses; output to MSS, XISAIN +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sslun.inc" +#include "isajet/sspar.inc" +#include "isajet/sssm.inc" +#include "isajet/sugpas.inc" +#include "isajet/sugxin.inc" +#include "isajet/sugmg.inc" + REAL MSB1,MSB2,MST1,MST2 + REAL G0(29) + REAL SUGMFN,SUALFS,SSPOLE,MHP,MGLMGL,MHPS, + $RDEL,ASMGL,DELHPS,M1S,M2S,FNB,FCN, + $MB,FNT,MT,MW,TANB,BETA,COSB,COTB,SINB,MZ,COS2B, + $PI,T2S,G,ATAU,MSSS,AT,AB,BRKT,B2S,T1S,TERM,B1S,Q, + $MBQ,MTAMZ,MTQ,FNL,MSL1,MSL2,ASMB,MBMB,ASMT,MTMT + REAL AA,BB,CC,DA,DB,DC,L1,L2,EVAL1,RL1,RL2 + DOUBLE PRECISION SSMQCD + INTEGER IALLOW,ILOOP,MHLNEG,MHCNEG,IMODEL +C +C Statement function +C + SUGMFN(Q)=Q**2*(LOG(Q**2/HIGFRZ**2)-1.) +C + PI=4.*ATAN(1.) + XW=.232 + G=G2 + TANB=XTANB + MT=AMT + MZ=AMZ + MW=AMW + AMTP=MT + BETA=ATAN(TANB) + COTB=1./TANB + SINB=SIN(BETA) + COSB=COS(BETA) + SIN2B=SIN(2*BETA) + COS2B=COS(2*BETA) + AT=G0(12) + AB=G0(11) + ATAU=G0(10) + ASMB=SUALFS(AMBT**2,.36,AMTP,3) + MBMB=AMBT*(1.-4*ASMB/3./PI) + MBQ=SSMQCD(DBLE(MBMB),DBLE(HIGFRZ)) + ASMT=SUALFS(AMTP**2,.36,AMTP,3) + MTMT=AMTP/(1.+4*ASMT/3./PI+(16.11-1.04*(5.-6.63/AMTP))* + $(ASMT/PI)**2) + MTQ=SSMQCD(DBLE(MTMT),DBLE(HIGFRZ)) + MTAMZ=FTAMZ*COSB*VEV +C +C Compute some masses from RGE solution to prepare for SSMASS, +C which computes the rest. +C + MSSS=G0(19)+AMUP**2+(.5-2*XW/3.)*MZ**2*COS2B + IF (MSSS.LE.0.) THEN + NOGOOD=1 + GO TO 100 + END IF +C Squark and slepton masses + MSS(2)=SQRT(MSSS) + MSS(3)=SQRT(G0(18)+AMUP**2+2./3.*XW*MZ**2*COS2B) + MSS(4)=SQRT(G0(19)+AMDN**2+(-.5+XW/3.)*MZ**2*COS2B) + MSS(5)=SQRT(G0(17)+AMDN**2-1./3.*XW*MZ**2*COS2B) + MSS(6)=SQRT(G0(19)+AMST**2+(-.5+XW/3.)*MZ**2*COS2B) + MSS(7)=SQRT(G0(17)+AMST**2-1./3.*XW*MZ**2*COS2B) + MSS(8)=SQRT(G0(19)+AMCH**2+(.5-2*XW/3.)*MZ**2*COS2B) + MSS(9)=SQRT(G0(18)+AMCH**2+2./3.*XW*MZ**2*COS2B) + BRKT=(.5*(G0(24)-G0(22))-COS2B*(4*MW**2-MZ**2)/12.)**2+ + $ MBQ**2*(AB-MU*TANB)**2 + TERM=.5*(G0(24)+G0(22))+MBQ**2-MZ**2*COS2B/4. + B1S=TERM-SQRT(BRKT) + B2S=TERM+SQRT(BRKT) + MSS(10)=SQRT(MAX(0.,B1S)) + MSS(11)=SQRT(MAX(0.,B2S)) + BRKT=(.5*(G0(24)-G0(23))+COS2B*(8*MW**2-5*MZ**2)/12.)**2+ + $ MTQ**2*(AT-MU*COTB)**2 + TERM=.5*(G0(24)+G0(23))+MTQ**2+MZ**2*COS2B/4. + T1S=TERM-SQRT(BRKT) + IF (T1S.LE.0..OR.B1S.LE.0.) THEN + NOGOOD=1 + GO TO 100 + END IF + T2S=TERM+SQRT(BRKT) + MSS(12)=SQRT(MAX(0.,T1S)) + MSS(13)=SQRT(MAX(0.,T2S)) + MSSS=G0(16)+.5*MZ**2*COS2B + IF (MSSS.LE.0.) THEN + NOGOOD=1 + GO TO 100 + END IF + MSS(14)=SQRT(MSSS) + MSS(15)=MSS(14) + MSSS=G0(21)+.5*MZ**2*COS2B + IF (MSSS.LE.0.) THEN + NOGOOD=1 + GO TO 100 + END IF + MSS(16)=SQRT(MSSS) + MSS(17)=SQRT(G0(16)+AME**2-.5*(2*MW**2-MZ**2)*COS2B) + MSS(18)=SQRT(G0(15)+AME**2+(MW**2-MZ**2)*COS2B) + MSS(19)=SQRT(G0(16)+AMMU**2-.5*(2*MW**2-MZ**2)*COS2B) + MSS(20)=SQRT(G0(15)+AMMU**2+(MW**2-MZ**2)*COS2B) + BRKT=(.5*(G0(21)-G0(20))-COS2B*(4*MW**2-3*MZ**2)/4.)**2+ + $ MTAMZ**2*(ATAU-MU*TANB)**2 + TERM=.5*(G0(21)+G0(20))+MTAMZ**2-MZ**2*COS2B/4. + T1S=TERM-SQRT(BRKT) + IF (T1S.LE.0.) THEN + NOGOOD=1 + GO TO 100 + END IF + T2S=TERM+SQRT(BRKT) + MSS(21)=SQRT(MAX(0.,T1S)) + MSS(22)=SQRT(MAX(0.,T2S)) +C A0 mass + M1S=MU**2+G0(13) + M2S=MU**2+G0(14) + MSB1=MSS(10) + MSB2=MSS(11) + MST1=MSS(12) + MST2=MSS(13) + MSL1=MSS(21) + MSL2=MSS(22) + MB=AMBT + FNT=(SUGMFN(MST2)-SUGMFN(MST1))/(MST2**2-MST1**2) + $*AT*MTQ**2/SINB**2 + FNB=(SUGMFN(MSB2)-SUGMFN(MSB1))/(MSB2**2-MSB1**2) + $*AB*MBQ**2/COSB**2 + FNL=(SUGMFN(MSL2)-SUGMFN(MSL1))/(MSL2**2-MSL1**2) + $*ATAU*MTAMZ**2/COSB**2 + FCN=FNT+FNB+FNL/3. + DELHPS=3*G0(2)**2*MU*(COTB+TANB)/32./PI**2/MW**2*FCN + RDEL=SQRT(ABS(DELHPS)) +C Tree level mhp not needed at this point so fix if negative + IF (ILOOP.EQ.0) THEN + MHPS=M1S+M2S + IF (MHPS.LT.0.) MHPS=0. + ELSE + MHPS=B*MU*(COTB+TANB)+DELHPS + IF (MHPS.LT.0.) THEN + NOGOOD=3 + MHPS=AMZ**2 + END IF + END IF + MHP=SQRT(MHPS) + MSS(31)=MHP +C APPLY XERXES' TEST FOR PROPER POTENTIAL SHAPE AT THE ORIGIN +C REMOVE THIS CONSTRAINT ON 4/7/00 + IF (ILOOP.EQ.1) THEN + L1=MIN(G0(24),G0(23)) + L2=MAX(G0(24),G0(23)) + RL1=SQRT(L1) + RL2=SQRT(L2) + DA=3*G0(6)**2*AT**2/ABS(G0(24)-G0(23))/16./PI**2* + $(-SUGMFN(RL1)+SUGMFN(RL2)) + DB=3*G0(6)**2/16./PI**2* + $(SUGMFN(RL1)*(1.-AT**2/ABS(G0(24)-G0(23)))+SUGMFN(RL2)* + $(1.+AT**2/ABS(G0(24)-G0(23)))) + DC=-3*G0(6)**2*AT*MU/ABS(G0(24)-G0(23))/16./PI**2* + $(-SUGMFN(RL1)+SUGMFN(RL2)) + AA=M1S+DA + BB=M2S+DB + CC=-B*MU+DC + EVAL1=((AA+BB)-SQRT((AA+BB)**2-4*(AA*BB-CC*CC)))/2. +C IF (EVAL1.GE.0) THEN +C NOGOOD=7 +C END IF + END IF +C +C Initialize SUSY parameters in /SSPAR/: +C + AMGLSS=G0(9) + AMULSS=MSS(2) + AMURSS=MSS(3) + AMDLSS=MSS(4) + AMDRSS=MSS(5) + AMSLSS=MSS(6) + AMSRSS=MSS(7) + AMCLSS=MSS(8) + AMCRSS=MSS(9) + AMN1SS=MSS(16) + AMN2SS=MSS(16) + AMN3SS=MSS(16) + AMELSS=MSS(17) + AMERSS=MSS(18) + AMMLSS=MSS(19) + AMMRSS=MSS(20) + TWOM1=-MU + RV2V1=1./TANB + AMTLSS=SQRT(G0(24)) + AMTRSS=SQRT(G0(23)) + AMBLSS=SQRT(G0(24)) + AMBRSS=SQRT(G0(22)) + AMLLSS=SQRT(G0(21)) + AMLRSS=SQRT(G0(20)) + AAT=G0(12) + AAB=G0(11) + AAL=G0(10) + AMHA=MHP +C +C Use SSMASS to diagonalize neutralino and chargino mass +C matrices and calculate Higgs masses. +C + MHLNEG=0 + MHCNEG=0 + CALL SSMASS(G0(7),G0(8),IALLOW,ILOOP,MHLNEG,MHCNEG,IMODEL) + IF(MHLNEG.EQ.1.OR.MHCNEG.EQ.1) THEN + NOGOOD=8 + ENDIF + IF(IALLOW.NE.0) THEN + NOGOOD=5 + GO TO 100 + ENDIF +C +C Save results also in MSS +C + MSS(23)=AMZ1SS + MSS(24)=AMZ2SS + MSS(25)=AMZ3SS + MSS(26)=AMZ4SS + MSS(27)=AMW1SS + MSS(28)=AMW2SS + MSS(29)=AMHL + MSS(30)=AMHH + MSS(31)=AMHA + MSS(32)=AMHC +C Gluino pole mass + MGLMGL=G0(9) + ASMGL=SUALFS(MGLMGL**2,.36,MT,3) + MSS(1)=SSPOLE(MGLMGL,MGLMGL**2,ASMGL) + AMGLSS=MSS(1) +C +100 RETURN + END diff --git a/ISAJET/isasusy/sugra.F b/ISAJET/isasusy/sugra.F new file mode 100644 index 00000000000..79d232535fd --- /dev/null +++ b/ISAJET/isasusy/sugra.F @@ -0,0 +1,521 @@ +#include "isajet/pilot.h" +C-------------------------------------------------------------------- + SUBROUTINE SUGRA(M0,MHF,A0,TANB,SGNMU,MT,IMODEL) +C-------------------------------------------------------------------- +C +C Calculate supergravity spectra for ISAJET using as inputs +C M0 = M_0 = common scalar mass at GUT scale +C MHF = M_(1/2) = common gaugino mass at GUT scale +C A0 = A_0 = trilinear soft breaking parameter at GUT scale +C TANB = tan(beta) = ratio of vacuum expectation values v_1/v_2 +C SGNMU = sgn(mu) = +-1 = sign of Higgsino mass term +C MT = M_t = mass of t quark +C M0 = Lambda = ratio of vevs / +C MHF = M_Mes = messenger scale +C A0 = n_5 = number of messenger fields +C IMODEL = 1 for SUGRA model +C = 2 for GMSB model +C = 7 for AMSB model +C +C Uses Runge-Kutta method to integrate RGE's from M_Z to M_GUT +C and back, putting in correct thresholds. For the first iteration +C only the first 6 couplings are included and a common threshold +C is used. +C +C See /SUGMG/ for definitions of couplings and masses. +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sslun.inc" +#include "isajet/sspar.inc" +#include "isajet/sssm.inc" +#include "isajet/sugxin.inc" +#include "isajet/sugmg.inc" +#include "isajet/sugpas.inc" +#include "isajet/sugnu.inc" +#include "isajet/ssinf.inc" + REAL GY(7),W1(21),G(29),W2(87) + REAL G0(29) + COMPLEX*16 SSB0,SSB1 + DOUBLE PRECISION DDILOG,XLM + INTEGER IG(29) + EXTERNAL SURG06,SURG26 + REAL M0,MHF,A0,TANB,SGNMU,MT,XLAMGM,XMESGM,XN5GM + INTEGER NSTEP + REAL M2,SUALFE,SUALFS,Q,T,A1I,AGUT,A3I,A2I,MTMT,ASMT,DT, + $TGUT,TZ,GGUT,SIG2,SIG1,MH1S,MH2S,AGUTI, + $MUS,MBMZ,MB,MTAU,MZ,MW,SR2,PI,ALEM,MTAMZ, + $MTAMB,MTAMTA,MBMB,ASMB,BETA,COTB,SINB,COS2B,COSB,XC, + $MSN,MG,MT1,MT2,MB1,MB2,MW1,MW2,AMU,BTHAT,BBHAT,BLHAT,AM2 + INTEGER II,I,J,IMODEL + REAL G0SAVE(26),DELG0,DELLIM,THRF,THRG,DY,QOLD + INTEGER MXITER,NSTEP0 + COMPLEX*16 ZZZ + REAL*8 REAL8 +C + DATA MZ/91.187/,MTAU/1.777/,MB/4.9/,ALEM/.0078186/ +C This choice is a compromise between precision and speed: + DATA MXITER/20/,NSTEP0/200/,DELLIM/2.E-2/ +C +C Define REAL(COMPLEX*16) for g77. This might need to be +C changed for 64-bit machines? +C + REAL8(ZZZ)=DREAL(ZZZ) +C +C Save input parameters +C + XSUGIN(1)=M0 + XSUGIN(2)=MHF + XSUGIN(3)=A0 + XSUGIN(4)=TANB + XSUGIN(5)=SGNMU + XSUGIN(6)=MT + XLAMGM=M0 + XMESGM=MHF + XN5GM=A0 + XGMIN(1)=XLAMGM + XGMIN(2)=XMESGM + XGMIN(3)=XN5GM + XGMIN(4)=TANB + XGMIN(5)=SGNMU + XGMIN(6)=MT + IF (XGMIN(12).EQ.0.) XGMIN(12)=XN5GM + IF (XGMIN(13).EQ.0.) XGMIN(13)=XN5GM + IF (XGMIN(14).EQ.0.) XGMIN(14)=XN5GM +C +C Compute gauge mediated threshold functions +C + IF (IMODEL.EQ.2) THEN + XLM=XLAMGM/XMESGM + THRF=((1.D0+XLM)*(LOG(1.D0+XLM)-2*DDILOG(XLM/(1.D0+XLM))+ + , .5*DDILOG(2*XLM/(1.D0+XLM)))+ + , (1.D0-XLM)*(LOG(1.D0-XLM)-2*DDILOG(-XLM/(1.D0-XLM))+ + , .5*DDILOG(-2*XLM/(1.D0-XLM))))/XLM**2 + THRG=((1.D0+XLM)*LOG(1.D0+XLM)+(1.D0-XLM)*LOG(1.D0-XLM))/XLM**2 + END IF +C +C Initialize standard model parameters in /SSSM/: +C + AMUP=0.0056 + AMDN=0.0099 + AMST=0.199 + AMCH=1.35 + AMBT=5.0 + AMTP=MT + AMT=MT + AME=0.511E-3 + AMMU=0.105 + AMTAU=1.777 + AMZ=91.17 + GAMW=2.12 + GAMZ=2.487 + ALFAEM=1./128. + SN2THW=0.232 + ALFA2=ALFAEM/SN2THW + ALQCD4=0.177 + ALFA3=0.118 +C + NOGOOD=0 + ITACHY=0 + PI=4.*ATAN(1.) + SR2=SQRT(2.) + XW=.2324-1.03E-7*(MT**2-138.**2) + MW=MZ*SQRT(1.-XW) + AMW=MW + A1MZ=5*ALEM/3./(1.-XW) + A2MZ=ALEM/XW + G2=SQRT(4*PI*A2MZ) + GP=SQRT(3./5.*A1MZ*4.*PI) + XTANB=TANB + COTB=1./TANB + BETA=ATAN(TANB) + SINB=SIN(BETA) + COSB=COS(BETA) + SIN2B=SIN(2*BETA) + COS2B=COS(2*BETA) + IF (IMODEL.EQ.1) THEN + MSUSY=SQRT(M0**2+4*MHF**2) + ELSE IF (IMODEL.EQ.2) THEN + MSUSY=XLAMGM/100. + ELSE IF (IMODEL.EQ.7) THEN + MSUSY=SQRT(M0**2+(.01*MHF)**2) + END IF +C USE PIERCE PRESCRIPTION FOR MAGNITUDE OF VEV +C VEV=SR2*(248.6+0.9*LOG(MSUSY/AMZ) +C V=SQRT(VEV**2/(1.+COTB)) +C PREVIOUS PRESCRIPTION + V=SQRT(2*MW**2/G2**2/(1.+COTB**2)) + VP=V/TANB + VEV=SQRT(V**2+VP**2) +C +C Compute m(tau), m(b) at z scale using qcd, qed +C + MTAMTA=MTAU*(1.-SUALFE(MTAU**2)/PI) + MTAMB=MTAMTA*(SUALFE(MB**2)/SUALFE(MTAU**2))**(-27./76.) + MTAMZ=MTAMB*(SUALFE(MZ**2)/SUALFE(MB**2))**(-27./80.) + FTAMZ=MTAMZ/COSB/VEV + ASMB=SUALFS(MB**2,.36,MT,3) + MBMB=MB*(1.-4*ASMB/3./PI) + ASMZ=SUALFS(MZ**2,.36,MT,3) + MBMZ=MBMB*(ASMZ/ASMB)**(12./23.)* + $ (SUALFE(MZ**2)/SUALFE(MB**2))**(-3./80.) + FBMZ=MBMZ/COSB/VEV + ASMT=SUALFS(MT**2,.36,MT,3) + MTMT=MT/(1.+4*ASMT/3./PI+(16.11-1.04*(5.-6.63/MT))*(ASMT/PI)**2) + FTMT=MTMT/SINB/VEV + FNMZ=SQRT(XNRIN(2)*XNRIN(1)/(SINB*VEV)**2) + AMNRMJ=XNRIN(2) +C +C Run the 3 gauge and 3 Yukawa's up to find M_GUT ,A_GUT and +C Yukawa_GUT +C +C + NSTEP=NSTEP0 + GY(1)=SQRT(4*PI*A1MZ) + GY(2)=SQRT(4*PI*A2MZ) + GY(3)=SQRT(4*PI*ALFA3) + GY(4)=FTAMZ + GY(5)=FBMZ + GY(6)=0. + GY(7)=0. + IF (IMODEL.EQ.1.OR.IMODEL.EQ.7) THEN + IF (XSUGIN(7).EQ.0.) THEN + MGUT=1.E19 + ELSE + MGUT=XSUGIN(7) + END IF + ELSE IF (IMODEL.EQ.2) THEN + MGUT=XMESGM + END IF + TZ=LOG(MZ/MGUT) + TGUT=0. + DT=(TGUT-TZ)/FLOAT(NSTEP) + DO 200 II=1,NSTEP + T=TZ+(TGUT-TZ)*FLOAT(II-1)/FLOAT(NSTEP) + Q=MGUT*EXP(T) + IF (Q.GT.MT.AND.GY(6).EQ.0.) GY(6)=FTMT + IF (Q.GT.XNRIN(2).AND.GY(7).EQ.0.) GY(7)=FNMZ + CALL RKSTP(7,DT,T,GY,SURG06,W1) + A1I=4*PI/GY(1)**2 + A2I=4*PI/GY(2)**2 + A3I=4*PI/GY(3)**2 + IF (GY(5).GT.10..OR.GY(6).GT.10..OR.GY(7).GT.10.) THEN + NOGOOD=4 + GO TO 100 + END IF + IF (A1I.LT.A2I.AND.XSUGIN(7).EQ.0.) GO TO 10 +200 CONTINUE + IF (MGUT.EQ.1.E19) THEN + WRITE(LOUT,*) 'SUGRA: NO UNIFICATION FOUND' + GO TO 100 + END IF +10 IF (XSUGIN(7).EQ.0.) THEN + MGUT=Q + ELSE + MGUT=XSUGIN(7) + END IF + AGUT=(GY(1)**2/4./PI+GY(2)**2/4./PI)/2. + GGUT=SQRT(4*PI*AGUT) + AGUTI=1./AGUT + FTAGUT=GY(4) + FBGUT=GY(5) + FTGUT=GY(6) + IF (XNRIN(1).EQ.0..AND.XNRIN(2).LT.1.E19) THEN +C UNIFY FN-FT + FNGUT=GY(6) + ELSE + FNGUT=GY(7) + END IF +C +C Define parameters at GUT scale +C + DO 210 J=1,3 + IF (IMODEL.EQ.1) THEN + G(J)=GY(J) + G(J+6)=MHF + G(J+9)=A0 + ELSE IF (IMODEL.EQ.2) THEN + G(J)=GY(J) + G(J+6)=XGMIN(11+J)*XGMIN(8)*THRG*(GY(J)/4./PI)**2*XLAMGM + G(J+9)=0. + END IF +210 CONTINUE +C OVERWRITE ALFA_3 UNIFICATION TO GET ALFA_3(MZ) RIGHT + IF (IMODEL.EQ.1.AND.IAL3UN.NE.0) G(3)=GGUT + G(4)=FTAGUT + G(5)=FBGUT + G(6)=FTGUT +C IF NR MAJORANA MASS EXISTS, SET EXTRA NR RGE PARAMETERS + IF (XNRIN(2).LT.1.E19) THEN + G(27)=FNGUT + G(28)=XNRIN(4)**2 + G(29)=XNRIN(3) + ELSE + G(27)=0. + G(28)=0. + G(29)=0. + END IF + IF (IMODEL.EQ.1) THEN + DO 220 J=13,24 + G(J)=M0**2 +220 CONTINUE +C Set possible non-universal boundary conditions + DO 230 J=1,6 + IF (XNUSUG(J).LT.1.E19) THEN + G(J+6)=XNUSUG(J) + END IF +230 CONTINUE + DO 231 J=7,18 + IF (XNUSUG(J).LT.1.E19) THEN + G(J+6)=XNUSUG(J)**2 + END IF +231 CONTINUE + ELSE IF (IMODEL.EQ.2) THEN + XC=2*THRF*XLAMGM**2 + DY=SQRT(3./5.)*GY(1)*XGMIN(11) + G(13)=XC*(.75*XGMIN(13)*(GY(2)/4./PI)**4+.6*.25* + ,XGMIN(12)*(GY(1)/4./PI)**4)+XGMIN(9)-DY + G(14)=XC*(.75*XGMIN(13)*(GY(2)/4./PI)**4+.6*.25* + ,XGMIN(12)*(GY(1)/4./PI)**4)+XGMIN(10)+DY + G(15)=XC*(.6*XGMIN(12)*(GY(1)/4./PI)**4)+2*DY + G(16)=XC*(.75*XGMIN(13)*(GY(2)/4./PI)**4+.6*.25* + ,XGMIN(12)*(GY(1)/4./PI)**4)-DY + G(17)=XC*(4*XGMIN(14)*(GY(3)/4./PI)**4/3.+.6*XGMIN(12)* + ,(GY(1)/4./PI)**4/9.)+2*DY/3. + G(18)=XC*(4*XGMIN(14)*(GY(3)/4./PI)**4/3.+.6*4*XGMIN(12)* + ,(GY(1)/4./PI)**4/9.)-4*DY/3. + G(19)=XC*(4*XGMIN(14)*(GY(3)/4./PI)**4/3.+.75*XGMIN(13)* + ,(GY(2)/4./PI)**4+.6*XGMIN(12)*(GY(1)/4./PI)**4/36.)+DY/3. + G(20)=G(15) + G(21)=G(16) + G(22)=G(17) + G(23)=G(18) + G(24)=G(19) + ELSE IF (IMODEL.EQ.7) THEN + G(1)=GY(1) + G(2)=GY(2) + G(3)=GY(3) + BLHAT=G(4)*(-9*G(1)**2/5.-3*G(2)**2+3*G(5)**2+4*G(4)**2) + BBHAT=G(5)*(-7*G(1)**2/15.-3*G(2)**2-16*G(3)**2/3.+ + , G(6)**2+6*G(5)**2+G(4)**2) + BTHAT=G(6)*(-13*G(1)**2/15.-3*G(2)**2-16*G(3)**2/3.+ + , 6*G(6)**2+G(5)**2) + G(7)=-33*MHF*G(1)**2/5./16./PI**2 + G(8)=-MHF*G(2)**2/16./PI**2 + G(9)=3*MHF*G(3)**2/16./PI**2 + G(10)=BLHAT*MHF/G(4)/16./PI**2 + G(11)=BBHAT*MHF/G(5)/16./PI**2 + G(12)=BTHAT*MHF/G(6)/16./PI**2 + G(13)=(-99*G(1)**4/50.-3*G(2)**4/2.+3*G(5)*BBHAT+G(4)*BLHAT)* + , MHF**2/(16*PI**2)**2 + G(14)=(-99*G(1)**4/50.-3*G(2)**4/2.+3*G(6)*BTHAT)* + , MHF**2/(16*PI**2)**2 + G(15)=(-198*G(1)**4/25.)*MHF**2/(16*PI**2)**2 + G(16)=(-99*G(1)**4/50.-3*G(2)**4/2.)*MHF**2/(16*PI**2)**2 + G(17)=(-22*G(1)**4/25.+8*G(3)**4)*MHF**2/(16*PI**2)**2 + G(18)=(-88*G(1)**4/25.+8*G(3)**4)*MHF**2/(16*PI**2)**2 + G(19)=(-11*G(1)**4/50.-3*G(2)**4/2.+8*G(3)**4)* + , MHF**2/(16*PI**2)**2 + G(20)=(-198*G(1)**4/25.+2*G(4)*BLHAT)*MHF**2/(16*PI**2)**2 + G(21)=(-99*G(1)**4/50.-3*G(2)**4/2.+G(4)*BLHAT)* + , MHF**2/(16*PI**2)**2 + G(22)=(-22*G(1)**4/25.+8*G(3)**4+2*G(5)*BBHAT)* + ,MHF**2/(16*PI**2)**2 + G(23)=(-88*G(1)**4/25.+8*G(3)**4+2*G(6)*BTHAT)* + ,MHF**2/(16*PI**2)**2 + G(24)=(-11*G(1)**4/50.-3*G(2)**4/2.+8*G(3)**4+G(5)*BBHAT+ + , G(6)*BTHAT)*MHF**2/(16*PI**2)**2 + DO 234 I=13,24 +234 G(I)=G(I)+M0**2 + END IF + G(25)=0. + G(26)=0. + DO 235 I=1,29 + IG(I)=0 +235 CONTINUE +C Check for tachyonic sleptons at GUT scale + IF (G(15).LT.0..OR.G(16).LT.0.) THEN + ITACHY=1 + END IF +C +C Initialize thresholds +C + MSS(1)=MSUSY + MSS(2)=MSUSY + MSS(17)=MSUSY + MSS(27)=MSUSY + MSS(31)=MSUSY + MU=MSUSY +C +C Evolve parameters from mgut to mz +C + TZ=LOG(MZ/MGUT) + TGUT=0. + DT=(TZ-TGUT)/FLOAT(NSTEP) +C Freeze Higgs parameters at HIGFRZ = Drees' value +C AMTLSS, AMTRSS initialized to 0 for later use in HIGFRZ + IF (IMODEL.EQ.1) THEN + HIGFRZ=SQRT(M0**2+3*MHF**2) + ELSE IF (IMODEL.EQ.2) THEN + HIGFRZ=MSUSY + ELSE IF (IMODEL.EQ.7) THEN + HIGFRZ=SQRT(M0**2+(.01*MHF)**2) + END IF + AMTLSS=0 + AMTRSS=0 + DO 240 II=1,NSTEP+2 + T=TGUT+(TZ-TGUT)*FLOAT(II-1)/FLOAT(NSTEP) + QOLD=Q + Q=MGUT*EXP(T) + CALL RKSTP(29,DT,T,G,SURG26,W2) + IF (Q.LT.AMNRMJ.AND.QOLD.GE.AMNRMJ.AND.FNMZ.EQ.0.) THEN + FNMZ=G(27) + END IF + IF (Q.LT.AMNRMJ) THEN + G(27)=0. + G(28)=0. + G(29)=0. + END IF + CALL SUGFRZ(Q,G,G0,IG) + IF (NOGOOD.NE.0) GO TO 100 + IF (Q.LT.MZ) GO TO 20 +240 CONTINUE +20 CONTINUE + ASMZ=G0(3)**2/4./PI +C Electroweak breaking constraints; tree level + MUS=(G0(13)-G0(14)*TANB**2)/(TANB**2-1.)-MZ**2/2. + IF (MUS.LT.0.) THEN + NOGOOD=2 + GO TO 100 + END IF + MU=SQRT(MUS)*SIGN(1.,SGNMU) + B=(G0(13)+G0(14)+2*MUS)*SIN2B/MU/2. +C Compute tree level masses + CALL SUGMAS(G0,0,IMODEL) + IF (NOGOOD.NE.0) GO TO 100 +C Compute effective potential corrections + CALL SUGEFF(G0,SIG1,SIG2) + MH1S=G0(13)+SIG1 + MH2S=G0(14)+SIG2 + MUS=(MH1S-MH2S*TANB**2)/(TANB**2-1.)-MZ**2/2. + IF (MUS.LT.0.) THEN + NOGOOD=2 + GO TO 100 + END IF + MU=SQRT(MUS)*SIGN(1.,SGNMU) + B=(MH1S+MH2S+2*MUS)*SIN2B/MU/2. +C +C Recompute weak scale Yukawa couplings including SUSY loops +C Follow formulae of Pierce et al. NPB491, 3 (1997) +C + M2=G0(8) + AM2=ABS(M2) + MSN=MSS(16) + MG=MSS(1) + MT1=MSS(12) + MT2=MSS(13) + MB1=MSS(10) + MB2=MSS(11) + MW1=ABS(MSS(27)) + MW2=ABS(MSS(28)) + AMU=ABS(MU) + XLAM=LOG(MT**2) +C Be careful in using our convention vs Pierce et al. + IF (ABS(COS(THETAT)).LT..707107) THEN + MTMT=MT/(1.+4*ASMT/3./PI+(16.11-1.04*(5.-6.63/MT))*(ASMT/PI)**2 + $ -ASMT/3./PI*(REAL8(SSB1(MT**2,MG,MT1))+ + $ REAL8(SSB1(MT**2,MG,MT2))-SIN(2*THETAT)*MG/MT* + $ (REAL8(SSB0(MT**2,MG,MT1))-REAL8(SSB0(MT**2,MG,MT2))))) + ELSE + MTMT=MT/(1.+4*ASMT/3./PI+(16.11-1.04*(5.-6.63/MT))*(ASMT/PI)**2 + $ -ASMT/3./PI*(REAL8(SSB1(MT**2,MG,MT2))+ + $ REAL8(SSB1(MT**2,MG,MT1))+SIN(2*THETAT)*MG/MT* + $ (REAL8(SSB0(MT**2,MG,MT2))-REAL8(SSB0(MT**2,MG,MT1))))) + END IF + FTMT=MTMT/SINB/VEV + XLAM=LOG(MZ**2) + IF (ABS(COS(THETAB)).LT..707107) THEN + MBMZ=MBMZ*(1.+ASMZ/3./PI*(REAL8(SSB1(MZ**2,MG,MB1))+ + $ REAL8(SSB1(MZ**2,MG,MB2))-SIN(2*THETAB)*MG/MB* + $ (REAL8(SSB0(MZ**2,MG,MB1))-REAL8(SSB0(MZ**2,MG,MB2)))) + $ -FTMT**2*MU*(-AAT*TANB+MU)/16./PI**2/(MT1**2-MT2**2)* + $ (REAL8(SSB0(MZ**2,AMU,MT1))-REAL8(SSB0(MZ**2,AMU,MT2)))+ + $ G2**2*MU*M2*TANB/16./PI**2/(AMU**2-M2**2)* + $ (SIN(THETAT)**2*(REAL8(SSB0(MZ**2,AM2,MT1))- + $ REAL8(SSB0(MZ**2,AMU,MT1)))+ + $ COS(THETAT)**2*(REAL8(SSB0(MZ**2,AM2,MT2))- + $ REAL8(SSB0(MZ**2,AMU,MT2))))) + ELSE + MBMZ=MBMZ*(1.+ASMZ/3./PI*(REAL8(SSB1(MZ**2,MG,MB2))+ + $ REAL8(SSB1(MZ**2,MG,MB1))+SIN(2*THETAB)*MG/MB* + $ (REAL8(SSB0(MZ**2,MG,MB2))-REAL8(SSB0(MZ**2,MG,MB1)))) + $ -FTMT**2*MU*(-AAT*TANB+MU)/16./PI**2/(MT2**2-MT1**2)* + $ (REAL8(SSB0(MZ**2,AMU,MT2))-REAL8(SSB0(MZ**2,AMU,MT1)))+ + $ G2**2*MU*M2*TANB/16./PI**2/(AMU**2-M2**2)* + $ (COS(THETAT)**2*(REAL8(SSB0(MZ**2,AM2,MT2))- + $ REAL8(SSB0(MZ**2,AMU,MT2)))+ + $ SIN(THETAT)**2*(REAL8(SSB0(MZ**2,AM2,MT1))- + $ REAL8(SSB0(MZ**2,AMU,MT1))))) + END IF + FBMZ=MBMZ/COSB/VEV + MTAMZ=MTAMZ*(1.+G2**2*MU*M2*TANB/16./PI**2/(MUS-M2**2)* + $(REAL8(SSB0(MZ**2,AM2,MSN))-REAL8(SSB0(MZ**2,AMU,MSN)))) + FTAMZ=MTAMZ/COSB/VEV +C +C Iterate entire process, increasing NSTEP each time +C This time, freeze out parameters at sqrt(t_l t_r) +C + HIGFRZ=MAX(AMZ,(G0(23)*G0(24))**0.25) + DO 300 I=1,MXITER + DO 310 J=1,26 +310 G0SAVE(J)=G0(J) + NSTEP=1.2*NSTEP + CALL SUGRGE(M0,MHF,A0,TANB,SGNMU,MT,G,G0,IG,W2,NSTEP,IMODEL) + IF(NOGOOD.NE.0) GO TO 100 + DELG0=0. + DO 320 J=1,24 +320 DELG0=MAX(DELG0,ABS((G0(J)-G0SAVE(J))/G0(J))) + IF(DELG0.LT.DELLIM) GO TO 400 +300 CONTINUE + WRITE(LOUT,1000) MXITER +1000 FORMAT(/' SUGRA WARNING: NO CONVERGENCE IN',I4,' ITERATIONS') +C +C Save results +C +400 DO 410 I=1,26 + GSS(I)=G0(I) +410 CONTINUE + MGUTSS=MGUT + AGUTSS=AGUT + GGUTSS=GGUT +C +C Fill XISAIN common block +C + XISAIN(1)=MSS(1) + XISAIN(2)=MU + XISAIN(3)=MSS(31) + XISAIN(4)=TANB + XISAIN(5)=SQRT(G0(19)) + XISAIN(6)=SQRT(G0(17)) + XISAIN(7)=SQRT(G0(18)) + XISAIN(8)=SQRT(G0(16)) + XISAIN(9)=SQRT(G0(15)) + XISAIN(10)=XISAIN(5) + XISAIN(11)=XISAIN(6) + XISAIN(12)=XISAIN(7) + XISAIN(13)=XISAIN(8) + XISAIN(14)=XISAIN(9) + XISAIN(15)=SQRT(G0(24)) + XISAIN(16)=SQRT(G0(22)) + XISAIN(17)=SQRT(G0(23)) + XISAIN(18)=SQRT(G0(21)) + XISAIN(19)=SQRT(G0(20)) + XISAIN(20)=G0(12) + XISAIN(21)=G0(11) + XISAIN(22)=G0(10) + XISAIN(23)=G0(7) + XISAIN(24)=G0(8) + M2=G0(8) +100 RETURN + END diff --git a/ISAJET/isasusy/sugrge.F b/ISAJET/isasusy/sugrge.F new file mode 100644 index 00000000000..66346aab09f --- /dev/null +++ b/ISAJET/isasusy/sugrge.F @@ -0,0 +1,282 @@ +#include "isajet/pilot.h" + SUBROUTINE SUGRGE(M0,MHF,A0,TANB,SGNMU,MT,G,G0,IG,W2 + $,NSTEP,IMODEL) +C +C Make one complete iteration of the renormalization group +C equations from MZ to MGUT and back, setting the boundary +C conditions on each end. +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sslun.inc" +#include "isajet/sssm.inc" +#include "isajet/sugpas.inc" +#include "isajet/sugnu.inc" +#include "isajet/sugxin.inc" +#include "isajet/sugmg.inc" +C + EXTERNAL SURG26 + DOUBLE PRECISION DDILOG,XLM + REAL M0,MHF,A0,TANB,SGNMU,MT,G(29),G0(29),W2(87) + INTEGER IG(29),NSTEP,IMODEL + REAL PI,TZ,A1I,A2I,A3I,GGUT,AGUTI,SIG1,SIG2, + $MH1S,MH2S,MUS,T,MZ,TGUT,DT,AGUT,Q,ASMT,MTMT,SINB, + $BETA,QOLD,XLAMGM,XMESGM,XN5GM,XC,G3GUT,THRF,THRG,DY, + $BLHAT,BBHAT,BTHAT + INTEGER I,II + DATA MZ/91.187/ +C +C Re-initialize weak scale parameters +C + XLAMGM=M0 + XMESGM=MHF + XN5GM=A0 + PI=4.*ATAN(1.) + BETA=ATAN(XTANB) + SINB=SIN(BETA) + ASMZ=0.118 +C ASMT=G3MT**2/4./PI +C MTMT=MT/(1.+4*ASMT/3./PI+(16.11-1.04*(5.-6.63/MT))*(ASMT/PI)**2) +C FTMT=MTMT/SINB/VEV + G(1)=SQRT(4*PI*A1MZ) + G(2)=SQRT(4*PI*A2MZ) + G(3)=SQRT(4*PI*ASMZ) + G(4)=FTAMZ + G(5)=FBMZ + G(6)=G(6) + G(25)=MU + G(26)=B + G(27)=0. + G(28)=0. + G(29)=0. +C Compute gauge mediated threshold functions + IF (IMODEL.EQ.2) THEN + XLM=XLAMGM/XMESGM + THRF=((1.D0+XLM)*(LOG(1.D0+XLM)-2*DDILOG(XLM/(1.D0+XLM))+ + , .5*DDILOG(2*XLM/(1.D0+XLM)))+ + , (1.D0-XLM)*(LOG(1.D0-XLM)-2*DDILOG(-XLM/(1.D0-XLM))+ + , .5*DDILOG(-2*XLM/(1.D0-XLM))))/XLM**2 + THRG=((1.D0+XLM)*LOG(1.D0+XLM)+(1.D0-XLM)*LOG(1.D0-XLM))/XLM**2 + END IF +C +C Run back up to mgut with approximate susy spectra +C + IF (IMODEL.EQ.1) THEN + IF (XSUGIN(7).EQ.0.) THEN + MGUT=1.E19 + ELSE + MGUT=XSUGIN(7) + END IF + ELSE IF (IMODEL.EQ.2) THEN + MGUT=XMESGM + END IF + TZ=LOG(MZ/MGUT) + TGUT=0. + DT=(TGUT-TZ)/FLOAT(NSTEP) + DO 250 II=1,NSTEP + T=TZ+(TGUT-TZ)*FLOAT(II-1)/FLOAT(NSTEP) + QOLD=Q + Q=MGUT*EXP(T) + IF (QOLD.LE.MT.AND.Q.GT.MT) G(6)=FTMT + IF (QOLD.LE.XNRIN(2).AND.Q.GT.XNRIN(2)) THEN + G(27)=FNMZ + G(28)=G0(28) + G(29)=G0(29) + END IF + CALL RKSTP(29,DT,T,G,SURG26,W2) + A1I=4*PI/G(1)**2 + A2I=4*PI/G(2)**2 + A3I=4*PI/G(3)**2 + IF (G(5).GT.10..OR.G(6).GT.10..OR.G(27).GT.10.) THEN + NOGOOD=4 + GO TO 100 + END IF + IF (A1I.LT.A2I.AND.XSUGIN(7).EQ.0.) GO TO 30 +250 CONTINUE + IF (IMODEL.EQ.1.AND.XSUGIN(7).EQ.0.) THEN + WRITE(LOUT,*) 'SUGRGE ERROR: NO UNIFICATION FOUND' + NOGOOD=1 + GO TO 100 + END IF +30 IF (XSUGIN(7).EQ.0.) THEN + MGUT=Q + ELSE + MGUT=XSUGIN(7) + END IF + AGUT=(G(1)**2/4./PI+G(2)**2/4./PI)/2. + GGUT=SQRT(4*PI*AGUT) + AGUTI=1./AGUT + FTAGUT=G(4) + FBGUT=G(5) + FTGUT=G(6) + IF (XNRIN(2).LT.1.E19.AND.XNRIN(1).EQ.0.) THEN +C IMPOSE FN-FT UNIFICATION + FNGUT=G(6) + ELSE + FNGUT=G(27) + END IF + G3GUT=G(3) + MGUTSS=MGUT + AGUTSS=AGUT + GGUTSS=GGUT +C +C Set GUT boundary condition +C + DO 260 I=1,3 + IF (IMODEL.EQ.1) THEN + G(I)=G(I) + G(I+6)=MHF + G(I+9)=A0 + ELSE IF (IMODEL.EQ.2) THEN + G(I)=G(I) + G(I+6)=XGMIN(11+I)*XGMIN(8)*THRG*(G(I)/4./PI)**2*XLAMGM + G(I+9)=0. + END IF + IF (XNRIN(2).LT.1.E19) THEN + G(27)=FNGUT + G(28)=XNRIN(4)**2 + G(29)=XNRIN(3) + ELSE + G(27)=0. + G(28)=0. + G(29)=0. + END IF +260 CONTINUE +C OVERWRITE ALFA_3 UNIFICATION TO GET ALFA_3(MZ) RIGHT + IF (IMODEL.EQ.1.AND.IAL3UN.NE.0) G(3)=GGUT + IF (IMODEL.EQ.1) THEN + DO 270 I=13,24 + G(I)=M0**2 +270 CONTINUE +C Set possible non-universal GUT scale boundary conditions + DO 280 I=1,6 + IF (XNUSUG(I).LT.1.E19) THEN + G(I+6)=XNUSUG(I) + END IF +280 CONTINUE + DO 281 I=7,18 + IF (XNUSUG(I).LT.1.E19) THEN + G(I+6)=XNUSUG(I)**2 + END IF +281 CONTINUE + ELSE IF (IMODEL.EQ.2) THEN + XC=2*THRF*XLAMGM**2 + DY=SQRT(3./5.)*G(1)*XGMIN(11) + G(13)=XC*(.75*XGMIN(13)*(G(2)/4./PI)**4+.6*.25* + , XGMIN(12)*(G(1)/4./PI)**4)+XGMIN(9)-DY + G(14)=XC*(.75*XGMIN(13)*(G(2)/4./PI)**4+.6*.25* + , XGMIN(12)*(G(1)/4./PI)**4)+XGMIN(10)+DY + G(15)=XC*(.6*XGMIN(12)*(G(1)/4./PI)**4)+2*DY + G(16)=XC*(.75*XGMIN(13)*(G(2)/4./PI)**4+.6*.25* + , XGMIN(12)*(G(1)/4./PI)**4)-DY + G(17)=XC*(4*XGMIN(14)*(G(3)/4./PI)**4/3.+.6*XGMIN(12)* + , (G(1)/4./PI)**4/9.)+2*DY/3. + G(18)=XC*(4*XGMIN(14)*(G(3)/4./PI)**4/3.+.6*4*XGMIN(12)* + , (G(1)/4./PI)**4/9.)-4*DY/3. + G(19)=XC*(4*XGMIN(14)*(G(3)/4./PI)**4/3.+.75*XGMIN(13)* + , (G(2)/4./PI)**4+.6*XGMIN(12)*(G(1)/4./PI)**4/36.)+DY/3. + G(20)=G(15) + G(21)=G(16) + G(22)=G(17) + G(23)=G(18) + G(24)=G(19) + ELSE IF (IMODEL.EQ.7) THEN + G(1)=G(1) + G(2)=G(2) + G(3)=G(3) + BLHAT=G(4)*(-9*G(1)**2/5.-3*G(2)**2+3*G(5)**2+4*G(4)**2) + BBHAT=G(5)*(-7*G(1)**2/15.-3*G(2)**2-16*G(3)**2/3.+ + , G(6)**2+6*G(5)**2+G(4)**2) + BTHAT=G(6)*(-13*G(1)**2/15.-3*G(2)**2-16*G(3)**2/3.+ + , 6*G(6)**2+G(5)**2) + G(7)=-33*MHF*G(1)**2/5./16./PI**2 + G(8)=-MHF*G(2)**2/16./PI**2 + G(9)=3*MHF*G(3)**2/16./PI**2 + G(10)=BLHAT*MHF/G(4)/16./PI**2 + G(11)=BBHAT*MHF/G(5)/16./PI**2 + G(12)=BTHAT*MHF/G(6)/16./PI**2 + G(13)=(-99*G(1)**4/50.-3*G(2)**4/2.+3*G(5)*BBHAT+G(4)*BLHAT)* + , MHF**2/(16*PI**2)**2 + G(14)=(-99*G(1)**4/50.-3*G(2)**4/2.+3*G(6)*BTHAT)* + , MHF**2/(16*PI**2)**2 + G(15)=(-198*G(1)**4/25.)*MHF**2/(16*PI**2)**2 + G(16)=(-99*G(1)**4/50.-3*G(2)**4/2.)*MHF**2/(16*PI**2)**2 + G(17)=(-22*G(1)**4/25.+8*G(3)**4)*MHF**2/(16*PI**2)**2 + G(18)=(-88*G(1)**4/25.+8*G(3)**4)*MHF**2/(16*PI**2)**2 + G(19)=(-11*G(1)**4/50.-3*G(2)**4/2.+8*G(3)**4)* + , MHF**2/(16*PI**2)**2 + G(20)=(-198*G(1)**4/25.+2*G(4)*BLHAT)*MHF**2/(16*PI**2)**2 + G(21)=(-99*G(1)**4/50.-3*G(2)**4/2.+G(4)*BLHAT)* + , MHF**2/(16*PI**2)**2 + G(22)=(-22*G(1)**4/25.+8*G(3)**4+2*G(5)*BBHAT)* + , MHF**2/(16*PI**2)**2 + G(23)=(-88*G(1)**4/25.+8*G(3)**4+2*G(6)*BTHAT)* + , MHF**2/(16*PI**2)**2 + G(24)=(-11*G(1)**4/50.-3*G(2)**4/2.+8*G(3)**4+G(5)*BBHAT+ + , G(6)*BTHAT)*MHF**2/(16*PI**2)**2 + DO 284 I=13,24 +284 G(I)=G(I)+M0**2 + END IF + DO 285 I=1,29 + IG(I)=0 +285 CONTINUE +C Check for tachyonic sleptons at GUT scale + IF (G(15).LT.0..OR.G(16).LT.0.) THEN + ITACHY=2 + ELSE + ITACHY=0 + END IF +C +C Run back down to weak scale +C + TZ=LOG(MZ/MGUT) + TGUT=0. + DT=(TZ-TGUT)/FLOAT(NSTEP) + DO 290 II=1,NSTEP+2 + T=TGUT+(TZ-TGUT)*FLOAT(II-1)/FLOAT(NSTEP) + QOLD=Q + Q=MGUT*EXP(T) + CALL RKSTP(29,DT,T,G,SURG26,W2) + CALL SUGFRZ(Q,G,G0,IG) + IF (QOLD.GE.AMNRMJ.AND.Q.LT.AMNRMJ.AND.XNRIN(1).EQ.0.) THEN + FNMZ=G(27) + END IF + IF (Q.LT.AMNRMJ) THEN + G(27)=0. + G(28)=0. + G(29)=0. + END IF + IF (NOGOOD.NE.0) GO TO 100 + IF (Q.LT.MZ) GO TO 40 +290 CONTINUE +40 CONTINUE +C +C Electroweak breaking constraints; tree level +C + MUS=(G0(13)-G0(14)*TANB**2)/(TANB**2-1.)-MZ**2/2. + IF (MUS.LT.0.) THEN + NOGOOD=2 + GO TO 100 + END IF + MU=SQRT(MUS)*SIGN(1.,SGNMU) + B=(G0(13)+G0(14)+2*MUS)*SIN2B/MU/2. + CALL SUGMAS(G0,0,IMODEL) + IF (NOGOOD.NE.0) GO TO 100 +C +C Electroweak breaking constraints; loop level +C + CALL SUGEFF(G0,SIG1,SIG2) + MH1S=G0(13)+SIG1 + MH2S=G0(14)+SIG2 + MUS=(MH1S-MH2S*TANB**2)/(TANB**2-1.)-MZ**2/2. + IF (MUS.LT.0.) THEN + NOGOOD=2 + GO TO 100 + END IF + MU=SQRT(MUS)*SIGN(1.,SGNMU) + B=(MH1S+MH2S+2*MUS)*SIN2B/MU/2. + CALL SUGMAS(G0,1,IMODEL) +C +100 RETURN + END diff --git a/ISAJET/isasusy/surg06.F b/ISAJET/isasusy/surg06.F new file mode 100644 index 00000000000..18b0a60e220 --- /dev/null +++ b/ISAJET/isasusy/surg06.F @@ -0,0 +1,155 @@ +#include "isajet/pilot.h" +C----------------------------------------------------------------- + SUBROUTINE SURG06(T,GY,F) +C----------------------------------------------------------------- +C +C Right hand side of truncated renormalization group equations +C dG_i/dT = F_i(G) +C using a single common scale MSUSY for SUSY mass thresholds. +C Added GY(7) for neutrino Yukawa coupling on 9/24/99 +C THIS INCLUDES TWO-LOOP YUKAWAS FOR MSSM ONLY 11/18/99 +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sslun.inc" +#include "isajet/sugpas.inc" + REAL T,GY(7),F(7) + REAL SINB,BETA,COSB,B1,THTOP,B3,B2,TH2LP,B12,B11,B21,B13, + $MT,TANB,PI,Q,B33,B23,B22,B32,B31 + REAL A11,A12,A13,A21,A22,A23,A31,A32,A33 + REAL C11,C12,C13,C21,C22,C23,C31,C32,C33 + REAL D11,D12,D13,D21,D22,D23,D31,D32,D33 + REAL C1,C2,C3,CP1,CP2,CP3,CPP1,CPP2,CPP3,BSY1,BSY2,BSY3 + INTEGER NSL,NSD,NSH,NSE,NSU,NSQ,NU,NSG,NSW,NH,NN,NE,ND +c DATA MZ/91.17/ + DATA ND/3/,NE/3/,NN/3/ + DATA B11/7.96/,B12/5.4/,B13/17.6/,B21/1.8/,B22/25./,B23/24./ + DATA B31/2.2/,B32/9./,B33/14./ + DATA A11/5.2/,A12/2.8/,A13/3.6/,A21/6./,A22/6./,A23/2./ + DATA A31/4./,A32/4./,A33/0./ + DATA C11/1.7/,C12/.5/,C13/1.5/,C21/1.5/,C22/1.5/,C23/.5/ + DATA C31/2./,C32/2./,C33/0./ + DATA D11/3.98/,D12/2.7/,D13/8.8/,D21/.9/,D22/5.833/,D23/12./ + DATA D31/1.1/,D32/4.5/,D33/-26./ + DATA C1/.8666667/,C2/3./,C3/5.333333/ + DATA CP1/.4666667/,CP2/3./,CP3/5.333333/ + DATA CPP1/1.8/,CPP2/3./,CPP3/0./ + DATA BSY1/6.6/,BSY2/1./,BSY3/-3./ + TANB=XTANB + MT=AMT +C-----THESE ARE VALID FROM MZ TO MGUT + Q=MGUT*EXP(T) + PI=4.*ATAN(1.) + BETA=ATAN(TANB) + SINB=SIN(BETA) + COSB=SQRT(1.-SINB**2) + IF (Q.GT.MSUSY) THEN + NSQ=3 + NSU=3 + NSD=3 + NSL=3 + NSE=3 + NSH=2 + NSW=1 + NSG=1 + NH=2 + TH2LP=1. + ELSE + NSQ=0 + NSU=0 + NSD=0 + NSL=0 + NSE=0 + NSH=0 + NSW=0 + NSG=0 + NH=1 + TH2LP=0. + END IF + IF (Q.GT.MT) THEN + NU=3 + THTOP=1. + ELSE + NU=2 + THTOP=0. + END IF + TH2LP=1. + THTOP=1. + B1=2.*(17*NU/12.+5*ND/12.+5*NE/4.+NN/4.)/5.+ + $ NSQ/30.+4*NSU/15.+NSD/15.+NSL/10.+NSE/5.+ + $ 1.*NSH/5.+1.*NH/10. + B2=-22./3.+.5*(NU+ND)+1.*(NE+NN)/6.+ + $ 1.*NSQ/2.+1.*NSL/6.+1.*NSH/3.+1.*NH/6.+4.*NSW/3. + B3=2.*(NU+ND)/3.+1.*NSQ/3.+1.*NSU/6.+1.*NSD/6.+2.*NSG-11. + IF (Q.GT.MSUSY) THEN + F(1)=GY(1)/16./PI**2*(B1*GY(1)**2+TH2LP/16./PI**2*GY(1)**2* + $(B11*GY(1)**2+B12*GY(2)**2+B13*GY(3)**2-A11*GY(6)**2-A12*GY(5)**2 + $-A13*GY(4)**2)) + F(2)=GY(2)/16./PI**2*(B2*GY(2)**2+TH2LP/16./PI**2*GY(2)**2* + $(B21*GY(1)**2+B22*GY(2)**2+B23*GY(3)**2-A21*GY(6)**2-A22*GY(5)**2 + $-A23*GY(4)**2)) + F(3)=GY(3)/16./PI**2*(B3*GY(3)**2+TH2LP/16./PI**2*GY(3)**2* + $(B31*GY(1)**2+B32*GY(2)**2+B33*GY(3)**2-A31*GY(6)**2-A32*GY(5)**2 + $-A33*GY(4)**2)) + ELSE + F(1)=GY(1)/16./PI**2*(B1*GY(1)**2+TH2LP/16./PI**2*GY(1)**2* + $(D11*GY(1)**2+D12*GY(2)**2+D13*GY(3)**2-C11*GY(6)**2-C12*GY(5)**2 + $-C13*GY(4)**2)) + F(2)=GY(2)/16./PI**2*(B2*GY(2)**2+TH2LP/16./PI**2*GY(2)**2* + $(D21*GY(1)**2+D22*GY(2)**2+D23*GY(3)**2-C21*GY(6)**2-C22*GY(5)**2 + $-C23*GY(4)**2)) + F(3)=GY(3)/16./PI**2*(B3*GY(3)**2+TH2LP/16./PI**2*GY(3)**2* + $(D31*GY(1)**2+D32*GY(2)**2+D33*GY(3)**2-C31*GY(6)**2-C32*GY(5)**2 + $-C33*GY(4)**2)) + ENDIF + IF (Q.LT.MSUSY) THEN + F(4)=GY(4)/16./PI**2*(5*GY(4)**2*COSB**2/2.+3*GY(6)**2*SINB**2* + $ THTOP+3*GY(5)**2*COSB**2-9*GY(1)**2/4.-9*GY(2)**2/4. + $ -SINB**2*(3*GY(6)**2*THTOP-3*GY(5)**2-GY(4)**2)) + F(5)=GY(5)/16./PI**2*(9*GY(5)**2*COSB**2/2.+3*GY(6)**2*SINB**2* + $ THTOP/2.+GY(4)**2*COSB**2-GY(1)**2/4.-9*GY(2)**2/4. + $ -8*GY(3)**2-SINB**2*(3*GY(6)**2*THTOP-3*GY(5)**2-GY(4)**2)) + F(6)=GY(6)/16./PI**2*(9*GY(6)**2*SINB**2/2.*THTOP+ + $ 3*GY(5)**2*COSB**2/2.+GY(4)**2*COSB**2-17.*GY(1)**2/20. + $ -9*GY(2)**2/4.-8*GY(3)**2+COSB**2* + $ (3*GY(6)**2*THTOP-3*GY(5)**2-GY(4)**2)) + ELSE + F(4)=GY(4)/16./PI**2*(4*GY(4)**2+3*GY(5)**2+GY(7)**2- + $ 9*GY(1)**2/5.-3*GY(2)**2+ + $ TH2LP/16./PI**2*((CPP1*BSY1+CPP1**2/2.)*GY(1)**4+ + $ (CPP2*BSY2+CPP2**2/2.)*GY(2)**4+(CPP3*BSY3+CPP3**2/2.)* + $ GY(3)**4+9*GY(1)**2*GY(2)**2/5.+ + $ GY(5)**2*(-.4*GY(1)**2+16*GY(3)**2)+ + $ GY(4)**2*(1.2*GY(1)**2+6*GY(2)**2)- + $ (3*GY(6)**2*GY(5)**2+9*GY(5)**4+9*GY(5)**2*GY(4)**2+ + $ 10*GY(4)**4))) + F(5)=GY(5)/16./PI**2*(6*GY(5)**2+GY(6)**2*THTOP+ + $ GY(4)**2-7*GY(1)**2/15.-3*GY(2)**2-16*GY(3)**2/3.+ + $ TH2LP/16./PI**2*((CP1*BSY1+CP1**2/2.)*GY(1)**4+ + $ (CP2*BSY2+CP2**2/2.)*GY(2)**4+(CP3*BSY3+CP3**2/2.)* + $ GY(3)**4+GY(1)**2*GY(2)**2+8*GY(1)**2*GY(3)**2/9.+ + $ 8*GY(2)**2*GY(3)**2+.8*GY(6)**2*GY(1)**2+ + $ GY(5)**2*(.4*GY(1)**2+6*GY(2)**2+16*GY(3)**2)+ + $ 1.2*GY(4)**2*GY(1)**2- + $ (22*GY(5)**4+5*GY(6)**2*GY(5)**2+3*GY(5)**2*GY(4)**2+ + $ 3*GY(4)**4+5*GY(6)**4))) + F(6)=GY(6)/16./PI**2*(6*GY(6)**2*THTOP+GY(5)**2+GY(7)**2- + $ 13*GY(1)**2/15.-3*GY(2)**2-16*GY(3)**2/3.+ + $ TH2LP/16./PI**2*((C1*BSY1+C1**2/2.)*GY(1)**4+ + $ (C2*BSY2+C2**2/2.)*GY(2)**4+(C3*BSY3+C3**2/2.)* + $ GY(3)**4+GY(1)**2*GY(2)**2+136*GY(1)**2*GY(3)**2/45.+ + $ 8*GY(2)**2*GY(3)**2+GY(6)**2*(1.2*GY(1)**2+6*GY(2)**2+ + $ 16*GY(3)**2)+.4*GY(5)**2*GY(1)**2- + $ (22*GY(6)**4+5*GY(6)**2*GY(5)**2+5*GY(5)**4+ + $ GY(5)**2*GY(4)**2))) + END IF +C THE NEUTRINO YUKAWA IS TO 1-LOOP ONLY FOR NOW... + IF (Q.GT.AMNRMJ) THEN + F(7)=GY(7)/16./PI**2*(3*GY(6)**2+GY(4)**2+4*GY(7)**2- + $ 3*GY(2)**2-3*GY(1)**2/5.) + ELSE + F(7)=0. + END IF + RETURN + END diff --git a/ISAJET/isasusy/surg26.F b/ISAJET/isasusy/surg26.F new file mode 100644 index 00000000000..13735219e63 --- /dev/null +++ b/ISAJET/isasusy/surg26.F @@ -0,0 +1,449 @@ +#include "isajet/pilot.h" +C----------------------------------------------------------------- + SUBROUTINE SURG26(T,G,F) +C----------------------------------------------------------------- +C +C Right hand side of full renormalization group equations +C dG_i/dT = F_i(G) +C using the thresholds MSS for each mass calculated with the +C couplings G0 frozen by SUGFRZ. +C Added right neutrino RGE's on 9/24/99 +C Upgrade to 2-loop RGE's for MSSM on 2/11/00 +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/sslun.inc" +#include "isajet/sugmg.inc" +#include "isajet/sugpas.inc" + REAL T,G(29),F(29) + REAL FAC,COSB,TH2LP,B3,B2,XTAU,XT,XB,B1,THTOP,B12,B11,TANB,MT, + $Q,B33,B32,PI,SINB,BETA,B21,B13,B22,B31,B23,XN,SMV,SPMV + REAL A11,A12,A13,A21,A22,A23,A31,A32,A33,A14,A24 + REAL C11,C12,C13,C21,C22,C23,C31,C32,C33 + REAL D11,D12,D13,D21,D22,D23,D31,D32,D33 + REAL C1,C2,C3,CP1,CP2,CP3,CPP1,CPP2,CPP3,BSY1,BSY2,BSY3 + REAL BY4,BY5,BY6,SIG1,SIG2,SIG3 + REAL G72LP,G82LP,G92LP,FAC2LP,G102lP,G112lP,G122lP + REAL G132LP,G142LP,G152LP,G162LP,G172LP,G182LP,G192LP,G262LP + REAL G202LP,G212LP,G222LP,G232LP,G242LP,G252LP,G292LP,G282LP + INTEGER THHL,THHH,THSHL,THSHH,THQ,THU,THD,THL,THE + INTEGER TH1,TH2,TH3 + INTEGER NSL,NSD,NSE,NSW,NSH,NSU,NSQ,NH,NSG,NU,NE,ND,NN +C + DATA ND/3/,NE/3/,NN/3/ + DATA B11/7.96/,B12/5.4/,B13/17.6/,B21/1.8/,B22/25./,B23/24./ + DATA B31/2.2/,B32/9./,B33/14./ + DATA A11/5.2/,A12/2.8/,A13/3.6/,A21/6./,A22/6./,A23/2./ + DATA A31/4./,A32/4./,A33/0./,A14/1.2/,A24/2./ + DATA C11/1.7/,C12/.5/,C13/1.5/,C21/1.5/,C22/1.5/,C23/.5/ + DATA C31/2./,C32/2./,C33/0./ + DATA D11/3.98/,D12/2.7/,D13/8.8/,D21/.9/,D22/5.833/,D23/12./ + DATA D31/1.1/,D32/4.5/,D33/-26./ + DATA C1/.8666667/,C2/3./,C3/5.333333/ + DATA CP1/.4666667/,CP2/3./,CP3/5.333333/ + DATA CPP1/1.8/,CPP2/3./,CPP3/0./ + DATA BSY1/6.6/,BSY2/1./,BSY3/-3./ +C +C-----THESE ARE VALID FROM MZ TO MGUT -------------------------------- + PI=4.*ATAN(1.) + TANB=XTANB + MT=AMT + Q=MGUT*EXP(T) + BETA=ATAN(TANB) + SINB=SIN(BETA) + COSB=SQRT(1.-SINB**2) + FAC=2./16./PI**2 +C-----CALCULATE 1-LOOP THRESHOLD EFFECTS ----------------------------- + IF (Q.GT.MSUSY) THEN + TH2LP=1. + ELSE + TH2LP=0. + END IF + IF (Q.GT.MSS(2)) THEN + NSQ=3 + NSU=3 + NSD=3 + ELSE + NSQ=0 + NSU=0 + NSD=0 + END IF + IF (Q.GT.MSS(17)) THEN + NSL=3 + NSE=3 + ELSE + NSL=0 + NSE=0 + END IF + IF (Q.GT.ABS(MU)) THEN + NSH=2 + ELSE + NSH=0 + END IF + IF (Q.GT.ABS(MSS(27))) THEN + NSW=1 + ELSE + NSW=0 + END IF + IF (Q.GT.MSS(1)) THEN + NSG=1 + ELSE + NSG=0 + END IF + IF (Q.GT.MSS(31)) THEN + NH=2 + ELSE + NH=1 + END IF + IF (Q.GT.GSS(7)) THEN + TH1=1 + ELSE + TH1=0 + END IF + IF (Q.GT.GSS(8)) THEN + TH2=1 + ELSE + TH2=0 + END IF + IF (Q.GT.MT) THEN + NU=3 + THTOP=1. + ELSE + NU=2 + THTOP=0. + END IF + TH2LP=1. + THTOP=1. + THHL=1 + THHH=NH/2 + THSHL=NSH/2 + THSHH=NSH/2 + THQ=NSQ/3 + THU=NSQ/3 + THD=NSQ/3 + THL=NSL/3 + THE=NSE/3 + TH3=NSG + B1=2.*(17*NU/12.+5*ND/12.+5*NE/4.+NN/4.)/5.+ + $ NSQ/30.+4*NSU/15.+NSD/15.+NSL/10.+NSE/5.+ + $ 1.*NSH/5.+1.*NH/10. + B2=-22./3.+.5*(NU+ND)+1.*(NE+NN)/6.+ + $ 1.*NSQ/2.+1.*NSL/6.+1.*NSH/3.+1.*NH/6.+4.*NSW/3. + B3=2.*(NU+ND)/3.+1.*NSQ/3.+1.*NSU/6.+1.*NSD/6.+2.*NSG-11. + IF (Q.GT.MSUSY) THEN + F(1)=G(1)/16./PI**2*(B1*G(1)**2+TH2LP/16./PI**2*G(1)**2* + $(B11*G(1)**2+B12*G(2)**2+B13*G(3)**2-A11*G(6)**2-A12*G(5)**2 + $-A13*G(4)**2-A14*G(27)**2)) + F(2)=G(2)/16./PI**2*(B2*G(2)**2+TH2LP/16./PI**2*G(2)**2* + $(B21*G(1)**2+B22*G(2)**2+B23*G(3)**2-A21*G(6)**2-A22*G(5)**2 + $-A23*G(4)**2-A24*G(27)**2)) + F(3)=G(3)/16./PI**2*(B3*G(3)**2+TH2LP/16./PI**2*G(3)**2* + $(B31*G(1)**2+B32*G(2)**2+B33*G(3)**2-A31*G(6)**2-A32*G(5)**2 + $-A33*G(4)**2)) + ELSE + F(1)=G(1)/16./PI**2*(B1*G(1)**2+TH2LP/16./PI**2*G(1)**2* + $(D11*G(1)**2+D12*G(2)**2+D13*G(3)**2-C11*G(6)**2-C12*G(5)**2 + $-C13*G(4)**2)) + F(2)=G(2)/16./PI**2*(B2*G(2)**2+TH2LP/16./PI**2*G(2)**2* + $(D21*G(1)**2+D22*G(2)**2+D23*G(3)**2-C21*G(6)**2-C22*G(5)**2 + $-C23*G(4)**2)) + F(3)=G(3)/16./PI**2*(B3*G(3)**2+TH2LP/16./PI**2*G(3)**2* + $(D31*G(1)**2+D32*G(2)**2+D33*G(3)**2-C31*G(6)**2-C32*G(5)**2 + $-C33*G(4)**2)) + ENDIF + IF (Q.LT.MSUSY) THEN + F(4)=G(4)/16./PI**2*(5*G(4)**2*COSB**2/2.+3*G(6)**2*SINB**2* + $ THTOP+3*G(5)**2*COSB**2-9*G(1)**2/4.-9*G(2)**2/4. + $ -SINB**2*(3*G(6)**2*THTOP-3*G(5)**2-G(4)**2)) + F(5)=G(5)/16./PI**2*(9*G(5)**2*COSB**2/2.+3*G(6)**2*SINB**2* + $ THTOP/2.+G(4)**2*COSB**2-G(1)**2/4.-9*G(2)**2/4. + $ -8*G(3)**2-SINB**2*(3*G(6)**2*THTOP-3*G(5)**2-G(4)**2)) + F(6)=G(6)/16./PI**2*(9*G(6)**2*SINB**2/2.*THTOP+ + $ 3*G(5)**2*COSB**2/2.+G(4)**2*COSB**2-17.*G(1)**2/20. + $ -9*G(2)**2/4.-8*G(3)**2+COSB**2* + $ (3*G(6)**2*THTOP-3*G(5)**2-G(4)**2)) + ELSE +C BY4=4*G(4)**2+3*G(5)**2-9*G(1)**2/5.-3*G(2)**2+G(27)**2 +C BY5=6*G(5)**2+G(6)**2*THTOP+G(4)**2-7*G(1)**2/15.-3*G(2)**2- +C $16*G(3)**2/3.+ +C BY6=6*G(6)**2*THTOP+G(5)**2-13*G(1)**2/15.-3*G(2)**2- +C $16*G(3)**2/3.+G(27)**2 + BY4=2.5*(COSB**2*THHL+SINB**2*THHH)*G(4)**2+ + $1.5*(COSB**2*THSHL+SINB**2*THSHH)*G(4)**2+ + $3*SINB**2*(THHL-THHH)*G(6)**2+3*(COSB**2*THHL+SINB**2*THHH)* + $G(5)**2- + $(3*G(1)**2/5.*(15./4.+3*THSHL/4.-TH1*(THL/4.+THE+THSHL/4.)) + $+G(2)**2*(9./4.+9*THSHL/4.-3*(THL+THSHL)*TH2/4.)) + BY4=BY4+G(27)**2 + BY5=4.5*(COSB**2*THHL+SINB**2*THHH)*G(5)**2+ + $1.5*(COSB**2*THSHL+SINB**2*THSHH)*G(5)**2+ + $.5*(SINB**2*THHL+COSB**2*THHH- + $4*SINB**2*(THHL-THHH))*G(6)**2+.5*(SINB**2*THSHL+COSB**2*THSHH)* + $G(6)**2+3*SINB**2*(THHL-THHH)*G(6)**2+ + $(COSB**2*THHL+SINB**2*THHH)*G(4)**2- + $(3*G(1)**2/5.*(5./12.+3*THSHL/4.-TH1*(THQ/36.+THD/9.+THSHL/4.)) + $+G(2)**2*(9./4.+9*THSHL/4.-3*(THQ+THSHL)*TH2/4.)+ + $G(3)**2*(8.-4*(THQ+THD)*TH3/3.)) + BY6=4.5*(SINB**2*THHL+COSB**2*THHH)*G(6)**2+ + $1.5*(SINB**2*THSHL+COSB**2*THSHH)*G(6)**2+ + $.5*(COSB**2*THHL+SINB**2*THHH- + $4*COSB**2*(THHL-THHH))*G(5)**2+.5*(COSB**2*THSHL+SINB**2*THSHH)* + $G(5)**2+COSB**2*(THHL-THHH)*(3*G(5)**2+G(4)**2)- + $(3*G(1)**2/5.*(17./12.+3*THSHL/4.-TH1*(THQ/36.+4*THU/9.+THSHL/4.)) + $+G(2)**2*(9./4.+9*THSHL/4.-3*(THQ+THSHL)*TH2/4.)+ + $G(3)**2*(8.-4*(THQ+THU)*TH3/3.)) + BY6=BY6+G(27)**2 + F(4)=G(4)/16./PI**2*(BY4+ + $ TH2LP/16./PI**2*((CPP1*BSY1+CPP1**2/2.)*G(1)**4+ + $ (CPP2*BSY2+CPP2**2/2.)*G(2)**4+(CPP3*BSY3+CPP3**2/2.)* + $ G(3)**4+9*G(1)**2*G(2)**2/5.+ + $ G(5)**2*(-.4*G(1)**2+16*G(3)**2)+ + $ G(4)**2*(1.2*G(1)**2+6*G(2)**2)- + $ (3*G(6)**2*G(5)**2+9*G(5)**4+9*G(5)**2*G(4)**2+ + $ 10*G(4)**4)-3*G(27)**4-3*G(27)**2*G(6)**2 + $ -3*G(27)**2*G(4)**2)) + F(5)=G(5)/16./PI**2*(BY5+ + $ TH2LP/16./PI**2*((CP1*BSY1+CP1**2/2.)*G(1)**4+ + $ (CP2*BSY2+CP2**2/2.)*G(2)**4+(CP3*BSY3+CP3**2/2.)* + $ G(3)**4+G(1)**2*G(2)**2+8*G(1)**2*G(3)**2/9.+ + $ 8*G(2)**2*G(3)**2+.8*G(6)**2*G(1)**2+ + $ G(5)**2*(.4*G(1)**2+6*G(2)**2+16*G(3)**2)+ + $ 1.2*G(4)**2*G(1)**2- + $ (22*G(5)**4+5*G(6)**2*G(5)**2+3*G(5)**2*G(4)**2+ + $ 3*G(4)**4+5*G(6)**4)-G(27)**2*G(6)**2-G(27)**2*G(4)**2)) + F(6)=G(6)/16./PI**2*(BY6+ + $ TH2LP/16./PI**2*((C1*BSY1+C1**2/2.)*G(1)**4+ + $ (C2*BSY2+C2**2/2.)*G(2)**4+(C3*BSY3+C3**2/2.)* + $ G(3)**4+G(1)**2*G(2)**2+136*G(1)**2*G(3)**2/45.+ + $ 8*G(2)**2*G(3)**2+G(6)**2*(1.2*G(1)**2+6*G(2)**2+ + $ 16*G(3)**2)+.4*G(5)**2*G(1)**2- + $ (22*G(6)**4+5*G(6)**2*G(5)**2+5*G(5)**4+ + $ G(5)**2*G(4)**2)-3*G(27)**4-3*G(27)**2*G(6)**2- + $ G(27)**2*G(4)**2)) + END IF + FAC2LP=(FAC/2.)**2 + G72LP=2*G(1)**2*(B11*G(1)**2*(G(7)+G(7))+ + $B12*G(2)**2*(G(7)+G(8))+B13*G(3)**2*(G(7)+G(9))+ + $A11*G(6)**2*(G(12)-G(7))+A12*G(5)**2*(G(11)-G(7))+ + $A13*G(4)**2*(G(10)-G(7))+A14*G(27)**2*(G(29)-G(7))) + G82LP=2*G(2)**2*(B21*G(1)**2*(G(7)+G(8))+ + $B22*G(2)**2*(G(8)+G(8))+B23*G(3)**2*(G(8)+G(9))+ + $A21*G(6)**2*(G(12)-G(8))+A22*G(5)**2*(G(11)-G(8))+ + $A23*G(4)**2*(G(10)-G(8))+A24*G(27)**2*(G(29)-G(8))) + G92LP=2*G(3)**2*(B31*G(1)**2*(G(9)+G(7))+ + $B32*G(2)**2*(G(9)+G(8))+B33*G(3)**2*(G(9)+G(9))+ + $A31*G(6)**2*(G(12)-G(9))+A32*G(5)**2*(G(11)-G(9))+ + $A33*G(4)**2*(G(10)-G(9))) + F(7)=FAC*B1*G(1)**2*G(7)+TH2LP*FAC2LP*G72LP + F(8)=FAC*B2*G(2)**2*G(8)+TH2LP*FAC2LP*G82LP + F(9)=FAC*B3*G(3)**2*G(9)+TH2LP*FAC2LP*G92LP + XTAU=G(21)+G(20)+G(13)+G(10)**2 + XB=G(24)+G(22)+G(13)+G(11)**2 + XT=G(24)+G(23)+G(14)+G(12)**2 + XN=G(21)+G(28)+G(14)+G(29)**2 + SMV=G(14)-G(13)+(2*G(19)+G(24))-(2*G(16)+G(21)) + $ -2*(2*G(18)+G(23))+(2*G(17)+G(22))+(2*G(15)+G(20)) + SPMV=-2*G(4)**2*G(20)+(6*G(1)**2*(2*G(15)+G(20)))/5.+ + $G(4)**2*(G(13)+G(21))-(3*(G(1)**2+5*G(2)**2)* + $(G(13)-G(14)+2*G(16)+G(21)))/10.-2*G(5)**2*G(22)+ + $(2*(G(1)**2+20*G(3)**2)*(2*G(17)+G(22)))/15.+ + $4*G(6)**2*G(23)-(16*(G(1)**2+5*G(3)**2)*(2*G(18)+G(23)))/15.+ + $G(5)**2*(3*G(13)-G(24))-G(6)**2*(3*G(14)+G(24))+ + $((G(1)**2+45*G(2)**2+80*G(3)**2)*(2*G(19)+G(24)))/30. + $+G(27)**2*(G(21)-G(14)) + SIG1=.2*G(1)**2*(3*(G(14)+G(13))+(2*G(19)+G(24))+ + $3*(2*G(16)+G(21))+8*(2*G(18)+G(23))+2*(2*G(17)+G(22))+ + $6*(2*G(15)+G(20))) + SIG2=G(2)**2*(G(14)+G(13)+3*(2*G(19)+G(24))+(2*G(16)+G(21))) + SIG3=G(3)**2*(2*(2*G(19)+G(24))+(2*G(18)+G(23))+ + $(2*G(17)+G(22))) +C + G102LP=(-54*G(1)**4-(18*G(1)**2*G(2)**2)/5.- + $(12*G(1)**2*G(4)**2)/5.+(4*G(1)**2*G(5)**2)/5.)*G(7)+ + $((-18*G(1)**2*G(2)**2)/5.-30*G(2)**4- + $12*G(2)**2*G(4)**2)*G(8)-32*G(3)**2*G(5)**2*G(9)+ + $(12*G(1)**2*G(4)**2*G(10))/5.+12*G(2)**2*G(4)**2*G(10)- + $40*G(4)**4*G(10)-36*G(5)**4*G(11)+G(5)**2* + $((-4*G(1)**2)/5.+32*G(3)**2-18*G(4)**2-6*G(6)**2)*G(11)+ + $G(5)**2*(-18*G(4)**2*G(10)-6*G(6)**2*G(12)) + $-6*G(27)**2*(G(12)*G(6)**2+G(10)*G(4)**2+G(29)* + $(G(6)**2+2*G(27)**2+G(4)**2)) + G112LP=((-574*G(1)**4)/45.-2*G(1)**2*G(2)**2- + $(16*G(1)**2*G(3)**2)/9.-(12*G(1)**2*G(4)**2)/5.- + $(4*G(1)**2*G(5)**2)/5.-(8*G(1)**2*G(6)**2)/5.)*G(7)+ + $(-2*G(1)**2*G(2)**2-30*G(2)**4-16*G(2)**2*G(3)**2- + $12*G(2)**2*G(5)**2)*G(8)+((-16*G(1)**2*G(3)**2)/9.- + $16*G(2)**2*G(3)**2+(64*G(3)**4)/9.- + $32*G(3)**2*G(5)**2)*G(9)+(12*G(1)**2*G(4)**2*G(10))/5.- + $12*G(4)**4*G(10)-88*G(5)**4*G(11)+G(5)**2*((4*G(1)**2)/5.+ + $12*G(2)**2+32*G(3)**2-6*G(4)**2-10*G(6)**2)*G(11)+ + $(8*G(1)**2*G(6)**2*G(12))/5.-20*G(6)**4*G(12)+ + $G(5)**2*(-6*G(4)**2*G(10)-10*G(6)**2*G(12)) + $-2*G(27)**2*(G(12)*G(6)**2+G(10)*G(4)**2+G(29)* + $(G(6)**2+G(4)**2)) + G122LP=((-5486*G(1)**4)/225.-2*G(1)**2*G(2)**2- + $(272*G(1)**2*G(3)**2)/45.-(4*G(1)**2*G(5)**2)/5.- + $(12*G(1)**2*G(6)**2)/5.)*G(7)+(-2*G(1)**2*G(2)**2- + $30*G(2)**4-16*G(2)**2*G(3)**2-12*G(2)**2*G(6)**2)*G(8)+ + $((-272*G(1)**2*G(3)**2)/45.-16*G(2)**2*G(3)**2+ + $(64*G(3)**4)/9.-32*G(3)**2*G(6)**2)*G(9)- + $2*G(4)**2*G(5)**2*G(10)+(4*G(1)**2*G(5)**2*G(11))/5.- + $2*G(4)**2*G(5)**2*G(11)-20*G(5)**4*G(11)- + $10*G(5)**2*G(6)**2*G(11)+((12*G(1)**2)/5.+12*G(2)**2+ + $32*G(3)**2-10*G(5)**2)*G(6)**2*G(12)-88*G(6)**4*G(12) + $-2*G(27)**2*(3*G(12)*G(6)**2+G(10)*G(4)**2+G(29)* + $(3*G(6)**2+6*G(27)**2+G(4)**2)) + G132LP=XB*((-4*G(1)**2)/5.+32*G(3)**2)*G(5)**2- + $(12*G(1)**2*G(4)**2*(-XTAU-2*G(7)**2+2*G(7)*G(10)))/5.- + $12*G(4)**4*(XTAU+G(10)**2)-36*G(5)**4*(XB+G(11)**2)+ + $G(5)**2*((8*G(1)**2*G(7)*(-G(7)+G(11)))/5.- + $64*G(3)**2*G(9)*(-G(9)+G(11)))-6*G(5)**2*G(6)**2* + $(XB+XT+2*G(11)*G(12))-1.2*G(1)**2*SPMV+33*G(2)**4*G(8)**2+ + $3.6*G(2)**2*G(1)**2*(G(8)**2+G(7)**2+G(7)*G(8))+ + $24.84*G(1)**4*G(7)**2+3*G(2)**2*SIG2+.6*G(1)**2*SIG1 + $-2*G(4)**2*G(27)**2*(2*G(29)*G(10)+XN+XTAU) + G142LP=XT*((8*G(1)**2)/5.+32*G(3)**2)*G(6)**2- + $6*G(5)**2*G(6)**2*(XB+XT+2*G(11)*G(12))- + $36*G(6)**4*(XT+G(12)**2)+G(6)**2*((-16*G(1)**2*G(7)* + $(-G(7)+G(12)))/5.-64*G(3)**2*G(9)*(-G(9)+G(12)))+ + $1.2*G(1)**2*SPMV+33*G(2)**4*G(8)**2+ + $3.6*G(2)**2*G(1)**2*(G(8)**2+G(7)**2+G(7)*G(8))+ + $24.84*G(1)**4*G(7)**2+3*G(2)**2*SIG2+.6*G(1)**2*SIG1 + $-12*G(27)**4*(G(29)**2+XN)-2*G(4)**2*G(27)**2* + $(2*G(29)*G(10)+XN+XTAU) + G152LP=2.4*G(1)**2*SPMV+112.32*G(1)**4*G(7)**2+2.4*G(1)**2*SIG1 + G162LP=-1.2*G(1)**2*SPMV+33*G(2)**4*G(8)**2+3.6*G(2)**2*G(1)**2* + $(G(8)**2+G(7)**2+G(8)*G(7))+24.84*G(1)**4*G(7)**2+ + $3*G(2)**2*SIG2+.6*G(1)**2*SIG1 + G172LP=.8*G(1)**2*SPMV-42.66667*G(3)**4*G(9)**2+ + $128*G(3)**2*G(1)**2*(G(9)**2+G(7)**2+G(7)*G(9))/45.+ + $808*G(1)**4*G(7)**2/75.+16*G(3)**2*SIG3/3.+4*G(1)**2*SIG1/15. + G182LP=-1.6*G(1)**2*SPMV-42.66667*G(3)**4*G(9)**2+ + $512*G(3)**2*G(1)**2*(G(9)**2+G(7)**2+G(7)*G(9))/45.+ + $3424*G(1)**4*G(7)**2/75.+16*G(3)**2*SIG3/3.+16*G(1)**2*SIG1/15. + G192LP=.4*G(1)**2*SPMV-128.*G(3)**4*G(9)**2/3.+ + $32*G(3)**2*G(2)**2*(G(9)**2+G(8)**2+G(9)*G(8))+ + $32*G(3)**2*G(1)**2*(G(9)**2+G(7)**2+G(9)*G(7))/45.+ + $33*G(2)**4*G(8)**2+ + $.4*G(2)**2*G(1)**2*(G(8)**2+G(7)**2+G(8)*G(7))+ + $199*G(1)**4*G(7)**2/75.+16*G(3)**2*SIG3/3.+ + $3*G(2)**2*SIG2+G(1)**2*SIG1/15. + G202LP=XTAU*((-12*G(1)**2)/5.+12*G(2)**2)*G(4)**2- + $16*G(4)**4*(XTAU+G(10)**2)+G(4)**2*((24*G(1)**2*G(7)* + $(-G(7)+G(10)))/5.-24*G(2)**2*G(8)*(-G(8)+G(10)))- + $12*G(4)**2*G(5)**2*(XB+XTAU+2*G(10)*G(11))+ + $2.4*G(1)**2*SPMV+112.32*G(1)**4*G(7)**2+2.4*G(1)**2*SIG1 + $-4*G(27)**2*G(4)**2*(2*G(29)*G(10)+XN+XTAU) + G212LP=(-12*G(1)**2*G(4)**2*(-XTAU-2*G(7)**2+2*G(7)*G(10)))/5.- + $12*G(4)**4*(XTAU+G(10)**2)-6*G(4)**2*G(5)**2* + $(XB+XTAU+2*G(10)*G(11)) + $-1.2*G(1)**2*SPMV+33*G(2)**4*G(8)**2+3.6*G(2)**2*G(1)**2* + $(G(8)**2+G(7)**2+G(8)*G(7))+24.84*G(1)**4*G(7)**2+ + $3*G(2)**2*SIG2+.6*G(1)**2*SIG1 + $-6*G(27)**2*(2*G(12)*G(29)*G(6)**2+G(6)**2*XT+ + $G(6)**2*XN+2*G(27)**2*(XN+G(29)**2)) + G222LP=XB*((4*G(1)**2)/5.+12*G(2)**2)*G(5)**2- + $4*G(4)**2*G(5)**2*(XB+XTAU+2*G(10)*G(11))-32*G(5)**4* + $(XB+G(11)**2)+G(5)**2*((-8*G(1)**2*G(7)*(-G(7)+G(11)))/5.- + $24*G(2)**2*G(8)*(-G(8)+G(11)))-4*G(5)**2*G(6)**2*(XB+XT+ + $2*G(11)*G(12))+.8*G(1)**2*SPMV-42.66667*G(3)**4*G(9)**2+ + $128*G(3)**2*G(1)**2*(G(9)**2+G(7)**2+G(7)*G(9))/45.+ + $808*G(1)**4*G(7)**2/75.+16*G(3)**2*SIG3/3.+4*G(1)**2*SIG1/15. + G232LP=XT*((-4*G(1)**2)/5.+12*G(2)**2)*G(6)**2- + $4*G(5)**2*G(6)**2*(XB+XT+2*G(11)*G(12))-32*G(6)**4* + $(XT+G(12)**2)+G(6)**2*((8*G(1)**2*G(7)*(-G(7)+G(12)))/5.- + $24*G(2)**2*G(8)*(-G(8)+G(12)))-1.6*G(1)**2*SPMV-42.66667* + $G(3)**4*G(9)**2+ + $512*G(3)**2*G(1)**2*(G(9)**2+G(7)**2+G(7)*G(9))/45.+ + $3424*G(1)**4*G(7)**2/75.+16*G(3)**2*SIG3/3.+16*G(1)**2*SIG1/15. + $-4*G(6)**2*G(27)**2*(2*G(12)*G(29)+XT+XN) + G242LP=(-4*G(1)**2*G(5)**2*(-XB-2*G(7)**2+2*G(7)*G(11)))/5.- + $2*G(4)**2*G(5)**2*(XB+XTAU+2*G(10)*G(11))-20*G(5)**4* + $(XB+G(11)**2)-(8*G(1)**2*G(6)**2*(-XT-2*G(7)**2+ + $2*G(7)*G(12)))/5.-20*G(6)**4*(XT+G(12)**2) + $+.4*G(1)**2*SPMV-128.*G(3)**4*G(9)**2/3.+ + $32*G(3)**2*G(2)**2*(G(9)**2+G(8)**2+G(9)*G(8))+ + $32*G(3)**2*G(1)**2*(G(9)**2+G(7)**2+G(9)*G(7))/45.+ + $33*G(2)**4*G(8)**2+ + $.4*G(2)**2*G(1)**2*(G(8)**2+G(7)**2+G(8)*G(7))+ + $199*G(1)**4*G(7)**2/75.+16*G(3)**2*SIG3/3.+ + $3*G(2)**2*SIG2+G(1)**2*SIG1/15. + $-2*G(6)**2*G(27)**2*(2*G(12)*G(29)+XT+XN) +C ADD IN MU 2-LOOP TERM SOMETIME... + G252LP=0. + G282LP=-16*G(27)**4*(G(29)**2+XN)-12*G(6)**2*G(27)**2* + $(2*G(12)*G(29)+XT+XN)-4*G(4)**2*G(27)**2*(2*G(29)*G(10)+ + $XN+XTAU)+G(27)**2*G(29)*(-24*G(7)*G(1)**2/5.-24*G(2)**2*G(8)) + $+G(27)**2*(2.4*G(1)**2*(2*G(7)**2+XN)+12*G(2)**2* + $(2*G(8)**2+XN)) + G292LP=-32*G(3)**2*G(6)**2*G(9)+(12*G(1)**2*G(4)**2*G(10))/5. + $-12*G(4)**4*G(10)-6*G(4)**2*G(5)**2*G(10)- + $6*G(4)**2*G(5)**2*G(11)-6*G(5)**2*G(6)**2*G(11)+ + $(8*G(1)**2*G(6)**2*G(12))/5.+32*G(3)**2*G(6)**2*G(12)- + $6*G(5)**2*G(6)**2*G(12)-36*G(6)**4*G(12)+ + $(-6*G(4)**2*G(10)-18*G(6)**2*G(12))*G(27)**2+ + $((12*G(1)**2)/5.+12*G(2)**2-6*G(4)**2- + $18*G(6)**2)*G(29)*G(27)**2-40*G(29)*G(27)**4+ + $G(7)*((-414*G(1)**4)/25.-(18*G(1)**2*G(2)**2)/5.- + $(12*G(1)**2*G(4)**2)/5.-(8*G(1)**2*G(6)**2)/5.- + $(12*G(1)**2*G(27)**2)/5.)+G(8)*((-18*G(1)**2*G(2)**2)/5.- + $30*G(2)**4-12*G(2)**2*G(27)**2) +C + F(10)=FAC*(9*G(1)**2*G(7)/5.+3*G(2)**2*G(8)+3*G(5)**2*G(11)+ + $4*G(4)**2*G(10)+G(27)**2*G(29))+FAC2LP*TH2LP*G102LP + F(11)=FAC*(7*G(1)**2*G(7)/15.+3*G(2)**2*G(8)+16*G(3)**2*G(9)/3.+ + $6*G(5)**2*G(11)+G(6)**2*G(12)+G(4)**2*G(10)) + $+FAC2LP*TH2LP*G112LP + F(12)=FAC*(13*G(1)**2*G(7)/15.+3*G(2)**2*G(8)+16*G(3)**2*G(9)/3.+ + $G(5)**2*G(11)+6*G(6)**2*G(12)+G(27)**2*G(29)) + $+FAC2LP*TH2LP*G122LP + F(13)=FAC*(-.6*G(1)**2*G(7)**2-3*G(2)**2*G(8)**2+ + $3*G(5)**2*XB+G(4)**2*XTAU-.3*G(1)**2*SMV)+FAC2LP*TH2LP*G132LP + F(14)=FAC*(-.6*G(1)**2*G(7)**2-3*G(2)**2*G(8)**2+3*G(6)**2*XT + $+G(27)**2*XN+.3*G(1)**2*SMV)+FAC2LP*TH2LP*G142LP + F(15)=FAC*(-2.4*G(1)**2*G(7)**2+.6*G(1)**2*SMV) + $+FAC2LP*TH2LP*G152LP + F(16)=FAC*(-.6*G(1)**2*G(7)**2-3*G(2)**2*G(8)**2-.3*G(1)**2*SMV) + $+FAC2LP*TH2LP*G162LP + F(17)=FAC*(-4*G(1)**2*G(7)**2/15.-16*G(3)**2*G(9)**2/3.+ + $.2*G(1)**2*SMV)+FAC2LP*TH2LP*G172LP + F(18)=FAC*(-16*G(1)**2*G(7)**2/15.-16*G(3)**2*G(9)**2/3.- + $.4*G(1)**2*SMV)+FAC2LP*TH2LP*G182LP + F(19)=FAC*(-G(1)**2*G(7)**2/15.-3*G(2)**2*G(8)**2- + $16*G(3)**2*G(9)**2/3.+.1*G(1)**2*SMV)+FAC2LP*TH2LP*G192LP + F(20)=FAC*(-2.4*G(1)**2*G(7)**2+2*G(4)**2*XTAU+.6*G(1)**2*SMV)+ + $FAC2LP*TH2LP*G202LP + F(21)=FAC*(-.6*G(1)**2*G(7)**2-3*G(2)**2*G(8)**2+G(4)**2*XTAU + $+G(27)**2*XN-.3*G(1)**2*SMV)+FAC2LP*TH2LP*G212LP + F(22)=FAC*(-4*G(1)**2*G(7)**2/15.-16*G(3)**2*G(9)**2/3.+ + $2*G(5)**2*XB+.2*G(1)**2*SMV)+FAC2LP*TH2LP*G222LP + F(23)=FAC*(-16*G(1)**2*G(7)**2/15.-16*G(3)**2*G(9)**2/3.+ + $2*G(6)**2*XT-.4*G(1)**2*SMV)+FAC2LP*TH2LP*G232LP + F(24)=FAC*(-G(1)**2*G(7)**2/15.-3*G(2)**2*G(8)**2- + $16*G(3)**2*G(9)**2/3.+G(6)**2*XT+G(5)**2*XB+.1*G(1)**2*SMV) + $+FAC2LP*TH2LP*G242LP + F(25)=FAC*G(25)/2.*(-.6*G(1)**2-3*G(2)**2+3*G(6)**2+ + $ 3*G(5)**2+G(4)**2+G(27)**2)+FAC2LP*TH2LP*G252LP + F(26)=FAC*(-.6*G(1)**2*G(7)-3*G(2)**2*G(8)+3*G(6)**2*G(12)+ + $ 3*G(5)**2*G(11)+G(4)**2*G(10)) + IF (Q.GT.AMNRMJ) THEN + F(27)=G(27)/16./PI**2*(3*G(6)**2+G(4)**2+4*G(27)**2- + $ 3*G(2)**2-3*G(1)**2/5.+TH2LP/16./PI**2*(-10*G(27)**4 + $ +G(27)**2*(1.2*G(1)**2+3*(2*G(2)**2-3*G(6)**2- + $ G(4)**2))+207*G(1)**4/50.+.2*G(1)**2*(9*G(2)**2+ + $ 4*G(6)**2+6*G(4)**2)+.5*(15*G(2)**4-18*G(6)**4- + $ 6*G(4)**4+32*G(3)**2*G(6)**2-6*G(5)**2*G(6)**2- + $ 6*G(5)**2*G(4)**2))) + F(28)=FAC*2*G(27)**2*XN+FAC2LP*TH2LP*G282LP + F(29)=FAC*(3*G(1)**2*G(7)/5.+3*G(2)**2*G(8)+3*G(6)**2*G(12)+ + $4*G(27)**2*G(29)+G(4)**2*G(10))+FAC2LP*TH2LP*G292LP + ELSE + F(27)=0. + F(28)=0. + F(29)=0. + END IF + RETURN + END + + + diff --git a/ISAJET/isatape/bufin.F b/ISAJET/isatape/bufin.F new file mode 100644 index 00000000000..43fbae87c62 --- /dev/null +++ b/ISAJET/isatape/bufin.F @@ -0,0 +1,57 @@ +#include "isajet/pilot.h" + SUBROUTINE BUFIN(IL,IFLAG) +C +C INVERSE OF BUFOUT. +C IF CDCPACK IS USED, READ INPUT RECORD INTO ZVOUT AND +C UNPACK EACH ZVOUT WORD INTO TWO ZEVEL WORDS BY CALL EXPAIR. +C OTHERWISE, READ ONE INPUT RECORD INTO ZEVEL. +C +#include "isajet/itapes.inc" +#include "isajet/ita.inc" +#include "isajet/zevel.inc" +#include "isajet/zvout.inc" + DIMENSION W(2),IW(2) + EQUIVALENCE(W(1),IW(1)) + DATA NPARR/0/ + 1 CONTINUE +#if defined(CERNLIB_CDCPACK) +C USE CDC BUFFER IN TO READ PACKED RECORD. + BUFFER IN(ITB,1) (ZVOUT(1),ZVOUT(512)) + IF(UNIT(ITB,ZVOUT(1),ZVOUT(512))) 300,200,100 +#endif +#if defined(CERNLIB_STDIO) +C STANDARD FORTRAN 77 READ. + CALL ZEROL(ZEVEL,MAXLEN) + READ(ITB,ERR=100,END=200) IZVL1,IZVL2,(ZEVEL(JJ),JJ=3,IZVL2) + GO TO 300 +#endif +C TAPE READ ERROR + 100 WRITE(ITLIS,10) ITB + NPARR=NPARR+1 + 10 FORMAT(1X,' TAPE READ ERROR ON TAPE',I3) + IFLAG=1 + IF(NPARR.LT.20) GOTO 1 +C END OF FILE + 200 IFLAG=-1 + RETURN +C GOOD RECORD + 300 IFLAG=0 +#if defined(CERNLIB_CDCPACK) +C USE CDC ASSEMBLY LANGUAGE ROUTINE EXPAIR TO UNPACK 1 ZVOUT +C WORDS INTO 2 ZEVEL WORDS. + WOUT=ZVOUT(1) + CALL EXPAIR(W(1),W(2),WOUT,IFL) + IZEVEL(1)=IW(1) + IZEVEL(2)=IW(2) + IL=IW(2) + NW=IL/2+MOD(IL,2) + DO 310 I=2,NW + WOUT=ZVOUT(I) + II=2*I-1 + CALL EXPAIR(W(1),W(2),WOUT,IFL) + CALL MOVLEV(W,IZEVEL(II),2) + 310 CONTINUE +#endif + IL=3 + RETURN + END diff --git a/ISAJET/isatape/bufout.F b/ISAJET/isatape/bufout.F new file mode 100644 index 00000000000..b53ae741e93 --- /dev/null +++ b/ISAJET/isatape/bufout.F @@ -0,0 +1,53 @@ +#include "isajet/pilot.h" + SUBROUTINE BUFOUT(IL) +C +C INVERSE OF BUFIN. +C IF CDCPACK IS USED, PACK TWO ZEVEL WORDS INTO EACH ZVOUT WORD +C BY CALL PAIRPAK AND BUFFER OUT ZVOUT ARRAY. +C OTHERWISE WRITE OUT ZEVEL. +C +C NRECS INCREMENTED BY 1 +C IL SET TO 3 + + +#include "isajet/itapes.inc" +#include "isajet/final.inc" +#include "isajet/idrun.inc" +#include "isajet/zevel.inc" +#include "isajet/zvout.inc" + DIMENSION W(2),IW(2) + EQUIVALENCE(W(1),IW(1)) +C THESE ARE NOW INITIALIZED IN BLOCK DATA + ITA=IABS(ITEVT) +#if defined(CERNLIB_CDCPACK) +C USE CDC ASSEMBLY LANGUAGE ROUTINE PAIRPAK TO PACK 2 ZEVEL +C WORDS INTO 1 ZVOUT WORD AND THEN CALL CDC BUFFER OUT. + IW(1)=IZEVEL(1) + IZEVEL(2)=IL + IW(2)=IL + CALL PAIRPAK(W(1),W(2),WOUT,IFL) + ZVOUT(1)=WOUT + NW=IL/2+MOD(IL,2) + DO 1 I=2,NW + II=2*I-1 + CALL MOVLEV(IZEVEL(II),W,2) + CALL PAIRPAK(W(1),W(2),WOUT,IFL) + ZVOUT(I)=WOUT + 1 CONTINUE + IL=3 + NRECS=NRECS+1 + BUFFER OUT(ITA,1) (ZVOUT(1),ZVOUT(NW)) + IF(UNIT(ITA,ZVOUT(1),ZVOUT(NW))) 10,10,11 +#endif +#if defined(CERNLIB_STDIO) +C STANDARD FORTRAN 77 WRITE. + IZEVEL(2)=IL + WRITE(ITA,ERR=11) (ZEVEL(I),I=1,IL) + IL=3 + NRECS=NRECS+1 +#endif + 10 RETURN + 11 WRITE(ITLIS,200) IEVT,IDG + 200 FORMAT(//' BAD WRITE, EVENT NO.',I10,5X,'EVENT ID',2I10) + RETURN + END diff --git a/ISAJET/isatape/edit.F b/ISAJET/isatape/edit.F new file mode 100644 index 00000000000..82f369c918d --- /dev/null +++ b/ISAJET/isatape/edit.F @@ -0,0 +1,8 @@ +#include "isajet/pilot.h" + LOGICAL FUNCTION EDIT(I) +C DUMMY ROUTINE FOR USER DEFINED LOGICAL FUNCTION +C EDIT=.TRUE. TO WRITE EVENT ON TAPE +C EDIT=.FALSE. TO SUPPRESS WRITING + EDIT=.TRUE. + RETURN + END diff --git a/ISAJET/isatape/isahep.F b/ISAJET/isatape/isahep.F new file mode 100644 index 00000000000..eb9c3e8b3b4 --- /dev/null +++ b/ISAJET/isatape/isahep.F @@ -0,0 +1,279 @@ +#include "isajet/pilot.h" + SUBROUTINE ISAHEP(MCONV) +C +C...Purpose: to convert ISAJET event record contents to or from +C...the standard event record common block. +C +C Thanks to Lynn Garren, Fermilab. +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/hepevt.inc" +C +C...for event number +#include "isajet/idrun.inc" +C...initial partons +#include "isajet/pjets.inc" +#include "isajet/primar.inc" +C...partons created during decay +#include "isajet/jetset.inc" +C...particles created in the decay, including final state particles +#include "isajet/partcl.inc" +C + INTEGER MCONV + INTEGER ITRANS + INTEGER I1,IHP,MPART,JET,NPOFF,NJHEP,NWHEP,IMO,IJT + INTEGER JPMO(2,MXJSET),JPDA(2,MXJSET),JMX(MXJSET),JMN(MXJSET) + INTEGER JTMO(2,MXPTCL),JTDA(2,MXPTCL) + INTEGER IP,IJ3,IJ2,IJ1,NSUM2,NSUM1,IPT,I,J,KST,KND,K +C +C +C...Conversion from ISAJET to standard +C + IF(MCONV.EQ.1) THEN + NEVHEP = IEVT +C...initial jets + NHEP = 0 +C... W or Z + IF(IDENTW.NE.0)THEN + NHEP = NHEP + 1 + ISTHEP(NHEP)=12 + JMOHEP(1,NHEP)=0 + JMOHEP(2,NHEP)=0 + JDAHEP(1,NHEP)= 2 + JDAHEP(2,NHEP)= NJET + 1 + IDHEP(NHEP) = ITRANS(IDENTW,1) + DO 100 J=1,5 + 100 PHEP(J,NHEP) = QWJET(J) + ENDIF + NWHEP = NHEP +C... jets + IF(NJET.GT.0)THEN + DO 120 I=1,NJET + NHEP = NHEP + 1 + ISTHEP(NHEP)=11 + JMOHEP(1,NHEP)=0 + IF(IDENTW.NE.0) JMOHEP(1,NHEP) = 1 + JMOHEP(2,NHEP)= I + JDAHEP(1,NHEP)=0 + JDAHEP(2,NHEP)=0 + IDHEP(NHEP) = ITRANS(IDJETS(I),1) + DO 110 J=1,5 + 110 PHEP(J,NHEP) = PJETS(J,I) + 120 CONTINUE + ENDIF + NJHEP = NHEP +C... pairs + IF(NPAIR.GT.0)THEN + DO 150 I=1,NPAIR + NHEP = NHEP + 1 + ISTHEP(NHEP)=13 + JMOHEP(1,NHEP)= JPAIR(I) + NWHEP + JMOHEP(2,NHEP)= JPAIR(I) + JDAHEP(1,NHEP)=0 + JDAHEP(2,NHEP)=0 + IDHEP(NHEP) = ITRANS(IDPAIR(I),1) + DO 140 J=1,5 + 140 PHEP(J,NHEP) = PPAIR(J,I) + 150 CONTINUE + ENDIF + DO 160 I=1,NHEP + DO 160 J=1,4 + 160 VHEP(J,I) = 0. +C...save offset into hep list + NPOFF = NHEP +C...partons + DO 200 I=1,NJSET + IHP = NHEP + I +C...use JMX and JMN to find daughters in hadron list + JMX(I) = 0 + JMN(I) = NHEP + NPTCL + 1 + IDHEP(IHP) = ITRANS(JTYPE(I),1) + MPART=MOD(JORIG(I),JPACK) + JMOHEP(1,IHP)=0 + IJT = JORIG(I)/JPACK + IF(MPART.NE.0)THEN + JMOHEP(1,IHP)=MPART+NHEP + ELSEIF(MPART.EQ.0 .AND. IJT.LT.10)THEN +C...find mother in jet/pair list + IMO = IJT + NWHEP + IF(NJHEP.LT.NPOFF)THEN + KST = NJHEP + 1 + DO 170 K=KST,NPOFF + IF(IDHEP(K).EQ.IDHEP(IHP)) IMO=K + 170 CONTINUE + ENDIF + JMOHEP(1,IHP)= IMO + IF(JDAHEP(1,IMO).EQ.0) JDAHEP(1,IMO)=IHP + JDAHEP(1,IMO) = MIN(IHP,JDAHEP(1,IMO)) + JDAHEP(2,IMO) = MAX(IHP,JDAHEP(2,IMO)) +C...amend information if a parton thinks this is it's daughter + KND = IHP-1 + DO 175 K=NPOFF,KND + IF(IHP.GE.JDAHEP(1,K) .AND. IHP.LE.JDAHEP(2,K)) + 1 JMOHEP(1,IHP)=K + 175 CONTINUE + ENDIF + JMOHEP(2,IHP)= IJT + IF(JDCAY(I).EQ.0)THEN + ISTHEP(IHP) = 21 + JDAHEP(1,IHP)=0 + JDAHEP(2,IHP)=0 + ELSE + ISTHEP(IHP) = 22 + JDAHEP(1,IHP) = JDCAY(I)/JPACK + NHEP + JDAHEP(2,IHP) = MOD(JDCAY(I),JPACK) + NHEP + ENDIF + DO 180 J=1,5 + 180 PHEP(J,IHP) = PJSET(J,I) + DO 190 J=1,4 + 190 VHEP(J,IHP) = 0. + 200 CONTINUE + NHEP = NHEP + NJSET +C...hadrons + DO 250 I=1,NPTCL + IHP = NHEP + I + IDHEP(IHP) = ITRANS(IDENT(I),1) + I1 = MOD(IABS(IORIG(I)),IPACK) + JMOHEP(1,IHP)=0 + JMOHEP(2,IHP)=IABS(IORIG(I))/IPACK +C...mother is pomeron + IF(I1.EQ.0)THEN +C...mother is in parton list + ELSEIF(IORIG(I).LT.0)THEN + JMOHEP(1,IHP) = I1 + NPOFF + JMN(I1) = MIN(JMN(I1),I) + JMX(I1) = MAX(JMX(I1),I) +C...mother is in hadron list + ELSEIF(IORIG(I).GT.0)THEN + JMOHEP(1,IHP) = I1 + NHEP + ENDIF + IF(IDCAY(I).EQ.0)THEN + ISTHEP(IHP) = 1 + JDAHEP(1,IHP)=0 + JDAHEP(2,IHP)=0 + ELSE + ISTHEP(IHP) = 2 + JDAHEP(1,IHP) = IDCAY(I)/IPACK + NHEP + JDAHEP(2,IHP) = MOD(IDCAY(I),IPACK) + NHEP + ENDIF + DO 210 J=1,5 + 210 PHEP(J,IHP) = PPTCL(J,I) + DO 220 J=1,4 + 220 VHEP(J,IHP) = 0. + 250 CONTINUE + NHEP = NHEP + NPTCL +C...fill in missing daughter info for partons + DO 270 I=1,NJSET + IF(JMX(I).NE.0)THEN + JDAHEP(1,I+NPOFF) = JMN(I) + NPOFF + NJSET + JDAHEP(2,I+NPOFF) = JMX(I) + NPOFF + NJSET + ENDIF + 270 CONTINUE +C +C...Conversion from standard to ISAJET +C + ELSEIF(MCONV.EQ.2)THEN + IEVT = NEVHEP +C... missing information + IDENTW = 0 + NPAIR = 0 + DO 330 I=1,5 + QWJET(I) = 0. + DO 330 J=1,4 + PPAIR(I,J) = 0. + 330 CONTINUE + DO 340 I=1,4 + IDPAIR(I) = 0 + 340 JPAIR(I) = 0 +C...zero counters + IJ1 = 0 + IJ2 = 0 + IJ3 = 0 + IP = 0 + IPT = 0 + DO 500 I=1,NHEP +C...initial jets +C... jets + IF(ISTHEP(I).EQ.11)THEN + IJ1 = IJ1 + 1 + IDJETS(IJ1) = ITRANS(IDHEP(I),2) + DO 410 J=1,5 + 410 PJETS(J,IJ1) = PHEP(J,I) +C... W + ELSEIF(ISTHEP(I).EQ.12)THEN + IJ2 = IJ2 + 1 + IDENTW = ITRANS(IDHEP(I),2) + DO 420 J=1,5 + 420 QWJET(J) = PHEP(J,I) +C... pairs + ELSEIF(ISTHEP(I).EQ.13)THEN + IJ3 = IJ3 + 1 + IDPAIR(IJ3) = ITRANS(IDHEP(I),2) + JPAIR(IJ3) = JMOHEP(2,I) + DO 430 J=1,5 + 430 PPAIR(J,IJ3) = PHEP(J,I) +C...partons + ELSEIF(ISTHEP(I).EQ.21 .OR. ISTHEP(I).EQ.22)THEN + IP = IP + 1 + JTYPE(IP) = ITRANS(IDHEP(I),2) + DO 440 J=1,5 + 440 PJSET(J,IP) = PHEP(J,I) +C... temporary storage until have counts + JPMO(1,IP) = JMOHEP(1,I) + JPMO(2,IP) = JMOHEP(2,I) + JPDA(1,IP) = JDAHEP(1,I) + JPDA(2,IP) = JDAHEP(2,I) +C...hadrons + ELSE + IPT = IPT + 1 + IDENT(IPT) = ITRANS(IDHEP(I),2) + DO 450 J=1,5 + 450 PPTCL(J,IPT) = PHEP(J,I) +C... temporary storage until have counts + JTMO(1,IPT) = JMOHEP(1,I) + JTMO(2,IPT) = JMOHEP(2,I) + JTDA(1,IPT) = JDAHEP(1,I) + JTDA(2,IPT) = JDAHEP(2,I) + ENDIF + 500 CONTINUE +C...completed counts + NJET = IJ1 + NPAIR = IJ3 + NJSET = IP + NPTCL = IPT +C...get mother/daughter information + NSUM1 = NJET + IJ2 + NPAIR + NSUM2 = NSUM1 + NJSET + DO 520 I=1,NJSET + IF(JPDA(1,I).EQ.0)THEN + JDCAY(I) = 0 + ELSEIF(JPDA(1,I).GT.NSUM2)THEN + JDCAY(I) = 0 + ELSE + JDCAY(I) = JPACK*(JPDA(1,I)-NSUM1) + JPDA(2,I)-NSUM1 + ENDIF + IF(JPMO(1,I).LE.NSUM1)THEN + JORIG(I) = JPACK*JPMO(2,I) + ELSE + JORIG(I) = JPACK*JPMO(2,I) + JPMO(1,I)-NSUM1 + ENDIF + 520 CONTINUE + DO 550 I=1,NPTCL + IF(JTDA(1,I).EQ.0)THEN + IDCAY(I) = 0 + ELSE + IDCAY(I) = IPACK*(JTDA(1,I)-NSUM2) + JTDA(2,I)-NSUM2 + ENDIF + IF(JTMO(1,I).LE.NSUM1)THEN + IORIG(I) = JTMO(2,I)*IPACK + 0 + ELSEIF(JTMO(1,I).LE.NSUM2)THEN + IORIG(I) = -(JTMO(2,I)*IPACK + JTMO(1,I)-NSUM1) + ELSE + IORIG(I) = JTMO(2,I)*IPACK + JTMO(1,I)-NSUM2 + ENDIF + 550 CONTINUE + ENDIF + RETURN + END diff --git a/ISAJET/isatape/isawbg.F b/ISAJET/isatape/isawbg.F new file mode 100644 index 00000000000..cee79cfa7ed --- /dev/null +++ b/ISAJET/isatape/isawbg.F @@ -0,0 +1,81 @@ +#include "isajet/pilot.h" + SUBROUTINE ISAWBG +C +C Write initial record (type 200) +C Inverse of RDBEG +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/dylim.inc" +#include "isajet/frgpar.inc" +#include "isajet/idrun.inc" +#include "isajet/jetlim.inc" +#include "isajet/keys.inc" +#include "isajet/primar.inc" +#include "isajet/qcdpar.inc" +#include "isajet/qlmass.inc" +#include "isajet/q1q2.inc" +#include "isajet/types.inc" +#include "isajet/xmssm.inc" +C +#include "isajet/zvout.inc" +#include "isajet/zevel.inc" +#include "isajet/final.inc" +C + INTEGER NL,IL,ITA +C +C Keep entry point WRBEG for backward compatibility + ENTRY WRBEG +C + ITA=IABS(ITEVT) + NKINF=0 + SIGF=0. + ALUM=0. + ACCEPT=0. + NRECS=0 +#if defined(CERNLIB_CDCPACK) + CALL ZEROL(ZVOUT,512) +#endif + CALL ZEROL(ZEVEL,MAXLEN) + IL=3 + CALL MOVLEI(IDVER,IZEVEL(IL),4) + IL=IL+4 + CALL MOVLEI(NJET,IZEVEL(IL),7) + IL=IL+7 + NL=NJET*MXGOQ + IF(NJET.NE.0) CALL MOVLEL(GOQ(1,1),LZEVEL(IL),NL) + IL=IL+NL + CALL MOVLEL(KEYS(1),LZEVEL(IL),10) + IL=IL+10 + CALL MOVLEV(PMIN(1),ZEVEL(IL),36) + IL=IL+36 + IF(.NOT.KEYS(3)) GOTO 11 + CALL MOVLEV(QMIN,ZEVEL(IL),12) + IL=IL+12 + 11 CONTINUE + CALL MOVLEL(GODY(1),LZEVEL(IL),5) + IL=IL+5 + CALL MOVLEV(PUD,ZEVEL(IL),22) + IL=IL+22 + CALL MOVLEV(ALAM,ZEVEL(IL),4) + IL=IL+4 + CALL MOVLEV(AMLEP(6),ZEVEL(IL),3) + IL=IL+3 + CALL MOVLEI(LOC(1),IZEVEL(IL),100) + IL=IL+100 + CALL MOVLEL(GOMSSM,LZEVEL(IL),1) + IL=IL+1 + CALL MOVLEV(XGLSS,ZEVEL(IL),11) + IL=IL+11 + CALL MOVLEL(GOSUG,LZEVEL(IL),1) + IL=IL+1 + CALL MOVLEV(XM0SU,ZEVEL(IL),5) + IL=IL+5 +C + IZEVEL(1)=200 + IZEVEL(2)=1 + CALL BUFOUT(IL) + RETURN + END diff --git a/ISAJET/isatape/isawev.F b/ISAJET/isatape/isawev.F new file mode 100644 index 00000000000..05361cf136a --- /dev/null +++ b/ISAJET/isatape/isawev.F @@ -0,0 +1,13 @@ +#include "isajet/pilot.h" + SUBROUTINE ISAWEV +C +C WRITE OUT MONTECARLO DATA IF EDIT IS TRUE +C + LOGICAL EDIT +C +C keep entry point WRTAPE for backward compatibility + ENTRY WRTAPE + IF(.NOT.EDIT(I)) RETURN + CALL WGENS + RETURN + END diff --git a/ISAJET/isatape/isawnd.F b/ISAJET/isatape/isawnd.F new file mode 100644 index 00000000000..85275742701 --- /dev/null +++ b/ISAJET/isatape/isawnd.F @@ -0,0 +1,31 @@ +#include "isajet/pilot.h" + SUBROUTINE ISAWND +C +C WRITE END RECORD, TYPE 300 +C CONTAINS CROSS SECTIONS AND LUMINOSITY +C +#include "isajet/itapes.inc" +#include "isajet/final.inc" +#include "isajet/totals.inc" +#include "isajet/zevel.inc" +#include "isajet/jetlim.inc" +#include "isajet/dylim.inc" +#include "isajet/keys.inc" +C +C keep entry point WREND for backward compatibility + ENTRY WREND + ITA=IABS(ITEVT) + IZEVEL(1)=300 + IZEVEL(2)=1 + IZEVEL(3)=NKINF + ZEVEL(4)=SIGF + ZEVEL(5)=ALUM + ZEVEL(6)=ACCEPT + IZEVEL(7)=NRECS + IL=7 + CALL BUFOUT(IL) + WRITE(ITLIS,1010) NRECS,ITA +1010 FORMAT(////' THIS RUN WROTE',I10, + 1' PHYSICAL RECORDS ON TAPE',I3) + RETURN + END diff --git a/ISAJET/isatape/itrans.F b/ISAJET/isatape/itrans.F new file mode 100644 index 00000000000..94eefcdae24 --- /dev/null +++ b/ISAJET/isatape/itrans.F @@ -0,0 +1,212 @@ +#include "isajet/pilot.h" + INTEGER FUNCTION ITRANS(ID,MCONV) +C +C...convert (MCONV=1) from ISAJET numbering to PDG numbering +C... or (MCONV=2) from PDG numbering to ISAJET numbering +C... +C...Ver 7.21: add extra mesons with IABS(ID) > 10000; these only occur +C... in a few B decays. +C +C...Thanks to Lynn Garren, Fermilab. +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +C + INTEGER ID,MCONV + INTEGER I2,I3,J,IDA,IF1,IF2,IND,ITMP,IF3,JS,J1,IS1,IS2,IS3,I4,I1 +C +C... ITABI(I) converts miscellaneous ISAJET particle ID's to standard +C... scheme + INTEGER ITABI(99,2), NOANT(15) + SAVE ITABI,NOANT + DATA ITABI/2,1,3,4,5,6,7,8,21,22, + 1 12,11,14,13,16,15,0,0,0,310, + 2 42,41,43,44,45,46,0,0,47,67, + 3 52,51,54,53,56,55,0,0,77,68, + 4 62,61,63,64,65,66,0,0,78,69, + 5 72,71,74,73,76,75,0,0,0,70, + 6 0,0,0,0,0,0,0,0,0,0, + 7 0,0,0,0,0,0,0,0,0,24, + 8 25,57,58,59,40,33,37,34,38,23, + 9 0,0,0,0,0,0,0,0,0, + * 2,1,3,4,5,6,7,8,0,0, + 1 12,11,14,13,16,15,0,0,0,0, + 2 9,10,90,80,81,0,0,0,0,0, + 3 0,82,86,88,0,83,87,89,84,85, + 4 22,21,23,24,25,26,29,0,0,0, + 5 32,31,34,33,36,35,82,83,84,0, + 6 42,41,43,44,45,46,30,40,50,60, + 7 52,51,54,53,56,55,39,49,0,0, + 8 0,0,0,0,0,0,0,0,0,0, + 9 0,0,0,0,0,0,0,0,0/ + DATA NOANT/-21,-22,-23,-25,-30,-35,-47,-48,-57,-58,-59, + 1 -67,-68,-69,-70/ +C + IDA=IABS(ID) + ITRANS=0 + IF(MCONV.NE.1) GO TO 200 +C...ISAJET algorithm routine + CALL FLAVOR(ID,IF1,IF2,IF3,JS,IND) + IF(IDA.EQ.0) THEN + WRITE(ITLIS,*) ' ITRANS: particle ID is zero' + ELSEIF(IDA.LT.100) THEN + ITRANS=ISIGN(ITABI(IDA,1),ID) + IF(ID.EQ.-20) ITRANS=130 +C...check for illegal antiparticles + ITMP=ITRANS + IF(ITMP.LT.0) THEN + DO 101 J=1,15 + IF(ITMP.EQ.NOANT(J)) ITRANS=0 + 101 CONTINUE + ENDIF + ELSEIF(IND.NE.0.AND.IDA.LT.10000) THEN + IS1=IABS(IF1) + IS2=IABS(IF2) + IS3=IABS(IF3) +C...mesons + IF(IS1.EQ.0) THEN + IF(IS2.LE.2 .AND. IS3.LE.2) THEN +C... don't change + ELSE +C... u and d have opposite definitions + IF(IS2.LE.2) IS2=ITABI(IS2,1) + IF(IS3.LE.2) IS3=ITABI(IS3,1) + ENDIF + ITRANS=IS3*100 + IS2*10 + 2*JS+1 + ITRANS=ISIGN(ITRANS,ID) +C... charmed and top mesons have wrong sign + IF(IS3.EQ.4 .AND. IS2.NE.4) ITRANS=-ITRANS + IF(IS3.EQ.6 .AND. IS2.NE.6 .AND. IS2.NE.4) ITRANS=-ITRANS +C...check for illegal antiparticles + IF(IS2.EQ.IS3 .AND. ID.LT.0) ITRANS=0 +C...diquarks + ELSEIF(IS3.EQ.0) THEN +C... u and d have opposite definitions + IF(IS1.LE.2) IS1=ITABI(IS1,1) + IF(IS2.LE.2) IS2=ITABI(IS2,1) + IF(IS2.LT.IS1) THEN + ITRANS=IS1*1000 + IS2*100 + 2*JS+1 + ELSE + ITRANS=IS2*1000 + IS1*100 + 2*JS+1 + ENDIF + ITRANS=ISIGN(ITRANS,ID) +C... charmed and top mesons have wrong sign + IF(IS2.EQ.4 .AND. IS1.NE.4) ITRANS=-ITRANS + IF(IS2.EQ.6 .AND. IS1.NE.6 .AND. IS1.NE.4) ITRANS=-ITRANS +C...baryons + ELSE +C... u and d have opposite definitions + IF(IS1.LE.2) IS1=ITABI(IS1,1) + IF(IS2.LE.2) IS2=ITABI(IS2,1) + IF(IS3.LE.2) IS3=ITABI(IS3,1) + IF(IS3.LE.2) THEN + ITRANS=IS1*1000 + IS2*100 + IS3*10 + 2*JS+2 + ELSEIF(IS1.LE.2 .AND. IS2.LE.2) THEN + ITRANS=IS3*1000 + IS1*100 + IS2*10 + 2*JS+2 + ELSE + ITRANS=IS3*1000 + IS2*100 + IS1*10 + 2*JS+2 + ENDIF + ITRANS=ISIGN(ITRANS,ID) + ENDIF + ELSEIF(IND.GT.0.AND.IDA.GT.10000) THEN +C...Special mesons. + IF(ID.EQ.10121) THEN + ITRANS=20213 + ELSEIF(ID.EQ.10111) THEN + ITRANS=20113 + ELSEIF(ID.EQ.10131) THEN + ITRANS=10323 + ELSEIF(ID.EQ.10231) THEN + ITRANS=10313 + ELSEIF(ID.EQ.30131) THEN + ITRANS=30323 + ELSEIF(ID.EQ.30231) THEN + ITRANS=30313 + ELSEIF(ID.EQ.10110) THEN + ITRANS=10221 + ELSEIF(ID.EQ.10441) THEN + ITRANS=20443 + ELSEIF(ID.EQ.20440) THEN + ITRANS=10441 + ELSEIF(ID.EQ.20441) THEN + ITRANS=10443 + ELSEIF(ID.EQ.20442) THEN + ITRANS=445 + ELSE + ITRANS=ID + ENDIF + ENDIF + GO TO 300 +C + 200 IF(MCONV.NE.2) GO TO 300 + J1=MOD(IDA,10) + I1=MOD(IDA/10,10) + I2=MOD(IDA/100,10) + I3=MOD(IDA/1000,10) + I4=MOD(IDA/10000,10) + IF(IDA.EQ.0) THEN + WRITE(ITLIS,*) ' ITRANS: particle ID is zero' +C...elementary particles + ELSEIF(IDA.LT.100) THEN + ITRANS=ISIGN(ITABI(IDA,2),ID) +C...check for illegal antiparticles + IF(ID.LT.0) THEN + DO 201 J=1,15 + IF(ID.EQ.NOANT(J)) ITRANS=0 + 201 CONTINUE + ENDIF +C...K short and K long + ELSEIF(ID.EQ.130) THEN + ITRANS=-20 + ELSEIF(ID.EQ.310) THEN + ITRANS=20 +C...mesons + ELSEIF(I3.EQ.0) THEN + IF(I1.LE.2 .AND. I2.LE.2) THEN +C... don't change + ELSE +C... u and d have opposite definitions + IF(I1.LE.2) I1=ITABI(I1,2) + IF(I2.LE.2) I2=ITABI(I2,2) + ENDIF + ITRANS=I1*100 + I2*10 + (J1-1)/2 + ITRANS=ISIGN(ITRANS,ID) +C... charmed and top mesons have wrong sign + IF(I2.EQ.4 .AND. I1.NE.4) ITRANS=-ITRANS + IF(I2.EQ.6 .AND. I1.NE.6 .AND. I1.NE.4) ITRANS=-ITRANS +C...check for illegal antiparticles + IF(I2.EQ.I1 .AND. ID.LT.0) ITRANS=0 +C...diquarks + ELSEIF(I1.EQ.0) THEN +C... u and d have opposite definitions + IF(I3.LE.2) I3=ITABI(I3,2) + IF(I2.LE.2) I2=ITABI(I2,2) + IF(I3.LT.I2) THEN + ITRANS=I3*1000 + I2*100 + (J1-1)/2 + ELSE + ITRANS=I2*1000 + I3*100 + (J1-1)/2 + ENDIF + ITRANS=ISIGN(ITRANS,ID) +C... charmed and top mesons have wrong sign + IF(I2.EQ.4 .AND. I3.NE.4) ITRANS=-ITRANS + IF(I2.EQ.6 .AND. I3.NE.6 .AND. I3.NE.4) ITRANS=-ITRANS +C...baryons + ELSE +C... u and d have opposite definitions + IF(I3.LE.2) I3=ITABI(I3,2) + IF(I2.LE.2) I2=ITABI(I2,2) + IF(I1.LE.2) I1=ITABI(I1,2) + IF(I3.LE.2) THEN + ITRANS=I3*1000 + I2*100 + I1*10 + (J1-2)/2 + ELSEIF(I1.LE.2 .AND. I2.LE.2) THEN + ITRANS=I2*1000 + I1*100 + I3*10 + (J1-2)/2 + ELSE + ITRANS=I1*1000 + I2*100 + I3*10 + (J1-2)/2 + ENDIF + ITRANS=ISIGN(ITRANS,ID) + ENDIF + + 300 RETURN + END diff --git a/ISAJET/isatape/movlev.F b/ISAJET/isatape/movlev.F new file mode 100644 index 00000000000..7ee3b400726 --- /dev/null +++ b/ISAJET/isatape/movlev.F @@ -0,0 +1,38 @@ +#include "isajet/pilot.h" +#if defined(CERNLIB_MOVEFTN) + SUBROUTINE MOVLEV(A,B,N) +C +C Replacement for CDC system routine. +C Move N consecutive locations from A to B. +C Ver. 7.02: Separate entry points for real, integer, logical +C to comply with strict Fortran standard. +C Hence incompatible with CDC -- CDC version is +C therefore obsolete, like the computer. +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" + INTEGER N,I + REAL A(N),B(N) + INTEGER IA(N),IB(N) + LOGICAL LA(N),LB(N) +C Reals + DO 100 I=1,N + B(I)=A(I) +100 CONTINUE + RETURN +C Integers + ENTRY MOVLEI(IA,IB,N) + DO 200 I=1,N + IB(I)=IA(I) +200 CONTINUE + RETURN +C Logicals + ENTRY MOVLEL(LA,LB,N) + DO 300 I=1,N + LB(I)=LA(I) +300 CONTINUE + RETURN + END +#endif diff --git a/ISAJET/isatape/prtlst.F b/ISAJET/isatape/prtlst.F new file mode 100644 index 00000000000..4e0ac7eafe3 --- /dev/null +++ b/ISAJET/isatape/prtlst.F @@ -0,0 +1,67 @@ +#include "isajet/pilot.h" + SUBROUTINE PRTLST(JTLIS,AMY,AMX) +C +C List defined particles. AMY, AMX are the masses of the +C fourth generation quarks. If a negative mass is given, +C then these are not listed. +C This must be linked with ISAJET, including ALDATA. +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/qlmass.inc" +#include "isajet/wcon.inc" + INTEGER JTLIS + REAL AMY,AMX + INTEGER IFL1,IFL2,IFL3,JSPIN,INDEX,I,ID + REAL AM,CG,AMASS,CHARGE + CHARACTER*8 LB,LABEL +C +C Initialize SUSY masses to 0. Remember offset of 1 from KL. +C + DO 100 I=22,NQLEP + AMLEP(I)=0. +100 CONTINUE + AMLEP(7)=AMY + AMLEP(8)=AMX + CALL FLAVOR(80,IFL1,IFL2,IFL3,JSPIN,INDEX) + AMLEP(INDEX)=WMASS(2) + CALL FLAVOR(90,IFL1,IFL2,IFL3,JSPIN,INDEX) + AMLEP(INDEX)=WMASS(4) + WRITE(JTLIS,101) AMY,AMX +C +C Loop over IDENT's +C + DO 200 I=1,40000 + ID = I + CALL FLAVOR(ID,IFL1,IFL2,IFL3,JSPIN,INDEX) + IF(AMX.LT.0..OR.AMY.LT.0.) THEN + IF(IABS(IFL1).GT.6.OR.IABS(IFL2).GT.6.OR.IABS(IFL3).GT.6) + $ GO TO 200 + ENDIF + IF(INDEX.GT.0) THEN + LB = LABEL(ID) + IF(LB.NE.'ERR') THEN + AM = AMASS(ID) + CG = CHARGE(ID) + WRITE(JTLIS,102) ID,LB,AM,CG,IFL1,IFL2,IFL3,JSPIN,INDEX + ENDIF + ENDIF + ID = -I + CALL FLAVOR(ID,IFL1,IFL2,IFL3,JSPIN,INDEX) +C Eliminate bad ID's: + IF(INDEX.GT.0) THEN + LB = LABEL(ID) + IF(LB.NE.'ERR') THEN + AM = AMASS(ID) + CG = CHARGE(ID) + WRITE(JTLIS,102) ID,LB,AM,CG,IFL1,IFL2,IFL3,JSPIN,INDEX + ENDIF + ENDIF + 200 CONTINUE + RETURN + 101 FORMAT(10X,'ISAJET PARTICLES, M(Y) =',F10.3,' M(X) =',F10.3// + 1 5X,'ID',4X,'PARTICLE',8X,'MASS',4X,'CHARGE', + 2 4X,'---FLAVOR---',4X,'SPIN',4X,'INDEX') + 102 FORMAT(1X,I6,4X,A8,F12.6,F10.2,4X,3I4,I8,I9) + END diff --git a/ISAJET/isatape/rdbeg.F b/ISAJET/isatape/rdbeg.F new file mode 100644 index 00000000000..ba73aff9722 --- /dev/null +++ b/ISAJET/isatape/rdbeg.F @@ -0,0 +1,69 @@ +#include "isajet/pilot.h" + SUBROUTINE RDBEG +C +C Read first record (type 200) +C Inverse of WRBEG +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/dylim.inc" +#include "isajet/frgpar.inc" +#include "isajet/idrun.inc" +#include "isajet/jetlim.inc" +#include "isajet/keys.inc" +#include "isajet/primar.inc" +#include "isajet/qcdpar.inc" +#include "isajet/qlmass.inc" +#include "isajet/q1q2.inc" +#include "isajet/types.inc" +#include "isajet/xmssm.inc" +C +#include "isajet/zevel.inc" +C + INTEGER NL,IDSAVE,IL +C + IL=3 + IDSAVE=IDVER + CALL MOVLEI(IZEVEL(IL),IDVER,4) + IF(IDVER.NE.IDSAVE) WRITE(ITLIS,1777) IDVER,IDSAVE +1777 FORMAT(///, + $' WARNING: DATA WERE GENERATED WITH VERSION',I5,/, + $' DATA ARE BEING READ WITH VERSION',I5,/, + $' RESULTS CANNOT BE PREDICTED.'///) + IL=IL+4 + CALL MOVLEI(IZEVEL(IL),NJET,7) + IL=IL+7 + NL=NJET*MXGOQ + IF(NJET.NE.0) CALL MOVLEL(LZEVEL(IL),GOQ(1,1),NL) + IL=14+NL + CALL MOVLEL(LZEVEL(IL),KEYS(1),10) + IL=IL+10 + CALL MOVLEV(ZEVEL(IL),PMIN(1),36) + IL=IL+36 + IF(.NOT.KEYS(3)) GO TO 11 + CALL MOVLEV(ZEVEL(IL),QMIN,12) + IL=IL+12 +11 CONTINUE + CALL MOVLEL(LZEVEL(IL),GODY(1),5) + IL=IL+5 + CALL MOVLEV(ZEVEL(IL),PUD,22) + IL=IL+22 + CALL MOVLEV(ZEVEL(IL),ALAM,4) + IL=IL+4 + CALL MOVLEV(ZEVEL(IL),AMLEP(6),3) + IL=IL+3 + CALL MOVLEI(IZEVEL(IL),LOC(1),100) + IL=IL+100 + CALL MOVLEL(LZEVEL(IL),GOMSSM,1) + IL=IL+1 + CALL MOVLEV(ZEVEL(IL),XGLSS,11) + IL=IL+11 + CALL MOVLEL(LZEVEL(IL),GOSUG,1) + IL=IL+1 + CALL MOVLEV(ZEVEL(IL),XM0SU,5) + IL=IL+5 +C + RETURN + END diff --git a/ISAJET/isatape/rdtape.F b/ISAJET/isatape/rdtape.F new file mode 100644 index 00000000000..6a005bb63ae --- /dev/null +++ b/ISAJET/isatape/rdtape.F @@ -0,0 +1,19 @@ +#include "isajet/pilot.h" + SUBROUTINE RDTAPE(IDEV,IFL) +C +C CALL ROUTINES TO READ AND UNPACK ISAJET DATA +C RGENS FOR EVENTS +C RDBEG FOR BEGINNING RECORD +C REND FOR END RECORD +C +#include "isajet/itapes.inc" +#include "isajet/ita.inc" +#include "isajet/rectp.inc" +#include "isajet/zevel.inc" + ITB=IABS(IDEV) + CALL RGENS(IFL) + IF(IFL.NE.0) RETURN + IF(IRECTP.EQ.200) CALL RDBEG + IF(IRECTP.EQ.300) CALL REND + RETURN + END diff --git a/ISAJET/isatape/rend.F b/ISAJET/isatape/rend.F new file mode 100644 index 00000000000..bf1571a2809 --- /dev/null +++ b/ISAJET/isatape/rend.F @@ -0,0 +1,16 @@ +#include "isajet/pilot.h" + SUBROUTINE REND +C +C INVERSE OF WREND +C READ END RECORD (TYPE 300) +C +#include "isajet/itapes.inc" +#include "isajet/final.inc" +#include "isajet/zevel.inc" + NKINF=IZEVEL(3) + SIGF=ZEVEL(4) + ALUM=ZEVEL(5) + ACCEPT=ZEVEL(6) + NRECS=IZEVEL(7) + RETURN + END diff --git a/ISAJET/isatape/rgens.F b/ISAJET/isatape/rgens.F new file mode 100644 index 00000000000..9936316502a --- /dev/null +++ b/ISAJET/isatape/rgens.F @@ -0,0 +1,146 @@ +#include "isajet/pilot.h" + SUBROUTINE RGENS(IFLAG) +C +C Inverse of WRGEN +C Read a record by a call BUFIN +C If record type is not event type return. +C If RGENS called with IFLAG=10 return without unpacking. +C Unpack ZEVEL into appropriate common blocks. +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/mbgen.inc" +#include "isajet/keys.inc" +#include "isajet/rectp.inc" +#include "isajet/idrun.inc" +#include "isajet/jetpar.inc" +#include "isajet/jetset.inc" +#include "isajet/jetsig.inc" +#include "isajet/partcl.inc" +#include "isajet/pjets.inc" +#include "isajet/pinits.inc" +#include "isajet/primar.inc" +#include "isajet/zevel.inc" +#include "isajet/totals.inc" +#include "isajet/wsig.inc" +#include "isajet/final.inc" +C + INTEGER IFLAG + INTEGER I,IEX,IZ5,K,IFL,ISAV,IL +C + IFL=IFLAG + CALL BUFIN(IL,IFLAG) + IF(IFLAG.NE.0) RETURN + ISAV=IZEVEL(1)/100 + IRECTP=ISAV*100 + IREC=MOD(IZEVEL(1),100) + IF(IRECTP.EQ.200) RETURN + IF(IRECTP.EQ.300) RETURN + IF(IFL.EQ.10) RETURN + IL=3 + CALL MOVLEI(IZEVEL(IL),IDVER,4) + IL=IL+4 + CALL MOVLEL(LZEVEL(IL),KEYS(1),MXKEYS) + IL=IL+MXKEYS + NJET=IZEVEL(IL) + IL=IL+1 + CALL MOVLEV(ZEVEL(IL),P(1),59) + IL=IL+59 + CALL MOVLEV(ZEVEL(IL),SIGF,1) + IL=IL+1 + IF(.NOT.KEYS(4)) THEN + SIGMA=ZEVEL(IL) + SIGEVT=ZEVEL(IL+1) + WT=ZEVEL(IL+2) + IL=IL+3 + ENDIF + NPTCL=IZEVEL(IL) + IL=IL+1 + IF(NJET.GT.0) THEN + IEX=NJET*5 + CALL MOVLEV(ZEVEL(IL),PJETS(1,1),IEX) + IL=IL+IEX + CALL MOVLEI(IZEVEL(IL),IDJETS(1),NJET) + IL=IL+NJET + ENDIF + IF(KEYS(3).OR.KEYS(7).OR.KEYS(11)) THEN + CALL MOVLEV(ZEVEL(IL),QWJET(1),6) + IL=IL+6 + CALL MOVLEV(ZEVEL(IL),QMW,16) + IL=IL+16 + SIGLLQ=ZEVEL(IL) + IL=IL+1 + ENDIF + IF(KEYS(6).OR.KEYS(7)) THEN + NPAIR=IZEVEL(IL) + IL=IL+1 + IF(NPAIR.NE.0) THEN + CALL MOVLEV(ZEVEL(IL),PPAIR(1,1),5*NPAIR) + IL=IL+5*NPAIR + CALL MOVLEI(IZEVEL(IL),IDPAIR(1),NPAIR) + IL=IL+NPAIR + CALL MOVLEI(IZEVEL(IL),JPAIR(1),NPAIR) + IL=IL+NPAIR + ENDIF + ENDIF + NJSET=IZEVEL(IL) + IL=IL+1 + CALL MOVLEI(IZEVEL(IL),NKINPT,5) + IL=IL+5 + CALL MOVLEI(IZEVEL(IL),NPOM,1) + IL=IL+1 +C +C /JETSET/ COMMON BLOCK + IF(NJSET.LT.1) GOTO 12 + DO 50 I=1,NJSET + CALL MOVLEV(ZEVEL(IL),PJSET(1,I),5) + IL=IL+5 + JORIG(I)=IZEVEL(IL) + JTYPE(I)=IZEVEL(IL+1) + JDCAY(I)=IZEVEL(IL+2) + IL=IL+3 + IF(IL.LE.MAXLEN-9) GO TO 50 + IF(I.EQ.NJSET.AND.NPTCL.EQ.0) GO TO 12 + CALL BUFIN(IL,IFLAG) + IF(IFLAG.NE.0) RETURN +50 CONTINUE +C +C /PARTCL/ COMMON BLOCK +C NPTCL.LT.0 IMPLIES ONLY STABLE PARTICLES ON THIS FILE +C ORIGIN AND DECAY INFORMATION SUPPRESSED +12 IF(NPTCL.EQ.0) GOTO 999 + IF(NPTCL.GT.0) GOTO 997 +C ONLY STABLE PARTICLES + NPTCL=-NPTCL + DO 992 K=1,NPTCL + CALL MOVLEV(ZEVEL(IL),PPTCL(1,K),5) + IZ5=IABS(IZEVEL(IL+5)) + IORIG(K)=(IZ5/10000)*1000 + IDENT(K)=MOD(IZ5,10000)*ISIGN(1,IZEVEL(IL+5)) + IDCAY(K)=0 + IL=IL+6 + IF(IL.LE.MAXLEN-6) GOTO 992 + IF(K.EQ.NPTCL) RETURN + CALL BUFIN(IL,IFLAG) + IF(IFLAG.NE.0) RETURN + 992 CONTINUE + RETURN +C ALL PARTICLES +C NOTE THAT IDCAY CAN EXCEED 2**24 LIMIT OF PAIRPAK + 997 CONTINUE + DO 998 K=1,NPTCL + CALL MOVLEV(ZEVEL(IL),PPTCL(1,K),5) + IORIG(K)=IZEVEL(IL+5) + IDENT(K)=IZEVEL(IL+6) + IDCAY(K)=IZEVEL(IL+7)*IPACK+IZEVEL(IL+8) + IL=IL+9 + IF(IL.LE.MAXLEN-9) GOTO 998 + IF(K.EQ.NPTCL) RETURN + CALL BUFIN(IL,IFLAG) + IF(IFLAG.NE.0) RETURN + 998 CONTINUE + 999 CONTINUE + RETURN + END diff --git a/ISAJET/isatape/wgens.F b/ISAJET/isatape/wgens.F new file mode 100644 index 00000000000..f28b7447cdf --- /dev/null +++ b/ISAJET/isatape/wgens.F @@ -0,0 +1,149 @@ +#include "isajet/pilot.h" + SUBROUTINE WGENS +C +C Copy event information into ZEVEL and call BUFOUT. +C If number of words required exceeds MAXLEN-8, the number +C of records written=no. of words/(MAXLEN-8)+1 +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif +#include "isajet/itapes.inc" +#include "isajet/mbgen.inc" +#include "isajet/keys.inc" +#include "isajet/idrun.inc" +#include "isajet/jetpar.inc" +#include "isajet/jetset.inc" +#include "isajet/jetsig.inc" +#include "isajet/partcl.inc" +#include "isajet/pjets.inc" +#include "isajet/pinits.inc" +#include "isajet/primar.inc" +#include "isajet/zevel.inc" +#include "isajet/final.inc" +#include "isajet/totals.inc" +#include "isajet/wsig.inc" +C + INTEGER I2,I1,JET,K,IEX,IL,ITA,I,NPSTA +C + ITA=IABS(ITEVT) + IZEVEL(1)=100 + IZEVEL(2)=1 + IL=3 + CALL MOVLEI(IDVER,IZEVEL(IL),4) + IL=IL+4 + CALL MOVLEL(KEYS(1),LZEVEL(IL),MXKEYS) + IL=IL+MXKEYS + IZEVEL(IL)=NJET + IL=IL+1 + CALL MOVLEV(P(1),ZEVEL(IL),59) + IL=IL+59 + CALL MOVLEV(SIGF,ZEVEL(IL),1) + IL=IL+1 + IF(.NOT.KEYS(4)) THEN + ZEVEL(IL)=SIGMA + ZEVEL(IL+1)=SIGEVT + ZEVEL(IL+2)=WT + IL=IL+3 + ENDIF +C IF ITEVT.LT.0 WRITE ONLY STABLE PARTICLES AND FLAG +C BY NPTCL=-(NO. OF STABLE PARTICLES) + IF(ITEVT.GT.0) THEN + IZEVEL(IL)=NPTCL + ELSE + NPSTA=0 + DO 990 I=1,NPTCL +990 IF(IDCAY(I).EQ.0) NPSTA=NPSTA+1 + IZEVEL(IL)=-NPSTA + ENDIF + IL=IL+1 + IF(NJET.GT.0) THEN + IEX=NJET*5 + CALL MOVLEV(PJETS(1,1),ZEVEL(IL),IEX) + IL=IL+IEX + CALL MOVLEI(IDJETS(1),IZEVEL(IL),NJET) + IL=IL+NJET + ENDIF + IF(KEYS(3).OR.KEYS(7).OR.KEYS(11)) THEN + CALL MOVLEV(QWJET(1),ZEVEL(IL),6) + IL=IL+6 + CALL MOVLEV(QMW,ZEVEL(IL),16) + IL=IL+16 + I1=JWTYP + I2=JETTYP(3) + IZEVEL(IL)=SIGLLQ + IL=IL+1 + ENDIF + IF(KEYS(6).OR.KEYS(7)) THEN + IZEVEL(IL)=NPAIR + IL=IL+1 + IF(NPAIR.NE.0) THEN + CALL MOVLEV(PPAIR(1,1),ZEVEL(IL),5*NPAIR) + IL=IL+5*NPAIR + CALL MOVLEI(IDPAIR(1),IZEVEL(IL),NPAIR) + IL=IL+NPAIR + CALL MOVLEI(JPAIR(1),IZEVEL(IL),NPAIR) + IL=IL+NPAIR + ENDIF + ENDIF + IZEVEL(IL)=NJSET + IL=IL+1 + CALL MOVLEI(NKINPT,IZEVEL(IL),5) + IL=IL+5 + CALL MOVLEI(NPOM,IZEVEL(IL),1) + IL=IL+1 +C +C /JETSET/ COMMON BLOCK + IF(NJSET.LT.1) GOTO 12 + DO 50 I=1,NJSET + CALL MOVLEV(PJSET(1,I),ZEVEL(IL),5) + IL=IL+5 + IZEVEL(IL)=JORIG(I) + IZEVEL(IL+1)=JTYPE(I) + IZEVEL(IL+2)=JDCAY(I) + IL=IL+3 + IF(IL.LE.MAXLEN-9) GO TO 50 + IZEVEL(1)=IZEVEL(1)+1 + CALL BUFOUT(IL) + IF(I.EQ.NJSET) GO TO 12 +50 CONTINUE +C +C /PARTCL/ COMMON BLOCK +C IF ITEVT.LT.0, WRITE OUT ONLY STABLE PARTICLES +C FLAG BY NPTCL=-(NO. OF STABLE PARTICLES) +C SUPPRESS ORIGIN AND DECAY INFORMATION +12 IF(NPTCL.EQ.0) GOTO 999 + IF(ITEVT.GT.0) GOTO 997 +C ONLY STABLE PARTICLES + DO 992 K=1,NPTCL + IF(IDCAY(K).NE.0) GOTO 992 + JET=IABS(IORIG(K))/1000 + CALL MOVLEV(PPTCL(1,K),ZEVEL(IL),5) + IZEVEL(IL+5)=(JET*10000+IABS(IDENT(K)))*ISIGN(1,IDENT(K)) + IL=IL+6 + IF(IL.LE.MAXLEN-6) GOTO 992 + IZEVEL(1)=IZEVEL(1)+1 + CALL BUFOUT(IL) + IF(K.EQ.NPTCL) RETURN + 992 CONTINUE + GOTO 999 + 997 CONTINUE +C ALL PARTICLES +C NOTE IDCAY CAN EXCEED 2**24 LIMIT OF PAIRPAK + DO 998 K=1,NPTCL + CALL MOVLEV(PPTCL(1,K),ZEVEL(IL),5) + IZEVEL(IL+5)=IORIG(K) + IZEVEL(IL+6)=IDENT(K) + IZEVEL(IL+7)=IDCAY(K)/IPACK + IZEVEL(IL+8)=MOD(IDCAY(K),IPACK) + IL=IL+9 + IF(IL.LE.MAXLEN-9) GOTO 998 + IZEVEL(1)=IZEVEL(1)+1 + CALL BUFOUT(IL) + IF(K.EQ.NPTCL) RETURN + 998 CONTINUE + 999 CONTINUE + IZEVEL(1)=IZEVEL(1)+1 + CALL BUFOUT(IL) + RETURN + END diff --git a/ISAJET/isatape/zerol.F b/ISAJET/isatape/zerol.F new file mode 100644 index 00000000000..c42f355cff5 --- /dev/null +++ b/ISAJET/isatape/zerol.F @@ -0,0 +1,12 @@ +#include "isajet/pilot.h" + SUBROUTINE ZEROL(Z,N) +C SET N VALUES OF Z IN LEVEL2 TO ZERO +#include "isajet/itapes.inc" + DIMENSION Z(N) +#if defined(CERNLIB_LEVEL2) + LEVEL2,Z +#endif + DO 1 I=1,N + 1 Z(I)=0 + RETURN + END diff --git a/ISAJET/openfile/openfile.F b/ISAJET/openfile/openfile.F new file mode 100644 index 00000000000..96e2cb7b4ef --- /dev/null +++ b/ISAJET/openfile/openfile.F @@ -0,0 +1,51 @@ + SUBROUTINE OPENFILES + CHARACTER*100 CHROOT + CHARACTER*100 FILNAM + LOGICAL EXISTS + CHROOT=' ' + CALL GETENVF('ALICE_ROOT',CHROOT) + LNROOT = LNBLNK(CHROOT) + IF(LNROOT.LE.0) THEN + FILNAM='myjob.par' + ELSE + FILNAM=CHROOT(1:LNROOT)//'/ISAJET/data/myjob.par' + ENDIF + + INQUIRE(FILE=FILNAM,EXIST=EXISTS) + IF(.NOT.EXISTS) THEN + PRINT*,'**********************************' + PRINT*,'* I S A J E T *' + PRINT*,'* ----------- *' + PRINT*,'* File myjob.par not found *' + PRINT*,'* Program STOP *' + PRINT*,'* Check CERN_ROOT environment *' + PRINT*,'* variable *' + PRINT*,'**********************************' + STOP + ENDIF + + OPEN(51, FILE=FILNAM + &, STATUS="OLD",FORM = "FORMATTED") + OPEN(52, FILE="myjob.dat", STATUS="OLD",FORM = "UNFORMATTED") + + OPEN(53, FILE="myjob.lis", STATUS="OLD",FORM = "FORMATTED") + + + FILNAM=CHROOT(1:LNROOT)//'/ISAJET/data/decay.cpp' + INQUIRE(FILE=FILNAM,EXIST=EXISTS) + IF(.NOT.EXISTS) THEN + PRINT*,'**********************************' + PRINT*,'* I S A J E T *' + PRINT*,'* ----------- *' + PRINT*,'* File decay.cpp not found *' + PRINT*,'* Program STOP *' + PRINT*,'* Check CERN_ROOT environment *' + PRINT*,'* variable *' + PRINT*,'**********************************' + STOP + ENDIF + + OPEN(54, FILE=FILNAM + &, STATUS="OLD",FORM = "FORMATTED") + RETURN + END diff --git a/ISAJET/pdfinit/pdfinit.F b/ISAJET/pdfinit/pdfinit.F new file mode 100644 index 00000000000..b7584105f2a --- /dev/null +++ b/ISAJET/pdfinit/pdfinit.F @@ -0,0 +1,50 @@ + SUBROUTINE PDFINIT(PDFPAR, PDFVAL) +#include "isajet/types.inc" +#if defined(CERNLIB_PDFLIB) +#include "isajet/w50510.inc" +#include "isajet/w50517.inc" + CHARACTER*20 PDFPAR(20) + +#if defined(CERNLIB_SINGLE) + REAL PDFVAL(20) + REAL DX,DSCALE,DXPDF(-6:6) +#endif +#if defined(CERNLIB_DOUBLE) + DOUBLE PRECISION PDFVAL(20) + DOUBLE PRECISION DX,DSCALE,DXPDF(-6:6) +#endif + + IF(ISTRUC.EQ.-999) THEN + WRITE(ITLIS,1200) +1200 FORMAT(// + $ '1********************************'/ + $ ' * *'/ + $ ' * INITIALIZE PDFLIB FOR ISAJET *'/ + $ ' * *'/ + $ ' ********************************'/) + N6=ITLIS + IFLPRT=2 + CALL PDFSET(PDFPAR,PDFVAL) + CALL PFTOPDG(0.5D0,1.0D2,DXPDF) + IFLPRT=0 + ENDIF + + DO 541 I=1,20 + PDFPAR(I)=' ' + PDFVAL(I)=0 +541 CONTINUE + READ(ITCOM,*) (PDFPAR(I),PDFVAL(I),I=1,20) + DO 542 I=1,20 + IF(PDFPAR(I).NE.' ') THEN + WRITE(ITLIS,*) PDFPAR(I),PDFVAL(I) + ENDIF +542 CONTINUE + ISTRUC=-999 + LOC(54)=NSEL +#endif + + END + + + + diff --git a/ISAJET/utils/cern_lib/ddilog.F b/ISAJET/utils/cern_lib/ddilog.F new file mode 100644 index 00000000000..b07d6496396 --- /dev/null +++ b/ISAJET/utils/cern_lib/ddilog.F @@ -0,0 +1,100 @@ +* +* $Id$ +* +* $Log$ +* Revision 1.9 2000/07/25 14:53:05 mclareni +* Version 7.51 from author +* +* +*#include "sys/CERNLIB_machine.h" +#include "isajet/pilot.h" +#if defined(CERNLIB_NOCERN) + DOUBLE PRECISION FUNCTION DDILOG(X) +C +C FROM CERN PROGRAM LIBRARY +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + DOUBLE PRECISION X,Y,T,S,A,PI3,PI6,ZERO,ONE,HALF,MALF,MONE,MTWO + DOUBLE PRECISION C(0:18),H,ALFA,B0,B1,B2 + INTEGER I +C + DATA ZERO /0.0D0/, ONE /1.0D0/ + DATA HALF /0.5D0/, MALF /-0.5D0/, MONE /-1.0D0/, MTWO /-2.0D0/ + DATA PI3 /3.28986 81336 96453D0/, PI6 /1.64493 40668 48226D0/ +C + DATA C( 0) / 0.42996 69356 08137 0D0/ + DATA C( 1) / 0.40975 98753 30771 1D0/ + DATA C( 2) /-0.01858 84366 50146 0D0/ + DATA C( 3) / 0.00145 75108 40622 7D0/ + DATA C( 4) /-0.00014 30418 44423 4D0/ + DATA C( 5) / 0.00001 58841 55418 8D0/ + DATA C( 6) /-0.00000 19078 49593 9D0/ + DATA C( 7) / 0.00000 02419 51808 5D0/ + DATA C( 8) /-0.00000 00319 33412 7D0/ + DATA C( 9) / 0.00000 00043 45450 6D0/ + DATA C(10) /-0.00000 00006 05784 8D0/ + DATA C(11) / 0.00000 00000 86121 0D0/ + DATA C(12) /-0.00000 00000 12443 3D0/ + DATA C(13) / 0.00000 00000 01822 6D0/ + DATA C(14) /-0.00000 00000 00270 1D0/ + DATA C(15) / 0.00000 00000 00040 4D0/ + DATA C(16) /-0.00000 00000 00006 1D0/ + DATA C(17) / 0.00000 00000 00000 9D0/ + DATA C(18) /-0.00000 00000 00000 1D0/ +C + IF(X .EQ. ONE) THEN + DDILOG=PI6 + RETURN + ELSE IF(X .EQ. MONE) THEN + DDILOG=MALF*PI6 + RETURN + END IF + T=-X + IF(T .LE. MTWO) THEN + Y=MONE/(ONE+T) + S=ONE + A=-PI3+HALF*(LOG(-T)**2-LOG(ONE+ONE/T)**2) + ELSE IF(T .LT. MONE) THEN + Y=MONE-T + S=MONE + A=LOG(-T) + A=-PI6+A*(A+LOG(ONE+ONE/T)) + ELSE IF(T .LE. MALF) THEN + Y=(MONE-T)/T + S=ONE + A=LOG(-T) + A=-PI6+A*(MALF*A+LOG(ONE+T)) + ELSE IF(T .LT. ZERO) THEN + Y=-T/(ONE+T) + S=MONE + A=HALF*LOG(ONE+T)**2 + ELSE IF(T .LE. ONE) THEN + Y=T + S=ONE + A=ZERO + ELSE + Y=ONE/T + S=MONE + A=PI6+HALF*LOG(T)**2 + END IF +C + H=Y+Y-ONE + ALFA=H+H + B1=ZERO + B2=ZERO + DO 1 I = 18,0,-1 + B0=C(I)+ALFA*B1-B2 + B2=B1 + 1 B1=B0 + DDILOG=-(S*(B0-H*B2)+A) + RETURN + END +#endif + + + + + + diff --git a/ISAJET/utils/cern_lib/eisrs1.F b/ISAJET/utils/cern_lib/eisrs1.F new file mode 100644 index 00000000000..10e26b43584 --- /dev/null +++ b/ISAJET/utils/cern_lib/eisrs1.F @@ -0,0 +1,26 @@ +* +* $Id$ +* +* $Log$ +* Revision 1.9 2000/07/25 14:53:05 mclareni +* Version 7.51 from author +* +* +*#include "sys/CERNLIB_machine.h" +#include "isajet/pilot.h" +#if defined(CERNLIB_NOCERN) + SUBROUTINE EISRS1(NM,N,AR,WR,ZR,IERR,WORK) +C ALL EIGENVALUES AND CORRESPONDING EIGENVECTORS OF A REAL +C SYMMETRIC MATRIX +C FROM CERN PROGRAM LIBRARY +C +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + INTEGER NM,N,IERR + REAL AR(NM,NM),WR(N),ZR(NM,NM),WORK(1) + CALL TRED2(NM,N,AR,WR,WORK,ZR) + CALL TQL2(NM,N,WR,WORK,ZR,IERR) + RETURN + END +#endif diff --git a/ISAJET/utils/cern_lib/rkstp.F b/ISAJET/utils/cern_lib/rkstp.F new file mode 100644 index 00000000000..d7bd8b8bb75 --- /dev/null +++ b/ISAJET/utils/cern_lib/rkstp.F @@ -0,0 +1,66 @@ +* +* $Id$ +* +* $Log$ +* Revision 1.9 2000/07/25 14:53:05 mclareni +* Version 7.51 from author +* +* +*#include "sys/CERNLIB_machine.h" +#include "isajet/pilot.h" +#if defined(CERNLIB_NOCERN) +C----------------------------------------------------------------------- + SUBROUTINE RKSTP(N,H,X,Y,SUB,W) +C----------------------------------------------------------------------- +C +C From CERN Program Library, routine D209, with error message for +C N.LT.1 replaced by STOP 99 to eliminate Kernlib error routine. +C + DIMENSION Y(N),W(N,3) + LOGICAL MFLAG,RFLAG + EXTERNAL SUB +C +C ****************************************************************** +C +C THIS SUBROUTINE REPLACES X BY X+H AND ADVANCES THE SOLUTION OF THE +C SYSTEM OF DIFFERENTIAL EQUATIONS DY/DX=F(X,Y) FROM Y(X) TO Y(X+H) +C USING A FIFTH-ORDER RUNGE-KUTTA METHOD. +C +C SUB IS THE NAME OF A SUBROUTINE SUB(X,Y,F) WHICH SETS THE VECTOR F +C TO THE DERIVATIVE AT X OF THE VECTOR Y. +C +C W IS A WORKING-SPACE ARRAY, TREATED AS CONSISTING OF THREE CONSEC- +C UTIVE WORKING VECTORS OF LENGTH N. +C +C ****************************************************************** +C +C START. + IF (N.LT.1) STOP 99 + NLOCAL=N + HLOCAL=H + H2=0.5*HLOCAL + H6=HLOCAL/6. + XH=X+HLOCAL + XH2=X+H2 + CALL SUB(X,Y,W(1,1)) + DO 1 J=1,NLOCAL + W(J,2)=Y(J)+H2*W(J,1) + 1 CONTINUE + CALL SUB(XH2,W(1,2),W(1,3)) + DO 2 J=1,NLOCAL + W(J,1)=W(J,1)+2.*W(J,3) + W(J,2)=Y(J)+H2*W(J,3) + 2 CONTINUE + CALL SUB(XH2,W(1,2),W(1,3)) + DO 3 J=1,NLOCAL + W(J,1)=W(J,1)+2.*W(J,3) + W(J,2)=Y(J)+HLOCAL*W(J,3) + 3 CONTINUE + CALL SUB(XH,W(1,2),W(1,3)) + DO 4 J=1,NLOCAL + Y(J)=Y(J)+H6*(W(J,1)+W(J,3)) + 4 CONTINUE + X=XH + RETURN + END +#endif diff --git a/ISAJET/utils/cern_lib/sorttf.F b/ISAJET/utils/cern_lib/sorttf.F new file mode 100644 index 00000000000..e3da6edc1d6 --- /dev/null +++ b/ISAJET/utils/cern_lib/sorttf.F @@ -0,0 +1,56 @@ +* +* $Id$ +* +* $Log$ +* Revision 1.1 2000/07/25 14:53:05 mclareni +* Version 7.51 from author +* +* +*#include "sys/CERNLIB_machine.h" +#include "isajet/pilot.h" +#if defined(CERNLIB_NOCERN) + SUBROUTINE SORTTF(A,INDEX,N1) +C======================================================================= +C Given real array and corresponding index INDEX, find new +C INDEX for which A is sorted into ascending order. +C +C From CERN PROGLIB# M101 +C======================================================================= + DIMENSION A(N1),INDEX(N1) +C + N = N1 + DO 3 I1=2,N + I3 = I1 + I33 = INDEX(I3) + AI = A(I33) + 1 I2 = I3/2 + IF (I2) 3,3,2 + 2 I22 = INDEX(I2) + IF (AI.LE.A (I22)) GO TO 3 + INDEX (I3) = I22 + I3 = I2 + GO TO 1 + 3 INDEX (I3) = I33 + 4 I3 = INDEX (N) + INDEX (N) = INDEX (1) + AI = A(I3) + N = N-1 + IF (N-1) 12,12,5 + 5 I1 = 1 + 6 I2 = I1 + I1 + IF (I2.LE.N) I22= INDEX(I2) + IF (I2-N) 7,9,11 + 7 I222 = INDEX (I2+1) + IF (A(I22)-A(I222)) 8,9,9 + 8 I2 = I2+1 + I22 = I222 + 9 IF (AI-A(I22)) 10,11,11 + 10 INDEX(I1) = I22 + I1 = I2 + GO TO 6 + 11 INDEX (I1) = I3 + GO TO 4 + 12 INDEX (1) = I3 + RETURN + END +#endif diff --git a/ISAJET/utils/cern_lib/tql2.F b/ISAJET/utils/cern_lib/tql2.F new file mode 100644 index 00000000000..87e066fc2d2 --- /dev/null +++ b/ISAJET/utils/cern_lib/tql2.F @@ -0,0 +1,102 @@ +* +* $Id$ +* +* $Log$ +* Revision 1.9 2000/07/25 14:53:05 mclareni +* Version 7.51 from author +* +* +*#include "sys/CERNLIB_machine.h" +#include "isajet/pilot.h" +#if defined(CERNLIB_NOCERN) + SUBROUTINE TQL2(NM,N,D,E,Z,IERR) +C FROM CERN PROGRAM LIBRARY +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + INTEGER I,J,K,L,M,N,II,NM,MML,IERR + REAL D(N),E(N),Z(NM,N) + REAL B,C,F,G,H,P,R,S,MACHEP + MACHEP=2.**(-23) +#if defined(CERNLIB_CDC) + MACHEP=2.**(-47) +#endif + IERR = 0 + IF (N .EQ. 1) GO TO 1001 + DO 100 I = 2, N + 100 E(I-1) = E(I) + F = 0.0 + B = 0.0 + E(N) = 0.0 + DO 240 L = 1, N + J = 0 + H = MACHEP * (ABS(D(L)) + ABS(E(L))) + IF (B .LT. H) B = H + DO 110 M = L, N + IF (ABS(E(M)) .LE. B) GO TO 120 + 110 CONTINUE + 120 IF (M .EQ. L) GO TO 220 + 130 IF (J .EQ. 30) GO TO 1000 + J = J + 1 + P = (D(L+1) - D(L)) / (2.0 * E(L)) + R = SQRT(P*P+1.0) + H = D(L) - E(L) / (P + SIGN(R,P)) + DO 140 I = L, N + 140 D(I) = D(I) - H + F = F + H + P = D(M) + C = 1.0 + S = 0.0 + MML = M - L + DO 200 II = 1, MML + I = M - II + G = C * E(I) + H = C * P + IF (ABS(P) .LT. ABS(E(I))) GO TO 150 + C = E(I) / P + R = SQRT(C*C+1.0) + E(I+1) = S * P * R + S = C / R + C = 1.0 / R + GO TO 160 + 150 C = P / E(I) + R = SQRT(C*C+1.0) + E(I+1) = S * E(I) * R + S = 1.0 / R + C = C * S + 160 P = C * D(I) - S * G + D(I+1) = H + S * (C * G + S * D(I)) + DO 180 K = 1, N + H = Z(K,I+1) + Z(K,I+1) = S * Z(K,I) + C * H + Z(K,I) = C * Z(K,I) - S * H + 180 CONTINUE + 200 CONTINUE + E(L) = S * P + D(L) = C * P + IF (ABS(E(L)) .GT. B) GO TO 130 + 220 D(L) = D(L) + F + 240 CONTINUE + DO 300 II = 2, N + I = II - 1 + K = I + P = D(I) + DO 260 J = II, N + IF (D(J) .GE. P) GO TO 260 + K = J + P = D(J) + 260 CONTINUE + IF (K .EQ. I) GO TO 300 + D(K) = D(I) + D(I) = P + DO 280 J = 1, N + P = Z(J,I) + Z(J,I) = Z(J,K) + Z(J,K) = P + 280 CONTINUE + 300 CONTINUE + GO TO 1001 + 1000 IERR = L + 1001 RETURN + END +#endif diff --git a/ISAJET/utils/cern_lib/tred2.F b/ISAJET/utils/cern_lib/tred2.F new file mode 100644 index 00000000000..a89514dd0c6 --- /dev/null +++ b/ISAJET/utils/cern_lib/tred2.F @@ -0,0 +1,92 @@ +* +* $Id$ +* +* $Log$ +* Revision 1.9 2000/07/25 14:53:06 mclareni +* Version 7.51 from author +* +* +*#include "sys/CERNLIB_machine.h" +#include "isajet/pilot.h" +#if defined(CERNLIB_NOCERN) + SUBROUTINE TRED2(NM,N,A,D,E,Z) +C FROM CERN PROGRAM LIBRARY +#if defined(CERNLIB_IMPNONE) + IMPLICIT NONE +#endif + INTEGER I,J,K,L,N,II,NM,JP1 + REAL A(NM,N),D(N),E(N),Z(NM,N) + REAL F,G,H,HH,SCALE + DO 100 I = 1, N + DO 100 J = 1, I + Z(I,J) = A(I,J) + 100 CONTINUE + IF (N .EQ. 1) GO TO 320 + DO 300 II = 2, N + I = N + 2 - II + L = I - 1 + H = 0.0 + SCALE = 0.0 + IF (L .LT. 2) GO TO 130 + DO 120 K = 1, L + 120 SCALE = SCALE + ABS(Z(I,K)) + IF (SCALE .NE. 0.0) GO TO 140 + 130 E(I) = Z(I,L) + GO TO 290 + 140 DO 150 K = 1, L + Z(I,K) = Z(I,K) / SCALE + H = H + Z(I,K) * Z(I,K) + 150 CONTINUE + F = Z(I,L) + G = -SIGN(SQRT(H),F) + E(I) = SCALE * G + H = H - F * G + Z(I,L) = F - G + F = 0.0 + DO 240 J = 1, L + Z(J,I) = Z(I,J) / (SCALE * H) + G = 0.0 + DO 180 K = 1, J + 180 G = G + Z(J,K) * Z(I,K) + JP1 = J + 1 + IF (L .LT. JP1) GO TO 220 + DO 200 K = JP1, L + 200 G = G + Z(K,J) * Z(I,K) + 220 E(J) = G / H + F = F + E(J) * Z(I,J) + 240 CONTINUE + HH = F / (H + H) + DO 260 J = 1, L + F = Z(I,J) + G = E(J) - HH * F + E(J) = G + DO 260 K = 1, J + Z(J,K) = Z(J,K) - F * E(K) - G * Z(I,K) + 260 CONTINUE + DO 280 K = 1, L + 280 Z(I,K) = SCALE * Z(I,K) + 290 D(I) = H + 300 CONTINUE + 320 D(1) = 0.0 + E(1) = 0.0 + DO 500 I = 1, N + L = I - 1 + IF (D(I) .EQ. 0.0) GO TO 380 + DO 360 J = 1, L + G = 0.0 + DO 340 K = 1, L + 340 G = G + Z(I,K) * Z(K,J) + DO 360 K = 1, L + Z(K,J) = Z(K,J) - G * Z(K,I) + 360 CONTINUE + 380 D(I) = Z(I,I) + Z(I,I) = 1.0 + IF (L .LT. 1) GO TO 500 + DO 400 J = 1, L + Z(I,J) = 0.0 + Z(J,I) = 0.0 + 400 CONTINUE + 500 CONTINUE + RETURN + END +#endif -- 2.43.0