1 C-----------------------------------------------------------------------
4 C a Monte Carlo event generator for simulating
5 C +---------------------------------------------------+
6 C | Hadron Emission Reactions With Interfering Gluons |
7 C +---------------------------------------------------+
8 C I.G. Knowles(*), G. Marchesini(+), M.H.Seymour($,&) and B.R. Webber(#)
9 C-----------------------------------------------------------------------
10 C with Minimal Supersymmetric Standard Model Matrix Elements by
11 C S. Moretti(") and K. Odagiri(^)
12 C-----------------------------------------------------------------------
13 C R parity violating Supersymmetric Decays and Matrix Elements by
15 C-----------------------------------------------------------------------
16 C matrix element corrections to top decay and Drell-Yan type processes
18 C-----------------------------------------------------------------------
19 C Deep Inelastic Scattering and Heavy Flavour Electroproduction by
20 C G. Abbiendi(@) and L. Stanco(%)
21 C-----------------------------------------------------------------------
22 C and Jet Photoproduction in Lepton-Hadron Collisions by J. Chyla(~)
23 C-----------------------------------------------------------------------
24 C(*) Department of Physics & Astronomy, University of Edinburgh
25 C(+) Dipartimento di Fisica, Universita di Milano-Bicocca
26 C($) Department of Physics & Astronomy, University of Manchester
27 C(&) Theory Division, CERN
28 C(#) Cavendish Laboratory, Cambridge
29 C(") School of Physics & Astronomy, Southampton
30 C(^) Academia Sinica, Taiwan
31 C(X) Institute of Particle Physics Phenomenology, University of Durham
32 C(@) Dipartimento di Fisica, Universita di Bologna
33 C(%) Dipartimento di Fisica, Universita di Padova
34 C(~) Institute of Physics, Prague
35 C-----------------------------------------------------------------------
36 C Version 6.507 - 8th March 2005
37 C-----------------------------------------------------------------------
40 C G.Corcella, I.G.Knowles, G.Marchesini, S.Moretti, K.Odagiri,
41 C P.Richardson, M.H.Seymour and B.R.Webber, JHEP 0101 (2001) 010
43 C G.Marchesini, B.R.Webber, G.Abbiendi, I.G.Knowles, M.H.Seymour,
44 C and L.Stanco, Computer Physics Communications 67 (1992) 465.
45 C-----------------------------------------------------------------------
46 C Please see the official HERWIG information page:
47 C http://hepwww.rl.ac.uk/theory/seymour/herwig/
48 C-----------------------------------------------------------------------
50 *CMZ :- -03/07/01 17.07.47 by Bryan Webber
51 *-- Author : Bryan Webber
52 C-----------------------------------------------------------------------
53 FUNCTION CIRCEE (X1, X2)
54 C-----------------------------------------------------------------------
55 C DUMMY FUNCTION: DELETE AND SET CIRCOP NON-ZERO
56 C IN MAIN PROGRAM IF YOU USE CIRCE BEAM SPECTRUM PACKAGE
57 C-----------------------------------------------------------------------
58 DOUBLE PRECISION CIRCEE, X1, X2
60 10 FORMAT(/10X,'CIRCEE CALLED BUT NOT LINKED')
65 *CMZ :- -03/07/01 17.07.47 by Bryan Webber
66 *-- Author : Bryan Webber
67 C-----------------------------------------------------------------------
68 SUBROUTINE CIRCES (XX1M, XX2M, XROOTS, XACC, XVER, XREV, XCHAT)
69 C-----------------------------------------------------------------------
70 C DUMMY SUBROUTINE: DELETE AND SET CIRCOP NON-ZERO
71 C IN MAIN PROGRAM IF YOU USE CIRCE BEAM SPECTRUM PACKAGE
72 C-----------------------------------------------------------------------
73 DOUBLE PRECISION XX1M, XX2M, XROOTS
74 INTEGER XACC, XVER, XREV, XCHAT
76 10 FORMAT(/10X,'CIRCES CALLED BUT NOT LINKED')
80 *CMZ :- -03/07/01 17.07.47 by Bryan Webber
81 *-- Author : Bryan Webber
82 C-----------------------------------------------------------------------
83 FUNCTION CIRCGG (X1, X2)
84 C-----------------------------------------------------------------------
85 C DUMMY FUNCTION: DELETE AND SET CIRCOP NON-ZERO
86 C IN MAIN PROGRAM IF YOU USE CIRCE BEAM SPECTRUM PACKAGE
87 C-----------------------------------------------------------------------
88 DOUBLE PRECISION CIRCGG, X1, X2
90 10 FORMAT(/10X,'CIRCGG CALLED BUT NOT LINKED')
95 *CMZ :- -28/01/92 12.34.44 by Mike Seymour
96 *-- Author : Luca Stanco
97 C-----------------------------------------------------------------------
98 SUBROUTINE DECADD(LOGI)
99 C-----------------------------------------------------------------------
100 C DUMMY SUBROUTINE: DELETE AND SET BDECAY='CLEO'
101 C IN MAIN PROGRAM IF YOU USE CLEO DECAY PACKAGE
102 C-----------------------------------------------------------------------
105 10 FORMAT(/10X,'DECADD CALLED BUT NOT LINKED')
109 *CMZ :- -17/10/01 10.03.37 by Peter Richardson
110 *-- Author : Peter Richardson
111 C-----------------------------------------------------------------------
112 SUBROUTINE DEXAY(IMODE,POL)
113 C-----------------------------------------------------------------------
114 C DUMMY SUBROUTINE: DELETE AND SET TAUDEC='TAUOLA'
115 C IN MAIN PROGRAM IF YOU USE TAUOLA DECAY PACKAGE
116 C-----------------------------------------------------------------------
121 10 FORMAT(/10X,'DEXAY CALLED BUT NOT LINKED')
125 *CMZ :- -28/01/92 12.34.44 by Mike Seymour
126 *-- Author : Luca Stanco
127 C-----------------------------------------------------------------------
129 C-----------------------------------------------------------------------
130 C DUMMY SUBROUTINE: DELETE AND SET BDECAY='EURO'
131 C IN MAIN PROGRAM IF YOU USE EURODEC DECAY PACKAGE
132 C-----------------------------------------------------------------------
134 10 FORMAT(/10X,'EUDINI CALLED BUT NOT LINKED')
138 *CMZ :- -17/10/01 09:42:21 by Peter Richardson
139 *-- Author : Martin W. Gruenewald
140 C-----------------------------------------------------------------------
141 SUBROUTINE FILHEP(N,IST,ID,JMO1,JMO2,JDA1,JDA2,P4,PINV,PHFLAG)
142 C ----------------------------------------------------------------------
143 C this subroutine fills one entry into the HEPEVT common
144 C and updates the information for affected mother entries
147 C written by Martin W. Gruenewald (91/01/28)
148 C ----------------------------------------------------------------------
149 INCLUDE 'HERWIG65.INC'
151 COMMON /PHORAD/ QEDRAD(NMXHEP)
152 INTEGER N,IHEP,IST,ID,JMO1,JMO2,JDA1,JDA2,I,IP
161 ELSE IF (N.GT.0) THEN
169 IF ((IHEP.LE.0).OR.(IHEP.GT.NMXHEP)) RETURN
175 IF(JMO1.LT.0)JMOHEP(1,IHEP)=JMOHEP(1,IHEP)+IHEP
177 IF(JMO2.LT.0)JMOHEP(2,IHEP)=JMOHEP(2,IHEP)+IHEP
182 C KORAL-B and KORAL-Z do not provide vertex and/or lifetime informations
189 DO IP=JMOHEP(1,IHEP),JMOHEP(2,IHEP)
191 C if there is a daughter at IHEP, mother entry at IP has decayed
192 IF(ISTHEP(IP).EQ.1)ISTHEP(IP)=2
193 C and daughter pointers of mother entry must be updated
194 IF(JDAHEP(1,IP).EQ.0)THEN
198 JDAHEP(2,IP)=MAX(IHEP,JDAHEP(2,IP))
205 *CMZ :- -28/01/92 12.34.44 by Mike Seymour
206 *-- Author : Luca Stanco
207 C-----------------------------------------------------------------------
208 SUBROUTINE FRAGMT(I,J,K)
209 C-----------------------------------------------------------------------
210 C DUMMY SUBROUTINE: DELETE AND SET BDECAY='EURO'
211 C IN MAIN PROGRAM IF YOU USE EURODEC DECAY PACKAGE
212 C-----------------------------------------------------------------------
215 10 FORMAT(/10X,'FRAGMT CALLED BUT NOT LINKED')
219 *CMZ :- -28/01/92 12.34.44 by Mike Seymour
220 *-- Author : Mike Seymour
221 C-----------------------------------------------------------------------
223 C-----------------------------------------------------------------------
224 C DUMMY ROUTINE: DELETE IF YOU LINK TO BARYON NUMBER VIOLATN PACKAGE
225 C-----------------------------------------------------------------------
227 10 FORMAT(/10X,'HVCBVI CALLED BUT NOT LINKED')
231 *CMZ :- -28/01/92 12.34.44 by Mike Seymour
232 *-- Author : Mike Seymour
233 C-----------------------------------------------------------------------
235 C-----------------------------------------------------------------------
236 C DUMMY ROUTINE: DELETE IF YOU LINK TO BARYON NUMBER VIOLATN PACKAGE
237 C-----------------------------------------------------------------------
239 10 FORMAT(/10X,'HERBVI CALLED BUT NOT LINKED')
243 *CMZ :- -26/04/91 11.11.54 by Bryan Webber
244 *-- Author : Ian Knowles
245 C-----------------------------------------------------------------------
246 SUBROUTINE HWBAZF(IPAR,JPAR,VEC1,VEC2,VEC3,VEC)
247 C-----------------------------------------------------------------------
248 C Azimuthal correlation functions for Collins' algorithm,
249 C see I.G.Knowles, Comp. Phys. Comm. 58 (90) 271 for notation.
250 C-----------------------------------------------------------------------
251 INCLUDE 'HERWIG65.INC'
252 DOUBLE PRECISION Z1,Z2,DOT12,DOT23,DOT31,TR,FN(7),VEC1(2),VEC2(2),
256 IF (.NOT.AZSPIN) RETURN
257 Z1=PPAR(4,JPAR)/PPAR(4,IPAR)
259 GLUI=IDPAR(IPAR).EQ.13
260 GLUJ=IDPAR(JPAR).EQ.13
267 FN(1)=FN(2)+FN(3)+FN(4)
272 C Branching: g--->qqbar
273 FN(1)=(Z1*Z1+Z2*Z2)/2.
284 FN(1)=(1.+Z2*Z2)/(2.*Z1)
293 FN(1)=(1.+Z1*Z1)/(2.*Z2)
302 DOT12=VEC1(1)*VEC2(1)+VEC1(2)*VEC2(2)
303 DOT23=VEC2(1)*VEC3(1)+VEC2(2)*VEC3(2)
304 DOT31=VEC3(1)*VEC1(1)+VEC3(2)*VEC1(2)
305 TR=1./(FN(1)+FN(2)*DOT23+FN(3)*DOT31+FN(4)*DOT12)
306 VEC(1)=((FN(2)+FN(5)*DOT23)*VEC1(1)
307 & +(FN(3)+FN(6)*DOT31)*VEC2(1)
308 & +(FN(4)+FN(7)*DOT12)*VEC3(1))*TR
309 VEC(2)=((FN(2)+FN(5)*DOT23)*VEC1(2)
310 & +(FN(3)+FN(6)*DOT31)*VEC2(2)
311 & +(FN(4)+FN(7)*DOT12)*VEC3(2))*TR
314 *CMZ :- -11/10/01 12.01.52 by Peter Richardson
315 *-- Author : Bryan Webber
316 C-----------------------------------------------------------------------
318 C-----------------------------------------------------------------------
319 C MAKES COLOUR CONNECTIONS BETWEEN JETS
320 C MODIFIED 12/10/97 BY BRW FOR SUSY PROCESSES
321 C MODIFIED 11/01/01 BY PR FOR SPIN CORRELATIONS(PROBLEM WITH ORDER
323 C NEW VARAIBLE BACK TO ALLOW CODE TO SEARCH DOWN CHAIN
324 C-----------------------------------------------------------------------
325 INCLUDE 'HERWIG65.INC'
326 INTEGER IHEP,IST,ID,JC,KC,JD,JHEP,LHEP,ID2,NTRY,KHEP
328 IF (IERROR.NE.0) RETURN
336 C---LOOK FOR PARTONS WITHOUT COLOUR MOTHERS
337 IF (IST.LT.145.OR.IST.GT.152) GOTO 20
338 51 IF (JMOHEP(2,IHEP).EQ.0.OR.BACK.OR.
339 & ISTHEP(JMOHEP(2,IHEP)).EQ.155) THEN
340 C---FIND COLOUR-CONNECTED PARTON
342 IF(JMOHEP(2,IHEP).EQ.0) THEN
344 IF (IST.NE.152) JC=JMOHEP(1,JC)
350 IF (JC.EQ.0) CALL HWWARN('HWBCON',51,*20)
351 C---FIND SPECTATOR WHEN JC IS DECAYED HEAVY QUARK OR SUSY PARTICLE
352 52 IF (ISTHEP(JC).EQ.155.OR.BACK) THEN
353 IF (IDHEP(JMOHEP(1,JC)).EQ.94.OR.BACK) THEN
354 C---DECAYED BEFORE HADRONIZING
355 IF(BACK.OR.(JMOHEP(2,IHEP).NE.0.AND.
356 & ISTHEP(JMOHEP(2,IHEP)).EQ.155)) GOTO 53
358 C--new bit to try and fix the problems for spin correlations
359 C--move one step further up the tree and hope this helps
365 IF(JHEP.NE.0.AND.ISTHEP(JHEP).EQ.155)
366 & JHEP = JMOHEP(2,JHEP)
367 IF(JHEP.EQ.0.AND.NTRY.LT.NHEP) GOTO 1
368 IF(NHEP.EQ.NTRY) GOTO 20
371 IF (ISTHEP(JHEP).EQ.155) THEN
372 C---SPECIAL FOR GLUINO DECAYS
375 C---N.B. WILL NEED MODS WHEN SUSY PARTICLES CAN SHOWER
376 IF (ID.EQ.449.OR.ID.EQ.13.OR.
377 & (ID.GE.401.AND.ID.LE.406).OR.
378 & (ID.GE.413.AND.ID.LE.418).OR.
379 & ID.LE.6.OR.(ID.GE.115.AND.ID.LE.120)) THEN
380 C---LOOK FOR ANTI(S)QUARK OR GLUON
381 DO KC=JDAHEP(1,JHEP),JDAHEP(2,JHEP)
383 IF ((ID.GE. 7.AND.ID.LE. 13).OR.
384 & (ID.GE.407.AND.ID.LE.412).OR.
385 & (ID.GE.419.AND.ID.LE.424)) GOTO 5
388 C---LOOK FOR (S)QUARK OR GLUON
389 DO KC=JDAHEP(1,JHEP),JDAHEP(2,JHEP)
391 IF (ID.LE. 6.OR. ID.EQ. 13.OR.
392 & (ID.GE.401.AND.ID.LE.406).OR.
393 & (ID.GE.413.AND.ID.LE.418)) GOTO 5
397 CALL HWWARN('HWBCON',101,*999)
400 C--PR MOD 30/6/99 should fix HWCFOR 104 errors
402 IF(IDHW(JDAHEP(1,JHEP)).EQ.449.AND.
403 & (ID2.LE.6.OR.(ID2.GE.115.AND.ID2.LE.120).OR.
404 & (ID2.GE.401.AND.ID2.LE.406).OR.ID2.EQ.13.OR.
405 & (ID2.GE.413.AND.ID2.LE.418).OR.ID2.EQ.449)) THEN
408 C--modifcation for top ME correction (modified for additional photon radiation)
409 IF(IDHW(JHEP).EQ.6) THEN
410 JC = JDAHEP(1,JHEP)+1
412 JC = JDAHEP(1,JHEP)+1
413 IF(IDHW(JDAHEP(1,JHEP)+2).EQ.13) JC=JC+1
417 ELSEIF (ID.EQ.6.OR.ID.EQ.12.OR.
418 & (ID.GE.209.AND.ID.LE.218).OR.
419 & (ID.GE.401.AND.ID.LE.424).OR.ID.EQ.449) THEN
420 C Wait for partner heavy quark to decay
422 C---N.B. MAY BE A PROBLEM HERE
435 C---SEARCH IN CORRESPONDING JET
439 IF (ISTHEP(JHEP).LT.145.OR.ISTHEP(JHEP).GT.152) GOTO 10
440 IF (JDAHEP(2,JHEP).EQ.IHEP) LHEP=JHEP
441 IF (JDAHEP(2,JHEP).NE.0) GOTO 10
442 C---JOIN IHEP AND JHEP
451 C--search down the tree
453 IF(ISTHEP(KHEP).EQ.3.AND.ISTHEP(JDAHEP(1,KHEP)).EQ.155) THEN
454 JHEP = JDAHEP(1,KHEP)
459 C---DIDN'T FIND PARTNER OF IHEP YET
460 C CALL HWWARN('HWBCON',52,*20)
464 C---BREAK COLOUR CONNECTIONS WITH PHOTONS
466 30 IF (IHEP.LE.NHEP) THEN
467 IF (IDHW(IHEP).EQ.59 .AND. ISTHEP(IHEP).EQ.149) THEN
469 IF (JMOHEP(2,IHEP).NE.0) THEN
470 IF (JDAHEP(2,JMOHEP(2,IHEP)).EQ.IHEP)
471 & JDAHEP(2,JMOHEP(2,IHEP))=JDAHEP(2,IHEP)
474 IF (JDAHEP(2,IHEP).NE.0) THEN
475 IF (JMOHEP(2,JDAHEP(2,IHEP)).EQ.IHEP)
476 & JMOHEP(2,JDAHEP(2,IHEP))=JMOHEP(2,IHEP)
486 *CMZ :- -22/04/96 13.54.08 by Mike Seymour
487 *-- Author : Mike Seymour
488 C-----------------------------------------------------------------------
489 SUBROUTINE HWBDED(IOPT)
490 C FILL MISSING AREA OF DALITZ PLOT WITH 3-JET AND 2-JET+GAMMA EVENTS
491 C IF (IOPT.EQ.1) SET UP EVENT RECORD
492 C IF (IOPT.EQ.2) CLEAN UP EVENT RECORD AFTER SHOWERING
494 C********MODIFIED 13/11/00 BY BRW TO ALLOW MULTIPLE APPLICATION IN
495 C*******SAME EVENT (FOR WW AND ZZ) N.B. NO CLEANUP CALLS FOR THESE!
496 C-----------------------------------------------------------------------
497 INCLUDE 'HERWIG65.INC'
498 DOUBLE PRECISION HWBVMC,HWRGEN,HWUALF,HWUSQR,X(3),W,WMAX,WSUM,
499 & X1MIN,X1MAX,X2MIN,X2MAX,QSCALE,GAMFAC,GLUFAC,R(3,3),CS,SN,M(3),
500 & E(3),LAMBDA,A,B,C,PTSQ,EM,P1(5),P2(5),PVRT(4),EPS,MASDEP
501 INTEGER ID,ID3,EMIT,NOEMIT,IEVT,IHEP,JHEP,KHEP,ICMF,IOPT,IEDT(3),
502 & I,NDEL,LHEP,IP,JP,KP,IDUN
503 EXTERNAL HWBVMC,HWRGEN,HWUALF,HWUSQR
505 DATA WSUM,WMAX,X1MIN,X1MAX,EMIT,ICMF,IEVT
506 & /0.994651D0,1.84096D0,0.0D0,0.773459D0,3*0.0D0/
507 LAMBDA(A,B,C)=(A**2+B**2+C**2-2*A*B-2*B*C-2*C*A)/(4*A)
509 C---FIND AN UNTREATED CMF
510 IF (IEVT.EQ.NEVHEP+NWGTS) RETURN
514 DO 10 IHEP=IDUN+1,NHEP
515 10 IF (ICMF.EQ.IDUN .AND. ISTHEP(IHEP).EQ.110 .AND.
516 & JDAHEP(2,IHEP).EQ.JDAHEP(1,IHEP)+1) ICMF=IHEP
517 IF (ICMF.EQ.IDUN) RETURN
519 IF (EM.LT.2*HWBVMC(1)) GOTO 5
520 C---ONLY APPLY THE CORRECTION TO HADRONIC DECAYS
521 IF (IDHW(JDAHEP(1,ICMF)).GT.12) GOTO 5
522 C---GENERATE X1,X2 ACCORDING TO 1/((1-X1)*(1-X2))
525 X(1)=1-(1-X1MAX)*((1-X1MIN)/(1-X1MAX))**HWRGEN(0)
527 X2MIN=MAX(X(1),1-X(1))
528 X2MAX=(4*X(1)-3+2*DREAL( DCMPLX( X(1)**3+135*(X(1)-1)**3,
529 & 3*HWUSQR(3*(128*X(1)**4-368*X(1)**3+405*X(1)**2-216*X(1)+54))*
530 & (X(1)-1) )**(1./3) ))/3
531 IF (X2MAX.GE.ONE.OR.X2MIN.GE.ONE.OR.X2MAX.LE.X2MIN) GOTO 100
532 X(2)=1-(1-X2MAX)*((1-X2MIN)/(1-X2MAX))**HWRGEN(1)
534 W=2 * LOG((1-X1MIN)/(1-X1MAX))*LOG((1-X2MIN)/(1-X2MAX)) *
536 C---GENERATE UNWEIGHTED (X1,X2) PAIRS (EFFICIENCY IS ~50%)
537 IF (WMAX*HWRGEN(2).GT.W) GOTO 100
540 IF (HWRGEN(5).GT.HALF) THEN
544 C---CHOOSE WHICH PARTON WILL EMIT
546 IF (HWRGEN(6).LT.X(1)**2/(X(1)**2+X(2)**2)) EMIT=2
548 IHEP=JDAHEP( EMIT,ICMF)
549 JHEP=JDAHEP(NOEMIT,ICMF)
550 C---PREFACTORS FOR GAMMA AND GLUON CASES
551 QSCALE=HWUSQR((1-X(1))*(1-X(2))*(1-X(3)))*EM/X(NOEMIT)
552 ID=IDHW(JDAHEP(1,ICMF))
553 GAMFAC=ALPFAC*ALPHEM*ICHRG(ID)**2/(18*PIFAC)
555 IF (QSCALE.GT.HWBVMC(13))
556 & GLUFAC=CFFAC/(2*PIFAC)*HWUALF(1,QSCALE)
557 C---SWITCH OFF PHOTON EMISSION IN W DECAYS (THE M-E DOES NOT FACTORIZE)
558 IF (ICHRG(IDHW(ICMF)).NE.0) GAMFAC=0
559 C---IN FRACTION FAC*WSUM OF EVENTS ADD A GAMMA/GLUON
560 IF (GAMFAC*WSUM .GT. HWRGEN(3)) THEN
562 ELSEIF (GLUFAC*WSUM .GT. HWRGEN(4)) THEN
568 C---CHECK INFRA-RED CUT-OFF FOR GAMMA/GLUON
569 M(EMIT)=PHEP(5,IHEP)+VQCUT
570 M(NOEMIT)=PHEP(5,JHEP)+VQCUT
572 E(1)=HALF*EM*(X(1)+(M(1)**2-M(2)**2-M(3)**2)/EM**2)
573 E(2)=HALF*EM*(X(2)+(M(2)**2-M(3)**2-M(1)**2)/EM**2)
575 PTSQ=-LAMBDA(E(NOEMIT)**2-M(NOEMIT)**2,E(3)**2-M(3)**2,
576 & E(EMIT)**2-M(EMIT)**2)
577 IF (PTSQ.LE.ZERO .OR.
578 $ E(1).LE.M(1).OR.E(2).LE.M(2).OR.E(3).LE.M(3)) THEN
582 C---CALCULATE MASS-DEPENDENT SUPRESSION
583 IF (MOD(IPROC,10).GT.0) THEN
584 EPS=(RMASS(ID)/EM)**2
585 MASDEP=X(1)**2+X(2)**2
586 $ -4*EPS*X(3)-2*EPS*((1-X(2))/(1-X(1))+(1-X(1))/(1-X(2)))
587 $ -4*EPS**2*X(3)**2/((1-X(1))*(1-X(2)))
588 IF (MASDEP.LT.HWRGEN(7)*(X(1)**2+X(2)**2)) THEN
593 C---STORE OLD MOMENTA
594 CALL HWVEQU(5,PHEP(1,JDAHEP(1,ICMF)),P1)
595 CALL HWVEQU(5,PHEP(1,JDAHEP(2,ICMF)),P2)
596 C---GET THE NON-EMITTING PARTON'S CMF DIRECTION
597 CALL HWULOF(PHEP(1,ICMF),PHEP(1,JHEP),PHEP(1,JHEP))
598 CALL HWRAZM(ONE,CS,SN)
599 CALL HWUROT(PHEP(1,JHEP),CS,SN,R)
601 M(NOEMIT)=PHEP(5,JHEP)
605 IF (NHEP.GT.KHEP) THEN
606 C---MOVE UP REST OF EVENT
609 ISTHEP(JP)= ISTHEP(IP)
616 IF (JDAHEP(1,KP).EQ.IP) JDAHEP(1,KP)=JP
617 IF (JDAHEP(2,KP).EQ.IP) JDAHEP(2,KP)=JP
621 IF (KP.GT.KHEP) KP=KP+1
624 IF (KP.GT.KHEP) KP=KP+1
627 IF (KP.GT.KHEP) KP=KP+1
629 CALL HWVEQU(5,PHEP(1,IP),PHEP(1,JP))
630 CALL HWVEQU(4,VHEP(1,IP),VHEP(1,JP))
633 C---REORDER ENTRIES: IHEP=EMITTER, JHEP=NON-EMITTER, KHEP=EMITTED
635 IF (IDHW(IHEP).LT.IDHW(JHEP)) THEN
643 PHEP(5,JHEP)=M(NOEMIT)
646 PHEP(4,JHEP)=HALF*EM*(X(NOEMIT)+
647 & (M(NOEMIT)**2-M(EMIT)**2-M(3)**2)/EM**2)
648 PHEP(4,IHEP)=HALF*EM*(X(EMIT)+
649 & (M(EMIT)**2-M(NOEMIT)**2-M(3)**2)/EM**2)
650 PHEP(4,KHEP)=EM-PHEP(4,IHEP)-PHEP(4,JHEP)
651 PHEP(3,JHEP)=HWUSQR(PHEP(4,JHEP)**2-PHEP(5,JHEP)**2)
652 PHEP(3,IHEP)=( (PHEP(4,KHEP)**2-PHEP(5,KHEP)**2) -
653 & (PHEP(4,IHEP)**2-PHEP(5,IHEP)**2) -
654 & (PHEP(3,JHEP)**2) )*HALF/PHEP(3,JHEP)
655 PHEP(3,KHEP)=-PHEP(3,IHEP)-PHEP(3,JHEP)
660 PHEP(1,IHEP)=HWUSQR(PHEP(4,IHEP)**2-
661 & PHEP(3,IHEP)**2-PHEP(5,IHEP)**2)
662 PHEP(1,KHEP)=-PHEP(1,IHEP)
663 C---ORIENT IN CMF, THEN BOOST TO LAB
664 CALL HWUROB(R,PHEP(1,IHEP),PHEP(1,IHEP))
665 CALL HWUROB(R,PHEP(1,JHEP),PHEP(1,JHEP))
666 CALL HWUROB(R,PHEP(1,KHEP),PHEP(1,KHEP))
667 CALL HWULOB(PHEP(1,ICMF),PHEP(1,IHEP),PHEP(1,IHEP))
668 CALL HWULOB(PHEP(1,ICMF),PHEP(1,JHEP),PHEP(1,JHEP))
669 CALL HWULOB(PHEP(1,ICMF),PHEP(1,KHEP),PHEP(1,KHEP))
670 C---CALCULATE PRODUCTION VERTICES
671 CALL HWVZRO(4,VHEP(1,JHEP))
672 CALL HWVSUM(4,PHEP(1,IHEP),PHEP(1,KHEP),PVRT)
673 CALL HWUDKL(ID,PVRT,VHEP(1,KHEP))
674 CALL HWVEQU(4,VHEP(1,KHEP),VHEP(1,IHEP))
675 C---REORDER ENTRIES: IHEP=QUARK, JHEP=ANTI-QUARK, KHEP=EMITTED
676 IF (IHEP.EQ.LHEP) THEN
680 C---STATUS, ID AND POINTERS
682 IDHW(JHEP)=IDHW(KHEP)
683 IDHEP(JHEP)=IDHEP(KHEP)
685 IDHEP(KHEP)=IDPDG(ID3)
689 C---COLOUR CONNECTIONS AND GLUON POLARIZATION
697 GPOLN=((1-X(1))**2+(1-X(2))**2)/(4*(1-X(3)))
707 ELSEIF (IOPT.EQ.2) THEN
708 C---MAKE THREE-JET EVENTS FROM THE `DEAD-ZONE' LOOK LIKE TWO-JET EVENTS
709 IF (EMIT.EQ.0.OR.IEVT.NE.NEVHEP+NWGTS) THEN
711 ELSEIF (EMIT.EQ.1) THEN
712 IHEP=JDAHEP(1,JDAHEP(1,ICMF)+1)
713 JHEP=JDAHEP(1,JDAHEP(1,ICMF))
715 IHEP=JDAHEP(1,JDAHEP(2,ICMF))
716 JHEP=JDAHEP(1,JDAHEP(1,ICMF)+1)
717 JDAHEP(1,JDAHEP(2,ICMF))=JHEP
718 IDHW(JHEP)=IDHW(IHEP)
719 IF (ISTHEP(IHEP+1).EQ.100 .AND. ISTHEP(JHEP+1).EQ.100)
720 & CALL HWVEQU(5,PHEP(1,IHEP+1),PHEP(1,JHEP+1))
722 JMOHEP(2,JDAHEP(1,ICMF))=JDAHEP(2,ICMF)
723 JDAHEP(2,JDAHEP(1,ICMF))=JDAHEP(2,ICMF)
724 JMOHEP(2,JDAHEP(2,ICMF))=JDAHEP(1,ICMF)
725 JDAHEP(2,JDAHEP(2,ICMF))=JDAHEP(1,ICMF)
726 CALL HWVEQU(5,P1,PHEP(1,JDAHEP(1,ICMF)))
727 CALL HWVEQU(5,P2,PHEP(1,JDAHEP(2,ICMF)))
728 CALL HWVSUM(4,PHEP(1,IHEP),PHEP(1,JHEP),PHEP(1,JHEP))
729 CALL HWUMAS(PHEP(1,JHEP))
730 JDAHEP(2,JHEP)=JDAHEP(2,IHEP)
731 IEDT(1)=JDAHEP(1,ICMF)+1
735 IF (ISTHEP(IHEP+1).NE.100) NDEL=2
736 CALL HWUEDT(NDEL,IEDT)
738 IHEP=JDAHEP(1,JDAHEP(I,ICMF))
739 JMOHEP(1,IHEP)=JDAHEP(I,ICMF)
740 IF (ISTHEP(IHEP+1).EQ.100) THEN
741 JMOHEP(1,IHEP+1)=JMOHEP(1,IHEP)
742 JMOHEP(2,IHEP+1)=JMOHEP(2,JMOHEP(1,IHEP))
744 DO 400 JHEP=JDAHEP(1,IHEP),JDAHEP(2,IHEP)
747 CALL HWVZRO(4,VHEP(1,JDAHEP(I,ICMF)))
748 CALL HWVZRO(4,VHEP(1,IHEP))
749 IF (ISTHEP(IHEP+1).EQ.100) CALL HWVZRO(4,VHEP(1,IHEP+1))
754 CALL HWWARN('HWBDED',500,*999)
758 *CMZ :- -17/05/94 09.33.08 by Mike Seymour
759 *-- Author : Mike Seymour
760 C-----------------------------------------------------------------------
761 SUBROUTINE HWBDIS(IOPT)
762 C-----------------------------------------------------------------------
763 C FILL MISSING AREA OF DIS PHASE-SPACE WITH 2+1-JET EVENTS
764 C IF (IOPT.EQ.1) SET UP EVENT RECORD
765 C IF (IOPT.EQ.2) CLEAN UP EVENT RECORD AFTER SHOWERING
766 C-----------------------------------------------------------------------
767 INCLUDE 'HERWIG65.INC'
768 DOUBLE PRECISION HWRGEN,HWBVMC,HWUALF,HWULDO,P1(5),P2(5),P3(5),
769 & PCMF(5),L(5),R(3,3),Q,XBJ,RN,XPMIN,XPMAX,XP,ZPMIN,ZPMAX,ZP,FAC,
770 & X1,X2,XTSQ,XT,PTSQ,SIN1,SIN2,W1,W2,CFAC,PDFOLD(13),PDFNEW(13),
771 & PHI,SCALE,Q1(5),Q2(5),DIR1,DIR2,DIR,PM(5),POLD,PNEW,COMINT,
772 & BGFINT,COMWGT,C1,C2,CM,B1,B2,BM,PVRT(4)
773 INTEGER IOPT,EMIT,ICMF,IHEP,JHEP,IIN,IOUT,ILEP,IHAD,ID,IDNEW,
774 & IEDT(3),NDEL,NTRY,ITEMP
776 EXTERNAL HWRGEN,HWBVMC,HWUALF,HWULDO
777 SAVE BGF,IIN,IOUT,ICMF,ID,Q1,Q2,XP,XBJ
778 DATA EMIT,COMINT,BGFINT,COMWGT/0D0,3.9827D0,1.2462D0,0.3D0/
779 DATA C1,C2,CM,B1,B2,BM/0.56D0,0.20D0,10D0,0.667D0,0.167D0,3D0/
780 IF (IERROR.NE.0) RETURN
782 C---FIND AN UNTREATED CMF
783 IF (EMIT.EQ.NEVHEP+NWGTS) RETURN
786 10 IF (ICMF.EQ.0 .AND. ISTHEP(IHEP).EQ.110 .AND.
787 & JDAHEP(2,IHEP).EQ.JDAHEP(1,IHEP)+1) ICMF=IHEP
788 IF (ICMF.EQ.0) RETURN
792 CALL HWVEQU(5,PHEP(1,IIN),P1)
793 CALL HWVEQU(5,PHEP(1,IOUT),P2)
794 CALL HWVEQU(5,PHEP(1,ILEP),L)
796 IF (JDAHEP(1,IHAD).NE.0) IHAD=JDAHEP(1,IHAD)
798 C---STORE OLD MOMENTA
801 C---BOOST AND ROTATE THE MOMENTA TO THE BREIT FRAME
802 CALL HWVDIF(4,P2,P1,PCMF)
804 CALL HWVEQU(5,PHEP(1,IHAD),PM)
806 XBJ=HALF*Q**2/HWULDO(PM,PCMF)
807 CALL HWVSCA(4,HALF/XBJ,PCMF,PCMF)
808 CALL HWVSUM(4,PM,PCMF,PCMF)
810 CALL HWULOF(PCMF,L,L)
811 CALL HWULOF(PCMF,PM,PM)
812 CALL HWUROT(PM,ONE,ZERO,R)
815 CALL HWUROT(PM,COS(PHI),SIN(PHI),R)
816 C---CHOOSE THE HADRONIC-PLANE CONFIGURATION, XP,ZP
817 IF (HWRGEN(0).LT.COMWGT) THEN
818 C-----CONSIDER GENERATING A QCD COMPTON EVENT
826 FAC=1/C1*2*XPMAX/((1-XP)*(1-ZP))*
827 $ (1+(1-XP-ZP+2*XP*ZP)**2+2*(1-XP)*(1-ZP)*XP*ZP)
828 IF (HWRGEN(4).LT.HALF) THEN
833 ELSEIF (RN.LT.C1+C2) THEN
837 ZPMAX=1-2./3.*XP*(1+DREAL( DCMPLX(10-45*XP+18*XP**2,3*SQRT(
838 $ 3*(9+66*XP-93*XP**2+12*XP**3-8*XP**4+24*XP**5-8*XP**6)))
839 $ **(1./3.) * DCMPLX(0.5D0,0.86602540378444D0) ))
840 ZP=1-((1-ZPMIN)/(1-ZPMAX))**HWRGEN(4)*(1-ZPMAX)
841 FAC=1/C2*XPMAX*LOG((1-ZPMIN)/(1-ZPMAX))/(1-XP)*
842 $ (1+(1-XP-ZP+2*XP*ZP)**2+2*(1-XP)*(1-ZP)*XP*ZP)
847 XPMAX=(1+4*ZP*(1-ZP))/(1+6*ZP*(1-ZP))
848 XP=1-((1-XPMIN)/(1-XPMAX))**HWRGEN(4)*(1-XPMAX)
849 FAC=1/(1-C1-C2)*ZPMAX*LOG((1-XPMIN)/(1-XPMAX))/(1-ZP)*
850 $ (1+(1-XP-ZP+2*XP*ZP)**2+2*(1-XP)*(1-ZP)*XP*ZP)
852 XPMAX=(1+4*ZP*(1-ZP))/(1+6*ZP*(1-ZP))
853 ZPMAX=1-2./3.*XP*(1+DREAL( DCMPLX(10-45*XP+18*XP**2,3*SQRT(
854 $ 3*(9+66*XP-93*XP**2+12*XP**3-8*XP**4+24*XP**5-8*XP**6)))
855 $ **(1./3.) * DCMPLX(0.5D0,0.86602540378444D0) ))
856 IF (XP.GT.XPMAX.OR.ZP.GT.ZPMAX.OR.CM*HWRGEN(4).GT.FAC)
859 C-----CONSIDER GENERATING A BGF EVENT
868 FAC=1/B1*2*XPMAX/(1-ZP)*
869 $ (( XP+ZP-2*XP*ZP)**2+2*(1-XP)*(1-ZP)*XP*ZP
870 $ +(1-XP-ZP+2*XP*ZP)**2+2*(1-XP)*(1-ZP)*XP*ZP)
871 IF (HWRGEN(4).LT.HALF) XP=1-XP
872 ELSEIF (RN.LT.B1+B2) THEN
876 ZPMAX=1-2./3.*XP*(1+DREAL( DCMPLX(10-45*XP+18*XP**2,3*SQRT(
877 $ 3*(9+66*XP-93*XP**2+12*XP**3-8*XP**4+24*XP**5-8*XP**6)))
878 $ **(1./3.) * DCMPLX(0.5D0,0.86602540378444D0) ))
879 ZP=1-((1-ZPMIN)/(1-ZPMAX))**HWRGEN(4)*(1-ZPMAX)
880 FAC=1/B2*XPMAX*LOG((1-ZPMIN)/(1-ZPMAX))*
881 $ (( XP+ZP-2*XP*ZP)**2+2*(1-XP)*(1-ZP)*XP*ZP
882 $ +(1-XP-ZP+2*XP*ZP)**2+2*(1-XP)*(1-ZP)*XP*ZP)
887 ZPMIN=2./3.*XP*(1+DREAL( DCMPLX(10-45*XP+18*XP**2,3*SQRT(
888 $ 3*(9+66*XP-93*XP**2+12*XP**3-8*XP**4+24*XP**5-8*XP**6)))
889 $ **(1./3.) * DCMPLX(0.5D0,0.86602540378444D0) ))
890 ZP=(ZPMAX-ZPMIN)*HWRGEN(4)+ZPMIN
891 FAC=1/(1-B1-B2)*XPMAX*(ZPMAX-ZPMIN)/(1-ZP)*
892 $ (( XP+ZP-2*XP*ZP)**2+2*(1-XP)*(1-ZP)*XP*ZP
893 $ +(1-XP-ZP+2*XP*ZP)**2+2*(1-XP)*(1-ZP)*XP*ZP)
895 ZPMAX=1-2./3.*XP*(1+DREAL( DCMPLX(10-45*XP+18*XP**2,3*SQRT(
896 $ 3*(9+66*XP-93*XP**2+12*XP**3-8*XP**4+24*XP**5-8*XP**6)))
897 $ **(1./3.) * DCMPLX(0.5D0,0.86602540378444D0) ))
898 IF (ZP.GT.ZPMAX.OR.ZP.LT.ONE-ZPMAX.OR.BM*HWRGEN(4).GT.FAC)
901 C---CALCULATE THE ADDITIONAL FACTORS IN THE WEIGHT
905 FAC=BGFINT/(1-COMWGT)
911 SCALE=Q*SQRT((1-XP)*(1-ZP)*ZP/XP+1)
914 CALL HWSFUN(XBJ,Q,IDHW(IHAD),NSTRU,PDFOLD,2)
916 IF (PDFOLD(ID).LE.ZERO) CALL HWWARN('HWBDIS',100,*999)
918 CALL HWSFUN(XBJ/XP,SCALE,IDHW(IHAD),NSTRU,PDFNEW,2)
919 FAC=CFAC/(2*PIFAC) * HWUALF(1,SCALE) * FAC *
920 $ PDFNEW(IDNEW)/PDFOLD(ID)
924 C---FOR PHOTON BEAMS, INCLUDE DIRECT PHOTON COUPLING
925 IF (IDHW(IHAD).EQ.59) THEN
926 ZPMIN=2./3.*XBJ*(1+DREAL( DCMPLX(10-45*XBJ+18*XBJ**2,3*SQRT(
927 $ 3*(9+66*XBJ-93*XBJ**2+12*XBJ**3-8*XBJ**4+24*XBJ**5
928 $ -8*XBJ**6)))**(1./3.)*DCMPLX(0.5D0,0.86602540378444D0) ))
930 DIR1=(XBJ**2+(1-XBJ)**2)*(LOG(ZPMAX/ZPMIN)-(ZPMAX-ZPMIN))
931 DIR2=4*XBJ*(1-XBJ)*(ZPMAX-ZPMIN)
932 DIR=QFCH(MOD(ID-1,6)+1)**2*ALPHEM/(2*PIFAC*PDFOLD(ID))*XBJ
937 C---DECIDE WHETHER TO MAKE AN EVENT HERE
938 IF (HWRGEN(4).GT.FAC+DIR) RETURN
939 C---FOR DIRECT COUPLING, CHOOSE ZP VALUE
940 IF ((FAC+DIR)*HWRGEN(8).GT.FAC) THEN
941 IF ((DIR1+DIR2)*HWRGEN(9).LT.DIR1) THEN
944 ZP=1-(ZPMAX/ZPMIN)**HWRGEN(NTRY+1)*ZPMIN
945 IF ((ZPMIN**2+(1-ZPMIN)**2)*HWRGEN(NTRY).GT.ZP**2+(1-ZP)**2)
948 ZP=SQRT((ZPMAX-ZPMIN)*HWRGEN(10)+ZPMIN**2)
957 XTSQ=4*(1-XP)*(1-ZP)*ZP/XP
959 SIN1=XT/SQRT(X1**2+XTSQ)
960 SIN2=XT/SQRT(X2**2+XTSQ)
961 C---CHOOSE THE AZIMUTH BETWEEN THE TWO PLANES
963 W1=XP**2*(X1**2+1.5*XTSQ)
967 W2=XP**2*(X2**2+1.5*XTSQ)
968 IF (HWRGEN(5)*(W1+W2).GT.W2) THEN
970 C-----WEIGHTED BY (1+SIN1*COS(PHI))**2
971 200 PHI=(2*HWRGEN(6)-1)*PIFAC
972 IF (HWRGEN(7)*(1+SIN1)**2.GT.(1+SIN1*COS(PHI))**2) GOTO 200
975 PHI=(2*HWRGEN(6)-1)*PIFAC
978 C-----WEIGHTED BY (1-SIN2*COS(PHI))**2
979 210 PHI=(2*HWRGEN(6)-1)*PIFAC
980 IF (HWRGEN(7)*(1+SIN2)**2.GT.(1-SIN2*COS(PHI))**2) GOTO 210
982 C---RECONSTRUCT MOMENTA AND BOOST BACK TO LAB
986 P1(4)=SQRT(P1(3)**2+P1(5)**2)
987 PTSQ=((ZP*Q*(P1(4)+P1(3)-Q)-P2(5)**2)*(P1(4)-P1(3)+(1-ZP)*Q)
988 $ -P3(5)**2*ZP*Q)/(P1(4)-P1(3)+Q)
989 C---CHECK INFRARED CUTOFF FOR THIS PARTON TYPE
990 IF (PTSQ.LT.MAX(HWBVMC(ID),HWBVMC(IDHW(IOUT)))**2) RETURN
991 P2(1)=SQRT(PTSQ)*COS(PHI)
992 P2(2)=SQRT(PTSQ)*SIN(PHI)
993 P2(3)=-0.5*(ZP*Q-(PTSQ+P2(5)**2)/(ZP*Q))
994 P2(4)= 0.5*(ZP*Q+(PTSQ+P2(5)**2)/(ZP*Q))
1000 CALL HWUROB(R,P2,P2)
1001 CALL HWUROB(R,P3,P3)
1002 CALL HWULOB(PCMF,P1,P1)
1003 CALL HWULOB(PCMF,P2,P2)
1004 CALL HWULOB(PCMF,P3,P3)
1005 C---SPECIAL CASE FOR DIRECT PHOTON - COPY THE EXACT BEAM MOMENTUM
1006 C---SHARE THE MISMATCH EQUALLY BETWEEN THE OUTGOING PARTONS
1007 C---AND PUT THEM BACK ON SHELL
1009 CALL HWVDIF(4,PHEP(1,IHAD),P1,PM)
1010 CALL HWVSCA(4,HALF,PM,PM)
1011 CALL HWVSUM(4,PM,P2,P2)
1012 CALL HWVSUM(4,PM,P3,P3)
1015 CALL HWVEQU(5,PHEP(1,IHAD),P1)
1016 CALL HWVSUM(4,P2,P3,PCMF)
1018 POLD=HWULDO(P2,PCMF)**2/PCMF(5)**2-SIGN(P2(5)**2,P2(5))
1019 PNEW=PCMF(5)**2/4-RMASS(ID)**2
1020 IF (PCMF(5).LE.ZERO.OR.POLD.LE.ZERO.OR.PNEW.LE.ZERO) RETURN
1021 CALL HWVSCA(4,SQRT(PNEW/POLD),P2,P2)
1022 CALL HWVSCA(4,HALF-HWULDO(P2,PCMF)/PCMF(5)**2,PCMF,PM)
1023 CALL HWVSUM(4,PM,P2,P2)
1025 CALL HWVDIF(4,PCMF,P2,P3)
1029 CALL HWVEQU(5,P1,PHEP(1,IIN))
1030 IF (BGF.AND.ID.GT.6.OR..NOT.BGF.AND.ID.LT.7) THEN
1031 CALL HWVEQU(5,P2,PHEP(1,IOUT))
1032 CALL HWVEQU(5,P3,PHEP(1,NHEP))
1034 CALL HWVEQU(5,P3,PHEP(1,IOUT))
1035 CALL HWVEQU(5,P2,PHEP(1,NHEP))
1037 CALL HWVSUM(4,PHEP(1,ILEP),PHEP(1,IIN),PHEP(1,ICMF))
1038 CALL HWUMAS(PHEP(1,ICMF))
1039 C Decide which quark radiated and assign production vertices
1041 C Boson-Gluon fusion case
1042 IF (1-ZP.LT.HWRGEN(0)) THEN
1043 C Gluon splitting to quark
1044 CALL HWVZRO(4,VHEP(1,NHEP-1))
1045 CALL HWVDIF(4,PHEP(1,NHEP-4),PHEP(1,NHEP),PVRT)
1046 CALL HWUDKL(ID,PVRT,VHEP(1,NHEP))
1047 CALL HWVEQU(4,VHEP(1,NHEP),VHEP(1,NHEP-4))
1049 C Gluon splitting to antiquark
1050 CALL HWVZRO(4,VHEP(1,NHEP))
1051 CALL HWVDIF(4,PHEP(1,NHEP-4),PHEP(1,NHEP-1),PVRT)
1052 CALL HWUDKL(ID,PVRT,VHEP(1,NHEP-1))
1053 CALL HWVEQU(4,VHEP(1,NHEP-1),VHEP(1,NHEP-4))
1057 IF (1.LT.HWRGEN(0)*(1+(1-XP-ZP)**2+6*XP*(1-XP)*ZP*(1-ZP)))THEN
1058 C Incoming quark radiated the gluon
1059 CALL HWVZRO(4,VHEP(1,NHEP-1))
1060 CALL HWVDIF(4,PHEP(1,NHEP-4),PHEP(1,NHEP),PVRT)
1061 CALL HWUDKL(ID,PVRT,VHEP(1,NHEP))
1062 CALL HWVEQU(4,VHEP(1,NHEP),VHEP(1,NHEP-4))
1064 C Outgoing quark radiated the gluon
1065 CALL HWVZRO(4,VHEP(1,NHEP-4))
1066 CALL HWVSUM(4,PHEP(1,NHEP-1),PHEP(1,NHEP),PVRT)
1067 CALL HWUDKL(ID,PVRT,VHEP(1,NHEP))
1068 CALL HWVEQU(4,VHEP(1,NHEP),VHEP(1,NHEP-1))
1071 C---STATUS, ID AND POINTERS
1076 IDHEP(IIN)=IDPDG(59)
1079 IDHEP(IIN)=IDPDG(13)
1082 IDHW(NHEP)=IDHW(IOUT)
1083 IDHEP(NHEP)=IDHEP(IOUT)
1084 IDHW(IOUT)=MOD(ID,6)+6
1085 IDHEP(IOUT)=IDPDG(IDHW(IOUT))
1087 IDHW(NHEP)=MOD(ID,6)
1088 IDHEP(NHEP)=IDPDG(IDHW(NHEP))
1090 ELSEIF (ID.LT.7) THEN
1092 IDHEP(NHEP)=IDPDG(13)
1094 IDHW(NHEP)=IDHW(IOUT)
1095 IDHEP(NHEP)=IDHEP(IOUT)
1097 IDHEP(IOUT)=IDPDG(13)
1101 C---COLOUR CONNECTIONS
1115 C---FACTORISATION SCALE
1118 ELSEIF (IOPT.EQ.2) THEN
1119 C---MAKE TWO-JET EVENTS LOOK LIKE ONE-JET EVENTS
1120 IF (EMIT.NE.NEVHEP+NWGTS .OR. XP.EQ.XBJ) RETURN
1122 CALL HWVEQU(5,Q1,PHEP(1,IIN))
1123 CALL HWVEQU(5,Q2,PHEP(1,IOUT))
1130 JHEP=JDAHEP(1,IOUT+1)
1131 CALL HWVSUM(4,PHEP(1,IHEP),PHEP(1,JHEP),PHEP(1,IHEP))
1132 CALL HWUMAS(PHEP(1,IHEP))
1133 JDAHEP(2,IHEP)=JDAHEP(2,JHEP)
1138 IF (ISTHEP(JHEP+1).NE.100) NDEL=2
1141 IF (ISTHEP(IHEP+1).EQ.100) THEN
1142 JMOHEP(1,IHEP+1)=IOUT
1143 JMOHEP(2,IHEP+1)=IIN
1145 DO 300 JHEP=JDAHEP(1,IHEP),JDAHEP(2,IHEP)
1148 IF (IDHW(IOUT).EQ.13) IDHW(IOUT)=IDHW(IOUT+1)
1149 IDHEP(IOUT)=IDPDG(IDHW(IOUT))
1150 IDHW(IHEP)=IDHW(IOUT)
1151 CALL HWUEDT(NDEL,IEDT)
1152 ELSEIF (ID.LT.7) THEN
1153 CALL HWVEQU(5,Q1,PHEP(1,IIN))
1154 CALL HWVEQU(5,Q2,PHEP(1,IOUT+1))
1155 JMOHEP(2,IIN)=IOUT+1
1156 JDAHEP(2,IIN)=IOUT+1
1157 JMOHEP(2,IOUT+1)=IIN
1158 JDAHEP(2,IOUT+1)=IIN
1159 JDAHEP(2,ICMF)=IOUT+1
1162 CALL HWVDIF(4,PHEP(1,IHEP),PHEP(1,JHEP),PHEP(1,IHEP))
1163 CALL HWUMAS(PHEP(1,IHEP))
1164 CALL HWVDIF(4,PHEP(1,ICMF),PHEP(1,JHEP),PHEP(1,ICMF))
1165 CALL HWUMAS(PHEP(1,ICMF))
1166 CALL HWUEMV(JDAHEP(2,JHEP)-JDAHEP(1,JHEP)+1,
1167 $ JDAHEP(1,JHEP),JDAHEP(2,IHEP))
1169 JDAHEP(2,IHEP)=JDAHEP(2,JHEP)
1174 IF (ISTHEP(JHEP+1).NE.100) NDEL=2
1175 CALL HWUEDT(NDEL,IEDT)
1177 DO 400 JHEP=JDAHEP(1,IHEP),JDAHEP(2,IHEP)
1181 IDHEP(IIN)=IDPDG(ID)
1184 CALL HWVEQU(5,Q1,PHEP(1,IIN))
1185 CALL HWVEQU(5,Q2,PHEP(1,IOUT))
1192 JHEP=JDAHEP(1,IOUT+1)
1193 CALL HWVDIF(4,PHEP(1,IHEP),PHEP(1,JHEP),PHEP(1,IHEP))
1194 CALL HWUMAS(PHEP(1,IHEP))
1195 CALL HWVDIF(4,PHEP(1,ICMF),PHEP(1,JHEP),PHEP(1,ICMF))
1196 CALL HWUMAS(PHEP(1,ICMF))
1197 CALL HWUEMV(JDAHEP(2,JHEP)-JDAHEP(1,JHEP)+1,
1198 $ JDAHEP(1,JHEP),JDAHEP(1,IHEP)-1)
1199 JHEP=JDAHEP(1,IOUT+1)
1200 JDAHEP(1,IHEP)=JDAHEP(1,JHEP)
1205 IF (ISTHEP(JHEP+1).NE.100.OR.JHEP.EQ.NHEP) NDEL=2
1206 CALL HWUEDT(NDEL,IEDT)
1208 DO 500 JHEP=JDAHEP(1,IHEP),JDAHEP(2,IHEP)
1212 IDHEP(IIN)=IDPDG(ID)
1215 CALL HWVZRO(4,VHEP(1,IIN))
1216 CALL HWVZRO(4,VHEP(1,JDAHEP(1,IIN)))
1217 IF (ISTHEP(JDAHEP(1,IIN)+1).EQ.100)
1218 $ CALL HWVZRO(4,VHEP(1,JDAHEP(1,IIN)+1))
1219 CALL HWVZRO(4,VHEP(1,IOUT))
1220 CALL HWVZRO(4,VHEP(1,JDAHEP(1,IOUT)))
1221 IF (ISTHEP(JDAHEP(1,IOUT)+1).EQ.100)
1222 $ CALL HWVZRO(4,VHEP(1,JDAHEP(1,IOUT)+1))
1225 CALL HWWARN('HWBDIS',500,*999)
1229 *CMZ :- -26/10/99 17.46.56 by Mike Seymour
1230 *-- Author : Gennaro Corcella
1231 C-----------------------------------------------------------------------
1232 SUBROUTINE HWBDYP(IOPT)
1233 C MATRIX ELEMENT CORRECTIONS TO DRELL-YAN PROCESSES
1234 C-----------------------------------------------------------------------
1235 INCLUDE 'HERWIG65.INC'
1236 DOUBLE PRECISION HWBVMC,HWRGEN,HWUALF,HWUSQR,PMODK,AZ,CZ,
1237 & T,U,S,EM,TMIN,TMAX,PMOD2,GLUFAC,SMIN,SMAX,SZ,TEST,
1238 & JAC,M(3),W1,W,PMOD3,SCAPR,CPHI,SPHI,SCALE,XI1,XI2,
1239 & PDFOLD1(13),PDFOLD2(13),PDFNEW1(13),PDFNEW2(13),ETA1,ETA2,Y,
1240 & COMWGT1,COMWGT2,WW,COS3,MODP,RN,BETA1,SIN3,R3(3,3),CTH,STH,M1,
1241 & M2,M3,GAMMA1,R5(3,3),CW,SW,R4(3,3),SCALE1,X1,X2,X3,MM,
1242 & PHAD1(5),PHAD2(5),P1(5),P2(5),P3(5),P4(5),PF(5),PV(5),PK(5),
1243 & PR(5),PNE(5),PE(5),PP1(5),PP2(5),PZ(5),PS(5),PD(5),P2N(5),
1244 & PBOS(5),PLAB(5),PTOT(5),P3N(5),SVNTN
1246 INTEGER EMIT,NOEMIT,IHEP,JHEP,KHEP,ICMF,IOPT,CHEP,
1247 & ID2,ID1,K,ID4,ID5,IDBOS,IHAD1,IHAD2,NTMP
1248 EXTERNAL HWBVMC,HWRGEN,HWUALF,HWUSQR
1249 SAVE PS,PF,ICMF,ID4,ID5
1254 C-----CHOOSE WEIGHTS
1257 C---FIND AN UNTREATED CMF
1260 10 IF (ICMF.EQ.0 .AND. ISTHEP(IHEP).EQ.110.AND.
1261 & JDAHEP(2,IHEP).EQ.JDAHEP(1,IHEP)+1) ICMF=IHEP
1262 IF (ICMF.EQ.0) RETURN
1264 C-----SET THE VECTOR BOSON RAPIDITY
1265 Y=HALF*LOG((PHEP(4,ICMF)+PHEP(3,ICMF))/
1266 & (PHEP(4,ICMF)-PHEP(3,ICMF)))
1267 C------SET PARTICLE IDENTIES
1268 c------ID1=QUARK, ID2=ANTIQUARK, IDBOS=VECTOR BOSON, ID4-5 BOSON DECAY
1270 ID1=IDHW(JMOHEP(1,ICMF))
1271 ID2=IDHW(JMOHEP(2,ICMF))
1272 ID4=IDHW(JDAHEP(1,ICMF))
1273 ID5=IDHW(JDAHEP(2,ICMF))
1277 C---STORE OLD MOMENTA
1278 C------VECTOR BOSON MOMENTUM
1279 CALL HWVEQU(5,PHEP(1,ICMF),PBOS)
1281 CALL HWVEQU(5,PHEP(1,JMOHEP(1,ICMF)),P1)
1282 C------ANTIQUARK MOMENTUM
1283 CALL HWVEQU(5,PHEP(1,JMOHEP(2,ICMF)),P2)
1284 C-------VECTOR DECAY (LEPTON) PRODUCT MOMENTA
1285 CALL HWVEQU(5,PHEP(1,JDAHEP(1,ICMF)),P3)
1286 CALL HWVEQU(5,PHEP(1,JDAHEP(2,ICMF)),P4)
1287 C------LEPTON MOMENTA IN THE BOSON REST FRAME
1288 CALL HWULOF(PHEP(1,ICMF),P2,P2N)
1289 CALL HWULOF(PHEP(1,ICMF),P3,P3N)
1290 C------AZ=AZIMUTHAL ANGLE OF P3N
1291 AZ=ATAN2(P3N(2),P3N(1))
1294 C------PHI=ANGLE BETWEEN P2N AND P3N
1295 SCAPR=P2N(1)*P3N(1)+P2N(2)*P3N(2)+P2N(3)*P3N(3)
1296 PMOD2=SQRT(P2N(1)**2+P2N(2)**2+P2N(3)**2)
1297 PMOD3=SQRT(P3N(1)**2+P3N(2)**2+P3N(3)**2)
1298 CPHI=SCAPR/(PMOD3*PMOD2)
1299 SPHI=SQRT(1-CPHI**2)
1300 C------HADRON MOMENTA
1303 IF (JDAHEP(1,IHAD1).NE.0) IHAD1=JDAHEP(1,IHAD1)
1304 IF (JDAHEP(1,IHAD2).NE.0) IHAD2=JDAHEP(1,IHAD2)
1305 CALL HWVEQU(5,PHEP(1,IHAD1),PHAD1)
1306 CALL HWVEQU(5,PHEP(1,IHAD2),PHAD2)
1307 CALL HWVSUM(4,PHAD1,PHAD2,PTOT)
1309 C------ Q - QBAR ENERGY FRACTIONS (BORN PROCESS)
1310 c---minorimprovement---mhs---4/8/04---include mass effects correctly
1311 ETA1=(P1(4)+P1(3))/(PHAD1(4)+PHAD1(3))
1312 ETA2=(P2(4)-P2(3))/(PHAD2(4)-PHAD2(3))
1313 C------ PDFs FOR THE BORN PROCESS
1314 CALL HWSFUN(ETA1,EM,IDHW(IHAD1),NSTRU,PDFOLD1,1)
1315 CALL HWSFUN(ETA2,EM,IDHW(IHAD2),NSTRU,PDFOLD2,2)
1316 C-------CONSIDER Q(QBAR) IN THE INITIAL STATE
1318 IF (RN.LT.COMWGT1) THEN
1319 C-------NO GLUON IN THE INITIAL STATE
1321 C---CHOOSE S ACCORDING TO 1/S**2
1323 SMIN=HALF*EM**2*(7-SQRT(SVNTN))
1325 IF (SMAX.LE.SMIN) RETURN
1326 S=SMIN*SMAX/(SMIN+HWRGEN(0)*(SMAX-SMIN))
1327 JAC=S**2*(1/SMIN-1/SMAX)
1328 C---CHOOSE T ACCORDING TO (S-EM**2)/(T*U)=1/T+1/U
1329 TMAX=-HALF*EM**2*(3-HWUSQR(1+8*EM**2/S))
1331 IF (TMAX.LE.TMIN) RETURN
1332 T=TMAX*(TMIN/TMAX)**HWRGEN(1)
1333 IF (HWRGEN(2).GT.HALF) T=EM**2-S-T
1335 JAC=JAC*2*T*U/(S-EM**2)*LOG(TMIN/TMAX)
1337 SCALE1=SQRT(U*T/S+EM**2)
1339 IF (SCALE1.GT.HWBVMC(13)) GLUFAC=HWUALF(1,SCALE1)/(2*PIFAC)
1340 C----Q-QBAR ENERGY FRACTIONS FOR Q QBAR-> VG
1341 XI1=(HALF/PHAD1(4))*EXP(Y)*SQRT(S*(S+T)/(S+U))
1342 XI2=S/(4*XI1*PHAD1(4)*PHAD2(4))
1343 c---minorimprovement---mhs---4/8/04---apply infrared cutoff for large x
1344 IF ((1-XI1)*SCALE.LT.HWBVMC(ID1)) RETURN
1345 IF ((1-XI2)*SCALE.LT.HWBVMC(ID2)) RETURN
1346 C-----PDFs WITH AN EMITTED GLUON
1347 CALL HWSFUN(XI1,SCALE,IDHW(IHAD1),NSTRU,PDFNEW1,1)
1348 CALL HWSFUN(XI2,SCALE,IDHW(IHAD2),NSTRU,PDFNEW2,2)
1349 C------CALCULATE WEIGHT
1350 W=JAC*((EM**2-T)**2+(EM**2-U)**2)/(S**2*T*U)
1351 W1=(GLUFAC/COMWGT1)*W*PDFNEW1(ID1)*PDFNEW2(ID2)/(PDFOLD1(ID1)*
1352 & PDFOLD2(ID2))*(CFFAC*ETA1*ETA2/(XI1*XI2))
1353 C-------CHOOSE WHICH PARTON WILL EMIT
1355 IF (HWRGEN(6).LT.(EM**2-U)**2/((EM**2-U)**2+(EM**2-T)**2))
1359 C--------GLUON IN THE INITIAL STATE
1361 C---CHOOSE S ACCORDING TO 1/S**2
1364 IF (SMAX.LE.SMIN) RETURN
1365 S=SMIN*SMAX/(SMIN+HWRGEN(0)*(SMAX-SMIN))
1366 JAC=S**2*(1/SMIN-1/SMAX)
1367 C---CHOOSE T ACCORDING TO 1/T
1368 TMAX=-HALF*EM**2*(3-HWUSQR(1+8*EM**2/S))
1370 IF (TMAX.LE.TMIN) RETURN
1371 T=TMAX*(TMIN/TMAX)**HWRGEN(1)
1372 JAC=JAC*T*LOG(TMAX/TMIN)
1375 SCALE1=SQRT(U*T/S+EM**2)
1377 IF (SCALE1.GT.HWBVMC(13)) GLUFAC=HWUALF(1,SCALE1)/(2*PIFAC)
1378 C--------INITIAL STATE GLUON COMING FROM HADRON 1
1379 IF (RN.LE.COMWGT2) THEN
1381 C--------ENERGY FRACTIONS and PDFs
1382 c---bug fix---mhs---4/8/04---swap u and t in mtm frac definitions
1383 XI1=(HALF/PHAD1(4))*EXP(Y)*SQRT(S*(S+T)/(S+U))
1384 XI2=S/(4*XI1*PHAD1(4)*PHAD2(4))
1385 c---minorimprovement---mhs---4/8/04---apply infrared cutoff for large x
1386 IF ((1-XI1)*SCALE.LT.HWBVMC(13)) RETURN
1387 IF ((1-XI2)*SCALE.LT.HWBVMC(ID2)) RETURN
1388 CALL HWSFUN(XI1,SCALE,IDHW(IHAD1),NSTRU,PDFNEW1,1)
1389 CALL HWSFUN(XI2,SCALE,IDHW(IHAD2),NSTRU,PDFNEW2,2)
1390 WW=PDFNEW1(13)*PDFNEW2(ID2)/((COMWGT2-COMWGT1)*
1391 & PDFOLD1(ID1)*PDFOLD2(ID2))
1393 C-------INITIAL STATE GLUON COMING FROM HADRON 2
1395 C-------ENERGY FRACTIONS AND PDFs
1396 c---bug fix---mhs---4/8/04---swap u and t in mtm frac definitions
1397 XI1=(HALF/PHAD1(4))*EXP(Y)*SQRT(S*(S+U)/(S+T))
1398 XI2=S/(4*XI1*PHAD1(4)*PHAD2(4))
1399 c---minorimprovement---mhs---4/8/04---apply infrared cutoff for large x
1400 IF ((1-XI1)*SCALE.LT.HWBVMC(ID1)) RETURN
1401 IF ((1-XI2)*SCALE.LT.HWBVMC(13)) RETURN
1402 CALL HWSFUN(XI1,SCALE,IDHW(IHAD1),NSTRU,PDFNEW1,1)
1403 CALL HWSFUN(XI2,SCALE,IDHW(IHAD2),NSTRU,PDFNEW2,2)
1404 WW=PDFNEW1(ID1)*PDFNEW2(13)/((1-COMWGT2)*
1405 & PDFOLD1(ID1)*PDFOLD2(ID2))
1407 W=-HALF*JAC*((EM**2-T)**2+(EM**2-S)**2)/(S**3*T)
1408 C-------CHOOSE WHICH PARTON WILL EMIT
1409 c---bug fix---mhs---4/8/04---swap emitter and nonemitter
1411 IF (HWRGEN(10).LT.(EM**2-S)**2/((EM**2-S)**2+(EM**2-T)**2))
1414 C-------FINAL WEIGHT FOR ALL THE CONSIDERED OPTIONS
1415 W1=GLUFAC*W*WW*ETA1*ETA2/(XI1*XI2)
1417 C--------ADD ONE MORE GLUON
1418 IF (W1.GT.HWRGEN(4)) THEN
1423 C---------INCLUDE MASSES
1424 S=S+M1**2+M2**2+M3**2
1425 IF (.NOT.GLUIN) THEN
1426 TEST=((S+M1**2-M2**2)*(S+M3**2-EM**2)-2*S*(M1**2+M3**2-T))**2
1427 $ -((S-M1**2-M2**2)**2-4*M1**2*M2**2)*
1428 $ ((S-M3**2-EM**2)**2-4*M3**2*EM**2)
1430 TEST=((S+M3**2-M2**2)*(S+M1**2-EM**2)-2*S*(M3**2+M1**2-T))**2
1431 $ -((S-M3**2-M2**2)**2-4*M3**2*M2**2)*
1432 $ ((S-M1**2-EM**2)**2-4*M1**2*EM**2)
1434 TEST=((S+M3**2-M1**2)*(S+M2**2-EM**2)-2*S*(M3**2+M2**2-T))**2
1435 $ -((S-M3**2-M1**2)**2-4*M3**2*M1**2)*
1436 $ ((S-M2**2-EM**2)**2-4*M2**2*EM**2)
1445 C----MOMENTA IN THE V-REST FRAME WITH NON EMITTER ALONG THE Z AXIS
1446 C----V=BOSON,K=GLUON,E=EMITTER,NE=NON-EMITTER
1454 IF (.NOT.GLUIN) THEN
1455 PK(4)=(S-M(3)**2-EM**2)/(2*EM)
1456 PMODK=SQRT(PK(4)**2-M(3)**2)
1468 PNE(4)=(EM**2+MM**2-X1)/(2*EM)
1469 PNE(3)=X3*SQRT(PNE(4)**2-MM**2)
1470 COS3=HALF*(X2-MM**2-M(3)**2+2*PNE(4)*PK(4))/(PNE(3)*PMODK)
1472 PK(4)=(EM**2+M(3)**2-U)/(2*EM)
1473 PMODK=SQRT(PK(4)**2-M(3)**2)
1482 PNE(4)=(S-MM**2-EM**2)/(2*EM)
1483 PNE(3)=X3*SQRT(PNE(4)**2-MM**2)
1484 COS3=HALF*(T-MM**2-M(3)**2+2*PNE(4)*PK(4))/(PNE(3)*PMODK)
1493 PNE(4)=(EM**2+MM**2-T)/(2*EM)
1494 PNE(3)=X3*SQRT(PNE(4)**2-MM**2)
1495 COS3=HALF*(MM**2+M(3)**2-S+2*PNE(4)*PK(4))/(PNE(3)*PMODK)
1499 SIN3=SQRT(1-COS3**2)
1500 C---------DEFINE A RANDOM ROTATION AROUND THE Z-AXIS
1501 CALL HWRAZM(PMODK*SIN3,PK(1),PK(2))
1505 IF (.NOT.GLUIN) THEN
1506 PE(K)=PV(K)+PK(K)-PNE(K)
1509 PE(K)=PV(K)+PNE(K)-PK(K)
1511 PE(K)=PNE(K)+PK(K)-PV(K)
1516 c------LEPTON MOMENTA IN THE BOSON REST FRAME, WITH THE DIRECTION
1517 C------TAKEN FROM THE BORN PROCESS
1519 PS(4)=(EM**2+P3(5)**2-P4(5)**2)/(2*EM)
1520 PS(3)=-SQRT(PS(4)**2-P3(5)**2)*CPHI
1521 PS(2)=SQRT(PS(4)**2-P3(5)**2)*SPHI*SZ
1522 PS(1)=SQRT(PS(4)**2-P3(5)**2)*SPHI*CZ
1524 PF(4)=(EM**2+P4(5)**2-P3(5)**2)/(2*EM)
1528 C----FIND A STATIONARY VECTOR PLAB IN THE LAB FRAME
1529 IF (.NOT.GLUIN) THEN
1531 CALL HWVEQU(5,PE,PP1)
1532 CALL HWVEQU(5,PNE,PP2)
1534 CALL HWVEQU(5,PNE,PP1)
1535 CALL HWVEQU(5,PE,PP2)
1539 CALL HWVEQU(5,PK,PP1)
1541 CALL HWVEQU(5,PE,PP2)
1543 CALL HWVEQU(5,PNE,PP2)
1546 CALL HWVEQU(5,PK,PP2)
1548 CALL HWVEQU(5,PE,PP1)
1550 CALL HWVEQU(5,PNE,PP1)
1554 CALL HWVSCA(4,1/XI1,PP1,PP1)
1555 CALL HWVSCA(4,1/XI2,PP2,PP2)
1556 CALL HWVSUM(4,PP1,PP2,PLAB)
1558 C------BOOST TO PLAB REST FRAME
1559 CALL HWULOF(PLAB,PE,PE)
1560 CALL HWULOF(PLAB,PNE,PNE)
1561 CALL HWULOF(PLAB,PK,PK)
1562 CALL HWULOF(PLAB,PS,PS)
1563 CALL HWULOF(PLAB,PF,PF)
1564 CALL HWULOF(PLAB,PV,PV)
1565 C----PUT THE INITIAL PARTON BELONGING TO HADRON 1 ON THE Z-AXIS
1566 IF (.NOT.GLUIN) THEN
1568 CALL HWVEQU(5,PE,PZ)
1570 CALL HWVEQU(5,PNE,PZ)
1574 CALL HWVEQU(5,PK,PZ)
1577 CALL HWVEQU(5,PE,PZ)
1579 CALL HWVEQU(5,PNE,PZ)
1583 MODP=SQRT(PZ(1)**2+PZ(2)**2)
1586 CALL HWUROT(PZ,CTH,STH,R3)
1587 C-----ROTATE EVERYTHING BY R3
1588 CALL HWUROF(R3,PE,PE)
1589 CALL HWUROF(R3,PNE,PNE)
1590 CALL HWUROF(R3,PV,PV)
1591 CALL HWUROF(R3,PK,PK)
1592 CALL HWUROF(R3,PS,PS)
1593 CALL HWUROF(R3,PF,PF)
1594 C--REORDER ENTRIES:--IHEP=EMITTER,JHEP=NON-EMITTER,KHEP=EMITTED
1595 IF (.NOT.GLUIN) THEN
1596 IHEP=JMOHEP(EMIT,ICMF)
1597 JHEP=JMOHEP(NOEMIT,ICMF)
1601 IDHEP(CHEP)=IDPDG(15)
1604 IDHEP(ICMF)=IDPDG(IDBOS)
1605 C-----NO GLUON IN THE INITIAL STATE: JUST ADD IT AFTER THE VECTOR BOSON
1606 IF (.NOT.GLUIN) THEN
1609 C---STATUS OF EMITTER/NON EMITTER
1610 ISTHEP(IHEP)=110+EMIT
1611 ISTHEP(JHEP)=110+NOEMIT
1613 C-----GLUON COMING FROM THE 1ST HADRON
1643 C------GLUON COMING FROM THE HADRON 2
1674 IDHEP(IHEP)=IDPDG(IDHW(IHEP))
1675 IDHEP(JHEP)=IDPDG(IDHW(JHEP))
1679 IDHEP(KHEP)=IDPDG(13)
1680 C---------DEFINE MOMENTA IN THE LAB FRAME
1681 CALL HWVEQU(5,PV,PHEP(1,ICMF))
1682 CALL HWVEQU(5,PK,PHEP(1,KHEP))
1683 CALL HWVEQU(5,PNE,PHEP(1,JHEP))
1684 CALL HWVEQU(5,PE,PHEP(1,IHEP))
1685 IF (.NOT.GLUIN) THEN
1686 CALL HWVSUM(4,PHEP(1,IHEP),PHEP(1,JHEP),PHEP(1,CHEP))
1689 CALL HWVSUM(4,PHEP(1,IHEP),PHEP(1,KHEP),PHEP(1,CHEP))
1691 CALL HWVSUM(4,PHEP(1,KHEP),PHEP(1,JHEP),PHEP(1,CHEP))
1694 CALL HWUMAS(PHEP(1,CHEP))
1695 IF (.NOT.GLUIN) THEN
1722 C---COLOUR CONNECTIONS
1723 IF (.NOT.GLUIN) THEN
1724 IF (IDHW(IHEP).LT.IDHW(JHEP)) THEN
1742 IF (IDHEP(IHEP).GT.0) THEN
1758 IF (IDHEP(JHEP).GT.0) THEN
1775 EMSCA=SQRT(EM**2+PHEP(1,ICMF)**2+PHEP(2,ICMF)**2)
1776 C--------SET STATUS AND LEPTON MOMENTA AFTER THE PARTON SHOWER
1777 ELSEIF (IOPT.EQ.2) THEN
1778 IF (EMIT.EQ.0.OR.NEVHEP+NWGTS.NE.NTMP) RETURN
1779 ISTHEP(JDAHEP(1,ICMF))=195
1782 IDHEP(NHEP+1)=IDPDG(ID4)
1783 IDHEP(NHEP+2)=IDPDG(ID5)
1786 CW=PHEP(3,ICMF)/SQRT(PHEP(1,ICMF)**2+PHEP(2,ICMF)**2+
1789 CALL HWUROT(PHEP(1,ICMF),CW,SW,R4)
1790 CALL HWUROF(R4,PHEP(1,ICMF),PR)
1793 CALL HWUROF(R4,PS,PS)
1794 CALL HWUROF(R4,PF,PF)
1797 CALL HWUROT(PHEP(1,JDAHEP(1,ICMF)),CW,SW,R5)
1798 CALL HWUROF(R5,PHEP(1,JDAHEP(1,ICMF)),PD)
1799 PD(4)=PHEP(4,JDAHEP(1,ICMF))
1801 BETA1=(PR(4)*PR(3)-SQRT(PR(4)**2*PD(3)**2-PR(3)**2*PD(3)**2+
1802 & PD(3)**4))/(PD(3)**2+PR(4)**2)
1803 GAMMA1=1/SQRT(1-BETA1**2)
1804 PHEP(4,NHEP+1)=GAMMA1*PS(4)-BETA1*GAMMA1*PS(3)
1805 PHEP(3,NHEP+1)=-BETA1*GAMMA1*PS(4)+GAMMA1*PS(3)
1806 PHEP(4,NHEP+2)=GAMMA1*PF(4)-BETA1*GAMMA1*PF(3)
1807 PHEP(3,NHEP+2)=-BETA1*GAMMA1*PF(4)+GAMMA1*PF(3)
1808 PHEP(1,NHEP+1)=PS(1)
1809 PHEP(2,NHEP+1)=PS(2)
1810 PHEP(1,NHEP+2)=PF(1)
1811 PHEP(2,NHEP+2)=PF(2)
1812 CALL HWUMAS(PHEP(1,NHEP+1))
1813 CALL HWUMAS(PHEP(1,NHEP+2))
1814 CALL HWUROB(R5,PHEP(1,NHEP+1),PHEP(1,NHEP+1))
1815 CALL HWUROB(R5,PHEP(1,NHEP+2),PHEP(1,NHEP+2))
1816 JDAHEP(1,JDAHEP(1,ICMF))=NHEP+1
1817 JDAHEP(2,JDAHEP(1,ICMF))=NHEP+2
1818 JMOHEP(1,NHEP+1)=JDAHEP(1,ICMF)
1819 JMOHEP(1,NHEP+2)=JDAHEP(1,ICMF)
1820 JMOHEP(2,NHEP+1)=NHEP+2
1821 JDAHEP(2,NHEP+1)=NHEP+2
1822 JMOHEP(2,NHEP+2)=NHEP+1
1823 JDAHEP(2,NHEP+2)=NHEP+1
1824 C--special for spin correlations(relabel in spin common block)
1825 IF(SYSPIN.AND.NSPN.NE.0) THEN
1836 *CMZ :- -26/04/91 10.18.56 by Bryan Webber
1837 *-- Author : Bryan Webber
1838 C-----------------------------------------------------------------------
1839 SUBROUTINE HWBFIN(IHEP)
1840 C-----------------------------------------------------------------------
1841 C DELETES INTERNAL LINES FROM SHOWER, MAKES COLOUR CONNECTION INDEX
1842 C AND COPIES INTO /HEPEVT/ IN COLOUR ORDER.
1843 C-----------------------------------------------------------------------
1844 INCLUDE 'HERWIG65.INC'
1845 INTEGER IHEP,ID,IJET,KHEP,IPAR,JPAR,NXPAR,IP,JP
1846 IF (IERROR.NE.0) RETURN
1847 C---SAVE VIRTUAL PARTON DATA
1849 IF(NHEP.GT.NMXHEP) CALL HWWARN('HWBFIN',100,*999)
1852 IDHEP(NHEP)=IDPDG(ID)
1853 ISTHEP(NHEP)=ISTHEP(IHEP)+20
1855 JMOHEP(2,NHEP)=JMOHEP(1,IHEP)
1859 CALL HWVEQU(5,PPAR(1,2),PHEP(1,NHEP))
1860 CALL HWVEQU(4,VPAR(1,2),VHEP(1,NHEP))
1861 C---FINISHED FOR SPECTATOR OR NON-PARTON JETS
1862 IF (ISTHEP(NHEP).GT.136) RETURN
1863 IF (ID.GT.13.AND.ID.LT.209 .AND. ID.NE.59) RETURN
1864 IF (ID.GT.220.AND.ABS(IDPDG(ID)).LT.1000000) RETURN
1865 IF (ID.GT.424.AND.ID.NE.449) RETURN
1866 IF (.NOT.TMPAR(2).AND.ID.EQ.59) RETURN
1872 IF(NHEP.GT.NMXHEP) CALL HWWARN('HWBFIN',101,*999)
1877 JMOHEP(2,NHEP)=JCOPAR(1,1)
1880 CALL HWVEQU(5,PPAR,PHEP(1,NHEP))
1881 CALL HWVEQU(4,VPAR(1,2),VHEP(1,NHEP))
1884 C---START WITH ANTICOLOUR DAUGHTER OF HARDEST PARTON
1890 IF (JPAR.EQ.0) GOTO 15
1891 IF (JCOPAR(2,JPAR).EQ.IPAR) THEN
1899 C---COULDN'T FIND COLOUR PARTNER
1900 CALL HWWARN('HWBFIN',1,*999)
1901 15 JPAR=JCOPAR(1,IPAR)
1903 IF(KHEP.GT.NMXHEP) CALL HWWARN('HWBFIN',102,*999)
1905 IF (TMPAR(IPAR)) THEN
1908 ELSEIF (ID.EQ.59) THEN
1910 ELSEIF (ID.LT.109) THEN
1912 ELSEIF (ID.LT.120) THEN
1914 ELSEIF (ABS(IDPDG(ID)).LT.1000000) THEN
1916 ELSEIF (ID.LT.425) THEN
1918 ELSEIF (ID.EQ.449) THEN
1924 ISTHEP(KHEP)=ISTHEP(IHEP)+24
1927 IDHEP(KHEP)=IDPDG(ID)
1928 CALL HWVEQU(5,PPAR(1,IPAR),PHEP(1,KHEP))
1929 CALL HWVEQU(4,VPAR(1,IPAR),VHEP(1,KHEP))
1931 JMOHEP(2,KHEP)=KHEP+1
1933 JDAHEP(2,KHEP)=KHEP-1
1937 JDAHEP(1,IJET)=NHEP+1
1942 *CMZ :- -14/10/99 18.04.56 by Mike Seymour
1943 *-- Author : Bryan Webber
1944 C-----------------------------------------------------------------------
1946 C-----------------------------------------------------------------------
1947 C BRANCHING GENERATOR WITH INTERFERING GLUONS
1948 C HWBGEN EVOLVES QCD JETS ACCORDING TO THE METHOD OF
1949 C G.MARCHESINI & B.R.WEBBER, NUCL. PHYS. B238(1984)1
1950 C-----------------------------------------------------------------------
1951 INCLUDE 'HERWIG65.INC'
1952 DOUBLE PRECISION HWULDO,HWRGAU,EINHEP,ERTXI,RTXI,XF
1953 INTEGER NTRY,LASHEP,IHEP,NRHEP,ID,IST,JHEP,KPAR,I,J,IRHEP(NMXJET),
1956 EXTERNAL HWULDO,HWRGAU
1957 IF (IERROR.NE.0) RETURN
1958 IF (IPRO.EQ.80) RETURN
1959 C---CHECK THAT EMSCA IS SET
1960 IF (EMSCA.LE.ZERO) CALL HWWARN('HWBGEN',200,*999)
1962 C---FORCE A BRANCH INTO THE `DEAD ZONE' IN E+E-
1964 C**********13/11/00 BRW FIX TO ALLOW ALSO WW AND ZZ
1965 IF (JPR.EQ.10.OR.JPR.EQ.20.OR.JPR.EQ.25) CALL HWBDED(1)
1967 C---FORCE A BRANCH INTO THE `DEAD ZONE' IN DIS
1968 IF (IPRO.EQ.90) CALL HWBDIS(1)
1969 C---FORCE A BRANCH INTO THE `DEAD ZONE' IN DRELL-YAN PROCESSES
1970 IF (IPRO.EQ.13.OR.IPRO.EQ.14) CALL HWBDYP(1)
1971 C---FORCE A BRANCH INTO THE `DEAD ZONE' IN TOP DECAYS
1974 C---GENERATE INTRINSIC PT ONCE AND FOR ALL
1976 IF (PTRMS.NE.0.) THEN
1977 PTINT(1,JNHAD)=HWRGAU(1,ZERO,PXRMS)
1978 PTINT(2,JNHAD)=HWRGAU(2,ZERO,PXRMS)
1979 PTINT(3,JNHAD)=PTINT(1,JNHAD)**2+PTINT(2,JNHAD)**2
1981 CALL HWVZRO(3,PTINT(1,JNHAD))
1987 IF (NTRY.GT.NETRY) CALL HWWARN('HWBGEN',ISLENT*100,*999)
1991 DO 100 IHEP=1,LASHEP
1993 IF (IST.GE.111.AND.IST.LE.115) THEN
1998 IF (IST.NE.115) THEN
1999 C---FOUND A PARTON TO EVOLVE
2011 C---SET UP EVOLUTION SCALE AND FRAME
2014 IF (HWRLOG(HALF)) JHEP=JDAHEP(2,IHEP)
2015 ELSEIF (IST.GT.112) THEN
2016 IF ((ID.GT.6.AND.ID.LT.13).OR.
2017 & (ID.GT.214.AND.ID.LT.221)) JHEP=JDAHEP(2,IHEP)
2019 IF (ID.LT.7.OR.(ID.GT.208.AND.ID.LT.215)) JHEP=JDAHEP(2,IHEP)
2021 IF (JHEP.LE.0.OR.JHEP.GT.NHEP) THEN
2022 CALL HWWARN('HWBGEN',1,*999)
2027 ERTXI=HWULDO(PHEP(1,IHEP),PHEP(1,JHEP))
2028 IF (ERTXI.LT.ZERO) ERTXI=0.
2029 IF (IST.LE.112.AND.IHEP.EQ.JHEP) ERTXI=0.
2030 IF (ISTHEP(JHEP).EQ.155) THEN
2031 ERTXI=ERTXI/PHEP(5,JHEP)
2037 IF (RTXI.EQ.ZERO) THEN
2052 IF (PPAR(4,2).LT.PHEP(5,IHEP)) PPAR(4,2)=PHEP(5,IHEP)
2054 PPAR(5,2)=PHEP(5,IHEP)
2055 CALL HWVZRO(4,VPAR(1,1))
2056 CALL HWVZRO(4,VPAR(1,2))
2057 IF (IST.GT.112) THEN
2066 IF (JDAHEP(1,JNHAD).NE.0) INHAD=JDAHEP(1,JNHAD)
2067 XFACT=XF/PHEP(4,INHAD)
2068 ANOMSC(1,JNHAD)=ZERO
2069 ANOMSC(2,JNHAD)=ZERO
2071 C---FOR QUARKS IN A COLOUR SINGLET, ALLOW SOFT MATRIX-ELEMENT CORRECTION
2073 IF (SOFTME.AND.IDHW(IHEP).LT.13.AND.
2074 $ ((JMOHEP(2,JHEP).EQ.IHEP.AND.JDAHEP(2,JHEP).EQ.IHEP).OR.
2075 $ ISTHEP(JHEP).EQ.155)) HARDST=0
2076 C---CREATE BRANCHES AND COMPUTE ENERGIES
2078 IF (TMPAR(KPAR)) THEN
2083 IF (IERROR.NE.0) RETURN
2085 IF (KPAR.EQ.NPAR) GOTO 30
2087 C---COMPUTE MASSES AND 3-MOMENTA
2090 IF (AZSPIN) CALL HWBSPN
2096 C---ENTER PARTON JET IN /HEPEVT/
2101 IF (ID.GT.120.AND.ID.LT.133 .OR. ID.GE.198.AND.ID.LE.201) THEN
2107 IDHEP(NHEP)=IDPDG(ID)
2112 CALL HWVEQU(5,PHEP(1,IHEP),PHEP(1,NHEP))
2114 ISTHEP(IHEP)=ISTHEP(IHEP)+10
2117 IF (.NOT.FROST) THEN
2122 IF (.NOT.FROST) THEN
2123 C---ATTACH SPECTATORS
2128 C---BAD JET: RESTORE PARTONS AND RE-EVOLVE
2130 120 ISTHEP(IRHEP(I))=IRST(I)
2138 C---CLEAN UP IF THERE WAS A BRANCH IN THE `DEAD ZONE' IN E+E-
2139 IF (IPROC/10.EQ.10) CALL HWBDED(2)
2140 C---CLEAN UP IF THERE WAS A BRANCH IN THE `DEAD ZONE' IN DIS
2141 IF (IPRO.EQ.90) CALL HWBDIS(2)
2142 C---CLEAN UP IF THERE WAS A BRANCH IN THE `DEAD ZONE' IN DRELL-YAN PROC
2143 IF (IPRO.EQ.13.OR.IPRO.EQ.14) CALL HWBDYP(2)
2145 C---IF THE CLEAN-UP OPERATION ADDED ANY PARTONS TO THE EVENT RECORD
2146 C IT MIGHT NEED RESHOWERING
2147 IF (NHEP.GT.LASHEP) THEN
2153 *CMZ :- -16/07/02 09.40.25 by Peter Richardson
2154 *-- Author : Peter Richardson
2155 C----------------------------------------------------------------------
2156 SUBROUTINE HWBGUP(ISTART,ICMF)
2157 C----------------------------------------------------------------------
2158 C Makes the colour connections and performs the parton shower
2159 C for events read in from the GUPI (Generic User Process Interface)
2160 C event common block
2161 C----------------------------------------------------------------------
2162 INCLUDE 'HERWIG65.INC'
2164 PARAMETER (MAXNUP=500)
2165 INTEGER NUP,IDPRUP,IDUP,ISTUP,MOTHUP,ICOLUP
2166 DOUBLE PRECISION XWGTUP,SCALUP,AQEDUP,AQCDUP,PUP,VTIMUP,SPINUP
2167 COMMON/HEPEUP/NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP,
2168 & IDUP(MAXNUP),ISTUP(MAXNUP),MOTHUP(2,MAXNUP),
2169 & ICOLUP(2,MAXNUP),PUP(5,MAXNUP),VTIMUP(MAXNUP),
2172 INTEGER ISTART,ICMF,J,K,I,JCOL,ICOL
2174 COMMON /HWGUP/ILOC(NMXHEP),JLOC(MAXNUP)
2176 C--now we need to do the colour connections
2177 20 ISTART = ISTART+1
2178 IF(ISTART.GT.NHEP) GOTO 30
2179 IF(ISTART.EQ.ICMF) ISTART = ISTART+1
2180 IF(JMOHEP(2,ISTART).NE.0.AND.JDAHEP(2,ISTART).NE.0) GOTO 20
2183 IF(ICOLUP(1,J).NE.0) THEN
2195 C--now search for the partner
2196 C--first search for the flavour partner if not looking for colour partner
2197 C--search for the flavour partner of the particle
2198 C--this must be set or HERWIG won't work
2199 10 IF(JDAHEP(2,K).NE.0.AND.JMOHEP(2,K).NE.0) GOTO 20
2202 C--look for unpaired particle
2204 IF(JLOC(I).EQ.0) GOTO 15
2205 IF(IDUP(I).EQ.21.OR.IDUP(I).EQ.9) GOTO 15
2206 IF(JLOC(I).EQ.ISTART) GOTO 15
2207 IF(ICOLUP(1,I).EQ.0.AND.ICOLUP(2,I).EQ.0) GOTO 15
2208 C--antiflavour partner
2209 IF(JDAHEP(2,JLOC(I)).EQ.0) THEN
2210 C--pair incoming particle with outgoing particle
2211 C-- or outgoing antiparticle with outgoing particle
2212 IF(ISTUP(I).GT.0.AND.IDUP(I).GT.0.AND.
2213 & ((IDUP(J).GT.0.AND.ISTUP(J).EQ.-1).OR.
2214 & (IDUP(J).LT.0.AND.ISTUP(J).GT.0 ))) THEN
2217 C--pair incoming particle with incoming antiparticle
2218 C-- or outgoing antiparticle with incoming antiparticle
2219 ELSEIF(IDUP(I).LT.0.AND.ISTUP(I).EQ.-1.AND.
2220 & ((IDUP(J).GT.0.AND.ISTUP(J).EQ.-1).OR.
2221 & (IDUP(J).LT.0.AND.ISTUP(J).GT.0 ))) THEN
2225 C--make the connection
2227 JMOHEP(2,K) = JLOC(I)
2228 JDAHEP(2,JLOC(I)) = K
2232 IF(JMOHEP(2,JLOC(I)).EQ.0.AND.(.NOT.FOUND)) THEN
2233 C--pair incoming antiparticle with outgoing antiparticle
2234 C-- or outgoing particle with outgoing antiparticle
2235 IF(IDUP(I).LT.0.AND.ISTUP(I).GT.0.AND.
2236 & ((IDUP(J).LT.0.AND.ISTUP(J).EQ.-1).OR.
2237 & (IDUP(J).GT.0.AND.ISTUP(J).GT.0 ))) THEN
2240 C--pair incoming antiparticle with incoming particle
2241 C-- or outgoing particle with incoming particle
2242 ELSEIF(IDUP(I).GT.0.AND.ISTUP(I).EQ.-1.AND.
2243 & ((IDUP(J).LT.0.AND.ISTUP(J).EQ.-1).OR.
2244 & (IDUP(J).GT.0.AND.ISTUP(J).GT.0 ))) THEN
2248 C--make the connection
2250 JDAHEP(2,K) = JLOC(I)
2251 JMOHEP(2,JLOC(I)) = K
2254 C--set up the search for the next partner
2257 ICOL = ICOLUP(JCOL,I)
2263 C--if no other choice then connect to the first particle in the loop
2264 IF(JDAHEP(2,K).EQ.0.AND.JMOHEP(2,ISTART).EQ.0) THEN
2265 JDAHEP(2,K) = ISTART
2266 JMOHEP(2,ISTART) = K
2267 ELSEIF(JDAHEP(2,ISTART).EQ.0.AND.JMOHEP(2,K).EQ.0) THEN
2268 JMOHEP(2,K) = ISTART
2269 JDAHEP(2,ISTART) = K
2271 CALL HWWARN('HWBGUP',100,*999)
2275 C--now the bit to find colour partners
2277 C--special for particle from a decaying coloured particle
2278 IF(MOTHUP(1,J).NE.0) THEN
2279 IF(ISTUP(MOTHUP(1,J)).EQ.2.OR.ISTUP(MOTHUP(1,J)).EQ.3) THEN
2280 IF(IDUP(J).LT.0.AND.ICOL.EQ.ICOLUP(2,MOTHUP(1,J))) THEN
2281 JDAHEP(2,K) = JLOC(MOTHUP(1,J))
2282 JMOHEP(2,K) = JLOC(MOTHUP(1,J))
2284 ELSEIF(IDUP(J).GT.0.AND.ICOL.EQ.ICOLUP(1,MOTHUP(1,J))) THEN
2285 JDAHEP(2,K) = JLOC(MOTHUP(1,J))
2286 JMOHEP(2,K) = JLOC(MOTHUP(1,J))
2291 C--search for the partner
2293 IF(ICOLUP(1,I).EQ.ICOL.AND.I.NE.J) THEN
2294 IF((JCOL.EQ.1.AND.ISTUP(J).EQ.-1.AND.ISTUP(I).GT.0).OR.
2295 & (JCOL.EQ.2.AND.ISTUP(J).GT.0.AND.ISTUP(I).GE.0)) THEN
2296 JDAHEP(2,K) = JLOC(I)
2297 JMOHEP(2,JLOC(I)) = K
2299 ELSEIF((JCOL.EQ.1.AND.ISTUP(J).GT.0.AND.ISTUP(I).EQ.-1).OR.
2300 & (JCOL.EQ.2.AND.ISTUP(J).EQ.-1.AND.ISTUP(I).EQ.-1)) THEN
2301 JMOHEP(2,K) = JLOC(I)
2302 JDAHEP(2,JLOC(I)) = K
2306 ELSEIF(ICOLUP(2,I).EQ.ICOL.AND.I.NE.J) THEN
2307 IF((JCOL.EQ.1.AND.ISTUP(J).EQ.-1.AND.ISTUP(I).EQ.-1).OR.
2308 & (JCOL.EQ.2.AND.ISTUP(J).GT.0.AND.ISTUP(I).EQ.-1)) THEN
2309 JDAHEP(2,K) = JLOC(I)
2310 JMOHEP(2,JLOC(I)) = K
2312 ELSEIF((JCOL.EQ.1.AND.ISTUP(J).GE.0.AND.ISTUP(I).GE.0).OR.
2313 & (JCOL.EQ.2.AND.ISTUP(J).EQ.-1.AND.ISTUP(I).GE.0)) THEN
2314 JMOHEP(2,K) = JLOC(I)
2315 JDAHEP(2,JLOC(I)) = K
2323 ICOL = ICOLUP(JCOL,I)
2327 C--special for self connected gluons
2328 IF(IDUP(J).EQ.21.OR.IDUP(J).EQ.9.AND.
2329 & ICOLUP(1,J).EQ.ICOLUP(2,J)) THEN
2332 C--options for self connected gluons
2334 CALL HWWARN('HWBGUP',1,*20)
2336 CALL HWWARN('HWBGUP',101,*999)
2340 C--perform the shower
2344 *CMZ :- -30/09/02 09.19.58 by Peter Richardson
2345 *-- Author : Bryan Webber
2346 C-----------------------------------------------------------------------
2348 C-----------------------------------------------------------------------
2349 C COMBINES JETS WITH REQUIRED KINEMATICS
2350 C-----------------------------------------------------------------------
2351 INCLUDE 'HERWIG65.INC'
2352 DOUBLE PRECISION HWULDO,EPS,PTX,PTY,PF,PTINF,PTCON,CN,CP,SP,PP0,
2353 & PM0,ET0,DET,ECM,EMJ,EMP,EMS,DMS,ES,DPF,ALF,AL(2),ET(2),PP(2),
2354 & PT(3),PA(5),PB(5),PC(5),PQ(5),PR(5),PS(5),RR(3,3),RS(3,3),ETC,
2355 & PJ(NMXJET),PM(NMXJET),PBR(5),RBR(3,3),DISP(4),PLAB(5)
2356 INTEGER LJET,IJ1,IST,IP,ICM,IP1,IP2,NP,IHEP,MHEP,JP,KP,LP,KHEP,
2357 & JHEP,NE,IJT,IEND(2),IJET(NMXJET),IPAR(NMXJET)
2358 LOGICAL AZCOR,JETRAD,DISPRO,DISLOW
2360 PARAMETER (EPS=1.D-4)
2361 IF (IERROR.NE.0) RETURN
2362 AZCOR=AZSOFT.OR.AZSPIN
2368 IF (IST.EQ.137.OR.IST.EQ.138) IST=133
2369 IF (IST.EQ.LJET) THEN
2370 C---FOUND AN UNBOOSTED JET - FIND PARTNERS
2373 DISPRO=IPRO/10.EQ.9.AND.IDHW(ICM).EQ.15
2374 DISLOW=DISPRO.AND.JDAHEP(1,ICM).EQ.JDAHEP(2,ICM)-1
2375 IF (IST.EQ.131) THEN
2382 IF (IP1.NE.IP) CALL HWWARN('HWBJCO',100,*999)
2387 30 IJET(NP)=JDAHEP(1,JHEP)
2392 IF (LJET.EQ.131) THEN
2397 50 IF (LJET.EQ.131) THEN
2398 C---SPACELIKE JETS: FIND SPACELIKE PARTONS
2399 IF (NP.NE.2) CALL HWWARN('HWBJCO',103,*999)
2400 C---special for DIS: FIND BOOST AND ROTATION FROM LAB TO BREIT FRAME
2401 IF (DISPRO.AND.BREIT) THEN
2403 IF (JDAHEP(1,IP).NE.0) IP=JDAHEP(1,IP)
2404 CALL HWVDIF(4,PHEP(1,JMOHEP(1,ICM)),PHEP(1,JDAHEP(1,ICM)),PB)
2406 C---IF Q**2<10**-2, SOMETHING MUST HAVE ALREADY GONE WRONG
2407 IF (PB(5)**2.LT.1.D-2) CALL HWWARN('HWBJCO',102,*999)
2408 CALL HWVSCA(4,PB(5)**2/HWULDO(PHEP(1,IP),PB),PHEP(1,IP),PBR)
2409 CALL HWVSUM(4,PB,PBR,PBR)
2411 CALL HWULOF(PBR,PB,PB)
2412 CALL HWUROT(PB,ONE,ZERO,RBR)
2419 IF (JDAHEP(1,MHEP).EQ.0) THEN
2420 C---SPECIAL FOR NON-PARTON JETS
2425 DO 60 IHEP=MHEP,NHEP
2426 60 IF (ISTHEP(IHEP).EQ.IST) GOTO 70
2427 C---COULDN'T FIND SPACELIKE PARTON
2428 CALL HWWARN('HWBJCO',101,*999)
2430 70 CALL HWVSCA(3,PF,PHEP(1,IHEP),PS)
2431 IF (PTINT(3,IP).GT.ZERO) THEN
2432 C---ADD INTRINSIC PT
2436 CALL HWUROT(PS, ONE,ZERO,RS)
2437 CALL HWUROB(RS,PT,PT)
2438 CALL HWVSUM(3,PS,PT,PS)
2441 IF (AZCOR.AND.JP.LE.NHEP.AND.IDHW(JP).EQ.17) THEN
2442 C---ALIGN CONE WITH INTERFERING PARTON
2443 CALL HWUROT(PS, ONE,ZERO,RS)
2444 CALL HWUROF(RS,PHEP(1,JP),PR)
2445 PTCON=PR(1)**2+PR(2)**2
2448 CALL HWWARN('HWBJCO',1,*999)
2451 CALL HWVEQU(4,PHEP(1,KP),PB)
2452 IF (DISPRO.AND.BREIT) THEN
2453 CALL HWULOF(PBR,PB,PB)
2454 CALL HWUROF(RBR,PB,PB)
2456 PTINF=PB(1)**2+PB(2)**2
2457 IF (PTINF.LT.EPS) THEN
2458 C---COLLINEAR JETS: ALIGN CONES
2460 IF (ISTHEP(KP).EQ.100.AND.(ISTHEP(KP-1)+9)/10.EQ.14) THEN
2461 CALL HWVEQU(4,PHEP(1,KP),PB)
2462 IF (DISPRO.AND.BREIT) THEN
2463 CALL HWULOF(PBR,PB,PB)
2464 CALL HWUROF(RBR,PB,PB)
2466 PTINF=PB(1)**2+PB(2)**2
2472 IF (PTCON.NE.ZERO.AND.PTINF.NE.ZERO) THEN
2473 CN=1./SQRT(PTINF*PTCON)
2474 CP=CN*(PR(1)*PB(1)+PR(2)*PB(2))
2475 SP=CN*(PR(1)*PB(2)-PR(2)*PB(1))
2477 CALL HWRAZM( ONE,CP,SP)
2480 CALL HWRAZM( ONE,CP,SP)
2482 C---ROTATE SO SPACELIKE IS ALONG AXIS (APART FROM INTRINSIC PT)
2483 CALL HWUROT(PS,CP,SP,RS)
2486 IF (KHEP.LT.IHEP) KHEP=IHEP
2488 DO 80 JHEP=IHEP,KHEP
2489 CALL HWUROF(RS,PHEP(1,JHEP),PHEP(1,JHEP))
2490 80 CALL HWUROF(RS,VHEP(1,JHEP),VHEP(1,JHEP))
2491 PP(IP)=PHEP(4,IHEP)+PF*PHEP(3,IHEP)
2492 ET(IP)=PHEP(1,IHEP)**2+PHEP(2,IHEP)**2-PHEP(5,IHEP)**2
2493 C---REDEFINE HARD CM
2494 PTX=PTX+PHEP(1,IHEP)
2495 PTY=PTY+PHEP(2,IHEP)
2499 C---special for DIS: keep lepton momenta fixed
2504 C---IJT will be used to store lepton momentum transfer
2505 CALL HWVDIF(4,PHEP(1,IP1),PHEP(1,IP2),PHEP(1,IJT))
2506 CALL HWUMAS(PHEP(1,IJT))
2507 IF (IDHEP(IP1).EQ.IDHEP(IP2)) THEN
2509 ELSEIF (IDHEP(IP1).LT.IDHEP(IP2)) THEN
2514 IDHEP(IJT)=IDPDG(IDHW(IJT))
2516 C---calculate boost for struck parton
2517 C PC is momentum of outgoing parton(s)
2519 IF (.NOT.DISLOW) THEN
2520 C---FOR heavy QQbar PQ and PC are old and new QQbar momenta
2521 CALL HWVSUM(4,PHEP(1,IP2-1),PHEP(1,IP2),PQ)
2525 PC(5)=PHEP(5,JDAHEP(1,IP2))
2527 CALL HWVSUM(2,PHEP(1,IJT),PHEP(1,IJET(2)),PC)
2529 C---USE BREIT FRAME BOSON MOMENTUM IF NECESSARY
2531 ET(2)=ET(1)+PC(5)**2+PHEP(5,IJET(2))**2
2535 ET(2)=PC(1)**2+PC(2)**2+PC(5)**2
2536 PP0=PHEP(4,IJT)+PHEP(3,IJT)
2537 PM0=PHEP(4,IJT)-PHEP(3,IJT)
2539 ET0=(PP0*PM0)+ET(1)-ET(2)
2540 DET=ET0**2-4.*(PP0*PM0)*ET(1)
2541 IF (DET.LT.ZERO) THEN
2545 ALF=(SQRT(DET)-ET0)/(2.*PP0*PP(2))
2551 DO 100 IHEP=IJET(2),IEND(2)
2552 CALL HWULOF(PB,PHEP(1,IHEP),PHEP(1,IHEP))
2553 CALL HWULF4(PB,VHEP(1,IHEP),VHEP(1,IHEP))
2554 C---BOOST FROM BREIT FRAME IF NECESSARY
2556 CALL HWUROB(RBR,PHEP(1,IHEP),PHEP(1,IHEP))
2557 CALL HWULOB(PBR,PHEP(1,IHEP),PHEP(1,IHEP))
2558 CALL HWUROB(RBR,VHEP(1,IHEP),VHEP(1,IHEP))
2559 CALL HWULB4(PBR,VHEP(1,IHEP),VHEP(1,IHEP))
2561 100 ISTHEP(IHEP)=ISTHEP(IHEP)+10
2562 CALL HWVDIF(4,VHEP(1,IPAR(2)),VHEP(1,IJET(2)),DISP)
2563 DO 110 IHEP=IJET(2),IEND(2)
2564 110 CALL HWVSUM(4,DISP,VHEP(1,IHEP),VHEP(1,IHEP))
2565 IF (IEND(2).GT.IJET(2)+1) ISTHEP(IJET(2)+1)=100
2566 CALL HWVSUM(4,PHEP(1,IJT),PHEP(1,IJET(2)),PC)
2567 CALL HWVSUM(4,PHEP(1,IP1),PHEP(1,IJET(2)),PHEP(1,ICM))
2568 CALL HWUMAS(PHEP(1,ICM))
2569 ELSEIF (IPRO/10.EQ.5) THEN
2570 C Special to preserve photon momentum
2571 ETC=PTX**2+PTY**2+PHEP(5,ICM)**2
2573 DET=ET0**2-4.*ETC*ET(1)
2574 IF (DET.LT.ZERO) THEN
2578 ALF=(SQRT(DET)+ET0-2.*ET(1))/(2.*PP(1)*PP(2))
2585 DO 120 IHEP=IJT,IEND(2)
2586 CALL HWULOF(PB,PHEP(1,IHEP),PHEP(1,IHEP))
2587 CALL HWULF4(PB,VHEP(1,IHEP),VHEP(1,IHEP))
2588 120 ISTHEP(IHEP)=ISTHEP(IHEP)+10
2589 CALL HWVDIF(4,VHEP(1,IPAR(2)),VHEP(1,IJT),DISP)
2590 DO 130 IHEP=IJT,IEND(2)
2591 130 CALL HWVSUM(4,DISP,VHEP(1,IHEP),VHEP(1,IHEP))
2592 IF (IEND(2).GT.IJT+1) ISTHEP(IJT+1)=100
2593 ISTHEP(IJET(1))=ISTHEP(IJET(1))+10
2594 CALL HWVSUM(2,PHEP(3,IPAR(1)),PHEP(3,IJT),PHEP(3,ICM))
2596 C--change to preserve either long mom or rapidity rather than long mom
2597 C--by PR and BRW 30/9/02
2599 C--PRESERVE LONG MOM OF CMF
2601 & SQRT(PTX**2+PTY**2+PHEP(3,ICM)**2+PHEP(5,ICM)**2)
2603 C--PRESERVE RAPIDITY OF CMF
2604 DET=SQRT(ONE+(PTX**2+PTY**2)/(PHEP(4,ICM)**2
2606 CALL HWVSCA(2,DET,PHEP(3,ICM),PHEP(3,ICM))
2608 C---NOW BOOST TO REQUIRED Q**2 AND X-F
2609 PP0=PHEP(4,ICM)+PHEP(3,ICM)
2610 PM0=PHEP(4,ICM)-PHEP(3,ICM)
2611 ET0=(PP0*PM0)+ET(1)-ET(2)
2612 DET=ET0**2-4.*(PP0*PM0)*ET(1)
2613 IF (DET.LT.ZERO) THEN
2618 AL(1)= 2.*PM0*PP(1)/DET
2619 AL(2)=(PM0/PP(2))*(1.-2.*ET(1)/DET)
2624 PB(3)=AL(IP)-(1./AL(IP))
2625 PB(4)=AL(IP)+(1./AL(IP))
2627 DO 140 IHEP=IJT,IEND(IP)
2628 CALL HWULOF(PB,PHEP(1,IHEP),PHEP(1,IHEP))
2629 CALL HWULF4(PB,VHEP(1,IHEP),VHEP(1,IHEP))
2630 140 ISTHEP(IHEP)=ISTHEP(IHEP)+10
2631 CALL HWVDIF(4,VHEP(1,IPAR(IP)),VHEP(1,IJT),DISP)
2632 DO 150 IHEP=IJT,IEND(IP)
2633 150 CALL HWVSUM(4,DISP,VHEP(1,IHEP),VHEP(1,IHEP))
2634 IF (IEND(IP).GT.IJT+1) THEN
2636 ELSEIF (IEND(IP).EQ.IJT) THEN
2645 C---SPECIAL CASE: IF HARD PROCESS IS W/Z DECAY, PERFORM KINEMATIC
2646 C RECONSTRUCTION IN ITS REST FRAME INSTEAD OF THE LAB FRAME
2647 IF (IDHW(ICM).GE.198.AND.IDHW(ICM).LE.200.AND.WZRFR) THEN
2648 CALL HWVEQU(5,PHEP(1,ICM),PLAB)
2649 CALL HWULOF(PLAB,PHEP(1,ICM),PHEP(1,ICM))
2650 CALL HWULF4(PLAB,VHEP(1,ICM),VHEP(1,ICM))
2652 CALL HWULOF(PLAB,PHEP(1,IPAR(IP)),PHEP(1,IPAR(IP)))
2653 CALL HWULF4(PLAB,VHEP(1,IPAR(IP)),VHEP(1,IPAR(IP)))
2656 C special for DIS: preserve outgoing lepton momentum
2658 CALL HWVEQU(5,PHEP(1,IPAR(1)),PHEP(1,IJET(1)))
2662 CALL HWVEQU(5,PHEP(1,ICM),PC)
2663 C--- PQ AND PC ARE OLD AND NEW PARTON CM
2664 CALL HWVSUM(4,PHEP(1,IPAR(1)),PHEP(1,IPAR(2)),PQ)
2668 170 CALL HWVSUM(4,PHEP(1,IPAR(KP)),PQ,PQ)
2672 IF (.NOT.DISLOW) THEN
2673 C---FIND JET CM MOMENTA
2678 EMJ=PHEP(5,IJET(KP))
2679 EMP=PHEP(5,IPAR(KP))
2680 JETRAD=JETRAD.OR.EMJ.NE.EMP
2683 C---N.B. ROUNDING ERRORS HERE AT HIGH ENERGIES
2684 PJ(KP)=(HWULDO(PHEP(1,IPAR(KP)),PQ)/ECM)**2-EMP**2
2685 IF (PJ(KP).LE.ZERO) CALL HWWARN('HWBJCO',104,*999)
2689 C---JETS DID RADIATE
2690 IF (EMS.GE.ECM) THEN
2698 ES=SQRT(PF*PJ(KP)+PM(KP))
2700 190 DMS=DMS+PJ(KP)/ES
2702 IF (DPF.GT.PF) DPF=0.9*PF
2704 200 IF (ABS(DPF).LT.EPS) GOTO 210
2705 CALL HWWARN('HWBJCO',105,*999)
2709 C---BOOST PC AND PQ TO BREIT FRAME IF NECESSARY
2710 IF (DISPRO.AND.BREIT) THEN
2711 CALL HWULOF(PBR,PC,PC)
2712 CALL HWUROF(RBR,PC,PC)
2713 IF (.NOT.DISLOW) THEN
2714 CALL HWULOF(PBR,PQ,PQ)
2715 CALL HWUROF(RBR,PQ,PQ)
2719 C---FIND CM ROTATION FOR JET IP
2720 IF (.NOT.DISLOW) THEN
2721 CALL HWVEQU(4,PHEP(1,IPAR(IP)),PR)
2722 IF (DISPRO.AND.BREIT) THEN
2723 CALL HWULOF(PBR,PR,PR)
2724 CALL HWUROF(RBR,PR,PR)
2726 CALL HWULOF(PQ,PR,PR)
2727 CALL HWUROT(PR, ONE,ZERO,RR)
2730 PR(3)=SQRT(PF*PJ(IP))
2731 PR(4)=SQRT(PF*PJ(IP)+PM(IP))
2732 PR(5)=PHEP(5,IJET(IP))
2733 CALL HWUROB(RR,PR,PR)
2734 C--Modified by BRW 25/10/02 to do boost in 2 stages (long,trans)
2739 PA(4)=SQRT(PA(3)**2+PA(5)**2)
2740 CALL HWULOB(PA,PR,PR)
2746 CALL HWULOB(PA,PR,PR)
2749 CALL HWVEQU(5,PC,PR)
2751 C---NOW PR IS LAB/BREIT MOMENTUM OF JET IP
2753 IF (AZCOR.AND.KP.LE.NHEP.AND.IDHW(KP).EQ.17) THEN
2754 C---ALIGN CONE WITH INTERFERING PARTON
2755 CALL HWUROT(PR, ONE,ZERO,RS)
2758 CALL HWWARN('HWBJCO',2,*999)
2761 CALL HWVEQU(4,PHEP(1,JP),PS)
2762 IF (DISPRO.AND.BREIT) THEN
2763 CALL HWULOF(PBR,PS,PS)
2764 CALL HWUROF(RBR,PS,PS)
2766 CALL HWUROF(RS,PS,PS)
2767 PTINF=PS(1)**2+PS(2)**2
2768 IF (PTINF.LT.EPS) THEN
2769 C---COLLINEAR JETS: ALIGN CONES
2771 IF (ISTHEP(JP).EQ.100.AND.(ISTHEP(JP-1)+9)/10.EQ.14) THEN
2772 CALL HWVEQU(4,PHEP(1,JP),PS)
2773 IF (DISPRO.AND.BREIT) THEN
2774 CALL HWULOF(PBR,PS,PS)
2775 CALL HWUROF(RBR,PS,PS)
2777 CALL HWUROF(RS,PS,PS)
2778 PTINF=PS(1)**2+PS(2)**2
2784 CALL HWVEQU(4,PHEP(1,KP),PB)
2785 IF (DISPRO.AND.BREIT) THEN
2786 CALL HWULOF(PBR,PB,PB)
2787 CALL HWUROF(RBR,PB,PB)
2789 PTCON=PB(1)**2+PB(2)**2
2790 IF (PTCON.NE.ZERO.AND.PTINF.NE.ZERO) THEN
2791 CN=1./SQRT(PTINF*PTCON)
2792 CP=CN*(PS(1)*PB(1)+PS(2)*PB(2))
2793 SP=CN*(PS(1)*PB(2)-PS(2)*PB(1))
2795 CALL HWRAZM( ONE,CP,SP)
2798 CALL HWRAZM( ONE,CP,SP)
2800 CALL HWUROT(PR,CP,SP,RS)
2801 C---FIND BOOST FOR JET IP
2802 ALF=(PHEP(3,IJET(IP))+PHEP(4,IJET(IP)))/
2803 & (PR(4)+SQRT((PR(4)+PR(5))*(PR(4)-PR(5))))
2811 IF (KHEP.LT.IHEP) KHEP=IHEP
2812 DO 220 JHEP=IHEP,KHEP
2813 CALL HWULOF(PB,PHEP(1,JHEP),PHEP(1,JHEP))
2814 CALL HWUROB(RS,PHEP(1,JHEP),PHEP(1,JHEP))
2815 CALL HWULF4(PB,VHEP(1,JHEP),VHEP(1,JHEP))
2816 CALL HWUROB(RS,VHEP(1,JHEP),VHEP(1,JHEP))
2817 C---BOOST FROM BREIT FRAME IF NECESSARY
2818 IF (DISPRO.AND.BREIT) THEN
2819 CALL HWUROB(RBR,PHEP(1,JHEP),PHEP(1,JHEP))
2820 CALL HWULOB(PBR,PHEP(1,JHEP),PHEP(1,JHEP))
2821 CALL HWUROB(RBR,VHEP(1,JHEP),VHEP(1,JHEP))
2822 CALL HWULB4(PBR,VHEP(1,JHEP),VHEP(1,JHEP))
2824 CALL HWVSUM(4,VHEP(1,JHEP),VHEP(1,IPAR(IP)),VHEP(1,JHEP))
2825 C--MHS FIX 07/03/05 FOR VERTEX POSITION OF LONG LIVED NON-PARTON JETS
2826 IF (KHEP.EQ.IHEP.AND.(IDHW(JHEP).GE.121.AND.IDHW(JHEP).LE.132
2827 $ .OR.IDHW(JHEP).EQ.59))
2828 $ CALL HWVSUM(4,VTXPIP,VHEP(1,JHEP),VHEP(1,JHEP))
2830 220 ISTHEP(JHEP)=ISTHEP(JHEP)+10
2831 IF (KHEP.GT.IHEP+1) THEN
2833 ELSEIF (KHEP.EQ.IHEP) THEN
2838 IF (ISTHEP(ICM).EQ.110) ISTHEP(ICM)=120
2839 C---SPECIAL CASE: FOR W/Z DECAY BOOST BACK TO THE LAB FRAME
2840 240 IF (IDHW(ICM).GE.198.AND.IDHW(ICM).LE.200.AND.WZRFR) THEN
2841 CALL HWULOB(PLAB,PHEP(1,ICM),PHEP(1,ICM))
2842 CALL HWULB4(PLAB,VHEP(1,ICM),VHEP(1,ICM))
2844 CALL HWULOB(PLAB,PHEP(1,IPAR(IP)),PHEP(1,IPAR(IP)))
2845 CALL HWULB4(PLAB,VHEP(1,IPAR(IP)),VHEP(1,IPAR(IP)))
2846 CALL HWULOB(PLAB,PHEP(1,IJET(IP)),PHEP(1,IJET(IP)))
2847 C--MHS FIX 07/03/05 - DO NOT REBOOST PRIMARY VERTEX
2848 IF (ISTHEP(IJET(IP)).EQ.190)
2849 $ CALL HWVDIF(4,VHEP(1,IJET(IP)),VTXPIP,VHEP(1,IJET(IP)))
2850 CALL HWULB4(PLAB,VHEP(1,IJET(IP)),VHEP(1,IJET(IP)))
2851 IF (ISTHEP(IJET(IP)).EQ.190)
2852 $ CALL HWVSUM(4,VHEP(1,IJET(IP)),VTXPIP,VHEP(1,IJET(IP)))
2854 IF (JDAHEP(1,IJET(IP)).GT.0) THEN
2855 IF (JDAHEP(2,IJET(IP)).GT.JDAHEP(1,IJET(IP))) THEN
2856 CALL HWULOB(PLAB,PHEP(1,IJET(IP)+1),PHEP(1,IJET(IP)+1))
2857 CALL HWULB4(PLAB,VHEP(1,IJET(IP)+1),VHEP(1,IJET(IP)+1))
2859 DO 250 IHEP=JDAHEP(1,IJET(IP)),JDAHEP(2,IJET(IP))
2860 CALL HWULOB(PLAB,PHEP(1,IHEP),PHEP(1,IHEP))
2861 CALL HWULB4(PLAB,VHEP(1,IHEP),VHEP(1,IHEP))
2871 *CMZ :- -26/04/91 11.11.54 by Bryan Webber
2872 *-- Author : Bryan Webber
2873 C-----------------------------------------------------------------------
2875 C-----------------------------------------------------------------------
2876 C Passes backwards through a jet cascade calculating the masses
2877 C and magnitudes of the longitudinal and transverse three momenta.
2878 C Components given relative to direction of parent for a time-like
2879 C vertex and with respect to z-axis for space-like vertices.
2881 C On input PPAR(1-5,*) contains:
2882 C (E*sqrt(Xi),Xi,3-mom (if external),E,M-sq (if external))
2884 C On output PPAR(1-5,*) (if TMPAR(*)), containts:
2885 C (P-trans,Xi or Xilast,P-long,E,M)
2886 C-----------------------------------------------------------------------
2887 INCLUDE 'HERWIG65.INC'
2888 DOUBLE PRECISION HWUSQR,EXI,PISQ,PJPK,EJEK,PTSQ,Z,ZMIN,ZMAX,
2889 $ EMI,EMJ,EMK,C,NQ,HWBVMC,RHO,POLD,PNEW,EOLD,ENEW,A,B
2890 INTEGER IPAR,JPAR,KPAR,MPAR,I,J,K
2892 IF (IERROR.NE.0) RETURN
2894 DO 30 MPAR=NPAR-1,3,-2
2896 C Find parent and partner of this branch
2899 C Determine type of branching
2900 IF (TMPAR(IPAR)) THEN
2901 C Time-like branching
2902 C Compute mass of parent
2903 EXI=PPAR(1,JPAR)*PPAR(1,KPAR)
2904 PPAR(5,IPAR)=PPAR(5,JPAR)+PPAR(5,KPAR)+2.*EXI
2905 C Compute three momentum of parent
2906 PISQ=PPAR(4,IPAR)*PPAR(4,IPAR)-PPAR(5,IPAR)
2907 PPAR(3,IPAR)=HWUSQR(PISQ)
2908 C---SPECIAL FOR G-->QQBAR: READJUST ANGULAR DISTRIBUTION
2909 IF (IDPAR(IPAR).EQ.13 .AND. IDPAR(JPAR).LT.13) THEN
2910 Z=PPAR(4,JPAR)/PPAR(4,IPAR)
2911 ZMIN=HWBVMC(IDPAR(JPAR))/PPAR(1,JPAR)*Z
2912 RHO=(Z*(3-Z*(3-2*Z))-ZMIN*(3-ZMIN*(3-2*ZMIN)))
2913 $ /(2*(1-2*ZMIN)*(1-ZMIN*(1-ZMIN)))
2914 NQ=PPAR(3,IPAR)*(PPAR(3,IPAR)+PPAR(4,IPAR))
2918 ZMIN=MAX((EMI+EMJ-EMK)/(2*(EMI+NQ)),
2919 $ (EMI+EMJ-EMK-SQRT(ABS((EMI-EMJ-EMK)**2-4*EMJ*EMK)))/(2*EMI))
2920 ZMAX=1-MAX((EMI-EMJ+EMK)/(2*(EMI+NQ)),
2921 $ (EMI-EMJ+EMK-SQRT(ABS((EMI-EMJ-EMK)**2-4*EMJ*EMK)))/(2*EMI))
2922 C=2*RMASS(IDPAR(JPAR))**2/EMI
2923 Z=(4*ZMIN*(1.5*(1+C-ZMIN)+ZMIN**2)*(1-RHO)
2924 $ +4*ZMAX*(1.5*(1+C-ZMAX)+ZMAX**2)*RHO-2-3*C)/(1+2*C)**1.5
2925 Z=SQRT(1+2*C)*SINH(LOG(Z+SQRT(Z**2+1))/3)+0.5
2926 Z=(Z*NQ+(EMI+EMJ-EMK)/2)/(NQ+EMI)
2927 PPAR(4,JPAR)=Z*PPAR(4,IPAR)
2928 PPAR(4,KPAR)=PPAR(4,IPAR)-PPAR(4,JPAR)
2929 PPAR(3,JPAR)=HWUSQR(PPAR(4,JPAR)**2-EMJ)
2930 PPAR(3,KPAR)=HWUSQR(PPAR(4,KPAR)**2-EMK)
2931 PPAR(2,JPAR)=EXI/(PPAR(4,JPAR)*PPAR(4,KPAR))
2932 IF(JDAPAR(2,JPAR).NE.0)PPAR(2,JDAPAR(2,JPAR))=PPAR(2,JPAR)
2933 IF(JDAPAR(2,KPAR).NE.0)PPAR(2,JDAPAR(2,KPAR))=PPAR(2,JPAR)
2934 C---FIND DESCENDENTS OF THIS SPLITTING AND READJUST THEIR MOMENTA TOO
2935 DO 20 J=JPAR+2,NPAR-1,2
2938 IF (I.GT.IPAR) GOTO 10
2942 POLD=PPAR(3,J)+PPAR(3,K)
2943 EOLD=PPAR(4,J)+PPAR(4,K)
2944 PNEW=HWUSQR(PPAR(4,I)**2-PPAR(5,I))
2946 A=(ENEW*EOLD-PNEW*POLD)/PPAR(5,I)
2947 B=(PNEW*EOLD-ENEW*POLD)/PPAR(5,I)
2948 PPAR(3,J)=A*PPAR(3,J)+B*PPAR(4,J)
2949 PPAR(4,J)=(PPAR(4,J)+B*PPAR(3,J))/A
2950 PPAR(3,K)=PNEW-PPAR(3,J)
2951 PPAR(4,K)=ENEW-PPAR(4,J)
2952 PPAR(2,J)=1-(PPAR(3,J)*PPAR(3,K)+PPAR(1,J)*PPAR(1,K))
2953 $ /(PPAR(4,J)*PPAR(4,K))
2954 IF (JDAPAR(2,J).NE.0) PPAR(2,JDAPAR(2,J))=PPAR(2,J)
2955 IF (JDAPAR(2,K).NE.0) PPAR(2,JDAPAR(2,K))=PPAR(2,J)
2959 C Compute daughter' transverse and longitudinal momenta
2960 PJPK=PPAR(3,JPAR)*PPAR(3,KPAR)
2961 EJEK=PPAR(4,JPAR)*PPAR(4,KPAR)-EXI
2962 PTSQ=(PJPK+EJEK)*(PJPK-EJEK)/PISQ
2963 PPAR(1,JPAR)=HWUSQR(PTSQ)
2964 PPAR(3,JPAR)=HWUSQR(PPAR(3,JPAR)*PPAR(3,JPAR)-PTSQ)
2965 PPAR(1,KPAR)=-PPAR(1,JPAR)
2966 PPAR(3,KPAR)= PPAR(3,IPAR)-PPAR(3,JPAR)
2968 C Space-like branching
2969 C Re-arrange such that JPAR is time-like
2970 IF (TMPAR(KPAR)) THEN
2974 C Compute time-like branch
2975 PTSQ=(2.-PPAR(2,JPAR))*PPAR(1,JPAR)*PPAR(1,JPAR)
2977 PPAR(1,JPAR)=HWUSQR(PTSQ)
2978 PPAR(3,JPAR)=(1.-PPAR(2,JPAR))*PPAR(4,JPAR)
2979 PPAR(3,IPAR)=PPAR(3,KPAR)-PPAR(3,JPAR)
2983 C Reset Xi to Xilast
2984 PPAR(2,KPAR)=PPAR(2,IPAR)
2988 40 PPAR(5,IPAR)=HWUSQR(PPAR(5,IPAR))
2993 *CMZ :- -14/10/99 18.04.56 by Mike Seymour
2994 *-- Author : Bryan Webber & Mike Seymour
2995 C-----------------------------------------------------------------------
2996 SUBROUTINE HWBRAN(KPAR)
2997 C-----------------------------------------------------------------------
2998 C BRANCHES TIMELIKE PARTON KPAR INTO TWO, PUTS PRODUCTS
2999 C INTO NPAR+1 AND NPAR+2, AND INCREASES NPAR BY TWO
3000 C-----------------------------------------------------------------------
3001 INCLUDE 'HERWIG65.INC'
3002 DOUBLE PRECISION HWBVMC,HWRGEN,HWUALF,HWUTAB,HWRUNI,HWULDO,PMOM,
3003 & QNOW,QLST,QKTHR,RN,QQBAR,DQQ,QGTHR,SNOW,QSUD,ZMIN,ZMAX,ZRAT,WMIN,
3004 & QLAM,Z1,Z2,ETEST,ZTEST,ENOW,XI,XIPREV,EPREV,QMAX,QGAM,SLST,SFNL,
3005 & TARG,ALF,BETA0(3:6),BETAP(3:6),SQRK(4:6,5),REJFAC,Z,X1,X2,OTHXI,
3006 & OTHZ,X3,FF,AW,XCUT,CC,JJ,HWUSQR
3007 INTEGER HWRINT,KPAR,ID,JD,IS,NTRY,N,ID1,ID2,MPAR,ISUD(13),IHEP,
3008 & JHEP,M,NF,NN,IREJ,NREJ,ITOP
3009 EXTERNAL HWBVMC,HWRGEN,HWUALF,HWUTAB,HWRUNI,HWULDO,HWRINT,HWUSQR
3010 SAVE BETA0,BETAP,SQRK
3011 DATA ISUD,BETA0/2,2,3,4,5,6,2,2,3,4,5,6,1,4*ZERO/
3012 IF (IERROR.NE.0) RETURN
3013 C---SET SQRK(M,N) TO THE PROBABILITY THAT A GLUON WILL NOT PRODUCE A
3014 C QUARK-ANTIQUARK PAIR BETWEEN SCALES RMASS(M) AND 2*HWBVMC(N)
3015 IF (SUDORD.NE.1.AND.BETA0(3).EQ.ZERO) THEN
3017 BETA0(M)=(11.*CAFAC-2.*M)*0.5
3018 100 BETAP(M)=(17.*CAFAC**2-(5.*CAFAC+3.*CFFAC)*M)
3019 & /BETA0(M)*0.25/PIFAC
3024 ELSEIF (M.EQ.4.OR.M.EQ.N+1) THEN
3026 IF (2*HWBVMC(N).GT.RMASS(M)) NF=M+1
3027 SQRK(M,N)=((BETAP(NF-1)+1/HWUALF(1,2*HWBVMC(N)))/
3028 $ (BETAP(NF-1)+1/HWUALF(1,RMASS(M))))**(1/BETA0(NF-1))
3030 SQRK(M,N)=SQRK(M-1,N)*
3031 $ ((BETAP(M-1)+1/HWUALF(1,RMASS(M-1)))/
3032 $ (BETAP(M-1)+1/HWUALF(1,RMASS(M))))**(1/BETA0(M-1))
3038 C--TEST FOR PARTON TYPE
3042 ELSEIF (ID.GE.209.AND.ID.LE.220) THEN
3050 C--TIMELIKE PARTON BRANCHING
3053 IF (JMOPAR(1,KPAR).EQ.0) THEN
3056 EPREV=PPAR(4,JMOPAR(1,KPAR))
3058 C--IF THIS IS CHARGED & PHOTONS ARE ALLOWED, ANGLES MIGHT NOT BE ORDERED
3061 IF (ICHRG(ID).NE.0 .AND. VPCUT.LT.PPAR(1,2)) THEN
3062 C--LOOK FOR A PREVIOUS G->QQBAR, IF ANY
3064 1 IF (JMOPAR(1,MPAR).NE.0) THEN
3065 IF (IDPAR(JMOPAR(1,MPAR)).EQ.ID) THEN
3070 C--IF CLIMBED TO THE TOP OF THE LIST, FIND QED INTERFERENCE PARTNER
3074 IHEP=JDAHEP(2,JCOPAR(1,1))
3075 IF (IHEP.GT.0) JHEP=JDAHEP(2,IHEP)
3077 IHEP=JMOHEP(2,JCOPAR(1,1))
3078 IF (IHEP.GT.0) JHEP=JMOHEP(2,IHEP)
3080 IF (IHEP.GT.0.AND.JHEP.GT.0) THEN
3081 QMAX=HWULDO(PHEP(1,IHEP),PHEP(1,JHEP))
3082 & *(ENOW/PPAR(4,2))**2
3084 C--FIX AT HARD PROCESS SCALE IF POINTER NOT YET SET
3085 C (CAN HAPPEN IN SUSY EVENTS)
3089 QMAX=ENOW**2*PPAR(2,MPAR)
3091 C--IF PREVIOUS BRANCHING WAS Q->QGAMMA, LOOK FOR A QCD BRANCHING
3093 2 IF (JMOPAR(1,MPAR).NE.0) THEN
3094 IF (IDPAR(JDAPAR(1,JMOPAR(1,MPAR))).EQ.59 .OR.
3095 & IDPAR(JDAPAR(2,JMOPAR(1,MPAR))).EQ.59) THEN
3100 QLST=ENOW**2*PPAR(2,MPAR)
3101 QMAX=SQRT(MAX(ZERO,MIN(
3102 & QMAX , EPREV**2*XIPREV , ENOW**2*XIPREV*(2-XIPREV))))
3104 & QLST , EPREV**2*XIPREV , ENOW**2*XIPREV*(2-XIPREV)))
3108 IF (NTRY.GT.NBTRY) CALL HWWARN('HWBRAN',100,*999)
3110 C--GLUON -> QUARK+ANTIQUARK OPTION
3111 IF (QLST.GT.QCDL3) THEN
3114 IF (QLST.GT.QKTHR) THEN
3116 IF (SUDORD.NE.1) THEN
3117 C---FIND IN WHICH FLAVOUR INTERVAL THE UPPER LIMIT LIES
3119 DO 200 M=MAX(3,N),NFLAV
3120 200 IF (QLST.GT.RMASS(M)) NF=M
3121 C---CALCULATE THE FORM FACTOR
3122 IF (NF.EQ.MAX(3,N)) THEN
3123 SFNL=((BETAP(NF)+1/HWUALF(1,QKTHR))/
3124 $ (BETAP(NF)+1/HWUALF(1,QLST)))**(1/BETA0(NF))
3127 SFNL=((BETAP(NF)+1/HWUALF(1,RMASS(NF)))/
3128 $ (BETAP(NF)+1/HWUALF(1,QLST)))**(1/BETA0(NF))
3129 SLST=SFNL*SQRK(NF,N)
3132 IF (RN.GT.1.E-3) THEN
3133 QQBAR=QCDL3*(QLST/QCDL3)**(RN**BETAF)
3137 IF (SUDORD.NE.1) THEN
3138 C---FIND IN WHICH FLAVOUR INTERVAL THE SOLUTION LIES
3139 IF (RN.GE.SFNL) THEN
3141 ELSEIF (RN.GE.SLST) THEN
3143 DO 210 M=MAX(3,N)+1,NF-1
3144 210 IF (RN.GE.SLST/SQRK(M,N)) NN=M
3153 TARG=HWUALF(1,RMASS(NN+1))
3154 RN=RN/SLST*SQRK(NN+1,N)
3156 TARG=1/((BETAP(NN)+1/TARG)*RN**BETA0(NN)-BETAP(NN))
3157 C---NOW SOLVE HWUALF(1,QQBAR)=TARG FOR QQBAR ITERATIVELY
3158 7 QQBAR=MAX(QQBAR,HALF*QKTHR)
3160 IF (ABS(ALF-TARG).GT.ACCUR) THEN
3162 IF (NTRY.GT.NBTRY) CALL HWWARN('HWBRAN',101,*999)
3163 QQBAR=QQBAR*(1+3*PIFAC*(ALF-TARG)
3164 $ /(BETA0(NN)*ALF**2*(1+BETAP(NN)*ALF)))
3169 IF (QQBAR.GT.QNOW.AND.QQBAR.GT.QKTHR) THEN
3178 C--GLUON->DIQUARKS OPTION
3179 9 IF (QLST.LT.QDIQK) THEN
3180 IF (PDIQK.NE.ZERO) THEN
3182 DQQ=QLST*EXP(-RN/PDIQK)
3183 IF (DQQ.GT.QNOW) THEN
3184 IF (DQQ.GT.2.*RMASS(115)) THEN
3192 C--ENHANCE GLUON AND PHOTON EMISSION BY A FACTOR OF TWO IF THIS BRANCH
3193 C IS CAPABLE OF BEING THE HARDEST SO FAR
3195 IF (TMPAR(2).AND.0.25*MAX(QLST,QMAX).GT.HARDST) NREJ=2
3196 C--BRANCHING ID->ID+GLUON
3197 QGTHR=HWBVMC(ID)+HWBVMC(13)
3198 IF (QLST.GT.QGTHR) THEN
3201 SLST=HWUTAB(SUD(1,IS),QEV(1,IS),NQEV,QLST,INTER)
3202 IF (RN.EQ.ZERO) THEN
3207 IF (SNOW.LT.ONE) THEN
3208 QSUD=HWUTAB(QEV(1,IS),SUD(1,IS),NQEV,SNOW,INTER)
3209 C---IF FORM FACTOR DID NOT GET INVERTED CORRECTLY TRY LINEAR INSTEAD
3210 IF (QSUD.GT.QLST) THEN
3211 SNOW=HWUTAB(SUD(1,IS),QEV(1,IS),NQEV,QLST,1)/RN
3212 QSUD=HWUTAB(QEV(1,IS),SUD(1,IS),NQEV,SNOW,1)
3213 IF (QSUD.GT.QLST) THEN
3214 CALL HWWARN('HWBRAN',1,*999)
3218 IF (QSUD.GT.QGTHR.AND.QSUD.GT.QNOW) THEN
3225 C--BRANCHING ID->ID+PHOTON
3226 IF (ICHRG(ID).NE.0) THEN
3227 QGTHR=MAX(HWBVMC(ID)+HWBVMC(59),HWBVMC(59)*EXP(0.75))
3228 IF (QMAX.GT.QGTHR) THEN
3231 IF (RN.EQ.ZERO) THEN
3234 QGAM=(LOG(QMAX/HWBVMC(59))-0.75)**2
3235 & +PIFAC*9/(ICHRG(ID)**2*ALPFAC*ALPHEM)*LOG(RN)
3236 IF (QGAM.GT.ZERO) THEN
3237 QGAM=HWBVMC(59)*EXP(0.75+SQRT(QGAM))
3242 IF (QGAM.GT.QGTHR.AND.QGAM.GT.QNOW) THEN
3249 IF (QNOW.GT.ZERO) THEN
3250 C--BRANCHING HAS OCCURRED
3251 ZMIN=HWBVMC(ID2)/QNOW
3255 C--GLUON -> GLUON + GLUON
3258 ETEST=(1.-WMIN)**2*HWUALF(5-SUDORD*2,QNOW*WMIN)
3259 ZRAT=(ZMAX*(1-ZMIN))/(ZMIN*(1-ZMAX))
3260 C--CHOOSE Z1 DISTRIBUTED ON (ZMIN,ZMAX)
3261 C ACCORDING TO GLUON BRANCHING FUNCTION
3262 10 Z1=ZMAX/(ZMAX+(1-ZMAX)*ZRAT**HWRGEN(0))
3264 ZTEST=(1.-(Z1*Z2))**2*HWUALF(5-SUDORD*2,QNOW*(Z1*Z2))
3265 IF (ZTEST.LT.ETEST*HWRGEN(1)) GOTO 10
3267 ELSEIF (ID2.NE.115) THEN
3270 ETEST=ZMIN**2+ZMAX**2
3271 20 Z1=HWRUNI(0,ZMIN,ZMAX)
3274 IF (ZTEST.LT.ETEST*HWRGEN(0)) GOTO 20
3276 C--GLUON -> DIQUARKS
3279 Z1=HWRUNI(0,ZMIN,ZMAX)
3283 C--QUARK OR ANTIQUARK BRANCHING
3286 ZMAX=1.-HWBVMC(ID)/QNOW
3287 WMIN=MIN(ZMIN*(1.-ZMIN),ZMAX*(1.-ZMAX))
3288 ETEST=(1.+ZMAX**2)*HWUALF(5-SUDORD*2,QNOW*WMIN)
3290 30 Z1=ZMIN*ZRAT**HWRGEN(0)
3292 ZTEST=(1.+Z2*Z2)*HWUALF(5-SUDORD*2,QNOW*Z1*Z2)
3293 IF (ZTEST.LT.ETEST*HWRGEN(1)) GOTO 30
3296 ZMIN= HWBVMC(59)/QNOW
3297 ZMAX=1-HWBVMC(ID)/QNOW
3300 40 Z1=ZMIN*ZRAT**HWRGEN(0)
3303 IF (ZTEST.LT.ETEST*HWRGEN(1)) GOTO 40
3305 C--QUARKS EMIT ON LOWER SIDE, ANTIQUARKS ON UPPER SIDE
3316 C--UPDATE THIS BRANCH AND CREATE NEW BRANCHES
3318 IF (ID1.NE.59.AND.ID2.NE.59) THEN
3319 IF (ID.EQ.13.AND.ID1.NE.13) THEN
3324 IF (SUDORD.EQ.1.AND.HWUALF(2,QLAM).LT.HWRGEN(0) .OR.
3325 & (2.-XI)*(QNOW*Z1*Z2)**2.GT.EMSCA**2) THEN
3326 C--BRANCHING REJECTED: REDUCE Q AND REPEAT
3333 C--IF THIS IS HARDEST EMISSION SO FAR, APPLY MATRIX-ELEMENT CORRECTION
3334 IF (ID.NE.13.OR.ID1.EQ.13) THEN
3337 IF (TMPAR(2).AND.QLAM.GT.HARDST) THEN
3338 C----SOFT MATRIX-ELEMENT CORRECTION TO TOP DECAYS
3340 IF (ISTHEP(ITOP).EQ.155.AND.(IDHW(ITOP).EQ.6
3341 $ .OR.IDHW(ITOP).EQ.12)) THEN
3342 AW=(PHEP(5,JDAHEP(1,ITOP))/PHEP(5,ITOP))**2
3343 FF=0.5*(1-AW)*(1-2*AW+1/AW)
3345 X1=1-2*CC*Z*(1-Z)*XI
3346 X3=0.5*(1-AW+2*CC*Z*(1-Z)*XI-(1-2*Z)
3347 & *HWUSQR(((1+AW-2*CC*Z*(1-Z)*XI)**2-4*AW)
3348 & /(1-2*Z*(1-Z)*XI)))
3349 C-----JACOBIAN FACTOR
3350 JJ=(1-X1)*(2-AW-X1-2*X3)*(1-2*Z*(1-Z)*XI)/(
3351 $ 4*CC**2*((X1+AW)**2-4*AW)*Z**2*(1-Z)**2*(1-2*Z)*XI)
3352 C-----REJECTION FACTOR
3353 XCUT=2*GCUTME/PHEP(5,ITOP)
3354 IF (X3.GT.XCUT) REJFAC=FF*JJ
3355 & *X3**2*(1-X1)*(1+(1-Z)**2)/(Z*XI)
3356 & /((1+1/AW-2*AW)*((1-AW)*X3-(1-X1)
3357 & *(1-X3)-X3**2)+(1+1/(2*AW))*X3*(X1+X3-1)**2
3359 ELSEIF (MOD(ISTHEP(JCOPAR(1,1)),10).GE.3) THEN
3360 C---COLOUR PARTNER IS ALSO OUTGOING
3362 X2=0.5*(1+Z*(1-Z)*XI +
3363 $ (1-Z*(1-Z)*XI)*(1-2*Z)/SQRT(1-2*Z*(1-Z)*XI))
3364 REJFAC=SQRT(2*X1-1)/(X1*Z*(1-Z))
3365 $ *(1+(1-Z)**2)/(Z*XI)
3366 $ *(1-X1)*(1-X2)/(X1**2+X2**2)
3367 C---CHECK WHETHER IT IS IN THE OVERLAP REGION
3368 OTHXI=4*(1-X2)*X2**2/(X2**2-(2*X2-1)*(2*X1+X2-2)**2)
3369 IF (OTHXI.LT.ONE) THEN
3370 OTHZ=0.5*(1-SQRT(2*X2-1)/X2*(2*X1+X2-2))
3371 REJFAC=REJFAC+SQRT(2*X2-1)/(X2*OTHZ*(1-OTHZ))
3372 $ *(1+(1-OTHZ)**2)/(OTHZ*OTHXI)
3373 $ *(1-X2)*(1-X1)/(X2**2+X1**2)
3376 C---COLOUR PARTNER IS INCOMING (X1=XP, X2=ZP)
3378 X2=0.5*(1+(1-2*Z)/SQRT(1-2*Z*(1-Z)*XI))
3379 REJFAC=SQRT(3-2/X1)/(X1**2*Z*(1-Z))
3380 $ *(1+(1-Z)**2)/(Z*XI)
3382 $ (1+(1-X1-X2+2*X1*X2)**2+2*(1-X1)*(1-X2)*X1*X2)
3383 C---CHECK WHETHER IT IS IN THE OVERLAP REGION
3384 OTHXI=(SQRT(X1+2*(1-X2)*(1-X2+X1*X2))-SQRT(X1))**2/
3385 $ (1+X1-X2-SQRT(X1*(X1+2*(1-X2)*(1-X2+X1*X2))))
3386 OTHZ=(SQRT(X1*(X1+2*(1-X2)*(1-X2+X1*X2)))-X1)/(1-X2)
3387 IF (OTHXI.LT.OTHZ**2) THEN
3388 REJFAC=REJFAC+OTHZ**3*(1-X1-X2+2*X1*X2)
3389 $ /(X1**2*(1-OTHZ)*(OTHZ+OTHXI*(1-OTHZ)))
3390 $ *(1+OTHZ**2)/((1-OTHZ)*OTHXI)
3392 $ (1+(1-X1-X2+2*X1*X2)**2+2*(1-X1)*(1-X2)*X1*X2)
3396 IF (NREJ*REJFAC*HWRGEN(NREJ).GT.ONE) THEN
3402 IF (QLAM.GT.HARDST) HARDST=QLAM
3407 PPAR(1,MPAR)=QNOW*Z1
3409 PPAR(4,MPAR)=ENOW*Z1
3413 PPAR(1,NPAR)=QNOW*Z2
3415 PPAR(4,NPAR)=ENOW*Z2
3416 C---NEW MOTHER-DAUGHTER RELATIONS
3421 C---NEW COLOUR CONNECTIONS
3431 IF (QNOW.LT.ZERO) THEN
3433 IF (ID.EQ.IDPAR(2).AND.PPAR(5,2).GT.1D-6) THEN
3434 PPAR(5,KPAR)=PPAR(5,2)**2
3436 PPAR(5,KPAR)=RMASS(ID)**2
3438 PMOM=PPAR(4,KPAR)**2-PPAR(5,KPAR)
3439 IF (PMOM.LT.-1E-6) CALL HWWARN('HWBRAN',104,*999)
3440 IF (PMOM.LT.ZERO) PMOM=ZERO
3441 PPAR(3,KPAR)=SQRT(PMOM)
3449 *CMZ :- -31/03/00 17:54:05 by Peter Richardson
3450 *-- Author : Peter Richardson
3451 C-----------------------------------------------------------------------
3453 C-----------------------------------------------------------------------
3454 C SUBROUTINE TO REPLACE HWBCON IN RPARITY VIOLATING SUSY
3455 C BASED ON HWBCON BY BRW
3456 C-----------------------------------------------------------------------
3457 INCLUDE 'HERWIG65.INC'
3458 INTEGER IHEP,IST,ID,JC,JD,JHEP,IDP,IDM,IDP2,IDM2,
3459 & RHEP,IST2,ORG,ANTC,XHEP,IP,COLP
3460 LOGICAL BVVUSE,BVVHRD,BVDEC1,BVDEC2,COLRD,ACOLRD,BVHRD,BVHRD2,
3462 C--logical functions to decide if baryon number violating
3464 BVDEC1(IP) = ((IDHW(IP).GE.419.AND.IDHW(IP).LE.424).OR.
3465 & IDHW(IP).EQ.411.OR.IDHW(IP).EQ.412.OR.
3466 & IDHW(IP).EQ.449).AND.IDHW(JDAHEP(1,IP)).LE.6.
3467 & AND.IDHW(JDAHEP(1,IP)+1).LE.6.AND.
3468 & IDHW(JDAHEP(2,IP)).LE.6
3470 BVDEC2(IP) = ((IDHW(IP).GE.413.AND.IDHW(IP).LE.418).OR.
3471 & IDHW(IP).EQ.405.OR.IDHW(IP).EQ.406.OR.
3472 & IDHW(IP).EQ.449).AND.
3473 & IDHW(JDAHEP(1,IP)).GE.7.AND.IDHW(JDAHEP(1,IP)).LE.12.AND.
3474 & IDHW(JDAHEP(1,IP)+1).GE.7.AND.IDHW(JDAHEP(1,IP)+1).LE.12.AND.
3475 & IDHW(JDAHEP(2,IP)).GE.7.AND.IDHW(JDAHEP(2,IP)).LE.12
3476 C--Neutralino and Chargino Decays
3477 BVDEC3(IP) = ((IDHW(IP).GE.450.AND.IDHW(IP).LE.457).AND.
3478 & (IDHW(JDAHEP(1,IP)).LE.12.AND.IDHW(JDAHEP(1,IP)+1).LE.12.
3479 & .AND.IDHW(JDAHEP(2,IP)).LE.12))
3480 C--Now the hard vertices
3481 BVHRD(IP) = IDHW(IP).EQ.15.AND.IDHW(JMOHEP(1,IP)).LE.12.
3482 & AND.IDHW(JMOHEP(2,IP)).LE.12.AND.IDHW(JDAHEP(1,IP)).LE.12.
3483 & AND.IDHW(JDAHEP(2,IP)).GE.449.AND.IDHW(JDAHEP(2,IP)).LE.457
3484 BVHRD2(IP) = IDHW(IP).EQ.15.AND.IDHW(JMOHEP(1,IP)).LE.12.
3485 & AND.IDHW(JMOHEP(2,IP)).LE.12.AND.IDHW(JDAHEP(1,IP)).GE.198.
3486 & AND.IDHW(JDAHEP(1,IP)).LE.207.
3487 & AND.ABS(IDHEP(JDAHEP(2,IP))).GT.1000000
3488 C--Those particles which are coloured
3489 COLRD(IP) = IP.LE.6.OR.IP.EQ.13.OR.IP.EQ.449.OR.
3490 & (IP.GE.401.AND.IP.LE.406).OR.(IP.GE.413.AND.IP.LE.418).OR.
3491 & (IP.GE.115.AND.IP.LE.120).OR.IP.EQ.59
3492 C--Those particles which are anticoloured
3493 ACOLRD(IP) = (IP.GE.7.AND.IP.LE.12).OR.IP.EQ.13.OR.IP.EQ.449.OR.
3494 & (IP.GE.407.AND.IP.LE.412).OR.(IP.GE.419.AND.IP.LE.424).OR.
3495 & (IP.GE.109.AND.IP.LE.114).OR.IP.EQ.59
3496 IF (IERROR.NE.0) RETURN
3497 C--Added 31/03/00 PR
3498 IF(NHEP.GT.NMXHEP) CALL HWWARN('HWBRCN',101,*999)
3500 IF(COLUPD.AND.HRDCOL(1,3).NE.0) THEN
3502 DO IHEP = HRDCOL(1,3),HRDCOL(1,3)+4
3505 JMOHEP(2,IHEP) = HRDCOL(1,JD)
3506 JDAHEP(2,IHEP) = HRDCOL(2,JD)
3523 C---LOOK FOR PARTONS WITHOUT COLOUR MOTHERS
3524 IF ((IST.LT.145.OR.IST.GT.152).AND.IST.NE.155) GOTO 110
3525 IF (JMOHEP(2,IHEP).EQ.0) THEN
3526 C---FIND COLOUR-CONNECTED PARTON
3527 IF(IST.EQ.155.AND.ABS(IDHEP(IHEP)).EQ.6) THEN
3529 ELSEIF(IST.EQ.155) THEN
3534 IF (IST.NE.152) JC=JMOHEP(1,JC)
3535 C--Correction for BV
3536 IF(HRDCOL(1,1).NE.0) THEN
3537 IDP = IDHW(HRDCOL(1,1))
3544 IF(BVDEC1(IDM).OR.BVDEC2(IDM)) THEN
3545 IF(IDHW(IDM).EQ.449.AND.JDAHEP(1,IDM).EQ.JC) THEN
3550 IF(JC.EQ.JD) JD= JDAHEP(2,JC-1)
3553 C--NEW FOR BV HARD PROCESS
3554 ELSEIF(BVHRD(IDM)) THEN
3555 IF(IDHW(JDAHEP(2,JMOHEP(1,JC))).EQ.449) THEN
3557 IDM2 = JDAHEP(2,HRDCOL(1,2))
3558 IF(JD.EQ.IDM2) JD = HRDCOL(1,1)
3559 IF(JC.EQ.JDAHEP(2,IDM2).AND.COLRD(IDHW(IHEP))) THEN
3561 ELSEIF(JC.EQ.IDM2) THEN
3562 IF(JDAHEP(2,JMOHEP(2,JC)).EQ.JC) THEN
3565 JMOHEP(2,IHEP)=JMOHEP(2,JC)
3572 IF(ACOLRD(IDHW(IHEP))) JC = JD
3573 IF(JC.EQ.IDM2) GOTO 110
3580 ELSEIF(BVHRD2(IDM)) THEN
3582 IF(JC.EQ.JDAHEP(2,HRDCOL(1,2))) THEN
3583 JMOHEP(2,IHEP)=JMOHEP(2,JC)
3586 IF(JD.EQ.JDAHEP(2,HRDCOL(1,2))) JD = HRDCOL(1,1)
3589 IF(JC.EQ.JDAHEP(2,HRDCOL(1,2))) THEN
3597 IF (JC.EQ.0) CALL HWWARN('HWBCON',51,*110)
3598 C---FIND SPECTATOR WHEN JC IS DECAYED HEAVY QUARK OR SUSY PARTICLE
3599 IF (ISTHEP(JC).EQ.155) THEN
3600 IF (IDHEP(JMOHEP(1,JC)).EQ.94) THEN
3601 C---DECAYED BEFORE HADRONIZING
3609 IF(JHEP.EQ.0.AND.ABS(IDHEP(JC)).EQ.6) THEN
3610 JHEP = JMOHEP(1,JMOHEP(1,JC))
3611 IF(BVDEC1(JMOHEP(1,JHEP)).OR.BVDEC2(JMOHEP(1,JHEP))) THEN
3613 JHEP = JDAHEP(2,JC-1)
3618 IF(BVVUSE.AND.ABS(IDHEP(JHEP)).GT.1000000.AND.
3619 & ISTHEP(JHEP).NE.155.OR.JHEP.EQ.0) GOTO 110
3621 IF (ISTHEP(JHEP).EQ.155) THEN
3622 C---SPECIAL FOR GLUINO DECAYS
3627 IF(ID.LE.6.OR.ID.EQ.13.OR.
3628 & (ID.GE.115.AND.ID.LE.120)) THEN
3634 CALL HWBRC1(JC,ID,JHEP,.TRUE.,*999)
3635 IF(BVVUSE.AND.JMOHEP(1,JC).EQ.JMOHEP(1,JD)) JC =JD
3638 IF(COLRD(IDHW(IHEP)).AND.IDHW(JDAHEP(1,JHEP)).EQ.449)
3640 IF(BVVUSE.AND.JMOHEP(1,JC).EQ.JMOHEP(1,JD)) JC =JD
3644 IF(BVDEC2(JMOHEP(1,JHEP)).OR.JD.NE.JHEP.OR.
3645 & BVHRD(JMOHEP(1,JHEP)).OR.BVHRD2(JMOHEP(1,JHEP))) THEN
3651 IF((ID.GE.7.AND.ID.LE.12).OR.
3652 & (ID.GE.109.AND.ID.LE.114)) JMOHEP(2,JHEP)=IHEP
3655 C--new for particles connected to BV
3656 IDM = JMOHEP(1,JHEP)
3657 IF(BVDEC1(IDM).OR.BVHRD(IDM).OR.BVHRD2(IDM)) THEN
3659 IF(ABS(IDHEP(IHEP)).LT.1000000) GOTO 100
3663 C--new for top's from BV
3665 IDP = JMOHEP(1,JMOHEP(1,JMOHEP(1,JC)))
3666 IF((ID.EQ.6.AND.(BVDEC1(IDP))).
3667 & OR.(ID.EQ.12.AND.BVDEC2(IDP)).
3668 & OR.((ID.EQ.12.OR.ID.EQ.449).AND.BVHRD(IDP))) THEN
3670 IF(JDAHEP(2,JHEP).EQ.JC) JDAHEP(2,JHEP)=IHEP
3672 IF((IDHW(IHEP).GE.7.AND.IDHW(IHEP).LE.12.
3673 & AND.IDHW(JHEP).GE.7.AND.IDHW(JHEP).LE.12).OR.
3674 & (IDHW(IHEP).LE.6.AND.IDHW(JHEP).LE.6)) THEN
3678 IF((COLRD(IDHW(IHEP)).AND.ACOLRD(IDHW(JHEP))).OR.
3679 & (.NOT.COLRD(IDHW(IHEP)).AND.
3680 & .NOT.ACOLRD(IDHW(JHEP)))) THEN
3681 IF(JDAHEP(2,JHEP).EQ.0) THEN
3683 ELSEIF(JMOHEP(2,JDAHEP(2,JHEP)).NE.JHEP) THEN
3687 IF(JMOHEP(2,JHEP).EQ.JC) JMOHEP(2,JHEP)=IHEP
3699 IF(BVVUSE.AND.ABS(IDHEP(JC)).LT.1000000.AND.JC.NE.JD
3700 & .AND.JD.NE.0.AND.JD.NE.JMOHEP(1,JC)) JC = JD
3701 IF(BVVUSE.AND.ABS(IDHEP(JC)).GT.1000000) THEN
3702 IF(COLRD(IDHW(IHEP)).AND..NOT.BVVHRD) GOTO 110
3704 IF(BVVUSE.AND.ISTHEP(JC).EQ.149) JC=JMOHEP(1,JMOHEP(1,JC))
3705 C--SEARCH IN THE JET
3706 IF((ISTHEP(JC).GT.145.AND.ISTHEP(JC).LT.152).AND.
3707 & ISTHEP(IHEP).EQ.155) THEN
3711 CALL HWBRC2(COLP,IHEP,JC,.TRUE.,BVVUSE,BVVHRD)
3713 JMOHEP(2,IHEP) = COLP
3714 IF(COLRD(IDHW(IHEP)).AND.ACOLRD(IDHW(COLP)).
3715 & AND.JDAHEP(2,COLP).EQ.0)
3716 & JDAHEP(2,COLP) = IHEP
3717 IF((IDHW(IHEP).GE.7.AND.IDHW(IHEP).LE.12).AND.
3718 & (IDHW(COLP).GE.7.AND.IDHW(COLP).LE.12)) THEN
3719 IF(JMOHEP(2,COLP).EQ.0) JMOHEP(2,COLP) = IHEP
3724 C---BREAK COLOUR CONNECTIONS WITH PHOTONS modified for Rslash
3726 130 IF (IHEP.LE.NHEP) THEN
3727 IF (IDHW(IHEP).EQ.59 .AND. ISTHEP(IHEP).EQ.149.AND.
3728 & (JMOHEP(2,IHEP).NE.IHEP.OR.JDAHEP(2,IHEP).NE.IHEP)) THEN
3729 IF(JMOHEP(2,IHEP).NE.0) THEN
3730 IF (JDAHEP(2,JMOHEP(2,IHEP)).EQ.IHEP)
3731 & JDAHEP(2,JMOHEP(2,IHEP))=JDAHEP(2,IHEP)
3733 IF (JDAHEP(2,IHEP).NE.0) THEN
3734 IF (JMOHEP(2,JDAHEP(2,IHEP)).EQ.IHEP)
3735 & JMOHEP(2,JDAHEP(2,IHEP))=JMOHEP(2,IHEP)
3739 IF((IST.GE.147.AND.IST.LE.149).AND.JDAHEP(2,RHEP).EQ.IHEP)
3740 & JDAHEP(2,RHEP)=JMOHEP(2,IHEP)
3744 IF((IST.GE.147.AND.IST.LE.149).AND.JMOHEP(2,RHEP).EQ.IHEP)
3745 & JMOHEP(2,RHEP) = JDAHEP(2,IHEP)
3753 C--Update the BV anticolour corrections
3754 DO 210 IHEP=1,NHEP+1
3755 IF(IHEP.EQ.1) GOTO 210
3757 IF(IHEP.EQ.NHEP+1) THEN
3759 IF(ANTC.EQ.0.OR.(IDHW(JMOHEP(1,HRDCOL(1,2))).LE.6)) GOTO 210
3762 IF(ANTC.EQ.JDAHEP(2,XHEP)) ANTC=JDAHEP(1,JDAHEP(1,ANTC))
3763 IF(ANTC.NE.0.AND.JDAHEP(1,ANTC).NE.0) IST2=ISTHEP(ANTC)
3765 ANTC = JDAHEP(2,IHEP-1)
3766 IF(ANTC.NE.0) IST2=ISTHEP(ANTC)
3775 IF(IST.EQ.155.AND.IST2.EQ.155) THEN
3778 IF(BVDEC1(XHEP).OR.BVDEC2(XHEP).OR.BVHRD(XHEP).OR.
3779 & BVHRD2(XHEP)) THEN
3783 IF(BVDEC1(JC).OR.BVDEC2(JC)) THEN
3784 IF(IHEP.EQ.(NHEP+1)) ANTC=JDAHEP(1,JC)
3788 C--SPECIAL FOR GLUINO DECAYS
3790 IF(IHEP.EQ.NHEP+1) ID = 407
3791 CALL HWBRC1(JC,ID,JHEP,.FALSE.,*999)
3793 IF(IDHW(JDAHEP(1,JHEP)).EQ.449) THEN
3800 CALL HWBRC2(COLP,XHEP,JC,.FALSE.,BVVUSE,.FALSE.)
3802 IF(IHEP.LE.NHEP.AND.ACOLRD(IDHW(IHEP)).AND.
3803 & COLRD(IDHW(COLP)).AND.JMOHEP(2,COLP).EQ.0) THEN
3804 JMOHEP(2,COLP) = IHEP
3805 ELSEIF(IHEP.LE.NHEP.AND.IDHW(IHEP).LE.6.AND.
3806 & IDHW(COLP).LE.6.AND.JDAHEP(2,COLP).EQ.0) THEN
3807 JDAHEP(2,COLP) = IHEP
3808 ELSEIF(IHEP.GT.NHEP.AND.
3809 & ((BVHRD(XHEP).AND.COLRD(JDAHEP(1,XHEP))).
3810 & OR.(BVHRD2(XHEP).AND.ACOLRD(JDAHEP(2,XHEP)))).AND.
3811 & ACOLRD(IDHW(COLP)).AND.JDAHEP(2,COLP).EQ.0) THEN
3812 JDAHEP(2,COLP) = IHEP
3817 IF(IHEP.EQ.NHEP+1) THEN
3818 IF(HRDCOL(1,1).NE.ANTC.AND.ANTC.NE.0) THEN
3820 IF(JDAHEP(2,ANTC).EQ.IHEP) THEN
3821 IF(JDAHEP(2,JMOHEP(1,HRDCOL(1,2))).EQ.JDAHEP(2,HRDCOL(1,2)).
3822 & AND.JMOHEP(2,JDAHEP(2,HRDCOL(1,2))).EQ.JMOHEP(1,HRDCOL(1,2)))
3824 JDAHEP(2,ANTC) = JMOHEP(2,HRDCOL(1,2))
3826 JDAHEP(2,ANTC) = JMOHEP(1,HRDCOL(1,2))
3828 ELSEIF(JMOHEP(2,ANTC).EQ.IHEP) THEN
3829 JMOHEP(2,ANTC) = JMOHEP(1,HRDCOL(1,2))
3832 ELSEIF(IHEP.NE.1) THEN
3833 IF(JDAHEP(2,IHEP-1).NE.ANTC.AND.ANTC.NE.0) JDAHEP(2,IHEP-1)=ANTC
3836 C--Update BV decaying particles connections
3837 DO 310 IHEP=1,NHEP+1
3838 IF(IHEP.EQ.1) GOTO 310
3839 IF(IHEP.EQ.NHEP+1) THEN
3841 IF(ANTC.EQ.0.OR.IDHW(JDAHEP(1,HRDCOL(1,2))).LE.6) GOTO 310
3844 IF(ANTC.EQ.JDAHEP(2,XHEP)) ANTC=JDAHEP(1,JDAHEP(1,ANTC))
3854 IF(ANTC.NE.0.AND.IHEP.NE.NHEP+1) THEN
3855 IF(JDAHEP(1,ANTC).NE.0) IST2 = ISTHEP(ANTC)
3856 ELSEIF(ANTC.NE.0.AND.IHEP.EQ.NHEP+1) THEN
3859 IF(IST.EQ.155.AND.IST2.EQ.155) THEN
3860 IF(BVDEC2(XHEP).OR.BVHRD(XHEP).OR.BVHRD2(XHEP)) THEN
3861 C--FIND COLOUR CONNECTED PARTON
3865 IF(BVDEC2(JHEP)) THEN
3871 IF(IHEP.EQ.NHEP+1) ID = 401
3872 C--SPECIAL FOR GLUINO DECAYS
3873 CALL HWBRC1(JC,ID,JHEP,.TRUE.,*999)
3875 IF(IDHW(JDAHEP(1,JHEP)).EQ.449) THEN
3882 CALL HWBRC2(COLP,XHEP,JC,.TRUE.,BVVUSE,.FALSE.)
3884 IF(COLP.EQ.0) GOTO 300
3885 IF(IHEP.LE.NHEP) THEN
3886 IF(JDAHEP(2,COLP).EQ.0) THEN
3887 JDAHEP(2,COLP) = JDAHEP(2,IHEP)
3888 ELSEIF(JMOHEP(2,JDAHEP(2,COLP)).NE.COLP) THEN
3889 JDAHEP(2,COLP) = JDAHEP(2,IHEP)
3891 ELSEIF(IHEP.GT.NHEP.AND.
3892 & ((BVHRD(XHEP).AND.ACOLRD(JDAHEP(1,XHEP)).AND.
3893 & IDHW(JDAHEP(2,XHEP)).EQ.449).
3894 & OR.(BVHRD2(XHEP).AND.ACOLRD(JDAHEP(2,XHEP)))).AND.
3895 & ACOLRD(IDHW(COLP)).AND.JDAHEP(2,COLP).EQ.0) THEN
3896 JDAHEP(2,COLP) = IHEP
3901 IF(IHEP.NE.NHEP+1.AND.IHEP.NE.1) THEN
3902 IF(JMOHEP(2,IHEP).NE.ANTC.AND.ANTC.NE.0) JMOHEP(2,IHEP)=ANTC
3903 ELSEIF(IHEP.GT.NHEP) THEN
3904 IF(HRDCOL(1,1).NE.ANTC.AND.ANTC.NE.0) HRDCOL(1,1)=ANTC
3905 IF(ANTC.EQ.0) GOTO 310
3906 IF(JDAHEP(2,ANTC).EQ.IHEP) THEN
3907 IF(JDAHEP(2,JMOHEP(1,HRDCOL(1,2))).EQ.JDAHEP(2,HRDCOL(1,2)).
3908 & AND.JMOHEP(2,JDAHEP(2,HRDCOL(1,2))).EQ.JMOHEP(1,HRDCOL(1,2)))
3910 JDAHEP(2,ANTC) = JMOHEP(2,HRDCOL(1,2))
3912 JDAHEP(2,ANTC) = JMOHEP(1,HRDCOL(1,2))
3914 ELSEIF(JMOHEP(2,ANTC).EQ.IHEP) THEN
3915 JMOHEP(2,ANTC) = JMOHEP(1,HRDCOL(1,2))
3919 C--Update partons connected to decaying SUSY particle
3922 C--LOOK FOR PARTONS CONNECTED TO A DECAYING SUSY PARTICLE
3923 IF (IST.LT.145.OR.IST.GT.152) GOTO 400
3924 IF(JMOHEP(2,IHEP).EQ.0) GOTO 400
3925 IF(ISTHEP(JMOHEP(2,IHEP)).EQ.155) THEN
3926 C--FIND THE COLOUR CONNECTED PARTON
3930 IF(BVDEC2(JC).AND.IDHW(JC).NE.449) THEN
3931 IF(IDHW(IHEP).GE.7.AND.IDHW(IHEP).LE.12)
3932 & JMOHEP(2,IHEP)=JDAHEP(1,JC)
3936 C--SPECIAL FOR GLUINO DECAYS
3938 CALL HWBRC1(JC,ID,JHEP,.TRUE.,*999)
3941 IF(COLRD(ID).AND.IDHW(JDAHEP(1,JC)).EQ.449) THEN
3945 IF(IDHW(JHEP).EQ.6.AND.IDHW(JC).EQ.13) JC=JC-1
3949 CALL HWBRC2(COLP,IHEP,JC,.TRUE.,BVVUSE,.FALSE.)
3950 JMOHEP(2,IHEP) = COLP
3953 C--Update partons connected to decaying SUSY particle
3956 C--LOOK FOR PARTONS CONNECTED TO A DECAYING SUSY PARTICLE
3957 IF (IST.LT.145.OR.IST.GT.152) GOTO 500
3958 IF(JDAHEP(2,IHEP).EQ.0) GOTO 500
3959 IF(ISTHEP(JDAHEP(2,IHEP)).EQ.155) THEN
3960 C--FIND THE COLOUR CONNECTED PARTON
3966 C--SPECIAL FOR GLUINO DECAYS
3968 CALL HWBRC1(JC,ID,JHEP,.FALSE.,*999)
3970 IF(ACOLRD(IDHW(IHEP)).AND.IDHW(JDAHEP(1,JC)).EQ.449) THEN
3976 C--SEARCH IN THE JET
3977 CALL HWBRC2(COLP,IHEP,JC,.FALSE.,BVVUSE,.FALSE.)
3978 IF(COLP.NE.0) JDAHEP(2,IHEP) = COLP
3981 C--Flavour and anticolour connections in Rslash
3984 IF(IST.LT.145.OR.IST.GT.152.OR.JDAHEP(2,IHEP).NE.0) GOTO 610
3988 IF(IST.NE.152) JC = JMOHEP(1,JC)
3989 IF(JC.EQ.0) CALL HWWARN('HWBRCN',51,*610)
3990 C--For particles which came from a top decay
3991 IF(ABS(IDHEP(JMOHEP(1,JC))).EQ.6) THEN
3992 JD = JMOHEP(1,JMOHEP(1,JMOHEP(1,JC)))
3993 C--flavour connect to self if needed
3994 IF(JDAHEP(2,JMOHEP(1,JC)-1).EQ.JMOHEP(1,JC)) THEN
3995 JDAHEP(2,IHEP) = IHEP
3997 ELSEIF(JDAHEP(2,JMOHEP(1,JC)-1).NE.0) THEN
3998 JDAHEP(2,IHEP) = JDAHEP(2,JMOHEP(1,JC)-1)
4004 C--Decide if this came from a BV decay
4006 IF(BVDEC1(IDM).OR.BVDEC2(IDM).OR.BVDEC3(IDM).
4007 & OR.BVHRD(IDM).OR.BVHRD2(IDM)) THEN
4009 IF(JDAHEP(2,JC).EQ.JMOHEP(1,JC)) THEN
4010 IF(IDHW(JMOHEP(1,JC)).EQ.449.AND.
4011 & JDAHEP(1,JMOHEP(1,JC)).EQ.JC) THEN
4012 JC = JDAHEP(2,JMOHEP(1,JC)-1)
4014 JC = JMOHEP(2,JMOHEP(1,JC))
4016 IF(ABS(IDHEP(JC)).LT.1000000) THEN
4017 IF(JDAHEP(1,JC).EQ.0) THEN
4023 ELSEIF(ABS(IDHEP(JC)).GT.1000000
4024 & .AND.ISTHEP(JC).NE.155) THEN
4027 IF(ISTHEP(JC).EQ.155.AND.ACOLRD(IDHW(IHEP))) THEN
4030 IF(ISTHEP(JC).EQ.155.AND.IDHW(JDAHEP(1,JC)).NE.449) THEN
4037 C--For the hard process
4038 IF(IDHW(IDM).EQ.15.AND.JC.EQ.JDAHEP(2,JMOHEP(1,JC))) THEN
4039 JDAHEP(2,IHEP) = JDAHEP(2,JC)
4041 ELSEIF(IDHW(IDM).EQ.15.AND.IDHW(IHEP).NE.449) THEN
4043 IF(BVHRD(IDM).AND.IDHW(JDAHEP(2,IDM)).NE.449) THEN
4046 ELSEIF(JMOHEP(1,JDAHEP(2,JC)).EQ.JD) THEN
4050 IF(JDAHEP(2,JC).EQ.8) JC = JD
4052 JD=JMOHEP(2,JMOHEP(1,JC))
4054 IF(COLRD(IDHW(IHEP)).AND..NOT.ACOLRD(IDHW(IHEP)).AND.
4055 & ABS(IDHEP(JD)).GT.1000000.AND.ISTHEP(JD).NE.155) THEN
4057 IF(JDAHEP(2,JD).EQ.0) JDAHEP(2,JD) = IHEP
4059 IF(ABS(IDHEP(JD)).GT.1000000
4060 & .AND.ISTHEP(JD).NE.155) GOTO 610
4061 IF(ISTHEP(JC).EQ.149) THEN
4065 IF(ACOLRD(IDHW(IHEP)).AND.IDHW(JC).EQ.449.AND.BVDEC2(JC)) THEN
4071 C--SEARCH IN THE JET
4072 600 CALL HWBRC2(COLP,IHEP,JC,.FALSE.,BVVUSE,.FALSE.)
4074 IF(ABS(IDHEP(COLP)).EQ.6.AND.JDAHEP(1,COLP).NE.0) THEN
4075 IF(ISTHEP(COLP).EQ.155) THEN
4078 JC = JDAHEP(2,JDAHEP(2,COLP))
4082 JDAHEP(2,IHEP) = COLP
4085 C--check if it came from a top
4086 IF(ABS(IDHEP(JC)).EQ.6) THEN
4087 C--start the analysis again
4089 IF(IST.NE.152) JC = JMOHEP(1,JC)
4091 IF(JC.EQ.0) CALL HWWARN('HWBRCN',52,*610)
4092 IF(ISTHEP(JC).EQ.155) THEN
4093 IF (IDHEP(JMOHEP(1,JC)).EQ.94) THEN
4094 C---DECAYED BEFORE HADRONIZING
4096 IF (JHEP.EQ.0) GO TO 610
4098 IF (ISTHEP(JHEP).EQ.155) THEN
4099 C---SPECIAL FOR GLUINO DECAYS
4101 CALL HWBRC1(JC,ID,JHEP,.TRUE.,*999)
4106 IF(JMOHEP(2,JHEP).EQ.JC) JMOHEP(2,JHEP)=IHEP
4107 JDAHEP(2,IHEP) = JHEP
4115 CALL HWBRC2(COLP,IHEP,JC,.FALSE.,BVVUSE,.FALSE.)
4116 IF(COLP.NE.0) JDAHEP(2,IHEP) = COLP
4118 IF(ISTHEP(JMOHEP(1,JC)).EQ.155
4119 & .AND.IDHW(JC).LE.6) THEN
4120 JDAHEP(2,IHEP) = JDAHEP(2,JMOHEP(1,JC)-1)
4121 IF(JDAHEP(2,IHEP).NE.0) GOTO 610
4123 CALL HWWARN('HWBRCN',100,*610)
4129 *CMZ :- -20/07/99 10:56:12 by Peter Richardson
4130 *-- Author : PeterRichardson
4131 C-----------------------------------------------------------------------
4132 SUBROUTINE HWBRC1(JC,ID,JHEP,COL,*)
4133 C-----------------------------------------------------------------------
4134 C--Function to find the right daugther of a decaying gluino
4135 C-----------------------------------------------------------------------
4136 INCLUDE 'HERWIG65.INC'
4137 INTEGER ID,JHEP,KC,JC
4139 C---N.B. WILL NEED MODS WHEN SUSY PARTICLES CAN SHOWER
4140 C--Rparity take the first daughther
4141 IF(IDHW(JDAHEP(1,JHEP)).LE.12.AND.IDHW(JDAHEP(1,JHEP)+1).LE.12
4142 & .AND.IDHW(JDAHEP(2,JHEP)).LE.12) THEN
4145 ELSEIF ((COL.AND.(ID.EQ.449.OR.ID.EQ.13)).OR.
4146 & (ID.GE.401.AND.ID.LE.406).OR.
4147 & (ID.GE.413.AND.ID.LE.418).OR.ID.LE.6.OR.
4148 & (ID.GE.115.AND.ID.LE.120)) THEN
4149 C---LOOK FOR ANTI(S)QUARK OR GLUON
4150 DO KC=JDAHEP(1,JHEP),JDAHEP(2,JHEP)
4152 IF ((ID.GE.7.AND.ID.LE.13).OR.(ID.GE.407.AND.ID.LE.412).OR.
4153 & (ID.GE.419.AND.ID.LE.424)) GOTO 20
4156 C---LOOK FOR (S)QUARK OR GLUON
4157 DO KC=JDAHEP(1,JHEP),JDAHEP(2,JHEP)
4159 IF (ID.LE. 6.OR. ID.EQ. 13.OR.(ID.GE.401.AND.ID.LE.406).OR.
4160 & (ID.GE.413.AND.ID.LE.418)) GOTO 20
4163 C---COULDNT FIND ONE
4164 CALL HWWARN('HWBRC1',100,*10)
4169 *CMZ :- -20/07/99 10:56:12 by Peter Richardson
4170 *-- Author : Peter Richardson
4171 C-----------------------------------------------------------------------
4172 SUBROUTINE HWBRC2(COLP,IHEP,JC,CON,BVVUSE,BVVHRD)
4173 C-----------------------------------------------------------------------
4174 C--Function to search in the jet for the particle
4175 C-----------------------------------------------------------------------
4176 INCLUDE 'HERWIG65.INC'
4177 INTEGER JC,JD,QHEP,LHEP,IHEP,JHEP,IDM,NCOUNT,ID,IP,IDM2,COLP
4178 LOGICAL CON,BVVUSE,FLA,AFLA,BVVHRD
4179 FLA(IP) = (IP.LE.6.OR.(IP.GE.115.AND.IP.LE.120).
4180 & OR.(IP.GE.401.AND.IP.LE.406).
4181 & OR.(IP.GE.413.AND.IP.LE.418))
4182 AFLA(IP) = ((IP.LE.12.AND.IP.GE.7).OR.(IP.GE.109.AND.IP.LE.114).
4183 & OR.(IP.GE.407.AND.IP.LE.412).
4184 & OR.(IP.GE.419.AND.IP.LE.424))
4187 C--begining and end of jet
4188 IF(JDAHEP(1,JC).NE.0) THEN
4198 C--SEARCH FOR A COLOUR PARTNER
4201 IF (ISTHEP(JHEP).LT.145.OR.ISTHEP(JHEP).GT.152) GOTO 110
4202 IF(AFLA(ID).AND.IDM.EQ.13) GOTO 110
4203 IF (JDAHEP(2,JHEP).EQ.IHEP) LHEP=JHEP
4204 IF ((BVVUSE.AND.JMOHEP(2,JHEP).NE.0).OR.
4205 & (.NOT.BVVUSE.AND.JDAHEP(2,JHEP).NE.0)) GOTO 110
4206 IF(BVVUSE.AND.ABS(IDHEP(JHEP)).GT.1000000) THEN
4207 IF(BVVHRD.AND.AFLA(ID)) THEN
4214 & ((FLA(ID).OR.ID.EQ.13.OR.ID.EQ.449).AND.AFLA(IDM)).
4215 & OR.(AFLA(ID).AND.(FLA(IDM).OR.IDM.EQ.13.OR.IDM.EQ.449))))
4217 IF(AFLA(ID).AND.(IDM.EQ.59.OR.IDM.EQ.449.OR.IDM.EQ.13)) GOTO 110
4218 C---JOIN IHEP AND JHEP
4220 IF(BVVUSE.OR.(ID.GE.7.AND.ID.LE.12.
4221 & AND.((IDM.GE.7.AND.IDM.LE.12)))) RETURN
4222 IF(IHEP.NE.HRDCOL(1,2).AND.
4223 & (((FLA(ID).OR.ID.EQ.13.OR.ID.EQ.449.OR.ID.EQ.59)
4224 & .AND.(AFLA(IDM).OR.IDM.EQ.13.OR.IDM.EQ.449.OR.IDM.EQ.59))
4225 & .OR.(AFLA(ID).AND.(FLA(IDM).OR.IDM.EQ.59))))
4226 & JDAHEP(2,JHEP)=IHEP
4229 IF (LHEP.NE.0) COLP=LHEP
4230 C--Additional Baryon number violating piece
4233 IF(JMOHEP(1,JC).LT.6) THEN
4236 ELSEIF(IDM2.GT.6) THEN
4240 IF(IHEP.EQ.HRDCOL(1,2).OR.
4241 & ((FLA(ID).OR.ID.EQ.13.OR.ID.EQ.449.OR.ID.EQ.15.OR.ID.EQ.59)
4242 & .AND.(AFLA(IDM2).OR.IDM2.EQ.13.OR.IDM2.EQ.13))) THEN
4245 IF(IDHEP(QHEP).EQ.0) GOTO 12
4246 IF(IDHW(QHEP).EQ.59) THEN
4247 IF(JC.EQ.JD.AND.IDHW(JMOHEP(1,QHEP)).EQ.59) THEN
4255 11 IF(JDAHEP(2,QHEP).NE.0) THEN
4256 IF(JMOHEP(2,JDAHEP(2,QHEP)).EQ.QHEP.AND.
4257 & JDAHEP(2,QHEP).NE.QHEP) THEN
4258 IF(JDAHEP(2,QHEP).GE.JC.AND.JDAHEP(2,QHEP).LE.JD) THEN
4259 QHEP = JDAHEP(2,QHEP)
4261 IF(NCOUNT.LT.NHEP) GOTO 11
4268 IF(IDHEP(QHEP).EQ.0) GOTO 13
4269 IF(IDHW(QHEP).EQ.59) THEN
4270 IF(JC.EQ.JD.AND.IDHW(JMOHEP(1,QHEP)).EQ.59) THEN
4278 9 IF(JMOHEP(2,QHEP).NE.0) THEN
4279 IF(JDAHEP(2,JMOHEP(2,QHEP)).EQ.QHEP.AND.
4280 & JMOHEP(2,QHEP).NE.QHEP) THEN
4281 IF(JMOHEP(2,QHEP).GE.JC.AND.JMOHEP(2,QHEP).LE.JD) THEN
4282 QHEP = JMOHEP(2,QHEP)
4284 IF(NCOUNT.LT.NHEP) GOTO 9
4289 IF(ABS(IDHEP(QHEP)).LT.1000000) COLP=QHEP
4292 C--Search for an anticolour partner
4294 IF (ISTHEP(JHEP).LT.145.OR.ISTHEP(JHEP).GT.152) GOTO 210
4295 IF (JMOHEP(2,JHEP).EQ.IHEP) LHEP=JHEP
4296 IF (JMOHEP(2,JHEP).NE.0) GOTO 210
4297 C---JOIN IHEP AND JHEP
4301 IF (LHEP.NE.0) COLP=LHEP
4305 IF(JMOHEP(1,JC).LT.6) THEN
4308 ELSEIF(IDM2.GT.6) THEN
4312 C--Additional Baryon number violating piece
4313 IF((FLA(ID).AND.AFLA(IDM2)).OR.
4314 & ((AFLA(ID).OR.ID.EQ.13.OR.ID.EQ.449.OR.ID.EQ.15.OR.ID.EQ.59)
4315 & .AND.(FLA(IDM2).OR.IDM2.EQ.13.OR.IDM2.EQ.449)
4316 & .AND..NOT.(IDHW(JMOHEP(1,JC)).EQ.13.AND.
4317 & IDHW(JMOHEP(1,JMOHEP(1,JC))).EQ.12.AND.
4318 & ISTHEP(JMOHEP(1,JMOHEP(1,JC))).EQ.155)
4320 C--special for gluino decay to gluon
4321 IF(ID.EQ.449.AND.IDHW(JMOHEP(1,JMOHEP(1,JC))).EQ.449.AND.
4322 & IDHW(JMOHEP(1,JC)).EQ.13) RETURN
4325 IF(IDHEP(QHEP).EQ.0) GOTO 211
4326 IF(IDHW(QHEP).EQ.59) THEN
4327 IF(JC.EQ.JD.AND.IDHW(JMOHEP(1,QHEP)).EQ.59) THEN
4335 209 IF(JMOHEP(2,QHEP).NE.0) THEN
4336 IF(JDAHEP(2,JMOHEP(2,QHEP)).EQ.QHEP.AND.
4337 & JMOHEP(2,QHEP).NE.QHEP) THEN
4338 IF(JMOHEP(2,QHEP).GE.JC.AND.JMOHEP(2,QHEP).LE.JD) THEN
4339 QHEP = JMOHEP(2,QHEP)
4341 IF(NCOUNT.LT.NHEP) GOTO 209
4345 IF(QHEP.NE.0) COLP=QHEP
4346 IF(JDAHEP(2,QHEP).EQ.0.AND.IHEP.NE.6) THEN
4348 IF(FLA(IHEP).AND.FLA(QHEP).OR.
4349 & ((AFLA(IHEP).OR.ID.EQ.13.OR.ID.EQ.449).AND.
4350 & (AFLA(QHEP).OR.IDM2.EQ.13.OR.IDM2.EQ.449)))
4351 & JDAHEP(2,QHEP)=IHEP
4356 IF(IDHEP(QHEP).EQ.0) GOTO 220
4357 IF(IDHW(QHEP).EQ.59) THEN
4358 IF(JC.EQ.JD.AND.IDHW(JMOHEP(1,QHEP)).EQ.59) THEN
4366 219 IF(JDAHEP(2,QHEP).NE.0) THEN
4367 IF(JMOHEP(2,JDAHEP(2,QHEP)).EQ.QHEP) THEN
4368 IF(JDAHEP(2,QHEP).GE.JC.AND.JDAHEP(2,QHEP).LE.JD) THEN
4369 QHEP = JDAHEP(2,QHEP)
4371 IF(NCOUNT.LT.200) GOTO 219
4375 IF(QHEP.NE.0) COLP=QHEP
4377 IF(JDAHEP(2,QHEP).EQ.0.AND.
4378 & (((AFLA(ID).OR.ID.EQ.13).AND.(AFLA(IDM2).OR.IDM2.EQ.13)).OR.
4379 & (FLA(ID).AND.FLA(IDM2)))) JDAHEP(2,QHEP)=IHEP
4385 *CMZ :- -26/04/91 14.26.44 by Federico Carminati
4386 *-- Author : Ian Knowles
4387 C-----------------------------------------------------------------------
4389 C-----------------------------------------------------------------------
4390 C Constructs time-like 4-momenta & production vertices in space-like
4391 C jet started by parton no.2 interference partner 1 and spin density
4392 C DECPAR(2). RHOPAR(2) gives the jet spin density matrix.
4393 C See I.G. Knowles, Comp. Phys. Comm. 58 (90) 271.
4394 C-----------------------------------------------------------------------
4395 INCLUDE 'HERWIG65.INC'
4396 DOUBLE PRECISION HWRGEN,DMIN,PT,EIKON,EISCR,EINUM,EIDEN1,EIDEN2,
4397 & WT,SPIN,Z1,Z2,TR,PRMAX,CX,SX,CAZ,ROHEP(3),RMAT(3,3),ZERO2(2)
4398 INTEGER IPAR,JPAR,KPAR,LPAR,MPAR,JSTR,LSTR,MSTR
4401 DATA ZERO2,DMIN/2*0D0,1D-15/
4402 IF (IERROR.NE.0) RETURN
4406 CALL HWVZRO(2,RHOPAR(1,2))
4409 C Generate azimuthal angle of JPAR's branching using an M-function
4410 C Find the daughters of JPAR, with LPAR time-like
4411 10 LPAR=JDAPAR(1,JPAR)
4412 IF (TMPAR(LPAR)) THEN
4419 CALL HWUROT(PPAR(1,JPAR), ONE,ZERO,RMAT)
4420 CALL HWUROF(RMAT,PPAR(1,KPAR),ROHEP)
4421 PT=MAX(SQRT(ROHEP(1)*ROHEP(1)+ROHEP(2)*ROHEP(2)),DMIN)
4423 EICOR=AZSOFT.AND.IDPAR(LPAR).EQ.13
4425 IF (ABS(PPAR(5,MPAR)).LT.DMIN) THEN
4428 EISCR=ONE-(PPAR(5,MPAR)/PPAR(4,MPAR))**2
4429 & /MIN(PPAR(2,LPAR),PPAR(2,MPAR))
4431 EINUM=PPAR(4,KPAR)*PPAR(4,LPAR)*ABS(PPAR(2,LPAR)-PPAR(2,MPAR))
4432 EIDEN1=PPAR(4,KPAR)*PPAR(4,LPAR)-ROHEP(3)*PPAR(3,LPAR)
4433 EIDEN2=PT*ABS(PPAR(1,LPAR))
4434 EIKON=MAX(EISCR+EINUM/MAX(EIDEN1-EIDEN2,DMIN),ZERO)
4439 IF (AZSPIN.AND.IDPAR(JPAR).EQ.13) THEN
4440 Z1=PPAR(4,JPAR)/PPAR(4,MPAR)
4442 IF (IDPAR(MPAR).EQ.13) THEN
4443 TR=Z1/Z2+Z2/Z1+Z1*Z2
4444 ELSEIF (IDPAR(MPAR).LT.13) THEN
4445 TR=(ONE+Z2**2)/(TWO*Z1)
4449 C Assign the azimuthal angle
4450 PRMAX=(1.+ABS(WT))*EIKON
4451 50 CALL HWRAZM( ONE,CX,SX)
4452 CALL HWUROT(PPAR(1,JPAR),CX,SX,RMAT)
4453 C Determine the angle between the branching planes
4454 CALL HWUROF(RMAT,PPAR(1,KPAR),ROHEP)
4456 PHIPAR(1,JPAR)=2.*CAZ*CAZ-1.
4457 PHIPAR(2,JPAR)=2.*CAZ*ROHEP(2)/PT
4458 IF (EICOR) EIKON=MAX(EISCR+EINUM/MAX(EIDEN1-EIDEN2*CAZ,DMIN),ZERO)
4459 IF (AZSPIN) SPIN=1.+WT*(DECPAR(1,JPAR)*PHIPAR(1,JPAR)
4460 & +DECPAR(2,JPAR)*PHIPAR(2,JPAR))
4461 IF (SPIN*EIKON.LT.HWRGEN(0)*PRMAX) GOTO 50
4462 C Construct full 4-momentum of LPAR, sum P-trans of MPAR
4465 CALL HWUROB(RMAT,PPAR(1,LPAR),PPAR(1,LPAR))
4466 CALL HWVDIF(2,PPAR(1,2),PPAR(1,LPAR),PPAR(1,2))
4467 C Test for end of space-like branches
4468 IF (JDAPAR(1,MPAR).EQ.0) GOTO 60
4469 C Generate new Decay matrix
4470 CALL HWBAZF(MPAR,JPAR,ZERO2,DECPAR(1,JPAR),
4471 & PHIPAR(1,JPAR),DECPAR(1,MPAR))
4472 C Advance along the space-like branch
4476 C Retreat along space-like line
4477 C Assign initial spin density matrix
4479 CALL HWVEQU(2,ZERO2,RHOPAR(1,MPAR))
4480 CALL HWUMAS(PPAR(1,2))
4481 CALL HWVZRO(4,VPAR(1,MPAR))
4488 CALL HWVEQU(4,VPAR(1,MPAR),VPAR(1,LPAR))
4489 IF (MPAR.EQ.2) RETURN
4490 C Construct spin density matrix for time-like branch
4491 CALL HWBAZF(MPAR,JPAR,RHOPAR(1,MPAR),PHIPAR(1,JPAR),
4492 & DECPAR(1,JPAR),RHOPAR(1,LPAR))
4493 C Evolve time-like side branch
4494 CALL HWBTIM(LPAR,MPAR)
4495 C Construct spin density matrix for space-like branch
4496 CALL HWBAZF(MPAR,JPAR,PHIPAR(1,JPAR),RHOPAR(1,MPAR),
4497 & DECPAR(1,LPAR),RHOPAR(1,JPAR))
4498 C Assign production vertex to J
4499 CALL HWVDIF(4,PPAR(1,MPAR),PPAR(1,LPAR),PPAR(1,JPAR))
4500 CALL HWUDKL(IDPAR(JPAR),PPAR(1,JPAR),VPAR(1,JPAR))
4501 CALL HWVSUM(4,VPAR(1,MPAR),VPAR(1,JPAR),VPAR(1,JPAR))
4502 C Find parent and partner of MPAR
4505 C BRW modified here 19/06/01 to avoid compiler-dependent bug
4506 C (overwriting of JPAR etc.)
4509 IF (JPAR.EQ.KPAR) THEN
4520 *CMZ :- -26/04/91 11.11.54 by Bryan Webber
4521 *-- Author : Ian Knowles
4522 C-----------------------------------------------------------------------
4524 C-----------------------------------------------------------------------
4525 C Constructs appropriate spin density/decay matrix for parton
4526 C in hard subprocess, otherwise zero. Assignments based upon
4527 C Comp. Phys. Comm. 58 (1990) 271.
4528 C-----------------------------------------------------------------------
4529 INCLUDE 'HERWIG65.INC'
4530 DOUBLE PRECISION C,V12,V23,V13,TR,C1,C2,C3,R1(2),R2(2)
4533 IF (IERROR.NE.0) RETURN
4534 IST=MOD(ISTHEP(NEVPAR),10)
4535 C Assumed partons processed in the order IST=1,2,3,4
4536 IF (IPROC.GE.100.AND.IPROC.LE.116) THEN
4537 C An e+e- ---> qqbar g event
4538 IF (IDPAR(2).EQ.13) THEN
4543 ELSEIF (IPRO.EQ.15.OR.IPRO.EQ.17) THEN
4544 IF (IHPRO.EQ. 7.OR.IHPRO.EQ. 8.OR.
4545 & IHPRO.EQ.10.OR.IHPRO.EQ.11.OR.
4546 & IHPRO.EQ.15.OR.IHPRO.EQ.16.OR.
4547 & (IHPRO.GE.21.AND.IHPRO.LE.31)) THEN
4548 C A hard 2 --- > 2 QCD subprocess involving gluons
4550 CALL HWVEQU(2,RHOPAR(1,2),R1(1))
4555 ELSEIF (IST.EQ.3) THEN
4556 CALL HWVEQU(2,RHOPAR(1,2),R2(1))
4557 V12=R1(1)*R2(1)+R1(2)*R2(2)
4558 TR=1./(GCOEF(1)+GCOEF(2)*V12)
4559 RHOPAR(1,2)= (GCOEF(3)*R1(1)+GCOEF(4)*R2(1))*TR
4560 RHOPAR(2,2)=-(GCOEF(3)*R1(2)+GCOEF(4)*R2(2))*TR
4562 ELSEIF (IST.EQ.4) THEN
4563 V13=R1(1)*DECPAR(1,2)+R1(2)*DECPAR(2,2)
4564 V23=R2(1)*DECPAR(1,2)+R2(2)*DECPAR(2,2)
4565 TR=1./(GCOEF(1)+GCOEF(2)*V12+GCOEF(3)*V13+GCOEF(4)*V23)
4566 C1=(GCOEF(2)+GCOEF(5))*TR
4567 C2=(GCOEF(3)+GCOEF(6))*TR
4568 C3=(GCOEF(4)+GCOEF(6))*TR
4569 RHOPAR(1,2)=C1*DECPAR(1,2)+C2*R2(1)+C3*R1(1)
4570 RHOPAR(2,2)=C1*DECPAR(2,2)-C2*R1(2)-C3*R2(2)
4574 ELSEIF ((IPRO.EQ.16).OR.(IPRO.EQ.36)) THEN
4575 C A gluon fusion ---> Higgs event
4577 IF (IHIGGS.NE.4) THEN
4578 DECPAR(1,2)=RHOPAR(1,2)
4579 DECPAR(2,2)=-RHOPAR(2,2)
4581 DECPAR(1,2)=-RHOPAR(1,2)
4582 DECPAR(2,2)=RHOPAR(2,2)
4586 ELSEIF (IPRO.EQ.42) THEN
4587 C A gluon fusion (or qq-bar annihilation) ---> graviton production event
4589 DECPAR(1,2)=RHOPAR(1,2)
4590 DECPAR(2,2)=RHOPAR(2,2)
4594 CALL HWVZRO(2,RHOPAR(1,2))
4595 CALL HWVZRO(2,DECPAR(1,2))
4598 *CMZ :- -13/07/92 20.15.54 by Mike Seymour
4599 *-- Author : Bryan Webber, modified by Mike Seymour
4600 C-----------------------------------------------------------------------
4601 FUNCTION HWBSU1(ZLOG)
4602 C-----------------------------------------------------------------------
4603 C Z TIMES THE INTEGRAND IN EXPONENT OF QUARK SUDAKOV FORM FACTOR.
4604 C HWBSU1 IS FOR UPPER PART OF Z INTEGRATION REGION
4605 C-----------------------------------------------------------------------
4606 DOUBLE PRECISION HWBSU1,HWBSUL,Z,ZLOG,U
4610 HWBSU1=HWBSUL(Z)*(1.+U*U)
4613 *CMZ :- -13/07/92 20.15.54 by Mike Seymour
4614 *-- Author : Bryan Webber, modified by Mike Seymour
4615 C-----------------------------------------------------------------------
4617 C-----------------------------------------------------------------------
4618 C INTEGRAND IN EXPONENT OF QUARK SUDAKOV FORM FACTOR.
4619 C HWBSU2 IS FOR LOWER PART OF Z INTEGRATION REGION
4620 C-----------------------------------------------------------------------
4621 DOUBLE PRECISION HWBSU2,HWBSUL,Z,U
4624 HWBSU2=HWBSUL(Z)*(1.+Z*Z)/U
4627 *CMZ :- -14/07/92 13.28.23 by Mike Seymour
4628 *-- Author : Bryan Webber
4629 C-----------------------------------------------------------------------
4631 C-----------------------------------------------------------------------
4632 C COMPUTES (OR READS) TABLES OF SUDAKOV FORM FACTORS
4633 C-----------------------------------------------------------------------
4634 INCLUDE 'HERWIG65.INC'
4635 DOUBLE PRECISION HWUGAU,HWBVMC,HWBSUG,HWBSU1,HWBSU2,G1,G2,QRAT,
4636 & QLAM,POWER,AFAC,QMIN,QFAC,QNOW,ZMIN,ZMAX,Q1,QCOLD,VGOLD,VQOLD,
4637 & RMOLD(6),ACOLD,ZLO,ZHI
4638 INTEGER IQ,IS,L1,L2,L,LL,I,INOLD,NQOLD,NSOLD,NCOLD,NFOLD,SDOLD
4639 EXTERNAL HWUGAU,HWBVMC,HWBSUG,HWBSU1,HWBSU2
4640 SAVE NQOLD,NSOLD,NCOLD,NFOLD,SDOLD,QCOLD,VGOLD,VQOLD,RMOLD,ACOLD,
4642 COMMON/HWSINT/QRAT,QLAM
4643 IF (LRSUD.EQ.0) THEN
4644 POWER=1./FLOAT(NQEV-1)
4647 QFAC=(1.1*QLIM/QMIN)**POWER
4650 C--IS=1 FOR GLUON->GLUON+GLUON FORM FACTOR
4652 QNOW=QFAC*QEV(IQ-1,1)
4660 IF (I.NE.6) ZLO=MAX(ZLO,QG/RMASS(I+1))
4661 IF (I.NE.3) ZHI=MIN(ZHI,QG/RMASS(I))
4662 IF (ZHI.GT.ZLO) G1=G1+HWUGAU(HWBSUG,LOG(ZLO),LOG(ZHI),ACCUR)
4664 SUD(IQ,1)=EXP(AFAC*G1)
4667 C--QUARK FORM FACTORS.
4668 C--IS=2,3,4,5,6,7 FOR U/D,S,C,B,T,V
4671 IF (IS.EQ.7) Q1=HWBVMC(209)
4673 IF (QMIN.GT.QLIM) GOTO 15
4674 QFAC=(1.1*QLIM/QMIN)**POWER
4678 QNOW=QFAC*QEV(IQ-1,IS)
4687 IF (I.NE.6) ZLO=MAX(ZLO,QG/RMASS(I+1))
4688 IF (I.NE.3) ZHI=MIN(ZHI,QG/RMASS(I))
4689 IF (ZHI.GT.ZLO) G1=G1+HWUGAU(HWBSU1,LOG(ZLO),LOG(ZHI),ACCUR)
4698 IF (I.NE.6) ZLO=MAX(ZLO,Q1/RMASS(I+1))
4699 IF (I.NE.3) ZHI=MIN(ZHI,Q1/RMASS(I))
4700 IF (ZHI.GT.ZLO) G2=G2+HWUGAU(HWBSU2,ZLO,ZHI,ACCUR)
4702 SUD(IQ,IS)=EXP(AFAC*(G1+G2))
4716 16 RMOLD(IS)=RMASS(IS)
4718 IF (LRSUD.GT.0) THEN
4719 IF (IPRINT.NE.0) WRITE (6,17) LRSUD
4720 17 FORMAT(/10X,'READING SUDAKOV TABLE ON UNIT',I4)
4721 OPEN(UNIT=LRSUD,FORM='UNFORMATTED',STATUS='UNKNOWN')
4722 READ(UNIT=LRSUD) QCOLD,VGOLD,VQOLD,RMOLD,
4723 & ACOLD,QEV,SUD,INOLD,NQOLD,NSOLD,NCOLD,NFOLD,SDOLD
4726 C---CHECK THAT RELEVANT PARAMETERS ARE UNCHANGED
4727 IF (QCDLAM.NE.QCOLD) CALL HWWARN('HWBSUD',501,*999)
4728 IF (VGCUT .NE.VGOLD) CALL HWWARN('HWBSUD',502,*999)
4729 IF (VQCUT .NE.VQOLD) CALL HWWARN('HWBSUD',503,*999)
4730 IF (ACCUR .NE.ACOLD) CALL HWWARN('HWBSUD',504,*999)
4731 IF (INTER .NE.INOLD) CALL HWWARN('HWBSUD',505,*999)
4732 IF (NQEV .NE.NQOLD) CALL HWWARN('HWBSUD',506,*999)
4733 IF (NSUD .NE.NSOLD) CALL HWWARN('HWBSUD',507,*999)
4734 IF (NCOLO .NE.NCOLD) CALL HWWARN('HWBSUD',508,*999)
4735 IF (NFLAV .NE.NFOLD) CALL HWWARN('HWBSUD',509,*999)
4736 IF (SUDORD.NE.SDOLD) CALL HWWARN('HWBSUD',510,*999)
4737 C---CHECK MASSES AND THAT TABLES ARE BIG ENOUGH FOR THIS RUN
4739 IF (RMASS(IS).NE.RMOLD(IS))
4740 & CALL HWWARN('HWBSUD',510+IS,*999)
4741 IF (QEV(NQEV,IS).LT.QLIM.AND.HWBVMC(IS)+QG.LT.QLIM)
4742 & CALL HWWARN('HWBSUD',500,*999)
4745 IF (LWSUD.GT.0) THEN
4746 IF (IPRINT.NE.0) WRITE (6,19) LWSUD
4747 19 FORMAT(/10X,'WRITING SUDAKOV TABLE ON UNIT',I4)
4748 OPEN (UNIT=LWSUD,FORM='UNFORMATTED',STATUS='UNKNOWN')
4749 WRITE(UNIT=LWSUD) QCDLAM,VGCUT,VQCUT,(RMASS(I),I=1,6),
4750 & ACCUR,QEV,SUD,INTER,NQEV,NSUD,NCOLO,NFLAV,SUDORD
4753 IF (IPRINT.GT.2) THEN
4754 C--PRINT EXTRACTS FROM TABLES OF FORM FACTORS
4757 20 FORMAT(1H1//10X,'EXTRACT FROM TABLE OF SUDAKOV FORM FACTOR NO.',
4758 & I2,' (',I5,' ACTUAL ENTRIES)'//10X,'SUD IS PROBABILITY THAT',
4759 & ' PARTON WITH GIVEN UPPER LIMIT ON Q WILL REACH THRESHOLD',
4760 & ' WITHOUT BRANCHING'///2X,8(' Q SUD ')/)
4766 WRITE(6,30) (QEV(I,IS),SUD(I,IS),I=L,LL,L2)
4767 30 FORMAT(2X,8(F9.2,F7.4))
4774 *CMZ :- -13/07/92 20.15.54 by Mike Seymour
4775 *-- Author : Bryan Webber, modified by Mike Seymour
4776 C-----------------------------------------------------------------------
4777 FUNCTION HWBSUG(ZLOG)
4778 C-----------------------------------------------------------------------
4779 C Z TIMES INTEGRAND IN EXPONENT OF GLUON SUDAKOV FORM FACTOR
4780 C-----------------------------------------------------------------------
4781 DOUBLE PRECISION HWBSUG,HWBSUL,Z,ZLOG,W
4785 HWBSUG=HWBSUL(Z)*(W-2.+1./W)*Z
4788 *CMZ :- -13/07/92 20.15.54 by Mike Seymour
4789 *-- Author : Mike Seymour
4790 C-----------------------------------------------------------------------
4792 C-----------------------------------------------------------------------
4793 C LOGARITHMIC PART OF INTEGRAND IN EXPONENT OF SUDAKOV FORM FACTOR.
4794 C THE SECOND ORDER ALPHAS CASE COMES FROM CONVERTING INTEGRAL OVER
4795 C Q^2 INTO ONE OVER ALPHAS, WITH FLAVOUR THRESHOLDS.
4796 C-----------------------------------------------------------------------
4797 INCLUDE 'HERWIG65.INC'
4798 DOUBLE PRECISION HWBSUL,HWUALF,Z,QRAT,QLAM,U,AL,BL,QNOW,QMIN,
4799 & BET(6),BEP(6),MUMI(6),MUMA(6),ALMI(6),ALMA(6),FINT(6),ALFINT,
4800 & MUMIN,MUMAX,ALMIN,ALMAX
4804 SAVE FIRST,BET,BEP,MUMI,MUMA
4805 COMMON/HWSINT/QRAT,QLAM
4807 ALFINT(AL,BL)=1/BET(NF)*
4808 & LOG(BL/(AL*(1+BEP(NF)*BL))*(1+BEP(NF)*AL))
4811 IF (SUDORD.EQ.1) THEN
4814 HWBSUL=LOG(1.-AL/BL)
4818 BET(NF)=(11*CAFAC-2*NF)/(12*PIFAC)
4819 BEP(NF)=(17*CAFAC**2-(5*CAFAC+3*CFFAC)*NF)/(24*PIFAC**2)
4826 ALMI(NF)=HWUALF(1,MUMI(NF))
4832 MUMA(NF)=RMASS(NF+1)
4833 ALMA(NF)=HWUALF(1,MUMA(NF))
4835 IF (NF.NE.3.AND.NF.NE.6) FINT(NF)=ALFINT(ALMI(NF),ALMA(NF))
4843 IF (MUMAX.LE.MUMIN) RETURN
4844 ALMIN=HWUALF(1,MUMIN)
4845 ALMAX=HWUALF(1,MUMAX)
4847 20 IF (MUMIN.GT.MUMA(NF)) THEN
4851 IF (MUMAX.LT.MUMA(NF)) THEN
4852 HWBSUL=ALFINT(ALMIN,ALMAX)
4854 HWBSUL=ALFINT(ALMIN,ALMA(NF))
4856 30 IF (MUMAX.GT.MUMA(NF)) THEN
4857 HWBSUL=HWBSUL+FINT(NF)
4861 HWBSUL=HWBSUL+ALFINT(ALMI(NF),ALMAX)
4863 HWBSUL=HWBSUL*BET(5)
4867 *CMZ :- -26/04/91 14.27.17 by Federico Carminati
4868 *-- Author : Ian Knowles
4869 C-----------------------------------------------------------------------
4870 SUBROUTINE HWBTIM(INITBR,INTERF)
4871 C-----------------------------------------------------------------------
4872 C Constructs full 4-momentum & production vertices in time-like jet
4873 C initiated by INITBR, interference partner INTERF and spin density
4874 C RHOPAR(INITBR). DECPAR(INITBR) returns jet's spin density matrix.
4875 C Includes azimuthal angular correlations between branching planes
4876 C due to spin (if AZSPIN) using the algorithm of Knowles & Collins.
4877 C Ses Nucl. Phys. B304 (1988) 794 & Comp. Phys. Comm. 58 (1990) 271.
4878 C-----------------------------------------------------------------------
4879 INCLUDE 'HERWIG65.INC'
4880 DOUBLE PRECISION HWRGEN,DMIN,PT,EIKON,EINUM,EIDEN1,EIDEN2,EISCR,
4881 & WT,SPIN,Z1,Z2,PRMAX,CAZ,CX,SX,ROHEP(3),RMAT(3,3),ZERO2(2)
4882 INTEGER INITBR,INTERF,IPAR,JPAR,KPAR,LPAR,MPAR,NTRY,JOLD
4885 DATA ZERO2,DMIN/ZERO,ZERO,1.D-15/
4886 IF (IERROR.NE.0) RETURN
4889 IF ((JDAPAR(1,JPAR).NE.0).OR.(IDPAR(JPAR).EQ.13)) GOTO 30
4890 C No branching, assign decay matrix
4891 CALL HWVZRO(2,DECPAR(1,JPAR))
4893 C Advance up the leader
4894 C Find the parent and partner of J
4895 10 IPAR=JMOPAR(1,JPAR)
4898 IF (JMOPAR(1,KPAR).EQ.IPAR) THEN
4900 CALL HWBAZF(IPAR,JPAR,PHIPAR(1,IPAR),RHOPAR(1,IPAR),
4901 & ZERO2,RHOPAR(1,JPAR))
4904 IF (JMOPAR(1,KPAR).NE.IPAR)
4905 & CALL HWWARN('HWBTIM',100,*999)
4907 CALL HWBAZF(IPAR,KPAR,RHOPAR(1,IPAR),PHIPAR(1,IPAR),
4908 & DECPAR(1,KPAR),RHOPAR(1,JPAR))
4910 C Generate azimuthal angle of J's branching
4911 30 IF (JDAPAR(1,JPAR).EQ.0) THEN
4913 CALL HWVZRO(2,DECPAR(1,JPAR))
4914 IF (JPAR.EQ.INITBR) RETURN
4917 C Assign an angle to a branching using an M-function
4918 C Find the daughters of J
4922 CALL HWUROT(PPAR(1,JPAR), ONE,ZERO,RMAT)
4923 CALL HWUROF(RMAT,PPAR(1,KPAR),ROHEP)
4924 PT=MAX(SQRT(ROHEP(1)*ROHEP(1)+ROHEP(2)*ROHEP(2)),DMIN)
4927 EICOR=AZSOFT.AND.((IDPAR(LPAR).EQ.13).OR.(IDPAR(MPAR).EQ.13))
4929 C Rearrange s.t. LPAR is the (softest) gluon
4930 IF (IDPAR(MPAR).EQ.13) THEN
4931 IF (IDPAR(LPAR).NE.13.OR.
4932 & PPAR(4,MPAR).LT.PPAR(4,LPAR)) THEN
4938 EINUM=(PPAR(4,KPAR)*PPAR(4,LPAR))
4939 & *ABS(PPAR(2,LPAR)-PPAR(2,MPAR))
4940 EIDEN1=(PPAR(4,KPAR)*PPAR(4,LPAR))-ROHEP(3)*PPAR(3,LPAR)
4941 EIDEN2=PT*ABS(PPAR(1,LPAR))
4942 IF (ABS(PPAR(2,MPAR)).LT.DMIN) THEN
4943 IF (ABS(PPAR(5,MPAR)).LT.DMIN) THEN
4946 CALL HWWARN('HWBTIM',102,*999)
4949 EISCR=ONE-(PPAR(5,MPAR)/PPAR(4,MPAR))**2
4950 & /MIN(PPAR(2,LPAR),PPAR(2,MPAR))
4952 EIKON=EISCR+EINUM/MAX(EIDEN1-EIDEN2,DMIN)
4958 Z1=PPAR(4,LPAR)/PPAR(4,JPAR)
4960 IF (IDPAR(JPAR).EQ.13.AND.IDPAR(LPAR).EQ.13) THEN
4961 WT=Z1*Z2/(Z1/Z2+Z2/Z1+Z1*Z2)
4962 ELSEIF (IDPAR(JPAR).EQ.13.AND.IDPAR(LPAR).LT.13) THEN
4963 WT=-2.*Z1*Z2/(Z1*Z1+Z2*Z2)
4966 C Assign the azimuthal angle
4967 PRMAX=(1.+ABS(WT))*EIKON
4970 IF (NTRY.GT.NBTRY) CALL HWWARN('HWBTIM',101,*999)
4971 CALL HWRAZM( ONE,CX,SX)
4972 CALL HWUROT(PPAR(1,JPAR),CX,SX,RMAT)
4973 C Determine the angle between the branching planes
4974 CALL HWUROF(RMAT,PPAR(1,KPAR),ROHEP)
4976 PHIPAR(1,JPAR)=2.*CAZ*CAZ-1.
4977 PHIPAR(2,JPAR)=2.*CAZ*ROHEP(2)/PT
4978 IF (EICOR) EIKON=EISCR+EINUM/MAX(EIDEN1-EIDEN2*CAZ,DMIN)
4979 IF (AZSPIN) SPIN=1.+WT*(RHOPAR(1,JPAR)*PHIPAR(1,JPAR)
4980 & +RHOPAR(2,JPAR)*PHIPAR(2,JPAR))
4981 IF (SPIN*EIKON.LT.HWRGEN(0)*PRMAX) GOTO 50
4982 C Construct full 4-momentum of L and M
4985 PPAR(1,LPAR)=-PPAR(1,LPAR)
4986 PPAR(1,MPAR)=-PPAR(1,MPAR)
4992 CALL HWUROB(RMAT,PPAR(1,LPAR),PPAR(1,LPAR))
4994 CALL HWUROB(RMAT,PPAR(1,MPAR),PPAR(1,MPAR))
4995 C Assign production vertex to L and M
4996 CALL HWUDKL(IDPAR(JOLD),PPAR(1,JOLD),VPAR(1,LPAR))
4997 CALL HWVSUM(4,VPAR(1,JOLD),VPAR(1,LPAR),VPAR(1,LPAR))
4998 CALL HWVEQU(4,VPAR(1,LPAR),VPAR(1,MPAR))
5000 60 IF (JDAPAR(1,JPAR).NE.0) GOTO 10
5001 C Assign decay matrix
5002 CALL HWVZRO(2,DECPAR(1,JPAR))
5003 C Backtrack down the leader
5004 70 IPAR=JMOPAR(1,JPAR)
5006 IF (KPAR.EQ.JPAR) THEN
5007 C Develop the side branch
5011 C Construct decay matrix
5012 CALL HWBAZF(IPAR,KPAR,DECPAR(1,JPAR),DECPAR(1,KPAR),
5013 & PHIPAR(1,IPAR),DECPAR(1,IPAR))
5015 IF (IPAR.EQ.INITBR) RETURN
5020 *CMZ :- -31/03/00 17:54:05 by Peter Richardson
5021 *-- Author : Gennaro Corcella
5022 C-----------------------------------------------------------------------
5024 C-----------------------------------------------------------------------
5025 INCLUDE 'HERWIG65.INC'
5026 DOUBLE PRECISION HWBVMC,HWRGEN,HWUALF,HWUSQR,X(3),W,
5027 & X3MIN,X3MAX,X1MIN,X1MAX,QSCALE,GLUFAC,R(3,3),M(3),
5028 & E(3),AW,PTSQ,EM,EPS,MASDEP,A,B,C,GAMDEP,LAMBDA,
5029 & PW(5),PT(5),PW1(5),CS,SN,EPG,QQ,RR,CC
5030 INTEGER ID,ID3,IHEP,KHEP,WHEP,ICMF,K
5031 EXTERNAL HWBVMC,HWUALF,HWUSQR,HWRGEN
5032 LAMBDA(A,B,C)=(A**2+B**2+C**2-2*A*B-2*B*C-2*C*A)/(4*A)
5033 C---FIND AN UNTREATED CMF
5036 C----FIND A DECAYING TOP QUARK
5037 10 IF (ISTHEP(IHEP).EQ.155.AND.ISTHEP(JDAHEP(1,IHEP)).EQ.113
5038 & .AND.(IDHW(IHEP).EQ.6.OR.IDHW(IHEP).EQ.12))
5040 IF (ICMF.EQ.0) RETURN
5043 C---GENERATE X(1),X(3) ACCORDING TO 1/((1-X(1))*X(3)**2)
5046 AW=(PHEP(5,JDAHEP(1,ICMF))/EM)**2
5049 X(3)=X3MIN*X3MAX/(X3MIN+(X3MAX-X3MIN)*HWRGEN(0))
5050 C--CC, QQ AND RR ARE THE VARIABLE DEFINED IN OUR PAPER
5051 C--IN ORDER TO SOLVE THE CUBIC EQUATION
5053 QQ=(AW**2-4*(1-X(3))*(2-CC-X(3))-2*AW*(3+2*X(3)))/3
5054 & -((3+2*AW-4*X(3))**2)/9
5055 RR=((3+2*AW-4*X(3))*(AW**2-4*(1-X(3))*(2-CC-X(3))
5056 & -2*AW*(3+2*X(3)))-3*(AW*(4-AW)*(2-CC)+(1-CC)
5057 & *(2*(1-X(3))-AW)**2))/6-(ONE/27)*(3+2*AW-4*X(3))**3
5059 X1MAX=2*(-QQ**3)**(ONE/6)*COS(ACOS(RR/SQRT(-QQ**3))/3)
5060 & -(3+2*AW-4*X(3))/3
5061 X1MIN=1-X(3)+(AW*X(3))/(1-X(3))
5062 IF (X1MAX.GE.1.OR.X1MIN.GE.1.OR.X1MAX.LE.X1MIN) GOTO 100
5063 X(1)=1-(1-X1MAX)*((1-X1MIN)/(1-X1MAX))**HWRGEN(1)
5064 C---CALCULATE WEIGHT
5065 W=((1+1/AW-2*AW)*((1-AW)*X(3)-(1-X(1))*(1-X(3))-X(3)**2)
5066 & +(1+1/(2*AW))*X(3)*(X(1)+X(3)-1)**2+2*X(3)**2*(1-X(1)))
5067 & *(1/X3MIN-1/X3MAX)*LOG((1-X1MIN)/(1-X1MAX))
5068 C---QSCALE=DURHAM-LIKE TRANSVERSE MOMENTUM OF THE GLUON
5069 QSCALE=EM*HWUSQR(X(3)*(1-X(1))/(2-X(1)-X(3)-AW))
5070 C---FACTOR FOR GLUON EMISSION
5071 ID=IDHW(JDAHEP(2,ICMF))
5073 IF (QSCALE.GT.HWBVMC(13)) GLUFAC=CFFAC*HWUALF(1,QSCALE)
5074 & /(PIFAC*(1-AW)*(1-2*AW+1/AW))
5075 C---IN FRACTION GLUFAC*W OF EVENTS ADD A GLUON
5076 IF (GLUFAC*W.GT.HWRGEN(4)) THEN
5081 C---CHECK INFRA-RED CUT-OFF FOR GLUON
5082 M(1)=PHEP(5,JDAHEP(1,ICMF))
5085 E(1)=HALF*EM*(X(1)+AW+(-M(2)**2-M(3)**2)/EM**2)
5088 PTSQ=-LAMBDA(E(1)**2-M(1)**2,E(3)**2-M(3)**2,
5090 IF (PTSQ.LE.0.OR.E(1).LE.M(1).OR.E(2).LE.M(2).OR.E(3).LE.M(3))
5092 C---CALCULATE MASS-DEPENDENT SUPPRESSION
5093 EPS=(RMASS(ID)/EM)**2
5094 EPG=(RMASS(ID3)/EM)**2
5095 GAMDEP=(1-AW)*(1+1/AW-2*AW)/(SQRT(1+AW**2+EPS**2
5096 & -2*AW-2*EPS-2*AW*EPS)*(1+EPS+(1-EPS)**2/AW-2*AW))
5097 MASDEP=GAMDEP/(1-X(1))*((1+EPS+(1-EPS)**2/AW-2*AW)
5098 & *((1-AW+EPS)*X(3)*(1-X(1))-(1-X(1))**2*(1-X(3))
5099 & -X(3)**2*(1-X(1)+EPS))+(1+(1+EPS)/(2*AW))*X(3)
5100 & *(1-X(1))*(X(1)+X(3)-1)**2+2*X(3)**2*(1-X(1))**2)
5101 IF (MASDEP.LT.HWRGEN(7)*((1+1/AW-2*AW)*((1-AW)*X(3)
5102 & -(1-X(1))*(1-X(3))-X(3)**2)+(1+1/(2*AW))*X(3)
5103 & *(X(1)+X(3)-1)**2+2*X(3)**2*(1-X(1)))) GOTO 1000
5104 C---STORE OLD MOMENTA
5105 c---PT = TOP MOMENTUM, PW= W MOMENTUM
5106 CALL HWVEQU(5,PHEP(1,ICMF),PT)
5107 CALL HWVEQU(5,PHEP(1,JDAHEP(1,ICMF)),PW)
5108 C--------GET THE NON-EMITTING PARTON CMF DIRECTION
5109 CALL HWULOF(PHEP(1,ICMF),PW,PW)
5110 CALL HWRAZM(ONE,CS,SN)
5111 CALL HWUROT(PW,CS,SN,R)
5112 CALL HWUROF(R,PW,PW)
5114 C---REORDER ENTRIES: IHEP=EMITTER, KHEP=EMITTED
5119 C---SET UP MOMENTA IN TOP REST FRAME
5125 PHEP(4,IHEP)=HALF*EM*(2-X(1)-X(3)+EPS-AW+EPG)
5126 PHEP(4,KHEP)=HALF*EM*X(3)
5127 PHEP(5,IHEP)=RMASS(ID)
5128 PHEP(5,KHEP)=RMASS(ID3)
5129 PHEP(3,KHEP)=HALF*EM*((X(1)+AW-EPS-EPG)*X(3)-2*(1+EPS-AW
5130 $ -EPG-(2+EPS+EPG-AW-X(1)-X(3))))/HWUSQR((X(1)+AW
5131 $ -EPS-EPG)**2-4*AW)
5132 PHEP(3,IHEP)=-PHEP(3,KHEP)-HALF*EM
5133 $ *HWUSQR((X(1)+AW-EPS-EPG)**2-4*AW)
5135 PHEP(1,KHEP)=HWUSQR(PHEP(4,KHEP)**2-PHEP(5,KHEP)**2
5137 PHEP(1,IHEP)=-PHEP(1,KHEP)
5139 CALL HWVSUM(4,PHEP(1,IHEP),PHEP(1,KHEP),PW1)
5140 CALL HWVDIF(4,PHEP(1,ICMF),PW1,PW1)
5145 C---ORIENT IN CMF, THEN BOOST TO LAB
5146 CALL HWUROB(R,PHEP(1,ICMF),PHEP(1,ICMF))
5147 CALL HWUROB(R,PHEP(1,IHEP),PHEP(1,IHEP))
5148 CALL HWUROB(R,PHEP(1,WHEP),PHEP(1,WHEP))
5149 CALL HWUROB(R,PHEP(1,KHEP),PHEP(1,KHEP))
5150 CALL HWULOB(PT,PHEP(1,IHEP),PHEP(1,IHEP))
5151 CALL HWULOB(PT,PHEP(1,KHEP),PHEP(1,KHEP))
5152 CALL HWULOB(PT,PHEP(1,ICMF),PHEP(1,ICMF))
5153 CALL HWULOB(PT,PHEP(1,WHEP),PHEP(1,WHEP))
5154 C---STATUS AND COLOUR CONNECTION
5155 C--Bug fix 31/03/00 PR
5158 IDHEP(KHEP)=IDPDG(ID3)
5163 IF(IDHW(ICMF).EQ.6) THEN
5169 JDAHEP(2,IHEP) = KHEP
5170 JDAHEP(2,KHEP) = ICMF
5171 JMOHEP(2,IHEP) = ICMF
5172 JMOHEP(2,KHEP) = IHEP
5175 C--modification to allow photon radiation via photos in top decay
5176 1000 IF(ITOPRD.EQ.1) CALL HWPHTP(ICMF)
5179 *CMZ :- -26/04/91 11.11.54 by Bryan Webber
5180 *-- Author : Bryan Webber
5181 C-----------------------------------------------------------------------
5183 C-----------------------------------------------------------------------
5184 C VIRTUAL MASS CUTOFF FOR PARTON TYPE ID
5185 C-----------------------------------------------------------------------
5186 INCLUDE 'HERWIG65.INC'
5187 DOUBLE PRECISION HWBVMC
5190 HWBVMC=RMASS(ID)+VGCUT
5191 ELSEIF (ID.LT.13) THEN
5192 HWBVMC=RMASS(ID)+VQCUT
5193 ELSEIF (ID.EQ.59) THEN
5194 HWBVMC=RMASS(ID)+VPCUT
5200 *CMZ :- -20/07/99 10:56:12 by Peter Richardson
5201 *-- Author : Peter Richardson
5202 C-----------------------------------------------------------------------
5203 SUBROUTINE HWCBCT(JHEP,KHEP,THEP,PCL,SPLIT)
5204 C-----------------------------------------------------------------------
5205 C Subroutine to split a baryonic cluster containing two heavy quarks
5207 C-----------------------------------------------------------------------
5208 INCLUDE 'HERWIG65.INC'
5209 DOUBLE PRECISION HWUPCM,HWRGEN,HWVDOT,EMC,QM1,QM2,QM3,QM4,
5210 & PXY,PCX,PCY,RCM,PCL(5),AX(5),PA(5),PB(5),PC(5),
5211 & VCLUS(4),DQM,EMX,EMY,SKAPPA,RKAPPA,VTMP(4),
5212 & DELTM,PDIQUK(5),AY(5)
5213 INTEGER HWRINT,JHEP,KHEP,LHEP,MHEP,THEP,ID1,ID2,ID3,ID4,NTRY,
5216 EXTERNAL HWUPCM,HWRGEN,HWVDOT
5217 PARAMETER(SKAPPA=1.,NTRYMX=100)
5218 IF(IERROR.NE.0) RETURN
5228 C Decide if cluster contains a b-(anti)quark
5229 IF (ID1.EQ.5.OR.ID1.EQ.11.OR.ID2.EQ.5.OR.ID2.EQ.11.OR.
5230 & ID3.EQ.5.OR.ID3.EQ.11) THEN
5235 C-- Set the positon of the cluster to be that of the heavy quark
5236 CALL HWVEQU(4,VHEP(1,THEP),VCLUS)
5237 C--SPLIT THE BARYONIC CLUSTER INTO A HEAVY FLAVOUR MESON AND A HEAVY
5241 IF(NTRY.GT.NTRYMX) RETURN
5242 30 EMX=QM1+QM2+PXY*HWRGEN(0)**PSPLT(IB)
5243 EMY= QM3+PXY*HWRGEN(1)**PSPLT(IB)
5244 IF(EMX+EMY.GE.EMC) GOTO 30
5245 C--PULL A LIGHT QUARK PAIR OUT OF THE VACUUM
5247 IF(QWT(ID4).LT.HWRGEN(3)) GOTO 40
5249 C--Now combine particles 3 & 4 into a diquark
5250 C--If three also heavy this diquark doesn't exist in HERWIG
5251 C--just assume mass is sum of quark masses,as for other diquarks
5253 C--Now obtain the masses for the cluster splitting
5254 PCX=HWUPCM(EMX,QM1,DQM)
5255 IF(PCX.LT.ZERO) GOTO 20
5256 PCY=HWUPCM(EMY,QM2,QM4)
5257 IF(PCY.LT.ZERO) GOTO 20
5259 C--Now we've decided which light quark to pull out of the vacuum
5260 C--Find the direction of the second heavy quark
5261 CALL HWULOF(PCL,PHEP(1,THEP),AX)
5262 RCM=1./SQRT(HWVDOT(3,AX,AX))
5263 CALL HWVSCA(3,RCM,AX,AX)
5264 C--Construct the new CoM momenta(collinear)
5265 PXY=HWUPCM(EMC,EMX,EMY)
5266 CALL HWVSCA(3,PXY,AX,PC)
5267 C--pc is momenta of Y cluster along 2nd quark dirn in cluster frame
5268 PC(4)=SQRT(PXY**2+EMY**2)
5270 C--pa is momenta of 2nd quark in Y frame
5271 CALL HWVSCA(3,PCY,AX,PA)
5272 PA(4)=SQRT(PCY**2+QM3**2)
5274 C--pb is momenta of 2nd quark in cluster frame,pa now momenta of antiquark
5275 CALL HWULOB(PC,PA,PB)
5276 CALL HWVDIF(4,PC,PB,PA)
5280 C--boost these momenta back to lab frame
5281 CALL HWULOB(PCL,PB,PHEP(1,THEP))
5282 CALL HWULOB(PCL,PA,PHEP(1,MHEP))
5283 C--pc now becomes momenta of X cluster in cluster frame
5284 CALL HWVSCA(3,-ONE,PC,PC)
5287 C--find the dirn of the 1st heavy quark in the X frame
5288 C--transform to cluster frame
5289 CALL HWULOF(PCL,PHEP(1,JHEP),AY)
5290 C--transform to X-frame
5291 CALL HWULOF(PC,AY,AY)
5292 RCM=1./SQRT(HWVDOT(3,AY,AY))
5293 CALL HWVSCA(3,RCM,AY,AY)
5294 C--pa now momenta of 1st havy quark along this dirn
5295 CALL HWVSCA(3,PCX,AY,PA)
5296 PA(4)=SQRT(PCX**2+QM1**2)
5298 C--pb now momenta of 1st heavy quark in cluster frame then to lab
5299 CALL HWULOB(PC,PA,PB)
5300 CALL HWULOB(PCL,PB,PHEP(1,JHEP))
5301 C--now find the diquark momenta by momentum conservation
5303 50 PDIQUK(J)=PCL(J)-PHEP(J,THEP)-PHEP(J,MHEP)-PHEP(J,JHEP)
5305 C--Now obtain the quark momenta from the diquark
5310 CALL HWULOB(PDIQUK,PA,PHEP(1,KHEP))
5311 CALL HWVDIF(4,PDIQUK,PHEP(1,KHEP),PHEP(1,LHEP))
5312 C--Construct new vertex positions
5313 RKAPPA=GEV2MM/SKAPPA
5314 CALL HWVSCA(3,RKAPPA,AX,AX)
5315 DELTM=(EMX-EMY)*(EMX+EMY)/(TWO*EMC)
5316 CALL HWVSCA(3,DELTM,AX,VTMP)
5317 VTMP(4)=(HALF*EMC-PXY)*RKAPPA
5318 CALL HWULB4(PCL,VTMP,VTMP)
5319 CALL HWVSUM(4,VTMP,VCLUS,VHEP(1,LHEP))
5320 CALL HWVEQU(4,VHEP(1,LHEP),VHEP(1,MHEP))
5321 C--Relabel the colours of the quarks
5322 IDHEP(LHEP) = IDPDG(ID4)
5323 IDHEP(MHEP) = IDPDG(ID4)
5324 IF(IDHEP(JHEP).GT.0) THEN
5326 IDHEP(LHEP) = -IDHEP(LHEP)
5328 JDAHEP(2,LHEP) = JHEP
5329 JMOHEP(2,LHEP) = MHEP
5330 JMOHEP(2,MHEP) = JMOHEP(2,JHEP)
5331 JDAHEP(2,MHEP) = LHEP
5332 JMOHEP(2,JHEP) = LHEP
5336 IDHEP(MHEP) = -IDHEP(MHEP)
5337 JMOHEP(2,LHEP) = JHEP
5338 JDAHEP(2,MHEP) = JDAHEP(2,JHEP)
5339 JDAHEP(2,LHEP) = MHEP
5340 JMOHEP(2,MHEP) = LHEP
5341 JDAHEP(2,JHEP) = LHEP
5345 JMOHEP(1,LHEP) = JMOHEP(1,KHEP)
5347 JMOHEP(1,MHEP) = JMOHEP(1,JHEP)
5352 *CMZ :- -12/12/01 14:59:58 by Peter Richardson
5353 *-- Author : Mark Gibbs, modified by Peter Richardson
5354 C-----------------------------------------------------------------------
5356 C-----------------------------------------------------------------------
5357 C FINDS UNPAIRED PARTONS AFTER BARYON-NUMBER VIOLATION
5358 C MODIFIED FOR RPARITY VIOLATING SUSY
5359 C-----------------------------------------------------------------------
5360 INCLUDE 'HERWIG65.INC'
5361 COMMON/HWBVIC/NBV,IBV(18)
5362 DOUBLE PRECISION HWRGEN,PDQ(5)
5363 INTEGER NBV,IBV,JBV,KBV,LBV,IHEP,IP1,IP2,IP3,JP1,JP2,JP3,
5364 & HWCBVT,NBR,MBV,IQ1,IQ2,IQ3,ID1,ID2,IDQ,IDIQK(3,3)
5365 LOGICAL SPLIT,DUNBV(18)
5366 DATA IDIQK/111,110,113,110,109,112,113,112,114/
5367 C---Check for errors
5368 IF (IERROR.NE.0) RETURN
5369 C---Correct colour connections are gluon splitting
5371 C---Reset bvi clustering flag
5373 C---LIST PARTONS WITH WRONG COLOUR PARTNERS-QUARKS ONLY
5376 IF (ISTHEP(IHEP).GT.149.AND.ISTHEP(IHEP).LT.155) THEN
5377 IF (QORQQB(IDHW(IHEP))) THEN
5378 IF (.NOT.QORQQB(IDHW(JMOHEP(2,IHEP))).
5379 & AND.JMOHEP(2,IHEP).GT.6) GOTO 10
5381 C---Extra check for Gamma's
5382 IF (IDHW(IHEP).EQ.59) GO TO 10
5384 IF (QORQQB(IDHW(JDAHEP(2,IHEP)))) GO TO 10
5387 IF(JMOHEP(2,IHEP).LT.6.AND.
5388 & .NOT.QBORQQ(IDHW(JMOHEP(2,IHEP)))) GOTO 10
5389 C--new for hard process
5391 IF (NBV.GT.18) CALL HWWARN('HWCBVI',100,*999)
5396 C--NOW FIND THE ANTIQUARKS WITH WRONG COLOUR CONNECTIONS
5398 IF(ISTHEP(IHEP).GT.149.AND.ISTHEP(IHEP).LT.155) THEN
5399 IF(QBORQQ(IDHW(IHEP))) THEN
5400 IF(.NOT.QBORQQ(IDHW(JDAHEP(2,IHEP))).AND.
5401 & JDAHEP(2,IHEP).GT.6) GO TO 11
5403 C--Extra check for gamma's
5404 IF(IDHW(IHEP).EQ.59) GO TO 11
5405 IF(QBORQQ(IDHW(JMOHEP(2,IHEP)))) GO TO 11
5408 IF(JDAHEP(2,IHEP).LT.6.AND.
5409 & .NOT.QORQQB(IDHW(JDAHEP(2,IHEP)))) GOTO 11
5411 IF(NBV.GT.18) CALL HWWARN('HWCBVI',100,*999)
5416 IF (NBV.EQ.0) RETURN
5417 IF(MOD(NBV,3).NE.0) CALL HWWARN('HWCBVI',101,*999)
5418 C---PROCESS FOUND PARTONS, STARTING AT RANDOM POINT IN LIST
5422 IF (JBV.GT.NBV) JBV=JBV-NBV
5423 IF (.NOT.DUNBV(JBV)) THEN
5427 C---FIND ASSOCIATED PARTONS
5429 IF (.NOT.DUNBV(KBV)) THEN
5432 IF (JP2.EQ.JP1) THEN
5435 IF (.NOT.DUNBV(LBV)) THEN
5438 IF (JP3.EQ.JP2) THEN
5447 CALL HWWARN('HWCBVI',102,*999)
5449 C---LOOK FOR DIQUARK
5450 IF (ABS(IDHEP(IP1)).GT.100) THEN
5454 ELSEIF (ABS(IDHEP(IP2)).GT.100) THEN
5458 ELSEIF (ABS(IDHEP(IP3)).GT.100) THEN
5464 C---NO DIQUARKS: COMBINE TWO (ANTI)QUARKS
5465 IF (ABS(IDHEP(IP1)).GT.3) THEN
5469 ELSEIF (ABS(IDHEP(IP2)).GT.3) THEN
5481 IF (ID1.GT.0.AND.ID1.LT.4.AND.
5482 & ID2.GT.0.AND.ID2.LT.4) THEN
5484 ELSEIF (ID1.LT.0.AND.ID1.GT.-4.AND.
5485 & ID1.LT.0.AND.ID2.GT.-4) THEN
5486 IDQ=IDIQK(-ID1,-ID2)+6
5488 C---CANT MAKE DIQUARKS WITH HEAVY QUARKS: TRY CLUSTER SPLITTING
5489 CALL HWVSUM(4,PHEP(1,IQ1),PHEP(1,IQ2),PDQ)
5491 C--Use the original splitting procedure
5492 CALL HWCCUT(IQ1,IQ2,PDQ,.FALSE.,SPLIT)
5493 IF (IERROR.NE.0) RETURN
5495 C--If it fails try the new procedure
5496 CALL HWVSUM(4,PDQ,PHEP(1,IQ3),PDQ)
5498 IF(ABS(ID1).GT.3) THEN
5499 CALL HWCBCT(IQ3,IQ2,IQ1,PDQ,SPLIT)
5500 ELSEIF(ABS(ID2).GT.3) THEN
5501 CALL HWCBCT(IQ3,IQ1,IQ2,PDQ,SPLIT)
5503 CALL HWWARN('HWCBVI',100,*999)
5506 C---Unable to form cluster; dispose of event
5507 CALL HWWARN('HWCBVI',-3,*999)
5509 C---OVERWRITE FIRST AND CANCEL SECOND
5511 IDHEP(IQ1)=IDPDG(IDQ)
5512 CALL HWVSUM(4,PHEP(1,IQ1),PHEP(1,IQ2),PHEP(1,IQ1))
5513 CALL HWUMAS(PHEP(1,IQ1))
5515 C---REMAKE COLOUR CONNECTIONS
5516 IF (QORQQB(IDQ)) THEN
5526 CALL HWVSCA(5,HALF,PHEP(1,IQ1),PHEP(1,IQ1))
5527 CALL HWVEQU(5,PHEP(1,IQ1),PHEP(1,NHEP))
5529 JMOHEP(1,NHEP)=JMOHEP(1,IQ1)
5535 IF (IDIQK(ID1,ID2).EQ.IDQ) THEN
5538 C---REMAKE COLOUR CONNECTIONS (DIQUARK)
5548 ELSEIF (IDIQK(ID1,ID2).EQ.IDQ-6) THEN
5551 C---REMAKE COLOUR CONNECTIONS (ANTIDIQUARK)
5563 CALL HWWARN('HWCBVI',104,*999)
5564 35 IDHEP(IQ1)=IDPDG(IDHW(IQ1))
5565 IDHEP(NHEP)=IDPDG(IDHW(NHEP))
5573 *-- Author : Peter Richardson
5574 C-----------------------------------------------------------------------
5576 C-----------------------------------------------------------------------
5577 C Function to find the baryon number violating vertex a parton came from
5578 C-----------------------------------------------------------------------
5579 INCLUDE 'HERWIG65.INC'
5580 INTEGER HWCBVT,IP,JP(2),KP,I,J,ID,TYPE,IDM,IDM2,IDM3,IDM4
5583 IF(ID.LE.6.OR.(ID.GE.115.AND.ID.LE.120)) THEN
5584 JP(2) = JMOHEP(2,IP)
5586 JP(2) = JDAHEP(2,IP)
5589 IDM = JMOHEP(1,JMOHEP(1,JMOHEP(1,JMOHEP(1,JP(I)))))
5590 IF(IDHW(IDM).EQ.6.OR.IDHW(IDM).EQ.12) THEN
5596 KP = JMOHEP(1,JP(I))
5598 IDM2 = IDHW(JDAHEP(1,KP))
5599 IDM3 = IDHW(JDAHEP(2,KP))
5600 IDM4 = IDHW(JDAHEP(1,KP)+1)
5601 IF((ISTHEP(KP).EQ.155.AND.
5602 & ((IDM.GE.449.AND.IDM.LE.457.AND.IDM2.LE.12.AND.
5603 & IDM3.LE.12.AND.IDM4.LE.12).OR.
5604 & (((IDM.GE.411.AND.IDM.LE.424).OR.IDM.EQ.405.OR.IDM.EQ.406)
5605 & .AND.IDM2.LE.12.AND.IDM3.LE.12)))
5606 & .OR.(IDM.EQ.15.AND.IDM2.LE.12.AND.
5607 & IDHW(JMOHEP(1,KP)).LE.12.AND.
5608 & IDHW(JMOHEP(2,KP)).LE.12.AND.IDM3.GE.449.AND.
5610 & (IDM.EQ.15.AND.IDM2.GE.198.AND.IDM2.LE.200.
5611 & AND.ABS(IDPDG(IDM3)).GT.1000000)) THEN
5612 IF(IDHW(KP).EQ.449.AND.JDAHEP(1,KP).EQ.JP(I)) THEN
5614 ELSEIF(IDHW(KP).EQ.15) THEN
5615 TYPE=IDHW(JDAHEP(1,KP))
5616 IF(TYPE.GE.7.AND.TYPE.LE.12.AND.
5617 & JMOHEP(2,JDAHEP(2,KP)).EQ.JP(I)) THEN
5619 ELSEIF(TYPE.LE.6.AND.
5620 & JDAHEP(2,JDAHEP(2,KP)).EQ.JP(I)) THEN
5638 *-- Author : Peter Richardson
5639 C-----------------------------------------------------------------------
5641 C-----------------------------------------------------------------------
5642 C Subroutine to correct colour connections after the gluon splitting
5643 C-----------------------------------------------------------------------
5644 INCLUDE 'HERWIG65.INC'
5645 INTEGER IHEP,STFSPT,LHEP,MHEP,RHEP
5646 IF(IERROR.NE.0) RETURN
5647 C--Find the first particle in the event record with status 150
5649 IF(ISTHEP(IHEP).GE.150.AND.ISTHEP(IHEP).LE.154) THEN
5655 C--Now find any that are colour connected to earlier particles
5656 C--in the event record
5658 C--First the quarks and antidiquarks
5659 IF(IDHW(IHEP).LT.6.OR.
5660 & (IDHW(IHEP).GE.115.AND.IDHW(IHEP).LE.120)) THEN
5661 IF(JMOHEP(2,IHEP).LT.STFSPT) THEN
5663 MHEP = JMOHEP(2,IHEP)
5665 IF(MHEP.GT.6) RHEP = JDAHEP(1,MHEP)
5666 C--As from Rparity connect to particle not to antiparticle
5667 IF(IDHW(MHEP).NE.13) THEN
5668 JMOHEP(2,LHEP) = RHEP
5671 JMOHEP(2,LHEP) = RHEP
5675 C--Now the antiquarks
5676 IF((IDHW(IHEP).GT.6.AND.IDHW(IHEP).LE.12).OR.
5677 & (IDHW(IHEP).GE.109.AND.IDHW(IHEP).LE.114)) THEN
5678 IF(JDAHEP(2,IHEP).LT.STFSPT) THEN
5680 MHEP = JDAHEP(2,IHEP)
5682 IF(MHEP.GT.6) RHEP = JDAHEP(1,MHEP)
5683 C--As from Rparity connect to antiparticle not particle
5684 IF(IDHW(MHEP).NE.13) THEN
5685 JDAHEP(2,LHEP) = RHEP
5687 JDAHEP(2,LHEP) = RHEP
5694 *CMZ :- -26/04/91 14.29.39 by Federico Carminati
5695 *-- Author : Bryan Webber
5696 C-----------------------------------------------------------------------
5697 SUBROUTINE HWCCUT(JHEP,KHEP,PCL,BTCLUS,SPLIT)
5698 C-----------------------------------------------------------------------
5699 C Cuts into 2 the cluster, momentum PCL, made of partons JHEP & KHEP
5700 C-----------------------------------------------------------------------
5701 INCLUDE 'HERWIG65.INC'
5702 DOUBLE PRECISION HWREXQ,HWUPCM,HWRGEN,HWVDOT,EMC,QM1,QM2,EMX,EMY,
5703 & QM3,PXY,PCX,PCY,RCM,PCL(5),AX(5),PA(5),PB(5),PC(5),SKAPPA,DELTM,
5704 & VSCA,VTMP(4),RKAPPA,VCLUS
5705 INTEGER HWRINT,JHEP,KHEP,LHEP,MHEP,ID1,ID2,ID3,NTRY,NTRYMX,J,IB
5706 LOGICAL BTCLUS,SPLIT
5707 EXTERNAL HWREXQ,HWUPCM,HWRGEN,HWVDOT,HWRINT
5708 COMMON/HWCFRM/VCLUS(4,NMXHEP)
5709 PARAMETER (SKAPPA=1.,NTRYMX=100)
5710 IF (IERROR.NE.0) RETURN
5718 C Decide if cluster contains a b-(anti)quark
5719 IF (ID1.EQ.5.OR.ID1.EQ.11.OR.ID2.EQ.5.OR.ID2.EQ.11) THEN
5725 C Split beam and target clusters as soft clusters
5726 C Both (remnant) children treated like soft clusters if IOPREM=0(1)
5729 IF (EMC.LE.QM1+QM2+2.*QM3) THEN
5732 IF (EMC.LE.QM1+QM2+2.*QM3) RETURN
5734 PXY=EMC-QM1-QM2-TWO*QM3
5735 IF (ISTHEP(JHEP).EQ.153.OR.ISTHEP(JHEP).EQ.154.OR.
5737 EMX=QM1+QM3+HWREXQ(BTCLM,PXY)
5739 EMX=QM1+QM3+PXY*HWRGEN(0)**PSPLT(IB)
5741 IF (ISTHEP(KHEP).EQ.153.OR.ISTHEP(KHEP).EQ.154.OR.
5743 EMY=QM2+QM3+HWREXQ(BTCLM,PXY)
5745 EMY=QM2+QM3+PXY*HWRGEN(1)**PSPLT(IB)
5747 IF (EMX+EMY.GE.EMC) THEN
5749 IF (NTRY.GT.NTRYMX) RETURN
5752 PCX=HWUPCM(EMX,QM1,QM3)
5753 PCY=HWUPCM(EMY,QM2,QM3)
5755 C Choose fragment masses for ordinary cluster
5758 IF (NTRY.GT.NTRYMX) RETURN
5759 30 EMX=QM1+PXY*HWRGEN(0)**PSPLT(IB)
5760 EMY=QM2+PXY*HWRGEN(1)**PSPLT(IB)
5761 IF (EMX+EMY.GE.EMC) GOTO 30
5762 C u,d,s pair production with weights QWT
5764 IF (QWT(ID3).LT.HWRGEN(3)) GOTO 40
5766 PCX=HWUPCM(EMX,QM1,QM3)
5767 IF (PCX.LT.ZERO) GOTO 20
5768 PCY=HWUPCM(EMY,QM2,QM3)
5769 IF (PCY.LT.ZERO) GOTO 20
5772 C Boost antiquark to CoM frame to find axis
5773 CALL HWULOF(PCL,PHEP(1,KHEP),AX)
5774 RCM=1./SQRT(HWVDOT(3,AX,AX))
5775 CALL HWVSCA(3,RCM,AX,AX)
5776 C Construct new CoM momenta (collinear)
5777 PXY=HWUPCM(EMC,EMX,EMY)
5778 CALL HWVSCA(3,PXY,AX,PC)
5779 PC(4)=SQRT(PXY**2+EMY**2)
5781 CALL HWVSCA(3,PCY,AX,PA)
5782 PA(4)=SQRT(PCY**2+QM2**2)
5784 CALL HWULOB(PC,PA,PB)
5785 CALL HWVDIF(4,PC,PB,PA)
5789 IF (MHEP.GT.NMXHEP) CALL HWWARN('HWCCUT',100,*999)
5790 CALL HWULOB(PCL,PB,PHEP(1,KHEP))
5791 CALL HWULOB(PCL,PA,PHEP(1,MHEP))
5792 CALL HWVSCA(3,-ONE,PC,PC)
5795 CALL HWVSCA(3,PCX,AX,PA)
5796 PA(4)=SQRT(PCX**2+QM3**2)
5797 CALL HWULOB(PC,PA,PB)
5798 CALL HWULOB(PCL,PB,PHEP(1,LHEP))
5800 50 PHEP(J,JHEP)=PCL(J)-PHEP(J,KHEP)-PHEP(J,LHEP)-PHEP(J,MHEP)
5802 CALL HWVEQU(4,VHEP(1,LHEP),VHEP(1,MHEP))
5803 C Construct new vertex positions
5804 RKAPPA=GEV2MM/SKAPPA
5805 CALL HWVSCA(3,RKAPPA,AX,AX)
5806 DELTM=(EMX-EMY)*(EMX+EMY)/(TWO*EMC)
5807 CALL HWVSCA(3,DELTM,AX,VTMP)
5808 VTMP(4)=(HALF*EMC-PXY)*RKAPPA
5809 CALL HWULB4(PCL,VTMP,VTMP)
5810 CALL HWVSUM(4,VTMP,VCLUS(1,JHEP),VHEP(1,LHEP))
5811 CALL HWVEQU(4,VHEP(1,LHEP),VHEP(1,MHEP))
5812 VSCA=0.25*EMC+HALF*(PXY+DELTM)
5813 CALL HWVSCA(3,VSCA,AX,VTMP)
5814 VTMP(4)=(EMC-VSCA)*RKAPPA
5815 CALL HWULB4(PCL,VTMP,VTMP)
5816 CALL HWVSUM(4,VTMP,VCLUS(1,JHEP),VCLUS(1,MHEP))
5817 VSCA=-0.25*EMC+HALF*(DELTM-PXY)
5818 CALL HWVSCA(3,VSCA,AX,VTMP)
5819 VTMP(4)=(EMC+VSCA)*RKAPPA
5820 CALL HWULB4(PCL,VTMP,VTMP)
5821 CALL HWVSUM(4,VTMP,VCLUS(1,JHEP),VCLUS(1,JHEP))
5825 IDHEP(MHEP)= IDPDG(ID3)
5826 IDHEP(LHEP)=-IDPDG(ID3)
5831 JMOHEP(1,LHEP)=JMOHEP(1,KHEP)
5835 JMOHEP(1,MHEP)=JMOHEP(1,JHEP)
5842 *CMZ :- -26/04/91 10.18.56 by Bryan Webber
5843 *-- Author : Bryan Webber
5844 C-----------------------------------------------------------------------
5846 C-----------------------------------------------------------------------
5847 C DECAYS CLUSTERS INTO PRIMARY HADRONS
5848 C-----------------------------------------------------------------------
5849 INCLUDE 'HERWIG65.INC'
5850 INTEGER JCL,KCL,IP,JP,KP,IST,ID1,ID2,ID3
5851 IF (IERROR.NE.0) RETURN
5852 IF (IPRO/10.EQ.9.OR.IPRO/10.EQ.5) THEN
5853 C---RELABEL CLUSTER CONNECTED TO REMNANT IN DIS
5855 IF (ISTHEP(JCL).EQ.164) GOTO 20
5856 IF (ISTHEP(JCL).EQ.165) THEN
5860 IF (ISTHEP(IP).EQ.162) THEN
5864 IF (JMOHEP(2,KP).NE.JP) THEN
5870 IF (ISTHEP(KCL)/10.NE.16) CALL HWWARN('HWCDEC',100,*999)
5879 IF (IST.GT.162.AND.IST.LT.166) THEN
5880 C---DON'T HADRONIZE BEAM/TARGET CLUSTERS
5881 IF (IST.EQ.163.OR..NOT.GENSOF) THEN
5882 C---SET UP FLAVOURS FOR CLUSTER DECAY
5883 CALL HWCFLA(IDHW(JMOHEP(1,JCL)),IDHW(JMOHEP(2,JCL)),ID1,ID3)
5884 CALL HWCHAD(JCL,ID1,ID3,ID2)
5891 *CMZ :- -26/04/91 10.18.56 by Bryan Webber
5892 *-- Author : Bryan Webber
5893 C-----------------------------------------------------------------------
5894 SUBROUTINE HWCFLA(JD1,JD2,ID1,ID2)
5895 C-----------------------------------------------------------------------
5896 C SETS UP FLAVOURS FOR CLUSTER DECAY
5897 C-----------------------------------------------------------------------
5898 INTEGER JD1,JD2,ID1,ID2,JD,JDEC(12)
5899 DATA JDEC/1,2,3,10,11,12,4,5,6,7,8,9/
5901 IF (JD.GT.12) JD=JD-108
5904 IF (JD.GT.12) JD=JD-96
5908 *CMZ :- -26/04/91 14.15.56 by Federico Carminati
5909 *-- Author : Bryan Webber
5910 C-----------------------------------------------------------------------
5912 C-----------------------------------------------------------------------
5913 C Converts colour-connected quark-antiquark pairs into clusters
5914 C Modified by IGK to include BRW's colour rearrangement and
5915 C MHS's cluster vertices
5916 C MODIFIED 16/10/97 BY BRW FOR SUSY PROCESSES
5917 C-----------------------------------------------------------------------
5918 INCLUDE 'HERWIG65.INC'
5919 DOUBLE PRECISION HWULDO,HWVDOT,HWRGEN,HWUPCM,DCL0,DCL(4),DCL1,
5920 & DFAC,DISP1(4),DISP2(4),DMAX,PCL(5),DOT1,DOT2,FAC,VCLUS,SCA1,SCA2,
5921 & EM0,EM1,EM2,PC0,PC1
5922 INTEGER HWRINT,MAP(120),IBHEP,IBCL,JBHEP,JHEP,
5923 & KHEP,LHEP,LCL,IHEP,MCL,I,ISTJ,ISTK,JCL,ID1,ID3,L
5924 LOGICAL HWRLOG,SPLIT
5925 EXTERNAL HWULDO,HWVDOT,HWRGEN,HWUPCM,HWRINT
5926 COMMON/HWCFRM/VCLUS(4,NMXHEP)
5927 DATA MAP/1,2,3,4,5,6,1,2,3,4,5,6,96*0,7,8,9,10,11,12,7,8,9,10,11,
5929 IF (IERROR.NE.0) RETURN
5932 C Find colour partners after baryon number violating event
5940 IF (IERROR.NE.0) RETURN
5941 C Look for partons to cluster
5943 10 IF (ISTHEP(IBHEP).GE.150.AND.ISTHEP(IBHEP).LE.154) GOTO 20
5947 C--Final check for colour disconnections
5948 DO 25 JHEP=IBHEP,NHEP
5949 IF (ISTHEP(JHEP).GE.150.AND.ISTHEP(JHEP).LE.154.AND.
5950 & QORQQB(IDHW(JHEP))) THEN
5953 IF (KHEP.EQ.0.OR..NOT.(
5954 & ISTHEP(KHEP).GE.150.AND.ISTHEP(KHEP).LE.154.AND.
5955 & QBORQQ(IDHW(KHEP)))) THEN
5957 IF (ISTHEP(KHEP).GE.150.AND.ISTHEP(KHEP).LE.154
5958 & .AND.QBORQQ(IDHW(KHEP))) THEN
5960 IF (LHEP.EQ.0.OR..NOT.(
5961 & ISTHEP(LHEP).GE.150.AND.ISTHEP(LHEP).LE.154.AND.
5962 & QORQQB(IDHW(LHEP)))) THEN
5970 CALL HWWARN('HWCFOR',100,*999)
5975 C Allow for colour rearrangement of primary clusters
5977 C Randomize starting point
5978 JBHEP=HWRINT(IBHEP,NHEP)
5981 IF (JHEP.GT.NHEP) JHEP=IBHEP
5982 IF (ISTHEP(JHEP).GE.150.AND.ISTHEP(JHEP).LE.154.AND.
5983 & QORQQB(IDHW(JHEP))) THEN
5984 C Find colour connected antiquark or diquark
5986 C Find partner antiquark or diquark
5988 C Find closest antiquark or diquark
5991 DO 40 IHEP=IBHEP,NHEP
5992 IF (ISTHEP(IHEP).GE.150.AND.ISTHEP(IHEP).LE.154.AND.
5993 & QBORQQ(IDHW(IHEP))) THEN
5994 C Check whether already reconnected
5995 IF (JDAHEP(2,IHEP).GT.0.AND.IHEP.NE.LHEP) THEN
5996 CALL HWVDIF(4,VHEP(1,IHEP),VHEP(1,JHEP),DCL)
5997 DCL1=ABS(HWULDO(DCL,DCL))
5998 IF (DCL1.LT.DCL0) THEN
6005 IF (LCL.NE.0.AND.LCL.NE.KHEP) THEN
6007 IF (JDAHEP(2,MCL).NE.KHEP) THEN
6008 C Pairwise reconnection is possible
6009 CALL HWVDIF(4,VHEP(1,KHEP),VHEP(1,MCL ),DCL)
6010 DCL0=DCL0+ABS(HWULDO(DCL,DCL))
6011 CALL HWVDIF(4,VHEP(1,JHEP),VHEP(1,KHEP),DCL)
6012 DCL1=ABS(HWULDO(DCL,DCL))
6013 CALL HWVDIF(4,VHEP(1,LCL ),VHEP(1,MCL ),DCL)
6014 DCL1=DCL1+ABS(HWULDO(DCL,DCL))
6015 IF (DCL0.LT.DCL1.AND.HWRLOG(PRECO)) THEN
6016 C Reconnection occurs
6018 JDAHEP(2,LCL )=-JHEP
6019 JMOHEP(2,MCL) = KHEP
6026 IF (JHEP.NE.JBHEP) GOTO 30
6027 IF (NRECO.NE.0) THEN
6028 DO 50 IHEP=IBHEP,NHEP
6029 50 JDAHEP(2,IHEP)=ABS(JDAHEP(2,IHEP))
6032 C Find (adjusted) cluster positions using MHS prescription
6035 DO 70 JHEP=IBHEP,NHEP
6036 IF (ISTHEP(JHEP).GE.150.AND.ISTHEP(JHEP).LE.154.AND.
6037 & QORQQB(IDHW(JHEP))) THEN
6039 CALL HWUDKL(IDHW(JHEP),PHEP(1,JHEP),DISP1)
6040 CALL HWVSCA(4,DFAC,DISP1,DISP1)
6041 CALL HWUDKL(IDHW(KHEP),PHEP(1,KHEP),DISP2)
6042 CALL HWVSCA(4,DFAC,DISP2,DISP2)
6043 C Rescale the lengths of DISP1,DISP2 if too long
6044 DOT1=HWVDOT(3,DISP1,DISP1)
6045 DOT2=HWVDOT(3,DISP2,DISP2)
6046 IF (MAX(DOT1,DOT2).GT.DMAX**2) THEN
6047 CALL HWVSCA(4,DMAX/SQRT(DOT1),DISP1,DISP1)
6048 CALL HWVSCA(4,DMAX/SQRT(DOT2),DISP2,DISP2)
6050 CALL HWVSUM(4,PHEP(1,JHEP),PHEP(1,KHEP),PCL)
6051 DOT1=HWVDOT(3,DISP1,PCL)
6052 DOT2=HWVDOT(3,DISP2,PCL)
6053 C If PCL > 90^o from either quark, use a vector which isn't
6054 IF (DOT1.LE.ZERO.OR. DOT2.LE.ZERO) THEN
6055 CALL HWVSUM(4,DISP1,DISP2,PCL)
6056 DOT1=HWVDOT(3,DISP1,PCL)
6057 DOT2=HWVDOT(3,DISP2,PCL)
6059 C If vectors are exactly opposite each other this method cannot work
6060 IF (DOT1.EQ.ZERO.OR.DOT2.EQ.ZERO) THEN
6061 C So use midpoint of quark constituents
6062 CALL HWVSUM(4,VHEP(1,JHEP),VHEP(1,KHEP),VCLUS(1,JHEP))
6063 CALL HWVSCA(4,HALF,VCLUS(1,JHEP),VCLUS(1,JHEP))
6066 C Rescale DISP1 or DISP2 to give equal components in the PCL direction
6068 IF (FAC.GT.ONE) THEN
6069 CALL HWVSCA(4, FAC,DISP2,DISP2)
6072 CALL HWVSCA(4,ONE/FAC,DISP1,DISP1)
6075 C Shift VHEP(1,JHEP) or VHEP(1,KHEP) s.t. their line is perp to PCL
6076 FAC=(HWVDOT(3,PCL,VHEP(1,KHEP))
6077 & -HWVDOT(3,PCL,VHEP(1,JHEP)))/DOT1
6078 SCA1=MAX(ONE,ONE+FAC)
6079 SCA2=MAX(ONE,ONE-FAC)
6081 60 VCLUS(I,JHEP)=.5*(VHEP(I,JHEP)+VHEP(I,KHEP)
6082 & +SCA1*DISP1(I)+SCA2*DISP2(I))
6085 C First chop up beam/target clusters
6086 DO 80 JHEP=IBHEP,NHEP
6090 C--PR MOD here 8/7/99
6091 IF (QORQQB(IDHW(JHEP)).AND.
6092 & (((ISTJ.EQ.153.OR.ISTJ.EQ.154).AND.ISTK.NE.151.AND.ISTK.NE.0)
6093 & .OR.((ISTK.EQ.153.OR.ISTK.EQ.154).
6094 & AND.ISTJ.NE.151.AND.ISTJ.NE.0))) THEN
6096 CALL HWVSUM(4,PHEP(1,JHEP),PHEP(1,KHEP),PCL)
6098 CALL HWCCUT(JHEP,KHEP,PCL,.TRUE.,SPLIT)
6099 IF (IERROR.NE.0) RETURN
6102 C Second chop up massive pairs
6103 DO 100 JHEP=IBHEP,NMXHEP
6104 IF (JHEP.GT.NHEP) GOTO 110
6105 IF (ISTHEP(JHEP).GE.150.AND.ISTHEP(JHEP).LE.154.AND.
6106 & QORQQB(IDHW(JHEP))) THEN
6107 90 KHEP=JMOHEP(2,JHEP)
6108 CALL HWVSUM(4,PHEP(1,JHEP),PHEP(1,KHEP),PCL)
6110 IF (PCL(5).GT.CTHRPW(MAP(IDHW(JHEP)),MAP(IDHW(KHEP)))) THEN
6111 CALL HWCCUT(JHEP,KHEP,PCL,.FALSE.,SPLIT)
6112 IF (IERROR.NE.0) RETURN
6117 C Third create clusters and store production vertex
6120 DO 120 JHEP=IBHEP,NHEP
6121 IF (ISTHEP(JHEP).GE.150.AND.ISTHEP(JHEP).LE.154.AND.
6122 & QORQQB(IDHW(JHEP))) THEN
6124 IF(JCL.GT.NMXHEP) CALL HWWARN('HWCFOR',105,*999)
6128 IF (KHEP.EQ.0.OR..NOT.(
6129 & ISTHEP(KHEP).GE.150.AND.ISTHEP(KHEP).LE.154.AND.
6130 & QBORQQ(IDHW(KHEP)))) CALL HWWARN('HWCFOR',104,*999)
6131 CALL HWVSUM(4,PHEP(1,JHEP),PHEP(1,KHEP),PHEP(1,JCL))
6132 CALL HWUMAS(PHEP(1,JCL))
6133 IF (ISTHEP(JHEP).EQ.153.OR.ISTHEP(KHEP).EQ.153) THEN
6135 ELSEIF (ISTHEP(JHEP).EQ.154.OR.ISTHEP(KHEP).EQ.154) THEN
6146 ISTHEP(JHEP)=ISTHEP(JHEP)+8
6147 ISTHEP(KHEP)=ISTHEP(KHEP)+8
6148 CALL HWVEQU(4,VCLUS(1,JHEP),VHEP(1,JCL))
6152 C Fix up momenta for single-hadron clusters
6153 130 DO 150 JCL=IBCL,NHEP
6154 C Don't hadronize beam/target clusters
6155 IF (ISTHEP(JCL).LT.163.OR.ISTHEP(JCL).GT.165) GOTO 150
6156 IF (ISTHEP(JCL).NE.163.AND.GENSOF) GOTO 150
6157 C Set up flavours for cluster decay
6158 CALL HWCFLA(IDHW(JMOHEP(1,JCL)),IDHW(JMOHEP(2,JCL)),ID1,ID3)
6160 IF ((B1LIM.EQ.ZERO).OR.(ID1.NE.11.AND.ID3.NE.11)) THEN
6161 IF (EM0.GT.MIN(RMIN(ID1,1)+RMIN(1,ID3),
6162 $ RMIN(ID1,2)+RMIN(2,ID3))) GOTO 150
6164 C Special for b clusters: allow 1-hadron decay above threshold
6165 IF (B1LIM*HWRGEN(1).LT.EM0/(MIN(RMIN(ID1,1)+RMIN(1,ID3),
6166 $ RMIN(ID1,2)+RMIN(2,ID3)))-1.)
6170 IF (ABS(EM0-EM1).LT.1.D-5) GOTO 150
6171 C Decide to go backward or forward to transfer 4-momentum
6172 L=1-TWO*INT(HALF+HWRGEN(2))
6177 IF (LCL.LT.IBCL) LCL=LCL+MCL
6178 IF (LCL.GT.NHEP) LCL=LCL-MCL
6179 IF (LCL.EQ.JCL) THEN
6180 IF (EM0.GE.EM1+RMIN(1,1)) GOTO 150
6181 CALL HWWARN('HWCFOR',101,*999)
6183 IF (ISTHEP(LCL).LT.163.OR.ISTHEP(LCL).GT.165) GOTO 140
6184 C Rescale momenta in 2-cluster CoM
6185 CALL HWVSUM(4,PHEP(1,JCL),PHEP(1,LCL),PCL)
6188 PC0=HWUPCM(PCL(5),EM0,EM2)
6189 PC1=HWUPCM(PCL(5),EM1,EM2)
6190 IF (PC1.LT.ZERO) THEN
6191 C Need to rescale other mass as well
6192 CALL HWCFLA(IDHW(JMOHEP(1,LCL)),IDHW(JMOHEP(2,LCL)),ID1,ID3)
6194 PC1=HWUPCM(PCL(5),EM1,EM2)
6195 IF (PC1.LT.ZERO) GOTO 140
6198 IF (PC0.GT.ZERO) THEN
6200 CALL HWULOF(PCL,PHEP(1,JCL),PHEP(1,JCL))
6201 CALL HWVSCA(3,PC0,PHEP(1,JCL),PHEP(1,JCL))
6202 PHEP(4,JCL)=SQRT(PC1**2+EM1**2)
6204 CALL HWULOB(PCL,PHEP(1,JCL),PHEP(1,JCL))
6205 CALL HWVDIF(4,PCL,PHEP(1,JCL),PHEP(1,LCL))
6207 ELSEIF (PC0.EQ.ZERO) THEN
6209 CALL HWDTWO(PCL,PHEP(1,JCL),PHEP(1,LCL),PC1,TWO,.TRUE.)
6212 CALL HWWARN('HWCFOR',102,*999)
6215 CALL HWWARN('HWCFOR',103,*999)
6218 C Non-partons labelled as partons (ie photons) should get copied
6220 IF (ISTHEP(IHEP).EQ.150) THEN
6225 IDHW(NHEP)=IDHW(IHEP)
6226 IDHEP(NHEP)=IDPDG(IDHW(IHEP))
6227 CALL HWVEQU(5,PHEP(1,IHEP),PHEP(1,NHEP))
6228 C--MHS FIX 07/03/05 - VERTEX SHOULD BE RELATIVE TO FIXED AXES
6229 CALL HWVSUM(4,VTXPIP,VHEP(1,IHEP),VHEP(1,NHEP))
6232 JMOHEP(2,NHEP)=JMOHEP(1,IHEP)
6239 *CMZ :- -13/07/92 20.15.54 by Mike Seymour
6240 *-- Author : Bryan Webber
6241 C-----------------------------------------------------------------------
6243 C-----------------------------------------------------------------------
6244 C SPLITS ANY TIMELIKE GLUONS REMAINING AFTER PERTURBATIVE
6245 C BRANCHING INTO LIGHT (I.E. U OR D) Q-QBAR PAIRS
6246 C-----------------------------------------------------------------------
6247 INCLUDE 'HERWIG65.INC'
6248 DOUBLE PRECISION HWRGEN,PF
6249 INTEGER HWRINT,IHEP,JHEP,KHEP,LHEP,MHEP,ID,J,IST
6250 EXTERNAL HWRGEN,HWRINT
6251 IF (NGSPL.EQ.0) CALL HWWARN('HWCGSP',400,*999)
6255 IF (ISTHEP(IHEP).GE.147.AND.ISTHEP(IHEP).LE.149) THEN
6261 IF (ISTHEP(JHEP).GE.147.AND.ISTHEP(JHEP).LE.149
6262 & .AND.JDAHEP(2,JHEP).LE.0) THEN
6268 IF (KHEP.EQ.0) CALL HWWARN('HWCGSP',102,*999)
6269 IF (KHEP.NE.1) CALL HWWARN('HWCGSP',103,*999)
6272 C---CHECK FOR DECAYED HEAVY ANTIQUARKS
6273 IF (ISTHEP(JHEP).EQ.155) THEN
6274 JHEP=JDAHEP(1,JDAHEP(2,JHEP))
6275 DO 10 J=JDAHEP(1,JHEP),JDAHEP(2,JHEP)
6276 10 IF (ISTHEP(J).EQ.149.AND.JDAHEP(2,J).EQ.0) GOTO 20
6277 CALL HWWARN('HWCGSP',100,*999)
6285 IF (ISTHEP(JHEP).GE.147.AND.ISTHEP(JHEP).LE.149
6286 & .AND.JMOHEP(2,JHEP).LE.0) THEN
6292 IF (KHEP.EQ.0) CALL HWWARN('HWCGSP',104,*999)
6293 IF (KHEP.NE.1) CALL HWWARN('HWCGSP',105,*999)
6297 C---CHECK FOR DECAYED HEAVY QUARKS
6298 IF (ISTHEP(KHEP).EQ.155) CALL HWWARN('HWCGSP',101,*999)
6299 IF (IDHW(IHEP).EQ.13) THEN
6303 IF(MHEP.GT.NMXHEP) CALL HWWARN('HWCGSP',106,*999)
6304 30 ID=HWRINT(1,NGSPL)
6305 IF (PGSPL(ID).LT.PGSMX*HWRGEN(0)) GOTO 30
6306 PHEP(5,LHEP)=RMASS(ID)
6307 PHEP(5,MHEP)=RMASS(ID)
6308 C---ASSUME ISOTROPIC ANGULAR DISTRIBUTION
6309 IF (PHEP(5,IHEP).GT.PHEP(5,LHEP)+PHEP(5,MHEP)) THEN
6310 CALL HWDTWO(PHEP(1,IHEP),PHEP(1,LHEP),
6311 & PHEP(1,MHEP),PGSPL(ID),TWO,.TRUE.)
6314 CALL HWVSCA(4,PF,PHEP(1,IHEP),PHEP(1,LHEP))
6315 CALL HWVDIF(4,PHEP(1,IHEP),PHEP(1,LHEP),PHEP(1,MHEP))
6316 PHEP(5,LHEP)=PF*PHEP(5,IHEP)
6317 PHEP(5,MHEP)=PHEP(5,IHEP)-PHEP(5,LHEP)
6319 CALL HWUDKL(13,PHEP(1,IHEP),VHEP(1,LHEP))
6320 CALL HWVSUM(4,VHEP(1,IHEP),VHEP(1,LHEP),VHEP(1,LHEP))
6321 CALL HWVEQU(4,VHEP(1,LHEP),VHEP(1,MHEP))
6324 IDHEP(MHEP)= IDPDG(ID)
6325 IDHEP(LHEP)=-IDPDG(ID)
6329 C---NEW COLOUR CONNECTIONS
6330 IF(RPARTY.OR.JMOHEP(2,KHEP).EQ.IHEP) JMOHEP(2,KHEP)=LHEP
6331 IF(RPARTY.OR.JDAHEP(2,JHEP).EQ.IHEP) JDAHEP(2,JHEP)=MHEP
6332 JMOHEP(1,LHEP)=JMOHEP(1,IHEP)
6334 JMOHEP(1,MHEP)=JMOHEP(1,IHEP)
6343 C---COPY A NON-GLUON
6346 IF(MHEP.GT.NMXHEP) CALL HWWARN('HWCGSP',107,*999)
6347 CALL HWVEQU(5,PHEP(1,IHEP),PHEP(1,MHEP))
6348 CALL HWVEQU(4,VHEP(1,IHEP),VHEP(1,MHEP))
6349 IDHW(MHEP)=IDHW(IHEP)
6350 IDHEP(MHEP)=IDHEP(IHEP)
6353 IF (IST.EQ.149) THEN
6358 C---NEW COLOUR CONNECTIONS
6359 IF(RPARTY.OR.JMOHEP(2,KHEP).EQ.IHEP)
6360 & JMOHEP(2,KHEP)=MHEP
6361 IF(RPARTY.OR.(JHEP.NE.IHEP.AND.JDAHEP(2,JHEP).EQ.IHEP))
6362 & JDAHEP(2,JHEP)=MHEP
6363 JMOHEP(1,MHEP)=JMOHEP(1,IHEP)
6364 JMOHEP(2,MHEP)=JMOHEP(2,IHEP)
6366 JDAHEP(2,MHEP)=JDAHEP(2,IHEP)
6374 *CMZ :- -26/04/91 14.00.57 by Federico Carminati
6375 *-- Author : Bryan Webber
6376 C-----------------------------------------------------------------------
6377 SUBROUTINE HWCHAD(JCL,ID1,ID3,ID2)
6378 C-----------------------------------------------------------------------
6379 C HADRONIZES CLUSTER JCL, CONSISTING OF PARTONS ID1,ID3
6380 C ID2 RETURNS PARTON-ANTIPARTON PAIR CREATED
6381 C (IN SPECIAL CLUSTER CODE - SEE HWCFLA)
6383 C MODIFIED 15/11/99 TO SMEAR POSITIONS OF HADRONS BY 1/(CLUSTER MASS)
6384 C-----------------------------------------------------------------------
6385 INCLUDE 'HERWIG65.INC'
6386 DOUBLE PRECISION HWRGEN,HWRGAU,HWVDOT,EM0,EM1,EM2,EMADU,EMSQ,
6387 & PCMAX,PCM,PTEST,PCQK,PP(5),EMLOW,RMAT(3,3),CT,ST,CX,SX,HPSMR
6388 INTEGER HWRINT,JCL,ID1,ID2,ID3,ID,IR1,IR2,NTRY,IDMIN,IMAX,I,MHEP,
6391 EXTERNAL HWRGEN,HWRINT
6392 DIQK(ID)=ID.GT.3.AND.ID.LT.10
6393 IF (IERROR.NE.0) RETURN
6396 IF (LOCN(ID1,ID3).LE.0) CALL HWWARN('HWCHAD',104,*999)
6397 IR1=NCLDK(LOCN(ID1,ID3))
6399 IF (ABS(EM0-EM1).LT.0.001) THEN
6400 C---SINGLE-HADRON CLUSTER
6402 IF (NHEP.GT.NMXHEP) CALL HWWARN('HWCHAD',100,*999)
6404 IDHEP(NHEP)=IDPDG(IR1)
6408 CALL HWVEQU(5,PHEP(1,JCL),PHEP(1,NHEP))
6409 CALL HWVSUM(4,VHEP(1,JCL),VTXPIP,VHEP(1,NHEP))
6413 EMLOW=RMIN(ID1,1)+RMIN(1,ID3)
6414 EMADU=RMIN(ID1,2)+RMIN(2,ID3)
6415 IF (EMADU.LT.EMLOW) THEN
6421 IF (PCMAX.GE.ZERO) THEN
6422 C---SET UP TWO QUARK-ANTIQUARK PAIRS OR A
6423 C QUARK-DIQUARK AND AN ANTIDIQUARK-ANTIQUARK
6424 PCMAX=PCMAX*(EMSQ-(RMIN(ID1,IDMIN)-RMIN(IDMIN,ID3))**2)
6426 IF (DIQK(ID1).OR.DIQK(ID3)) IMAX=3
6428 IF (EM0.LT.RMIN(ID1,I)+RMIN(I,ID3)) GOTO 20
6431 20 ID2=HWRINT(1,I-1)
6432 IF (PWT(ID2).NE.ONE) THEN
6433 IF (PWT(ID2).LT.HWRGEN(1)) GOTO 20
6435 C---PICK TWO PARTICLES WITH THESE QUANTUM NUMBERS
6437 30 IR1=LOCN(ID1,ID2)+INT(RESN(ID1,ID2)*HWRGEN(2))
6438 IF (CLDKWT(IR1).LT.HWRGEN(3)) GOTO 30
6440 40 IR2=LOCN(ID2,ID3)+INT(RESN(ID2,ID3)*HWRGEN(4))
6441 IF (CLDKWT(IR2).LT.HWRGEN(5)) GOTO 40
6445 PCM=EMSQ-(EM1+EM2)**2
6446 IF (PCM.GT.ZERO) GOTO 70
6447 50 IF (NTRY.LE.NDTRY) GOTO 20
6448 C---CAN'T FIND A DECAY MODE - CHOOSE LIGHTEST
6450 IR1=NCLDK(LOCN(ID1,ID2))
6451 IR2=NCLDK(LOCN(ID2,ID3))
6454 PCM=EMSQ-(EM1+EM2)**2
6455 IF (PCM.GT.ZERO) GOTO 70
6457 IF (NTRY.LE.NDTRY+50) GOTO 60
6458 CALL HWWARN('HWCHAD',101,*999)
6459 C---DECAY IS ALLOWED
6460 70 PCM=PCM*(EMSQ-(EM1-EM2)**2)
6461 IF (NTRY.GT.NCTRY) GOTO 80
6462 PTEST=PCM*SWTEF(IR1)*SWTEF(IR2)
6463 IF (PTEST.LT.PCMAX*HWRGEN(0)**2) GOTO 20
6465 C---ALLOW DECAY BY PI0 EMISSION IF ONLY POSSIBILITY
6467 IR2=NCLDK(LOCN(1,1))
6469 PCM=(EMSQ-(EM1+EM2)**2)*(EMSQ-(EM1-EM2)**2)
6471 C---DECAY IS CHOSEN. GENERATE DECAY MOMENTA
6472 C AND PUT PARTICLES IN /HEPEVT/
6473 80 IF (PCM.LT.ZERO) CALL HWWARN('HWCHAD',102,*999)
6474 PCM=0.5*SQRT(PCM)/EM0
6477 IF (NHEP.GT.NMXHEP) CALL HWWARN('HWCHAD',103,*999)
6480 C Decide if cluster contains a b-(anti)quark or not
6481 IF (ID1.EQ.11.OR.ID2.EQ.11.OR.ID3.EQ.11) THEN
6486 IF (CLDIR(IB).NE.0) THEN
6489 IF (JM.EQ.0) GOTO 110
6490 IF (ISTHEP(JM).NE.158) GOTO 110
6491 C LOOK FOR PARENT PARTON
6492 DO 100 KM=JMOHEP(1,JM)+1,JM
6493 IF (ISTHEP(KM).EQ.2) THEN
6494 IF (JDAHEP(1,KM).EQ.JM) THEN
6495 C FOUND PARENT PARTON
6496 IF (IDHW(KM).NE.13) THEN
6497 C FIND ITS DIRECTION IN CLUSTER CMF
6498 CALL HWULOF(PHEP(1,JCL),PHEP(1,KM),PP)
6499 PCQK=PP(1)**2+PP(2)**2+PP(3)**2
6500 IF (PCQK.GT.ZERO) THEN
6502 IF (CLSMR(IB).GT.ZERO) THEN
6503 C DO GAUSSIAN SMEARING OF DIRECTION
6504 90 CT=ONE+CLSMR(IB)*LOG(HWRGEN(0))
6505 IF (CT.LT.-ONE) GOTO 90
6507 IF (ST.GT.ZERO) ST=SQRT(ST)
6508 CALL HWRAZM( ONE,CX,SX)
6509 CALL HWUROT(PP,CX,SX,RMAT)
6513 CALL HWUROB(RMAT,PP,PP)
6516 IF (IM.EQ.2) PCQK=-PCQK
6517 CALL HWVSCA(3,PCQK,PP,PHEP(1,MHEP))
6518 PHEP(4,MHEP)=SQRT(PHEP(5,MHEP)**2+PCM**2)
6519 CALL HWULOB(PHEP(1,JCL),PHEP(1,MHEP),PHEP(1,MHEP))
6520 CALL HWVDIF(4,PHEP(1,JCL),PHEP(1,MHEP),PHEP(1,NHEP))
6526 ELSEIF (ISTHEP(KM).GT.140) THEN
6533 120 CALL HWDTWO(PHEP(1,JCL),PHEP(1,MHEP),PHEP(1,NHEP),
6537 IDHEP(MHEP)=IDPDG(IR1)
6538 IDHEP(NHEP)=IDPDG(IR2)
6542 C---SECOND MOTHER OF HADRON IS JET
6543 JMOHEP(2,MHEP)=JMOHEP(1,JMOHEP(1,JCL))
6546 C---SMEAR HADRON POSITIONS
6547 HPSMR=GEV2MM/PHEP(5,JCL)
6549 VHEP(I,MHEP)=HWRGAU(I,ZERO,HPSMR)
6551 VHEP(4,MHEP)=ABS(VHEP(4,MHEP))
6552 & +SQRT(HWVDOT(3,VHEP(1,MHEP),VHEP(1,MHEP)))
6553 CALL HWULB4(PHEP(1,JCL),VHEP(1,MHEP),VHEP(1,MHEP))
6554 CALL HWVSUM(4,VHEP(1,JCL),VHEP(1,MHEP),VHEP(1,MHEP))
6555 CALL HWVSUM(4,VTXPIP,VHEP(1,MHEP),VHEP(1,MHEP))
6557 VHEP(I,NHEP)=HWRGAU(I,ZERO,HPSMR)
6559 VHEP(4,NHEP)=ABS(VHEP(4,NHEP))
6560 & +SQRT(HWVDOT(3,VHEP(1,NHEP),VHEP(1,NHEP)))
6561 CALL HWULB4(PHEP(1,JCL),VHEP(1,NHEP),VHEP(1,NHEP))
6562 CALL HWVSUM(4,VHEP(1,JCL),VHEP(1,NHEP),VHEP(1,NHEP))
6563 CALL HWVSUM(4,VTXPIP,VHEP(1,NHEP),VHEP(1,NHEP))
6565 ISTHEP(JCL)=180+MOD(ISTHEP(JCL),10)
6567 JMOHEP(2,NHEP)=JMOHEP(1,JMOHEP(1,JCL))
6570 *CMZ :- -09/04/02 13:37:38 by Peter Richardson
6571 *-- Author : Peter Richardson
6572 C-----------------------------------------------------------------------
6573 SUBROUTINE HWD2ME(IMODE)
6574 C-----------------------------------------------------------------------
6575 C Computes the width and maximum weight for a two body mode
6576 C-----------------------------------------------------------------------
6577 INCLUDE 'HERWIG65.INC'
6579 DOUBLE PRECISION A(2),M(3),PCM,E1,E2,HWUPCM,PHS,WGT,MWGT,PCM2,
6583 E = SQRT(FOUR*PIFAC/128.0D0)
6585 C--set up the masses and couplings
6586 M(1) = RMASS(IDK(ID2PRT(IMODE)))
6588 A(I) = A2MODE(I,IMODE)
6589 1 M(I+1) = RMASS(IDKPRD(I,ID2PRT(IMODE)))
6592 C--first compute the masses etc
6593 PCM = HWUPCM(M(1),M(2),M(3))
6595 PHS = PCM/M2(1)/8.0D0/PIFAC
6596 C--now compute the width and max weight
6597 C--first the fermion --> fermion scalar diagrams
6598 IF(I2DRTP(IMODE).EQ.1) THEN
6599 WGT = HALF*((A(1)**2+A(2)**2)*(M2(1)+M2(2)-M2(3))
6600 & +FOUR*A(1)*A(2)*M(1)*M(2))
6601 E1 = SQRT(M2(2)+PCM2)
6602 E2 = SQRT(M2(3)+PCM2)
6603 MWGT = HALF*M2(1)/(E1+E2)*(E1+PCM)*ABS(A(1)**2-A(2)**2)+WGT
6604 C--next the fermion --> scalar fermion diagrams
6605 ELSEIF(I2DRTP(IMODE).EQ.2) THEN
6606 WGT = HALF*((A(1)**2+A(2)**2)*(M2(1)+M2(3)-M2(2))
6607 & +FOUR*A(1)*A(2)*M(1)*M(3))
6608 E1 = SQRT(M2(2)+PCM2)
6609 E2 = SQRT(M2(3)+PCM2)
6610 MWGT = HALF*M2(1)/(E1+E2)*(E2+PCM)*ABS(A(1)**2-A(2)**2)+WGT
6611 C--next the fermion --> scalar antifermion diagrams
6612 ELSEIF(I2DRTP(IMODE).EQ.3) THEN
6613 WGT = HALF*((A(1)**2+A(2)**2)*(M2(1)+M2(3)-M2(2))
6614 & +FOUR*A(1)*A(2)*M(1)*M(3))
6615 E1 = SQRT(M2(2)+PCM2)
6616 E2 = SQRT(M2(3)+PCM2)
6617 MWGT = HALF*M2(1)/(E1+E2)*(E2+PCM)*ABS(A(1)**2-A(2)**2)+WGT
6618 C--next the fermion --> fermion gauge boson diagrams
6619 ELSEIF(I2DRTP(IMODE).EQ.4) THEN
6620 WGT = 2.0D0*(M2(1)-M2(2))**2
6622 C--next the scalar --> fermion antifermion diagrams
6623 ELSEIF(I2DRTP(IMODE).EQ.5) THEN
6624 WGT = (M2(1)-M2(2)-M2(3))*(A(1)**2+A(2)**2)
6625 & -FOUR*M(2)*M(3)*A(1)*A(2)
6627 C--next the scalar --> fermion fermion diagrams
6628 ELSEIF(I2DRTP(IMODE).EQ.6) THEN
6629 WGT = (M2(1)-M2(2)-M2(3))*(A(1)**2+A(2)**2)
6630 & -FOUR*M(2)*M(3)*A(1)*A(2)
6632 C--next the fermion --> fermion pion diagrams
6633 ELSEIF(I2DRTP(IMODE).EQ.7) THEN
6634 WGT = HALF/FOUR/RMASS(198)**4*(
6635 & (A(1)**2+A(2)**2)*((M2(1)-M2(2))**2-M2(3)*(M2(1)+M2(2)))
6636 & +FOUR*M(1)*M(2)*M2(3)*A(1)*A(2))
6637 E1 = SQRT(M2(2)+PCM2)
6638 E2 = SQRT(M2(3)+PCM2)
6639 MWGT =ONE/8.0D0/RMASS(198)**4*ABS(A(1)**2-A(2)**2)*
6640 & M(1)*(M(1)*M2(3)+(M2(1)-M2(2)+M2(3))*(E2+PCM))+WGT
6641 C--next scalar --> antifermion fermion diagrams
6642 ELSEIF(I2DRTP(IMODE).EQ.8) THEN
6643 WGT = (M2(1)-M2(2)-M2(3))*(A(1)**2+A(2)**2)
6644 & -FOUR*M(2)*M(3)*A(1)*A(2)
6646 C--next fermion --> gravitino photon
6647 ELSEIF(I2DRTP(IMODE).EQ.9) THEN
6648 WGT = 8.0D0*M2(1)**3
6650 C--next fermion --> gravitino scalar
6651 ELSEIF(I2DRTP(IMODE).EQ.10) THEN
6652 WGT = HALF*(M2(1)-M2(3))**3
6653 E1 = SQRT(M2(2)+PCM2)
6654 E2 = SQRT(M2(3)+PCM2)
6655 MWGT = TWO*M2(1)/(E1+E2)*(E1+PCM)*(M2(1)-M2(3))**2 +WGT
6656 C--next sfermion --> fermion gravitino
6657 ELSEIF(I2DRTP(IMODE).EQ.11) THEN
6658 WGT = (M2(1)-M2(2))**3
6660 C--next antisfermion --> fermion gravitino
6661 ELSEIF(I2DRTP(IMODE).EQ.12) THEN
6662 WGT = (M2(1)-M2(2))**3
6664 C--next the scalar --> antifermion antifermion diagrams
6665 ELSEIF(I2DRTP(IMODE).EQ.13) THEN
6666 WGT = (M2(1)-M2(2)-M2(3))*(A(1)**2+A(2)**2)
6667 & -FOUR*M(2)*M(3)*A(1)*A(2)
6669 C--next the antifermion --> scalar antifermion diagrams
6670 ELSEIF(I2DRTP(IMODE).EQ.14) THEN
6671 WGT = HALF*((A(1)**2+A(2)**2)*(M2(1)+M2(3)-M2(2))
6672 & +FOUR*A(1)*A(2)*M(1)*M(3))
6673 E1 = SQRT(M2(2)+PCM2)
6674 E2 = SQRT(M2(3)+PCM2)
6675 MWGT = HALF*M2(1)/(E1+E2)*(E2+PCM)*ABS(A(1)**2-A(2)**2)+WGT
6676 C--unrecognised issue warning
6678 CALL HWWARN('HWITWO',500,*999)
6680 WGT = P2MODE(IMODE)* WGT*PHS
6681 MWGT = 1.1D0*P2MODE(IMODE)*MWGT*PHS
6682 C--put the information in the common block
6683 WT2MAX(IMODE) = MWGT
6684 C--output the information
6685 IF(IPRINT.EQ.2) THEN
6688 WRITE(*,3030) WGT/HBAR/BRFRAC(ID2PRT(IMODE))*
6689 & RLTIM(IDK(ID2PRT(IMODE)))
6692 C--format statements
6693 3010 FORMAT(' PARTIAL WIDTH = ',G12.4)
6694 3020 FORMAT(' MAXIMUM WEIGHT = ',E12.4)
6695 3030 FORMAT(' RATIO TO ISAJET VALUE = ',G12.4)
6698 *CMZ :- -20/10/99 09:46:43 by Peter Richardson
6699 *-- Author : Peter Richardson
6700 C-----------------------------------------------------------------------
6701 SUBROUTINE HWD3ME(ID,ITYPE,IMODE,RHOIN,IDSPIN)
6702 C-----------------------------------------------------------------------
6703 C Subroutine to perform the three body decays for spin correlations
6704 C and SUSY three body modes
6705 C-----------------------------------------------------------------------
6706 INCLUDE 'HERWIG65.INC'
6707 INTEGER IMODE,I,J,ID,IDP(4+NDIAGR),ITYPE,NDIA,ID1,ID2,
6708 & DRTYPE(NDIAGR),NTRY,IDSPIN,NCTHRE,DRCF(NDIAGR)
6709 DOUBLE PRECISION A,B,MS,MWD,MA,MB,MA2,MB2,WGT,M342,HWRUNI,
6710 & HWUPCM,M232,M242,WMAX,WSUM,WSSUM,MR,PRE,TEMP,HWRGEN,WTMAX,
6711 & BRW(6),BRZ(12),P(5,4),PM(5,4),WGTM,CFTHRE(NCFMAX,NCFMAX)
6712 DOUBLE COMPLEX S,D,RHOIN(2,2),F0(2,2,8),F3(2,2,8),F1(2,2,8),
6713 & F2(2,2,8),F0M(2,2,8),F1M(2,2,8),F01(2,2,8,8)
6714 EXTERNAL HWRUNI,HWUPCM,HWRGEN
6715 COMMON/HWHEWS/S(8,8,2),D(8,8)
6716 COMMON/HWD3BY/F0,F0M,F1M,F1,F2,F3,F01,A(2,NDIAGR),B(2,NDIAGR),
6717 & MS(NDIAGR),MWD(NDIAGR),MR(NDIAGR),MA(4),MA2(4),MB(4),MB2(4),
6718 & M342,M232,M242,P,PM,CFTHRE,IDP,DRTYPE,NCTHRE,DRCF
6719 DATA BRW/0.321D0,0.321D0,0.000D0,0.108D0,0.108D0,0.108D0/
6720 DATA BRZ/0.154D0,0.120D0,0.154D0,0.120D0,0.152D0,0.000D0,
6721 & 0.033D0,0.067D0,0.033D0,0.067D0,0.033D0,0.067D0/
6722 C--compute the masses of external particles for the decay mode
6723 C--first for true three body decay modes
6725 C--initalisation for the diagrams
6726 WTMAX = WT3MAX(IMODE)
6728 NCTHRE = N3NCFL(IMODE)
6729 NDIA = NDI3BY(IMODE)
6730 IDP(1) = IDK(ID3PRT(IMODE))
6732 1 IDP(I+1) = IDKPRD(I,ID3PRT(IMODE))
6735 2 CFTHRE(I,J) = SPN3CF(I,J,IMODE)
6736 C--enter the couplings for the diagrams
6737 DO 3 I=1,NDI3BY(IMODE)
6738 DRTYPE(I) = I3DRTP(I,IMODE)
6739 DRCF (I) = I3DRCF(I,IMODE)
6741 A(J,I) = A3MODE(J,I,IMODE)
6742 3 B(J,I) = B3MODE(J,I,IMODE)
6743 C--enter the intermediate masses for the diagrams
6744 DO 4 I=1,NDI3BY(IMODE)
6745 IDP(I+4) = I3MODE(I,IMODE)
6746 MR(I) = RMASS(I3MODE(I,IMODE))
6748 IF(I3MODE(I,IMODE).GT.200) THEN
6749 MWD(I) = RMASS(I3MODE(I,IMODE))*HBAR/RLTIM(I3MODE(I,IMODE))
6750 ELSEIF(I3MODE(I,IMODE).EQ.200) THEN
6751 MWD(I) = RMASS(200)*GAMZ
6752 ELSEIF(I3MODE(I,IMODE).EQ.198.OR.I3MODE(I,IMODE).EQ.199) THEN
6753 MWD(I) = RMASS(198)*GAMW
6754 ELSEIF(I3MODE(I,IMODE).EQ.59) THEN
6758 C--reorder for top quark decay modes(b first then W products)
6759 IF(IDP(1).EQ.6.OR.IDP(1).EQ.12) THEN
6765 C--reorder if fermion not first
6766 IF(IDP(3).GT.IDP(4).AND.((IDP(1).EQ.6.OR.IDP(1).EQ.12).OR.
6767 & IDP(2).GE.400)) THEN
6772 C--then for two body modes to gauge bosons including boson decays
6774 C--initalisation for the diagram
6775 WTMAX = WTBMAX(ITYPE,IMODE)
6777 PRE = PBMODE(ITYPE,IMODE)
6778 DRTYPE(1) = IBDRTP(IMODE)
6782 C--particles in decay
6783 IDP(1) = IDK(IDBPRT(IMODE))
6784 IDP(2) = IDKPRD(1,IDBPRT(IMODE))
6785 IF(IDP(2).GE.198.AND.IDP(2).LE.200)
6786 & IDP(2) = IDKPRD(2,IDBPRT(IMODE))
6787 IDP(5) = IBMODE(IMODE)
6788 C--masses of virtual particles and couplings
6789 MR(1) = RMASS(IBMODE(IMODE))
6792 A(J,1) = ABMODE(J,IMODE)
6793 B(J,1) = BBMODE(J,ITYPE,IMODE)
6795 IF(IBMODE(IMODE).EQ.200) THEN
6796 MWD(1) = RMASS(200)*GAMZ
6798 MWD(1) = RMASS(198)*GAMW
6800 C--particles from boson decay
6801 IF(IBMODE(IMODE).EQ.200) THEN
6803 IF(ITYPE.GT.6) ID1 = ID1+114
6807 IF(ITYPE.GT.3) ID1 = ID1+114
6809 IF(IBMODE(IMODE).EQ.198) THEN
6817 C--only do the decay if possible for an on-shell boson
6818 IF(RMASS(ID1)+RMASS(ID2).GT.MR(1)) RETURN
6819 IF(IPRINT.EQ.2.AND..NOT.GENEV)
6820 & WRITE(6,3000) RNAME(IDP(5)),RNAME(IDP(3)),RNAME(IDP(4))
6821 MA(3) = RMASS(IDP(3))
6822 MA(4) = RMASS(IDP(4))
6826 C--set up the masses MA OFF SHELL MB ON SHELL
6828 MB(I) = RMASS(IDP(I))
6835 IF(MA(1).LT.MA(2)+MA(3)+MA(4)) RETURN
6836 C--compute the width and maximum weight if initialising
6838 C--search for maximum weight
6843 CALL HWD3M0(1,NDIA,WGT,WGTM,RHOIN,IDSPIN)
6846 IF(WGTM.GT.WMAX) WMAX = WGTM
6848 WSSUM = WSSUM+WGT**2
6849 IF(WGT.LT.ZERO) CALL HWWARN('HWD3ME',500,*999)
6851 C--compute width and maximum weight
6852 WSUM = WSUM/DBLE(NSEARCH)
6853 WSSUM = MAX(ZERO,WSSUM/DBLE(NSEARCH)-WSUM**2)
6854 WSSUM = SQRT(WSSUM/DBLE(NSEARCH))
6855 C--if required output results
6856 IF(IPRINT.EQ.2) THEN
6857 WRITE(6,3010) WSUM,WSSUM
6860 TEMP = BRFRAC(ID3PRT(IMODE))*HBAR/RLTIM(IDK(ID3PRT(IMODE)))
6862 IF(IBMODE(IMODE).EQ.200) THEN
6863 TEMP = BRFRAC(IDBPRT(IMODE))*HBAR/
6864 & RLTIM(IDK(IDBPRT(IMODE)))*BRZ(ITYPE)
6866 TEMP = BRFRAC(IDBPRT(IMODE))*HBAR/
6867 & RLTIM(IDK(IDBPRT(IMODE)))*BRW(ITYPE)
6870 WRITE(6,3030) WSUM/TEMP,WSSUM/TEMP
6872 C--set up the maximum weight
6874 WT3MAX(IMODE) = 1.1D0*WMAX
6876 WTBMAX(ITYPE,IMODE) = 1.1D0*WMAX
6878 C--if not initialising generate the momenta
6880 C--generate a configuation
6883 CALL HWD3M0(ID,NDIA,WGT,WGTM,RHOIN,IDSPIN)
6885 C--check maximum isn't violated, increase and issue warning if it is
6886 IF(WGT.GT.WTMAX) THEN
6887 CALL HWWARN('HWD3ME',1,*50)
6889 WRITE(6,3040) RNAME(IDP(1)),RNAME(IDP(2)),RNAME(IDP(3)),
6890 & RNAME(IDP(4)),WTMAX,WGT*1.1D0
6892 WRITE(6,3050) RNAME(IDP(1)),RNAME(IDP(2)),RNAME(IDP(5))
6893 WRITE(6,3060) RNAME(IDP(5)),RNAME(IDP(3)),RNAME(IDP(4)),
6898 WT3MAX(IMODE) = WTMAX
6900 WTBMAX(ITYPE,IMODE) = WTMAX
6903 50 IF(HWRGEN(0)*WTMAX.GT.WGT.AND.NTRY.LT.NSNTRY) GOTO 100
6904 IF(NTRY.GE.NSNTRY) CALL HWWARN('HWD3ME',100,*999)
6907 C--format statements for the outputs
6908 3000 FORMAT(/' FOLLOWED BY ',A8,' --> ',A8,' ',A8)
6909 3010 FORMAT(' PARTIAL WIDTH = ',G12.4,' +/- ',G12.4)
6910 3020 FORMAT(' MAXIMUM WEIGHT = ',E12.4)
6911 3030 FORMAT(' RATIO TO ISAJET VALUE = ',G12.4,' +/- ',G12.4)
6912 3040 FORMAT(/'WEIGHT FOR DECAY ',A8,' --> ',A8,' ',A8,' ',A8,
6914 & /10X,' MAXIMUM WEIGHT =',1PG24.16,
6915 & /10X,'NEW MAXIMUM WEIGHT =',1PG24.16)
6916 3050 FORMAT(/'WEIGHT FOR DECAY ',A8,' --> ',A8,' ',A8)
6917 3060 FORMAT(/' FOLLOWED BY ',A8,' --> ',A8,' ',A8,' EXCEEDS MAX',
6918 & /10X,' MAXIMUM WEIGHT =',1PG24.16,
6919 & /10X,'NEW MAXIMUM WEIGHT =',1PG24.16)
6922 *CMZ :- -09/04/02 13:46:07 by Peter Richardson
6923 *-- Author : Peter Richardson
6924 C-----------------------------------------------------------------------
6925 SUBROUTINE HWD3M0(ID,NDIA,WGT,MWGT,RHOIN,IDSPIN)
6926 C-----------------------------------------------------------------------
6927 C Subroutine to calculate the matrix element for a given mode
6928 C-----------------------------------------------------------------------
6929 INCLUDE 'HERWIG65.INC'
6930 INTEGER I,J,P0,P1,P2,P3,P0P,IB,ID,IDP(4+NDIAGR),IDSPIN,NDIA,
6931 & DRTYPE(NDIAGR),NCTHRE,DRCF(NDIAGR)
6932 DOUBLE PRECISION A,B,MS,MWD,MA,MB,MA2,MB2,WGT,FJAC,M342,HWRUNI,
6933 & M34,PCMA,PCMB,HWUPCM,PHS,N(3),HWVDOT,PP,HWULDO,EPS,PTMP(5),
6934 & M232,M242,PRE,PLAB,PRW,XMASS,PCM,P(5,4),PM(5,4),MR,PREF(5),
6935 & MMIN,MMAX,MWGT,CFTHRE(NCFMAX,NCFMAX),WGTB(NCFMAX),WGTC,
6937 DOUBLE COMPLEX S,D,ME(2,2,2,2,NCFMAX),MED(2,2,2,2),F01(2,2,8,8),
6938 & RHOIN(2,2),F0(2,2,8),F1(2,2,8),F2(2,2,8),F0M(2,2,8),
6939 & RHOB(2,2),F1M(2,2,8),F3(2,2,8)
6940 EXTERNAL HWRUNI,HWUPCM,HWVDOT,HWULDO,HWRGEN
6941 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
6942 COMMON/HWD3BY/F0,F0M,F1M,F1,F2,F3,F01,A(2,NDIAGR),B(2,NDIAGR),
6943 & MS(NDIAGR),MWD(NDIAGR),MR(NDIAGR),MA(4),MA2(4),MB(4),MB2(4),
6944 & M342,M232,M242,P,PM,CFTHRE,IDP,DRTYPE,NCTHRE,DRCF
6945 DATA PREF/1.0D0,0.0D0,0.0D0,1.0D0,0.0D0/
6946 COMMON/HWHEWS/S(8,8,2),D(8,8)
6947 PARAMETER(EPS=1D-10)
6948 C--select the momenta of the particles
6949 C--first see if there is a boson mode
6952 IF(DRTYPE(I).EQ.1.OR.DRTYPE(I).EQ.5.OR.DRTYPE(I).EQ.6.OR.
6953 & DRTYPE(I).EQ.7) IB = IDP(I+4)
6955 C--compute the mass of the 34 subsystem flat if no boson otherwise Breit-Wigner
6956 MMIN = (MA(3)+MA(4))**2
6957 MMAX = (MA(1)-MA(2))**2
6958 IF(IB.GT.0.AND.IB.NE.59) THEN
6959 CALL HWHGB1(1,2,IB,FJAC,M342,MMAX,MMIN)
6960 ELSEIF(IB.EQ.59) THEN
6961 M342 = HWRUNI(1,LOG(MMIN),LOG(MMAX))
6963 FJAC = (LOG(MMAX)-LOG(MMIN))*M342
6964 ELSEIF((DRTYPE(1).EQ.2.OR.DRTYPE(1).EQ.17).AND.
6965 & IDP(5).EQ.206.OR.IDP(5).EQ.207) THEN
6966 A02 = ATAN((MMIN-MS(1))/MWD(1))
6967 A2 = ATAN((MMAX-MS(1))/MWD(1))-A02
6968 M342 = MS(1)+MWD(1)*TAN(A02+A2*HWRGEN(1))
6969 FJAC = A2*((M342-MS(1))**2+MWD(1)**2)/MWD(1)
6972 M342 = HWRUNI(1,MMIN,MMAX)
6975 FJAC = HALF*FJAC/M34
6976 C--copy the momentum of the decaying particle into the internal common block
6977 CALL HWVEQU(5,PHEP(1,ID),P(1,1))
6980 C--perform the decay 1---> 2+34
6981 PCMA = HWUPCM(MA(1),MA(2),M34)
6983 CALL HWDTWO(P(1,1),PLAB(1,1),P(1,2),PCMA,2.0D0,.TRUE.)
6984 C--perform the decay 34 --> 3+4
6985 PCMB = HWUPCM(M34,MA(3),MA(4))
6986 CALL HWDTWO(PLAB(1,1),P(1,3),P(1,4),PCMB,2.0D0,.TRUE.)
6987 C--compute the phase sapce factors
6988 PHS = PCMA*PCMB*FJAC/32.0D0/PIFAC**3/MA2(1)
6989 C--compute the other possible masses for the propagator
6990 M232 = MA2(2)+MA2(3)+TWO*HWULDO(P(1,2),P(1,3))
6991 M242 = MA2(2)+MA2(4)+TWO*HWULDO(P(1,2),P(1,4))
6992 C--compute the vectors for the helicity amplitudes
6994 C--compute the references vectors
6995 C--not important if SM particle which can't have spin measured
6996 C--ie anything other the top and tau
6997 C--also not important if particle is approx massless
6998 C--first the SM particles other than top and tau
6999 IF(IDP(I).LT.400.AND.(IDP(I).NE.6.AND.IDP(I).NE.12
7000 & .AND.IDP(I).NE.125.AND.IDP(I).NE.131)) THEN
7001 CALL HWVEQU(5,PREF,PLAB(1,I+4))
7002 C--all other particles
7004 PP = SQRT(HWVDOT(3,P(1,I),P(1,I)))
7005 CALL HWVSCA(3,ONE/PP,P(1,I),N)
7006 PLAB(4,I+4) = HALF*(P(4,I)-PP)
7007 PP = HALF*(PP-MA(I)-PP**2/(MA(I)+P(4,I)))
7008 CALL HWVSCA(3,PP,N,PLAB(1,I+4))
7009 CALL HWUMAS(PLAB(1,I+4))
7010 PP = HWVDOT(3,PLAB(1,I+4),PLAB(1,I+4))
7011 C--fix to avoid problems if approx massless due to energy
7012 IF(PP.LT.EPS) CALL HWVEQU(5,PREF,PLAB(1,I+4))
7014 C--now the massless vectors
7015 PP = HALF*MA2(I)/HWULDO(PLAB(1,I+4),P(1,I))
7017 4 PLAB(J,I) = P(J,I)-PP*PLAB(J,I+4)
7018 3 CALL HWUMAS(PLAB(1,I))
7019 C--change order of momenta for call to HE code
7031 6 PCM(5,I)=PLAB(5,I)
7032 C--compute the S functions
7033 CALL HWHEW2(8,PCM(1,1),S(1,1,2),S(1,1,1),D)
7036 S(I,J,2) = -S(I,J,2)
7037 7 D(I,J) = TWO*D(I,J)
7038 C--compute the F functions
7039 CALL HWVSUM(5,PM(1,1),PM(1,2),PTMP)
7041 CALL HWH2F2(8,F0 ,5,PM(1,1), MA(1))
7042 CALL HWH2F1(8,F1 ,6,PM(1,2), MA(2))
7043 CALL HWH2F1(8,F2 ,7,PM(1,3), MA(3))
7044 CALL HWH2F1(8,F3 ,8,PM(1,4), MA(4))
7045 CALL HWH2F1(8,F0M,5,PM(1,1),-MA(1))
7046 CALL HWH2F2(8,F1M,6,PM(1,2),-MA(2))
7047 CALL HWH2F3(8,F01,PTMP,ZERO)
7048 C--now find the prefactor for all the diagrams
7049 PRE = HWULDO(PCM(1,5),PM(1,1))*HWULDO(PCM(1,6),PM(1,2))*
7050 & HWULDO(PCM(1,7),PM(1,3))*HWULDO(PCM(1,8),PM(1,4))
7052 C--zero the matrix element
7058 8 ME(P0,P1,P2,P3,I) = (0.0D0,0.0D0)
7059 C--now call the subroutines to compute the individual diagrams
7061 C--vector boson exchange diagram
7062 IF(DRTYPE(I).EQ.1) THEN
7064 C--Higgs boson exchange diagram
7065 ELSEIF(DRTYPE(I).EQ.2) THEN
7067 C--antisfermion exchange diagram
7068 ELSEIF(DRTYPE(I).EQ.3) THEN
7070 C--sfermion exchange diagram
7071 ELSEIF(DRTYPE(I).EQ.4) THEN
7073 C--antifermion vector boson exchange diagram
7074 ELSEIF(DRTYPE(I).EQ.5) THEN
7076 C--scalar vector boson exchange diagram
7077 ELSEIF(DRTYPE(I).EQ.6) THEN
7079 C--gravitino fermion fermion
7080 ELSEIF(DRTYPE(I).EQ.7) THEN
7083 ELSEIF(DRTYPE(I).EQ.8) THEN
7086 ELSEIF(DRTYPE(I).EQ.9) THEN
7089 ELSEIF(DRTYPE(I).EQ.10) THEN
7091 C--fermion --> 3 fermions 1
7092 ELSEIF(DRTYPE(I).EQ.11) THEN
7094 C--fermion --> 3 fermions 2
7095 ELSEIF(DRTYPE(I).EQ.12) THEN
7097 C--fermion --> 3 fermions 3
7098 ELSEIF(DRTYPE(I).EQ.13) THEN
7100 C--fermion --> 3 antifermions 1
7101 ELSEIF(DRTYPE(I).EQ.14) THEN
7103 C--fermion --> 3 antifermions 2
7104 ELSEIF(DRTYPE(I).EQ.15) THEN
7106 C--fermion --> 3 antifermions 3
7107 ELSEIF(DRTYPE(I).EQ.16) THEN
7109 C--antifermion --> antifermion fermion fermion
7110 ELSEIF(DRTYPE(I).EQ.17) THEN
7114 CALL HWWARN('HWD3M0',501,*999)
7116 C--add up the matrix elements
7121 10 ME(P0,P1,P2,P3,DRCF(I)) = ME(P0,P1,P2,P3,DRCF(I))
7124 C--preform the final normalisation
7130 15 ME(P0,P1,P2,P3,I) = PRE*ME(P0,P1,P2,P3,I)
7131 C--compute the unnormalised spin density matrix
7134 RHOB(P0,P0P) = (0.0D0,0.0D0)
7140 35 RHOB(P0,P0P)=RHOB(P0,P0P)+CFTHRE(I,J)*ME(P0,P1,P2,P3,I)*
7141 & DCONJG(ME(P0P,P1,P2,P3,J))
7142 C--compute the weight
7146 45 WGT = WGT+RHOIN(P0,P0P)*RHOB(P0,P0P)
7147 C--normalise this for phase space
7149 C--if initialising select the max weight
7150 IF(SYSPIN.OR.THREEB)
7151 & MWGT = PHS*(MAX(DBLE(RHOB(1,1)),DBLE(RHOB(2,2)))
7152 & +ABS(DBLE(RHOB(1,2)))+ABS(DIMAG(RHOB(1,2))))
7153 C--if generating the event put the information in the common block
7155 C--put the matrix element into the spin common block
7162 25 MESPN(P0,P1,P2,P3,I,IDSPIN) = ME(P0,P1,P2,P3,I)
7163 NCFL(IDSPIN) = NCTHRE
7165 C--if more than one colour flow pick the flow
7166 IF(SPCOPT.EQ.2.AND.NCTHRE.NE.1) THEN
7167 C--contstruct the matrix elements for the colour flows
7176 55 WGTB(I) = WGTB(I)+CFTHRE(I,I)*
7177 & RHOIN(P0,P0P)*ME(P0 ,P1,P2,P3,I)*DCONJG(ME(P0P,P1,P2,P3,I))
7178 WGTB(I) = WGTB(I)*PHS
7179 50 WGTC = WGTC+WGTB(I)
7182 60 WGTB(I) = WGTB(I)*WGTC
7183 C--select the colour flow
7184 WGTC = HWRGEN(1)*WGT
7186 IF(WGTB(I).GE.WGTC) THEN
7190 70 WGTC = WGTC-WGTB(I)
7191 C--otherwise if wrong options set issue warning
7192 ELSEIF(NCTHRE.NE.1) THEN
7194 CALL HWWARN('HWD3M0',500,*999)
7197 1000 FORMAT(/'MULTIPLE COLOUR FLOWS IN DECAY'/'SPCOPT=2 MUST BE USED')
7200 *CMZ :- -10/10/01 14:34:54 by Peter Richardson
7201 *-- Author : Peter Richardson
7202 C-----------------------------------------------------------------------
7203 SUBROUTINE HWD3M1(ID,ME)
7204 C-----------------------------------------------------------------------
7205 C Subroutine to calculate the helicity amplitudes for the three body
7206 C gauge boson exchange diagram
7207 C-----------------------------------------------------------------------
7208 INCLUDE 'HERWIG65.INC'
7209 DOUBLE COMPLEX ME(2,2,2,2),S,D,F0(2,2,8),F1(2,2,8),F01(2,2,8,8),
7210 & F0M(2,2,8),F2(2,2,8),PRE,C(2,2),E(2,2),ZI,APP(2,2),APM(2,2),
7211 & AMP(2,2),AMM(2,2),F1M(2,2,8),F3(2,2,8)
7212 DOUBLE PRECISION A,B,MS,MWD,MA,MB,MA2,MB2,M342,M232,M242,CN,
7213 & MR,P(5,4),PM(5,4),CFTHRE(NCFMAX,NCFMAX)
7214 INTEGER P0,P1,P2,P3,ID,O(2),IDP(4+NDIAGR),DRTYPE(NDIAGR),NCTHRE,
7216 COMMON/HWD3BY/F0,F0M,F1M,F1,F2,F3,F01,A(2,NDIAGR),B(2,NDIAGR),
7217 & MS(NDIAGR),MWD(NDIAGR),MR(NDIAGR),MA(4),MA2(4),MB(4),MB2(4),
7218 & M342,M232,M242,P,PM,CFTHRE,IDP,DRTYPE,NCTHRE,DRCF
7219 PARAMETER(ZI=(0.0D0,1.0D0))
7220 COMMON/HWHEWS/S(8,8,2),D(8,8)
7222 C--compute the propagator factor
7223 PRE = -0.25D0/(M342-MS(ID)+ZI*MWD(ID))
7225 C--compute the C and D functions
7230 APP(P1,P2) = B( P2 ,ID)*S(7,3,O(P1))*S(4,8, P1 )
7233 AMM(P1,P2) = -B(O(P2),ID)*MA(3)*MA(4)
7234 C--the C and E functions
7235 C(P1,P2) = A( P1 ,ID)*( MA2(1)*S(6,2,O(P2))*S(2,5, P2 )
7236 & -MA2(2)*S(6,1,O(P2))*S(1,5, P2 ))
7237 & +A(O(P1),ID)*MA(1)*MA(2)*( S(6,1,O(P2))*S(1,5, P2 )
7238 & -S(6,2,O(P2))*S(2,5, P2 ))
7239 E(P1,P2) =CN*(B( P2 ,ID)*( MA2(3)*S(7,4,O(P1))*S(4,8, P1 )
7240 & +MA2(4)*S(7,3,O(P1))*S(3,8, P1 ))
7241 & -B(O(P2),ID)*MA(3)*MA(4)*( S(7,3,O(P1))*S(3,8, P1 )
7242 & +S(7,4,O(P1))*S(4,8, P1 )))
7246 APM(P1,P2) = B( P2 ,ID)*MA(3)*S(4,8,O(P1))
7247 AMP(P1,P2) =-B(O(P2),ID)*MA(4)*S(7,3,O(P1))
7249 C--the C and D functions
7250 C(P1,P2) = A( P1 ,ID)*MA(2)*( MA2(1)*S(6,5,O(P2))
7251 & -S(6,2,O(P2))*S(2,1, P2 )*S(1,5,O(P2)))
7252 & +A(O(P1),ID)*MA(1)*(-MA2(2)*S(6,5,O(P2))
7253 & +S(6,2,O(P2))*S(2,1, P2 )*S(1,5,O(P2)))
7254 E(P1,P2) =CN*( B( P2 ,ID)*MA(3)*( MA2(4)*S(7,8,O(P1))
7255 & +S(7,3,O(P1))*S(3,4, P1 )*S(4,8,O(P1)))
7256 & -B(O(P2),ID)*MA(4)*( MA2(3)*S(7,8,O(P1))
7257 & +S(7,3,O(P1))*S(3,4, P1 )*S(4,8,O(P1))))
7260 C--compute the matrix element
7266 & APP(P2,P3)*( A(O(P2),ID)*F1(O(P1), P2 ,4)*F0( P2 ,O(P0),3)
7267 & +A( P2 ,ID)*F1(O(P1),O(P2),3)*F0(O(P2),O(P0),4))
7268 & +APM(P2,P3)*( A( P2 ,ID)*F1(O(P1),O(P2),4)*F0(O(P2),O(P0),7)
7269 & +A(O(P2),ID)*F1(O(P1), P2 ,7)*F0( P2 ,O(P0),4))
7270 & +AMP(P2,P3)*( A(O(P2),ID)*F1(O(P1), P2 ,8)*F0( P2 ,O(P0),3)
7271 & +A( P2 ,ID)*F1(O(P1),O(P2),3)*F0(O(P2),O(P0),8))
7272 & +AMM(P2,P3)*( A( P2 ,ID)*F1(O(P1),O(P2),8)*F0(O(P2),O(P0),7)
7273 & +A(O(P2),ID)*F1(O(P1), P2 ,7)*F0( P2 ,O(P0),8))
7274 20 ME(P0,P1,P2,P3) =PRE*(TWO*ME(P0,P1,P2,P3)+C(P0,P1)*E(P2,P3))
7277 *CMZ :- -10/10/01 14:34:54 by Peter Richardson
7278 *-- Author : Peter Richardson
7279 C-----------------------------------------------------------------------
7280 SUBROUTINE HWD3M2(ID,ME)
7281 C-----------------------------------------------------------------------
7282 C Subroutine to calculate the helicity amplitudes for the three body
7283 C Higgs boson exchange diagram
7284 C-----------------------------------------------------------------------
7285 INCLUDE 'HERWIG65.INC'
7286 DOUBLE COMPLEX ME(2,2,2,2),S,D,F0(2,2,8),F1(2,2,8),F01(2,2,8,8),
7287 & F0M(2,2,8),F2(2,2,8),PRE,ZI,V1(2,2),V2(2,2),F1M(2,2,8),
7289 DOUBLE PRECISION A,B,MS,MWD,MA,MB,MA2,MB2,M342,M232,M242,MR,
7290 & P(5,4),PM(5,4),CFTHRE(NCFMAX,NCFMAX)
7291 INTEGER P0,P1,P2,P3,ID,O(2),IDP(4+NDIAGR),DRTYPE(NDIAGR),NCTHRE,
7293 COMMON/HWD3BY/F0,F0M,F1M,F1,F2,F3,F01,A(2,NDIAGR),B(2,NDIAGR),
7294 & MS(NDIAGR),MWD(NDIAGR),MR(NDIAGR),MA(4),MA2(4),MB(4),MB2(4),
7295 & M342,M232,M242,P,PM,CFTHRE,IDP,DRTYPE,NCTHRE,DRCF
7297 COMMON/HWHEWS/S(8,8,2),D(8,8)
7298 PARAMETER(ZI=(0.0D0,1.0D0))
7299 C--decide whether to do the diagram
7300 IF(MB(2)+MR(ID).LT.MB(1).AND.MR(ID).GT.MB(3)+MB(4).AND.
7301 & IDP(4+ID).NE.206) THEN
7306 5 ME(P0,P1,P2,P3) = (0.0D0,0.0D0)
7309 C--calculate the propagator factor
7310 PRE = 0.25D0/(M342-MS(ID)+ZI*MWD(ID))
7311 C--calculate the vertex functions
7314 V1(P1,P2) = PRE*( A( P1 ,ID)*F1(O(P2), P1 ,1)*S(1,5,P1)
7315 & +A(O(P1),ID)*F1(O(P2),O(P1),5)*MA(1))
7316 10 V2(P1,P2) = B( P2 ,ID)*F2(O(P1), P2 ,4)*S(4,8,P2)
7317 & -B(O(P2),ID)*F2(O(P1),O(P2),8)*MA(4)
7318 C--calculate the matrix element
7323 20 ME(P0,P1,P2,P3) = V1(P0,P1)*V2(P2,P3)
7326 *CMZ :- -10/10/01 14:34:54 by Peter Richardson
7327 *-- Author : Peter Richardson
7328 C-----------------------------------------------------------------------
7329 SUBROUTINE HWD3M3(ID,ME)
7330 C-----------------------------------------------------------------------
7331 C Subroutine to calculate the helicity amplitudes for the three body
7332 C antisfermion exchange diagram
7333 C-----------------------------------------------------------------------
7334 INCLUDE 'HERWIG65.INC'
7335 DOUBLE COMPLEX ME(2,2,2,2),S,D,F0(2,2,8),F1(2,2,8),F01(2,2,8,8),
7336 & F0M(2,2,8),F2(2,2,8),PRE,V1(2,2),V2(2,2),ZI,F1M(2,2,8),
7338 DOUBLE PRECISION A,B,MS,MWD,MA,MB,MA2,MB2,M342,M232,M242,MR,
7339 & P(5,4),PM(5,4),CFTHRE(NCFMAX,NCFMAX)
7340 INTEGER P0,P1,P2,P3,ID,O(2),IDP(4+NDIAGR),DRTYPE(NDIAGR),NCTHRE,
7342 COMMON/HWD3BY/F0,F0M,F1M,F1,F2,F3,F01,A(2,NDIAGR),B(2,NDIAGR),
7343 & MS(NDIAGR),MWD(NDIAGR),MR(NDIAGR),MA(4),MA2(4),MB(4),MB2(4),
7344 & M342,M232,M242,P,PM,CFTHRE,IDP,DRTYPE,NCTHRE,DRCF
7346 COMMON/HWHEWS/S(8,8,2),D(8,8)
7347 PARAMETER(ZI=(0.0D0,1.0D0))
7348 C--decide whether to do the diagram
7349 IF(MB(3)+MR(ID).LT.MB(1).AND.MR(ID).GT.MB(2)+MB(4)) THEN
7354 5 ME(P0,P1,P2,P3) = (0.0D0,0.0D0)
7357 C--compute the propagator factor
7358 PRE = -0.25D0/(M242-MS(ID)+ZI*MWD(ID))
7359 C--compute the vertex factors
7362 V1(P1,P2) = PRE*( A( P1 ,ID)*F2(O(P2), P1 ,1)*S(1,5,P1)
7363 & +A(O(P1),ID)*F2(O(P2),O(P1),5)*MA(1))
7364 10 V2(P1,P2) = B( P2 ,ID)*F1(O(P1), P2 ,4)*S(4,8,P2)
7365 & -B(O(P2),ID)*F1(O(P1),O(P2),8)*MA(4)
7366 C--compute the matrix element
7371 20 ME(P0,P1,P2,P3) = V1(P0,P2)*V2(P1,P3)
7374 *CMZ :- -10/10/01 14:34:54 by Peter Richardson
7375 *-- Author : Peter Richardson
7376 C-----------------------------------------------------------------------
7377 SUBROUTINE HWD3M4(ID,ME)
7378 C-----------------------------------------------------------------------
7379 C Subroutine to calculate the helicity amplitudes for the three body
7380 C sfermion exchange diagram
7381 C-----------------------------------------------------------------------
7382 INCLUDE 'HERWIG65.INC'
7383 DOUBLE COMPLEX ME(2,2,2,2),S,D,F0(2,2,8),F1(2,2,8),F01(2,2,8,8),
7384 & F0M(2,2,8),F2(2,2,8),PRE,ZI,V1(2,2),V2(2,2),F1M(2,2,8),
7386 DOUBLE PRECISION A,B,MS,MWD,MA,MB,MA2,MB2,M342,M232,M242,MR,
7387 &P(5,4),PM(5,4),CFTHRE(NCFMAX,NCFMAX)
7388 INTEGER P0,P1,P2,P3,ID,O(2),IDP(4+NDIAGR),DRTYPE(NDIAGR),NCTHRE,
7390 COMMON/HWHEWS/S(8,8,2),D(8,8)
7391 COMMON/HWD3BY/F0,F0M,F1M,F1,F2,F3,F01,A(2,NDIAGR),B(2,NDIAGR),
7392 & MS(NDIAGR),MWD(NDIAGR),MR(NDIAGR),MA(4),MA2(4),MB(4),MB2(4),
7393 & M342,M232,M242,P,PM,CFTHRE,IDP,DRTYPE,NCTHRE,DRCF
7394 PARAMETER(ZI=(0.0D0,1.0D0))
7396 C--decide whether to do the diagram
7397 IF(MB(4)+MR(ID).LT.MB(1).AND.MR(ID).GT.MB(2)+MB(3)) THEN
7402 5 ME(P0,P1,P2,P3) = (0.0D0,0.0D0)
7405 C--compute the propagator factor
7406 PRE = 0.25D0/(M232-MS(ID)+ZI*MWD(ID))
7407 C--compute the factors for the two vertices
7410 V1(P1,P2) = PRE*( A( P2 ,ID)*F0M( P1 , P2 ,4)*S(4,8, P2 )
7411 & -A(O(P2),ID)*F0M( P1 ,O(P2),8)*MA(4))
7412 10 V2(P1,P2) = B(O(P1),ID)*F2 (O(P2),O(P1),2)*S(2,6,O(P1))
7413 & -B( P1 ,ID)*F2 (O(P2), P1 ,6)*MA(2)
7414 C--now compute the matrix element
7419 20 ME(P0,P1,P2,P3) = V1(P0,P3)*V2(P1,P2)
7422 *CMZ :- -10/10/01 14:34:54 by Peter Richardson
7423 *-- Author : Peter Richardson
7424 C-----------------------------------------------------------------------
7425 SUBROUTINE HWD3M5(ID,ME)
7426 C-----------------------------------------------------------------------
7427 C Subroutine to calculate the helicity amplitudes for the three body
7428 C gauge boson exchange diagram (antiparticle decay)
7429 C-----------------------------------------------------------------------
7430 INCLUDE 'HERWIG65.INC'
7431 DOUBLE COMPLEX ME(2,2,2,2),S,D,F0(2,2,8),F1(2,2,8),
7432 & F0M(2,2,8),F2(2,2,8),PRE,C(2,2),E(2,2),ZI,APP(2,2),APM(2,2),
7433 & AMP(2,2),AMM(2,2),F1M(2,2,8),F3(2,2,8),F01(2,2,8,8)
7434 DOUBLE PRECISION A,B,MS,MWD,MA,MB,MA2,MB2,M342,M232,M242,CN,MR,
7435 & P(5,4),PM(5,4),CFTHRE(NCFMAX,NCFMAX)
7436 INTEGER P0,P1,P2,P3,ID,O(2),IDP(4+NDIAGR),DRTYPE(NDIAGR),NCTHRE,
7438 COMMON/HWD3BY/F0,F0M,F1M,F1,F2,F3,F01,A(2,NDIAGR),B(2,NDIAGR),
7439 & MS(NDIAGR),MWD(NDIAGR),MR(NDIAGR),MA(4),MA2(4),MB(4),MB2(4),
7440 & M342,M232,M242,P,PM,CFTHRE,IDP,DRTYPE,NCTHRE,DRCF
7441 PARAMETER(ZI=(0.0D0,1.0D0))
7442 COMMON/HWHEWS/S(8,8,2),D(8,8)
7444 C--compute the propagator factor
7445 PRE = -0.25D0/(M342-MS(ID)+ZI*MWD(ID))
7447 C--compute the C and D functions
7452 APP(P1,P2) = B( P2 ,ID)*S(7,3,O(P1))*S(4,8, P1 )
7455 AMM(P1,P2) = -B(O(P2),ID)*MA(3)*MA(4)
7456 C--the C and E functions
7457 C(P1,P2) = A( P2 ,ID)*( MA2(1)*S(5,2,O(P1))*S(2,6, P1 )
7458 & -MA2(2)*S(5,1,O(P1))*S(1,6, P1 ))
7459 & +A(O(P2),ID)*MA(1)*MA(2)*( S(5,1,O(P1))*S(1,6, P1 )
7460 & -S(5,2,O(P1))*S(2,6, P1 ))
7461 E(P1,P2) =CN*(B( P2 ,ID)*( MA2(3)*S(7,4,O(P1))*S(4,8, P1 )
7462 & +MA2(4)*S(7,3,O(P1))*S(3,8, P1 ))
7463 & -B(O(P2),ID)*MA(3)*MA(4)*( S(7,3,O(P1))*S(3,8, P1 )
7464 & +S(7,4,O(P1))*S(4,8, P1 )))
7468 APM(P1,P2) = B( P2 ,ID)*MA(3)*S(4,8,O(P1))
7469 AMP(P1,P2) =-B(O(P2),ID)*MA(4)*S(7,3,O(P1))
7471 C--the C and D functions
7472 C(P1,P2) = A( P2 ,ID)*MA(1)*( MA2(2)*S(5,6,O(P1))
7473 & -S(5,1,O(P1))*S(1,2, P1 )*S(2,6,O(P1)))
7474 & +A(O(P2),ID)*MA(2)*(-MA2(1)*S(5,6,O(P1))
7475 & +S(5,1,O(P1))*S(1,2, P1 )*S(2,6,O(P1)))
7476 E(P1,P2) =CN*( B( P2 ,ID)*MA(3)*( MA2(4)*S(7,8,O(P1))
7477 & +S(7,3,O(P1))*S(3,4, P1 )*S(4,8,O(P1)))
7478 & -B(O(P2),ID)*MA(4)*( MA2(3)*S(7,8,O(P1))
7479 & +S(7,3,O(P1))*S(3,4, P1 )*S(4,8,O(P1))))
7482 C--compute the matrix element
7488 & APP(P2,P3)*( A(O(P2),ID)*F0M(O(P0), P2 ,4)*F1M( P2 ,O(P1),3)
7489 & +A( P2 ,ID)*F0M(O(P0),O(P2),3)*F1M(O(P2),O(P1),4))
7490 & +APM(P2,P3)*( A( P2 ,ID)*F0M(O(P0),O(P2),4)*F1M(O(P2),O(P1),7)
7491 & +A(O(P2),ID)*F0M(O(P0), P2 ,7)*F1M( P2 ,O(P1),4))
7492 & +AMP(P2,P3)*( A(O(P2),ID)*F0M(O(P0), P2 ,8)*F1M( P2 ,O(P1),3)
7493 & +A( P2 ,ID)*F0M(O(P0),O(P2),3)*F1M(O(P2),O(P1),8))
7494 & +AMM(P2,P3)*( A( P2 ,ID)*F0M(O(P0),O(P2),8)*F1M(O(P2),O(P1),7)
7495 & +A(O(P2),ID)*F0M(O(P0), P2 ,7)*F1M( P2 ,O(P1),8))
7496 20 ME(P0,P1,P2,P3) =PRE*(TWO*ME(P0,P1,P2,P3)+C(P0,P1)*E(P2,P3))
7499 *CMZ :- -10/10/01 14:34:54 by Peter Richardson
7500 *-- Author : Peter Richardson
7501 C-----------------------------------------------------------------------
7502 SUBROUTINE HWD3M6(ID,ME)
7503 C-----------------------------------------------------------------------
7504 C Subroutine to calculate the helicity amplitudes for the three body
7505 C gauge boson exchange diagram
7506 C-----------------------------------------------------------------------
7507 INCLUDE 'HERWIG65.INC'
7508 DOUBLE COMPLEX ME(2,2,2,2),S,D,F0(2,2,8),F1(2,2,8),
7509 & F0M(2,2,8),F2(2,2,8),PRE,C(2,2),ZI,APP(2,2),APM(2,2),
7510 & AMP(2,2),AMM(2,2),F1M(2,2,8),F3(2,2,8),F01(2,2,8,8)
7511 DOUBLE PRECISION A,B,MS,MWD,MA,MB,MA2,MB2,M342,M232,M242,CN,MR,
7512 & P(5,4),DOT,HWULDO,PM(5,4),CFTHRE(NCFMAX,NCFMAX)
7513 INTEGER P0,P1,P2,P3,ID,O(2),IDP(4+NDIAGR),DRTYPE(NDIAGR),NCTHRE,
7515 COMMON/HWD3BY/F0,F0M,F1M,F1,F2,F3,F01,A(2,NDIAGR),B(2,NDIAGR),
7516 & MS(NDIAGR),MWD(NDIAGR),MR(NDIAGR),MA(4),MA2(4),MB(4),MB2(4),
7517 & M342,M232,M242,P,PM,CFTHRE,IDP,DRTYPE,NCTHRE,DRCF
7518 DOUBLE PRECISION XMASS,PLAB,PRW,PCM
7519 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
7520 PARAMETER(ZI=(0.0D0,1.0D0))
7521 COMMON/HWHEWS/S(8,8,2),D(8,8)
7524 C--compute the propagator factor
7525 PRE = SQRT(HWULDO(PCM(1,5),PM(1,1))*HWULDO(PCM(1,6),PM(1,2)))
7526 PRE = -HALF*PRE*A(1,ID)/(M342-MS(ID)+ZI*MWD(ID))
7528 DOT = HWULDO(P(1,1),P(1,3))+HWULDO(P(1,1),P(1,4))
7529 & +HWULDO(P(1,2),P(1,3))+HWULDO(P(1,2),P(1,4))
7530 C--compute the C and D functions
7535 APP(P1,P2) = B( P2 ,ID)*S(7,3,O(P1))*S(4,8, P1 )
7538 AMM(P1,P2) = -B(O(P2),ID)*MA(3)*MA(4)
7540 C(P1,P2) =CN*(B( P2 ,ID)*( MA2(3)*S(7,4,O(P1))*S(4,8, P1 )
7541 & +MA2(4)*S(7,3,O(P1))*S(3,8, P1 ))
7542 & -B(O(P2),ID)*MA(3)*MA(4)*( S(7,3,O(P1))*S(3,8, P1 )
7543 & +S(7,4,O(P1))*S(4,8, P1 )))
7547 APM(P1,P2) = B( P2 ,ID)*MA(3)*S(4,8,O(P1))
7548 AMP(P1,P2) =-B(O(P2),ID)*MA(4)*S(7,3,O(P1))
7551 C(P1,P2) =CN*( B( P2 ,ID)*MA(3)*( MA2(4)*S(7,8,O(P1))
7552 & +S(7,3,O(P1))*S(3,4, P1 )*S(4,8,O(P1)))
7553 & -B(O(P2),ID)*MA(4)*( MA2(3)*S(7,8,O(P1))
7554 & +S(7,3,O(P1))*S(3,4, P1 )*S(4,8,O(P1))))
7557 C--compute the matrix element
7562 15 ME(P0,P1,P2,P3) = (0.0D0,0.0D0)
7565 20 ME(1,1,P2,P3) = PRE*(DOT*C(P2,P3)
7566 & +APP(P2,P3)*F01( P2 , P2 ,3,4)+APM(P2,P3)*F01(O(P2),O(P2),7,4)
7567 & +AMP(P2,P3)*F01( P2 , P2 ,3,8)+AMM(P2,P3)*F01(O(P2),O(P2),7,8))
7570 *CMZ :- -13/03/02 14:19:47 by Peter Richardson
7571 *-- Author : Peter Richardson
7572 C-----------------------------------------------------------------------
7573 SUBROUTINE HWD3M7(ID,ME)
7574 C-----------------------------------------------------------------------
7575 C Subroutine to calculate the helicity amplitudes for the three body
7576 C decay fermion --> gravitino fermion antifermion (via gauge boson)
7577 C-----------------------------------------------------------------------
7578 INCLUDE 'HERWIG65.INC'
7579 DOUBLE COMPLEX ME(2,2,2,2),S,D,F0(2,2,8),F1(2,2,8),F01(2,2,8,8),
7580 & F0M(2,2,8),F2(2,2,8),PRE,ZI,F1M(2,2,8),F3(2,2,8)
7581 DOUBLE PRECISION A,B,MS,MWD,MA,MB,MA2,MB2,M342,M232,M242,MR,
7582 &P(5,4),PM(5,4),CFTHRE(NCFMAX,NCFMAX),HWULDO,DL(2,2)
7583 INTEGER P0,P1,ID,O(2),IDP(4+NDIAGR),DRTYPE(NDIAGR),NCTHRE,
7585 COMMON/HWHEWS/S(8,8,2),D(8,8)
7586 COMMON/HWD3BY/F0,F0M,F1M,F1,F2,F3,F01,A(2,NDIAGR),B(2,NDIAGR),
7587 & MS(NDIAGR),MWD(NDIAGR),MR(NDIAGR),MA(4),MA2(4),MB(4),MB2(4),
7588 & M342,M232,M242,P,PM,CFTHRE,IDP,DRTYPE,NCTHRE,DRCF
7589 PARAMETER(ZI=(0.0D0,1.0D0))
7590 DOUBLE PRECISION XMASS,PLAB,PRW,PCM
7591 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
7593 DATA DL/1.0D0,0.0D0,0.0D0,1.0D0/
7595 C--compute the propagator factor
7596 PRE = HALF*HWULDO(PCM(1,6),PM(1,2))*
7597 & HWULDO(PCM(1,7),PM(1,3))*HWULDO(PCM(1,8),PM(1,4))
7599 PRE = PRE/(M342-MS(ID)+ZI*MWD(ID))
7602 ME(P0,P1, P1 , P1 ) = PRE*B( P1 ,ID)*(
7603 & A(1,ID)*S(2,3,P1)*S(3,4,O(P1))*S(3,2, P1 )*F0(O(P1),O(P0),2)
7604 & +A(2,ID)* DL(P1,1)*S(2,3, P1 )*S(4,2,O(P1))*F0( 1 ,O(P0),2))
7605 ME(P0,P1,O(P1),O(P1)) = PRE*B(O(P1),ID)*(
7606 & A(1,ID)*S(2,4,P1)*S(4,3,O(P1))*S(4,2, P1 )*F0(O(P1),O(P0),2)
7607 & +A(2,ID)* DL(P1,1)*S(2,4, P1 )*S(3,2,O(P1))*F0( 1 ,O(P0),2))
7608 ME(P0,P1,O(P1), P1 ) = (0.0D0,0.0D0)
7609 10 ME(P0,P1, P1 ,O(P1)) = (0.0D0,0.0D0)
7612 *CMZ :- -08/04/02 14:48:42 by Peter Richardson
7613 *-- Author : Peter Richardson
7614 C-----------------------------------------------------------------------
7615 SUBROUTINE HWD3M8(ID,ME)
7616 C-----------------------------------------------------------------------
7617 C Subroutine to calculate the helicity amplitudes for 1st 3 body RPV
7618 C diagram f--> fbar fbar f
7619 C-----------------------------------------------------------------------
7620 INCLUDE 'HERWIG65.INC'
7621 DOUBLE COMPLEX ME(2,2,2,2),S,D,F0(2,2,8),F1(2,2,8),F01(2,2,8,8),
7622 & F0M(2,2,8),F2(2,2,8),PRE,ZI,V1(2,2),V2(2,2),F1M(2,2,8),
7624 DOUBLE PRECISION A,B,MS,MWD,MA,MB,MA2,MB2,M342,M232,M242,MR,
7625 & P(5,4),PM(5,4),CFTHRE(NCFMAX,NCFMAX)
7626 INTEGER P0,P1,P2,P3,ID,O(2),IDP(4+NDIAGR),DRTYPE(NDIAGR),NCTHRE,
7628 COMMON/HWD3BY/F0,F0M,F1M,F1,F2,F3,F01,A(2,NDIAGR),B(2,NDIAGR),
7629 & MS(NDIAGR),MWD(NDIAGR),MR(NDIAGR),MA(4),MA2(4),MB(4),MB2(4),
7630 & M342,M232,M242,P,PM,CFTHRE,IDP,DRTYPE,NCTHRE,DRCF
7632 COMMON/HWHEWS/S(8,8,2),D(8,8)
7633 PARAMETER(ZI=(0.0D0,1.0D0))
7634 C--decide whether to do the diagram
7635 IF(MB(2)+MR(ID).LT.MB(1).AND.MR(ID).GT.MB(3)+MB(4)) THEN
7640 5 ME(P0,P1,P2,P3) = (0.0D0,0.0D0)
7643 C--calculate the propagator factor
7644 PRE = 0.25D0/(M342-MS(ID)+ZI*MWD(ID))
7645 C--calculate the vertex functions
7648 V1(P1,P2) = PRE*( A( P2 ,ID)*F0M( P1 , P2 ,2)*S(2,6, P2)
7649 & -A(O(P2),ID)*F0M( P1 ,O(P2),6)*MA(2))
7650 10 V2(P1,P2) = B( P1 ,ID)*F3 (O(P2), P1 ,3)*S(3,7,P1)
7651 & -B(O(P1),ID)*F3 (O(P2),O(P1),7)*MA(3)
7652 C--calculate the matrix element
7657 20 ME(P0,P1,P2,P3) = V1(P0,P1)*V2(P2,P3)
7660 *CMZ :- -08/04/02 14:48:42 by Peter Richardson
7661 *-- Author : Peter Richardson
7662 C-----------------------------------------------------------------------
7663 SUBROUTINE HWD3M9(ID,ME)
7664 C-----------------------------------------------------------------------
7665 C Subroutine to calculate the helicity amplitudes for 2nd 3 body RPV
7666 C diagram f --> fbar fbar f
7667 C-----------------------------------------------------------------------
7668 INCLUDE 'HERWIG65.INC'
7669 DOUBLE COMPLEX ME(2,2,2,2),S,D,F0(2,2,8),F1(2,2,8),F01(2,2,8,8),
7670 & F0M(2,2,8),F2(2,2,8),PRE,V1(2,2),V2(2,2),ZI,F1M(2,2,8),
7672 DOUBLE PRECISION A,B,MS,MWD,MA,MB,MA2,MB2,M342,M232,M242,MR,
7673 & P(5,4),PM(5,4),CFTHRE(NCFMAX,NCFMAX)
7674 INTEGER P0,P1,P2,P3,ID,O(2),IDP(4+NDIAGR),DRTYPE(NDIAGR),NCTHRE,
7676 COMMON/HWD3BY/F0,F0M,F1M,F1,F2,F3,F01,A(2,NDIAGR),B(2,NDIAGR),
7677 & MS(NDIAGR),MWD(NDIAGR),MR(NDIAGR),MA(4),MA2(4),MB(4),MB2(4),
7678 & M342,M232,M242,P,PM,CFTHRE,IDP,DRTYPE,NCTHRE,DRCF
7680 COMMON/HWHEWS/S(8,8,2),D(8,8)
7681 PARAMETER(ZI=(0.0D0,1.0D0))
7682 C--decide whether to do the diagram
7683 IF(MB(3)+MR(ID).LT.MB(1).AND.MR(ID).GT.MB(2)+MB(4)) THEN
7688 5 ME(P0,P1,P2,P3) = (0.0D0,0.0D0)
7691 C--compute the propagator factor
7692 PRE = -0.25D0/(M242-MS(ID)+ZI*MWD(ID))
7693 C--compute the vertex factors
7696 V1(P1,P2) = PRE*( A( P2 ,ID)*F0M( P1 , P2 ,3)*S(3,7,P2)
7697 & -A(O(P2),ID)*F0M( P1 ,O(P2),7)*MA(3))
7698 10 V2(P1,P2) = B( P1 ,ID)*F3 (O(P2), P1 ,2)*S(2,6,P1)
7699 & -B(O(P1),ID)*F3 (O(P2),O(P1),6)*MA(2)
7700 C--compute the matrix element
7705 20 ME(P0,P1,P2,P3) = V1(P0,P2)*V2(P1,P3)
7708 *CMZ :- -08/04/02 14:48:42 by Peter Richardson
7709 *-- Author : Peter Richardson
7710 C-----------------------------------------------------------------------
7711 SUBROUTINE HWD3MA(ID,ME)
7712 C-----------------------------------------------------------------------
7713 C Subroutine to calculate the helicity amplitudes for 3rd 3 body RPV
7714 C diagram f --> fbar fbar f
7715 C-----------------------------------------------------------------------
7716 INCLUDE 'HERWIG65.INC'
7717 DOUBLE COMPLEX ME(2,2,2,2),S,D,F0(2,2,8),F1(2,2,8),F01(2,2,8,8),
7718 & F0M(2,2,8),F2(2,2,8),PRE,ZI,V1(2,2),V2(2,2),F1M(2,2,8),
7720 DOUBLE PRECISION A,B,MS,MWD,MA,MB,MA2,MB2,M342,M232,M242,MR,
7721 &P(5,4),PM(5,4),CFTHRE(NCFMAX,NCFMAX)
7722 INTEGER P0,P1,P2,P3,ID,O(2),IDP(4+NDIAGR),DRTYPE(NDIAGR),NCTHRE,
7724 COMMON/HWHEWS/S(8,8,2),D(8,8)
7725 COMMON/HWD3BY/F0,F0M,F1M,F1,F2,F3,F01,A(2,NDIAGR),B(2,NDIAGR),
7726 & MS(NDIAGR),MWD(NDIAGR),MR(NDIAGR),MA(4),MA2(4),MB(4),MB2(4),
7727 & M342,M232,M242,P,PM,CFTHRE,IDP,DRTYPE,NCTHRE,DRCF
7728 PARAMETER(ZI=(0.0D0,1.0D0))
7730 C--decide whether to do the diagram
7731 IF(MB(4)+MR(ID).LT.MB(1).AND.MR(ID).GT.MB(2)+MB(3)) THEN
7736 5 ME(P0,P1,P2,P3) = (0.0D0,0.0D0)
7739 C--compute the propagator factor
7740 PRE = 0.25D0/(M232-MS(ID)+ZI*MWD(ID))
7741 C--compute the factors for the two vertices
7744 V1(P1,P2) = PRE*( A( P1 ,ID)*F3(O(P2), P1 ,1)*S(1,5,P1)
7745 & +A(O(P1),ID)*F3(O(P2),O(P1),5)*MA(1))
7746 10 V2(P1,P2) = B( P2 ,ID)*F1( P1 , P2 ,3)*S(3,7,P2)
7747 & -B(O(P2),ID)*F1( P1 ,O(P2),7)*MA(3)
7748 C--now compute the matrix element
7753 20 ME(P0,P1,P2,P3) = V1(P0,P3)*V2(P1,P2)
7756 *CMZ :- -08/04/02 14:48:42 by Peter Richardson
7757 *-- Author : Peter Richardson
7758 C-----------------------------------------------------------------------
7759 SUBROUTINE HWD3MB(ID,ME)
7760 C-----------------------------------------------------------------------
7761 C Subroutine to calculate the helicity amplitudes for 4th 3 body RPV
7762 C diagram f --> f f f
7763 C-----------------------------------------------------------------------
7764 INCLUDE 'HERWIG65.INC'
7765 DOUBLE COMPLEX ME(2,2,2,2),S,D,F0(2,2,8),F1(2,2,8),F01(2,2,8,8),
7766 & F0M(2,2,8),F2(2,2,8),PRE,ZI,V1(2,2),V2(2,2),F1M(2,2,8),
7768 DOUBLE PRECISION A,B,MS,MWD,MA,MB,MA2,MB2,M342,M232,M242,MR,
7769 & P(5,4),PM(5,4),CFTHRE(NCFMAX,NCFMAX)
7770 INTEGER P0,P1,P2,P3,ID,O(2),IDP(4+NDIAGR),DRTYPE(NDIAGR),NCTHRE,
7772 COMMON/HWD3BY/F0,F0M,F1M,F1,F2,F3,F01,A(2,NDIAGR),B(2,NDIAGR),
7773 & MS(NDIAGR),MWD(NDIAGR),MR(NDIAGR),MA(4),MA2(4),MB(4),MB2(4),
7774 & M342,M232,M242,P,PM,CFTHRE,IDP,DRTYPE,NCTHRE,DRCF
7776 COMMON/HWHEWS/S(8,8,2),D(8,8)
7777 PARAMETER(ZI=(0.0D0,1.0D0))
7778 C--decide whether to do the diagram
7779 IF(MB(2)+MR(ID).LT.MB(1).AND.MR(ID).GT.MB(3)+MB(4)) THEN
7784 5 ME(P0,P1,P2,P3) = (0.0D0,0.0D0)
7787 C--calculate the propagator factor
7788 PRE = 0.25D0/(M342-MS(ID)+ZI*MWD(ID))
7789 C--calculate the vertex functions
7792 V1(P1,P2) = PRE*( A( P1 ,ID)*F1(O(P2), P1 ,1)*S(1,5,P1)
7793 & +A(O(P1),ID)*F1(O(P2),O(P1),5)*MA(1))
7794 10 V2(P1,P2) = B(O(P2),ID)*F2(O(P1),O(P2),4)*S(4,8,O(P2))
7795 & -B( P2 ,ID)*F2(O(P1), P2 ,8)*MA(4)
7796 C--calculate the matrix element
7801 20 ME(P0,P1,P2,P3) = V1(P0,P1)*V2(P2,P3)
7804 *CMZ :- -08/04/02 14:48:42 by Peter Richardson
7805 *-- Author : Peter Richardson
7806 C-----------------------------------------------------------------------
7807 SUBROUTINE HWD3MC(ID,ME)
7808 C-----------------------------------------------------------------------
7809 C Subroutine to calculate the helicity amplitudes for 5th 3 body RPV
7810 C diagram f --> f f f
7811 C-----------------------------------------------------------------------
7812 INCLUDE 'HERWIG65.INC'
7813 DOUBLE COMPLEX ME(2,2,2,2),S,D,F0(2,2,8),F1(2,2,8),F01(2,2,8,8),
7814 & F0M(2,2,8),F2(2,2,8),PRE,V1(2,2),V2(2,2),ZI,F1M(2,2,8),
7816 DOUBLE PRECISION A,B,MS,MWD,MA,MB,MA2,MB2,M342,M232,M242,MR,
7817 & P(5,4),PM(5,4),CFTHRE(NCFMAX,NCFMAX)
7818 INTEGER P0,P1,P2,P3,ID,O(2),IDP(4+NDIAGR),DRTYPE(NDIAGR),NCTHRE,
7820 COMMON/HWD3BY/F0,F0M,F1M,F1,F2,F3,F01,A(2,NDIAGR),B(2,NDIAGR),
7821 & MS(NDIAGR),MWD(NDIAGR),MR(NDIAGR),MA(4),MA2(4),MB(4),MB2(4),
7822 & M342,M232,M242,P,PM,CFTHRE,IDP,DRTYPE,NCTHRE,DRCF
7824 COMMON/HWHEWS/S(8,8,2),D(8,8)
7825 PARAMETER(ZI=(0.0D0,1.0D0))
7826 C--decide whether to do the diagram
7827 IF(MB(3)+MR(ID).LT.MB(1).AND.MR(ID).GT.MB(2)+MB(4)) THEN
7832 5 ME(P0,P1,P2,P3) = (0.0D0,0.0D0)
7835 C--compute the propagator factor
7836 PRE =-0.25D0/(M242-MS(ID)+ZI*MWD(ID))
7837 C--compute the vertex factors
7840 V1(P1,P2) = PRE*( A( P1 ,ID)*F2(O(P2), P1 ,1)*S(1,5,P1)
7841 & +A(O(P1),ID)*F2(O(P2),O(P1),5)*MA(1))
7842 10 V2(P1,P2) = B(O(P2),ID)*F1(O(P1),O(P2),4)*S(4,8,O(P2))
7843 & -B( P2 ,ID)*F1(O(P1), P2 ,8)*MA(4)
7844 C--compute the matrix element
7849 20 ME(P0,P1,P2,P3) = V1(P0,P2)*V2(P1,P3)
7852 *CMZ :- -08/04/02 14:48:42 by Peter Richardson
7853 *-- Author : Peter Richardson
7854 C-----------------------------------------------------------------------
7855 SUBROUTINE HWD3MD(ID,ME)
7856 C-----------------------------------------------------------------------
7857 C Subroutine to calculate the helicity amplitudes for 6th 3 body RPV
7858 C diagram f --> f f f
7859 C-----------------------------------------------------------------------
7860 INCLUDE 'HERWIG65.INC'
7861 DOUBLE COMPLEX ME(2,2,2,2),S,D,F0(2,2,8),F1(2,2,8),F01(2,2,8,8),
7862 & F0M(2,2,8),F2(2,2,8),PRE,ZI,V1(2,2),V2(2,2),F1M(2,2,8),
7864 DOUBLE PRECISION A,B,MS,MWD,MA,MB,MA2,MB2,M342,M232,M242,MR,
7865 &P(5,4),PM(5,4),CFTHRE(NCFMAX,NCFMAX)
7866 INTEGER P0,P1,P2,P3,ID,O(2),IDP(4+NDIAGR),DRTYPE(NDIAGR),NCTHRE,
7868 COMMON/HWHEWS/S(8,8,2),D(8,8)
7869 COMMON/HWD3BY/F0,F0M,F1M,F1,F2,F3,F01,A(2,NDIAGR),B(2,NDIAGR),
7870 & MS(NDIAGR),MWD(NDIAGR),MR(NDIAGR),MA(4),MA2(4),MB(4),MB2(4),
7871 & M342,M232,M242,P,PM,CFTHRE,IDP,DRTYPE,NCTHRE,DRCF
7872 PARAMETER(ZI=(0.0D0,1.0D0))
7874 C--decide whether to do the diagram
7875 IF(MB(4)+MR(ID).LT.MB(1).AND.MR(ID).GT.MB(2)+MB(3)) THEN
7880 5 ME(P0,P1,P2,P3) = (0.0D0,0.0D0)
7883 C--compute the propagator factor
7884 PRE = 0.25D0/(M232-MS(ID)+ZI*MWD(ID))
7885 C--compute the factors for the two vertices
7888 V1(P1,P2) = PRE*( A(O(P2),ID)*F0M( P1 ,O(P2),4)*S(4,8,O(P2))
7889 & -A( P2 ,ID)*F0M( P1 , P2 ,8)*MA(4))
7890 10 V2(P1,P2) = B(O(P1),ID)*F2 (O(P2),O(P1),2)*S(2,6,O(P1))
7891 & -B( P1 ,ID)*F2 (O(P2), P1 ,6)*MA(2)
7892 C--now compute the matrix element
7897 20 ME(P0,P1,P2,P3) = V1(P0,P3)*V2(P1,P2)
7900 *CMZ :- -08/04/02 14:48:42 by Peter Richardson
7901 *-- Author : Peter Richardson
7902 C-----------------------------------------------------------------------
7903 SUBROUTINE HWD3MF(ID,ME)
7904 C-----------------------------------------------------------------------
7905 C Subroutine to calculate the helicity amplitudes for 7th 3 body RPV
7906 C diagram f --> fbar fbar fbar
7907 C-----------------------------------------------------------------------
7908 INCLUDE 'HERWIG65.INC'
7909 DOUBLE COMPLEX ME(2,2,2,2),S,D,F0(2,2,8),F1(2,2,8),F01(2,2,8,8),
7910 & F0M(2,2,8),F2(2,2,8),PRE,ZI,V1(2,2),V2(2,2),F1M(2,2,8),
7912 DOUBLE PRECISION A,B,MS,MWD,MA,MB,MA2,MB2,M342,M232,M242,MR,
7913 & P(5,4),PM(5,4),CFTHRE(NCFMAX,NCFMAX)
7914 INTEGER P0,P1,P2,P3,ID,O(2),IDP(4+NDIAGR),DRTYPE(NDIAGR),NCTHRE,
7916 COMMON/HWD3BY/F0,F0M,F1M,F1,F2,F3,F01,A(2,NDIAGR),B(2,NDIAGR),
7917 & MS(NDIAGR),MWD(NDIAGR),MR(NDIAGR),MA(4),MA2(4),MB(4),MB2(4),
7918 & M342,M232,M242,P,PM,CFTHRE,IDP,DRTYPE,NCTHRE,DRCF
7920 COMMON/HWHEWS/S(8,8,2),D(8,8)
7921 PARAMETER(ZI=(0.0D0,1.0D0))
7922 C--decide whether to do the diagram
7923 IF(MB(2)+MR(ID).LT.MB(1).AND.MR(ID).GT.MB(3)+MB(4)) THEN
7928 5 ME(P0,P1,P2,P3) = (0.0D0,0.0D0)
7931 C--calculate the propagator factor
7932 PRE = 0.25D0/(M342-MS(ID)+ZI*MWD(ID))
7933 C--calculate the vertex functions
7936 V1(P1,P2) = PRE*( A( P2 ,ID)*F0M( P1 , P2 ,2)*S(2,6,P2)
7937 & -A(O(P2),ID)*F0M( P1 ,O(P2),6)*MA(2))
7938 10 V2(P1,P2) = B( P2 ,ID)*F2( P1 , P2 ,4)*S(4,8,P2)
7939 & -B(O(P2),ID)*F2( P1 ,O(P2),8)*MA(4)
7940 C--calculate the matrix element
7945 20 ME(P0,P1,P2,P3) = V1(P0,P1)*V2(P2,P3)
7948 *CMZ :- -08/04/02 14:48:42 by Peter Richardson
7949 *-- Author : Peter Richardson
7950 C-----------------------------------------------------------------------
7951 SUBROUTINE HWD3MG(ID,ME)
7952 C-----------------------------------------------------------------------
7953 C Subroutine to calculate the helicity amplitudes for 8th 3 body RPV
7954 C diagram f --> fbar fbar fbar
7955 C-----------------------------------------------------------------------
7956 INCLUDE 'HERWIG65.INC'
7957 DOUBLE COMPLEX ME(2,2,2,2),S,D,F0(2,2,8),F1(2,2,8),F01(2,2,8,8),
7958 & F0M(2,2,8),F2(2,2,8),PRE,V1(2,2),V2(2,2),ZI,F1M(2,2,8),
7960 DOUBLE PRECISION A,B,MS,MWD,MA,MB,MA2,MB2,M342,M232,M242,MR,
7961 & P(5,4),PM(5,4),CFTHRE(NCFMAX,NCFMAX)
7962 INTEGER P0,P1,P2,P3,ID,O(2),IDP(4+NDIAGR),DRTYPE(NDIAGR),NCTHRE,
7964 COMMON/HWD3BY/F0,F0M,F1M,F1,F2,F3,F01,A(2,NDIAGR),B(2,NDIAGR),
7965 & MS(NDIAGR),MWD(NDIAGR),MR(NDIAGR),MA(4),MA2(4),MB(4),MB2(4),
7966 & M342,M232,M242,P,PM,CFTHRE,IDP,DRTYPE,NCTHRE,DRCF
7968 COMMON/HWHEWS/S(8,8,2),D(8,8)
7969 PARAMETER(ZI=(0.0D0,1.0D0))
7970 C--decide whether to do the diagram
7971 IF(MB(3)+MR(ID).LT.MB(1).AND.MR(ID).GT.MB(2)+MB(4)) THEN
7976 5 ME(P0,P1,P2,P3) = (0.0D0,0.0D0)
7979 C--compute the propagator factor
7980 PRE = 0.25D0/(M242-MS(ID)+ZI*MWD(ID))
7981 C--compute the vertex factors
7984 V1(P1,P2) = PRE*( A( P2 ,ID)*F0M( P1 , P2 ,3)*S(3,7, P2 )
7985 & -A(O(P2),ID)*F0M( P1 ,O(P2),7)*MA(3))
7986 10 V2(P1,P2) = B( P1 ,ID)*F3 ( P2 , P1 ,2)*S(2,6, P1 )
7987 & -B(O(P1),ID)*F3 ( P2 ,O(P1),6)*MA(2)
7988 C--compute the matrix element
7993 20 ME(P0,P1,P2,P3) = V1(P0,P2)*V2(P1,P3)
7996 *CMZ :- -08/04/02 14:48:42 by Peter Richardson
7997 *-- Author : Peter Richardson
7998 C-----------------------------------------------------------------------
7999 SUBROUTINE HWD3MH(ID,ME)
8000 C-----------------------------------------------------------------------
8001 C Subroutine to calculate the helicity amplitudes for 9th 3 body RPV
8002 C diagram f --> fbar fbar fbar
8003 C-----------------------------------------------------------------------
8004 INCLUDE 'HERWIG65.INC'
8005 DOUBLE COMPLEX ME(2,2,2,2),S,D,F0(2,2,8),F1(2,2,8),F01(2,2,8,8),
8006 & F0M(2,2,8),F2(2,2,8),PRE,ZI,V1(2,2),V2(2,2),F1M(2,2,8),
8008 DOUBLE PRECISION A,B,MS,MWD,MA,MB,MA2,MB2,M342,M232,M242,MR,
8009 &P(5,4),PM(5,4),CFTHRE(NCFMAX,NCFMAX)
8010 INTEGER P0,P1,P2,P3,ID,O(2),IDP(4+NDIAGR),DRTYPE(NDIAGR),NCTHRE,
8012 COMMON/HWHEWS/S(8,8,2),D(8,8)
8013 COMMON/HWD3BY/F0,F0M,F1M,F1,F2,F3,F01,A(2,NDIAGR),B(2,NDIAGR),
8014 & MS(NDIAGR),MWD(NDIAGR),MR(NDIAGR),MA(4),MA2(4),MB(4),MB2(4),
8015 & M342,M232,M242,P,PM,CFTHRE,IDP,DRTYPE,NCTHRE,DRCF
8016 PARAMETER(ZI=(0.0D0,1.0D0))
8018 C--decide whether to do the diagram
8019 IF(MB(4)+MR(ID).LT.MB(1).AND.MR(ID).GT.MB(2)+MB(3)) THEN
8024 5 ME(P0,P1,P2,P3) = (0.0D0,0.0D0)
8027 C--compute the propagator factor
8028 PRE = -0.25D0/(M232-MS(ID)+ZI*MWD(ID))
8029 C--compute the factors for the two vertices
8032 V1(P1,P2) = PRE*( A( P2 ,ID)*F0M( P1 , P2 ,4)*S(4,8,P2)
8033 & -A(O(P2),ID)*F0M( P1 ,O(P2),8)*MA(4))
8034 10 V2(P1,P2) = B( P1 ,ID)*F2 ( P2 , P1 ,2)*S(2,6,P1)
8035 & -B(O(P1),ID)*F2 ( P2 ,O(P1),6)*MA(2)
8036 C--now compute the matrix element
8041 20 ME(P0,P1,P2,P3) = V1(P0,P3)*V2(P1,P2)
8044 *CMZ :- -09/04/02 13:37:38 by Peter Richardson
8045 *-- Author : Peter Richardson
8046 C-----------------------------------------------------------------------
8047 SUBROUTINE HWD3MI(ID,ME)
8048 C-----------------------------------------------------------------------
8049 C Subroutine to calculate the helicity amplitudes for the three body
8050 C Higgs boson exchange diagram antifermion decay
8051 C-----------------------------------------------------------------------
8052 INCLUDE 'HERWIG65.INC'
8053 DOUBLE COMPLEX ME(2,2,2,2),S,D,F0(2,2,8),F1(2,2,8),F01(2,2,8,8),
8054 & F0M(2,2,8),F2(2,2,8),PRE,ZI,V1(2,2),V2(2,2),F1M(2,2,8),
8056 DOUBLE PRECISION A,B,MS,MWD,MA,MB,MA2,MB2,M342,M232,M242,MR,
8057 & P(5,4),PM(5,4),CFTHRE(NCFMAX,NCFMAX)
8058 INTEGER P0,P1,P2,P3,ID,O(2),IDP(4+NDIAGR),DRTYPE(NDIAGR),NCTHRE,
8060 COMMON/HWD3BY/F0,F0M,F1M,F1,F2,F3,F01,A(2,NDIAGR),B(2,NDIAGR),
8061 & MS(NDIAGR),MWD(NDIAGR),MR(NDIAGR),MA(4),MA2(4),MB(4),MB2(4),
8062 & M342,M232,M242,P,PM,CFTHRE,IDP,DRTYPE,NCTHRE,DRCF
8064 COMMON/HWHEWS/S(8,8,2),D(8,8)
8065 PARAMETER(ZI=(0.0D0,1.0D0))
8066 C--decide whether to do the diagram
8067 IF(MB(2)+MR(ID).LT.MB(1).AND.MR(ID).GT.MB(3)+MB(4).AND.
8068 & IDP(4+ID).NE.207) THEN
8073 5 ME(P0,P1,P2,P3) = (0.0D0,0.0D0)
8076 C--calculate the propagator factor
8077 PRE = 0.25D0/(M342-MS(ID)+ZI*MWD(ID))
8078 C--calculate the vertex functions
8081 V1(P1,P2) = PRE*( A( P2 ,ID)*F0M(O(P1), P2 ,2)*S(2,6,P2)
8082 & -A(O(P2),ID)*F0M(O(P1),O(P2),6)*MA(2))
8083 10 V2(P1,P2) = B( P2 ,ID)*F2(O(P1), P2 ,4)*S(4,8,P2)
8084 & -B(O(P2),ID)*F2(O(P1),O(P2),8)*MA(4)
8085 C--calculate the matrix element
8090 20 ME(P0,P1,P2,P3) = V1(P0,P1)*V2(P2,P3)
8093 *CMZ :- -20/10/99 09:46:43 by Peter Richardson
8094 *-- Author : Peter Richardson
8095 C-----------------------------------------------------------------------
8096 SUBROUTINE HWD4ME(ID,ITYPE1,ITYPE2,IMODE)
8097 C-----------------------------------------------------------------------
8098 C Subroutine to perform the four body Higgs decays
8099 C-----------------------------------------------------------------------
8100 INCLUDE 'HERWIG65.INC'
8101 INTEGER IMODE,I,J,ID,IDP(4+NDIAGR),ITYPE(2),NTRY,ITYPE1,ITYPE2
8102 DOUBLE PRECISION A,B,MS,MWD,M,M2,WGT,HWRUNI,BRW(6),BRZ(12),
8103 & HWUPCM,WMAX,WSUM,WSSUM,MR,PRE,TEMP,HWRGEN,WTMAX,P(5,5)
8104 EXTERNAL HWRUNI,HWUPCM,HWRGEN
8105 COMMON/HWD4BY/A(2),B(2),MS(2),MWD(2),MR(2),M(5),M2(5),P,IDP
8106 DATA BRW/0.321D0,0.321D0,0.000D0,0.108D0,0.108D0,0.108D0/
8107 DATA BRZ/0.154D0,0.120D0,0.154D0,0.120D0,0.152D0,0.000D0,
8108 & 0.033D0,0.067D0,0.033D0,0.067D0,0.033D0,0.067D0/
8111 WTMAX = WT4MAX(ITYPE(1),ITYPE(2),IMODE)
8112 PRE=P4MODE(ITYPE(1),ITYPE(2),IMODE)
8113 C--compute the masses of external particles for the decay mode
8115 C--couplings and masses of the internal particles
8116 A(I) = A4MODE(I,ITYPE1,IMODE)
8117 B(I) = B4MODE(I,ITYPE2,IMODE)
8118 MR(I) = RMASS(I4MODE(I,IMODE))
8120 IF(I4MODE(I,IMODE).EQ.200) THEN
8125 IDP(5+I) = I4MODE(I,IMODE)
8126 C--id's of outgoing particles
8127 IF(I4MODE(I,IMODE).EQ.200) THEN
8128 IDP(2*I ) = ITYPE(I)
8129 IF(ITYPE(I).GT.6) IDP(2*I) = IDP(2*I)+114
8130 IDP(2*I+1) = IDP(2*I)+6
8132 IDP(2*I ) = 2*ITYPE(I)-1
8133 IF(ITYPE(I).GT.3) IDP(2*I) = IDP(2*I)+114
8134 IDP(2*I+1) = IDP(2*I)+7
8135 IF(I4MODE(I,IMODE).EQ.198) THEN
8137 IDP(2*I) = IDP(2*I+1)-6
8142 IDP(1) = IDK(ID4PRT(IMODE))
8144 M(I) = RMASS(IDP(I))
8146 IF(M(1).LT.M(2)+M(3)+M(4)+M(5).OR.MR(1).LT.M(2)+M(3).OR.
8147 & MR(2).LT.M(4)+M(5)) RETURN
8148 IF(IPRINT.EQ.2.AND..NOT.GENEV)
8149 & WRITE(6,3000) RNAME(IDP(6)),RNAME(IDP(2)),RNAME(IDP(3)),
8150 & RNAME(IDP(7)),RNAME(IDP(4)),RNAME(IDP(5))
8151 C--compute the width and maximum weight if initialising
8159 IF(WGT.GT.WMAX) WMAX = WGT
8161 WSSUM = WSSUM+WGT**2
8162 IF(WGT.LT.ZERO) CALL HWWARN('HWD4ME',500,*999)
8164 WSUM = WSUM/DBLE(NSEARCH)
8165 WSSUM = MAX(ZERO,WSSUM/DBLE(NSEARCH)-WSUM**2)
8166 WSSUM = SQRT(WSSUM/DBLE(NSEARCH))
8167 IF(IPRINT.EQ.2) WRITE(6,3010) WSUM,WSSUM
8168 IF(IPRINT.EQ.2) WRITE(6,3020) WMAX
8169 TEMP = BRFRAC(ID4PRT(IMODE))*HBAR/RLTIM(IDK(ID4PRT(IMODE)))
8171 IF(I4MODE(J,IMODE).EQ.200) THEN
8172 TEMP = TEMP*BRZ(ITYPE(J))
8174 TEMP = TEMP*BRW(ITYPE(J))
8177 IF(IPRINT.EQ.2) WRITE(6,3030) WSUM/TEMP,WSSUM/TEMP
8178 C--set up the maximum weight
8179 WT4MAX(ITYPE(1),ITYPE(2),IMODE) = WMAX
8181 C--generate a configuation
8183 IF(SYSPIN.AND.NSPN.NE.0) CALL HWWARN('HWD4ME',501,*999)
8187 IF(HWRGEN(0)*WTMAX.GT.WGT.AND.NTRY.LT.NSNTRY) GOTO 100
8188 IF(NTRY.GE.NSNTRY) CALL HWWARN('HWD4ME',100,*999)
8190 3000 FORMAT(/' FOLLOWED BY ',A8,' --> ',A8,' ',A8,' AND ',
8191 & A8,' --> ',A8,' ',A8)
8192 3010 FORMAT(' PARTIAL WIDTH = ',G12.4,' +/- ',G12.4)
8193 3020 FORMAT(' MAXIMUM WEIGHT = ',E12.4)
8194 3030 FORMAT(' RATIO TO ISAJET VALUE = ',G12.4,' +/- ',G12.4)
8197 *CMZ :- -11/10/01 12:32:39 by Peter Richardson
8198 *-- Author : Peter Richardson
8199 C-----------------------------------------------------------------------
8200 SUBROUTINE HWD4M0(ID,WGT)
8201 C-----------------------------------------------------------------------
8202 C Subroutine to calculate the matrix element for a given four body
8204 C-----------------------------------------------------------------------
8205 INCLUDE 'HERWIG65.INC'
8206 INTEGER I,J,P0,P1,P2,P3,ID,O(2),IDP(4+NDIAGR),II,P4
8207 DOUBLE PRECISION A,B,MS,MWD,M,M2,WGT,HWRUNI,
8208 & M23,PCMA,PCMB(2),HWUPCM,PHS,N(3),HWVDOT,PP,HWULDO,EPS,
8209 & M232,PRE,PLAB,PRW,XMASS,PCM,P(5,5),PM(5,5),MR,PREF(5),
8210 & M45,M452,MJAC(2),PTMP(5,2),CN(2),DOT
8211 DOUBLE COMPLEX S,D,ME(2,2,2,2),APP(2,2),AMP(2,2),APM(2,2),
8212 & AMM(2,2),BPP(2,2),BPM(2,2),BMP(2,2),BMM(2,2),ZI,
8213 & F45(2,2,8,8),F23(2,2,8,8),C(2,2),E(2,2)
8215 EXTERNAL HWRUNI,HWUPCM,HWVDOT,HWULDO,HWRLOG
8216 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
8217 COMMON/HWD4BY/A(2),B(2),MS(2),MWD(2),MR(2),M(5),M2(5),P,IDP
8219 DATA PREF/1.0D0,0.0D0,0.0D0,1.0D0,0.0D0/
8220 COMMON/HWHEWS/S(8,8,2),D(8,8)
8221 PARAMETER(EPS=1D-20,ZI=(0.0D0,1.0D0))
8222 C--select the masses of the gauge bosons and compute Jacobians
8223 IF(HWRLOG(HALF)) THEN
8224 CALL HWHGB1(1,2,IDP(6),MJAC(1),M232,(M(1)-M(4)-M(5))**2,
8227 CALL HWHGB1(1,2,IDP(7),MJAC(2),M452,
8228 & (M(1)-M23)**2,(M(4)+M(5))**2)
8231 CALL HWHGB1(1,2,IDP(7),MJAC(2),M452,(M(1)-M(2)-M(3))**2,
8234 CALL HWHGB1(1,2,IDP(6),MJAC(1),M232,(M(1)-M45)**2,
8238 MJAC(1) = MJAC(1)/((M232-MS(1))**2+MWD(1)**2)
8239 MJAC(2) = MJAC(2)/((M452-MS(2))**2+MWD(2)**2)
8243 2 CN(I) = -ONE/MS(I)
8244 C--now perform the decay of the Higgs to the bosons
8245 PCMA = HWUPCM(M(1),M23,M45)
8248 CALL HWVEQU(5,PHEP(1,ID),P(1,1))
8249 CALL HWDTWO(P(1,1),PLAB(1,1),PLAB(1,2),PCMA,2.0D0,.TRUE.)
8250 PCMB(1) = HWUPCM(M23,M(2),M(3))
8251 CALL HWDTWO(PLAB(1,1),P(1,2),P(1,3),PCMB(1),2.0D0,.TRUE.)
8252 PCMB(2) = HWUPCM(M45,M(4),M(5))
8253 CALL HWDTWO(PLAB(1,2),P(1,4),P(1,5),PCMB(2),2.0D0,.TRUE.)
8254 DOT = HWULDO(PLAB(1,1),PLAB(1,2))
8255 C--compute the phase sapce factors
8256 PHS = PCMA*PCMB(1)*PCMB(2)*MJAC(1)*MJAC(2)/512.0D0/PIFAC**5/
8258 C--compute the vectors for the helicity amplitudes
8261 C--compute the references vectors
8262 C--not important if SM particle which can't have spin measured
8263 C--ie anything other the top and tau
8264 C--also not important if particle is approx massless
8265 C--first the SM particles other than top and tau
8266 IF(IDP(II).LT.400.AND.(IDP(II).NE.6.AND.IDP(II).NE.12
8267 & .AND.IDP(II).NE.125.AND.IDP(II).NE.131)) THEN
8268 CALL HWVEQU(5,PREF,PLAB(1,I+4))
8269 C--all other particles
8271 PP = SQRT(HWVDOT(3,P(1,II),P(1,II)))
8272 CALL HWVSCA(3,ONE/PP,P(1,II),N)
8273 PLAB(4,I+4) = HALF*(P(4,II)-PP)
8274 PP = HALF*(PP-M(II)-PP**2/(M(II)+P(4,II)))
8275 CALL HWVSCA(3,PP,N,PLAB(1,I+4))
8276 CALL HWUMAS(PLAB(1,I+4))
8277 PP = HWVDOT(3,PLAB(1,I+4),PLAB(1,I+4))
8278 C--fix to avoid problems if approx massless due to energy
8279 IF(PP.LT.EPS) CALL HWVEQU(5,PREF,PLAB(1,I+4))
8281 C--now the massless vectors
8282 PP = HALF*M2(II)/HWULDO(PLAB(1,I+4),P(1,II))
8284 4 PLAB(J,I) = P(J,II)-PP*PLAB(J,I+4)
8285 3 CALL HWUMAS(PLAB(1,I))
8286 C--change ordr of momenta for call to HE code
8298 6 PCM(5,I)=PLAB(5,I)
8299 C--compute the S functions
8300 CALL HWHEW2(8,PCM(1,1),S(1,1,2),S(1,1,1),D)
8303 S(I,J,2) = -S(I,J,2)
8304 7 D(I,J) = TWO*D(I,J)
8305 CALL HWVSUM(4,PM(1,2),PM(1,3),PTMP(1,1))
8306 CALL HWVSUM(4,PM(1,4),PM(1,5),PTMP(1,2))
8307 CALL HWUMAS(PTMP(1,1))
8308 CALL HWUMAS(PTMP(1,2))
8309 C--compute the F functions
8310 CALL HWH2F3(8,F23,PTMP(1,1),ZERO)
8311 CALL HWH2F3(8,F45,PTMP(1,2),ZERO)
8312 C--now find the prefactor for all the diagrams
8313 PRE = HWULDO(PCM(1,5),PM(1,2))*HWULDO(PCM(1,6),PM(1,3))*
8314 & HWULDO(PCM(1,7),PM(1,4))*HWULDO(PCM(1,8),PM(1,5))
8315 PRE = 0.25D0/SQRT(PRE)
8316 C--zero the matrix element
8321 8 ME(P0,P1,P2,P3) = (0.0D0,0.0D0)
8322 C--compute the A, B, C and E functions
8326 C--the A and B functions
8327 APP(P1,P2) = A( P2 )*S(5,1,O(P1))*S(2,6, P1 )
8330 AMM(P1,P2) = -A(O(P2))*M(2)*M(3)
8331 BPP(P1,P2) = B( P2 )*S(7,3,O(P1))*S(4,8, P1 )
8334 BMM(P1,P2) = -B(O(P2))*M(4)*M(5)
8335 C--the C and E functions
8336 C(P1,P2) =CN(1)*(A( P2 )*( M2(2)*S(5,2,O(P1))*S(2,6, P1 )
8337 & +M2(3)*S(5,1,O(P1))*S(1,6, P1 ))
8338 & -A(O(P2))*M(2)*M(3)*( S(5,1,O(P1))*S(1,6, P1 )
8339 & +S(5,2,O(P1))*S(2,6, P1 )))
8340 E(P1,P2) =CN(2)*(B( P2 )*( M2(4)*S(7,4,O(P1))*S(4,8, P1 )
8341 & +M2(5)*S(7,3,O(P1))*S(3,8, P1 ))
8342 & -B(O(P2))*M(4)*M(5)*( S(7,3,O(P1))*S(3,8, P1 )
8343 & +S(7,4,O(P1))*S(4,8, P1 )))
8347 APM(P1,P2) = A( P2 )*M(2)*S(2,6,O(P1))
8348 AMP(P1,P2) =-A(O(P2))*M(3)*S(5,1,O(P1))
8351 BPM(P1,P2) = B( P2 )*M(4)*S(4,8,O(P1))
8352 BMP(P1,P2) =-B(O(P2))*M(5)*S(7,3,O(P1))
8354 C--the C and D functions
8355 C(P1,P2) =CN(1)*( A( P2 )*M(2)*( M2(3)*S(5,6,O(P1))
8356 & +S(5,1,O(P1))*S(1,2, P1 )*S(2,6,O(P1)))
8357 & -A(O(P2))*M(3)*( M2(2)*S(5,6,O(P1))
8358 & +S(5,1,O(P1))*S(1,2, P1 )*S(2,6,O(P1))))
8359 E(P1,P2) =CN(2)*( B( P2 )*M(4)*( M2(5)*S(7,8,O(P1))
8360 & +S(7,3,O(P1))*S(3,4, P1 )*S(4,8,O(P1)))
8361 & -B(O(P2))*M(5)*( M2(4)*S(7,8,O(P1))
8362 & +S(7,3,O(P1))*S(3,4, P1 )*S(4,8,O(P1))))
8365 C--now put the whole thing together to give the matrix element
8373 & APP(P1,P2)*(S(1,3,P1)*(BPP(P3,P4)*S(4,2,P0)+BMP(P3,P4)*S(8,2,P0))
8374 & +S(7,2,P0)*(BPM(P3,P4)*S(1,4,P1)+BMM(P3,P4)*S(1,8,P1)))
8375 &+APM(P1,P2)*(S(5,7,P0)*(BPM(P3,P4)*S(4,2,P1)+BMM(P3,P4)*S(8,2,P1))
8376 & +S(3,2,P1)*(BPP(P3,P4)*S(5,4,P0)+BMP(P3,P4)*S(5,8,P0)))
8377 &+AMP(P1,P2)*(S(1,3,P1)*(BPP(P3,P4)*S(4,6,P0)+BMP(P3,P4)*S(8,6,P0))
8378 & +S(7,6,P0)*(BPM(P3,P4)*S(1,4,P1)+BMM(P3,P4)*S(1,8,P1)))
8379 &+AMM(P1,P2)*(S(3,6,P1)*(BPP(P3,P4)*S(5,4,P0)+BMP(P3,P4)*S(5,8,P0))
8380 & +S(5,7,P0)*(BPM(P3,P4)*S(4,6,P1)+BMM(P3,P4)*S(8,6,P1)))
8383 & APP(P1,P2)*(S(3,2,P0)*(BPP(P3,P4)*S(1,4,P1)+BMP(P3,P4)*S(1,8,P1))
8384 & +S(1,7,P1)*(BPM(P3,P4)*S(4,2,P0)+BMM(P3,P4)*S(8,2,P0)))
8385 &+APM(P1,P2)*(S(5,3,P0)*(BPP(P3,P4)*S(4,2,P1)+BMP(P3,P4)*S(8,2,P1))
8386 & +S(7,2,P1)*(BPM(P3,P4)*S(5,4,P0)+BMM(P3,P4)*S(5,8,P0)))
8387 &+AMP(P1,P2)*(S(3,6,P0)*(BPP(P3,P4)*S(1,4,P1)+BMP(P3,P3)*S(1,8,P1))
8388 & +S(1,7,P1)*(BPM(P3,P4)*S(4,6,P0)+BMM(P3,P4)*S(8,6,P0)))
8389 &+AMM(P1,P2)*(S(5,3,P0)*(BPP(P3,P4)*S(4,6,P1)+BMP(P3,P4)*S(8,6,P1))
8390 & +S(7,6,P1)*(BPM(P3,P4)*S(5,4,P0)+BMM(P3,P4)*S(5,8,P0)))
8392 ME(P1,P2,P3,P4) = TWO*ME(P1,P2,P3,P4)
8394 & BPP(P3,P4)*F23(P3,P3,3,4)+BPM(P3,P4)*F23(O(P3),O(P3),7,4)
8395 & +BMP(P3,P4)*F23(P3,P3,3,8)+BMM(P3,P4)*F23(O(P3),O(P3),7,8))
8397 & APP(P1,P2)*F45(P1,P1,1,2)+APM(P1,P2)*F45(P0,P0,5,2)
8398 & +AMP(P1,P2)*F45(P1,P1,1,6)+AMM(P1,P2)*F45(P0,P0,5,6))
8399 & +DOT*C(P1,P2)*E(P3,P4)
8400 10 ME(P1,P2,P3,P4) = PRE*ME(P1,P2,P3,P4)
8401 C--compute the weight
8407 40 WGT = WGT+ME(P1,P2,P3,P4)*DCONJG(ME(P1,P2,P3,P4))
8408 C--normalise this for phase space
8410 C--enter the matrix element into the spin common block
8411 IF(GENEV.AND.SYSPIN) THEN
8417 11 MESPN(P1,P2,P3,P4,1,1) = ME(P1,P2,P3,P4)
8423 *CMZ :- -23/05/96 18.34.17 by Mike Seymour
8424 *-- Author : Mike Seymour
8425 C-----------------------------------------------------------------------
8426 SUBROUTINE HWDBOS(IBOSON)
8427 C-----------------------------------------------------------------------
8428 C DECAY GAUGE BOSONS (ALREADY FOUND BY HWDHAD)
8429 C USES SPIN DENSITY MATRIX IN RHOHEP (1ST CMPT=>-VE,2=>LONG,3=>+VE)
8430 C IF BOSON CAME FROM HIGGS DECAY, GIVE BOTH THE SAME HELICITY (EPR)
8431 C IF BOSON CAME FROM W+1JET, GIVE IT THE CORRECT DECAY CORRELATIONS
8432 C--BRW FIX 20/07/04: ADD FULL DECAY CORRELATIONS FOR W/Z+HIGGS
8433 C-----------------------------------------------------------------------
8434 INCLUDE 'HERWIG65.INC'
8435 DOUBLE PRECISION HWRGEN,HWRUNI,HWUPCM,HWULDO,R(3,3),CV,CA,BR,PCM,
8436 & PBOS(5),PMAX,PROB,RRLL,RLLR
8437 INTEGER HWRINT,IBOS,IBOSON,IPAIR,ICMF,IOPT,IHEL,IMOTH,
8440 EXTERNAL HWRGEN,HWRUNI,HWUPCM,HWULDO,HWRINT
8442 IF (IDHW(IBOS).LT.198.OR.IDHW(IBOS).GT.200)
8443 & CALL HWWARN('HWDBOS',101,*999)
8445 C---SEE IF IT IS PART OF A PAIR
8446 IMOTH=JMOHEP(1,IBOS)
8447 IPAIR=JMOHEP(2,IBOS)
8450 IF (IPAIR.EQ.IBOS) THEN
8452 IF (IPRO.EQ.26.OR.IPRO.EQ.27) ICMF=JMOHEP(1,IMOTH)
8454 IF (IDHW(ICMF).EQ.IDHW(IBOS).AND.ISTHEP(ICMF)/10.EQ.12) THEN
8455 IPAIR=JMOHEP(2,ICMF)
8456 IF (IPAIR.NE.0) THEN
8457 IPAIR=JDAHEP(1,IPAIR)
8458 IF (IPAIR.NE.0) JMOHEP(2,IPAIR)=IBOS
8463 IF (IPAIR.NE.0) THEN
8464 IF (JMOHEP(2,IPAIR).NE.IBOS.OR.
8465 & IDHW(IPAIR).LT.198.OR.IDHW(IPAIR).GT.200) IPAIR=0
8467 IF (IPAIR.GT.0.AND.IPAIR.NE.IBOS) IOPT=1
8470 C---SELECT DECAY PRODUCTS
8471 10 CALL HWDBOZ(IDHW(IBOS),IDN(1),IDN(2),CV,CA,BR,IOPT)
8472 C---V + 1JET, V+HIGGS DECAYS ARE NOW HANDLED HERE !
8473 IF (IPRO.EQ.21.OR.IPRO.EQ.26.OR.IPRO.EQ.27) THEN
8474 IQRK=IDHW(JMOHEP(1,ICMF))
8475 IANT=IDHW(JMOHEP(2,ICMF))
8476 IF (IQRK.EQ.13 .AND. IANT.LE.6) THEN
8479 ELSEIF (IQRK.EQ.13) THEN
8482 ELSEIF (IANT.EQ.13 .AND. IQRK.LE.6) THEN
8485 ELSEIF (IANT.EQ.13) THEN
8488 ELSEIF (IQRK.GT.IANT) THEN
8495 PHEP(5,NHEP+1)=RMASS(IDN(1))
8496 PHEP(5,NHEP+2)=RMASS(IDN(2))
8497 PCM=HWUPCM(PHEP(5,IBOS),PHEP(5,NHEP+1),PHEP(5,NHEP+2))
8498 IF (PCM.LT.ZERO) CALL HWWARN('HWDBOS',103,*999)
8499 IF (IDHW(IBOS).EQ.200) THEN
8501 IF (ID.GT.120) ID=ID-110
8503 IF (IQ.GT.6) IQ=IQ-6
8504 RRLL=(VFCH(IQ,1)**2+AFCH(IQ,1)**2)*
8505 $ (VFCH(ID,1)**2+AFCH(ID,1)**2)
8506 $ +4*VFCH(IQ,1)*AFCH(IQ,1)*
8507 $ VFCH(ID,1)*AFCH(ID,1)
8508 RLLR=(VFCH(IQ,1)**2+AFCH(IQ,1)**2)*
8509 $ (VFCH(ID,1)**2+AFCH(ID,1)**2)
8510 $ -4*VFCH(IQ,1)*AFCH(IQ,1)*
8511 $ VFCH(ID,1)*AFCH(ID,1)
8516 IF (IPRO.EQ.21) THEN
8517 PMAX=(RRLL+RLLR)*(HWULDO(PHEP(1,IANT),PHEP(1,IBOS))**2+
8518 & HWULDO(PHEP(1,IQRK),PHEP(1,IBOS))**2)
8520 PMAX=(RRLL+RLLR)* HWULDO(PHEP(1,IANT),PHEP(1,IBOS))*
8521 & HWULDO(PHEP(1,IQRK),PHEP(1,IBOS))
8523 1 CALL HWDTWO(PHEP(1,IBOS),PHEP(1,NHEP+1),PHEP(1,NHEP+2),
8525 IF (IPRO.EQ.21) THEN
8526 PROB=RRLL*(HWULDO(PHEP(1,IANT),PHEP(1,NHEP+1))**2+
8527 & HWULDO(PHEP(1,IQRK),PHEP(1,NHEP+2))**2)+
8528 & RLLR*(HWULDO(PHEP(1,IANT),PHEP(1,NHEP+2))**2+
8529 & HWULDO(PHEP(1,IQRK),PHEP(1,NHEP+1))**2)
8531 PROB=RRLL* HWULDO(PHEP(1,IANT),PHEP(1,NHEP+1))*
8532 & HWULDO(PHEP(1,IQRK),PHEP(1,NHEP+2))+
8533 & RLLR* HWULDO(PHEP(1,IANT),PHEP(1,NHEP+2))*
8534 & HWULDO(PHEP(1,IQRK),PHEP(1,NHEP+1))
8536 IF (PROB.GT.PMAX.OR.PROB.LT.ZERO)
8537 & CALL HWWARN('HWDBOS',104,*999)
8538 IF (PMAX*HWRGEN(0).GT.PROB) GOTO 1
8540 C---SELECT HELICITY, UNLESS IT IS THE SECOND OF A HIGGS DECAY (EPR)
8541 IF (IPAIR.NE.IBOS .OR. IDHW(ICMF).NE.201) THEN
8542 IF (RHOHEP(1,IBOS)+RHOHEP(2,IBOS)+RHOHEP(3,IBOS).LE.ZERO) THEN
8543 C---COPY PARENT HELICITY IF IT WAS A GAUGE BOSON
8544 IF (IDHW(IMOTH).GE.198.AND.IDHW(IMOTH).LE.200) THEN
8545 CALL HWVEQU(3,RHOHEP(1,IMOTH),RHOHEP(1,IBOS))
8546 IF (RHOHEP(1,IBOS)+RHOHEP(2,IBOS)+RHOHEP(3,IBOS).GT.ZERO)
8548 C---MAY BE FROM A SUSY DECAY
8549 ELSEIF (ABS(IDHEP(IMOTH)).LT.1000000) THEN
8550 CALL HWWARN('HWDBOS',1,*999)
8557 IF (HWRGEN(0).GT.RHOHEP(IHEL,IBOS)) GOTO 20
8559 C---SELECT DIRECTION OF FERMION
8560 30 COSTH=HWRUNI(0,-ONE,ONE)
8561 IF (IHEL.EQ.1 .AND. (ONE+COSTH)**2.LT.HWRGEN(0)*FOUR) GOTO 30
8562 IF (IHEL.EQ.2 .AND. (ONE-COSTH**2).LT.HWRGEN(0) ) GOTO 30
8563 IF (IHEL.EQ.3 .AND. (ONE-COSTH)**2.LT.HWRGEN(0)*FOUR) GOTO 30
8564 C---GENERATE DECAY RELATIVE TO Z-AXIS
8565 PHEP(5,NHEP+1)=RMASS(IDN(1))
8566 PHEP(5,NHEP+2)=RMASS(IDN(2))
8567 PCM=HWUPCM(PHEP(5,IBOS),PHEP(5,NHEP+1),PHEP(5,NHEP+2))
8568 IF (PCM.LT.ZERO) CALL HWWARN('HWDBOS',102,*999)
8569 CALL HWRAZM(PCM*SQRT(1-COSTH**2),PHEP(1,NHEP+1),PHEP(2,NHEP+1))
8570 PHEP(3,NHEP+1)=PCM*COSTH
8571 PHEP(4,NHEP+1)=SQRT(PHEP(5,NHEP+1)**2+PCM**2)
8572 C---ROTATE SO THAT Z-AXIS BECOMES BOSON'S DIRECTION IN ORIGINAL CM FRAME
8573 CALL HWULOF(PHEP(1,ICMF),PHEP(1,IBOS),PBOS)
8574 CALL HWUROT(PBOS, ONE,ZERO,R)
8575 CALL HWUROB(R,PHEP(1,NHEP+1),PHEP(1,NHEP+1))
8576 C---BOOST BACK TO LAB
8577 CALL HWULOB(PHEP(1,IBOS),PHEP(1,NHEP+1),PHEP(1,NHEP+1))
8578 CALL HWVDIF(4,PHEP(1,IBOS),PHEP(1,NHEP+1),PHEP(1,NHEP+2))
8580 C---STATUS, IDs AND POINTERS
8585 IDHEP(NHEP+I)=IDPDG(IDN(I))
8586 JDAHEP(I,IBOS)=NHEP+I
8587 JMOHEP(1,NHEP+I)=IBOS
8588 JMOHEP(2,NHEP+I)=JMOHEP(1,IBOS)
8591 IF (IDN(1).LE.12) THEN
8594 JMOHEP(2,NHEP)=NHEP-1
8595 JDAHEP(2,NHEP)=NHEP-1
8596 JMOHEP(2,NHEP-1)=NHEP
8597 JDAHEP(2,NHEP-1)=NHEP
8600 C--MHS FIX 07/03/05 - VERTEX POSITION FOR DECAYS TO LEPTONS
8601 CALL HWVEQU(4,VTXPIP,VHEP(1,NHEP-1))
8602 CALL HWVEQU(4,VTXPIP,VHEP(1,NHEP))
8605 C---IF FIRST OF A PAIR, DO SECOND DECAY
8606 IF (IPAIR.NE.0 .AND. IPAIR.NE.IBOS) THEN
8610 C---IF QUARK DECAY, HADRONIZE
8620 *CMZ :- -29/04/91 18.00.03 by Federico Carminati
8621 *-- Author : Mike Seymour
8622 C-----------------------------------------------------------------------
8623 SUBROUTINE HWDBOZ(IDBOS,IFER,IANT,CV,CA,BR,IOPT)
8624 C-----------------------------------------------------------------------
8625 C CHOOSE DECAY MODE OF BOSON
8626 C IOPT=2 TO RESET COUNTERS, 1 FOR BOSON PAIR, 0 FOR ANY OTHERS
8627 C-----------------------------------------------------------------------
8628 INCLUDE 'HERWIG65.INC'
8629 DOUBLE PRECISION HWRGEN,BRMODE(12,3),CV,CA,BR,BRLST,BRCOM,FACZ,
8631 INTEGER HWRINT,IDBOS,IDEC,IDMODE(2,12,3),IFER,IANT,IOPT,I1,I2,
8632 & I1LST,I2LST,NWGLST,NUMDEC,NPAIR,MODTMP,JFER
8634 EXTERNAL HWRGEN,HWRINT
8635 SAVE FACW,FACZ,NWGLST,GENLST,NUMDEC,NPAIR,I1LST,I2LST,BRLST
8636 DATA NWGLST,GENLST,NPAIR/-1,.FALSE.,0/
8637 C---STORE THE DECAY MODES (FERMION FIRST)
8638 DATA IDMODE/ 2, 7, 4, 9, 6, 11, 2, 9, 4, 7,
8639 & 122,127,124,129,126,131,8*0,
8640 & 1, 8, 3, 10, 5, 12, 3, 8, 1, 10,
8641 & 121,128,123,130,125,132,8*0,
8642 & 1, 7, 2, 8, 3, 9, 4, 10, 5, 11, 6, 12,
8643 & 121,127,123,129,125,131,122,128,124,130,126,132/
8644 C---STORE THE BRANCHING RATIOS TO THESE MODES
8645 DATA BRMODE/0.321D0,0.321D0,0.000D0,0.017D0,0.017D0,0.108D0,
8646 & 0.108D0,0.108D0,4*0.0D0,
8647 & 0.321D0,0.321D0,0.000D0,0.017D0,0.017D0,0.108D0,
8648 & 0.108D0,0.108D0,4*0.0D0,
8649 & 0.154D0,0.120D0,0.154D0,0.120D0,0.152D0,0.000D0,
8650 & 0.033D0,0.033D0,0.033D0,0.067D0,0.067D0,0.067D0/
8651 C---FACTORS FOR CV AND CA FOR W AND Z
8652 DATA FACW,FACZ/2*0.0D0/
8653 IF (FACZ.EQ.ZERO) FACZ=SQRT(SWEIN)
8654 IF (FACW.EQ.ZERO) FACW=0.5/SQRT(2D0)
8655 IF (IDBOS.LT.198.OR.IDBOS.GT.200) CALL HWWARN('HWDBOZ',101,*999)
8656 C---IF THIS IS A NEW EVENT SINCE LAST TIME, ZERO COUNTERS
8657 IF (NWGTS.NE.NWGLST .OR.(GENEV.NEQV.GENLST).OR. IOPT.EQ.2) THEN
8662 IF (IOPT.EQ.2) RETURN
8665 IF (NUMDEC.GT.MODMAX) CALL HWWARN('HWDBOZ',102,*999)
8666 C---IF PAIR OPTION SPECIFIED FOR THE FIRST TIME, MAKE CHOICE
8668 IF (NUMDEC.GT.MODMAX-1) CALL HWWARN('HWDBOZ',103,*999)
8669 IF (NPAIR.EQ.0) THEN
8670 IF (HWRGEN(1).GT.HALF) THEN
8671 MODTMP=MODBOS(NUMDEC+1)
8672 MODBOS(NUMDEC+1)=MODBOS(NUMDEC)
8673 MODBOS(NUMDEC)=MODTMP
8680 C---SELECT USER'S CHOICE
8681 IF (IDBOS.EQ.200) THEN
8682 IF (MODBOS(NUMDEC).EQ.1) THEN
8685 ELSEIF (MODBOS(NUMDEC).EQ.2) THEN
8688 ELSEIF (MODBOS(NUMDEC).EQ.3) THEN
8691 ELSEIF (MODBOS(NUMDEC).EQ.4) THEN
8694 ELSEIF (MODBOS(NUMDEC).EQ.5) THEN
8697 ELSEIF (MODBOS(NUMDEC).EQ.6) THEN
8700 ELSEIF (MODBOS(NUMDEC).EQ.7) THEN
8708 IF (MODBOS(NUMDEC).EQ.1) THEN
8711 ELSEIF (MODBOS(NUMDEC).EQ.2) THEN
8714 ELSEIF (MODBOS(NUMDEC).EQ.3) THEN
8717 ELSEIF (MODBOS(NUMDEC).EQ.4) THEN
8720 ELSEIF (MODBOS(NUMDEC).EQ.5) THEN
8728 10 IDEC=HWRINT(I1,I2)
8729 IF (HWRGEN(0).GT.BRMODE(IDEC,IDBOS-197).AND.I1.NE.I2) GOTO 10
8730 IFER=IDMODE(1,IDEC,IDBOS-197)
8731 IANT=IDMODE(2,IDEC,IDBOS-197)
8732 C---CALCULATE BRANCHING RATIO
8733 C (RESULT IS NOT WELL-DEFINED AFTER THE FIRST CALL OF A PAIR)
8736 20 BR=BR+BRMODE(IDEC,IDBOS-197)
8738 IF (NPAIR.NE.0) THEN
8744 DO 30 IDEC=MAX(I1,I1LST),MIN(I2,I2LST)
8745 30 BRCOM=BRCOM+BRMODE(IDEC,IDBOS-197)
8746 BR=2*BR*BRLST - BRCOM**2
8749 C---SET UP VECTOR AND AXIAL VECTOR COUPLINGS (NORMALIZED TO THE
8750 C CONVENTION WHERE THE WEAK CURRENT IS G*(CV-CA*GAM5) )
8751 IF (IDBOS.EQ.200) THEN
8770 *CMZ :- -02/04/01 12.11.55 by Peter Richardson
8771 *-- Author : Peter Richardson based on Mike Seymour's HWDBOZ
8772 C-----------------------------------------------------------------------
8773 SUBROUTINE HWDBZ2(IDBOS,IFER,IANT,CV,CA,BR,IOPT,MASS)
8774 C-----------------------------------------------------------------------
8775 C CHOOSE DECAY MODE OF BOSON
8776 C IOPT=2 TO RESET COUNTERS, 1 FOR BOSON PAIR, 0 FOR ANY OTHERS
8777 C IDENTICAL TO HWDBOZ BUT REQUIRES DECAY MODE ACCESSIBLE FOR GIVEN
8779 C-----------------------------------------------------------------------
8780 INCLUDE 'HERWIG65.INC'
8781 DOUBLE PRECISION HWRGEN,BRMODE(12,3),CV,CA,BR,BRLST,BRCOM,FACZ,
8782 & FACW,MSMODE(12,3),MASS
8783 INTEGER HWRINT,IDBOS,IDEC,IDMODE(2,12,3),IFER,IANT,IOPT,I1,I2,
8784 & I1LST,I2LST,NWGLST,NUMDEC,NPAIR,MODTMP,JFER,NTRY
8786 EXTERNAL HWRGEN,HWRINT
8787 SAVE FACW,FACZ,MSMODE,NWGLST,GENLST,NUMDEC,NPAIR,I1LST,I2LST,BRLST
8788 DATA NWGLST,GENLST,NPAIR/-1,.FALSE.,0/
8789 C---STORE THE DECAY MODES (FERMION FIRST)
8790 DATA IDMODE/ 2, 7, 4, 9, 6, 11, 2, 9, 4, 7,
8791 & 122,127,124,129,126,131,8*0,
8792 & 1, 8, 3, 10, 5, 12, 3, 8, 1, 10,
8793 & 121,128,123,130,125,132,8*0,
8794 & 1, 7, 2, 8, 3, 9, 4, 10, 5, 11, 6, 12,
8795 & 121,127,123,129,125,131,122,128,124,130,126,132/
8796 C---STORE THE BRANCHING RATIOS TO THESE MODES
8797 DATA BRMODE/0.321D0,0.321D0,0.000D0,0.017D0,0.017D0,0.108D0,
8798 & 0.108D0,0.108D0,4*0.0D0,
8799 & 0.321D0,0.321D0,0.000D0,0.017D0,0.017D0,0.108D0,
8800 & 0.108D0,0.108D0,4*0.0D0,
8801 & 0.154D0,0.120D0,0.154D0,0.120D0,0.152D0,0.000D0,
8802 & 0.033D0,0.033D0,0.033D0,0.067D0,0.067D0,0.067D0/
8803 DATA MSMODE/36*0.0D0/
8804 C---FACTORS FOR CV AND CA FOR W AND Z
8805 DATA FACW,FACZ/2*0.0D0/
8806 IF (FACZ.EQ.ZERO) FACZ=SQRT(SWEIN)
8807 IF (FACW.EQ.ZERO) FACW=0.5/SQRT(2D0)
8808 IF (IDBOS.LT.198.OR.IDBOS.GT.200) CALL HWWARN('HWDBZ2',101,*999)
8809 IF(MSMODE(1,1).EQ.ZERO) THEN
8812 MSMODE(I1,I2)=RMASS(IDMODE(1,I1,I2))+RMASS(IDMODE(2,I1,I2))
8816 C---IF THIS IS A NEW EVENT SINCE LAST TIME, ZERO COUNTERS
8817 IF (NWGTS.NE.NWGLST .OR.(GENEV.NEQV.GENLST).OR. IOPT.EQ.2) THEN
8822 IF (IOPT.EQ.2) RETURN
8825 IF (NUMDEC.GT.MODMAX) CALL HWWARN('HWDBZ2',102,*999)
8826 C---IF PAIR OPTION SPECIFIED FOR THE FIRST TIME, MAKE CHOICE
8828 IF (NUMDEC.GT.MODMAX-1) CALL HWWARN('HWDBZ2',103,*999)
8829 IF (NPAIR.EQ.0) THEN
8830 IF (HWRGEN(1).GT.HALF) THEN
8831 MODTMP=MODBOS(NUMDEC+1)
8832 MODBOS(NUMDEC+1)=MODBOS(NUMDEC)
8833 MODBOS(NUMDEC)=MODTMP
8840 C---SELECT USER'S CHOICE
8841 IF (IDBOS.EQ.200) THEN
8842 IF (MODBOS(NUMDEC).EQ.1) THEN
8845 ELSEIF (MODBOS(NUMDEC).EQ.2) THEN
8848 ELSEIF (MODBOS(NUMDEC).EQ.3) THEN
8851 ELSEIF (MODBOS(NUMDEC).EQ.4) THEN
8854 ELSEIF (MODBOS(NUMDEC).EQ.5) THEN
8857 ELSEIF (MODBOS(NUMDEC).EQ.6) THEN
8860 ELSEIF (MODBOS(NUMDEC).EQ.7) THEN
8868 IF (MODBOS(NUMDEC).EQ.1) THEN
8871 ELSEIF (MODBOS(NUMDEC).EQ.2) THEN
8874 ELSEIF (MODBOS(NUMDEC).EQ.3) THEN
8877 ELSEIF (MODBOS(NUMDEC).EQ.4) THEN
8880 ELSEIF (MODBOS(NUMDEC).EQ.5) THEN
8889 10 IDEC=HWRINT(I1,I2)
8891 IF (HWRGEN(0).GT.BRMODE(IDEC,IDBOS-197).AND.I1.NE.I2) GOTO 10
8892 IF(MASS.LT.MSMODE(IDEC,IDBOS-197).AND.NTRY.LT.NBTRY) GOTO 10
8893 IF(NTRY.GE.NBTRY) THEN
8897 IFER=IDMODE(1,IDEC,IDBOS-197)
8898 IANT=IDMODE(2,IDEC,IDBOS-197)
8899 C---CALCULATE BRANCHING RATIO
8900 C (RESULT IS NOT WELL-DEFINED AFTER THE FIRST CALL OF A PAIR)
8903 20 IF(MSMODE(IDEC,IDBOS-197).LT.MASS) BR=BR+BRMODE(IDEC,IDBOS-197)
8905 IF (NPAIR.NE.0) THEN
8911 DO 30 IDEC=MAX(I1,I1LST),MIN(I2,I2LST)
8912 30 IF(MSMODE(IDEC,IDBOS-197).LT.MASS)
8913 & BRCOM=BRCOM+BRMODE(IDEC,IDBOS-197)
8914 BR=2*BR*BRLST - BRCOM**2
8917 C---SET UP VECTOR AND AXIAL VECTOR COUPLINGS (NORMALIZED TO THE
8918 C CONVENTION WHERE THE WEAK CURRENT IS G*(CV-CA*GAM5) )
8919 IF (IDBOS.EQ.200) THEN
8938 *CMZ :- -27/07/99 13.33.03 by Mike Seymour
8939 *-- Author : Ian Knowles
8940 C-----------------------------------------------------------------------
8941 SUBROUTINE HWDCHK(IDKY,L,*)
8942 C-----------------------------------------------------------------------
8943 C Checks line L of decay table is compatible with decay of particle
8944 C IDKY, tidies up the line and sets NPRODS.
8945 C-----------------------------------------------------------------------
8946 INCLUDE 'HERWIG65.INC'
8947 DOUBLE PRECISION EPS,QS,Q,DM
8948 INTEGER IDKY,L,IFAULT,I,ID,J
8949 PARAMETER (EPS=1.D-6)
8950 IF (VTOCDK(IDKY).AND.VTORDK(IDKY)) RETURN 1
8952 QS=FLOAT(ICHRG(IDKY))
8953 IF (IDKY.LE.12.OR.(IDKY.GE.109.AND.IDKY.LE.120)
8954 & .OR.(IDKY.GE.209.AND.IDKY.LE.220)
8955 & .OR.(IDKY.GE.401.AND.IDKY.LE.424)) QS=QS/3.
8960 IF (ID.LT.0.OR.ID.EQ.20.OR.ID.GT.NRES) THEN
8961 WRITE(6,20) L,RNAME(IDKY),(RNAME(IDKPRD(J,L)),J=1,5)
8963 ELSEIF (ID.NE.0) THEN
8964 IF (VTORDK(ID)) THEN
8965 WRITE(6,30) L,RNAME(IDKY),(RNAME(IDKPRD(J,L)),J=1,5),RNAME(ID)
8968 NPRODS(L)=NPRODS(L)+1
8969 IDKPRD(NPRODS(L),L)=ID
8971 IF (ID.LE.12.OR.(ID.GE.109.AND.ID.LE.120)
8972 & .OR.(ID.GE.209.AND.ID.LE.220)
8973 & .OR.(ID.GE.401.AND.ID.LE.424)) Q=Q/3.
8978 C print any warnings
8979 IF (NPRODS(L).EQ.0) THEN
8980 WRITE(6,20) L,RNAME(IDKY),(RNAME(IDKPRD(I,L)),I=1,5)
8983 IF (ABS(QS).GT.EPS) THEN
8984 WRITE(6,40) L,RNAME(IDKY),(RNAME(IDKPRD(I,L)),I=1,5),QS
8987 C--modification so doesn't remove H --> W*W* Z*Z* modes
8988 IF (DM.LT.ZERO.AND..NOT.
8989 & (FOURB.AND.IDK(L).GE.203.AND.IDK(L).LE.205.AND.
8990 & IDKPRD(1,L).GE.198.AND.IDKPRD(2,L).LE.200.AND.
8991 & IDKPRD(2,L).GE.198.AND.IDKPRD(2,L).LE.200)) THEN
8992 WRITE(6,50) L,RNAME(IDKY),(RNAME(IDKPRD(I,L)),I=1,5),DM
8996 20 FORMAT(1X,'Line ',I4,' decay: ',A8,' --> ',4(A8,1X),A8/
8997 & 1X,'contains no or unrecognised decay product(s)')
8998 30 FORMAT(1X,'Line ',I4,' decay: ',A8,' --> ',4(A8,1X),A8/
8999 & 1X,'contains decay product ',A8,' which is vetoed')
9000 40 FORMAT(1X,'Line ',I4,' decay: ',A8,' --> ',4(A8,1X),A8/
9001 & 1X,'violates charge conservation, Qin-Qout= ',F6.3)
9002 50 FORMAT(1X,'Line ',I4,' decay: ',A8,' --> ',4(A8,1X),A8/
9003 & 1X,'is kinematically not allowed, Min-Mout= ',F10.3)
9004 IF (IFAULT.NE.0) THEN
9011 *CMZ :- -28/01/92 12.34.44 by Mike Seymour
9012 *-- Author : Luca Stanco
9013 C-----------------------------------------------------------------------
9014 SUBROUTINE HWDCLE(IHEP)
9015 C-----------------------------------------------------------------------
9016 C INTERFACE TO QQ-CLEO MONTE CARLO (LS 11/12/91)
9017 C-----------------------------------------------------------------------
9018 INCLUDE 'HERWIG65.INC'
9019 INTEGER IHEP,IIHEP,NHEPHF,QQLMAT
9023 C---QQ-CLEO COMMON'S
9025 INTEGER MCTRK, NTRKS, MCVRTX, NVTXS, MCHANS, MCDTRS, MPOLQQ
9026 INTEGER MCNUM, MCSTBL, MCSTAB, MCTLQQ, MDECQQ
9027 INTEGER MHLPRB, MHLLST, MHLANG, MCPLST, MFDECA
9028 PARAMETER (MCTRK = 512)
9029 PARAMETER (NTRKS = MCTRK)
9030 PARAMETER (MCVRTX = 256)
9031 PARAMETER (NVTXS = MCVRTX)
9032 PARAMETER (MCHANS = 4000)
9033 PARAMETER (MCDTRS = 8000)
9034 PARAMETER (MPOLQQ = 300)
9035 PARAMETER (MCNUM = 500)
9036 PARAMETER (MCSTBL = 40)
9037 PARAMETER (MCSTAB = 512)
9038 PARAMETER (MCTLQQ = 100)
9039 PARAMETER (MDECQQ = 300)
9040 PARAMETER (MHLPRB = 500)
9041 PARAMETER (MHLLST = 1000)
9042 PARAMETER (MHLANG = 500)
9043 PARAMETER (MCPLST = 200)
9044 PARAMETER (MFDECA = 5)
9046 REAL AMASS, CHARGE, CTAU, SPIN, RWIDTH, RMASMN, RMASMX
9048 INTEGER NPMNQQ, NPMXQQ, IDMC, INVMC, LPARTY, CPARTY
9049 INTEGER IMIXPP, ICPMIX
9052 * AMASS(-20:MCNUM), CHARGE(-20:MCNUM), CTAU(-20:MCNUM),
9053 * IDMC(-20:MCNUM), SPIN(-20:MCNUM),
9054 * RWIDTH(-20:MCNUM), RMASMN(-20:MCNUM), RMASMX(-20:MCNUM),
9055 * LPARTY(-20:MCNUM), CPARTY(-20:MCNUM),
9056 * IMIXPP(-20:MCNUM), RMIXPP(-20:MCNUM),
9057 * ICPMIX(-20:MCNUM), RCPMIX(-20:MCNUM),
9060 INTEGER NPOLQQ, IPOLQQ
9062 * NPOLQQ, IPOLQQ(5,MPOLQQ)
9064 CHARACTER QNAME*10, PNAME*10
9066 * QNAME(37), PNAME(-20:MCNUM)
9069 INTEGER NCTLQQ, NDECQQ, IVRSQQ, IORGQQ, IRS1QQ
9070 INTEGER IEVTQQ, IRUNQQ, IBMRAD
9071 INTEGER NTRKMC, QQNTRK, NSTBMC, NSTBQQ, NCHGMC, NCHGQQ
9072 INTEGER IRANQQ, IRANMC, IRANCC, IRS2QQ
9073 INTEGER IPFTQQ, IPCDQQ, IPRNTV, ITYPEV, IDECSV, IDAUTV
9074 INTEGER ISTBMC, NDAUTV
9075 INTEGER IVPROD, IVDECA
9077 REAL ENERQQ, BEAMQQ, BMPSQQ, BMNGQQ, EWIDQQ, BWPSQQ, BWNGQQ
9079 REAL ECM, P4CMQQ, P4PHQQ, ENERNW, BEAMNW, BEAMP, BEAMN
9080 REAL PSAV, P4QQ, HELCQQ
9081 CHARACTER DATEQQ*20, TIMEQQ*20, FOUTQQ*80, FCTLQQ*80, FDECQQ*80
9083 CHARACTER CCTLQQ*80, CDECQQ*80
9086 * NCTLQQ, NDECQQ, IVRSQQ, IORGQQ, IRS1QQ(3), BFLDQQ,
9087 * ENERQQ, BEAMQQ, BMPSQQ, BMNGQQ, EWIDQQ, BWPSQQ, BWNGQQ,
9088 * BPOSQQ(3), BSIZQQ(3),
9090 * IBMRAD, ECM, P4CMQQ(4), P4PHQQ(4),
9091 * ENERNW, BEAMNW, BEAMP, BEAMN,
9092 * NTRKMC, QQNTRK, NSTBMC, NSTBQQ, NCHGMC, NCHGQQ,
9093 * IRANQQ(2), IRANMC(2), IRANCC(2), IRS2QQ(5),
9094 * IPFTQQ(MCTRK), IPCDQQ(MCTRK), IPRNTV(MCTRK), ITYPEV(MCTRK,2),
9095 * IDECSV(MCTRK), IDAUTV(MCTRK), ISTBMC(MCTRK), NDAUTV(MCTRK),
9096 * IVPROD(MCTRK), IVDECA(MCTRK),
9097 * PSAV(MCTRK,4), HELCQQ(MCTRK), P4QQ(4,MCTRK)
9100 * DATEQQ, TIMEQQ, FOUTQQ, FCTLQQ, FDECQQ, FGEOQQ,
9101 * CCTLQQ(MCTLQQ), CDECQQ(MDECQQ)
9106 INTEGER IFINAL(MCTRK), IFINSV(MCSTAB), NFINAL
9107 EQUIVALENCE (IFINAL,ISTBMC), (IFINSV,IDSTBL), (NFINAL,NSTBMC)
9109 INTEGER NVRTX, ITRKIN, NTRKOU, ITRKOU, IVKODE
9110 REAL XVTX, TVTX, RVTX
9112 * NVRTX, XVTX(MCVRTX,3), TVTX(MCVRTX), RVTX(MCVRTX),
9113 * ITRKIN(MCVRTX), NTRKOU(MCVRTX), ITRKOU(MCVRTX),
9116 INTEGER QQIST,QQIFR,QQN,QQK,QQMESO,QQNC,QQKC,QQLASTN
9117 REAL QQPUD,QQPS1,QQSIGM,QQMAS,QQPAR,QQCMIX,QQCND,QQBSPI,QQBSYM,QQP
9120 COMMON/DATA1/QQIST,QQIFR,QQPUD,QQPS1,QQSIGM,QQMAS(15),QQPAR(25)
9121 COMMON/DATA2/QQCZF(15),QQMESO(36),QQCMIX(6,2)
9122 COMMON/DATA3/QQCND(3)
9123 COMMON/DATA5/QQBSPI(5),QQBSYM(3)
9124 COMMON/JET/QQN,QQK(250,2),QQP(250,5),QQNC,QQKC(10),QQPC(10,4),
9128 C---INITIALIZE QQ-CLEO
9130 IF(QQLERR) CALL HWWARN('HWDEUR',500,*999)
9132 C---CONSTRUCT THE HADRON FOR QQ-CLEO
9133 C NOTE: THE IDPDG CODE IS PROVIDED THROUGH THE QQLMAT ROUTINE
9134 C FROM THE CLEO PACKAGE (QQ-CLEO <--> IDPDG CODE TRANSFORMATION)
9136 IDHEP(IHEP)=IDPDG(IDHW(IHEP))
9138 QQK(1,2)=QQLMAT(IDHEP(IHEP),1)
9139 QQP(1,1)=PHEP(1,IHEP)
9140 QQP(1,2)=PHEP(2,IHEP)
9141 QQP(1,3)=PHEP(3,IHEP)
9142 QQP(1,5)=AMASS(QQK(1,2))
9143 QQP(1,4)=SQRT(QQP(1,5)**2+QQP(1,1)**2+QQP(1,2)**2+QQP(1,3)**2)
9144 C---LET QQ-CLEO DO THE JOB
9147 CALL DECADD(.FALSE.)
9148 C---UPDATE THE HERWIG TABLE : LOOP OVER QQN-CLEO FINAL PARTICLES
9152 IF(ITYPEV(IIHEP,2).GE.0) ISTHEP(NHEP)=1
9153 IDHEP(NHEP)=QQLMAT(ITYPEV(IIHEP,1),2)
9154 CALL HWUIDT(1,IDHEP(NHEP),IDHW(NHEP),NAME)
9164 JMOHEP(1,NHEP)=IPRNTV(IIHEP)+NHEPHF-1
9165 JMOHEP(2,NHEP)=NHEPHF
9169 IF(NDAUTV(IIHEP).GT.0) THEN
9170 JDAHEP(1,NHEP)=IDAUTV(IIHEP)+NHEPHF-1
9171 JDAHEP(2,NHEP)=JDAHEP(1,NHEP)+NDAUTV(IIHEP)-1
9173 PHEP(1,NHEP)=QQP(IIHEP,1)
9174 PHEP(2,NHEP)=QQP(IIHEP,2)
9175 PHEP(3,NHEP)=QQP(IIHEP,3)
9176 PHEP(4,NHEP)=QQP(IIHEP,4)
9177 PHEP(5,NHEP)=QQP(IIHEP,5)
9178 VHEP(1,NHEP)=XVTX(IVPROD(IIHEP),1)
9179 VHEP(2,NHEP)=XVTX(IVPROD(IIHEP),2)
9180 VHEP(3,NHEP)=XVTX(IVPROD(IIHEP),3)
9185 *CMZ :- -28/01/92 12.34.44 by Mike Seymour
9186 *-- Author : Luca Stanco
9187 C-----------------------------------------------------------------------
9188 SUBROUTINE HWDEUR(IHEP)
9189 C-----------------------------------------------------------------------
9190 C INTERFACE TO EURODEC PACKAGE (LS 10/29/91)
9191 C-----------------------------------------------------------------------
9192 INCLUDE 'HERWIG65.INC'
9193 INTEGER IHEP,IIHEP,NHEPHF,IEUPDG,IPDGEU
9195 C---EURODEC COMMON'S : INITIAL INPUT
9196 INTEGER EULUN0,EULUN1,EULUN2,EURUN,EUEVNT
9197 CHARACTER*4 EUDATD,EUTIT
9198 REAL AMINIE(12),EUWEI
9199 COMMON/INPOUT/EULUN0,EULUN1,EULUN2
9200 COMMON/FILNAM/EUDATD,EUTIT
9201 COMMON/HVYINI/AMINIE
9202 COMMON/RUNINF/EURUN,EUEVNT,EUWEI
9203 C---EURODEC WORKING COMMON'S
9205 PARAMETER (NPMAX=18,NTMAX=2000)
9206 INTEGER EUNP,EUIP(NPMAX),EUPHEL(NPMAX),EUTEIL,EUINDX(NTMAX),
9207 & EUORIG(NTMAX),EUDCAY(NTMAX),EUTHEL(NTMAX)
9208 REAL EUAPM(NPMAX),EUPCM(5,NPMAX),EUPVTX(3,NPMAX),EUPTEI(5,NTMAX),
9210 COMMON/MOMGEN/EUNP,EUIP,EUAPM,EUPCM,EUPHEL,EUPVTX
9211 COMMON/RESULT/EUTEIL,EUPTEI,EUINDX,EUORIG,EUDCAY,EUTHEL,EUSECV
9212 C---EURODEC COMMON'S FOR DECAY PROPERTIES
9214 PARAMETER (NGMAX=400,NCMAX=9000)
9215 INTEGER EUNPA,EUIPC(NGMAX),EUIPDG(NGMAX),EUIDP(NGMAX),
9217 REAL EUPM(NGMAX),EUPLT(NGMAX)
9218 COMMON/PCTABL/EUNPA,EUIPC,EUIPDG,EUPM,EUPLT,EUIDP
9219 COMMON/CONVRT/EUCONV
9222 C---CHANGE HERE THE DEFAULT VALUES OF EURODEC COMMON'S
9224 C---INITIALIZE EURODEC COMMON'S
9226 C---INITIALIZE EURODEC
9229 C---CONSTRUCT THE HADRON FOR EURODEC FROM ID1,ID2
9231 IDHEP(IHEP)=IDPDG(IDHW(IHEP))
9232 EUIP(1)=IPDGEU(IDHEP(IHEP))
9233 EUAPM(1)=EUPM(EUCONV(IABS(EUIP(1))))
9234 EUPCM(1,1)=PHEP(1,IHEP)
9235 EUPCM(2,1)=PHEP(2,IHEP)
9236 EUPCM(3,1)=PHEP(3,IHEP)
9237 EUPCM(5,1)=SQRT(PHEP(1,IHEP)**2+PHEP(2,IHEP)**2+PHEP(3,IHEP)**2)
9238 EUPCM(4,1)=SQRT(EUPCM(5,1)**2+EUAPM(1)**2)
9239 C NOT POLARIZED HADRONS
9241 C HADRONS START FROM PRIMARY VERTEX
9245 C---LET EURODEC DO THE JOB
9248 C---UPDATE THE HERWIG TABLE : LOOP OVER N-EURODEC FINAL PARTICLES
9249 DO 40 IIHEP=1,EUTEIL
9252 IF(EUDCAY(IIHEP).EQ.0) ISTHEP(NHEP)=1
9253 IDHEP(NHEP)=IEUPDG(EUINDX(IIHEP))
9254 CALL HWUIDT(1,IDHEP(NHEP),IDHW(NHEP),NAME)
9263 JDAHEP(1,NHEP)=EUDCAY(IIHEP)/10000+NHEPHF-1
9264 JDAHEP(2,NHEP)=MOD(EUDCAY(IIHEP),10000)+NHEPHF-1
9266 JMOHEP(1,NHEP)=MOD(EUORIG(IIHEP),10000)+NHEPHF-1
9267 JMOHEP(2,NHEP)=NHEPHF
9268 JDAHEP(1,NHEP)=EUDCAY(IIHEP)/10000+NHEPHF-1
9269 JDAHEP(2,NHEP)=MOD(EUDCAY(IIHEP),10000)+NHEPHF-1
9271 PHEP(1,NHEP)=EUPTEI(1,IIHEP)
9272 PHEP(2,NHEP)=EUPTEI(2,IIHEP)
9273 PHEP(3,NHEP)=EUPTEI(3,IIHEP)
9274 PHEP(4,NHEP)=EUPTEI(4,IIHEP)
9275 PHEP(5,NHEP)=EUPTEI(5,IIHEP)
9276 VHEP(1,NHEP)=EUSECV(1,IIHEP)
9277 VHEP(2,NHEP)=EUSECV(2,IIHEP)
9278 VHEP(3,NHEP)=EUSECV(3,IIHEP)
9280 IF (IIHEP.GT.NTMAX) CALL HWWARN('HWDEUR',99,*999)
9284 *CMZ :- -01/04/99 19.52.44 by Mike Seymour
9285 *-- Author : Ian Knowles
9286 C-----------------------------------------------------------------------
9287 SUBROUTINE HWDFOR(P0,P1,P2,P3,P4)
9288 C-----------------------------------------------------------------------
9289 C Generates 4-body decay 0->1+2+3+4 using pure phase space
9290 C-----------------------------------------------------------------------
9292 DOUBLE PRECISION HWRGEN,P0(5),P1(5),P2(5),P3(5),P4(5),B,C,AA,BB,
9293 & CC,DD,EE,TT,S1,RS1,FF,S2,PP,QQ,RR,P1CM,P234(5),P2CM,P34(5),P3CM
9294 DOUBLE PRECISION TWO
9295 PARAMETER (TWO=2.D0)
9299 IF (B.LT.C) CALL HWWARN('HWDFOR',100,*999)
9305 TT=(B-C)*P0(5)**7/16
9306 C Select squared masses S1 and S2 of 234 and 34 subsystems
9307 10 S1=BB+HWRGEN(1)*(CC-BB)
9310 S2=DD+HWRGEN(2)*(FF-DD)
9312 QQ=((RS1+P2(5))**2-S2)*(FF-S2)/S1
9313 RR=(S2-DD)*(S2-EE)/S2
9314 IF (PP*QQ*RR*(FF-DD)**2.LT.TT*S1*S2*HWRGEN(3)**2) GOTO 10
9315 C Do two body decays: 0-->1+234, 234-->2+34 and 34-->3+4
9316 P1CM=SQRT(PP/4)/P0(5)
9321 CALL HWDTWO(P0 ,P1,P234,P1CM,TWO,.TRUE.)
9322 CALL HWDTWO(P234,P2,P34 ,P2CM,TWO,.TRUE.)
9323 CALL HWDTWO(P34 ,P3,P4 ,P3CM,TWO,.TRUE.)
9326 *CMZ :- -01/04/99 19.52.44 by Mike Seymour
9327 *-- Author : Ian Knowles
9328 C-----------------------------------------------------------------------
9329 SUBROUTINE HWDFIV(P0,P1,P2,P3,P4,P5)
9330 C-----------------------------------------------------------------------
9331 C Generates 5-body decay 0->1+2+3+4+5 using pure phase space
9332 C-----------------------------------------------------------------------
9334 DOUBLE PRECISION HWRGEN,P0(5),P1(5),P2(5),P3(5),P4(5),P5(5),B,C,
9335 & AA,BB,CC,DD,EE,FF,TT,S1,RS1,GG,S2,RS2,HH,S3,PP,QQ,RR,SS,P1CM,
9336 & P2345(5),P2CM,P345(5),P3CM,P45(5),P4CM
9337 DOUBLE PRECISION TWO
9338 PARAMETER (TWO=2.D0)
9341 C=P2(5)+P3(5)+P4(5)+P5(5)
9342 IF (B.LT.C) CALL HWWARN('HWDFIV',100,*999)
9346 DD=(P3(5)+P4(5)+P5(5))**2
9349 TT=(B-C)*P0(5)**11/729
9350 C Select squared masses S1, S2 and S3 of 2345, 345 and 45 subsystems
9351 10 S1=BB+HWRGEN(1)*(CC-BB)
9354 S2=DD+HWRGEN(2)*(GG-DD)
9357 S3=EE+HWRGEN(3)*(HH-EE)
9359 QQ=((RS1+P2(5))**2-S2)*(GG-S2)/S1
9360 RR=((RS2+P3(5))**2-S3)*(HH-S3)/S2
9361 SS=(S3-EE)*(S3-FF)/S3
9362 IF (PP*QQ*RR*SS*((GG-DD)*(HH-EE))**2.LT.TT*S1*S2*S3*HWRGEN(4)**2)
9364 C Do two body decays: 0-->1+2345, 2345-->2+345, 345-->3+45 and 45-->4+5
9365 P1CM=SQRT(PP/4)/P0(5)
9372 CALL HWDTWO(P0 ,P1,P2345,P1CM,TWO,.TRUE.)
9373 CALL HWDTWO(P2345,P2,P345 ,P2CM,TWO,.TRUE.)
9374 CALL HWDTWO(P345 ,P3,P45 ,P3CM,TWO,.TRUE.)
9375 CALL HWDTWO(P45 ,P4,P5 ,P4CM,TWO,.TRUE.)
9378 *CMZ :- -26/04/91 11.11.54 by Peter Richardson
9379 *-- Author : Ian Knowles, Bryan Webber & Mike Seymour
9380 C-----------------------------------------------------------------------
9382 C-----------------------------------------------------------------------
9383 C GENERATES DECAYS OF UNSTABLE HADRONS AND LEPTONS
9384 C Modified for TAUOLA interface 16/10/01 PR
9385 C-----------------------------------------------------------------------
9386 INCLUDE 'HERWIG65.INC'
9388 COMMON/SFF/IT1,IB1,IT2,IB2
9389 DOUBLE PRECISION TB,BT
9390 INTEGER IT1,IB1,IT2,IB2
9391 DOUBLE PRECISION HWRGEN,HWULDO,RN,BF,COSANG,RSUM,DIST(4),VERTX(4),
9392 & PMIX,WTMX,WTMX2,XS,DOT1,DOT2,HWDPWT,HWDWWT,HWDHWT,XXX,YYY
9393 INTEGER IHEP,ID,MHEP,IDM,I,IDS,IM,MO,IPDG
9395 EXTERNAL HWRGEN,HWDPWT,HWDWWT,HWDHWT,HWULDO
9396 IF (IERROR.NE.0) RETURN
9397 DO 100 IHEP=1,NMXHEP
9398 IF (IHEP.GT.NHEP) THEN
9401 ELSEIF (ISTHEP(IHEP).EQ.120 .AND.
9402 & JDAHEP(1,IHEP).EQ.IHEP.AND.JDAHEP(2,IHEP).EQ.IHEP) THEN
9403 C---COPY COLOUR SINGLET CMF
9405 IF (NHEP.GT.NMXHEP) CALL HWWARN('HWDHAD',100,*999)
9406 CALL HWVEQU(5,PHEP(1,IHEP),PHEP(1,NHEP))
9407 CALL HWVEQU(4,VHEP(1,IHEP),VHEP(1,NHEP))
9408 IDHW(NHEP)=IDHW(IHEP)
9409 IDHEP(NHEP)=IDHEP(IHEP)
9416 ELSEIF (ISTHEP(IHEP).GE.190.AND.ISTHEP(IHEP).LE.193) THEN
9417 C---FIRST CHECK FOR STABILITY
9423 C---SPECIAL FOR GAUGE BOSON DECAY
9424 IF (ID.GE.198.AND.ID.LE.200) CALL HWDBOS(IHEP)
9425 C---SPECIAL FOR HIGGS BOSON DECAY
9426 IF (ID.EQ.201) CALL HWDHIG(ZERO)
9429 C Calculate position of decay vertex
9430 IF (DKLTM(ID).EQ.ZERO) THEN
9431 CALL HWVEQU(4,VHEP(1,IHEP),VERTX)
9435 CALL HWUDKL(ID,PHEP(1,IHEP),DIST)
9436 CALL HWVSUM(4,VHEP(1,IHEP),DIST,VERTX)
9438 CALL HWDXLM(VERTX,STABLE)
9446 IF (MIXING.AND.(ID.EQ.221.OR.ID.EQ.223.OR.
9447 & ID.EQ.245.OR.ID.EQ.247)) THEN
9448 C Select flavour of decaying b-meson allowing for flavour oscillation
9450 XXX=XMRCT(IDS)*DIST(4)/PHEP(4,IHEP)
9451 YYY=YMRCT(IDS)*DIST(4)/PHEP(4,IHEP)
9452 IF (ABS(YYY).LT.10) THEN
9453 PMIX=HALF*(ONE-COS(XXX)/COSH(YYY))
9457 IF (HWRGEN(1).LE.PMIX) THEN
9466 C Introduce a decaying neutral b-meson
9467 IF (NHEP+1.GT.NMXHEP) CALL HWWARN('HWDHAD',101,*999)
9469 ISTHEP(MHEP)=ISTHEP(IHEP)
9474 IDHEP(MHEP)=IDPDG(IDM)
9476 JMOHEP(2,MHEP)=JMOHEP(2,IHEP)
9477 CALL HWVEQU(5,PHEP(1,IHEP),PHEP(1,MHEP))
9478 CALL HWVEQU(4,VERTX,VHEP(1,MHEP))
9485 C Use CLEO/EURODEC packages for b-hadrons if requested
9486 IF ((IDM.GE.221.AND.IDM.LE.231).OR.
9487 & (IDM.GE.245.AND.IDM.LE.254)) THEN
9488 IF (BDECAY.EQ.'CLEO') THEN
9491 ELSEIF (BDECAY.EQ.'EURO') THEN
9496 C Use TAUOLA package for tau decays if requested
9497 IF((IDM.EQ.125.OR.IDM.EQ.131).AND.TAUDEC.EQ.'TAUOLA') THEN
9498 CALL HWDTAU(1,MHEP,0.0D0)
9502 ISTHEP(MHEP)=ISTHEP(MHEP)+5
9506 DO 10 I=1,NMODES(IDM)
9508 IF (BF.GE.RN) GOTO 20
9510 CALL HWWARN('HWDHAD',50,*20)
9511 20 IF ((IDKPRD(1,IM).GE.1.AND.IDKPRD(1,IM).LE.13).OR.
9512 & (IDKPRD(3,IM).GE.1.AND.IDKPRD(3,IM).LE.13)) THEN
9513 C Partonic decay of a heavy-(b,c)-hadron, store details
9515 IF (NQDK.GT.NMXQDK) CALL HWWARN('HWDHAD',102,*999)
9518 CALL HWVEQU(4,VERTX,VTXQDK(1,NQDK))
9521 C Exclusive decay, add decay products to event record
9522 IF (NHEP+NPRODS(IM).GT.NMXHEP)
9523 & CALL HWWARN('HWDHAD',103,*999)
9524 JDAHEP(1,MHEP)=NHEP+1
9525 DO 30 I=1,NPRODS(IM)
9527 IDHW(NHEP)=IDKPRD(I,IM)
9528 IDHEP(NHEP)=IDPDG(IDKPRD(I,IM))
9531 JMOHEP(2,NHEP)=JMOHEP(2,MHEP)
9532 PHEP(5,NHEP)=RMASS(IDKPRD(I,IM))
9533 30 CALL HWVEQU(4,VERTX,VHEP(1,NHEP))
9536 C Next choose momenta:
9537 IF (NPRODS(IM).EQ.1) THEN
9538 C 1-body decay: K0(BR) --> K0S,K0L
9539 CALL HWVEQU(4,PHEP(1,MHEP),PHEP(1,NHEP))
9540 ELSEIF (NPRODS(IM).EQ.2) THEN
9542 C---SPECIAL TREATMENT OF POLARIZED MESONS
9544 IF (ID.EQ.IDHW(JMOHEP(1,MHEP))) THEN
9548 40 RSUM=RSUM+RHOHEP(I,MO)
9549 IF (RSUM.GT.ZERO) THEN
9551 IF (RSUM.LT.RHOHEP(1,MO)) THEN
9553 COSANG=MAX(HWRGEN(4),HWRGEN(5),HWRGEN(6))*TWO-ONE
9554 ELSEIF (RSUM.LT.RHOHEP(1,MO)+RHOHEP(2,MO)) THEN
9556 COSANG=2*COS((ACOS(HWRGEN(7)*TWO-ONE)+PIFAC)/THREE)
9559 COSANG=MIN(HWRGEN(8),HWRGEN(9),HWRGEN(10))*TWO-ONE
9563 CALL HWDTWO(PHEP(1,MHEP),PHEP(1,NHEP-1),
9564 & PHEP(1,NHEP),CMMOM(IM),COSANG,.FALSE.)
9565 ELSEIF (NPRODS(IM).EQ.3) THEN
9567 IF (NME(IM).EQ.100) THEN
9568 C Use free massless (V-A)*(V-A) Matrix Element
9569 CALL HWDTHR(PHEP(1,MHEP),PHEP(1,NHEP-1),PHEP(1,NHEP-2),
9570 & PHEP(1,NHEP),HWDWWT)
9571 ELSEIF (NME(IM).EQ.101) THEN
9572 C Use bound massless (V-A)*(V-A) Matrix Element
9573 WTMX=((PHEP(5,MHEP)-PHEP(5,NHEP))
9574 & *(PHEP(5,MHEP)+PHEP(5,NHEP))
9575 & +(PHEP(5,NHEP-1)-PHEP(5,NHEP-2))
9576 & *(PHEP(5,NHEP-1)+PHEP(5,NHEP-2)))/TWO
9578 IPDG=ABS(IDHEP(MHEP))
9579 XS=ONE-MAX(RMASS(MOD(IPDG/1000,10)),
9580 & RMASS(MOD(IPDG/100,10)),RMASS(MOD(IPDG/10,10)))
9581 & /(RMASS(MOD(IPDG/1000,10))+RMASS(MOD(IPDG/100,10))
9582 & +RMASS(MOD(IPDG/10,10)))
9583 50 CALL HWDTHR(PHEP(1,MHEP),PHEP(1,NHEP-1),PHEP(1,NHEP-2),
9584 & PHEP(1,NHEP),HWDWWT)
9585 DOT1=HWULDO(PHEP(1,MHEP),PHEP(1,NHEP-1))
9586 DOT2=HWULDO(PHEP(1,MHEP),PHEP(1,NHEP-2))
9587 IF (DOT1*(WTMX-DOT1-XS*DOT2).LT.HWRGEN(11)*WTMX2) GOTO 50
9588 ELSE IF (NME(IM).EQ.200) THEN
9589 C Use free massless ((V-A)*TB1+(V+A)*CT1)*((V-A)*TB2+(V+A)*CT2)) Matrix Element
9591 IF((IDK(IM).EQ. 2).OR.(IDK(IM).EQ. 4).OR.
9592 & (IDK(IM).EQ. 6).OR.(IDK(IM).EQ. 8).OR.
9593 & (IDK(IM).EQ. 10).OR.(IDK(IM).EQ. 12).OR.
9594 & (IDK(IM).EQ.122).OR.(IDK(IM).EQ.124).OR.
9595 & (IDK(IM).EQ.126).OR.(IDK(IM).EQ.128).OR.
9596 & (IDK(IM).EQ.130).OR.(IDK(IM).EQ.132))THEN
9601 IF((IDKPRD(1,IM).EQ. 2).OR.(IDKPRD(1,IM).EQ. 4).OR.
9602 & (IDKPRD(1,IM).EQ. 6).OR.(IDKPRD(1,IM).EQ. 8).OR.
9603 & (IDKPRD(1,IM).EQ. 10).OR.(IDKPRD(1,IM).EQ. 12).OR.
9604 & (IDKPRD(1,IM).EQ.122).OR.(IDKPRD(1,IM).EQ.124).OR.
9605 & (IDKPRD(1,IM).EQ.126).OR.(IDKPRD(1,IM).EQ.128).OR.
9606 & (IDKPRD(1,IM).EQ.130).OR.(IDKPRD(1,IM).EQ.132))THEN
9615 CALL HWDTHR(PHEP(1,MHEP),PHEP(1,NHEP),PHEP(1,NHEP-2),
9616 & PHEP(1,NHEP-1),HWDHWT)
9618 CALL HWDTHR(PHEP(1,MHEP),PHEP(1,NHEP-2),PHEP(1,NHEP-1),
9619 & PHEP(1,NHEP),HWDPWT)
9621 ELSEIF (NPRODS(IM).EQ.4) THEN
9623 CALL HWDFOR(PHEP(1,MHEP ),PHEP(1,NHEP-3),PHEP(1,NHEP-2),
9624 & PHEP(1,NHEP-1),PHEP(1,NHEP))
9625 ELSEIF (NPRODS(IM).EQ.5) THEN
9627 CALL HWDFIV(PHEP(1,MHEP ),PHEP(1,NHEP-4),PHEP(1,NHEP-3),
9628 & PHEP(1,NHEP-2),PHEP(1,NHEP-1),PHEP(1,NHEP))
9630 CALL HWWARN('HWDHAD',104,*999)
9635 C---MAY HAVE OVERFLOWED /HEPEVT/
9636 CALL HWWARN('HWDHAD',105,*999)
9639 *CMZ :- -26/04/91 11.11.55 by Bryan Webber
9640 *-- Author : Mike Seymour
9641 C-----------------------------------------------------------------------
9642 SUBROUTINE HWDHGC(TAU,FNREAL,FNIMAG)
9643 C-----------------------------------------------------------------------
9644 C CALCULATE THE COMPLEX FUNCTION F OF HHG eq 2.18
9645 C FOR USE IN H-->GAMMGAMM DECAYS
9646 C-----------------------------------------------------------------------
9647 INCLUDE 'HERWIG65.INC'
9648 DOUBLE PRECISION TAU,FNREAL,FNIMAG,FNLOG,FNSQR
9649 IF (TAU.GT.ONE) THEN
9650 FNREAL=(ASIN(1/SQRT(TAU)))**2
9652 ELSEIF (TAU.LT.ONE) THEN
9654 FNLOG=LOG((1+FNSQR)/(1-FNSQR))
9655 FNREAL=-0.25 * (FNLOG**2 - PIFAC**2)
9656 FNIMAG= 0.5 * PIFAC*FNLOG
9658 FNREAL=0.25*PIFAC**2
9663 *CMZ :- -02/05/91 11.11.45 by Federico Carminati
9664 *-- Author : Mike Seymour
9665 C-----------------------------------------------------------------------
9666 FUNCTION HWDHGF(X,Y)
9667 C-----------------------------------------------------------------------
9668 C CALCULATE THE DOUBLE BREIT-WIGNER INTEGRAL
9669 C X=(EMV/EMH)**2 , Y=EMV*GAMV/EMH**2
9670 C-----------------------------------------------------------------------
9671 INCLUDE 'HERWIG65.INC'
9672 DOUBLE PRECISION HWDHGF,X,Y,CHANGE,X1,X2,FAC1,FAC2,TH1,TH2,TH1HI,
9673 & TH1LO,TH2HI,TH2LO,X2MAX,SQFAC
9674 INTEGER NBIN,IBIN1,IBIN2
9675 C CHANGE IS THE POINT WHERE DIRECT INTEGRATION BEGINS TO CONVERGE
9676 C FASTER THAN STANDARD BREIT-WIGNER SUBSTITUTION
9677 DATA CHANGE,NBIN/0.425D0,25/
9679 IF (Y.LT.ZERO) RETURN
9680 IF (X.GT.CHANGE) THEN
9681 C---DIRECT INTEGRATION
9684 X1=(IBIN1-0.5) * FAC1
9685 FAC2=( (1-SQRT(X1))**2-X1 ) / NBIN
9687 X2=(IBIN2-0.5) * FAC2 + X1
9688 SQFAC=1+X1**2+X2**2-2*(X1+X2+X1*X2)
9689 IF (SQFAC.LT.ZERO) GOTO 100
9691 & * ((1-X1-X2)**2+8*X1*X2)
9693 & / ((X1-X)**2+Y**2) *Y
9694 & / ((X2-X)**2+Y**2) *Y
9699 C---INTEGRATION USING TAN THETA SUBSTITUTIONS
9702 FAC1=(TH1HI-TH1LO) / NBIN
9704 TH1=(IBIN1-0.5) * FAC1 + TH1LO
9706 X2MAX=MIN(X1,(1-SQRT(X1))**2)
9708 TH2HI=ATAN((X2MAX-X)/Y)
9709 FAC2=(TH2HI-TH2LO) / NBIN
9711 TH2=(IBIN2-0.5) * FAC2 + TH2LO
9713 SQFAC=1+X1**2+X2**2-2*(X1+X2+X1*X2)
9714 IF (SQFAC.LT.ZERO) GOTO 300
9716 & * ((1-X1-X2)**2+8*X1*X2)
9722 HWDHGF=HWDHGF/(PIFAC*PIFAC)
9725 *CMZ :- -24/04/92 14.23.44 by Mike Seymour
9726 *-- Author : Mike Seymour
9727 C-----------------------------------------------------------------------
9728 SUBROUTINE HWDHIG(GAMINP)
9729 C-----------------------------------------------------------------------
9730 C HIGGS DECAY ROUTINE
9731 C A) FOR GAMinp=0 FIND AND DECAY HIGGS
9732 C B) FOR GAMinp>0 CALCULATE TOTAL HIGGS WIDTH
9733 C FOR EMH=GAMINP. STORE RESULT IN GAMINP.
9734 C-----------------------------------------------------------------------
9735 INCLUDE 'HERWIG65.INC'
9736 DOUBLE PRECISION HWDHGF,HWRGEN,HWRUNI,HWUSQR,HWUPCM,GAMINP,EMH,
9737 & EMF,COLFAC,ENF,K1,K0,BET0,BET1,GAM0,GAM1,SCLOG,CFAC,XF,EM,GAMLIM,
9738 & GAM,XW,EMW,XZ,EMZ,YW,YZ,EMI,TAUT,TAUW,WIDHIG,VECDEC,EMB,GAMB,
9739 & TMIN,TMAX1,EM1,TMAX2,EM2,X1,X2,PROB,PCM,SUMR,SUMI,TAUTR,TAUTI,
9740 & TAUWR,TAUWI,GFACTR
9741 INTEGER HWRINT,IHIG,I,IFERM,NLOOK,I1,I2,IPART,IMODE,IDEC,MMAX
9743 EXTERNAL HWDHGF,HWRGEN,HWRUNI,HWUSQR,HWUPCM,HWRINT,HWRLOG
9745 PARAMETER (NLOOK=100)
9746 DIMENSION VECDEC(2,0:NLOOK)
9747 EQUIVALENCE (EMW,RMASS(198)),(EMZ,RMASS(200))
9748 DATA GAMLIM,GAM,EM/10D0,2*0D0/
9749 C---IF DECAY, FIND HIGGS (HWDHAD WILL HAVE GIVEN IT STATUS=1)
9750 IF (GAMINP.EQ.ZERO) THEN
9753 10 IF (IHIG.EQ.0.AND.IDHW(I).EQ.201.AND.ISTHEP(I).EQ.1) IHIG=I
9754 IF (IHIG.EQ.0) CALL HWWARN('HWDHIG',101,*999)
9756 IF (EMH.LE.ZERO) CALL HWWARN('HWDHIG',102,*999)
9760 IF (EMH.LE.ZERO) THEN
9765 C---CALCULATE BRANCHING FRACTIONS
9767 C---NLL CORRECTION TO QUARK DECAY RATE (HHG eq 2.6-9)
9770 1 IF (2*RMASS(I).LT.EMH) ENF=ENF+1
9773 BET0=(11*CAFAC-2*ENF)/3
9774 BET1=(34*CAFAC**2-(10*CAFAC+6*CFFAC)*ENF)/3
9776 GAM1=-404./3+40*ENF/9
9777 SCLOG=LOG(EMH**2/QCDLAM**2)
9778 CFAC=1 + ( K1/K0 - 2*GAM0 + GAM0*BET1/BET0**2*LOG(SCLOG)
9779 & + (GAM0*BET1-GAM1*BET0)/BET0**2) / (BET0*SCLOG)
9781 IF (IFERM.LE.6) THEN
9786 & EMF=EMF*(LOG(EMH/QCDLAM)/LOG(EMF/QCDLAM))**(GAM0/(2*BET0))
9788 EMF=RMASS(107+IFERM*2)
9793 IF (FOUR*XF.LT.ONE) THEN
9794 GFACTR=ALPHEM/(8.*SWEIN*EMW**2)
9795 BRHIG(IFERM)=COLFAC*GFACTR*EMH*EMF**2 * (1-4*XF)**1.5 * CFAC
9801 IF (ABS(EM-EMH).GE.GAMLIM*GAM) THEN
9802 C---OFF EDGE OF LOOK-UP TABLE
9807 BRHIG(10)=.50*GFACTR * EMH**3 * HWDHGF(XW,YW)
9808 BRHIG(11)=.25*GFACTR * EMH**3 * HWDHGF(XZ,YZ)
9811 EMI=((EMH-EM)/(GAM*GAMLIM)+1)*NLOOK/2.0
9814 BRHIG(10)=.50*GFACTR * EMH**3 * ( VECDEC(1,I1)*(I2-EMI) +
9815 & VECDEC(1,I2)*(EMI-I1) )
9816 BRHIG(11)=.25*GFACTR * EMH**3 * ( VECDEC(2,I1)*(I2-EMI) +
9817 & VECDEC(2,I2)*(EMI-I1) )
9820 TAUT=(2*RMASS(6)/EMH)**2
9822 CALL HWDHGC(TAUT,TAUTR,TAUTI)
9823 CALL HWDHGC(TAUW,TAUWR,TAUWI)
9824 SUMR=4./3*( - 2*TAUT*( 1 + (1-TAUT)*TAUTR ) ) * ENHANC(6)
9825 & +(2 + 3*TAUW*( 1 + (2-TAUW)*TAUWR ) ) * ENHANC(10)
9826 SUMI=4./3*( - 2*TAUT*( (1-TAUT)*TAUTI ) ) * ENHANC(6)
9827 & +( 3*TAUW*( (2-TAUW)*TAUWI ) ) * ENHANC(10)
9828 BRHIG(12)=GFACTR*.03125*(ALPHEM/PIFAC)**2
9829 & *EMH**3 * (SUMR**2 + SUMI**2)
9832 IF (IPART.LT.12) BRHIG(IPART)=BRHIG(IPART)*ENHANC(IPART)**2
9833 200 WIDHIG=WIDHIG+BRHIG(IPART)
9834 IF (WIDHIG.EQ.ZERO) CALL HWWARN('HWDHIG',103,*999)
9836 300 BRHIG(IPART)=BRHIG(IPART)/WIDHIG
9837 IF (EM.NE.RMASS(201)) THEN
9838 C---SET UP W*W*/Z*Z* LOOKUP TABLES
9841 GAMLIM=MAX(GAMLIM,GAMMAX)
9843 EMH=(I*2.0/NLOOK-1)*GAM*GAMLIM+EM
9848 VECDEC(1,I)=HWDHGF(XW,YW)
9849 VECDEC(2,I)=HWDHGF(XZ,YZ)
9853 IF (GAMINP.GT.ZERO) THEN
9857 C---SEE IF USER SPECIFIED A DECAY MODE
9858 IMODE=MOD(ABS(IPROC),100)
9859 C---IF NOT, CHOOSE ONE
9860 IF (IMODE.LT.1.OR.IMODE.GT.12) THEN
9862 IF (IMODE.LT.1) MMAX=6
9863 500 IMODE=HWRINT(1,MMAX)
9864 IF (BRHIG(IMODE).LT.HWRGEN(0)) GOTO 500
9866 C---SEE IF SPECIFIED DECAY IS POSSIBLE
9867 IF (BRHIG(IMODE).EQ.ZERO) CALL HWWARN('HWDHIG',104,*999)
9868 IF (IMODE.LE.6) THEN
9870 ELSEIF (IMODE.LE.9) THEN
9872 ELSEIF (IMODE.EQ.10) THEN
9874 ELSEIF (IMODE.EQ.11) THEN
9876 ELSEIF (IMODE.EQ.12) THEN
9879 C---STATUS, IDs AND POINTERS
9884 IDHEP(NHEP+I)=IDPDG(IDEC)
9885 JDAHEP(I,IHIG)=NHEP+I
9886 JMOHEP(1,NHEP+I)=IHIG
9887 JMOHEP(2,NHEP+I)=NHEP+(3-I)
9888 JDAHEP(2,NHEP+I)=NHEP+(3-I)
9889 PHEP(5,NHEP+I)=RMASS(IDEC)
9891 IF (IDEC.EQ.204) IDEC=199
9892 IF (IDEC.EQ.206) IDEC=200
9893 IF (IDEC.EQ. 65) IDEC= 59
9895 C---ALLOW W/Z TO BE OFF-SHELL
9896 IF (IMODE.EQ.10.OR.IMODE.EQ.11) THEN
9897 IF (IMODE.EQ.10) THEN
9904 C---STANDARD MASS DISTRIBUTION
9905 700 TMIN=ATAN(-EMB/GAMB)
9906 TMAX1=ATAN((EMH**2/EMB-EMB)/GAMB)
9907 EM1=HWUSQR(EMB*(GAMB*TAN(HWRUNI(0,TMIN,TMAX1))+EMB))
9908 TMAX2=ATAN(((EMH-EM1)**2/EMB-EMB)/GAMB)
9909 EM2=HWUSQR(EMB*(GAMB*TAN(HWRUNI(0,TMIN,TMAX2))+EMB))
9912 C---CORRECT MASS DISTRIBUTION
9913 PROB=HWUSQR(1+X1**2+X2**2-2*X1-2*X2-2*X1*X2)
9914 & * ((X1+X2-1)**2 + 8*X1*X2)
9915 IF (.NOT.HWRLOG(PROB)) GOTO 700
9916 C---CALCULATE SPIN DENSITY MATRIX
9917 RHOHEP(1,NHEP+1)=4*X1*X2 / (8*X1*X2 + (X1+X2-1)**2)
9918 RHOHEP(2,NHEP+1)=(X1+X2-1)**2 / (8*X1*X2 + (X1+X2-1)**2)
9919 RHOHEP(3,NHEP+1)=RHOHEP(1,NHEP+1)
9920 C---SYMMETRIZE DISTRIBUTIONS IN PARTICLES 1,2
9921 IF (HWRLOG(HALF)) THEN
9930 PCM=HWUPCM(EMH,PHEP(5,NHEP+1),PHEP(5,NHEP+2))
9931 IF (PCM.LT.ZERO) CALL HWWARN('HWDHIG',105,*999)
9932 CALL HWDTWO(PHEP(1,IHIG),PHEP(1,NHEP+1),PHEP(1,NHEP+2),
9935 C---IF QUARK DECAY, HADRONIZE
9936 IF (IMODE.LE.6) THEN
9943 C--MHS FIX 07/03/05 - VERTEX POSITION FOR DECAYS TO LEPTONS OR PHOTONS
9944 ELSEIF (IMODE.LE.9.OR.IMODE.EQ.12) THEN
9945 CALL HWVEQU(4,VTXPIP,VHEP(1,NHEP-1))
9946 CALL HWVEQU(4,VTXPIP,VHEP(1,NHEP))
9951 *CMZ :- -17/10/01 10:19:15 by Peter Richardson
9952 *-- Author : Ian Knowles & Bryan Webber
9953 C-----------------------------------------------------------------------
9955 C-----------------------------------------------------------------------
9956 C Performs decays of heavy objects (heavy quarks & SUSY particles)
9957 C MODIFIED TO INCLUDE R-PARITY VIOLATING SUSY PR 9/4/99
9958 C MODIFIED TO CALL A NUMBER OF ROUTINES TO DO THE VARIOUS BITS OF
9960 C-----------------------------------------------------------------------
9961 INCLUDE 'HERWIG65.INC'
9962 DOUBLE PRECISION PW(5)
9963 INTEGER IHEP,IS,ID,IM,KHEP,LHEP,MHEP,NPR,CLSAVE(2),NHEPST
9966 IF (IERROR.NE.0) RETURN
9974 IF(SYSPIN.AND.NSPN.NE.0) CALL HWDSIN(CLSAVE)
9975 IF (.NOT.RSTAB(ID).AND.(ID.EQ.6.OR.ID.EQ.12.OR.
9976 & (ID.GE.203.AND.ID.LE.218).OR.ABS(IDPDG(ID)).GT.1000000).AND.
9977 & ((IS.EQ.120.AND.JDAHEP(1,IHEP).EQ.IHEP).OR.
9978 & IS.EQ.190.OR.(IS.GE.147.AND.IS.LE.151))) THEN
9980 C--select the decay mode and enter the decay products in the event record
9981 CALL HWDHO1(IHEP,ID,IM,NPR,LHEP,MHEP)
9982 IF (IERROR.NE.0) RETURN
9983 C--select the momenta of the decay products
9984 CALL HWDHO2(IHEP,IM,NPR,MHEP,LHEP,KHEP,PW)
9985 IF (IERROR.NE.0) RETURN
9986 C--make the colour connections
9987 CALL HWDHO3(IHEP,ID,IM,NPR,MHEP,LHEP,KHEP,CLSAVE)
9988 IF (IERROR.NE.0) RETURN
9989 C--perform the parton-showers
9990 CALL HWDHO4(IHEP,ID,IM,NPR,MHEP,LHEP,KHEP,PW)
9991 IF (IERROR.NE.0) RETURN
9993 C--perform the colour corrections for RPV
9994 CALL HWDHO5(IHEP,MHEP,LHEP,CLSAVE)
9995 IF(IERROR.NE.0) RETURN
9996 IF (IHEP.EQ.NHEP) GOTO 70
9998 70 IF(SYSPIN.AND.NHEP.NE.NHEPST) FOUND=.TRUE.
10000 C--final check for colour disconnection
10002 C Go back to check for further heavy decay products
10007 *CMZ :- -17/10/01 10:19:15 by Peter Richardson
10008 *-- Author : Ian Knowles & Bryan Webber
10009 C-----------------------------------------------------------------------
10010 SUBROUTINE HWDHO1(IHEP,ID,IM,NPR,LHEP,MHEP)
10011 C-----------------------------------------------------------------------
10012 C Subroutine to perform the first part of the heavy object decays
10013 C IE to select the decay mode
10014 C was part of HWDHOB
10015 C-----------------------------------------------------------------------
10016 INCLUDE 'HERWIG65.INC'
10017 DOUBLE PRECISION HWUMBW,HWRGEN,SDKM,RN,BF
10018 INTEGER IST(3),IHEP,ID,IM,I,JHEP,LHEP,MHEP,NPR,MTRY,NTRY,IS
10020 DATA IST/113,114,114/
10021 IF (IERROR.NE.0) RETURN
10022 IF(.NOT.RPARTY) THEN
10027 CALL HWVEQU(5,PHEP(1,IHEP),PHEP(1,NHEP))
10028 CALL HWVEQU(4,VHEP(1,IHEP),VHEP(1,NHEP))
10029 JMOHEP(1,NHEP)=JMOHEP(1,IHEP)
10030 JMOHEP(2,NHEP)=JMOHEP(2,IHEP)
10031 JDAHEP(1,NHEP)=JDAHEP(1,IHEP)
10032 JDAHEP(2,NHEP)=JDAHEP(2,IHEP)
10034 C Make a copy of decaying object
10037 IDHW(NHEP)=IDHW(IHEP)
10038 IDHEP(NHEP)=IDHEP(IHEP)
10039 CALL HWVEQU(5,PHEP(1,IHEP),PHEP(1,NHEP))
10040 CALL HWVEQU(4,VHEP(1,IHEP),VHEP(1,NHEP))
10041 JMOHEP(1,NHEP)=JMOHEP(1,IHEP)
10042 JMOHEP(2,NHEP)=JMOHEP(2,IHEP)
10043 C--copy the location of the particle in the spin block
10044 IF(SYSPIN.AND.NSPN.NE.0) THEN
10045 IF(ISNHEP(IHEP).EQ.0) THEN
10050 IF(ISNHEP(IS).EQ.0.AND.MTRY.LE.NETRY) GOTO 5
10051 IF(MTRY.GT.NETRY) CALL HWWARN('HWDHO1',102,*999)
10052 ISNHEP(IHEP) = ISNHEP(IS)
10054 ISNHEP(NHEP) = ISNHEP(JMOHEP(1,NHEP))
10058 C Select decay mode
10062 DO 20 I=1,NMODES(ID)
10064 IF (BF.GE.RN) GOTO 30
10066 CALL HWWARN('HWDHO1',50,*30)
10067 30 IF (NHEP+5.GT.NMXHEP) CALL HWWARN('HWDHO1',100,*999)
10069 JDAHEP(1,NHEP)=NHEP+1
10070 JDAHEP(2,NHEP)=NHEP+NPR
10071 C Reset colour pointers (if set)
10072 JHEP=JMOHEP(2,IHEP)
10073 IF (JHEP.GT.0) THEN
10074 IF (JDAHEP(2,JHEP).EQ.IHEP) JDAHEP(2,JHEP)=NHEP
10075 IF(.NOT.RPARTY.AND.ISTHEP(JHEP).EQ.155
10076 & .AND.ABS(IDHEP(JHEP)).GT.1000000
10077 & .AND.JDAHEP(2,JHEP-1).EQ.IHEP) JDAHEP(2,JHEP-1) = NHEP
10079 JHEP=JDAHEP(2,IHEP)
10080 IF (JHEP.GT.0) THEN
10081 IF (JMOHEP(2,JHEP).EQ.IHEP) JMOHEP(2,JHEP)=NHEP
10082 IF(.NOT.RPARTY.AND.ISTHEP(JHEP).EQ.155
10083 & .AND.ABS(IDHEP(JHEP)).GT.1000000
10084 & .AND.JMOHEP(2,JHEP-1).EQ.IHEP) JMOHEP(2,JHEP-1) = NHEP
10086 C--Reset colour pointers if baryon number violated
10087 IF(.NOT.RPARTY) THEN
10089 IF(ISTHEP(JHEP).EQ.155
10090 & .AND.ABS(IDHEP(JHEP)).GT.1000000.AND.
10091 & JDAHEP(2,JHEP-1).EQ.IHEP) JDAHEP(2,JHEP-1)= NHEP
10092 IF(JDAHEP(2,JHEP).EQ.IHEP) JDAHEP(2,JHEP)=NHEP
10093 IF(JMOHEP(2,JHEP).EQ.IHEP) JMOHEP(2,JHEP)=NHEP
10095 IF(HRDCOL(1,1).EQ.IHEP) HRDCOL(1,1)=NHEP
10097 C Relabel original track
10098 IF (ISTHEP(IHEP).NE.120) ISTHEP(IHEP)=3
10099 JMOHEP(2,IHEP)=JMOHEP(1,IHEP)
10100 JDAHEP(1,IHEP)=NHEP
10101 JDAHEP(2,IHEP)=NHEP
10102 C Label decay products and choose masses
10110 IDHW(NHEP)=IDKPRD(I,IM)
10111 IDHEP(NHEP)=IDPDG(IDKPRD(I,IM))
10112 ISTHEP(NHEP)=IST(I)
10113 JMOHEP(1,NHEP)=LHEP
10115 PHEP(5,NHEP)=HWUMBW(IDKPRD(I,IM))
10116 40 SDKM=SDKM-PHEP(5,NHEP)
10117 IF (SDKM.LT.ZERO) THEN
10119 IF (NTRY.LE.NETRY) GO TO 35
10120 CALL HWWARN('HWDHO1',1,*45)
10121 45 IF (MTRY.LE.NETRY) GO TO 15
10122 CALL HWWARN('HWDHO1',101,*999)
10124 C Assign production vertices to decay products
10125 CALL HWUDKL(ID,PHEP(1,IHEP),VHEP(1,MHEP))
10126 CALL HWVSUM(4,VHEP(1,IHEP),VHEP(1,MHEP),VHEP(1,MHEP))
10127 CALL HWVEQU(4,VHEP(1,MHEP),VHEP(1,NHEP))
10130 *CMZ :- -30/09/02 14:05:28 by Peter Richardson
10131 *-- Author : Ian Knowles & Bryan Webber
10132 C-----------------------------------------------------------------------
10133 SUBROUTINE HWDHO2(IHEP,IM,NPR,MHEP,LHEP,KHEP,PW)
10134 C-----------------------------------------------------------------------
10135 C Subroutine to perform the second part of the heavy object decays
10136 C IE generate the kinematics for the decay
10137 C was part of HWDHOB
10138 C-----------------------------------------------------------------------
10139 INCLUDE 'HERWIG65.INC'
10141 COMMON/SFF/IT1,IB1,IT2,IB2
10142 DOUBLE PRECISION TB,BT
10143 INTEGER IT1,IB1,IT2,IB2,ISP
10144 DOUBLE PRECISION GAMHPM
10145 DOUBLE PRECISION HWUPCM,HWRGEN,PCM,
10146 & EMMX,EMWSQ,GMWSQ,EMLIM,PW(5),EMTST,HWDPWT,HWDWWT,HWULDO,HWDHWT
10147 DOUBLE COMPLEX RHOIN(2,2,2)
10148 INTEGER IHEP,IM,KHEP,LHEP,MHEP,NPR,RHEP
10149 EXTERNAL HWRGEN,HWDPWT,HWDWWT,HWDHWT
10150 DATA RHOIN/(1.0D0,0.0D0),(0.0D0,0.0D0),
10151 & (0.0D0,0.0D0),(0.0D0,0.0D0),
10152 & (0.5D0,0.0D0),(0.0D0,0.0D0),
10153 & (0.0D0,0.0D0),(0.5D0,0.0D0)/
10154 ISP = INT(2*RSPIN(IDHW(IHEP)))+1
10155 IF (IERROR.NE.0) RETURN
10157 C Two body decay: LHEP -> MHEP + NHEP
10158 IF(NME(IM).GT.20000.AND.NME(IM).LT.30000) THEN
10159 C--generate a two body decay to a gauge boson as a three body decay
10160 CALL HWDSM3(2,IHEP,MHEP,NHEP,0,NME(IM)-20000,RHOIN(1,1,ISP),1)
10161 C--generate a two body decay of a Higgs to two gauge bosons
10162 ELSEIF(NME(IM).GT.40000.AND.NME(IM).LT.50000) THEN
10163 CALL HWDSM4(1,IHEP,MHEP,NHEP,NME(IM)-40000)
10164 C--if spin correlations call the routine to set-up the matrix element
10165 ELSEIF(SYSPIN.AND.NME(IM).GE.30000.AND.NME(IM).LE.40000) THEN
10166 CALL HWDSM2(IHEP,MHEP,NHEP,NME(IM)-30000,RHOIN(1,1,ISP),1)
10168 PCM=HWUPCM(PHEP(5,IHEP),PHEP(5,MHEP),PHEP(5,NHEP))
10169 CALL HWDTWO(PHEP(1,IHEP),PHEP(1,MHEP),
10170 & PHEP(1,NHEP),PCM,TWO,.FALSE.)
10172 ELSEIF (NPR.EQ.3) THEN
10173 C Three body decay: LHEP -> KHEP + MHEP + NHEP
10176 C Provisional colour self-connection of KHEP
10177 JMOHEP(2,KHEP)=KHEP
10178 JDAHEP(2,KHEP)=KHEP
10179 IF (NME(IM).EQ.100) THEN
10180 C Generate decay momenta using full (V-A)*(V-A) matrix element
10181 EMMX=PHEP(5,IHEP)-PHEP(5,NHEP)
10182 EMWSQ=RMASS(198)**2
10183 GMWSQ=(RMASS(198)*GAMW)**2
10185 IF (EMMX.LT.RMASS(198)) EMLIM=EMLIM+(EMWSQ-EMMX**2)**2
10186 50 CALL HWDTHR(PHEP(1,IHEP),PHEP(1,MHEP),
10187 & PHEP(1,KHEP),PHEP(1,NHEP),HWDWWT)
10188 CALL HWVSUM(4,PHEP(1,KHEP),PHEP(1,MHEP),PW)
10189 PW(5)=HWULDO(PW,PW)
10190 EMTST=(EMWSQ-PW(5))**2
10191 IF ((EMTST+GMWSQ)*HWRGEN(1).GT.EMLIM) GOTO 50
10193 C Assign production vertices to 1 and 2
10194 CALL HWUDKL(198,PW,VHEP(1,KHEP))
10195 CALL HWVSUM(4,VHEP(1,NHEP),VHEP(1,KHEP),VHEP(1,KHEP))
10196 ELSE IF (NME(IM).EQ.200) THEN
10197 C Generate decay momenta using full
10198 C ((V-A)*TB1+(V+A)*CT1)*((V-A)*TB2+(V+A)*CT2)) matrix element
10199 GAMHPM=RMASS(206)/DKLTM(206)
10201 IF((IDK(IM).EQ. 2).OR.(IDK(IM).EQ. 4).OR.
10202 & (IDK(IM).EQ. 6).OR.(IDK(IM).EQ. 8).OR.
10203 & (IDK(IM).EQ. 10).OR.(IDK(IM).EQ. 12).OR.
10204 & (IDK(IM).EQ.122).OR.(IDK(IM).EQ.124).OR.
10205 & (IDK(IM).EQ.126).OR.(IDK(IM).EQ.128).OR.
10206 & (IDK(IM).EQ.130).OR.(IDK(IM).EQ.132))THEN
10211 IF((IDKPRD(1,IM).EQ. 2).OR.(IDKPRD(1,IM).EQ. 4).OR.
10212 & (IDKPRD(1,IM).EQ. 6).OR.(IDKPRD(1,IM).EQ. 8).OR.
10213 & (IDKPRD(1,IM).EQ. 10).OR.(IDKPRD(1,IM).EQ. 12).OR.
10214 & (IDKPRD(1,IM).EQ.122).OR.(IDKPRD(1,IM).EQ.124).OR.
10215 & (IDKPRD(1,IM).EQ.126).OR.(IDKPRD(1,IM).EQ.128).OR.
10216 & (IDKPRD(1,IM).EQ.130).OR.(IDKPRD(1,IM).EQ.132))THEN
10225 EMMX=PHEP(5,IHEP)-PHEP(5,NHEP)
10226 EMWSQ=RMASS(206)**2
10227 GMWSQ=(RMASS(206)*GAMHPM)**2
10229 IF (EMMX.LT.RMASS(206)) EMLIM=EMLIM+(EMWSQ-EMMX**2)**2
10230 55 CALL HWDTHR(PHEP(1,IHEP),PHEP(1,NHEP),
10231 & PHEP(1,KHEP),PHEP(1,MHEP),HWDHWT)
10232 CALL HWVSUM(4,PHEP(1,KHEP),PHEP(1,MHEP),PW)
10233 PW(5)=HWULDO(PW,PW)
10234 EMTST=(EMWSQ-PW(5))**2
10235 IF ((EMTST+GMWSQ)*HWRGEN(2).GT.EMLIM) GOTO 55
10237 C Assign production vertices to 1 and 2
10238 CALL HWUDKL(206,PW,VHEP(1,KHEP))
10239 CALL HWVSUM(4,VHEP(1,NHEP),VHEP(1,KHEP),VHEP(1,KHEP))
10240 ELSEIF(NME(IM).EQ.300) THEN
10241 C Generate momenta using 3-body RPV matrix element
10242 CALL HWDRME(LHEP,KHEP)
10243 C--Three body SUSY decay
10244 ELSEIF(NME(IM).GE.10000.AND.NME(IM).LT.20000) THEN
10245 CALL HWDSM3(3,IHEP,MHEP,KHEP,NHEP,NME(IM)-10000,
10246 & RHOIN(1,1,ISP),1)
10247 C--special for top decay
10248 IF(ABS(IDHEP(IHEP)).EQ.6) THEN
10249 CALL HWVSUM(4,PHEP(1,KHEP),PHEP(1,MHEP),PW)
10253 C Three body phase space decay
10254 CALL HWDTHR(PHEP(1,IHEP),PHEP(1,MHEP),
10255 & PHEP(1,KHEP),PHEP(1,NHEP),HWDPWT)
10257 CALL HWVEQU(4,VHEP(1,KHEP),VHEP(1,MHEP))
10258 ELSEIF(NPR.EQ.4) THEN
10259 C Four body decay: LHEP -> KHEP + RHEP + MHEP + NHEP
10264 C Provisional colour connections of KHEP and RHEP
10265 JMOHEP(2,KHEP)=RHEP
10266 JDAHEP(2,KHEP)=RHEP
10267 JMOHEP(2,RHEP)=KHEP
10268 JDAHEP(2,RHEP)=KHEP
10269 C Four body phase space decay
10270 CALL HWDFOR(PHEP(1,IHEP),PHEP(1,KHEP),PHEP(1,RHEP),
10271 & PHEP(1,MHEP),PHEP(1,NHEP))
10272 CALL HWVEQU(4,VHEP(1,KHEP),VHEP(1,RHEP))
10273 CALL HWVEQU(4,VHEP(1,KHEP),VHEP(1,MHEP))
10275 CALL HWWARN('HWDHO2',100,*999)
10279 *CMZ :- -17/10/01 10:19:15 by Peter Richardson
10280 *-- Author : Ian Knowles & Bryan Webber
10281 C-----------------------------------------------------------------------
10282 SUBROUTINE HWDHO3(IHEP,ID,IM,NPR,MHEP,LHEP,KHEP,CLSAVE)
10283 C-----------------------------------------------------------------------
10284 C Subroutine to perform the third part of the heavy object decays
10285 C IE setup the colour connections
10286 C was part of HWDHOB
10287 C-----------------------------------------------------------------------
10288 INCLUDE 'HERWIG65.INC'
10289 INTEGER IHEP,ID,IM,KHEP,LHEP,MHEP,NPR,CLSAVE(2)
10290 IF (IERROR.NE.0) RETURN
10291 C Colour connections
10292 IF (ID.EQ.6.OR.ID.EQ.12.OR.(ID.GE.209.AND.ID.LE.212)
10293 & .OR.(ID.GE.215.AND.ID.LE.218)) THEN
10294 IF ((NPR.EQ.3.AND.NME(IM).EQ.100).OR.
10295 & ((SYSPIN.OR.THREEB).AND.NPR.EQ.3.AND.
10296 & NME(IM).GE.10000.AND.NME(IM).LE.20000)) THEN
10297 C usual heavy quark decay
10298 JMOHEP(2,KHEP)=MHEP
10299 JDAHEP(2,KHEP)=MHEP
10300 JMOHEP(2,MHEP)=KHEP
10301 JDAHEP(2,MHEP)=KHEP
10302 JMOHEP(2,NHEP)=LHEP
10303 JDAHEP(2,NHEP)=LHEP
10304 ELSEIF (ABS(IDHEP(MHEP)).EQ.37) THEN
10305 C heavy quark to charged Higgs 2->2
10306 JMOHEP(2,MHEP)=MHEP
10307 JDAHEP(2,MHEP)=MHEP
10308 JMOHEP(2,NHEP)=LHEP
10309 JDAHEP(2,NHEP)=LHEP
10310 ELSEIF (ABS(IDHEP(NHEP)).EQ.37) THEN
10311 C heavy quark to charged Higgs 2->2
10312 JMOHEP(2,MHEP)=LHEP
10313 JDAHEP(2,MHEP)=LHEP
10314 JMOHEP(2,NHEP)=NHEP
10315 JDAHEP(2,NHEP)=NHEP
10316 ELSE IF (NPR.EQ.3.AND.NME(IM).EQ.200) THEN
10317 C heavy quark to charged Higgs 2->3
10318 JMOHEP(2,KHEP)=MHEP
10319 JDAHEP(2,KHEP)=MHEP
10320 JMOHEP(2,MHEP)=KHEP
10321 JDAHEP(2,MHEP)=KHEP
10322 JMOHEP(2,NHEP)=LHEP
10323 JDAHEP(2,NHEP)=LHEP
10325 CALL HWWARN('HWDHO3',100,*999)
10328 IF(.NOT.RPARTY.AND.
10329 & ((NPR.EQ.2.AND.ID.GE.401.AND.ID.LT.448.AND.
10330 & IDHW(MHEP).LE.132.AND.IDHW(NHEP).LE.132)
10331 & .OR.(NPR.EQ.3.AND.ID.GE.449.AND.ID.LE.457.AND.
10332 & IDHW(MHEP).LE.132.AND.IDHW(NHEP).LE.132.AND.
10333 & IDHW(MHEP-1).LE.132))) THEN
10334 C R-parity violating SUSY decays
10336 C--Rparity slepton colour connections
10337 IF(ID.GE.425.AND.ID.LE.448) THEN
10338 IF(IDHW(MHEP).GT.12) THEN
10339 JMOHEP(2,MHEP) = MHEP
10340 JDAHEP(2,MHEP) = MHEP
10341 JMOHEP(2,NHEP) = NHEP
10342 JDAHEP(2,NHEP) = NHEP
10344 JMOHEP(2,MHEP) = NHEP
10345 JDAHEP(2,MHEP) = NHEP
10346 JMOHEP(2,NHEP) = MHEP
10347 JDAHEP(2,NHEP) = MHEP
10349 C--Rparity squark colour connections
10351 IF(IDHEP(LHEP).GT.0) THEN
10352 C--LQD decay colour connections
10353 IF(IDHW(MHEP).GT.12) THEN
10354 JMOHEP(2,MHEP) = MHEP
10355 JDAHEP(2,MHEP) = MHEP
10356 JMOHEP(2,NHEP) = LHEP
10357 JDAHEP(2,NHEP) = LHEP
10359 C--UDD decay colour connections
10361 CALL HWDRCL(LHEP,MHEP,CLSAVE)
10364 C--Antisquark connections
10365 IF(IDHW(MHEP).GT.12) THEN
10366 JMOHEP(2,MHEP) = MHEP
10367 JDAHEP(2,MHEP) = MHEP
10368 JMOHEP(2,NHEP) = LHEP
10369 JDAHEP(2,NHEP) = LHEP
10372 CALL HWDRCL(LHEP,MHEP,CLSAVE)
10377 IF(ID.GE.450.AND.ID.LE.457) THEN
10378 C--Rparity Neutralino/Chargino colour connection
10379 IF(IDHW(MHEP-1).LE.12.AND.IDHW(MHEP).LE.12.
10380 & AND.IDHW(NHEP).LE.12) THEN
10382 CALL HWDRCL(LHEP,MHEP,CLSAVE)
10384 JMOHEP(2,MHEP) = NHEP
10385 JDAHEP(2,MHEP) = NHEP
10386 JMOHEP(2,NHEP) = MHEP
10387 JDAHEP(2,NHEP) = MHEP
10389 C--Rparity gluino colour connections
10390 ELSEIF(ID.EQ.449) THEN
10391 IF(IDHW(MHEP-1).LE.12.AND.IDHW(MHEP).LE.12.
10392 & AND.IDHW(NHEP).LE.12) THEN
10394 CALL HWDRCL(LHEP,MHEP,CLSAVE)
10395 C--Now the lepton number violating decay
10397 IF(IDHW(MHEP).LE.6) THEN
10398 JMOHEP(2,MHEP) = LHEP
10399 JDAHEP(2,MHEP) = NHEP
10400 JMOHEP(2,NHEP) = MHEP
10401 JDAHEP(2,NHEP) = LHEP
10403 JMOHEP(2,MHEP) = NHEP
10404 JDAHEP(2,MHEP) = LHEP
10405 JMOHEP(2,NHEP) = LHEP
10406 JDAHEP(2,NHEP) = MHEP
10410 CALL HWWARN('HWDHO3',101,*999)
10414 C Normal SUSY decays
10415 IF (ID.LE.448.AND.ID.GT.207) THEN
10416 C Squark (or slepton)
10417 IF (IDHW(MHEP).EQ.449) THEN
10418 IF (IDHEP(LHEP).GT.0) THEN
10419 JMOHEP(2,MHEP)=LHEP
10420 JDAHEP(2,MHEP)=NHEP
10421 JMOHEP(2,NHEP)=MHEP
10422 JDAHEP(2,NHEP)=LHEP
10424 JMOHEP(2,MHEP)=NHEP
10425 JDAHEP(2,MHEP)=LHEP
10426 JMOHEP(2,NHEP)=LHEP
10427 JDAHEP(2,NHEP)=MHEP
10430 IF(NPR.EQ.3.AND.IDHW(MHEP).LE.12) THEN
10431 JMOHEP(2,MHEP)=NHEP
10432 JDAHEP(2,MHEP)=NHEP
10433 JMOHEP(2,NHEP)=MHEP
10434 JDAHEP(2,NHEP)=MHEP
10436 JMOHEP(2,MHEP)=MHEP
10437 JDAHEP(2,MHEP)=MHEP
10438 JMOHEP(2,NHEP)=LHEP
10439 JDAHEP(2,NHEP)=LHEP
10442 ELSEIF (ID.EQ.449) THEN
10444 IF (IDHW(NHEP).EQ.13) THEN
10445 JMOHEP(2,MHEP)=MHEP
10446 JDAHEP(2,MHEP)=MHEP
10447 JMOHEP(2,NHEP)=LHEP
10448 JDAHEP(2,NHEP)=LHEP
10449 ELSEIF (IDHEP(MHEP).GT.0) THEN
10450 JMOHEP(2,MHEP)=LHEP
10451 JDAHEP(2,MHEP)=NHEP
10452 JMOHEP(2,NHEP)=MHEP
10453 JDAHEP(2,NHEP)=LHEP
10455 JMOHEP(2,MHEP)=NHEP
10456 JDAHEP(2,MHEP)=LHEP
10457 JMOHEP(2,NHEP)=LHEP
10458 JDAHEP(2,NHEP)=MHEP
10462 JMOHEP(2,MHEP)=NHEP
10463 JDAHEP(2,MHEP)=NHEP
10464 JMOHEP(2,NHEP)=MHEP
10465 JDAHEP(2,NHEP)=MHEP
10471 *CMZ :- -30/09/02 14:05:28 by Peter Richardson
10472 *-- Author : Ian Knowles & Bryan Webber
10473 C-----------------------------------------------------------------------
10474 SUBROUTINE HWDHO4(IHEP,ID,IM,NPR,MHEP,LHEP,KHEP,PW)
10475 C-----------------------------------------------------------------------
10476 C Subroutine to perform the fourth part of the heavy object decays
10477 C IE parton-showers with special treatment for top
10478 C was part of HWDHOB
10479 C-----------------------------------------------------------------------
10480 INCLUDE 'HERWIG65.INC'
10481 DOUBLE PRECISION PW(5),PDW(5,3)
10482 INTEGER IHEP,ID,IM,I,KHEP,LHEP,MHEP,NPR,NTRY,WHEP,SHEP
10483 DOUBLE COMPLEX RHOIN(2,2)
10484 DATA RHOIN/(0.5D0,0.0D0),(0.0D0,0.0D0),
10485 & (0.0D0,0.0D0),(0.5D0,0.0D0)/
10486 IF (IERROR.NE.0) RETURN
10488 C---SPECIAL CASE FOR THREE-BODY TOP DECAYS:
10489 C RELABEL THEM AS TWO TWO-BODY DECAYS FOR PARTON SHOWERING
10490 IF ((ID.EQ.6.OR.ID.EQ.12).AND.NPR.EQ.3.AND.
10491 & (NME(IM).EQ.100.OR.NME(IM).EQ.200.OR.
10492 & (NME(IM).GT.10000.AND.NME(IM).LE.20000.AND.
10493 & (SYSPIN.OR.THREEB)))) THEN
10494 C---STORE W/H DECAY PRODUCTS
10495 CALL HWVEQU(10,PHEP(1,KHEP),PDW)
10496 C---BOOST THEM INTO W/H REST FRAME
10497 CALL HWULOF(PW,PDW(1,1),PDW(1,3))
10498 C---REPLACE THEM BY W/H
10499 CALL HWVEQU(5,PW,PHEP(1,KHEP))
10501 IF (NME(IM).EQ.100.OR.(NME(IM).GT.10000.AND.
10502 & NME(IM).LE.20000.AND.(SYSPIN.OR.THREEB)))IDHW(KHEP)=198
10503 IF((NME(IM).EQ.100.OR.(NME(IM).GT.10000.AND.
10504 & NME(IM).LE.20000.AND.(SYSPIN.OR.THREEB))).AND.(ID.EQ.12))
10506 IF (NME(IM).EQ.200)IDHW(KHEP)=206
10507 IF((NME(IM).EQ.200).AND.(ID.EQ.12))IDHW(KHEP)=207
10508 IDHEP(KHEP)=IDPDG(IDHW(KHEP))
10509 JMOHEP(2,KHEP)=KHEP
10510 JDAHEP(2,KHEP)=KHEP
10511 CALL HWVEQU(4,VHEP(1,NHEP),VHEP(1,KHEP))
10513 CALL HWVEQU(5,PHEP(1,NHEP),PHEP(1,MHEP))
10514 IDHW(MHEP)=IDHW(NHEP)
10515 IDHEP(MHEP)=IDHEP(NHEP)
10516 JDAHEP(2,LHEP)=MHEP
10517 JMOHEP(2,MHEP)=JMOHEP(2,NHEP)
10518 JDAHEP(2,MHEP)=JDAHEP(2,NHEP)
10519 CALL HWVEQU(4,VHEP(1,NHEP),VHEP(1,MHEP))
10521 C---DO PARTON SHOWER
10524 IF (IERROR.NE.0) RETURN
10525 C---FIND BOOSTED W/H MOMENTUM
10528 IF (NTRY.GT.NHEP.OR.WHEP.LE.0.OR.WHEP.GT.NHEP)
10529 $ CALL HWWARN('HWDHO4',100,*999)
10530 WHEP=JDAHEP(1,WHEP)
10531 IF (ISTHEP(WHEP).NE.190) GOTO 41
10532 C---AND HENCE ITS CHILDRENS MOMENTA
10533 CALL HWULOB(PHEP(1,WHEP),PDW(1,3),PHEP(1,NHEP+1))
10534 CALL HWVDIF(4,PHEP(1,WHEP),PHEP(1,NHEP+1),PHEP(1,NHEP+2))
10535 PHEP(5,NHEP+2)=PDW(5,2)
10539 IDHW(NHEP+I)=IDKPRD(I,IM)
10540 IDHEP(NHEP+I)=IDPDG(IDHW(NHEP+I))
10541 ISTHEP(NHEP+I)=112+I
10542 JDAHEP(I,WHEP)=NHEP+I
10543 JMOHEP(1,NHEP+I)=WHEP
10544 JMOHEP(2,NHEP+I)=NHEP+3-I
10545 JDAHEP(2,NHEP+I)=NHEP+3-I
10548 C---ASSIGN PRODUCTION VERTICES TO 1 AND 2
10549 IF(NME(IM).EQ.100)CALL HWUDKL(198,PW,VHEP(1,NHEP))
10550 IF(NME(IM).EQ.200)CALL HWUDKL(206,PW,VHEP(1,NHEP))
10551 CALL HWVSUM(4,VHEP(1,WHEP),VHEP(1,NHEP),VHEP(1,NHEP))
10552 CALL HWVEQU(4,VHEP(1,NHEP),VHEP(1,NHEP-1))
10553 C---DO PARTON SHOWERS
10555 C--modification to use photos in top decays
10556 IF(ITOPRD.EQ.1) CALL HWPHTP(WHEP)
10557 C--end of modification
10559 IF (IERROR.NE.0) RETURN
10561 C Do parton showers
10564 IF (IERROR.NE.0) RETURN
10565 C--special for gauge boson decay modes of gauginos and four body higgs
10566 C--call routine to add decay products and generate parton shower
10567 IF(NME(IM).GT.20000.AND.NME(IM).LT.30000) THEN
10568 CALL HWDSM3(-1,IHEP,MHEP,SHEP,0,NME(IM)-20000,RHOIN,
10570 ELSEIF(NME(IM).GT.40000.AND.NME(IM).LT.50000) THEN
10571 CALL HWDSM4(2,IHEP,MHEP,SHEP,NME(IM)-40000)
10573 IF (IERROR.NE.0) RETURN
10577 *CMZ :- -17/10/01 10:19:15 by Peter Richardson
10578 *-- Author : Ian Knowles & Bryan Webber
10579 C-----------------------------------------------------------------------
10580 SUBROUTINE HWDHO5(IHEP,MHEP,LHEP,CLSAVE)
10581 C-----------------------------------------------------------------------
10582 C Subroutine to perform the fifth part of the heavy object decays
10583 C IE sort out RPV colour connections
10584 C was part of HWDHOB
10585 C-----------------------------------------------------------------------
10586 INCLUDE 'HERWIG65.INC'
10587 INTEGER IHEP,ID,LHEP,MHEP,IDM,IDM2,THEP,CLSAVE(2)
10588 IF (IERROR.NE.0) RETURN
10589 C--New to correct colour connections in Rslash
10590 IF(CLSAVE(1).NE.0) THEN
10592 ID = IDHW(CLSAVE(1))
10593 IDM = IDHW(JMOHEP(1,CLSAVE(1)))
10595 IF(IDM.EQ.15) ID=IDHW(JMOHEP(1,JMOHEP(1,CLSAVE(1))))
10596 IF((ID.LE.6.AND.((IDM.GE.419.AND.IDM.LE.424).OR.IDM.EQ.411.OR.
10598 & AND.((IDM2.GE.413.AND.IDM2.LE.418)
10599 & .OR.IDM2.EQ.449).OR.IDM2.EQ.405.OR.IDM2.EQ.406)
10600 & .OR.(ID.LE.6.AND.IDM.EQ.449.AND.
10601 & (((IDM2.GE.413.AND.IDM2.LE.418).OR.IDM2.EQ.405.OR.IDM2.EQ.406)
10602 & .OR.IDM2.EQ.449)).OR.
10603 & (IDM.EQ.15.AND.ID.LE.12.AND.ID.GE.7.AND.((IDM2.GE.413.AND.
10604 & IDM2.LE.418).OR.IDM2.EQ.449.OR.IDM2.
10605 & EQ.405.OR.IDM2.EQ.406))) THEN
10606 IF(JMOHEP(2,CLSAVE(1)).EQ.MHEP) THEN
10607 IF(IDHW(CLSAVE(1)).NE.13.AND.IDHW(CLSAVE(1)).NE.449)
10608 & JMOHEP(2,CLSAVE(2)) = THEP
10609 JDAHEP(2,MHEP) = CLSAVE(1)
10610 JDAHEP(2,THEP) = CLSAVE(2)
10612 IF(IDHW(CLSAVE(1)).NE.13.AND.IDHW(CLSAVE(1)).NE.449)
10613 & JMOHEP(2,CLSAVE(2)) = MHEP
10614 JDAHEP(2,MHEP) = CLSAVE(2)
10615 JDAHEP(2,THEP) = CLSAVE(1)
10617 ELSEIF((ID.GT.6.AND.ID.LE.12.
10618 & AND.((IDM.GE.413.AND.IDM.LE.418).OR.IDM.EQ.405.OR.
10620 & ((IDM2.GE.419.AND.IDM2.LE.424).OR.IDM2.EQ.449.OR.
10621 & IDM2.EQ.411.OR.IDM2.EQ.412)).OR.
10622 & (ID.GT.6.AND.ID.LE.12.AND.IDM.EQ.449.
10623 & AND.((IDM2.GE.419.AND.IDM2.LE.424).OR.IDM2.EQ.449.OR.
10624 & IDM2.EQ.411.OR.IDM2.EQ.412)).OR.
10625 & (IDM.EQ.15.AND.ID.LE.6.AND.((IDM2.GE.419.AND.
10626 & IDM2.LE.424).OR.IDM2.EQ.449.OR.IDM2.EQ.411.OR.
10627 & IDM2.EQ.412))) THEN
10628 IF(JDAHEP(2,CLSAVE(1)).EQ.MHEP) THEN
10629 JDAHEP(2,CLSAVE(2))=THEP
10630 JMOHEP(2,MHEP)=CLSAVE(1)
10631 JMOHEP(2,THEP)=CLSAVE(2)
10633 JDAHEP(2,CLSAVE(2))=MHEP
10634 JMOHEP(2,MHEP)=CLSAVE(2)
10635 JMOHEP(2,THEP)=CLSAVE(1)
10643 *CMZ :- -17/10/01 10:19:15 by Peter Richardson
10644 *-- Author : Ian Knowles & Bryan Webber
10645 C-----------------------------------------------------------------------
10647 C-----------------------------------------------------------------------
10648 C Subroutine to perform the final part of the heavy object decays
10649 C IE sort out any colour connection problems
10650 C-----------------------------------------------------------------------
10651 INCLUDE 'HERWIG65.INC'
10652 INTEGER IHEP,IM,JHEP,ISM,JCM
10653 IF (IERROR.NE.0) RETURN
10654 C Fix any SUSY colour disconnections
10656 IF (ISTHEP(IHEP).GE.147.AND.ISTHEP(IHEP).LE.151
10657 & .AND.JDAHEP(2,IHEP).EQ.0) THEN
10659 C Chase connection back through SUSY decays
10662 IF (ISM.EQ.120) GOTO 80
10663 IF (ISM.NE.123.AND.ISM.NE.124.AND.ISM.NE.155) GOTO 75
10664 C Look for unclustered parton to connect
10666 IF (ISTHEP(JHEP).GE.147.AND.ISTHEP(JHEP).LE.151) THEN
10668 IF (JCM.EQ.IM) THEN
10669 C Found it: connect
10670 JMOHEP(2,JHEP)=IHEP
10671 JDAHEP(2,IHEP)=JHEP
10676 C Not found: need to go further back
10682 *CMZ :- -26/04/91 12.19.24 by Federico Carminati
10683 *-- Author : Ian Knowles & Bryan Webber
10684 C-----------------------------------------------------------------------
10686 C-----------------------------------------------------------------------
10687 C Performs partonic decays of hadrons containing heavy quark(s):
10688 C either, meson/baryon spectator model weak decays;
10689 C or, quarkonia -> 2-gluons, q-qbar, 3-gluons, or 2-gluons + photon.
10690 C-----------------------------------------------------------------------
10691 INCLUDE 'HERWIG65.INC'
10693 COMMON/SFF/IT1,IB1,IT2,IB2
10694 DOUBLE PRECISION TB,BT
10695 INTEGER IT1,IB1,IT2,IB2
10696 DOUBLE PRECISION GAMHPM
10697 DOUBLE PRECISION HWULDO,HWRGEN,XS,XB,EMWSQ,GMWSQ,EMLIM,PW(4),
10698 & EMTST,X1,X2,X3,TEST,HWDWWT,HWDHWT,HWDPWT
10699 INTEGER IST(3),I,IHEP,IM,ID,IDQ,IQ,IS,J
10700 EXTERNAL HWRGEN,HWDWWT,HWDHWT,HWDPWT,HWULDO
10701 DATA IST/113,114,114/
10702 IF (IERROR.NE.0) RETURN
10704 IF (I.GT.NQDK) THEN
10709 IF (ISTHEP(IHEP).EQ.199) GOTO 100
10711 IF (NHEP+NPRODS(IM).GT.NMXHEP) CALL HWWARN('HWDHVY',100,*999)
10712 IF (IDKPRD(4,IM).NE.0) THEN
10713 C Weak decay of meson or baryon
10714 C Idenitify decaying heavy quark and spectator
10716 IF (ID.EQ.136.OR.ID.EQ.140.OR.ID.EQ.144.OR.
10717 & ID.EQ.150.OR.ID.EQ.155.OR.ID.EQ.158.OR.ID.EQ.161.OR.
10718 & (ID.EQ.254.AND.IDKPRD(4,IM).EQ.11)) THEN
10719 C c hadron or c decay of B_c+
10723 ELSEIF (ID.EQ.171.OR.ID.EQ.175.OR.ID.EQ.179.OR.
10724 & ID.EQ.185.OR.ID.EQ.190.OR.ID.EQ.194.OR.ID.EQ.196.OR.
10725 & (ID.EQ.230.AND.IDKPRD(4,IM).EQ.5)) THEN
10726 C cbar hadron or cbar decay of B_c-
10730 ELSEIF ((ID.GE.221.AND.ID.LE.229).OR.
10731 & (ID.EQ.230.AND.IDKPRD(4,IM).EQ.10)) THEN
10732 C b hadron or b decay of B_c-
10736 ELSEIF ((ID.GE.245.AND.ID.LE.253).OR.
10737 & (ID.EQ.254.AND.IDKPRD(4,IM).EQ.4)) THEN
10738 C bbar hadron or bbar decay of B_c+
10743 C Decay not recognized
10744 CALL HWWARN('HWDHVY',101,*999)
10746 C Label constituents
10747 IF (NHEP+5.GT.NMXHEP) CALL HWWARN('HWDHVY',102,*999)
10749 JDAHEP(1,IHEP)=NHEP+1
10750 JDAHEP(2,IHEP)=NHEP+2
10752 IDHW(IS)=IDKPRD(4,IM)
10753 IDHEP(IQ)=IDPDG(IDQ)
10754 IDHEP(IS)=IDPDG(IDKPRD(4,IM))
10759 JDAHEP(1,IQ)=NHEP+3
10760 JDAHEP(2,IQ)=NHEP+5
10762 JMOHEP(2,IS)=NHEP+5
10764 JDAHEP(2,IS)=NHEP+5
10766 C and weak decay product jets
10769 IDHW(NHEP)=IDKPRD(J,IM)
10770 IDHEP(NHEP)=IDPDG(IDKPRD(J,IM))
10771 ISTHEP(NHEP)=IST(J)
10774 10 PHEP(5,NHEP)=RMASS(IDKPRD(J,IM))
10775 JMOHEP(2,NHEP-2)=NHEP-1
10776 JDAHEP(2,NHEP-2)=NHEP-1
10777 JMOHEP(2,NHEP-1)=NHEP-2
10778 JDAHEP(2,NHEP-1)=NHEP-2
10781 C Share momenta in ratio of masses, preserving specator mass
10782 XS=RMASS(IDHW(IS))/PHEP(5,IHEP)
10784 CALL HWVSCA(5,XB,PHEP(1,IHEP),PHEP(1,IQ))
10785 CALL HWVSCA(5,XS,PHEP(1,IHEP),PHEP(1,IS))
10786 IF (NME(IM).EQ.100) THEN
10787 C Generate decay momenta using full (V-A)*(V-A) matrix element
10788 EMWSQ=RMASS(198)**2
10789 GMWSQ=(RMASS(198)*GAMW)**2
10790 EMLIM=GMWSQ+(EMWSQ-(PHEP(5,IQ)-PHEP(5,NHEP))**2)**2
10791 20 CALL HWDTHR(PHEP(1,IQ ),PHEP(1,NHEP-1),
10792 & PHEP(1,NHEP-2),PHEP(1,NHEP),HWDWWT)
10793 CALL HWVSUM(4,PHEP(1,NHEP-2),PHEP(1,NHEP-1),PW)
10794 EMTST=(HWULDO(PW,PW)-EMWSQ)**2
10795 IF ((EMTST+GMWSQ)*HWRGEN(0).GT.EMLIM) GOTO 20
10796 ELSEIF (NME(IM).EQ.200) THEN
10797 C Generate decay momenta using full
10798 C ((V-A)*TB1+(V+A)*CT1)*((V-A)*TB2+(V+A)*CT2)) matrix element
10799 GAMHPM=RMASS(206)/DKLTM(206)
10801 IF((IQ.EQ. 2).OR.(IQ.EQ. 4).OR.
10802 & (IQ.EQ. 6).OR.(IQ.EQ. 8).OR.
10803 & (IQ.EQ. 10).OR.(IQ.EQ. 12).OR.
10804 & (IQ.EQ.122).OR.(IQ.EQ.124).OR.
10805 & (IQ.EQ.126).OR.(IQ.EQ.128).OR.
10806 & (IQ.EQ.130).OR.(IQ.EQ.132))THEN
10811 IF((IDKPRD(1,IM).EQ. 2).OR.(IDKPRD(1,IM).EQ. 4).OR.
10812 & (IDKPRD(1,IM).EQ. 6).OR.(IDKPRD(1,IM).EQ. 8).OR.
10813 & (IDKPRD(1,IM).EQ. 10).OR.(IDKPRD(1,IM).EQ. 12).OR.
10814 & (IDKPRD(1,IM).EQ.122).OR.(IDKPRD(1,IM).EQ.124).OR.
10815 & (IDKPRD(1,IM).EQ.126).OR.(IDKPRD(1,IM).EQ.128).OR.
10816 & (IDKPRD(1,IM).EQ.130).OR.(IDKPRD(1,IM).EQ.132))THEN
10825 EMWSQ=RMASS(206)**2
10826 GMWSQ=(RMASS(206)*GAMHPM)**2
10827 EMLIM=GMWSQ+(EMWSQ-(PHEP(5,IQ)-PHEP(5,NHEP))**2)**2
10828 25 CALL HWDTHR(PHEP(1,IQ ),PHEP(1,NHEP),
10829 & PHEP(1,NHEP-2),PHEP(1,NHEP-1),HWDHWT)
10830 CALL HWVSUM(4,PHEP(1,NHEP-2),PHEP(1,NHEP-1),PW)
10831 EMTST=(HWULDO(PW,PW)-EMWSQ)**2
10832 IF ((EMTST+GMWSQ)*HWRGEN(0).GT.EMLIM) GOTO 25
10835 CALL HWDTHR(PHEP(1,IQ ),PHEP(1,NHEP-2),
10836 & PHEP(1,NHEP-1),PHEP(1,NHEP),HWDPWT)
10837 CALL HWVSUM(4,PHEP(1,NHEP-2),PHEP(1,NHEP-1),PW)
10839 C Set up production vertices
10840 CALL HWVZRO(4,VHEP(1,IQ))
10841 CALL HWVEQU(4,VHEP(1,IQ),VHEP(1,IS))
10842 CALL HWVEQU(4,VHEP(1,IQ),VHEP(1,NHEP))
10843 CALL HWUDKL(198,PW,VHEP(1,NHEP-2))
10844 CALL HWVSUM(4,VHEP(1,IQ),VHEP(1,NHEP-2),VHEP(1,NHEP-2))
10845 CALL HWVEQU(4,VHEP(1,NHEP-2),VHEP(1,NHEP-1))
10851 JDAHEP(1,IHEP)=NHEP+1
10852 DO 30 J=1,NPRODS(IM)
10854 IDHW(NHEP)=IDKPRD(J,IM)
10855 IDHEP(NHEP)=IDPDG(IDKPRD(J,IM))
10856 ISTHEP(NHEP)=IST(J)
10857 JMOHEP(1,NHEP)=IHEP
10859 PHEP(5,NHEP)=RMASS(IDKPRD(J,IM))
10860 30 CALL HWVZRO(4,VHEP(1,NHEP))
10861 JDAHEP(2,IHEP)=NHEP
10862 C Establish colour connections and select momentum configuration
10863 IF (NPRODS(IM).EQ.3) THEN
10864 IF (IDKPRD(3,IM).EQ.13) THEN
10866 JMOHEP(2,NHEP-2)=NHEP
10867 JMOHEP(2,NHEP-1)=NHEP-2
10868 JMOHEP(2,NHEP )=NHEP-1
10869 JDAHEP(2,NHEP-2)=NHEP-1
10870 JDAHEP(2,NHEP-1)=NHEP
10871 JDAHEP(2,NHEP )=NHEP-2
10873 C or 2-gluon + photon decay
10874 JMOHEP(2,NHEP-2)=NHEP-1
10875 JMOHEP(2,NHEP-1)=NHEP-2
10876 JMOHEP(2,NHEP )=NHEP
10877 JDAHEP(2,NHEP-2)=NHEP-1
10878 JDAHEP(2,NHEP-1)=NHEP-2
10879 JDAHEP(2,NHEP )=NHEP
10881 IF (NME(IM).EQ.130) THEN
10882 C Use Ore & Powell orthopositronium matrix element
10883 40 CALL HWDTHR(PHEP(1,IHEP),PHEP(1,NHEP-2),
10884 & PHEP(1,NHEP-1),PHEP(1,NHEP),HWDPWT)
10885 X1=TWO*HWULDO(PHEP(1,IHEP),PHEP(1,NHEP-2))/PHEP(5,IHEP)**2
10886 X2=TWO*HWULDO(PHEP(1,IHEP),PHEP(1,NHEP-1))/PHEP(5,IHEP)**2
10888 TEST=((X1*(ONE-X1))**2+(X2*(ONE-X2))**2+(X3*(ONE-X3))**2)
10890 IF (TEST.LT.TWO*HWRGEN(0)) GOTO 40
10893 CALL HWDTHR(PHEP(1,IHEP),PHEP(1,NHEP-2),
10894 & PHEP(1,NHEP-1),PHEP(1,NHEP),HWDPWT)
10897 C Parapositronium 2-gluon or q-qbar decay
10898 JMOHEP(2,NHEP-1)=NHEP
10899 JMOHEP(2,NHEP )=NHEP-1
10900 JDAHEP(2,NHEP-1)=NHEP
10901 JDAHEP(2,NHEP )=NHEP-1
10902 CALL HWDTWO(PHEP(1,IHEP),PHEP(1,NHEP-1),
10903 & PHEP(1,NHEP),CMMOM(IM),TWO,.FALSE.)
10907 C Process this new hard scatter
10908 CALL HWVEQU(4,VTXQDK(1,I),VTXPIP)
10917 *CMZ :- -20/07/99 10:56:12 by Peter Richardson
10918 *-- Author : Peter Richardson
10919 C-----------------------------------------------------------------------
10920 SUBROUTINE HWDRCL(IHEP,MHEP,CLSAVE)
10921 C-----------------------------------------------------------------------
10922 C Sets the colour connections in Baryon number violating decays
10923 C-----------------------------------------------------------------------
10924 INCLUDE 'HERWIG65.INC'
10925 INTEGER IHEP,MHEP,ID,ID2,IDM2,IDM3,COLCON(2,2,3),FLACON(2,3),JHEP,
10926 & DECAY,COLANT,KHEP,IDM,IDMB,IDMB2,IDMB3,IDMB4,QHEP,IDM4,
10927 & CLSAVE(2),XHEP,I,HWRINT,THEP
10929 C--Colour connections for the decays
10930 DATA COLCON/-1,1,-1,-2,-2,1,-3,-1,-1,1,-2,-1/
10931 DATA FLACON/1,-1,1,-1,-1,0/
10932 C--identify the decay
10933 IF(IERROR.NE.0) RETURN
10936 IF(ID.GE.450.AND.ID.LE.457) THEN
10938 ELSEIF(ID.EQ.449) THEN
10940 ELSEIF((ID.GE.411.AND.ID.LE.424).OR.ID.EQ.405.OR.ID.EQ.406) THEN
10944 CALL HWWARN('HWDRCL',100,*999)
10947 C--identify the colour partner
10948 IF(DECAY.GT.1.AND.ID2.LE.6) THEN
10951 KHEP = JDAHEP(2,IHEP-1)
10952 ELSEIF(DECAY.GT.1.AND.ID2.GE.7) THEN
10953 C--anticolour partner
10955 KHEP = JMOHEP(2,IHEP)
10959 IDM = IDHW(JMOHEP(1,KHEP))
10960 IF(ABS(IDPDG(IDM)).GT.1000000.OR.IDM.EQ.15) THEN
10961 IDM2 = IDHW(JDAHEP(1,JMOHEP(1,KHEP)))
10962 IDM3 = IDHW(JDAHEP(2,JMOHEP(1,KHEP)))
10963 IDM4 = IDHW(JDAHEP(2,JMOHEP(1,KHEP))-1)
10964 QHEP = JMOHEP(1,KHEP)
10965 IDMB = IDHW(JMOHEP(1,QHEP))
10966 IDMB2 = IDHW(JMOHEP(2,QHEP))
10967 IDMB3 = IDHW(JDAHEP(1,QHEP))
10968 IDMB4 = IDHW(JDAHEP(2,QHEP))
10970 C--Now decide if the colour partner decayed via BV
10971 IF(COLANT.EQ.2.AND.((((IDM.GE.413.AND.IDM.LE.418).OR.
10972 & IDM.EQ.449.OR.IDM.EQ.405.OR.IDM.EQ.406).AND.
10973 & (IDM2.GE.7.AND.IDM2.LE.12.AND.
10974 & IDM3.GE.7.AND.IDM3.LE.12.AND.
10975 & IDM4.GE.7.AND.IDM4.LE.12)).OR.
10976 & (IDM.EQ.15.AND.IDMB.LE.6.AND.IDMB2.LE.6.AND.
10977 & ((IDMB3.GE.7.AND.IDMB4.GE.12.AND.IDMB4.EQ.449).OR.
10978 & (IDMB3.GE.198.AND.IDMB3.LE.207.AND.
10979 & ABS(IDPDG(IDMB4)).GT.1000000))))) THEN
10983 XHEP = JMOHEP(2,JDAHEP(2,JMOHEP(1,KHEP)))
10984 ELSEIF(COLANT.EQ.3.AND.((((IDM.GE.419.AND.IDM.LE.424).OR.
10985 & IDM.EQ.449.OR.IDM.EQ.411.OR.IDM.EQ.412).AND.
10986 & (IDM2.LE.6.AND.IDM3.LE.6.AND.IDM4.LE.6)).OR.
10987 & (IDM.EQ.15.AND.IDMB.GE.7.AND.IDMB.LE.12.AND.
10988 & IDMB2.GE.7.AND.IDMB2.LE.12.AND.((IDMB3.LE.6.AND.
10989 & IDMB4.EQ.449).OR.(ABS(IDPDG(IDMB4)).GT.1000000
10990 & .AND.IDMB3.GE.198.AND.IDMB3.LE.207))))) THEN
10994 XHEP = JDAHEP(2,JDAHEP(2,JMOHEP(1,KHEP)))
11002 CLSAVE(1) = JDAHEP(2,JMOHEP(1,KHEP))-1
11003 CLSAVE(2) = CLSAVE(1)+1
11005 IF(IDMB4.EQ.449) THEN
11007 CLSAVE(I) = JMOHEP(I,JMOHEP(1,KHEP))
11008 IF(CLSAVE(I).EQ.XHEP) CLSAVE(I)=JDAHEP(1,JMOHEP(1,KHEP))
11011 CLSAVE(1) = JMOHEP(1,JMOHEP(1,KHEP))
11012 CLSAVE(2) = JMOHEP(2,JMOHEP(1,KHEP))
11019 C--Now set the colours for angular ordering
11021 IF(DECAY.EQ.1) THEN
11023 JMOHEP(2,THEP) = THEP+HWRINT(1,2)
11024 JDAHEP(2,THEP) = THEP
11026 JMOHEP(2,THEP) = THEP
11027 JDAHEP(2,THEP) = THEP+HWRINT(1,2)
11029 ELSEIF(DECAY.EQ.2) THEN
11031 JMOHEP(2,THEP) = IHEP
11032 JDAHEP(2,THEP) = THEP
11034 JMOHEP(2,THEP) = THEP
11035 JDAHEP(2,THEP) = IHEP
11038 C--Colour of the second two
11041 JMOHEP(2,MHEP+JHEP-1) = MHEP+JHEP-1+
11042 & COLCON(HWRINT(1,2),JHEP,DECAY)
11043 JDAHEP(2,MHEP+JHEP-1) = MHEP+JHEP-1+FLACON(JHEP,DECAY)
11045 JDAHEP(2,MHEP+JHEP-1) = MHEP+JHEP-1+
11046 & COLCON(HWRINT(1,2),JHEP,DECAY)
11047 JMOHEP(2,MHEP+JHEP-1) = MHEP+JHEP-1+FLACON(JHEP,DECAY)
11050 C--Now set the colours of the colour partner
11051 IF(DECAY.GT.1.AND..NOT.CONBV) THEN
11052 IF(ID2.LE.6) JMOHEP(2,KHEP) = MHEP+HWRINT(0,1)
11053 IF(ID2.GE.7) JDAHEP(2,KHEP) = MHEP+HWRINT(0,1)
11056 JMOHEP(2,CLSAVE(1)) = MHEP+HWRINT(0,1)
11057 IF(JMOHEP(2,CLSAVE(1)).EQ.MHEP) THEN
11058 JMOHEP(2,CLSAVE(2)) = MHEP+1
11060 JMOHEP(2,CLSAVE(2)) = MHEP
11063 JDAHEP(2,CLSAVE(1)) = MHEP+HWRINT(0,1)
11064 IF(JDAHEP(2,CLSAVE(1)).EQ.MHEP) THEN
11065 JDAHEP(2,CLSAVE(2)) = MHEP+1
11067 JDAHEP(2,CLSAVE(2)) = MHEP
11073 *CMZ :- -20/07/99 10:56:12 by Peter Richardson
11074 *-- Author : Peter Richardson
11075 C-----------------------------------------------------------------------
11076 SUBROUTINE HWDRME(LHEP,MHEP)
11077 C-----------------------------------------------------------------------
11078 C SUBROUTINE TO IMPLEMENT ALL RPARITY DECAY MATRIX ELEMENTS
11079 C-----------------------------------------------------------------------
11080 INCLUDE 'HERWIG65.INC'
11081 DOUBLE PRECISION SM(6),SW(6),HWULDO,INFCOL,AM, M12SQ,M23SQ,MSGN,
11082 & M13SQ,A(6),B(6),SWEAK,MW,DECMOM(5),TEST(3),EPS,
11083 & M12SQT(6),M23SQT(6),M13SQT(6),LIMIT,M(4),RAND,
11084 & MC(2),MX2(6),MX(6),HWDPWT,HWRGEN,HWDRM1,LAMD(3),
11086 EXTERNAL HWDRM1,HWULDO,HWDPWT,HWRGEN
11087 INTEGER K,SN(3),LHEP,CSP,I,SB(3),J,ND,LTRY,MHEP,NSP,ID(3),IG,
11088 & IDHWTP,IDHPTP,MTRY
11089 PARAMETER(EPS=1D-20)
11090 IF(IERROR.NE.0) RETURN
11091 C--Electroweak parameters, etc
11092 SWEAK = SQRT(SWEIN)
11094 M(4) = PHEP(5,LHEP)
11096 C--Find the masses of the final state and zero parameters
11098 ID(K) = IDHW(MHEP+K-1)
11099 IF(ID(K).LE.12) THEN
11104 IF(SN(K).GT.6) SN(K)=SN(K)-6
11105 M(K) = PHEP(5,LHEP+K)
11116 C--Evaluate the coefficents for the mode we want
11117 IF(IG.GE.450.AND.IG.LE.453) THEN
11122 MC(1) = ZMIXSS(NSP,3)/(2*MW*COSB*SWEAK)
11123 MC(2) = ZMIXSS(NSP,4)/(2*MW*SINB*SWEAK)
11124 C--Calculate the combinations of couplings needed
11125 IF(ID(1).LE.12.AND.ID(2).LE.12.AND.ID(3).LE.12) THEN
11126 C--first for the UDD modes
11128 A(J) = M(1)*MC(2)*QMIXSS(SN(1),2,J)
11129 & +SLFCH(SN(1),NSP)*QMIXSS(SN(1),1,J)
11130 B(J) = MSGN*(M(1)*MC(2)*QMIXSS(SN(1),1,J)
11131 & +SRFCH(SN(1),NSP)*QMIXSS(SN(1),2,J))
11132 MX2(J) = QMIXSS(SN(1),2,J)
11133 A(J+2) = M(2)*MC(1)*QMIXSS(SN(2),2,J)
11134 & +SLFCH(SN(2),NSP)*QMIXSS(SN(2),1,J)
11135 B(J+2) = MSGN*(M(2)*MC(1)*QMIXSS(SN(2),1,J)
11136 & +SRFCH(SN(2),NSP)*QMIXSS(SN(2),2,J))
11137 MX2(J+2) = QMIXSS(SN(2),2,J)
11138 A(J+4) = M(3)*MC(1)*QMIXSS(SN(3),2,J)
11139 & +SLFCH(SN(3),NSP)*QMIXSS(SN(3),1,J)
11140 B(J+4) = MSGN*(M(3)*MC(1)*QMIXSS(SN(3),1,J)
11141 & +SRFCH(SN(3),NSP)*QMIXSS(SN(3),2,J))
11142 MX2(J+2) = QMIXSS(SN(3),2,J)
11148 ELSEIF(ID(1).GE.121.AND.ID(2).GE.121.AND.ID(3).GE.121) THEN
11149 C--Now for the LLE modes
11151 A(J) = MSGN*(M(1)*MC(1)*LMIXSS(SN(1),1,J)
11152 & +SRFCH(10+SN(1),NSP)*LMIXSS(SN(1),2,J))
11153 B(J) = M(1)*MC(1)*LMIXSS(SN(1),2,J)
11154 & +SLFCH(10+SN(1),NSP)*LMIXSS(SN(2),1,J)
11155 MX2(J)= LMIXSS(SN(1),1,J)
11157 B(J+2) = SLFCH(10+SN(2),NSP)*LMIXSS(SN(2),1,J)
11158 MX2(J+2) = LMIXSS(SN(2),1,J)
11159 A(J+4) = M(3)*MC(1)*LMIXSS(SN(3),2,J)
11160 & +SLFCH(10+SN(3),NSP)*LMIXSS(SN(3),1,J)
11161 B(J+4) = MSGN*(M(3)*MC(1)*LMIXSS(SN(3),1,J)
11162 & +SRFCH(10+SN(3),NSP)*LMIXSS(SN(3),2,J))
11163 MX2(4+J) = LMIXSS(SN(3),2,J)
11166 SN(J) = SN(J) + 424
11167 SB(J) = SB(J) + 436
11170 C--Now for both types of LQD modes
11171 IF(MOD(SN(1),2).EQ.0) THEN
11172 C--First the neutrino,down,antidown mode
11175 B(J) = SLFCH(10+SN(1),NSP)*
11176 & LMIXSS(SN(1),1,J)
11177 MX2(J) = LMIXSS(SN(1),1,J)
11178 A(J+2) = MSGN*(M(2)*MC(1)*QMIXSS(SN(2),1,J)
11179 & +SRFCH(SN(2),NSP)*QMIXSS(SN(2),2,J))
11180 B(J+2) = M(2)*MC(1)*QMIXSS(SN(2),2,J)
11181 & +SLFCH(SN(2),NSP)*QMIXSS(SN(2),1,J)
11182 MX2(2+J) = QMIXSS(SN(2),1,J)
11183 A(J+4) = M(3)*MC(1)*QMIXSS(SN(3),2,J)
11184 & +SLFCH(SN(3),NSP)*QMIXSS(SN(3),1,J)
11185 B(J+4) = MSGN*(M(3)*MC(1)*QMIXSS(SN(3),1,J)
11186 & +SRFCH(SN(3),NSP)*QMIXSS(SN(3),2,J))
11187 MX2(J+4) = QMIXSS(SN(3),2,J)
11190 C--Now the charged lepton, antiup,down modes
11192 A(J) = MSGN*(M(1)*MC(1)*LMIXSS(SN(1),1,J)
11193 & +SRFCH(10+SN(1),NSP)*LMIXSS(SN(1),2,J))
11194 B(J) = M(1)*MC(1)*LMIXSS(SN(1),2,J)
11195 & +SLFCH(10+SN(1),NSP)*LMIXSS(SN(1),1,J)
11196 MX2(J) = LMIXSS(SN(1),1,J)
11197 A(J+2) =MSGN*(M(2)*MC(2)*QMIXSS(SN(2),1,J)
11198 & +SRFCH(SN(2),NSP)*QMIXSS(SN(2),2,J))
11199 B(J+2) = M(2)*MC(2)*QMIXSS(SN(2),2,J)
11200 & +SLFCH(SN(2),NSP)*QMIXSS(SN(2),1,J)
11201 MX2(2+J) = QMIXSS(SN(2),1,J)
11202 A(J+4) = M(3)*MC(1)*QMIXSS(SN(3),2,J)
11203 & +SLFCH(SN(3),NSP)*QMIXSS(SN(3),1,J)
11204 B(J+4) = MSGN*(M(3)*MC(1)*QMIXSS(SN(3),1,J)
11205 & +SRFCH(SN(3),NSP)*QMIXSS(SN(3),2,J))
11206 MX2(J+4) = QMIXSS(SN(3),2,J)
11209 SN(1) = SN(1) + 424
11210 SB(1) = SB(1) + 436
11212 SN(J) = SN(J) + 400
11213 SB(J) = SB(J) + 412
11217 SM(2*K-1) = RMASS(SN(K))
11218 SM(2*K) = RMASS(SB(K))
11219 SW(2*K-1) = HBAR/RLTIM(SN(K))
11220 SW(2*K) = HBAR/RLTIM(SB(K))
11227 ELSEIF(IG.EQ.449) THEN
11229 C--First obtian the masses and widths needed
11232 C--Calculate the combinations of couplings needed
11233 IF(ID(1).LE.12.AND.ID(2).LE.12.AND.ID(3).LE.12) THEN
11234 C--first for the UDD modes
11239 A(2*I-2+J) = -QMIXSS(SN(I),1,J)
11240 B(2*I-2+J) = QMIXSS(SN(I),2,J)
11241 MX2(2*I-2+J) = QMIXSS(SN(I),2,J)
11248 C--Now for both types of LQD modes
11249 IF(MOD(SN(1),2).EQ.0) THEN
11250 C--First the neutrino,down,antidown mode
11255 A(J+2) = QMIXSS(SN(2),2,J)
11256 B(J+2) = -QMIXSS(SN(2),1,J)
11257 MX2(J+2) = QMIXSS(SN(2),1,J)
11258 A(J+4) = -QMIXSS(SN(3),1,J)
11259 B(J+4) = QMIXSS(SN(3),2,J)
11260 MX2(4+J) = QMIXSS(SN(3),2,J)
11262 ELSEIF(MOD(SN(1),2).EQ.1) THEN
11263 C--Now the charged lepton, antiup,down modes
11268 A(J+2) = QMIXSS(SN(2),2,J)
11269 B(J+2) = -QMIXSS(SN(2),1,J)
11270 MX2(J+2) = QMIXSS(SN(2),1,J)
11271 A(J+4) = -QMIXSS(SN(3),1,J)
11272 B(J+4) = QMIXSS(SN(3),2,J)
11273 MX2(J+4) = QMIXSS(SN(3),2,J)
11276 SN(1) = SN(1) + 424
11277 SB(1) = SB(1) + 436
11279 SN(K) = SN(K) + 400
11280 SB(K) = SB(K) + 412
11284 SM(2*K-1) = RMASS(SN(K))
11285 SM(2*K) = RMASS(SB(K))
11286 SW(2*K-1) = HBAR/RLTIM(SN(K))
11287 SW(2*K) = HBAR/RLTIM(SB(K))
11292 ELSEIF(IG.GE.454.AND.IG.LE.457) THEN
11295 IF(CSP.GT.2) CSP = CSP-2
11299 MC(1) = ONE/(SQRT(2.0D0)*MW*COSB)
11300 MC(2) = ONE/(SQRT(2.0D0)*MW*SINB)
11301 C--Calculate the combinations of the couplings needed
11302 IF(ID(1).GT.120.AND.ID(2).GT.120.AND.ID(3).GT.120) THEN
11303 C--first for the LLE modes, three modes
11304 IF(MOD(SN(1),2).EQ.0.AND.MOD(SN(3),2).EQ.0) THEN
11305 C--the one diagram mode nubar,positron, nu
11307 A(J+4) = LMIXSS(SN(3)-1,1,J)*WMXUSS(CSP,1)
11308 & -RMASS(SN(3)+119)*MC(1)*LMIXSS(SN(3)-1,2,J)*WMXUSS(CSP,2)
11310 MX2(J+4) = LMIXSS(SN(3)-1,2,J)
11315 ELSEIF(MOD(SN(1),2).EQ.0.AND.MOD(SN(2),2).EQ.0) THEN
11316 C--the first two diagram mode nu, nu, positron
11319 B(J) = LMIXSS(SN(1)-1,1,J)*WMXUSS(CSP,1)
11320 & -RMASS(SN(1)+119)*MC(1)*LMIXSS(SN(1)-1,2,J)*WMXUSS(CSP,2)
11322 B(J+2) = LMIXSS(SN(2)-1,1,J)*WMXUSS(CSP,1)
11323 & -RMASS(SN(2)+119)*MC(1)*LMIXSS(SN(2)-1,2,J)*WMXUSS(CSP,2)
11324 MX2(J) = LMIXSS(SN(1)-1,1,J)
11325 MX2(J+2) = LMIXSS(SN(2)-1,1,J)
11333 C--the second two diagram mode positron, positron, electron
11335 A(J) = -M(1)*WMXUSS(CSP,2)*MC(1)*LMIXSS(SN(1)+1,1,J)
11336 B(J) = MSGN*WMXVSS(CSP,1)*LMIXSS(SN(1)+1,1,J)
11337 A(J+2) = -M(2)*WMXUSS(CSP,2)*MC(1)*LMIXSS(SN(2)+1,1,J)
11338 B(J+2) = MSGN*WMXVSS(CSP,1)*LMIXSS(SN(2)+1,1,J)
11339 MX2(J) = LMIXSS(SN(1)+1,1,J)
11340 MX2(J+2) = LMIXSS(SN(2)+1,1,J)
11351 ELSEIF(ID(1).LE.12.AND.ID(2).LE.12.AND.ID(3).LE.12) THEN
11353 IF(MOD(SN(1),2).EQ.0) THEN
11354 C--two diagram mode
11355 LAMD(1) = LAMDA3(SN(2)/2,SN(1)/2,(SN(3)+1)/2)
11356 LAMD(2) = LAMDA3(SN(1)/2,SN(2)/2,(SN(3)+1)/2)
11358 A(J) = WMXUSS(CSP,1)*QMIXSS(SN(1)-1,1,J)
11359 & -RMASS(SN(1)-1)*MC(1)*WMXUSS(CSP,2)*QMIXSS(SN(1)-1,2,J)
11360 B(J) = -MSGN*M(2)*WMXVSS(CSP,2)*QMIXSS(SN(1)-1,1,J)
11361 A(J+2) = WMXUSS(CSP,1)*QMIXSS(SN(2)-1,1,J)
11362 & -RMASS(SN(2)-1)*MC(1)*WMXUSS(CSP,2)*QMIXSS(SN(2)-1,2,J)
11363 B(J+2) = -MSGN*M(2)*WMXVSS(CSP,2)*QMIXSS(SN(2)-1,1,J)
11364 MX2(J) = QMIXSS(SN(1)-1,2,J)
11365 MX2(J+2) = QMIXSS(SN(2)-1,2,J)
11368 SN(J) = SN(J) + 399
11369 SB(J) = SB(J) + 411
11373 C--three diagram mode
11374 LAMD(1) = LAMDA3((SN(1)+1)/2,(SN(2)+1)/2,(SN(3)+1)/2)
11375 LAMD(2) = LAMDA3((SN(2)+1)/2,(SN(1)+1)/2,(SN(3)+1)/2)
11376 LAMD(3) = LAMDA3((SN(3)+1)/2,(SN(2)+1)/2,(SN(1)+1)/2)
11379 A(J+2*I-2) = MSGN*(WMXVSS(CSP,1)*QMIXSS(SN(I)+1,1,J)
11380 & -RMASS(SN(I)+1)*MC(2)*WMXVSS(CSP,2)*QMIXSS(SN(I)+1,2,J))
11381 B(J+2*I-2) = -M(I)*MC(1)*WMXUSS(CSP,2)
11382 & *QMIXSS(SN(I)+1,1,J)
11383 MX2(J+2*I-2) = QMIXSS(SN(I)+1,2,J)
11385 SN(I) = SN(I) + 401
11386 SB(I) = SB(I) + 413
11391 C--now for the LQD modes
11392 IF(MOD(SN(2),2).EQ.1.AND.MOD(SN(3),2).EQ.0) THEN
11393 C--first one diagram mode nubar, dbar, up
11395 A(J+4) = -MSGN*M(3)*WMXVSS(CSP,2)*MC(2)*
11396 & QMIXSS(SN(3)-1,1,J)
11397 B(J+4) = WMXUSS(CSP,1)*QMIXSS(SN(3)-1,1,J)
11398 & -RMASS(SN(3)-1)*MC(1)*WMXUSS(CSP,2)*QMIXSS(SN(3)-1,2,1)
11399 MX2(J+4) = QMIXSS(SN(3)-1,2,J)
11401 SN(3) = SN(3) + 399
11402 SB(3) = SB(3) + 411
11404 ELSEIF(MOD(SN(2),2).EQ.0.AND.MOD(SN(3),2).EQ.0) THEN
11405 C--second one diagram mode positron, ubar, up
11407 A(J+4) = -MSGN*M(3)*WMXVSS(CSP,2)*MC(2)*
11408 & QMIXSS(SN(3)-1,1,J)
11409 B(J+4) = WMXUSS(CSP,1)*QMIXSS(SN(3)-1,1,J)
11410 & -RMASS(SN(3)-1)*MC(1)*WMXUSS(CSP,2)*QMIXSS(SN(3)-1,2,1)
11411 MX2(J+4) = QMIXSS(SN(3)-1,2,J)
11413 SN(3) = SN(3) + 399
11414 SB(3) = SB(3) + 411
11416 ELSEIF(MOD(SN(2),2).EQ.1.AND.MOD(SN(3),2).EQ.1) THEN
11417 C--first two diagram mode positron, dbar, down
11419 A(J) = -M(1)*MC(1)*WMXUSS(CSP,2)*LMIXSS(SN(1)+1,1,J)
11420 B(J) = MSGN*WMXVSS(CSP,1)*LMIXSS(SN(2)+1,1,J)
11421 A(J+2) = -M(2)*WMXUSS(CSP,2)*MC(1)*QMIXSS(SN(2)+1,1,J)
11422 B(J+2) = MSGN*(WMXVSS(CSP,1)*QMIXSS(SN(2)+1,1,J)
11423 & -RMASS(SN(2)+1)*MC(2)*WMXVSS(CSP,2)*QMIXSS(SN(2)+1,2,J))
11424 MX2(J) = LMIXSS(SN(1)+1,1,J)
11425 MX2(J+2) = QMIXSS(SN(2)+1,1,J)
11427 SN(1) = SN(1) + 425
11428 SB(1) = SB(1) + 437
11429 SN(2) = SN(2) + 401
11430 SB(2) = SB(2) + 413
11433 C--second two diagram mode nu, up, dbar
11436 B(J) = WMXUSS(CSP,1)*LMIXSS(SN(1)-1,1,J)
11437 & -RMASS(119+SN(1))*MC(1)*WMXUSS(CSP,2)*LMIXSS(SN(1)-1,2,J)
11438 A(J+2) = -MSGN*M(2)*MC(2)*WMXVSS(CSP,2)*
11439 & QMIXSS(SN(2)-1,1,J)
11440 B(J+2) = WMXUSS(CSP,1)*QMIXSS(SN(2)-1,1,J)
11441 & -RMASS(SN(2)-1)*MC(1)*WMXUSS(CSP,2)*QMIXSS(SN(2)-1,2,J)
11442 MX2(J) = LMIXSS(SN(1)-1,1,J)
11443 MX2(J+2) = QMIXSS(SN(2)-1,1,J)
11445 SN(1) = SN(1) + 423
11446 SB(1) = SB(1) + 435
11447 SN(2) = SN(2) + 399
11448 SB(2) = SB(2) + 411
11462 SM(5) = RMASS(SN(3))
11463 SM(6) = RMASS(SB(3))
11464 SW(5) = HBAR/RLTIM(SN(3))
11465 SW(6) = HBAR/RLTIM(SB(3))
11468 SM(2*K-1) = RMASS(SN(K))
11469 SM(2*K) = RMASS(SB(K))
11470 SW(2*K-1) = HBAR/RLTIM(SN(K))
11471 SW(2*K) = HBAR/RLTIM(SB(K))
11478 CALL HWWARN('HWDRME',500,*999)
11480 C--Set mixing to zero if diagram not available
11481 IF((AM.LT.(ABS(SM(1))+M(1)).OR.ABS(SM(1)).LT.(M(2)+M(3)))
11482 & .AND.ABS(MX2(1)).GT.ZERO.AND.ND.NE.1) MX(1) = MX2(1)*LAMD(1)
11483 IF((AM.LT.(ABS(SM(2))+M(1)).OR.ABS(SM(2)).LT.(M(2)+M(3)))
11484 & .AND.ABS(MX2(2)).GT.ZERO.AND.ND.NE.1) MX(2) = MX2(2)*LAMD(1)
11485 IF((AM.LT.(ABS(SM(3))+M(2)).OR.ABS(SM(3)).LT.(M(1)+M(3)))
11486 & .AND.ABS(MX2(3)).GT.ZERO.AND.ND.NE.1) MX(3) = MX2(3)*LAMD(2)
11487 IF((AM.LT.(ABS(SM(4))+M(2)).OR.ABS(SM(4)).LT.(M(1)+M(3)))
11488 & .AND.ABS(MX2(4)).GT.ZERO.AND.ND.NE.1) MX(4) = MX2(4)*LAMD(2)
11489 IF((AM.LT.(ABS(SM(5))+M(3)).OR.ABS(SM(5)).LT.(M(1)+M(2)))
11490 & .AND.ABS(MX2(5)).GT.ZERO.AND.ND.NE.2) MX(5) = MX2(5)*LAMD(3)
11491 IF((AM.LT.(ABS(SM(6))+M(3)).OR.ABS(SM(6)).LT.(M(1)+M(2)))
11492 & .AND.ABS(MX2(6)).GT.ZERO.AND.ND.NE.2) MX(6) = MX2(6)*LAMD(3)
11493 C--Calculate the limiting points
11496 IF(ABS(MX(J)).GT.EPS) CALL HWDRM5(M23SQT(J),M13SQT(J),
11497 & M12SQT(J),A(J),B(J),M(2),M(3),M(1),M(4),SM(J),SW(J))
11498 IF(ABS(MX(J+2)).GT.EPS) CALL HWDRM5(M13SQT(2+J),M23SQT(2+J),
11499 & M12SQT(2+J),A(2+J),B(2+J),M(1),M(3),M(2),M(4),SM(2+J),SW(2+J))
11502 IF(ABS(MX(J+4)).GT.EPS) CALL HWDRM5(M12SQT(4+J),M23SQT(4+J),
11503 & M13SQT(4+J),A(4+J),B(4+J),M(1),M(2),M(3),M(4),SM(4+J),SW(4+J))
11506 C--Now evaluate the limit using these points
11509 IF(ABS(MX(I)).LT.EPS) GOTO 100
11510 LIMIT = LIMIT+HWDRM1(TEST,M12SQT(I),M13SQT(I),M23SQT(I),A,B,MX,
11511 & M,SM,SW,INFCOL,AM,0,ND)
11514 C--Now evaluate at a random point
11519 CALL HWDTHR(PHEP(1,LHEP),PHEP(1,MHEP),
11520 & PHEP(1,MHEP+1),PHEP(1,MHEP+2),HWDPWT)
11521 C--Now calculate the m12sq etc for the actual point
11522 M12SQ = M(1)**2+M(2)**2+2*HWULDO(PHEP(1,MHEP),PHEP(1,MHEP+1))
11523 M13SQ = M(1)**2+M(3)**2+2*HWULDO(PHEP(1,MHEP),PHEP(1,MHEP+2))
11524 M23SQ = M(2)**2+M(3)**2+2*HWULDO(PHEP(1,MHEP+1),PHEP(1,MHEP+2))
11525 C--Now calulate the matrix element
11526 TEST2 = HWDRM1(TEST,M12SQ,M13SQ,M23SQ,A,B,MX,
11527 & M,SM,SW,INFCOL,AM,1,ND)
11528 C--Now test the value againest the limit
11529 RAND = HWRGEN(0)*LIMIT
11530 IF(TEST2.GT.LIMIT) THEN
11531 LIMIT = 1.1D0*TEST2
11532 CALL HWWARN('HWDRME',51,*150)
11534 150 IF(TEST2.LT.RAND.AND.LTRY.LT.NETRY) THEN
11536 ELSEIF(LTRY.GE.NETRY) THEN
11537 IF(MTRY.LE.NETRY) THEN
11538 LIMIT = LIMIT*0.9D0
11539 CALL HWWARN('HWDRME',52,*25)
11541 CALL HWWARN('HWDRME',100,*999)
11544 C--Reorder the particles in gluino decay to get angular ordering right
11545 IF(IG.EQ.449.AND.ID(1).LE.12.AND.ID(2).LE.12.AND.ID(3).LE.12) THEN
11547 IF(TEST(LTRY).GT.RAND) THEN
11549 IDHWTP = IDHW(MHEP)
11550 IDHW(MHEP) = IDHW(MHEP+1)
11551 IDHW(MHEP+1) = IDHWTP
11552 IDHPTP = IDHEP(MHEP)
11553 IDHEP(MHEP) = IDHEP(MHEP+1)
11554 IDHEP(MHEP+1) = IDHPTP
11555 CALL HWVEQU(5,PHEP(1,MHEP),DECMOM)
11556 CALL HWVEQU(5,PHEP(1,MHEP+1),PHEP(1,MHEP))
11557 CALL HWVEQU(5,DECMOM,PHEP(1,MHEP+1))
11558 ELSEIF(LTRY.EQ.3) THEN
11559 IDHWTP = IDHW(MHEP)
11560 IDHW(MHEP) = IDHW(MHEP+2)
11561 IDHW(MHEP+2) = IDHWTP
11562 IDHPTP = IDHEP(MHEP)
11563 IDHEP(MHEP) = IDHEP(MHEP+2)
11564 IDHEP(MHEP+2) = IDHPTP
11566 CALL HWVEQU(5,PHEP(1,MHEP),DECMOM)
11567 CALL HWVEQU(5,PHEP(1,MHEP+2),PHEP(1,MHEP))
11568 CALL HWVEQU(5,DECMOM,PHEP(1,MHEP+2))
11573 RAND=RAND-TEST(LTRY)
11579 *CMZ :- -20/07/99 10:56:12 by Peter Richardson
11580 *-- Author : Peter Richardson
11581 C-----------------------------------------------------------------------
11582 FUNCTION HWDRM1(TEST,M12SQ,M13SQ,M23SQ,A,B,MX,M,SM,SW
11583 & ,INFCOL,AM,LM,ND)
11584 C-----------------------------------------------------------------------
11585 C FUNCTION TO GIVE THE R-PARITY VIOLATING MATRIX ELEMENT AT A GIVEN
11586 C PHASE-SPACE POINT
11587 C-----------------------------------------------------------------------
11589 DOUBLE PRECISION M12SQ,M13SQ,M23SQ,MX(6),A(6),B(6),SM(6),SW(6),
11590 & INFCOL,AM,TERM(21),TEST(3),PLN,NPLN,ZERO,
11591 & M(4),HWDRM1,HWDRM2,HWDRM3,HWDRM4
11593 EXTERNAL HWDRM2,HWDRM3,HWDRM4
11601 IF(ABS(MX(1)).GT.ZERO.AND.ND.NE.1) THEN
11602 TERM(1) = MX(1)**2*HWDRM2(M23SQ,M(2),M(3),M(1),M(4),SM(1),
11604 IF(ABS(MX(2)).GT.ZERO) TERM(7)= MX(1)*MX(2)*HWDRM3(M23SQ,M(2),
11605 & M(3),M(1),M(4),SM(1),SM(2),SW(1),SW(2),A(1),A(2),B(1),B(2))
11606 IF(ABS(MX(3)).GT.ZERO) TERM(10)=-MX(1)*MX(3)*HWDRM4(M13SQ,M23SQ,
11607 & M(1),M(3),M(2),M(4),SM(3),SM(1),SW(3),SW(1),A(1),A(3),B(1),B(3))
11608 IF(ABS(MX(4)).GT.ZERO) TERM(11)=-MX(1)*MX(4)*HWDRM4(M13SQ,M23SQ,
11609 & M(1),M(3),M(2),M(4),SM(4),SM(1),SW(4),SW(1),A(1),A(4),B(1),B(4))
11610 IF(ABS(MX(5)).GT.ZERO) TERM(12)=-MX(1)*MX(5)*HWDRM4(M23SQ,M12SQ,
11611 & M(3),M(2),M(1),M(4),SM(1),SM(5),SW(1),SW(5),A(5),A(1),B(5),B(1))
11612 IF(ABS(MX(6)).GT.ZERO) TERM(13)=-MX(1)*MX(6)*HWDRM4(M23SQ,M12SQ,
11613 & M(3),M(2),M(1),M(4),SM(1),SM(6),SW(1),SW(6),A(6),A(1),B(6),B(1))
11615 IF(ABS(MX(2)).GT.ZERO.AND.ND.NE.1) THEN
11616 TERM(2) = MX(2)**2*HWDRM2(M23SQ,M(2),M(3),M(1),M(4),SM(2),
11618 IF(ABS(MX(3)).GT.ZERO) TERM(14)=-MX(2)*MX(3)*HWDRM4(M13SQ,M23SQ,
11619 & M(1),M(3),M(2),M(4),SM(3),SM(2),SW(3),SW(2),A(2),A(3),B(2),B(3))
11620 IF(ABS(MX(4)).GT.ZERO) TERM(15)=-MX(2)*MX(4)*HWDRM4(M13SQ,M23SQ,
11621 & M(1),M(3),M(2),M(4),SM(4),SM(2),SW(4),SW(2),A(2),A(4),B(2),B(4))
11622 IF(ABS(MX(5)).GT.ZERO) TERM(16)=-MX(2)*MX(5)*HWDRM4(M23SQ,M12SQ,
11623 & M(3),M(2),M(1),M(4),SM(2),SM(5),SW(2),SW(5),A(5),A(2),B(5),B(2))
11624 IF(ABS(MX(6)).GT.ZERO) TERM(17)=-MX(2)*MX(6)*HWDRM4(M23SQ,M12SQ,
11625 & M(3),M(2),M(1),M(4),SM(2),SM(6),SW(2),SW(6),A(6),A(2),B(6),B(2))
11627 IF(ABS(MX(3)).GT.ZERO.AND.ND.NE.1) THEN
11628 TERM(3) = MX(3)**2*HWDRM2(M13SQ,M(1),M(3),M(2),M(4),SM(3),
11630 IF(ABS(MX(4)).GT.ZERO) TERM(8)= MX(3)*MX(4)*HWDRM3(M13SQ,M(1),
11631 & M(3),M(2),M(4),SM(3),SM(4),SW(3),SW(4),A(3),A(4),B(3),B(4))
11632 IF(ABS(MX(5)).GT.ZERO) TERM(18)=-MX(3)*MX(5)*HWDRM4(M12SQ,M13SQ,
11633 & M(2),M(1),M(3),M(4),SM(5),SM(3),SW(5),SW(3),A(3),A(5),B(3),B(5))
11634 IF(ABS(MX(6)).GT.ZERO) TERM(19)=-MX(3)*MX(6)*HWDRM4(M12SQ,M13SQ,
11635 & M(2),M(1),M(3),M(4),SM(6),SM(3),SW(6),SW(3),A(3),A(6),B(3),B(6))
11637 IF(ABS(MX(4)).GT.ZERO.AND.ND.NE.1) THEN
11638 TERM(4) = MX(4)**2*HWDRM2(M13SQ,M(1),M(3),M(2),M(4),SM(4),
11640 IF(ABS(MX(5)).GT.ZERO) TERM(20)=-MX(4)*MX(5)*HWDRM4(M12SQ,M13SQ,
11641 & M(2),M(1),M(3),M(4),SM(5),SM(4),SW(5),SW(4),A(4),A(5),B(4),B(5))
11642 IF(ABS(MX(6)).GT.ZERO) TERM(21)=-MX(4)*MX(6)*HWDRM4(M12SQ,M13SQ,
11643 & M(2),M(1),M(3),M(4),SM(6),SM(4),SW(6),SW(4),A(4),A(6),B(4),B(6))
11645 IF(ABS(MX(5)).GT.ZERO.AND.ND.NE.2) THEN
11646 TERM(5) = MX(5)**2*HWDRM2(M12SQ,M(1),M(2),M(3),M(4),SM(5),
11648 IF(ABS(MX(6)).GT.ZERO) TERM(9)= MX(5)*MX(6)*HWDRM3(M12SQ,M(1),
11649 & M(2),M(3),M(4),SM(5),SM(6),SW(5),SW(6),A(5),A(6),B(5),B(6))
11651 IF(ABS(MX(6)).GT.ZERO.AND.ND.NE.2) TERM(6) = MX(6)**2*
11652 & HWDRM2(M12SQ,M(1),M(2),M(3),M(4),SM(6),SW(6),A(6),B(6))
11654 TERM(K)=TERM(K)*INFCOL
11658 HWDRM1 = HWDRM1+TERM(K)
11660 C--Different colour flows for the gluino
11671 TEST(K) = (TERM(2*K-1)+TERM(2*K)+TERM(6+K))*(1+NPLN/PLN)
11678 IF(HWDRM1.LT.ZERO) CALL HWWARN('HWDRM1',50,*999)
11681 *CMZ :- -20/07/99 10:56:12 by Peter Richardson
11682 *-- Author : Peter Richardson
11683 C-----------------------------------------------------------------------
11684 FUNCTION HWDRM2(X,MA,MB,MC,MD,MR1,GAM1,A,B)
11685 C-----------------------------------------------------------------------
11686 C Function to compute the matrix element squared part of a 3-body
11688 C-----------------------------------------------------------------------
11690 DOUBLE PRECISION X,MA,MB,MC,MD,A,B,HWDRM2,MR1,GAM1
11691 HWDRM2 = (X - MA**2 - MB**2)*(4*A*B*MC*MD +
11692 & (A**2 + B**2)*(-X + MC**2 + MD**2))/
11693 & ((X-MR1**2)**2+GAM1**2*MR1**2)
11696 *CMZ :- -20/07/99 10:56:12 by Peter Richardson
11697 *-- Author : Peter Richardson
11698 C-----------------------------------------------------------------------
11699 FUNCTION HWDRM3(X,MA,MB,MC,MD,MR1,MR2,GAM1,GAM2,A1,A2,B1,B2)
11700 C-----------------------------------------------------------------------
11701 C Function to compute the light/heavy interference part of a 3-body
11703 C-----------------------------------------------------------------------
11705 DOUBLE PRECISION X,MA,MB,MC,MD,A1,A2,B1,B2,HWDRM3,MR1,MR2,GAM1
11708 HWDRM3 = 2*(X - MA**2 - MB**2)*(2*(A2*B1 + A1*B2)*MC*MD +
11709 & (A1*A2 + B1*B2)*(-X + MC**2 + MD**2))*
11710 & (GAM1*GAM2*MR1*MR2 + (X - MR1**2)*(X - MR2**2))/
11711 & (((X-MR1**2)**2+GAM1**2*MR1**2)*((X-MR2**2)**2+GAM2**2*MR2**2))
11714 *CMZ :- -20/07/99 10:56:12 by Peter Richardson
11715 *-- Author : Peter Richardson
11716 C-----------------------------------------------------------------------
11717 FUNCTION HWDRM4(X,Y,MA,MB,MC,MD,MR1,MR2,GAM1,GAM2,A1,A2,B1,B2)
11718 C-----------------------------------------------------------------------
11719 C Function to compute the interference part of a 3-body
11721 C-----------------------------------------------------------------------
11723 DOUBLE PRECISION X,Y,MA,MB,MC,MD,A1,A2,B1,B2,HWDRM4,MR1,MR2,GAM1
11726 HWDRM4 = 2*((GAM1*GAM2*MR1*MR2 + (X - MR1**2)*(Y - MR2**2))*
11727 & (A2*B1*MC*MD*(X - MA**2 - MB**2) +
11728 & A1*A2*MA*MC*(X + Y - MA**2 - MC**2) +
11729 & A1*B2*MA*MD*(Y - MB**2 - MC**2) +
11730 & B1*B2*(X*Y - MA**2*MC**2 - MB**2*MD**2)))/
11731 & (((X-MR1**2)**2+GAM1**2*MR1**2)*((Y-MR2**2)**2+GAM2**2*MR2**2))
11734 *CMZ :- -20/07/99 10:56:12 by Peter Richardson
11735 *-- Author : Peter Richardson
11736 C-----------------------------------------------------------------------
11737 SUBROUTINE HWDRM5(X,Y,Z,A,B,MA,MB,MC,MD,MR,GAM)
11738 C-----------------------------------------------------------------------
11739 C Subroutine to find the maximum of the ME
11740 C-----------------------------------------------------------------------
11742 DOUBLE PRECISION X,Y,Z,MA,MB,MC,MD,MR,GAM,RES(3),A,B,C,D,
11743 & E2S,E3S,E2M,E3M,LOW,UPP,HWRUNI,EPS,ZERO
11745 PARAMETER(EPS=1D-9,ZERO=0)
11748 RES(1) = -D*(MA**2 + MB**2)*MC*MD +
11749 & C*(GAM**2*MR**2 + MR**4 - MA**2*MC**2 - MB**2*MC**2 -
11750 & MA**2*MD**2 - MB**2*MD**2)
11751 RES(2) = (GAM**2*MR**2 + (-MR**2 + MA**2 + MB**2)**2)*
11752 & (D**2*MC**2*MD**2 +
11753 & 2*C*D*MC*MD*(-MR**2 + MC**2 + MD**2) +
11754 & C**2*(GAM**2*MR**2 + (-MR**2 + MC**2 + MD**2)**2))
11755 RES(3) = -D*MC*MD+C*(2*MR**2-(MA**2+MB**2+MC**2+MD**2))
11756 IF(RES(2).GT.ZERO) THEN
11757 RES(2) = SQRT(RES(2))
11761 IF((RES(1)+RES(2))/RES(3).GT.(MD-MC)**2.OR.
11762 & (RES(1)+RES(2))/RES(3).LT.(MA+MB)**2) THEN
11763 X = (RES(1)-RES(2))/RES(3)
11765 X = (RES(1)+RES(2))/RES(3)
11767 IF(X.GT.(MD-MC)**2) X = (MD-MC)**2
11768 IF(X.LT.(MA+MB)**2) X = (MA+MB)**2
11769 E2S = (X-MA**2+MB**2)/(2*SQRT(X))
11770 E3S = (MD**2-X-MC**2)/(2*SQRT(X))
11773 IF(E2M.LT.ZERO) THEN
11774 IF(ABS(E2M/E2S).GT.EPS) CALL HWWARN('HWDRM5',2,*10)
11777 IF(E3M.LT.ZERO) THEN
11778 IF(ABS(E3M/E3S).GT.EPS) CALL HWWARN('HWDRM5',3,*20)
11783 LOW = (E2S+E3S)**2-(E2M+E3M)**2
11784 UPP = (E2S+E3S)**2-(E2M-E3M)**2
11785 Y = HWRUNI(1,LOW,UPP)
11786 Z = MA**2+MB**2+MC**2+MD**2-X-Y
11789 *CMZ :- -26/04/91 11.11.55 by Bryan Webber
11790 *-- Author : Bryan Webber
11791 C-----------------------------------------------------------------------
11792 FUNCTION HWDPWT(EMSQ,A,B,C)
11793 C-----------------------------------------------------------------------
11794 C MATRIX ELEMENT SQUARED FOR PHASE SPACE DECAY
11795 C-----------------------------------------------------------------------
11796 DOUBLE PRECISION HWDPWT,EMSQ,A,B,C
11800 *CMZ :- -30/09/02 14:05:28 by Peter Richardson
11801 *-- Author : Peter Richardson
11802 C-----------------------------------------------------------------------
11803 SUBROUTINE HWDSIN(CLSAVE)
11804 C-----------------------------------------------------------------------
11805 C Subroutine to perform decays including spin correlations
11806 C-----------------------------------------------------------------------
11807 INCLUDE 'HERWIG65.INC'
11808 DOUBLE PRECISION PW(5)
11809 INTEGER IDEC,IP,IS,IHEP,ID,IM,LHEP,MHEP,NPR,KHEP,CLSAVE(2),NTRY,
11811 IF(IERROR.NE.0) RETURN
11815 C--search the decay products and decide which one to decay next
11816 IF(.NOT.DECSPN(IDEC)) THEN
11817 CALL HWDSI1(IDEC,IP)
11819 IDEC = JMOSPN(IDEC)
11822 C--first no more particles in this decay to develop so move up chain
11824 IDEC = JMOSPN(IDEC)
11825 C--reached the end of this spin chain go back to HWDHOB
11829 C--otherwise keep going up the chain
11831 IF(NTRY.LE.NBTRY) THEN
11834 CALL HWWARN('HWDSIN',100,*999)
11837 C--special for tau decays call spin correlation in tau decay routine
11838 ELSEIF(ABS(IDHEP(IDSPN(IP))).EQ.15) THEN
11840 IF(IERROR.NE.0) RETURN
11843 C--work out where that particle is
11845 C--if particle has daughters
11846 10 IF(JDAHEP(1,IHEP).NE.0) THEN
11847 IF(ISTHEP(IHEP).GE.141.AND.ISTHEP(IHEP).LE.144) THEN
11848 DO ID1=JDAHEP(1,IHEP),JDAHEP(2,IHEP)
11849 IF(IDHW(ID1).EQ.ID) IHEP=ID1
11852 IHEP = JDAHEP(1,IHEP)
11858 IF(NTRY.GE.NBTRY) CALL HWWARN('HWDSIN',101,*999)
11859 IF (.NOT.RSTAB(ID).AND.(ID.EQ.6.OR.ID.EQ.12.OR.
11860 & (ID.GE.203.AND.ID.LE.218).OR.ABS(IDPDG(ID)).GT.1000000).AND.
11861 & (IS.EQ.190.OR.(IS.GE.147.AND.IS.LE.151))) THEN
11862 CALL HWDHO1(IHEP,ID,IM,NPR,LHEP,MHEP)
11863 IF(IERROR.NE.0) RETURN
11867 C--perform the decay including spin correlations
11868 CALL HWDSI2(IHEP,IM,NPR,MHEP,LHEP,KHEP,PW)
11869 IF(IERROR.NE.0) RETURN
11870 C--make the colour connections
11871 CALL HWDHO3(IHEP,ID,IM,NPR,MHEP,LHEP,KHEP,CLSAVE)
11872 IF (IERROR.NE.0) RETURN
11873 C--perform the parton-showers
11874 CALL HWDHO4(IHEP,ID,IM,NPR,MHEP,LHEP,KHEP,PW)
11875 IF(IERROR.NE.0) RETURN
11876 C--perform RPV colour connections
11877 CALL HWDHO5(IHEP,MHEP,LHEP,CLSAVE)
11878 IF(IERROR.NE.0) RETURN
11879 C--continue and perform the next decay
11881 IF(NTRY.LE.NBTRY) THEN
11884 CALL HWWARN('HWDSIN',102,*999)
11888 *CMZ :- -30/09/02 14:05:28 by Peter Richardson
11889 *-- Author : Peter Richardson
11890 C-----------------------------------------------------------------------
11891 SUBROUTINE HWDSI1(IDEC,IP)
11892 C-----------------------------------------------------------------------
11893 C Subroutine to check a vertex and decide which branch to treat
11894 C-----------------------------------------------------------------------
11895 INCLUDE 'HERWIG65.INC'
11896 INTEGER IDEC,I,IPICK(5),IP,HWRINT,P1,P2,P3,P4,P3P,P4P,NPR,P0,P0P,
11897 & P1P,P2P,IF1,IF2,P5,P5P
11898 DOUBLE PRECISION NORM
11899 DOUBLE COMPLEX RHOLP(2,2),RHOPS(2,2)
11901 C--loop over the daughters and decide what to do
11903 C--if daughters of particle the same issue warning
11904 IF(JDASPN(1,IDEC).EQ.JDASPN(2,IDEC))
11905 & CALL HWWARN('HWDSI1',100,*999)
11906 C--loop over the decay products
11907 DO I=JDASPN(1,IDEC),JDASPN(2,IDEC)
11908 IF(.NOT.DECSPN(I)) THEN
11909 C--first SM particles other than tau and top and stable particles
11910 IF(RSTAB(IDHW(IDSPN(I)))
11911 & .OR.(IDHW(IDSPN(I)).LE.12.AND.ABS(IDHEP(IDSPN(I))).NE.6)
11912 & .OR.(IDHW(IDSPN(I)).GE.121.AND.IDHW(IDSPN(I)).LE.132.AND.
11913 & ABS(IDHEP(IDSPN(I))).NE.15)) THEN
11915 RHOSPN(1,1,I) = HALF
11916 RHOSPN(1,2,I) = ZERO
11917 RHOSPN(2,1,I) = ZERO
11918 RHOSPN(2,2,I) = HALF
11919 C--spinless particles
11920 ELSEIF(RSPIN(IDHW(IDSPN(I))).EQ.ZERO) THEN
11922 RHOSPN(1,1,I) = ONE
11923 RHOSPN(1,2,I) = ZERO
11924 RHOSPN(2,1,I) = ZERO
11925 RHOSPN(2,2,I) = ZERO
11927 C--particle which needs development
11933 C--pick the particle to decay next
11935 IF(JMOSPN(IDEC).EQ.0) RETURN
11936 C--done everything compute the decay matrix and move up
11937 DECSPN(IDEC) = .TRUE.
11938 NPR = JDASPN(2,IDEC)-JDASPN(1,IDEC)+1
11941 20 RHOSPN(P0,P0P,IDEC) = ZERO
11950 21 RHOSPN(P0,P0P,IDEC) = RHOSPN(P0,P0P,IDEC)+
11951 & MESPN(P0 ,P1 ,P2 ,1,NCFL(IDEC),IDEC)*
11952 & DCONJG(MESPN(P0P,P1P,P2P,1,NCFL(IDEC),IDEC))*
11953 & RHOSPN(P1,P1P,JDASPN(1,IDEC))*RHOSPN(P2,P2P,JDASPN(2,IDEC))
11954 C--three body decay
11955 ELSEIF(NPR.EQ.3) THEN
11964 25 RHOSPN(P0,P0P,IDEC) = RHOSPN(P0,P0P,IDEC)+
11965 & MESPN(P0 ,P1 ,P2 ,P3 ,NCFL(IDEC),IDEC)*
11966 & DCONJG(MESPN(P0P,P1P,P2P,P3P,NCFL(IDEC),IDEC))*
11967 & RHOSPN(P1,P1P,JDASPN(1,IDEC))*RHOSPN(P2,P2P,JDASPN(1,IDEC)+1)*
11968 & RHOSPN(P3,P3P,JDASPN(2,IDEC))
11971 CALL HWWARN('HWDSI1',500,*999)
11973 C--now normalise this
11974 NORM = DBLE(RHOSPN(1,1,IDEC))+DBLE(RHOSPN(2,2,IDEC))
11975 IF(NORM.GT.ZERO) THEN
11979 35 RHOSPN(P0,P0P,IDEC) = NORM*RHOSPN(P0,P0P,IDEC)
11981 CALL HWWARN('HWDSI1',101,*999)
11984 C--pick the particle to be decayed
11985 IP = IPICK(HWRINT(1,IP))
11986 C--setup the spin density matrix for the decay
11987 C--special for the hard process
11988 IF(ISTHEP(IDSPN(IDEC)).EQ.120) THEN
11989 NPR = JDASPN(2,IDEC)-JDASPN(1,IDEC)+1
11990 C--set up the spin density matrices for the incoming partons
11991 C--zero off diagonal elements
11996 C--set up for polarized incoming beams in lepton collisons
11997 IF(IDHW(JMOHEP(1,IDSPN(IDEC))).GE.121.AND.
11998 & IDHW(JMOHEP(1,IDSPN(IDEC))).LE.132) THEN
11999 RHOLP(1,1) = HALF*(ONE+EPOLN(3))
12000 RHOLP(2,2) = HALF*(ONE-EPOLN(3))
12001 RHOPS(1,1) = HALF*(ONE-PPOLN(3))
12002 RHOPS(2,2) = HALF*(ONE+PPOLN(3))
12003 C--otherwise average
12010 C--first decay product
12012 IF(IP.EQ.JDASPN(1,IDEC)) THEN
12013 C--if using first colour flow option
12014 IF(SPCOPT.EQ.1) THEN
12017 RHOSPN(P3,P3P,IP) = ZERO
12026 5 RHOSPN(P3,P3P,IP) = RHOSPN(P3,P3P,IP)+SPNCFC(IF1,IF2,1)*
12027 & MESPN(P1 ,P2 ,P3 ,P4 ,IF1,1)*
12028 & DCONJG(MESPN(P1P,P2P,P3P,P4P,IF2,1))*
12029 & RHOLP(P1,P1P)*RHOPS(P2,P2P)*RHOSPN(P4,P4P,IP+1)
12030 C--if using second colour flow option
12031 ELSEIF(SPCOPT.EQ.2) THEN
12034 RHOSPN(P3,P3P,IP) = ZERO
12041 6 RHOSPN(P3,P3P,IP) = RHOSPN(P3,P3P,IP)
12042 & +SPNCFC(NCFL(1),NCFL(1),1)*
12043 & MESPN(P1 ,P2 ,P3 ,P4 ,NCFL(1),1)*
12044 & DCONJG(MESPN(P1P,P2P,P3P,P4P,NCFL(1),1))*
12045 & RHOLP(P1,P1P)*RHOPS(P2,P2P)*RHOSPN(P4,P4P,IP+1)
12046 C--unknown option issue warning
12048 CALL HWWARN('HWDSI1',501,*999)
12050 C--second decay product
12052 IF(SPCOPT.EQ.1) THEN
12055 RHOSPN(P4,P4P,IP) = (0.0D0,0.0D0)
12056 DO 10 IF1=1,NCFL(1)
12057 DO 10 IF2=1,NCFL(1)
12064 10 RHOSPN(P4,P4P,IP) = RHOSPN(P4,P4P,IP)+SPNCFC(IF1,IF2,1)*
12065 & MESPN(P1 ,P2 ,P3 ,P4 ,IF1,1)*
12066 & DCONJG(MESPN(P1P,P2P,P3P,P4P,IF2,1))*
12067 & RHOLP(P1,P1P)*RHOPS(P2,P2P)*RHOSPN(P3,P3P,IP-1)
12068 ELSEIF(SPCOPT.EQ.2) THEN
12071 RHOSPN(P4,P4P,IP) = (0.0D0,0.0D0)
12078 11 RHOSPN(P4,P4P,IP) = RHOSPN(P4,P4P,IP)
12079 & +SPNCFC(NCFL(1),NCFL(1),1)*
12080 & MESPN(P1 ,P2 ,P3 ,P4 ,NCFL(1),1)*
12081 & DCONJG(MESPN(P1P,P2P,P3P,P4P,NCFL(1),1))*
12082 & RHOLP(P1,P1P)*RHOPS(P2,P2P)*RHOSPN(P3,P3P,IP-1)
12084 CALL HWWARN('HWDSI1',502,*999)
12087 C--new for four body gauge boson pair processes
12088 ELSEIF(NPR.EQ.4) THEN
12090 IF(IP.EQ.JDASPN(1,IDEC)) THEN
12093 RHOSPN(P1,P1P,IP) = (0.0D0,0.0D0)
12098 41 RHOSPN(P1,P1P,IP) = RHOSPN(P1,P1P,IP)+
12099 & MESPN(P5,P1,P3,1,1,1)*DCONJG(MESPN(P5P,P1P,P3P,1,1,1))*
12100 & RHOSPN(P1,P1P,JDASPN(1,IDEC)+1)*
12101 & RHOSPN(P3,P3P,JDASPN(1,IDEC)+2)*
12102 & RHOSPN(P3,P3P,JDASPN(2,IDEC))
12104 ELSEIF(IP.EQ.JDASPN(1,IDEC)+1) THEN
12107 RHOSPN(P1,P1P,IP) = (0.0D0,0.0D0)
12112 42 RHOSPN(P1,P1P,IP) = RHOSPN(P1,P1P,IP)+
12113 & MESPN(P5,P1,P3,1,1,1)*DCONJG(MESPN(P5P,P1P,P3P,1,1,1))*
12114 & RHOSPN(P1,P1P,JDASPN(1,IDEC))*
12115 & RHOSPN(P3,P3P,JDASPN(1,IDEC)+2)*
12116 & RHOSPN(P3,P3P,JDASPN(2,IDEC))
12118 ELSEIF(IP.EQ.JDASPN(1,IDEC)+2) THEN
12121 RHOSPN(P3,P3P,IP) = (0.0D0,0.0D0)
12126 43 RHOSPN(P3,P3P,IP) = RHOSPN(P3,P3P,IP)+
12127 & MESPN(P5,P1,P3,1,1,1)*DCONJG(MESPN(P5P,P1P,P3P,1,1,1))*
12128 & RHOSPN(P1,P1P,JDASPN(1,IDEC))*
12129 & RHOSPN(P1,P1P,JDASPN(1,IDEC)+1)*
12130 & RHOSPN(P3,P3P,JDASPN(2,IDEC))
12132 ELSEIF(IP.EQ.JDASPN(2,IDEC)) THEN
12135 RHOSPN(P3,P3P,IP) = (0.0D0,0.0D0)
12140 44 RHOSPN(P3,P3P,IP) = RHOSPN(P3,P3P,IP)+
12141 & MESPN(P5,P1,P3,1,1,1)*DCONJG(MESPN(P5P,P1P,P3P,1,1,1))*
12142 & RHOSPN(P1,P1P,JDASPN(1,IDEC))*
12143 & RHOSPN(P1,P1P,JDASPN(1,IDEC)+1)*
12144 & RHOSPN(P3,P3P,JDASPN(1,IDEC)+2)
12145 C--unrecognized issue warning
12147 CALL HWWARN('(HWDSI1)',509,*999)
12149 C--unrecognized issue warning
12151 CALL HWWARN('(HWDSI1)',508,*999)
12154 NPR = JDASPN(2,IDEC)-JDASPN(1,IDEC)+1
12157 50 RHOSPN(P1,P1P,IP) = (0.0D0,0.0D0)
12158 C--set-up matrix for 2-body decay
12160 IF(NCFL(IDEC).NE.1) CALL HWWARN('HWDSI1',503,*999)
12161 IF(IP.EQ.JDASPN(1,IDEC)) THEN
12168 60 RHOSPN(P1,P1P,IP) = RHOSPN(P1,P1P,IP)+RHOSPN(P0,P0P,IDEC)*
12169 & MESPN(P0 ,P1 ,P2 ,1,1,IDEC)*
12170 & DCONJG(MESPN(P0P,P1P,P2P,1,1,IDEC))*
12171 & RHOSPN(P2,P2P,JDASPN(2,IDEC))
12179 70 RHOSPN(P2,P2P,IP) = RHOSPN(P2,P2P,IP)+RHOSPN(P0,P0P,IDEC)*
12180 & MESPN(P0 ,P1 ,P2 ,1,1,IDEC)*
12181 & DCONJG(MESPN(P0P,P1P,P2P,1,1,IDEC))*
12182 & RHOSPN(P1,P1P,JDASPN(1,IDEC))
12184 C--set-up matrix for 3-body decay
12185 ELSEIF(NPR.EQ.3) THEN
12186 IF(SPCOPT.NE.2.AND.NCFL(IDEC).NE.1)
12187 & CALL HWWARN('HWDSI1',504,*999)
12189 IF(IP.EQ.JDASPN(1,IDEC)) THEN
12198 100 RHOSPN(P1,P1P,IP) = RHOSPN(P1,P1P,IP)+RHOSPN(P0,P0P,IDEC)*
12199 & MESPN(P0 ,P1 ,P2 ,P3 ,NCFL(IDEC),IDEC)*
12200 & DCONJG(MESPN(P0P,P1P,P2P,P3P,NCFL(IDEC),IDEC))*
12201 & RHOSPN(P2,P2P,JDASPN(1,IDEC)+1)*
12202 & RHOSPN(P3,P3P,JDASPN(2,IDEC))
12204 ELSEIF(IP.EQ.JDASPN(1,IDEC)+1) THEN
12213 105 RHOSPN(P2,P2P,IP) = RHOSPN(P2,P2P,IP)+RHOSPN(P0,P0P,IDEC)*
12214 & MESPN(P0 ,P1 ,P2 ,P3 ,NCFL(IDEC),IDEC)*
12215 & DCONJG(MESPN(P0P,P1P,P2P,P3P,NCFL(IDEC),IDEC))*
12216 & RHOSPN(P1,P1P,JDASPN(1,IDEC))*
12217 & RHOSPN(P3,P3P,JDASPN(2,IDEC))
12219 ELSEIF(IP.EQ.JDASPN(2,IDEC)) THEN
12228 110 RHOSPN(P3,P3P,IP) = RHOSPN(P3,P3P,IP)+RHOSPN(P0,P0P,IDEC)*
12229 & MESPN(P0 ,P1 ,P2 ,P3 ,NCFL(IDEC),IDEC)*
12230 & DCONJG(MESPN(P0P,P1P,P2P,P3P,NCFL(IDEC),IDEC))*
12231 & RHOSPN(P1,P1P,JDASPN(1,IDEC))*
12232 & RHOSPN(P2,P2P,JDASPN(1,IDEC)+1)
12235 CALL HWWARN('HWDSI1',102,*999)
12237 ELSEIF(NPR.EQ.4) THEN
12239 IF(IP.EQ.JDASPN(1,IDEC)) THEN
12242 RHOSPN(P1,P1P,IP) = (0.0D0,0.0D0)
12249 151 RHOSPN(P1,P1P,IP) = RHOSPN(P1,P1P,IP)+
12250 & MESPN(P1 ,P2 ,P3 ,P4 ,1,1)*
12251 & DCONJG(MESPN(P1P,P2P,P3P,P4P,1,1))*
12252 & RHOSPN(P2,P2P,JDASPN(1,IDEC)+1)*
12253 & RHOSPN(P3,P3P,JDASPN(1,IDEC)+2)*
12254 & RHOSPN(P4,P4P,JDASPN(2,IDEC))
12256 ELSEIF(IP.EQ.JDASPN(1,IDEC)+1) THEN
12259 RHOSPN(P2,P2P,IP) = (0.0D0,0.0D0)
12266 152 RHOSPN(P2,P2P,IP) = RHOSPN(P2,P2P,IP)+
12267 & MESPN(P1 ,P2 ,P3 ,P4 ,1,1)*
12268 & DCONJG(MESPN(P1P,P2P,P3P,P4P,1,1))*
12269 & RHOSPN(P1,P1P,JDASPN(1,IDEC))*
12270 & RHOSPN(P3,P3P,JDASPN(1,IDEC)+2)*
12271 & RHOSPN(P4,P4P,JDASPN(2,IDEC))
12273 ELSEIF(IP.EQ.JDASPN(1,IDEC)+2) THEN
12276 RHOSPN(P3,P3P,IP) = (0.0D0,0.0D0)
12283 153 RHOSPN(P3,P3P,IP) = RHOSPN(P3,P3P,IP)+
12284 & MESPN(P1 ,P2 ,P3 ,P4 ,1,1)*
12285 & DCONJG(MESPN(P1P,P2P,P3P,P4P,1,1))*
12286 & RHOSPN(P1,P1P,JDASPN(1,IDEC))*
12287 & RHOSPN(P2,P2P,JDASPN(1,IDEC)+1)*
12288 & RHOSPN(P4,P4P,JDASPN(2,IDEC))
12290 ELSEIF(IP.EQ.JDASPN(2,IDEC)) THEN
12293 RHOSPN(P4,P4P,IP) = (0.0D0,0.0D0)
12300 154 RHOSPN(P4,P4P,IP) = RHOSPN(P4,P4P,IP)+
12301 & MESPN(P1 ,P2 ,P3 ,P4 ,1,1)*
12302 & DCONJG(MESPN(P1P,P2P,P3P,P4P,1,1))*
12303 & RHOSPN(P1,P1P,JDASPN(1,IDEC))*
12304 & RHOSPN(P2,P2P,JDASPN(1,IDEC)+1)*
12305 & RHOSPN(P3,P3P,JDASPN(1,IDEC)+2)
12307 CALL HWWARN('HWDSI1',505,*999)
12310 CALL HWWARN('HWDSI1',506,*999)
12313 C--normalise the spin density matrix
12314 NORM = DBLE(RHOSPN(1,1,IP))+DBLE(RHOSPN(2,2,IP))
12315 IF(NORM.GT.ZERO) THEN
12319 15 RHOSPN(P3,P3P,IP) = NORM*RHOSPN(P3,P3P,IP)
12321 CALL HWWARN('HWDSI1',107,*999)
12326 *CMZ :- -30/09/02 14:05:28 by Peter Richardson
12327 *-- Author : Peter Richardson
12328 C-----------------------------------------------------------------------
12329 SUBROUTINE HWDSI2(IHEP,IM,NPR,MHEP,LHEP,KHEP,PW)
12330 C-----------------------------------------------------------------------
12331 C Subroutine to perform the second part of the heavy object decays
12332 C IE generate the kinematics for the decay
12333 C including spin correlations
12334 C was part of HWDHOB
12335 C-----------------------------------------------------------------------
12336 INCLUDE 'HERWIG65.INC'
12337 DOUBLE PRECISION HWRGEN,PW(5),HWDPWT,HWDWWT,PCM,HWUPCM
12338 INTEGER IHEP,IM,KHEP,LHEP,MHEP,NPR,ISN,RHEP
12339 EXTERNAL HWRGEN,HWDPWT,HWDWWT,HWUPCM
12340 IF (IERROR.NE.0) RETURN
12343 C Two body decay: LHEP -> MHEP + NHEP
12344 IF(NME(IM).GT.20000.AND.NME(IM).LT.30000) THEN
12345 C--generate a two body decay to a gauge boson as a three body decay
12346 CALL HWDSM3(2,IHEP,MHEP,NHEP,0,NME(IM)-20000,
12347 & RHOSPN(1,1,ISN),ISN)
12349 ELSEIF(NME(IM).GT.30000.AND.NME(IM).LT.40000) THEN
12350 CALL HWDSM2(IHEP,MHEP,NHEP,NME(IM)-30000,
12351 & RHOSPN(1,1,ISN),ISN)
12352 C--otherwise issue warning
12353 C--change by PR 9/30/02 to issue non-terminal warning and continue
12355 CALL HWWARN('HWDSI2',1,*999)
12356 PCM=HWUPCM(PHEP(5,IHEP),PHEP(5,MHEP),PHEP(5,NHEP))
12357 CALL HWDTWO(PHEP(1,IHEP),PHEP(1,MHEP),
12358 & PHEP(1,NHEP),PCM,TWO,.FALSE.)
12359 DECSPN(ISN) = .TRUE.
12360 IF(RSPIN(IDHW(IHEP)).EQ.ZERO) THEN
12361 RHOSPN(1,1,ISN) = ONE
12362 RHOSPN(1,2,ISN) = ZERO
12363 RHOSPN(2,1,ISN) = ZERO
12364 RHOSPN(2,2,ISN) = ZERO
12366 RHOSPN(1,1,ISN) = HALF
12367 RHOSPN(1,2,ISN) = ZERO
12368 RHOSPN(2,1,ISN) = ZERO
12369 RHOSPN(2,2,ISN) = HALF
12372 ELSEIF (NPR.EQ.3) THEN
12373 C Three body decay: LHEP -> KHEP + MHEP + NHEP
12376 C Provisional colour self-connection of KHEP
12377 JMOHEP(2,KHEP)=KHEP
12378 JDAHEP(2,KHEP)=KHEP
12379 C--if old codes issue warning
12380 IF (NME(IM).EQ.100.OR.NME(IM).EQ.200.OR.NME(IM).EQ.300) THEN
12381 CALL HWWARN('HWDSI2',502,*999)
12382 C--three body spin matrix element
12383 ELSEIF(NME(IM).GE.10000.AND.NME(IM).LT.20000) THEN
12384 CALL HWDSM3(3,IHEP,MHEP,KHEP,NHEP,NME(IM)-10000,
12385 & RHOSPN(1,1,ISN),ISN)
12386 C--special for top decay
12387 IF(ABS(IDHEP(IHEP)).EQ.6) THEN
12388 CALL HWVSUM(4,PHEP(1,KHEP),PHEP(1,MHEP),PW)
12391 C--unknown issue warning
12393 CALL HWWARN('HWDSI2',2,*999)
12394 C Three body phase space decay
12395 CALL HWDTHR(PHEP(1,IHEP),PHEP(1,MHEP),
12396 & PHEP(1,KHEP),PHEP(1,NHEP),HWDPWT)
12397 CALL HWVEQU(4,VHEP(1,KHEP),VHEP(1,MHEP))
12398 DECSPN(ISN) = .TRUE.
12399 IF(RSPIN(IDHW(IHEP)).EQ.ZERO) THEN
12400 RHOSPN(1,1,ISN) = ONE
12401 RHOSPN(1,2,ISN) = ZERO
12402 RHOSPN(2,1,ISN) = ZERO
12403 RHOSPN(2,2,ISN) = ZERO
12405 RHOSPN(1,1,ISN) = HALF
12406 RHOSPN(1,2,ISN) = ZERO
12407 RHOSPN(2,1,ISN) = ZERO
12408 RHOSPN(2,2,ISN) = HALF
12411 ELSEIF(NPR.EQ.4) THEN
12412 CALL HWWARN('HWDSI2',3,*999)
12413 C Four body decay: LHEP -> KHEP + RHEP + MHEP + NHEP
12418 C Provisional colour connections of KHEP and RHEP
12419 JMOHEP(2,KHEP)=RHEP
12420 JDAHEP(2,KHEP)=RHEP
12421 JMOHEP(2,RHEP)=KHEP
12422 JDAHEP(2,RHEP)=KHEP
12423 C Four body phase space decay
12424 CALL HWDFOR(PHEP(1,IHEP),PHEP(1,KHEP),PHEP(1,RHEP),
12425 & PHEP(1,MHEP),PHEP(1,NHEP))
12426 CALL HWVEQU(4,VHEP(1,KHEP),VHEP(1,RHEP))
12427 CALL HWVEQU(4,VHEP(1,KHEP),VHEP(1,MHEP))
12428 DECSPN(ISN) = .TRUE.
12429 IF(RSPIN(IDHW(IHEP)).EQ.ZERO) THEN
12430 RHOSPN(1,1,ISN) = ONE
12431 RHOSPN(1,2,ISN) = ZERO
12432 RHOSPN(2,1,ISN) = ZERO
12433 RHOSPN(2,2,ISN) = ZERO
12435 RHOSPN(1,1,ISN) = HALF
12436 RHOSPN(1,2,ISN) = ZERO
12437 RHOSPN(2,1,ISN) = ZERO
12438 RHOSPN(2,2,ISN) = HALF
12441 CALL HWWARN('HWDSI2',100,*999)
12445 *CMZ :- -30/09/02 14:05:28 by Peter Richardson
12446 *-- Author : Peter Richardson
12447 C-----------------------------------------------------------------------
12448 SUBROUTINE HWDSI3(IP)
12449 C-----------------------------------------------------------------------
12450 C Subroutine to handle spin correlations in tau decays
12451 C averages spin if not using TAUOLA
12452 C if using TAUOLA selects the spin and uses TAUOLA to perform the
12454 C-----------------------------------------------------------------------
12455 INCLUDE 'HERWIG65.INC'
12456 INTEGER IP,IHEP,ID1,ID,NTRY
12457 DOUBLE PRECISION PPOL,HWRGEN,POL
12459 C--if HERWIG is performing tau decays average over spins and return
12460 C--spin averaged tau decay will be done later
12461 IF(TAUDEC.EQ.'HERWIG') THEN
12462 DECSPN(IP) = .TRUE.
12463 RHOSPN(1,1,IP) = HALF
12464 RHOSPN(2,1,IP) = ZERO
12465 RHOSPN(1,2,IP) = ZERO
12466 RHOSPN(2,2,IP) = HALF
12467 C--if using tauola select the polarization for the decay
12468 ELSEIF(TAUDEC.EQ.'TAUOLA') THEN
12469 C--work out where that particle is
12473 IF(JDAHEP(1,IHEP).NE.0) THEN
12474 IF(ISTHEP(IHEP).GE.141.AND.ISTHEP(IHEP).LE.144) THEN
12475 DO ID1=JDAHEP(1,IHEP),JDAHEP(2,IHEP)
12476 IF(IDHW(ID1).EQ.ID) IHEP=ID1
12479 IHEP = JDAHEP(1,IHEP)
12482 IF(NTRY.LT.NBTRY) THEN
12485 CALL HWWARN('HWDSI3',100,*999)
12488 C--select the tau polarization
12489 PPOL = DBLE(RHOSPN(1,1,IP))
12490 IF(PPOL.GE.HWRGEN(0)) THEN
12492 RHOSPN(1,1,IP) = ONE
12493 RHOSPN(2,1,IP) = ZERO
12494 RHOSPN(1,2,IP) = ZERO
12495 RHOSPN(2,2,IP) = ZERO
12498 RHOSPN(1,1,IP) = ZERO
12499 RHOSPN(2,1,IP) = ZERO
12500 RHOSPN(1,2,IP) = ZERO
12501 RHOSPN(2,2,IP) = ONE
12503 C--decay the particle
12504 CALL HWDTAU(1,IHEP,POL)
12505 DECSPN(IP) = .TRUE.
12507 CALL HWWARN('HWDSI3',500,*999)
12511 *CMZ :- -09/04/02 13:46:07 by Peter Richardson
12512 *-- Author : Peter Richardson
12513 C-----------------------------------------------------------------------
12514 SUBROUTINE HWDSM2(ID,IOUT1,IOUT2,IMODE,RHOIN,IDSPIN)
12515 C-----------------------------------------------------------------------
12516 C Subroutine to calculate the two body matrix element for spin
12518 C-----------------------------------------------------------------------
12519 INCLUDE 'HERWIG65.INC'
12520 INTEGER IOUT1,IOUT2,IMODE,IDSPIN,ID,I,J,IDP(3),P0,P1,P2,O(2),P0P,
12522 DOUBLE PRECISION XMASS,PLAB,PRW,PCM,PREF(5),P(5,3),PM(5,3),PCMA,
12523 & HWUPCM,MA(3),MA2(3),HWULDO,PP,HWVDOT,N(3),EPS,PRE,PHS,A(2),
12525 DOUBLE COMPLEX RHOIN(2,2),S,D,ME(2,2,2),F1(2,2,8),F0(2,2,8),
12526 & F2M(2,2,8),F1M(2,2,8),F1F(2,2,8),F2(2,2,8,8),F0B(2,2,8,8)
12527 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
12528 DATA PREF/1.0D0,0.0D0,0.0D0,1.0D0,0.0D0/
12530 COMMON/HWHEWS/S(8,8,2),D(8,8)
12531 PARAMETER(EPS=1D-20)
12532 EXTERNAL HWUPCM,HWULDO,HWVDOT,HWRGEN
12533 C--first setup if this is the start of a new spin chain
12535 C--zero the elements of the array
12536 CALL HWVZRI( NMXHEP,ISNHEP)
12537 CALL HWVZRI( NMXSPN,JMOSPN)
12538 CALL HWVZRI(2*NMXSPN,JDASPN)
12539 CALL HWVZRI( NMXSPN, IDSPN)
12543 DECSPN(NSPN) = .FALSE.
12544 IF(RSPIN(IDHW(ID)).EQ.ZERO) THEN
12545 RHOSPN(1,1,NSPN) = ONE
12546 RHOSPN(2,1,NSPN) = ZERO
12547 RHOSPN(1,2,NSPN) = ZERO
12548 RHOSPN(2,2,NSPN) = ZERO
12550 RHOSPN(1,1,NSPN) = HALF
12551 RHOSPN(2,1,NSPN) = ZERO
12552 RHOSPN(1,2,NSPN) = ZERO
12553 RHOSPN(2,2,NSPN) = HALF
12557 C--MA is mass for this decay (OFF-SHELL)
12558 C--generate the momenta for a two body decay
12559 P(5,1) = PHEP(5, ID)
12560 P(5,2) = PHEP(5,IOUT1)
12561 P(5,3) = PHEP(5,IOUT2)
12563 IDP(2) = IDHW(IOUT1)
12564 IDP(3) = IDHW(IOUT2)
12567 1 MA2(I) = MA(I)**2
12568 PCMA = HWUPCM(P(5,1),P(5,2),P(5,3))
12569 C--setup the couplings
12571 2 A(I) = A2MODE(I,IMODE)
12572 C--phase space factor
12573 PHS = PCMA/MA2(1)/8.0D0/PIFAC
12575 WTMAX = WT2MAX(IMODE)
12578 CALL HWVEQU(5,PHEP(1,ID),P(1,1))
12579 CALL HWDTWO(P(1,1),P(1,2),P(1,3),PCMA,2.0D0,.TRUE.)
12581 C--compute the references vectors
12582 C--not important if SM particle which can't have spin measured
12583 C--ie anything other the top and tau
12584 C--also not important if particle is approx massless
12585 C--first the SM particles other than top and tau
12586 IF(IDP(I).LT.400.AND.(IDP(I).NE.6.AND.IDP(I).NE.12
12587 & .AND.IDP(I).NE.125.AND.IDP(I).NE.131)) THEN
12588 CALL HWVEQU(5,PREF,PLAB(1,I+3))
12589 C--all other particles
12591 PP = SQRT(HWVDOT(3,P(1,I),P(1,I)))
12592 CALL HWVSCA(3,ONE/PP,P(1,I),N)
12593 PLAB(4,I+3) = HALF*(P(4,I)-PP)
12594 PP = HALF*(PP-MA(I)-PP**2/(MA(I)+P(4,I)))
12595 CALL HWVSCA(3,PP,N,PLAB(1,I+3))
12596 CALL HWUMAS(PLAB(1,I+3))
12597 PP = HWVDOT(3,PLAB(1,I+3),PLAB(1,I+3))
12598 C--fix to avoid problems if approx massless due to energy
12599 IF(PP.LT.EPS) CALL HWVEQU(5,PREF,PLAB(1,I+3))
12601 C--now the massless vectors
12602 PP = HALF*P(5,I)**2/HWULDO(PLAB(1,I+3),P(1,I))
12604 4 PLAB(J,I) = P(J,I)-PP*PLAB(J,I+3)
12605 3 CALL HWUMAS(PLAB(1,I))
12606 C--change order of momenta for call to HE code
12618 6 PCM(5,I)=PLAB(5,I)
12619 C--compute the S functions
12620 CALL HWHEW2(6,PCM(1,1),S(1,1,2),S(1,1,1),D)
12623 S(I,J,2) = -S(I,J,2)
12624 7 D(I,J) = TWO*D(I,J)
12625 C--now compute the F functions needed
12626 CALL HWH2F2(6,F1 ,5,PM(1,2), MA(2))
12627 CALL HWH2F2(6,F0 ,4,PM(1,1), MA(1))
12628 CALL HWH2F2(6,F1M,5,PM(1,2),-MA(2))
12629 CALL HWH2F2(6,F2M,6,PM(1,3),-MA(3))
12630 CALL HWH2F1(6,F1F,5,PM(1,2), MA(2))
12631 CALL HWH2F3(6,F2 ,PM(1,3),ZERO )
12632 CALL HWH2F3(6,F0B ,PM(1,1),ZERO )
12633 C--now compute the diagrams
12634 C--fermion --> fermion scalar
12635 IF(I2DRTP(IMODE).EQ.1) THEN
12636 PRE = HWULDO(PM(1,1),PCM(1,4))*HWULDO(PM(1,2),PCM(1,5))
12637 PRE = HALF/SQRT(PRE)
12640 ME(P0,P1,2) = (0.0D0,0.0D0)
12641 10 ME(P0,P1,1) = PRE*( A(O(P1))*S(5,2,O(P1))*F0( P1 ,O(P0),2)
12642 & +A( P1 )*MA(2)* F0(O(P1),O(P0),5))
12643 C--fermion --> scalar fermion diagrams
12644 ELSEIF(I2DRTP(IMODE).EQ.2) THEN
12645 PRE = HWULDO(PM(1,1),PCM(1,4))*HWULDO(PM(1,3),PCM(1,6))
12646 PRE = HALF/SQRT(PRE)
12649 ME(P0,2,P2) = (0.0D0,0.0D0)
12650 20 ME(P0,1,P2) = PRE*( A(O(P2))*S(6,3,O(P2))*F0( P2 ,O(P0),3)
12651 & +A( P2 )*MA(3)* F0(O(P2),O(P0),6))
12652 C--fermion --> scalar antifermion
12653 ELSEIF(I2DRTP(IMODE).EQ.3) THEN
12654 PRE = HWULDO(PM(1,1),PCM(1,4))*HWULDO(PM(1,3),PCM(1,6))
12655 PRE =-HALF/SQRT(PRE)
12658 ME(P0,2,P2) = (0.0D0,0.0D0)
12659 30 ME(P0,1,P2) = PRE*( A( P0 )*S(4,1,P0)*F2M(O(P0),O(P2),1)
12660 & -A(O(P0))*MA(1) *F2M( P0 ,O(P2),4))
12661 C--fermion --> fermion gauge boson
12662 ELSEIF(I2DRTP(IMODE).EQ.4) THEN
12663 PRE = HWULDO(PM(1,1),PCM(1,4))*HWULDO(PM(1,2),PCM(1,5))*
12664 & HWULDO(PM(1,3),PCM(1,6))
12665 PRE = HALF/SQRT(PRE)
12668 ME(P0,P1,1) =-PRE*A(1)*F1F(O(P1),2,3)*S(3,6,2)*F0(1,O(P0),3)
12669 40 ME(P0,P1,2) = PRE* F1F(O(P1),1,3)*S(3,6,1)*F0(2,O(P0),3)
12670 C--scalar --> fermion antifermion
12671 ELSEIF(I2DRTP(IMODE).EQ.5) THEN
12672 PRE = HWULDO(PM(1,2),PCM(1,5))*HWULDO(PM(1,3),PCM(1,6))
12673 PRE =-HALF/SQRT(PRE)
12676 ME(2,P1,P2) = (0.0D0,0.0D0)
12677 50 ME(1,P1,P2) = PRE*( A(O(P1))*S(5,2,O(P1))*F2M( P1 ,O(P2),2)
12678 & +A( P1 )*MA(2)* F2M(O(P1),O(P2),5))
12679 C--scalar --> fermion fermion
12680 ELSEIF(I2DRTP(IMODE).EQ.6) THEN
12681 PRE = HWULDO(PM(1,2),PCM(1,5))*HWULDO(PM(1,3),PCM(1,6))
12682 PRE = HALF/SQRT(PRE)
12685 ME(2,P1,P2) = (0.0D0,0.0D0)
12686 60 ME(1,P1,P2) = PRE*( A(O(P2))*S(6,3,O(P2))*F1M( P2 ,P1,3)
12687 & +A( P2 )*MA(3)* F1M(O(P2),P1,6))
12688 C--fermion --> fermion pion
12689 ELSEIF(I2DRTP(IMODE).EQ.7) THEN
12690 PRE = HWULDO(PM(1,1),PCM(1,4))*HWULDO(PM(1,2),PCM(1,5))
12691 PRE = 0.25D0/SQRT(PRE)/RMASS(198)**2
12694 ME(P0,P1,2) = (0.0D0,0.0D0)
12695 70 ME(P0,P1,1) =PRE*(
12696 & MA(1)*A(O(P0))*( S(5,2,O(P1))*F2( P1 ,O(P0),2,4)
12697 & +MA(2)*F2(O(P1),O(P0),5,4))
12698 & +A(P0)*S(1,4,P0)*( S(5,2,O(P1))*F2( P1 , P0 ,2,1)
12699 & +MA(2)*F2(O(P1), P0 ,5,1)))
12700 C--scalar --> antifermion fermion
12701 ELSEIF(I2DRTP(IMODE).EQ.8) THEN
12702 PRE = HWULDO(PM(1,2),PCM(1,5))*HWULDO(PM(1,3),PCM(1,6))
12703 PRE =-HALF/SQRT(PRE)
12706 ME(2,P1,P2) = (0.0D0,0.0D0)
12707 80 ME(1,P1,P2) = PRE*( A(O(P2))*S(6,3,O(P2))*F1M( P2 ,O(P1),3)
12708 & +A( P2 )*MA(3)* F1M(O(P2),O(P1),6))
12709 C--neutralino --> gravitino photon
12710 ELSEIF(I2DRTP(IMODE).EQ.9) THEN
12711 PRE = TWO*HWULDO(PM(1,1),PCM(1,4))*HWULDO(PM(1,3),PCM(1,6))
12712 PRE = TWO/SQRT(PRE)
12715 ME(P1,P2,O(P2)) = (0.0D0,0.0D0)
12716 90 ME(P1,P2, P2 ) = PRE*S(2,3,P2)*S(3,6,O(P2))*
12717 & S(3,2,P2)*F0(O(P2),P1,2)
12718 C--neutralino --> gravitino scalar
12719 ELSEIF(I2DRTP(IMODE).EQ.10) THEN
12720 PRE = TWO*HWULDO(PM(1,1),PCM(1,4))
12721 PRE = ONE/SQRT(PRE)
12724 ME(P1,P2,2) = (0.0D0,0.0D0)
12725 100 ME(P1,P2,1) = PRE*F2(P2,1,2,2)*F0(1,O(P1),2)
12726 C--sfermion --> fermion gravitino
12727 ELSEIF(I2DRTP(IMODE).EQ.11) THEN
12728 PRE = TWO*HWULDO(PM(1,2),PCM(1,5))
12729 PRE = ONE/SQRT(PRE)
12732 ME(2,P1,P2) = (0.0D0,0.0D0)
12733 110 ME(1,P1,P2) = PRE*A(O(P2))*F1M(O(P1),P2,3)*F0B(P2,P2,3,3)
12734 C--antisfermion --> antifermion gravitino
12735 ELSEIF(I2DRTP(IMODE).EQ.12) THEN
12736 PRE = TWO*HWULDO(PM(1,2),PCM(1,5))
12737 PRE = ONE/SQRT(PRE)
12740 ME(2,P1,P2) = (0.0D0,0.0D0)
12741 120 ME(1,P1,P2) = PRE*A(O(P2))*F0B(P2,P2,3,3)*F1(P2,O(P1),3)
12742 C--scalar --> antifermion antifermion
12743 ELSEIF(I2DRTP(IMODE).EQ.13) THEN
12744 PRE = HWULDO(PM(1,2),PCM(1,5))*HWULDO(PM(1,3),PCM(1,6))
12745 PRE = HALF/SQRT(PRE)
12748 ME(2,P1,P2) = (0.0D0,0.0D0)
12749 130 ME(1,P1,P2) = PRE*( A( P1 )*S(5,2, P1 )*F2M(O(P1),O(P2),2)
12750 & +A(O(P1))*MA(2) *F2M( P1 ,O(P2),5))
12751 C--antifermion --> scalar antifermion
12752 ELSEIF(I2DRTP(IMODE).EQ.14) THEN
12753 PRE = HWULDO(PM(1,1),PCM(1,4))*HWULDO(PM(1,3),PCM(1,6))
12754 PRE = HALF/SQRT(PRE)
12757 ME(P0,2,P2) = (0.0D0,0.0D0)
12758 140 ME(P0,1,P2) = PRE*( A(O(P0))*S(4,1,O(P0))*F2M( P0 ,O(P2),1)
12759 & -A( P0 )*MA(1) *F2M(O(P0),O(P2),4))
12760 C--unrecognized type of diagram
12762 CALL HWWARN('HWDSM2',500,*999)
12764 C--now compute the weight
12770 500 WGT = WGT+PHS*P2MODE(IMODE)*ME(P0,P1,P2)*DCONJG(ME(P0P,P1,P2))*
12772 IF(I2DRTP(IMODE).EQ.5.OR.I2DRTP(IMODE).EQ.6.OR.
12773 & I2DRTP(IMODE).EQ.8.OR.I2DRTP(IMODE).EQ.13) GOTO 300
12774 C--issue warning if greater than maximum
12775 IF(WGT.GT.WTMAX) THEN
12776 CALL HWWARN('HWDSM2',1,*200)
12777 WRITE(6,2000) RNAME(IDK(ID2PRT(IMODE))),
12778 & RNAME(IDKPRD(1,ID2PRT(IMODE))),RNAME(IDKPRD(2,ID2PRT(IMODE))),
12780 WT2MAX(IMODE) = 1.1D0*WGT
12781 WTMAX = WT2MAX(IMODE)
12783 200 IF(HWRGEN(0)*WTMAX.GT.WGT.AND.NTRY.LT.NSNTRY) GOTO 1000
12784 IF(NTRY.GE.NSNTRY) CALL HWWARN('HWDSM2',100,*999)
12785 C--now enter the momenta in the common block
12786 300 CALL HWVEQU(5,P(1,2),PHEP(1,IOUT1))
12787 CALL HWVEQU(5,P(1,3),PHEP(1,IOUT2))
12788 C--set up the spin information
12789 C--setup for all decays
12790 JMOSPN(NSPN+1) = IDSPIN
12791 JMOSPN(NSPN+2) = IDSPIN
12792 JDASPN(1,IDSPIN) = NSPN+1
12793 JDASPN(2,IDSPIN) = NSPN+2
12794 IDSPN(NSPN+1) = IOUT1
12795 IDSPN(NSPN+2) = IOUT2
12797 DECSPN(NSPN+I) = .FALSE.
12799 11 JDASPN(I,NSPN+J) = 0
12800 ISNHEP(IOUT1) = NSPN+1
12801 ISNHEP(IOUT2) = NSPN+2
12803 IF(RSPIN(IDHW(IDSPN(NSPN+I))).EQ.ZERO) THEN
12804 RHOSPN(1,1,NSPN+I) = ONE
12805 RHOSPN(2,1,NSPN+I) = ZERO
12806 RHOSPN(1,2,NSPN+I) = ZERO
12807 RHOSPN(2,2,NSPN+I) = ZERO
12809 RHOSPN(1,1,NSPN+I) = HALF
12810 RHOSPN(2,1,NSPN+I) = ZERO
12811 RHOSPN(1,2,NSPN+I) = ZERO
12812 RHOSPN(2,2,NSPN+I) = HALF
12816 C--now enter the matrix element
12820 MESPN(P0,P1,P2,2,1,IDSPIN) = (0.0D0,0.0D0)
12821 150 MESPN(P0,P1,P2,1,1,IDSPIN) = ME(P0,P1,P2)
12822 SPNCFC(1,1,IDSPIN) = ONE
12825 C--format statements
12826 2000 FORMAT(/'WEIGHT FOR DECAY ',A8,' --> ',A8,' ',A8, 'EXCEEDS MAX',
12827 & /10X,' MAXIMUM WEIGHT =',1PG24.16,
12828 & /10X,'NEW MAXIMUM WEIGHT =',1PG24.16)
12831 *CMZ :- -09/04/02 13:46:07 by Peter Richardson
12832 *-- Author : Peter Richardson
12833 C-----------------------------------------------------------------------
12834 SUBROUTINE HWDSM3(NPR,ID,IOUT1,IOUT2,IOUT3,IMODE,RHOIN,IDSPIN)
12835 C-----------------------------------------------------------------------
12836 C Master subroutine for three body SUSY and spin ME's
12837 C Uses HWD3ME to generate the momenta etc
12838 C-----------------------------------------------------------------------
12839 INCLUDE 'HERWIG65.INC'
12840 DOUBLE COMPLEX F0(2,2,8),F1(2,2,8),F1M(2,2,8),F3(2,2,8),
12841 & F0M(2,2,8),F2(2,2,8),RHOIN(2,2),F01(2,2,8,8)
12842 DOUBLE PRECISION A,B,MS,MWD,MA,MB,MA2,MB2,M342,M232,M242,MR,
12843 & P(5,4),PZ(5),HWRGEN,CV,CA,BR,PM(5,4),CFTHRE(NCFMAX,NCFMAX)
12844 INTEGER ID,IDP(4+NDIAGR),NPR,ITYPE,I,IB,ID1,ID2,IDSPIN,
12845 & DRTYPE(NDIAGR),IOUT(3),IMODE,IOUT1,IOUT2,IOUT3,J,NCTHRE,
12847 COMMON/HWD3BY/F0,F0M,F1M,F1,F2,F3,F01,A(2,NDIAGR),B(2,NDIAGR),
12848 & MS(NDIAGR),MWD(NDIAGR),MR(NDIAGR),MA(4),MA2(4),MB(4),MB2(4),
12849 & M342,M232,M242,P,PM,CFTHRE,IDP,DRTYPE,NCTHRE,DRCF
12851 SAVE PZ,IOUT,ITYPE,ID1,ID2
12852 C--calculate the matrix element for a three body decay
12854 C--set up the decay products, if a SUSY decay the SUSY particle
12855 C--must be the first decay product
12856 IF(ABS(IDHEP(IOUT1)).GT.1000000) THEN
12860 ELSEIF(ABS(IDHEP(IOUT2)).GT.1000000) THEN
12864 ELSEIF(ABS(IDHEP(IOUT3)).GT.1000000) THEN
12868 C--special for top decay (bottom must be first)
12869 ELSEIF(ABS(IDHEP(ID)).EQ.6) THEN
12878 C--fermion must be second and antifermion third
12879 IF(IDHEP(IOUT(2)).LT.0.AND.
12880 & (ABS(IDHEP(IOUT(1))).GT.1000000.OR.ABS(IDHEP(ID)).EQ.6)) THEN
12885 C--setup the OFF SHELL MASSES
12888 1 MA(I+1) = PHEP(5,IOUT(I))
12890 2 MA2(I) = MA(I)**2
12892 CALL HWD3ME(ID,0,IMODE,RHOIN,IDSPIN)
12893 IF(IERROR.NE.0) RETURN
12894 C--juggle the momenta for the RPV BV gluino if needed
12895 IF(SPCOPT.EQ.2.AND.N3NCFL(IMODE).EQ.3) THEN
12896 IF(NCFL(IDSPIN).EQ.2) THEN
12900 ELSEIF(NCFL(IDSPIN).EQ.3) THEN
12906 IDHW(IOUT(I)) = IDP(I+1)
12909 C--copy momenta into event record
12911 3 CALL HWVEQU(5,P(1,1+I),PHEP(1,IOUT(I)))
12912 C--enter the spin information in the common block
12914 C--set up if start of new spin chain
12916 C--zero the elements
12917 CALL HWVZRI( NMXHEP,ISNHEP)
12918 CALL HWVZRI( NMXSPN,JMOSPN)
12919 CALL HWVZRI(2*NMXSPN,JDASPN)
12920 CALL HWVZRI( NMXSPN, IDSPN)
12924 DECSPN(NSPN) = .FALSE.
12925 C--set up spin density matrix for particle
12926 IF(RSPIN(IDHW(ID)).EQ.ZERO) THEN
12927 RHOSPN(1,1,NSPN) = ONE
12928 RHOSPN(2,1,NSPN) = ZERO
12929 RHOSPN(1,2,NSPN) = ZERO
12930 RHOSPN(2,2,NSPN) = ZERO
12932 RHOSPN(1,1,NSPN) = HALF
12933 RHOSPN(2,1,NSPN) = ZERO
12934 RHOSPN(1,2,NSPN) = ZERO
12935 RHOSPN(2,2,NSPN) = HALF
12939 C--enter the decay products
12940 JDASPN(1,IDSPIN) = NSPN+1
12941 JDASPN(2,IDSPIN) = NSPN+3
12943 JMOSPN(NSPN+I ) = IDSPIN
12944 IDSPN (NSPN+I ) = IOUT(I)
12945 DECSPN(NSPN+I ) = .FALSE.
12946 ISNHEP(IOUT(I) ) = NSPN+I
12947 IF(RSPIN(IDHW(IOUT(I))).EQ.ZERO) THEN
12948 RHOSPN(1,1,NSPN+I) = ONE
12949 RHOSPN(2,1,NSPN+I) = ZERO
12950 RHOSPN(1,2,NSPN+I) = ZERO
12951 RHOSPN(2,2,NSPN+I) = ZERO
12953 RHOSPN(1,1,NSPN+I) = HALF
12954 RHOSPN(2,1,NSPN+I) = ZERO
12955 RHOSPN(1,2,NSPN+I) = ZERO
12956 RHOSPN(2,2,NSPN+I) = HALF
12959 7 JDASPN(J,NSPN+I) = 0
12962 C--select the decay mode and generate the decay for a two body mode
12963 ELSEIF(NPR.EQ.2) THEN
12964 IF(IDHW(IOUT2).GE.198.AND.IDHW(IOUT2).LE.200) THEN
12968 ELSEIF(IDHW(IOUT1).GE.198.AND.IDHW(IOUT1).LE.200) THEN
12973 CALL HWWARN('HWDSM3',501,*999)
12975 C--setup the off shell masses and particle ids for me code
12977 MA(2) = PHEP(5,IOUT(1))
12978 CALL HWDBOZ(IB,ID1,ID2,CV,CA,BR,0)
12980 IF(IB.EQ.199) ITYPE = ITYPE+1
12981 IF(ITYPE.GT.120) ITYPE = ITYPE-114
12982 IF(IB.NE.200) ITYPE = ITYPE/2
12983 C--generate momenta of decay products
12984 CALL HWD3ME(ID,ITYPE,IMODE,RHOIN,IDSPIN)
12985 CALL HWVEQU(5,P(1,2),PHEP(1,IOUT(1)))
12986 CALL HWVSUM(4,P(1,3),P(1,4),PZ)
12988 CALL HWVEQU(5,PZ,PHEP(1,IOUT(2)))
12989 C--enter the spin information in the common block if starting new chain
12990 IF(SYSPIN.AND.NSPN.EQ.0) THEN
12991 C--zero elements of common block
12992 CALL HWVZRI( NMXHEP,ISNHEP)
12993 CALL HWVZRI( NMXSPN,JMOSPN)
12994 CALL HWVZRI(2*NMXSPN,JDASPN)
12995 CALL HWVZRI( NMXSPN, IDSPN)
12999 DECSPN(NSPN) = .FALSE.
13000 IF(RSPIN(IDHW(ID)).EQ.ZERO) THEN
13001 RHOSPN(1,1,NSPN) = ONE
13002 RHOSPN(2,1,NSPN) = ZERO
13003 RHOSPN(1,2,NSPN) = ZERO
13004 RHOSPN(2,2,NSPN) = ZERO
13006 RHOSPN(1,1,NSPN) = HALF
13007 RHOSPN(2,1,NSPN) = ZERO
13008 RHOSPN(1,2,NSPN) = ZERO
13009 RHOSPN(2,2,NSPN) = HALF
13014 IDSPN (NSPN+1 ) = IOUT(1)
13015 ISNHEP(IOUT(1)) = NSPN+1
13017 C--put the boson decay products into the event record for a two body mode
13018 ELSEIF(NPR.EQ.-1) THEN
13019 IOUT(1) = JDAHEP(1,IOUT(2))
13022 C--set up the status of the particles
13023 ISTHEP(IOUT(1)) = 195
13024 JDAHEP(1,IOUT(1)) = NHEP+1
13025 JDAHEP(2,IOUT(1)) = NHEP+2
13026 C--find the ID's of the particles
13027 IF(IDHW(IOUT(1)).EQ.200) THEN
13029 IF(ITYPE.GT.6) ID1 = ID1+114
13033 IF(ITYPE.GT.3) ID1 = ID1+114
13035 IF(IDHW(IOUT(1)).EQ.198) THEN
13041 C--put id's of decay products into the event record
13044 IDHEP(NHEP+1) = IDPDG(ID1)
13045 IDHEP(NHEP+2) = IDPDG(ID2)
13046 C--boost decay products momenta to rest frame of boson
13047 CALL HWULOF(PZ,P(1,3),P(1,3))
13048 CALL HWULOF(PZ,P(1,4),P(1,4))
13049 C--boost back to lab using new boson
13050 CALL HWULOB(PHEP(1,IOUT(1)),P(1,3),PHEP(1,NHEP+1))
13051 CALL HWULOB(PHEP(1,IOUT(1)),P(1,4),PHEP(1,NHEP+2))
13052 C--setup for decay to quarks
13054 ISTHEP(NHEP+1) = 113
13055 ISTHEP(NHEP+2) = 114
13056 JMOHEP(2,NHEP+1) = NHEP+2
13057 JDAHEP(2,NHEP+1) = NHEP+2
13058 JMOHEP(2,NHEP+2) = NHEP+1
13059 JDAHEP(2,NHEP+2) = NHEP+1
13060 JMOHEP(1,NHEP+1) = IOUT(1)
13061 JMOHEP(1,NHEP+2) = IOUT(1)
13062 C--setup for decay to leptons
13064 ISTHEP(NHEP+1) = 193
13065 ISTHEP(NHEP+2) = 193
13066 JMOHEP(1,NHEP+1) = IOUT(1)
13067 JMOHEP(1,NHEP+2) = IOUT(1)
13068 JMOHEP(2,NHEP+1) = JMOHEP(1,IOUT(1))
13069 JMOHEP(2,NHEP+2) = JMOHEP(1,IOUT(1))
13070 JDAHEP(1,NHEP+1) = 0
13071 JDAHEP(1,NHEP+2) = 0
13072 JDAHEP(2,NHEP+1) = 0
13073 JDAHEP(2,NHEP+2) = 0
13076 C--finish entering the spin information in the common block
13078 JDASPN(1,IDSPIN) = NSPN+1
13079 JDASPN(2,IDSPIN) = NSPN+3
13081 JMOSPN(NSPN+I ) = IDSPIN
13082 DECSPN(NSPN+I ) = .FALSE.
13083 IF(RSPIN(IDHW(IOUT(I))).EQ.ZERO) THEN
13084 RHOSPN(1,1,NSPN+I) = ONE
13085 RHOSPN(2,1,NSPN+I) = ZERO
13086 RHOSPN(1,2,NSPN+I) = ZERO
13087 RHOSPN(2,2,NSPN+I) = ZERO
13089 RHOSPN(1,1,NSPN+I) = HALF
13090 RHOSPN(2,1,NSPN+I) = ZERO
13091 RHOSPN(1,2,NSPN+I) = ZERO
13092 RHOSPN(2,2,NSPN+I) = HALF
13095 6 JDASPN(J,NSPN+I) =0
13097 IDSPN (NSPN-1) = NHEP-1
13098 IDSPN (NSPN ) = NHEP
13099 ISNHEP(NHEP-1) = NSPN-1
13100 ISNHEP(NHEP ) = NSPN
13102 C--perform the parton shower for the decay products of the gauge boson
13103 IF(ID1.LE.12) CALL HWBGEN
13104 C--error issue warning
13106 CALL HWWARN('HWDSM3',500,*999)
13110 *CMZ :- -11/10/01 14:03:42 by Peter Richardson
13111 *-- Author : Peter Richardson
13112 C-----------------------------------------------------------------------
13113 SUBROUTINE HWDSM4(IOPT,ID,IOUT1,IOUT2,IMODE)
13114 C-----------------------------------------------------------------------
13115 C Subroutine to perform the four body decays
13116 C IOPT = 1 select decay mode and generate momenta
13117 C IOPT = 2 enter first decays and perform parton shower
13118 C-----------------------------------------------------------------------
13119 INCLUDE 'HERWIG65.INC'
13120 INTEGER IOPT,ID,IOUT1,IOUT2,IB(2),I,IDF(4),ITYPE(2),IMODE,
13121 & IDP(4+NDIAGR),ID1,ID2,J
13122 DOUBLE PRECISION CV,CA,A,B,MS,MWD,MR,M,M2,P(5,5),PW(5,2),BR
13123 COMMON/HWD4BY/A(2),B(2),MS(2),MWD(2),MR(2),M(5),M2(5),P,IDP
13125 C--generate the decay
13127 IB(1) = IDHW(IOUT1)
13128 IB(2) = IDHW(IOUT2)
13129 C--select the decays of the bosons
13131 CALL HWDBOZ(IB(I),IDF(2*I-1),IDF(2*I),CV,CA,BR,1)
13132 ITYPE(I) = IDF(2*I-1)
13133 IF(IB(I).EQ.199) ITYPE(I) = ITYPE(I)+1
13134 IF(ITYPE(I).GT.120) ITYPE(I) = ITYPE(I)-114
13135 1 IF(IB(I).NE.200) ITYPE(I) = ITYPE(I)/2
13136 C--generate the momenta of the decay products
13137 CALL HWD4ME(ID,ITYPE(1),ITYPE(2),IMODE)
13139 CALL HWVSUM(4,P(1,2*I),P(1,2*I+1),PW(1,I))
13140 2 CALL HWUMAS(PW(1,I))
13141 CALL HWVEQU(5,PW(1,1),PHEP(1,IOUT1))
13142 CALL HWVEQU(5,PW(1,2),PHEP(1,IOUT2))
13144 IDSPN(1) = JDAHEP(1,ID)
13145 DECSPN(1) = .FALSE.
13146 ISNHEP(JDAHEP(1,ID)) = 1
13150 DECSPN(I) = .FALSE.
13153 ELSEIF(IOPT.EQ.2) THEN
13154 IB(1) = JDAHEP(1,IOUT1)
13155 IB(2) = JDAHEP(1,IOUT2)
13157 ISTHEP(IB(I)) = 195
13158 JDAHEP(1,IB(I)) = NHEP+1
13159 JDAHEP(2,IB(I)) = NHEP+2
13160 C--find the ID's of the particles
13161 IF(IDHW(IB(I)).EQ.200) THEN
13163 IF(ITYPE(I).GT.6) ID1 = ID1+114
13167 IF(ITYPE(I).GT.3) ID1 = ID1+114
13169 IF(IDHW(IB(I)).EQ.198) THEN
13175 C--put id's of decay products into the event record
13178 IDHEP(NHEP+1) = IDPDG(ID1)
13179 IDHEP(NHEP+2) = IDPDG(ID2)
13180 C--boost decay products momenta to rest frame of boson
13181 CALL HWULOF(PW(1,I),P(1,2*I ),P(1,2*I ))
13182 CALL HWULOF(PW(1,I),P(1,2*I+1),P(1,2*I+1))
13183 C--boost back to lab using new boson
13184 CALL HWULOB(PHEP(1,IB(I)),P(1,2*I ),PHEP(1,NHEP+1))
13185 CALL HWULOB(PHEP(1,IB(I)),P(1,2*I+1),PHEP(1,NHEP+2))
13186 C--setup for decay to quarks
13188 ISTHEP(NHEP+1) = 113
13189 ISTHEP(NHEP+2) = 114
13190 JMOHEP(2,NHEP+1) = NHEP+2
13191 JDAHEP(2,NHEP+1) = NHEP+2
13192 JMOHEP(2,NHEP+2) = NHEP+1
13193 JDAHEP(2,NHEP+2) = NHEP+1
13194 JMOHEP(1,NHEP+1) = IB(I)
13195 JMOHEP(1,NHEP+2) = IB(I)
13196 C--setup for decay to leptons
13198 ISTHEP(NHEP+1) = 193
13199 ISTHEP(NHEP+2) = 193
13200 JMOHEP(1,NHEP+1) = IB(I)
13201 JMOHEP(1,NHEP+2) = IB(I)
13202 JMOHEP(2,NHEP+1) = JMOHEP(1,IB(I))
13203 JMOHEP(2,NHEP+2) = JMOHEP(1,IB(I))
13205 C--enter the information in the spin common block
13207 IDSPN(2*I ) = NHEP+1
13208 IDSPN(2*I+1) = NHEP+2
13209 ISNHEP(NHEP+1) = 2*I
13210 ISNHEP(NHEP+2) = 2*I+1
13213 C--perform the parton shower for the decay products of the gauge boson
13214 IF(ID1.LE.12) CALL HWBGEN
13219 *CMZ :- -17/10/01 09:42:21 by Peter Richardson
13220 *-- Author : Peter Richardson
13221 C-----------------------------------------------------------------------
13222 SUBROUTINE HWDTAU(IOPT,IHEP,POL)
13223 C-----------------------------------------------------------------------
13224 C HERWIG-TAUOLA interface to perform tau decays using TAUOLA rather
13226 C IOPT = 0 initialises
13227 C IOPT = 1 performs decay
13228 C IOPT = 2 write outs final TAUOLA information
13229 C-----------------------------------------------------------------------
13230 INCLUDE 'HERWIG65.INC'
13231 INTEGER IOPT,IHEP,ID,ITAU,I,IMO,NHEPPO
13232 DOUBLE PRECISION POL,PLAB(4)
13235 DATA PLAB/0.0D0,0.0D0,0.0D0,1.0D0/
13236 C--common block for PHOTOS
13238 COMMON /PHOQED/ QEDRAD(NMXHEP)
13239 C--common blocks for TAUOLA
13241 COMMON /TAUPOS/ NP1, NP2
13242 DOUBLE PRECISION Q1(4),Q2(4),P1(4),P2(4),P3(4),P4(4)
13243 COMMON / MOMDEC / Q1,Q2,P1,P2,P3,P4
13245 IF(IOPT.EQ.-1) THEN
13246 C--initialise TAUOLA
13247 CALL INIETC(JAK1,JAK2,ITDKRC,IFPHOT)
13249 CALL INIPHX(0.01d0)
13251 C--generate a decay
13252 ELSEIF(IOPT.EQ.1) THEN
13256 1 IMO = JMOHEP(1,IMO)
13257 IF(IDHW(IMO).EQ.ID) GOTO 1
13258 C--id of tau for tauola
13263 ELSEIF(ID.EQ.131) THEN
13268 CALL HWWARN('HWDTAU',501,*999)
13270 C--set up the tau polarization
13273 POL1(3) = REAL(POL)
13277 P1(I) = PHEP(I,IHEP)
13278 P2(I) = PHEP(I,IHEP)
13279 C--we measure tau spins in lab frame
13282 C--perform the decay and generate QED radiation if needed
13284 CALL DEXAY(ITAU,POL1)
13285 IF(IFPHOT.EQ.1) THEN
13292 IF(NHEPPO.NE.NHEP) THEN
13293 DO 2 I=NHEPPO+1,NHEP
13294 CALL HWVEQU(4,VHEP(1,IHEP),VHEP(1,I))
13295 2 CALL HWUIDT(1,IDHEP(I),IDHW(I),DUMMY)
13297 C--write out info at end
13298 ELSEIF(IOPT.EQ.2) THEN
13299 CALL DEXAY(100,POL1)
13300 C--otherwise issue warning
13302 CALL HWWARN('HWDTAU',500,*999)
13306 *CMZ :- -26/04/91 14.55.44 by Federico Carminati
13307 *-- Author : Bryan Webber
13308 C-----------------------------------------------------------------------
13309 SUBROUTINE HWDTHR(P0,P1,P2,P3,WEIGHT)
13310 C-----------------------------------------------------------------------
13311 C GENERATES THREE-BODY DECAY 0->1+2+3 DISTRIBUTED
13312 C ACCORDING TO PHASE SPACE * WEIGHT
13313 C-----------------------------------------------------------------------
13314 DOUBLE PRECISION HWRGEN,HWRUNI,A,B,C,D,AA,BB,CC,DD,EE,FF,PP,QQ,WW,
13315 & RR,PCM1,PC23,WEIGHT,P0(5),P1(5),P2(5),P3(5),P23(5),TWO
13316 EXTERNAL HWRGEN,HWRUNI,WEIGHT
13317 PARAMETER (TWO=2.D0)
13321 IF (B.LT.C) CALL HWWARN('HWDTHR',100,*999)
13332 C CHOOSE MASS OF SUBSYSTEM 23 WITH PRESCRIBED DISTRIBUTION
13334 10 FF=HWRUNI(0,BB,CC)
13337 WW=WEIGHT(FF,A,B,C)**2
13339 IF (PP*QQ*WW.LT.RR*RR) GOTO 10
13341 C FF IS MASS SQUARED OF SUBSYSTEM 23.
13343 C DO 2-BODY DECAYS 0->1+23, 23->2+3
13346 PCM1=SQRT(PP)*0.5/P0(5)
13347 PC23=SQRT(QQ)*0.5/P23(5)
13348 CALL HWDTWO(P0,P1,P23,PCM1,TWO,.TRUE.)
13349 CALL HWDTWO(P23,P2,P3,PC23,TWO,.TRUE.)
13352 *CMZ :- -09/12/92 11.03.46 by Bryan Webber
13353 *-- Author : Bryan Webber
13354 C-----------------------------------------------------------------------
13355 SUBROUTINE HWDTOP(DECAY)
13356 C-----------------------------------------------------------------------
13357 C DECIDES WHETHER TO DO TOP QUARK DECAY BEFORE HADRONIZATION
13358 C-----------------------------------------------------------------------
13359 INCLUDE 'HERWIG65.INC'
13361 DECAY=RMASS(6).GT.130D0
13364 *CMZ :- -27/01/94 17.38.49 by Mike Seymour
13365 *-- Author : Bryan Webber & Mike Seymour
13366 C-----------------------------------------------------------------------
13367 SUBROUTINE HWDTWO(P0,P1,P2,PCM,COSTH,ZAXIS)
13368 C-----------------------------------------------------------------------
13369 C GENERATES DECAY 0 -> 1+2
13371 C PCM IS CM MOMENTUM
13373 C COSTH = COS THETA IN P0 REST FRAME (>1 FOR ISOTROPIC)
13374 C IF ZAXIS=.TRUE., COS THETA IS MEASURED FROM THE ZAXIS
13375 C IF .FALSE., IT IS MEASURED FROM P0'S DIRECTION
13376 C-----------------------------------------------------------------------
13377 DOUBLE PRECISION HWRUNI,ONE,ZERO,PCM,COSTH,C,S,P0(5),P1(5),P2(5),
13381 PARAMETER (ZERO=0.D0, ONE=1.D0)
13382 C--CHOOSE C.M. ANGLES
13384 IF (C.GT.ONE) C=HWRUNI(0,-ONE,ONE)
13386 CALL HWRAZM(PCM*S,PP(1),PP(2))
13387 C--PP IS MOMENTUM OF 2 IN C.M.
13389 PP(4)=SQRT(P2(5)**2+PCM**2)
13391 C--ROTATE IF NECESSARY
13392 IF (COSTH.LE.ONE.AND..NOT.ZAXIS) THEN
13393 CALL HWUROT(P0,ONE,ZERO,R)
13394 CALL HWUROB(R,PP,PP)
13396 C--BOOST FROM C.M. TO LAB FRAME
13397 CALL HWULOB(P0,PP,P2)
13398 CALL HWVDIF(4,P0,P2,P1)
13401 *CMZ :- -26/04/91 11.11.55 by Bryan Webber
13402 *-- Author : Bryan Webber
13403 C-----------------------------------------------------------------------
13404 FUNCTION HWDWWT(EMSQ,A,B,C)
13405 C-----------------------------------------------------------------------
13406 C MATRIX ELEMENT SQUARED FOR V-A WEAK DECAY
13407 C-----------------------------------------------------------------------
13408 DOUBLE PRECISION HWDWWT,EMSQ,A,B,C
13409 HWDWWT=(A-EMSQ)*(EMSQ-B)*C
13412 *CMZ :- -26/06/01 14.44.53 by Stefano Moretti
13413 *-- Author : Stefano Moretti
13414 C-----------------------------------------------------------------------
13415 FUNCTION HWDHWT(EMSQ,DUMMYA,DUMMYB,DUMMYC)
13416 C-----------------------------------------------------------------------
13417 C MATRIX ELEMENT SQUARED FOR
13418 C ((V-A)*TB1+(V+A)*CT1)*((V-A)*TB2+(V+A)*CT2)) WEAK DECAY
13419 C-----------------------------------------------------------------------
13420 INCLUDE 'HERWIG65.INC'
13422 COMMON/SFF/IT1,IB1,IT2,IB2
13423 DOUBLE PRECISION TB,BT
13424 INTEGER IT1,IB1,IT2,IB2
13425 DOUBLE PRECISION TBH,HBT,CB1,TB1,CB2,TB2
13426 DOUBLE PRECISION DUMMYA,DUMMYB,DUMMYC
13427 DOUBLE PRECISION HWDHWT,EMSQ
13432 C use formula (4.52) page 217 of `Higgs Hunter Guide'.
13433 TBH=(TB1+CB1-EMSQ)*(TB1*TB*TB+CB1/TB/TB)+4.*TB1*CB1
13434 C use formula (B. 1) page 411 of `Higgs Hunter Guide'.
13435 HBT=(EMSQ-TB2-CB2)*(TB2*BT*BT+CB2/BT/BT)-4.*TB2*CB2
13437 HWDHWT=ABS(HWDHWT)*SQRT(EMSQ)
13440 *CMZ :- -07/09/00 10:06:23 by Peter Richardson
13441 *-- Author : Ian Knowles
13442 C-----------------------------------------------------------------------
13443 SUBROUTINE HWDXLM(DKVRTX,STAB)
13444 C-----------------------------------------------------------------------
13445 C Sets STAB=.TRUE. if DKVRTX lies outside the specified region.
13446 C Revised 05/09/00 by BRW to put parameters in common
13447 C-----------------------------------------------------------------------
13448 INCLUDE 'HERWIG65.INC'
13449 DOUBLE PRECISION DKVRTX(4),RR
13452 RR=DKVRTX(1)**2+DKVRTX(2)**2
13453 IF (IOPDKL.EQ.1) THEN
13454 C Cylindrical geometry
13455 IF (RR.GE.DXRCYL**2.OR.ABS(DKVRTX(3)).GE.DXZMAX) STAB=.TRUE.
13456 ELSEIF (IOPDKL.EQ.2) THEN
13457 C Spherical geometry
13459 IF (RR.GE.DXRSPH**2) STAB=.TRUE.
13461 C User supplied geometry -- missing
13462 CALL HWWARN('HWDXLM',500,*999)
13466 *CMZ :- -11/05/01 15.44.55 by Mike Seymour
13467 *-- Author : Mike Seymour
13468 C-----------------------------------------------------------------------
13470 C-----------------------------------------------------------------------
13471 C INTEGRAND OF BEAMSTRAHLUNG FUNCTION INTEGRATION
13472 C NOTE THAT THE JACOBIAN TRANSFORMATION (1-Z)^ETA HAS ETA HARDCODED
13473 C-----------------------------------------------------------------------
13475 DOUBLE PRECISION HWECIR,Y,Z,ETA,CIRCEE
13479 HWECIR=(1-Z)**ETA/(1-ETA)*CIRCEE(Z,-1D0)/SQRT(CIRCEE(-1D0,-1D0))
13482 *CMZ :- -15/07/02 17.56.53 by Peter Richardson
13483 *-- Author : Bryan Webber
13484 C-----------------------------------------------------------------------
13486 C-----------------------------------------------------------------------
13487 C TERMINAL CALCULATIONS ON ELEMENTARY PROCESS
13488 C Modified 28/03/01 by BRW to handle negative weights
13489 C Modified 15/07/02 by PR for Les Houches Accord
13490 C-----------------------------------------------------------------------
13491 INCLUDE 'HERWIG65.INC'
13493 DOUBLE PRECISION RNWGT,SPWGT,ERWGT
13494 C--Les Houches Common Block
13496 PARAMETER(MAXPUP=100)
13497 INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP
13498 DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP
13499 COMMON /HEPRUP/ IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2),
13500 & IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),
13501 & XMAXUP(MAXPUP),LPRUP(MAXPUP)
13502 IF(TAUDEC.EQ.'TAUOLA') CALL HWDTAU(2,0,0.0D0)
13503 IF (NWGTS.EQ.0) THEN
13506 10 FORMAT(10X,'NO WEIGHTS GENERATED')
13509 C--output Les Houches common block information
13510 IF(IPROC.LE.0) THEN
13511 C--WRITE THE HEADER
13514 C--FOR THE FIRST WEIGHT OPTION CALCULATE THE CROSS SECTION
13515 IF(ABS(IDWTUP).EQ.1) THEN
13517 RNWGT = 1.0D0/DBLE(LHIWGT(I))
13518 LHXSCT(I) = LHWGT(I)*RNWGT
13519 LHXERR(I) = SQRT(MAX(LHWGTS(I)*RNWGT-LHXSCT(I)**2,ZERO))
13520 LHXERR(I) = LHXERR(I)*SQRT(RNWGT)
13521 LHXSCT(I) = LHXSCT(I)*1.0D3
13522 LHXERR(I) = LHXERR(I)*1.0D3
13523 LHXMAX(I) = LHXMAX(I)*1.0D3
13525 C--FOR THE SECOND WEIGHT OPTION THIS WAS AN INPUT
13526 ELSEIF(ABS(IDWTUP).EQ.2) THEN
13528 LHXMAX(I) = LHXMAX(I)*1.0D3
13531 IF(ABS(IDWTUP).LE.2) THEN
13535 WRITE(6,15) LPRUP(I),LHXSCT(I),LHXERR(I),LHXMAX(I)*1.0D-3,
13537 AVWGT = AVWGT+LHXSCT(I)
13538 ERWGT = ERWGT+LHXERR(I)**2
13540 AVWGT = AVWGT*1.0D-3
13541 ERWGT = SQRT(ERWGT)*1.0D-3
13543 RNWGT=1./FLOAT(NWGTS)
13544 IF (NEGWTS) AVABW=ABWSUM*RNWGT
13546 SPWGT=SQRT(MAX(WSQSUM*RNWGT-AVWGT**2,ZERO))
13547 ERWGT=SPWGT*SQRT(RNWGT)
13548 IF (.NOT.NOWGT) WGTMAX=AVWGT
13549 IF (WGTMAX.EQ.ZERO) WGTMAX=ONE
13551 C--STANDARD HERWIG OPTION
13553 RNWGT=1./FLOAT(NWGTS)
13554 IF (NEGWTS) AVABW=ABWSUM*RNWGT
13556 SPWGT=SQRT(MAX(WSQSUM*RNWGT-AVWGT**2,ZERO))
13557 ERWGT=SPWGT*SQRT(RNWGT)
13558 IF (.NOT.NOWGT) WGTMAX=AVWGT
13559 IF (WGTMAX.EQ.ZERO) WGTMAX=ONE
13561 C--PRINT OUT THE INFO
13563 1 FORMAT(/10X,'OUTPUT ON ELEMENTARY PROCESS'/)
13565 WRITE (6,12) NEVHEP,NNEGEV,NWGTS,NNEGWT,AVWGT,SPWGT,
13566 & AVABW,WBIGST,WGTMAX,IPROC,
13567 & 1000.*AVWGT,1000.*ERWGT,100.*AVWGT/WGTMAX
13569 WRITE (6,11) NEVHEP,NWGTS,AVWGT,SPWGT,WBIGST,WGTMAX,
13571 & 1000.*AVWGT,1000.*ERWGT,100.*AVWGT/WGTMAX
13574 & 10X,'N.B. NEGATIVE WEIGHTS NOT ALLOWED'//
13575 & 10X,'NUMBER OF EVENTS = ',I11/
13576 & 10X,'NUMBER OF WEIGHTS = ',I11/
13577 & 10X,'MEAN VALUE OF WGT =',E12.4/
13578 & 10X,'RMS SPREAD IN WGT =',E12.4/
13579 & 10X,'ACTUAL MAX WEIGHT =',E12.4/
13580 & 10X,'ASSUMED MAX WEIGHT =',E12.4//
13581 & 10X,'PROCESS CODE IPROC = ',I11/
13582 & 10X,'CROSS SECTION (PB) =',G12.4/
13583 & 10X,'ERROR IN C-S (PB) =',G12.4/
13584 & 10X,'EFFICIENCY PERCENT =',G12.4)
13586 & 10X,'N.B. NEGATIVE WEIGHTS ALLOWED'//
13587 & 10X,'NUMBER OF EVENTS = ',I11/
13588 & 10X,'NEGATIVE EVENTS = ',I11/
13589 & 10X,'NUMBER OF WEIGHTS = ',I11/
13590 & 10X,'NEGATIVE WEIGHTS = ',I11/
13591 & 10X,'MEAN VALUE OF WGT =',E12.4/
13592 & 10X,'RMS SPREAD IN WGT =',E12.4/
13593 & 10X,'MEAN ABS WEIGHT =',E12.4/
13594 & 10X,'ACTUAL MAX ABS WGT =',E12.4/
13595 & 10X,'ASSUMED MAXABS WGT =',E12.4//
13596 & 10X,'PROCESS CODE IPROC = ',I11/
13597 & 10X,'CROSS SECTION (PB) =',G12.4/
13598 & 10X,'ERROR IN C-S (PB) =',G12.4/
13599 & 10X,'EFFICIENCY PERCENT =',G12.4)
13600 13 FORMAT(/1P,10X,'OUTPUT ON LES HOUCHES EVENTS'/)
13601 14 FORMAT(/1P,5X,' PROC CODE',1X,' XSECT(pb) ',1X,
13602 & ' XERR(pb) ',1X,' Max wgt(nb)',1X,'No. of events'/)
13603 15 FORMAT(5X,I7,E15.5,1X,E15.5,1X,E15.5,2X,I7)
13606 *CMZ :- -26/04/91 11.11.55 by Bryan Webber
13607 *-- Author : Bryan Webber & Luca Stanco
13608 C-----------------------------------------------------------------------
13609 SUBROUTINE HWEGAM(IHEP,ZMI,ZMA,WWA)
13610 C-----------------------------------------------------------------------
13611 C GENERATES A PHOTON IN WEIZSACKER-WILLIAMS (WWA=.TRUE.) OR
13612 C ELSE EQUIVALENT PHOTON APPROX FROM INCOMING E+, E-, MU+ OR MU-
13613 C-----------------------------------------------------------------------
13614 INCLUDE 'HERWIG65.INC'
13615 DOUBLE PRECISION HWRGEN,HWRUNI,EGMIN,ZMIN,ZMAX,ZGAM,SS,ZMI,ZMA,
13616 & PPL,PMI,QT2,Q2,QQMIN,QQMAX,S0,A
13617 INTEGER IHEP,IHADIS
13619 EXTERNAL HWRGEN,HWRUNI
13621 IF (IERROR.NE.0) RETURN
13622 IF (IHEP.LT.1.OR.IHEP.GT.2) CALL HWWARN('HWEGAM',500,*999)
13624 IF (IHEP.EQ.1) THEN
13628 IF (JDAHEP(1,IHADIS).NE.0) IHADIS=JDAHEP(1,IHADIS)
13630 C---DEFINE LIMITS FOR GAMMA MOMENTUM FRACTION
13631 IF (ZMI.LE.ZERO .OR. ZMA.GT.ONE) THEN
13633 IF (S0.GT.ZERO) THEN
13634 S0 = (SQRT(S0)+ABS(PHEP(5,IHADIS)))**2-PHEP(5,IHADIS)**2
13635 S0 = MAX(S0,WHMIN**2)
13636 ZMIN = S0 / (SS**2 - PHEP(5,IHEP)**2 - PHEP(5,IHADIS)**2)
13639 C---UNKNOWN PROCESS: USE ENERGY CUTOFF, AND WARN USER
13640 IF (FSTWGT) CALL HWWARN('HWEGAM',1,*999)
13641 ZMIN = EGMIN / PHEP(4,IHEP)
13648 C---APPLY USER DEFINED CUTS YWWMIN,YWWMAX AND INDIRECT LIMITS ON Z
13650 ZMIN=MAX(ZMIN,YWWMIN,SQRT(Q2WWMN)/ABS(PHEP(3,IHEP)))
13651 ZMAX=MIN(ZMAX,YWWMAX)
13653 ZMAX=MIN(ZMAX,1-PHEP(5,IHEP)/PHEP(4,IHEP))
13655 IF (ZMIN.GE.ZMAX) THEN
13659 C---GENERATE GAMMA MOMENTUM FRACTION
13661 10 IF (HWRGEN(2).LT.A) THEN
13662 ZGAM=(ZMIN/ZMAX)**HWRGEN(1)*ZMAX
13664 ZGAM=(ZMAX-ZMIN)*HWRGEN(1)+ZMIN
13666 GAMWT = GAMWT * .5*ALPHEM/PIFAC *
13667 + (1+(1-ZGAM)**2)/(A/LOG(ZMAX/ZMIN)+(1-A)/(ZMAX-ZMIN)*ZGAM)
13669 GAMWT = GAMWT * LOG((ONE-ZGAM)/ZGAM*(SS/PHEP(5,IHEP))**2)
13671 C---Q2WWMN AND Q2WWMX ARE USER-DEFINED LIMITS IN THE Q**2 INTEGRATION
13672 QQMAX=MIN(Q2WWMX,(ZGAM*PHEP(3,IHEP))**2)
13673 QQMIN=MAX(Q2WWMN,(PHEP(5,IHEP)*ZGAM)**2/(1.-ZGAM))
13674 IF (QQMIN.GT.QQMAX) CALL HWWARN('HWEGAM',50,*10)
13675 Q2=EXP(HWRUNI(0,LOG(QQMIN),LOG(QQMAX)))
13676 GAMWT = GAMWT * LOG(QQMAX/QQMIN)
13678 IF (GAMWT.LT.ZERO) GAMWT=ZERO
13684 JMOHEP(1,NHEP)=IHEP
13688 JDAHEP(1,IHEP)=NHEP
13690 C---FOR COLLINEAR KINEMATICS, ZGAM IS THE ENERGY FRACTION
13691 PHEP(4,NHEP)=PHEP(4,IHEP)*ZGAM
13692 PHEP(3,NHEP)=PHEP(3,IHEP)-SIGN(SQRT(
13693 & (PHEP(4,IHEP)-PHEP(4,NHEP))**2-PHEP(5,IHEP)**2),PHEP(3,IHEP))
13696 CALL HWUMAS(PHEP(1,NHEP))
13698 C---FOR EXACT KINEMATICS, ZGAM IS TAKEN TO BE FRACTION OF (E+PZ)
13699 PPL=ZGAM*(ABS(PHEP(3,IHEP))+PHEP(4,IHEP))
13700 QT2=(ONE-ZGAM)*Q2-(ZGAM*PHEP(5,IHEP))**2
13702 PHEP(5,NHEP)=-SQRT(Q2)
13703 PHEP(4,NHEP)=(PPL+PMI)/TWO
13704 PHEP(3,NHEP)=SIGN((PPL-PMI)/TWO,PHEP(3,IHEP))
13705 CALL HWRAZM(SQRT(QT2),PHEP(1,NHEP),PHEP(2,NHEP))
13707 C---UPDATE OVERALL CM FRAME
13708 JMOHEP(IHEP,3)=NHEP
13709 CALL HWVDIF(4,PHEP(1,3),PHEP(1,IHEP),PHEP(1,3))
13710 CALL HWVSUM(4,PHEP(1,NHEP),PHEP(1,3),PHEP(1,3))
13711 CALL HWUMAS(PHEP(1,3))
13712 C---FILL OUTGOING LEPTON
13714 IDHW(NHEP)=IDHW(IHEP)
13716 IDHEP(NHEP)=IDHEP(IHEP)
13717 JMOHEP(1,NHEP)=IHEP
13721 JDAHEP(2,IHEP)=NHEP
13722 CALL HWVDIF(4,PHEP(1,IHEP),PHEP(1,NHEP-1),PHEP(1,NHEP))
13723 PHEP(5,NHEP)=PHEP(5,IHEP)
13726 *CMZ :- -18/04/04 10.45.55 by Mike Seymour
13727 *-- Author : Bryan Webber & Luca Stanco
13728 C-----------------------------------------------------------------------
13729 SUBROUTINE HWEGAS(S0)
13730 C-----------------------------------------------------------------------
13731 C FIND MINIMUM INVARIANT MASS SQUARED NEEDED FOR HARD PROCESS, S0
13732 C-----------------------------------------------------------------------
13733 INCLUDE 'HERWIG65.INC'
13734 DOUBLE PRECISION S0,RPM(2)
13736 IF (IPRO.EQ.13.OR.IPRO.EQ.14) THEN
13738 ELSEIF(IPRO.EQ.15.OR.IPRO.EQ.18.OR.IPRO.EQ.22.OR.IPRO.EQ.24.OR.
13739 & IPRO.EQ.50.OR.IPRO.EQ.53.OR.IPRO.EQ.55)THEN
13741 ELSEIF (IPRO.EQ.17.OR.IPRO.EQ.51) THEN
13742 HQ = MOD(IPROC,100)
13743 S0 = 4.D0*(PTMIN**2+RMASS(HQ)**2)
13744 ELSEIF (IPRO.EQ.16.OR.IPRO.EQ.19.OR.
13745 & IPRO.EQ.25.OR.IPRO.EQ.26.OR.IPRO.EQ.27.OR.
13747 S0 = MAX(2*RMASS(1),RMASS(201)-GAMMAX*GAMH)**2
13748 ELSEIF ((IPRO.EQ.31).OR.(IPRO.EQ.32)) THEN
13749 S0 = MAX(2*RMASS(1),RMASS(201+IHIGGS))**2
13750 ELSEIF (IPRO.EQ.33) THEN
13751 IF((MOD(IPROC,10000).EQ.3350).OR.
13752 & (MOD(IPROC,10000).EQ.3355))THEN
13753 S0 = MAX(2*RMASS(1),RMASS(206))**2
13754 ELSEIF(MOD(IPROC,10000).EQ.3315)THEN
13755 S0 = MAX(2*RMASS(1),RMASS(206),RMASS(203))**2
13756 ELSEIF(MOD(IPROC,10000).EQ.3325)THEN
13757 S0 = MAX(2*RMASS(1),RMASS(206),RMASS(204))**2
13758 ELSEIF(MOD(IPROC,10000).EQ.3335)THEN
13759 S0 = MAX(2*RMASS(1),RMASS(206),RMASS(205))**2
13760 ELSEIF(MOD(IPROC,10000).EQ.3365)THEN
13761 S0 = MAX(2*RMASS(1),RMASS(205),RMASS(203))**2
13762 ELSEIF(MOD(IPROC,10000).EQ.3375)THEN
13763 S0 = MAX(2*RMASS(1),RMASS(205),RMASS(204))**2
13765 S0 = MAX(2*RMASS(1),RMASS(201+IHIGGS))**2
13767 ELSEIF ((IPRO.EQ.34).OR.(IPRO.EQ.35)) THEN
13768 S0 = MAX(RMASS(5),RMASS(201+IHIGGS))**2
13769 ELSEIF (IPRO.EQ.36.OR.IPRO.EQ.37) THEN
13770 S0 = MAX(2*RMASS(1),RMASS(201+IHIGGS))**2
13771 ELSEIF (IPRO.EQ.38) THEN
13772 IF((MOD(IPROC,10000).EQ.3839).OR.
13773 & (MOD(IPROC,10000).EQ.3869).OR.
13774 & (MOD(IPROC,10000).EQ.3899))THEN
13775 S0 = MAX(RMASS(6),RMASS(206))**2
13777 S0 = RMASS(201+IHIGGS)**2
13779 ELSEIF (IPRO.EQ.23) THEN
13780 S0 = MAX(2*RMASS(1),RMASS(201)-GAMMAX*GAMH)**2
13781 S0 = (PTMIN+SQRT(PTMIN**2+S0))**2
13782 ELSEIF (IPRO.EQ.20) THEN
13784 ELSEIF (IPRO.EQ.21) THEN
13785 S0 = (PTMIN+SQRT(PTMIN**2+RMASS(198)**2))**2
13787 ELSEIF (IPRO.EQ.30) THEN
13788 S0 = 4.0D0*(PTMIN**2+RMMNSS**2)
13789 ELSEIF(IPRO.EQ.40.OR.IPRO.EQ.41) THEN
13790 HQ = MOD(IPROC,100)
13793 IF(HQ.GE.10.AND.HQ.LT.20) THEN
13794 RPM(1) = ABS(RMASS(450))
13795 IF(HQ.GT.10) RPM(1) = ABS(RMASS(449+MOD(HQ,10)))
13796 ELSEIF(HQ.GE.20.AND.HQ.LT.30) THEN
13797 RPM(1) = ABS(RMASS(454))
13798 IF(HQ.GT.20) RPM(1) = ABS(RMASS(453+MOD(HQ,20)))
13799 ELSEIF(HQ.EQ.30) THEN
13800 RPM(1) = RMASS(449)
13801 ELSEIF(HQ.EQ.40) THEN
13802 IF(IPRO.EQ.40) THEN
13803 RPM(1) = RMASS(425)
13805 RPM(1) = MIN(RPM(1),RMASS(425+I))
13808 RPM(1) = MIN(RMASS(405),RMASS(406))
13810 RPM(2) = RMASS(198)
13811 ELSEIF(HQ.EQ.50) THEN
13812 IF(IPRO.EQ.40) THEN
13813 RPM(1) = RMASS(425)
13815 RPM(1) = MIN(RPM(1),RMASS(425+I))
13818 RPM(2) = MIN(RPM(1),RMASS(433+2*I))
13820 RPM(1) = MIN(RPM(1),RPM(2))
13821 RPM(2) = RMASS(203)
13823 RPM(2) = MIN(RPM(2),RMASS(204+I))
13826 RPM(1) = RMASS(401)
13827 RPM(2) = RMASS(413)
13829 RPM(1) = MIN(RPM(1),RMASS(401+I))
13830 RPM(2) = MIN(RPM(2),RMASS(413+I))
13832 RPM(1) = MIN(RPM(1),RPM(2))
13833 RPM(2) = RMASS(203)
13835 RPM(2) = MIN(RPM(2),RMASS(204+I))
13838 RPM(2) = RMASS(203)
13840 RPM(2) = MIN(RPM(2),RMASS(204+I))
13842 ELSEIF(HQ.GE.60) THEN
13847 S0 = RPM(1)+RPM(2)+TWO*(PTMIN**2+
13848 & SQRT(RPM(1)*RPM(2)+PTMIN**2*(RPM(1)+RPM(2)+PTMIN**2)))
13851 ELSEIF (IPRO.EQ.42) THEN
13853 ELSEIF (IPRO.EQ.52) THEN
13854 HQ = MOD(IPROC,100)
13855 S0 = (PTMIN+SQRT(PTMIN**2+RMASS(HQ)**2))**2
13856 ELSEIF (IPRO.EQ.60) THEN
13857 HQ = MOD(IPROC,100)
13861 IF (HQ.GT.6) HQ=2*HQ+107
13862 IF (HQ.EQ.127) HQ=198
13863 S0 = 4.D0*(PTMIN**2+RMASS(HQ)**2)
13865 ELSEIF (IPRO.EQ.80) THEN
13867 ELSEIF (IPRO.EQ.90) THEN
13869 ELSEIF (IPRO.EQ.91.OR.IPRO.EQ.92) THEN
13870 S0 = Q2MIN+4.D0*PTMIN**2
13871 HQ = MOD(IPROC,100)
13872 IF (HQ.GT.0) S0 = S0+4.D0*RMASS(HQ)**2
13873 IF (IPRO.EQ.91) S0 = MAX(S0,EMMIN**2)
13879 *CMZ :- -26/04/91 12.42.30 by Federico Carminati
13880 *-- Author : Bryan Webber
13881 C-----------------------------------------------------------------------
13883 C-----------------------------------------------------------------------
13884 C INITIALISES ELEMENTARY PROCESS
13885 C Modified 28/03/01 by BRW to handle negative weights
13886 C-----------------------------------------------------------------------
13887 INCLUDE 'HERWIG65.INC'
13888 DOUBLE PRECISION HWRSET,DUMMY,SAFETY
13890 PARAMETER (SAFETY=1.001)
13892 C---NO OF WEIGHT GENERATED
13895 C---ACCUMULATED WEIGHTS
13898 C---ACCUMULATED WEIGHT-SQUARED
13900 C---CURRENT MAX WEIGHT
13902 C---LAST VALUE OF SCALE
13904 C---NUMBER OF ERRORS REPORTED
13906 C---NUMBER OF ERRORS UNREPORTED
13908 C---FIND MAXIMUM ABSOLUTE WEIGHT IN CASES WHERE THIS IS REQUIRED
13910 IF (WGTMAX.EQ.ZERO.AND.IPROC.GT.0) THEN
13912 DUMMY = HWRSET(IBRN)
13913 WRITE(6,10) IPROC,IBRN,NBSH
13914 10 FORMAT(/10X,'INITIAL SEARCH FOR MAX WEIGHT'//
13915 & 10X,'PROCESS CODE IPROC = ',I11/
13916 & 10X,'RANDOM NO. SEED 1 = ',I11/
13917 & 10X,' SEED 2 = ',I11/
13918 & 10X,'NUMBER OF SHOTS = ',I11)
13924 20 FORMAT(/10X,'INITIAL SEARCH FINISHED')
13925 IF (WBIGST*NWGTS.LT.SAFETY*WGTSUM)
13926 & WGTMAX=SAFETY*WBIGST
13935 WRITE(6,21) AVWGT,WGTMAX
13936 21 FORMAT(/1P,10X,'INPUT EVT WEIGHT =',E12.4/
13937 & 10X,'INPUT MAX WEIGHT =',E12.4)
13940 C---RESET RANDOM NUMBER
13941 DUMMY = HWRSET(NRN)
13945 *CMZ :- -01/04/99 19.55.17 by Mike Seymour
13946 *-- Author : Mike Seymour
13947 C-----------------------------------------------------------------------
13948 SUBROUTINE HWEISR(IHEP)
13949 C-----------------------------------------------------------------------
13950 C GENERATES AN ISR PHOTON FROM INCOMING E+, E-, MU+ OR MU-
13951 C-----------------------------------------------------------------------
13952 INCLUDE 'HERWIG65.INC'
13953 DOUBLE PRECISION CIRCKP(2)
13954 COMMON /HWCIR2/CIRCKP
13955 DOUBLE PRECISION HWRGEN,QSQMAX,QSQMIN,A,B,B1,B2,B3,B4,B5,B6,B7,B8,
13956 $ R,AA,T0,T1,C1,C2,T,Z(2),QSQ(2),PHI(2),C,NWID,NMASS
13960 C---IF ZMXISR IS ZERO, THERE CAN BE NO ISR
13961 IF (ZMXISR.EQ.ZERO.OR.(IPRO.GT.3.AND.IPRO.LT.6)
13962 & .OR.IPRO.GT.12.OR.IPROC.EQ.850) RETURN
13963 C---CHECK CONSISTENCY OF TMNISR AND ZMXISR
13964 IF (ZMXISR**2.LT.TMNISR) CALL HWWARN('HWEISR',200,*999)
13965 C---CALCULATE VIRTUALITY LIMITS
13966 QSQMAX=4*PHEP(4,IHEP)**2
13967 QSQMIN=PHEP(5,IHEP)**2
13968 C---AND THEREFORE THE Z DEPENDENCE
13970 B=A*(LOG(QSQMAX/QSQMIN)-1)
13971 C---DECIDE HOW MUCH WEIGHT TO GIVE THE Z RESONANCE
13972 IF (IHEP.EQ.1) THEN
13973 IF (IPRO.EQ.1.OR.IPRO.EQ.6.OR.IPRO.EQ.8) THEN
13975 ELSEIF (IPRO.EQ.2) THEN
13977 ELSEIF (IPRO.EQ.3.OR.IPRO.EQ.7.OR.IPRO.EQ.10.OR.IPRO.EQ.11) THEN
13979 ELSEIF (IPRO.EQ.9) THEN
13981 IF((MOD(IPROC,10000).EQ.960).OR.
13982 & (MOD(IPROC,10000).EQ.970))THEN
13990 C--set up the parameters for the resonance
13992 C--first the standard parameters if smoothing the Z resonance
13993 T0=RMASS(200)**2/QSQMAX
13994 T1=GAMZ*RMASS(200)/QSQMAX
13996 C--now the parameters for a resonant sneutrino in RPV
13997 C--uses the average of the muon and tau sneutrino mass and either the
13998 C--larger width or the difference in masses (whichever is larger)
13999 NMASS = HALF*(RMASS(428)+RMASS(430))
14000 NWID = MAX(HBAR/RLTIM(428),HBAR/RLTIM(430))
14001 NWID = MAX(NWID,ABS(RMASS(428)-RMASS(430)))
14002 T0 = NMASS**2/QSQMAX
14003 T1 = NWID*NMASS/QSQMAX
14005 IF (T0.GT.ONE) THEN
14010 C---GENERATE A T VALUE BETWEEN TMNISR AND 1 ACCORDING TO:
14011 C ( b**2*log(zmxisr**2/t)/t + 2*b*(1-(1-zmxisr)**b)*((1-t)**(2*b-1)+1/t
14012 C +(1-t0)**(2b-1)*aa*t1/((t-t0)**2+t1**2)) ) *theta(zmxisr**2-t)
14013 C +( 2*b*(1-zmxisr)**b*((1-t)**(b-1)+1/t
14014 C +(1-t0)**(b-1)*aa*t1/((t-t0)**2+t1**2)) ) *theta(zmxisr-t)
14015 C +( (1-zmxisr)**(2*b) ) *delta(1-t)
14016 B1=(1-ZMXISR)**(2*B)
14017 B2=B1+2*(1-ZMXISR)**B*((1-TMNISR)**B-(1-ZMXISR)**B)
14018 B3=B2+2*B*(1-ZMXISR)**B*LOG(ZMXISR/TMNISR)
14019 B4=B3+2*B*(1-ZMXISR)**B*AA*(1-T0)**(B-1)
14020 $ *(ATAN((ZMXISR-T0)/T1)-ATAN((TMNISR-T0)/T1))
14021 B5=B4+(1-(1-ZMXISR)**B)*((1-TMNISR)**(2*B)-(1-ZMXISR**2)**(2*B))
14022 B6=B5+2*B*(1-(1-ZMXISR)**B)*LOG(ZMXISR**2/TMNISR)
14023 B7=B6+B**2*LOG(ZMXISR**2/TMNISR)**2/2
14024 B8=B7+2*B*(1-(1-ZMXISR)**B)*AA*(1-T0)**(2*B-1)
14025 $ *(ATAN((ZMXISR**2-T0)/T1)-ATAN((TMNISR-T0)/T1))
14032 ELSEIF (R.LE.B4) THEN
14036 T=1-(1-TMNISR)*(1-R*(1-((1-ZMXISR)/(1-TMNISR))**B))**(1/B)
14037 ELSEIF (R.LE.B3) THEN
14039 T=(TMNISR/ZMXISR)**R*ZMXISR
14043 $ ATAN((ZMXISR-T0)/T1)*R+ATAN((TMNISR-T0)/T1)*(1-R))
14045 GAMWT=GAMWT*B8/(2*B*(1-ZMXISR)**B*((1-T)**(B-1)+1/T+
14046 $ (1-T0)**(B-1)*AA*T1/((T-T0)**2+T1**2)))
14048 IF (HWRGEN(1).GT.HALF) Z(1)=T
14055 $ (1-R*(1-((1-ZMXISR**2)/(1-TMNISR))**(2*B)))**(.5/B)
14056 ELSEIF (R.LE.B6) THEN
14058 T=(TMNISR/ZMXISR**2)**R*ZMXISR**2
14059 ELSEIF (R.LE.B7) THEN
14061 T=(TMNISR/ZMXISR**2)**SQRT(R)*ZMXISR**2
14065 $ ATAN((ZMXISR**2-T0)/T1)*R+ATAN((TMNISR-T0)/T1)*(1-R))
14067 GAMWT=GAMWT*B8/(B**2*LOG(ZMXISR**2/T)/T
14068 $ + 2*B*(1-(1-ZMXISR)**B)*((1-T)**(2*B-1)+1/T+
14069 $ (1-T0)**(B-1)*AA*T1/((T-T0)**2+T1**2)))
14070 C---GENERATE A Z VALUE BETWEEN T/ZMXISR AND ZMXISR ACCORDING TO:
14071 C 1/z+(1-z)**(b-1)+t/z**2*(1-t/z)**(b-1)
14072 C1=LOG(ZMXISR**2/T)
14073 C2=C1+2/B*((1-T/ZMXISR)**B-(1-ZMXISR)**B)
14074 IF (C2.GT.ZERO) THEN
14077 Z(1)=(T/ZMXISR**2)**HWRGEN(5)*ZMXISR
14079 Z(1)=1-(1-T/ZMXISR)*
14080 $ (1-HWRGEN(6)*(1-((1-ZMXISR)/(1-T/ZMXISR))**B))**(1/B)
14081 IF (2*R.LE.C2+C1) Z(1)=T/Z(1)
14086 GAMWT=GAMWT*C2/Z(1)
14087 $ /(1/Z(1)+(1-Z(1))**(B-1)+T/Z(1)**2*(1-T/Z(1))**(B-1))
14089 C---INCLUDE DISTRIBUTION FUNCTIONS
14092 IF (Z(I).GT.ZMXISR) THEN
14094 CIRCKP(I)=(1-ZMXISR)**B*EXP(3*B/4)*(1-B**2*PIFAC**2/12)
14096 CIRCKP(I)=(B*(1-Z(I))**(B-1)*(1+Z(I)**2)/2
14097 $ *EXP(B*Z(I)/2*(1+Z(I)/2))*(1-B**2*PIFAC**2/12)
14098 $ +B**2/8*((1+Z(I))*((1+Z(I))**2+3*LOG(Z(I)))
14099 $ -4*LOG(Z(I))/(1-Z(I))))
14101 GAMWT=GAMWT*CIRCKP(I)
14103 C---CHOOSE BOTH QSQ VALUES
14105 IF (Z(I).GT.ZMXISR .OR. COLISR) THEN
14109 C---ACCORDING TO 1/(QSQ+QSQMIN) FROM 0 TO (1-Z)*(T/(Z+T))*QSQMAX
14110 20 QSQ(I)=(((1-Z(I))*(T/(Z(I)+T))
14111 $ *QSQMAX/QSQMIN+1)**HWRGEN(7)-1)*QSQMIN
14112 C---AND REJECT TO QSQ/(QSQ+QSQMIN)**2
14113 IF (HWRGEN(8)*(QSQ(I)+QSQMIN).GT.QSQ(I)) GOTO 20
14116 C---CHOOSE BOTH AZIMUTHS
14117 PHI(1)=HWRGEN(9)*2*PIFAC
14118 PHI(2)=HWRGEN(10)*2*PIFAC
14119 C---USE S-HAT PRESCRIPTION TO MODIFY Z VALUES
14121 IF ((1-Z(1))*QSQ(1).GT.(1-Z(2))*QSQ(2)) I=1
14122 IF ((1-Z(2))*QSQ(2).GT.(1-Z(1))*QSQ(1)) I=2
14125 Z(I)=Z(I)+QSQ(I)/QSQMAX
14126 IF (QSQ(J).GT.ZERO) THEN
14127 Z(J)=((QSQ(I)*QSQMAX+QSQ(J)*QSQMAX
14128 $ -QSQ(I)*QSQ(J))/QSQMAX**2+T)/Z(I)
14129 C=COS(PHI(1)-PHI(2))*SQRT(QSQ(1)*QSQ(2))/QSQMAX
14130 Z(J)=Z(J)+(-2*C**2*(1-Z(I))+2*C*SQRT((1-Z(I))
14131 $ *(C**2*(1-Z(I))+Z(I)**2*(1-Z(J)))))/Z(I)**2
14134 ELSEIF (IHEP.EQ.2) THEN
14135 C---EVERYTHING WAS GENERATED LAST TIME
14137 C---ROUTINE CALLED UNEXPECTEDLY
14138 CALL HWWARN('HWEISR',201,*999)
14140 C---IF Z IS TOO LARGE THERE IS NO EMISSION
14141 IF (Z(IHEP).GT.ZMXISR) RETURN
14142 C---PUT NEW LEPTON IN EVENT RECORD
14144 IDHW(NHEP)=IDHW(IHEP)
14145 IDHEP(NHEP)=IDHEP(IHEP)
14147 JMOHEP(1,NHEP)=IHEP
14151 JDAHEP(1,IHEP)=NHEP
14152 C---AND OUTGOING PHOTON
14157 JMOHEP(1,NHEP)=IHEP
14161 JDAHEP(2,IHEP)=NHEP
14162 C---RECONSTRUCT PHOTON KINEMATICS (Z IS LIGHT-CONE MOMENTUM FRACTION)
14163 PHEP(1,NHEP)=SQRT(QSQ(IHEP)*(1-Z(IHEP)))*COS(PHI(IHEP))
14164 PHEP(2,NHEP)=SQRT(QSQ(IHEP)*(1-Z(IHEP)))*SIN(PHI(IHEP))
14165 PHEP(3,NHEP)=(1-Z(IHEP))*PHEP(4,IHEP)-QSQ(IHEP)/(4*PHEP(4,IHEP))
14166 IF (IHEP.EQ.2) PHEP(3,NHEP)=-PHEP(3,NHEP)
14167 PHEP(4,NHEP)=(1-Z(IHEP))*PHEP(4,IHEP)+QSQ(IHEP)/(4*PHEP(4,IHEP))
14170 CALL HWVDIF(4,PHEP(1,IHEP),PHEP(1,NHEP),PHEP(1,NHEP-1))
14171 CALL HWUMAS(PHEP(1,NHEP-1))
14172 C---UPDATE OVERALL CM FRAME
14173 JMOHEP(IHEP,3)=NHEP-1
14174 CALL HWVDIF(4,PHEP(1,3),PHEP(1,IHEP),PHEP(1,3))
14175 CALL HWVSUM(4,PHEP(1,NHEP-1),PHEP(1,3),PHEP(1,3))
14176 CALL HWUMAS(PHEP(1,3))
14179 *CMZ :- -26/04/91 11.11.55 by Bryan Webber
14180 *-- Author : Bryan Webber
14181 C-----------------------------------------------------------------------
14183 C-----------------------------------------------------------------------
14184 C SETS UP 2->1 (COLOUR SINGLET) HARD SUBPROCESS
14185 C-----------------------------------------------------------------------
14186 INCLUDE 'HERWIG65.INC'
14187 DOUBLE PRECISION PA
14188 INTEGER ICMF,I,IBM,IHEP
14193 C---FIND BEAM AND TARGET
14194 IF (JDAHEP(1,I).NE.0) IBM=JDAHEP(1,I)
14197 IDHEP(IHEP)=IDPDG(IDN(I))
14199 JMOHEP(1,IHEP)=ICMF
14200 JMOHEP(I,ICMF)=IHEP
14201 JDAHEP(1,IHEP)=ICMF
14202 C---SPECIAL - IF INCOMING PARTON IS INCOMING BEAM THEN COPY IT
14203 IF (XX(I).EQ.ONE.AND.IDHW(IBM).EQ.IDN(I)) THEN
14204 CALL HWVEQU(5,PHEP(1,IBM),PHEP(1,IHEP))
14205 IF (I.EQ.2) PHEP(3,IHEP)=-PHEP(3,IHEP)
14209 PHEP(5,IHEP)=RMASS(IDN(I))
14210 PA=XX(I)*(PHEP(4,IBM)+ABS(PHEP(3,IBM)))
14211 PHEP(4,IHEP)=0.5*(PA+PHEP(5,IHEP)**2/PA)
14212 PHEP(3,IHEP)=PA-PHEP(4,IHEP)
14215 PHEP(3,NHEP+2)=-PHEP(3,NHEP+2)
14216 C---HARD CENTRE OF MASS
14218 IDHEP(ICMF)=IDPDG(IDCMF)
14220 CALL HWVSUM(4,PHEP(1,NHEP+1),PHEP(1,NHEP+2),PHEP(1,ICMF))
14221 CALL HWUMAS(PHEP(1,ICMF))
14222 C---SET UP COLOUR STRUCTURE LABELS
14223 JMOHEP(2,NHEP+1)=NHEP+2
14224 JDAHEP(2,NHEP+1)=NHEP+2
14225 JMOHEP(2,NHEP+2)=NHEP+1
14226 JDAHEP(2,NHEP+2)=NHEP+1
14227 JDAHEP(1,NHEP+3)=NHEP+3
14228 JDAHEP(2,NHEP+3)=NHEP+3
14232 *CMZ :- -15/07/02 17.56.53 by Peter Richardson
14233 *-- Author : Bryan Webber
14234 C-----------------------------------------------------------------------
14236 C-----------------------------------------------------------------------
14237 C WHEN NEVHEP=0, CHOOSES X VALUES AND FINDS WEIGHT FOR PROCESS IPROC
14238 C OTHERWISE, CHOOSES AND LOADS ALL VARIABLES FOR HARD PROCESS
14239 C modifications for Les Houches accord by PR (7/15/02)
14240 C-----------------------------------------------------------------------
14241 INCLUDE 'HERWIG65.INC'
14242 DOUBLE PRECISION CIRCKP(2)
14243 COMMON /HWCIR2/CIRCKP
14244 DOUBLE PRECISION Z1,Z2,C1,C2,B1,B2,CIRCEE,CIRCGG,RS,MISS,ETA,
14245 $ HWUGAU,HWECIR,QMX1,QMN1,QMX2,QMN2,TEST
14248 DOUBLE PRECISION HWRGEN
14249 EXTERNAL HWRGEN,HWECIR
14250 C--Les Houches Common Block
14252 PARAMETER(MAXPUP=100)
14253 INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP
14254 DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP
14255 COMMON /HEPRUP/ IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2),
14256 & IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),
14257 & XMAXUP(MAXPUP),LPRUP(MAXPUP)
14258 IF (IERROR.NE.0) RETURN
14259 C--pick the type of event to generate if using Les Houches accord
14260 C--first choice according to maxiumum weight
14261 IF(IPROC.LT.0) THEN
14262 IF(ABS(IDWTUP).EQ.1) THEN
14263 IF(ITYPLH.EQ.0) THEN
14264 TEST = HWRGEN(1)*LHMXSM
14266 IF(TEST.LE.ABS(LHXMAX(ITYPLH))) GOTO 5
14267 TEST = TEST-ABS(LHXMAX(ITYPLH))
14269 5 WGTMAX = ABS(LHXMAX(ITYPLH))
14270 WBIGST = ABS(LHXMAX(ITYPLH))
14272 C--second choice according to cross section
14273 ELSEIF(ABS(IDWTUP).EQ.2) THEN
14274 IF(ITYPLH.EQ.0) THEN
14275 TEST = HWRGEN(1)*LHMXSM
14277 IF(TEST.LE.ABS(LHXSCT(ITYPLH))) GOTO 6
14278 TEST = TEST-ABS(LHXSCT(ITYPLH))
14280 6 WGTMAX = ABS(LHXMAX(ITYPLH))
14281 WBIGST = ABS(LHXMAX(ITYPLH))
14289 C---ROUTINE LOOPS BACK TO HERE IF GENERATED WEIGHT WAS NOT ACCEPTED
14291 C---FSTWGT IS .TRUE. DURING FIRST CALL TO HARD PROCESS ROUTINE
14293 C---FSTEVT IS .TRUE. THROUGHOUT THE FIRST EVENT
14295 C---SET COLOUR CORRECTION TO FALSE
14299 C---SET UP INITIAL STATE
14304 PHEP(3,NHEP)=PBEAM1
14305 PHEP(4,NHEP)=EBEAM1
14306 PHEP(5,NHEP)=RMASS(IPART1)
14312 IDHEP(NHEP)=IDPDG(IPART1)
14317 PHEP(3,NHEP)=-PBEAM2
14318 PHEP(4,NHEP)=EBEAM2
14319 PHEP(5,NHEP)=RMASS(IPART2)
14325 IDHEP(NHEP)=IDPDG(IPART2)
14326 C---NEXT ENTRY IS OVERALL CM FRAME
14331 JMOHEP(1,NHEP)=NHEP-2
14332 JMOHEP(2,NHEP)=NHEP-1
14335 CALL HWVSUM(4,PHEP(1,NHEP-1),PHEP(1,NHEP-2),PHEP(1,NHEP))
14336 CALL HWUMAS(PHEP(1,NHEP))
14337 C Select a primary interaction point
14341 CALL HWVZRO(4,VTXPIP)
14343 CALL HWVEQU(3,VTXPIP,VHEP(1,NHEP))
14345 C---GENERATE PHOTONS (WEIZSACKER-WILLIAMS APPROX)
14346 C FOR HADRONIC PROCESSES WITH LEPTON BEAMS
14348 IF (IPRO.GT.12.AND.IPRO.LT.90) THEN
14349 IF (CIRCOP.EQ.0) THEN
14350 IF (ABS(IDHEP(1)).EQ.11.OR.ABS(IDHEP(1)).EQ.13)
14351 & CALL HWEGAM(1,ZERO, ONE,.FALSE.)
14352 IF (ABS(IDHEP(2)).EQ.11.OR.ABS(IDHEP(2)).EQ.13)
14353 & CALL HWEGAM(2,ZERO, ONE,.FALSE.)
14355 C---MODIFIED TO USE CIRCE FOR BEAMSTRAHLUNG EFFECTS
14356 IF (ABS(IDHEP(1)).NE.11.OR.IDHEP(1)+IDHEP(2).NE.0) STOP
14357 $ 'This version only works for e+e- annihilation'
14359 RS=NINT(PHEP(5,3)*10)/1D1
14360 CALL CIRCES(ZERO,ZERO,RS,CIRCAC,CIRCVR,CIRCRV,CIRCCH)
14362 CALL HWEGAM(1,ZERO, ONE,.TRUE.)
14363 CALL HWEGAM(2,ZERO, ONE,.TRUE.)
14364 Z1=PHEP(4,4)/PHEP(4,1)
14365 Z2=PHEP(4,6)/PHEP(4,2)
14366 C---FACTORIZE THE DISTRIBUTIONS FROM CIRCE
14367 C1=CIRCGG(Z1,-1D0)/SQRT(CIRCGG(-1D0,-1D0))
14368 C2=CIRCGG(-1D0,Z2)/SQRT(CIRCGG(-1D0,-1D0))
14369 C---REMOVE SPURIOUS WEIGHT GIVEN IN HWEGAM
14370 GAMWT=GAMWT/(.5*ALPHEM/PIFAC*(1+(1-Z1)**2)/Z1*
14371 $ LOG((ONE-Z1)/Z1*4*PHEP(4,1)*PHEP(4,2)/PHEP(5,1)**2))
14372 $ /(.5*ALPHEM/PIFAC*(1+(1-Z2)**2)/Z2*
14373 $ LOG((ONE-Z2)/Z2*4*PHEP(4,4)*PHEP(4,2)/PHEP(5,1)**2))
14374 C---REPLACE IT BY THE SUM OF BEAM AND BREM STRAHLUNG
14375 QMX1=MIN(Q2WWMX,(Z1*PHEP(3,1))**2)
14376 QMN1=MAX(Q2WWMN,(PHEP(5,1)*Z1)**2/(1-Z1))
14377 QMX2=MIN(Q2WWMX,(Z2*PHEP(3,2))**2)
14378 QMN2=MAX(Q2WWMN,(PHEP(5,2)*Z2)**2/(1-Z2))
14379 B1=.5*ALPHEM/PIFAC*(1+(1-Z1)**2)/Z1*LOG(QMX1/QMN1)
14380 B2=.5*ALPHEM/PIFAC*(1+(1-Z2)**2)/Z2*LOG(QMX2/QMN2)
14381 IF (CIRCOP.EQ.1) THEN
14383 ELSEIF (CIRCOP.EQ.2) THEN
14385 ELSEIF (CIRCOP.EQ.3) THEN
14386 GAMWT=GAMWT*(C1+B1)*(C2+B2)
14388 STOP 'Illegal value of circop!'
14391 ELSEIF (IPRO.GE.90) THEN
14392 IF (CIRCOP.NE.0) STOP 'Circe not interfaced for DIS processes'
14393 IF (ABS(IDHEP(2)).EQ.11.OR.ABS(IDHEP(2)).EQ.13)
14394 & CALL HWEGAM(2,ZERO, ONE,.FALSE.)
14396 C---GENERATE ISR PHOTONS FOR LEPTONIC PROCESSES
14397 IF (IPRO.GT.0.AND.IPRO.LE.12) THEN
14398 IF (CIRCOP.EQ.0) THEN
14402 C---MODIFIED TO USE CIRCE FOR BEAMSTRAHLUNG EFFECTS
14403 IF (ABS(IDHEP(1)).NE.11.OR.IDHEP(1)+IDHEP(2).NE.0) STOP
14404 $ 'This version only works for e+e- annihilation'
14406 RS=NINT(PHEP(5,3)*10)/1D1
14407 CALL CIRCES(ZERO,ZERO,RS,CIRCAC,CIRCVR,CIRCRV,CIRCCH)
14408 C---PRECALCULATE THE PART OF THE SPECTRUM MISSED BETWEEN ZMXISR AND 1
14410 MISS=HWUGAU(HWECIR,1D-15**(1-ETA),(1-ZMXISR)**(1-ETA),1D-12)
14416 IF (JDAHEP(1,IHAD).NE.0) IHAD=JDAHEP(1,IHAD)
14417 Z1=PHEP(4,IHAD)/PHEP(4,1)
14419 IF (JDAHEP(1,IHAD).NE.0) IHAD=JDAHEP(1,IHAD)
14420 Z2=PHEP(4,IHAD)/PHEP(4,2)
14421 C---FACTORIZE THE DISTRIBUTIONS FROM CIRCE
14422 C1=CIRCEE(Z1,-1D0)/SQRT(CIRCEE(-1D0,-1D0))
14423 C2=CIRCEE(-1D0,Z2)/SQRT(CIRCEE(-1D0,-1D0))
14424 IF (Z1.EQ.ONE) C1=C1+MISS
14425 IF (Z2.EQ.ONE) C2=C2+MISS
14426 C---REMOVE WEIGHT GIVEN IN HWEISR
14429 GAMWT=GAMWT/(B1*B2)
14430 C---REPLACE IT BY THE SUM OF BEAM AND BREM STRAHLUNG
14431 IF (CIRCOP.EQ.1) THEN
14433 ELSEIF (CIRCOP.EQ.2) THEN
14435 ELSEIF (CIRCOP.EQ.3) THEN
14436 C---IN THE APPROXIMATION OF DOMINANCE BY THE DELTA-FUNCTION TERM
14437 IF (Z1.EQ.ONE) C1=C1-1
14438 IF (Z2.EQ.ONE) C2=C2-1
14439 C---IF IT DOES NOT DOMINATE, ZMXISR SHOULD BE DECREASED
14440 IF (B1+C1.LT.ZERO) CALL HWWARN('HWEPRO',501,*999)
14441 IF (B2+C2.LT.ZERO) CALL HWWARN('HWEPRO',502,*999)
14442 GAMWT=GAMWT*(C1+B1)*(C2+B2)
14444 STOP 'Illegal value of circop!'
14448 C---IF USER LIMITS WERE TOO TIGHT, MIGHT NOT BE ANY PHASE-SPACE
14449 IF (GAMWT.LE.ZERO) GOTO 30
14450 C---IF CMF HAS ACQUIRED A TRANSVERSE BOOST, OR USER REQUESTS IT ANYWAY,
14451 C BOOST EVENT RECORD BACK TO CMF
14452 IF (PHEP(1,3)**2+PHEP(2,3)**2.GT.ZERO .OR. USECMF) CALL HWUBST(1)
14453 C---ROUTINE LOOPS BACK TO HERE IF GENERATED WEIGHT WAS ACCEPTED
14455 IPRO=MOD(IPROC/100,100)
14456 C---PROCESS GENERATED BY LES HOUCHES INTERFACE
14459 ELSEIF (IPRO.EQ.1) THEN
14460 IF (IPROC.LT.110.OR.IPROC.GE.120) THEN
14461 C--- E+E- -> Q-QBAR OR L-LBAR
14464 C--- E+E- -> Q-QBAR-GLUON
14467 ELSEIF (IPRO.EQ.2) THEN
14470 ELSEIF (IPRO.EQ.3) THEN
14473 ELSEIF (IPRO.EQ.4) THEN
14474 C---E+E- -> NUEB NUE H
14476 ELSEIF (IPRO.EQ.5 .AND. IPROC.LT.550) THEN
14477 C---EE -> EE GAMGAM -> EE FFBAR/WW
14479 ELSEIF (IPRO.EQ.5) THEN
14480 C---EE -> ENU GAMW -> ENU FF'BAR/WZ
14482 ELSEIF (IPRO.EQ.6) THEN
14483 C---EE -> FOUR JETS
14485 ELSEIF(IPRO.EQ.7) THEN
14486 C--EE -> SUSY PARTICLES(PAIR PRODUCTION)
14488 ELSEIF(IPRO.EQ.8) THEN
14489 C--EE -> RPV SUSY PARTICLE PRODUCTION
14491 ELSEIF (IPRO.EQ.9) THEN
14492 IF((MOD(IPROC,10000).EQ.955).OR.
14493 & (MOD(IPROC,10000).EQ.965).OR.
14494 & (MOD(IPROC,10000).EQ.975))THEN
14495 C---MSSM Higgs pair production in l+l-: H+ H- and A0 Higgs, Higgs=h0,H0.
14497 ELSEIF((MOD(IPROC,10000).EQ.910).OR.
14498 & (MOD(IPROC,10000).EQ.920))THEN
14499 C---MSSM scalar Higgs production from vector-vector fusion.
14501 ELSEIF((MOD(IPROC,10000).EQ.960).OR.
14502 & (MOD(IPROC,10000).EQ.970))THEN
14503 C---MSSM scalar Higgs production from Higgs-strahlung.
14506 ELSEIF ((IPRO.EQ.10).OR.(IPRO.EQ.11)) THEN
14507 C---SM/MSSM Higgs production with heavy quark flavours via e+e-.
14509 ELSEIF (IPRO.EQ.13) THEN
14510 C---GAMMA/Z0/Z' DRELL-YAN PROCESS
14512 ELSEIF (IPRO.EQ.14) THEN
14513 C---W+/- PRODUCTION VIA DRELL-YAN PROCESS
14515 ELSEIF (IPRO.EQ.15) THEN
14516 C---QCD HARD 2->2 PROCESSES
14518 ELSEIF ((IPRO.EQ.16).OR.(IPRO.EQ.36)) THEN
14519 C---SM/MSSM HIGGS PRODUCTION VIA QUARK/GLUON FUSION
14521 ELSEIF (IPRO.EQ.17) THEN
14522 C---QCD HEAVY FLAVOUR PRODUCTION
14524 ELSEIF (IPRO.EQ.18) THEN
14525 C---QCD DIRECT PHOTON + JET PRODUCTION
14527 ELSEIF ((IPRO.EQ.19).OR.(IPRO.EQ.37)) THEN
14528 C---SM/MSSM HIGGS PRODUCTION VIA W/Z FUSION
14530 ELSEIF (IPRO.EQ.20) THEN
14531 C---TOP PRODUCTION FROM W EXCHANGE
14533 ELSEIF (IPRO.EQ.21) THEN
14534 C---VECTOR BOSON + JET PRODUCTION
14536 ELSEIF (IPRO.EQ.22) THEN
14537 C QCD direct photon pair production
14539 ELSEIF (IPRO.EQ.23) THEN
14540 C QCD Higgs plus jet production
14542 ELSEIF (IPRO.EQ.24) THEN
14543 C---COLOUR-SINGLET EXCHANGE
14545 ELSEIF (IPRO.EQ.25) THEN
14546 C---SM Higgs production with heavy quark flavours via qq and gg.
14548 ELSEIF ((IPRO.EQ.26).OR.(IPRO.EQ.27)) THEN
14549 C---SM Higgs production with heavy gauge bosons via qq(').
14551 C---Gauge boson pair in hadron hadron
14552 ELSEIF (IPRO.EQ.28) THEN
14553 IF (MOD(IPROC,10000).LT.2850) THEN
14558 C--Vector boson + two jets
14559 ELSEIF(IPRO.EQ.29) THEN
14561 ELSEIF (IPRO.EQ.30) THEN
14562 C---HADRON-HADRON SUSY PROCESSES
14564 ELSEIF ((IPRO.EQ.31).OR.(IPRO.EQ.32)) THEN
14565 C---MSSM charged/neutral Higgs production in association with squarks.
14567 ELSEIF (IPRO.EQ.33) THEN
14568 IF(MOD(IPROC,10000).EQ.3350)THEN
14569 C---MSSM charged Higgs production in association with W: W+H- + W-H+.
14571 ELSEIF((MOD(IPROC,10000).EQ.3310).OR.
14572 & (MOD(IPROC,10000).EQ.3320).OR.
14573 & (MOD(IPROC,10000).EQ.3360).OR.
14574 & (MOD(IPROC,10000).EQ.3370))THEN
14575 C---MSSM Higgs production with heavy gauge bosons via qq(').
14578 C---MSSM charged/neutral Higgs pair production.
14581 ELSEIF (IPRO.EQ.34) THEN
14582 C---MSSM charged/neutral Higgs production via bg fusion.
14584 ELSEIF (IPRO.EQ.35) THEN
14585 C---MSSM charged Higgs production via bq fusion.
14587 ELSEIF (IPRO.EQ.38) THEN
14588 C---MSSM charged/neutral Higgs production with heavy quarks via qq and gg.
14590 ELSEIF(IPRO.EQ.40.OR.IPRO.EQ.41) THEN
14591 C---HADRON-HADRON R-PARITY VIOLATING SUSY PROCESSES
14593 ELSEIF (IPRO.EQ.42) THEN
14594 C---SPIN-TWO RESONANCE
14596 ELSEIF (IPRO.EQ.50) THEN
14597 C Point-like photon two-jet production
14599 ELSEIF (IPRO.EQ.51) THEN
14600 C Point-like photon/QCD heavy flavour pair production
14602 ELSEIF (IPRO.EQ.52) THEN
14603 C Point-like photon/QCD heavy flavour single excitation
14605 ELSEIF (IPRO.EQ.53) THEN
14606 C Compton scattering of point-like photon and (anti)quark
14608 ELSEIF (IPRO.EQ.55) THEN
14609 C Point-like photon/higher twist meson production
14611 ELSEIF (IPRO.EQ.60) THEN
14612 C---QPM GAMMA-GAMMA-->QQBAR
14614 ELSEIF (IPRO.GE.70.AND.IPRO.LE.79) THEN
14615 C---BARYON-NUMBER VIOLATION, AND OTHER MULTI-W PRODUCTION PROCESSES
14617 ELSEIF (IPRO.EQ.80) THEN
14618 C---MINIMUM-BIAS: NO HARD SUBPROCESS
14621 ELSEIF (IPRO.EQ.90) THEN
14624 ELSEIF(IPRO.EQ.91) THEN
14625 C---BOSON - GLUON(QUARK) FUSION --> ANTIQUARK(GLUON) + QUARK
14627 ELSEIF(IPRO.EQ.92) THEN
14628 C---DEEP INELASTIC WITH EXTRA JET: OBSOLETE PROCESS
14630 40 FORMAT (1X,' IPROC=92** is no longer supported.'
14631 & /1X,' Please use IPROC=91** instead.')
14632 CALL HWWARN('HWEPRO',500,*999)
14633 ELSEIF(IPRO.EQ.95) THEN
14634 C---HIGGS PRODUCTION VIA W FUSION IN E P
14637 C---UNKNOWN PROCESS
14638 CALL HWWARN('HWEPRO',102,*999)
14643 IF (EVWGT.LT.ZERO) THEN
14653 C--New call spin correlation code if needed
14654 IF(SYSPIN.AND.(IPRO.EQ. 1.OR.IPRO.EQ.13.OR.IPRO.EQ.14.OR.
14655 & IPRO.EQ.15.OR.IPRO.EQ.17.OR.IPRO.EQ.20.OR.
14656 & IPRO.EQ. 7.OR.IPRO.EQ.30.OR.IPRO.EQ.40.OR.
14657 & IPRO.EQ.41.OR.IPRO.EQ.8)) CALL HWHSPN
14658 C--generate additional photon radition in top production
14659 IF(ITOPRD.EQ.1.AND.MOD(IPROC,10000).EQ.1706) CALL HWPHTT
14662 C---IF AN EVENT IS CANCELLED BEFORE IT IS GENERATED, GIVE IT ZERO WEIGHT
14663 IF (IERROR.NE.0) THEN
14670 IF (EVWGT.LT.ZERO) THEN
14674 IF (EVWGT.LT.-1.D-9) CALL HWWARN('HWEPRO',3,*999)
14679 WGTSUM=WGTSUM+EVWGT
14680 WSQSUM=WSQSUM+EVWGT**2
14681 ABWSUM=ABWSUM+ABWGT
14682 C--weight addition for Les Houches accord
14683 IF(IPROC.LE.0) THEN
14684 IF(ABS(IDWTUP).EQ.1) THEN
14685 LHWGT (ITYPLH) = LHWGT (ITYPLH)+EVWGT
14686 LHWGTS(ITYPLH) = LHWGTS(ITYPLH)+EVWGT**2
14687 LHIWGT(ITYPLH) = LHIWGT(ITYPLH)+1
14690 IF (ABWGT.GT.WBIGST) THEN
14692 IF (NOWGT.AND.WBIGST.GT.WGTMAX) THEN
14693 IF (NEVHEP.NE.0) CALL HWWARN('HWEPRO',1,*999)
14695 WRITE (6,99) WGTMAX
14696 C--additional for Les Houche accord
14697 IF(IPROC.LE.0) THEN
14698 IF(ABS(IDWTUP).EQ.1)
14699 & LHMXSM = LHMXSM-LHXMAX(ITYPLH)+ABWGT
14700 LHXMAX(ITYPLH) = EVWGT
14704 IF (NEVHEP.NE.0) THEN
14705 C---LOW EFFICIENCY WARNINGS:
14706 C WARN AT 10*EFFMIN, STOP AT EFFMIN
14707 IF (10*EFFMIN*NWGTS.GT.NEVHEP) THEN
14708 IF (EFFMIN*NWGTS.GT.NEVHEP) CALL HWWARN('HWEPRO',200,*999)
14709 IF (EFFMIN.GT.ZERO) THEN
14710 IF (MOD(NWGTS,INT(10/EFFMIN)).EQ.0) THEN
14711 CALL HWWARN('HWEPRO',2,*999)
14712 WRITE (6,98) WGTMAX
14717 GENEV=ABWGT.GT.WGTMAX*HWRGEN(0)
14719 GENEV=ABWGT.NE.ZERO
14725 98 FORMAT(10X,' MAXIMUM WEIGHT =',1PG24.16)
14726 99 FORMAT(10X,'NEW MAXIMUM WEIGHT =',1PG24.16)
14729 *CMZ :- -26/04/91 11.11.55 by Bryan Webber
14730 *-- Author : Bryan Webber
14731 C-----------------------------------------------------------------------
14732 SUBROUTINE HWETWO(SMR3,SMR4)
14733 C-----------------------------------------------------------------------
14734 C SETS UP 2->2 HARD SUBPROCESS
14735 c BRW change 18/8/04: BW smearing of mass i only if SMRi is true
14736 C-----------------------------------------------------------------------
14737 INCLUDE 'HERWIG65.INC'
14738 DOUBLE PRECISION HWUMBW,HWUPCM,PA,PCM
14739 INTEGER ICMF,IBM,I,J,K,IHEP,NTRY
14746 C---FIND BEAM AND TARGET
14747 IF (JDAHEP(1,I).NE.0) IBM=JDAHEP(1,I)
14750 IDHEP(IHEP)=IDPDG(IDN(I))
14752 JMOHEP(1,IHEP)=ICMF
14753 JMOHEP(I,ICMF)=IHEP
14754 JDAHEP(1,IHEP)=ICMF
14755 C---SPECIAL - IF INCOMING PARTON IS INCOMING BEAM THEN COPY IT
14756 IF (XX(I).EQ.ONE.AND.IDHW(IBM).EQ.IDN(I)) THEN
14757 CALL HWVEQU(5,PHEP(1,IBM),PHEP(1,IHEP))
14758 IF (I.EQ.2) PHEP(3,IHEP)=-PHEP(3,IHEP)
14762 PHEP(5,IHEP)=RMASS(IDN(I))
14763 PA=XX(I)*(PHEP(4,IBM)+ABS(PHEP(3,IBM)))
14764 PHEP(4,IHEP)=0.5*(PA+PHEP(5,IHEP)**2/PA)
14765 PHEP(3,IHEP)=PA-PHEP(4,IHEP)
14768 PHEP(3,NHEP+2)=-PHEP(3,NHEP+2)
14769 C---HARD CENTRE OF MASS
14771 IDHEP(ICMF)=IDPDG(IDCMF)
14773 CALL HWVSUM(4,PHEP(1,NHEP+1),PHEP(1,NHEP+2),PHEP(1,ICMF))
14774 CALL HWUMAS(PHEP(1,ICMF))
14780 IDHEP(IHEP)=IDPDG(IDN(I))
14782 JMOHEP(1,IHEP)=ICMF
14783 16 JDAHEP(I-2,ICMF)=IHEP
14786 PHEP(5,NHEP+4)=HWUMBW(IDN(3))
14788 PHEP(5,NHEP+4)=RMASS(IDN(3))
14791 PHEP(5,NHEP+5)=HWUMBW(IDN(4))
14793 PHEP(5,NHEP+5)=RMASS(IDN(4))
14795 PCM=HWUPCM(PHEP(5,NHEP+3),PHEP(5,NHEP+4),PHEP(5,NHEP+5))
14796 IF (PCM.LT.ZERO) THEN
14798 IF (NTRY.LE.NETRY) GO TO 19
14799 CALL HWWARN('HWETWO',103,*999)
14802 PHEP(4,IHEP)=SQRT(PCM**2+PHEP(5,IHEP)**2)
14803 PHEP(3,IHEP)=PCM*COSTH
14804 PHEP(1,IHEP)=SQRT((PCM+PHEP(3,IHEP))*(PCM-PHEP(3,IHEP)))
14805 CALL HWRAZM(PHEP(1,IHEP),PHEP(1,IHEP),PHEP(2,IHEP))
14806 CALL HWULOB(PHEP(1,NHEP+3),PHEP(1,IHEP),PHEP(1,IHEP))
14807 CALL HWVDIF(4,PHEP(1,NHEP+3),PHEP(1,IHEP),PHEP(1,NHEP+5))
14808 C---SET UP COLOUR STRUCTURE LABELS
14814 JMOHEP(2,NHEP+J)=NHEP+K
14815 30 JDAHEP(2,NHEP+K)=NHEP+J
14819 *CMZ :- -26/11/00 17.21.55 by Bryan Webber
14820 *-- Author : Stefano Moretti
14821 C-----------------------------------------------------------------------
14822 SUBROUTINE HWH2BK(P1,P2,P3,P4,RMW,RMH,RES,RESL,REST)
14823 C-----------------------------------------------------------------------
14824 C...Matrix element for q(1) + q-bar(2) -> W+/-(3) + H-/+(4),
14825 C...all masses retained.
14826 C...It factorises (PIFAC*ALPHA/SWEIN/RMW/RMW/SQRT(2.))**2
14828 C...First release: 1-APR-1998 by Stefano Moretti
14829 C-----------------------------------------------------------------------
14830 INCLUDE 'HERWIG65.INC'
14832 DOUBLE PRECISION P1(0:3),P2(0:3),P3(0:3),P4(0:3)
14833 DOUBLE PRECISION P(0:3)
14834 DOUBLE PRECISION RES,S,T,U,MB2,MT2,MW2,MHP2,MH02,MA02,MSH2,
14835 & MGAMH0,MGAMA0,MGAMSH,PT,NC,KT2,RESL,REST
14836 DOUBLE PRECISION TT,UU,KKT2,TL
14837 DOUBLE COMPLEX Z,PV,PA
14838 DOUBLE PRECISION RMB,RMT,RMW,RMH
14839 DOUBLE PRECISION RMH01,GAMH01,
14842 DOUBLE PRECISION VP,CFC
14843 EQUIVALENCE (RMB ,RMASS( 5)),(RMT ,RMASS( 6))
14844 EQUIVALENCE (RMH01,RMASS(204)),
14845 & (RMH02,RMASS(203)),
14846 & (RMH03,RMASS(205))
14847 PARAMETER (Z=(0.,1.),NC=3.)
14849 GAMH01=RMASS(204)/DKLTM(204)
14850 GAMH02=RMASS(203)/DKLTM(203)
14851 GAMH03=RMASS(205)/DKLTM(205)
14852 C...constant terms.
14860 MGAMH0=RMH01*GAMH01
14861 MGAMA0=RMH03*GAMH03
14862 MGAMSH=RMH02*GAMH02
14863 C...Mandelstam invariants.
14868 S=S-(P1(I)+P2(I))**2
14869 T=T-(P1(I)-P3(I))**2
14870 U=U-(P1(I)-P4(I))**2
14872 C...propagators and couplings.
14873 PV=(-SINA*COSBMA/(S-MSH2+Z*MGAMSH)
14874 & -COSA*SINBMA/(S-MH02+Z*MGAMH0) )/COSB
14875 PA= TANB/(S-MA02+Z*MGAMA0)
14877 KT2=(U*T-MHP2*MW2)/S
14879 RES=S/NC*( MB2/2.*((S-MW2-MHP2)**2-4.*MW2*MHP2)*
14880 & DREAL(DCONJG(PV)*PV+DCONJG(PA)*PA)+
14881 & MB2*TANB*PT*(MW2*MHP2-S*KT2-T**2)*DREAL(PV-PA)+
14882 & PT**2*((MT2/TANB)**2*(2.*MW2+KT2)
14883 & +MB2*TANB**2*(2.*MW2*KT2+T**2)))
14885 C...Extracts spin dependence.
14886 VP=SQRT(P3(1)**2+P3(2)**2+P3(3)**2)
14891 P(0)=VP**2/P3(0)*CFC
14895 TT=TT-(P1(I)-P(I))**2
14896 UU=UU-(P2(I)-P(I))**2
14898 KKT2=((MW2+TT)*(MW2+UU)+(MW2+MHP2-T-U)*MW2)/S
14899 TL=((TT+MW2)*(UU+MW2)*((S+U-MW2)*(TT+MW2)/(UU+MW2)-T)
14900 & +MW2*((MW2-T)*(MW2-U)-S*MW2))/S
14901 C...Longitudinal ME (along V direction).
14902 RESL=S/NC*(MB2/2.*((S-MW2-MHP2)**2-4.*MW2*MHP2)*
14903 & DREAL(DCONJG(PV)*PV+DCONJG(PA)*PA)+
14904 & MB2*TANB*PT*(MW2*MHP2-S*KT2-T**2)*DREAL(PV-PA)+
14905 & PT**2*((MT2/TANB)**2*(KKT2)
14906 & +MB2*TANB**2*(TL)))
14908 C...Transverse ME (perpendicular to V direction).
14913 *CMZ :- -27/02/01 17:04:16 by Peter Richardson
14914 *-- Author : Peter Richardson
14915 C-----------------------------------------------------------------------
14916 FUNCTION HWH2DD(ND,I,J,K,L,Z1,Z2)
14917 C-----------------------------------------------------------------------
14918 C Returns the coefficient D1-10 from Nucl. Phys. B262 (1985) 235-262
14919 C N.B. THE STRONG COUPLING AND GV+/-GA ARE INCLUDED IN THE CROSS
14921 C I-L are the particles (all outgoing)
14922 C Z1 and Z2 are the decay products of the Z
14923 C-----------------------------------------------------------------------
14924 INCLUDE 'HERWIG65.INC'
14925 INTEGER ND,I,J,K,L,Z1,Z2
14926 DOUBLE COMPLEX HWH2DD,ZI,S,D,F
14927 PARAMETER(ZI=(0.0D0,1.0D0))
14928 COMMON/HWHEWS/S(8,8,2),D(8,8)
14929 COMMON/HWHZBB/F(8,8)
14932 ELSEIF(ND.EQ.2) THEN
14933 HWH2DD = ZI/F(J,K)/SQRT(TWO*D(I,K))
14934 ELSEIF(ND.EQ.3) THEN
14935 HWH2DD = -ZI/F(I,K)/SQRT(TWO*D(I,K))
14936 ELSEIF(ND.EQ.4) THEN
14937 HWH2DD = -ZI/F(K,L)/(F(Z1,I)+F(Z2,I)+F(Z1,Z2))
14938 ELSEIF(ND.EQ.5) THEN
14939 HWH2DD = ZI/F(K,L)/(F(Z1,J)+F(Z2,J)+F(Z1,Z2))
14940 ELSEIF(ND.EQ.6) THEN
14941 HWH2DD = ZI*HALF/F(J,L)/(F(J,L)+F(J,K)+F(K,L))/D(K,L)
14942 ELSEIF(ND.EQ.7) THEN
14943 HWH2DD = -ZI*HALF/F(I,K)/F(J,L)/D(K,L)
14944 ELSEIF(ND.EQ.8) THEN
14945 HWH2DD = ZI*HALF/F(I,K)/(F(I,K)+F(I,L)+F(K,L))/D(K,L)
14946 ELSEIF(ND.EQ.9) THEN
14947 HWH2DD = -ZI/F(K,L)/(F(J,K)+F(J,L)+F(K,L))
14948 ELSEIF(ND.EQ.10) THEN
14949 HWH2DD = ZI/F(K,L)/(F(I,K)+F(I,L)+F(K,L))
14953 *CMZ :- -30/06/01 18.21.35 by Stefano Moretti
14954 *-- Author : Kosuke Odagiri & Stefano Moretti
14955 C-----------------------------------------------------------------------
14956 SUBROUTINE HWH2BH(P1,P2,P3,P4,P5,
14957 & EMW,EMH,EMH01,EMH02,EMH03,EMB,EMT,IFL,IRES,CKM,
14959 C-----------------------------------------------------------------------
14960 C...Matrix element for b(1) + q(2) -> b(3) + q'(4) + H+/-(5) and C.C.,
14961 C...q(q') massless incoming(outgoing) quark, all other masses retained.
14962 C...It factorises 64.*PIFAC**3*ALPHA**3/4./SWEIN/SWEIN/SWEIN/EMW/EMW.
14964 C...First release: 01-APR-1998 by Kosuke Odagiri
14965 C...First modified: 12-APR-1998 by Stefano Moretti
14966 C-----------------------------------------------------------------------
14967 INCLUDE 'HERWIG65.INC'
14968 INTEGER MU,IRES,IFL
14969 DOUBLE PRECISION P1(0:3),P2(0:3),P3(0:3),P4(0:3),P5(0:3)
14970 DOUBLE PRECISION EMB,EMT,EMW,EMH,EMH01,EMH02,EMH03
14971 DOUBLE PRECISION GAMT,GAMWTMP,GAMH01,GAMH03,GAMH02,CKM
14972 DOUBLE PRECISION QW(0:3),QS(0:3)
14973 DOUBLE PRECISION N0,DOTHH,DOTSS,DOTWW,E1234
14974 DOUBLE PRECISION DOTTT,DOT12,DOT13,DOT14,DOT1H,DOT23
14975 DOUBLE PRECISION DOT24,DOT2H,DOT34,DOT3H,DOT4H
14976 DOUBLE PRECISION PT2,PV2,PA2,PTPV,PTPA,IMPTPV,IMPTPA
14977 DOUBLE PRECISION M2
14978 DOUBLE COMPLEX PV,PA,PT,PW,Z
14979 PARAMETER (GAMWTMP=0.D0,GAMH01=0.D0,GAMH03=0.D0,GAMH02=0.D0)
14980 PARAMETER (Z=(0.D0,1.D0))
14981 DOUBLE PRECISION SC,RICCI
14985 QW(MU)=P2(MU)-P4(MU)
14986 QS(MU)=P1(MU)-P3(MU)
14992 DOT13=EMB*EMB-DOTSS/2.D0
15004 E1234=RICCI(P1,P2,P3,P4)
15005 ELSE IF(IFL.EQ.-1)THEN
15012 E1234=-RICCI(P1,P2,P3,P4)
15015 DOTTT=DOTHH+EMB*EMB+2.D0*DOT3H
15017 PV=COSA*SINBMA/(DOTSS-EMH01*EMH01+Z*EMH01*GAMH01)+
15018 1 SINA*COSBMA/(DOTSS-EMH02*EMH02+Z*EMH02*GAMH02)
15019 PA=SINB/(DOTSS-EMH03*EMH03+Z*EMH03*GAMH03)
15020 PW=1./(DOTWW-EMW*EMW+Z*EMW*GAMWTMP)
15021 C REMOVE TOP DIAGRAM.
15022 IF(IRES.EQ.1)PT=1./(DOTTT-EMT*EMT+Z*EMT*GAMT)
15023 IF(IRES.EQ.0)PT=(0.D0,0.D0)
15025 PT2 =DREAL(DCONJG(PT)*PT)
15026 PV2 =DREAL(DCONJG(PV)*PV)
15027 PA2 =DREAL(DCONJG(PA)*PA)
15028 PTPV=DREAL(DCONJG(PT)*PV)
15029 PTPA=DREAL(DCONJG(PT)*PA)
15030 IMPTPV=DIMAG(DCONJG(PT)*PV)
15031 IMPTPA=DIMAG(DCONJG(PT)*PA)
15035 M2=N0*N0* ( EMB*EMB/COSB/COSB*(PV2+PA2)*DOT13*
15036 & (2.D0*DOT4H*DOT2H-DOT24*DOTHH)+
15038 O (EMB*EMB*TANB*TANB*(2.D0*DOT3H*DOT4H-DOT34*DOTHH)+
15039 P EMT*EMT/TANB/TANB*(EMT*EMT*DOT34))+
15040 & EMB*EMB*TANB/COSB*DREAL(PV+PA)*
15041 X (DREAL(PT)*(4.D0*DOT4H*DOT12*DOT13-
15042 T (2.D0*DOT4H+DOTHH)*(DOT12*DOT34+DOT13*DOT24-DOT14*DOT23))+
15043 M DIMAG(PT)*(2.D0*DOT4H+DOTHH)*E1234) )
15047 DOUBLE PRECISION FUNCTION SC(A,B)
15048 DOUBLE PRECISION A(0:3),B(0:3)
15049 SC=A(0)*B(0)-A(1)*B(1)-A(2)*B(2)-A(3)*B(3)
15053 DOUBLE PRECISION FUNCTION RICCI(A,B,C,D)
15054 DOUBLE PRECISION A(0:3),B(0:3),C(0:3),D(0:3)
15056 & A(0)*B(1)*C(2)*D(3)+A(0)*B(2)*C(3)*D(1)+A(0)*B(3)*C(1)*D(2)-
15057 & A(0)*B(3)*C(2)*D(1)-A(0)*B(1)*C(3)*D(2)-A(0)*B(2)*C(1)*D(3)+
15058 & A(1)*B(0)*C(3)*D(2)+A(1)*B(2)*C(0)*D(3)+A(1)*B(3)*C(2)*D(0)-
15059 & A(1)*B(2)*C(3)*D(0)-A(1)*B(3)*C(0)*D(2)-A(1)*B(0)*C(2)*D(3)+
15060 & A(2)*B(3)*C(0)*D(1)+A(2)*B(0)*C(1)*D(3)+A(2)*B(1)*C(3)*D(0)-
15061 & A(2)*B(1)*C(0)*D(3)-A(2)*B(3)*C(1)*D(0)-A(2)*B(0)*C(3)*D(1)+
15062 & A(3)*B(2)*C(1)*D(0)+A(3)*B(0)*C(2)*D(1)+A(3)*B(1)*C(0)*D(2)-
15063 & A(3)*B(0)*C(1)*D(2)-A(3)*B(1)*C(2)*D(0)-A(3)*B(2)*C(0)*D(1)
15067 *CMZ :- -27/02/01 17:04:16 by Peter Richardson
15068 C-----------------------------------------------------------------------
15069 SUBROUTINE HWH2F1(NP,F,I,P,MQ)
15070 C-----------------------------------------------------------------------
15071 C Subroutine to implement the F function of Eijk and Kliess
15072 C fixed first momenta and all second momenta
15073 C-----------------------------------------------------------------------
15074 INCLUDE 'HERWIG65.INC'
15075 DOUBLE PRECISION P(5),MQ,PM(5),XMASS,PLAB,PRW,PCM,HWULDO,PDOT,EPS
15076 DOUBLE COMPLEX F(2,2,8),S,D,SIP(2),SJP(2)
15079 COMMON/HWHEWS/S(8,8,2),D(8,8)
15080 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
15081 PARAMETER(EPS=1D-10)
15082 C--find the massless momentum we need
15083 PDOT = HWULDO(PCM(1,I),P)
15084 P(5) = P(4)**2-P(1)**2-P(2)**2-P(3)**2
15085 IF(ABS(PDOT).LT.EPS.AND.ABS(P(5)).LT.EPS) THEN
15088 PDOT = HALF*P(5)/PDOT
15091 PM(J) = P(J)-PDOT*PCM(J,I)
15093 IF(P(5).GT.ZERO) THEN
15099 C--calculate its spinor product with the fixed momentum
15100 CALL HWH2SS(SIP,PCM(1,I),PM)
15101 C--calculate the F functions
15103 CALL HWH2SS(SJP,PM,PCM(1,J))
15104 F(1,1,J) = SIP(1)*SJP(2)
15105 F(1,2,J) = MQ*S(I,J,1)
15106 F(2,1,J) = MQ*S(I,J,2)
15107 F(2,2,J) = SIP(2)*SJP(1)
15111 *CMZ :- -27/02/01 17:04:16 by Peter Richardson
15112 C-----------------------------------------------------------------------
15113 SUBROUTINE HWH2F2(NP,F,I,P,MQ)
15114 C-----------------------------------------------------------------------
15115 C Subroutine to implement the F function of Eijk and Kliess
15116 C fixed second momenta and all first momenta
15117 C-----------------------------------------------------------------------
15118 INCLUDE 'HERWIG65.INC'
15119 DOUBLE PRECISION P(5),MQ,PM(5),XMASS,PLAB,PRW,PCM,HWULDO,PDOT,EPS
15120 DOUBLE COMPLEX F(2,2,8),S,D,SIP(2),SJP(2)
15123 COMMON/HWHEWS/S(8,8,2),D(8,8)
15124 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
15125 PARAMETER(EPS=1D-10)
15126 C--find the massless momentum we need
15127 PDOT = HWULDO(PCM(1,I),P)
15128 P(5) = P(4)**2-P(1)**2-P(2)**2-P(3)**2
15129 IF(ABS(PDOT).LT.EPS.AND.ABS(P(5)).LT.EPS) THEN
15132 PDOT = HALF*P(5)/PDOT
15135 PM(J) = P(J)-PDOT*PCM(J,I)
15137 IF(P(5).GT.ZERO) THEN
15143 C--calculate its spinor product with the fixed momentum
15144 CALL HWH2SS(SIP,PM,PCM(1,I))
15145 C--calculate the F functions
15147 CALL HWH2SS(SJP,PCM(1,J),PM)
15148 F(1,1,J) = SIP(2)*SJP(1)
15149 F(1,2,J) = MQ*S(J,I,1)
15150 F(2,1,J) = MQ*S(J,I,2)
15151 F(2,2,J) = SIP(1)*SJP(2)
15155 *CMZ :- -27/02/01 17:04:16 by Peter Richardson
15156 C-----------------------------------------------------------------------
15157 SUBROUTINE HWH2F3(NP,F,P,MQ)
15158 C-----------------------------------------------------------------------
15159 C Subroutine to implement the F function of Eijk and Kliess
15160 C All first and second momenta
15161 C-----------------------------------------------------------------------
15162 INCLUDE 'HERWIG65.INC'
15163 DOUBLE PRECISION P(5),MQ,PM(5),XMASS,PLAB,PRW,PCM,HWULDO,PDOT,EPS
15164 DOUBLE COMPLEX F(2,2,8,8),SIP(2),SJP(2),S,D
15166 COMMON/HWHEWS/S(8,8,2),D(8,8)
15167 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
15169 PARAMETER(EPS=1D-10)
15170 C--find the massless momentum we need
15172 PDOT = HWULDO(PCM(1,I),P)
15173 P(5) = P(4)**2-P(1)**2-P(2)**2-P(3)**2
15174 IF(ABS(PDOT).LT.EPS.AND.ABS(P(5)).LT.EPS) THEN
15177 PDOT = HALF*P(5)/PDOT
15180 PM(J) = P(J)-PDOT*PCM(J,I)
15182 IF(P(5).GT.ZERO) THEN
15188 C--calculate its spinor product with the fixed momentum
15189 CALL HWH2SS(SIP,PCM(1,I),PM)
15190 C--calculate the F functions
15192 CALL HWH2SS(SJP,PM,PCM(1,J))
15193 F(1,1,I,J) = SIP(1)*SJP(2)
15194 F(1,2,I,J) = MQ*S(I,J,1)
15195 F(2,1,I,J) = MQ*S(I,J,2)
15196 F(2,2,I,J) = SIP(2)*SJP(1)
15201 F(1,1,J,I) = F(2,2,I,J)
15202 F(1,2,J,I) = -F(1,2,I,J)
15203 F(2,1,J,I) = -F(2,1,I,J)
15204 F(2,2,J,I) = F(1,1,I,J)
15209 *CMZ :- -13/10/02 09.43.05 by Peter Richardson
15210 *-- Author : Kosuke Odagiri and Stefano Moretti
15211 C-----------------------------------------------------------------------
15212 SUBROUTINE HWH2HE(FIRST,GAUGE,IFL,IH,HFC,HBC,
15213 & E,S2W,TANB,AL,RMW,S,Q3, P3,P4,P5,
15214 & RM3,YM3,GAM3,RM4,YM4,GAM4,RM5,GAM5,
15215 & RML,GAML,RMH,GAMH,RMA,GAMA,
15216 & RMZ,GAMZ,CFAC,RES)
15217 C-----------------------------------------------------------------------
15218 C MATRIX ELEMENT SQUARED FOR
15219 C e-(1) e+(2) -> f(3) f(')bar(4) Higgs(5)
15220 C (SAME QUARK MASSES IN YUKAWA AND KINEMATICS)
15221 C-----------------------------------------------------------------------
15223 LOGICAL FIRST,GAUGE
15224 DOUBLE PRECISION HFC,HBC
15225 DOUBLE PRECISION CFAC
15226 DOUBLE PRECISION E,S2W,TANB,AL,RMW,S,Q3,RES
15227 DOUBLE PRECISION P3(0:3),P4(0:3),P5(0:3)
15228 DOUBLE PRECISION RM3,YM3,GAM3,RM4,YM4,GAM4,RM5,GAM5,RMZ,GAMZ
15229 DOUBLE PRECISION RML,GAML,RMH,GAMH,RMA,GAMA,Q2
15230 DOUBLE PRECISION XW,GE(-1:1),G3(-1:1),G4(-1:1),G5(-1:1)
15231 DOUBLE PRECISION RM(-1:1),RN1(-1:1),RN2(-1:1),RN3
15232 DOUBLE PRECISION SQS,TWOSQS,HLFSQS,P34,M34,PREFAC
15233 DOUBLE PRECISION RLE,RLLE,EP3(-1:1),EP4(-1:1),ZERO,ONE,TWO,HLF
15234 DOUBLE PRECISION BE,DUMMY(0:3),SA,CA,SB,CB
15235 INTEGER I,LE,L,IFL,IH
15236 DOUBLE COMPLEX PROPZ,PROP3(-1:1),PROP4(-1:1),PROP5,PROP6
15237 DOUBLE COMPLEX PROP7(-1:1)
15238 DOUBLE COMPLEX PP(-1:1),MM(-1:1),QQ(-1:1),ZP3,ZP4,ZP5
15239 PARAMETER (ZERO=0.D0,ONE=1.D0,TWO=2.D0,HLF=.5D0)
15240 SAVE XW,GE,G3,G4,G5,RM,PREFAC
15241 C QUANTITIES WHICH CAN BE COMPUTED ONLY ONCE
15243 C SOME COMMON INITIALISATIONS
15260 G3(-1)=-ONE*(-Q3/ABS(Q3))+G3(1)
15273 C MSSM SCALING FACTORS FOR COUPLINGS
15275 RM(-1)=+YM3/RMW*HFC
15276 RM(+1)=+YM4/RMW*HFC
15277 ELSE IF(IH.EQ.3)THEN
15278 RM(-1)=+YM3/RMW*HFC
15279 RM(+1)=-YM4/RMW*HFC
15282 IF(IH.EQ.1)RN1(-1)=+YM3/RMW*((2-IFL)*TANB+(IFL-1)/TANB)
15283 & *(-SQRT(ABS(ONE-HBC**2)))
15284 IF(IH.EQ.1)RN1(+1)=-YM4/RMW*((2-IFL)*TANB+(IFL-1)/TANB)
15285 & *(-SQRT(ABS(ONE-HBC**2)))
15286 IF(IH.EQ.2)RN1(-1)=-YM3/RMW*((2-IFL)*TANB+(IFL-1)/TANB)
15287 & *(+SQRT(ABS(ONE-HBC**2)))
15288 IF(IH.EQ.2)RN1(+1)=+YM4/RMW*((2-IFL)*TANB+(IFL-1)/TANB)
15289 & *(+SQRT(ABS(ONE-HBC**2)))
15292 IF(IH.EQ.0)RN3=1.D0
15295 ELSE IF(IH.EQ.3)THEN
15296 RN1(-1)=+YM3/RMW*((2-IFL)*(-SA/CB)+(IFL-1)*(+CA/SB))
15298 RN1(+1)=+YM4/RMW*((2-IFL)*(-SA/CB)+(IFL-1)*(+CA/SB))
15300 RN2(-1)=+YM3/RMW*((2-IFL)*(+CA/CB)+(IFL-1)*(+SA/SB))
15302 RN2(+1)=+YM4/RMW*((2-IFL)*(+CA/CB)+(IFL-1)*(+SA/SB))
15306 PREFAC=E**6/(XW*S)*CFAC/TWO
15317 RM(-1)=YM3*TANB/RMW
15318 RM(+1)=YM4/TANB/RMW
15324 PREFAC=E**6/(XW*S)*CFAC
15328 C SOME ENERGY CONSTANTS
15332 PROPZ=S/(XW*(TWO-XW)*DCMPLX(S-RMZ**2,-RMZ*GAMZ))
15334 P34=P3(0)*P4(0)-P3(1)*P4(1)-P3(2)*P4(2)-P3(3)*P4(3)
15337 C FF(')-BAR PROPAGATOR
15338 Q2=RM3**2+RM4**2+TWO*P34
15339 C CONSTRUCT AMPLITUDE
15343 PROP5=(GE(0)*G5(0)+GE(LE)*G5(-1)*PROPZ)/
15344 & DCMPLX(Q2-RMA**2,-RMA*GAMA)
15346 ELSE IF(IH.EQ.3)THEN
15347 PROP5=(GE(0)*G5(0)+GE(LE)*G5(-1)*PROPZ)/
15348 & DCMPLX(Q2-RML**2,-RML*GAML)
15349 PROP6=(GE(0)*G5(0)+GE(LE)*G5(-1)*PROPZ)/
15350 & DCMPLX(Q2-RMH**2,-RMH*GAMH)
15352 PROP5=(GE(0)*G5(0)+GE(LE)*G5(-1)*PROPZ)/
15353 & DCMPLX(Q2-RM5**2,-RM5*GAM5)
15355 ZP3=DCMPLX(P3(1),-RLE*P3(2))
15356 ZP4=DCMPLX(P4(1),-RLE*P4(2))
15359 PROP3(L)=(GE(0)*G3(0)+GE(LE)*G3(L)*PROPZ)/
15360 & DCMPLX(S-TWOSQS*P3(0),-RM3*GAM3)
15361 PROP4(L)=(GE(0)*G4(0)+GE(LE)*G4(L)*PROPZ)/
15362 & DCMPLX(S-TWOSQS*P4(0),-RM4*GAM4)
15363 PROP7(L)=GE(LE)*G3(L)*PROPZ/DCMPLX(Q2-RMZ**2,-RMZ*GAMZ)
15366 PP(L)=-RM(-L)*SQS*(PROP3(L)+PROP4(-L))
15367 MM(L)=RM3*RM(+L)*(PROP3(L)-PROP3(-L))
15368 & +RM4*RM(-L)*(PROP4(L)-PROP4(-L))
15369 & +TWO*RMZ**2/RMW*RN3*PROP7(L)
15374 PP(L)=DCMPLX(ZERO,ZERO)
15375 MM(L)=MM(L)+PROPZ*GE(LE)*DFLOAT(L)/TWOSQS*
15376 & (RM3*RM(L)/ZP3-RM4*RM(-L)/ZP4)
15378 QQ(L)=RM(L)*(PROP3(-L)*ZP3-PROP4(L)*ZP4)
15379 & +RN1(L)*PROP5*ZP5
15380 & -RN2(L)*PROP6*ZP5
15381 & +RM3/RMW*RN3*(PROP7(L)-PROP7(-L))*ZP5
15383 EP3(L)=P3(0)+RLLE*P3(3)
15384 EP4(L)=P4(0)+RLLE*P4(3)
15388 & EP3(+L)*EP4(+L)*DCONJG(PP(+L))*PP(+L)+
15389 & EP3(+L)*EP4(-L)*DCONJG(MM(+L))*MM(+L)-
15390 & TWO*RM3*EP4(+L)*DCONJG(PP(+L))*MM(-L)-
15391 & TWO*RM4*EP3(+L)*DCONJG(PP(+L))*MM(+L)+
15392 & M34*(DCONJG(PP(-L))*PP(+L)+DCONJG(MM(-L))*MM(+L))
15393 & +TWO*DCONJG(QQ(-L))
15394 & *((RM3*MM(-L)-EP3(+L)*PP(+L))*ZP4-
15395 & (RM4*MM(+L)-EP4(+L)*PP(+L))*ZP3+
15396 & P34*QQ(-L)-M34*QQ(+L)))
15402 *CMZ :- -14/03/01 09:03:25 by Peter Richardson
15403 *-- Author : Peter Richardson
15404 C-----------------------------------------------------------------------
15405 SUBROUTINE HWH2M0(IQ,IDZ,MG,MQ)
15406 C-----------------------------------------------------------------------
15407 C Massless matrix elements for gg-->qqZ and qq-->qqZ
15408 C using the matrix elements given in Nucl. Phys. B262 (1985) 235-242
15409 C-----------------------------------------------------------------------
15410 INCLUDE 'HERWIG65.INC'
15411 INTEGER IQ,I,J,OZ(2,2),IDZ,P1,P2,P3,P4,IQI,ID(2),K
15412 DOUBLE PRECISION MG(2),MQ(2,5),G(12,2),FLOW(3,3),CQFC,CQIFC,
15414 DOUBLE COMPLEX MQAMP(2),HWH2T1,HWH2T2,HWH2T3,HWH2T4,HWH2T5,
15415 & HWH2T6,HWH2T7,HWH2T8,HWH2T9,HWH2T0,DCF(8),HWH2DD,
15416 & MGAMP(2,2,2,2,2),TRPGL(2)
15417 EXTERNAL HWH2DD,HWH2T0,HWH2T1,HWH2T2,HWH2T3,HWH2T4,HWH2T5,HWH2T6,
15418 & HWH2T7,HWH2T8,HWH2T9
15419 PARAMETER(CQFC=2.0D0,CQIFC=-2.0D0/3.0D0,CGFC=16.0D0/3.0D0,
15420 & CGIFC=-2.0D0/3.0D0)
15424 C--flavour of the final-state quark (1 is down-type and 2 is up-type)
15427 C--calculate qqbar---> q'q'barZ
15428 DCF(1) = HWH2DD(4,2,1,3,4,5,6)
15429 DCF(2) = HWH2DD(5,2,1,3,4,5,6)
15430 DCF(3) = HWH2DD(4,3,4,2,1,5,6)
15431 DCF(4) = HWH2DD(5,3,4,2,1,5,6)
15432 DCF(5) = HWH2DD(4,3,1,2,4,5,6)
15433 DCF(6) = HWH2DD(5,3,1,2,4,5,6)
15434 DCF(7) = HWH2DD(4,2,4,3,1,5,6)
15435 DCF(8) = HWH2DD(5,2,4,3,1,5,6)
15442 C--calculate the matrix element, N.B. two possibe colour flows
15446 MQAMP(1)= G(IDZ,P3)*(
15447 & G(ID(I),P1)*(DCF(1)*HWH2T4(2,1,3,4,OZ(P3,1),OZ(P3,2),P1,P2)
15448 & +DCF(2)*HWH2T5(2,1,3,4,OZ(P3,1),OZ(P3,2),P1,P2))
15449 & +G(IQ,P2)*(DCF(3)*HWH2T4(3,4,2,1,OZ(P3,1),OZ(P3,2),P2,P1)
15450 & +DCF(4)*HWH2T5(3,4,2,1,OZ(P3,1),OZ(P3,2),P2,P1)))
15451 IF(ID(I).NE.IQI) THEN
15454 MQAMP(2)= G(IDZ,P3)*(
15455 & G(IQ,P1)*(DCF(5)*HWH2T4(3,1,2,4,OZ(P3,1),OZ(P3,2),P1,P2)
15456 & +DCF(6)*HWH2T5(3,1,2,4,OZ(P3,1),OZ(P3,2),P1,P2))
15457 & +G(IQ,P2)*(DCF(7)*HWH2T4(2,4,3,1,OZ(P3,1),OZ(P3,2),P2,P1)
15458 & +DCF(8)*HWH2T5(2,4,3,1,OZ(P3,1),OZ(P3,2),P2,P1)))
15460 FLOW(I,1) = FLOW(I,1)+DBLE(MQAMP(1)*DCONJG(MQAMP(1)))
15463 IF(IQI.EQ.ID(I)) THEN
15464 FLOW(3,1) = FLOW(3,1)+DBLE(MQAMP(1)*DCONJG(MQAMP(1)))
15465 FLOW(3,2) = FLOW(3,2)+DBLE(MQAMP(2)*DCONJG(MQAMP(2)))
15466 IF(P1.EQ.P2) FLOW(3,3) = FLOW(3,3)
15467 & -TWO*DBLE(MQAMP(1)*DCONJG(MQAMP(2)))
15474 FLOW(I,1) = CQFC*FLOW(I,1)
15475 FLOW(I,2) = CQFC*FLOW(I,2)
15476 FLOW(I,3) = CQIFC*FLOW(I,3)
15478 C--now find the matrix elements
15484 IF(FLOW(K,J).NE.ZERO) MQ(J,I) = FLOW(K,J)*
15485 & (ONE+FLOW(K,3)/(FLOW(K,1)+FLOW(K,2)))
15488 C--calculate gg---> bbbarZ
15489 C--coefficients for the diagrams
15490 DCF(1) = HWH2DD( 6,3,4,1,2,5,6)
15491 DCF(2) = HWH2DD( 7,3,4,1,2,5,6)
15492 DCF(3) = HWH2DD( 8,3,4,1,2,5,6)
15493 DCF(4) = HWH2DD( 6,3,4,2,1,5,6)
15494 DCF(5) = HWH2DD( 7,3,4,2,1,5,6)
15495 DCF(6) = HWH2DD( 8,3,4,2,1,5,6)
15496 DCF(7) = HWH2DD( 9,3,4,1,2,5,6)
15497 DCF(8) = HWH2DD(10,3,4,1,2,5,6)
15498 C--helicity amplitudes
15504 & DCF(7)*HWH2T9(3,4,1,2,OZ(P4,1),OZ(P4,2),P3,P1,P2)
15505 & +DCF(8)*HWH2T0(3,4,1,2,OZ(P4,1),OZ(P4,2),P3,P1,P2)
15507 & DCF(7)*HWH2T9(3,4,1,2,OZ(P4,1),OZ(P4,2),P3,P2,P1)
15508 & +DCF(8)*HWH2T0(3,4,1,2,OZ(P4,1),OZ(P4,2),P3,P2,P1)
15509 MGAMP(1,P1,P2,P3,P4) = G(IDZ,P4)*G(IQ,P3)*(
15511 & +DCF(1)*HWH2T6(3,4,1,2,OZ(P4,1),OZ(P4,2),P3,P1,P2)
15512 & +DCF(2)*HWH2T7(3,4,1,2,OZ(P4,1),OZ(P4,2),P3,P1,P2)
15513 & +DCF(3)*HWH2T8(3,4,1,2,OZ(P4,1),OZ(P4,2),P3,P1,P2)
15515 MGAMP(2,P2,P1,P3,P4) = G(IDZ,P4)*G(IQ,P3)*(-TRPGL(2)
15516 & +DCF(4)*HWH2T6(3,4,2,1,OZ(P4,1),OZ(P4,2),P3,P1,P2)
15517 & +DCF(5)*HWH2T7(3,4,2,1,OZ(P4,1),OZ(P4,2),P3,P1,P2)
15518 & +DCF(6)*HWH2T8(3,4,2,1,OZ(P4,1),OZ(P4,2),P3,P1,P2))
15523 C--square to obtain the matrix element
15531 FLOW(1,1) = FLOW(1,1)+DBLE(MGAMP(1,P1,P2,P3,P4)*
15532 & DCONJG(MGAMP(1,P1,P2,P3,P4)))
15533 FLOW(1,2) = FLOW(1,2)+DBLE(MGAMP(2,P1,P2,P3,P4)*
15534 & DCONJG(MGAMP(2,P1,P2,P3,P4)))
15535 FLOW(1,3) = FLOW(1,3)+TWO*DBLE(MGAMP(1,P1,P2,P3,P4)*
15536 & DCONJG(MGAMP(2,P1,P2,P3,P4)))
15541 FLOW(1,1) = CGFC*FLOW(1,1)
15542 FLOW(1,2) = CGFC*FLOW(1,2)
15543 FLOW(1,3) = CGIFC*FLOW(1,3)
15545 MG(I) = FLOW(1,I)*(ONE+FLOW(1,3)/(FLOW(1,1)+FLOW(1,2)))
15549 *CMZ :- -14/03/01 09:03:25 by Peter Richardson
15550 *-- Author : Peter Richardson
15551 C-----------------------------------------------------------------------
15552 SUBROUTINE HWH2MQ(IQ,IDZ,MG,MQ)
15553 C-----------------------------------------------------------------------
15554 C Massive matrix elements for gg --> qqbarZ and qqbar --> qqbarZ
15555 C-----------------------------------------------------------------------
15556 INCLUDE 'HERWIG65.INC'
15557 INTEGER IQ,I,IDZ,P1,P2,PL,PB,PBB,O(2),J,IQI
15558 DOUBLE PRECISION MG(2),MQ(2,5),G(12,2),CQFC,CQIFC,CGFC,CGIFC,
15559 & PTMP(5,10),XMASS,PLAB,PRW,PCM,HWULDO,QBL,QBBL,Q2B,Q1B,Q2BB,
15560 & Q1BB,QM2,FLOW(3,3),PG,PBQB,PBBQBB,QM,PQ,Q1L,Q2L,
15561 & Q1LB,Q2LB,MQB(2,3),QBB
15562 DOUBLE COMPLEX S,D,FBB(2,2,8),FBBB(2,2,8),FBLL(2,2,8,8),MQP(2),
15563 & FBBLL(2,2,8,8),F1B(2,2,8,8),F1BB(2,2,8,8),F2B(2,2,8,8),
15564 & F2BB(2,2,8,8),DL(2,2),DCF(8),MGAMP(3),MQAMP(3,2,2,2,2),
15565 & MQQAMP(2,2,2,2,2),F1LL(2,2,8,8),F2LL(2,2,8,8)
15566 DATA DL/(1.0D0,0.0D0),(0.0D0,0.0D0),(0.0D0,0.0D0),(1.0D0,0.0D0)/
15569 COMMON/HWHEWS/S(8,8,2),D(8,8)
15570 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
15571 PARAMETER(CQFC=2.0D0,CQIFC=-2.0D0/3.0D0,CGFC=16.0D0/3.0D0,
15572 & CGIFC=-2.0D0/3.0D0)
15574 C--mass of the final-state quark
15577 C--first calculate the F functions we will need
15579 PTMP(I,1) = PCM(I,9)+PCM(I,5)+PCM(I,6)
15580 PTMP(I,2) = -PCM(I,10)-PCM(I,5)-PCM(I,6)
15581 PTMP(I,3) = PCM(I,9)-PCM(I,1)
15582 PTMP(I,4) = PCM(I,1)-PCM(I,10)
15583 PTMP(I,5) = PCM(I,9)-PCM(I,2)
15584 PTMP(I,6) = PCM(I,2)-PCM(I,10)
15585 PTMP(I,7) = PCM(I,9)
15586 PTMP(I,8) = -PCM(I,10)
15587 PTMP(I,9) = PCM(I,1)-PCM(I,5)-PCM(I,6)
15588 PTMP(I,10) =-PCM(I,2)+PCM(I,5)+PCM(I,6)
15590 CALL HWH2F3(8,FBLL , PTMP(1, 1),QM)
15591 CALL HWH2F3(8,FBBLL, PTMP(1, 2),QM)
15592 CALL HWH2F3(8,F1B , PTMP(1, 3),QM)
15593 CALL HWH2F3(8,F1BB , PTMP(1, 4),QM)
15594 CALL HWH2F3(8,F2B , PTMP(1, 5),QM)
15595 CALL HWH2F3(8,F2BB , PTMP(1, 6),QM)
15596 CALL HWH2F1(8,FBB ,3,PTMP(1, 7),QM)
15597 CALL HWH2F2(8,FBBB ,4,PTMP(1, 8),QM)
15598 CALL HWH2F3(8,F1LL , PTMP(1, 9),QM)
15599 CALL HWH2F3(8,F2LL , PTMP(1,10),QM)
15600 C--calculate the momenta squared for the denominators
15601 QBB = HALF/(QM2+HWULDO(PCM(1,9),PCM(1,10)))
15602 QBL = ONE/(HWULDO(PTMP(1,1),PTMP(1,1))-QM2)
15603 QBBL = ONE/(HWULDO(PTMP(1,2),PTMP(1,2))-QM2)
15604 Q1B = ONE/(HWULDO(PTMP(1,3),PTMP(1,3))-QM2)
15605 Q1BB = ONE/(HWULDO(PTMP(1,4),PTMP(1,4))-QM2)
15606 Q2B = ONE/(HWULDO(PTMP(1,5),PTMP(1,5))-QM2)
15607 Q2BB = ONE/(HWULDO(PTMP(1,6),PTMP(1,6))-QM2)
15608 Q1L = HWULDO(PTMP(1, 9),PTMP(1, 9))
15609 Q2L = HWULDO(PTMP(1,10),PTMP(1,10))
15610 Q1LB = ONE/(Q1L-QM2)
15611 Q2LB = ONE/(Q2L-QM2)
15614 C--first construct the massless momenta
15615 PBQB = HWULDO(PCM(1,3),PCM(1,9))
15616 PBBQBB = HWULDO(PCM(1,4),PCM(1,10))
15617 C--first gg --> q qbar Z
15618 C--calculate the denominators due gluon polaizations and massive quarks
15619 PG = 0.25D0/PBQB/PBBQBB/D(1,2)/D(1,2)
15620 C--and the denominators
15621 DCF(1) = FOUR*QBL*Q2BB
15622 DCF(2) = FOUR*QBL*Q1BB
15623 DCF(3) = FOUR*Q1B*Q2BB
15624 DCF(4) = FOUR*Q2B*Q1BB
15625 DCF(5) = FOUR*Q1B*QBBL
15626 DCF(6) = FOUR*Q2B*QBBL
15627 DCF(7) = TWO*QBL/D(1,2)
15628 DCF(8) = TWO*QBBL/D(1,2)
15629 C--now calculate the matrix elements we need
15638 C--first amplitude from notes
15639 MGAMP(1) = DCF(1)*(
15640 & ( G(IQ,O(PL))*FBB(PB, PL,6)*FBLL( PL ,P1,5,2)
15641 & +G(IQ, PL )*FBB(PB,O(PL),5)*FBLL(O(PL),P1,6,2))*
15642 & (F2BB( P1 , P2 ,1,1)*FBBB( P2 ,PBB,2)+
15643 & F2BB( P1 ,O(P2),1,2)*FBBB(O(P2),PBB,1))
15644 & +( G(IQ,O(PL))*FBB(PB, PL ,6)*FBLL( PL,O(P1),5,1)
15645 & +G(IQ, PL )*FBB(PB,O(PL),5)*FBLL(O(PL),O(P1),6,1))*
15646 & (F2BB(O(P1), P2 ,2,1)*FBBB( P2 ,PBB,2)+
15647 & F2BB(O(P1),O(P2),2,2)*FBBB(O(P2),PBB,1)))
15648 C--second amplitude from notes (1st with gluons interchanged)
15649 MGAMP(2) = DCF(2)*(
15650 & ( G(IQ,O(PL))*FBB(PB, PL ,6)*FBLL( PL , P2 ,5,1)
15651 & +G(IQ, PL )*FBB(PB,O(PL),5)*FBLL(O(PL), P2 ,6,1))*
15652 & (F1BB( P2 , P1 ,2,2)*FBBB( P1 ,PBB,1)+
15653 & F1BB( P2 ,O(P1),2,1)*FBBB(O(P1),PBB,2))
15654 & +( G(IQ,O(PL))*FBB(PB, PL ,6)*FBLL( PL ,O(P2),5,2)
15655 & +G(IQ, PL )*FBB(PB,O(PL),5)*FBLL(O(PL),O(P2),6,2))*
15656 & (F1BB(O(P2), P1 ,1,2)*FBBB( P1 ,PBB,1)+
15657 & F1BB(O(P2),O(P1),1,1)*FBBB(O(P1),PBB,2)))
15658 C--third amplitude from notes
15659 MGAMP(1) = MGAMP(1)+DCF(3)*(
15660 & G(IQ,O(PL))*( FBB(PB, P1 ,2)*F1B( P1 , PL ,1,6)
15661 & +FBB(PB,O(P1),1)*F1B(O(P1), PL ,2,6))*
15662 & (F2BB(PL, P2 ,5,1)*FBBB( P2 ,PBB,2)+
15663 & F2BB(PL,O(P2),5,2)*FBBB(O(P2),PBB,1))
15664 & +G(IQ, PL )*( FBB(PB, P1 ,2)*F1B( P1 ,O(PL),1,5)
15665 & +FBB(PB,O(P1),1)*F1B(O(P1),O(PL),2,5))*
15666 & (F2BB(O(PL), P2 ,6,1)*FBBB( P2 ,PBB,2)+
15667 & F2BB(O(PL),O(P2),6,2)*FBBB(O(P2),PBB,1)))
15668 C--fourth amplitude from notes (3rd with gluons interchanged)
15669 MGAMP(2) = MGAMP(2)+DCF(4)*(
15670 & G(IQ,O(PL))*( FBB(PB, P2 ,1)*F2B( P2 , PL ,2,6)
15671 & +FBB(PB,O(P2),2)*F2B(O(P2), PL ,1,6))*
15672 & (F1BB( PL , P1 ,5,2)*FBBB( P1 ,PBB,1)+
15673 & F1BB( PL ,O(P1),5,1)*FBBB(O(P1),PBB,2))
15674 & +G(IQ, PL )*( FBB(PB, P2 ,1)*F2B( P2 ,O(PL),2,5)
15675 & +FBB(PB,O(P2),2)*F2B(O(P2),O(PL),1,5))*
15676 & ( F1BB(O(PL), P1 ,6,2)*FBBB( P1 ,PBB,1)
15677 & +F1BB(O(PL),O(P1),6,1)*FBBB(O(P1),PBB,2)))
15678 C--fifth amplitude from notes
15679 MGAMP(1) = MGAMP(1)+DCF(5)*(
15680 & ( G(IQ,O(PL))*FBBLL( P2 , PL ,2,6)*FBBB( PL ,PBB,5)
15681 & +G(IQ, PL )*FBBLL( P2 ,O(PL),2,5)*FBBB(O(PL),PBB,6))*
15682 & ( FBB(PB, P1 ,2)*F1B( P1 , P2 ,1,1)
15683 & +FBB(PB,O(P1),1)*F1B(O(P1), P2 ,2,1))
15684 & +( G(IQ,O(PL))*FBBLL(O(P2), PL ,1,6)*FBBB( PL ,PBB,5)
15685 & +G(IQ, PL )*FBBLL(O(P2),O(PL),1,5)*FBBB(O(PL),PBB,6))*
15686 & ( FBB(PB, P1 ,2)*F1B( P1 ,O(P2),1,2)
15687 & +FBB(PB,O(P1),1)*F1B(O(P1),O(P2),2,2)))
15688 C--sixth amplitude from notes (5th with gluons interchanged)
15689 MGAMP(2) = MGAMP(2)+DCF(6)*(
15690 & ( G(IQ,O(PL))*FBBLL( P1 , PL ,1,6)*FBBB( PL ,PBB,5)
15691 & +G(IQ, PL )*FBBLL( P1 ,O(PL),1,5)*FBBB(O(PL),PBB,6))*
15692 & ( FBB(PB, P2 ,1)*F2B( P2 , P1 ,2,2)
15693 & +FBB(PB,O(P2),2)*F2B(O(P2), P1 ,1,2))
15694 & +( G(IQ,O(PL))*FBBLL(O(P1), PL ,2,6)*FBBB( PL ,PBB,5)
15695 & +G(IQ, PL )*FBBLL(O(P1),O(PL),2,5)*FBBB(O(PL),PBB,6))*
15696 & ( FBB(PB, P2 ,1)*F2B( P2 ,O(P1),2,1)
15697 & +FBB(PB,O(P2),2)*F2B(O(P2),O(P1),1,1)))
15698 C--seventh amplitude from notes (first non-Abelian one)
15699 MGAMP(3) = DCF(7)*DL(P1,P2)*S(1,2,P1)*S(1,2,O(P1))*(
15700 & G(IQ,O(PL))*FBB(PB, PL ,6)*
15701 & ( FBLL( PL ,1,5,1)*FBBB(1,PBB,1)
15702 & +FBLL( PL ,2,5,1)*FBBB(2,PBB,1)
15703 & -FBLL( PL ,1,5,2)*FBBB(1,PBB,2)
15704 & -FBLL( PL ,2,5,2)*FBBB(2,PBB,2))
15705 & +G(IQ, PL )*FBB(PB,O(PL),5)*
15706 & ( FBLL(O(PL),1,6,1)*FBBB(1,PBB,1)
15707 & +FBLL(O(PL),2,6,1)*FBBB(2,PBB,1)
15708 & -FBLL(O(PL),1,6,2)*FBBB(1,PBB,2)
15709 & -FBLL(O(PL),2,6,2)*FBBB(2,PBB,2)))
15710 C--eighth amplitude from notes (second non-Abelian one)
15711 C--bug fix 12/7/03 by PR (too many continuations for NAG)
15712 MGAMP(3) = MGAMP(3)
15713 & + DCF(8)*DL(P1,P2)*S(1,2,P1)*S(1,2,O(P1))*(
15714 & G(IQ,O(PL))*FBBB( PL ,PBB,5)*
15715 & ( FBB(PB,1,1)*FBBLL(1,PL,1,6)
15716 & +FBB(PB,2,1)*FBBLL(2,PL,1,6)
15717 & -FBB(PB,1,2)*FBBLL(1,PL,2,6)
15718 & -FBB(PB,2,2)*FBBLL(2,PL,2,6))
15719 & +G(IQ, PL )*FBBB(O(PL),PBB,6)*
15720 & ( FBB(PB,1,1)*FBBLL(1,O(PL),1,5)
15721 & +FBB(PB,2,1)*FBBLL(2,O(PL),1,5)
15722 & -FBB(PB,1,2)*FBBLL(1,O(PL),2,5)
15723 & -FBB(PB,2,2)*FBBLL(2,O(PL),2,5)))
15724 MGAMP(1) = G(IDZ,PL)*(MGAMP(1)+MGAMP(3))
15725 MGAMP(2) = G(IDZ,PL)*(MGAMP(2)-MGAMP(3))
15727 FLOW(1,1) = FLOW(1,1)+DBLE(MGAMP(1)*DCONJG(MGAMP(1)))
15728 FLOW(1,2) = FLOW(1,2)+DBLE(MGAMP(2)*DCONJG(MGAMP(2)))
15729 FLOW(1,3) = FLOW(1,3)+TWO*DBLE(MGAMP(1)*DCONJG(MGAMP(2)))
15735 C--add up the diagrams to obtain the amplitudes for the two colour flows
15736 FLOW(1,1) = CGFC*FLOW(1,1)
15737 FLOW(1,2) = CGFC*FLOW(1,2)
15738 FLOW(1,3) = CGIFC*FLOW(1,3)
15740 IF(FLOW(1,3).NE.ZERO) THEN
15741 MG(I) = PG*FLOW(1,I)*(ONE+FLOW(1,3)/(FLOW(1,1)+FLOW(1,2)))
15743 MG(I) = PG*FLOW(1,I)
15746 C--now q qbar --> q qbar Z
15747 C--calculate the denominators
15748 DCF(1) = -TWO*QBL/D(1,2)
15749 DCF(2) = -TWO*QBBL/D(1,2)
15750 DCF(3) = -TWO*Q1L*QBB
15751 DCF(4) = +TWO*Q2L*QBB
15752 DCF(5) = TWO*Q1LB*Q2BB
15753 DCF(6) = -TWO*Q2LB*Q1B
15754 DCF(7) = TWO*QBL*Q2BB
15755 DCF(8) = -TWO*QBBL*Q1B
15756 PQ = ONE/PBQB/PBBQBB
15761 C--first the amplitudes for q qbar --> q' q'bar Z
15762 C--the first two amplitudes have Z off the final state and therefore
15763 C--the flavour of the incoming quarks doesn't matter
15764 C--first amplitude from notes
15765 MQAMP(3,P1,PL,PB,PBB) = G(IDZ,PL)*(
15766 & DCF(1)*(G(IQ,O(PL))*FBB(O(PB), PL ,6)*
15767 & ( FBLL( PL , P1 ,5,1)*FBBB( P1 ,O(PBB),2)
15768 & +FBLL( PL ,O(P1),5,2)*FBBB(O(P1),O(PBB),1))
15769 & +G(IQ, PL )*FBB(O(PB),O(PL),5)*
15770 & ( FBLL(O(PL), P1 ,6,1)*FBBB( P1 ,O(PBB),2)
15771 & +FBLL(O(PL),O(P1),6,2)*FBBB(O(P1),O(PBB),1)))
15772 C--second amplitide from notes
15773 & +DCF(2)*(G(IQ,O(PL))*FBBB( PL ,O(PBB),5)*
15774 & ( FBB(O(PB), P1 ,1)*FBBLL( P1 , PL ,2,6)
15775 & +FBB(O(PB),O(P1),2)*FBBLL(O(P1), PL ,1,6))
15776 & +G(IQ, PL )*FBBB(O(PL),O(PBB),6)*
15777 & ( FBB(O(PB), P1 ,1)*FBBLL( P1 ,O(PL),2,5)
15778 & +FBB(O(PB),O(P1),2)*FBBLL(O(P1),O(PL),1,5))))
15779 C--third amplitide from notes
15781 MQAMP(I,P1,PL,PB,PBB) =
15782 & DCF(3)*(G(I,O(PL))*DL(P1,O(PL))*S(5,1, PL )*(
15783 & S(1,6,O(PL))*( FBB(O(PB), P1 ,1)*FBBB( P1 ,O(PBB),2)
15784 & +FBB(O(PB),O(P1),2)*FBBB(O(P1),O(PBB),1))
15785 & -S(5,6,O(PL))*( FBB(O(PB), P1 ,5)*FBBB( P1 ,O(PBB),2)
15786 & +FBB(O(PB),O(P1),2)*FBBB(O(P1),O(PBB),5)))
15787 & +G(I, PL )*DL(P1, PL )*S(6,1,O(PL))*(
15788 & S(1,5, PL )*( FBB(O(PB), P1 ,1)*FBBB( P1 ,O(PBB),2)
15789 & +FBB(O(PB),O(P1),2)*FBBB(O(P1),O(PBB),1))
15790 & -S(6,5, PL )*( FBB(O(PB), P1 ,6)*FBBB( P1 ,O(PBB),2)
15791 & +FBB(O(PB),O(P1),2)*FBBB(O(P1),O(PBB),6))))
15792 C--fourth amplitude from notes
15793 MQAMP(I,P1,PL,PB,PBB) = MQAMP(I,P1,PL,PB,PBB)
15794 & +DCF(4)*(G(I,O(PL))*DL(P1,O(PL))*S(2,6, P1 )*(
15795 & S(5,2, PL )*( FBB(O(PB), P1 ,1)*FBBB( P1 ,O(PBB),2)
15796 & +FBB(O(PB),O(P1),2)*FBBB(O(P1),O(PBB),1))
15797 & -S(5,6, PL )*( FBB(O(PB), P1 ,1)*FBBB( P1 ,O(PBB),6)
15798 & +FBB(O(PB),O(P1),6)*FBBB(O(P1),O(PBB),1)))
15799 & +G(I, PL )*DL(P1, PL )*S(2,5, P1 )*(
15800 & S(6,2,O(PL))*( FBB(O(PB), P1 ,1)*FBBB( P1 ,O(PBB),2)
15801 & +FBB(O(PB),O(P1),2)*FBBB(O(P1),O(PBB),1))
15802 & -S(6,5,O(PL))*( FBB(O(PB), P1 ,1)*FBBB( P1 ,O(PBB),5)
15803 & +FBB(O(PB),O(P1),5)*FBBB(O(P1),O(PBB),1))))
15804 MQAMP(I,P1,PL,PB,PBB) = G(IDZ,PL)*MQAMP(I,P1,PL,PB,PBB)
15806 C--now the extra amplitudes for q qbar --> q qbar Z
15808 C--first amplitude for notes
15809 MQQAMP(P1,P2,PL,PB,PBB) =
15810 & DCF(5)*(DL(P2,PBB)*S(8,4,PBB)*(
15811 & G(IQ,O(PL))*DL(P1,O(PL))*S(5,1, PL )*
15812 & ( FBB(O(PB), PBB,8)*F1LL( P2 , PL ,2,6)
15813 & +FBB(O(PB),O(P2),2)*F1LL(O(PBB), PL ,8,6))
15814 & +G(IQ, PL )*DL(P1, PL )*S(6,1,O(PL))*
15815 & ( FBB(O(PB), PBB ,8)*F1LL( P2 ,O(PL),2,5)
15816 & +FBB(O(PB),O(P2) ,2)*F1LL(O(PBB),O(PL),8,5)))
15817 & -QM*DL(P2,O(PBB))*(
15818 & G(IQ,O(PL))*DL(P1,O(PL))*S(5,1,PL)*
15819 & ( FBB(O(PB),O(PBB),8)*F1LL( P2 , PL ,2,6)
15820 & +FBB(O(PB),O(P2) ,2)*F1LL( PBB , PL ,8,6))
15821 & +G(IQ, PL )*DL(P1, PL )*S(6,1,O(PL))*
15822 & ( FBB(O(PB),O(PBB),8)*F1LL( P2 ,O(PL),2,5)
15823 & +FBB(O(PB), O(P2),2)*F1LL( PBB ,O(PL),8,5))))
15824 C--second amplitude from notes
15825 MQQAMP(P1,P2,PL,PB,PBB) = MQQAMP(P1,P2,PL,PB,PBB)
15826 & +DCF(6)*(DL(P1,PB)*S(3,7,O(PB))*(
15827 & G(IQ,O(PL))*DL(P2,O(PL))*S(2,6, P2 )*
15828 & ( F2LL( PL , P1 ,5,1)*FBBB( PB ,O(PBB),7)
15829 & +F2LL( PL ,O(PB),5,7)*FBBB(O(P1),O(PBB),1))
15830 & +G(IQ, PL )*DL(P2, PL )*S(2,5, P2 )*
15831 & ( F2LL(O(PL), P1 ,6,1)*FBBB( PB ,O(PBB),7)
15832 & +F2LL(O(PL),O(PB),6,7)*FBBB(O(P1),O(PBB),1)))
15833 & -QM*DL(P1,O(PB))*(
15834 & G(IQ,O(PL))*DL(P2,O(PL))*S(2,6, P2 )*
15835 & ( F2LL( PL , P1 ,5,1)*FBBB(O(PB),O(PBB),7)
15836 & +F2LL( PL , PB ,5,7)*FBBB(O(P1),O(PBB),1))
15837 & +G(IQ, PL )*DL(P2, PL )*S(2,5, P2 )*
15838 & ( F2LL(O(PL), P1 ,6,1)*FBBB(O(PB),O(PBB),7)
15839 & +F2LL(O(PL), PB ,6,7)*FBBB(O(P1),O(PBB),1))))
15840 C--third amplitude from notes
15841 MQQAMP(P1,P2,PL,PB,PBB) = MQQAMP(P1,P2,PL,PB,PBB)
15842 & +DCF(7)*(DL(P2,PBB)*S(8,4,PBB)*(
15843 & G(IQ,O(PL))*FBB(O(PB), PL ,6)*
15844 & ( DL(P2,O(P1) )*S(2,1, P2 )*FBLL( PL , PBB ,5,8)
15845 & +DL(P1,PBB )*S(8,1,O(PBB))*FBLL( PL ,O(P2),5,2))
15846 & +G(IQ, PL )*FBB(O(PB),O(PL),5)*
15847 & ( DL(P2,O(P1) )*S(2,1, P2 )*FBLL(O(PL), PBB ,6,8)
15848 & +DL(P1,PBB )*S(8,1,O(PBB))*FBLL(O(PL),O(P2),6,2)))
15849 & -QM*DL(P2,O(PBB))*(
15850 & G(IQ,O(PL))*FBB(O(PB),PL,6)*
15851 & ( DL(P2,O(P1) )*S(2,1, P2 )*FBLL( PL ,O(PBB),5,8)
15852 & +DL(P1,O(PBB))*S(8,1, PBB )*FBLL( PL ,O(P2) ,5,2))
15853 & +G(IQ, PL )*FBB(O(PB),O(PB),5)*
15854 & ( DL(P2,O(PL) )*S(2,1, P2 )*FBLL(O(PL),O(PBB),6,8)
15855 & +DL(P1,O(PBB))*S(8,1, PBB )*FBLL(O(PL),O(P2) ,6,2))))
15856 C--fourth amplitude from notes
15857 MQQAMP(P1,P2,PL,PB,PBB) = MQQAMP(P1,P2,PL,PB,PBB)
15858 & +DCF(8)*(DL(P1,PB)*S(3,7,O(PB))*(
15859 & DL(P1,O(P2))*S(2,1,P2)*
15860 & ( G(IQ,O(PL))*FBBLL(PB, PL ,7,6)*FBBB( PL ,O(PBB),5)
15861 & +G(IQ, PL )*FBBLL(PB,O(PL),7,5)*FBBB(O(PL),O(PBB),6))
15862 & +DL(P2,PB)*S(2,7,P2)*
15863 & (G(IQ,O(PL))*FBBLL(O(P1), PL ,1,6)*FBBB( PL ,O(PBB),5)
15864 & +G(IQ, PL )*FBBLL(O(P1),O(PL),1,5)*FBBB(O(PL),O(PBB),6)))
15865 & +QM*DL(P1,O(PB))*(
15866 & DL(P2,O(P1))*S(2,1,P2)*
15867 & ( G(IQ,O(PL))*FBBLL(O(PB), PL ,3,6)*FBBB( PL ,O(PBB),5)
15868 & +G(IQ, PL )*FBBLL(O(PB),O(PL),3,5)*FBBB(O(PL),O(PBB),6))
15869 & +DL(P2,O(PB))*S(2,3,P2)*
15870 & ( G(IQ,O(PL))*FBBLL(O(P1), PL ,1,6)*FBBB( PL ,O(PBB),5)
15871 & +G(IQ, PL )*FBBLL(O(P1),O(PL),1,5)*FBBB(O(PL),O(PBB),6))))
15872 MQQAMP(P1,P2,PL,PB,PBB) = G(IDZ,PL)*MQQAMP(P1,P2,PL,PB,PBB)
15878 C--now obtain the matrix elements squared for the quarks
15884 IF(MOD(IQ,2).EQ.1) THEN
15893 C--different quarks in inital and final states
15895 MQP(I) = MQAMP(I,P1,PL,PB,PBB)+MQAMP(3,P1,PL,PB,PBB)
15896 FLOW(I,1) = FLOW(I,1)+DCONJG(MQP(I))*MQP(I)
15898 C--same quark in inital and final state
15900 FLOW(3,2) = FLOW(3,2)+
15901 & DCONJG(MQQAMP(P1,P2,PL,PB,PBB))*MQQAMP(P1,P2,PL,PB,PBB)
15903 FLOW(3,1) = FLOW(3,1)+
15904 & DCONJG(MQP(IQI))*MQP(IQI)
15905 FLOW(3,3) = FLOW(3,3)-TWO*
15906 & DCONJG(MQP(IQI))*MQQAMP(P1,P2,PL,PB,PBB)
15913 C--split up the non-planar pieces according to Kosuke's prescription
15915 FLOW(I,1) = CQFC*FLOW(I,1)
15916 FLOW(I,2) = CQFC*FLOW(I,2)
15917 FLOW(I,3) = CQIFC*FLOW(I,3)
15919 IF(FLOW(I,J).NE.ZERO) THEN
15920 MQB(J,I) = PQ*FLOW(I,J)*
15921 & (ONE+FLOW(I,3)/(FLOW(I,1)+FLOW(I,2)))
15933 ELSEIF(MOD(I,2).EQ.1) THEN
15945 *CMZ :- -14/03/01 09:03:25 by Peter Richardson
15946 *-- Author : Peter Richardson
15947 C-----------------------------------------------------------------------
15948 SUBROUTINE HWH2PS(WEIGHT,GEN,MQ,MQ2)
15949 C-----------------------------------------------------------------------
15950 C Phase Space for vector boson plus 2 jets
15951 C-----------------------------------------------------------------------
15952 INCLUDE 'HERWIG65.INC'
15953 DOUBLE PRECISION WEIGHT,XMASS,PLAB,PRW,PCM,Y(3),Y35,Y34,Y45,RAND,
15954 & HWRGEN,HWRUNI,M35,M35S,G(IMAXCH),DEM,MT(3),PT(3),MJAC,ETOT,
15955 & STOT,MQ(3),MQ2(3),PS35,HWUPCM,TWOPI2,MT35,PTJ(3),MT2(3),A,C,
15956 & PT2(3),YMIN,YMAX,EY(3),EY34,YJAC,YJJMAX,YJJMIN,EY35,PHI(3),
15957 & MT45,PS45,EY45,M45,M45S,M34,PS34,M34S,MT34,XJAC,SJAC,PST,TAU,
15958 & FLUX,ETMP,PZTMP,XT1,XT2,WI(IMAXCH)
15961 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
15963 EXTERNAL HWRGEN,HWRUNI,HWUPCM
15964 PARAMETER(YJJMIN=-8.0D0,YJJMAX=8.0D0)
15965 IF(IERROR.NE.0) RETURN
15966 TWOPI2 = FOUR*PIFAC**2
15974 C--centre of mass energy
15977 C--first select the channel to be used
15981 IF(CHNPRB(ICH).GT.RAND) GOTO 10
15982 RAND = RAND-CHNPRB(ICH)
15986 C--generate the phase space according to the channel selected
15989 C--first generate the mass of 35
15990 CALL HWH2P1(2,MJAC,MQ2(1),M35S,(ETOT-MQ(2))**2,(MQ(1)+MQ(3))**2)
15992 PS35 = HWUPCM(M35,MQ(1),MQ(3))
15993 MJAC = HALF*MJAC*PS35/M35/TWOPI2
15994 C--the generate the PT of 4
15995 CALL HWH2P2(2,PTJ(1),MT2(2),MQ2(2)+PTMAX**2,MQ2(2)+PTMIN**2)
15996 MT (2) = SQRT(MT2(2))
15997 PT2(2) = MT2(2)-MQ2(2)
15998 PT(2) = SQRT(PT2(2))
15999 MT35 = SQRT(M35S+PT2(2))
16000 C--generate the rapidities of 4 and 35
16001 YMAX = MIN(YJJMAX, LOG(PHEP(5,3)/MT35))
16002 YMIN = MAX(YJJMIN,-LOG(PHEP(5,3)/MT35))
16003 IF(YMAX.LT.YMIN) RETURN
16004 Y35 = HWRUNI(1,YMIN,YMAX)
16007 YMAX = MIN(YJMAX, LOG((PHEP(5,3)-MT35*EY35)/MT(2)))
16008 YMIN = MAX(YJMIN,-LOG((PHEP(5,3)-MT35/EY35)/MT(2)))
16009 IF(YMAX.LT.YMIN) RETURN
16010 Y(2) = HWRUNI(2,YMIN,YMAX)
16011 YJAC = (YMAX-YMIN)*YJAC
16013 C--generate the incoming quark momentum fractions
16014 XX(1) = (MT(2)*EY(2)+MT35*EY35)/ETOT
16015 XX(2) = (MT(2)/EY(2)+MT35/EY35)/ETOT
16016 STOT = XX(1)*XX(2)*STOT
16017 C--azimuthal angle of 4 and 35
16018 PHI(1) = HWRUNI(3,ZERO,TWO*PIFAC)
16019 C--construct the momenta of 4 and 35
16020 PLAB(1,4) = PT(2)*SIN(PHI(1))
16021 PLAB(2,4) = PT(2)*COS(PHI(1))
16022 PLAB(3,4) = HALF*MT(2)*(EY(2)-ONE/EY(2))
16023 PLAB(4,4) = HALF*MT(2)*(EY(2)+ONE/EY(2))
16025 PLAB(1,6) =-PT(2)*SIN(PHI(1))
16026 PLAB(2,6) =-PT(2)*COS(PHI(1))
16027 PLAB(3,6) = HALF*MT35*(EY35-ONE/EY35)
16028 PLAB(4,6) = HALF*MT35*(EY35+ONE/EY35)
16030 C--perform the decay 35 --> 3+5
16033 CALL HWDTWO(PLAB(1,6),PLAB(1,3),PLAB(1,5),PS35,TWO,.TRUE.)
16034 C--phase space weight
16035 FLUX = MJAC*YJAC*PTJ(1)/16.0D0/PIFAC/STOT**2
16037 ELSEIF(ICH.EQ.2) THEN
16038 C--first generate the pt's and azimuthal angles of 3 and 4
16040 CALL HWH2P2(2,PTJ(I),MT2(I),MQ2(I)+PTMAX**2,MQ2(I)+PTMIN**2)
16041 PT2(I) = MT2(I)-MQ2(I)
16042 MT(I) = SQRT(MT2(I))
16043 PT(I) = SQRT(PT2(I))
16044 PHI(I) = HWRUNI(I,ZERO,TWO*PIFAC)
16046 C--find the pt and azimuth of 5 by conservation of transverse momentum
16047 A = PT(1)*SIN(PHI(1))+PT(2)*SIN(PHI(2))
16048 C = PT(1)*COS(PHI(1))+PT(2)*COS(PHI(2))
16050 MT(3) = SQRT(PT(3)+MQ2(3))
16051 PT(3) = SQRT(PT(3))
16052 PHI(3) = -ACOS(-C/PT(3))
16053 IF(A.LT.ZERO) PHI(3)=-PHI(3)
16054 C--generate the rapidities of 3,4 and 5
16059 YMAX = MIN(YJMAX, LOG((PHEP(5,3)-XX(1))/MT(I)))
16060 YMIN = MAX(YJMIN,-LOG((PHEP(5,3)-XX(2))/MT(I)))
16061 IF(YMAX.LT.YMIN) RETURN
16062 Y(I) = HWRUNI(I+2,YMIN,YMAX)
16064 XX(1) = XX(1)+MT(I)*EY(I)
16065 XX(2) = XX(2)+MT(I)/EY(I)
16066 YJAC = YJAC*(YMAX-YMIN)
16068 C--generate the incoming quark momentum fractions
16069 XX(1) = XX(1)/PHEP(5,3)
16070 XX(2) = XX(2)/PHEP(5,3)
16071 IF(XX(1).GT.ONE.OR.XX(2).GT.ONE) RETURN
16072 C--Construct the 4-momenta of the outgoing particles
16074 PLAB(1,I+2) = PT(I)*SIN(PHI(I))
16075 PLAB(2,I+2) = PT(I)*COS(PHI(I))
16076 PLAB(3,I+2) = HALF*MT(I)*(EY(I)-ONE/EY(I))
16077 PLAB(4,I+2) = HALF*MT(I)*(EY(I)+ONE/EY(I))
16078 PLAB(5,I+2) = MQ(I)
16080 C--phase space weight
16081 STOT = XX(1)*XX(2)*STOT
16082 FLUX = YJAC*PTJ(1)*PTJ(2)/64.0D0/PIFAC/TWOPI2/STOT**2
16084 ELSEIF(ICH.EQ.3) THEN
16085 C--first generate the mass of 45
16086 CALL HWH2P1(2,MJAC,MQ2(2),M45S,(ETOT-MQ(1))**2,(MQ(2)+MQ(3))**2)
16088 PS45 = HWUPCM(M45,MQ(2),MQ(3))
16089 MJAC = HALF*MJAC*PS45/M45/TWOPI2
16090 C--the generate the PT of 4
16091 CALL HWH2P2(2,PTJ(1),MT2(1),MQ2(1)+PTMAX**2,MQ2(1)+PTMIN**2)
16092 MT (1) = SQRT(MT2(1))
16093 PT2(1) = MT2(1)-MQ2(1)
16094 PT(1) = SQRT(PT2(1))
16095 MT45 = SQRT(M45S+PT2(1))
16096 C--generate the rapidities of 3 and 45
16097 YMAX = MIN(YJJMAX, LOG(PHEP(5,3)/MT45))
16098 YMIN = MAX(YJJMIN,-LOG(PHEP(5,3)/MT45))
16099 IF(YMAX.LT.YMIN) RETURN
16100 Y45 = HWRUNI(1,YMIN,YMAX)
16103 YMAX = MIN(YJMAX, LOG((PHEP(5,3)-MT45*EY45)/MT(1)))
16104 YMIN = MAX(YJMIN,-LOG((PHEP(5,3)-MT45/EY45)/MT(1)))
16105 IF(YMAX.LT.YMIN) RETURN
16106 Y(1) = HWRUNI(2,YMIN,YMAX)
16107 YJAC = (YMAX-YMIN)*YJAC
16109 C--generate the incoming quark momentum fractions
16110 XX(1) = (MT(1)*EY(1)+MT45*EY45)/ETOT
16111 XX(2) = (MT(1)/EY(1)+MT45/EY45)/ETOT
16112 STOT = XX(1)*XX(2)*STOT
16113 C--azimuthal angle of 3 and 45
16114 PHI(1) = HWRUNI(3,ZERO,TWO*PIFAC)
16115 C--construct the momenta of 3 and 45
16116 PLAB(1,3) = PT(1)*SIN(PHI(1))
16117 PLAB(2,3) = PT(1)*COS(PHI(1))
16118 PLAB(3,3) = HALF*MT(1)*(EY(1)-ONE/EY(1))
16119 PLAB(4,3) = HALF*MT(1)*(EY(1)+ONE/EY(1))
16121 PLAB(1,6) =-PT(1)*SIN(PHI(1))
16122 PLAB(2,6) =-PT(1)*COS(PHI(1))
16123 PLAB(3,6) = HALF*MT45*(EY45-ONE/EY45)
16124 PLAB(4,6) = HALF*MT45*(EY45+ONE/EY45)
16126 C--perform the decay 45 --> 4+5
16129 CALL HWDTWO(PLAB(1,6),PLAB(1,4),PLAB(1,5),PS45,TWO,.TRUE.)
16130 C--phase space weight
16131 FLUX = MJAC*YJAC*PTJ(1)/16.0D0/PIFAC/STOT**2
16133 ELSEIF(ICH.EQ.4) THEN
16134 C--generate shat according to a power law
16135 CALL HWHGB1(1,2,200,SJAC,STOT,PHEP(5,3)**2,
16136 & (MQ(1)+MQ(2)+MQ(3))**2)
16139 TAU = STOT/PHEP(5,3)**2
16141 XX(1) = EXP(HWRUNI(2,LOG(TAU),ZERO))
16144 CALL HWH2P1(2,MJAC,MQ2(1),M35S,(ETOT-MQ(2))**2,
16145 & (MQ(1)+MQ(3))**2)
16147 PS35 = HWUPCM(M35,MQ(1),MQ(3))
16148 MJAC = HALF*MJAC*PS35/M35/TWOPI2
16149 C--generate the momenta of 4 and 35
16150 PST = HWUPCM(ETOT,M35,MQ(2))
16153 PLAB(3,7) = HALF*(XX(1)-XX(2))*PHEP(5,3)
16154 PLAB(4,7) = HALF*(XX(1)+XX(2))*PHEP(5,3)
16159 CALL HWDTWO(PLAB(1,7),PLAB(1,4),PLAB(1,6),PST,TWO,.TRUE.)
16160 C--perform the decay 35 --> 3+5
16163 CALL HWDTWO(PLAB(1,6),PLAB(1,3),PLAB(1,5),PS35,TWO,.TRUE.)
16164 C--phase space weight
16165 FLUX = SJAC*XJAC*MJAC*PST/ETOT/STOT**2/8.0D0/PIFAC
16167 ELSEIF(ICH.EQ.5) THEN
16168 C--generate shat according to a power law
16169 CALL HWHGB1(1,2,200,SJAC,STOT,PHEP(5,3)**2,
16170 & (MQ(1)+MQ(2)+MQ(3))**2)
16173 TAU = STOT/PHEP(5,3)**2
16175 XX(1) = EXP(HWRUNI(2,LOG(TAU),ZERO))
16178 CALL HWH2P1(2,MJAC,MQ2(2),M45S,(ETOT-MQ(1))**2,(MQ(2)+MQ(3))**2)
16180 PS45 = HWUPCM(M45,MQ(2),MQ(3))
16181 MJAC = HALF*MJAC*PS45/M45/TWOPI2
16182 C--generate the momenta of 4 and 35
16183 PST = HWUPCM(ETOT,M45,MQ(1))
16186 PLAB(3,7) = HALF*(XX(1)-XX(2))*PHEP(5,3)
16187 PLAB(4,7) = HALF*(XX(1)+XX(2))*PHEP(5,3)
16191 CALL HWDTWO(PLAB(1,7),PLAB(1,3),PLAB(1,6),PST,TWO,.TRUE.)
16192 C--perform the decay 45 --> 4+5
16195 CALL HWDTWO(PLAB(1,6),PLAB(1,4),PLAB(1,5),PS45,TWO,.TRUE.)
16196 C--phase space weight
16197 FLUX = SJAC*XJAC*MJAC*PST/ETOT/STOT**2/8.0D0/PIFAC
16199 ELSEIF(ICH.EQ.6) THEN
16200 C--first generate the mass of 34
16201 CALL HWH2P1(2,MJAC,ZERO,M34S,(ETOT-MQ(3))**2,MJJMIN**2)
16203 PS34 = HWUPCM(M34,MQ(1),MQ(2))
16204 MJAC = HALF*MJAC*PS34/M34/TWOPI2
16205 C--the generate the PT of 5
16206 CALL HWH2P2(2,PTJ(1),MT2(3),MQ2(3)+PTMAX**2,MQ2(3))
16207 MT (3) = SQRT(MT2(3))
16208 PT2(3) = MT2(3)-MQ2(3)
16209 PT(3) = SQRT(PT2(3))
16210 MT34 = SQRT(M34S+PT2(3))
16211 C--generate the rapidities of 5 and 34
16212 YMAX = MIN(YJJMAX, LOG(PHEP(5,3)/MT34))
16213 YMIN = MAX(YJJMIN,-LOG(PHEP(5,3)/MT34))
16214 IF(YMAX.LT.YMIN) RETURN
16215 Y34 = HWRUNI(1,YMIN,YMAX)
16218 YMAX = MIN(YJMAX, LOG((PHEP(5,3)-MT34*EY34)/MT(3)))
16219 YMIN = MAX(YJMIN,-LOG((PHEP(5,3)-MT34/EY34)/MT(3)))
16220 IF(YMAX.LT.YMIN) RETURN
16221 Y(3) = HWRUNI(2,YMIN,YMAX)
16222 YJAC = (YMAX-YMIN)*YJAC
16224 C--generate the incoming quark momentum fractions
16225 XX(1) = (MT(3)*EY(3)+MT34*EY34)/ETOT
16226 XX(2) = (MT(3)/EY(3)+MT34/EY34)/ETOT
16227 STOT = XX(1)*XX(2)*STOT
16228 C--azimuthal angle of 3 and 45
16229 PHI(1) = HWRUNI(3,ZERO,TWO*PIFAC)
16230 C--construct the momenta of 5 and 34
16231 PLAB(1,5) = PT(3)*SIN(PHI(1))
16232 PLAB(2,5) = PT(3)*COS(PHI(1))
16233 PLAB(3,5) = HALF*MT(3)*(EY(3)-ONE/EY(3))
16234 PLAB(4,5) = HALF*MT(3)*(EY(3)+ONE/EY(3))
16236 PLAB(1,6) =-PT(3)*SIN(PHI(1))
16237 PLAB(2,6) =-PT(3)*COS(PHI(1))
16238 PLAB(3,6) = HALF*MT34*(EY34-ONE/EY34)
16239 PLAB(4,6) = HALF*MT34*(EY34+ONE/EY34)
16241 C--perform the decay 34 --> 3+4
16244 CALL HWDTWO(PLAB(1,6),PLAB(1,3),PLAB(1,4),PS34,TWO,.TRUE.)
16245 C--phase space weight
16246 FLUX = MJAC*YJAC*PTJ(1)/16.0D0/PIFAC/STOT**2
16248 CALL HWWARN('HWH2PS',500,*999)
16250 C--calculate the variables we need for the smoothing functions
16251 C--pt,mt and y for outgoing particles
16254 PT2(I) = PLAB(1,J)**2+PLAB(2,J)**2
16255 PT(I) = SQRT(PT2(I))
16256 MT2(I) = MQ2(I)+PT2(I)
16257 MT(I) = SQRT(MT2(I))
16258 Y(I) = HALF*LOG((PLAB(4,J)+PLAB(3,J))/(PLAB(4,J)-PLAB(3,J)))
16260 IF(I.LE.2.AND.(Y(I).LT.YJMIN.OR.Y(I).GT.YJMAX)) RETURN
16262 IF(PT(1).LT.PTMIN.OR.PT(2).LT.PTMIN) RETURN
16263 C--masses of composite particles
16264 M34S = (PLAB(4,3)+PLAB(4,4))**2
16265 M45S = (PLAB(4,4)+PLAB(4,5))**2
16266 M35S = (PLAB(4,3)+PLAB(4,5))**2
16268 M34S = M34S-(PLAB(I,3)+PLAB(I,4))**2
16269 M45S = M45S-(PLAB(I,4)+PLAB(I,5))**2
16270 M35S = M35S-(PLAB(I,3)+PLAB(I,5))**2
16275 IF(M34.LT.MJJMIN) RETURN
16276 C--tramsverse masses of the composite particles
16281 MT34 = MT34+(PLAB(I,3)+PLAB(I,4))**2
16282 MT35 = MT35+(PLAB(I,3)+PLAB(I,5))**2
16283 MT45 = MT45+(PLAB(I,4)+PLAB(I,5))**2
16285 MT34 = SQRT(M34S+MT34)
16286 MT35 = SQRT(M35S+MT35)
16287 MT45 = SQRT(M45S+MT45)
16288 C--final the momenta
16289 PS34 = HWUPCM(M34,MQ(1),MQ(2))
16290 PS35 = HWUPCM(M35,MQ(1),MQ(3))
16291 PS45 = HWUPCM(M45,MQ(2),MQ(3))
16292 C--the rapidities of the composite particles
16293 ETMP = PLAB(4,3)+PLAB(4,4)
16294 PZTMP = PLAB(3,3)+PLAB(3,4)
16295 Y34 = HALF*LOG((ETMP+PZTMP)/(ETMP-PZTMP))
16297 ETMP = PLAB(4,3)+PLAB(4,5)
16298 PZTMP = PLAB(3,3)+PLAB(3,5)
16299 Y35 = HALF*LOG((ETMP+PZTMP)/(ETMP-PZTMP))
16301 ETMP = PLAB(4,4)+PLAB(4,5)
16302 PZTMP = PLAB(3,4)+PLAB(3,5)
16303 Y45 = HALF*LOG((ETMP+PZTMP)/(ETMP-PZTMP))
16305 C--find the pdf's and set the scale
16308 CALL HWSGEN(.FALSE.)
16309 C--construct the incoming momenta
16313 PLAB(3,I) = HALF*XX(I)*PHEP(5,3)
16314 PLAB(4,I) = HALF*XX(I)*PHEP(5,3)
16317 PLAB(3,2) = -PLAB(3,2)
16319 C--find the smoothing functions for the different channels
16320 C--function for first channel
16322 CALL HWH2P1(1,MJAC,MQ2(1),M35S,(PHEP(5,3)-MQ(2))**2,
16323 & (MQ(1)+MQ(3))**2)
16324 MJAC = MJAC/PS35*M35
16325 CALL HWH2P2(1,PTJ(1),MT2(2),PTMAX**2+MQ2(2),MQ2(2)+PTMIN**2)
16326 YMAX = MIN(YJJMAX, LOG(PHEP(5,3)/MT35))
16327 YMIN = MAX(YJJMIN,-LOG(PHEP(5,3)/MT35))
16329 YMAX = MIN(YJMAX, LOG((PHEP(5,3)-MT35*EY35)/MT(2)))
16330 YMIN = MAX(YJMIN,-LOG((PHEP(5,3)-MT35/EY35)/MT(2)))
16331 YJAC = (YMAX-YMIN)*YJAC
16332 G(1) = 2.0D0*MJAC*PTJ(1)/YJAC
16334 C--function for second channel
16337 CALL HWH2P2(1,PTJ(I),MT2(I),PTMAX**2+MQ2(I),MQ2(I)+PTMIN**2)
16343 YMAX = MIN(YJMAX, LOG((PHEP(5,3)-XT1)/MT(I)))
16344 YMIN = MAX(YJMIN,-LOG((PHEP(5,3)-XT2)/MT(I)))
16345 XT1 = XT1+MT(I)*EY(I)
16346 XT2 = XT2+MT(I)/EY(I)
16347 YJAC = YJAC*(YMAX-YMIN)
16349 G(2) = 4.0D0*PTJ(1)*PTJ(2)/YJAC
16351 C--function for third channel
16353 CALL HWH2P1(1,MJAC,MQ2(2),M45S,(PHEP(5,3)-MQ(1))**2,
16354 & (MQ(2)+MQ(3))**2)
16355 MJAC = MJAC/PS45*M45
16356 CALL HWH2P2(1,PTJ(1),MT2(1),PTMAX**2+MQ2(1),MQ2(1)+PTMIN**2)
16357 YMAX = MIN(YJJMAX, LOG(PHEP(5,3)/MT45))
16358 YMIN = MAX(YJJMIN,-LOG(PHEP(5,3)/MT45))
16360 YMAX = MIN(YJMAX, LOG((PHEP(5,3)-MT45*EY45)/MT(1)))
16361 YMIN = MAX(YJMIN,-LOG((PHEP(5,3)-MT45/EY45)/MT(1)))
16362 YJAC = (YMAX-YMIN)*YJAC
16363 G(3) = 2.0D0*MJAC*PTJ(1)/YJAC
16365 C--function for fourth channel
16367 CALL HWHGB1(1,1,200,SJAC,STOT,PHEP(5,3)**2,
16368 & (MQ(1)+MQ(2)+MQ(3))**2)
16370 CALL HWH2P1(1,MJAC,MQ2(1),M35S,(ETOT-MQ(2))**2,(MQ(1)+MQ(3))**2)
16372 MJAC = MJAC/PS35*M35
16373 PST = HWUPCM(ETOT,M35,MQ(2))
16374 G(4) = SJAC*MJAC/XJAC*ETOT/PST
16376 C--function for fifth channel
16378 CALL HWHGB1(1,1,200,SJAC,STOT,PHEP(5,3)**2,
16379 & (MQ(1)+MQ(2)+MQ(3))**2)
16381 CALL HWH2P1(1,MJAC,MQ2(2),M45S,(ETOT-MQ(1))**2,(MQ(2)+MQ(3))**2)
16382 MJAC = MJAC/PS45*M45
16383 PST = HWUPCM(ETOT,M45,MQ(1))
16384 G(5) = SJAC/XJAC*MJAC/PST*ETOT
16386 C--function for sixth chaneel
16388 CALL HWH2P1(1,MJAC,ZERO,M34S,(PHEP(5,3)-MQ(3))**2,MJJMIN**2)
16389 MJAC = MJAC/PS34*M34
16390 CALL HWH2P2(1,PTJ(1),MT2(3),MQ2(3)+PTMAX**2,MQ2(3))
16391 YMAX = MIN(YJJMAX, LOG(PHEP(5,3)/MT34))
16392 YMIN = MAX(YJJMIN,-LOG(PHEP(5,3)/MT34))
16394 YMAX = MIN(YJMAX, LOG((PHEP(5,3)-MT34*EY34)/MT(3)))
16395 YMIN = MAX(YJMIN,-LOG((PHEP(5,3)-MT34/EY34)/MT(3)))
16396 YJAC = (YMAX-YMIN)*YJAC
16397 G(6) = 2.0D0*MJAC/YJAC*PTJ(1)
16402 IF(CHON(I)) DEM = DEM+CHNPRB(I)*G(I)
16405 WEIGHT = FLUX*GEV2NB*G(ICH)/DEM
16407 C--compute the weights for the different channels if optimizing
16410 IF(CHON(I)) WI(I)=G(I)*WEIGHT**2/DEM
16415 *CMZ :- -02/04/01 12.11.55 by Peter Richardson
16416 *-- Author : Peter Richardson
16417 C-----------------------------------------------------------------------
16418 SUBROUTINE HWH2P1(IOPT,FJAC,MQ2,M2,MMX,MMN)
16419 C-----------------------------------------------------------------------
16420 C Subroutine to select virtual quark mass for HWH2PS
16421 C IOPT=1 return the function at M2
16422 C IOPT=2 calculate M2
16423 C-----------------------------------------------------------------------
16424 INCLUDE 'HERWIG65.INC'
16426 DOUBLE PRECISION FJAC,MPOW,MMN,MQ2,M2,A1,A01,RPOW,QPOW,HWRGEN,MMX
16428 C--smooth a powerlaw
16429 IF(EMPOW.EQ.TWO) THEN
16431 A1 = LOG(MMX-MQ2)-A01
16433 FJAC = ONE/(M2-MQ2)/A1
16435 M2 = EXP(A01+A1*HWRGEN(2))
16443 A01 = (MMN-MQ2)**QPOW
16444 A1 = (MMX-MQ2)**QPOW-A01
16446 FJAC = QPOW*(M2-MQ2)**MPOW/A1
16448 M2 = (A01+A1*HWRGEN(2))**RPOW
16449 FJAC = A1*RPOW/M2**MPOW
16455 *CMZ :- -02/04/01 12.11.55 by Peter Richardson
16456 *-- Author : Peter Richardson
16457 C-----------------------------------------------------------------------
16458 SUBROUTINE HWH2P2(IOPT,FJAC,PT2,PTMX2,PTMN2)
16459 C-----------------------------------------------------------------------
16460 C Subroutine to select virtual quark mass for HWH2PS
16461 C IOPT=1 return the function at M2
16462 C IOPT=2 calculate M2
16463 C-----------------------------------------------------------------------
16464 INCLUDE 'HERWIG65.INC'
16466 DOUBLE PRECISION FJAC,MPOW,A1,A01,RPOW,QPOW,HWRGEN,PT2,
16467 & PPOW,PTMN2,PTMX2,Z
16469 C--smooth a powerlaw
16471 IF(PPOW.EQ.ONE) THEN
16473 A1 = LOG(PTMX2)-A01
16477 PT2 = EXP(A01+A1*HWRGEN(2))
16485 A1 = PTMX2**QPOW-A01
16487 FJAC = QPOW*PT2**MPOW/A1
16489 Z = A01+A1*HWRGEN(2)
16491 FJAC = A1*RPOW/Z*PT2
16496 *CMZ :- -26/11/00 17.21.55 by Bryan Webber
16497 *-- Author : Kosuke Odagiri
16498 C-----------------------------------------------------------------------
16499 SUBROUTINE HWH2QH(SQS,P1,P2,P3,P4,P5,RM3,RM4,RM5,FACGPM,MGM3,
16500 & IGG,IQQ,GGQQHT,GGQQHU,GGQQHNP,QQQQH)
16501 C-----------------------------------------------------------------------
16502 C MATRIX ELEMENT SQUARED FOR THE PROCESS GG/QQ(BAR) -> QQ(BAR) HIGGS
16503 C-----------------------------------------------------------------------
16504 C NEEDS PREFACTOR G_S^4. COUPLINGS, E.G. FOR T(3)B(4)H-(5) ARE:
16505 C FACGPM(1) = GW/SQRT(TWO) M_B / M_W * TANB
16506 C FACGPM(2) = GW/SQRT(TWO) M_T / M_W / TANB
16507 C MGM3 = (TOP MASS)*(TOP WIDTH)
16508 C INITIAL STATE MOMENTA: P1=(SQS/2)(1,0,0,1), P2=(SQS/2)(1,0,0,-1)
16510 C GGQQHTOT = (G_S**4)*(GGQQHT+GGQQHU-GGQQHNP/CAFAC**2)/(8.*CFFAC)
16511 C QQQQHTOT = (G_S**4)*(QQQQH )*(1.-1./CAFAC**2)/4.
16512 C N.B. SUBROUTINE CANNOT BE USED FOR PHOTON PHOTON -> ...
16513 C-----------------------------------------------------------------------
16517 C --- CENTRE-OF-MASS ENERGY, FOUR-MOMENTA, MASSES AND WIDTHS
16518 DOUBLE PRECISION SQS,P1(0:3),P2(0:3),P3(0:3),P4(0:3),P5(0:3)
16519 DOUBLE PRECISION K3(0:3),K4(0:3), Q3(0:3),Q4(0:3), R3(0:3),R4(0:3)
16520 DOUBLE PRECISION RM3,RM4,RM5, MGM3,MGM4, TWOSQS
16522 DOUBLE COMPLEX U0(4), F3(4,2),F4(4,2), F3K(4,2),F4K(4,2)
16523 DOUBLE COMPLEX F3Q(4,2,2),F4Q(4,2,2), F3R(4,2,2),F4R(4,2,2)
16524 C --- MOMENTUM PROJECTION OPERATORS
16525 DOUBLE COMPLEX P3PROJ(4,4),P4PROJ(4,4),K3PROJ(4,4),K4PROJ(4,4)
16526 DOUBLE COMPLEX Q3PROJ(4,4),Q4PROJ(4,4),R3PROJ(4,4),R4PROJ(4,4)
16527 C --- SPINOR INDICES AND PERMUTATION MATRICES
16528 INTEGER I,J,K,L, PERM0(4), PL(4,2),PR(4,2), PERMU0(4)
16529 C --- CHIRALITY PROJECTION OPERATORS: 1 = - , 2 = +
16530 DOUBLE PRECISION FACGPM(2),FACL(2,2),FACR(2,2),FAC0(2,2)
16531 C --- GG AMPLITUDES
16532 DOUBLE COMPLEX AMPS1(2,2),AMPS2(2,2)
16533 DOUBLE COMPLEX AMPT1(2,2,2,2),AMPT2(2,2,2,2),AMPT3(2,2,2,2)
16534 DOUBLE COMPLEX AMPU1(2,2,2,2),AMPU2(2,2,2,2),AMPU3(2,2,2,2)
16535 DOUBLE COMPLEX AMPS, AMPT, AMPU, AMPST, AMPSU, AMPTU
16536 DOUBLE PRECISION AMPST2, AMPSU2, AMPTU2
16537 DOUBLE PRECISION GGQQHT,GGQQHU,GGQQHNP,QQQQH
16538 C --- QQ AMPLITUDES
16539 DOUBLE PRECISION RM3452
16540 DOUBLE PRECISION S,PT32,PT42,PT52,GLAMBDA,LAMBDA,LAMBDAI,LA34,
16541 & PROP2,PROP3R,PROP3I,PROP4R,PROP4I,PROP34R,PT3452
16542 DOUBLE COMPLEX PROP3,PROP4,PROP
16544 DOUBLE PRECISION ZERO,ONE,TWO,MONE,FAC
16545 DOUBLE COMPLEX CZERO,CONE
16547 C --- PARAMETER DEFINITIONS
16548 PARAMETER (ZERO=0.D0,ONE=1.D0,TWO=2.D0,MONE=-ONE, LEFT=1,RIGHT=2)
16549 PARAMETER (CZERO=(0.D0,0.D0),CONE=(1.D0,0.D0))
16550 DATA MGM4,U0,FAC0 /ZERO, 4*CONE , ONE,ZERO, ZERO, ONE /
16551 DATA PERM0 ,PERMU0 / 1,2, 3,4 , 1,0, 0,4 /
16552 DATA PL ,PR / 0,3, 0,1, 4,0, 2,0, 4,0, 2,0, 0,3, 0,1 /
16553 DATA FACL ,FACR /MONE, ONE, ONE,MONE, ONE,MONE, MONE, ONE /
16554 SAVE MGM4,PERM0,PL,FACL,PR,FACR,PERMU0,FAC0,U0
16561 IF(IGG.EQ.0)GOTO 100
16564 Q3(I) = P3(I)-P1(I)
16565 Q4(I) = P4(I)-P2(I)
16566 R3(I) = P3(I)-P2(I)
16567 R4(I) = P4(I)-P1(I)
16568 K3(I) = P3(I)+P5(I)
16569 K4(I) = P4(I)+P5(I)
16571 CALL HWUMPO(P3, RM3, (P3(0)-P3(3)) ,ZERO,P3PROJ, .FALSE.)
16572 CALL HWUMPO(P4,-RM4, (P4(0)+P4(3)) ,ZERO,P4PROJ, .FALSE.)
16573 CALL HWUMPO(Q3, RM3,-SQS*(P3(0)-P3(3)) ,ZERO,Q3PROJ, .FALSE.)
16574 CALL HWUMPO(Q4,-RM4,-SQS*(P4(0)+P4(3)) ,ZERO,Q4PROJ, .FALSE.)
16575 CALL HWUMPO(R3, RM3,-SQS*(P3(0)+P3(3)) ,ZERO,R3PROJ, .FALSE.)
16576 CALL HWUMPO(R4,-RM4,-SQS*(P4(0)-P4(3)) ,ZERO,R4PROJ, .FALSE.)
16577 CALL HWUMPO(K3, RM4,SQS*(SQS-2.D0*P4(0)),MGM4,K3PROJ, .TRUE.)
16578 CALL HWUMPO(K4,-RM3,SQS*(SQS-2.D0*P3(0)),MGM3,K4PROJ, .TRUE.)
16580 CALL HWUMPP(P3PROJ,FAC0(1,I),PERMU0 ,U0 ,F3(1,I) , LEFT)
16581 CALL HWUMPP(K3PROJ,FACGPM ,PERM0 ,F3(1,I),F3K(1,I) , LEFT)
16582 CALL HWUMPP(P4PROJ,FAC0(1,I),PERMU0 ,U0 ,F4(1,I) , RIGHT)
16583 CALL HWUMPP(K4PROJ,FACGPM ,PERM0 ,F4(1,I),F4K(1,I) , RIGHT)
16585 CALL HWUMPP(Q3PROJ,FACL(1,J),PL(1,J),F3(1,I),F3Q(1,I,J), LEFT)
16586 CALL HWUMPP(R3PROJ,FACL(1,J),PL(1,J),F3(1,I),F3R(1,I,J), LEFT)
16587 CALL HWUMPP(R4PROJ,FACR(1,J),PR(1,J),F4(1,I),F4R(1,I,J), RIGHT)
16588 CALL HWUMPP(Q4PROJ,FACR(1,J),PR(1,J),F4(1,I),F4Q(1,I,J), RIGHT)
16593 AMPS1(I,J)=( - F3K(1,I)* F4(3,J) + F3K(2,I)* F4(4,J)
16594 & + F3K(3,I)* F4(1,J) - F3K(4,I)* F4(2,J) ) * TWOSQS
16595 AMPS2(I,J)=( - F3(1,I)*F4K(3,J) + F3(2,I)*F4K(4,J)
16596 & + F3(3,I)*F4K(1,J) - F3(4,I)*F4K(2,J) ) * TWOSQS
16598 AMPT1(1,K,I,J)= F3K(1,I)*F4Q(4,J,K)-F3K(3,I)*F4Q(2,J,K)
16599 AMPT1(2,K,I,J)=-F3K(2,I)*F4Q(3,J,K)+F3K(4,I)*F4Q(1,J,K)
16600 AMPT3(K,1,I,J)= F3Q(1,I,K)*F4K(4,J)-F3Q(3,I,K)*F4K(2,J)
16601 AMPT3(K,2,I,J)=-F3Q(2,I,K)*F4K(3,J)+F3Q(4,I,K)*F4K(1,J)
16602 AMPU1(K,1,I,J)= F3K(1,I)*F4R(4,J,K)-F3K(3,I)*F4R(2,J,K)
16603 AMPU1(K,2,I,J)=-F3K(2,I)*F4R(3,J,K)+F3K(4,I)*F4R(1,J,K)
16604 AMPU3(1,K,I,J)= F3R(1,I,K)*F4K(4,J)-F3R(3,I,K)*F4K(2,J)
16605 AMPU3(2,K,I,J)=-F3R(2,I,K)*F4K(3,J)+F3R(4,I,K)*F4K(1,J)
16608 & = FACGPM(1)*( F3Q(1,I,K)*F4Q(1,J,L)+F3Q(2,I,K)*F4Q(2,J,L) )
16609 & + FACGPM(2)*( F3Q(3,I,K)*F4Q(3,J,L)+F3Q(4,I,K)*F4Q(4,J,L) )
16611 & = FACGPM(1)*( F3R(1,I,K)*F4R(1,J,L)+F3R(2,I,K)*F4R(2,J,L) )
16612 & + FACGPM(2)*( F3R(3,I,K)*F4R(3,J,L)+F3R(4,I,K)*F4R(4,J,L) )
16625 AMPS = AMPS1(K,L) - AMPS2(K,L)
16629 AMPT = AMPT1(I,J,K,L)+AMPT2(I,J,K,L)+AMPT3(I,J,K,L)
16630 AMPU = AMPU1(I,J,K,L)+AMPU2(I,J,K,L)+AMPU3(I,J,K,L)
16631 AMPST = AMPS - AMPT
16632 AMPSU = AMPS + AMPU
16633 AMPTU = AMPT + AMPU
16634 AMPST2 = AMPST2 + DREAL(DCONJG(AMPST)*AMPST)
16635 AMPSU2 = AMPSU2 + DREAL(DCONJG(AMPSU)*AMPSU)
16636 AMPTU2 = AMPTU2 + DREAL(DCONJG(AMPTU)*AMPTU)
16641 FAC = (P3(0)-P3(3))*(P4(0)+P4(3))
16642 GGQQHT = FAC*AMPST2
16643 GGQQHU = FAC*AMPSU2
16644 GGQQHNP = FAC*AMPTU2
16647 IF(IQQ.EQ.0)GOTO 200
16649 PT32 = P3(1)**2+P3(2)**2
16650 PT42 = P4(1)**2+P4(2)**2
16651 PT52 = P5(1)**2+P5(2)**2
16652 PT3452 = (PT32+PT42-PT52)/TWO
16653 RM3452 = (RM3**2+RM4**2-RM5**2)/TWO
16654 GLAMBDA = FACGPM(1)**2+FACGPM(2)**2
16655 LAMBDA = TWO*FACGPM(1)*FACGPM(2)/GLAMBDA
16656 LAMBDAI = (FACGPM(2)**2-FACGPM(1)**2)/GLAMBDA
16657 LA34 = S/TWO-SQS*P5(0)-RM3452-LAMBDA*RM3*RM4
16658 PROP3 = ONE/DCMPLX(SQS*(SQS-TWO*P4(0)),ZERO)
16659 PROP4 = ONE/DCMPLX(SQS*(SQS-TWO*P3(0)),MGM3)
16661 PROP2 = DREAL(DCONJG(PROP)*PROP)
16662 PROP3R = DREAL(DCONJG(PROP)*PROP3)
16663 PROP3I = DIMAG(DCONJG(PROP)*PROP3)
16664 PROP4R = DREAL(DCONJG(PROP)*PROP4)
16665 PROP4I = DIMAG(DCONJG(PROP)*PROP4)
16666 PROP34R = DREAL(DCONJG(PROP3)*PROP4)
16667 QQQQH = TWO*GLAMBDA/S*(S*PROP2*(PT3452+TWO*P3(0)*P4(0)-
16668 & LA34)+TWO*LA34*(PROP3R*PT42+PROP4R*PT32-PROP34R*PT52)-TWO*SQS*((
16669 & PROP3R*(P3(0)*PT42+P4(0)*PT3452)+PROP4R*(P4(0)*PT32+P3(0)*PT3452)
16670 & )-(PROP3I*P4(3)-PROP4I*P3(3))*LAMBDAI*(P3(1)*P4(2)-P3(2)*P4(1))))
16675 *CMZ :- -30/06/01 18.25.35 by Stefano Moretti
16676 *-- Author : Kosuke Odagiri & Stefano Moretti
16677 C-----------------------------------------------------------------------
16678 SUBROUTINE HWH2SH(SQS,P1,P2,P3,P4,P5,RM3,RM4,RM5,MGM3,MGM4,
16679 & IGG,IQQ,GGSQHT,GGSQHU,GGSQHN,QQSQH)
16680 C-----------------------------------------------------------------------
16681 C MATRIX ELEMENT SQUARED FOR THE PROCESS GG/QQ(BAR) -> SQ SQ* HIGGS
16682 C-----------------------------------------------------------------------
16683 C NEEDS PREFACTOR G_S^4 AND G_(HIGGS-SQ-SQ)^2
16684 C MGM3, MGM4 = MASS * WIDTH
16685 C INITIAL STATE MOMENTA: P1=(SQS/2)(1,0,0,1), P2=(SQS/2)(1,0,0,-1)
16688 C (G_S**4)*(G_HIGGS**2)*(GGSQHT+GGSQHU-GGSQHN/CAFAC**2)/(8.*CFFAC)
16690 C (G_S**4)*(G_HIGGS**2)*(QQSQH )*(1.-1./CAFAC**2)/4.
16691 C N.B. SUBROUTINE CANNOT BE USED FOR PHOTON PHOTON -> ...
16693 C...First release: 08-OCT-1999 by Kosuke Odagiri
16694 C...First modified: 12-NOV-1999 by Stefano Moretti
16695 C-----------------------------------------------------------------------
16699 C --- CENTRE-OF-MASS ENERGY, FOUR-MOMENTA, MASSES AND WIDTHS
16700 DOUBLE PRECISION SQS,P1(0:3),P2(0:3),P3(0:3),P4(0:3),P5(0:3)
16701 DOUBLE PRECISION RM3,RM4,RM5, MGM3,MGM4
16702 C --- POLARISATION INDICES, PROPAGATORS AND GG AMPLITUDES
16704 DOUBLE PRECISION G14,G24,G23,G13,MSQS, GGSQHT,GGSQHU,GGSQHN
16705 DOUBLE COMPLEX G35,G45, AMPT,AMPU,AMPS,AMPC, AMPST,AMPSU,AMPTU
16706 C --- QQ AMPLITUDES
16707 DOUBLE PRECISION QQSQH
16708 DOUBLE PRECISION PT32,PT42,PT34
16709 DOUBLE COMPLEX PROP3,PROP4
16710 C --- CONSTANT PARAMETERS
16711 DOUBLE PRECISION ZERO,ONE,TWO,SQTWO,MSQTWO
16712 PARAMETER (ZERO=0.D0,ONE=1.D0,TWO=2.D0)
16719 IF(IGG.EQ.0)GOTO 100
16720 C -- GG SCATTERING.
16722 G13 = MSQS/(P3(0)-P3(3))
16723 G23 = MSQS/(P3(0)+P3(3))
16724 G14 = MSQS/(P4(0)-P4(3))
16725 G24 = MSQS/(P4(0)+P4(3))
16726 G35 = SQTWO/CMPLX(SQS*(SQS-TWO*P4(0)),MGM4)
16727 G45 = SQTWO/CMPLX(SQS*(SQS-TWO*P3(0)),MGM3)
16728 AMPS = 0.5D0*MSQS*(P4(3)*G35-P3(3)*G45)
16729 AMPC = MSQTWO*(G35+G45)
16732 AMPT=P3(I)*P4(J)*G24*G13-P4(I)*P4(J)*G24*G35-P3(I)*P3(J)*G13*G45
16733 AMPU=P4(I)*P3(J)*G14*G23-P4(I)*P4(J)*G14*G35-P3(I)*P3(J)*G23*G45
16735 AMPST = AMPT-AMPS+AMPC
16736 AMPSU = AMPU+AMPS+AMPC
16741 AMPTU = AMPST+AMPSU
16742 GGSQHT = GGSQHT + DREAL(DCONJG(AMPST)*AMPST)
16743 GGSQHU = GGSQHU + DREAL(DCONJG(AMPSU)*AMPSU)
16744 GGSQHN = GGSQHN + DREAL(DCONJG(AMPTU)*AMPTU)
16748 IF(IQQ.EQ.0)GOTO 200
16749 C -- QQ SCATTERING.
16750 PT32 = P3(1)**2+P3(2)**2
16751 PT42 = P4(1)**2+P4(2)**2
16752 PT34 = P3(1)*P4(1)+P3(2)*P4(2)
16753 PROP3 = ONE/CMPLX(SQS*(SQS-TWO*P3(0)),MGM3)
16754 PROP4 = ONE/CMPLX(SQS*(SQS-TWO*P4(0)),MGM4)
16755 QQSQH = TWO/SQS**2*DREAL(PT32*DCONJG(PROP3)*PROP3+
16756 & PT42*DCONJG(PROP4)*PROP4-TWO*PT34*DCONJG(PROP3)*PROP4)
16761 *CMZ :- -27/02/01 17:04:16 by Peter Richardson
16762 C-----------------------------------------------------------------------
16763 SUBROUTINE HWH2SS(S,K,KK)
16764 C-----------------------------------------------------------------------
16765 C Subroutine to calculate the spinor products in the notation of
16766 C Kleiss and Strirling S(1) is S and S(2) is T
16767 C-----------------------------------------------------------------------
16768 INCLUDE 'HERWIG65.INC'
16769 DOUBLE PRECISION WRN(2),K(5),KK(5),P(5,2),Q1,Q2,EPS,QTI,PTI,
16770 & PT,QT,DPM,DMP,QP,QM,P1,P2,PP,PM
16771 DOUBLE COMPLEX S(2),ZI,Z1,ZT,ZQ,ZQS,ZPS,ZP,ZDPM,ZDMP
16774 ZI=DCMPLX(ZERO,ONE)
16775 Z1=DCMPLX(ONE,ZERO)
16776 C FOLLOWING DO LOOP IS TO CONVERT TO OUR STANDARD INDEXING
16783 IF(P(4,II).LT.ZERO) WRN(II)=-ONE
16785 P(JJ,II)=WRN(II)*P(JJ,II)
16787 C THE ABOVE CHECKS FOR MOMENTA WITH NEGATIVE ENERGY,INNER PRODUCTS
16788 C ARE EXPRESSED DIFFERENTLY FOR DIFFERENT CASES
16791 IF(Q1.GT.EPS) QP=SQRT(Q1)
16794 IF(Q2.GT.EPS)QM=SQRT(Q2)
16797 IF(P1.GT.EPS)PP=SQRT(P1)
16800 IF(P2.GT.EPS)PM=SQRT(P2)
16802 ZDMP=DCMPLX(DMP,ZERO)
16804 ZDPM=DCMPLX(DPM,ZERO)
16805 C NOTE THAT IN OUR INNER PRODUCT NOTATION WE ARE COMPUTING <P,Q>
16806 PT=SQRT(P(2,2)**2+P(3,2)**2)
16807 QT=SQRT(P(2,1)**2+P(3,1)**2)
16808 IF(PT.GT.EPS) GOTO 99
16812 ZP=DCMPLX(PTI*P(2,2),PTI*P(3,2))
16814 IF(QT.GT.EPS) GOTO 89
16818 ZQ=DCMPLX(QTI*P(2,1),QTI*P(3,1))
16821 IF(WRN(1).LT.ZERO) ZT=ZT*ZI
16822 IF(WRN(2).LT.ZERO) ZT=ZT*ZI
16823 S(2)=-(ZDMP*ZP-ZDPM*ZQ)*ZT
16824 S(1)=(ZDMP*ZPS-ZDPM*ZQS)*ZT
16827 *CMZ :- -27/02/01 17:04:16 by Peter Richardson
16828 *-- Author : Peter Richardson
16829 C-----------------------------------------------------------------------
16830 FUNCTION HWH2T1(I,J,K,L,Z1,Z2,P1)
16831 C-----------------------------------------------------------------------
16832 C Returns the amplitude T1 from Nucl. Phys. B262 (1985) 235-262
16833 C I-L are the particles
16834 C Z1 and Z2 are the decay products of the Z
16835 C P1 is the polarization of the line I,J
16836 C-----------------------------------------------------------------------
16837 INCLUDE 'HERWIG65.INC'
16838 DOUBLE COMPLEX HWH2T1,S,D
16839 INTEGER I,J,K,L,Z1,Z2,P1
16840 COMMON/HWHEWS/S(8,8,2),D(8,8)
16842 HWH2T1 = TWO*S(I,Z2,1)*S(Z1,J,2)
16843 ELSEIF(P1.EQ.2) THEN
16844 HWH2T1 = TWO*S(I,Z1,2)*S(Z2,J,1)
16846 CALL HWWARN('HWH2T1',500,*999)
16850 *CMZ :- -27/02/01 17:04:16 by Peter Richardson
16851 *-- Author : Peter Richardson
16852 C-----------------------------------------------------------------------
16853 FUNCTION HWH2T2(I,J,K,L,Z1,Z2,P1,P2)
16854 C-----------------------------------------------------------------------
16855 C Returns the amplitude T2 from Nucl. Phys. B262 (1985) 235-262
16856 C I-L are the particles
16857 C Z1 and Z2 are the decay products of the Z
16858 C P1 is the polarization of the line I,J
16859 C P2 is the polarization of the gluon K
16860 C-----------------------------------------------------------------------
16861 INCLUDE 'HERWIG65.INC'
16862 DOUBLE COMPLEX HWH2T2,S,D
16863 INTEGER I,J,K,L,Z1,Z2,P1,P2
16864 DOUBLE PRECISION B(6)
16865 DATA B/-1.0D0,-1.0D0,1.0D0,1.0D0,1.0D0,1.0D0/
16866 COMMON/HWHEWS/S(8,8,2),D(8,8)
16867 IF(P1.EQ.1.AND.P2.EQ.1) THEN
16868 HWH2T2 = FOUR*B(J)*S(I,Z2,1)*S(Z1,J,2)*S(J,K,1)*S(I,J,2)
16869 ELSEIF(P1.EQ.1.AND.P2.EQ.2) THEN
16870 HWH2T2 = FOUR*S(I,Z2,1)*S(K,J,2)*(B(J)*S(Z1,J,2)*S(J,I,1)
16871 & +B(K)*S(Z1,K,2)*S(K,I,1))
16872 ELSEIF(P1.EQ.2.AND.P2.EQ.1) THEN
16873 HWH2T2 = FOUR*S(I,Z1,2)*S(K,J,1)*(B(J)*S(Z2,J,1)*S(J,I,2)
16874 & +B(K)*S(Z2,K,1)*S(K,I,2))
16875 ELSEIF(P1.EQ.2.AND.P2.EQ.2) THEN
16876 HWH2T2 = FOUR*B(J)*S(I,Z1,2)*S(Z2,J,1)*S(J,K,2)*S(I,J,1)
16878 CALL HWWARN('HWH2T2',500,*999)
16882 *CMZ :- -27/02/01 17:04:16 by Peter Richardson
16883 *-- Author : Peter Richardson
16884 C-----------------------------------------------------------------------
16885 FUNCTION HWH2T3(I,J,K,L,Z1,Z2,P1,P2)
16886 C-----------------------------------------------------------------------
16887 C Returns the amplitude T3 from Nucl. Phys. B262 (1985) 235-262
16888 C I-L are the particles
16889 C Z1 and Z2 are the decay products of the Z
16890 C P1 is the polarization of the line I,J
16891 C P2 is the polarization of the gluon K
16892 C-----------------------------------------------------------------------
16893 INCLUDE 'HERWIG65.INC'
16894 DOUBLE COMPLEX HWH2T3,S,D
16895 INTEGER I,J,K,L,Z1,Z2,P1,P2
16896 DOUBLE PRECISION B(6)
16897 DATA B/-1.0D0,-1.0D0,1.0D0,1.0D0,1.0D0,1.0D0/
16898 COMMON/HWHEWS/S(8,8,2),D(8,8)
16899 IF(P1.EQ.1.AND.P2.EQ.1) THEN
16900 HWH2T3 = FOUR*B(K)*S(I,K,1)*S(I,K,2)*S(K,Z2,1)*S(Z1,J,2)
16901 ELSEIF(P1.EQ.1.AND.P2.EQ.2) THEN
16903 ELSEIF(P1.EQ.2.AND.P2.EQ.1) THEN
16905 ELSEIF(P1.EQ.2.AND.P2.EQ.2) THEN
16906 HWH2T3 = FOUR*B(K)*S(I,K,2)*S(I,K,1)*S(K,Z1,2)*S(Z2,J,1)
16908 CALL HWWARN('HWH2T3',500,*999)
16912 *CMZ :- -27/02/01 17:04:16 by Peter Richardson
16913 *-- Author : Peter Richardson
16914 C-----------------------------------------------------------------------
16915 FUNCTION HWH2T4(I,J,K,L,Z1,Z2,P1,P2)
16916 C-----------------------------------------------------------------------
16917 C Returns the amplitude T4 from Nucl. Phys. B262 (1985) 235-262
16918 C I-L are the particles
16919 C Z1 and Z2 are the decay products of the Z
16920 C P1 is the polarization of the line I,J
16921 C P2 is the polarization of the line K,L
16922 C-----------------------------------------------------------------------
16923 INCLUDE 'HERWIG65.INC'
16924 DOUBLE COMPLEX HWH2T4,AP,AM,S,D
16925 INTEGER I,J,K,L,Z1,Z2,J1,J2,J3,J4,P1,P2
16926 DOUBLE PRECISION B(6)
16927 DATA B/-1.0D0,-1.0D0,1.0D0,1.0D0,1.0D0,1.0D0/
16928 COMMON/HWHEWS/S(8,8,2),D(8,8)
16929 AP(J1,J2,J3,J4) = FOUR*S(J1,Z2,1)*S(J4,J2,2)*
16930 & (S(Z1,Z2,2)*S(Z2,J3,1)+B(J1)*S(Z1,J1,2)*S(J1,J3,1))
16931 AM(J1,J2,J3,J4) = FOUR*S(J1,Z1,2)*S(J4,J2,1)*
16932 & (S(Z2,Z1,1)*S(Z1,J3,2)+B(J1)*S(Z2,J1,1)*S(J1,J3,2))
16933 IF(P1.EQ.1.AND.P2.EQ.1) THEN
16934 HWH2T4 = AP(I,J,K,L)
16935 ELSEIF(P1.EQ.1.AND.P2.EQ.2) THEN
16936 HWH2T4 = AP(I,J,L,K)
16937 ELSEIF(P1.EQ.2.AND.P2.EQ.1) THEN
16938 HWH2T4 = AM(I,J,L,K)
16939 ELSEIF(P1.EQ.2.AND.P2.EQ.2) THEN
16940 HWH2T4 = AM(I,J,K,L)
16942 CALL HWWARN('HWH2T4',500,*999)
16946 *CMZ :- -27/02/01 17:04:16 by Peter Richardson
16947 *-- Author : Peter Richardson
16948 C-----------------------------------------------------------------------
16949 FUNCTION HWH2T5(I,J,K,L,Z1,Z2,P1,P2)
16950 C-----------------------------------------------------------------------
16951 C Returns the amplitude T5 from Nucl. Phys. B262 (1985) 235-262
16952 C I-L are the particles
16953 C Z1 and Z2 are the decay products of the Z
16954 C P1 is the polarization of the line I,J
16955 C P2 is the polarization of the line K,L
16956 C-----------------------------------------------------------------------
16957 INCLUDE 'HERWIG65.INC'
16958 DOUBLE COMPLEX HWH2T5,AP,AM,S,D
16959 INTEGER I,J,K,L,Z1,Z2,J1,J2,J3,J4,P1,P2
16960 DOUBLE PRECISION B(6)
16961 DATA B/-1.0D0,-1.0D0,1.0D0,1.0D0,1.0D0,1.0D0/
16962 COMMON/HWHEWS/S(8,8,2),D(8,8)
16963 AP(J1,J2,J3,J4) = FOUR*S(J1,Z2,1)*S(J4,J2,2)*
16964 & (S(Z1,Z2,2)*S(Z2,J3,1)+B(J1)*S(Z1,J1,2)*S(J1,J3,1))
16965 AM(J1,J2,J3,J4) = FOUR*S(J1,Z1,2)*S(J4,J2,1)*
16966 & (S(Z2,Z1,1)*S(Z1,J3,2)+B(J1)*S(Z2,J1,1)*S(J1,J3,2))
16967 IF(P1.EQ.1.AND.P2.EQ.1) THEN
16968 HWH2T5 = AM(J,I,L,K)
16969 ELSEIF(P1.EQ.1.AND.P2.EQ.2) THEN
16970 HWH2T5 = AM(J,I,K,L)
16971 ELSEIF(P1.EQ.2.AND.P2.EQ.1) THEN
16972 HWH2T5 = AP(J,I,K,L)
16973 ELSEIF(P1.EQ.2.AND.P2.EQ.2) THEN
16974 HWH2T5 = AP(J,I,L,K)
16976 CALL HWWARN('HWH2T5',500,*999)
16980 *CMZ :- -27/02/01 17:04:16 by Peter Richardson
16981 *-- Author : Peter Richardson
16982 C-----------------------------------------------------------------------
16983 FUNCTION HWH2T6(I,J,K,L,Z1,Z2,P1,P2,P3)
16984 C-----------------------------------------------------------------------
16985 C Returns the amplitude T6 from Nucl. Phys. B262 (1985) 235-262
16986 C I-L are the particles
16987 C Z1 and Z2 are the decay products of the Z
16988 C P1 is the polarization of the line I,J
16989 C P2 is the polarization of the gluon K
16990 C P3 is the polarization of the gluon L
16991 C-----------------------------------------------------------------------
16992 INCLUDE 'HERWIG65.INC'
16993 DOUBLE COMPLEX HWH2T6,S,D
16994 INTEGER I,J,K,L,Z1,Z2,J1,J2,P1,P2,P3
16995 DOUBLE PRECISION B(6)
16996 DATA B/-1.0D0,-1.0D0,1.0D0,1.0D0,1.0D0,1.0D0/
16997 COMMON/HWHEWS/S(8,8,2),D(8,8)
17005 IF((P1.EQ.1.AND.P2.EQ.1.AND.P3.EQ.1).OR.
17006 & (P1.EQ.2.AND.P2.EQ.2.AND.P3.EQ.2)) THEN
17007 HWH2T6 = 8.0D0*B(J)*S(I,J2,1)*D(L,J)*S(K,J,2)*
17008 & (B(J)*S(J1,J,2)*S(J,K,1)+B(L)*S(J1,L,2)*S(L,K,1))
17009 ELSEIF((P1.EQ.1.AND.P2.EQ.1.AND.P3.EQ.2).OR.
17010 & (P1.EQ.2.AND.P2.EQ.2.AND.P3.EQ.1)) THEN
17011 HWH2T6 = 8.0D0*B(J)*S(I,J2,1)*S(L,J,2)*S(J,K,1)*S(L,J,2)*
17012 & (B(J)*S(J1,J,2)*S(J,K,1)+B(L)*S(J1,L,2)*S(L,K,1))
17013 ELSEIF((P1.EQ.1.AND.P2.EQ.2.AND.P3.EQ.1).OR.
17014 & (P1.EQ.2.AND.P2.EQ.1.AND.P3.EQ.2)) THEN
17015 HWH2T6 = 8.0D0*B(J)*S(I,J2,1)*S(K,J,2)*S(J,L,1)*S(K,J,2)*
17016 & (B(J)*S(J1,J,2)*S(J,L,1)+B(K)*S(J1,K,2)*S(K,L,1))
17017 ELSEIF((P1.EQ.1.AND.P2.EQ.2.AND.P3.EQ.2).OR.
17018 & (P1.EQ.2.AND.P2.EQ.1.AND.P3.EQ.1)) THEN
17019 HWH2T6 = 8.0D0*S(I,J2,1)*S(L,J,2)*(B(J)*D(K,J)+B(L)*D(K,L))*
17020 & (B(J)*S(J1,J,2)*S(J,L,1)+B(K)*S(J1,K,2)*S(K,L,1))
17022 CALL HWWARN('HWH2T6',500,*999)
17024 IF(P1.EQ.2) HWH2T6 = DCONJG(HWH2T6)
17027 *CMZ :- -27/02/01 17:04:16 by Peter Richardson
17028 *-- Author : Peter Richardson
17029 C-----------------------------------------------------------------------
17030 FUNCTION HWH2T7(I,J,K,L,Z1,Z2,P1,P2,P3)
17031 C-----------------------------------------------------------------------
17032 C Returns the amplitude T7 from Nucl. Phys. B262 (1985) 235-262
17033 C I-L are the particles
17034 C Z1 and Z2 are the decay products of the Z
17035 C P1 is the polarization of the line I,J
17036 C P2 is the polarization of the gluon K
17037 C P3 is the polarization of the gluon L
17038 C-----------------------------------------------------------------------
17039 INCLUDE 'HERWIG65.INC'
17040 DOUBLE COMPLEX HWH2T7,S,D
17041 INTEGER I,J,K,L,Z1,Z2,J1,J2,P1,P2,P3
17042 DOUBLE PRECISION B(6)
17043 DATA B/-1.0D0,-1.0D0,1.0D0,1.0D0,1.0D0,1.0D0/
17044 COMMON/HWHEWS/S(8,8,2),D(8,8)
17052 IF((P1.EQ.1.AND.P2.EQ.1.AND.P3.EQ.1).OR.
17053 & (P1.EQ.2.AND.P2.EQ.2.AND.P3.EQ.2)) THEN
17054 HWH2T7 = 8.0D0*B(J)*S(I,K,1)*S(J1,J,2)*S(J,L,1)*S(K,J,2)*
17055 & (B(I)*S(L,I,2)*S(I,J2,1)+B(K)*S(L,K,2)*S(K,J2,1))
17056 ELSEIF((P1.EQ.1.AND.P2.EQ.1.AND.P3.EQ.2).OR.
17057 & (P1.EQ.2.AND.P2.EQ.2.AND.P3.EQ.1)) THEN
17058 HWH2T7 = 8.0D0*S(I,K,1)*S(L,J,2)*
17059 & (B(I)*S(L,I,2)*S(I,J2,1)+B(K)*S(L,K,2)*S(K,J2,1))*
17060 & (B(J)*S(J1,J,2)*S(J,K,1)+B(L)*S(J1,L,2)*S(L,K,1))
17061 ELSEIF((P1.EQ.1.AND.P2.EQ.2.AND.P3.EQ.1).OR.
17062 & (P1.EQ.2.AND.P2.EQ.1.AND.P3.EQ.2)) THEN
17063 HWH2T7 = 8.0D0*B(I)*B(J)*S(I,L,1)*S(K,I,2)*
17064 & S(I,J2,1)*S(J1,J,2)*S(J,L,1)*S(K,J,2)
17065 ELSEIF((P1.EQ.1.AND.P2.EQ.2.AND.P3.EQ.2).OR.
17066 & (P1.EQ.2.AND.P2.EQ.1.AND.P3.EQ.1)) THEN
17067 HWH2T7 = 8.0D0*B(I)*S(I,L,1)*S(K,I,2)*S(I,J2,1)*S(L,J,2)*
17068 & (B(J)*S(J1,J,2)*S(J,K,1)+B(L)*S(J1,L,2)*S(L,K,1))
17070 CALL HWWARN('HWH2T7',500,*999)
17072 IF(P1.EQ.2) HWH2T7 = DCONJG(HWH2T7)
17075 *CMZ :- -27/02/01 17:04:16 by Peter Richardson
17076 *-- Author : Peter Richardson
17077 C-----------------------------------------------------------------------
17078 FUNCTION HWH2T8(I,J,K,L,Z1,Z2,P1,P2,P3)
17079 C-----------------------------------------------------------------------
17080 C Returns the amplitude T8 from Nucl. Phys. B262 (1985) 235-262
17081 C I-L are the particles
17082 C Z1 and Z2 are the decay products of the Z
17083 C P1 is the polarization of the line I,J
17084 C P2 is the polarization of the gluon K
17085 C P3 is the polarization of the gluon L
17086 C-----------------------------------------------------------------------
17087 INCLUDE 'HERWIG65.INC'
17088 DOUBLE COMPLEX HWH2T8,S,D
17089 INTEGER I,J,K,L,Z1,Z2,J1,J2,P1,P2,P3
17090 DOUBLE PRECISION B(6)
17091 DATA B/-1.0D0,-1.0D0,1.0D0,1.0D0,1.0D0,1.0D0/
17092 COMMON/HWHEWS/S(8,8,2),D(8,8)
17100 IF((P1.EQ.1.AND.P2.EQ.1.AND.P3.EQ.1).OR.
17101 & (P1.EQ.2.AND.P2.EQ.2.AND.P3.EQ.2)) THEN
17102 HWH2T8 = 8.0D0*S(I,K,1)*S(J1,J,2)*(B(I)*D(L,I)+B(K)*D(L,K))*
17103 & (B(I)*S(K,I,2)*S(I,J2,1)+B(L)*S(K,L,2)*S(L,J2,1))
17104 ELSEIF((P1.EQ.1.AND.P2.EQ.1.AND.P3.EQ.2).OR.
17105 & (P1.EQ.2.AND.P2.EQ.2.AND.P3.EQ.1)) THEN
17106 HWH2T8 = 8.0D0*B(I)*S(I,K,1)*S(L,I,2)*S(I,K,1)*S(J1,J,2)*
17107 & (B(I)*S(L,I,2)*S(I,J2,1)+B(K)*S(L,K,2)*S(K,J2,1))
17108 ELSEIF((P1.EQ.1.AND.P2.EQ.2.AND.P3.EQ.1).OR.
17109 & (P1.EQ.2.AND.P2.EQ.1.AND.P3.EQ.2)) THEN
17110 HWH2T8 = 8.0D0*B(I)*S(I,L,1)*S(K,I,2)*S(I,L,1)*S(J1,J,2)*
17111 & (B(I)*S(K,I,2)*S(I,J2,1)+B(L)*S(K,L,2)*S(L,J2,1))
17112 ELSEIF((P1.EQ.1.AND.P2.EQ.2.AND.P3.EQ.2).OR.
17113 & (P1.EQ.2.AND.P2.EQ.1.AND.P3.EQ.1)) THEN
17114 HWH2T8 = 8.0D0*B(I)*S(I,L,1)*D(I,K)*S(J1,J,2)*
17115 & (B(I)*S(L,I,2)*S(I,J2,1)+B(K)*S(L,K,2)*S(K,J2,1))
17117 CALL HWWARN('HWH2T8',500,*999)
17119 IF(P1.EQ.2) HWH2T8 = DCONJG(HWH2T8)
17122 *CMZ :- -27/02/01 17:04:16 by Peter Richardson
17123 *-- Author : Peter Richardson
17124 C-----------------------------------------------------------------------
17125 FUNCTION HWH2T9(I,J,K,L,Z1,Z2,P1,P2,P3)
17126 C-----------------------------------------------------------------------
17127 C Returns the amplitude T9 from Nucl. Phys. B262 (1985) 235-262
17128 C N.B. DELTA FUNCTION FOR THE GLUON POLARIZATIONS HERE
17129 C I-L are the particles
17130 C Z1 and Z2 are the decay products of the Z
17131 C P1 is the polarization of the line I,J
17132 C P2 is the polarization of the gluon K
17133 C P3 is the polarization of the gluon L
17134 C-----------------------------------------------------------------------
17135 INCLUDE 'HERWIG65.INC'
17136 DOUBLE COMPLEX HWH2T9,S,D
17137 INTEGER I,J,K,L,Z1,Z2,J1,J2,P1,P2,P3
17138 DOUBLE PRECISION B(6)
17139 DATA B/-1.0D0,-1.0D0,1.0D0,1.0D0,1.0D0,1.0D0/
17140 COMMON/HWHEWS/S(8,8,2),D(8,8)
17147 ELSEIF(P1.EQ.2) THEN
17151 HWH2T9 = TWO*S(I,J2,1)*(
17152 & B(K)*S(K,J,2)*(B(J)*S(J1,J,2)*S(J,K,1)
17153 & +B(L)*S(J1,L,2)*S(L,K,1))
17154 & -B(L)*S(L,J,2)*(B(J)*S(J1,J,2)*S(J,L,1)
17155 & +B(K)*S(J1,K,2)*S(K,L,1)))
17156 IF(P1.EQ.2) HWH2T9 = DCONJG(HWH2T9)
17160 *CMZ :- -27/02/01 17:04:16 by Peter Richardson
17161 *-- Author : Peter Richardson
17162 C-----------------------------------------------------------------------
17163 FUNCTION HWH2T0(I,J,K,L,Z1,Z2,P1,P2,P3)
17164 C-----------------------------------------------------------------------
17165 C Returns the amplitude T10 from Nucl. Phys. B262 (1985) 235-262
17166 C N.B. DELTA FUNCTION FOR THE GLUON POLARIZATIONS HERE
17167 C I-L are the particles
17168 C Z1 and Z2 are the decay products of the Z
17169 C P1 is the polarization of the line I,J
17170 C P2 is the polarization of the gluon K
17171 C P3 is the polarization of the gluon L
17172 C-----------------------------------------------------------------------
17173 INCLUDE 'HERWIG65.INC'
17174 DOUBLE COMPLEX HWH2T0,S,D
17175 INTEGER I,J,K,L,Z1,Z2,J1,J2,P1,P2,P3
17176 DOUBLE PRECISION B(6)
17177 DATA B/-1.0D0,-1.0D0,1.0D0,1.0D0,1.0D0,1.0D0/
17178 COMMON/HWHEWS/S(8,8,2),D(8,8)
17185 ELSEIF(P1.EQ.2) THEN
17189 HWH2T0 = TWO*S(J1,J,2)*(
17190 & B(K)*S(I,K,1)*(B(I)*S(K,I,2)*S(I,J2,1)
17191 & +B(L)*S(K,L,2)*S(L,J2,1))
17192 & -B(L)*S(I,L,1)*(B(I)*S(L,I,2)*S(I,J2,1)
17193 & +B(K)*S(L,K,2)*S(K,J2,1)))
17194 IF(P1.EQ.2) HWH2T0 = DCONJG(HWH2T0)
17198 *CMZ :- -26/11/00 17.21.55 by Bryan Webber
17199 *-- Author : Stefano Moretti
17200 C-----------------------------------------------------------------------
17201 SUBROUTINE HWH2VH(P1,P2,P3,P4,RMV,RES,RESL,REST)
17202 C-----------------------------------------------------------------------
17203 C...Matrix element for q(1) + q(')-bar(2) -> V(3) + Higgs(4),
17204 C...V=Z(W+/-), all masses retained (but no Yukawa couplings to quarks).
17205 C...It factorises 64.*PIFAC**3*ALPHA**3/4./SWEIN/SWEIN/SWEIN/EMW/EMW
17207 C... (VQ*VQ+AQ*AQ)/(1.-SWEIN)/(1.-SWEIN) if V=Z
17208 C... VCKM(q,q') if V=W+/-
17210 C...First release: 1-APR-1998 by Stefano Moretti
17211 C-----------------------------------------------------------------------
17213 DOUBLE PRECISION P1(0:3),P2(0:3),P3(0:3),P4(0:3)
17214 DOUBLE PRECISION P(0:3)
17215 DOUBLE PRECISION RMV,GAMV,RES,RESL,REST
17217 DOUBLE PRECISION S,S12,S13,S23
17218 DOUBLE PRECISION T, T13,T23
17219 DOUBLE PRECISION PV,CFC
17220 PARAMETER (GAMV=0.D0)
17223 S=S-(P1(I)+P2(I))**2
17229 S12=S12-P1(I)*P2(I)
17230 S13=S13-P1(I)*P3(I)
17231 S23=S23-P2(I)*P3(I)
17234 RES=(S12+2.D0/RMV/RMV*(S13*S23))
17235 & /((S-RMV**2)**2+GAMV**2*RMV**2)
17237 C...Extracts spin dependence.
17238 PV=SQRT(P3(1)**2+P3(2)**2+P3(3)**2)
17243 P(0)=PV**2/P3(0)*CFC
17254 C...Longitudinal ME (along V direction).
17255 RESL=(2.D0/RMV/RMV*(T13*T23)-S12*T/RMV/RMV)
17256 & /((S-RMV**2)**2+GAMV**2*RMV**2)
17258 C...Transverse ME (perpendicular to V direction).
17263 *CMZ :- -01/04/99 19.47.55 by Mike Seymour
17264 *-- Author : Ian Knowles
17265 C-----------------------------------------------------------------------
17267 C-----------------------------------------------------------------------
17268 C Four jet production in e^+e^- annihilation: qqbar+gg & qqbar+qqbar
17269 C IOP4JT controls the treatment of the colour flow interference term
17271 C IOP4JT(1)=0 neglect, =1 extreme 2341; =2 extreme 3421
17272 C qqbar-qqbar (identical quark flavour) case:
17273 C IOP4JT(2)=0 neglect, =1 extreme 4123; =2 extreme 2143
17275 C Matrix elements based on Ellis Ross & Terrano and Catani & Seymour
17277 C WARNING: Phase space factor inaccurate for JADE y_cut > 0.14.
17278 C-----------------------------------------------------------------------
17279 INCLUDE 'HERWIG65.INC'
17280 INTEGER LM,LP,IQK,I,J,IDMN,IDMX,ID1,ID2,IST(4)
17281 DOUBLE PRECISION HWRGEN,HWUALF,HWUAEM,HWULDO,HWH4J1,HWH4J2,
17282 & HWH4J4,HWH4J5,HWH4J6,HWH4J7,QNOW,Q2NOW,QLST,SCUT,PSFAC,FACT,
17283 & X12,X13,X14,X23,X24,X34,
17284 & COLA,COLB,COLC,CLF(7,6),P12,P13,P14,P23,P24,P34,FACTR,EP1,EP2,
17285 & EP3,EP4,GG1,GG2,GG12,GG3,GG13,GG23,GGINT,WTGG,QQ,QP,QQINT,QQ1,
17286 & QQ2,WTQQ,WTQP,HCS,WTAB,WTBA,WTOT,RCS,YLST
17288 LOGICAL INCLQG(6),INCLQQ(6,6),ORIENT
17289 EXTERNAL HWRGEN,HWUALF,HWUAEM,HWULDO,HWH4J1,HWH4J2,HWH4J4,
17290 & HWH4J5,HWH4J6,HWH4J7
17291 SAVE HCS,QLST,WTQP,WTQQ,WTGG,FACTR,COLA,COLB,COLC,IDMN,IDMX,
17292 & CLF,GG1,GG2,GGINT,INCLQG,INCLQQ,LM,LP,QQ1,QQ2,QQINT,FACT,ORIENT,
17294 DATA QLST,YLST,IST/-1D0,-1D0,113,114,114,114/
17299 IF (NHEP+5.GT.NMXHEP) CALL HWWARN('HWH4JT',100,*999)
17301 IF (QNOW.NE.QLST.OR.Y4JT.NE.YLST) THEN
17306 C Calculate allowed fraction of Phase Space using parameterization
17308 PSFAC=(1.-6.*Y4JT)**5.50*(1.-173.3*Y4JT*(1.-247.3*Y4JT
17309 & *(1.+148.3*Y4JT*(1.+3.913*Y4JT))))
17310 & /(1.-8.352*Y4JT*(1.-1102.*Y4JT
17311 & *(1.+1603.*Y4JT*(1.+22.99*Y4JT))))
17313 PSFAC=(1.-6.*Y4JT)**4.62*(1.-44.72*Y4JT*(1.-176.0*Y4JT
17314 & *(1.+102.9*Y4JT*(1.-6.579*Y4JT))))
17315 & /(1.-3.392*Y4JT*(1.-946.5*Y4JT
17316 & *(1.+423.4*Y4JT*(1.-3.971*Y4JT))))
17318 FACT=GEV2NB*HWUAEM(Q2NOW)**2*CFFAC*FLOAT(NCOLO)*PSFAC
17319 & /(THREE*16*PIFAC)
17321 COLB=CFFAC-HALF*CAFAC
17324 IF (JDAHEP(1,LM).NE.0) LM=JDAHEP(1,LM)
17326 IF (JDAHEP(1,LP).NE.0) LP=JDAHEP(1,LP)
17336 CALL HWUCFF(11,I,Q2NOW,CLF(1,I))
17337 IF (QNOW.GT.TWO*(RMASS(I)+RMASS(13))) THEN
17343 IF (QNOW.GT.TWO*(RMASS(I)+RMASS(J ))) THEN
17347 INCLQQ(I,J)=.FALSE.
17348 INCLQQ(J,I)=.FALSE.
17351 IF (MOD(IPROC/10,10).EQ.5) THEN
17357 C Generate phase space point and check it passes cuts
17358 CALL HWVEQU(5,PHEP(1,3),PHEP(1,NHEP+1))
17360 20 PHEP(5,NHEP+I)=0.
17361 30 CALL HWDFOR(PHEP(1,NHEP+1),PHEP(1,NHEP+2),PHEP(1,NHEP+3),
17362 & PHEP(1,NHEP+4),PHEP(1,NHEP+5))
17364 P12=2*HWULDO(PHEP(1,NHEP+2),PHEP(1,NHEP+3))
17365 X12=MIN(PHEP(4,NHEP+2)/PHEP(4,NHEP+3),
17366 & PHEP(4,NHEP+3)/PHEP(4,NHEP+2))*P12
17367 IF (X12.GT.SCUT) THEN
17368 P13=2*HWULDO(PHEP(1,NHEP+2),PHEP(1,NHEP+4))
17369 X13=MIN(PHEP(4,NHEP+2)/PHEP(4,NHEP+4),
17370 & PHEP(4,NHEP+4)/PHEP(4,NHEP+2))*P13
17371 IF (X13.GT.SCUT) THEN
17372 P14=2*HWULDO(PHEP(1,NHEP+2),PHEP(1,NHEP+5))
17373 X14=MIN(PHEP(4,NHEP+2)/PHEP(4,NHEP+5),
17374 & PHEP(4,NHEP+5)/PHEP(4,NHEP+2))*P14
17375 IF (X14.GT.SCUT) THEN
17376 P23=2*HWULDO(PHEP(1,NHEP+3),PHEP(1,NHEP+4))
17377 X23=MIN(PHEP(4,NHEP+3)/PHEP(4,NHEP+4),
17378 & PHEP(4,NHEP+4)/PHEP(4,NHEP+3))*P23
17379 IF (X23.GT.SCUT) THEN
17380 P24=2*HWULDO(PHEP(1,NHEP+3),PHEP(1,NHEP+5))
17381 X24=MIN(PHEP(4,NHEP+3)/PHEP(4,NHEP+5),
17382 & PHEP(4,NHEP+5)/PHEP(4,NHEP+3))*P24
17383 IF (X24.GT.SCUT) THEN
17384 P34=2*HWULDO(PHEP(1,NHEP+4),PHEP(1,NHEP+5))
17385 X34=MIN(PHEP(4,NHEP+4)/PHEP(4,NHEP+5),
17386 & PHEP(4,NHEP+5)/PHEP(4,NHEP+4))*P34
17387 IF (X34.GT.SCUT) GOTO 40
17394 P12=2*HWULDO(PHEP(1,NHEP+2),PHEP(1,NHEP+3))
17395 IF (P12.GT.SCUT) THEN
17396 P13=2*HWULDO(PHEP(1,NHEP+2),PHEP(1,NHEP+4))
17397 IF (P13.GT.SCUT) THEN
17398 P14=2*HWULDO(PHEP(1,NHEP+2),PHEP(1,NHEP+5))
17399 IF (P14.GT.SCUT) THEN
17400 P23=2*HWULDO(PHEP(1,NHEP+3),PHEP(1,NHEP+4))
17401 IF (P23.GT.SCUT) THEN
17402 P24=2*HWULDO(PHEP(1,NHEP+3),PHEP(1,NHEP+5))
17403 IF (P24.GT.SCUT) THEN
17404 P34=2*HWULDO(PHEP(1,NHEP+4),PHEP(1,NHEP+5))
17405 IF (P34.GT.SCUT) GOTO 40
17412 C Failed cuts retry
17414 C Passed cuts: calculate contributions to Matrix Elements
17415 40 EMSCA=SQRT(MIN(P12,P13,P14,P23,P24,P34))
17416 IF (DURHAM) EMSCA=SQRT(MIN(X12,X13,X14,X23,X24,X34))
17417 IF (FIX4JT) EMSCA=SQRT(SCUT)
17418 FACTR=FACT*HWUALF(1,EMSCA)**2
17420 QF=HWULDO(PHEP(1,LP),PHEP(1,3))
17421 EF=Q2NOW/(2*SQRT(QF**2-HWULDO(PHEP(1,LP),PHEP(1,LP))*Q2NOW))
17422 QF=HALF-EF*QF/Q2NOW
17424 E(I)=EF*PHEP(I,LP)+QF*PHEP(I,3)
17426 EP1=HWULDO(E,PHEP(1,NHEP+2))
17427 EP2=HWULDO(E,PHEP(1,NHEP+3))
17428 EP3=HWULDO(E,PHEP(1,NHEP+4))
17429 EP4=HWULDO(E,PHEP(1,NHEP+5))
17432 GG1=HWH4J1(P12,P13,P14,P23,P24,P34,EP1,EP2,EP3,EP4,ORIENT)
17433 & +HWH4J1(P12,P24,P23,P14,P13,P34,EP2,EP1,EP4,EP3,ORIENT)
17434 GG2=HWH4J1(P12,P23,P24,P13,P14,P34,EP2,EP1,EP3,EP4,ORIENT)
17435 & +HWH4J1(P12,P14,P13,P24,P23,P34,EP1,EP2,EP4,EP3,ORIENT)
17436 GG12=HWH4J2(P12,P13,P14,P23,P24,P34,EP1,EP2,EP3,EP4,ORIENT)
17437 & +HWH4J2(P12,P14,P13,P24,P23,P34,EP1,EP2,EP4,EP3,ORIENT)
17438 & +HWH4J2(P12,P23,P24,P13,P14,P34,EP2,EP1,EP3,EP4,ORIENT)
17439 & +HWH4J2(P12,P24,P23,P14,P13,P34,EP2,EP1,EP4,EP3,ORIENT)
17440 GG3=HWH4J4(P12,P13,P14,P23,P24,P34,EP1,EP2,EP3,EP4,ORIENT)
17441 & +HWH4J4(P12,P24,P23,P14,P13,P34,EP2,EP1,EP4,EP3,ORIENT)
17442 GG13=GG3+HWH4J5(P12,P13,P14,P23,P24,P34,EP1,EP2,EP3,EP4,ORIENT)
17443 & +HWH4J5(P12,P24,P23,P14,P13,P34,EP2,EP1,EP4,EP3,ORIENT)
17444 GG23=GG3+HWH4J5(P12,P14,P13,P24,P23,P34,EP1,EP2,EP4,EP3,ORIENT)
17445 & +HWH4J5(P12,P23,P24,P13,P14,P34,EP2,EP1,EP3,EP4,ORIENT)
17447 GG1 =COLA*(GG1 +GG13)
17448 GG2 =COLA*(GG2 +GG23)
17449 GGINT=COLB*(GG12-GG13-GG23)
17450 WTGG=FACTR*(GG1+GG2+GGINT)
17452 QP=HWH4J6(P13,P12,P14,P23,P34,P24,EP1,EP3,EP2,EP4,ORIENT)
17453 & +HWH4J6(P24,P12,P23,P14,P34,P13,EP2,EP4,EP1,EP3,ORIENT)
17454 & +HWH4J6(P13,P34,P23,P14,P12,P24,EP3,EP1,EP4,EP2,ORIENT)
17455 & +HWH4J6(P24,P34,P14,P23,P12,P13,EP4,EP2,EP3,EP1,ORIENT)
17456 QQ=HWH4J6(P13,P23,P34,P12,P14,P24,EP3,EP1,EP2,EP4,ORIENT)
17457 & +HWH4J6(P24,P23,P12,P34,P14,P13,EP2,EP4,EP3,EP1,ORIENT)
17458 & +HWH4J6(P13,P14,P12,P34,P23,P24,EP1,EP3,EP4,EP2,ORIENT)
17459 & +HWH4J6(P24,P14,P34,P12,P23,P13,EP4,EP2,EP1,EP3,ORIENT)
17460 QQINT=HWH4J7(P13,P12,P14,P23,P34,P24,EP1,EP3,EP2,EP4,ORIENT)
17461 & +HWH4J7(P24,P12,P23,P14,P34,P13,EP2,EP4,EP1,EP3,ORIENT)
17462 & +HWH4J7(P13,P23,P34,P12,P14,P24,EP3,EP1,EP2,EP4,ORIENT)
17463 & +HWH4J7(P24,P23,P12,P34,P14,P13,EP2,EP4,EP3,EP1,ORIENT)
17464 & +HWH4J7(P13,P14,P12,P34,P23,P24,EP1,EP3,EP4,EP2,ORIENT)
17465 & +HWH4J7(P24,P14,P34,P12,P23,P13,EP4,EP2,EP1,EP3,ORIENT)
17466 & +HWH4J7(P13,P34,P23,P14,P12,P24,EP3,EP1,EP4,EP2,ORIENT)
17467 & +HWH4J7(P24,P34,P14,P23,P12,P13,EP4,EP2,EP3,EP1,ORIENT)
17469 WTQP=FACTR*COLC*QP/TWO
17473 WTQQ=FACTR*(QQ1+QQ2+QQINT)/2
17477 DO 60 ID1=IDMN,IDMX
17478 IF (INCLQG(ID1)) THEN
17480 HCS=HCS+CLF(1,ID1)*WTGG
17481 IF (GENEV.AND.HCS.GT.RCS) THEN
17482 C Select colour flow
17485 IF (IOP4JT(1).EQ.1) THEN
17486 IF (GGINT.GE.ZERO) THEN
17489 WTBA=MAX(WTBA,WTBA+GGINT)
17491 ELSEIF (IOP4JT(1).EQ.2) THEN
17492 IF (GGINT.GE.ZERO) THEN
17495 WTAB=MAX(WTAB,WTAB+GGINT)
17497 ELSEIF (IOP4JT(1).NE.0) THEN
17498 CALL HWWARN('HWH4JT',101,*999)
17501 IF (WTAB.GT.HWRGEN(1)*WTOT) THEN
17502 CALL HWHQCP( 13, 13,3142,91,*99)
17504 CALL HWHQCP( 13, 13,4123,92,*99)
17510 C Identical quark pairs
17511 IF (ID1.EQ.ID2.AND.INCLQQ(ID1,ID1)) THEN
17512 HCS=HCS+CLF(1,ID1)*WTQQ
17513 IF (GENEV.AND.HCS.GT.RCS) THEN
17514 C Select colour flow
17517 IF (IOP4JT(2).EQ.1) THEN
17518 IF (QQINT.GE.ZERO) THEN
17521 WTBA=MAX(WTBA,WTBA+QQINT)
17523 ELSEIF (IOP4JT(2).EQ.2) THEN
17524 IF (QQINT.GE.ZERO) THEN
17527 WTAB=MAX(WTAB,WTAB+QQINT)
17529 ELSEIF (IOP4JT(2).NE.0) THEN
17530 CALL HWWARN('HWH4JT',102,*999)
17533 IF (WTAB.GT.HWRGEN(1)*WTOT) THEN
17534 CALL HWHQCP(ID1,ID1+6,4123,93,*99)
17536 CALL HWHQCP(ID1,ID1+6,2143,94,*99)
17539 C Unlike quark pairs
17540 ELSEIF (INCLQQ(ID1,ID2)) THEN
17541 HCS=HCS+(CLF(1,ID1)+CLF(1,ID2))*WTQP
17542 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID2,ID2+6,4123,95,*99)
17548 C Set up labels for selected final state
17562 IDHEP(J)=IDPDG(IDN(I))
17566 C And colour structure pointers
17569 JMOHEP(2,NHEP+1+I)=NHEP+1+J
17570 110 JDAHEP(2,NHEP+1+J)=NHEP+1+I
17574 *CMZ :- -01/04/99 19.47.55 by Mike Seymour
17575 *-- Author : Ian Knowles
17576 C-----------------------------------------------------------------------
17577 FUNCTION HWH4J1(S12,S13,S14,S23,S24,S34,EP1,EP2,EP3,EP4,ORIENT)
17578 C-----------------------------------------------------------------------
17579 C Evaluate `ERT' functions A, B, C, D, E; S12=(p1+p2)^2 etc.
17580 C-----------------------------------------------------------------------
17582 DOUBLE PRECISION HWH4J1,HWH4J2,HWH4J4,HWH4J5,HWH4J6,HWH4J7,
17583 & S12,S13,S14,S23,S24,S34,S123,S124,S134,S234,S,EP1,EP2,EP3,EP4,
17590 S=S12+S13+S14+S23+S24+S34
17591 HWH4J1=(S12*((S12+S14+S23+S34)**2+S13*(S12+S14-S24)+S24*(S12+S23))
17592 & +(S14*S23-S12*S34-S13*S24)*(S14+S23+S34)/2)
17593 & /(S13*S24*S134*S234)
17594 & +((S12+S24)*(S13+S34)-S14*S23)/(S13*S134**2)
17595 & +2*S23*(S-S13)/(S13*S134*S24) + S34/(2*S13*S24)
17598 & +4*((EP1*EP1*((S-S13)*(S23+S24)-S24*S34)
17599 & -EP1*EP2*(S12*(S123+S124)+(S+S12)*(S14+S23)+2*S14*S23
17600 & +S24*S134+S234*(S13+2*S234))
17601 & +EP1*EP3*(S*(S24-S12)+S12*S13+(S14+2*S234-S34)*S24)
17602 & -EP1*EP4*(S12*S124+S23*(S+S12+S14))
17603 & +EP2*EP2*((S-S24)*(S13+S14)+2*(S13+S34)*S234-S13*S34)
17604 & -EP2*EP3*((S+S23)*(S12+S14)+(S12+2*(S23+S234))*S234)
17605 & +EP2*EP4*(S12*(S24-S)+S13*(S+S23-S34)+2*(S13+S34-S234)*S234)
17606 & +EP3*EP3*(S14+2*S234)*S24
17607 & +EP3*EP4*(-S234*(2*(S12+S23)+S134)+S12*S34-S13*S24-S14*S23)
17608 & +EP4*EP4*S13*S23)*S134
17609 & +EP2*(EP1+EP3+EP4)*2*S14*S24*S234)/(S*S13*S24*S134**2*S234)
17614 C-----------------------------------------------------------------------
17615 ENTRY HWH4J2(S12,S13,S14,S23,S24,S34,EP1,EP2,EP3,EP4,ORIENT)
17616 C-----------------------------------------------------------------------
17621 S=S12+S13+S14+S23+S24+S34
17622 HWH4J2=(S12*S14*(S24+S34)+S24*(S12*(S14+S34)+S13*(S14-S24)))
17623 & /(S14*S23*S13*S134)
17624 & +S12*(S+S34)*S124/(S24*S234*S14*S134)
17625 & -(S13*(2*(S12+S24)+S23)+S14**2)/(S134*S13*S14)
17626 & +S12*S123*S124/(2*S13*S24*S14*S23)
17629 & +4*((EP1*EP1*(S12*S134*S234-4*S23*S24*S34)
17630 & +EP1*EP2*(2*(2*S13*S234+S14*S123)*S24-S12*S134*(S+S12+S34))
17631 & +EP1*EP3*(S12*(4*S24*S34-S134*(S12+S14-S24))
17632 & -4*(S13*S24-S14*S23)*S24)
17633 & +EP1*EP4*(4*(S13+S14)*S23*S24-S12*S134*(S12+S13-S23))
17634 & +EP2*EP2*(S12*S134-4*S13*S24)*S134
17635 & +EP2*EP3*(4*S13*(S12+S23+S24)*S24-S12*S134*(S12-S14+S24))
17636 & -EP2*EP4*(4*(S12*(S14+S134)+S13*(S134-S234))*S24
17637 & +S12*(S12-S13+S23)*S134)
17638 & -EP3*EP3*4*S12*S14*S24
17639 & -EP3*EP4*2*S12*(2*S14*S24+S12*S134))*S234
17640 & +(EP1*(EP1*(S23+S24)+EP2*(S134-2*S))
17641 & -(EP1+EP2)*(EP3+EP4)*S12+EP2*EP2*(S13+S14))*2*S14*S24*S123)
17642 & /(2*S*S13*S14*S234*S23*S24*S134)
17647 C-----------------------------------------------------------------------
17648 ENTRY HWH4J4(S12,S13,S14,S23,S24,S34,EP1,EP2,EP3,EP4,ORIENT)
17649 C-----------------------------------------------------------------------
17652 S=S12+S13+S14+S23+S24+S34
17653 HWH4J4=-(S12*(S34*(3*(S+S34)+S12)-S134*S234-2*(S13*S24+S14*S23))
17654 & +(S14*S23-S13*S24)*(S13-S14+S24-S23))/(2*S134*S234*S34**2)
17655 & -(S12*(S134**2/2+2*S13*S14+S34*(S13+S14-S34))
17656 & +S34*((S13+S14)*(S23+S24)+S14*S24+S13*S23)
17657 & +(S13*S24-S14*S23)*(S14-S13))/(S34*S134)**2
17660 & +4*((-EP1*EP1*2*(S23+S24)*S34
17661 & -EP1*EP2*(S13*(S23+3*S24)+S14*(3*S23+S24)-(4*S12-S34)*S34)
17662 & +EP1*EP3*((2*S12-S24)*S34-(S13-S14)*S24)
17663 & +EP1*EP4*((2*S12-S23)*S34+(S13-S14)*S23)
17664 & -EP2*EP2*2*(S13+S14)*S34
17665 & +EP2*EP3*(2*S12*S34-S14*(S23-S24+S34))
17666 & +EP2*EP4*(2*S12*S34+S13*(S23-S24-S34))
17667 & +EP3*EP3*2*S14*S24
17668 & +EP3*EP4*2*(S12*S34-S13*S24-S14*S23)
17669 & +EP4*EP4*2*S13*S23)/(S*S134*S234*S34**2)
17670 & +(EP1*EP2*(S134*(S134+2*S34)+4*(S13*S14-S34**2))
17671 & +EP2*EP3*2*(2*S13*S34+S14*(S13-S14+S34))
17672 & +EP2*EP4*2*(2*S14*S34-S13*(S13-S14-S34)))
17673 & /(S*(S134*S34)**2))
17678 C-----------------------------------------------------------------------
17679 ENTRY HWH4J5(S12,S13,S14,S23,S24,S34,EP1,EP2,EP3,EP4,ORIENT)
17680 C-----------------------------------------------------------------------
17685 S=S12+S13+S14+S23+S24+S34
17686 HWH4J5=(3*S12*S34**2-3*S13*S24*S34+3*S12*S24*S34+3*S14*S23*S34-
17687 $ S13*S24**2-S12*S23*S34+6*S12*S14*S34+2*S12*S13*S34-
17688 $ 2*S12**2*S34+S14*S23*S24-3*S13*S23*S24-2*S13*S14*S24+
17689 $ 4*S12*S14*S24+2*S12*S13*S24+3*S14*S23**2+2*S14**2*S23+
17690 $ 2*S14**2*S12+2*S12**2*S14+6*S12*S14*S23-2*S12*S13**2-
17691 $ 2*S12**2*S13)/(2*S13*S134*S234*S34)+
17692 $ (2*S12*S34**2-2*S13*S24*S34+S12*S24*S34+4*S13*S23*S34+
17693 $ 4*S12*S14*S34+2*S12*S13*S34+2*S12**2*S34-S13*S24**2+
17694 $ 3*S14*S23*S24+4*S13*S23*S24-2*S13*S14*S24+4*S12*S14*S24+
17695 $ 2*S12*S13*S24+2*S14*S23**2+4*S13*S23**2+2*S13*S14*S23+
17696 $ 2*S12*S14*S23+4*S12*S13*S23+2*S12*S14**2+4*S12**2*S13+
17697 $ 4*S12*S13*S14+2*S12**2*S14)/(2*S13*S134*S24*S34)-
17698 $ (S12*S34**2-2*S14*S24*S34-2*S13*S24*S34-S14*S23*S34+
17699 $ S13*S23*S34+S12*S14*S34+2*S12*S13*S34-2*S14**2*S24-
17700 $ 4*S13*S14*S24-4*S13**2*S24-S14**2*S23-S13**2*S23+
17701 $ S12*S13*S14-S12*S13**2)/(S13*S34*S134**2)
17704 & +EP1*EP1*((S13-S14+S23-3*S24)*S34+(S134+S14+2*S34)*S234)
17706 & +EP1*EP2*((2*(S12-S24)+S34)*S134-S14*(4*S12+S14+3*S23)
17707 & +S13*(S13+S23)+S24*S34 )*S24*S134
17708 & -EP1*EP2*(((2*S12*S134+S13*(2*(S12+S14+S23)-S24+S34)
17709 & +S14*(S14-S23)+(2*S14-S34)*S234)*S234)*S134
17710 & + 4*S13**2*S24*S234)
17711 & +EP1*EP3*(S12*(2*S13-S134)+S13*(S24+2*S234)+S14*(3*S24-S234)
17712 & +S34*(S234-3*S24))*S24*S134
17713 & +EP1*EP4*((S12*(S13-S14+3*S34)-S23*(S13+3*S14-S34))*S24
17714 & -(S12*(S13+S134+2*S34)+2*S13*S24
17715 & +(S13-2*S14)*S23)*S234)*S134
17716 & +EP2*EP2*(S13*((2*S13+S34)*S234+S24*(S134-2*S34))
17717 & +2*S14*S134*(S24+S234))*S134
17719 & -EP2*EP3*(((S12*(S13+2*S14-S34)+S14*(S+2*S23-S34))*S24
17720 & +(S12*(S13+S134)+(S13+S24+2*S234)*S14
17721 & +2*S13*(2*S23+S34))*S234)*S134
17722 & +4*S13**2*S24*S234)
17723 & +EP2*EP4*(((S12*(S13-2*S134)+S13*(S+2*S23-3*S34))*S24
17724 & -((S-3*S13+S23+2*S24)*S13+2*S12*S14
17725 & +2*S14*(S23+2*S24))*S234)*S134-4*S13**2*S24*S234)
17726 & +EP3*EP3*2*(S13*S234+S14*S24)*S24*S134
17727 & +EP3*EP4*(2*(S12*S34-S13*S24-S14*S23)*S24
17728 & -(S12*S134+2*S13*S23)*S234)*S134
17729 & +EP4*EP4*2*(S12*S234+S23*S24)*S13*S134
17730 HWH4J5=HWH4J5+4*SUM/(S*S234*S134**2*S13*S34*S24)
17735 C-----------------------------------------------------------------------
17736 ENTRY HWH4J6(S12,S13,S14,S23,S24,S34,EP1,EP2,EP3,EP4,ORIENT)
17737 C-----------------------------------------------------------------------
17742 S=S12+S13+S14+S23+S24+S34
17743 HWH4J6=(S23*(S123*S234-S*S23)+S12*(S123*S124-S*S12))/(S13*S123)**2
17744 & -(S12*S34*(S234-2*S23)+S14*S23*(S234-2*S34)
17745 & -S13*S24*(S234+S13))/(S13**2*S123*S134)
17748 & +4*(-EP1*EP1*2*S23*S34
17749 & +EP1*EP2*((S12-S23)*S34-S13*(S24-S34))
17750 & +(EP1*EP3+EP2*EP4)*2*(S12*S34-S13*S24+S14*S23)
17751 & -EP1*EP4*(S13*S24-(3*(S13+S14)+S34)*S23)
17752 & -(EP1+EP2+EP3)*EP4*2
17753 & *(S12*(S13+S23)+(S12+S13)*S23)*S134/S123
17754 & +EP2*EP2*S13*(S14+S34)
17755 & +EP2*EP3*(S13*(S14-S24)-(S12-S23)*S14)
17756 & -EP3*EP3*2*S12*S14
17757 & -EP3*EP4*(S13*S24-(3*(S13+S34)+S14)*S12)
17758 & +EP4*EP4*(S12+S23)*S13)/(S*S134*S123*S13**2)
17763 C-----------------------------------------------------------------------
17764 ENTRY HWH4J7(S12,S13,S14,S23,S24,S34,EP1,EP2,EP3,EP4,ORIENT)
17765 C-----------------------------------------------------------------------
17770 S=S12+S13+S14+S23+S24+S34
17771 HWH4J7=((S12*S34+S13*S24-S14*S23)*(S13+S14+S23+S24)-2*S12*S24*S34)
17772 & /(S13*S134*S23*S123)
17773 & -S12*(S12*S-S123*S124)/(S123**2*S13*S23)
17774 & -(S13+S14)*(S23+S24)*S34/(S13*S134*S23*S234)
17777 & +4*(+2*(EP1+EP2)*(S23*EP1-S13*EP2)*S34*S134
17778 & -EP1*EP2*2*S34**2*S123
17779 & +EP1*EP3*(S123*(S23+S24)*S34+2*S134*(S13*S24-S14*S23))
17780 & +EP1*EP4*(S123*(S23+S24)*S34+2*S12**2*S134*S234/S123
17781 & +2*S134*(S24*(S13-S12)-S23*(S12+S14)))
17782 & +EP2*EP3*(2*(S12*S34+S13*S24-S14*S23)*S134
17783 & +S123*(S13+S14)*S34)
17784 & +EP2*EP4*(S123*(S13+S14)*S34+2*S12**2*S234*S134/S123
17785 & -2*S134*(S12*S234-S13*S24+S14*S23))
17786 & -EP3*EP3*S12*(2*S24*S134+S123*S34)
17787 & +EP3*EP4*2*S12*(S134*(S23-S24)-S34*S123+S12*S134*S234/S123)
17788 & +EP4*EP4*S12*(2*S23*S134-S123*S34))
17789 & /(S*S13*S23*S123*S134*S234)
17796 *CMZ :- -26/04/91 11.11.55 by Bryan Webber
17797 *-- Author : Giovanni Abbiendi & Luca Stanco
17798 C-----------------------------------------------------------------------
17800 C-----------------------------------------------------------------------
17801 C Order Alpha_s processes in charged lepton-hadron collisions
17803 C Process code IPROC has to be set in the Main Program
17804 C the following codes IPROC may be selected
17806 C 9100 : NC BOSON-GLUON FUSION
17807 C 9100+IQK (IQK=1,...,6) : produced flavour is IQK
17808 C 9107 : produced J/psi + gluon
17810 C 9110 : NC QCD COMPTON
17811 C 9110+IQK (IQK=1,...,12) : struck parton is IQK
17813 C 9130 : NC order alpha_s processes (9100+9110)
17815 C Select maximum and minimum generated flavour when IQK=0
17816 C setting IFLMIN and IFLMAX in the Main Program
17817 C (allowed values from 1 to 6), default are 1 and 5
17818 C allowing d,u,s,c,b,dbar,ubar,sbar,cbar,bbar
17820 C CHARGED CURRENT Boson-Gluon Fusion processes
17821 C 9141 : CC s cbar (c sbar)
17822 C 9142 : CC b cbar (c bbar)
17823 C 9143 : CC s tbar (t cbar)
17824 C 9144 : CC b tbar (t bbar)
17826 C other inputs : Q2MIN,Q2MAX,YBMIN,YBMAX,PTMIN,EMMIN,EMMAX
17827 C when IPROC=(1)9107 : as above but Q2WWMN, Q2WWMX substitute
17828 C Q2MIN and Q2MAX (EPA is used); ZJMAX cut
17830 C Add 10000 to suppress soft remnant fragmentation
17832 C Mean EVWGT = cross section in nanoBarn
17834 C-----------------------------------------------------------------------
17835 INCLUDE 'HERWIG65.INC'
17836 DOUBLE PRECISION HWRGEN,Y,Q2,SHAT,Z,PHI,AJACOB,DSIGMA,ME,MP,
17837 & ML,MREMIF(18),MFIN1(18),MFIN2(18),RS,SMA,W2,RSHAT,FSIGMA(18),
17838 & SIGSUM,PROB,PRAN,PVRT(4),X
17840 INTEGER IQK,IFLAVU,IFLAVD,IMIN,IMAX,IFL,IPROO,LEPFIN,ID1,ID2,I,IDD
17841 LOGICAL CHARGD,INCLUD(18),INSIDE(18)
17843 SAVE LEPFIN,ID1,ID2,FSIGMA,SIGSUM
17844 COMMON /HWAREA/ Y,Q2,SHAT,Z,PHI,AJACOB,DSIGMA,ME,MP,ML,MREMIF,
17845 & MFIN1,MFIN2,RS,SMA,W2,RSHAT,IQK,IFLAVU,IFLAVD,IMIN,IMAX,IFL,LEP,
17846 & IPROO,CHARGD,INCLUD,INSIDE
17849 C---LEP = 1 FOR LEPTONS, -1 FOR ANTILEPTONS
17851 IF (IDHW(1).GE.121.AND.IDHW(1).LE.126) THEN
17853 ELSEIF (IDHW(1).GE.127.AND.IDHW(1).LE.132) THEN
17856 IF (LEP.EQ.0) CALL HWWARN('HWHBGF',500,*999)
17857 IPROO=MOD(IPROC,100)/10
17858 IF (IPROO.EQ.0.OR.IPROO.EQ.4) THEN
17861 IF (IQK.EQ.7) IFL=164
17863 ELSEIF (IPROO.EQ.1.OR.IPROO.EQ.2) THEN
17864 IQK=MOD(IPROC,100)-10
17867 ELSEIF (IPROO.EQ.3) THEN
17872 CALL HWWARN('HWHBGF',501,*999)
17883 ELSEIF (IQK.EQ.2) THEN
17888 ELSEIF (IQK.EQ.3) THEN
17899 IF (LEP.EQ.-1) THEN
17913 IF (I.LT.IFLMIN.OR.I.GT.IFLMAX) INCLUD(I)=.FALSE.
17917 IF (I-6.LT.IFLMIN.OR.I-6.GT.IFLMAX) INCLUD(I)=.FALSE.
17919 IF (I-12.LT.IFLMIN.OR.I-12.GT.IFLMAX) INCLUD(I)=.FALSE.
17922 IF (IPROO.EQ.0) THEN
17928 ELSEIF (IPROO.EQ.1.OR.IPROO.EQ.2) THEN
17934 ELSEIF (IPROO.EQ.3) THEN
17938 ELSEIF (IQK.NE.0 .AND. (.NOT.CHARGD)) THEN
17942 IF (IFL.LE.18) THEN
17946 ELSEIF (IFL.EQ.164) THEN
17953 C---End of initialization
17955 IF (.NOT.CHARGD) THEN
17957 PRAN= SIGSUM * HWRGEN(0)
17959 DO 10 IFL=IMIN,IMAX
17960 IF (.NOT.INSIDE(IFL)) GOTO 10
17961 PROB=PROB+FSIGMA(IFL)
17962 IF (PROB.GE.PRAN) GOTO 20
17965 C---at this point the subprocess has been selected (IFL)
17968 C---Boson-Gluon Fusion event
17969 IDHW(NHEP+1)=IDHW(1)
17972 IDHW(NHEP+4)=LEPFIN
17975 ELSEIF (IFL.GE.7.AND.IFL.LE.18) THEN
17976 C---QCD_Compton event
17977 IDHW(NHEP+1)=IDHW(1)
17980 IDHW(NHEP+4)=LEPFIN
17983 ELSEIF (IFL.EQ.164) THEN
17984 C---gamma+gluon-->J/Psi+gluon
17985 IDHW(NHEP+1)=IDHW(1)
17988 IDHW(NHEP+4)=LEPFIN
17992 CALL HWWARN('HWHBGF',503,*999)
17995 C---Charged current event of specified flavours
17996 IDHW(NHEP+1)=IDHW(1)
17999 IDHW(NHEP+4)=LEPFIN
18004 DO 1 I=NHEP+1,NHEP+6
18005 1 IDHEP(I)=IDPDG(IDHW(I))
18007 C---Codes common for all processes
18019 C---Incoming lepton
18020 JMOHEP(2,NHEP+1)=NHEP+4
18021 JDAHEP(2,NHEP+1)=NHEP+4
18022 C---Hard Process C.M.
18023 JMOHEP(1,NHEP+3)=NHEP+1
18024 JMOHEP(2,NHEP+3)=NHEP+2
18025 JDAHEP(1,NHEP+3)=NHEP+4
18026 JDAHEP(2,NHEP+3)=NHEP+6
18027 C---Outgoing lepton
18028 JMOHEP(2,NHEP+4)=NHEP+1
18029 JDAHEP(2,NHEP+4)=NHEP+1
18031 IF (IFL.LE.6 .OR. CHARGD) THEN
18032 C---Codes for boson-gluon fusion processes
18033 C--- Incoming gluon
18034 JMOHEP(2,NHEP+2)=NHEP+6
18035 JDAHEP(2,NHEP+2)=NHEP+5
18036 C--- Outgoing quark
18037 JMOHEP(2,NHEP+5)=NHEP+2
18038 JDAHEP(2,NHEP+5)=NHEP+6
18039 C--- Outgoing antiquark
18040 JMOHEP(2,NHEP+6)=NHEP+5
18041 JDAHEP(2,NHEP+6)=NHEP+2
18042 ELSEIF (IFL.GE.7 .AND. IFL.LE.12) THEN
18043 C---Codes for V+q --> q+g
18044 C--- Incoming quark
18045 JMOHEP(2,NHEP+2)=NHEP+5
18046 JDAHEP(2,NHEP+2)=NHEP+6
18047 C--- Outgoing quark
18048 JMOHEP(2,NHEP+5)=NHEP+6
18049 JDAHEP(2,NHEP+5)=NHEP+2
18050 C--- Outgoing gluon
18051 JMOHEP(2,NHEP+6)=NHEP+2
18052 JDAHEP(2,NHEP+6)=NHEP+5
18053 ELSEIF (IFL.GE.13 .AND. IFL.LE.18) THEN
18054 C---Codes for V+qbar --> qbar+g
18055 C--- Incoming antiquark
18056 JMOHEP(2,NHEP+2)=NHEP+6
18057 JDAHEP(2,NHEP+2)=NHEP+5
18058 C--- Outgoing antiquark
18059 JMOHEP(2,NHEP+5)=NHEP+2
18060 JDAHEP(2,NHEP+5)=NHEP+6
18061 C--- Outgoing gluon
18062 JMOHEP(2,NHEP+6)=NHEP+5
18063 JDAHEP(2,NHEP+6)=NHEP+2
18064 ELSEIF (IFL.EQ.164) THEN
18065 C---Codes for Gamma+gluon --> J/Psi+gluon
18066 C--- Incoming gluon
18067 JMOHEP(2,NHEP+2)=NHEP+6
18068 JDAHEP(2,NHEP+2)=NHEP+6
18069 C--- Outgoing J/Psi
18070 JMOHEP(2,NHEP+5)=NHEP+1
18071 JDAHEP(2,NHEP+5)=NHEP+1
18072 C--- Outgoing gluon
18073 JMOHEP(2,NHEP+6)=NHEP+2
18074 JDAHEP(2,NHEP+6)=NHEP+2
18076 C---Computation of momenta in Laboratory frame of reference
18079 C Decide which quark radiated and assign production vertices
18081 C Boson-Gluon fusion case
18082 IF (1-Z.LT.HWRGEN(0)) THEN
18083 C Gluon splitting to quark
18084 CALL HWVZRO(4,VHEP(1,NHEP-1))
18085 CALL HWVDIF(4,PHEP(1,NHEP-4),PHEP(1,NHEP),PVRT)
18086 CALL HWUDKL(IFL,PVRT,VHEP(1,NHEP))
18087 CALL HWVEQU(4,VHEP(1,NHEP),VHEP(1,NHEP-4))
18089 C Gluon splitting to antiquark
18090 CALL HWVZRO(4,VHEP(1,NHEP))
18091 CALL HWVDIF(4,PHEP(1,NHEP-4),PHEP(1,NHEP-1),PVRT)
18092 CALL HWUDKL(IFL,PVRT,VHEP(1,NHEP-1))
18093 CALL HWVEQU(4,VHEP(1,NHEP-1),VHEP(1,NHEP-4))
18095 ELSEIF (IFL.GE.7.AND.IFL.LE.18) THEN
18098 IF (1.LT.HWRGEN(0)*(1+(1-X-Z)**2+6*X*(1-X)*Z*(1-Z))) THEN
18099 C Incoming quark radiated the gluon
18100 CALL HWVZRO(4,VHEP(1,NHEP-1))
18101 CALL HWVDIF(4,PHEP(1,NHEP-4),PHEP(1,NHEP),PVRT)
18102 CALL HWUDKL(IFL-6,PVRT,VHEP(1,NHEP))
18103 CALL HWVEQU(4,VHEP(1,NHEP),VHEP(1,NHEP-4))
18105 C Outgoing quark radiated the gluon
18106 CALL HWVZRO(4,VHEP(1,NHEP-4))
18107 CALL HWVSUM(4,PHEP(1,NHEP-1),PHEP(1,NHEP),PVRT)
18108 CALL HWUDKL(IFL-6,PVRT,VHEP(1,NHEP))
18109 CALL HWVEQU(4,VHEP(1,NHEP),VHEP(1,NHEP-1))
18112 C---HERWIG gets confused if lepton momentum is different from beam
18113 C momentum, which it can be if incoming hadron has negative virtuality
18114 C As a temporary fix, simply copy the momentum.
18115 C Momentum conservation somehow gets taken care of HWBGEN!
18116 call hwvequ(5,phep(1,1),phep(1,nhep-5))
18119 C---generation of the 5 variables Y,Q2,SHAT,Z,PHI and Jacobian computation
18120 C---in the largest phase space avalaible for selected processes and
18121 C---filling of logical vector INSIDE to tag contributing ones
18123 C---calculate differential cross section corresponding to the chosen
18124 C---variables and the weight for MC generation
18126 C---many subprocesses included
18132 IF (INSIDE(I)) THEN
18137 SIGSUM=SIGSUM+DSIGMA
18140 EVWGT=SIGSUM * AJACOB
18142 C---only one subprocess included
18144 EVWGT= DSIGMA * AJACOB
18146 IF (EVWGT.LT.ZERO) EVWGT=ZERO
18150 *CMZ :- -26/04/91 13.19.32 by Federico Carminati
18151 *-- Author : Giovanni Abbiendi & Luca Stanco
18152 C----------------------------------------------------------------------
18154 C----------------------------------------------------------------------
18155 C gives the fourmomenta in the laboratory system for the particles
18156 C of the hard 2-->3 subprocess, to match with HERWIG routines of
18158 C----------------------------------------------------------------------
18159 INCLUDE 'HERWIG65.INC'
18160 DOUBLE PRECISION HWUECM,HWUPCM,HWUSQR,Y,Q2,SHAT,Z,PHI,AJACOB,
18161 & DSIGMA,ME,MP,ML,MREMIF(18),MFIN1(18),MFIN2(18),RS,SMA,W2,RSHAT,
18162 & PGAMMA(5),SG,MF1,MF2,EP,PP,EL,PL,E1,E2,Q1,COSBET,SINBET,COSTHE,
18163 & SINTHE,SINAZI,COSAZI,ROTAZI(3,3),EGAM,A,PPROT,MREMIN,PGAM,PEP(5),
18164 & COSPHI,SINPHI,ROT(3,3),EPROT,PROTON(5),MPART
18165 INTEGER IQK,IFLAVU,IFLAVD,IMIN,IMAX,IFL,IPROO,I,IHAD,J,IS,ICMF,LEP
18166 LOGICAL CHARGD,INCLUD(18),INSIDE(18)
18167 EXTERNAL HWUECM,HWUPCM,HWUSQR
18168 COMMON /HWAREA/ Y,Q2,SHAT,Z,PHI,AJACOB,DSIGMA,ME,MP,ML,MREMIF,
18169 & MFIN1,MFIN2,RS,SMA,W2,RSHAT,IQK,IFLAVU,IFLAVD,IMIN,IMAX,IFL,LEP,
18170 & IPROO,CHARGD,INCLUD,INSIDE
18173 IF (JDAHEP(1,IHAD).NE.0) IHAD=JDAHEP(1,IHAD)
18177 MF1=RMASS(IDHW(NHEP+5))
18178 MF2=RMASS(IDHW(NHEP+6))
18182 IF (IFL.EQ.164) IS=IQK
18184 IF (IFL.GE.7.AND.IFL.LE.18) MPART=RMASS(IFL-6)
18187 MREMIN = MREMIF(IS)
18189 C---Calculation of kinematical variables for the generated event
18190 C in the center of mass frame of the incoming boson and parton
18191 C with parton along +z
18192 EGAM = HWUECM (SHAT, -Q2, MPART**2)
18193 PGAM = SQRT( EGAM**2 + Q2 )
18196 A = (W2+Q2-MP**2)/TWO
18197 PPROT = (A*PGAM-EGAM*SQRT(A**2+MP**2*Q2))/Q2
18198 IF (PPROT.LT.ZERO) CALL HWWARN('HWHBKI',101,*999)
18199 EPROT = SQRT(PPROT**2+MP**2)
18200 IF ((EPROT+PPROT).LT.(EP+PP)) CALL HWWARN('HWHBKI',102,*999)
18201 EL = ( PGAM / PPROT * SMA - Q2 ) / TWO
18202 + / (EGAM + PGAM / PPROT * EPROT)
18204 PL = SQRT ( EL**2 - ME**2 )
18206 CALL HWWARN ('HWHBKI',103,*999)
18208 COSBET = (TWO * EPROT * EL - SMA) / (TWO * PPROT * PL)
18209 IF ( ABS(COSBET) .GE. ONE ) THEN
18210 COSBET = SIGN (ONE,COSBET)
18213 SINBET = SQRT (ONE - COSBET**2)
18215 SG = ME**2 + MPART**2 + Q2 + TWO * RSHAT * EL
18216 IF (SG.LE.(RSHAT+ML)**2 .OR. SG.GE.(RS-MREMIN)**2)
18217 + CALL HWWARN ('HWHBKI',104,*999)
18218 Q1 = HWUPCM( RSHAT, MF1, MF2)
18219 E1 = SQRT(Q1**2+MF1**2)
18220 E2 = SQRT(Q1**2+MF2**2)
18221 IF (Q1 .GT. ZERO) THEN
18222 COSTHE=(TWO*EP*E1 - Z*(SHAT+Q2))/(TWO*PP*Q1)
18223 IF (ABS(COSTHE) .GT. ONE) THEN
18224 COSTHE=SIGN(ONE,COSTHE)
18227 SINTHE=SQRT(ONE-COSTHE**2)
18234 PHEP(1,NHEP+1)=PL*SINBET
18235 PHEP(2,NHEP+1)=ZERO
18236 PHEP(3,NHEP+1)=PL*COSBET
18238 PHEP(5,NHEP+1)=RMASS(IDHW(1))
18244 CALL HWUMAS (PROTON)
18246 PHEP(1,NHEP+2)=ZERO
18247 PHEP(2,NHEP+2)=ZERO
18250 PHEP(5,NHEP+2)=MPART
18251 C---HARD SUBPROCESS 2-->3 CENTRE OF MASS
18252 PHEP(1,NHEP+3)=PHEP(1,NHEP+1)+PHEP(1,NHEP+2)
18253 PHEP(2,NHEP+3)=PHEP(2,NHEP+1)+PHEP(2,NHEP+2)
18254 PHEP(3,NHEP+3)=PHEP(3,NHEP+1)+PHEP(3,NHEP+2)
18255 PHEP(4,NHEP+3)=PHEP(4,NHEP+1)+PHEP(4,NHEP+2)
18256 CALL HWUMAS ( PHEP(1,NHEP+3) )
18262 PGAMMA(5)=HWUSQR(Q2)
18263 C---Scattered lepton
18264 PHEP(1,NHEP+4)=PHEP(1,NHEP+1)-PGAMMA(1)
18265 PHEP(2,NHEP+4)=PHEP(2,NHEP+1)-PGAMMA(2)
18266 PHEP(3,NHEP+4)=PHEP(3,NHEP+1)-PGAMMA(3)
18267 PHEP(4,NHEP+4)=PHEP(4,NHEP+1)-PGAMMA(4)
18268 PHEP(5,NHEP+4)=RMASS(IDHW(1))
18269 IF (CHARGD) PHEP(5,NHEP+4)=ZERO
18270 C---First Final parton: quark (or J/psi) in Boson-Gluon Fusion
18271 C--- quark or antiquark in QCD Compton
18272 PHEP(1,NHEP+5)=Q1*SINTHE*COS(PHI)
18273 PHEP(2,NHEP+5)=Q1*SINTHE*SIN(PHI)
18274 PHEP(3,NHEP+5)=Q1*COSTHE
18277 C---Second Final parton: antiquark in Boson-Gluon Fusion
18278 C--- gluon in QCD Compton
18279 PHEP(1,NHEP+6)=-PHEP(1,NHEP+5)
18280 PHEP(2,NHEP+6)=-PHEP(2,NHEP+5)
18281 PHEP(3,NHEP+6)=-PHEP(3,NHEP+5)
18284 C---Boost to lepton-hadron CM frame
18285 PEP(1) = PHEP(1,NHEP+1)
18286 PEP(2) = PHEP(2,NHEP+1)
18287 PEP(3) = PHEP(3,NHEP+1) + PPROT
18288 PEP(4) = PHEP(4,NHEP+1) + EPROT
18291 CALL HWULOF (PEP,PHEP(1,NHEP+I),PHEP(1,NHEP+I))
18293 CALL HWULOF (PEP,PROTON,PROTON)
18294 CALL HWULOF (PEP,PGAMMA,PGAMMA)
18295 C---Rotation around y-axis to align lepton beam with z-axis
18296 COSPHI = PHEP(3,NHEP+1) /
18297 & SQRT( PHEP(1,NHEP+1)**2 + PHEP(3,NHEP+1)**2 )
18298 SINPHI = PHEP(1,NHEP+1) /
18299 & SQRT( PHEP(1,NHEP+1)**2 + PHEP(3,NHEP+1)**2 )
18311 CALL HWUROF (ROT,PHEP(1,NHEP+I),PHEP(1,NHEP+I))
18313 CALL HWUROF (ROT,PROTON,PROTON)
18314 CALL HWUROF (ROT,PGAMMA,PGAMMA)
18315 C---Boost to the LAB frame
18318 CALL HWULOB (PHEP(1,ICMF),PHEP(1,NHEP+I),PHEP(1,NHEP+I))
18320 CALL HWULOB (PHEP(1,ICMF),PROTON,PROTON)
18321 CALL HWULOB (PHEP(1,ICMF),PGAMMA,PGAMMA)
18322 C---Random azimuthal rotation
18323 CALL HWRAZM (ONE,COSAZI,SINAZI)
18329 ROTAZI(1,1) = COSAZI
18330 ROTAZI(1,2) = SINAZI
18331 ROTAZI(2,1) = -SINAZI
18332 ROTAZI(2,2) = COSAZI
18335 CALL HWUROF (ROTAZI,PHEP(1,NHEP+I),PHEP(1,NHEP+I))
18337 CALL HWUROF (ROTAZI,PROTON,PROTON)
18338 CALL HWUROF (ROTAZI,PGAMMA,PGAMMA)
18341 *CMZ :- -03/07/95 19.02.12 by Giovanni Abbiendi
18342 *-- Author : Giovanni Abbiendi & Luca Stanco
18343 C-----------------------------------------------------------------------
18344 SUBROUTINE HWHBRN (*)
18345 C----------------------------------------------------------------------
18346 C Returns a point in the phase space (Y,Q2,SHAT,Z,PHI) and the
18347 C corresponding Jacobian factor AJACOB
18348 C Fill the logical vector INSIDE to tag contributing subprocesses
18349 C to the cross-section
18350 C-----------------------------------------------------------------------
18351 INCLUDE 'HERWIG65.INC'
18352 DOUBLE PRECISION HWRUNI,HWRGEN,HWUPCM,Y,Q2,SHAT,Z,PHI,AJACOB,
18353 & DSIGMA,ME,MP,ML,MREMIF(18),MFIN1(18),MFIN2(18),RS,SMA,W2,RSHAT,
18354 & MF1,MF2,YMIN,YMAX,YJAC,Q2INF,Q2SUP,Q2JAC,EMW2,ZMIN,ZMAX,ZJAC,
18355 & GAMMA2,LAMBDA,PHIJAC,ZINT,ZLMIN,ZL,EMW,TMIN,TMAX,EMLMIN,EMLMAX,
18356 & SHMIN,EMMIF(18),EMMAF(18),WMIF(18),WMIN,MREMIN,YMIF(18),Q1CM(18),
18357 & Q2MAF(18),EMMAWF(18),ZMIF(18),ZMAF(18),PLMAX,PINC,SHINF,SHSUP,
18358 & SHJAC,CTHLIM,Q1,DETDSH,SRY,SRY0,SRY1
18360 INTEGER IQK,IFLAVU,IFLAVD,I,IMIN,IMAX,IFL,IPROO,IHAD,NTRY,DEBUG
18361 LOGICAL CHARGD,INCLUD(18),INSIDE(18)
18362 EXTERNAL HWRUNI,HWRGEN,HWUPCM
18363 SAVE EMLMIN,EMLMAX,EMMIF,EMMAF,MREMIN,MF1,MF2,YMIF,
18364 & YMIN,YMAX,WMIN,WMIF
18365 COMMON /HWAREA/ Y,Q2,SHAT,Z,PHI,AJACOB,DSIGMA,ME,MP,ML,MREMIF,
18366 & MFIN1,MFIN2,RS,SMA,W2,RSHAT,IQK,IFLAVU,IFLAVD,IMIN,IMAX,IFL,LEP,
18367 & IPROO,CHARGD,INCLUD,INSIDE
18368 EQUIVALENCE (EMW,RMASS(198))
18371 IF (JDAHEP(1,IHAD).NE.0) IHAD=JDAHEP(1,IHAD)
18373 IF (FSTWGT.OR.IHAD.NE.2) THEN
18374 ME = RMASS(IDHW(1))
18375 MP = RMASS(IDHW(IHAD))
18377 SMA = RS**2-ME**2-MP**2
18378 PINC = HWUPCM(RS,ME,MP)
18379 C---Charged current
18381 ML=RMASS(IDHW(1)+1)
18382 YMAX = ONE - TWO*ML*MP / SMA
18383 YMAX = MIN(YMAX,YBMAX)
18392 SHMIN = MF1**2+MF2**2 + TWO * PTMIN**2 +
18393 + TWO * SQRT(PTMIN**2+MF1**2) * SQRT(PTMIN**2+MF2**2)
18394 EMLMIN=MAX(EMMIN,SQRT(SHMIN))
18395 EMLMAX=MIN(EMMAX,RS-ML-MREMIN)
18397 IF (EMLMIN.GT.EMLMAX) GOTO 888
18399 PLMAX=HWUPCM(RS,ML,WMIN)
18400 YMIN = ONE-TWO*(SQRT(PINC**2+MP**2)*SQRT(PLMAX**2+ML**2)+
18402 YMIN = MAX(YMIN,YBMIN)
18404 IF (YMIN.GT.YMAX) GOTO 888
18406 C---Neutral current
18408 YMAX = ONE - TWO*ML*MP / SMA
18409 YMAX = MIN(YMAX,YBMAX)
18416 C---Boson-Gluon Fusion (also J/Psi) and QCD Compton with struck u or d
18420 MFIN2(I)=RMASS(I+6)
18422 MFIN1(I)=RMASS(I-6)
18426 C---QCD Compton with struck non-valence parton
18427 MREMIF(I)=MP+RMASS(I-6)
18428 MFIN1(I)=RMASS(I-6)
18432 IF (IFL.EQ.164) THEN
18434 MFIN1(7)=RMASS(164)
18437 C---y boundaries for different flavours and processes
18439 IF (INCLUD(I)) THEN
18443 SHMIN = MF1**2+MF2**2 + TWO * PTMIN**2 +
18444 + TWO * SQRT(PTMIN**2+MF1**2) * SQRT(PTMIN**2+MF2**2)
18445 EMMIF(I) = MAX(EMMIN,SQRT(SHMIN))
18446 EMMAF(I) = MIN(EMMAX,RS-ML-MREMIN)
18447 IF (EMMIF(I).GT.EMMAF(I)) THEN
18449 CALL HWWARN('HWHBRN',3,*999)
18452 WMIF(I) = EMMIF(I)+MREMIF(I)
18454 PLMAX = HWUPCM(RS,ML,WMIN)
18455 YMIF(I)=ONE-TWO*(SQRT(PINC**2+MP**2)*SQRT(PLMAX**2+ML**2)+
18457 IF (YMIF(I).GT.YMAX) THEN
18459 CALL HWWARN('HWHBRN',4,*999)
18464 C---considering the largest boundaries
18467 IF (IPROO.EQ.3) THEN
18468 EMLMIN=MIN(EMMIF(IMIN),EMMIF(IMIN+6))
18469 EMLMAX=MAX(EMMAF(IMIN),EMMAF(IMIN+6))
18472 IF (EMLMIN.GT.EMLMAX) GOTO 888
18474 IF (IPROO.EQ.3) YMIN=MIN(YMIF(IMIN),YMIF(IMIN+6))
18475 YMIN = MAX(YMIN,YBMIN)
18477 IF (YMIN.GT.YMAX) GOTO 888
18479 MREMIN = MREMIF(IMIN)
18482 IF (IPROO.EQ.3) THEN
18483 WMIN = MIN(WMIF(IMIN),WMIF(IMIN+6))
18484 MREMIN = MIN(MREMIF(IMIN),MREMIF(IMIN+6))
18488 C---Random generation in largest phase space
18496 IF (.NOT.CHARGD) THEN
18497 IF (IFL.LE.5.OR.(IFL.GE.7.AND.IFL.LE.18)) THEN
18500 SRY = HWRUNI(0,SRY0,SRY1)
18502 YJAC = TWO*SRY*(SRY1-SRY0)
18503 ELSEIF (IFL.EQ.6) THEN
18504 Y = SQRT(HWRUNI(0,YMIN**2,YMAX**2))
18505 YJAC = HALF * (YMAX**2-YMIN**2) / Y
18506 ELSEIF (IFL.EQ.164) THEN
18507 C---in J/psi photoproduction Y and Q2 are given by the Equivalent Photon
18511 IF (NTRY.GT.NETRY) CALL HWWARN('HWHBRN',50,*10)
18512 Y = (YMIN/YMAX)**HWRGEN(1)*YMAX
18513 IF (ONE+(ONE-Y)**2.LT.TWO*HWRGEN(2)) GOTO 20
18514 YJAC=(TWO*LOG(YMAX/YMIN)-TWO*(YMAX-YMIN)
18515 & +HALF*(YMAX**2-YMIN**2))
18518 IF (IPRO.EQ.5) THEN
18519 Y = EXP(HWRUNI(0,LOG(YMIN),LOG(YMAX)))
18520 YJAC = Y * LOG(YMAX/YMIN)
18522 Y = HWRUNI(0,YMIN,YMAX)
18526 C---Q**2 generation
18527 Q2INF = ME**2*Y**2 / (ONE-Y)
18528 Q2SUP = MP**2 + SMA*Y - WMIN**2
18529 IF (IFL.EQ.164) THEN
18530 Q2INF = MAX(Q2INF,Q2WWMN)
18531 Q2SUP = MIN(Q2SUP,Q2WWMX)
18533 Q2INF = MAX(Q2INF,Q2MIN)
18534 Q2SUP = MIN(Q2SUP,Q2MAX)
18537 IF (Q2INF .GT. Q2SUP) GOTO 888
18539 IF (.NOT.CHARGD) THEN
18540 IF (IFL.EQ.164) THEN
18541 Q2 = EXP(HWRUNI(0,LOG(Q2INF),LOG(Q2SUP)))
18542 Q2JAC = LOG(Q2SUP/Q2INF)
18543 ELSEIF (Q2INF.LT.RMASS(4)**2) THEN
18544 Q2 = EXP(HWRUNI(0,LOG(Q2INF),LOG(Q2SUP)))
18545 Q2JAC = Q2 * LOG(Q2SUP/Q2INF)
18547 Q2 = Q2INF*Q2SUP/HWRUNI(0,Q2INF,Q2SUP)
18548 Q2JAC = Q2**2 * (Q2SUP-Q2INF)/(Q2SUP*Q2INF)
18552 Q2=(Q2INF+EMW2)*(Q2SUP+EMW2)/(HWRUNI(0,Q2INF,Q2SUP)+EMW2)-EMW2
18553 Q2JAC=(Q2+EMW2)**2*(Q2SUP-Q2INF)/((Q2SUP+EMW2)*(Q2INF+EMW2))
18555 W2 = MP**2 + SMA*Y - Q2
18556 C---s_hat generation
18558 SHSUP = (MIN(SQRT(W2)-MREMIN,EMLMAX))**2
18560 IF (SHINF .GT. SHSUP) GOTO 888
18562 IF (IPRO.EQ.91) THEN
18563 IF (.NOT.CHARGD) THEN
18564 SHAT = SHINF*SHSUP/HWRUNI(0,SHINF,SHSUP)
18565 SHJAC = SHAT**2 * (SHSUP-SHINF)/(SHSUP*SHINF)
18567 SHAT = EXP(HWRUNI(0,LOG(SHINF),LOG(SHSUP)))
18568 SHJAC = SHAT*(LOG(SHSUP/SHINF))
18572 IF (SHINF.GT.EMW2+10*GAMW*EMW) THEN
18573 SHAT = SHINF*SHSUP/HWRUNI(0,SHINF,SHSUP)
18574 SHJAC = SHAT**2 * (SHSUP-SHINF)/(SHSUP*SHINF)
18575 ELSEIF (SHSUP.LT.EMW2-10*EMW*GAMW) THEN
18576 SHAT = HWRUNI(0,SHINF,SHSUP)
18577 SHJAC = SHSUP-SHINF
18579 TMIN=ATAN((SHINF-EMW2)/(GAMW*EMW))
18580 TMAX=ATAN((SHSUP-EMW2)/(GAMW*EMW))
18581 SHAT = GAMW*EMW*TAN(HWRUNI(0,TMIN,TMAX))+EMW2
18582 SHJAC=((SHAT-EMW2)**2+(GAMW*EMW)**2)/(GAMW*EMW)*(TMAX-TMIN)
18587 RSHAT = SQRT (SHAT)
18591 IF (.NOT.CHARGD) THEN
18598 IF (INCLUD(I)) THEN
18599 Q1CM(I) = HWUPCM( RSHAT, MFIN1(I), MFIN2(I) )
18600 IF (Q1CM(I) .LT. PTMIN) THEN
18604 CTHLIM = SQRT(ONE - (PTMIN / Q1CM(I))**2)
18605 GAMMA2 = SHAT + MFIN1(I)**2 - MFIN2(I)**2
18606 LAMBDA = (SHAT-MFIN1(I)**2-MFIN2(I)**2)**2 -
18607 + 4.D0*MFIN1(I)**2*MFIN2(I)**2
18608 ZMIF(I) = (GAMMA2 - SQRT(LAMBDA)*CTHLIM)/TWO/SHAT
18609 ZMIF(I) = MAX(ZMIF(I),ZERO)
18610 ZMAF(I) = (GAMMA2 + SQRT(LAMBDA)*CTHLIM)/TWO/SHAT
18611 ZMAF(I) = MIN(ZMAF(I),ONE)
18612 ZMIN = MIN( ZMIN, ZMIF(I) )
18613 ZMAX = MAX( ZMAX, ZMAF(I) )
18616 IF (IFL.EQ.164) ZMAX=MIN(ZMAX,ZJMAX)
18618 Q1 = HWUPCM(RSHAT,MF1,MF2)
18620 IF (Q1.LT.PTMIN) GOTO 888
18621 CTHLIM = SQRT(ONE-(PTMIN/Q1)**2)
18622 GAMMA2 = SHAT+MF1**2-MF2**2
18623 LAMBDA = (SHAT-MF1**2-MF2**2)**2-4.D0*MF1**2*MF2**2
18624 ZMIN = (GAMMA2-SQRT(LAMBDA)*CTHLIM)/TWO/SHAT
18625 ZMIN = MAX(ZMIN,1D-6)
18626 ZMAX = (GAMMA2+SQRT(LAMBDA)*CTHLIM)/TWO/SHAT
18627 ZMAX = MIN(ZMAX,ONE-1D-6)
18630 IF (ZMIN .GT. ZMAX) GOTO 888
18631 ZLMIN = LOG(ZMIN/(ONE-ZMIN))
18632 ZINT = LOG(ZMAX/(ONE-ZMAX)) - LOG(ZMIN/(ONE-ZMIN))
18633 ZL = ZLMIN+HWRGEN(0)*ZINT
18634 Z = EXP(ZL)/(ONE+EXP(ZL))
18635 ZJAC = Z*(ONE-Z)*ZINT
18638 IF ((Y.LT.YMIN.OR.Y.GT.YMAX).OR.(Q2.LT.Q2INF.OR.Q2.GT.Q2SUP).OR.
18639 + (SHAT.LT.SHINF.OR.SHAT.GT.SHSUP).OR.(Z.LT.ZMIN.OR.Z.GT.ZMAX))
18642 PHI = HWRUNI(0,ZERO,2*PIFAC)
18644 IF (IFL.EQ.164) PHIJAC=ONE
18646 AJACOB = YJAC * Q2JAC * SHJAC * ZJAC * PHIJAC
18648 IF (IQK.NE.0.OR.IPRO.EQ.5) GOTO 999
18649 C---contributing subprocesses: filling of logical vector INSIDE
18656 IF (INCLUD(I)) THEN
18657 IF ( Y.LT.YMIF(I) ) GOTO 200
18659 Q2MAF(I) = MP**2 + SMA*Y - WMIF(I)**2
18660 Q2MAF(I) = MIN( Q2MAF(I), Q2MAX)
18661 IF (Q2INF .GT. Q2MAF(I)) GOTO 200
18662 IF (Q2.LT.Q2INF .OR. Q2.GT.Q2MAF(I)) GOTO 200
18664 EMMAWF(I) = SQRT(W2) - MREMIF(I)
18665 EMMAWF(I) = MIN( EMMAWF(I), EMLMAX )
18667 IF (EMMIF(I) .GT. EMMAWF(I)) GOTO 200
18668 IF (SHAT.LT.EMMIF(I)**2.OR.SHAT.GT.EMMAWF(I)**2) GOTO 200
18670 IF (ZMIF(I) .GT. ZMAF(I)) GOTO 200
18671 IF (Z.LT.ZMIF(I) .OR. Z.GT.ZMAF(I)) GOTO 200
18677 C---UNCOMMENT THIS LINE TO GET A DEBUGGING WARNING FOR NO PHASE-SPACE
18678 C CALL HWWARN('HWHBRN',DEBUG,*777)
18682 *CMZ :- -03/07/95 19.02.12 by Giovanni Abbiendi
18683 *-- Author : Giovanni Abbiendi & Luca Stanco
18684 C----------------------------------------------------------------------
18686 C----------------------------------------------------------------------
18687 C Returns differential cross section DSIGMA in (Y,Q2,ETA,Z,PHI)
18688 C Scale for structure functions and alpha_s selected by BGSHAT
18689 C----------------------------------------------------------------------
18690 INCLUDE 'HERWIG65.INC'
18691 DOUBLE PRECISION HWUALF,HWUAEM,Y,Q2,SHAT,Z,PHI,AJACOB,DSIGMA,
18692 & ME,MP,ML,MREMIF(18),MFIN1(18),MFIN2(18),RS,SMA,W2,RSHAT,
18693 & SFUN(13),ALPHA,LDSIG,DLQ(7),SG,XG,MF1,MF2,MSUM,MDIF,MPRO,FFUN,
18694 & GFUN,H43,H41,H11,H12,H14,H16,H21,H22,G11,G12,G1A,G1B,G21,G22,G3,
18695 & GC,A11,A12,A44,ALPHAS,PDENS,AFACT,BFACT,CFACT,DFACT,GAMMA,S,T,U,
18696 & MREMIN,POL,CCOL,ETA
18698 INTEGER IQK,IFLAVU,IFLAVD,IMIN,IMAX,IFL,IPROO,IHAD,ILEPT,IQ,IS
18699 LOGICAL CHARGD,INCLUD(18),INSIDE(18)
18700 EXTERNAL HWUALF,HWUAEM
18701 COMMON /HWAREA/ Y,Q2,SHAT,Z,PHI,AJACOB,DSIGMA,ME,MP,ML,MREMIF,
18702 & MFIN1,MFIN2,RS,SMA,W2,RSHAT,IQK,IFLAVU,IFLAVD,IMIN,IMAX,IFL,LEP,
18703 & IPROO,CHARGD,INCLUD,INSIDE
18706 IF (JDAHEP(1,IHAD).NE.0) IHAD=JDAHEP(1,IHAD)
18719 IF (IFL.EQ.164) IS=IQK
18720 MREMIN = MREMIF(IS)
18724 C---choose subprocess scale
18729 IF (IFL.GE.7.AND.IFL.LE.18) S=SHAT+Q2-MF1**2
18732 IF (IFL.GE.7.AND.IFL.LE.18) U=-S-T-2*MF1**2
18733 EMSCA = SQRT(TWO*S*T*U/(S**2+T**2+U**2))
18734 IF (IFL.EQ.164) EMSCA=SQRT(-U)
18736 ALPHAS = HWUALF(1,EMSCA)
18737 IF (ALPHAS.GE.ONE.OR.ALPHAS.LE.ZERO) CALL HWWARN('HWHBSG',51,*888)
18738 C---structure functions
18739 ETA = (SHAT+Q2)/SMA/Y
18740 IF (ETA.GT.ONE) ETA=ONE
18741 CALL HWSFUN (ETA,EMSCA,IDHW(IHAD),NSTRU,SFUN,2)
18742 XG = Q2/(SHAT + Q2)
18744 IF (SG.LE.(RSHAT+ML)**2.OR.SG.GE.(RS-MREMIN)**2) GOTO 888
18746 IF (IFL.EQ.164) GOTO 200
18748 C---Electroweak couplings
18751 POL = PPOLN(3) - EPOLN(3)
18752 DLQ(1)=.0625*VCKM(IFLAVU/2,(IFLAVD+1)/2)/SWEIN**2 *
18753 + Q2**2/((Q2+RMASS(198)**2)**2+(RMASS(198)*GAMW)**2) *
18759 ILEPT=MOD(IDHW(1)-121,6)+11
18760 CALL HWUCFF(ILEPT,IQ,-Q2,DLQ(1))
18764 C---For Boson-Gluon Fusion
18765 PDENS = SFUN(13)/ETA
18767 MSUM = (MF1**2 + MF2**2) / (Y*SG)
18768 MDIF = (MF1**2 - MF2**2) / (Y*SG)
18769 MPRO = MF1*MF2 / (Y*SG)
18771 FFUN = (1.D0-XG)*Z*(1.D0-Z) + (MDIF*(2.D0*Z-1.D0)-MSUM)/2.D0
18772 GFUN = (1.D0-XG)*(1.D0-Z) + XG*Z + MDIF
18773 IF ( FFUN .LT. ZERO ) FFUN = ZERO
18774 H43 = (8.D0*(2.D0*Z**2*XG-Z**2-2.D0*Z*XG+2.D0*Z*MDIF+Z-MDIF
18775 & -MSUM)) / (Z*(1.D0-Z))**2
18777 H41 = (8.D0*(Z**2-Z*XG+Z*MDIF-MDIF-MSUM)) / (Z**2*(1.D0-Z))
18779 H11 = (4.D0*(2.D0*Z**4-4.D0*Z**3+2.D0*Z**2*MSUM*XG
18780 & -2.D0*Z**2*MSUM+2.D0*Z**2*XG**2-2.D0*Z**2*XG+3.D0*Z**2
18781 & +2.D0*Z*MDIF*MSUM+2.D0*Z*MDIF*XG-2.D0*Z*MSUM*XG
18782 & +2.D0*Z*MSUM-2.D0*Z*XG**2+2.D0*Z*XG-Z-MDIF*MSUM-MDIF*XG
18783 & -MSUM**2-MSUM*XG)) / (Z*(1.D0-Z))**2
18785 H12 = (16.D0*(-Z*MDIF+Z*XG+MDIF+MSUM))/(Z**2*(1.D0-Z))
18787 H14 = (16.D0*(-2.D0*Z**2*XG-2.D0*Z*MDIF+2.D0*Z*XG+MDIF+MSUM))
18788 & / (Z*(1.D0-Z))**2
18790 H16 = (32.D0*(Z*MDIF-Z*XG-MDIF-MSUM)) / (Z**2*(1.D0-Z))
18792 H21 = (8.D0*MPRO*(-2.D0*Z**2*XG+2.D0*Z**2-2.D0*Z*MDIF+2.D0*Z*XG
18793 + -2.D0*Z+MDIF+MSUM)) / (Z*(1.D0-Z))**2
18795 H22 = (-32.D0*MPRO) / (Z*(1.D0-Z))
18797 G11 = -2.D0*H11 + FFUN*H14
18798 G12 = 2.D0*XG*FFUN*H14 + H12 + GFUN * ( H16+GFUN*H14 )
18799 G1A = SQRT( XG*FFUN ) * ( H16 + 2.D0*GFUN*H14 )
18803 G3 = H41 - GFUN*H43
18804 GC = SQRT( XG*FFUN ) * (-2.D0*XG*H43 )
18806 C---for QCD Compton, massless matrix element
18807 PDENS = SFUN(IFL-6)/ETA
18809 FFUN = XG*(ONE-XG)*Z*(ONE-Z)
18810 GFUN = (ONE-XG)*(ONE-Z)+XG*Z
18811 G11 = 8.D0*((Z**2+XG**2)/(ONE-XG)/(ONE-Z)+TWO*(XG*Z+ONE))
18812 G12 = 64.D0*XG**2*Z+TWO*XG*G11
18813 G1A = 32.D0*XG*GFUN*SQRT(FFUN)/((ONE-XG)*(ONE-Z))
18815 G3 = -16.D0*(ONE-XG)*(ONE-Z)+G11
18816 GC = -16.D0*XG*SQRT(FFUN)*(ONE-Z-XG)/((ONE-XG)*(ONE-Z))
18821 A11 = XG * Y**2 * G11 + (1.D0-Y) * G12
18822 & - (2.D0-Y) * SQRT( 1.D0-Y ) * G1A * COS( PHI )
18823 & + 2.D0 * XG * (1.D0-Y) * G1B * COS( 2.D0*PHI )
18825 A12 = XG * Y**2 * G21 + (1.D0-Y) * G22
18827 A44 = XG * Y * (2.D0-Y) * G3
18828 & - 2.D0 * Y * SQRT( 1.D0-Y ) * GC * COS( PHI )
18830 IF ( Y*Q2**2 .LT. 1D-38 ) THEN
18831 C---prevent numerical uncertainties in DSIGMA computation
18832 DSIGMA = PDENS*ALPHA**2*ALPHAS*GEV2NB*CCOL/(16.D0*PIFAC)
18833 & *(DLQ(1)*A11 + DLQ(2)*A12 + FLOAT(LEP)*DLQ(3)*A44)
18834 IF ( DSIGMA .LE. ZERO ) GOTO 888
18835 LDSIG = LOG (DSIGMA) - LOG (Y) - 2.D0 * LOG (Q2)
18836 DSIGMA = EXP (LDSIG)
18838 DSIGMA = PDENS*ALPHA**2*ALPHAS*GEV2NB*CCOL
18839 & * (DLQ(1)*A11 + DLQ(2)*A12 + FLOAT(LEP)*DLQ(3)*A44)
18840 & / (16.D0*PIFAC*Y*Q2**2)
18842 IF (DSIGMA.LT.ZERO) GOTO 888
18846 C--- J/psi production
18847 ALPHA = HWUAEM(-Q2)
18849 PDENS = SFUN(13)/ETA
18850 AFACT = (8.D0*PIFAC*ALPHAS**2*RMASS(164)**3*GAMMA)/(3.D0*ALPHA)
18851 BFACT = ONE/(Y*SG*Z**2*((Z-ONE)*Y*SG-RMASS(164)**2)**2)
18852 CFACT = (RMASS(164)**2-Z*Y*SG)**2/(Y*SG*(ONE-XG)**2*
18853 & ((ONE-XG)*Y*SG-RMASS(164)**2)**2*
18854 & ((Z-ONE)*Y*SG-RMASS(164)**2)**2)
18855 DFACT = ((Z-ONE)*Y*SG)**2/(Y*SG*(ONE-XG)**2*
18856 & ((ONE-XG)*Y*SG-RMASS(164)**2)**2*(Z*Y*SG)**2)
18857 DSIGMA = GEV2NB*ALPHA/(TWO*PIFAC)*AFACT*(BFACT+CFACT+DFACT)*PDENS
18858 IF (DSIGMA.LT.ZERO ) GOTO 888
18863 *CMZ :- -26/04/91 14.55.44 by Federico Carminati
18864 *-- Author : Giovanni Abbiendi & Luca Stanco
18865 C----------------------------------------------------------------------
18867 C----------------------------------------------------------------------
18868 C DEEP INELASTIC LEPTON-HADRON SCATTERING: MEAN EVWGT = SIGMA IN NB
18869 C----------------------------------------------------------------------
18870 INCLUDE 'HERWIG65.INC'
18871 DOUBLE PRECISION HWRGEN,HWRUNI,HWUPCM,PRAN,PROB,SAMP,SIG,Q2,
18872 & XBJ,Y,W,S,MLEP,MHAD,MLSCAT,YMIN,YMAX,XXMAX,Q2JAC,XXJAC,
18873 & JACOBI,A1,A2,A3,B1,B2,PCM,PCMEP,PCMLW,PCMEQ,PCMLQ,COSPHI,PA,
18874 & EQ,PZQ,SHAT,PROP,DLEFT,DRGHT,DUP,DWN,FACT,EFACT,OMY2,YPLUS,
18875 & YMNUS,SIGMA,AF(7,12),SMA,Q2SUP,HWUAEM,DCHRG,DNEUT
18876 INTEGER I,IQK,IQKIN,IQKOUT,IDSCAT,IHAD,ILEPT,LEP
18878 EXTERNAL HWRGEN,HWRUNI,HWUPCM
18879 SAVE MLEP,MHAD,S,SMA,PCM,MLSCAT,A1,A2,A3,B1,B2,DLEFT,DRGHT,Q2,
18880 & AF,XBJ,Y,YPLUS,YMNUS,OMY2,FACT,EFACT,SIGMA,IDSCAT,CHARGD,
18881 & ILEPT,DCHRG,DNEUT,LEP
18884 IF (JDAHEP(1,IHAD).NE.0) IHAD=JDAHEP(1,IHAD)
18885 IF (FSTWGT.OR.IHAD.NE.2) THEN
18886 C---INITIALISE PROCESS (MUST BE DONE EVERY TIME IF S VARIES)
18887 C---LEPTON AND HADRON MASSES, INVARIANT MASS, MOMENTUM IN C.M. FRAME
18891 SMA=S-MLEP**2-MHAD**2
18892 PCM=HWUPCM(SQRT(S),MLEP,MHAD)
18893 C---LEP = 1 FOR LEPTONS, -1 FOR ANTILEPTONS
18894 IF (IDHW(1).GE.121.AND.IDHW(1).LE.126) THEN
18896 ELSEIF (IDHW(1).GE.127.AND.IDHW(1).LE.132) THEN
18899 CALL HWWARN('HWHDIS',500,*999)
18901 DCHRG=FLOAT(MOD(IDHW(1) ,2))
18902 DNEUT=FLOAT(MOD(IDHW(1)+1,2))
18903 ILEPT=MOD(IDHW(1)-121,6)+11
18904 C---DLEFT,DRIGHT = 1,0 for leptons; = 0,1 for anti-leptons
18907 CHARGD=MOD(IPROC,100)/10.EQ.1
18908 C---Evaluate constant factor in cross section and
18909 C find and store scattered lepton identity
18911 IF ((EPOLN(3)-PPOLN(3)).EQ.ONE) THEN
18913 CALL HWWARN('HWHDIS',501,*999)
18914 5 FORMAT(1X,'WARNING: Cross-section is zero for the',
18915 & ' specified lepton helicity')
18917 FACT=GEV2NB*(ONE-(EPOLN(3)-PPOLN(3)))*.25D0*PIFAC
18918 & /(SWEIN*RMASS(198)**2)**2
18919 IDSCAT=IDHW(1)+NINT(DCHRG-DNEUT)
18921 FACT=GEV2NB*TWO*PIFAC
18924 MLSCAT=RMASS(IDSCAT)
18925 C---PARAMETERS USED FOR THE WEIGHT GENERATION IN NEUTRAL CURRENT
18926 C PROCESSES. ASSUME D(SIGMA)/D(Q**2) GOES LIKE A1+A2/Q**2+A3/Q**4
18927 C AND D(SIGMA)/D(X) LIKE B1+B2/X
18935 C---GENERATE EVENT (KINEMATICAL VARIABLES AND STRUCTURE FUNCTION
18937 PRAN=SIGMA*HWRGEN(0)
18939 C---CHARGED CURRENT PROCESS
18941 C---FIND FLAVOUR OF THE STRUCK QUARK (IF NOT SELECTED BY THE USER)
18947 & ((DCHRG*(DLEFT*DUP+DRGHT*DWN*OMY2)
18948 & +DNEUT*(DLEFT*DWN+DRGHT*DUP*OMY2))*DISF(I ,1)
18949 & +(DCHRG*(DLEFT*DWN*OMY2+DRGHT*DUP)
18950 & +DNEUT*(DLEFT*DUP*OMY2+DRGHT*DWN))*DISF(I+6,1))
18951 IF (PROB.GE.PRAN) GOTO 20
18959 IF ((LEP.EQ. 1.AND.MOD(IQK+IDHW(1),2).EQ.0)
18960 & .OR.(LEP.EQ.-1.AND.MOD(IQK+IDHW(1),2).EQ.1)) IQKIN=IQK+6
18961 C---FIND FLAVOUR OF THE OUTGOING QUARK
18964 IF (DUP.EQ.ONE) THEN
18966 PROB=PROB+VCKM(IQK/2,I)
18967 IF (PROB.GE.PRAN) GOTO 40
18971 IF (IQKIN.GT.6) IQKOUT=IQKOUT+6
18974 PROB=PROB+VCKM(I,(IQK+1)/2)
18975 IF (PROB.GE.PRAN) GOTO 60
18979 IF (IQKIN.GT.6) IQKOUT=IQKOUT+6
18982 C---NEUTRAL CURRENT PROCESS
18985 PROB=EFACT*(AF(1,IQK)*YPLUS*DISF(IQK,1)+
18986 & FLOAT(LEP)*AF(3,IQK)*YMNUS*DISF(IQK,1))
18987 IF (PROB.LT.PRAN) IQKIN=IQK+6
18989 C---FIND FLAVOUR OF THE STRUCK QUARK (IF NOT SELECTED BY THE USER)
18993 IF (I.GT.6) SIG=-ONE
18994 PROB=PROB+EFACT*(AF(1,I)*YPLUS*DISF(I,1)+
18995 & FLOAT(LEP)*SIG*AF(3,I)*YMNUS*DISF(I,1))
18996 IF (PROB.GE.PRAN) GOTO 80
19013 C---CHECK PHASE SPACE WITH THE SELECTED FLAVOUR. IF OUTSIDE THE
19015 PA=XBJ*(PHEP(4,IHAD)+ABS(PHEP(3,IHAD)))
19016 EQ=HALF*(PA+RMASS(IDN(2))**2/PA)
19018 SHAT=(PHEP(4,1)+EQ)**2-(PHEP(3,1)+PZQ)**2
19019 PCMEQ=HWUPCM(SQRT(SHAT),MLEP,RMASS(IDN(2)))
19020 PCMLQ=HWUPCM(SQRT(SHAT),MLSCAT,RMASS(IDN(4)))
19021 IF (PCMLQ.LT.ZERO) THEN
19022 CALL HWWARN('HWHDIS',101,*999)
19023 ELSEIF (PCMLQ.EQ.ZERO) THEN
19026 COSTH=(TWO*SQRT(PCMEQ**2+MLEP**2)*SQRT(PCMLQ**2+MLSCAT**2)
19027 & -(Q2+MLEP**2+MLSCAT**2))/(TWO*PCMEQ*PCMLQ)
19029 IF (ABS(COSTH).GT.ONE) CALL HWWARN('HWHDIS',102,*999)
19031 CALL HWETWO(.TRUE.,.TRUE.)
19035 C---CHOOSE X,Y (CC PROCESS)
19036 YMIN=MAX(YBMIN,Q2MIN/SMA)
19037 YMAX=MIN(YBMAX,ONE)
19038 IF (YMIN.GT.YMAX) GOTO 999
19039 Y=HWRUNI(0,YMIN,YMAX)
19041 XXMAX=MIN(Q2MAX/SMA/Y,ONE)
19042 IF (XXMIN.GT.XXMAX) GOTO 999
19043 XBJ=HWRUNI(0,XXMIN,XXMAX)
19044 Q2=XBJ*Y*(S-MLEP**2-MHAD**2)
19045 JACOBI=(YMAX-YMIN)*(XXMAX-XXMIN)*(S-MLEP**2-MHAD**2)*XBJ
19047 C---CHOOSE X,Q**2 (NC PROCESS)
19048 Q2SUP=MIN(Q2MAX,SMA*YBMAX)
19049 IF (Q2MIN.GT.Q2SUP) GOTO 999
19050 SAMP=(A1+A2+A3)*HWRGEN(0)
19051 IF (SAMP.LE.A1) THEN
19052 Q2=HWRUNI(0,Q2MIN,Q2SUP)
19053 ELSEIF (SAMP.LE.(A1+A2)) THEN
19054 Q2=EXP(HWRUNI(0,LOG(Q2MIN),LOG(Q2SUP)))
19056 Q2=-ONE/HWRUNI(0,-ONE/Q2MIN,-ONE/Q2SUP)
19059 & (A1/(Q2SUP-Q2MIN)
19060 & +A2/LOG(Q2SUP/Q2MIN)/Q2
19061 & +A3*Q2MIN*Q2SUP/(Q2SUP-Q2MIN)/Q2**2)
19064 IF (YBMIN.GT.ZERO) XXMAX=MIN(Q2/SMA/YBMIN,ONE)
19065 IF (XXMIN.GT.XXMAX) GOTO 999
19066 SAMP=(B1+B2)*HWRGEN(0)
19067 IF (SAMP.LE.B1) THEN
19068 XBJ=HWRUNI(0,XXMIN,XXMAX)
19070 XBJ=EXP(HWRUNI(0,LOG(XXMIN),LOG(XXMAX)))
19072 XXJAC=(B1+B2)/(B1/(XXMAX-XXMIN)+B2/LOG(XXMAX/XXMIN)/XBJ)
19073 Y=Q2/(S-MLEP**2-MHAD**2)/XBJ
19076 C---CHECK IF THE GENERATED POINT IS INSIDE PHASE SPACE. IF NOT
19077 C RETURN WITH WEIGHT EQUAL TO ZERO.
19078 W=SQRT(MHAD**2+Q2*(ONE-XBJ)/XBJ)
19079 IF (W.LT.WHMIN) RETURN
19081 PCMLW=HWUPCM(SQRT(S),MLSCAT,W)
19082 IF (PCMLW.LT.ZERO) THEN
19085 ELSEIF (PCMLW.EQ.ZERO) THEN
19089 & (TWO*SQRT(PCMEP**2+MLEP**2)*SQRT(PCMLW**2+MLSCAT**2)
19090 & -(Q2+MLEP**2+MLSCAT**2))/(TWO*PCMEP*PCMLW)
19092 IF (ABS(COSPHI).GT.ONE) THEN
19096 C---SET SCALE EQUAL Q. EVALUATE STRUCTURE FUNCTIONS.
19098 CALL HWSFUN(XBJ,EMSCA,IDHW(IHAD),NSTRU,DISF,2)
19099 C---SWITCH OFF ANY FLAVOURS THAT ARE BELOW THRESHOLD
19101 90 IF (W.LT.2*RMASS(I)) DISF(I,1)=0
19102 C---EVALUATE DIFFERENTIAL CROSS SECTION
19104 PROP=RMASS(198)**2/(Q2+RMASS(198)**2)
19105 EFACT=FACT*(HWUAEM(-Q2)*PROP)**2/XBJ
19111 IF (IQK.NE.0.AND.IQK.NE.I) GOTO 100
19113 & ((DCHRG*(DLEFT*DUP+DRGHT*DWN*OMY2)
19114 & +DNEUT*(DLEFT*DWN+DRGHT*DUP*OMY2))*DISF(I ,1)
19115 & +(DCHRG*(DLEFT*DWN*OMY2+DRGHT*DUP)
19116 & +DNEUT*(DLEFT*DUP*OMY2+DRGHT*DWN))*DISF(I+6,1))
19119 EFACT=FACT/XBJ*(HWUAEM(-Q2)/Q2)**2
19120 YPLUS=ONE+(ONE-Y)**2
19121 YMNUS=ONE-(ONE-Y)**2
19123 CALL HWUCFF(ILEPT,I,-Q2,AF(1,I))
19129 IF (IQK.NE.0.AND.IQK.NE.I) GOTO 200
19130 SIGMA=SIGMA+EFACT*(AF(1,I)*YPLUS*(DISF(I,1)+DISF(I+6,1))+
19131 & FLOAT(LEP)*AF(3,I)*YMNUS*(DISF(I,1)-DISF(I+6,1)))
19134 C---FIND WEIGHT: DIFFERENTIAL CROSS SECTION TIME THE JACOBIAN FACTOR
19136 IF (EVWGT.LT.ZERO) EVWGT=ZERO
19140 *CMZ :- -18/05/99 12.41.07 by Mike Seymour
19141 *-- Author : Bryan Webber, Ian Knowles and Mike Seymour
19142 C-----------------------------------------------------------------------
19144 C-----------------------------------------------------------------------
19145 C Drell-Yan Production of fermion pairs via photon, Z0 & (if ZPRIME)
19146 C Z' exchange. Lepton universality is assumed for photon and Z, and
19147 C for Z' if no lepton flavour is specified.
19148 C MEAN EVWGT = SIGMA IN NB
19150 C Modified 16/01/01 by BRW to implement Peter Richardson's
19151 C fix for bug in lepton mass effects on branching ratio
19152 C-----------------------------------------------------------------------
19153 INCLUDE 'HERWIG65.INC'
19154 DOUBLE PRECISION HWRGEN,HWRUNI,HWUAEM,EPS,C1,C2,C3,EMSQZ,EMGMZ,
19155 & EMSQZP,EMGMZP,CQF(7,6,16),QPOW,RPOW,A01,A1,A02,A2,A03,A3,CRAN,
19156 & EMJ1,EMJ2,EMJ3,EMJAC,FACT,QSQ,HCS,FACTR,RCS,EXTRA,PMAX,PTHETA
19157 INTEGER IMODE,JQMN,JQMX,JQ,JLMN,JLMX,JL,IQ,I,IADD(2,2),ID1,ID2,
19159 EXTERNAL HWRGEN,HWRUNI,HWUAEM
19160 SAVE HCS,JQMN,JQMX,JLMN,JLMX,C1,C2,C3,QPOW,RPOW,EMSQZ,EMGMZ,
19161 & A1,A01,A2,A02,A3,A03,EMSQZP,EMGMZP,FACT,CQF
19162 PARAMETER (EPS=1.D-9)
19168 C Set limits for which particles to include
19173 IMODE=MOD(IPROC,100)
19174 IF (IMODE.EQ.0) THEN
19177 ELSEIF (IMODE.LE.10) THEN
19180 ELSEIF (IMODE.EQ.50) THEN
19183 ELSEIF (IMODE.GE.50.AND.IMODE.LE.60) THEN
19186 ELSEIF (IMODE.EQ.99) THEN
19192 CALL HWWARN('HWHDYP',500,*999)
19194 C Set up parameters for importance sampling:
19195 C sum of power law and two Breit-Wigners (relative weights C1,C2,C3)
19200 IF (EMPOW.EQ.ONE) CALL HWWARN('HWHDYP',501,*999)
19201 IF (C2.EQ.ZERO) CALL HWWARN('HWHDYP',502,*999)
19202 IF (C3.EQ.ZERO.AND.ZPRIME) CALL HWWARN('HWHDYP',503,*999)
19205 EMSQZ=RMASS(200)**2
19206 EMGMZ=RMASS(200)*GAMZ
19208 A1=(EMMAX**QPOW-A01)/C1
19209 A02=ATAN((EMMIN**2-EMSQZ)/EMGMZ)
19210 A2=(ATAN((EMMAX**2-EMSQZ)/EMGMZ)-A02)/C2
19211 IF (C3.GT.ZERO) THEN
19212 EMSQZP=RMASS(202)**2
19213 EMGMZP=RMASS(202)*GAMZP
19214 A03=ATAN((EMMIN**2-EMSQZP)/EMGMZP)
19215 A3=(ATAN((EMMAX**2-EMSQZP)/EMGMZP)-A03)/C3
19219 C Select a mass for the produced pair
19220 CRAN=(C1+C2+C3)*HWRGEN(1)
19221 IF (CRAN.LT.C1) THEN
19223 EMSCA=(A01+A1*CRAN)**RPOW
19225 ELSEIF (CRAN.LT.C1+C2) THEN
19226 C Use Z Breit-Wigner
19228 QSQ=EMSQZ+EMGMZ*TAN(A02+A2*CRAN)
19231 C Use Z' Breit-Wigner
19233 QSQ=EMSQZP+EMGMZP*TAN(A03+A3*CRAN)
19236 EMJ1=EMSCA**EMPOW/(1-EMPOW)*A1
19237 EMJ2=((QSQ-EMSQZ)**2+EMGMZ**2)/(2*EMSCA*EMGMZ)*A2
19238 IF (C3.GT.ZERO) THEN
19239 EMJ3=((QSQ-EMSQZP)**2+EMGMZP**2)/(2*EMSCA*EMGMZP)*A3
19240 EMJAC=(C1+C2+C3)/(1/EMJ1+1/EMJ2+1/EMJ3)
19242 EMJAC=(C1+C2)/(1/EMJ1+1/EMJ2)
19244 C Select initial momentum fractions
19245 XXMIN=QSQ/PHEP(5,3)**2
19247 CALL HWSGEN(.TRUE.)
19248 FACT=-GEV2NB*HWUAEM(QSQ)**2*PIFAC*8*EMJAC*XLMIN
19249 $ /(3*NCOLO*EMSCA**3)
19250 C Store cross-section coefficients
19253 IF (EMSCA.GT.2.*RMASS(JQ)) THEN
19254 CALL HWUCFF(IQ,JQ,QSQ,CQF(1,IQ,JQ))
19256 CALL HWVZRO(7,CQF(1,IQ,JQ))
19260 IF (EMSCA.GT.2.*RMASS(JL+110)) THEN
19261 CALL HWUCFF(IQ,JL,QSQ,CQF(1,IQ,JL))
19263 CALL HWVZRO(7,CQF(1,IQ,JL))
19271 C I=1 quark first, I=2 anti-quark first
19275 IF (DISF(ID1,1).LT.EPS.OR.DISF(ID2,2).LT.EPS) GOTO 80
19276 FACTR=FACT*DISF(ID1,1)*DISF(ID2,2)
19277 C Quark final states
19282 HCS=HCS+FACTR*(CQF(1,IQ,JQ)*FLOAT(NCOLO)+3*HALF*QFCH(IQ)**4)
19283 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID3,ID4,2143,50,*99)
19285 HCS=HCS+FACTR*CQF(1,IQ,JQ)*FLOAT(NCOLO)
19286 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID3,ID4,2143,50,*99)
19289 C Lepton final states
19293 HCS=HCS+FACTR*CQF(1,IQ,JL)
19294 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID3,ID4,2134,50,*99)
19309 C Select polar angle from distribution:
19310 C CQF(1,IQ,JF)*(ONE+COSTH**2)+CQF(3,IQ,JF)*COSTH+EXTRA*(ONE+COSTH)
19311 IF (ID1.EQ.ID3.OR.ID2.EQ.ID3) THEN
19312 EXTRA=TWO*QFCH(ID3)**4/NCOLO
19316 PMAX=2.*(CQF(1,IQ,JF)+EXTRA)+ABS(CQF(3,IQ,JF))
19317 100 COSTH=HWRUNI(0,-ONE,ONE)
19318 PTHETA=CQF(1,IQ,JF)*(ONE+COSTH**2)+TWO*CQF(3,IQ,JF)*COSTH
19319 & +EXTRA*(ONE+COSTH)
19320 IF (PTHETA.LT.PMAX*HWRGEN(1)) GOTO 100
19321 IF (ID1.GT.ID2) COSTH=-COSTH
19323 CALL HWETWO(.TRUE.,.TRUE.)
19326 *CMZ :- -14/03/01 09:03:25 by Peter Richardson
19327 *-- Author : Peter Richardson
19328 C-----------------------------------------------------------------------
19329 SUBROUTINE HWHDYQ(FSTCLL,HCS,IFLOW,IDP,ORD,IQ,MASS)
19330 C-----------------------------------------------------------------------
19331 C Drell-Yan production with a q qbar pair
19332 C-----------------------------------------------------------------------
19333 INCLUDE 'HERWIG65.INC'
19334 INTEGER I,MAP(12),ORD,IFL,IDP(6),IFLOW,QCFL(2,2),GCFL(2),IDZ,IQ
19335 DOUBLE PRECISION HCS,RCS,MQ(2,5),HWRGEN,G(12,2),DIST(2),MG(2)
19336 LOGICAL FSTCLL,MASS
19338 DATA MAP/1,2,3,4,5,6,11,12,13,14,15,16/
19339 DATA QCFL/2413,3142,4123,2341/
19340 DATA GCFL/2413,4123/
19344 RCS = HCS*HWRGEN(1)
19346 C--to the initalisation
19348 C--G(I,1) is the right charge and G(I,2) is the left charge
19350 G(I,1) = VFCH(MAP(I),1)-AFCH(MAP(I),1)
19351 G(I,2) = VFCH(MAP(I),1)+AFCH(MAP(I),1)
19355 C--identify the Z decay product
19357 IF(IDZ.GT.6) IDZ = IDZ-114
19358 C--calculate the matrix elements
19361 CALL HWH2MQ(IQ,IDZ,MG,MQ)
19364 CALL HWH2M0(IQ,IDZ,MG,MQ)
19367 C--multiply the matrix elements by the PDF's to obtain the cross section
19371 C--first the qqbar initial states
19375 DIST(1) = DISF(IDP(1),1)*DISF(IDP(2),2)
19376 DIST(2) = DISF(IDP(1),2)*DISF(IDP(2),1)
19379 IFLOW = QCFL(IFL,ORD)
19380 HCS = HCS+DIST(ORD)*MQ(IFL,IDP(1))/36.0D0
19381 IF(GENEV.AND.HCS.GT.RCS) RETURN
19385 C--then the gluon gluon inital state
19388 DIST(1) = DISF(IDP(1),1)*DISF(IDP(1),2)
19391 HCS = HCS+DIST(1)*MG(IFL)/256.0D0
19392 IF(GENEV.AND.HCS.GT.RCS) RETURN
19396 *CMZ :- -19/03/92 10.13.56 by Mike Seymour
19397 *-- Author : Mike Seymour
19398 C-----------------------------------------------------------------------
19400 C----------------------------------------------------------------------
19401 C HARD PROCESS: EE --> EEGAMGAM --> EEFFBAR/WW
19402 C MEAN EVENT WEIGHT = CROSS-SECTION IN NB
19403 C AFTER CUTS ON PT AND MASS OF CENTRE-OF-MASS SYSTEM
19404 C AND COS(THETA) IN CENTRE-OF-MASS SYSTEM
19405 C AND TIMES BRANCHING FRACTION IF WW
19406 C-----------------------------------------------------------------------
19407 INCLUDE 'HERWIG65.INC'
19408 DOUBLE PRECISION HWRGEN,HWULDO,EMSQ,BETA,S,T,U,TMIN,TMAX,TRAT,
19409 & DSDT,PROB,X,Z(2),ZMIN,ZMAX,PCMIN,PCMAX,PCFAC,PLOGMI,PLOGMA,PTCMF,
19410 & Q,PC,BLOG,EMCMIN,EMCMAX,EMLMIN,EMLMAX,WGT(6),RWGT,CV,CA,BR,QT(2),
19411 & QX(2),QY(2),PX,PY,ROOTS,DOT,A,B,C,SHAT,PCF(2),PCM(2),PCMAC,ZZ(2),
19413 INTEGER I,IGAM,ID,IDL,ID1,ID2,IHEP,JHEP,NADD,NTRY,NQ,JGAM
19415 EXTERNAL HWRGEN,HWULDO,HWRLOG
19416 SAVE S,BETA,X,ID,NQ,WGT,EMLMIN,EMLMAX,PCFAC,PLOGMA,PLOGMI,SHAT,
19417 & PCF,PCM,Z,PCMAC,NADD
19418 IF (IERROR.NE.0) RETURN
19419 C---INITIALIZE LOCAL COPIES OF EMMIN,EMMAX
19424 IF (.NOT.GENEV) THEN
19425 C---CHOOSE Z1,Z2 AND CALCULATE SUB-PROCESS CROSS-SECTION
19427 C-----FIND FINAL STATE PARTICLES
19428 IHPRO=MOD(IPROC,100)
19429 IF (IHPRO.EQ.0) THEN
19432 COLFAC=FLOAT(NCOLO)
19434 ELSEIF (IHPRO.LE.6) THEN
19437 COLFAC=FLOAT(NCOLO)
19440 ELSEIF (IHPRO.LE.9) THEN
19446 ELSEIF (IHPRO.LE.10) THEN
19451 CALL HWWARN('HWHEGG',200,*999)
19453 C-----SPLIT ELECTRONS TO PHOTONS
19456 S=2*HWULDO(PHEP(1,1),PHEP(1,2))
19458 EMCMIN=MAX(EMLMIN,MAX(2*RMASS(ID),PTMIN))
19459 EMCMAX=MIN(EMLMAX,ROOTS)
19460 IF (EMCMIN.GT.EMCMAX) RETURN
19462 ZMAX=1-PHEP(5,1)/PHEP(4,1)
19463 IF (ZMIN.GT.ZMAX) RETURN
19464 CALL HWEGAM(1,ZMIN,ZMAX,.TRUE.)
19465 Z(1)=PHEP(4,NHEP-1)/PHEP(4,1)
19466 ZMIN=EMCMIN**2/(Z(1)*S)
19467 ZMAX=MIN(EMCMAX**2/(Z(1)*S), ONE-PHEP(5,2)/PHEP(4,2))
19468 IF (ZMIN.GT.ZMAX) RETURN
19469 CALL HWEGAM(2,ZMIN,ZMAX,.TRUE.)
19470 Z(2)=PHEP(4,NHEP-1)/PHEP(4,2)
19473 C-----REMOVE LOG TERMS FROM WEIGHT, CALCULATE NEW ONES FROM PT LIMITS
19474 GAMWT=GAMWT/(0.5*LOG((1-Z(1))*S/(Z(1)*PHEP(5,1)**2))
19475 & *0.5*LOG((1-Z(2))*Z(1)*S/(Z(2)*PHEP(5,2)**2)))
19476 PCF(1)=Z(1)*PHEP(5,1)
19477 PCF(2)=Z(2)*PHEP(5,2)
19478 PCFAC=SQRT(PCF(1)*PCF(2))
19479 PCM(1)=(1-Z(1))*PHEP(4,1)
19480 PCM(2)=(1-Z(2))*PHEP(4,2)
19481 PCMAC=SQRT(PCM(1)*PCM(2))
19482 PCMIN=MAX(PTMIN,MAX(PCF(1),PCF(2)))
19483 PCMAX=MIN( MIN(PTMAX,PHEP(5,3)) , MIN(PCM(1),PCM(2)) )
19484 IF (PCMIN.GT.PCMAX) RETURN
19485 PLOGMI=(LOG(PCMIN/PCFAC))**2
19486 PLOGMA=(LOG(PCMAX/PCFAC))**2
19487 GAMWT=GAMWT*(PLOGMA-PLOGMI)
19488 C-----CALCULATE CROSS-SECTION
19491 IF (IHPRO.EQ.0) THEN
19497 IF (X.GT.ONE) GOTO 10
19499 BLOG=LOG((1+BETA*CTMAX)/(1-BETA*CTMAX))/BETA
19500 IF (IHPRO.LE.9) THEN
19501 EVWGT=EVWGT+GEV2NB*4*PIFAC*COLFAC*Q**4*ALPHEM**2*BETA
19502 & /SHAT * GAMWT * ( (1+X-0.5*X**2)*BLOG
19503 & - CTMAX*(1+X**2/(CTMAX**2*(X-1)+1)) )
19506 CALL HWDBOZ(198,ID1,ID2,CV,CA,BR,1)
19507 CALL HWDBOZ(199,ID1,ID2,CV,CA,BR,1)
19508 EVWGT=EVWGT + GEV2NB*6*PIFAC*ALPHEM**2*BETA/SHAT*BR
19509 & * GAMWT * (-( X-0.5*X**2)*BLOG
19510 & + CTMAX*(1+(X**2+16/3.)/(CTMAX**2*(X-1)+1)) )
19513 C-----GAMWT MUST BE RESET TO ONE, SINCE IT IS REAPPLIED LATER!
19517 C-----CHOOSE PT OF THE CMF
19518 PTCMF=PCFAC*EXP(SQRT(HWRGEN(0)*(PLOGMA-PLOGMI)+PLOGMI))
19519 C-----CHOOSE WHICH PHOTON USUALLY HAS SMALLER PT
19522 IF (LOG(PCM(1)/PCF(1)).LT.HWRGEN(1)*2*LOG(PCMAC/PCFAC)) IGAM=2
19524 C-----CHOOSE ITS PT
19526 IF (NTRY.GT.NBTRY) CALL HWWARN('HWHEGG',100,*999)
19527 QT(IGAM)=(PCM(IGAM)/PCF(IGAM))**HWRGEN(2)
19528 PROB=(QT(IGAM)**2/(QT(IGAM)**2+1))**2
19529 QT(IGAM)=QT(IGAM)*PCF(IGAM)
19530 IF (HWRLOG(1-PROB)) GOTO 30
19531 C-----CHOOSE ITS DIRECTION
19532 CALL HWRAZM(QT(IGAM),QX(IGAM),QY(IGAM))
19533 C-----CALCULATE THE OTHER PHOTON'S PT
19534 QX(JGAM)=PTCMF-QX(IGAM)
19535 QY(JGAM)= -QY(IGAM)
19536 QT(JGAM)=SQRT(QX(JGAM)**2+QY(JGAM)**2)
19537 IF (QT(JGAM).LT.PCF(JGAM).OR.QT(JGAM).GT.PCM(JGAM)) GOTO 20
19538 C-----APPLY A RANDOM ROTATION AROUND THE BEAM AXIS
19539 CALL HWRAZM(ONE,PX,PY)
19540 IF (PX.EQ.ZERO) PX=1D-20
19541 QX(1)=(QX(1)*PX -QY(1)*PY)
19542 QY(1)=(QY(1) +QX(1)*PY)/PX
19543 QX(2)=(QX(2)*PX -QY(2)*PY)
19544 QY(2)=(QY(2) +QX(2)*PY)/PX
19545 C-----RECONSTRUCT MOMENTA
19546 IF (QT(IGAM).GT.QT(JGAM)) THEN
19550 DOT=-Z(JGAM)*S+SHAT+2*(QX(1)*QX(2)+QY(1)*QY(2))
19551 C-------SOLVE QUADRATIC IN Z(IGAM) TO FIND ELECTRON ENERGIES
19552 A=S*(S*Z(JGAM)+QT(JGAM)**2)
19553 B=S*DOT*(1+Z(JGAM))
19554 C=DOT**2+S*QT(IGAM)**2*(1-Z(JGAM))**2-4*QT(IGAM)**2*QT(JGAM)**2
19555 IF (B**2.LT.4*A*C) GOTO 20
19556 ZZ(IGAM)=(-B+SQRT(B**2-4*A*C))/(2*A)
19557 IF (ZZ(IGAM).LT.ZERO .OR. ZZ(IGAM).GT.ONE-Z(IGAM)) GOTO 20
19559 C-------REJECT AGAINST PHOTON DISTRIBUTION FUNCTION
19560 PROB=((1+ZZ(IGAM)**2)/(1-ZZ(IGAM)))/((1+(1-Z(IGAM))**2)/Z(IGAM))
19561 & *((1+ZZ(JGAM)**2)/(1-ZZ(JGAM)))/((1+(1-Z(JGAM))**2)/Z(JGAM))
19562 IF (HWRLOG(1-PROB)) GOTO 20
19563 C-------RECONSTRUCT ALL OTHER VARIABLES
19568 PHEP(4,IGAM)=ZZ(I)*PHEP(4,I)
19569 PHEP(5,IGAM)=RMASS(IDHW(IGAM))
19570 C---------IF MOMENTUM CANNOT BE CONSERVED TRY AGAIN
19571 IF (PHEP(4,IGAM)**2-PHEP(5,IGAM)**2-QT(I)**2 .LT. 0) GOTO 20
19572 PHEP(3,IGAM)=SIGN(SQRT(PHEP(4,IGAM)**2-PHEP(5,IGAM)**2-
19573 & QT(I)**2),PHEP(3,IGAM))
19574 CALL HWVDIF(4,PHEP(1,I),PHEP(1,IGAM),PHEP(1,IGAM-1))
19575 CALL HWUMAS(PHEP(1,IGAM-1))
19577 C-----TIDY UP EVENT RECORD
19580 IDHEP(NHEP)=IDHEP(3)
19582 CALL HWVSUM(4,PHEP(1,4),PHEP(1,6),PHEP(1,NHEP))
19583 CALL HWVSUM(4,PHEP(1,1),PHEP(1,2),PHEP(1,3))
19584 CALL HWUMAS(PHEP(1,NHEP))
19585 CALL HWUMAS(PHEP(1,3))
19590 C-----CHOOSE FINAL STATE QUARK
19591 IF (IHPRO.EQ.0) THEN
19592 RWGT=HWRGEN(2)*EVWGT
19595 IF (RWGT.GT.WGT(IDL)) ID=IDL+1
19601 C-----CHOOSE T (WHERE T = MANDELSTAM_T - EMSQ)
19603 TMAX=-SHAT/2*(1-BETA*CTMAX)
19606 IF (IHPRO.LE.9) THEN
19607 C-------FOR FFBAR, CHOOSE T ACCORDING TO -SHAT/T
19609 IF (NTRY.GT.NBTRY) CALL HWWARN('HWHEGG',101,*999)
19610 T=TRAT**HWRGEN(3)*TMIN
19612 C-------REWEIGHT TO CORRECT DISTRIBUTION
19613 DSDT=(T*U-2*EMSQ*(T+2*EMSQ))/T**2
19614 & +( 2*EMSQ*(SHAT-4*EMSQ))/(T*U)
19615 & +(T*U-2*EMSQ*(U+2*EMSQ))/U**2
19616 PROB=-DSDT*T/SHAT / (1 + 2*X - 2*X**2)
19617 IF (HWRLOG(1-PROB)) GOTO 60
19619 C-------FOR WW, CHOOSE T ACCORDING TO (SHAT/T)**2
19621 IF (NTRY.GT.NBTRY) CALL HWWARN('HWHEGG',102,*999)
19622 T=TMAX/(1-(1-TRAT)*HWRGEN(4))
19624 C-------REWEIGHT TO CORRECT DISTRIBUTION
19625 DSDT=( 3*(T*U)**2 - SHAT*T*U*(4*SHAT+6*EMSQ)
19626 & + SHAT**2*(2*SHAT**2+6*EMSQ**2) ) / (T*U)**2
19627 PROB=DSDT*(T/SHAT)**2 / (4.75 - 1.5*X + 1.5*X**2)
19628 IF (HWRLOG(1-PROB)) GOTO 70
19630 C-----SYMMETRIZE IN T,U
19631 IF (HWRLOG(HALF)) T=U
19632 C-----FILL EVENT RECORD
19633 COSTH=(1+2*T/SHAT)/BETA
19634 PC=0.5*BETA*PHEP(5,NHEP)
19635 PHEP(5,NHEP+1)=RMASS(ID)
19636 PHEP(5,NHEP+2)=RMASS(ID)
19637 CALL HWDTWO(PHEP(1,NHEP),PHEP(1,NHEP+1),PHEP(1,NHEP+2),
19643 IF (IHPRO.LE.6) ISTHEP(IHEP)=112+I
19644 IDHW(IHEP)=ID+NADD*(I-1)
19645 IDHEP(IHEP)=IDPDG(IDHW(IHEP))
19646 JDAHEP(I,NHEP)=IHEP
19647 JMOHEP(1,IHEP)=NHEP
19648 JMOHEP(2,IHEP)=JHEP
19649 JDAHEP(2,IHEP)=JHEP
19650 IF (IHPRO.EQ.10) THEN
19651 RHOHEP(1,IHEP)=0.3333
19652 RHOHEP(2,IHEP)=0.3333
19653 RHOHEP(3,IHEP)=0.3333
19660 *CMZ :- -26/04/91 10.18.56 by Bryan Webber
19661 *-- Author : Mike Seymour
19662 C-----------------------------------------------------------------------
19664 C----------------------------------------------------------------------
19665 C W + GAMMA --> FF'BAR : MEAN EVWGT = CROSS SECTION IN NANOBARN
19666 C BASED ON BOSON GLUON FUSION OF ABBIENDI AND STANCO
19667 C-----------------------------------------------------------------------
19668 INCLUDE 'HERWIG65.INC'
19669 DOUBLE PRECISION HWRGEN,GMASS,EV(3),RV,Y,Q2,SHAT,Z,PHI,AJACOB,
19670 & DSIGMA,ME,MP,ML,MREMIF(18),MFIN1(18),MFIN2(18),RS,SMA,W2,RSHAT
19672 INTEGER LEPFIN,ID1,ID2,I,IQK,IFLAVU,IFLAVD,IMIN,IMAX,IFL,IPROO
19673 LOGICAL CHARGD,INCLUD(18),INSIDE(18)
19675 SAVE LEPFIN,ID1,ID2
19676 COMMON /HWAREA/ Y,Q2,SHAT,Z,PHI,AJACOB,DSIGMA,ME,MP,ML,MREMIF,
19677 & MFIN1,MFIN2,RS,SMA,W2,RSHAT,IQK,IFLAVU,IFLAVD,IMIN,IMAX,IFL,LEP,
19678 & IPROO,CHARGD,INCLUD,INSIDE
19690 1 IDHEP(I)=IDPDG(IDHW(I))
19726 C---COMPUTATION OF MOMENTA IN LABORATORY FRAME OF REFERENCE
19727 C---Persuade HWHBKI that the gluon is actually a photon...
19732 C---put the other outgoing lepton in as well
19734 IDHEP(10)=IDPDG(IDHW(10))
19742 CALL HWVDIF(4,PHEP(1,2),PHEP(1,5),PHEP(1,10))
19743 CALL HWUMAS(PHEP(1,10))
19746 C---if antilepton was first, do charge conjugation
19747 IF (LEP.EQ.-1) THEN
19749 IF (IDHEP(I).NE.0 .AND. ABS(IDHEP(I)).LT.20) THEN
19750 IDHW(I)=IDHW(I) + 6*SIGN(1,IDHEP(I))
19756 C---half the time, do charge conjugation and parity flip
19757 IF (HWRGEN(0).GT.HALF) THEN
19759 IF (IDHEP(I).NE.0 .AND. ABS(IDHEP(I)).LT.20) THEN
19760 IDHW(I)=IDHW(I) + 6*SIGN(1,IDHEP(I))
19763 PHEP(1,I)=-PHEP(1,I)
19764 PHEP(2,I)=-PHEP(2,I)
19765 PHEP(3,I)=-PHEP(3,I)
19767 JMOHEP(1,10)=3-JMOHEP(1,10)
19773 C---LEP = 1 IF TRACK 1 IS A LEPTON, -1 FOR ANTILEPTON
19775 IF (IDHW(1).GE.121.AND.IDHW(1).LE.126) THEN
19777 ELSEIF (IDHW(1).GE.127.AND.IDHW(1).LE.132) THEN
19780 IF (LEP.EQ.0) CALL HWWARN('HWHEGW',500,*999)
19781 C---program only works if beam and target are charge conjugates
19782 IF (LEP*(IDHW(2)-IDHW(1)).NE.6)
19783 & CALL HWWARN('HWHEGW',501,*999)
19784 C---program only works for equal energy beams colliding
19785 IF (PHEP(3,3).NE.ZERO) CALL HWWARN('HWHEGW',503,*999)
19787 C---FINAL STATE IS ALWAYS SET UP AS IF PARTICLE IS BEFORE ANTI-PARTICLE
19788 C AND THEN INVERTED IF NECESSARY
19789 LEPFIN = MIN(IDHW(1),IDHW(2))+1
19795 ELSEIF (IQK.LE.4) THEN
19800 ELSEIF (IQK.LE.6) THEN
19805 ELSEIF (IQK.EQ.7) THEN
19810 C---INTERFERENCE TERMS IN EE -> EE NUE NUEB NEGLECTED: SIGMA UNRELIABLE
19811 IF (FSTWGT) CALL HWWARN('HWHEGW',1,*999)
19812 ELSEIF (IQK.EQ.8) THEN
19817 ELSEIF (IQK.EQ.9) THEN
19823 CALL HWWARN('HWHEGW',504,*999)
19826 IF (IQK.LE.6) IQK=0
19829 EVWGT = 2 * DSIGMA * AJACOB
19830 IF (EVWGT.LT.ZERO) EVWGT=ZERO
19832 C---SUM OVER QUARK FLAVOURS
19835 IF (SHAT.GT.(RMASS(IFLAVD)+RMASS(IFLAVU))**2) THEN
19837 EV(I) = 2 * DSIGMA * AJACOB
19838 IF (EV(I).LT.ZERO) EV(I)=ZERO
19847 C---CHOOSE QUARK FLAVOUR
19849 IF (RV.LT.EV(1)) THEN
19852 ELSEIF (RV.LT.EV(2)) THEN
19863 *CMZ :- -17/07/92 16.42.56 by Mike Seymour
19864 *-- Author : Mike Seymour
19865 C-----------------------------------------------------------------------
19867 C-----------------------------------------------------------------------
19868 C COMPUTES DIFFERENTIAL CROSS SECTION DSIGMA IN (Y,Q2,ETA,Z,PHI)
19869 C-----------------------------------------------------------------------
19870 INCLUDE 'HERWIG65.INC'
19871 DOUBLE PRECISION TMAX,TMIN,A1,A2,B1,B2,I0,I1,I2,I3,I4,I5,MUSQ,
19872 & MDSQ,ETA,Q1,COSTHE,S,G,T,U,C1,C2,D1,D2,F1,F2,COSBET,WPROP,D(4,4),
19873 & C(4,4),QU,QD,QE,QW,PHOTON,EMWSQ,EMSSQ,CFAC,Y,Q2,SHAT,Z,PHI,
19874 & AJACOB,DSIGMA,ME,MP,ML,MREMIF(18),MFIN1(18),MFIN2(18),RS,SMA,W2,
19876 INTEGER IQK,IFLAVU,IFLAVD,IMIN,IMAX,IFL,IPROO,I,J,LEP
19877 LOGICAL CHARGD,INCLUD(18),INSIDE(18)
19878 COMMON /HWAREA/ Y,Q2,SHAT,Z,PHI,AJACOB,DSIGMA,ME,MP,ML,MREMIF,
19879 & MFIN1,MFIN2,RS,SMA,W2,RSHAT,IQK,IFLAVU,IFLAVD,IMIN,IMAX,IFL,LEP,
19880 & IPROO,CHARGD,INCLUD,INSIDE
19881 C---INPUT VARIABLES
19882 IF (IERROR.NE.0) RETURN
19884 IF (IFLAVU.LE.12) THEN
19885 QU=QFCH(MOD(IFLAVU-1,6)+1)
19886 QD=QFCH(MOD(IFLAVD-1,6)+1)
19889 QU=QFCH(MOD(IFLAVU-1,6)+11)
19890 QD=QFCH(MOD(IFLAVD-1,6)+11)
19895 EMWSQ=RMASS(198)**2
19898 MUSQ=RMASS(IFLAVU)**2
19899 MDSQ=RMASS(IFLAVD)**2
19900 ETA=(SHAT+Q2)/EMSSQ/Y
19901 IF (ETA.GT.ONE) RETURN
19902 C---CALCULATE KINEMATIC TERMS
19903 G=0.5*(ETA*EMSSQ*Y-Q2) -0.5*(MUSQ+MDSQ)
19905 T=0.5*ETA*EMSSQ*(1-Y)
19907 C1=0.5*ETA*EMSSQ*Y*Z
19908 C2=0.5*ETA*EMSSQ*Y*(1-Z)
19909 COSBET=(-ETA*EMSSQ*Y+Q2*(2-Y))/(Y*(ETA*EMSSQ-Q2))
19910 IF (SHAT.LE.(RMASS(IFLAVU)+RMASS(IFLAVD))**2) RETURN
19911 Q1=SQRT((SHAT**2+MUSQ**2+MDSQ**2
19912 & -2*SHAT*MUSQ-2*SHAT*MDSQ-2*MUSQ*MDSQ)/SHAT**2)
19913 COSTHE=(1+(MDSQ-MUSQ)/SHAT-2*Z)/Q1
19914 IF (ABS(COSTHE).GE.ONE .OR. ABS(COSBET).GE.ONE) RETURN
19915 D1=0.25*(ETA*EMSSQ-Q2)*(1+(MDSQ-MUSQ)/SHAT-Q1*
19916 & (COSTHE*COSBET+SQRT((1-COSTHE**2)*(1-COSBET**2))*COS(PHI)))
19920 C---CALCULATE TRACE TERMS
19925 D(3,3)=-D1*(2*F2*G-D2*(F1+2*U))
19926 & -D2*F1*(F2+U-D2+F1)
19928 & -G*(-2*D1*(F1+F2+U)-F1*(D2+2*U)+2*D2*(U-F2)+2*U*(F2-U+G))
19930 D(1,2)=(D1+U-F2)*(D1*F2-F1*D2)-G*(D1*(F2+U)+U*(U-F2-G)+F1*D2)
19931 D(1,3)=D1*F2*(-2*F1+U-F2+D1)
19932 & +F1*(F2*(D2-2*U)+F1*D2)
19933 & +G*(-D1*(2*F1+F2+U)-F1*(D2+2*U)+U*(F2-U+G))
19934 D(1,4)=-2*F1*(D1+U)*(F2+G)
19935 D(2,3)=D1*(D2*(F1+2*(U-F2))+F2*(F2-U-D1))
19937 & +G*(D1*(F2+U)+D2*(F1-2*(U-F2))+U*(U-F2-G))
19938 D(2,4)=-D1*F2*(U-F2+D1)
19939 & -F1*D2*(U-D1-G-F2)
19940 & -G*(U*(F2-U+G)-D1*(F2+U))
19941 D(3,4)=D1*(F1*(D2+2*F2)+F2*(F2-U-D1))
19942 & +F1*(2*F2*U-D2*(U+F1))
19943 & +G*(D1*(2*F1+F2+U)+U*(2*F1-F2+U-G))
19944 C---REGULATE PROPAGATORS
19947 A1=2*C1+MDSQ*(G+U)/G
19948 A2=2*C2+MUSQ*(G+U)/G
19949 B1=(2*U+MUSQ)/(2*G+2*U)
19950 B2=(2*U+MDSQ)/(2*G+2*U)
19952 I1=1/A1*(I0-LOG((A1+B1*TMAX)/(A1+B1*TMIN)))
19953 I2=1/A2*(I0-LOG((A2+B2*TMAX)/(A2+B2*TMIN)))
19954 I3=(B1*I1-B2*I2)/(B1*A2-B2*A1)
19955 I4=1/A1*(I1+1/(A1+B1*TMAX)-1/(A1+B1*TMIN))
19956 I5=1/A2*(I2+1/(A2+B2*TMAX)-1/(A2+B2*TMIN))
19957 WPROP=1/((2*G-EMWSQ)**2+GAMW**2*EMWSQ)
19958 C---CALCULATE COEFFICIENTS
19959 C(1,1)= QU**2/(2*U+EMWSQ)**2 *I5
19960 C(2,2)= QD**2/(2*U+EMWSQ)**2 *I4
19961 C(3,3)= QW**2/(2*U+EMWSQ)**2 *WPROP *I0
19962 C(4,4)= QE**2/(2*S)**2 *WPROP *I0
19963 C(1,2)= 2*QU*QD/(2*U+EMWSQ)**2 *I3
19964 C(1,3)= 2*QW*QU/(2*U+EMWSQ)**2 *WPROP*(2*G-EMWSQ) *I2
19965 C(1,4)= 2*QU*QE/(2*S*(2*U+EMWSQ)) *WPROP*(2*G-EMWSQ) *I2
19966 C(2,3)= 2*QW*QD/(2*U+EMWSQ)**2 *WPROP*(2*G-EMWSQ) *I1
19967 C(2,4)= 2*QD*QE/(2*S*(2*U+EMWSQ)) *WPROP*(2*G-EMWSQ) *I1
19968 C(3,4)= 2*QW*QE/(2*S*(2*U+EMWSQ)) *WPROP *I0
19969 C---CALCULATE PHOTON STRUCTURE FUNCTION
19970 PHOTON=ALPHEM * (1+(1-ETA)**2) / (2*PIFAC*ETA)
19971 C---SUM ALL TENSOR CONTRIBUTIONS
19974 10 DSIGMA=DSIGMA + C(I,J)*D(I,J)
19975 C---CALCULATE TOTAL SUMMED AND AVERAGED MATRIX ELEMENT SQUARED
19976 DSIGMA = DSIGMA * 2*CFAC*(4*PIFAC*ALPHEM)**3/SWEIN**2
19977 C---CALCULATE DIFFERENTIAL CROSS-SECTION
19978 DSIGMA = DSIGMA * GEV2NB*PHOTON/(512*PIFAC**4*ETA*EMSSQ)
19981 *CMZ :- -12/10/01 10.05.16 by Peter Richardson
19982 *-- Author : Bryan Webber and Ian Knowles
19983 C-----------------------------------------------------------------------
19985 C-----------------------------------------------------------------------
19986 C (Initially polarised) e+e- --> ffbar (f=quark, mu or tau)
19987 C If IPROC=107: --> gg, distributed as sum of light quarks.
19988 C If fermion flavour specified mass effects fully included.
19989 C EVWGT=sig(e+e- --> ffbar) in nb
19990 C-----------------------------------------------------------------------
19991 INCLUDE 'HERWIG65.INC'
19992 DOUBLE PRECISION HWRGEN,HWRUNI,HWUPCM,HWUAEM,Q2NOW,Q2LST,FACTR,
19993 & VF2,VF,CLF(7),PRAN,PQWT,PMAX,PTHETA,SINTH2,CPHI,SPHI,C2PHI,S2PHI,
19994 & PPHI,SINTH,PCM,PP(5),EWGT
19995 INTEGER ID1,ID2,IDF,IQ,IQ1,I
19996 EXTERNAL HWRGEN,HWRUNI,HWUPCM,HWUAEM
19997 SAVE Q2LST,FACTR,ID1,ID2,VF2,VF,CLF,EWGT
20001 C Choose quark flavour
20002 PRAN=TQWT*HWRGEN(0)
20005 PQWT=PQWT+CLQ(1,IQ)
20006 IF (PQWT.GT.PRAN) GOTO 11
20011 20 CLF(I)=CLQ(I,IQ)
20015 C Label particles, assign outgoing particle masses
20024 PHEP(5,NHEP+2)=RMASS(13)
20025 PHEP(5,NHEP+3)=RMASS(13)
20029 IDHEP(NHEP+2)=IDPDG(IQ1)
20030 IDHEP(NHEP+3)=-IDHEP(NHEP+2)
20031 PHEP(5,NHEP+2)=RMASS(IQ1)
20032 PHEP(5,NHEP+3)=RMASS(IQ1)
20037 IF (JDAHEP(1,1).NE.0) JMOHEP(1,NHEP+1)=JDAHEP(1,1)
20039 IF (JDAHEP(1,2).NE.0) JMOHEP(2,NHEP+1)=JDAHEP(1,2)
20040 JMOHEP(1,NHEP+2)=NHEP+1
20041 JMOHEP(2,NHEP+2)=NHEP+3
20042 JMOHEP(1,NHEP+3)=NHEP+1
20043 JMOHEP(2,NHEP+3)=NHEP+2
20044 JDAHEP(1,NHEP+1)=NHEP+2
20045 JDAHEP(2,NHEP+1)=NHEP+3
20047 JDAHEP(2,NHEP+2)=NHEP+3
20049 JDAHEP(2,NHEP+3)=NHEP+2
20050 C Generate polar and azimuthal angular distributions:
20051 C CLF(1)*(1+(VF*COSTH)**2)+CLF(2)*(1-VF**2)+CLF(3)*2.*VF*COSTH
20052 C +(VF*SINTH)**2*(CLF(4)*COS(2*PHI-PHI1-PHI2)
20053 C +CLF(6)*SIN(2*PHI-PHI1-PHI2))
20054 PMAX=CLF(1)*(1.+VF2)+CLF(2)*(1.-VF2)+ABS(CLF(3))*2.*VF
20055 30 COSTH=HWRUNI(0,-ONE, ONE)
20056 PTHETA=CLF(1)*(1.+VF2*COSTH**2)+CLF(2)*(1.-VF2)
20057 & +CLF(3)*2.*VF*COSTH
20058 IF (PTHETA.LT.PMAX*HWRGEN(1)) GOTO 30
20059 IF (IDHW(1).GT.IDHW(2)) COSTH=-COSTH
20062 PMAX=PTHETA+VF2*SINTH2*SQRT(CLF(4)**2+CLF(6)**2)
20063 40 CALL HWRAZM(ONE,CPHI,SPHI)
20064 C2PHI=2.*CPHI**2-1.
20066 PPHI=PTHETA+(CLF(4)*(C2PHI*COSS+S2PHI*SINS)
20067 & +CLF(6)*(S2PHI*COSS-C2PHI*SINS))*VF2*SINTH2
20068 IF (PPHI.LT.PMAX*HWRGEN(1)) GOTO 40
20070 CALL HWRAZM(ONE,CPHI,SPHI)
20072 C Construct final state 4-mommenta
20073 CALL HWVEQU(5,PHEP(1,3),PHEP(1,NHEP+1))
20074 PCM=HWUPCM(PHEP(5,NHEP+1),PHEP(5,NHEP+2),PHEP(5,NHEP+3))
20075 C PP is momentum of track NHEP+2 in CoM (track NHEP+1) frame
20077 PP(5)=PHEP(5,NHEP+2)
20078 PP(1)=PCM*SINTH*CPHI
20079 PP(2)=PCM*SINTH*SPHI
20081 PP(4)=SQRT(PCM**2+PP(5)**2)
20082 CALL HWULOB(PHEP(1,NHEP+1),PP(1),PHEP(1,NHEP+2))
20083 CALL HWVDIF(4,PHEP(1,NHEP+1),PHEP(1,NHEP+2),PHEP(1,NHEP+3))
20084 C Set production vertices
20085 CALL HWVZRO(4,VHEP(1,NHEP+2))
20086 CALL HWVEQU(4,VHEP(1,NHEP+2),VHEP(1,NHEP+3))
20091 IF (Q2NOW.NE.Q2LST) THEN
20092 C Calculate coefficients for cross-section
20095 FACTR=PIFAC*GEV2NB*HWUAEM(Q2NOW)**2/Q2NOW
20102 EWGT=FACTR*FLOAT(NCOLO)*TQWT*4./3.
20104 IF (IPROC.LT.150) THEN
20106 FACTR=FACTR*FLOAT(NCOLO)
20111 IF (EMSCA.LE.2.*RMASS(ID1)) then
20114 CALL HWUCFF(11,IDF,Q2NOW,CLF(1))
20115 VF2=1.-4.*RMASS(ID1)**2/Q2NOW
20117 EWGT=FACTR*VF*(CLF(1)*(1.+VF2/3.)+CLF(2)*(1.-VF2))
20125 *CMZ :- -02/05/91 10.57.27 by Federico Carminati
20126 *-- Author : Bryan Webber and Ian Knowles
20127 C-----------------------------------------------------------------------
20129 C-----------------------------------------------------------------------
20130 C (Initially polarised) e-e+ --> qqbar g with parton thrust < THMAX,
20131 C equivalent to: maximum parton energy < THMAX*EMSCA/2; or a JADE E0
20132 c scheme, y_cut=1.-THMAX.
20133 C If flavour specified mass effects fully included.
20134 C EVWGT=sig(e^-e^+ --> qqbar g) in nb
20135 C-----------------------------------------------------------------------
20136 INCLUDE 'HERWIG65.INC'
20137 DOUBLE PRECISION HWRGEN,HWUALF,HWUAEM,HWULDO,HWDPWT,Q2NOW,Q2LST,
20138 & PHASP,QGMAX,QGMIN,FACTR,QM2,CLF(7),ORDER,PRAN,PQWT,QQG,QBG,SUM,
20139 & RUT,QQLM,QQLP,QBLM,QBLP,DYN1,DYN2,DYN3,DYN4,DYN5,DYN6,XQ2,X2SUM,
20141 INTEGER ID1,IQ,I,LM,LP,IQ1
20143 EXTERNAL HWRGEN,HWUALF,HWUAEM,HWULDO,HWDPWT
20144 SAVE Q2NOW,Q2LST,QGMAX,QGMIN,FACTR,ORDER,ID1,MASS,QM2,CLF,LM,LP,
20148 C Label produced partons and calculate gluon spin
20161 JMOHEP(1,NHEP+1)=LM
20162 JMOHEP(2,NHEP+1)=LP
20163 JMOHEP(1,NHEP+2)=NHEP+1
20164 JMOHEP(2,NHEP+2)=NHEP+3
20165 JMOHEP(1,NHEP+3)=NHEP+1
20166 JMOHEP(2,NHEP+3)=NHEP+4
20167 JMOHEP(1,NHEP+4)=NHEP+1
20168 JMOHEP(2,NHEP+4)=NHEP+2
20169 JDAHEP(1,NHEP+1)=NHEP+2
20170 JDAHEP(2,NHEP+1)=NHEP+4
20172 JDAHEP(2,NHEP+2)=NHEP+4
20174 JDAHEP(2,NHEP+3)=NHEP+2
20176 JDAHEP(2,NHEP+4)=NHEP+3
20177 C Decide which quark radiated and assign production vertices
20178 XQ2=(Q2NOW-2.*QBG)**2
20179 X2SUM=XQ2+(Q2NOW-2.*QQG)**2
20180 IF (XQ2.LT.HWRGEN(0)*X2SUM) THEN
20181 C Quark radiated the gluon
20182 CALL HWVZRO(4,VHEP(1,NHEP+4))
20183 CALL HWVSUM(4,PHEP(1,NHEP+2),PHEP(1,NHEP+3),PVRT)
20184 CALL HWUDKL(IQ1,PVRT,VHEP(1,NHEP+3))
20185 CALL HWVEQU(4,VHEP(1,NHEP+3),VHEP(1,NHEP+2))
20187 C Anti-quark radiated the gluon
20188 CALL HWVZRO(4,VHEP(1,NHEP+2))
20189 CALL HWVSUM(4,PHEP(1,NHEP+4),PHEP(1,NHEP+3),PVRT)
20190 CALL HWUDKL(IQ1,PVRT,VHEP(1,NHEP+3))
20191 CALL HWVEQU(4,VHEP(1,NHEP+3),VHEP(1,NHEP+4))
20194 C Calculate the transverse polarisation of the gluon
20195 C Correlation with leptons presently neglected
20196 GPOLN=(QQG**2+QBG**2)/((Q2NOW-2.*SUM)*Q2NOW)
20197 GPOLN=2./(2.+GPOLN)
20203 IF (Q2NOW.NE.Q2LST) THEN
20206 IF (PHASP.LE.ZERO) CALL HWWARN('HWHEPG',400,*999)
20207 QGMAX=.5*Q2NOW*THMAX
20208 QGMIN=.5*Q2NOW*(1.-THMAX)
20209 FACTR=GEV2NB*FLOAT(NCOLO)*CFFAC*HWUALF(1,EMSCA)
20210 & *.5*(HWUAEM(Q2NOW)*PHASP)**2/Q2NOW
20212 IF (JDAHEP(1,LM).NE.0) LM=JDAHEP(1,LM)
20214 IF (JDAHEP(1,LP).NE.0) LP=JDAHEP(1,LP)
20216 IF (IDHW(1).GT.IDHW(2)) ORDER=-ORDER
20221 CALL HWUCFF(11,ID1,Q2NOW,CLF(1))
20230 C Select quark flavour
20231 PRAN=TQWT*HWRGEN(1)
20234 PQWT=PQWT+CLQ(1,IQ)
20235 IF (PQWT.GT.PRAN) GOTO 11
20240 20 CLF(I)=CLQ(I,IQ)
20241 ELSEIF (Q2NOW.GT.4*QM2/(2*THMAX-1)) THEN
20247 C Select final state momentum configuration
20248 CALL HWVEQU(5,PHEP(1,3),PHEP(1,NHEP+1))
20249 PHEP(5,NHEP+2)=RMASS(IQ1)
20250 PHEP(5,NHEP+3)=RMASS(13)
20251 PHEP(5,NHEP+4)=RMASS(IQ1)
20252 30 CALL HWDTHR(PHEP(1,NHEP+1),PHEP(1,NHEP+2),
20253 & PHEP(1,NHEP+3),PHEP(1,NHEP+4),HWDPWT)
20254 QQG=HWULDO(PHEP(1,NHEP+2),PHEP(1,NHEP+3))
20255 IF (QQG.LT.QGMIN) GOTO 30
20256 QBG=HWULDO(PHEP(1,NHEP+4),PHEP(1,NHEP+3))
20258 IF (QBG.LT.QGMIN.OR.SUM.GT.QGMAX) GOTO 30
20259 QQLM=HWULDO(PHEP(1,NHEP+2),PHEP(1,LM))
20260 QQLP=HWULDO(PHEP(1,NHEP+2),PHEP(1,LP))
20261 QBLM=HWULDO(PHEP(1,NHEP+4),PHEP(1,LM))
20262 QBLP=HWULDO(PHEP(1,NHEP+4),PHEP(1,LP))
20263 DYN1=QQLM**2+QQLP**2+QBLM**2+QBLP**2
20265 DYN3=DYN1-2.*(QQLM**2+QBLP**2)
20268 DYN1=DYN1+8.*QM2*(1.-.25*Q2NOW*RUT
20269 & +QQLM*QQLP/(Q2NOW*QBG)+QBLM*QBLP/(Q2NOW*QQG))
20270 DYN2=QM2*(Q2NOW-SUM*(2.+QM2*RUT)
20271 & -4.*HWULDO(PHEP(1,NHEP+3),PHEP(1,LM))
20272 & *HWULDO(PHEP(1,NHEP+3),PHEP(1,LP))/Q2NOW)
20273 DYN3=DYN3+QM2*2.*RUT*(QBG*(QBLP-QBLM)-QQG*(QQLP-QQLM))
20275 EVWGT=CLF(1)*DYN1+CLF(2)*DYN2+ORDER*CLF(3)*DYN3
20277 C Include event plane azimuthal angle
20282 DYN4=DYN4-QM2*SUM/QBG
20283 DYN5=DYN5-QM2*SUM/QQG
20287 & +(CLF(4)*COSS-CLF(6)*SINS)
20288 & *(DYN4*(PHEP(1,NHEP+2)**2-PHEP(2,NHEP+2)**2)
20289 & +DYN5*(PHEP(1,NHEP+4)**2-PHEP(2,NHEP+4)**2))
20290 & +(CLF(4)*SINS+CLF(6)*COSS)*2.
20291 & *(DYN4*PHEP(1,NHEP+2)*PHEP(2,NHEP+2)
20292 & +DYN5*PHEP(1,NHEP+4)*PHEP(2,NHEP+4))
20293 & +(CLF(5)*COSS-CLF(7)*SINS)*DYN6
20294 & *(PHEP(1,NHEP+3)**2-PHEP(2,NHEP+3)**2)
20295 & +(CLF(5)*SINS+CLF(7)*COSS)*DYN6*2.
20296 & *PHEP(1,NHEP+3)*PHEP(2,NHEP+3)
20298 C Assign event weight
20299 EVWGT=EVWGT*FACTR/(QQG*QBG*CLF(1))
20303 *CMZ :- -17/10/00 17:43:25 by Peter Richardson
20304 *-- Author : Kosuke Odagiri & Peter Richardson
20305 C-----------------------------------------------------------------------
20307 C-----------------------------------------------------------------------
20308 C SUSY E+E- -> 2 SLEPTON PROCESSES
20309 C-----------------------------------------------------------------------
20310 INCLUDE 'HERWIG65.INC'
20311 DOUBLE PRECISION HWRGEN,HWUAEM,EPS,HCS,RCS,S,PF,QPE,HWUPCM,PCM,
20312 & FACTR,SN2TH,MZ,MW,ME2(2,2,6),EMSC2,HWUMBW,HWRUNI,T,SQPE
20313 INTEGER ID1,ID2,IL,IL1,IL2,I,J,IG,IG1,IHEP,NTRY,IDL,ILP,IDLR(2),
20316 PARAMETER (SSNU = 449, SSCH = 453)
20317 EXTERNAL HWRGEN, HWUAEM,HWUMBW,HWUPCM,HWRUNI
20318 SAVE HCS,ME2,IDLR,IDSLP
20319 PARAMETER (EPS = 1.D-9)
20320 DOUBLE COMPLEX Z, GZ, A, BL, BR, CL, CR, D, E
20321 DOUBLE PRECISION F,FACT0
20322 PARAMETER (Z = (0.D0,1.D0))
20323 EQUIVALENCE (MZ, RMASS(200)), (MW, RMASS(198))
20327 EMSCA = SQRT(EMSC2)
20329 IL = MOD((IPROC-740),5)
20330 IF(IPROC.EQ.700.OR.IPROC.EQ.740) THEN
20339 IDSLP(1) = 2*(IPROC-740)/5
20340 ELSEIF(IL.EQ.1) THEN
20343 IDSLP(1) = 2*(IPROC-741)/5+1
20344 ELSEIF(IL.EQ.2) THEN
20347 IDSLP(1) = 2*(IPROC-742)/5+1
20348 ELSEIF(IL.EQ.3) THEN
20351 IDSLP(1) = 2*(IPROC-743)/5+1
20352 ELSEIF(IL.EQ.4) THEN
20355 IDSLP(1) = 2*(IPROC-744)/5+1
20357 IDSLP(2) = IDSLP(1)
20361 RCS = HCS*HWRGEN(0)
20363 IDL = ABS(IDHEP(1))
20365 COSTH = HWRUNI(1,-ONE,ONE)
20366 SN2TH = 0.25D0 - 0.25D0*COSTH**2
20367 FACT0 = GEV2NB*PIFAC*HWUAEM(EMSC2)**2/S
20368 FACTR = FACT0*SN2TH
20369 GZ = (S-MZ**2+Z*S*GAMZ/MZ)/S
20380 DO IL = IDSLP(1),IDSLP(2)
20383 IF ((I.EQ.2.OR.J.EQ.2).AND.(((IL/2)*2).EQ.IL).OR.
20384 & (IDLR(1).NE.0.AND.(IDLR(1).NE.I.OR.IDLR(2).NE.J)
20385 & .AND.(IDLR(1).NE.J.OR.IDLR(2).NE.I))) THEN
20388 ID1 = 412 + I*12 + IL
20389 ID2 = 412 + J*12 + IL
20391 QPE = S-(RMASS(ID1)+RMASS(ID2))**2
20393 IF (QPE.GT.ZERO) THEN
20394 SQPE = SQRT(QPE*(S-(RMASS(ID1)-RMASS(ID2))**2))
20396 IF ((IL.NE.ILP).OR.(I.EQ.J)) THEN
20397 A = QFCH(IL1)*QFCH(IDL)
20400 CL = LMIXSS(IL,1,I)*LMIXSS(IL,1,J)
20401 CR = LMIXSS(IL,2,I)*LMIXSS(IL,2,J)
20402 D = (A+BL*LFCH(IDL))*CL+(A+BR*LFCH(IDL))*CR
20403 E = (A+BL*RFCH(IDL))*CL+(A+BR*RFCH(IDL))*CR
20404 IF (IL.EQ.ILP+1.OR.IL.EQ.ILP) THEN
20406 T = HALF*(SQPE*COSTH-S+RMASS(ID1)**2+RMASS(ID2)**2)
20407 IF (IL.EQ.ILP) THEN
20412 F = F + SLFCH(IL1,IG)**2/(T-RMASS(IG1)**2)
20418 F = F +SRFCH(IL1,IG)**2/(T-RMASS(IG1)**2)
20427 F = F + WMXVSS(IG,1)**2/(T-RMASS(IG1)**2)
20429 D = D + F*S/(TWO*SWEIN)
20432 ME2(I,J,IL)=FACTR*PF**3*DREAL(
20433 & (ONE-EPOLN(3))*(ONE+PPOLN(3))*DCONJG(D)*D
20434 & +(ONE+EPOLN(3))*(ONE-PPOLN(3))*DCONJG(E)*E)
20437 T = HALF*(SQPE*COSTH-S+RMASS(ID1)**2+RMASS(ID2)**2)
20440 F = F + SLFCH(IL1,IG)*SRFCH(IL1,IG)*
20441 & ZSGNSS(IG)*RMASS(IG1)/(T-RMASS(IG1)**2)
20443 C--production of el- er+
20444 IF(I.EQ.1.AND.J.EQ.2) THEN
20445 ME2(I,J,IL)=FACT0*PF*F**2*S*
20446 & (ONE-EPOLN(3))*(ONE-PPOLN(3))
20448 C--production of er- el+
20449 ME2(I,J,IL)=FACT0*PF*F**2*S*
20450 & (ONE+EPOLN(3))*(ONE+PPOLN(3))
20467 HCS = HCS + ME2(I,J,IL)
20468 IF (GENEV.AND.HCS.GT.RCS) GOTO 100
20474 C--change sign of COSTH if antiparticle first
20475 IF(IDHEP(1).LT.IDHEP(2)) COSTH = -COSTH
20478 ISTHEP(NHEP+1) = 110
20481 IDHEP(NHEP+2) = IDPDG(IL1)
20482 IDHEP(NHEP+3) = IDPDG(IL2)
20483 C--select the particle masses and momenta
20486 PHEP(5,NHEP+2) = HWUMBW(IL1)
20487 PHEP(5,NHEP+3) = HWUMBW(IL2)
20488 CALL HWVEQU(5,PHEP(1,3),PHEP(1,NHEP+1))
20489 PCM = HWUPCM(PHEP(5,NHEP+1),PHEP(5,NHEP+2),PHEP(5,NHEP+3))
20490 IF(PCM.LT.ZERO.AND.NTRY.LE.NETRY) THEN
20492 ELSEIF(PCM.LT.ZERO) THEN
20493 CALL HWWARN('HWHESL',100,*999)
20495 C--Set up the colours etc
20496 ISTHEP(NHEP+2) = 113
20497 ISTHEP(NHEP+3) = 114
20498 JMOHEP(1,NHEP+1) = 1
20499 IF (JDAHEP(1,1).NE.0) JMOHEP(1,NHEP+1)=JDAHEP(1,1)
20500 JMOHEP(2,NHEP+1) = 2
20501 IF (JDAHEP(1,2).NE.0) JMOHEP(2,NHEP+1)=JDAHEP(1,2)
20502 JMOHEP(1,NHEP+2) = NHEP+1
20503 JMOHEP(2,NHEP+2) = NHEP+2
20504 JMOHEP(1,NHEP+3) = NHEP+1
20505 JMOHEP(2,NHEP+3) = NHEP+3
20506 JDAHEP(1,NHEP+1) = NHEP+2
20507 JDAHEP(2,NHEP+1) = NHEP+3
20508 JDAHEP(1,NHEP+2) = 0
20509 JDAHEP(2,NHEP+2) = NHEP+2
20510 JDAHEP(1,NHEP+3) = 0
20511 JDAHEP(2,NHEP+3) = NHEP+3
20512 C--Set up the momenta
20515 PHEP(4,IHEP) = SQRT(PCM**2+PHEP(5,IHEP)**2)
20516 PHEP(3,IHEP) = PCM*COSTH
20517 PHEP(1,IHEP) = SQRT((PCM+PHEP(3,IHEP))*(PCM-PHEP(3,IHEP)))
20518 PHEP(2,IHEP) = ZERO
20519 CALL HWRAZM(PHEP(1,IHEP),PHEP(1,IHEP),PHEP(2,IHEP))
20520 CALL HWULOB(PHEP(1,NHEP+1),PHEP(1,IHEP),PHEP(1,IHEP))
20521 CALL HWVDIF(4,PHEP(1,NHEP+1),PHEP(1,IHEP),PHEP(1,IHEP+1))
20528 *CMZ :- -18/10/00 13:46:47 by Peter Richardson
20529 *-- Author : Kosuke Odagiri & Peter Richardson
20530 C-----------------------------------------------------------------------
20532 C-----------------------------------------------------------------------
20533 C SUSY E+E- -> 2 GAUGINO PROCESSES
20534 C-----------------------------------------------------------------------
20535 INCLUDE 'HERWIG65.INC'
20536 DOUBLE PRECISION HWRGEN,HWUAEM,HCS,RCS,MNU(4),MNU2(4),HWRUNI,
20537 & FACA,M1(4,4),S2W,XA(4),XB(4),XC(4),XD(4),MSNU,
20538 & MW,MZ,HWHSS2,U,T,QPE,SQPE,MSL,MSL2,MSR,MSR2,
20539 & SGN,SN2TH,S,SM,DM,PF,PCM,HWUPCM,XW,S22W,SQXW,
20540 & MSNU2,MCH(2),MCH2(2),DAB,M2(2,2),HWUMBW
20541 INTEGER I,IQ1,IQ2,SSNU,NTID(2),CHID(2),IG1,IG2,IHEP,SSCH,ISL,ISR,
20544 SAVE HCS,M1,M2,NTID,ISL,ISR,ISN,IDL,CHID,NEUT,CHAR
20545 EXTERNAL HWRGEN,HWUAEM,HWRUNI,HWHSS2,HWUPCM,HWUMBW
20546 DOUBLE COMPLEX Z, Z0, Z1, C1, C2, C3,GZ, CLL, CLR, CRL, CRR
20547 PARAMETER (Z = (0.D0,1.D0), Z0 = (0.D0,0.D0), Z1 = (1.D0,0.D0))
20548 PARAMETER (SSNU=449,SSCH = 453)
20549 EQUIVALENCE (MZ, RMASS(200)), (MW, RMASS(198))
20550 EQUIVALENCE (XA(1), ZMIXSS(1,1)), (XA(2), ZMIXSS(2,1))
20551 EQUIVALENCE (XA(3), ZMIXSS(3,1)), (XA(4), ZMIXSS(4,1))
20552 EQUIVALENCE (XB(1), ZMIXSS(1,2)), (XB(2), ZMIXSS(2,2))
20553 EQUIVALENCE (XB(3), ZMIXSS(3,2)), (XB(4), ZMIXSS(4,2))
20554 EQUIVALENCE (XC(1), ZMIXSS(1,3)), (XC(2), ZMIXSS(2,3))
20555 EQUIVALENCE (XC(3), ZMIXSS(3,3)), (XC(4), ZMIXSS(4,3))
20556 EQUIVALENCE (XD(1), ZMIXSS(1,4)), (XD(2), ZMIXSS(2,4))
20557 EQUIVALENCE (XD(3), ZMIXSS(3,4)), (XD(4), ZMIXSS(4,4))
20558 C--Start of the code
20560 RCS = HCS*HWRGEN(0)
20562 C--Decide which processes to generate
20566 C--neutralino pair production
20567 IF(IPROC.GE.710.AND.IPROC.LE.726) THEN
20569 IF(IPROC.EQ.710) THEN
20573 NTID(1) = INT((IPROC-707)/4)
20574 NTID(2) = MOD((IPROC-711),4)+1
20576 C--chargino pair production
20577 ELSEIF(IPROC.GE.730.AND.IPROC.LE.734) THEN
20579 IF(IPROC.EQ.730) THEN
20583 CHID(1) = INT((IPROC-729)/2)
20584 CHID(2) = MOD((IPROC-731),2)+1
20586 ELSEIF(IPROC.NE.700) THEN
20587 CALL HWWARN('HWHESG',500,*999)
20589 C--check the particles in the beam
20590 IF(ABS(IDHEP(1)).EQ.11) THEN
20595 ELSEIF(ABS(IDHEP(1)).EQ.13) THEN
20601 CALL HWWARN('HWHESG',501,*999)
20606 MNU(I) = RMASS(SSNU+I)
20607 MNU2(I) = MNU(I)**2
20610 MCH(IG1) = RMASS(IG1+SSCH)
20611 MCH2(IG1) = MCH(IG1)**2
20613 COSTH = HWRUNI(1,-ONE,ONE)
20614 SN2TH = 0.25D0-0.25D0*COSTH**2
20617 S22W = XW * (TWO - XW)
20621 FACA = HWUAEM(S)**2
20622 GZ = S-MZ**2+Z*S/MZ*GAMZ
20629 C--neutralino pair production
20640 SM = MNU(IQ1) + MNU(IQ2)
20642 IF(QPE.GE.ZERO.AND.
20643 & (NTID(1).EQ.0.OR.(IQ1.EQ.NTID(1).AND.IQ2.EQ.NTID(2))
20644 & .OR.(IQ1.EQ.NTID(2).AND.IQ2.EQ.NTID(1)))) THEN
20645 DM = MNU(IQ1) - MNU(IQ2)
20646 SQPE = SQRT(QPE*(S-DM**2))
20648 T = HALF*(SQPE*COSTH - S + MNU2(IQ1) + MNU2(IQ2))
20649 U = - T - S + MNU2(IQ1) + MNU2(IQ2)
20650 C1 = (XD(IQ1)*XD(IQ2)-XC(IQ1)*XC(IQ2))/S2W/GZ
20652 SGN = ZSGNSS(IQ1)*ZSGNSS(IQ2)
20653 CLL = LFCH(IDL)*C1+SLFCH(IDL,IQ1)*SLFCH(IDL,IQ2)/(U-MSL2)
20654 CLR = LFCH(IDL)*C2-SLFCH(IDL,IQ1)*SLFCH(IDL,IQ2)/(T-MSL2)
20655 CRL = RFCH(IDL)*C1-SRFCH(IDL,IQ1)*SRFCH(IDL,IQ2)/(T-MSR2)
20656 CRR = RFCH(IDL)*C2+SRFCH(IDL,IQ1)*SRFCH(IDL,IQ2)/(U-MSR2)
20657 C--modified to include beam polarization PR 10/10/01
20658 M1(IQ1,IQ2) = FACA*PF*GEV2NB*PIFAC/S*HALF*
20659 & HWHSS2(S,T,U,MNU(IQ1),MNU(IQ2),SGN,CLL,CLR,CRL,CRR)
20665 C--chargino pair production
20666 100 IF(.NOT.CHAR) THEN
20676 SM = MCH(IG1) + MCH(IG2)
20678 IF (QPE.GE.ZERO.AND.
20679 & (CHID(1).EQ.0.OR.(CHID(1).EQ.IG1.AND.CHID(2).EQ.IG2)
20680 & .OR.(CHID(1).EQ.IG2.AND.CHID(2).EQ.IG1))) THEN
20681 DM = MCH(IG1) - MCH(IG2)
20682 SQPE = SQRT(QPE*(S-DM**2))
20684 T = HALF*(SQPE*COSTH - S + MCH2(IG1) + MCH2(IG2))
20685 U = - T - S + MCH2(IG1) + MCH2(IG2)
20686 DAB = ABS(FLOAT(IG1+IG2-3))
20687 C1 = (-WMXVSS(IG1,2)*WMXVSS(IG2,2)+DAB*S22W/XW)/S2W/GZ
20688 C2 = (-WMXUSS(IG1,2)*WMXUSS(IG2,2)+DAB*S22W/XW)/S2W/GZ
20689 SGN = WSGNSS(IG1)*WSGNSS(IG2)
20690 C3 = -DAB*QFCH(IDL)/S
20691 CLL = C3- LFCH(IDL)*C1
20692 & +WMXVSS(IG1,1)*WMXVSS(IG2,1)/((U-MSNU2)*XW)
20693 CLR = C3- LFCH(IDL)*C2
20694 CRL = C3- RFCH(IDL)*C1
20695 CRR = C3- RFCH(IDL)*C2
20696 C--modified to include beam polarization PR 10/10/01
20697 M2(IG1,IG2)=FACA*PF*GEV2NB*PIFAC/S*
20698 & HWHSS2(S,T,U,MCH(IG1),MCH(IG2),SGN,CLL,CLR,CRL,CRR)
20705 C--Add up the weights now
20707 IF(.NOT.NEUT) GOTO 250
20712 HCS = HCS+M1(IQ1,IQ2)
20713 IF(GENEV.AND.HCS.GT.RCS) GOTO 900
20716 250 IF(.NOT.CHAR) GOTO 900
20721 HCS = HCS + M2(IQ1,IQ2)
20722 IF (GENEV.AND.HCS.GT.RCS) GOTO 900
20726 C--change sign of COSTH if antiparticle first
20727 IF(IDHEP(1).LT.IDHEP(2)) COSTH = -COSTH
20728 C-Set up the particle types
20731 ISTHEP(NHEP+1) = 110
20734 IDHEP(NHEP+2) = IDPDG(IG1)
20735 IDHEP(NHEP+3) = IDPDG(IG2)
20736 C--select the particle masses and momenta
20739 PHEP(5,NHEP+2) = HWUMBW(IG1)
20740 PHEP(5,NHEP+3) = HWUMBW(IG2)
20741 CALL HWVEQU(5,PHEP(1,3),PHEP(1,NHEP+1))
20742 PCM = HWUPCM(PHEP(5,NHEP+1),PHEP(5,NHEP+2),PHEP(5,NHEP+3))
20743 IF(PCM.LT.ZERO.AND.NTRY.LE.NETRY) THEN
20745 ELSEIF(PCM.LT.ZERO) THEN
20746 CALL HWWARN('HWHESG',100,*999)
20748 C--Set up the colours etc
20749 ISTHEP(NHEP+2) = 113
20750 ISTHEP(NHEP+3) = 114
20751 JMOHEP(1,NHEP+1) = 1
20752 C--PR Bug fix 10/10/01
20753 IF (JDAHEP(1,1).NE.0) JMOHEP(1,NHEP+1)=JDAHEP(1,1)
20754 JMOHEP(2,NHEP+1) = 2
20755 IF (JDAHEP(1,2).NE.0) JMOHEP(2,NHEP+1)=JDAHEP(1,2)
20756 JMOHEP(1,NHEP+2) = NHEP+1
20757 JMOHEP(2,NHEP+2) = NHEP+2
20758 JMOHEP(1,NHEP+3) = NHEP+1
20759 JMOHEP(2,NHEP+3) = NHEP+3
20760 JDAHEP(1,NHEP+1) = NHEP+2
20761 JDAHEP(2,NHEP+1) = NHEP+3
20762 JDAHEP(1,NHEP+2) = 0
20763 JDAHEP(2,NHEP+2) = NHEP+3
20764 JDAHEP(1,NHEP+3) = 0
20765 JDAHEP(2,NHEP+3) = NHEP+2
20766 C--Set up the momenta
20768 PHEP(4,IHEP) = SQRT(PCM**2+PHEP(5,IHEP)**2)
20769 PHEP(3,IHEP) = PCM*COSTH
20770 PHEP(1,IHEP) = SQRT((PCM+PHEP(3,IHEP))*(PCM-PHEP(3,IHEP)))
20771 PHEP(2,IHEP) = ZERO
20772 CALL HWRAZM(PHEP(1,IHEP),PHEP(1,IHEP),PHEP(2,IHEP))
20773 CALL HWULOB(PHEP(1,NHEP+1),PHEP(1,IHEP),PHEP(1,IHEP))
20774 CALL HWVDIF(4,PHEP(1,NHEP+1),PHEP(1,IHEP),PHEP(1,IHEP+1))
20781 *CMZ :- -18/10/00 13:46:47 by Peter Richardson
20782 *-- Author : Kosuke Odagiri & Peter Richardson
20783 C-----------------------------------------------------------------------
20785 C-----------------------------------------------------------------------
20786 C SUSY E+E- -> 2 SPARTICLE PROCESSES
20787 C-----------------------------------------------------------------------
20788 INCLUDE 'HERWIG65.INC'
20789 DOUBLE PRECISION SAVWT(3),RANWT,HWRGEN
20792 IF(IPROC.EQ.700) THEN
20794 RANWT = SAVWT(3)*HWRGEN(0)
20795 IF(RANWT.LT.SAVWT(1)) THEN
20797 ELSEIF(RANWT.LT.SAVWT(2)) THEN
20799 ELSEIF(RANWT.LT.SAVWT(3)) THEN
20806 SAVWT(2) = SAVWT(1)+EVWGT
20808 SAVWT(3) = SAVWT(2)+EVWGT
20811 ELSEIF(IPROC.LT.740) THEN
20813 ELSEIF(IPROC.LT.760) THEN
20815 ELSEIF(IPROC.LT.790) THEN
20818 C---UNRECOGNIZED PROCESS
20819 CALL HWWARN('HWHESP',500,*999)
20823 *CMZ :- -16/10/00 15:34:113 by Peter Richardson
20824 *-- Author : Kosuke Odagiri & Peter Richardson
20825 C-----------------------------------------------------------------------
20827 C-----------------------------------------------------------------------
20828 C SUSY E+E- -> 2 SQUARK PROCESSES
20829 C-----------------------------------------------------------------------
20830 INCLUDE 'HERWIG65.INC'
20831 DOUBLE PRECISION HWRGEN,HWUAEM,EPS,HCS,RCS,S,PF,QPE,HWUPCM,PCM,
20832 & FACTR,SN2TH,MZ,MW,ME2(2,2,6),EMSC2,HWUMBW,HWRUNI,SQPE
20833 INTEGER ID1,ID2,IQ,IQ1,IQ2,I,J,IHEP,IDL,IDLR(2),IDSQU(2),NTRY
20834 EXTERNAL HWRGEN,HWUAEM,HWUMBW,HWUPCM,HWRUNI
20835 SAVE HCS,ME2,IDLR,IDSQU
20836 PARAMETER (EPS = 1.D-9)
20837 DOUBLE COMPLEX Z, GZ, A, BL, BR, CL, CR, D, E
20838 PARAMETER (Z = (0.D0,1.D0))
20839 EQUIVALENCE (MZ, RMASS(200)), (MW, RMASS(198))
20843 EMSCA = SQRT(EMSC2)
20845 IF(IPROC.EQ.700.OR.IPROC.EQ.760) THEN
20850 ELSEIF(IPROC.GT.760.AND.IPROC.LE.784) THEN
20851 IQ = MOD((IPROC-761),4)
20855 ELSEIF(IQ.EQ.1) THEN
20858 ELSEIF(IQ.EQ.2) THEN
20861 ELSEIF(IQ.EQ.3) THEN
20865 IDSQU(1) = (IPROC-761)/4+1
20866 IDSQU(2) = IDSQU(1)
20868 CALL HWWARN('HWHESQ',500,*999)
20872 RCS = HCS*HWRGEN(0)
20874 COSTH = HWRUNI(1,-ONE,ONE)
20875 SN2TH = 0.25D0 - 0.25D0*COSTH**2
20876 FACTR = CAFAC*GEV2NB*PIFAC*HWUAEM(EMSC2)**2*SN2TH/S
20877 GZ = (S-MZ**2+Z*S*GAMZ/MZ)/S
20878 IDL = ABS(IDHEP(1))
20889 DO IQ = IDSQU(1),IDSQU(2)
20892 IF ((I.NE.J).AND.(IQ.LT.5).OR.
20893 & (IDLR(1).NE.0.AND.(IDLR(1).NE.I.OR.IDLR(2).NE.J)
20894 & .AND.(IDLR(1).NE.J.OR.IDLR(2).NE.I))) THEN
20897 ID1 = 388 + I*12 + IQ
20898 ID2 = 388 + J*12 + IQ
20899 QPE = S-(RMASS(ID1)+RMASS(ID2))**2
20901 IF (QPE.GT.ZERO) THEN
20902 SQPE = SQRT(QPE*(S-(RMASS(ID1)-RMASS(ID2))**2))
20904 A = QFCH(IQ)*QFCH(IDL)
20907 CL = QMIXSS(IQ,1,I)*QMIXSS(IQ,1,J)
20908 CR = QMIXSS(IQ,2,I)*QMIXSS(IQ,2,J)
20909 D = (A+BL*LFCH(IDL))*CL+(A+BR*LFCH(IDL))*CR
20910 E = (A+BL*RFCH(IDL))*CL+(A+BR*RFCH(IDL))*CR
20911 ME2(I,J,IQ)=FACTR*PF**3*DREAL(
20912 & (ONE-EPOLN(3))*(ONE+PPOLN(3))*DCONJG(D)*D
20913 & +(ONE+EPOLN(3))*(ONE-PPOLN(3))*DCONJG(E)*E)
20928 HCS = HCS + ME2(I,J,IQ)
20929 IF (GENEV.AND.HCS.GT.RCS) GOTO 100
20937 ISTHEP(NHEP+1) = 110
20940 IDHEP(NHEP+2) = IDPDG(IQ1)
20941 IDHEP(NHEP+3) = IDPDG(IQ2)
20942 C--Select the particle masses and momenta
20944 PHEP(5,NHEP+2) = HWUMBW(IQ1)
20945 PHEP(5,NHEP+3) = HWUMBW(IQ2)
20946 CALL HWVEQU(5,PHEP(1,3),PHEP(1,NHEP+1))
20947 PCM = HWUPCM(PHEP(5,NHEP+1),PHEP(5,NHEP+2),PHEP(5,NHEP+3))
20948 IF(PCM.LT.ZERO.AND.NTRY.LE.NETRY) THEN
20950 ELSEIF(PCM.LT.ZERO) THEN
20951 CALL HWWARN('HWHESQ',100,*999)
20953 C--Set up the colours etc
20954 ISTHEP(NHEP+2) = 113
20955 ISTHEP(NHEP+3) = 114
20956 JMOHEP(1,NHEP+1) = 1
20957 IF (JDAHEP(1,1).NE.0) JMOHEP(1,NHEP+1)=JDAHEP(1,1)
20958 JMOHEP(2,NHEP+1) = 2
20959 IF (JDAHEP(1,2).NE.0) JMOHEP(2,NHEP+1)=JDAHEP(1,2)
20960 JMOHEP(1,NHEP+2) = NHEP+1
20961 JMOHEP(2,NHEP+2) = NHEP+3
20962 JMOHEP(1,NHEP+3) = NHEP+1
20963 JMOHEP(2,NHEP+3) = NHEP+2
20964 JDAHEP(1,NHEP+1) = NHEP+2
20965 JDAHEP(2,NHEP+1) = NHEP+3
20966 JDAHEP(1,NHEP+2) = 0
20967 JDAHEP(2,NHEP+2) = NHEP+3
20968 JDAHEP(1,NHEP+3) = 0
20969 JDAHEP(2,NHEP+3) = NHEP+2
20970 C--Set up the momenta
20972 PHEP(4,IHEP) = SQRT(PCM**2+PHEP(5,IHEP)**2)
20973 PHEP(3,IHEP) = PCM*COSTH
20974 PHEP(1,IHEP) = SQRT((PCM+PHEP(3,IHEP))*(PCM-PHEP(3,IHEP)))
20975 CALL HWRAZM(PHEP(1,IHEP),PHEP(1,IHEP),PHEP(2,IHEP))
20976 CALL HWULOB(PHEP(1,NHEP+1),PHEP(1,IHEP),PHEP(1,IHEP))
20977 CALL HWVDIF(4,PHEP(1,NHEP+1),PHEP(1,IHEP),PHEP(1,IHEP+1))
20984 *CMZ :- -26/04/91 11.11.55 by Bryan Webber
20985 *-- Author : Zoltan Kunszt, modified by Bryan Webber & Mike Seymour
20986 C-----------------------------------------------------------------------
20987 SUBROUTINE HWHEW0(IP,ETOT,XM,PR,WEIGHT,CR)
20988 C-----------------------------------------------------------------------
20989 INCLUDE 'HERWIG65.INC'
20990 DOUBLE PRECISION HWRGEN,ETOT,XM(2),PR(5,2),WEIGHT,CR,XM1,XM2,S,
20991 & D1,PABS,D,CX,C,E,F,SC,G
20999 PABS=D1*D1-4.*XM1*XM2
21000 IF (PABS.LE.ZERO) RETURN
21005 C=D-(D+CX)*((D-CR)/(D+CX))**HWRGEN(2)
21007 3 E=((D+ONE)/(D-ONE))*(TWO*HWRGEN(3)-ONE)
21008 C=D*((E-ONE)/(E+ONE))
21009 4 F=2D0*PIFAC*HWRGEN(4)
21011 PR(4,1)=(S+XM1-XM2)/(TWO*ETOT)
21012 PR(5,1)=PR(4,1)*PR(4,1)-XM1
21013 IF (PR(5,1).LE.ZERO) RETURN
21014 PR(5,1)=SQRT(PR(5,1))
21015 PR(4,2)=ETOT-PR(4,1)
21018 PR(2,1)=PR(5,1)*SC*COS(F)
21019 PR(1,1)=PR(5,1)*SC*SIN(F)
21023 IF(IP.EQ.1)G=(D-C)*LOG((D+CX)/(D-CR))
21024 IF(IP.EQ.2)G=(D*D-C*C)/D*LOG((D+ONE)/(D-ONE))
21025 WEIGHT=PIFAC*G*PR(5,1)/ETOT*HALF
21029 *CMZ :- -26/04/91 11.11.55 by Bryan Webber
21030 *-- Author : Zoltan Kunszt, modified by Bryan Webber
21031 C-----------------------------------------------------------------------
21032 SUBROUTINE HWHEW1(NPART)
21033 C-----------------------------------------------------------------------
21035 DOUBLE PRECISION P(4,7),XMASS,PLAB,PRW,PCM
21036 INTEGER NPART,I,J,K
21037 COMMON/HWHEWP/ XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
21045 DO 30 K=1,(NPART-2)
21046 30 PCM(J,K)=P(J,K+2)
21047 PCM(J,NPART-1)=-P(J,1)
21048 PCM(J,NPART)=-P(J,2)
21052 *CMZ :- -26/04/91 13.22.25 by Federico Carminati
21053 *-- Author : Zoltan Kunszt, modified by Bryan Webber
21054 C-----------------------------------------------------------------------
21055 SUBROUTINE HWHEW2(NPART,PPCM,H,CH,D)
21056 C-----------------------------------------------------------------------
21057 C PCM SHOULD BE DEFINED SUCH THAT ALL 4-MOMENTA ARE OUTGOING.
21058 C CONVENTION FOR PCM AND P IS THAT DIRECTION 1 =BEAM, COMPONENT
21059 C 4 = ENERGY AND COMPONENT 2 AND 3 ARE TRANSVERSE COMPONENTS.
21060 C THUS INCOMING MOMENTA SHOULD CORRESPOND TO OUTGOING MOMENTA
21061 C OF NEGATIVE ENERGY.
21062 C PCM IS FILLED BY PHASE SPACE MONTE CARLO.
21063 C I1-I7 HERE REFER TO HOW PCM INDEXING IS MAPPED TO OUR STANDARD
21064 C 1-6=GLUON,GLUON,Q,QBAR,QP,QPBAR ORDERING `
21065 C-----------------------------------------------------------------------
21067 DOUBLE COMPLEX PT5,ZT,Z1,ZI,ZP,ZQ,ZD,ZPS,ZQS,ZDPM,ZDMP,H(8,8),
21069 DOUBLE PRECISION ZERO,ONE,PPCM(5,8),P(5,8),WRN(8),EPS,Q1,Q2,QP,QM,
21070 & P1,P2,PP,PM,DMP,DPM,PT,QT,PTI,QTI,HALF
21071 INTEGER J,L,IJ,II,JJ,I,NPART,IP1,IPP1
21072 PARAMETER (ZERO=0.D0,ONE=1.D0,HALF=0.5D0)
21074 ZI=DCMPLX(ZERO,ONE)
21075 Z1=DCMPLX(ONE,ZERO)
21076 C FOLLOWING DO LOOP IS TO CONVERT TO OUR STANDARD INDEXING
21079 1 P(IJ,L)=PPCM(IJ,L)
21082 IF(P(4,II).LT.ZERO) WRN(II)=-ONE
21084 P(JJ,II)=WRN(II)*P(JJ,II)
21086 C THE ABOVE CHECKS FOR MOMENTA WITH NEGATIVE ENERGY,INNER PRODUCTS
21087 C ARE EXPRESSED DIFFERENTLY FOR DIFFERENT CASES
21093 IF(Q1.GT.EPS)QP=SQRT(Q1)
21096 IF(Q2.GT.EPS)QM=SQRT(Q2)
21099 IF(P1.GT.EPS)PP=SQRT(P1)
21102 IF(P2.GT.EPS)PM=SQRT(P2)
21104 ZDMP=DCMPLX(DMP,ZERO)
21106 ZDPM=DCMPLX(DPM,ZERO)
21107 C NOTE THAT IN OUR INNER PRODUCT NOTATION WE ARE COMPUTING <P,Q>
21108 PT=SQRT(P(2,J)**2+P(3,J)**2)
21109 QT=SQRT(P(2,I)**2+P(3,I)**2)
21110 IF(PT.GT.EPS) GOTO 99
21114 ZP=DCMPLX(PTI*P(2,J),PTI*P(3,J))
21116 IF(QT.GT.EPS) GOTO 89
21120 ZQ=DCMPLX(QTI*P(2,I),QTI*P(3,I))
21123 IF(WRN(I).LT.ZERO) ZT=ZT*ZI
21124 IF(WRN(J).LT.ZERO) ZT=ZT*ZI
21125 H(J,I)=(ZDMP*ZP-ZDPM*ZQ)*ZT
21126 CH(J,I)=(ZDMP*ZPS-ZDPM*ZQS)*ZT
21128 PT5=DCMPLX(HALF,ZERO)
21140 *CMZ :- -27/03/92 19.48.55 by Mike Seymour
21141 *-- Author : Zoltan Kunszt, modified by Bryan Webber
21142 C-----------------------------------------------------------------------
21143 SUBROUTINE HWHEW3(N1,N2,N3,N4,N5,N6,AMPWW)
21144 C-----------------------------------------------------------------------
21145 C RECALL THAT N1,N3,N5 MUST BE OUTGOING FERMIONS, AND N2,N4,N6 MUST BE
21146 C OUTGOING ANTI-FERMIONS; 3,4 FOR W-, 5,6 FOR W+
21148 C EQ1 AND T31 ARE FOR OUTOING INITIAL QUARK
21149 C CHOOSE APPROPRIATE CASE ACCORDING TO NUPDN
21150 C NUPDN=1 FOR UUBAR COLLISIONS, NUPDN=2 FOR DDBAR COLLISIONS
21151 C NFINAL CHOOSES THE FINAL DECAYS, 1 FOR DOUBLE LEPTON, 2 FOR 1 FLAVOR
21152 C LEPTON+2FAMILIES OF QUARKS, 3 THE SAME, 4 FOR DOUBLE 2FAM3COLOR QUARKS
21154 C NOTE: EXTERNAL FACTOR OF COLOR AVERAGE AND SPIN AVERAGE AND
21155 C COUPLING (E**8/4/9) MUST BE INCLUDED AS WELL AS COMPENSATION
21156 C FOR ON POLE APPROXIMATION AS DESIRED.
21157 C-----------------------------------------------------------------------
21158 INCLUDE 'HERWIG65.INC'
21159 DOUBLE COMPLEX HWHEW4,ZH,ZCH,ZD,ZAMP1,ZAMP2,ZAMP3,DWW,CWW,BWW,AWW,
21160 & AWWM,AWWP,AMPTEM,ZTWO,ZHALF
21161 DOUBLE PRECISION XW,ZMASS,T3,EQ1,RR,RL,ZM2,AMP2,RKW,COLFAC(4),
21163 INTEGER I,N1,N2,N3,N4,N5,N6
21165 COMMON/HWHEWQ/ZH(8,8),ZCH(8,8),ZD(8,8)
21166 EQUIVALENCE (XW,SWEIN),(ZMASS,RMASS(200))
21167 DATA COLFAC/1.D0,3.D0,3.D0,9.D0/
21168 DATA ZTWO,ZHALF/(2.0D0,0.0D0),(0.5D0,0.0D0)/
21174 ZAMP1=DCMPLX(ZM2)/(ZTWO*ZD(N1,N2))
21175 & /(ZTWO*ZD(N1,N2)+DCMPLX(-ZM2,GAMZ*ZMASS))
21176 ZAMP2=ZHALF/(ZD(N1,N3)+ZD(N1,N4)+ZD(N3,N4))
21177 ZAMP3=ZHALF/(ZD(N1,N5)+ZD(N1,N6)+ZD(N5,N6))
21178 DWW=DCMPLX(RL)*ZAMP1+T3/(ZTWO*ZD(N1,N2))
21179 CWW=DCMPLX(RR)*ZAMP1
21182 AWWM=AWW*HWHEW4(N1,N2,N3,N4,N5,N6)-BWW*HWHEW4(N1,N2,N5,N6,N3,N4)
21183 AWWP=CWW*(HWHEW4(N2,N1,N5,N6,N3,N4)-HWHEW4(N2,N1,N3,N4,N5,N6))
21184 AMPTEM=AWWM*DCONJG(AWWM)+AWWP*DCONJG(AWWP)
21186 C AMP2 DOES NOT INCLUDE COLOR OR FLAVOR SUMS OR AVERAGES YET
21187 C NOR DOES IT INCLUDE TO THIS POINT KWW**2
21188 C 1 LEPTON FLAVOR IF APPROPRIATE FOR NFINAL CHOICE
21191 6 AMPWW(I)=AMP2*COLFAC(I)*RKW*RKW
21195 *CMZ :- -26/04/91 10.18.57 by Bryan Webber
21196 *-- Author : Zoltan Kunszt, modified by Bryan Webber
21197 C-----------------------------------------------------------------------
21198 FUNCTION HWHEW4(N1,N2,N3,N4,N5,N6)
21199 C-----------------------------------------------------------------------
21201 DOUBLE COMPLEX HWHEW4,ZH,ZCH,ZD
21202 INTEGER N1,N2,N3,N4,N5,N6
21203 COMMON/HWHEWQ/ZH(8,8),ZCH(8,8),ZD(8,8)
21204 HWHEW4=4*ZH(N1,N3)*ZCH(N2,N6)*(ZH(N1,N5)*ZCH(N1,N4)
21205 X +ZH(N3,N5)*ZCH(N3,N4))
21209 *CMZ : 20/08/91 22.09.33 by Federico Carminati
21210 *-- Author : Zoltan Kunszt, modified by Mike Seymour
21211 C-----------------------------------------------------------------------
21212 SUBROUTINE HWHEW5(N1,N2,N3,N4,N5,N6,HELSUM,HELCTY,ID1,ID2)
21213 C-----------------------------------------------------------------------
21214 C RECALL THAT N1,N3,N5 MUST BE OUTGOING FERMIONS, AND N2,N4,N6 MUST BE
21215 C OUTGOING ANTI-FERMIONS; 3,4 FOR Z0, 5,6 FOR Z0
21217 C EQ1 AND T31 ARE FOR OUTOING INITIAL QUARK
21218 C CHOOSE APPROPRIATE CASE ACCORDING TO NUPDN
21219 C NUPDN=1 FOR UUBAR COLLISIONS, NUPDN=2 FOR DDBAR COLLISIONS
21220 C NFINAL CHOOSES THE FINAL DECAYS, 1 FOR DOUBLE LEPTON, 2 FOR 1 FLAVOR
21221 C LEPTON+2FAMILIES OF QUARKS, 3 THE SAME, 4 FOR DOUBLE 2FAM3COLOR QUARKS
21223 C NOTE: EXTERNAL FACTOR OF COLOR AVERAGE AND SPIN AVERAGE AND
21224 C COUPLING (E**8/4/9) MUST BE INCLUDED AS WELL AS COMPENSATION
21225 C FOR ON POLE APPROXIMATION AS DESIRED.
21227 C---SLIGHTLY MODIFIED BY MHS, SO THAT HELCTY REFERS TO THE FINAL STATE
21228 C INDICATED BY ID1,ID2
21229 C-----------------------------------------------------------------------
21231 DOUBLE COMPLEX HWHEW4,ZH,ZCH,ZD,ZAMM(8),ZS134,ZS156,ZS234,ZS256,
21233 DOUBLE PRECISION CPFAC,CPALL,HELSUM,HELCTY,AMM
21234 INTEGER N1,N2,N3,N4,N5,N6,ID1,ID2,I
21236 COMMON/HWHEWQ/ZH(8,8),ZCH(8,8),ZD(8,8)
21237 COMMON/HWHEWR/CPFAC(12,12,8),CPALL(8)
21238 DATA ZTWO/(2.0D0,0.0D0)/
21239 C THE MATRIX ELEMENT DEPENDS ON
21240 ZS134=(ZD(N1,N3)+ZD(N1,N4)+ZD(N3,N4))*ZTWO
21241 ZS156=(ZD(N1,N5)+ZD(N1,N6)+ZD(N5,N6))*ZTWO
21242 ZS234=(ZD(N2,N3)+ZD(N2,N4)+ZD(N3,N4))*ZTWO
21243 ZS256=(ZD(N2,N5)+ZD(N2,N6)+ZD(N5,N6))*ZTWO
21244 ZAMM(1)=HWHEW4(N1,N2,N3,N4,N5,N6)/ZS134+
21245 > HWHEW4(N1,N2,N5,N6,N3,N4)/ZS156
21246 ZAMM(2)=HWHEW4(N1,N2,N4,N3,N5,N6)/ZS134+
21247 > HWHEW4(N1,N2,N5,N6,N4,N3)/ZS156
21248 ZAMM(3)=HWHEW4(N1,N2,N3,N4,N6,N5)/ZS134+
21249 > HWHEW4(N1,N2,N6,N5,N3,N4)/ZS156
21250 ZAMM(4)=HWHEW4(N1,N2,N4,N3,N6,N5)/ZS134+
21251 > HWHEW4(N1,N2,N6,N5,N4,N3)/ZS156
21252 ZAMM(5)=HWHEW4(N2,N1,N3,N4,N5,N6)/ZS234+
21253 > HWHEW4(N2,N1,N5,N6,N3,N4)/ZS256
21254 ZAMM(6)=HWHEW4(N2,N1,N4,N3,N5,N6)/ZS234+
21255 > HWHEW4(N2,N1,N5,N6,N4,N3)/ZS256
21256 ZAMM(7)=HWHEW4(N2,N1,N3,N4,N6,N5)/ZS234+
21257 > HWHEW4(N2,N1,N6,N5,N3,N4)/ZS256
21258 ZAMM(8)=HWHEW4(N2,N1,N4,N3,N6,N5)/ZS234+
21259 > HWHEW4(N2,N1,N6,N5,N4,N3)/ZS256
21263 AMM=DREAL(ZAMM(I)*DCONJG(ZAMM(I)))
21264 HELSUM=HELSUM+CPALL(I)*AMM
21265 HELCTY=HELCTY+CPFAC(ID1,ID2,I)*AMM
21270 *CMZ :- -02/05/91 10.58.29 by Federico Carminati
21271 *-- Author : Zoltan Kunszt, modified by Bryan Webber
21272 C-----------------------------------------------------------------------
21274 C-----------------------------------------------------------------------
21275 C E+E- -> W+W-/Z0Z0 (BASED ON ZOLTAN KUNSZT'S PROGRAM)
21276 C-----------------------------------------------------------------------
21277 INCLUDE 'HERWIG65.INC'
21278 DOUBLE COMPLEX ZH,ZCH,ZD
21279 DOUBLE PRECISION HWUAEM,HWRGEN,HWUPCM,ETOT,STOT,FLUXW,GAMM,GIMM,
21280 & WM2,WXMIN,WX1MAX,WX2MAX,FJAC1,FJAC2,WX1,WX2,WMM1,WMM2,XXM,W2BO,
21281 & PST,WEIGHT,TOTSIG,WMASS,WWIDTH,ELST,CV,CA,BR,XMASS,PLAB,PRW,PCM,
21282 & AMPWW(4),CCC,HELSUM,HELCTY,BRZED(12),BRTOT,CPFAC,CPALL,RLL(12),
21284 INTEGER IB,IBOS,I,ID1,ID2,NTRY,IDP(10),IDBOS(2),J1,J2,IPRC,ILST,
21285 & IDZOLT(16),MAP(12),NEWHEP
21286 LOGICAL EISBM1,HWRLOG
21287 EXTERNAL HWUAEM,HWRGEN,HWUPCM
21288 SAVE IDP,STOT,FLUXW,GAMM,GIMM,WM2,WXMIN,WX1MAX,FJAC1,ELST,ILST,
21289 & IDBOS,WMASS,WWIDTH,BRZED
21290 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
21291 COMMON/HWHEWQ/ZH(8,8),ZCH(8,8),ZD(8,8)
21292 COMMON/HWHEWR/CPFAC(12,12,8),CPALL(8)
21293 DATA ELST,ILST/0.D0,0/
21294 DATA IDZOLT/4,3,8,7,12,11,4*0,2,1,6,5,10,9/
21295 DATA MAP/12,11,2,1,14,13,4,3,16,15,6,5/
21296 IF (IERROR.NE.0) RETURN
21297 EISBM1=IDHW(1).LT.IDHW(2)
21303 CALL HWVEQU(5,PRW(1,IB),PHEP(1,IBOS))
21304 IF (EISBM1) PHEP(3,IBOS)=-PHEP(3,IBOS)
21305 CALL HWVZRO(4,VHEP(1,IBOS))
21306 CALL HWUDKL(IDBOS(IB),PHEP(1,IBOS),DIST)
21307 CALL HWVSUM(4,VHEP(1,IBOS),DIST,DIST)
21308 IDHW(IBOS)=IDBOS(IB)
21309 IDHEP(IBOS)=IDPDG(IDBOS(IB))
21314 CALL HWVEQU(5,PLAB(1,2*IB+I),PHEP(1,NHEP+I))
21315 IF (EISBM1) PHEP(3,NHEP+I)=-PHEP(3,NHEP+I)
21316 CALL HWVEQU(4,DIST,VHEP(1,NHEP+I))
21317 C---STATUS, IDs AND POINTERS
21318 ISTHEP(NHEP+I)=112+I
21319 IDHW(NHEP+I)=IDP(2*IB+I)
21320 IDHEP(NHEP+I)=IDPDG(IDP(2*IB+I))
21321 JDAHEP(I,IBOS)=NHEP+I
21322 JMOHEP(1,NHEP+I)=IBOS
21323 JMOHEP(2,NHEP+I)=JMOHEP(1,IBOS)
21326 JMOHEP(2,NHEP)=NHEP-1
21327 JDAHEP(2,NHEP)=NHEP-1
21328 JMOHEP(2,NHEP-1)=NHEP
21329 JDAHEP(2,NHEP-1)=NHEP
21334 IPRC=MOD(IPROC,100)
21335 IF (ETOT.NE.ELST .OR. IPRC.NE.ILST) THEN
21337 FLUXW=GEV2NB*.125*(HWUAEM(STOT)/PIFAC)**4/STOT
21338 IF (IPRC.EQ.0) THEN
21343 ELSEIF (IPRC.EQ.50) THEN
21348 C---LOAD FERMION COUPLINGS TO Z
21350 RLL(I)=VFCH(MAP(I),1)+AFCH(MAP(I),1)
21351 RRL(I)=VFCH(MAP(I),1)-AFCH(MAP(I),1)
21360 IF (MOD(J1-1,4).GE.2) CCC=CCC*CAFAC
21361 IF (MOD(J2-1,4).GE.2) CCC=CCC*CAFAC
21362 CPFAC(J1,J2,1)=CCC*(RLL(2)**2*RLL(J1)*RLL(J2))**2
21363 CPFAC(J1,J2,2)=CCC*(RLL(2)**2*RRL(J1)*RLL(J2))**2
21364 CPFAC(J1,J2,3)=CCC*(RLL(2)**2*RLL(J1)*RRL(J2))**2
21365 CPFAC(J1,J2,4)=CCC*(RLL(2)**2*RRL(J1)*RRL(J2))**2
21366 CPFAC(J1,J2,5)=CCC*(RRL(2)**2*RLL(J1)*RLL(J2))**2
21367 CPFAC(J1,J2,6)=CCC*(RRL(2)**2*RRL(J1)*RLL(J2))**2
21368 CPFAC(J1,J2,7)=CCC*(RRL(2)**2*RLL(J1)*RRL(J2))**2
21369 CPFAC(J1,J2,8)=CCC*(RRL(2)**2*RRL(J1)*RRL(J2))**2
21371 IF (J1.EQ.1.AND.J2.EQ.1) CPALL(I)=0
21372 CPALL(I)=CPALL(I)+CPFAC(J1,J2,I)
21373 BRZED(J1)=BRZED(J1)+CPFAC(J1,J2,I)
21374 BRTOT=BRTOT+CPFAC(J1,J2,I)
21379 70 BRZED(I)=BRZED(I)/BRTOT
21381 CALL HWWARN('HWHEWW',500,*999)
21386 WXMIN=ATAN(-WMASS/WWIDTH)
21387 WX1MAX=ATAN((STOT-WM2)*GIMM)
21393 C---CHOOSE W MASSES
21394 WX1=WXMIN+FJAC1*HWRGEN(1)
21395 WMM1=GAMM*TAN(WX1)+WM2
21396 IF (WMM1.LE.0) RETURN
21397 XMASS(1)=SQRT(WMM1)
21398 WX2MAX=ATAN(((ETOT-XMASS(1))**2-WM2)*GIMM)
21400 WX2=WXMIN+FJAC2*HWRGEN(2)
21401 WMM2=GAMM*TAN(WX2)+WM2
21402 IF (WMM2.LE.0) RETURN
21403 XMASS(2)=SQRT(WMM2)
21404 IF (HWRLOG(HALF))THEN
21409 C---CTMAX=ANGULAR CUT ON COS W-ANGLE
21410 CALL HWHEW0(1,ETOT,XMASS(1),PRW(1,1),W2BO,CTMAX)
21411 IF (W2BO.EQ.ZERO) RETURN
21412 C---FOR ZZ EVENTS, FORCE BOSE STATISTICS, BY KILLING EVENTS WITH COS1<0
21413 IF (IPRC.NE.0) THEN
21414 IF (PRW(3,1).LT.ZERO) RETURN
21415 C---AND THEN SYMMETRIZE (THIS PROCEDURE VASTLY IMPROVES EFFICIENCY)
21416 IF (HWRLOG(HALF)) THEN
21422 PLAB(4,1)=PLAB(3,1)
21423 PLAB(3,2)=-PLAB(3,1)
21424 PLAB(4,2)=PLAB(3,1)
21426 C---LET THE W BOSONS DECAY
21430 CALL HWDBOZ(IDBOS(IB),ID1,ID2,CV,CA,BR,1)
21431 PST=HWUPCM(XMASS(IB),RMASS(ID1),RMASS(ID2))
21432 IF (PST.LT.ZERO) THEN
21433 CALL HWDBOZ(IDBOS(IB),ID1,ID2,CV,CA,BR,2)
21434 IF (NTRY.LE.NBTRY) GOTO 80
21435 C CALL HWWARN('HWHEWW',1,*999)
21438 PRW(5,IB)=XMASS(IB)
21441 PLAB(5,2*IB+1)=RMASS(ID1)
21442 PLAB(5,2*IB+2)=RMASS(ID2)
21443 CALL HWDTWO(PRW(1,IB),PLAB(1,2*IB+1),PLAB(1,2*IB+2),
21446 WEIGHT=FLUXW*W2BO*FJAC1*FJAC2*(0.5D0*PIFAC*GIMM)**2
21448 CALL HWHEW2(6,PCM(1,1),ZH,ZCH,ZD)
21449 IF (IPRC.EQ.0) THEN
21450 CALL HWHEW3(5,6,3,4,1,2,AMPWW)
21451 TOTSIG=9.*AMPWW(1)+6.*(AMPWW(2)+AMPWW(3))+4.*AMPWW(4)
21452 EVWGT=TOTSIG*WEIGHT*BR
21454 ID1=IDZOLT(IDPDG(IDP(3)))
21455 ID2=IDZOLT(IDPDG(IDP(5)))
21456 CALL HWHEW5(5,6,3,4,1,2,HELSUM,HELCTY,ID1,ID2)
21457 EVWGT=HELCTY*WEIGHT*BR/(BRZED(ID1)*BRZED(ID2))
21462 *CMZ :- -02/04/01 12.11.55 by Peter Richardson
21463 *-- Author : Peter Richardson
21464 C-----------------------------------------------------------------------
21466 C-----------------------------------------------------------------------
21467 C Hadron-Hadron to WW/WZ/ZZ (BASED ON ZOLTAN KUNSZT'S PROGRAM)
21468 C-----------------------------------------------------------------------
21469 INCLUDE 'HERWIG65.INC'
21470 DOUBLE COMPLEX ZH,ZCH,ZD
21471 DOUBLE PRECISION HWUAEM,HWRGEN,HWUPCM,FLUXW,CSW,WMASS(2),XMASS,
21472 & PLAB,PRW,PCM,HWRUNI,P(5,10),AMPWW,DIST(4),MW2,CFAC1,AMP,
21473 & MZ2,GMW,GMZ,G(4,2),EE(4),CKM2(12),RF(2),LF(2),TAUI(2),FPI4
21474 INTEGER IB,IBOS,I,IDP,IDBOS,IPRC,NEWHEP,J,ICMF,IHEP,IBRAD,K,IOPT,
21477 EXTERNAL HWUAEM,HWRGEN,HWUPCM,HWRUNI
21478 COMMON/HWHEWQ/ZH(8,8),ZCH(8,8),ZD(8,8)
21479 COMMON/HWHGBC/ MW2,MZ2,GMW,GMZ,G,EE,CKM2,RF,LF,TAUI,CSW,CFAC1
21480 COMMON /HWBOSN/XMASS(2),PLAB(5,10),PRW(5,2),PCM(5,10),IDBOS(2),
21481 & IDRES,IDP(10),IOPT
21482 DATA MAP/1,2,11,12/
21483 SAVE WMASS,AMPWW,IPRC,PHOTON
21484 PARAMETER(FPI4=24936.72731D0)
21485 DOUBLE PRECISION WI(IMAXCH)
21487 IF (IERROR.NE.0) RETURN
21489 IF (IPRC.EQ.0) THEN
21490 CALL HWHGB2(AMPWW,IDP,PHOTON)
21491 ELSEIF(IPRC.EQ.10) THEN
21492 CALL HWHGB3(AMPWW,IDP,PHOTON)
21493 ELSEIF(IPRC.EQ.20) THEN
21494 CALL HWHGB4(AMPWW,IDP,PHOTON)
21495 IF((IDP(1).LE.6.AND.MOD(IDP(1),2).EQ.1).OR.
21496 & (IDP(2).LE.6.AND.MOD(IDP(2),2).EQ.1)) THEN
21502 C--change the sign of the z component (in CMF) if particle first
21503 IF(IDP(1).LT.IDP(2)) THEN
21505 PRW(3,IB) = -PRW(3,IB)
21507 PLAB(3,2*IB+I)=-PLAB(3,2*IB+I)
21511 C--boost particles back to the lab frame from the centre of mass frame
21513 CALL HWULOB(PLAB(1,7),PRW(1,IB),PRW(1,IB))
21516 CALL HWULOB(PLAB(1,7),PLAB(1,I),PLAB(1,I))
21518 C--put the particles in the event record
21519 C--first the incoming quarks
21523 CALL HWVEQU(5,PLAB(1,I),PHEP(1,IHEP))
21524 IDHW(IHEP) = IDP(I)
21525 IDHEP(IHEP)=IDPDG(IDP(I))
21527 JMOHEP(1,IHEP)=ICMF
21528 JMOHEP(I,ICMF)=IHEP
21529 JDAHEP(1,IHEP)=ICMF
21531 JMOHEP(2,NHEP+1) = NHEP+2
21532 JMOHEP(2,NHEP+2) = NHEP+1
21533 JDAHEP(2,NHEP+1) = NHEP+2
21534 JDAHEP(2,NHEP+2) = NHEP+1
21535 C--Centre-of-mass energy
21537 C--new for spin correlations
21544 DECSPN(1) = .FALSE.
21547 IDHEP(ICMF)=IDPDG(15)
21549 CALL HWVEQU(5,PLAB(1,7),PHEP(1,ICMF))
21550 CALL HWUMAS(PHEP(1,ICMF))
21551 JDAHEP(1,ICMF) = ICMF+1
21552 JDAHEP(2,ICMF) = ICMF+2
21559 CALL HWVEQU(5,PRW(1,IB),PHEP(1,IBOS))
21560 CALL HWVZRO(4,VHEP(1,IBOS))
21561 CALL HWUDKL(IDBOS(IB),PHEP(1,IBOS),DIST)
21562 CALL HWVSUM(4,VHEP(1,IBOS),DIST,DIST)
21563 IDHW(IBOS)=IDBOS(IB)
21564 IDHEP(IBOS)=IDPDG(IDBOS(IB))
21565 JMOHEP(1,IBOS)=ICMF
21566 JMOHEP(2,IBOS)=ICMF
21567 JDAHEP(2,IBOS)=IBOS
21568 ISTHEP(IBOS)=112+IB
21570 C--now generate the initial state shower
21572 IF(IERROR.NE.0) RETURN
21573 C--now add the outgoing fermions to the event record
21576 IBRAD = JDAHEP(1,IBOS)
21577 ISTHEP(IBRAD) = 195
21579 CALL HWVEQU(5,PLAB(1,2*IB+I),PHEP(1,NHEP+I))
21580 CALL HWVEQU(4,DIST,VHEP(1,NHEP+I))
21581 C--Boost the fermion momenta to the rest frame of the original W
21582 CALL HWULOF(PRW(1,IB),PHEP(1,NHEP+I),PHEP(1,NHEP+I))
21583 C--Now boost back to the lab from rest frame of the W after radiation
21584 CALL HWULOB(PHEP(1,IBRAD),PHEP(1,NHEP+I),PHEP(1,NHEP+I))
21585 C--Set the status and pointers
21586 ISTHEP(NHEP+I)=112+I
21587 IDHW(NHEP+I)=IDP(2*IB+I)
21588 IDHEP(NHEP+I)=IDPDG(IDP(2*IB+I))
21589 JDAHEP(I,IBRAD)=NHEP+I
21590 JMOHEP(1,NHEP+I)=IBRAD
21591 C--New for spin correlations
21593 ISNHEP(NHEP+I) = 2*IB+I-1
21594 IDSPN(2*IB+I-1) = NHEP+I
21595 JMOSPN(2*IB+I-1) = 1
21596 DECSPN(2*IB+I-1) = .FALSE.
21597 RHOSPN(1,1,2*IB+I-1) = HALF
21598 RHOSPN(1,2,2*IB+I-1) = ZERO
21599 RHOSPN(2,1,2*IB+I-1) = ZERO
21600 RHOSPN(2,2,2*IB+I-1) = HALF
21605 JMOHEP(2,NHEP)=NHEP-1
21606 JDAHEP(2,NHEP)=NHEP-1
21607 JMOHEP(2,NHEP-1)=NHEP
21608 JDAHEP(2,NHEP-1)=NHEP
21612 IPRC=MOD(IPROC,100)
21613 IF(MOD(IPRC,5).EQ.0.AND.MOD(IPRC,10).NE.0) THEN
21620 IF (IPRC.EQ.0) THEN
21626 ELSEIF (IPRC.EQ.10) THEN
21630 ELSEIF(IPRC.EQ.20) THEN
21637 CALL HWWARN('HWHGBP',500,*999)
21640 WMASS(I)=RMASS(IDBOS(I))
21642 C--calculate the couplings etc
21643 MW2 = RMASS(198)**2
21644 GMW = RMASS(198)*GAMW
21645 MZ2 = RMASS(200)**2
21646 GMZ = RMASS(200)*GAMZ
21647 C--couplings to Z and photon
21649 G(I,1) = VFCH(MAP(I),1)+AFCH(MAP(I),1)
21650 G(I,2) = VFCH(MAP(I),1)-AFCH(MAP(I),1)
21651 EE(I) = QFCH(MAP(I))
21653 C--elements of the CKM matrix for the various decay modes of the W
21656 C**Bug fix 2/7/01 by BRW (unsquare)
21657 CKM2(3*I-3+J) = VCKM(J,I)
21662 C--couplings of the up and down
21666 RF(I) = -TWO*QFCH(I)*SWEIN
21667 LF(I) = TAUI(I)+RF(I)
21670 CSW = SQRT((ONE-SWEIN)/SWEIN)
21673 C--find the momenta and the phase space weight
21674 CALL HWHGBS(FLUXW,GEN)
21675 IF(.NOT.GEN) RETURN
21677 AMP = FPI4*HWUAEM(EMSCA**2)**4
21678 C--copy the momenta and change the sign of the beam
21687 130 PCM(J,K)=P(J,K)
21691 C--use the e+e- code to calulate the spinor products
21692 CALL HWHEW2(6,PCM(1,1),ZH,ZCH,ZD)
21693 C--calculate the matrix elements
21694 IF (IPRC.EQ.0) THEN
21695 C--WW matrix element
21696 CALL HWHGB2(AMPWW,IDP,PHOTON)
21697 ELSEIF(IPRC.EQ.10) THEN
21698 C--ZZ matrix element
21699 CALL HWHGB3(AMPWW,IDP,PHOTON)
21700 ELSEIF(IPRC.EQ.20) THEN
21701 C--WZ matrix element
21702 CALL HWHGB4(AMPWW,IDP,PHOTON)
21704 C--Now calculate the cross section
21705 EVWGT = AMPWW*FLUXW*AMP
21708 IF(CHON(I)) WI(I) = WI(I)*AMPWW**2*AMP**2
21714 *CMZ :- -02/04/01 12.11.55 by Peter Richardson
21715 *-- Author : Peter Richardson
21716 C-----------------------------------------------------------------------
21717 SUBROUTINE HWHGBS(WEIGHT,GEN)
21718 C-----------------------------------------------------------------------
21719 C Multichannel phase space for gauge boson pair production
21720 C ICH returns the channel used is OPTM=.FALSE.
21721 C ICH specifies the channel to be used if OPTM=.TRUE.
21722 C This is used in optimising the weights for the different channels
21723 C-----------------------------------------------------------------------
21724 INCLUDE 'HERWIG65.INC'
21725 INTEGER ICH,IDBOS,ISM(2,IMAXCH),I,J,IB(2),IDRES,IDP,IOPT,IPRC,ID1
21726 DOUBLE PRECISION XMASS,PLAB,PRW,PCM,RAND,HWRGEN,BMS2(2),TJAC,PLM,
21727 & MJAC(2),TWOPI2,SJAC,STOT,THAT,UHAT,TMIN,TMAX,UMIN,UMAX,PS(2),
21728 & ETOT,HWUPCM,PST,HWRUNI,TAU,XJAC,PHI,SINTH,SIG(2),CV,CA,BR(2),
21729 & G(IMAXCH),XF,DEM,TN,UN,SN,S1,S2,MB1,MB2,WEIGHT,BRFAC,BRZ(12)
21731 COMMON /HWBOSN/ XMASS(2),PLAB(5,10),PRW(5,2),PCM(5,10),IDBOS(2),
21732 & IDRES,IDP(10),IOPT
21733 EXTERNAL HWRGEN,HWRLOG,HWUPCM,HWRUNI
21735 PARAMETER(TWOPI2=39.4784176D0)
21736 DATA SIG/1.0D0,-1.0D0/
21737 DATA BRZ/0.154D0,0.120D0,0.154D0,0.120D0,0.152D0,0.000D0,
21738 & 0.033D0,0.067D0,0.033D0,0.067D0,0.033D0,0.067D0/
21739 DOUBLE PRECISION WI(IMAXCH)
21741 IF(IERROR.NE.0) RETURN
21749 C--set the smoothing for the bosons in the various channels
21751 IPRC = MOD(IPROC,100)
21755 ISM(1,4*I-2+J ) = 1
21757 ISM(2,4*I+2*J-3) = 1
21758 ISM(2,4*I+2*J-2) = 2
21764 C--select the channel to be used
21768 IF(CHNPRB(ICH).GT.RAND) GOTO 10
21769 RAND = RAND-CHNPRB(ICH)
21773 C--select the boson masses and compute that part of the denominator
21774 C--decide which boson to do first
21775 IF(HWRLOG(HALF)) THEN
21782 C--find the boson masses
21783 CALL HWHGB1(ISM(IB(1),ICH),2,IDBOS(IB(1)),MJAC(IB(1)),BMS2(IB(1)),
21784 & (PHEP(5,3)-EMMIN)**2,EMMIN**2)
21785 XMASS(IB(1)) = SQRT(BMS2(IB(1)))
21786 CALL HWHGB1(ISM(IB(2),ICH),2,IDBOS(IB(2)),MJAC(IB(2)),BMS2(IB(2)),
21787 & (PHEP(5,3)-XMASS(IB(1)))**2,EMMIN**2)
21788 XMASS(IB(2)) = SQRT(BMS2(IB(2)))
21790 MJAC(I) = HALF*MJAC(I)/TWOPI2
21792 C--now generate the values of s
21793 C--according to a Breit-Wigner for the first two
21795 CALL HWHGB1(1,2,IDRES,SJAC,STOT,PHEP(5,3)**2,
21796 & (SQRT(BMS2(1)+PTMIN**2)+SQRT(BMS2(2)+PTMIN**2))**2)
21797 C--according to a power law for the rest
21799 CALL HWHGB1(2,2,IDRES,SJAC,STOT,PHEP(5,3)**2,
21800 & (SQRT(BMS2(1)+PTMIN**2)+SQRT(BMS2(2)+PTMIN**2))**2)
21803 C--find the centre of mass momenta
21804 PST = HWUPCM(ETOT,XMASS(1),XMASS(2))
21805 IF(PST.LT.PTMIN) RETURN
21806 PRW(4,1) = SQRT(BMS2(1)+PST**2)
21807 PRW(4,2) = SQRT(BMS2(2)+PST**2)
21808 C--now generate the value of t and u
21809 PLM = SQRT(PST**2-PTMIN**2)
21810 TMIN = BMS2(1)-ETOT*(PRW(4,1)+PLM)
21811 TMAX = BMS2(1)-ETOT*(PRW(4,1)-PLM)
21812 UMIN = BMS2(2)-ETOT*(PRW(4,2)+PLM)
21813 UMAX = BMS2(2)-ETOT*(PRW(4,2)-PLM)
21814 SN = ONE/(TMAX-TMIN)
21815 C--for the first two channels uniform in t
21817 THAT = HWRUNI(1,TMIN,TMAX)
21818 UHAT = BMS2(1)+BMS2(2)-STOT-THAT
21820 C--for the next four channels generate t according to 1/t
21821 ELSEIF(ICH.LE.6) THEN
21822 CALL HWHGB5(2,TJAC,THAT,TMAX,TMIN)
21823 UHAT = BMS2(1)+BMS2(2)-STOT-THAT
21824 C--for the last four channels generate u according to 1/u
21825 ELSEIF(ICH.LE.10) THEN
21826 CALL HWHGB5(2,TJAC,UHAT,UMAX,UMIN)
21827 THAT = BMS2(1)+BMS2(2)-STOT-UHAT
21829 CALL HWWARN('HWHGPS',500,*999)
21831 CALL HWHGB5(1,TN,THAT,TMAX,TMIN)
21832 CALL HWHGB5(1,UN,UHAT,UMAX,UMIN)
21833 C--generate the parton momentum fractions and find the pdf's
21834 TAU = STOT/PHEP(5,3)**2
21835 XX(1) = EXP(HWRUNI(3,LOG(TAU),ZERO))
21837 XJAC = -LOG(TAU)*XX(1)
21840 CALL HWSGEN(.FALSE.)
21841 C--Centre of mass collison angle
21842 COSTH = (THAT-BMS2(1)+ETOT*PRW(4,1))/ETOT/PST
21843 PHI = HWRUNI(4,ZERO,TWO*PIFAC)
21844 SINTH = SQRT(ONE-COSTH**2)
21845 C--incoming momenta in the centre of mass frame
21849 PLAB(3,I) = HALF*ETOT
21850 PLAB(4,I) = HALF*ETOT
21853 PLAB(3,2) = -PLAB(3,2)
21854 C--outgoing boson momenta in the centre of mass frame
21856 PRW(1,I) = SIG(I)*SINTH*COS(PHI)*PST
21857 PRW(2,I) = SIG(I)*SINTH*SIN(PHI)*PST
21858 PRW(3,I) = SIG(I)*COSTH*PST
21859 PRW(5,I) = XMASS(I)
21861 C--now find the boson decay products
21862 C--find the momenta of the boson decay products
21863 IF(IPRC.EQ.20) IDBOS(1)=198
21865 CALL HWDBZ2(IDBOS(I),IDP(2*I+1),IDP(2*I+2),CV,CA,BR(I),IOPT,
21867 IF(BR(I).EQ.ZERO) RETURN
21869 PLAB(5,2*I+1) = ZERO
21870 PLAB(5,2*I+2) = ZERO
21871 PS(I) = HALF*XMASS(I)
21874 CALL HWDTWO(PRW(1,I),PLAB(1,2*I+1),PLAB(1,2*I+2),
21875 & PS(I),TWO,.TRUE.)
21878 IF(IOPT.EQ.0) BRFAC = BRFAC*BR(1)
21880 IF(IDBOS(I).EQ.200) THEN
21882 IF(ID1.GE.121) ID1 = ID1-114
21883 BRFAC = BRFAC/BRZ(ID1)
21887 MJAC(I) = MJAC(I)*PS(I)/XMASS(I)
21889 C--set up a vector with the centre of mass
21892 PLAB(3,7) = HALF*PHEP(5,3)*(XX(1)-XX(2))
21893 PLAB(4,7) = HALF*PHEP(5,3)*(XX(1)+XX(2))
21895 C--now find the denominator
21896 CALL HWHGB1(1,1,IDRES,S1,STOT,PHEP(5,3)**2,
21897 & (XMASS(1)+XMASS(2))**2)
21898 CALL HWHGB1(2,1,IDRES,S2,STOT,PHEP(5,3)**2,
21899 & (XMASS(1)+XMASS(2))**2)
21903 C--factors due to the choice of s and t
21906 ELSEIF(I.LE.6) THEN
21911 C--factors due to the boson masses
21912 CALL HWHGB1(ISM(IB(1),I),1,IDBOS(IB(1)),MB1,BMS2(IB(1)),
21913 & (PHEP(5,3)-EMMIN)**2,EMMIN**2)
21914 CALL HWHGB1(ISM(IB(2),I),1,IDBOS(IB(2)),MB2,BMS2(IB(2)),
21915 & (PHEP(5,3)-XMASS(IB(1)))**2,EMMIN**2)
21916 G(I) = G(I)*MB1*MB2*XF
21917 DEM = DEM+CHNPRB(I)*G(I)
21920 C--now combine everything to get the weight
21921 WEIGHT = GEV2NB*TJAC*SJAC*G(ICH)/DEM/XX(1)*
21922 & MJAC(1)*MJAC(2)*XJAC/64.0D0/PIFAC/STOT**3*BRFAC
21924 C--compute the weights for the different channels if optimizing
21927 IF(CHON(I)) WI(I)=G(I)*WEIGHT**2/DEM
21932 *CMZ :- -02/04/01 12.11.55 by Peter Richardson
21933 *-- Author : Peter Richardson
21934 C-----------------------------------------------------------------------
21935 SUBROUTINE HWHGB1(ISM,IOPT,IDBOZ,FJAC,MBOS2,MMAX,MMIN)
21936 C-----------------------------------------------------------------------
21937 C Subroutine to select gauge boson mass for HWHGBP
21938 C ISM=1 select according to Breit-Wigner for IDBOZ
21939 C ISM=2 select according to power law for IDBOZ
21940 C IOPT=1 return the function at MBOS2
21941 C IOPT=2 calculate MBOS2
21942 C-----------------------------------------------------------------------
21943 INCLUDE 'HERWIG65.INC'
21944 INTEGER IDBOZ,ISM,IOPT
21945 DOUBLE PRECISION MBOZ,FJAC,GBOZ,GMBOZ,MPOW,MMIN,
21946 & MBOS2,A1,A2,A01,A02,RPOW,QPOW,HWRGEN,MMAX,EMSQ
21948 C--set the boson mass
21949 IF(IDBOZ.EQ.198.OR.IDBOZ.EQ.199) THEN
21952 ELSEIF(IDBOZ.EQ.200) THEN
21956 CALL HWWARN('HWHGB1',500,*999)
21960 C--smooth a Breit-Wigner only
21962 A02 = ATAN((MMIN-EMSQ)/GMBOZ)
21963 A2 = ATAN((MMAX-EMSQ)/GMBOZ)-A02
21965 FJAC = GMBOZ/((MBOS2-EMSQ)**2+GMBOZ**2)/A2
21967 MBOS2 = EMSQ+GMBOZ*TAN(A02+A2*HWRGEN(1))
21968 FJAC = A2*((MBOS2-EMSQ)**2+GMBOZ**2)/GMBOZ
21970 C--smooth a powerlaw only
21971 ELSEIF(ISM.EQ.2) THEN
21972 IF(EMPOW.EQ.TWO) THEN
21976 FJAC = ONE/MBOS2/A1
21978 MBOS2 = EXP(A01+A1*HWRGEN(2))
21986 A1 = (MMAX**QPOW-A01)
21988 FJAC = QPOW*MBOS2**MPOW/A1
21990 MBOS2 = (A01+A1*HWRGEN(2))**RPOW
21991 FJAC = A1*RPOW/MBOS2**MPOW
21995 CALL HWWARN('HWHGB1',501,*999)
21999 *CMZ :- -02/04/01 12.11.55 by Peter Richardson
22000 *-- Author : Peter Richardson
22001 C-----------------------------------------------------------------------
22002 SUBROUTINE HWHGB2(HCS,IDP,PHOTON)
22003 C-----------------------------------------------------------------------
22004 C WW cross section in hadron hadron
22005 C-----------------------------------------------------------------------
22006 INCLUDE 'HERWIG65.INC'
22007 DOUBLE PRECISION HCS,RCS,HWRGEN,DIST(2),CFAC,WAMP(2),S34,S56,KWW2,
22008 & MW2,MZ2,GMW,GMZ,G(4,2),EE(4),CKM2(12),RF(2),LF(2),TAUI(2),
22010 DOUBLE COMPLEX ZH,ZCH,ZD,Z1,Z2,ZHF,P12,Z12,S134,S156,AWW,BWW,
22011 & CWW,DWW,AWWM(2),AWWP(2),HWHEW4
22012 INTEGER IDP(10),I,I1,I2,MAPZ(4,3),P1,P2,P3,P4
22013 PARAMETER(Z1=(0.0D0,1.0D0),Z2=(2.0D0,0.0D0),
22014 & ZHF=(0.5D0,0.0D0))
22016 EXTERNAL HWRGEN,HWHEW4
22017 COMMON/HWHEWQ/ZH(8,8),ZCH(8,8),ZD(8,8)
22018 COMMON /HWHGBC/ MW2,MZ2,GMW,GMZ,G,EE,CKM2,RF,LF,TAUI,CSW,CFAC1
22019 DATA MAPZ/1,2,121,122,3,4,123,125,5,6,124,126/
22020 SAVE WAMP,AWWM,AWWP
22022 RCS = HCS*HWRGEN(1)
22024 C--Now calculate the matrix element
22025 Z12 = ONE/(Z2*ZD(1,2)-MZ2+Z1*GMZ)
22026 P12 = ZHF*(Z2*ZD(1,2)-MZ2)*Z12/ZD(1,2)
22027 S134 = ZHF*(Z2*ZD(1,2)-MZ2)*Z12/(ZD(1,3)+ZD(1,4)+ZD(3,4))
22028 S156 = ZHF*(Z2*ZD(1,2)-MZ2)*Z12/(ZD(1,5)+ZD(1,6)+ZD(5,6))
22029 S34 = DBLE(Z2*ZD(3,4))
22030 S56 = DBLE(Z2*ZD(5,6))
22031 KWW2 = ONE/((S34-MW2)**2+GMW**2)/((S56-MW2)**2+GMW**2)
22034 DWW = LF(I)*Z12-RF(I)*P12
22035 CWW = RF(I)*(Z12-P12)
22036 AWW = DWW + ZHF*S134*(TAUI(I)+ONE)
22037 BWW = DWW + ZHF*S156*(TAUI(I)-ONE)
22038 AWWM(I) = AWW*HWHEW4(1,2,3,4,5,6)-BWW*HWHEW4(1,2,5,6,3,4)
22039 AWWP(I) = CWW*(HWHEW4(2,1,5,6,3,4)-HWHEW4(2,1,3,4,5,6))
22040 WAMP(I) = KWW2*DBLE( AWWM(I)*DCONJG(AWWM(I))
22041 & +AWWP(I)*DCONJG(AWWP(I)))
22045 CFAC = CFAC1*81.0D0
22048 IDP(1) = MAPZ(I,I1)
22050 DIST(1)=DISF(IDP(1),1)*DISF(IDP(2),2)
22051 DIST(2)=DISF(IDP(2),1)*DISF(IDP(1),2)
22053 HCS = HCS+DIST(I2)*CFAC*WAMP(I)
22054 IF(GENEV.AND.HCS.GT.RCS) THEN
22055 C--new for spin correlations
22062 10 MESPN(P1,P2,P3,P4,1,1) = (0.0D0,0.0D0)
22063 MESPN(1,2,2,1,1,1) = AWWP(I)
22064 MESPN(2,2,2,1,1,1) = AWWM(I)
22066 SPNCFC(1,1,1) = ONE
22077 *CMZ :- -02/04/01 12.11.55 by Peter Richardson
22078 *-- Author : Peter Richardson
22079 C-----------------------------------------------------------------------
22080 SUBROUTINE HWHGB3(HCS,IDP,PHOTON)
22081 C-----------------------------------------------------------------------
22082 C ZZ cross section in hadron hadron
22083 C-----------------------------------------------------------------------
22084 INCLUDE 'HERWIG65.INC'
22085 DOUBLE PRECISION AMP(2),RCS,HCS,HWRGEN,DIST(2),S34,S56,CFAC,
22086 & MW2,MZ2,GMW,GMZ,G(4,2),EE(4),CKM2(12),RF(2),LF(2),TAUI(2),
22088 DOUBLE COMPLEX ZH,ZCH,ZD,P34,P56,Z34,Z56,Z1,ZAMP(8),S134,S156,
22089 & HWHEW4,TAMP,Z0,AMPT(2,2,2,2),CP
22090 INTEGER I,P1,P2,P3,IDP(10),I2,MAPZ(4,3),I1,ID(2),O(2)
22091 EXTERNAL HWHEW4,HWRGEN
22093 COMMON/HWHEWQ/ZH(8,8),ZCH(8,8),ZD(8,8)
22094 COMMON /HWHGBC/ MW2,MZ2,GMW,GMZ,G,EE,CKM2,RF,LF,TAUI,CSW,CFAC1
22095 PARAMETER(Z0=(0.0D0,0.0D0),Z1=(0.0D0,1.0D0))
22096 DATA MAPZ/1,2,121,122,3,4,123,125,5,6,124,126/
22101 RCS = HCS*HWRGEN(0)
22103 C--Identitiys of the decay prodcucts (d=1,u=2,e=3,nu=4)
22106 IF(ID(I).GE.121) ID(I) = ID(I)-114
22107 ID(I) = MOD(ID(I)+1,2)+2*INT((ID(I)-1)/6)+1
22109 C--the various propagators we need
22110 S34 = TWO*DBLE(ZD(3,4))
22111 S56 = TWO*DBLE(ZD(5,6))
22112 Z34 = ONE/(S34-MZ2+Z1*GMZ)
22113 Z56 = ONE/(S56-MZ2+Z1*GMZ)
22115 P34 = Z34*(S34-MZ2)/S34
22116 P56 = Z56*(S56-MZ2)/S56
22121 S134 = HALF/(ZD(1,3)+ZD(1,4)+ZD(3,4))
22122 S156 = HALF/(ZD(1,5)+ZD(1,6)+ZD(5,6))
22123 C--Now calculate the amplitudes
22124 ZAMP(1)=HWHEW4(1,2,3,4,5,6)*S134+HWHEW4(1,2,5,6,3,4)*S156
22125 ZAMP(2)=HWHEW4(1,2,4,3,5,6)*S134+HWHEW4(1,2,5,6,4,3)*S156
22126 ZAMP(3)=HWHEW4(1,2,3,4,6,5)*S134+HWHEW4(1,2,6,5,3,4)*S156
22127 ZAMP(4)=HWHEW4(1,2,4,3,6,5)*S134+HWHEW4(1,2,6,5,4,3)*S156
22128 ZAMP(5)=HWHEW4(2,1,3,4,5,6)*S156+HWHEW4(2,1,5,6,3,4)*S134
22129 ZAMP(6)=HWHEW4(2,1,4,3,5,6)*S156+HWHEW4(2,1,5,6,4,3)*S134
22130 ZAMP(7)=HWHEW4(2,1,3,4,6,5)*S156+HWHEW4(2,1,6,5,3,4)*S134
22131 ZAMP(8)=HWHEW4(2,1,4,3,6,5)*S156+HWHEW4(2,1,6,5,4,3)*S134
22132 C--Now the amplitudes squared for the process
22139 CP = G(I,P1)**2*G(ID(1),P2)*G(ID(2),P3)*Z34*Z56
22140 & +G(I,P1)*EE(I)*G(ID(1),P2)*EE(ID(2))*Z34*P56
22141 & +G(I,P1)*EE(I)*EE(ID(1))*G(ID(2),P3)*P34*Z56
22142 & +EE(I)**2*EE(ID(1))*EE(ID(2))*P34*P56
22144 CP = G(I,P1)**2*G(ID(1),P2)*G(ID(2),P3)*Z34*Z56
22146 AMPT(I,P1,P2,P3) = ZAMP(4*P1+2*P3+P2-6)*CP
22147 TAMP = TAMP+AMPT(I,P1,P2,P3)*DCONJG(AMPT(I,P1,P2,P3))
22151 AMP(I) = HALF*DBLE(TAMP)
22154 C--Now calculate the cross section
22157 IF(ID(1).LE.2) CFAC = CFAC*THREE
22158 IF(ID(2).LE.2) CFAC = CFAC*THREE
22161 IDP(1) = MAPZ(I,I1)
22162 IDP(2) = MAPZ(I,I1)+6
22163 DIST(1)=DISF(IDP(1),1)*DISF(IDP(2),2)
22164 DIST(2)=DISF(IDP(2),1)*DISF(IDP(1),2)
22166 HCS = HCS+CFAC*DIST(I2)*AMP(I)
22167 IF(GENEV.AND.HCS.GT.RCS) THEN
22168 C--New for spin correlations
22174 MESPN(P1,P2,P3,1,1,1) = AMPT(I,O(P1),O(P2),O(P3))
22175 10 MESPN(P1,P2,P3,2,1,1) = (0.0D0,0.0D0)
22177 SPNCFC(1,1,1) = ONE
22188 *CMZ :- -02/04/01 12.11.55 by Peter Richardson
22189 *-- Author : Peter Richardson
22190 C-----------------------------------------------------------------------
22191 SUBROUTINE HWHGB4(HCS,IDP,PHOTON)
22192 C-----------------------------------------------------------------------
22193 C WZ cross section in hadron hadron
22194 C-----------------------------------------------------------------------
22195 INCLUDE 'HERWIG65.INC'
22196 DOUBLE PRECISION AMP(2),HCS,RCS,HWRGEN,W34,DIST(2),S34,S56,CFAC,
22197 & TCS,S12,MW2,MZ2,GMW,GMZ,G(4,2),EE(4),CKM2(12),RF(2),LF(2),
22198 & TAUI(2),CSW,CFAC1
22199 DOUBLE COMPLEX ZH,ZCH,ZD,P56,Z56,Z1,Z0,S134,S156,HWHEW4,
22200 & CP(4),W12,F(4),TAMP(2,2)
22201 INTEGER IDP(10),I,J,I1,I2,I3,ID,P1,P2,P3,P4
22203 EXTERNAL HWRGEN,HWHEW4
22204 COMMON/HWHEWQ/ZH(8,8),ZCH(8,8),ZD(8,8)
22205 COMMON /HWHGBC/ MW2,MZ2,GMW,GMZ,G,EE,CKM2,RF,LF,TAUI,CSW,CFAC1
22206 PARAMETER(Z0=(0.0D0,0.0D0),Z1=(0.0D0,1.0D0))
22209 RCS = HCS*HWRGEN(1)
22211 C--identity of the Z decay product (d=1,u=2,e=3,nu=4)
22213 IF(ID.GE.121) ID = ID-114
22214 ID = MOD(ID+1,2)+2*INT((ID-1)/6)+1
22215 C--the various propagators we need
22216 S12 = TWO*DBLE(ZD(1,2))
22217 S34 = TWO*DBLE(ZD(3,4))
22218 S56 = TWO*DBLE(ZD(5,6))
22219 Z56 = ONE/(S56-MZ2+Z1*GMZ)
22221 P56 = Z56*(S56-MZ2)/S56
22225 W12 = ONE/(S12-MW2+Z1*GMW)
22226 S134 = HALF*W12*(S12-MW2)/(ZD(1,3)+ZD(1,4)+ZD(3,4))
22227 S156 = HALF*W12*(S12-MW2)/(ZD(1,5)+ZD(1,6)+ZD(5,6))
22228 W34 = ONE/((S34-MW2)**2+GMW**2)/SWEIN**2/FOUR
22229 C--calculate the coefficents of the various amplitudes
22230 F(1) = HWHEW4(1,2,3,4,5,6)
22231 F(2) = HWHEW4(1,2,5,6,3,4)
22232 F(3) = HWHEW4(1,2,3,4,6,5)
22233 F(4) = HWHEW4(1,2,6,5,3,4)
22240 CP(1) = G(J,1)*S134-TAUI(I)*CSW*W12
22241 CP(2) = G(I,1)*S156+TAUI(I)*CSW*W12
22243 CP(3) = EE(J)*S134-TAUI(I)*W12
22244 CP(4) = EE(I)*S156+TAUI(I)*W12
22249 TAMP(I,1) = F(1)*(G(ID,1)*Z56*CP(1)+EE(ID)*P56*CP(3))
22250 & +F(2)*(G(ID,1)*Z56*CP(2)+EE(ID)*P56*CP(4))
22251 TAMP(I,2) = F(3)*(G(ID,2)*Z56*CP(1)+EE(ID)*P56*CP(3))
22252 & +F(4)*(G(ID,2)*Z56*CP(2)+EE(ID)*P56*CP(4))
22253 AMP(I) = W34*DBLE( TAMP(I,1)*DCONJG(TAMP(I,1))
22254 & +TAMP(I,2)*DCONJG(TAMP(I,2)))
22257 C--Now calculate the cross section
22260 IF(ID.LE.2) CFAC = CFAC*THREE
22273 C**Bug fix 2/7/01 by BRW (unsquare)
22280 DIST(1) = TCS*DISF(IDP(1),1)*DISF(IDP(2),2)
22281 DIST(2) = TCS*DISF(IDP(2),1)*DISF(IDP(1),2)
22283 HCS = HCS+CFAC*DIST(I2)*AMP(I)
22284 IF(GENEV.AND.HCS.GT.RCS) GOTO 900
22289 900 IF(GENEV.AND.I2.EQ.2) THEN
22294 IF(SYSPIN.AND.GENEV) THEN
22300 10 MESPN(P1,P2,P3,P4,1,1) = (0.0D0,0.0D0)
22301 MESPN(2 ,2 ,1 ,1 ,1,1) = TAMP(I,2)
22302 MESPN(2 ,2 ,2 ,1 ,1,1) = TAMP(I,1)
22304 SPNCFC(1,1,1) = ONE
22308 *CMZ :- -02/04/01 12.11.55 by Peter Richardson
22309 *-- Author : Peter Richardson
22310 C-----------------------------------------------------------------------
22311 SUBROUTINE HWHGB5(IOPT,FJAC,T,TMAX,TMIN)
22312 C-----------------------------------------------------------------------
22313 C Subroutine to select t or u for HWHGBP
22314 C-----------------------------------------------------------------------
22315 INCLUDE 'HERWIG65.INC'
22317 DOUBLE PRECISION FJAC,TPOW,TMIN,T,A1,A01,RPOW,QPOW,HWRGEN,TMAX,TN,
22323 IF(TPOW.EQ.-ONE) THEN
22328 T = -TN*EXP(A1*HWRGEN(2))
22335 A1 = (TX**QPOW-A01)
22338 FJAC =QPOW*MT**TPOW/A1
22340 MT = (A01+A1*HWRGEN(2))**RPOW
22342 FJAC = A1*RPOW/MT**TPOW
22347 *CMZ :- -13/10/00 10:48:07 by Peter Richardson
22348 *-- Author Kosuke Odagiri
22349 C-----------------------------------------------------------------------
22351 C-----------------------------------------------------------------------
22352 C Massive spin-2 resonance (massive graviton)
22353 C Universal tensor coupling to the energy-momentum tensor is assumed
22354 C viz L = - G(mu,nu) T(mu,nu) / GRVLAM
22355 C If GAMGRV is zero, it is revaluated during the first run
22356 C MEAN EVWGT = SIGMA IN NB
22357 C-----------------------------------------------------------------------
22358 INCLUDE 'HERWIG65.INC'
22359 DOUBLE PRECISION HWRGEN,HWRUNI,EPS,EMSQG,
22360 & EMGMG,S,CC,CC2,SS,SS2,M1(16),M2(16),M3,M4,M5(3),M6(3),
22361 & RNGLU,FACT,HCS,FACTR,RCS,A2,A02,QPE,SQPE,RGRV
22362 INTEGER IMODE,JQMN,JQMX,JQ,JLMN,JLMX,JL,IQ,I,ID1,ID2,ID3,ID4,
22364 LOGICAL JGLU,JPHO,JW,JZ,JH
22365 EXTERNAL HWRGEN,HWRUNI
22366 SAVE HCS,JQMN,JQMX,JLMN,JLMX,JGLU,JPHO,JW,JZ,JH,EMSQG,EMGMG,
22367 & A2,A02,FACT,RNGLU,M1,M2,M3,M4,M5,M6
22368 PARAMETER (EPS=1.D-9)
22374 C Set limits for which particles to include
22384 IMODE=MOD(IPROC,100)
22385 IF (IMODE.EQ.0) THEN
22395 ELSEIF (IMODE.EQ.10) THEN
22399 ELSEIF (IMODE.GT.10.AND.IMODE.LE.16) THEN
22402 ELSEIF (IMODE.EQ.20) THEN
22404 ELSEIF (IMODE.EQ.50) THEN
22408 ELSEIF (IMODE.GT.50.AND.IMODE.LE.56) THEN
22411 ELSEIF (IMODE.EQ.60) THEN
22413 ELSEIF (IMODE.EQ.70) THEN
22417 ELSEIF (IMODE.EQ.71) THEN
22419 ELSEIF (IMODE.EQ.72) THEN
22421 ELSEIF (IMODE.EQ.73) THEN
22424 CALL HWWARN('HWHGRV',500,*999)
22427 IF (GAMGRV.EQ.ZERO) THEN
22428 C Calculate the width if GAMGRV=ZERO.
22431 RGRV=(RMASS(JQ)/EMGRV)**2
22433 IF (QPE.GT.ZERO) THEN
22435 GAMGRV=GAMGRV+CAFAC*SQPE**3*(ONE+8.D0/3.D0*RGRV)/4.D0
22440 RGRV=(RMASS(JL)/EMGRV)**2
22442 IF (QPE.GT.ZERO) THEN
22444 GAMGRV=GAMGRV+SQPE**3*(ONE+8.D0/3.D0*RGRV)/4.D0
22450 GAMGRV=GAMGRV+HALF*RNGLU
22452 RGRV=(RMASS(200)/EMGRV)**2
22454 IF (QPE.GT.ZERO) THEN
22456 GAMGRV=GAMGRV+SQPE*
22457 & (13.D0/12.D0+14.D0/3.D0*RGRV+4.D0*RGRV**2)/TWO
22460 RGRV=(RMASS(198)/EMGRV)**2
22462 IF (QPE.GT.ZERO) THEN
22464 GAMGRV=GAMGRV+SQPE*
22465 & (13.D0/12.D0+14.D0/3.D0*RGRV+4.D0*RGRV**2)
22468 RGRV=(RMASS(201)/EMGRV)**2
22470 IF (QPE.GT.ZERO) THEN
22472 GAMGRV=GAMGRV+SQPE**5/12.D0/TWO
22474 GAMGRV=GAMGRV*EMGRV**3/(GRVLAM**2*40.D0*PIFAC)
22478 A02=ATAN((EMMIN**2-EMSQG)/EMGMG)
22479 A2 =ATAN((EMMAX**2-EMSQG)/EMGMG)-A02
22482 C Select a mass for the produced pair
22483 S=EMSQG+EMGMG*TAN(A02+A2*HWRGEN(1))
22485 C Select initial momentum fractions
22486 XXMIN=S/PHEP(5,3)**2
22488 CALL HWSGEN(.TRUE.)
22489 COSTH=HWRUNI(0,-ONE,ONE)
22491 FACT=-GEV2NB*A2*XLMIN*S**2/(GRVLAM**4*EMGMG*16.D0*PIFAC)
22500 QPE=ONE-4.D0*RMASS(JQ)**2/S
22501 IF (QPE.GT.ZERO) THEN
22503 M1(JQ)=SQPE*QPE*(ONE+CC-4.D0*QPE*SS*CC)/64.D0/CAFAC
22504 M2(JQ)=SQPE*QPE*SS*(TWO-QPE*SS)/16.D0/RNGLU
22509 QPE=ONE-4.D0*RMASS(JL+110)**2/S
22510 IF (QPE.GT.ZERO) THEN
22512 M1(JL)=SQPE*QPE*(ONE+CC-4.D0*QPE*SS*CC)/64.D0/CAFAC
22513 M2(JL)=SQPE*QPE*SS*(TWO-QPE*SS)/16.D0/RNGLU
22519 C QQ,GG -> BB (massless)
22520 M3=SS*(ONE+CC)/32.D0/CAFAC
22521 M4=(CC+SS2/8.D0)/4.D0/RNGLU
22523 QPE=ONE-4.D0*RMASS(198)**2/S
22524 IF (QPE.GT.ZERO) THEN
22526 M5(1)=SQPE*(ONE-.5D0*QPE*(ONE+CC)+.75D0*QPE**2*CC*SS)/8.D0/CAFAC
22527 M6(1)=SQPE*(ONE-QPE*SS+3.D0*QPE**2*SS2/16.D0)/2.D0/RNGLU
22532 QPE=ONE-4.D0*RMASS(200)**2/S
22533 IF (QPE.GT.ZERO) THEN
22535 M5(2)=SQPE*(ONE-.5D0*QPE*(ONE+CC)+.75D0*QPE**2*CC*SS)/16.D0/CAFAC
22536 M6(2)=SQPE*(ONE-QPE*SS+3.D0*QPE**2*SS2/16.D0)/4.D0/RNGLU
22541 QPE=ONE-4.D0*RMASS(201)**2/S
22542 IF (QPE.GT.ZERO) THEN
22544 M5(3)=SQPE*(QPE**2*SS*CC)/64.D0/CAFAC
22545 M6(3)=SQPE*(QPE**2*SS2)/64.D0/RNGLU
22553 C I=1 quark first, I=2 anti-quark first
22557 IF (DISF(ID1,1).LT.EPS.OR.DISF(ID2,2).LT.EPS) GOTO 80
22558 FACTR=FACT*DISF(ID1,1)*DISF(ID2,2)
22559 C Quark final states
22563 HCS=HCS+FACTR*M1(JQ)*CAFAC
22564 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID3,ID4,2143,50,*99)
22566 C Lepton final states
22570 HCS=HCS+FACTR*M1(JL)
22571 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID3,ID4,2134,50,*99)
22573 C Bosonic final states
22578 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID3,ID4,2134,50,*99)
22583 HCS=HCS+FACTR*M5(1)
22584 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID3,ID4,2134,50,*99)
22589 HCS=HCS+FACTR*M5(2)
22590 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID3,ID4,2134,50,*99)
22595 HCS=HCS+FACTR*M5(3)
22596 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID3,ID4,2134,50,*99)
22601 HCS=HCS+FACTR*M3*RNGLU
22602 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID3,ID4,2143,50,*99)
22606 C Gluon initial states
22609 IF (DISF(ID1,1).LT.EPS.OR.DISF(ID2,2).LT.EPS) GOTO 30
22610 FACTR=FACT*DISF(ID1,1)*DISF(ID2,2)
22611 C Quark final states
22615 HCS=HCS+FACTR*M2(JQ)*CAFAC
22616 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID3,ID4,2143,51,*99)
22618 C Lepton final states
22622 HCS=HCS+FACTR*M2(JL)
22623 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID3,ID4,2134,51,*99)
22625 C Vector boson final states
22630 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID3,ID4,2134,51,*99)
22635 HCS=HCS+FACTR*M6(1)
22636 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID3,ID4,2134,51,*99)
22641 HCS=HCS+FACTR*M6(2)
22642 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID3,ID4,2134,51,*99)
22647 HCS=HCS+FACTR*M6(3)
22648 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID3,ID4,2134,51,*99)
22653 HCS=HCS+FACTR*M4*RNGLU
22654 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID3,ID4,2143,51,*99)
22663 CALL HWETWO(.TRUE.,.TRUE.)
22665 C Calculate coefficients for constructing spin density matrices
22666 C Set to zero for now
22667 CALL HWVZRO(7,GCOEF)
22671 *CMZ :- -16/07/02 09.40.25 by Peter Richardson
22672 *-- Author : Peter Richardson
22673 C----------------------------------------------------------------------
22675 C----------------------------------------------------------------------
22676 C Use the GUPI (Generic User Process Interface) event common block
22677 C as the hard process for HERWIG
22678 C----------------------------------------------------------------------
22679 INCLUDE 'HERWIG65.INC'
22680 C--Les Houches Common Block
22682 PARAMETER(MAXPUP=100)
22683 INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP
22684 DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP
22685 COMMON /HEPRUP/ IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2),
22686 & IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),
22687 & XMAXUP(MAXPUP),LPRUP(MAXPUP)
22689 PARAMETER (MAXNUP=500)
22690 INTEGER NUP,IDPRUP,IDUP,ISTUP,MOTHUP,ICOLUP
22691 DOUBLE PRECISION XWGTUP,SCALUP,AQEDUP,AQCDUP,PUP,VTIMUP,SPINUP
22692 COMMON/HEPEUP/NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP,
22693 & IDUP(MAXNUP),ISTUP(MAXNUP),MOTHUP(2,MAXNUP),
22694 & ICOLUP(2,MAXNUP),PUP(5,MAXNUP),VTIMUP(MAXNUP),
22697 COMMON /HWGUP/ILOC(NMXHEP),JLOC(MAXNUP)
22698 INTEGER ILOC,JLOC,JHEP,ID
22699 INTEGER IHEP,IDIN(2),I,IDRES(2,MAXPUP),IRES,ICMF,ISTART,JRES,J
22700 DOUBLE PRECISION PTEMP(5)
22705 C--zero the variables
22712 c---generate hard subprocess
22713 C--now do the event selection bit
22714 IF(.NOT.GENEV) THEN
22715 IDPRUP = LPRUP(ITYPLH)
22717 IF(ABS(IDWTUP).EQ.1.OR.ABS(IDWTUP).EQ.2.OR.
22718 & ABS(IDWTUP).EQ.4) THEN
22719 EVWGT = XWGTUP*1.0D-3
22720 ELSEIF(ABS(IDWTUP).EQ.3) THEN
22721 EVWGT = SIGN(ONE,XWGTUP)
22723 CALL HWWARN('HWHGUP',510,*999)
22725 C--check the sign of the weight
22726 IF(IDWTUP.GT.ZERO.AND.EVWGT.LT.ZERO)
22727 & CALL HWWARN('HWHGUP',520,*999)
22730 C--update the number of events
22731 LHNEVT(ITYPLH) = LHNEVT(ITYPLH)+1
22733 C--first search to see if there are incoming beam particles in the record
22736 IF(ISTUP(IHEP).EQ.-9) THEN
22738 IF(I.EQ.3) CALL HWWARN('HWHGUP',102,*999)
22742 C--put the beam particles in the record
22743 C--require the soft event
22744 GENSOF = LHSOFT.AND.HWRLOG(PRSOF)
22745 C--if given for event from event common block
22748 C--otherwise from the process common block
22749 ELSEIF(I.EQ.0) THEN
22751 CALL HWUIDT(1,IDBMUP(I),IDHW(I),DUMMY)
22754 PHEP(4,I) = EBMUP(I)
22755 PHEP(5,I) = RMASS(IDHW(I))
22756 PHEP(3,I) = SQRT(EBMUP(I)**2-RMASS(IDHW(I))**2)
22759 PHEP(3,2) = -PHEP(3,2)
22761 C--if not correct issue warning
22763 CALL HWWARN('HWHGUP',103,*999)
22765 C--setup the centre-of-mass energy
22766 CALL HWVSUM(4,PHEP(1,NHEP-1),PHEP(1,NHEP),PHEP(1,NHEP+1))
22767 CALL HWUMAS(PHEP(1,NHEP+1))
22768 JMOHEP(1,NHEP+1) = NHEP-1
22769 JMOHEP(2,NHEP+1) = NHEP
22773 C--search for the incoming particles in collision
22776 IF(ISTUP(IHEP).EQ.-1) THEN
22778 IF(I.EQ.3) CALL HWWARN('HWHGUP',100,*999)
22782 C--require two incoming particles
22783 IF(I.NE.2) CALL HWWARN('HWHGUP',101,*999)
22784 C--Now write these particles into the event record
22786 IDHEP(NHEP+I) = IDUP(IDIN(I))
22787 ISTHEP(NHEP+I) = 110+I
22788 CALL HWUIDT(1,IDUP(IDIN(I)),IDHW(NHEP+I),DUMMY)
22789 CALL HWVEQU(5,PUP(1,IDIN(I)),PHEP(1,NHEP+I))
22790 JMOHEP(1,NHEP+I) = NHEP+3
22791 ILOC(NHEP+I) = IDIN(I)
22793 C--special for pairtcles which are identical to the beam
22795 IF(IDHEP(NHEP+I).EQ.IDHEP(J)) THEN
22796 JDAHEP(1,J) = NHEP+I
22797 JDAHEP(2,J) = NHEP+I
22801 CALL HWVSUM(4,PHEP(1,NHEP+1),PHEP(1,NHEP+2),PHEP(1,NHEP+3))
22802 CALL HWUMAS(PHEP(1,NHEP+3))
22803 C--add the hard entry
22805 ISTHEP(NHEP+3) = 110
22806 JMOHEP(1,NHEP+3) = NHEP+1
22807 JMOHEP(2,NHEP+3) = NHEP+2
22808 JDAHEP(1,NHEP+3) = NHEP+4
22811 C--now search for the outgoing particles and add them to the event record
22813 C--normal outgoing particles
22814 IF(ISTUP(I).EQ.1.AND.
22815 & (MOTHUP(1,I).EQ.IDIN(1).OR.MOTHUP(1,I).EQ.IDIN(2))) THEN
22817 IDHEP(NHEP) = IDUP(I)
22818 CALL HWUIDT(1,IDUP(I),IDHW(NHEP),DUMMY)
22819 CALL HWVEQU(5,PUP(1,I),PHEP(1,NHEP))
22820 JMOHEP(1,NHEP) = ICMF
22825 C--resonances which must have mass preserved and resonances
22826 C-- which don't have to have mass preserved
22827 C--for the time being we won't disguish between these two options
22828 ELSEIF((ISTUP(I).EQ.2.OR.ISTUP(I).EQ.3).AND.
22829 & (MOTHUP(1,I).EQ.IDIN(1).OR.MOTHUP(1,I).EQ.IDIN(2))) THEN
22831 IDHEP(NHEP) = IDUP(I)
22832 CALL HWUIDT(1,IDUP(I),IDHW(NHEP),DUMMY)
22833 CALL HWVEQU(5,PUP(1,I),PHEP(1,NHEP))
22835 IDRES(1,IRES) = NHEP
22837 JMOHEP(1,NHEP) = ICMF
22842 ELSEIF(ISTUP(I).NE.-9.AND.ISTUP(I).NE.-1.AND.ISTUP(I).NE.1.AND.
22843 & ISTUP(I).NE.2.AND.ISTUP(I).NE.3) THEN
22844 CALL HWWARN('HWHGUP',500,*999)
22847 C--Modified 2/7/03 for 2->1 processes
22848 IF(ICMF+1.EQ.NHEP) THEN
22850 IDHEP(NHEP) = IDHEP(NHEP+1)
22852 IDHW(NHEP) = IDHW(NHEP+1)
22854 CALL HWVEQU(5,PHEP(1,NHEP+1),PHEP(1,NHEP))
22855 JMOHEP(1,NHEP+1) = 0
22856 JMOHEP(2,NHEP+1) = 0
22857 JDAHEP(1,NHEP+1) = 0
22858 JDAHEP(2,NHEP+1) = 0
22859 JDAHEP(1,NHEP ) = NHEP
22860 JDAHEP(2,NHEP ) = NHEP
22861 ILOC(NHEP) = ILOC(NHEP+1)
22863 JLOC(ILOC(NHEP)) = NHEP
22866 IF(IDRES(1,IRES).EQ.NHEP+1) IDRES(1,IRES) = NHEP
22869 JDAHEP(2,ICMF) = NHEP
22870 C--setup the status codes
22871 ISTHEP(ICMF+1) = 113
22872 DO IHEP=ICMF+2,NHEP
22879 C--generate parton shower
22880 CALL HWBGUP(ISTART,ICMF)
22881 C--now we need to sort out the resonances
22882 IF(IRES.EQ.0) RETURN
22884 35 ID = IDHEP(IDRES(1,JRES))
22885 36 IF(JDAHEP(1,IDRES(1,JRES)).NE.0.AND.
22886 & JDAHEP(1,IDRES(1,JRES)).NE.IDRES(1,JRES)) THEN
22887 IF(IDHEP(IDRES(1,JRES)).EQ.94) THEN
22888 DO IHEP=JDAHEP(1,IDRES(1,JRES)),JDAHEP(2,IDRES(1,JRES))
22889 IF(IDHEP(IHEP).EQ.ID) THEN
22890 IDRES(1,JRES) = IHEP
22895 IDRES(1,JRES) = JDAHEP(1,IDRES(1,JRES))
22899 C--make a copy of this particle
22900 IHEP = IDRES(1,JRES)
22901 JMOHEP(1,NHEP+1) = JMOHEP(1,IDRES(1,JRES))
22902 JMOHEP(2,NHEP+1) = JMOHEP(2,IDRES(1,JRES))
22903 IDHEP(NHEP+1) = IDHEP(IDRES(1,JRES))
22904 IDHW(NHEP+1) = IDHW(IDRES(1,JRES))
22905 CALL HWVEQU(5,PHEP(1,IDRES(1,JRES)),PHEP(1,NHEP+1))
22906 IDRES(1,JRES) = NHEP+1
22907 JLOC(IDRES(2,JRES)) = IDRES(1,JRES)
22908 ISTHEP(NHEP+1) = 155
22910 C Reset colour pointers (if set)
22911 JHEP=JMOHEP(2,IHEP)
22912 IF (JHEP.GT.0) THEN
22913 IF (JDAHEP(2,JHEP).EQ.IHEP) JDAHEP(2,JHEP)=NHEP
22914 IF(.NOT.RPARTY.AND.ISTHEP(JHEP).EQ.155
22915 & .AND.ABS(IDHEP(JHEP)).GT.1000000
22916 & .AND.JDAHEP(2,JHEP-1).EQ.IHEP) JDAHEP(2,JHEP-1) = NHEP
22918 JHEP=JDAHEP(2,IHEP)
22919 IF (JHEP.GT.0) THEN
22920 IF (JMOHEP(2,JHEP).EQ.IHEP) JMOHEP(2,JHEP)=NHEP
22921 IF(.NOT.RPARTY.AND.ISTHEP(JHEP).EQ.155
22922 & .AND.ABS(IDHEP(JHEP)).GT.1000000
22923 & .AND.JMOHEP(2,JHEP-1).EQ.IHEP) JMOHEP(2,JHEP-1) = NHEP
22925 C Relabel original track
22926 IF (ISTHEP(IHEP).NE.120) ISTHEP(IHEP)=3
22927 JMOHEP(2,IHEP)=JMOHEP(1,IHEP)
22928 JDAHEP(1,IHEP)=NHEP
22929 JDAHEP(2,IHEP)=NHEP
22930 C--look for all the particles which have this as a mother
22931 C--now search for the outgoing particles and add them to the event record
22932 JDAHEP(1,NHEP) = NHEP+1
22933 ISTHEP(NHEP+1) = 113
22935 IF(ISTUP(I).EQ.1.AND.MOTHUP(1,I).EQ.IDRES(2,JRES)) THEN
22937 IDHEP(NHEP) = IDUP(I)
22938 CALL HWUIDT(1,IDUP(I),IDHW(NHEP),DUMMY)
22939 CALL HWULOF(PUP(1,IDRES(2,JRES)),PUP(1,I),PHEP(1,NHEP))
22940 CALL HWULOB(PHEP(1,IDRES(1,JRES)),PHEP(1,NHEP),PHEP(1,NHEP))
22941 JMOHEP(1,NHEP) = IDRES(1,JRES)
22946 ELSEIF((ISTUP(I).EQ.2.OR.ISTUP(I).EQ.3).AND.
22947 & MOTHUP(1,I).EQ.IDRES(2,JRES)) THEN
22949 IDHEP(NHEP) = IDUP(I)
22950 CALL HWUIDT(1,IDUP(I),IDHW(NHEP),DUMMY)
22951 CALL HWULOF(PUP(1,IDRES(2,JRES)),PUP(1,I),PHEP(1,NHEP))
22952 CALL HWULOB(PHEP(1,IDRES(1,JRES)),PHEP(1,NHEP),PHEP(1,NHEP))
22954 IDRES(1,IRES) = NHEP
22956 JMOHEP(1,NHEP) = IDRES(1,JRES)
22963 C--special for top decays to ensure b is second and W is first, this seems
22964 C--to cause problems if the order is the other way around
22965 IF(ABS(IDHEP(IDRES(1,JRES))).EQ.6.AND.
22966 & NHEP-IDRES(1,JRES).EQ.2) THEN
22967 IF(ABS(IDHEP(NHEP-1)).EQ.5) THEN
22969 CALL HWVEQU(5,PHEP(1,NHEP),PTEMP)
22970 CALL HWVEQU(5,PHEP(1,NHEP-1),PHEP(1,NHEP))
22971 CALL HWVEQU(5,PTEMP,PHEP(1,NHEP-1))
22974 IDHW(NHEP) = IDHW(NHEP-1)
22977 IDHEP(NHEP) = IDHEP(NHEP-1)
22981 ILOC(NHEP) = ILOC(NHEP-1)
22983 JLOC(ILOC(NHEP-1)) = NHEP-1
22984 JLOC(ILOC(NHEP)) = NHEP
22987 IF(IDRES(1,I).EQ.NHEP) IDRES(1,I) = NHEP-1
22991 DO IHEP=IDRES(1,JRES)+2,NHEP
22994 JDAHEP(2,IDRES(1,JRES)) = NHEP
22995 ISTART = IDRES(1,JRES)
22996 EMSCA = PHEP(4,IDRES(1,JRES))
22997 CALL HWBGUP(ISTART,0)
22998 IF(JRES.NE.IRES) THEN
23004 *CMZ :- -18/05/99 14.55.44 by Kosuke Odagiri
23005 *-- Author : Bryan Webber
23006 C-----------------------------------------------------------------------
23008 C-----------------------------------------------------------------------
23009 C QCD HEAVY FLAVOUR PRODUCTION: MEAN EVWGT = SIGMA IN NB
23010 C-----------------------------------------------------------------------
23011 INCLUDE 'HERWIG65.INC'
23012 DOUBLE PRECISION HWRGEN,HWRUNI,HWUALF,EPS,RCS,Z1,Z2,ET,EJ,
23013 & QM2,QPE,FACTR,S,T,U,ST,TU,US,TUS,UST,EN,RN,AF,ASTU,
23014 & AUST,CF,CN,CS,CSTU,CSUT,CTSU,CTUS,HCS,UT,SU,GT,DIST,KK,KK2,
23015 & YJ1INF,YJ1SUP,YJ2INF,YJ2SUP
23016 INTEGER IQ1,IQ2,ID1,ID2
23018 EXTERNAL HWRGEN,HWRUNI,HWUALF
23019 SAVE HCS,ASTU,AUST,CSTU,CSUT,CTSU,CTUS,S,T,TU,U,US
23020 PARAMETER (EPS=1.D-9)
23028 IF (KK.GE.ONE) RETURN
23029 YJ1INF = MAX( YJMIN, LOG((ONE-SQRT(ONE-KK2))/KK) )
23030 YJ1SUP = MIN( YJMAX, LOG((ONE+SQRT(ONE-KK2))/KK) )
23031 IF (YJ1INF.GE.YJ1SUP) RETURN
23032 Z1=EXP(HWRUNI(1,YJ1INF,YJ1SUP))
23033 YJ2INF = MAX( YJMIN, -LOG(TWO/KK-ONE/Z1) )
23034 YJ2SUP = MIN( YJMAX, LOG(TWO/KK-Z1) )
23035 IF (YJ2INF.GE.YJ2SUP) RETURN
23036 Z2=EXP(HWRUNI(2,YJ2INF,YJ2SUP))
23037 XX(1)=HALF*(Z1+Z2)*KK
23038 IF (XX(1).GE.ONE) RETURN
23039 XX(2)=XX(1)/(Z1*Z2)
23040 IF (XX(2).GE.ONE) RETURN
23041 S=XX(1)*XX(2)*PHEP(5,3)**2
23045 IF (QPE.LE.ZERO) RETURN
23046 COSTH=HALF*ET*(Z1-Z2)/SQRT(Z1*Z2*QPE)
23047 IF (ABS(COSTH).GT.ONE) RETURN
23048 C---REDEFINE S, T, U AS P1.P2, -P1.P3, -P1.P4
23050 T=-HALF*(1.+Z2/Z1)*(HALF*ET)**2
23052 C---SET EMSCA TO HEAVY HARD PROCESS SCALE
23053 EMSCA=SQRT(4.*S*T*U/(S*S+T*T+U*U))
23054 FACTR = GEV2NB*.125*PIFAC*EJ*ET*(HWUALF(1,EMSCA)/S)**2
23055 & *(YJ1SUP-YJ1INF)*(YJ2SUP-YJ2INF)
23056 CALL HWSGEN(.FALSE.)
23069 ASTU=AF*(1.-2.*UST+QM2/T)
23070 AUST=AF*(1.-2.*TUS+QM2/S)
23071 CF=FACTR/(2.*CFFAC)
23073 C-----------------------------------------------------------------------
23074 C---Heavy flavour colour decomposition modifications below (KO)
23075 C-----------------------------------------------------------------------
23076 CS=(TU+UT-CN/TUS)*(HALF-TUS+QM2/S-QM2**2/U/T/TWO)
23077 CSTU=CF*CS/(ONE+TU**2)
23078 CSUT=CF*CS/(ONE+UT**2)
23079 CS=(SU+US-CN/UST)*(HALF-UST+QM2/T-QM2**2/U/S/TWO)
23080 CTSU=-FACTR*CS/(ONE+SU**2)
23081 CTUS=-FACTR*CS/(ONE+US**2)
23082 C-----------------------------------------------------------------------
23083 C CS=HALF/TU-QM2/T-HALF*(QM2/T)**2
23084 C CSTU=CF*(CS- US**2-QM2/S - CN*(CS+QM2*QM2/(S*T)))
23085 C CS=HALF*TU-QM2/U-HALF*(QM2/U)**2
23086 C CSUT=CF*(CS-1./ST**2-QM2/S - CN*(CS+QM2*QM2/(S*U)))
23087 C CS=HALF*US-QM2/S-HALF*(QM2/S)**2
23088 C CTSU=-FACTR*(CS-1./TU**2-QM2/T - CN*(CS+QM2*QM2/(S*T)))
23089 C CS=HALF/US-QM2/U-HALF*(QM2/U)**2
23090 C CTUS=-FACTR*(CS- ST**2-QM2/T - CN*(CS+QM2*QM2/(T*U)))
23091 C-----------------------------------------------------------------------
23097 IF (DISF(ID1,1).LT.EPS) GOTO 6
23098 HQ1=ID1.EQ.IQ1.OR.ID1.EQ.IQ2
23100 IF (DISF(ID2,2).LT.EPS) GOTO 5
23101 HQ2=ID2.EQ.IQ1.OR.ID2.EQ.IQ2
23102 DIST=DISF(ID1,1)*DISF(ID2,2)
23103 IF (HQ1.OR.HQ2) THEN
23104 C---PROCESSES INVOLVING HEAVY CONSTITUENT
23105 C N.B. NEGLECT CASE THAT BOTH ARE HEAVY
23106 IF (HQ1.AND.HQ2) GOTO 5
23111 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3421, 3,*9)
23112 ELSEIF (ID2.NE.13) THEN
23114 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3142, 9,*9)
23117 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3142,10,*9)
23119 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3421,11,*9)
23121 ELSEIF (ID1.NE.13) THEN
23125 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,2413,17,*9)
23126 ELSEIF (ID2.NE.13) THEN
23128 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,4312,20,*9)
23131 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,2413,21,*9)
23133 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,4312,22,*9)
23139 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,2413,23,*9)
23141 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3421,24,*9)
23142 ELSEIF (ID2.LT.13) THEN
23144 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3142,25,*9)
23146 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,4312,26,*9)
23149 ELSEIF (ID2.NE.13.AND.ID2.EQ.ID1+6) THEN
23150 C---LIGHT Q-QBAR ANNIHILATION
23152 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(IQ1,IQ2,2413, 4,*9)
23153 ELSEIF (ID1.NE.13.AND.ID1.EQ.ID2+6) THEN
23154 C---LIGHT QBAR-Q ANNIHILATION
23156 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(IQ2,IQ1,3142,12,*9)
23157 ELSEIF (ID1.EQ.13.AND.ID2.EQ.13) THEN
23160 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(IQ1,IQ2,2413,27,*9)
23162 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(IQ1,IQ2,4123,28,*9)
23172 CALL HWETWO(.TRUE.,.TRUE.)
23174 C Calculate coefficients for constructing spin density matrices
23175 IF (IHPRO.EQ.7 .OR.IHPRO.EQ.8 .OR.
23176 & IHPRO.EQ.15.OR.IHPRO.EQ.16) THEN
23177 C qqbar-->gg or qbarq-->gg
23186 ELSEIF (IHPRO.EQ.10.OR.IHPRO.EQ.11.OR.
23187 & IHPRO.EQ.21.OR.IHPRO.EQ.22.OR.
23188 & IHPRO.EQ.23.OR.IHPRO.EQ.24.OR.
23189 & IHPRO.EQ.25.OR.IHPRO.EQ.26) THEN
23190 C qg-->qg or qbarg-->qbarg or gq-->gq or gqbar-->gqbar
23199 ELSEIF (IHPRO.EQ.27.OR.IHPRO.EQ.28) THEN
23209 ELSEIF (IHPRO.EQ.29.OR.IHPRO.EQ.30.OR.
23210 & IHPRO.EQ.31) THEN
23213 GCOEF(2)=2.*U*U*T*T
23214 GCOEF(3)=2.*S*S*U*U
23215 GCOEF(4)=2.*S*S*T*T
23216 GCOEF(1)=GT*GT-GCOEF(2)-GCOEF(3)-GCOEF(4)
23217 GCOEF(5)=GT*(GT-2.*S*S)-GCOEF(2)
23218 GCOEF(6)=GT*(GT-2.*T*T)-GCOEF(3)
23219 GCOEF(7)=GT*(GT-2.*U*U)-GCOEF(4)
23221 CALL HWVZRO(7,GCOEF)
23226 *CMZ :- -26/11/00 17.21.55 by Bryan Webber
23227 *-- Author : Kosuke Odagiri & Stefano Moretti
23228 C-----------------------------------------------------------------------
23229 C...Generate completely differential cross section (EVWGT) in the variables
23230 C...X(I) with I=1,3 (see below) for the processes IPROC=3410,3420,3430,3450
23231 C...as described in the HERWIG 6 documentation file.
23232 C...It includes interface to PDFs and takes into account color connections
23235 C...First release: 6-AUG-1999 by Kosuke Odagiri
23236 C...Last modified: 6-SEP-1999 by Stefano Moretti
23238 C-----------------------------------------------------------------------
23240 C-----------------------------------------------------------------------
23241 C HIGGS + HEAVY QUARK (BOTTOM & TOP) PRODUCTION (2HDM)
23242 C-----------------------------------------------------------------------
23243 INCLUDE 'HERWIG65.INC'
23244 DOUBLE PRECISION HWRGEN, HWUALF, HWUAEM, EPS, HCS, RCS,
23245 & DIST, SM, DM, QPE, PF, SQPE, EMSC2, FACTR, S, T3, U4,
23246 & SN2TH, ME2(0:4), MW, XWEIN, PT2MIN, PT2, GQH(0:4), G1, RMMIN,
23247 & EMG, EMQ, EMH, EMG2, EMQ2, EMH2, EMHWT, ECM_MAX, X(3), XL(3),
23248 & XU(3), WEIGHT, ECM, SHAT, TAU, T, TL, TLMIN, TLMAX, TTMIN, TTMAX,
23249 & CTMP, PCM, PCM2, RCM, RCM2, FKLN
23250 INTEGER ID1, ID2, IH, IQ, I
23251 EXTERNAL HWRGEN, HWUALF, HWUAEM
23252 SAVE HCS,ME2,S,SHAT
23253 PARAMETER (EPS = 1.D-9)
23254 EQUIVALENCE (MW, RMASS(198))
23255 PARAMETER (EMG=0.,EMG2=0.)
23256 C...generate event.
23258 RCS = HCS*HWRGEN(0)
23262 C...minimum transverse momentum.
23265 C...accompanying quark.
23267 IF(IHIGGS.GE.5)IQ=6
23270 C...on-shell Higgs.
23271 EMH=RMASS(201+IHIGGS)
23275 C...energy at hadron level.
23276 ECM_MAX=PBEAM1+PBEAM2
23278 C...phase space variables.
23279 C...IF IQ=5 -> X(1)=(LOG(|T|)-LOG(|TMIN|))/(LOG(|TMAX|)-LOG(|TMIN|),
23280 C...IF IQ=6 -> X(1)=COS(THETA_CM);
23281 C...X(2)=(1./SHAT-1./ECM_MAX**2)/(1./(EMQ+EMH)**2-1./ECM_MAX**2),
23282 C...X(3)=(LOG(TAU)-LOG(X1))/LOG(TAU),
23283 C...phase space borders.
23284 IF(IQ.EQ.5)XL(1)=0.
23285 IF(IQ.EQ.6)XL(1)=-1.
23291 C...single phase space point.
23295 X(I)=XL(I)+(XU(I)-XL(I))*HWRGEN(0)
23296 WEIGHT=WEIGHT*ABS(XU(I)-XL(I))
23298 C...energy at parton level.
23299 ECM=SQRT(1./(X(2)*(1./(EMQ+EMH)**2-1./ECM_MAX**2)
23301 IF((EMH.LE.0.).OR.(EMH.GE.ECM))RETURN
23304 C...momentum fractions X1 and X2.
23305 XX(1)=EXP(LOG(TAU)*(1.-X(3)))
23307 C...reconstruct polar angle.
23309 PCM2=((SHAT-EMQ2-EMG2)**2
23310 & -(2.*EMQ*EMG)**2)/(4.*SHAT)
23312 RCM2=((SHAT-EMQ2-EMH2)**2
23313 & -(2.*EMQ*EMH)**2)/(4.*SHAT)
23315 FKLN=SQRT((SHAT-(EMQ+EMG)**2)*(SHAT-(EMQ-EMG)**2))
23316 & *SQRT((SHAT-(EMQ+EMH)**2)*(SHAT-(EMQ-EMH)**2))
23317 TTMAX=EMG2+EMQ2-0.5D0/ECM/ECM
23318 & *((SHAT+EMG2-EMQ2)*(SHAT+EMQ2-EMH2)
23320 TTMIN=EMG2+EMQ2-0.5D0/ECM/ECM
23321 & *((SHAT+EMG2-EMQ2)*(SHAT+EMQ2-EMH2)
23323 TLMAX=LOG(ABS(TTMIN))
23324 TLMIN=LOG(ABS(TTMAX))
23325 TL=X(1)*(TLMAX-TLMIN)+TLMIN
23328 & +2.*SQRT(PCM2+EMG2)*SQRT(RCM2+EMQ2)
23329 COSTH = CTMP/2./PCM/RCM
23330 ELSE IF(IQ.EQ.6)THEN
23333 SN2TH = 0.25D0 - 0.25D0*COSTH**2
23334 IF((0.25D0-RMMIN**2/SHAT).LT.0.)THEN
23338 T3 = ( SQRT(0.25D0-RMMIN**2/SHAT) * COSTH - HALF ) * SHAT
23340 EMSC2 = TWO*SHAT*T3*U4/(SHAT**2+T3**2+U4**2)
23341 EMSCA = SQRT( EMSC2 )
23342 CALL HWSGEN(.FALSE.)
23344 XWEIN = TWO * SWEIN
23345 FACTR = GEV2NB*PIFAC*HWUAEM(EMSC2)/XWEIN/SHAT
23346 & *HWUALF(1,EMSCA)/TWO/CAFAC/2.
23347 C...Jacobians from COSTH to X(1).
23349 FACTR=FACTR*(TLMAX-TLMIN)/2./PCM/RCM*T
23353 C...Jacobians from X1,X2 to X(2),X(3).
23354 FACTR=FACTR/S*(-LOG(TAU))*(1./(EMQ+EMH)**2-1./ECM_MAX**2)
23355 C...CKM mixing top/bottom quark.
23356 c bug fix 20/05/01 SM.
23357 IF(IQ.EQ.6)FACTR=FACTR*VCKM(3,3)
23359 C...Higgs resonance.
23361 C...constant weight.
23363 C...SM/MSSM couplings.
23364 IF (IHIGGS.EQ.0) THEN
23365 GQH(0)=(RMASS(5)/MW)**2/TWO
23367 G1 = (RMASS(5)/MW/COSB)**2/TWO
23368 GQH(1) = G1*SINA**2
23369 GQH(2) = G1*COSA**2
23370 GQH(3) = G1*SINB**2
23371 GQH(4) = GQH(3)+(RMASS(6)/MW/TANB)**2/TWO
23373 C...Matrix elements.
23382 IF(IHIGGS.NE.0)IH=IHIGGS-1
23383 IF (IH.EQ.4) ID1 = 6
23385 SM = RMASS(ID1)+RMASS(ID2)
23387 IF (QPE.GT.ZERO) THEN
23388 DM = RMASS(ID1)-RMASS(ID2)
23389 QPE = QPE*(SHAT-DM**2)/SHAT
23392 IF (PT2.GT.PT2MIN) THEN
23393 SQPE = SQRT(QPE*SHAT)
23395 T3 = (SQPE*COSTH - SHAT - SM*DM) / TWO
23397 ME2(IH) = FACTR*PF * GQH(IH) *
23398 & U4/SHAT/T3*(-U4+TWO*SM*DM/T3/U4*SHAT*PT2)
23408 IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN
23409 DIST = DISF(ID1,1)*DISF(ID2,2)*S*SHAT
23411 HCS = HCS + DIST*ME2(IH)
23412 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(5,IHIGGS+201,2314,1,*9)
23414 HCS = HCS + DIST*ME2(4)
23415 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(6,207,2314,1,*9)
23421 IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN
23422 DIST = DISF(ID1,1)*DISF(ID2,2)*S*SHAT
23424 HCS = HCS + DIST*ME2(IH)
23425 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(11,IHIGGS+201,3124,1,*9)
23427 HCS = HCS + DIST*ME2(4)
23428 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(12,206,3124,1,*9)
23434 IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN
23435 DIST = DISF(ID1,1)*DISF(ID2,2)*S*SHAT
23437 HCS = HCS + DIST*ME2(IH)
23438 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(IHIGGS+201,5,4132,1,*9)
23440 HCS = HCS + DIST*ME2(4)
23441 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(207,6,4132,1,*9)
23447 IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN
23448 DIST = DISF(ID1,1)*DISF(ID2,2)*S*SHAT
23450 HCS = HCS + DIST*ME2(IH)
23451 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(IHIGGS+201,11,2431,1,*9)
23453 HCS = HCS + DIST*ME2(4)
23454 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(206,12,2431,1,*9)
23462 CALL HWETWO(.TRUE.,.TRUE.)
23464 C Calculate coefficients for constructing spin density matrices
23465 C Set to zero for now
23466 CALL HWVZRO(7,GCOEF)
23470 *CMZ :- -26/11/00 17.21.55 by Bryan Webber
23471 *-- Author : Stefano Moretti
23472 C-----------------------------------------------------------------------
23473 C...Generate completely differential cross section (EVWGT) in the variables
23474 C...X(I) with I=1,4 (see below) for the process IPROC=3350, as described
23475 C...in the HERWIG 6 documentation file.
23476 C...It includes interface to PDFs and takes into account color connections
23479 C...First release: 8-APR-1999 by Stefano Moretti
23482 C-----------------------------------------------------------------------
23483 C ASSOCIATE PRODUCTION W+H- FROM QUARK FUSION (2HDM)
23484 C-----------------------------------------------------------------------
23485 INCLUDE 'HERWIG65.INC'
23487 DOUBLE PRECISION EMH,EMHWT,RMW,EMW
23488 DOUBLE PRECISION RMH01,RMH02,RMH03,RMH
23489 DOUBLE PRECISION X(4),XL(4),XU(4)
23490 DOUBLE PRECISION CT,ST
23491 DOUBLE PRECISION P1(0:3),P2(0:3),P3(0:3),P4(0:3)
23492 DOUBLE PRECISION ECM_MAX,ECM,SHAT,S,TAU
23493 DOUBLE PRECISION EMIN,PCM2,PCM,RCM2,RCM
23494 DOUBLE PRECISION M2,M2L,M2T
23495 DOUBLE PRECISION ALPHA,EMSC2
23496 DOUBLE PRECISION HWRGEN,HWUAEM
23497 DOUBLE PRECISION RNMIN,RNMAX,THETA_MIN,THETA_MAX
23498 DOUBLE PRECISION EPS,HCS,RCS,FACT,DIST
23499 DOUBLE PRECISION WEIGHT
23500 DOUBLE PRECISION VSAVE
23501 SAVE EMH,EMW,HCS,M2,M2L,M2T,FACT,S,CT
23503 EXTERNAL HWHIGM,HWRGEN,HWUAEM,HWH2BK,HWETWO,HWRLOG
23504 PARAMETER (EPS=1.D-9)
23505 EQUIVALENCE (RMW ,RMASS(198))
23506 EQUIVALENCE (RMH01,RMASS(204)),
23507 & (RMH02,RMASS(203)),
23508 & (RMH03,RMASS(205)),
23509 & (RMH ,RMASS(206))
23515 C...assign final state masses.
23518 C...energy at hadron level.
23519 ECM_MAX=PBEAM1+PBEAM2
23521 C...phase space variables.
23522 C...X(1)=COS(THETA_CM),
23523 C...X(2)=(1./SHAT-1./ECM_MAX**2)/(1./(EMW+EMH)**2-1./ECM_MAX**2),
23524 C...X(3)=(LOG(TAU)-LOG(X1))/LOG(TAU),
23525 C...X(4)=(THETA-THETA_MIN)/(THETA_MAX-THETA_MIN),
23526 C...where THETA=ATAN((EMW*EMW-RMW*RMW)/RMW/GAMW);
23527 C...phase space borders.
23536 C...single phase space point.
23540 X(I)=XL(I)+(XU(I)-XL(I))*HWRGEN(0)
23541 WEIGHT=WEIGHT*ABS(XU(I)-XL(I))
23543 C...resonant boson mass (limits to -10*W-widths to improve efficiency).
23544 RNMIN=RMW-GAMMAX*GAMW
23545 THETA_MIN=ATAN((RNMIN*RNMIN-RMW*RMW)/RMW/GAMW)
23547 THETA_MAX=ATAN((RNMAX*RNMAX-RMW*RMW)/RMW/GAMW)
23548 EMW=SQRT((TAN(X(4)*(THETA_MAX-THETA_MIN)+THETA_MIN))
23549 & *RMW*GAMW+RMW*RMW)
23550 C...energy at parton level.
23551 ECM=SQRT(1./(X(2)*(1./(EMW+EMH)**2-1./ECM_MAX**2)
23553 IF((EMH.LE.0.).OR.(EMH.GE.ECM))RETURN
23556 C...momentum fractions X1 and X2.
23557 XX(1)=EXP(LOG(TAU)*(1.-X(3)))
23559 C...two particle kinematics.
23561 IF(HWRLOG(HALF))THEN
23566 RCM2=((SHAT-EMW*EMW-EMH*EMH)**2
23567 & -(2.*EMW*EMH)**2)/(4.*SHAT)
23569 P3(0)=SQRT(RCM2+EMW*EMW)
23573 P4(0)=SQRT(RCM2+EMH*EMH)
23577 C...incoming parton: massless.
23579 C...initial state momenta in the partonic CM.
23580 PCM2=((SHAT-EMIN*EMIN-EMIN*EMIN)**2
23581 & -(2.*EMIN*EMIN)**2)/(4.*SHAT)
23583 P1(0)=SQRT(PCM2+EMIN*EMIN)
23587 P2(0)=SQRT(PCM2+EMIN*EMIN)
23591 C...color structured ME summed/averaged over final/initial spins and colors.
23592 CALL HWH2BK(P1,P2,P3,P4,EMW,EMH,M2,M2L,M2T)
23594 C...charge conjugation.
23598 C...constant factors: phi along beam and conversion GeV^2->nb.
23599 FACT=2.*PIFAC*GEV2NB
23600 C...Jacobians from X1,X2 to X(2),X(3)
23601 FACT=FACT/S*(-LOG(TAU))*(1./(EMW+EMH)**2-1./ECM_MAX**2)
23602 C...phase space Jacobians, pi's and flux.
23603 FACT=FACT/64./PIFAC/PIFAC*RCM/PCM
23608 ALPHA=HWUAEM(EMSC2)
23609 FACT=FACT*(PIFAC*ALPHA/SWEIN/RMW/RMW/SQRT(2.))**2
23610 C...Higgs resonance.
23612 C...vector boson resonance.
23613 FACT=FACT*(THETA_MAX-THETA_MIN)/PIFAC
23614 C...constant weight.
23619 CALL HWSGEN(.FALSE.)
23621 IF(DISF(I,1).LT.EPS)THEN
23626 IF(DISF(J,2).LT.EPS)THEN
23629 DIST=DISF(I,1)*DISF(J,2)*S
23630 C...no need to set up color connections.
23631 HCS=HCS+M2*DIST*FACT
23632 IF(GENEV.AND.HCS.GT.RCS)THEN
23633 C...generate event.
23636 IDN(3)=NINT(198.+HWRGEN(0))
23637 IF(IDN(3).EQ.198)IDN(4)=207
23638 IF(IDN(3).EQ.199)IDN(4)=206
23639 C...set up status and IDs: use HWETWO.
23646 C...trick HWETWO in using off-shell V mass
23647 VSAVE=RMASS(IDN(3))
23649 C-- BRW fix 27/8/04: avoid double smearing of V mass
23650 CALL HWETWO(.FALSE.,.TRUE.)
23651 RMASS(IDN(3))=VSAVE
23653 C...set to zero the coefficients of the spin density matrices.
23654 CALL HWVZRO(7,GCOEF)
23656 C...calculates approximately polarized decay matrix of gauge boson.
23657 IF(IERROR.NE.0)RETURN
23659 IF(ICHRG(I)*ICHRG(IDN(3)).LT.0.D0)IHEL=1
23660 IF(M2L.LT.0.)M2L=0.
23661 IF(M2T.LT.0.)M2T=0.
23662 RHOHEP(2,NHEP-1)=M2L/M2
23663 RHOHEP(1,NHEP-1)=M2T/M2*(1-IHEL)
23664 RHOHEP(3,NHEP-1)=M2T/M2*( IHEL)
23673 *CMZ :- -23/08/94 13.22.29 by Mike Seymour
23674 *-- Author : Ulrich Baur & Nigel Glover, adapted by Ian Knowles
23675 C-----------------------------------------------------------------------
23676 FUNCTION HWHIG1(S,T,U,EH2,EQ2,I,J,K,I1,J1,K1)
23677 C-----------------------------------------------------------------------
23678 C Basic matrix elements for Higgs + jet production; used in HWHIGA
23679 C-----------------------------------------------------------------------
23681 DOUBLE COMPLEX HWHIG1,HWHIG2,HWHIG5,BI(4),CI(7),DI(3)
23682 DOUBLE PRECISION S,T,U,EH2,EQ2,S1,T1,U1,ONE,TWO,FOUR,HALF
23683 INTEGER I,J,K,I1,J1,K1
23684 COMMON/CINTS/BI,CI,DI
23685 PARAMETER (ONE =1.D0, TWO =2.D0, FOUR =4.D0, HALF =0.5D0)
23686 C-----------------------------------------------------------------------
23687 C +++ helicity amplitude for: g+g --> g+H
23688 C-----------------------------------------------------------------------
23692 HWHIG1=EQ2*FOUR*DSQRT(TWO*S*T*U)*(
23693 & -FOUR*(ONE/(U*T)+ONE/(U*U1)+ONE/(T*T1))
23694 & -FOUR*((TWO*S+T)*BI(K)/U1**2+(TWO*S+U)*BI(J)/T1**2)/S
23695 & -(S-FOUR*EQ2)*(S1*CI(I1)+(U-S)*CI(J1)+(T-S)*CI(K1))/(S*T*U)
23696 & -8.D0*EQ2*(CI(J1)/(T*T1)+CI(K1)/(U*U1))
23697 & +HALF*(S-FOUR*EQ2)*(S*T*DI(K)+U*S*DI(J)-U*T*DI(I))/(S*T*U)
23698 & +FOUR*EQ2*DI(I)/S
23699 & -TWO*(U*CI(K)+T*CI(J)+U1*CI(K1)+T1*CI(J1)-U*T*DI(I))/S**2 )
23701 C-----------------------------------------------------------------------
23702 ENTRY HWHIG2(S,T,U,EH2,EQ2,I,J,K,I1,J1,K1)
23703 C-----------------------------------------------------------------------
23704 C ++- helicity amplitude for: g+g --> g+H
23705 C-----------------------------------------------------------------------
23709 HWHIG2=EQ2*FOUR*DSQRT(TWO*S*T*U)*(FOUR*EH2
23710 & +(EH2-FOUR*EQ2)*(S1*CI(4)+T1*CI(5)+U1*CI(6))
23711 & -HALF*(EH2-FOUR*EQ2)*(S*T*DI(3)+U*S*DI(2)+U*T*DI(1)) )/(S*T*U)
23713 C-----------------------------------------------------------------------
23714 ENTRY HWHIG5(S,T,U,EH2,EQ2,I,J,K,I1,J1,K1)
23715 C-----------------------------------------------------------------------
23716 C Amplitude for: q+qbar --> g+H
23717 C-----------------------------------------------------------------------
23718 HWHIG5=DCMPLX(TWO)+DCMPLX(TWO*S/(S-EH2))*BI(I)
23719 & +DCMPLX(FOUR*EQ2-U-T)*CI(K)
23723 *CMZ :- -30/06/01 18.40.33 by Stefano Moretti
23724 *-- Author : Stefano Moretti
23725 C-----------------------------------------------------------------------
23726 C...Generate completely differential cross section (EVWGT) in the variables
23727 C...X(I) with I=1,6 (see below) for the process IPROC=3500, as described
23728 C...in the HERWIG 6 documentation file.
23729 C...It includes interface to PDFs and takes into account color connections
23732 C...First release: 12-APR-2000 by Stefano Moretti
23734 C-----------------------------------------------------------------------
23736 C-----------------------------------------------------------------------
23737 C PRODUCTION OF MSSM CHARGED HIGGSES FROM B-QUARK+LIGHT-QUARK FUSION
23738 C-----------------------------------------------------------------------
23739 INCLUDE 'HERWIG65.INC'
23740 INTEGER I,J,K,L,M,N
23743 DOUBLE PRECISION EMQ,ENQ,EMQH,EMB,EMH,EMHWT,EMT,EMW
23744 DOUBLE PRECISION EMH01,EMH02,EMH03
23745 DOUBLE PRECISION WCKM,CKM,GAMT
23746 DOUBLE PRECISION X(6),XL(6),XU(6)
23747 DOUBLE PRECISION Q3(0:3),Q35(0:3)
23748 DOUBLE PRECISION Q1(5),Q2(5),H(5)
23749 DOUBLE PRECISION CT4,ST4,CT3,ST3,CF3,SF3,RQ42,RQ4,RQ32,RQ3,PQ3
23750 DOUBLE PRECISION P1(0:3),P2(0:3),P3(0:3),P4(0:3),P5(0:3)
23751 DOUBLE PRECISION ECM_MAX,ECM,SHAT,S,TAU
23752 DOUBLE PRECISION XTMP
23753 DOUBLE PRECISION EMIN1,EMIN2,PCM2,PCM
23754 DOUBLE PRECISION M2B,M2BBAR
23755 DOUBLE PRECISION ALPHA,EMSC2
23756 DOUBLE PRECISION HWRGEN,HWUAEM
23757 DOUBLE PRECISION PHI,CPHI,SPHI,ROT(3,3)
23758 DOUBLE PRECISION QAUX(0:3)
23759 DOUBLE PRECISION EPS,HCS,RCS,FACT,DIST
23760 DOUBLE PRECISION WEIGHT
23761 SAVE HCS,M2B,M2BBAR,FACT,S,WCKM,P3,P4,P5
23763 EXTERNAL HWRGEN,HWUAEM,HWH2BH,HWEONE,HWRLOG,
23765 EQUIVALENCE (EMB,RMASS(5)),(EMT,RMASS(6))
23766 EQUIVALENCE (EMW,RMASS(198))
23767 EQUIVALENCE (EMH01,RMASS(204)),
23768 & (EMH02,RMASS(203)),
23769 & (EMH03,RMASS(205))
23770 EQUIVALENCE (CKM,VCKM(3,3))
23771 PARAMETER (EPS=1.D-9)
23777 C...assign final state masses.
23782 C...assign top width.
23784 C...energy at hadron level.
23785 ECM_MAX=PBEAM1+PBEAM2
23787 C...phase space variables.
23788 C...X(1)=(EMQH-EMQ-EMH)/(ECM-EMQ-ENQ-EMH),
23789 C...X(2)=1/[-(P2-P3)^2+MW^2],X(3)=COS(THETA4_CM_35),X(4)=FI4_CM_35,
23790 C...X(5)=(1./SHAT-1./ECM_MAX**2)/(1./(EMQ+ENQ+EMH)**2-1./ECM_MAX**2),
23791 C...X(6)=(LOG(TAU)-LOG(X1))/LOG(TAU);
23792 C...phase space borders.
23795 c...for XL(2),XU(2) see below (non constant).
23804 C...single phase space point.
23809 X(I)=XL(I)+(XU(I)-XL(I))*HWRGEN(0)
23810 WEIGHT=WEIGHT*ABS(XU(I)-XL(I))
23813 C...energy at parton level.
23814 ECM=SQRT(1./(X(5)*(1./(EMQ+ENQ+EMH)**2-1./ECM_MAX**2)
23816 IF((EMH.LE.0.).OR.(EMH.GE.ECM))RETURN
23819 C...momentum fractions X1 and X2.
23820 XX(1)=EXP(LOG(TAU)*(1.-X(6)))
23822 C...incoming partons massless.
23825 C...initial state momenta in the partonic CM.
23826 PCM2=((SHAT-EMIN1*EMIN1-EMIN2*EMIN2)**2
23827 & -(2.*EMIN1*EMIN2)**2)/(4.*SHAT)
23829 C...three particle kinematics.
23830 EMQH=X(1)*(ECM-EMQ-ENQ-EMH)+EMQ+EMH
23831 RQ42=((ECM*ECM-ENQ*ENQ-EMQH*EMQH)**2-(2.*ENQ*EMQH)**2)/
23838 C...X(2): integrate over W propagator.
23839 XL(2)=1./(4.*SQRT(PCM2+EMIN2*EMIN2)*RQ4+EMW*EMW)
23841 X(2)=XL(2)+(XU(2)-XL(2))*HWRGEN(0)
23842 WEIGHT=WEIGHT*ABS(XU(2)-XL(2))
23844 XTMP=(XTMP-EMW*EMW)/2./SQRT(PCM2+EMIN2*EMIN2)
23845 CT4=1.-XTMP/((SHAT-EMQH*EMQH+2.*ENQ*ENQ)/(2.*ECM))
23846 IF(CT4.GT.+1.)CT4=+1.
23847 IF(CT4.LT.-1.)CT4=-1.
23848 IF(HWRLOG(HALF))THEN
23849 ST4=+SQRT(1.-CT4*CT4)
23851 ST4=-SQRT(1.-CT4*CT4)
23854 ST3=SQRT(1.-CT3*CT3)
23860 P4(0)=SQRT(RQ42+ENQ*ENQ)
23864 Q35(0)=SQRT(RQ42+EMQH*EMQH)
23865 RQ32=((EMQH*EMQH-EMH*EMH-EMQ*EMQ)**2-(2.*EMH*EMQ)**2)/
23875 Q3(0)=SQRT(RQ32+EMQ*EMQ)
23878 PQ3=PQ3+Q35(I)*Q3(I)
23880 P3(0)=(Q35(0)*Q3(0)+PQ3)/EMQH
23883 P3(I)=Q3(I)+Q35(I)*(P3(0)+Q3(0))/(Q35(0)+EMQH)
23887 P1(0)=SQRT(PCM2+EMIN1*EMIN1)
23891 P2(0)=SQRT(PCM2+EMIN2*EMIN2)
23895 C...option: top diagram removed if can be resonant to avoid double counting.
23897 C IF((EMT-EMB-EMH).GE.0.)IRES=0
23898 C...color structured ME summed/averaged over final/initial spins and colors.
23899 C...IFL=+1 selects b.
23901 CALL HWH2BH(P1,P2,P3,P4,P5,EMW,EMH,EMH01,EMH02,EMH03,EMB,EMT,
23902 & IFL,IRES,CKM,GAMT,M2B)
23903 C...IFL=-1 selects b-bar.
23905 CALL HWH2BH(P1,P2,P3,P4,P5,EMW,EMH,EMH01,EMH02,EMH03,EMB,EMT,
23906 & IFL,IRES,CKM,GAMT,M2BBAR)
23907 C...constant factors: phi along beam and conversion GeV^2->nb.
23908 FACT=2.*PIFAC*GEV2NB
23909 C...Jacobians from X1,X2 to X(5),X(6)
23910 FACT=FACT/S*(-LOG(TAU))*(1./(EMQ+ENQ+EMH)**2-1./ECM_MAX**2)
23911 C...phase space Jacobians, pi's and flux.
23912 FACT=FACT*RQ3*RQ4/PCM/32./(2.*PIFAC)**5
23913 & *(ECM-EMQ-ENQ-EMH)
23914 FACT=FACT/2./P2(0)/P4(0)
23915 FACT=FACT*(2.*P2(0)*P4(0)*(1.-CT4)+EMW*EMW)**2
23919 ALPHA=HWUAEM(EMSC2)
23920 FACT=FACT*64.*PIFAC**3*ALPHA**3/4./SWEIN/SWEIN/SWEIN/EMW/EMW
23921 C...Higgs resonance.
23923 C...constant weight.
23928 CALL HWSGEN(.FALSE.)
23930 IF(DISF(I,1).LT.EPS)THEN
23934 IF(DISF(J,2).LT.EPS)THEN
23937 IF((I.NE.5).AND.(I.NE.11).AND.
23938 & (J.NE.5).AND.(J.NE.11))THEN
23942 IF((I.NE.5).AND.(I.NE.11))II=I
23949 IF((ITMP.EQ.5).AND.(II.EQ.3).AND.(JJ.EQ.3))WCKM=0.
23950 DIST=DIST+DISF(I,1)*DISF(J,2)*WCKM*S
23952 IF((I.LE.6).AND.(J.LE.6))THEN
23953 HCS=HCS+M2B*DIST*FACT
23954 ELSE IF((I.LE.6).AND.(J.GE.7))THEN
23955 IF(J.NE.11)HCS=HCS+M2B*DIST*FACT
23956 IF(J.EQ.11)HCS=HCS+M2BBAR*DIST*FACT
23957 ELSE IF((I.GE.7).AND.(J.LE.6))THEN
23958 IF(I.NE.11)HCS=HCS+M2B*DIST*FACT
23959 IF(I.EQ.11)HCS=HCS+M2BBAR*DIST*FACT
23960 ELSE IF((I.GE.7).AND.(J.GE.7))THEN
23961 HCS=HCS+M2BBAR*DIST*FACT
23963 IF(GENEV.AND.HCS.GT.RCS)THEN
23964 C...generate event.
23967 IF((I.EQ.5).OR.(I.EQ.11))THEN
23978 IF(IDN(2).EQ.IDN(4))THEN
23980 & NINT(198.5-.1667*FLOAT(ICHRG(IDN(1))-ICHRG(IDN(3))))
23983 & NINT(198.5-.1667*FLOAT(ICHRG(IDN(2))-ICHRG(IDN(4))))
23986 C...sets up incoming status and IDs only for 2->1: use HWEONE.
23989 JDAHEP(1,NHEP)=NHEP+1
23990 JDAHEP(2,NHEP)=NHEP+3
23991 JMOHEP(1,NHEP+1)=NHEP
23992 JMOHEP(1,NHEP+2)=NHEP
23993 JMOHEP(1,NHEP+3)=NHEP
23994 C...randomly rotate final state momenta around beam axis.
23995 PHI=2.*PIFAC*HWRGEN(0)
24011 IF(L.EQ.1)QAUX(M)=QAUX(M)+ROT(M,N)*P3(N)
24012 IF(L.EQ.2)QAUX(M)=QAUX(M)+ROT(M,N)*P4(N)
24013 IF(L.EQ.3)QAUX(M)=QAUX(M)+ROT(M,N)*P5(N)
24017 IF(L.EQ.1)P3(M)=QAUX(M)
24018 IF(L.EQ.2)P4(M)=QAUX(M)
24019 IF(L.EQ.3)P5(M)=QAUX(M)
24022 C...outgoing momenta (give quark masses non covariantly!)
24031 Q1(5)=RMASS(IDN(3))
24032 Q1(4)=SQRT(Q1(4)**2+Q1(5)**2)
24033 Q2(5)=RMASS(IDN(4))
24034 Q2(4)=SQRT(Q2(4)**2+Q2(5)**2)
24035 H(4)=-Q1(4)-Q2(4)+PHEP(5,NHEP)
24037 CALL HWULOB(PHEP(1,NHEP),Q1,PHEP(1,NHEP+1))
24038 CALL HWULOB(PHEP(1,NHEP),Q2,PHEP(1,NHEP+2))
24039 CALL HWULOB(PHEP(1,NHEP),H ,PHEP(1,NHEP+3))
24040 C...sets up outgoing status and IDs.
24044 IDHW(NHEP+1)=IDN(3)
24045 IDHEP(NHEP+1)=IDPDG(IDN(3))
24046 IDHW(NHEP+2)=IDN(4)
24047 IDHEP(NHEP+2)=IDPDG(IDN(4))
24048 IDHW(NHEP+3)=IDN(5)
24049 IDHEP(NHEP+3)=IDPDG(IDN(5))
24050 C...sets up colour connections.
24051 JMOHEP(2,NHEP+1)=NHEP-2
24052 JMOHEP(2,NHEP+2)=NHEP-1
24053 JMOHEP(2,NHEP-1)=NHEP+2
24054 JMOHEP(2,NHEP-2)=NHEP+1
24055 JMOHEP(2,NHEP+3)=NHEP+3
24056 JDAHEP(2,NHEP+1)=NHEP-2
24057 JDAHEP(2,NHEP+2)=NHEP-1
24058 JDAHEP(2,NHEP-1)=NHEP+2
24059 JDAHEP(2,NHEP-2)=NHEP+1
24060 JDAHEP(2,NHEP+3)=NHEP+3
24063 C...set to zero the coefficients of the spin density matrices.
24064 CALL HWVZRO(7,GCOEF)
24077 *CMZ :- -23/08/94 13.22.29 by Mike Seymour
24078 *-- Author : Ulrich Baur & Nigel Glover, adapted by Ian Knowles
24079 C-----------------------------------------------------------------------
24080 SUBROUTINE HWHIGA(S,T,U,EMH2,WTQQ,WTQG,WTGQ,WTGG)
24081 C-----------------------------------------------------------------------
24082 C Gives amplitudes squared for q-qbar, q(bar)-g and gg -> Higgs +jet
24083 C IAPHIG (set in HWIGIN)=0: zero mass approximation =1: exact result
24084 C =2: infinite mass limit.
24085 C Only top loop included. A factor (alpha_s**3*alpha_W) is extracted
24086 C-----------------------------------------------------------------------
24087 INCLUDE 'HERWIG65.INC'
24088 DOUBLE COMPLEX HWHIGB,HWHIGC,HWHIGD,HWHIG5,HWHIG1,HWHIG2,BI(4),
24089 & CI(7),DI(3),EPSI,TAMP(7)
24090 DOUBLE PRECISION S,T,U,EMH2,WTQQ,WTQG,WTGQ,WTGG,EMW2,RNGLU,RNQRK,
24091 & FLUXGG,FLUXGQ,FLUXQQ,EMQ2,TAMPI(7),TAMPR(7)
24094 EXTERNAL HWHIGB,HWHIGC,HWHIGD,HWHIG5,HWHIG1,HWHIG2
24096 COMMON/CINTS/BI,CI,DI
24097 EPSI=DCMPLX(ZERO,-1.D-10)
24099 C Spin and colour flux factors plus enhancement factor
24100 RNGLU=1./FLOAT(NCOLO**2-1)
24101 RNQRK=1./FLOAT(NCOLO)
24102 FLUXGG=.25*RNGLU**2*ENHANC(6)**2
24103 FLUXGQ=.25*RNGLU*RNQRK*ENHANC(6)**2
24104 FLUXQQ=.25*RNQRK**2*ENHANC(6)**2
24105 IF (IAPHIG.EQ.2) THEN
24106 C Infinite mass limit in loops
24107 WTGG=(2./3.)**2*FLOAT(NCOLO*(NCOLO**2-1))
24108 & *(EMH2**4+S**4+T**4+U**4)/(S*T*U*EMW2)*FLUXGG
24109 WTQQ= 16./9.*(U**2+T**2)/(S*EMW2)*FLUXQQ
24110 WTQG=-16./9.*(U**2+S**2)/(T*EMW2)*FLUXGQ
24111 WTGQ=-16./9.*(S**2+T**2)/(U*EMW2)*FLUXGQ
24113 ELSEIF (IAPHIG.EQ.1) THEN
24114 C Exact result for loops
24116 ELSEIF (IAPHIG.EQ.0) THEN
24117 C Small mass approximation in loops
24120 CALL HWWARN('HWHIGA',500,*999)
24122 C Include only top quark contribution
24124 BI(1)=HWHIGB(NOMASS,S,ZERO,ZERO,EMQ2)
24125 BI(2)=HWHIGB(NOMASS,T,ZERO,ZERO,EMQ2)
24126 BI(3)=HWHIGB(NOMASS,U,ZERO,ZERO,EMQ2)
24127 BI(4)=HWHIGB(NOMASS,EMH2,ZERO,ZERO,EMQ2)
24131 CI(1)=HWHIGC(NOMASS,S,ZERO,ZERO,EMQ2)
24132 CI(2)=HWHIGC(NOMASS,T,ZERO,ZERO,EMQ2)
24133 CI(3)=HWHIGC(NOMASS,U,ZERO,ZERO,EMQ2)
24134 CI(7)=HWHIGC(NOMASS,EMH2,ZERO,ZERO,EMQ2)
24135 CI(4)=(S*CI(1)-EMH2*CI(7))/(S-EMH2)
24136 CI(5)=(T*CI(2)-EMH2*CI(7))/(T-EMH2)
24137 CI(6)=(U*CI(3)-EMH2*CI(7))/(U-EMH2)
24138 DI(1)=HWHIGD(NOMASS,U,T,EMH2,EMQ2)
24139 DI(2)=HWHIGD(NOMASS,S,U,EMH2,EMQ2)
24140 DI(3)=HWHIGD(NOMASS,S,T,EMH2,EMQ2)
24141 C Compute complex amplitudes
24142 TAMP(1)=HWHIG1(S,T,U,EMH2,EMQ2,1,2,3,4,5,6)
24143 TAMP(2)=HWHIG2(S,T,U,EMH2,EMQ2,1,2,3,0,0,0)
24144 TAMP(3)=HWHIG1(T,S,U,EMH2,EMQ2,2,1,3,5,4,6)
24145 TAMP(4)=HWHIG1(U,T,S,EMH2,EMQ2,3,2,1,6,5,4)
24146 TAMP(5)=HWHIG5(S,T,U,EMH2,EMQ2,1,0,4,0,0,0)
24147 TAMP(6)=HWHIG5(T,S,U,EMH2,EMQ2,2,0,5,0,0,0)
24148 TAMP(7)=HWHIG5(U,T,S,EMH2,EMQ2,3,0,6,0,0,0)
24150 TAMPI(I)= DREAL(TAMP(I))
24151 20 TAMPR(I)=-DIMAG(TAMP(I))
24152 C Square and add prefactors
24153 WTGG=0.03125*FLOAT(NCOLO*(NCOLO**2-1))/EMW2
24154 & *(TAMPR(1)**2+TAMPI(1)**2+TAMPR(2)**2+TAMPI(2)**2
24155 & +TAMPR(3)**2+TAMPI(3)**2+TAMPR(4)**2+TAMPI(4)**2)*FLUXGG
24156 WTQQ= 16.*(U**2+T**2)/(U+T)**2*EMQ2**2/(S*EMW2)
24157 & *(TAMPR(5)**2+TAMPI(5)**2)*FLUXQQ
24158 WTQG=-16.*(U**2+S**2)/(U+S)**2*EMQ2**2/(T*EMW2)
24159 & *(TAMPR(6)**2+TAMPI(6)**2)*FLUXGQ
24160 WTGQ=-16.*(S**2+T**2)/(S+T)**2*EMQ2**2/(U*EMW2)
24161 & *(TAMPR(7)**2+TAMPI(7)**2)*FLUXGQ
24165 *CMZ :- -23/08/94 13.22.29 by Mike Seymour
24166 *-- Author : Ulrich Baur & Nigel Glover, adapted by Ian Knowles
24167 C-----------------------------------------------------------------------
24168 FUNCTION HWHIGB(NOMASS,S,T,EH2,EQ2)
24169 C-----------------------------------------------------------------------
24170 C One loop scalar integrals, used in HWHIGJ.
24171 C If NOMASS=.TRUE. use a small mass approx. for particle in loop.
24172 C-----------------------------------------------------------------------
24173 INCLUDE 'HERWIG65.INC'
24174 DOUBLE COMPLEX HWHIGB,HWHIGC,HWHIGD,HWUCI2,HWULI2,EPSI,PII,Z1,Z2
24175 DOUBLE PRECISION S,T,EQ2,EH2,RAT,COSH,DLS,DLT,DLM,RZ12,DL1,DL2,
24178 EXTERNAL HWULI2,HWUCI2
24180 C-----------------------------------------------------------------------
24181 C B_0(2p1.p2=S;mq,mq)
24182 C-----------------------------------------------------------------------
24183 PII=DCMPLX(ZERO,PIFAC)
24186 HWHIGB=-DLOG(RAT)+TWO
24187 IF (S.GT.ZERO) HWHIGB=HWHIGB+PII
24190 IF (S.LT.ZERO) THEN
24191 HWHIGB=TWO-TWO*DSQRT(ONE-ONE/RAT)
24192 & *DLOG(DSQRT(-RAT)+DSQRT(ONE-RAT))
24193 ELSEIF (S.GT.ZERO.AND.RAT.LT.ONE) THEN
24194 HWHIGB=TWO-TWO*DSQRT(ONE/RAT-ONE)*DASIN(DSQRT(RAT))
24195 ELSEIF (RAT.GT.ONE) THEN
24196 HWHIGB=TWO-DSQRT(ONE-ONE/RAT)
24197 & *(TWO*DLOG(DSQRT(RAT)+DSQRT(RAT-ONE))-PII)
24201 C-----------------------------------------------------------------------
24202 ENTRY HWHIGC(NOMASS,S,T,EH2,EQ2)
24203 C-----------------------------------------------------------------------
24204 C C_0(p{1,2}^2=0,2p1.p2=S;mq,mq,mq)
24205 C-----------------------------------------------------------------------
24206 PII=DCMPLX(ZERO,PIFAC)
24209 HWHIGC=HALF*DLOG(RAT)**2
24210 IF (S.GT.ZERO) HWHIGC=HWHIGC-HALF*PIFAC**2-PII*DLOG(RAT)
24214 IF (S.LT.ZERO) THEN
24215 HWHIGC=TWO*DLOG(DSQRT(-RAT)+DSQRT(ONE-RAT))**2/S
24216 ELSEIF (S.GT.ZERO.AND.RAT.LT.ONE) THEN
24217 HWHIGC=-TWO*(DASIN(DSQRT(RAT)))**2/S
24218 ELSEIF (RAT.GT.ONE) THEN
24219 COSH=DLOG(DSQRT(RAT)+DSQRT(RAT-ONE))
24220 HWHIGC=TWO*(COSH**2-PIFAC**2/FOUR-PII*COSH)/S
24224 C-----------------------------------------------------------------------
24225 ENTRY HWHIGD(NOMASS,S,T,EH2,EQ2)
24226 C-----------------------------------------------------------------------
24227 C D_0(p{1,2,3}^2=0,p4^2=EH2,2p1.p2=S,2p2.p3=T;mq,mq,mq,mq)
24228 C-----------------------------------------------------------------------
24229 PII=DCMPLX(ZERO,PIFAC)
24231 DLS=DLOG(DABS(S/EQ2))
24232 DLT=DLOG(DABS(T/EQ2))
24233 DLM=DLOG(DABS(EH2/EQ2))
24234 IF (S.GE.ZERO.AND.T.LE.ZERO) THEN
24235 DL1=DLOG((EH2-T)/S)
24238 HWHIGD=DLS**2+DLT**2-DLM**2+DL1**2
24239 & +TWO*(DLOG(S/(EH2-T))*DLOG(-T/S)+HWULI2(Z1)-HWULI2(Z2)
24240 & +PII*DLOG(EH2/(EH2-T)))
24241 ELSEIF (S.LT.ZERO.AND.T.LT.ZERO) THEN
24245 DL1=DLOG((T-EH2)/(S-EH2))
24247 HWHIGD=DLS**2+DLT**2-DLM**2+TWO*PIFAC**2/THREE
24248 & +TWO*DLOG(S/(T-EH2))*DLOG(ONE/DREAL(Z2))
24249 & +TWO*DLOG(T/(S-EH2))*DLOG(ONE/DREAL(Z1))
24250 & -DL1**2-DL2**2-TWO*(HWULI2(Z1)+HWULI2(Z2))
24251 & +TWO*PII*DLOG(RZ12**2*EH2/EQ2)
24253 HWHIGD=HWHIGD/(S*T)
24256 ROOT=DSQRT(ST**2-FOUR*ST*EQ2*(S+T-EH2))
24257 XP=HALF*(ST+ROOT)/ST
24259 HWHIGD=TWO/ROOT*(-HWUCI2(EQ2,S,XP)-HWUCI2(EQ2,T,XP)
24260 & +HWUCI2(EQ2,EH2,XP)+DLOG(-XM/XP)
24261 & *(LOG(EQ2+EPSI)-LOG(EQ2+EPSI-S*XP*XM)
24262 & +LOG(EQ2+EPSI-EH2*XP*XM)-LOG(EQ2+EPSI-T*XP*XM)))
24267 *CMZ :- -13/10/02 09.43.05 by Peter Richardson
24268 *-- Author : Kosuke Odagiri and Stefano Moretti
24269 C-----------------------------------------------------------------------
24270 C...Generate completely differential cross section (EVWGT) in the variables
24271 C...X(I) with I=1,4 (see below) for the processes from IPROC=1000-1099 (SM),
24272 C...IPROC=1111-1139 (MSSM), as described in the HERWIG 6 documentation file.
24273 C...(For IPROC=1140-1145 it describes MSSM charged Higgs production.)
24275 C...First release: 18-SEP-2002 by Stefano Moretti
24278 C--------------------------------------------------------------------------
24279 C LEPTOPRODUCTION OF MS(SM) HIGGSES IN ASSOCIATION WITH HEAVY QUARK PAIRS
24280 C--------------------------------------------------------------------------
24281 INCLUDE 'HERWIG65.INC'
24284 INTEGER IH,IQ,JQ,IIQ,JJQ
24286 INTEGER IDEC,NC,FLIP
24288 DOUBLE PRECISION CV,CA,BR
24289 DOUBLE PRECISION BRHIGQ,EMQ,ENQ,GMQ,EMQQ,EMH,GMH,EMHWT,EMW
24290 DOUBLE PRECISION PTMMIN,PTNMIN
24291 DOUBLE PRECISION T,TL,TLMIN,TLMAX,TTMIN,TTMAX,CTMP,RCM,RCM2
24292 DOUBLE PRECISION X(4),XL(4),XU(4)
24293 DOUBLE PRECISION Q4(0:3),Q34(0:3)
24294 DOUBLE PRECISION CT5,ST5,CT4,ST4,CF4,SF4,RQ52,RQ5,RQ42,RQ4,PQ4
24295 DOUBLE PRECISION P1(0:3),P2(0:3),P3(0:3),P4(0:3),P5(0:3)
24296 DOUBLE PRECISION F(0:3),G(0:3)
24297 DOUBLE PRECISION ECM,SHAT,S
24298 DOUBLE PRECISION EMIN,EMIN1,EMIN2,PCM2,PCM
24299 DOUBLE PRECISION HFC,HBC
24300 DOUBLE PRECISION M2EE
24301 DOUBLE PRECISION GRND,FACGPM(2)
24302 DOUBLE PRECISION ALPHA,EMSC2
24303 DOUBLE PRECISION HWRGEN,HWUAEM
24304 DOUBLE PRECISION PHI,CPHI,SPHI,ROT(3,3)
24305 DOUBLE PRECISION QAUX(0:3)
24306 DOUBLE PRECISION EPS,HCS,RCS,FACT
24307 DOUBLE PRECISION WEIGHT
24308 INTEGER IFL,KHIGGS,JH,JFL
24309 LOGICAL FIRST,GAUGE
24310 DOUBLE PRECISION E,Q3,YM3,GAM3,YM4,GAM4,GAM5,COLOUR
24311 DOUBLE PRECISION RM3,RM4,RM5
24312 DOUBLE PRECISION S2W,RMW,RMZ
24313 DOUBLE PRECISION RMHL,GAMHL
24314 DOUBLE PRECISION RMHH,GAMHH
24315 DOUBLE PRECISION RMHA,GAMHA
24316 EQUIVALENCE (RMHL,RMASS(203)),(RMHH,RMASS(204)),(RMHA,RMASS(205))
24318 EXTERNAL HWHIGM,HWRGEN,HWUAEM,HWHQCP,HWH2HE,HWEONE,HWRLOG
24319 PARAMETER (EPS=1.D-9)
24320 EQUIVALENCE (EMW,RMASS(198)),(NC,NCOLO)
24321 SAVE HCS,M2EE,FACT,S,SHAT,P3,P4,P5
24322 SAVE IIQ,JJQ,JHIGGS
24323 C...ASSIGN Q/Q'-FLAVOUR.
24324 IF(IPROC.GE.1140)THEN
24326 IF(IPROC.EQ.1140)IQ=2
24327 IF(IPROC.EQ.1141)IQ=4
24328 IF(IPROC.EQ.1142)IQ=6
24329 IF(IPROC.EQ.1143)IQ=7
24330 IF(IPROC.EQ.1144)IQ=8
24331 IF(IPROC.EQ.1145)IQ=9
24335 IF(JQ.EQ.11)GMQ=HBAR/RLTIM(6)
24341 IF(IPROC.LT.1140)IH=3
24342 IF(IPROC.LT.1130)IH=2
24343 IF(IPROC.LT.1120)IH=1
24344 IQ=IPROC-1100-10*IH
24356 C...ASSIGN FINAL STATE MASSES.
24361 EMQ=RMASS(2*IQ-7+114+IAD)
24362 ENQ=RMASS(2*IQ-7+114 )
24364 EMH=RMASS(201+IHIGGS)
24365 GMH=HBAR/RLTIM(201+IHIGGS)
24367 C...ENERGY AT PARTON LEVEL.
24371 IF((EMH.LE.0.).OR.(EMH.GE.ECM))RETURN
24372 C...PHASE SPACE VARIABLES.
24373 C...X(1)=(EMQQ**2-(EMQ+ENQ)**2)/((ECM-EMH)**2-(EMQ+ENQ)**2),
24374 C...LIGHT QUARKS -> X(2)=(LOG|T|-LOG|TMIN|)/(LOG|TMAX|-LOG|TMIN|),
24375 C... X(3)=SIN(THETA4_CM_34),X(4)=COS(FI4_CM_34),
24376 C...HEAVY QUARKS -> X(2)=COS(THETA5_CM),
24377 C... X(3)=COS(THETA4_CM_34),X(4)=FI4_CM_34,
24378 C...PHASE SPACE BORDERS.
24381 IF((IQ+JQ).EQ.18)THEN
24393 C...SINGLE PHASE SPACE POINT.
24397 X(I)=XL(I)+(XU(I)-XL(I))*HWRGEN(0)
24398 WEIGHT=WEIGHT*ABS(XU(I)-XL(I))
24400 C...ENERGY AT PARTON LEVEL.
24404 IF(IPROC.GE.1140)THEN
24407 IF((IQ.NE.6).AND.(IQ.NE.12).AND.
24408 & (JQ.NE.6).AND.(JQ.NE.12))THEN
24416 C...THREE PARTICLE KINEMATICS.
24417 EMQQ=SQRT(X(1)*((ECM-EMH)**2-(EMQ+ENQ)**2)+(EMQ+ENQ)**2)
24418 C...INCOMING PARTONS: ALL MASSLESS.
24420 IF((IQ+JQ).EQ.18)THEN
24423 ST4=SQRT(1.-CT4*CT4)
24427 PCM2=((ECM*ECM-EMIN*EMIN-EMIN*EMIN)**2
24428 & -(2.*EMIN*EMIN)**2)/(4.*ECM*ECM)
24430 RCM2=((ECM*ECM-EMQQ*EMQQ-EMH*EMH)**2
24431 & -(2.*EMQQ*EMH)**2)/(4.*ECM*ECM)
24433 TTMAX=EMIN**2+EMQQ**2-0.5D0/ECM/ECM
24434 & *((ECM*ECM+EMIN**2-EMIN**2)*(ECM*ECM+EMQQ**2-EMH**2)
24435 & -SQRT((ECM*ECM-(EMIN+EMIN)**2)*(ECM*ECM-(EMIN-EMIN)**2))
24436 & *SQRT((ECM*ECM-(EMQQ+EMH)**2)*(ECM*ECM-(EMQQ-EMH)**2)))
24437 TTMIN=EMIN**2+EMQQ**2-0.5D0/ECM/ECM
24438 & *((ECM*ECM+EMIN**2-EMIN**2)*(ECM*ECM+EMQQ**2-EMH**2)
24439 & +SQRT((ECM*ECM-(EMIN+EMIN)**2)*(ECM*ECM-(EMIN-EMIN)**2))
24440 & *SQRT((ECM*ECM-(EMQQ+EMH)**2)*(ECM*ECM-(EMQQ-EMH)**2)))
24441 TLMIN=LOG(ABS(TTMAX))
24442 TLMAX=LOG(ABS(TTMIN))
24443 TL=X(2)*(TLMAX-TLMIN)+TLMIN
24445 CTMP=-T-EMIN**2-EMQQ**2
24446 & +2.*SQRT(PCM**2+EMIN**2)*SQRT(RCM**2+EMQQ**2)
24447 CT5=CTMP/2./PCM/RCM
24449 CT4=SQRT(1.-ST4*ST4)
24451 SF4=SQRT(1.-CF4*CF4)
24453 IF(HWRLOG(HALF))THEN
24454 ST5=+SQRT(1.-CT5*CT5)
24456 ST5=-SQRT(1.-CT5*CT5)
24458 RQ52=((ECM*ECM-EMH*EMH-EMQQ*EMQQ)**2-(2.*EMH*EMQQ)**2)/
24468 P5(0)=SQRT(RQ52+EMH*EMH)
24472 Q34(0)=SQRT(RQ52+EMQQ*EMQQ)
24473 RQ42=((EMQQ*EMQQ-EMQ*EMQ-ENQ*ENQ)**2-(2.*EMQ*ENQ)**2)/
24483 Q4(0)=SQRT(RQ42+ENQ*ENQ)
24486 PQ4=PQ4+Q34(I)*Q4(I)
24488 P4(0)=(Q34(0)*Q4(0)+PQ4)/EMQQ
24491 P4(I)=Q4(I)+Q34(I)*(P4(0)+Q4(0))/(Q34(0)+EMQQ)
24495 IF(IPROC.GE.1140)THEN
24496 IF(SQRT(P4(1)**2+P4(2)**2).LT.PTMIN)RETURN
24498 IF((IQ.NE.6).AND.(IQ.NE.12).AND.
24499 & (JQ.NE.6).AND.(JQ.NE.12))THEN
24500 IF(SQRT(P3(1)**2+P3(2)**2).LT.PTMIN)RETURN
24501 IF(SQRT(P4(1)**2+P4(2)**2).LT.PTMIN)RETURN
24507 C...INITIAL STATE MOMENTA IN THE PARTONIC CM.
24508 PCM2=((SHAT-EMIN*EMIN-EMIN*EMIN)**2
24509 & -(2.*EMIN*EMIN)**2)/(4.*SHAT)
24511 P1(0)=SQRT(PCM2+EMIN*EMIN)
24515 P2(0)=SQRT(PCM2+EMIN*EMIN)
24519 C...COLOR STRUCTURED ME SUMMED/AVERAGED OVER FINAL/INITIAL SPINS AND COLORS.
24520 IF(IPROC.GE.1140)THEN
24528 FACGPM(1) = ENQ *GRND
24529 FACGPM(2) = EMQ*PARITY/GRND
24530 C...EW AND QCD COUPLINGS.
24533 ALPHA=HWUAEM(EMSC2)
24536 E=SQRT(4.D0*PIFAC*ALPHA)
24537 IF(IPROC.GE.1140)THEN
24540 IF(IQ.EQ.8)IFL=IQ+1
24541 IF(IQ.EQ.9)IFL=IQ+2
24548 C...CHARGED HIGGSES
24550 IF(IFL.LE.6)Q3=-1.D0/3.D0
24553 C...ASSIGN FERMION MOMENTA
24561 IF(IQ.EQ.8)IFL=IQ+1
24562 IF(IQ.EQ.9)IFL=IQ+2
24569 C...NEUTRAL HIGGSES
24570 IF((IFL.EQ.1).OR.(IFL.EQ.3).OR.(IFL.EQ.5 ))THEN
24572 ELSEIF((IFL.EQ.2).OR.(IFL.EQ.4).OR.(IFL.EQ.6 ))THEN
24574 ELSEIF((IFL.EQ.7).OR.(IFL.EQ.9).OR.(IFL.EQ.11))THEN
24577 IF((IFL.EQ.1).OR.(IFL.EQ.3).OR.(IFL.EQ. 5).OR.
24578 & (IFL.EQ.7).OR.(IFL.EQ.9).OR.(IFL.EQ.11))THEN
24580 ELSEIF((IFL.EQ.2).OR.(IFL.EQ.4).OR.(IFL.EQ.6))THEN
24584 IF(IHIGGS.NE.0)KHIGGS=IHIGGS-1
24586 C...ASSIGN FERMION MOMENTA
24597 GAMHL=HBAR/RLTIM(203)
24598 GAMHH=HBAR/RLTIM(204)
24599 GAMHA=HBAR/RLTIM(205)
24601 IF(IFL.LE.6)COLOUR=3.D0
24602 C...MSSM COUPLINGS.
24611 CALL HWH2HE(FIRST,GAUGE,JFL,JH,HFC,HBC,
24612 & E,S2W,TANB,ALPHAH,RMW,S,Q3,F,G,P5,
24613 & RM3,YM3,GAM3,RM4,YM4,GAM4,RM5,GAM5,
24614 & RMHL,GAMHL,RMHH,GAMHH,RMHA,GAMHA,
24615 & RMZ,GAMZ,COLOUR,M2EE)
24616 C...CONSTANT FACTORS: PHI ALONG BEAM AND CONVERSION GEV^2->NB.
24617 FACT=2.*PIFAC*GEV2NB
24618 C...PHASE SPACE JACOBIANS, PI'S AND FLUX.
24619 FACT=FACT*RQ4*RQ5/PCM/32./(2.*PIFAC)**5
24620 & *((ECM-EMH)**2-(EMQ+ENQ)**2)
24622 C...JACOBIANS FROM CT5 TO X(2).
24623 IF((IQ+JQ).EQ.18)THEN
24626 FACT=FACT*(TLMAX-TLMIN)/2./PCM/RCM*ABS(T)
24627 FACT=FACT*2.*ABS(ST4/CT4/SF4)
24629 C...CHARGE CONJUGATION.
24630 IF(IPROC.GE.1140)THEN
24631 C...YES FOR CHARGED HIGGS.
24634 C...NO FOR NEUTRAL HIGGSES.
24637 C...HIGGS RESONANCE.
24639 C...CONSTANT WEIGHT.
24641 C...INCLUDE BR OF HIGGS.
24643 IDEC=MOD(IPROC,100)
24644 IF (IDEC.GT.0.AND.IDEC.LE.12) FACT=FACT*BRHIG(IDEC)
24645 IF (IDEC.EQ.0) THEN
24648 BRHIGQ=BRHIGQ+BRHIG(I)
24652 IF (IDEC.EQ.10) THEN
24653 CALL HWDBOZ(198,ID1,ID2,CV,CA,BR,1)
24654 CALL HWDBOZ(199,ID1,ID2,CV,CA,BR,1)
24656 ELSEIF (IDEC.EQ.11) THEN
24657 CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,1)
24658 CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,1)
24663 C...SET UP FLAVOURS IN FINAL STATE.
24664 IF(IPROC.GE.1140)THEN
24665 IF(HWRGEN(0).LT.0.5)THEN
24683 IF (GENEV.AND.HCS.GT.RCS) THEN
24684 C...GENERATE EVENT.
24687 IF(IIQ.LE.12.AND.JJQ.LE.12)THEN
24692 IDN(4)=2*IIQ-7+114+IAD
24695 C...INCOMING PARTONS: NOW MASSIVE.
24696 EMIN1=RMASS(IDN(1))
24697 EMIN2=RMASS(IDN(2))
24698 C...REDO INITIAL STATE MOMENTA IN THE PARTONIC CM.
24699 PCM2=((SHAT-EMIN1*EMIN1-EMIN2*EMIN2)**2
24700 & -(2.*EMIN1*EMIN2)**2)/(4.*SHAT)
24702 P1(0)=SQRT(PCM2+EMIN1*EMIN1)
24706 P2(0)=SQRT(PCM2+EMIN2*EMIN2)
24710 C...SETS UP INCOMING STATUS AND IDS ONLY FOR 2->1: USE HWEONE.
24715 JDAHEP(1,NHEP )=NHEP+1
24716 JDAHEP(2,NHEP )=NHEP+3
24717 JMOHEP(1,NHEP+1)=NHEP
24718 JMOHEP(1,NHEP+2)=NHEP
24719 JMOHEP(1,NHEP+3)=NHEP
24720 C...RANDOMLY ROTATE FINAL STATE MOMENTA AROUND BEAM AXIS.
24721 PHI=2.*PIFAC*HWRGEN(0)
24737 IF(L.EQ.1)QAUX(M)=QAUX(M)+ROT(M,N)*P3(N)
24738 IF(L.EQ.2)QAUX(M)=QAUX(M)+ROT(M,N)*P4(N)
24739 IF(L.EQ.3)QAUX(M)=QAUX(M)+ROT(M,N)*P5(N)
24743 IF(L.EQ.1)P3(M)=QAUX(M)
24744 IF(L.EQ.2)P4(M)=QAUX(M)
24745 IF(L.EQ.3)P5(M)=QAUX(M)
24748 C...DO REAL INCOMING, OUTGOING MOMENTA IN THE LAB FRAME.
24750 IF(M.EQ.NHEP )GO TO 888
24754 IF(M.EQ.NHEP-2)PHEP(NN,M)=P1(N)
24755 IF(M.EQ.NHEP-1)PHEP(NN,M)=P2(N)
24756 IF(M.EQ.NHEP+1)PHEP(NN,M)=P3(N)*(1-FLIP)+P4(N)*FLIP
24757 IF(M.EQ.NHEP+2)PHEP(NN,M)=P4(N)*(1-FLIP)+P3(N)*FLIP
24758 IF(M.EQ.NHEP+3)PHEP(NN,M)=P5(N)
24762 C...NEEDS TO SET ALL FINAL STATE MASSES.
24763 PHEP(5,NHEP+1)=SQRT(ABS(PHEP(4,NHEP+1)**2
24764 & -PHEP(3,NHEP+1)**2
24765 & -PHEP(2,NHEP+1)**2
24766 & -PHEP(1,NHEP+1)**2))
24767 PHEP(5,NHEP+2)=SQRT(ABS(PHEP(4,NHEP+2)**2
24768 & -PHEP(3,NHEP+2)**2
24769 & -PHEP(2,NHEP+2)**2
24770 & -PHEP(1,NHEP+2)**2))
24771 PHEP(5,NHEP+3)=SQRT(ABS(PHEP(4,NHEP+3)**2
24772 & -PHEP(3,NHEP+3)**2
24773 & -PHEP(2,NHEP+3)**2
24774 & -PHEP(1,NHEP+3)**2))
24777 PHEP(I,NHEP )=PHEP(I,NHEP-2)+PHEP(I,NHEP-1)
24779 PHEP(5,NHEP )=SQRT(ABS(PHEP(4,NHEP )**2
24780 & -PHEP(3,NHEP )**2
24781 & -PHEP(2,NHEP )**2
24782 & -PHEP(1,NHEP )**2))
24783 C...SETS UP OUTGOING STATUS AND IDS.
24787 IDHW(NHEP+1)=IDN(3)
24788 IDHEP(NHEP+1)=IDPDG(IDN(3))
24789 IDHW(NHEP+2)=IDN(4)
24790 IDHEP(NHEP+2)=IDPDG(IDN(4))
24791 IDHW(NHEP+3)=IDN(5)
24792 IDHEP(NHEP+3)=IDPDG(IDN(5))
24793 C...SETS UP COLOUR CONNECTIONS.
24794 JMOHEP(2,NHEP+1)=NHEP+2
24795 JMOHEP(2,NHEP+2)=NHEP+1
24796 JMOHEP(2,NHEP-1)=NHEP-2
24797 JMOHEP(2,NHEP-2)=NHEP-1
24798 JMOHEP(2,NHEP+3)=NHEP+3
24799 JDAHEP(2,NHEP+1)=NHEP+2
24800 JDAHEP(2,NHEP+2)=NHEP+1
24801 JDAHEP(2,NHEP-1)=NHEP-1
24802 JDAHEP(2,NHEP-2)=NHEP-2
24803 JDAHEP(2,NHEP+3)=NHEP+3
24806 C...SET TO ZERO THE COEFFICIENTS OF THE SPIN DENSITY MATRICES.
24807 CALL HWVZRO(7,GCOEF)
24810 C...COLLECT WEIGHT.
24815 *CMZ :- -26/11/00 17.21.55 by Bryan Webber
24816 *-- Author : Kosuke Odagiri & Stefano Moretti
24817 C-----------------------------------------------------------------------
24818 C...Generate completely differential cross section (EVWGT) in the variables
24819 C...X(I) with I=1,3 (see below) for the processes IPROC=3315,3325,3335,3355,
24820 C...3365,3375 as described in the HERWIG 6 documentation file.
24821 C...It includes interface to PDFs and takes into account color connections
24824 C...First release: 16-AUG-1999 by Kosuke Odagiri
24825 C...Last modified: 26-SEP-1999 by Stefano Moretti
24826 C-----------------------------------------------------------------------
24828 C-----------------------------------------------------------------------
24829 C DRELL-YAN 2 PARTON -> 2 HIGGS PAIR (2HDM)
24830 C-----------------------------------------------------------------------
24831 INCLUDE 'HERWIG65.INC'
24832 DOUBLE PRECISION HWRGEN, HWUAEM, EPS, HCS, RCS, DIST, S, PF, QPE,
24833 & FACTR, SN2TH, MZ, MW, MNN(2,2), MCC(2), MCN(3), EMSC2, GW2, GZ2,
24834 & GHH(4), XWEIN, S2W, PT2MIN, ECM_MAX, X(3), XL(3),
24835 & XU(3), WEIGHT, ECM, SHAT, TAU, RMH1, RMH2, EMH1, EMH2,
24836 & EMHWT1, EMHWT2, EMHHWT
24837 INTEGER I, J, IQ, IQ1, IQ2, ID1, ID2, IH, JH, IH1, IH2
24838 EXTERNAL HWRGEN, HWUAEM
24839 SAVE HCS,MNN,MCC,MCN,EMHHWT,S,SHAT
24840 PARAMETER (EPS = 1.D-9)
24841 DOUBLE COMPLEX Z, GZ, A, D, E
24842 PARAMETER (Z = (0.D0,1.D0))
24843 EQUIVALENCE (MZ, RMASS(200)), (MW, RMASS(198))
24846 RCS = HCS*HWRGEN(0)
24850 C...minimum transverse momentum.
24853 C...energy at hadron level.
24854 ECM_MAX=PBEAM1+PBEAM2
24856 C...phase space variables.
24857 C...X(1)=COS(THETA_CM),
24858 C...X(2)=(1./SHAT-1./ECM_MAX**2)/(1./(EMH1+EMH2)**2-1./ECM_MAX**2),
24859 C...X(3)=(LOG(TAU)-LOG(X1))/LOG(TAU),
24860 C...phase space borders.
24867 C...single phase space point.
24871 X(I)=XL(I)+(XU(I)-XL(I))*HWRGEN(0)
24872 WEIGHT=WEIGHT*ABS(XU(I)-XL(I))
24874 C...final state masses.
24875 IF((MOD(IPROC,10000).EQ.3365).OR.
24876 & (MOD(IPROC,10000).EQ.3375))THEN
24880 ELSE IF(MOD(IPROC,10000).EQ.3355)THEN
24884 ELSE IF((MOD(IPROC,10000).EQ.3315).OR.
24885 & (MOD(IPROC,10000).EQ.3325).OR.
24886 & (MOD(IPROC,10000).EQ.3335))THEN
24897 EMHHWT=EMHWT1*EMHWT2
24898 C...energy at parton level.
24899 ECM=SQRT(1./(X(2)*(1./(EMH1+EMH2)**2-1./ECM_MAX**2)
24901 IF((EMH1.LE.0.).OR.(EMH1.GE.ECM))RETURN
24902 IF((EMH2.LE.0.).OR.(EMH2.GE.ECM))RETURN
24905 C...momentum fractions X1 and X2.
24906 XX(1) = EXP(LOG(TAU)*(1.-X(3)))
24909 SN2TH = 0.25D0 - 0.25D0*COSTH**2
24911 EMSC2 = EMSCA*EMSCA
24912 CALL HWSGEN(.FALSE.)
24914 FACTR = GEV2NB*PIFAC*(HWUAEM(EMSC2))**2/SHAT/CAFAC*SN2TH/2.
24915 C...Jacobians from X1,X2 to X(2),X(3).
24916 FACTR = FACTR/S*(-LOG(TAU))*(1./(EMH1+EMH2)**2-1./ECM_MAX**2)
24917 C...constant weight.
24918 FACTR = FACTR*WEIGHT
24919 C...couplings and propagators.
24921 S2W = DSQRT(XWEIN*(TWO-XWEIN))
24922 GZ = S2W*(SHAT-MZ**2+Z*SHAT*GAMZ/MZ)/SHAT
24923 GZ2 = DREAL(DCONJG(GZ)*GZ)
24924 GW2 = ((ONE-MW**2/SHAT)**2+(GAMW/MW)**2)*XWEIN**2
24925 C...labels: 1 = h0, 2 = H0, 3 = A0, 4 = H+, 5 = H-.
24930 C...set to zero all MEs.
24939 C...start subprocesses.
24940 IF((MOD(IPROC,10000).EQ.3365).OR.
24941 & (MOD(IPROC,10000).EQ.3375))THEN
24947 QPE = SHAT-(EMH1+EMH2)**2
24948 IF (QPE.GT.ZERO) THEN
24949 PF = SQRT(QPE*(SHAT-(EMH1-EMH2)**2))/SHAT
24952 & FACTR*PF**3*GHH(IH)**2*(LFCH(IQ)**2+RFCH(IQ)**2)/GZ2
24958 ELSE IF(MOD(IPROC,10000).EQ.3355)THEN
24964 QPE = SHAT-(EMH1+EMH2)**2
24965 IF (QPE.GT.ZERO) THEN
24966 PF = SQRT(QPE*(SHAT-(EMH1-EMH2)**2))/SHAT
24969 D = QFCH(IQ)+A*LFCH(IQ)
24970 E = QFCH(IQ)+A*RFCH(IQ)
24971 MCC(IQ)=FACTR*PF**3*DREAL(DCONJG(D)*D+DCONJG(E)*E)
24976 ELSE IF((MOD(IPROC,10000).EQ.3315).OR.
24977 & (MOD(IPROC,10000).EQ.3325).OR.
24978 & (MOD(IPROC,10000).EQ.3335))THEN
24981 c q q' -> H h / H / A
24984 QPE = SHAT-(EMH1+EMH2)**2
24985 IF (QPE.GT.ZERO) THEN
24986 PF = SQRT(QPE*(SHAT-(EMH1-EMH2)**2))/SHAT
24987 MCN(IH)=FACTR*PF**3/GW2*HALF*GHH(IH)**2
24997 IF (DISF(ID1,1).LT.EPS) GOTO 1
25003 IQ = ID1 - ((ID1-1)/2)*2
25004 IF (DISF(ID2,2).LT.EPS) GOTO 1
25005 DIST = DISF(ID1,1)*DISF(ID2,2)*S*SHAT
25008 HCS = HCS + DIST*EMHHWT*MNN(1,IQ)
25009 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(IH1,IH2,2134,1,*9)
25011 HCS = HCS + DIST*EMHHWT*MNN(2,IQ)
25012 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(IH1,IH2,2134,2,*9)
25015 HCS = HCS + DIST*EMHHWT*MCC(IQ)
25016 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(IH1,IH2,2134,3,*9)
25019 c ud(+), ud(-), du(-), du(+)
25023 IF(VCKM(IQ1,IQ2).GT.EPS) THEN
25030 IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN
25031 DIST = VCKM(IQ1,IQ2)*DISF(ID1,1)*DISF(ID2,2)*S*SHAT
25034 HCS = HCS + DIST*EMHHWT*MCN(IH)
25035 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(IH1,IH2,2134,3+IH,*9)
25044 IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN
25045 DIST = VCKM(IQ1,IQ2)*DISF(ID1,1)*DISF(ID2,2)*S*SHAT
25048 HCS = HCS + DIST*EMHHWT*MCN(IH)
25049 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(IH1,IH2,2134,3+IH,*9)
25058 IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN
25059 DIST = VCKM(IQ1,IQ2)*DISF(ID1,1)*DISF(ID2,2)*S*SHAT
25062 HCS = HCS + DIST*EMHHWT*MCN(IH)
25063 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(IH1,IH2,2134,3+IH,*9)
25072 IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN
25073 DIST = VCKM(IQ1,IQ2)*DISF(ID1,1)*DISF(ID2,2)*S*SHAT
25076 HCS = HCS + DIST*EMHHWT*MCN(IH)
25077 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(IH1,IH2,2134,3+IH,*9)
25085 C...generate event.
25089 CALL HWETWO(.TRUE.,.TRUE.)
25091 CALL HWVZRO(7,GCOEF)
25095 *CMZ :- -23/08/94 13.22.29 by Mike Seymour
25096 *-- Author : Ian Knowles
25097 C-----------------------------------------------------------------------
25099 C-----------------------------------------------------------------------
25100 C QCD Higgs plus jet production; mean EVWGT = Sigma in nb*Higgs B.R.
25101 C Adapted from the program of U. Baur and E.W.N. Glover
25102 C See: Nucl. Phys. B339 (1990) 38
25103 C-----------------------------------------------------------------------
25104 INCLUDE 'HERWIG65.INC'
25105 DOUBLE PRECISION HWRGEN,HWRUNI,HWUALF,HWUAEM,EPS,RCS,EMH,EMHWT,
25106 & EMHTMP,BR,CV,CA,EMH2,ET,EJ,PT,EMT,EMAX,YMAX,YHINF,YHSUP,EXYH,
25107 & YMIN,YJINF,YJSUP,EXYJ,S,T,U,FACT,AMPQQ,AMPQG,AMPGQ,AMPGG,HCS,
25109 INTEGER I,IDEC,ID1,ID2
25110 EXTERNAL HWRGEN,HWRUNI,HWUALF,HWUAEM
25111 SAVE HCS,AMPGG,AMPGQ,AMPQG,AMPQQ,EMH,FACT
25112 PARAMETER (EPS=1.D-9)
25117 C Select a Higgs mass
25118 CALL HWHIGM(EMH,EMHWT)
25119 IF (EMH.LE.ZERO .OR. EMH.GE.PHEP(5,3)) RETURN
25120 C Store branching ratio for specified Higgs deacy channel
25121 IDEC=MOD(IPROC,100)
25123 IF (IDEC.EQ.0) THEN
25127 ELSEIF (IDEC.EQ.10) THEN
25128 CALL HWDBOZ(198,ID1,ID2,CV,CA,BR,1)
25129 CALL HWDBOZ(199,ID1,ID2,CV,CA,BR,1)
25131 ELSEIF (IDEC.EQ.11) THEN
25132 CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,1)
25133 CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,1)
25135 ELSEIF (IDEC.LE.12) THEN
25138 C Select subprocess kinematics
25142 EMT=SQRT(PT**2+EMH2)
25143 EMAX=0.5*(PHEP(5,3)+EMH2/PHEP(5,3))
25144 IF (EMAX.LE.EMT) RETURN
25145 YMAX=LOG((EMAX+SQRT(EMAX**2-EMT**2))/EMT)
25146 YHINF=MAX(YJMIN,-YMAX)
25147 YHSUP=MIN(YJMAX, YMAX)
25148 IF (YHSUP.LE.YHINF) RETURN
25149 EXYH=EXP(HWRUNI(1,YHINF,YHSUP))
25150 YMIN=LOG(PT/(PHEP(5,3)-EMT/EXYH))
25151 YMAX=LOG((PHEP(5,3)-EMT*EXYH)/PT)
25152 YJINF=MAX(YJMIN,YMIN)
25153 YJSUP=MIN(YJMAX,YMAX)
25154 IF (YJSUP.LE.YJINF) RETURN
25155 EXYJ=EXP(HWRUNI(2,YJINF,YJSUP))
25156 XX(1)=(EMT*EXYH+PT*EXYJ)/PHEP(5,3)
25157 XX(2)=(EMT/EXYH+PT/EXYJ)/PHEP(5,3)
25158 S=XX(1)*XX(2)*PHEP(5,3)**2
25159 T=EMH2-XX(1)*EMT*PHEP(5,3)/EXYH
25161 COSTH=(S+2.*T-EMH2)/(S-EMH2)
25162 C Set subprocess scale
25164 CALL HWSGEN(.FALSE.)
25165 FACT=GEV2NB*PT*EJ*(YHSUP-YHINF)*(YJSUP-YJINF)*BR*EMHWT
25166 & *HWUALF(1,EMSCA)**3*HWUAEM(EMH2)/(SWEIN*16*PIFAC*S**2)
25167 CALL HWHIGA(S,T,U,EMH2,AMPQQ,AMPQG,AMPGQ,AMPGG)
25171 IF (DISF(ID1,1).LT.EPS) GOTO 30
25172 FACTR=FACT*DISF(ID1,1)
25176 HCS=HCS+FACTR*DISF(ID2,2)*AMPQQ
25177 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(13 ,201,2314,81,*99)
25179 HCS=HCS+FACTR*DISF(ID2,2)*AMPQG
25180 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,201,3124,82,*99)
25181 ELSEIF (ID1.LT.13) THEN
25184 HCS=HCS+FACTR*DISF(ID2,2)*AMPQQ
25185 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(13 ,201,3124,83,*99)
25187 HCS=HCS+FACTR*DISF(ID2,2)*AMPQG
25188 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,201,2314,84,*99)
25192 IF (DISF(ID2,2).LT.EPS) GOTO 20
25194 HCS=HCS+FACTR*DISF(ID2,2)*AMPGQ
25195 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID2,201,2314,85,*99)
25197 HCS=HCS+FACTR*DISF(ID2,2)*AMPGQ
25198 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID2,201,3124,86,*99)
25201 HCS=HCS+FACTR*DISF(13,2)*AMPGG
25202 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(13 ,201,2314,87,*99)
25211 C Trick HWETWO into using off-shell Higgs mass
25212 EMHTMP=RMASS(IDN(4))
25214 C-- BRW fix 27/8/04: avoid double smearing of H mass
25215 CALL HWETWO(.TRUE.,.FALSE.)
25216 RMASS(IDN(4))=EMHTMP
25219 *CMZ :- -02/05/91 11.17.14 by Federico Carminati
25220 *-- Author : Mike Seymour
25221 C-----------------------------------------------------------------------
25222 SUBROUTINE HWHIGM(EM,WEIGHT)
25223 C-----------------------------------------------------------------------
25224 C CHOOSE HIGGS MASS:
25225 C IF (IOPHIG.EQ.0.OR.IOPHIG.EQ.2) THEN
25226 C CHOOSE HIGGS MASS ACCORDING TO
25227 C EM**4 / (EM**2-EMH**2)**2 + (GAMH*EMH)**2
25229 C CHOOSE HIGGS MASS ACCORDING TO
25230 C EMH * GAMH / (EM**2-EMH**2)**2 + (GAMH*EMH)**2
25232 C IF (IOPHIG.EQ.0.OR.IOPHIG.EQ.1) THEN
25233 C SUPPLY WEIGHT FACTOR TO YIELD
25234 C EM * GAM(EM)/ (EM**2-EMH**2)**2 + (GAM(EM)*EM)**2
25236 C SUPPLY WEIGHT FACTOR TO YIELD
25237 C EM*(EMH/EM)**4 * GAM(EM)
25238 C / (EM**2-EMH**2)**2 + (GAM(EM)*EMH**2/EM)**2
25239 C AS SUGGESTED IN M.H.SEYMOUR, PHYS.LETT.B354(1995)409.
25241 C-----------------------------------------------------------------------
25242 INCLUDE 'HERWIG65.INC'
25243 DOUBLE PRECISION HWRUNI,EM,WEIGHT,EMH,DIF,FUN,THETA,T,EMHLST,W0,
25244 & W1,EMM,GAMEM,T0,TMIN,TMAX,THEMIN,THEMAX,ZMIN,ZMAX,Z,F,GAMOFS
25247 SAVE EMHLST,GAMEM,T0,TMIN,TMAX,THEMIN,THEMAX,ZMIN,ZMAX,W0,W1
25248 EQUIVALENCE (EMH,RMASS(201))
25250 C---SET UP INTEGRAND AND INDEFINITE INTEGRAL OF DISTRIBUTION
25251 C THETA=ATAN((EM**2-EMH**2)/(GAMH*EMH)); T=TAN(THETA); T0=EMH/GAMH
25252 DIF(T,T0)=(T+T0)**2
25253 FUN(THETA,T,T0)=T + (T0*T0-1)*THETA + T0*LOG(1+T*T)
25254 C---SET UP CONSTANTS
25255 IF (EMH.NE.EMHLST .OR. FSTWGT) THEN
25259 TMIN=(MAX(ONE*1E-10,EMH-GAMMAX*GAMH))**2/GAMEM-T0
25260 TMAX=( EMH+GAMMAX*GAMH )**2/GAMEM-T0
25263 ZMIN=FUN(THEMIN,TMIN,T0)
25264 ZMAX=FUN(THEMAX,TMAX,T0)
25265 W0=(ZMAX-ZMIN) / PIFAC * GAMEM
25266 W1=(THEMAX-THEMIN) / PIFAC
25268 C---CHOOSE HIGGS MASS
25269 IF (IOPHIG.EQ.0.OR.IOPHIG.EQ.2) THEN
25272 Z=HWRUNI(1,ZMIN,ZMAX)
25273 C---SOLVE FUN(THETA,TAN(THETA))=Z BY NEWTON'S METHOD
25274 THETA=MAX(THEMIN, MIN(THEMAX, Z/T0**2 ))
25277 10 IF (I.LE.20 .AND. ABS(1-F/Z).GT.1E-4) THEN
25279 IF (2*ABS(THETA).GT.PIFAC) CALL HWWARN('HWHIGM',51,*999)
25282 THETA=THETA-(F-Z)/DIF(T,T0)
25285 IF (I.GT.20) CALL HWWARN('HWHIGM',1,*999)
25287 THETA=HWRUNI(0,THEMIN,THEMAX)
25289 EM=SQRT(GAMEM*(T0+TAN(THETA)))
25290 C---NOW CALCULATE WEIGHT FACTOR FOR NON-CONSTANT HIGGS WIDTH
25292 CALL HWDHIG(GAMOFS)
25293 IF (IOPHIG.EQ.0) THEN
25294 WEIGHT=W0*GAMOFS*EM /EM**4 *((EM**2-EMH**2)**2 + GAMEM**2)
25295 & /((EM**2-EMH**2)**2 +(GAMOFS*EM)**2)
25296 ELSEIF (IOPHIG.EQ.1) THEN
25297 WEIGHT=W1*GAMOFS*EM /GAMEM *((EM**2-EMH**2)**2 + GAMEM**2)
25298 & /((EM**2-EMH**2)**2 +(GAMOFS*EM)**2)
25299 ELSEIF (IOPHIG.EQ.2) THEN
25301 WEIGHT=W0*GAMOFS*EMM/EM**4 *((EM**2-EMH**2)**2 + GAMEM**2)
25302 & /((EM**2-EMH**2)**2 +(GAMOFS*EMM)**2)
25303 ELSEIF (IOPHIG.EQ.3) THEN
25305 WEIGHT=W1*GAMOFS*EMM/GAMEM *((EM**2-EMH**2)**2 + GAMEM**2)
25306 & /((EM**2-EMH**2)**2 +(GAMOFS*EMM)**2)
25308 CALL HWWARN('HWHIGM',500,*999)
25312 *CMZ :- -26/11/00 17.21.55 by Bryan Webber
25313 *-- Author : Stefano Moretti
25314 C-----------------------------------------------------------------------
25315 C...Generate completely differential cross section (EVWGT) in the variables
25316 C...X(I) with I=1,6 (see below) for the processes from IPROC=2500-2599 (SM),
25317 C...IPROC=3811-3899, as described in the HERWIG 6 documentation file.
25318 C...(For IPROC=3839,3869,3899 it describes MSSM charged Higgs production.)
25319 C...It includes interface to PDFs and takes into account color connections
25322 C...First release: 08-APR-1999 by Stefano Moretti
25323 C...Last modified: 28-JUN-2001 by Stefano Moretti
25326 C-----------------------------------------------------------------------
25327 C PRODUCTION OF MSSM HIGGSES IN ASSOCIATION WITH HEAVY QUARK PAIRS
25328 C-----------------------------------------------------------------------
25329 INCLUDE 'HERWIG65.INC'
25331 INTEGER I,J,K,L,M,N
25332 INTEGER IS,IH,IQ,JQ,IIQ,JJQ,IQMIN,IQMAX,IGG,IQQ
25333 INTEGER IDEC,NC,FLIP
25335 DOUBLE PRECISION CV,CA,BR
25336 DOUBLE PRECISION BRHIGQ,EMQ,ENQ,EMQQ,EMH,EMHWT,EMW
25337 DOUBLE PRECISION PTMMIN,PTNMIN
25338 DOUBLE PRECISION T,TL,TLMIN,TLMAX,TTMIN,TTMAX,CTMP,RCM,RCM2
25339 DOUBLE PRECISION X(6),XL(6),XU(6)
25340 DOUBLE PRECISION Q4(0:3),Q34(0:3)
25341 DOUBLE PRECISION CT5,ST5,CT4,ST4,CF4,SF4,RQ52,RQ5,RQ42,RQ4,PQ4
25342 DOUBLE PRECISION P1(0:3),P2(0:3),P3(0:3),P4(0:3),P5(0:3)
25343 DOUBLE PRECISION ECM_MAX,ECM,SHAT,S,TAU
25344 DOUBLE PRECISION EMIN,EMIN1,EMIN2,PCM2,PCM
25345 DOUBLE PRECISION M2GG,M2GGPL,M2GGMN,M2QQ
25346 DOUBLE PRECISION GM,GRND,FACGPM(2)
25347 DOUBLE PRECISION GGQQHT,GGQQHU,GGQQHNP,QQQQH
25348 DOUBLE PRECISION ALPHA,ALPHAS,EMSC2
25349 DOUBLE PRECISION HWRGEN,HWUAEM,HWUALF
25350 DOUBLE PRECISION PHI,CPHI,SPHI,ROT(3,3)
25351 DOUBLE PRECISION VCOL,GCOL,QAUX(0:3)
25352 DOUBLE PRECISION EPS,HCS,RCS,FACT,DIST
25353 DOUBLE PRECISION WEIGHT
25354 SAVE HCS,M2QQ,M2GG,M2GGPL,M2GGMN,FACT,S,SHAT,P3,P4,P5
25355 SAVE IIQ,JJQ,JHIGGS
25357 EXTERNAL HWHIGM,HWRGEN,HWUAEM,HWUALF,HWHQCP,HWH2QH,HWETWO,HWRLOG
25358 PARAMETER (EPS=1.D-9)
25359 EQUIVALENCE (EMW,RMASS(198)),(NC,NCOLO)
25360 C...assign Q/Q'-flavour.
25361 IF((MOD(IPROC,10000).EQ.3839).OR.
25362 & (MOD(IPROC,10000).EQ.3869).OR.
25363 & (MOD(IPROC,10000).EQ.3899))THEN
25366 GM=HBAR/RLTIM(6)*RMASS(6)
25373 IF(MOD(IPROC,10000).LT.4000)IS=6
25374 IF(MOD(IPROC,10000).LT.3870)IS=3
25375 IF(MOD(IPROC,10000).LT.3840)IS=0
25376 IH=MOD(IPROC,10000)/10-380-IS
25377 IQ=MOD(IPROC,10000)-3800-10*(IH+IS)
25388 C...assign final state masses.
25391 EMH=RMASS(201+IHIGGS)
25393 IF(IMSSM.EQ.0)CALL HWHIGM(EMH,EMHWT)
25394 C...energy at hadron level.
25395 ECM_MAX=PBEAM1+PBEAM2
25397 C...phase space variables.
25398 C...X(1)=(EMQQ**2-(EMQ+ENQ)**2)/((ECM-EMH)**2-(EMQ+ENQ)**2),
25399 C...LIGHT QUARKS -> X(2)=(LOG|T|-LOG|TMIN|)/(LOG|TMAX|-LOG|TMIN|),
25400 C... X(3)=SIN(THETA4_CM_34),X(4)=COS(FI4_CM_34),
25401 C...HEAVY QUARKS -> X(2)=COS(THETA5_CM),
25402 C... X(3)=COS(THETA4_CM_34),X(4)=FI4_CM_34,
25403 C...X(5)=(1./SHAT-1./ECM_MAX**2)/(1./(EMQ+ENQ+EMH)**2-1./ECM_MAX**2),
25404 C...X(6)=(LOG(TAU)-LOG(X1))/LOG(TAU);
25405 C...phase space borders.
25408 IF((IQ+JQ).EQ.18)THEN
25424 C...single phase space point.
25428 X(I)=XL(I)+(XU(I)-XL(I))*HWRGEN(0)
25429 WEIGHT=WEIGHT*ABS(XU(I)-XL(I))
25431 C...energy at parton level.
25435 IF((MOD(IPROC,10000).EQ.3839).OR.
25436 & (MOD(IPROC,10000).EQ.3869).OR.
25437 & (MOD(IPROC,10000).EQ.3899))THEN
25440 IF((IQ.NE.6).AND.(IQ.NE.12).AND.
25441 & (JQ.NE.6).AND.(JQ.NE.12))THEN
25449 ECM=SQRT(1./(X(5)*(1./(SQRT(PTMMIN**2+EMQ**2)
25450 & +SQRT(PTNMIN**2+ENQ**2)+EMH)**2
25453 IF((EMH.LE.0.).OR.(EMH.GE.ECM))RETURN
25456 C...momentum fractions X1 and X2.
25457 XX(1)=EXP(LOG(TAU)*(1.-X(6)))
25459 C...three particle kinematics.
25460 EMQQ=SQRT(X(1)*((ECM-EMH)**2-(EMQ+ENQ)**2)+(EMQ+ENQ)**2)
25461 C...incoming partons: all massless.
25463 IF((IQ+JQ).EQ.18)THEN
25466 ST4=SQRT(1.-CT4*CT4)
25470 PCM2=((ECM*ECM-EMIN*EMIN-EMIN*EMIN)**2
25471 & -(2.*EMIN*EMIN)**2)/(4.*ECM*ECM)
25473 RCM2=((ECM*ECM-EMQQ*EMQQ-EMH*EMH)**2
25474 & -(2.*EMQQ*EMH)**2)/(4.*ECM*ECM)
25476 TTMAX=EMIN**2+EMQQ**2-0.5D0/ECM/ECM
25477 & *((ECM*ECM+EMIN**2-EMIN**2)*(ECM*ECM+EMQQ**2-EMH**2)
25478 & -SQRT((ECM*ECM-(EMIN+EMIN)**2)*(ECM*ECM-(EMIN-EMIN)**2))
25479 & *SQRT((ECM*ECM-(EMQQ+EMH)**2)*(ECM*ECM-(EMQQ-EMH)**2)))
25480 TTMIN=EMIN**2+EMQQ**2-0.5D0/ECM/ECM
25481 & *((ECM*ECM+EMIN**2-EMIN**2)*(ECM*ECM+EMQQ**2-EMH**2)
25482 & +SQRT((ECM*ECM-(EMIN+EMIN)**2)*(ECM*ECM-(EMIN-EMIN)**2))
25483 & *SQRT((ECM*ECM-(EMQQ+EMH)**2)*(ECM*ECM-(EMQQ-EMH)**2)))
25484 TLMIN=LOG(ABS(TTMAX))
25485 TLMAX=LOG(ABS(TTMIN))
25486 TL=X(2)*(TLMAX-TLMIN)+TLMIN
25488 CTMP=-T-EMIN**2-EMQQ**2
25489 & +2.*SQRT(PCM**2+EMIN**2)*SQRT(RCM**2+EMQQ**2)
25490 CT5=CTMP/2./PCM/RCM
25492 CT4=SQRT(1.-ST4*ST4)
25493 IF (HWRLOG(HALF)) CT4=-CT4
25495 SF4=SQRT(1.-CF4*CF4)
25496 IF (HWRLOG(HALF)) SF4=-SF4
25498 ST5=SQRT(1.-CT5*CT5)
25499 IF (HWRLOG(HALF)) ST5=-ST5
25500 RQ52=((ECM*ECM-EMH*EMH-EMQQ*EMQQ)**2-(2.*EMH*EMQQ)**2)/
25510 P5(0)=SQRT(RQ52+EMH*EMH)
25514 Q34(0)=SQRT(RQ52+EMQQ*EMQQ)
25515 RQ42=((EMQQ*EMQQ-EMQ*EMQ-ENQ*ENQ)**2-(2.*EMQ*ENQ)**2)/
25525 Q4(0)=SQRT(RQ42+ENQ*ENQ)
25528 PQ4=PQ4+Q34(I)*Q4(I)
25530 P4(0)=(Q34(0)*Q4(0)+PQ4)/EMQQ
25533 P4(I)=Q4(I)+Q34(I)*(P4(0)+Q4(0))/(Q34(0)+EMQQ)
25537 IF((MOD(IPROC,10000).EQ.3839).OR.
25538 & (MOD(IPROC,10000).EQ.3869).OR.
25539 & (MOD(IPROC,10000).EQ.3899))THEN
25540 IF(SQRT(P4(1)**2+P4(2)**2).LT.PTMIN)RETURN
25542 IF((IQ.NE.6).AND.(IQ.NE.12).AND.
25543 & (JQ.NE.6).AND.(JQ.NE.12))THEN
25544 IF(SQRT(P3(1)**2+P3(2)**2).LT.PTMIN)RETURN
25545 IF(SQRT(P4(1)**2+P4(2)**2).LT.PTMIN)RETURN
25551 C...initial state momenta in the partonic CM.
25552 PCM2=((SHAT-EMIN*EMIN-EMIN*EMIN)**2
25553 & -(2.*EMIN*EMIN)**2)/(4.*SHAT)
25555 P1(0)=SQRT(PCM2+EMIN*EMIN)
25559 P2(0)=SQRT(PCM2+EMIN*EMIN)
25563 C...color structured ME summed/averaged over final/initial spins and colors.
25566 IF((MOD(IPROC,10000).EQ.3839).OR.
25567 & (MOD(IPROC,10000).EQ.3869).OR.
25568 & (MOD(IPROC,10000).EQ.3899))THEN
25569 IF(MOD(IPROC,10000).EQ.3869)IQQ=0
25570 IF(MOD(IPROC,10000).EQ.3899)IGG=0
25574 IF((MOD(IPROC,10000)/10-380).EQ.4)IQQ=0
25575 IF((MOD(IPROC,10000)/10-380).EQ.7)IGG=0
25579 FACGPM(1) = ENQ *GRND
25580 FACGPM(2) = EMQ*PARITY/GRND
25581 CALL HWH2QH(ECM,P1,P2,P3,P4,P5,EMQ,ENQ,EMH,FACGPM,GM,IGG,IQQ,
25582 & GGQQHT,GGQQHU,GGQQHNP,QQQQH)
25583 M2GG=GGQQHNP/(8.*CFFAC)
25584 M2GGPL=GGQQHT/(8.*CFFAC)
25585 M2GGMN=GGQQHU/(8.*CFFAC)
25586 M2QQ=QQQQH*(1.-1./CAFAC**2)/4.
25587 C...constant factors: phi along beam and conversion GeV^2->nb.
25588 FACT=2.*PIFAC*GEV2NB
25589 C...Jacobians from X1,X2 to X(5),X(6)
25590 FACT=FACT/S*(-LOG(TAU))*(1./(EMQ+ENQ+EMH)**2-1./ECM_MAX**2)
25591 C...phase space Jacobians, pi's and flux.
25592 FACT=FACT*RQ4*RQ5/PCM/32./(2.*PIFAC)**5
25593 & *((ECM-EMH)**2-(EMQ+ENQ)**2)
25595 C...Jacobians from CT5 to X(2).
25596 IF((IQ+JQ).EQ.18)THEN
25599 FACT=FACT*(TLMAX-TLMIN)/2./PCM/RCM*ABS(T)
25600 FACT=FACT*2.*ABS(ST4/CT4/SF4)
25602 C...EW and QCD couplings.
25605 ALPHA=HWUAEM(EMSC2)
25606 ALPHAS=HWUALF(1,EMSCA)
25607 FACT=FACT*4.*PIFAC*ALPHA/4./SWEIN/EMW/EMW
25608 FACT=FACT*16.*PIFAC**2*ALPHAS**2
25609 IF((MOD(IPROC,10000).EQ.3839).OR.
25610 & (MOD(IPROC,10000).EQ.3869).OR.
25611 & (MOD(IPROC,10000).EQ.3899))THEN
25612 C...enhancement factor for coupling+c.c.
25613 FACT=FACT*4.*VCKM(3,3)
25615 C...enhancement factor for MSSM.
25616 FACT=FACT*ENHANC(IQ)*ENHANC(IQ)
25618 C...Higgs resonance.
25620 C...constant weight.
25622 C...include BR of Higgs.
25624 IDEC=MOD(IPROC,100)
25625 IF (IDEC.GT.0.AND.IDEC.LE.12) FACT=FACT*BRHIG(IDEC)
25626 IF (IDEC.EQ.0) THEN
25629 BRHIGQ=BRHIGQ+BRHIG(I)
25633 c bug fix 11/10/02 SM.
25634 IF (IDEC.EQ.10) THEN
25635 CALL HWDBOZ(198,ID1,ID2,CV,CA,BR,1)
25636 CALL HWDBOZ(199,ID1,ID2,CV,CA,BR,1)
25638 ELSEIF (IDEC.EQ.11) THEN
25639 CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,1)
25640 CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,1)
25646 C...set up flavours in final state.
25647 IF((MOD(IPROC,10000).EQ.3839).OR.
25648 & (MOD(IPROC,10000).EQ.3869).OR.
25649 & (MOD(IPROC,10000).EQ.3899))THEN
25650 IF(HWRGEN(0).LT.0.5)THEN
25669 CALL HWSGEN(.FALSE.)
25672 IF((MOD(IPROC,10000).EQ.3839).OR.
25673 & (MOD(IPROC,10000).EQ.3869).OR.
25674 & (MOD(IPROC,10000).EQ.3899))THEN
25675 IF(MOD(IPROC,10000).EQ.3869)IQMIN=13
25676 IF(MOD(IPROC,10000).EQ.3899)IQMAX=12
25679 C...Some compilers don't like this statement.
25680 C Since it does nothing, just comment it out.
25681 C IF((MOD(IPROC,10000).GE.3811).AND.
25682 C & (MOD(IPROC,10000).LE.3836))CONTINUE
25683 IF((MOD(IPROC,10000).GE.3841).AND.
25684 & (MOD(IPROC,10000).LE.3866))IQMIN=13
25685 IF((MOD(IPROC,10000).GE.3871).AND.
25686 & (MOD(IPROC,10000).LE.3896))IQMAX=12
25690 IF(DISF(I,1).LT.EPS)THEN
25697 IF(DISF(J,2).LT.EPS)THEN
25700 DIST=DISF(I,1)*DISF(J,2)*S
25702 C...set up color connections: qq-scattering.
25704 HCS=HCS+M2QQ*DIST*FACT
25705 IF(GENEV.AND.HCS.GT.RCS)THEN
25707 CALL HWHQCP(IIQ,JJQ,2413, 4,*9)
25709 ELSE IF(I.EQ.J+6)THEN
25710 HCS=HCS+M2QQ*DIST*FACT
25711 IF(GENEV.AND.HCS.GT.RCS)THEN
25713 CALL HWHQCP(JJQ,IIQ,3142,12,*9)
25717 C...set up color connections: gg-scattering.
25719 & +(M2GGPL-M2GG*M2GGPL/(M2GGPL+M2GGMN)/FLOAT(NC)**2)*DIST*FACT
25720 IF(GENEV.AND.HCS.GT.RCS)CALL HWHQCP(IIQ,JJQ,2413,27,*9)
25722 & +(M2GGMN-M2GG*M2GGMN/(M2GGPL+M2GGMN)/FLOAT(NC)**2)*DIST*FACT
25723 IF(GENEV.AND.HCS.GT.RCS)CALL HWHQCP(IIQ,JJQ,4123,28,*9)
25729 C...generate event.
25733 C...incoming partons: now massive.
25734 EMIN1=RMASS(IDN(1))
25735 EMIN2=RMASS(IDN(2))
25736 C...redo initial state momenta in the partonic CM.
25737 PCM2=((SHAT-EMIN1*EMIN1-EMIN2*EMIN2)**2
25738 & -(2.*EMIN1*EMIN2)**2)/(4.*SHAT)
25740 P1(0)=SQRT(PCM2+EMIN1*EMIN1)
25744 P2(0)=SQRT(PCM2+EMIN2*EMIN2)
25748 C...randomly rotate final state momenta around beam axis.
25749 PHI=2.*PIFAC*HWRGEN(0)
25765 IF(L.EQ.1)QAUX(M)=QAUX(M)+ROT(M,N)*P3(N)
25766 IF(L.EQ.2)QAUX(M)=QAUX(M)+ROT(M,N)*P4(N)
25767 IF(L.EQ.3)QAUX(M)=QAUX(M)+ROT(M,N)*P5(N)
25771 IF(L.EQ.1)P3(M)=QAUX(M)
25772 IF(L.EQ.2)P4(M)=QAUX(M)
25773 IF(L.EQ.3)P5(M)=QAUX(M)
25776 C...use HWETWO only to set up status and IDs of quarks.
25779 CALL HWETWO(.TRUE.,.TRUE.)
25780 C...do real incoming, outgoing momenta in the lab frame.
25781 VCOL=(XX(1)-XX(2))/(XX(1)+XX(2))
25782 GCOL=(XX(1)+XX(2))/2./SQRT(XX(1)*XX(2))
25784 IF(M.EQ.NHEP-2)GO TO 888
25786 IF(M.EQ.NHEP-4)QAUX(N)=P1(N)
25787 IF(M.EQ.NHEP-3)QAUX(N)=P2(N)
25788 IF(M.EQ.NHEP-1)QAUX(N)=P3(N)*(1-FLIP)+P4(N)*FLIP
25789 IF(M.EQ.NHEP )QAUX(N)=P4(N)*(1-FLIP)+P3(N)*FLIP
25790 IF(M.EQ.NHEP+1)QAUX(N)=P5(N)
25793 PHEP(4,M)=GCOL*(QAUX(0)+VCOL*QAUX(3))
25794 PHEP(3,M)=GCOL*(QAUX(3)+VCOL*QAUX(0))
25799 C...needs to set all final state masses.
25800 PHEP(5,NHEP-1)=SQRT(ABS(PHEP(4,NHEP-1)**2
25801 & -PHEP(3,NHEP-1)**2
25802 & -PHEP(2,NHEP-1)**2
25803 & -PHEP(1,NHEP-1)**2))
25804 PHEP(5,NHEP )=SQRT(ABS(PHEP(4,NHEP )**2
25805 & -PHEP(3,NHEP )**2
25806 & -PHEP(2,NHEP )**2
25807 & -PHEP(1,NHEP )**2))
25808 PHEP(5,NHEP+1)=SQRT(ABS(PHEP(4,NHEP+1)**2
25809 & -PHEP(3,NHEP+1)**2
25810 & -PHEP(2,NHEP+1)**2
25811 & -PHEP(1,NHEP+1)**2))
25814 PHEP(I,NHEP-2)=PHEP(I,NHEP-4)+PHEP(I,NHEP-3)
25816 PHEP(5,NHEP-2)=SQRT(ABS(PHEP(4,NHEP-2)**2
25817 & -PHEP(3,NHEP-2)**2
25818 & -PHEP(2,NHEP-2)**2
25819 & -PHEP(1,NHEP-2)**2))
25820 C...status and IDs for Higgs.
25822 IDHW(NHEP+1)=IDN(5)
25823 IDHEP(NHEP+1)=IDPDG(IDN(5))
25824 C...Higgs colour (self-)connections.
25825 JMOHEP(1,NHEP+1)=NHEP-2
25826 JMOHEP(2,NHEP+1)=NHEP+1
25827 JDAHEP(2,NHEP+1)=NHEP+1
25828 JDAHEP(2,NHEP-2)=NHEP+1
25831 C...set to zero the coefficients of the spin density matrices.
25832 CALL HWVZRO(7,GCOEF)
25835 C-----------------------------------------------------------------------
25837 *CMZ :- -02/04/98 14.52.22 by Mike Seymour
25838 *-- Author : Mike Seymour
25839 *-- Modified: Stefano Moretti 04/05/98
25840 C-----------------------------------------------------------------------
25842 C-----------------------------------------------------------------------
25843 C HIGGS PRODUCTION VIA GLUON OR QUARK FUSION
25844 C MEAN EVWGT = HIGGS PRODN C-S * BRANCHING FRACTION IN NB
25845 C-----------------------------------------------------------------------
25846 INCLUDE 'HERWIG65.INC'
25847 DOUBLE PRECISION HWUALF,HWHIGT,HWRGEN,HWUSQR,HWUAEM,BRHIGQ,EMH,
25848 & CSFAC(13),EVSUM(13),EMFAC,CV,CA,BR,RWGT,E1,E2,EMQ,GFACTR,RQM(6)
25849 INTEGER IDEC,I,J,ID1,ID2
25850 EXTERNAL HWUALF,HWHIGT,HWRGEN,HWUSQR,HWUAEM
25851 SAVE CSFAC,BR,EVSUM
25853 RWGT=HWRGEN(0)*EVSUM(13)
25856 10 IF (RWGT.GT.EVSUM(I)) IDN(1)=I+1
25858 IF (IDN(1).LE.12) IDN(2)=IDN(1)-6
25859 IF (IDN(1).LE. 6) IDN(2)=IDN(1)+6
25864 EMH=RMASS(201+IHIGGS)
25866 IF(IMSSM.EQ.0)CALL HWHIGM(EMH,EMFAC)
25867 IF (EMH.LE.0 .OR. EMH.GE.PHEP(5,3)) RETURN
25869 IF (EMSCA.NE.EMLST) THEN
25871 XXMIN=(EMH/PHEP(5,3))**2
25873 GFACTR=GEV2NB*HWUAEM(EMH**2)/(576.*SWEIN*RMASS(198)**2)
25874 C--MOD BY BRW 16/07/03 TO USE RUNNING MASSES
25875 CALL HWURQM(EMH,RQM)
25878 CSFAC(I)=-GFACTR*HWHIGT( EMH)*XLMIN
25879 & *HWUALF(1,EMH)**2*EMFAC
25880 ELSEIF (I.GT.6) THEN
25881 CSFAC(I)=CSFAC(I-6)
25884 IF (EMQ.GT.ZERO.AND.EMH.GT.TWO*EMQ) THEN
25885 CSFAC(I)=-GFACTR*96.*PIFAC**2 *(1-(TWO*EMQ/EMH)**2)
25886 & *(EMQ/EMH)**2 *XLMIN *EMFAC*ENHANC(I)**2
25893 C INCLUDE BRANCHING RATIO OF HIGGS
25894 IDEC=MOD(IPROC,100)
25898 IF (IDEC.EQ.0) THEN
25901 30 BRHIGQ=BRHIGQ+BRHIG(I)
25903 ELSEIF (IDEC.EQ.10) THEN
25904 CALL HWDBOZ(198,ID1,ID2,CV,CA,BR,1)
25905 CALL HWDBOZ(199,ID1,ID2,CV,CA,BR,1)
25907 ELSEIF (IDEC.EQ.11) THEN
25908 CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,1)
25909 CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,1)
25911 ELSEIF (IDEC.LE.12) THEN
25916 CALL HWSGEN(.TRUE.)
25918 E1=PHEP(4,MAX(1,JDAHEP(1,1)))
25919 E2=PHEP(4,MAX(2,JDAHEP(1,2)))
25922 IF (EMH.GT.2*EMQ) THEN
25926 IF (XX(1).LT.0.5*(1-EMQ/E1+HWUSQR(1-2*EMQ/E1)) .AND.
25927 & XX(2).LT.0.5*(1-EMQ/E2+HWUSQR(1-2*EMQ/E2)))
25928 & EVWGT=EVWGT+DISF(I,1)*DISF(J,2)*CSFAC(I)*BR
25935 *CMZ :- -02/04/98 15.00.39 by Mike Seymour
25936 *-- Author : Mike Seymour
25937 C-----------------------------------------------------------------------
25938 FUNCTION HWHIGT(EMH)
25939 C-----------------------------------------------------------------------
25940 C CALCULATE MOD SQUARED I DEFINED AS IN BARGER & PHILLIPS p433
25941 C WARNING: THIS IS A FACTOR OF 3 GREATER THAN EHLQ'S ETA FUNCTION
25942 C PARITY=+1 FOR SCALAR AND -1 FOR PSEUDOSCALAR
25943 C-----------------------------------------------------------------------
25944 INCLUDE 'HERWIG65.INC'
25945 DOUBLE PRECISION HWHIGT,RATIO,RAT2,EMH,FREAL,FIMAG,ETALOG,AIREAL,
25949 IF (ABS(PARITY).NE.1) CALL HWWARN('HWHIGT',500,*999)
25952 C---CONTRIBUTION FROM QUARK LOOPS
25956 IF (RAT2.GT.0.25) THEN
25957 FREAL=-2.*ASIN(0.5/RATIO)**2
25959 ELSEIF (RAT2.LT.0.25) THEN
25960 ETALOG=LOG( (0.5+SQRT(0.25-RAT2)) / (0.5-SQRT(0.25-RAT2)) )
25961 FREAL=0.5 * (ETALOG**2 - PIFAC**2)
25962 FIMAG=PIFAC * ETALOG
25964 FREAL=0.5 * ( - PIFAC**2)
25967 IF (PARITY.EQ.1) THEN
25968 AIREAL=AIREAL+3*RAT2*(2 + (4*RAT2-1)*FREAL)*ENHANC(I)
25969 AIIMAG=AIIMAG+3*RAT2*( (4*RAT2-1)*FIMAG)*ENHANC(I)
25971 AIREAL=AIREAL-2*RAT2*(FREAL)*ENHANC(I)
25972 AIIMAG=AIIMAG-2*RAT2*(FIMAG)*ENHANC(I)
25975 C---CONTRIBUTION FROM SQUARK LOOPS
25983 IF (RAT2.GT.0.25) THEN
25984 FREAL=-2.*ASIN(0.5/RATIO)**2
25986 ELSEIF (RAT2.LT.0.25) THEN
25987 ETALOG=LOG( (0.5+SQRT(0.25-RAT2)) / (0.5-SQRT(0.25-RAT2)) )
25988 FREAL=0.5 * (ETALOG**2 - PIFAC**2)
25989 FIMAG=PIFAC * ETALOG
25991 FREAL=0.5 * ( - PIFAC**2)
25994 IF (PARITY.EQ.1) THEN
25995 AIREAL=AIREAL-3*RAT2*(1 + 2*RAT2*FREAL)*SENHNC(K)
25996 AIIMAG=AIIMAG-3*RAT2*( 2*RAT2*FIMAG)*SENHNC(K)
25999 C---FUNCTION RETURNS MOD-SQUARED OF SUM
26000 HWHIGT=AIREAL**2 + AIIMAG**2
26003 *CMZ :- -26/11/00 17.21.55 by Bryan Webber
26004 *-- Author : Stefano Moretti
26005 C-----------------------------------------------------------------------
26006 C...Generate completely differential cross section (EVWGT) in the variables
26007 C...X(I) with I=1,4 (see below) for the processes of ther series
26008 C...IPROC=2600,2700 as described in the HERWIG 6 documentation file.
26009 C...It includes interface to PDFs and takes into account color connections
26012 C...First release: 8-APR-1999 by Stefano Moretti
26015 C-----------------------------------------------------------------------
26016 C MSSM NEUTRAL HIGGS PRODUCTION IN ASSOCIATION WITH GAUGE BOSON
26017 C--BRW fix 27/8/04: corrected off-shell gauge boson mass dependence
26018 C-----------------------------------------------------------------------
26019 INCLUDE 'HERWIG65.INC'
26020 INTEGER I,J,K,L,M,N
26023 DOUBLE PRECISION CV,CA,BR
26024 DOUBLE PRECISION BRHIGQ,EMH,EMHWT,EMV,RMV,GAMV,RMH
26025 DOUBLE PRECISION X(4),XL(4),XU(4)
26026 DOUBLE PRECISION CT,ST,CCT
26027 DOUBLE PRECISION P1(0:3),P2(0:3),P3(0:3),P4(0:3)
26028 DOUBLE PRECISION ECM_MAX,ECM,SHAT,S,TAU
26029 DOUBLE PRECISION EMIN,PCM2,PCM,RCM2,RCM
26030 DOUBLE PRECISION QQV(12,12),C4W,VQ(12),AQ(12)
26031 DOUBLE PRECISION M2,M2L,M2T
26032 DOUBLE PRECISION ALPHA,EMSC2
26033 DOUBLE PRECISION HWRGEN,HWUAEM
26034 DOUBLE PRECISION RNMIN,RNMAX,THETA_MIN,THETA_MAX
26035 DOUBLE PRECISION EPS,HCS,RCS,FACT,DIST
26036 DOUBLE PRECISION WEIGHT
26037 DOUBLE PRECISION VSAVE,HSAVE,CFT,QR,QL
26038 SAVE EMH,EMV,HCS,M2,M2L,M2T,FACT,QQV,S,CT
26040 EXTERNAL HWHIGM,HWRGEN,HWUAEM,HWH2VH,HWETWO,HWRLOG
26041 PARAMETER (EPS=1.D-9)
26046 IF((MOD(IPROC,10000).EQ.3310).OR.
26047 & (MOD(IPROC,10000).EQ.3320))THEN
26049 ELSEIF((MOD(IPROC,10000).EQ.3360).OR.
26050 & (MOD(IPROC,10000).EQ.3370))THEN
26059 C...assign final state masses.
26060 RMV=RMASS(198+2*IV)
26061 RMH=RMASS(201+IHIGGS)
26062 IF(IV.EQ.0)GAMV=GAMW
26063 IF(IV.EQ.1)GAMV=GAMZ
26066 IF(IMSSM.EQ.0)CALL HWHIGM(EMH,EMHWT)
26067 C...energy at hadron level.
26068 ECM_MAX=PBEAM1+PBEAM2
26070 C...phase space variables.
26071 C...X(1)=COS(THETA_CM),
26072 C...X(2)=(1./SHAT-1./ECM_MAX**2)/(1./(EMV+EMH)**2-1./ECM_MAX**2),
26073 C...X(3)=(LOG(TAU)-LOG(X1))/LOG(TAU),
26074 C...X(4)=(THETA-THETA_MIN)/(THETA_MAX-THETA_MIN),
26075 C...where THETA=ATAN((EMV*EMV-RMV*RMV)/RMV/GAMV);
26076 C...phase space borders.
26085 C...single phase space point.
26089 X(I)=XL(I)+(XU(I)-XL(I))*HWRGEN(0)
26090 WEIGHT=WEIGHT*ABS(XU(I)-XL(I))
26092 C...resonant boson mass.
26093 RNMIN=RMV-GAMMAX*GAMV
26094 THETA_MIN=ATAN((RNMIN*RNMIN-RMV*RMV)/RMV/GAMV)
26096 THETA_MAX=ATAN((RNMAX*RNMAX-RMV*RMV)/RMV/GAMV)
26097 EMV=SQRT((TAN(X(4)*(THETA_MAX-THETA_MIN)+THETA_MIN))
26098 & *RMV*GAMV+RMV*RMV)
26099 C...energy at parton level.
26100 ECM=SQRT(1./(X(2)*(1./(EMV+EMH)**2-1./ECM_MAX**2)
26102 IF((EMH.LE.0.).OR.(EMH.GE.ECM))RETURN
26105 C...momentum fractions X1 and X2.
26106 XX(1)=EXP(LOG(TAU)*(1.-X(3)))
26108 C...two particle kinematics.
26110 IF(HWRLOG(HALF))THEN
26115 C...single phase space point.
26116 RCM2=((SHAT-EMV*EMV-EMH*EMH)**2
26117 & -(2.*EMV*EMH)**2)/(4.*SHAT)
26119 P3(0)=SQRT(RCM2+EMV*EMV)
26123 P4(0)=SQRT(RCM2+EMH*EMH)
26127 C...incoming partons: massless.
26129 C...initial state momenta in the partonic CM.
26130 PCM2=((SHAT-EMIN*EMIN-EMIN*EMIN)**2
26131 & -(2.*EMIN*EMIN)**2)/(4.*SHAT)
26133 P1(0)=SQRT(PCM2+EMIN*EMIN)
26137 P2(0)=SQRT(PCM2+EMIN*EMIN)
26141 C...color structured ME summed/averaged over final/initial spins and colors.
26142 CALL HWH2VH(P1,P2,P3,P4,EMV,M2,M2L,M2T)
26144 C...vector-axial couplings of V to qq'/qq.
26155 c bug fix 20/05/01 SM.
26162 ELSE IF(IV.EQ.1)THEN
26163 C4W=(1.-SWEIN)*(1.-SWEIN)
26165 VQ(I)=2.*VFCH(1,1)*SQRT(SWEIN)*SQRT(1.-SWEIN)
26166 AQ(I)=2.*AFCH(1,1)*SQRT(SWEIN)*SQRT(1.-SWEIN)
26169 QQV(I,J)=(VQ(I)*VQ(I)+AQ(I)*AQ(I))/C4W
26172 VQ(I)=2.*VFCH(2,1)*SQRT(SWEIN)*SQRT(1.-SWEIN)
26173 AQ(I)=2.*AFCH(2,1)*SQRT(SWEIN)*SQRT(1.-SWEIN)
26176 QQV(I,J)=(VQ(I)*VQ(I)+AQ(I)*AQ(I))/C4W
26179 C...constant factors: phi along beam and conversion GeV^2->nb.
26180 FACT=2.*PIFAC*GEV2NB
26181 C...Jacobians from X1,X2 to X(2),X(3)
26182 FACT=FACT/S*(-LOG(TAU))*(1./(EMV+EMH)**2-1./ECM_MAX**2)
26183 C...phase space Jacobians, pi's and flux.
26184 FACT=FACT/64./PIFAC/PIFAC*RCM/PCM
26188 ALPHA=HWUAEM(EMSC2)
26189 C--BRW fix 27/8/04: RMV*RMV --> EMV*EMV
26190 FACT=FACT*16.*PIFAC**2*ALPHA**2/SWEIN/SWEIN*EMV*EMV
26191 C...enhancement factor for MSSM.
26192 FACT=FACT*ENHANC(10+IV)*ENHANC(10+IV)
26193 C...Higgs resonance.
26195 C...vector boson resonance.
26196 FACT=FACT*(THETA_MAX-THETA_MIN)/PIFAC
26197 C...constant weight.
26199 C...include BR of Higgs.
26201 IDEC=MOD(IPROC,100)
26202 IF (IDEC.GT.0.AND.IDEC.LE.12) FACT=FACT*BRHIG(IDEC)
26203 IF (IDEC.EQ.0) THEN
26206 BRHIGQ=BRHIGQ+BRHIG(I)
26210 c bug fix 11/10/02 SM.
26211 IF (IDEC.EQ.10) THEN
26212 CALL HWDBOZ(198,ID1,ID2,CV,CA,BR,1)
26213 CALL HWDBOZ(199,ID1,ID2,CV,CA,BR,1)
26215 ELSEIF (IDEC.EQ.11) THEN
26216 CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,1)
26217 CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,1)
26225 CALL HWSGEN(.FALSE.)
26227 IF(DISF(I,1).LT.EPS)THEN
26233 J=I+L*6+(-1)**(I+1)
26234 ELSE IF(IV.EQ.1)THEN
26237 IF(DISF(J,2).LT.EPS)THEN
26240 DIST=DISF(I,1)*DISF(J,2)*S
26241 C...QQV vector and axial couplings.
26243 C...no need to set up color connections.
26244 HCS=HCS+M2*DIST*FACT
26245 IF(GENEV.AND.HCS.GT.RCS)THEN
26246 C...generate event.
26250 & IDN(3)=NINT(198.5-.1667*FLOAT(ICHRG(IDN(1))+ICHRG(IDN(2))))
26251 IF(IV.EQ.1)IDN(3)=200
26259 C...trick HWETWO in using off-shell V and H masses.
26260 VSAVE=RMASS(IDN(3))
26261 HSAVE=RMASS(IDN(4))
26264 C-- BRW fix 27/8/04: avoid double smearing of W and H masses
26265 CALL HWETWO(.FALSE.,.FALSE.)
26266 RMASS(IDN(3))=VSAVE
26267 RMASS(IDN(4))=HSAVE
26269 C...set to zero the coefficients of the spin density matrices.
26270 CALL HWVZRO(7,GCOEF)
26272 C...calculates exactly polarized decay matrix of gauge boson.
26273 IF(IERROR.NE.0)RETURN
26276 IF(M2L.LT.0.)M2L=0.
26277 IF(M2T.LT.0.)M2T=0.
26278 RHOHEP(2,NHEP-1)=M2L/M2
26279 CFT=(M2-M2L)/(1.+CCT**2)/2.
26281 RHOHEP(1,NHEP-1)=CFT*(1.+CCT)**2/M2
26282 RHOHEP(3,NHEP-1)=CFT*(1.-CCT)**2/M2
26283 ELSE IF(IV.EQ.1)THEN
26284 QR=(VQ(I)-AQ(I))/2.
26285 QL=(VQ(I)+AQ(I))/2.
26286 RHOHEP(1,NHEP-1)=CFT*(QR**2*(1.-CCT)**2+QL**2*(1.+CCT)**2)
26287 & /(QR**2+QL**2)/M2
26288 RHOHEP(3,NHEP-1)=CFT*(QR**2*(1.+CCT)**2+QL**2*(1.-CCT)**2)
26289 & /(QR**2+QL**2)/M2
26299 *CMZ :- -26/04/91 14.55.44 by Federico Carminati
26300 *-- Author : Mike Seymour, modified by Stefano Moretti
26301 C-----------------------------------------------------------------------
26303 C-----------------------------------------------------------------------
26304 C HIGGS PRODUCTION VIA W/Z BOSON FUSION
26305 C MEAN EVWGT = HIGGS PRODN C-S * BRANCHING FRACTION IN NB
26306 C-----------------------------------------------------------------------
26307 INCLUDE 'HERWIG65.INC'
26308 DOUBLE PRECISION HWULDO,HWRUNI,HWRGEN,HWUAEM,K1MAX2,K1MIN2,K12,
26309 & K2MAX2,K2MIN2,K22,EMW2,EMW,ROOTS,EMH2,EMH,ROOTS2,P1,PHI1,PHI2,
26310 & COSPHI,COSTH1,SINTH1,COSTH2,SINTH2,P2,WEIGHT,TAU,TAULN,CSFAC,
26311 & PSUM,PROB,Q1(5),Q2(5),H(5),A,B,C,TERM2,BRHIGQ,G1WW,G2WW,G1ZZ(6),
26312 & G2ZZ(6),AWW,AZZ(6),PWW,PZZ(6),EMZ,EMZ2,RSUM,GLUSQ,GRUSQ,GLDSQ,
26313 & GRDSQ,GLESQ,GRESQ,CW,CZ,EMFAC,CV,CA,BR,X2,ETA,P1JAC,FACTR,EH2
26314 INTEGER HWRINT,IDEC,I,ID1,ID2,IHAD
26316 EXTERNAL HWULDO,HWRUNI,HWRGEN,HWUAEM,HWRINT
26317 SAVE EMW2,EMZ2,EE,GLUSQ,GRUSQ,GLDSQ,GRDSQ,GLESQ,GRESQ,G1ZZ,G2ZZ,
26318 & G1WW,G2WW,CW,CZ,PSUM,AWW,PWW,AZZ,PZZ,ROOTS,Q1,Q2,H,FACTR
26319 EQUIVALENCE (EMW,RMASS(198)),(EMZ,RMASS(200))
26321 IF (JDAHEP(1,IHAD).NE.0) IHAD=JDAHEP(1,IHAD)
26325 GLUSQ=(VFCH(2,1)+AFCH(2,1))**2
26326 GRUSQ=(VFCH(2,1)-AFCH(2,1))**2
26327 GLDSQ=(VFCH(1,1)+AFCH(1,1))**2
26328 GRDSQ=(VFCH(1,1)-AFCH(1,1))**2
26329 GLESQ=(VFCH(11,1)+AFCH(11,1))**2
26330 GRESQ=(VFCH(11,1)-AFCH(11,1))**2
26331 G1ZZ(1)=GLUSQ*GLUSQ+GRUSQ*GRUSQ
26332 G2ZZ(1)=GLUSQ*GRUSQ+GRUSQ*GLUSQ
26333 G1ZZ(2)=GLUSQ*GLDSQ+GRUSQ*GRDSQ
26334 G2ZZ(2)=GLUSQ*GRDSQ+GRUSQ*GLDSQ
26335 G1ZZ(3)=GLDSQ*GLDSQ+GRDSQ*GRDSQ
26336 G2ZZ(3)=GLDSQ*GRDSQ+GRDSQ*GLDSQ
26337 G1ZZ(4)=GLESQ*GLESQ+GRESQ*GRESQ
26338 G2ZZ(4)=GLESQ*GRESQ+GRESQ*GLESQ
26339 G1ZZ(5)=GLESQ*GLUSQ+GRESQ*GRUSQ
26340 G2ZZ(5)=GLESQ*GRUSQ+GRESQ*GLUSQ
26341 G1ZZ(6)=GLESQ*GLDSQ+GRESQ*GRDSQ
26342 G2ZZ(6)=GLESQ*GRDSQ+GRESQ*GLDSQ
26345 FACTR=GEV2NB/(128.*PIFAC**3)
26346 EH2=RMASS(201+IHIGGS)**2
26347 CW=256*(PIFAC*HWUAEM(EH2)/SWEIN)**3*EMW2
26348 CZ=256.*(PIFAC*HWUAEM(EH2))**3*EMZ2/(SWEIN*(1.-SWEIN))
26352 IF (.NOT.GENEV) THEN
26353 C---CHOOSE PARAMETERS
26355 EMH=RMASS(201+IHIGGS)
26357 IF(IMSSM.EQ.0)CALL HWHIGM(EMH,EMFAC)
26358 IF (EMH.LE.ZERO .OR. EMH.GE.PHEP(5,3)) RETURN
26363 TAU=(EMH/PHEP(5,3))**2
26365 ROOTS=PHEP(5,3)*SQRT(EXP(HWRUNI(0,-1D-10,TAULN)))
26369 C---CHOOSE P1 ACCORDING TO (1-ETA)*(ETA-X2)/ETA**2
26370 C WHERE ETA=1-2P1/ROOTS AND X2=EMH**2/S
26372 1 ETA=X2**HWRGEN(0)
26373 IF (HWRGEN(0)*(1-EMH/ROOTS)**2*ETA.GT.(1-ETA)*(ETA-X2))GOTO 1
26374 P1JAC=0.5*ROOTS*ETA**2/((1-ETA)*(ETA-X2))
26375 & *(-LOG(X2)*(1+X2)-2*(1-X2))
26376 P1=0.5*ROOTS*(1-ETA)
26377 C---CHOOSE PHI1,2 UNIFORMLY
26378 PHI1=2*PIFAC*HWRGEN(0)
26379 PHI2=2*PIFAC*HWRGEN(0)
26380 COSPHI=COS(PHI2-PHI1)
26381 C---CHOOSE K1^2, ON PROPAGATOR FACTOR
26384 K12=EMW2-(EMW2+K1MAX2)*(EMW2+K1MIN2)/
26385 & ((K1MAX2-K1MIN2)*HWRGEN(0)+(EMW2+K1MIN2))
26386 C---CALCULATE COSTH1 FROM K1^2
26387 COSTH1=1+K12/(P1*ROOTS)
26388 SINTH1=SQRT(1-COSTH1**2)
26390 K2MAX2=ROOTS*(ROOTS2-EMH2-2*ROOTS*P1)*(ROOTS-P1-P1*COSTH1)
26391 & /((ROOTS-P1)**2-(P1*COSTH1)**2-(P1*SINTH1*COSPHI)**2)
26393 K22=EMW2-(EMW2+K2MAX2)*(EMW2+K2MIN2)/
26394 & ((K2MAX2-K2MIN2)*HWRGEN(0)+(EMW2+K2MIN2))
26395 C---CALCULATE A,B,C FACTORS, AND...
26396 A=-2*K22*P1*COSTH1 - ROOTS*(ROOTS2-EMH2-2*ROOTS*P1)
26397 B=-2*K22*P1*SINTH1*COSPHI
26398 C=+2*K22*P1 - 2*ROOTS*K22 - ROOTS*(ROOTS2-EMH2-2*ROOTS*P1)
26399 C---SOLVE A*COSTH2 + B*SINTH2 + C = 0 FOR COSTH2
26400 TERM2=B**2 + A**2 - C**2
26401 IF (TERM2.LT.ZERO) RETURN
26402 TERM2=B*SQRT(TERM2)
26403 IF (A.GE.ZERO) RETURN
26404 COSTH2=(-A*C + TERM2)/(A**2+B**2)
26405 SINTH2=SQRT(1-COSTH2**2)
26406 C---FINALLY, GET P2
26407 IF (COSTH2.EQ.-ONE) RETURN
26408 P2=-K22/(ROOTS*(1+COSTH2))
26409 C---LOAD UP CMF MOMENTA
26410 Q1(1)=P1*SINTH1*COS(PHI1)
26411 Q1(2)=P1*SINTH1*SIN(PHI1)
26415 Q2(1)=P2*SINTH2*COS(PHI2)
26416 Q2(2)=P2*SINTH2*SIN(PHI2)
26423 H(4)=-Q1(4)-Q2(4)+ROOTS
26425 C---CALCULATE MATRIX ELEMENTS SQUARED
26426 AWW=ENHANC(10)**2 * CW*(ROOTS2/2*HWULDO(Q1,Q2)*G1WW
26427 & +ROOTS2/4*P1*P2*(1+COSTH1)*(1-COSTH2)*G2WW)
26429 AZZ(I)=ENHANC(11)**2 * CZ*(ROOTS2/2*HWULDO(Q1,Q2)*G1ZZ(I)
26430 & +ROOTS2/4*P1*P2*(1+COSTH1)*(1-COSTH2)*G2ZZ(I))
26431 & *((K12-EMW2)/(K12-EMZ2)*(K22-EMW2)/(K22-EMZ2))**2
26433 C---CALCULATE WEIGHT IN INTEGRAL
26434 WEIGHT=FACTR*P2*P1JAC/(ROOTS2**2*HWULDO(H,Q2))
26435 & *(K1MAX2-K1MIN2)/((K1MAX2+EMW2)*(K1MIN2+EMW2))
26436 & *(K2MAX2-K2MIN2)/((K2MAX2+EMW2)*(K2MIN2+EMW2))
26439 XXMIN=(ROOTS/PHEP(5,3))**2
26441 C---INCLUDE BRANCHING RATIO OF HIGGS
26443 IDEC=MOD(IPROC,100)
26444 IF (IDEC.GT.0.AND.IDEC.LE.12) WEIGHT=WEIGHT*BRHIG(IDEC)
26445 IF (IDEC.EQ.0) THEN
26448 20 BRHIGQ=BRHIGQ+BRHIG(I)
26449 WEIGHT=WEIGHT*BRHIGQ
26451 IF (IDEC.EQ.10) THEN
26452 CALL HWDBOZ(198,ID1,ID2,CV,CA,BR,1)
26453 CALL HWDBOZ(199,ID1,ID2,CV,CA,BR,1)
26455 ELSEIF (IDEC.EQ.11) THEN
26456 CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,1)
26457 CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,1)
26466 CSFAC=-WEIGHT*TAULN
26469 CALL HWSFUN(XX(2),EMSCA,IDHW(IHAD),NSTRU,DISF(1,2),2)
26470 IF (IDHW(1).LE.126) THEN
26471 PWW=(DISF(2,2)+DISF(4,2)+DISF(7,2)+DISF( 9,2))*AWW
26473 PWW=(DISF(1,2)+DISF(3,2)+DISF(8,2)+DISF(10,2))*AWW
26475 PZZ(5)=(DISF(2,2)+DISF(4,2)+DISF(8,2)+DISF(10,2))*AZZ(5)
26476 PZZ(6)=(DISF(1,2)+DISF(3,2)+DISF(7,2)+DISF( 9,2))*AZZ(6)
26477 PSUM=PWW+PZZ(5)+PZZ(6)
26480 CSFAC=WEIGHT*TAULN*XLMIN
26481 CALL HWSGEN(.TRUE.)
26482 PWW=((DISF(2,1)+DISF(4, 1)+DISF(7,1)+DISF(9,1))
26483 & *(DISF(8,2)+DISF(10,2)+DISF(1,2)+DISF(3,2))
26484 & +(DISF(8,1)+DISF(10,1)+DISF(1,1)+DISF(3,1))
26485 & *(DISF(2,2)+DISF(4, 2)+DISF(7,2)+DISF(9,2)))
26487 PZZ(1)=((DISF(2,1)+DISF(4,1)+DISF(8,1)+DISF(10,1))
26488 & *(DISF(2,2)+DISF(4,2)+DISF(8,2)+DISF(10,2)))
26490 PZZ(2)=((DISF(2,1)+DISF(4,1)+DISF(8,1)+DISF(10,1))
26491 & *(DISF(1,2)+DISF(3,2)+DISF(7,2)+DISF(9, 2))
26492 & +(DISF(1,1)+DISF(3,1)+DISF(7,1)+DISF(9, 1))
26493 & *(DISF(2,2)+DISF(4,2)+DISF(8,2)+DISF(10,2)))
26495 PZZ(3)=((DISF(1,1)+DISF(3,1)+DISF(7,1)+DISF(9,1))
26496 & *(DISF(1,2)+DISF(3,2)+DISF(7,2)+DISF(9,2)))
26498 PSUM=PWW+PZZ(1)+PZZ(2)+PZZ(3)
26499 C---EVENT WEIGHT IS SUM OVER ALL COMBINATIONS
26504 C---CHOOSE EVENT TYPE
26505 RSUM=PSUM*HWRGEN(0)
26506 C---ELECTRON BEAMS?
26511 IF (RSUM.LT.AWW) THEN
26519 C---LEPTON-HADRON COLLISION?
26523 IF (RSUM.LT.PWW) THEN
26524 24 IDN(2)=HWRINT(1,8)
26525 IF (IDN(2).GE.5) IDN(2)=IDN(2)+2
26526 IF (ICHRG(IDN(1))*ICHRG(IDN(2)).GT.0) GOTO 24
26527 PROB=DISF(IDN(2),2)*AWW/PWW
26528 IF (HWRGEN(0).GT.PROB) GOTO 24
26530 IF (HWRGEN(0).GT.SCABI) THEN
26531 IDN(4)= 4*INT((IDN(2)-1)/2)-IDN(2)+3
26533 IDN(4)=12*INT((IDN(2)-1)/6)-IDN(2)+5
26535 C---ZZ FUSION FROM U-TYPE QUARK?
26536 ELSEIF (RSUM.LT.PWW+PZZ(5)) THEN
26537 26 IDN(2)=2*HWRINT(1,4)
26538 IF (IDN(2).GE.5) IDN(2)=IDN(2)+2
26539 PROB=DISF(IDN(2),2)*AZZ(5)/PZZ(5)
26540 IF (HWRGEN(0).GT.PROB) GOTO 26
26543 C---ZZ FUSION FROM D-TYPE QUARK?
26545 28 IDN(2)=2*HWRINT(1,4)-1
26546 IF (IDN(2).GE.5) IDN(2)=IDN(2)+2
26547 PROB=DISF(IDN(2),2)*AZZ(6)/PZZ(6)
26548 IF (HWRGEN(0).GT.PROB) GOTO 28
26555 IF (RSUM.LT.PWW) THEN
26558 IF (IDN(I).GE.5) IDN(I)=IDN(I)+2
26560 IF (ICHRG(IDN(1))*ICHRG(IDN(2)).GT.0) GOTO 31
26561 PROB=DISF(IDN(1),1)*DISF(IDN(2),2)*AWW/PWW
26562 IF (HWRGEN(0).GT.PROB) GOTO 31
26563 C---CHOOSE OUTGOING QUARKS
26565 IF (HWRGEN(0).GT.SCABI) THEN
26566 IDN(I+2)=4*INT((IDN(I)-1)/2)-IDN(I)+3
26568 IDN(I+2)=12*INT((IDN(I)-1)/6)-IDN(I)+5
26571 C---ZZ FUSION FROM U-TYPE QUARKS?
26572 ELSEIF (RSUM.LT.PWW+PZZ(1)) THEN
26574 IDN(I)=2*HWRINT(1,4)
26575 IF (IDN(I).GE.5) IDN(I)=IDN(I)+2
26577 PROB=DISF(IDN(1),1)*DISF(IDN(2),2)*AZZ(1)/PZZ(1)
26578 IF (HWRGEN(0).GT.PROB) GOTO 41
26581 C---ZZ FUSION FROM D-TYPE QUARKS?
26582 ELSEIF (RSUM.LT.PWW+PZZ(1)+PZZ(3)) THEN
26584 IDN(I)=2*HWRINT(1,4)-1
26585 IF (IDN(I).GE.5) IDN(I)=IDN(I)+2
26587 PROB=DISF(IDN(1),1)*DISF(IDN(2),2)*AZZ(3)/PZZ(3)
26588 IF (HWRGEN(0).GT.PROB) GOTO 51
26591 C---ZZ FUSION FROM UD-TYPE PAIRS?
26593 61 IF (HWRGEN(0).GT.HALF) THEN
26594 IDN(1)=2*HWRINT(1,4)-1
26595 IDN(2)=2*HWRINT(1,4)
26597 IDN(1)=2*HWRINT(1,4)
26598 IDN(2)=2*HWRINT(1,4)-1
26601 62 IF (IDN(I).GE.5) IDN(I)=IDN(I)+2
26602 PROB=DISF(IDN(1),1)*DISF(IDN(2),2)*AZZ(2)/PZZ(2)
26603 IF (HWRGEN(0).GT.PROB) GOTO 61
26608 C---NOW BOOST TO LAB, AND SET UP STATUS CODES etc
26611 IF (.NOT.EE) CALL HWEONE
26613 JDAHEP(1,NHEP)=NHEP+1
26614 JDAHEP(2,NHEP)=NHEP+3
26615 JMOHEP(1,NHEP+1)=NHEP
26616 JMOHEP(1,NHEP+2)=NHEP
26617 JMOHEP(1,NHEP+3)=NHEP
26618 C---OUTGOING MOMENTA (GIVE QUARKS MASS NON-COVARIANTLY!)
26619 Q1(5)=RMASS(IDN(1))
26620 Q1(4)=SQRT(Q1(4)**2+Q1(5)**2)
26621 Q2(5)=RMASS(IDN(2))
26622 Q2(4)=SQRT(Q2(4)**2+Q2(5)**2)
26623 H(4)=-Q1(4)-Q2(4)+PHEP(5,NHEP)
26625 CALL HWULOB(PHEP(1,NHEP),Q1,PHEP(1,NHEP+1))
26626 CALL HWULOB(PHEP(1,NHEP),Q2,PHEP(1,NHEP+2))
26627 CALL HWULOB(PHEP(1,NHEP),H,PHEP(1,NHEP+3))
26632 IDHW(NHEP+1)=IDN(3)
26633 IDHEP(NHEP+1)=IDPDG(IDN(3))
26634 IDHW(NHEP+2)=IDN(4)
26635 IDHEP(NHEP+2)=IDPDG(IDN(4))
26636 IDHW(NHEP+3)=201+IHIGGS
26637 IDHEP(NHEP+3)=IDPDG(201+IHIGGS)
26639 JMOHEP(2,NHEP+1)=NHEP-2
26640 JMOHEP(2,NHEP+2)=NHEP-1
26641 JMOHEP(2,NHEP-1)=NHEP+2
26642 JMOHEP(2,NHEP-2)=NHEP+1
26643 JMOHEP(2,NHEP+3)=NHEP+3
26644 JDAHEP(2,NHEP+1)=NHEP-2
26645 JDAHEP(2,NHEP+2)=NHEP-1
26646 JDAHEP(2,NHEP-1)=NHEP+2
26647 JDAHEP(2,NHEP-2)=NHEP+1
26648 JDAHEP(2,NHEP+3)=NHEP+3
26653 *CMZ :- -26/04/91 13.37.37 by Federico Carminati
26654 *-- Author : Mike Seymour
26655 C-----------------------------------------------------------------------
26656 FUNCTION HWHIGY(A,B,XP)
26657 C-----------------------------------------------------------------------
26658 C CALCULATE THE INTEGRAL OF BERENDS AND KLEISS APPENDIX B
26659 C-----------------------------------------------------------------------
26661 DOUBLE COMPLEX XQ,Z1,Z2,Z3,Z4,C0,C1,C2,C3,C4,C5,C6,C7,C8,FUN,Z
26662 DOUBLE PRECISION HWHIGY,TWO,A,B,XP,Y
26663 PARAMETER (TWO=2.D0)
26664 C---DECLARE ALL THE STATEMENT-FUNCTION DEFINITIONS
26665 C0(Z,A)=(Z**2-A)**2*((Z**2+A)**2-24*Z*(Z**2+A)+8*Z**2*(A+6))/Z**4
26667 C2(Z,A)=-A**3*(24*Z-A)/(2*Z**2)
26668 C3(Z,A)=A**2*(8*Z**2*(A+6)-24*A*Z+A**2)/Z**3
26669 C4(Z,A)=-A**2*(24*Z**3+8*Z**2*(A+6)-24*A*Z+A**2)/Z**4
26670 C5(Z,A)=Z**3-24*Z**2+8*Z*(A+6)+24*A
26671 C6(Z,A)=0.5*Z**2-12*Z+4*(A+6)
26674 FUN(Z,Y,A)=C0(Z,A)*LOG(Y-Z)
26683 C---NOW EVALUATE THE INTEGRAL
26687 Z1=XQ+SQRT(XQ**2-A)
26688 Z2=XQ-SQRT(XQ**2-A)
26689 Z3=FUN(Z1,TWO,A)-FUN(Z1,SQRT(A),A)
26690 Z4=FUN(Z2,TWO,A)-FUN(Z2,SQRT(A),A)
26691 HWHIGY=DIMAG((Z3-Z4)/(Z1-Z2))/(8*B)
26694 *CMZ :- -02/05/91 11.18.44 by Federico Carminati
26695 *-- Author : Mike Seymour, modified by Stefano Moretti
26696 C-----------------------------------------------------------------------
26698 C-----------------------------------------------------------------------
26699 C HIGGS PRODUCTION VIA THE BJORKEN PROCESS: E+E- --> Z(*) --> Z(*)H
26700 C WHERE ONE OR BOTH OF THE Zs IS OFF-SHELL
26701 C USES ALGORITHM OF BERENDS AND KLEISS: NUCL.PHYS. B260(1985)32
26703 C MEAN EVWGT = CROSS-SECTION (IN NB) * HIGGS BRANCHING FRACTION
26704 C-----------------------------------------------------------------------
26705 INCLUDE 'HERWIG65.INC'
26706 DOUBLE PRECISION HWUAEM,HWHIGY,HWRUNI,HWRGEN,HWULDO,EMZ,CVE,CAE,
26707 & POL1,POL2,CE1,CE2,CE3,PMAX,EMZ2,S,B,FACTR,EMH,EMFAC,EMH2,A,XP,
26708 & CV,CA,BRHIGQ,BR,X1,X2,FAC1,FAC2,XPP,XPPSQ,COEF,X,XSQ,PROB,C1,C2,
26709 & CHIGG,PTHETA,SHIGG,C3,PHIMAX,CPHI,SPHI,C2PHI,S2PHI,PCM,ELST
26710 INTEGER IDEC,I,NLOOP,ICMF,IHIG,IZED,IFER,IANT,ID1,ID2,IN1,IN2
26711 EXTERNAL HWUAEM,HWHIGY,HWRUNI,HWRGEN,HWULDO
26712 SAVE CVE,CAE,CE1,CE2,CE3,PMAX,EMZ2,S,EMH,B,FACTR,A,EMH2
26713 EQUIVALENCE (EMZ,RMASS(200))
26715 C---SET UP CONSTANTS
26717 IF (JDAHEP(1,IN1).NE.0) IN1=JDAHEP(1,IN1)
26719 IF (JDAHEP(1,IN2).NE.0) IN2=JDAHEP(1,IN2)
26720 IF (FSTWGT.OR.ELST.NE.PHEP(5,3)) THEN
26724 POL1=1.-EPOLN(3)*PPOLN(3)
26725 POL2=EPOLN(3)-PPOLN(3)
26726 CE1=(POL1*(CVE**2+CAE**2)+POL2*2.*CVE*CAE)
26727 CE2=(POL1*2.*CVE*CAE+POL2*(CVE**2+CAE**2))
26728 IF ((IDHW(IN1).GT.IDHW(IN2).AND.PHEP(3,IN1).LT.ZERO).OR.
26729 & (IDHW(IN2).GT.IDHW(IN1).AND.PHEP(3,IN2).LT.ZERO)) CE2=-CE2
26730 IF (TPOL) CE3=(CVE**2-CAE**2)
26735 FACTR=GEV2NB*CE1*(HWUAEM(RMASS(201+IHIGGS)**2)*ENHANC(11))**2
26736 & /(12.*S*SWEIN*(1.-SWEIN))*B/((1-EMZ2/S)**2+B**2)
26738 IF (.NOT.GENEV) THEN
26739 C---CHOOSE HIGGS MASS, AND CALCULATE EVENT WEIGHT
26741 EMH=RMASS(201+IHIGGS)
26743 IF(IMSSM.EQ.0)CALL HWHIGM(EMH,EMFAC)
26744 IF (EMH.LE.ZERO .OR. EMH.GT.PHEP(5,3)) RETURN
26749 EVWGT=FACTR*HWHIGY(A,B,XP)*EMFAC
26750 C---INCLUDE BRANCHING RATIO OF HIGGS
26752 IDEC=MOD(IPROC,100)
26753 IF (IDEC.GT.0.AND.IDEC.LE.12) EVWGT=EVWGT*BRHIG(IDEC)
26754 IF (IDEC.EQ.0) THEN
26757 10 BRHIGQ=BRHIGQ+BRHIG(I)
26760 C Add Z branching fractions
26761 CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,0)
26763 IF (IDEC.EQ.10) THEN
26764 CALL HWDBOZ(198,ID1,ID2,CV,CA,BR,1)
26765 CALL HWDBOZ(199,ID1,ID2,CV,CA,BR,1)
26767 ELSEIF (IDEC.EQ.11) THEN
26768 CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,1)
26769 CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,1)
26780 CALL HWVEQU(5,PHEP(1,3),PHEP(1,ICMF))
26782 C---CHOOSE ENERGY FRACTION OF HIGGS
26786 FAC1=ATAN((X1-XP)/B)
26787 FAC2=ATAN((X2-XP)/B)
26788 XPP=MIN(X2,MAX(X1+B,XP))
26791 COEF=1./((12+2*A-12*XPP+XPPSQ)*SQRT(XPPSQ-A))
26793 IF (NLOOP.GT.NBTRY) CALL HWWARN('HWHIGZ',101,*999)
26794 X=XP+B*TAN(HWRUNI(1,FAC1,FAC2))
26796 PROB=COEF*((12+2*A-12*X+XSQ)*SQRT(XSQ-A))
26797 IF (PROB.GT.PMAX) THEN
26799 CALL HWWARN('HWHIGZ',1,*999)
26801 21 FORMAT(7X,'NEW HWHIGZ MAX WEIGHT =',F8.4)
26803 IF (PROB.LT.PMAX*HWRGEN(0)) GOTO 20
26804 C Choose Z decay mode
26805 CALL HWDBOZ(200,IDHW(IFER),IDHW(IANT),CV,CA,BR,0)
26806 C1=CE1*(CV**2+CA**2)
26808 C---CHOOSE HIGGS DIRECTION
26809 C First polar angle
26811 COEF=(XSQ-A)/(8.*(1.-X)+XSQ+A)
26813 IF (NLOOP.GT.NBTRY) CALL HWWARN('HWHIGZ',102,*999)
26814 CHIGG=HWRUNI(2,-ONE, ONE)
26815 PTHETA=1-COEF*CHIGG**2
26816 IF (PTHETA.LT.HWRGEN(1)) GOTO 30
26817 SHIGG=SQRT(1-CHIGG**2)
26818 C Now azimuthal angle
26820 C3=CE3*(CV*2+CA**2)
26821 COEF=COEF*SHIGG**2*C3/C1
26822 PHIMAX=PTHETA+ABS(COEF)
26823 40 CALL HWRAZM(ONE,CPHI,SPHI)
26824 C2PHI=2.*CPHI**2-1.
26826 PROB=PTHETA-COEF*(C2PHI*COSS+S2PHI*SINS)
26827 IF (PROB.LT.HWRGEN(1)*PHIMAX) GOTO 40
26829 CALL HWRAZM(ONE,CPHI,SPHI)
26831 C Construct Higgs and Z momenta
26833 PHEP(4,IHIG)=X*PHEP(5,ICMF)/2
26834 PCM=SQRT(PHEP(4,IHIG)**2-EMH2)
26835 PHEP(3,IHIG)=CHIGG*PCM
26836 PHEP(1,IHIG)=SHIGG*PCM*CPHI
26837 PHEP(2,IHIG)=SHIGG*PCM*SPHI
26838 CALL HWVDIF(4,PHEP(1,ICMF),PHEP(1,IHIG),PHEP(1,IZED))
26839 CALL HWUMAS(PHEP(1,IZED))
26840 C Choose orientation of Z decay
26842 COEF=2.*(C1+ABS(C2))*HWULDO(PHEP(1,IN1),PHEP(1,IZED))
26843 & *HWULDO(PHEP(1,IN2),PHEP(1,IZED))/S
26844 IF (TPOL) COEF=COEF*(C1+ABS(C2)+ABS(C3))/(C1+ABS(C2))
26849 IF (NLOOP.GT.NBTRY) CALL HWWARN('HWHIGZ',103,*999)
26850 CALL HWDTWO(PHEP(1,IZED),PHEP(1,IFER),PHEP(1,IANT),
26852 PROB=C1*(PHEP(4,IFER)*PHEP(4,IANT)-PHEP(3,IFER)*PHEP(3,IANT))
26853 & +C2*(PHEP(4,IFER)*PHEP(3,IANT)-PHEP(3,IFER)*PHEP(4,IANT))
26854 IF (TPOL) PROB=PROB+C3*
26855 & (COSS*(PHEP(1,IFER)*PHEP(1,IANT)-PHEP(2,IFER)*PHEP(2,IANT))
26856 & +SINS*(PHEP(1,IFER)*PHEP(2,IANT)+PHEP(2,IFER)*PHEP(1,IANT)))
26857 IF (PROB.LT.HWRGEN(2)*COEF) GOTO 50
26858 C---SET UP STATUS CODES,
26864 C---COLOR CONNECTIONS,
26867 JDAHEP(1,ICMF)=IHIG
26868 JDAHEP(2,ICMF)=IZED
26869 JMOHEP(1,IHIG)=ICMF
26870 JMOHEP(1,IZED)=ICMF
26871 JMOHEP(1,IFER)=IZED
26872 JMOHEP(1,IANT)=IZED
26873 JMOHEP(2,IFER)=IANT
26874 JMOHEP(2,IANT)=IFER
26875 JDAHEP(1,IZED)=IFER
26876 JDAHEP(2,IZED)=IANT
26877 JDAHEP(2,IFER)=IANT
26878 JDAHEP(2,IANT)=IFER
26881 IDHW(IHIG)=201+IHIGGS
26883 IDHEP(ICMF)=IDPDG(IDHW(ICMF))
26884 IDHEP(IHIG)=IDPDG(IDHW(IHIG))
26885 IDHEP(IZED)=IDPDG(IDHW(IZED))
26886 IDHEP(IFER)=IDPDG(IDHW(IFER))
26887 IDHEP(IANT)=IDPDG(IDHW(IANT))
26891 *CMZ :- -25/11/01 17.11.33 by Stefano Moretti
26892 *-- Author : Kosuke Odagiri, modified by Stefano Moretti
26893 C-----------------------------------------------------------------------
26894 C...Generate completely differential cross section (EVWGT) in the variable
26895 C...X(I) with I=1 (see below) for the processes IPROC=955,965,975 as
26896 C...described in the HERWIG 6 documentation file.
26898 C...First release: 12-NOV-2001 by Stefano Moretti
26900 C-----------------------------------------------------------------------
26902 C-----------------------------------------------------------------------
26903 C PRODUCTION OF MSSM HIGGS PAIRS IN L+L- (L=E,MU)
26904 C-----------------------------------------------------------------------
26905 INCLUDE 'HERWIG65.INC'
26906 DOUBLE PRECISION HWRGEN, HWUAEM, HCS, RCS, S, PF, QPE,
26907 & FACTR, SN2TH, MZ, MNN(2), MCC, EMSC2, GZ2,
26908 & GHH(4), XWEIN, S2W, X(1), XL(1),
26909 & XU(1), WEIGHT, ECM, RMH1, RMH2, EMH1, EMH2,
26910 & EMHWT1, EMHWT2, EMHHWT, SHAT
26911 INTEGER I, ID1, ID2, IH1, IH2, IH, JH
26912 EXTERNAL HWRGEN, HWUAEM
26913 SAVE HCS,MNN,MCC,EMHHWT,S,SHAT
26914 DOUBLE COMPLEX Z, GZ, A, D, E
26915 PARAMETER (Z = (0.D0,1.D0))
26916 EQUIVALENCE (MZ, RMASS(200))
26919 RCS = HCS*HWRGEN(0)
26923 C...energy at parton level.
26924 ECM = PBEAM1+PBEAM2
26927 C...phase space variables.
26928 C...X(1)=COS(THETA_CM),
26929 C...phase space borders.
26932 C...single phase space point.
26936 X(I)=XL(I)+(XU(I)-XL(I))*HWRGEN(0)
26937 WEIGHT=WEIGHT*ABS(XU(I)-XL(I))
26939 C...final state masses.
26940 IF((MOD(IPROC,10000).EQ.965).OR.
26941 & (MOD(IPROC,10000).EQ.975))THEN
26945 ELSE IF(MOD(IPROC,10000).EQ.955)THEN
26956 EMHHWT=EMHWT1*EMHWT2
26959 SN2TH = 0.25D0 - 0.25D0*COSTH**2
26961 EMSC2 = EMSCA*EMSCA
26963 FACTR = GEV2NB*PIFAC*(HWUAEM(EMSC2))**2/SHAT*SN2TH/2.
26964 C...constant weight.
26965 FACTR = FACTR*WEIGHT
26966 C...couplings and propagators.
26968 S2W = DSQRT(XWEIN*(TWO-XWEIN))
26969 GZ = S2W*(SHAT-MZ**2+Z*SHAT*GAMZ/MZ)/SHAT
26970 GZ2 = DREAL(DCONJG(GZ)*GZ)
26971 C...labels: 1 = h0, 2 = H0, 3 = A0, 4 = H+, 5 = H-.
26976 C...set to zero all MEs.
26981 C...start subprocesses.
26982 IF((MOD(IPROC,10000).EQ.965).OR.
26983 & (MOD(IPROC,10000).EQ.975))THEN
26989 QPE = SHAT-(EMH1+EMH2)**2
26990 IF (QPE.GT.ZERO) THEN
26991 PF = SQRT(QPE*(SHAT-(EMH1-EMH2)**2))/SHAT
26993 & FACTR*PF**3*GHH(IH)**2*(LFCH(11)**2+RFCH(11)**2)/GZ2
26998 ELSE IF(MOD(IPROC,10000).EQ.955)THEN
27004 QPE = SHAT-(EMH1+EMH2)**2
27005 IF (QPE.GT.ZERO) THEN
27006 PF = SQRT(QPE*(SHAT-(EMH1-EMH2)**2))/SHAT
27008 D = QFCH(11)+A*LFCH(11)
27009 E = QFCH(11)+A*RFCH(11)
27010 MCC=FACTR*PF**3*DREAL(DCONJG(D)*D+DCONJG(E)*E)
27017 IF(MOD(IPROC,10000).EQ.965)THEN
27020 HCS = HCS + EMHHWT*MNN(1)
27021 ELSE IF(MOD(IPROC,10000).EQ.975)THEN
27024 HCS = HCS + EMHHWT*MNN(2)
27025 ELSE IF(MOD(IPROC,10000).EQ.955)THEN
27028 HCS = HCS + EMHHWT*MCC
27030 IF (GENEV.AND.HCS.GT.RCS) THEN
27031 C...generate event.
27039 CALL HWETWO(.TRUE.,.TRUE.)
27041 CALL HWVZRO(7,GCOEF)
27048 *CMZ :- -30/06/01 18.41.23 by Stefano Moretti
27049 *-- Author : Stefano Moretti
27050 C-----------------------------------------------------------------------
27051 C...Generate completely differential cross section (EVWGT) in the variables
27052 C...X(I) with I=1,6 (see below) for the processes from IPROC=3110
27053 C...to IPROC=3298, as described in the HERWIG 6 documentation file.
27054 C...It includes interface to PDFs and takes into account color connections
27057 C...First release: 08-APR-2000 by Stefano Moretti
27058 C...Last modified: 29-JUN-2001 by Stefano Moretti
27060 C-----------------------------------------------------------------------
27062 C-----------------------------------------------------------------------
27063 C PRODUCTION OF MSSM HIGGSES IN ASSOCIATION WITH B,T-SQUARK PAIRS
27064 C-----------------------------------------------------------------------
27065 INCLUDE 'HERWIG65.INC'
27066 COMMON/SQSQH/JHIGGS,ILBL,JH,IF1MIN,IF1MAX,IF2MIN,IF2MAX
27067 INTEGER JHIGGS,ILBL,JH,IF1MIN,IF1MAX,IF2MIN,IF2MAX
27068 INTEGER I,J,K,L,M,N
27069 INTEGER IQMIN,IQMAX,IGG,IQQ,JPP
27072 INTEGER JHH,IMIX1,IMIX2
27073 INTEGER JSQ,JSQ1,JSQ2
27075 DOUBLE PRECISION EMSQ1,EMSQ2,GAMSQ1,GAMSQ2,EMSQQ,EMH,EMHWT,EMW
27076 DOUBLE PRECISION GSQ1,GSQ2
27077 DOUBLE PRECISION X(6),XL(6),XU(6)
27078 DOUBLE PRECISION Q4(0:3),Q34(0:3)
27079 DOUBLE PRECISION CT5,ST5,CT4,ST4,CF4,SF4,RQ52,RQ5,RQ42,RQ4,PQ4
27080 DOUBLE PRECISION P1(0:3),P2(0:3),P3(0:3),P4(0:3),P5(0:3)
27081 DOUBLE PRECISION ECM_MAX,ECM,SHAT,S,TAU
27082 DOUBLE PRECISION EMIN,EMIN1,EMIN2,PCM2,PCM
27083 DOUBLE PRECISION GGSQHT,GGSQHU,GGSQHN,QQSQH
27084 DOUBLE PRECISION M2GG(8),M2GGPL(8),M2GGMN(8),M2QQ(8)
27085 DOUBLE PRECISION ALPHA,ALPHAS,EMSC2
27086 DOUBLE PRECISION HWRGEN,HWUAEM,HWUALF
27087 DOUBLE PRECISION PHI,CPHI,SPHI,ROT(3,3)
27088 DOUBLE PRECISION VCOL,GCOL,QAUX(0:3)
27089 DOUBLE PRECISION EPS,HCS,RCS,GACT,FACT(8),DIST
27090 DOUBLE PRECISION WEIGHT
27091 SAVE HCS,M2QQ,M2GG,M2GGPL,M2GGMN,FACT,S,SHAT,P3,P4,P5
27094 EXTERNAL HWRGEN,HWUAEM,HWUALF,HWHQCP,HWH2SH,HWETWO,HWRLOG
27095 PARAMETER (EPS=1.D-9)
27096 EQUIVALENCE (EMW,RMASS(198)),(NC,NCOLO)
27097 C...process the event.
27103 C...loop over final state flavours.
27112 DO 2 IF1=IF1MIN,IF1MAX
27113 IF((IF1.GE.407).AND.(IF1.LE.416))GOTO 2
27114 DO 1 IF2=IF2MIN,IF2MAX
27115 IF((IF2.GE.413).AND.(IF2.LE.422))GOTO 1
27116 C...assign squark flavour.
27120 IF((ICHRG(JSQ1)+ICHRG(JSQ2))/3.NE.-ICHRG(201+JHIGGS+1))GOTO 1
27122 IF((IME.LE.0).OR.(IME.GT.8))CALL HWWARN('HWHISQ',100,*999)
27123 C...assign final state masses and widths.
27126 GAMSQ1=HBAR/RLTIM(JSQ1)
27127 GAMSQ2=HBAR/RLTIM(JSQ2)
27128 EMH=RMASS(201+JHIGGS+1)
27130 C...energy at hadron level.
27131 ECM_MAX=PBEAM1+PBEAM2
27133 C...phase space variables.
27134 C...X(1)=(EMSQQ-EMSQ1-EMSQ2)/(ECM-EMSQ1-EMSQ2-EMH),
27135 C...X(2)=COS(THETA5_CM),X(3)=COS(THETA4_CM_34),X(4)=FI4_CM_34,
27136 C...X(5)=(1./SHAT-1./ECM_MAX**2)/(1./(EMSQ1+EMSQ2+EMH)**2-1./ECM_MAX**2),
27137 C...X(6)=(LOG(TAU)-LOG(X1))/LOG(TAU);
27138 C...phase space borders.
27151 C...single phase space point.
27155 X(I)=XL(I)+(XU(I)-XL(I))*HWRGEN(0)
27156 WEIGHT=WEIGHT*ABS(XU(I)-XL(I))
27158 C...energy at parton level.
27159 ECM=SQRT(1./(X(5)*(1./(EMSQ1+EMSQ2+EMH)**2-1./ECM_MAX**2)
27161 IF((EMH.LE.0.).OR.(EMH.GE.ECM))RETURN
27164 C...momentum fractions X1 and X2.
27165 XX(1)=EXP(LOG(TAU)*(1.-X(6)))
27167 C...three particle kinematics.
27168 EMSQQ=X(1)*(ECM-EMSQ1-EMSQ2-EMH)+EMSQ1+EMSQ2
27170 IF(HWRLOG(HALF))THEN
27171 ST5=+SQRT(1.-CT5*CT5)
27173 ST5=-SQRT(1.-CT5*CT5)
27176 ST4=SQRT(1.-CT4*CT4)
27179 RQ52=((ECM*ECM-EMH*EMH-EMSQQ*EMSQQ)**2-(2.*EMH*EMSQQ)**2)/
27189 P5(0)=SQRT(RQ52+EMH*EMH)
27193 Q34(0)=SQRT(RQ52+EMSQQ*EMSQQ)
27194 RQ42=((EMSQQ*EMSQQ-EMSQ1*EMSQ1-EMSQ2*EMSQ2)**2
27195 & -(2.*EMSQ1*EMSQ2)**2)/
27205 Q4(0)=SQRT(RQ42+EMSQ2*EMSQ2)
27208 PQ4=PQ4+Q34(I)*Q4(I)
27210 P4(0)=(Q34(0)*Q4(0)+PQ4)/EMSQQ
27213 P4(I)=Q4(I)+Q34(I)*(P4(0)+Q4(0))/(Q34(0)+EMSQQ)
27216 C...incoming partons: all massless.
27218 C...initial state momenta in the partonic CM.
27219 PCM2=((SHAT-EMIN*EMIN-EMIN*EMIN)**2
27220 & -(2.*EMIN*EMIN)**2)/(4.*SHAT)
27222 P1(0)=SQRT(PCM2+EMIN*EMIN)
27226 P2(0)=SQRT(PCM2+EMIN*EMIN)
27230 C...color structured ME summed/averaged over final/initial spins and colors.
27233 JPP=(MOD(IPROC,10000)/10-ILBL/10)
27234 IF((JPP.EQ.4).OR.(JPP.EQ.5).OR.(JPP.EQ.6))IQQ=0
27235 IF((JPP.EQ.7).OR.(JPP.EQ.8).OR.(JPP.EQ.9))IGG=0
27238 CALL HWH2SH(ECM,P1,P2,P3,P4,P5,EMSQ1,EMSQ2,EMH,GSQ1,GSQ2,
27239 & IGG,IQQ,GGSQHT,GGSQHU,GGSQHN,QQSQH)
27240 M2GG(IME)=GGSQHN/(8.*CFFAC)
27241 M2GGPL(IME)=GGSQHT/(8.*CFFAC)
27242 M2GGMN(IME)=GGSQHU/(8.*CFFAC)
27243 M2QQ(IME)=QQSQH*(1.-1./CAFAC**2)/4.
27244 C...constant factors: phi along beam and conversion GeV^2->nb.
27245 GACT=2.*PIFAC*GEV2NB
27246 C...Jacobians from X1,X2 to X(5),X(6)
27247 GACT=GACT/S*(-LOG(TAU))*(1./(EMSQ1+EMSQ2+EMH)**2-1./ECM_MAX**2)
27248 C...phase space Jacobians, pi's and flux.
27249 GACT=GACT*RQ4*RQ5/PCM/32./(2.*PIFAC)**5
27250 & *(ECM-EMSQ1-EMSQ2-EMH)
27251 C...EW and QCD couplings.
27252 EMSCA=EMSQ1+EMSQ2+EMH
27254 ALPHA=HWUAEM(EMSC2)
27255 ALPHAS=HWUALF(1,EMSCA)
27256 GACT=GACT*4.*PIFAC*ALPHA/SWEIN
27257 GACT=GACT*16.*PIFAC**2*ALPHAS**2
27258 C...enhancement factor for MSSM.
27260 IF(JHIGGS.EQ.5)JHH=4
27262 IF(JSQ1.GT.412)JSQ=JSQ1-412
27265 IF(JSQ1.GT.412)IMIX1=2
27266 IF(JSQ2.GT.418)IMIX2=2
27267 SENHNC(JSQ)=GHSQSS(JHH,JSQ,IMIX1,IMIX2)
27268 GACT=GACT*SENHNC(JSQ)*SENHNC(JSQ)
27269 C...Higgs resonance.
27271 C...constant weight.
27278 C...set up flavours in final state.
27282 CALL HWSGEN(.FALSE.)
27284 IF(MOD(IPROC,10000)-ILBL.GE.70)IQMAX=12
27286 IF(MOD(IPROC,10000)-ILBL.GE.40)IQMIN=13
27287 IF(MOD(IPROC,10000)-ILBL.GE.70)IQMIN=1
27289 IF((M2GGPL(JME)+M2GGMN(JME)).EQ.0.)GOTO 3
27291 IF(DISF(I,1).LT.EPS)THEN
27298 IF(DISF(J,2).LT.EPS)THEN
27301 DIST=DISF(I,1)*DISF(J,2)*S
27303 C...set up color connections: qq-scattering.
27305 HCS=HCS+M2QQ(JME)*DIST*FACT(JME)
27306 IF(GENEV.AND.HCS.GT.RCS)THEN
27308 CALL HWHQCP(JSQ1,JSQ2,2413, 4,*9)
27310 ELSE IF(I.EQ.J+6)THEN
27311 HCS=HCS+M2QQ(JME)*DIST*FACT(JME)
27312 IF(GENEV.AND.HCS.GT.RCS)THEN
27314 CALL HWHQCP(JSQ2,JSQ1,3142,12,*9)
27318 C...set up color connections: gg-scattering.
27320 & +(M2GGPL(JME)-M2GG(JME)*M2GGPL(JME)
27321 & /(M2GGPL(JME)+M2GGMN(JME))/FLOAT(NC)**2)*DIST*FACT(JME)
27322 IF(GENEV.AND.HCS.GT.RCS)CALL HWHQCP(JSQ1,JSQ2,2413,27,*9)
27324 & +(M2GGMN(JME)-M2GG(JME)*M2GGMN(JME)
27325 & /(M2GGPL(JME)+M2GGMN(JME))/FLOAT(NC)**2)*DIST*FACT(JME)
27326 IF(GENEV.AND.HCS.GT.RCS)CALL HWHQCP(JSQ1,JSQ2,4123,28,*9)
27333 C...generate event.
27337 C...incoming partons: now massive.
27338 EMIN1=RMASS(IDN(1))
27339 EMIN2=RMASS(IDN(2))
27340 C...redo initial state momenta in the partonic CM.
27341 PCM2=((SHAT-EMIN1*EMIN1-EMIN2*EMIN2)**2
27342 & -(2.*EMIN1*EMIN2)**2)/(4.*SHAT)
27344 P1(0)=SQRT(PCM2+EMIN1*EMIN1)
27348 P2(0)=SQRT(PCM2+EMIN2*EMIN2)
27352 C...randomly rotate final state momenta around beam axis.
27353 PHI=2.*PIFAC*HWRGEN(0)
27369 IF(L.EQ.1)QAUX(M)=QAUX(M)+ROT(M,N)*P3(N)
27370 IF(L.EQ.2)QAUX(M)=QAUX(M)+ROT(M,N)*P4(N)
27371 IF(L.EQ.3)QAUX(M)=QAUX(M)+ROT(M,N)*P5(N)
27375 IF(L.EQ.1)P3(M)=QAUX(M)
27376 IF(L.EQ.2)P4(M)=QAUX(M)
27377 IF(L.EQ.3)P5(M)=QAUX(M)
27380 C...use HWETWO only to set up status and IDs of (s)quarks.
27383 CALL HWETWO(.TRUE.,.TRUE.)
27384 C...do real incoming, outgoing momenta in the lab frame.
27385 VCOL=(XX(1)-XX(2))/(XX(1)+XX(2))
27386 GCOL=(XX(1)+XX(2))/2./SQRT(XX(1)*XX(2))
27388 IF(M.EQ.NHEP-2)GO TO 888
27390 IF(M.EQ.NHEP-4)QAUX(N)=P1(N)
27391 IF(M.EQ.NHEP-3)QAUX(N)=P2(N)
27392 IF(M.EQ.NHEP-1)QAUX(N)=P3(N)*(1-FLIP)+P4(N)*FLIP
27393 IF(M.EQ.NHEP )QAUX(N)=P4(N)*(1-FLIP)+P3(N)*FLIP
27394 IF(M.EQ.NHEP+1)QAUX(N)=P5(N)
27397 PHEP(4,M)=GCOL*(QAUX(0)+VCOL*QAUX(3))
27398 PHEP(3,M)=GCOL*(QAUX(3)+VCOL*QAUX(0))
27403 C...needs to set all final state masses.
27404 PHEP(5,NHEP-1)=SQRT(ABS(PHEP(4,NHEP-1)**2
27405 & -PHEP(3,NHEP-1)**2
27406 & -PHEP(2,NHEP-1)**2
27407 & -PHEP(1,NHEP-1)**2))
27408 PHEP(5,NHEP )=SQRT(ABS(PHEP(4,NHEP )**2
27409 & -PHEP(3,NHEP )**2
27410 & -PHEP(2,NHEP )**2
27411 & -PHEP(1,NHEP )**2))
27412 PHEP(5,NHEP+1)=SQRT(ABS(PHEP(4,NHEP+1)**2
27413 & -PHEP(3,NHEP+1)**2
27414 & -PHEP(2,NHEP+1)**2
27415 & -PHEP(1,NHEP+1)**2))
27418 PHEP(I,NHEP-2)=PHEP(I,NHEP-4)+PHEP(I,NHEP-3)
27420 PHEP(5,NHEP-2)=SQRT(ABS(PHEP(4,NHEP-2)**2
27421 & -PHEP(3,NHEP-2)**2
27422 & -PHEP(2,NHEP-2)**2
27423 & -PHEP(1,NHEP-2)**2))
27424 C...status and IDs for Higgs.
27426 IDHW(NHEP+1)=IDN(5)
27427 IDHEP(NHEP+1)=IDPDG(IDN(5))
27428 C...Higgs colour (self-)connections.
27429 JMOHEP(1,NHEP+1)=NHEP-2
27430 JMOHEP(2,NHEP+1)=NHEP+1
27431 JDAHEP(2,NHEP+1)=NHEP+1
27432 JDAHEP(2,NHEP-2)=NHEP+1
27435 C...set to zero the coefficients of the spin density matrices.
27436 CALL HWVZRO(7,GCOEF)
27440 *CMZ :- -12/01/93 10.12.43 by Bryan Webber
27441 *-- Author : Ian Knowles
27442 C-----------------------------------------------------------------------
27444 C-----------------------------------------------------------------------
27445 C QQD direct photon pair production: mean EVWGT = sigma in nb
27446 C-----------------------------------------------------------------------
27447 INCLUDE 'HERWIG65.INC'
27448 DOUBLE PRECISION HWRGEN,HWRUNI,HWUALF,HWHPPB,EPS,RCS,ET,EJ,KK,KK2,
27449 & YJ1INF,YJ1SUP,Z1,YJ2INF,YJ2SUP,Z2,FACT,FACTR,RS,S,T,U,CSTU,TQSQ,
27452 EXTERNAL HWRGEN,HWRUNI,HWUALF,HWHPPB
27453 SAVE HCS,CSTU,DSTU,FACT
27454 PARAMETER (EPS=1.D-9)
27462 IF (KK.GE.ONE) RETURN
27463 YJ1INF=MAX( YJMIN , LOG((1.-SQRT(1.-KK2))/KK) )
27464 YJ1SUP=MIN( YJMAX , LOG((1.+SQRT(1.-KK2))/KK) )
27465 IF (YJ1INF.GE.YJ1SUP) RETURN
27466 Z1=EXP(HWRUNI(1,YJ1INF,YJ1SUP))
27467 YJ2INF=MAX( YJMIN , -LOG(2./KK-1./Z1) )
27468 YJ2SUP=MIN( YJMAX , LOG(2./KK-Z1) )
27469 IF (YJ2INF.GE.YJ2SUP) RETURN
27470 Z2=EXP(HWRUNI(2,YJ2INF,YJ2SUP))
27471 XX(1)=0.5*(Z1+Z2)*KK
27472 IF (XX(1).GE.ONE) RETURN
27473 XX(2)=XX(1)/(Z1*Z2)
27474 IF (XX(2).GE.ONE) RETURN
27475 COSTH=(Z1-Z2)/(Z1+Z2)
27476 S=XX(1)*XX(2)*PHEP(5,3)**2
27478 T=-0.5*S*(1.-COSTH)
27480 EMSCA=SQRT(2.*S*T*U/(S*S+T*T+U*U))
27481 FACT=GEV2NB*PIFAC*0.5*ET*EJ*(YJ1SUP-YJ1INF)*(YJ2SUP-YJ2INF)
27483 CALL HWSGEN(.FALSE.)
27484 CSTU=2.*(U/T+T/U)/CAFAC
27485 IF (DISF(13,1).GT.EPS.AND.DISF(13,2).GT.EPS) THEN
27488 10 IF (RMASS(ID).LT.RS) TQSQ=TQSQ+QFCH(ID)**2
27489 DSTU=DISF(13,1)*DISF(13,2)*FACT*HWHPPB(S,T,U)
27490 & /64.*(HWUALF(1,EMSCA)*TQSQ/PIFAC)**2
27497 FACTR=FACT*CSTU*QFCH(ID)**4
27498 C q+qbar ---> gamma+gamma
27501 IF (DISF(ID1,1).LT.EPS.OR.DISF(ID2,2).LT.EPS) GOTO 20
27502 HCS=HCS+FACTR*DISF(ID1,1)*DISF(ID2,2)
27503 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(59,59,2134,61,*99)
27504 C qbar+q ---> gamma+gamma
27507 IF (DISF(ID1,1).LT.EPS.OR.DISF(ID2,2).LT.EPS) GOTO 30
27508 HCS=HCS+FACTR*DISF(ID1,1)*DISF(ID2,2)
27509 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(59,59,2134,62,*99)
27511 C g+g ---> gamma+gamma
27515 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(59,59,2134,63,*99)
27522 CALL HWETWO(.TRUE.,.TRUE.)
27525 *CMZ :- -26/04/91 14.55.45 by Federico Carminati
27526 *-- Author : Bryan Webber
27527 C-----------------------------------------------------------------------
27529 C-----------------------------------------------------------------------
27530 C QCD DIRECT PHOTON + JET PRODUCTION: MEAN EVWGT = SIGMA IN NB
27531 C-----------------------------------------------------------------------
27532 INCLUDE 'HERWIG65.INC'
27533 DOUBLE PRECISION HWRGEN,HWRUNI,HWUALF,HWHPPB,EPS,RCS,ET,EJ,KK,KK2,
27534 & YJ1INF,YJ1SUP,Z1,YJ2INF,YJ2SUP,Z2,FACT,FACTR,FACTF,RS,S,T,U,CF,
27535 & AF,CSTU,CTSU,CUST,DSTU,HCS,TQCH
27537 EXTERNAL HWRGEN,HWRUNI,HWUALF,HWHPPB
27539 PARAMETER (EPS=1.D-9)
27547 IF (KK.GE.ONE) RETURN
27548 YJ1INF=MAX( YJMIN , LOG((1.-SQRT(1.-KK2))/KK) )
27549 YJ1SUP=MIN( YJMAX , LOG((1.+SQRT(1.-KK2))/KK) )
27550 IF (YJ1INF.GE.YJ1SUP) RETURN
27551 Z1=EXP(HWRUNI(1,YJ1INF,YJ1SUP))
27552 YJ2INF=MAX( YJMIN , -LOG(2./KK-1./Z1) )
27553 YJ2SUP=MIN( YJMAX , LOG(2./KK-Z1) )
27554 IF (YJ2INF.GE.YJ2SUP) RETURN
27555 Z2=EXP(HWRUNI(2,YJ2INF,YJ2SUP))
27556 XX(1)=0.5*(Z1+Z2)*KK
27557 IF (XX(1).GE.ONE) RETURN
27558 XX(2)=XX(1)/(Z1*Z2)
27559 IF (XX(2).GE.ONE) RETURN
27560 COSTH=(Z1-Z2)/(Z1+Z2)
27561 S=XX(1)*XX(2)*PHEP(5,3)**2
27563 T=-0.5*S*(1.-COSTH)
27565 C---SET EMSCA TO HARD PROCESS SCALE (APPROX ET-JET)
27566 EMSCA=SQRT(2.*S*T*U/(S*S+T*T+U*U))
27567 FACT=GEV2NB*PIFAC*0.5*ET*EJ*ALPHEM
27568 & *HWUALF(1,EMSCA)*(YJ1SUP-YJ1INF)*(YJ2SUP-YJ2INF)/S**2
27569 CALL HWSGEN(.FALSE.)
27576 IF (DISF(13,1).GT.EPS.AND.DISF(13,2).GT.EPS) THEN
27579 10 IF (RMASS(ID).LT.RS) TQCH=TQCH+QFCH(ID)
27580 DSTU=DISF(13,1)*DISF(13,2)*FACT*HWHPPB(S,T,U)
27581 & *5./768.*(HWUALF(1,EMSCA)*TQCH/PIFAC)**2
27589 FACTR=FACT*QFCH(ID)**2
27592 IF (DISF(ID1,1).LT.EPS) GOTO 20
27594 HCS=HCS+CSTU*FACTR*DISF(ID1,1)*DISF(ID2,2)
27595 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP( 13, 59,2314,41,*9)
27597 HCS=HCS+CTSU*FACTR*DISF(ID1,1)*DISF(ID2,2)
27598 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1, 59,3124,42,*9)
27601 IF (DISF(ID1,1).LT.EPS) GOTO 30
27603 HCS=HCS+CSTU*FACTR*DISF(ID1,1)*DISF(ID2,2)
27604 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP( 13, 59,3124,43,*9)
27606 HCS=HCS+CTSU*FACTR*DISF(ID1,1)*DISF(ID2,2)
27607 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1, 59,2314,44,*9)
27611 FACTF=FACT*CUST*DISF(ID1,1)
27613 FACTR=FACTF*QFCH(ID)**2
27615 IF (DISF(ID2,2).LT.EPS) GOTO 40
27616 HCS=HCS+FACTR*DISF(ID2,2)
27617 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID2, 59,2314,45,*9)
27619 IF (DISF(ID2,2).LT.EPS) GOTO 50
27620 HCS=HCS+FACTR*DISF(ID2,2)
27621 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID2, 59,3124,46,*9)
27626 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP( 13, 59,2314,47,*9)
27633 CALL HWETWO(.TRUE.,.TRUE.)
27636 *CMZ :- -12/01/93 10.12.43 by Bryan Webber
27637 *-- Author : Ian Knowles
27638 C-----------------------------------------------------------------------
27639 FUNCTION HWHPPB(S,T,U)
27640 C-----------------------------------------------------------------------
27641 C Quark box diagram contribution to photon/gluon scattering
27642 C Internal quark mass neglected: m_q << U,T,S
27643 C-----------------------------------------------------------------------
27645 DOUBLE PRECISION HWHPPB,S,T,U,S2,T2,U2,PI2,ALNTU,ALNST,ALNSU
27654 & +((2.*S2+2.*(U2-T2)*ALNTU+(T2+U2)*(ALNTU**2+PI2))/S2)**2
27655 & +((2.*U2+2.*(T2-S2)*ALNST+(T2+S2)* ALNST**2 )/U2)**2
27656 & +((2.*T2+2.*(U2-S2)*ALNSU+(U2+S2)* ALNSU**2 )/T2)**2
27657 & +4.*PI2*(((T2-S2+(T2+S2)*ALNST)/U2)**2
27658 & +((U2-S2+(U2+S2)*ALNSU)/T2)**2)
27661 *CMZ :- -12/01/93 10.12.43 by Bryan Webber
27662 *-- Author : Ian Knowles
27663 C-----------------------------------------------------------------------
27665 C-----------------------------------------------------------------------
27666 C point-like photon/QCD heavy flavour single excitation, using exact
27667 C massive lightcone kinematics, mean EVWGT = sigma in nb.
27668 C-----------------------------------------------------------------------
27669 INCLUDE 'HERWIG65.INC'
27670 DOUBLE PRECISION HWRGEN,HWRUNI,HWUALF,EPS,PP1,PP2,QM2,FACTR,
27671 & PT,PJ,PT2,PTM,EXY,T,CC,EXY2,S,U,C,SIGE,HCS,RCS
27672 INTEGER IQ1,IQ2,ID1,ID2,IHAD1,IHAD2
27673 EXTERNAL HWRGEN,HWRUNI,HWUALF
27674 SAVE PP1,PP2,IQ1,IQ2,QM2,FACTR,SIGE,HCS
27675 PARAMETER (EPS=1.E-9)
27677 IF (JDAHEP(1,IHAD1).NE.0) IHAD1=JDAHEP(1,IHAD1)
27679 IF (JDAHEP(1,IHAD2).NE.0) IHAD2=JDAHEP(1,IHAD2)
27680 IF (FSTWGT.OR.IHAD1.NE.1.OR.IHAD2.NE.2) THEN
27681 PP1=PHEP(4,IHAD1)+ABS(PHEP(3,IHAD1))
27682 PP2=PHEP(4,IHAD2)+ABS(PHEP(3,IHAD2))
27687 FACTR=GEV2NB*(YJMAX-YJMIN)*4.*PIFAC*CFFAC*PP1
27688 & *ALPHEM*QFCH(IQ1)**2
27697 EXY=EXP(HWRUNI(1,YJMIN,YJMAX))
27699 CC=T**2-4.*QM2*(PT2+T)
27700 IF (CC.LT.ZERO) RETURN
27701 EXY2=(2.*PT2+T-SQRT(CC))*PP1/(2.*T*PTM)
27702 IF (EXY2.LT.EXP(YJMIN).OR.EXY2.GT.EXP(YJMAX)) RETURN
27703 XX(2)=(PT/EXY+PTM/EXY2)/PP2
27704 IF (XX(2).GT.ONE) RETURN
27705 C define: S=Shat-M**2, T=That ,U=Uhat-M**2 (2p.Q, -2p.g, -2p.Q')
27708 COSTH=(1.+QM2/S)*(T-U)/S-QM2/S
27709 C Set hard process scale (Approx ET-jet)
27710 EMSCA=SQRT(2.*S*T*U/(S*S+T*T+U*U))
27712 SIGE=-FACTR*PT*PJ*HWUALF(1,EMSCA)*(S/U+U/S+4.*C*(1.-C))
27713 & /(S**2*EXY2*PTM*(1-QM2/(XX(2)*PP2*EXY2)**2))
27714 CALL HWSFUN(XX(2),EMSCA,IDHW(IHAD2),NSTRU,DISF(1,2),2)
27718 C photon+Q ---> g+Q
27720 IF (DISF(ID2,2).LT.EPS) GOTO 10
27721 HCS=HCS+SIGE*DISF(ID2,2)
27722 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(13,ID2,1423,51,*99)
27723 C photon+Qbar ---> g+Qbar
27725 IF (DISF(ID2,2).LT.EPS) GOTO 20
27726 HCS=HCS+SIGE*DISF(ID2,2)
27727 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(13,ID2,1342,52,*99)
27734 CALL HWETWO(.TRUE.,.TRUE.)
27737 *CMZ :- -12/01/93 10.12.43 by Bryan Webber
27738 *-- Author : Ian Knowles
27739 C-----------------------------------------------------------------------
27741 C-----------------------------------------------------------------------
27742 C Point-like photon/gluon heavy flavour pair production, with
27743 C exact lightcone massive kinematics, mean EVWGT = sigma in nb.
27744 C-----------------------------------------------------------------------
27745 INCLUDE 'HERWIG65.INC'
27746 DOUBLE PRECISION HWRUNI,HWUALF,EPS,PP1,PP2,QM2,FACTR,ET,EJ,ET2,
27748 INTEGER IQ1,IHAD1,IHAD2
27749 EXTERNAL HWRUNI,HWUALF
27750 SAVE PP1,PP2,IQ1,QM2,FACTR
27751 PARAMETER (EPS=1.E-9)
27753 IF (JDAHEP(1,IHAD1).NE.0) IHAD1=JDAHEP(1,IHAD1)
27755 IF (JDAHEP(1,IHAD2).NE.0) IHAD2=JDAHEP(1,IHAD2)
27756 IF (FSTWGT.OR.IHAD1.NE.1.OR.IHAD2.NE.2) THEN
27757 PP1=PHEP(4,IHAD1)+ABS(PHEP(3,IHAD1))
27758 PP2=PHEP(4,IHAD2)+ABS(PHEP(3,IHAD2))
27763 FACTR=-GEV2NB*(YJMAX-YJMIN)*.5*PIFAC*ALPHEM*QFCH(IQ1)**2
27776 CALL HWETWO(.TRUE.,.TRUE.)
27778 C Select kinematics
27782 EXY=EXP(HWRUNI(1,YJMIN,YJMAX))
27784 IF (EXY2.LT.EXP(YJMIN).OR.EXY2.GT.EXP(YJMAX)) RETURN
27785 XX(2)=.5*ET*(1./EXY+1./EXY2)/PP2
27786 IF (XX(2).LT.ZERO.OR.XX(2).GT.ONE) RETURN
27788 IF (S.LT.ET2) RETURN
27789 C define: S=Shat, T=That-M**2, U=Uhat-M**2 (2p.g, -2p.Q, -2p.QBar)
27792 COSTH=(T-U)/(S*SQRT(1.-4.*QM2/S))
27793 EMSCA=SQRT(2.*S*T*U/(S*S+T*T+U*U))
27794 CALL HWSFUN(XX(2),EMSCA,IDHW(IHAD2),NSTRU,DISF(1,2),2)
27795 C photon+g ---> Q+Qbar
27796 IF (DISF(13,2).LT.EPS) THEN
27800 EVWGT=FACTR*EJ*ET*HWUALF(1,EMSCA)
27801 & *DISF(13,2)*(T/U+U/T+4.*C*(1.-C))/(S*T)
27806 *CMZ :- -09/12/93 15.50.26 by Mike Seymour
27807 *-- Author : Ian Knowles & Mike Seymour
27808 C-----------------------------------------------------------------------
27810 C-----------------------------------------------------------------------
27811 C Point-like photon/QCD direct meson production
27812 C See M. Benayoun, et al., Nucl. Phys. B282 (1987) 653 for details.
27813 C mean EVWGT = sigma in nb
27814 C-----------------------------------------------------------------------
27815 INCLUDE 'HERWIG65.INC'
27816 DOUBLE PRECISION HWRGEN,HWRUNI,HWUALF,EPS,PP1,PP2,ET,EJ,EXY,EXY2,
27817 & FACT,FACTR,S,T,U,REDS,DELT(3,3),C1STU,C3STU,HCS,RCS,CMIX,SMIX,
27818 & C1WVFN,FPI,FETA8,FETA1,FRHO,FPHI8,FPHI1,FPI2,FETA2(3),FETAP2(3),
27819 7 FRHO2,FPHI2(3),FOMEG2(3)
27820 INTEGER MNAME(3,3,2),N4(3),I,J,ID2,ID4,I2,I4,M1,M2,IHAD1,IHAD2
27821 LOGICAL SPIN0,SPIN1
27822 EXTERNAL HWRGEN,HWRUNI,HWUALF
27823 SAVE FPI2,FETA2,FETAP2,FRHO2,FPHI2,FOMEG2,HCS,REDS,FACT,DELT,
27825 PARAMETER (EPS=1.D-20)
27826 DATA MNAME/21,38,42,30,21,34,50,46,0,23,39,43,31,23,35,51,47,0/
27827 DATA N4,SPIN0,SPIN1/3,3,2,.TRUE.,.TRUE./
27828 DATA C1WVFN,FPI,FETA8,FETA1,FRHO,FPHI8,FPHI1
27829 & /1.D0,3*0.093D0,3*0.107D0/
27832 CMIX=COS(ETAMIX*PIFAC/180.D0)
27833 SMIX=SIN(ETAMIX*PIFAC/180.D0)
27834 FETA2(1) =(+CMIX*FETA8/SQRT(TWO)-SMIX*FETA1)**2/THREE
27836 FETA2(3) =(-CMIX*FETA8*SQRT(TWO)-SMIX*FETA1)**2/THREE
27837 FETAP2(1)=(+SMIX*FETA8/SQRT(TWO)+CMIX*FETA1)**2/THREE
27838 FETAP2(2)=FETAP2(1)
27839 FETAP2(3)=(-SMIX*FETA8*SQRT(TWO)+CMIX*FETA1)**2/THREE
27841 CMIX=COS(PHIMIX*PIFAC/180.D0)
27842 SMIX=SIN(PHIMIX*PIFAC/180.D0)
27843 FPHI2(1) =(+CMIX*FPHI8/SQRT(TWO)-SMIX*FPHI1)**2/THREE
27845 FPHI2(3) =(-CMIX*FPHI8*SQRT(TWO)-SMIX*FPHI1)**2/THREE
27846 FOMEG2(1)=(+SMIX*FPHI8/SQRT(TWO)+CMIX*FPHI1)**2/THREE
27847 FOMEG2(2)=FOMEG2(1)
27848 FOMEG2(3)=(-SMIX*FPHI8*SQRT(TWO)+CMIX*FPHI1)**2/THREE
27850 SPIN0=.NOT.(MOD(IPROC/10,10).EQ.2)
27851 SPIN1=.NOT.(MOD(IPROC/10,10).EQ.1)
27857 IF (JDAHEP(1,IHAD1).NE.0) IHAD1=JDAHEP(1,IHAD1)
27859 IF (JDAHEP(1,IHAD2).NE.0) IHAD2=JDAHEP(1,IHAD2)
27860 PP1=PHEP(4,IHAD1)+ABS(PHEP(3,IHAD1))
27861 PP2=PHEP(4,IHAD2)+ABS(PHEP(3,IHAD2))
27864 EXY=EXP(HWRUNI(1,YJMIN,YJMAX))
27865 EXY2=TWO*PP1/ET-EXY
27866 IF (EXY2.LE.EXP(YJMIN).OR.EXY2.GE.EXP(YJMAX)) RETURN
27867 XX(2)=PP1/(PP2*EXY*EXY2)
27868 IF (XX(2).LE.ZERO.OR.XX(2).GE.ONE) RETURN
27870 REDS=SQRT(S-ET*SQRT(S))
27874 C Set EMSCA to hard process scale (Approx ET-jet)
27875 EMSCA=SQRT(TWO*S*T*U/(S*S+T*T+U*U))
27876 FACT=-GEV2NB*ET*EJ*(YJMAX-YJMIN)*ALPHEM*CFFAC
27877 & *(HWUALF(1,EMSCA)*PIFAC*C1WVFN)**2*32.D0/(THREE*S*T)
27878 CALL HWSFUN(XX(2),EMSCA,IDHW(IHAD2),NSTRU,DISF(1,2),2)
27881 10 DELT(I,J)=(QFCH(I)*U+QFCH(J)*S)**2
27882 C1STU=-(S**2+U**2)/(T*S**2*U**2)
27883 C3STU=-8.D0*T/(S**2*U**2)
27887 C Quark initiated processes
27889 IF (DISF(ID2,2).LT.EPS) GOTO 30
27891 M1=MNAME(ID2,ID4,1)
27892 FACTR=FACT*DELT(ID2,ID4)*DISF(ID2,2)
27893 IF (ID2.EQ.ID4) FACTR=HALF*FACTR
27894 IF (SPIN0.AND.REDS.GT.RMASS(M1)) THEN
27895 C photon+q --> meson_0+q'
27896 HCS=HCS+HALF*FACTR*C1STU*FPI2
27897 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(M1,ID4,1432,71,*99)
27899 M2=MNAME(ID2,ID4,2)
27900 IF (SPIN1.AND.REDS.GT.RMASS(M2)) THEN
27901 C photon+q --> meson_L+q'
27902 HCS=HCS+FACTR*C1STU*FRHO2
27903 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(M2,ID4,1432,72,*99)
27904 C photon+q --> meson_T+q'
27905 HCS=HCS+FACTR*C3STU*FRHO2
27906 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(M2,ID4,1432,73,*99)
27909 FACTR=FACT*DELT(I2,I2)*DISF(ID2,2)
27910 IF (SPIN0.AND.REDS.GT.RMASS(22)) THEN
27911 C photon+q -->eta+q
27912 HCS=HCS+HALF*FACTR*C1STU*FETA2(I2)
27913 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(22,ID2,1432,71,*99)
27915 IF (SPIN0.AND.REDS.GT.RMASS(25)) THEN
27916 C photon+q -->eta'+q
27917 HCS=HCS+HALF*FACTR*C1STU*FETAP2(I2)
27918 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(25,ID2,1432,71,*99)
27920 IF (SPIN1.AND.REDS.GT.RMASS(56)) THEN
27921 C photon+q -->phi_L+q
27922 HCS=HCS+FACTR*C1STU*FPHI2(I2)
27923 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(56,ID2,1432,72,*99)
27924 C photon+q -->phi_T+q
27925 HCS=HCS+FACTR*C3STU*FPHI2(I2)
27926 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(56,ID2,1432,73,*99)
27928 IF (SPIN1.AND.REDS.GT.RMASS(24)) THEN
27929 C photon+q -->omega_L+q
27930 HCS=HCS+FACTR*C1STU*FOMEG2(I2)
27931 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(24,ID2,1432,72,*99)
27932 C photon+q -->omega_T+q
27933 HCS=HCS+FACTR*C3STU*FOMEG2(I2)
27934 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(24,ID2,1432,73,*99)
27936 C Anti-quark initiated processes
27938 IF (DISF(ID2,2).LT.EPS) GOTO 50
27941 FACTR=FACT*DELT(I2,I4)*DISF(ID2,2)
27942 IF (ID2.EQ.ID4) FACTR=HALF*FACTR
27944 IF (SPIN0.AND.REDS.GT.RMASS(M1)) THEN
27945 C photon+qbar --> meson_0+qbar'
27946 HCS=HCS+HALF*FACTR*C1STU*FPI2
27947 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(M1,ID4,1432,74,*99)
27950 IF (SPIN1.AND.REDS.GT.RMASS(M2)) THEN
27951 C photon+qbar --> meson_L+qbar'
27952 HCS=HCS+FACTR*C1STU*FRHO2
27953 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(M2,ID4,1432,75,*99)
27954 C photon+qbar --> meson_T+qbar'
27955 HCS=HCS+FACTR*C3STU*FRHO2
27956 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(M2,ID4,1432,76,*99)
27959 FACTR=FACT*DELT(I2,I2)*DISF(ID2,2)
27960 IF (SPIN0.AND.REDS.GT.RMASS(22)) THEN
27961 C photon+qbar -->eta+qbar
27962 HCS=HCS+HALF*FACTR*C1STU*FETA2(I2)
27963 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(22,ID2,1432,74,*99)
27965 IF (SPIN0.AND.REDS.GT.RMASS(25)) THEN
27966 C photon+qbar -->eta'+qbar
27967 HCS=HCS+HALF*FACTR*C1STU*FETAP2(I2)
27968 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(25,ID2,1432,74,*99)
27970 IF (SPIN1.AND.REDS.GT.RMASS(56)) THEN
27971 C photon+qbar -->phi_L+qbar
27972 HCS=HCS+FACTR*C1STU*FPHI2(I2)
27973 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(56,ID2,1432,75,*99)
27974 C photon+qbar -->phi_T+qbar
27975 HCS=HCS+FACTR*C3STU*FPHI2(I2)
27976 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(56,ID2,1432,76,*99)
27978 IF (SPIN1.AND.REDS.GT.RMASS(24)) THEN
27979 C photon+qbar -->omega_L+qbar
27980 HCS=HCS+FACTR*C1STU*FOMEG2(I2)
27981 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(24,ID2,1432,75,*99)
27982 C photon+qbar -->omega_T+qbar
27983 HCS=HCS+FACTR*C3STU*FOMEG2(I2)
27984 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(24,ID2,1432,76,*99)
27993 CALL HWETWO(.TRUE.,.TRUE.)
27994 C Set polarization vector
27995 IF (IHPRO.EQ.72.OR.IHPRO.EQ.75) THEN
27996 RHOHEP(2,NHEP-1)=ONE
27997 ELSEIF (IHPRO.EQ.73.OR.IHPRO.EQ.76) THEN
27998 RHOHEP(1,NHEP-1)=HALF
27999 RHOHEP(3,NHEP-1)=HALF
28003 *CMZ :- -12/01/93 10.12.43 by Bryan Webber
28004 *-- Author : Ian Knowles
28005 C-----------------------------------------------------------------------
28007 C-----------------------------------------------------------------------
28008 C point-like photon/QCD di-jet production: mean EVWGT = sigma in nb
28009 C-----------------------------------------------------------------------
28010 INCLUDE 'HERWIG65.INC'
28011 DOUBLE PRECISION HWRGEN,HWRUNI,HWUALF,EPS,RCS,PP1,PP2,ET,EJ,
28012 & EXY,EXY2,FACTR,RS,S,T,U,CSTU,CTSU,HCS
28013 INTEGER ID1,ID2,ID3,ID4,IHAD1,IHAD2
28014 EXTERNAL HWRGEN,HWRUNI,HWUALF
28015 SAVE CSTU,CTSU,HCS,FACTR,RS
28016 PARAMETER (EPS=1.E-9)
28018 IF (JDAHEP(1,IHAD1).NE.0) IHAD1=JDAHEP(1,IHAD1)
28020 IF (JDAHEP(1,IHAD2).NE.0) IHAD2=JDAHEP(1,IHAD2)
28025 PP1=PHEP(4,IHAD1)+ABS(PHEP(3,IHAD1))
28026 PP2=PHEP(4,IHAD2)+ABS(PHEP(3,IHAD2))
28029 EXY=EXP(HWRUNI(1,YJMIN,YJMAX))
28031 IF (EXY2.LE.EXP(YJMIN).OR.EXY2.GE.EXP(YJMAX)) RETURN
28032 XX(2)=PP1/(PP2*EXY*EXY2)
28033 IF (XX(2).LE.ZERO.OR.XX(2).GE.ONE) RETURN
28039 C Set EMSCA to hard process scale (Approx ET-jet)
28040 EMSCA=SQRT(2.*S*T*U/(S*S+T*T+U*U))
28041 FACTR=-GEV2NB*0.5*EJ*(YJMAX-YJMIN)*ET*PIFAC*ALPHEM
28042 & *HWUALF(1,EMSCA)/(S*T)
28043 CALL HWSFUN(XX(2),EMSCA,IDHW(IHAD2),NSTRU,DISF(1,2),2)
28045 CTSU=-2.*CFFAC*(U/S+S/U)
28050 IF (DISF(ID2,2).LT.EPS) GOTO 20
28052 C photon+q ---> g+q
28053 HCS=HCS+CTSU*DISF(ID2,2)*QFCH(ID2)**2
28054 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP( 13,ID2,1423,51,*99)
28055 ELSEIF (ID2.LT.13) THEN
28056 C photon+qbar ---> g+qbar
28057 HCS=HCS+CTSU*DISF(ID2,2)*QFCH(ID2-6)**2
28058 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP( 13,ID2,1342,52,*99)
28060 C photon+g ---> q+qbar
28062 IF (RS.GT.RMASS(ID3)) THEN
28064 HCS=HCS+CSTU*DISF(ID2,2)*QFCH(ID3)**2
28065 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID3,ID4,1423,53,*99)
28076 CALL HWETWO(.TRUE.,.TRUE.)
28079 *CMZ :- -27/03/95 13.27.22 by Mike Seymour
28080 *-- Author : Ian Knowles
28081 C-----------------------------------------------------------------------
28083 C-----------------------------------------------------------------------
28084 C Compton scattering of point-like photon and (anti)quark
28085 C mean EVWGT = sigma in nb
28086 C-----------------------------------------------------------------------
28087 INCLUDE 'HERWIG65.INC'
28088 DOUBLE PRECISION HWRGEN,HWRUNI,EPS,RCS,PP1,PP2,ET,EJ,EXY,EXY2,
28089 & FACTR,S,T,U,CTSU,HCS
28090 INTEGER ID1,ID2,IHAD1,IHAD2
28091 EXTERNAL HWRGEN,HWRUNI
28092 SAVE CTSU,HCS,FACTR
28093 PARAMETER (EPS=1.E-9)
28095 IF (JDAHEP(1,IHAD1).NE.0) IHAD1=JDAHEP(1,IHAD1)
28097 IF (JDAHEP(1,IHAD2).NE.0) IHAD2=JDAHEP(1,IHAD2)
28102 PP1=PHEP(4,IHAD1)+ABS(PHEP(3,IHAD1))
28103 PP2=PHEP(4,IHAD2)+ABS(PHEP(3,IHAD2))
28106 EXY=EXP(HWRUNI(1,YJMIN,YJMAX))
28108 IF (EXY2.LE.EXP(YJMIN).OR.EXY2.GE.EXP(YJMAX)) RETURN
28109 XX(2)=PP1/(PP2*EXY*EXY2)
28110 IF (XX(2).LE.ZERO.OR.XX(2).GE.ONE) RETURN
28115 C Set EMSCA to hard process scale (Approx ET-jet)
28116 EMSCA=SQRT(2.*S*T*U/(S*S+T*T+U*U))
28117 FACTR=-GEV2NB*0.5*EJ*(YJMAX-YJMIN)*ET*PIFAC*ALPHEM**2/(S*T)
28118 CALL HWSFUN(XX(2),EMSCA,IDHW(IHAD2),NSTRU,DISF(1,2),2)
28124 IF (DISF(ID2,2).LT.EPS) GOTO 20
28126 C photon+q ---> photon+q
28127 HCS=HCS+CTSU*DISF(ID2,2)*QFCH(ID2)**4
28128 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP( 59,ID2,1432,66,*99)
28130 C photon+qbar ---> photon+qbar
28131 HCS=HCS+CTSU*DISF(ID2,2)*QFCH(ID2-6)**4
28132 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP( 59,ID2,1432,67,*99)
28141 CALL HWETWO(.TRUE.,.TRUE.)
28144 *CMZ :- -20/05/99 12.39.45 by Kosuke Odagiri
28145 *-- Author : Bryan Webber
28146 C-----------------------------------------------------------------------
28148 C-----------------------------------------------------------------------
28149 C QCD HARD 2->2 PROCESSES: MEAN EVWGT = SIGMA IN NB
28150 C-----------------------------------------------------------------------
28151 INCLUDE 'HERWIG65.INC'
28152 DOUBLE PRECISION HWRGEN,HWRUNI,HWUALF,RS,EPS,HF,RCS,Z1,Z2,ET,EJ,
28153 & FACTR,S,T,U,ST,TU,US,STU,TUS,UST,EN,RN,GFLA,AF,ASTU,ASUT,AUST,
28154 & BF,BSTU,BSUT,BUST,BUTS,CF,CSTU,CSUT,CTSU,CTUS,DF,DSTU,DTSU,DUTS,
28155 & DIST,HCS,UT,SU,GT,KK,KK2,YJ1INF,YJ1SUP,YJ2INF,YJ2SUP
28157 EXTERNAL HWRGEN,HWRUNI,HWUALF
28158 SAVE HCS,ASTU,AUST,BSTU,BSUT,BUST,BUTS,CSTU,CSUT,CTSU,CTUS,
28159 & DSTU,DTSU,DUTS,GFLA,RCS,S,T,TU,U,US
28160 PARAMETER (EPS=1.E-9,HF=0.5)
28168 IF (KK.GE.ONE) RETURN
28169 YJ1INF = MAX( YJMIN, LOG((ONE-SQRT(ONE-KK2))/KK) )
28170 YJ1SUP = MIN( YJMAX, LOG((ONE+SQRT(ONE-KK2))/KK) )
28171 IF (YJ1INF.GE.YJ1SUP) RETURN
28172 Z1=EXP(HWRUNI(1,YJ1INF,YJ1SUP))
28173 YJ2INF = MAX( YJMIN, -LOG(TWO/KK-ONE/Z1) )
28174 YJ2SUP = MIN( YJMAX, LOG(TWO/KK-Z1) )
28175 IF (YJ2INF.GE.YJ2SUP) RETURN
28176 Z2=EXP(HWRUNI(2,YJ2INF,YJ2SUP))
28177 XX(1)=.5*(Z1+Z2)*KK
28178 IF (XX(1).GE.ONE) RETURN
28179 XX(2)=XX(1)/(Z1*Z2)
28180 IF (XX(2).GE.ONE) RETURN
28181 COSTH=(Z1-Z2)/(Z1+Z2)
28182 S=XX(1)*XX(2)*PHEP(5,3)**2
28185 IF (RS.LT.RMASS(I)) GOTO 4
28189 IF (MAXFL.EQ.0) CALL HWWARN('HWHQCD',100,*999)
28193 C---SET EMSCA TO HARD PROCESS SCALE (APPROX ET-JET)
28194 EMSCA=SQRT(2.*S*T*U/(S*S+T*T+U*U))
28195 FACTR = GEV2NB*.5*PIFAC*EJ*ET*(HWUALF(1,EMSCA)/S)**2
28196 & * (YJ1SUP-YJ1INF)*(YJ2SUP-YJ2INF)
28197 CALL HWSGEN(.FALSE.)
28208 GFLA=HF*FLOAT(MAXFL)/(EN*RN)**2
28210 ASTU=AF*(1.-2.*UST)
28211 ASUT=AF*(1.-2.*STU)
28212 AUST=AF*(1.-2.*TUS)
28213 C-----------------------------------------------------------------------
28214 C---Colour decomposition modifications below (KO)
28215 C-----------------------------------------------------------------------
28216 BF=HF-AF/EN/TUS/(ASTU+ASUT)
28219 BF=ONE-TWO*AF/EN/STU/(AUST+ASTU)
28222 C-----------------------------------------------------------------------
28224 C BSTU=HF*(ASTU+BF*ST)
28225 C BSUT=HF*(ASUT+BF/US)
28228 C-----------------------------------------------------------------------
28230 CSTU=(CF*(RN-TUS))/TU
28231 CSUT=(CF*(RN-TUS))*TU
28232 CTSU=(FACTR*(UST-RN))*US
28233 CTUS=(FACTR*(UST-RN))/US
28235 DSTU=DF*(1.+1./TUS-STU-UST)
28236 DTSU=DF*(1.+1./UST-STU-TUS)
28237 DUTS=DF*(1.+1./STU-UST-TUS)
28242 IF (DISF(ID1,1).LT.EPS) GOTO 6
28244 IF (DISF(ID2,2).LT.EPS) GOTO 5
28245 DIST=DISF(ID1,1)*DISF(ID2,2)
28249 IF (ID1.NE.ID2) THEN
28251 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3421, 3,*9)
28254 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3421, 1,*9)
28256 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,4312, 2,*9)
28258 ELSEIF (ID2.NE.13) THEN
28259 IF (ID2.NE.ID1+6) THEN
28261 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3142, 9,*9)
28263 HCS=HCS+FLOAT(MAXFL-1)*AUST*DIST
28264 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(-ID1, 0,2413, 4,*9)
28266 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3142, 5,*9)
28268 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,2413, 6,*9)
28270 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP( 13, 13,2413, 7,*9)
28272 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP( 13, 13,2341, 8,*9)
28276 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3142,10,*9)
28278 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3421,11,*9)
28280 ELSEIF (ID1.NE.13) THEN
28283 IF (ID1.NE.ID2+6) THEN
28285 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,2413,17,*9)
28287 HCS=HCS+FLOAT(MAXFL-1)*AUST*DIST
28288 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(-ID1, 0,3142,12,*9)
28290 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,2413,13,*9)
28292 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3142,14,*9)
28294 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP( 13, 13,3142,15,*9)
28296 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP( 13, 13,4123,16,*9)
28298 ELSEIF (ID2.NE.13) THEN
28299 IF (ID1.NE.ID2) THEN
28301 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,4312,20,*9)
28304 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,4312,18,*9)
28306 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3421,19,*9)
28310 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,2413,21,*9)
28312 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,4312,22,*9)
28318 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,2413,23,*9)
28320 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3421,24,*9)
28321 ELSEIF (ID2.LT.13) THEN
28323 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3142,25,*9)
28325 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,4312,26,*9)
28327 HCS=HCS+GFLA*CSTU*DIST
28328 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP( 0, 0,2413,27,*9)
28329 HCS=HCS+GFLA*CSUT*DIST
28330 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP( 0, 0,4123,28,*9)
28332 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,2341,29,*9)
28334 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3421,30,*9)
28336 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,2413,31,*9)
28347 CALL HWETWO(.TRUE.,.TRUE.)
28349 C Calculate coefficients for constructing spin density matrices
28350 IF (IHPRO.EQ.7 .OR.IHPRO.EQ.8 .OR.
28351 & IHPRO.EQ.15.OR.IHPRO.EQ.16) THEN
28352 C qqbar-->gg or qbarq-->gg
28361 ELSEIF (IHPRO.EQ.10.OR.IHPRO.EQ.11.OR.
28362 & IHPRO.EQ.21.OR.IHPRO.EQ.22.OR.
28363 & IHPRO.EQ.23.OR.IHPRO.EQ.24.OR.
28364 & IHPRO.EQ.25.OR.IHPRO.EQ.26) THEN
28365 C qg-->qg or qbarg-->qbarg or gq-->gq or gqbar-->gqbar
28374 ELSEIF (IHPRO.EQ.27.OR.IHPRO.EQ.28) THEN
28384 ELSEIF (IHPRO.EQ.29.OR.IHPRO.EQ.30.OR.
28385 & IHPRO.EQ.31) THEN
28388 GCOEF(2)=2.*U*U*T*T
28389 GCOEF(3)=2.*S*S*U*U
28390 GCOEF(4)=2.*S*S*T*T
28391 GCOEF(1)=GT*GT-GCOEF(2)-GCOEF(3)-GCOEF(4)
28392 GCOEF(5)=GT*(GT-2.*S*S)-GCOEF(2)
28393 GCOEF(6)=GT*(GT-2.*T*T)-GCOEF(3)
28394 GCOEF(7)=GT*(GT-2.*U*U)-GCOEF(4)
28396 CALL HWVZRO(7,GCOEF)
28401 *CMZ :- -26/04/91 10.18.57 by Bryan Webber
28402 *-- Author : Bryan Webber
28403 C-----------------------------------------------------------------------
28404 SUBROUTINE HWHQCP(ID3,ID4,IPERM,IHPR,*)
28405 C-----------------------------------------------------------------------
28406 C IDENTIFIES HARD SUBPROCESS
28407 C-----------------------------------------------------------------------
28408 INCLUDE 'HERWIG65.INC'
28409 INTEGER HWRINT,ID3,ID4,IPERM,IHPR,ND3
28417 IF (ID3.GT.-7) THEN
28418 1 IDN(3)=HWRINT(1,MAXFL)
28419 IF (IDN(3).EQ.ND3) GOTO 1
28422 2 IDN(3)=HWRINT(1,MAXFL)+6
28423 IF (IDN(3).EQ.ND3) GOTO 2
28428 ICO(2)=IPERM/100-10*ICO(1)
28429 ICO(3)=IPERM/10 -10*(IPERM/100)
28430 ICO(4)=IPERM -10*(IPERM/10)
28434 *CMZ :- -27/07/95 14.13.56 by Mike Seymour
28435 *-- Author : Mike Seymour
28436 C-----------------------------------------------------------------------
28438 C HARD PROCESS: GAMGAM --> QQBAR/LLBAR/W+W-
28439 C MEAN EVENT WEIGHT = CROSS-SECTION IN NB AFTER CUTS ON PT
28440 C-----------------------------------------------------------------------
28441 INCLUDE 'HERWIG65.INC'
28442 DOUBLE PRECISION RCS,HCS,RS,S,EMSQ,BE,TMIN,TMAX,T,U,FACTR,Q,CFAC,
28444 INTEGER IHAD1,IHAD2,HQ,ID3,ID4,I1,I2
28445 SAVE HCS,FACTR,HQ,RS
28447 IF (JDAHEP(1,IHAD1).NE.0) IHAD1=JDAHEP(1,IHAD1)
28449 IF (JDAHEP(1,IHAD2).NE.0) IHAD2=JDAHEP(1,IHAD2)
28462 IF (HQ.GT.6) HQ=2*HQ+107
28463 IF (HQ.EQ.127) HQ=198
28466 IF (BE.LT.ZERO) RETURN
28469 IF (HQ.LE.6) CFAC=3
28471 TMIN=S/2*(1-SQRT(MAX(1-4*(EMSQ+PTMIN**2)/S,ZERO)))
28472 TMAX=S/2*(1-SQRT(MAX(1-4*(EMSQ+PTMAX**2)/S,ZERO)))
28473 IF (TMIN.GE.TMAX) RETURN
28474 T=-(TMAX/TMIN)**HWRGEN(1)*TMIN
28475 IF (HWRGEN(2).GT.HALF) T=-S-T
28478 EMSCA=SQRT(2.*S*T*U/(S*S+T*T+U*U))
28479 IF (HQ.NE.198) THEN
28480 FACTR=-GEV2NB*2*LOG(TMAX/TMIN)*MAX(T,U)
28481 $ *2*PIFAC*CFAC*ALPHEM**2/S**2
28482 $ *((U-4*EMSQ)/T+(T-4*EMSQ)/U-4*(EMSQ/T+EMSQ/U)**2)
28484 FACTR=-GEV2NB*2*LOG(TMAX/TMIN)*MAX(T,U)
28485 $ *6*PIFAC*CFAC*ALPHEM**2/S**2
28486 $ *(1-S/(T*U)*(4D0/3*S+2*EMSQ)
28487 $ +(S/(T*U))**2*(2D0/3*S**2+2*EMSQ**2))
28501 IF (RS.GT.2*RMASS(ID3)) THEN
28503 IF (HQ.LE.6) Q=Q/THREE
28505 IF (HQ.EQ.198) ID4=199
28507 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID3,ID4,1243,61,*99)
28515 CALL HWETWO(.TRUE.,.TRUE.)
28518 *CMZ :- -20/10/99 09:46:43 by Peter Richardson
28519 *-- Author : Peter Richardson
28520 C-----------------------------------------------------------------------
28522 C-----------------------------------------------------------------------
28523 C Subroutine for 2 parton -> 2 parton via UDD resonant squarks
28524 C-----------------------------------------------------------------------
28525 INCLUDE 'HERWIG65.INC'
28526 DOUBLE PRECISION HCS,S,RCS,HWRGEN,MQ1,MQ2,TAU,LOWTLM,UPPTLM,RTAB,
28527 & SQSH,MATELM,SCF(12),CHANPB(2),HWRUNI,PCM,MIX(12),
28528 & ME(2,3,3,3,3),WD,MS(12),SWD(12),RAND,TAUA,
28529 & CHAN(12),EPS,SH,FAC,TAUB,LAM(6,3,3,3,3),
28530 & XMIN,XMAX,XPOW,XUPP,MS2(12),MSWD(12)
28531 INTEGER I,J,K,L,I1,J1,K1,L1,N,THEP,CONECT(4,5),HWRINT,
28532 & GENR,GN,MIG,MXG,GEN
28534 EXTERNAL HWRGEN,HWRUNI
28535 PARAMETER(EPS=1D-20)
28536 COMMON/HWRPIN/XMIN,XMAX,XPOW,FIRST
28537 SAVE HCS,ME,MS,SWD,CHAN,LAM,MIX,FAC,SH,SQSH,SCF,MS2,MSWD
28538 DATA CONECT/1,1,3,4,-1,-1,2,3,0,0,0,0,1,1,-2,-3,-1,-1,-3,-4/
28540 RCS = HCS*HWRGEN(0)
28543 C--Extract masses and width's needed
28545 MS(2*I-1) = RMASS(399+2*I)
28546 MS(2*I) = RMASS(411+2*I)
28547 MS(2*I+5) = RMASS(400+2*I)
28548 MS(2*I+6) = RMASS(412+2*I)
28549 SWD(2*I-1) = HBAR/RLTIM(399+2*I)
28550 SWD(2*I) = HBAR/RLTIM(411+2*I)
28551 SWD(2*I+5) = HBAR/RLTIM(400+2*I)
28552 SWD(2*I+6) = HBAR/RLTIM(412+2*I)
28556 MSWD(I) = MS(I)*SWD(I)
28558 C--Now set up the parmaters for multichannel integration
28565 CHANPB(1)=CHANPB(1)+LAMDA3(I,J,K)**2
28566 CHANPB(2)=CHANPB(2)+LAMDA3(K,I,J)**2
28569 RAND=RAND+CHANPB(1)+CHANPB(2)
28571 CHAN(2*K-2+J) = CHANPB(1)*QMIXSS(2*K-1,2,J)**2
28572 CHAN(2*K+4+J) = CHANPB(2)*QMIXSS(2*K ,2,J)**2
28573 MIX(2*K-2+J) = QMIXSS(2*K-1,2,J)**2
28574 MIX(2*K+4+J) = QMIXSS(2*K,2,J)**2
28577 IF(RAND.GT.ZERO) THEN
28579 CHAN(I)=CHAN(I)/RAND
28583 CALL HWWARN('HWHRBB',500,*999)
28585 C--find the couplings
28591 LAM(GN,I,J,K,L) =LAMDA3(I,J,GN)*LAMDA3(K,L,GN)
28592 LAM(GN+3,I,J,K,L)=LAMDA3(GN,I,J)*LAMDA3(GN,K,L)
28601 COSTH = HWRUNI(0,-ONE,ONE)
28602 C--Generate the smoothing
28603 RAND=HWRUNI(0,ZERO,ONE)
28605 IF(CHAN(I).GT.RAND) GOTO 20
28609 C--Calculate hard scale and obtain parton distributions
28611 TAUB = SWD(GENR)**2/S
28612 RTAB = SQRT(TAUA*TAUB)
28614 IF(XMAX**2.GT.S) XUPP = SQRT(S)
28615 LOWTLM = DATAN((XMIN**2/S-TAUA)/RTAB)/RTAB
28616 UPPTLM = DATAN((XUPP**2/S-TAUA)/RTAB)/RTAB
28617 TAU = HWRUNI(0,LOWTLM,UPPTLM)
28618 TAU = RTAB*TAN(RTAB*TAU)+TAUA
28622 XX(1) = EXP(HWRUNI(0,ZERO,LOG(TAU)))
28624 CALL HWSGEN(.FALSE.)
28625 C--Calculate the prefactor due multichannel approach
28628 SCF(GN)=1/((SH-MS2(GN))**2+MSWD(GN)**2)
28629 FAC=FAC+CHAN(GN)*SCF(GN)
28631 FAC=-(UPPTLM-LOWTLM)*LOG(TAU)*GEV2NB
28632 & /(24*PIFAC*SQSH*SH*TAU*FAC*S**2)
28634 C--loop over the quarks
28652 IF(GN.EQ.2.AND.L1.GE.K1) GOTO 70
28656 IF(SQSH.GT.(MQ1+MQ2)) THEN
28657 PCM=SQRT((SH-(MQ1+MQ2)**2)*(SH-(MQ1-MQ2)**2)/(4*SH))
28658 WD = SH*(SH-MQ1**2-MQ2**2)*PCM
28670 IF(J1.GT.I1) GOTO 60
28675 IF(ABS(MIX(GEN)).LT.EPS.OR.
28676 & ABS(LAM(INT((GEN+1)/2),I1,J1,K1,L1)).LT.EPS) GOTO 40
28678 IF(ABS(LAM(INT((GENR+1)/2),I1,J1,K1,L1)).LT.EPS.
28679 & OR.ABS(MIX(GENR)).LT.EPS) GOTO 30
28680 MATELM =MATELM+SCF(GEN)*SCF(GENR)*WD*
28681 & ((SH-MS2(GEN))*(SH-MS2(GENR))+
28682 & MSWD(GEN)*MSWD(GENR))
28683 & *LAM(INT((GEN+1)/2),I1,J1,K1,L1)*MIX(GEN)
28684 & *LAM(INT((GENR+1)/2),I1,J1,K1,L1)*MIX(GENR)
28687 ME(GN,I1,J1,K1,L1) = MATELM*FAC
28688 C--Add up the term to get the cross-section
28689 50 HCS = HCS+ME(GN,I1,J1,K1,L1)*DISF(I,1)*DISF(J,2)
28690 IF(HCS.GT.RCS.AND.GENEV)
28691 & CALL HWHRSS(1,I,J,K,L,0,0,*100)
28692 HCS = HCS+ME(GN,I1,J1,K1,L1)*DISF(J,1)*DISF(I,2)
28693 IF(HCS.GT.RCS.AND.GENEV)
28694 & CALL HWHRSS(2,J,I,K,L,0,0,*100)
28695 HCS = HCS+ME(GN,I1,J1,K1,L1)*DISF(I+6,1)*DISF(J+6,2)
28696 IF(HCS.GT.RCS.AND.GENEV)
28697 & CALL HWHRSS(1,I,J,K,L,1,0,*100)
28698 HCS = HCS+ME(GN,I1,J1,K1,L1)*DISF(J+6,1)*DISF(I+6,2)
28699 IF(HCS.GT.RCS.AND.GENEV)
28700 & CALL HWHRSS(2,J,I,K,L,1,0,*100)
28707 CALL HWETWO(.TRUE.,.TRUE.)
28708 C--first stage of the colour connection corrections
28711 JMOHEP(2,THEP+NHEP-5)=NHEP-5+THEP+CONECT(HWRINT(1,4),THEP)
28712 JDAHEP(2,THEP+NHEP-5) = JMOHEP(2,THEP+NHEP-5)
28716 IF(HWRINT(1,2).EQ.1) THEN
28717 HRDCOL(2,1) = THEP+3
28718 HRDCOL(2,2) = THEP+4
28720 HRDCOL(1,5) = THEP+1
28722 HRDCOL(2,1) = THEP+4
28723 HRDCOL(2,2) = THEP+3
28724 HRDCOL(1,4) = THEP+1
28729 HRDCOL(1,N)=HRDCOL(2,N)
28730 ELSEIF(N.GE.4) THEN
28731 HRDCOL(2,N)=HRDCOL(1,N)
28741 *CMZ :- -20/10/99 09:46:43 by Peter Richardson
28742 *-- Author : Peter Richardson
28743 C-----------------------------------------------------------------------
28745 C-----------------------------------------------------------------------
28746 C Subroutine for 2 parton -> parton SUSY particle via UDD resonant
28748 C-----------------------------------------------------------------------
28749 INCLUDE 'HERWIG65.INC'
28750 DOUBLE PRECISION HCS,S,RCS,HWRGEN,ME(4),CW,MER(6),MZ,TAU,TAUA,
28751 & TAUB,LOWTLM,UPPTLM,HWRUNI,SH,SQSH,SCF(12),MW2,
28752 & LAMC(3),CHANPB(2),PCM,ECM,RAND,MEN(7,6,3,3),
28753 & MEC(2,6,3,3),RTAB,MS(12),SWD(12),AS,HWUALF,
28754 & MQ,MN,MQS,SIN2B,TH,UH,FAC,MX(14),CHAN(12),MC(2),
28755 & MNS,HWUAEM,SW,G,EC,MW,A(7,14),B(7,14),EPS,XUPP,
28756 & MEH(3,42),XMIN,XMAX,XPOW,FAC2,MH(4),ZSQU(2,2),
28757 & ZQRK(2),MZ2,GUU(4),GDD(4),ME2,MS2(12),MSWD(12)
28758 INTEGER I,J,K,I1,J1,GEN,THEP,HWRINT,L,GT,GU,GR,I2,
28759 & CONECT(2,6,5),GN,GENR,SP,SPMN,SPMX,CON,CHARMN,CHARMX,
28761 LOGICAL RAD,NEUT,CHAR,HIGGS,FIRST
28762 EXTERNAL HWRGEN,HWRUNI,HWUAEM,HWUALF,HWRINT
28763 COMMON/HWRPIN/XMIN,XMAX,XPOW,FIRST
28764 SAVE HCS,MS,SWD,MX,CHAN,A,B,SPMN,SPMX,RAD,MEN,MEC,HIGGS,
28765 & CHARMN,CHARMX,NEUT,CHAR,SQSH,MEH,SW,CW,MW,MZ,MER,SH,MH,
28766 & AS,EC,FAC,G,SCF,ZSQU,ZQRK,MW2,MZ2,MS2,MSWD,GUU,GDD
28767 PARAMETER(EPS=1D-20)
28768 DATA CONECT/ 4, 4, 2, 3, 0, 0, 1,-2,-1,-3,-4,-4,
28769 & 3, 4, 3, 3, 0, 0, 1,-3,-1,-4,-3,-3,
28770 & 1, 4,-1, 3, 0, 0, 1, 1,-3,-4,-1,-1,
28771 & 1, 3,-1, 2, 0, 0,-3,-2, 0, 0, 0, 0,
28772 & 1, 4,-1, 3, 0, 0,-3,-2,-1,-1,-1,-1/
28774 RCS = HCS*HWRGEN(0)
28777 C--Extract masses and width's needed
28779 MS(2*I-1) = RMASS(399+2*I)
28780 MS(2*I) = RMASS(411+2*I)
28781 MS(2*I+5) = RMASS(400+2*I)
28782 MS(2*I+6) = RMASS(412+2*I)
28783 SWD(2*I-1) = HBAR/RLTIM(399+2*I)
28784 SWD(2*I) = HBAR/RLTIM(411+2*I)
28785 SWD(2*I+5) = HBAR/RLTIM(400+2*I)
28786 SWD(2*I+6) = HBAR/RLTIM(412+2*I)
28790 MSWD(I) = MS(I)*SWD(I)
28792 C--Electroweak parameters
28799 SIN2B = TWO*SINB*COSB
28800 C--Now set up the parmaters for multichannel integration
28807 CHANPB(1)=CHANPB(1)+LAMDA3(I,J,K)**2
28808 CHANPB(2)=CHANPB(2)+LAMDA3(K,I,J)**2
28811 RAND=RAND+CHANPB(1)+CHANPB(2)
28813 CHAN(2*K-2+J) = CHANPB(1)*QMIXSS(2*K-1,2,J)**2
28814 CHAN(2*K+4+J) = CHANPB(2)*QMIXSS(2*K ,2,J)**2
28815 MX(2*K-2+J) = QMIXSS(2*K-1,2,J)
28816 MX(2*K+4+J) = QMIXSS(2*K,2,J)
28821 IF(RAND.GT.ZERO) THEN
28823 CHAN(I)=CHAN(I)/RAND
28826 CALL HWWARN('HWHRBS',500,*999)
28828 C--Couplings we need for the various processes
28832 A(1,2*I-2+J) = QMIXSS(2*I-1,2,J)
28833 B(1,2*I-2+J) = -QMIXSS(2*I-1,1,J)
28834 A(1,2*I+4+J) = QMIXSS(2*I,2,J)
28835 B(1,2*I+4+J) = -QMIXSS(2*I,1,J)
28838 C--Now the neutralinos
28840 MC(1) = ZMIXSS(L,3)/(2*MW*COSB*SW)
28841 MC(2) = ZMIXSS(L,4)/(2*MW*SINB*SW)
28844 A(L+1,2*I-2+J) = ZSGNSS(L)*(MC(1)*QMIXSS(2*I-1,1,J)*
28845 & RMASS(2*I-1)+SRFCH(2*I-1,L)*QMIXSS(2*I-1,2,J))
28846 B(L+1,2*I-2+J) = MC(1)*QMIXSS(2*I-1,2,J)*
28847 & RMASS(2*I-1)+SLFCH(2*I-1,L)*QMIXSS(2*I-1,1,J)
28848 A(L+1,2*I+4+J) = ZSGNSS(L)*(MC(2)*QMIXSS(2*I,1,J)*
28849 & RMASS(2*I)+SRFCH(2*I ,L)*QMIXSS(2*I,2,J))
28850 B(L+1,2*I+4+J) = MC(2)*QMIXSS(2*I,2,J)*
28851 & RMASS(2*I)+SLFCH(2*I, L)*QMIXSS(2*I,1,J)
28855 C--Now for the charginos
28857 MC(1) = 1/(SQRT(2.0D0)*MW*COSB)
28858 MC(2) = 1/(SQRT(2.0D0)*MW*SINB)
28861 A(5+L,2*I-2+J) = -WSGNSS(L)*WMXVSS(L,2)*MC(2)*
28862 & RMASS(2*I)*QMIXSS(2*I-1,1,J)
28863 B(5+L,2*I-2+J) = WMXUSS(L,1)*QMIXSS(2*I-1,1,J)
28864 & -WMXUSS(L,2)*MC(1)*RMASS(2*I-1)*QMIXSS(2*I-1,2,J)
28865 A(5+L,2*I+4+J) = -WMXUSS(L,2)*MC(1)*RMASS(2*I-1)
28867 B(5+L,2*I+4+J) = WSGNSS(L)*(WMXVSS(L,1)*QMIXSS(2*I,1,J)
28868 & -WMXVSS(L,2)*MC(2)*RMASS(2*I)*QMIXSS(2*I,2,J))
28879 C--Couplings to the Z boson of squarks and right-handed quarks
28880 ZQRK(1) = -SW**2/6.0D0/CW
28881 ZQRK(2) = SW**2/3.0D0/CW
28882 ZSQU(1,1) = HALF*(QMIXSS(5,1,1)**2-2.0D0*SW**2/3.0D0)/CW
28883 ZSQU(1,2) = HALF*QMIXSS(5,1,1)*QMIXSS(5,1,2)/CW
28884 ZSQU(2,1) = -HALF*(QMIXSS(6,1,1)**2-4.0D0*SW**2/3.0D0)/CW
28885 ZSQU(2,2) = -HALF*QMIXSS(6,1,1)*QMIXSS(6,1,2)/CW
28888 MH(I) = RMASS(202+I)
28890 C--Higgs couplings to quarks
28892 GUU(I) = GHUUSS(I)**2*HALF**2/MW2
28893 GDD(I) = GHDDSS(I)**2*HALF**2/MW2
28895 GUU(4) = ONE/TANB**2/MW2/8.0D0
28896 GDD(4) = ONE*TANB**2/MW2/8.0D0
28897 C--decide which processes to generate from IPROC
28906 IF(MOD(IPROC,10000).EQ.4100) THEN
28911 ELSEIF(MOD(IPROC,10000).LT.4120) THEN
28913 IF(MOD(IPROC,10000).NE.4110) THEN
28914 SPMN = MOD(IPROC,10)+1
28918 ELSEIF(MOD(IPROC,10000).LT.4130) THEN
28919 IF(MOD(IPROC,10000).NE.4120) THEN
28920 CHARMN = MOD(IPROC,10)
28924 ELSEIF(MOD(IPROC,10000).EQ.4130) THEN
28927 ELSEIF(MOD(IPROC,10000).EQ.4140) THEN
28929 ELSEIF(MOD(IPROC,10000).EQ.4150) THEN
28932 CALL HWWARN('HWHRBS',501,*999)
28937 COSTH = HWRUNI(0,-ONE,ONE)
28951 C--Multichannel peak
28952 RAND=HWRUNI(0,ZERO,ONE)
28954 IF(CHAN(I).GT.RAND) GOTO 25
28958 C--Calculate the hard scale and obtain parton distributions
28960 TAUB = SWD(GENR)**2/S
28961 RTAB = SQRT(TAUA*TAUB)
28963 IF(XMAX**2.GT.S) XUPP = SQRT(S)
28964 LOWTLM = DATAN((XMIN**2/S-TAUA)/RTAB)/RTAB
28965 UPPTLM = DATAN((XUPP**2/S-TAUA)/RTAB)/RTAB
28966 TAU = HWRUNI(0,LOWTLM,UPPTLM)
28967 TAU = RTAB*TAN(RTAB*TAU)+TAUA
28971 XX(1) = EXP(HWRUNI(0,ZERO,LOG(TAU)))
28973 CALL HWSGEN(.FALSE.)
28974 C--Strong, EM coupling and weak couplings
28975 AS = HWUALF(1,EMSCA)
28976 EC = SQRT(4*PIFAC*HWUAEM(SH))
28978 C--Calculate the prefactor due multichannel approach
28981 SCF(GN)=1/((SH-MS2(GN))**2+MSWD(GN)**2)
28982 FAC=FAC+CHAN(GN)*SCF(GN)
28984 FAC=-(UPPTLM-LOWTLM)*LOG(TAU)*GEV2NB
28985 & /(48*PIFAC*SQSH*SH*TAU*FAC*S**2)
28988 IF(.NOT.NEUT) GOTO 200
28991 IF(CHAN(GR).LT.EPS) GOTO 140
28994 IF(GN.GT.3) K = 2*GN
28996 MN = ABS(RMASS(448+L))
28999 IF(SQSH.LT.(MQ+MN)) GOTO 130
29000 PCM=SQRT((SH-(MQ+MN)**2)*(SH-(MQ-MN)**2)/(4*SH))
29001 ECM=SQRT(PCM**2+MQS)
29002 TH = MQS-SQSH*(ECM-PCM*COSTH)
29003 UH = MQS-SQSH*(ECM+PCM*COSTH)
29009 LAMC(1) = LAMDA3(I,J,GN)**2
29013 LAMC(1) = LAMDA3(GN-3,I,J)**2
29014 IF(J.GT.I) LAMC(1) = ZERO
29018 C--Now the matrix elements
29019 IF(LAMC(1).LT.EPS) GOTO 120
29022 ME(3) = MX(GR)**2*SCF(GR)*SH*((SH-MQS-MNS)*(A(L,GR)**2+
29023 & B(L,GR)**2)-4*MQ*MN*A(L,GR)*B(L,GR))
29024 ME(4) =-TWO*MX(GU)*MX(GT)*(MQS*MNS-UH*TH)*A(L,GT)*A(L,GU)
29025 & /(TH-MS2(GT))/(UH-MS2(GU))
29026 & +TWO*MX(GR)*MX(GU)*(SH-MS2(GR))*SCF(GR)*SH*
29027 & A(L,GU)*(A(L,GR)*UH+B(L,GR)*MQ*MN)/(UH-MS2(GU))
29028 & +TWO*MX(GR)*MX(GT)*(SH-MS2(GR))*SCF(GR)*SH*
29029 & A(L,GT)*(A(L,GR)*TH+B(L,GR)*MQ*MN)/(TH-MS2(GT))
29030 C--L/R s channel and interference
29031 IF(ABS(MX(GR-1)).GT.EPS) THEN
29033 & MX(GR-1)**2*SCF(GR-1)*SH*((SH-MQS-MNS)*(A(L,GR-1)**2
29034 & +B(L,GR-1)**2)-4*MQ*MN*A(L,GR-1)*B(L,GR-1))
29035 & +TWO*MX(GR)*MX(GR-1)*SCF(GR)*SCF(GR-1)*SH*
29036 & ((SH-MS2(GR))*(SH-MS2(GR-1))+MSWD(GR)*MSWD(GR-1))*
29037 & ((SH-MQS-MNS)*(A(L,GR)*A(L,GR-1)
29038 & +B(L,GR)*B(L,GR-1))
29039 & -TWO*MQ*MN*(A(L,GR)*B(L,GR-1)+A(L,GR-1)*B(L,GR)))
29040 ME(4) = ME(4)+TWO*MX(GR-1)*MX(GU)*(SH-MS2(GR-1))
29041 & *SCF(GR-1)*A(L,GU)*SH*(A(L,GR-1)*UH+B(L,GR-1)*MQ*MN)
29043 & +TWO*MX(GR-1)*MX(GT)*(SH-MS2(GR-1))*SCF(GR-1)*SH*
29044 & A(L,GT)*(A(L,GR-1)*TH+B(L,GR-1)*MQ*MN)/(TH-MS2(GT))
29045 IF(ABS(MX(GU-1)).GT.EPS) ME(4)=ME(4)+TWO*MX(GR-1)*
29046 & MX(GU-1)*(SH-MS2(GR-1))*SCF(GR-1)*A(L,GU-1)*SH*(
29047 & A(L,GR-1)*UH+B(L,GR-1)*MQ*MN)/(UH-MS2(GU-1))
29048 IF(ABS(MX(GT-1)).GT.EPS) ME(4)=ME(4)+TWO*MX(GR-1)*
29049 & MX(GT-1)*(SH-MS2(GR-1))*SCF(GR-1)*A(L,GT-1)*SH*
29050 & (A(L,GR-1)*TH+B(L,GR-1)*MQ*MN)/(TH-MS2(GT-1))
29052 C--u channel and L/R mixing
29053 ME(1)= MX(GU)**2*(MQS-UH)*(MNS-UH)*
29054 & (A(L,GU)**2+B(L,GU)**2)/(UH-MS2(GU))**2
29055 IF(ABS(MX(GU-1)).GT.EPS) THEN
29056 ME(1) = ME(1)+MX(GU-1)**2*(MQS-UH)*(MNS-UH)*
29057 & (A(L,GU-1)**2+B(L,GU-1)**2)/(UH-MS2(GU-1))**2
29058 & +TWO*MX(GU)*MX(GU-1)*(MQS-UH)*(MNS-UH)*
29059 & (A(L,GU)*A(L,GU-1)+B(L,GU)*B(L,GU-1))
29060 & /(UH-MS2(GU))/(UH-MS2(GU-1))
29061 ME(4) =ME(4)+TWO*MX(GR)*MX(GU-1)*(SH-MS2(GR))*
29062 & SCF(GR)*A(L,GU-1)*SH*(A(L,GR)*UH+B(L,GR)*MQ*MN)
29064 & -2*MX(GU-1)*MX(GT)*(MQS*MNS-UH*TH)*A(L,GT)*
29065 & A(L,GU-1)/(TH-MS2(GT))/(UH-MS2(GU-1))
29066 IF(ABS(MX(GT-1)).GT.EPS) ME(4)=ME(4)-2*MX(GU-1)*MX(GT-1)
29067 & *(MQS*MNS-UH*TH)*A(L,GT-1)*A(L,GU-1)
29068 & /(TH-MS2(GT-1))/(UH-MS2(GU-1))
29070 C--t channel and t channel L/R mixing
29071 ME(2) = MX(GT)**2*(MQS-TH)*(MNS-TH)*
29072 & (A(L,GT)**2+B(L,GT)**2)/(TH-MS2(GT))**2
29073 IF(ABS(MX(GT-1)).GT.EPS) THEN
29074 ME(2) = ME(2)+MX(GT-1)**2*(MQS-TH)*(MNS-TH)*
29075 & (A(L,GT-1)**2+B(L,GT-1)**2)/(TH-MS2(GT-1))**2
29076 & +TWO*MX(GT)*MX(GT-1)*(MQS-TH)*(MNS-TH)*(A(L,GT)*
29077 & A(L,GT-1)+ B(L,GT)*B(L,GT-1))
29078 & /(TH-MS2(GT))/(TH-MS2(GT-1))
29079 ME(4)=ME(4)-TWO*MX(GU)*MX(GT-1)*(MQS*MNS-UH*TH)*
29080 & A(L,GT-1)*A(L,GU)/(TH-MS2(GT-1))/(UH-MS2(GU))
29081 & +TWO*MX(GR)*MX(GT-1)*(SH-MS2(GR))*SCF(GR)*
29082 & A(L,GT-1)*SH*(A(L,GR)*TH+B(L,GR)*MQ*MN)
29085 C--Angular ordering and the phase space factors
29087 ME(4)=-HALF*ME(4)/(ME(1)+ME(2)+ME(3))
29088 LAMC(1) = 32.0D0*LAMC(1)*AS*PIFAC/THREE
29090 MEN(GEN,GN,I,J) = FAC*PCM*LAMC(1)*ME(GEN)*(ONE+ME(4))
29093 LAMC(1) = TWO*LAMC(1)*EC**2
29094 MEN(L+2,GN,I,J)=FAC*PCM*LAMC(1)*(ME(1)+ME(2)+ME(3)+ME(4))
29096 C--Multiply by the pdf's
29097 110 IF(L.EQ.1) THEN
29106 IF(GEN.LE.3) CON = GEN
29107 HCS=HCS+MEN(GEN,GN,I,J)*DISF(I1,1)*DISF(J1,2)
29108 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(3,I1,J1,K,GEN,0,0,*900)
29109 HCS=HCS+MEN(GEN,GN,I,J)*DISF(J1,1)*DISF(I1,2)
29110 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(4,J1,I1,K,GEN,0,0,*900)
29111 HCS=HCS+MEN(GEN,GN,I,J)*DISF(I1+6,1)*DISF(J1+6,2)
29112 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(3,I1,J1,K,GEN,1,0,*900)
29113 HCS=HCS+MEN(GEN,GN,I,J)*DISF(J1+6,1)*DISF(I1+6,2)
29114 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(4,J1,I1,K,GEN,1,0,*900)
29120 C--Now the chargino processes if wanted
29121 200 IF(.NOT.CHAR) GOTO 300
29124 IF(CHAN(GR).LT.EPS) GOTO 240
29125 DO 230 L=CHARMN,CHARMX
29128 IF(GN.GT.3) K = 2*GN-1
29130 MN = ABS(RMASS(453+L))
29133 IF(SQSH.LT.(MQ+MN)) GOTO 230
29134 PCM=SQRT((SH-(MQ+MN)**2)*(SH-(MQ-MN)**2)/(4*SH))
29135 ECM=SQRT(PCM**2+MQS)
29136 TH = MQS-SQSH*(ECM-PCM*COSTH)
29137 UH = MQS-SQSH*(ECM+PCM*COSTH)
29144 LAMC(1) = LAMDA3(I,J,GN)
29145 LAMC(2) = LAMDA3(GN,I,J)
29151 LAMC(1) = LAMDA3(GN-3,I,J)
29152 LAMC(2) = LAMDA3(I,J,GN-3)
29153 LAMC(3) = LAMDA3(J,GN-3,I)
29154 IF(J.GT.I) LAMC(1) = ZERO
29157 IF(ABS(LAMC(1)).LT.EPS) GOTO 220
29161 ME(1) = LAMC(1)**2*MX(GR)**2*SCF(GR)*SH*((SH-MQS-MNS)*
29162 & (A(SP,GR)**2+B(SP,GR)**2)-4*MQ*MN*A(SP,GR)*B(SP,GR))
29163 IF(ABS(MX(GU)).GT.EPS) THEN
29164 ME(1) = ME(1)+LAMC(2)**2*MX(GU)**2*(MQS-UH)*(MNS-UH)*
29165 & (A(SP,GU)**2+B(SP,GU)**2)/(UH-MS2(GU))**2
29166 & +LAMC(1)*LAMC(2)*TWO*MX(GR)*MX(GU)*
29167 & (SH-MS2(GR))*SCF(GR)*A(SP,GU)*SH*
29168 & (A(SP,GR)*UH+B(SP,GR)*MQ*MN)/(UH-MS2(GU))
29169 IF(ABS(MX(GT)).GT.EPS) ME(1) = ME(1)-LAMC(2)*LAMC(3)*
29170 & TWO*MX(GU)*MX(GT)*(MQS*MNS-UH*TH)*A(SP,GT)*
29171 & A(SP,GU)/(TH-MS2(GT))/(UH-MS2(GU))
29173 IF(ABS(MX(GT)).GT.EPS) THEN
29174 ME(1) = ME(1)+LAMC(3)**2*MX(GT)**2*(MQS-TH)*(MNS-TH)*
29175 & (A(SP,GT)**2+B(SP,GT)**2)/(TH-MS2(GT))**2
29176 & +LAMC(1)*LAMC(3)*TWO*MX(GR)*MX(GT)*
29177 & (SH-MS2(GR))*SCF(GR)*A(SP,GT)*SH*
29178 & (A(SP,GR)*TH+B(SP,GR)*MQ*MN)/(TH-MS2(GT))
29180 c--L/R s channel and interference
29181 IF(ABS(MX(GR-1)).GT.EPS) THEN
29182 ME(1) = ME(1)+LAMC(1)**2*MX(GR-1)**2*SCF(GR-1)*SH*
29183 & ((SH-MQS-MNS)*(A(SP,GR-1)**2+B(SP,GR-1)**2)
29184 & -4*MQ*MN*A(SP,GR-1)*B(SP,GR-1))
29185 & +LAMC(1)**2*TWO*MX(GR)*MX(GR-1)*SCF(GR)*
29187 & ((SH-MS2(GR))*(SH-MS2(GR-1))+
29188 & MSWD(GR)*MSWD(GR-1))*
29189 & ((SH-MQS-MNS)*(A(SP,GR)*A(SP,GR-1)+
29190 & B(SP,GR)*B(SP,GR-1))-TWO*MQ*MN*
29191 & (A(SP,GR)*B(SP,GR-1)+A(SP,GR-1)*B(SP,GR)))
29192 IF(ABS(MX(GU)).GT.EPS) ME(1) = ME(1)+LAMC(1)*LAMC(2)*
29193 & TWO*MX(GR-1)*MX(GU)*(SH-MS2(GR-1))*SCF(GR-1)*
29194 & A(SP,GU)*SH*(A(SP,GR-1)*UH+B(SP,GR-1)*MQ*MN)
29196 IF(ABS(MX(GT)).GT.EPS) ME(1) = ME(1)+LAMC(1)*LAMC(3)*
29197 & TWO*MX(GR-1)*MX(GT)*(SH-MS2(GR-1))*SCF(GR-1)*
29198 & A(SP,GT)*SH*(A(SP,GR-1)*TH+B(SP,GR-1)*MQ*MN)
29200 IF(ABS(MX(GU-1)).GT.EPS) ME(1)=ME(1)+LAMC(1)*LAMC(2)*
29201 & TWO*MX(GR-1)*MX(GU-1)*(SH-MS2(GR-1))*
29202 & SCF(GR-1)*A(SP,GU-1)*SH*(A(SP,GR-1)*UH+
29203 & B(SP,GR-1)*MQ*MN)/(UH-MS2(GU-1))
29204 IF(ABS(MX(GT-1)).GT.EPS) ME(1)=ME(1)+LAMC(1)*LAMC(3)*
29205 & TWO*MX(GR-1)*MX(GT-1)*(SH-MS2(GR-1))*
29206 & SCF(GR-1)*A(SP,GT-1)*SH*(A(SP,GR-1)*TH+
29207 & B(SP,GR-1)*MQ*MN)/(TH-MS2(GT-1))
29209 C--u channel and L/R mixing
29210 IF(ABS(MX(GU-1)).GT.EPS) THEN
29211 ME(1) = ME(1)+LAMC(2)**2*MX(GU-1)**2*(MQS-UH)*(MNS-UH)*
29212 & (A(SP,GU-1)**2+B(SP,GU-1)**2)/(UH-MS2(GU-1))**2
29213 & +LAMC(2)**2*TWO*MX(GU)*MX(GU-1)*(MQS-UH)*(MNS-UH)*
29214 & (A(SP,GU)*A(SP,GU-1)+B(SP,GU)*B(SP,GU-1))
29215 & /(UH-MS2(GU))/(UH-MS2(GU-1))
29216 & +TWO*LAMC(1)*LAMC(2)*MX(GR)*MX(GU-1)*
29217 & (SH-MS2(GR))*SCF(GR)*A(SP,GU-1)*SH*
29218 & (A(SP,GR)*UH+B(SP,GR)*MQ*MN)/(UH-MS2(GU-1))
29219 IF(ABS(MX(GT)).GT.EPS) ME(1)=ME(1)-LAMC(2)*LAMC(3)*TWO*
29220 & MX(GU-1)*MX(GT)*(MQS*MNS-UH*TH)*A(SP,GT)*A(SP,GU-1)
29221 & /(TH-MS2(GT))/(UH-MS2(GU-1))
29222 IF(ABS(MX(GT-1)).GT.EPS) ME(1)=ME(1)-LAMC(2)*LAMC(3)*
29223 & TWO*MX(GU-1)*MX(GT-1)*(MQS*MNS-UH*TH)*A(SP,GT-1)*
29224 & A(SP,GU-1)/(TH-MS2(GT-1))/(UH-MS2(GU-1))
29226 C--t channel and t channel L/R mixing
29227 IF(ABS(MX(GT-1)).GT.EPS) THEN
29228 ME(1) = ME(1)+LAMC(3)**2*MX(GT-1)**2*(MQS-TH)*(MNS-TH)*
29229 & (A(SP,GT-1)**2+B(SP,GT-1)**2)/(TH-MS2(GT-1))**2
29230 & +LAMC(3)**2*TWO*MX(GT)*MX(GT-1)*(MQS-TH)*(MNS-TH)*
29231 & (A(SP,GT)*A(SP,GT-1)+B(SP,GT)*B(SP,GT-1))
29232 & /(TH-MS2(GT))/(TH-MS2(GT-1))
29233 & +LAMC(1)*LAMC(3)*TWO*MX(GR)*MX(GT-1)*
29234 & (SH-MS2(GR))*SCF(GR)*A(SP,GT-1)*SH*
29235 & (A(SP,GR)*TH+B(SP,GR)*MQ*MN)/(TH-MS2(GT-1))
29236 IF(ABS(MX(GU)).GT.EPS) ME(1)=ME(1)-LAMC(2)*LAMC(3)*TWO*
29237 & MX(GU)*MX(GT-1)*(MQS*MNS-UH*TH)*A(SP,GT-1)*A(SP,GU)
29238 & /(TH-MS2(GT-1))/(UH-MS2(GU))
29240 c--phase space factors
29241 MEC(L,GN,I,J) = G**2*FAC*ME(1)*PCM
29244 IF(MOD(K,2).EQ.1) I2 =I2+2
29245 HCS=HCS+MEC(L,GN,I,J)*DISF(I1,1)*DISF(J1,2)
29246 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(3,I1,J1,K,I2,0,0,*900)
29247 HCS=HCS+MEC(L,GN,I,J)*DISF(J1,1)*DISF(I1,2)
29248 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(4,J1,I1,K,I2,0,0,*900)
29249 HCS=HCS+MEC(L,GN,I,J)*DISF(I1+6,1)*DISF(J1+6,2)
29250 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(3,I1,J1,K,I2+2,1,0,*900)
29251 HCS=HCS+MEC(L,GN,I,J)*DISF(J1+6,1)*DISF(I1+6,2)
29252 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(4,J1,I1,K,I2+2,1,0,*900)
29257 C--Now the radiative decays, if possible
29258 300 IF(.NOT.RAD.OR.(CHAN(5).LT.EPS.AND.CHAN(11).LT.EPS)) GOTO 400
29262 C--stop to light stop and Z
29263 IF(SH.GT.(MZ+MS(11))**2) THEN
29264 PCM = SQRT((SH-(MZ+MS(11))**2)*(SH-(MZ-MS(11))**2))*HALF/SQSH
29265 ECM=SQRT(PCM**2+MZ2)
29266 TH = MZ2-SQSH*(ECM-PCM*COSTH)
29267 UH = MZ2-SQSH*(ECM+PCM*COSTH)
29268 MER(3) = SH**2*PCM**2*(SCF(11)*ZSQU(2,1)**2*QMIXSS(6,2,1)**2
29269 & +SCF(12)*ZSQU(2,2)**2*QMIXSS(6,2,2)**2
29270 & +TWO*SCF(11)*SCF(12)*QMIXSS(6,2,1)*QMIXSS(6,2,2)*
29271 & ZSQU(2,1)*ZSQU(2,2)*((SH-MS2(11))*
29272 & (SH-MS2(12))+MSWD(11)*MSWD(12)))
29273 & +QMIXSS(6,2,1)**2/UH**2*ZQRK(1)**2*(
29274 & TWO*MZ2*(UH*TH-MS2(11)*MZ2)+UH**2*SH)
29275 & +QMIXSS(6,2,1)**2/TH**2*ZQRK(1)**2*(
29276 & TWO*MZ2*(UH*TH-MS2(11)*MZ2)+TH**2*SH)
29277 & +ZQRK(1)*SH*QMIXSS(6,2,1)*
29278 & (QMIXSS(6,2,1)*ZSQU(2,1)*(SH-MS2(11))*SCF(11)
29279 & +QMIXSS(6,2,2)*ZSQU(2,2)*(SH-MS2(12))*SCF(12))
29280 & *((MZ2*(TWO*MS2(11)-TH)+TH*(SH-MS2(11)))/TH
29281 & +(MZ2*(TWO*MS2(11)-UH)+UH*(SH-MS2(11)))/UH)
29282 & -TWO*QMIXSS(6,2,1)**2/UH/TH*ZQRK(1)**2*
29283 & (TWO*MZ2*(MS2(11)-UH)*(MS2(11)-TH)-SH*TH*UH)
29284 MER(3) = MER(3)*FOUR*PCM/MZ2
29286 C--sbottom to light sbottom and Z
29287 IF(SH.GT.(MZ+MS(5))**2) THEN
29288 PCM = SQRT((SH-(MZ+MS(5))**2)*(SH-(MZ-MS(5))**2))*HALF/SQSH
29289 ECM=SQRT(PCM**2+MZ2)
29290 TH = MZ2-SQSH*(ECM-PCM*COSTH)
29291 UH = MZ2-SQSH*(ECM+PCM*COSTH)
29292 MER(6) = SH**2*PCM**2*(SCF(5)*QMIXSS(5,2,1)**2*ZSQU(1,1)**2
29293 & +SCF(6)*QMIXSS(5,2,2)**2*ZSQU(1,2)**2
29294 & +TWO*SCF(5)*SCF(6)*QMIXSS(5,2,1)*QMIXSS(5,2,2)*
29295 & ZSQU(1,1)*ZSQU(1,2)*((SH-MS2(5))*
29296 & (SH-MS2(6))+MSWD(5)*MSWD(6)))
29297 & +QMIXSS(5,2,1)**2/UH**2*ZQRK(1)**2*
29298 & (TWO*MZ2*(UH*TH-MS2(5)*MZ2)+UH**2*SH)
29299 & +QMIXSS(5,2,1)**2/TH**2*ZQRK(2)**2*
29300 & (TWO*MZ2*(UH*TH-MS2(5)*MZ2)+TH**2*SH)
29301 & +QMIXSS(5,2,1)*SH*
29302 & (QMIXSS(5,2,1)*ZSQU(1,1)*(SH-MS2(5))*SCF(5)
29303 & +QMIXSS(5,2,2)*ZSQU(1,2)*(SH-MS2(6))*SCF(6))*
29304 & (ZQRK(1)/UH*(MZ2*(TWO*MS2(5)-UH)+(SH-MS2(5))*UH)
29305 & +ZQRK(2)/TH*(MZ2*(TWO*MS2(5)-TH)+(SH-MS2(5))*TH))
29306 & -TWO*QMIXSS(5,2,1)**2*ZQRK(1)*ZQRK(2)/UH/TH*
29307 & (TWO*MZ2*(MS2(5)-UH)*(MS2(5)-TH)-SH*TH*UH)
29308 MER(6) = MER(6)*FOUR*PCM/MZ2
29310 C--stop to sbottom and W
29312 IF(SH.GT.(MW+MS(4+J))**2) THEN
29313 PCM =SQRT((SH-(MW+MS(4+J))**2)*(SH-(MW-MS(4+J))**2))*HALF/SQSH
29314 C--diagram square pieces
29316 MER(J)=MER(J)+SCF(10+I)*
29317 & (QMIXSS(6,2,I)*QMIXSS(6,1,I)*QMIXSS(5,1,J))**2
29319 C--light/heavy interference
29320 MER(J)=TWO*SH**2*PCM**3/MW2*(MER(J)+TWO*SCF(11)*SCF(12)*
29321 & ((SH-MS2(11))*(SH-MS2(12))
29322 & +MSWD(11)*MSWD(12))*QMIXSS(5,1,J)**2*
29323 & QMIXSS(6,2,1)*QMIXSS(6,2,2)*QMIXSS(6,1,1)*QMIXSS(6,1,2))
29325 C--sbottom to stop and W
29326 IF(SH.GT.(MW+MS(10+J))**2) THEN
29327 PCM=SQRT((SH-(MW+MS(10+J))**2)*(SH-(MW-MS(10+J))**2))*HALF/SQSH
29328 C--diagram square pieces
29330 MER(J+3)=MER(J+3)+SCF(4+I)*
29331 & (QMIXSS(5,2,I)*QMIXSS(5,1,I)*QMIXSS(6,1,J))**2
29333 C--light/heavy interference
29334 MER(J+3)=TWO*SH**2*PCM**3/MW2*(MER(J+3)+TWO*SCF(5)*SCF(6)*
29335 & ((SH-MS2(5))*(SH-MS2(6))+
29336 & MSWD(5)*MSWD(6))*QMIXSS(6,1,J)**2*
29337 & QMIXSS(5,2,1)*QMIXSS(5,2,2)*QMIXSS(5,1,1)*QMIXSS(5,1,2))
29340 C--Now multiply by the parton distributions and phase space factors
29345 IF(ABS(LAMDA3(3,J,K)).GT.EPS.AND.J.LT.K) THEN
29346 FAC2 = LAMDA3(3,J,K)**2*FAC*G**2
29351 HCS=HCS+ME2*DISF(I1,1)*DISF(J1,2)
29352 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(5,I1,J1,I,I,0,0,*900)
29353 HCS=HCS+ME2*DISF(J1,1)*DISF(I1,2)
29354 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(6,J1,I1,I,I,0,0,*900)
29355 HCS=HCS+ME2*DISF(I1+6,1)*DISF(J1+6,2)
29356 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(5,I1,J1,I,I,1,0,*900)
29357 HCS=HCS+ME2*DISF(J1+6,1)*DISF(I1+6,2)
29358 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(6,J1,I1,I,I,1,0,*900)
29361 C--resonant sbottom's
29362 IF(ABS(LAMDA3(J,K,3)).GT.EPS) THEN
29363 FAC2 = LAMDA3(J,K,3)**2*FAC*G**2
29368 HCS=HCS+ME2*DISF(I1,1)*DISF(J1,2)
29369 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(5,I1,J1,I,I,0,0,*900)
29370 HCS=HCS+ME2*DISF(J1,1)*DISF(I1,2)
29371 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(6,J1,I1,I,I,0,0,*900)
29372 HCS=HCS+ME2*DISF(I1+6,1)*DISF(J1+6,2)
29373 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(5,I1,J1,I,I,1,0,*900)
29374 HCS=HCS+ME2*DISF(J1+6,1)*DISF(I1+6,2)
29375 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(6,J1,I1,I,I,1,0,*900)
29380 C--Now the Higgs decays if possible
29381 400 IF(.NOT.HIGGS) GOTO 900
29385 405 MEH(I,J) = ZERO
29389 C--Neutral Higgs down type squark
29390 IF(SQSH.LT.MH(J)+MS(2*I-1)) GOTO 410
29391 PCM = SQRT((SH-(MH(J)+MS(2*I-1))**2)*
29392 & (SH-(MH(J)-MS(2*I-1))**2))*HALF/SQSH
29393 ECM=SQRT(PCM**2+MH(J)**2)
29394 TH = MH(J)**2-SQSH*(ECM-PCM*COSTH)
29395 UH = MH(J)**2-SQSH*(ECM+PCM*COSTH)
29396 MEH(1,3*I-3+J) = PCM*SH*(
29397 & QMIXSS(2*I-1,2,1)**2*SCF(2*I-1)*GHSQSS(J,2*I-1,1,1)**2
29398 & +QMIXSS(2*I-1,2,2)**2*SCF(2*I)*GHSQSS(J,2*I-1,2,1)**2
29399 & +TWO*QMIXSS(2*I-1,2,1)*QMIXSS(2*I-1,2,2)*SCF(2*I-1)
29400 & *SCF(2*I)*GHSQSS(J,2*I-1,1,1)*GHSQSS(J,2*I-1,2,1)*
29401 & ((SH-MS2(2*I-1))*(SH-MS2(2*I))+MSWD(2*I-1)*MSWD(2*I)))
29402 MEH(2,3*I-3+J) = PCM*GUU(J)*QMIXSS(2*I,2,1)**2/TH**2*
29403 & (TH*UH-MH(J)**2*MS2(2*I-1))
29404 MEH(3,3*I-3+J) = PCM*GDD(J)*QMIXSS(2*I,2,1)**2/UH**2*
29405 & (TH*UH-MH(J)**2*MS2(2*I-1))
29406 C--Neutral Higgs up type squarks
29407 410 IF(SQSH.LT.MH(J)+MS(2*I+5)) GOTO 420
29408 PCM = SQRT((SH-(MH(J)+MS(2*I+5))**2)*
29409 & (SH-(MH(J)-MS(2*I+5))**2))*HALF/SQSH
29410 ECM=SQRT(PCM**2+MH(J)**2)
29411 TH = MH(J)**2-SQSH*(ECM-PCM*COSTH)
29412 UH = MH(J)**2-SQSH*(ECM+PCM*COSTH)
29413 MEH(1,3*I+6+J) = PCM*SH*(
29414 & QMIXSS(2*I,2,1)**2*SCF(2*I+5)*GHSQSS(J,2*I,1,1)**2
29415 & +QMIXSS(2*I,2,2)**2*SCF(2*I+6)*GHSQSS(J,2*I,2,1)**2
29416 & +TWO*QMIXSS(2*I,2,1)*QMIXSS(2*I,2,2)*SCF(2*I+5)
29417 & *SCF(2*I+6)*GHSQSS(J,2*I,1,1)*GHSQSS(J,2*I,2,1)*
29418 & ((SH-MS2(2*I+5))*(SH-MS2(2*I+6))+
29419 & MSWD(2*I+5)*MSWD(2*I+6)))
29420 MEH(2,3*I+6+J) = PCM*GDD(J)*QMIXSS(2*I-1,2,1)**2/TH**2*
29421 & (TH*UH-MH(J)**2*MS2(2*I+5))
29422 MEH(3,3*I+6+J) = PCM*GDD(J)*QMIXSS(2*I-1,2,1)**2/UH**2*
29423 & (TH*UH-MH(J)**2*MS2(2*I+5))
29425 C--Charged Higgs up type squark
29427 IF(SQSH.LT.MH(4)+MS(2*I+4+J)) GOTO 430
29428 PCM = SQRT((SH-(MH(4)+MS(2*I+4+J))**2)*
29429 & (SH-(MH(4)-MS(2*I+4+J))**2))*HALF/SQSH
29430 ECM=SQRT(PCM**2+MH(4)**2)
29431 TH = MH(4)**2-SQSH*(ECM-PCM*COSTH)
29432 UH = MH(4)**2-SQSH*(ECM+PCM*COSTH)
29433 MEH(1,4*I+14+J) = PCM*SH*(
29434 & QMIXSS(2*I-1,2,1)**2*GHSQSS(4,2*I,J,1)**2*SCF(2*I-1)
29435 & +QMIXSS(2*I-1,2,2)**2*GHSQSS(4,2*I,J,2)**2*SCF(2*I)
29436 & +TWO*QMIXSS(2*I-1,2,1)*QMIXSS(2*I-1,2,2)*SCF(2*I-1)
29437 & *SCF(2*I)*GHSQSS(4,2*I,J,1)*GHSQSS(4,2*I,J,2)*
29438 & ((SH-MS2(2*I-1))*(SH-MS2(2*I))+
29439 & MSWD(2*I-1)*MSWD(2*I)))
29440 MEH(2,4*I+14+J) = PCM*QMIXSS(2*I,2,J)**2*GDD(4)/TH**2*
29441 & (UH*TH-MS2(2*I+4+J)*MH(4)**2)
29442 C--Charged Higgs down type squark
29443 430 IF(SQSH.LT.MH(4)+MS(2*I-2+J)) GOTO 440
29444 PCM = SQRT((SH-(MH(4)+MS(2*I-2+J))**2)*
29445 & (SH-(MH(4)-MS(2*I-2+J))**2))*HALF/SQSH
29446 ECM=SQRT(PCM**2+MH(4)**2)
29447 TH = MH(4)**2-SQSH*(ECM-PCM*COSTH)
29448 UH = MH(4)**2-SQSH*(ECM+PCM*COSTH)
29449 MEH(1,4*I+16+J) = PCM*SH*(
29450 & QMIXSS(2*I,2,1)**2*GHSQSS(4,2*I-1,J,1)**2*SCF(2*I+5)
29451 & +QMIXSS(2*I,2,2)**2*GHSQSS(4,2*I-1,J,2)**2*SCF(2*I+6)
29452 & +TWO*QMIXSS(2*I,2,1)*QMIXSS(2*I,2,2)*SCF(2*I+5)
29453 & *SCF(2*I+6)*GHSQSS(4,2*I-1,J,1)*GHSQSS(4,2*I-1,J,2)*
29454 & ((SH-MS2(2*I+5))*(SH-MS2(2*I+6))+
29455 & MSWD(2*I+5)*MSWD(2*I+6)))
29456 MEH(2,4*I+16+J) = PCM*QMIXSS(2*I-1,2,J)**2*GUU(4)/TH**2*
29457 & (UH*TH-MS2(2*I-2+J)*MH(4)**2)
29458 MEH(3,4*I+16+J) = PCM*QMIXSS(2*I-1,2,J)**2*GUU(4)/UH**2*
29459 & (UH*TH-MS2(2*I-2+J)*MH(4)**2)
29467 IF(ABS(LAMDA3(J,K,I)).GT.EPS) THEN
29468 C--neutral higgs and sdown
29469 FAC2 = FAC*G**2*LAMDA3(J,K,I)**2
29472 ME2 = FAC2*(MEH(1,3*I-3+L)+RMASS(I1)**2*MEH(2,3*I-3+L)
29473 & +RMASS(J1)**2*MEH(3,3*I-3+L))
29474 HCS=HCS+ME2*DISF(I1,1)*DISF(J1,2)
29475 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(7,I1,J1,L,2*I-1,0,0,*900)
29476 HCS=HCS+ME2*DISF(J1,1)*DISF(I1,2)
29477 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(8,J1,I1,L,2*I-1,0,0,*900)
29478 IF(I2.NE.200) I2=198
29479 HCS=HCS+ME2*DISF(I1+6,1)*DISF(J1+6,2)
29480 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(7,I1,J1,L,2*I-1,1,0,*900)
29481 HCS=HCS+ME2*DISF(J1+6,1)*DISF(I1+6,2)
29482 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(8,J1,I1,L,2*I-1,1,0,*900)
29484 IF(ABS(LAMDA3(I,J,K)).GT.EPS.AND.J.LT.K) THEN
29485 FAC2 = FAC*G**2*LAMDA3(I,J,K)**2
29486 C--neutral higgs and sup
29489 ME2 = FAC2*(MEH(1,3*I+6+L)+RMASS(I1)**2*MEH(2,3*I+6+L)
29490 & +RMASS(J1)**2*MEH(3,3*I+6+L))
29491 HCS=HCS+ME2*DISF(I1,1)*DISF(J1,2)
29492 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(7,I1,J1,L,2*I+5,0,0,*900)
29493 HCS=HCS+ME2*DISF(J1,1)*DISF(I1,2)
29494 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(8,J1,I1,L,2*I+5,0,0,*900)
29495 HCS=HCS+ME2*DISF(I1+6,1)*DISF(J1+6,2)
29496 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(7,I1,J1,L,2*I+5,1,0,*900)
29497 HCS=HCS+ME2*DISF(J1+6,1)*DISF(I1+6,2)
29498 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(8,J1,I1,L,2*I+5,1,0,*900)
29502 IF(ABS(LAMDA3(J,K,I)).GT.EPS) THEN
29503 C--charged higgs and sup
29507 ME2 = FAC2*(LAMDA3(J,K,I)**2*MEH(1,4*I+L+14)
29508 & +LAMDA3(I,J,K)**2*RMASS(I1-1)**2*MEH(2,4*I+L+14))
29509 HCS= HCS+ME2*DISF(I1,1)*DISF(J1,2)
29510 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(7,I1,J1,4,2*I+4+L,0,0,*900)
29511 HCS= HCS+ME2*DISF(J1,1)*DISF(I1,2)
29512 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(8,J1,I1,4,2*I+4+L,0,0,*900)
29513 HCS= HCS+ME2*DISF(I1+6,1)*DISF(J1+6,2)
29514 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(7,I1,J1,5,2*I+4+L,1,0,*900)
29515 HCS= HCS+ME2*DISF(J1+6,1)*DISF(I1+6,2)
29516 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(8,J1,I1,5,2*I+4+L,1,0,*900)
29518 C--charged higgs and sdown
29519 IF(ABS(LAMDA3(I,J,K)).GT.EPS.AND.J.LT.K) THEN
29523 ME2 = FAC2*(MEH(1,4*I+L+16)*LAMDA3(I,J,K)**2
29524 & +RMASS(I1+1)**2*LAMDA3(J,I,K)**2*MEH(2,4*I+L+16)
29525 & +RMASS(J1+1)**2*LAMDA3(K,I,J)**2*MEH(3,4*I+L+16))
29526 HCS=HCS+ME2*DISF(I1,1)*DISF(J1,2)
29527 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(7,I1,J1,5,2*I-2+L,0,0,*900)
29528 HCS=HCS+ME2*DISF(J1,1)*DISF(I1,2)
29529 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(8,J1,I1,5,2*I-2+L,0,0,*900)
29530 HCS=HCS+ME2*DISF(I1+6,1)*DISF(J1+6,2)
29531 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(7,I1,J1,4,2*I-2+L,1,0,*900)
29532 HCS=HCS+ME2*DISF(J1+6,1)*DISF(I1+6,2)
29533 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(8,J1,I1,4,2*I-2+L,1,0,*900)
29539 C--calculate of the matrix elements
29541 CALL HWETWO(.TRUE.,.TRUE.)
29542 IF(IERROR.NE.0) RETURN
29544 C--first stage of the colour connection corrections
29547 JMOHEP(2,THEP+NHEP-5)=NHEP-5+THEP
29548 & +CONECT(HWRINT(1,2),THEP,CON)
29549 JDAHEP(2,THEP+NHEP-5) = JMOHEP(2,THEP+NHEP-5)
29552 IF(IDHEP(NHEP-4).LT.0) THEN
29553 JDAHEP(2,NHEP-4)=NHEP-1
29554 JDAHEP(2,NHEP-3)=NHEP-3
29555 JDAHEP(2,NHEP-1)=NHEP-4
29556 IF(CON.EQ.5) JDAHEP(2,NHEP-4)=NHEP
29557 JDAHEP(2,NHEP)=CONECT(1,6,CON)+NHEP
29559 JMOHEP(2,NHEP-4)=NHEP-1
29560 JMOHEP(2,NHEP-3)=NHEP-3
29561 JMOHEP(2,NHEP-1)=NHEP-4
29562 IF(CON.EQ.5) JMOHEP(2,NHEP-4)=NHEP
29563 JMOHEP(2,NHEP)=CONECT(1,6,CON)+NHEP
29567 JDAHEP(2,NHEP) = JDAHEP(2,NHEP-1)
29568 JDAHEP(2,NHEP-1) = SP
29570 JMOHEP(2,NHEP) = JMOHEP(2,NHEP-1)
29571 JMOHEP(2,NHEP-1) = SP
29574 HRDCOL(1,2) = NHEP-2
29580 *CMZ :- -05/04/02 15:40:41 by Peter Richardson
29581 *-- Author : Peter Richardson
29582 C-----------------------------------------------------------------------
29584 C-----------------------------------------------------------------------
29585 C SUSY E+E- --> SM PARTICLES VIA RPV
29586 C MODIFIED TO INCLUDE BEAM POLARIZATION EFFECTS BY PETER RICHARDSON
29587 C-----------------------------------------------------------------------
29588 INCLUDE 'HERWIG65.INC'
29589 DOUBLE PRECISION HWRGEN,HWRUNI,HWUPCM,HWUMBW,HWUAEM,HCS,RCS,FACA,
29590 & S,T,PCM,MQ1,MQ2,SP,TP,TPZ,TPN,TPN2,MSL2(3),MZ,
29591 & MZ2,MSU2(3,2),MWD(3),GL,GR,GLP,GRP,EC,EE,THTMIN,
29592 & MIX(3,2),CFAC,LAM(4,3,3,3,3,3),MET,ME(2,3,3)
29593 DOUBLE COMPLEX FSLL,FSLR,FSRL,FSRR,FTLL,FTLR,FTRL,FTRR,Z,Z0,GZ,
29595 INTEGER I,IHEP,RSID(2),IL,GN,J,K,L,GNMN,GNMX,K1,L1,NTRY,GNR,FID(2)
29596 SAVE HCS,MSL2,MWD,LAM,ME,GL,GR,MZ,MZ2,MSU2,MIX,GNMN,GNMX,IL,RSID,
29598 EXTERNAL HWRGEN,HWRUNI,HWUPCM,HWUMBW,HWUAEM
29599 PARAMETER(Z=(0.D0,1.D0),Z0=(0.D0,0.D0))
29600 C--Start of the code
29602 RCS = HCS*HWRGEN(0)
29605 C--identify the beam particles
29606 IF(ABS(IDHEP(1)).EQ.11) THEN
29610 ELSEIF(ABS(IDHEP(1)).EQ.13) THEN
29614 C--unrecognized beam particles issue warning
29616 CALL HWWARN('HWHREE',500,*999)
29619 C--masses of the sleptons
29621 MSL2(I) = RMASS(424+2*I)
29622 MWD(I) = MSL2(I)*HBAR/RLTIM(424+2*I)
29623 MSL2(I) = MSL2(I)**2
29625 C--masses and mixings of the t channel squarks
29627 MSU2(I,1) = RMASS(400+2*I)
29628 MSU2(I,2) = RMASS(412+2*I)
29630 MIX(I,J) = QMIXSS(2*I,1,J)**2
29631 MSU2(I,J) = MSU2(I,J)**2
29637 C--find the couplings
29643 LAM(1,GN,I,J,K,L) = LAMDA1(GN,I,J)*LAMDA1(GN,K,L)
29644 LAM(2,GN,I,J,K,L) = LAMDA1(GN,I,J)*LAMDA2(GN,K,L)
29645 LAM(3,GN,I,J,K,L) = LAM(1,GN,I,J,K,L)
29646 LAM(4,GN,I,J,K,L) = LAMDA2(I,GN,J)*LAMDA2(K,GN,L)
29655 C--select the process from the IPROC code
29656 IF(IPROC.EQ.860) THEN
29661 ELSEIF(IPROC.GE.870.AND.IPROC.LT.890) THEN
29663 IF(MOD(IPROC,10).EQ.0) THEN
29667 FID(1) = MOD(J-1,3)+1
29668 FID(2) = INT((J-1)/3)+1
29670 IF(IPROC.LT.880) THEN
29677 CALL HWWARN('HWHREE',501,*999)
29680 C--calculate the kinematic varibles
29683 THTMIN = ONE-FOUR*PTMIN**2/S
29684 IF(THTMIN.LT.ZERO) CALL HWWARN('HWHREE',502,*999)
29685 THTMIN = SQRT(THTMIN)
29686 COSTH = HWRUNI(0,-THTMIN,THTMIN)
29688 GZ = ONE/(S-MZ**2+Z*MZ*GAMZ)
29690 FACA = GEV2NB*EE**2*PIFAC*S/FOUR
29691 EE = 0.25D0/EE/PIFAC
29693 T = -HALF*S*(ONE-COSTH)
29696 C--Calculate the prefactor due multichannel approach
29698 IF(GN.EQ.RSID(1).OR.GN.EQ.RSID(2)) THEN
29699 SCF(GN)= ONE/(S-MSL2(GN)+Z*MWD(GN))
29705 C--Now the loop to actually calculate the cross sections
29711 IF(FID(1).NE.0.AND.(FID(1).NE.K1.OR.FID(2).NE.L1).AND.
29712 & (FID(1).NE.L1.OR.FID(2).NE.K1)) GOTO 80
29720 ELSEIF(GN.EQ.2) THEN
29730 IF(EMSCA.LT.(MQ1+MQ2)) GOTO 80
29733 C--calculate the matrix element
29734 C--set all coefficents to zero
29743 C--Standard Model terms
29745 C--first if same flavour pair production
29746 FSLL = EC*SP+GL*GRP*GZ
29747 FSLR = EC*SP+GL*GLP*GZ
29748 FSRL = EC*SP+GR*GRP*GZ
29749 FSRR = EC*SP+GR*GLP*GZ
29750 C--t channel terms if e+e- --> e+e-
29751 IF(K1.EQ.IL.AND.GN.EQ.1) THEN
29752 FTLL = TP+GL*GR*TPZ
29753 FTLR = TP+GL**2*TPZ
29754 FTRL = TP+GR**2*TPZ
29755 FTRR = TP+GL*GR*TPZ
29758 C--Now add the RPV terms
29761 TPN = ONE/(T-MSL2(I))
29764 TPN = MIX(I,1)/(T-MSU2(I,1))+ MIX(I,2)/(T-MSU2(I,2))
29767 FSLL = FSLL+HALF*LAM(GNR,I,IL,K1,IL,L1)*EE*TPN
29768 FSRR = FSRR+HALF*LAM(GNR,I,K1,IL,L1,IL)*EE*TPN2
29769 FTLL = FTLL+HALF*LAM(GN,I,IL,IL,K1,L1)*EE*SCF(I)
29770 FTRR = FTRR+HALF*LAM(GN,I,IL,IL,L1,K1)*EE*SCF(I)
29772 C--now calculate the matrix element (including beam polarization)
29773 MET =(ONE+COSTH)**2*DREAL(
29774 & DCONJG(FSLR)*FSLR*(ONE-EPOLN(3))*(ONE+PPOLN(3))
29775 & +DCONJG(FSRL)*FSRL*(ONE+EPOLN(3))*(ONE-PPOLN(3))
29776 & +DCONJG(FTLR)*FTLR*(ONE-EPOLN(3))*(ONE+PPOLN(3))
29777 & +DCONJG(FTRL)*FTRL*(ONE+EPOLN(3))*(ONE-PPOLN(3))
29778 & +TWO*FTLR*DCONJG(FSLR)*(ONE-EPOLN(3))*(ONE+PPOLN(3))
29779 & +TWO*FTRL*DCONJG(FSRL)*(ONE+EPOLN(3))*(ONE-PPOLN(3)))
29780 & +(ONE-COSTH)**2*DREAL(
29781 & DCONJG(FSLL)*FSLL*(ONE-EPOLN(3))*(ONE+PPOLN(3))
29782 & +DCONJG(FSRR)*FSRR*(ONE+EPOLN(3))*(ONE-PPOLN(3)))
29784 & DCONJG(FTLL)*FTLL*(ONE+EPOLN(3))*(ONE+PPOLN(3))
29785 & +DCONJG(FTRR)*FTRR*(ONE-EPOLN(3))*(ONE-PPOLN(3)))
29786 C--final phase space factors
29787 ME(GN,K1,L1) = MET*CFAC*FACA*THTMIN
29788 60 HCS = HCS+ME(GN,K1,L1)
29789 IF(HCS.GT.RCS.AND.GENEV) GOTO 900
29794 C--change sign of COSTH if antiparticle first
29795 IF(IDHEP(1).LT.IDHEP(2)) COSTH = -COSTH
29796 C-Set up the particle types
29799 ISTHEP(NHEP+1) = 110
29802 IDHEP(NHEP+2) = IDPDG(K)
29803 IDHEP(NHEP+3) = IDPDG(L)
29804 C--Select the masses of the particles and the final-state momenta
29806 PHEP(5,NHEP+2) = HWUMBW(K)
29807 PHEP(5,NHEP+3) = HWUMBW(L)
29808 CALL HWVEQU(5,PHEP(1,3),PHEP(1,NHEP+1))
29809 PCM = HWUPCM(PHEP(5,NHEP+1),PHEP(5,NHEP+2),PHEP(5,NHEP+3))
29810 IF(PCM.LT.ZERO.AND.NTRY.LE.NETRY) THEN
29812 ELSEIF(PCM.LT.ZERO) THEN
29813 CALL HWWARN('HWHREE',100,*999)
29815 C--Set up the colours etc
29816 ISTHEP(NHEP+2) = 113
29817 ISTHEP(NHEP+3) = 114
29818 JMOHEP(1,NHEP+1) = 1
29819 IF (JDAHEP(1,1).NE.0) JMOHEP(1,NHEP+1)=JDAHEP(1,1)
29820 JMOHEP(2,NHEP+1) = 2
29821 IF (JDAHEP(1,2).NE.0) JMOHEP(2,NHEP+1)=JDAHEP(1,2)
29822 JMOHEP(1,NHEP+2) = NHEP+1
29823 JMOHEP(2,NHEP+2) = NHEP+3
29824 JMOHEP(1,NHEP+3) = NHEP+1
29825 JMOHEP(2,NHEP+3) = NHEP+2
29826 JDAHEP(1,NHEP+1) = NHEP+2
29827 JDAHEP(2,NHEP+1) = NHEP+3
29828 JDAHEP(1,NHEP+2) = 0
29829 JDAHEP(2,NHEP+2) = NHEP+3
29830 JDAHEP(1,NHEP+3) = 0
29831 JDAHEP(2,NHEP+3) = NHEP+2
29832 C--Set up the momenta
29834 PHEP(4,IHEP) = SQRT(PCM**2+PHEP(5,IHEP)**2)
29835 PHEP(3,IHEP) = PCM*COSTH
29836 PHEP(1,IHEP) = SQRT((PCM+PHEP(3,IHEP))*(PCM-PHEP(3,IHEP)))
29837 PHEP(2,IHEP) = ZERO
29838 CALL HWRAZM(PHEP(1,IHEP),PHEP(1,IHEP),PHEP(2,IHEP))
29839 CALL HWULOB(PHEP(1,NHEP+1),PHEP(1,IHEP),PHEP(1,IHEP))
29840 CALL HWVDIF(4,PHEP(1,NHEP+1),PHEP(1,IHEP),PHEP(1,IHEP+1))
29847 *CMZ :- -01/06/94 17.03.31 by Mike Seymour
29848 *-- Author : Mike Seymour
29849 C-----------------------------------------------------------------------
29850 SUBROUTINE HWHREM(IBEAM,ITARG)
29851 C-----------------------------------------------------------------------
29852 C IDENTIFY THE REMNANTS OF THE HARD SCATTERING
29853 C AND BREAK THEIR COLOUR CONNECTION IF NECESSARY
29854 C-----------------------------------------------------------------------
29855 INCLUDE 'HERWIG65.INC'
29856 DOUBLE PRECISION PCL(5),
29857 $ P1P2,P1SQ,P2SQ,S,M1SQ,M2SQ,TMP1,TMP2,A,B,C,D,PTOT(4),HWULDO
29858 INTEGER IBEAM,ITARG,IHEP,NTEMP,I,ICOL,IANT
29859 LOGICAL LTEMP,T,COL,ANT
29860 PARAMETER (T=.TRUE.)
29861 COL(I)=I.EQ.13 .OR. I.GE.1.AND.I.LE.6 .OR. I.GE.115.AND.I.LE.120
29862 ANT(I)=I.EQ.13 .OR. I.GE.7.AND.I.LE.12.OR. I.GE.109.AND.I.LE.114
29863 C---LOOK FOR UNTREATED BEAM AND TARGET REMNANTS
29867 IF (ISTHEP(IHEP).EQ.148) THEN
29868 IF (ITARG.NE.0) CALL HWWARN('HWHREM',100,*999)
29870 ELSEIF (ISTHEP(IHEP).EQ.147) THEN
29871 IF (IBEAM.NE.0) CALL HWWARN('HWHREM',101,*999)
29875 IF (ITARG.EQ.0) CALL HWWARN('HWHREM',102,*999)
29876 IF (IBEAM.EQ.0) CALL HWWARN('HWHREM',103,*999)
29877 C---MHS FIX TO PREVENT MOMENTUM VIOLATION DUE TO OFF-SHELL BEAM REMNANTS
29878 C---FIND REMNANT MOMENTA AND MASSES
29879 P1P2=HWULDO(PHEP(1,IBEAM),PHEP(1,ITARG))
29880 P1SQ=HWULDO(PHEP(1,IBEAM),PHEP(1,IBEAM))
29881 P2SQ=HWULDO(PHEP(1,ITARG),PHEP(1,ITARG))
29883 TMP1=P1P2**2-P1SQ*P2SQ
29884 IF (TMP1.LE.0) CALL HWWARN('HWHREM',104,*999)
29886 M1SQ=RMASS(IDHW(IBEAM))**2
29887 M2SQ=RMASS(IDHW(ITARG))**2
29888 TMP2=(S-M1SQ-M2SQ)**2-4*M1SQ*M2SQ
29889 IF (TMP2.LE.0) CALL HWWARN('HWHREM',105,*999)
29891 C---EXCHANGE A LITTLE MOMENTUM TO PUT THEM BOTH ON MASS-SHELL
29892 A=(1-(P1P2+P2SQ)/TMP1)/2
29893 B=(1-(P1P2+P1SQ)/TMP1)/2
29894 C=(S-M1SQ+M2SQ-TMP2)/(2*S)
29895 D=(S+M1SQ-M2SQ-TMP2)/(2*S)
29896 CALL HWVSUM(4,PHEP(1,IBEAM),PHEP(1,ITARG),PTOT)
29897 CALL HWVSCA(4,(1-A)*(1-C)+A*D,PHEP(1,IBEAM),PHEP(1,IBEAM))
29898 CALL HWVSCA(4,B*(1-C)+(1-B)*D,PHEP(1,ITARG),PHEP(1,ITARG))
29899 CALL HWVSUM(4,PHEP(1,IBEAM),PHEP(1,ITARG),PHEP(1,IBEAM))
29900 CALL HWVDIF(4,PTOT,PHEP(1,IBEAM),PHEP(1,ITARG))
29901 CALL HWUMAS(PHEP(1,IBEAM))
29902 CALL HWUMAS(PHEP(1,ITARG))
29904 C---IF THEY ARE COLOUR CONNECTED, DISCONNECT THEM BY EMITTING A SOFT
29905 C GLUON AND SPLITTING THAT GLUON TO LIGHT QUARKS
29906 C (WHICH NORMALLY GETS DONE AS THE FIRST STAGE OF CLUSTER FORMATION)
29907 C---LOOP OVER COLOUR/ANTICOLOUR LINE
29916 IF (COL(IDHW(ICOL)).AND.ANT(IDHW(IANT)).AND.
29917 $ JMOHEP(2,ICOL).EQ.IANT.AND.JDAHEP(2,IANT).EQ.ICOL) THEN
29918 CALL HWVSUM(4,PHEP(1,ICOL),PHEP(1,IANT),PCL)
29921 CALL HWCCUT(ICOL,IANT,PCL,T,LTEMP)
29922 IF (IERROR.NE.0) RETURN
29923 C---IF NOTHING WAS CREATED THEY MUST BE BELOW THRESHOLD, SO GIVE UP
29924 IF (NHEP.NE.NTEMP+2) RETURN
29925 C---RELABEL THEM AS PERTUBATIVE JUST TO NEATEN UP THE EVENT RECORD
29932 *CMZ :- -18/10/00 13:46:47 by Peter Richardson
29933 *-- Author : Peter Richardson
29934 C-----------------------------------------------------------------------
29936 C-----------------------------------------------------------------------
29937 C SUSY E+E- RPV PRODUCTION
29938 C-----------------------------------------------------------------------
29939 INCLUDE 'HERWIG65.INC'
29940 IF(IPROC.GE.800.AND.IPROC.LE.850) THEN
29942 ELSEIF(IPROC.GE.860.AND.IPROC.LT.890) THEN
29944 C---UNRECOGNIZED PROCESS
29946 CALL HWWARN('HWHREP',500,*999)
29950 *CMZ :- -07/04/02 10:38:51 by Peter Richardson
29951 *-- Author : Peter Richardson
29952 C-----------------------------------------------------------------------
29954 C-----------------------------------------------------------------------
29955 C SUSY E+E- --> RPV SINGLE SPARTICLE PRODUCTION
29956 C POLARZATION EFFECTS ADDED 5/4/02 BY PETER RICHARDSON
29957 C-----------------------------------------------------------------------
29958 INCLUDE 'HERWIG65.INC'
29959 DOUBLE PRECISION HWRGEN,HWUAEM,HWRUNI,HWUPCM,HWUMBW,HCS,RCS,FACA,
29960 & FACB,FACC,FACD,FACE,M1(4,4),M2(2,4),M3(8,2),
29961 & MW,MZ,MSCL(2,2),MSCL2(2,2),MZ2,MSL2,MSR2,MSNU2,
29962 & MW2,MCH(2),MCH2(2),MNU(4),MNU2(4),MLT(3),MLT2(3),
29963 & MNUT(2),MNUT2(2),RMNUT(2),S,U,T,QPE,SQPE,SM,DM,
29964 & PF,PCM,SCF(2),UP,TP,MH(4),MH2(4),THCOS(2),THTMIN,
29965 & A(6,4),B(6,4),SW,CW,MC,SIN2B,ZNU,RHO,HSL(2,2),
29966 & HL(4),M4(10,2),HNU(3)
29967 INTEGER I,SSNU,NTID(2),CHID(2),IG1,IG2,IHEP,SSCH,ISL,ISR,NTRY,
29968 & ISN,IDL,J,L,RSID(2),K,L2,IL,IDZ,RADID(2,8),GMIN,GMAX
29969 LOGICAL NEUT,CHAR,RAD,HIGGS,THSGN
29970 SAVE HCS,M1,M2,M3,M4,SW,CW,MW,MZ,MW2,MZ2,MLT,MLT2,MNUT,MNUT2,
29971 & RMNUT,MNU,MNU2,MCH,MCH2,MSNU2,A,B,MSL2,MSR2,MSCL,
29972 & MSCL2,ZNU,THCOS,HSL,HL,HNU,MH,MH2,GMIN,GMAX,
29973 & RADID,NTID,ISL,ISR,ISN,IDL,CHID,RSID,IL,NEUT,CHAR,RAD,HIGGS
29974 EXTERNAL HWRGEN,HWUAEM,HWRUNI,HWUPCM,HWUMBW
29975 PARAMETER (SSNU=449,SSCH = 455)
29976 C--Start of the code
29978 RCS = HCS*HWRGEN(0)
29980 C--Initialise the hard processes
29982 C--Decide which processes to generate
29987 C--all single sparticle production
29988 IF(IPROC.EQ.800) THEN
29999 C--single neutralino production
30000 ELSEIF(IPROC.GE.810.AND.IPROC.LE.814) THEN
30002 IF(IPROC.EQ.810) THEN
30006 NTID(1) = IPROC-810
30009 C--single chargino production
30010 ELSEIF(IPROC.GE.820.AND.IPROC.LE.822) THEN
30012 IF(IPROC.EQ.820) THEN
30016 CHID(1) = IPROC-820
30019 C--single slepton production with gauge boson
30020 ELSEIF(IPROC.EQ.830) THEN
30024 C--single slepton production with Higgs boson
30025 ELSEIF(IPROC.EQ.840) THEN
30027 C--photon radiation processes
30028 ELSEIF(IPROC.EQ.850) THEN
30032 C--unrecognized process issue warning
30034 CALL HWWARN('HWHRES',500,*999)
30036 C--check the particles in the beam
30038 IF(ABS(IDHEP(1)).EQ.11) THEN
30045 ELSEIF(ABS(IDHEP(1)).EQ.13) THEN
30052 C--unrecognised beam particles issue warning
30054 CALL HWWARN('HWHRES',501,*999)
30057 C--masses and electroweak parameters
30064 SIN2B = TWO*SINB*COSB
30065 C--neutralino and chargino masses
30067 MNU(I) = RMASS(SSNU+I)
30068 MNU2(I) = MNU(I)**2
30071 MCH(I) = RMASS(I+SSCH)
30072 MCH2(I) = MCH(I)**2
30074 C--incoming lepton mass
30075 MLT(1) = RMASS(IDL+110)
30076 C--lepton masses in chargino production
30078 MLT(I+1) = RMASS(119+2*RSID(I))
30081 MLT2(I) = MLT(I)**2
30083 C--t-channel slepton masses
30084 MSL2 = RMASS(ISL)**2
30085 MSR2 = RMASS(ISR)**2
30086 MSNU2 = RMASS(ISN)**2
30087 C--resonant sneutrino masses and widths
30089 MNUT(I) = RMASS(424+2*RSID(I))
30090 MNUT2(I) = MNUT(I)**2
30091 RMNUT(I) = MNUT2(I)*HBAR**2/RLTIM(424+2*RSID(I))**2
30093 C--now calculate the coefficients for the processes
30094 C--first neutralino production
30096 MC = MLT(1)*ZMIXSS(L,3)/(TWO*MW*COSB*SW)
30097 C--first for the left slepton
30098 A(L,1) = SLFCH(IDL,L)
30099 B(L,1) = ZSGNSS(L)*MC
30100 C--then the right slepton
30101 A(L,2) = ZSGNSS(L)*SRFCH(IDL,L)
30103 C--the resonant sneutrino
30105 A(L,2+I) = SLFCH(10+2*RSID(I),L)
30109 C--now chargino production
30112 MC = WMXUSS(L,2)/(SQRT(TWO)*MW*COSB*SW)
30113 C--first for the t channel sneutrino
30114 A(J,1) = WSGNSS(L)*WMXVSS(L,1)/SW
30115 B(J,1) = -MLT(1)*MC
30116 C--now for the resonant sneutrinos
30118 A(J,I+1) = WSGNSS(L)*WMXVSS(L,1)/SW
30119 B(J,I+1) = -MLT(I+1)*MC
30122 C--coupling of the Z to the sneutrino
30124 C--now the masses and IDs of the slepton in the radiative processes
30125 C--IDs and masses of the charged sleptons
30127 RADID(2,2*I-1) = 423+RSID(I)*2
30128 RADID(2,2*I ) = 435+RSID(I)*2
30129 MSCL(I,1) = RMASS(RADID(2,2*I-1))
30130 MSCL(I,2) = RMASS(RADID(2,2*I))
30132 MSCL2(I,J) = MSCL(I,J)**2
30135 C--ID of the W for charged slepton processes
30139 C--ID's for the Z and gamma processes
30143 RADID(2,I+4) = 424+RSID(I)*2
30144 RADID(2,I+6) = RADID(2,I+4)
30146 C--couplings of the sleptons to the Higgs
30151 HSL(I,J) = LMIXSS(K,1,J)*(RMASS(L)**2*TANB-MW2*SIN2B)
30152 & +LMIXSS(K,2,J)*RMASS(L)*MUSS
30153 IF(RSID(I).EQ.3) HSL(I,J) = HSL(I,J)
30154 & +LMIXSS(K,2,J)*RMASS(L)*ALSS*TANB
30155 HSL(I,J) = HSL(I,J)/SQRT(HALF)/MW
30158 C--coupling of the sneutrino to the Higgs
30159 HNU(1) = HALF*MZ*SINBPA/CW
30160 HNU(2) = -HALF*MZ*COSBPA/CW
30162 C--couplings of the leptons to the Higgs
30163 RHO = HALF*MLT(1)/MW
30164 HL(1) = -RHO*SINA/COSB
30165 HL(2) = RHO*COSA/COSB
30167 HL(4) = RHO*TANB/SQRT(HALF)
30170 MH(I) = RMASS(202+I)
30174 C--Now calculate the weights
30175 COSTH = HWRUNI(1,-ONE,ONE)
30178 FACA = HWUAEM(S)*GEV2NB/S/8.0D0
30179 FACD = HALF*FACA/SWEIN
30180 FACB = HALF*FACD/MW2
30181 FACC = HALF*FACA/MZ2
30182 FACE = ALPHEM*GEV2NB/S/8.0D0
30184 SCF(I) = ONE/((S-MNUT2(I))**2+RMNUT(I))
30186 C--single neutralino production
30195 DO L=NTID(1),NTID(2)
30199 IF(SQPE.GE.ZERO) THEN
30201 T = HALF*(SQPE*COSTH-S+MNU2(L))
30205 C--neutralino antineutrino production (including beam polarization)
30206 M1(L,J) = (ONE-EPOLN(3))*(ONE-PPOLN(3))*(
30207 & A(L,K)**2*S*(S-MNU2(L))*SCF(J)
30208 & +TWO*S*U*(S-MNUT2(J))*UP*SCF(J)*A(L,K)*A(L,1)
30209 & +TWO*S*T*(S-MNUT2(J))*TP*SCF(J)*A(L,K)*A(L,2)
30210 & +TWO*U*T*UP*TP*A(L,1)*A(L,2))
30211 & +U*(U-MNU2(L))*UP**2*(ONE-PPOLN(3))*
30212 & (A(L,1)**2*(ONE-EPOLN(3))+B(L,1)**2*(ONE+EPOLN(3)))
30213 & +T*(T-MNU2(L))*TP**2*(ONE-EPOLN(3))*
30214 & (A(L,2)**2*(ONE-PPOLN(3))+B(L,2)**2*(ONE+PPOLN(3)))
30215 C--neutralino neutrino production (including beam polarization)
30216 M1(L,K) = (ONE+EPOLN(3))*(ONE+PPOLN(3))*(
30217 & A(L,K)**2*S*(S-MNU2(L))*SCF(J)
30218 & +TWO*S*U*(S-MNUT2(J))*UP*SCF(J)*A(L,K)*A(L,1)
30219 & +TWO*S*T*(S-MNUT2(J))*TP*SCF(J)*A(L,K)*A(L,2)
30220 & +TWO*U*T*UP*TP*A(L,1)*A(L,2))
30221 & +U*(U-MNU2(L))*UP**2*(ONE+PPOLN(3))*
30222 & (A(L,1)**2*(ONE+EPOLN(3))+B(L,1)**2*(ONE-EPOLN(3)))
30223 & +T*(T-MNU2(L))*TP**2*(ONE+EPOLN(3))*
30224 & (A(L,2)**2*(ONE+PPOLN(3))+B(L,2)**2*(ONE-PPOLN(3)))
30225 C--final coefficients
30226 M1(L,J) = LAMDA1(RSID(J),IL,IL)**2*FACA*PF*M1(L,J)
30227 M1(L,K) = LAMDA1(RSID(J),IL,IL)**2*FACA*PF*M1(L,K)
30234 C--single chargino production
30235 100 IF(.NOT.CHAR) THEN
30243 DO L = CHID(1),CHID(2)
30247 SM = MCH(L) + MLT(K)
30249 IF (QPE.GE.ZERO) THEN
30250 DM = MCH(L) - MLT(K)
30251 SQPE = SQRT(QPE*(S-DM**2))
30253 T = HALF*(SQPE*COSTH-S+MCH2(L)+MLT2(K))
30254 U = -T-S+MCH2(L)+MLT2(K)
30256 C--chargino antilepton (including beam polarization)
30257 M2(L,J) = S*SCF(J)*(-FOUR*MLT(K)*MCH(L)*A(L2,K)*B(L2,K)
30258 & +(S-MLT2(K)-MCH2(L))*(A(L2,K)**2+B(L2,K)**2))*
30259 & (ONE-EPOLN(3))*(ONE-PPOLN(3))
30260 & +(MLT2(K)-U)*(MCH2(L)-U)*UP**2*(ONE-PPOLN(3))*
30261 & (A(L2,1)**2*(ONE-EPOLN(3))+B(L2,1)**2*(ONE+EPOLN(3)))
30262 & -TWO*S*(S-MNUT2(J))*UP*SCF(J)*A(L2,1)*(ONE-EPOLN(3))*
30263 & (ONE-PPOLN(3))*(U*A(L2,K)+MLT(K)*MCH(L)*B(L2,K))
30264 C--chargino lepton (including beam polarization)
30265 M2(L,J+2) = S*SCF(J)*(-FOUR*MLT(K)*MCH(L)*A(L2,K)*B(L2,K)
30266 & +(S-MLT2(K)-MCH2(L))*(A(L2,K)**2+B(L2,K)**2))*
30267 & (ONE+EPOLN(3))*(ONE+PPOLN(3))
30268 & +(MLT2(K)-U)*(MCH2(L)-U)*UP**2*(ONE+PPOLN(3))*
30269 & (A(L2,1)**2*(ONE+EPOLN(3))+B(L2,1)**2*(ONE-EPOLN(3)))
30270 & -TWO*S*(S-MNUT2(J))*UP*SCF(J)*A(L2,1)*(ONE+EPOLN(3))*
30271 & (ONE+PPOLN(3))*(U*A(L2,K)+MLT(K)*MCH(L)*B(L2,K))
30272 C--final coefficients
30273 M2(L,J) =HALF*LAMDA1(RSID(J),IL,IL)**2*FACA*PF*M2(L,J)
30274 M2(L,J+2)=HALF*LAMDA1(RSID(J),IL,IL)**2*FACA*PF*M2(L,J+2)
30281 C--Radiative processes
30282 200 IF(.NOT.RAD) THEN
30291 C--W charged slepton production
30294 QPE = S-(MW+MSCL(I,J))**2
30295 IF(QPE.GE.ZERO) THEN
30297 SQPE = SQRT(QPE*(S-DM**2))
30299 T = HALF*(SQPE*COSTH-S+MW2+MSCL2(I,J))
30300 U = -T-S+MW2+MSCL2(I,J)
30303 M3(2*I+J-2,1) = SCF(I)*S*SQPE**2
30304 & +UP**2*(TWO*MW2*(U*T-MW2*MSCL2(I,J))+U**2*S)
30305 & -TWO*UP*SCF(I)*(S-MNUT2(I))*S*(MW2*(TWO*MSCL2(I,J)-U)+
30306 & U*(S-MSCL2(I,J)))
30307 M3(2*I+J-2,1) = LAMDA1(RSID(I),IL,IL)**2*FACB*PF
30308 & *LMIXSS(2*RSID(I)-1,1,J)**2*M3(2*I+J-2,1)
30309 C--W- antislepton (including beam polarization)
30310 M3(2*I+J-2,2) = (ONE-EPOLN(3))*(ONE-PPOLN(3))*
30312 C--W+ antislepton (including beam polarization)
30313 M3(2*I+J-2,1) = (ONE+EPOLN(3))*(ONE+PPOLN(3))*
30316 M3(2*I+J-2,1) = ZERO
30317 M3(2*I+J-2,2) = ZERO
30321 C--Z sneutrino production
30323 QPE = S-(MZ+MNUT(I))**2
30324 IF(QPE.GE.ZERO) THEN
30326 SQPE = SQRT(QPE*(S-DM**2))
30328 T = HALF*(SQPE*COSTH-S+MZ2+MNUT2(I))
30329 U = -T-S+MZ2+MNUT2(I)
30333 C--Z sneutrino production
30334 M3(I+4,1) = SCF(I)*S*SQPE**2*ZNU**2
30335 & +TP**2*RFCH(IDZ)**2*(TWO*MZ2*(U*T-MNUT2(I)*MZ2)+S*T**2)
30336 & +UP**2*LFCH(IDZ)**2*(TWO*MZ2*(U*T-MNUT2(I)*MZ2)+S*U**2)
30337 & -TWO*ZNU*RFCH(IDZ)*TP*S*SCF(I)*(S-MNUT2(I))*
30338 & (MZ2*(TWO*MNUT2(I)-T)+T*(S-MNUT2(I)))
30339 & +TWO*ZNU*LFCH(IDZ)*UP*S*SCF(I)*(S-MNUT2(I))*
30340 & (MZ2*(TWO*MNUT2(I)-U)+U*(S-MNUT2(I)))
30341 & +TWO*LFCH(IDZ)*RFCH(IDZ)*UP*TP*
30342 & (TWO*MZ2*(MNUT2(I)-T)*(MNUT2(I)-U)-S*U*T)
30343 M3(I+4,1) = LAMDA1(RSID(I),IL,IL)**2*FACC*PF*M3(I+4,1)
30344 C--Z antisneutrino (including beam polarization)
30345 M3(I+4,2) = (ONE-EPOLN(3))*(ONE-PPOLN(3))*M3(I+4,1)
30346 C--Z sneutrino (including beam polarization)
30347 M3(I+4,1) = (ONE+EPOLN(3))*(ONE+PPOLN(3))*M3(I+4,1)
30354 C--gamma sneutrino production (includes Jacobian 1-costh**2)
30355 C--now includes polarization effects
30358 IF(SQPE.GE.ZERO) THEN
30360 PCM = HALF*EMSCA*PF
30362 IF(THTMIN.GT.ONE) CALL HWWARN('HWHRES',502,*999)
30363 THTMIN = ONE-THTMIN**2
30364 THTMIN = HALF*LOG((1+THTMIN)/(1-THTMIN))
30365 RHO = HWRUNI(2,-THTMIN,THTMIN)
30366 THCOS(I) = -TANH(RHO)
30367 T = HALF*(SQPE*THCOS(I)-S+MNUT2(I))
30371 M3(I+6,1) = U*TP+T*UP+TWO*UP*TP*(MNUT2(I)-U)*(MNUT2(I)-T)
30372 M3(I+6,1) = LAMDA1(RSID(I),IL,IL)**2*FACE*PF*M3(I+6,1)*
30373 & (ONE-THCOS(I)**2)*THTMIN
30374 M3(I+6,2) = M3(I+6,1)*(ONE-EPOLN(3))*(ONE-PPOLN(3))
30375 M3(I+6,1) = M3(I+6,1)*(ONE+EPOLN(3))*(ONE+PPOLN(3))
30383 300 IF(.NOT.HIGGS) THEN
30391 C--Charged Higgs charged slepton production
30394 QPE = S-(MH(4)+MSCL(I,J))**2
30395 IF(QPE.GE.ZERO) THEN
30396 DM = MH(4)-MSCL(I,J)
30397 SQPE = SQRT(QPE*(S-DM**2))
30399 T = HALF*(SQPE*COSTH-S+MH2(4)+MSCL2(I,J))
30400 U = -T-S+MH2(4)+MSCL2(I,J)
30401 C--charged Higgs antislepton
30402 M4(2*I+J-2,1) = HSL(I,J)**2*S*SCF(I)*
30403 & (ONE-EPOLN(3))*(ONE-PPOLN(3))
30404 & +FOUR*LMIXSS(2*RSID(I)-1,1,J)**2*HL(4)**2
30405 & *(U*T-MSCL2(I,J)*MH2(4))/U**2*
30406 & (ONE+EPOLN(3))*(ONE-PPOLN(3))
30407 C--charged Higgs slepton
30408 M4(2*I+J-2,2) = HSL(I,J)**2*S*SCF(I)*
30409 & (ONE+EPOLN(3))*(ONE+PPOLN(3))
30410 & +FOUR*LMIXSS(2*RSID(I)-1,1,J)**2*HL(4)**2
30411 & *(U*T-MSCL2(I,J)*MH2(4))/U**2*
30412 & (ONE-EPOLN(3))*(ONE+PPOLN(3))
30413 C--final coefficients
30414 M4(2*I+J-2,1) = FACD*LAMDA1(RSID(I),IL,IL)**2*
30416 M4(2*I+J-2,2) = FACD*LAMDA1(RSID(I),IL,IL)**2*
30419 M4(2*I+J-2,1) = ZERO
30420 M4(2*I+J-2,2) = ZERO
30424 C--neutral higgs sneutrino production
30427 QPE = S-(MH(L)+MNUT(I))**2
30428 IF(QPE.GE.ZERO) THEN
30430 SQPE = SQRT(QPE*(S-DM**2))
30432 T = HALF*(SQPE*COSTH-S+MH2(L)+MNUT2(I))
30433 U = -T-S+MH2(L)+MNUT2(I)
30435 C--h0, H0 antisneutrino (including beam polarization)
30436 M4(2*L+I+2,1) = HNU(L)**2*S*SCF(I)*
30437 & (ONE-EPOLN(3))*(ONE-PPOLN(3))
30438 & +HL(L)**2*( ONE/T**2*(ONE+EPOLN(3))*(ONE-PPOLN(3))
30439 & +ONE/U**2*(ONE-EPOLN(3))*(ONE+PPOLN(3)))
30440 & *(U*T-MH2(L)*MNUT2(I))
30441 C--h0, H0 sneutrino (including beam polarization)
30442 M4(2*L+I+2,2) = HNU(L)**2*S*SCF(I)*
30443 & (ONE+EPOLN(3))*(ONE+PPOLN(3))
30444 & +HL(L)**2*( ONE/T**2*(ONE-EPOLN(3))*(ONE+PPOLN(3))
30445 & +ONE/U**2*(ONE+EPOLN(3))*(ONE-PPOLN(3)))
30446 & *(U*T-MH2(L)*MNUT2(I))
30448 C--A0 antisneutrino (including beam polarization)
30449 M4(2*L+I+2,1) = (ONE-EPOLN(3))*(ONE-PPOLN(3))*(
30450 & HNU(L)**2*S*SCF(I)
30451 & +HL(L)**2*(ONE/T**2+ONE/U**2)*(U*T-MH2(L)*MNUT2(I)))
30452 C--A0 sneutrino (including beam polarization)
30453 M4(2*L+I+2,2) = (ONE+EPOLN(3))*(ONE+PPOLN(3))*(
30454 & HNU(L)**2*S*SCF(I)
30455 & +HL(L)**2*(ONE/T**2+ONE/U**2)*(U*T-MH2(L)*MNUT2(I)))
30457 C--final coefficients
30458 M4(2*L+I+2,1) = FACD*LAMDA1(RSID(I),IL,IL)**2*
30460 M4(2*L+I+2,2) = FACD*LAMDA1(RSID(I),IL,IL)**2*
30463 M4(2*L+I+2,1) = ZERO
30464 M4(2*L+I+2,2) = ZERO
30469 C--Add up the weights now
30471 C--single neutralino production
30472 IF(.NOT.NEUT) GOTO 550
30473 DO L=NTID(1),NTID(2)
30476 IG2 = 126+2*RSID(MOD(J-1,2)+1)-6*INT((J-1)/2)
30478 THSGN = (IDHEP(1).LT.IDHEP(2).AND.J.GT.2).OR.
30479 & (IDHEP(1).GT.IDHEP(2).AND.J.LE.2)
30480 IF(GENEV.AND.HCS.GT.RCS) GOTO 900
30483 C--single chargino production
30484 550 IF(.NOT.CHAR) GOTO 600
30485 DO L=CHID(1),CHID(2)
30487 IG1 = SSCH+L-2*INT((J-1)/2)
30488 IG2 = 125+2*RSID(MOD((J-1),2)+1)-6*INT((J-1)/2)
30489 HCS = HCS + M2(L,J)
30490 THSGN = (IDHEP(1).LT.IDHEP(2).AND.J.GT.2).OR.
30491 & (IDHEP(1).GT.IDHEP(2).AND.J.LE.2)
30492 IF (GENEV.AND.HCS.GT.RCS) GOTO 900
30495 C--gauge boson slepton production
30496 600 IF(.NOT.RAD) GOTO 650
30500 IF(I.GE.7) COSTH = THCOS(I-6)
30503 THSGN = (IDHEP(1).LT.IDHEP(2).AND.J.EQ.1).OR.
30504 & (IDHEP(1).GT.IDHEP(2).AND.J.EQ.2)
30505 IF(GENEV.AND.HCS.GT.RCS) GOTO 900
30506 IF(I.LE.4) IG1 = IG1+1
30510 C--higgs slepton production
30511 650 IF(.NOT.HIGGS) GOTO 900
30512 C--charged Higgs slepton
30518 THSGN = (IDHEP(1).LT.IDHEP(2).AND.J.EQ.1).OR.
30519 & (IDHEP(1).GT.IDHEP(2).AND.J.EQ.2)
30520 IF(GENEV.AND.HCS.GT.RCS) GOTO 900
30525 C--Neutral Higgs sneutrino
30529 IG2 = 430+2*RSID(I)
30531 HCS = HCS+M4(2+2*L+I,J)
30532 THSGN = (IDHEP(1).LT.IDHEP(2).AND.J.EQ.1).OR.
30533 & (IDHEP(1).GT.IDHEP(2).AND.J.EQ.2)
30534 IF(GENEV.AND.HCS.GT.RCS) GOTO 900
30540 C--change sign of COSTH if antiparticle first
30541 IF(THSGN) COSTH = -COSTH
30542 C-Set up the particle types
30545 ISTHEP(NHEP+1) = 110
30548 IDHEP(NHEP+2) = IDPDG(IG1)
30549 IDHEP(NHEP+3) = IDPDG(IG2)
30550 C--generate the particle masses and final-state momenta
30553 PHEP(5,NHEP+2) = HWUMBW(IG1)
30554 PHEP(5,NHEP+3) = HWUMBW(IG2)
30555 C--Set up the Centre-of-mass energy
30556 CALL HWVEQU(5,PHEP(1,3),PHEP(1,NHEP+1))
30557 PCM = HWUPCM(PHEP(5,NHEP+1),PHEP(5,NHEP+2),PHEP(5,NHEP+3))
30558 IF(PCM.LT.ZERO.AND.NTRY.LE.NETRY) THEN
30560 ELSEIF(PCM.LT.ZERO) THEN
30561 CALL HWWARN('HWHRES',100,*999)
30563 C--Set up the colours etc
30564 ISTHEP(NHEP+2) = 113
30565 ISTHEP(NHEP+3) = 114
30566 JMOHEP(1,NHEP+1) = 1
30567 IF (JDAHEP(1,1).NE.0) JMOHEP(1,NHEP+1)=JDAHEP(1,1)
30568 JMOHEP(2,NHEP+1) = 2
30569 IF (JDAHEP(1,2).NE.0) JMOHEP(2,NHEP+1)=JDAHEP(1,2)
30570 JMOHEP(1,NHEP+2) = NHEP+1
30571 JMOHEP(2,NHEP+2) = NHEP+2
30572 JMOHEP(1,NHEP+3) = NHEP+1
30573 JMOHEP(2,NHEP+3) = NHEP+3
30574 JDAHEP(1,NHEP+1) = NHEP+2
30575 JDAHEP(2,NHEP+1) = NHEP+3
30576 JDAHEP(1,NHEP+2) = 0
30577 JDAHEP(2,NHEP+2) = NHEP+2
30578 JDAHEP(1,NHEP+3) = 0
30579 JDAHEP(2,NHEP+3) = NHEP+3
30580 C--set up the rest of the momenta
30582 PHEP(4,IHEP) = SQRT(PCM**2+PHEP(5,IHEP)**2)
30583 PHEP(3,IHEP) = PCM*COSTH
30584 PHEP(1,IHEP) = SQRT((PCM+PHEP(3,IHEP))*(PCM-PHEP(3,IHEP)))
30585 PHEP(2,IHEP) = ZERO
30586 CALL HWRAZM(PHEP(1,IHEP),PHEP(1,IHEP),PHEP(2,IHEP))
30587 CALL HWULOB(PHEP(1,NHEP+1),PHEP(1,IHEP),PHEP(1,IHEP))
30588 CALL HWVDIF(4,PHEP(1,NHEP+1),PHEP(1,IHEP),PHEP(1,IHEP+1))
30595 *CMZ :- -08/04/02 09:00:27 by Peter Richardson
30596 *-- Author : Peter Richardson
30597 C-----------------------------------------------------------------------
30599 C-----------------------------------------------------------------------
30600 C Subroutine for resonant sleptons to standard model particles
30601 C slepton mass and mass*width added to save statement to
30602 C avoid problems with Linux by Peter Richardson
30603 C-----------------------------------------------------------------------
30604 INCLUDE 'HERWIG65.INC'
30605 DOUBLE PRECISION HCS,S,RCS,HWRGEN,FAC,ECM,TH,PCM,CFAC,CHANPB,SH,
30606 & TAU,TAUA,TAUB,LOWTLM,UPPTLM,HWRUNI,MSL(12),
30607 & SQSH,MET(2),SCF(12),MIX(12),ME(4,3,3,3,3,2),
30608 & RAND,CHAN(12),LAM(2,7,3,3,3,3),SLWD(12),RTAB,
30609 & WD,MQ1,MQ2,EPS,XMIN,XMAX,XPOW,XUPP,MSL2(12),
30611 INTEGER I,J,K,L,I1,J1,K1,L1,GEN,GN,GR,GNMX,GNMN,MIG,MXG,CUP,CF
30613 EXTERNAL HWRGEN,HWRUNI
30614 PARAMETER(EPS=1D-20)
30615 COMMON/HWRPIN/XMIN,XMAX,XPOW,FIRST
30616 SAVE HCS,ME,MSL,SLWD,LAM,MIX,CHAN,GNMN,GNMX,SH,SQSH,FAC,SCF,MSL2,
30619 RCS = HCS*HWRGEN(0)
30623 MSL(2*I-1) = RMASS(423+2*I)
30624 MSL(2*I) = RMASS(435+2*I)
30625 MSL(2*I+5) = RMASS(424+2*I)
30626 MSL(2*I+6) = RMASS(436+2*I)
30627 SLWD(2*I-1) = HBAR/RLTIM(423+2*I)
30628 SLWD(2*I) = HBAR/RLTIM(435+2*I)
30629 SLWD(2*I+5) = HBAR/RLTIM(424+2*I)
30630 SLWD(2*I+6) = HBAR/RLTIM(436+2*I)
30633 MSL2(I) = MSL(I)**2
30634 MSWD(I) = MSL(I)*SLWD(I)
30641 CHANPB=CHANPB+LAMDA2(I,J,K)**4
30646 CHAN(2*I-2+J) = LMIXSS(2*I-1,1,J)**2*CHANPB
30647 CHAN(2*I+4+J) = LMIXSS(2*I ,1,J)**2*CHANPB
30648 MIX(2*I-2+J) = LMIXSS(2*I-1,1,J)**2
30649 MIX(2*I+4+J) = LMIXSS(2*I ,1,J)**2
30652 IF(RAND.GT.ZERO) THEN
30654 CHAN(I)=CHAN(I)/RAND
30657 CALL HWWARN('HWHRLL',500,*999)
30659 C--find the couplings
30665 LAM(1,GN,I,J,K,L) =LAMDA2(GN,I,J)*LAMDA1(GN,K,L)
30666 LAM(2,GN,I,J,K,L) =LAMDA2(GN,I,J)*LAMDA2(GN,K,L)
30667 LAM(1,GN+3,I,J,K,L)=LAM(1,GN,I,J,K,L)
30668 LAM(2,GN+3,I,J,K,L)=LAM(2,GN,I,J,K,L)
30674 C--select the process from the IPROC code
30677 IF(MOD(IPROC,10000).EQ.4070) THEN
30679 ELSEIF(MOD(IPROC,10000).EQ.4080) THEN
30685 COSTH = HWRUNI(0,-ONE,ONE)
30686 C--Generate the smoothing
30687 RAND=HWRUNI(0,ZERO,ONE)
30689 IF(CHAN(I).GT.RAND) GOTO 20
30693 C--Calculate hard scale and obtain parton distributions
30695 TAUB = SLWD(GR)**2/S
30696 RTAB = SQRT(TAUA*TAUB)
30698 IF(XMAX**2.GT.S) XUPP = SQRT(S)
30699 LOWTLM = DATAN((XMIN**2/S-TAUA)/RTAB)/RTAB
30700 UPPTLM = DATAN((XUPP**2/S-TAUA)/RTAB)/RTAB
30701 TAU = HWRUNI(0,LOWTLM,UPPTLM)
30702 TAU = RTAB*TAN(RTAB*TAU)+TAUA
30706 XX(1) = EXP(HWRUNI(0,ZERO,LOG(TAU)))
30708 CALL HWSGEN(.FALSE.)
30709 C--Calculate the prefactor due multichannel approach
30712 SCF(GN)=1/((SH-MSL2(GN))**2+MSWD(GN)**2)
30713 FAC=FAC+CHAN(GN)*SCF(GN)
30715 FAC=-(UPPTLM-LOWTLM)*LOG(TAU)*GEV2NB
30716 & /(96*PIFAC*SQSH*SH*TAU*FAC*S**2)
30718 C--Now the loop to actually calculate the cross-sections
30721 IF(MOD(GN,2).EQ.1) THEN
30740 ELSEIF(GN.EQ.2) THEN
30743 ELSEIF(GN.EQ.3) THEN
30746 ELSEIF(GN.EQ.4) THEN
30752 IF(SQSH.GT.(MQ1+MQ2)) THEN
30753 PCM = SQRT((SH-(MQ1+MQ2)**2)*(SH-(MQ1-MQ2)**2))/(2*SQSH)
30754 WD = (SH-MQ1**2-MQ2**2)*SH*PCM
30760 IF(MOD(GN,2).EQ.1) THEN
30772 IF(ABS(LAM(CUP,INT((GEN+1)/2),I1,J1,K1,L1)).LT.EPS.
30773 & OR.ABS(MIX(GEN)).LT.EPS) GOTO 50
30775 IF(ABS(LAM(CUP,INT((GR+1)/2),I1,J1,K1,L1)).GT.EPS.
30776 & AND.ABS(MIX(GR)).GT.EPS) THEN
30777 MET(1) =MET(1)+SCF(GEN)*SCF(GR)*WD*
30778 & ((SH-MSL2(GEN))*(SH-MSL2(GR))+MSWD(GEN)*MSWD(GR))
30779 & *LAM(CUP,INT((GEN+1)/2),I1,J1,K1,L1)*MIX(GEN)
30780 & *LAM(CUP,INT((GR+1)/2),I1,J1,K1,L1)*MIX(GR)
30783 C--Now the t-channel diagrams if the s-channel particles is a sneutrino
30785 ECM=SQRT(PCM**2+MQ1**2)
30786 TH=MQ1**2-SQSH*(ECM-PCM*COSTH)
30788 MET(2)=MET(2)+(MQ1**2-TH)*(MQ2**2-TH)*PCM*
30789 & LAM(2,INT((GEN+1)/2),I1,K1,J1,L1)*MIX(GEN)*
30790 & LAM(2,INT((GR+1)/2),I1,K1,J1,L1)*MIX(GR)
30791 & /((TH-MSL2(GEN))*(TH-MSL2(GR)))
30795 C--final phase space factors
30796 IF(MET(1).LT.EPS.AND.MET(2).LT.EPS) GOTO 70
30798 ME(GN,I1,J1,K1,L1,GR) = MET(GR)*CFAC
30803 HCS = HCS+ME(GN,I1,J1,K1,L1,GR)*DISF(I,1)*DISF(J,2)
30804 IF(HCS.GT.RCS.AND.GENEV)
30805 & CALL HWHRSS(9,I,J,K,L,0,CF,*100)
30806 HCS = HCS+ME(GN,I1,J1,K1,L1,GR)*DISF(J,1)*DISF(I,2)
30807 IF(HCS.GT.RCS.AND.GENEV)
30808 & CALL HWHRSS(10,J,I,K,L,0,CF,*100)
30809 HCS = HCS+ME(GN,I1,J1,K1,L1,GR)
30810 & *DISF(I+6,1)*DISF(J-6,2)
30811 IF(HCS.GT.RCS.AND.GENEV)
30812 & CALL HWHRSS(9,I,J,K,L,1,CF,*100)
30813 HCS = HCS+ME(GN,I1,J1,K1,L1,GR)
30814 & *DISF(J-6,1)*DISF(I+6,2)
30815 IF(HCS.GT.RCS.AND.GENEV)
30816 & CALL HWHRSS(10,J,I,K,L,1,CF,*100)
30824 CALL HWETWO(.TRUE.,.TRUE.)
30830 *CMZ :- -23/10/00 13:53:06 by Peter Richardson
30831 *-- Author : Peter Richardson
30832 C-----------------------------------------------------------------------
30834 C-----------------------------------------------------------------------
30835 C Subroutine for 2 parton -> sparticle + X via LQD
30836 C-----------------------------------------------------------------------
30837 INCLUDE 'HERWIG65.INC'
30838 DOUBLE PRECISION HCS,A(6,12),B(6,12),S,RCS,HWRGEN,CW,FAC2,EC,ME2,
30839 & MW,G,TAU,TAUA,TAUB,LOWTLM,UPPTLM,HWRUNI,SW,SQSH,LC,
30840 & SH,MSL(12),MSU(12),MST(6),C(2,6,12),D(2,6,12),UH,
30841 & TH,MEN(4,6,3,3),SCF(12),SLWD(12),MLT(6),MNT(4),PCM,
30842 & MXS(12),MER(8),MCR(2),RTAB,H(18),MEH(3,18),MXT(12),
30843 & CHAN(12),MXU(12),RAND,FAC,ECM,MC(2),MEC(2,6,3,3),
30844 & MZ,CHPROB,EPS,HWUAEM,XMIN,XMAX,XPOW,SIN2B,GUU(4),
30845 & ML,MN,MLS,MNS,XUPP,MW2,MZ2,ZSLP(2),ZQRK(2),GDD(4),
30846 & MSL2(12),MH(4),MSWD(12)
30847 INTEGER I,J,K,L,J1,K1,GN,GR,SP,GU,GT,I2,I1,NEUTMN
30848 & ,NEUTMX,CHARMN,CHARMX,P
30849 LOGICAL RAD,NEUT,CHAR,HIGGS,FIRST
30850 EXTERNAL HWRGEN,HWRUNI,HWUAEM
30851 COMMON/HWRPIN/XMIN,XMAX,XPOW,FIRST
30852 SAVE HCS,A,B,C,D,FAC,MER,MEC,MEN,MLT,MSL,MSU,MST,SLWD,MNT,MXT,MXU,
30853 & SW,CW,MXS,H,MEH,CHAN,NEUTMN,NEUTMX,CHARMN,CHARMX,RAD,NEUT,
30854 & CHAR,HIGGS,MW,MZ,MW2,MZ2,MCR,SH,SQSH,EC,G,SCF,ZSLP,ZQRK,GUU,
30856 PARAMETER(EPS=1D-20)
30858 RCS = HCS*HWRGEN(0)
30861 C--Calculate Electroweak parameters needed
30868 SIN2B = TWO*SINB*COSB
30869 C--Masses and widths
30871 MSL(2*I-1) = RMASS(423+2*I)
30872 MSL(2*I) = RMASS(435+2*I)
30873 MSL(2*I+5) = RMASS(424+2*I)
30874 MSL(2*I+6) = RMASS(436+2*I)
30875 SLWD(2*I-1) = HBAR/RLTIM(423+2*I)
30876 SLWD(2*I) = HBAR/RLTIM(435+2*I)
30877 SLWD(2*I+5) = HBAR/RLTIM(424+2*I)
30878 SLWD(2*I+6) = HBAR/RLTIM(436+2*I)
30879 MSU(2*I-1) = RMASS(400+2*I)**2
30880 MSU(2*I) = RMASS(412+2*I)**2
30881 MSU(2*I+5) = RMASS(399+2*I)**2
30882 MSU(2*I+6) = RMASS(411+2*I)**2
30883 MST(2*I-1) = RMASS(399+2*I)**2
30884 MST(2*I) = RMASS(411+2*I)**2
30886 MLT(2*I-1) = RMASS(119+2*I)
30889 MSL2(I) = MSL(I)**2
30890 MSWD(I) = MSL(I)*SLWD(I)
30893 MNT(I) = ABS(RMASS(449+I))
30895 MCR(1) = ABS(RMASS(454))
30896 MCR(2) = ABS(RMASS(455))
30897 C--Couplings for the neutralinos
30899 MC(1) = ZMIXSS(L,3)/(2*MW*COSB*SW)
30900 MC(2) = ZMIXSS(L,4)/(2*MW*SINB*SW)
30903 C--resonant charged sleptons
30904 A(L,2*I-2+J) = MC(1)*MLT(2*I-1)*LMIXSS(2*I-1,2,J)
30905 & +SLFCH(9+2*I,L)*LMIXSS(2*I-1,1,J)
30906 B(L,2*I-2+J) = ZSGNSS(L)*(MC(1)*MLT(2*I-1)*
30907 & LMIXSS(2*I-1,1,J)+SRFCH(9+2*I,L)*LMIXSS(2*I-1,2,J))
30908 C--resonant sneutrinos
30909 A(L,2*I+4+J) = SLFCH(10+2*I,L)*LMIXSS(2*I,1,J)
30910 B(L,2*I+4+J) = ZERO
30911 C--u channel up type squarks
30912 C(1,L,2*I-2+J) = MC(2)*QMIXSS(2*I,2,J)*
30913 & RMASS(2*I)+SLFCH(2*I,L)*QMIXSS(2*I,1,J)
30914 D(1,L,2*I-2+J) = ZSGNSS(L)*(MC(2)*QMIXSS(2*I,1,J)*
30915 & RMASS(2*I)+SRFCH(2*I ,L)*QMIXSS(2*I,2,J))
30916 C--u channel down type squarks
30917 C(1,L,2*I+4+J) = MC(1)*QMIXSS(2*I-1,2,J)*
30918 & RMASS(2*I-1)+SLFCH(2*I-1,L)*QMIXSS(2*I-1,1,J)
30919 D(1,L,2*I+4+J) = ZSGNSS(L)*(MC(1)*QMIXSS(2*I-1,1,J)*
30920 & RMASS(2*I-1)+SRFCH(2*I-1,L)*QMIXSS(2*I-1,2,J))
30921 C--t channel down type squarks
30922 C(2,L,2*I-2+J) = ZSGNSS(L)*(MC(1)*QMIXSS(2*I-1,1,J)*
30923 & RMASS(2*I-1)+SRFCH(2*I-1,L)*QMIXSS(2*I-1,2,J))
30924 D(2,L,2*I-2+J) = MC(1)*QMIXSS(2*I-1,2,J)*
30925 & RMASS(2*I-1)+SLFCH(2*I-1,L)*QMIXSS(2*I-1,1,J)
30929 C(2,L,6+I) = C(2,L,I)
30930 D(2,L,6+I) = D(2,L,I)
30933 C--Couplings for charginos
30935 MC(1) = 1/(SQRT(2.0D0)*MW*COSB)
30936 MC(2) = 1/(SQRT(2.0D0)*MW*SINB)
30940 C--resonant charged slepton
30941 A(SP,2*I-2+J) = WMXUSS(L,1)*LMIXSS(2*I-1,1,J)
30942 & -LMIXSS(2*I-1,2,J)*WMXUSS(L,2)*
30944 B(SP,2*I-2+J) = ZERO
30945 C--resonant sneutrinos
30946 A(SP,2*I+4+J) = WSGNSS(L)*WMXVSS(L,1)*LMIXSS(2*I,1,J)
30947 B(SP,2*I+4+J) = -MLT(2*I-1)*WMXUSS(L,2)*LMIXSS(2*I,1,J)
30950 C(1,SP,2*I-2+J) = WSGNSS(L)*(WMXVSS(L,1)*QMIXSS(2*I,1,J)
30951 & -WMXVSS(L,2)*MC(2)*RMASS(2*I)*QMIXSS(2*I,2,J))
30952 D(1,SP,2*I-2+J) = -WMXUSS(L,2)*MC(1)*RMASS(2*I-1)
30955 C(1,SP,2*I+4+J) = WMXUSS(L,1)*QMIXSS(2*I-1,1,J)
30956 & -WMXUSS(L,2)*MC(1)*RMASS(2*I-1)*QMIXSS(2*I-1,2,J)
30957 D(1,SP,2*I+4+J) = -WSGNSS(L)*WMXVSS(L,2)*MC(2)*
30958 & RMASS(2*I)*QMIXSS(2*I-1,1,J)
30962 C--Couplings and massesfor Higgs
30964 MH(I) = RMASS(202+I)
30966 C--first the neutral Higgs
30967 C--fix to the sign of the A and mu term 31/03/00 PR
30969 H(I) = MLT(2*I-1)*HALF/MW/COSB*MUSS*COSA
30970 H(I+4) = MLT(2*I-1)*HALF/MW/COSB*MUSS*SINA
30971 H(I+8) = -MLT(2*I-1)*HALF/MW*MUSS
30973 H(3) = (H(3)+MLT(5)*HALF/MW/COSB*ALSS*SINA)*TWO*
30974 & LMIXSS(5,2,1)*LMIXSS(5,1,1)
30975 & -MZ*SINBPA/CW*(LMIXSS(5,1,1)**2*(HALF-SWEIN)
30976 & +SWEIN*LMIXSS(5,2,1)**2)+MLT(5)**2*SINA/MW/COSB
30977 H(4) = -MZ*SINBPA/CW*(LMIXSS(5,1,1)*LMIXSS(5,1,2)*(HALF-SWEIN)
30978 & +SWEIN*LMIXSS(5,2,1)*LMIXSS(5,2,2))
30979 & +MLT(5)*HALF/COSB/MW*(MUSS*COSA+ALSS*SINA)*
30980 & (LMIXSS(5,2,2)*LMIXSS(5,1,1)+LMIXSS(5,1,2)*LMIXSS(5,2,1))
30981 H(7) = (H(7)-MLT(5)*HALF/MW/COSB*ALSS*COSA)*TWO*
30982 & LMIXSS(5,2,1)*LMIXSS(5,1,1)
30983 & +MZ*COSBPA/CW*(LMIXSS(5,1,1)**2*(HALF-SWEIN)
30984 & +LMIXSS(5,2,1)**2*SWEIN)-MLT(5)**2*COSA/MW/COSB
30985 H(8) = MZ*COSBPA/CW*(LMIXSS(5,1,2)*LMIXSS(5,1,1)*(HALF-SWEIN)
30986 & +LMIXSS(5,2,2)*LMIXSS(5,2,1)*SWEIN)
30987 & +MLT(5)*HALF/MW/COSB*(MUSS*SINA-ALSS*COSA)*
30988 & (LMIXSS(5,2,2)*LMIXSS(5,1,1)+LMIXSS(5,1,2)*LMIXSS(5,2,1))
30989 H(12) = H(11)-MLT(5)*HALF/MW*ALSS*TANB
30991 C--Now the charged Higgs
30994 H(10+2*I+J) = LMIXSS(2*I-1,1,J)*
30995 & (MLT(2*I-1)**2*TANB-MW2*SIN2B)
30996 & +LMIXSS(2*I-1,2,J)*MLT(2*I-1)*MUSS
30998 H(16+J) = H(16+J)+LMIXSS(5,2,J)*MLT(5)*ALSS*TANB
31001 C--couplings of the Higgs to quarks
31003 GUU(I) = GHUUSS(I)**2/MW2*HALF**2
31004 GDD(I) = GHDDSS(I)**2/MW2*HALF**2
31006 GUU(4) = ONE/TANB**2/MW2/8.0D0
31007 GDD(4) = ONE*TANB**2/MW2/8.0D0
31008 C--Couplings of the Z to quarks, left up right down, and charged sleptons
31009 ZQRK(1) = -SW**2/6.0D0/CW
31010 ZQRK(2) = (SW**2/3.0D0-HALF**2)/CW
31011 ZSLP(1) = HALF*(LMIXSS(5,1,1)**2-2.0D0*SW**2)/CW
31012 ZSLP(2) = HALF*LMIXSS(5,1,1)*LMIXSS(5,1,2)/CW
31013 C--parameters for multichannel integration
31019 CHPROB=CHPROB+LAMDA2(I,J,K)**2
31022 RAND = RAND+2*CHPROB
31024 MXS(2*I-2+J) = LMIXSS(2*I-1,1,J)
31025 MXS(2*I+4+J) = LMIXSS(2*I,1,J)
31026 MXU(2*I-2+J) = QMIXSS(2*I,1,J)
31027 MXU(2*I+4+J) = QMIXSS(2*I-1,1,J)
31028 MXT(2*I-2+J) = QMIXSS(2*I-1,2,J)
31029 MXT(2*I+4+J) = QMIXSS(2*I-1,2,J)
31030 CHAN(2*I-2+J) = LMIXSS(2*I-1,1,J)**2*CHPROB
31031 CHAN(2*I+4+J) = LMIXSS(2*I,1,J)**2*CHPROB
31034 IF(RAND.GT.ZERO) THEN
31036 CHAN(I)=CHAN(I)/RAND
31039 CALL HWWARN('HWHRLS',500,*999)
31041 C--decide what processes to generate
31050 C--Decide which process to generate
31051 IF(MOD(IPROC,10000).EQ.4000) THEN
31056 ELSEIF(MOD(IPROC,10000).LT.4020) THEN
31057 IF(MOD(IPROC,10000).NE.4010) THEN
31058 NEUTMN = MOD(IPROC,10)
31062 ELSEIF(MOD(IPROC,10000).LT.4030) THEN
31063 IF(MOD(IPROC,10000).NE.4020) THEN
31064 CHARMN = MOD(IPROC,10)
31068 ELSEIF(MOD(IPROC,10000).EQ.4040) THEN
31070 ELSEIF(MOD(IPROC,10000).EQ.4050) THEN
31074 C--basic parameters
31077 COSTH = HWRUNI(0,-ONE,ONE)
31078 RAND = HWRUNI(0,ZERO,ONE)
31084 MEN(L,I,J,K) = ZERO
31085 MEN(L+2,I,J,K) = ZERO
31086 MEC(L,I,J,K) = ZERO
31094 C--Perform multichannel integration
31096 IF(CHAN(I).GT.RAND) THEN
31102 C--Calculate the hard scale and obtain parton distributions
31103 25 TAUA = MSL2(GR)/S
31104 TAUB = SLWD(GR)**2/S
31105 RTAB = SQRT(TAUA*TAUB)
31107 IF(XMAX**2.GT.S) XUPP = SQRT(S)
31108 LOWTLM = DATAN((XMIN**2/S-TAUA)/RTAB)/RTAB
31109 UPPTLM = DATAN((XUPP**2/S-TAUA)/RTAB)/RTAB
31110 TAU = HWRUNI(0,LOWTLM,UPPTLM)
31111 TAU = RTAB*TAN(RTAB*TAU)+TAUA
31115 XX(1) = EXP(HWRUNI(0,LOG(TAU),ZERO))
31117 CALL HWSGEN(.FALSE.)
31118 C--EM and Weak couplings
31119 EC = SQRT(4*PIFAC*HWUAEM(SH))
31121 C--Calculate the prefactor due multichannel approach
31124 SCF(GN)=1/((SH-MSL2(GN))**2+MSWD(GN)**2)
31125 FAC=FAC+CHAN(GN)*SCF(GN)
31127 FAC=-(UPPTLM-LOWTLM)*GEV2NB*LOG(TAU)/
31128 & (48*TAU*FAC*PIFAC*S**2*SH*SQSH)
31131 C--First we do the neutralino production
31132 IF(.NOT.NEUT) GOTO 200
31141 IF(CHAN(GR).LT.EPS) GOTO 140
31142 DO 130 L=NEUTMN,NEUTMX
31147 IF((ML+MN).GT.SQSH) GOTO 130
31149 PCM = SQRT((SH-(ML+MN)**2)*(SH-(ML-MN)**2))*HALF/SQSH
31150 ECM = SQRT(PCM**2+MLS)
31151 TH = MLS-SQSH*(ECM-PCM*COSTH)
31152 UH = MLS-SQSH*(ECM+PCM*COSTH)
31155 IF(ABS(LAMDA2(I,J,K)).LT.EPS) GOTO 120
31158 IF(GN.GT.3) J1=J1-1
31160 C--squarks in u and t channels
31161 GU = 6*INT((GN-1)/3)+2*J-1
31163 C--calulate the matrix element
31164 ME2=MXS(GR)**2*SCF(GR)*SH*((SH-MLS-MNS)*
31165 & (A(L,GR)**2+B(L,GR)**2)-4*ML*MN*A(L,GR)*B(L,GR))
31166 & +MXU(GU)**2*(MLS-UH)*(MNS-UH)*
31167 & (C(1,L,GU)**2+D(1,L,GU)**2)/(UH-MSU(GU))**2
31168 & +MXT(GT)**2*(MLS-TH)*(MNS-TH)*
31169 & (C(2,L,GT)**2+D(2,L,GT)**2)/(TH-MST(GT))**2
31170 & -TWO*MXT(GT)*MXU(GU)*C(1,L,GU)*C(2,L,GT)*(MLS*MNS-UH*TH)
31171 & /(UH-MSU(GU))/(TH-MST(GT))
31172 & +TWO*MXS(GR)*MXU(GU)*(SH-MSL2(GR))*SCF(GR)*C(1,L,GU)*
31173 & SH*(UH*A(L,GR)+ML*MN*B(L,GR))/(UH-MSU(GU))
31174 & +TWO*MXS(GR)*MXT(GT)*(SH-MSL2(GR))*SCF(GR)*C(2,L,GT)*
31175 & SH*(TH*A(L,GR)+ML*MN*B(L,GR))/(TH-MST(GT))
31176 C--s channel mixing L/R mixing
31177 IF(ABS(MXS(GR+1)).GT.EPS) THEN
31178 ME2=ME2+MXS(GR+1)**2*SCF(GR+1)*SH*((SH-MLS-MNS)*
31179 & (A(L,GR+1)**2+B(L,GR+1)**2)
31180 & -4*ML*MN*A(L,GR+1)*B(L,GR+1))
31181 & +TWO*MXS(GR)*MXS(GR+1)*SCF(GR)*SCF(GR+1)*
31182 & ((SH-MSL2(GR))*(SH-MSL2(GR+1))+
31183 & MSWD(GR)*MSWD(GR+1))*SH*
31184 & ((SH-MLS-MNS)*(A(L,GR)*A(L,GR+1)+B(L,GR)*B(L,GR+1))
31185 & -2*ML*MN*(A(L,GR)*B(L,GR+1)+A(L,GR+1)*B(L,GR)))
31186 & +TWO*MXS(GR+1)*MXU(GU)*(SH-MSL2(GR+1))*SCF(GR+1)*
31187 & SH*C(1,L,GU)*(UH*A(L,GR+1)+ML*MN*B(L,GR+1))
31189 & +TWO*MXS(GR+1)*MXT(GT)*(SH-MSL2(GR+1))*SCF(GR+1)*
31190 & SH*C(2,L,GT)*(TH*A(L,GR+1)+ML*MN*B(L,GR+1))
31192 IF(ABS(MXU(GU+1)).GT.EPS) ME2=ME2+TWO*MXS(GR+1)*MXU(GU+1)*
31193 & (SH-MSL2(GR+1))*SCF(GR+1)*SH*C(1,L,GU+1)*
31194 & (UH*A(L,GR+1)+ML*MN*B(L,GR+1))/(UH-MSU(GU+1))
31195 IF(ABS(MXT(GT-1)).GT.EPS) ME2=ME2+TWO*MXS(GR+1)*MXT(GT-1)*
31196 & (SH-MSL2(GR+1))*SCF(GR+1)*SH*C(2,L,GT-1)*
31197 & (TH*A(L,GR+1)+ML*MN*B(L,GR+1))/(TH-MST(GT-1))
31199 C--u channel L/R mixing
31200 IF(ABS(MXU(GU+1)).GT.EPS) THEN
31201 ME2=ME2+MXU(GU+1)**2*(MLS-UH)*(MNS-UH)*(C(1,L,GU+1)**2+
31202 & D(1,L,GU+1)**2)/(UH-MSU(GU+1))**2
31203 & +TWO*MXU(GU)*MXU(GU+1)*(MLS-UH)*(MNS-UH)*
31204 & (C(1,L,GU)*C(1,L,GU+1)+D(1,L,GU)*D(1,L,GU+1))
31205 & /(UH-MSU(GU))/(UH-MSU(GU+1))
31206 & -TWO*MXT(GT)*MXU(GU+1)*C(1,L,GU+1)*C(2,L,GT)*
31207 & (MLS*MNS-UH*TH)/(UH-MSU(GU+1))/(TH-MST(GT))
31208 & +TWO*MXS(GR)*MXU(GU+1)*(SH-MSL2(GR))*SCF(GR)*
31209 & SH*C(1,L,GU+1)*(UH*A(L,GR)+ML*MN*B(L,GR))
31211 IF(ABS(MXT(GT-1)).GT.EPS) ME2=ME2-TWO*MXT(GT-1)*MXU(GU+1)*
31212 & C(1,L,GU+1)*C(2,L,GT-1)*(MLS*MNS-UH*TH)
31213 & /(UH-MSU(GU+1))/(TH-MST(GT-1))
31215 C--t channel L/R mixing
31216 IF(ABS(MXT(GT-1)).GT.EPS) THEN
31217 ME2=ME2+MXT(GT-1)**2*(MLS-TH)*(MNS-TH)*(C(2,L,GT-1)**2
31218 & +D(2,L,GT-1)**2)/(TH-MST(GT-1))**2
31219 & +TWO*MXT(GT)*MXT(GT-1)*(MLS-TH)*(MNS-TH)*
31220 & (C(2,L,GT)*C(2,L,GT-1)+D(2,L,GT)*D(2,L,GT-1))
31221 & /(TH-MST(GT))/(TH-MST(GT-1))
31222 & -TWO*MXT(GT-1)*MXU(GU)*C(1,L,GU)*C(2,L,GT-1)*
31223 & (MLS*MNS-UH*TH)/(UH-MSU(GU))/(TH-MST(GT-1))
31224 & +TWO*MXS(GR)*MXT(GT-1)*(SH-MSL2(GR))*SCF(GR)*
31225 & SH*C(2,L,GT-1)*(TH*A(L,GR)+ML*MN*B(L,GR))
31228 C--multiply by lamda and factors
31229 MEN(L,GN,J,K) = FAC*ME2*EC**2*LAMDA2(I,J,K)**2*PCM
31231 HCS = HCS+MEN(L,GN,J,K)*DISF(J1,1)*DISF(K1,2)
31232 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(11,J1,K1,I2,L,0,0,*500)
31233 HCS = HCS+MEN(L,GN,J,K)*DISF(K1,1)*DISF(J1,2)
31234 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(12,K1,J1,I2,L,0,0,*500)
31235 HCS = HCS+MEN(L,GN,J,K)*DISF(J1+6,1)*DISF(K1-6,2)
31236 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(11,J1,K1,I2,L,1,0,*500)
31237 HCS = HCS+MEN(L,GN,J,K)*DISF(K1-6,1)*DISF(J1+6,2)
31238 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(12,K1,J1,I2,L,1,0,*500)
31243 200 IF(.NOT.CHAR) GOTO 300
31244 C--Chargino production
31253 IF(CHAN(GR).LT.EPS) GOTO 240
31254 DO 230 L=CHARMN,CHARMX
31260 IF((ML+MN).GT.EMSCA) GOTO 230
31261 PCM = SQRT((SH-(ML+MN)**2)*(SH-(ML-MN)**2))*HALF/SQSH
31262 ECM = SQRT(PCM**2+MLS)
31263 TH = MLS-SQSH*(ECM-PCM*COSTH)
31264 UH = MLS-SQSH*(ECM+PCM*COSTH)
31267 IF(ABS(LAMDA2(I,J,K)).LT.EPS) GOTO 220
31270 IF(GN.GT.3) J1=J1-1
31273 IF(GN.LE.3) GU=GU+6
31274 C--Calculate the matrix element, s and u terms
31275 ME2 =MXS(GR)**2*SCF(GR)*SH*(
31276 & (SH-MLS-MNS)*(A(SP,GR)**2+B(SP,GR)**2)
31277 & -4*ML*MN*A(SP,GR)*B(SP,GR))
31278 & +MXU(GU)**2*(MLS-UH)*(MNS-UH)*
31279 & (C(1,SP,GU)**2+D(1,SP,GU)**2)/(UH-MSU(GU))**2
31280 & -2*MXS(GR)*MXU(GU)*(SH-MSL2(GR))*SCF(GR)*C(1,SP,GU)*
31281 & SH*(UH*A(SP,GR)+B(SP,GR)*ML*MN)/(UH-MSU(GU))
31282 C--s channel L/R mixing
31283 IF(ABS(MXS(GR+1)).GT.EPS) THEN
31284 ME2=ME2+MXS(GR+1)**2*SCF(GR+1)*SH*((SH-MLS-MNS)*
31285 & (A(SP,GR+1)**2+B(SP,GR+1)**2)
31286 & -4*ML*MN*A(SP,GR+1)*B(SP,GR+1))
31287 & +2*MXS(GR)*MXS(GR+1)*SCF(GR)*SCF(GR+1)*
31288 & ((SH-MSL2(GR))*(SH-MSL2(GR+1))+
31289 & MSWD(GR)*MSWD(GR+1))*SH*
31290 & ((SH-MLS-MNS)*(A(SP,GR)*A(SP,GR+1)
31291 & +B(SP,GR)*B(SP,GR+1))-4*ML*MN*
31292 & (A(SP,GR)*B(SP,GR+1)+B(SP,GR)*A(SP,GR+1)))
31293 & -2*MXS(GR+1)*MXU(GU)*(SH-MSL2(GR+1))*SCF(GR+1)*SH*
31294 & C(1,SP,GU)*(UH*A(SP,GR+1)+B(SP,GR+1)*ML*MN)
31296 IF(ABS(MXU(GU+1)).GT.EPS) ME2=ME2-2*MXS(GR+1)*MXU(GU+1)*
31297 & (SH-MSL2(GR+1))*SCF(GR+1)*C(1,SP,GU+1)*SH*
31298 & (UH*A(SP,GR+1)+B(SP,GR+1)*ML*MN)/(UH-MSU(GU+1))
31300 C--u channel L/R mixing
31301 IF(ABS(MXU(GU+1)).GT.EPS) ME2 = ME2+MXU(GU+1)**2*(MLS-UH)*
31302 & (MNS-UH)*(C(1,SP,GU+1)**2+D(1,SP,GU+1)**2)
31303 & /(UH-MSU(GU+1))**2
31304 & +2*MXU(GU)*MXU(GU+1)*(MLS-UH)*(MNS-UH)*
31305 & (C(1,SP,GU)*C(1,SP,GU+1)+D(1,SP,GU)*D(1,SP,GU+1))
31306 & /(UH-MSU(GU))/(UH-MSU(GU+1))
31307 & -2*MXS(GR)*MXU(GU+1)*(SH-MSL2(GR))*SCF(GR)*SH*
31308 & C(1,SP,GU+1)*(UH*A(SP,GR)+B(SP,GR)*ML*MN)
31310 MEC(L,GN,J,K) = FAC*ME2*G**2*LAMDA2(I,J,K)**2*PCM*HALF
31313 HCS = HCS+MEC(L,GN,J,K)*DISF(J1,1)*DISF(K1,2)
31314 IF(GN.GT.3) P = P+2
31315 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(11,J1,K1,I2,P,0,0,*500)
31316 HCS = HCS+MEC(L,GN,J,K)*DISF(K1,1)*DISF(J1,2)
31317 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(12,K1,J1,I2,P,0,0,*500)
31318 HCS = HCS+MEC(L,GN,J,K)*DISF(J1+6,1)*DISF(K1-6,2)
31319 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(11,J1,K1,I2,P,1,0,*500)
31320 HCS = HCS+MEC(L,GN,J,K)*DISF(K1-6,1)*DISF(J1+6,2)
31321 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(12,K1,J1,I2,P,1,0,*500)
31326 300 IF(.NOT.RAD) GOTO 400
31327 C--Radiative decays
31332 C--charged slepton to sneutrino W
31333 IF(SQSH.GT.(MW+MSL(I1))) THEN
31334 PCM = SQRT((SH-(MW+MSL(I1))**2)*(SH-(MW-MSL(I1))**2))*HALF/SQSH
31335 ECM = SQRT(PCM**2+MW2)
31336 TH = MW2-SQSH*(ECM-PCM*COSTH)
31337 UH = MW2-SQSH*(ECM+PCM*COSTH)
31338 ME2 = MXS(I)**4*SCF(I)*SH**2*PCM**2
31339 & +HALF**2/TH**2*(TWO*MW2*(UH*TH-MSL2(I1)*MW2)+TH**2*SH)
31340 & -HALF*MXS(I)**2*SH*(SH-MSL2(I))*SCF(I)/TH*
31341 & (MW2*(TWO*MSL2(I1)-TH)+(SH-MSL2(I1))*TH)
31342 IF(GN.EQ.3) ME2 = ME2+MXS(I+1)**4*SCF(I+1)*SH**2*PCM**2
31343 & +2.0D0*MXS(I)**2*MXS(I+1)**2*SCF(I)*SCF(I+1)*SH**2*PCM**2
31344 & *((SH-MSL2(I))*(SH-MSL2(I+1))+MSWD(I)*MSWD(I+1))
31345 & -HALF*MXS(I+1)**2*SH*(SH-MSL2(I+1))*SCF(I+1)/TH*
31346 & (MW2*(TWO*MSL2(I1)-TH)+(SH-MSL2(I1))*TH)
31347 MER(GN) = ME2*PCM/MW2
31349 C--sneutrino to charged slepton W
31350 IF(SQSH.GT.(MW+MSL(I))) THEN
31351 PCM = SQRT((SH-(MW+MSL(I))**2)*(SH-(MW-MSL(I))**2))*HALF/SQSH
31352 ECM = SQRT(PCM**2+MW2)
31353 TH = MW2-SQSH*(ECM-PCM*COSTH)
31354 UH = MW2-SQSH*(ECM+PCM*COSTH)
31355 ME2 = MXS(I)**2*SCF(I1)*SH**2*PCM**2
31356 & +HALF**2*MXS(I)**2/TH**2*
31357 & (TWO*MW2*(UH*TH-MW2*MSL2(I))+TH**2*SH)
31358 & -HALF*MXS(I)**2*SH*(SH-MSL2(I1))*SCF(I1)/TH*
31359 & (MW2*(TWO*MSL2(I)-TH)+(SH-MSL2(I))*TH)
31360 MER(GN+4) = ME2*PCM/MW2
31363 C--now the decay stau_2 to stau_1 Z
31364 IF(SQSH.GT.(MZ+MSL(5))) THEN
31365 PCM = SQRT((SH-(MZ+MSL(5))**2)*(SH-(MZ-MSL(5))**2))*HALF/SQSH
31366 ECM = SQRT(PCM**2+MZ2)
31367 TH = MZ2-SQSH*(ECM-PCM*COSTH)
31368 UH = MZ2-SQSH*(ECM+PCM*COSTH)
31369 ME2 = SH**2*PCM**2*(SCF(5)*MXS(5)**2*ZSLP(1)**2
31370 & +SCF(6)*MXS(6)**2*ZSLP(2)**2+TWO*SCF(5)*SCF(6)*
31371 & MXS(5)*MXS(6)*ZSLP(1)*ZSLP(2)*((SH-MSL2(5))*
31372 & (SH-MSL2(6))+MSWD(5)*MSWD(6)))
31373 & +MXS(5)**2*ZQRK(2)**2/TH**2*
31374 & (TWO*MZ2*(UH*TH-MZ2*MSL2(5))+TH**2*SH)
31375 & +MXS(5)**2*ZQRK(1)**2/UH**2*
31376 & (TWO*MZ2*(UH*TH-MZ2*MSL2(5))+UH**2*SH)
31377 & +MXS(5)*SH*(MXS(5)*SCF(5)*ZSLP(1)*(SH-MSL2(5))
31378 & +MXS(6)*SCF(6)*ZSLP(2)*(SH-MSL2(6)))*
31379 & (-ZQRK(2)/TH*(MZ2*(TWO*MSL2(5)-TH)+TH*(SH-MSL2(5)))
31380 & +ZQRK(1)/UH*(MZ2*(TWO*MSL2(5)-UH)+UH*(SH-MSL2(5))))
31381 & +TWO*MXS(5)**2*ZQRK(1)*ZQRK(2)/UH/TH*
31382 & (TWO*MZ2*(MSL2(5)-UH)*(MSL2(5)-TH)-SH*UH*TH)
31383 MER(4) = TWO*ME2*PCM/MZ2
31385 C--now the decay tau sneutrino to tau_2 W
31386 IF(SQSH.GT.(MW+MSL(6))) THEN
31387 PCM = SQRT((SH-(MW+MSL(6))**2)*(SH-(MW-MSL(6))**2))*HALF/SQSH
31388 ECM = SQRT(PCM**2+MW2)
31389 TH = MW2-SQSH*(ECM-PCM*COSTH)
31390 UH = MW2-SQSH*(ECM+PCM*COSTH)
31391 ME2 = MXS(6)**2*SCF(11)*SH**2*PCM**2
31392 & +HALF**2*MXS(6)**2/TH**2*
31393 & (TWO*MW2*(UH*TH-MW2*MSL2(6))+TH**2*SH)
31394 & -HALF*MXS(6)**2*SH*(SH-MSL2(11))*SCF(11)/TH*
31395 & (MW2*(2*MSL2(6)-TH)+(SH-MSL2(6))*TH)
31396 MER(8) = ME2*PCM/MW2
31398 C--Multiply by the parton distributions
31403 LC = LAMDA2(I,J,K)**2
31405 LC = LAMDA2(3,J,K)**2
31407 IF(LC.LT.EPS) GOTO 330
31409 C--radiative cross-sections
31413 HCS = HCS+ME2*DISF(J1,1)*DISF(K1,2)
31414 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(13,J1,K1,I,I,0,0,*500)
31415 HCS = HCS+ME2*DISF(K1,1)*DISF(J1,2)
31416 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(14,K1,J1,I,I,0,0,*500)
31417 HCS = HCS+ME2*DISF(J1+6,1)*DISF(K1-6,2)
31418 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(13,J1,K1,I,I,1,0,*500)
31419 HCS = HCS+ME2*DISF(K1-6,1)*DISF(J1+6,2)
31420 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(14,K1,J1,I,I,1,0,*500)
31423 ME2 = FAC2*MER(I+4)
31424 HCS = HCS+ME2*DISF(J1,1)*DISF(K1,2)
31425 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(13,J1,K1,I+4,I+4,0,0,*500)
31426 HCS = HCS+ME2*DISF(K1,1)*DISF(J1,2)
31427 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(14,K1,J1,I+4,I+4,0,0,*500)
31428 HCS = HCS+ME2*DISF(J1+6,1)*DISF(K1-6,2)
31429 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(13,J1,K1,I+4,I+4,1,0,*500)
31430 HCS = HCS+ME2*DISF(K1-6,1)*DISF(J1+6,2)
31431 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(14,K1,J1,I+4,I+4,1,0,*500)
31435 400 IF(.NOT.HIGGS) GOTO 500
31439 405 MEH(I,J) = ZERO
31441 C--Neutral higgs charged slepton
31444 C--first two generations
31445 IF(SQSH.LT.MH(L)+MSL(2*I)) GOTO 410
31446 PCM = SQRT((SH-(MSL(2*I)+MH(L))**2)*
31447 & (SH-(MSL(2*I)-MH(L))**2))*HALF/SQSH
31448 MEH(1,3*L-3+I) = PCM*SH*SCF(2*I-1)*H(4*L+I-4)**2
31450 C--third generation
31451 IF(SQSH.LT.MH(L)+MSL(5)) GOTO 420
31452 PCM = SQRT((SH-(MSL(5)+MH(L))**2)*
31453 & (SH-(MSL(5)-MH(L))**2))*HALF/SQSH
31454 ECM = SQRT(PCM**2+MH(L)**2)
31455 TH = MH(L)**2-SQSH*(ECM-PCM*COSTH)
31456 UH = MH(L)**2-SQSH*(ECM+PCM*COSTH)
31457 MEH(1,3*L) = PCM*SH*(MXS(5)**2*SCF(5)*H(4*L-1)**2
31458 & +MXS(6)**2*SCF(6)*H(4*L)**2
31459 & +TWO*MXS(5)*MXS(6)*SCF(5)*SCF(6)*H(4*L-1)*
31460 & H(4*L)*((SH-MSL2(5))*(SH-MSL2(6))+
31461 & MSWD(5)*MSWD(6)) )
31462 ME2 = MXS(5)**2*PCM*(UH*TH-MSL2(5)*MH(L)**2)
31463 MEH(2,3*L) =ME2*GUU(L)/TH**2
31464 MEH(3,3*L) =ME2*GDD(L)/UH**2
31468 C--charged slepton charged Higgs
31470 IF(SQSH.LT.(MH(4)+MSL(2*I-2+J))) GOTO 430
31471 PCM = SQRT((SH-(MH(4)+MSL(2*I-2+J))**2)*
31472 & (SH-(MH(4)-MSL(2*I-2+J))**2))*HALF/SQSH
31473 ECM = SQRT(PCM**2+MH(4)**2)
31474 TH = MH(4)**2-SQSH*(ECM-PCM*COSTH)
31475 UH = MH(4)**2-SQSH*(ECM+PCM*COSTH)
31476 MEH(1,2*I+J+7) = PCM*SH*HALF/MW2*H(2*I+J+10)**2*SCF(5+2*I)
31477 MEH(2,2*I+J+7) = PCM*GDD(4)*MXS(2*I-2+J)**2*
31478 & (UH*TH-MH(4)**2*MSL2(2*I-2+J))/TH**2
31480 C--Sneutrino Charged Higgs
31481 IF(SQSH.LT.(MH(4)+MSL(2*I+5))) GOTO 440
31482 PCM = SQRT((SH-(MH(4)+MSL(2*I+5))**2)*
31483 & (SH-(MH(4)-MSL(2*I+5))**2))*HALF/SQSH
31484 ECM = SQRT(PCM**2+MH(4)**2)
31485 TH = MH(4)**2-SQSH*(ECM-PCM*COSTH)
31486 UH = MH(4)**2-SQSH*(ECM+PCM*COSTH)
31487 MEH(1,15+I) = PCM*SH*HALF/MW2*(
31488 & MXS(2*I-1)**2*SCF(2*I-1)*H(11+2*I)**2
31489 & +MXS(2*I)**2*SCF(2*I)*H(12+2*I)**2
31490 & +TWO*MXS(2*I-1)*MXS(2*I)*SCF(2*I-1)*
31491 & SCF(2*I)*H(11+2*I)*H(12+2*I)*
31492 & ((SH-MSL2(2*I-1))*(SH-MSL2(2*I))+
31493 & MSWD(2*I-1)*MSWD(2*I)))
31494 MEH(2,15+I) = PCM*GUU(4)*
31495 & (UH*TH-MH(4)**2*MSL2(2*I+5))/TH**2
31497 C--Multiply by the parton distributions
31501 IF(LAMDA2(I,J,K).LT.EPS) GOTO 490
31502 C--Higgs cross-sections
31505 FAC2 = G**2*LAMDA2(I,J,K)**2*FAC*HALF
31507 ME2 = FAC2*(MEH(1,3*L-3+I)+RMASS(J1)**2*MEH(2,3*L-3+I)
31508 & +RMASS(K1)**2*MEH(3,3*L-3+I))
31509 HCS = HCS+ME2*DISF(J1,1)*DISF(K1,2)
31510 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(15,J1,K1,I,L,0,0,*500)
31511 HCS = HCS+ME2*DISF(K1,1)*DISF(J1,2)
31512 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(16,K1,J1,I,L,0,0,*500)
31513 HCS = HCS+ME2*DISF(J1+6,1)*DISF(K1-6,2)
31514 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(15,J1,K1,I,L,1,0,*500)
31515 HCS = HCS+ME2*DISF(K1-6,1)*DISF(J1+6,2)
31516 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(16,K1,J1,I,L,1,0,*500)
31518 ME2 = FAC2*(MEH(1,15+I)+RMASS(J1)**2*MEH(2,15+I))
31519 HCS = HCS+ME2*DISF(J1,1)*DISF(K1,2)
31520 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(15,J1,K1,9+I,4,0,0,*500)
31521 HCS = HCS+ME2*DISF(K1,1)*DISF(J1,2)
31522 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(16,K1,J1,9+I,4,0,0,*500)
31523 HCS = HCS+ME2*DISF(J1+6,1)*DISF(K1-6,2)
31524 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(15,J1,K1,9+I,5,1,0,*500)
31525 HCS = HCS+ME2*DISF(K1-6,1)*DISF(J1+6,2)
31526 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(16,K1,J1,9+I,5,1,0,*500)
31530 ME2 = FAC2*(MEH(1,2*I+L+6)+RMASS(J1)**2*MEH(2,2*I+L+6))
31531 HCS = HCS+ME2*DISF(J1,1)*DISF(K1,2)
31532 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(15,J1,K1,2*I+L,5,0,0,*500)
31533 HCS = HCS+ME2*DISF(K1,1)*DISF(J1,2)
31534 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(16,K1,J1,2*I+L,5,0,0,*500)
31535 HCS = HCS+ME2*DISF(J1+6,1)*DISF(K1-6,2)
31536 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(15,J1,K1,2*I+L,4,1,0,*500)
31537 HCS = HCS+ME2*DISF(K1-6,1)*DISF(J1+6,2)
31538 IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(16,K1,J1,2*I+L,4,1,0,*500)
31543 C--Setup to generate the event
31545 CALL HWETWO(.TRUE.,.TRUE.)
31551 *CMZ :- -20/07/99 10:56:12 by Peter Richardson
31552 *-- Author : Peter Richardson
31553 C-----------------------------------------------------------------------
31555 C-----------------------------------------------------------------------
31556 C Subroutine for all hadron-hadron Rparity violating processes
31557 C-----------------------------------------------------------------------
31558 INCLUDE 'HERWIG65.INC'
31559 IF(MOD(IPROC,10000).GE.4000.AND.MOD(IPROC,10000).LT.4060) THEN
31560 C--SINGLE SPARTICLE VIA LQD
31562 ELSEIF(MOD(IPROC,10000).GE.4060.AND.MOD(IPROC,10000).LT.4100) THEN
31563 C--RESONANT SLEPTONS TO STANDARD MODEL VIA LQD
31565 ELSEIF(MOD(IPROC,10000).GE.4100.AND.MOD(IPROC,10000).LT.4160) THEN
31566 C--SINGLE SPARTICLE VIA UDD
31568 C--RESONANT SQUARKS TO STANDARD MODEL VIA UDD
31569 ELSEIF(MOD(IPROC,10000).EQ.4160) THEN
31573 CALL HWWARN('HWHRSP',500,*999)
31577 *CMZ :- -20/07/99 10:56:12 by Peter Richardson
31578 *-- Author : Peter Richardson
31579 C-----------------------------------------------------------------------
31580 SUBROUTINE HWHRSS(TYPE,ID1,ID2,ID3,ID4,R4,IPERM,*)
31581 C-----------------------------------------------------------------------
31582 C IDENTIDY HARD R-PARITY VIOLATING PROCESS
31583 C-----------------------------------------------------------------------
31584 INCLUDE 'HERWIG65.INC'
31585 INTEGER ID3, ID4, R4, IPERM,TYPE,ID1,ID2,NEUTD1(8),SLEPID(8),
31586 & NEUTD2(13),SQUID(6),SGN,HWUANT,SQUID2(12),SLPID2(12),
31587 & GAGID1(6),GAGID2(8)
31589 DATA NEUTD1 /450,451,452,453,454,455,456,457/
31590 DATA NEUTD2 /449,449,449,450,451,452,453,454,455,456,457,454,455/
31591 DATA SLEPID /432,434,436,435,431,433,435,447/
31592 DATA SQUID /411,423,412,412,424,411/
31593 DATA SQUID2 /407,419,409,421,411,423,408,420,410,422,412,424/
31594 DATA SLPID2 /443,445,435,431,443,433,445,435,447,432,434,436/
31595 DATA GAGID1 /199,199,200,198,198,200/
31596 DATA GAGID2 /198,198,198,200,199,199,199,199/
31598 IF(IPERM.EQ.0) THEN
31603 ELSEIF(IPERM.EQ.1) THEN
31608 ELSEIF(IPERM.EQ.2) THEN
31614 CALL HWWARN('HWHRSS',100,*999)
31621 IF(MOD(TYPE,2).EQ.0) SGN = -1
31622 IDN(1) = ID1+R4*6*SGN
31623 IDN(2) = ID2-R4*6*SGN
31628 ELSEIF(TYPE.GE.3.AND.TYPE.LE.4) THEN
31630 IDN(4) = NEUTD2(ID4)
31631 ELSEIF(TYPE.GE.5.AND.TYPE.LE.6) THEN
31632 IDN(3) = GAGID1(ID3)
31633 IDN(4) = SQUID(ID4)-R4*6
31634 IF(R4.EQ.1) IDN(3) = HWUANT(IDN(3))
31635 ELSEIF(TYPE.GE.7.AND.TYPE.LE.8) THEN
31637 IDN(4) = SQUID2(ID4)-R4*6
31638 ELSEIF(TYPE.GE.9.AND.TYPE.LE.10) THEN
31641 IF(IPERM.EQ.2.AND.TYPE.EQ.10) THEN
31646 ELSEIF(TYPE.GE.11.AND.TYPE.LE.12) THEN
31647 IDN(3) = 120+ID3-R4*6
31648 IDN(4) = NEUTD1(ID4)
31649 IF(R4.EQ.1) IDN(4) = HWUANT(IDN(4))
31650 ELSEIF(TYPE.GE.13.AND.TYPE.LE.14) THEN
31651 IDN(3) = SLEPID(ID3)-R4*6
31652 IDN(4) = GAGID2(ID4)
31653 IF(R4.NE.0) IDN(4) = HWUANT(IDN(4))
31654 ELSEIF(TYPE.GE.15.AND.TYPE.LE.16) THEN
31655 IDN(3) = SLPID2(ID3)-R4*6
31658 IF(MOD(TYPE,2).EQ.0.AND.TYPE.NE.8) COSTH=-COSTH
31662 *CMZ :- -18/03/04 18.42.43 by Mike Seymour
31663 *-- Author : Mike Seymour
31664 C-----------------------------------------------------------------------
31665 SUBROUTINE HWHSCT(REPORT,FIRSTC,JMUEO,PTJIM)
31666 C-----------------------------------------------------------------------
31667 C RELABEL THE EVENT RECORD FOR EXTRA HARD SCATTERING,
31668 C DO THE SCATTERING, PARTON SHOWER IT, AND CLEAN UP THE EVENT RECORD
31669 C REPORT RETURNS THE OUTCOME:
31671 C 1 = FAILED DUE TO ERROR IN HARD SCATTERING GENERATION
31672 C 2 = FAILED DUE TO ENERGY CONSERVATION IN HARD SCATTERING
31673 C 3 = FAILED DUE TO ERROR IN PARTON EVOLUTION
31674 C 4 = FAILED DUE TO ENERGY CONSERVATION IN PARTON EVOLUTION
31675 C 5 = COMPLETELY FAILED (IERROR IS ALSO NON-ZERO TO CANCEL EVENT)
31676 C FIRSTC IS AN INPUT FLAG THAT SAYS THAT THIS IS THE FIRST CALL
31678 C JMUEO IS THE UNDERLYING EVENT OPTION: 1=>VETO EVENTS WITH M
31679 C SCATTERS ABOVE PTMIN WITH PROBABILITY 1/M
31680 C PTJIM IS THE MINIMUM TRANSVERSE MOMENTUM FOR ADDITIONAL SCATTERS
31681 C-----------------------------------------------------------------------
31682 INCLUDE 'HERWIG65.INC'
31683 DOUBLE PRECISION HWRGEN,HWRGET,HWRSET,WGT,PBOOST(5),RBOOST(3,3),
31684 $ WJMAX,PT,PTJIM,DUMMY,HWUPCM
31685 INTEGER IHEP,IBM,ITG,IBMN,ITGN,IBMT,ITGT,I,REPORT,NHARD,
31686 $ MYRN(2),TMPRN,JMUEO
31687 LOGICAL COL,FIRSTC,TMPFLG
31689 DATA WJMAX,MYRN,NHARD/0,004122,7679781,0/
31690 EXTERNAL HWRGEN,HWRGET,HWRSET,HWUPCM
31691 COL(I)=I.EQ.13 .OR. I.GE.1.AND.I.LE.6 .OR. I.GE.115.AND.I.LE.120
31693 IF (IERROR.NE.0) RETURN
31694 C---RESET THE COUNTER FOR HARD SCATTERS ON THE FIRST CALL
31695 IF (FIRSTC) NHARD=0
31696 C---FIND BEAM AND TARGET REMNANTS
31697 CALL HWHREM(IBM,ITG)
31698 IF (IERROR.NE.0) RETURN
31699 C---RECALCULATE THEIR MASS CORRECTLY
31700 CALL HWUMAS(PHEP(1,IBM))
31701 CALL HWUMAS(PHEP(1,ITG))
31702 C---SET UP NEW ENTRIES IN THE EVENT RECORD
31704 CALL HWVEQU(5,PHEP(1,IBM),PHEP(1,NHEP))
31708 IF (IBMT.EQ.0) THEN
31712 JMOHEP(1,NHEP)=IBMT
31718 IDHEP(NHEP)=IDPDG(IDHW(NHEP))
31720 CALL HWVEQU(5,PHEP(1,ITG),PHEP(1,NHEP))
31724 IF (ITGT.EQ.0) THEN
31728 JMOHEP(1,NHEP)=ITGT
31734 IDHEP(NHEP)=IDPDG(IDHW(NHEP))
31735 C---BOOST TO THEIR CENTRE-OF-MASS FRAME
31736 CALL HWVSUM(4,PHEP(1,IBMN),PHEP(1,ITGN),PBOOST)
31737 CALL HWUMAS(PBOOST)
31738 DO 100 IHEP=IBMN,NHEP
31739 CALL HWULOF(PBOOST,PHEP(1,IHEP),PHEP(1,IHEP))
31741 CALL HWUROT(PHEP(1,IBMN),ONE,ZERO,RBOOST)
31742 DO 110 IHEP=IBMN,NHEP
31743 CALL HWUROF(RBOOST,PHEP(1,IHEP),PHEP(1,IHEP))
31745 C---PERFORM A SEARCH FOR THE MAXIMUM WEIGHT, IF IT IS NOT YET FOUND
31746 IF (WJMAX.EQ.0) THEN
31747 C---USING LOCAL RANDOM NUMBER SEEDS
31748 DUMMY=HWRGET(TMPRN)
31752 CALL HWHSCU(WGT,PTJIM)
31753 WJMAX=MAX(WJMAX,WGT)
31755 WRITE (6,'(A,G12.4)') ' Jimmy search for maximum weight=',WJMAX
31757 DUMMY=HWRSET(TMPRN)
31758 C---BECAUSE OF THE ENERGY DEPENDENCE, LEAVE LOTS OF SAFETY MARGIN
31761 C---GENERATE A NEW HARD SCATTERING
31763 10 CALL HWHSCU(WGT,PTJIM)
31764 IF (WGT.GT.WJMAX) THEN
31765 WRITE (6,'(A,G12.4/A,G12.4,A,G12.4)')
31766 $ ' Jimmy maximum weight exceeded! SQRT(S)=',PHEP(5,3),
31767 $ ' Increasing from ',WJMAX,' to ',WGT*2
31770 IF (WGT.LE.WJMAX*HWRGEN(0)) GOTO 10
31772 CALL HWHSCU(WGT,PTJIM)
31773 C---IF ADDING LOW PT SCATTERS TO HIGH PT EVENTS ADD AN EXTRA VETO ON
31774 C SCATTERS THAT HAPPEN TO BE HIGH PT
31776 IF (JMUEO.EQ.1) THEN
31777 C---FIRST RECONSTRUCT THE PT THAT WAS GENERATED IN THE SCATTERING
31778 PT=SQRT(PHEP(1,NHEP)**2+PHEP(2,NHEP)**2)*
31779 $ SQRT(XX(1)*XX(2))*PHEP(5,3)
31780 $ /(2*HWUPCM(PHEP(5,NHEP-2),PHEP(5,NHEP-1),PHEP(5,NHEP)))
31781 C---IF IT IS ABOVE THE TRIGGER THRESHOLD APPLY THE VETO
31782 IF (PT.GT.PTMIN) THEN
31783 IF ((NHARD+2)*HWRGEN(1).LT.1) THEN
31790 C---IF MOMENTUM CANNOT BE CONSERVED, STOP GENERATING HARD SCATTERS
31791 IF ( PHEP(4,IBMN+2) .GT. PHEP(4,IBMN).OR.
31792 $ PHEP(4,ITGN+2) .GT. PHEP(4,ITGN).OR.
31793 $ PHEP(3,IBMN+2) .GT. PHEP(3,IBMN).OR.
31794 $ -PHEP(3,ITGN+2) .GT.-PHEP(3,ITGN).OR.IERROR.NE.0) THEN
31795 IF (IERROR.GT.0) THEN
31797 $ ' THIS ERROR OCCURED DURING A SECONDARY SCATTER AND WAS',
31798 $ ' CAUGHT BY HWHSCT, SO EVENT IS NOT KILLED AFTER ALL'
31807 C---RELABEL OUTGOING REMNANTS AS INCOMING HADRONS
31812 C---SAVE THE CURRENT PROCESS TYPE, AND SWITCH TO
31813 C QCD SCATTERING TO AVOID PROBLEMS WITH THE
31820 C---PUT THE LABELS BACK
31823 C---IF THERE WERE ANY PROBLEMS, STOP GENERATING HARD SCATTERS
31824 IF (IERROR.NE.0) THEN
31825 IF (IERROR.GT.0) THEN
31827 $ ' THIS ERROR OCCURED DURING A SECONDARY SCATTER AND WAS',
31828 $ ' CAUGHT BY HWHSCT, SO EVENT IS NOT KILLED AFTER ALL'
31837 C---UNDO THE LORENTZ BOOST
31838 DO 200 IHEP=IBMN,NHEP
31839 CALL HWUROB(RBOOST,PHEP(1,IHEP),PHEP(1,IHEP))
31840 CALL HWULOB(PBOOST,PHEP(1,IHEP),PHEP(1,IHEP))
31842 C---FIND THE NEW BEAM AND TARGET REMNANTS
31845 CALL HWHREM(IBMN,ITGN)
31846 IF (IERROR.NE.0) RETURN
31847 C---CONNECT UP THE COLOUR/FLAVOUR LINES OF THE TWO SCATTERS
31848 IDHW(IBMN)=IDHW(IBM)
31849 IDHEP(IBMN)=IDHEP(IBM)
31850 IF (COL(IDHW(IBM))) THEN
31851 JMOHEP(2,JDAHEP(2,IBMN))=JMOHEP(2,IBM)
31852 JDAHEP(2,JMOHEP(2,IBM))=JDAHEP(2,IBMN)
31853 JDAHEP(2,IBMN)=JDAHEP(2,IBM)
31854 JMOHEP(2,JDAHEP(2,IBM))=IBMN
31856 JDAHEP(2,JMOHEP(2,IBMN))=JDAHEP(2,IBM)
31857 JMOHEP(2,JDAHEP(2,IBM))=JMOHEP(2,IBMN)
31858 JMOHEP(2,IBMN)=JMOHEP(2,IBM)
31859 JDAHEP(2,JMOHEP(2,IBM))=IBMN
31864 IDHW(ITGN)=IDHW(ITG)
31865 IDHEP(ITGN)=IDHEP(ITG)
31866 IF (COL(IDHW(ITG))) THEN
31867 JMOHEP(2,JDAHEP(2,ITGN))=JMOHEP(2,ITG)
31868 JDAHEP(2,JMOHEP(2,ITG))=JDAHEP(2,ITGN)
31869 JDAHEP(2,ITGN)=JDAHEP(2,ITG)
31870 JMOHEP(2,JDAHEP(2,ITG))=ITGN
31872 JDAHEP(2,JMOHEP(2,ITGN))=JDAHEP(2,ITG)
31873 JMOHEP(2,JDAHEP(2,ITG))=JMOHEP(2,ITGN)
31874 JMOHEP(2,ITGN)=JMOHEP(2,ITG)
31875 JDAHEP(2,JMOHEP(2,ITG))=ITGN
31880 C---LOOK FOR COLOUR SINGLET GLUONS (A RARE BUT ANNOYING SPECIAL CASE)
31882 IF (IDHW(IHEP).EQ.13.AND.JMOHEP(2,IHEP).EQ.IHEP)
31883 $ CALL HWWARN('HWHSCT',120,*999)
31886 IF (TMPFLG) NHARD=NHARD+1
31889 *CMZ :- -17/03/04 14.37.43 by Mike Seymour
31890 *-- Author : Mike Seymour
31891 C-----------------------------------------------------------------------
31892 SUBROUTINE HWHSCU(WGT,PTJIM)
31893 C-----------------------------------------------------------------------
31894 C SWAP THE HARD PROCESS GENERATION PARAMETERS,
31895 C CALL HWHQCD, AND SWAP BACK
31896 C WGT IS THE OUTPUT EVENT WEIGHT
31897 C-----------------------------------------------------------------------
31898 INCLUDE 'HERWIG65.INC'
31899 DOUBLE PRECISION WGT,PTJIM,XMIN,XMAX,XPOW,
31900 $ TMPXMN,TMPXMX,TMPXPW,TMPWGT
31902 COMMON/HWRPIN/XMIN,XMAX,XPOW,FIRST
31903 C---STORE THE CURRENT VALUES
31908 C---REPLACE BY NEW ONES
31910 XMAX=2*SQRT(HALF*(EBEAM1*EBEAM2+PBEAM1*PBEAM2))
31912 C---AND ENSURE THAT HWRPOW GETS REINITIALIZED
31914 C---GENERATE A PHASE SPACE POINT
31916 IF (IERROR.NE.0.OR.EVWGT.LT.0) THEN
31921 C---PUT THE OLD VALUES BACK
31926 C---AND AGAIN ENSURE THAT HWRPOW GETS REINITIALIZED
31928 C---INCLUDE GAMWT HERE
31932 *CMZ :- -20/09/95 14.59.15 by Mike Seymour
31933 *-- Author : Mike Seymour
31934 C-----------------------------------------------------------------------
31936 C PARTON-PARTON SCATTERING VIA COLOUR SINGLET
31937 C MEAN EVWGT = SIGMA IN NB
31938 C TREATS ALL PARTONS ON EQUAL FOOTING WITH HWHSNM(ID1,ID2,S,T)
31939 C PROVIDING THE MATRIX ELEMENT SQUARED FOR PARTON TYPES ID1 AND ID2
31940 C-----------------------------------------------------------------------
31941 INCLUDE 'HERWIG65.INC'
31943 DOUBLE PRECISION HWRGEN,HWRUNI,HWHSNM,EPS,RCS,ET,EJ,KK,KK2,
31944 & YJ1INF,YJ1SUP,Z1,YJ2INF,YJ2SUP,Z2,FACT,S,T,U,HCS
31946 PARAMETER (EPS=1.D-9)
31954 IF (KK.GE.ONE) RETURN
31955 YJ1INF=MAX( YJMIN , LOG((1.-SQRT(1.-KK2))/KK) )
31956 YJ1SUP=MIN( YJMAX , LOG((1.+SQRT(1.-KK2))/KK) )
31957 IF (YJ1INF.GE.YJ1SUP) RETURN
31958 Z1=EXP(HWRUNI(1,YJ1INF,YJ1SUP))
31959 YJ2INF=MAX( YJMIN , -LOG(2./KK-1./Z1) )
31960 YJ2SUP=MIN( YJMAX , LOG(2./KK-Z1) )
31961 IF (YJ2INF.GE.YJ2SUP) RETURN
31962 Z2=EXP(HWRUNI(2,YJ2INF,YJ2SUP))
31963 XX(1)=0.5*(Z1+Z2)*KK
31964 IF (XX(1).GE.ONE) RETURN
31965 XX(2)=XX(1)/(Z1*Z2)
31966 IF (XX(2).GE.ONE) RETURN
31967 COSTH=(Z1-Z2)/(Z1+Z2)
31968 S=XX(1)*XX(2)*PHEP(5,3)**2
31969 T=-0.5*S*(1.-COSTH)
31971 C---SET EMSCA TO HARD PROCESS SCALE (APPROX ET-JET)
31972 EMSCA=SQRT(2.*S*T*U/(S*S+T*T+U*U))
31973 FACT=GEV2NB*0.5*ET*EJ*(YJ1SUP-YJ1INF)*(YJ2SUP-YJ2INF)
31975 CALL HWSGEN(.FALSE.)
31980 IF (DISF(ID1,1).LT.EPS) GOTO 20
31982 IF (DISF(ID2,1).LT.EPS) GOTO 10
31983 HCS=HCS+FACT*DISF(ID1,1)*DISF(ID2,2)*HWHSNM(ID1,ID2,S,T)
31984 IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3412,90,*30)
31993 CALL HWETWO(.TRUE.,.TRUE.)
31996 *CMZ :- -20/09/95 15.28.53 by Mike Seymour
31997 *-- Author : Mike Seymour
31998 C-----------------------------------------------------------------------
31999 FUNCTION HWHSNM(ID1,ID2,S,T)
32000 C MATRIX ELEMENT SQUARED FOR COLOUR-SINGLET PARTON-PARTON SCATTERING
32001 C INCLUDES SPIN AND COLOUR AVERAGES AND SUMS.
32002 C FOR PHOTON EXCHANGE, INTERFERENCE WITH U-CHANNEL CONTRIBUTION IS
32003 C INCLUDED FOR IDENTICAL QUARKS AND LIKEWISE S-CHANNEL CONTRIBUTION
32004 C FOR IDENTICAL QUARK-ANTIQUARK PAIRS.
32005 C-----------------------------------------------------------------------
32006 INCLUDE 'HERWIG65.INC'
32007 DOUBLE PRECISION HWHSNM,HWUAEM,HWUALF,S,T,ASQ,AINU,AINS,Y,SOLD,
32008 $ TOLD,QQ(13,13),ZETA3
32011 C---ZETA3=RIEMANN ZETA FUNCTION(3)
32012 PARAMETER (ZETA3=1.202056903159594D0)
32013 C---PHOTON=.TRUE. FOR PHOTON EXCHANGE, .FALSE. FOR MUELLER-TANG
32014 PHOTON=MOD(IPROC,100).GE.50
32015 DATA ASQ,AINU,AINS,SOLD,TOLD,QQ/5*0,169*-1/
32016 C---QQ CACHES THE KINEMATIC-INDEPENDENT FACTORS, TO MAKE IT RUN FASTER
32017 C (BEARING IN MIND THAT THIS ROUTINE IS CALLED 169 TIMES PER EVENT)
32018 IF (QQ(ID1,ID2).LT.ZERO) THEN
32020 IF (ID1.EQ.13.OR.ID2.EQ.13) THEN
32023 QQ(ID1,ID2)=(QFCH(MOD(ID1-1,6)+1)*QFCH(MOD(ID2-1,6)+1))**2
32027 IF (ID1.EQ.13.AND.ID2.EQ.13) THEN
32028 QQ(ID1,ID2)=CAFAC**4
32029 ELSEIF (ID1.EQ.13.OR.ID2.EQ.13) THEN
32030 QQ(ID1,ID2)=(CAFAC*CFFAC)**2
32032 QQ(ID1,ID2)=CFFAC**4
32034 QQ(ID1,ID2)=QQ(ID1,ID2)*
32035 $ PIFAC**3/(4*(3.5*ASFIXD*CAFAC*ZETA3)**3)
32039 C---THE KINEMATIC-DEPENDENT PART IS ALSO CACHED
32040 IF (S.NE.SOLD.OR.T.NE.TOLD) THEN
32043 ASQ=2*(S**2+(S+T)**2)/T**2*AINS
32044 AINU=-4*S/T*AINS/NCOLO
32045 AINS=4*AINS/NCOLO-AINU
32048 ASQ=HWUALF(1,EMSCA)**4*(S/T)**2*EXP(2*OMEGA0*Y)/Y**3
32053 C---THE FINAL ANSWER IS JUST THEIR PRODUCT
32054 IF (ID1.EQ.ID2) THEN
32055 HWHSNM=QQ(ID1,ID2)*(ASQ+AINU)
32056 ELSEIF (ABS(ID1-ID2).EQ.6) THEN
32057 HWHSNM=QQ(ID1,ID2)*(ASQ+AINS)
32059 HWHSNM=QQ(ID1,ID2)*ASQ
32063 *CMZ :- -01/10/01 19.41.18 by Peter Richardson
32064 *-- Author : Peter Richardson
32065 C-----------------------------------------------------------------------
32067 C-----------------------------------------------------------------------
32068 C Calculates the spin correlations for the hard process
32069 C-----------------------------------------------------------------------
32070 INCLUDE 'HERWIG65.INC'
32072 PARAMETER(NDIAHD=10)
32073 DOUBLE COMPLEX ZI,S,D,ME(2,2,2,2,NCFMAX),MED(2,2,2,2),F3(2,2,8),
32074 & F4(2,2,8),F3M(2,2,8),F4M(2,2,8),FTP(2,2,8,8),FTM(2,2,8,8),
32075 & FUP(2,2,8,8),FUM(2,2,8,8),FST(2,2,8)
32076 DOUBLE PRECISION P(5,4),A(2,NDIAHD),B(2,NDIAHD),XMASS,PLAB,
32077 & PRW,PCM,MS(NDIAHD),MWD(NDIAHD),MR(NDIAHD),HWULDO,EE,
32078 & PREF(5),EPS,N(3),HWVDOT,PP,PRE,SH,TH,UH,PM(5,4),DIJ(2,2),
32079 & MA(4),MA2(4),PTMP(5),WGT,WGTB(NCFMAX),WGTC,HWRGEN
32080 INTEGER ICM,IHEP,IST,JHEP,KHEP,ID,LHEP,MHEP,IK,IL,IM,IJ,L1,L2,I,J,
32081 & IDP(4+NDIAHD),DRTYPE(NDIAHD),NDIA,P1,P2,P3,P4,IFLOW(NDIAHD),
32082 & ID1,ID2,III,JJJ,KKK,O(2),LLL,MMM
32083 DOUBLE PRECISION SW,CW,TW,E,G,RT,ORT,MW,MZ,GS,AFN(2,12,2,4),
32084 & AFG(2,6,2),AFC(2,12,2,2),OIJ(2,4,2),OIJP(2,2,2),OIJPP(2,4,4),
32085 & HNN(2,3,4,4),HCC(2,3,2,2),HNC(2,4,2),HFF(2,4,12),HWW(2),
32086 & HZZ(2),ZAB(12,2,2),HHB(2,3),HWUAEM
32087 COMMON /HWSPNC/ SW,CW,TW,E,G,RT,ORT,MW,MZ,GS,AFN,AFG,AFC,OIJ,OIJP,
32088 & OIJPP,HNN,HCC,HNC,HFF,HWW,HZZ,ZAB,HHB
32091 PARAMETER(ZI=(0.0D0,1.0D0))
32092 COMMON/HWHEWS/S(8,8,2),D(8,8)
32093 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
32094 & MA2,SH,TH,UH,IDP,DRTYPE
32095 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
32096 DATA PREF/1.0D0,0.0D0,0.0D0,1.0D0,0.0D0/
32097 DATA DIJ/1.0D0,0.0D0,0.0D0,1.0D0/
32100 PARAMETER(EPS=1D-20)
32101 EXTERNAL HWULDO,HWVDOT,HWRGEN
32103 IF(IERROR.NE.0) RETURN
32108 C--search the event record for the hard process
32111 IF(IST.EQ.110.OR.IST.EQ.120) THEN
32116 C--now decide whether or not to perform spin correlation
32117 2 KHEP = JDAHEP(1,ICM)
32119 JHEP = JDAHEP(2,ICM)
32121 IF(JHEP-KHEP+1.NE.2) CALL HWWARN('HWHSPN',500,*999)
32123 DO 3 IHEP=KHEP,JHEP
32125 IF(RSPIN(ID).EQ.0.5D0) SPIN=.TRUE.
32127 IF(.NOT.SPIN) RETURN
32128 IF((RSPIN(IDHW(KHEP)).EQ.ONE.AND.RSPIN(IDHW(JHEP)).EQ.ZERO).OR.
32129 & (RSPIN(IDHW(KHEP)).EQ.ZERO.AND.RSPIN(IDHW(JHEP)).EQ.ONE)) RETURN
32130 LHEP = JMOHEP(1,ICM)
32131 MHEP = JMOHEP(2,ICM)
32132 C--now identify the hard process
32133 C--SM processes first
32134 C--fermion-antifermion production in lepton-lepton collisions
32135 C--or via Z/gamma in hadron-hadron collisions
32136 IF(IPRO.EQ.1.OR.IPRO.EQ.13) THEN
32137 C--only need spin correlations for top and tau production
32138 IF((IK.EQ. 6.AND.IJ.EQ. 12).OR.(IK.EQ. 12.AND.IJ.EQ.6 ).OR.
32139 & (IK.EQ.125.AND.IJ.EQ.131).OR.(IK.EQ.131.AND.IJ.EQ.125)) THEN
32140 C--check fermion first and change order if not
32141 IF(IDHEP(LHEP).LT.0) THEN
32146 C--Id's of the incoming and outgoing fermions
32148 ID1 = IL-6*INT((IL-1)/6)+10*INT((IL-1)/120)
32149 ID2 = IK-6*INT((IK-1)/6)+10*INT((IK-1)/120)
32150 C--couplings for the diagrams
32151 C--first the photon exchange
32152 A(1,1) = -QFCH(ID1)
32153 A(2,1) = -QFCH(ID1)
32154 B(1,1) = -QFCH(ID2)
32155 B(2,1) = -QFCH(ID2)
32158 C--then the Z exchange
32159 A(1,2) = -RFCH(ID1)
32160 A(2,2) = -LFCH(ID1)
32161 B(1,2) = -RFCH(ID2)
32162 B(2,2) = -LFCH(ID2)
32165 C--setup the colour flow
32168 SPNCFC(1,1,1) = ONE
32174 C--fermion-antifermion via s-channel W in hadron-hadron
32175 ELSEIF(IPRO.EQ.14) THEN
32176 IF(IK.EQ. 6.OR.IK.EQ. 12.OR.IJ.EQ. 6.OR.IJ.EQ. 12.OR.
32177 & IK.EQ.125.OR.IJ.EQ.131.OR.IK.EQ.131.OR.IJ.EQ.125) THEN
32178 C--check fermion first and reorder if not
32179 IF(IDHEP(LHEP).LT.0) THEN
32184 C--couplings for the diagram
32193 SPNCFC(1,1,1) = ONE
32198 C--top quark production via QCD
32199 ELSEIF(IPRO.EQ.15.OR.IPRO.EQ.17) THEN
32200 IF((IK.EQ.6.AND.IJ.EQ.12).OR.(IK.EQ.12.AND.IJ.EQ.6)) THEN
32201 C--check if the outgoing fermion is first and change order if not
32202 IF(IDHEP(KHEP).LT.0) THEN
32207 C--quark-quark to t tbar
32208 IF(IDHW(LHEP).LE.12.AND.IDHW(MHEP).LE.12) THEN
32209 C--first check the incoming fermion is first and change order if not
32210 IF(IDHEP(LHEP).LT.0) THEN
32216 C--couplings for the diagram
32224 C--setup the colour flow
32226 SPNCFC(1,1,1) = TWO/9.0D0
32228 C--gluon-gluon to t tbar
32229 ELSEIF(IDHW(LHEP).EQ.13.AND.IDHW(MHEP).EQ.13) THEN
32230 C--setup the diagrams
32240 C--setup the colour flow
32246 SPNCFC(1,1,1) = 0.25D0/THREE
32247 SPNCFC(2,2,1) = SPNCFC(1,1,1)
32248 SPNCFC(1,2,1) = ONE/THREE/32.0D0
32249 SPNCFC(2,1,1) = ONE/THREE/32.0D0
32250 C--incorrect initial state
32252 CALL HWWARN('HWHSPN',501,*999)
32254 C--don't need spin correlations haven't produced top
32258 C--single top quark production in hadron collisions
32259 ELSEIF(IPRO.EQ.20) THEN
32260 C--change order if b quark not first and identify incoming particles
32261 IF(ABS(IDHEP(LHEP)).NE.5) THEN
32268 C--change order if t quark not first
32269 IF(ABS(IDHEP(KHEP)).NE.6) THEN
32274 C--identify diagram type
32276 IF(IL.GT.0.AND.IM.GT.0) THEN
32278 C--fermion antifermion
32279 ELSEIF(IL.GT.0.AND.IM.LT.0) THEN
32281 C--antifermion fermion
32282 ELSEIF(IL.LT.0.AND.IM.GT.0) THEN
32284 C--antifermion antifermion
32285 ELSEIF(IL.LT.0.AND.IM.LT.0) THEN
32287 C--incorrect initial state
32289 CALL HWWARN('HWHSPN',502,*999)
32296 C--virtual particle etc
32300 SPNCFC(1,1,1) = ONE
32302 C--SUSY particle production
32303 ELSEIF(IPRO.EQ.7.OR.IPRO.EQ.30) THEN
32304 IF(MOD(IPROC,10000).GT.3030) RETURN
32305 C--fermion-antifermion to neutralino neutralino
32306 IF(IK.GE.450.AND.IK.LE.453.AND.IJ.GE.450.AND.IJ.LE.453) THEN
32307 C--first check the fermion is first and change order if not
32308 IF(IDHEP(LHEP).LT.0) THEN
32315 C--couplings of the various diagrams
32318 ID = IL-6*INT((IL-1)/6)+10*INT((IL-1)/120)
32319 C--couplings for the Z exchange diagram
32322 B(2,1) = HALF*(-ZMIXSS(L1,3)*ZMIXSS(L2,3)
32323 & +ZMIXSS(L1,4)*ZMIXSS(L2,4))/SW/CW
32325 B(2,1) = B(2,1)*ZSGNSS(L1)*ZSGNSS(L2)
32328 C--couplings for the t-channel diagrams
32330 A(2,2) =-RT*SLFCH(ID,L1)
32331 B(1,2) =-RT*SLFCH(ID,L2)
32333 IDP(6) = IL-6*INT((IL-1)/6)+24*INT((IL-1)/120)+400
32334 A(1,3) =-RT*SRFCH(ID,L1)*ZSGNSS(L1)
32337 B(2,3) =-RT*SRFCH(ID,L2)*ZSGNSS(L2)
32338 IDP(7) = IL-6*INT((IL-1)/6)+24*INT((IL-1)/120)+412
32341 C--couplings for the u-channel diagrams
32343 A(2,4) =-RT*SLFCH(ID,L2)*ZSGNSS(L2)
32344 B(1,4) =-RT*SLFCH(ID,L1)*ZSGNSS(L1)
32347 A(1,5) =-RT*SRFCH(ID,L2)
32350 B(2,5) =-RT*SRFCH(ID,L1)
32355 C--setup the colour flow
32357 SPNCFC(1,1,1) = ONE
32363 C--chargino pair production
32364 ELSEIF(IK.GE.454.AND.IK.LE.457.AND.IJ.GE.454.AND.IJ.LE.457) THEN
32365 C--first check the fermion is first and change order if not
32366 IF(IDHEP(LHEP).LT.0) THEN
32373 C--couplings of the various diagrams
32374 L1 = IK-453-2*INT((IK-454)/2)
32375 L2 = IJ-453-2*INT((IJ-454)/2)
32376 ID = IL-6*INT((IL-1)/6)+10*INT((IL-1)/120)
32377 C--couplings for the s-channel photon exchange
32380 B(1,1) = -DIJ(L1,L2)
32381 B(2,1) = -DIJ(L1,L2)
32384 C--couplings for the s-channel Z exchange
32387 B(1,2) =(-WMXUSS(L1,1)*WMXUSS(L2,1)
32388 & -HALF*WMXUSS(L1,2)*WMXUSS(L2,2)+DIJ(L1,L2)*SWEIN)/CW/SW
32389 B(2,2) =WSGNSS(L1)*WSGNSS(L2)*(-WMXVSS(L1,1)*WMXVSS(L2,1)
32390 & -HALF*WMXVSS(L1,2)*WMXVSS(L2,2)+DIJ(L1,L2)*SWEIN)/CW/SW
32393 C--couplings for the t-channel diagram
32394 IF(IDHEP(KHEP).GT.0.AND.MOD(IL,2).EQ.0) THEN
32396 A(2,3) =-WMXUSS(L1,1)/SW
32397 B(1,3) =-WMXUSS(L2,1)/SW
32400 ELSEIF(IDHEP(KHEP).LT.0.AND.MOD(IL,2).NE.0) THEN
32401 A(1,3) =-WMXVSS(L1,1)*WSGNSS(L1)/SW
32404 B(2,3) =-WMXVSS(L2,1)*WSGNSS(L2)/SW
32406 ELSEIF(IDHEP(KHEP).GT.0.AND.MOD(IL,2).NE.0) THEN
32408 A(2,3) =-WMXVSS(L2,1)*WSGNSS(L2)/SW
32409 B(1,3) =-WMXVSS(L1,1)*WSGNSS(L1)/SW
32413 A(1,3) =-WMXUSS(L2,1)/SW
32416 B(2,3) =-WMXUSS(L1,1)/SW
32419 IDP(7) = IL-6*INT((IL-1)/6)+24*INT((IL-1)/120)+400
32422 C--setup the colour flow
32424 SPNCFC(1,1,1) = ONE
32428 C--chargino neutralino production
32429 ELSEIF((IK.GE.454.AND.IK.LE.457.AND.IJ.GE.450.AND.IJ.LE.453).OR.
32430 & (IJ.GE.454.AND.IJ.LE.457.AND.IK.GE.450.AND.IK.LE.453)) THEN
32431 C--first check the fermion is first and change order if not
32432 IF(IDHEP(LHEP).LT.0) THEN
32439 C--change order of outgoing particles if negative chargino
32440 IF(IDHEP(KHEP).LT.0) THEN
32445 L1 = IK-453-2*INT((IK-454)/2)
32449 IF(IDHEP(JHEP).GT.0) THEN
32454 L1 = IJ-453-2*INT((IJ-454)/2)
32457 C--first the W exchange diagram
32460 B(1,1) =( ORT*ZMXNSS(L2,3)*WMXUSS(L1,2)
32461 & +ZMXNSS(L2,2)*WMXUSS(L1,1))/SW
32462 B(2,1) =WSGNSS(L1)*ZSGNSS(L2)*(-ORT*ZMXNSS(L2,4)*WMXVSS(L1,2)
32463 & +ZMXNSS(L2,2)*WMXVSS(L1,1))/SW
32466 C--intermediate particles for the t and u channel diagrams
32471 IF(MOD(IL,2).EQ.0) THEN
32473 A(2,2) =-WMXUSS(L1,1)/SW
32474 B(1,2) =-RT*SLFCH(IM-6,L2)
32478 A(2,3) =-RT*ZSGNSS(L2)*SLFCH(IL,L2)
32479 B(1,3) =-WSGNSS(L1)*WMXVSS(L1,1)/SW
32484 A(2,2) =-WSGNSS(L1)*WMXVSS(L1,1)/SW
32485 B(1,2) =-RT*ZSGNSS(L2)*SLFCH(IM-6,L2)
32489 A(2,3) =-RT*SLFCH(IL,L2)
32490 B(1,3) =-WMXUSS(L1,1)/SW
32494 C--setup the colour flow
32497 SPNCFC(1,1,1) = ONE
32501 C--neutralino gluino production
32502 ELSEIF((IK.EQ.449.AND.IJ.GE.450.AND.IJ.LE.453).OR.
32503 & (IJ.EQ.449.AND.IK.GE.450.AND.IK.LE.453)) THEN
32504 C--first check the fermion is first and change order if not
32505 IF(IDHEP(LHEP).LT.0) THEN
32510 C--check neutralino first and change order if not
32520 C--coupling for the diagrams
32521 C--first t-channel squark exchange
32524 A(2,1) =-RT*SLFCH(IL,L1)
32529 A(1,2) =-RT*ZSGNSS(L1)*SRFCH(IL,L1)
32534 C--then u-channel s squark exchange
32538 B(1,3) =-RT*ZSGNSS(L1)*SLFCH(IL,L1)
32545 B(2,4) =-RT*SRFCH(IL,L1)
32547 C--colour flow information
32554 SPNCFC(1,1,1) = ONE
32555 C--chargino gluino production
32556 ELSEIF((IK.GE.454.AND.IK.LE.457.AND.IJ.EQ.449).OR.
32557 & (IJ.GE.454.AND.IJ.LE.457.AND.IK.EQ.449)) THEN
32558 C--first check the fermion is first and change order if not
32559 IF(IDHEP(LHEP).LT.0) THEN
32564 C--check chargino first and change order if not
32566 L1 = IJ-453-2*INT((IJ-454)/2)
32571 L1 = IK-453-2*INT((IK-454)/2)
32577 IF(MOD(IL,2).EQ.0) THEN
32579 A(2,1) =-WMXUSS(L1,1)/SW
32585 B(1,2) =-WSGNSS(L1)*WMXVSS(L1,1)/SW
32590 A(2,1) =-WSGNSS(L1)*WMXVSS(L1,1)/SW
32596 B(1,2) =-WMXUSS(L1,1)/SW
32600 C--setup the colour flow
32603 SPNCFC(1,1,1) = ONE
32606 C--quark quark to gluino gluino
32607 ELSEIF(IJ.EQ.449.AND.IK.EQ.449.AND.
32608 & IDHW(LHEP).LE.12.AND.IDHW(MHEP).LE.12) THEN
32609 C--change order if antiquark first
32610 IF(IDHEP(LHEP).LT.0) THEN
32616 C--couplings of the various diagrams
32638 C--intermediate particles
32645 C--types of diagram
32653 C--setup the colour flow
32655 SPNCFC(1,1,1) = 8.0D0/27.0D0
32656 SPNCFC(2,2,1) = 8.0D0/27.0D0
32657 SPNCFC(1,2,1) =-ONE/27.0D0
32658 SPNCFC(2,1,1) =-ONE/27.0D0
32665 C--gluon gluon to gluino gluino
32666 ELSEIF(IDHW(LHEP).EQ.13.AND.IDHW(MHEP).EQ.13.AND.IJ.EQ.449
32667 & .AND.IK.EQ.449) THEN
32668 C--setup the diagrams
32678 C--setup the colour flow
32684 SPNCFC(1,1,1) = 9.0D0/16.0D0
32685 SPNCFC(2,2,1) = SPNCFC(1,1,1)
32686 SPNCFC(1,2,1) =-9.0D0/32.0D0
32687 SPNCFC(2,1,1) =-9.0D0/32.0D0
32688 C--neutralino squark production
32689 ELSEIF( (IK.GE.450.AND.IK.LE.453.AND.
32690 & ((IJ.GE.401.AND.IJ.LE.406).OR.(IJ.GE.413.AND.IJ.LE.418)))
32691 & .OR.(IJ.GE.450.AND.IJ.LE.453.AND.
32692 & ((IK.GE.401.AND.IK.LE.406).OR.(IK.GE.413.AND.IK.LE.418))))
32694 C--change order if gluon first
32695 IF(IDHW(LHEP).EQ.13) THEN
32700 C--change order in squark first
32710 C--left handed (lighter) squark
32712 A(1,1) =-RT*SRFCH(IL,L1)*QMIXSS(IL,2,1)
32713 A(2,1) =-RT*ZSGNSS(L1)*SLFCH(IL,L1)*QMIXSS(IL,1,1)
32714 C--right handed (heavier) squark
32715 ELSEIF(IJ.GT.412) THEN
32716 A(1,1) =-RT*SRFCH(IL,L1)*QMIXSS(IL,2,2)
32717 A(2,1) =-RT*ZSGNSS(L1)*SLFCH(IL,L1)*QMIXSS(IL,1,2)
32723 C--colour flow info
32728 SPNCFC(1,1,1) = HALF/THREE
32731 C--neutralino antisquark production
32732 ELSEIF( (IK.GE.450.AND.IK.LE.453.AND.
32733 & ((IJ.GE.407.AND.IJ.LE.412).OR.(IJ.GE.419.AND.IJ.LE.424)))
32734 & .OR.(IJ.GE.450.AND.IJ.LE.453.AND.
32735 & ((IK.GE.407.AND.IK.LE.412).OR.(IK.GE.419.AND.IK.LE.424))))
32737 C--change order if gluon first
32738 IF(IDHW(LHEP).EQ.13) THEN
32743 C--change order in squark first
32753 C--left handed (lighter) squark
32755 A(1,1) =-RT*ZSGNSS(L1)*SLFCH(IL,L1)*QMIXSS(IL,1,1)
32756 A(2,1) =-RT*SRFCH(IL,L1)*QMIXSS(IL,2,1)
32757 C--right handed (heavier) squark
32758 ELSEIF(IJ.GT.412) THEN
32759 A(1,1) =-RT*ZSGNSS(L1)*SLFCH(IL,L1)*QMIXSS(IL,1,2)
32760 A(2,1) =-RT*SRFCH(IL,L1)*QMIXSS(IL,2,2)
32766 C--colour flow info
32771 SPNCFC(1,1,1) = HALF/THREE
32775 ELSEIF((IK.GE.454.AND.IK.LE.457.AND.
32776 & ((IJ.GE.401.AND.IJ.LE.406).OR.(IJ.GE.413.AND.IJ.LE.418)))
32777 & .OR.(IJ.GE.454.AND.IJ.LE.457.AND.
32778 & ((IK.GE.401.AND.IK.LE.406).OR.(IK.GE.413.AND.IK.LE.418))))
32780 C--change order if gluon first
32781 IF(IDHW(LHEP).EQ.13) THEN
32786 C--change order if squark first
32795 L1 = IK-453-2*INT((IK-454)/2)
32796 C--left handed (lighter) squark
32799 IF(MOD(IL,2).EQ.0) THEN
32800 A(2,1) = -WMXUSS(L1,1)*QMIXSS(IL-1,1,1)/SW
32802 A(2,1) = -WSGNSS(L1)*WMXVSS(L1,1)*QMIXSS(IL+1,1,1)/SW
32804 C--right handed (heavier) squark
32805 ELSEIF(IJ.GT.412) THEN
32806 IF(MOD(IL,2).EQ.0) THEN
32807 A(2,1) = -WMXUSS(L1,1)*QMIXSS(IL-1,1,2)/SW
32809 A(2,1) = -WSGNSS(L1)*WMXVSS(L1,1)*QMIXSS(IL+1,1,2)/SW
32816 C--colour flow info
32821 SPNCFC(1,1,1) = HALF/THREE
32824 C--chargino antisquark
32825 ELSEIF((IK.GE.454.AND.IK.LE.457.AND.
32826 & ((IJ.GE.407.AND.IJ.LE.412).OR.(IJ.GE.419.AND.IJ.LE.424)))
32827 & .OR.(IJ.GE.454.AND.IJ.LE.457.AND.
32828 & ((IK.GE.407.AND.IK.LE.412).OR.(IK.GE.419.AND.IK.LE.424))))
32830 C--change order if gluon first
32831 IF(IDHW(LHEP).EQ.13) THEN
32836 C--change order in squark first
32845 L1 = IK-453-2*INT((IK-454)/2)
32846 C--left handed (lighter) squark
32849 IF(MOD(IL,2).EQ.0) THEN
32850 A(1,1) = -WMXUSS(L1,1)*QMIXSS(IL-1,1,1)/SW
32852 A(1,1) = -WSGNSS(L1)*WMXVSS(L1,1)*QMIXSS(IL+1,1,1)/SW
32854 C--right handed (heavier) squark
32855 ELSEIF(IJ.GT.412) THEN
32856 IF(MOD(IL,2).EQ.0) THEN
32857 A(1,1) = -WMXUSS(L1,1)*QMIXSS(IL-1,1,2)/SW
32859 A(1,1) = -WMXVSS(L1,1)*QMIXSS(IL+1,1,2)/SW
32866 C--colour flow info
32871 SPNCFC(1,1,1) = ONE
32874 C--squark gluino production
32875 ELSEIF((IK.EQ.449.AND.((IJ.GE.401.AND.IJ.LE.406)
32876 & .OR.(IJ.GE.413.AND.IJ.LE.418)))
32877 & .OR.(IJ.GE.449.AND.((IK.GE.401.AND.IK.LE.406)
32878 & .OR.(IK.GE.413.AND.IK.LE.418)))) THEN
32879 C--change order if gluon first
32880 IF(IDHW(LHEP).EQ.13) THEN
32886 C--change order in squark first
32893 ID = INT((IJ-401)/12)+1
32920 SPNCFC(1,1,1) = 2.0D0/9.0D0
32921 SPNCFC(2,2,1) = 2.0D0/9.0D0
32922 SPNCFC(1,2,1) = -0.25D0/9.0D0
32923 SPNCFC(2,1,1) = -0.25D0/9.0D0
32924 C--antisquark gluino production
32925 ELSEIF((IK.GE.449..AND.((IJ.GE.407.AND.IJ.LE.412)
32926 & .OR.(IJ.GE.419.AND.IJ.LE.424)))
32927 & .OR.(IJ.GE.449.AND.((IK.GE.407.AND.IK.LE.412)
32928 & .OR.(IK.GE.419.AND.IK.LE.424)))) THEN
32929 C--change order if gluon first
32930 IF(IDHW(LHEP).EQ.13) THEN
32936 C--change order in squark first
32943 ID = INT((IJ-401)/12)+1
32970 SPNCFC(1,1,1) = 2.0D0/9.0D0
32971 SPNCFC(2,2,1) = 2.0D0/9.0D0
32972 SPNCFC(1,2,1) = -0.25D0/9.0D0
32973 SPNCFC(2,1,1) = -0.25D0/9.0D0
32974 C--unrecognised SUSY process
32976 CALL HWWARN('HWHSPN',503,*999)
32979 ELSEIF(IPRO.EQ.8) THEN
32980 C--neutralino antineutrino production
32981 IF(IK.GE.450.AND.IK.LE.453.AND.
32982 & IJ.GE.127.AND.IJ.LE.132.AND.MOD(IJ,2).EQ.0) THEN
32983 C--ensure lepton first
32984 IF(IDHEP(LHEP).LT.0) THEN
32991 JJJ = (IDHW(LHEP)-119)/2
32992 KKK = (IDHW(MHEP)-125)/2
32996 IDP(5+I) = 423+2*JJJ+(I-1)*12
32997 11 IDP(7+I) = 423+2*KKK+(I-1)*12
32998 C--types of diagram
33006 A(2,1) = -LAMDA1(III,JJJ,KKK)
33009 B(2,I+1) = -LMIXSS(2*JJJ-1,1,I)*LAMDA1(III,JJJ,KKK)
33011 12 A(2,I+3) = -LMIXSS(2*KKK-1,2,I)*LAMDA1(III,JJJ,KKK)
33014 B(J,1) = AFN(O(J),2*III+6,1,L1)
33016 A(J,I+1) = AFN(O(J),2*JJJ+5,I,L1)
33017 13 B(J,I+3) = AFN( J ,2*KKK+5,I,L1)
33023 SPNCFC(1,1,1) = ONE
33024 C--neutralino neutrino production
33025 ELSEIF(IK.GE.450.AND.IK.LE.453.AND.
33026 & IJ.GE.121.AND.IJ.LE.126.AND.MOD(IJ,2).EQ.0) THEN
33027 C--ensure lepton first
33028 IF(IDHEP(LHEP).LT.0) THEN
33035 JJJ = (IDHW(MHEP)-125)/2
33036 KKK = (IDHW(LHEP)-119)/2
33040 IDP(5+I) = 423+2*JJJ+(I-1)*12
33041 15 IDP(7+I) = 423+2*KKK+(I-1)*12
33042 C--types of diagram
33049 A(1,1) = -LAMDA1(III,JJJ,KKK)
33052 B(1,I+1) = -LMIXSS(2*JJJ-1,1,I)*LAMDA1(III,JJJ,KKK)
33054 A(1,I+3) = -LMIXSS(2*KKK-1,2,I)*LAMDA1(III,JJJ,KKK)
33058 B(J,1) = AFN( J ,2*III+6,1,L1)
33060 A(J,I+1) = AFN( J ,2*JJJ+5,I,L1)
33061 17 B(J,I+3) = AFN(O(J),2*KKK+5,I,L1)
33067 SPNCFC(1,1,1) = ONE
33068 C--chargino antilepton
33069 ELSEIF(IK.GE.456.AND.IK.LE.457.AND.
33070 & IJ.GE.127.AND.IJ.LE.132.AND.MOD(IJ,2).EQ.1) THEN
33071 C--ensure lepton first
33072 IF(IDHEP(LHEP).LT.0) THEN
33079 JJJ = (IDHW(LHEP)-119)/2
33080 KKK = (IDHW(MHEP)-125)/2
33086 A(2,1) = LAMDA1(III,JJJ,KKK)
33088 B(2,2) =-LAMDA1(III,JJJ,KKK)
33091 B(J,1) = AFC(O(J),2*III+6,1,L1)
33092 19 A(J,2) = AFC(O(J),2*JJJ+6,1,L1)
33100 SPNCFC(1,1,1) = ONE
33102 ELSEIF(IK.GE.454.AND.IK.LE.455.AND.
33103 & IJ.GE.121.AND.IJ.LE.126.AND.MOD(IJ,2).EQ.1) THEN
33104 C--ensure lepton first
33105 IF(IDHEP(LHEP).LT.0) THEN
33112 JJJ = (IDHW(MHEP)-125)/2
33113 KKK = (IDHW(LHEP)-119)/2
33118 A(1,1) = LAMDA1(III,JJJ,KKK)
33120 B(1,2) =-LAMDA1(III,JJJ,KKK)
33124 B(J,1) = AFC(J,2*III+6,1,L1)
33125 21 A(J,2) = AFC(J,2*JJJ+6,1,L1)
33133 SPNCFC(1,1,1) = ONE
33135 ELSEIF(IK.GE.121.AND.IK.LE.132.AND.MOD(IK,2).EQ.1.AND.
33136 & IJ.GE.121.AND.IJ.LE.132.AND.MOD(IJ,2).EQ.1) THEN
33137 C--ensure incoming lepton first
33138 IF(IDHEP(LHEP).LT.0) THEN
33143 C--ensure outgoing lepton first
33144 IF(IDHEP(KHEP).LT.0) THEN
33152 C--only need the correlations for tau production
33153 IF(IK.NE.125.AND.IJ.NE.131) RETURN
33154 C--find the RPV indices
33155 III = (IDHW(LHEP)-119)/2
33159 EE = SQRT(HWUAEM(SH)*FOUR*PIFAC)
33160 C--s-channel photon and Z exchange if needed
33161 IF(KKK.EQ.LLL) THEN
33166 A(1,1) = -EE*QFCH(ID1)
33167 A(2,1) = -EE*QFCH(ID1)
33168 B(1,1) = -EE*QFCH(ID2)
33169 B(2,1) = -EE*QFCH(ID2)
33172 C--then the Z exchange
33173 A(1,2) = -EE*RFCH(ID1)
33174 A(2,2) = -EE*LFCH(ID1)
33175 B(1,2) = -EE*RFCH(ID2)
33176 B(2,2) = -EE*LFCH(ID2)
33181 C--s-channel sneutrino exchange
33182 IF(ABS(LAMDA1(III,JJJ,III)*LAMDA1(LLL,JJJ,KKK)).GT.EPS) THEN
33185 IDP(NDIA+4) = 424+2*JJJ
33186 A(1,NDIA) = LAMDA1(III,JJJ,III)
33189 B(2,NDIA) = LAMDA1(LLL,JJJ,KKK)
33191 C--s-channel antisneutrino exchange
33192 IF(ABS(LAMDA1(III,JJJ,III)*LAMDA1(KKK,JJJ,LLL)).GT.EPS) THEN
33195 IDP(NDIA+4) = 424+2*JJJ
33197 A(2,NDIA) = LAMDA1(III,JJJ,III)
33198 B(1,NDIA) = LAMDA1(KKK,JJJ,LLL)
33201 C--t-channel sneutrino exchange
33202 IF(ABS(LAMDA1(KKK,JJJ,III)*LAMDA1(LLL,JJJ,III)).GT.EPS) THEN
33205 IDP(NDIA+4) = 424+2*JJJ
33206 A(1,NDIA) = LAMDA1(KKK,JJJ,III)
33209 B(2,NDIA) = LAMDA1(LLL,JJJ,III)
33211 C--t-channel antisneutrino exchange
33212 IF(ABS(LAMDA1(III,JJJ,KKK)*LAMDA1(III,JJJ,LLL)).GT.EPS) THEN
33215 IDP(NDIA+4) = 424+2*JJJ
33217 A(2,NDIA) = LAMDA1(III,JJJ,KKK)
33218 B(1,NDIA) = LAMDA1(III,JJJ,LLL)
33222 C--setup the colour flow
33224 SPNCFC(1,1,1) = ONE
33227 C--d dbar production
33228 ELSEIF(IK.LE.12.AND.IK.LE.12.AND.
33229 & MOD(IJ,2).EQ.1.AND.MOD(IK,2).EQ.1) THEN
33230 C--can't produce quark which decays before hadronization
33232 C--unrecognised process
33234 CALL HWWARN('HWHSPN',504,*999)
33237 ELSEIF(IPRO.EQ.40) THEN
33238 C--change outgoing order
33245 C--neutrino neutralino production
33246 IF(IK.GE.450.AND.IK.LE.453.AND.MOD(IJ,2).EQ.0.AND.
33247 & IDPDG(IJ).GT.0) THEN
33248 C--change order if antiparticle first
33249 IF(IDHEP(LHEP).LT.0) THEN
33254 C--indices for RPV coupling
33256 JJJ = (IDHW(MHEP)-5)/2
33257 KKK = (IDHW(LHEP)+1)/2
33261 IDP(5+I) = 399+2*JJJ+(I-1)*12
33262 25 IDP(7+I) = 399+2*KKK+(I-1)*12
33263 C--types of diagram
33270 A(1,1) = -LAMDA2(III,JJJ,KKK)
33273 B(1,I+1) = -QMIXSS(2*JJJ-1,1,I)*LAMDA2(III,JJJ,KKK)
33275 A(1,I+3) = -QMIXSS(2*KKK-1,2,I)*LAMDA2(III,JJJ,KKK)
33279 B(J,1) = AFN( J ,2*III+6,1,L1)
33281 A(J,I+1) = AFN( J ,2*JJJ-1,I,L1)
33282 27 B(J,I+3) = AFN(O(J),2*KKK-1,I,L1)
33288 SPNCFC(1,1,1) = ONE/THREE
33289 C--antineutrino neutralino production
33290 ELSEIF(IK.GE.450.AND.IK.LE.453.AND.MOD(IJ,2).EQ.0.AND.
33291 & IDPDG(IJ).LT.0) THEN
33292 C--change order if antiparticle first
33293 IF(IDHEP(LHEP).LT.0) THEN
33298 C--indices for RPV coupling
33300 JJJ = (IDHW(LHEP)+1)/2
33301 KKK = (IDHW(MHEP)-5)/2
33305 IDP(5+I) = 399+2*JJJ+(I-1)*12
33306 29 IDP(7+I) = 399+2*KKK+(I-1)*12
33307 C--types of diagram
33315 A(2,1) = -LAMDA2(III,JJJ,KKK)
33318 B(2,I+1) = -QMIXSS(2*JJJ-1,1,I)*LAMDA2(III,JJJ,KKK)
33320 30 A(2,I+3) = -QMIXSS(2*KKK-1,2,I)*LAMDA2(III,JJJ,KKK)
33323 B(J,1) = AFN(O(J),2*III+6,1,L1)
33325 A(J,I+1) = AFN(O(J),2*JJJ-1,I,L1)
33326 31 B(J,I+3) = AFN( J ,2*KKK-1,I,L1)
33332 SPNCFC(1,1,1) = ONE/THREE
33333 C--lepton neutralino production
33334 ELSEIF(IK.GE.450.AND.IK.LE.453.AND.MOD(IJ,2).EQ.1.AND.
33335 & IDPDG(IJ).GT.0) THEN
33336 C--change order if antiparticle first
33337 IF(IDHEP(LHEP).LT.0) THEN
33342 C--indices for RPV coupling
33344 JJJ = (IDHW(MHEP)-6)/2
33345 KKK = (IDHW(LHEP)+1)/2
33348 IDP(4+I) = 423+2*III+(I-1)*12
33349 IDP(6+I) = 400+2*JJJ+(I-1)*12
33350 33 IDP(8+I) = 399+2*KKK+(I-1)*12
33351 C--types of diagram
33360 A(1,I ) = LMIXSS(2*III-1,1,I)*LAMDA2(III,JJJ,KKK)
33362 B(1,I+2) = QMIXSS(2*JJJ ,1,I)*LAMDA2(III,JJJ,KKK)
33364 A(1,I+4) = QMIXSS(2*KKK-1,2,I)*LAMDA2(III,JJJ,KKK)
33368 B(J,I ) = AFN( J ,2*III+5,I,L1)
33369 A(J,I+2) = AFN( J ,2*JJJ ,I,L1)
33370 34 B(J,I+4) = AFN(O(J),2*KKK-1,I,L1)
33376 SPNCFC(1,1,1) = ONE/THREE
33377 C--antilepton neutralino production
33378 ELSEIF(IK.GE.450.AND.IK.LE.453.AND.MOD(IJ,2).EQ.1.AND.
33379 & IDPDG(IJ).LT.0) THEN
33380 C--change order if antiparticle first
33381 IF(IDHEP(LHEP).LT.0) THEN
33386 C--indices for RPV coupling
33389 KKK = (IDHW(MHEP)-5)/2
33392 IDP(4+I) = 423+2*III+(I-1)*12
33393 IDP(6+I) = 400+2*JJJ+(I-1)*12
33394 36 IDP(8+I) = 399+2*KKK+(I-1)*12
33395 C--types of diagram
33405 A(2,I ) = LMIXSS(2*III-1,1,I)*LAMDA2(III,JJJ,KKK)
33407 B(2,I+2) = QMIXSS(2*JJJ ,1,I)*LAMDA2(III,JJJ,KKK)
33409 A(2,I+4) = QMIXSS(2*KKK-1,2,I)*LAMDA2(III,JJJ,KKK)
33412 B(J,I ) = AFN(O(J),2*III+5,I,L1)
33413 A(J,I+2) = AFN(O(J),2*JJJ ,I,L1)
33414 37 B(J,I+4) = AFN( J ,2*KKK-1,I,L1)
33420 SPNCFC(1,1,1) = ONE/THREE
33421 C-- +ve chargino antineutrino
33422 ELSEIF(IK.GE.454.AND.IK.LE.455.AND.MOD(IJ,2).EQ.0) THEN
33423 C--change order if antiparticle first
33424 IF(IDHEP(LHEP).LT.0) THEN
33432 KKK = (IDHW(MHEP)-5)/2
33435 IDP(4+I) = 423+2*III+(I-1)*12
33436 40 IDP(6+I) = 399+2*JJJ+(I-1)*12
33437 C--types of diagram
33445 A(2,I ) = LMIXSS(2*III-1,1,I)*LAMDA2(III,JJJ,KKK)
33447 B(2,I+2) =-QMIXSS(2*JJJ-1,1,I)*LAMDA2(III,JJJ,KKK)
33450 B(J,I ) = AFC(O(J),2*III+5,I,L1)
33451 41 A(J,I+2) = AFC(O(J),2*JJJ-1,I,L1)
33457 SPNCFC(1,1,1) = ONE/THREE
33458 C-- -ve chargino neutrino
33459 ELSEIF(IK.GE.456.AND.IK.LE.457.AND.MOD(IJ,2).EQ.0) THEN
33460 C--change order if antiparticle first
33461 IF(IDHEP(LHEP).LT.0) THEN
33468 JJJ = (IDHW(MHEP)-6)/2
33469 KKK = (IDHW(LHEP)+1)/2
33472 IDP(4+I) = 423+2*III+(I-1)*12
33473 43 IDP(6+I) = 399+2*JJJ+(I-1)*12
33474 C--types of diagram
33481 A(1,I ) = LMIXSS(2*III-1,1,I)*LAMDA2(III,JJJ,KKK)
33483 B(1,I+2) =-QMIXSS(2*JJJ-1,1,I)*LAMDA2(III,JJJ,KKK)
33487 B(J,I ) = AFC(J,2*III+5,I,L1)
33488 44 A(J,I+2) = AFC(J,2*JJJ-1,I,L1)
33494 SPNCFC(1,1,1) = ONE/THREE
33495 C-- -ve chargino antilepton
33496 ELSEIF(IK.GE.456.AND.IK.LE.457.AND.MOD(IJ,2).EQ.1) THEN
33497 C--change order if antiparticle first
33498 IF(IDHEP(LHEP).LT.0) THEN
33505 JJJ = (IDHW(LHEP)+1)/2
33506 KKK = (IDHW(MHEP)-5)/2
33510 46 IDP(5+I) = 400+2*JJJ+(I-1)*12
33511 C--types of diagram
33517 A(2,1) =-LAMDA2(III,JJJ,KKK)
33520 47 B(2,I+1) = QMIXSS(2*JJJ,1,I)*LAMDA2(III,JJJ,KKK)
33523 B(J,1) = AFC(O(J),2*III+6,1,L1)
33525 48 A(J,I+1) = AFC(O(J),2*JJJ,I,L1)
33531 SPNCFC(1,1,1) = ONE/THREE
33532 C-- +ve chargino lepton
33533 ELSEIF(IK.GE.454.AND.IK.LE.455.AND.MOD(IJ,2).EQ.1) THEN
33534 C--change order if antiparticle first
33535 IF(IDHEP(LHEP).LT.0) THEN
33542 JJJ = (IDHW(MHEP)-5)/2
33543 KKK = (IDHW(LHEP)+1)/2
33547 50 IDP(5+I) = 400+2*JJJ+(I-1)*12
33548 C--types of diagram
33553 A(1,1) =-LAMDA2(III,JJJ,KKK)
33556 B(1,I+1) = QMIXSS(2*JJJ,1,I)*LAMDA2(III,JJJ,KKK)
33557 51 B(2,I+1) = 0.0D0
33560 B(J,1) = AFC(J,2*III+6,1,L1)
33562 52 A(J,I+1) = AFC(J,2*JJJ,I,L1)
33568 SPNCFC(1,1,1) = ONE/THREE
33570 ELSEIF(IK.LE.12.AND.IJ.LE.12.AND.
33571 & MOD(IJ,2).EQ.1.AND.MOD(IK,2).EQ.1) THEN
33572 C--can't produce unstable quark (on hadronization timescale)
33574 C--u dbar --> u dbar
33575 ELSEIF((IJ.LE. 6.AND.MOD(IJ,2).EQ.0.AND.
33576 & IK.LE.12.AND.MOD(IK,2).EQ.1).OR.
33577 & (IK.LE.6 .AND.MOD(IK,2).EQ.0.AND.
33578 & IJ.LE.12.AND.MOD(IJ,2).EQ.1)) THEN
33579 C--ensure u first (incoming)
33580 IF(MOD(IDHW(LHEP),2).EQ.1) THEN
33585 C--ensure u first (outgoing)
33586 IF(MOD(IK,2).EQ.1) THEN
33594 C--can't produce unstable quark (on hadronization timescale)
33598 KKK = (IDHW(MHEP)-5)/2
33603 IF(ABS(LAMDA2(III,JJJ,KKK)*LAMDA2(III,LLL,MMM)).LT.EPS)
33607 IDP(4+NDIA+J) = 423+2*III+12*(J-1)
33609 A(2,NDIA+J) = LAMDA2(III,JJJ,KKK)*LMIXSS(2*III-1,1,J)
33610 B(1,NDIA+J) = LAMDA2(III,LLL,MMM)*LMIXSS(2*III-1,1,J)
33612 55 DRTYPE(NDIA+J) = 21
33616 SPNCFC(1,1,1) = ONE
33617 C--ubar d --> ubar d
33618 ELSEIF((IJ.LE.12.AND.MOD(IJ,2).EQ.0.AND.
33619 & IK.LE. 6.AND.MOD(IK,2).EQ.1).OR.
33620 & (IK.LE.12.AND.MOD(IK,2).EQ.0.AND.
33621 & IJ.LE. 6.AND.MOD(IJ,2).EQ.1)) THEN
33622 C--ensure d first (incoming)
33623 IF(MOD(IDHW(LHEP),2).EQ.0) THEN
33628 C--ensure d first (outgoing)
33629 IF(MOD(IK,2).EQ.0) THEN
33637 C--can't produce unstable quark (on hadronization timescale)
33638 IF(IJ.NE.12) RETURN
33640 JJJ = (IDHW(MHEP)-6)/2
33641 KKK = (IDHW(LHEP)+1)/2
33646 IF(ABS(LAMDA2(III,JJJ,KKK)*LAMDA2(III,LLL,MMM)).LT.EPS)
33650 IDP(4+NDIA+J) = 423+2*III+12*(J-1)
33651 A(1,NDIA+J) = LAMDA2(III,JJJ,KKK)*LMIXSS(2*III-1,1,J)
33654 B(2,NDIA+J) = LAMDA2(III,LLL,MMM)*LMIXSS(2*III-1,1,J)
33655 57 DRTYPE(NDIA+J) = 21
33659 SPNCFC(1,1,1) = ONE
33660 C--d dbar --> ell- ell+
33661 ELSEIF(IDHW(LHEP).LE.12.AND.MOD(IDHW(LHEP),2).EQ.1.AND.
33662 & IDHW(MHEP).LE.12.AND.MOD(IDHW(MHEP),2).EQ.1.AND.
33663 & IK.GE.127.AND.IK.LE.132.AND.MOD(IK,2).EQ.1.AND.
33664 & IJ.GE.121.AND.IJ.LE.126.AND.MOD(IJ,2).EQ.1) THEN
33665 C--change outgoing order
33672 C--change order if dbar first
33673 IF(IDHEP(LHEP).LT.0) THEN
33678 C--don't do correlations if no taus
33679 IF(IK.NE.125.AND.IJ.NE.131) RETURN
33681 JJJ = (IDHW(LHEP)+1)/2
33682 KKK = (IDHW(MHEP)-5)/2
33687 IF(ABS(LAMDA2(III,JJJ,KKK)*LAMDA1(III,LLL,MMM)).LT.EPS)
33691 IDP(4+NDIA) = 424+2*III
33693 A(2,NDIA) = LAMDA2(III,JJJ,KKK)
33694 B(1,NDIA) = LAMDA1(III,LLL,MMM)
33699 SPNCFC(1,1,1) = ONE/THREE
33700 C--dbar d --> ell+ ell-
33701 ELSEIF(IDHW(LHEP).LE.12.AND.MOD(IDHW(LHEP),2).EQ.1.AND.
33702 & IDHW(MHEP).LE.12.AND.MOD(IDHW(MHEP),2).EQ.1.AND.
33703 & IK.GE.121.AND.IK.LE.126.AND.MOD(IK,2).EQ.1.AND.
33704 & IJ.GE.127.AND.IJ.LE.132.AND.MOD(IJ,2).EQ.1) THEN
33705 C--change order if dbar first
33706 IF(IDHEP(LHEP).LT.0) THEN
33711 C--don't do correlations if no taus
33712 IF(IK.NE.125.AND.IJ.NE.131) RETURN
33714 JJJ = (IDHW(MHEP)-5)/2
33715 KKK = (IDHW(LHEP)+1)/2
33720 IF(ABS(LAMDA2(III,JJJ,KKK)*LAMDA1(III,LLL,MMM)).LT.EPS)
33724 IDP(4+NDIA) = 424+2*III
33725 A(1,NDIA) = LAMDA2(III,JJJ,KKK)
33728 B(2,NDIA) = LAMDA1(III,LLL,MMM)
33732 SPNCFC(1,1,1) = ONE/THREE
33733 C--u dbar --> nu ell+
33734 ELSEIF((IK.GE.121.AND.IK.LE.126.AND.MOD(IK,2).EQ.0.AND.
33735 & IJ.GE.127.AND.IJ.LE.132.AND.MOD(IJ,2).EQ.1).OR.
33736 & (IK.GE.127.AND.IK.LE.132.AND.MOD(IK,2).EQ.1.AND.
33737 & IJ.GE.121.AND.IJ.LE.126.AND.MOD(IJ,2).EQ.0)) THEN
33739 IF(MOD(IDHW(LHEP),2).NE.0) THEN
33745 IF(MOD(IK,2).NE.0) THEN
33753 C--only need correlations if tau
33754 IF(IJ.NE.131) RETURN
33757 KKK = (IDHW(MHEP)-5)/2
33762 IF(ABS(LAMDA2(III,JJJ,KKK)*LAMDA1(III,LLL,MMM)).LT.EPS)
33766 IDP(4+NDIA+J) = 423+2*III+12*(J-1)
33768 A(2,NDIA+J) = LAMDA2(III,JJJ,KKK)*LMIXSS(2*III-1,1,J)
33769 B(1,NDIA+J) = LAMDA1(III,LLL,MMM)*LMIXSS(2*III-1,1,J)
33771 61 DRTYPE(NDIA+J) = 21
33775 SPNCFC(1,1,1) = ONE/THREE
33776 C--ubar d --> ell nubar
33777 ELSEIF((IK.GE.127.AND.IK.LE.132.AND.MOD(IK,2).EQ.0.AND.
33778 & IJ.GE.121.AND.IJ.LE.126.AND.MOD(IJ,2).EQ.1).OR.
33779 & (IK.GE.121.AND.IK.LE.126.AND.MOD(IK,2).EQ.1.AND.
33780 & IJ.GE.127.AND.IJ.LE.132.AND.MOD(IJ,2).EQ.0)) THEN
33782 IF(MOD(IDHW(MHEP),2).NE.0) THEN
33787 C-- ensure nu second
33788 IF(MOD(IJ,2).NE.0) THEN
33796 C--only need correlations if tau
33797 IF(IK.NE.125) RETURN
33799 JJJ = (IDHW(MHEP)-6)/2
33800 KKK = (IDHW(LHEP)+1)/2
33805 IF(ABS(LAMDA2(III,JJJ,KKK)*LAMDA1(III,LLL,MMM)).LT.EPS)
33809 IDP(4+NDIA+J) = 423+2*III+12*(J-1)
33810 A(1,NDIA+J) = LAMDA2(III,JJJ,KKK)*LMIXSS(2*III-1,1,J)
33813 B(2,NDIA+J) = LAMDA1(III,LLL,MMM)*LMIXSS(2*III-1,1,J)
33814 63 DRTYPE(NDIA+J) = 21
33818 SPNCFC(1,1,1) = ONE/THREE
33819 C--unrecognized process
33821 CALL HWWARN('HWHSPN',505,*999)
33824 ELSEIF(IPRO.EQ.41) THEN
33825 C--change outgoing order
33833 IF(IK.GE.450.AND.IK.LE.453.AND.MOD(IJ,2).EQ.0.AND.
33834 & IDPDG(IJ).LT.0) THEN
33837 JJJ = (IDHW(LHEP)+1)/2
33838 KKK = (IDHW(MHEP)+1)/2
33840 C--types of diagram
33849 A(1,J ) = QMIXSS(2*III,2,J)*LAMDA3(III,JJJ,KKK)
33851 B(1,J+2) = QMIXSS(2*JJJ-1,2,J)*LAMDA3(III,JJJ,KKK)
33853 A(1,J+4) = QMIXSS(2*KKK-1,2,J)*LAMDA3(III,JJJ,KKK)
33856 IDP(4+J) = 400+2*III+12*(J-1)
33857 IDP(6+J) = 399+2*JJJ+12*(J-1)
33858 IDP(8+J) = 399+2*KKK+12*(J-1)
33861 B(I,J) = AFN(O(I),2*III,J,L1)
33862 A(I,J+2) = AFN(O(I),2*JJJ-1,J,L1)
33863 64 B(I,J+4) = AFN(O(I),2*KKK-1,J,L1)
33869 SPNCFC(1,1,1) = TWO/THREE
33871 ELSEIF(IK.GE.450.AND.IK.LE.453.AND.MOD(IJ,2).EQ.0.AND.
33872 & IDPDG(IJ).GT.0) THEN
33875 JJJ = (IDHW(LHEP)-5)/2
33876 KKK = (IDHW(MHEP)-5)/2
33878 C--types of diagram
33888 A(2,J ) = QMIXSS(2*III,2,J)*LAMDA3(III,JJJ,KKK)
33890 B(2,J+2) = QMIXSS(2*JJJ-1,2,J)*LAMDA3(III,JJJ,KKK)
33892 A(2,J+4) = QMIXSS(2*KKK-1,2,J)*LAMDA3(III,JJJ,KKK)
33894 IDP(4+J) = 400+2*III+12*(J-1)
33895 IDP(6+J) = 399+2*JJJ+12*(J-1)
33896 IDP(8+J) = 399+2*KKK+12*(J-1)
33899 B(I,J) = AFN(I,2*III,J,L1)
33900 A(I,J+2) = AFN(I,2*JJJ-1,J,L1)
33901 66 B(I,J+4) = AFN(I,2*KKK-1,J,L1)
33907 SPNCFC(1,1,1) = TWO/THREE
33909 ELSEIF(IK.GE.450.AND.IK.LE.453.AND.MOD(IJ,2).EQ.1.AND.
33910 & IDPDG(IJ).LT.0) THEN
33911 C--ensure u type first
33912 IF(MOD(IDHW(LHEP),2).NE.0) THEN
33919 JJJ = (IDHW(MHEP)+1)/2
33922 C--types of diagram
33931 A(1,I ) = QMIXSS(2*KKK-1,2,I)*LAMDA3(III,JJJ,KKK)
33933 B(1,I+2) = QMIXSS(2*III,2,I)*LAMDA3(III,JJJ,KKK)
33935 A(1,I+4) = QMIXSS(2*JJJ-1,2,I)*LAMDA3(III,JJJ,KKK)
33938 IDP(4+I) = 399+2*KKK+12*(I-1)
33939 IDP(6+I) = 400+2*III+12*(I-1)
33940 IDP(8+I) = 399+2*JJJ+12*(I-1)
33943 B(J,I ) = AFN(O(J),2*KKK-1,I,L1)
33944 A(J,I+2) = AFN(O(J),2*III ,I,L1)
33945 68 B(J,I+4) = AFN(O(J),2*JJJ-1,I,L1)
33951 SPNCFC(1,1,1) = TWO/THREE
33953 ELSEIF(IK.GE.450.AND.IK.LE.453.AND.MOD(IJ,2).EQ.1.AND.
33954 & IDPDG(IJ).GT.0) THEN
33955 C--ensure u type first
33956 IF(MOD(IDHW(LHEP),2).NE.0) THEN
33962 III = (IDHW(LHEP)-6)/2
33963 JJJ = (IDHW(MHEP)-5)/2
33966 C--types of diagram
33976 A(2,I ) = QMIXSS(2*KKK-1,2,I)*LAMDA3(III,JJJ,KKK)
33978 B(2,I+2) = QMIXSS(2*III,2,I)*LAMDA3(III,JJJ,KKK)
33980 A(2,I+4) = QMIXSS(2*JJJ-1,2,I)*LAMDA3(III,JJJ,KKK)
33982 IDP(4+I) = 399+2*KKK+12*(I-1)
33983 IDP(6+I) = 400+2*III+12*(I-1)
33984 IDP(8+I) = 399+2*JJJ+12*(I-1)
33987 B(J,I ) = AFN(J,2*KKK-1,I,L1)
33988 A(J,I+2) = AFN(J,2*III ,I,L1)
33989 70 B(J,I+4) = AFN(J,2*JJJ-1,I,L1)
33995 SPNCFC(1,1,1) = TWO/THREE
33997 ELSEIF(IK.EQ.449.AND.MOD(IJ,2).EQ.0.AND.IDPDG(IJ).LT.0) THEN
34000 JJJ = (IDHW(LHEP)+1)/2
34001 KKK = (IDHW(MHEP)+1)/2
34002 C--types of diagram
34011 A(1,J ) = QMIXSS(2*III,2,J)*LAMDA3(III,JJJ,KKK)
34013 B(1,J+2) = QMIXSS(2*JJJ-1,2,J)*LAMDA3(III,JJJ,KKK)
34015 A(1,J+4) = QMIXSS(2*KKK-1,2,J)*LAMDA3(III,JJJ,KKK)
34018 IDP(4+J) = 400+2*III+12*(J-1)
34019 IDP(6+J) = 399+2*JJJ+12*(J-1)
34020 IDP(8+J) = 399+2*KKK+12*(J-1)
34023 B(I,J) = AFG(O(I),2*III,J)
34024 A(I,J+2) = AFG(O(I),2*JJJ-1,J)
34025 72 B(I,J+4) = AFG(O(I),2*KKK-1,J)
34036 SPNCFC(I,J,1) = 8.0D0/9.0D0
34038 SPNCFC(I,J,1) =-4.0D0/9.0D0
34042 ELSEIF(IK.EQ.449.AND.MOD(IJ,2).EQ.0.AND.IDPDG(IJ).GT.0) THEN
34045 JJJ = (IDHW(LHEP)-5)/2
34046 KKK = (IDHW(MHEP)-5)/2
34047 C--types of diagram
34057 A(2,J ) = QMIXSS(2*III,2,J)*LAMDA3(III,JJJ,KKK)
34059 B(2,J+2) = QMIXSS(2*JJJ-1,2,J)*LAMDA3(III,JJJ,KKK)
34061 A(2,J+4) = QMIXSS(2*KKK-1,2,J)*LAMDA3(III,JJJ,KKK)
34063 IDP(4+J) = 400+2*III+12*(J-1)
34064 IDP(6+J) = 399+2*JJJ+12*(J-1)
34065 IDP(8+J) = 399+2*KKK+12*(J-1)
34068 B(I,J) = AFG(I,2*III,J)
34069 A(I,J+2) = AFG(I,2*JJJ-1,J)
34070 75 B(I,J+4) = AFG(I,2*KKK-1,J)
34081 SPNCFC(I,J,1) = 8.0D0/9.0D0
34083 SPNCFC(I,J,1) =-4.0D0/9.0D0
34087 ELSEIF(IK.EQ.449.AND.MOD(IJ,2).EQ.1.AND.IDPDG(IJ).LT.0) THEN
34088 C--ensure u type first
34089 IF(MOD(IDHW(LHEP),2).NE.0) THEN
34096 JJJ = (IDHW(MHEP)+1)/2
34098 C--types of diagram
34107 A(1,I ) = QMIXSS(2*KKK-1,2,I)*LAMDA3(III,JJJ,KKK)
34109 B(1,I+2) = QMIXSS(2*III,2,I)*LAMDA3(III,JJJ,KKK)
34111 A(1,I+4) = QMIXSS(2*JJJ-1,2,I)*LAMDA3(III,JJJ,KKK)
34114 IDP(4+I) = 399+2*KKK+12*(I-1)
34115 IDP(6+I) = 400+2*III+12*(I-1)
34116 IDP(8+I) = 399+2*JJJ+12*(I-1)
34119 B(J,I ) = AFG(O(J),2*KKK-1,I)
34120 A(J,I+2) = AFG(O(J),2*III ,I)
34121 78 B(J,I+4) = AFG(O(J),2*JJJ-1,I)
34132 SPNCFC(I,J,1) = 8.0D0/9.0D0
34134 SPNCFC(I,J,1) =-4.0D0/9.0D0
34138 ELSEIF(IK.EQ.449.AND.MOD(IJ,2).EQ.1.AND.IDPDG(IJ).GT.0) THEN
34139 C--ensure u type first
34140 IF(MOD(IDHW(LHEP),2).NE.0) THEN
34146 III = (IDHW(LHEP)-6)/2
34147 JJJ = (IDHW(MHEP)-5)/2
34149 C--types of diagram
34159 A(2,I ) = QMIXSS(2*KKK-1,2,I)*LAMDA3(III,JJJ,KKK)
34161 B(2,I+2) = QMIXSS(2*III,2,I)*LAMDA3(III,JJJ,KKK)
34163 A(2,I+4) = QMIXSS(2*JJJ-1,2,I)*LAMDA3(III,JJJ,KKK)
34165 IDP(4+I) = 399+2*KKK+12*(I-1)
34166 IDP(6+I) = 400+2*III+12*(I-1)
34167 IDP(8+I) = 399+2*JJJ+12*(I-1)
34170 B(J,I ) = AFG(J,2*KKK-1,I)
34171 A(J,I+2) = AFG(J,2*III ,I)
34172 81 B(J,I+4) = AFG(J,2*JJJ-1,I)
34183 SPNCFC(I,J,1) = 8.0D0/9.0D0
34185 SPNCFC(I,J,1) =-4.0D0/9.0D0
34188 C--dbar -ve chargino
34189 ELSEIF(IK.GE.456.AND.IK.LE.457.AND.MOD(IJ,2).EQ.1) THEN
34190 C--change order so highest generation first
34191 IF(IDHW(MHEP).GT.IDHW(LHEP)) THEN
34198 JJJ = (IDHW(LHEP)+1)/2
34199 KKK = (IDHW(MHEP)+1)/2
34201 C--types of diagram
34210 A(1,I ) = QMIXSS(2*III,2,I)*LAMDA3(III,JJJ,KKK)
34212 B(1,I+2) = QMIXSS(2*JJJ,2,I)*LAMDA3(JJJ,KKK,III)
34214 A(1,I+4) = QMIXSS(2*KKK,2,I)*LAMDA3(KKK,III,JJJ)
34217 IDP(4+I) = 400+2*III+12*(I-1)
34218 IDP(6+I) = 400+2*JJJ+12*(I-1)
34219 IDP(8+I) = 400+2*KKK+12*(I-1)
34222 B(J,I ) = AFC(O(J),2*III,I,L1)
34223 A(J,I+2) = AFC(O(J),2*JJJ,I,L1)
34224 84 B(J,I+4) = AFC(O(J),2*KKK,I,L1)
34230 SPNCFC(1,1,1) = TWO/THREE
34232 ELSEIF(IK.GE.454.AND.IK.LE.455.AND.MOD(IJ,2).EQ.1) THEN
34233 C--change order so highest generation first
34234 IF(IDHW(MHEP).GT.IDHW(LHEP)) THEN
34241 JJJ = (IDHW(LHEP)-5)/2
34242 KKK = (IDHW(MHEP)-5)/2
34244 C--types of diagram
34254 A(2,I ) = QMIXSS(2*III,2,I)*LAMDA3(III,JJJ,KKK)
34256 B(2,I+2) = QMIXSS(2*JJJ,2,I)*LAMDA3(JJJ,KKK,III)
34258 A(2,I+4) = QMIXSS(2*KKK,2,I)*LAMDA3(KKK,III,JJJ)
34260 IDP(4+I) = 400+2*III+12*(I-1)
34261 IDP(6+I) = 400+2*JJJ+12*(I-1)
34262 IDP(8+I) = 400+2*KKK+12*(I-1)
34265 B(J,I ) = AFC(J,2*III,I,L1)
34266 A(J,I+2) = AFC(J,2*JJJ,I,L1)
34267 86 B(J,I+4) = AFC(J,2*KKK,I,L1)
34273 SPNCFC(1,1,1) = TWO/THREE
34274 C--ubar +ve chargino
34275 ELSEIF(IK.GE.454.AND.IK.LE.455.AND.MOD(IJ,2).EQ.0) THEN
34276 C--ensure u type first
34277 IF(MOD(IDHW(LHEP),2).NE.0) THEN
34284 JJJ = (IDHW(MHEP)+1)/2
34287 C--types of diagram
34294 A(1,I ) = QMIXSS(2*KKK-1,2,I)*LAMDA3(III,JJJ,KKK)
34296 B(1,I+2) = QMIXSS(2*III-1,2,I)*LAMDA3(KKK,III,JJJ)
34299 IDP(4+I) = 399+2*KKK+12*(I-1)
34300 IDP(6+I) = 399+2*III+12*(I-1)
34303 B(J,I ) = AFC(O(J),2*KKK-1,I,L1)
34304 88 A(J,I+2) = AFC(O(J),2*III-1,I,L1)
34310 SPNCFC(1,1,1) = TWO/THREE
34312 ELSEIF(IK.GE.456.AND.IK.LE.457.AND.MOD(IJ,2).EQ.0) THEN
34313 C--ensure u type first
34314 IF(MOD(IDHW(LHEP),2).NE.0) THEN
34320 III = (IDHW(LHEP)-6)/2
34321 JJJ = (IDHW(MHEP)-5)/2
34324 C--types of diagram
34332 A(2,I ) = QMIXSS(2*KKK-1,2,I)*LAMDA3(III,JJJ,KKK)
34334 B(2,I+2) = QMIXSS(2*III-1,2,I)*LAMDA3(KKK,III,JJJ)
34336 IDP(4+I) = 399+2*KKK+12*(I-1)
34337 IDP(6+I) = 399+2*III+12*(I-1)
34340 B(J,I ) = AFC(J,2*KKK-1,I,L1)
34341 90 A(J,I+2) = AFC(J,2*III-1,I,L1)
34347 SPNCFC(1,1,1) = TWO/THREE
34349 ELSEIF(IDPDG(IK).GT.0.AND.IDPDG(IK).GT.0.AND.
34350 & MOD(IK,2).EQ.1.AND.MOD(IJ,2).EQ.1) THEN
34351 C--can't produce unstable quark on hadronisation timescale
34353 C--dbar dbar --> dbar dbar
34354 ELSEIF(IDPDG(IK).LT.0.AND.IDPDG(IJ).LT.0.AND.
34355 & MOD(IJ,2).EQ.1.AND.MOD(IK,2).EQ.1) THEN
34356 C--can't produce unstable quark on hadronisation timescale
34359 ELSEIF(IDPDG(IK).GT.0.AND.IDPDG(IJ).GT.0.AND.
34360 & ((MOD(IJ,2).EQ.1.AND.MOD(IK,2).EQ.0).OR.
34361 & (MOD(IJ,2).EQ.0.AND.MOD(IK,2).EQ.1))) THEN
34362 C--ensure u first (incoming)
34363 IF(MOD(IDHW(LHEP),2).EQ.1) THEN
34368 C--ensure u first (outgoing)
34369 IF(MOD(IK,2).EQ.1) THEN
34377 C--can't produce unstable quark on hadronisation timescale
34381 KKK = (IDHW(MHEP)+1)/2
34386 IF(ABS(LAMDA3(III,JJJ,KKK)*LAMDA3(LLL,JJJ,MMM)).LT.EPS)
34390 IDP(4+NDIA+J) = 399+2*JJJ+12*(J-1)
34391 A(1,NDIA+J) = LAMDA3(III,JJJ,KKK)*QMIXSS(2*JJJ-1,2,J)
34394 B(2,NDIA+J) = LAMDA3(LLL,JJJ,MMM)*QMIXSS(2*JJJ-1,2,J)
34395 93 DRTYPE(NDIA+J) = 33
34399 SPNCFC(1,1,1) = ONE/THREE
34400 C--ubar dbar --> ubar dbar
34401 ELSEIF(IDPDG(IK).LT.0.AND.IDPDG(IJ).LT.0.AND.
34402 & ((MOD(IJ,2).EQ.1.AND.MOD(IK,2).EQ.0).OR.
34403 & (MOD(IJ,2).EQ.0.AND.MOD(IK,2).EQ.1))) THEN
34404 C--ensure u first (incoming)
34405 IF(MOD(IDHW(LHEP),2).EQ.1) THEN
34410 C--ensure u first (outgoing)
34411 IF(MOD(IK,2).EQ.1) THEN
34419 C--can't produce unstable quark on hadronisation timescale
34422 III = (IDHW(LHEP)-6)/2
34423 KKK = (IDHW(MHEP)-5)/2
34428 IF(ABS(LAMDA3(III,JJJ,KKK)*LAMDA3(LLL,JJJ,MMM)).LT.EPS)
34432 IDP(4+NDIA+J) = 399+2*JJJ+12*(J-1)
34434 A(2,NDIA+J) = LAMDA3(III,JJJ,KKK)*QMIXSS(2*JJJ-1,2,J)
34435 B(1,NDIA+J) = LAMDA3(LLL,JJJ,MMM)*QMIXSS(2*JJJ-1,2,J)
34437 95 DRTYPE(NDIA+J) = 34
34441 SPNCFC(1,1,1) = ONE/THREE
34442 C--unrecognized process
34444 CALL HWWARN('HWHSPN',506,*999)
34446 C--unrecognized process
34448 CALL HWWARN('HWHSPN',507,*999)
34450 C--copy the momenta into the internal array
34451 CALL HWVEQU(5,PHEP(1,LHEP),P(1,1))
34452 CALL HWVEQU(5,PHEP(1,MHEP),P(1,2))
34453 CALL HWVEQU(5,PHEP(1,KHEP),P(1,3))
34454 CALL HWVEQU(5,PHEP(1,JHEP),P(1,4))
34455 C--now compute the masses etc for the diagrams
34456 IDP(1) = IDHW(LHEP)
34457 IDP(2) = IDHW(MHEP)
34458 IDP(3) = IDHW(KHEP)
34459 IDP(4) = IDHW(JHEP)
34462 104 MA2(I) = SIGN(MA(I)**2,MA(I))
34464 MR(I) = RMASS(IDP(4+I))
34466 IF(IDP(I+4).EQ.200) THEN
34467 MWD(I) = RMASS(200)*GAMZ
34468 ELSEIF(IDP(I+4).EQ.198.OR.IDP(I+4).EQ.199) THEN
34469 MWD(I) = RMASS(198)*GAMW
34470 ELSEIF(IDP(I+4).EQ.59.OR.IDP(I+4).EQ.13.OR.
34471 & IDP(I+4).LE.5.OR.(IDP(I+4).GE.7.AND.IDP(I+4).LE.11)) THEN
34476 MWD(I) = MR(I)*HBAR/RLTIM(IDP(I+4))
34479 C--set up the mandelstam variables
34480 SH = TWO*HWULDO(P(1,1),P(1,2))
34481 CALL HWVSCA(4,-ONE,P(1,3),PLAB(1,2))
34482 CALL HWVSUM(5,P(1,1),PLAB(1,2),PLAB(1,1))
34483 TH = P(5,3)**2-TWO*HWULDO(P(1,1),P(1,3))
34484 UH = P(5,4)**2-TWO*HWULDO(P(1,1),P(1,4))
34485 C--copy the momenta into the common block for spinor computation
34487 IF(IDP(I).LT.400.AND.(IDP(I).NE.6.AND.IDP(I).NE.12
34488 & .AND.IDP(I).NE.125.AND.IDP(I).NE.131)) THEN
34489 CALL HWVEQU(5,PREF,PLAB(1,I+4))
34490 C--all other particles
34492 PP = SQRT(HWVDOT(3,P(1,I),P(1,I)))
34493 CALL HWVSCA(3,ONE/PP,P(1,I),N)
34494 PLAB(4,I+4) = HALF*(P(4,I)-PP)
34495 PP = HALF*(PP-P(5,I)-PP**2/(P(5,I)+P(4,I)))
34496 CALL HWVSCA(3,PP,N,PLAB(1,I+4))
34497 CALL HWUMAS(PLAB(1,I+4))
34498 PP = HWVDOT(3,PLAB(1,I+4),PLAB(1,I+4))
34499 C--fix to avoid problems if approx massless due to energy
34500 IF(PP.LT.EPS) CALL HWVEQU(5,PREF,PLAB(1,I+4))
34502 C--now the massless vectors
34503 PP = HALF*MA2(I)/HWULDO(PLAB(1,I+4),P(1,I))
34505 107 PLAB(J,I) = P(J,I)-PP*PLAB(J,I+4)
34506 106 CALL HWUMAS(PLAB(1,I))
34507 C--change order of momenta for call to HE code
34513 108 PM(5,I) = P(5,I)
34519 109 PCM(5,I)=PLAB(5,I)
34520 C--compute the S functions
34521 CALL HWHEW2(8,PCM(1,1),S(1,1,2),S(1,1,1),D)
34524 S(I,J,2) = -S(I,J,2)
34525 110 D(I,J) = TWO*D(I,J)
34526 C--compute the F functions
34527 CALL HWH2F1(8,F3 ,7,PM(1,3), MA(3))
34528 CALL HWH2F2(8,F4 ,8,PM(1,4),-MA(4))
34529 CALL HWH2F1(8,F4M,8,PM(1,4), MA(4))
34530 CALL HWH2F2(8,F3M,7,PM(1,3),-MA(3))
34531 C--t and u channel functions
34532 C--first the t channel ones
34533 CALL HWVSCA(4,-ONE,PM(1,4),PTMP)
34534 CALL HWVSUM(4,PM(1,2),PTMP,PTMP)
34536 CALL HWH2F3(8,FTP,PTMP, MR(1))
34537 CALL HWH2F3(8,FTM,PTMP,-MR(1))
34538 C--then the u-channel ones
34539 CALL HWVSCA(4,-ONE,PM(1,4),PTMP)
34540 CALL HWVSUM(4,PM(1,1),PTMP,PTMP)
34542 CALL HWH2F3(8,FUP,PTMP, MR(1))
34543 CALL HWH2F3(8,FUM,PTMP,-MR(1))
34544 C--function for t-channel scalar exchange
34545 CALL HWVSUM(4,PM(1,4),PM(1,4),PTMP)
34547 CALL HWH2F1(8,FST,2,PTMP,ZERO)
34548 C--compute the prefactor for all diagrams
34549 PRE = HWULDO(PCM(1,7),PM(1,3))*HWULDO(PCM(1,8),PM(1,4))
34550 PRE = ONE/SQRT(PRE)
34551 C--zero the matrix element
34557 200 ME(P1,P2,P3,P4,I) = (0.0D0,0.0D0)
34558 C--now call the subroutines to compute the individual diagrams
34560 C--s-channel vector boson exchange diagram (f fbar to fermion fermion)
34561 IF(DRTYPE(I).EQ.1) THEN
34563 C--t-channel sfermion exchange diagram (f fbar to fermion fermion)
34564 ELSEIF(DRTYPE(I).EQ.2) THEN
34566 C--u-channel sfermion exchange diagram(f fbar to fermion fermion)
34567 ELSEIF(DRTYPE(I).EQ.3) THEN
34569 C--s-channel vector boson (f fbar to fermion antifermion)
34570 ELSEIF(DRTYPE(I).EQ.4) THEN
34572 C--t-channel fermion exchange (g g to fermion antifermion)
34573 ELSEIF(DRTYPE(I).EQ.5) THEN
34575 C--u-channel fermion exchange (g g to fermion antifermion)
34576 ELSEIF(DRTYPE(I).EQ.6) THEN
34578 C--s-channel gluon exchange (g g to fermion antifermion)
34579 ELSEIF(DRTYPE(I).EQ.7) THEN
34581 C--t-channel sfermion exchange (g q to fermion sfermion)
34582 ELSEIF(DRTYPE(I).EQ.8) THEN
34584 C--t-channel sfermion exchange (g qbar to fermion antisfermion)
34585 ELSEIF(DRTYPE(I).EQ.9) THEN
34587 C--s-channel quark exchange (g q to fermion antisfermion)
34588 ELSEIF(DRTYPE(I).EQ.10) THEN
34590 C--s-channel antiquark exchange (g qbar to fermion antisfermion)
34591 ELSEIF(DRTYPE(I).EQ.11) THEN
34593 C--u-channel gluino exchange (g q to fermion antisfermion)
34594 ELSEIF(DRTYPE(I).EQ.12) THEN
34596 C--u-channel gluino exchange (g qbar to fermion antisfermion)
34597 ELSEIF(DRTYPE(I).EQ.13) THEN
34599 C--t-channel fermion exchange (g g to fermion fermion)
34600 ELSEIF(DRTYPE(I).EQ.14) THEN
34602 C--u-channel fermion exchange (g g to fermion fermion)
34603 ELSEIF(DRTYPE(I).EQ.15) THEN
34605 C--s-channel gluon exchange (g g to fermion fermion)
34606 ELSEIF(DRTYPE(I).EQ.16) THEN
34608 C--t-channel gauge boson exchange (fermion fermion)
34609 ELSEIF(DRTYPE(I).EQ.17) THEN
34611 C--t-channel gauge boson exchange (fermion antifermion)
34612 ELSEIF(DRTYPE(I).EQ.18) THEN
34614 C--t-channel gauge boson exchange (antifermion fermion)
34615 ELSEIF(DRTYPE(I).EQ.19) THEN
34617 C--t-channel gauge boson exchange (antifermion antifermion)
34618 ELSEIF(DRTYPE(I).EQ.20) THEN
34620 C--s-channel scalar exchange (f fbar --> f fbar)
34621 ELSEIF(DRTYPE(I).EQ.21) THEN
34623 C--t-channel scalar exchange (f fbar --> f fbar)
34624 ELSEIF(DRTYPE(I).EQ.22) THEN
34626 C--u-channel scalar exchange (f fbar --> f fbar)
34627 ELSEIF(DRTYPE(I).EQ.23) THEN
34629 C--s-channel scalar exchange (fbar f --> f f)
34630 ELSEIF(DRTYPE(I).EQ.24) THEN
34632 C--t-channel scalar exchange (fbar f --> f f)
34633 ELSEIF(DRTYPE(I).EQ.25) THEN
34635 C--u-channel scalar exchange (fbar f --> f f)
34636 ELSEIF(DRTYPE(I).EQ.26) THEN
34638 C--s-channel scalar exchange (f f --> f fbar)
34639 ELSEIF(DRTYPE(I).EQ.27) THEN
34641 C--t-channel scalar exchange (f f --> f fbar)
34642 ELSEIF(DRTYPE(I).EQ.28) THEN
34644 C--u-channel scalar exchange (f f --> f fbar)
34645 ELSEIF(DRTYPE(I).EQ.29) THEN
34647 C--s-channel scalar exchange (fbar fbar --> f f)
34648 ELSEIF(DRTYPE(I).EQ.30) THEN
34650 C--t-channel scalar exchange (fbar fbar --> f f)
34651 ELSEIF(DRTYPE(I).EQ.31) THEN
34653 C--u-channel scalar exchange (fbar fbar --> f f)
34654 ELSEIF(DRTYPE(I).EQ.32) THEN
34656 C--s-channel scalar exchange (f f --> f f)
34657 ELSEIF(DRTYPE(I).EQ.33) THEN
34659 C--s-channel scalar exchange (fbar fbar --> fbar fbar)
34660 ELSEIF(DRTYPE(I).EQ.34) THEN
34664 CALL HWWARN('HWHSPN',508,*999)
34666 C--add up the matrix elements
34671 210 ME(P1,P2,P3,P4,IFLOW(I)) = ME(P1,P2,P3,P4,IFLOW(I))
34672 & +MED(P1,P2,P3,P4)
34673 C--preform the final normalisation
34679 215 ME(P1,P2,P3,P4,I) = PRE*ME(P1,P2,P3,P4,I)
34680 C--now enter the matrix element in the spin common block
34687 DECSPN(1) = .FALSE.
34693 225 MESPN(P1,P2,P3,P4,I,1) = ME(P1,P2,P3,P4,I)
34694 C--now enter the daughter particles
34702 C--spin density matrices for daughter particles
34706 RHOSPN(1,1,I) = HALF
34707 RHOSPN(1,2,I) = ZERO
34708 RHOSPN(2,1,I) = ZERO
34709 230 RHOSPN(2,2,I) = HALF
34710 DECSPN(2) = .FALSE.
34711 DECSPN(3) = .FALSE.
34712 C--select the colour flow if needed
34713 IF(SPCOPT.EQ.2.AND.NCFL(1).NE.1) THEN
34715 C--assume no incoming polarization, no processes with more than one
34716 C--colour flow in e+e-
34717 DO 335 I =1,NCFL(1)
34723 WGTB(I) = WGTB(I)+SPNCFC(I,I,1)*MESPN(P1,P2,P3,P4,I,1)*
34724 & DCONJG(MESPN(P1,P2,P3,P4,I,1))
34725 DO 335 J =1,NCFL(1)
34726 335 WGT = WGT+SPNCFC(I,J,1)*MESPN(P1,P2,P3,P4,I,1)*
34727 & DCONJG(MESPN(P1,P2,P3,P4,J,1))
34730 340 WGTC = WGTC+WGTB(I)
34733 345 WGTB(I) = WGTB(I)*WGTC
34734 WGTC = WGT*HWRGEN(0)
34736 IF(WGTB(I).GE.WGTC) THEN
34740 350 WGTC =WGTC-WGTB(I)
34744 *CMZ :- -02/10/01 10:17:10 by Peter Richardson
34745 *-- Author : Peter Richardson
34746 C-----------------------------------------------------------------------
34747 SUBROUTINE HWHS01(ID,ME)
34748 C-----------------------------------------------------------------------
34749 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
34750 C section f fbar --> gauge boson --> fermion fermion
34751 C This diagram 1 from DAMTP-2001-83 with opposite sign of P4
34752 C-----------------------------------------------------------------------
34753 INCLUDE 'HERWIG65.INC'
34755 PARAMETER(NDIAHD=10)
34756 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE,ZI
34757 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),
34758 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
34759 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
34760 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
34761 INTEGER P1,P2,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
34762 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
34763 & MA2,SH,TH,UH,IDP,DRTYPE
34764 PARAMETER(ZI=(0.0D0,1.0D0))
34765 COMMON/HWHEWS/S(8,8,2),D(8,8)
34767 C--compute the propagator factor
34768 PRE = -ONE/(SH-MS(ID)+ZI*MWD(ID))
34774 ME(P1,P2,P3,P4) = PRE*A(P1,ID)*(
34775 & B(O(P1),ID)*F3(O(P3), P1 ,1)*F4( P1 ,P4,2)
34776 & +B( P1 ,ID)*F3(O(P3),O(P1),2)*F4(O(P1),P4,1))
34778 ME(P1,P2,P3,P4) = ZERO
34783 *CMZ :- -02/10/01 10:17:10 by Peter Richardson
34784 *-- Author : Peter Richardson
34785 C-----------------------------------------------------------------------
34786 SUBROUTINE HWHS02(ID,ME)
34787 C-----------------------------------------------------------------------
34788 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
34789 C section f fbar ---> fermion fermion via t-channel scalar exchange
34790 C This diagram 2 from DAMTP-2001-83 with opposite sign of P4
34791 C-----------------------------------------------------------------------
34792 INCLUDE 'HERWIG65.INC'
34794 PARAMETER(NDIAHD=10)
34795 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE
34796 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),
34797 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
34798 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
34799 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
34800 INTEGER P1,P2,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
34801 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
34802 & MA2,SH,TH,UH,IDP,DRTYPE
34803 COMMON/HWHEWS/S(8,8,2),D(8,8)
34805 C--compute the propagator factor
34806 PRE = -HALF/(TH-MS(ID))
34811 10 ME(P1,P2,P3,P4) = PRE*A(P1,ID)*B(O(P2),ID)*
34812 & F3(O(P3),P1,1)*F4(P2,P4,2)
34815 *CMZ :- -02/10/01 10:17:10 by Peter Richardson
34816 *-- Author : Peter Richardson
34817 C-----------------------------------------------------------------------
34818 SUBROUTINE HWHS03(ID,ME)
34819 C-----------------------------------------------------------------------
34820 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
34821 C section f fbar ---> fermion fermion via u-channel scalar exchange
34822 C This diagram 3 from DAMTP-2001-83 with opposite sign of P4
34823 C-----------------------------------------------------------------------
34824 INCLUDE 'HERWIG65.INC'
34826 PARAMETER(NDIAHD=10)
34827 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE,
34828 & F3M(2,2,8),F4M(2,2,8),FST(2,2,8),
34829 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
34830 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
34831 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
34832 INTEGER P1,P2,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
34833 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
34834 & MA2,SH,TH,UH,IDP,DRTYPE
34835 COMMON/HWHEWS/S(8,8,2),D(8,8)
34837 C--compute the propagator factor
34838 PRE = HALF/(UH-MS(ID))
34843 10 ME(P1,P2,P3,P4) = PRE*A(P1,ID)*B(O(P2),ID)*
34844 & F4M(O(P4),P1,1)*F3M(P2,P3,2)
34847 *CMZ :- -02/10/01 10:17:10 by Peter Richardson
34848 *-- Author : Peter Richardson
34849 C-----------------------------------------------------------------------
34850 SUBROUTINE HWHS04(ID,ME)
34851 C-----------------------------------------------------------------------
34852 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
34853 C section f fbar --> gauge boson --> fermion antifermion
34854 C This diagram 1 from DAMTP-2001-83
34855 C-----------------------------------------------------------------------
34856 INCLUDE 'HERWIG65.INC'
34858 PARAMETER(NDIAHD=10)
34859 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE,ZI
34860 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),
34861 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
34862 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
34863 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
34864 INTEGER P1,P2,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
34865 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
34866 & MA2,SH,TH,UH,IDP,DRTYPE
34867 PARAMETER(ZI=(0.0D0,1.0D0))
34868 COMMON/HWHEWS/S(8,8,2),D(8,8)
34870 C--compute the propagator factor
34871 PRE = -ONE/(SH-MS(ID)+ZI*MWD(ID))
34877 ME(P1,P2,P3,P4) = PRE*A(P1,ID)*(
34878 & B(O(P1),ID)*F3(O(P3), P1 ,1)*F4( P1 ,O(P4),2)
34879 & +B( P1 ,ID)*F3(O(P3),O(P1),2)*F4(O(P1),O(P4),1))
34881 ME(P1,P2,P3,P4) = (0.0D0,0.0D0)
34886 *CMZ :- -02/10/01 10:17:10 by Peter Richardson
34887 *-- Author : Peter Richardson
34888 C-----------------------------------------------------------------------
34889 SUBROUTINE HWHS05(ID,ME)
34890 C-----------------------------------------------------------------------
34891 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
34892 C section gluon gluon --> fermion antifermion (1st colour flow)
34893 C N.B. a gauge choice has been made to simplify the triple gluon vertex
34894 C This diagram 4 from DAMTP-2001-83 with the gauge choice L1=2 L2=1
34895 C-----------------------------------------------------------------------
34896 INCLUDE 'HERWIG65.INC'
34898 PARAMETER(NDIAHD=10)
34899 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE,ZI
34900 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),
34901 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
34902 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
34903 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
34904 INTEGER P1,P2,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
34905 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
34906 & MA2,SH,TH,UH,IDP,DRTYPE
34907 PARAMETER(ZI=(0.0D0,1.0D0))
34908 COMMON/HWHEWS/S(8,8,2),D(8,8)
34910 C--compute the propagator factor
34911 PRE =+ONE/SH/(TH-MS(ID))
34916 10 ME(P1,P2,P3,P4) = PRE*(
34917 & F3(O(P3), P1 ,2)*( FTP( P1 , P2 ,1,1)*F4( P2 ,O(P4),2)
34918 & +FTP( P1 ,O(P2),1,2)*F4(O(P2),O(P4),1))
34919 & +F3(O(P3),O(P1),1)*( FTP(O(P1), P2 ,2,1)*F4( P2 ,O(P4),2)
34920 & +FTP(O(P1),O(P2),2,2)*F4(O(P2),O(P4),1)))
34923 *CMZ :- -02/10/01 10:17:10 by Peter Richardson
34924 *-- Author : Peter Richardson
34925 C-----------------------------------------------------------------------
34926 SUBROUTINE HWHS06(ID,ME)
34927 C-----------------------------------------------------------------------
34928 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
34929 C section gluon gluon --> fermion antifermion (2st colour flow)
34930 C N.B. a gauge choice has been made to simplify the triple gluon vertex
34931 C This diagram 5 from DAMTP-2001-83 with the gauge choice L1=2 L2=1
34932 C-----------------------------------------------------------------------
34933 INCLUDE 'HERWIG65.INC'
34935 PARAMETER(NDIAHD=10)
34936 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE,ZI
34937 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),
34938 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
34939 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
34940 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
34941 INTEGER P1,P2,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
34942 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
34943 & MA2,SH,TH,UH,IDP,DRTYPE
34944 PARAMETER(ZI=(0.0D0,1.0D0))
34945 COMMON/HWHEWS/S(8,8,2),D(8,8)
34947 C--compute the propagator factor
34948 PRE =-ONE/SH/(UH-MS(ID))
34953 10 ME(P1,P2,P3,P4) = PRE*(
34954 & F3(O(P3), P2 ,1)*( FUP( P2 , P1 ,2,2)*F4( P1 ,O(P4),1)
34955 & +FUP( P2 ,O(P1),2,1)*F4(O(P1),O(P4),2))
34956 & +F3(O(P3),O(P2),2)*( FUP(O(P2), P1 ,1,2)*F4( P1 ,O(P4),1)
34957 & +FUP(O(P2),O(P1),1,1)*F4(O(P1),O(P4),2)))
34960 *CMZ :- -02/10/01 10:17:10 by Peter Richardson
34961 *-- Author : Peter Richardson
34962 C-----------------------------------------------------------------------
34963 SUBROUTINE HWHS07(ID,ME)
34964 C-----------------------------------------------------------------------
34965 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
34966 C section gluon gluon --> fermion antifermion (triple gluon piece)
34967 C N.B. a gauge choice has been made to simplify the triple gluon vertex
34968 C This diagram 6 from DAMTP-2001-83 with the gauge choice L1=2 L2=1
34969 C-----------------------------------------------------------------------
34970 INCLUDE 'HERWIG65.INC'
34972 PARAMETER(NDIAHD=10)
34973 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE,ZI
34974 & ,F3M(2,2,8),F4M(2,2,8),MET,FST(2,2,8),
34975 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
34976 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
34977 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
34978 INTEGER I,P1,P2,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
34979 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
34980 & MA2,SH,TH,UH,IDP,DRTYPE
34981 PARAMETER(ZI=(0.0D0,1.0D0))
34982 COMMON/HWHEWS/S(8,8,2),D(8,8)
34984 C--compute the propagator factor
34988 MET = (0.0D0,0.0D0)
34990 5 MET=MET+F3(O(P3),I,1)*F4(I,O(P4),1)-F3(O(P3),I,2)*F4(I,O(P4),2)
34994 ME(P1,P2,P3,P4) = PRE*S(1,2,P1)*S(1,2,O(P1))*MET
34996 ME(P1,P2,P3,P4) = (0.0D0,0.0D0)
35001 *CMZ :- -02/10/01 10:17:10 by Peter Richardson
35002 *-- Author : Peter Richardson
35003 C-----------------------------------------------------------------------
35004 SUBROUTINE HWHS08(ID,ME)
35005 C-----------------------------------------------------------------------
35006 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
35007 C section quark gluon --> fermion sfermion
35008 C This diagram 7 from DAMTP-2001-83 with the gauge choice L2=1
35009 C-----------------------------------------------------------------------
35010 INCLUDE 'HERWIG65.INC'
35012 PARAMETER(NDIAHD=10)
35013 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE,ZI
35014 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),
35015 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
35016 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
35017 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH,HWULDO,XMASS,PLAB,PRW,PCM
35018 INTEGER P1,P2,P3,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
35019 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
35020 & MA2,SH,TH,UH,IDP,DRTYPE
35021 PARAMETER(ZI=(0.0D0,1.0D0))
35022 COMMON/HWHEWS/S(8,8,2),D(8,8)
35023 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
35026 C--compute the propagator factor
35027 PRE = HALF*SQRT(HWULDO(PCM(1,8),PCM(1,4)))/SQRT(TWO)/
35028 & SQRT(HWULDO(PCM(1,1),PCM(1,2)))/
35033 ME(P1,P2,P3,2) = ZERO
35034 10 ME(P1,P2,P3,1) = A(P1,ID)*PRE*FST(P2,P2,1)*F3(O(P3), P1,1)
35037 *CMZ :- -02/10/01 10:17:10 by Peter Richardson
35038 *-- Author : Peter Richardson
35039 C-----------------------------------------------------------------------
35040 SUBROUTINE HWHS09(ID,ME)
35041 C-----------------------------------------------------------------------
35042 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
35043 C section antiquark gluon --> fermion antisfermion
35044 C This diagram 10 from DAMTP-2001-83 with the gauge choice L2=1
35045 C-----------------------------------------------------------------------
35046 INCLUDE 'HERWIG65.INC'
35048 PARAMETER(NDIAHD=10)
35049 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE,ZI
35050 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),
35051 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
35052 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
35053 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH,HWULDO,XMASS,PLAB,PRW,PCM
35054 INTEGER P1,P2,P3,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
35055 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
35056 & MA2,SH,TH,UH,IDP,DRTYPE
35057 PARAMETER(ZI=(0.0D0,1.0D0))
35058 COMMON/HWHEWS/S(8,8,2),D(8,8)
35059 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
35062 C--compute the propagator factor
35063 PRE = HALF*SQRT(HWULDO(PCM(1,8),PCM(1,4)))/SQRT(TWO)/
35064 & SQRT(HWULDO(PCM(1,1),PCM(1,2)))/
35069 ME(P1,P2,P3,2) = ZERO
35070 10 ME(P1,P2,P3,1) = A(O(P1),ID)*PRE*FST(P2,P2,1)*F3M(P1,P3,1)
35073 *CMZ :- -02/10/01 10:17:10 by Peter Richardson
35074 *-- Author : Peter Richardson
35075 C-----------------------------------------------------------------------
35076 SUBROUTINE HWHS10(ID,ME)
35077 C-----------------------------------------------------------------------
35078 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
35079 C section quark gluon --> fermion antisfermion (s-channel quark)
35080 C This is diagram 8 from DAMTP-2001-83 with the gauge choice L2=1
35081 C-----------------------------------------------------------------------
35082 INCLUDE 'HERWIG65.INC'
35084 PARAMETER(NDIAHD=10)
35085 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE,ZI
35086 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),
35087 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
35088 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
35089 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH,HWULDO,XMASS,PLAB,PRW,PCM
35090 INTEGER P1,P2,P3,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
35091 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
35092 & MA2,SH,TH,UH,IDP,DRTYPE
35093 PARAMETER(ZI=(0.0D0,1.0D0))
35094 COMMON/HWHEWS/S(8,8,2),D(8,8)
35095 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
35098 C--compute the propagator factor
35099 PRE = SQRT(HWULDO(PCM(1,8),PCM(1,4)))/SQRT(TWO)/
35100 & SQRT(HWULDO(PCM(1,1),PCM(1,2)))/SH
35105 ME(p1,p2,p3,1) = PRE*A( P2 ,ID)*F3(O(P3), P2 ,1)*S(1,2,P2)*
35108 ME(P1,P2,P3,1) = PRE*
35109 & A(O(P2),ID)*( F3(O(P3),O(P2),1)*S(1,1,O(P2))
35110 & +F3(O(P3),O(P2),2)*S(2,1,O(P2)))*S(2,1,P2)
35112 10 ME(P1,P2,P3,2) = ZERO
35115 *CMZ :- -02/10/01 10:17:10 by Peter Richardson
35116 *-- Author : Peter Richardson
35117 C-----------------------------------------------------------------------
35118 SUBROUTINE HWHS11(ID,ME)
35119 C-----------------------------------------------------------------------
35120 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
35121 C section quark gluon --> fermion antisfermion (s-channel quark)
35122 C This is diagram 11 from DAMTP-2001-83 with the gauge choice L2=1
35123 C-----------------------------------------------------------------------
35124 INCLUDE 'HERWIG65.INC'
35126 PARAMETER(NDIAHD=10)
35127 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE,ZI
35128 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),
35129 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
35130 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
35131 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH,HWULDO,XMASS,PLAB,PRW,PCM
35132 INTEGER P1,P2,P3,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
35133 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
35134 & MA2,SH,TH,UH,IDP,DRTYPE
35135 PARAMETER(ZI=(0.0D0,1.0D0))
35136 COMMON/HWHEWS/S(8,8,2),D(8,8)
35137 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
35140 C--compute the propagator factor
35141 PRE = SQRT(HWULDO(PCM(1,8),PCM(1,4)))/SQRT(TWO)/
35142 & SQRT(HWULDO(PCM(1,1),PCM(1,2)))/SH
35147 ME(P1,P2,P3,1) = PRE*A(O(P2),ID)*S(1,2,P1)*
35148 & (S(1,1,O(P2))*F3M(P2,P3,1)+S(1,2,O(P2))*F3M(P2,P3,2))
35150 ME(P1,P2,P3,1)=PRE*A(P2,ID)*S(1,1,P1)*S(2,1,P2)*F3M(O(P2),P3,1)
35152 10 ME(P1,P2,P3,2) = ZERO
35155 *CMZ :- -02/10/01 10:17:10 by Peter Richardson
35156 *-- Author : Peter Richardson
35157 C-----------------------------------------------------------------------
35158 SUBROUTINE HWHS12(ID,ME)
35159 C-----------------------------------------------------------------------
35160 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
35161 C section quark gluon --> fermion antisfermion (s-channel quark)
35162 C This is diagram 9 from DAMTP-2001-83 with the gauge choice L2=1
35163 C-----------------------------------------------------------------------
35164 INCLUDE 'HERWIG65.INC'
35166 PARAMETER(NDIAHD=10)
35167 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE,ZI
35168 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),
35169 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
35170 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
35171 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH,HWULDO,XMASS,PLAB,PRW,PCM
35172 INTEGER P1,P2,P3,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
35173 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
35174 & MA2,SH,TH,UH,IDP,DRTYPE
35175 PARAMETER(ZI=(0.0D0,1.0D0))
35176 COMMON/HWHEWS/S(8,8,2),D(8,8)
35177 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
35180 C--compute the propagator factor
35181 PRE =-SQRT(HWULDO(PCM(1,8),PCM(1,4)))/SQRT(TWO)/
35182 & SQRT(HWULDO(PCM(1,1),PCM(1,2)))/(UH-MS(ID))
35186 ME(P1,P2,P3,1) = PRE*A(P1,ID)*(
35187 & F3(O(P3), P2 ,1)*FUP( P2 ,P1, 2,1)
35188 & +F3(O(P3),O(P2), 2)*FUP(O(P2),P1,1,1))
35189 10 ME(P1,P2,P3,2) = ZERO
35192 *CMZ :- -02/10/01 10:17:10 by Peter Richardson
35193 *-- Author : Peter Richardson
35194 C-----------------------------------------------------------------------
35195 SUBROUTINE HWHS13(ID,ME)
35196 C-----------------------------------------------------------------------
35197 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
35198 C section quark gluon --> fermion antisfermion (s-channel quark)
35199 C This is diagram 12 from DAMTP-2001-83 with the gauge choice L2=1
35200 C-----------------------------------------------------------------------
35201 INCLUDE 'HERWIG65.INC'
35203 PARAMETER(NDIAHD=10)
35204 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE,ZI
35205 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),
35206 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
35207 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
35208 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH,HWULDO,XMASS,PLAB,PRW,PCM
35209 INTEGER P1,P2,P3,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
35210 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
35211 & MA2,SH,TH,UH,IDP,DRTYPE
35212 PARAMETER(ZI=(0.0D0,1.0D0))
35213 COMMON/HWHEWS/S(8,8,2),D(8,8)
35214 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
35217 C--compute the propagator factor
35218 PRE =-SQRT(HWULDO(PCM(1,8),PCM(1,4)))/SQRT(TWO)/
35219 & SQRT(HWULDO(PCM(1,1),PCM(1,2)))/(UH-MS(ID))
35223 ME(P1,P2,P3,1) = PRE*A(O(P1),ID)*(
35224 & FUM(P1, P2 ,1,1)*F3M( P2 ,P3, 2)
35225 & +FUM(P1,O(P2),1, 2)*F3M(O(P2),P3,1))
35226 10 ME(P1,P2,P3,2) = ZERO
35229 *CMZ :- -02/10/01 10:17:10 by Peter Richardson
35230 *-- Author : Peter Richardson
35231 C-----------------------------------------------------------------------
35232 SUBROUTINE HWHS14(ID,ME)
35233 C-----------------------------------------------------------------------
35234 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
35235 C section gluon gluon --> fermion antifermion (1st colour flow)
35236 C N.B. a gauge choice has been made to simplify the triple gluon vertex
35237 C This diagram 4 from DAMTP-2001-83 with opposite helicity for 4
35238 C and gauge choice L1=2 L2=1
35239 C-----------------------------------------------------------------------
35240 INCLUDE 'HERWIG65.INC'
35242 PARAMETER(NDIAHD=10)
35243 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE,ZI,
35244 & F3M(2,2,8),F4M(2,2,8),FST(2,2,8),FTP(2,2,8,8),FTM(2,2,8,8),
35245 & FUP(2,2,8,8),FUM(2,2,8,8)
35246 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
35247 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
35248 INTEGER P1,P2,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
35249 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
35250 & MA2,SH,TH,UH,IDP,DRTYPE
35251 PARAMETER(ZI=(0.0D0,1.0D0))
35252 COMMON/HWHEWS/S(8,8,2),D(8,8)
35254 C--compute the propagator factor
35255 PRE =+ONE/(TH-MS(ID))/SH
35261 10 ME(P1,P2,P3,P4) = PRE*(
35262 & F3(O(P3), P1 ,2)*( FTP( P1 , P2 , 1,1)*F4( P2 ,P4,2)
35263 & +FTP( P1 ,O(P2), 1,2)*F4(O(P2),P4,1))
35264 & +F3(O(P3),O(P1),1)*( FTP(O(P1), P2 ,2,1)*F4( P2 ,P4,2)
35265 & +FTP(O(P1),O(P2),2,2)*F4(O(P2),P4,1)))
35268 *CMZ :- -02/10/01 10:17:10 by Peter Richardson
35269 *-- Author : Peter Richardson
35270 C-----------------------------------------------------------------------
35271 SUBROUTINE HWHS15(ID,ME)
35272 C-----------------------------------------------------------------------
35273 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
35274 C section gluon gluon --> fermion antifermion (2st colour flow)
35275 C N.B. a gauge choice has been made to simplify the triple gluon vertex
35276 C This diagram 5 from DAMTP-2001-83 with opposite helicity for 4
35277 C and gauge choice L1=2 L2=1
35278 C-----------------------------------------------------------------------
35279 INCLUDE 'HERWIG65.INC'
35281 PARAMETER(NDIAHD=10)
35282 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE,ZI,
35283 & F3M(2,2,8),F4M(2,2,8),FST(2,2,8),FTP(2,2,8,8),FTM(2,2,8,8),
35284 & FUP(2,2,8,8),FUM(2,2,8,8)
35285 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
35286 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
35287 INTEGER P1,P2,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
35288 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST, A,B,MS,MWD,MR,MA,
35289 & MA2,SH,TH,UH,IDP,DRTYPE
35290 PARAMETER(ZI=(0.0D0,1.0D0))
35291 COMMON/HWHEWS/S(8,8,2),D(8,8)
35293 C--compute the propagator factor
35294 PRE =-ONE/(UH-MS(ID))/SH
35300 10 ME(P1,P2,P3,P4) = PRE*(
35301 & F3(O(P3), P2 ,1)*( FUP( P2 , P1 ,2,2)*F4( P1 ,P4,1)
35302 & +FUP( P2 ,O(P1),2,1)*F4(O(P1),P4,2))
35303 &+F3(O(P3),O(P2),2)*( FUP(O(P2), P1 ,1,2)*F4( P1 ,P4,1)
35304 & +FUP(O(P2),O(P1),1,1)*F4(O(P1),P4,2)))
35307 *CMZ :- -02/10/01 10:17:10 by Peter Richardson
35308 *-- Author : Peter Richardson
35309 C-----------------------------------------------------------------------
35310 SUBROUTINE HWHS16(ID,ME)
35311 C-----------------------------------------------------------------------
35312 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
35313 C section gluon gluon --> fermion antifermion (triple gluon piece)
35314 C N.B. a gauge choice has been made to simplify the triple gluon vertex
35315 C This diagram 6 from DAMTP-2001-83 with opposite helicity for 4
35316 C and gauge choice L1=2 L2=1
35317 C-----------------------------------------------------------------------
35318 INCLUDE 'HERWIG65.INC'
35320 PARAMETER(NDIAHD=10)
35321 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE,ZI
35322 & ,F3M(2,2,8),F4M(2,2,8),MET,FST(2,2,8),
35323 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
35324 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
35325 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
35326 INTEGER I,P1,P2,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
35327 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
35328 & MA2,SH,TH,UH,IDP,DRTYPE
35329 PARAMETER(ZI=(0.0D0,1.0D0))
35330 COMMON/HWHEWS/S(8,8,2),D(8,8)
35332 C--compute the propagator factor
35337 MET = (0.0D0,0.0D0)
35339 5 MET=MET+F3(O(P3),I,1)*F4(I,P4,1)-F3(O(P3),I,2)*F4(I,P4,2)
35343 ME(P1,P2,P3,P4) = PRE*MET*S(1,2,P1)*S(1,2,O(P1))
35345 ME(P1,P2,P3,P4) = (0.0D0,0.0D0)
35350 *CMZ :- -02/10/01 10:17:10 by Peter Richardson
35351 *-- Author : Peter Richardson
35352 C-----------------------------------------------------------------------
35353 SUBROUTINE HWHS17(ID,ME)
35354 C-----------------------------------------------------------------------
35355 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
35356 C section fermion fermion --> fermion fermion (t-channel boson)
35357 C This diagram 13 from DAMTP-2001-83
35358 C-----------------------------------------------------------------------
35359 INCLUDE 'HERWIG65.INC'
35361 PARAMETER(NDIAHD=10)
35362 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE,ZI,
35363 & F3M(2,2,8),F4M(2,2,8),FST(2,2,8),
35364 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8),DL(2,2)
35365 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
35366 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH,HWULDO,XMASS,PLAB,PRW,PCM
35367 INTEGER P1,P2,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
35368 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
35369 & MA2,SH,TH,UH,IDP,DRTYPE
35370 PARAMETER(ZI=(0.0D0,1.0D0))
35371 COMMON/HWHEWS/S(8,8,2),D(8,8)
35372 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
35375 DATA DL/(1.0,0.0D0),(0.0D0,0.0D0),(0.0D0,0.0D0),(1.0D0,0.0D0)/
35376 C--compute the propagator factor
35377 PRE = SQRT(TWO*HWULDO(PCM(1,8),PCM(1,4)))/(TH-MS(ID))
35383 ME(P1,P2,P3,P4) = PRE*A(P1,ID)*B(P2,ID)*
35384 & ( DL(P1,O(P2))*F3(O(P3), P2 ,2)*S(4,1, P2 )
35385 & +DL(P1, P2 )*F3(O(P3),O(P2),4)*S(2,1,O(P2)))
35387 ME(P1,P2,P3,P4) = (0.0D0,0.0D0)
35392 *CMZ :- -02/10/01 10:17:10 by Peter Richardson
35393 *-- Author : Peter Richardson
35394 C-----------------------------------------------------------------------
35395 SUBROUTINE HWHS18(ID,ME)
35396 C-----------------------------------------------------------------------
35397 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
35398 C section fermion antifermion --> fermion antifermion (t-channel boson)
35399 C This diagram 14 from DAMTP-2001-83
35400 C-----------------------------------------------------------------------
35401 INCLUDE 'HERWIG65.INC'
35403 PARAMETER(NDIAHD=10)
35404 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE,ZI,
35405 & F3M(2,2,8),F4M(2,2,8),FST(2,2,8),
35406 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8),DL(2,2)
35407 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
35408 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH,HWULDO,XMASS,PLAB,PRW,PCM
35409 INTEGER P1,P2,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
35410 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
35411 & MA2,SH,TH,UH,IDP,DRTYPE
35412 PARAMETER(ZI=(0.0D0,1.0D0))
35413 COMMON/HWHEWS/S(8,8,2),D(8,8)
35414 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
35417 DATA DL/(1.0,0.0D0),(0.0D0,0.0D0),(0.0D0,0.0D0),(1.0D0,0.0D0)/
35418 C--compute the propagator factor
35419 PRE = SQRT(TWO*HWULDO(PCM(1,8),PCM(1,4)))/(TH-MS(ID))
35425 ME(P1,P2,P3,P4) = PRE*A(P1,ID)*B(P2,ID)*
35426 & ( DL(P1,O(P2))*F3(O(P3), P2 ,4)*S(2,1, P2 )
35427 & +DL(P1, P2 )*F3(O(P3),O(P2),2)*S(4,1,O(P2)))
35429 ME(P1,P2,P3,P4) = (0.0D0,0.0D0)
35434 *CMZ :- -02/10/01 10:17:10 by Peter Richardson
35435 *-- Author : Peter Richardson
35436 C-----------------------------------------------------------------------
35437 SUBROUTINE HWHS19(ID,ME)
35438 C-----------------------------------------------------------------------
35439 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
35440 C section antifermion fermion --> antifermion fermion (t-channel boson)
35441 C This diagram 15 from DAMTP-2001-83
35442 C-----------------------------------------------------------------------
35443 INCLUDE 'HERWIG65.INC'
35445 PARAMETER(NDIAHD=10)
35446 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE,ZI,
35447 & F3M(2,2,8),F4M(2,2,8),FST(2,2,8),
35448 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8),DL(2,2)
35449 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
35450 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH,HWULDO,XMASS,PLAB,PRW,PCM
35451 INTEGER P1,P2,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
35452 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
35453 & MA2,SH,TH,UH,IDP,DRTYPE
35454 PARAMETER(ZI=(0.0D0,1.0D0))
35455 COMMON/HWHEWS/S(8,8,2),D(8,8)
35456 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
35459 DATA DL/(1.0,0.0D0),(0.0D0,0.0D0),(0.0D0,0.0D0),(1.0D0,0.0D0)/
35460 C--compute the propagator factor
35461 PRE = SQRT(TWO*HWULDO(PCM(1,8),PCM(1,4)))/(TH-MS(ID))
35467 ME(P1,P2,P3,P4) = PRE*A(P1,ID)*B(P2,ID)*
35468 & ( DL(P1,O(P2))*S(1,2, P1 )*F3M( P2 ,O(P3),4)
35469 & +DL(P1, P2 )*S(1,4, P1 )*F3M(O(P2),O(P3),2))
35471 ME(P1,P2,P3,P4) = (0.0D0,0.0D0)
35476 *CMZ :- -02/10/01 10:17:10 by Peter Richardson
35477 *-- Author : Peter Richardson
35478 C-----------------------------------------------------------------------
35479 SUBROUTINE HWHS20(ID,ME)
35480 C-----------------------------------------------------------------------
35481 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
35482 C section antifermion fermion --> antifermion fermion (t-channel boson)
35483 C This diagram 16 from DAMTP-2001-83
35484 C-----------------------------------------------------------------------
35485 INCLUDE 'HERWIG65.INC'
35487 PARAMETER(NDIAHD=10)
35488 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE,ZI,
35489 & F3M(2,2,8),F4M(2,2,8),FST(2,2,8),
35490 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8),DL(2,2)
35491 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
35492 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH,HWULDO,XMASS,PLAB,PRW,PCM
35493 INTEGER P1,P2,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
35494 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
35495 & MA2,SH,TH,UH,IDP,DRTYPE
35496 PARAMETER(ZI=(0.0D0,1.0D0))
35497 COMMON/HWHEWS/S(8,8,2),D(8,8)
35498 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
35501 DATA DL/(1.0,0.0D0),(0.0D0,0.0D0),(0.0D0,0.0D0),(1.0D0,0.0D0)/
35502 C--compute the propagator factor
35503 PRE = SQRT(TWO*HWULDO(PCM(1,8),PCM(1,4)))/(TH-MS(ID))
35509 ME(P1,P2,P3,P4) = PRE*A(P1,ID)*B(P2,ID)*
35510 & ( DL(P1,O(P2))*S(1,4, P1 )*F3M( P2 ,O(P3),2)
35511 & +DL(P1, P2 )*S(1,2, P1 )*F3M(O(P2),O(P3),4))
35513 ME(P1,P2,P3,P4) = (0.0D0,0.0D0)
35518 *CMZ :- -02/10/01 10:17:10 by Peter Richardson
35519 *-- Author : Peter Richardson
35520 C-----------------------------------------------------------------------
35521 SUBROUTINE HWHS21(ID,ME)
35522 C-----------------------------------------------------------------------
35523 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
35524 C section f fbar ---> f fbar via s-channel scalar exchange
35525 C This is diagram 1 from RPV notes
35526 C-----------------------------------------------------------------------
35527 INCLUDE 'HERWIG65.INC'
35529 PARAMETER(NDIAHD=10)
35530 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE
35531 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),ZI,
35532 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
35533 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
35534 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
35535 INTEGER P1,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
35536 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
35537 & MA2,SH,TH,UH,IDP,DRTYPE
35538 COMMON/HWHEWS/S(8,8,2),D(8,8)
35540 PARAMETER(ZI=(0.0D0,1.0D0))
35541 C--compute the propagator factor
35542 PRE = HALF/(SH-MS(ID)+ZI*MWD(ID))
35546 ME(P1, P1 ,P3,P4) = (0.0D0,0.0D0)
35547 10 ME(P1,O(P1),P3,P4) = PRE*A(P1,ID)*S(2,1,O(P1))*
35548 & ( B( P4 ,ID)*F3(O(P3), P4 ,4)*S(4,8,P4)
35549 & -B(O(P4),ID)*F3(O(P3),O(P4),8)*MA(4))
35552 *CMZ :- -08/04/02 11:54:39 by Peter Richardson
35553 *-- Author : Peter Richardson
35554 C-----------------------------------------------------------------------
35555 SUBROUTINE HWHS22(ID,ME)
35556 C-----------------------------------------------------------------------
35557 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
35558 C section f fbar ---> f fbar via t-channel scalar exchange
35559 C This is diagram 2 from RPV notes
35560 C-----------------------------------------------------------------------
35561 INCLUDE 'HERWIG65.INC'
35563 PARAMETER(NDIAHD=10)
35564 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE
35565 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),
35566 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
35567 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
35568 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
35569 INTEGER P1,P2,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
35570 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
35571 & MA2,SH,TH,UH,IDP,DRTYPE
35572 COMMON/HWHEWS/S(8,8,2),D(8,8)
35574 C--compute the propagator factor
35575 PRE = -HALF/(TH-MS(ID))
35580 10 ME(P1,P2,P3,P4) = PRE*B(O(P2),ID)*A( P1 ,ID)*
35581 & F4(P2,O(P4),2)*F3(O(P3),P1,1)
35584 *CMZ :- -08/04/02 11:54:39 by Peter Richardson
35585 *-- Author : Peter Richardson
35586 C-----------------------------------------------------------------------
35587 SUBROUTINE HWHS23(ID,ME)
35588 C-----------------------------------------------------------------------
35589 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
35590 C section f fbar ---> fermion fermion via t-channel scalar exchange
35591 C This is diagram 3 from RPV notes
35592 C-----------------------------------------------------------------------
35593 INCLUDE 'HERWIG65.INC'
35595 PARAMETER(NDIAHD=10)
35596 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE
35597 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),
35598 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
35599 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
35600 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
35601 INTEGER P1,P2,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
35602 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
35603 & MA2,SH,TH,UH,IDP,DRTYPE
35604 COMMON/HWHEWS/S(8,8,2),D(8,8)
35606 C--compute the propagator factor
35607 PRE = HALF/(UH-MS(ID))
35612 10 ME(P1,P2,P3,P4) = PRE*B(O(P2),ID)*A( P1 ,ID)*
35613 & F4M(P4,P1,1)*F3M(P2,P3,2)
35616 *CMZ :- -08/04/02 11:54:39 by Peter Richardson
35617 *-- Author : Peter Richardson
35618 C-----------------------------------------------------------------------
35619 SUBROUTINE HWHS24(ID,ME)
35620 C-----------------------------------------------------------------------
35621 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
35622 C section f fbar ---> f f via s-channel scalar exchange
35623 C This is diagram 4 from RPV notes
35624 C-----------------------------------------------------------------------
35625 INCLUDE 'HERWIG65.INC'
35627 PARAMETER(NDIAHD=10)
35628 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE
35629 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),ZI,
35630 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
35631 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
35632 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
35633 INTEGER P1,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
35634 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
35635 & MA2,SH,TH,UH,IDP,DRTYPE
35636 COMMON/HWHEWS/S(8,8,2),D(8,8)
35638 PARAMETER(ZI=(0.0D0,1.0D0))
35639 C--compute the propagator factor
35640 PRE = HALF/(SH-MS(ID)+ZI*MWD(ID))
35644 ME(P1, P1 ,P3,P4) = (0.0D0,0.0D0)
35645 10 ME(P1,O(P1),P3,P4) = PRE*A(P1,ID)*S(2,1,O(P1))*
35646 & ( B(O(P3),ID)*F4M(O(P4),O(P3),3)*S(3,7,O(P3))
35647 & -B( P3 ,ID)*F4M(O(P4), P3 ,7)*MA(3))
35650 *CMZ :- -08/04/02 11:54:39 by Peter Richardson
35651 *-- Author : Peter Richardson
35652 C-----------------------------------------------------------------------
35653 SUBROUTINE HWHS25(ID,ME)
35654 C-----------------------------------------------------------------------
35655 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
35656 C section f fbar ---> f f via u-channel scalar exchange
35657 C This is diagram 5 from RPV notes
35658 C-----------------------------------------------------------------------
35659 INCLUDE 'HERWIG65.INC'
35661 PARAMETER(NDIAHD=10)
35662 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE
35663 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),
35664 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
35665 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
35666 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
35667 INTEGER P1,P2,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
35668 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
35669 & MA2,SH,TH,UH,IDP,DRTYPE
35670 COMMON/HWHEWS/S(8,8,2),D(8,8)
35672 C--compute the propagator factor
35673 PRE = -HALF/(UH-MS(ID))
35678 10 ME(P1,P2,P3,P4) = PRE*B(P1,ID)*A(O(P2),ID)*
35679 & F4M(O(P4),P1,1)*F3M(P2,P3,2)
35682 *CMZ :- -08/04/02 11:54:39 by Peter Richardson
35683 *-- Author : Peter Richardson
35684 C-----------------------------------------------------------------------
35685 SUBROUTINE HWHS26(ID,ME)
35686 C-----------------------------------------------------------------------
35687 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
35688 C section f fbar ---> f f via t-channel scalar exchange
35689 C This is diagram 6 from RPV notes
35690 C-----------------------------------------------------------------------
35691 INCLUDE 'HERWIG65.INC'
35693 PARAMETER(NDIAHD=10)
35694 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE
35695 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),
35696 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
35697 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
35698 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
35699 INTEGER P1,P2,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
35700 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
35701 & MA2,SH,TH,UH,IDP,DRTYPE
35702 COMMON/HWHEWS/S(8,8,2),D(8,8)
35704 C--compute the propagator factor
35705 PRE = HALF/(TH-MS(ID))
35710 10 ME(P1,P2,P3,P4) = PRE*B(P1,ID)*A(O(P2),ID)*
35711 & F4(P2,P4,2)*F3(O(P3),P1,1)
35714 *CMZ :- -08/04/02 11:54:39 by Peter Richardson
35715 *-- Author : Peter Richardson
35716 C-----------------------------------------------------------------------
35717 SUBROUTINE HWHS27(ID,ME)
35718 C-----------------------------------------------------------------------
35719 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
35720 C section f f ---> f fbar via s-channel scalar exchange
35721 C This is diagram 7 from RPV notes
35722 C-----------------------------------------------------------------------
35723 INCLUDE 'HERWIG65.INC'
35725 PARAMETER(NDIAHD=10)
35726 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE
35727 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),ZI,
35728 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
35729 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
35730 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
35731 INTEGER P1,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
35732 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
35733 & MA2,SH,TH,UH,IDP,DRTYPE
35734 COMMON/HWHEWS/S(8,8,2),D(8,8)
35736 PARAMETER(ZI=(0.0D0,1.0D0))
35737 C--compute the propagator factor
35738 PRE =-HALF/(SH-MS(ID)+ZI*MWD(ID))
35742 ME(P1,O(P1),P3,P4) = (0.0D0,0.0D0)
35743 10 ME(P1, P1 ,P3,P4) = PRE*A(P1,ID)*S(1,2,O(P1))*
35744 & ( B( P4 ,ID)*F3(O(P3), P4 ,4)*S(4,8,P4)
35745 & -B(O(P4),ID)*F3(O(P3),O(P4),8)*MA(4))
35748 *CMZ :- -08/04/02 11:54:39 by Peter Richardson
35749 *-- Author : Peter Richardson
35750 C-----------------------------------------------------------------------
35751 SUBROUTINE HWHS28(ID,ME)
35752 C-----------------------------------------------------------------------
35753 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
35754 C section f f ---> f fbar via t-channel scalar exchange
35755 C This is diagram 8 from RPV notes
35756 C-----------------------------------------------------------------------
35757 INCLUDE 'HERWIG65.INC'
35759 PARAMETER(NDIAHD=10)
35760 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE
35761 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),ZI,
35762 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
35763 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
35764 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
35765 INTEGER P1,P2,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
35766 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
35767 & MA2,SH,TH,UH,IDP,DRTYPE
35768 COMMON/HWHEWS/S(8,8,2),D(8,8)
35770 PARAMETER(ZI=(0.0D0,1.0D0))
35771 C--compute the propagator factor
35772 PRE = -HALF/(TH-MS(ID))
35777 10 ME(P1,P2,P3,P4) = PRE*B(P2,ID)*A( P1 ,ID)*
35778 & F4(O(P2),O(P4),2)*F3(O(P3),P1,1)
35781 *CMZ :- -08/04/02 11:54:39 by Peter Richardson
35782 *-- Author : Peter Richardson
35783 C-----------------------------------------------------------------------
35784 SUBROUTINE HWHS29(ID,ME)
35785 C-----------------------------------------------------------------------
35786 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
35787 C section f f ---> f fbar via u-channel scalar exchange
35788 C This is diagram 9 from RPV notes
35789 C-----------------------------------------------------------------------
35790 INCLUDE 'HERWIG65.INC'
35792 PARAMETER(NDIAHD=10)
35793 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE
35794 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),ZI,
35795 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
35796 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
35797 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
35798 INTEGER P1,P2,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
35799 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
35800 & MA2,SH,TH,UH,IDP,DRTYPE
35801 COMMON/HWHEWS/S(8,8,2),D(8,8)
35803 PARAMETER(ZI=(0.0D0,1.0D0))
35804 C--compute the propagator factor
35805 PRE = HALF/(UH-MS(ID))
35810 10 ME(P1,P2,P3,P4) = PRE*B(P2,ID)*A(P1,ID)*
35811 & F3(O(P3),P2,2)*F4(O(P1),O(P4),1)
35814 *CMZ :- -08/04/02 11:54:39 by Peter Richardson
35815 *-- Author : Peter Richardson
35816 C-----------------------------------------------------------------------
35817 SUBROUTINE HWHS30(ID,ME)
35818 C-----------------------------------------------------------------------
35819 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
35820 C section fbar fbar ---> f f via s-channel scalar exchange
35821 C This is diagram 10 from RPV notes
35822 C-----------------------------------------------------------------------
35823 INCLUDE 'HERWIG65.INC'
35825 PARAMETER(NDIAHD=10)
35826 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE
35827 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),ZI,
35828 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
35829 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
35830 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
35831 INTEGER P1,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
35832 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
35833 & MA2,SH,TH,UH,IDP,DRTYPE
35834 COMMON/HWHEWS/S(8,8,2),D(8,8)
35836 PARAMETER(ZI=(0.0D0,1.0D0))
35837 C--compute the propagator factor
35838 PRE = HALF/(SH-MS(ID)+ZI*MWD(ID))
35842 ME(P1,O(P1),P3,P4) = (0.0D0,0.0D0)
35843 10 ME(P1, P1 ,P3,P4) = PRE*A(O(P1),ID)*S(2,1,P1)*
35844 & ( B(O(P3),ID)*F4M(O(P4),O(P3),3)*S(3,7,O(P3))
35845 & -B( P3 ,ID)*F4M(O(P4), P3 ,7)*MA(3))
35848 *CMZ :- -08/04/02 11:54:39 by Peter Richardson
35849 *-- Author : Peter Richardson
35850 C-----------------------------------------------------------------------
35851 SUBROUTINE HWHS31(ID,ME)
35852 C-----------------------------------------------------------------------
35853 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
35854 C section fbar fbar ---> f f via t-channel scalar exchange
35855 C This is diagram 11 from RPV notes
35856 C-----------------------------------------------------------------------
35857 INCLUDE 'HERWIG65.INC'
35859 PARAMETER(NDIAHD=10)
35860 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE
35861 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),ZI,
35862 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
35863 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
35864 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
35865 INTEGER P1,P2,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
35866 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
35867 & MA2,SH,TH,UH,IDP,DRTYPE
35868 COMMON/HWHEWS/S(8,8,2),D(8,8)
35870 PARAMETER(ZI=(0.0D0,1.0D0))
35871 C--compute the propagator factor
35872 PRE = HALF/(TH-MS(ID))
35877 10 ME(P1,P2,P3,P4) = PRE*B(O(P2),ID)*A(O(P1),ID)*
35878 & F4M(O(P4),O(P2),2)*F3M(P1,P3,1)
35881 *CMZ :- -08/04/02 11:54:39 by Peter Richardson
35882 *-- Author : Peter Richardson
35883 C-----------------------------------------------------------------------
35884 SUBROUTINE HWHS32(ID,ME)
35885 C-----------------------------------------------------------------------
35886 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
35887 C section fbar fbar ---> f f via u-channel scalar exchange
35888 C This is diagram 12 from RPV notes
35889 C-----------------------------------------------------------------------
35890 INCLUDE 'HERWIG65.INC'
35892 PARAMETER(NDIAHD=10)
35893 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE
35894 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),ZI,
35895 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
35896 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
35897 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
35898 INTEGER P1,P2,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
35899 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
35900 & MA2,SH,TH,UH,IDP,DRTYPE
35901 COMMON/HWHEWS/S(8,8,2),D(8,8)
35903 PARAMETER(ZI=(0.0D0,1.0D0))
35904 C--compute the propagator factor
35905 PRE =-HALF/(UH-MS(ID))
35910 10 ME(P1,P2,P3,P4) = PRE*B(O(P2),ID)*A(O(P1),ID)*
35911 & F4M(O(P4),O(P1),1)*F3M(P2,P3,2)
35914 *CMZ :- -08/04/02 11:54:39 by Peter Richardson
35915 *-- Author : Peter Richardson
35916 C-----------------------------------------------------------------------
35917 SUBROUTINE HWHS33(ID,ME)
35918 C-----------------------------------------------------------------------
35919 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
35920 C section f f ---> f f via s-channel scalar exchange
35921 C This is diagram 13 from RPV
35922 C-----------------------------------------------------------------------
35923 INCLUDE 'HERWIG65.INC'
35925 PARAMETER(NDIAHD=10)
35926 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE
35927 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),ZI,
35928 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
35929 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
35930 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
35931 INTEGER P1,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
35932 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
35933 & MA2,SH,TH,UH,IDP,DRTYPE
35934 COMMON/HWHEWS/S(8,8,2),D(8,8)
35936 PARAMETER(ZI=(0.0D0,1.0D0))
35937 C--compute the propagator factor
35938 PRE = HALF/(SH-MS(ID)+ZI*MWD(ID))
35942 ME(P1,O(P1),P3,P4) = (0.0D0,0.0D0)
35943 10 ME(P1, P1 ,P3,P4) = PRE*A(P1,ID)*S(1,2,O(P1))*
35944 & ( B(O(P3),ID)*F4M(O(P4),O(P3),3)*S(3,7,O(P3))
35945 & -B( P3 ,ID)*F4M(O(P4), P3 ,7)*MA(3))
35948 *CMZ :- -08/04/02 11:54:39 by Peter Richardson
35949 *-- Author : Peter Richardson
35950 C-----------------------------------------------------------------------
35951 SUBROUTINE HWHS34(ID,ME)
35952 C-----------------------------------------------------------------------
35953 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
35954 C section fbar fbar ---> fbar fbar via t-channel scalar exchange
35955 C This is diagram 14 from RPV notes
35956 C-----------------------------------------------------------------------
35957 INCLUDE 'HERWIG65.INC'
35959 PARAMETER(NDIAHD=10)
35960 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE
35961 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),ZI,
35962 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
35963 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
35964 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
35965 INTEGER P1,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
35966 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
35967 & MA2,SH,TH,UH,IDP,DRTYPE
35968 COMMON/HWHEWS/S(8,8,2),D(8,8)
35970 PARAMETER(ZI=(0.0D0,1.0D0))
35971 C--compute the propagator factor
35972 PRE = HALF/(SH-MS(ID)+ZI*MWD(ID))
35976 ME(P1,O(P1),P3,P4) = (0.0D0,0.0D0)
35977 10 ME(P1, P1 ,P3,P4) = PRE*A(O(P1),ID)*S(2,1,P1)*
35978 & ( B( P4 ,ID)*F3(P3, P4 ,4)*S(4,8,P4)
35979 & -B(O(P4),ID)*F3(P3,O(P4),8)*MA(4))
35982 *CMZ :- -18/05/99 20.33.45 by Kosuke Odagiri
35983 *-- Author : Kosuke Odagiri
35984 C-----------------------------------------------------------------------
35985 FUNCTION HWHSS1(S, T, U, M3, M4, SGN, CLL, CLR, CRL, CRR)
35986 C-----------------------------------------------------------------------
35987 C QQ(BAR) -> GAUGINOS
35988 C-----------------------------------------------------------------------
35990 DOUBLE PRECISION HWHSS1, S, T, U, M3, M4, SGN
35991 DOUBLE COMPLEX CLL, CLR, CRL, CRR
35993 & (DCONJG(CLL)*CLL+DCONJG(CRR)*CRR)*(U-M3*M3)*(U-M4*M4)+
35994 & (DCONJG(CLR)*CLR+DCONJG(CRL)*CRL)*(T-M3*M3)*(T-M4*M4)+
35995 & (DCONJG(CLL)*CLR+DCONJG(CRL)*CRR)*2.*SGN*M3*M4*S )
35999 *CMZ :- -10/10/01 10:38:15 by Peter Richardson
36000 *-- Author : Kosuke Odagiri
36001 C-----------------------------------------------------------------------
36002 FUNCTION HWHSS2(S, T, U, M3, M4, SGN, CLL, CLR, CRL, CRR)
36003 C-----------------------------------------------------------------------
36004 C LL(BAR) -> GAUGINOS (including beam polarization)
36005 C-----------------------------------------------------------------------
36006 INCLUDE 'HERWIG65.INC'
36007 DOUBLE PRECISION HWHSS2, S, T, U, M3, M4, SGN
36008 DOUBLE COMPLEX CLL, CLR, CRL, CRR
36010 C--first the incoming left electron
36011 & (ONE-EPOLN(3))*(ONE+PPOLN(3))*DREAL(
36012 & DCONJG(CLL)*CLL*(U-M3*M3)*(U-M4*M4)+
36013 & DCONJG(CLR)*CLR*(T-M3*M3)*(T-M4*M4)+
36014 & DCONJG(CLL)*CLR*2.*SGN*M3*M4*S )
36015 C--then the incoming right electron
36016 &+(ONE+EPOLN(3))*(ONE-PPOLN(3))*DREAL(
36017 & DCONJG(CRR)*CRR*(U-M3*M3)*(U-M4*M4)+
36018 & DCONJG(CRL)*CRL*(T-M3*M3)*(T-M4*M4)+
36019 & DCONJG(CRL)*CRR*2.*SGN*M3*M4*S )
36023 *CMZ :- -31/03/00 17:54:05 by Peter Richardson
36024 *-- Author : Kosuke Odagiri
36025 C-----------------------------------------------------------------------
36027 C-----------------------------------------------------------------------
36028 C SUSY 2 PARTON -> 2 GAUGINOS PROCESSES (1 - 3)
36029 C -> GAUGINO + SPARTON PROCESSES (4 - 7)
36030 C-----------------------------------------------------------------------
36031 INCLUDE 'HERWIG65.INC'
36032 DOUBLE PRECISION HWRGEN, HWUALF, HWUAEM, EPS, HCS, RCS, DIST,
36033 & ML(6), ML2(6), MR(6), MR2(6), MCH(2), MCH2(2), MNU(4), MNU2(4),
36034 & MSQK, MG, MG2, SM, DM, DAB, QPE, SGN, PF, SQPE, EMSC2,
36035 & FAC0, FACA, FACB, FACC, S, T, T3, U, U4, SN2TH
36036 DOUBLE PRECISION M1(2,2,6), M2(4,4,6), M3(2,4,6,6),
36037 & M4(4,6), M5(2,6,6), M6L(4,6), M6R(4,6), M7(2,2,6,6),
36038 & XA(4), XB(4), XC(4), XD(4), MZ, MW, XW, SQXW, S2W, S22W
36039 INTEGER I, IQ, IQ1, IQ2, IQ3, IQ4, IG1, IG2, IG3, IG4,
36040 & ID1, ID2, IGL, SSL, SSR, GLU, SSNU, SSCH, INU, ICH, IWD(6), IPB
36041 DOUBLE PRECISION DQD(6), DQU(6), HWHSS1
36042 EXTERNAL HWRGEN, HWUALF, HWUAEM, HWHSS1
36043 SAVE HCS, M1, M2, M3, M4, M5, M6L, M6R, M7
36044 PARAMETER (EPS = 1.D-9, IGL = 49, SSL = 400, SSR = 412, GLU = 449)
36045 PARAMETER (SSNU = 449, SSCH = 453, INU = 49, ICH = 53)
36046 DOUBLE COMPLEX Z, Z0, C1, C2, C3, GZ, GW, CLL, CLR, CRL, CRR
36047 PARAMETER (Z = (0.D0,1.D0), Z0 = (0.D0,0.D0))
36048 EQUIVALENCE (MZ, RMASS(200)), (MW, RMASS(198)), (MG, RMASS(GLU))
36049 EQUIVALENCE (XA(1), ZMIXSS(1,1)), (XA(2), ZMIXSS(2,1))
36050 EQUIVALENCE (XA(3), ZMIXSS(3,1)), (XA(4), ZMIXSS(4,1))
36051 EQUIVALENCE (XB(1), ZMIXSS(1,2)), (XB(2), ZMIXSS(2,2))
36052 EQUIVALENCE (XB(3), ZMIXSS(3,2)), (XB(4), ZMIXSS(4,2))
36053 EQUIVALENCE (XC(1), ZMIXSS(1,3)), (XC(2), ZMIXSS(2,3))
36054 EQUIVALENCE (XC(3), ZMIXSS(3,3)), (XC(4), ZMIXSS(4,3))
36055 EQUIVALENCE (XD(1), ZMIXSS(1,4)), (XD(2), ZMIXSS(2,4))
36056 EQUIVALENCE (XD(3), ZMIXSS(3,4)), (XD(4), ZMIXSS(4,4))
36057 DATA IWD/2,1,4,3,6,5/
36058 DATA DQD/ONE,ZERO,ONE,ZERO,ONE,ZERO/
36059 DATA DQU/ZERO,ONE,ZERO,ONE,ZERO,ONE/
36061 CALL HWSGEN(.FALSE.)
36063 RCS = HCS*HWRGEN(0)
36065 SN2TH = 0.25D0 - 0.25D0*COSTH**2
36066 S=XX(1)*XX(2)*PHEP(5,3)**2
36068 FAC0 = FACTSS*HWUAEM(EMSC2)
36069 c prefactor for pair production, includes 1/Nc colour factor
36070 FACA = FAC0*HWUAEM(EMSC2) / CAFAC
36071 c prefactor for qq -> gaugino + gluino, includes CF/Nc colour factor
36072 FACB = FAC0*HWUALF(1,EMSCA) * CFFAC / CAFAC
36073 c prefactor for qg -> gaugino + squark, includes 1/2Nc colour factor
36074 FACC = FACB / CFFAC / TWO
36076 GZ = S-MZ**2+Z*S/MZ*GAMZ
36077 GW = S-MW**2+Z*S/MW*GAMW
36081 ML(IQ) = RMASS(IQ1)
36082 ML2(IQ) = ML(IQ)**2
36083 MR(IQ) = RMASS(IQ2)
36084 MR2(IQ) = MR(IQ)**2
36088 S22W = XW * (TWO - XW)
36091 MNU(IG1) = RMASS(IG1+SSNU)
36092 MNU2(IG1) = MNU(IG1)**2
36095 MCH(IG1) = RMASS(IG1+SSCH)
36096 MCH2(IG1) = MCH(IG1)**2
36103 SM = MCH(IG1) + MCH(IG2)
36105 IF (QPE.GE.ZERO) THEN
36106 DM = MCH(IG1) - MCH(IG2)
36107 SQPE = SQRT(QPE*(S-DM**2))
36109 T = (SQPE*COSTH - S + MCH2(IG1) + MCH2(IG2)) / TWO
36110 U = - T - S + MCH2(IG1) + MCH2(IG2)
36111 DAB = ABS(FLOAT(IG1+IG2-3))
36112 C1 = (-WMXVSS(IG1,2)*WMXVSS(IG2,2)+DAB*S22W/XW)/S2W/GZ
36113 C2 = (-WMXUSS(IG1,2)*WMXUSS(IG2,2)+DAB*S22W/XW)/S2W/GZ
36114 SGN = WSGNSS(IG1)*WSGNSS(IG2)
36115 C--PR bug fix 31/03/00
36117 C3 = -DAB*QFCH(IQ)/S
36118 CLL = C3 - LFCH(IQ)*C1 +
36119 & DQD(IQ)*WMXVSS(IG1,1)*WMXVSS(IG2,1)/((U-ML2(IWD(IQ)))*XW)
36120 CLR = C3 - LFCH(IQ)*C2 -
36121 & DQU(IQ)*WMXUSS(IG1,1)*WMXUSS(IG2,1)/((T-ML2(IWD(IQ)))*XW)
36122 CRL = C3 - RFCH(IQ)*C1
36123 CRR = C3 - RFCH(IQ)*C2
36124 M1(IG1,IG2,IQ)=FACA*PF*
36125 & HWHSS1(S,T,U,MCH(IG1),MCH(IG2),SGN,CLL,CLR,CRL,CRR)
36130 M1(IG1,IG2,IQ) = ZERO
36140 SM = MNU(IG1) + MNU(IG2)
36142 IF (QPE.GE.ZERO) THEN
36143 DM = MNU(IG1) - MNU(IG2)
36144 SQPE = SQRT(QPE*(S-DM**2))
36146 T = (SQPE*COSTH - S + MNU2(IG1) + MNU2(IG2)) / TWO
36147 U = - T - S + MNU2(IG1) + MNU2(IG2)
36148 C1 = (XD(IG1)*XD(IG2)-XC(IG1)*XC(IG2))/S2W/GZ
36150 SGN = ZSGNSS(IG1)*ZSGNSS(IG2)
36152 CLL =LFCH(IQ)*C1+SLFCH(IQ,IG1)*SLFCH(IQ,IG2)/(U-ML2(IQ))
36153 CLR =LFCH(IQ)*C2-SLFCH(IQ,IG1)*SLFCH(IQ,IG2)/(T-ML2(IQ))
36154 CRL =RFCH(IQ)*C1-SRFCH(IQ,IG1)*SRFCH(IQ,IG2)/(T-MR2(IQ))
36155 CRR =RFCH(IQ)*C2+SRFCH(IQ,IG1)*SRFCH(IQ,IG2)/(U-MR2(IQ))
36156 M2(IG1,IG2,IQ) = FACA*PF*HALF*
36157 & HWHSS1(S,T,U,MNU(IG1),MNU(IG2),SGN,CLL,CLR,CRL,CRR)
36161 M2(IG1,IG2,IQ) = ZERO
36171 SM = MCH(IG1) + MNU(IG2)
36173 IF (QPE.GE.ZERO) THEN
36174 DM = MCH(IG1) - MNU(IG2)
36175 SQPE = SQRT(QPE*(S-DM**2))
36177 T = (SQPE*COSTH - S + MCH2(IG1) + MNU2(IG2)) / TWO
36178 U = - T - S + MCH2(IG1) + MNU2(IG2)
36179 C1 = XA(IG2)+S2W/XW*XB(IG2)
36180 c note the new s-channel signs below. (PR BUG FIX 3/9/01)
36181 C2 = (-XD(IG2)*WMXVSS(IG1,2)/SQXW+C1*WMXVSS(IG1,1))/GW
36182 C3 = ( XC(IG2)*WMXUSS(IG1,2)/SQXW+C1*WMXUSS(IG1,1))/GW
36183 SGN = WSGNSS(IG1)*ZSGNSS(IG2)
36188 CLL = C2+WMXVSS(IG1,1)*SLFCH(IQ3,IG2)/(U-ML2(IQ3))
36189 CLR = C3-WMXUSS(IG1,1)*SLFCH(IQ4,IG2)/(T-ML2(IQ4))
36190 M3(IG1,IG2,IQ1,IQ2) = FACA*PF*VCKM(IQ1,IQ2)/XW*
36191 & HWHSS1(S,T,U,MCH(IG1),MNU(IG2),SGN,CLL,CLR,Z0,Z0)
36197 M3(IG1,IG2,IQ1,IQ2) = ZERO
36209 IF (QPE.GE.ZERO) THEN
36211 SQPE = SQRT(QPE*(S-DM**2))
36213 T = (SQPE*COSTH - S + MG2 + MNU2(IG1)) / TWO
36214 U = - T - S + MG2 + MNU2(IG1)
36216 CLL = SLFCH(IQ,IG1)/(U-ML2(IQ))
36217 CLR = - SLFCH(IQ,IG1)/(T-ML2(IQ))
36218 CRL = - SRFCH(IQ,IG1)/(T-MR2(IQ))
36219 CRR = SRFCH(IQ,IG1)/(U-MR2(IQ))
36220 M4(IG1,IQ) = FACB*PF*
36221 & HWHSS1(S,T,U,MNU(IG1),MG,ZSGNSS(IG1),CLL,CLR,CRL,CRR)
36235 IF (QPE.GE.ZERO) THEN
36237 SQPE = SQRT(QPE*(S-DM**2))
36239 T = (SQPE*COSTH - S + MCH2(IG1) + MG2) / TWO
36240 U = - T - S + MCH2(IG1) + MG2
36245 CLL = WMXVSS(IG1,1)/(U-ML2(IQ3))
36246 CLR = - WMXUSS(IG1,1)/(T-ML2(IQ4))
36247 M5(IG1,IQ1,IQ2) = FACB*PF*VCKM(IQ1,IQ2)/XW*
36248 & HWHSS1(S,T,U,MCH(IG1),MG,WSGNSS(IG1),CLL,CLR,Z0,Z0)
36254 M5(IG1,IQ1,IQ2) = ZERO
36265 SM = MNU(IG1)+ML(IQ)
36267 IF (QPE.GE.ZERO) THEN
36268 DM = MNU(IG1)-ML(IQ)
36269 SQPE = SQRT(QPE*(S-DM**2))
36271 T3 = (SQPE*COSTH - S - SM*DM) / TWO
36273 C--KO bug fix 06/10/00
36274 M6L(IG1,IQ) = FACC*PF*((QMIXSS(IQ,1,1)*SLFCH(IQ,IG1))**2
36275 & +(QMIXSS(IQ,2,1)*SRFCH(IQ,IG1))**2)*
36276 & T3/S/U4*(-U4+TWO*SM*DM/T3/U4*SQPE*SQPE*SN2TH)
36281 SM = MNU(IG1)+MR(IQ)
36283 IF (QPE.GE.ZERO) THEN
36284 DM = MNU(IG1)-MR(IQ)
36285 SQPE = SQRT(QPE*(S-DM**2))
36287 T3 = (SQPE*COSTH - S - SM*DM) / TWO
36289 C--PR bug fix 28/08/01
36290 M6R(IG1,IQ) = FACC*PF * ((QMIXSS(IQ,1,2)*SLFCH(IQ,IG1))**2
36291 & +(QMIXSS(IQ,2,2)*SRFCH(IQ,IG1))**2)*
36292 & T3/S/U4*(-U4+TWO*SM*DM/T3/U4*SQPE*SQPE*SN2TH)
36307 c U initiated processes
36313 SM = MCH(IG1) + MSQK
36315 IF (((I.EQ.1).OR.(IQ2.EQ.3)).AND.(QPE.GE.ZERO)) THEN
36316 DM = MCH(IG1) - MSQK
36317 SQPE = SQRT(QPE*(S-DM**2))
36319 T3 = (SQPE*COSTH - S - SM*DM) / TWO
36321 M7(I,IG1,IQ3,IQ4)=FACC*PF*WMXUSS(IG1,1)**2*VCKM(IQ1,IQ2)
36322 & /XW*T3/S/U4*(-U4+TWO*SM*DM/T3/U4*SQPE*SQPE*SN2TH)*
36323 & QMIXSS(IQ4,1,I)**2
36325 M7(I,IG1,IQ3,IQ4) = ZERO
36327 c D initiated processes
36333 SM = MCH(IG1) + MSQK
36335 IF (((I.EQ.1).OR.(IQ1.EQ.3)).AND.(QPE.GE.ZERO)) THEN
36336 DM = MCH(IG1) - MSQK
36337 SQPE = SQRT(QPE*(S-DM**2))
36339 T3 = (SQPE*COSTH - S - SM*DM) / TWO
36341 M7(I,IG1,IQ4,IQ3)=FACC*PF*WMXVSS(IG1,1)**2*VCKM(IQ1,IQ2)
36342 & /XW*T3/S/U4*(-U4+TWO*SM*DM/T3/U4*SQPE*SQPE*SN2TH)*
36343 & QMIXSS(IQ3,1,I)**2
36345 M7(I,IG1,IQ4,IQ3) = ZERO
36353 c _ _ ~+ ~- ~o ~o ~o ~
36354 c q q , q q -> X X , X X , X g
36357 IF (DISF(ID1,1).LT.EPS) GOTO 1
36367 IF (DISF(ID2,2).LT.EPS) GOTO 1
36368 DIST = DISF(ID1,1)*DISF(ID2,2)
36373 HCS = HCS + DIST*M1(IG1,IG2,IQ)
36374 C--PR bug fix 10/10/01
36375 IF (GENEV.AND.HCS.GT.RCS) THEN
36376 IF(ID2.LT.ID1) COSTH=-COSTH
36377 CALL HWHSSS(IG3,0,IG4,0,2134,21,*9)
36385 IF (IG2.GE.IG1) HCS = HCS + DIST*M2(IG1,IG2,IQ)
36386 C--PR bug fix 10/10/01
36387 IF (GENEV.AND.HCS.GT.RCS) THEN
36388 IF(ID2.LT.ID1) COSTH=-COSTH
36389 CALL HWHSSS(IG3,0,IG4,0,2134,22,*9)
36392 HCS = HCS + DIST*M4(IG1,IQ)
36393 C--PR bug fix 10/10/01
36394 IF (GENEV.AND.HCS.GT.RCS) THEN
36395 IF(ID2.LT.ID1) COSTH=-COSTH
36396 CALL HWHSSS(IG3,0,IGL,0, IPB,24,*9)
36401 c q q', q q' -> X X , X g
36405 c ud(+), ud(-), du(-), du(+)
36408 IF(VCKM(IQ1,IQ2).GT.EPS) THEN
36413 IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN
36414 DIST = DISF(ID1,1)*DISF(ID2,2)
36419 HCS = HCS + DIST*M3(IG1,IG2,IQ1,IQ2)
36420 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IG3,0,IG4,0,2134,23,*9)
36422 HCS = HCS + DIST*M5(IG1,IQ1,IQ2)
36423 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IG3,0,IGL,0,2431,25,*9)
36430 IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN
36431 DIST = DISF(ID1,1)*DISF(ID2,2)
36436 HCS = HCS + DIST*M3(IG1,IG2,IQ1,IQ2)
36437 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IG4,0,IG3,0,2134,23,*9)
36439 HCS = HCS + DIST*M5(IG1,IQ1,IQ2)
36440 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IGL,0,IG3,0,3124,25,*9)
36447 IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN
36448 DIST = DISF(ID1,1)*DISF(ID2,2)
36453 HCS = HCS + DIST*M3(IG1,IG2,IQ1,IQ2)
36454 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IG4,0,IG3,0,2134,23,*9)
36456 HCS = HCS + DIST*M5(IG1,IQ1,IQ2)
36457 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IGL,0,IG3,0,2314,25,*9)
36464 IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN
36465 DIST = DISF(ID1,1)*DISF(ID2,2)
36470 HCS = HCS + DIST*M3(IG1,IG2,IQ1,IQ2)
36471 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IG3,0,IG4,0,2134,23,*9)
36473 HCS = HCS + DIST*M5(IG1,IQ1,IQ2)
36474 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IG3,0,IGL,0,4132,25,*9)
36481 c g q , g q , q g , q g -> X q , X q'
36489 IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN
36490 DIST = DISF(ID1,1)*DISF(ID2,2)
36493 HCS = HCS + DIST*M6L(IG1,IQ1)
36494 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IG3,0,ID2,0,2431,26,*9)
36495 HCS = HCS + DIST*M6R(IG1,IQ1)
36496 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IG3,0,ID2,2,2431,26,*9)
36503 IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN
36504 DIST = DISF(ID1,1)*DISF(ID2,2)
36507 HCS = HCS + DIST*M6L(IG1,IQ1)
36508 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IG3,0,ID2,0,4132,26,*9)
36509 HCS = HCS + DIST*M6R(IG1,IQ1)
36510 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IG3,0,ID2,2,4132,26,*9)
36517 IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN
36518 DIST = DISF(ID1,1)*DISF(ID2,2)
36521 HCS = HCS + DIST*M6L(IG1,IQ1)
36522 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(ID1,0,IG3,0,3124,26,*9)
36523 HCS = HCS + DIST*M6R(IG1,IQ1)
36524 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(ID1,2,IG3,0,3124,26,*9)
36531 IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN
36532 DIST = DISF(ID1,1)*DISF(ID2,2)
36535 HCS = HCS + DIST*M6L(IG1,IQ1)
36536 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(ID1,0,IG3,0,2314,26,*9)
36537 HCS = HCS + DIST*M6R(IG1,IQ1)
36538 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(ID1,2,IG3,0,2314,26,*9)
36546 IF (VCKM(IQ1,IQ2).LT.EPS) GOTO 3
36555 HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(1,IG1,IQ3,IQ4)
36556 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IG3,0,IQ4,0,2431,27,*9)
36557 HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(2,IG1,IQ3,IQ4)
36558 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IG3,0,IQ4,2,2431,27,*9)
36560 HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(1,IG1,IQ4,IQ3)
36561 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IG4,0,IQ3,0,2431,27,*9)
36562 HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(2,IG1,IQ4,IQ3)
36563 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IG4,0,IQ3,2,2431,27,*9)
36566 HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(1,IG1,IQ3,IQ4)
36567 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ4,0,IG3,0,3124,27,*9)
36568 HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(2,IG1,IQ3,IQ4)
36569 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ4,2,IG3,0,3124,27,*9)
36571 HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(1,IG1,IQ4,IQ3)
36572 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ3,0,IG4,0,3124,27,*9)
36573 HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(2,IG1,IQ4,IQ3)
36574 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ3,2,IG4,0,3124,27,*9)
36579 HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(1,IG1,IQ3,IQ4)
36580 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IG4,0,IQ4,1,4132,27,*9)
36581 HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(2,IG1,IQ3,IQ4)
36582 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IG4,0,IQ4,3,4132,27,*9)
36584 HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(1,IG1,IQ4,IQ3)
36585 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IG3,0,IQ3,1,4132,27,*9)
36586 HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(2,IG1,IQ4,IQ3)
36587 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IG3,0,IQ3,3,4132,27,*9)
36590 HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(1,IG1,IQ3,IQ4)
36591 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ4,1,IG4,0,2314,27,*9)
36592 HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(2,IG1,IQ3,IQ4)
36593 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ4,3,IG4,0,2314,27,*9)
36595 HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(1,IG1,IQ4,IQ3)
36596 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ3,1,IG3,0,2314,27,*9)
36597 HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(2,IG1,IQ4,IQ3)
36598 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ3,3,IG3,0,2314,27,*9)
36608 CALL HWETWO(.TRUE.,.TRUE.)
36610 C Calculate coefficients for constructing spin density matrices
36611 C Set to zero for now
36612 CALL HWVZRO(7,GCOEF)
36616 *CMZ :- -18/05/99 20.33.45 by Kosuke Odagiri
36617 *-- Author : Kosuke Odagiri
36618 C-----------------------------------------------------------------------
36620 C-----------------------------------------------------------------------
36621 C SUSY 2 PARTON -> 2 SLEPTON PROCESSES
36622 C-----------------------------------------------------------------------
36623 INCLUDE 'HERWIG65.INC'
36624 DOUBLE PRECISION HWRGEN, HWUAEM, EPS, HCS, RCS, DIST, S, PF, QPE,
36625 & FACTR, SN2TH, MZ, MW, ME2(2,2,6,2), ME2W(2,3), EMSC2, GW2
36626 INTEGER IQ, IQ1, IQ2, ID1, ID2, IL, IL1, IL2, I, J
36627 EXTERNAL HWRGEN, HWUAEM
36628 SAVE HCS, ME2, ME2W
36629 PARAMETER (EPS = 1.D-9)
36630 DOUBLE COMPLEX Z, GZ, A, BL, BR, CL, CR, D, E
36631 PARAMETER (Z = (0.D0,1.D0))
36632 EQUIVALENCE (MZ, RMASS(200)), (MW, RMASS(198))
36634 S = XX(1)*XX(2)*PHEP(5,3)**2
36636 EMSCA = SQRT(EMSC2)
36637 CALL HWSGEN(.FALSE.)
36639 RCS = HCS*HWRGEN(0)
36641 SN2TH = 0.25D0 - 0.25D0*COSTH**2
36642 FACTR = FACTSS*HWUAEM(EMSC2)**2/CAFAC*SN2TH
36643 GZ = (S-MZ**2+Z*S*GAMZ/MZ)/S
36644 GW2 = ((ONE-MW**2/S)**2+(GAMW/MW)**2)*(TWO*SWEIN)**2
36651 IF (((I.NE.J).AND.(IL.NE.5)).OR.
36652 & ((I.EQ.2).AND.(((IL/2)*2).EQ.IL))) THEN
36655 ID1 = 412 + I*12 + IL
36656 ID2 = 412 + J*12 + IL
36658 QPE = S-(RMASS(ID1)+RMASS(ID2))**2
36660 IF (QPE.GT.ZERO) THEN
36661 PF = SQRT(QPE*(S-(RMASS(ID1)-RMASS(ID2))**2))/S
36663 A = QFCH(IL1)*QFCH(IQ)
36666 CL = LMIXSS(IL,1,I)*LMIXSS(IL,1,J)
36667 CR = LMIXSS(IL,2,I)*LMIXSS(IL,2,J)
36668 D = (A+BL*LFCH(IQ))*CL+(A+BR*LFCH(IQ))*CR
36669 E = (A+BL*RFCH(IQ))*CL+(A+BR*RFCH(IQ))*CR
36670 ME2(I,J,IL,IQ)=FACTR*PF**3
36671 $ *DREAL(DCONJG(D)*D+DCONJG(E)*E)
36685 IF ((IL.NE.3).AND.(I.EQ.2)) THEN
36688 ID1 = 411 + IL*2 + I*12
36690 QPE = S-(RMASS(ID1)+RMASS(ID2))**2
36692 IF (QPE.GT.ZERO) THEN
36693 PF = SQRT(QPE*(S-(RMASS(ID1)-RMASS(ID2))**2))/S
36694 ME2W(I,IL)=FACTR*PF**3/GW2
36695 IF (IL.EQ.3) ME2W(I,3)=ME2W(I,3)*LMIXSS(5,1,I)**2
36705 IF (DISF(ID1,1).LT.EPS) GOTO 1
36711 IQ = ID1 - ((ID1-1)/2)*2
36712 IF (DISF(ID2,2).LT.EPS) GOTO 1
36713 DIST = DISF(ID1,1)*DISF(ID2,2)
36719 HCS = HCS + DIST*ME2(I,J,IL,IQ)
36720 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IL1,2,IL2,3,2134,30,*9)
36726 c ud(+), ud(-), du(-), du(+)
36729 IF(VCKM(IQ1,IQ2).GT.EPS) THEN
36734 IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN
36735 DIST = VCKM(IQ1,IQ2)*DISF(ID1,1)*DISF(ID2,2)
36739 HCS = HCS + DIST*ME2W(1,IL)
36740 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IL1,5,IL2,4,2134,30,*9)
36742 HCS = HCS + DIST*ME2W(2,3)
36743 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(5,7,6,4,2134,30,*9)
36749 IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN
36750 DIST = VCKM(IQ1,IQ2)*DISF(ID1,1)*DISF(ID2,2)
36754 HCS = HCS + DIST*ME2W(1,IL)
36755 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IL1,5,IL2,4,2134,30,*9)
36757 HCS = HCS + DIST*ME2W(2,3)
36758 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(5,7,6,4,2134,30,*9)
36764 IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN
36765 DIST = VCKM(IQ1,IQ2)*DISF(ID1,1)*DISF(ID2,2)
36769 HCS = HCS + DIST*ME2W(1,IL)
36770 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IL1,4,IL2,5,2134,30,*9)
36772 HCS = HCS + DIST*ME2W(2,3)
36773 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(5,6,6,5,2134,30,*9)
36779 IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN
36780 DIST = VCKM(IQ1,IQ2)*DISF(ID1,1)*DISF(ID2,2)
36784 HCS = HCS + DIST*ME2W(1,IL)
36785 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IL1,4,IL2,5,2134,30,*9)
36787 HCS = HCS + DIST*ME2W(2,3)
36788 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(5,6,6,5,2134,30,*9)
36799 CALL HWETWO(.TRUE.,.TRUE.)
36801 C Calculate coefficients for constructing spin density matrices
36802 C Set to zero for now
36803 CALL HWVZRO(7,GCOEF)
36807 *CMZ :- -18/05/99 20.33.45 by Kosuke Odagiri
36808 *-- Author : Kosuke Odagiri
36809 C-----------------------------------------------------------------------
36811 C-----------------------------------------------------------------------
36812 C SUSY HARD 2 PARTON -> 2 SPARTON PROCESSES
36813 C-----------------------------------------------------------------------
36814 INCLUDE 'HERWIG65.INC'
36815 DOUBLE PRECISION HWRGEN, HWUALF, EPS, HCS, RCS, DIST, NC, NC2,
36816 & NC2C, ML2(6), ML4(6), MR2(6), MR4(6), MG2, SM, DM, QPE,
36817 & SQPE, FACTR, AFAC, AF, BONE, CFAC, CFC2, CFC3, CONE,
36818 & CONN, CONT, CONU, CONL, CONR, DFAC, DONE, PF, S,
36819 & S2, TT, TT2, TMG, TMG2, UU, UU2, UMG, UMG2,
36820 & L, L2, TTML, UUML, R, R2, TTMR, UUMR, SN2TH
36822 & AUSTLL(6), AUSTRR(6),
36823 & ASTULL(6,6), ASTURR(6,6), ASTULR(6,6), ASTURL(6,6),
36824 & AUTSLL(6,6), AUTSRR(6,6), AUTSLR(6,6), AUTSRL(6,6),
36825 & BSTULL(6), BSTURR(6), BSTULR(6), BSTURL(6),
36826 & BSUTLL(6), BSUTRR(6), BSUTLR(6), BSUTRL(6),
36827 & BUTSLL(6), BUTSRR(6), BUTSLR(6), BUTSRL(6),
36828 & BUSTLL(6), BUSTRR(6), BUSTLR(6), BUSTRL(6),
36829 & CSTU(6), CSUT(6), CSTUL(6), CSTUR(6), CSUTL(6), CSUTR(6),
36830 & CTSUL(6), CTSUR(6), CTUSL(6), CTUSR(6), DUTS, DTSU, DSTU
36831 INTEGER IQ, IQ1, IQ2, ID1, ID2, ID2MIN, IGL, SSL, SSR, GLU
36832 EXTERNAL HWRGEN, HWUALF
36833 SAVE HCS, AUSTLL, AUSTRR, ASTULL, ASTURR, ASTULR, ASTURL,
36834 & AUTSLL, AUTSRR, AUTSLR, AUTSRL, BSTULL, BSTURR, BSTULR,
36835 & BSTURL, BSUTLL, BSUTRR, BSUTLR, BSUTRL, BUTSLL, BUTSRR, BUTSLR,
36836 & BUTSRL, BUSTLL, BUSTRR, BUSTLR, BUSTRL, CSTU, CSUT, CSTUL, CSTUR,
36837 & CSUTL, CSUTR, CTSUL, CTSUR, CTUSL, CTUSR, DUTS, DTSU, DSTU
36838 PARAMETER (EPS = 1.D-9, IGL = 49, SSL = 400, SSR = 412, GLU = 449)
36839 CALL HWSGEN(.FALSE.)
36841 RCS = HCS*HWRGEN(0)
36843 SN2TH = 0.25D0 - 0.25D0*COSTH**2
36844 S = XX(1)*XX(2)*PHEP(5,3)**2
36845 FACTR = FACTSS*HWUALF(1,EMSCA)**2
36848 NC2C = ONE - ONE/NC2
36849 AFAC = FACTR*NC2C/FOUR
36850 CFAC = FACTR*CFFAC/FOUR
36851 CFC2 = FACTR/CFFAC/FOUR
36855 MG2 = RMASS(GLU)**2
36859 ML2(IQ) = RMASS(IQ1)**2
36860 ML4(IQ) = ML2(IQ)**2
36861 MR2(IQ) = RMASS(IQ2)**2
36862 MR4(IQ) = MR2(IQ)**2
36864 c gluino pair production
36866 IF (QPE.GE.ZERO) THEN
36869 TT = (SQPE*COSTH - S) / TWO
36877 & DFAC*PF/TWO*(UU2+TT2+FOUR*MG2*S*SQPE**2*SN2TH/TT/UU)/S2/TT/UU
36893 CONE = TWO*PF**2*SN2TH
36894 CONL = CONE/UUML/TTML
36895 CONR = CONE/UUMR/TTMR
36896 CONT = (UU2-L2)*CONL+(UU2-R2)*CONR+L2/TTML**2+R2/TTMR**2
36897 CONU = (TT2-L2)*CONL+(TT2-R2)*CONR+L2/UUML**2+R2/UUMR**2
36898 CONN = CFAC*(PF-PF/NC2/(CONT+CONU)*( S2*(CONL+CONR)+
36899 & L2*((TT-UU)*CONL/CONE)**2+R2*((TT-UU)*CONR/CONE)**2 ))
36900 CSTU(IQ) = CONT*CONN
36901 CSUT(IQ) = CONU*CONN
36912 c left handed squark (identical flavour) pair production
36914 QPE = S - FOUR*ML2(IQ)
36915 IF (QPE.GE.ZERO) THEN
36918 TT = (SQPE*COSTH - S) / TWO
36925 CONE = CFC2*PF*((SQPE*PF*SN2TH)**2+ML4(IQ))/TT2/UU2
36926 CONN = CONE-CONE*S2/(TT2+UU2)/NC2
36927 CSTUL(IQ) = CONN*UU2
36928 CSUTL(IQ) = CONN*TT2
36932 TMG = TT+ML2(IQ)-MG2
36934 UMG = UU+ML2(IQ)-MG2
36936 BONE = AFAC*PF*MG2*S*(HALF-TMG*UMG/(TMG2+UMG2)/NC)
36937 BSTULL(IQ) = BONE/TMG2
36938 BSUTLL(IQ) = BONE/UMG2
36942 AF = AFAC*PF*PF**2*SN2TH
36943 BONE = AF/TMG2-AF*S/(HALF*S2+TMG2)/TMG/NC
36944 BUTSLL(IQ) = BONE*S2
36945 BUSTLL(IQ) = BONE*TWO*TMG2
36947 c q q -> q'q' q =/= q'
36949 AUSTLL(IQ) = TWO*AF
36959 c right handed squark (identical flavour) pair production
36960 QPE = S - FOUR*MR2(IQ)
36961 IF (QPE.GE.ZERO) THEN
36964 TT = (SQPE*COSTH - S) / TWO
36971 CONE = CFC2*PF*((SQPE*PF*SN2TH)**2+MR4(IQ))/TT2/UU2
36972 CONN = CONE-CONE*S2/(TT2+UU2)/NC2
36973 CSTUR(IQ) = CONN*UU2
36974 CSUTR(IQ) = CONN*TT2
36978 TMG = TT+MR2(IQ)-MG2
36980 UMG = UU+MR2(IQ)-MG2
36982 BONE = AFAC*PF*MG2*S*(HALF-TMG*UMG/(TMG2+UMG2)/NC)
36983 BSTURR(IQ) = BONE/TMG2
36984 BSUTRR(IQ) = BONE/UMG2
36988 AF = AFAC*PF*PF**2*SN2TH
36989 BONE = AF/TMG2-AF*S/(HALF*S2+TMG2)/TMG/NC
36990 BUTSRR(IQ) = BONE*S2
36991 BUSTRR(IQ) = BONE*TWO*TMG2
36993 c q q -> q'q' q =/= q'
36995 AUSTRR(IQ) = TWO*AF
37005 c left and right handed squark (identical flavour) pair production
37008 SM = RMASS(IQ1)+RMASS(IQ2)
37010 IF (QPE.GE.ZERO) THEN
37011 DM = RMASS(IQ1)-RMASS(IQ2)
37012 SQPE = SQRT( QPE*(S-DM**2) )
37015 TT = (SQPE*COSTH - S - SM*DM) / TWO
37017 TMG = TT + ML2(IQ) - MG2
37019 UMG = UU + MR2(IQ) - MG2
37024 BONE = AFAC*PF*SQPE**2*SN2TH
37025 BSTULR(IQ) = BONE/TMG2
37026 BSUTLR(IQ) = BONE/UMG2
37030 BUTSLR(IQ) = AFAC*PF*MG2*S/TMG2
37032 TT = (SQPE*COSTH - S + SM*DM) / TWO
37034 TMG = TT + MR2(IQ) - MG2
37036 UMG = UU + ML2(IQ) - MG2
37041 c BONE = AFAC*PF*SQPE**2*SN2TH
37042 c BSTURL(IQ) = BONE/TMG2
37043 c BSUTRL(IQ) = BONE/UMG2
37049 BUTSRL(IQ) = AFAC*PF*MG2*S/TMG2
37062 c distinct flavours - gq, qq'
37065 SM = RMASS(GLU)+RMASS(IQ1)
37067 IF (QPE.GE.ZERO) THEN
37068 DM = RMASS(GLU)-RMASS(IQ1)
37069 SQPE = SQRT( QPE*(S-DM**2) )
37071 TT = (SQPE*COSTH - S - SM*DM) / TWO
37078 CONE = (-UU+TWO*SM*DM*(ONE+MG2/TT+ML2(ID1)/UU))/S/TT/UU
37079 CONN = CFC3*PF*CONE*(ONE-TT2/(UU2+S2)/NC2)
37080 CTSUL(ID1) = CONN*UU2
37081 CTUSL(ID1) = CONN*S2
37087 SM = RMASS(GLU)+RMASS(IQ2)
37089 IF (QPE.GE.ZERO) THEN
37090 DM = RMASS(GLU)-RMASS(IQ2)
37091 SQPE = SQRT( QPE*(S-DM**2) )
37093 TT = (SQPE*COSTH - S - SM*DM) / TWO
37100 CONE = (-UU+TWO*SM*DM*(ONE+MG2/TT+MR2(ID1)/UU))/S/TT/UU
37101 CONN = CFC3*PF*CONE*(ONE-TT2/(UU2+S2)/NC2)
37102 CTSUR(ID1) = CONN*UU2
37103 CTUSR(ID1) = CONN*S2
37108 IF(ID1.EQ.6) GOTO 11
37110 DO 12 ID2 = ID2MIN, 6
37113 SM = RMASS(IQ1)+RMASS(IQ2)
37115 IF (QPE.GE.ZERO) THEN
37116 DM = RMASS(IQ1)-RMASS(IQ2)
37117 SQPE = SQRT( QPE*(S-DM**2) )
37119 TT = (SQPE*COSTH - S - SM*DM) / TWO
37121 TMG = TT+ML2(ID1)-MG2
37122 AF = AFAC*PF/TMG/TMG
37126 ASTULL(ID1,ID2) = AF*MG2*S
37127 ASTULL(ID2,ID1) = ASTULL(ID1,ID2)
37131 AUTSLL(ID1,ID2) = AF*SQPE**2*SN2TH
37132 AUTSLL(ID2,ID1) = AUTSLL(ID1,ID2)
37134 ASTULL(ID1,ID2) = ZERO
37135 ASTULL(ID2,ID1) = ZERO
37136 AUTSLL(ID1,ID2) = ZERO
37137 AUTSLL(ID2,ID1) = ZERO
37141 SM = RMASS(IQ1)+RMASS(IQ2)
37143 IF (QPE.GE.ZERO) THEN
37144 DM = RMASS(IQ1)-RMASS(IQ2)
37145 SQPE = SQRT( QPE*(S-DM**2) )
37147 TT = (SQPE*COSTH - S - SM*DM) / TWO
37149 TMG = TT+MR2(ID1)-MG2
37150 AF = AFAC*PF/TMG/TMG
37154 ASTURR(ID1,ID2) = AF*MG2*S
37155 ASTURR(ID2,ID1) = ASTURR(ID1,ID2)
37159 AUTSRR(ID1,ID2) = AF*SQPE**2*SN2TH
37160 AUTSRR(ID2,ID1) = AUTSRR(ID1,ID2)
37162 ASTURR(ID1,ID2) = ZERO
37163 ASTURR(ID2,ID1) = ZERO
37164 AUTSRR(ID1,ID2) = ZERO
37165 AUTSRR(ID2,ID1) = ZERO
37169 SM = RMASS(IQ1)+RMASS(IQ2)
37171 IF (QPE.GE.ZERO) THEN
37172 DM = RMASS(IQ1)-RMASS(IQ2)
37173 SQPE = SQRT( QPE*(S-DM**2) )
37175 TT = (SQPE*COSTH - S - SM*DM) / TWO
37177 TMG = TT+ML2(ID1)-MG2
37178 AF = AFAC*PF/TMG/TMG
37182 ASTULR(ID1,ID2) = AF*SQPE**2*SN2TH
37183 ASTULR(ID2,ID1) = ASTULR(ID1,ID2)
37187 AUTSLR(ID1,ID2) = AF*MG2*S
37188 AUTSLR(ID2,ID1) = AUTSLR(ID1,ID2)
37189 TT = (SQPE*COSTH - S + SM*DM) / TWO
37191 TMG = TT+MR2(ID1)-MG2
37192 AF = AFAC*PF/TMG/TMG
37196 ASTURL(ID1,ID2) = AF*SQPE**2*SN2TH
37197 ASTURL(ID2,ID1) = ASTULR(ID1,ID2)
37201 AUTSRL(ID1,ID2) = AF*MG2*S
37202 AUTSRL(ID2,ID1) = AUTSLR(ID1,ID2)
37204 ASTULR(ID1,ID2) = ZERO
37205 ASTULR(ID2,ID1) = ZERO
37206 AUTSLR(ID1,ID2) = ZERO
37207 AUTSLR(ID2,ID1) = ZERO
37208 ASTURL(ID1,ID2) = ZERO
37209 ASTURL(ID2,ID1) = ZERO
37210 AUTSRL(ID1,ID2) = ZERO
37211 AUTSRL(ID2,ID1) = ZERO
37218 IF (DISF(ID1,1).LT.EPS) GOTO 6
37220 IF (DISF(ID2,2).LT.EPS) GOTO 5
37221 DIST = DISF(ID1,1)*DISF(ID2,2)
37226 IF (IQ1.NE.IQ2) THEN
37229 HCS = HCS + ASTULL(IQ1,IQ2)*DIST
37230 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,0,3421,10,*9)
37231 HCS = HCS + ASTURR(IQ1,IQ2)*DIST
37232 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,2,IQ2,2,3421,10,*9)
37233 HCS = HCS + ASTULR(IQ1,IQ2)*DIST
37234 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,2,3421,10,*9)
37235 HCS = HCS + ASTURL(IQ1,IQ2)*DIST
37236 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,2,IQ2,0,3421,10,*9)
37240 HCS = HCS + BSTULL(IQ1)*DIST
37241 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,0,3421,10,*9)
37242 HCS = HCS + BSTURR(IQ1)*DIST
37243 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,2,IQ2,2,3421,10,*9)
37244 HCS = HCS + BSTULR(IQ1)*DIST
37245 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,2,3421,10,*9)
37246 HCS = HCS + BSTURL(IQ1)*DIST
37247 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,2,IQ2,0,3421,10,*9)
37248 HCS = HCS + BSUTLL(IQ1)*DIST
37249 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,0,4312,10,*9)
37250 HCS = HCS + BSUTRR(IQ1)*DIST
37251 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,2,IQ2,2,4312,10,*9)
37252 HCS = HCS + BSUTLR(IQ1)*DIST
37253 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,2,4312,10,*9)
37254 HCS = HCS + BSUTRL(IQ1)*DIST
37255 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,2,IQ2,0,4312,10,*9)
37257 ELSEIF (ID2.NE.13) THEN
37259 IF (IQ1.NE.IQ2) THEN
37262 HCS = HCS + AUTSLL(IQ1,IQ2)*DIST
37263 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,1,3142,10,*9)
37264 HCS = HCS + AUTSRR(IQ1,IQ2)*DIST
37265 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,2,IQ2,3,3142,10,*9)
37266 HCS = HCS + AUTSLR(IQ1,IQ2)*DIST
37267 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,3,3142,10,*9)
37268 HCS = HCS + AUTSRL(IQ1,IQ2)*DIST
37269 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,2,IQ2,1,3142,10,*9)
37272 c qq -> q'q' (q =/= q')
37274 IF (IQ .EQ.IQ1) GOTO 30
37275 HCS = HCS + AUSTLL(IQ )*DIST
37276 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ ,0,IQ ,1,2413,10,*9)
37277 HCS = HCS + AUSTRR(IQ )*DIST
37278 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ ,2,IQ ,3,2413,10,*9)
37282 HCS = HCS + BUTSLL(IQ1)*DIST
37283 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,1,3142,10,*9)
37284 HCS = HCS + BUTSRR(IQ1)*DIST
37285 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,2,IQ2,3,3142,10,*9)
37286 HCS = HCS + BUTSLR(IQ1)*DIST
37287 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,3,3142,10,*9)
37288 HCS = HCS + BUTSRL(IQ1)*DIST
37289 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,2,IQ2,1,3142,10,*9)
37290 HCS = HCS + BUSTLL(IQ1)*DIST
37291 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,1,2413,10,*9)
37292 HCS = HCS + BUSTRR(IQ1)*DIST
37293 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,2,IQ2,3,2413,10,*9)
37294 HCS = HCS + BUSTLR(IQ1)*DIST
37295 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,3,2413,10,*9)
37296 HCS = HCS + BUSTRL(IQ1)*DIST
37297 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,2,IQ2,1,2413,10,*9)
37301 HCS = HCS + CSTU(IQ1)*DIST
37302 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ ,0,IQ ,0,2413,10,*9)
37303 HCS = HCS + CSUT(IQ1)*DIST
37304 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ ,0,IQ ,0,2341,10,*9)
37310 HCS = HCS + CTSUL(IQ1)*DIST
37311 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,0,3142,10,*9)
37312 HCS = HCS + CTSUR(IQ1)*DIST
37313 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,2,IQ2,0,3142,10,*9)
37314 HCS = HCS + CTUSL(IQ1)*DIST
37315 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,0,3421,10,*9)
37316 HCS = HCS + CTUSR(IQ1)*DIST
37317 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,2,IQ2,0,3421,10,*9)
37319 ELSEIF (ID1.NE.13) THEN
37323 IF (IQ1.NE.IQ2) THEN
37326 HCS = HCS + AUTSLL(IQ1,IQ2)*DIST
37327 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,1,IQ2,0,2413,10,*9)
37328 HCS = HCS + AUTSRR(IQ1,IQ2)*DIST
37329 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,3,IQ2,2,2413,10,*9)
37330 HCS = HCS + AUTSLR(IQ1,IQ2)*DIST
37331 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,1,IQ2,2,2413,10,*9)
37332 HCS = HCS + AUTSRL(IQ1,IQ2)*DIST
37333 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,3,IQ2,0,2413,10,*9)
37336 c qq -> q'q' (q =/= q')
37338 IF (IQ .EQ.IQ1) GOTO 31
37339 HCS = HCS + AUSTLL(IQ)*DIST
37340 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ ,1,IQ ,0,3142,10,*9)
37341 HCS = HCS + AUSTRR(IQ)*DIST
37342 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ ,3,IQ ,2,3142,10,*9)
37346 HCS = HCS + BUTSLL(IQ1)*DIST
37347 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,1,IQ2,0,2413,10,*9)
37348 HCS = HCS + BUTSRR(IQ1)*DIST
37349 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,3,IQ2,2,2413,10,*9)
37350 HCS = HCS + BUTSLR(IQ1)*DIST
37351 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,1,IQ2,2,2413,10,*9)
37352 HCS = HCS + BUTSRL(IQ1)*DIST
37353 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,3,IQ2,0,2413,10,*9)
37354 HCS = HCS + BUSTLL(IQ1)*DIST
37355 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,1,IQ2,0,3142,10,*9)
37356 HCS = HCS + BUSTRR(IQ1)*DIST
37357 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,3,IQ2,2,3142,10,*9)
37358 HCS = HCS + BUSTLR(IQ1)*DIST
37359 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,1,IQ2,2,3142,10,*9)
37360 HCS = HCS + BUSTRL(IQ1)*DIST
37361 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,3,IQ2,0,3142,10,*9)
37364 HCS = HCS + CSTU(IQ1)*DIST
37365 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IGL,0,IGL,0,3142,10,*9)
37366 HCS = HCS + CSUT(IQ1)*DIST
37367 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IGL,0,IGL,0,4123,10,*9)
37369 ELSEIF (ID2.NE.13) THEN
37371 IF (IQ1.NE.IQ2) THEN
37374 HCS = HCS + ASTULL(IQ1,IQ2)*DIST
37375 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,1,IQ2,1,4312,10,*9)
37376 HCS = HCS + ASTURR(IQ1,IQ2)*DIST
37377 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,3,IQ2,3,4312,10,*9)
37378 HCS = HCS + ASTULR(IQ1,IQ2)*DIST
37379 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,1,IQ2,3,4312,10,*9)
37380 HCS = HCS + ASTURL(IQ1,IQ2)*DIST
37381 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,3,IQ2,1,4312,10,*9)
37385 HCS = HCS + BSTULL(IQ1)*DIST
37386 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,1,IQ2,1,4312,10,*9)
37387 HCS = HCS + BSTURR(IQ1)*DIST
37388 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,3,IQ2,3,4312,10,*9)
37389 HCS = HCS + BSTULR(IQ1)*DIST
37390 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,1,IQ2,3,4312,10,*9)
37391 HCS = HCS + BSTURL(IQ1)*DIST
37392 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,3,IQ2,1,4312,10,*9)
37393 HCS = HCS + BSUTLL(IQ1)*DIST
37394 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,1,IQ2,1,3421,10,*9)
37395 HCS = HCS + BSUTRR(IQ1)*DIST
37396 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,3,IQ2,3,3421,10,*9)
37397 HCS = HCS + BSUTLR(IQ1)*DIST
37398 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,1,IQ2,3,3421,10,*9)
37399 HCS = HCS + BSUTRL(IQ1)*DIST
37400 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,3,IQ2,1,3421,10,*9)
37406 HCS = HCS + CTSUL(IQ1)*DIST
37407 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,1,IQ2,0,2413,10,*9)
37408 HCS = HCS + CTSUR(IQ1)*DIST
37409 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,3,IQ2,0,2413,10,*9)
37410 HCS = HCS + CTUSL(IQ1)*DIST
37411 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,1,IQ2,0,4312,10,*9)
37412 HCS = HCS + CTUSR(IQ1)*DIST
37413 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,3,IQ2,0,4312,10,*9)
37421 HCS = HCS + CTSUL(IQ2)*DIST
37422 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,0,2413,10,*9)
37423 HCS = HCS + CTSUR(IQ2)*DIST
37424 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,2,2413,10,*9)
37425 HCS = HCS + CTUSL(IQ2)*DIST
37426 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,0,3421,10,*9)
37427 HCS = HCS + CTUSR(IQ2)*DIST
37428 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,2,3421,10,*9)
37429 ELSEIF (ID2.LT.13) THEN
37433 HCS = HCS + CTSUL(IQ2)*DIST
37434 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,1,3142,10,*9)
37435 HCS = HCS + CTSUR(IQ2)*DIST
37436 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,3,3142,10,*9)
37437 HCS = HCS + CTUSL(IQ2)*DIST
37438 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,1,4312,10,*9)
37439 HCS = HCS + CTUSR(IQ2)*DIST
37440 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,3,4312,10,*9)
37446 HCS = HCS + CSTUL(IQ)*DIST
37447 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ ,0,IQ ,1,2413,10,*9)
37448 HCS = HCS + CSTUR(IQ)*DIST
37449 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ ,2,IQ ,3,2413,10,*9)
37450 HCS = HCS + CSUTL(IQ)*DIST
37451 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ ,0,IQ ,1,4123,10,*9)
37452 HCS = HCS + CSUTR(IQ)*DIST
37453 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ ,2,IQ ,3,4123,10,*9)
37457 HCS = HCS + DTSU*DIST
37458 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,0,2341,10,*9)
37459 HCS = HCS + DSTU*DIST
37460 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,0,3421,10,*9)
37461 HCS = HCS + DUTS*DIST
37462 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,0,2413,10,*9)
37473 CALL HWETWO(.TRUE.,.TRUE.)
37475 C Calculate coefficients for constructing spin density matrices
37476 C Set to zero for now
37477 CALL HWVZRO(7,GCOEF)
37481 *CMZ :- -25/06/99 20.33.45 by Kosuke Odagiri
37482 *-- Author : Kosuke Odagiri & Bryan Webber
37483 C-----------------------------------------------------------------------
37485 C-----------------------------------------------------------------------
37486 C SUSY HARD 2 PARTON -> 2 SPARTON/GAUGINO/SLEPTON PROCESSES
37487 C-----------------------------------------------------------------------
37488 INCLUDE 'HERWIG65.INC'
37489 DOUBLE PRECISION SAVWT(3),RANWT,HWRGEN,HWRUNI,Z1,Z2,ET,EJ,
37490 & QPE,S,T,U,KK,KK2,YJ1INF,YJ1SUP,YJ2INF,YJ2SUP,SVEMSC
37492 EXTERNAL HWRGEN,HWRUNI
37494 IF (.NOT.GENEV) THEN
37499 IF (KK.GE.ONE) RETURN
37500 YJ1INF = MAX( YJMIN, LOG((ONE-SQRT(ONE-KK2))/KK) )
37501 YJ1SUP = MIN( YJMAX, LOG((ONE+SQRT(ONE-KK2))/KK) )
37502 IF (YJ1INF.GE.YJ1SUP) RETURN
37503 Z1=EXP(HWRUNI(1,YJ1INF,YJ1SUP))
37504 YJ2INF = MAX( YJMIN, -LOG(TWO/KK-ONE/Z1) )
37505 YJ2SUP = MIN( YJMAX, LOG(TWO/KK-Z1) )
37506 IF (YJ2INF.GE.YJ2SUP) RETURN
37507 Z2=EXP(HWRUNI(2,YJ2INF,YJ2SUP))
37508 XX(1)=HALF*(Z1+Z2)*KK
37509 IF (XX(1).GE.ONE) RETURN
37510 XX(2)=XX(1)/(Z1*Z2)
37511 IF (XX(2).GE.ONE) RETURN
37512 S=XX(1)*XX(2)*PHEP(5,3)**2
37513 QPE=S-(TWO*RMMNSS)**2
37514 IF (QPE.LE.ZERO) RETURN
37515 COSTH=HALF*ET*(Z1-Z2)/SQRT(Z1*Z2*QPE)
37516 IF (ABS(COSTH).GT.ONE) RETURN
37517 T=-(ONE+Z2/Z1)*(HALF*ET)**2
37519 C---SET EMSCA TO HEAVY HARD PROCESS SCALE
37520 SVEMSC = SQRT(TWO*S*T*U/(S*S+T*T+U*U))
37521 FACTSS = GEV2NB*HALF*PIFAC*EJ*ET/S**2
37522 & * (YJ1SUP-YJ1INF)*(YJ2SUP-YJ2INF)
37529 RANWT=SAVWT(3)*HWRGEN(0)
37530 IF (RANWT.LT.SAVWT(1)) THEN
37532 ELSEIF (RANWT.LT.SAVWT(2)) THEN
37541 SAVWT(2)=SAVWT(1)+EVWGT
37543 SAVWT(3)=SAVWT(2)+EVWGT
37546 ELSEIF (ISP.EQ.10) THEN
37548 ELSEIF (ISP.EQ.20) THEN
37550 ELSEIF (ISP.EQ.30) THEN
37553 C---UNRECOGNIZED PROCESS
37554 CALL HWWARN('HWHSSP',500,*999)
37558 *CMZ :- -18/05/99 20.33.45 by Kosuke Odagiri
37559 *-- Author : Kosuke Odagiri
37560 C-----------------------------------------------------------------------
37561 SUBROUTINE HWHSSS(ID3,R3,ID4,R4,IPERM,IHPR,*)
37562 C-----------------------------------------------------------------------
37563 C IDENTIFIES HARD SUSY SUBPROCESS
37564 C-----------------------------------------------------------------------
37565 INCLUDE 'HERWIG65.INC'
37566 INTEGER ID3, R3, ID4, R4, IPERM, IHPR, SSL
37567 PARAMETER (SSL = 400)
37568 IHPRO = 3000 + IHPR
37569 IDN(3) = SSL + ID3 + R3*6
37570 IDN(4) = SSL + ID4 + R4*6
37571 ICO(1) = IPERM/1000
37572 ICO(2) = IPERM/100 - 10*ICO(1)
37573 ICO(3) = IPERM/10 - 10*(IPERM/100)
37574 ICO(4) = IPERM - 10*(IPERM/10)
37578 *CMZ :- -18/05/99 14.37.45 by Mike Seymour
37579 *-- Author : Mike Seymour
37580 C-----------------------------------------------------------------------
37582 C-----------------------------------------------------------------------
37583 C V + 1 JET PRODUCTION, WHERE V=W (IHPRO.LT.5) OR Z (IHPRO.GE.5).
37584 C USES CROSS-SECTIONS OF EHLQ FOR ANNIHILATION AND COMPTON SCATTERING
37585 C IHPRO=0 FOR BOTH, 1 FOR ANNIHILATION, AND 2 FOR COMPTON.
37586 C-----------------------------------------------------------------------
37587 INCLUDE 'HERWIG65.INC'
37588 DOUBLE PRECISION HWRGEN,HWRUNI,DISFAC(2,12,2),EMV2,DISMAX,S,T,U,
37589 & SHAT,THAT,UHAT,Z,HWUALF,PT,EMT,GFACTR,SIGANN,SIGCOM(2),CSFAC,ET,
37590 & EJ,YMIN,YMAX,VYMIN,VYMAX,EMAX,CV,CA,BR,EMV,GAMV,HWUAEM,TMIN,TMAX
37591 INTEGER HWRINT,IDINIT(2,12,2),ICOFLO(4,2),I,J,K,L,M,ID1,ID2,
37594 SAVE DISFAC,SHAT,THAT,EMV,EMV2,IDV,IDI
37595 C---IDINIT HOLDS THE INITIAL STATES FOR ANNIHILATION PROCESSES
37596 DATA IDINIT/1,8,2,7,3,10,4,9,5,12,6,11,1,10,2,9,3,8,4,7,5,12,6,11,
37597 $ 1,7,2,8,3,9,4,10,5,11,6,12,1,7,2,8,3,9,4,10,5,11,6,12/
37598 C---ICOFLO HOLDS THE COLOR FLOW FOR EACH PROCESS
37599 C---DISFAC HOLDS THE DISTRIBUTION FUNCTION*CROSS-SECTION FOR EACH
37600 C POSSIBLE SUB-PROCESS.
37601 C INDEX1=INITIAL STATE PERMUTATION (1=AS IDINIT/QG;2=OPPOSITE/GQ),
37602 C 2=QUARK (FOR ANNIHILATION, >6 IMPLIES CABIBBO ROTATED PAIR),
37603 C 3=PROCESS (1=ANNIHILATION, 2=COMPTON)
37604 DATA ICOFLO,DISFAC/2,4,3,1,4,1,3,2,48*0.D0/
37610 110 DISMAX=MAX(DISFAC(K,J,I),DISMAX)
37614 IF (HWRGEN(0)*DISMAX.GT.DISFAC(K,J,I)) GOTO 120
37617 IDN(1)=IDINIT(K,J,IDI)
37618 IDN(2)=IDINIT(3-K,J,IDI)
37621 C---COMPTON SCATTERING
37624 IF (IDV.EQ.200) THEN
37627 IF (J.EQ.5.OR.J.EQ.6.OR.J.GE.11.OR.HWRGEN(0).GT.SCABI) THEN
37628 C---CHANGE QUARKS (1->2,2->1,3->4,4->3,...)
37629 IDN(4)=4*INT((J-1)/2)-J+3
37631 C---CHANGE AND CABIBBO ROTATE QUARKS (1->4,2->3,3->2,...)
37632 IDN(4)=12*INT((J-1)/6)-J+5
37635 IF ((SQRT(EMV2)+RMASS(IDN(4)))**2.GT.SHAT) GOTO 120
37637 C---SWAP INITIAL STATES
37643 IF (IDV.EQ.200) THEN
37646 C---W+ OR W-? USE CHARGE CONSERVATION TO WORK OUT
37647 IDN(3)=NINT(198.5-.1667*FLOAT(ICHRG(IDN(1))+ICHRG(IDN(2))))
37650 IF (I.EQ.2.AND.J.LE.6) M=3-K
37652 130 ICO(L)=ICOFLO(L,M)
37654 COSTH=(SHAT+2*THAT-EMV2)/(SHAT-EMV2)
37655 C---TRICK HWETWO INTO USING THE OFF-SHELL V MASS
37656 RMASS(IDN(3))=SQRT(EMV2)
37657 C-- BRW fix 27/8/04: avoid double smearing of V mass
37658 CALL HWETWO(.FALSE.,.TRUE.)
37660 RHOHEP(1,NHEP-1)=0.5
37661 RHOHEP(2,NHEP-1)=0.0
37662 RHOHEP(3,NHEP-1)=0.5
37665 IHPRO=MOD(IPROC,100)/10
37666 IF (IHPRO.LT.5) THEN
37679 c---mhs---implement cut on number of widths from nominal mass
37680 TMIN=-ATAN(2*GAMMAX-GAMV*GAMMAX**2/EMV)
37681 TMAX=ATAN(2*GAMMAX+GAMV*GAMMAX**2/EMV)
37682 EMV2=EMV*(EMV+GAMV*TAN(HWRUNI(0,TMIN,TMAX)))
37683 IF (EMV2.LE.ZERO) RETURN
37686 EMT=SQRT(PT**2+EMV2)
37687 EMAX=0.5*(PHEP(5,3)+EMV2/PHEP(5,3))
37688 IF (EMAX.LE.EMT) RETURN
37689 VYMAX=0.5*LOG((EMAX+SQRT(EMAX**2-EMT**2))
37690 & /(EMAX-SQRT(EMAX**2-EMT**2)))
37692 IF (VYMAX.LE.VYMIN) RETURN
37693 Z=EXP(HWRUNI(0,VYMIN,VYMAX))
37695 T=-PHEP(5,3)*EMT/Z+EMV2
37696 U=-PHEP(5,3)*EMT*Z+EMV2
37697 XXMIN=-U/(S+T-EMV2)
37698 IF (XXMIN.LT.ZERO.OR.XXMIN.GT.ONE) RETURN
37699 YMIN=MAX(LOG((XXMIN*PHEP(5,3)-EMT*Z)/PT),YJMIN)
37700 YMAX=MIN(LOG((PHEP(5,3)-EMT*Z)/PT),YJMAX)
37701 IF (YMAX.LE.YMIN) RETURN
37702 XX(1)=(Z*EMT+EXP(HWRUNI(2,YMIN,YMAX))*PT)/PHEP(5,3)
37703 IF (XX(1).LE.ZERO.OR.XX(1).GT.ONE) RETURN
37704 THAT =XX(1)*T+(1.-XX(1))*EMV2
37705 XX(2)=-THAT / (XX(1)*S+U-EMV2)
37706 IF (XX(2).LT.ZERO.OR.XX(2).GT.ONE) RETURN
37707 UHAT =XX(2)*U+(1.-XX(2))*EMV2
37708 SHAT =XX(1)*XX(2)*S
37710 CALL HWSGEN(.FALSE.)
37711 c---mhs minor improvement: replace thomson coupling by running coupling
37712 c---mhs bug fix: missing factor of m^2/m0^2, where m0 is nominal mass
37713 GFACTR=GEV2NB*2.*PIFAC*HWUAEM(EMV2)*HWUALF(1,EMSCA)/(9.*SWEIN)
37715 SIGANN=GFACTR*((THAT-EMV2)**2+(UHAT-EMV2)**2)
37716 & /(SHAT**2*THAT*UHAT)
37717 SIGCOM(2)=.375*GFACTR*(SHAT**2+UHAT**2+2*EMV2*THAT)
37719 SIGCOM(1)=.375*GFACTR*(SHAT**2+THAT**2+2*EMV2*UHAT)
37721 C---IF USER SPECIFIED A SUB-PROCESS, ZERO THE OTHER
37722 IF (IHPRO.EQ.1) THEN
37726 IF (IHPRO.EQ.2) SIGANN=0.
37728 IF (IDV.EQ.200) THEN
37731 DISFAC(1,I,1)=4*SWEIN*(VFCH(J,1)**2+AFCH(J,1)**2)
37734 DISFAC(1,I,1)=1-SCABI
37735 ELSEIF (I.GE.7) THEN
37736 DISFAC(1,I,1)=SCABI
37741 DISFAC(2,I,1)=DISFAC(1,I,1) *
37742 & SIGANN*DISF(IDINIT(1,I,IDI),2)*DISF(IDINIT(2,I,IDI),1)
37743 DISFAC(1,I,1)=DISFAC(1,I,1) *
37744 & SIGANN*DISF(IDINIT(1,I,IDI),1)*DISF(IDINIT(2,I,IDI),2)
37751 IF (IDV.EQ.200) THEN
37754 DISFAC(1,I,2)=4*SWEIN*(VFCH(J,1)**2+AFCH(J,1)**2)
37757 c---mhs fix: switch off bg->Wt process since we neglect quark masses!
37758 IF (I.EQ.5.OR.I.EQ.11) DISFAC(1,I,2)=0
37760 DISFAC(2,I,2)=DISFAC(1,I,2)*SIGCOM(2)*DISF(I,2)*DISF(13,1)
37761 DISFAC(1,I,2)=DISFAC(1,I,2)*SIGCOM(1)*DISF(I,1)*DISF(13,2)
37766 230 EVWGT=EVWGT+DISFAC(K,J,I)
37767 CSFAC=PT*EJ*(YMAX-YMIN)*(VYMAX-VYMIN)*(TMAX-TMIN)/PIFAC
37768 C---INCLUDE BRANCHING RATIO OF V
37769 CALL HWDBOZ(IDV,ID1,ID2,CV,CA,BR,0)
37770 EVWGT=EVWGT*CSFAC*BR
37774 *CMZ :- -14/03/01 09:03:25 by Peter Richardson
37775 *-- Author : Peter Richardson
37776 C-----------------------------------------------------------------------
37778 C-----------------------------------------------------------------------
37779 C Vector Boson production with two hard jets
37780 C Master subroutine for all vector boson + 2 jet processes
37781 C Currently implemented qqbar Z only
37782 C-----------------------------------------------------------------------
37783 INCLUDE 'HERWIG65.INC'
37784 INTEGER I,J,K,IDBS,IPRC,IDP(6),ORD,IB,ICMF,IHEP,IFLOW,IZ,IBRAD,
37786 DOUBLE PRECISION HWRGEN,HWRUNI,XMASS,PLAB,PRW,PCM,HWUAEM,BR,FLUX,
37787 & MBOS,MBOS2,ME,DT(4),B(6),HWUPCM,CV,CA,PST,HWUALF,GMBS,FPI4,
37788 & MQ(3),MQ2(3),MJAC,BRZED(12),PTP(5,2),PDOT(2),HWULDO,TWOPI2,
37790 DOUBLE COMPLEX S,D,F
37791 LOGICAL FSTCLL,MASS,GEN
37792 EXTERNAL HWRGEN,HWRUNI,HWUPCM,HWUALF,HWUAEM,HWULDO
37793 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
37794 COMMON/HWHEWS/S(8,8,2),D(8,8)
37795 COMMON/HWHZBB/F(8,8)
37797 DATA B/-1.0D0,-1.0D0,1.0D0,1.0D0,1.0D0,1.0D0/
37798 DATA BRZED/0.154D0,0.120D0,0.154D0,0.120D0,0.152D0,0.000D0,
37799 & 0.033D0,0.067D0,0.033D0,0.067D0,0.033D0,0.067D0/
37800 SAVE ME,MBOS,MBOS2,GMBS,IDBS,IPRC,IDP,FSTCLL,MQ,MQ2,TWOPI2,FPI4,
37802 C--generate the event
37804 C--find the particles produced
37808 ELSEIF(IPRC.GT.0.AND.IPRC.LE.16) THEN
37809 CALL HWHDYQ(FSTCLL,ME,IFLOW,IDP,ORD,IQ,MASS)
37811 CALL HWWARN('HWHV2J',502,*999)
37817 PRW(3,1) = -PRW(3,1)
37819 PLAB(3,I)=-PLAB(3,I)
37822 C--enter the incoming particles
37826 CALL HWVEQU(5,PLAB(1,I),PHEP(1,IHEP))
37827 IDHW(IHEP) = IDP(I)
37828 IDHEP(IHEP)= IDPDG(IDP(I))
37830 JMOHEP(1,IHEP)=ICMF
37831 JMOHEP(I,ICMF)=IHEP
37832 JDAHEP(1,IHEP)=ICMF
37835 IDHEP(ICMF)=IDPDG(15)
37837 CALL HWVSUM(4,PHEP(1,NHEP+1),PHEP(1,NHEP+2),PHEP(1,ICMF))
37838 CALL HWUMAS(PHEP(1,ICMF))
37839 JDAHEP(1,ICMF) = ICMF+1
37840 JDAHEP(2,ICMF) = ICMF+3
37842 C--Now the outgoing jets
37844 CALL HWVEQU(5,PLAB(1,2+I),PHEP(1,NHEP+I))
37845 C--Set the status and pointers
37847 IDHW(NHEP+I)=IDP(2+I)
37848 IDHEP(NHEP+I)=IDPDG(IDP(2+I))
37849 JMOHEP(1,NHEP+I)=NHEP
37852 C--Now sort out the colour connections
37854 ICOL(2)=IFLOW/100-10*ICOL(1)
37855 ICOL(3)=IFLOW/10 -10*(IFLOW/100)
37856 ICOL(4)=IFLOW -10*(IFLOW/10)
37862 JMOHEP(2,NHEP-5+J)=NHEP+K-5
37863 30 JDAHEP(2,NHEP-5+K)=NHEP+J-5
37864 C--Now add the Z to the event record
37865 CALL HWVEQU(5,PRW(1,1),PHEP(1,NHEP+1))
37866 CALL HWVZRO(4,VHEP(1,NHEP+1))
37867 CALL HWUDKL(200,PHEP(1,NHEP+1),DT)
37868 CALL HWVSUM(4,VHEP(1,NHEP+1),DT,DT)
37870 IDHEP(NHEP+1)=IDPDG(IDBS)
37871 JMOHEP(1,NHEP+1)=ICMF
37872 JMOHEP(2,NHEP+1)=ICMF
37876 C--generate the inital-state shower
37878 C--now add the decay products of the Z
37879 IZ = JDAHEP(1,IBRAD)
37881 JDAHEP(1,IZ) = NHEP+1
37882 JDAHEP(2,IZ) = NHEP+2
37883 IDHW(NHEP+1) = IDP(5)
37884 IDHW(NHEP+2) = IDP(6)
37885 ISTHEP(NHEP+1) = 113
37886 ISTHEP(NHEP+2) = 114
37887 IDHEP(NHEP+1) = IDPDG(IDP(5))
37888 IDHEP(NHEP+2) = IDPDG(IDP(6))
37889 JMOHEP(1,NHEP+1) = IZ
37890 JMOHEP(1,NHEP+2) = IZ
37891 JMOHEP(2,NHEP+1) = NHEP+2
37892 JDAHEP(2,NHEP+1) = NHEP+2
37893 JMOHEP(2,NHEP+2) = NHEP+1
37894 JDAHEP(2,NHEP+2) = NHEP+1
37895 CALL HWVEQU(5,PLAB(1,5),PHEP(1,NHEP+1))
37896 CALL HWVEQU(5,PLAB(1,6),PHEP(1,NHEP+2))
37897 DO IHEP=NHEP+1,NHEP+2
37898 CALL HWVEQU(4,DT,VHEP(1,IHEP))
37899 C--Boost the fermion momenta to the rest frame of the original Z
37900 CALL HWULOF(PRW(1,1),PHEP(1,IHEP),PHEP(1,IHEP))
37901 C--Now boost back to the lab from rest frame of the Z after radiation
37902 CALL HWULOB(PHEP(1,IZ),PHEP(1,IHEP),PHEP(1,IHEP))
37908 C--for second option minimum invariant mass of the jet pair
37909 C--set the type of events to be generated
37910 TWOPI2= FOUR*PIFAC**2
37911 FPI4 = (FOUR*PIFAC)**4
37912 IPRC = MOD(IPROC,100)
37913 IF(IPRC.GE.0.AND.IPRC.LE.16) THEN
37917 GMBS = MBOS2*GAMZ**2
37923 ELSEIF(IPRC.GT.0.AND.IPRC.LE.6) THEN
37925 IF(MJJMIN.LT.TWO*RMASS(IQ)) MJJMIN = TWO*RMASS(IQ)
37926 ELSEIF(IPRC.GE.11.AND.IPRC.LE.16) THEN
37931 IF(MJJMIN.LT.(MQ(1)+MQ(2))) MJJMIN = MQ(1)+MQ(2)
37933 CALL HWWARN('HWHV2J',500,*999)
37939 CALL HWWARN('HWHV2J',500,*999)
37943 C--generate the weight
37945 C--find the mass of the gauge boson
37946 CALL HWHGB1(1,2,IDBS,MJAC,MQ2(3),(PHEP(5,3)-MQ(1)-MQ(2))**2,
37948 MQ(3) = SQRT(MQ2(3))
37949 MJAC = MJAC/((MQ2(3)-MBOS2)**2+GMBS)
37950 C--do the phase space
37951 CALL HWH2PS(FLUX,GEN,MQ,MQ2)
37953 IF(.NOT.GEN) RETURN
37954 C--copy the gauge boson momentum
37955 CALL HWVEQU(5,PLAB(1,5),PRW(1,1))
37956 C--select the decay mode of the boson
37957 CALL HWDBOZ(IDBS,IDP(5),IDP(6),CV,CA,BR,0)
37959 IF(IDZ.GT.6) IDZ = IDZ-114
37961 IF(IDZ.LE.6) AMP = AMP*THREE
37962 C--Finds the momenta of the boson decay products
37963 PST=HWUPCM(PRW(5,1),ZERO,ZERO)
37966 IF(PRW(5,1).LT.(RMASS(IDP(5))+RMASS(IDP(6)))) RETURN
37967 CALL HWDTWO(PRW(1,1),PLAB(1,5),PLAB(1,6),PST,TWO,.FALSE.)
37968 MJAC = HALF*PST*MJAC/TWOPI2/MQ(3)
37969 C--copy the momenta, change order and boost to CMF
37972 PTP(3,1) = HALF*(XX(1)-XX(2))*PHEP(5,3)
37973 PTP(4,1) = HALF*(XX(1)+XX(2))*PHEP(5,3)
37974 PTP(5,1) = PHEP(5,3)*SQRT(XX(1)*XX(2))
37976 CALL HWULOF(PTP(1,1),PLAB(1,I),PTP(1,2))
37983 C--Massive momentum case
37984 C--reorder the products
37985 C--move b and bbar to 9 and 10
37988 PCM(J,I+6) = PCM(J,I)
37991 C--select the reference momenta for the b and bbar and put in 3,4
37992 C--the results is independent of this choice
37993 CALL HWVEQU(5,PCM(1,1),PCM(1,3))
37994 CALL HWVEQU(5,PCM(1,1),PCM(1,4))
37995 C--find the massless vectors for the b and bbar
37996 PDOT(1) = HALF*MQ2(1)/HWULDO(PCM(1,3),PCM(1, 9))
37997 PDOT(2) = HALF*MQ2(2)/HWULDO(PCM(1,4),PCM(1,10))
37999 PCM(I,7) = PCM(I,9) -PDOT(1)*PCM(I,3)
38000 PCM(I,8) = PCM(I,10)-PDOT(2)*PCM(I,4)
38004 C--use e+e- code to calculate the spinor products
38005 CALL HWHEW2(8,PCM(1,1),S(1,1,2),S(1,1,1),D)
38008 S(I,J,2) = -S(I,J,2)
38009 D(I,J) = TWO*D(I,J)
38013 C--Massless case, use the e+e- code to calculate the spinor products
38014 CALL HWHEW2(6,PCM(1,1),S(1,1,2),S(1,1,1),D)
38017 D(I,J) = TWO*D(I,J)
38018 F(I,J) = B(I)*B(J)*D(I,J)
38019 S(I,J,2) = -S(I,J,2)
38023 C--now call the code to calculate the matrix element*PDF
38027 ELSEIF(IPRC.GT.0.AND.IPRC.LE.16) THEN
38028 CALL HWHDYQ(FSTCLL,ME,IFLOW,IDP,ORD,IQ,MASS)
38030 CALL HWWARN('HWHV2J',501,*999)
38032 AMP = AMP*MJAC*BR*FPI4*HWUAEM(EMSCA**2)**2*HWUALF(1,EMSCA)**2
38033 EVWGT = FLUX*ME*AMP
38036 IF(CHON(I)) WI(I) = WI(I)*ME**2*AMP**2
38041 1000 FORMAT('DRELL-YAN + 2 JETS NOT YET IMPLEMENTED')
38044 *CMZ :- -11/05/01 09.19.45 by Bryan Webber
38045 *-- Author : Bryan Webber
38046 C-----------------------------------------------------------------------
38048 C-----------------------------------------------------------------------
38049 C VV + 1 JET PRODUCTION, WHERE VV=WW,ZZ,WZ FOR IPROC=2850,2860,2870
38050 C-----------------------------------------------------------------------
38051 PRINT *,' VV + 1 JET CALLED BUT NOT YET IMPLEMENTED'
38052 CALL HWWARN('HWHVVJ',500,*999)
38055 *CMZ :- -26/04/91 14.55.45 by Federico Carminati
38056 *-- Author : Mike Seymour
38057 C-----------------------------------------------------------------------
38059 C-----------------------------------------------------------------------
38060 C TOP QUARK PRODUCTION VIA W EXCHANGE: MEAN EVWGT=TOP PROD C-S IN NB
38062 C UbarBbar, DBbar, DbarB, UB, CbarBbar, SBbar, SbarB, AND CB
38063 C UNLESS USER SPECIFIES OTHERWISE BY MOD(IPROC,100)=1-8 RESPECTIVELY
38064 C---DSDCOS HOLDS THE CROSS-SECTIONS FOR THE PROCESSES LISTED ABOVE
38065 C (1-8) ARE WITH B FROM BEAM 1, (9-16) ARE WITH B FROM BEAM 2.
38066 C-----------------------------------------------------------------------
38067 INCLUDE 'HERWIG65.INC'
38068 DOUBLE PRECISION HWRGEN,HWRUNI,DSDCOS(16),EMT2,EMT,EMW2,EMW,
38069 & CMFMIN,TAUMIN,TAUMLN,S,T,U,ROOTS,DSMAX
38070 INTEGER HWRINT,IDHWEX(2,16),I
38071 EXTERNAL HWRGEN,HWRUNI,HWRINT
38073 EQUIVALENCE (EMW,RMASS(198)),(EMT,RMASS(6))
38074 C---IDHWEX HOLDS THE IDs OF THE INCOMING PARTICLES FOR EACH SUB-PROCESS
38075 DATA IDHWEX/11,8,11,1,5,7,5,2,11,10,11,3,5,9,5,4,
38076 & 8,11,1,11,7,5,2,5,10,11,3,11,9,5,4,5/
38080 300 IHPRO=HWRINT(1,16)
38081 IF (HWRGEN(0).GT.DSDCOS(IHPRO)/DSMAX) GOTO 300
38083 IDN(I)=IDHWEX(I,IHPRO)
38084 IF (IDN(I).EQ.5 .OR. IDN(I).EQ.11) THEN
38085 C---CHANGE B QUARK INTO T QUARK
38087 ELSEIF (HWRGEN(0).GT.SCABI) THEN
38088 C---CHANGE QUARKS (1->2,2->1,3->4,4->3,7->8,8->7,...)
38089 IDN(I+2)=4*INT((IDN(I)-1)/2)-IDN(I)+3
38091 C---CHANGE AND CABIBBO ROTATE QUARKS (1->4,2->3,3->2,4->1,7->10,...)
38092 IDN(I+2)=12*INT((IDN(I)-1)/6)-IDN(I)+5
38098 CALL HWETWO(.TRUE.,.TRUE.)
38102 TAUMIN=(CMFMIN/PHEP(5,3))**2
38104 ROOTS=PHEP(5,3)*SQRT(EXP(HWRUNI(0,ZERO,TAUMLN)))
38105 XXMIN=(ROOTS/PHEP(5,3))**2
38107 COSTH=HWRUNI(0,-ONE, ONE)
38111 EMSCA=SQRT(2*S*T*U/(S*S+T*T+U*U))
38112 DSDCOS(1)=GEV2NB*PIFAC*.125*(ALPHEM/SWEIN)**2
38113 & *(S-EMT2)**2 / S / (EMW2 + 0.5*(S-EMT2)*(1-COSTH))**2
38114 DSDCOS(2)=DSDCOS(1) / 4
38115 & * (1 + EMT2/S + 2*COSTH + (1-EMT2/S)*COSTH**2)
38116 DSDCOS(3)=DSDCOS(2)
38117 DSDCOS(4)=DSDCOS(1)
38118 C---IF USER SPECIFIED SUB-PROCESS THEN ZERO ALL THE OTHERS
38119 IHPRO=MOD(IPROC,100)
38120 IF (IHPRO.GT.8) THEN
38121 CALL HWWARN('HWHWEX',1,*999)
38125 IF (I.LE.4) DSDCOS(I+4)=DSDCOS(I)
38126 IF (IHPRO.NE.0 .AND. IHPRO.NE.I) DSDCOS(I)=0
38127 DSDCOS(I+8)=DSDCOS(I)
38129 CALL HWSGEN(.TRUE.)
38132 DSDCOS(I)=DSDCOS(I)*DISF(IDHWEX(1,I),1)*DISF(IDHWEX(2,I),2)
38133 EVWGT=EVWGT + 2*TAUMLN*XLMIN*DSDCOS(I)
38134 IF (DSDCOS(I).GT.DSMAX) DSMAX=DSDCOS(I)
38139 *CMZ :- -18/05/99 14.22.13 by Mike Seymour
38140 *-- Author : Bryan Webber
38141 C-----------------------------------------------------------------------
38143 C-----------------------------------------------------------------------
38144 C W+/- PRODUCTION AND DECAY VIA DRELL-YAN PROCESS
38145 C MEAN EVWGT IS SIG(W+/-)*(BRANCHING FRACTION) IN NB
38146 C-----------------------------------------------------------------------
38147 INCLUDE 'HERWIG65.INC'
38148 DOUBLE PRECISION HWRGEN,HWRUNI,HWUPCM,PRAN,PROB,COEF,CSFAC,EMW,
38149 & FTQK,PTOP,ETOP,EBOT,PMAX,FHAD,FTOT,BRAF,FLEP,TMIN,HWUAEM,TMAX
38150 INTEGER HWRINT,ICH,IC,IL,ID,IDEC,JDEC,IWP(2,16)
38152 EXTERNAL HWRGEN,HWRUNI,HWUPCM,HWRINT,HWRLOG
38153 SAVE CSFAC,IDEC,FLEP,FTQK,ETOP,PTOP,EBOT,PMAX,PROB
38154 DATA IWP/2,7,1,8,7,2,8,1,4,9,3,10,9,4,10,3,
38155 & 2,9,3,8,9,2,8,3,4,7,1,10,7,4,10,1/
38157 C---GENERATE EVENT (X'S AND STRUCTURE FUNCTIONS ALREADY FOUND)
38158 PRAN=PROB*HWRGEN(0)
38159 C---LOOP OVER PARTON FLAVOURS
38163 IF (IC.EQ.9) COEF=SCABI
38164 PROB=PROB+DISF(IWP(1,IC),1)*DISF(IWP(2,IC),2)*COEF
38165 IF (PROB.GE.PRAN) GOTO 20
38167 C---STORE INCOMING PARTONS
38168 20 IDN(1)=IWP(1,IC)
38172 C---ICH=1/2 FOR W+/-
38174 IF ((IDEC.GT.49.AND.IDEC.LT.54).OR.
38175 & (IDEC.EQ.99.AND.HWRLOG(FLEP))) THEN
38178 IF (IL.EQ.0.OR.IL.GT.3) IL=HWRINT(1,3)
38179 IDN(3)=2*IL+121-ICH
38180 IDN(4)=2*IL+124+ICH
38181 C---W DECAY ANGLE (1+COSTH)**2
38182 COSTH=2.*HWRGEN(1)**0.3333-1.
38183 ELSEIF (IDEC.EQ.5.OR.IDEC.EQ.6.OR.
38184 & ((IDEC.EQ.0.OR.IDEC.EQ.99).AND.HWRLOG(FTQK))) THEN
38185 C---W -> TOP + BOTTOM DECAY
38188 21 COSTH=HWRUNI(1,-ONE, ONE)
38189 IF ((ETOP+(PTOP*COSTH))*(EBOT+(PTOP*COSTH)).LT.
38190 & PMAX*HWRGEN(1)) GOTO 21
38192 C---OTHER HADRONIC DECAY
38197 IF (ID.GT.8) COEF=SCABI
38199 IF (PROB.GE.PRAN) THEN
38206 IF (IDEC.GT.0.AND.IDEC.LT.5) THEN
38208 IF (IDN(3).NE.IDEC.AND.IDN(4).NE.IDEC
38209 & .AND.IDN(3).NE.JDEC.AND.IDN(4).NE.JDEC) GOTO 25
38211 COSTH=2.*HWRGEN(1)**0.3333-1.
38214 IF (IDN(1).GT.6) COSTH=-COSTH
38217 CALL HWETWO(.TRUE.,.TRUE.)
38219 IDEC=MOD(IPROC,100)
38220 IF (IDEC.EQ.5.OR.IDEC.EQ.6) THEN
38221 TMIN=ATAN((RMASS(6)**2-RMASS(199)**2)/(GAMW*RMASS(199)))
38223 TMIN=-ATAN(RMASS(199)/GAMW)
38226 c---mhs---implement cut on number of widths from nominal mass
38227 TMIN=MAX(TMIN,-ATAN(2*GAMMAX-GAMW*GAMMAX**2/RMASS(199)))
38228 TMAX=ATAN(2*GAMMAX+GAMW*GAMMAX**2/RMASS(199))
38229 EMW=GAMW*TAN(HWRUNI(0,TMIN,TMAX))+RMASS(199)
38230 IF (EMW.LE.ZERO) RETURN
38231 EMW=SQRT(EMW*RMASS(199))
38232 IF (EMW.LE.QSPAC.OR.EMW.GE.PHEP(5,3)) RETURN
38234 IF (EMLST.NE.EMW) THEN
38236 XXMIN=(EMW/PHEP(5,3))**2
38238 CSFAC=-GEV2NB*PIFAC**2*HWUAEM(EMSCA**2)
38239 & /(3.*SWEIN*RMASS(199)**2)*XLMIN
38240 C---COMPUTE TOP AND LEPTONIC FRACTIONS
38242 IF (NFLAV.GT.5) THEN
38243 PTOP=HWUPCM(EMW,RMASS(5),RMASS(6))
38244 IF (PTOP.GT.ZERO) THEN
38245 ETOP=SQRT(PTOP**2+RMASS(6)**2)
38247 FTQK=2.*PTOP*(3.*ETOP*EBOT+PTOP**2)/EMW**3
38248 PMAX=(ETOP+PTOP)*(EBOT+PTOP)
38253 C---MULTIPLY WEIGHT BY BRANCHING FRACTION
38254 IF (IDEC.EQ.0) THEN
38256 ELSEIF (IDEC.LT.5.OR.IDEC.EQ.50) THEN
38258 ELSEIF (IDEC.LT.7) THEN
38260 ELSEIF (IDEC.EQ.99) THEN
38265 c---mhs fix: normalization should be to on-shell total width
38266 c (only different if chosen mass is above top threshold)
38267 CSFAC=CSFAC*BRAF/THREE*(TMAX-TMIN)/PIFAC
38271 CALL HWSGEN(.TRUE.)
38272 C---LOOP OVER PARTON FLAVOURS
38276 IF (IC.EQ.9) COEF=SCABI
38277 PROB=PROB+DISF(IWP(1,IC),1)*DISF(IWP(2,IC),2)*COEF
38283 *CMZ :- -27/07/99 13.33.03 by Mike Seymour
38284 *-- Author : Ian Knowles
38285 C-----------------------------------------------------------------------
38286 c$$$ SUBROUTINE HWIODK(IUNIT,IOPT,IME)
38287 SUBROUTINE HWIODK(IOPT)
38288 C-----------------------------------------------------------------------
38289 C If IUNIT > 0 writes out present HERWIG decay tables to unit IUNIT
38290 C < 0 reads in decay tables from unit IUNIT
38291 C The format used during the read/write is specified by IOPT
38292 C =1 PDG; =2 HERWIG numeric; =3 HERWIG character name.
38293 C When reading in if IME =1 matrix element codes >= 100 are accepted
38295 C-----------------------------------------------------------------------
38296 INCLUDE 'HERWIG65.INC'
38297 INTEGER IUNIT,IOPT,IME,JUNIT,I,J,K,L,IDKY,ITMP(5),IDUM
38298 CHARACTER*8 CDK(NMXDKS),CDKPRD(5,NMXDKS),CDUM
38299 c$$$ JUNIT=ABS(IUNIT)
38300 c$$$c$$$ OPEN(UNIT=JUNIT,FORM='FORMATTED',STATUS='UNKNOWN')
38301 c$$$c$$$ IF (IUNIT.GT.0) THEN
38302 c$$$C Write out the decay table
38304 c$$$ IF (IOPT.EQ.1) THEN
38305 c$$$ DO 20 I=1,NRES
38306 c$$$ IF (NMODES(I).EQ.0) GOTO 20
38308 c$$$ DO 10 J=1,NMODES(I)
38309 c$$$ WRITE(*,110) IDPDG(I),BRFRAC(K),NME(K),
38310 c$$$ & (IDPDG(IDKPRD(L,K)),L=1,5)
38314 c$$$ ELSEIF (IOPT.EQ.2) THEN
38315 c$$$ DO 40 I=1,NRES
38316 c$$$ IF (NMODES(I).EQ.0) GOTO 40
38318 c$$$ DO 30 J=1,NMODES(I)
38319 c$$$ WRITE(*,120) I,BRFRAC(K),NME(K),(IDKPRD(L,K),L=1,5)
38322 c$$$ ELSEIF (IOPT.EQ.3) THEN
38325 IF (NMODES(I).EQ.0) GOTO 60
38327 DO 50 J=1,NMODES(I)
38328 WRITE(*,130) K,IDPDG(I),RNAME(I),BRFRAC(K),NME(K),
38329 & (RNAME(IDKPRD(L,K)),L=1,5)
38334 c$$$ ELSEIF (IUNIT.LT.0) THEN
38335 c$$$C Read in the decay table and convert to HERWIG numeric format
38336 c$$$ READ(JUNIT,100) NDKYS
38337 c$$$ IF (NDKYS.GT.NMXDKS) CALL HWWARN('HWIODK',100,*999)
38338 c$$$ IF (IOPT.EQ.1) THEN
38339 c$$$ DO 70 I=1,NDKYS
38340 c$$$ READ(JUNIT,110) IDKY,BRFRAC(I),NME(I),ITMP
38341 c$$$ IF (IME.EQ.0.AND.NME(I).GE.100) NME(I)=0
38342 c$$$ CALL HWUIDT(1,IDKY,IDK(I),CDUM)
38344 c$$$ 70 CALL HWUIDT(1,ITMP(J),IDKPRD(J,I),CDUM)
38345 c$$$ ELSEIF (IOPT.EQ.2) THEN
38346 c$$$ DO 80 I=1,NDKYS
38347 c$$$ READ(JUNIT,120) IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5)
38348 c$$$ IF (IDK(I).LT.0.OR.IDK(I).GT.NRES) IDK(I)=20
38349 c$$$ 80 IF (IME.EQ.0.AND.NME(I).GE.100) NME(I)=0
38350 c$$$ ELSEIF (IOPT.EQ.3) THEN
38351 c$$$ DO 90 I=1,NDKYS
38352 c$$$ READ(JUNIT,130) CDK(I),BRFRAC(I),NME(I),(CDKPRD(J,I),J=1,5)
38353 c$$$ IF (IME.EQ.0.AND.NME(I).GE.100) NME(I)=0
38354 c$$$ CALL HWUIDT(3,IDUM,IDK(I),CDK(I))
38356 c$$$ 90 CALL HWUIDT(3,IDUM,IDKPRD(J,I),CDKPRD(J,I))
38358 c$$$ CALL HWWARN('HWIODK',101,*999)
38361 c$$$ CLOSE(UNIT=JUNIT)
38363 110 FORMAT(1X,I7,1X,F7.5,1X,I3,5(1X,I7))
38364 120 FORMAT(1X,I3,1X,F7.5,6(1X,I3))
38365 130 FORMAT(1X,I4,1X,I7,1X,A8,1X,F7.5,1X,I3,5(1X,A8))
38369 *CMZ :- -12/10/01 09.50.50 by Peter Richardson
38370 *-- Author : Bryan Webber
38371 C----------------------------------------------------------------------
38373 C-----------------------------------------------------------------------
38374 C SETS INPUT PARAMETERS
38375 C----------------------------------------------------------------------
38376 INCLUDE 'HERWIG65.INC'
38377 DOUBLE PRECISION FAC,ANGLE
38380 DATA TITLE/'HERWIG 6.507 8th March 2005'/
38382 10 FORMAT(//10X,A28//,
38383 & 10X,'Please reference: G. Marchesini, B.R. Webber,',/,
38384 & 10X,'G.Abbiendi, I.G.Knowles, M.H.Seymour & L.Stanco',/,
38385 & 10X,'Computer Physics Communications 67 (1992) 465',/,
38387 & 10X,'G.Corcella, I.G.Knowles, G.Marchesini, S.Moretti,'
38388 & ,/, 10X,'K.Odagiri, P.Richardson, M.H.Seymour & B.R.Webber,'
38389 & ,/, 10X,'JHEP 0101 (2001) 010')
38391 C IPRINT=0 NO PRINTOUT
38392 C 1 PRINT SELECTED INPUT PARAMETERS
38393 C 2 1 + TABLE OF PARTICLE CODES AND PROPERTIES
38394 C 3 2 + TABLES OF SUDAKOV FORM FACTORS
38396 C Format for track numbers in event listing
38397 C PRNDEC=.TRUE. use decimal
38398 C .FALSE. use hexadecimal
38399 PRNDEC=(NMXHEP.LE.9999)
38400 C Number of significant figures to print out in event listing
38401 C NPRFMT (< 2) compact 80 character stout and A4-long tex output,
38402 C (= 2) 2 decimal places in stout, (> 2) - 5 decimal places in stout
38404 C Print out vertex information
38406 C Print out particle properties/event record to stout, tex or web
38410 C---MAX NO OF EVENTS TO PRINT
38414 C---UNIT FOR READING SUDAKOV FORM FACTORS (IF ZERO THEN COMPUTE THEM)
38416 C---UNIT FOR WRITING SUDAKOV FORM FACTORS (IF ZERO THEN NOT WRITTEN)
38418 C---UNIT FOR WRITING EVENT DATA IN HWANAL (IF ZERO THEN NOT WRITTEN)
38420 C---SEEDS FOR RANDOM NUMBER GENERATOR (CALLED HWRGEN)
38423 C---ALLOW NEGATIVE WEIGHTS?
38425 C---AZIMUTHAL CORRELATIONS?
38426 C THESE INCLUDE SOFT GLUON (INSIDE CONE)
38428 C AND NEAREST-NEIGHBOUR SPIN CORRELATIONS
38430 C---MATRIX-ELEMENT MATCHING FOR E+E-, DIS, DRELL-YAN AND TOP DECAY
38435 C---GLUON ENERGY CUT FOR TOP DECAY CASE
38437 C Electromagnetic fine structure constant: Thomson limit
38439 C---QCD LAMBDA: CORRESPONDS TO 5-FLAVOUR LAMBDA-MS-BAR AT LARGE X ONLY
38441 C---NUMBER OF COLOURS
38443 C---NUMBER OF FLAVOURS
38445 C---QUARK, GLUON AND PHOTON VIRTUAL MASS CUTOFFS IN
38446 C PARTON SHOWER (ADDED TO MASSES GIVEN BELOW)
38451 C---D,U,S,C,B,T QUARK AND GLUON MASSES (IN THAT ORDER)
38459 C---W+/- AND Z0 MASSES
38463 C---HIGGS BOSON MASS
38465 C---WIDTHS OF W, Z, HIGGS
38468 C SM Higgs width is actually recomputed by HWDHIG
38469 C but this value corresponds to RMASS(201)=115.
38471 C Include additional neutral, massive vector boson (Z')
38473 C Z' mass and width
38476 C Graviton properties
38477 C Graviton mass and width (default mass 1 TeV and calculated width)
38480 C Graviton coupling (this has dimensions of mass)
38482 C Lepton (EPOLN) and anti-lepton (PPOLN) beam polarisations used in:
38483 C e+e- --> ffbar/qqbar g; and l/lbar N DIS.
38484 C Cpts. 1,2 Transverse polarisation; cpt. 3 longitudinal polarisation.
38485 C Note require POLN(1)**2+POLN(2)**2+POLN(3)**2 < 1.
38489 C-----------------------------------------------------------------------
38490 C Specify couplings of weak vector bosons to fermions:
38492 C electric current: QFCH(I)*e*G_mu (electric charge, e>0)
38493 C weak neutral current: [VFCH(I,J).1+AFCH(I,J).G_5]*e*G_mu
38494 C weak charged current: SQRT(VCKM(K,L)/2.)*g*(1+G_5)*G_mu
38496 C I= 1- 6: d,u,s,c,b,t (quarks)
38497 C =11-16: e,nu_e,mu,nu_mu,tau,nu_tau (leptons) (`I=IDHW-110')
38498 C J=1 for minimal SM:
38499 C =2 for Z' couplings (ZPRIME=.TRUE.)
38500 C K=1,2,3 for u,c,t; L=1,2,3 for d,s,b
38501 C-----------------------------------------------------------------------
38502 C Minimal standard model neutral vector boson couplings
38503 C VFCH(I,1)=(T3/2-Q*S^2_W)/(C_W*S_W); AFCH(I,1)=T3/(2*C_W*S_W)
38504 C sin**2 Weinberg angle (PDG '94)
38506 FAC=1./SQRT(SWEIN*(1.-SWEIN))
38511 VFCH(J,1)=(-0.25+SWEIN/3.)*FAC
38512 AFCH(J,1)= -0.25*FAC
38516 VFCH(J,1)=(+0.25-2.*SWEIN/3.)*FAC
38517 AFCH(J,1)= +0.25*FAC
38521 VFCH(J,1)=(-0.25+SWEIN)*FAC
38522 AFCH(J,1)= -0.25*FAC
38526 VFCH(J,1)=+0.25*FAC
38527 AFCH(J,1)=+0.25*FAC
38529 C Additional Z' couplings (To be set by the user)
38530 IF (.NOT.ZPRIME) THEN
38538 C--calculate left and right couplings of bosons for axial and vector ones
38540 IF(J.LE.6.OR.J.GE.11) THEN
38541 LFCH(J)=VFCH(J,1)+AFCH(J,1)
38542 RFCH(J)=VFCH(J,1)-AFCH(J,1)
38545 C Cabibbo-Kobayashi-Maskawa matrix elements squared (PDG '92):
38546 C sin**2 of Cabibbo angle
38554 VCKM(2,2)=1.-SCABI-.002
38560 C---GAUGE BOSON DECAYS
38569 C THE iTH GAUGE BOSON DECAY PER EVENT IS CONTROLLED BY MODBOS AS FOLLOWS
38570 C MODBOS(i) W DECAY Z DECAY
38576 C 5 enu & munu ee & mumu
38580 C BOSON PAIRS (eg FROM HIGGS DECAY)ARE CHOSEN FROM MODBOS(i),MODBOS(i+1)
38582 C---CONTROL OF LARGE EMH BEHAVIOUR (SEE HWHIGM FOR DETAILS)
38585 C Specify approximation used in HWHIGA
38587 C---MASSES OF HYPOTHETICAL NEW QUARKS GO
38588 C INTO 209-214 (ANTIQUARKS IN 215-220)
38589 C ID = 209,210 ARE B',T' WITH DECAYS T'->B'->C
38590 C 211,212 ARE B',T' WITH DECAYS T'->B'->T
38591 C 215-218 ARE THEIR ANTIQUARKS
38594 C---MAXIMUM CLUSTER MASS PARAMETERS
38595 C N.B. LIMIT FOR Q1-Q2BAR CLUSTER MASS
38596 C IS (CLMAX**CLPOW + (QM1+QM2)**CLPOW)**(1/CLPOW)
38599 C For PSPLT(I), CLDIR(I) & CLSMR(I): I=1 light u,d,s,c cluster
38600 C =2 heavy b cluster
38601 C---MASS SPECTRUM OF PRODUCTS IN CLUSTER
38602 C SPLITTING ABOVE CLMAX - FLAT IN M**PSPLT(*)
38605 C---KINEMATIC TREATMENT OF CLUSTER DECAY
38606 C 0=ISOTROPIC, 1=REMEMBER DIRECTION OF PERTURBATIVELY PRODUCED QUARKS
38609 C IF CLDIR(*)=1, DO GAUSSIAN SMEARING OF DIRECTION:
38610 C ACTUALLY EXPONENTIAL IN 1-COS(THETA) WITH MEAN CLSMR(*)
38613 C---OPTION FOR TREATMENT OF REMNANT CLUSTERS:
38614 C 0=BOTH CHILDREN ARE SOFT, (EQUIVALENT TO PREVIOUS VERSIONS)
38615 C 1=REMNANT CHILD IS SOFT, BUT PERTURBATIVE CHILD IS NORMAL
38617 C---TREATMENT OF LOWER LIMIT FOR SPACELIKE EVOLUTION
38618 C 0=EVOLUTION STOPS AT QSPAC, BUT STRUCT FUNS CAN GET CALLED AT
38619 C SMALLER SCALES IN FORCED EMISSION (EQUIVALENT TO V5.7 AND EARLIER)
38620 C 1=EVOLUTION STOPS AT QSPAC, STRUCTURE FUNCTIONS FREEZE AT QSPAC
38621 C 2=EVOLUTION CONTINUES TO INFRARED CUT, BUT S.F.S FREEZE AT QSPAC
38623 C---LOWER LIMIT FOR SPACELIKE EVOLUTION
38625 C---SWITCH OFF SPACE-LIKE SHOWERS
38627 C---INTRINSIC PT OF SPACELIKE PARTONS (RMS)
38629 C---MASS PARAMETER IN REMNANT FRAGMENTATION
38631 C---PARAMETERS CONTROLLING VERY SMALL-X BEHAVIOUR OF PDFS
38634 C---STRUCTURE FUNCTION SET:
38635 C SET MODPDF(I)=MODE AND AUTPDF='AUTHOR GROUP' TO USE CERN LIBRARY
38636 C PDFLIB PACKAGE FOR STRUCTURE FUNCTIONS IN BEAM I
38641 C OR SET MODPDF(I)=-1 TO USE BUILT-IN STRUCTURE FUNCTION SET:
38642 C 1,2 FOR DUKE+OWENS SETS 1,2 (SOFT/HARD GLUE)
38643 C 3,4 FOR EICHTEN+AL SETS 1,2 (NUCLEONS ONLY)
38644 C 5 FOR OWENS SET 1.1 (SOFT GLUE ONLY)
38645 C 6 FOR MRST98LO central alpha_s/gluon
38646 C 7 FOR MRST98LO higher gluon
38647 C 8 FOR MRST98LO average of central and higher gluon (default)
38649 C PARAMETER FOR B CLUSTER DECAY TO 1 HADRON. IF MCL IS CLUSTER MASS
38650 C AND MTH IS THRESHOLD FOR 2-HADRON DECAY, THEN PROBABILITY IS
38651 C 1 IF MCL<MTH, 0 IF MCL>(1+B1LIM)*MTH, WITH LINEAR INTERPOLATION,
38653 C---B DECAY PACKAGE ('HERW'=>HERWIG, 'EURO'=>EURODEC, 'CLEO'=>CLEO)
38655 C---TAU DECAY PACKAGE ('HERWIG'=>HERWIG, 'TAUOLA'=> TAUOLA)
38657 C--default options for TAUOLA (if used)
38659 C JAK=1 ELECTRON MODE
38667 C--tau decay modes (1 is tau+ and 2 is tau-)
38670 C--radiative corrections in tau decay (1 on/ 0 off)
38672 C--use PHOTOS in tau decays (1 PHOTOS/ 0 no PHOTOS)
38674 C--use PHOTOS in ttbar production and decay
38676 C---HARD SUBPROCESS SCALE TO BE USED IN 4-JET MATRIX ELEMENT OPTION
38677 C IF (FIX4JT) THEN SCALE=C.M. ENERGY
38678 C ELSE SCALE=2.*MIN(PI.PJ)
38680 C---HARD SUBPROCESS SCALE TO BE USED IN BOSON-GLUON FUSION
38681 C IF (BGSHAT) THEN SCALE=SHAT
38682 C ELSE SCALE=2.*SHAT*THAT*UHAT/(SHAT**2+THAT**2+UHAT**2)
38684 C---RECONSTRUCT DIS EVENTS IN BREIT FRAME
38686 C---TREAT ALL EVENTS IN THEIR CMF (ELSE USE LAB FRAME)
38688 C---TREAT W/Z DECAY IN ITS REST FRAME
38690 C---PROBABILITY OF UNDERLYING SOFT EVENT:
38692 C---SOFT UNDERLYING OR MIN BIAS EVENT PARAMETERS
38693 C DEFAULT VALUES ARE FROM UA5 COLLAB, NPB291(1987)445
38694 C NCH_PPBAR(SQRT(S)) = PMBN1*S**PMBN2+PMBN3
38698 C 1/K (IN NEG BINOMIAL) = PMBK1*LN(S)+PMBK2
38701 C SOFT CLUSTER MASS SPECTRUM (M-M1-M2-PMBM1)*EXP(-PMBM2*M)
38704 C SOFT CLUSTER PT SPECTRUM PT*EXP(-B*SQRT(PT**2+M**2))
38705 C B=PMBP1 FOR D,U, PMBP2 FOR S,C, PMBP3 FOR DIQUARKS
38709 C---MULTIPLICITY ENHANCEMENT FOR UNDERLYING SOFT EVENT:
38710 C NCH = NCH_PPBAR(ENSOF*SQRT(S))
38712 C PARAMETERS FOR MUELLER TANG FORMULA: IPROC=2400
38713 C---THE VALUE TO USE FOR FIXED ALPHA_S IN DENOMINATOR
38715 C---OMEGA0=12*LOG(2)*ALPHA_S/PI, BUT NOT NECESSARILY THE SAME ALPHA_S
38717 C---MIN AND MAX JET RAPIDITIES IN QCD 2->2,
38718 C HEAVY FLAVOUR, SUSY AND DIRECT PHOTON PROCESSES
38721 C---MIN AND MAX PARTON TRANSVERSE MOMENTUM
38722 C IN ELEMENTARY 2 -> 2 SUBPROCESSES
38725 C---UPPER LIMIT ON HARD PROCESS SCALE
38727 C---MAX PARTON THRUST IN 2->3 HARD PROCESSES
38729 C Set parameters for 2->4 hard process
38730 C Choose inter-jet metric (else JADE) and minimum y-cut
38733 C---TREATMENT OF COLOUR INTERFERENCE IN E+E- -> 4 JETS:
38735 C IOP4JT(1)=0 neglect, =1 extreme 2341; =2 extreme 3421
38736 C qqbar-qqbar (identical quark flavour) case:
38737 C IOP4JT(2)=0 neglect, =1 extreme 4123; =2 extreme 2143
38740 C---MIN AND MAX DILEPTON INVARIANT MASS IN DRELL-YAN PROCESS
38743 C---MIN AND MAX ABS(Q**2) IN DEEP INELASTIC LEPTON SCATTERING
38746 C---MIN AND MAX ABS(Q**2) IN WEISZACKER-WILLIAMS APPROXIMATION
38749 C---MIN AND MAX ENERGY FRACTION IN WEISZACKER-WILLIAMS APPROXIMATION
38752 C---MINIMUM HADRONIC MASS FOR PHOTON-INDUCED PROCESSES (INCLUDING DIS)
38754 C---IF PHOMAS IS NON-ZERO, PARTON DISTRIBUTION FUNCTIONS FOR OFF-SHELL
38755 C PHOTONS IS DAMPED, WITH MASS PARAMETER = PHOMAS
38757 C---MIN AND MAX FLAVOURS GENERATED BY IPROC=9100,9110,9130
38760 C---MAX Z IN J/PSI PHOTO- AND ELECTRO- PRODUCTION
38762 C---MIN AND MAX BJORKEN-Y
38765 C---MIN jet-jet mass in Drell-Yan+2 jets
38767 C---MAX COS(THETA) FOR W'S IN E+E- -> W+W-
38769 C Minimum virtuality^2 of partons to use in calculating distances
38771 C Exageration factor for lifetimes of weakly decaying heavy particles
38773 C Include colour rearrangement in cluster formation
38775 C Probability for colour rearrangement to occur
38777 C Minimum lifetime for particle to be considered stable
38779 C Incude neutral B-meson mixing
38781 C Set B_s and B_d mixing parameters: X=Delta m/Gamma
38784 C Y=Delta Gamma/2*Gamma
38787 C Include a cut on particle decay lengths
38789 C Set option for decay length cut (see HWDXLM)
38791 C Radius for cylindrical option (mm) (IOPDKL=1)
38793 C Length for cylindrical option(IOPDKL=1)
38795 C Radius for spherical option(IOPDKL=2)
38797 C Smear the primary interaction vertex: see HWRPIP for details
38799 C Widths of Gaussian smearing in x,y,z (mm)
38804 C Veto cluster decays into particle type I
38806 C Veto unstable particle decays into modes involving particle type I
38807 60 VTORDK(I)=.FALSE.
38808 C Veto f_0(980) and a_0(980) production in cluster decays
38813 C---MINIMUM AND MAXIMUM S-HAT/S RANGE FOR PHOTON ISR
38816 C---COLISR IS .TRUE. TO MAKE ISR PHOTONS COLLINEAR WITH BEAMS
38818 C A Priori weights for mesons w.r.t. pionic n=1, 0-(+) states:
38819 C old VECWT=REPWT(0,1,0) & TENWT=REPWT(0,2,0)
38824 C and singlet (Lambda-like) and decuplet barons
38827 C---A PRIORI WEIGHTS FOR D,U,S,C,B,T QUARKS AND DIQUARKS (IN THAT ORDER)
38835 C Octet-Singlet isoscalar mixing angles in degrees
38836 C (use ANGLE for ideal mixing, recommended for F0MIX & OMHMIX)
38837 ANGLE=ATAN(ONE/SQRT(TWO))*180./ACOS(-ONE)
38842 C h_1(1380) - h_1(1170)
38844 C MISSING - f_0(1370)
38846 C f_1(1420) - f_1(1285)
38850 C MISSING - omega(1600)
38852 C eta_2(1645) - eta_2(1870)
38856 C---PARAMETERS FOR NON-PERTURBATIVE SPLITTING OF GLUONS INTO
38857 C DIQUARK-ANTIDIQUARK PAIRS:
38858 C SCALE AT WHICH GLUONS CAN BE SPLIT INTO DIQUARKS
38859 C (0.0 FOR NO SPLITTING)
38861 C PROBABILITY (PER UNIT LOG SCALE) OF DIQUARK SPLITTING
38863 C---PARAMETERS FOR IMPORTANCE SAMPLING
38864 C ASSUME QCD 2->2 DSIG/DET FALLS LIKE ET**(-PTPOW)
38865 C WHERE ET=SQRT(MQ**2+PT**2) FOR HEAVY FLAVOURS
38867 C DEFAULT PTPOW=2 FOR SUSY PROCESSES
38868 IF (MOD(IPROC/100,100).EQ.30) PTPOW=2.
38869 C ASSUME DRELL-YAN DSIG/DEM FALLS LIKE EM**(-EMPOW)
38871 C ASSUME DEEP INELASTIC DSIG/DQ**2 FALLS LIKE (Q**2)**(-Q2POW)
38873 C---GENERATE UNWEIGHTED EVENTS (EVWGT=AVWGT)?
38875 C---DEFAULT MEAN EVENT WEIGHT
38877 C---ASSUMED MAXIMUM WEIGHT (ZERO TO RECOMPUTE)
38879 C---MINIMUM ACCEPTABLE EVENT GENERATION EFFICIENCY
38881 C---MAX NO OF (CODE.GE.100) ERRORS
38882 MAXER=MAX(10,MAXEV/100)
38883 C---TIME (SEC) NEEDED TO TERMINATE GRACEFULLY
38885 C---CURRENT NO OF EVENTS
38887 C---CURRENT NO OF ENTRIES IN /HEPEVT/
38889 C---ISTAT IS STATUS OF EVENT (I.E. STAGE IN PROCESSING)
38891 C---IERROR IS ERROR CODE
38893 C---MORE TECHNICAL PARAMETERS - SHOULDN'T NEED ADJUSTMENT
38896 C Speed of light (mm/s)
38898 C Cross-section conversion factor (hbar.c/e)**2
38900 C---NUMBER OF SHOTS FOR INITIAL MAX WEIGHT SEARCH
38902 C---RANDOM NO. SEEDS FOR INITIAL MAX WEIGHT SEARCH
38905 C--Number of shots and steps for the optimisation procedure
38908 C---NUMBER OF ENTRIES IN LOOKUP TABLES OF SUDAKOV FORM FACTORS
38910 C---MAXIMUM BIN SIZE IN Z FOR SPACELIKE BRANCHING
38912 C---MAXIMUM NUMBER OF Z BINS FOR SPACELIKE BRANCHING
38914 C---MAXIMUM NUMBER OF BRANCH REJECTIONS (TO AVOID INFINITE LOOPS)
38916 C---MAXIMUM NUMBER OF TRIES TO GENERATE CLUSTER DECAY
38918 C---MAXIMUM NUMBER OF TRIES TO GENERATE MASS REQUESTED
38920 C---MAXIMUM NUMBER OF TRIES TO GENERATE SOFT SUBPROCESS
38922 C---MAXIMUM NUMBER OF TRIES TO GENERATE SPIN DECAYS
38924 C---PRECISION FOR GAUSSIAN INTEGRATION
38926 C---ORDER OF INTERPOLATION IN SUDAKOV TABLES
38928 C---ORDER TO USE FOR ALPHAS IN SUDAKOV TABLES
38930 C---DEFAULT UNIT FOR THE SUSY DATA FILE
38932 C---CONSERVATION OF RPARITY
38934 C---CHECK WHETHER SUSY DATA INPUTTED
38936 C---SPIN CORRELATIONS IN TOP/TAU/SUSY DECAYS
38938 C---THREE BODY SUSY MATRIX ELEMENTS
38940 C---FOUR BODY SUSY MATRIX ELEMENTS
38942 C---OPTION FOR DIFFERENT COLOUR FLOWS IN SPIN CORRELATION
38943 C---(1 is first option in DAMTP-2001-83 only for SM/MSSM)
38944 C---(2 is second option in DAMTP-2001-83 needed for RPV)
38946 C---number of weights for maximum search for 3/4 body MEs
38948 C--unit to read three/four body decays from (if 0 computed)
38950 C--unit to write three/four body decays to (if 0 not written)
38952 C--WHETHER OR NOT TO OPTIMIZE THE WEIGHTS IN MULTICHANNEL PROCESSES
38954 C--initializes the multichannel integrals
38957 C---CIRCE IS CONTROLLED BY THESE NEW VARIABLES:
38958 C---CIRCOP = CIRCE OPTION: 0=NO CIRCE, STANDARD HERWIG
38959 C 1=NO CIRCE, HERWIG WITH COLLINEAR KINEMATICS
38960 C 2=BEAMSTRAHLUNG FROM CIRCE
38961 C 3=BEAMSTRAHLUNG FROM CIRCE PLUS BREMSTRAHLUNG
38962 C THEREFORE 0 SHOULD BE REGARDED AS OFF AND 3 AS ON. THE OTHERS ARE
38963 C MAINLY THERE FOR CROSS-CHECKING PURPOSES
38965 C---CIRCAC, CIRCVR, CIRCRV, CIRCCH = CIRCE INPUTS ACC, VER, REV AND CHAT
38966 C EG CIRCAC=1=SBAND, CIRCAC=2=TESLA, CIRCAC=3=XBAND
38971 C---END OF CIRCE VARIABLES
38972 C--options for Les Houches Accord
38973 C--allow self connected gluons (.TRUE.) or forbid (.FALSE.)
38975 C--generate the soft event (.TRUE.) or don't (.FALSE.)
38977 C--conserve longitudinal momentum (.true.) or rapidity of hard process
38981 *CMZ :- -15/07/02 16.42.23 by Peter Richardson
38982 *-- Author : Peter Richardson
38983 C----------------------------------------------------------------------
38985 C----------------------------------------------------------------------
38986 C Use the GUPI (Generic User Process Interface) run common block
38987 C to initialise HERWIG
38988 C----------------------------------------------------------------------
38989 INCLUDE 'HERWIG65.INC'
38991 PARAMETER(MAXPUP=100)
38992 INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP
38993 DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP
38994 COMMON /HEPRUP/ IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2),
38995 & IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),
38996 & XMAXUP(MAXPUP),LPRUP(MAXPUP)
38997 CHARACTER *8 DUMMY,PDFNUC(9),PDFPI(9),PDFPHT(9)
38998 DATA PDFNUC/ 'DO','DFLM','MRS','CTEQ','GRV','ABFOW','BM',
39000 DATA PDFPI / 'OW-P',' ','SMRS-P',' ','GRV-P',
39001 & 'ABFKW-P',' ',' ',' '/
39002 DATA PDFPHT /'DO-G','DG-G','LAC-G','GS-G','GRV-G','ACG-G',
39003 & ' ','WHIT-G','SaSph'/
39005 C--call the user routine to do the initialisation
39007 C--setup the beam particles and momentum
39008 CALL HWUIDT(1,IDBMUP(1),IDB(1),DUMMY)
39010 CALL HWUIDT(1,IDBMUP(2),IDB(2),DUMMY)
39012 PBEAM1 = SQRT(EBMUP(1)**2-RMASS(IDB(1))**2)
39013 PBEAM2 = SQRT(EBMUP(2)**2-RMASS(IDB(2))**2)
39014 C--set up for PDFLIB if need
39016 IF(PDFGUP(I).NE.-1) THEN
39017 IF(PDFGUP(I).LT.1.OR.PDFGUP(I).GT.9) then
39019 CALL HWWARN('HWIGUP',500,*999)
39021 MODPDF(I) = PDFSUP(I)
39022 C--proton/neutron beams
39023 IF(ABS(IDBMUP(I)).EQ.2212.OR.ABS(IDBMUP(I)).EQ.2112) THEN
39024 AUTPDF(I) = PDFNUC(PDFGUP(I))
39026 ELSEIF(ABS(IDBMUP(I)).EQ.22) THEN
39027 AUTPDF(I) = PDFPHT(PDFGUP(I))
39029 ELSEIF(ABS(IDBMUP(I)).EQ.211) THEN
39030 AUTPDF(I) = PDFPI(PDFGUP(I))
39031 C--unknown beam type
39033 print*,'unknown beam type'
39034 CALL HWWARN('HWIGUP',500,*999)
39038 C--decide what to do about the weights
39039 IF(ABS(IDWTUP).EQ.1) THEN
39044 C--sum up the magnitudes of the maximum weight
39047 LHXMAX(I) = XMAXUP(I)*1.0D-3
39048 LHMXSM = LHMXSM+ABS(LHXMAX(I))
39051 ELSEIF(ABS(IDWTUP).EQ.2) THEN
39056 C--sum the cross sections and obtain the total
39059 LHXSCT(I) = XSECUP(I)*1.0D-3
39060 LHXMAX(I) = XMAXUP(I)*1.0D-3
39061 LHMXSM = LHMXSM+ABS(LHXSCT(I))
39064 ELSEIF(ABS(IDWTUP).EQ.3) THEN
39069 ELSEIF(ABS(IDWTUP).EQ.4) THEN
39074 IF(IDWTUP.LT.0) NEGWTS = .TRUE.
39084 *CMZ :- -12/10/01 17.14.22 by Peter Richardson
39085 *-- Author : Peter Richardson
39086 C-----------------------------------------------------------------------
39088 C-----------------------------------------------------------------------
39089 C Subroutine to merge Higgs WW/ZZ decay modes for four body ME
39090 C-----------------------------------------------------------------------
39091 INCLUDE 'HERWIG65.INC'
39092 INTEGER IH,I,NMODE,J,IMAX,K
39094 DOUBLE PRECISION BR
39096 C--first identify the WW modes
39101 IF(IDK(I).EQ.IH.AND.((IDKPRD(3,I).NE.0.AND.IDKPRD(4,I).EQ.0
39102 & .AND.(IDKPRD(1,I).EQ.198.OR.IDKPRD(1,I).EQ.199).AND.
39103 & ((IDKPRD(2,I).LE.12 .AND.IDKPRD(3,I).LE.12).OR.
39104 & (IDKPRD(2,I).GE.121.AND.IDKPRD(3,I).GE.121.AND.
39105 & IDKPRD(2,I).LE.132.AND.IDKPRD(3,I).LE.132)))
39106 & .OR.((IDKPRD(4,I).NE.0.AND.IDKPRD(5,I).EQ.0.AND.
39107 & (((IDKPRD(1,I).LE.12 .AND.IDKPRD(2,I).LE.12).OR.
39108 & (IDKPRD(1,I).GE.121.AND.IDKPRD(2,I).GE.121.AND.
39109 & IDKPRD(1,I).LE.132.AND.IDKPRD(2,I).LE.132))
39110 & .AND.ICHRG(IDKPRD(1,I))+ICHRG(IDKPRD(2,I)).NE.0)
39112 & (((IDKPRD(3,I).LE.12 .AND.IDKPRD(4,I).LE.12).OR.
39113 & (IDKPRD(3,I).GE.121.AND.IDKPRD(4,I).GE.121.AND.
39114 & IDKPRD(3,I).LE.132.AND.IDKPRD(4,I).LE.132))
39115 & .AND.ICHRG(IDKPRD(3,I))+ICHRG(IDKPRD(4,I)).NE.0))))) THEN
39121 C--add the new mode to the event record
39122 IF(NMODE.GT.0) THEN
39128 IDKPRD(1,NDKYS) = 198
39129 IDKPRD(2,NDKYS) = 199
39131 IDKPRD(I,NDKYS) = 0
39135 C--now do the ZZ modes
39140 IF(IDK(I).EQ.IH.AND.(IDKPRD(3,I).NE.0.AND.IDKPRD(4,I).EQ.0
39141 & .AND.IDKPRD(1,I).EQ.200.AND.
39142 & ((IDKPRD(2,I).LE.12 .AND.IDKPRD(3,I).LE.12).OR.
39143 & (IDKPRD(2,I).GE.121.AND.IDKPRD(3,I).GE.121.AND.
39144 & IDKPRD(2,I).LE.132.AND.IDKPRD(3,I).LE.132))
39145 & .OR.((IDKPRD(4,I).NE.0.AND.IDKPRD(5,I).EQ.0.AND.
39146 & (((IDKPRD(1,I).LE.12 .AND.IDKPRD(2,I).LE.12).OR.
39147 & (IDKPRD(1,I).GE.121.AND.IDKPRD(2,I).GE.121.AND.
39148 & IDKPRD(1,I).LE.132.AND.IDKPRD(2,I).LE.132))
39149 & .AND.ICHRG(IDKPRD(1,I))+ICHRG(IDKPRD(2,I)).EQ.0)
39151 & (((IDKPRD(3,I).LE.12 .AND.IDKPRD(4,I).LE.12).OR.
39152 & (IDKPRD(3,I).GE.121.AND.IDKPRD(4,I).GE.121.AND.
39153 & IDKPRD(3,I).LE.132.AND.IDKPRD(4,I).LE.132))
39154 & .AND.ICHRG(IDKPRD(3,I))+ICHRG(IDKPRD(4,I)).EQ.0))))) THEN
39160 C--add the new mode to the event record
39161 IF(NMODE.GT.0) THEN
39167 IDKPRD(1,NDKYS) = 200
39168 IDKPRD(2,NDKYS) = 200
39170 IDKPRD(I,NDKYS) = 0
39174 IF(.NOT.REMOVE) RETURN
39175 C--now remove the modes we have marked
39179 10 IF(NME(I+J).EQ.-100) I=I+1
39181 BRFRAC(J)=BRFRAC(I+J)
39184 IDKPRD(K,J)=IDKPRD(K,I+J)
39186 IF(NME(J).EQ.-100) GOTO 10
39188 C--reset the number of modes
39192 *CMZ :- -02/04/01 12.11.55 by Peter Richardson
39193 *-- Author : Peter Richardson
39194 C-----------------------------------------------------------------------
39195 SUBROUTINE HWIPHS(IOPT)
39196 C-----------------------------------------------------------------------
39197 C Subroutine to initialise the multichannel integration
39198 C IOPT = 1 sets the weights for the different channels to their
39200 C IOPT = 2 optimises the weights for the process selected
39201 C-----------------------------------------------------------------------
39202 INCLUDE 'HERWIG65.INC'
39203 INTEGER I,IPRC,ICH,IOPT,ISTP,IWGT,IFER,IANT,IGAU,IQRK
39204 LOGICAL CALLED,TEV,LHC
39205 DOUBLE PRECISION CHNPST(IMAXCH,IMAXOP),D(IMAXOP),CHWGTS(IMAXCH),
39206 & TOTAL,DEM,DMIN,CV,CA,BR,WA(IMAXCH),WITOT,WI(IMAXCH),
39207 & TEVGWT(10,5),LHCGWT(10,5),TEVQWT(6,6,2),LHCQWT(6,6,2)
39209 DATA CALLED/.FALSE./
39210 DATA TEVGWT/0.19684D0,0.00403D0,0.63772D0,0.01209D0,0.01321D0,
39211 & 0.00054D0,0.12984D0,0.00257D0,0.00296D0,0.00019D0,
39212 & 0.24146D0,0.00944D0,0.33949D0,0.01430D0,0.01918D0,
39213 & 0.00169D0,0.33919D0,0.01433D0,0.01931D0,0.00161D0,
39214 & 0.22270D0,0.00004D0,0.38873D0,0.00007D0,0.00009D0,
39215 & 0.00000D0,0.38820D0,0.00007D0,0.00009D0,0.00000D0,
39216 & 0.03228D0,0.00629D0,0.43227D0,0.01147D0,0.00010D0,
39217 & 0.03685D0,0.43270D0,0.01193D0,0.00010D0,0.03602D0,
39218 & 0.05828D0,0.00018D0,0.46870D0,0.00033D0,0.00047D0,
39219 & 0.00092D0,0.46940D0,0.00033D0,0.00047D0,0.00094D0/
39220 DATA LHCGWT/0.10679D0,0.00075D0,0.50915D0,0.00105D0,0.00126D0,
39221 & 0.00039D0,0.37853D0,0.00080D0,0.00092D0,0.00037D0,
39222 & 0.18163D0,0.00456D0,0.38555D0,0.00906D0,0.01160D0,
39223 & 0.00095D0,0.38498D0,0.00920D0,0.01163D0,0.00084D0,
39224 & 0.16647D0,0.00003D0,0.41691D0,0.00007D0,0.00009D0,
39225 & 0.00000D0,0.41627D0,0.00007D0,0.00009D0,0.00000D0,
39226 & 0.01957D0,0.00578D0,0.42971D0,0.01087D0,0.00015D0,
39227 & 0.02305D0,0.47944D0,0.00750D0,0.00016D0,0.02377D0,
39228 & 0.03659D0,0.00027D0,0.45268D0,0.00041D0,0.00063D0,
39229 & 0.00062D0,0.50700D0,0.00045D0,0.00069D0,0.00066D0/
39230 DATA TEVQWT/0.37855D0,0.15212D0,0.38016D0,0.00048D0,0.00047D0,
39231 & 0.08822D0,0.37292D0,0.19051D0,0.36770D0,0.00178D0,
39232 & 0.00180D0,0.06529D0,0.37724D0,0.12202D0,0.37579D0,
39233 & 0.00013D0,0.00013D0,0.12470D0,0.36728D0,0.12100D0,
39234 & 0.36521D0,0.00014D0,0.00014D0,0.14622D0,0.37548D0,
39235 & 0.12144D0,0.37410D0,0.00013D0,0.00013D0,0.12873D0,
39236 & 0.08694D0,0.32633D0,0.07192D0,0.00000D0,0.00000D0,
39237 & 0.51481D0,0.37831D0,0.15131D0,0.38081D0,0.00079D0,
39238 & 0.00077D0,0.08801D0,0.37494D0,0.19012D0,0.36496D0,
39239 & 0.00243D0,0.00246D0,0.06509D0,0.37726D0,0.12071D0,
39240 & 0.37641D0,0.00031D0,0.00032D0,0.12499D0,0.36248D0,
39241 & 0.12007D0,0.36203D0,0.00242D0,0.00243D0,0.15057D0,
39242 & 0.31054D0,0.13065D0,0.30760D0,0.04158D0,0.04178D0,
39243 & 0.16785D0,0.04116D0,0.00125D0,0.04116D0,0.32149D0,
39244 & 0.32030D0,0.27465D0/
39245 DATA LHCQWT/0.45556D0,0.06337D0,0.45712D0,0.00022D0,0.00022D0,
39246 & 0.02351D0,0.43712D0,0.07332D0,0.45023D0,0.00021D0,
39247 & 0.00021D0,0.03890D0,0.44611D0,0.08021D0,0.44572D0,
39248 & 0.00176D0,0.00170D0,0.02450D0,0.47268D0,0.03728D0,
39249 & 0.46843D0,0.00004D0,0.00004D0,0.02152D0,0.45662D0,
39250 & 0.06644D0,0.45586D0,0.00065D0,0.00063D0,0.01980D0,
39251 & 0.18486D0,0.27252D0,0.19067D0,0.00000D0,0.00000D0,
39252 & 0.35195D0,0.45530D0,0.06307D0,0.45770D0,0.00037D0,
39253 & 0.00038D0,0.02318D0,0.43653D0,0.07295D0,0.45173D0,
39254 & 0.00036D0,0.00036D0,0.03807D0,0.47312D0,0.04168D0,
39255 & 0.46993D0,0.00010D0,0.00010D0,0.01506D0,0.47047D0,
39256 & 0.03721D0,0.46860D0,0.00101D0,0.00100D0,0.02172D0,
39257 & 0.44379D0,0.05231D0,0.45440D0,0.01608D0,0.01624D0,
39258 & 0.01717D0,0.25443D0,0.04115D0,0.25503D0,0.18346D0,
39259 & 0.18255D0,0.08337D0/
39261 IF(IERROR.NE.0) RETURN
39262 C--initialize for tevatron or LHC based on energy
39263 TEV = NINT(PBEAM1/1000.0D0).EQ.1
39264 LHC = NINT(PBEAM1/1000.0D0).EQ.7
39265 C--first the initalisation
39267 IPRO = MOD(IPROC/100,100)
39268 IPRC=MOD(IPROC,100)
39273 C--gauge boson pair production
39274 IF(IPRO.EQ.28.AND.IPRC.LT.50) THEN
39275 IF(MOD(IPRC,5).NE.0.OR.IPRC.EQ.5.OR.IPRC.GT.25)
39276 & CALL HWWARN('HWIPHS',500,*999)
39280 C--select the process
39282 IF(IGAU.EQ.0) IGAU = IGAU+1
39285 CHNPRB(I) = TEVGWT(I,IGAU)
39289 CHNPRB(I) = LHCGWT(I,IGAU)
39297 DEM = ONE/DBLE(IOPSH)
39298 C--Drell Yan + 2 jet production
39299 ELSEIF(IPRO.EQ.29) THEN
39305 ELSEIF(IPRC.GE.11.AND.IPRC.LE.16) THEN
39308 CALL HWWARN('HWIPHS',502,*999)
39310 IQRK = MOD(IPRC,10)
39311 IF(IQRK.EQ.0.OR.IQRK.GT.6) CALL HWWARN('HWIPHS',503,*999)
39314 CHNPRB(I) = TEVQWT(I,IQRK,IGAU)
39318 CHNPRB(I) = LHCQWT(I,IQRK,IGAU)
39322 CHNPRB(I) = 1.0D0/6.0D0
39326 DEM = ONE/DBLE(IOPSH)
39331 IF(.NOT.CALLED) RETURN
39334 IF(CHON(I)) TOTAL = TOTAL+CHNPRB(I)
39336 IF(TOTAL.EQ.ZERO) CALL HWWARN('HWIPHS',501,*999)
39337 IF(TOTAL.NE.ONE) THEN
39339 IF(CHON(I)) CHNPRB(I) = CHNPRB(I)/TOTAL
39342 IF(.NOT.OPTM) RETURN
39344 C--optimise the weights
39346 C---SET UP INITIAL STATE
39351 PHEP(3,NHEP)=PBEAM1
39352 PHEP(4,NHEP)=EBEAM1
39353 PHEP(5,NHEP)=RMASS(IPART1)
39359 IDHEP(NHEP)=IDPDG(IPART1)
39364 PHEP(3,NHEP)=-PBEAM2
39365 PHEP(4,NHEP)=EBEAM2
39366 PHEP(5,NHEP)=RMASS(IPART2)
39372 IDHEP(NHEP)=IDPDG(IPART2)
39373 C---NEXT ENTRY IS OVERALL CM FRAME
39378 JMOHEP(1,NHEP)=NHEP-2
39379 JMOHEP(2,NHEP)=NHEP-1
39382 CALL HWVSUM(4,PHEP(1,NHEP-1),PHEP(1,NHEP-2),PHEP(1,NHEP))
39383 CALL HWUMAS(PHEP(1,NHEP))
39388 CHNPST(ICH,ISTP) = CHNPRB(ICH)
39389 IF(CHON(ICH)) WRITE(*,200) ICH,CHNPRB(ICH)
39391 C--compute the weights for the various channels
39393 IF(IPRO.EQ.28) THEN
39396 CALL HWDBZ2(200,IFER,IANT,CV,CA,BR,2,ZERO)
39397 ELSEIF(IPRO.EQ.29) THEN
39400 CALL HWDBOZ(200,IFER,IANT,CV,CA,BR,2)
39403 IF(CHON(ICH)) CHWGTS(ICH) = CHWGTS(ICH)+WI(ICH)
39409 WA(ICH) = CHWGTS(ICH)*DEM
39410 WITOT = WITOT+WA(ICH)*CHNPRB(ICH)
39413 C--now pick the next set of probablities for the different channels
39417 CHNPRB(ICH) = CHNPRB(ICH)*SQRT(WA(ICH))
39418 TOTAL = TOTAL+CHNPRB(ICH)
39422 CHNPRB(ICH)=CHNPRB(ICH)/TOTAL
39427 IF(D(ISTP).EQ.ZERO) THEN
39428 D(ISTP) = ABS(WITOT-WA(ICH))
39430 D(ISTP) = MAX(D(ISTP),ABS(WITOT-WA(ICH)))
39434 WRITE(*,300) D(ISTP)
39436 C--pick the best set of weights
39440 IF(D(I).LT.DMIN) THEN
39448 CHNPRB(I)=CHNPST(I,IWGT)
39449 WRITE(*,200) I,CHNPRB(I)
39455 50 FORMAT(/10X,'OPTIMIZING THE WEIGHTS FOR MULTICHANNEL INTEGRATION')
39456 100 FORMAT(/10X,'PERFORMING ITERATION',I2,/10X)
39457 200 FORMAT( 12X,'CHNPRB(',I2,') = ',F7.5)
39458 300 FORMAT(/10X,'DIFFERENCE IN W BETWEEN CHANNELS',E15.5)
39459 500 FORMAT(/10X,'SELECTED ITERATION',I2)
39462 *CMZ :- -27/07/99 16.38.25 by Peter Richardson
39463 *-- Author : Peter Richardson
39464 C-----------------------------------------------------------------------
39466 C-----------------------------------------------------------------------
39467 C Calculates the couplings for the SUSY decays for spin correlations
39468 C and 3/4 body matrix elements
39469 C-----------------------------------------------------------------------
39470 INCLUDE 'HERWIG65.INC'
39471 DOUBLE PRECISION HWUALF,PRE,MCHAR(2),QIJPP(4,4),SIJPP(4,4),
39472 & DIJ(2,2),QIJ(2,2),R(4,2),SIJ(2,2)
39473 INTEGER I,J,K,L,IH,IK,IL,IQ
39474 COMMON /HWSPNC/ SW,CW,TW,E,G,RT,ORT,MW,MZ,GS,AFN,AFG,AFC,OIJ,OIJP,
39475 & OIJPP,HNN,HCC,HNC,HFF,HWW,HZZ,ZAB,HHB
39476 DOUBLE PRECISION SW,CW,TW,E,G,RT,ORT,MW,MZ,GS,AFN(2,12,2,4),
39477 & AFG(2,6,2),AFC(2,12,2,2),OIJ(2,4,2),OIJP(2,2,2),OIJPP(2,4,4),
39478 & HNN(2,3,4,4),HCC(2,3,2,2),HNC(2,4,2),HFF(2,4,12),HWW(2),
39479 & HZZ(2),ZAB(12,2,2),HHB(2,3)
39480 DATA DIJ/1.0D0,0.0D0,0.0D0,1.0D0/
39482 IF(IERROR.NE.0) RETURN
39483 C--coupling constants
39485 CW = SQRT(ONE-SWEIN)
39487 E = SQRT(FOUR*PIFAC/128.0D0)
39493 IF(.NOT.SUSYIN) RETURN
39494 GS = SQRT(HWUALF(3,RMASS(449))*FOUR*PIFAC)
39495 C--couplings of the neutralinos to the squarks
39497 MCHAR(1) = ORT*G*ZMIXSS(L,3)/MW/COSB
39498 MCHAR(2) = ORT*G*ZMIXSS(L,4)/MW/SINB
39502 AFN(1,J,K,L) =-MCHAR(1)*RMASS(J)*QMIXSS(J,2,K)
39503 & -RT*E*QMIXSS(J,1,K)*SLFCH(J,L)
39504 2 AFN(2,J,K,L) =-ZSGNSS(L)*(MCHAR(1)*RMASS(J)*QMIXSS(J,1,K)
39505 & +RT*E*QMIXSS(J,2,K)*SRFCH(J,L))
39508 AFN(1,J,K,L) =-MCHAR(2)*RMASS(J)*QMIXSS(J,2,K)
39509 & -RT*E*QMIXSS(J,1,K)*SLFCH(J,L)
39510 1 AFN(2,J,K,L) =-ZSGNSS(L)*(MCHAR(2)*RMASS(J)*QMIXSS(J,1,K)
39511 & +RT*E*QMIXSS(J,2,K)*SRFCH(J,L))
39512 C--couplings of the neutralinos to the sleptons
39514 MCHAR(1) = ORT*G*ZMIXSS(L,3)/MW/COSB
39520 AFN(1,IK,K,L) =-(MCHAR(1)*RMASS(110+IL)*LMIXSS(J,2,K)
39521 & +RT*E*LMIXSS(J,1,K)*SLFCH(IL,L))
39522 4 AFN(2,IK,K,L) =-ZSGNSS(L)*(MCHAR(1)*RMASS(110+IL)*LMIXSS(J,1,K)
39523 & +RT*E*LMIXSS(J,2,K)*SRFCH(IL,L))
39528 AFN(1,IK,K,L) =-RT*E*LMIXSS(J,1,K)*SLFCH(IL,L)
39529 3 AFN(2,IK,K,L) = ZERO
39530 C--couplings of the gluinos to the squarks
39533 AFG(1,I,K) = -GS*RT*QMIXSS(I,1,K)
39534 5 AFG(2,I,K) = +GS*RT*QMIXSS(I,2,K)
39535 C--couplings of the charginos to the squarks
39537 MCHAR(1) =-WMXVSS(L,2)*ORT/MW/SINB
39538 MCHAR(2) =-WMXUSS(L,2)*ORT/MW/COSB
39542 AFC(1,J,K,L) = -G*( WMXUSS(L,1)*QMIXSS(J,1,K)
39543 & +MCHAR(2)*RMASS(J)*QMIXSS(J,2,K))
39544 7 AFC(2,J,K,L) = -G*WSGNSS(L)*MCHAR(1)*
39545 & RMASS(J+1)*QMIXSS(J,1,K)
39548 AFC(1,J,K,L) = -G*WSGNSS(L)*( WMXVSS(L,1)*QMIXSS(J,1,K)
39549 & +MCHAR(1)*RMASS(J)*QMIXSS(J,2,K))
39550 6 AFC(2,J,K,L) = -G*MCHAR(2)*RMASS(J-1)*QMIXSS(J,1,K)
39551 C--couplings of the charginos to the sleptons
39553 MCHAR(1) = -WMXUSS(L,2)*ORT/MW/COSB
39558 AFC(1,IL,K,L) = -G*(WMXUSS(L,1)*LMIXSS(J,1,K)
39559 & +RMASS(120+J)*MCHAR(1)*LMIXSS(J,2,K))
39560 9 AFC(2,IL,K,L) = ZERO
39564 AFC(1,IL,K,L) =-WSGNSS(L)*G*WMXVSS(L,1)
39565 8 AFC(2,IL,K,L) =-MCHAR(1)*G*RMASS(119+J)
39566 C--couplings of chargino-neutralino to the W
39569 OIJ(1,I,J) = G*( ORT*ZMXNSS(I,3)*WMXUSS(J,2)
39570 & +ZMXNSS(I,2)*WMXUSS(J,1))
39571 10 OIJ(2,I,J) = ZSGNSS(I)*WSGNSS(J)*G*(-ORT*ZMXNSS(I,4)*WMXVSS(J,2)
39572 & +ZMXNSS(I,2)*WMXVSS(J,1))
39573 C--couplings of chargino-chargino to the Z
39577 OIJP(1,I,J) = PRE*(-WMXUSS(I,1)*WMXUSS(J,1)
39578 & -HALF*WMXUSS(I,2)*WMXUSS(J,2)+DIJ(I,J)*SWEIN)
39579 11 OIJP(2,I,J) = WSGNSS(I)*WSGNSS(J)*PRE*(-WMXVSS(I,1)*WMXVSS(J,1)
39580 & -HALF*WMXVSS(I,2)*WMXVSS(J,2)+DIJ(I,J)*SWEIN)
39581 C--couplings of neutralino-neutralino to the Z
39585 OIJPP(1,I,J) = PRE*(ZMIXSS(I,3)*ZMIXSS(J,3)
39586 & -ZMIXSS(I,4)*ZMIXSS(J,4))
39587 12 OIJPP(2,I,J) = -ZSGNSS(I)*ZSGNSS(J)*OIJPP(1,I,J)
39588 C--couplings of the neutralino-neutralino to the Higgs
39591 QIJPP(I,J) = HALF*ZSGNSS(I)*
39592 & (ZMXNSS(I,3)*(ZMXNSS(J,2)-ZMXNSS(J,1)*TW)
39593 & +ZMXNSS(J,3)*(ZMXNSS(I,2)-ZMXNSS(I,1)*TW))
39594 13 SIJPP(I,J) = HALF*ZSGNSS(I)*
39595 & (ZMXNSS(I,4)*(ZMXNSS(J,2)-ZMXNSS(J,1)*TW)
39596 & +ZMXNSS(J,4)*(ZMXNSS(I,2)-ZMXNSS(I,1)*TW))
39599 HNN(1,1,I,J) = G*(QIJPP(I,J)*SINA+SIJPP(I,J)*COSA)
39600 HNN(2,1,I,J) = G*(QIJPP(J,I)*SINA+SIJPP(J,I)*COSA)
39601 HNN(1,2,I,J) = G*(SIJPP(I,J)*SINA-QIJPP(I,J)*COSA)
39602 HNN(2,2,I,J) = G*(SIJPP(J,I)*SINA-QIJPP(J,I)*COSA)
39603 HNN(1,3,I,J) = G*(QIJPP(I,J)*SINB-SIJPP(I,J)*COSB)
39604 14 HNN(2,3,I,J) =-G*(QIJPP(J,I)*SINB-SIJPP(J,I)*COSB)
39605 C--couplings of chargino-chargino to the Higgs
39608 QIJ(I,J) = ORT*WSGNSS(I)*WMXVSS(I,1)*WMXUSS(J,2)
39609 15 SIJ(I,J) = ORT*WSGNSS(I)*WMXVSS(I,2)*WMXUSS(J,1)
39612 HCC(1,1,I,J) = G*(QIJ(I,J)*SINA-SIJ(I,J)*COSA)
39613 HCC(2,1,I,J) = G*(QIJ(J,I)*SINA-SIJ(J,I)*COSA)
39614 HCC(1,2,I,J) =-G*(QIJ(I,J)*COSA+SIJ(I,J)*SINA)
39615 HCC(2,2,I,J) =-G*(QIJ(J,I)*COSA+SIJ(J,I)*SINA)
39616 HCC(1,3,I,J) = G*(QIJ(I,J)*SINB+SIJ(I,J)*COSB)
39617 16 HCC(2,3,I,J) =-G*(QIJ(J,I)*SINB+SIJ(J,I)*COSB)
39618 C--couplings of chargino-neutralino to the Higgs
39621 HNC(1,I,J) =-G*ZSGNSS(I)*SINB*(ZMXNSS(I,3)*WMXUSS(J,1)
39622 & -ORT*(ZMXNSS(I,2)+ZMXNSS(I,1)*TW)*WMXUSS(J,2))
39623 17 HNC(2,I,J) =-G*WSGNSS(J)*COSB*(ZMXNSS(I,4)*WMXVSS(J,1)
39624 & +ORT*(ZMXNSS(I,2)+ZMXNSS(I,1)*TW)*WMXVSS(J,2))
39625 C--fermion couplings to the Higgs
39626 R(1,1) = HALF*G*SINA/MW/COSB
39627 R(1,2) =-HALF*G*COSA/MW/SINB
39628 R(2,1) =-HALF*G*COSA/MW/COSB
39629 R(2,2) =-HALF*G*SINA/MW/SINB
39630 R(3,1) = HALF*G*TANB/MW
39631 R(3,2) = HALF*G*COTB/MW
39632 R(4,1) = G*ORT*TANB/MW
39633 R(4,2) = G*ORT*COTB/MW
39641 HFF(L,IK,J ) = R(IK,1)*RMASS(J)
39642 HFF(L,IK,K ) = R(IK,2)*RMASS(K)
39643 HFF(L,IK,IL) = R(IK,1)*RMASS(114+IL)
39644 19 HFF(L,IK,IQ) = ZERO
39645 HFF(2,3,J ) = -HFF(2,3, J)
39646 HFF(2,3,K ) = -HFF(2,3, K)
39647 HFF(2,3,IL) = -HFF(2,3,IL)
39648 HFF(1,4,I) = RMASS(J)*R(4,1)
39649 HFF(2,4,I) = RMASS(K)*R(4,2)
39650 HFF(1,4,I+3) = RMASS(114+IL)*R(4,1)
39651 18 HFF(2,4,I+3) = ZERO
39652 C--couplings of the Higgs to gauge boson pairs
39653 HWW(1) = G*MW*SINBMA
39654 HWW(2) = G*MW*COSBMA
39655 HZZ(1) = G*MZ*SINBMA/CW
39656 HZZ(2) = G*MZ*COSBMA/CW
39657 C--couplings of the Z to the sfermions
39665 ZAB(IQ,J,K) = G/CW*HALF*( QMIXSS(IQ,1,J)*QMIXSS(IQ,1,K)
39666 & -TWO*DIJ(J,K) *SWEIN/THREE)
39667 ZAB(IL,J,K) = G/CW*HALF*(-QMIXSS(IL,1,J)*QMIXSS(IL,1,K)
39668 & -FOUR*DIJ(J,K)*SWEIN/THREE)
39669 ZAB(IK,J,K) = G/CW*HALF*( LMIXSS(IQ,1,J)*LMIXSS(IQ,1,K)
39670 & -TWO*DIJ(J,K)*SWEIN)
39671 20 ZAB(IH,J,K) =-G/CW*HALF*DIJ(J,1)*DIJ(K,1)
39672 C--couplings of the Higgs Higgs to the gauge bosons
39673 HHB(1,1) = HALF*G*COSBMA
39674 HHB(1,2) = HALF*G*SINBMA
39676 HHB(2,1) =-HALF*G*COSBMA/CW
39677 HHB(2,2) = HALF*G*SINBMA/CW
39681 *CMZ :- -12/10/01 17.22.48 by Peter Richardson
39682 *-- Author : Peter Richardson
39683 C-----------------------------------------------------------------------
39685 C-----------------------------------------------------------------------
39686 C Initialise all the decay modes for three/four body MEs and spin
39688 C-----------------------------------------------------------------------
39689 INCLUDE 'HERWIG65.INC'
39690 INTEGER I,J,K,NDKYST
39691 C--set the number of two and three body modes to zero
39696 C--if not reading in decay info calculate it
39697 IF(LRDEC.EQ.0) THEN
39698 C--initialise the couplings for the various decay modes
39700 C--Top decays and SUSY three body decays (including SUSY gauge
39701 C--boson 2 body modes which are treated as three body)
39702 IF(THREEB) CALL HWISP3
39703 IF(IERROR.NE.0) RETURN
39704 C--then four body modes if needed
39705 IF(FOURB) CALL HWISP4
39706 IF(IERROR.NE.0) RETURN
39707 C--Two body modes if needed for spin correlations
39708 IF(SYSPIN) CALL HWISP2
39709 IF(IERROR.NE.0) RETURN
39710 C--otherwise read it in
39711 ELSEIF(LRDEC.GT.0) THEN
39713 IF (IPRINT.NE.0) WRITE (6,1) LRDEC
39714 1 FORMAT(/10X,'READING MATRIX ELEMENT TABLE ON UNIT',I4)
39715 OPEN(UNIT=LRDEC,FORM='UNFORMATTED',STATUS='UNKNOWN')
39717 READ(UNIT=LRDEC) NDKYST
39718 IF(NDKYS.NE.NDKYST) CALL HWWARN('HWISPN',501,*999)
39719 READ(UNIT=LRDEC) SYSPIN,THREEB,FOURB
39720 C--read two body decays
39722 READ(UNIT=LRDEC) N2MODE
39724 2 READ(UNIT=LRDEC) (A2MODE(J,I),J=1,2),P2MODE(I),WT2MAX(I),
39725 & ID2PRT(I),I2DRTP(I)
39727 C--read three body decays
39728 IF(SYSPIN.OR.THREEB) THEN
39729 READ(UNIT=LRDEC) N3MODE
39731 READ(UNIT=LRDEC) P3MODE(I),WT3MAX(I),ID3PRT(I),NDI3BY(I),
39732 & ((SPN3CF(J,K,I),J=1,NCFMAX),K=1,NCFMAX),N3NCFL(I)
39734 3 READ(UNIT=LRDEC) (A3MODE(K,J,I),K=1,2),(B3MODE(K,J,I),K=1,2),
39735 & I3DRTP(J,I),I3MODE(J,I),I3DRCF(J,I)
39736 C--read two body gauge boson modes
39737 READ(UNIT=LRDEC) NBMODE
39739 4 READ(UNIT=LRDEC) (ABMODE(J,I),J=1,2),
39740 & ((BBMODE(J,K,I),J=1,2),K=1,12),(PBMODE(K,I),K=1,12),
39741 & (WTBMAX(K,I),K=1,12),IDBPRT(I),IBMODE(I),IBDRTP(I)
39743 C--read four body decays
39745 READ(UNIT=LRDEC) N4MODE
39747 5 READ(UNIT=LRDEC) ((A4MODE(J,K,I),J=1,2),K=1,12),
39748 & ((B4MODE(J,K,I),J=1,2),K=1,12),
39749 & ((P4MODE(J,K,I),J=1,12),K=1,12),
39750 & ((WT4MAX(J,K,I),J=1,12),K=1,12),ID4PRT(I),
39751 & (I4MODE(J,I),J=1,2)
39753 C--finally read in the matrix element codes
39754 READ(UNIT=LRDEC) NME
39756 CALL HWWARN('HWISPN',500,*999)
39758 C--write the decay information if needed
39759 IF(LWDEC.GT.0) THEN
39761 IF (IPRINT.NE.0) WRITE (6,6) LWDEC
39762 6 FORMAT(/10X,'WRITING MATRIX ELEMENT TABLE ON UNIT',I4)
39763 OPEN(UNIT=LWDEC,FORM='UNFORMATTED',STATUS='UNKNOWN')
39765 WRITE(UNIT=LWDEC) NDKYS
39766 WRITE(UNIT=LWDEC) SYSPIN,THREEB,FOURB
39767 C--write two body decays
39769 WRITE(UNIT=LWDEC) N2MODE
39771 7 WRITE(UNIT=LWDEC) (A2MODE(J,I),J=1,2),P2MODE(I),WT2MAX(I),
39772 & ID2PRT(I),I2DRTP(I)
39774 C--write three body decays
39775 IF(SYSPIN.OR.THREEB) THEN
39776 WRITE(UNIT=LWDEC) N3MODE
39778 WRITE(UNIT=LWDEC) P3MODE(I),WT3MAX(I),ID3PRT(I),NDI3BY(I),
39779 & ((SPN3CF(J,K,I),J=1,NCFMAX),K=1,NCFMAX),N3NCFL(I)
39781 8 WRITE(UNIT=LWDEC) (A3MODE(K,J,I),K=1,2),(B3MODE(K,J,I),K=1,2),
39782 & I3DRTP(J,I),I3MODE(J,I),I3DRCF(J,I)
39783 C--write two body gauge boson modes
39784 WRITE(UNIT=LWDEC) NBMODE
39786 9 WRITE(UNIT=LWDEC) (ABMODE(J,I),J=1,2),
39787 & ((BBMODE(J,K,I),J=1,2),K=1,12),(PBMODE(K,I),K=1,12),
39788 & (WTBMAX(K,I),K=1,12),IDBPRT(I),IBMODE(I),IBDRTP(I)
39790 C--write four body decays
39792 WRITE(UNIT=LWDEC) N4MODE
39794 10 WRITE(UNIT=LWDEC) ((A4MODE(J,K,I),J=1,2),K=1,12),
39795 & ((B4MODE(J,K,I),J=1,2),K=1,12),
39796 & ((P4MODE(J,K,I),J=1,12),K=1,12),
39797 & ((WT4MAX(J,K,I),J=1,12),K=1,12),ID4PRT(I),
39798 & (I4MODE(J,I),J=1,2)
39800 C--finally write the matrix element codes
39801 WRITE(UNIT=LWDEC) NME
39806 *CMZ :- -30/09/02 14:05:28 by Peter Richardson
39807 *-- Author : Peter Richardson
39808 C-----------------------------------------------------------------------
39810 C-----------------------------------------------------------------------
39811 C Initialise the SUSY two body modes for spin correlations
39812 C-----------------------------------------------------------------------
39813 INCLUDE 'HERWIG65.INC'
39814 INTEGER I,J,IL,IH,L,L1,IM,O(2),II,JJ,III,JJJ,KKK
39815 COMMON /HWSPNC/ SW,CW,TW,E,G,RT,ORT,MW,MZ,GS,AFN,AFG,AFC,OIJ,OIJP,
39816 & OIJPP,HNN,HCC,HNC,HFF,HWW,HZZ,ZAB,HHB
39817 DOUBLE PRECISION SW,CW,TW,E,G,RT,ORT,MW,MZ,GS,AFN(2,12,2,4),
39818 & AFG(2,6,2),AFC(2,12,2,2),OIJ(2,4,2),OIJP(2,2,2),OIJPP(2,4,4),
39819 & HNN(2,3,4,4),HCC(2,3,2,2),HNC(2,4,2),HFF(2,4,12),HWW(2),
39820 & HZZ(2),ZAB(12,2,2),HHB(2,3),FPI
39822 DATA FPI/0.09298D0/
39823 IF(IERROR.NE.0.OR..NOT.SUSYIN) RETURN
39824 C--now the two body modes for spin corrections
39826 DO 1000 II=1,NMODES(JJ)
39832 IF(IDKPRD(2,I).EQ.0.OR.IDKPRD(3,I).NE.0.OR.
39833 & (NME(I).GT.10000.AND.NME(I).LT.50000)) GOTO 1000
39835 C--two body top to charged higgs decay
39836 IF(IDK(I).EQ.6.AND.IDKPRD(1,I).EQ.206.AND.
39837 & IDKPRD(2,I).EQ.5) THEN
39839 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',100,*999)
39840 NME(I) = 30000+N2MODE
39843 P2MODE(N2MODE) = ONE
39845 201 A2MODE(J,N2MODE) = HFF(O(J),4,3)
39846 C--two body antitop to charged higgs
39847 ELSEIF(IDK(I).EQ.12.AND.IDKPRD(1,I).EQ.207.AND.
39848 & IDKPRD(2,I).EQ.11) THEN
39850 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',101,*999)
39851 NME(I) = 30000+N2MODE
39853 I2DRTP(N2MODE) = 14
39854 P2MODE(N2MODE) = ONE
39856 202 A2MODE(J,N2MODE) = HFF( J ,4,3)
39857 C--two body modes of the gluino
39858 ELSEIF(L1.EQ.0) THEN
39859 L = IDKPRD(1,I)-449
39860 C--gluino to antisfermion fermion
39861 IF(IDPDG(IDKPRD(2,I)).GT.0.AND.L.GE.-48.AND.L.LE.-1) THEN
39863 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',102,*999)
39864 NME(I) = 30000+N2MODE
39867 P2MODE(N2MODE) = HALF
39868 IM = MOD(INT((IDKPRD(1,I)-389)/12)+1,2)+1
39869 IL = 6*INT((IDKPRD(1,I)-401)/24)+MOD(IDKPRD(1,I)-401,6)+1
39871 1 A2MODE(J,N2MODE) = AFG(J,IL,IM)
39872 C--gluino to sfermion antifermion
39873 ELSEIF(IDPDG(IDKPRD(2,I)).LT.0.AND.L.GE.-48.AND.L.LE.-1) THEN
39875 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',103,*999)
39876 NME(I) = 30000+N2MODE
39879 P2MODE(N2MODE) = HALF
39880 IM = MOD(INT((IDKPRD(1,I)-389)/12)+1,2)+1
39881 IL = 6*INT((IDKPRD(1,I)-401)/24)+MOD(IDKPRD(1,I)-401,6)+1
39883 2 A2MODE(J,N2MODE) = AFG(O(J),IL,IM)
39884 C--gluino to neutralino gluon
39885 ELSEIF(L.GE.1.AND.L.LE.4.AND.IDKPRD(2,I).EQ.13) THEN
39887 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',104,*999)
39888 NME(I) = 30000+N2MODE
39891 P2MODE(N2MODE) = 8.0D0*PIFAC*RMASS(IDK(I))**3/
39892 & (RMASS(IDK(I))**2-RMASS(IDKPRD(1,I))**2)**3*
39893 & HBAR/RLTIM(IDK(I))*BRFRAC(I)
39894 A2MODE(1,N2MODE) = ZSGNSS(L)
39895 C--gluino to gravitino gluon
39896 ELSEIF(IDKPRD(1,I).EQ.458.AND.IDKPRD(2,I).EQ.13) THEN
39898 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',105,*999)
39899 NME(I) = 30000+N2MODE
39902 P2MODE(N2MODE) = ONE/24.0D0
39904 C--two body modes of the neutralinos
39905 ELSEIF(L1.GE.1.AND.L1.LE.4) THEN
39906 L = IDKPRD(1,I)-449
39907 IH = IDKPRD(2,I)-202
39908 C--first the neutralino modes to neutralino Higgs
39909 IF(L.GE.1.AND.L.LE.4.AND.IH.GE.1.AND.IH.LE.3) THEN
39911 IF(N2MODE.GE.NMODE2) CALL HWWARN('HWISP2',106,*999)
39912 NME(I) = 30000+N2MODE
39915 P2MODE(N2MODE) = ONE
39917 3 A2MODE(J,N2MODE) = HNN(J,IH,L,L1)
39918 C--neutralino to positive chargino negative Higgs
39919 ELSEIF((L.EQ.5.OR.L.EQ.6).AND.IH.EQ.5) THEN
39922 IF(N2MODE.GE.NMODE2) CALL HWWARN('HWISP2',107,*999)
39923 NME(I) = 30000+N2MODE
39926 P2MODE(N2MODE) = ONE
39928 4 A2MODE(J,N2MODE) = HNC(O(J),L1,L)
39929 C--neutralino to negative chargino positive Higgs
39930 ELSEIF((L.EQ.7.OR.L.EQ.8).AND.IH.EQ.6) THEN
39933 IF(N2MODE.GE.NMODE2) CALL HWWARN('HWISP2',108,*999)
39934 NME(I) = 30000+N2MODE
39937 P2MODE(N2MODE) = ONE
39939 5 A2MODE(J,N2MODE) = HNC(J,L1,L)
39940 C--neutralino to antisfermion sfermion
39941 ELSEIF(IDPDG(IDKPRD(2,I)).GT.0.AND.L.GE.-48.AND.L.LE.-1) THEN
39943 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',109,*999)
39944 NME(I) = 30000+N2MODE
39947 P2MODE(N2MODE) = ONE
39948 IM = MOD(INT((IDKPRD(1,I)-389)/12)+1,2)+1
39949 IL = 6*INT((IDKPRD(1,I)-401)/24)+MOD(IDKPRD(1,I)-401,6)+1
39950 IF(IL.LE.6) P2MODE(N2MODE) = THREE
39952 6 A2MODE(J,N2MODE) = AFN(J,IL,IM,L1)
39953 C--neutralino to sfermion antifermion
39954 ELSEIF(IDPDG(IDKPRD(2,I)).LT.0.AND.L.GE.-48.AND.L.LE.-1) THEN
39956 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',110,*999)
39957 NME(I) = 30000+N2MODE
39960 P2MODE(N2MODE) = ONE
39961 IM = MOD(INT((IDKPRD(1,I)-389)/12)+1,2)+1
39962 IL = 6*INT((IDKPRD(1,I)-401)/24)+MOD(IDKPRD(1,I)-401,6)+1
39963 IF(IL.LE.6) P2MODE(N2MODE) = THREE
39965 7 A2MODE(J,N2MODE) = AFN(O(J),IL,IM,L1)
39966 C--neutralino to neutralino photon
39967 ELSEIF(L.GE.1.AND.L.LE.4.AND.IDKPRD(2,I).EQ.59) THEN
39969 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',111,*999)
39970 NME(I) = 30000+N2MODE
39973 P2MODE(N2MODE) = 8.0D0*PIFAC*RMASS(IDK(I))**3/
39974 & (RMASS(IDK(I))**2-RMASS(IDKPRD(1,I))**2)**3*
39975 & HBAR/RLTIM(IDK(I))*BRFRAC(I)
39976 A2MODE(1,N2MODE) = ZSGNSS(L)*ZSGNSS(L1)
39977 C--neutralino to gravitino photon for GMSB
39978 ELSEIF(IDKPRD(1,I).EQ.458.AND.IDKPRD(2,I).EQ.59) THEN
39980 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',112,*999)
39981 NME(I) = 30000+N2MODE
39984 P2MODE(N2MODE) = ZMIXSS(L1,1)**2/24.0D0
39985 C--neutralino to gravitino Higgs for GMSB
39986 ELSEIF(IDKPRD(1,I).EQ.458.AND.IH.GE.1.AND.IH.LE.3) THEN
39988 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',113,*999)
39989 NME(I) = 30000+N2MODE
39991 I2DRTP(N2MODE) = 10
39993 P2MODE(N2MODE) = ZMIXSS(L1,3)*SINA-ZMIXSS(L1,4)*COSA
39994 ELSEIF(IH.EQ.2) THEN
39995 P2MODE(N2MODE) = ZMIXSS(L1,3)*COSA+ZMIXSS(L1,4)*SINA
39997 P2MODE(N2MODE) = ZMIXSS(L1,3)*SINB+ZMIXSS(L1,4)*COSB
39999 P2MODE(N2MODE) = P2MODE(N2MODE)**2/3.0D0
40001 CALL HWWARN('HWISP2',1,*999)
40003 C--two body modes of the positive charginos
40004 ELSEIF(L1.EQ.5.OR.L1.EQ.6) THEN
40006 L = IDKPRD(1,I)-449
40007 IH = IDKPRD(2,I)-202
40008 C--first the chargino modes to chargino Higgs
40009 IF((L.EQ.5.OR.L.EQ.6).AND.IH.GE.1.AND.IH.LE.3) THEN
40012 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',114,*999)
40013 NME(I) = 30000+N2MODE
40016 P2MODE(N2MODE) = ONE
40018 8 A2MODE(J,N2MODE) = HCC(J,IH,L,L1)
40019 C--then the chargino modes to neutralino Higgs
40020 ELSEIF(L.GE.1.AND.L.LE.4.AND.IH.EQ.4) THEN
40022 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',115,*999)
40023 NME(I) = 30000+N2MODE
40026 P2MODE(N2MODE) = ONE
40028 9 A2MODE(J,N2MODE) = HNC(J,L,L1)
40029 C--chargino modes to antisfermion fermion
40030 ELSEIF(IDPDG(IDKPRD(2,I)).GT.0.AND.L.GE.-48.AND.L.LE.-1) THEN
40032 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',116,*999)
40033 NME(I) = 30000+N2MODE
40036 P2MODE(N2MODE) = ONE
40037 IM = MOD(INT((IDKPRD(1,I)-389)/12)+1,2)+1
40038 IL = 6*INT((IDKPRD(1,I)-401)/24)+MOD(IDKPRD(1,I)-401,6)+1
40039 IF(IL.LE.6) P2MODE(N2MODE) = THREE
40041 10 A2MODE(J,N2MODE) = AFC(J,IL,IM,L1)
40042 C--chargino modes to sfermion antifermion
40043 ELSEIF(IDPDG(IDKPRD(2,I)).LT.0.AND.L.GE.-48.AND.L.LE.-1) THEN
40045 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',117,*999)
40046 NME(I) = 30000+N2MODE
40049 P2MODE(N2MODE) = ONE
40050 IM = MOD(INT((IDKPRD(1,I)-389)/12)+1,2)+1
40051 IL = 6*INT((IDKPRD(1,I)-401)/24)+MOD(IDKPRD(1,I)-401,6)+1
40052 IF(IL.LE.6) P2MODE(N2MODE) = THREE
40054 11 A2MODE(J,N2MODE) = AFC(O(J),IL,IM,L1)
40055 C--chargino --> neutralino pi+
40056 ELSEIF(L.GE.1.AND.L.LE.4.AND.IDKPRD(2,I).EQ.38) THEN
40058 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',118,*999)
40059 NME(I) = 30000+N2MODE
40062 P2MODE(N2MODE) = FPI**2*G**2
40064 12 A2MODE(J,N2MODE) = OIJ(J,L,L1)
40066 C--two body modes of the negative charginos
40067 ELSEIF(L1.EQ.7.OR.L1.EQ.8) THEN
40069 L = IDKPRD(1,I)-449
40070 IH = IDKPRD(2,I)-202
40071 C--first the chargino modes to chargino Higgs
40072 IF((L.EQ.7.OR.L.EQ.8).AND.IH.GE.1.AND.IH.LE.3) THEN
40075 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',119,*999)
40076 NME(I) = 30000+N2MODE
40079 P2MODE(N2MODE) = ONE
40081 13 A2MODE(J,N2MODE) = HCC(O(J),IH,L,L1)
40082 C--then the chargino modes to neutralino Higgs
40083 ELSEIF(L.GE.1.AND.L.LE.4.AND.IH.EQ.5) THEN
40085 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',120,*999)
40086 NME(I) = 30000+N2MODE
40089 P2MODE(N2MODE) = ONE
40091 14 A2MODE(J,N2MODE) = HNC(O(J),L,L1)
40092 C--chargino to antisfermion fermion
40093 ELSEIF(IDPDG(IDKPRD(2,I)).GT.0.AND.L.GE.-48.AND.L.LE.-1) THEN
40095 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',121,*999)
40096 NME(I) = 30000+N2MODE
40099 P2MODE(N2MODE) = ONE
40100 IM = MOD(INT((IDKPRD(1,I)-389)/12)+1,2)+1
40101 IL = 6*INT((IDKPRD(1,I)-401)/24)+MOD(IDKPRD(1,I)-401,6)+1
40102 IF(IL.LE.6) P2MODE(N2MODE) = THREE
40104 15 A2MODE(J,N2MODE) = AFC(J,IL,IM,L1)
40105 C--chargino to sfermion antifermion
40106 ELSEIF(IDPDG(IDKPRD(2,I)).LT.0.AND.L.GE.-48.AND.L.LE.-1) THEN
40108 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',122,*999)
40109 NME(I) = 30000+N2MODE
40112 P2MODE(N2MODE) = ONE
40113 IM = MOD(INT((IDKPRD(1,I)-389)/12)+1,2)+1
40114 IL = 6*INT((IDKPRD(1,I)-401)/24)+MOD(IDKPRD(1,I)-401,6)+1
40115 IF(IL.LE.6) P2MODE(N2MODE) = THREE
40117 16 A2MODE(J,N2MODE) = AFC(O(J),IL,IM,L1)
40118 C--chargino --> neutralino pi-
40119 ELSEIF(L.GE.1.AND.L.LE.4.AND.IDKPRD(2,I).EQ.30) THEN
40121 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',123,*999)
40122 NME(I) = 30000+N2MODE
40125 P2MODE(N2MODE) = FPI**2*G**2
40127 17 A2MODE(J,N2MODE) =-OIJ(O(J),L,L1)
40129 ELSEIF(L1.GE.-48.AND.L1.LT.0) THEN
40130 C--sfermion decay modes
40131 L = IDKPRD(1,I)-449
40132 C--first sfermion modes to gluinos
40134 C--first sfermion --> fermion gluino
40135 IF(IDPDG(IDKPRD(2,I)).GT.0) THEN
40137 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',124,*999)
40138 NME(I) = 30000+N2MODE
40141 P2MODE(N2MODE) = FOUR/THREE
40142 IM = MOD(INT((IDK(I)-389)/12)+1,2)+1
40143 IL = 6*INT((IDK(I)-401)/24)+MOD(IDK(I)-401,6)+1
40145 18 A2MODE(J,N2MODE) = AFG(J,IL,IM)
40146 C--then antisfermion --> antifermion gluino
40149 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',125,*999)
40150 NME(I) = 30000+N2MODE
40153 P2MODE(N2MODE) = FOUR/THREE
40154 IM = MOD(INT((IDK(I)-389)/12)+1,2)+1
40155 IL = 6*INT((IDK(I)-401)/24)+MOD(IDK(I)-401,6)+1
40157 19 A2MODE(J,N2MODE) = AFG(O(J),IL,IM)
40159 C--then sfermion modes to neutralinos
40160 ELSEIF(L.GE.1.AND.L.LE.4) THEN
40161 C--first sfermion --> fermion neutralino
40162 IF(IDPDG(IDKPRD(2,I)).GT.0) THEN
40164 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',126,*999)
40165 NME(I) = 30000+N2MODE
40168 P2MODE(N2MODE) = ONE
40169 IM = MOD(INT((IDK(I)-389)/12)+1,2)+1
40170 IL = 6*INT((IDK(I)-401)/24)+MOD(IDK(I)-401,6)+1
40172 20 A2MODE(J,N2MODE) = AFN(J,IL,IM,L)
40173 C--then antisfermion --> fermion neutralino
40176 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',127,*999)
40177 NME(I) = 30000+N2MODE
40180 P2MODE(N2MODE) = ONE
40181 IM = MOD(INT((IDK(I)-389)/12)+1,2)+1
40182 IL = 6*INT((IDK(I)-401)/24)+MOD(IDK(I)-401,6)+1
40184 21 A2MODE(J,N2MODE) = AFN(O(J),IL,IM,L)
40186 C--sfermion modes to charginos
40187 ELSEIF(L.GE.5.AND.L.LE.8) THEN
40189 C--first sfermion --> fermion chargino
40190 IF(IDPDG(IDKPRD(2,I)).GT.0) THEN
40192 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',128,*999)
40193 NME(I) = 30000+N2MODE
40196 P2MODE(N2MODE) = ONE
40197 IM = MOD(INT((IDK(I)-389)/12)+1,2)+1
40198 IL = 6*INT((IDK(I)-401)/24)+MOD(IDK(I)-401,6)+1
40200 22 A2MODE(J,N2MODE) = AFC(J,IL,IM,L)
40201 C--then antisfermion --> fermion chargino
40204 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',129,*999)
40205 NME(I) = 30000+N2MODE
40208 P2MODE(N2MODE) = ONE
40209 IM = MOD(INT((IDK(I)-389)/12)+1,2)+1
40210 IL = 6*INT((IDK(I)-401)/24)+MOD(IDK(I)-401,6)+1
40212 23 A2MODE(J,N2MODE) = AFC(O(J),IL,IM,L)
40214 C--sfermion modes to fermion gravitino
40215 ELSEIF(IDKPRD(2,I).EQ.458) THEN
40216 IF(IDPDG(IDKPRD(1,I)).GT.0) THEN
40218 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',130,*999)
40219 NME(I) = 30000+N2MODE
40221 I2DRTP(N2MODE) = 11
40222 P2MODE(N2MODE) = ONE/THREE
40223 IM = MOD(INT((IDK(I)-389)/12)+1,2)+1
40224 IL = 6*INT((IDK(I)-401)/24)+MOD(IDK(I)-401,6)+1
40227 40 A2MODE(J,N2MODE) = QMIXSS(IL,O(J),IM)
40230 41 A2MODE(J,N2MODE) = LMIXSS(IL-6,O(J),IM)
40234 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',131,*999)
40235 NME(I) = 30000+N2MODE
40237 I2DRTP(N2MODE) = 12
40238 P2MODE(N2MODE) = ONE/THREE
40239 IM = MOD(INT((IDK(I)-389)/12)+1,2)+1
40240 IL = 6*INT((IDK(I)-401)/24)+MOD(IDK(I)-401,6)+1
40243 42 A2MODE(J,N2MODE) = QMIXSS(IL,O(J),IM)
40246 43 A2MODE(J,N2MODE) = LMIXSS(IL-6,O(J),IM)
40249 C--R-parity violating decay modes
40251 ELSEIF(IDK(I).GE.425.AND.IDK(I).LE.448.AND.
40252 & IDKPRD(1,I).GE.121.AND.IDKPRD(1,I).LE.132.AND.
40253 & IDKPRD(2,I).GE.121.AND.IDKPRD(2,I).LE.132) THEN
40254 C--charged slepton decays
40255 IF(MOD(IDK(I),2).EQ.1) THEN
40256 C--right slepton decay
40257 IF(IDPDG(IDKPRD(1,I))/ABS(IDPDG(IDKPRD(1,I))).EQ.
40258 & IDPDG(IDKPRD(2,I))/ABS(IDPDG(IDKPRD(2,I)))) THEN
40261 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',132,*999)
40262 NME(I) = 30000+N2MODE
40264 P2MODE(N2MODE) = ONE
40265 IF(IDPDG(IDK(I)).GT.0) THEN
40266 KKK = (IDK(I)-423)/2
40273 IF(MOD(IDKPRD(1,I),2).EQ.0) THEN
40274 III = (IDKPRD(1,I)-120)/2
40275 JJJ = (IDKPRD(2,I)-119)/2
40277 III = (IDKPRD(2,I)-120)/2
40278 JJJ = (IDKPRD(1,I)-119)/2
40281 A2MODE(1,N2MODE) = LMIXSS(2*KKK-1,2,IM)*
40282 & LAMDA1(III,JJJ,KKK)
40283 A2MODE(2,N2MODE) = 0.0D0
40285 C--antiparticle decay
40286 KKK = (IDK(I)-429)/2
40293 IF(MOD(IDKPRD(1,I),2).EQ.0) THEN
40294 III = (IDKPRD(1,I)-126)/2
40295 JJJ = (IDKPRD(2,I)-125)/2
40297 III = (IDKPRD(2,I)-126)/2
40298 JJJ = (IDKPRD(1,I)-125)/2
40300 I2DRTP(N2MODE) = 13
40301 A2MODE(1,N2MODE) = 0.0D0
40302 A2MODE(2,N2MODE) = LMIXSS(2*KKK-1,2,IM)*
40303 & LAMDA1(III,JJJ,KKK)
40305 C--left slepton decay
40308 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',133,*999)
40309 NME(I) = 30000+N2MODE
40311 P2MODE(N2MODE) = ONE
40312 IF(IDPDG(IDK(I)).GT.0) THEN
40313 JJJ = (IDK(I)-423)/2
40320 IF(MOD(IDKPRD(1,I),2).EQ.0) THEN
40321 III = (IDKPRD(1,I)-126)/2
40322 KKK = (IDKPRD(2,I)-119)/2
40325 III = (IDKPRD(2,I)-126)/2
40326 KKK = (IDKPRD(1,I)-119)/2
40329 A2MODE(1,N2MODE) = 0.0D0
40330 A2MODE(2,N2MODE) = LMIXSS(2*JJJ-1,1,IM)*
40331 & LAMDA1(III,JJJ,KKK)
40333 JJJ = (IDK(I)-429)/2
40340 IF(MOD(IDKPRD(1,I),2).EQ.0) THEN
40341 III = (IDKPRD(1,I)-120)/2
40342 KKK = (IDKPRD(2,I)-125)/2
40345 III = (IDKPRD(2,I)-120)/2
40346 KKK = (IDKPRD(1,I)-125)/2
40349 A2MODE(1,N2MODE) = LMIXSS(2*JJJ-1,1,IM)*
40350 & LAMDA1(III,JJJ,KKK)
40351 A2MODE(2,N2MODE) = 0.0D0
40354 C--sneutrino decays
40355 ELSEIF(MOD(IDK(I),2).EQ.0.AND.IDK(I).LE.436) THEN
40358 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',134,*999)
40359 NME(I) = 30000+N2MODE
40361 P2MODE(N2MODE) = ONE
40362 IF(IDPDG(IDK(I)).GT.0) THEN
40363 III = (IDK(I)-424)/2
40364 IF(IDPDG(IDKPRD(1,I)).GT.0) THEN
40365 KKK = (IDKPRD(1,I)-119)/2
40366 JJJ = (IDKPRD(2,I)-125)/2
40369 JJJ = (IDKPRD(1,I)-125)/2
40370 KKK = (IDKPRD(2,I)-119)/2
40373 A2MODE(1,N2MODE) = 0.0D0
40374 A2MODE(2,N2MODE) = LAMDA1(III,JJJ,KKK)
40375 C--antisneutrino decay
40377 III = (IDK(I)-430)/2
40378 IF(IDPDG(IDKPRD(1,I)).LT.0) THEN
40379 KKK = (IDKPRD(1,I)-125)/2
40380 JJJ = (IDKPRD(2,I)-119)/2
40383 JJJ = (IDKPRD(1,I)-119)/2
40384 KKK = (IDKPRD(2,I)-125)/2
40387 A2MODE(1,N2MODE) = LAMDA1(III,JJJ,KKK)
40388 A2MODE(2,N2MODE) = 0.0D0
40393 ELSEIF(IDK(I).GE.401.AND.IDK(I).LE.424.AND.
40394 & IDKPRD(1,I).GE.121.AND.IDKPRD(2,I).LE.132.AND.
40395 & IDKPRD(2,I).LE.12) THEN
40396 C--up type squark decay
40397 IF(MOD(IDK(I),2).EQ.0) THEN
40399 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',135,*999)
40400 NME(I) = 30000+N2MODE
40402 P2MODE(N2MODE) = ONE
40403 IF(IDPDG(IDK(I)).GT.0) THEN
40404 JJJ = (IDK(I)-400)/2
40411 III = (IDKPRD(1,I)-125)/2
40412 KKK = (IDKPRD(2,I)+1)/2
40414 A2MODE(1,N2MODE) = ZERO
40415 A2MODE(2,N2MODE) = QMIXSS(2*JJJ,1,IM)*
40416 & LAMDA2(III,JJJ,KKK)
40418 JJJ = (IDK(I)-406)/2
40425 III = (IDKPRD(1,I)-119)/2
40426 KKK = (IDKPRD(2,I)-5)/2
40428 A2MODE(1,N2MODE) = QMIXSS(2*JJJ,1,IM)*
40429 & LAMDA2(III,JJJ,KKK)
40430 A2MODE(2,N2MODE) = ZERO
40432 C--down type squark to lepton up
40433 ELSEIF(MOD(IDK(I),2).EQ.1.AND.MOD(IDKPRD(1,I),2).EQ.1) THEN
40435 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',136,*999)
40436 NME(I) = 30000+N2MODE
40438 P2MODE(N2MODE) = ONE
40440 IF(IDPDG(IDK(I)).GT.0) THEN
40441 KKK = (IDK(I)-399)/2
40448 III = (IDKPRD(1,I)-119)/2
40449 JJJ = IDKPRD(2,I)/2
40451 A2MODE(1,N2MODE) = QMIXSS(2*KKK-1,2,IM)*
40452 & LAMDA2(III,JJJ,KKK)
40453 A2MODE(2,N2MODE) = ZERO
40456 KKK = (IDK(I)-405)/2
40463 III = (IDKPRD(1,I)-125)/2
40464 JJJ = (IDKPRD(2,I)-6)/2
40465 I2DRTP(N2MODE) = 13
40466 A2MODE(1,N2MODE) = ZERO
40467 A2MODE(2,N2MODE) = QMIXSS(2*KKK-1,2,IM)*
40468 & LAMDA2(III,JJJ,KKK)
40470 C--down (left) squark --> nu d
40471 ELSEIF(MOD(IDK(I),2).EQ.1.AND.
40472 & IDPDG(IDK(I))/ABS(IDPDG(IDK(I))).EQ.
40473 & -IDPDG(IDKPRD(1,I))/ABS(IDPDG(IDKPRD(1,I)))) THEN
40475 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',137,*999)
40476 NME(I) = 30000+N2MODE
40478 P2MODE(N2MODE) = ONE
40479 IF(IDPDG(IDK(I)).GT.0) THEN
40480 JJJ = (IDK(I)-399)/2
40487 III = (IDKPRD(1,I)-126)/2
40488 KKK = (IDKPRD(2,I)+1)/2
40490 A2MODE(1,N2MODE) = ZERO
40491 A2MODE(2,N2MODE) = QMIXSS(2*JJJ-1,1,IM)*
40492 & LAMDA2(III,JJJ,KKK)
40494 JJJ = (IDK(I)-405)/2
40501 III = (IDKPRD(1,I)-120)/2
40502 KKK = (IDKPRD(2,I)-5)/2
40504 A2MODE(1,N2MODE) = QMIXSS(2*JJJ-1,1,IM)*
40505 & LAMDA2(III,JJJ,KKK)
40506 A2MODE(2,N2MODE) = ZERO
40508 C--down (right) squark --> nu d
40509 ELSEIF(MOD(IDK(I),2).EQ.1.AND.
40510 & IDPDG(IDK(I))/ABS(IDPDG(IDK(I))).EQ.
40511 & IDPDG(IDKPRD(1,I))/ABS(IDPDG(IDKPRD(1,I)))) THEN
40513 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',138,*999)
40514 NME(I) = 30000+N2MODE
40516 P2MODE(N2MODE) = ONE
40517 IF(IDPDG(IDK(I)).GT.0) THEN
40518 KKK = (IDK(I)-399)/2
40525 III = (IDKPRD(1,I)-120)/2
40526 JJJ = (IDKPRD(2,I)+1)/2
40528 A2MODE(1,N2MODE) = QMIXSS(2*KKK-1,2,IM)*
40529 & LAMDA2(III,JJJ,KKK)
40530 A2MODE(2,N2MODE) = ZERO
40532 KKK = (IDK(I)-405)/2
40539 III = (IDKPRD(1,I)-126)/2
40540 JJJ = (IDKPRD(2,I)-5)/2
40541 I2DRTP(N2MODE) = 13
40542 A2MODE(1,N2MODE) = ZERO
40543 A2MODE(2,N2MODE) = QMIXSS(2*KKK-1,2,IM)*
40544 & LAMDA2(III,JJJ,KKK)
40547 CALL HWWARN('HWISP2',2,*999)
40550 ELSEIF(IDK(I).GE.425.AND.IDK(I).LE.448.AND.
40551 & IDKPRD(1,I).LE.12.AND.IDKPRD(2,I).LE.12) THEN
40553 IF(MOD(IDK(I),2).EQ.0) THEN
40555 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',140,*999)
40556 NME(I) = 30000+N2MODE
40558 P2MODE(N2MODE) = THREE
40560 IF(IDPDG(IDK(I)).GT.0) THEN
40561 III = (IDK(I)-424)/2
40562 JJJ = (IDKPRD(1,I)-5)/2
40563 KKK = (IDKPRD(2,I)+1)/2
40565 A2MODE(1,N2MODE) = 0.0D0
40566 A2MODE(2,N2MODE) = LAMDA2(III,JJJ,KKK)
40569 III = (IDK(I)-430)/2
40570 JJJ = (IDKPRD(1,I)+1)/2
40571 KKK = (IDKPRD(2,I)-5)/2
40573 A2MODE(1,N2MODE) = LAMDA2(III,JJJ,KKK)
40574 A2MODE(2,N2MODE) = 0.0D0
40577 ELSEIF(MOD(IDK(I),2).EQ.1) THEN
40579 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',141,*999)
40580 NME(I) = 30000+N2MODE
40582 P2MODE(N2MODE) = THREE
40584 IF(IDPDG(IDK(I)).GT.0) THEN
40585 III = (IDK(I)-423)/2
40592 JJJ = (IDKPRD(1,I)-6)/2
40593 KKK = (IDKPRD(2,I)+1)/2
40595 A2MODE(1,N2MODE) = 0.0D0
40596 A2MODE(2,N2MODE) = LMIXSS(2*III-1,1,IM)*
40597 & LAMDA2(III,JJJ,KKK)
40600 III = (IDK(I)-429)/2
40607 JJJ = IDKPRD(1,I)/2
40608 KKK = (IDKPRD(2,I)-5)/2
40610 A2MODE(1,N2MODE) = LMIXSS(2*III-1,1,IM)*
40611 & LAMDA2(III,JJJ,KKK)
40612 A2MODE(2,N2MODE) = 0.0D0
40615 CALL HWWARN('HWISP2',3,*999)
40618 ELSEIF(IDK(I).GE.401.AND.IDK(I).LE.424.AND.
40619 & IDKPRD(1,I).LE.12.AND.IDKPRD(2,I).LE.12) THEN
40620 C--up type squark decay
40621 IF(MOD(IDK(I),2).EQ.0) THEN
40623 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',143,*999)
40624 NME(I) = 30000+N2MODE
40626 P2MODE(N2MODE) = 2.0D0
40628 IF(IDPDG(IDK(I)).GT.0) THEN
40629 III = (IDK(I)-400)/2
40636 JJJ = (IDKPRD(1,I)-5)/2
40637 KKK = (IDKPRD(2,I)-5)/2
40638 I2DRTP(N2MODE) = 13
40639 A2MODE(1,N2MODE)=QMIXSS(2*III,2,IM)*LAMDA3(III,JJJ,KKK)
40640 A2MODE(2,N2MODE)=0.0D0
40641 C--antisquark decay
40643 III = (IDK(I)-406)/2
40650 JJJ = (IDKPRD(1,I)+1)/2
40651 KKK = (IDKPRD(2,I)+1)/2
40653 A2MODE(1,N2MODE) =0.0D0
40654 A2MODE(2,N2MODE) =QMIXSS(2*III,2,IM)*LAMDA3(III,JJJ,KKK)
40657 C--down type squark decay
40659 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',144,*999)
40660 NME(I) = 30000+N2MODE
40662 P2MODE(N2MODE) = 2.0D0
40664 IF(IDPDG(IDK(I)).GT.0) THEN
40665 JJJ = (IDK(I)-399)/2
40672 III = (IDKPRD(1,I)-6)/2
40673 KKK = (IDKPRD(2,I)-5)/2
40674 I2DRTP(N2MODE) = 13
40675 A2MODE(1,N2MODE)= QMIXSS(2*JJJ-1,2,IM)*
40676 & LAMDA3(III,JJJ,KKK)
40677 A2MODE(2,N2MODE)= 0.0D0
40678 C--antisquark decay
40680 JJJ = (IDK(I)-405)/2
40687 III = IDKPRD(1,I)/2
40688 KKK = (IDKPRD(2,I)+1)/2
40690 A2MODE(1,N2MODE) = 0.0D0
40691 A2MODE(2,N2MODE) = QMIXSS(2*JJJ-1,2,IM)*
40692 & LAMDA3(III,JJJ,KKK)
40696 IF(.NOT.(RSPIN(IDKPRD(1,I)).EQ.ZERO.AND.
40697 & RSPIN(IDKPRD(2,I)).EQ.ZERO)) CALL HWWARN('HWISP2',4,*999)
40699 ELSEIF(IDK(I).GE.203.AND.IDK(I).LE.207) THEN
40701 L = IDKPRD(1,I)-449
40702 L1 = IDKPRD(2,I)-449
40703 C--Neutral Higgs decays
40704 IF(IH.GE.1.AND.IH.LE.3) THEN
40705 C--Higgs to neutralino neutralino
40706 IF(L.GE.1.AND.L.LE.4) THEN
40708 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',146,*999)
40709 NME(I) = 30000+N2MODE
40712 P2MODE(N2MODE) = ONE
40713 IF(L.EQ.L1) P2MODE(N2MODE) = HALF
40715 24 A2MODE(J,N2MODE) = HNN(J,IH,L,L1)
40716 C--Higgs to chargino chargino
40717 ELSEIF(L.GE.5.AND.L.LE.8) THEN
40721 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',147,*999)
40722 NME(I) = 30000+N2MODE
40725 P2MODE(N2MODE) = ONE
40727 IF(IDPDG(IDKPRD(1,I)).GT.0) THEN
40728 A2MODE(J,N2MODE) = HCC( J ,IH,L,L1)
40730 A2MODE(J,N2MODE) = HCC(O(J),IH,L,L1)
40733 C--Higgs to fermion antifermion
40734 ELSEIF((L.GE.-448.AND.L.LE.-437)
40735 & .OR.(L.GE.-328.AND.L.LE.-317)) THEN
40737 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',148,*999)
40738 NME(I) = 30000+N2MODE
40741 P2MODE(N2MODE) = ONE
40743 IL = IL-6*INT((IL-1)/6)+6*INT((IL-1)/120)
40744 IF(IL.LE.6) P2MODE(N2MODE) = THREE
40746 26 A2MODE(J,N2MODE) = HFF(J,IH,IL)
40749 & (RSPIN(IDKPRD(1,I)).EQ.ZERO.AND.RSPIN(IDKPRD(2,I)).EQ.ZERO)
40750 & .AND..NOT.(IDKPRD(1,I).EQ.13.AND.IDKPRD(2,I).EQ.13)
40751 & .AND..NOT.(IDKPRD(1,I).EQ.59.AND.IDKPRD(2,I).EQ.59)
40752 & .AND..NOT.(IDKPRD(1,I).GE.198.AND.IDKPRD(1,I).LE.200.AND.
40753 & IDKPRD(2,I).GE.198.AND.IDKPRD(2,I).LE.200))
40754 & CALL HWWARN('HWISP2',5,*999)
40756 C--charged Higgs decays
40759 L = IDKPRD(1,I)-449
40760 L1 = IDKPRD(2,I)-449
40761 C--positive Higgs decays
40763 C--decay to chargino neutralino
40764 IF(L.EQ.5.OR.L.EQ.6) THEN
40767 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',149,*999)
40768 NME(I) = 30000+N2MODE
40771 P2MODE(N2MODE) = ONE
40773 27 A2MODE(J,N2MODE) = HNC(O(J),L1,L)
40774 C--decay to neutralino chargino
40775 ELSEIF(L.GE.1.AND.L.LE.4) THEN
40778 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',150,*999)
40779 NME(I) = 30000+N2MODE
40782 P2MODE(N2MODE) = ONE
40784 28 A2MODE(J,N2MODE) = HNC(O(J),L1,L)
40785 C--fermion antifermion decay modes
40786 ELSEIF((L.GE.-448.AND.L.LE.-437)
40787 & .OR.(L.GE.-328.AND.L.LE.-317)) THEN
40789 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',151,*999)
40790 NME(I) = 30000+N2MODE
40793 P2MODE(N2MODE) = ONE
40795 IL = IL-6*INT((IL-1)/6)+6*INT((IL-1)/120)
40797 IF(IL.LE.3) P2MODE(N2MODE) = THREE
40799 29 A2MODE(J,N2MODE) = HFF(J,4,IL)
40801 IF(RSPIN(IDKPRD(1,I)).NE.ZERO.OR.RSPIN(IDKPRD(2,I)).NE.
40802 & ZERO) CALL HWWARN('HWISP2',6,*999)
40804 C--negative Higgs decays
40806 C--Higgs to chargino neutralino
40807 IF(L.EQ.7.OR.L.EQ.8) THEN
40810 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',152,*999)
40811 NME(I) = 30000+N2MODE
40814 P2MODE(N2MODE) = ONE
40816 30 A2MODE(J,N2MODE) = HNC(J,L1,L)
40817 C--Higgs to neutralino chargino
40818 ELSEIF(L.GE.1.AND.L.LE.4) THEN
40821 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',153,*999)
40822 NME(I) = 30000+N2MODE
40825 P2MODE(N2MODE) = ONE
40827 31 A2MODE(J,N2MODE) = HNC(J,L1,L)
40828 C--fermion antifermion decay modes
40829 ELSEIF((L.GE.-448.AND.L.LE.-437)
40830 & .OR.(L.GE.-328.AND.L.LE.-317)) THEN
40832 IF(N2MODE.GT.NMODE2) CALL HWWARN('HWISP2',154,*999)
40833 NME(I) = 30000+N2MODE
40836 P2MODE(N2MODE) = ONE
40838 IL = IL-6*INT((IL-1)/6)+6*INT((IL-1)/120)
40840 IF(IL.LE.3) P2MODE(N2MODE) = THREE
40842 32 A2MODE(J,N2MODE) = HFF(O(J),4,IL)
40844 IF(RSPIN(IDKPRD(1,I)).NE.ZERO.OR.RSPIN(IDKPRD(1,I)).NE.
40845 & ZERO) CALL HWWARN('HWISP2',7,*999)
40851 C--now find the maximum weights and compute the decay rates
40853 IF(IPRINT.EQ.2) WRITE(6,5010) RNAME(IDK(ID2PRT(I))),
40854 & RNAME(IDKPRD(1,ID2PRT(I))),RNAME(IDKPRD(2,ID2PRT(I)))
40855 2000 CALL HWD2ME(I)
40857 5010 FORMAT(/'CALCULATING TWO BODY DECAY ',
40858 & A8,' --> ',A8,' ',A8/)
40861 *CMZ :- -30/09/02 14:05:28 by Peter Richardson
40862 *-- Author : Peter Richardson
40863 C-----------------------------------------------------------------------
40865 C-----------------------------------------------------------------------
40866 C Initialise the top/SUSY three body decay modes
40867 C gravitino and RPV modes added by Peter Richardson
40868 C-----------------------------------------------------------------------
40869 INCLUDE 'HERWIG65.INC'
40870 INTEGER I,J,K,L,L1,IL,IQ,IQ1,IQ2,IFR,SIFR,IH,IH1,IM,O(2),II,JJ,
40872 DOUBLE PRECISION SW,CW,TW,E,G,RT,ORT,MW,MZ,GS,AFN(2,12,2,4),
40873 & AFG(2,6,2),AFC(2,12,2,2),OIJ(2,4,2),OIJP(2,2,2),OIJPP(2,4,4),
40874 & HNN(2,3,4,4),HCC(2,3,2,2),HNC(2,4,2),HFF(2,4,12),HWW(2),
40875 & HZZ(2),ZAB(12,2,2),HHB(2,3)
40876 DOUBLE COMPLEX RHOIN(2,2)
40877 COMMON /HWSPNC/ SW,CW,TW,E,G,RT,ORT,MW,MZ,GS,AFN,AFG,AFC,OIJ,OIJP,
40878 & OIJPP,HNN,HCC,HNC,HFF,HWW,HZZ,ZAB,HHB
40880 IF(IERROR.NE.0) RETURN
40881 C--loop over the decays and find the top decays
40883 DO 1000 II=1,NMODES(JJ)
40890 IF(IDK(I).EQ.6.AND.NME(I).EQ.100) THEN
40892 IF(N3MODE.GT.NMODE3) CALL HWWARN('HWISP3',100,*999)
40893 P3MODE(N3MODE) = ONE
40894 IF(IDKPRD(1,I).LE.12) P3MODE(N3MODE) = THREE
40895 SPN3CF(1,1,N3MODE) = ONE
40898 NME(I) = 10000+N3MODE
40900 I3DRTP(1,N3MODE) = 1
40901 I3DRCF(1,N3MODE) = 1
40902 I3MODE(1,N3MODE) = 198
40903 A3MODE(1,1,N3MODE) = ZERO
40904 A3MODE(2,1,N3MODE) = -G*ORT
40905 B3MODE(1,1,N3MODE) = ZERO
40906 B3MODE(2,1,N3MODE) = -G*ORT
40907 C--antitop decay via W
40908 ELSEIF(IDK(I).EQ.12.AND.NME(I).EQ.100) THEN
40910 IF(N3MODE.GT.NMODE3) CALL HWWARN('HWISP3',101,*999)
40911 P3MODE(N3MODE) = ONE
40912 IF(IDKPRD(1,I).LE.12) P3MODE(N3MODE) = THREE
40913 SPN3CF(1,1,N3MODE) = ONE
40916 NME(I) = 10000+N3MODE
40918 I3DRTP(1,N3MODE) = 5
40919 I3DRCF(1,N3MODE) = 1
40920 I3MODE(1,N3MODE) = 199
40921 A3MODE(1,1,N3MODE) = ZERO
40922 A3MODE(2,1,N3MODE) = -G*ORT
40923 B3MODE(1,1,N3MODE) = ZERO
40924 B3MODE(2,1,N3MODE) = -G*ORT
40925 C--top decay via charged Higgs
40926 ELSEIF(IDK(I).EQ.6.AND.NME(I).EQ.200) THEN
40928 IF(N3MODE.GT.NMODE3) CALL HWWARN('HWISP3',102,*999)
40929 P3MODE(N3MODE) = ONE
40930 IF(IDKPRD(1,I).LE.12) P3MODE(N3MODE) = THREE
40931 SPN3CF(1,1,N3MODE) = ONE
40934 NME(I) = 10000+N3MODE
40936 I3DRTP(1,N3MODE) = 2
40937 I3DRCF(1,N3MODE) = 1
40938 I3MODE(1,N3MODE) = 206
40940 IL = IL-6*INT((IL-1)/6)+6*INT((IL-1)/120)
40943 A3MODE(J,1,N3MODE) = HFF(O(J),4,3)
40944 201 B3MODE(J,1,N3MODE) = HFF( J ,4,IL)
40945 C--antitop decay via charged Higgs
40946 ELSEIF(IDK(I).EQ.12.AND.NME(I).EQ.200) THEN
40948 IF(N3MODE.GT.NMODE3) CALL HWWARN('HWISP3',103,*999)
40949 P3MODE(N3MODE) = ONE
40950 IF(IDKPRD(1,I).LE.12) P3MODE(N3MODE) = THREE
40951 SPN3CF(1,1,N3MODE) = ONE
40954 NME(I) = 10000+N3MODE
40956 I3DRTP(1,N3MODE) = 17
40957 I3DRCF(1,N3MODE) = 1
40958 I3MODE(1,N3MODE) = 207
40960 IL = IL-6*INT((IL-1)/6)+6*INT((IL-1)/120)
40963 A3MODE(J,1,N3MODE) = HFF( J ,4,3)
40964 202 B3MODE(J,1,N3MODE) = HFF(O(J),4,IL)
40967 IF(.NOT.SUSYIN) GOTO 2999
40968 C--loop over all the SUSY decay modes and find the ones we want
40969 C--first the true three body gaugino decays
40971 DO 2000 II=1,NMODES(JJ)
40977 L = IDKPRD(1,I)-449
40978 IF(IDKPRD(3,I).EQ.0.OR.IDKPRD(4,I).NE.0) GOTO 2500
40979 C--gluino modes first
40980 IF(IDK(I).EQ.449) THEN
40981 C--first the gluino modes to quark-antiquark neutralino
40982 IF(L.GE.1.AND.L.LE.4.AND.(IDKPRD(2,I).LE.12.OR.
40983 & (IDKPRD(2,I).GE.121.AND.IDKPRD(2,I).LE.132))) THEN
40985 IF(IQ.GT.6) IQ=IQ-6
40986 IF(IQ.GT.6.OR.IQ.LT.1) CALL HWWARN('HWISP3',200,*2000)
40988 IF(N3MODE.GT.NMODE3) CALL HWWARN('HWISP3',104,*999)
40989 P3MODE(N3MODE) = HALF
40990 SPN3CF(1,1,N3MODE) = ONE
40993 NME(I) = 10000+N3MODE
40995 C--only squark exchange diagrams
40997 I3DRTP(K ,N3MODE) = 3
40998 I3DRCF(K ,N3MODE) = 1
40999 I3DRTP(K+2,N3MODE) = 4
41000 I3DRCF(K+2,N3MODE) = 1
41001 I3MODE(K ,N3MODE) = 12*(K-1)+400+IQ
41002 I3MODE(K+2,N3MODE) = 12*(K-1)+406+IQ
41004 A3MODE(J,K ,N3MODE) = AFG( J ,IQ,K)
41005 B3MODE(J,K ,N3MODE) = AFN(O(J),IQ,K,L)
41006 A3MODE(J,K+2,N3MODE) = AFG(O(J),IQ,K)
41007 1 B3MODE(J,K+2,N3MODE) = ZSGNSS(L)*AFN( J ,IQ,K,L)
41008 C--then the gluino modes to quark-antiquark +ve chargino
41009 ELSEIF(L.EQ.5.OR.L.EQ.6.AND.(IDKPRD(2,I).LE.12.OR.
41010 & (IDKPRD(2,I).GE.121.AND.IDKPRD(2,I).LE.132))) THEN
41013 IF(IQ.GT.6) IQ=IQ-6
41014 IF(IQ.GT.6.OR.IQ.LT.1) CALL HWWARN('HWISP3',201,*2000)
41015 IQ = (IQ+MOD(IQ,2))/2
41019 IF(N3MODE.GT.NMODE3) CALL HWWARN('HWISP3',105,*999)
41020 P3MODE(N3MODE) = HALF
41021 SPN3CF(1,1,N3MODE) = ONE
41024 NME(I) = 10000+N3MODE
41026 C--only squark exchange diagrams
41028 I3DRTP(K ,N3MODE) = 3
41029 I3DRCF(K ,N3MODE) = 1
41030 I3DRTP(K+2,N3MODE) = 4
41031 I3DRCF(K+2,N3MODE) = 1
41032 I3MODE(K ,N3MODE) = 12*(K-1)+400+IQ1
41033 I3MODE(K+2,N3MODE) = 12*(K-1)+406+IQ2
41035 A3MODE(J,K ,N3MODE) = AFG( J ,IQ1,K)
41036 B3MODE(J,K ,N3MODE) = AFC(O(J),IQ1,K,L)
41037 A3MODE(J,K+2,N3MODE) = AFG(O(J),IQ2,K)
41038 2 B3MODE(J,K+2,N3MODE) = AFC( J ,IQ2,K,L)
41039 C--then the gluino modes to quark-antiquark -ve chargino
41040 ELSEIF(L.EQ.7.OR.L.EQ.8.AND.(IDKPRD(2,I).LE.12.OR.
41041 & (IDKPRD(2,I).GE.121.AND.IDKPRD(2,I).LE.132))) THEN
41044 IF(IQ.GT.6) IQ=IQ-6
41045 IF(IQ.GT.6.OR.IQ.LT.1) CALL HWWARN('HWISP3',202,*2000)
41046 IQ = (IQ+MOD(IQ,2))/2
41050 IF(N3MODE.GT.NMODE3) CALL HWWARN('HWISP3',106,*999)
41051 P3MODE(N3MODE) = HALF
41052 SPN3CF(1,1,N3MODE) = ONE
41055 NME(I) = 10000+N3MODE
41057 C--only squark exchange diagrams
41059 I3DRTP(K ,N3MODE) = 3
41060 I3DRCF(K ,N3MODE) = 1
41061 I3DRTP(K+2,N3MODE) = 4
41062 I3DRCF(K+2,N3MODE) = 1
41063 I3MODE(K ,N3MODE) = 12*(K-1)+400+IQ1
41064 I3MODE(K+2,N3MODE) = 12*(K-1)+406+IQ2
41066 A3MODE(J,K ,N3MODE) = AFG( J ,IQ1,K)
41067 B3MODE(J,K ,N3MODE) = AFC(O(J),IQ1,K,L)
41068 A3MODE(J,K+2,N3MODE) = AFG(O(J),IQ2,K)
41069 3 B3MODE(J,K+2,N3MODE) = AFC( J ,IQ2,K,L)
41072 ELSEIF(IDKPRD(1,I).GE.121.AND.IDKPRD(1,I).LE.132.AND.
41073 & IDKPRD(2,I).LE.12 .AND.IDKPRD(3,I).LE.12) THEN
41075 IF(N3MODE.GT.NMODE3) CALL HWWARN('HWISP3',107,*999)
41077 NME(I) = 10000+N3MODE
41078 P3MODE(N3MODE) = HALF
41079 SPN3CF(1,1,N3MODE) = ONE
41083 98 I3DRCF(J,N3MODE) = 1
41084 C--first the neutrino mode
41085 IF(MOD(IDKPRD(1,I),2).EQ.0) THEN
41087 IF(IDPDG(IDKPRD(1,I)).GT.0) THEN
41088 III = (IDKPRD(1,I)-120)/2
41089 JJJ = (IDKPRD(2,I)+1)/2
41090 KKK = (IDKPRD(3,I)-5)/2
41092 I3DRTP(K ,N3MODE) = 3
41093 I3DRTP(K+2,N3MODE) = 4
41094 I3MODE(K ,N3MODE) = 399+2*JJJ+(K-1)*12
41095 I3MODE(K+2,N3MODE) = 399+2*KKK+(K-1)*12
41096 B3MODE(2,K ,N3MODE) = 0.0D0
41097 B3MODE(1,K ,N3MODE) = -QMIXSS(2*JJJ-1,1,K)*
41098 & LAMDA2(III,JJJ,KKK)
41099 B3MODE(2,K+2,N3MODE) = 0.0D0
41100 B3MODE(1,K+2,N3MODE) = -QMIXSS(2*KKK-1,2,K)*
41101 & LAMDA2(III,JJJ,KKK)
41103 A3MODE(J,K ,N3MODE) = AFG( J ,2*JJJ-1,K)
41104 99 A3MODE(J,K+2,N3MODE) = AFG(O(J),2*KKK-1,K)
41105 C--antiparticle mode
41107 III = (IDKPRD(1,I)-126)/2
41108 JJJ = (IDKPRD(2,I)-5)/2
41109 KKK = (IDKPRD(3,I)+1)/2
41111 I3DRTP(K ,N3MODE) = 9
41112 I3DRTP(K+2,N3MODE) = 10
41113 I3MODE(K ,N3MODE) = 399+2*JJJ+(K-1)*12
41114 I3MODE(K+2,N3MODE) = 399+2*KKK+(K-1)*12
41115 B3MODE(1,K ,N3MODE) = 0.0D0
41116 B3MODE(2,K ,N3MODE) = -QMIXSS(2*JJJ-1,1,K)*
41117 & LAMDA2(III,JJJ,KKK)
41118 B3MODE(1,K+2,N3MODE) = 0.0D0
41119 B3MODE(2,K+2,N3MODE) = -QMIXSS(2*KKK-1,2,K)*
41120 & LAMDA2(III,JJJ,KKK)
41122 A3MODE(J,K ,N3MODE) = AFG(O(J),2*JJJ-1,K)
41123 101 A3MODE(J,K+2,N3MODE) = AFG( J ,2*KKK-1,K)
41125 C--then the charged lepton mode
41128 IF(IDPDG(IDKPRD(1,I)).GT.0) THEN
41129 III = (IDKPRD(1,I)-119)/2
41130 JJJ = IDKPRD(2,I)/2
41131 KKK = (IDKPRD(3,I)-5)/2
41133 I3DRTP(K ,N3MODE) = 3
41134 I3DRTP(K+2,N3MODE) = 4
41135 I3MODE(K ,N3MODE) = 400+2*JJJ+(K-1)*12
41136 I3MODE(K+2,N3MODE) = 399+2*KKK+(K-1)*12
41137 B3MODE(2,K ,N3MODE) = 0.0D0
41138 B3MODE(1,K ,N3MODE) = QMIXSS(2*JJJ,1,K)*
41139 & LAMDA2(III,JJJ,KKK)
41140 B3MODE(2,K+2,N3MODE) = 0.0D0
41141 B3MODE(1,K+2,N3MODE) = QMIXSS(2*KKK-1,2,K)*
41142 & LAMDA2(III,JJJ,KKK)
41144 A3MODE(J,K ,N3MODE) = AFG( J ,2*JJJ ,K)
41145 102 A3MODE(J,K+2,N3MODE) = AFG(O(J),2*KKK-1,K)
41146 C--antiparticle mode
41148 III = (IDKPRD(1,I)-125)/2
41149 JJJ = (IDKPRD(2,I)-6)/2
41150 KKK = (IDKPRD(3,I)+1)/2
41152 I3DRTP(K ,N3MODE) = 9
41153 I3DRTP(K+2,N3MODE) = 10
41154 I3MODE(K ,N3MODE) = 400+2*JJJ+(K-1)*12
41155 I3MODE(K+2,N3MODE) = 399+2*KKK+(K-1)*12
41156 B3MODE(1,K ,N3MODE) = 0.0D0
41157 B3MODE(2,K ,N3MODE) = QMIXSS(2*JJJ,1,K)*
41158 & LAMDA2(III,JJJ,KKK)
41159 B3MODE(1,K+2,N3MODE) = 0.0D0
41160 B3MODE(2,K+2,N3MODE) = QMIXSS(2*KKK-1,2,K)*
41161 & LAMDA2(III,JJJ,KKK)
41163 A3MODE(J,K ,N3MODE) = AFG(O(J),2*JJJ ,K)
41164 103 A3MODE(J,K+2,N3MODE) = AFG( J ,2*KKK-1,K)
41168 ELSEIF(IDKPRD(1,I).LE.12.AND.IDKPRD(2,I).LE.12.AND.
41169 & IDKPRD(3,I).LE.12) THEN
41171 IF(N3MODE.GT.NMODE3) CALL HWWARN('HWISP3',108,*999)
41172 P3MODE(N3MODE) = ONE
41175 NME(I) = 10000+N3MODE
41180 SPN3CF(J,K,N3MODE) = -HALF
41182 SPN3CF(J,K,N3MODE) = ONE
41186 IF(IDKPRD(1,I).LE.6) THEN
41187 C--antiparticle mode
41188 III = IDKPRD(1,I)/2
41189 JJJ = (IDKPRD(2,I)+1)/2
41190 KKK = (IDKPRD(3,I)+1)/2
41192 I3DRTP(K ,N3MODE) = 11
41193 I3DRCF(K ,N3MODE) = 1
41194 I3DRTP(K+2,N3MODE) = 12
41195 I3DRCF(K+2,N3MODE) = 2
41196 I3DRTP(K+4,N3MODE) = 13
41197 I3DRCF(K+4,N3MODE) = 3
41198 I3MODE(K ,N3MODE) = 400+2*III+(K-1)*12
41199 I3MODE(K+2,N3MODE) = 399+2*JJJ+(K-1)*12
41200 I3MODE(K+4,N3MODE) = 399+2*KKK+(K-1)*12
41201 B3MODE(2,K ,N3MODE) = QMIXSS(2*III,2,K)*
41202 & LAMDA3(III,JJJ,KKK)
41203 B3MODE(2,K+2,N3MODE) = QMIXSS(2*JJJ-1,2,K)*
41204 & LAMDA3(III,JJJ,KKK)
41205 B3MODE(2,K+4,N3MODE) = QMIXSS(2*KKK-1,2,K)*
41206 & LAMDA3(III,JJJ,KKK)
41207 B3MODE(1,K ,N3MODE) = 0.0D0
41208 B3MODE(1,K+2,N3MODE) = 0.0D0
41209 B3MODE(1,K+4,N3MODE) = 0.0D0
41211 A3MODE(J,K ,N3MODE) = AFG(J,2*III ,K)
41212 A3MODE(J,K+2,N3MODE) = AFG(J,2*JJJ-1,K)
41213 71 A3MODE(J,K+4,N3MODE) = AFG(J,2*KKK-1,K)
41215 III = (IDKPRD(1,I)-6)/2
41216 JJJ = (IDKPRD(2,I)-5)/2
41217 KKK = (IDKPRD(3,I)-5)/2
41219 I3DRTP(K ,N3MODE) = 14
41220 I3DRCF(K ,N3MODE) = 1
41221 I3DRTP(K+2,N3MODE) = 15
41222 I3DRCF(K+2,N3MODE) = 2
41223 I3DRTP(K+4,N3MODE) = 16
41224 I3DRCF(K+4,N3MODE) = 3
41225 I3MODE(K ,N3MODE) = 400+2*III+(K-1)*12
41226 I3MODE(K+2,N3MODE) = 399+2*JJJ+(K-1)*12
41227 I3MODE(K+4,N3MODE) = 399+2*KKK+(K-1)*12
41228 B3MODE(1,K ,N3MODE) = QMIXSS(2*III,2,K)*
41229 & LAMDA3(III,JJJ,KKK)
41230 B3MODE(1,K+2,N3MODE) = QMIXSS(2*JJJ-1,2,K)*
41231 & LAMDA3(III,JJJ,KKK)
41232 B3MODE(1,K+4,N3MODE) = QMIXSS(2*KKK-1,2,K)*
41233 & LAMDA3(III,JJJ,KKK)
41234 B3MODE(2,K ,N3MODE) = 0.0D0
41235 B3MODE(2,K+2,N3MODE) = 0.0D0
41236 B3MODE(2,K+4,N3MODE) = 0.0D0
41238 A3MODE(J,K ,N3MODE) = AFG(O(J),2*III ,K)
41239 A3MODE(J,K+2,N3MODE) = AFG(O(J),2*JJJ-1,K)
41240 72 A3MODE(J,K+4,N3MODE) = AFG(O(J),2*KKK-1,K)
41242 C--unrecognized decay issue warning
41244 CALL HWWARN('HWISP3',1,*2000)
41246 ELSEIF(IDK(I).GE.450.AND.IDK(I).LE.453) THEN
41248 C--neutralino modes next
41249 IF(L.GE.1.AND.L.LE.4.AND.(IDKPRD(2,I).LE.12.OR.
41250 & (IDKPRD(2,I).GE.121.AND.IDKPRD(2,I).LE.132))) THEN
41251 C--first the neutralino modes to fermion-antifermion neutralino
41253 J = INT((IFR-1)/120)
41254 IFR = IFR-6*INT((IFR-1)/6)+6*J
41258 IF(N3MODE.GT.NMODE3) CALL HWWARN('HWISP3',109,*999)
41259 P3MODE(N3MODE) = ONE
41260 IF(IFR.LE.6) P3MODE(N3MODE)=THREE
41261 SPN3CF(1,1,N3MODE) = ONE
41264 NME(I) = 10000+N3MODE
41266 C--sfermion exchange diagrams
41268 I3DRTP(K ,N3MODE) = 3
41269 I3DRCF(K ,N3MODE) = 1
41270 I3DRTP(K+2,N3MODE) = 4
41271 I3DRCF(K+2,N3MODE) = 1
41272 I3MODE(K ,N3MODE) = 12*(K-1)+400+SIFR
41273 I3MODE(K+2,N3MODE) = 12*(K-1)+406+SIFR
41275 A3MODE(J,K ,N3MODE) = AFN( J ,IFR,K,L1)
41276 B3MODE(J,K ,N3MODE) = AFN(O(J),IFR,K,L )
41277 A3MODE(J,K+2,N3MODE) = ZSGNSS(L1)*AFN(O(J),IFR,K,L1)
41278 4 B3MODE(J,K+2,N3MODE) = ZSGNSS(L )*AFN( J ,IFR,K,L )
41279 C--now add higgs diagrams if third generation fermion, if Higgs off shell
41280 IF(IFR.EQ.5.OR.IFR.EQ.6.OR.IFR.EQ.11) THEN
41282 IF(RMASS(IDK(I)).LT.
41283 & RMASS(203+J)+RMASS(IDKPRD(1,I))) THEN
41284 NDI3BY(N3MODE) = NDI3BY(N3MODE)+1
41285 I3DRTP( NDI3BY(N3MODE),N3MODE) = 2
41286 I3DRCF( NDI3BY(N3MODE),N3MODE) = 1
41287 I3MODE( NDI3BY(N3MODE),N3MODE) = 203+J
41289 A3MODE(K,NDI3BY(N3MODE),N3MODE) = HNN(K,J,L,L1)
41290 6 B3MODE(K,NDI3BY(N3MODE),N3MODE) = HFF(K,J,IFR)
41294 C-- and gauge boson diagrams if Z not on-shell
41295 IF(RMASS(IDK(I)).LT.MZ+RMASS(IDKPRD(1,I))) THEN
41296 NDI3BY(N3MODE) = NDI3BY(N3MODE)+1
41297 I3DRTP(NDI3BY(N3MODE),N3MODE) = 1
41298 I3DRCF(NDI3BY(N3MODE),N3MODE) = 1
41299 I3MODE(NDI3BY(N3MODE),N3MODE) = 200
41301 7 A3MODE(J,NDI3BY(N3MODE),N3MODE) = OIJPP(J,L,L1)
41302 B3MODE(1,NDI3BY(N3MODE),N3MODE) = -E*RFCH(IL)
41303 B3MODE(2,NDI3BY(N3MODE),N3MODE) = -E*LFCH(IL)
41305 ELSEIF(L.EQ.5.OR.L.EQ.6.AND.(IDKPRD(2,I).LE.12.OR.
41306 & (IDKPRD(2,I).GE.121.AND.IDKPRD(2,I).LE.132))) THEN
41307 C--then the neutralino modes to fermion-antifermion +ve chargino
41308 C--NB ISAJET ONLY HAS W EXCHANGE AND THEREFORE SO DO WE
41309 IF(RMASS(IDK(I)).GT.MW+RMASS(IDKPRD(1,I))) GOTO 2000
41312 IF(N3MODE.GT.NMODE3) CALL HWWARN('HWISP3',110,*999)
41314 NME(I) = 10000+N3MODE
41316 P3MODE(N3MODE) = ONE
41317 IF(IDKPRD(2,I).LE.12) P3MODE(N3MODE) = THREE
41318 SPN3CF(1,1,N3MODE) = ONE
41320 C--gauge boson diagram
41321 I3DRTP(1,N3MODE) = 1
41322 I3DRCF(1,N3MODE) = 1
41323 I3MODE(1,N3MODE) = 199
41325 8 A3MODE(J,1,N3MODE) = OIJ(J,L1,L)
41326 B3MODE(1,1,N3MODE) = ZERO
41327 B3MODE(2,1,N3MODE) = -G*ORT
41328 ELSEIF(L.EQ.7.OR.L.EQ.8.AND.(IDKPRD(2,I).LE.12.OR.
41329 & (IDKPRD(2,I).GE.121.AND.IDKPRD(2,I).LE.132))) THEN
41330 C--then the neutralino modes to fermion-antifermion -ve chargino
41331 C--NB ISAJET ONLY HAS W EXCHANGE AND THEREFORE SO DO WE
41332 IF(RMASS(IDK(I)).GT.MW+RMASS(IDKPRD(1,I))) GOTO 2000
41335 IF(N3MODE.GT.NMODE3) CALL HWWARN('HWISP3',111,*999)
41337 NME(I) = 10000+N3MODE
41339 P3MODE(N3MODE) = ONE
41340 IF(IDKPRD(2,I).LE.12) P3MODE(N3MODE) = THREE
41341 SPN3CF(1,1,N3MODE) = ONE
41343 C--gauge boson diagram
41344 I3DRTP(1,N3MODE) = 1
41345 I3DRCF(1,N3MODE) = 1
41346 I3MODE(1,N3MODE) = 198
41348 9 A3MODE(J,1,N3MODE) =-OIJ(O(J),L1,L)
41349 B3MODE(1,1,N3MODE) = ZERO
41350 B3MODE(2,1,N3MODE) = -G*ORT
41351 C--gravitino E+e- modes
41352 ELSEIF(L.EQ.9.AND.(IDKPRD(2,I).LE.12.OR.
41353 & (IDKPRD(2,I).GE.121.AND.IDKPRD(2,I).LE.132))) THEN
41355 J = INT((IFR-1)/120)
41356 IFR = IFR-6*INT((IFR-1)/6)+6*J
41359 IF(N3MODE.GT.NMODE3) CALL HWWARN('HWISP3',112,*999)
41361 NME(I) = 10000+N3MODE
41363 P3MODE(N3MODE) = ONE
41364 IF(IDKPRD(2,I).LE.12) P3MODE(N3MODE) = THREE
41365 SPN3CF(1,1,N3MODE) = ONE
41368 I3DRTP(1,N3MODE) = 7
41369 I3DRCF(1,N3MODE) = 1
41370 I3MODE(1,N3MODE) = 59
41371 A3MODE(1,1,N3MODE) = 2.0D0/SQRT(6.0D0)*ZMIXSS(L1,1)
41372 A3MODE(2,1,N3MODE) = 0
41373 B3MODE(1,1,N3MODE) = -E*QFCH(IL)
41374 B3MODE(2,1,N3MODE) = -E*QFCH(IL)
41375 C--R-parity violating modes
41377 ELSEIF(IDKPRD(1,I).GE.121.AND.IDKPRD(1,I).LE.132.AND.
41378 & IDKPRD(2,I).GE.121.AND.IDKPRD(2,I).LE.132.AND.
41379 & IDKPRD(3,I).GE.121.AND.IDKPRD(3,I).LE.132) THEN
41381 IF(N3MODE.GT.NMODE3) CALL HWWARN('HWISP3',113,*999)
41383 NME(I) = 10000+N3MODE
41385 P3MODE(N3MODE) = ONE
41386 SPN3CF(1,1,N3MODE) = ONE
41390 53 I3DRCF(J,N3MODE) = 1
41391 IF(IDPDG(IDKPRD(1,I)).GT.0) THEN
41392 III = (IDKPRD(1,I)-119)/2
41393 JJJ = (IDKPRD(2,I)-120)/2
41394 KKK = (IDKPRD(3,I)-125)/2
41396 I3DRTP(J ,N3MODE) = 2
41397 I3DRTP(J+2,N3MODE) = 4
41398 I3MODE(J ,N3MODE) = 423+2*III+(J-1)*12
41399 I3MODE(J+2,N3MODE) = 423+2*KKK+(J-1)*12
41400 B3MODE(1,J ,N3MODE) = LMIXSS(2*III-1,1,J)*
41401 & LAMDA1(III,JJJ,KKK)
41402 B3MODE(2,J ,N3MODE) = 0.0D0
41403 B3MODE(1,J+2,N3MODE) = LMIXSS(2*KKK-1,2,J)*
41404 & LAMDA1(III,JJJ,KKK)
41405 B3MODE(2,J+2,N3MODE) = 0.0D0
41407 A3MODE(K,J ,N3MODE) = AFN( K ,5+2*III,J,L1)
41408 51 A3MODE(K,J+2,N3MODE) = AFN(O(K),5+2*KKK,J,L1)
41410 48 A3MODE(K,5,N3MODE) = AFN( K ,6+2*JJJ,1,L1)
41411 I3DRTP(5,N3MODE) = 3
41412 I3MODE(5,N3MODE) = 430+2*JJJ
41413 B3MODE(1,5,N3MODE) = LAMDA1(III,JJJ,KKK)
41414 B3MODE(2,5,N3MODE) = 0.0D0
41415 C--antiparticle mode
41417 III = (IDKPRD(1,I)-125)/2
41418 JJJ = (IDKPRD(2,I)-126)/2
41419 KKK = (IDKPRD(3,I)-119)/2
41421 I3DRTP(J ,N3MODE) = 8
41422 I3DRTP(J+2,N3MODE) = 10
41423 I3MODE(J ,N3MODE) = 423+2*III+(J-1)*12
41424 I3MODE(J+2,N3MODE) = 423+2*KKK+(J-1)*12
41425 B3MODE(2,J ,N3MODE) = LMIXSS(2*III-1,1,J)*
41426 & LAMDA1(III,JJJ,KKK)
41427 B3MODE(1,J ,N3MODE) = 0.0D0
41428 B3MODE(2,J+2,N3MODE) = LMIXSS(2*KKK-1,2,J)*
41429 & LAMDA1(III,JJJ,KKK)
41430 B3MODE(1,J+2,N3MODE) = 0.0D0
41432 A3MODE(K,J ,N3MODE) = AFN(O(K),5+2*III,J,L1)
41433 52 A3MODE(K,J+2,N3MODE) = AFN( K ,5+2*KKK,J,L1)
41435 49 A3MODE(K,5,N3MODE) = AFN(O(K),6+2*JJJ,1,L1)
41436 I3DRTP(5,N3MODE) = 9
41437 I3MODE(5,N3MODE) = 430+2*JJJ
41438 B3MODE(2,5,N3MODE) = LAMDA1(III,JJJ,KKK)
41439 B3MODE(1,5,N3MODE) = 0.0D0
41442 ELSEIF(IDKPRD(1,I).GE.121.AND.IDKPRD(1,I).LE.132.AND.
41443 & IDKPRD(2,I).LE.12 .AND.IDKPRD(3,I).LE.12) THEN
41445 IF(N3MODE.GT.NMODE3) CALL HWWARN('HWISP3',114,*999)
41447 NME(I) = 10000+N3MODE
41448 P3MODE(N3MODE) = 3.0D0
41449 SPN3CF(1,1,N3MODE) = ONE
41452 81 I3DRCF(J,N3MODE) = 1
41453 C--first the neutrino mode
41454 IF(MOD(IDKPRD(1,I),2).EQ.0) THEN
41457 IF(IDPDG(IDKPRD(1,I)).GT.0) THEN
41458 III = (IDKPRD(1,I)-120)/2
41459 JJJ = (IDKPRD(2,I)+1)/2
41460 KKK = (IDKPRD(3,I)-5)/2
41462 I3DRTP(K ,N3MODE) = 3
41463 I3DRTP(K+2,N3MODE) = 4
41464 I3MODE(K ,N3MODE) = 399+2*JJJ+(K-1)*12
41465 I3MODE(K+2,N3MODE) = 399+2*KKK+(K-1)*12
41466 B3MODE(2,K ,N3MODE) = 0.0D0
41467 B3MODE(1,K ,N3MODE) = -QMIXSS(2*JJJ-1,1,K)*
41468 & LAMDA2(III,JJJ,KKK)
41469 B3MODE(2,K+2,N3MODE) = 0.0D0
41470 B3MODE(1,K+2,N3MODE) = -QMIXSS(2*KKK-1,2,K)*
41471 & LAMDA2(III,JJJ,KKK)
41473 A3MODE(J,K ,N3MODE) = AFN( J ,2*JJJ-1,K,L1)
41474 82 A3MODE(J,K+2,N3MODE) = AFN(O(J),2*KKK-1,K,L1)
41475 I3DRTP(5,N3MODE) = 2
41476 I3MODE(5,N3MODE) = 424+2*III
41477 B3MODE(2,5,N3MODE) = 0.0D0
41478 B3MODE(1,5,N3MODE) = -LAMDA2(III,JJJ,KKK)
41480 83 A3MODE(J,5,N3MODE) = AFN(J,6+2*III,1,L1)
41481 C--antiparticle mode
41483 III = (IDKPRD(1,I)-126)/2
41484 JJJ = (IDKPRD(2,I)-5)/2
41485 KKK = (IDKPRD(3,I)+1)/2
41487 I3DRTP(K ,N3MODE) = 9
41488 I3DRTP(K+2,N3MODE) = 10
41489 I3MODE(K ,N3MODE) = 399+2*JJJ+(K-1)*12
41490 I3MODE(K+2,N3MODE) = 399+2*KKK+(K-1)*12
41491 B3MODE(1,K ,N3MODE) = 0.0D0
41492 B3MODE(2,K ,N3MODE) = -QMIXSS(2*JJJ-1,1,K)*
41493 & LAMDA2(III,JJJ,KKK)
41494 B3MODE(1,K+2,N3MODE) = 0.0D0
41495 B3MODE(2,K+2,N3MODE) = -QMIXSS(2*KKK-1,2,K)*
41496 & LAMDA2(III,JJJ,KKK)
41498 A3MODE(J,K ,N3MODE) = AFN(O(J),2*JJJ-1,K,L1)
41499 84 A3MODE(J,K+2,N3MODE) = AFN( J ,2*KKK-1,K,L1)
41500 I3DRTP(5,N3MODE) = 8
41501 I3MODE(5,N3MODE) = 424+2*III
41502 B3MODE(1,5,N3MODE) = 0.0D0
41503 B3MODE(2,5,N3MODE) = -LAMDA2(III,JJJ,KKK)
41505 85 A3MODE(J,5,N3MODE) = AFN(O(J),6+2*III,1,L1)
41507 C--then the charged lepton mode
41511 IF(IDPDG(IDKPRD(1,I)).GT.0) THEN
41512 III = (IDKPRD(1,I)-119)/2
41513 JJJ = IDKPRD(2,I)/2
41514 KKK = (IDKPRD(3,I)-5)/2
41516 I3DRTP(K ,N3MODE) = 2
41517 I3DRTP(K+2,N3MODE) = 3
41518 I3DRTP(K+4,N3MODE) = 4
41519 I3MODE(K ,N3MODE) = 423+2*III+(K-1)*12
41520 I3MODE(K+2,N3MODE) = 400+2*JJJ+(K-1)*12
41521 I3MODE(K+4,N3MODE) = 399+2*KKK+(K-1)*12
41522 B3MODE(2,K ,N3MODE) = 0.0D0
41523 B3MODE(1,K ,N3MODE) = LMIXSS(2*III-1,1,K)*
41524 & LAMDA2(III,JJJ,KKK)
41525 B3MODE(2,K+2,N3MODE) = 0.0D0
41526 B3MODE(1,K+2,N3MODE) = QMIXSS(2*JJJ,1,K)*
41527 & LAMDA2(III,JJJ,KKK)
41528 B3MODE(2,K+4,N3MODE) = 0.0D0
41529 B3MODE(1,K+4,N3MODE) = QMIXSS(2*KKK-1,2,K)*
41530 & LAMDA2(III,JJJ,KKK)
41532 A3MODE(J,K ,N3MODE) = AFN( J ,2*III+5,K,L1)
41533 A3MODE(J,K+2,N3MODE) = AFN( J ,2*JJJ ,K,L1)
41534 86 A3MODE(J,K+4,N3MODE) = AFN(O(J),2*KKK-1,K,L1)
41535 C--antiparticle mode
41537 III = (IDKPRD(1,I)-125)/2
41538 JJJ = (IDKPRD(2,I)-6)/2
41539 KKK = (IDKPRD(3,I)+1)/2
41541 I3DRTP(K ,N3MODE) = 8
41542 I3DRTP(K+2,N3MODE) = 9
41543 I3DRTP(K+4,N3MODE) = 10
41544 I3MODE(K ,N3MODE) = 423+2*III+(K-1)*12
41545 I3MODE(K+2,N3MODE) = 400+2*JJJ+(K-1)*12
41546 I3MODE(K+4,N3MODE) = 399+2*KKK+(K-1)*12
41547 B3MODE(1,K ,N3MODE) = 0.0D0
41548 B3MODE(2,K ,N3MODE) = LMIXSS(2*III-1,1,K)*
41549 & LAMDA2(III,JJJ,KKK)
41550 B3MODE(1,K+2,N3MODE) = 0.0D0
41551 B3MODE(2,K+2,N3MODE) = QMIXSS(2*JJJ,1,K)*
41552 & LAMDA2(III,JJJ,KKK)
41553 B3MODE(1,K+4,N3MODE) = 0.0D0
41554 B3MODE(2,K+4,N3MODE) = QMIXSS(2*KKK-1,2,K)*
41555 & LAMDA2(III,JJJ,KKK)
41557 A3MODE(J,K ,N3MODE) = AFN(O(J),2*III+5,K,L1)
41558 A3MODE(J,K+2,N3MODE) = AFN(O(J),2*JJJ ,K,L1)
41559 87 A3MODE(J,K+4,N3MODE) = AFN( J ,2*KKK-1,K,L1)
41563 ELSEIF(IDKPRD(1,I).LE.12.AND.IDKPRD(2,I).LE.12.AND.
41564 & IDKPRD(3,I).LE.12) THEN
41566 IF(N3MODE.GT.NMODE3) CALL HWWARN('HWISP3',115,*999)
41568 NME(I) = 10000+N3MODE
41570 P3MODE(N3MODE) = 6.0D0
41571 SPN3CF(1,1,N3MODE) = ONE
41574 61 I3DRCF(J,N3MODE) = 1
41576 IF(IDPDG(IDKPRD(1,I)).GT.0) THEN
41577 III = IDKPRD(1,I)/2
41578 JJJ = (IDKPRD(2,I)+1)/2
41579 KKK = (IDKPRD(3,I)+1)/2
41581 I3DRTP(J ,N3MODE) = 11
41582 I3DRTP(J+2,N3MODE) = 12
41583 I3DRTP(J+4,N3MODE) = 13
41584 I3MODE(J ,N3MODE) = 400+2*III+(J-1)*12
41585 I3MODE(J+2,N3MODE) = 399+2*JJJ+(J-1)*12
41586 I3MODE(J+4,N3MODE) = 399+2*KKK+(J-1)*12
41587 B3MODE(2,J ,N3MODE) = QMIXSS(2*III,2,J)*
41588 & LAMDA3(III,JJJ,KKK)
41589 B3MODE(2,J+2,N3MODE) = QMIXSS(2*JJJ-1,2,J)*
41590 & LAMDA3(III,JJJ,KKK)
41591 B3MODE(2,J+4,N3MODE) = QMIXSS(2*KKK-1,2,J)*
41592 & LAMDA3(III,JJJ,KKK)
41593 B3MODE(1,J ,N3MODE) = 0.0D0
41594 B3MODE(1,J+2,N3MODE) = 0.0D0
41595 B3MODE(1,J+4,N3MODE) = 0.0D0
41597 A3MODE(K,J ,N3MODE) = AFN(K,2*III ,J,L1)
41598 A3MODE(K,J+2,N3MODE) = AFN(K,2*JJJ-1,J,L1)
41599 62 A3MODE(K,J+4,N3MODE) = AFN(K,2*KKK-1,J,L1)
41600 C--antiparticle mode
41602 III = (IDKPRD(1,I)-6)/2
41603 JJJ = (IDKPRD(2,I)-5)/2
41604 KKK = (IDKPRD(3,I)-5)/2
41606 I3DRTP(J ,N3MODE) = 14
41607 I3DRTP(J+2,N3MODE) = 15
41608 I3DRTP(J+4,N3MODE) = 16
41609 I3MODE(J ,N3MODE) = 400+2*III+(J-1)*12
41610 I3MODE(J+2,N3MODE) = 399+2*JJJ+(J-1)*12
41611 I3MODE(J+4,N3MODE) = 399+2*KKK+(J-1)*12
41612 B3MODE(2,J ,N3MODE) = 0.0D0
41613 B3MODE(2,J+2,N3MODE) = 0.0D0
41614 B3MODE(2,J+4,N3MODE) = 0.0D0
41615 B3MODE(1,J ,N3MODE) = QMIXSS(2*III,2,J)*
41616 & LAMDA3(III,JJJ,KKK)
41617 B3MODE(1,J+2,N3MODE) = QMIXSS(2*JJJ-1,2,J)*
41618 & LAMDA3(III,JJJ,KKK)
41619 B3MODE(1,J+4,N3MODE) = QMIXSS(2*KKK-1,2,J)*
41620 & LAMDA3(III,JJJ,KKK)
41622 A3MODE(K,J ,N3MODE) = AFN(O(K),2*III ,J,L1)
41623 A3MODE(K,J+2,N3MODE) = AFN(O(K),2*JJJ-1,J,L1)
41624 63 A3MODE(K,J+4,N3MODE) = AFN(O(K),2*KKK-1,J,L1)
41626 C--unrecognized decay issue warning
41628 CALL HWWARN('HWISP3',2,*2000)
41630 ELSEIF(IDK(I).GE.454.AND.IDK(I).LE.455) THEN
41631 C--+ve chargino modes
41632 C--first the chargino modes to fermion-antifermion neutralino
41633 IF(L.GE.1.AND.L.LE.4.AND.(IDKPRD(2,I).LE.12.OR.
41634 & (IDKPRD(2,I).GE.121.AND.IDKPRD(2,I).LE.132))) THEN
41636 IFR = IFR+MOD(IFR,2)
41637 J = INT((IFR-1)/120)
41638 IFR = IFR-6*INT((IFR-1)/6)+6*J
41643 IF(N3MODE.GT.NMODE3) CALL HWWARN('HWISP3',116,*999)
41645 NME(I) = 10000+N3MODE
41647 P3MODE(N3MODE) = ONE
41648 IF(IDKPRD(2,I).LE.12) P3MODE(N3MODE) = THREE
41649 SPN3CF(1,1,N3MODE) = ONE
41651 C--sfermion exchange diagrams
41653 I3DRTP(K ,N3MODE) = 3
41654 I3DRCF(K ,N3MODE) = 1
41655 I3DRTP(K+2,N3MODE) = 4
41656 I3DRCF(K+2,N3MODE) = 1
41657 I3MODE(K ,N3MODE) = 12*(K-1)+405+SIFR
41658 I3MODE(K+2,N3MODE) = 12*(K-1)+400+SIFR
41660 A3MODE(J,K ,N3MODE) = AFC( J ,IFR-1,K,L1)
41661 B3MODE(J,K ,N3MODE) = AFN(O(J),IFR-1,K,L )
41662 A3MODE(J,K+2,N3MODE) = AFC(O(J),IFR ,K,L1)
41663 10 B3MODE(J,K+2,N3MODE) = AFN( J ,IFR ,K,L )
41664 C--gauge boson diagram
41665 IF(RMASS(IDK(I)).LT.MW+RMASS(IDKPRD(1,I))) THEN
41666 NDI3BY(N3MODE) = NDI3BY(N3MODE)+1
41667 I3DRTP(NDI3BY(N3MODE),N3MODE) = 1
41668 I3DRCF(NDI3BY(N3MODE),N3MODE) = 1
41669 I3MODE(NDI3BY(N3MODE),N3MODE) = 198
41671 11 A3MODE(J,NDI3BY(N3MODE),N3MODE) = OIJ(J,L,L1)
41672 B3MODE(1,NDI3BY(N3MODE),N3MODE) = ZERO
41673 B3MODE(2,NDI3BY(N3MODE),N3MODE) = -G*ORT
41675 C--then the chargino modes to fermion-antifermion chargino
41676 ELSEIF(L.GE.5.AND.L.LE.8.AND.(IDKPRD(2,I).LE.12.OR.
41677 & (IDKPRD(2,I).GE.121.AND.IDKPRD(2,I).LE.132))) THEN
41680 J = INT((IFR-1)/120)
41681 IFR = IFR-6*INT((IFR-1)/6)+6*J
41684 IF(MOD(IFR,2).EQ.0) THEN
41693 IF(N3MODE.GT.NMODE3) CALL HWWARN('HWISP3',117,*999)
41695 NME(I) = 10000+N3MODE
41697 P3MODE(N3MODE) = ONE
41698 IF(IDKPRD(2,I).LE.12) P3MODE(N3MODE) = THREE
41699 SPN3CF(1,1,N3MODE) = ONE
41701 C--sfermion exchange diagrams
41702 IF(MOD(IL,2).EQ.0) THEN
41704 I3DRTP(K,N3MODE) = 3
41705 I3DRCF(K,N3MODE) = 1
41706 I3MODE(K,N3MODE) = 12*(K-1)+400+SIFR
41708 A3MODE(J,K,N3MODE) = AFC( J ,IFR,K,L1)
41709 12 B3MODE(J,K,N3MODE) = AFC(O(J),IFR,K,L )
41712 I3DRTP(K,N3MODE) = 4
41713 I3DRCF(K,N3MODE) = 1
41714 I3MODE(K,N3MODE) = 12*(K-1)+400+SIFR
41716 A3MODE(J,K,N3MODE) = AFC(O(J),IFR,K,L1)
41717 13 B3MODE(J,K,N3MODE) = AFC( J ,IFR,K,L )
41719 C--gauge boson diagram
41720 IF(RMASS(IDK(I)).LT.MZ+RMASS(IDKPRD(1,I))) THEN
41721 NDI3BY(N3MODE) = NDI3BY(N3MODE)+1
41722 I3DRTP(NDI3BY(N3MODE),N3MODE) = 1
41723 I3DRCF(NDI3BY(N3MODE),N3MODE) = 1
41724 I3MODE(NDI3BY(N3MODE),N3MODE) = 200
41726 14 A3MODE(J,NDI3BY(N3MODE),N3MODE) = OIJP(J,L,L1)
41727 B3MODE(1,NDI3BY(N3MODE),N3MODE) = -E*RFCH(IL)
41728 B3MODE(2,NDI3BY(N3MODE),N3MODE) = -E*LFCH(IL)
41730 C--R-parity violating decays
41732 ELSEIF(IDKPRD(1,I).GE.121.AND.IDKPRD(1,I).LE.132.AND.
41733 & IDKPRD(2,I).GE.121.AND.IDKPRD(2,I).LE.132.AND.
41734 & IDKPRD(1,I).GE.121.AND.IDKPRD(3,I).LE.132) THEN
41736 C--neutrino lepton neutrino
41737 IF(MOD(IDKPRD(1,I),2).EQ.0.AND.MOD(IDKPRD(2,I),2).EQ.1.AND.
41738 & MOD(IDKPRD(3,I),2).EQ.0) THEN
41740 IF(N3MODE.GT.NMODE3) CALL HWWARN('HWISP3',118,*999)
41742 NME(I) = 10000+N3MODE
41744 P3MODE(N3MODE) = ONE
41746 SPN3CF(1,1,N3MODE) = ONE
41747 III = (IDKPRD(1,I)-126)/2
41748 JJJ = (IDKPRD(2,I)-125)/2
41749 KKK = (IDKPRD(3,I)-120)/2
41751 I3DRTP(K,N3MODE) = 10
41752 I3DRCF(K,N3MODE) = 1
41753 I3MODE(K,N3MODE) = 423+2*KKK+12*(K-1)
41754 B3MODE(1,K,N3MODE) = 0.0D0
41755 B3MODE(2,K,N3MODE)=LAMDA1(III,JJJ,KKK)*LMIXSS(2*KKK-1,2,K)
41757 54 A3MODE(J,K,N3MODE) = AFC(J,5+2*KKK,K,L1)
41758 C--neutrino neutrino lepton
41759 ELSEIF(MOD(IDKPRD(1,I),2).EQ.0.AND.MOD(IDKPRD(2,I),2).EQ.0
41760 & .AND.MOD(IDKPRD(3,I),2).EQ.1) THEN
41762 IF(N3MODE.GT.NMODE3) CALL HWWARN('HWISP3',119,*999)
41764 NME(I) = 10000+N3MODE
41766 P3MODE(N3MODE) = ONE
41768 SPN3CF(1,1,N3MODE) = ONE
41769 III = (IDKPRD(1,I)-120)/2
41770 JJJ = (IDKPRD(2,I)-120)/2
41771 KKK = (IDKPRD(3,I)-125)/2
41773 I3DRTP(K ,N3MODE) = 2
41774 I3DRTP(K+2,N3MODE) = 3
41775 I3DRCF(K ,N3MODE) = 1
41776 I3DRCF(K+2,N3MODE) = 1
41777 I3MODE(K ,N3MODE) = 423+2*III+12*(K-1)
41778 I3MODE(K+2,N3MODE) = 423+2*JJJ+12*(K-1)
41779 B3MODE(1,K,N3MODE) = LAMDA1(III,JJJ,KKK)*
41780 & LMIXSS(2*III-1,1,K)
41781 B3MODE(2,K,N3MODE) = 0.0D0
41782 B3MODE(1,K+2,N3MODE) =-LAMDA1(III,JJJ,KKK)*
41783 & LMIXSS(2*JJJ-1,1,K)
41784 B3MODE(2,K+2,N3MODE) = 0.0D0
41786 A3MODE(J,K,N3MODE) = AFC(J,5+2*III,K,L1)
41787 55 A3MODE(J,K+2,N3MODE) = AFC(J,5+2*JJJ,K,L1)
41788 C--lepton lepton lepton
41789 ELSEIF(MOD(IDKPRD(1,I),2).EQ.1.AND.MOD(IDKPRD(2,I),2).EQ.1
41790 & .AND.MOD(IDKPRD(3,I),2).EQ.1) THEN
41792 IF(N3MODE.GT.NMODE3) CALL HWWARN('HWISP3',120,*999)
41794 NME(I) = 10000+N3MODE
41796 P3MODE(N3MODE) = ONE
41798 SPN3CF(1,1,N3MODE) = ONE
41799 III = (IDKPRD(1,I)-125)/2
41800 JJJ = (IDKPRD(2,I)-125)/2
41801 KKK = (IDKPRD(3,I)-119)/2
41802 I3DRTP(1,N3MODE) = 8
41803 I3DRTP(2,N3MODE) = 9
41804 I3DRCF(1,N3MODE) = 1
41805 I3DRCF(2,N3MODE) = 1
41806 I3MODE(1,N3MODE) = 424+2*III
41807 I3MODE(2,N3MODE) = 424+2*JJJ
41808 B3MODE(1,1,N3MODE) = 0.0D0
41809 B3MODE(2,1,N3MODE) = LAMDA1(III,JJJ,KKK)
41810 B3MODE(1,2,N3MODE) = 0.0D0
41811 B3MODE(2,2,N3MODE) =-LAMDA1(III,JJJ,KKK)
41813 A3MODE(J,1,N3MODE) = AFC(O(J),6+2*III,1,L1)
41814 56 A3MODE(J,2,N3MODE) = AFC(O(J),6+2*JJJ,1,L1)
41816 CALL HWWARN('HWISP3',3,*2000)
41819 ELSEIF(IDKPRD(1,I).GE.121.AND.IDKPRD(1,I).LE.132.AND.
41820 & IDKPRD(2,I).LE.12 .AND.IDKPRD(3,I).LE. 12) THEN
41823 IF(IDKPRD(1,I).GE.128.AND.MOD(IDKPRD(1,I),2).EQ.0) THEN
41825 IF(N3MODE.GT.NMODE3) CALL HWWARN('HWISP3',121,*999)
41827 NME(I) = 10000+N3MODE
41829 P3MODE(N3MODE) = THREE
41831 SPN3CF(1,1,N3MODE) = ONE
41832 III = (IDKPRD(1,I)-126)/2
41833 JJJ = (IDKPRD(2,I)-5)/2
41834 KKK = IDKPRD(3,I)/2
41836 I3DRTP(K,N3MODE) = 10
41837 I3DRCF(K,N3MODE) = 1
41838 I3MODE(K,N3MODE) = 399+2*KKK+12*(K-1)
41839 B3MODE(1,K,N3MODE) = 0.0D0
41840 B3MODE(2,K,N3MODE) = QMIXSS(2*KKK-1,2,K)*
41841 & LAMDA2(III,JJJ,KKK)
41843 88 A3MODE(J,K,N3MODE) = AFC(J,2*KKK-1,K,L1)
41845 ELSEIF(IDKPRD(1,I).GE.127.AND.MOD(IDKPRD(1,I),2).EQ.1.AND.
41846 & MOD(IDKPRD(2,I),2).EQ.0) THEN
41848 IF(N3MODE.GT.NMODE3) CALL HWWARN('HWISP3',122,*999)
41850 NME(I) = 10000+N3MODE
41852 P3MODE(N3MODE) = THREE
41854 SPN3CF(1,1,N3MODE) = ONE
41855 III = (IDKPRD(1,I)-125)/2
41856 JJJ = (IDKPRD(2,I)-6)/2
41857 KKK = IDKPRD(3,I)/2
41859 I3DRTP(K,N3MODE) = 10
41860 I3DRCF(K,N3MODE) = 1
41861 I3MODE(K,N3MODE) = 399+2*KKK+12*(K-1)
41862 B3MODE(1,K,N3MODE) = 0.0D0
41863 B3MODE(2,K,N3MODE) = QMIXSS(2*KKK-1,2,K)*
41864 & LAMDA2(III,JJJ,KKK)
41866 89 A3MODE(J,K,N3MODE) = AFC(J,2*KKK-1,K,L1)
41868 ELSEIF(IDKPRD(1,I).GE.127.AND.MOD(IDKPRD(1,I),2).EQ.1.AND.
41869 & MOD(IDKPRD(2,I),2).EQ.1) THEN
41871 IF(N3MODE.GT.NMODE3) CALL HWWARN('HWISP3',123,*999)
41873 NME(I) = 10000+N3MODE
41875 P3MODE(N3MODE) = THREE
41877 SPN3CF(1,1,N3MODE) = ONE
41878 III = (IDKPRD(1,I)-125)/2
41879 JJJ = (IDKPRD(2,I)-5)/2
41880 KKK = (IDKPRD(3,I)+1)/2
41881 I3DRTP(1,N3MODE) = 8
41882 I3DRCF(1,N3MODE) = 1
41883 I3MODE(1,N3MODE) = 424+2*III
41884 B3MODE(1,1,N3MODE) = 0.0D0
41885 B3MODE(2,1,N3MODE) = -LAMDA2(III,JJJ,KKK)
41887 91 A3MODE(J,1,N3MODE) = AFC(O(J),2*III+6,1,L1)
41889 I3DRTP(K+1,N3MODE) = 9
41890 I3DRCF(K+1,N3MODE) = 1
41891 I3MODE(K+1,N3MODE) = 400+2*JJJ+12*(K-1)
41892 B3MODE(1,K+1,N3MODE) = 0.0D0
41893 B3MODE(2,K+1,N3MODE) = QMIXSS(2*JJJ,1,K)*
41894 & LAMDA2(III,JJJ,KKK)
41896 92 A3MODE(J,K+1,N3MODE) = AFC(O(J),2*JJJ,K,L1)
41898 ELSEIF(IDKPRD(1,I).LE.126.AND.MOD(IDKPRD(1,I),2).EQ.0) THEN
41900 IF(N3MODE.GT.NMODE3) CALL HWWARN('HWISP3',124,*999)
41902 NME(I) = 10000+N3MODE
41904 P3MODE(N3MODE) = THREE
41906 SPN3CF(1,1,N3MODE) = ONE
41907 III = (IDKPRD(1,I)-120)/2
41908 JJJ = IDKPRD(2,I)/2
41909 KKK = (IDKPRD(3,I)-5)/2
41911 I3DRTP(K ,N3MODE) = 2
41912 I3DRTP(K+2,N3MODE) = 3
41913 I3DRCF(K ,N3MODE) = 1
41914 I3DRCF(K+2,N3MODE) = 1
41915 I3MODE(K ,N3MODE) = 423+2*III+12*(K-1)
41916 I3MODE(K+2,N3MODE) = 399+2*JJJ+12*(K-1)
41917 B3MODE(1,K ,N3MODE) = LMIXSS(2*III-1,1,K)*
41918 & LAMDA2(III,JJJ,KKK)
41919 B3MODE(2,K ,N3MODE) = 0.0D0
41920 B3MODE(1,K+2,N3MODE) = -QMIXSS(2*JJJ-1,1,K)*
41921 & LAMDA2(III,JJJ,KKK)
41922 B3MODE(2,K+2,N3MODE) = 0.0D0
41924 A3MODE(J,K ,N3MODE) = AFC(J,2*III+5,K,L1)
41925 90 A3MODE(J,K+2,N3MODE) = AFC(J,2*JJJ-1,K,L1)
41928 CALL HWWARN('HWISP3',4,*2000)
41931 ELSEIF(IDKPRD(1,I).LE.12.AND.IDKPRD(2,I).LE.12.AND.
41932 & IDKPRD(3,I).LE.12) THEN
41934 C--dbar dbar dbar mode
41935 IF(MOD(IDKPRD(1,I),2).EQ.1.AND.MOD(IDKPRD(2,I),2).EQ.1.AND.
41936 & MOD(IDKPRD(3,I),2).EQ.1) THEN
41938 IF(N3MODE.GT.NMODE3) CALL HWWARN('HWISP3',125,*999)
41940 NME(I) = 10000+N3MODE
41943 SPN3CF(1,1,N3MODE) = ONE
41944 III = (IDKPRD(1,I)-5)/2
41945 JJJ = (IDKPRD(2,I)-5)/2
41946 KKK = (IDKPRD(3,I)-5)/2
41947 P3MODE(N3MODE) = ONE
41948 IF(III.EQ.JJJ) P3MODE(N3MODE) = P3MODE(N3MODE)+ONE
41949 IF(JJJ.EQ.KKK) P3MODE(N3MODE) = P3MODE(N3MODE)+ONE
41950 IF(III.EQ.KKK) P3MODE(N3MODE) = P3MODE(N3MODE)+ONE
41951 P3MODE(N3MODE) = 6.0D0/P3MODE(N3MODE)
41953 66 I3DRCF(K,N3MODE) = 1
41955 I3DRTP(K ,N3MODE) = 14
41956 I3DRTP(K+2,N3MODE) = 15
41957 I3DRTP(K+4,N3MODE) = 16
41958 I3MODE(K ,N3MODE) = 400+2*III+(K-1)*12
41959 I3MODE(K+2,N3MODE) = 400+2*JJJ+(K-1)*12
41960 I3MODE(K+4,N3MODE) = 400+2*KKK+(K-1)*12
41961 B3MODE(1,K ,N3MODE) = QMIXSS(2*III,2,K)*
41962 & LAMDA3(III,JJJ,KKK)
41963 B3MODE(2,K ,N3MODE) = 0.0D0
41964 B3MODE(1,K+2,N3MODE) =-QMIXSS(2*JJJ,2,K)*
41965 & LAMDA3(JJJ,III,KKK)
41966 B3MODE(2,K+2,N3MODE) = 0.0D0
41967 B3MODE(1,K+4,N3MODE) = QMIXSS(2*KKK,2,K)*
41968 & LAMDA3(KKK,III,JJJ)
41969 B3MODE(2,K+4,N3MODE) = 0.0D0
41971 A3MODE(J,K ,N3MODE) = AFC(O(J),2*III,K,L1)
41972 A3MODE(J,K+2,N3MODE) = AFC(O(J),2*JJJ,K,L1)
41973 65 A3MODE(J,K+4,N3MODE) = AFC(O(J),2*KKK,K,L1)
41975 ELSEIF(MOD(IDKPRD(1,I),2).EQ.0.AND.MOD(IDKPRD(2,I),2).EQ.0
41976 & .AND.MOD(IDKPRD(3,I),2).EQ.1) THEN
41978 IF(N3MODE.GT.NMODE3) CALL HWWARN('HWISP3',126,*999)
41980 NME(I) = 10000+N3MODE
41982 P3MODE(N3MODE) = 6.0D0
41984 SPN3CF(1,1,N3MODE) = ONE
41985 III = IDKPRD(1,I)/2
41986 JJJ = IDKPRD(2,I)/2
41987 KKK = (IDKPRD(3,I)+1)/2
41988 IF(III.EQ.JJJ) P3MODE(N3MODE) = HALF*P3MODE(N3MODE)
41990 I3DRTP(K ,N3MODE) = 11
41991 I3DRTP(K+2,N3MODE) = 12
41992 I3DRCF(K ,N3MODE) = 1
41993 I3DRCF(K+2,N3MODE) = 1
41994 I3MODE(K ,N3MODE) = 399+2*III+(K-1)*12
41995 I3MODE(K+2,N3MODE) = 399+2*JJJ+(K-1)*12
41996 B3MODE(1,K ,N3MODE) = 0.0D0
41997 B3MODE(2,K ,N3MODE) = QMIXSS(2*III-1,2,K)*
41998 & LAMDA3(JJJ,III,KKK)
41999 c B3MODE(2,K,N3MODE) = 0.0D0
42000 B3MODE(1,K+2,N3MODE) = 0.0D0
42001 B3MODE(2,K+2,N3MODE) =-QMIXSS(2*JJJ-1,2,K)*
42002 & LAMDA3(III,JJJ,KKK)
42004 A3MODE(J,K ,N3MODE) = AFC(J,2*III-1,K,L1)
42005 64 A3MODE(J,K+2,N3MODE) = AFC(J,2*JJJ-1,K,L1)
42006 C--unrecognized decay issue warning
42008 CALL HWWARN('HWISP3',5,*2000)
42010 C--unrecognized decay issue warning
42012 CALL HWWARN('HWISP3',6,*2000)
42014 ELSEIF(IDK(I).GE.456.AND.IDK(I).LE.457) THEN
42015 C-- -ve chargino modes last
42016 C--first the chargino modes to fermion-antifermion neutralino
42017 IF(L.GE.1.AND.L.LE.4.AND.(IDKPRD(2,I).LE.12.OR.
42018 & (IDKPRD(2,I).GE.121.AND.IDKPRD(2,I).LE.132))) THEN
42020 IFR = IFR+MOD(IFR,2)
42021 J = INT((IFR-1)/120)
42022 IFR = IFR-6*INT((IFR-1)/6)+6*J
42027 IF(N3MODE.GT.NMODE3) CALL HWWARN('HWISP3',127,*999)
42029 NME(I) = 10000+N3MODE
42031 P3MODE(N3MODE) = ONE
42032 IF(IDKPRD(2,I).LE.12) P3MODE(N3MODE) = THREE
42033 SPN3CF(1,1,N3MODE) = ONE
42035 C--sfermion exchange diagrams
42037 I3DRTP(K ,N3MODE) = 3
42038 I3DRCF(K ,N3MODE) = 1
42039 I3DRTP(K+2,N3MODE) = 4
42040 I3DRCF(K+2,N3MODE) = 1
42041 I3MODE(K ,N3MODE) = 12*(K-1)+406+SIFR
42042 I3MODE(K+2,N3MODE) = 12*(K-1)+399+SIFR
42044 A3MODE(J,K ,N3MODE) = AFC( J ,IFR ,K,L1)
42045 B3MODE(J,K ,N3MODE) = AFN(O(J),IFR ,K,L )
42046 A3MODE(J,K+2,N3MODE) = AFC(O(J),IFR-1,K,L1)
42047 15 B3MODE(J,K+2,N3MODE) = AFN( J ,IFR-1,K,L )
42048 C--gauge boson diagram
42049 IF(RMASS(IDK(I)).LT.MW+RMASS(IDKPRD(1,I))) THEN
42050 NDI3BY(N3MODE) = NDI3BY(N3MODE)+1
42051 I3DRTP(NDI3BY(N3MODE),N3MODE) = 1
42052 I3DRCF(NDI3BY(N3MODE),N3MODE) = 1
42053 I3MODE(NDI3BY(N3MODE),N3MODE) = 199
42055 16 A3MODE(J,NDI3BY(N3MODE),N3MODE) =-OIJ(O(J),L,L1)
42056 B3MODE(1,NDI3BY(N3MODE),N3MODE) = ZERO
42057 B3MODE(2,NDI3BY(N3MODE),N3MODE) = -G*ORT
42059 C--then the chargino modes to fermion-antifermion chargino
42060 ELSEIF(L.GE.5.AND.L.LE.8.AND.(IDKPRD(2,I).LE.12.OR.
42061 & (IDKPRD(2,I).GE.121.AND.IDKPRD(2,I).LE.132))) THEN
42064 J = INT((IFR-1)/120)
42065 IFR = IFR-6*INT((IFR-1)/6)+6*J
42068 IF(MOD(IFR,2).EQ.0) THEN
42077 IF(N3MODE.GT.NMODE3) CALL HWWARN('HWISP3',128,*999)
42079 NME(I) = 10000+N3MODE
42081 P3MODE(N3MODE) = ONE
42082 IF(IDKPRD(2,I).LE.12) P3MODE(N3MODE) = THREE
42083 SPN3CF(1,1,N3MODE) = ONE
42085 C--sfermion exchange diagrams
42086 IF(MOD(IL,2).EQ.0) THEN
42088 I3DRTP(K,N3MODE) = 4
42089 I3DRCF(K,N3MODE) = 1
42090 I3MODE(K,N3MODE) = 12*(K-1)+400+SIFR
42092 A3MODE(J,K,N3MODE) = AFC(O(J),IFR,K,L1)
42093 17 B3MODE(J,K,N3MODE) = AFC( J ,IFR,K,L )
42096 I3DRTP(K,N3MODE) = 3
42097 I3DRCF(K,N3MODE) = 1
42098 I3MODE(K,N3MODE) = 12*(K-1)+400+SIFR
42100 A3MODE(J,K,N3MODE) = AFC( J ,IFR,K,L1)
42101 18 B3MODE(J,K,N3MODE) = AFC(O(J),IFR,K,L )
42103 C--gauge boson diagram
42104 IF(RMASS(IDK(I)).LT.MZ+RMASS(IDKPRD(1,I))) THEN
42105 NDI3BY(N3MODE) = NDI3BY(N3MODE)+1
42106 I3DRTP(NDI3BY(N3MODE),N3MODE) = 1
42107 I3DRCF(NDI3BY(N3MODE),N3MODE) = 1
42108 I3MODE(NDI3BY(N3MODE),N3MODE) = 200
42110 19 A3MODE(J,NDI3BY(N3MODE),N3MODE) =-OIJP(O(J),L,L1)
42111 B3MODE(1,NDI3BY(N3MODE),N3MODE) = -E*RFCH(IL)
42112 B3MODE(2,NDI3BY(N3MODE),N3MODE) = -E*LFCH(IL)
42114 C--R-parity violating decays
42116 ELSEIF(IDKPRD(1,I).GE.121.AND.IDKPRD(1,I).LE.132.AND.
42117 & IDKPRD(2,I).GE.121.AND.IDKPRD(2,I).LE.132.AND.
42118 & IDKPRD(1,I).GE.121.AND.IDKPRD(3,I).LE.132) THEN
42120 C--neutrino lepton neutrino
42121 IF(MOD(IDKPRD(1,I),2).EQ.0.AND.MOD(IDKPRD(2,I),2).EQ.1.AND.
42122 & MOD(IDKPRD(3,I),2).EQ.0) THEN
42124 IF(N3MODE.GT.NMODE3) CALL HWWARN('HWISP3',129,*999)
42126 NME(I) = 10000+N3MODE
42128 P3MODE(N3MODE) = ONE
42130 SPN3CF(1,1,N3MODE) = ONE
42131 III = (IDKPRD(1,I)-120)/2
42132 JJJ = (IDKPRD(2,I)-119)/2
42133 KKK = (IDKPRD(3,I)-126)/2
42135 I3DRTP(K,N3MODE) = 4
42136 I3DRCF(K,N3MODE) = 1
42137 I3MODE(K,N3MODE) = 423+2*KKK+12*(K-1)
42138 B3MODE(2,K,N3MODE) = 0.0D0
42139 B3MODE(1,K,N3MODE)=LAMDA1(III,JJJ,KKK)*LMIXSS(2*KKK-1,2,K)
42141 57 A3MODE(J,K,N3MODE) = AFC(O(J),5+2*KKK,K,L1)
42142 C--neutrino neutrino lepton
42143 ELSEIF(MOD(IDKPRD(1,I),2).EQ.0.AND.MOD(IDKPRD(2,I),2).EQ.0
42144 & .AND.MOD(IDKPRD(3,I),2).EQ.1) THEN
42146 IF(N3MODE.GT.NMODE3) CALL HWWARN('HWISP3',130,*999)
42148 NME(I) = 10000+N3MODE
42150 P3MODE(N3MODE) = ONE
42152 SPN3CF(1,1,N3MODE) = ONE
42153 III = (IDKPRD(1,I)-126)/2
42154 JJJ = (IDKPRD(2,I)-126)/2
42155 KKK = (IDKPRD(3,I)-119)/2
42157 I3DRTP(K ,N3MODE) = 8
42158 I3DRTP(K+2,N3MODE) = 9
42159 I3DRCF(K ,N3MODE) = 1
42160 I3DRCF(K+2,N3MODE) = 1
42161 I3MODE(K ,N3MODE) = 423+2*III+12*(K-1)
42162 I3MODE(K+2,N3MODE) = 423+2*JJJ+12*(K-1)
42163 B3MODE(2,K,N3MODE) = LAMDA1(III,JJJ,KKK)*
42164 & LMIXSS(2*III-1,1,K)
42165 B3MODE(1,K,N3MODE) = 0.0D0
42166 B3MODE(2,K+2,N3MODE) =-LAMDA1(III,JJJ,KKK)*
42167 & LMIXSS(2*JJJ-1,1,K)
42168 B3MODE(1,K+2,N3MODE) = 0.0D0
42170 A3MODE(J,K,N3MODE) = AFC(O(J),5+2*III,K,L1)
42171 58 A3MODE(J,K+2,N3MODE) = AFC(O(J),5+2*JJJ,K,L1)
42172 C--lepton lepton lepton
42173 ELSEIF(MOD(IDKPRD(1,I),2).EQ.1.AND.MOD(IDKPRD(2,I),2).EQ.1
42174 & .AND.MOD(IDKPRD(3,I),2).EQ.1) THEN
42176 IF(N3MODE.GT.NMODE3) CALL HWWARN('HWISP3',131,*999)
42178 NME(I) = 10000+N3MODE
42180 P3MODE(N3MODE) = ONE
42182 SPN3CF(1,1,N3MODE) = ONE
42183 III = (IDKPRD(1,I)-119)/2
42184 JJJ = (IDKPRD(2,I)-119)/2
42185 KKK = (IDKPRD(3,I)-125)/2
42186 I3DRTP(1,N3MODE) = 2
42187 I3DRTP(2,N3MODE) = 3
42188 I3DRCF(1,N3MODE) = 1
42189 I3DRCF(2,N3MODE) = 1
42190 I3MODE(1,N3MODE) = 424+2*III
42191 I3MODE(2,N3MODE) = 424+2*JJJ
42192 B3MODE(1,1,N3MODE) = LAMDA1(III,JJJ,KKK)
42193 B3MODE(2,1,N3MODE) = 0.0D0
42194 B3MODE(1,2,N3MODE) =-LAMDA1(III,JJJ,KKK)
42195 B3MODE(2,2,N3MODE) = 0.0D0
42197 A3MODE(J,1,N3MODE) = AFC(J,6+2*III,1,L1)
42198 59 A3MODE(J,2,N3MODE) = AFC(J,6+2*JJJ,1,L1)
42200 CALL HWWARN('HWISP3',7,*2000)
42203 ELSEIF(IDKPRD(1,I).GE.121.AND.IDKPRD(1,I).LE.132.AND.
42204 & IDKPRD(2,I).LE.12 .AND.IDKPRD(3,I).LE. 12) THEN
42207 IF(IDKPRD(1,I).LE.126.AND.MOD(IDKPRD(1,I),2).EQ.0) THEN
42209 IF(N3MODE.GT.NMODE3) CALL HWWARN('HWISP3',132,*999)
42211 NME(I) = 10000+N3MODE
42213 P3MODE(N3MODE) = THREE
42215 SPN3CF(1,1,N3MODE) = ONE
42216 III = (IDKPRD(1,I)-120)/2
42217 JJJ = (IDKPRD(2,I)+1)/2
42218 KKK = (IDKPRD(3,I)-6)/2
42220 I3DRTP(K,N3MODE) = 4
42221 I3DRCF(K,N3MODE) = 1
42222 I3MODE(K,N3MODE) = 399+2*KKK+12*(K-1)
42223 B3MODE(2,K,N3MODE) = 0.0D0
42224 B3MODE(1,K,N3MODE) = QMIXSS(2*KKK-1,2,K)*
42225 & LAMDA2(III,JJJ,KKK)
42227 93 A3MODE(J,K,N3MODE) = AFC(O(J),2*KKK-1,K,L1)
42229 ELSEIF(IDKPRD(1,I).LE.125.AND.MOD(IDKPRD(1,I),2).EQ.1.AND.
42230 & MOD(IDKPRD(2,I),2).EQ.0) THEN
42232 IF(N3MODE.GT.NMODE3) CALL HWWARN('HWISP3',133,*999)
42234 NME(I) = 10000+N3MODE
42236 P3MODE(N3MODE) = THREE
42238 SPN3CF(1,1,N3MODE) = ONE
42239 III = (IDKPRD(1,I)-119)/2
42240 JJJ = IDKPRD(2,I)/2
42241 KKK = (IDKPRD(3,I)-6)/2
42243 I3DRTP(K,N3MODE) = 4
42244 I3DRCF(K,N3MODE) = 1
42245 I3MODE(K,N3MODE) = 399+2*KKK+12*(K-1)
42246 B3MODE(2,K,N3MODE) = 0.0D0
42247 B3MODE(1,K,N3MODE) = QMIXSS(2*KKK-1,2,K)*
42248 & LAMDA2(III,JJJ,KKK)
42250 94 A3MODE(J,K,N3MODE) = AFC(J,2*KKK-1,K,L1)
42252 ELSEIF(IDKPRD(1,I).LE.125.AND.MOD(IDKPRD(1,I),2).EQ.1.AND.
42253 & MOD(IDKPRD(2,I),2).EQ.1) THEN
42255 IF(N3MODE.GT.NMODE3) CALL HWWARN('HWISP3',134,*999)
42257 NME(I) = 10000+N3MODE
42259 P3MODE(N3MODE) = THREE
42261 SPN3CF(1,1,N3MODE) = ONE
42262 III = (IDKPRD(1,I)-119)/2
42263 JJJ = (IDKPRD(2,I)+1)/2
42264 KKK = (IDKPRD(3,I)-5)/2
42265 I3DRTP(1,N3MODE) = 2
42266 I3DRCF(1,N3MODE) = 1
42267 I3MODE(1,N3MODE) = 424+2*III
42268 B3MODE(2,1,N3MODE) = 0.0D0
42269 B3MODE(1,1,N3MODE) = -LAMDA2(III,JJJ,KKK)
42271 95 A3MODE(J,1,N3MODE) = AFC(J,2*III+6,1,L1)
42273 I3DRTP(K+1,N3MODE) = 3
42274 I3DRCF(K+1,N3MODE) = 1
42275 I3MODE(K+1,N3MODE) = 400+2*JJJ+12*(K-1)
42276 B3MODE(2,K+1,N3MODE) = 0.0D0
42277 B3MODE(1,K+1,N3MODE) = QMIXSS(2*JJJ,1,K)*
42278 & LAMDA2(III,JJJ,KKK)
42280 96 A3MODE(J,K+1,N3MODE) = AFC(J,2*JJJ,K,L1)
42282 ELSEIF(IDKPRD(1,I).GE.128.AND.MOD(IDKPRD(1,I),2).EQ.0) THEN
42284 IF(N3MODE.GT.NMODE3) CALL HWWARN('HWISP3',135,*999)
42286 NME(I) = 10000+N3MODE
42288 P3MODE(N3MODE) = THREE
42290 SPN3CF(1,1,N3MODE) = ONE
42291 III = (IDKPRD(1,I)-126)/2
42292 JJJ = (IDKPRD(2,I)-6)/2
42293 KKK = (IDKPRD(3,I)+1)/2
42295 I3DRTP(K ,N3MODE) = 8
42296 I3DRTP(K+2,N3MODE) = 9
42297 I3DRCF(K ,N3MODE) = 1
42298 I3DRCF(K+2,N3MODE) = 1
42299 I3MODE(K ,N3MODE) = 423+2*III+12*(K-1)
42300 I3MODE(K+2,N3MODE) = 399+2*JJJ+12*(K-1)
42301 B3MODE(2,K ,N3MODE) = LMIXSS(2*III-1,1,K)*
42302 & LAMDA2(III,JJJ,KKK)
42303 B3MODE(1,K ,N3MODE) = 0.0D0
42304 B3MODE(2,K+2,N3MODE) = -QMIXSS(2*JJJ-1,1,K)*
42305 & LAMDA2(III,JJJ,KKK)
42306 B3MODE(1,K+2,N3MODE) = 0.0D0
42308 A3MODE(J,K ,N3MODE) = AFC(O(J),2*III+5,K,L1)
42309 97 A3MODE(J,K+2,N3MODE) = AFC(O(J),2*JJJ-1,K,L1)
42312 CALL HWWARN('HWISP3',8,*2000)
42315 ELSEIF(IDKPRD(1,I).LE.12.AND.IDKPRD(2,I).LE.12.AND.
42316 & IDKPRD(3,I).LE.12) THEN
42319 IF(MOD(IDKPRD(1,I),2).EQ.1.AND.MOD(IDKPRD(2,I),2).EQ.1.AND.
42320 & MOD(IDKPRD(3,I),2).EQ.1) THEN
42322 IF(N3MODE.GT.NMODE3) CALL HWWARN('HWISP3',136,*999)
42324 NME(I) = 10000+N3MODE
42327 SPN3CF(1,1,N3MODE) = ONE
42328 III = (IDKPRD(1,I)+1)/2
42329 JJJ = (IDKPRD(2,I)+1)/2
42330 KKK = (IDKPRD(3,I)+1)/2
42331 P3MODE(N3MODE) = ONE
42332 IF(III.EQ.JJJ) P3MODE(N3MODE) = P3MODE(N3MODE)+ONE
42333 IF(JJJ.EQ.KKK) P3MODE(N3MODE) = P3MODE(N3MODE)+ONE
42334 IF(III.EQ.KKK) P3MODE(N3MODE) = P3MODE(N3MODE)+ONE
42335 P3MODE(N3MODE) = 6.0D0/P3MODE(N3MODE)
42337 68 I3DRCF(K,N3MODE) = 1
42339 I3DRTP(K ,N3MODE) = 12
42340 I3DRTP(K+2,N3MODE) = 13
42341 I3DRTP(K+4,N3MODE) = 14
42342 I3MODE(K ,N3MODE) = 400+2*III+(K-1)*12
42343 I3MODE(K+2,N3MODE) = 400+2*JJJ+(K-1)*12
42344 I3MODE(K+4,N3MODE) = 400+2*KKK+(K-1)*12
42345 B3MODE(1,K ,N3MODE) = 0.0D0
42346 B3MODE(1,K+2,N3MODE) = 0.0D0
42347 B3MODE(1,K+4,N3MODE) = 0.0D0
42348 B3MODE(2,K ,N3MODE) = QMIXSS(2*III,2,K)*
42349 & LAMDA3(III,JJJ,KKK)
42350 B3MODE(2,K+2,N3MODE) =-QMIXSS(2*JJJ,2,K)*
42351 & LAMDA3(JJJ,III,KKK)
42352 B3MODE(2,K+4,N3MODE) = QMIXSS(2*KKK,2,K)*
42353 & LAMDA3(KKK,III,JJJ)
42355 A3MODE(J,K ,N3MODE) = AFC(J,2*III,K,L1)
42356 A3MODE(J,K+2,N3MODE) = AFC(J,2*JJJ,K,L1)
42357 67 A3MODE(J,K+4,N3MODE) = AFC(J,2*KKK,K,L1)
42359 ELSEIF(MOD(IDKPRD(1,I),2).EQ.0.AND.MOD(IDKPRD(2,I),2).EQ.0
42360 & .AND.MOD(IDKPRD(3,I),2).EQ.1) THEN
42362 IF(N3MODE.GT.NMODE3) CALL HWWARN('HWISP3',137,*999)
42364 NME(I) = 10000+N3MODE
42366 P3MODE(N3MODE) = 6.0D0
42368 SPN3CF(1,1,N3MODE) = ONE
42369 III = (IDKPRD(1,I)-6)/2
42370 JJJ = (IDKPRD(2,I)-6)/2
42371 KKK = (IDKPRD(3,I)-5)/2
42372 IF(III.EQ.JJJ) P3MODE(N3MODE) = HALF*P3MODE(N3MODE)
42374 I3DRTP(K ,N3MODE) = 11
42375 I3DRTP(K+2,N3MODE) = 12
42376 I3DRCF(K ,N3MODE) = 1
42377 I3DRCF(K+2,N3MODE) = 1
42378 I3MODE(K ,N3MODE) = 399+2*III+(K-1)*12
42379 I3MODE(K+2,N3MODE) = 399+2*JJJ+(K-1)*12
42380 B3MODE(1,K ,N3MODE) = QMIXSS(2*III-1,2,K)*
42381 & LAMDA3(JJJ,III,KKK)
42382 B3MODE(1,K+2,N3MODE) =-QMIXSS(2*JJJ-1,2,K)*
42383 & LAMDA3(III,JJJ,KKK)
42384 B3MODE(2,K+2,N3MODE) = 0.0D0
42385 B3MODE(2,K+2,N3MODE) = 0.0D0
42387 A3MODE(J,K ,N3MODE) = AFC(O(J),2*III-1,K,L1)
42388 69 A3MODE(J,K+2,N3MODE) = AFC(O(J),2*JJJ-1,K,L1)
42389 C--unrecognized decay issue warning
42391 CALL HWWARN('HWISP3',9,*2000)
42393 C--unrecognized decay issue warning
42395 CALL HWWARN('HWISP3',10,*2000)
42398 C--NOW FIND THE TWO BODY MODES WE WILL TREAT AS THREE BODY
42399 2500 IF(IDKPRD(2,I).EQ.0.OR.IDKPRD(3,I).NE.0) GOTO 2000
42402 IH = IDKPRD(1,I)-202
42403 C--first the neutralino decay modes
42404 IF(L1.GE.1.AND.L1.LE.4.AND.
42405 & IDKPRD(2,I).GE.198.AND.IDKPRD(2,I).LE.200) THEN
42406 C--neutralino --> neutralino Z
42407 IF(L.GE.1.AND.L.LE.4.AND.IDKPRD(2,I).EQ.200) THEN
42409 IF(NBMODE.GT.NMODEB) CALL HWWARN('HWISP3',138,*999)
42410 NME(I) = 20000+NBMODE
42412 IBMODE(NBMODE) = 200
42415 20 ABMODE(J,NBMODE) = OIJPP(J,L,L1)
42419 PBMODE(K,NBMODE) = THREE
42422 PBMODE(K,NBMODE) = ONE
42424 BBMODE(1,K,NBMODE) = -E*RFCH(IL)
42425 21 BBMODE(2,K,NBMODE) = -E*LFCH(IL)
42426 C--neutralino --> chargino+ W-
42427 ELSEIF((L.EQ.5.OR.L.EQ.6).AND.IDKPRD(2,I).EQ.199) THEN
42430 IF(NBMODE.GT.NMODEB) CALL HWWARN('HWISP3',139,*999)
42431 NME(I) = 20000+NBMODE
42433 IBMODE(NBMODE) = 199
42436 22 ABMODE(J,NBMODE) = OIJ(J,L1,L)
42438 PBMODE(K,NBMODE) = ONE
42439 IF(K.LE.3) PBMODE(K,NBMODE) = THREE
42440 BBMODE(1,K,NBMODE) = ZERO
42441 23 BBMODE(2,K,NBMODE) = -G*ORT
42442 C--neutralino --> chargino- W+
42443 ELSEIF((L.EQ.7.OR.L.EQ.8).AND.IDKPRD(2,I).EQ.198) THEN
42446 IF(NBMODE.GT.NMODEB) CALL HWWARN('HWISP3',140,*999)
42447 NME(I) = 20000+NBMODE
42449 IBMODE(NBMODE) = 198
42452 24 ABMODE(J,NBMODE) =-OIJ(O(J),L1,L)
42454 PBMODE(K,NBMODE) = ONE
42455 IF(K.LE.3) PBMODE(K,NBMODE) = THREE
42456 BBMODE(1,K,NBMODE) = ZERO
42457 25 BBMODE(2,K,NBMODE) = -G*ORT
42458 C--gravitino Z modes
42459 ELSEIF(L.EQ.9.AND.IDKPRD(2,I).EQ.200) THEN
42461 IF(NBMODE.GT.NMODEB) CALL HWWARN('HWISP3',141,*999)
42462 NME(I) = 20000+NBMODE
42464 IBMODE(NBMODE) = 200
42466 ABMODE(1,NBMODE) = 2.0D0/SQRT(6.0D0)*ZMIXSS(L1,2)
42467 ABMODE(2,NBMODE) = 2.0D0/SQRT(6.0D0)*RMASS(200)*
42468 & (ZMIXSS(L1,3)*COSB-ZMIXSS(L1,4)*SINB)
42472 PBMODE(K,NBMODE) = THREE
42475 PBMODE(K,NBMODE) = ONE
42477 BBMODE(1,K,NBMODE) = -E*RFCH(IL)
42478 41 BBMODE(2,K,NBMODE) = -E*LFCH(IL)
42479 C--unrecognized decay issue warning
42481 CALL HWWARN('HWISP3',11,*2000)
42483 C--then the +ve chargino decay modes
42484 ELSEIF((L1.EQ.5.OR.L1.EQ.6)
42485 & .AND.IDKPRD(2,I).GE.198.AND.IDKPRD(2,I).LE.200) THEN
42487 C--chargino --> chargino Z
42488 IF((L.EQ.5.OR.L.EQ.6).AND.IDKPRD(2,I).EQ.200) THEN
42491 IF(NBMODE.GT.NMODEB) CALL HWWARN('HWISP3',142,*999)
42492 NME(I) = 20000+NBMODE
42494 IBMODE(NBMODE) = 200
42497 26 ABMODE(J,NBMODE) = OIJP(J,L,L1)
42501 PBMODE(K,NBMODE) = THREE
42504 PBMODE(K,NBMODE) = ONE
42506 BBMODE(1,K,NBMODE) = -E*RFCH(IL)
42507 27 BBMODE(2,K,NBMODE) = -E*LFCH(IL)
42508 C--chargino --> neutralino W+
42509 ELSEIF(L.GE.1.AND.L.LE.4.AND.IDKPRD(2,I).EQ.198) THEN
42511 IF(NBMODE.GT.NMODEB) CALL HWWARN('HWISP3',143,*999)
42512 NME(I) = 20000+NBMODE
42514 IBMODE(NBMODE) = 198
42517 28 ABMODE(J,NBMODE) = OIJ(J,L,L1)
42519 PBMODE(K,NBMODE) = ONE
42520 IF(K.LE.3) PBMODE(K,NBMODE) = THREE
42521 BBMODE(1,K,NBMODE) = ZERO
42522 29 BBMODE(2,K,NBMODE) = -G*ORT
42523 C--unrecognised decay issue warning
42525 CALL HWWARN('HWISP3',12,*2000)
42527 C--then the -ve chargino decay modes
42528 ELSEIF((L1.EQ.7.OR.L1.EQ.8)
42529 & .AND.IDKPRD(2,I).GE.198.AND.IDKPRD(2,I).LE.200) THEN
42531 C--chargino --> chargino Z
42532 IF((L.EQ.7.OR.L.EQ.8).AND.IDKPRD(2,I).EQ.200) THEN
42535 IF(NBMODE.GT.NMODEB) CALL HWWARN('HWISP3',144,*999)
42536 NME(I) = 20000+NBMODE
42538 IBMODE(NBMODE) = 200
42541 30 ABMODE(J,NBMODE) =-OIJP(O(J),L,L1)
42545 PBMODE(K,NBMODE) = THREE
42548 PBMODE(K,NBMODE) = ONE
42550 BBMODE(1,K,NBMODE) = -E*RFCH(IL)
42551 31 BBMODE(2,K,NBMODE) = -E*LFCH(IL)
42552 C--chargino --> neutralino W-
42553 ELSEIF(L.GE.1.AND.L.LE.4.AND.IDKPRD(2,I).EQ.199) THEN
42555 IF(NBMODE.GT.NMODEB) CALL HWWARN('HWISP3',145,*999)
42556 NME(I) = 20000+NBMODE
42558 IBMODE(NBMODE) = 199
42561 32 ABMODE(J,NBMODE) =-OIJ(O(J),L,L1)
42563 PBMODE(K,NBMODE) = ONE
42564 IF(K.LE.3) PBMODE(K,NBMODE) = THREE
42565 BBMODE(1,K,NBMODE) = ZERO
42566 33 BBMODE(2,K,NBMODE) = -G*ORT
42567 C--unrecognised decay issue warning
42569 CALL HWWARN('HWISP3',13,*2000)
42571 C--gauge boson decay modes of the Higgs
42572 ELSEIF(IH.GE.1.AND.IH.LE.5.AND.IH1.GE.1.AND.IH1.LE.5.AND.
42573 & IDKPRD(1,I).GE.198.AND.IDKPRD(2,I).LE.200) THEN
42574 C--decay of the A0 to scalar Higgs and Z boson
42575 IF(IH1.EQ.3.AND.IH.LE.2) THEN
42577 IF(NBMODE.GT.NMODEB) CALL HWWARN('HWISP3',146,*999)
42578 NME(I) = 20000+NBMODE
42580 IBMODE(NBMODE) = 200
42582 ABMODE(1,NBMODE) =-HHB(2,IH)
42583 ABMODE(2,NBMODE) = ZERO
42587 PBMODE(K,NBMODE) = 3.0D0
42590 PBMODE(K,NBMODE) = 1.0D0
42592 BBMODE(1,K,NBMODE) = -E*RFCH(IL)
42593 34 BBMODE(2,K,NBMODE) = -E*LFCH(IL)
42594 C--decay of scalar Higgs to A0 and Z
42595 ELSEIF(IH.EQ.3.AND.IH1.LE.3) THEN
42597 IF(NBMODE.GT.NMODEB) CALL HWWARN('HWISP3',147,*999)
42598 NME(I) = 20000+NBMODE
42600 IBMODE(NBMODE) = 200
42602 ABMODE(1,NBMODE) = HHB(2,IH1)
42603 ABMODE(2,NBMODE) = ZERO
42607 PBMODE(K,NBMODE) = 3.0D0
42610 PBMODE(K,NBMODE) = 1.0D0
42612 BBMODE(1,K,NBMODE) = -E*RFCH(IL)
42613 35 BBMODE(2,K,NBMODE) = -E*LFCH(IL)
42614 C--decay of the positively charged Higgs
42615 ELSEIF(IH1.EQ.4.AND.IH.LE.3) THEN
42617 IF(NBMODE.GT.NMODEB) CALL HWWARN('HWISP3',148,*999)
42618 NME(I) = 20000+NBMODE
42620 IBMODE(NBMODE) = 198
42622 ABMODE(1,NBMODE) =-HHB(1,IH)
42623 ABMODE(2,NBMODE) = ZERO
42625 PBMODE(K,NBMODE) = 1.0D0
42626 IF(K.LE.3) PBMODE(K,NBMODE) = 3.0D0
42627 BBMODE(1,K,NBMODE) = ZERO
42628 36 BBMODE(2,K,NBMODE) = -G*ORT
42629 C--decay of the negatively charged Higgs
42630 ELSEIF(IH1.EQ.5.AND.IH.LE.3) THEN
42632 IF(NBMODE.GT.NMODEB) CALL HWWARN('HWISP3',149,*999)
42633 NME(I) = 20000+NBMODE
42635 IBMODE(NBMODE) = 199
42637 ABMODE(1,NBMODE) =-HHB(1,IH)
42638 ABMODE(2,NBMODE) = ZERO
42640 PBMODE(K,NBMODE) = 1.0D0
42641 IF(K.LE.3) PBMODE(K,NBMODE) = 3.0D0
42642 BBMODE(1,K,NBMODE) = ZERO
42643 37 BBMODE(2,K,NBMODE) = -G*ORT
42645 C--finally sfermion modes to gauge bosons
42646 ELSEIF(IDK(I).GE.401.AND.IDK(I).LE.448.AND.
42647 & IDKPRD(2,I).GE.401.AND.IDKPRD(2,I).LE.448.AND.
42648 & IDKPRD(1,I).GE.198.AND.IDKPRD(1,I).LE.200) THEN
42649 C--change the order of the decay products
42650 IM = MOD(INT((IDK(I)-389)/12)+1,2)+1
42651 IL = 6*INT((IDK(I)-401)/24)+MOD(IDK(I)-401,6)+1
42652 IH = MOD(INT((IDKPRD(2,I)-389)/12)+1,2)+1
42653 IQ = 6*INT((IDKPRD(2,I)-401)/24)+MOD(IDKPRD(2,I)-401,6)+1
42654 C--first the Z decay modes
42655 IF(IDKPRD(1,I).EQ.200) THEN
42657 IF(NBMODE.GT.NMODEB) CALL HWWARN('HWISP3',150,*999)
42658 NME(I) = 20000+NBMODE
42660 IBMODE(NBMODE) = 200
42662 ABMODE(1,NBMODE) = ZAB(IL,IM,IH)
42663 ABMODE(2,NBMODE) = ZERO
42667 PBMODE(K,NBMODE) = 3.0D0
42670 PBMODE(K,NBMODE) = 1.0D0
42672 BBMODE(1,K,NBMODE) = -E*RFCH(IL)
42673 38 BBMODE(2,K,NBMODE) = -E*LFCH(IL)
42674 C--then the W+ decay modes
42675 ELSEIF(IDKPRD(1,I).EQ.198) THEN
42677 IF(NBMODE.GT.NMODEB) CALL HWWARN('HWISP3',151,*999)
42678 NME(I) = 20000+NBMODE
42680 IBMODE(NBMODE) = 198
42683 ABMODE(1,NBMODE) = -G*ORT*QMIXSS(IL,1,IM)*QMIXSS(IQ,1,IH)
42685 ABMODE(1,NBMODE) = -G*ORT*LMIXSS(IL-6,1,IM)*
42686 & LMIXSS(IQ-6,1,IH)
42688 ABMODE(2,NBMODE) = ZERO
42690 PBMODE(K,NBMODE) = 1.0D0
42691 IF(K.LE.3) PBMODE(K,NBMODE) = 3.0D0
42692 BBMODE(1,K,NBMODE) = ZERO
42693 39 BBMODE(2,K,NBMODE) = -G*ORT
42694 ELSEIF(IDKPRD(1,I).EQ.199) THEN
42696 IF(NBMODE.GT.NMODEB) CALL HWWARN('HWISP3',152,*999)
42697 NME(I) = 20000+NBMODE
42699 IBMODE(NBMODE) = 199
42702 ABMODE(1,NBMODE) = -G*ORT*QMIXSS(IL,1,IM)*QMIXSS(IQ,1,IH)
42704 ABMODE(1,NBMODE) = -G*ORT*LMIXSS(IL-6,1,IM)*
42705 & LMIXSS(IQ-6,1,IH)
42707 ABMODE(2,NBMODE) = ZERO
42709 PBMODE(K,NBMODE) = 1.0D0
42710 IF(K.LE.3) PBMODE(K,NBMODE) = 3.0D0
42711 BBMODE(1,K,NBMODE) = ZERO
42712 40 BBMODE(2,K,NBMODE) = -G*ORT
42716 C--now compute the maximum weights for the three body decays found
42719 IF(RSPIN(IDK(ID3PRT(I))).EQ.ZERO) THEN
42730 PHEP(5,1) = RMASS(IDK(ID3PRT(I)))
42731 PHEP(4,1) = SQRT(100.0D0**2+PHEP(5,1)**2)
42732 PHEP(1,1) = 100.0D0
42735 IF(IPRINT.EQ.2) WRITE(6,5000) RNAME(IDK(ID3PRT(I))),
42736 & RNAME(IDKPRD(1,ID3PRT(I))),RNAME(IDKPRD(2,ID3PRT(I))),
42737 & RNAME(IDKPRD(3,ID3PRT(I)))
42738 3000 CALL HWD3ME(1,0,I,RHOIN,1)
42739 IF(.NOT.SUSYIN) RETURN
42740 C--and for the two body gauge boson modes
42742 IF(RSPIN(IDK(IDBPRT(I))).EQ.ZERO) THEN
42753 PHEP(5,1) = RMASS(IDK(IDBPRT(I)))
42754 PHEP(4,1) = SQRT(100.0D0**2+PHEP(5,1)**2)
42755 PHEP(1,1) = 100.0D0
42758 IF(IPRINT.EQ.2) WRITE(6,5010) RNAME(IDK(IDBPRT(I))),
42759 & RNAME(IDKPRD(1,IDBPRT(I))),RNAME(IDKPRD(2,IDBPRT(I)))
42761 IF(IBMODE(I).NE.200) IL = 6
42763 4000 CALL HWD3ME(1,J,I,RHOIN,1)
42765 5000 FORMAT(/'CALCULATING THREE BODY DECAY ',
42766 & A8,' --> ',A8,' ',A8,' ',A8/)
42767 5010 FORMAT(/'CALCULATING TWO BODY DECAY ',
42768 & A8,' --> ',A8,' ',A8/)
42771 *CMZ :- -12/10/01 12.04.54 by Peter Richardson
42772 *-- Author : Peter Richardson
42773 C-----------------------------------------------------------------------
42775 C-----------------------------------------------------------------------
42776 C Initialise the Higgs four body modes
42777 C-----------------------------------------------------------------------
42778 INCLUDE 'HERWIG65.INC'
42779 INTEGER I,J,K,IL,IH,II,JJ
42780 DOUBLE PRECISION COL(2),SW,CW,TW,E,G,RT,ORT,MW,MZ,AFN(2,12,2,4),
42781 & AFG(2,6,2),AFC(2,12,2,2),OIJ(2,4,2),OIJP(2,2,2),OIJPP(2,4,4),
42782 & HNN(2,3,4,4),HCC(2,3,2,2),HNC(2,4,2),HFF(2,4,12),HWW(2),
42783 & HZZ(2),ZAB(12,2,2),HHB(2,3),GS
42784 COMMON /HWSPNC/ SW,CW,TW,E,G,RT,ORT,MW,MZ,GS,AFN,AFG,AFC,OIJ,OIJP,
42785 & OIJPP,HNN,HCC,HNC,HFF,HWW,HZZ,ZAB,HHB
42786 IF(IERROR.NE.0.OR..NOT.SUSYIN) RETURN
42787 C--four body Higgs modes via virtual WW and ZZ
42789 DO 1000 II=1,NMODES(JJ)
42796 IF((IH.EQ.1.OR.IH.EQ.2).AND.IDKPRD(3,I).EQ.0.AND.
42797 & IDKPRD(1,I).GE.198.AND.IDKPRD(1,I).LE.200.AND.
42798 & IDKPRD(2,I).GE.198.AND.IDKPRD(2,I).LE.200) THEN
42799 C--first the WW modes
42800 IF(IDKPRD(1,I).NE.200) THEN
42802 IF(N4MODE.GT.NMODE4) CALL HWWARN('HWISP4',100,*999)
42803 NME(I) = 40000+N4MODE
42805 I4MODE(1,N4MODE) = 198
42806 I4MODE(2,N4MODE) = 199
42808 A4MODE(1,K,N4MODE) = ZERO
42809 A4MODE(2,K,N4MODE) =-G*ORT
42810 B4MODE(1,K,N4MODE) = ZERO
42811 1 B4MODE(2,K,N4MODE) =-G*ORT
42812 C--now the prefactors
42814 COL(1) = HWW(IH)**2
42815 IF(J.LE.3) COL(1) = THREE*COL(1)
42818 IF(K.LE.3) COL(2) = THREE*COL(2)
42819 2 P4MODE(J,K,N4MODE) = COL(1)*COL(2)
42820 C--then the ZZ modes
42823 IF(N4MODE.GT.NMODE4) CALL HWWARN('HWISP4',101,*999)
42824 NME(I) = 40000+N4MODE
42826 I4MODE(1,N4MODE) = 200
42827 I4MODE(2,N4MODE) = 200
42831 A4MODE(1,K,N4MODE) =-E*RFCH(IL)
42832 A4MODE(2,K,N4MODE) =-E*LFCH(IL)
42833 B4MODE(1,K,N4MODE) =-E*RFCH(IL)
42834 3 B4MODE(2,K,N4MODE) =-E*LFCH(IL)
42836 COL(1) = HALF*HZZ(IH)**2
42837 IF(J.LE.6) COL(1)=THREE*COL(1)
42840 IF(K.LE.6) COL(2) = THREE
42841 4 P4MODE(J,K,N4MODE) = COL(1)*COL(2)
42845 C--compute the maximum weights
42846 IF(N4MODE.EQ.0) RETURN
42848 PHEP(5,1) = RMASS(IDK(ID4PRT(I)))
42849 PHEP(4,1) = SQRT(100.0D0**2+PHEP(5,1)**2)
42850 PHEP(1,1) = 100.0D0
42853 IF(IPRINT.EQ.2) WRITE(6,5010) RNAME(IDK(ID4PRT(I))),
42854 & RNAME(IDKPRD(1,ID4PRT(I))),RNAME(IDKPRD(2,ID4PRT(I)))
42856 IF(I4MODE(1,I).NE.200) IL = 6
42859 2000 CALL HWD4ME(1,J,K,I)
42861 5010 FORMAT(/'CALCULATING TWO BODY DECAY ',
42862 & A8,' --> ',A8,' ',A8/)
42865 *CMZ :- -12/10/01 09:41:43 by Peter Richardson
42866 *-- Author : Bryan Webber, modified by Kosuke Odagiri
42867 C-----------------------------------------------------------------------
42869 C-----------------------------------------------------------------------
42870 C Reads in SUSY particle properties and decays,
42871 C in format generated by ISAWIG
42872 C-----------------------------------------------------------------------
42873 INCLUDE 'HERWIG65.INC'
42874 INTEGER I,J,K,IH,IHW,NSSP,NDEC,MDKYS
42875 DOUBLE PRECISION BETAH, WEINCOS,WEINSIN, MW,MZ, RMMAX
42876 DOUBLE PRECISION FTM,FTMUU(4),FTMDD(4),FTMTT(4),FTMBB(4),FTMU,FTMD
42877 DOUBLE PRECISION YTM,YTM1,DTERM(4), SQHF,SNBCSB,MZSW2
42879 EQUIVALENCE (MW,RMASS(198)), (MZ,RMASS(200))
42888 C--reset susy input flag
42889 IF (LRSUSY.LT.0) CALL HWWARN('HWISSP',500,*999)
42892 C Input SUSY particle + top quark table
42895 9 FORMAT(//10X,A28//,
42896 & 10X,'Since SUSY processes are called,'
42897 & ,/, 10X,'please also reference: S.Moretti, K.Odagiri,'
42898 & ,/, 10X,'P.Richardson, M.H.Seymour & B.R.Webber,'
42899 & ,/, 10X,'JHEP 0204 (2002) 028')
42900 WRITE (6,10) LRSUSY
42901 10 FORMAT (/10X,'Reading in SUSY data from unit',I3)
42902 READ (LRSUSY,'(I4)') NSSP
42903 IF (NSSP.LE.0) RETURN
42904 RMMAX=SQRT(HALF*(EBEAM1*EBEAM2+PBEAM1*PBEAM2))
42907 READ (LRSUSY,1) IHW,RMASS(IHW),RLTIM(IHW)
42908 C Negative gaugino mass means physical field is gamma_5*psi
42910 IF ((IHW.GE.450).AND.(IHW.LE.457)) THEN
42911 IF (IHW.LE.453) THEN
42913 ZSGNSS(J)=RMASS(IHW)/ABS(RMASS(IHW))
42914 ELSEIF (IHW.LE.455) THEN
42916 WSGNSS(J)=RMASS(IHW)/ABS(RMASS(IHW))
42918 RMASS(IHW)=ABS(RMASS(IHW))
42920 IF (ABS(IDPDG(IHW)).GT.1000000.AND.(RMASS(IHW).NE.ZERO))
42921 & RMMNSS=MIN(RMMNSS,RMASS(IHW))
42922 IF (IHW.GT.NRES) THEN
42923 IF (IHW.GT.NMXRES) CALL HWWARN('HWISSP',501,*999)
42927 XLMNSS=TWO*LOG(RMMNSS/RMMAX)
42928 1 FORMAT(I5,F12.4,E15.5)
42930 C Input decay modes
42934 READ (LRSUSY,'(I4)') NDEC
42935 IF (NDEC.GT.0) THEN
42938 IF (NDKYS.GT.NMXDKS) CALL HWWARN('HWISSP',100,*999)
42939 READ (LRSUSY,11) IDK(NDKYS),BRFRAC(NDKYS),NME(NDKYS),
42940 & (IDKPRD(K,NDKYS),K=1,5)
42941 11 FORMAT(I6,F16.8,6I6)
42946 C Mixings and other SUSY parameters
42948 READ (LRSUSY,'(2F16.8)') TANB,ALPHAH
42950 READ (LRSUSY,13) ZMXNSS(I,1),ZMXNSS(I,2),ZMXNSS(I,3),ZMXNSS(I,4)
42952 WEINSIN = SQRT(SWEIN)
42953 WEINCOS = SQRT(1.-SWEIN)
42955 ZMIXSS(I,1) = WEINCOS*ZMXNSS(I,1)+WEINSIN*ZMXNSS(I,2)
42956 ZMIXSS(I,2) = -WEINSIN*ZMXNSS(I,1)+WEINCOS*ZMXNSS(I,2)
42957 ZMIXSS(I,3) = ZMXNSS(I,3)
42958 ZMIXSS(I,4) = ZMXNSS(I,4)
42961 IF ((J.LE.6).OR.(J.GE.11)) THEN
42962 C--left and right couplings now computed in HWIGIN
42964 SLFCH(J,I)= ZMIXSS(I,1)*QFCH(J)+ZMIXSS(I,2)*LFCH(J)
42965 SRFCH(J,I)=-ZMIXSS(I,1)*QFCH(J)-ZMIXSS(I,2)*RFCH(J)
42969 READ (LRSUSY,13) WMXVSS(1,1),WMXVSS(1,2), WMXVSS(2,1),WMXVSS(2,2)
42970 READ (LRSUSY,13) WMXUSS(1,1),WMXUSS(1,2), WMXUSS(2,1),WMXUSS(2,2)
42971 READ (LRSUSY,'(3F16.8)') THETAT,THETAB,THETAL
42972 READ (LRSUSY,'(3F16.8)') ATSS,ABSS,ALSS
42973 READ (LRSUSY,'( F16.8)') MUSS
42984 QMIXSS(6,1,1)= COS(THETAT)
42985 QMIXSS(6,1,2)= SIN(THETAT)
42986 QMIXSS(6,2,1)=-QMIXSS(6,1,2)
42987 QMIXSS(6,2,2)= QMIXSS(6,1,1)
42988 QMIXSS(5,1,1)= COS(THETAB)
42989 QMIXSS(5,1,2)= SIN(THETAB)
42990 QMIXSS(5,2,1)=-QMIXSS(5,1,2)
42991 QMIXSS(5,2,2)= QMIXSS(5,1,1)
42992 LMIXSS(5,1,1)= COS(THETAL)
42993 LMIXSS(5,1,2)= SIN(THETAL)
42994 LMIXSS(5,2,1)=-LMIXSS(5,1,2)
42995 LMIXSS(5,2,2)= LMIXSS(5,1,1)
42996 C--Evaluating Higgs parameters and couplings
42999 COSBPA=COS(BETAH+ALPHAH)
43000 SINBPA=SIN(BETAH+ALPHAH)
43001 COSBMA=COS(BETAH-ALPHAH)
43002 SINBMA=SIN(BETAH-ALPHAH)
43011 GHZZSS(I)=GHWWSS(I)
43013 GHDDSS(1)=-SINA/COSB
43014 GHDDSS(2)= COSA/COSB
43016 GHUUSS(1)= COSA/SINB
43017 GHUUSS(2)= SINA/SINB
43022 MZSW2 = MZ**2 * SQRT(SWEIN*(ONE-SWEIN))
43023 DTERM(1) =-SINBPA*MZSW2
43024 DTERM(2) = COSBPA*MZSW2
43026 FTMUU(1) = MUSS*SINA/SINB
43027 FTMUU(2) =-MUSS*COSA/SINB
43030 FTMTT(1) = ATSS*COSA/SINB
43031 FTMTT(2) = ATSS*SINA/SINB
43032 FTMTT(3) =-ATSS*COTB
43033 FTMTT(4) =-ATSS*COTB
43034 FTMDD(1) =-MUSS*COSA/COSB
43035 FTMDD(2) =-MUSS*SINA/COSB
43038 FTMBB(1) =-ABSS*SINA/COSB
43039 FTMBB(2) = ABSS*COSA/COSB
43040 FTMBB(3) =-ABSS*TANB
43041 FTMBB(4) =-ABSS*TANB
43046 IF (I.EQ.5) FTMU=FTMU+FTMTT(IH)
43047 IF (I.EQ.5) FTMD=FTMD+FTMBB(IH)
43048 IF (MOD(I,2).EQ.0) THEN
43056 GHSQSS(IH,I,1,1) = ZERO
43057 GHSQSS(IH,I,2,2) = ZERO
43058 GHSQSS(IH,I,1,2) = FTM*HALF*RMASS(I)/MW
43059 GHSQSS(IH,I,2,1) = - GHSQSS(IH,I,1,2)
43061 ELSEIF (IH.EQ.4) THEN
43066 IF (MOD(I,2).EQ.1) THEN
43067 GHSQSS(IH,I,J,K)=SQHF*(
43068 & RMASS(I )*FTMD*QMIXSS(I,2,J)*QMIXSS(I+1,1,K)
43069 & +RMASS(I+1)*FTMU*QMIXSS(I,1,J)*QMIXSS(I+1,2,K)
43070 & +( MW**2*TWO*SNBCSB-RMASS(I+1)**2*COTB
43071 & -RMASS(I )**2*TANB )*QMIXSS(I,1,J)*QMIXSS(I+1,1,K)
43072 & -RMASS(I)*RMASS(I+1)/SNBCSB
43073 & *QMIXSS(I,2,J)*QMIXSS(I+1,2,K) ) / MW
43075 GHSQSS(IH,I,J,K)=GHSQSS(IH,I-1,K,J)
43083 IF (J.EQ.K) YTM1=YTM*RMASS(I)**2
43084 GHSQSS(IH,I,J,K)=( YTM1
43085 & +( LFCH(I)*QMIXSS(I,1,J)*QMIXSS(I,1,K)
43086 & -RFCH(I)*QMIXSS(I,2,J)*QMIXSS(I,2,K) )*DTERM(IH)
43087 & +FTM*HALF*RMASS(I)*(QMIXSS(I,1,J)*QMIXSS(I,2,K)
43088 & +QMIXSS(I,2,J)*QMIXSS(I,1,K)) ) / MW
43094 C--Rparity violation
43095 READ (LRSUSY,'(L5)') RPARTY
43096 IF(.NOT.RPARTY) THEN
43097 READ(LRSUSY,20) (((LAMDA1(I,J,K),K=1,3),J=1,3),I=1,3)
43098 READ(LRSUSY,20) (((LAMDA2(I,J,K),K=1,3),J=1,3),I=1,3)
43099 READ(LRSUSY,20) (((LAMDA3(I,J,K),K=1,3),J=1,3),I=1,3)
43104 IF(FOURB) CALL HWIMDE
43107 *CMZ :- -04/05/99 14.28.59 by Bryan Webber
43108 *-- Author : Bryan Webber
43109 C-----------------------------------------------------------------------
43111 C-----------------------------------------------------------------------
43112 C IPROC = 1000,... ADDS SOFT UNDERLYING EVENT
43113 C = 8000: CREATES MINIMUM-BIAS EVENT
43114 C SUPPRESSED BY ADDING 10000 TO IPROC
43115 C-----------------------------------------------------------------------
43116 INCLUDE 'HERWIG65.INC'
43117 DOUBLE PRECISION HWREXP,ENFAC,TECM,SECM,SUMM,EMCL,BMP(5),BMR(3,3)
43118 INTEGER HWRINT,NETC,IBT,IDBT,ID1,ID2,ID3,KHEP,LHEP,NTRY,ICMS,
43119 & NPPBAR,MCHT,JCL,JD1,JD2,JD3,ICH,MODC,NCHT,INHEP(2),
43121 C--BRW FIX 30/12/04 FOR SPACE-TIME STRUCTURE
43122 C--RMS CLUSTER COORDINATES (GAUSSIAN) AND C*LIFETIME (IN MM)
43123 DOUBLE PRECISION VCLX,VCLY,VCLZ,VCLT,HWRGAU,HWRGEN
43124 DATA VCLX,VCLY,VCLZ,VCLT/4*1D-12/
43125 EXTERNAL HWREXP,HWRINT,HWRGAU,HWRGEN
43127 IF (IERROR.NE.0) RETURN
43128 IF (.NOT.GENSOF) GOTO 990
43129 IF (IPROC.EQ.8000) THEN
43130 C---SET UP BEAM AND TARGET CLUSTERS
43134 IF (JDAHEP(1,IBT).NE.0) JBT=JDAHEP(1,IBT)
43136 IF (IDBT.EQ.73.OR.IDBT.EQ.75) THEN
43137 INID(1,IBT)=HWRINT(1,2)
43139 ELSEIF (IDBT.EQ.91.OR.IDBT.EQ.93) THEN
43141 INID(2,IBT)=HWRINT(7,8)
43142 ELSEIF (IDBT.EQ.30) THEN
43143 INID(1,IBT)=HWRINT(1,2)
43145 ELSEIF (IDBT.EQ.38) THEN
43147 INID(2,IBT)=HWRINT(7,8)
43148 ELSEIF (IDBT.EQ.34) THEN
43150 INID(2,IBT)=HWRINT(7,8)
43151 ELSEIF (IDBT.EQ.46) THEN
43152 INID(1,IBT)=HWRINT(1,2)
43154 ELSEIF (IDBT.EQ.59) THEN
43155 INID(1,IBT)=HWRINT(1,2)
43156 INID(2,IBT)=HWRINT(7,8)
43158 CALL HWWARN('HWMEVT',100,*999)
43160 NETC=NETC+ICHRG(IDBT)
43161 & -(ICHRG(INID(1,IBT))+ICHRG(INID(2,IBT)))/3
43165 ISTHEP(NHEP+IBT)=163+IBT
43166 JMOHEP(1,NHEP+IBT)=JBT
43168 IF (NETC.EQ.0) THEN
43170 ELSEIF (NETC.EQ.-1) THEN
43172 ELSEIF (NETC.EQ.1) THEN
43180 IF (JDAHEP(1,IBT).NE.0) JBT=JDAHEP(1,IBT)
43181 CALL HWVEQU(5,PHEP(1,JBT),PHEP(1,NHEP))
43184 C---FIND BEAM AND TARGET CLUSTERS
43187 IF (ISTHEP(KHEP).EQ.163+IBT) THEN
43189 INID(1,IBT)=IDHW(JMOHEP(1,KHEP))
43190 INID(2,IBT)=IDHW(JMOHEP(2,KHEP))
43194 C---COULDN'T FIND ONE
43198 C---TEST FOR BOTH FOUND
43199 IF (INHEP(1).EQ.0) JCL=INHEP(2)
43200 IF (INHEP(2).EQ.0) JCL=INHEP(1)
43201 IF (JCL.EQ.0) CALL HWWARN('HWMEVT',101,*999)
43214 C---FIND SOFT CM MOMENTUM AND MULTIPLICITY
43217 IF (NHEP.GT.NMXHEP) CALL HWWARN('HWMEVT',102,*999)
43221 C--Bug Fix 31/03/00 PR
43222 JMOHEP(1,ICMS)=INHEP(1)
43223 JMOHEP(2,ICMS)=INHEP(2)
43226 CALL HWVSUM(4,PHEP(1,INHEP(1)),PHEP(1,INHEP(2)),PHEP(1,NHEP))
43227 CALL HWUMAS(PHEP(1,NHEP))
43229 IF (IPRO/10.EQ.9.OR.IPRO/10.EQ.5) THEN
43232 SECM=PHEP(5,3)*ENFAC
43234 C---CHOOSE MULTIPLICITY
43235 25 CALL HWMULT(SECM,NPPBAR)
43242 C---CREATE CLUSTERS
43245 IF (NHEP.GT.NMXHEP) CALL HWWARN('HWMEVT',103,*999)
43250 ISTHEP(JCL)=170+NCL
43255 IF (NCL.EQ.3) ID1=ID3
43261 CALL HWVZRO(3,PHEP(1,JCL))
43262 PHEP(4,JCL)=RMASS(ID1)+RMASS(ID2)+PMBM1+HWREXP(TWO/PMBM2)
43263 PHEP(5,JCL)=PHEP(4,JCL)
43264 C--BRW FIX 30/12/04 FOR SPACE-TIME STRUCTURE
43265 C--VERTEX POSITION FOR CLUSTER FORMATION
43266 VHEP(1,JCL)=HWRGAU(1,ZERO,VCLX)
43267 VHEP(2,JCL)=HWRGAU(2,ZERO,VCLY)
43268 VHEP(3,JCL)=HWRGAU(3,ZERO,VCLZ)
43269 VHEP(4,JCL)=SQRT(VHEP(1,JCL)**2+VHEP(2,JCL)**2+VHEP(3,JCL)**2)
43270 & -VCLT*LOG(HWRGEN(0))
43271 C--MHS FIX 07/03/05 - MEASURE DISPLACEMENTS RELATIVE TO SOFT CM
43272 CALL HWVZRO(4,VTXPIP)
43274 C---HADRONIZE AND DECAY CLUSTERS
43275 CALL HWCFLA(ID1,ID2,JD1,JD2)
43276 CALL HWCHAD(JCL,JD1,JD2,JD3)
43277 IF (IERROR.NE.0) RETURN
43279 EMCL=RMASS(IDHW(NHEP))
43280 IF (PHEP(4,JCL).NE.EMCL) THEN
43294 IF (IERROR.NE.0) RETURN
43295 C---CHECK CHARGED MULTIPLICITY
43297 DO 50 KHEP=JCL,NHEP
43298 IF (ISTHEP(KHEP).EQ.1) THEN
43299 ICH=ICHRG(IDHW(KHEP))
43307 NCHT=NPPBAR+NETC+ABS(MODC)
43309 ELSEIF (NCL.EQ.2) THEN
43310 NCHT=NCHT+ABS(MODC)
43311 IF (NCHT.LT.0) NCHT=NCHT+2
43313 IF (MCHT.LT.NCHT) THEN
43315 ELSEIF (MCHT.GT.NCHT) THEN
43316 IF (MOD(NTRY,50).EQ.0) GOTO 25
43317 IF (NTRY.LT.NSTRY) GOTO 30
43318 C---NO PHASE SPACE FOR SOFT EVENT
43320 IF (IPROC.EQ.8000) THEN
43321 C---MINIMUM BIAS: RELABEL BEAM AND TARGET CLUSTERS
43324 LHEP=JMOHEP(1,KHEP)
43326 IDHEP(KHEP)=IDHEP(LHEP)
43327 IDHW(KHEP)=IDHW(LHEP)
43330 C---UNDERLYING EVENT: DECAY THEM
43331 ISTHEP(INHEP(1))=163
43332 ISTHEP(INHEP(2))=163
43340 C---GENERATE CLUSTER MOMENTA IN CLUSTER CM
43341 C FRAME. N.B. SECOND CLUSTER IS TARGET
43342 IF (SUMM.GT.TECM) GOTO 25
43344 IF (NCL.EQ.0) GOTO 25
43346 C---ROTATE & BOOST CLUSTERS & DECAY PRODUCTS
43347 CALL HWULOF(PHEP(1,ICMS),PHEP(1,INHEP(1)),BMP)
43348 CALL HWUROT(BMP, ONE,ZERO,BMR)
43349 C---BMR PUTS BEAM ALONG Z AXIS (WE WANT INVERSE)
43350 DO 70 KHEP=ICMS+1,NHEP
43351 IF (ISTHEP(KHEP).GT.180.AND.ISTHEP(KHEP).LT.190
43352 $ .AND.JMOHEP(1,KHEP).EQ.ICMS) THEN
43353 ISTHEP(KHEP)=ISTHEP(KHEP)+3
43356 CALL HWUROB(BMR,PPCL(1,JCL),PPCL(1,JCL))
43357 CALL HWULOB(PHEP(1,ICMS),PPCL(1,JCL),PPCL(1,JCL))
43358 C---NOW PPCL(*,JCL) IS LAB MOMENTUM OF JTH CLUSTER
43360 CALL HWULOB(PPCL(1,JCL),PHEP(1,KHEP),PHEP(1,KHEP))
43361 C--BRW FIX 30/12/04 FOR SPACE-TIME STRUCTURE
43362 CALL HWULOB(PPCL(1,JCL),VHEP(1,KHEP),VHEP(1,KHEP))
43363 C--MHS FIX 07/03/05 - ASSUME THAT SOFT CM COINCIDES WITH PRIMARY IP
43364 IF (.NOT.(ISTHEP(KHEP).GT.180.AND.ISTHEP(KHEP).LT.190
43365 $ .AND.JMOHEP(1,KHEP).EQ.ICMS))
43366 $ CALL HWVSUM(4,VHEP(1,3),VHEP(1,KHEP),VHEP(1,KHEP))
43369 ISTHEP(INHEP(1))=167
43370 ISTHEP(INHEP(2))=168
43371 JDAHEP(1,INHEP(1))=ICMS
43372 JDAHEP(2,INHEP(1))=0
43373 JDAHEP(1,INHEP(2))=ICMS
43374 JDAHEP(2,INHEP(2))=0
43375 JDAHEP(1,ICMS)=ICMS+1
43376 JDAHEP(2,ICMS)=LHEP
43381 *CMZ :- -04/05/99 14.17.04 by Bryan Webber
43382 *-- Author : David Ward, modified by Bryan Webber
43383 C-----------------------------------------------------------------------
43384 SUBROUTINE HWMLPS(TECM)
43385 C-----------------------------------------------------------------------
43386 C GENERATES CYLINDRICAL PHASE SPACE USING THE METHOD OF JADACH
43387 C RETURNS WITH NCL=0 IF UNSUCCESSFUL
43388 C-----------------------------------------------------------------------
43389 INCLUDE 'HERWIG65.INC'
43390 DOUBLE PRECISION HWREXT,HWRUNG,HWUSQR,TECM,ESS,ALOGS,EPS,SUMX,
43391 & SUMY,PT,PX,PY,PT2,SUMPT2,SUMTM,XIMIN,XIMAX,YY,SUM1,SUM2,SUM3,
43392 & SUM4,EX,FY,DD,DYY,ZZ,E1,TM,SLOP,XI(NMXCL)
43393 INTEGER NTRY,I,NIT,IY(NMXCL),IDP
43394 EXTERNAL HWREXT,HWRUNG,HWUSQR
43395 IF (NCL.GT.NMXCL) THEN
43396 CALL HWWARN('HWMLPS',1,*999)
43404 IF (NTRY.GT.NSTRY) THEN
43411 C---Pt distribution of form exp(-b*Mt)
43412 C---Factors for pt slopes to fit data. IDCL contains the type of
43413 C q-qbar pair produced in this cluster (0 if 1-particle cluster).
43417 ELSEIF(IDP.EQ.3.OR.IDP.EQ.10) THEN
43419 ELSEIF(IDP.GT.3.AND.IDP.LE.9) THEN
43422 CALL HWWARN('HWMLPS',IDP,*999)
43425 PT=HWREXT(PPCL(5,I),SLOP)
43426 PT=HWUSQR(PT**2-PPCL(5,I)**2)
43427 CALL HWRAZM(PT,PX,PY)
43430 SUMX=SUMX+PPCL(1,I)
43431 12 SUMY=SUMY+PPCL(2,I)
43437 PPCL(1,I)=PPCL(1,I)-SUMX
43438 PPCL(2,I)=PPCL(2,I)-SUMY
43439 PT2=PPCL(1,I)**2+PPCL(2,I)**2
43441 C---STORE TRANSVERSE MASS IN PPCL(3,I) TEMPORARILY
43442 PPCL(3,I)=SQRT(PT2+PPCL(5,I)**2)
43443 13 SUMTM=SUMTM+PPCL(3,I)
43444 IF (SUMTM.GT.TECM) GOTO 11
43446 C---Form of "reduced rapidity" distribution
43447 XI(I)=HWRUNG(0.6*ONE,ONE)
43449 CALL HWUSOR(XI,NCL,IY,1)
43451 XIMAX=XI(NCL)-XI(1)
43452 C---N.B. TARGET CLUSTER IS SECOND
43455 XI(I+1)=(XI(I)-XIMIN)/XIMAX
43458 YY=LOG(ESS/(PPCL(3,1)*PPCL(3,2)))
43469 SUM3=SUM3+(TM*EX)*XI(I)
43470 19 SUM4=SUM4+(TM/EX)*XI(I)
43471 FY=ALOGS-LOG(SUM1*SUM2)
43472 DD=(SUM3*SUM2-SUM1*SUM4)/(SUM1*SUM2)
43474 IF(ABS(DYY/YY).LT.EPS) GOTO 20
43476 C---Y ITERATIONS EXCEEDED - TRY AGAIN
43477 IF (NTRY.LT.100) GOTO 11
43479 IF (EPS.GT.ONE) CALL HWWARN('HWMLPS',100,*999)
43480 CALL HWWARN('HWMLPS',50,*11)
43485 E1=EXP(ZZ+YY*XI(I))
43486 PPCL(3,I)=(0.5*TM)*((1./E1)-E1)
43487 PPCL(4,I)=(0.5*TM)*((1./E1)+E1)
43491 *CMZ :- -26/04/91 11.11.55 by Bryan Webber
43492 *-- Author : David Ward, modified by Bryan Webber
43493 C-----------------------------------------------------------------------
43494 FUNCTION HWMNBI(N,AVNCH,EK)
43495 C-----------------------------------------------------------------------
43496 C---Computes negative binomial probability
43497 C-----------------------------------------------------------------------
43498 DOUBLE PRECISION HWMNBI,AVNCH,EK,R
43504 HWMNBI=(1.+R)**(-EK)
43507 HWMNBI=HWMNBI*R*(EK+I-1)/I
43512 *CMZ :- -27/07/99 13.33.03 by Mike Seymour
43513 *-- Author : Ian Knowles
43514 C-----------------------------------------------------------------------
43515 SUBROUTINE HWMODK(IDKTMP,BRTMP,IMETMP,
43516 & IATMP,IBTMP,ICTMP,IDTMP,IETMP)
43517 C-----------------------------------------------------------------------
43518 C Takes the decay, IDKTMP -> I-(A+B+C+D+E)-TMP, and simply stores it
43519 C if internal pointers not set up (.NOT.DKPSET) else if pre-existing
43520 C mode updates branching ratio BRTMP and matrix element code IMETMP,
43521 C if -ve leaves as is. If a new mode adds to table and if consistent
43522 C adjusts pointers, sets CMMOM (for two-body mode) and resets RSTAB
43523 C if necessary. The branching ratios of any other IDKTMP decays are
43524 C scaled by (1.-BRTMP)/(1.-BR_OLD)
43525 C-----------------------------------------------------------------------
43526 INCLUDE 'HERWIG65.INC'
43527 DOUBLE PRECISION HWUPCM,BRTMP,SCALE,EPS
43528 INTEGER IDKTMP,IMETMP,IATMP,IBTMP,ICTMP,IDTMP,IETMP,IDKY,ITMP(5),
43533 PARAMETER (EPS=1.D-6)
43534 C Convert to internal format
43535 CALL HWUIDT(1,IDKTMP,IDKY,CDUM)
43536 IF (IDKY.EQ.20) THEN
43538 10 FORMAT(1X,'Particle decaying,',I7,', is not recognised')
43541 CALL HWUIDT(1,IATMP,ITMP(1),CDUM)
43542 CALL HWUIDT(1,IBTMP,ITMP(2),CDUM)
43543 CALL HWUIDT(1,ICTMP,ITMP(3),CDUM)
43544 CALL HWUIDT(1,IDTMP,ITMP(4),CDUM)
43545 CALL HWUIDT(1,IETMP,ITMP(5),CDUM)
43546 C If internal pointers not yet set up simply store decay
43547 IF (.NOT.DKPSET) THEN
43549 IF (NDKYS.GT.NMXDKS) CALL HWWARN('HWMODK',100,*999)
43551 BRFRAC(NDKYS)=BRTMP
43554 20 IDKPRD(I,NDKYS)=ITMP(I)
43556 IF (NMODES(IDKY).GT.0) THEN
43557 C First search to see if mode pre-exists
43558 IF ((ITMP(2).GE.1.AND.ITMP(2).LE.13).OR.
43559 & (ITMP(3).GE.1.AND.ITMP(3).LE.13)) THEN
43560 C Partonic respect order
43562 DO 30 K=1,NMODES(IDKY)
43563 IF (ITMP(1).EQ.IDKPRD(1,L).AND.
43564 & ITMP(2).EQ.IDKPRD(2,L).AND.
43565 & ITMP(3).EQ.IDKPRD(3,L).AND.
43566 & ITMP(4).EQ.IDKPRD(4,L).AND.
43567 & ITMP(5).EQ.IDKPRD(5,L)) GOTO 90
43570 C Allow for different order in matching
43572 DO 70 I=1,NMODES(IDKY)
43574 40 MATCH(J)=.FALSE.
43577 IF (.NOT.MATCH(K).AND.ITMP(K).EQ.IDKPRD(J,L)) THEN
43583 IF (MATCH(1).AND.MATCH(2).AND.MATCH(3).AND.
43584 & MATCH(4).AND.MATCH(5)) GOTO 90
43588 C A new mode put decay products in table
43590 IF (NDKYS.GT.NMXDKS) CALL HWWARN('HWMODK',101,*999)
43592 80 IDKPRD(I,NDKYS)=ITMP(I)
43593 C If decay consistent set up new pointers
43594 CALL HWDCHK(IDKY,NDKYS,*980)
43595 IF (NMODES(IDKY).EQ.0) THEN
43597 IF (RLTIM(IDKY).LT.PLTCUT.AND.RMASS(IDKY).NE.ZERO) THEN
43598 RSTAB(IDKY)=.FALSE.
43599 DKLTM(IDKY)=RLTIM(IDKY)*RMASS(IDKY)/HBAR
43606 NMODES(IDKY)=NMODES(IDKY)+1
43609 C Set CMMOM if two body decay
43610 IF (NPRODS(L).EQ.2) CMMOM(L)=
43611 & HWUPCM(RMASS(IDKY),RMASS(IDKPRD(1,L)),RMASS(IDKPRD(2,L)))
43612 C A Pre-existing mode, line L, add/update ME code and BR, scaling all
43613 C other branching fractions
43614 90 IF (IMETMP.GT.0) NME(L)=IMETMP
43615 IF (ABS(BRTMP-1.).LT.EPS) THEN
43616 C This modes dominant: eliminate others
43621 ELSEIF (ABS(BRTMP).LT.EPS) THEN
43622 C This mode insignificant: eliminate it
43623 IF (NMODES(IDKY).EQ.1) THEN
43628 LSTRT(IDKY)=LNEXT(J)
43631 DO 100 I=2,NMODES(IDKY)
43633 IF (J.EQ.L) LNEXT(JPREV)=LNEXT(J)
43636 C Rescale other modes
43637 SCALE=ONE/(ONE-BRFRAC(L))
43639 DO 110 I=1,NMODES(IDKY)-1
43640 BRFRAC(J)=SCALE*BRFRAC(J)
43643 NMODES(IDKY)=NMODES(IDKY)-1
43645 C Rescale all other modes
43646 IF (NMODES(IDKY).EQ.1) THEN
43649 IF (L.EQ.NDKYS) THEN
43652 SCALE=(ONE-BRTMP)/(ONE-BRFRAC(L))
43655 DO 120 I=1,NMODES(IDKY)
43656 IF (J.NE.L) BRFRAC(J)=SCALE*BRFRAC(J)
43664 990 FORMAT(1X,'Decay mode inconsistent, no modifications made')
43668 *CMZ :- -04/05/99 11.11.55 by Bryan Webber
43669 *-- Author : David Ward, modified by Bryan Webber
43670 C-----------------------------------------------------------------------
43671 SUBROUTINE HWMULT(EPPBAR,NCHT)
43672 C-----------------------------------------------------------------------
43673 C Chooses charged multiplicity NCHT at the p-pbar c.m. energy EPPBAR
43674 C-----------------------------------------------------------------------
43675 INCLUDE 'HERWIG65.INC'
43676 DOUBLE PRECISION HWMNBI,HWRGEN,EPPBAR,E0,ALOGS,RK,EK,AVN,SUM,R,
43678 INTEGER NCHT,IMAX,I,N
43680 EXTERNAL HWMNBI,HWRGEN
43682 IF (EPPBAR.NE.E0) THEN
43685 ALOGS=2.*LOG(EPPBAR)
43686 RK=PMBK1*ALOGS+PMBK2
43687 IF (ABS(RK).GT.1000.) RK=1000.
43689 AVN=PMBN1*EXP(PMBN2*ALOGS)+PMBN3
43690 IF (AVN.LT.ONE) AVN=1.
43695 CUM(I)=HWMNBI(N,AVN,EK)
43696 IF (CUM(I).LT.1D-7*SUM) GOTO 11
43702 IF (IMAX.LE.1) THEN
43705 ELSEIF (IMAX.EQ.500) THEN
43707 CALL HWWARN('HWMULT',101,*999)
43710 12 CUM(I)=CUM(I)/SUM
43716 IF(R.GT.CUM(I)) GOTO 20
43720 CALL HWWARN('HWMULT',100,*999)
43723 *CMZ :- -02/11/93 11.11.55 by Bryan Webber
43724 *-- Author : Bryan Webber
43725 C-----------------------------------------------------------------------
43727 C-----------------------------------------------------------------------
43728 C COMPUTES WEIGHT FOR MINIMUM-BIAS EVENT
43729 C-----------------------------------------------------------------------
43730 INCLUDE 'HERWIG65.INC'
43731 DOUBLE PRECISION S,X,Y
43732 INTEGER IDB,IDT,IDBT
43733 IF (IERROR.NE.0) RETURN
43735 IF (JDAHEP(1,1).NE.0) IDB=IDHW(JDAHEP(1,1))
43737 IF (JDAHEP(1,2).NE.0) IDT=IDHW(JDAHEP(1,2))
43739 IF (IDT.GT.IDB) IDBT=100*IDT+IDB
43740 C---USE TOTAL CROSS SECTION FITS OF DONNACHIE & LANDSHOFF
43742 IF (IDBT.EQ.9173) THEN
43745 ELSEIF (IDBT.EQ.7373) THEN
43748 ELSEIF (IDBT.EQ.7330) THEN
43751 ELSEIF (IDBT.EQ.7338) THEN
43754 ELSEIF (IDBT.EQ.7334) THEN
43757 ELSEIF (IDBT.EQ.7346) THEN
43760 ELSEIF (IDBT.EQ.7359) THEN
43763 ELSEIF (IDBT.EQ.9175) THEN
43766 ELSEIF (IDBT.EQ.7573) THEN
43769 ELSEIF (IDBT.EQ.5959) THEN
43770 C---FOR GAMMA-GAMMA ASSUME X AND Y FACTORIZE
43774 PRINT *,' IDBT=',IDBT
43775 CALL HWWARN('HWMWGT',100,*999)
43778 C---EVWGT IS NON-DIFFRACTIVE CROSS SECTION IN NANOBARNS
43779 C ASSUMING NON-DIFFRACTIVE = TOTAL*0.7
43780 EVWGT=.7E6*(X*S**.0808 + Y*S**(-.4525))
43783 *CMZ :- -11/08/03 15:30:25 by Peter Richardson
43784 *-- Author : Peter Richardson and Zbigniew Was
43785 C-----------------------------------------------------------------------
43786 SUBROUTINE HWPHTP(IHEP)
43787 C-----------------------------------------------------------------------
43788 C subroutine for radiation in top decays
43789 C-----------------------------------------------------------------------
43790 INCLUDE 'HERWIG65.INC'
43791 INTEGER IHEP,KK,IPOS,NN,NHEP0,KK1,KK2,JMOH(NMXHEP)
43792 DOUBLE PRECISION HWDPWT
43794 C--add an extra photon for top or W
43795 IF(IERROR.NE.0) RETURN
43796 IF(ABS(IDHEP(IHEP)).EQ.6.OR.ABS(IDHEP(IHEP)).EQ.24) THEN
43800 C--copy the colour mother infomation
43802 JMOH(KK)=JMOHEP(2,KK)
43808 C--reset the colour mother infomation
43810 JMOHEP(2,KK)=JMOH(KK)
43812 C--update the decaying particle
43813 JDAHEP(2,IHEP) = NHEP
43814 C--set up the additions photons in the record
43819 C--photon mass probably not needed
43820 PHEP(5,NHEP+1) = ZERO
43821 C--info on the photon
43822 ISTHEP(NHEP+1) = 114
43825 JMOHEP(1,NHEP+1) = IHEP
43826 JMOHEP(2,NHEP+1) = NHEP+1
43827 JDAHEP(2,NHEP+1) = NHEP+1
43834 *CMZ :- -11/08/03 15:30:25 by Peter Richardson
43835 *-- Author : Peter Richardson and Zbigniew Was
43836 C-----------------------------------------------------------------------
43838 C-----------------------------------------------------------------------
43839 C subroutine for radiation in top production
43840 C-----------------------------------------------------------------------
43841 INCLUDE 'HERWIG65.INC'
43843 INTEGER IMO(10),IFOUND,JMO(2),I,J,K,L,NSTART,NHEPX,NHEP0
43845 IF(IERROR.NE.0) RETURN
43850 C--loop to find mothers of any tops
43853 IF (ABS(IDHEP(I)).EQ.6) THEN
43855 IF(IMO(K).EQ.JMOHEP(1,I)) GOTO 10
43858 IMO(IFOUND)=JMOHEP(1,I)
43862 C--generate the radiation
43864 C--save the colour mother pointers
43865 JMO(1)=JMOHEP(2,JDAHEP(1,IMO(K)))
43866 JMO(2)=JMOHEP(2,1+JDAHEP(1,IMO(K)))
43867 C--zero the second mothers
43869 JMOHEP(2,JDAHEP(1,IMO(K)))=0
43870 JMOHEP(2,JDAHEP(2,IMO(K)))=0
43871 C--call photos to generate radiation
43872 CALL PHOTOS(IMO(K))
43875 IF(IDHEP(J).EQ.22) THEN
43881 C--reset the colour pointers
43882 JMOHEP(2, JDAHEP(1,IMO(K)))=JMO(1)
43883 JMOHEP(2,1+JDAHEP(1,IMO(K)))=JMO(2)
43884 C--setup the photons
43894 *CMZ :- -26/04/91 11.11.55 by Bryan Webber
43895 *-- Author : Bryan Webber
43896 C-----------------------------------------------------------------------
43897 SUBROUTINE HWRAZM(PT,PX,PY)
43898 C-----------------------------------------------------------------------
43899 C RANDOMLY ROTATED 2-VECTOR (PX,PY) OF LENGTH PT
43900 C-----------------------------------------------------------------------
43901 DOUBLE PRECISION HWRGEN,PT,PX,PY,C,S,CS,QT,ONE,ZERO
43902 PARAMETER(ONE=1.0D0, ZERO=0.0D0)
43904 10 C=2.*HWRGEN(1)-1.
43907 IF (CS.GT.ONE .OR. CS.EQ.ZERO) GOTO 10
43913 *CMZ :- -26/04/91 11.11.55 by Bryan Webber
43914 *-- Author : David Ward, modified by Bryan Webber
43915 C-----------------------------------------------------------------------
43916 FUNCTION HWREXP(AV)
43917 C-----------------------------------------------------------------------
43918 C Random number from dN/d(x**2)=exp(-b*x) with mean AV
43919 C-----------------------------------------------------------------------
43920 DOUBLE PRECISION HWREXP,HWRGEN,AV,B,R1,R2
43925 HWREXP=-LOG(R1*R2)/B
43928 *CMZ :- -02/06/94 11.02.47 by Mike Seymour
43929 *-- Author : David Ward, modified by Bryan Webber and Mike Seymour
43930 C-----------------------------------------------------------------------
43931 FUNCTION HWREXQ(AV,XMAX)
43932 C-----------------------------------------------------------------------
43933 C Random number from dN/d(x**2)=EXQ(-b*x) with mean AV,
43934 C But truncated at XMAX
43935 C-----------------------------------------------------------------------
43936 DOUBLE PRECISION HWREXQ,HWRGEN,AV,B,BXMAX,R1,R2,XMAX,R,RMIN
43940 IF (BXMAX.LT.50) THEN
43945 10 R1=HWRGEN(0)*(1-RMIN)+RMIN
43946 R2=HWRGEN(1)*(1-RMIN)+RMIN
43948 IF (R.LT.RMIN) GOTO 10
43952 *CMZ :- -26/04/91 11.11.55 by Bryan Webber
43953 *-- Author : David Ward, modified by Bryan Webber
43954 C-----------------------------------------------------------------------
43955 FUNCTION HWREXT(AM0,B)
43956 C-----------------------------------------------------------------------
43957 C Random number from dN/d(x**2)=exp(-B*TM) distribution, where
43958 C TM = SQRT(X**2+AM0**2). Uses Newton's method to solve F-R=0
43959 C-----------------------------------------------------------------------
43960 DOUBLE PRECISION HWREXT,HWRGEN,AM0,B,R,A,F,DF,DAM,AM
43964 C --- Starting value
43967 A=EXP(-B*(AM-AM0))/(1.+B*AM0)
43972 IF(AM.LT.AM0) AM=AM0+.001
43973 IF(ABS(DAM).LT..001) GOTO 2
43975 CALL HWWARN('HWREXT',1,*2)
43979 *CMZ :- -19/05/99 11.11.56 by Mike Seymour
43980 *-- Author : Mike Seymour
43981 C-----------------------------------------------------------------------
43982 FUNCTION HWRGAU(J,A,B)
43983 C-----------------------------------------------------------------------
43984 C Gaussian random number, mean A, standard deviation B.
43985 C Generates uncorrelated pairs and throws one of them away.
43986 C-----------------------------------------------------------------------
43987 INCLUDE 'HERWIG65.INC'
43988 DOUBLE PRECISION HWRGAU,HWRGEN,A,B,X,TRASH
43992 IF (X.LE.ZERO.OR.X.GT.ONE) GOTO 10
43993 X=SQRT(-TWO*LOG(X))
43994 CALL HWRAZM(X,X,TRASH)
43998 *CMZ :- -26/04/91 12.42.30 by Federico Carminati
43999 *-- Author : F. James, modified by Mike Seymour
44000 C-----------------------------------------------------------------------
44002 C-----------------------------------------------------------------------
44003 C MAIN RANDOM NUMBER GENERATOR
44004 C USES METHOD OF l'Ecuyer, (VIA F.JAMES, COMP PHYS COMM 60(1990)329)
44005 C-----------------------------------------------------------------------
44007 DOUBLE PRECISION HWRGEN,HWRSET,HWRGET
44008 INTEGER I,ISEED(2),K,IZ,JSEED(2)
44010 DATA ISEED/12345,67890/
44012 ISEED(1)=40014*(ISEED(1)-K*53668)-K*12211
44013 IF (ISEED(1).LT.0) ISEED(1)=ISEED(1)+2147483563
44015 ISEED(2)=40692*(ISEED(2)-K*52774)-K*3791
44016 IF (ISEED(2).LT.0) ISEED(2)=ISEED(2)+2147483399
44017 IZ=ISEED(1)-ISEED(2)
44018 IF (IZ.LT.1) IZ=IZ+2147483562
44019 HWRGEN=DBLE(IZ)*4.656613001013252D-10
44020 C---> (4.656613001013252D-10 = 1.D0/2147483589)
44022 C-----------------------------------------------------------------------
44023 ENTRY HWRSET(JSEED)
44024 C-----------------------------------------------------------------------
44026 IF (JSEED(1).EQ.0.OR.JSEED(2).EQ.0) CALL HWWARN('HWRSET',99,*999)
44030 C-----------------------------------------------------------------------
44031 ENTRY HWRGET(JSEED)
44032 C-----------------------------------------------------------------------
44039 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
44040 *-- Author : Bryan Webber
44041 C-----------------------------------------------------------------------
44042 FUNCTION HWRINT(IMIN,IMAX)
44043 C-----------------------------------------------------------------------
44044 C RANDOM INTEGER IN [IMIN,IMAX]. N.B. ASSUMES IMAX.GE.IMIN
44045 C-----------------------------------------------------------------------
44046 DOUBLE PRECISION HWRGEN,RN,ONE
44047 INTEGER HWRINT,IMIN,IMAX
44049 PARAMETER (ONE=1.0D0)
44051 IF (RN.EQ.ONE) GOTO 1
44052 RN=RN*(IMAX-IMIN+1)
44053 HWRINT=IMIN+INT(RN)
44056 *CMZ :- -26/04/91 14.15.56 by Federico Carminati
44057 *-- Author : Bryan Webber
44058 C-----------------------------------------------------------------------
44060 C-----------------------------------------------------------------------
44061 C Returns .TRUE. with probability A
44062 C-----------------------------------------------------------------------
44063 DOUBLE PRECISION HWRGEN,A,R
44068 IF(R.GT.A) HWRLOG=.FALSE.
44071 *CMZ :- -07/09/00 10:06:23 by Peter Richardson
44072 *-- Author : Ian Knowles
44073 C-----------------------------------------------------------------------
44075 C-----------------------------------------------------------------------
44076 C Generates a random primary IP using a triple Gaussian distribution
44077 C-----------------------------------------------------------------------
44078 INCLUDE 'HERWIG65.INC'
44079 DOUBLE PRECISION HWRGAU
44083 10 VTXPIP(I)=HWRGAU(I,ZERO,VIPWID(I))
44087 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
44088 *-- Author : Bryan Webber
44089 C-----------------------------------------------------------------------
44090 SUBROUTINE HWRPOW(XVAL,XJAC)
44091 C-----------------------------------------------------------------------
44092 C RETURNS XVAL DISTRIBUTED ON (XMIN,XMAX) LIKE XVAL**XPOW
44093 C AND CORRESPONDING JACOBIAN FACTOR XJAC
44094 C SET FIRST=.TRUE. IF NEW XMIN,XMAX OR XPOW
44095 C-----------------------------------------------------------------------
44096 DOUBLE PRECISION HWRGEN,XVAL,XJAC,XMIN,XMAX,XPOW,P,Q,A,B,C,Z,ZERO
44098 PARAMETER(ZERO=0.0D0)
44101 COMMON/HWRPIN/XMIN,XMAX,XPOW,FIRST
44104 IF (P.EQ.ZERO) CALL HWWARN('HWRPOW',500,*999)
44116 *CMZ :- -26/04/91 14.55.45 by Federico Carminati
44117 *-- Author : David Ward, modified by Bryan Webber
44118 C-----------------------------------------------------------------------
44119 FUNCTION HWRUNG(A,B)
44120 C-----------------------------------------------------------------------
44121 C Random number from distribution having flat top [-A,A] & gaussian
44123 C-----------------------------------------------------------------------
44124 DOUBLE PRECISION HWRUNG,HWRGAU,HWRUNI,A,B,PRUN,ZERO
44126 EXTERNAL HWRGAU,HWRUNI,HWRLOG
44127 PARAMETER (ZERO=0.D0)
44128 IF (A.EQ.ZERO) THEN
44131 PRUN=1./(1.+B*1.2533/A)
44133 IF(HWRLOG(PRUN)) THEN
44134 HWRUNG=HWRUNI(0,-A,A)
44136 HWRUNG=HWRGAU(0,ZERO,B)
44137 HWRUNG=HWRUNG+SIGN(A,HWRUNG)
44141 *CMZ :- -26/04/91 14.55.45 by Federico Carminati
44142 *-- Author : Bryan Webber
44143 C-----------------------------------------------------------------------
44144 FUNCTION HWRUNI(I,A,B)
44145 C-----------------------------------------------------------------------
44146 C Uniform random random number in range [A,B]
44147 C-----------------------------------------------------------------------
44148 DOUBLE PRECISION HWRUNI,HWRGEN,A,B,RN
44155 *CMZ :- -18/10/99 19.08.45 by Mike Seymour
44156 *-- Author : Bryan Webber
44157 C-----------------------------------------------------------------------
44158 SUBROUTINE HWSBRN(KPAR)
44159 C-----------------------------------------------------------------------
44160 C DOES BRANCHING OF SPACELIKE PARTON KPAR
44161 C-----------------------------------------------------------------------
44162 INCLUDE 'HERWIG65.INC'
44163 DOUBLE PRECISION HWBVMC,HWRGEN,HWRUNI,HWSTAB,HWUALF,HWUTAB,HWSGQQ,
44164 & HWSSUD,XLAST,QNOW,QLST,QP,QMIN,QLAM,QSAV,SMAX,SLST,SNOW,RN,SUDA,
44165 & SUDB,ZZ,ENOW,XI,PMOM,DIST(13),DMIN,X1,X2,REJFAC,OTHXI,OTHZ,QTMP,
44166 & PTMP(2),JAC,OTHJAC,S,T,U,EMB2,PTMX
44167 INTEGER N0,IS,ID,ID1,ID2,IDHAD,N1,I,MQ,NTRY,NDEL,NA,NB,IW1,IW2,
44168 & KPAR,LPAR,MPAR,ISUD(13),IREJ,NREJ
44169 LOGICAL HWSVAL,FORCE,VALPAR,FTMP
44170 EXTERNAL HWBVMC,HWRGEN,HWRUNI,HWSTAB,HWUALF,HWUTAB,HWSGQQ,HWSSUD,
44172 COMMON/HWTABC/XLAST,N0,IS,ID
44173 DATA ISUD,DMIN/2,2,3,4,5,6,2,2,3,4,5,6,1,1.D-15/
44174 IF (IERROR.NE.0) RETURN
44176 C--TEST FOR PARTON TYPE
44179 ELSEIF (ID.GE.208) THEN
44186 C--SPACELIKE PARTON BRANCHING
44191 XLAST=XFACT*PPAR(4,KPAR)
44192 IF (XLAST.GE.ONE) CALL HWWARN('HWSBRN',107,*999)
44193 C--SET UP Q BOUNDARY
44196 ELSEIF (ID.EQ.13) THEN
44199 QMIN=.5*(QP+QV+SQRT((QP-QV)**2+4.*QP*QV*XLAST))/(1.-XLAST)
44202 IF (QMIN.LE.QSPAC.AND.ISPAC.LT.2) THEN
44205 ELSEIF (QMIN.LE.QEV(1,IS)) THEN
44210 IF (QEV(I,IS).GT.QMIN) GOTO 120
44219 IF (QLST.GT.QMIN.AND..NOT.NOSPAC.OR..NOT.VALPAR) THEN
44220 IF (QLST.LE.QMIN) THEN
44221 C--CHECK PHASE SPACE FOR FORCED SPLITTING OF NON-VALENCE PARTON
44222 IF (QLST.LT.QSAV) CALL HWWARN('HWSBRN',ISLENT*105,*999)
44224 QNOW=(QLST/QSAV)**HWRGEN(0)*QSAV
44226 C--ENHANCE EMISSION BY A FACTOR OF TWO IF THIS BRANCH
44227 C IS CAPABLE OF BEING THE HARDEST SO FAR
44228 IF (QLST.GT.HARDST) NREJ=2
44231 C--FIND NEW VALUE OF SUD/DIST
44232 CALL HWSFUN(XLAST,QMIN,IDHAD,NSTRU,DIST,JNHAD)
44233 IF (ID.EQ.13) DIST(ID)=DIST(ID)*HWSGQQ(QMIN)
44234 IF (DIST(ID).LT.DMIN) DIST(ID)=DMIN
44235 SMAX=HWUTAB(SUD(N1,IS),QEV(N1,IS),MQ,QMIN,INTER)/DIST(ID)
44236 CALL HWSFUN(XLAST,QLST,IDHAD,NSTRU,DIST,JNHAD)
44237 IF (ID.EQ.13) DIST(ID)=DIST(ID)*HWSGQQ(QLST)
44238 IF (DIST(ID).LT.DMIN) DIST(ID)=DMIN
44239 SLST=HWUTAB(SUD(N1,IS),QEV(N1,IS),MQ,QLST,INTER)/DIST(ID)
44241 IF (RN.EQ.ZERO) THEN
44246 IF (VALPAR.AND.SNOW.GE.SMAX) GOTO 200
44247 IF (SNOW.LT.SMAX.AND..NOT.NOSPAC) THEN
44250 C--FORCE SPLITTING OF NON-VALENCE PARTON
44252 QNOW=(MIN(QLST,1.1*QMIN)/QSAV)**HWRGEN(0)*QSAV
44254 IF (QNOW.LT.ZERO) THEN
44255 C--BRANCHING OCCURS. FIRST CHECK FOR MONOTONIC FORM FACTOR
44260 IF (NB.GT.NQEV) CALL HWWARN('HWSBRN',103,*999)
44261 CALL HWSFUN(XLAST,QEV(NB,IS),IDHAD,NSTRU,DIST,JNHAD)
44262 IF (ID.EQ.13) DIST(ID)=DIST(ID)*HWSGQQ(QEV(NB,IS))
44263 IF (DIST(ID).LT.DMIN) DIST(ID)=DMIN
44264 SUDB=SUD(NB,IS)/DIST(ID)
44265 IF (SUDB.GT.SUDA) THEN
44269 ELSEIF (NA.NE.N1) THEN
44270 IF (SUDB.LT.SNOW) THEN
44272 IF (NDEL.EQ.0) CALL HWWARN('HWSBRN',100,*999)
44280 QNOW=HWSTAB(QEV(N1,IS),HWSSUD,MQ,SNOW,INTER)
44281 IF (QNOW.LE.QMIN.OR.QNOW.GT.QLST) THEN
44282 C--INTERPOLATION PROBLEM: USE LINEAR INSTEAD
44283 C CALL HWWARN('HWSBRN',1,*999)
44284 QNOW=HWRUNI(0,QMIN,QLST)
44288 IF (QNOW.GT.QTMP) THEN
44297 IF (QNOW.LT.ZERO) GOTO 210
44299 CALL HWSFBR(XLAST,QNOW,FORCE,ID,1,ID1,ID2,IW1,IW2,ZZ)
44301 C--NO PHASE SPACE FOR BRANCHING
44304 ELSEIF (ID1.EQ.0) THEN
44305 C--BRANCHING REJECTED: REDUCE Q AND REPEAT
44306 IF (NTRY.GT.NBTRY.OR.IERROR.NE.0)
44307 $ CALL HWWARN('HWSBRN',102,*999)
44311 ELSEIF (ID1.EQ.59) THEN
44312 C--ANOMALOUS PHOTON SPLITTING: ADD PT TO INTRINSIC PT AND STOP BRANCHING
44313 IF (IDHAD.NE.59) CALL HWWARN('HWSBRN',109,*999)
44314 ENOW=PPAR(4,KPAR)/XLAST
44316 QLAM=QNOW*(1.-XLAST)
44317 IF ((2.-XI)*QLAM**2.GT.EMSCA**2) THEN
44318 C--BRANCHING REJECTED: REDUCE Q AND REPEAT
44319 IF (NTRY.GT.NBTRY) CALL HWWARN('HWSBRN',110,*999)
44324 CALL HWRAZM(QNOW*(1.-XLAST),PTMP(1),PTMP(2))
44325 CALL HWVSUM(2,PTMP,PTINT(1,JNHAD),PTINT(1,JNHAD))
44326 PTINT(3,JNHAD)=PTINT(1,JNHAD)**2+PTINT(2,JNHAD)**2
44327 ANOMSC(1,JNHAD)=QNOW
44328 ANOMSC(2,JNHAD)=QNOW*(1.-XLAST)
44332 ELSEIF (FORCE.AND..NOT.HWSVAL(ID1).AND.ID1.NE.13) THEN
44333 C--FORCED BRANCHING PRODUCED A NON-VALENCE PARTON: TRY AGAIN
44334 IF (NTRY.GT.NBTRY) CALL HWWARN('HWSBRN',108,*999)
44341 IF (QNOW.GT.ZERO) THEN
44342 C--BRANCHING HAS OCCURRED
44343 ENOW=PPAR(4,KPAR)/ZZ
44346 IF ((SUDORD.EQ.1.AND.HWUALF(2,QLAM).LT.HWRGEN(0) .OR.
44347 & (2.-XI)*QLAM**2.GT.EMSCA**2).AND..NOT.FORCE) THEN
44348 C--BRANCHING REJECTED: REDUCE Q AND REPEAT
44349 IF (NTRY.GT.NBTRY) CALL HWWARN('HWSBRN',104,*999)
44354 C--IF THIS IS HARDEST EMISSION SO FAR, APPLY MATRIX-ELEMENT CORRECTION
44355 IF (.NOT.FORCE) THEN
44357 IF (QLAM.GT.HARDST .AND. ID.NE.13) THEN
44358 IF (MOD(ISTHEP(JCOPAR(1,1)),10).GE.3) THEN
44359 C---COLOUR PARTNER IS OUTGOING (X1=XP, X2=ZP)
44360 X2=SQRT((ZZ**2-(1-ZZ)*XI)**2+2*(ZZ*(1-ZZ))**2*XI*(2-XI))
44361 X1=(ZZ**2+(1-ZZ)*XI-X2)/(2*(1-ZZ)*XI)
44362 X2=(ZZ**2-(1-ZZ)*XI+X2)/(2*ZZ**2)
44363 IF (ID2.EQ.13) THEN
44365 REJFAC=ZZ**3*(1-X1-X2+2*X1*X2)
44366 $ /(X1**2*(1-ZZ)*(ZZ+XI*(1-ZZ)))
44367 $ *(1+ZZ**2)/((1-ZZ)*XI)
44369 $ (1+(1-X1-X2+2*X1*X2)**2+2*(1-X1)*(1-X2)*X1*X2)
44370 C---CHECK WHETHER IT IS IN THE OVERLAP REGION
44371 OTHXI=2*(1-X1)/(1-X1+2*(3*X1-2)*X2*(1-X2))
44372 IF (OTHXI.LT.ONE) THEN
44373 OTHZ=(1-(2*X2-1)*SQRT((3*X1-2)/X1))/2
44374 REJFAC=REJFAC+SQRT(3-2/X1)/(X1**2*OTHZ*(1-OTHZ))
44375 $ *(1+(1-OTHZ)**2)/(OTHZ*OTHXI)
44377 $ (1+(1-X1-X2+2*X1*X2)**2+2*(1-X1)*(1-X2)*X1*X2)
44379 ELSEIF (ID1.EQ.13) THEN
44380 C---GLUON SPLITTING
44381 REJFAC=ZZ**3*(1-X1-X2+2*X1*X2)
44382 $ /(X1**2*(1-ZZ)*(ZZ+XI*(1-ZZ)))
44383 $ *(ZZ**2+(1-ZZ)**2)/XI
44385 $ (( X1+X2-2*X1*X2)**2+2*(1-X1)*(1-X2)*X1*X2
44386 $ +(1-X1-X2+2*X1*X2)**2+2*(1-X1)*(1-X2)*X1*X2)
44389 C---COLOUR PARTNER IS ALSO INCOMING
44391 S=2*(ZZ**2+(1-ZZ)*XI)/(ZZ**2*(2*ZZ+XI*(1-ZZ)))
44393 JAC=-T*(1-T)/S**2*ZZ**5/(XI*(1-ZZ)**2*(ZZ+XI*(1-ZZ)))
44394 IF (ID2.EQ.13) THEN
44396 REJFAC=(1+ZZ**2)/((1-ZZ)*ZZ*XI)
44397 & *JAC*S**2*T*U/((1-U)**2+(1-T)**2)
44398 C---CHECK WHETHER IT IS IN THE OVERLAPPING REGION
44399 OTHZ=(1+SQRT(1-2*U*(1-U)/S))/U
44400 OTHXI=2*(1-OTHZ+T/S)/(1-OTHZ)
44401 IF (OTHXI.LT.OTHZ**2) THEN
44402 OTHJAC=-U*(1-U)/S**2*OTHZ**5/(OTHXI*
44403 & (1-OTHZ)**2*(OTHZ+OTHXI*(1-OTHZ)))
44404 REJFAC=REJFAC+(1+OTHZ**2)/((1-OTHZ)*OTHZ*OTHXI)
44405 & *OTHJAC*S**2*T*U/((1-U)**2+(1-T)**2)
44407 ELSEIF (ID1.EQ.13) THEN
44408 C---GLUON SPLITTING
44409 REJFAC=-((1-ZZ)**2+ZZ**2)/(ZZ*XI)
44410 & *JAC*S**3*T/((1-S)**2+(1-T)**2)
44414 IF (NREJ*REJFAC*HWRGEN(NREJ).GT.ONE) THEN
44419 IF (QLAM.GT.HARDST) HARDST=QLAM
44421 IF (IW2.GT.IW1) THEN
44424 C---NEW MOTHER-DAUGHTER RELATIONS
44425 C N.B. DEFINED MOVING AWAY FROM HARD PROCESS
44426 JDAPAR(1,KPAR)=LPAR
44427 JDAPAR(2,KPAR)=MPAR
44428 C---NEW COLOUR CONNECTIONS
44429 JCOPAR(3,KPAR)=MPAR
44430 JCOPAR(4,KPAR)=LPAR
44431 JCOPAR(1,MPAR)=KPAR
44432 JCOPAR(2,MPAR)=LPAR
44433 JCOPAR(1,LPAR)=MPAR
44434 JCOPAR(2,LPAR)=KPAR
44438 JDAPAR(1,KPAR)=MPAR
44439 JDAPAR(2,KPAR)=LPAR
44440 JCOPAR(3,KPAR)=LPAR
44441 JCOPAR(4,KPAR)=MPAR
44442 JCOPAR(1,MPAR)=LPAR
44443 JCOPAR(2,MPAR)=KPAR
44444 JCOPAR(1,LPAR)=KPAR
44445 JCOPAR(2,LPAR)=MPAR
44447 JMOPAR(1,LPAR)=KPAR
44448 JMOPAR(1,MPAR)=KPAR
44451 TMPAR(LPAR)=.FALSE.
44456 PPAR(1,MPAR)=QNOW*(1.-ZZ)
44458 PPAR(4,MPAR)=ENOW*(1.-ZZ)
44462 IF (QNOW.LT.ZERO) THEN
44469 C---PUT SPECTATOR (APPROXIMATELY) ON-SHELL
44470 XLAST=XFACT*PPAR(4,KPAR)
44471 IF ((1-XLAST)**2.LT.(RMASS(ID)**2+PTINT(3,JNHAD))*XFACT**2)
44476 C---BRW MOD: INCLUDE HIGHER ORDER CORRECTION IN MASS CALCULATION
44477 c$$$ PPAR(5,KPAR)=-(RMASS(ID)**2*XLAST+PTINT(3,JNHAD))/(1.-XLAST)
44478 c$$$ & +XLAST*SIGN(PHEP(5,INHAD)**2,PHEP(5,INHAD))
44479 PTMX=(RMASS(ID)**2+PTINT(3,JNHAD))/(ONE-XLAST)
44480 EMB2=SIGN(PHEP(5,INHAD)**2,PHEP(5,INHAD))
44481 PPAR(5,KPAR)=-PTINT(3,JNHAD)-XLAST*(PTMX-EMB2)-0.25D0*
44482 $ ((PTMX-EMB2)**2+XLAST*(PTMX**2/(ONE-XLAST)-EMB2**2))*XFACT**2
44484 ELSEIF (ID.EQ.IDHW(INHAD)) THEN
44485 C---IF INCOMING PARTON IS INCOMING BEAM, ALLOW IT TO BE OFF-SHELL
44486 PPAR(5,KPAR)=SIGN(PHEP(5,INHAD)**2,PHEP(5,INHAD))
44488 PPAR(5,KPAR)=RMASS(ID)**2
44490 PMOM=PPAR(4,KPAR)**2-PPAR(5,KPAR)
44491 IF (PMOM.LT.ZERO) THEN
44495 PPAR(3,KPAR)=SQRT(PMOM)
44499 *CMZ := =26/04/91 12.47.48 by Federico Carminati
44500 *-- Author : Drees, Grassie, Charchula, modified by Bryan Webber
44501 C ===============================================================
44502 C DREES & GRASSIE PARAMETRIZATION OF PHOTON STRUCTURE FUNCTION
44504 C HWSDGQ(X,Q2,NFL,NCH) - X*QUARK_IN_PHOTON/ALPHA (!)
44505 C HWSDGG(X,Q2,NFL) - X*GLUON_IN_PHOTON/ALPHA (!)
44507 C (INTEGER) NCH - QUARK CHARGE: 1 FOR 1/3
44509 C (INTEGER) NFL - NUMBER OF QUARK FLAVOURS /3 OR 4/
44510 C Q2 - SQUARE OF MOMENTUM Q /IN GEV2/
44511 C X - LONGITUDINAL FRACTION
44514 C NFL=3: 1 < Q2 < 50 GEV^2
44515 C NFL=4: 20 < Q2 < 500 GEV^2
44516 C NFL=5: 200 < Q2 < 10^4 GEV^2
44519 C KRZYSZTOF CHARCHULA /14.02.1989/
44520 C================================================================
44522 C PS. Note that for the case of three flavors, one has to add
44523 C the QPM charm contribution for getting F2.
44525 C================================================================
44526 C MODIFIED FOR HERWIG BY BRW 19/4/91
44527 C--- -----------------------------------------------
44528 C GLUON PART OF THE PHOTON SF
44529 C--- -----------------------------------------------
44530 FUNCTION HWSDGG(X,Q2,NFL)
44531 IMPLICIT REAL (A-H,P-Z)
44533 DIMENSION A(3,4,3),AT(3)
44536 C- --- CHECK WHETHER NFL HAVE RIGHT VALUES -----
44537 IF (.NOT.((NFL.EQ.3).OR.(NFL.EQ.4).OR.(NFL.EQ.5)))THEN
44539 131 FORMAT(' NUMBER OF FLAVOURS(NFL) HAS NOT BEEN SET TO: 3,4 OR 5;'/
44540 *' NFL=3 IS ASSUMED')
44542 ELSEIF (T.LE.0) THEN
44544 132 FORMAT(' HWSDGG CALLED WITH SCALE < LAMBDA. RETURNING ZERO.')
44548 C ------ INITIALIZATION OF PARAMETERS ARRAY -----
44549 DATA(((A(I,J,K),I=1,3),J=1,4),K=1,3)/
44550 + -0.20700,-0.19870, 5.11900,
44551 + 0.61580, 0.62570,-0.27520,
44552 + 1.07400, 8.35200,-6.99300,
44553 + 0.00000, 5.02400, 2.29800,
44554 + 0.8926E-2, 0.05090,-0.23130,
44555 + 0.659400, 0.27740, 0.13820,
44556 + 0.476600,-0.39060, 6.54200,
44557 + 0.019750,-0.32120, 0.51620,
44558 + 0.031970, -0.618E-2, -0.1216,
44559 + 1.0180, 0.94760, 0.90470,
44560 + 0.24610, -0.60940, 2.6530,
44561 + 0.027070, -0.010670, 0.2003E-2/
44562 C ------ Q2 DEPENDENCE -----------
44565 AT(I)=A(I,1,LF)*T**A(I,2,LF)+A(I,3,LF)*T**(-A(I,4,LF))
44567 C ------ GLUON DISTRIBUTION -------------
44568 HWSDGG=AT(1)*X**AT(2)*(1.0-X)**AT(3)/137.
44572 *CMZ :- -26/04/91 13.04.45 by Federico Carminati
44573 *-- Author : Drees, Grassie, Charchula, modified by Bryan Webber
44574 C --------------------------------------
44575 C QUARK PART OF THE PHOTON SF
44576 C --------------------------------------
44577 FUNCTION HWSDGQ(X,Q2,NFL,NCH)
44578 IMPLICIT REAL (A-H,P-Z)
44580 DIMENSION A(5,4,2,3),AT(5,2),XQPOM(2),E(2)
44582 C SQUARE OF LAMBDA=0.4 GEV
44586 C CHECK WHETHER NFL AND NCH HAVE RIGHT VALUES
44588 IF(.NOT.((NFL.EQ.3).OR.(NFL.EQ.4).OR.(NFL.EQ.5))) THEN
44590 111 FORMAT('NUMBER OF FLAVOURS (NFL) HAS NOT BEEN SET TO: 3,4 OR 5'/
44591 *' NFL=3 IS ASSUMED')
44593 ELSEIF (T.LE.0) THEN
44595 132 FORMAT(' HWSDGQ CALLED WITH SCALE < LAMBDA. RETURNING ZERO.')
44599 IF (.NOT.((NCH.EQ.1).OR.(NCH.EQ.2))) THEN
44601 121 FORMAT(' QUARK CHARGE NUMBER (NCH) HAS NOT BEEN SET',
44603 *' NCH=1 IS ASSUMED')
44606 C ------ INITIALIZATION ------
44607 DATA(((A(I,J,K,1),I=1,5),J=1,4),K=1,2)/
44608 + 2.28500, 6.07300, -0.42020,-0.08080, 0.05530,
44609 +-0.01530, -0.81320, 0.01780, 0.63460, 1.13600,
44610 + 1.3300E3,-41.3100, 0.92160, 1.20800, 0.95120,
44611 + 4.21900, 3.16500, 0.18000, 0.20300, 0.01160,
44612 +16.6900, 0.17600, -0.02080,-0.01680,-0.19860,
44613 +-0.79160, 0.04790, 0.3386E-2,1.35300, 1.10000,
44614 + 1.0990E3, 1.04700, 4.85300, 1.42600, 1.13600,
44615 + 4.42800, 0.02500, 0.84040, 1.23900,-0.27790/
44616 DATA(((A(I,J,K,2),I=1,5),J=1,4),K=1,2)/
44617 +-0.37110,-0.17170, 0.087660,-0.89150,-0.18160,
44618 + 1.06100, 0.78150, 0.021970, 0.28570, 0.58660,
44619 + 4.75800, 1.53500, 0.109600, 2.97300, 2.42100,
44620 +-0.01500, 0.7067E-2,0.204000, 0.11850, 0.40590,
44621 +-0.12070,25.00000,-0.012300,-0.09190, 0.020150,
44622 + 1.07100,-1.64800, 1.162000, 0.79120, 0.98690,
44623 + 1.97700,-0.015630,0.482400, 0.63970,-0.070360,
44624 +-0.8625E-2,6.43800,-0.011000, 2.32700, 0.016940/
44625 DATA(((A(I,J,K,3),I=1,5),J=1,4),K=1,2)/
44626 +15.80, 2.7420, 0.029170,-0.03420, -0.023020,
44627 +-0.94640, -0.73320, 0.046570, 0.71960, 0.92290,
44628 +-0.50, 0.71480, 0.17850, 0.73380, 0.58730,
44629 +-0.21180, 3.2870, 0.048110, 0.081390,-0.79E-4,
44630 + 6.7340, 59.880, -0.3226E-2,-0.03321, 0.10590,
44631 +-1.0080, -2.9830, 0.84320, 0.94750, 0.69540,
44632 +-0.085940, 4.480, 0.36160, -0.31980, -0.66630,
44633 + 0.076250, 0.96860, 0.1383E-2, 0.021320, 0.36830/
44635 C ------- EVALUATION OF PARAMETERS IN Q2 ---------
44640 ELSEIF (NFL.EQ.4) THEN
44643 ELSEIF (NFL.EQ.5) THEN
44649 ATP=A(I,1,J,LF)*T**A(I,2,J,LF)
44650 AT(I,J)=ATP+A(I,3,J,LF)*T**(-A(I,4,J,LF))
44654 POM1=X*(X*X+(1.0-X)**2)/(AT(1,J)-AT(2,J)*ALOG(1.0-X))
44655 POM2=AT(3,J)*X**AT(4,J)*(1.0-X)**AT(5,J)
44656 XQPOM(J)=E(J)*POM1+POM2
44658 C ------- QUARK DISTRIBUTIONS ----------
44662 HWSDGQ=1.0/6.0*(XQPOM(2)+9.0*XQPOM(1))
44663 ELSEIF(NCH.EQ.1) THEN
44664 HWSDGQ=1.0/6.0*(XQPOM(2)-9.0/2.0*XQPOM(1))
44666 F2=2.0/9.0*XQPOM(2)+XQPOM(1)
44667 ELSEIF (NFL.EQ.4) THEN
44669 HWSDGQ=1.0/8.0*(XQPOM(2)+6.0*XQPOM(1))
44670 ELSEIF(NCH.EQ.1) THEN
44671 HWSDGQ=1.0/8.0*(XQPOM(2)-6.0*XQPOM(1))
44673 F2=5.0/18.0*XQPOM(2)+XQPOM(1)
44674 ELSEIF (NFL.EQ.5) THEN
44676 HWSDGQ=1.0/10.0*(XQPOM(2)+15.0/2.0*XQPOM(1))
44677 ELSEIF(NCH.EQ.1) THEN
44678 HWSDGQ=1.0/10.0*(XQPOM(2)-5.0*XQPOM(1))
44680 F2=11.0/45.0*XQPOM(2)+XQPOM(1)
44686 *CMZ :- -15/07/92 14.08.45 by Mike Seymour
44687 *-- Author : Bryan Webber
44688 C-----------------------------------------------------------------------
44689 SUBROUTINE HWSFBR(X,QQ,FORCED,ID,IW,ID1,ID2,IW1,IW2,Z)
44690 C-----------------------------------------------------------------------
44691 C FINDS BRANCHING (ID1->ID+ID2) AND Z=X/X1 IN BACKWARD
44692 C EVOLUTION AT ENERGY FRACTION X AND SCALE QQ
44694 C FORCED=.TRUE. FORCES SPLITTING OF NON-VALENCE PARTON
44696 C IW,IW1,IW2 ARE COLOUR CONNECTION WORDS
44698 C ID1.LT.0 ON RETURN MEANS NO PHASE SPACE
44699 C ID1.EQ.0 ON RETURN FLAGS REJECTED BRANCHINGS
44700 C-----------------------------------------------------------------------
44701 INCLUDE 'HERWIG65.INC'
44702 DOUBLE PRECISION HWBVMC,HWRGEN,HWUALF,HWUAEM,QP,X,QQ,Z,WQG,WQV,
44703 & WQP,XQV,ZMIN,ZMAX,YMIN,YMAX,DELY,YY,PSUM,EZ,WQN,WR,ZR,WZ,ZZ,AZ,
44704 & PVAL,EY,DIST(13),PROB(13,100),PPHO
44705 INTEGER ID,IW,ID1,ID2,IW1,IW2,NZ,IDHAD,IP,IZ
44706 LOGICAL HWRLOG,HWSVAL,FORCED,NONF,NONV,PHOTPR
44707 EXTERNAL HWBVMC,HWRGEN,HWUALF,HWUAEM,HWRLOG,HWSVAL
44714 NONV=.NOT.HWSVAL(ID)
44716 5 IF (ID.EQ.13) THEN
44736 IF (ZMIN.GE.ZMAX) RETURN
44738 C---INTERPOLATION VARIABLE IS Y=LN(Z/(1-Z))
44739 YMIN=LOG(ZMIN/(1.-ZMIN))
44740 YMAX=LOG(ZMAX/(1.-ZMAX))
44742 NZ=MIN(INT(ZBINM*DELY)+1,NZBIN)
44743 DELY=(YMAX-YMIN)/FLOAT(NZ)
44747 C---SET UP TABLES FOR CHOOSING BRANCHING
44754 AZ=WZ*ZZ*HWUALF(5-2*SUDORD,MAX(WZ*QQ,QG))
44755 CALL HWSFUN(X*ZR,QQ,IDHAD,NSTRU,DIST,JNHAD)
44757 C---SPLITTING INTO QUARK
44759 10 PROB(IP,IZ)=PSUM
44760 IF (NONF) PSUM=PSUM+DIST(ID)*AZ*CFFAC*(1.+ZZ*ZZ)*WR
44762 20 PROB(IP,IZ)=PSUM
44763 PSUM=PSUM+DIST(13)*AZ*0.5*(ZZ*ZZ+WZ*WZ)
44766 C---SPLITTING INTO GLUON
44768 PSUM=PSUM+DIST(IP)*AZ*CFFAC*(1.+WZ*WZ)*ZR
44769 30 PROB(IP,IZ)=PSUM
44770 IF (NONF) PSUM=PSUM+DIST(13)*AZ*2.*CAFAC*(WZ*ZR+ZZ*WR+WZ*ZZ)
44774 50 PHOTPR=IDHAD.EQ.59.AND.ID.NE.13
44776 C---ALLOW ANOMALOUS PHOTON SPLITTING
44777 PPHO=ZMIN*HWUAEM(-QQ*QQ)*CAFAC*(ZMIN**2+(1.-ZMIN)**2)
44778 & *ICHRG(ID)**2/9D0
44779 IF (PPHO.GT.(PPHO+PSUM*DELY)*HWRGEN(2)) THEN
44780 C---ANOMALOUS PHOTON SPLITTING OCCURRED
44785 IF (PSUM.LE.ZERO) RETURN
44787 PVAL=PSUM*HWRGEN(0)
44789 IF (PROB(13,IZ).GT.PVAL) GOTO 70
44792 70 EY=EXP(YMIN+DELY*(FLOAT(IZ)-HWRGEN(1)))
44794 C---CHOOSE BRANCHING
44796 IF (PROB(IP,IZ).GT.PVAL) GOTO 90
44799 C---CHECK THAT Z IS INSIDE PHASE SPACE (RETURN IF NOT)
44803 IF ((NONV.AND.ZZ*WQP.LT.XQV).OR.ZZ.GT.WQG) THEN
44804 IF (PHOTPR) GOTO 50
44808 IF (ZZ.LT.XQV.OR.ZZ.GT.WQP) THEN
44809 IF (PHOTPR) GOTO 50
44815 IF (ZZ.LT.XQV.OR.ZZ.GT.WQG) RETURN
44816 ELSEIF (.NOT.HWSVAL(IP)) THEN
44817 WQN=1.-HWBVMC(IP)/QQ
44818 IF (ZZ*WQN.LT.XQV.OR.ZZ.GT.WQN) RETURN
44821 C---EVERYTHING OK: LABEL NEW BRANCHES
44827 IF (ID1.EQ.13) THEN
44833 ELSE IF (ID.NE.13) THEN
44834 IF (ID1.EQ.13) THEN
44842 IF (ID1.EQ.13) THEN
44843 IF (HWRLOG(HALF)) IW2=IW1
44844 ELSE IF (ID1.GT.6) THEN
44848 IF (IW2.EQ.IW1) IW1=IW1+1
44851 *CMZ :- -02/05/91 11.30.51 by Federico Carminati
44852 *-- Author : Miscellaneous, combined by Bryan Webber
44853 C-----------------------------------------------------------------------
44854 SUBROUTINE HWSFUN(XIN,SCALE,IDHAD,NSET,DIST,IBEAM)
44855 C-----------------------------------------------------------------------
44856 C NUCLEON AND PION STRUCTURE FUNCTIONS DIST=X*QRK(X,Q=SCALE)
44858 C IDHAD = TYPE OF HADRON:
44859 C 73=P 91=PBAR 75=N 93=NBAR 38=PI+ 30=PI- 59=PHOTON
44861 C NEW SPECIAL CODES:
44862 C 71=`REMNANT PHOTON' 72=`REMNANT NUCLEON'
44864 C NSET = STRUCTURE FUNCTION SET
44865 C = 1,2 FOR DUKE+OWENS SETS 1,2 (SOFT/HARD GLUE)
44866 C = 3,4 FOR EICHTEN ET AL SETS 1,2 (NUCLEON ONLY)
44867 C = 5 FOR OWENS SET 1.1 (PREPRINT FSU-HEP-910606)
44869 C FOR PHOTON DREES+GRASSIE IS USED
44871 C N.B. IF IBEAM.GT.0.AND.MODPDF(IBEAM).GE.0 THEN NSET IS
44872 C IGNORED AND CERN PDFLIB WITH AUTHOR GROUP=AUTPDF(IBEAM) AND
44873 C SET=MODPDF(IBEAM) IS USED. FOR COMPATABILITY WITH VERSIONS 3
44874 C AND EARLIER, AUTPDF SHOULD BE SET TO 'MODE'
44875 C NOTE THAT NO CONSISTENCY CHECK IS MADE, FOR EXAMPLE THAT THE
44876 C REQUESTED SET FOR A PHOTON IS ACTUALLY A PHOTON SET
44878 C IF (ISPAC.GT.0) SCALE IS REPLACED BY MAX(SCALE,QSPAC)
44880 C IF (X.LT.PDFX0) REPLACE X*F(X) BY PDFX0*F(PDFX0)*(X/PDFX0)**PDFPOW
44882 C FOR PHOTON, IF (PHOMAS.GT.0) THEN QUARK DISTRIBUTIONS ARE
44883 C SUPPRESSED BY LOG((Q**2+PHOMAS**2)/(P**2+PHOMAS**2))
44884 C L = -------------------------------------- ,
44885 C LOG((Q**2+PHOMAS**2)/( PHOMAS**2))
44886 C WHILE GLUON DISTRIBUTIONS ARE SUPPRESSED BY L**2,
44887 C WHERE Q=SCALE AND P=VIRTUALITY OF THE PHOTON
44889 C DUKE+OWENS = D.W.DUKE AND J.F.OWENS, PHYS. REV. D30 (1984) 49 (P/N)
44890 C + J.F.OWENS, PHYS. REV. D30 (1984) 943 (PI+/-)
44891 C WITH EXTRA SIGNIFICANT FIGURES VIA ED BERGER
44892 C WARNING....MOMENTUM SUM RULE BADLY VIOLATED ABOVE 1 TEV
44893 C DUKE+OWENS SETS 1,2 OBSOLETE. SET 1 UPDATED TO OWENS 1.1 (1991)
44894 C PION NOT RELIABLE ABOVE SCALE = 50 GEV
44896 C EICHTEN ET AL = E.EICHTEN,I.HINCHLIFFE,K.LANE AND C.QUIGG,
44897 C REV. MOD. PHYS. 56 (1984) 579
44898 C REVISED AS IN REV. MOD. PHYS. 58 (1986) 1065
44899 C RELIABLE RANGE : SQRT(5)GEV < SCALE < 10TEV, 1E-4 < X < 1
44901 C DREES+GRASSIE = M.DREES & K.GRASSIE, ZEIT. PHYS. C28 (1985) 451
44902 C MODIFIED IN M.DREES & C.S.KIM, DESY 91-039
44903 C AND C.S.KIM, DTP/91/16 FOR HEAVY QUARKS
44905 C FOR CERN PDFLIB DETAILS SEE PDFLIB DOC Q ON CERNVM OR
44906 C CERN_ROOT:[DOC]PDFLIB.TXT ON VXCERN
44907 C-----------------------------------------------------------------------
44908 C---BRW change 27/8/04: include Frixione's fix to reduce PDFSET calls
44909 C-----------------------------------------------------------------------
44910 INCLUDE 'HERWIG65.INC'
44911 DOUBLE PRECISION HWSGAM,X,SCALE,XOLD,QOLD,XMWN,QSCA,SS,SMIN,S,T,
44912 & TMIN,TMAX,VX,AA,VT,WT,UPV,DNV,SEA,STR,CHM,BTM,TOP,GLU,WX,XQSUM,
44913 & DMIN,TPMIN,TPMAX,DIST(13),G(2),Q0(5),QL(5),F(5),A(6,5),
44914 & B(3,6,5,4),XQ(6),TX(6),TT(6),TB(6),NEHLQ(8,2),CEHLQ(6,6,2,8,2),
44915 & BB(4,6,5),VAL(20),USEA,DSEA,TOTAL,SCALEF,FAC,TBMIN(2),TTMIN(2)
44916 DOUBLE PRECISION XIN,PDFFAC
44917 REAL HWSDGG,HWSDGQ,XSP,Q2,P2,W2,EMB2,EMC2,ALAM2,XPGA(-6:6),F2GM,
44918 & XPVMD,XPANL,XPANH,XPBEH,XPDIR
44919 COMMON/SASCOM/XPVMD(-6:6),XPANL(-6:6),XPANH(-6:6),XPBEH(-6:6),
44921 LOGICAL PDFWRX(2,2),PDFWRQ(2,2)
44922 DOUBLE PRECISION PDFXMN,PDFXMX,PDFQMN,PDFQMX
44923 COMMON /W50513/PDFXMN,PDFXMX,PDFQMN,PDFQMX
44924 INTEGER IDHAD,NSET,IBEAM,IOLD,NOLD,IP,I,J,K,NX,IT,IX,IFL,NFL,
44925 & MPDF,IHAD,ISET,IOP1,IOP2,IP2
44926 CHARACTER*20 PARM(20)
44927 CHARACTER*20 PARMSAVE
44928 DOUBLE PRECISION VALSAVE
44929 COMMON/HWSFSA/PARMSAVE
44930 COMMON/HWSFSB/VALSAVE
44931 EXTERNAL HWSGAM,HWSDGG,HWSDGQ
44932 SAVE QOLD,IOLD,NOLD,XOLD,SS,S,T,TMIN,TMAX,G,A,TX,TT,TB,IP,NX
44933 DATA PDFWRX,PDFWRQ/8*.TRUE./
44934 DATA (((B(I,J,K,1),I=1,3),J=1,6),K=1,5)/
44935 &3.D0,0.D0,0.D0,.419D0,.004383D0,-.007412D0,
44936 &3.46D0,.72432D0,-.065998D0,4.4D0,-4.8644D0,1.3274D0,
44938 &0.D0,0.D0,.763D0,-.23696D0,.025836D0,4.D0,.62664D0,-.019163D0,
44939 &0.D0,-.42068D0,.032809D0,6*0.D0,1.265D0,-1.1323D0,.29268D0,
44940 &0.D0,-.37162D0,-.028977D0,8.05D0,1.5877D0,-.15291D0,
44941 &0.D0,6.3059D0,-.27342D0,0.D0,-10.543D0,-3.1674D0,
44942 &0.D0,14.698D0,9.798D0,0.D0,.13479D0,-.074693D0,
44943 &-.0355D0,-.22237D0,-.057685D0,6.3494D0,3.2649D0,-.90945D0,
44944 &0.D0,-3.0331D0,1.5042D0,0.D0,17.431D0,-11.255D0,
44945 &0.D0,-17.861D0,15.571D0,1.564D0,-1.7112D0,.63751D0,
44946 &0.D0,-.94892D0,.32505D0,6.D0,1.4345D0,-1.0485D0,
44947 &9.D0,-7.1858D0,.25494D0,0.D0,-16.457D0,10.947D0,
44948 &0.D0,15.261D0,-10.085D0/
44949 DATA (((B(I,J,K,2),I=1,3),J=1,6),K=1,5)/
44950 &3.D0,0.D0,0.D0,.3743D0,.013946D0,-.00031695D0,
44951 &3.329D0,.75343D0,-.076125D0,6.032D0,-6.2153D0,1.5561D0,
44953 &0.D0,.7608D0,-.2317D0,.023232D0,3.83D0,.62746D0,-.019155D0,
44954 &0.D0,-.41843D0,.035972D0,6*0.D0,1.6714D0,-1.9168D0,.58175D0,
44955 &0.D0,-.27307D0,-.16392D0,9.145D0,.53045D0,-.76271D0,
44956 &0.D0,15.665D0,-2.8341D0,0.D0,-100.63D0,44.658D0,
44957 &0.D0,223.24D0,-116.76D0,0.D0,.067368D0,-.030574D0,
44958 &-.11989D0,-.23293D0,-.023273D0,3.5087D0,3.6554D0,-.45313D0,
44959 &0.D0,-.47369D0,.35793D0,0.D0,9.5041D0,-5.4303D0,
44960 &0.D0,-16.563D0,15.524D0,.8789D0,-.97093D0,.43388D0,
44961 &0.D0,-1.1612D0,.4759D0,4.D0,1.2271D0,-.25369D0,
44962 &9.D0,-5.6354D0,-.81747D0,0.D0,-7.5438D0,5.5034D0,
44963 &0.D0,-.59649D0,.12611D0/
44964 DATA (((B(I,J,K,3),I=1,3),J=1,6),K=1,5)/
44965 &1.D0,0.D0,0.D0,0.4D0,-0.06212D0,-0.007109D0,0.7D0,0.6478D0,
44966 &0.01335D0,27*0.D0,0.9D0,-0.2428D0,0.1386D0,0.D0,-0.2120D0,
44967 &0.003671D0,5.0D0,0.8673D0,0.04747D0,
44968 &0.D0,1.266D0,-2.215D0,0.D0,2.382D0,0.3482D0,3*0.D0,
44969 &0.D0,0.07928D0,-0.06134D0,-0.02212D0,-0.3785D0,-0.1088D0,2.894D0,
44971 &-10.852D0,0.D0,5.248D0,-7.187D0,0.D0,8.388D0,-11.61D0,3*0.D0,
44972 &0.888D0,-1.802D0,1.812D0,0.D0,-1.576D0,1.20D0,3.11D0,-0.1317D0,
44973 &0.5068D0,6.0D0,2.801D0,-12.16D0,0.D0,-17.28D0,20.49D0,3*0.D0/
44974 DATA (((B(I,J,K,4),I=1,3),J=1,6),K=1,5)/
44975 &1.D0,0.D0,0.D0,0.4D0,-0.05909D0,-0.006524D0,0.628D0,0.6436D0,
44976 &0.01451D0,27*0.D0,
44977 &0.90D0,-0.1417D0,-0.1740D0,0.D0,-0.1697D0,-0.09623D0,5.0D0,
44979 &0.D0,-2.534D0,1.378D0,0.D0,0.5621D0,-0.2701D0,3*0.D0,
44980 &0.D0,0.06229D0,-0.04099D0,-0.0882D0,-0.2892D0,-0.1082D0,1.924D0,
44982 &2.036D0,0.D0,-4.463D0,5.209D0,0.D0,-0.8367D0,-0.04840D0,3*0.D0,
44983 &0.794D0,-0.9144D0,0.5966D0,0.D0,-1.237D0,0.6582D0,2.89D0,0.5966D0,
44985 &6.0D0,-3.671D0,-2.304D0,0.D0,-8.191D0,7.758D0,3*0.D0/
44986 C---COEFFTS FOR NEW OWENS 1.1 SET
44987 DATA BB/3.D0,3*0.D0,.665D0,-.1097D0,-.002442D0,0.D0,
44988 &3.614D0,.8395D0,-.02186D0,0.D0,.8673D0,-1.6637D0,.342D0,0.D0,
44989 &0.D0,1.1049D0,-.2369D0,5*0.D0,1.D0,3*0.D0,
44990 &.8388D0,-.2092D0,.02657D0,0.D0,4.667D0,.7951D0,.1081D0,0.D0,
44991 &0.D0,-1.0232D0,.05799D0,0.D0,0.D0,.8616D0,.153D0,5*0.D0,
44992 &.909D0,-.4023D0,.006305D0,0.D0,
44993 &0.D0,-.3823D0,.02766D0,0.D0,7.278D0,-.7904D0,.8108D0,0.D0,
44994 &0.D0,-1.6629D0,.5719D0,0.D0,0.D0,-.01333D0,.5299D0,0.D0,
44995 &0.D0,.1211D0,-.1739D0,0.D0,0.D0,.09469D0,-.07066D0,.01236D0,
44996 &-.1447D0,-.402D0,.1533D0,-.06479D0,6.7599D0,1.6596D0,.6798D0,
44997 &-.8525D0,0.D0,-4.4559D0,3.3756D0,-.9468D0,
44998 &0.D0,7.862D0,-3.6591D0,.03672D0,0.D0,-.2472D0,-.751D0,.0487D0,
44999 &3.017D0,-4.7347D0,3.3594D0,-.9443D0,0.D0,-.9342D0,.5454D0,
45001 &5.304D0,1.4654D0,-1.4292D0,.7569D0,0.D0,-3.9141D0,2.8445D0,
45003 &0.D0,9.0176D0,-10.426D0,4.0983D0,0.D0,-5.9602D0,7.515D0,-2.7329D0/
45004 C...THE FOLLOWING DATA LINES ARE COEFFICIENTS NEEDED IN THE
45005 C...EICHTEN, HINCHLIFFE, LANE, QUIGG PROTON STRUCTURE FUNCTION
45006 C...POWERS OF 1-X IN DIFFERENT CASES
45007 DATA NEHLQ/3,4,7,5,7,7,7,7,3,4,7,6,7,7,7,7/
45008 C...EXPANSION COEFFICIENTS FOR UP VALENCE QUARK DISTRIBUTION
45009 DATA (((CEHLQ(IX,IT,NX,1,1),IX=1,6),IT=1,6),NX=1,2)/
45010 1 7.677D-01,-2.087D-01,-3.303D-01,-2.517D-02,-1.570D-02,-1.000D-04,
45011 2-5.326D-01,-2.661D-01, 3.201D-01, 1.192D-01, 2.434D-02, 7.620D-03,
45012 3 2.162D-01, 1.881D-01,-8.375D-02,-6.515D-02,-1.743D-02,-5.040D-03,
45013 4-9.211D-02,-9.952D-02, 1.373D-02, 2.506D-02, 8.770D-03, 2.550D-03,
45014 5 3.670D-02, 4.409D-02, 9.600D-04,-7.960D-03,-3.420D-03,-1.050D-03,
45015 6-1.549D-02,-2.026D-02,-3.060D-03, 2.220D-03, 1.240D-03, 4.100D-04,
45016 1 2.395D-01, 2.905D-01, 9.778D-02, 2.149D-02, 3.440D-03, 5.000D-04,
45017 2 1.751D-02,-6.090D-03,-2.687D-02,-1.916D-02,-7.970D-03,-2.750D-03,
45018 3-5.760D-03,-5.040D-03, 1.080D-03, 2.490D-03, 1.530D-03, 7.500D-04,
45019 4 1.740D-03, 1.960D-03, 3.000D-04,-3.400D-04,-2.900D-04,-1.800D-04,
45020 5-5.300D-04,-6.400D-04,-1.700D-04, 4.000D-05, 6.000D-05, 4.000D-05,
45021 6 1.700D-04, 2.200D-04, 8.000D-05, 1.000D-05,-1.000D-05,-1.000D-05/
45022 DATA (((CEHLQ(IX,IT,NX,1,2),IX=1,6),IT=1,6),NX=1,2)/
45023 1 7.237D-01,-2.189D-01,-2.995D-01,-1.909D-02,-1.477D-02, 2.500D-04,
45024 2-5.314D-01,-2.425D-01, 3.283D-01, 1.119D-01, 2.223D-02, 7.070D-03,
45025 3 2.289D-01, 1.890D-01,-9.859D-02,-6.900D-02,-1.747D-02,-5.080D-03,
45026 4-1.041D-01,-1.084D-01, 2.108D-02, 2.975D-02, 9.830D-03, 2.830D-03,
45027 5 4.394D-02, 5.116D-02,-1.410D-03,-1.055D-02,-4.230D-03,-1.270D-03,
45028 6-1.991D-02,-2.539D-02,-2.780D-03, 3.430D-03, 1.720D-03, 5.500D-04,
45029 1 2.410D-01, 2.884D-01, 9.369D-02, 1.900D-02, 2.530D-03, 2.400D-04,
45030 2 1.765D-02,-9.220D-03,-3.037D-02,-2.085D-02,-8.440D-03,-2.810D-03,
45031 3-6.450D-03,-5.260D-03, 1.720D-03, 3.110D-03, 1.830D-03, 8.700D-04,
45032 4 2.120D-03, 2.320D-03, 2.600D-04,-4.900D-04,-3.900D-04,-2.300D-04,
45033 5-6.900D-04,-8.200D-04,-2.000D-04, 7.000D-05, 9.000D-05, 6.000D-05,
45034 6 2.400D-04, 3.100D-04, 1.100D-04, 0.000D+00,-2.000D-05,-2.000D-05/
45035 C...EXPANSION COEFFICIENTS FOR DOWN VALENCE QUARK DISTRIBUTION
45036 DATA (((CEHLQ(IX,IT,NX,2,1),IX=1,6),IT=1,6),NX=1,2)/
45037 1 3.813D-01,-8.090D-02,-1.634D-01,-2.185D-02,-8.430D-03,-6.200D-04,
45038 2-2.948D-01,-1.435D-01, 1.665D-01, 6.638D-02, 1.473D-02, 4.080D-03,
45039 3 1.252D-01, 1.042D-01,-4.722D-02,-3.683D-02,-1.038D-02,-2.860D-03,
45040 4-5.478D-02,-5.678D-02, 8.900D-03, 1.484D-02, 5.340D-03, 1.520D-03,
45041 5 2.220D-02, 2.567D-02,-3.000D-05,-4.970D-03,-2.160D-03,-6.500D-04,
45042 6-9.530D-03,-1.204D-02,-1.510D-03, 1.510D-03, 8.300D-04, 2.700D-04,
45043 1 1.261D-01, 1.354D-01, 3.958D-02, 8.240D-03, 1.660D-03, 4.500D-04,
45044 2 3.890D-03,-1.159D-02,-1.625D-02,-9.610D-03,-3.710D-03,-1.260D-03,
45045 3-1.910D-03,-5.600D-04, 1.590D-03, 1.590D-03, 8.400D-04, 3.900D-04,
45046 4 6.400D-04, 4.900D-04,-1.500D-04,-2.900D-04,-1.800D-04,-1.000D-04,
45047 5-2.000D-04,-1.900D-04, 0.000D+00, 6.000D-05, 4.000D-05, 3.000D-05,
45048 6 7.000D-05, 8.000D-05, 2.000D-05,-1.000D-05,-1.000D-05,-1.000D-05/
45049 DATA (((CEHLQ(IX,IT,NX,2,2),IX=1,6),IT=1,6),NX=1,2)/
45050 1 3.578D-01,-8.622D-02,-1.480D-01,-1.840D-02,-7.820D-03,-4.500D-04,
45051 2-2.925D-01,-1.304D-01, 1.696D-01, 6.243D-02, 1.353D-02, 3.750D-03,
45052 3 1.318D-01, 1.041D-01,-5.486D-02,-3.872D-02,-1.038D-02,-2.850D-03,
45053 4-6.162D-02,-6.143D-02, 1.303D-02, 1.740D-02, 5.940D-03, 1.670D-03,
45054 5 2.643D-02, 2.957D-02,-1.490D-03,-6.450D-03,-2.630D-03,-7.700D-04,
45055 6-1.218D-02,-1.497D-02,-1.260D-03, 2.240D-03, 1.120D-03, 3.500D-04,
45056 1 1.263D-01, 1.334D-01, 3.732D-02, 7.070D-03, 1.260D-03, 3.400D-04,
45057 2 3.660D-03,-1.357D-02,-1.795D-02,-1.031D-02,-3.880D-03,-1.280D-03,
45058 3-2.100D-03,-3.600D-04, 2.050D-03, 1.920D-03, 9.800D-04, 4.400D-04,
45059 4 7.700D-04, 5.400D-04,-2.400D-04,-3.900D-04,-2.400D-04,-1.300D-04,
45060 5-2.600D-04,-2.300D-04, 2.000D-05, 9.000D-05, 6.000D-05, 4.000D-05,
45061 6 9.000D-05, 1.000D-04, 2.000D-05,-2.000D-05,-2.000D-05,-1.000D-05/
45062 C...EXPANSION COEFFICIENTS FOR UP AND DOWN SEA QUARK DISTRIBUTIONS
45063 DATA (((CEHLQ(IX,IT,NX,3,1),IX=1,6),IT=1,6),NX=1,2)/
45064 1 6.870D-02,-6.861D-02, 2.973D-02,-5.400D-03, 3.780D-03,-9.700D-04,
45065 2-1.802D-02, 1.400D-04, 6.490D-03,-8.540D-03, 1.220D-03,-1.750D-03,
45066 3-4.650D-03, 1.480D-03,-5.930D-03, 6.000D-04,-1.030D-03,-8.000D-05,
45067 4 6.440D-03, 2.570D-03, 2.830D-03, 1.150D-03, 7.100D-04, 3.300D-04,
45068 5-3.930D-03,-2.540D-03,-1.160D-03,-7.700D-04,-3.600D-04,-1.900D-04,
45069 6 2.340D-03, 1.930D-03, 5.300D-04, 3.700D-04, 1.600D-04, 9.000D-05,
45070 1 1.014D+00,-1.106D+00, 3.374D-01,-7.444D-02, 8.850D-03,-8.700D-04,
45071 2 9.233D-01,-1.285D+00, 4.475D-01,-9.786D-02, 1.419D-02,-1.120D-03,
45072 3 4.888D-02,-1.271D-01, 8.606D-02,-2.608D-02, 4.780D-03,-6.000D-04,
45073 4-2.691D-02, 4.887D-02,-1.771D-02, 1.620D-03, 2.500D-04,-6.000D-05,
45074 5 7.040D-03,-1.113D-02, 1.590D-03, 7.000D-04,-2.000D-04, 0.000D+00,
45075 6-1.710D-03, 2.290D-03, 3.800D-04,-3.500D-04, 4.000D-05, 1.000D-05/
45076 DATA (((CEHLQ(IX,IT,NX,3,2),IX=1,6),IT=1,6),NX=1,2)/
45077 1 1.008D-01,-7.100D-02, 1.973D-02,-5.710D-03, 2.930D-03,-9.900D-04,
45078 2-5.271D-02,-1.823D-02, 1.792D-02,-6.580D-03, 1.750D-03,-1.550D-03,
45079 3 1.220D-02, 1.763D-02,-8.690D-03,-8.800D-04,-1.160D-03,-2.100D-04,
45080 4-1.190D-03,-7.180D-03, 2.360D-03, 1.890D-03, 7.700D-04, 4.100D-04,
45081 5-9.100D-04, 2.040D-03,-3.100D-04,-1.050D-03,-4.000D-04,-2.400D-04,
45082 6 1.190D-03,-1.700D-04,-2.000D-04, 4.200D-04, 1.700D-04, 1.000D-04,
45083 1 1.081D+00,-1.189D+00, 3.868D-01,-8.617D-02, 1.115D-02,-1.180D-03,
45084 2 9.917D-01,-1.396D+00, 4.998D-01,-1.159D-01, 1.674D-02,-1.720D-03,
45085 3 5.099D-02,-1.338D-01, 9.173D-02,-2.885D-02, 5.890D-03,-6.500D-04,
45086 4-3.178D-02, 5.703D-02,-2.070D-02, 2.440D-03, 1.100D-04,-9.000D-05,
45087 5 8.970D-03,-1.392D-02, 2.050D-03, 6.500D-04,-2.300D-04, 2.000D-05,
45088 6-2.340D-03, 3.010D-03, 5.000D-04,-3.900D-04, 6.000D-05, 1.000D-05/
45089 C...EXPANSION COEFFICIENTS FOR GLUON DISTRIBUTION
45090 DATA (((CEHLQ(IX,IT,NX,4,1),IX=1,6),IT=1,6),NX=1,2)/
45091 1 9.482D-01,-9.578D-01, 1.009D-01,-1.051D-01, 3.456D-02,-3.054D-02,
45092 2-9.627D-01, 5.379D-01, 3.368D-01,-9.525D-02, 1.488D-02,-2.051D-02,
45093 3 4.300D-01,-8.306D-02,-3.372D-01, 4.902D-02,-9.160D-03, 1.041D-02,
45094 4-1.925D-01,-1.790D-02, 2.183D-01, 7.490D-03, 4.140D-03,-1.860D-03,
45095 5 8.183D-02, 1.926D-02,-1.072D-01,-1.944D-02,-2.770D-03,-5.200D-04,
45096 6-3.884D-02,-1.234D-02, 5.410D-02, 1.879D-02, 3.350D-03, 1.040D-03,
45097 1 2.948D+01,-3.902D+01, 1.464D+01,-3.335D+00, 5.054D-01,-5.915D-02,
45098 2 2.559D+01,-3.955D+01, 1.661D+01,-4.299D+00, 6.904D-01,-8.243D-02,
45099 3-1.663D+00, 1.176D+00, 1.118D+00,-7.099D-01, 1.948D-01,-2.404D-02,
45100 4-2.168D-01, 8.170D-01,-7.169D-01, 1.851D-01,-1.924D-02,-3.250D-03,
45101 5 2.088D-01,-4.355D-01, 2.239D-01,-2.446D-02,-3.620D-03, 1.910D-03,
45102 6-9.097D-02, 1.601D-01,-5.681D-02,-2.500D-03, 2.580D-03,-4.700D-04/
45103 DATA (((CEHLQ(IX,IT,NX,4,2),IX=1,6),IT=1,6),NX=1,2)/
45104 1 2.367D+00, 4.453D-01, 3.660D-01, 9.467D-02, 1.341D-01, 1.661D-02,
45105 2-3.170D+00,-1.795D+00, 3.313D-02,-2.874D-01,-9.827D-02,-7.119D-02,
45106 3 1.823D+00, 1.457D+00,-2.465D-01, 3.739D-02, 6.090D-03, 1.814D-02,
45107 4-1.033D+00,-9.827D-01, 2.136D-01, 1.169D-01, 5.001D-02, 1.684D-02,
45108 5 5.133D-01, 5.259D-01,-1.173D-01,-1.139D-01,-4.988D-02,-2.021D-02,
45109 6-2.881D-01,-3.145D-01, 5.667D-02, 9.161D-02, 4.568D-02, 1.951D-02,
45110 1 3.036D+01,-4.062D+01, 1.578D+01,-3.699D+00, 6.020D-01,-7.031D-02,
45111 2 2.700D+01,-4.167D+01, 1.770D+01,-4.804D+00, 7.862D-01,-1.060D-01,
45112 3-1.909D+00, 1.357D+00, 1.127D+00,-7.181D-01, 2.232D-01,-2.481D-02,
45113 4-2.488D-01, 9.781D-01,-8.127D-01, 2.094D-01,-2.997D-02,-4.710D-03,
45114 5 2.506D-01,-5.427D-01, 2.672D-01,-3.103D-02,-1.800D-03, 2.870D-03,
45115 6-1.128D-01, 2.087D-01,-6.972D-02,-2.480D-03, 2.630D-03,-8.400D-04/
45116 C...EXPANSION COEFFICIENTS FOR STRANGE SEA QUARK DISTRIBUTION
45117 DATA (((CEHLQ(IX,IT,NX,5,1),IX=1,6),IT=1,6),NX=1,2)/
45118 1 4.968D-02,-4.173D-02, 2.102D-02,-3.270D-03, 3.240D-03,-6.700D-04,
45119 2-6.150D-03,-1.294D-02, 6.740D-03,-6.890D-03, 9.000D-04,-1.510D-03,
45120 3-8.580D-03, 5.050D-03,-4.900D-03,-1.600D-04,-9.400D-04,-1.500D-04,
45121 4 7.840D-03, 1.510D-03, 2.220D-03, 1.400D-03, 7.000D-04, 3.500D-04,
45122 5-4.410D-03,-2.220D-03,-8.900D-04,-8.500D-04,-3.600D-04,-2.000D-04,
45123 6 2.520D-03, 1.840D-03, 4.100D-04, 3.900D-04, 1.600D-04, 9.000D-05,
45124 1 9.235D-01,-1.085D+00, 3.464D-01,-7.210D-02, 9.140D-03,-9.100D-04,
45125 2 9.315D-01,-1.274D+00, 4.512D-01,-9.775D-02, 1.380D-02,-1.310D-03,
45126 3 4.739D-02,-1.296D-01, 8.482D-02,-2.642D-02, 4.760D-03,-5.700D-04,
45127 4-2.653D-02, 4.953D-02,-1.735D-02, 1.750D-03, 2.800D-04,-6.000D-05,
45128 5 6.940D-03,-1.132D-02, 1.480D-03, 6.500D-04,-2.100D-04, 0.000D+00,
45129 6-1.680D-03, 2.340D-03, 4.200D-04,-3.400D-04, 5.000D-05, 1.000D-05/
45130 DATA (((CEHLQ(IX,IT,NX,5,2),IX=1,6),IT=1,6),NX=1,2)/
45131 1 6.478D-02,-4.537D-02, 1.643D-02,-3.490D-03, 2.710D-03,-6.700D-04,
45132 2-2.223D-02,-2.126D-02, 1.247D-02,-6.290D-03, 1.120D-03,-1.440D-03,
45133 3-1.340D-03, 1.362D-02,-6.130D-03,-7.900D-04,-9.000D-04,-2.000D-04,
45134 4 5.080D-03,-3.610D-03, 1.700D-03, 1.830D-03, 6.800D-04, 4.000D-04,
45135 5-3.580D-03, 6.000D-05,-2.600D-04,-1.050D-03,-3.800D-04,-2.300D-04,
45136 6 2.420D-03, 9.300D-04,-1.000D-04, 4.500D-04, 1.700D-04, 1.100D-04,
45137 1 9.868D-01,-1.171D+00, 3.940D-01,-8.459D-02, 1.124D-02,-1.250D-03,
45138 2 1.001D+00,-1.383D+00, 5.044D-01,-1.152D-01, 1.658D-02,-1.830D-03,
45139 3 4.928D-02,-1.368D-01, 9.021D-02,-2.935D-02, 5.800D-03,-6.600D-04,
45140 4-3.133D-02, 5.785D-02,-2.023D-02, 2.630D-03, 1.600D-04,-8.000D-05,
45141 5 8.840D-03,-1.416D-02, 1.900D-03, 5.800D-04,-2.500D-04, 1.000D-05,
45142 6-2.300D-03, 3.080D-03, 5.500D-04,-3.700D-04, 7.000D-05, 1.000D-05/
45143 C...EXPANSION COEFFICIENTS FOR CHARM SEA QUARK DISTRIBUTION
45144 DATA (((CEHLQ(IX,IT,NX,6,1),IX=1,6),IT=1,6),NX=1,2)/
45145 1 9.270D-03,-1.817D-02, 9.590D-03,-6.390D-03, 1.690D-03,-1.540D-03,
45146 2 5.710D-03,-1.188D-02, 6.090D-03,-4.650D-03, 1.240D-03,-1.310D-03,
45147 3-3.960D-03, 7.100D-03,-3.590D-03, 1.840D-03,-3.900D-04, 3.400D-04,
45148 4 1.120D-03,-1.960D-03, 1.120D-03,-4.800D-04, 1.000D-04,-4.000D-05,
45149 5 4.000D-05,-3.000D-05,-1.800D-04, 9.000D-05,-5.000D-05,-2.000D-05,
45150 6-4.200D-04, 7.300D-04,-1.600D-04, 5.000D-05, 5.000D-05, 5.000D-05,
45151 1 8.098D-01,-1.042D+00, 3.398D-01,-6.824D-02, 8.760D-03,-9.000D-04,
45152 2 8.961D-01,-1.217D+00, 4.339D-01,-9.287D-02, 1.304D-02,-1.290D-03,
45153 3 3.058D-02,-1.040D-01, 7.604D-02,-2.415D-02, 4.600D-03,-5.000D-04,
45154 4-2.451D-02, 4.432D-02,-1.651D-02, 1.430D-03, 1.200D-04,-1.000D-04,
45155 5 1.122D-02,-1.457D-02, 2.680D-03, 5.800D-04,-1.200D-04, 3.000D-05,
45156 6-7.730D-03, 7.330D-03,-7.600D-04,-2.400D-04, 1.000D-05, 0.000D+00/
45157 DATA (((CEHLQ(IX,IT,NX,6,2),IX=1,6),IT=1,6),NX=1,2)/
45158 1 9.980D-03,-1.945D-02, 1.055D-02,-6.870D-03, 1.860D-03,-1.560D-03,
45159 2 5.700D-03,-1.203D-02, 6.250D-03,-4.860D-03, 1.310D-03,-1.370D-03,
45160 3-4.490D-03, 7.990D-03,-4.170D-03, 2.050D-03,-4.400D-04, 3.300D-04,
45161 4 1.470D-03,-2.480D-03, 1.460D-03,-5.700D-04, 1.200D-04,-1.000D-05,
45162 5-9.000D-05, 1.500D-04,-3.200D-04, 1.200D-04,-6.000D-05,-4.000D-05,
45163 6-4.200D-04, 7.600D-04,-1.400D-04, 4.000D-05, 7.000D-05, 5.000D-05,
45164 1 8.698D-01,-1.131D+00, 3.836D-01,-8.111D-02, 1.048D-02,-1.300D-03,
45165 2 9.626D-01,-1.321D+00, 4.854D-01,-1.091D-01, 1.583D-02,-1.700D-03,
45166 3 3.057D-02,-1.088D-01, 8.022D-02,-2.676D-02, 5.590D-03,-5.600D-04,
45167 4-2.845D-02, 5.164D-02,-1.918D-02, 2.210D-03,-4.000D-05,-1.500D-04,
45168 5 1.311D-02,-1.751D-02, 3.310D-03, 5.100D-04,-1.200D-04, 5.000D-05,
45169 6-8.590D-03, 8.380D-03,-9.200D-04,-2.600D-04, 1.000D-05,-1.000D-05/
45170 C...EXPANSION COEFFICIENTS FOR BOTTOM SEA QUARK DISTRIBUTION
45171 DATA (((CEHLQ(IX,IT,NX,7,1),IX=1,6),IT=1,6),NX=1,2)/
45172 1 9.010D-03,-1.401D-02, 7.150D-03,-4.130D-03, 1.260D-03,-1.040D-03,
45173 2 6.280D-03,-9.320D-03, 4.780D-03,-2.890D-03, 9.100D-04,-8.200D-04,
45174 3-2.930D-03, 4.090D-03,-1.890D-03, 7.600D-04,-2.300D-04, 1.400D-04,
45175 4 3.900D-04,-1.200D-03, 4.400D-04,-2.500D-04, 2.000D-05,-2.000D-05,
45176 5 2.600D-04, 1.400D-04,-8.000D-05, 1.000D-04, 1.000D-05, 1.000D-05,
45177 6-2.600D-04, 3.200D-04, 1.000D-05,-1.000D-05, 1.000D-05,-1.000D-05,
45178 1 8.029D-01,-1.075D+00, 3.792D-01,-7.843D-02, 1.007D-02,-1.090D-03,
45179 2 7.903D-01,-1.099D+00, 4.153D-01,-9.301D-02, 1.317D-02,-1.410D-03,
45180 3-1.704D-02,-1.130D-02, 2.882D-02,-1.341D-02, 3.040D-03,-3.600D-04,
45181 4-7.200D-04, 7.230D-03,-5.160D-03, 1.080D-03,-5.000D-05,-4.000D-05,
45182 5 3.050D-03,-4.610D-03, 1.660D-03,-1.300D-04,-1.000D-05, 1.000D-05,
45183 6-4.360D-03, 5.230D-03,-1.610D-03, 2.000D-04,-2.000D-05, 0.000D+00/
45184 DATA (((CEHLQ(IX,IT,NX,7,2),IX=1,6),IT=1,6),NX=1,2)/
45185 1 8.980D-03,-1.459D-02, 7.510D-03,-4.410D-03, 1.310D-03,-1.070D-03,
45186 2 5.970D-03,-9.440D-03, 4.800D-03,-3.020D-03, 9.100D-04,-8.500D-04,
45187 3-3.050D-03, 4.440D-03,-2.100D-03, 8.500D-04,-2.400D-04, 1.400D-04,
45188 4 5.300D-04,-1.300D-03, 5.600D-04,-2.700D-04, 3.000D-05,-2.000D-05,
45189 5 2.000D-04, 1.400D-04,-1.100D-04, 1.000D-04, 0.000D+00, 0.000D+00,
45190 6-2.600D-04, 3.200D-04, 0.000D+00,-3.000D-05, 1.000D-05,-1.000D-05,
45191 1 8.672D-01,-1.174D+00, 4.265D-01,-9.252D-02, 1.244D-02,-1.460D-03,
45192 2 8.500D-01,-1.194D+00, 4.630D-01,-1.083D-01, 1.614D-02,-1.830D-03,
45193 3-2.241D-02,-5.630D-03, 2.815D-02,-1.425D-02, 3.520D-03,-4.300D-04,
45194 4-7.300D-04, 8.030D-03,-5.780D-03, 1.380D-03,-1.300D-04,-4.000D-05,
45195 5 3.460D-03,-5.380D-03, 1.960D-03,-2.100D-04, 1.000D-05, 1.000D-05,
45196 6-4.850D-03, 5.950D-03,-1.890D-03, 2.600D-04,-3.000D-05, 0.000D+00/
45197 C...EXPANSION COEFFICIENTS FOR TOP SEA QUARK DISTRIBUTION
45198 DATA (((CEHLQ(IX,IT,NX,8,1),IX=1,6),IT=1,6),NX=1,2)/
45199 1 4.410D-03,-7.480D-03, 3.770D-03,-2.580D-03, 7.300D-04,-7.100D-04,
45200 2 3.840D-03,-6.050D-03, 3.030D-03,-2.030D-03, 5.800D-04,-5.900D-04,
45201 3-8.800D-04, 1.660D-03,-7.500D-04, 4.700D-04,-1.000D-04, 1.000D-04,
45202 4-8.000D-05,-1.500D-04, 1.200D-04,-9.000D-05, 3.000D-05, 0.000D+00,
45203 5 1.300D-04,-2.200D-04,-2.000D-05,-2.000D-05,-2.000D-05,-2.000D-05,
45204 6-7.000D-05, 1.900D-04,-4.000D-05, 2.000D-05, 0.000D+00, 0.000D+00,
45205 1 6.623D-01,-9.248D-01, 3.519D-01,-7.930D-02, 1.110D-02,-1.180D-03,
45206 2 6.380D-01,-9.062D-01, 3.582D-01,-8.479D-02, 1.265D-02,-1.390D-03,
45207 3-2.581D-02, 2.125D-02, 4.190D-03,-4.980D-03, 1.490D-03,-2.100D-04,
45208 4 7.100D-04, 5.300D-04,-1.270D-03, 3.900D-04,-5.000D-05,-1.000D-05,
45209 5 3.850D-03,-5.060D-03, 1.860D-03,-3.500D-04, 4.000D-05, 0.000D+00,
45210 6-3.530D-03, 4.460D-03,-1.500D-03, 2.700D-04,-3.000D-05, 0.000D+00/
45211 DATA (((CEHLQ(IX,IT,NX,8,2),IX=1,6),IT=1,6),NX=1,2)/
45212 1 4.260D-03,-7.530D-03, 3.830D-03,-2.680D-03, 7.600D-04,-7.300D-04,
45213 2 3.640D-03,-6.050D-03, 3.030D-03,-2.090D-03, 5.900D-04,-6.000D-04,
45214 3-9.200D-04, 1.710D-03,-8.200D-04, 5.000D-04,-1.200D-04, 1.000D-04,
45215 4-5.000D-05,-1.600D-04, 1.300D-04,-9.000D-05, 3.000D-05, 0.000D+00,
45216 5 1.300D-04,-2.100D-04,-1.000D-05,-2.000D-05,-2.000D-05,-1.000D-05,
45217 6-8.000D-05, 1.800D-04,-5.000D-05, 2.000D-05, 0.000D+00, 0.000D+00,
45218 1 7.146D-01,-1.007D+00, 3.932D-01,-9.246D-02, 1.366D-02,-1.540D-03,
45219 2 6.856D-01,-9.828D-01, 3.977D-01,-9.795D-02, 1.540D-02,-1.790D-03,
45220 3-3.053D-02, 2.758D-02, 2.150D-03,-4.880D-03, 1.640D-03,-2.500D-04,
45221 4 9.200D-04, 4.200D-04,-1.340D-03, 4.600D-04,-8.000D-05,-1.000D-05,
45222 5 4.230D-03,-5.660D-03, 2.140D-03,-4.300D-04, 6.000D-05, 0.000D+00,
45223 6-3.890D-03, 5.000D-03,-1.740D-03, 3.300D-04,-4.000D-05, 0.000D+00/
45224 DATA TBMIN,TTMIN/8.1905D0,7.4474D0,11.5528D0,10.8097D0/
45225 DATA XOLD,QOLD,IOLD,NOLD/-1.D0,0.D0,0,0/
45226 DATA DMIN,Q0,QL/0.D0,2*2.D0,2*2.236D0,2.D0,.2D0,
45227 & .4D0,.2D0,.29D0,.177D0/
45228 C---X IS EQUAL TO XIN, UNLESS IT IS LESS THAN PDFX0
45230 IF (X.LE.ZERO) CALL HWWARN('HWSFUN',100,*999)
45232 IF (XMWN.LE.ZERO) THEN
45238 C---FREEZE THE SCALE IF REQUIRED
45240 IF (ISPAC.GT.0) SCALEF=MAX(SCALEF,QSPAC)
45241 C---CHECK IF PDFLIB REQUESTED
45242 IF (IBEAM.EQ.1.OR.IBEAM.EQ.2) THEN
45248 IF (IDHAD.EQ.59.OR.IDHAD.EQ.71) THEN
45249 IF (MPDF.GE.0) THEN
45250 C---USE PDFLIB PHOTON STRUCTURE FUNCTIONS
45251 PARM(1)=AUTPDF(IBEAM)
45253 C---FIX TO CALL SCHULER-SJOSTRAND CODE
45254 IF (AUTPDF(IBEAM).EQ.'SaSph') THEN
45256 IF ( XSP.LE.ZERO) CALL HWWARN('HWSFUN',102,*999)
45257 IF (ONE-XSP.LE.ZERO) CALL HWWARN('HWSFUN',103,*999)
45259 ISET=MOD(MODPDF(IBEAM),10)
45260 IOP1=MOD(MODPDF(IBEAM)/10,2)
45261 IOP2=MOD(MODPDF(IBEAM)/20,2)
45262 IP2=MODPDF(IBEAM)/100
45263 IF (IOP2.EQ.0) THEN
45267 IF (JDAHEP(1,IHAD).NE.0) IHAD=JDAHEP(1,IHAD)
45270 CALL SASGAM(ISET,XSP,Q2,P2,IP2,F2GM,XPGA)
45271 IF (IOP1.EQ.1 .AND. ISTAT.LT.10) THEN
45273 5 XPGA(I)=XPVMD(I)+XPANL(I)+XPBEH(I)+XPDIR(I)
45285 IF(PARM(1).NE.PARMSAVE.OR.VAL(1).NE.VALSAVE)THEN
45288 CALL PDFSET(PARM,VAL)
45290 IF (X.LT.PDFXMN.AND.PDFWRX(IBEAM,1) .OR.
45291 & X.GT.PDFXMX.AND.PDFWRX(IBEAM,2)) THEN
45292 CALL HWWARN('HWSFUN',2,*999)
45293 WRITE (6,'(2A)') ' WARNING: PDFLIB CALLED WITH X',
45294 & ' OUTSIDE ALLOWED RANGE!'
45295 WRITE (6,'(1P,3(A,E9.3))') ' X VALUE=',X,
45296 & ', MINIMUM=',PDFXMN,', MAXIMUM=',PDFXMX
45297 WRITE (6,'(A)') ' NO FURTHER WARNINGS WILL BE ISSUED'
45298 IF (X.LT.PDFXMN) PDFWRX(IBEAM,1)=.FALSE.
45299 IF (X.GT.PDFXMX) PDFWRX(IBEAM,2)=.FALSE.
45301 IF (QSCA**2.LT.PDFQMN.AND.PDFWRQ(IBEAM,1) .OR.
45302 & QSCA**2.GT.PDFQMX.AND.PDFWRQ(IBEAM,2)) THEN
45303 CALL HWWARN('HWSFUN',3,*999)
45304 WRITE (6,'(2A)') ' WARNING: PDFLIB CALLED WITH Q',
45305 & ' OUTSIDE ALLOWED RANGE!'
45306 WRITE (6,'(1P,3(A,E9.3))') ' Q VALUE=',QSCA,
45307 & ', MINIMUM=',SQRT(PDFQMN),', MAXIMUM=',SQRT(PDFQMX)
45308 WRITE (6,'(A)') ' NO FURTHER WARNINGS WILL BE ISSUED'
45309 IF (QSCA**2.LT.PDFQMN) PDFWRQ(IBEAM,1)=.FALSE.
45310 IF (QSCA**2.GT.PDFQMN) PDFWRQ(IBEAM,2)=.FALSE.
45312 CALL STRUCTM(X,QSCA,UPV,DNV,USEA,DSEA,STR,CHM,BTM,TOP,GLU)
45320 IF ( XSP.LE.ZERO) CALL HWWARN('HWSFUN',102,*999)
45321 IF (ONE-XSP.LE.ZERO) CALL HWWARN('HWSFUN',103,*999)
45328 IF (Q2.GT.50.) NFL=4
45329 IF (Q2.GT.500.) NFL=5
45330 STR=HWSDGQ(XSP,Q2,NFL,1)
45331 CHM=HWSDGQ(XSP,Q2,NFL,2)
45332 GLU=HWSDGG(XSP,Q2,NFL)
45337 IF (W2.GT.EMB2) THEN
45339 IF (W2*ALAM2.LT.Q2*EMB2)
45340 & BTM=BTM*LOG(W2/EMB2)/LOG(Q2/ALAM2)
45344 IF (W2.GT.EMC2) THEN
45345 IF (W2*ALAM2.LT.Q2*EMC2)
45346 & CHM=CHM*LOG(W2/EMC2)/LOG(Q2/ALAM2)
45352 C---INCLUDE SUPPRESSION FROM PHOTON VIRTUALITY IF NECESSARY
45353 IF (PHOMAS.GT.ZERO.AND.(IBEAM.EQ.1.OR.IBEAM.EQ.2)) THEN
45355 IF (JDAHEP(1,IHAD).NE.0) IHAD=JDAHEP(1,IHAD)
45356 IF (IDHW(IHAD).EQ.59) THEN
45357 FAC=LOG((QSCA**2+PHOMAS**2)/(PHEP(5,IHAD)**2+PHOMAS**2))/
45358 $ LOG((QSCA**2+PHOMAS**2)/( PHOMAS**2))
45359 IF (FAC.LT.ZERO) FAC=ZERO
45360 DIST(1)=DIST(1)*FAC
45361 DIST(2)=DIST(2)*FAC
45362 DIST(7)=DIST(7)*FAC
45363 DIST(8)=DIST(8)*FAC
45370 CALL HWWARN('HWSFUN',1,*999)
45375 IF (MPDF.GE.0) THEN
45376 C---USE PDFLIB NUCLEON STRUCTURE FUNCTIONS
45377 PARM(1)=AUTPDF(IBEAM)
45379 IF(PARM(1).NE.PARMSAVE.OR.VAL(1).NE.VALSAVE)THEN
45382 CALL PDFSET(PARM,VAL)
45384 IF (X.LT.PDFXMN.AND.PDFWRX(IBEAM,1) .OR.
45385 & X.GT.PDFXMX.AND.PDFWRX(IBEAM,2)) THEN
45386 CALL HWWARN('HWSFUN',4,*999)
45387 WRITE (6,'(2A)') ' WARNING: PDFLIB CALLED WITH X',
45388 & ' OUTSIDE ALLOWED RANGE!'
45389 WRITE (6,'(1P,3(A,E9.3))') ' X VALUE=',X,
45390 & ', MINIMUM=',PDFXMN,', MAXIMUM=',PDFXMX
45391 WRITE (6,'(A)') ' NO FURTHER WARNINGS WILL BE ISSUED'
45392 IF (X.LT.PDFXMN) PDFWRX(IBEAM,1)=.FALSE.
45393 IF (X.GT.PDFXMX) PDFWRX(IBEAM,2)=.FALSE.
45395 IF (QSCA**2.LT.PDFQMN.AND.PDFWRQ(IBEAM,1) .OR.
45396 & QSCA**2.GT.PDFQMX.AND.PDFWRQ(IBEAM,2)) THEN
45397 CALL HWWARN('HWSFUN',5,*999)
45398 WRITE (6,'(2A)') ' WARNING: PDFLIB CALLED WITH Q',
45399 & ' OUTSIDE ALLOWED RANGE!'
45400 WRITE (6,'(1P,3(A,E9.3))') ' Q VALUE=',QSCA,
45401 & ', MINIMUM=',SQRT(PDFQMN),', MAXIMUM=',SQRT(PDFQMX)
45402 WRITE (6,'(A)') ' NO FURTHER WARNINGS WILL BE ISSUED'
45403 IF (QSCA**2.LT.PDFQMN) PDFWRQ(IBEAM,1)=.FALSE.
45404 IF (QSCA**2.GT.PDFQMN) PDFWRQ(IBEAM,2)=.FALSE.
45406 CALL STRUCTM(X,QSCA,UPV,DNV,USEA,DSEA,STR,CHM,BTM,TOP,GLU)
45407 C--new MRST98 LO PDF's
45408 ELSEIF(NSET.GE.6.AND.NSET.LE.8) THEN
45409 CALL HWSMRS(X,SCALEF,NSET-5,UPV,DNV,USEA,DSEA,STR,CHM,BTM,GLU)
45412 IF (NSET.LT.1.OR.NSET.GT.5) CALL HWWARN('HWSFUN',400,*999)
45413 IF (QSCA.LT.Q0(NSET)) QSCA=Q0(NSET)
45414 IF (QSCA.NE.QOLD.OR.IDHAD.NE.IOLD.OR.NSET.NE.NOLD) THEN
45419 SS=LOG(QSCA/QL(NSET))
45420 SMIN=LOG(Q0(NSET)/QL(NSET))
45421 IF (NSET.LT.3.OR.NSET.EQ.5) THEN
45426 TMAX=2.*LOG(1.E4/QL(NSET))
45428 IF (IDHAD.GE.72) THEN
45429 IF (NSET.LT.3) THEN
45433 10 A(J,I)=B(1,J,I,IP)+S*(B(2,J,I,IP)+S*B(3,J,I,IP))
45435 AA=ONE+A(2,K)+A(3,K)
45436 20 G(K)=HWSGAM(AA)/((ONE+A(2,K)*A(4,K)/AA)*HWSGAM(A(2,K))
45437 & *HWSGAM(ONE+A(3,K)))
45438 ELSEIF (NSET.EQ.5) THEN
45441 21 A(J,I)=BB(1,J,I)+S*(BB(2,J,I)+S*(BB(3,J,I)+S*BB(4,J,I)))
45443 AA=ONE+A(2,K)+A(3,K)
45444 22 G(K)=HWSGAM(AA)/((ONE+A(2,K)/AA*(A(4,K)+
45445 & (ONE+A(2,K))/(ONE+AA)*A(5,K)))*HWSGAM(A(2,K))
45446 & *HWSGAM(ONE+A(3,K)))
45449 VT=MAX(-ONE,MIN(ONE,(2.*T-TMAX-TMIN)/(TMAX-TMIN)))
45451 C...CHEBYSHEV POLYNOMIALS FOR T EXPANSION
45455 TT(4)= (4.*WT- 3.)*VT
45456 TT(5)= (8.*WT- 8.)*WT+1.
45457 TT(6)=((16.*WT-20.)*WT+5.)*VT
45459 ELSEIF (NSET.LT.3) THEN
45463 30 A(J,I)=B(1,J,I,IP)+S*(B(2,J,I,IP)+S*B(3,J,I,IP))
45464 AA=ONE+A(2,1)+A(3,1)
45465 G(1)=HWSGAM(AA)/(HWSGAM(A(2,1))*HWSGAM(ONE+A(3,1)))
45470 IF (NSET.LT.3.OR.NSET.EQ.5) THEN
45472 50 F(I)=A(1,I)*X**A(2,I)*XMWN**A(3,I)*(ONE+X*
45473 & (A(4,I)+X*(A(5,I) + X*A(6,I))))
45485 IF (X.NE.XOLD) THEN
45492 VX=MAX(-ONE,(2.*LOG(X)+11.51293)/6.90776)
45498 TX(4)= (4.*WX- 3.)*VX
45499 TX(5)= (8.*WX- 8.)*WX+1.
45500 TX(6)=((16.*WX-20.)*WX+5.)*VX
45502 C...CALCULATE STRUCTURE FUNCTIONS
45507 110 XQSUM=XQSUM+CEHLQ(IX,IT,NX,IFL,IP)*TX(IX)*TT(IT)
45508 120 XQ(IFL)=XQSUM*XMWN**NEHLQ(IFL,IP)
45515 C...SPECIAL EXPANSION FOR BOTTOM (THRESHOLD EFFECTS)
45516 IF (NFLAV.LT.5.OR.T.LE.TBMIN(IP)) THEN
45519 VT=MAX(-ONE,MIN(ONE,(2.*T-TMAX-TBMIN(IP))/(TMAX-TBMIN(IP))))
45524 TB(4)= (4.*WT- 3.)*VT
45525 TB(5)= (8.*WT- 8.)*WT+1.
45526 TB(6)=((16.*WT-20.)*WT+5.)*VT
45530 130 XQSUM=XQSUM+CEHLQ(IX,IT,NX,7,IP)*TX(IX)*TB(IT)
45531 BTM=XQSUM*XMWN**NEHLQ(7,IP)
45533 C...SPECIAL EXPANSION FOR TOP (THRESHOLD EFFECTS)
45534 TPMIN=TTMIN(IP)+TMTOP
45535 C---TMTOP=2.*LOG(TOPMAS/30.)
45537 IF (NFLAV.LT.6.OR.T.LE.TPMIN) THEN
45540 VT=MAX(-ONE,MIN(ONE,(2.*T-TPMAX-TPMIN)/(TPMAX-TPMIN)))
45545 TB(4)= (4.*WT- 3.)*VT
45546 TB(5)= (8.*WT- 8.)*WT+1.
45547 TB(6)=((16.*WT-20.)*WT+5.)*VT
45551 150 XQSUM=XQSUM+CEHLQ(IX,IT,NX,8,IP)*TX(IX)*TB(IT)
45552 TOP=XQSUM*XMWN**NEHLQ(8,IP)
45556 IF (MPDF.LT.0.AND.NSET.LE.5) THEN
45560 IF(MPDF.LT.0.AND.NSET.GT.2.AND.(IDHAD.EQ.38.OR.IDHAD.EQ.30)) THEN
45561 WRITE(6,*) ' THIS SET OF PDFS DOES NOT SUPPORT PIONS'
45562 WRITE(6,*) 'EITHER USE SET NSTRU=1,2 OR A PION SET FROM PDFLIB'
45565 IF (IDHAD.EQ.73.OR.IDHAD.EQ.72) THEN
45570 ELSEIF (IDHAD.EQ.91) THEN
45575 ELSEIF (IDHAD.EQ.75) THEN
45580 ELSEIF (IDHAD.EQ.93) THEN
45585 ELSEIF (IDHAD.EQ.38) THEN
45590 ELSEIF (IDHAD.EQ.30) THEN
45596 PRINT *,' CALLED HWSFUN FOR IDHAD =',IDHAD
45597 CALL HWWARN('HWSFUN',400,*999)
45609 IF (DIST(I).LT.DMIN) DIST(I)=DMIN
45611 C---FOR REMNANT NUCLEONS SWITCH OFF VALENCE QUARKS,
45612 C WHILE MAINTAINING MOMENTUM SUM RULE
45613 IF (IDHAD.EQ.72) THEN
45616 TOTAL=TOTAL+DIST(I)
45618 DIST(1)=DIST(1)-DNV
45619 DIST(2)=DIST(2)-UPV
45620 IF (TOTAL.GT.DNV+UPV) THEN
45622 DIST(I)=DIST(I)*TOTAL/(TOTAL-DNV-UPV)
45626 C---IF X HAS BEEN FROZEN USE A POWER LAW
45627 IF (XIN.LT.PDFX0) THEN
45628 PDFFAC=(XIN/PDFX0)**PDFPOW
45630 DIST(I)=DIST(I)*PDFFAC
45635 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
45636 *-- Author : Adapted by Bryan Webber
45637 C-----------------------------------------------------------------------
45638 FUNCTION HWSGAM(ZINPUT)
45639 C-----------------------------------------------------------------------
45640 C Gamma function computed by eq. 6.1.40, Abramowitz.
45641 C B(M) = B2m/(2m *(2m-1)) where B2m is the 2m'th Bernoulli number.
45642 C HLNTPI = .5*LOG(2.*PI)
45643 C-----------------------------------------------------------------------
45644 DOUBLE PRECISION HWSGAM,ZINPUT,B(10),HLNTPI,Z,SHIFT,G,T,RECZSQ
45647 1 0.83333333333333333333D-01, -0.27777777777777777778D-02,
45648 1 0.79365079365079365079D-03, -0.59523809523809523810D-03,
45649 1 0.84175084175084175084D-03, -0.19175269175269175269D-02,
45650 1 0.64102564102564102564D-02, -0.29550653594771241830D-01,
45651 1 0.17964437236883057316D0 , -1.3924322169059011164D0 /
45652 DATA HLNTPI/0.91893853320467274178D0/
45654 C Shift argument to large value ( > 20 )
45658 10 IF (Z.LT.20.D0) THEN
45664 C Compute asymptotic formula
45666 G = (Z-.5D0)*LOG(Z) - Z + HLNTPI
45673 HWSGAM = EXP(G)/SHIFT
45676 *CMZ :- -26/04/91 14.55.45 by Federico Carminati
45677 *-- Author : Bryan Webber
45678 C-----------------------------------------------------------------------
45679 SUBROUTINE HWSGEN(GENEX)
45680 C-----------------------------------------------------------------------
45681 C GENERATES X VALUES (IF GENEX)
45682 C EVALUATES STRUCTURE FUNCTIONS AND ENFORCES CUTOFFS ON X
45683 C-----------------------------------------------------------------------
45684 INCLUDE 'HERWIG65.INC'
45685 DOUBLE PRECISION HWBVMC,HWRUNI,X,QL
45688 EXTERNAL HWBVMC,HWRUNI
45690 XX(1)=EXP(HWRUNI(0,ZERO,XLMIN))
45695 IF (JDAHEP(1,I).NE.0) J=JDAHEP(1,I)
45698 CALL HWSFUN(X,EMSCA,IDHW(J),NSTRU,DISF(1,I),I)
45700 IF (QL.LT.HWBVMC(J)) DISF(J,I)=0.
45704 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
45705 *-- Author : Bryan Webber
45706 C-----------------------------------------------------------------------
45707 FUNCTION HWSGQQ(QSCA)
45708 C-----------------------------------------------------------------------
45709 C CORRECTION TO GLUON STRUCTURE FUNCTION FOR BACKWARD EVOLUTION:
45710 C G->Q-QBAR PART OF FORM FACTOR
45711 C-----------------------------------------------------------------------
45712 INCLUDE 'HERWIG65.INC'
45713 DOUBLE PRECISION HWSGQQ,HWUALF,QSCA,GG
45715 GG=HWUALF(1,QSCA)**(-ONE/BETAF)
45716 IF (GG.LT.ONE) GG=ONE
45717 IF (QSCA.GT.RMASS(6)) THEN
45719 ELSEIF (QSCA.GT.RMASS(5)) THEN
45721 ELSEIF (QSCA.GT.RMASS(4)) THEN
45728 *CMZ :- -26/04/01 10.00.16 by Peter Richardson
45729 *-- Author : Dick Roberts, modified by Peter Richardson
45730 C-----------------------------------------------------------------------
45731 SUBROUTINE HWSMRS(X,Q,MODE,UPV,DNV,USEA,DSEA,STR,CHM,BOT,GLU)
45732 C-----------------------------------------------------------------------
45733 C MRST98 Leading order PDF's central and higher gluon + average
45734 C-----------------------------------------------------------------------
45735 INCLUDE 'HERWIG65.INC'
45736 DOUBLE PRECISION X,Q,UPV,DNV,USEA,DSEA,STR,CHM,BOT,GLU,XMIN,XMAX,
45737 & QSQMIN,QSQMAX,Q2,QQ(NQMRS),XXMRS(NXMRS),G(NPMRS),N0(NPMRS),
45738 & XSAVE,Q2SAVE,XXX,A,B,FAC
45739 INTEGER MODE,INIT,NTENTH,N,M,I,J,K,ML,WARN(2)
45740 PARAMETER(NTENTH=23)
45741 DATA XMIN,XMAX,QSQMIN,QSQMAX/1D-5,1D0,1.25D0,1D7/
45742 DATA XXMRS/1d-5,2d-5,4d-5,6d-5,8d-5,
45743 & 1d-4,2d-4,4d-4,6d-4,8d-4,
45744 & 1d-3,2d-3,4d-3,6d-3,8d-3,
45745 & 1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2,
45746 & .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0,
45747 & .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0,
45748 & .5d0,.525d0,.55d0,.575d0,.6d0,.65d0,.7d0,.75d0,
45750 DATA QQ/1.25d0,1.5d0,2d0,2.5d0,3.2d0,4d0,5d0,6.4d0,8d0,1d1,
45751 & 1.2d1,1.8d1,2.6d1,4d1,6.4d1,1d2,
45752 & 1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3,1d4,
45753 & 1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6,
45754 & 1.8d6,3.2d6,5.6d6,1d7/
45755 DATA N0/3,4,5,9,9,9,9,9/
45756 DATA INIT,WARN/0,0,0/
45757 SAVE INIT,WARN,XMIN,XMAX,QSQMIN,QSQMAX,XXMRS,QQ,N0
45759 C--issue warning if x or q out of range
45760 IF((Q2.LT.QSQMIN.OR.Q2.GT.QSQMAX).AND.WARN(1).EQ.0) THEN
45761 CALL HWWARN('HWSMRS',5,*98)
45762 WRITE (6,'(2A)') ' WARNING: MRST98 CALLED WITH Q',
45763 & ' OUTSIDE ALLOWED RANGE!'
45764 WRITE (6,'(1P,3(A,E9.3))') ' Q VALUE=',Q,
45765 & ', MINIMUM=',SQRT(QSQMIN),', MAXIMUM=',SQRT(QSQMAX)
45766 WRITE (6,'(A)') ' NO FURTHER WARNINGS WILL BE ISSUED'
45769 98 IF((X.LT.XMIN.OR.X.GT.XMAX).AND.WARN(2).EQ.0) THEN
45770 CALL HWWARN('HWSMRS',4,*99)
45771 WRITE (6,'(2A)') ' WARNING: MRST98 CALLED WITH X',
45772 & ' OUTSIDE ALLOWED RANGE!'
45773 WRITE (6,'(1P,3(A,E9.3))') ' X VALUE=',X,
45774 & ', MINIMUM=',XMIN,', MAXIMUM=',XMAX
45775 WRITE (6,'(A)') ' NO FURTHER WARNINGS WILL BE ISSUED'
45778 C--now the evaluation
45781 C--first the initialisation
45782 IF(INIT.NE.0) GOTO 10
45787 c notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea
45789 FMRS(ML,I,N,M) = FMRS(ML,I,N,M)/(1.0D0-XXMRS(N))**N0(I)
45791 FMRS(ML,I,N,M) = 0.5D0*(FMRS(1,I,N,M)+FMRS(2,I,N,M))/
45792 & (1.0D0-XXMRS(N))**N0(I)
45797 IF(I.EQ.5.OR.I.EQ.7) GOTO 31
45799 30 FMRS(ML,I,J,K)=DLOG10(FMRS(ML,I,J,K)/FMRS(ML,I,NTENTH,K))
45800 & +FMRS(ML,I,NTENTH,K)
45804 40 FMRS(ML,I,NXMRS,M)=0.0D0
45807 32 XXMRS(J)=DLOG10(XXMRS(J)/XXMRS(NTENTH))+XXMRS(NTENTH)
45810 C--check x and q within range of set
45811 IF(X.LT.XMIN) X=XMIN
45812 IF(X.GT.XMAX) X=XMAX
45813 IF(Q2.LT.QSQMIN) Q2=QSQMIN
45814 IF(Q2.GT.QSQMAX) Q2=QSQMAX
45817 IF(X.LT.XXMRS(NTENTH)) XXX=DLOG10(X/XXMRS(NTENTH))+XXMRS(NTENTH)
45820 IF(XXX.GT.XXMRS(N+1)) GOTO 70
45821 A=(XXX-XXMRS(N))/(XXMRS(N+1)-XXMRS(N))
45824 IF(Q2.GT.QQ(M+1)) GOTO 80
45825 B=(Q2-QQ(M))/(QQ(M+1)-QQ(M))
45827 G(I)= (1.0D0-A)*(1.0D0-B)*FMRS(MODE,I,N ,M )
45828 & +(1.0D0-A)* B *FMRS(MODE,I,N ,M+1)
45829 & + A *(1.0D0-B)*FMRS(MODE,I,N+1,M )
45830 & + A * B *FMRS(MODE,I,N+1,M+1)
45831 IF(N.GE.NTENTH) GOTO 65
45832 IF(I.EQ.5.OR.I.EQ.7) GOTO 65
45833 FAC = (1.0D0-B)*FMRS(MODE,I,NTENTH,M)+B*FMRS(MODE,I,NTENTH,M+1)
45834 G(I) = FAC*10.0d0**(G(I)-FAC)
45836 G(I)=G(I)*(1.0d0-X)**N0(I)
45851 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
45852 *-- Author : Bryan Webber
45853 C-----------------------------------------------------------------------
45855 C-----------------------------------------------------------------------
45856 C REPLACES SPACELIKE PARTONS BY SPECTATORS
45857 C-----------------------------------------------------------------------
45858 INCLUDE 'HERWIG65.INC'
45859 DOUBLE PRECISION HWUSQR,EMSQ,EMTR,EPAR,XPAR,QSQ,PCL(5)
45860 INTEGER KHEP,IP,JP,IDH,IDP,ISP,IDSPC,JHEP
45862 IF (IERROR.NE.0) RETURN
45864 IF (ISTHEP(KHEP).EQ.145.OR.ISTHEP(KHEP).EQ.146) THEN
45865 IP=ISTHEP(KHEP)-144
45867 IF (JDAHEP(1,IP).NE.0) JP=JDAHEP(1,IP)
45870 IF (IDH.NE.IDP) THEN
45871 IF (IDH.EQ.59) THEN
45875 ELSEIF (IDP.LT.13) THEN
45878 CALL HWWARN('HWSSPC',100,*999)
45880 C---IDENTIFY SPECTATOR
45882 ELSEIF (IDP.LE.3) THEN
45884 10 IF (IDH.EQ.NCLDK(LOCN(IDP,ISP))) GOTO 20
45885 CALL HWWARN('HWSSPC',101,*999)
45886 20 IF (ISP.LE.3) THEN
45888 ELSEIF (ISP.LE.9) THEN
45893 C---(2) ANTIQUARK CASE
45894 ELSEIF (IDP.GT.6.AND.IDP.LE.9) THEN
45897 30 IF (IDH.EQ.NCLDK(LOCN(ISP,IDP))) GOTO 40
45898 CALL HWWARN('HWSSPC',103,*999)
45900 40 IF (ISP.LE.3) THEN
45902 ELSEIF (ISP.LE.9) THEN
45907 C---SPECIAL CASE FOR REMNANT HADRON
45908 ELSEIF (IDH.EQ.71.OR.IDH.EQ.72) THEN
45909 IF (IDP.EQ.13) THEN
45912 CALL HWWARN('HWSSPC',106,*999)
45915 CALL HWWARN('HWSSPC',105,*999)
45917 C---REPLACE PARTON BY SPECTATOR
45919 IDHEP(KHEP)=IDPDG(IDSPC)
45920 ISTHEP(KHEP)=146+IP
45921 EMSQ=SIGN(PHEP(5,KHEP)**2,PHEP(5,KHEP))
45922 EMTR=EMSQ+PHEP(1,KHEP)**2+PHEP(2,KHEP)**2
45924 CALL HWVDIF(4,PHEP(1,JP),PHEP(1,KHEP),PHEP(1,KHEP))
45925 IF (EPAR**2.LT.10000.*ABS(EMTR)) THEN
45926 CALL HWUMAS(PHEP(1,KHEP))
45928 C---COMPUTE SPECTATOR MASS ELIMINATING ROUNDING ERRORS
45929 XPAR=EPAR/PHEP(4,JP)
45930 QSQ=SIGN(PHEP(5,JP)**2,PHEP(5,JP))
45931 PHEP(5,KHEP)=HWUSQR((1.-XPAR)*QSQ+EMSQ-EMTR/XPAR
45932 & -((QSQ*XPAR**2-EMTR)/(2*EPAR*XPAR**2))**2*XPAR)
45934 C---CHECK FOR UNPHYSICAL SPECTATOR
45935 IF (PHEP(4,KHEP).LT.ZERO) FROST=.TRUE.
45936 C---FIND MASS OF CORRESPONDING CLUSTER, IF PARTNER IS IN THE SAME JET
45937 IF (QORQQB(IDHW(KHEP))) THEN
45938 JHEP=JMOHEP(2,KHEP)
45939 ELSEIF (QBORQQ(IDHW(KHEP))) THEN
45940 JHEP=JDAHEP(2,KHEP)
45944 IF (JHEP.GT.0) THEN
45945 CALL HWVSUM(4,PHEP(1,KHEP),PHEP(1,JHEP),PCL)
45947 C---IF IT IS NEGATIVE, REJECT
45948 IF (PCL(5).LT.ZERO) FROST=.TRUE.
45955 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
45956 *-- Author : Bryan Webber
45957 C-----------------------------------------------------------------------
45959 C-----------------------------------------------------------------------
45960 INCLUDE 'HERWIG65.INC'
45961 DOUBLE PRECISION HWSSUD,HWSGQQ,DMIN,QSCA,XLAST,DIST(13)
45964 COMMON/HWTABC/XLAST,N0,IS,ID
45967 CALL HWSFUN(XLAST,QSCA,IDHW(INHAD),NSTRU,DIST,JNHAD)
45968 IF (ID.EQ.13) DIST(ID)=DIST(ID)*HWSGQQ(QSCA)
45969 IF (DIST(ID).LT.DMIN) DIST(ID)=DMIN
45970 HWSSUD=SUD(N0+I,IS)/DIST(ID)
45973 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
45974 *-- Author : Adapted by Bryan Webber
45975 C-----------------------------------------------------------------------
45976 FUNCTION HWSTAB(F,AFUN,NN,X,MM)
45977 C-----------------------------------------------------------------------
45978 C MODIFIED CERN INTERPOLATION ROUTINE DIVDIF
45979 C LIKE HWUTAB BUT USES FUNCTION AFUN IN PLACE OF ARRAY A
45980 C-----------------------------------------------------------------------
45982 INTEGER NN,MM,MMAX,N,M,MPLUS,IX,IY,MID,NPTS,IP,I,J,L,ISUB
45983 DOUBLE PRECISION HWSTAB,AFUN,SUM,X,F(NN),T(20),D(20)
45992 IF (AFUN(1).GT.AFUN(N)) GOTO 94
45994 IF (X.GE.AFUN(MID)) GOTO 92
45998 93 IF (IY-IX.GT.1) GOTO 91
46001 IF (X.LE.AFUN(MID)) GOTO 95
46005 96 IF (IY-IX.GT.1) GOTO 94
46006 97 NPTS=M+2-MOD(M,2)
46013 IF ((1.LE.ISUB).AND.(ISUB.LE.N)) GOTO 100
46019 101 IF (IP.LT.NPTS) GOTO 98
46020 EXTRA=NPTS.NE.MPLUS
46022 IF (.NOT.EXTRA) GOTO 12
46024 D(M+2)=(D(M+2)-D(M))/(T(M+2)-T(ISUB))
46028 D(I)=(D(I)-D(I-1))/(T(I)-T(ISUB))
46033 IF (EXTRA) SUM=0.5*(SUM+D(M+2))
46036 SUM=D(J)+(X-T(J))*SUM
46042 *CMZ :- -26/04/91 10.18.58 by Bryan Webber
46043 *-- Author : Bryan Webber
46044 C-----------------------------------------------------------------------
46045 FUNCTION HWSVAL(ID)
46046 C-----------------------------------------------------------------------
46047 C TRUE FOR VALENCE PARTON ID IN INCOMING HADRON INHAD
46048 C-----------------------------------------------------------------------
46049 INCLUDE 'HERWIG65.INC'
46054 IF (IDHAD.EQ.73.OR.IDHAD.EQ.75) THEN
46055 IF (ID.EQ.1.OR.ID.EQ.2) HWSVAL=.TRUE.
46056 ELSEIF (IDHAD.EQ.91.OR.IDHAD.EQ.93) THEN
46057 IF (ID.EQ.7.OR.ID.EQ.8) HWSVAL=.TRUE.
46058 ELSEIF (IDHAD.EQ.30) THEN
46059 IF (ID.EQ.1.OR.ID.EQ.8) HWSVAL=.TRUE.
46060 ELSEIF (IDHAD.EQ.38) THEN
46061 IF (ID.EQ.2.OR.ID.EQ.7) HWSVAL=.TRUE.
46062 ELSEIF (IDHAD.EQ.59) THEN
46063 IF (ID.LT.6.OR.(ID.GT.6.AND.ID.LT.12)) HWSVAL=.TRUE.
46064 ELSEIF (IDHAD.EQ.71.OR.IDHAD.EQ.72) THEN
46065 IF (ID.EQ.13) HWSVAL=.TRUE.
46067 CALL HWWARN('HWSVAL',100,*999)
46071 *CMZ :- -23/08/94 13.22.29 by Mike Seymour
46072 *-- Author : Ian Knowles
46073 C-----------------------------------------------------------------------
46074 FUNCTION HWUAEM(Q2)
46075 C-----------------------------------------------------------------------
46076 C Running electromagnetic coupling constant.
46077 C See R. Kleiss et al.: CERN yellow report 89-08, vol.3 p.129
46078 C Hadronic component from: H. Burkhardt et al.: Z. Phys C43 (89) 497
46079 C-----------------------------------------------------------------------
46080 INCLUDE 'HERWIG65.INC'
46081 DOUBLE PRECISION HWUAEM,HWUAER,Q2,EPS,A1,B1,C1,A2,B2,C2,A3,B3,C3,
46082 & A4,B4,C4,AEMPI,EEL2,EMU2,ETAU2,ETOP2,REPIGG,X
46085 SAVE FIRST,AEMPI,EEL2,EMU2,ETAU2,ETOP2
46086 PARAMETER (EPS=1.D-6)
46087 DATA A1,B1,C1/0.0 D0,0.00835D0,1.000D0/
46088 DATA A2,B2,C2/0.0 D0,0.00238D0,3.927D0/
46089 DATA A3,B3,C3/0.00165D0,0.00299D0,1.000D0/
46090 DATA A4,B4,C4/0.00221D0,0.00293D0,1.000D0/
46093 AEMPI=ALPHEM/(THREE*PIFAC)
46094 EEL2 =RMASS(121)**2
46095 EMU2 =RMASS(123)**2
46096 ETAU2=RMASS(125)**2
46100 IF (ABS(Q2).LT.EPS) THEN
46104 C Leptonic component
46105 REPIGG=AEMPI*(HWUAER(EEL2/Q2)+HWUAER(EMU2/Q2)+HWUAER(ETAU2/Q2))
46106 C Hadronic component from light quarks
46108 IF (X.LT.9.D-2) THEN
46109 REPIGG=REPIGG+A1+B1*LOG(ONE+C1*X)
46110 ELSEIF (X.LT.9.D0) THEN
46111 REPIGG=REPIGG+A2+B2*LOG(ONE+C2*X)
46112 ELSEIF (X.LT.1.D4) THEN
46113 REPIGG=REPIGG+A3+B3*LOG(ONE+C3*X)
46115 REPIGG=REPIGG+A4+B4*LOG(ONE+C4*X)
46118 REPIGG=REPIGG+AEMPI*HWUAER(ETOP2/Q2)
46119 HWUAEM=ALPHEM/(ONE-REPIGG)
46123 *CMZ :- -23/08/94 13.22.29 by Mike Seymour
46124 *-- Author : Ian Knowles
46125 C-----------------------------------------------------------------------
46127 C-----------------------------------------------------------------------
46128 C Real part of photon self-energy: Pi_{gg}(R=M^2/Q^2)
46129 C-----------------------------------------------------------------------
46130 DOUBLE PRECISION HWUAER,R,ZERO,ONE,TWO,FOUR,FVTHR,THIRD,RMAX,BETA
46131 PARAMETER (ZERO=0.D0, ONE=1.D0, TWO=2.D0, FOUR=4.D0,
46132 & FVTHR=1.666666666666667D0, THIRD=.3333333333333333D0)
46133 PARAMETER (RMAX=1.D6)
46134 IF (ABS(R).LT.1.D-3) THEN
46135 C Use assymptotic formula
46136 HWUAER=-FVTHR-LOG(ABS(R))
46137 ELSEIF (ABS(R).GT.RMAX) THEN
46139 ELSEIF (FOUR*R.GT.ONE) THEN
46140 BETA=SQRT(FOUR*R-ONE)
46142 & -(ONE+TWO*R)*(TWO-BETA*ACOS(ONE-ONE/(TWO*R)))
46144 BETA=SQRT(ONE-FOUR*R)
46146 & -(ONE+TWO*R)*(TWO+BETA*LOG(ABS((BETA-ONE)/(BETA+ONE))))
46151 *CMZ :- -15/07/92 14.08.45 by Mike Seymour
46152 *-- Author : Bryan Webber
46153 C-----------------------------------------------------------------------
46154 FUNCTION HWUALF(IOPT,SCALE)
46155 C-----------------------------------------------------------------------
46156 C STRONG COUPLING CONSTANT
46157 C IOPT.EQ.0 INITIALIZES
46158 C .EQ.1 TWO-LOOP, FLAVOUR THRESHOLDS
46159 C .EQ.2 RATIO OF ABOVE TO ONE-LOOP
46160 C WITH 5-FLAVOUR BETA, LAMBDA=QCDL3
46161 C .EQ.3 ONE-LOOP WITH 5-FLAVOUR BETA, LAMBDA=QCDL3
46162 C-----------------------------------------------------------------------
46163 INCLUDE 'HERWIG65.INC'
46164 DOUBLE PRECISION HWUALF,SCALE,KAFAC,B3,B4,B5,B6,C3,C4,C5,C6,C35,
46165 & C45,C65,D35,RHO,RAT,RLF,DRH,EPS
46167 SAVE B3,B4,B5,B6,C3,C4,C5,C6,C35,C45,C65,D35
46169 IF (IOPT.EQ.0) THEN
46170 C---INITIALIZE CONSTANTS
46172 CFFAC=FLOAT(NCOLO**2-1)/(2.*CAFAC)
46173 B3=((11.*CAFAC)- 6.)/(12.*PIFAC)
46174 B4=((11.*CAFAC)- 8.)/(12.*PIFAC)
46175 B5=((11.*CAFAC)-10.)/(12.*PIFAC)
46176 B6=((11.*CAFAC)-12.)/(12.*PIFAC)
46178 C3=((17.*CAFAC**2)-(5.*CAFAC+3.*CFFAC)*3.)/(24.*PIFAC**2)/B3**2
46179 C4=((17.*CAFAC**2)-(5.*CAFAC+3.*CFFAC)*4.)/(24.*PIFAC**2)/B4**2
46180 C5=((17.*CAFAC**2)-(5.*CAFAC+3.*CFFAC)*5.)/(24.*PIFAC**2)/B5**2
46181 C6=((17.*CAFAC**2)-(5.*CAFAC+3.*CFFAC)*6.)/(24.*PIFAC**2)/B6**2
46182 KAFAC=CAFAC*(67./18.-PIFAC**2/6.)-25./9.
46183 C---QCDLAM IS 5-FLAVOUR LAMBDA-MS-BAR AT LARGE X OR Z
46184 C---QCDL5 IS 5-FLAVOUR LAMBDA-MC
46185 QCDL5=QCDLAM*EXP(KAFAC/(4.*PIFAC*B5))/SQRT(2.D0)
46186 C---COMPUTE THRESHOLD MATCHING
46187 RHO=2.*LOG(RMASS(6)/QCDL5)
46189 C65=(B5/(1.-C5*RAT)-B6/(1.-C6*RAT))*RHO
46190 RHO=2.*LOG(RMASS(5)/QCDL5)
46192 C45=(B5/(1.-C5*RAT)-B4/(1.-C4*RAT))*RHO
46193 RHO=2.*LOG(RMASS(4)/QCDL5)
46195 C35=(B4/(1.-C4*RAT)-B3/(1.-C3*RAT))*RHO+C45
46200 RLF=B3*D35/(1.-C3*RAT)
46201 DRH=B3*(RLF+C35)*D35**2/((1.-2.*C3*RAT+C3/D35)*RLF**2)
46203 IF (ABS(DRH).LT.EPS*D35) GOTO 20
46205 20 QCDL3=QCDL5*EXP(0.5*D35)
46207 IF (SCALE.LE.QCDL5) CALL HWWARN('HWUALF',51,*999)
46208 RHO=2.*LOG(SCALE/QCDL5)
46209 IF (IOPT.EQ.3) THEN
46210 IF (RHO.LE.D35) CALL HWWARN('HWUALF',52,*999)
46211 HWUALF=1./(B5*(RHO-D35))
46215 IF (SCALE.GT.RMASS(6)) THEN
46216 RLF=B6*RHO/(1.-C6*RAT)+C65
46217 ELSEIF (SCALE.GT.RMASS(5)) THEN
46218 RLF=B5*RHO/(1.-C5*RAT)
46219 ELSEIF (SCALE.GT.RMASS(4)) THEN
46220 RLF=B4*RHO/(1.-C4*RAT)+C45
46222 RLF=B3*RHO/(1.-C3*RAT)+C35
46224 IF (RLF.LE.ZERO) CALL HWWARN('HWUALF',53,*999)
46225 IF (IOPT.EQ.1) THEN
46228 HWUALF=B5*(RHO-D35)/RLF
46229 IF (HWUALF.GT.ONE) CALL HWWARN('HWUALF',54,*999)
46235 *CMZ :- -27/07/99 13.33.03 by Mike Seymour
46236 *-- Author : Ian Knowles
46237 C-----------------------------------------------------------------------
46238 FUNCTION HWUANT(IPART)
46239 C-----------------------------------------------------------------------
46240 C Returns the antiparticle of IPART; uses HERWIG numbering
46241 C-----------------------------------------------------------------------
46242 INCLUDE 'HERWIG65.INC'
46243 INTEGER HWUANT,IPART,IPDG,IANTI,OLDERR
46247 IF (IPDG.EQ. 9.OR.IPDG.EQ.21.OR.IPDG.EQ.22.OR.IPDG.EQ.23.OR.
46248 & IPDG.EQ.25.OR.IPDG.EQ.26.OR.IPDG.EQ.32.OR.IPDG.EQ.35.OR.
46249 & IPDG.EQ.36.OR.IPDG.EQ.39.OR.IPDG.EQ.91.OR.IPDG.EQ.98.OR.
46250 & IPDG.EQ.99.OR.IPDG.EQ.130.OR.IPDG.EQ.310.OR.
46251 & IPDG.EQ.1000021.OR.IPDG.EQ.1000022.OR.IPDG.EQ.1000023.OR.
46252 & IPDG.EQ.1000025.OR.IPDG.EQ.1000035.OR.IPDG.EQ.1000039.OR.
46253 & (FLOAT(INT(RSPIN(IPART))).EQ.RSPIN(IPART).AND.
46254 & MOD(IPDG/100,10).EQ.MOD(IPDG/10,10).AND.
46255 & MOD(IPDG/10,10).NE.0)) THEN
46256 C Self-conjugate boson
46258 ELSEIF(IPART.EQ.211.OR.IPART.EQ.212) THEN
46259 C Fourth generation (anti-)quarks
46261 ELSEIF(IPART.EQ.217.OR.IPART.EQ.218) THEN
46264 C Non-zero charge particle
46265 CALL HWUIDT(1,-IPDG,IANTI,CDUM)
46267 IF (IANTI.EQ.20) WRITE(6,10) RNAME(IPART)
46268 10 FORMAT(1X,A8,' has no antiparticle'/)
46273 *CMZ :- -07/07/99 17.42.00 by Kosuke Odagiri
46274 *-- Author : Kosuke Odagiri
46275 C-----------------------------------------------------------------------
46277 C-----------------------------------------------------------------------
46278 C Replaces all &'s in TXNAME by backslashes
46279 C-----------------------------------------------------------------------
46280 INCLUDE 'HERWIG65.INC'
46287 IF (TXNAME(1,I)(J:J).EQ.'&') TXNAME(1,I)(J:J)=Z
46292 *CMZ :- -26/04/91 10.18.58 by Bryan Webber
46293 *-- Author : Bryan Webber
46294 C-----------------------------------------------------------------------
46296 C-----------------------------------------------------------------------
46297 C PRINTS OUT DATA ON PARTON SHOWER
46298 C-----------------------------------------------------------------------
46299 INCLUDE 'HERWIG65.INC'
46302 WRITE(6,10) INHAD,XFACT
46303 10 FORMAT(///10X,'DATA ON LAST PARTON SHOWER: INHAD =',I3,
46304 & ' XFACT =',E11.3//' IPAR ID TM DA1 CMO AMO CDA',
46305 & ' ADA P-X P-Y P-Z ENERGY MASS',
46306 & ' V-X V-Y V-Z V-C*T')
46308 20 WRITE(6,30) J,RNAME(ABS(IDPAR(J))),TMPAR(J),JDAPAR(1,J),
46309 & (JCOPAR(I,J),I=1,4),(PPAR(I,J),I=1,5),(VPAR(I,J),I=1,4)
46310 30 FORMAT(I5,1X,A8,L2,5I4,F7.2,4F8.2,4E11.4)
46312 WRITE(6,40) INHAD,XFACT
46313 40 FORMAT(///10X,'DATA ON LAST PARTON SHOWER: INHAD =',I3,
46314 & ' XFACT =',E11.3//' IPAR ID TM DA1 CMO AMO CDA',
46315 & ' ADA P-X P-Y P-Z ENERGY MASS')
46317 50 WRITE(6,60) J,RNAME(ABS(IDPAR(J))),TMPAR(J),JDAPAR(1,J),
46318 & (JCOPAR(I,J),I=1,4),(PPAR(I,J),I=1,5)
46319 60 FORMAT(I5,1X,A8,L2,5I4,F7.2,4F8.2)
46323 *CMZ :- -18/10/93 10.21.56 by Mike Seymour
46324 *-- Author : Mike Seymour
46325 C-----------------------------------------------------------------------
46326 SUBROUTINE HWUBST(IOPT)
46327 C-----------------------------------------------------------------------
46328 C BOOST THE ENTIRE EVENT RECORD TO (IOPT=1) OR FROM (IOPT=0) ITS
46329 C CENTRE-OF-MASS FRAME, WITH INCOMING HADRONS ON Z-AXIS
46330 C-----------------------------------------------------------------------
46331 INCLUDE 'HERWIG65.INC'
46332 DOUBLE PRECISION PBOOST(5),RBOOST(3,3)
46333 INTEGER IOPT,IHEP,BOOSTD,IHAD
46334 SAVE BOOSTD,PBOOST,RBOOST
46336 IF (IERROR.NE.0) RETURN
46337 IF (IOPT.EQ.1) THEN
46338 C---FIND FIRST INCOMING HADRON
46340 IF (JDAHEP(1,IHAD).NE.0) IHAD=JDAHEP(1,IHAD)
46341 C---IF WE'RE ALREADY IN THE RIGHT FRAME, DON'T DO ANYTHING
46342 IF (PHEP(1,3)**2+PHEP(2,3)**2+PHEP(3,3)**2.EQ.ZERO .AND.
46343 & PHEP(1,IHAD)**2+PHEP(2,IHAD)**2.EQ.ZERO) RETURN
46344 C---FIND AND APPLY BOOST
46345 CALL HWVEQU(5,PHEP(1,3),PBOOST)
46347 CALL HWULOF(PBOOST,PHEP(1,IHEP),PHEP(1,IHEP))
46348 CALL HWULOF(PBOOST,VHEP(1,IHEP),VHEP(1,IHEP))
46350 CALL HWULOF(PBOOST,VTXPIP,VTXPIP)
46351 C---FIND AND APPLY ROTATION TO PUT IT ON Z-AXIS
46352 CALL HWUROT(PHEP(1,IHAD),ONE,ZERO,RBOOST)
46354 CALL HWUROF(RBOOST,PHEP(1,IHEP),PHEP(1,IHEP))
46355 CALL HWUROF(RBOOST,VHEP(1,IHEP),VHEP(1,IHEP))
46357 CALL HWUROF(RBOOST,VTXPIP,VTXPIP)
46358 C---ENSURE THAT WE ONLY EVER UNBOOST THE SAME EVENT THAT WE BOOSTED
46359 C (BEARING IN MIND THAT NWGTS IS UPDATED AFTER GENERATING THE WEIGHT)
46361 ELSEIF (IOPT.EQ.0) THEN
46362 IF (BOOSTD.NE.NWGTS) RETURN
46363 C---UNDO ROTATION AND BOOST
46365 CALL HWUROB(RBOOST,PHEP(1,IHEP),PHEP(1,IHEP))
46366 CALL HWULOB(PBOOST,PHEP(1,IHEP),PHEP(1,IHEP))
46367 CALL HWUROB(RBOOST,VHEP(1,IHEP),VHEP(1,IHEP))
46368 CALL HWULB4(PBOOST,VHEP(1,IHEP),VHEP(1,IHEP))
46373 *CMZ :- -23/08/94 13.22.29 by Mike Seymour
46374 *-- Author : Bryan Webber and Ian Knowles
46375 C-----------------------------------------------------------------------
46376 SUBROUTINE HWUCFF(I,J,QSQ,CLF)
46377 C-----------------------------------------------------------------------
46378 C Calculates basic coefficients in cross-section formula for
46379 C ffbar --> f'fbar', at virtuality QSQ, I labels initial, J
46380 C labels final fermion; type given as:
46381 C I,J= 1- 6: d,u,s,c,b,t
46382 C =11-16: e,nu_e,mu,nu_mu,tau,nu_tau
46383 C-----------------------------------------------------------------------
46384 INCLUDE 'HERWIG65.INC'
46385 DOUBLE PRECISION QSQ,CLF(7),POL1,POL2,QIF,VI,AI,VF,AF,PG,DQM,PMW,
46386 & DEN,XRE,XIM,XSQ,VI2,AI2,VF2,AF2,PG2,PG12,DQM2,PMW2,DEN2,XRE2,
46387 & XIM2,XSQ2,XRE12,XIM12
46389 C Longitudinal Polarisation factors
46390 POL1=1.-EPOLN(3)*PPOLN(3)
46391 POL2=PPOLN(3)-EPOLN(3)
46392 C Standard model couplings
46393 QIF=QFCH(I)*QFCH(J)
46398 PG=POL1*(VI**2+AI**2)+POL2*2.*VI*AI
46399 C Z propagator factors
46400 DQM=QSQ-RMASS(200)**2
46401 PMW=GAMZ*RMASS(200)
46402 DEN=QSQ/(DQM**2+PMW**2)
46406 C Calculate cross-section coefficients
46407 CLF(1)=POL1*QIF**2+XRE*2.*QIF*(POL1*VI+POL2*AI)*VF
46408 & +XSQ*PG*(VF**2+AF**2)
46409 CLF(2)=CLF(1)-2.*XSQ*PG*AF**2
46410 CLF(3)=2.*(XRE*QIF*(POL1*AI+POL2*VI)*AF
46411 & +XSQ*(POL1*2.*VI*AI+POL2*(VI**2+AI**2))*VF*AF)
46413 CLF(4)=QIF**2+XRE*2.*QIF*VI*VF+XSQ*(VI**2-AI**2)*(VF**2+AF**2)
46414 CLF(5)=CLF(4)-2.*XSQ*(VI**2-AI**2)*AF**2
46415 CLF(6)=XIM*2.*QIF*AI*VF
46424 PG2=POL1*(VI2**2+AI2**2)+POL2*2.*VI2*AI2
46425 PG12=POL1*(VI*VI2+AI*AI2)+POL2*(VI*AI2+AI+VI2)
46426 C Z' propagator factors
46427 DQM2=QSQ-RMASS(202)**2
46428 PMW2=RMASS(202)*GAMZP
46429 DEN2=QSQ/(DQM2**2+PMW2**2)
46433 XRE12=DEN*DEN2*(DQM*DQM2+PMW*PMW2)
46434 XIM12=DEN*DEN2*(DQM*PMW2-DQM2*PMW)
46435 C Additional contributions to cross-section coefficients
46436 CLF(1)=CLF(1)+XRE2*2.*QIF*(POL1*VI2+POL2*AI2)*VF2
46437 & +XSQ2*PG2*(VF2**2+AF2**2)+XRE12*2.*PG12*(VF*VF2+AF*AF2)
46438 CLF(2)=CLF(1)-2.*(XSQ2*PG2*AF2**2+XRE12*2.*PG12*AF*AF2)
46439 CLF(3)=CLF(3)+2.*(XRE2*QIF*(POL1*AI2+POL2*VI2)*AF2
46440 & +XSQ2*(POL1*2.*VI2*AI2+POL2*(VI2**2+AI2**2))*VF2*AF2
46441 & +XRE12*(POL1*(VI*AI2+AI*VI2)+POL1*(VI*VI2+AI*AI2))
46442 & *(VF*VF2+AF*AF2))
46444 CLF(4)=CLF(4)+XRE2*2.*QIF*VI2*VF2
46445 & +XSQ2*(VI2**2-AI2**2)*(VF2**2+AF2**2)
46446 & +XRE12*2.*(VI*VI2-AI*AI2)*(VF*VF2+AF*AF2)
46447 CLF(5)=CLF(4)-2*(XSQ2*(VI2**2-AI2**2)*AF2**2
46448 & +XRE12*2.*(VI*VI2-AI*AI2)*AF*AF2)
46449 CLF(6)=CLF(6)+2.*(XIM2*QIF*AI2*VF2
46450 & -XIM12*(VI*AI2-AI*VI2)*(VF*VF2+AF*AF2))
46451 CLF(7)=CLF(6)+4.*XIM12*(VI*AI2-AI*AI2)*AF*AF2
46457 *CMZ :- -23/08/94 13.22.29 by Mike Seymour
46458 *-- Author : Ulrich Baur & Nigel Glover, adapted by Ian Knowles
46459 C-----------------------------------------------------------------------
46460 FUNCTION HWUCI2(A,B,Y0)
46461 C-----------------------------------------------------------------------
46462 C Integral LOG(A-EPSI-BY(1-Y))/(Y-Y0)
46463 C-----------------------------------------------------------------------
46465 DOUBLE COMPLEX HWUCI2,HWULI2,EPSI,Y1,Y2,Z1,Z2,Z3,Z4
46466 DOUBLE PRECISION A,B,Y0,ZERO,ONE,FOUR,HALF
46469 PARAMETER (ZERO=0.D0, ONE =1.D0, FOUR= 4.D0, HALF=0.5D0)
46471 HWUCI2=DCMPLX(ZERO,ZERO)
46473 Y1=HALF*(ONE+SQRT(ONE-FOUR*(A+EPSI)/B))
46476 Z2=(Y0-ONE)/(Y0-Y1)
46478 Z4=(Y0-ONE)/(Y0-Y2)
46479 HWUCI2=HWULI2(Z1)-HWULI2(Z2)+HWULI2(Z3)-HWULI2(Z4)
46484 *CMZ :- -26/04/91 10.18.58 by Bryan Webber
46485 *-- Author : Ian Knowles & Bryan Webber
46486 C-----------------------------------------------------------------------
46488 C-----------------------------------------------------------------------
46489 C Loads common blocks with particle properties data; for particle I:
46491 C IDPDG(I) = PDG code
46492 C IFLAV(I) = HERWIG flavour code
46493 C ICHRG(I) = Electric charge (|e-|) (*3 for (di-)quarks)
46494 C RMASS(I) = Mass (GeV/c^2)
46495 C RLTIM(I) = Proper life time (s)
46497 C QORQQB(I) = .TRUE. if it is a quark or an antidiquark
46498 C QBORQQ(I) = .TRUE. if it is an antiquark or a diquark
46499 C And stores the particle decay tables: call HWUDPR to print them
46500 C-----------------------------------------------------------------------
46501 INCLUDE 'HERWIG65.INC'
46502 INTEGER NLAST,NNEXT,NLEFT,NREST,I,J,MMWIDE,MMLONG,MMHOFF,MMVOFF
46503 COMMON/PAPER/MMWIDE,MMLONG,MMHOFF,MMVOFF
46504 PARAMETER (NLAST=458,NNEXT=458+1,NLEFT=NMXRES-458)
46505 PARAMETER (NREST=NMXRES-120)
46507 C Don't forget to change the three occurances above as well
46508 DATA MMWIDE,MMLONG,MMHOFF,MMVOFF/190,280,-39,-35/
46509 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
46510 & RSPIN(I),I=0,16)/
46511 & ' ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
46512 & 'DQRK ', 1, 0,-1,0.3200D0,0.000D+00,0.5D0,
46513 & 'UQRK ', 2, 0,+2,0.3200D0,0.000D+00,0.5D0,
46514 & 'SQRK ', 3, 0,-1,0.5000D0,0.000D+00,0.5D0,
46515 & 'CQRK ', 4, 0,+2,1.5500D0,0.000D+00,0.5D0,
46516 & 'BQRK ', 5, 0,-1,4.9500D0,0.000D+00,0.5D0,
46517 & 'TQRK ', 6, 0,+2,174.30D0,4.000D-25,0.5D0,
46518 & 'DBAR ', -1, 0,+1,0.3200D0,0.000D+00,0.5D0,
46519 & 'UBAR ', -2, 0,-2,0.3200D0,0.000D+00,0.5D0,
46520 & 'SBAR ', -3, 0,+1,0.5000D0,0.000D+00,0.5D0,
46521 & 'CBAR ', -4, 0,-2,1.5500D0,0.000D+00,0.5D0,
46522 & 'BBAR ', -5, 0,+1,4.9500D0,0.000D+00,0.5D0,
46523 & 'TBAR ', -6, 0,-2,174.30D0,4.000D-25,0.5D0,
46524 & 'GLUON ', 21, 0, 0,0.7500D0,0.000D+00,1.0D0,
46525 & 'CMF ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
46526 & 'HARD ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
46527 & 'SOFT ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0/
46528 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
46529 & RSPIN(I),I=17,32)/
46530 & 'CONE ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
46531 & 'HEAVY ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
46532 & 'CLUS ', 91, 0, 0,0.0000D0,0.000D+00,0.0D0,
46533 & '**** ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
46534 & 'PI0 ', 111, 11, 0,.13498D0,8.400D-17,0.0D0,
46535 & 'ETA ', 221, 33, 0,.54730D0,0.000D+00,0.0D0,
46536 & 'RHO0 ', 113, 11, 0,.77000D0,0.000D+00,1.0D0,
46537 & 'OMEGA ', 223, 33, 0,.78194D0,0.000D+00,1.0D0,
46538 & 'ETAP ', 331, 33, 0,.95778D0,0.000D+00,0.0D0,
46539 & 'F_2 ', 225, 33, 0,1.2750D0,0.000D+00,2.0D0,
46540 & 'A_10 ', 20113, 11, 0,1.2300D0,0.000D+00,1.0D0,
46541 & 'FL_1 ', 20223, 33, 0,1.2819D0,0.000D+00,1.0D0,
46542 & 'A_20 ', 115, 11, 0,1.3181D0,0.000D+00,2.0D0,
46543 & 'PI- ', -211, 12,-1,.13957D0,2.603D-08,0.0D0,
46544 & 'RHO- ', -213, 12,-1,.77000D0,0.000D+00,1.0D0,
46545 & 'A_1- ', -20213, 12,-1,1.2300D0,0.000D+00,1.0D0/
46546 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
46547 & RSPIN(I),I=33,48)/
46548 & 'A_2- ', -215, 12,-1,1.3181D0,0.000D+00,2.0D0,
46549 & 'K- ', -321, 32,-1,.49368D0,1.237D-08,0.0D0,
46550 & 'K*- ', -323, 32,-1,.89166D0,0.000D+00,1.0D0,
46551 & 'KH_1- ', -20323, 32,-1,1.8500D0,0.000D+00,1.0D0,
46552 & 'K*_2- ', -325, 32,-1,1.4256D0,0.000D+00,2.0D0,
46553 & 'PI+ ', 211, 21,+1,.13957D0,2.603D-08,0.0D0,
46554 & 'RHO+ ', 213, 21,+1,.77000D0,0.000D+00,1.0D0,
46555 & 'A_1+ ', 20213, 21,+1,1.2300D0,0.000D+00,1.0D0,
46556 & 'A_2+ ', 215, 21,+1,1.3181D0,0.000D+00,2.0D0,
46557 & 'KBAR0 ', -311, 31, 0,.49767D0,0.000D+00,0.0D0,
46558 & 'K*BAR0 ', -313, 31, 0,.89610D0,0.000D+00,1.0D0,
46559 & 'KH_1BAR0', -20313, 31, 0,1.8500D0,0.000D+00,1.0D0,
46560 & 'K*_2BAR0', -315, 31, 0,1.4324D0,0.000D+00,2.0D0,
46561 & 'K+ ', 321, 23,+1,.49368D0,1.237D-08,0.0D0,
46562 & 'K*+ ', 323, 23,+1,.89166D0,0.000D+00,1.0D0,
46563 & 'KH_1+ ', 20323, 23,+1,1.8500D0,0.000D+00,1.0D0/
46564 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
46565 & RSPIN(I),I=49,64)/
46566 & 'K*_2+ ', 325, 23,+1,1.4256D0,0.000D+00,2.0D0,
46567 & 'K0 ', 311, 13, 0,.49767D0,0.000D+00,0.0D0,
46568 & 'K*0 ', 313, 13, 0,.89610D0,0.000D+00,1.0D0,
46569 & 'KH_10 ', 20313, 13, 0,1.8500D0,0.000D+00,1.0D0,
46570 & 'K*_20 ', 315, 13, 0,1.4324D0,0.000D+00,2.0D0,
46571 & ' ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
46572 & ' ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
46573 & 'PHI ', 333, 33, 0,1.0194D0,0.000D+00,1.0D0,
46574 & 'FH_1 ', 20333, 33, 0,1.4262D0,0.000D+00,1.0D0,
46575 & 'FP_2 ', 335, 33, 0,1.5250D0,0.000D+00,2.0D0,
46576 & 'GAMMA ', 22, 0, 0,0.0000D0,1.000D+30,1.0D0,
46577 & 'K_S0 ', 310, 0, 0,.49767D0,8.926D-11,0.0D0,
46578 & 'K_L0 ', 130, 0, 0,.49767D0,5.170D-08,0.0D0,
46579 & 'A_0(H)0 ', 10111, 11, 0,1.4740D0,0.000D+00,0.0D0,
46580 & 'A_0(H)+ ', 10211, 21,+1,1.4740D0,0.000D+00,0.0D0,
46581 & 'A_0(H)- ', -10211, 12,-1,1.4740D0,0.000D+00,0.0D0/
46582 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
46583 & RSPIN(I),I=65,80)/
46584 & ' ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
46585 & ' ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
46586 & ' ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
46587 & ' ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
46588 & ' ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
46589 & ' ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
46590 & 'REMG ', 98, 0, 0,0.0000D0,0.000D+00,0.0D0,
46591 & 'REMN ', 99, 0, 0,0.0000D0,0.000D+00,0.0D0,
46592 & 'P ', 2212, 122,+1,.93827D0,1.000D+30,0.5D0,
46593 & 'DELTA+ ', 2214, 122,+1,1.2320D0,0.000D+00,1.5D0,
46594 & 'N ', 2112, 112, 0,.93957D0,8.870D+02,0.5D0,
46595 & 'DELTA0 ', 2114, 112, 0,1.2320D0,0.000D+00,1.5D0,
46596 & 'DELTA- ', 1114, 111,-1,1.2320D0,0.000D+00,1.5D0,
46597 & 'LAMBDA ', 3122, 123, 0,1.1157D0,2.632D-10,0.5D0,
46598 & 'SIGMA0 ', 3212, 123, 0,1.1926D0,7.400D-20,0.5D0,
46599 & 'SIGMA*0 ', 3214, 123, 0,1.3837D0,0.000D+00,1.5D0/
46600 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
46601 & RSPIN(I),I=81,96)/
46602 & 'SIGMA- ', 3112, 113,-1,1.1974D0,1.479D-10,0.5D0,
46603 & 'SIGMA*- ', 3114, 113,-1,1.3872D0,0.000D+00,1.5D0,
46604 & 'XI- ', 3312, 133,-1,1.3213D0,1.639D-10,0.5D0,
46605 & 'XI*- ', 3314, 133,-1,1.5350D0,0.000D+00,1.5D0,
46606 & 'DELTA++ ', 2224, 222,+2,1.2320D0,0.000D+00,1.5D0,
46607 & 'SIGMA+ ', 3222, 223,+1,1.1894D0,7.990D-11,0.5D0,
46608 & 'SIGMA*+ ', 3224, 223,+1,1.3828D0,0.000D+00,1.5D0,
46609 & 'XI0 ', 3322, 233, 0,1.3149D0,2.900D-10,0.5D0,
46610 & 'XI*0 ', 3324, 233, 0,1.5318D0,0.000D+00,1.5D0,
46611 & 'OMEGA- ', 3334, 333,-1,1.6725D0,8.220D-11,1.5D0,
46612 & 'PBAR ', -2212,-122,-1,.93827D0,1.000D+30,0.5D0,
46613 & 'DELTABR-', -2214,-122,-1,1.2320D0,0.000D+00,1.5D0,
46614 & 'NBAR ', -2112,-112, 0,.93957D0,8.870D+02,0.5D0,
46615 & 'DELTABR0', -2114,-112, 0,1.2320D0,0.000D+00,1.5D0,
46616 & 'DELTABR+', -1114,-111,+1,1.2320D0,0.000D+00,1.5D0,
46617 & 'LAMBDABR', -3122,-123, 0,1.1157D0,2.632D-10,0.5D0/
46618 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
46619 & RSPIN(I),I=97,112)/
46620 & 'SIGMABR0', -3212,-123, 0,1.1926D0,7.400D-20,0.5D0,
46621 & 'SGMA*BR0', -3214,-123, 0,1.3837D0,0.000D+00,1.5D0,
46622 & 'SIGMABR+', -3112,-113,+1,1.1974D0,1.479D-10,0.5D0,
46623 & 'SGMA*BR+', -3114,-113,+1,1.3872D0,0.000D+00,1.5D0,
46624 & 'XIBAR+ ', -3312,-133,+1,1.3213D0,1.639D-10,0.5D0,
46625 & 'XI*BAR+ ', -3314,-133,+1,1.5350D0,0.000D+00,1.5D0,
46626 & 'DLTABR--', -2224,-222,-2,1.2320D0,0.000D+00,1.5D0,
46627 & 'SIGMABR-', -3222,-223,-1,1.1894D0,7.990D-11,0.5D0,
46628 & 'SGMA*BR-', -3224,-223,-1,1.3828D0,0.000D+00,1.5D0,
46629 & 'XIBAR0 ', -3322,-233, 0,1.3149D0,2.900D-10,0.5D0,
46630 & 'XI*BAR ', -3324,-233, 0,1.5318D0,0.000D+00,1.5D0,
46631 & 'OMEGABR+', -3334,-333,+1,1.6725D0,8.220D-11,1.5D0,
46632 & 'UU ', 2203, 0,+4,0.6400D0,0.000D+00,0.0D0,
46633 & 'UD ', 2101, 0,+1,0.6400D0,0.000D+00,0.0D0,
46634 & 'DD ', 1103, 0,-2,0.6400D0,0.000D+00,0.0D0,
46635 & 'US ', 3201, 0,+1,0.8200D0,0.000D+00,0.0D0/
46636 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
46637 & RSPIN(I),I=113,128)/
46638 & 'DS ', 3101, 0,-2,0.8200D0,0.000D+00,0.0D0,
46639 & 'SS ', 3303, 0,-2,1.0000D0,0.000D+00,0.0D0,
46640 & 'UBARUBAR', -2203, 0,-4,0.6400D0,0.000D+00,0.0D0,
46641 & 'UBARDBAR', -2101, 0,-1,0.6400D0,0.000D+00,0.0D0,
46642 & 'DBARDBAR', -1103, 0,+2,0.6400D0,0.000D+00,0.0D0,
46643 & 'UBARSBAR', -3201, 0,-1,0.8200D0,0.000D+00,0.0D0,
46644 & 'DBARSBAR', -3101, 0,+2,0.8200D0,0.000D+00,0.0D0,
46645 & 'SBARSBAR', -3303, 0,+2,1.0000D0,0.000D+00,0.0D0,
46646 & 'E- ', 11, 0,-1,5.11D-04,1.000D+30,0.5D0,
46647 & 'NU_E ', 12, 0, 0,0.0000D0,1.000D+30,0.5D0,
46648 & 'MU- ', 13, 0,-1,.10566D0,2.197D-06,0.5D0,
46649 & 'NU_MU ', 14, 0, 0,0.0000D0,1.000D+30,0.5D0,
46650 & 'TAU- ', 15, 0,-1,1.7771D0,2.916D-13,0.5D0,
46651 & 'NU_TAU ', 16, 0, 0,0.0000D0,1.000D+30,0.5D0,
46652 & 'E+ ', -11, 0,+1,5.11D-04,1.000D+30,0.5D0,
46653 & 'NU_EBAR ', -12, 0, 0,0.0000D0,1.000D+30,0.5D0/
46654 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
46655 & RSPIN(I),I=129,144)/
46656 & 'MU+ ', -13, 0,+1,.10566D0,2.197D-06,0.5D0,
46657 & 'NU_MUBAR', -14, 0, 0,0.0000D0,1.000D+30,0.5D0,
46658 & 'TAU+ ', -15, 0,+1,1.7771D0,2.916D-13,0.5D0,
46659 & 'NU_TAUBR', -16, 0, 0,0.0000D0,1.000D+30,0.5D0,
46660 & ' ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
46661 & ' ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
46662 & ' ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
46663 & 'D+ ', 411, 41,+1,1.8693D0,1.057D-12,0.0D0,
46664 & 'D*+ ', 413, 41,+1,2.0100D0,0.000D+00,1.0D0,
46665 & 'DH_1+ ', 20413, 41,+1,2.4270D0,0.000D+00,1.0D0,
46666 & 'D*_2+ ', 415, 41,+1,2.4590D0,0.000D+00,2.0D0,
46667 & 'D0 ', 421, 42, 0,1.8646D0,4.150D-13,0.0D0,
46668 & 'D*0 ', 423, 42, 0,2.0067D0,0.000D+00,1.0D0,
46669 & 'DH_10 ', 20423, 42, 0,2.4222D0,0.000D+00,1.0D0,
46670 & 'D*_20 ', 425, 42, 0,2.4589D0,0.000D+00,2.0D0,
46671 & 'D_S+ ', 431, 43,+1,1.9685D0,4.670D-13,0.0D0/
46672 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
46673 & RSPIN(I),I=145,160)/
46674 & 'D*_S+ ', 433, 43,+1,2.1124D0,0.000D+00,1.0D0,
46675 & 'DH_S1+ ', 20433, 43,+1,2.5354D0,0.000D+00,1.0D0,
46676 & 'D*_S2+ ', 435, 43,+1,2.5735D0,0.000D+00,2.0D0,
46677 & 'SGMA_C++', 4222, 224,+2,2.4528D0,0.000D+00,0.5D0,
46678 & 'SGM*_C++', 4224, 224,+2,2.5194D0,0.000D+00,1.5D0,
46679 & 'LMBDA_C+', 4122, 124,+1,2.2849D0,2.060D-13,0.5D0,
46680 & 'SIGMA_C+', 4212, 124,+1,2.4536D0,0.000D+00,0.5D0,
46681 & 'SGMA*_C+', 4214, 124,+1,2.5185D0,0.000D+00,1.5D0,
46682 & 'SIGMA_C0', 4112, 114, 0,2.4522D0,0.000D+00,0.5D0,
46683 & 'SGMA*_C0', 4114, 114, 0,2.5175D0,0.000D+00,1.5D0,
46684 & 'XI_C+ ', 4232, 234,+1,2.4656D0,3.500D-13,0.5D0,
46685 & 'XIP_C+ ', 4322, 234,+1,2.5750D0,0.000D+00,0.5D0,
46686 & 'XI*_C+ ', 4324, 234,+1,2.6446D0,0.000D+00,1.5D0,
46687 & 'XI_C0 ', 4132, 134, 0,2.4703D0,9.800D-14,0.5D0,
46688 & 'XIP_C0 ', 4312, 134, 0,2.5800D0,0.000D+00,0.5D0,
46689 & 'XI*_C0 ', 4314, 134, 0,2.6438D0,0.000D+00,1.5D0/
46690 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
46691 & RSPIN(I),I=161,176)/
46692 & 'OMEGA_C0', 4332, 334, 0,2.7040D0,6.400D-14,0.5D0,
46693 & 'OMGA*_C0', 4334, 334, 0,2.7300D0,0.000D+00,1.5D0,
46694 & 'ETA_C ', 441, 44, 0,2.9798D0,0.000D+00,0.0D0,
46695 & 'JPSI ', 443, 44, 0,3.0969D0,0.000D+00,1.0D0,
46696 & 'CHI_C1 ', 10441, 44, 0,3.4173D0,0.000D+00,0.0D0,
46697 & 'PSI2S ', 100443, 44, 0,3.6860D0,0.000D+00,1.0D0,
46698 & 'PSID ', 30443, 44, 0,3.7699D0,0.000D+00,1.0D0,
46699 & ' ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
46700 & ' ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
46701 & ' ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
46702 & 'D- ', -411, 14,-1,1.8693D0,1.057D-12,0.0D0,
46703 & 'D*- ', -413, 14,-1,2.0100D0,0.000D+00,1.0D0,
46704 & 'DH_1- ', -20413, 14,-1,2.4270D0,0.000D+00,1.0D0,
46705 & 'D*_2- ', -415, 14,-1,2.4590D0,0.000D+00,2.0D0,
46706 & 'DBAR0 ', -421, 24, 0,1.8646D0,4.140D-13,0.0D0,
46707 & 'D*BAR0 ', -423, 24, 0,2.0067D0,0.000D+00,1.0D0/
46708 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
46709 & RSPIN(I),I=177,192)/
46710 & 'DH_1BAR0', -20423, 24, 0,2.4222D0,0.000D+00,1.0D0,
46711 & 'D*_2BAR0', -425, 24, 0,2.4589D0,0.000D+00,2.0D0,
46712 & 'D_S- ', -431, 34,-1,1.9685D0,4.670D-13,0.0D0,
46713 & 'D*_S- ', -433, 34,-1,2.1124D0,0.000D+00,1.0D0,
46714 & 'DH_S1- ', -20433, 34,-1,2.5354D0,0.000D+00,1.0D0,
46715 & 'D*_S2- ', -435, 34,-1,2.5735D0,0.000D+00,2.0D0,
46716 & 'SGMA_C--', -4222,-224,-2,2.4528D0,0.000D+00,0.5D0,
46717 & 'SGM*_C--', -4224,-224,-2,2.5194D0,0.000D+00,1.5D0,
46718 & 'LMBDA_C-', -4122,-124,-1,2.2849D0,2.060D-13,0.5D0,
46719 & 'SIGMA_C-', -4212,-124,-1,2.4536D0,0.000D+00,0.5D0,
46720 & 'SGMA*_C-', -4214,-124,-1,2.5185D0,0.000D+00,1.5D0,
46721 & 'SGM_CBR0', -4112,-114, 0,2.4522D0,0.000D+00,0.5D0,
46722 & 'SG*_CBR0', -4114,-114, 0,2.5175D0,0.000D+00,1.5D0,
46723 & 'XI_C- ', -4232,-234,-1,2.4656D0,3.500D-13,0.5D0,
46724 & 'XIP_C- ', -4322,-234,-1,2.5750D0,0.000D+00,0.5D0,
46725 & 'XI*_C- ', -4324,-234,-1,2.6446D0,0.000D+00,1.5D0/
46726 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
46727 & RSPIN(I),I=193,208)/
46728 & 'XI_CBAR0', -4132,-134, 0,2.4703D0,9.800D-14,0.5D0,
46729 & 'XIP_CBR0', -4312,-134, 0,2.5800D0,0.000D+00,0.5D0,
46730 & 'XI*_CBR0', -4314,-134, 0,2.6438D0,0.000D+00,1.5D0,
46731 & 'OMG_CBR0', -4332,-334, 0,2.7040D0,6.400D-14,0.5D0,
46732 & 'OM*_CBR0', -4334,-334, 0,2.7300D0,0.000D+00,1.5D0,
46733 & 'W+ ', 24, 0,+1,80.420D0,0.000D+00,1.0D0,
46734 & 'W- ', -24, 0,-1,80.420D0,0.000D+00,1.0D0,
46735 & 'Z0/GAMA*', 23, 0, 0,91.188D0,0.000D+00,1.0D0,
46736 & 'HIGGS ', 25, 0, 0,115.00D0,0.000D+00,0.0D0,
46737 & 'Z0P ', 32, 0, 0,500.00D0,0.000D+00,1.0D0,
46738 & 'HIGGSL0 ', 26, 0, 0,0.0000D0,1.000D+30,0.0D0,
46739 & 'HIGGSH0 ', 35, 0, 0,0.0000D0,1.000D+30,0.0D0,
46740 & 'HIGGSA0 ', 36, 0, 0,0.0000D0,1.000D+30,0.0D0,
46741 & 'HIGGS+ ', 37, 0,+1,0.0000D0,1.000D+30,0.0D0,
46742 & 'HIGGS- ', -37, 0,-1,0.0000D0,1.000D+30,0.0D0,
46743 & 'GRAVITON', 39, 0, 0,0.0000D0,1.000D+30,2.0D0/
46744 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
46745 & RSPIN(I),I=209,224)/
46746 & 'VQRK ', 7, 0,-1,200.00D0,0.000D+00,0.5D0,
46747 & 'AQRK ', 8, 0,+2,400.00D0,0.000D+00,0.5D0,
46748 & 'HQRK ', 7, 0,-1,400.00D0,0.000D+00,0.5D0,
46749 & 'HPQK ', 8, 0,+2,600.00D0,0.000D+00,0.5D0,
46750 & ' ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
46751 & ' ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
46752 & 'VBAR ', -7, 0,+1,200.00D0,0.000D+00,0.5D0,
46753 & 'ABAR ', -8, 0,-2,400.00D0,0.000D+00,0.5D0,
46754 & 'HBAR ', -7, 0,+1,400.00D0,0.000D+00,0.5D0,
46755 & 'HPBR ', -8, 0,-2,600.00D0,0.000D+00,0.5D0,
46756 & ' ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
46757 & ' ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
46758 & 'B_DBAR0 ', -511, 51, 0,5.2792D0,1.614D-12,0.0D0,
46759 & 'B- ', -521, 52,-1,5.2789D0,1.652D-12,0.0D0,
46760 & 'B_SBAR0 ', -531, 53, 0,5.3693D0,1.540D-12,0.0D0,
46761 & 'SIGMA_B+', 5222, 225,+1,5.8200D0,1.070D-12,0.5D0/
46762 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
46763 & RSPIN(I),I=225,240)/
46764 & 'LMBDA_B0', 5122, 125, 0,5.6240D0,1.070D-12,0.5D0,
46765 & 'SIGMA_B-', 5112, 115,-1,5.8200D0,1.070D-12,0.5D0,
46766 & 'XI_B0 ', 5232, 235, 0,5.8000D0,1.070D-12,0.5D0,
46767 & 'XI_B- ', 5132, 135,-1,5.8000D0,1.070D-12,0.5D0,
46768 & 'OMEGA_B-', 5332, 335,-1,6.0400D0,1.070D-12,0.5D0,
46769 & 'B_C- ', -541, 54,-1,6.2500D0,1.000D-12,0.5D0,
46770 & 'UPSLON1S', 553, 55, 0,9.4604D0,0.000D+00,1.0D0,
46771 & 'T_B- ', -651, 56,-1,0.0000D0,0.000D+00,0.0D0,
46772 & 'T+ ', 611, 61,+1,0.0000D0,0.000D+00,0.0D0,
46773 & 'T0 ', 621, 62, 0,0.0000D0,0.000D+00,0.0D0,
46774 & 'T_S+ ', 631, 63,+1,0.0000D0,0.000D+00,0.0D0,
46775 & 'SGMA_T++', 6222, 226,+2,0.0000D0,0.000D+00,0.5D0,
46776 & 'LMBDA_T0', 6122, 126,+1,0.0000D0,0.000D+00,0.5D0,
46777 & 'SIGMA_T0', 6112, 116, 0,0.0000D0,0.000D+00,0.5D0,
46778 & 'XI_T+ ', 6232, 236,+1,0.0000D0,0.000D+00,0.5D0,
46779 & 'XI_T0 ', 6132, 136, 0,0.0000D0,0.000D+00,0.5D0/
46780 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
46781 & RSPIN(I),I=241,256)/
46782 & 'OMEGA_T0', 6332, 336, 0,0.0000D0,0.000D+00,0.5D0,
46783 & 'T_C0 ', 641, 64, 0,0.0000D0,0.000D+00,0.0D0,
46784 & 'T_B+ ', 651, 65,+1,0.0000D0,0.000D+00,0.0D0,
46785 & 'TOPONIUM', 663, 66, 0,0.0000D0,0.000D+00,1.0D0,
46786 & 'B_D0 ', 511, 15, 0,5.2792D0,1.614D-12,0.0D0,
46787 & 'B+ ', 521, 25,+1,5.2789D0,1.652D-12,0.0D0,
46788 & 'B_S0 ', 531, 35, 0,5.3693D0,1.540D-12,0.0D0,
46789 & 'SGM_BBR-', -5222,-225,-1,5.8200D0,1.070D-12,0.5D0,
46790 & 'LMD_BBR0', -5122,-125, 0,5.6240D0,1.070D-12,0.5D0,
46791 & 'SGM_BBR+', -5112,-115,+1,5.8200D0,1.070D-12,0.5D0,
46792 & 'XI_BBAR0', -5232,-235, 0,5.8000D0,1.070D-12,0.5D0,
46793 & 'XI_B+ ', -5132,-135,+1,5.8000D0,1.070D-12,0.5D0,
46794 & 'OMG_BBR+', -5332,-335,+1,6.0400D0,1.070D-12,0.5D0,
46795 & 'B_C+ ', 541, 45,+1,6.2500D0,1.000D-12,0.5D0,
46796 & 'T- ', -611, 16,-1,0.0000D0,0.000D+00,0.0D0,
46797 & 'TBAR0 ', -621, 26, 0,0.0000D0,0.000D+00,0.0D0/
46798 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
46799 & RSPIN(I),I=257,272)/
46800 & 'T_S- ', -631, 36,-1,0.0000D0,0.000D+00,0.0D0,
46801 & 'SGMA_T--', -6222,-226,-2,0.0000D0,0.000D+00,0.5D0,
46802 & 'LAMDA_T-', -6122,-126,-1,0.0000D0,0.000D+00,0.5D0,
46803 & 'SGM_TBR0', -6112,-116, 0,0.0000D0,0.000D+00,0.5D0,
46804 & 'XI_T- ', -6232,-236,-1,0.0000D0,0.000D+00,0.5D0,
46805 & 'XI_TBAR0', -6132,-136, 0,0.0000D0,0.000D+00,0.5D0,
46806 & 'OMG_TBR0', -6332,-336, 0,0.0000D0,0.000D+00,0.5D0,
46807 & 'T_CBAR0 ', -641, 46, 0,0.0000D0,0.000D+00,0.0D0,
46808 & 'B*BAR0 ', -513, 51, 0,5.3249D0,0.000D+00,1.0D0,
46809 & 'B*- ', -523, 52,-1,5.3249D0,0.000D+00,1.0D0,
46810 & 'B*_SBAR0', -533, 53, 0,5.4163D0,0.000D+00,1.0D0,
46811 & 'BH_1BAR0', -20513, 51, 0,5.7600D0,0.000D+00,1.0D0,
46812 & 'BH_1- ', -20523, 52,-1,5.7600D0,0.000D+00,1.0D0,
46813 & 'BH_S1BR0', -20533, 53, 0,5.8550D0,0.000D+00,1.0D0,
46814 & 'B*_2BAR0', -515, 51, 0,5.7700D0,0.000D+00,2.0D0,
46815 & 'B*_2- ', -525, 52,-1,5.7700D0,0.000D+00,2.0D0/
46816 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
46817 & RSPIN(I),I=273,288)/
46818 & 'B*_S2BR0', -535, 53, 0,5.8650D0,0.000D+00,2.0D0,
46819 & 'B*0 ', 513, 15, 0,5.3249D0,0.000D+00,1.0D0,
46820 & 'B*+ ', 523, 25,+1,5.3249D0,0.000D+00,1.0D0,
46821 & 'B*_S0 ', 533, 35, 0,5.4163D0,0.000D+00,1.0D0,
46822 & 'BH_10 ', 20513, 15, 0,5.7600D0,0.000D+00,1.0D0,
46823 & 'BH_1+ ', 20523, 25,+1,5.7600D0,0.000D+00,1.0D0,
46824 & 'BH_S10 ', 20533, 35, 0,5.8550D0,0.000D+00,1.0D0,
46825 & 'B*_20 ', 515, 15, 0,5.7700D0,0.000D+00,2.0D0,
46826 & 'B*_2+ ', 525, 25,+1,5.7700D0,0.000D+00,2.0D0,
46827 & 'B*_S20 ', 535, 35, 0,5.8650D0,0.000D+00,2.0D0,
46828 & ' ', 0, 0, 0,0.0000D0,0.000D+00, 0D0,
46829 & ' ', 0, 0, 0,0.0000D0,0.000D+00, 0D0,
46830 & 'B_10 ', 10113, 11, 0,1.2295D0,0.000D+00,1.0D0,
46831 & 'B_1+ ', 10213, 21,+1,1.2295D0,0.000D+00,1.0D0,
46832 & 'B_1- ', -10213, 12,-1,1.2295D0,0.000D+00,1.0D0,
46833 & 'HL_10 ', 10223, 33, 0,1.1700D0,0.000D+00,1.0D0/
46834 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
46835 & RSPIN(I),I=289,304)/
46836 & 'HH_10 ', 10333, 33, 0,1.3950D0,0.000D+00,1.0D0,
46837 & 'A_00 ', 9000111, 11, 0,.99600D0,0.000D+00,0.0D0,
46838 & 'A_0+ ', 9000211, 21,+1,.99600D0,0.000D+00,0.0D0,
46839 & 'A_0- ',-9000211, 12,-1,.99600D0,0.000D+00,0.0D0,
46840 & 'F0P0 ', 9010221, 33, 0,.99600D0,0.000D+00,0.0D0,
46841 & 'FH_00 ', 10221, 33, 0,1.3500D0,0.000D+00,0.0D0,
46842 & 'B*_C+ ', 543, 45,+1,6.2950D0,0.000D+00,1.0D0,
46843 & 'B*_C- ', -543, 54,-1,6.2950D0,0.000D+00,1.0D0,
46844 & 'BH_C1+ ', 20543, 45,+1,6.7300D0,0.000D+00,1.0D0,
46845 & 'BH_C1- ', -20543, 54,-1,6.7300D0,0.000D+00,1.0D0,
46846 & 'B*_C2+ ', 545, 45,+1,6.7400D0,0.000D+00,2.0D0,
46847 & 'B*_C2- ', -545, 54,-1,6.7400D0,0.000D+00,2.0D0,
46848 & 'H_C ', 10443, 44, 0,3.5261D0,0.000D+00,1.0D0,
46849 & 'CHI_C0 ', 20443, 44, 0,3.5105D0,0.000D+00,0.0D0,
46850 & 'CHI_C2 ', 445, 44, 0,3.5562D0,0.000D+00,2.0D0,
46851 & 'ETA_B ', 551, 55, 0,9.0000D0,0.000D+00,0.0D0/
46852 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
46853 & RSPIN(I),I=305,320)/
46854 & 'H_B ', 10553, 55, 0,9.8880D0,0.000D+00,1.0D0,
46855 & 'CHI_B0 ', 10551, 55, 0,9.8598D0,0.000D+00,0.0D0,
46856 & 'CHI_B1 ', 20553, 55, 0,9.8919D0,0.000D+00,1.0D0,
46857 & 'CHI_B2 ', 555, 55, 0,9.9132D0,0.000D+00,2.0D0,
46858 & 'KL_10 ', 10313, 13, 0,1.5700D0,0.000D+00,1.0D0,
46859 & 'KL_1+ ', 10323, 23,+1,1.5700D0,0.000D+00,1.0D0,
46860 & 'KL_1BAR0', -10313, 31, 0,1.5700D0,0.000D+00,1.0D0,
46861 & 'KL_1- ', -10323, 32,-1,1.5700D0,0.000D+00,1.0D0,
46862 & 'DL_1+ ', 10413, 41,+1,2.4270D0,0.000D+00,1.0D0,
46863 & 'DL_10 ', 10423, 42, 0,2.4222D0,0.000D+00,1.0D0,
46864 & 'DL_S1+ ', 10433, 43,+1,2.5354D0,0.000D+00,1.0D0,
46865 & 'DL_1- ', -10413, 14,-1,2.4270D0,0.000D+00,1.0D0,
46866 & 'DL_1BAR0', -10423, 24, 0,2.4222D0,0.000D+00,1.0D0,
46867 & 'DL_S1- ', -10433, 34,-1,2.5354D0,0.000D+00,1.0D0,
46868 & 'BL_10 ', 10513, 15, 0,5.7600D0,0.000D+00,1.0D0,
46869 & 'BL_1+ ', 10523, 25,+1,5.7600D0,0.000D+00,1.0D0/
46870 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
46871 & RSPIN(I),I=321,336)/
46872 & 'BL_S10 ', 10533, 35, 0,5.8530D0,0.000D+00,1.0D0,
46873 & 'BL_C1+ ', 10543, 45,+1,6.7300D0,0.000D+00,1.0D0,
46874 & 'BL_1BAR0', -10513, 51, 0,5.7600D0,0.000D+00,1.0D0,
46875 & 'BL_1- ', -10523, 52,-1,5.7600D0,0.000D+00,1.0D0,
46876 & 'BL_S1BR0', -10533, 53, 0,5.8530D0,0.000D+00,1.0D0,
46877 & 'BL_C1- ', -10543, 54,-1,6.7300D0,0.000D+00,1.0D0,
46878 & 'K*_0+ ', 10321, 23,+1,1.4290D0,0.000D+00,0.0D0,
46879 & 'K*_00 ', 10311, 13, 0,1.4290D0,0.000D+00,0.0D0,
46880 & 'K*_0BAR0', -10311, 31, 0,1.4290D0,0.000D+00,0.0D0,
46881 & 'K*_0- ', -10321, 32,-1,1.4290D0,0.000D+00,0.0D0,
46882 & 'D*_0+ ', 10411, 41,+1,2.4230D0,0.000D+00,0.0D0,
46883 & 'D*_00 ', 10421, 42, 0,2.4230D0,0.000D+00,0.0D0,
46884 & 'D*_S0+ ', 10431, 43,+1,2.5250D0,0.000D+00,0.0D0,
46885 & 'D*_0- ', -10411, 14,-1,2.4230D0,0.000D+00,0.0D0,
46886 & 'D*_0BAR0', -10421, 24, 0,2.4230D0,0.000D+00,0.0D0,
46887 & 'D*_S0- ', -10431, 34,-1,2.5250D0,0.000D+00,0.0D0/
46888 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
46889 & RSPIN(I),I=337,352)/
46890 & 'B*_00 ', 10511, 15, 0,5.7600D0,0.000D+00,0.0D0,
46891 & 'B*_0+ ', 10521, 25,+1,5.7600D0,0.000D+00,0.0D0,
46892 & 'B*_S00 ', 10531, 35, 0,5.8550D0,0.000D+00,0.0D0,
46893 & 'B*_C0+ ', 10541, 45,+1,6.7300D0,0.000D+00,0.0D0,
46894 & 'B*_0BAR0', -10511, 51, 0,5.7600D0,0.000D+00,0.0D0,
46895 & 'B*_0- ', -10521, 52,-1,5.7600D0,0.000D+00,0.0D0,
46896 & 'B*_S0BR0', -10531, 53, 0,5.8550D0,0.000D+00,0.0D0,
46897 & 'B*_C0- ', -10541, 54,-1,6.7300D0,0.000D+00,0.0D0,
46898 & 'SGMA*_B-', 5114, 115,-1,5.8400D0,0.000D+00,1.5D0,
46899 & 'SIGMA_B0', 5212, 125, 0,5.8200D0,0.000D+00,0.5D0,
46900 & 'SGMA*_B0', 5214, 125, 0,5.8400D0,0.000D+00,1.5D0,
46901 & 'SGMA*_B+', 5224, 225,+1,5.8400D0,0.000D+00,1.5D0,
46902 & 'XIP_B0 ', 5322, 235, 0,5.9450D0,0.000D+00,0.5D0,
46903 & 'XI*_B0 ', 5324, 235, 0,5.9450D0,0.000D+00,1.5D0,
46904 & 'XIP_B- ', 5312, 135,-1,5.9450D0,0.000D+00,0.5D0,
46905 & 'XI*_B- ', 5314, 135,-1,5.9450D0,0.000D+00,1.5D0/
46906 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
46907 & RSPIN(I),I=353,368)/
46908 & '0MGA*_B-', 5334, 335,-1,6.0600D0,0.000D+00,1.5D0,
46909 & 'SG*_BBR+', -5114,-115,+1,5.8400D0,0.000D+00,1.5D0,
46910 & 'SGM_BBR0', -5212,-125, 0,5.8200D0,0.000D+00,0.5D0,
46911 & 'SG*_BBR0', -5214,-125, 0,5.8400D0,0.000D+00,1.5D0,
46912 & 'SG*_BBR-', -5224,-225,-1,5.8400D0,0.000D+00,1.5D0,
46913 & 'XIP_BBR0', -5322,-235, 0,5.9450D0,0.000D+00,0.5D0,
46914 & 'XI*_BBR0', -5324,-235, 0,5.9450D0,0.000D+00,1.5D0,
46915 & 'XIP_B+ ', -5312,-135,+1,5.9450D0,0.000D+00,0.5D0,
46916 & 'XI*_B+ ', -5314,-135,+1,5.9450D0,0.000D+00,1.5D0,
46917 & '0MGA*_B+', -5334,-335,+1,6.0600D0,0.000D+00,1.5D0,
46918 & 'KDL_2+ ', 10325, 23,+1,1.7730D0,0.000D+00,2.0D0,
46919 & 'KDL_20 ', 10315, 13, 0,1.7730D0,0.000D+00,2.0D0,
46920 & 'KDL_2BR0', -10315, 31, 0,1.7730D0,0.000D+00,2.0D0,
46921 & 'KDL_2- ', -10325, 32,-1,1.7730D0,0.000D+00,2.0D0,
46922 & 'KD*+ ', 30323, 23,+1,1.7170D0,0.000D+00,1.0D0,
46923 & 'KD*0 ', 30313, 13, 0,1.7170D0,0.000D+00,1.0D0/
46924 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
46925 & RSPIN(I),I=369,384)/
46926 & 'KD*BAR0 ', -30313, 31, 0,1.7170D0,0.000D+00,1.0D0,
46927 & 'KD*- ', -30323, 32,-1,1.7170D0,0.000D+00,1.0D0,
46928 & 'KDH_2+ ', 20325, 23,+1,1.8160D0,0.000D+00,2.0D0,
46929 & 'KDH_20 ', 20315, 13, 0,1.8160D0,0.000D+00,2.0D0,
46930 & 'KDH_2BR0', -20315, 31, 0,1.8160D0,0.000D+00,2.0D0,
46931 & 'KDH_2- ', -20325, 32,-1,1.8160D0,0.000D+00,2.0D0,
46932 & 'KD_3+ ', 327, 23,+1,1.7730D0,0.000D+00,3.0D0,
46933 & 'KD_30 ', 317, 13, 0,1.7730D0,0.000D+00,3.0D0,
46934 & 'KD_3BAR0', -317, 31, 0,1.7730D0,0.000D+00,3.0D0,
46935 & 'KD_3- ', -327, 32,-1,1.7730D0,0.000D+00,3.0D0,
46936 & 'PI_2+ ', 10215, 21,+1,1.6700D0,0.000D+00,2.0D0,
46937 & 'PI_20 ', 10115, 11, 0,1.6700D0,0.000D+00,2.0D0,
46938 & 'PI_2- ', -10215, 12,-1,1.6700D0,0.000D+00,2.0D0,
46939 & 'RHOD+ ', 30213, 21,+1,1.7000D0,0.000D+00,1.0D0,
46940 & 'RHOD0 ', 30113, 11, 0,1.7000D0,0.000D+00,1.0D0,
46941 & 'RHOD- ', -30213, 12,-1,1.7000D0,0.000D+00,1.0D0/
46942 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
46943 & RSPIN(I),I=385,400)/
46944 & 'RHO_3+ ', 217, 21,+1,1.6910D0,0.000D+00,3.0D0,
46945 & 'RHO_30 ', 117, 11, 0,1.6910D0,0.000D+00,3.0D0,
46946 & 'RHO_3- ', -217, 12,-1,1.6910D0,0.000D+00,3.0D0,
46947 & 'UPSLON2S', 100553, 55, 0,10.023D0,0.000D+00,1.0D0,
46948 & 'CHI2P_B0', 110551, 55, 0,10.232D0,0.000D+00,0.0D0,
46949 & 'CHI2P_B1', 120553, 55, 0,10.255D0,0.000D+00,1.0D0,
46950 & 'CHI2P_B2', 100555, 55, 0,10.269D0,0.000D+00,2.0D0,
46951 & 'UPSLON3S', 200553, 55, 0,10.355D0,0.000D+00,1.0D0,
46952 & 'UPSLON4S', 300553, 55, 0,10.580D0,0.000D+00,1.0D0,
46953 & ' ', 0, 0, 0,0.0 D0, 0.0D+00, 0D0,
46954 & 'OMEGA_3 ', 227, 33, 0,1.6670D0,0.000D+00,3.0D0,
46955 & 'PHI_3 ', 337, 33, 0,1.8540D0,0.000D+00,3.0D0,
46956 & 'ETA_2(L)', 10225, 33, 0,1.6320D0,0.000D+00,2.0D0,
46957 & 'ETA_2(H)', 10335, 33, 0,1.8540D0,0.000D+00,2.0D0,
46958 & 'OMEGA(H)', 30223, 33, 0,1.6490D0,0.000D+00,1.0D0,
46959 & ' ', 0, 0, 0,0.0 D0,0.0D+00 , 0D0/
46960 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
46961 & RSPIN(I),I=401,416)/
46962 & 'SSDL ', 1000001, 0,-1,0.00D0,1.000D+30,0.0D0,
46963 & 'SSUL ', 1000002, 0,+2,0.00D0,1.000D+30,0.0D0,
46964 & 'SSSL ', 1000003, 0,-1,0.00D0,1.000D+30,0.0D0,
46965 & 'SSCL ', 1000004, 0,+2,0.00D0,1.000D+30,0.0D0,
46966 & 'SSB1 ', 1000005, 0,-1,0.00D0,1.000D+30,0.0D0,
46967 & 'SST1 ', 1000006, 0,+2,0.00D0,1.000D+30,0.0D0,
46968 & 'SSDLBR ',-1000001, 0,+1,0.00D0,1.000D+30,0.0D0,
46969 & 'SSULBR ',-1000002, 0,-2,0.00D0,1.000D+30,0.0D0,
46970 & 'SSSLBR ',-1000003, 0,+1,0.00D0,1.000D+30,0.0D0,
46971 & 'SSCLBR ',-1000004, 0,-2,0.00D0,1.000D+30,0.0D0,
46972 & 'SSB1BR ',-1000005, 0,+1,0.00D0,1.000D+30,0.0D0,
46973 & 'SST1BR ',-1000006, 0,-2,0.00D0,1.000D+30,0.0D0,
46974 & 'SSDR ', 2000001, 0,-1,0.00D0,1.000D+30,0.0D0,
46975 & 'SSUR ', 2000002, 0,+2,0.00D0,1.000D+30,0.0D0,
46976 & 'SSSR ', 2000003, 0,-1,0.00D0,1.000D+30,0.0D0,
46977 & 'SSCR ', 2000004, 0,+2,0.00D0,1.000D+30,0.0D0/
46978 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
46979 & RSPIN(I),I=417,432)/
46980 & 'SSB2 ', 2000005, 0,-1,0.00D0,1.000D+30,0.0D0,
46981 & 'SST2 ', 2000006, 0,+2,0.00D0,1.000D+30,0.0D0,
46982 & 'SSDRBR ',-2000001, 0,+1,0.00D0,1.000D+30,0.0D0,
46983 & 'SSURBR ',-2000002, 0,-2,0.00D0,1.000D+30,0.0D0,
46984 & 'SSSRBR ',-2000003, 0,+1,0.00D0,1.000D+30,0.0D0,
46985 & 'SSCRBR ',-2000004, 0,-2,0.00D0,1.000D+30,0.0D0,
46986 & 'SSB2BR ',-2000005, 0,+1,0.00D0,1.000D+30,0.0D0,
46987 & 'SST2BR ',-2000006, 0,-2,0.00D0,1.000D+30,0.0D0,
46988 & 'SSEL- ', 1000011, 0,-1,0.00D0,1.000D+30,0.0D0,
46989 & 'SSNUEL ', 1000012, 0, 0,0.00D0,1.000D+30,0.0D0,
46990 & 'SSMUL- ', 1000013, 0,-1,0.00D0,1.000D+30,0.0D0,
46991 & 'SSNUMUL ', 1000014, 0, 0,0.00D0,1.000D+30,0.0D0,
46992 & 'SSTAU1- ', 1000015, 0,-1,0.00D0,1.000D+30,0.0D0,
46993 & 'SSNUTL ', 1000016, 0, 0,0.00D0,1.000D+30,0.0D0,
46994 & 'SSEL+ ',-1000011, 0,+1,0.00D0,1.000D+30,0.0D0,
46995 & 'SSNUELBR',-1000012, 0, 0,0.00D0,1.000D+30,0.0D0/
46996 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
46997 & RSPIN(I),I=433,448)/
46998 & 'SSMUL+ ',-1000013, 0,+1,0.00D0,1.000D+30,0.0D0,
46999 & 'SSNUMLBR',-1000014, 0, 0,0.00D0,1.000D+30,0.0D0,
47000 & 'SSTAU1+ ',-1000015, 0,+1,0.00D0,1.000D+30,0.0D0,
47001 & 'SSNUTLBR',-1000016, 0, 0,0.00D0,1.000D+30,0.0D0,
47002 & 'SSER- ', 2000011, 0,-1,0.00D0,1.000D+30,0.0D0,
47003 & 'SSNUER ', 2000012, 0, 0,0.00D0,1.000D+30,0.0D0,
47004 & 'SSMUR- ', 2000013, 0,-1,0.00D0,1.000D+30,0.0D0,
47005 & 'SSNUMUR ', 2000014, 0, 0,0.00D0,1.000D+30,0.0D0,
47006 & 'SSTAU2- ', 2000015, 0,-1,0.00D0,1.000D+30,0.0D0,
47007 & 'SSNUTR ', 2000016, 0, 0,0.00D0,1.000D+30,0.0D0,
47008 & 'SSER+ ',-2000011, 0,+1,0.00D0,1.000D+30,0.0D0,
47009 & 'SSNUERBR',-2000012, 0, 0,0.00D0,1.000D+30,0.0D0,
47010 & 'SSMUR+ ',-2000013, 0,+1,0.00D0,1.000D+30,0.0D0,
47011 & 'SSNUMRBR',-2000014, 0, 0,0.00D0,1.000D+30,0.0D0,
47012 & 'SSTAU2+ ',-2000015, 0,+1,0.00D0,1.000D+30,0.0D0,
47013 & 'SSNUTRBR',-2000016, 0, 0,0.00D0,1.000D+30,0.0D0/
47014 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
47015 & RSPIN(I),I=449,NLAST)/
47016 & 'GLUINO ', 1000021, 0, 0,0.00D0,1.000D+30,0.5D0,
47017 & 'NTLINO1 ', 1000022, 0, 0,0.00D0,1.000D+30,0.5D0,
47018 & 'NTLINO2 ', 1000023, 0, 0,0.00D0,1.000D+30,0.5D0,
47019 & 'NTLINO3 ', 1000025, 0, 0,0.00D0,1.000D+30,0.5D0,
47020 & 'NTLINO4 ', 1000035, 0, 0,0.00D0,1.000D+30,0.5D0,
47021 & 'CHGINO1+', 1000024, 0,+1,0.00D0,1.000D+30,0.5D0,
47022 & 'CHGINO2+', 1000037, 0,+1,0.00D0,1.000D+30,0.5D0,
47023 & 'CHGINO1-',-1000024, 0,-1,0.00D0,1.000D+30,0.5D0,
47024 & 'CHGINO2-',-1000037, 0,-1,0.00D0,1.000D+30,0.5D0,
47025 & 'GRAVTINO', 1000039, 0, 0,0.00D0,1.000D+30,1.5D0/
47027 DATA QORQQB/.FALSE.,
47028 & 6*.TRUE.,6*.FALSE.,96*.FALSE.,6*.FALSE.,6*.TRUE.,NREST*.FALSE./
47029 DATA QBORQQ/.FALSE.,
47030 & 6*.FALSE.,6*.TRUE.,96*.FALSE.,6*.TRUE.,6*.FALSE.,NREST*.FALSE./
47032 C In the character strings use an ampersand to represent a backslash
47033 C to avoid compiler problems with the C escape character
47034 DATA ((TXNAME(J,I),J=1,2),I=0,8)/
47049 & ' $&bar{&rm d}$',
47051 & ' $&bar{&rm u}$',
47053 DATA ((TXNAME(J,I),J=1,2),I=9,16)/
47054 & ' $&bar{&rm s}$',
47056 & ' $&bar{&rm c}$',
47058 & ' $&bar{&rm b}$',
47060 & ' $&bar{&rm t}$',
47070 DATA ((TXNAME(J,I),J=1,2),I=17,24)/
47077 & ' $&star&star&star&star$',
47080 & ' pi<SUP>0</SUP>',
47084 & ' rho<SUP>0</SUP>',
47087 DATA ((TXNAME(J,I),J=1,2),I=25,32)/
47088 & ' $&eta^&prime$',
47089 & ' eta<SUP>''</SUP>',
47091 & ' f<SUB>2</SUB>',
47093 & ' a<SUB>1</SUB><SUP>0</SUP>',
47095 & ' f<SUB>1</SUB>(L)',
47097 & ' a<SUB>2</SUB><SUP>0</SUP>',
47099 & ' pi<SUP>-</SUP>',
47101 & ' rho<SUP>-</SUP>',
47103 & ' a<SUB>1</SUB><SUP>-</SUP>'/
47104 DATA ((TXNAME(J,I),J=1,2),I=33,40)/
47106 & ' a<SUB>2</SUB><SUP>-</SUP>',
47108 & ' K<SUP>-</SUP>',
47110 & ' K<SUP>*-</SUP>',
47112 & ' K<SUB>1</SUB>(H)<SUP>-</SUP>',
47113 & ' K$^{&star-}_2$',
47114 & ' K<SUB>2</SUB><SUP>*-</SUP>',
47116 & ' pi<SUP>+</SUP>',
47118 & ' rho<SUP>+</SUP>',
47120 & ' a<SUB>1</SUB><SUP>+</SUP>'/
47121 DATA ((TXNAME(J,I),J=1,2),I=41,48)/
47123 & ' a<SUB>2</SUB><SUP>+</SUP>',
47124 & ' $&overline{&rm K}^0$',
47125 & ' -K<SUP>0</SUP>',
47126 & ' $&overline{&rm K}^{&star0}$',
47127 & ' -K<SUP>*0</SUP>',
47128 & ' $&overline{&rm K}_1(H)^0$',
47129 & ' -K<SUB>1</SUB>(H)<SUP>0</SUP>',
47130 & ' $&overline{&rm K}^{&star0}_2$',
47131 & ' -K<SUB>2</SUB><SUP>*0</SUP>',
47133 & ' K<SUP>+</SUP>',
47135 & ' K<SUP>*+</SUP>',
47137 & ' K<SUB>1</SUB>(H)<SUP>+</SUP>'/
47138 DATA ((TXNAME(J,I),J=1,2),I=49,56)/
47139 & ' K$^{&star+}_2$',
47140 & ' K<SUB>2</SUB>(H)<SUP>*+</SUP>',
47142 & ' K<SUP>0</SUP>',
47144 & ' K<SUP>*-</SUP>',
47146 & ' K<SUB>1</SUB>(H)<SUP>0</SUP>',
47147 & ' K$^{&star0}_2$',
47148 & ' K<SUB>2</SUB><SUP>*0</SUP>',
47155 DATA ((TXNAME(J,I),J=1,2),I=57,64)/
47157 & ' f<SUB>1</SUB>(1420)',
47159 & ' f<SUP>''</SUP><SUB>2</SUB>',
47162 & ' K$^0_{&rm S}$',
47163 & ' K<SUB>S</SUB><SUP>0</SUP>',
47164 & ' K$^0_{&rm L}$',
47165 & ' K<SUB>L</SUB><SUP>0</SUP>',
47166 & ' $a_0(1450)^0$',
47167 & ' a<SUB>0</SUB>(1450)<SUP>0</SUP>',
47168 & ' $a_0(1450)^+$',
47169 & ' a<SUB>0</SUB>(1450)<SUP>+</SUP>',
47170 & ' $a_0(1450)^-$',
47171 & ' a<SUB>0</SUB>(1450)<SUP>-</SUP>'/
47172 DATA ((TXNAME(J,I),J=1,2),I=65,72)/
47185 & ' $&gamma$-remnant',
47186 & ' gamma-remnant',
47189 DATA ((TXNAME(J,I),J=1,2),I=73,80)/
47193 & ' Delta<SUP>+</SUP>',
47197 & ' Delta<SUP>0</SUP>',
47199 & ' Delta<SUP>-</SUP>',
47203 & ' Sigma<SUP>0</SUP>',
47204 & ' $&Sigma^{&star0}$',
47205 & ' Sigma<SUP>*0</SUP>'/
47206 DATA ((TXNAME(J,I),J=1,2),I=81,88)/
47208 & ' Sigma<SUP>-</SUP>',
47209 & ' $&Sigma^{&star-}$',
47210 & ' Sigma<SUP>*-</SUP>',
47212 & ' Xi<SUP>-</SUP>',
47213 & ' $&Xi^{&star-}$',
47214 & ' Xi<SUP>*-</SUP>',
47215 & ' $&Delta^{++}$',
47216 & ' Delta<SUP>++</SUP>',
47218 & ' Sigma<SUP>+</SUP>',
47219 & ' $&Sigma^{&star+}$',
47220 & ' Sigma<SUP>*+</SUP>',
47222 & ' Xi<SUP>0</SUP>'/
47223 DATA ((TXNAME(J,I),J=1,2),I=89,96)/
47224 & ' $&Xi^{&star0}$',
47225 & ' Xi<SUP>*0</SUP>',
47227 & ' Omega<SUP>-</SUP>',
47228 & ' $&bar{&rm p}$',
47230 & ' $&overline{&Delta}^-$',
47231 & ' -Delta<SUP>-</SUP>',
47232 & ' $&bar{&rm n}$',
47234 & ' $&overline{&Delta}^0$',
47235 & ' -Delta<SUP>0</SUP>',
47236 & ' $&overline{&Delta}^+$',
47237 & ' -Delta<SUP>+</SUP>',
47238 & ' $&overline{&Lambda}$',
47240 DATA ((TXNAME(J,I),J=1,2),I=97,104)/
47241 & ' $&overline{&Sigma}^0$',
47242 & ' -Sigma<SUP>0</SUP>',
47243 & ' $&overline{&Sigma}^{&star0}$',
47244 & ' -Sigma<SUP>*0</SUP>',
47245 & ' $&overline{&Sigma}^+$',
47246 & ' -Sigma<SUP>+</SUP>',
47247 & ' $&overline{&Sigma}^{&star+}$',
47248 & ' -Sigma<SUP>*+</SUP>',
47249 & ' $&overline{&Xi}^+$',
47250 & ' -Xi<SUP>+</SUP>',
47251 & ' $&overline{&Xi}^{&star+}$',
47252 & ' -Xi<SUP>*+</SUP>',
47253 & ' $&overline{&Delta}^{--}$',
47254 & ' -Delta<SUP>--</SUP>',
47255 & ' $&overline{&Sigma}^-$',
47256 & ' -Sigma<SUP>-</SUP>'/
47257 DATA ((TXNAME(J,I),J=1,2),I=105,112)/
47258 & ' $&overline{&Sigma}^{&star-}$',
47259 & ' -Sigma<SUP>*-</SUP>',
47260 & ' $&overline{&Xi}^0$',
47261 & ' -Xi<SUP>0</SUP>',
47262 & ' $&overline&Xi^{&star0}$',
47263 & ' -Xi<SUP>*0</SUP>',
47264 & ' $&overline{&Omega}^+$',
47265 & ' -Omega<SUP>+</SUP>',
47274 DATA ((TXNAME(J,I),J=1,2),I=113,120)/
47279 & ' $&bar{&rm u}&bar{&rm u}$',
47281 & ' $&bar{&rm u}&bar{&rm d}$',
47283 & ' $&bar{&rm d}&bar{&rm d}$',
47285 & ' $&bar{&rm u}&bar{&rm s}$',
47287 & ' $&bar{&rm d}&bar{&rm s}$',
47289 & ' $&bar{&rm s}&bar{&rm s}$',
47291 DATA ((TXNAME(J,I),J=1,2),I=121,128)/
47293 & ' e<SUP>-</SUP>',
47294 & ' $&nu_{&rm e}$',
47295 & ' nu<SUB>e</SUB>',
47297 & ' mu<SUP>-</SUP>',
47299 & ' nu<SUB>mu</SUB>',
47301 & ' tau<SUP>-</SUP>',
47303 & ' nu<SUB>tau</SUB>',
47305 & ' e<SUP>+</SUP>',
47306 & ' $&bar{&nu}_{&rm e}$',
47307 & ' -nu<SUB>e</SUB>'/
47308 DATA ((TXNAME(J,I),J=1,2),I=129,136)/
47310 & ' mu<SUP>+</SUP>',
47311 & ' $&bar{&nu}_&mu$',
47312 & ' -nu<SUB>mu</SUB>',
47314 & ' tau<SUP>+</SUP>',
47315 & ' $&bar{&nu}_&tau$',
47316 & ' -nu<SUB>tau</SUB>',
47324 & ' D<SUP>+</SUP>'/
47325 DATA ((TXNAME(J,I),J=1,2),I=137,144)/
47327 & ' D<SUP>*+</SUP>',
47329 & ' D<SUB>1</SUB>(H)<SUP>+</SUP>',
47330 & ' D$_2^{&star+}$',
47331 & ' D<SUB>2</SUB><SUP>*+</SUP>',
47333 & ' D<SUP>0</SUP>',
47335 & ' D<SUP>*0</SUP>',
47337 & ' D<SUB>1</SUB>(H)<SUP>0</SUP>',
47338 & ' D$_2^{&star0}$',
47339 & ' D<SUB>2</SUB><SUP>*0</SUP>',
47340 & ' D$_{&rm s}^+$',
47341 & ' D<SUB>s</SUB><SUP>+</SUP>'/
47342 DATA ((TXNAME(J,I),J=1,2),I=145,152)/
47343 & ' D$_{&rm s}^{&star+}$',
47344 & ' D<SUB>s</SUB><SUP>*+</SUP>',
47345 & ' D$_{&rm s1}(H)^+$',
47346 & ' D<SUB>s1</SUB>(H)<SUP>+</SUP>',
47347 & ' D$^{&star+}_{&rm s2}$',
47348 & ' D<SUB>s1</SUB>(H)<SUP>*+</SUP>',
47349 & ' $&Sigma_{&rm c}^{++}$',
47350 & ' Sigma<SUB>c</SUB><SUP>++</SUP>',
47351 & ' $&Sigma_{&rm c}^{&star++}$',
47352 & ' Sigma<SUB>c</SUB><SUP>*++</SUP>',
47353 & ' $&Lambda_{&rm c}^+$',
47354 & ' Lambda<SUB>c</SUB><SUP>+</SUP>',
47355 & ' $&Sigma_{&rm c}^+$',
47356 & ' Sigma<SUB>c</SUB><SUP>+</SUP>',
47357 & ' $&Sigma_{&rm c}^{&star+}$',
47358 & ' Sigma<SUB>c</SUB><SUP>*+</SUP>'/
47359 DATA ((TXNAME(J,I),J=1,2),I=153,160)/
47360 & ' $&Sigma_{&rm c}^0$',
47361 & ' Sigma<SUB>c</SUB><SUP>0</SUP>',
47362 & ' $&Sigma_{&rm c}^{&star0}$',
47363 & ' Sigma<SUB>c</SUB><SUP>*0</SUP>',
47364 & ' $&Xi_{&rm c}^+$',
47365 & ' Xi<SUB>c</SUB><SUP>+</SUP>',
47366 & ' $&Xi_{&rm c}^{&prime+}$',
47367 & ' Xi<SUB>c</SUB><SUP>''+</SUP>',
47368 & ' $&Xi_{&rm c}^{&star+}$',
47369 & ' Xi<SUB>c</SUB><SUP>*+</SUP>',
47370 & ' $&Xi_{&rm c}^0$',
47371 & ' Xi<SUB>c</SUB><SUP>0</SUP>',
47372 & ' $&Xi_{&rm c}^{&prime0}$',
47373 & ' Xi<SUB>c</SUB><SUP>''0</SUP>',
47374 & ' $&Xi_{&rm c}^{&star0}$',
47375 & ' Xi<SUB>c</SUB><SUP>*0</SUP>'/
47376 DATA ((TXNAME(J,I),J=1,2),I=161,168)/
47377 & ' $&Omega_{&rm c}^0$',
47378 & ' Omega<SUB>c</SUB><SUP>0</SUP>',
47379 & ' $&Omega_{&rm c}^{&star0}$',
47380 & ' Omega<SUB>c</SUB><SUP>*0</SUP>',
47381 & ' $&eta_{&rm c}(1S)$',
47382 & ' eta<SUB>c</SUB>(1S)',
47385 & ' $&chi_{&rm c0}(1P)$',
47386 & ' chi<SUB>c0</SUB>(1P)',
47393 DATA ((TXNAME(J,I),J=1,2),I=169,176)/
47399 & ' D<SUP>-</SUP>',
47401 & ' D<SUP>*-</SUP>',
47403 & ' D<SUB>1</SUB>(H)<SUP>-</SUP>',
47404 & ' D$_2^{&star-}$',
47405 & ' D<SUB>2</SUB><SUP>*-</SUP>',
47406 & ' $&overline{&rm D}^0$',
47407 & ' -D<SUP>0</SUP>',
47408 & ' $&overline{&rm D}^{&star0}$',
47409 & ' -D<SUP>*0</SUP>'/
47410 DATA ((TXNAME(J,I),J=1,2),I=177,184)/
47411 & ' $&overline{&rm D}_1(H)^0$',
47412 & ' -D<SUB>1</SUB>(H)<SUP>0</SUP>',
47413 & ' $&overline{&rm D}_2^{&star0}$',
47414 & ' -D<SUB>2</SUB><SUP>*0</SUP>',
47415 & ' D$_{&rm s}^-$',
47416 & ' D<SUB>s</SUB><SUP>-</SUP>',
47417 & ' D$_{&rm s}^{&star-}$',
47418 & ' D<SUB>s</SUB><SUP>*-</SUP>',
47419 & ' D$_{&rm s1}(H)^-$',
47420 & ' D<SUB>s1</SUB>(H)<SUP>-</SUP>',
47421 & ' D$_{&rm s2}^{&star-}$',
47422 & ' D<SUB>s1</SUB>(H)<SUP>*-</SUP>',
47423 & ' $&overline{&Sigma}_{&rm c}^{--}$',
47424 & ' -Sigma<SUB>c</SUB><SUP>--</SUP>',
47425 & '$&overline{&Sigma}_{&rm c}^{&star--}$',
47426 & ' -Sigma<SUB>c</SUB><SUP>*--</SUP>'/
47427 DATA ((TXNAME(J,I),J=1,2),I=185,192)/
47428 & ' $&overline{&Lambda}_{&rm c}^-$',
47429 & ' -Lambda<SUB>c</SUB><SUP>-</SUP>',
47430 & ' $&overline{&Sigma}_{&rm c}^-$',
47431 & ' -Sigma<SUB>c</SUB><SUP>-</SUP>',
47432 & ' $&overline{&Sigma}_{&rm c}^{&star-}$',
47433 & ' -Sigma<SUB>c</SUB><SUP>*-</SUP>',
47434 & ' $&overline{&Sigma}_{&rm c}^0$',
47435 & ' -Sigma<SUB>c</SUB><SUP>0</SUP>',
47436 & ' $&overline{&Sigma}_{&rm c}^{&star0}$',
47437 & ' -Sigma<SUB>c</SUB><SUP>*0</SUP>',
47438 & ' $&overline{&Xi}_{&rm c}^-$',
47439 & ' -Xi<SUB>c</SUB><SUP>-</SUP>',
47440 & ' $&overline{&Xi}_{&rm c}^{&prime-}$',
47441 & ' -Xi<SUB>c</SUB><SUP>''-</SUP>',
47442 & ' $&overline{&Xi}_{&rm c}^{&star-}$',
47443 & ' -Xi<SUB>c</SUB><SUP>*-</SUP>'/
47444 DATA ((TXNAME(J,I),J=1,2),I=193,200)/
47445 & ' $&overline{&Xi}_{&rm c}^0$',
47446 & ' -Xi<SUB>c</SUB><SUP>0</SUP>',
47447 & ' $&overline{&Xi}_{&rm c}^{&prime0}$',
47448 & ' -Xi<SUB>c</SUB><SUP>''0</SUP>',
47449 & ' $&overline{&Xi}_{&rm c}^{&star0}$',
47450 & ' -Xi<SUB>c</SUB><SUP>*0</SUP>',
47451 & ' $&overline{&Omega}_{&rm c}^0$',
47452 & ' -Omega<SUB>c</SUB><SUP>0</SUP>',
47453 & ' $&overline{&Omega}_{&rm c}^{&star0}$',
47454 & ' -Omega<SUB>c</SUB><SUP>*0</SUP>',
47456 & ' W<SUP>+</SUP>',
47458 & ' W<SUP>-</SUP>',
47459 & ' Z$^0/&gamma^&star$',
47460 & ' Z<SUP>0</SUP>/gamma<SUP>*</SUP>'/
47461 DATA ((TXNAME(J,I),J=1,2),I=201,208)/
47462 & ' $H^0_{&rm SM}$',
47463 & ' H<SUP>0</SUP><SUB>SM</SUB>',
47464 & ' Z$^{&prime0}$',
47465 & ' Z<SUP>''0</SUP>',
47467 & ' h<SUP>0</SUP>',
47469 & ' H<SUP>0</SUP>',
47471 & ' A<SUP>0</SUP>',
47473 & ' H<SUP>+</SUP>',
47475 & ' H<SUP>-</SUP>',
47478 DATA ((TXNAME(J,I),J=1,2),I=209,216)/
47485 & ' H$^&prime$-quark',
47486 & ' H<SUP>''</SUP>-quark',
47491 & ' $&overline{&rm V}$-quark',
47493 & ' $&overline{&rm A}$-quark',
47495 DATA ((TXNAME(J,I),J=1,2),I=217,224)/
47496 & ' $&overline{&rm H}$-quark',
47498 & ' $&overline{&rm H}^&prime$-quark',
47499 & ' -H<SUP>''</SUP>-quark',
47504 & ' $&overline{&rm B}_{&rm d}^0$',
47505 & ' -B<SUB>d</SUB><SUP>0</SUP>',
47507 & ' B<SUP>-</SUP>',
47508 & ' $&overline{&rm B}_{&rm s}^0$',
47509 & ' -B<SUB>s</SUB><SUP>0</SUP>',
47510 & ' $&Sigma_{&rm b}^+$',
47511 & ' Sigma<SUB>b</SUB><SUP>+</SUP>'/
47512 DATA ((TXNAME(J,I),J=1,2),I=225,232)/
47513 & ' $&Lambda_{&rm b}^0$',
47514 & ' Lambda<SUB>b</SUB><SUP>0</SUP>',
47515 & ' $&Sigma_{&rm b}^-$',
47516 & ' Sigma<SUB>b</SUB><SUP>-</SUP>',
47517 & ' $&Xi_{&rm b}^0$',
47518 & ' Xi<SUB>b</SUB><SUP>0</SUP>',
47519 & ' $&Xi_{&rm b}^-$',
47520 & ' Xi<SUB>b</SUB><SUP>-</SUP>',
47521 & ' $&Omega_{&rm b}^-$',
47522 & ' Omega<SUB>b</SUB><SUP>-</SUP>',
47523 & ' B$_{&rm c}^-$',
47524 & ' B<SUB>c</SUB><SUP>-</SUP>',
47525 & ' $&Upsilon(1S)$',
47527 & ' T$_{&rm b}^-$',
47528 & ' T<SUB>b</SUB><SUP>-</SUP>'/
47529 DATA ((TXNAME(J,I),J=1,2),I=233,240)/
47531 & ' T<SUP>+</SUP>',
47533 & ' T<SUP>0</SUP>',
47534 & ' T$_{&rm s}^+$',
47535 & ' T<SUB>s</SUB><SUP>+</SUP>',
47536 & ' $&Sigma_{&rm t}^{++}$',
47537 & ' Sigma<SUB>t</SUB><SUP>++</SUP>',
47538 & ' $&Lambda_{&rm t}^0$',
47539 & ' Lambda<SUB>t</SUB><SUP>0</SUP>',
47540 & ' $&Sigma_{&rm t}^0$',
47541 & ' Sigma<SUB>t</SUB><SUP>0</SUP>',
47542 & ' $&chi_{&rm t}^+$',
47543 & ' Xi<SUB>t</SUB><SUP>+</SUP>',
47544 & ' $&chi_{&rm t}^0$',
47545 & ' Xi<SUB>t</SUB><SUP>0</SUP>'/
47546 DATA ((TXNAME(J,I),J=1,2),I=241,248)/
47547 & ' $&Omega_{&rm t}^0$',
47548 & ' Omega<SUB>t</SUB><SUP>0</SUP>',
47549 & ' T$_{&rm c}^0$',
47550 & ' T<SUB>c</SUB><SUP>0</SUP>',
47551 & ' T$_{&rm b}^+$',
47552 & ' T<SUB>b</SUB><SUP>+</SUP>',
47555 & ' B$_{&rm d}^0$',
47556 & ' B<SUB>d</SUB><SUP>0</SUP>',
47558 & ' B<SUP>+</SUP>',
47559 & ' B$_{&rm s}^0$',
47560 & ' B<SUB>s</SUB><SUP>0</SUP>',
47561 & ' $&overline{&Sigma}_{&rm b}^-$',
47562 & ' -Sigma<SUB>b</SUB><SUP>-</SUP>'/
47563 DATA ((TXNAME(J,I),J=1,2),I=249,256)/
47564 & ' $&overline{&Lambda}_{&rm b}^-$',
47565 & ' -Lambda<SUB>b</SUB><SUP>-</SUP>',
47566 & ' $&overline{&Sigma}_{&rm b}^+$',
47567 & ' -Sigma<SUB>b</SUB><SUP>+</SUP>',
47568 & ' $&overline{&Xi}_{&rm b}^0$',
47569 & ' -Xi<SUB>b</SUB><SUP>0</SUP>',
47570 & ' $&Xi_{&rm b}^+$',
47571 & ' Xi<SUB>b</SUB><SUP>+</SUP>',
47572 & ' $&overline{&Omega}_{&rm b}^+$',
47573 & ' -Omega<SUB>b</SUB><SUP>+</SUP>',
47574 & ' B$_{&rm c}^+$',
47575 & ' B<SUB>c</SUB><SUP>+</SUP>',
47577 & ' T<SUP>-</SUP>',
47578 & ' $&overline{&rm T}^0$',
47579 & ' T<SUP>0</SUP>'/
47580 DATA ((TXNAME(J,I),J=1,2),I=257,264)/
47581 & ' T$_{&rm s}^-$',
47582 & ' T<SUB>s</SUB><SUP>-</SUP>',
47583 & ' $&overline{&Sigma}_{&rm t}^{--}$',
47584 & ' Sigma<SUB>t</SUB><SUP>--</SUP>',
47585 & ' $&overline{&Lambda}_{&rm t}^-$',
47586 & ' -Lambda<SUB>t</SUB><SUP>-</SUP>',
47587 & ' $&overline{&Sigma}_{&rm t}^0$',
47588 & ' -Sigma<SUB>t</SUB><SUP>0</SUP>',
47589 & ' $&overline{&Xi}_{&rm t}^-$',
47590 & ' -Xi<SUB>t</SUB><SUP>-</SUP>',
47591 & ' $&overline{&Xi}_{&rm t}^0$',
47592 & ' -Xi<SUB>t</SUB><SUP>0</SUP>',
47593 & ' $&overline{&Omega}_{&rm t}^0$',
47594 & ' -Omega<SUB>t</SUB><SUP>0</SUP>',
47595 & ' $&overline{&rm T}_{&rm c}^0$',
47596 & ' T<SUB>c</SUB><SUP>0</SUP>'/
47597 DATA ((TXNAME(J,I),J=1,2),I=265,272)/
47598 & ' $&overline{&rm B}^{&star0}$',
47599 & ' -B<SUP>*0</SUP>',
47601 & ' B<SUP>*-</SUP>',
47602 & ' $&overline{&rm B}_{&rm s}^{&star0}$',
47603 & ' -B<SUB>s</SUB><SUP>*0</SUP>',
47604 & ' $&overline{&rm B}_1(H)^0$',
47605 & ' -B<SUB>1</SUB>(H)<SUP>0</SUP>',
47607 & ' B<SUB>1</SUB>(H)<SUP>-</SUP>',
47608 & ' $&overline{&rm B}_{&rm s1}(H)^0$',
47609 & ' -B<SUB>s1</SUB>(H)<SUP>0</SUP>',
47610 & ' $&overline{&rm B}_2^{&star0}$',
47611 & ' -B<SUB>2</SUB><SUP>*0</SUP>',
47612 & ' B$_2^{&star-}$',
47613 & ' B<SUB>2</SUB><SUP>*-</SUP>'/
47614 DATA ((TXNAME(J,I),J=1,2),I=273,280)/
47615 & ' B$_{&rm s2}^{&star0}$',
47616 & ' B<SUB>s2</SUB><SUP>*0</SUP>',
47618 & ' B<SUP>*0</SUP>',
47620 & ' B<SUP>*+</SUP>',
47621 & ' B$_{&rm s}^{&star0}$',
47622 & ' B<SUB>s</SUB><SUP>*0</SUP>',
47624 & ' B<SUB>1</SUB>(H)<SUP>0</SUP>',
47626 & ' B<SUB>1</SUB>(H)<SUP>+</SUP>',
47627 & ' B$_{&rm s1}(H)^0$',
47628 & ' B<SUB>s1</SUB>(H)<SUP>0</SUP>',
47629 & ' B$_2^{&star0}$',
47630 & ' B<SUB>2</SUB><SUP>*0</SUP>'/
47631 DATA ((TXNAME(J,I),J=1,2),I=281,288)/
47632 & ' B$_2^{&star+}$',
47633 & ' B<SUB>2</SUB><SUP>*+</SUP>',
47634 & ' B$_{&rm s2}^{&star0}$',
47635 & ' B<SUB>s2</SUB><SUP>*0</SUP>',
47641 & ' b<SUB>1</SUB><SUP>0</SUP>',
47643 & ' b<SUB>1</SUB><SUP>+</SUP>',
47645 & ' b<SUB>1</SUB><SUP>-</SUP>',
47647 & ' h<SUB>1</SUB>(L)<SUP>0</SUP>'/
47648 DATA ((TXNAME(J,I),J=1,2),I=289,296)/
47650 & ' h<SUB>1</SUB>(H)<SUP>0</SUP>',
47652 & ' a<SUB>0</SUB>(980)<SUP>0</SUP>',
47654 & ' a<SUB>0</SUB>(980)<SUP>+</SUP>',
47656 & ' a<SUB>0</SUB>(980)<SUP>-</SUP>',
47658 & ' f<SUB>0</SUB>(980)',
47660 & ' f<SUB>0</SUB>(1370)',
47661 & ' B$_{&rm c}^{&star+}$',
47662 & ' B<SUB>c</SUB><SUP>*+</SUP>',
47663 & ' B$_{&rm c}^{&star-}$',
47664 & ' B<SUB>c</SUB><SUP>*-</SUP>'/
47665 DATA ((TXNAME(J,I),J=1,2),I=297,304)/
47666 & ' B$_{&rm c1}(H)^+$',
47667 & ' B<SUB>c1</SUB>(H)<SUP>+</SUP>',
47668 & ' B$_{&rm c1}(H)^-$',
47669 & ' B<SUB>c1</SUB>(H)<SUP>-</SUP>',
47670 & ' B$_{&rm c2}^{&star+}$',
47671 & ' B<SUB>c2</SUB><SUP>*+</SUP>',
47672 & ' B$_{&rm c2}^{&star-}$',
47673 & ' B<SUB>c2</SUB><SUP>*-</SUP>',
47674 & ' h$_{&rm c}(1P)$',
47675 & ' h<SUB>c</SUB>(1P)',
47676 & ' $&chi_{&rm c0}(1P)$',
47677 & ' chi<SUB>c0</SUB>(1P)',
47678 & ' $&chi_{&rm c2}(1P)$',
47679 & ' chi<SUB>c2</SUB>(1P)',
47680 & ' $&eta_{&rm b}(1S)$',
47681 & ' eta<SUB>b</SUB>(1S)'/
47682 DATA ((TXNAME(J,I),J=1,2),I=305,312)/
47683 & ' h$_{&rm b}(1P)$',
47684 & ' h<SUB>b</SUB>(1P)',
47685 & ' $&chi_{&rm b0}(1P)$',
47686 & ' chi<SUB>b0</SUB>(1P)',
47687 & ' $&chi_{&rm b1}(1P)$',
47688 & ' chi<SUB>b1</SUB>(1P)',
47689 & ' $&chi_{&rm b2}(1P)$',
47690 & ' chi<SUB>b2</SUB>(1P)',
47692 & ' K<SUB>1</SUB>(L)<SUP>0</SUP>',
47694 & ' K<SUB>1</SUB>(L)<SUP>+</SUP>',
47695 & ' $&overline{&rm K}_1(L)^0$',
47696 & ' -K<SUB>1</SUB>(L)<SUP>0</SUP>',
47698 & ' K<SUB>1</SUB>(L)<SUP>-</SUP>'/
47699 DATA ((TXNAME(J,I),J=1,2),I=313,320)/
47701 & ' D<SUB>1</SUB>(L)<SUP>+</SUP>',
47703 & ' D<SUB>1</SUB>(L)<SUP>0</SUP>',
47704 & ' D$_{&rm s1}(L)^+$',
47705 & ' D<SUB>s1</SUB>(L)<SUP>+</SUP>',
47707 & ' D<SUB>1</SUB>(L)<SUP>-</SUP>',
47708 & ' $&overline{&rm D}_1(L)^0$',
47709 & ' D<SUB>1</SUB>(L)<SUP>0</SUP>',
47710 & ' D$_{&rm s1}(L)^-$',
47711 & ' D<SUB>s1</SUB>(L)<SUP>-</SUP>',
47713 & ' B<SUB>1</SUB>(L)<SUP>0</SUP>',
47715 & ' B<SUB>1</SUB>(L)<SUP>+</SUP>'/
47716 DATA ((TXNAME(J,I),J=1,2),I=321,328)/
47717 & ' B$_{&rm s1}(L)^0$',
47718 & ' B<SUB>s1</SUB>(L)<SUP>0</SUP>',
47719 & ' B$_{&rm c1}(L)^+$',
47720 & ' B<SUB>c1</SUB>(L)<SUP>+</SUP>',
47721 & ' $&overline{&rm B}_1(L)^0$',
47722 & ' -B<SUB>1</SUB>(L)<SUP>0</SUP>',
47724 & ' B<SUB>1</SUB>(L)<SUP>-</SUP>',
47725 & ' $&overline{&rm B}_{&rm s1}(L)^0$',
47726 & ' -B<SUB>s1</SUB>(L)<SUP>0</SUP>',
47727 & ' B$_{&rm c1}(L)^-$',
47728 & ' B<SUB>c1</SUB>(L)<SUP>-</SUP>',
47729 & ' K$_0^{&star+}$',
47730 & ' K<SUB>0</SUB><SUP>*+</SUP>',
47731 & ' K$_0^{&star0}$',
47732 & ' K<SUB>0</SUB><SUP>*0</SUP>'/
47733 DATA ((TXNAME(J,I),J=1,2),I=329,336)/
47734 & ' $&overline{&rm K}_0^{&star0}$',
47735 & ' -K<SUB>0</SUB><SUP>*0</SUP>',
47736 & ' K$_0^{&star-}$',
47737 & ' K<SUB>0</SUB><SUP>*-</SUP>',
47738 & ' D$_0^{&star+}$',
47739 & ' D<SUB>0</SUB><SUP>*+</SUP>',
47740 & ' D$_0^{&star0}$',
47741 & ' D<SUB>0</SUB><SUP>*0</SUP>',
47742 & ' D$_{&rm s0}^{&star+}$',
47743 & ' D<SUB>s0</SUB><SUP>*+</SUP>',
47744 & ' D$_0^{&star-}$',
47745 & ' D<SUB>0</SUB><SUP>*-</SUP>',
47746 & ' $&overline{&rm D}_0^{&star0}$',
47747 & ' -D<SUB>0</SUB><SUP>*0</SUP>',
47748 & ' D$_{&rm s0}^{&star-}$',
47749 & ' D<SUB>s0</SUB><SUP>*-</SUP>'/
47750 DATA ((TXNAME(J,I),J=1,2),I=337,344)/
47751 & ' B$_0^{&star0}$',
47752 & ' B<SUB>0</SUB><SUP>*0</SUP>',
47753 & ' B$_0^{&star+}$',
47754 & ' B<SUB>0</SUB><SUP>*+</SUP>',
47755 & ' B$_{&rm s0}^{&star0}$',
47756 & ' B<SUB>s0</SUB><SUP>*0</SUP>',
47757 & ' B$_{&rm c0}^{&star+}$',
47758 & ' B<SUB>c0</SUB><SUP>*+</SUP>',
47759 & ' $&overline{&rm B}_0^{&star0}$',
47760 & ' -B<SUB>0</SUB><SUP>*0</SUP>',
47761 & ' B$_0^{&star-}$',
47762 & ' B<SUB>0</SUB><SUP>*-</SUP>',
47763 & ' $&overline{&rm B}_{&rm s0}^{&star0}$',
47764 & ' -B<SUB>s0</SUB><SUP>*0</SUP>',
47765 & ' B$_{&rm c0}^{&star-}$',
47766 & ' B<SUB>c0</SUB><SUP>*-</SUP>'/
47767 DATA ((TXNAME(J,I),J=1,2),I=345,352)/
47768 & ' $&Sigma_{&rm b}^0$',
47769 & ' Sigma<SUB>b</SUB><SUP>0</SUP>',
47770 & ' $&Sigma_{&rm b}^{&star-}$',
47771 & ' Sigma<SUB>b</SUB><SUP>*-</SUP>',
47772 & ' $&Sigma_{&rm b}^{&star0}$',
47773 & ' Sigma<SUB>b</SUB><SUP>*0</SUP>',
47774 & ' $&Sigma_{&rm b}^{&star+}$',
47775 & ' Sigma<SUB>b</SUB><SUP>*+</SUP>',
47776 & ' $&Xi_{&rm b}^{&prime0}$',
47777 & ' Xi<SUB>b</SUB><SUP>''0</SUP>',
47778 & ' $&Xi_{&rm b}^{&star0}$',
47779 & ' Xi<SUB>b</SUB><SUP>*0</SUP>',
47780 & ' $&Xi_{&rm b}^{&prime-}$',
47781 & ' Xi<SUB>b</SUB><SUP>''-</SUP>',
47782 & ' $&Xi_{&rm b}^{&star-}$',
47783 & ' Xi<SUB>b</SUB><SUP>*-</SUP>'/
47784 DATA ((TXNAME(J,I),J=1,2),I=353,360)/
47785 & ' $&Omega_{&rm b}^{&star-}$',
47786 & ' -Omega<SUB>b</SUB><SUP>*-</SUP>',
47787 & ' $&overline{&Sigma}_{&rm b}^{&star+}$',
47788 & ' Sigma<SUB>b</SUB><SUP>*+</SUP>',
47789 & ' $&overline{&Sigma}_{&rm b}^0$',
47790 & ' -Sigma<SUB>b</SUB><SUP>0</SUP>',
47791 & ' $&overline{&Sigma}_{&rm b}^{&star0}$',
47792 & ' -Sigma<SUB>b</SUB><SUP>*0</SUP>',
47793 & ' $&overline{&Sigma}_{&rm b}^{&star-}$',
47794 & ' -Sigma<SUB>b</SUB><SUP>*-</SUP>',
47795 & ' $&overline{&Xi}_{&rm b}^{&prime0}$',
47796 & ' -Xi<SUB>b</SUB><SUP>''0</SUP>',
47797 & ' $&overline{&Xi}_{&rm b}^{&star0}$',
47798 & ' -Xi<SUB>b</SUB><SUP>*0</SUP>',
47799 & ' $&overline{&Xi}_{&rm b}^{&prime+}$',
47800 & ' -Xi<SUB>b</SUB><SUP>''+</SUP>'/
47801 DATA ((TXNAME(J,I),J=1,2),I=361,368)/
47802 & ' $&overline{&Xi}_{&rm b}^{&star+}$',
47803 & ' -Xi<SUB>b</SUB><SUP>*+</SUP>',
47804 & ' $&Omega_{&rm b}^{&star+}$',
47805 & ' Omega<SUB>b</SUB><SUP>*+</SUP>',
47807 & ' K(DL)<SUB>2</SUB><SUP>+</SUP>',
47809 & ' K(DL)<SUB>2</SUB><SUP>0</SUP>',
47810 & ' $&overline{&rm K}(DL)_2^0$',
47811 & ' -K(DL)<SUB>2</SUB><SUP>0</SUP>',
47813 & ' K(DL)<SUB>2</SUB><SUP>-</SUP>',
47814 & ' K$(D)^{&star+}$',
47815 & ' K(D)<SUP>*+</SUP>',
47816 & ' K$(D)^{&star0}$',
47817 & ' K(D)<SUP>*0</SUP>'/
47818 DATA ((TXNAME(J,I),J=1,2),I=369,376)/
47819 & ' $&overline{&rm K}(D)^{&star0}$',
47820 & ' -K(D)<SUP>*0</SUP>',
47821 & ' K$(D)^{&star-}$',
47822 & ' K(D)<SUP>*-</SUP>',
47824 & ' K(DH)<SUB>2</SUB><SUP>+</SUP>',
47826 & ' K(DH)<SUB>2</SUB><SUP>0</SUP>',
47827 & ' $&overline{&rm K}(DH)_2^0$',
47828 & ' -K(DH)<SUB>2</SUB><SUP>0</SUP>',
47830 & ' K(DH)<SUB>2</SUB><SUP>-</SUP>',
47832 & ' K(D)<SUB>3</SUB><SUP>+</SUP>',
47834 & ' K(D)<SUB>3</SUB><SUP>0</SUP>'/
47835 DATA ((TXNAME(J,I),J=1,2),I=377,384)/
47836 & ' $&overline{&rm K}(D)_3^0$',
47837 & ' -K(D)<SUB>3</SUB><SUP>0</SUP>',
47839 & ' K(D)<SUB>3</SUB><SUP>-</SUP>',
47841 & ' pi<SUB>2</SUB><SUP>+</SUP>',
47843 & ' pi<SUB>2</SUB><SUP>0</SUP>',
47845 & ' pi<SUB>2</SUB><SUP>-</SUP>',
47847 & ' rho(D)<SUP>+</SUP>',
47849 & ' rho(D)<SUP>0</SUP>',
47851 & ' rho(D)<SUP>-</SUP>'/
47852 DATA ((TXNAME(J,I),J=1,2),I=385,392)/
47854 & ' rho<SUB>3</SUB><SUP>+</SUP>',
47856 & ' rho<SUB>3</SUB><SUP>0</SUP>',
47858 & ' rho<SUB>3</SUB><SUP>-</SUP>',
47859 & ' $&Upsilon(2S)$',
47861 & ' $&chi_{&rm b0}(2P)$',
47862 & ' Chi<SUB>b0</SUB>(2P)',
47863 & ' $&chi_{&rm b1}(2P)$',
47864 & ' Chi<SUB>b1</SUB>(2P)',
47865 & ' $&chi_{&rm b2}(2P)$',
47866 & ' Chi<SUB>b2</SUB>(2P)',
47867 & ' $&Upsilon(3S)$',
47869 DATA ((TXNAME(J,I),J=1,2),I=393,400)/
47870 & ' $&Upsilon(4S)$',
47875 & ' omega<SUB>3</SUB>',
47877 & ' phi<SUB>3</SUB>',
47879 & ' eta<SUB>2</SUB>(L)',
47881 & ' eta<SUB>2</SUB>(H)',
47886 DATA ((TXNAME(J,I),J=1,2),I=401,408)/
47887 & ' $&tilde{&rm d}_{&rm L}$',
47888 & ' ~d<SUB>L</SUB>',
47889 & ' $&tilde{&rm u}_{&rm L}$',
47890 & ' ~u<SUB>L</SUB>',
47891 & ' $&tilde{&rm s}_{&rm L}$',
47892 & ' ~s<SUB>L</SUB>',
47893 & ' $&tilde{&rm c}_{&rm L}$',
47894 & ' ~c<SUB>L</SUB>',
47895 & ' $&tilde{&rm b}_1$',
47896 & ' ~b<SUB>1</SUB>',
47897 & ' $&tilde{&rm t}_1$',
47898 & ' ~t<SUB>1</SUB>',
47899 & ' $&overline{&tilde{&rm d}}_{&rm L}$',
47900 & ' -~d<SUB>L</SUB>',
47901 & ' $&overline{&tilde{&rm u}}_{&rm L}$',
47902 & ' -~u<SUB>L</SUB>'/
47903 DATA ((TXNAME(J,I),J=1,2),I=409,416)/
47904 & ' $&overline{&tilde{&rm s}}_{&rm L}$',
47905 & ' -~s<SUB>L</SUB>',
47906 & ' $&overline{&tilde{&rm c}}_{&rm L}$',
47907 & ' -~c<SUB>L</SUB>',
47908 & ' $&overline{&tilde{&rm b}}_1$',
47909 & ' -~b<SUB>1</SUB>',
47910 & ' $&overline{&tilde{&rm t}}_1$',
47911 & ' -~t<SUB>1</SUB>',
47912 & ' $&tilde{&rm d}_{&rm R}$',
47913 & ' ~d<SUB>R</SUB>',
47914 & ' $&tilde{&rm u}_{&rm R}$',
47915 & ' ~u<SUB>R</SUB>',
47916 & ' $&tilde{&rm s}_{&rm R}$',
47917 & ' ~s<SUB>R</SUB>',
47918 & ' $&tilde{&rm c}_{&rm R}$',
47919 & ' ~c<SUB>R</SUB>'/
47920 DATA ((TXNAME(J,I),J=1,2),I=417,424)/
47921 & ' $&tilde{&rm b}_2$',
47922 & ' ~b<SUB>2</SUB>',
47923 & ' $&tilde{&rm t}_2$',
47924 & ' ~t<SUB>2</SUB>',
47925 & ' $&overline{&tilde{&rm d}}_{&rm R}$',
47926 & ' -~d<SUB>R</SUB>',
47927 & ' $&overline{&tilde{&rm u}}_{&rm R}$',
47928 & ' -~u<SUB>R</SUB>',
47929 & ' $&overline{&tilde{&rm s}}_{&rm R}$',
47930 & ' -~s<SUB>R</SUB>',
47931 & ' $&overline{&tilde{&rm c}}_{&rm R}$',
47932 & ' -~c<SUB>R</SUB>',
47933 & ' $&overline{&tilde{&rm b}}_2$',
47934 & ' -~b<SUB>2</SUB>',
47935 & ' $&overline{&tilde{&rm t}}_2$',
47936 & ' -~t<SUB>2</SUB>'/
47937 DATA ((TXNAME(J,I),J=1,2),I=425,432)/
47938 & ' $&tilde{&rm e}^-_{&rm L}$',
47939 & ' ~e<SUP>-</SUP><SUB>L</SUB>',
47940 & ' $&tilde{&nu}_{&rm e}$',
47941 & ' ~nu<SUB>e L</SUB>',
47942 & ' $&tilde{&mu}^-_{&rm L}$',
47943 & ' ~mu<SUP>-</SUP><SUB>L</SUB>',
47944 & ' $&tilde{&nu}_&mu$',
47945 & ' ~nu<SUB>mu L</SUB>',
47946 & ' $&tilde{&tau}^-_1$',
47947 & ' ~tau<SUP>-</SUP><SUB>1</SUB>',
47948 & ' $&tilde{&nu}_&tau$',
47949 & ' ~nu<SUB>tau L</SUB>',
47950 & ' $&tilde{&rm e}^+_{&rm L}$',
47951 & ' ~e<SUP>+</SUP><SUB>L</SUB>',
47952 & ' $&overline{&tilde{&nu}}_{&rm eL}$',
47953 & ' -~nu<SUB>eL</SUB>'/
47954 DATA ((TXNAME(J,I),J=1,2),I=433,440)/
47955 & ' $&tilde{&mu}^+_{&rm L}$',
47956 & ' ~mu<SUP>+</SUP><SUB>L</SUB>',
47957 & ' $&overline{&tilde{&nu}}_{&rm&mu L}$',
47958 & ' -~nu<SUB>mu L</SUB>',
47959 & ' $&tilde{&tau}^+_1$',
47960 & ' ~tau<SUP>+</SUP><SUB>1</SUB>',
47961 & ' $&overline{&tilde{&nu}}_{&rm&tau L}$',
47962 & ' -~nu<SUB>tau L</SUB>',
47963 & ' $&tilde{&rm e}^-_{&rm R}$',
47964 & ' ~e<SUP>-</SUP><SUB>R</SUB>',
47965 & ' $&tilde{&nu}_{&rm eR}$',
47966 & ' ~nu<SUB>e R</SUB>',
47967 & ' $&tilde{&mu}^-_{&rm R}$',
47968 & ' ~mu<SUP>-</SUP><SUB>R</SUB>',
47969 & ' $&tilde{&nu}_{&mu{&rm R}}$',
47970 & ' ~nu<SUB>mu R</SUB>'/
47971 DATA ((TXNAME(J,I),J=1,2),I=441,448)/
47972 & ' $&tilde{&tau}^-_2$',
47973 & ' ~tau<SUP>-</SUP><SUB>2</SUB>',
47974 & ' $&tilde{&nu}_{&tau{&rm R}}$',
47975 & ' ~nu<SUB>tau R</SUB>',
47976 & ' $&tilde{&rm e}^+_{&rm R}$',
47977 & ' ~e<SUP>+</SUP><SUB>R</SUB>',
47978 & ' $&overline{&tilde{&nu}}_{&rm eR}$',
47979 & ' -~nu<SUB>e R</SUB>',
47980 & ' $&tilde{&mu}^+_{&rm R}$',
47981 & ' ~mu<SUP>+</SUP><SUB>R</SUB>',
47982 & ' $&overline{&tilde{&nu}}_{&rm&mu R}$',
47983 & ' -~nu<SUB>mu R</SUB>',
47984 & ' $&tilde{&tau}^+_2$',
47985 & ' ~tau<SUP>+</SUP><SUB>2</SUB>',
47986 & ' $&overline{&tilde{&nu}}_{&rm&tau R}$',
47987 & ' -~nu<SUB>tau R</SUB>'/
47988 DATA ((TXNAME(J,I),J=1,2),I=449,456)/
47991 & ' $&tilde{&chi}^0_1$',
47992 & ' ~chi<SUP>0</SUP><SUB>1</SUB>',
47993 & ' $&tilde{&chi}^0_2$',
47994 & ' ~chi<SUP>0</SUP><SUB>2</SUB>',
47995 & ' $&tilde{&chi}^0_3$',
47996 & ' ~chi<SUP>0</SUP><SUB>3</SUB>',
47997 & ' $&tilde{&chi}^0_4$',
47998 & ' ~chi<SUP>0</SUP><SUB>4</SUB>',
47999 & ' $&tilde{&chi}^+_1$',
48000 & ' ~chi<SUP>+</SUP><SUB>1</SUB>',
48001 & ' $&tilde{&chi}^+_2$',
48002 & ' ~chi<SUP>+</SUP><SUB>2</SUB>',
48003 & ' $&tilde{&chi}^-_1$',
48004 & ' ~chi<SUP>-</SUP><SUB>1</SUB>'/
48005 DATA ((TXNAME(J,I),J=1,2),I=457,NLAST)/
48006 & ' $&tilde{&chi}^-_2$',
48007 & ' ~chi<SUP>-</SUP><SUB>2</SUB>',
48011 DATA (RNAME(I),I=NNEXT,NMXRES)/NLEFT*' '/
48012 DATA (IDPDG(I),I=NNEXT,NMXRES)/NLEFT*0/
48013 DATA (IFLAV(I),I=NNEXT,NMXRES)/NLEFT*0/
48014 DATA (RMASS(I),I=NNEXT,NMXRES)/NLEFT*0.0000D0/
48015 DATA (RLTIM(I),I=NNEXT,NMXRES)/NLEFT*0.000D+00/
48016 DATA (RSPIN(I),I=NNEXT,NMXRES)/NLEFT*0.0D0/
48017 DATA (TXNAME(1,I),I=NNEXT,NMXRES)/
48019 DATA (TXNAME(2,I),I=NNEXT,NMXRES)/
48022 DATA (RSTAB(I),I=1,NMXRES)/NMXRES*.FALSE./
48023 DATA DKPSET/.FALSE./
48026 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 1, 19)/
48027 & 6,0.334D0,100, 2, 7, 5, 0, 0,
48028 & 6,0.333D0,100, 4, 9, 5, 0, 0,
48029 & 6,0.111D0,100,122,127, 5, 0, 0,
48030 & 6,0.111D0,100,124,129, 5, 0, 0,
48031 & 6,0.111D0,100,126,131, 5, 0, 0,
48032 & 12,0.334D0,100, 8, 1, 11, 0, 0,
48033 & 12,0.333D0,100, 10, 3, 11, 0, 0,
48034 & 12,0.111D0,100,128,121, 11, 0, 0,
48035 & 12,0.111D0,100,130,123, 11, 0, 0,
48036 & 12,0.111D0,100,132,125, 11, 0, 0,
48037 & 21,0.988D0, 0, 59, 59, 0, 0, 0,
48038 & 21,0.012D0, 0,127,121, 59, 0, 0,
48039 & 22,0.388D0, 0, 59, 59, 0, 0, 0,
48040 & 22,0.319D0, 0, 21, 21, 21, 0, 0,
48041 & 22,0.001D0, 0, 21, 59, 59, 0, 0,
48042 & 22,0.236D0, 0, 38, 30, 21, 0, 0,
48043 & 22,0.049D0, 0, 38, 30, 59, 0, 0,
48044 & 22,0.005D0, 0,127,121, 59, 0, 0,
48045 & 22,0.002D0, 0, 38, 30,127,121, 0/
48046 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 20, 38)/
48047 & 23,0.989D0, 0, 38, 30, 0, 0, 0,
48048 & 23,0.010D0, 0, 38, 30, 59, 0, 0,
48049 & 23,0.001D0, 0, 21, 59, 0, 0, 0,
48050 & 24,0.888D0, 0, 38, 30, 21, 0, 0,
48051 & 24,0.085D0, 0, 21, 59, 0, 0, 0,
48052 & 24,0.022D0, 0, 38, 30, 0, 0, 0,
48053 & 24,0.001D0, 0, 22, 59, 0, 0, 0,
48054 & 24,0.001D0, 0, 21,127,121, 0, 0,
48055 & 24,0.003D0, 0, 38, 30, 21, 21, 0,
48056 & 25,0.437D0, 0, 38, 30, 22, 0, 0,
48057 & 25,0.302D0, 0, 23, 59, 0, 0, 0,
48058 & 25,0.208D0, 0, 21, 21, 22, 0, 0,
48059 & 25,0.030D0, 0, 24, 59, 0, 0, 0,
48060 & 25,0.021D0, 0, 59, 59, 0, 0, 0,
48061 & 25,0.002D0, 0, 21, 21, 21, 0, 0,
48062 & 26,0.566D0, 0, 38, 30, 0, 0, 0,
48063 & 26,0.283D0, 0, 21, 21, 0, 0, 0,
48064 & 26,0.069D0, 0, 38, 30, 21, 21, 0,
48065 & 26,0.023D0, 0, 46, 34, 0, 0, 0/
48066 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 39, 57)/
48067 & 26,0.023D0, 0, 50, 42, 0, 0, 0,
48068 & 26,0.028D0, 0, 38, 38, 30, 30, 0,
48069 & 26,0.005D0, 0, 22, 22, 0, 0, 0,
48070 & 26,0.003D0, 0, 21, 21, 21, 21, 0,
48071 & 27,0.499D0, 0, 39, 30, 0, 0, 0,
48072 & 27,0.499D0, 0, 31, 38, 0, 0, 0,
48073 & 27,0.002D0, 0, 21, 59, 59, 0, 0,
48074 & 28,0.148D0, 0, 21, 21, 38, 30, 0,
48075 & 28,0.148D0, 0, 23, 38, 30, 0, 0,
48076 & 28,0.147D0, 0,291, 30, 0, 0, 0,
48077 & 28,0.147D0, 0,290, 21, 0, 0, 0,
48078 & 28,0.147D0, 0,292, 38, 0, 0, 0,
48079 & 28,0.067D0, 0, 22, 38, 30, 0, 0,
48080 & 28,0.033D0, 0, 22, 21, 21, 0, 0,
48081 & 28,0.032D0, 0, 46, 42, 30, 0, 0,
48082 & 28,0.016D0, 0, 46, 34, 21, 0, 0,
48083 & 28,0.016D0, 0, 50, 42, 21, 0, 0,
48084 & 28,0.032D0, 0, 50, 34, 38, 0, 0,
48085 & 28,0.066D0, 0, 59, 23, 0, 0, 0/
48086 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 58, 76)/
48087 & 28,0.001D0, 0, 56, 59, 0, 0, 0,
48088 & 29,0.349D0, 0, 39, 30, 0, 0, 0,
48089 & 29,0.349D0, 0, 31, 38, 0, 0, 0,
48090 & 29,0.144D0, 0, 22, 21, 0, 0, 0,
48091 & 29,0.104D0, 0, 24, 38, 30, 0, 0,
48092 & 29,0.024D0, 0, 46, 34, 0, 0, 0,
48093 & 29,0.024D0, 0, 50, 42, 0, 0, 0,
48094 & 29,0.006D0, 0, 25, 21, 0, 0, 0,
48095 & 30,1.000D0, 0,123,130, 0, 0, 0,
48096 & 31,1.000D0, 0, 30, 21, 0, 0, 0,
48097 & 32,0.499D0, 0, 31, 21, 0, 0, 0,
48098 & 32,0.499D0, 0, 23, 30, 0, 0, 0,
48099 & 32,0.002D0, 0, 30, 59, 0, 0, 0,
48100 & 33,0.349D0, 0, 31, 21, 0, 0, 0,
48101 & 33,0.349D0, 0, 23, 30, 0, 0, 0,
48102 & 33,0.144D0, 0, 22, 30, 0, 0, 0,
48103 & 33,0.101D0, 0, 24, 30, 21, 0, 0,
48104 & 33,0.048D0, 0, 50, 34, 0, 0, 0,
48105 & 33,0.006D0, 0, 25, 30, 0, 0, 0/
48106 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 77, 95)/
48107 & 33,0.003D0, 0, 30, 59, 0, 0, 0,
48108 & 34,0.629D0, 0,123,130, 0, 0, 0,
48109 & 34,0.212D0, 0, 30, 21, 0, 0, 0,
48110 & 34,0.056D0, 0, 30, 38, 30, 0, 0,
48111 & 34,0.017D0, 0, 30, 21, 21, 0, 0,
48112 & 34,0.048D0,101,121,128, 21, 0, 0,
48113 & 34,0.032D0,101,123,130, 21, 0, 0,
48114 & 34,0.006D0, 0,123,130, 59, 0, 0,
48115 & 35,0.666D0, 0, 42, 30, 0, 0, 0,
48116 & 35,0.333D0, 0, 34, 21, 0, 0, 0,
48117 & 35,0.001D0, 0, 34, 59, 0, 0, 0,
48118 & 36,0.627D0, 0, 43, 30, 0, 0, 0,
48119 & 36,0.313D0, 0, 35, 21, 0, 0, 0,
48120 & 36,0.020D0, 0, 42, 31, 0, 0, 0,
48121 & 36,0.010D0, 0, 34, 23, 0, 0, 0,
48122 & 36,0.020D0, 0, 34,294, 0, 0, 0,
48123 & 36,0.010D0, 0, 34, 24, 0, 0, 0,
48124 & 37,0.331D0, 0, 42, 30, 0, 0, 0,
48125 & 37,0.166D0, 0, 34, 21, 0, 0, 0/
48126 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 96, 114)/
48127 & 37,0.168D0, 0, 43, 30, 0, 0, 0,
48128 & 37,0.084D0, 0, 35, 21, 0, 0, 0,
48129 & 37,0.087D0, 0, 35, 38, 30, 0, 0,
48130 & 37,0.044D0, 0, 35, 21, 21, 0, 0,
48131 & 37,0.059D0, 0, 42, 31, 0, 0, 0,
48132 & 37,0.029D0, 0, 34, 23, 0, 0, 0,
48133 & 37,0.029D0, 0, 34, 24, 0, 0, 0,
48134 & 37,0.002D0, 0, 34, 59, 0, 0, 0,
48135 & 37,0.001D0, 0, 34, 22, 0, 0, 0,
48136 & 38,1.000D0, 0,129,124, 0, 0, 0,
48137 & 39,1.000D0, 0, 38, 21, 0, 0, 0,
48138 & 40,0.499D0, 0, 39, 21, 0, 0, 0,
48139 & 40,0.499D0, 0, 23, 38, 0, 0, 0,
48140 & 40,0.002D0, 0, 38, 59, 0, 0, 0,
48141 & 41,0.349D0, 0, 39, 21, 0, 0, 0,
48142 & 41,0.349D0, 0, 23, 38, 0, 0, 0,
48143 & 41,0.144D0, 0, 22, 38, 0, 0, 0,
48144 & 41,0.101D0, 0, 24, 38, 21, 0, 0,
48145 & 41,0.048D0, 0, 46, 42, 0, 0, 0/
48146 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 115, 133)/
48147 & 41,0.006D0, 0, 25, 38, 0, 0, 0,
48148 & 41,0.003D0, 0, 38, 59, 0, 0, 0,
48149 & 42,0.500D0, 0, 60, 0, 0, 0, 0,
48150 & 42,0.500D0, 0, 61, 0, 0, 0, 0,
48151 & 43,0.665D0, 0, 34, 38, 0, 0, 0,
48152 & 43,0.333D0, 0, 42, 21, 0, 0, 0,
48153 & 43,0.002D0, 0, 42, 59, 0, 0, 0,
48154 & 44,0.627D0, 0, 35, 38, 0, 0, 0,
48155 & 44,0.313D0, 0, 43, 21, 0, 0, 0,
48156 & 44,0.020D0, 0, 34, 39, 0, 0, 0,
48157 & 44,0.010D0, 0, 42, 23, 0, 0, 0,
48158 & 44,0.020D0, 0, 42,294, 0, 0, 0,
48159 & 44,0.010D0, 0, 42, 24, 0, 0, 0,
48160 & 45,0.331D0, 0, 34, 38, 0, 0, 0,
48161 & 45,0.166D0, 0, 42, 21, 0, 0, 0,
48162 & 45,0.168D0, 0, 35, 38, 0, 0, 0,
48163 & 45,0.084D0, 0, 43, 21, 0, 0, 0,
48164 & 45,0.089D0, 0, 42, 38, 30, 0, 0,
48165 & 45,0.044D0, 0, 42, 21, 21, 0, 0/
48166 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 134, 152)/
48167 & 45,0.059D0, 0, 34, 39, 0, 0, 0,
48168 & 45,0.029D0, 0, 42, 23, 0, 0, 0,
48169 & 45,0.029D0, 0, 42, 24, 0, 0, 0,
48170 & 45,0.001D0, 0, 42, 22, 0, 0, 0,
48171 & 46,0.629D0, 0,129,124, 0, 0, 0,
48172 & 46,0.212D0, 0, 38, 21, 0, 0, 0,
48173 & 46,0.056D0, 0, 38, 38, 30, 0, 0,
48174 & 46,0.017D0, 0, 38, 21, 21, 0, 0,
48175 & 46,0.032D0,101,129,124, 21, 0, 0,
48176 & 46,0.048D0,101,127,122, 21, 0, 0,
48177 & 46,0.006D0, 0,129,124, 59, 0, 0,
48178 & 47,0.666D0, 0, 50, 38, 0, 0, 0,
48179 & 47,0.333D0, 0, 46, 21, 0, 0, 0,
48180 & 47,0.001D0, 0, 46, 59, 0, 0, 0,
48181 & 48,0.627D0, 0, 51, 38, 0, 0, 0,
48182 & 48,0.313D0, 0, 47, 21, 0, 0, 0,
48183 & 48,0.020D0, 0, 50, 39, 0, 0, 0,
48184 & 48,0.010D0, 0, 46, 23, 0, 0, 0,
48185 & 48,0.020D0, 0, 46,294, 0, 0, 0/
48186 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 153, 171)/
48187 & 48,0.010D0, 0, 46, 24, 0, 0, 0,
48188 & 49,0.331D0, 0, 50, 38, 0, 0, 0,
48189 & 49,0.166D0, 0, 46, 21, 0, 0, 0,
48190 & 49,0.168D0, 0, 51, 38, 0, 0, 0,
48191 & 49,0.084D0, 0, 47, 21, 0, 0, 0,
48192 & 49,0.087D0, 0, 47, 38, 30, 0, 0,
48193 & 49,0.044D0, 0, 47, 21, 21, 0, 0,
48194 & 49,0.059D0, 0, 50, 39, 0, 0, 0,
48195 & 49,0.029D0, 0, 46, 23, 0, 0, 0,
48196 & 49,0.029D0, 0, 46, 24, 0, 0, 0,
48197 & 49,0.002D0, 0, 46, 59, 0, 0, 0,
48198 & 49,0.001D0, 0, 46, 22, 0, 0, 0,
48199 & 50,0.500D0, 0, 60, 0, 0, 0, 0,
48200 & 50,0.500D0, 0, 61, 0, 0, 0, 0,
48201 & 51,0.665D0, 0, 46, 30, 0, 0, 0,
48202 & 51,0.333D0, 0, 50, 21, 0, 0, 0,
48203 & 51,0.002D0, 0, 50, 59, 0, 0, 0,
48204 & 52,0.627D0, 0, 47, 30, 0, 0, 0,
48205 & 52,0.313D0, 0, 51, 21, 0, 0, 0/
48206 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 172, 190)/
48207 & 52,0.020D0, 0, 46, 31, 0, 0, 0,
48208 & 52,0.010D0, 0, 50, 23, 0, 0, 0,
48209 & 52,0.020D0, 0, 50,294, 0, 0, 0,
48210 & 52,0.010D0, 0, 50, 24, 0, 0, 0,
48211 & 53,0.331D0, 0, 46, 30, 0, 0, 0,
48212 & 53,0.166D0, 0, 50, 21, 0, 0, 0,
48213 & 53,0.168D0, 0, 47, 30, 0, 0, 0,
48214 & 53,0.084D0, 0, 51, 21, 0, 0, 0,
48215 & 53,0.089D0, 0, 50, 38, 30, 0, 0,
48216 & 53,0.044D0, 0, 50, 21, 21, 0, 0,
48217 & 53,0.059D0, 0, 46, 31, 0, 0, 0,
48218 & 53,0.029D0, 0, 50, 23, 0, 0, 0,
48219 & 53,0.029D0, 0, 50, 24, 0, 0, 0,
48220 & 53,0.001D0, 0, 50, 22, 0, 0, 0,
48221 & 56,0.490D0, 0, 46, 34, 0, 0, 0,
48222 & 56,0.342D0, 0, 61, 60, 0, 0, 0,
48223 & 56,0.043D0, 0, 39, 30, 0, 0, 0,
48224 & 56,0.043D0, 0, 23, 21, 0, 0, 0,
48225 & 56,0.043D0, 0, 31, 38, 0, 0, 0/
48226 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 191, 209)/
48227 & 56,0.025D0, 0, 38, 30, 21, 0, 0,
48228 & 56,0.013D0, 0, 22, 59, 0, 0, 0,
48229 & 56,0.001D0, 0, 21, 59, 0, 0, 0,
48230 & 57,0.250D0, 0, 50, 43, 0, 0, 0,
48231 & 57,0.250D0, 0, 34, 47, 0, 0, 0,
48232 & 57,0.250D0, 0, 42, 51, 0, 0, 0,
48233 & 57,0.250D0, 0, 46, 35, 0, 0, 0,
48234 & 58,0.356D0, 0, 46, 34, 0, 0, 0,
48235 & 58,0.356D0, 0, 50, 42, 0, 0, 0,
48236 & 58,0.279D0, 0, 22, 22, 0, 0, 0,
48237 & 58,0.006D0, 0, 38, 30, 0, 0, 0,
48238 & 58,0.003D0, 0, 21, 21, 0, 0, 0,
48239 & 60,0.684D0, 0, 38, 30, 0, 0, 0,
48240 & 60,0.314D0, 0, 21, 21, 0, 0, 0,
48241 & 60,0.002D0, 0, 38, 30, 59, 0, 0,
48242 & 61,0.216D0, 0, 21, 21, 21, 0, 0,
48243 & 61,0.124D0, 0, 38, 30, 21, 0, 0,
48244 & 61,0.135D0,101,123,130, 38, 0, 0,
48245 & 61,0.135D0,101,124,129, 30, 0, 0/
48246 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 210, 228)/
48247 & 61,0.187D0,101,121,128, 38, 0, 0,
48248 & 61,0.187D0,101,122,127, 30, 0, 0,
48249 & 61,0.006D0, 0,121,128, 38, 59, 0,
48250 & 61,0.006D0, 0,122,127, 30, 59, 0,
48251 & 61,0.002D0, 0, 38, 30, 0, 0, 0,
48252 & 61,0.001D0, 0, 21, 21, 0, 0, 0,
48253 & 61,0.001D0, 0, 59, 59, 0, 0, 0,
48254 & 74,0.663D0, 0, 73, 21, 0, 0, 0,
48255 & 74,0.331D0, 0, 75, 38, 0, 0, 0,
48256 & 74,0.006D0, 0, 73, 59, 0, 0, 0,
48257 & 75,1.000D0,101,121,128, 73, 0, 0,
48258 & 76,0.663D0, 0, 75, 21, 0, 0, 0,
48259 & 76,0.331D0, 0, 73, 30, 0, 0, 0,
48260 & 76,0.006D0, 0, 75, 59, 0, 0, 0,
48261 & 77,1.000D0, 0, 75, 30, 0, 0, 0,
48262 & 78,0.638D0, 0, 73, 30, 0, 0, 0,
48263 & 78,0.358D0, 0, 75, 21, 0, 0, 0,
48264 & 78,0.002D0, 0, 75, 59, 0, 0, 0,
48265 & 78,0.001D0, 0, 73, 30, 59, 0, 0/
48266 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 229, 247)/
48267 & 78,0.001D0,101,121,128, 73, 0, 0,
48268 & 79,0.995D0, 0, 78, 59, 0, 0, 0,
48269 & 79,0.005D0, 0, 78,127,121, 0, 0,
48270 & 80,0.880D0, 0, 78, 21, 0, 0, 0,
48271 & 80,0.060D0, 0, 86, 30, 0, 0, 0,
48272 & 80,0.060D0, 0, 81, 38, 0, 0, 0,
48273 & 81,0.998D0, 0, 75, 30, 0, 0, 0,
48274 & 81,0.001D0, 0, 75, 30, 59, 0, 0,
48275 & 81,0.001D0,101,121,128, 75, 0, 0,
48276 & 82,0.880D0, 0, 78, 30, 0, 0, 0,
48277 & 82,0.060D0, 0, 79, 30, 0, 0, 0,
48278 & 82,0.060D0, 0, 81, 21, 0, 0, 0,
48279 & 83,0.999D0, 0, 78, 30, 0, 0, 0,
48280 & 83,0.001D0,101,121,128, 78, 0, 0,
48281 & 84,0.667D0, 0, 88, 30, 0, 0, 0,
48282 & 84,0.333D0, 0, 83, 21, 0, 0, 0,
48283 & 85,1.000D0, 0, 73, 38, 0, 0, 0,
48284 & 86,0.516D0, 0, 73, 21, 0, 0, 0,
48285 & 86,0.483D0, 0, 75, 38, 0, 0, 0/
48286 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 248, 266)/
48287 & 86,0.001D0, 0, 73, 59, 0, 0, 0,
48288 & 87,0.880D0, 0, 78, 38, 0, 0, 0,
48289 & 87,0.060D0, 0, 86, 21, 0, 0, 0,
48290 & 87,0.060D0, 0, 79, 38, 0, 0, 0,
48291 & 88,0.995D0, 0, 78, 21, 0, 0, 0,
48292 & 88,0.001D0, 0, 78, 59, 0, 0, 0,
48293 & 88,0.004D0, 0, 79, 59, 0, 0, 0,
48294 & 89,0.667D0, 0, 83, 38, 0, 0, 0,
48295 & 89,0.333D0, 0, 88, 21, 0, 0, 0,
48296 & 90,0.675D0, 0, 78, 34, 0, 0, 0,
48297 & 90,0.233D0, 0, 88, 30, 0, 0, 0,
48298 & 90,0.086D0, 0, 83, 21, 0, 0, 0,
48299 & 90,0.006D0,101,121,128, 88, 0, 0,
48300 & 92,0.663D0, 0, 91, 21, 0, 0, 0,
48301 & 92,0.331D0, 0, 93, 30, 0, 0, 0,
48302 & 92,0.006D0, 0, 91, 59, 0, 0, 0,
48303 & 93,1.000D0,101,127,122, 91, 0, 0,
48304 & 94,0.663D0, 0, 93, 21, 0, 0, 0,
48305 & 94,0.331D0, 0, 91, 38, 0, 0, 0/
48306 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 267, 285)/
48307 & 94,0.006D0, 0, 93, 59, 0, 0, 0,
48308 & 95,1.000D0, 0, 93, 38, 0, 0, 0,
48309 & 96,0.638D0, 0, 91, 38, 0, 0, 0,
48310 & 96,0.358D0, 0, 93, 21, 0, 0, 0,
48311 & 96,0.002D0, 0, 93, 59, 0, 0, 0,
48312 & 96,0.001D0, 0, 91, 38, 59, 0, 0,
48313 & 96,0.001D0,101,127,122, 91, 0, 0,
48314 & 97,0.995D0, 0, 96, 59, 0, 0, 0,
48315 & 97,0.005D0, 0, 96,127,121, 0, 0,
48316 & 98,0.880D0, 0, 96, 21, 0, 0, 0,
48317 & 98,0.060D0, 0,104, 38, 0, 0, 0,
48318 & 98,0.060D0, 0, 99, 30, 0, 0, 0,
48319 & 99,0.998D0, 0, 93, 38, 0, 0, 0,
48320 & 99,0.001D0, 0, 93, 38, 59, 0, 0,
48321 & 99,0.001D0,101,127,122, 93, 0, 0,
48322 & 100,0.880D0, 0, 96, 38, 0, 0, 0,
48323 & 100,0.060D0, 0, 97, 38, 0, 0, 0,
48324 & 100,0.060D0, 0, 99, 21, 0, 0, 0,
48325 & 101,0.999D0, 0, 96, 38, 0, 0, 0/
48326 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 286, 304)/
48327 & 101,0.001D0,101,127,122, 96, 0, 0,
48328 & 102,0.667D0, 0,106, 38, 0, 0, 0,
48329 & 102,0.333D0, 0,101, 21, 0, 0, 0,
48330 & 103,1.000D0, 0, 91, 30, 0, 0, 0,
48331 & 104,0.516D0, 0, 91, 21, 0, 0, 0,
48332 & 104,0.483D0, 0, 93, 30, 0, 0, 0,
48333 & 104,0.001D0, 0, 91, 59, 0, 0, 0,
48334 & 105,0.880D0, 0, 96, 30, 0, 0, 0,
48335 & 105,0.060D0, 0,104, 21, 0, 0, 0,
48336 & 105,0.060D0, 0, 97, 30, 0, 0, 0,
48337 & 106,0.995D0, 0, 96, 21, 0, 0, 0,
48338 & 106,0.001D0, 0, 96, 59, 0, 0, 0,
48339 & 106,0.004D0, 0, 97, 59, 0, 0, 0,
48340 & 107,0.667D0, 0,101, 30, 0, 0, 0,
48341 & 107,0.333D0, 0,106, 21, 0, 0, 0,
48342 & 108,0.675D0, 0, 96, 46, 0, 0, 0,
48343 & 108,0.233D0, 0,106, 38, 0, 0, 0,
48344 & 108,0.086D0, 0,101, 21, 0, 0, 0,
48345 & 108,0.006D0,101,127,122,106, 0, 0/
48346 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 305, 323)/
48347 & 123,0.986D0,100,121,128,124, 0, 0,
48348 & 123,0.014D0, 0,121,128,124, 59, 0,
48349 & 125,0.178D0,100,121,128,126, 0, 0,
48350 & 125,0.171D0,100,123,130,126, 0, 0,
48351 & 125,0.002D0, 0,123,130, 59,126, 0,
48352 & 125,0.111D0, 0, 30,126, 0, 0, 0,
48353 & 125,0.253D0, 0, 31,126, 0, 0, 0,
48354 & 125,0.181D0, 0, 32,126, 0, 0, 0,
48355 & 125,0.002D0, 0, 30, 22, 21,126, 0,
48356 & 125,0.018D0, 0, 30, 24,126, 0, 0,
48357 & 125,0.004D0, 0, 30, 24, 21,126, 0,
48358 & 125,0.015D0, 0, 31, 23,126, 0, 0,
48359 & 125,0.001D0, 0, 31, 24, 21,126, 0,
48360 & 125,0.024D0, 0, 32, 21,126, 0, 0,
48361 & 125,0.002D0, 0, 32, 38, 30,126, 0,
48362 & 125,0.007D0, 0, 34,126, 0, 0, 0,
48363 & 125,0.014D0, 0, 35,126, 0, 0, 0,
48364 & 125,0.003D0, 0, 35, 21,126, 0, 0,
48365 & 125,0.001D0, 0, 34, 38, 30,126, 0/
48366 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 324, 342)/
48367 & 125,0.004D0, 0, 30, 43,126, 0, 0,
48368 & 125,0.003D0, 0, 34, 50,126, 0, 0,
48369 & 125,0.003D0, 0, 34, 51,126, 0, 0,
48370 & 125,0.003D0, 0, 30, 50, 42,126, 0,
48371 & 129,0.986D0,100,127,122,130, 0, 0,
48372 & 129,0.014D0, 0,127,122,130, 59, 0,
48373 & 131,0.178D0,100,127,122,132, 0, 0,
48374 & 131,0.171D0,100,129,124,132, 0, 0,
48375 & 131,0.002D0, 0,129,124, 59,132, 0,
48376 & 131,0.111D0, 0, 38,132, 0, 0, 0,
48377 & 131,0.253D0, 0, 39,132, 0, 0, 0,
48378 & 131,0.181D0, 0, 40,132, 0, 0, 0,
48379 & 131,0.002D0, 0, 38, 22, 21,132, 0,
48380 & 131,0.018D0, 0, 38, 24,132, 0, 0,
48381 & 131,0.004D0, 0, 38, 24, 21,132, 0,
48382 & 131,0.015D0, 0, 39, 23,132, 0, 0,
48383 & 131,0.001D0, 0, 39, 24, 21,132, 0,
48384 & 131,0.024D0, 0, 40, 21,132, 0, 0,
48385 & 131,0.002D0, 0, 40, 38, 30,132, 0/
48386 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 343, 361)/
48387 & 131,0.007D0, 0, 46,132, 0, 0, 0,
48388 & 131,0.014D0, 0, 47,132, 0, 0, 0,
48389 & 131,0.003D0, 0, 47, 21,132, 0, 0,
48390 & 131,0.001D0, 0, 46, 38, 30,132, 0,
48391 & 131,0.004D0, 0, 38, 51,132, 0, 0,
48392 & 131,0.003D0, 0, 46, 42,132, 0, 0,
48393 & 131,0.003D0, 0, 46, 43,132, 0, 0,
48394 & 131,0.003D0, 0, 38, 50, 42,132, 0,
48395 & 136,0.067D0,101,122,127, 42, 0, 0,
48396 & 136,0.067D0,101,124,129, 42, 0, 0,
48397 & 136,0.048D0,101,122,127, 43, 0, 0,
48398 & 136,0.048D0,101,124,129, 43, 0, 0,
48399 & 136,0.003D0, 0, 34, 38,122,127, 0,
48400 & 136,0.003D0, 0, 34, 38,124,129, 0,
48401 & 136,0.006D0,101,122,127, 21, 0, 0,
48402 & 136,0.006D0,101,124,129, 21, 0, 0,
48403 & 136,0.002D0,101,122,127, 23, 0, 0,
48404 & 136,0.002D0,101,124,129, 23, 0, 0,
48405 & 136,0.055D0, 0, 34, 38, 38, 0, 0/
48406 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 362, 380)/
48407 & 136,0.031D0, 0, 34, 39, 38, 0, 0,
48408 & 136,0.042D0, 0, 34, 38, 38, 21, 21,
48409 & 136,0.002D0, 0, 34, 38, 38, 38, 31,
48410 & 136,0.021D0, 0, 35, 38, 38, 0, 0,
48411 & 136,0.027D0, 0, 42, 38, 0, 0, 0,
48412 & 136,0.066D0, 0, 42, 39, 0, 0, 0,
48413 & 136,0.081D0, 0, 42, 40, 0, 0, 0,
48414 & 136,0.024D0, 0, 42, 38, 21, 0, 0,
48415 & 136,0.004D0, 0, 42, 38, 23, 0, 0,
48416 & 136,0.069D0, 0, 42, 38, 38, 30, 21,
48417 & 136,0.001D0, 0, 42, 38, 38, 30, 23,
48418 & 136,0.022D0, 0, 43, 38, 0, 0, 0,
48419 & 136,0.021D0, 0, 43, 39, 0, 0, 0,
48420 & 136,0.042D0, 0, 43, 38, 21, 0, 0,
48421 & 136,0.008D0, 0, 43, 38, 23, 0, 0,
48422 & 136,0.010D0, 0, 43, 38, 38, 30, 0,
48423 & 136,0.050D0, 0,311, 38, 0, 0, 0,
48424 & 136,0.034D0, 0,329, 38, 0, 0, 0,
48425 & 136,0.010D0, 0,369, 38, 0, 0, 0/
48426 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 381, 399)/
48427 & 136,0.031D0, 0, 46, 42, 42, 0, 0,
48428 & 136,0.003D0, 0, 38, 21, 0, 0, 0,
48429 & 136,0.001D0, 0, 38, 23, 0, 0, 0,
48430 & 136,0.002D0, 0, 38, 38, 30, 0, 0,
48431 & 136,0.008D0, 0, 38, 22, 0, 0, 0,
48432 & 136,0.001D0, 0, 38, 38, 38, 30, 30,
48433 & 136,0.003D0, 0, 38, 38, 38, 30, 31,
48434 & 136,0.008D0, 0, 46, 42, 0, 0, 0,
48435 & 136,0.005D0, 0, 46, 43, 0, 0, 0,
48436 & 136,0.026D0, 0, 47, 43, 0, 0, 0,
48437 & 136,0.005D0, 0, 46, 34, 38, 0, 0,
48438 & 136,0.007D0, 0, 38, 56, 0, 0, 0,
48439 & 136,0.023D0, 0, 38, 56, 21, 0, 0,
48440 & 136,0.005D0, 0, 46, 46, 34, 0, 0,
48441 & 137,0.683D0, 0,140, 38, 0, 0, 0,
48442 & 137,0.306D0, 0,136, 21, 0, 0, 0,
48443 & 137,0.011D0, 0,136, 59, 0, 0, 0,
48444 & 138,0.667D0, 0,141, 38, 0, 0, 0,
48445 & 138,0.333D0, 0,137, 21, 0, 0, 0/
48446 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 400, 418)/
48447 & 139,0.220D0, 0,140, 38, 0, 0, 0,
48448 & 139,0.110D0, 0,136, 21, 0, 0, 0,
48449 & 139,0.380D0, 0,141, 38, 0, 0, 0,
48450 & 139,0.190D0, 0,137, 21, 0, 0, 0,
48451 & 139,0.004D0, 0,136, 22, 0, 0, 0,
48452 & 139,0.064D0, 0,141, 38, 21, 0, 0,
48453 & 139,0.032D0, 0,137, 38, 30, 0, 0,
48454 & 140,0.037D0,101,122,127, 34, 0, 0,
48455 & 140,0.037D0,101,124,129, 34, 0, 0,
48456 & 140,0.016D0,101,122,127, 35, 0, 0,
48457 & 140,0.016D0,101,124,129, 35, 0, 0,
48458 & 140,0.013D0, 0, 34, 21,122,127, 0,
48459 & 140,0.013D0, 0, 34, 21,124,129, 0,
48460 & 140,0.012D0, 0, 42, 30,122,127, 0,
48461 & 140,0.012D0, 0, 42, 30,124,129, 0,
48462 & 140,0.003D0,101,122,127, 30, 0, 0,
48463 & 140,0.003D0,101,124,129, 30, 0, 0,
48464 & 140,0.039D0, 0, 34, 38, 0, 0, 0,
48465 & 140,0.091D0, 0, 34, 39, 0, 0, 0/
48466 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 419, 437)/
48467 & 140,0.067D0, 0, 34, 40, 0, 0, 0,
48468 & 140,0.004D0, 0, 34, 38, 21, 0, 0,
48469 & 140,0.100D0, 0, 34, 38, 21, 21, 0,
48470 & 140,0.058D0, 0, 34, 38, 23, 0, 0,
48471 & 140,0.020D0, 0, 34, 38, 24, 0, 0,
48472 & 140,0.006D0, 0, 34, 38, 25, 0, 0,
48473 & 140,0.043D0, 0, 35, 38, 0, 0, 0,
48474 & 140,0.035D0, 0, 35, 39, 0, 0, 0,
48475 & 140,0.007D0, 0,312, 38, 0, 0, 0,
48476 & 140,0.007D0, 0,330, 38, 0, 0, 0,
48477 & 140,0.020D0, 0, 42, 21, 0, 0, 0,
48478 & 140,0.006D0, 0, 42, 22, 0, 0, 0,
48479 & 140,0.009D0, 0, 42, 23, 0, 0, 0,
48480 & 140,0.016D0, 0, 42, 24, 0, 0, 0,
48481 & 140,0.014D0, 0, 42, 25, 0, 0, 0,
48482 & 140,0.003D0, 0, 42,293, 0, 0, 0,
48483 & 140,0.007D0, 0, 42, 56, 0, 0, 0,
48484 & 140,0.003D0, 0, 42, 26, 0, 0, 0,
48485 & 140,0.004D0, 0, 42,294, 0, 0, 0/
48486 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 438, 456)/
48487 & 140,0.006D0, 0, 42, 21, 21, 0, 0,
48488 & 140,0.042D0, 0, 42, 38, 30, 21, 0,
48489 & 140,0.004D0, 0, 42, 38, 38, 30, 30,
48490 & 140,0.076D0, 0, 42, 38, 30, 21, 21,
48491 & 140,0.026D0, 0, 43, 21, 0, 0, 0,
48492 & 140,0.014D0, 0, 43, 22, 0, 0, 0,
48493 & 140,0.014D0, 0, 43, 23, 0, 0, 0,
48494 & 140,0.011D0, 0, 43, 24, 0, 0, 0,
48495 & 140,0.018D0, 0, 43, 38, 30, 0, 0,
48496 & 140,0.004D0, 0, 42, 46, 34, 0, 0,
48497 & 140,0.004D0, 0, 42, 46, 34, 21, 0,
48498 & 140,0.005D0, 0, 42, 42, 50, 0, 0,
48499 & 140,0.002D0, 0, 38, 30, 0, 0, 0,
48500 & 140,0.001D0, 0, 21, 21, 0, 0, 0,
48501 & 140,0.008D0, 0, 38, 30, 21, 0, 0,
48502 & 140,0.007D0, 0, 38, 38, 30, 30, 0,
48503 & 140,0.015D0, 0, 38, 38, 30, 30, 21,
48504 & 140,0.004D0, 0, 46, 34, 0, 0, 0,
48505 & 140,0.003D0, 0, 47, 34, 0, 0, 0/
48506 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 457, 475)/
48507 & 140,0.002D0, 0, 46, 35, 0, 0, 0,
48508 & 140,0.001D0, 0, 50, 42, 0, 0, 0,
48509 & 140,0.002D0, 0, 51, 43, 0, 0, 0,
48510 & 140,0.003D0, 0, 50, 34, 38, 0, 0,
48511 & 140,0.003D0, 0, 42, 46, 30, 0, 0,
48512 & 140,0.001D0, 0, 46, 34, 38, 30, 21,
48513 & 140,0.002D0, 0, 56, 23, 0, 0, 0,
48514 & 140,0.001D0, 0, 56, 38, 30, 0, 0,
48515 & 141,0.636D0, 0,140, 21, 0, 0, 0,
48516 & 141,0.364D0, 0,140, 59, 0, 0, 0,
48517 & 142,0.667D0, 0,137, 30, 0, 0, 0,
48518 & 142,0.333D0, 0,141, 21, 0, 0, 0,
48519 & 143,0.220D0, 0,136, 30, 0, 0, 0,
48520 & 143,0.110D0, 0,140, 21, 0, 0, 0,
48521 & 143,0.380D0, 0,137, 30, 0, 0, 0,
48522 & 143,0.190D0, 0,141, 21, 0, 0, 0,
48523 & 143,0.004D0, 0,140, 22, 0, 0, 0,
48524 & 143,0.064D0, 0,137, 30, 21, 0, 0,
48525 & 143,0.032D0, 0,141, 38, 30, 0, 0/
48526 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 476, 494)/
48527 & 144,0.009D0, 0,124,129, 0, 0, 0,
48528 & 144,0.019D0,101,122,127, 56, 0, 0,
48529 & 144,0.019D0,101,124,129, 56, 0, 0,
48530 & 144,0.025D0,101,122,127, 22, 0, 0,
48531 & 144,0.025D0,101,124,129, 22, 0, 0,
48532 & 144,0.009D0,101,122,127, 25, 0, 0,
48533 & 144,0.009D0,101,124,129, 25, 0, 0,
48534 & 144,0.036D0, 0, 46, 42, 0, 0, 0,
48535 & 144,0.034D0, 0, 46, 43, 0, 0, 0,
48536 & 144,0.007D0, 0, 46,329, 0, 0, 0,
48537 & 144,0.043D0, 0, 47, 42, 0, 0, 0,
48538 & 144,0.058D0, 0, 47, 43, 0, 0, 0,
48539 & 144,0.011D0, 0, 46, 34, 38, 0, 0,
48540 & 144,0.055D0, 0, 46, 34, 38, 21, 0,
48541 & 144,0.003D0, 0, 46, 34, 38, 38, 30,
48542 & 144,0.014D0, 0, 46, 42, 38, 30, 0,
48543 & 144,0.017D0, 0, 50, 34, 38, 38, 0,
48544 & 144,0.036D0, 0, 56, 38, 0, 0, 0,
48545 & 144,0.067D0, 0, 56, 39, 0, 0, 0/
48546 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 495, 513)/
48547 & 144,0.023D0, 0, 56, 38, 21, 0, 0,
48548 & 144,0.018D0, 0, 56, 38, 38, 30, 0,
48549 & 144,0.020D0, 0, 22, 38, 0, 0, 0,
48550 & 144,0.001D0, 0, 23, 38, 0, 0, 0,
48551 & 144,0.009D0, 0, 24, 38, 0, 0, 0,
48552 & 144,0.049D0, 0, 25, 38, 0, 0, 0,
48553 & 144,0.011D0, 0,293, 38, 0, 0, 0,
48554 & 144,0.015D0, 0, 22, 38, 21, 0, 0,
48555 & 144,0.016D0, 0, 25, 38, 21, 0, 0,
48556 & 144,0.103D0, 0, 22, 39, 0, 0, 0,
48557 & 144,0.120D0, 0, 25, 39, 0, 0, 0,
48558 & 144,0.010D0, 0, 38, 38, 30, 0, 0,
48559 & 144,0.046D0, 0, 38, 38, 30, 21, 0,
48560 & 144,0.003D0, 0, 38, 38, 38, 30, 30,
48561 & 144,0.042D0, 0, 38, 30, 30, 38, 39,
48562 & 144,0.001D0, 0, 46, 23, 0, 0, 0,
48563 & 144,0.005D0, 0, 46, 38, 30, 0, 0,
48564 & 144,0.001D0, 0, 46, 56, 0, 0, 0,
48565 & 144,0.004D0, 0, 50, 38, 0, 0, 0/
48566 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 514, 532)/
48567 & 144,0.007D0, 0, 51, 38, 0, 0, 0,
48568 & 145,0.900D0, 0,144, 59, 0, 0, 0,
48569 & 145,0.100D0, 0,144, 21, 0, 0, 0,
48570 & 146,0.500D0, 0,137, 50, 0, 0, 0,
48571 & 146,0.500D0, 0,141, 46, 0, 0, 0,
48572 & 147,0.440D0, 0,136, 50, 0, 0, 0,
48573 & 147,0.440D0, 0,140, 46, 0, 0, 0,
48574 & 147,0.055D0, 0,137, 50, 0, 0, 0,
48575 & 147,0.055D0, 0,141, 46, 0, 0, 0,
48576 & 147,0.010D0, 0,144, 22, 0, 0, 0,
48577 & 148,1.000D0, 0,150, 38, 0, 0, 0,
48578 & 149,1.000D0, 0,150, 38, 0, 0, 0,
48579 & 150,0.028D0,101,122,127, 78, 0, 0,
48580 & 150,0.010D0,101,122,127, 80, 0, 0,
48581 & 150,0.028D0,101,124,129, 78, 0, 0,
48582 & 150,0.010D0,101,124,129, 80, 0, 0,
48583 & 150,0.026D0, 0, 73, 42, 0, 0, 0,
48584 & 150,0.030D0, 0, 73, 42, 21, 0, 0,
48585 & 150,0.029D0, 0, 73, 42, 38, 30, 0/
48586 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 533, 551)/
48587 & 150,0.014D0, 0, 73, 42, 22, 0, 0,
48588 & 150,0.020D0, 0, 73, 43, 0, 0, 0,
48589 & 150,0.029D0, 0, 73, 34, 38, 0, 0,
48590 & 150,0.039D0, 0, 73, 34, 38, 21, 0,
48591 & 150,0.002D0, 0, 73, 34, 38, 38, 30,
48592 & 150,0.010D0, 0, 73, 34, 38, 21, 21,
48593 & 150,0.014D0, 0, 73, 35, 38, 0, 0,
48594 & 150,0.010D0, 0, 74, 42, 0, 0, 0,
48595 & 150,0.020D0, 0, 74, 43, 0, 0, 0,
48596 & 150,0.010D0, 0, 74, 43, 21, 0, 0,
48597 & 150,0.007D0, 0, 85, 34, 0, 0, 0,
48598 & 150,0.014D0, 0, 85, 35, 0, 0, 0,
48599 & 150,0.004D0, 0, 73,293, 0, 0, 0,
48600 & 150,0.003D0, 0, 73, 38, 30, 0, 0,
48601 & 150,0.003D0, 0, 73, 38, 30, 38, 30,
48602 & 150,0.001D0, 0, 73, 56, 0, 0, 0,
48603 & 150,0.002D0, 0, 73, 46, 34, 0, 0,
48604 & 150,0.010D0, 0, 78, 38, 0, 0, 0,
48605 & 150,0.020D0, 0, 78, 39, 0, 0, 0/
48606 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 552, 570)/
48607 & 150,0.030D0, 0, 78, 38, 21, 0, 0,
48608 & 150,0.010D0, 0, 78, 38, 22, 0, 0,
48609 & 150,0.020D0, 0, 78, 38, 24, 0, 0,
48610 & 150,0.035D0, 0, 78, 38, 38, 30, 0,
48611 & 150,0.020D0, 0, 78, 38, 21, 21, 0,
48612 & 150,0.010D0, 0, 78, 38, 38, 30, 21,
48613 & 150,0.010D0, 0, 78, 38, 21, 21, 21,
48614 & 150,0.007D0, 0, 78, 46, 42, 0, 0,
48615 & 150,0.011D0, 0, 79, 38, 0, 0, 0,
48616 & 150,0.022D0, 0, 79, 38, 21, 0, 0,
48617 & 150,0.013D0, 0, 79, 38, 38, 30, 0,
48618 & 150,0.010D0, 0, 79, 38, 21, 21, 0,
48619 & 150,0.007D0, 0, 79, 38, 38, 30, 21,
48620 & 150,0.005D0, 0, 79, 38, 21, 21, 21,
48621 & 150,0.005D0, 0, 80, 38, 0, 0, 0,
48622 & 150,0.015D0, 0, 80, 39, 0, 0, 0,
48623 & 150,0.011D0, 0, 86, 21, 0, 0, 0,
48624 & 150,0.007D0, 0, 86, 22, 0, 0, 0,
48625 & 150,0.010D0, 0, 86, 23, 0, 0, 0/
48626 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 571, 589)/
48627 & 150,0.031D0, 0, 86, 24, 0, 0, 0,
48628 & 150,0.010D0, 0, 86, 25, 0, 0, 0,
48629 & 150,0.004D0, 0, 86, 56, 0, 0, 0,
48630 & 150,0.026D0, 0, 86, 38, 30, 0, 0,
48631 & 150,0.005D0, 0, 86, 38, 38, 30, 30,
48632 & 150,0.005D0, 0, 86, 38, 30, 21, 21,
48633 & 150,0.005D0, 0, 87, 21, 0, 0, 0,
48634 & 150,0.006D0, 0, 87, 23, 0, 0, 0,
48635 & 150,0.004D0, 0, 86, 46, 34, 0, 0,
48636 & 150,0.002D0, 0, 86, 46, 30, 0, 0,
48637 & 150,0.001D0, 0, 86, 46, 30, 21, 0,
48638 & 150,0.016D0, 0, 81, 38, 38, 0, 0,
48639 & 150,0.003D0, 0, 88, 46, 0, 0, 0,
48640 & 150,0.002D0, 0, 89, 46, 0, 0, 0,
48641 & 150,0.003D0, 0, 83, 46, 38, 0, 0,
48642 & 150,0.040D0, 0, 75, 46, 21, 0, 0,
48643 & 150,0.040D0, 0, 75, 46, 38, 30, 0,
48644 & 150,0.020D0, 0, 75, 46, 21, 21, 0,
48645 & 150,0.010D0, 0, 75, 46, 38, 30, 21/
48646 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 590, 608)/
48647 & 150,0.010D0, 0, 75, 46, 21, 21, 21,
48648 & 150,0.020D0, 0, 75, 47, 21, 0, 0,
48649 & 150,0.040D0, 0, 75, 42, 38, 0, 0,
48650 & 150,0.020D0, 0, 75, 42, 39, 0, 0,
48651 & 150,0.010D0, 0, 75, 42, 38, 38, 30,
48652 & 150,0.010D0, 0, 75, 42, 38, 21, 21,
48653 & 150,0.006D0, 0, 75, 43, 38, 0, 0,
48654 & 151,1.000D0, 0,150, 21, 0, 0, 0,
48655 & 152,1.000D0, 0,150, 21, 0, 0, 0,
48656 & 153,1.000D0, 0,150, 30, 0, 0, 0,
48657 & 154,1.000D0, 0,150, 30, 0, 0, 0,
48658 & 155,0.045D0,101,122,127, 88, 0, 0,
48659 & 155,0.005D0,101,122,127, 89, 0, 0,
48660 & 155,0.045D0,101,124,129, 88, 0, 0,
48661 & 155,0.005D0,101,124,129, 89, 0, 0,
48662 & 155,0.021D0, 0, 86, 42, 0, 0, 0,
48663 & 155,0.032D0, 0, 87, 42, 0, 0, 0,
48664 & 155,0.032D0, 0, 79, 38, 42, 0, 0,
48665 & 155,0.045D0, 0, 86, 43, 0, 0, 0/
48666 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 609, 627)/
48667 & 155,0.065D0, 0, 87, 43, 0, 0, 0,
48668 & 155,0.065D0, 0, 79, 38, 43, 0, 0,
48669 & 155,0.055D0, 0, 88, 38, 0, 0, 0,
48670 & 155,0.160D0, 0, 88, 39, 0, 0, 0,
48671 & 155,0.105D0, 0, 89, 38, 0, 0, 0,
48672 & 155,0.320D0, 0, 89, 39, 0, 0, 0,
48673 & 156,1.000D0, 0,155, 59, 0, 0, 0,
48674 & 157,0.667D0, 0,158, 38, 0, 0, 0,
48675 & 157,0.333D0, 0,155, 21, 0, 0, 0,
48676 & 158,0.045D0,101,122,127, 83, 0, 0,
48677 & 158,0.045D0,101,124,129, 83, 0, 0,
48678 & 158,0.005D0,101,122,127, 84, 0, 0,
48679 & 158,0.005D0,101,124,129, 84, 0, 0,
48680 & 158,0.020D0, 0, 79, 42, 0, 0, 0,
48681 & 158,0.020D0, 0, 79, 21, 42, 0, 0,
48682 & 158,0.020D0, 0, 80, 42, 0, 0, 0,
48683 & 158,0.060D0, 0, 79, 43, 0, 0, 0,
48684 & 158,0.060D0, 0, 79, 21, 43, 0, 0,
48685 & 158,0.060D0, 0, 80, 43, 0, 0, 0/
48686 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 628, 646)/
48687 & 158,0.020D0, 0, 86, 34, 0, 0, 0,
48688 & 158,0.060D0, 0, 86, 35, 0, 0, 0,
48689 & 158,0.040D0, 0, 87, 34, 0, 0, 0,
48690 & 158,0.120D0, 0, 87, 35, 0, 0, 0,
48691 & 158,0.020D0, 0, 83, 38, 0, 0, 0,
48692 & 158,0.060D0, 0, 83, 39, 0, 0, 0,
48693 & 158,0.040D0, 0, 84, 38, 0, 0, 0,
48694 & 158,0.120D0, 0, 84, 39, 0, 0, 0,
48695 & 158,0.010D0, 0, 88, 21, 0, 0, 0,
48696 & 158,0.030D0, 0, 88, 23, 0, 0, 0,
48697 & 158,0.020D0, 0, 89, 21, 0, 0, 0,
48698 & 158,0.060D0, 0, 89, 23, 0, 0, 0,
48699 & 158,0.030D0, 0, 88, 56, 0, 0, 0,
48700 & 158,0.030D0, 0, 90, 46, 0, 0, 0,
48701 & 159,1.000D0, 0,158, 59, 0, 0, 0,
48702 & 160,0.670D0, 0,155, 30, 0, 0, 0,
48703 & 160,0.330D0, 0,158, 21, 0, 0, 0,
48704 & 161,0.050D0,101,122,127, 90, 0, 0,
48705 & 161,0.050D0,101,124,129, 90, 0, 0/
48706 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 647, 665)/
48707 & 161,0.075D0, 0, 88, 42, 0, 0, 0,
48708 & 161,0.225D0, 0, 88, 43, 0, 0, 0,
48709 & 161,0.150D0, 0, 89, 42, 0, 0, 0,
48710 & 161,0.450D0, 0, 89, 43, 0, 0, 0,
48711 & 162,1.000D0, 0,161, 59, 0, 0, 0,
48712 & 163,0.028D0, 0, 25, 38, 30, 0, 0,
48713 & 163,0.014D0, 0, 25, 21, 21, 0, 0,
48714 & 163,0.018D0, 0, 39, 31, 0, 0, 0,
48715 & 163,0.009D0, 0, 23, 23, 0, 0, 0,
48716 & 163,0.010D0, 0, 51, 34, 38, 0, 0,
48717 & 163,0.010D0, 0, 43, 47, 30, 0, 0,
48718 & 163,0.004D0, 0, 51, 43, 0, 0, 0,
48719 & 163,0.004D0, 0, 47, 35, 0, 0, 0,
48720 & 163,0.007D0, 0, 56, 56, 0, 0, 0,
48721 & 163,0.022D0, 0, 46, 42, 30, 0, 0,
48722 & 163,0.011D0, 0, 46, 34, 21, 0, 0,
48723 & 163,0.011D0, 0, 50, 42, 21, 0, 0,
48724 & 163,0.022D0, 0, 50, 34, 38, 0, 0,
48725 & 163,0.032D0, 0, 22, 38, 30, 0, 0/
48726 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 666, 684)/
48727 & 163,0.016D0, 0, 22, 21, 21, 0, 0,
48728 & 163,0.020D0, 0, 38, 30, 46, 34, 0,
48729 & 163,0.012D0, 0, 38, 30, 38, 30, 0,
48730 & 163,0.001D0, 0, 73, 91, 0, 0, 0,
48731 & 163,0.001D0, 0, 59, 59, 0, 0, 0,
48732 & 163,0.748D0, 0, 13, 13, 0, 0, 0,
48733 & 164,0.060D0, 0,121,127, 0, 0, 0,
48734 & 164,0.060D0, 0,123,129, 0, 0, 0,
48735 & 164,0.004D0, 0, 39, 30, 0, 0, 0,
48736 & 164,0.004D0, 0, 23, 21, 0, 0, 0,
48737 & 164,0.004D0, 0, 31, 38, 0, 0, 0,
48738 & 164,0.003D0, 0, 41, 31, 0, 0, 0,
48739 & 164,0.003D0, 0, 29, 23, 0, 0, 0,
48740 & 164,0.003D0, 0, 33, 39, 0, 0, 0,
48741 & 164,0.009D0, 0, 24, 38, 38, 30, 30,
48742 & 164,0.007D0, 0, 24, 38, 30, 0, 0,
48743 & 164,0.003D0, 0, 51, 45, 0, 0, 0,
48744 & 164,0.003D0, 0, 43, 53, 0, 0, 0,
48745 & 164,0.003D0, 0, 24, 51, 42, 0, 0/
48746 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 685, 703)/
48747 & 164,0.003D0, 0, 24, 43, 50, 0, 0,
48748 & 164,0.004D0, 0, 24, 26, 0, 0, 0,
48749 & 164,0.003D0, 0, 46, 35, 0, 0, 0,
48750 & 164,0.003D0, 0, 34, 47, 0, 0, 0,
48751 & 164,0.002D0, 0, 50, 43, 0, 0, 0,
48752 & 164,0.002D0, 0, 42, 51, 0, 0, 0,
48753 & 164,0.003D0, 0, 24, 21, 21, 0, 0,
48754 & 164,0.002D0, 0,286, 30, 0, 0, 0,
48755 & 164,0.002D0, 0,287, 38, 0, 0, 0,
48756 & 164,0.003D0, 0, 24, 46, 42, 30, 0,
48757 & 164,0.003D0, 0, 24, 34, 50, 38, 0,
48758 & 164,0.002D0, 0,285, 21, 0, 0, 0,
48759 & 164,0.001D0, 0, 56, 51, 42, 0, 0,
48760 & 164,0.001D0, 0, 56, 43, 50, 0, 0,
48761 & 164,0.001D0, 0, 24, 50, 42, 0, 0,
48762 & 164,0.001D0, 0, 24, 46, 34, 0, 0,
48763 & 164,0.002D0, 0, 56, 38, 30, 38, 30,
48764 & 164,0.002D0, 0, 85, 91, 30, 0, 0,
48765 & 164,0.002D0, 0,103, 73, 38, 0, 0/
48766 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 704, 722)/
48767 & 164,0.002D0, 0, 24, 22, 0, 0, 0,
48768 & 164,0.001D0, 0, 56, 50, 42, 0, 0,
48769 & 164,0.001D0, 0, 56, 46, 34, 0, 0,
48770 & 164,0.001D0, 0, 73, 91, 24, 0, 0,
48771 & 164,0.001D0, 0, 85,103, 0, 0, 0,
48772 & 164,0.001D0, 0, 82,100, 0, 0, 0,
48773 & 164,0.001D0, 0, 87,105, 0, 0, 0,
48774 & 164,0.001D0, 0, 73, 91, 25, 0, 0,
48775 & 164,0.001D0, 0, 56, 58, 0, 0, 0,
48776 & 164,0.001D0, 0, 56, 38, 30, 0, 0,
48777 & 164,0.001D0, 0, 56, 46, 42, 30, 0,
48778 & 164,0.001D0, 0, 56, 34, 50, 38, 0,
48779 & 164,0.001D0, 0, 56, 22, 0, 0, 0,
48780 & 164,0.001D0, 0, 84,102, 0, 0, 0,
48781 & 164,0.001D0, 0, 73, 34, 98, 0, 0,
48782 & 164,0.001D0, 0, 91, 46, 80, 0, 0,
48783 & 164,0.034D0, 0, 38, 38, 30, 30, 21,
48784 & 164,0.029D0, 0, 23, 23, 23, 21, 0,
48785 & 164,0.015D0, 0, 38, 30, 21, 0, 0/
48786 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 723, 741)/
48787 & 164,0.012D0, 0, 38, 30, 21, 34, 46,
48788 & 164,0.009D0, 0, 23, 23, 23, 24, 0,
48789 & 164,0.007D0, 0, 38, 30, 34, 46, 0,
48790 & 164,0.002D0, 0, 46, 42, 30, 0, 0,
48791 & 164,0.001D0, 0, 46, 34, 21, 0, 0,
48792 & 164,0.001D0, 0, 50, 42, 21, 0, 0,
48793 & 164,0.002D0, 0, 50, 34, 38, 0, 0,
48794 & 164,0.006D0, 0, 73, 91, 38, 30, 0,
48795 & 164,0.004D0, 0, 38, 30, 38, 30, 0,
48796 & 164,0.004D0, 0, 38, 30, 38, 30, 23,
48797 & 164,0.004D0, 0, 75, 93, 38, 30, 0,
48798 & 164,0.001D0, 0, 86,104, 0, 0, 0,
48799 & 164,0.001D0, 0, 79, 97, 0, 0, 0,
48800 & 164,0.001D0, 0, 81, 99, 0, 0, 0,
48801 & 164,0.003D0, 0, 23, 23, 34, 46, 0,
48802 & 164,0.002D0, 0, 73, 91, 38, 30, 21,
48803 & 164,0.002D0, 0, 73, 91, 0, 0, 0,
48804 & 164,0.002D0, 0, 73, 91, 22, 0, 0,
48805 & 164,0.002D0, 0, 73, 93, 30, 0, 0/
48806 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 742, 760)/
48807 & 164,0.002D0, 0, 75, 93, 0, 0, 0,
48808 & 164,0.001D0, 0, 83,102, 0, 0, 0,
48809 & 164,0.001D0, 0, 88,106, 0, 0, 0,
48810 & 164,0.001D0, 0, 78, 96, 0, 0, 0,
48811 & 164,0.001D0, 0, 73, 91, 21, 0, 0,
48812 & 164,0.001D0, 0, 78,104, 38, 0, 0,
48813 & 164,0.001D0, 0, 96, 86, 30, 0, 0,
48814 & 164,0.001D0, 0, 73, 34, 96, 0, 0,
48815 & 164,0.001D0, 0, 91, 46, 78, 0, 0,
48816 & 164,0.001D0, 0, 46, 34, 46, 34, 0,
48817 & 164,0.013D0, 0, 59,163, 0, 0, 0,
48818 & 164,0.008D0, 0, 59, 38, 30, 21, 21,
48819 & 164,0.004D0, 0, 59, 22, 38, 30, 0,
48820 & 164,0.002D0, 0, 59, 22, 21, 21, 0,
48821 & 164,0.003D0, 0, 59, 39, 31, 0, 0,
48822 & 164,0.002D0, 0, 59, 23, 23, 0, 0,
48823 & 164,0.004D0, 0, 59, 25, 0, 0, 0,
48824 & 164,0.003D0, 0, 59, 38, 30, 38, 30,
48825 & 164,0.002D0, 0, 59, 24, 24, 0, 0/
48826 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 761, 779)/
48827 & 164,0.001D0, 0, 59, 26, 0, 0, 0,
48828 & 164,0.001D0, 0, 59, 22, 0, 0, 0,
48829 & 164,0.001D0, 0, 59, 28, 0, 0, 0,
48830 & 164,0.001D0, 0, 59, 58, 0, 0, 0,
48831 & 164,0.020D0, 0, 1, 7, 0, 0, 0,
48832 & 164,0.080D0, 0, 2, 8, 0, 0, 0,
48833 & 164,0.020D0, 0, 3, 9, 0, 0, 0,
48834 & 164,0.364D0,130, 13, 13, 13, 0, 0,
48835 & 164,0.091D0,130, 13, 13, 59, 0, 0,
48836 & 165,0.037D0, 0, 38, 30, 38, 30, 0,
48837 & 165,0.030D0, 0, 38, 30, 46, 34, 0,
48838 & 165,0.016D0, 0, 23, 38, 30, 0, 0,
48839 & 165,0.015D0, 0, 23, 38, 30, 38, 30,
48840 & 165,0.004D0, 0, 46, 43, 30, 0, 0,
48841 & 165,0.002D0, 0, 46, 35, 21, 0, 0,
48842 & 165,0.002D0, 0, 51, 43, 21, 0, 0,
48843 & 165,0.004D0, 0, 51, 35, 38, 0, 0,
48844 & 165,0.008D0, 0, 38, 30, 0, 0, 0,
48845 & 165,0.007D0, 0, 46, 34, 0, 0, 0/
48846 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 780, 798)/
48847 & 165,0.005D0, 0, 38, 30, 73, 91, 0,
48848 & 165,0.003D0, 0, 21, 21, 0, 0, 0,
48849 & 165,0.003D0, 0, 22, 22, 0, 0, 0,
48850 & 165,0.007D0, 0, 59,164, 0, 0, 0,
48851 & 165,0.857D0, 0, 13, 13, 0, 0, 0,
48852 & 166,0.008D0, 0,121,127, 0, 0, 0,
48853 & 166,0.008D0, 0,123,129, 0, 0, 0,
48854 & 166,0.001D0, 0,125,131, 0, 0, 0,
48855 & 166,0.338D0, 0,164, 38, 30, 0, 0,
48856 & 166,0.169D0, 0,164, 21, 21, 0, 0,
48857 & 166,0.027D0, 0,164, 22, 0, 0, 0,
48858 & 166,0.001D0, 0,164, 21, 0, 0, 0,
48859 & 166,0.004D0, 0, 23, 23, 23, 21, 0,
48860 & 166,0.003D0, 0, 23, 23, 21, 0, 0,
48861 & 166,0.002D0, 0, 38, 30, 46, 34, 0,
48862 & 166,0.001D0, 0, 38, 30, 73, 91, 0,
48863 & 166,0.093D0, 0, 59,165, 0, 0, 0,
48864 & 166,0.087D0, 0, 59,302, 0, 0, 0,
48865 & 166,0.078D0, 0, 59,303, 0, 0, 0/
48866 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 799, 817)/
48867 & 166,0.003D0, 0, 59,163, 0, 0, 0,
48868 & 166,0.003D0, 0, 1, 7, 0, 0, 0,
48869 & 166,0.012D0, 0, 2, 8, 0, 0, 0,
48870 & 166,0.003D0, 0, 3, 9, 0, 0, 0,
48871 & 166,0.127D0,130, 13, 13, 13, 0, 0,
48872 & 166,0.032D0,130, 13, 13, 59, 0, 0,
48873 & 167,0.500D0, 0,136,171, 0, 0, 0,
48874 & 167,0.500D0, 0,140,175, 0, 0, 0,
48875 & 171,0.067D0,101,128,121, 50, 0, 0,
48876 & 171,0.067D0,101,130,123, 50, 0, 0,
48877 & 171,0.048D0,101,128,121, 51, 0, 0,
48878 & 171,0.048D0,101,130,123, 51, 0, 0,
48879 & 171,0.003D0, 0,128,121, 46, 30, 0,
48880 & 171,0.003D0, 0,130,123, 46, 30, 0,
48881 & 171,0.006D0,101,128,121, 21, 0, 0,
48882 & 171,0.006D0,101,130,123, 21, 0, 0,
48883 & 171,0.002D0,101,128,121, 23, 0, 0,
48884 & 171,0.002D0,101,130,123, 23, 0, 0,
48885 & 171,0.055D0, 0, 46, 30, 30, 0, 0/
48886 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 818, 836)/
48887 & 171,0.031D0, 0, 46, 31, 30, 0, 0,
48888 & 171,0.042D0, 0, 46, 30, 30, 21, 21,
48889 & 171,0.002D0, 0, 46, 30, 30, 30, 39,
48890 & 171,0.021D0, 0, 47, 30, 30, 0, 0,
48891 & 171,0.027D0, 0, 50, 30, 0, 0, 0,
48892 & 171,0.066D0, 0, 50, 31, 0, 0, 0,
48893 & 171,0.081D0, 0, 50, 32, 0, 0, 0,
48894 & 171,0.024D0, 0, 50, 30, 21, 0, 0,
48895 & 171,0.004D0, 0, 50, 30, 23, 0, 0,
48896 & 171,0.069D0, 0, 50, 30, 30, 38, 21,
48897 & 171,0.001D0, 0, 50, 30, 30, 38, 23,
48898 & 171,0.022D0, 0, 51, 30, 0, 0, 0,
48899 & 171,0.021D0, 0, 51, 31, 0, 0, 0,
48900 & 171,0.042D0, 0, 51, 30, 21, 0, 0,
48901 & 171,0.008D0, 0, 51, 30, 23, 0, 0,
48902 & 171,0.010D0, 0, 51, 30, 30, 38, 0,
48903 & 171,0.050D0, 0,309, 30, 0, 0, 0,
48904 & 171,0.034D0, 0,328, 30, 0, 0, 0,
48905 & 171,0.010D0, 0,368, 30, 0, 0, 0/
48906 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 837, 855)/
48907 & 171,0.031D0, 0, 34, 50, 50, 0, 0,
48908 & 171,0.003D0, 0, 30, 21, 0, 0, 0,
48909 & 171,0.001D0, 0, 30, 23, 0, 0, 0,
48910 & 171,0.002D0, 0, 30, 30, 38, 0, 0,
48911 & 171,0.008D0, 0, 30, 22, 0, 0, 0,
48912 & 171,0.001D0, 0, 30, 30, 30, 38, 38,
48913 & 171,0.003D0, 0, 30, 30, 30, 38, 39,
48914 & 171,0.008D0, 0, 34, 50, 0, 0, 0,
48915 & 171,0.005D0, 0, 34, 51, 0, 0, 0,
48916 & 171,0.026D0, 0, 35, 51, 0, 0, 0,
48917 & 171,0.005D0, 0, 34, 46, 30, 0, 0,
48918 & 171,0.007D0, 0, 30, 56, 0, 0, 0,
48919 & 171,0.023D0, 0, 30, 56, 21, 0, 0,
48920 & 171,0.005D0, 0, 34, 34, 46, 0, 0,
48921 & 172,0.683D0, 0,175, 30, 0, 0, 0,
48922 & 172,0.306D0, 0,171, 21, 0, 0, 0,
48923 & 172,0.011D0, 0,171, 59, 0, 0, 0,
48924 & 173,0.667D0, 0,176, 30, 0, 0, 0,
48925 & 173,0.333D0, 0,172, 21, 0, 0, 0/
48926 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 856, 874)/
48927 & 174,0.220D0, 0,175, 30, 0, 0, 0,
48928 & 174,0.110D0, 0,171, 21, 0, 0, 0,
48929 & 174,0.380D0, 0,176, 30, 0, 0, 0,
48930 & 174,0.190D0, 0,172, 21, 0, 0, 0,
48931 & 174,0.004D0, 0,171, 22, 0, 0, 0,
48932 & 174,0.064D0, 0,176, 30, 21, 0, 0,
48933 & 174,0.032D0, 0,172, 38, 30, 0, 0,
48934 & 175,0.037D0,101,128,121, 46, 0, 0,
48935 & 175,0.037D0,101,130,123, 46, 0, 0,
48936 & 175,0.016D0,101,128,121, 47, 0, 0,
48937 & 175,0.016D0,101,130,123, 47, 0, 0,
48938 & 175,0.013D0, 0,128,121, 46, 21, 0,
48939 & 175,0.013D0, 0,130,123, 46, 21, 0,
48940 & 175,0.012D0, 0,128,121, 50, 38, 0,
48941 & 175,0.012D0, 0,130,123, 50, 38, 0,
48942 & 175,0.003D0,101,128,121, 38, 0, 0,
48943 & 175,0.003D0,101,130,123, 38, 0, 0,
48944 & 175,0.039D0, 0, 46, 30, 0, 0, 0,
48945 & 175,0.091D0, 0, 46, 31, 0, 0, 0/
48946 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 875, 893)/
48947 & 175,0.067D0, 0, 46, 32, 0, 0, 0,
48948 & 175,0.004D0, 0, 46, 30, 21, 0, 0,
48949 & 175,0.100D0, 0, 46, 30, 21, 21, 0,
48950 & 175,0.058D0, 0, 46, 30, 23, 0, 0,
48951 & 175,0.020D0, 0, 46, 30, 24, 0, 0,
48952 & 175,0.006D0, 0, 46, 30, 25, 0, 0,
48953 & 175,0.043D0, 0, 47, 30, 0, 0, 0,
48954 & 175,0.035D0, 0, 47, 31, 0, 0, 0,
48955 & 175,0.007D0, 0,310, 30, 0, 0, 0,
48956 & 175,0.007D0, 0,327, 30, 0, 0, 0,
48957 & 175,0.020D0, 0, 50, 21, 0, 0, 0,
48958 & 175,0.006D0, 0, 50, 22, 0, 0, 0,
48959 & 175,0.009D0, 0, 50, 23, 0, 0, 0,
48960 & 175,0.016D0, 0, 50, 24, 0, 0, 0,
48961 & 175,0.014D0, 0, 50, 25, 0, 0, 0,
48962 & 175,0.003D0, 0, 50,293, 0, 0, 0,
48963 & 175,0.007D0, 0, 50, 56, 0, 0, 0,
48964 & 175,0.003D0, 0, 50, 26, 0, 0, 0,
48965 & 175,0.004D0, 0, 50,294, 0, 0, 0/
48966 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 894, 912)/
48967 & 175,0.006D0, 0, 50, 21, 21, 0, 0,
48968 & 175,0.042D0, 0, 50, 30, 38, 21, 0,
48969 & 175,0.004D0, 0, 50, 30, 30, 38, 38,
48970 & 175,0.076D0, 0, 50, 30, 38, 21, 21,
48971 & 175,0.026D0, 0, 51, 21, 0, 0, 0,
48972 & 175,0.014D0, 0, 51, 22, 0, 0, 0,
48973 & 175,0.014D0, 0, 51, 23, 0, 0, 0,
48974 & 175,0.011D0, 0, 51, 24, 0, 0, 0,
48975 & 175,0.018D0, 0, 51, 30, 38, 0, 0,
48976 & 175,0.004D0, 0, 50, 34, 46, 0, 0,
48977 & 175,0.004D0, 0, 50, 34, 46, 21, 0,
48978 & 175,0.005D0, 0, 50, 50, 42, 0, 0,
48979 & 175,0.002D0, 0, 30, 38, 0, 0, 0,
48980 & 175,0.001D0, 0, 21, 21, 0, 0, 0,
48981 & 175,0.008D0, 0, 30, 38, 21, 0, 0,
48982 & 175,0.007D0, 0, 30, 30, 38, 38, 0,
48983 & 175,0.015D0, 0, 30, 30, 38, 38, 21,
48984 & 175,0.004D0, 0, 34, 46, 0, 0, 0,
48985 & 175,0.003D0, 0, 35, 46, 0, 0, 0/
48986 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 913, 931)/
48987 & 175,0.002D0, 0, 34, 47, 0, 0, 0,
48988 & 175,0.001D0, 0, 42, 50, 0, 0, 0,
48989 & 175,0.002D0, 0, 43, 51, 0, 0, 0,
48990 & 175,0.003D0, 0, 42, 46, 30, 0, 0,
48991 & 175,0.003D0, 0, 50, 34, 38, 0, 0,
48992 & 175,0.001D0, 0, 34, 46, 30, 38, 21,
48993 & 175,0.002D0, 0, 56, 23, 0, 0, 0,
48994 & 175,0.001D0, 0, 56, 30, 38, 0, 0,
48995 & 176,0.636D0, 0,175, 21, 0, 0, 0,
48996 & 176,0.364D0, 0,175, 59, 0, 0, 0,
48997 & 177,0.667D0, 0,172, 38, 0, 0, 0,
48998 & 177,0.333D0, 0,176, 21, 0, 0, 0,
48999 & 178,0.220D0, 0,171, 38, 0, 0, 0,
49000 & 178,0.110D0, 0,175, 21, 0, 0, 0,
49001 & 178,0.380D0, 0,172, 38, 0, 0, 0,
49002 & 178,0.190D0, 0,176, 21, 0, 0, 0,
49003 & 178,0.004D0, 0,175, 22, 0, 0, 0,
49004 & 178,0.064D0, 0,172, 38, 21, 0, 0,
49005 & 178,0.032D0, 0,176, 38, 30, 0, 0/
49006 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 932, 950)/
49007 & 179,0.009D0, 0,130,123, 0, 0, 0,
49008 & 179,0.019D0,101,128,121, 56, 0, 0,
49009 & 179,0.019D0,101,130,123, 56, 0, 0,
49010 & 179,0.025D0,101,128,121, 22, 0, 0,
49011 & 179,0.025D0,101,130,123, 22, 0, 0,
49012 & 179,0.009D0,101,128,121, 25, 0, 0,
49013 & 179,0.009D0,101,130,123, 25, 0, 0,
49014 & 179,0.036D0, 0, 34, 50, 0, 0, 0,
49015 & 179,0.034D0, 0, 34, 51, 0, 0, 0,
49016 & 179,0.007D0, 0, 34,328, 0, 0, 0,
49017 & 179,0.043D0, 0, 35, 50, 0, 0, 0,
49018 & 179,0.058D0, 0, 35, 51, 0, 0, 0,
49019 & 179,0.011D0, 0, 34, 46, 30, 0, 0,
49020 & 179,0.055D0, 0, 34, 46, 30, 21, 0,
49021 & 179,0.003D0, 0, 34, 46, 30, 38, 30,
49022 & 179,0.014D0, 0, 34, 50, 38, 30, 0,
49023 & 179,0.017D0, 0, 42, 46, 30, 30, 0,
49024 & 179,0.036D0, 0, 56, 30, 0, 0, 0,
49025 & 179,0.067D0, 0, 56, 31, 0, 0, 0/
49026 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 951, 969)/
49027 & 179,0.023D0, 0, 56, 30, 21, 0, 0,
49028 & 179,0.018D0, 0, 56, 30, 38, 30, 0,
49029 & 179,0.020D0, 0, 22, 30, 0, 0, 0,
49030 & 179,0.001D0, 0, 23, 30, 0, 0, 0,
49031 & 179,0.009D0, 0, 24, 30, 0, 0, 0,
49032 & 179,0.049D0, 0, 25, 30, 0, 0, 0,
49033 & 179,0.011D0, 0,293, 30, 0, 0, 0,
49034 & 179,0.015D0, 0, 22, 30, 21, 0, 0,
49035 & 179,0.016D0, 0, 25, 30, 21, 0, 0,
49036 & 179,0.103D0, 0, 22, 31, 0, 0, 0,
49037 & 179,0.120D0, 0, 25, 31, 0, 0, 0,
49038 & 179,0.010D0, 0, 30, 38, 30, 0, 0,
49039 & 179,0.046D0, 0, 30, 38, 30, 21, 0,
49040 & 179,0.003D0, 0, 30, 38, 38, 30, 30,
49041 & 179,0.042D0, 0, 30, 38, 38, 30, 31,
49042 & 179,0.001D0, 0, 34, 23, 0, 0, 0,
49043 & 179,0.005D0, 0, 34, 38, 30, 0, 0,
49044 & 179,0.001D0, 0, 34, 56, 0, 0, 0,
49045 & 179,0.004D0, 0, 42, 30, 0, 0, 0/
49046 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 970, 988)/
49047 & 179,0.007D0, 0, 43, 30, 0, 0, 0,
49048 & 180,0.900D0, 0,179, 59, 0, 0, 0,
49049 & 180,0.100D0, 0,179, 21, 0, 0, 0,
49050 & 181,0.500D0, 0,172, 42, 0, 0, 0,
49051 & 181,0.500D0, 0,176, 34, 0, 0, 0,
49052 & 182,0.440D0, 0,171, 42, 0, 0, 0,
49053 & 182,0.440D0, 0,175, 34, 0, 0, 0,
49054 & 182,0.055D0, 0,172, 42, 0, 0, 0,
49055 & 182,0.055D0, 0,176, 34, 0, 0, 0,
49056 & 182,0.010D0, 0,179, 22, 0, 0, 0,
49057 & 183,1.000D0, 0,185, 30, 0, 0, 0,
49058 & 184,1.000D0, 0,185, 30, 0, 0, 0,
49059 & 185,0.028D0,101,128,121, 96, 0, 0,
49060 & 185,0.010D0,101,128,121, 98, 0, 0,
49061 & 185,0.028D0,101,130,123, 96, 0, 0,
49062 & 185,0.010D0,101,130,123, 98, 0, 0,
49063 & 185,0.026D0, 0, 91, 50, 0, 0, 0,
49064 & 185,0.030D0, 0, 91, 50, 21, 0, 0,
49065 & 185,0.029D0, 0, 91, 50, 38, 30, 0/
49066 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 989,1007)/
49067 & 185,0.014D0, 0, 91, 50, 22, 0, 0,
49068 & 185,0.020D0, 0, 91, 51, 0, 0, 0,
49069 & 185,0.029D0, 0, 91, 46, 30, 0, 0,
49070 & 185,0.039D0, 0, 91, 46, 30, 21, 0,
49071 & 185,0.002D0, 0, 91, 46, 30, 30, 38,
49072 & 185,0.010D0, 0, 91, 46, 30, 21, 21,
49073 & 185,0.014D0, 0, 91, 47, 30, 0, 0,
49074 & 185,0.010D0, 0, 92, 50, 0, 0, 0,
49075 & 185,0.020D0, 0, 92, 51, 0, 0, 0,
49076 & 185,0.010D0, 0, 92, 51, 21, 0, 0,
49077 & 185,0.007D0, 0,103, 46, 0, 0, 0,
49078 & 185,0.014D0, 0,103, 47, 0, 0, 0,
49079 & 185,0.004D0, 0, 91,293, 0, 0, 0,
49080 & 185,0.003D0, 0, 91, 38, 30, 0, 0,
49081 & 185,0.003D0, 0, 91, 38, 30, 38, 30,
49082 & 185,0.001D0, 0, 91, 56, 0, 0, 0,
49083 & 185,0.002D0, 0, 91, 46, 34, 0, 0,
49084 & 185,0.010D0, 0, 96, 30, 0, 0, 0,
49085 & 185,0.020D0, 0, 96, 31, 0, 0, 0/
49086 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1008,1026)/
49087 & 185,0.030D0, 0, 96, 30, 21, 0, 0,
49088 & 185,0.010D0, 0, 96, 30, 22, 0, 0,
49089 & 185,0.020D0, 0, 96, 30, 24, 0, 0,
49090 & 185,0.035D0, 0, 96, 30, 30, 38, 0,
49091 & 185,0.020D0, 0, 96, 30, 21, 21, 0,
49092 & 185,0.010D0, 0, 96, 30, 38, 30, 21,
49093 & 185,0.010D0, 0, 96, 30, 21, 21, 21,
49094 & 185,0.007D0, 0, 96, 34, 50, 0, 0,
49095 & 185,0.011D0, 0, 97, 30, 0, 0, 0,
49096 & 185,0.022D0, 0, 97, 30, 21, 0, 0,
49097 & 185,0.013D0, 0, 97, 30, 38, 30, 0,
49098 & 185,0.010D0, 0, 97, 30, 21, 21, 0,
49099 & 185,0.007D0, 0, 97, 30, 38, 30, 21,
49100 & 185,0.005D0, 0, 97, 30, 21, 21, 21,
49101 & 185,0.005D0, 0, 98, 30, 0, 0, 0,
49102 & 185,0.015D0, 0, 98, 31, 0, 0, 0,
49103 & 185,0.011D0, 0,104, 21, 0, 0, 0,
49104 & 185,0.007D0, 0,104, 22, 0, 0, 0,
49105 & 185,0.010D0, 0,104, 23, 0, 0, 0/
49106 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1027,1045)/
49107 & 185,0.031D0, 0,104, 24, 0, 0, 0,
49108 & 185,0.010D0, 0,104, 25, 0, 0, 0,
49109 & 185,0.004D0, 0,104, 56, 0, 0, 0,
49110 & 185,0.026D0, 0,104, 38, 30, 0, 0,
49111 & 185,0.005D0, 0,104, 38, 38, 30, 30,
49112 & 185,0.005D0, 0,104, 38, 30, 21, 21,
49113 & 185,0.005D0, 0,105, 21, 0, 0, 0,
49114 & 185,0.006D0, 0,105, 23, 0, 0, 0,
49115 & 185,0.004D0, 0,104, 46, 34, 0, 0,
49116 & 185,0.002D0, 0,104, 34, 38, 0, 0,
49117 & 185,0.001D0, 0,104, 34, 38, 21, 0,
49118 & 185,0.016D0, 0, 99, 30, 30, 0, 0,
49119 & 185,0.003D0, 0,106, 34, 0, 0, 0,
49120 & 185,0.002D0, 0,107, 34, 0, 0, 0,
49121 & 185,0.003D0, 0,101, 34, 30, 0, 0,
49122 & 185,0.040D0, 0, 93, 34, 21, 0, 0,
49123 & 185,0.040D0, 0, 93, 34, 38, 30, 0,
49124 & 185,0.020D0, 0, 93, 34, 21, 21, 0,
49125 & 185,0.010D0, 0, 93, 34, 38, 30, 21/
49126 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1046,1064)/
49127 & 185,0.010D0, 0, 93, 34, 21, 21, 21,
49128 & 185,0.020D0, 0, 93, 35, 21, 0, 0,
49129 & 185,0.040D0, 0, 93, 50, 30, 0, 0,
49130 & 185,0.020D0, 0, 93, 50, 31, 0, 0,
49131 & 185,0.010D0, 0, 93, 50, 30, 38, 30,
49132 & 185,0.010D0, 0, 93, 50, 30, 21, 21,
49133 & 185,0.006D0, 0, 93, 51, 30, 0, 0,
49134 & 186,1.000D0, 0,185, 21, 0, 0, 0,
49135 & 187,1.000D0, 0,185, 21, 0, 0, 0,
49136 & 188,1.000D0, 0,185, 38, 0, 0, 0,
49137 & 189,1.000D0, 0,185, 38, 0, 0, 0,
49138 & 190,0.045D0,101,128,121,106, 0, 0,
49139 & 190,0.005D0,101,128,121,107, 0, 0,
49140 & 190,0.045D0,101,130,123,106, 0, 0,
49141 & 190,0.005D0,101,130,123,107, 0, 0,
49142 & 190,0.021D0, 0,104, 50, 0, 0, 0,
49143 & 190,0.032D0, 0,105, 50, 0, 0, 0,
49144 & 190,0.032D0, 0, 97, 30, 50, 0, 0,
49145 & 190,0.045D0, 0,104, 51, 0, 0, 0/
49146 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1065,1083)/
49147 & 190,0.065D0, 0,105, 51, 0, 0, 0,
49148 & 190,0.065D0, 0, 97, 30, 51, 0, 0,
49149 & 190,0.055D0, 0,106, 30, 0, 0, 0,
49150 & 190,0.160D0, 0,106, 31, 0, 0, 0,
49151 & 190,0.105D0, 0,107, 30, 0, 0, 0,
49152 & 190,0.320D0, 0,107, 31, 0, 0, 0,
49153 & 191,1.000D0, 0,190, 59, 0, 0, 0,
49154 & 192,0.667D0, 0,193, 30, 0, 0, 0,
49155 & 192,0.333D0, 0,190, 21, 0, 0, 0,
49156 & 193,0.045D0,101,128,121,101, 0, 0,
49157 & 193,0.045D0,101,130,123,101, 0, 0,
49158 & 193,0.005D0,101,128,121,102, 0, 0,
49159 & 193,0.005D0,101,130,123,102, 0, 0,
49160 & 193,0.020D0, 0, 97, 50, 0, 0, 0,
49161 & 193,0.020D0, 0, 97, 21, 50, 0, 0,
49162 & 193,0.020D0, 0, 98, 50, 0, 0, 0,
49163 & 193,0.060D0, 0, 97, 51, 0, 0, 0,
49164 & 193,0.060D0, 0, 97, 21, 51, 0, 0,
49165 & 193,0.060D0, 0, 98, 51, 0, 0, 0/
49166 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1084,1102)/
49167 & 193,0.020D0, 0,104, 46, 0, 0, 0,
49168 & 193,0.060D0, 0,104, 47, 0, 0, 0,
49169 & 193,0.040D0, 0,105, 46, 0, 0, 0,
49170 & 193,0.120D0, 0,105, 47, 0, 0, 0,
49171 & 193,0.020D0, 0,101, 30, 0, 0, 0,
49172 & 193,0.060D0, 0,101, 31, 0, 0, 0,
49173 & 193,0.040D0, 0,102, 30, 0, 0, 0,
49174 & 193,0.120D0, 0,102, 31, 0, 0, 0,
49175 & 193,0.010D0, 0,106, 21, 0, 0, 0,
49176 & 193,0.030D0, 0,106, 23, 0, 0, 0,
49177 & 193,0.020D0, 0,107, 21, 0, 0, 0,
49178 & 193,0.060D0, 0,107, 23, 0, 0, 0,
49179 & 193,0.030D0, 0,106, 56, 0, 0, 0,
49180 & 193,0.030D0, 0,108, 34, 0, 0, 0,
49181 & 194,1.000D0, 0,193, 59, 0, 0, 0,
49182 & 195,0.670D0, 0,190, 38, 0, 0, 0,
49183 & 195,0.330D0, 0,193, 21, 0, 0, 0,
49184 & 196,0.050D0,101,128,121,108, 0, 0,
49185 & 196,0.050D0,101,130,123,108, 0, 0/
49186 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1103,1121)/
49187 & 196,0.075D0, 0,106, 50, 0, 0, 0,
49188 & 196,0.225D0, 0,106, 51, 0, 0, 0,
49189 & 196,0.150D0, 0,107, 50, 0, 0, 0,
49190 & 196,0.450D0, 0,107, 51, 0, 0, 0,
49191 & 197,1.000D0, 0,196, 59, 0, 0, 0,
49192 & 209,0.250D0,100, 1, 8, 4, 0, 0,
49193 & 209,0.250D0,100, 3, 10, 4, 0, 0,
49194 & 209,0.250D0,100, 5, 12, 4, 0, 0,
49195 & 209,0.085D0,100,121,128, 4, 0, 0,
49196 & 209,0.085D0,100,123,130, 4, 0, 0,
49197 & 209,0.080D0,100,125,132, 4, 0, 0,
49198 & 210,0.250D0,100, 2, 7,209, 0, 0,
49199 & 210,0.250D0,100, 4, 9,209, 0, 0,
49200 & 210,0.250D0,100, 6, 11,209, 0, 0,
49201 & 210,0.085D0,100,122,127,209, 0, 0,
49202 & 210,0.085D0,100,124,129,209, 0, 0,
49203 & 210,0.080D0,100,126,131,209, 0, 0,
49204 & 211,0.250D0,100, 1, 8, 6, 0, 0,
49205 & 211,0.250D0,100, 3, 10, 6, 0, 0/
49206 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1122,1140)/
49207 & 211,0.250D0,100, 5, 12, 6, 0, 0,
49208 & 211,0.085D0,100,121,128, 6, 0, 0,
49209 & 211,0.085D0,100,123,130, 6, 0, 0,
49210 & 211,0.080D0,100,125,132, 6, 0, 0,
49211 & 212,0.250D0,100, 2, 7,211, 0, 0,
49212 & 212,0.250D0,100, 4, 9,211, 0, 0,
49213 & 212,0.250D0,100, 6, 11,211, 0, 0,
49214 & 212,0.085D0,100,122,127,211, 0, 0,
49215 & 212,0.085D0,100,124,129,211, 0, 0,
49216 & 212,0.080D0,100,126,131,211, 0, 0,
49217 & 215,0.250D0,100, 7, 2, 10, 0, 0,
49218 & 215,0.250D0,100, 9, 4, 10, 0, 0,
49219 & 215,0.250D0,100, 11, 6, 10, 0, 0,
49220 & 215,0.085D0,100,127,122, 10, 0, 0,
49221 & 215,0.085D0,100,129,124, 10, 0, 0,
49222 & 215,0.080D0,100,131,126, 10, 0, 0,
49223 & 216,0.250D0,100, 8, 1,215, 0, 0,
49224 & 216,0.250D0,100, 10, 3,215, 0, 0,
49225 & 216,0.250D0,100, 12, 5,215, 0, 0/
49226 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1141,1159)/
49227 & 216,0.085D0,100,128,121,215, 0, 0,
49228 & 216,0.085D0,100,130,123,215, 0, 0,
49229 & 216,0.080D0,100,132,125,215, 0, 0,
49230 & 217,0.250D0,100, 7, 2, 12, 0, 0,
49231 & 217,0.250D0,100, 9, 4, 12, 0, 0,
49232 & 217,0.250D0,100, 11, 6, 12, 0, 0,
49233 & 217,0.085D0,100,127,122, 12, 0, 0,
49234 & 217,0.085D0,100,129,124, 12, 0, 0,
49235 & 217,0.080D0,100,131,126, 12, 0, 0,
49236 & 218,0.250D0,100, 8, 1,217, 0, 0,
49237 & 218,0.250D0,100, 10, 3,217, 0, 0,
49238 & 218,0.250D0,100, 12, 5,217, 0, 0,
49239 & 218,0.085D0,100,128,121,217, 0, 0,
49240 & 218,0.085D0,100,130,123,217, 0, 0,
49241 & 218,0.080D0,100,132,125,217, 0, 0,
49242 & 221,0.016D0,101,121,128,136, 0, 0,
49243 & 221,0.016D0,101,123,130,136, 0, 0,
49244 & 221,0.008D0,101,125,132,136, 0, 0,
49245 & 221,0.048D0,101,121,128,137, 0, 0/
49246 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1160,1178)/
49247 & 221,0.048D0,101,123,130,137, 0, 0,
49248 & 221,0.022D0,101,125,132,137, 0, 0,
49249 & 221,0.003D0,101,121,128,331, 0, 0,
49250 & 221,0.003D0,101,123,130,331, 0, 0,
49251 & 221,0.001D0,101,125,132,331, 0, 0,
49252 & 221,0.008D0,101,121,128,138, 0, 0,
49253 & 221,0.008D0,101,123,130,138, 0, 0,
49254 & 221,0.004D0,101,125,132,138, 0, 0,
49255 & 221,0.008D0,101,121,128,313, 0, 0,
49256 & 221,0.008D0,101,123,130,313, 0, 0,
49257 & 221,0.004D0,101,125,132,313, 0, 0,
49258 & 221,0.013D0,101,121,128,139, 0, 0,
49259 & 221,0.013D0,101,123,130,139, 0, 0,
49260 & 221,0.006D0,101,125,132,139, 0, 0,
49261 & 221,0.004D0, 0,136, 30, 0, 0, 0,
49262 & 221,0.010D0, 0,136, 31, 0, 0, 0,
49263 & 221,0.006D0, 0,136, 32, 0, 0, 0,
49264 & 221,0.003D0, 0,137, 30, 0, 0, 0,
49265 & 221,0.009D0, 0,137, 31, 0, 0, 0/
49266 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1179,1197)/
49267 & 221,0.017D0, 0,137, 32, 0, 0, 0,
49268 & 221,0.011D0, 0,136,179, 0, 0, 0,
49269 & 221,0.015D0, 0,136,180, 0, 0, 0,
49270 & 221,0.011D0, 0,137,179, 0, 0, 0,
49271 & 221,0.022D0, 0,137,180, 0, 0, 0,
49272 & 221,0.001D0, 0,164, 42, 0, 0, 0,
49273 & 221,0.002D0, 0,164, 43, 0, 0, 0,
49274 & 221,0.001D0, 0,165, 42, 0, 0, 0,
49275 & 221,0.001D0, 0,165, 43, 0, 0, 0,
49276 & 221,0.001D0, 0,166, 42, 0, 0, 0,
49277 & 221,0.001D0, 0,166, 43, 0, 0, 0,
49278 & 221,0.207D0,100, 1, 8, 4, 7, 0,
49279 & 221,0.207D0,100, 3, 10, 4, 7, 0,
49280 & 221,0.024D0,100, 1, 8, 2, 7, 0,
49281 & 221,0.024D0,100, 3, 10, 2, 7, 0,
49282 & 221,0.012D0,100, 3, 8, 4, 7, 0,
49283 & 221,0.012D0,100, 1, 10, 4, 7, 0,
49284 & 221,0.069D0,100, 4, 8, 1, 7, 0,
49285 & 221,0.069D0,100, 4, 10, 3, 7, 0/
49286 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1198,1216)/
49287 & 221,0.008D0,100, 2, 8, 1, 7, 0,
49288 & 221,0.008D0,100, 2, 10, 3, 7, 0,
49289 & 221,0.004D0,100, 4, 8, 3, 7, 0,
49290 & 221,0.004D0,100, 4, 10, 1, 7, 0,
49291 & 222,0.016D0,101,121,128,140, 0, 0,
49292 & 222,0.016D0,101,123,130,140, 0, 0,
49293 & 222,0.008D0,101,125,132,140, 0, 0,
49294 & 222,0.048D0,101,121,128,141, 0, 0,
49295 & 222,0.048D0,101,123,130,141, 0, 0,
49296 & 222,0.022D0,101,125,132,141, 0, 0,
49297 & 222,0.003D0,101,121,128,332, 0, 0,
49298 & 222,0.003D0,101,123,130,332, 0, 0,
49299 & 222,0.001D0,101,125,132,332, 0, 0,
49300 & 222,0.008D0,101,121,128,142, 0, 0,
49301 & 222,0.008D0,101,123,130,142, 0, 0,
49302 & 222,0.004D0,101,125,132,142, 0, 0,
49303 & 222,0.008D0,101,121,128,314, 0, 0,
49304 & 222,0.008D0,101,123,130,314, 0, 0,
49305 & 222,0.004D0,101,125,132,314, 0, 0/
49306 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1217,1235)/
49307 & 222,0.013D0,101,121,128,143, 0, 0,
49308 & 222,0.013D0,101,123,130,143, 0, 0,
49309 & 222,0.006D0,101,125,132,143, 0, 0,
49310 & 222,0.004D0, 0,140, 30, 0, 0, 0,
49311 & 222,0.010D0, 0,140, 31, 0, 0, 0,
49312 & 222,0.006D0, 0,140, 32, 0, 0, 0,
49313 & 222,0.003D0, 0,141, 30, 0, 0, 0,
49314 & 222,0.009D0, 0,141, 31, 0, 0, 0,
49315 & 222,0.017D0, 0,141, 32, 0, 0, 0,
49316 & 222,0.011D0, 0,140,179, 0, 0, 0,
49317 & 222,0.015D0, 0,140,180, 0, 0, 0,
49318 & 222,0.011D0, 0,141,179, 0, 0, 0,
49319 & 222,0.022D0, 0,141,180, 0, 0, 0,
49320 & 222,0.001D0, 0,164, 34, 0, 0, 0,
49321 & 222,0.002D0, 0,164, 35, 0, 0, 0,
49322 & 222,0.001D0, 0,165, 34, 0, 0, 0,
49323 & 222,0.001D0, 0,165, 35, 0, 0, 0,
49324 & 222,0.001D0, 0,166, 34, 0, 0, 0,
49325 & 222,0.001D0, 0,166, 35, 0, 0, 0/
49326 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1236,1254)/
49327 & 222,0.207D0,100, 1, 8, 4, 8, 0,
49328 & 222,0.207D0,100, 3, 10, 4, 8, 0,
49329 & 222,0.024D0,100, 1, 8, 2, 8, 0,
49330 & 222,0.024D0,100, 3, 10, 2, 8, 0,
49331 & 222,0.012D0,100, 3, 8, 4, 8, 0,
49332 & 222,0.012D0,100, 1, 10, 4, 8, 0,
49333 & 222,0.069D0,100, 4, 8, 1, 8, 0,
49334 & 222,0.069D0,100, 4, 10, 3, 8, 0,
49335 & 222,0.008D0,100, 2, 8, 1, 8, 0,
49336 & 222,0.008D0,100, 2, 10, 3, 8, 0,
49337 & 222,0.004D0,100, 4, 8, 3, 8, 0,
49338 & 222,0.004D0,100, 4, 10, 1, 8, 0,
49339 & 223,0.016D0,101,121,128,144, 0, 0,
49340 & 223,0.016D0,101,123,130,144, 0, 0,
49341 & 223,0.008D0,101,125,132,144, 0, 0,
49342 & 223,0.048D0,101,121,128,145, 0, 0,
49343 & 223,0.048D0,101,123,130,145, 0, 0,
49344 & 223,0.022D0,101,125,132,145, 0, 0,
49345 & 223,0.003D0,101,121,128,333, 0, 0/
49346 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1255,1273)/
49347 & 223,0.003D0,101,123,130,333, 0, 0,
49348 & 223,0.001D0,101,125,132,333, 0, 0,
49349 & 223,0.008D0,101,121,128,146, 0, 0,
49350 & 223,0.008D0,101,123,130,146, 0, 0,
49351 & 223,0.004D0,101,125,132,146, 0, 0,
49352 & 223,0.008D0,101,121,128,315, 0, 0,
49353 & 223,0.008D0,101,123,130,315, 0, 0,
49354 & 223,0.004D0,101,125,132,315, 0, 0,
49355 & 223,0.013D0,101,121,128,147, 0, 0,
49356 & 223,0.013D0,101,123,130,147, 0, 0,
49357 & 223,0.006D0,101,125,132,147, 0, 0,
49358 & 223,0.004D0, 0,144, 30, 0, 0, 0,
49359 & 223,0.010D0, 0,144, 31, 0, 0, 0,
49360 & 223,0.006D0, 0,144, 32, 0, 0, 0,
49361 & 223,0.003D0, 0,145, 30, 0, 0, 0,
49362 & 223,0.009D0, 0,145, 31, 0, 0, 0,
49363 & 223,0.017D0, 0,145, 32, 0, 0, 0,
49364 & 223,0.011D0, 0,144,179, 0, 0, 0,
49365 & 223,0.015D0, 0,144,180, 0, 0, 0/
49366 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1274,1292)/
49367 & 223,0.011D0, 0,145,179, 0, 0, 0,
49368 & 223,0.022D0, 0,145,180, 0, 0, 0,
49369 & 223,0.001D0, 0,164, 25, 0, 0, 0,
49370 & 223,0.002D0, 0,164, 56, 0, 0, 0,
49371 & 223,0.001D0, 0,165, 25, 0, 0, 0,
49372 & 223,0.001D0, 0,165, 56, 0, 0, 0,
49373 & 223,0.001D0, 0,166, 25, 0, 0, 0,
49374 & 223,0.001D0, 0,166, 56, 0, 0, 0,
49375 & 223,0.207D0,100, 1, 8, 4, 9, 0,
49376 & 223,0.207D0,100, 3, 10, 4, 9, 0,
49377 & 223,0.024D0,100, 1, 8, 2, 9, 0,
49378 & 223,0.024D0,100, 3, 10, 2, 9, 0,
49379 & 223,0.012D0,100, 3, 8, 4, 9, 0,
49380 & 223,0.012D0,100, 1, 10, 4, 9, 0,
49381 & 223,0.069D0,100, 4, 8, 1, 9, 0,
49382 & 223,0.069D0,100, 4, 10, 3, 9, 0,
49383 & 223,0.008D0,100, 2, 8, 1, 9, 0,
49384 & 223,0.008D0,100, 2, 10, 3, 9, 0,
49385 & 223,0.004D0,100, 4, 8, 3, 9, 0/
49386 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1293,1311)/
49387 & 223,0.004D0,100, 4, 10, 1, 9, 0,
49388 & 224,0.090D0,100,121,128, 4,109, 0,
49389 & 224,0.090D0,100,123,130, 4,109, 0,
49390 & 224,0.045D0,100,125,132, 4,109, 0,
49391 & 224,0.010D0,100,121,128, 2,109, 0,
49392 & 224,0.010D0,100,123,130, 2,109, 0,
49393 & 224,0.005D0,100,125,132, 2,109, 0,
49394 & 224,0.242D0,100, 1, 8, 4,109, 0,
49395 & 224,0.242D0,100, 3, 10, 4,109, 0,
49396 & 224,0.027D0,100, 1, 8, 2,109, 0,
49397 & 224,0.027D0,100, 3, 10, 2,109, 0,
49398 & 224,0.012D0,100, 3, 8, 4,109, 0,
49399 & 224,0.012D0,100, 1, 10, 4,109, 0,
49400 & 224,0.081D0,100, 4, 8, 1,109, 0,
49401 & 224,0.081D0,100, 4, 10, 3,109, 0,
49402 & 224,0.009D0,100, 2, 8, 1,109, 0,
49403 & 224,0.009D0,100, 2, 10, 3,109, 0,
49404 & 224,0.004D0,100, 4, 8, 3,109, 0,
49405 & 224,0.004D0,100, 4, 10, 1,109, 0/
49406 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1312,1330)/
49407 & 225,0.090D0,100,121,128, 4,110, 0,
49408 & 225,0.090D0,100,123,130, 4,110, 0,
49409 & 225,0.045D0,100,125,132, 4,110, 0,
49410 & 225,0.010D0,100,121,128, 2,110, 0,
49411 & 225,0.010D0,100,123,130, 2,110, 0,
49412 & 225,0.005D0,100,125,132, 2,110, 0,
49413 & 225,0.242D0,100, 1, 8, 4,110, 0,
49414 & 225,0.242D0,100, 3, 10, 4,110, 0,
49415 & 225,0.027D0,100, 1, 8, 2,110, 0,
49416 & 225,0.027D0,100, 3, 10, 2,110, 0,
49417 & 225,0.012D0,100, 3, 8, 4,110, 0,
49418 & 225,0.012D0,100, 1, 10, 4,110, 0,
49419 & 225,0.081D0,100, 4, 8, 1,110, 0,
49420 & 225,0.081D0,100, 4, 10, 3,110, 0,
49421 & 225,0.009D0,100, 2, 8, 1,110, 0,
49422 & 225,0.009D0,100, 2, 10, 3,110, 0,
49423 & 225,0.004D0,100, 4, 8, 3,110, 0,
49424 & 225,0.004D0,100, 4, 10, 1,110, 0,
49425 & 226,0.090D0,100,121,128, 4,111, 0/
49426 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1331,1349)/
49427 & 226,0.090D0,100,123,130, 4,111, 0,
49428 & 226,0.045D0,100,125,132, 4,111, 0,
49429 & 226,0.010D0,100,121,128, 2,111, 0,
49430 & 226,0.010D0,100,123,130, 2,111, 0,
49431 & 226,0.005D0,100,125,132, 2,111, 0,
49432 & 226,0.242D0,100, 1, 8, 4,111, 0,
49433 & 226,0.242D0,100, 3, 10, 4,111, 0,
49434 & 226,0.027D0,100, 1, 8, 2,111, 0,
49435 & 226,0.027D0,100, 3, 10, 2,111, 0,
49436 & 226,0.012D0,100, 3, 8, 4,111, 0,
49437 & 226,0.012D0,100, 1, 10, 4,111, 0,
49438 & 226,0.081D0,100, 4, 8, 1,111, 0,
49439 & 226,0.081D0,100, 4, 10, 3,111, 0,
49440 & 226,0.009D0,100, 2, 8, 1,111, 0,
49441 & 226,0.009D0,100, 2, 10, 3,111, 0,
49442 & 226,0.004D0,100, 4, 8, 3,111, 0,
49443 & 226,0.004D0,100, 4, 10, 1,111, 0,
49444 & 227,0.090D0,100,121,128, 4,112, 0,
49445 & 227,0.090D0,100,123,130, 4,112, 0/
49446 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1350,1368)/
49447 & 227,0.045D0,100,125,132, 4,112, 0,
49448 & 227,0.010D0,100,121,128, 2,112, 0,
49449 & 227,0.010D0,100,123,130, 2,112, 0,
49450 & 227,0.005D0,100,125,132, 2,112, 0,
49451 & 227,0.242D0,100, 1, 8, 4,112, 0,
49452 & 227,0.242D0,100, 3, 10, 4,112, 0,
49453 & 227,0.027D0,100, 1, 8, 2,112, 0,
49454 & 227,0.027D0,100, 3, 10, 2,112, 0,
49455 & 227,0.012D0,100, 3, 8, 4,112, 0,
49456 & 227,0.012D0,100, 1, 10, 4,112, 0,
49457 & 227,0.081D0,100, 4, 8, 1,112, 0,
49458 & 227,0.081D0,100, 4, 10, 3,112, 0,
49459 & 227,0.009D0,100, 2, 8, 1,112, 0,
49460 & 227,0.009D0,100, 2, 10, 3,112, 0,
49461 & 227,0.004D0,100, 4, 8, 3,112, 0,
49462 & 227,0.004D0,100, 4, 10, 1,112, 0,
49463 & 228,0.090D0,100,121,128, 4,113, 0,
49464 & 228,0.090D0,100,123,130, 4,113, 0,
49465 & 228,0.045D0,100,125,132, 4,113, 0/
49466 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1369,1387)/
49467 & 228,0.010D0,100,121,128, 2,113, 0,
49468 & 228,0.010D0,100,123,130, 2,113, 0,
49469 & 228,0.005D0,100,125,132, 2,113, 0,
49470 & 228,0.242D0,100, 1, 8, 4,113, 0,
49471 & 228,0.242D0,100, 3, 10, 4,113, 0,
49472 & 228,0.027D0,100, 1, 8, 2,113, 0,
49473 & 228,0.027D0,100, 3, 10, 2,113, 0,
49474 & 228,0.012D0,100, 3, 8, 4,113, 0,
49475 & 228,0.012D0,100, 1, 10, 4,113, 0,
49476 & 228,0.081D0,100, 4, 8, 1,113, 0,
49477 & 228,0.081D0,100, 4, 10, 3,113, 0,
49478 & 228,0.009D0,100, 2, 8, 1,113, 0,
49479 & 228,0.009D0,100, 2, 10, 3,113, 0,
49480 & 228,0.004D0,100, 4, 8, 3,113, 0,
49481 & 228,0.004D0,100, 4, 10, 1,113, 0,
49482 & 229,0.090D0,100,121,128, 4,114, 0,
49483 & 229,0.090D0,100,123,130, 4,114, 0,
49484 & 229,0.045D0,100,125,132, 4,114, 0,
49485 & 229,0.010D0,100,121,128, 2,114, 0/
49486 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1388,1406)/
49487 & 229,0.010D0,100,123,130, 2,114, 0,
49488 & 229,0.005D0,100,125,132, 2,114, 0,
49489 & 229,0.242D0,100, 1, 8, 4,114, 0,
49490 & 229,0.242D0,100, 3, 10, 4,114, 0,
49491 & 229,0.027D0,100, 1, 8, 2,114, 0,
49492 & 229,0.027D0,100, 3, 10, 2,114, 0,
49493 & 229,0.012D0,100, 3, 8, 4,114, 0,
49494 & 229,0.012D0,100, 1, 10, 4,114, 0,
49495 & 229,0.081D0,100, 4, 8, 1,114, 0,
49496 & 229,0.081D0,100, 4, 10, 3,114, 0,
49497 & 229,0.009D0,100, 2, 8, 1,114, 0,
49498 & 229,0.009D0,100, 2, 10, 3,114, 0,
49499 & 229,0.004D0,100, 4, 8, 3,114, 0,
49500 & 229,0.004D0,100, 4, 10, 1,114, 0,
49501 & 230,0.080D0,100,121,128, 4, 10, 0,
49502 & 230,0.080D0,100,123,130, 4, 10, 0,
49503 & 230,0.040D0,100,125,132, 4, 10, 0,
49504 & 230,0.080D0,100,121,128, 9, 5, 0,
49505 & 230,0.080D0,100,123,130, 9, 5, 0/
49506 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1407,1425)/
49507 & 230,0.228D0,100, 1, 8, 4, 10, 0,
49508 & 230,0.228D0,100, 3, 10, 4, 10, 0,
49509 & 230,0.012D0,100, 3, 8, 4, 10, 0,
49510 & 230,0.012D0,100, 1, 10, 4, 10, 0,
49511 & 230,0.076D0,100, 4, 8, 1, 10, 0,
49512 & 230,0.076D0,100, 4, 10, 3, 10, 0,
49513 & 230,0.004D0,100, 4, 8, 3, 10, 0,
49514 & 230,0.004D0,100, 4, 10, 1, 10, 0,
49515 & 231,0.025D0, 0,121,127, 0, 0, 0,
49516 & 231,0.025D0, 0,123,129, 0, 0, 0,
49517 & 231,0.025D0, 0,125,131, 0, 0, 0,
49518 & 231,0.008D0, 0, 1, 7, 0, 0, 0,
49519 & 231,0.033D0, 0, 2, 8, 0, 0, 0,
49520 & 231,0.008D0, 0, 3, 9, 0, 0, 0,
49521 & 231,0.033D0, 0, 4, 10, 0, 0, 0,
49522 & 231,0.801D0,130, 13, 13, 13, 0, 0,
49523 & 231,0.042D0,130, 13, 13, 59, 0, 0,
49524 & 245,0.016D0,101,127,122,171, 0, 0,
49525 & 245,0.016D0,101,129,124,171, 0, 0/
49526 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1426,1444)/
49527 & 245,0.008D0,101,131,126,171, 0, 0,
49528 & 245,0.048D0,101,127,122,172, 0, 0,
49529 & 245,0.048D0,101,129,124,172, 0, 0,
49530 & 245,0.022D0,101,131,126,172, 0, 0,
49531 & 245,0.003D0,101,127,122,334, 0, 0,
49532 & 245,0.003D0,101,129,124,334, 0, 0,
49533 & 245,0.001D0,101,131,126,334, 0, 0,
49534 & 245,0.008D0,101,127,122,173, 0, 0,
49535 & 245,0.008D0,101,129,124,173, 0, 0,
49536 & 245,0.004D0,101,131,126,173, 0, 0,
49537 & 245,0.008D0,101,127,122,316, 0, 0,
49538 & 245,0.008D0,101,129,124,316, 0, 0,
49539 & 245,0.004D0,101,131,126,316, 0, 0,
49540 & 245,0.013D0,101,127,122,174, 0, 0,
49541 & 245,0.013D0,101,129,124,174, 0, 0,
49542 & 245,0.006D0,101,131,126,174, 0, 0,
49543 & 245,0.004D0, 0,171, 38, 0, 0, 0,
49544 & 245,0.010D0, 0,171, 39, 0, 0, 0,
49545 & 245,0.006D0, 0,171, 40, 0, 0, 0/
49546 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1445,1463)/
49547 & 245,0.003D0, 0,172, 38, 0, 0, 0,
49548 & 245,0.009D0, 0,172, 39, 0, 0, 0,
49549 & 245,0.017D0, 0,172, 40, 0, 0, 0,
49550 & 245,0.011D0, 0,171,144, 0, 0, 0,
49551 & 245,0.015D0, 0,171,145, 0, 0, 0,
49552 & 245,0.011D0, 0,172,144, 0, 0, 0,
49553 & 245,0.022D0, 0,172,145, 0, 0, 0,
49554 & 245,0.001D0, 0,164, 50, 0, 0, 0,
49555 & 245,0.002D0, 0,164, 51, 0, 0, 0,
49556 & 245,0.001D0, 0,165, 50, 0, 0, 0,
49557 & 245,0.001D0, 0,165, 51, 0, 0, 0,
49558 & 245,0.001D0, 0,166, 50, 0, 0, 0,
49559 & 245,0.001D0, 0,166, 51, 0, 0, 0,
49560 & 245,0.207D0,100, 7, 2, 10, 1, 0,
49561 & 245,0.207D0,100, 9, 4, 10, 1, 0,
49562 & 245,0.024D0,100, 7, 2, 8, 1, 0,
49563 & 245,0.024D0,100, 9, 4, 8, 1, 0,
49564 & 245,0.012D0,100, 9, 2, 10, 1, 0,
49565 & 245,0.012D0,100, 7, 4, 10, 1, 0/
49566 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1464,1482)/
49567 & 245,0.069D0,100, 10, 2, 7, 1, 0,
49568 & 245,0.069D0,100, 10, 4, 9, 1, 0,
49569 & 245,0.008D0,100, 8, 2, 7, 1, 0,
49570 & 245,0.008D0,100, 8, 4, 9, 1, 0,
49571 & 245,0.004D0,100, 10, 2, 9, 1, 0,
49572 & 245,0.004D0,100, 10, 4, 7, 1, 0,
49573 & 246,0.016D0,101,127,122,175, 0, 0,
49574 & 246,0.016D0,101,129,124,175, 0, 0,
49575 & 246,0.008D0,101,131,126,175, 0, 0,
49576 & 246,0.048D0,101,127,122,176, 0, 0,
49577 & 246,0.048D0,101,129,124,176, 0, 0,
49578 & 246,0.022D0,101,131,126,176, 0, 0,
49579 & 246,0.003D0,101,127,122,335, 0, 0,
49580 & 246,0.003D0,101,129,124,335, 0, 0,
49581 & 246,0.001D0,101,131,126,335, 0, 0,
49582 & 246,0.008D0,101,127,122,177, 0, 0,
49583 & 246,0.008D0,101,129,124,177, 0, 0,
49584 & 246,0.004D0,101,131,126,177, 0, 0,
49585 & 246,0.008D0,101,127,122,317, 0, 0/
49586 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1483,1501)/
49587 & 246,0.008D0,101,129,124,317, 0, 0,
49588 & 246,0.004D0,101,131,126,317, 0, 0,
49589 & 246,0.013D0,101,127,122,178, 0, 0,
49590 & 246,0.013D0,101,129,124,178, 0, 0,
49591 & 246,0.006D0,101,131,126,178, 0, 0,
49592 & 246,0.004D0, 0,175, 38, 0, 0, 0,
49593 & 246,0.010D0, 0,175, 39, 0, 0, 0,
49594 & 246,0.006D0, 0,175, 40, 0, 0, 0,
49595 & 246,0.003D0, 0,176, 38, 0, 0, 0,
49596 & 246,0.009D0, 0,176, 39, 0, 0, 0,
49597 & 246,0.017D0, 0,176, 40, 0, 0, 0,
49598 & 246,0.011D0, 0,175,144, 0, 0, 0,
49599 & 246,0.015D0, 0,175,145, 0, 0, 0,
49600 & 246,0.011D0, 0,176,144, 0, 0, 0,
49601 & 246,0.022D0, 0,176,145, 0, 0, 0,
49602 & 246,0.001D0, 0,164, 46, 0, 0, 0,
49603 & 246,0.002D0, 0,164, 47, 0, 0, 0,
49604 & 246,0.001D0, 0,165, 46, 0, 0, 0,
49605 & 246,0.001D0, 0,165, 47, 0, 0, 0/
49606 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1502,1520)/
49607 & 246,0.001D0, 0,166, 46, 0, 0, 0,
49608 & 246,0.001D0, 0,166, 47, 0, 0, 0,
49609 & 246,0.207D0,100, 7, 2, 10, 2, 0,
49610 & 246,0.207D0,100, 9, 4, 10, 2, 0,
49611 & 246,0.024D0,100, 7, 2, 8, 2, 0,
49612 & 246,0.024D0,100, 9, 4, 8, 2, 0,
49613 & 246,0.012D0,100, 9, 2, 10, 2, 0,
49614 & 246,0.012D0,100, 7, 4, 10, 2, 0,
49615 & 246,0.069D0,100, 10, 2, 7, 2, 0,
49616 & 246,0.069D0,100, 10, 4, 9, 2, 0,
49617 & 246,0.008D0,100, 8, 2, 7, 2, 0,
49618 & 246,0.008D0,100, 8, 4, 9, 2, 0,
49619 & 246,0.004D0,100, 10, 2, 9, 2, 0,
49620 & 246,0.004D0,100, 10, 4, 7, 2, 0,
49621 & 247,0.016D0,101,127,122,179, 0, 0,
49622 & 247,0.016D0,101,129,124,179, 0, 0,
49623 & 247,0.008D0,101,131,126,179, 0, 0,
49624 & 247,0.048D0,101,127,122,180, 0, 0,
49625 & 247,0.048D0,101,129,124,180, 0, 0/
49626 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1521,1539)/
49627 & 247,0.022D0,101,131,126,180, 0, 0,
49628 & 247,0.003D0,101,127,122,336, 0, 0,
49629 & 247,0.003D0,101,129,124,336, 0, 0,
49630 & 247,0.001D0,101,131,126,336, 0, 0,
49631 & 247,0.008D0,101,127,122,181, 0, 0,
49632 & 247,0.008D0,101,129,124,181, 0, 0,
49633 & 247,0.004D0,101,131,126,181, 0, 0,
49634 & 247,0.008D0,101,127,122,318, 0, 0,
49635 & 247,0.008D0,101,129,124,318, 0, 0,
49636 & 247,0.004D0,101,131,126,318, 0, 0,
49637 & 247,0.013D0,101,127,122,182, 0, 0,
49638 & 247,0.013D0,101,129,124,182, 0, 0,
49639 & 247,0.006D0,101,131,126,182, 0, 0,
49640 & 247,0.004D0, 0,179, 38, 0, 0, 0,
49641 & 247,0.010D0, 0,179, 39, 0, 0, 0,
49642 & 247,0.006D0, 0,179, 40, 0, 0, 0,
49643 & 247,0.003D0, 0,180, 38, 0, 0, 0,
49644 & 247,0.009D0, 0,180, 39, 0, 0, 0,
49645 & 247,0.017D0, 0,180, 40, 0, 0, 0/
49646 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1540,1558)/
49647 & 247,0.011D0, 0,179,144, 0, 0, 0,
49648 & 247,0.015D0, 0,179,145, 0, 0, 0,
49649 & 247,0.011D0, 0,180,144, 0, 0, 0,
49650 & 247,0.022D0, 0,180,145, 0, 0, 0,
49651 & 247,0.001D0, 0,164, 25, 0, 0, 0,
49652 & 247,0.002D0, 0,164, 56, 0, 0, 0,
49653 & 247,0.001D0, 0,165, 25, 0, 0, 0,
49654 & 247,0.001D0, 0,165, 56, 0, 0, 0,
49655 & 247,0.001D0, 0,166, 25, 0, 0, 0,
49656 & 247,0.001D0, 0,166, 56, 0, 0, 0,
49657 & 247,0.207D0,100, 7, 2, 10, 3, 0,
49658 & 247,0.207D0,100, 9, 4, 10, 3, 0,
49659 & 247,0.024D0,100, 7, 2, 8, 3, 0,
49660 & 247,0.024D0,100, 9, 4, 8, 3, 0,
49661 & 247,0.012D0,100, 9, 2, 10, 3, 0,
49662 & 247,0.012D0,100, 7, 4, 10, 3, 0,
49663 & 247,0.069D0,100, 10, 2, 7, 3, 0,
49664 & 247,0.069D0,100, 10, 4, 9, 3, 0,
49665 & 247,0.008D0,100, 8, 2, 7, 3, 0/
49666 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1559,1577)/
49667 & 247,0.008D0,100, 8, 4, 9, 3, 0,
49668 & 247,0.004D0,100, 10, 2, 9, 3, 0,
49669 & 247,0.004D0,100, 10, 4, 7, 3, 0,
49670 & 248,0.090D0,100,127,122, 10,115, 0,
49671 & 248,0.090D0,100,129,124, 10,115, 0,
49672 & 248,0.045D0,100,131,126, 10,115, 0,
49673 & 248,0.010D0,100,127,122, 8,115, 0,
49674 & 248,0.010D0,100,129,124, 8,115, 0,
49675 & 248,0.005D0,100,131,126, 8,115, 0,
49676 & 248,0.242D0,100, 7, 2, 10,115, 0,
49677 & 248,0.242D0,100, 9, 4, 10,115, 0,
49678 & 248,0.027D0,100, 7, 2, 8,115, 0,
49679 & 248,0.027D0,100, 9, 4, 8,115, 0,
49680 & 248,0.012D0,100, 9, 2, 10,115, 0,
49681 & 248,0.012D0,100, 7, 4, 10,115, 0,
49682 & 248,0.081D0,100, 10, 2, 7,115, 0,
49683 & 248,0.081D0,100, 10, 4, 9,115, 0,
49684 & 248,0.009D0,100, 8, 2, 7,115, 0,
49685 & 248,0.009D0,100, 8, 4, 9,115, 0/
49686 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1578,1596)/
49687 & 248,0.004D0,100, 10, 2, 9,115, 0,
49688 & 248,0.004D0,100, 10, 4, 7,115, 0,
49689 & 249,0.090D0,100,127,122, 10,116, 0,
49690 & 249,0.090D0,100,129,124, 10,116, 0,
49691 & 249,0.045D0,100,131,126, 10,116, 0,
49692 & 249,0.010D0,100,127,122, 8,116, 0,
49693 & 249,0.010D0,100,129,124, 8,116, 0,
49694 & 249,0.005D0,100,131,126, 8,116, 0,
49695 & 249,0.242D0,100, 7, 2, 10,116, 0,
49696 & 249,0.242D0,100, 9, 4, 10,116, 0,
49697 & 249,0.027D0,100, 7, 2, 8,116, 0,
49698 & 249,0.027D0,100, 9, 4, 8,116, 0,
49699 & 249,0.012D0,100, 9, 2, 10,116, 0,
49700 & 249,0.012D0,100, 7, 4, 10,116, 0,
49701 & 249,0.081D0,100, 10, 2, 7,116, 0,
49702 & 249,0.081D0,100, 10, 4, 9,116, 0,
49703 & 249,0.009D0,100, 8, 2, 7,116, 0,
49704 & 249,0.009D0,100, 8, 4, 9,116, 0,
49705 & 249,0.004D0,100, 10, 2, 9,116, 0/
49706 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1597,1615)/
49707 & 249,0.004D0,100, 10, 4, 7,116, 0,
49708 & 250,0.090D0,100,127,122, 10,117, 0,
49709 & 250,0.090D0,100,129,124, 10,117, 0,
49710 & 250,0.045D0,100,131,126, 10,117, 0,
49711 & 250,0.010D0,100,127,122, 8,117, 0,
49712 & 250,0.010D0,100,129,124, 8,117, 0,
49713 & 250,0.005D0,100,131,126, 8,117, 0,
49714 & 250,0.242D0,100, 7, 2, 10,117, 0,
49715 & 250,0.242D0,100, 9, 4, 10,117, 0,
49716 & 250,0.027D0,100, 7, 2, 8,117, 0,
49717 & 250,0.027D0,100, 9, 4, 8,117, 0,
49718 & 250,0.012D0,100, 9, 2, 10,117, 0,
49719 & 250,0.012D0,100, 7, 4, 10,117, 0,
49720 & 250,0.081D0,100, 10, 2, 7,117, 0,
49721 & 250,0.081D0,100, 10, 4, 9,117, 0,
49722 & 250,0.009D0,100, 8, 2, 7,117, 0,
49723 & 250,0.009D0,100, 8, 4, 9,117, 0,
49724 & 250,0.004D0,100, 10, 2, 9,117, 0,
49725 & 250,0.004D0,100, 10, 4, 7,117, 0/
49726 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1616,1634)/
49727 & 251,0.090D0,100,127,122, 10,118, 0,
49728 & 251,0.090D0,100,129,124, 10,118, 0,
49729 & 251,0.045D0,100,131,126, 10,118, 0,
49730 & 251,0.010D0,100,127,122, 8,118, 0,
49731 & 251,0.010D0,100,129,124, 8,118, 0,
49732 & 251,0.005D0,100,131,126, 8,118, 0,
49733 & 251,0.242D0,100, 7, 2, 10,118, 0,
49734 & 251,0.242D0,100, 9, 4, 10,118, 0,
49735 & 251,0.027D0,100, 7, 2, 8,118, 0,
49736 & 251,0.027D0,100, 9, 4, 8,118, 0,
49737 & 251,0.012D0,100, 9, 2, 10,118, 0,
49738 & 251,0.012D0,100, 7, 4, 10,118, 0,
49739 & 251,0.081D0,100, 10, 2, 7,118, 0,
49740 & 251,0.081D0,100, 10, 4, 9,118, 0,
49741 & 251,0.009D0,100, 8, 2, 7,118, 0,
49742 & 251,0.009D0,100, 8, 4, 9,118, 0,
49743 & 251,0.004D0,100, 10, 2, 9,118, 0,
49744 & 251,0.004D0,100, 10, 4, 7,118, 0,
49745 & 252,0.090D0,100,127,122, 10,119, 0/
49746 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1635,1653)/
49747 & 252,0.090D0,100,129,124, 10,119, 0,
49748 & 252,0.045D0,100,131,126, 10,119, 0,
49749 & 252,0.010D0,100,127,122, 8,119, 0,
49750 & 252,0.010D0,100,129,124, 8,119, 0,
49751 & 252,0.005D0,100,131,126, 8,119, 0,
49752 & 252,0.242D0,100, 7, 2, 10,119, 0,
49753 & 252,0.242D0,100, 9, 4, 10,119, 0,
49754 & 252,0.027D0,100, 7, 2, 8,119, 0,
49755 & 252,0.027D0,100, 9, 4, 8,119, 0,
49756 & 252,0.012D0,100, 9, 2, 10,119, 0,
49757 & 252,0.012D0,100, 7, 4, 10,119, 0,
49758 & 252,0.081D0,100, 10, 2, 7,119, 0,
49759 & 252,0.081D0,100, 10, 4, 9,119, 0,
49760 & 252,0.009D0,100, 8, 2, 7,119, 0,
49761 & 252,0.009D0,100, 8, 4, 9,119, 0,
49762 & 252,0.004D0,100, 10, 2, 9,119, 0,
49763 & 252,0.004D0,100, 10, 4, 7,119, 0,
49764 & 253,0.090D0,100,127,122, 10,120, 0,
49765 & 253,0.090D0,100,129,124, 10,120, 0/
49766 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1654,1672)/
49767 & 253,0.045D0,100,131,126, 10,120, 0,
49768 & 253,0.010D0,100,127,122, 8,120, 0,
49769 & 253,0.010D0,100,129,124, 8,120, 0,
49770 & 253,0.005D0,100,131,126, 8,120, 0,
49771 & 253,0.242D0,100, 7, 2, 10,120, 0,
49772 & 253,0.242D0,100, 9, 4, 10,120, 0,
49773 & 253,0.027D0,100, 7, 2, 8,120, 0,
49774 & 253,0.027D0,100, 9, 4, 8,120, 0,
49775 & 253,0.012D0,100, 9, 2, 10,120, 0,
49776 & 253,0.012D0,100, 7, 4, 10,120, 0,
49777 & 253,0.081D0,100, 10, 2, 7,120, 0,
49778 & 253,0.081D0,100, 10, 4, 9,120, 0,
49779 & 253,0.009D0,100, 8, 2, 7,120, 0,
49780 & 253,0.009D0,100, 8, 4, 9,120, 0,
49781 & 253,0.004D0,100, 10, 2, 9,120, 0,
49782 & 253,0.004D0,100, 10, 4, 7,120, 0,
49783 & 254,0.080D0,100,127,122, 10, 4, 0,
49784 & 254,0.080D0,100,129,124, 10, 4, 0,
49785 & 254,0.040D0,100,131,126, 10, 4, 0/
49786 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1673,1691)/
49787 & 254,0.080D0,100,127,122, 3, 11, 0,
49788 & 254,0.080D0,100,129,124, 3, 11, 0,
49789 & 254,0.228D0,100, 7, 2, 10, 4, 0,
49790 & 254,0.228D0,100, 9, 4, 10, 4, 0,
49791 & 254,0.012D0,100, 9, 2, 10, 4, 0,
49792 & 254,0.012D0,100, 7, 4, 10, 4, 0,
49793 & 254,0.076D0,100, 10, 2, 7, 4, 0,
49794 & 254,0.076D0,100, 10, 4, 9, 4, 0,
49795 & 254,0.004D0,100, 10, 2, 9, 4, 0,
49796 & 254,0.004D0,100, 10, 4, 7, 4, 0,
49797 & 265,1.000D0, 0,221, 59, 0, 0, 0,
49798 & 266,1.000D0, 0,222, 59, 0, 0, 0,
49799 & 267,1.000D0, 0,223, 59, 0, 0, 0,
49800 & 268,0.667D0, 0,266, 38, 0, 0, 0,
49801 & 268,0.333D0, 0,265, 21, 0, 0, 0,
49802 & 269,0.667D0, 0,265, 30, 0, 0, 0,
49803 & 269,0.333D0, 0,266, 21, 0, 0, 0,
49804 & 270,0.500D0, 0,265, 50, 0, 0, 0,
49805 & 270,0.500D0, 0,266, 46, 0, 0, 0/
49806 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1692,1710)/
49807 & 271,0.290D0, 0,266, 38, 0, 0, 0,
49808 & 271,0.150D0, 0,265, 21, 0, 0, 0,
49809 & 271,0.290D0, 0,222, 38, 0, 0, 0,
49810 & 271,0.150D0, 0,221, 21, 0, 0, 0,
49811 & 271,0.060D0, 0,266, 38, 21, 0, 0,
49812 & 271,0.020D0, 0,265, 38, 30, 0, 0,
49813 & 271,0.010D0, 0,265, 21, 21, 0, 0,
49814 & 271,0.020D0, 0,222, 38, 21, 0, 0,
49815 & 271,0.010D0, 0,221, 38, 30, 0, 0,
49816 & 272,0.290D0, 0,265, 30, 0, 0, 0,
49817 & 272,0.150D0, 0,266, 21, 0, 0, 0,
49818 & 272,0.290D0, 0,221, 30, 0, 0, 0,
49819 & 272,0.150D0, 0,222, 21, 0, 0, 0,
49820 & 272,0.060D0, 0,265, 30, 21, 0, 0,
49821 & 272,0.020D0, 0,266, 38, 30, 0, 0,
49822 & 272,0.010D0, 0,266, 21, 21, 0, 0,
49823 & 272,0.020D0, 0,221, 30, 21, 0, 0,
49824 & 272,0.010D0, 0,222, 38, 30, 0, 0,
49825 & 273,0.350D0, 0,221, 50, 0, 0, 0/
49826 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1711,1729)/
49827 & 273,0.350D0, 0,222, 46, 0, 0, 0,
49828 & 273,0.150D0, 0,265, 50, 0, 0, 0,
49829 & 273,0.150D0, 0,266, 46, 0, 0, 0,
49830 & 274,1.000D0, 0,245, 59, 0, 0, 0,
49831 & 275,1.000D0, 0,246, 59, 0, 0, 0,
49832 & 276,1.000D0, 0,247, 59, 0, 0, 0,
49833 & 277,0.667D0, 0,275, 30, 0, 0, 0,
49834 & 277,0.333D0, 0,274, 21, 0, 0, 0,
49835 & 278,0.667D0, 0,274, 38, 0, 0, 0,
49836 & 278,0.333D0, 0,275, 21, 0, 0, 0,
49837 & 279,0.500D0, 0,274, 42, 0, 0, 0,
49838 & 279,0.500D0, 0,275, 34, 0, 0, 0,
49839 & 280,0.290D0, 0,275, 30, 0, 0, 0,
49840 & 280,0.150D0, 0,274, 21, 0, 0, 0,
49841 & 280,0.290D0, 0,246, 30, 0, 0, 0,
49842 & 280,0.150D0, 0,245, 21, 0, 0, 0,
49843 & 280,0.060D0, 0,275, 30, 21, 0, 0,
49844 & 280,0.020D0, 0,274, 38, 30, 0, 0,
49845 & 280,0.010D0, 0,274, 21, 21, 0, 0/
49846 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1730,1748)/
49847 & 280,0.020D0, 0,246, 30, 21, 0, 0,
49848 & 280,0.010D0, 0,245, 38, 30, 0, 0,
49849 & 281,0.290D0, 0,274, 38, 0, 0, 0,
49850 & 281,0.150D0, 0,275, 21, 0, 0, 0,
49851 & 281,0.290D0, 0,245, 38, 0, 0, 0,
49852 & 281,0.150D0, 0,246, 21, 0, 0, 0,
49853 & 281,0.060D0, 0,274, 38, 21, 0, 0,
49854 & 281,0.020D0, 0,275, 38, 30, 0, 0,
49855 & 281,0.010D0, 0,275, 21, 21, 0, 0,
49856 & 281,0.020D0, 0,245, 38, 21, 0, 0,
49857 & 281,0.010D0, 0,246, 38, 30, 0, 0,
49858 & 282,0.350D0, 0,245, 42, 0, 0, 0,
49859 & 282,0.350D0, 0,246, 34, 0, 0, 0,
49860 & 282,0.150D0, 0,274, 42, 0, 0, 0,
49861 & 282,0.150D0, 0,275, 34, 0, 0, 0,
49862 & 285,1.000D0, 0, 24, 21, 0, 0, 0,
49863 & 286,0.998D0, 0, 24, 38, 0, 0, 0,
49864 & 286,0.002D0, 0, 38, 59, 0, 0, 0,
49865 & 287,0.998D0, 0, 24, 30, 0, 0, 0/
49866 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1749,1767)/
49867 & 287,0.002D0, 0, 30, 59, 0, 0, 0,
49868 & 288,0.330D0, 0, 39, 30, 0, 0, 0,
49869 & 288,0.340D0, 0, 23, 21, 0, 0, 0,
49870 & 288,0.330D0, 0, 31, 38, 0, 0, 0,
49871 & 289,0.250D0, 0, 46, 35, 0, 0, 0,
49872 & 289,0.250D0, 0, 34, 47, 0, 0, 0,
49873 & 289,0.250D0, 0, 50, 43, 0, 0, 0,
49874 & 289,0.250D0, 0, 42, 51, 0, 0, 0,
49875 & 290,0.996D0, 0, 22, 21, 0, 0, 0,
49876 & 290,0.002D0, 0, 46, 34, 0, 0, 0,
49877 & 290,0.002D0, 0, 50, 42, 0, 0, 0,
49878 & 291,0.996D0, 0, 22, 38, 0, 0, 0,
49879 & 291,0.004D0, 0, 46, 42, 0, 0, 0,
49880 & 292,0.996D0, 0, 22, 30, 0, 0, 0,
49881 & 292,0.004D0, 0, 50, 34, 0, 0, 0,
49882 & 293,0.520D0, 0, 38, 30, 0, 0, 0,
49883 & 293,0.260D0, 0, 21, 21, 0, 0, 0,
49884 & 293,0.110D0, 0, 46, 34, 0, 0, 0,
49885 & 293,0.110D0, 0, 50, 42, 0, 0, 0/
49886 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1768,1786)/
49887 & 294,0.620D0, 0, 38, 30, 0, 0, 0,
49888 & 294,0.310D0, 0, 21, 21, 0, 0, 0,
49889 & 294,0.035D0, 0, 46, 34, 0, 0, 0,
49890 & 294,0.035D0, 0, 50, 42, 0, 0, 0,
49891 & 295,1.000D0, 0,254, 59, 0, 0, 0,
49892 & 296,1.000D0, 0,230, 59, 0, 0, 0,
49893 & 297,1.000D0, 0,254, 59, 0, 0, 0,
49894 & 298,1.000D0, 0,230, 59, 0, 0, 0,
49895 & 299,1.000D0, 0,254, 59, 0, 0, 0,
49896 & 300,1.000D0, 0,230, 59, 0, 0, 0,
49897 & 301,0.050D0, 0,121,127, 0, 0, 0,
49898 & 301,0.050D0, 0,123,129, 0, 0, 0,
49899 & 301,0.017D0, 0, 1, 7, 0, 0, 0,
49900 & 301,0.066D0, 0, 2, 8, 0, 0, 0,
49901 & 301,0.017D0, 0, 3, 9, 0, 0, 0,
49902 & 301,0.640D0,130, 13, 13, 13, 0, 0,
49903 & 301,0.160D0,130, 13, 13, 59, 0, 0,
49904 & 302,0.022D0, 0, 38, 30, 38, 30, 23,
49905 & 302,0.016D0, 0, 38, 30, 38, 30, 0/
49906 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1787,1805)/
49907 & 302,0.009D0, 0, 38, 30, 46, 34, 0,
49908 & 302,0.004D0, 0, 23, 38, 30, 0, 0,
49909 & 302,0.002D0, 0, 46, 43, 30, 0, 0,
49910 & 302,0.002D0, 0, 34, 51, 38, 0, 0,
49911 & 302,0.001D0, 0, 38, 30, 73, 91, 0,
49912 & 302,0.273D0, 0, 59,164, 0, 0, 0,
49913 & 302,0.671D0, 0, 13, 13, 0, 0, 0,
49914 & 303,0.022D0, 0, 38, 30, 38, 30, 0,
49915 & 303,0.019D0, 0, 38, 30, 46, 34, 0,
49916 & 303,0.012D0, 0, 38, 30, 38, 30, 23,
49917 & 303,0.007D0, 0, 23, 38, 30, 0, 0,
49918 & 303,0.002D0, 0, 46, 43, 30, 0, 0,
49919 & 303,0.002D0, 0, 34, 51, 38, 0, 0,
49920 & 303,0.003D0, 0, 38, 30, 73, 91, 0,
49921 & 303,0.002D0, 0, 38, 30, 0, 0, 0,
49922 & 303,0.002D0, 0, 46, 34, 0, 0, 0,
49923 & 303,0.001D0, 0, 21, 21, 0, 0, 0,
49924 & 303,0.135D0, 0, 59,164, 0, 0, 0,
49925 & 303,0.793D0, 0, 13, 13, 0, 0, 0/
49926 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1806,1824)/
49927 & 304,1.000D0, 0, 13, 13, 0, 0, 0,
49928 & 305,1.000D0, 0, 13, 13, 0, 0, 0,
49929 & 306,0.050D0, 0, 59,231, 0, 0, 0,
49930 & 306,0.950D0, 0, 13, 13, 0, 0, 0,
49931 & 307,0.350D0, 0, 59,231, 0, 0, 0,
49932 & 307,0.650D0, 0, 13, 13, 0, 0, 0,
49933 & 308,0.220D0, 0, 59,231, 0, 0, 0,
49934 & 308,0.780D0, 0, 13, 13, 0, 0, 0,
49935 & 309,0.280D0, 0, 46, 31, 0, 0, 0,
49936 & 309,0.140D0, 0, 50, 23, 0, 0, 0,
49937 & 309,0.187D0, 0,327, 30, 0, 0, 0,
49938 & 309,0.093D0, 0,328, 21, 0, 0, 0,
49939 & 309,0.110D0, 0, 50, 24, 0, 0, 0,
49940 & 309,0.107D0, 0, 47, 30, 0, 0, 0,
49941 & 309,0.053D0, 0, 51, 21, 0, 0, 0,
49942 & 309,0.030D0, 0, 50,293, 0, 0, 0,
49943 & 310,0.280D0, 0, 50, 39, 0, 0, 0,
49944 & 310,0.140D0, 0, 46, 23, 0, 0, 0,
49945 & 310,0.187D0, 0,328, 38, 0, 0, 0/
49946 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1825,1843)/
49947 & 310,0.093D0, 0,327, 21, 0, 0, 0,
49948 & 310,0.110D0, 0, 46, 24, 0, 0, 0,
49949 & 310,0.107D0, 0, 51, 38, 0, 0, 0,
49950 & 310,0.053D0, 0, 47, 21, 0, 0, 0,
49951 & 310,0.030D0, 0, 46,293, 0, 0, 0,
49952 & 311,0.280D0, 0, 34, 39, 0, 0, 0,
49953 & 311,0.140D0, 0, 42, 23, 0, 0, 0,
49954 & 311,0.187D0, 0,330, 38, 0, 0, 0,
49955 & 311,0.093D0, 0,329, 21, 0, 0, 0,
49956 & 311,0.110D0, 0, 42, 24, 0, 0, 0,
49957 & 311,0.107D0, 0, 35, 38, 0, 0, 0,
49958 & 311,0.053D0, 0, 43, 21, 0, 0, 0,
49959 & 311,0.030D0, 0, 42,293, 0, 0, 0,
49960 & 312,0.280D0, 0, 42, 31, 0, 0, 0,
49961 & 312,0.140D0, 0, 34, 23, 0, 0, 0,
49962 & 312,0.187D0, 0,329, 30, 0, 0, 0,
49963 & 312,0.093D0, 0,330, 21, 0, 0, 0,
49964 & 312,0.110D0, 0, 34, 24, 0, 0, 0,
49965 & 312,0.107D0, 0, 43, 30, 0, 0, 0/
49966 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1844,1862)/
49967 & 312,0.053D0, 0, 35, 21, 0, 0, 0,
49968 & 312,0.030D0, 0, 34,293, 0, 0, 0,
49969 & 313,0.430D0, 0,140, 38, 0, 0, 0,
49970 & 313,0.215D0, 0,136, 21, 0, 0, 0,
49971 & 313,0.235D0, 0,140, 38, 21, 0, 0,
49972 & 313,0.120D0, 0,136, 38, 30, 0, 0,
49973 & 314,0.430D0, 0,136, 30, 0, 0, 0,
49974 & 314,0.215D0, 0,140, 21, 0, 0, 0,
49975 & 314,0.235D0, 0,136, 30, 21, 0, 0,
49976 & 314,0.120D0, 0,140, 38, 30, 0, 0,
49977 & 315,0.480D0, 0,136, 50, 0, 0, 0,
49978 & 315,0.480D0, 0,140, 46, 0, 0, 0,
49979 & 315,0.040D0, 0,145, 59, 0, 0, 0,
49980 & 316,0.430D0, 0,175, 30, 0, 0, 0,
49981 & 316,0.215D0, 0,171, 21, 0, 0, 0,
49982 & 316,0.235D0, 0,175, 30, 21, 0, 0,
49983 & 316,0.120D0, 0,171, 38, 30, 0, 0,
49984 & 317,0.430D0, 0,171, 38, 0, 0, 0,
49985 & 317,0.215D0, 0,175, 21, 0, 0, 0/
49986 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1863,1881)/
49987 & 317,0.235D0, 0,171, 38, 21, 0, 0,
49988 & 317,0.120D0, 0,175, 38, 30, 0, 0,
49989 & 318,0.480D0, 0,171, 42, 0, 0, 0,
49990 & 318,0.480D0, 0,175, 34, 0, 0, 0,
49991 & 318,0.040D0, 0,180, 59, 0, 0, 0,
49992 & 319,0.540D0, 0,275, 30, 0, 0, 0,
49993 & 319,0.270D0, 0,274, 21, 0, 0, 0,
49994 & 319,0.030D0, 0,275, 30, 21, 0, 0,
49995 & 319,0.010D0, 0,274, 38, 30, 0, 0,
49996 & 319,0.010D0, 0,274, 21, 21, 0, 0,
49997 & 319,0.090D0, 0,246, 30, 21, 0, 0,
49998 & 319,0.030D0, 0,245, 38, 30, 0, 0,
49999 & 319,0.020D0, 0,245, 21, 21, 0, 0,
50000 & 320,0.540D0, 0,274, 38, 0, 0, 0,
50001 & 320,0.270D0, 0,275, 21, 0, 0, 0,
50002 & 320,0.030D0, 0,274, 38, 21, 0, 0,
50003 & 320,0.010D0, 0,275, 38, 30, 0, 0,
50004 & 320,0.010D0, 0,275, 21, 21, 0, 0,
50005 & 320,0.090D0, 0,245, 38, 21, 0, 0/
50006 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1882,1900)/
50007 & 320,0.030D0, 0,246, 38, 30, 0, 0,
50008 & 320,0.020D0, 0,246, 21, 21, 0, 0,
50009 & 321,0.500D0, 0,266, 46, 0, 0, 0,
50010 & 321,0.500D0, 0,265, 50, 0, 0, 0,
50011 & 322,1.000D0, 0,254, 59, 0, 0, 0,
50012 & 323,0.540D0, 0,266, 38, 0, 0, 0,
50013 & 323,0.270D0, 0,265, 21, 0, 0, 0,
50014 & 323,0.030D0, 0,266, 38, 21, 0, 0,
50015 & 323,0.010D0, 0,265, 38, 30, 0, 0,
50016 & 323,0.010D0, 0,265, 21, 21, 0, 0,
50017 & 323,0.090D0, 0,222, 38, 21, 0, 0,
50018 & 323,0.030D0, 0,221, 38, 30, 0, 0,
50019 & 323,0.020D0, 0,221, 21, 21, 0, 0,
50020 & 324,0.540D0, 0,265, 30, 0, 0, 0,
50021 & 324,0.270D0, 0,266, 21, 0, 0, 0,
50022 & 324,0.030D0, 0,265, 30, 21, 0, 0,
50023 & 324,0.010D0, 0,266, 38, 30, 0, 0,
50024 & 324,0.010D0, 0,266, 21, 21, 0, 0,
50025 & 324,0.090D0, 0,221, 30, 21, 0, 0/
50026 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1901,1919)/
50027 & 324,0.030D0, 0,222, 38, 30, 0, 0,
50028 & 324,0.020D0, 0,222, 21, 21, 0, 0,
50029 & 325,0.500D0, 0,275, 34, 0, 0, 0,
50030 & 325,0.500D0, 0,274, 42, 0, 0, 0,
50031 & 326,1.000D0, 0,230, 59, 0, 0, 0,
50032 & 327,0.667D0, 0, 50, 38, 0, 0, 0,
50033 & 327,0.333D0, 0, 46, 21, 0, 0, 0,
50034 & 328,0.667D0, 0, 46, 30, 0, 0, 0,
50035 & 328,0.333D0, 0, 50, 21, 0, 0, 0,
50036 & 329,0.667D0, 0, 34, 38, 0, 0, 0,
50037 & 329,0.333D0, 0, 42, 21, 0, 0, 0,
50038 & 330,0.667D0, 0, 42, 30, 0, 0, 0,
50039 & 330,0.333D0, 0, 34, 21, 0, 0, 0,
50040 & 331,0.667D0, 0,140, 38, 0, 0, 0,
50041 & 331,0.333D0, 0,136, 21, 0, 0, 0,
50042 & 332,0.667D0, 0,136, 30, 0, 0, 0,
50043 & 332,0.333D0, 0,140, 21, 0, 0, 0,
50044 & 333,0.500D0, 0,136, 50, 0, 0, 0,
50045 & 333,0.500D0, 0,140, 46, 0, 0, 0/
50046 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1920,1938)/
50047 & 334,0.667D0, 0,175, 30, 0, 0, 0,
50048 & 334,0.333D0, 0,171, 21, 0, 0, 0,
50049 & 335,0.667D0, 0,171, 38, 0, 0, 0,
50050 & 335,0.333D0, 0,175, 21, 0, 0, 0,
50051 & 336,0.500D0, 0,171, 42, 0, 0, 0,
50052 & 336,0.500D0, 0,175, 34, 0, 0, 0,
50053 & 337,0.667D0, 0,246, 30, 0, 0, 0,
50054 & 337,0.333D0, 0,245, 21, 0, 0, 0,
50055 & 338,0.667D0, 0,245, 38, 0, 0, 0,
50056 & 338,0.333D0, 0,246, 21, 0, 0, 0,
50057 & 339,0.500D0, 0,246, 34, 0, 0, 0,
50058 & 339,0.500D0, 0,245, 42, 0, 0, 0,
50059 & 340,1.000D0, 0,254, 59, 0, 0, 0,
50060 & 341,0.667D0, 0,222, 38, 0, 0, 0,
50061 & 341,0.333D0, 0,221, 21, 0, 0, 0,
50062 & 342,0.667D0, 0,221, 30, 0, 0, 0,
50063 & 342,0.333D0, 0,222, 21, 0, 0, 0,
50064 & 343,0.500D0, 0,222, 46, 0, 0, 0,
50065 & 343,0.500D0, 0,221, 50, 0, 0, 0/
50066 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1939,1957)/
50067 & 344,1.000D0, 0,230, 59, 0, 0, 0,
50068 & 345,1.000D0, 0,225, 30, 0, 0, 0,
50069 & 346,1.000D0, 0,225, 21, 0, 0, 0,
50070 & 347,1.000D0, 0,225, 21, 0, 0, 0,
50071 & 348,1.000D0, 0,225, 38, 0, 0, 0,
50072 & 349,0.600D0, 0,228, 38, 0, 0, 0,
50073 & 349,0.300D0, 0,227, 21, 0, 0, 0,
50074 & 349,0.100D0, 0,227, 59, 0, 0, 0,
50075 & 350,0.600D0, 0,228, 38, 0, 0, 0,
50076 & 350,0.300D0, 0,227, 21, 0, 0, 0,
50077 & 350,0.100D0, 0,227, 59, 0, 0, 0,
50078 & 351,0.600D0, 0,227, 30, 0, 0, 0,
50079 & 351,0.300D0, 0,228, 21, 0, 0, 0,
50080 & 351,0.100D0, 0,228, 59, 0, 0, 0,
50081 & 352,0.600D0, 0,227, 30, 0, 0, 0,
50082 & 352,0.300D0, 0,228, 21, 0, 0, 0,
50083 & 352,0.100D0, 0,228, 59, 0, 0, 0,
50084 & 353,1.000D0, 0,229, 59, 0, 0, 0,
50085 & 354,1.000D0, 0,249, 38, 0, 0, 0/
50086 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1958,1976)/
50087 & 355,1.000D0, 0,249, 21, 0, 0, 0,
50088 & 356,1.000D0, 0,249, 21, 0, 0, 0,
50089 & 357,1.000D0, 0,249, 30, 0, 0, 0,
50090 & 358,0.600D0, 0,252, 30, 0, 0, 0,
50091 & 358,0.300D0, 0,251, 21, 0, 0, 0,
50092 & 358,0.100D0, 0,251, 59, 0, 0, 0,
50093 & 359,0.600D0, 0,252, 30, 0, 0, 0,
50094 & 359,0.300D0, 0,251, 21, 0, 0, 0,
50095 & 359,0.100D0, 0,251, 59, 0, 0, 0,
50096 & 360,0.600D0, 0,251, 38, 0, 0, 0,
50097 & 360,0.300D0, 0,252, 21, 0, 0, 0,
50098 & 360,0.100D0, 0,252, 59, 0, 0, 0,
50099 & 361,0.600D0, 0,251, 38, 0, 0, 0,
50100 & 361,0.300D0, 0,252, 21, 0, 0, 0,
50101 & 361,0.100D0, 0,252, 59, 0, 0, 0,
50102 & 362,1.000D0, 0,253, 59, 0, 0, 0,
50103 & 363,0.400D0, 0, 53, 38, 0, 0, 0,
50104 & 363,0.200D0, 0, 49, 21, 0, 0, 0,
50105 & 363,0.100D0, 0, 51, 38, 0, 0, 0/
50106 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1977,1995)/
50107 & 363,0.050D0, 0, 47, 21, 0, 0, 0,
50108 & 363,0.150D0, 0, 46, 26, 0, 0, 0,
50109 & 363,0.050D0, 0, 46, 56, 0, 0, 0,
50110 & 363,0.050D0, 0, 46, 24, 0, 0, 0,
50111 & 364,0.400D0, 0, 49, 30, 0, 0, 0,
50112 & 364,0.200D0, 0, 53, 21, 0, 0, 0,
50113 & 364,0.100D0, 0, 47, 30, 0, 0, 0,
50114 & 364,0.050D0, 0, 51, 21, 0, 0, 0,
50115 & 364,0.150D0, 0, 50, 26, 0, 0, 0,
50116 & 364,0.050D0, 0, 50, 56, 0, 0, 0,
50117 & 364,0.050D0, 0, 50, 24, 0, 0, 0,
50118 & 365,0.400D0, 0, 37, 38, 0, 0, 0,
50119 & 365,0.200D0, 0, 45, 21, 0, 0, 0,
50120 & 365,0.100D0, 0, 35, 38, 0, 0, 0,
50121 & 365,0.050D0, 0, 43, 21, 0, 0, 0,
50122 & 365,0.150D0, 0, 42, 26, 0, 0, 0,
50123 & 365,0.050D0, 0, 42, 56, 0, 0, 0,
50124 & 365,0.050D0, 0, 42, 24, 0, 0, 0,
50125 & 366,0.400D0, 0, 45, 30, 0, 0, 0/
50126 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1996,2014)/
50127 & 366,0.200D0, 0, 37, 21, 0, 0, 0,
50128 & 366,0.100D0, 0, 43, 30, 0, 0, 0,
50129 & 366,0.050D0, 0, 35, 21, 0, 0, 0,
50130 & 366,0.150D0, 0, 34, 26, 0, 0, 0,
50131 & 366,0.050D0, 0, 34, 56, 0, 0, 0,
50132 & 366,0.050D0, 0, 34, 24, 0, 0, 0,
50133 & 367,0.258D0, 0, 50, 38, 0, 0, 0,
50134 & 367,0.129D0, 0, 46, 21, 0, 0, 0,
50135 & 367,0.209D0, 0, 50, 39, 0, 0, 0,
50136 & 367,0.105D0, 0, 46, 23, 0, 0, 0,
50137 & 367,0.199D0, 0, 51, 38, 0, 0, 0,
50138 & 367,0.100D0, 0, 47, 21, 0, 0, 0,
50139 & 368,0.258D0, 0, 46, 30, 0, 0, 0,
50140 & 368,0.129D0, 0, 50, 21, 0, 0, 0,
50141 & 368,0.209D0, 0, 46, 31, 0, 0, 0,
50142 & 368,0.105D0, 0, 50, 23, 0, 0, 0,
50143 & 368,0.199D0, 0, 47, 30, 0, 0, 0,
50144 & 368,0.100D0, 0, 51, 21, 0, 0, 0,
50145 & 369,0.258D0, 0, 34, 38, 0, 0, 0/
50146 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=2015,2033)/
50147 & 369,0.129D0, 0, 42, 21, 0, 0, 0,
50148 & 369,0.209D0, 0, 34, 39, 0, 0, 0,
50149 & 369,0.105D0, 0, 42, 23, 0, 0, 0,
50150 & 369,0.199D0, 0, 35, 38, 0, 0, 0,
50151 & 369,0.100D0, 0, 43, 21, 0, 0, 0,
50152 & 370,0.258D0, 0, 42, 30, 0, 0, 0,
50153 & 370,0.129D0, 0, 34, 21, 0, 0, 0,
50154 & 370,0.209D0, 0, 42, 31, 0, 0, 0,
50155 & 370,0.105D0, 0, 34, 23, 0, 0, 0,
50156 & 370,0.199D0, 0, 43, 30, 0, 0, 0,
50157 & 370,0.100D0, 0, 35, 21, 0, 0, 0,
50158 & 371,0.400D0, 0, 53, 38, 0, 0, 0,
50159 & 371,0.200D0, 0, 49, 21, 0, 0, 0,
50160 & 371,0.100D0, 0, 51, 38, 0, 0, 0,
50161 & 371,0.050D0, 0, 47, 21, 0, 0, 0,
50162 & 371,0.150D0, 0, 46, 26, 0, 0, 0,
50163 & 371,0.050D0, 0, 46, 56, 0, 0, 0,
50164 & 371,0.050D0, 0, 46, 24, 0, 0, 0,
50165 & 372,0.400D0, 0, 49, 30, 0, 0, 0/
50166 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=2034,2052)/
50167 & 372,0.200D0, 0, 53, 21, 0, 0, 0,
50168 & 372,0.100D0, 0, 47, 30, 0, 0, 0,
50169 & 372,0.050D0, 0, 51, 21, 0, 0, 0,
50170 & 372,0.150D0, 0, 50, 26, 0, 0, 0,
50171 & 372,0.050D0, 0, 50, 56, 0, 0, 0,
50172 & 372,0.050D0, 0, 50, 24, 0, 0, 0,
50173 & 373,0.400D0, 0, 37, 38, 0, 0, 0,
50174 & 373,0.200D0, 0, 45, 21, 0, 0, 0,
50175 & 373,0.100D0, 0, 35, 38, 0, 0, 0,
50176 & 373,0.050D0, 0, 43, 21, 0, 0, 0,
50177 & 373,0.150D0, 0, 42, 26, 0, 0, 0,
50178 & 373,0.050D0, 0, 42, 56, 0, 0, 0,
50179 & 373,0.050D0, 0, 42, 24, 0, 0, 0,
50180 & 374,0.400D0, 0, 45, 30, 0, 0, 0,
50181 & 374,0.200D0, 0, 37, 21, 0, 0, 0,
50182 & 374,0.100D0, 0, 43, 30, 0, 0, 0,
50183 & 374,0.050D0, 0, 35, 21, 0, 0, 0,
50184 & 374,0.150D0, 0, 34, 26, 0, 0, 0,
50185 & 374,0.050D0, 0, 34, 56, 0, 0, 0/
50186 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=2053,2071)/
50187 & 374,0.050D0, 0, 34, 24, 0, 0, 0,
50188 & 375,0.208D0, 0, 50, 39, 0, 0, 0,
50189 & 375,0.104D0, 0, 46, 23, 0, 0, 0,
50190 & 375,0.134D0, 0, 51, 38, 0, 0, 0,
50191 & 375,0.067D0, 0, 47, 21, 0, 0, 0,
50192 & 375,0.124D0, 0, 50, 38, 0, 0, 0,
50193 & 375,0.062D0, 0, 46, 21, 0, 0, 0,
50194 & 375,0.301D0, 0, 46, 22, 0, 0, 0,
50195 & 376,0.208D0, 0, 46, 31, 0, 0, 0,
50196 & 376,0.104D0, 0, 50, 23, 0, 0, 0,
50197 & 376,0.134D0, 0, 47, 30, 0, 0, 0,
50198 & 376,0.067D0, 0, 51, 21, 0, 0, 0,
50199 & 376,0.124D0, 0, 46, 30, 0, 0, 0,
50200 & 376,0.062D0, 0, 50, 21, 0, 0, 0,
50201 & 376,0.301D0, 0, 50, 22, 0, 0, 0,
50202 & 377,0.208D0, 0, 34, 39, 0, 0, 0,
50203 & 377,0.104D0, 0, 42, 23, 0, 0, 0,
50204 & 377,0.134D0, 0, 35, 38, 0, 0, 0,
50205 & 377,0.067D0, 0, 43, 21, 0, 0, 0/
50206 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=2072,2090)/
50207 & 377,0.124D0, 0, 34, 38, 0, 0, 0,
50208 & 377,0.062D0, 0, 42, 21, 0, 0, 0,
50209 & 377,0.301D0, 0, 42, 22, 0, 0, 0,
50210 & 378,0.208D0, 0, 42, 31, 0, 0, 0,
50211 & 378,0.104D0, 0, 34, 23, 0, 0, 0,
50212 & 378,0.134D0, 0, 43, 30, 0, 0, 0,
50213 & 378,0.067D0, 0, 35, 21, 0, 0, 0,
50214 & 378,0.124D0, 0, 42, 30, 0, 0, 0,
50215 & 378,0.062D0, 0, 34, 21, 0, 0, 0,
50216 & 378,0.301D0, 0, 34, 22, 0, 0, 0,
50217 & 379,0.562D0, 0, 26, 38, 0, 0, 0,
50218 & 379,0.155D0, 0, 39, 21, 0, 0, 0,
50219 & 379,0.155D0, 0, 23, 38, 0, 0, 0,
50220 & 379,0.088D0, 0,293, 38, 0, 0, 0,
50221 & 379,0.020D0, 0, 46, 43, 0, 0, 0,
50222 & 379,0.020D0, 0, 42, 47, 0, 0, 0,
50223 & 380,0.562D0, 0, 26, 21, 0, 0, 0,
50224 & 380,0.155D0, 0, 39, 30, 0, 0, 0,
50225 & 380,0.155D0, 0, 31, 38, 0, 0, 0/
50226 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=2091,2109)/
50227 & 380,0.088D0, 0,293, 21, 0, 0, 0,
50228 & 380,0.010D0, 0, 46, 35, 0, 0, 0,
50229 & 380,0.010D0, 0, 50, 43, 0, 0, 0,
50230 & 380,0.010D0, 0, 34, 47, 0, 0, 0,
50231 & 380,0.010D0, 0, 42, 51, 0, 0, 0,
50232 & 381,0.562D0, 0, 26, 30, 0, 0, 0,
50233 & 381,0.155D0, 0, 31, 21, 0, 0, 0,
50234 & 381,0.155D0, 0, 23, 30, 0, 0, 0,
50235 & 381,0.088D0, 0,293, 30, 0, 0, 0,
50236 & 381,0.020D0, 0, 34, 51, 0, 0, 0,
50237 & 381,0.020D0, 0, 50, 35, 0, 0, 0,
50238 & 382,0.360D0, 0, 31, 38, 38, 0, 0,
50239 & 382,0.180D0, 0, 23, 38, 21, 0, 0,
50240 & 382,0.040D0, 0, 39, 21, 21, 0, 0,
50241 & 382,0.020D0, 0, 39, 38, 30, 0, 0,
50242 & 382,0.300D0, 0, 38, 21, 0, 0, 0,
50243 & 382,0.040D0, 0, 46, 43, 0, 0, 0,
50244 & 382,0.040D0, 0, 42, 47, 0, 0, 0,
50245 & 382,0.020D0, 0, 22, 39, 0, 0, 0/
50246 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=2110,2128)/
50247 & 383,0.180D0, 0, 39, 30, 21, 0, 0,
50248 & 383,0.180D0, 0, 31, 38, 21, 0, 0,
50249 & 383,0.160D0, 0, 23, 21, 21, 0, 0,
50250 & 383,0.080D0, 0, 23, 38, 30, 0, 0,
50251 & 383,0.300D0, 0, 38, 30, 0, 0, 0,
50252 & 383,0.020D0, 0, 46, 35, 0, 0, 0,
50253 & 383,0.020D0, 0, 50, 43, 0, 0, 0,
50254 & 383,0.020D0, 0, 34, 47, 0, 0, 0,
50255 & 383,0.020D0, 0, 42, 51, 0, 0, 0,
50256 & 383,0.020D0, 0, 22, 23, 0, 0, 0,
50257 & 384,0.360D0, 0, 39, 30, 30, 0, 0,
50258 & 384,0.180D0, 0, 23, 30, 21, 0, 0,
50259 & 384,0.040D0, 0, 31, 21, 21, 0, 0,
50260 & 384,0.020D0, 0, 31, 30, 38, 0, 0,
50261 & 384,0.300D0, 0, 30, 21, 0, 0, 0,
50262 & 384,0.040D0, 0, 34, 51, 0, 0, 0,
50263 & 384,0.040D0, 0, 50, 35, 0, 0, 0,
50264 & 384,0.020D0, 0, 22, 31, 0, 0, 0,
50265 & 385,0.184D0, 0, 41, 21, 0, 0, 0/
50266 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=2129,2147)/
50267 & 385,0.184D0, 0, 29, 38, 0, 0, 0,
50268 & 385,0.184D0, 0, 39, 23, 0, 0, 0,
50269 & 385,0.236D0, 0, 38, 21, 0, 0, 0,
50270 & 385,0.160D0, 0, 24, 38, 0, 0, 0,
50271 & 385,0.018D0, 0, 46, 43, 0, 0, 0,
50272 & 385,0.018D0, 0, 42, 47, 0, 0, 0,
50273 & 385,0.016D0, 0, 46, 42, 0, 0, 0,
50274 & 386,0.184D0, 0, 41, 30, 0, 0, 0,
50275 & 386,0.184D0, 0, 33, 38, 0, 0, 0,
50276 & 386,0.184D0, 0, 39, 31, 0, 0, 0,
50277 & 386,0.236D0, 0, 38, 30, 0, 0, 0,
50278 & 386,0.160D0, 0, 24, 21, 0, 0, 0,
50279 & 386,0.009D0, 0, 46, 35, 0, 0, 0,
50280 & 386,0.009D0, 0, 50, 43, 0, 0, 0,
50281 & 386,0.009D0, 0, 34, 47, 0, 0, 0,
50282 & 386,0.009D0, 0, 42, 51, 0, 0, 0,
50283 & 386,0.008D0, 0, 46, 34, 0, 0, 0,
50284 & 386,0.008D0, 0, 42, 50, 0, 0, 0,
50285 & 387,0.184D0, 0, 33, 21, 0, 0, 0/
50286 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=2148,2166)/
50287 & 387,0.184D0, 0, 29, 30, 0, 0, 0,
50288 & 387,0.184D0, 0, 31, 23, 0, 0, 0,
50289 & 387,0.236D0, 0, 30, 21, 0, 0, 0,
50290 & 387,0.160D0, 0, 24, 30, 0, 0, 0,
50291 & 387,0.018D0, 0, 34, 51, 0, 0, 0,
50292 & 387,0.018D0, 0, 50, 35, 0, 0, 0,
50293 & 387,0.016D0, 0, 34, 50, 0, 0, 0,
50294 & 388,0.183D0, 0,231, 38, 30, 0, 0,
50295 & 388,0.091D0, 0,231, 21, 21, 0, 0,
50296 & 388,0.067D0, 0, 59,307, 0, 0, 0,
50297 & 388,0.066D0, 0, 59,308, 0, 0, 0,
50298 & 388,0.043D0, 0, 59,309, 0, 0, 0,
50299 & 388,0.446D0,130, 13, 13, 13, 0, 0,
50300 & 388,0.023D0,130, 13, 13, 59, 0, 0,
50301 & 388,0.013D0, 0,121,127, 0, 0, 0,
50302 & 388,0.013D0, 0,123,129, 0, 0, 0,
50303 & 388,0.013D0, 0,125,131, 0, 0, 0,
50304 & 388,0.004D0, 0, 1, 7, 0, 0, 0,
50305 & 388,0.017D0, 0, 2, 8, 0, 0, 0/
50306 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=2167,2185)/
50307 & 388,0.004D0, 0, 3, 9, 0, 0, 0,
50308 & 388,0.017D0, 0, 4, 10, 0, 0, 0,
50309 & 389,0.046D0, 0, 59,388, 0, 0, 0,
50310 & 389,0.009D0, 0, 59,231, 0, 0, 0,
50311 & 389,0.755D0, 0, 13, 13, 0, 0, 0,
50312 & 389,0.030D0, 0,121,127, 0, 0, 0,
50313 & 389,0.030D0, 0,123,129, 0, 0, 0,
50314 & 389,0.030D0, 0,125,131, 0, 0, 0,
50315 & 389,0.010D0, 0, 1, 7, 0, 0, 0,
50316 & 389,0.040D0, 0, 2, 8, 0, 0, 0,
50317 & 389,0.010D0, 0, 3, 9, 0, 0, 0,
50318 & 389,0.040D0, 0, 4, 10, 0, 0, 0,
50319 & 390,0.210D0, 0, 59,388, 0, 0, 0,
50320 & 390,0.085D0, 0, 59,231, 0, 0, 0,
50321 & 390,0.565D0, 0, 13, 13, 0, 0, 0,
50322 & 390,0.022D0, 0,121,127, 0, 0, 0,
50323 & 390,0.022D0, 0,123,129, 0, 0, 0,
50324 & 390,0.022D0, 0,125,131, 0, 0, 0,
50325 & 390,0.007D0, 0, 1, 7, 0, 0, 0/
50326 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=2186,2204)/
50327 & 390,0.030D0, 0, 2, 8, 0, 0, 0,
50328 & 390,0.007D0, 0, 3, 9, 0, 0, 0,
50329 & 390,0.030D0, 0, 4, 10, 0, 0, 0,
50330 & 391,0.162D0, 0, 59,388, 0, 0, 0,
50331 & 391,0.071D0, 0, 59,231, 0, 0, 0,
50332 & 391,0.615D0, 0, 13, 13, 0, 0, 0,
50333 & 391,0.024D0, 0,121,127, 0, 0, 0,
50334 & 391,0.024D0, 0,123,129, 0, 0, 0,
50335 & 391,0.024D0, 0,125,131, 0, 0, 0,
50336 & 391,0.008D0, 0, 1, 7, 0, 0, 0,
50337 & 391,0.032D0, 0, 2, 8, 0, 0, 0,
50338 & 391,0.008D0, 0, 3, 9, 0, 0, 0,
50339 & 391,0.032D0, 0, 4, 10, 0, 0, 0,
50340 & 392,0.034D0, 0,267, 38, 30, 0, 0,
50341 & 392,0.017D0, 0,267, 21, 21, 0, 0,
50342 & 392,0.044D0, 0,231, 38, 30, 0, 0,
50343 & 392,0.022D0, 0,231, 21, 21, 0, 0,
50344 & 392,0.050D0, 0,267, 59, 59, 0, 0,
50345 & 392,0.114D0, 0, 59,389, 0, 0, 0/
50346 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=2205,2223)/
50347 & 392,0.113D0, 0, 59,390, 0, 0, 0,
50348 & 392,0.054D0, 0, 59,391, 0, 0, 0,
50349 & 392,0.403D0,130, 13, 13, 13, 0, 0,
50350 & 392,0.021D0,130, 13, 13, 59, 0, 0,
50351 & 392,0.020D0, 0,121,127, 0, 0, 0,
50352 & 392,0.020D0, 0,123,129, 0, 0, 0,
50353 & 392,0.020D0, 0,125,131, 0, 0, 0,
50354 & 392,0.007D0, 0, 1, 7, 0, 0, 0,
50355 & 392,0.027D0, 0, 2, 8, 0, 0, 0,
50356 & 392,0.007D0, 0, 3, 9, 0, 0, 0,
50357 & 392,0.027D0, 0, 4, 10, 0, 0, 0,
50358 & 393,0.250D0, 0,246,222, 0, 0, 0,
50359 & 393,0.250D0, 0,245,221, 0, 0, 0,
50360 & 393,0.385D0,130, 13, 13, 13, 0, 0,
50361 & 393,0.020D0,130, 13, 13, 59, 0, 0,
50362 & 393,0.015D0, 0,121,127, 0, 0, 0,
50363 & 393,0.015D0, 0,123,129, 0, 0, 0,
50364 & 393,0.015D0, 0,125,131, 0, 0, 0,
50365 & 393,0.005D0, 0, 1, 7, 0, 0, 0/
50366 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=2224,2242)/
50367 & 393,0.020D0, 0, 2, 8, 0, 0, 0,
50368 & 393,0.005D0, 0, 3, 9, 0, 0, 0,
50369 & 393,0.020D0, 0, 4, 10, 0, 0, 0,
50370 & 395,0.195D0, 0, 39, 30, 0, 0, 0,
50371 & 395,0.195D0, 0, 23, 21, 0, 0, 0,
50372 & 395,0.195D0, 0, 31, 38, 0, 0, 0,
50373 & 395,0.105D0, 0,286, 30, 0, 0, 0,
50374 & 395,0.105D0, 0,285, 21, 0, 0, 0,
50375 & 395,0.105D0, 0,287, 38, 0, 0, 0,
50376 & 395,0.065D0, 0, 24, 38, 30, 0, 0,
50377 & 395,0.035D0, 0, 24, 21, 21, 0, 0,
50378 & 396,0.320D0, 0, 46, 34, 0, 0, 0,
50379 & 396,0.320D0, 0, 60, 61, 0, 0, 0,
50380 & 396,0.090D0, 0, 46, 35, 0, 0, 0,
50381 & 396,0.090D0, 0, 42, 51, 0, 0, 0,
50382 & 396,0.090D0, 0, 50, 43, 0, 0, 0,
50383 & 396,0.090D0, 0, 34, 47, 0, 0, 0,
50384 & 397,0.312D0, 0, 41, 30, 0, 0, 0,
50385 & 397,0.312D0, 0, 29, 21, 0, 0, 0/
50386 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=2243,2261)/
50387 & 397,0.312D0, 0, 33, 38, 0, 0, 0,
50388 & 397,0.016D0, 0, 46, 35, 0, 0, 0,
50389 & 397,0.016D0, 0, 42, 51, 0, 0, 0,
50390 & 397,0.016D0, 0, 50, 43, 0, 0, 0,
50391 & 397,0.016D0, 0, 34, 47, 0, 0, 0,
50392 & 398,0.805D0, 0, 26, 22, 0, 0, 0,
50393 & 398,0.065D0, 0, 41, 30, 0, 0, 0,
50394 & 398,0.065D0, 0, 29, 21, 0, 0, 0,
50395 & 398,0.065D0, 0, 33, 38, 0, 0, 0,
50396 & 399,0.667D0, 0, 24, 38, 30, 0, 0,
50397 & 399,0.333D0, 0, 24, 21, 21, 0, 0,
50398 & 62,0.440D0, 0, 21, 22, 0, 0, 0,
50399 & 62,0.160D0, 0, 21, 25, 0, 0, 0,
50400 & 62,0.200D0, 0, 50, 42, 0, 0, 0,
50401 & 62,0.200D0, 0, 46, 34, 0, 0, 0,
50402 & 63,0.440D0, 0, 38, 22, 0, 0, 0,
50403 & 63,0.160D0, 0, 38, 25, 0, 0, 0,
50404 & 63,0.400D0, 0, 46, 42, 0, 0, 0,
50405 & 64,0.440D0, 0, 30, 22, 0, 0, 0/
50406 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=2262,2263)/
50407 & 64,0.160D0, 0, 30, 25, 0, 0, 0,
50408 & 64,0.400D0, 0, 50, 34, 0, 0, 0/
50409 C--data for MRST98 LO PDF's
50410 DATA (FMRS(1,1,I, 1),I=1,49)/
50411 & 0.01518D0, 0.01868D0, 0.02298D0, 0.02594D0, 0.02828D0,
50412 & 0.03023D0, 0.03724D0, 0.04592D0, 0.05197D0, 0.05679D0,
50413 & 0.06085D0, 0.07576D0, 0.09547D0, 0.11035D0, 0.12307D0,
50414 & 0.13453D0, 0.15525D0, 0.18319D0, 0.22542D0, 0.26441D0,
50415 & 0.33553D0, 0.39881D0, 0.45451D0, 0.51363D0, 0.56120D0,
50416 & 0.59755D0, 0.62324D0, 0.63889D0, 0.64529D0, 0.64295D0,
50417 & 0.63335D0, 0.61691D0, 0.59464D0, 0.56748D0, 0.53621D0,
50418 & 0.50180D0, 0.46495D0, 0.42660D0, 0.38735D0, 0.34791D0,
50419 & 0.30888D0, 0.27105D0, 0.23455D0, 0.16807D0, 0.11197D0,
50420 & 0.06774D0, 0.03566D0, 0.00443D0, 0.00000D0/
50421 DATA (FMRS(1,1,I, 2),I=1,49)/
50422 & 0.01534D0, 0.01889D0, 0.02325D0, 0.02625D0, 0.02862D0,
50423 & 0.03061D0, 0.03771D0, 0.04653D0, 0.05268D0, 0.05757D0,
50424 & 0.06171D0, 0.07691D0, 0.09707D0, 0.11230D0, 0.12533D0,
50425 & 0.13708D0, 0.15827D0, 0.18678D0, 0.22968D0, 0.26907D0,
50426 & 0.34038D0, 0.40321D0, 0.45801D0, 0.51556D0, 0.56122D0,
50427 & 0.59551D0, 0.61905D0, 0.63261D0, 0.63699D0, 0.63286D0,
50428 & 0.62162D0, 0.60381D0, 0.58043D0, 0.55244D0, 0.52060D0,
50429 & 0.48591D0, 0.44902D0, 0.41090D0, 0.37213D0, 0.33332D0,
50430 & 0.29514D0, 0.25827D0, 0.22283D0, 0.15873D0, 0.10506D0,
50431 & 0.06310D0, 0.03294D0, 0.00399D0, 0.00000D0/
50432 DATA (FMRS(1,1,I, 3),I=1,49)/
50433 & 0.01559D0, 0.01920D0, 0.02365D0, 0.02672D0, 0.02914D0,
50434 & 0.03116D0, 0.03842D0, 0.04744D0, 0.05374D0, 0.05876D0,
50435 & 0.06301D0, 0.07866D0, 0.09949D0, 0.11525D0, 0.12874D0,
50436 & 0.14090D0, 0.16278D0, 0.19212D0, 0.23598D0, 0.27589D0,
50437 & 0.34735D0, 0.40941D0, 0.46279D0, 0.51792D0, 0.56073D0,
50438 & 0.59195D0, 0.61237D0, 0.62289D0, 0.62439D0, 0.61773D0,
50439 & 0.60419D0, 0.58448D0, 0.55962D0, 0.53052D0, 0.49799D0,
50440 & 0.46298D0, 0.42617D0, 0.38844D0, 0.35048D0, 0.31268D0,
50441 & 0.27573D0, 0.24031D0, 0.20643D0, 0.14575D0, 0.09554D0,
50442 & 0.05679D0, 0.02927D0, 0.00342D0, 0.00000D0/
50443 DATA (FMRS(1,1,I, 4),I=1,49)/
50444 & 0.01577D0, 0.01944D0, 0.02395D0, 0.02707D0, 0.02952D0,
50445 & 0.03158D0, 0.03895D0, 0.04812D0, 0.05453D0, 0.05964D0,
50446 & 0.06398D0, 0.07996D0, 0.10128D0, 0.11743D0, 0.13126D0,
50447 & 0.14371D0, 0.16610D0, 0.19602D0, 0.24052D0, 0.28078D0,
50448 & 0.35225D0, 0.41367D0, 0.46596D0, 0.51926D0, 0.56000D0,
50449 & 0.58897D0, 0.60716D0, 0.61554D0, 0.61505D0, 0.60661D0,
50450 & 0.59150D0, 0.57049D0, 0.54465D0, 0.51484D0, 0.48194D0,
50451 & 0.44680D0, 0.41012D0, 0.37271D0, 0.33536D0, 0.29833D0,
50452 & 0.26227D0, 0.22791D0, 0.19519D0, 0.13692D0, 0.08913D0,
50453 & 0.05257D0, 0.02685D0, 0.00306D0, 0.00000D0/
50454 DATA (FMRS(1,1,I, 5),I=1,49)/
50455 & 0.01597D0, 0.01969D0, 0.02427D0, 0.02744D0, 0.02993D0,
50456 & 0.03202D0, 0.03952D0, 0.04885D0, 0.05537D0, 0.06058D0,
50457 & 0.06501D0, 0.08134D0, 0.10319D0, 0.11975D0, 0.13393D0,
50458 & 0.14669D0, 0.16958D0, 0.20009D0, 0.24521D0, 0.28578D0,
50459 & 0.35715D0, 0.41781D0, 0.46887D0, 0.52022D0, 0.55877D0,
50460 & 0.58539D0, 0.60126D0, 0.60744D0, 0.60489D0, 0.59469D0,
50461 & 0.57807D0, 0.55581D0, 0.52903D0, 0.49861D0, 0.46535D0,
50462 & 0.43012D0, 0.39368D0, 0.35672D0, 0.32002D0, 0.28380D0,
50463 & 0.24878D0, 0.21549D0, 0.18398D0, 0.12819D0, 0.08284D0,
50464 & 0.04845D0, 0.02451D0, 0.00272D0, 0.00000D0/
50465 DATA (FMRS(1,1,I, 6),I=1,49)/
50466 & 0.01613D0, 0.01990D0, 0.02455D0, 0.02776D0, 0.03029D0,
50467 & 0.03241D0, 0.04001D0, 0.04949D0, 0.05611D0, 0.06141D0,
50468 & 0.06592D0, 0.08256D0, 0.10485D0, 0.12178D0, 0.13626D0,
50469 & 0.14927D0, 0.17260D0, 0.20361D0, 0.24924D0, 0.29005D0,
50470 & 0.36128D0, 0.42124D0, 0.47121D0, 0.52086D0, 0.55750D0,
50471 & 0.58213D0, 0.59603D0, 0.60035D0, 0.59612D0, 0.58445D0,
50472 & 0.56659D0, 0.54334D0, 0.51581D0, 0.48493D0, 0.45142D0,
50473 & 0.41618D0, 0.37998D0, 0.34345D0, 0.30732D0, 0.27182D0,
50474 & 0.23768D0, 0.20532D0, 0.17482D0, 0.12110D0, 0.07777D0,
50475 & 0.04515D0, 0.02267D0, 0.00245D0, 0.00000D0/
50476 DATA (FMRS(1,1,I, 7),I=1,49)/
50477 & 0.01630D0, 0.02011D0, 0.02482D0, 0.02807D0, 0.03063D0,
50478 & 0.03278D0, 0.04049D0, 0.05010D0, 0.05683D0, 0.06221D0,
50479 & 0.06680D0, 0.08373D0, 0.10647D0, 0.12373D0, 0.13849D0,
50480 & 0.15175D0, 0.17549D0, 0.20695D0, 0.25304D0, 0.29403D0,
50481 & 0.36506D0, 0.42430D0, 0.47319D0, 0.52118D0, 0.55597D0,
50482 & 0.57870D0, 0.59079D0, 0.59337D0, 0.58760D0, 0.57458D0,
50483 & 0.55556D0, 0.53145D0, 0.50329D0, 0.47196D0, 0.43832D0,
50484 & 0.40316D0, 0.36719D0, 0.33110D0, 0.29555D0, 0.26076D0,
50485 & 0.22742D0, 0.19600D0, 0.16642D0, 0.11467D0, 0.07318D0,
50486 & 0.04221D0, 0.02103D0, 0.00223D0, 0.00000D0/
50487 DATA (FMRS(1,1,I, 8),I=1,49)/
50488 & 0.01647D0, 0.02033D0, 0.02511D0, 0.02840D0, 0.03100D0,
50489 & 0.03318D0, 0.04101D0, 0.05076D0, 0.05760D0, 0.06307D0,
50490 & 0.06774D0, 0.08499D0, 0.10819D0, 0.12581D0, 0.14088D0,
50491 & 0.15440D0, 0.17856D0, 0.21047D0, 0.25702D0, 0.29817D0,
50492 & 0.36893D0, 0.42735D0, 0.47507D0, 0.52128D0, 0.55411D0,
50493 & 0.57487D0, 0.58505D0, 0.58586D0, 0.57850D0, 0.56412D0,
50494 & 0.54397D0, 0.51898D0, 0.49021D0, 0.45851D0, 0.42474D0,
50495 & 0.38970D0, 0.35404D0, 0.31842D0, 0.28351D0, 0.24949D0,
50496 & 0.21700D0, 0.18654D0, 0.15795D0, 0.10821D0, 0.06861D0,
50497 & 0.03930D0, 0.01942D0, 0.00201D0, 0.00000D0/
50498 DATA (FMRS(1,1,I, 9),I=1,49)/
50499 & 0.01662D0, 0.02053D0, 0.02536D0, 0.02869D0, 0.03133D0,
50500 & 0.03353D0, 0.04146D0, 0.05135D0, 0.05828D0, 0.06382D0,
50501 & 0.06856D0, 0.08610D0, 0.10971D0, 0.12764D0, 0.14296D0,
50502 & 0.15670D0, 0.18121D0, 0.21352D0, 0.26045D0, 0.30172D0,
50503 & 0.37220D0, 0.42986D0, 0.47655D0, 0.52120D0, 0.55234D0,
50504 & 0.57141D0, 0.57995D0, 0.57927D0, 0.57058D0, 0.55506D0,
50505 & 0.53402D0, 0.50830D0, 0.47904D0, 0.44709D0, 0.41323D0,
50506 & 0.37832D0, 0.34296D0, 0.30776D0, 0.27344D0, 0.24008D0,
50507 & 0.20833D0, 0.17868D0, 0.15093D0, 0.10287D0, 0.06487D0,
50508 & 0.03693D0, 0.01812D0, 0.00183D0, 0.00000D0/
50509 DATA (FMRS(1,1,I,10),I=1,49)/
50510 & 0.01676D0, 0.02072D0, 0.02560D0, 0.02898D0, 0.03164D0,
50511 & 0.03388D0, 0.04190D0, 0.05191D0, 0.05894D0, 0.06456D0,
50512 & 0.06937D0, 0.08718D0, 0.11117D0, 0.12940D0, 0.14497D0,
50513 & 0.15892D0, 0.18377D0, 0.21643D0, 0.26368D0, 0.30503D0,
50514 & 0.37520D0, 0.43209D0, 0.47774D0, 0.52089D0, 0.55041D0,
50515 & 0.56787D0, 0.57486D0, 0.57280D0, 0.56285D0, 0.54631D0,
50516 & 0.52442D0, 0.49810D0, 0.46842D0, 0.43624D0, 0.40236D0,
50517 & 0.36762D0, 0.33255D0, 0.29778D0, 0.26402D0, 0.23132D0,
50518 & 0.20029D0, 0.17139D0, 0.14445D0, 0.09798D0, 0.06147D0,
50519 & 0.03479D0, 0.01695D0, 0.00168D0, 0.00000D0/
50520 DATA (FMRS(1,1,I,11),I=1,49)/
50521 & 0.01688D0, 0.02087D0, 0.02580D0, 0.02920D0, 0.03189D0,
50522 & 0.03415D0, 0.04225D0, 0.05236D0, 0.05946D0, 0.06515D0,
50523 & 0.07001D0, 0.08804D0, 0.11234D0, 0.13081D0, 0.14657D0,
50524 & 0.16068D0, 0.18579D0, 0.21873D0, 0.26622D0, 0.30762D0,
50525 & 0.37751D0, 0.43378D0, 0.47859D0, 0.52054D0, 0.54880D0,
50526 & 0.56500D0, 0.57079D0, 0.56765D0, 0.55675D0, 0.53942D0,
50527 & 0.51689D0, 0.49012D0, 0.46015D0, 0.42782D0, 0.39393D0,
50528 & 0.35936D0, 0.32453D0, 0.29009D0, 0.25678D0, 0.22461D0,
50529 & 0.19416D0, 0.16583D0, 0.13951D0, 0.09427D0, 0.05892D0,
50530 & 0.03318D0, 0.01609D0, 0.00157D0, 0.00000D0/
50531 DATA (FMRS(1,1,I,12),I=1,49)/
50532 & 0.01713D0, 0.02119D0, 0.02622D0, 0.02969D0, 0.03243D0,
50533 & 0.03474D0, 0.04300D0, 0.05334D0, 0.06060D0, 0.06641D0,
50534 & 0.07140D0, 0.08989D0, 0.11485D0, 0.13381D0, 0.14997D0,
50535 & 0.16442D0, 0.19008D0, 0.22357D0, 0.27152D0, 0.31299D0,
50536 & 0.38219D0, 0.43708D0, 0.48008D0, 0.51946D0, 0.54505D0,
50537 & 0.55859D0, 0.56192D0, 0.55654D0, 0.54370D0, 0.52483D0,
50538 & 0.50100D0, 0.47335D0, 0.44283D0, 0.41025D0, 0.37649D0,
50539 & 0.34225D0, 0.30799D0, 0.27433D0, 0.24202D0, 0.21092D0,
50540 & 0.18167D0, 0.15459D0, 0.12954D0, 0.08683D0, 0.05380D0,
50541 & 0.03001D0, 0.01438D0, 0.00136D0, 0.00000D0/
50542 DATA (FMRS(1,1,I,13),I=1,49)/
50543 & 0.01734D0, 0.02147D0, 0.02658D0, 0.03011D0, 0.03290D0,
50544 & 0.03525D0, 0.04366D0, 0.05419D0, 0.06158D0, 0.06752D0,
50545 & 0.07261D0, 0.09150D0, 0.11703D0, 0.13641D0, 0.15292D0,
50546 & 0.16765D0, 0.19375D0, 0.22769D0, 0.27599D0, 0.31747D0,
50547 & 0.38599D0, 0.43964D0, 0.48105D0, 0.51822D0, 0.54152D0,
50548 & 0.55284D0, 0.55412D0, 0.54689D0, 0.53251D0, 0.51240D0,
50549 & 0.48756D0, 0.45925D0, 0.42833D0, 0.39563D0, 0.36202D0,
50550 & 0.32809D0, 0.29438D0, 0.26143D0, 0.22998D0, 0.19977D0,
50551 & 0.17155D0, 0.14553D0, 0.12155D0, 0.08091D0, 0.04976D0,
50552 & 0.02753D0, 0.01306D0, 0.00120D0, 0.00000D0/
50553 DATA (FMRS(1,1,I,14),I=1,49)/
50554 & 0.01759D0, 0.02179D0, 0.02699D0, 0.03059D0, 0.03343D0,
50555 & 0.03582D0, 0.04441D0, 0.05515D0, 0.06270D0, 0.06876D0,
50556 & 0.07397D0, 0.09331D0, 0.11948D0, 0.13933D0, 0.15621D0,
50557 & 0.17125D0, 0.19782D0, 0.23224D0, 0.28086D0, 0.32228D0,
50558 & 0.38998D0, 0.44216D0, 0.48181D0, 0.51649D0, 0.53727D0,
50559 & 0.54619D0, 0.54525D0, 0.53606D0, 0.52007D0, 0.49864D0,
50560 & 0.47286D0, 0.44390D0, 0.41261D0, 0.37987D0, 0.34645D0,
50561 & 0.31295D0, 0.27985D0, 0.24773D0, 0.21718D0, 0.18802D0,
50562 & 0.16091D0, 0.13605D0, 0.11323D0, 0.07479D0, 0.04562D0,
50563 & 0.02500D0, 0.01174D0, 0.00105D0, 0.00000D0/
50564 DATA (FMRS(1,1,I,15),I=1,49)/
50565 & 0.01784D0, 0.02212D0, 0.02742D0, 0.03109D0, 0.03399D0,
50566 & 0.03643D0, 0.04519D0, 0.05616D0, 0.06388D0, 0.07007D0,
50567 & 0.07541D0, 0.09522D0, 0.12203D0, 0.14235D0, 0.15961D0,
50568 & 0.17496D0, 0.20199D0, 0.23684D0, 0.28574D0, 0.32703D0,
50569 & 0.39374D0, 0.44435D0, 0.48208D0, 0.51422D0, 0.53243D0,
50570 & 0.53888D0, 0.53581D0, 0.52470D0, 0.50714D0, 0.48444D0,
50571 & 0.45778D0, 0.42824D0, 0.39670D0, 0.36400D0, 0.33079D0,
50572 & 0.29784D0, 0.26546D0, 0.23422D0, 0.20462D0, 0.17657D0,
50573 & 0.15056D0, 0.12684D0, 0.10517D0, 0.06893D0, 0.04169D0,
50574 & 0.02264D0, 0.01051D0, 0.00091D0, 0.00000D0/
50575 DATA (FMRS(1,1,I,16),I=1,49)/
50576 & 0.01807D0, 0.02243D0, 0.02782D0, 0.03155D0, 0.03450D0,
50577 & 0.03698D0, 0.04591D0, 0.05708D0, 0.06495D0, 0.07127D0,
50578 & 0.07672D0, 0.09696D0, 0.12435D0, 0.14510D0, 0.16268D0,
50579 & 0.17830D0, 0.20573D0, 0.24094D0, 0.29002D0, 0.33115D0,
50580 & 0.39689D0, 0.44603D0, 0.48202D0, 0.51185D0, 0.52778D0,
50581 & 0.53213D0, 0.52713D0, 0.51440D0, 0.49550D0, 0.47182D0,
50582 & 0.44444D0, 0.41444D0, 0.38277D0, 0.35014D0, 0.31726D0,
50583 & 0.28479D0, 0.25306D0, 0.22258D0, 0.19389D0, 0.16682D0,
50584 & 0.14175D0, 0.11905D0, 0.09839D0, 0.06403D0, 0.03844D0,
50585 & 0.02069D0, 0.00951D0, 0.00080D0, 0.00000D0/
50586 DATA (FMRS(1,1,I,17),I=1,49)/
50587 & 0.01831D0, 0.02273D0, 0.02822D0, 0.03202D0, 0.03502D0,
50588 & 0.03755D0, 0.04663D0, 0.05802D0, 0.06604D0, 0.07249D0,
50589 & 0.07805D0, 0.09872D0, 0.12670D0, 0.14787D0, 0.16578D0,
50590 & 0.18165D0, 0.20947D0, 0.24500D0, 0.29423D0, 0.33515D0,
50591 & 0.39986D0, 0.44747D0, 0.48171D0, 0.50924D0, 0.52291D0,
50592 & 0.52522D0, 0.51836D0, 0.50409D0, 0.48395D0, 0.45934D0,
50593 & 0.43132D0, 0.40095D0, 0.36919D0, 0.33668D0, 0.30419D0,
50594 & 0.27223D0, 0.24118D0, 0.21147D0, 0.18368D0, 0.15756D0,
50595 & 0.13343D0, 0.11172D0, 0.09203D0, 0.05947D0, 0.03543D0,
50596 & 0.01891D0, 0.00861D0, 0.00070D0, 0.00000D0/
50597 DATA (FMRS(1,1,I,18),I=1,49)/
50598 & 0.01851D0, 0.02299D0, 0.02855D0, 0.03241D0, 0.03546D0,
50599 & 0.03802D0, 0.04724D0, 0.05881D0, 0.06696D0, 0.07351D0,
50600 & 0.07917D0, 0.10019D0, 0.12865D0, 0.15015D0, 0.16833D0,
50601 & 0.18440D0, 0.21252D0, 0.24831D0, 0.29761D0, 0.33832D0,
50602 & 0.40212D0, 0.44845D0, 0.48121D0, 0.50687D0, 0.51871D0,
50603 & 0.51934D0, 0.51104D0, 0.49556D0, 0.47446D0, 0.44911D0,
50604 & 0.42066D0, 0.39005D0, 0.35822D0, 0.32587D0, 0.29370D0,
50605 & 0.26224D0, 0.23174D0, 0.20270D0, 0.17561D0, 0.15023D0,
50606 & 0.12693D0, 0.10599D0, 0.08707D0, 0.05595D0, 0.03312D0,
50607 & 0.01756D0, 0.00793D0, 0.00063D0, 0.00000D0/
50608 DATA (FMRS(1,1,I,19),I=1,49)/
50609 & 0.01875D0, 0.02330D0, 0.02896D0, 0.03288D0, 0.03599D0,
50610 & 0.03859D0, 0.04798D0, 0.05977D0, 0.06807D0, 0.07475D0,
50611 & 0.08052D0, 0.10198D0, 0.13101D0, 0.15292D0, 0.17139D0,
50612 & 0.18771D0, 0.21617D0, 0.25222D0, 0.30155D0, 0.34198D0,
50613 & 0.40461D0, 0.44935D0, 0.48033D0, 0.50374D0, 0.51343D0,
50614 & 0.51210D0, 0.50212D0, 0.48526D0, 0.46307D0, 0.43693D0,
50615 & 0.40797D0, 0.37715D0, 0.34533D0, 0.31321D0, 0.28148D0,
50616 & 0.25058D0, 0.22080D0, 0.19255D0, 0.16635D0, 0.14187D0,
50617 & 0.11948D0, 0.09946D0, 0.08142D0, 0.05198D0, 0.03054D0,
50618 & 0.01606D0, 0.00718D0, 0.00056D0, 0.00000D0/
50619 DATA (FMRS(1,1,I,20),I=1,49)/
50620 & 0.01896D0, 0.02358D0, 0.02932D0, 0.03331D0, 0.03646D0,
50621 & 0.03911D0, 0.04864D0, 0.06062D0, 0.06906D0, 0.07585D0,
50622 & 0.08173D0, 0.10357D0, 0.13310D0, 0.15536D0, 0.17410D0,
50623 & 0.19062D0, 0.21937D0, 0.25563D0, 0.30495D0, 0.34510D0,
50624 & 0.40666D0, 0.44998D0, 0.47941D0, 0.50085D0, 0.50868D0,
50625 & 0.50571D0, 0.49430D0, 0.47628D0, 0.45320D0, 0.42642D0,
50626 & 0.39707D0, 0.36611D0, 0.33435D0, 0.30245D0, 0.27113D0,
50627 & 0.24074D0, 0.21159D0, 0.18404D0, 0.15862D0, 0.13491D0,
50628 & 0.11330D0, 0.09405D0, 0.07676D0, 0.04872D0, 0.02844D0,
50629 & 0.01484D0, 0.00658D0, 0.00050D0, 0.00000D0/
50630 DATA (FMRS(1,1,I,21),I=1,49)/
50631 & 0.01916D0, 0.02384D0, 0.02966D0, 0.03370D0, 0.03689D0,
50632 & 0.03958D0, 0.04926D0, 0.06141D0, 0.06998D0, 0.07687D0,
50633 & 0.08284D0, 0.10503D0, 0.13502D0, 0.15758D0, 0.17655D0,
50634 & 0.19325D0, 0.22223D0, 0.25866D0, 0.30794D0, 0.34779D0,
50635 & 0.40831D0, 0.45032D0, 0.47832D0, 0.49795D0, 0.50413D0,
50636 & 0.49968D0, 0.48705D0, 0.46802D0, 0.44417D0, 0.41690D0,
50637 & 0.38723D0, 0.35619D0, 0.32452D0, 0.29287D0, 0.26194D0,
50638 & 0.23205D0, 0.20344D0, 0.17655D0, 0.15180D0, 0.12880D0,
50639 & 0.10792D0, 0.08934D0, 0.07273D0, 0.04591D0, 0.02665D0,
50640 & 0.01381D0, 0.00607D0, 0.00045D0, 0.00000D0/
50641 DATA (FMRS(1,1,I,22),I=1,49)/
50642 & 0.01941D0, 0.02417D0, 0.03009D0, 0.03420D0, 0.03745D0,
50643 & 0.04018D0, 0.05003D0, 0.06241D0, 0.07114D0, 0.07817D0,
50644 & 0.08426D0, 0.10688D0, 0.13744D0, 0.16039D0, 0.17965D0,
50645 & 0.19656D0, 0.22582D0, 0.26244D0, 0.31163D0, 0.35107D0,
50646 & 0.41025D0, 0.45056D0, 0.47676D0, 0.49416D0, 0.49829D0,
50647 & 0.49204D0, 0.47792D0, 0.45768D0, 0.43295D0, 0.40511D0,
50648 & 0.37512D0, 0.34401D0, 0.31250D0, 0.28120D0, 0.25076D0,
50649 & 0.22150D0, 0.19361D0, 0.16754D0, 0.14361D0, 0.12149D0,
50650 & 0.10149D0, 0.08376D0, 0.06796D0, 0.04260D0, 0.02455D0,
50651 & 0.01262D0, 0.00549D0, 0.00039D0, 0.00000D0/
50652 DATA (FMRS(1,1,I,23),I=1,49)/
50653 & 0.01965D0, 0.02448D0, 0.03049D0, 0.03467D0, 0.03797D0,
50654 & 0.04075D0, 0.05077D0, 0.06336D0, 0.07225D0, 0.07940D0,
50655 & 0.08560D0, 0.10863D0, 0.13972D0, 0.16302D0, 0.18254D0,
50656 & 0.19964D0, 0.22916D0, 0.26592D0, 0.31498D0, 0.35400D0,
50657 & 0.41189D0, 0.45060D0, 0.47511D0, 0.49045D0, 0.49274D0,
50658 & 0.48487D0, 0.46938D0, 0.44808D0, 0.42260D0, 0.39428D0,
50659 & 0.36409D0, 0.33294D0, 0.30164D0, 0.27069D0, 0.24070D0,
50660 & 0.21203D0, 0.18488D0, 0.15951D0, 0.13633D0, 0.11502D0,
50661 & 0.09581D0, 0.07887D0, 0.06380D0, 0.03974D0, 0.02273D0,
50662 & 0.01159D0, 0.00500D0, 0.00035D0, 0.00000D0/
50663 DATA (FMRS(1,1,I,24),I=1,49)/
50664 & 0.01987D0, 0.02478D0, 0.03088D0, 0.03511D0, 0.03847D0,
50665 & 0.04129D0, 0.05147D0, 0.06426D0, 0.07329D0, 0.08055D0,
50666 & 0.08686D0, 0.11027D0, 0.14184D0, 0.16546D0, 0.18521D0,
50667 & 0.20248D0, 0.23220D0, 0.26906D0, 0.31795D0, 0.35654D0,
50668 & 0.41317D0, 0.45035D0, 0.47330D0, 0.48677D0, 0.48734D0,
50669 & 0.47799D0, 0.46135D0, 0.43917D0, 0.41301D0, 0.38430D0,
50670 & 0.35392D0, 0.32282D0, 0.29171D0, 0.26113D0, 0.23164D0,
50671 & 0.20355D0, 0.17701D0, 0.15231D0, 0.12990D0, 0.10928D0,
50672 & 0.09079D0, 0.07455D0, 0.06012D0, 0.03723D0, 0.02116D0,
50673 & 0.01072D0, 0.00459D0, 0.00031D0, 0.00000D0/
50674 DATA (FMRS(1,1,I,25),I=1,49)/
50675 & 0.02010D0, 0.02507D0, 0.03126D0, 0.03556D0, 0.03897D0,
50676 & 0.04183D0, 0.05216D0, 0.06515D0, 0.07433D0, 0.08171D0,
50677 & 0.08812D0, 0.11191D0, 0.14397D0, 0.16790D0, 0.18786D0,
50678 & 0.20530D0, 0.23522D0, 0.27216D0, 0.32085D0, 0.35900D0,
50679 & 0.41434D0, 0.45001D0, 0.47142D0, 0.48304D0, 0.48197D0,
50680 & 0.47120D0, 0.45346D0, 0.43043D0, 0.40367D0, 0.37460D0,
50681 & 0.34407D0, 0.31306D0, 0.28215D0, 0.25197D0, 0.22296D0,
50682 & 0.19546D0, 0.16953D0, 0.14549D0, 0.12381D0, 0.10387D0,
50683 & 0.08608D0, 0.07049D0, 0.05669D0, 0.03490D0, 0.01971D0,
50684 & 0.00991D0, 0.00421D0, 0.00028D0, 0.00000D0/
50685 DATA (FMRS(1,1,I,26),I=1,49)/
50686 & 0.02032D0, 0.02536D0, 0.03164D0, 0.03600D0, 0.03946D0,
50687 & 0.04236D0, 0.05285D0, 0.06604D0, 0.07535D0, 0.08285D0,
50688 & 0.08936D0, 0.11352D0, 0.14603D0, 0.17026D0, 0.19043D0,
50689 & 0.20801D0, 0.23810D0, 0.27509D0, 0.32355D0, 0.36123D0,
50690 & 0.41527D0, 0.44945D0, 0.46936D0, 0.47919D0, 0.47657D0,
50691 & 0.46453D0, 0.44572D0, 0.42188D0, 0.39463D0, 0.36526D0,
50692 & 0.33462D0, 0.30373D0, 0.27307D0, 0.24328D0, 0.21472D0,
50693 & 0.18782D0, 0.16253D0, 0.13914D0, 0.11811D0, 0.09886D0,
50694 & 0.08171D0, 0.06673D0, 0.05353D0, 0.03277D0, 0.01840D0,
50695 & 0.00919D0, 0.00387D0, 0.00025D0, 0.00000D0/
50696 DATA (FMRS(1,1,I,27),I=1,49)/
50697 & 0.02054D0, 0.02564D0, 0.03200D0, 0.03642D0, 0.03992D0,
50698 & 0.04287D0, 0.05350D0, 0.06688D0, 0.07633D0, 0.08394D0,
50699 & 0.09053D0, 0.11504D0, 0.14798D0, 0.17249D0, 0.19284D0,
50700 & 0.21055D0, 0.24079D0, 0.27781D0, 0.32602D0, 0.36325D0,
50701 & 0.41604D0, 0.44883D0, 0.46732D0, 0.47551D0, 0.47145D0,
50702 & 0.45823D0, 0.43846D0, 0.41392D0, 0.38625D0, 0.35664D0,
50703 & 0.32595D0, 0.29518D0, 0.26477D0, 0.23536D0, 0.20725D0,
50704 & 0.18088D0, 0.15618D0, 0.13340D0, 0.11297D0, 0.09435D0,
50705 & 0.07779D0, 0.06337D0, 0.05071D0, 0.03088D0, 0.01724D0,
50706 & 0.00855D0, 0.00357D0, 0.00023D0, 0.00000D0/
50707 DATA (FMRS(1,1,I,28),I=1,49)/
50708 & 0.02074D0, 0.02591D0, 0.03234D0, 0.03682D0, 0.04037D0,
50709 & 0.04335D0, 0.05412D0, 0.06768D0, 0.07725D0, 0.08496D0,
50710 & 0.09165D0, 0.11648D0, 0.14982D0, 0.17457D0, 0.19509D0,
50711 & 0.21292D0, 0.24327D0, 0.28031D0, 0.32827D0, 0.36504D0,
50712 & 0.41665D0, 0.44811D0, 0.46527D0, 0.47196D0, 0.46656D0,
50713 & 0.45228D0, 0.43165D0, 0.40650D0, 0.37846D0, 0.34867D0,
50714 & 0.31800D0, 0.28733D0, 0.25718D0, 0.22812D0, 0.20048D0,
50715 & 0.17458D0, 0.15043D0, 0.12823D0, 0.10834D0, 0.09029D0,
50716 & 0.07427D0, 0.06037D0, 0.04820D0, 0.02920D0, 0.01621D0,
50717 & 0.00800D0, 0.00332D0, 0.00021D0, 0.00000D0/
50718 DATA (FMRS(1,1,I,29),I=1,49)/
50719 & 0.02094D0, 0.02617D0, 0.03269D0, 0.03722D0, 0.04081D0,
50720 & 0.04383D0, 0.05475D0, 0.06848D0, 0.07818D0, 0.08599D0,
50721 & 0.09277D0, 0.11792D0, 0.15165D0, 0.17664D0, 0.19733D0,
50722 & 0.21527D0, 0.24574D0, 0.28277D0, 0.33045D0, 0.36674D0,
50723 & 0.41715D0, 0.44728D0, 0.46313D0, 0.46834D0, 0.46164D0,
50724 & 0.44631D0, 0.42488D0, 0.39917D0, 0.37077D0, 0.34082D0,
50725 & 0.31017D0, 0.27964D0, 0.24978D0, 0.22107D0, 0.19390D0,
50726 & 0.16849D0, 0.14488D0, 0.12325D0, 0.10390D0, 0.08640D0,
50727 & 0.07092D0, 0.05751D0, 0.04581D0, 0.02761D0, 0.01524D0,
50728 & 0.00748D0, 0.00308D0, 0.00019D0, 0.00000D0/
50729 DATA (FMRS(1,1,I,30),I=1,49)/
50730 & 0.02115D0, 0.02644D0, 0.03303D0, 0.03762D0, 0.04125D0,
50731 & 0.04431D0, 0.05536D0, 0.06927D0, 0.07910D0, 0.08701D0,
50732 & 0.09387D0, 0.11934D0, 0.15345D0, 0.17867D0, 0.19951D0,
50733 & 0.21755D0, 0.24811D0, 0.28512D0, 0.33251D0, 0.36831D0,
50734 & 0.41752D0, 0.44634D0, 0.46092D0, 0.46470D0, 0.45678D0,
50735 & 0.44042D0, 0.41827D0, 0.39206D0, 0.36329D0, 0.33323D0,
50736 & 0.30260D0, 0.27226D0, 0.24270D0, 0.21435D0, 0.18761D0,
50737 & 0.16271D0, 0.13963D0, 0.11853D0, 0.09974D0, 0.08276D0,
50738 & 0.06777D0, 0.05484D0, 0.04358D0, 0.02615D0, 0.01436D0,
50739 & 0.00700D0, 0.00286D0, 0.00017D0, 0.00000D0/
50740 DATA (FMRS(1,1,I,31),I=1,49)/
50741 & 0.02134D0, 0.02669D0, 0.03336D0, 0.03800D0, 0.04168D0,
50742 & 0.04477D0, 0.05595D0, 0.07003D0, 0.07997D0, 0.08798D0,
50743 & 0.09492D0, 0.12069D0, 0.15515D0, 0.18059D0, 0.20157D0,
50744 & 0.21970D0, 0.25034D0, 0.28732D0, 0.33440D0, 0.36974D0,
50745 & 0.41780D0, 0.44538D0, 0.45878D0, 0.46121D0, 0.45216D0,
50746 & 0.43488D0, 0.41206D0, 0.38539D0, 0.35634D0, 0.32619D0,
50747 & 0.29560D0, 0.26544D0, 0.23618D0, 0.20818D0, 0.18185D0,
50748 & 0.15743D0, 0.13483D0, 0.11423D0, 0.09594D0, 0.07945D0,
50749 & 0.06492D0, 0.05243D0, 0.04157D0, 0.02483D0, 0.01357D0,
50750 & 0.00658D0, 0.00267D0, 0.00016D0, 0.00000D0/
50751 DATA (FMRS(1,1,I,32),I=1,49)/
50752 & 0.02153D0, 0.02693D0, 0.03367D0, 0.03836D0, 0.04208D0,
50753 & 0.04521D0, 0.05651D0, 0.07075D0, 0.08080D0, 0.08890D0,
50754 & 0.09592D0, 0.12197D0, 0.15676D0, 0.18239D0, 0.20349D0,
50755 & 0.22170D0, 0.25240D0, 0.28933D0, 0.33609D0, 0.37098D0,
50756 & 0.41793D0, 0.44434D0, 0.45663D0, 0.45780D0, 0.44772D0,
50757 & 0.42965D0, 0.40618D0, 0.37910D0, 0.34986D0, 0.31963D0,
50758 & 0.28912D0, 0.25913D0, 0.23015D0, 0.20249D0, 0.17658D0,
50759 & 0.15257D0, 0.13044D0, 0.11030D0, 0.09247D0, 0.07643D0,
50760 & 0.06234D0, 0.05026D0, 0.03976D0, 0.02365D0, 0.01287D0,
50761 & 0.00620D0, 0.00250D0, 0.00014D0, 0.00000D0/
50762 DATA (FMRS(1,1,I,33),I=1,49)/
50763 & 0.02171D0, 0.02717D0, 0.03398D0, 0.03872D0, 0.04248D0,
50764 & 0.04565D0, 0.05708D0, 0.07147D0, 0.08164D0, 0.08983D0,
50765 & 0.09693D0, 0.12326D0, 0.15838D0, 0.18421D0, 0.20543D0,
50766 & 0.22371D0, 0.25448D0, 0.29136D0, 0.33779D0, 0.37222D0,
50767 & 0.41806D0, 0.44331D0, 0.45449D0, 0.45441D0, 0.44330D0,
50768 & 0.42446D0, 0.40038D0, 0.37291D0, 0.34349D0, 0.31319D0,
50769 & 0.28277D0, 0.25295D0, 0.22427D0, 0.19695D0, 0.17145D0,
50770 & 0.14785D0, 0.12618D0, 0.10650D0, 0.08912D0, 0.07353D0,
50771 & 0.05986D0, 0.04817D0, 0.03803D0, 0.02252D0, 0.01220D0,
50772 & 0.00585D0, 0.00235D0, 0.00013D0, 0.00000D0/
50773 DATA (FMRS(1,1,I,34),I=1,49)/
50774 & 0.02190D0, 0.02741D0, 0.03429D0, 0.03909D0, 0.04289D0,
50775 & 0.04609D0, 0.05764D0, 0.07219D0, 0.08247D0, 0.09075D0,
50776 & 0.09793D0, 0.12453D0, 0.15996D0, 0.18597D0, 0.20731D0,
50777 & 0.22565D0, 0.25646D0, 0.29325D0, 0.33935D0, 0.37330D0,
50778 & 0.41800D0, 0.44209D0, 0.45219D0, 0.45092D0, 0.43883D0,
50779 & 0.41923D0, 0.39461D0, 0.36679D0, 0.33718D0, 0.30687D0,
50780 & 0.27654D0, 0.24693D0, 0.21853D0, 0.19159D0, 0.16650D0,
50781 & 0.14332D0, 0.12207D0, 0.10288D0, 0.08593D0, 0.07076D0,
50782 & 0.05749D0, 0.04618D0, 0.03639D0, 0.02146D0, 0.01157D0,
50783 & 0.00552D0, 0.00220D0, 0.00012D0, 0.00000D0/
50784 DATA (FMRS(1,1,I,35),I=1,49)/
50785 & 0.02208D0, 0.02764D0, 0.03459D0, 0.03943D0, 0.04327D0,
50786 & 0.04650D0, 0.05818D0, 0.07288D0, 0.08327D0, 0.09162D0,
50787 & 0.09888D0, 0.12574D0, 0.16147D0, 0.18765D0, 0.20909D0,
50788 & 0.22750D0, 0.25834D0, 0.29505D0, 0.34083D0, 0.37432D0,
50789 & 0.41794D0, 0.44094D0, 0.45002D0, 0.44763D0, 0.43463D0,
50790 & 0.41432D0, 0.38921D0, 0.36108D0, 0.33130D0, 0.30099D0,
50791 & 0.27077D0, 0.24136D0, 0.21322D0, 0.18665D0, 0.16193D0,
50792 & 0.13915D0, 0.11830D0, 0.09955D0, 0.08301D0, 0.06823D0,
50793 & 0.05533D0, 0.04437D0, 0.03490D0, 0.02050D0, 0.01100D0,
50794 & 0.00523D0, 0.00207D0, 0.00011D0, 0.00000D0/
50795 DATA (FMRS(1,1,I,36),I=1,49)/
50796 & 0.02225D0, 0.02787D0, 0.03488D0, 0.03977D0, 0.04364D0,
50797 & 0.04690D0, 0.05869D0, 0.07354D0, 0.08402D0, 0.09246D0,
50798 & 0.09978D0, 0.12689D0, 0.16290D0, 0.18924D0, 0.21077D0,
50799 & 0.22923D0, 0.26010D0, 0.29672D0, 0.34217D0, 0.37521D0,
50800 & 0.41781D0, 0.43978D0, 0.44789D0, 0.44447D0, 0.43062D0,
50801 & 0.40968D0, 0.38412D0, 0.35571D0, 0.32579D0, 0.29550D0,
50802 & 0.26538D0, 0.23618D0, 0.20831D0, 0.18206D0, 0.15771D0,
50803 & 0.13531D0, 0.11485D0, 0.09649D0, 0.08034D0, 0.06592D0,
50804 & 0.05337D0, 0.04272D0, 0.03354D0, 0.01963D0, 0.01049D0,
50805 & 0.00496D0, 0.00196D0, 0.00011D0, 0.00000D0/
50806 DATA (FMRS(1,1,I,37),I=1,49)/
50807 & 0.02242D0, 0.02809D0, 0.03517D0, 0.04010D0, 0.04401D0,
50808 & 0.04731D0, 0.05921D0, 0.07420D0, 0.08479D0, 0.09331D0,
50809 & 0.10070D0, 0.12805D0, 0.16433D0, 0.19082D0, 0.21245D0,
50810 & 0.23095D0, 0.26184D0, 0.29836D0, 0.34345D0, 0.37604D0,
50811 & 0.41760D0, 0.43853D0, 0.44568D0, 0.44123D0, 0.42654D0,
50812 & 0.40499D0, 0.37899D0, 0.35034D0, 0.32029D0, 0.29001D0,
50813 & 0.26003D0, 0.23104D0, 0.20345D0, 0.17752D0, 0.15354D0,
50814 & 0.13153D0, 0.11147D0, 0.09348D0, 0.07771D0, 0.06366D0,
50815 & 0.05147D0, 0.04112D0, 0.03222D0, 0.01879D0, 0.01000D0,
50816 & 0.00471D0, 0.00185D0, 0.00010D0, 0.00000D0/
50817 DATA (FMRS(1,1,I,38),I=1,49)/
50818 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
50819 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
50820 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
50821 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
50822 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
50823 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
50824 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
50825 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
50826 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
50827 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
50828 DATA (FMRS(1,2,I, 1),I=1,49)/
50829 & 0.00513D0, 0.00648D0, 0.00818D0, 0.00938D0, 0.01034D0,
50830 & 0.01116D0, 0.01418D0, 0.01818D0, 0.02118D0, 0.02372D0,
50831 & 0.02613D0, 0.03576D0, 0.05040D0, 0.06228D0, 0.07266D0,
50832 & 0.08202D0, 0.09864D0, 0.12002D0, 0.14955D0, 0.17387D0,
50833 & 0.21184D0, 0.23954D0, 0.25956D0, 0.27606D0, 0.28502D0,
50834 & 0.28790D0, 0.28586D0, 0.27985D0, 0.27060D0, 0.25918D0,
50835 & 0.24535D0, 0.23028D0, 0.21416D0, 0.19735D0, 0.18044D0,
50836 & 0.16347D0, 0.14671D0, 0.13049D0, 0.11512D0, 0.10018D0,
50837 & 0.08630D0, 0.07360D0, 0.06172D0, 0.04171D0, 0.02610D0,
50838 & 0.01478D0, 0.00721D0, 0.00074D0, 0.00000D0/
50839 DATA (FMRS(1,2,I, 2),I=1,49)/
50840 & 0.00518D0, 0.00654D0, 0.00828D0, 0.00950D0, 0.01049D0,
50841 & 0.01133D0, 0.01443D0, 0.01854D0, 0.02162D0, 0.02423D0,
50842 & 0.02670D0, 0.03657D0, 0.05155D0, 0.06366D0, 0.07421D0,
50843 & 0.08371D0, 0.10052D0, 0.12206D0, 0.15163D0, 0.17583D0,
50844 & 0.21329D0, 0.24028D0, 0.25950D0, 0.27498D0, 0.28295D0,
50845 & 0.28491D0, 0.28206D0, 0.27535D0, 0.26555D0, 0.25365D0,
50846 & 0.23952D0, 0.22423D0, 0.20802D0, 0.19123D0, 0.17441D0,
50847 & 0.15763D0, 0.14114D0, 0.12520D0, 0.11019D0, 0.09565D0,
50848 & 0.08218D0, 0.06990D0, 0.05847D0, 0.03927D0, 0.02442D0,
50849 & 0.01373D0, 0.00665D0, 0.00066D0, 0.00000D0/
50850 DATA (FMRS(1,2,I, 3),I=1,49)/
50851 & 0.00524D0, 0.00664D0, 0.00843D0, 0.00970D0, 0.01072D0,
50852 & 0.01159D0, 0.01481D0, 0.01908D0, 0.02229D0, 0.02501D0,
50853 & 0.02757D0, 0.03781D0, 0.05328D0, 0.06572D0, 0.07653D0,
50854 & 0.08622D0, 0.10330D0, 0.12505D0, 0.15465D0, 0.17864D0,
50855 & 0.21528D0, 0.24119D0, 0.25922D0, 0.27320D0, 0.27971D0,
50856 & 0.28035D0, 0.27635D0, 0.26864D0, 0.25807D0, 0.24551D0,
50857 & 0.23101D0, 0.21544D0, 0.19911D0, 0.18240D0, 0.16578D0,
50858 & 0.14929D0, 0.13320D0, 0.11772D0, 0.10322D0, 0.08926D0,
50859 & 0.07639D0, 0.06473D0, 0.05394D0, 0.03591D0, 0.02212D0,
50860 & 0.01231D0, 0.00589D0, 0.00057D0, 0.00000D0/
50861 DATA (FMRS(1,2,I, 4),I=1,49)/
50862 & 0.00529D0, 0.00672D0, 0.00855D0, 0.00985D0, 0.01090D0,
50863 & 0.01179D0, 0.01510D0, 0.01949D0, 0.02279D0, 0.02558D0,
50864 & 0.02822D0, 0.03873D0, 0.05456D0, 0.06724D0, 0.07823D0,
50865 & 0.08806D0, 0.10532D0, 0.12720D0, 0.15680D0, 0.18061D0,
50866 & 0.21663D0, 0.24172D0, 0.25888D0, 0.27177D0, 0.27723D0,
50867 & 0.27696D0, 0.27213D0, 0.26373D0, 0.25262D0, 0.23966D0,
50868 & 0.22489D0, 0.20919D0, 0.19281D0, 0.17616D0, 0.15968D0,
50869 & 0.14345D0, 0.12763D0, 0.11250D0, 0.09838D0, 0.08485D0,
50870 & 0.07242D0, 0.06118D0, 0.05083D0, 0.03363D0, 0.02058D0,
50871 & 0.01136D0, 0.00539D0, 0.00050D0, 0.00000D0/
50872 DATA (FMRS(1,2,I, 5),I=1,49)/
50873 & 0.00534D0, 0.00680D0, 0.00868D0, 0.01001D0, 0.01108D0,
50874 & 0.01200D0, 0.01540D0, 0.01993D0, 0.02332D0, 0.02620D0,
50875 & 0.02891D0, 0.03971D0, 0.05590D0, 0.06884D0, 0.08000D0,
50876 & 0.08997D0, 0.10741D0, 0.12941D0, 0.15897D0, 0.18257D0,
50877 & 0.21790D0, 0.24212D0, 0.25836D0, 0.27010D0, 0.27446D0,
50878 & 0.27326D0, 0.26762D0, 0.25853D0, 0.24692D0, 0.23356D0,
50879 & 0.21851D0, 0.20270D0, 0.18633D0, 0.16975D0, 0.15345D0,
50880 & 0.13751D0, 0.12199D0, 0.10721D0, 0.09351D0, 0.08043D0,
50881 & 0.06843D0, 0.05765D0, 0.04775D0, 0.03138D0, 0.01907D0,
50882 & 0.01045D0, 0.00491D0, 0.00045D0, 0.00000D0/
50883 DATA (FMRS(1,2,I, 6),I=1,49)/
50884 & 0.00539D0, 0.00688D0, 0.00879D0, 0.01015D0, 0.01125D0,
50885 & 0.01219D0, 0.01567D0, 0.02031D0, 0.02379D0, 0.02674D0,
50886 & 0.02951D0, 0.04056D0, 0.05708D0, 0.07022D0, 0.08154D0,
50887 & 0.09162D0, 0.10921D0, 0.13130D0, 0.16082D0, 0.18422D0,
50888 & 0.21894D0, 0.24239D0, 0.25783D0, 0.26859D0, 0.27204D0,
50889 & 0.27005D0, 0.26373D0, 0.25409D0, 0.24206D0, 0.22838D0,
50890 & 0.21313D0, 0.19724D0, 0.18088D0, 0.16440D0, 0.14826D0,
50891 & 0.13257D0, 0.11731D0, 0.10284D0, 0.08950D0, 0.07679D0,
50892 & 0.06517D0, 0.05477D0, 0.04524D0, 0.02956D0, 0.01786D0,
50893 & 0.00972D0, 0.00453D0, 0.00040D0, 0.00000D0/
50894 DATA (FMRS(1,2,I, 7),I=1,49)/
50895 & 0.00544D0, 0.00695D0, 0.00890D0, 0.01029D0, 0.01141D0,
50896 & 0.01237D0, 0.01593D0, 0.02068D0, 0.02425D0, 0.02727D0,
50897 & 0.03010D0, 0.04138D0, 0.05820D0, 0.07155D0, 0.08301D0,
50898 & 0.09319D0, 0.11091D0, 0.13308D0, 0.16253D0, 0.18572D0,
50899 & 0.21983D0, 0.24255D0, 0.25721D0, 0.26706D0, 0.26966D0,
50900 & 0.26692D0, 0.25996D0, 0.24983D0, 0.23740D0, 0.22344D0,
50901 & 0.20806D0, 0.19209D0, 0.17575D0, 0.15940D0, 0.14342D0,
50902 & 0.12794D0, 0.11298D0, 0.09881D0, 0.08579D0, 0.07344D0,
50903 & 0.06219D0, 0.05213D0, 0.04295D0, 0.02791D0, 0.01677D0,
50904 & 0.00906D0, 0.00419D0, 0.00037D0, 0.00000D0/
50905 DATA (FMRS(1,2,I, 8),I=1,49)/
50906 & 0.00549D0, 0.00703D0, 0.00902D0, 0.01044D0, 0.01159D0,
50907 & 0.01257D0, 0.01622D0, 0.02109D0, 0.02474D0, 0.02783D0,
50908 & 0.03073D0, 0.04227D0, 0.05940D0, 0.07296D0, 0.08456D0,
50909 & 0.09485D0, 0.11270D0, 0.13493D0, 0.16429D0, 0.18726D0,
50910 & 0.22070D0, 0.24263D0, 0.25647D0, 0.26535D0, 0.26707D0,
50911 & 0.26357D0, 0.25596D0, 0.24532D0, 0.23250D0, 0.21829D0,
50912 & 0.20276D0, 0.18675D0, 0.17045D0, 0.15424D0, 0.13845D0,
50913 & 0.12321D0, 0.10855D0, 0.09470D0, 0.08203D0, 0.07005D0,
50914 & 0.05917D0, 0.04947D0, 0.04065D0, 0.02627D0, 0.01569D0,
50915 & 0.00842D0, 0.00386D0, 0.00033D0, 0.00000D0/
50916 DATA (FMRS(1,2,I, 9),I=1,49)/
50917 & 0.00553D0, 0.00711D0, 0.00913D0, 0.01057D0, 0.01174D0,
50918 & 0.01274D0, 0.01647D0, 0.02144D0, 0.02517D0, 0.02833D0,
50919 & 0.03129D0, 0.04304D0, 0.06045D0, 0.07418D0, 0.08591D0,
50920 & 0.09629D0, 0.11425D0, 0.13653D0, 0.16579D0, 0.18855D0,
50921 & 0.22139D0, 0.24264D0, 0.25577D0, 0.26380D0, 0.26479D0,
50922 & 0.26063D0, 0.25250D0, 0.24142D0, 0.22830D0, 0.21390D0,
50923 & 0.19824D0, 0.18222D0, 0.16597D0, 0.14988D0, 0.13426D0,
50924 & 0.11924D0, 0.10484D0, 0.09128D0, 0.07889D0, 0.06724D0,
50925 & 0.05666D0, 0.04727D0, 0.03875D0, 0.02492D0, 0.01480D0,
50926 & 0.00790D0, 0.00360D0, 0.00030D0, 0.00000D0/
50927 DATA (FMRS(1,2,I,10),I=1,49)/
50928 & 0.00558D0, 0.00718D0, 0.00923D0, 0.01071D0, 0.01190D0,
50929 & 0.01291D0, 0.01671D0, 0.02178D0, 0.02559D0, 0.02881D0,
50930 & 0.03183D0, 0.04379D0, 0.06146D0, 0.07536D0, 0.08720D0,
50931 & 0.09766D0, 0.11571D0, 0.13802D0, 0.16719D0, 0.18973D0,
50932 & 0.22198D0, 0.24256D0, 0.25502D0, 0.26225D0, 0.26252D0,
50933 & 0.25776D0, 0.24914D0, 0.23766D0, 0.22428D0, 0.20968D0,
50934 & 0.19393D0, 0.17791D0, 0.16173D0, 0.14575D0, 0.13032D0,
50935 & 0.11552D0, 0.10136D0, 0.08807D0, 0.07596D0, 0.06462D0,
50936 & 0.05433D0, 0.04524D0, 0.03701D0, 0.02369D0, 0.01400D0,
50937 & 0.00743D0, 0.00336D0, 0.00028D0, 0.00000D0/
50938 DATA (FMRS(1,2,I,11),I=1,49)/
50939 & 0.00562D0, 0.00723D0, 0.00932D0, 0.01081D0, 0.01202D0,
50940 & 0.01305D0, 0.01691D0, 0.02206D0, 0.02593D0, 0.02920D0,
50941 & 0.03226D0, 0.04438D0, 0.06226D0, 0.07629D0, 0.08822D0,
50942 & 0.09874D0, 0.11687D0, 0.13920D0, 0.16827D0, 0.19064D0,
50943 & 0.22242D0, 0.24246D0, 0.25439D0, 0.26100D0, 0.26071D0,
50944 & 0.25548D0, 0.24648D0, 0.23472D0, 0.22112D0, 0.20638D0,
50945 & 0.19059D0, 0.17454D0, 0.15845D0, 0.14257D0, 0.12728D0,
50946 & 0.11265D0, 0.09869D0, 0.08561D0, 0.07373D0, 0.06261D0,
50947 & 0.05256D0, 0.04369D0, 0.03568D0, 0.02275D0, 0.01339D0,
50948 & 0.00707D0, 0.00318D0, 0.00026D0, 0.00000D0/
50949 DATA (FMRS(1,2,I,12),I=1,49)/
50950 & 0.00570D0, 0.00736D0, 0.00950D0, 0.01104D0, 0.01228D0,
50951 & 0.01335D0, 0.01733D0, 0.02266D0, 0.02665D0, 0.03003D0,
50952 & 0.03319D0, 0.04566D0, 0.06397D0, 0.07827D0, 0.09038D0,
50953 & 0.10102D0, 0.11928D0, 0.14164D0, 0.17050D0, 0.19247D0,
50954 & 0.22321D0, 0.24211D0, 0.25293D0, 0.25822D0, 0.25677D0,
50955 & 0.25059D0, 0.24082D0, 0.22847D0, 0.21448D0, 0.19945D0,
50956 & 0.18361D0, 0.16759D0, 0.15163D0, 0.13598D0, 0.12100D0,
50957 & 0.10676D0, 0.09321D0, 0.08058D0, 0.06917D0, 0.05856D0,
50958 & 0.04898D0, 0.04057D0, 0.03301D0, 0.02089D0, 0.01219D0,
50959 & 0.00638D0, 0.00284D0, 0.00022D0, 0.00000D0/
50960 DATA (FMRS(1,2,I,13),I=1,49)/
50961 & 0.00578D0, 0.00747D0, 0.00966D0, 0.01124D0, 0.01252D0,
50962 & 0.01361D0, 0.01770D0, 0.02318D0, 0.02729D0, 0.03076D0,
50963 & 0.03400D0, 0.04677D0, 0.06545D0, 0.07997D0, 0.09223D0,
50964 & 0.10297D0, 0.12133D0, 0.14370D0, 0.17234D0, 0.19395D0,
50965 & 0.22379D0, 0.24170D0, 0.25156D0, 0.25575D0, 0.25334D0,
50966 & 0.24638D0, 0.23598D0, 0.22317D0, 0.20887D0, 0.19364D0,
50967 & 0.17776D0, 0.16180D0, 0.14597D0, 0.13054D0, 0.11583D0,
50968 & 0.10193D0, 0.08873D0, 0.07648D0, 0.06548D0, 0.05529D0,
50969 & 0.04609D0, 0.03806D0, 0.03088D0, 0.01941D0, 0.01124D0,
50970 & 0.00583D0, 0.00257D0, 0.00020D0, 0.00000D0/
50971 DATA (FMRS(1,2,I,14),I=1,49)/
50972 & 0.00586D0, 0.00760D0, 0.00985D0, 0.01147D0, 0.01278D0,
50973 & 0.01391D0, 0.01812D0, 0.02377D0, 0.02801D0, 0.03158D0,
50974 & 0.03491D0, 0.04802D0, 0.06710D0, 0.08186D0, 0.09428D0,
50975 & 0.10512D0, 0.12358D0, 0.14593D0, 0.17430D0, 0.19551D0,
50976 & 0.22431D0, 0.24113D0, 0.24990D0, 0.25292D0, 0.24948D0,
50977 & 0.24168D0, 0.23063D0, 0.21737D0, 0.20273D0, 0.18735D0,
50978 & 0.17142D0, 0.15550D0, 0.13986D0, 0.12470D0, 0.11033D0,
50979 & 0.09680D0, 0.08400D0, 0.07217D0, 0.06162D0, 0.05183D0,
50980 & 0.04308D0, 0.03546D0, 0.02866D0, 0.01788D0, 0.01027D0,
50981 & 0.00528D0, 0.00231D0, 0.00017D0, 0.00000D0/
50982 DATA (FMRS(1,2,I,15),I=1,49)/
50983 & 0.00596D0, 0.00773D0, 0.01005D0, 0.01171D0, 0.01307D0,
50984 & 0.01423D0, 0.01857D0, 0.02439D0, 0.02876D0, 0.03244D0,
50985 & 0.03586D0, 0.04932D0, 0.06880D0, 0.08380D0, 0.09637D0,
50986 & 0.10730D0, 0.12584D0, 0.14815D0, 0.17622D0, 0.19694D0,
50987 & 0.22466D0, 0.24034D0, 0.24804D0, 0.24983D0, 0.24536D0,
50988 & 0.23677D0, 0.22506D0, 0.21136D0, 0.19645D0, 0.18096D0,
50989 & 0.16500D0, 0.14922D0, 0.13378D0, 0.11890D0, 0.10488D0,
50990 & 0.09171D0, 0.07933D0, 0.06793D0, 0.05781D0, 0.04848D0,
50991 & 0.04016D0, 0.03293D0, 0.02652D0, 0.01642D0, 0.00936D0,
50992 & 0.00477D0, 0.00206D0, 0.00015D0, 0.00000D0/
50993 DATA (FMRS(1,2,I,16),I=1,49)/
50994 & 0.00604D0, 0.00786D0, 0.01023D0, 0.01194D0, 0.01333D0,
50995 & 0.01452D0, 0.01898D0, 0.02497D0, 0.02945D0, 0.03323D0,
50996 & 0.03674D0, 0.05050D0, 0.07034D0, 0.08554D0, 0.09824D0,
50997 & 0.10925D0, 0.12785D0, 0.15009D0, 0.17786D0, 0.19815D0,
50998 & 0.22486D0, 0.23952D0, 0.24625D0, 0.24698D0, 0.24163D0,
50999 & 0.23233D0, 0.22009D0, 0.20603D0, 0.19091D0, 0.17529D0,
51000 & 0.15938D0, 0.14374D0, 0.12849D0, 0.11388D0, 0.10016D0,
51001 & 0.08733D0, 0.07533D0, 0.06433D0, 0.05458D0, 0.04564D0,
51002 & 0.03769D0, 0.03082D0, 0.02473D0, 0.01521D0, 0.00860D0,
51003 & 0.00435D0, 0.00186D0, 0.00013D0, 0.00000D0/
51004 DATA (FMRS(1,2,I,17),I=1,49)/
51005 & 0.00614D0, 0.00799D0, 0.01042D0, 0.01217D0, 0.01359D0,
51006 & 0.01482D0, 0.01940D0, 0.02555D0, 0.03016D0, 0.03404D0,
51007 & 0.03763D0, 0.05170D0, 0.07188D0, 0.08729D0, 0.10010D0,
51008 & 0.11119D0, 0.12983D0, 0.15200D0, 0.17943D0, 0.19928D0,
51009 & 0.22497D0, 0.23860D0, 0.24438D0, 0.24406D0, 0.23786D0,
51010 & 0.22788D0, 0.21517D0, 0.20077D0, 0.18546D0, 0.16976D0,
51011 & 0.15392D0, 0.13841D0, 0.12338D0, 0.10905D0, 0.09563D0,
51012 & 0.08314D0, 0.07152D0, 0.06090D0, 0.05152D0, 0.04295D0,
51013 & 0.03537D0, 0.02883D0, 0.02306D0, 0.01409D0, 0.00791D0,
51014 & 0.00396D0, 0.00168D0, 0.00011D0, 0.00000D0/
51015 DATA (FMRS(1,2,I,18),I=1,49)/
51016 & 0.00621D0, 0.00810D0, 0.01058D0, 0.01236D0, 0.01382D0,
51017 & 0.01507D0, 0.01975D0, 0.02604D0, 0.03075D0, 0.03471D0,
51018 & 0.03837D0, 0.05269D0, 0.07316D0, 0.08872D0, 0.10163D0,
51019 & 0.11277D0, 0.13143D0, 0.15352D0, 0.18066D0, 0.20012D0,
51020 & 0.22496D0, 0.23774D0, 0.24276D0, 0.24159D0, 0.23471D0,
51021 & 0.22421D0, 0.21113D0, 0.19645D0, 0.18102D0, 0.16532D0,
51022 & 0.14952D0, 0.13412D0, 0.11930D0, 0.10519D0, 0.09201D0,
51023 & 0.07983D0, 0.06850D0, 0.05818D0, 0.04914D0, 0.04085D0,
51024 & 0.03356D0, 0.02728D0, 0.02176D0, 0.01322D0, 0.00738D0,
51025 & 0.00367D0, 0.00154D0, 0.00010D0, 0.00000D0/
51026 DATA (FMRS(1,2,I,19),I=1,49)/
51027 & 0.00631D0, 0.00824D0, 0.01077D0, 0.01261D0, 0.01410D0,
51028 & 0.01538D0, 0.02018D0, 0.02663D0, 0.03146D0, 0.03553D0,
51029 & 0.03927D0, 0.05390D0, 0.07469D0, 0.09044D0, 0.10345D0,
51030 & 0.11464D0, 0.13332D0, 0.15529D0, 0.18206D0, 0.20106D0,
51031 & 0.22486D0, 0.23661D0, 0.24071D0, 0.23855D0, 0.23089D0,
51032 & 0.21978D0, 0.20626D0, 0.19133D0, 0.17575D0, 0.16006D0,
51033 & 0.14433D0, 0.12911D0, 0.11452D0, 0.10069D0, 0.08783D0,
51034 & 0.07600D0, 0.06503D0, 0.05507D0, 0.04638D0, 0.03845D0,
51035 & 0.03149D0, 0.02552D0, 0.02030D0, 0.01225D0, 0.00679D0,
51036 & 0.00335D0, 0.00139D0, 0.00009D0, 0.00000D0/
51037 DATA (FMRS(1,2,I,20),I=1,49)/
51038 & 0.00640D0, 0.00837D0, 0.01095D0, 0.01282D0, 0.01434D0,
51039 & 0.01565D0, 0.02057D0, 0.02717D0, 0.03210D0, 0.03625D0,
51040 & 0.04007D0, 0.05496D0, 0.07605D0, 0.09195D0, 0.10504D0,
51041 & 0.11628D0, 0.13496D0, 0.15682D0, 0.18325D0, 0.20182D0,
51042 & 0.22471D0, 0.23557D0, 0.23887D0, 0.23587D0, 0.22753D0,
51043 & 0.21592D0, 0.20204D0, 0.18691D0, 0.17123D0, 0.15556D0,
51044 & 0.13990D0, 0.12485D0, 0.11047D0, 0.09690D0, 0.08432D0,
51045 & 0.07279D0, 0.06213D0, 0.05248D0, 0.04407D0, 0.03646D0,
51046 & 0.02978D0, 0.02408D0, 0.01910D0, 0.01145D0, 0.00631D0,
51047 & 0.00309D0, 0.00127D0, 0.00008D0, 0.00000D0/
51048 DATA (FMRS(1,2,I,21),I=1,49)/
51049 & 0.00648D0, 0.00848D0, 0.01111D0, 0.01302D0, 0.01457D0,
51050 & 0.01591D0, 0.02092D0, 0.02766D0, 0.03269D0, 0.03692D0,
51051 & 0.04081D0, 0.05593D0, 0.07728D0, 0.09331D0, 0.10647D0,
51052 & 0.11774D0, 0.13641D0, 0.15816D0, 0.18425D0, 0.20243D0,
51053 & 0.22446D0, 0.23452D0, 0.23710D0, 0.23336D0, 0.22443D0,
51054 & 0.21239D0, 0.19820D0, 0.18290D0, 0.16716D0, 0.15148D0,
51055 & 0.13595D0, 0.12104D0, 0.10685D0, 0.09353D0, 0.08121D0,
51056 & 0.06995D0, 0.05958D0, 0.05021D0, 0.04207D0, 0.03472D0,
51057 & 0.02829D0, 0.02282D0, 0.01806D0, 0.01077D0, 0.00590D0,
51058 & 0.00287D0, 0.00118D0, 0.00007D0, 0.00000D0/
51059 DATA (FMRS(1,2,I,22),I=1,49)/
51060 & 0.00659D0, 0.00863D0, 0.01133D0, 0.01328D0, 0.01487D0,
51061 & 0.01624D0, 0.02138D0, 0.02828D0, 0.03345D0, 0.03777D0,
51062 & 0.04174D0, 0.05717D0, 0.07882D0, 0.09501D0, 0.10826D0,
51063 & 0.11956D0, 0.13822D0, 0.15980D0, 0.18547D0, 0.20313D0,
51064 & 0.22408D0, 0.23313D0, 0.23482D0, 0.23017D0, 0.22053D0,
51065 & 0.20797D0, 0.19344D0, 0.17794D0, 0.16215D0, 0.14650D0,
51066 & 0.13110D0, 0.11639D0, 0.10245D0, 0.08944D0, 0.07745D0,
51067 & 0.06653D0, 0.05651D0, 0.04748D0, 0.03968D0, 0.03265D0,
51068 & 0.02652D0, 0.02133D0, 0.01682D0, 0.00997D0, 0.00542D0,
51069 & 0.00262D0, 0.00106D0, 0.00006D0, 0.00000D0/
51070 DATA (FMRS(1,2,I,23),I=1,49)/
51071 & 0.00669D0, 0.00878D0, 0.01153D0, 0.01352D0, 0.01515D0,
51072 & 0.01655D0, 0.02181D0, 0.02888D0, 0.03416D0, 0.03858D0,
51073 & 0.04263D0, 0.05833D0, 0.08027D0, 0.09661D0, 0.10992D0,
51074 & 0.12125D0, 0.13987D0, 0.16129D0, 0.18654D0, 0.20370D0,
51075 & 0.22365D0, 0.23178D0, 0.23266D0, 0.22717D0, 0.21689D0,
51076 & 0.20387D0, 0.18906D0, 0.17340D0, 0.15758D0, 0.14198D0,
51077 & 0.12670D0, 0.11220D0, 0.09851D0, 0.08577D0, 0.07408D0,
51078 & 0.06350D0, 0.05377D0, 0.04507D0, 0.03757D0, 0.03084D0,
51079 & 0.02497D0, 0.02003D0, 0.01574D0, 0.00927D0, 0.00500D0,
51080 & 0.00240D0, 0.00096D0, 0.00006D0, 0.00000D0/
51081 DATA (FMRS(1,2,I,24),I=1,49)/
51082 & 0.00679D0, 0.00892D0, 0.01172D0, 0.01376D0, 0.01542D0,
51083 & 0.01685D0, 0.02222D0, 0.02944D0, 0.03483D0, 0.03934D0,
51084 & 0.04345D0, 0.05941D0, 0.08161D0, 0.09806D0, 0.11144D0,
51085 & 0.12278D0, 0.14136D0, 0.16260D0, 0.18745D0, 0.20414D0,
51086 & 0.22314D0, 0.23041D0, 0.23054D0, 0.22429D0, 0.21345D0,
51087 & 0.20006D0, 0.18498D0, 0.16918D0, 0.15336D0, 0.13783D0,
51088 & 0.12271D0, 0.10840D0, 0.09494D0, 0.08246D0, 0.07106D0,
51089 & 0.06075D0, 0.05132D0, 0.04292D0, 0.03570D0, 0.02922D0,
51090 & 0.02361D0, 0.01888D0, 0.01480D0, 0.00867D0, 0.00465D0,
51091 & 0.00221D0, 0.00088D0, 0.00005D0, 0.00000D0/
51092 DATA (FMRS(1,2,I,25),I=1,49)/
51093 & 0.00689D0, 0.00906D0, 0.01192D0, 0.01399D0, 0.01569D0,
51094 & 0.01715D0, 0.02264D0, 0.03000D0, 0.03550D0, 0.04009D0,
51095 & 0.04429D0, 0.06049D0, 0.08294D0, 0.09952D0, 0.11294D0,
51096 & 0.12429D0, 0.14282D0, 0.16389D0, 0.18832D0, 0.20454D0,
51097 & 0.22261D0, 0.22902D0, 0.22843D0, 0.22145D0, 0.21007D0,
51098 & 0.19632D0, 0.18101D0, 0.16509D0, 0.14928D0, 0.13382D0,
51099 & 0.11886D0, 0.10475D0, 0.09153D0, 0.07931D0, 0.06819D0,
51100 & 0.05815D0, 0.04900D0, 0.04089D0, 0.03393D0, 0.02770D0,
51101 & 0.02232D0, 0.01781D0, 0.01392D0, 0.00811D0, 0.00432D0,
51102 & 0.00204D0, 0.00081D0, 0.00004D0, 0.00000D0/
51103 DATA (FMRS(1,2,I,26),I=1,49)/
51104 & 0.00699D0, 0.00920D0, 0.01211D0, 0.01423D0, 0.01596D0,
51105 & 0.01744D0, 0.02304D0, 0.03056D0, 0.03616D0, 0.04084D0,
51106 & 0.04510D0, 0.06154D0, 0.08423D0, 0.10091D0, 0.11437D0,
51107 & 0.12573D0, 0.14419D0, 0.16508D0, 0.18909D0, 0.20485D0,
51108 & 0.22201D0, 0.22760D0, 0.22631D0, 0.21867D0, 0.20676D0,
51109 & 0.19266D0, 0.17717D0, 0.16120D0, 0.14536D0, 0.12999D0,
51110 & 0.11520D0, 0.10128D0, 0.08831D0, 0.07633D0, 0.06548D0,
51111 & 0.05572D0, 0.04685D0, 0.03900D0, 0.03228D0, 0.02629D0,
51112 & 0.02113D0, 0.01682D0, 0.01311D0, 0.00760D0, 0.00403D0,
51113 & 0.00189D0, 0.00074D0, 0.00004D0, 0.00000D0/
51114 DATA (FMRS(1,2,I,27),I=1,49)/
51115 & 0.00708D0, 0.00933D0, 0.01230D0, 0.01445D0, 0.01621D0,
51116 & 0.01773D0, 0.02343D0, 0.03108D0, 0.03678D0, 0.04155D0,
51117 & 0.04587D0, 0.06253D0, 0.08544D0, 0.10221D0, 0.11571D0,
51118 & 0.12707D0, 0.14546D0, 0.16617D0, 0.18977D0, 0.20509D0,
51119 & 0.22139D0, 0.22623D0, 0.22430D0, 0.21604D0, 0.20367D0,
51120 & 0.18926D0, 0.17361D0, 0.15759D0, 0.14176D0, 0.12648D0,
51121 & 0.11185D0, 0.09812D0, 0.08537D0, 0.07364D0, 0.06303D0,
51122 & 0.05352D0, 0.04490D0, 0.03729D0, 0.03081D0, 0.02503D0,
51123 & 0.02007D0, 0.01594D0, 0.01240D0, 0.00714D0, 0.00376D0,
51124 & 0.00176D0, 0.00068D0, 0.00004D0, 0.00000D0/
51125 DATA (FMRS(1,2,I,28),I=1,49)/
51126 & 0.00718D0, 0.00946D0, 0.01247D0, 0.01467D0, 0.01646D0,
51127 & 0.01800D0, 0.02380D0, 0.03158D0, 0.03738D0, 0.04221D0,
51128 & 0.04660D0, 0.06346D0, 0.08657D0, 0.10342D0, 0.11695D0,
51129 & 0.12830D0, 0.14663D0, 0.16715D0, 0.19037D0, 0.20527D0,
51130 & 0.22075D0, 0.22489D0, 0.22237D0, 0.21353D0, 0.20079D0,
51131 & 0.18610D0, 0.17031D0, 0.15425D0, 0.13844D0, 0.12326D0,
51132 & 0.10877D0, 0.09523D0, 0.08268D0, 0.07119D0, 0.06080D0,
51133 & 0.05153D0, 0.04314D0, 0.03575D0, 0.02948D0, 0.02390D0,
51134 & 0.01913D0, 0.01516D0, 0.01177D0, 0.00675D0, 0.00353D0,
51135 & 0.00164D0, 0.00063D0, 0.00003D0, 0.00000D0/
51136 DATA (FMRS(1,2,I,29),I=1,49)/
51137 & 0.00727D0, 0.00959D0, 0.01265D0, 0.01488D0, 0.01670D0,
51138 & 0.01827D0, 0.02417D0, 0.03208D0, 0.03797D0, 0.04288D0,
51139 & 0.04733D0, 0.06440D0, 0.08769D0, 0.10463D0, 0.11818D0,
51140 & 0.12952D0, 0.14777D0, 0.16810D0, 0.19092D0, 0.20540D0,
51141 & 0.22008D0, 0.22352D0, 0.22043D0, 0.21103D0, 0.19791D0,
51142 & 0.18297D0, 0.16705D0, 0.15095D0, 0.13519D0, 0.12011D0,
51143 & 0.10577D0, 0.09241D0, 0.08008D0, 0.06881D0, 0.05866D0,
51144 & 0.04961D0, 0.04145D0, 0.03427D0, 0.02822D0, 0.02282D0,
51145 & 0.01822D0, 0.01441D0, 0.01116D0, 0.00637D0, 0.00332D0,
51146 & 0.00153D0, 0.00059D0, 0.00003D0, 0.00000D0/
51147 DATA (FMRS(1,2,I,30),I=1,49)/
51148 & 0.00737D0, 0.00972D0, 0.01283D0, 0.01510D0, 0.01695D0,
51149 & 0.01854D0, 0.02454D0, 0.03258D0, 0.03856D0, 0.04354D0,
51150 & 0.04805D0, 0.06532D0, 0.08879D0, 0.10580D0, 0.11936D0,
51151 & 0.13069D0, 0.14886D0, 0.16900D0, 0.19141D0, 0.20548D0,
51152 & 0.21937D0, 0.22213D0, 0.21850D0, 0.20855D0, 0.19507D0,
51153 & 0.17994D0, 0.16388D0, 0.14775D0, 0.13208D0, 0.11709D0,
51154 & 0.10291D0, 0.08973D0, 0.07760D0, 0.06655D0, 0.05664D0,
51155 & 0.04779D0, 0.03985D0, 0.03289D0, 0.02702D0, 0.02182D0,
51156 & 0.01738D0, 0.01372D0, 0.01060D0, 0.00602D0, 0.00312D0,
51157 & 0.00143D0, 0.00055D0, 0.00003D0, 0.00000D0/
51158 DATA (FMRS(1,2,I,31),I=1,49)/
51159 & 0.00746D0, 0.00985D0, 0.01300D0, 0.01530D0, 0.01718D0,
51160 & 0.01880D0, 0.02489D0, 0.03306D0, 0.03912D0, 0.04417D0,
51161 & 0.04873D0, 0.06619D0, 0.08983D0, 0.10690D0, 0.12048D0,
51162 & 0.13179D0, 0.14987D0, 0.16982D0, 0.19186D0, 0.20553D0,
51163 & 0.21868D0, 0.22081D0, 0.21666D0, 0.20623D0, 0.19242D0,
51164 & 0.17710D0, 0.16093D0, 0.14478D0, 0.12919D0, 0.11430D0,
51165 & 0.10026D0, 0.08726D0, 0.07533D0, 0.06447D0, 0.05479D0,
51166 & 0.04614D0, 0.03840D0, 0.03163D0, 0.02594D0, 0.02091D0,
51167 & 0.01662D0, 0.01309D0, 0.01009D0, 0.00571D0, 0.00295D0,
51168 & 0.00134D0, 0.00051D0, 0.00003D0, 0.00000D0/
51169 DATA (FMRS(1,2,I,32),I=1,49)/
51170 & 0.00755D0, 0.00997D0, 0.01317D0, 0.01550D0, 0.01741D0,
51171 & 0.01905D0, 0.02522D0, 0.03351D0, 0.03966D0, 0.04477D0,
51172 & 0.04938D0, 0.06700D0, 0.09079D0, 0.10792D0, 0.12151D0,
51173 & 0.13280D0, 0.15080D0, 0.17056D0, 0.19223D0, 0.20552D0,
51174 & 0.21797D0, 0.21951D0, 0.21489D0, 0.20403D0, 0.18991D0,
51175 & 0.17441D0, 0.15817D0, 0.14202D0, 0.12646D0, 0.11170D0,
51176 & 0.09780D0, 0.08498D0, 0.07322D0, 0.06257D0, 0.05306D0,
51177 & 0.04463D0, 0.03708D0, 0.03049D0, 0.02496D0, 0.02008D0,
51178 & 0.01594D0, 0.01252D0, 0.00963D0, 0.00542D0, 0.00279D0,
51179 & 0.00126D0, 0.00048D0, 0.00002D0, 0.00000D0/
51180 DATA (FMRS(1,2,I,33),I=1,49)/
51181 & 0.00764D0, 0.01009D0, 0.01333D0, 0.01570D0, 0.01763D0,
51182 & 0.01930D0, 0.02556D0, 0.03396D0, 0.04019D0, 0.04537D0,
51183 & 0.05004D0, 0.06783D0, 0.09177D0, 0.10895D0, 0.12254D0,
51184 & 0.13381D0, 0.15173D0, 0.17130D0, 0.19261D0, 0.20552D0,
51185 & 0.21726D0, 0.21822D0, 0.21313D0, 0.20185D0, 0.18743D0,
51186 & 0.17175D0, 0.15545D0, 0.13931D0, 0.12379D0, 0.10917D0,
51187 & 0.09540D0, 0.08276D0, 0.07118D0, 0.06072D0, 0.05139D0,
51188 & 0.04317D0, 0.03581D0, 0.02938D0, 0.02402D0, 0.01929D0,
51189 & 0.01528D0, 0.01198D0, 0.00920D0, 0.00516D0, 0.00264D0,
51190 & 0.00119D0, 0.00045D0, 0.00002D0, 0.00000D0/
51191 DATA (FMRS(1,2,I,34),I=1,49)/
51192 & 0.00773D0, 0.01021D0, 0.01350D0, 0.01590D0, 0.01786D0,
51193 & 0.01955D0, 0.02590D0, 0.03441D0, 0.04072D0, 0.04597D0,
51194 & 0.05068D0, 0.06863D0, 0.09272D0, 0.10994D0, 0.12353D0,
51195 & 0.13477D0, 0.15260D0, 0.17197D0, 0.19290D0, 0.20543D0,
51196 & 0.21649D0, 0.21688D0, 0.21134D0, 0.19965D0, 0.18497D0,
51197 & 0.16913D0, 0.15278D0, 0.13665D0, 0.12121D0, 0.10669D0,
51198 & 0.09308D0, 0.08060D0, 0.06921D0, 0.05894D0, 0.04980D0,
51199 & 0.04176D0, 0.03458D0, 0.02833D0, 0.02311D0, 0.01853D0,
51200 & 0.01465D0, 0.01147D0, 0.00879D0, 0.00491D0, 0.00250D0,
51201 & 0.00112D0, 0.00042D0, 0.00002D0, 0.00000D0/
51202 DATA (FMRS(1,2,I,35),I=1,49)/
51203 & 0.00781D0, 0.01033D0, 0.01366D0, 0.01609D0, 0.01808D0,
51204 & 0.01979D0, 0.02622D0, 0.03484D0, 0.04123D0, 0.04653D0,
51205 & 0.05129D0, 0.06941D0, 0.09362D0, 0.11088D0, 0.12448D0,
51206 & 0.13569D0, 0.15342D0, 0.17260D0, 0.19318D0, 0.20535D0,
51207 & 0.21576D0, 0.21562D0, 0.20966D0, 0.19759D0, 0.18266D0,
51208 & 0.16668D0, 0.15028D0, 0.13418D0, 0.11882D0, 0.10439D0,
51209 & 0.09094D0, 0.07861D0, 0.06739D0, 0.05729D0, 0.04834D0,
51210 & 0.04048D0, 0.03346D0, 0.02736D0, 0.02228D0, 0.01784D0,
51211 & 0.01408D0, 0.01100D0, 0.00842D0, 0.00468D0, 0.00237D0,
51212 & 0.00106D0, 0.00039D0, 0.00002D0, 0.00000D0/
51213 DATA (FMRS(1,2,I,36),I=1,49)/
51214 & 0.00790D0, 0.01044D0, 0.01382D0, 0.01628D0, 0.01829D0,
51215 & 0.02002D0, 0.02653D0, 0.03525D0, 0.04172D0, 0.04707D0,
51216 & 0.05188D0, 0.07013D0, 0.09447D0, 0.11177D0, 0.12535D0,
51217 & 0.13654D0, 0.15418D0, 0.17318D0, 0.19341D0, 0.20524D0,
51218 & 0.21505D0, 0.21440D0, 0.20805D0, 0.19563D0, 0.18048D0,
51219 & 0.16438D0, 0.14795D0, 0.13186D0, 0.11657D0, 0.10226D0,
51220 & 0.08894D0, 0.07676D0, 0.06571D0, 0.05578D0, 0.04700D0,
51221 & 0.03929D0, 0.03242D0, 0.02648D0, 0.02153D0, 0.01720D0,
51222 & 0.01356D0, 0.01058D0, 0.00808D0, 0.00448D0, 0.00226D0,
51223 & 0.00101D0, 0.00037D0, 0.00002D0, 0.00000D0/
51224 DATA (FMRS(1,2,I,37),I=1,49)/
51225 & 0.00798D0, 0.01056D0, 0.01397D0, 0.01646D0, 0.01850D0,
51226 & 0.02025D0, 0.02684D0, 0.03567D0, 0.04221D0, 0.04762D0,
51227 & 0.05247D0, 0.07087D0, 0.09532D0, 0.11265D0, 0.12622D0,
51228 & 0.13738D0, 0.15492D0, 0.17373D0, 0.19361D0, 0.20510D0,
51229 & 0.21429D0, 0.21315D0, 0.20641D0, 0.19365D0, 0.17829D0,
51230 & 0.16207D0, 0.14561D0, 0.12954D0, 0.11434D0, 0.10013D0,
51231 & 0.08696D0, 0.07493D0, 0.06406D0, 0.05429D0, 0.04567D0,
51232 & 0.03812D0, 0.03141D0, 0.02561D0, 0.02079D0, 0.01659D0,
51233 & 0.01305D0, 0.01017D0, 0.00775D0, 0.00428D0, 0.00215D0,
51234 & 0.00095D0, 0.00035D0, 0.00002D0, 0.00000D0/
51235 DATA (FMRS(1,2,I,38),I=1,49)/
51236 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
51237 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
51238 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
51239 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
51240 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
51241 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
51242 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
51243 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
51244 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
51245 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
51246 DATA (FMRS(1,3,I, 1),I=1,49)/
51247 & 3.68244D0, 3.61785D0, 3.55346D0, 3.51555D0, 3.48837D0,
51248 & 3.46702D0, 3.39811D0, 3.32177D0, 3.27072D0, 3.23000D0,
51249 & 3.19378D0, 3.05765D0, 2.86346D0, 2.71339D0, 2.58651D0,
51250 & 2.47572D0, 2.28777D0, 2.06245D0, 1.78178D0, 1.57726D0,
51251 & 1.30519D0, 1.14076D0, 1.03654D0, 0.95264D0, 0.89447D0,
51252 & 0.84663D0, 0.80090D0, 0.75325D0, 0.70217D0, 0.64784D0,
51253 & 0.59048D0, 0.53173D0, 0.47263D0, 0.41459D0, 0.35887D0,
51254 & 0.30634D0, 0.25757D0, 0.21335D0, 0.17415D0, 0.13936D0,
51255 & 0.10957D0, 0.08459D0, 0.06372D0, 0.03369D0, 0.01574D0,
51256 & 0.00625D0, 0.00195D0, 0.00005D0, 0.00000D0/
51257 DATA (FMRS(1,3,I, 2),I=1,49)/
51258 & 6.24307D0, 5.86376D0, 5.50631D0, 5.30646D0, 5.16844D0,
51259 & 5.06337D0, 4.74657D0, 4.44005D0, 4.26242D0, 4.13555D0,
51260 & 4.03502D0, 3.71094D0, 3.34882D0, 3.11051D0, 2.92600D0,
51261 & 2.77355D0, 2.52821D0, 2.24967D0, 1.91859D0, 1.68481D0,
51262 & 1.37946D0, 1.19535D0, 1.07673D0, 0.97819D0, 0.90750D0,
51263 & 0.84881D0, 0.79381D0, 0.73852D0, 0.68149D0, 0.62276D0,
51264 & 0.56254D0, 0.50226D0, 0.44285D0, 0.38548D0, 0.33123D0,
51265 & 0.28073D0, 0.23437D0, 0.19279D0, 0.15633D0, 0.12427D0,
51266 & 0.09707D0, 0.07445D0, 0.05572D0, 0.02906D0, 0.01339D0,
51267 & 0.00524D0, 0.00161D0, 0.00004D0, 0.00000D0/
51268 DATA (FMRS(1,3,I, 3),I=1,49)/
51269 & 11.05139D0, 9.94786D0, 8.95244D0, 8.41536D0, 8.05287D0,
51270 & 7.78166D0, 6.98996D0, 6.26416D0, 5.86369D0, 5.58758D0,
51271 & 5.37431D0, 4.72923D0, 4.08790D0, 3.70661D0, 3.43015D0,
51272 & 3.21204D0, 2.87740D0, 2.51734D0, 2.11023D0, 1.83283D0,
51273 & 1.47833D0, 1.26530D0, 1.12571D0, 1.00618D0, 0.91793D0,
51274 & 0.84442D0, 0.77712D0, 0.71204D0, 0.64770D0, 0.58389D0,
51275 & 0.52071D0, 0.45928D0, 0.40030D0, 0.34459D0, 0.29298D0,
51276 & 0.24576D0, 0.20309D0, 0.16540D0, 0.13284D0, 0.10462D0,
51277 & 0.08093D0, 0.06152D0, 0.04560D0, 0.02333D0, 0.01054D0,
51278 & 0.00404D0, 0.00122D0, 0.00003D0, 0.00000D0/
51279 DATA (FMRS(1,3,I, 4),I=1,49)/
51280 & 15.37825D0, 13.53065D0, 11.90193D0, 11.03924D0, 10.46378D0,
51281 & 10.03696D0, 8.81034D0, 7.71341D0, 7.12073D0, 6.71781D0,
51282 & 6.40918D0, 5.49848D0, 4.63276D0, 4.13943D0, 3.79203D0,
51283 & 3.52386D0, 3.12196D0, 2.70149D0, 2.23890D0, 1.93011D0,
51284 & 1.54059D0, 1.30714D0, 1.15286D0, 1.01886D0, 0.91881D0,
51285 & 0.83562D0, 0.76055D0, 0.68952D0, 0.62095D0, 0.55452D0,
51286 & 0.49011D0, 0.42861D0, 0.37052D0, 0.31647D0, 0.26702D0,
51287 & 0.22241D0, 0.18246D0, 0.14751D0, 0.11769D0, 0.09209D0,
51288 & 0.07074D0, 0.05343D0, 0.03933D0, 0.01985D0, 0.00885D0,
51289 & 0.00335D0, 0.00100D0, 0.00002D0, 0.00000D0/
51290 DATA (FMRS(1,3,I, 5),I=1,49)/
51291 & 20.54786D0, 17.73643D0, 15.30522D0, 14.03720D0, 13.19955D0,
51292 & 12.58273D0, 10.83264D0, 9.29877D0, 8.48369D0, 7.93560D0,
51293 & 7.51848D0, 6.31010D0, 5.19808D0, 4.58383D0, 4.16067D0,
51294 & 3.83948D0, 3.36690D0, 2.88348D0, 2.36367D0, 2.02276D0,
51295 & 1.59751D0, 1.34336D0, 1.17440D0, 1.02619D0, 0.91484D0,
51296 & 0.82260D0, 0.74049D0, 0.66431D0, 0.59227D0, 0.52387D0,
51297 & 0.45886D0, 0.39784D0, 0.34106D0, 0.28898D0, 0.24193D0,
51298 & 0.20003D0, 0.16291D0, 0.13075D0, 0.10361D0, 0.08049D0,
51299 & 0.06141D0, 0.04606D0, 0.03367D0, 0.01676D0, 0.00737D0,
51300 & 0.00275D0, 0.00081D0, 0.00002D0, 0.00000D0/
51301 DATA (FMRS(1,3,I, 6),I=1,49)/
51302 & 25.87997D0, 22.00579D0, 18.70564D0, 17.00514D0, 15.89031D0,
51303 & 15.07400D0, 12.78092D0, 10.80231D0, 9.76436D0, 9.07223D0,
51304 & 8.54820D0, 7.05063D0, 5.70461D0, 4.97765D0, 4.48471D0,
51305 & 4.11512D0, 3.57867D0, 3.03899D0, 2.46867D0, 2.09967D0,
51306 & 1.64344D0, 1.37152D0, 1.19009D0, 1.03003D0, 0.90944D0,
51307 & 0.81000D0, 0.72245D0, 0.64242D0, 0.56795D0, 0.49835D0,
51308 & 0.43318D0, 0.37285D0, 0.31739D0, 0.26712D0, 0.22217D0,
51309 & 0.18254D0, 0.14775D0, 0.11786D0, 0.09285D0, 0.07171D0,
51310 & 0.05439D0, 0.04056D0, 0.02948D0, 0.01450D0, 0.00631D0,
51311 & 0.00232D0, 0.00067D0, 0.00002D0, 0.00000D0/
51312 DATA (FMRS(1,3,I, 7),I=1,49)/
51313 & 31.48650D0, 26.43816D0, 22.19174D0, 20.02570D0, 18.61470D0,
51314 & 17.58636D0, 14.72161D0, 12.28168D0, 11.01532D0, 10.17669D0,
51315 & 9.54456D0, 7.75761D0, 6.18119D0, 5.34474D0, 4.78459D0,
51316 & 4.36861D0, 3.77149D0, 3.17878D0, 2.56125D0, 2.16614D0,
51317 & 1.68135D0, 1.39321D0, 1.20050D0, 1.02990D0, 0.90129D0,
51318 & 0.79577D0, 0.70378D0, 0.62075D0, 0.54457D0, 0.47435D0,
51319 & 0.40939D0, 0.34999D0, 0.29601D0, 0.24758D0, 0.20467D0,
51320 & 0.16718D0, 0.13453D0, 0.10670D0, 0.08361D0, 0.06425D0,
51321 & 0.04845D0, 0.03594D0, 0.02598D0, 0.01264D0, 0.00544D0,
51322 & 0.00198D0, 0.00057D0, 0.00001D0, 0.00000D0/
51323 DATA (FMRS(1,3,I, 8),I=1,49)/
51324 & 38.19562D0, 31.67731D0, 26.26192D0, 23.52700D0, 21.75654D0,
51325 & 20.47217D0, 16.92324D0, 13.93891D0, 12.40615D0, 11.39793D0,
51326 & 10.64140D0, 8.52490D0, 6.69053D0, 5.73328D0, 5.09966D0,
51327 & 4.63338D0, 3.97084D0, 3.32155D0, 2.65414D0, 2.23167D0,
51328 & 1.71719D0, 1.41235D0, 1.20819D0, 1.02708D0, 0.89064D0,
51329 & 0.77934D0, 0.68328D0, 0.59764D0, 0.52014D0, 0.44964D0,
51330 & 0.38523D0, 0.32704D0, 0.27476D0, 0.22832D0, 0.18758D0,
51331 & 0.15228D0, 0.12182D0, 0.09604D0, 0.07484D0, 0.05719D0,
51332 & 0.04288D0, 0.03164D0, 0.02275D0, 0.01095D0, 0.00466D0,
51333 & 0.00168D0, 0.00048D0, 0.00001D0, 0.00000D0/
51334 DATA (FMRS(1,3,I, 9),I=1,49)/
51335 & 44.69263D0, 36.69535D0, 30.11768D0, 26.82255D0, 24.70025D0,
51336 & 23.16639D0, 18.95601D0, 15.45187D0, 13.66736D0, 12.49995D0,
51337 & 11.62724D0, 9.20581D0, 7.13631D0, 6.07035D0, 5.37118D0,
51338 & 4.86033D0, 4.14011D0, 3.44140D0, 2.73081D0, 2.28485D0,
51339 & 1.74506D0, 1.42613D0, 1.21246D0, 1.02274D0, 0.88003D0,
51340 & 0.76424D0, 0.66513D0, 0.57765D0, 0.49935D0, 0.42889D0,
51341 & 0.36519D0, 0.30820D0, 0.25746D0, 0.21275D0, 0.17388D0,
51342 & 0.14043D0, 0.11178D0, 0.08767D0, 0.06799D0, 0.05171D0,
51343 & 0.03859D0, 0.02834D0, 0.02028D0, 0.00968D0, 0.00408D0,
51344 & 0.00146D0, 0.00041D0, 0.00001D0, 0.00000D0/
51345 DATA (FMRS(1,3,I,10),I=1,49)/
51346 & 51.42669D0, 41.84610D0, 34.03689D0, 30.15309D0, 27.66303D0,
51347 & 25.86942D0, 20.97504D0, 16.93923D0, 14.89954D0, 13.57172D0,
51348 & 12.58248D0, 9.85775D0, 7.55746D0, 6.38605D0, 5.62372D0,
51349 & 5.07013D0, 4.29501D0, 3.54959D0, 2.79853D0, 2.33075D0,
51350 & 1.76763D0, 1.43584D0, 1.21358D0, 1.01625D0, 0.86814D0,
51351 & 0.74860D0, 0.64707D0, 0.55827D0, 0.47958D0, 0.40941D0,
51352 & 0.34660D0, 0.29089D0, 0.24172D0, 0.19871D0, 0.16160D0,
51353 & 0.12988D0, 0.10289D0, 0.08032D0, 0.06202D0, 0.04695D0,
51354 & 0.03489D0, 0.02551D0, 0.01818D0, 0.00860D0, 0.00360D0,
51355 & 0.00128D0, 0.00036D0, 0.00001D0, 0.00000D0/
51356 DATA (FMRS(1,3,I,11),I=1,49)/
51357 & 57.20334D0, 46.22931D0, 37.34534D0, 32.95134D0, 30.14391D0,
51358 & 28.12686D0, 22.64741D0, 18.16087D0, 15.90648D0, 14.44434D0,
51359 & 13.35786D0, 10.38182D0, 7.89242D0, 6.63544D0, 5.82215D0,
51360 & 5.23423D0, 4.41529D0, 3.63279D0, 2.84983D0, 2.36499D0,
51361 & 1.78374D0, 1.44206D0, 1.21326D0, 1.01023D0, 0.85815D0,
51362 & 0.73593D0, 0.63273D0, 0.54312D0, 0.46430D0, 0.39449D0,
51363 & 0.33248D0, 0.27783D0, 0.22993D0, 0.18826D0, 0.15250D0,
51364 & 0.12212D0, 0.09637D0, 0.07495D0, 0.05770D0, 0.04352D0,
51365 & 0.03223D0, 0.02349D0, 0.01668D0, 0.00784D0, 0.00326D0,
51366 & 0.00115D0, 0.00032D0, 0.00001D0, 0.00000D0/
51367 DATA (FMRS(1,3,I,12),I=1,49)/
51368 & 70.62117D0, 56.29525D0, 44.85603D0, 39.26056D0, 35.71024D0,
51369 & 33.17249D0, 26.34026D0, 20.82458D0, 18.08508D0, 16.32156D0,
51370 & 15.01807D0, 11.48651D0, 8.58576D0, 7.14521D0, 6.22372D0,
51371 & 5.56345D0, 4.65284D0, 3.79371D0, 2.94559D0, 2.42633D0,
51372 & 1.80899D0, 1.44797D0, 1.20662D0, 0.99291D0, 0.83369D0,
51373 & 0.70687D0, 0.60112D0, 0.51056D0, 0.43209D0, 0.36357D0,
51374 & 0.30359D0, 0.25146D0, 0.20630D0, 0.16753D0, 0.13462D0,
51375 & 0.10696D0, 0.08376D0, 0.06466D0, 0.04944D0, 0.03702D0,
51376 & 0.02722D0, 0.01971D0, 0.01390D0, 0.00645D0, 0.00265D0,
51377 & 0.00093D0, 0.00026D0, 0.00001D0, 0.00000D0/
51378 DATA (FMRS(1,3,I,13),I=1,49)/
51379 & 83.50434D0, 65.82890D0, 51.87140D0, 45.10521D0, 40.83618D0,
51380 & 37.79736D0, 29.67546D0, 23.19327D0, 20.00393D0, 17.96325D0,
51381 & 16.46149D0, 12.42825D0, 9.16326D0, 7.56303D0, 6.54853D0,
51382 & 5.82663D0, 4.83880D0, 3.91602D0, 3.01472D0, 2.46779D0,
51383 & 1.82202D0, 1.44614D0, 1.19543D0, 0.97402D0, 0.80992D0,
51384 & 0.68027D0, 0.57325D0, 0.48262D0, 0.40504D0, 0.33808D0,
51385 & 0.28014D0, 0.23033D0, 0.18761D0, 0.15130D0, 0.12077D0,
51386 & 0.09534D0, 0.07419D0, 0.05692D0, 0.04326D0, 0.03220D0,
51387 & 0.02354D0, 0.01696D0, 0.01189D0, 0.00546D0, 0.00222D0,
51388 & 0.00077D0, 0.00021D0, 0.00001D0, 0.00000D0/
51389 DATA (FMRS(1,3,I,14),I=1,49)/
51390 & 99.26808D0, 77.34151D0, 60.22972D0, 52.01289D0, 46.85941D0,
51391 & 43.20707D0, 33.52017D0, 25.88194D0, 22.16110D0, 19.79557D0,
51392 & 18.06292D0, 13.45200D0, 9.77556D0, 7.99825D0, 6.88178D0,
51393 & 6.09288D0, 5.02224D0, 4.03207D0, 3.07569D0, 2.50055D0,
51394 & 1.82658D0, 1.43637D0, 1.17694D0, 0.94870D0, 0.78062D0,
51395 & 0.64903D0, 0.54156D0, 0.45166D0, 0.37564D0, 0.31084D0,
51396 & 0.25547D0, 0.20834D0, 0.16843D0, 0.13481D0, 0.10686D0,
51397 & 0.08378D0, 0.06476D0, 0.04934D0, 0.03727D0, 0.02756D0,
51398 & 0.02003D0, 0.01435D0, 0.01000D0, 0.00454D0, 0.00183D0,
51399 & 0.00063D0, 0.00017D0, 0.00000D0, 0.00000D0/
51400 DATA (FMRS(1,3,I,15),I=1,49)/
51401 & 117.13634D0, 90.22787D0, 69.46667D0, 59.58908D0, 53.42973D0,
51402 & 49.08310D0, 37.64029D0, 28.72286D0, 24.42074D0, 21.70264D0,
51403 & 19.72087D0, 14.49332D0, 10.38573D0, 8.42544D0, 7.20484D0,
51404 & 6.34818D0, 5.19436D0, 4.13748D0, 3.12707D0, 2.52493D0,
51405 & 1.82437D0, 1.42118D0, 1.15415D0, 0.92032D0, 0.74934D0,
51406 & 0.61673D0, 0.50955D0, 0.42103D0, 0.34703D0, 0.28471D0,
51407 & 0.23205D0, 0.18777D0, 0.15064D0, 0.11967D0, 0.09419D0,
51408 & 0.07336D0, 0.05631D0, 0.04263D0, 0.03201D0, 0.02354D0,
51409 & 0.01700D0, 0.01211D0, 0.00839D0, 0.00377D0, 0.00151D0,
51410 & 0.00052D0, 0.00014D0, 0.00000D0, 0.00000D0/
51411 DATA (FMRS(1,3,I,16),I=1,49)/
51412 & 134.87820D0,102.87527D0, 78.42588D0, 66.88609D0, 59.72612D0,
51413 & 54.69190D0, 41.52393D0, 31.36570D0, 26.50579D0, 23.45176D0,
51414 & 21.23395D0, 15.42784D0, 10.92244D0, 8.79593D0, 7.48170D0,
51415 & 6.56462D0, 5.33723D0, 4.22208D0, 3.16533D0, 2.54035D0,
51416 & 1.81781D0, 1.40424D0, 1.13142D0, 0.89365D0, 0.72095D0,
51417 & 0.58811D0, 0.48181D0, 0.39483D0, 0.32289D0, 0.26295D0,
51418 & 0.21278D0, 0.17100D0, 0.13629D0, 0.10758D0, 0.08415D0,
51419 & 0.06517D0, 0.04972D0, 0.03744D0, 0.02797D0, 0.02046D0,
51420 & 0.01470D0, 0.01042D0, 0.00719D0, 0.00321D0, 0.00127D0,
51421 & 0.00043D0, 0.00012D0, 0.00000D0, 0.00000D0/
51422 DATA (FMRS(1,3,I,17),I=1,49)/
51423 & 154.38010D0,116.63111D0, 88.06633D0, 74.68806D0, 66.42747D0,
51424 & 60.64011D0, 45.59593D0, 34.10384D0, 28.65021D0, 25.24085D0,
51425 & 22.77463D0, 16.36506D0, 11.45095D0, 9.15610D0, 7.74790D0,
51426 & 6.77064D0, 5.47057D0, 4.29852D0, 3.19720D0, 2.55058D0,
51427 & 1.80771D0, 1.38488D0, 1.10716D0, 0.86634D0, 0.69264D0,
51428 & 0.56014D0, 0.45511D0, 0.36997D0, 0.30026D0, 0.24276D0,
51429 & 0.19507D0, 0.15573D0, 0.12333D0, 0.09676D0, 0.07524D0,
51430 & 0.05794D0, 0.04395D0, 0.03292D0, 0.02447D0, 0.01781D0,
51431 & 0.01274D0, 0.00899D0, 0.00618D0, 0.00274D0, 0.00108D0,
51432 & 0.00037D0, 0.00010D0, 0.00000D0, 0.00000D0/
51433 DATA (FMRS(1,3,I,18),I=1,49)/
51434 & 171.60985D0,128.66806D0, 96.41977D0, 81.40891D0, 72.17590D0,
51435 & 65.72558D0, 49.04064D0, 36.39427D0, 30.43144D0, 26.71914D0,
51436 & 24.04215D0, 17.12464D0, 11.87120D0, 9.43856D0, 7.95410D0,
51437 & 6.92832D0, 5.57016D0, 4.35322D0, 3.21721D0, 2.55406D0,
51438 & 1.79608D0, 1.36671D0, 1.08575D0, 0.84319D0, 0.66925D0,
51439 & 0.53749D0, 0.43376D0, 0.35041D0, 0.28267D0, 0.22722D0,
51440 & 0.18154D0, 0.14418D0, 0.11359D0, 0.08871D0, 0.06865D0,
51441 & 0.05262D0, 0.03976D0, 0.02965D0, 0.02195D0, 0.01592D0,
51442 & 0.01135D0, 0.00798D0, 0.00547D0, 0.00241D0, 0.00095D0,
51443 & 0.00032D0, 0.00009D0, 0.00000D0, 0.00000D0/
51444 DATA (FMRS(1,3,I,19),I=1,49)/
51445 & 193.78899D0,144.01862D0,106.97157D0, 89.85031D0, 79.36631D0,
51446 & 72.06629D0, 53.29134D0, 39.18974D0, 32.59051D0, 28.50177D0,
51447 & 25.56394D0, 18.02311D0, 12.35926D0, 9.76179D0, 8.18702D0,
51448 & 7.10431D0, 5.67841D0, 4.40968D0, 3.23437D0, 2.55292D0,
51449 & 1.77867D0, 1.34261D0, 1.05865D0, 0.81484D0, 0.64125D0,
51450 & 0.51082D0, 0.40904D0, 0.32798D0, 0.26269D0, 0.20975D0,
51451 & 0.16651D0, 0.13145D0, 0.10293D0, 0.07994D0, 0.06153D0,
51452 & 0.04691D0, 0.03527D0, 0.02618D0, 0.01929D0, 0.01394D0,
51453 & 0.00989D0, 0.00693D0, 0.00473D0, 0.00207D0, 0.00081D0,
51454 & 0.00027D0, 0.00007D0, 0.00000D0, 0.00000D0/
51455 DATA (FMRS(1,3,I,20),I=1,49)/
51456 & 214.89481D0,158.49641D0,116.83355D0, 97.69725D0, 86.02460D0,
51457 & 77.91979D0, 57.17770D0, 41.71972D0, 34.53225D0, 30.09744D0,
51458 & 26.92084D0, 18.81368D0, 12.78187D0, 10.03830D0, 8.38419D0,
51459 & 7.25181D0, 5.76723D0, 4.45410D0, 3.24560D0, 2.54901D0,
51460 & 1.76164D0, 1.32048D0, 1.03446D0, 0.79010D0, 0.61721D0,
51461 & 0.48824D0, 0.38835D0, 0.30938D0, 0.24629D0, 0.19551D0,
51462 & 0.15438D0, 0.12122D0, 0.09444D0, 0.07299D0, 0.05594D0,
51463 & 0.04245D0, 0.03178D0, 0.02349D0, 0.01725D0, 0.01242D0,
51464 & 0.00879D0, 0.00614D0, 0.00418D0, 0.00182D0, 0.00071D0,
51465 & 0.00024D0, 0.00007D0, 0.00000D0, 0.00000D0/
51466 DATA (FMRS(1,3,I,21),I=1,49)/
51467 & 234.93695D0,172.12665D0,126.03609D0,104.98046D0, 92.18044D0,
51468 & 83.31506D0, 60.72429D0, 44.00365D0, 36.27307D0, 31.52044D0,
51469 & 28.12565D0, 19.50453D0, 13.14306D0, 10.27071D0, 8.54710D0,
51470 & 7.37140D0, 5.83642D0, 4.48556D0, 3.24949D0, 2.54059D0,
51471 & 1.74309D0, 1.29840D0, 1.01128D0, 0.76711D0, 0.59538D0,
51472 & 0.46805D0, 0.37012D0, 0.29319D0, 0.23219D0, 0.18337D0,
51473 & 0.14410D0, 0.11261D0, 0.08738D0, 0.06725D0, 0.05133D0,
51474 & 0.03881D0, 0.02895D0, 0.02133D0, 0.01562D0, 0.01121D0,
51475 & 0.00791D0, 0.00551D0, 0.00374D0, 0.00162D0, 0.00063D0,
51476 & 0.00021D0, 0.00006D0, 0.00000D0, 0.00000D0/
51477 DATA (FMRS(1,3,I,22),I=1,49)/
51478 & 261.98752D0,190.37146D0,138.25069D0,114.59908D0,100.28083D0,
51479 & 90.39440D0, 65.33586D0, 46.94503D0, 38.50155D0, 33.33386D0,
51480 & 29.65516D0, 20.37022D0, 13.58831D0, 10.55348D0, 8.74295D0,
51481 & 7.51340D0, 5.91633D0, 4.51953D0, 3.25037D0, 2.52703D0,
51482 & 1.71812D0, 1.26985D0, 0.98192D0, 0.73853D0, 0.56860D0,
51483 & 0.44359D0, 0.34825D0, 0.27396D0, 0.21556D0, 0.16918D0,
51484 & 0.13216D0, 0.10269D0, 0.07927D0, 0.06069D0, 0.04611D0,
51485 & 0.03471D0, 0.02577D0, 0.01891D0, 0.01380D0, 0.00987D0,
51486 & 0.00694D0, 0.00482D0, 0.00326D0, 0.00141D0, 0.00055D0,
51487 & 0.00018D0, 0.00005D0, 0.00000D0, 0.00000D0/
51488 DATA (FMRS(1,3,I,23),I=1,49)/
51489 & 289.01031D0,208.43709D0,150.23653D0,123.98669D0,108.15595D0,
51490 & 97.25583D0, 69.76177D0, 49.73855D0, 40.60409D0, 35.03629D0,
51491 & 31.08496D0, 21.16773D0, 13.99081D0, 10.80513D0, 8.91469D0,
51492 & 7.63597D0, 5.98282D0, 4.54504D0, 3.24687D0, 2.51128D0,
51493 & 1.69316D0, 1.24243D0, 0.95435D0, 0.71223D0, 0.54431D0,
51494 & 0.42170D0, 0.32889D0, 0.25710D0, 0.20110D0, 0.15697D0,
51495 & 0.12195D0, 0.09429D0, 0.07242D0, 0.05518D0, 0.04175D0,
51496 & 0.03132D0, 0.02316D0, 0.01693D0, 0.01232D0, 0.00878D0,
51497 & 0.00615D0, 0.00426D0, 0.00288D0, 0.00124D0, 0.00048D0,
51498 & 0.00016D0, 0.00004D0, 0.00000D0, 0.00000D0/
51499 DATA (FMRS(1,3,I,24),I=1,49)/
51500 & 315.12421D0,225.74153D0,161.61246D0,132.84715D0,115.55888D0,
51501 & 103.68510D0, 73.86555D0, 52.29894D0, 42.51674D0, 36.57598D0,
51502 & 32.37159D0, 21.87235D0, 14.33730D0, 11.01653D0, 9.05547D0,
51503 & 7.73389D0, 6.03187D0, 4.55934D0, 3.23736D0, 2.49207D0,
51504 & 1.66734D0, 1.21544D0, 0.92800D0, 0.68769D0, 0.52210D0,
51505 & 0.40197D0, 0.31164D0, 0.24228D0, 0.18850D0, 0.14640D0,
51506 & 0.11322D0, 0.08715D0, 0.06666D0, 0.05059D0, 0.03813D0,
51507 & 0.02850D0, 0.02101D0, 0.01531D0, 0.01111D0, 0.00790D0,
51508 & 0.00552D0, 0.00382D0, 0.00258D0, 0.00111D0, 0.00043D0,
51509 & 0.00014D0, 0.00004D0, 0.00000D0, 0.00000D0/
51510 DATA (FMRS(1,3,I,25),I=1,49)/
51511 & 342.80673D0,243.95296D0,173.49684D0,142.06322D0,123.23465D0,
51512 & 110.33495D0, 78.07693D0, 54.90473D0, 44.45325D0, 38.12883D0,
51513 & 33.66507D0, 22.57285D0, 14.67683D0, 11.22134D0, 9.19035D0,
51514 & 7.82660D0, 6.07682D0, 4.57070D0, 3.22605D0, 2.47181D0,
51515 & 1.64130D0, 1.18872D0, 0.90224D0, 0.66398D0, 0.50084D0,
51516 & 0.38326D0, 0.29541D0, 0.22842D0, 0.17680D0, 0.13666D0,
51517 & 0.10521D0, 0.08063D0, 0.06143D0, 0.04643D0, 0.03487D0,
51518 & 0.02598D0, 0.01909D0, 0.01388D0, 0.01004D0, 0.00712D0,
51519 & 0.00496D0, 0.00343D0, 0.00231D0, 0.00099D0, 0.00038D0,
51520 & 0.00013D0, 0.00004D0, 0.00000D0, 0.00000D0/
51521 DATA (FMRS(1,3,I,26),I=1,49)/
51522 & 370.71918D0,262.16998D0,185.28712D0,151.16048D0,130.78375D0,
51523 & 116.85600D0, 82.16776D0, 57.40948D0, 46.30192D0, 39.60334D0,
51524 & 34.88776D0, 23.22383D0, 14.98428D0, 11.40259D0, 9.30664D0,
51525 & 7.90402D0, 6.11093D0, 4.57472D0, 3.21035D0, 2.44880D0,
51526 & 1.61427D0, 1.16192D0, 0.87693D0, 0.64114D0, 0.48063D0,
51527 & 0.36570D0, 0.28035D0, 0.21566D0, 0.16615D0, 0.12784D0,
51528 & 0.09801D0, 0.07482D0, 0.05679D0, 0.04277D0, 0.03202D0,
51529 & 0.02378D0, 0.01743D0, 0.01263D0, 0.00912D0, 0.00645D0,
51530 & 0.00449D0, 0.00310D0, 0.00208D0, 0.00089D0, 0.00034D0,
51531 & 0.00012D0, 0.00003D0, 0.00000D0, 0.00000D0/
51532 DATA (FMRS(1,3,I,27),I=1,49)/
51533 & 398.31635D0,280.05777D0,196.78310D0,159.99336D0,138.09111D0,
51534 & 123.15311D0, 86.08746D0, 59.78946D0, 48.04917D0, 40.99130D0,
51535 & 36.03455D0, 23.82682D0, 15.26416D0, 11.56505D0, 9.40909D0,
51536 & 7.97073D0, 6.13825D0, 4.57511D0, 3.19349D0, 2.42581D0,
51537 & 1.58834D0, 1.13668D0, 0.85340D0, 0.62017D0, 0.46227D0,
51538 & 0.34987D0, 0.26689D0, 0.20435D0, 0.15674D0, 0.12011D0,
51539 & 0.09172D0, 0.06977D0, 0.05278D0, 0.03962D0, 0.02958D0,
51540 & 0.02190D0, 0.01601D0, 0.01157D0, 0.00834D0, 0.00589D0,
51541 & 0.00409D0, 0.00282D0, 0.00189D0, 0.00081D0, 0.00031D0,
51542 & 0.00010D0, 0.00003D0, 0.00000D0, 0.00000D0/
51543 DATA (FMRS(1,3,I,28),I=1,49)/
51544 & 425.10541D0,297.30496D0,207.79007D0,168.41481D0,145.03664D0,
51545 & 129.12375D0, 89.77434D0, 62.00834D0, 49.66874D0, 42.27205D0,
51546 & 37.08847D0, 24.37295D0, 15.51221D0, 11.70602D0, 9.49577D0,
51547 & 8.02523D0, 6.15776D0, 4.57120D0, 3.17506D0, 2.40249D0,
51548 & 1.56325D0, 1.11278D0, 0.83141D0, 0.60084D0, 0.44554D0,
51549 & 0.33559D0, 0.25483D0, 0.19432D0, 0.14844D0, 0.11333D0,
51550 & 0.08624D0, 0.06537D0, 0.04932D0, 0.03692D0, 0.02748D0,
51551 & 0.02030D0, 0.01481D0, 0.01068D0, 0.00768D0, 0.00541D0,
51552 & 0.00376D0, 0.00258D0, 0.00173D0, 0.00074D0, 0.00028D0,
51553 & 0.00010D0, 0.00003D0, 0.00000D0, 0.00000D0/
51554 DATA (FMRS(1,3,I,29),I=1,49)/
51555 & 452.96622D0,315.13217D0,219.09509D0,177.03108D0,152.12305D0,
51556 & 135.20210D0, 93.50108D0, 64.23380D0, 51.28493D0, 43.54515D0,
51557 & 38.13279D0, 24.90754D0, 15.75054D0, 11.83897D0, 9.57579D0,
51558 & 8.07414D0, 6.17308D0, 4.56436D0, 3.15482D0, 2.37807D0,
51559 & 1.53780D0, 1.08891D0, 0.80971D0, 0.58195D0, 0.42935D0,
51560 & 0.32187D0, 0.24333D0, 0.18479D0, 0.14060D0, 0.10697D0,
51561 & 0.08112D0, 0.06130D0, 0.04611D0, 0.03442D0, 0.02556D0,
51562 & 0.01884D0, 0.01371D0, 0.00987D0, 0.00709D0, 0.00499D0,
51563 & 0.00346D0, 0.00237D0, 0.00159D0, 0.00068D0, 0.00026D0,
51564 & 0.00009D0, 0.00002D0, 0.00000D0, 0.00000D0/
51565 DATA (FMRS(1,3,I,30),I=1,49)/
51566 & 481.05176D0,332.98895D0,230.34398D0,185.57016D0,159.12541D0,
51567 & 141.19426D0, 97.14677D0, 66.39220D0, 52.84356D0, 44.76743D0,
51568 & 39.13180D0, 25.41137D0, 15.96984D0, 11.95815D0, 9.64523D0,
51569 & 8.11468D0, 6.18265D0, 4.55389D0, 3.13269D0, 2.35270D0,
51570 & 1.51231D0, 1.06542D0, 0.78862D0, 0.56381D0, 0.41396D0,
51571 & 0.30893D0, 0.23257D0, 0.17592D0, 0.13335D0, 0.10111D0,
51572 & 0.07645D0, 0.05760D0, 0.04319D0, 0.03217D0, 0.02383D0,
51573 & 0.01753D0, 0.01273D0, 0.00915D0, 0.00656D0, 0.00461D0,
51574 & 0.00319D0, 0.00219D0, 0.00146D0, 0.00062D0, 0.00024D0,
51575 & 0.00008D0, 0.00002D0, 0.00000D0, 0.00000D0/
51576 DATA (FMRS(1,3,I,31),I=1,49)/
51577 & 508.69336D0,350.46606D0,241.29128D0,193.85184D0,165.89978D0,
51578 & 146.97998D0,100.64462D0, 68.44891D0, 54.32217D0, 45.92301D0,
51579 & 40.07352D0, 25.88124D0, 16.17098D0, 12.06571D0, 9.70659D0,
51580 & 8.14933D0, 6.18899D0, 4.54214D0, 3.11075D0, 2.32815D0,
51581 & 1.48813D0, 1.04340D0, 0.76902D0, 0.54710D0, 0.39988D0,
51582 & 0.29718D0, 0.22284D0, 0.16794D0, 0.12688D0, 0.09590D0,
51583 & 0.07230D0, 0.05433D0, 0.04063D0, 0.03020D0, 0.02232D0,
51584 & 0.01639D0, 0.01188D0, 0.00852D0, 0.00610D0, 0.00428D0,
51585 & 0.00296D0, 0.00203D0, 0.00136D0, 0.00057D0, 0.00022D0,
51586 & 0.00007D0, 0.00002D0, 0.00000D0, 0.00000D0/
51587 DATA (FMRS(1,3,I,32),I=1,49)/
51588 & 535.18030D0,367.11212D0,251.65173D0,201.65910D0,172.26764D0,
51589 & 152.40591D0,103.89980D0, 70.34598D0, 55.67789D0, 46.97741D0,
51590 & 40.92907D0, 26.30087D0, 16.34517D0, 12.15570D0, 9.75539D0,
51591 & 8.17448D0, 6.18955D0, 4.52735D0, 3.08788D0, 2.30359D0,
51592 & 1.46475D0, 1.02248D0, 0.75063D0, 0.53161D0, 0.38695D0,
51593 & 0.28648D0, 0.21405D0, 0.16077D0, 0.12112D0, 0.09128D0,
51594 & 0.06863D0, 0.05145D0, 0.03839D0, 0.02847D0, 0.02101D0,
51595 & 0.01540D0, 0.01114D0, 0.00798D0, 0.00571D0, 0.00400D0,
51596 & 0.00276D0, 0.00189D0, 0.00126D0, 0.00054D0, 0.00020D0,
51597 & 0.00007D0, 0.00002D0, 0.00000D0, 0.00000D0/
51598 DATA (FMRS(1,3,I,33),I=1,49)/
51599 & 563.08673D0,384.57391D0,262.47256D0,209.79239D0,178.88937D0,
51600 & 158.04028D0,107.26506D0, 72.29848D0, 57.06943D0, 48.05758D0,
51601 & 41.80413D0, 26.72791D0, 16.52149D0, 12.24650D0, 9.80451D0,
51602 & 8.19975D0, 6.19012D0, 4.51259D0, 3.06514D0, 2.27926D0,
51603 & 1.44171D0, 1.00196D0, 0.73265D0, 0.51654D0, 0.37443D0,
51604 & 0.27615D0, 0.20559D0, 0.15389D0, 0.11561D0, 0.08687D0,
51605 & 0.06514D0, 0.04872D0, 0.03627D0, 0.02685D0, 0.01977D0,
51606 & 0.01446D0, 0.01045D0, 0.00747D0, 0.00534D0, 0.00374D0,
51607 & 0.00258D0, 0.00176D0, 0.00118D0, 0.00050D0, 0.00019D0,
51608 & 0.00006D0, 0.00002D0, 0.00000D0, 0.00000D0/
51609 DATA (FMRS(1,3,I,34),I=1,49)/
51610 & 590.49207D0,401.61096D0,272.95639D0,217.63766D0,185.25558D0,
51611 & 163.44283D0,110.46277D0, 74.13376D0, 58.36747D0, 49.05885D0,
51612 & 42.61046D0, 27.11206D0, 16.67322D0, 12.31989D0, 9.84041D0,
51613 & 8.21457D0, 6.18338D0, 4.49312D0, 3.03982D0, 2.25340D0,
51614 & 1.41818D0, 0.98144D0, 0.71494D0, 0.50189D0, 0.36238D0,
51615 & 0.26631D0, 0.19763D0, 0.14748D0, 0.11046D0, 0.08279D0,
51616 & 0.06193D0, 0.04622D0, 0.03434D0, 0.02537D0, 0.01865D0,
51617 & 0.01362D0, 0.00983D0, 0.00702D0, 0.00501D0, 0.00351D0,
51618 & 0.00242D0, 0.00165D0, 0.00110D0, 0.00046D0, 0.00018D0,
51619 & 0.00006D0, 0.00002D0, 0.00000D0, 0.00000D0/
51620 DATA (FMRS(1,3,I,35),I=1,49)/
51621 & 617.67798D0,418.44214D0,283.27148D0,225.33791D0,191.49365D0,
51622 & 168.72942D0,113.57884D0, 75.91459D0, 59.62379D0, 50.02613D0,
51623 & 43.38823D0, 27.48080D0, 16.81807D0, 12.38969D0, 9.87443D0,
51624 & 8.22855D0, 6.17694D0, 4.47470D0, 3.01600D0, 2.22915D0,
51625 & 1.39622D0, 0.96237D0, 0.69854D0, 0.48839D0, 0.35132D0,
51626 & 0.25731D0, 0.19037D0, 0.14164D0, 0.10579D0, 0.07911D0,
51627 & 0.05904D0, 0.04396D0, 0.03261D0, 0.02405D0, 0.01765D0,
51628 & 0.01287D0, 0.00928D0, 0.00662D0, 0.00472D0, 0.00330D0,
51629 & 0.00227D0, 0.00155D0, 0.00103D0, 0.00044D0, 0.00017D0,
51630 & 0.00006D0, 0.00002D0, 0.00000D0, 0.00000D0/
51631 DATA (FMRS(1,3,I,36),I=1,49)/
51632 & 643.85529D0,434.56937D0,293.10349D0,232.65437D0,197.40677D0,
51633 & 173.73129D0,116.50865D0, 77.57690D0, 60.79072D0, 50.92106D0,
51634 & 44.10533D0, 27.81589D0, 16.94600D0, 12.44906D0, 9.90141D0,
51635 & 8.23759D0, 6.16791D0, 4.45540D0, 2.99242D0, 2.20560D0,
51636 & 1.37532D0, 0.94442D0, 0.68324D0, 0.47589D0, 0.34114D0,
51637 & 0.24908D0, 0.18375D0, 0.13636D0, 0.10159D0, 0.07580D0,
51638 & 0.05645D0, 0.04195D0, 0.03106D0, 0.02287D0, 0.01676D0,
51639 & 0.01221D0, 0.00879D0, 0.00626D0, 0.00446D0, 0.00311D0,
51640 & 0.00214D0, 0.00146D0, 0.00097D0, 0.00041D0, 0.00016D0,
51641 & 0.00005D0, 0.00001D0, 0.00000D0, 0.00000D0/
51642 DATA (FMRS(1,3,I,37),I=1,49)/
51643 & 670.62598D0,450.98129D0,303.05762D0,240.03790D0,203.35986D0,
51644 & 178.75746D0,119.43383D0, 79.22430D0, 61.94125D0, 51.79964D0,
51645 & 44.80675D0, 28.13850D0, 17.06516D0, 12.50182D0, 9.92310D0,
51646 & 8.24227D0, 6.15572D0, 4.43398D0, 2.96756D0, 2.18122D0,
51647 & 1.35409D0, 0.92638D0, 0.66799D0, 0.46354D0, 0.33115D0,
51648 & 0.24105D0, 0.17731D0, 0.13125D0, 0.09756D0, 0.07262D0,
51649 & 0.05397D0, 0.04005D0, 0.02960D0, 0.02176D0, 0.01592D0,
51650 & 0.01159D0, 0.00833D0, 0.00593D0, 0.00422D0, 0.00294D0,
51651 & 0.00202D0, 0.00138D0, 0.00092D0, 0.00039D0, 0.00015D0,
51652 & 0.00005D0, 0.00001D0, 0.00000D0, 0.00000D0/
51653 DATA (FMRS(1,3,I,38),I=1,49)/
51654 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
51655 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
51656 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
51657 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
51658 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
51659 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
51660 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
51661 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
51662 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
51663 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
51664 DATA (FMRS(1,4,I, 1),I=1,49)/
51665 & 0.86800D0, 0.76598D0, 0.67520D0, 0.62675D0, 0.59428D0,
51666 & 0.57013D0, 0.50046D0, 0.43816D0, 0.40484D0, 0.38253D0,
51667 & 0.36613D0, 0.31874D0, 0.27654D0, 0.25397D0, 0.23882D0,
51668 & 0.22750D0, 0.21099D0, 0.19387D0, 0.17401D0, 0.15872D0,
51669 & 0.13363D0, 0.11222D0, 0.09356D0, 0.07392D0, 0.05824D0,
51670 & 0.04613D0, 0.03700D0, 0.03017D0, 0.02498D0, 0.02125D0,
51671 & 0.01786D0, 0.01513D0, 0.01268D0, 0.01040D0, 0.00852D0,
51672 & 0.00674D0, 0.00520D0, 0.00388D0, 0.00299D0, 0.00201D0,
51673 & 0.00134D0, 0.00094D0, 0.00051D0, 0.00021D0, 0.00007D0,
51674 & 0.00003D0, -0.00001D0, 0.00000D0, 0.00000D0/
51675 DATA (FMRS(1,4,I, 2),I=1,49)/
51676 & 0.88205D0, 0.77983D0, 0.68869D0, 0.63997D0, 0.60729D0,
51677 & 0.58296D0, 0.51264D0, 0.44961D0, 0.41580D0, 0.39312D0,
51678 & 0.37640D0, 0.32792D0, 0.28442D0, 0.26097D0, 0.24515D0,
51679 & 0.23328D0, 0.21590D0, 0.19782D0, 0.17683D0, 0.16077D0,
51680 & 0.13467D0, 0.11273D0, 0.09381D0, 0.07406D0, 0.05839D0,
51681 & 0.04632D0, 0.03722D0, 0.03037D0, 0.02516D0, 0.02135D0,
51682 & 0.01792D0, 0.01513D0, 0.01262D0, 0.01032D0, 0.00842D0,
51683 & 0.00664D0, 0.00510D0, 0.00380D0, 0.00291D0, 0.00197D0,
51684 & 0.00130D0, 0.00091D0, 0.00051D0, 0.00020D0, 0.00007D0,
51685 & 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0/
51686 DATA (FMRS(1,4,I, 3),I=1,49)/
51687 & 0.91886D0, 0.81356D0, 0.71953D0, 0.66920D0, 0.63541D0,
51688 & 0.61023D0, 0.53738D0, 0.47189D0, 0.43666D0, 0.41295D0,
51689 & 0.39539D0, 0.34428D0, 0.29794D0, 0.27277D0, 0.25567D0,
51690 & 0.24279D0, 0.22388D0, 0.20416D0, 0.18131D0, 0.16398D0,
51691 & 0.13630D0, 0.11352D0, 0.09418D0, 0.07425D0, 0.05857D0,
51692 & 0.04653D0, 0.03744D0, 0.03056D0, 0.02532D0, 0.02139D0,
51693 & 0.01791D0, 0.01504D0, 0.01246D0, 0.01016D0, 0.00822D0,
51694 & 0.00648D0, 0.00493D0, 0.00368D0, 0.00278D0, 0.00188D0,
51695 & 0.00124D0, 0.00086D0, 0.00051D0, 0.00020D0, 0.00006D0,
51696 & 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0/
51697 DATA (FMRS(1,4,I, 4),I=1,49)/
51698 & 0.95997D0, 0.84981D0, 0.75147D0, 0.69884D0, 0.66351D0,
51699 & 0.63718D0, 0.56100D0, 0.49247D0, 0.45556D0, 0.43069D0,
51700 & 0.41221D0, 0.35830D0, 0.30918D0, 0.28239D0, 0.26415D0,
51701 & 0.25039D0, 0.23017D0, 0.20908D0, 0.18474D0, 0.16642D0,
51702 & 0.13752D0, 0.11409D0, 0.09444D0, 0.07437D0, 0.05864D0,
51703 & 0.04662D0, 0.03752D0, 0.03063D0, 0.02535D0, 0.02135D0,
51704 & 0.01783D0, 0.01492D0, 0.01232D0, 0.01000D0, 0.00803D0,
51705 & 0.00631D0, 0.00479D0, 0.00358D0, 0.00268D0, 0.00180D0,
51706 & 0.00120D0, 0.00084D0, 0.00049D0, 0.00020D0, 0.00006D0,
51707 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
51708 DATA (FMRS(1,4,I, 5),I=1,49)/
51709 & 1.02269D0, 0.90363D0, 0.79759D0, 0.74093D0, 0.70294D0,
51710 & 0.67465D0, 0.59289D0, 0.51944D0, 0.47990D0, 0.45324D0,
51711 & 0.43337D0, 0.37541D0, 0.32249D0, 0.29359D0, 0.27391D0,
51712 & 0.25907D0, 0.23726D0, 0.21456D0, 0.18851D0, 0.16906D0,
51713 & 0.13883D0, 0.11469D0, 0.09468D0, 0.07442D0, 0.05863D0,
51714 & 0.04662D0, 0.03753D0, 0.03061D0, 0.02531D0, 0.02124D0,
51715 & 0.01767D0, 0.01472D0, 0.01211D0, 0.00977D0, 0.00782D0,
51716 & 0.00614D0, 0.00464D0, 0.00341D0, 0.00257D0, 0.00173D0,
51717 & 0.00113D0, 0.00080D0, 0.00046D0, 0.00018D0, 0.00005D0,
51718 & 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0/
51719 DATA (FMRS(1,4,I, 6),I=1,49)/
51720 & 1.08763D0, 0.95875D0, 0.84428D0, 0.78326D0, 0.74239D0,
51721 & 0.71199D0, 0.62427D0, 0.54563D0, 0.50333D0, 0.47482D0,
51722 & 0.45353D0, 0.39146D0, 0.33478D0, 0.30385D0, 0.28279D0,
51723 & 0.26692D0, 0.24362D0, 0.21944D0, 0.19183D0, 0.17138D0,
51724 & 0.13995D0, 0.11519D0, 0.09486D0, 0.07444D0, 0.05860D0,
51725 & 0.04659D0, 0.03750D0, 0.03056D0, 0.02523D0, 0.02111D0,
51726 & 0.01751D0, 0.01454D0, 0.01191D0, 0.00957D0, 0.00764D0,
51727 & 0.00598D0, 0.00450D0, 0.00328D0, 0.00247D0, 0.00167D0,
51728 & 0.00107D0, 0.00076D0, 0.00044D0, 0.00016D0, 0.00005D0,
51729 & 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0/
51730 DATA (FMRS(1,4,I, 7),I=1,49)/
51731 & 1.16556D0, 1.02401D0, 0.89875D0, 0.83219D0, 0.78769D0,
51732 & 0.75465D0, 0.65951D0, 0.57450D0, 0.52889D0, 0.49818D0,
51733 & 0.47520D0, 0.40838D0, 0.34748D0, 0.31432D0, 0.29177D0,
51734 & 0.27481D0, 0.24995D0, 0.22424D0, 0.19505D0, 0.17361D0,
51735 & 0.14101D0, 0.11563D0, 0.09500D0, 0.07441D0, 0.05852D0,
51736 & 0.04652D0, 0.03740D0, 0.03045D0, 0.02509D0, 0.02093D0,
51737 & 0.01733D0, 0.01434D0, 0.01170D0, 0.00939D0, 0.00744D0,
51738 & 0.00582D0, 0.00436D0, 0.00318D0, 0.00238D0, 0.00161D0,
51739 & 0.00104D0, 0.00073D0, 0.00042D0, 0.00014D0, 0.00005D0,
51740 & 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0/
51741 DATA (FMRS(1,4,I, 8),I=1,49)/
51742 & 1.26306D0, 1.10484D0, 0.96554D0, 0.89180D0, 0.84263D0,
51743 & 0.80618D0, 0.70157D0, 0.60853D0, 0.55877D0, 0.52532D0,
51744 & 0.50028D0, 0.42768D0, 0.36175D0, 0.32597D0, 0.30171D0,
51745 & 0.28349D0, 0.25687D0, 0.22944D0, 0.19851D0, 0.17597D0,
51746 & 0.14210D0, 0.11607D0, 0.09509D0, 0.07433D0, 0.05839D0,
51747 & 0.04638D0, 0.03725D0, 0.03028D0, 0.02490D0, 0.02071D0,
51748 & 0.01710D0, 0.01411D0, 0.01147D0, 0.00917D0, 0.00724D0,
51749 & 0.00565D0, 0.00421D0, 0.00306D0, 0.00228D0, 0.00155D0,
51750 & 0.00101D0, 0.00070D0, 0.00040D0, 0.00013D0, 0.00005D0,
51751 & 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0/
51752 DATA (FMRS(1,4,I, 9),I=1,49)/
51753 & 1.36120D0, 1.18550D0, 1.03156D0, 0.95040D0, 0.89642D0,
51754 & 0.85647D0, 0.74219D0, 0.64102D0, 0.58710D0, 0.55092D0,
51755 & 0.52385D0, 0.44558D0, 0.37481D0, 0.33656D0, 0.31068D0,
51756 & 0.29130D0, 0.26304D0, 0.23405D0, 0.20153D0, 0.17803D0,
51757 & 0.14303D0, 0.11643D0, 0.09515D0, 0.07423D0, 0.05825D0,
51758 & 0.04622D0, 0.03709D0, 0.03010D0, 0.02471D0, 0.02052D0,
51759 & 0.01688D0, 0.01389D0, 0.01125D0, 0.00895D0, 0.00706D0,
51760 & 0.00550D0, 0.00409D0, 0.00295D0, 0.00220D0, 0.00150D0,
51761 & 0.00098D0, 0.00067D0, 0.00039D0, 0.00013D0, 0.00005D0,
51762 & 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0/
51763 DATA (FMRS(1,4,I,10),I=1,49)/
51764 & 1.47041D0, 1.27446D0, 1.10370D0, 1.01406D0, 0.95460D0,
51765 & 0.91068D0, 0.78549D0, 0.67526D0, 0.61674D0, 0.57757D0,
51766 & 0.54827D0, 0.46388D0, 0.38797D0, 0.34713D0, 0.31960D0,
51767 & 0.29901D0, 0.26910D0, 0.23853D0, 0.20444D0, 0.17998D0,
51768 & 0.14388D0, 0.11673D0, 0.09517D0, 0.07410D0, 0.05807D0,
51769 & 0.04602D0, 0.03690D0, 0.02989D0, 0.02450D0, 0.02029D0,
51770 & 0.01665D0, 0.01365D0, 0.01102D0, 0.00875D0, 0.00689D0,
51771 & 0.00534D0, 0.00396D0, 0.00285D0, 0.00213D0, 0.00144D0,
51772 & 0.00094D0, 0.00064D0, 0.00038D0, 0.00013D0, 0.00004D0,
51773 & 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0/
51774 DATA (FMRS(1,4,I,11),I=1,49)/
51775 & 1.56638D0, 1.35212D0, 1.16625D0, 1.06903D0, 1.00469D0,
51776 & 0.95725D0, 0.82240D0, 0.70420D0, 0.64167D0, 0.59990D0,
51777 & 0.56868D0, 0.47904D0, 0.39878D0, 0.35576D0, 0.32683D0,
51778 & 0.30525D0, 0.27397D0, 0.24210D0, 0.20674D0, 0.18151D0,
51779 & 0.14453D0, 0.11694D0, 0.09517D0, 0.07398D0, 0.05791D0,
51780 & 0.04585D0, 0.03673D0, 0.02971D0, 0.02433D0, 0.02010D0,
51781 & 0.01646D0, 0.01346D0, 0.01083D0, 0.00860D0, 0.00675D0,
51782 & 0.00520D0, 0.00385D0, 0.00277D0, 0.00207D0, 0.00139D0,
51783 & 0.00090D0, 0.00062D0, 0.00037D0, 0.00013D0, 0.00004D0,
51784 & 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0/
51785 DATA (FMRS(1,4,I,12),I=1,49)/
51786 & 1.80214D0, 1.54109D0, 1.31694D0, 1.20067D0, 1.12412D0,
51787 & 1.06789D0, 0.90916D0, 0.77146D0, 0.69919D0, 0.65116D0,
51788 & 0.61534D0, 0.51323D0, 0.42280D0, 0.37478D0, 0.34269D0,
51789 & 0.31886D0, 0.28449D0, 0.24976D0, 0.21162D0, 0.18471D0,
51790 & 0.14585D0, 0.11732D0, 0.09509D0, 0.07364D0, 0.05748D0,
51791 & 0.04542D0, 0.03629D0, 0.02928D0, 0.02389D0, 0.01964D0,
51792 & 0.01603D0, 0.01303D0, 0.01043D0, 0.00824D0, 0.00644D0,
51793 & 0.00493D0, 0.00365D0, 0.00261D0, 0.00193D0, 0.00129D0,
51794 & 0.00082D0, 0.00058D0, 0.00033D0, 0.00012D0, 0.00003D0,
51795 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
51796 DATA (FMRS(1,4,I,13),I=1,49)/
51797 & 2.04055D0, 1.73004D0, 1.46588D0, 1.32988D0, 1.24076D0,
51798 & 1.17553D0, 0.99250D0, 0.83521D0, 0.75328D0, 0.69907D0,
51799 & 0.65875D0, 0.54456D0, 0.44445D0, 0.39176D0, 0.35673D0,
51800 & 0.33084D0, 0.29368D0, 0.25636D0, 0.21574D0, 0.18736D0,
51801 & 0.14688D0, 0.11755D0, 0.09493D0, 0.07328D0, 0.05705D0,
51802 & 0.04498D0, 0.03587D0, 0.02887D0, 0.02347D0, 0.01921D0,
51803 & 0.01564D0, 0.01265D0, 0.01010D0, 0.00793D0, 0.00617D0,
51804 & 0.00472D0, 0.00348D0, 0.00248D0, 0.00181D0, 0.00123D0,
51805 & 0.00077D0, 0.00054D0, 0.00031D0, 0.00011D0, 0.00003D0,
51806 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
51807 DATA (FMRS(1,4,I,14),I=1,49)/
51808 & 2.34878D0, 1.97162D0, 1.65417D0, 1.49212D0, 1.38650D0,
51809 & 1.30951D0, 1.09500D0, 0.91263D0, 0.81846D0, 0.75649D0,
51810 & 0.71054D0, 0.58140D0, 0.46952D0, 0.41122D0, 0.37271D0,
51811 & 0.34438D0, 0.30396D0, 0.26367D0, 0.22023D0, 0.19019D0,
51812 & 0.14790D0, 0.11770D0, 0.09464D0, 0.07279D0, 0.05650D0,
51813 & 0.04444D0, 0.03534D0, 0.02838D0, 0.02299D0, 0.01873D0,
51814 & 0.01518D0, 0.01221D0, 0.00971D0, 0.00758D0, 0.00587D0,
51815 & 0.00448D0, 0.00329D0, 0.00233D0, 0.00171D0, 0.00117D0,
51816 & 0.00073D0, 0.00051D0, 0.00028D0, 0.00010D0, 0.00003D0,
51817 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
51818 DATA (FMRS(1,4,I,15),I=1,49)/
51819 & 2.72076D0, 2.25974D0, 1.87603D0, 1.68193D0, 1.55614D0,
51820 & 1.46482D0, 1.21228D0, 1.00004D0, 0.89145D0, 0.82040D0,
51821 & 0.76790D0, 0.62156D0, 0.49638D0, 0.43184D0, 0.38951D0,
51822 & 0.35852D0, 0.31456D0, 0.27109D0, 0.22467D0, 0.19292D0,
51823 & 0.14878D0, 0.11770D0, 0.09423D0, 0.07216D0, 0.05583D0,
51824 & 0.04380D0, 0.03471D0, 0.02777D0, 0.02242D0, 0.01821D0,
51825 & 0.01468D0, 0.01176D0, 0.00931D0, 0.00721D0, 0.00560D0,
51826 & 0.00425D0, 0.00310D0, 0.00215D0, 0.00160D0, 0.00107D0,
51827 & 0.00067D0, 0.00046D0, 0.00026D0, 0.00009D0, 0.00003D0,
51828 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
51829 DATA (FMRS(1,4,I,16),I=1,49)/
51830 & 3.10372D0, 2.55317D0, 2.09952D0, 1.87189D0, 1.72513D0,
51831 & 1.61899D0, 1.32738D0, 1.08482D0, 0.96174D0, 0.88163D0,
51832 & 0.82262D0, 0.65935D0, 0.52128D0, 0.45078D0, 0.40481D0,
51833 & 0.37132D0, 0.32407D0, 0.27766D0, 0.22852D0, 0.19522D0,
51834 & 0.14943D0, 0.11759D0, 0.09376D0, 0.07153D0, 0.05518D0,
51835 & 0.04316D0, 0.03411D0, 0.02721D0, 0.02189D0, 0.01771D0,
51836 & 0.01421D0, 0.01135D0, 0.00894D0, 0.00691D0, 0.00532D0,
51837 & 0.00403D0, 0.00292D0, 0.00202D0, 0.00150D0, 0.00098D0,
51838 & 0.00063D0, 0.00043D0, 0.00024D0, 0.00009D0, 0.00003D0,
51839 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
51840 DATA (FMRS(1,4,I,17),I=1,49)/
51841 & 3.53791D0, 2.88253D0, 2.34786D0, 2.08172D0, 1.91099D0,
51842 & 1.78798D0, 1.45224D0, 1.17581D0, 1.03669D0, 0.94660D0,
51843 & 0.88048D0, 0.69881D0, 0.54694D0, 0.47011D0, 0.42034D0,
51844 & 0.38424D0, 0.33357D0, 0.28414D0, 0.23224D0, 0.19739D0,
51845 & 0.14997D0, 0.11738D0, 0.09322D0, 0.07083D0, 0.05448D0,
51846 & 0.04248D0, 0.03349D0, 0.02663D0, 0.02135D0, 0.01720D0,
51847 & 0.01373D0, 0.01094D0, 0.00857D0, 0.00662D0, 0.00504D0,
51848 & 0.00382D0, 0.00275D0, 0.00191D0, 0.00140D0, 0.00091D0,
51849 & 0.00060D0, 0.00040D0, 0.00021D0, 0.00008D0, 0.00002D0,
51850 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
51851 DATA (FMRS(1,4,I,18),I=1,49)/
51852 & 3.93600D0, 3.18179D0, 2.57144D0, 2.26962D0, 2.07679D0,
51853 & 1.93828D0, 1.56224D0, 1.25519D0, 1.10169D0, 1.00271D0,
51854 & 0.93026D0, 0.73238D0, 0.56848D0, 0.48622D0, 0.43319D0,
51855 & 0.39487D0, 0.34131D0, 0.28936D0, 0.23517D0, 0.19905D0,
51856 & 0.15030D0, 0.11713D0, 0.09270D0, 0.07021D0, 0.05385D0,
51857 & 0.04190D0, 0.03295D0, 0.02612D0, 0.02087D0, 0.01677D0,
51858 & 0.01334D0, 0.01060D0, 0.00827D0, 0.00637D0, 0.00486D0,
51859 & 0.00366D0, 0.00263D0, 0.00181D0, 0.00134D0, 0.00088D0,
51860 & 0.00056D0, 0.00038D0, 0.00020D0, 0.00007D0, 0.00002D0,
51861 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
51862 DATA (FMRS(1,4,I,19),I=1,49)/
51863 & 4.46512D0, 3.57604D0, 2.86339D0, 2.51369D0, 2.29136D0,
51864 & 2.13222D0, 1.70289D0, 1.35573D0, 1.18356D0, 1.07308D0,
51865 & 0.99248D0, 0.77387D0, 0.59477D0, 0.50571D0, 0.44864D0,
51866 & 0.40759D0, 0.35048D0, 0.29545D0, 0.23852D0, 0.20087D0,
51867 & 0.15057D0, 0.11671D0, 0.09200D0, 0.06939D0, 0.05304D0,
51868 & 0.04116D0, 0.03225D0, 0.02548D0, 0.02030D0, 0.01627D0,
51869 & 0.01289D0, 0.01018D0, 0.00793D0, 0.00608D0, 0.00462D0,
51870 & 0.00346D0, 0.00247D0, 0.00170D0, 0.00124D0, 0.00082D0,
51871 & 0.00052D0, 0.00036D0, 0.00020D0, 0.00007D0, 0.00002D0,
51872 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
51873 DATA (FMRS(1,4,I,20),I=1,49)/
51874 & 4.98110D0, 3.95717D0, 3.14315D0, 2.74636D0, 2.49515D0,
51875 & 2.31589D0, 1.83490D0, 1.44924D0, 1.25928D0, 1.13790D0,
51876 & 1.04961D0, 0.81156D0, 0.61839D0, 0.52309D0, 0.46234D0,
51877 & 0.41880D0, 0.35851D0, 0.30072D0, 0.24136D0, 0.20237D0,
51878 & 0.15073D0, 0.11629D0, 0.09134D0, 0.06865D0, 0.05232D0,
51879 & 0.04048D0, 0.03163D0, 0.02492D0, 0.01980D0, 0.01582D0,
51880 & 0.01251D0, 0.00983D0, 0.00765D0, 0.00583D0, 0.00441D0,
51881 & 0.00330D0, 0.00234D0, 0.00161D0, 0.00116D0, 0.00076D0,
51882 & 0.00049D0, 0.00034D0, 0.00019D0, 0.00006D0, 0.00002D0,
51883 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
51884 DATA (FMRS(1,4,I,21),I=1,49)/
51885 & 5.48855D0, 4.32906D0, 3.41400D0, 2.97058D0, 2.69088D0,
51886 & 2.49185D0, 1.96033D0, 1.53734D0, 1.33025D0, 1.19843D0,
51887 & 1.10279D0, 0.84628D0, 0.63987D0, 0.53877D0, 0.47461D0,
51888 & 0.42879D0, 0.36557D0, 0.30530D0, 0.24373D0, 0.20356D0,
51889 & 0.15074D0, 0.11580D0, 0.09065D0, 0.06792D0, 0.05161D0,
51890 & 0.03984D0, 0.03104D0, 0.02440D0, 0.01932D0, 0.01538D0,
51891 & 0.01214D0, 0.00950D0, 0.00738D0, 0.00561D0, 0.00423D0,
51892 & 0.00315D0, 0.00224D0, 0.00152D0, 0.00110D0, 0.00072D0,
51893 & 0.00045D0, 0.00032D0, 0.00018D0, 0.00006D0, 0.00002D0,
51894 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
51895 DATA (FMRS(1,4,I,22),I=1,49)/
51896 & 6.18910D0, 4.83835D0, 3.78189D0, 3.27368D0, 2.95458D0,
51897 & 2.72828D0, 2.12748D0, 1.65375D0, 1.42355D0, 1.27771D0,
51898 & 1.17223D0, 0.89116D0, 0.66734D0, 0.55867D0, 0.49010D0,
51899 & 0.44134D0, 0.37438D0, 0.31092D0, 0.24658D0, 0.20493D0,
51900 & 0.15066D0, 0.11512D0, 0.08974D0, 0.06696D0, 0.05069D0,
51901 & 0.03901D0, 0.03030D0, 0.02374D0, 0.01874D0, 0.01485D0,
51902 & 0.01168D0, 0.00911D0, 0.00704D0, 0.00533D0, 0.00400D0,
51903 & 0.00297D0, 0.00211D0, 0.00142D0, 0.00104D0, 0.00068D0,
51904 & 0.00042D0, 0.00029D0, 0.00017D0, 0.00005D0, 0.00002D0,
51905 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
51906 DATA (FMRS(1,4,I,23),I=1,49)/
51907 & 6.90776D0, 5.35634D0, 4.15288D0, 3.57780D0, 3.21822D0,
51908 & 2.96398D0, 2.29266D0, 1.76775D0, 1.51442D0, 1.35462D0,
51909 & 1.23937D0, 0.93411D0, 0.69332D0, 0.57734D0, 0.50454D0,
51910 & 0.45297D0, 0.38246D0, 0.31600D0, 0.24910D0, 0.20608D0,
51911 & 0.15048D0, 0.11442D0, 0.08886D0, 0.06603D0, 0.04982D0,
51912 & 0.03823D0, 0.02961D0, 0.02314D0, 0.01820D0, 0.01437D0,
51913 & 0.01125D0, 0.00875D0, 0.00671D0, 0.00507D0, 0.00380D0,
51914 & 0.00282D0, 0.00198D0, 0.00134D0, 0.00099D0, 0.00065D0,
51915 & 0.00039D0, 0.00026D0, 0.00015D0, 0.00005D0, 0.00002D0,
51916 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
51917 DATA (FMRS(1,4,I,24),I=1,49)/
51918 & 7.62426D0, 5.86871D0, 4.51692D0, 3.87481D0, 3.47482D0,
51919 & 3.19280D0, 2.45168D0, 1.87657D0, 1.60070D0, 1.42736D0,
51920 & 1.30266D0, 0.97414D0, 0.71722D0, 0.59437D0, 0.51760D0,
51921 & 0.46341D0, 0.38962D0, 0.32042D0, 0.25117D0, 0.20694D0,
51922 & 0.15017D0, 0.11367D0, 0.08795D0, 0.06511D0, 0.04897D0,
51923 & 0.03748D0, 0.02894D0, 0.02253D0, 0.01769D0, 0.01392D0,
51924 & 0.01087D0, 0.00842D0, 0.00645D0, 0.00484D0, 0.00362D0,
51925 & 0.00267D0, 0.00187D0, 0.00128D0, 0.00093D0, 0.00060D0,
51926 & 0.00037D0, 0.00024D0, 0.00014D0, 0.00004D0, 0.00002D0,
51927 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
51928 DATA (FMRS(1,4,I,25),I=1,49)/
51929 & 8.39819D0, 6.41814D0, 4.90446D0, 4.18965D0, 3.74601D0,
51930 & 3.43405D0, 2.61811D0, 1.98959D0, 1.68991D0, 1.50231D0,
51931 & 1.36770D0, 1.01493D0, 0.74134D0, 0.61144D0, 0.53063D0,
51932 & 0.47380D0, 0.39668D0, 0.32474D0, 0.25316D0, 0.20772D0,
51933 & 0.14981D0, 0.11289D0, 0.08703D0, 0.06420D0, 0.04813D0,
51934 & 0.03673D0, 0.02828D0, 0.02194D0, 0.01719D0, 0.01349D0,
51935 & 0.01049D0, 0.00810D0, 0.00620D0, 0.00463D0, 0.00344D0,
51936 & 0.00252D0, 0.00177D0, 0.00122D0, 0.00086D0, 0.00056D0,
51937 & 0.00034D0, 0.00023D0, 0.00012D0, 0.00004D0, 0.00001D0,
51938 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
51939 DATA (FMRS(1,4,I,26),I=1,49)/
51940 & 9.19912D0, 6.98269D0, 5.29980D0, 4.50945D0, 4.02062D0,
51941 & 3.67776D0, 2.78497D0, 2.10203D0, 1.77824D0, 1.57626D0,
51942 & 1.43169D0, 1.05466D0, 0.76454D0, 0.62772D0, 0.54298D0,
51943 & 0.48357D0, 0.40325D0, 0.32867D0, 0.25488D0, 0.20830D0,
51944 & 0.14936D0, 0.11205D0, 0.08608D0, 0.06328D0, 0.04729D0,
51945 & 0.03598D0, 0.02762D0, 0.02140D0, 0.01669D0, 0.01307D0,
51946 & 0.01014D0, 0.00780D0, 0.00595D0, 0.00443D0, 0.00330D0,
51947 & 0.00240D0, 0.00168D0, 0.00114D0, 0.00081D0, 0.00053D0,
51948 & 0.00032D0, 0.00022D0, 0.00012D0, 0.00004D0, 0.00001D0,
51949 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
51950 DATA (FMRS(1,4,I,27),I=1,49)/
51951 & 10.00621D0, 7.54783D0, 5.69293D0, 4.82623D0, 4.29189D0,
51952 & 3.91798D0, 2.94832D0, 2.21133D0, 1.86373D0, 1.64761D0,
51953 & 1.49327D0, 1.09257D0, 0.78647D0, 0.64301D0, 0.55451D0,
51954 & 0.49265D0, 0.40930D0, 0.33223D0, 0.25638D0, 0.20876D0,
51955 & 0.14886D0, 0.11122D0, 0.08517D0, 0.06240D0, 0.04650D0,
51956 & 0.03528D0, 0.02702D0, 0.02089D0, 0.01623D0, 0.01267D0,
51957 & 0.00980D0, 0.00752D0, 0.00573D0, 0.00425D0, 0.00316D0,
51958 & 0.00230D0, 0.00159D0, 0.00107D0, 0.00077D0, 0.00050D0,
51959 & 0.00030D0, 0.00020D0, 0.00011D0, 0.00003D0, 0.00001D0,
51960 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
51961 DATA (FMRS(1,4,I,28),I=1,49)/
51962 & 10.80590D0, 8.10435D0, 6.07766D0, 5.13510D0, 4.55568D0,
51963 & 4.15111D0, 3.10583D0, 2.31601D0, 1.94527D0, 1.71546D0,
51964 & 1.55167D0, 1.12822D0, 0.80689D0, 0.65715D0, 0.56511D0,
51965 & 0.50095D0, 0.41476D0, 0.33539D0, 0.25764D0, 0.20907D0,
51966 & 0.14833D0, 0.11039D0, 0.08428D0, 0.06155D0, 0.04576D0,
51967 & 0.03462D0, 0.02647D0, 0.02040D0, 0.01582D0, 0.01230D0,
51968 & 0.00949D0, 0.00726D0, 0.00551D0, 0.00409D0, 0.00302D0,
51969 & 0.00221D0, 0.00152D0, 0.00102D0, 0.00073D0, 0.00048D0,
51970 & 0.00029D0, 0.00019D0, 0.00010D0, 0.00004D0, 0.00001D0,
51971 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
51972 DATA (FMRS(1,4,I,29),I=1,49)/
51973 & 11.65207D0, 8.68978D0, 6.48001D0, 5.45700D0, 4.82993D0,
51974 & 4.39300D0, 3.26826D0, 2.42329D0, 2.02852D0, 1.78454D0,
51975 & 1.61099D0, 1.16415D0, 0.82729D0, 0.67117D0, 0.57557D0,
51976 & 0.50910D0, 0.42008D0, 0.33842D0, 0.25880D0, 0.20930D0,
51977 & 0.14773D0, 0.10953D0, 0.08337D0, 0.06069D0, 0.04500D0,
51978 & 0.03397D0, 0.02591D0, 0.01991D0, 0.01541D0, 0.01194D0,
51979 & 0.00919D0, 0.00702D0, 0.00530D0, 0.00393D0, 0.00290D0,
51980 & 0.00211D0, 0.00145D0, 0.00096D0, 0.00070D0, 0.00045D0,
51981 & 0.00028D0, 0.00018D0, 0.00010D0, 0.00003D0, 0.00001D0,
51982 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
51983 DATA (FMRS(1,4,I,30),I=1,49)/
51984 & 12.52131D0, 9.28774D0, 6.88859D0, 5.78276D0, 5.10678D0,
51985 & 4.63673D0, 3.43094D0, 2.53005D0, 2.11104D0, 1.85281D0,
51986 & 1.66948D0, 1.19929D0, 0.84705D0, 0.68466D0, 0.58556D0,
51987 & 0.51685D0, 0.42507D0, 0.34121D0, 0.25979D0, 0.20942D0,
51988 & 0.14709D0, 0.10866D0, 0.08245D0, 0.05983D0, 0.04425D0,
51989 & 0.03334D0, 0.02536D0, 0.01943D0, 0.01501D0, 0.01160D0,
51990 & 0.00891D0, 0.00678D0, 0.00511D0, 0.00378D0, 0.00279D0,
51991 & 0.00202D0, 0.00138D0, 0.00091D0, 0.00067D0, 0.00043D0,
51992 & 0.00026D0, 0.00018D0, 0.00010D0, 0.00003D0, 0.00001D0,
51993 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
51994 DATA (FMRS(1,4,I,31),I=1,49)/
51995 & 13.38978D0, 9.88200D0, 7.29246D0, 6.10376D0, 5.37897D0,
51996 & 4.87592D0, 3.58970D0, 2.63365D0, 2.19084D0, 1.91866D0,
51997 & 1.72578D0, 1.23288D0, 0.86578D0, 0.69738D0, 0.59494D0,
51998 & 0.52409D0, 0.42970D0, 0.34375D0, 0.26065D0, 0.20947D0,
51999 & 0.14644D0, 0.10781D0, 0.08158D0, 0.05902D0, 0.04354D0,
52000 & 0.03274D0, 0.02484D0, 0.01899D0, 0.01463D0, 0.01128D0,
52001 & 0.00865D0, 0.00657D0, 0.00493D0, 0.00364D0, 0.00268D0,
52002 & 0.00194D0, 0.00132D0, 0.00087D0, 0.00064D0, 0.00041D0,
52003 & 0.00025D0, 0.00017D0, 0.00009D0, 0.00003D0, 0.00001D0,
52004 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52005 DATA (FMRS(1,4,I,32),I=1,49)/
52006 & 14.23688D0, 10.45864D0, 7.68231D0, 6.41264D0, 5.64030D0,
52007 & 5.10517D0, 3.74102D0, 2.73180D0, 2.26617D0, 1.98065D0,
52008 & 1.77865D0, 1.26417D0, 0.88305D0, 0.70902D0, 0.60346D0,
52009 & 0.53062D0, 0.43382D0, 0.34595D0, 0.26134D0, 0.20941D0,
52010 & 0.14577D0, 0.10696D0, 0.08072D0, 0.05825D0, 0.04287D0,
52011 & 0.03215D0, 0.02436D0, 0.01857D0, 0.01428D0, 0.01098D0,
52012 & 0.00840D0, 0.00638D0, 0.00476D0, 0.00351D0, 0.00258D0,
52013 & 0.00187D0, 0.00127D0, 0.00083D0, 0.00061D0, 0.00039D0,
52014 & 0.00024D0, 0.00016D0, 0.00009D0, 0.00002D0, 0.00001D0,
52015 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52016 DATA (FMRS(1,4,I,33),I=1,49)/
52017 & 15.13941D0, 11.07021D0, 8.09390D0, 6.73786D0, 5.91493D0,
52018 & 5.34574D0, 3.89907D0, 2.83385D0, 2.34427D0, 2.04479D0,
52019 & 1.83327D0, 1.29634D0, 0.90070D0, 0.72088D0, 0.61213D0,
52020 & 0.53725D0, 0.43798D0, 0.34817D0, 0.26202D0, 0.20935D0,
52021 & 0.14510D0, 0.10612D0, 0.07988D0, 0.05749D0, 0.04221D0,
52022 & 0.03158D0, 0.02388D0, 0.01816D0, 0.01393D0, 0.01069D0,
52023 & 0.00816D0, 0.00620D0, 0.00459D0, 0.00338D0, 0.00248D0,
52024 & 0.00179D0, 0.00121D0, 0.00080D0, 0.00058D0, 0.00037D0,
52025 & 0.00022D0, 0.00014D0, 0.00008D0, 0.00002D0, 0.00001D0,
52026 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52027 DATA (FMRS(1,4,I,34),I=1,49)/
52028 & 16.04276D0, 11.67919D0, 8.50158D0, 7.05899D0, 6.18548D0,
52029 & 5.58230D0, 4.05359D0, 2.93300D0, 2.41985D0, 2.10667D0,
52030 & 1.88583D0, 1.32700D0, 0.91732D0, 0.73194D0, 0.62013D0,
52031 & 0.54331D0, 0.44171D0, 0.35007D0, 0.26248D0, 0.20913D0,
52032 & 0.14434D0, 0.10523D0, 0.07901D0, 0.05671D0, 0.04155D0,
52033 & 0.03102D0, 0.02340D0, 0.01777D0, 0.01360D0, 0.01042D0,
52034 & 0.00793D0, 0.00600D0, 0.00446D0, 0.00326D0, 0.00238D0,
52035 & 0.00173D0, 0.00118D0, 0.00076D0, 0.00055D0, 0.00036D0,
52036 & 0.00022D0, 0.00014D0, 0.00007D0, 0.00002D0, 0.00001D0,
52037 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52038 DATA (FMRS(1,4,I,35),I=1,49)/
52039 & 16.94849D0, 12.28721D0, 8.90688D0, 7.37746D0, 6.45332D0,
52040 & 5.81617D0, 4.20570D0, 3.03017D0, 2.49373D0, 2.16705D0,
52041 & 1.93704D0, 1.35674D0, 0.93336D0, 0.74257D0, 0.62781D0,
52042 & 0.54911D0, 0.44527D0, 0.35187D0, 0.26291D0, 0.20892D0,
52043 & 0.14363D0, 0.10440D0, 0.07819D0, 0.05599D0, 0.04092D0,
52044 & 0.03050D0, 0.02296D0, 0.01740D0, 0.01329D0, 0.01017D0,
52045 & 0.00772D0, 0.00583D0, 0.00433D0, 0.00315D0, 0.00229D0,
52046 & 0.00167D0, 0.00114D0, 0.00073D0, 0.00053D0, 0.00035D0,
52047 & 0.00021D0, 0.00013D0, 0.00007D0, 0.00002D0, 0.00001D0,
52048 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52049 DATA (FMRS(1,4,I,36),I=1,49)/
52050 & 17.83243D0, 12.87802D0, 9.29900D0, 7.68475D0, 6.71127D0,
52051 & 6.04107D0, 4.35129D0, 3.12272D0, 2.56388D0, 2.22424D0,
52052 & 1.98545D0, 1.38466D0, 0.94830D0, 0.75241D0, 0.63488D0,
52053 & 0.55441D0, 0.44848D0, 0.35346D0, 0.26323D0, 0.20867D0,
52054 & 0.14292D0, 0.10358D0, 0.07741D0, 0.05529D0, 0.04033D0,
52055 & 0.03000D0, 0.02255D0, 0.01705D0, 0.01300D0, 0.00993D0,
52056 & 0.00753D0, 0.00566D0, 0.00421D0, 0.00306D0, 0.00221D0,
52057 & 0.00161D0, 0.00110D0, 0.00071D0, 0.00051D0, 0.00034D0,
52058 & 0.00020D0, 0.00013D0, 0.00007D0, 0.00002D0, 0.00001D0,
52059 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52060 DATA (FMRS(1,4,I,37),I=1,49)/
52061 & 18.74867D0, 13.48785D0, 9.70200D0, 7.99976D0, 6.97522D0,
52062 & 6.27087D0, 4.49936D0, 3.21639D0, 2.63465D0, 2.28182D0,
52063 & 2.03408D0, 1.41252D0, 0.96307D0, 0.76207D0, 0.64176D0,
52064 & 0.55956D0, 0.45155D0, 0.35492D0, 0.26347D0, 0.20834D0,
52065 & 0.14216D0, 0.10274D0, 0.07660D0, 0.05459D0, 0.03974D0,
52066 & 0.02950D0, 0.02213D0, 0.01670D0, 0.01272D0, 0.00970D0,
52067 & 0.00733D0, 0.00550D0, 0.00408D0, 0.00297D0, 0.00214D0,
52068 & 0.00155D0, 0.00105D0, 0.00068D0, 0.00049D0, 0.00032D0,
52069 & 0.00018D0, 0.00012D0, 0.00007D0, 0.00002D0, 0.00001D0,
52070 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52071 DATA (FMRS(1,4,I,38),I=1,49)/
52072 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52073 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52074 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52075 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52076 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52077 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52078 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52079 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52080 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52081 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52082 DATA (FMRS(1,5,I, 1),I=1,49)/
52083 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52084 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52085 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52086 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52087 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52088 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52089 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52090 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52091 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52092 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52093 DATA (FMRS(1,5,I, 2),I=1,49)/
52094 & 0.00003D0, 0.00003D0, 0.00002D0, 0.00002D0, 0.00002D0,
52095 & 0.00002D0, 0.00002D0, 0.00002D0, 0.00002D0, 0.00002D0,
52096 & 0.00002D0, 0.00002D0, 0.00002D0, 0.00002D0, 0.00002D0,
52097 & 0.00002D0, 0.00002D0, 0.00001D0, 0.00001D0, 0.00001D0,
52098 & 0.00001D0, 0.00001D0, 0.00001D0, 0.00001D0, 0.00001D0,
52099 & 0.00001D0, 0.00001D0, 0.00001D0, 0.00001D0, 0.00001D0,
52100 & 0.00001D0, 0.00001D0, 0.00001D0, 0.00000D0, 0.00000D0,
52101 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52102 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52103 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52104 DATA (FMRS(1,5,I, 3),I=1,49)/
52105 & 0.03227D0, 0.02900D0, 0.02605D0, 0.02445D0, 0.02338D0,
52106 & 0.02257D0, 0.02019D0, 0.01798D0, 0.01674D0, 0.01586D0,
52107 & 0.01516D0, 0.01302D0, 0.01084D0, 0.00956D0, 0.00865D0,
52108 & 0.00795D0, 0.00692D0, 0.00587D0, 0.00477D0, 0.00405D0,
52109 & 0.00317D0, 0.00263D0, 0.00225D0, 0.00190D0, 0.00163D0,
52110 & 0.00139D0, 0.00119D0, 0.00101D0, 0.00085D0, 0.00072D0,
52111 & 0.00059D0, 0.00048D0, 0.00039D0, 0.00031D0, 0.00025D0,
52112 & 0.00019D0, 0.00015D0, 0.00011D0, 0.00008D0, 0.00006D0,
52113 & 0.00004D0, 0.00003D0, 0.00002D0, 0.00001D0, 0.00000D0,
52114 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52115 DATA (FMRS(1,5,I, 4),I=1,49)/
52116 & 0.08412D0, 0.07493D0, 0.06672D0, 0.06231D0, 0.05935D0,
52117 & 0.05713D0, 0.05068D0, 0.04474D0, 0.04144D0, 0.03913D0,
52118 & 0.03731D0, 0.03177D0, 0.02623D0, 0.02303D0, 0.02077D0,
52119 & 0.01905D0, 0.01652D0, 0.01397D0, 0.01129D0, 0.00957D0,
52120 & 0.00745D0, 0.00615D0, 0.00525D0, 0.00441D0, 0.00375D0,
52121 & 0.00320D0, 0.00272D0, 0.00230D0, 0.00193D0, 0.00161D0,
52122 & 0.00132D0, 0.00108D0, 0.00087D0, 0.00069D0, 0.00054D0,
52123 & 0.00042D0, 0.00032D0, 0.00024D0, 0.00018D0, 0.00013D0,
52124 & 0.00009D0, 0.00006D0, 0.00004D0, 0.00001D0, 0.00000D0,
52125 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52126 DATA (FMRS(1,5,I, 5),I=1,49)/
52127 & 0.14877D0, 0.13082D0, 0.11499D0, 0.10659D0, 0.10097D0,
52128 & 0.09680D0, 0.08477D0, 0.07388D0, 0.06791D0, 0.06379D0,
52129 & 0.06056D0, 0.05091D0, 0.04152D0, 0.03619D0, 0.03249D0,
52130 & 0.02969D0, 0.02561D0, 0.02153D0, 0.01729D0, 0.01459D0,
52131 & 0.01127D0, 0.00925D0, 0.00785D0, 0.00655D0, 0.00553D0,
52132 & 0.00469D0, 0.00396D0, 0.00333D0, 0.00278D0, 0.00231D0,
52133 & 0.00189D0, 0.00153D0, 0.00123D0, 0.00097D0, 0.00076D0,
52134 & 0.00059D0, 0.00045D0, 0.00034D0, 0.00025D0, 0.00018D0,
52135 & 0.00012D0, 0.00009D0, 0.00006D0, 0.00001D0, 0.00000D0,
52136 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52137 DATA (FMRS(1,5,I, 6),I=1,49)/
52138 & 0.22202D0, 0.19306D0, 0.16779D0, 0.15452D0, 0.14570D0,
52139 & 0.13918D0, 0.12051D0, 0.10386D0, 0.09484D0, 0.08868D0,
52140 & 0.08388D0, 0.06972D0, 0.05624D0, 0.04872D0, 0.04355D0,
52141 & 0.03966D0, 0.03405D0, 0.02848D0, 0.02274D0, 0.01911D0,
52142 & 0.01466D0, 0.01197D0, 0.01011D0, 0.00838D0, 0.00703D0,
52143 & 0.00592D0, 0.00498D0, 0.00416D0, 0.00346D0, 0.00286D0,
52144 & 0.00233D0, 0.00188D0, 0.00150D0, 0.00118D0, 0.00092D0,
52145 & 0.00071D0, 0.00054D0, 0.00041D0, 0.00030D0, 0.00021D0,
52146 & 0.00015D0, 0.00010D0, 0.00007D0, 0.00001D0, 0.00000D0,
52147 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52148 DATA (FMRS(1,5,I, 7),I=1,49)/
52149 & 0.30272D0, 0.26063D0, 0.22430D0, 0.20535D0, 0.19284D0,
52150 & 0.18362D0, 0.15743D0, 0.13433D0, 0.12195D0, 0.11355D0,
52151 & 0.10705D0, 0.08808D0, 0.07034D0, 0.06058D0, 0.05394D0,
52152 & 0.04898D0, 0.04185D0, 0.03485D0, 0.02767D0, 0.02316D0,
52153 & 0.01766D0, 0.01434D0, 0.01204D0, 0.00992D0, 0.00828D0,
52154 & 0.00693D0, 0.00580D0, 0.00482D0, 0.00399D0, 0.00328D0,
52155 & 0.00266D0, 0.00214D0, 0.00170D0, 0.00133D0, 0.00104D0,
52156 & 0.00080D0, 0.00060D0, 0.00045D0, 0.00033D0, 0.00024D0,
52157 & 0.00016D0, 0.00011D0, 0.00007D0, 0.00001D0, 0.00000D0,
52158 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52159 DATA (FMRS(1,5,I, 8),I=1,49)/
52160 & 0.40640D0, 0.34641D0, 0.29514D0, 0.26863D0, 0.25121D0,
52161 & 0.23843D0, 0.20237D0, 0.17095D0, 0.15427D0, 0.14303D0,
52162 & 0.13440D0, 0.10944D0, 0.08650D0, 0.07407D0, 0.06568D0,
52163 & 0.05945D0, 0.05056D0, 0.04189D0, 0.03309D0, 0.02757D0,
52164 & 0.02089D0, 0.01686D0, 0.01408D0, 0.01153D0, 0.00956D0,
52165 & 0.00796D0, 0.00662D0, 0.00548D0, 0.00451D0, 0.00369D0,
52166 & 0.00298D0, 0.00239D0, 0.00189D0, 0.00148D0, 0.00114D0,
52167 & 0.00087D0, 0.00066D0, 0.00049D0, 0.00037D0, 0.00026D0,
52168 & 0.00018D0, 0.00012D0, 0.00007D0, 0.00001D0, 0.00000D0,
52169 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52170 DATA (FMRS(1,5,I, 9),I=1,49)/
52171 & 0.51210D0, 0.43288D0, 0.36574D0, 0.33126D0, 0.30871D0,
52172 & 0.29222D0, 0.24594D0, 0.20601D0, 0.18499D0, 0.17091D0,
52173 & 0.16014D0, 0.12927D0, 0.10130D0, 0.08631D0, 0.07626D0,
52174 & 0.06885D0, 0.05833D0, 0.04813D0, 0.03783D0, 0.03141D0,
52175 & 0.02366D0, 0.01900D0, 0.01580D0, 0.01287D0, 0.01061D0,
52176 & 0.00880D0, 0.00728D0, 0.00600D0, 0.00491D0, 0.00401D0,
52177 & 0.00322D0, 0.00257D0, 0.00203D0, 0.00158D0, 0.00122D0,
52178 & 0.00093D0, 0.00070D0, 0.00052D0, 0.00039D0, 0.00028D0,
52179 & 0.00018D0, 0.00012D0, 0.00007D0, 0.00001D0, 0.00000D0,
52180 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52181 DATA (FMRS(1,5,I,10),I=1,49)/
52182 & 0.62615D0, 0.52524D0, 0.44038D0, 0.39709D0, 0.36888D0,
52183 & 0.34831D0, 0.29091D0, 0.24179D0, 0.21613D0, 0.19903D0,
52184 & 0.18601D0, 0.14895D0, 0.11579D0, 0.09820D0, 0.08649D0,
52185 & 0.07789D0, 0.06575D0, 0.05404D0, 0.04228D0, 0.03498D0,
52186 & 0.02621D0, 0.02095D0, 0.01734D0, 0.01405D0, 0.01153D0,
52187 & 0.00952D0, 0.00784D0, 0.00644D0, 0.00525D0, 0.00426D0,
52188 & 0.00342D0, 0.00272D0, 0.00213D0, 0.00166D0, 0.00127D0,
52189 & 0.00097D0, 0.00073D0, 0.00054D0, 0.00040D0, 0.00029D0,
52190 & 0.00019D0, 0.00013D0, 0.00007D0, 0.00001D0, 0.00000D0,
52191 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52192 DATA (FMRS(1,5,I,11),I=1,49)/
52193 & 0.72756D0, 0.60673D0, 0.50572D0, 0.45443D0, 0.42111D0,
52194 & 0.39687D0, 0.32951D0, 0.27226D0, 0.24251D0, 0.22276D0,
52195 & 0.20777D0, 0.16535D0, 0.12775D0, 0.10795D0, 0.09484D0,
52196 & 0.08524D0, 0.07175D0, 0.05879D0, 0.04583D0, 0.03782D0,
52197 & 0.02821D0, 0.02247D0, 0.01853D0, 0.01496D0, 0.01223D0,
52198 & 0.01005D0, 0.00826D0, 0.00676D0, 0.00549D0, 0.00445D0,
52199 & 0.00355D0, 0.00282D0, 0.00221D0, 0.00171D0, 0.00131D0,
52200 & 0.00099D0, 0.00074D0, 0.00055D0, 0.00041D0, 0.00029D0,
52201 & 0.00019D0, 0.00013D0, 0.00007D0, 0.00001D0, 0.00000D0,
52202 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52203 DATA (FMRS(1,5,I,12),I=1,49)/
52204 & 0.97596D0, 0.80419D0, 0.66232D0, 0.59100D0, 0.54494D0,
52205 & 0.51159D0, 0.41968D0, 0.34257D0, 0.30297D0, 0.27688D0,
52206 & 0.25720D0, 0.20210D0, 0.15417D0, 0.12932D0, 0.11303D0,
52207 & 0.10119D0, 0.08465D0, 0.06892D0, 0.05333D0, 0.04376D0,
52208 & 0.03235D0, 0.02557D0, 0.02094D0, 0.01675D0, 0.01359D0,
52209 & 0.01109D0, 0.00904D0, 0.00734D0, 0.00594D0, 0.00477D0,
52210 & 0.00379D0, 0.00299D0, 0.00233D0, 0.00179D0, 0.00137D0,
52211 & 0.00103D0, 0.00077D0, 0.00057D0, 0.00042D0, 0.00030D0,
52212 & 0.00019D0, 0.00013D0, 0.00007D0, 0.00001D0, 0.00000D0,
52213 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52214 DATA (FMRS(1,5,I,13),I=1,49)/
52215 & 1.22977D0, 1.00344D0, 0.81836D0, 0.72605D0, 0.66675D0,
52216 & 0.62396D0, 0.50684D0, 0.40963D0, 0.36016D0, 0.32776D0,
52217 & 0.30345D0, 0.23597D0, 0.17813D0, 0.14851D0, 0.12924D0,
52218 & 0.11531D0, 0.09599D0, 0.07773D0, 0.05977D0, 0.04882D0,
52219 & 0.03581D0, 0.02811D0, 0.02289D0, 0.01818D0, 0.01465D0,
52220 & 0.01187D0, 0.00963D0, 0.00777D0, 0.00625D0, 0.00500D0,
52221 & 0.00395D0, 0.00310D0, 0.00241D0, 0.00185D0, 0.00140D0,
52222 & 0.00105D0, 0.00078D0, 0.00058D0, 0.00043D0, 0.00031D0,
52223 & 0.00019D0, 0.00013D0, 0.00007D0, 0.00001D0, 0.00000D0,
52224 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52225 DATA (FMRS(1,5,I,14),I=1,49)/
52226 & 1.55816D0, 1.25825D0, 1.01555D0, 0.89552D0, 0.81883D0,
52227 & 0.76371D0, 0.61389D0, 0.49095D0, 0.42897D0, 0.38864D0,
52228 & 0.35854D0, 0.27572D0, 0.20581D0, 0.17047D0, 0.14766D0,
52229 & 0.13128D0, 0.10869D0, 0.08751D0, 0.06683D0, 0.05430D0,
52230 & 0.03950D0, 0.03078D0, 0.02489D0, 0.01962D0, 0.01569D0,
52231 & 0.01264D0, 0.01018D0, 0.00817D0, 0.00653D0, 0.00519D0,
52232 & 0.00408D0, 0.00319D0, 0.00246D0, 0.00188D0, 0.00142D0,
52233 & 0.00106D0, 0.00078D0, 0.00058D0, 0.00043D0, 0.00031D0,
52234 & 0.00019D0, 0.00012D0, 0.00007D0, 0.00001D0, 0.00000D0,
52235 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52236 DATA (FMRS(1,5,I,15),I=1,49)/
52237 & 1.94525D0, 1.55494D0, 1.24230D0, 1.08896D0, 0.99149D0,
52238 & 0.92172D0, 0.73335D0, 0.58046D0, 0.50409D0, 0.45471D0,
52239 & 0.41801D0, 0.31797D0, 0.23473D0, 0.19316D0, 0.16655D0,
52240 & 0.14754D0, 0.12149D0, 0.09725D0, 0.07376D0, 0.05961D0,
52241 & 0.04299D0, 0.03326D0, 0.02672D0, 0.02089D0, 0.01659D0,
52242 & 0.01327D0, 0.01061D0, 0.00847D0, 0.00673D0, 0.00532D0,
52243 & 0.00416D0, 0.00323D0, 0.00248D0, 0.00188D0, 0.00142D0,
52244 & 0.00105D0, 0.00077D0, 0.00057D0, 0.00042D0, 0.00031D0,
52245 & 0.00019D0, 0.00012D0, 0.00007D0, 0.00001D0, 0.00000D0,
52246 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52247 DATA (FMRS(1,5,I,16),I=1,49)/
52248 & 2.34531D0, 1.85826D0, 1.47159D0, 1.28330D0, 1.16416D0,
52249 & 1.07915D0, 0.85101D0, 0.66758D0, 0.57668D0, 0.51821D0,
52250 & 0.47495D0, 0.35786D0, 0.26164D0, 0.21408D0, 0.18385D0,
52251 & 0.16236D0, 0.13305D0, 0.10596D0, 0.07987D0, 0.06425D0,
52252 & 0.04599D0, 0.03535D0, 0.02822D0, 0.02192D0, 0.01729D0,
52253 & 0.01375D0, 0.01093D0, 0.00867D0, 0.00685D0, 0.00540D0,
52254 & 0.00420D0, 0.00325D0, 0.00248D0, 0.00188D0, 0.00141D0,
52255 & 0.00104D0, 0.00076D0, 0.00056D0, 0.00041D0, 0.00030D0,
52256 & 0.00018D0, 0.00011D0, 0.00006D0, 0.00001D0, 0.00000D0,
52257 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52258 DATA (FMRS(1,5,I,17),I=1,49)/
52259 & 2.80142D0, 2.20072D0, 1.72790D0, 1.49927D0, 1.35523D0,
52260 & 1.25280D0, 0.97945D0, 0.76167D0, 0.65458D0, 0.58603D0,
52261 & 0.53553D0, 0.39978D0, 0.28955D0, 0.23561D0, 0.20153D0,
52262 & 0.17743D0, 0.14473D0, 0.11467D0, 0.08591D0, 0.06880D0,
52263 & 0.04888D0, 0.03733D0, 0.02963D0, 0.02285D0, 0.01791D0,
52264 & 0.01415D0, 0.01119D0, 0.00883D0, 0.00694D0, 0.00544D0,
52265 & 0.00421D0, 0.00324D0, 0.00247D0, 0.00186D0, 0.00139D0,
52266 & 0.00102D0, 0.00075D0, 0.00055D0, 0.00040D0, 0.00029D0,
52267 & 0.00018D0, 0.00011D0, 0.00006D0, 0.00001D0, 0.00000D0,
52268 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52269 DATA (FMRS(1,5,I,18),I=1,49)/
52270 & 3.21652D0, 2.50960D0, 1.95700D0, 1.69126D0, 1.52443D0,
52271 & 1.40610D0, 1.09176D0, 0.84313D0, 0.72161D0, 0.64414D0,
52272 & 0.58724D0, 0.43516D0, 0.31280D0, 0.25339D0, 0.21606D0,
52273 & 0.18974D0, 0.15419D0, 0.12166D0, 0.09071D0, 0.07236D0,
52274 & 0.05109D0, 0.03882D0, 0.03067D0, 0.02352D0, 0.01834D0,
52275 & 0.01442D0, 0.01135D0, 0.00892D0, 0.00699D0, 0.00545D0,
52276 & 0.00421D0, 0.00322D0, 0.00245D0, 0.00184D0, 0.00137D0,
52277 & 0.00100D0, 0.00073D0, 0.00053D0, 0.00039D0, 0.00029D0,
52278 & 0.00017D0, 0.00010D0, 0.00006D0, 0.00001D0, 0.00000D0,
52279 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52280 DATA (FMRS(1,5,I,19),I=1,49)/
52281 & 3.76652D0, 2.91536D0, 2.25532D0, 1.93997D0, 1.74280D0,
52282 & 1.60338D0, 1.23496D0, 0.94601D0, 0.80577D0, 0.71678D0,
52283 & 0.65167D0, 0.47873D0, 0.34109D0, 0.27487D0, 0.23349D0,
52284 & 0.20445D0, 0.16541D0, 0.12988D0, 0.09628D0, 0.07646D0,
52285 & 0.05359D0, 0.04046D0, 0.03178D0, 0.02422D0, 0.01877D0,
52286 & 0.01467D0, 0.01149D0, 0.00898D0, 0.00700D0, 0.00543D0,
52287 & 0.00418D0, 0.00319D0, 0.00241D0, 0.00180D0, 0.00134D0,
52288 & 0.00098D0, 0.00071D0, 0.00052D0, 0.00038D0, 0.00028D0,
52289 & 0.00017D0, 0.00010D0, 0.00006D0, 0.00001D0, 0.00000D0,
52290 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52291 DATA (FMRS(1,5,I,20),I=1,49)/
52292 & 4.30575D0, 3.30993D0, 2.54302D0, 2.17866D0, 1.95165D0,
52293 & 1.79153D0, 1.37036D0, 1.04242D0, 0.88422D0, 0.78423D0,
52294 & 0.71130D0, 0.51866D0, 0.36673D0, 0.29419D0, 0.24910D0,
52295 & 0.21757D0, 0.17534D0, 0.13711D0, 0.10112D0, 0.07999D0,
52296 & 0.05571D0, 0.04184D0, 0.03270D0, 0.02477D0, 0.01909D0,
52297 & 0.01486D0, 0.01158D0, 0.00901D0, 0.00699D0, 0.00541D0,
52298 & 0.00414D0, 0.00315D0, 0.00237D0, 0.00177D0, 0.00131D0,
52299 & 0.00095D0, 0.00069D0, 0.00050D0, 0.00037D0, 0.00027D0,
52300 & 0.00016D0, 0.00009D0, 0.00005D0, 0.00001D0, 0.00000D0,
52301 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52302 DATA (FMRS(1,5,I,21),I=1,49)/
52303 & 4.82956D0, 3.69021D0, 2.81808D0, 2.40576D0, 2.14966D0,
52304 & 1.96944D0, 1.49728D0, 1.13198D0, 0.95669D0, 0.84628D0,
52305 & 0.76597D0, 0.55486D0, 0.38968D0, 0.31136D0, 0.26288D0,
52306 & 0.22909D0, 0.18399D0, 0.14333D0, 0.10523D0, 0.08295D0,
52307 & 0.05744D0, 0.04293D0, 0.03340D0, 0.02518D0, 0.01931D0,
52308 & 0.01496D0, 0.01161D0, 0.00900D0, 0.00696D0, 0.00536D0,
52309 & 0.00409D0, 0.00310D0, 0.00233D0, 0.00173D0, 0.00128D0,
52310 & 0.00093D0, 0.00067D0, 0.00049D0, 0.00036D0, 0.00027D0,
52311 & 0.00015D0, 0.00009D0, 0.00005D0, 0.00001D0, 0.00000D0,
52312 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52313 DATA (FMRS(1,5,I,22),I=1,49)/
52314 & 5.55546D0, 4.21326D0, 3.19353D0, 2.71436D0, 2.41786D0,
52315 & 2.20981D0, 1.66741D0, 1.25104D0, 1.05255D0, 0.92807D0,
52316 & 0.83783D0, 0.60198D0, 0.41926D0, 0.33333D0, 0.28043D0,
52317 & 0.24370D0, 0.19489D0, 0.15111D0, 0.11032D0, 0.08657D0,
52318 & 0.05953D0, 0.04421D0, 0.03422D0, 0.02563D0, 0.01955D0,
52319 & 0.01506D0, 0.01163D0, 0.00897D0, 0.00690D0, 0.00529D0,
52320 & 0.00403D0, 0.00304D0, 0.00227D0, 0.00168D0, 0.00124D0,
52321 & 0.00090D0, 0.00064D0, 0.00047D0, 0.00035D0, 0.00026D0,
52322 & 0.00015D0, 0.00008D0, 0.00005D0, 0.00001D0, 0.00000D0,
52323 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52324 DATA (FMRS(1,5,I,23),I=1,49)/
52325 & 6.30033D0, 4.74567D0, 3.57260D0, 3.02443D0, 2.68642D0,
52326 & 2.44984D0, 1.83585D0, 1.36787D0, 1.14612D0, 1.00758D0,
52327 & 0.90746D0, 0.64718D0, 0.44730D0, 0.35401D0, 0.29686D0,
52328 & 0.25731D0, 0.20497D0, 0.15824D0, 0.11492D0, 0.08982D0,
52329 & 0.06136D0, 0.04532D0, 0.03489D0, 0.02598D0, 0.01971D0,
52330 & 0.01511D0, 0.01161D0, 0.00892D0, 0.00683D0, 0.00522D0,
52331 & 0.00395D0, 0.00297D0, 0.00222D0, 0.00163D0, 0.00120D0,
52332 & 0.00087D0, 0.00062D0, 0.00045D0, 0.00034D0, 0.00025D0,
52333 & 0.00014D0, 0.00008D0, 0.00005D0, 0.00001D0, 0.00000D0,
52334 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52335 DATA (FMRS(1,5,I,24),I=1,49)/
52336 & 7.03684D0, 5.26796D0, 3.94145D0, 3.32468D0, 2.94556D0,
52337 & 2.68082D0, 1.99651D0, 1.47829D0, 1.23404D0, 1.08198D0,
52338 & 0.97239D0, 0.68884D0, 0.47281D0, 0.37266D0, 0.31157D0,
52339 & 0.26944D0, 0.21386D0, 0.16445D0, 0.11886D0, 0.09256D0,
52340 & 0.06285D0, 0.04618D0, 0.03539D0, 0.02621D0, 0.01979D0,
52341 & 0.01510D0, 0.01155D0, 0.00884D0, 0.00675D0, 0.00513D0,
52342 & 0.00387D0, 0.00290D0, 0.00216D0, 0.00159D0, 0.00116D0,
52343 & 0.00084D0, 0.00060D0, 0.00044D0, 0.00033D0, 0.00024D0,
52344 & 0.00014D0, 0.00007D0, 0.00004D0, 0.00001D0, 0.00000D0,
52345 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52346 DATA (FMRS(1,5,I,25),I=1,49)/
52347 & 7.83575D0, 5.83079D0, 4.33631D0, 3.64485D0, 3.22112D0,
52348 & 2.92590D0, 2.16582D0, 1.59383D0, 1.32566D0, 1.15927D0,
52349 & 1.03966D0, 0.73165D0, 0.49881D0, 0.39156D0, 0.32642D0,
52350 & 0.28163D0, 0.22275D0, 0.17063D0, 0.12274D0, 0.09523D0,
52351 & 0.06428D0, 0.04699D0, 0.03585D0, 0.02642D0, 0.01984D0,
52352 & 0.01507D0, 0.01148D0, 0.00875D0, 0.00665D0, 0.00505D0,
52353 & 0.00380D0, 0.00284D0, 0.00210D0, 0.00154D0, 0.00112D0,
52354 & 0.00081D0, 0.00058D0, 0.00042D0, 0.00031D0, 0.00024D0,
52355 & 0.00014D0, 0.00007D0, 0.00004D0, 0.00001D0, 0.00000D0,
52356 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52357 DATA (FMRS(1,5,I,26),I=1,49)/
52358 & 8.65815D0, 6.40607D0, 4.73699D0, 3.96832D0, 3.49865D0,
52359 & 3.17213D0, 2.33459D0, 1.70806D0, 1.41577D0, 1.23500D0,
52360 & 1.10538D0, 0.77305D0, 0.52365D0, 0.40947D0, 0.34040D0,
52361 & 0.29306D0, 0.23101D0, 0.17630D0, 0.12625D0, 0.09761D0,
52362 & 0.06550D0, 0.04766D0, 0.03620D0, 0.02654D0, 0.01984D0,
52363 & 0.01501D0, 0.01139D0, 0.00864D0, 0.00655D0, 0.00495D0,
52364 & 0.00371D0, 0.00276D0, 0.00204D0, 0.00149D0, 0.00108D0,
52365 & 0.00078D0, 0.00056D0, 0.00041D0, 0.00030D0, 0.00023D0,
52366 & 0.00014D0, 0.00007D0, 0.00004D0, 0.00001D0, 0.00000D0,
52367 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52368 DATA (FMRS(1,5,I,27),I=1,49)/
52369 & 9.48773D0, 6.98283D0, 5.13620D0, 4.28942D0, 3.77342D0,
52370 & 3.41540D0, 2.50025D0, 1.81942D0, 1.50325D0, 1.30829D0,
52371 & 1.16884D0, 0.81270D0, 0.54722D0, 0.42638D0, 0.35354D0,
52372 & 0.30375D0, 0.23869D0, 0.18153D0, 0.12945D0, 0.09975D0,
52373 & 0.06658D0, 0.04823D0, 0.03648D0, 0.02662D0, 0.01982D0,
52374 & 0.01493D0, 0.01129D0, 0.00853D0, 0.00645D0, 0.00486D0,
52375 & 0.00363D0, 0.00270D0, 0.00199D0, 0.00145D0, 0.00105D0,
52376 & 0.00075D0, 0.00054D0, 0.00039D0, 0.00030D0, 0.00022D0,
52377 & 0.00014D0, 0.00007D0, 0.00004D0, 0.00001D0, 0.00000D0,
52378 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52379 DATA (FMRS(1,5,I,28),I=1,49)/
52380 & 10.30763D0, 7.54945D0, 5.52601D0, 4.60181D0, 4.04004D0,
52381 & 3.65097D0, 2.65960D0, 1.92581D0, 1.58647D0, 1.37780D0,
52382 & 1.22885D0, 0.84989D0, 0.56911D0, 0.44198D0, 0.36560D0,
52383 & 0.31352D0, 0.24565D0, 0.18623D0, 0.13228D0, 0.10162D0,
52384 & 0.06750D0, 0.04868D0, 0.03669D0, 0.02666D0, 0.01976D0,
52385 & 0.01484D0, 0.01118D0, 0.00842D0, 0.00635D0, 0.00477D0,
52386 & 0.00355D0, 0.00263D0, 0.00193D0, 0.00141D0, 0.00102D0,
52387 & 0.00073D0, 0.00052D0, 0.00038D0, 0.00029D0, 0.00022D0,
52388 & 0.00014D0, 0.00007D0, 0.00004D0, 0.00001D0, 0.00000D0,
52389 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52390 DATA (FMRS(1,5,I,29),I=1,49)/
52391 & 11.17527D0, 8.14579D0, 5.93397D0, 4.92768D0, 4.31749D0,
52392 & 3.89565D0, 2.82415D0, 2.03499D0, 1.67156D0, 1.44867D0,
52393 & 1.28991D0, 0.88743D0, 0.59103D0, 0.45751D0, 0.37756D0,
52394 & 0.32318D0, 0.25249D0, 0.19081D0, 0.13501D0, 0.10341D0,
52395 & 0.06835D0, 0.04909D0, 0.03686D0, 0.02667D0, 0.01969D0,
52396 & 0.01473D0, 0.01106D0, 0.00831D0, 0.00624D0, 0.00467D0,
52397 & 0.00347D0, 0.00257D0, 0.00188D0, 0.00136D0, 0.00099D0,
52398 & 0.00070D0, 0.00050D0, 0.00037D0, 0.00028D0, 0.00021D0,
52399 & 0.00014D0, 0.00007D0, 0.00004D0, 0.00001D0, 0.00000D0,
52400 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52401 DATA (FMRS(1,5,I,30),I=1,49)/
52402 & 12.06456D0, 8.75358D0, 6.34740D0, 5.25678D0, 4.59701D0,
52403 & 4.14168D0, 2.98858D0, 2.14338D0, 1.75569D0, 1.51853D0,
52404 & 1.34994D0, 0.92405D0, 0.61221D0, 0.47241D0, 0.38898D0,
52405 & 0.33235D0, 0.25894D0, 0.19508D0, 0.13752D0, 0.10502D0,
52406 & 0.06908D0, 0.04942D0, 0.03697D0, 0.02664D0, 0.01960D0,
52407 & 0.01461D0, 0.01093D0, 0.00819D0, 0.00613D0, 0.00458D0,
52408 & 0.00339D0, 0.00250D0, 0.00183D0, 0.00132D0, 0.00095D0,
52409 & 0.00068D0, 0.00049D0, 0.00036D0, 0.00027D0, 0.00021D0,
52410 & 0.00014D0, 0.00007D0, 0.00004D0, 0.00001D0, 0.00000D0,
52411 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52412 DATA (FMRS(1,5,I,31),I=1,49)/
52413 & 12.95374D0, 9.35831D0, 6.75669D0, 5.58162D0, 4.87232D0,
52414 & 4.38360D0, 3.14942D0, 2.24882D0, 1.83726D0, 1.58610D0,
52415 & 1.40790D0, 0.95916D0, 0.63237D0, 0.48653D0, 0.39975D0,
52416 & 0.34099D0, 0.26498D0, 0.19905D0, 0.13983D0, 0.10648D0,
52417 & 0.06974D0, 0.04970D0, 0.03705D0, 0.02660D0, 0.01950D0,
52418 & 0.01449D0, 0.01081D0, 0.00807D0, 0.00603D0, 0.00449D0,
52419 & 0.00332D0, 0.00244D0, 0.00178D0, 0.00129D0, 0.00093D0,
52420 & 0.00066D0, 0.00047D0, 0.00035D0, 0.00026D0, 0.00020D0,
52421 & 0.00013D0, 0.00007D0, 0.00004D0, 0.00001D0, 0.00000D0,
52422 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52423 DATA (FMRS(1,5,I,32),I=1,49)/
52424 & 13.81822D0, 9.94319D0, 7.15042D0, 5.89310D0, 5.13569D0,
52425 & 4.61461D0, 3.30209D0, 2.34827D0, 1.91389D0, 1.64940D0,
52426 & 1.46205D0, 0.99170D0, 0.65086D0, 0.49940D0, 0.40952D0,
52427 & 0.34877D0, 0.27037D0, 0.20256D0, 0.14182D0, 0.10773D0,
52428 & 0.07026D0, 0.04989D0, 0.03708D0, 0.02652D0, 0.01938D0,
52429 & 0.01436D0, 0.01068D0, 0.00795D0, 0.00592D0, 0.00440D0,
52430 & 0.00325D0, 0.00238D0, 0.00174D0, 0.00125D0, 0.00090D0,
52431 & 0.00064D0, 0.00046D0, 0.00034D0, 0.00026D0, 0.00020D0,
52432 & 0.00013D0, 0.00007D0, 0.00004D0, 0.00001D0, 0.00000D0,
52433 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52434 DATA (FMRS(1,5,I,33),I=1,49)/
52435 & 14.74174D0, 10.56553D0, 7.56770D0, 6.22245D0, 5.41371D0,
52436 & 4.85814D0, 3.46239D0, 2.45228D0, 1.99384D0, 1.71531D0,
52437 & 1.51837D0, 1.02539D0, 0.66993D0, 0.51263D0, 0.41953D0,
52438 & 0.35674D0, 0.27589D0, 0.20614D0, 0.14386D0, 0.10899D0,
52439 & 0.07078D0, 0.05009D0, 0.03711D0, 0.02645D0, 0.01927D0,
52440 & 0.01422D0, 0.01055D0, 0.00784D0, 0.00582D0, 0.00432D0,
52441 & 0.00318D0, 0.00233D0, 0.00169D0, 0.00122D0, 0.00087D0,
52442 & 0.00062D0, 0.00044D0, 0.00033D0, 0.00025D0, 0.00020D0,
52443 & 0.00013D0, 0.00007D0, 0.00004D0, 0.00001D0, 0.00000D0,
52444 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52445 DATA (FMRS(1,5,I,34),I=1,49)/
52446 & 15.66159D0, 11.18202D0, 7.97872D0, 6.54573D0, 5.68591D0,
52447 & 5.09611D0, 3.61802D0, 2.55254D0, 2.07056D0, 1.77835D0,
52448 & 1.57208D0, 1.05721D0, 0.68771D0, 0.52486D0, 0.42872D0,
52449 & 0.36401D0, 0.28085D0, 0.20931D0, 0.14560D0, 0.11004D0,
52450 & 0.07117D0, 0.05019D0, 0.03707D0, 0.02633D0, 0.01912D0,
52451 & 0.01408D0, 0.01041D0, 0.00771D0, 0.00572D0, 0.00423D0,
52452 & 0.00311D0, 0.00227D0, 0.00165D0, 0.00118D0, 0.00085D0,
52453 & 0.00060D0, 0.00043D0, 0.00032D0, 0.00025D0, 0.00020D0,
52454 & 0.00013D0, 0.00007D0, 0.00004D0, 0.00001D0, 0.00000D0,
52455 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52456 DATA (FMRS(1,5,I,35),I=1,49)/
52457 & 16.58568D0, 11.79905D0, 8.38856D0, 6.86738D0, 5.95633D0,
52458 & 5.33223D0, 3.77185D0, 2.65127D0, 2.14594D0, 1.84019D0,
52459 & 1.62469D0, 1.08825D0, 0.70498D0, 0.53670D0, 0.43761D0,
52460 & 0.37103D0, 0.28563D0, 0.21235D0, 0.14727D0, 0.11103D0,
52461 & 0.07154D0, 0.05029D0, 0.03704D0, 0.02622D0, 0.01898D0,
52462 & 0.01394D0, 0.01028D0, 0.00760D0, 0.00562D0, 0.00415D0,
52463 & 0.00304D0, 0.00222D0, 0.00161D0, 0.00115D0, 0.00082D0,
52464 & 0.00058D0, 0.00042D0, 0.00031D0, 0.00024D0, 0.00019D0,
52465 & 0.00013D0, 0.00007D0, 0.00004D0, 0.00001D0, 0.00000D0,
52466 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52467 DATA (FMRS(1,5,I,36),I=1,49)/
52468 & 17.48656D0, 12.39804D0, 8.78469D0, 7.17746D0, 6.21652D0,
52469 & 5.55909D0, 3.91895D0, 2.74520D0, 2.21743D0, 1.89869D0,
52470 & 1.67437D0, 1.11736D0, 0.72106D0, 0.54767D0, 0.44580D0,
52471 & 0.37747D0, 0.28999D0, 0.21509D0, 0.14875D0, 0.11190D0,
52472 & 0.07184D0, 0.05035D0, 0.03698D0, 0.02610D0, 0.01884D0,
52473 & 0.01380D0, 0.01016D0, 0.00749D0, 0.00553D0, 0.00407D0,
52474 & 0.00298D0, 0.00217D0, 0.00157D0, 0.00112D0, 0.00080D0,
52475 & 0.00057D0, 0.00041D0, 0.00031D0, 0.00024D0, 0.00019D0,
52476 & 0.00013D0, 0.00007D0, 0.00004D0, 0.00001D0, 0.00000D0,
52477 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52478 DATA (FMRS(1,5,I,37),I=1,49)/
52479 & 18.41889D0, 13.01534D0, 9.19117D0, 7.49481D0, 6.48233D0,
52480 & 5.79049D0, 4.06828D0, 2.84006D0, 2.28940D0, 1.95745D0,
52481 & 1.72416D0, 1.14634D0, 0.73693D0, 0.55843D0, 0.45379D0,
52482 & 0.38373D0, 0.29419D0, 0.21770D0, 0.15013D0, 0.11269D0,
52483 & 0.07209D0, 0.05037D0, 0.03690D0, 0.02596D0, 0.01869D0,
52484 & 0.01365D0, 0.01003D0, 0.00738D0, 0.00543D0, 0.00399D0,
52485 & 0.00291D0, 0.00212D0, 0.00153D0, 0.00109D0, 0.00078D0,
52486 & 0.00055D0, 0.00040D0, 0.00030D0, 0.00023D0, 0.00019D0,
52487 & 0.00013D0, 0.00007D0, 0.00004D0, 0.00001D0, 0.00000D0,
52488 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52489 DATA (FMRS(1,5,I,38),I=1,49)/
52490 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52491 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52492 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52493 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52494 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52495 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52496 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52497 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52498 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52499 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52500 DATA (FMRS(1,6,I, 1),I=1,49)/
52501 & 0.44989D0, 0.39539D0, 0.34747D0, 0.32216D0, 0.30531D0,
52502 & 0.29285D0, 0.25722D0, 0.22578D0, 0.20909D0, 0.19792D0,
52503 & 0.18955D0, 0.16547D0, 0.14378D0, 0.13212D0, 0.12429D0,
52504 & 0.11845D0, 0.11003D0, 0.10150D0, 0.09208D0, 0.08532D0,
52505 & 0.07497D0, 0.06641D0, 0.05872D0, 0.04993D0, 0.04200D0,
52506 & 0.03492D0, 0.02867D0, 0.02327D0, 0.01867D0, 0.01463D0,
52507 & 0.01149D0, 0.00885D0, 0.00675D0, 0.00511D0, 0.00375D0,
52508 & 0.00275D0, 0.00200D0, 0.00140D0, 0.00092D0, 0.00067D0,
52509 & 0.00045D0, 0.00028D0, 0.00020D0, 0.00007D0, 0.00002D0,
52510 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52511 DATA (FMRS(1,6,I, 2),I=1,49)/
52512 & 0.46639D0, 0.41136D0, 0.36279D0, 0.33706D0, 0.31990D0,
52513 & 0.30719D0, 0.27073D0, 0.23840D0, 0.22115D0, 0.20956D0,
52514 & 0.20084D0, 0.17557D0, 0.15249D0, 0.13993D0, 0.13142D0,
52515 & 0.12504D0, 0.11578D0, 0.10635D0, 0.09591D0, 0.08845D0,
52516 & 0.07719D0, 0.06805D0, 0.05996D0, 0.05084D0, 0.04269D0,
52517 & 0.03544D0, 0.02909D0, 0.02361D0, 0.01895D0, 0.01488D0,
52518 & 0.01169D0, 0.00902D0, 0.00689D0, 0.00524D0, 0.00385D0,
52519 & 0.00283D0, 0.00206D0, 0.00146D0, 0.00096D0, 0.00071D0,
52520 & 0.00048D0, 0.00029D0, 0.00022D0, 0.00008D0, 0.00002D0,
52521 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52522 DATA (FMRS(1,6,I, 3),I=1,49)/
52523 & 0.50684D0, 0.44821D0, 0.39632D0, 0.36876D0, 0.35036D0,
52524 & 0.33670D0, 0.29743D0, 0.26242D0, 0.24363D0, 0.23094D0,
52525 & 0.22132D0, 0.19327D0, 0.16725D0, 0.15293D0, 0.14314D0,
52526 & 0.13576D0, 0.12501D0, 0.11402D0, 0.10188D0, 0.09328D0,
52527 & 0.08055D0, 0.07049D0, 0.06177D0, 0.05212D0, 0.04362D0,
52528 & 0.03613D0, 0.02960D0, 0.02400D0, 0.01926D0, 0.01513D0,
52529 & 0.01189D0, 0.00918D0, 0.00704D0, 0.00535D0, 0.00395D0,
52530 & 0.00290D0, 0.00211D0, 0.00152D0, 0.00101D0, 0.00074D0,
52531 & 0.00051D0, 0.00031D0, 0.00023D0, 0.00008D0, 0.00002D0,
52532 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52533 DATA (FMRS(1,6,I, 4),I=1,49)/
52534 & 0.55058D0, 0.48672D0, 0.43021D0, 0.40019D0, 0.38014D0,
52535 & 0.36526D0, 0.32246D0, 0.28426D0, 0.26371D0, 0.24981D0,
52536 & 0.23922D0, 0.20826D0, 0.17939D0, 0.16343D0, 0.15249D0,
52537 & 0.14425D0, 0.13221D0, 0.11993D0, 0.10640D0, 0.09689D0,
52538 & 0.08300D0, 0.07224D0, 0.06305D0, 0.05299D0, 0.04421D0,
52539 & 0.03653D0, 0.02989D0, 0.02420D0, 0.01939D0, 0.01523D0,
52540 & 0.01197D0, 0.00924D0, 0.00709D0, 0.00537D0, 0.00399D0,
52541 & 0.00293D0, 0.00213D0, 0.00154D0, 0.00102D0, 0.00074D0,
52542 & 0.00053D0, 0.00032D0, 0.00024D0, 0.00009D0, 0.00002D0,
52543 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52544 DATA (FMRS(1,6,I, 5),I=1,49)/
52545 & 0.61607D0, 0.54291D0, 0.47835D0, 0.44415D0, 0.42133D0,
52546 & 0.40441D0, 0.35583D0, 0.31254D0, 0.28927D0, 0.27353D0,
52547 & 0.26150D0, 0.22639D0, 0.19363D0, 0.17555D0, 0.16316D0,
52548 & 0.15384D0, 0.14026D0, 0.12643D0, 0.11130D0, 0.10077D0,
52549 & 0.08558D0, 0.07403D0, 0.06431D0, 0.05381D0, 0.04474D0,
52550 & 0.03686D0, 0.03008D0, 0.02432D0, 0.01945D0, 0.01528D0,
52551 & 0.01199D0, 0.00925D0, 0.00709D0, 0.00537D0, 0.00398D0,
52552 & 0.00293D0, 0.00214D0, 0.00154D0, 0.00103D0, 0.00074D0,
52553 & 0.00052D0, 0.00032D0, 0.00024D0, 0.00008D0, 0.00002D0,
52554 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52555 DATA (FMRS(1,6,I, 6),I=1,49)/
52556 & 0.68336D0, 0.60005D0, 0.52679D0, 0.48807D0, 0.46228D0,
52557 & 0.44318D0, 0.38846D0, 0.33984D0, 0.31375D0, 0.29611D0,
52558 & 0.28263D0, 0.24332D0, 0.20674D0, 0.18660D0, 0.17283D0,
52559 & 0.16249D0, 0.14745D0, 0.13219D0, 0.11560D0, 0.10414D0,
52560 & 0.08779D0, 0.07555D0, 0.06535D0, 0.05447D0, 0.04515D0,
52561 & 0.03709D0, 0.03021D0, 0.02439D0, 0.01946D0, 0.01528D0,
52562 & 0.01197D0, 0.00923D0, 0.00707D0, 0.00536D0, 0.00396D0,
52563 & 0.00291D0, 0.00213D0, 0.00154D0, 0.00103D0, 0.00073D0,
52564 & 0.00051D0, 0.00032D0, 0.00023D0, 0.00008D0, 0.00002D0,
52565 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52566 DATA (FMRS(1,6,I, 7),I=1,49)/
52567 & 0.76355D0, 0.66723D0, 0.58292D0, 0.53852D0, 0.50902D0,
52568 & 0.48721D0, 0.42490D0, 0.36978D0, 0.34030D0, 0.32042D0,
52569 & 0.30522D0, 0.26107D0, 0.22021D0, 0.19782D0, 0.18257D0,
52570 & 0.17114D0, 0.15457D0, 0.13784D0, 0.11976D0, 0.10736D0,
52571 & 0.08987D0, 0.07693D0, 0.06629D0, 0.05503D0, 0.04547D0,
52572 & 0.03726D0, 0.03027D0, 0.02439D0, 0.01942D0, 0.01523D0,
52573 & 0.01190D0, 0.00918D0, 0.00701D0, 0.00533D0, 0.00392D0,
52574 & 0.00287D0, 0.00209D0, 0.00153D0, 0.00101D0, 0.00073D0,
52575 & 0.00050D0, 0.00032D0, 0.00022D0, 0.00007D0, 0.00002D0,
52576 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52577 DATA (FMRS(1,6,I, 8),I=1,49)/
52578 & 0.86343D0, 0.75010D0, 0.65144D0, 0.59973D0, 0.56547D0,
52579 & 0.54018D0, 0.46822D0, 0.40492D0, 0.37123D0, 0.34856D0,
52580 & 0.33127D0, 0.28125D0, 0.23529D0, 0.21028D0, 0.19331D0,
52581 & 0.18063D0, 0.16233D0, 0.14394D0, 0.12420D0, 0.11077D0,
52582 & 0.09202D0, 0.07835D0, 0.06722D0, 0.05555D0, 0.04575D0,
52583 & 0.03737D0, 0.03028D0, 0.02434D0, 0.01934D0, 0.01514D0,
52584 & 0.01181D0, 0.00909D0, 0.00694D0, 0.00526D0, 0.00387D0,
52585 & 0.00282D0, 0.00206D0, 0.00150D0, 0.00100D0, 0.00072D0,
52586 & 0.00049D0, 0.00031D0, 0.00021D0, 0.00008D0, 0.00002D0,
52587 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52588 DATA (FMRS(1,6,I, 9),I=1,49)/
52589 & 0.96361D0, 0.83251D0, 0.71897D0, 0.65971D0, 0.62055D0,
52590 & 0.59171D0, 0.50993D0, 0.43838D0, 0.40047D0, 0.37504D0,
52591 & 0.35567D0, 0.29991D0, 0.24906D0, 0.22156D0, 0.20298D0,
52592 & 0.18914D0, 0.16924D0, 0.14933D0, 0.12809D0, 0.11373D0,
52593 & 0.09387D0, 0.07954D0, 0.06798D0, 0.05596D0, 0.04595D0,
52594 & 0.03743D0, 0.03026D0, 0.02427D0, 0.01926D0, 0.01505D0,
52595 & 0.01172D0, 0.00900D0, 0.00687D0, 0.00519D0, 0.00383D0,
52596 & 0.00278D0, 0.00203D0, 0.00148D0, 0.00098D0, 0.00071D0,
52597 & 0.00048D0, 0.00031D0, 0.00021D0, 0.00008D0, 0.00002D0,
52598 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52599 DATA (FMRS(1,6,I,10),I=1,49)/
52600 & 1.07479D0, 0.92315D0, 0.79255D0, 0.72469D0, 0.67997D0,
52601 & 0.64711D0, 0.55427D0, 0.47353D0, 0.43097D0, 0.40251D0,
52602 & 0.38089D0, 0.31894D0, 0.26290D0, 0.23280D0, 0.21256D0,
52603 & 0.19753D0, 0.17599D0, 0.15455D0, 0.13181D0, 0.11654D0,
52604 & 0.09559D0, 0.08062D0, 0.06865D0, 0.05629D0, 0.04608D0,
52605 & 0.03743D0, 0.03019D0, 0.02416D0, 0.01913D0, 0.01493D0,
52606 & 0.01161D0, 0.00890D0, 0.00677D0, 0.00511D0, 0.00377D0,
52607 & 0.00274D0, 0.00200D0, 0.00145D0, 0.00096D0, 0.00068D0,
52608 & 0.00046D0, 0.00030D0, 0.00020D0, 0.00008D0, 0.00002D0,
52609 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52610 DATA (FMRS(1,6,I,11),I=1,49)/
52611 & 1.17232D0, 1.00213D0, 0.85623D0, 0.78069D0, 0.73104D0,
52612 & 0.69461D0, 0.59200D0, 0.50321D0, 0.45658D0, 0.42550D0,
52613 & 0.40194D0, 0.33467D0, 0.27424D0, 0.24195D0, 0.22032D0,
52614 & 0.20431D0, 0.18142D0, 0.15872D0, 0.13477D0, 0.11875D0,
52615 & 0.09692D0, 0.08144D0, 0.06915D0, 0.05653D0, 0.04615D0,
52616 & 0.03741D0, 0.03011D0, 0.02406D0, 0.01902D0, 0.01482D0,
52617 & 0.01152D0, 0.00881D0, 0.00669D0, 0.00505D0, 0.00371D0,
52618 & 0.00270D0, 0.00197D0, 0.00143D0, 0.00094D0, 0.00066D0,
52619 & 0.00045D0, 0.00029D0, 0.00020D0, 0.00008D0, 0.00002D0,
52620 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52621 DATA (FMRS(1,6,I,12),I=1,49)/
52622 & 1.41135D0, 1.19389D0, 1.00931D0, 0.91452D0, 0.85253D0,
52623 & 0.80723D0, 0.68048D0, 0.57199D0, 0.51554D0, 0.47813D0,
52624 & 0.44992D0, 0.37007D0, 0.29939D0, 0.26209D0, 0.23729D0,
52625 & 0.21905D0, 0.19312D0, 0.16764D0, 0.14100D0, 0.12337D0,
52626 & 0.09965D0, 0.08309D0, 0.07010D0, 0.05694D0, 0.04624D0,
52627 & 0.03729D0, 0.02989D0, 0.02378D0, 0.01873D0, 0.01456D0,
52628 & 0.01128D0, 0.00861D0, 0.00651D0, 0.00490D0, 0.00360D0,
52629 & 0.00260D0, 0.00189D0, 0.00137D0, 0.00090D0, 0.00062D0,
52630 & 0.00043D0, 0.00028D0, 0.00019D0, 0.00007D0, 0.00002D0,
52631 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52632 DATA (FMRS(1,6,I,13),I=1,49)/
52633 & 1.65256D0, 1.38522D0, 1.16028D0, 1.04559D0, 0.97092D0,
52634 & 0.91653D0, 0.76529D0, 0.63704D0, 0.57085D0, 0.52722D0,
52635 & 0.49446D0, 0.40243D0, 0.32201D0, 0.28002D0, 0.25230D0,
52636 & 0.23200D0, 0.20332D0, 0.17533D0, 0.14629D0, 0.12724D0,
52637 & 0.10187D0, 0.08438D0, 0.07080D0, 0.05719D0, 0.04622D0,
52638 & 0.03712D0, 0.02965D0, 0.02350D0, 0.01845D0, 0.01430D0,
52639 & 0.01104D0, 0.00841D0, 0.00634D0, 0.00476D0, 0.00349D0,
52640 & 0.00251D0, 0.00182D0, 0.00132D0, 0.00086D0, 0.00060D0,
52641 & 0.00042D0, 0.00026D0, 0.00018D0, 0.00006D0, 0.00002D0,
52642 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52643 DATA (FMRS(1,6,I,14),I=1,49)/
52644 & 1.96387D0, 1.62942D0, 1.35081D0, 1.20988D0, 1.11860D0,
52645 & 1.05236D0, 0.86939D0, 0.71589D0, 0.63738D0, 0.58593D0,
52646 & 0.54750D0, 0.44041D0, 0.34815D0, 0.30054D0, 0.26935D0,
52647 & 0.24663D0, 0.21473D0, 0.18383D0, 0.15206D0, 0.13140D0,
52648 & 0.10419D0, 0.08567D0, 0.07145D0, 0.05736D0, 0.04609D0,
52649 & 0.03684D0, 0.02930D0, 0.02313D0, 0.01809D0, 0.01398D0,
52650 & 0.01074D0, 0.00816D0, 0.00615D0, 0.00459D0, 0.00334D0,
52651 & 0.00240D0, 0.00174D0, 0.00125D0, 0.00082D0, 0.00057D0,
52652 & 0.00038D0, 0.00024D0, 0.00016D0, 0.00006D0, 0.00002D0,
52653 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52654 DATA (FMRS(1,6,I,15),I=1,49)/
52655 & 2.33902D0, 1.92024D0, 1.57497D0, 1.40179D0, 1.29021D0,
52656 & 1.20956D0, 0.98833D0, 0.80477D0, 0.71175D0, 0.65116D0,
52657 & 0.60614D0, 0.48174D0, 0.37612D0, 0.32226D0, 0.28724D0,
52658 & 0.26188D0, 0.22649D0, 0.19248D0, 0.15783D0, 0.13549D0,
52659 & 0.10637D0, 0.08680D0, 0.07195D0, 0.05738D0, 0.04585D0,
52660 & 0.03646D0, 0.02886D0, 0.02269D0, 0.01768D0, 0.01360D0,
52661 & 0.01043D0, 0.00789D0, 0.00592D0, 0.00441D0, 0.00321D0,
52662 & 0.00230D0, 0.00166D0, 0.00118D0, 0.00078D0, 0.00054D0,
52663 & 0.00037D0, 0.00022D0, 0.00015D0, 0.00006D0, 0.00002D0,
52664 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52665 DATA (FMRS(1,6,I,16),I=1,49)/
52666 & 2.72482D0, 2.21608D0, 1.80052D0, 1.59364D0, 1.46096D0,
52667 & 1.36541D0, 1.10490D0, 0.89086D0, 0.78327D0, 0.71357D0,
52668 & 0.66200D0, 0.52058D0, 0.40200D0, 0.34217D0, 0.30354D0,
52669 & 0.27569D0, 0.23704D0, 0.20015D0, 0.16285D0, 0.13900D0,
52670 & 0.10817D0, 0.08767D0, 0.07227D0, 0.05729D0, 0.04554D0,
52671 & 0.03606D0, 0.02842D0, 0.02227D0, 0.01728D0, 0.01326D0,
52672 & 0.01012D0, 0.00763D0, 0.00571D0, 0.00425D0, 0.00307D0,
52673 & 0.00219D0, 0.00158D0, 0.00112D0, 0.00073D0, 0.00051D0,
52674 & 0.00035D0, 0.00021D0, 0.00014D0, 0.00005D0, 0.00002D0,
52675 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52676 DATA (FMRS(1,6,I,17),I=1,49)/
52677 & 3.16184D0, 2.54784D0, 2.05090D0, 1.80533D0, 1.64858D0,
52678 & 1.53608D0, 1.23122D0, 0.98314D0, 0.85944D0, 0.77972D0,
52679 & 0.72099D0, 0.56109D0, 0.42865D0, 0.36249D0, 0.32006D0,
52680 & 0.28962D0, 0.24759D0, 0.20774D0, 0.16775D0, 0.14236D0,
52681 & 0.10984D0, 0.08843D0, 0.07249D0, 0.05712D0, 0.04518D0,
52682 & 0.03560D0, 0.02794D0, 0.02182D0, 0.01686D0, 0.01291D0,
52683 & 0.00980D0, 0.00737D0, 0.00550D0, 0.00408D0, 0.00294D0,
52684 & 0.00209D0, 0.00150D0, 0.00107D0, 0.00069D0, 0.00049D0,
52685 & 0.00034D0, 0.00019D0, 0.00014D0, 0.00005D0, 0.00001D0,
52686 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52687 DATA (FMRS(1,6,I,18),I=1,49)/
52688 & 3.56226D0, 2.84906D0, 2.27616D0, 1.99475D0, 1.81581D0,
52689 & 1.68774D0, 1.34241D0, 1.06358D0, 0.92544D0, 0.83679D0,
52690 & 0.77171D0, 0.59551D0, 0.45100D0, 0.37940D0, 0.33372D0,
52691 & 0.30107D0, 0.25620D0, 0.21386D0, 0.17164D0, 0.14499D0,
52692 & 0.11108D0, 0.08895D0, 0.07258D0, 0.05692D0, 0.04483D0,
52693 & 0.03518D0, 0.02753D0, 0.02142D0, 0.01651D0, 0.01260D0,
52694 & 0.00954D0, 0.00717D0, 0.00532D0, 0.00393D0, 0.00284D0,
52695 & 0.00201D0, 0.00144D0, 0.00103D0, 0.00066D0, 0.00045D0,
52696 & 0.00032D0, 0.00018D0, 0.00013D0, 0.00004D0, 0.00001D0,
52697 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52698 DATA (FMRS(1,6,I,19),I=1,49)/
52699 & 4.09416D0, 3.24567D0, 2.57011D0, 2.24065D0, 2.03209D0,
52700 & 1.88332D0, 1.48448D0, 1.16540D0, 1.00850D0, 0.90831D0,
52701 & 0.83504D0, 0.63803D0, 0.47827D0, 0.39987D0, 0.35015D0,
52702 & 0.31478D0, 0.26640D0, 0.22104D0, 0.17612D0, 0.14797D0,
52703 & 0.11241D0, 0.08943D0, 0.07259D0, 0.05659D0, 0.04434D0,
52704 & 0.03464D0, 0.02699D0, 0.02092D0, 0.01606D0, 0.01221D0,
52705 & 0.00922D0, 0.00691D0, 0.00511D0, 0.00375D0, 0.00271D0,
52706 & 0.00191D0, 0.00136D0, 0.00097D0, 0.00063D0, 0.00043D0,
52707 & 0.00030D0, 0.00017D0, 0.00012D0, 0.00004D0, 0.00001D0,
52708 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52709 DATA (FMRS(1,6,I,20),I=1,49)/
52710 & 4.61257D0, 3.62885D0, 2.85161D0, 2.47491D0, 2.23738D0,
52711 & 2.06842D0, 1.61774D0, 1.26001D0, 1.08527D0, 0.97415D0,
52712 & 0.89315D0, 0.67662D0, 0.50274D0, 0.41811D0, 0.36471D0,
52713 & 0.32688D0, 0.27534D0, 0.22728D0, 0.17996D0, 0.15048D0,
52714 & 0.11349D0, 0.08979D0, 0.07253D0, 0.05626D0, 0.04389D0,
52715 & 0.03414D0, 0.02651D0, 0.02047D0, 0.01566D0, 0.01187D0,
52716 & 0.00894D0, 0.00668D0, 0.00493D0, 0.00361D0, 0.00261D0,
52717 & 0.00182D0, 0.00129D0, 0.00093D0, 0.00059D0, 0.00040D0,
52718 & 0.00028D0, 0.00016D0, 0.00011D0, 0.00004D0, 0.00001D0,
52719 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52720 DATA (FMRS(1,6,I,21),I=1,49)/
52721 & 5.12222D0, 4.00261D0, 3.12404D0, 2.70057D0, 2.43446D0,
52722 & 2.24566D0, 1.74429D0, 1.34911D0, 1.15718D0, 1.03559D0,
52723 & 0.94721D0, 0.71215D0, 0.52500D0, 0.43455D0, 0.37776D0,
52724 & 0.33766D0, 0.28323D0, 0.23271D0, 0.18324D0, 0.15257D0,
52725 & 0.11432D0, 0.08998D0, 0.07237D0, 0.05588D0, 0.04342D0,
52726 & 0.03365D0, 0.02604D0, 0.02004D0, 0.01529D0, 0.01156D0,
52727 & 0.00869D0, 0.00646D0, 0.00477D0, 0.00348D0, 0.00251D0,
52728 & 0.00175D0, 0.00124D0, 0.00088D0, 0.00057D0, 0.00038D0,
52729 & 0.00026D0, 0.00015D0, 0.00010D0, 0.00004D0, 0.00001D0,
52730 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52731 DATA (FMRS(1,6,I,22),I=1,49)/
52732 & 5.82554D0, 4.51423D0, 3.49391D0, 3.00548D0, 2.69986D0,
52733 & 2.48370D0, 1.91285D0, 1.46678D0, 1.25167D0, 1.11601D0,
52734 & 1.01775D0, 0.75806D0, 0.55345D0, 0.45543D0, 0.39424D0,
52735 & 0.35121D0, 0.29307D0, 0.23942D0, 0.18722D0, 0.15507D0,
52736 & 0.11526D0, 0.09014D0, 0.07211D0, 0.05536D0, 0.04279D0,
52737 & 0.03301D0, 0.02543D0, 0.01950D0, 0.01483D0, 0.01117D0,
52738 & 0.00837D0, 0.00620D0, 0.00456D0, 0.00332D0, 0.00238D0,
52739 & 0.00166D0, 0.00117D0, 0.00083D0, 0.00053D0, 0.00035D0,
52740 & 0.00024D0, 0.00015D0, 0.00010D0, 0.00003D0, 0.00001D0,
52741 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52742 DATA (FMRS(1,6,I,23),I=1,49)/
52743 & 6.54676D0, 5.03439D0, 3.86673D0, 3.31126D0, 2.96506D0,
52744 & 2.72090D0, 2.07933D0, 1.58195D0, 1.34364D0, 1.19398D0,
52745 & 1.08591D0, 0.80195D0, 0.58033D0, 0.47501D0, 0.40960D0,
52746 & 0.36377D0, 0.30212D0, 0.24551D0, 0.19078D0, 0.15726D0,
52747 & 0.11602D0, 0.09021D0, 0.07181D0, 0.05483D0, 0.04218D0,
52748 & 0.03240D0, 0.02486D0, 0.01900D0, 0.01440D0, 0.01081D0,
52749 & 0.00808D0, 0.00597D0, 0.00437D0, 0.00317D0, 0.00227D0,
52750 & 0.00157D0, 0.00111D0, 0.00080D0, 0.00050D0, 0.00034D0,
52751 & 0.00022D0, 0.00014D0, 0.00009D0, 0.00003D0, 0.00001D0,
52752 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52753 DATA (FMRS(1,6,I,24),I=1,49)/
52754 & 7.26565D0, 5.54876D0, 4.23247D0, 3.60982D0, 3.22311D0,
52755 & 2.95109D0, 2.23956D0, 1.69183D0, 1.43093D0, 1.26769D0,
52756 & 1.15015D0, 0.84286D0, 0.60508D0, 0.49288D0, 0.42351D0,
52757 & 0.37509D0, 0.31017D0, 0.25086D0, 0.19381D0, 0.15905D0,
52758 & 0.11655D0, 0.09013D0, 0.07142D0, 0.05426D0, 0.04157D0,
52759 & 0.03180D0, 0.02431D0, 0.01852D0, 0.01399D0, 0.01048D0,
52760 & 0.00780D0, 0.00574D0, 0.00419D0, 0.00304D0, 0.00217D0,
52761 & 0.00149D0, 0.00106D0, 0.00075D0, 0.00048D0, 0.00032D0,
52762 & 0.00021D0, 0.00013D0, 0.00009D0, 0.00003D0, 0.00001D0,
52763 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52764 DATA (FMRS(1,6,I,25),I=1,49)/
52765 & 8.04192D0, 6.10017D0, 4.62168D0, 3.92618D0, 3.49572D0,
52766 & 3.19370D0, 2.40717D0, 1.80591D0, 1.52114D0, 1.34361D0,
52767 & 1.21613D0, 0.88453D0, 0.63003D0, 0.51078D0, 0.43739D0,
52768 & 0.38633D0, 0.31813D0, 0.25609D0, 0.19674D0, 0.16076D0,
52769 & 0.11701D0, 0.09001D0, 0.07101D0, 0.05368D0, 0.04095D0,
52770 & 0.03121D0, 0.02377D0, 0.01805D0, 0.01359D0, 0.01015D0,
52771 & 0.00753D0, 0.00553D0, 0.00402D0, 0.00291D0, 0.00207D0,
52772 & 0.00142D0, 0.00101D0, 0.00071D0, 0.00045D0, 0.00030D0,
52773 & 0.00020D0, 0.00012D0, 0.00008D0, 0.00003D0, 0.00001D0,
52774 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52775 DATA (FMRS(1,6,I,26),I=1,49)/
52776 & 8.84513D0, 6.66663D0, 5.01863D0, 4.24745D0, 3.77171D0,
52777 & 3.43873D0, 2.57518D0, 1.91937D0, 1.61043D0, 1.41849D0,
52778 & 1.28102D0, 0.92509D0, 0.65405D0, 0.52788D0, 0.45056D0,
52779 & 0.39694D0, 0.32555D0, 0.26091D0, 0.19936D0, 0.16223D0,
52780 & 0.11732D0, 0.08979D0, 0.07053D0, 0.05307D0, 0.04031D0,
52781 & 0.03061D0, 0.02325D0, 0.01759D0, 0.01321D0, 0.00982D0,
52782 & 0.00728D0, 0.00532D0, 0.00387D0, 0.00279D0, 0.00197D0,
52783 & 0.00136D0, 0.00096D0, 0.00067D0, 0.00043D0, 0.00029D0,
52784 & 0.00019D0, 0.00011D0, 0.00007D0, 0.00003D0, 0.00001D0,
52785 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52786 DATA (FMRS(1,6,I,27),I=1,49)/
52787 & 9.65435D0, 7.23356D0, 5.41328D0, 4.56560D0, 4.04426D0,
52788 & 3.68017D0, 2.73960D0, 2.02962D0, 1.69683D0, 1.49072D0,
52789 & 1.34344D0, 0.96379D0, 0.67674D0, 0.54393D0, 0.46286D0,
52790 & 0.40680D0, 0.33241D0, 0.26531D0, 0.20171D0, 0.16351D0,
52791 & 0.11755D0, 0.08953D0, 0.07005D0, 0.05247D0, 0.03970D0,
52792 & 0.03004D0, 0.02275D0, 0.01715D0, 0.01284D0, 0.00953D0,
52793 & 0.00704D0, 0.00513D0, 0.00373D0, 0.00268D0, 0.00189D0,
52794 & 0.00130D0, 0.00092D0, 0.00064D0, 0.00040D0, 0.00027D0,
52795 & 0.00018D0, 0.00010D0, 0.00007D0, 0.00002D0, 0.00001D0,
52796 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52797 DATA (FMRS(1,6,I,28),I=1,49)/
52798 & 10.45602D0, 7.79175D0, 5.79941D0, 4.87575D0, 4.30926D0,
52799 & 3.91444D0, 2.89810D0, 2.13519D0, 1.77921D0, 1.55938D0,
52800 & 1.40263D0, 1.00018D0, 0.69787D0, 0.55877D0, 0.47417D0,
52801 & 0.41582D0, 0.33862D0, 0.26925D0, 0.20376D0, 0.16459D0,
52802 & 0.11767D0, 0.08923D0, 0.06955D0, 0.05189D0, 0.03911D0,
52803 & 0.02950D0, 0.02227D0, 0.01675D0, 0.01249D0, 0.00926D0,
52804 & 0.00681D0, 0.00496D0, 0.00359D0, 0.00258D0, 0.00181D0,
52805 & 0.00125D0, 0.00088D0, 0.00062D0, 0.00038D0, 0.00026D0,
52806 & 0.00017D0, 0.00010D0, 0.00007D0, 0.00002D0, 0.00001D0,
52807 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52808 DATA (FMRS(1,6,I,29),I=1,49)/
52809 & 11.30416D0, 8.37884D0, 6.20316D0, 5.19892D0, 4.58469D0,
52810 & 4.15747D0, 3.06152D0, 2.24335D0, 1.86330D0, 1.62927D0,
52811 & 1.46273D0, 1.03685D0, 0.71898D0, 0.57351D0, 0.48535D0,
52812 & 0.42471D0, 0.34469D0, 0.27305D0, 0.20570D0, 0.16558D0,
52813 & 0.11773D0, 0.08889D0, 0.06902D0, 0.05129D0, 0.03852D0,
52814 & 0.02896D0, 0.02179D0, 0.01634D0, 0.01216D0, 0.00899D0,
52815 & 0.00659D0, 0.00479D0, 0.00347D0, 0.00248D0, 0.00174D0,
52816 & 0.00119D0, 0.00084D0, 0.00059D0, 0.00036D0, 0.00024D0,
52817 & 0.00016D0, 0.00009D0, 0.00006D0, 0.00002D0, 0.00001D0,
52818 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52819 DATA (FMRS(1,6,I,30),I=1,49)/
52820 & 12.17534D0, 8.97841D0, 6.61310D0, 5.52592D0, 4.86271D0,
52821 & 4.40230D0, 3.22516D0, 2.35097D0, 1.94663D0, 1.69833D0,
52822 & 1.52199D0, 1.07270D0, 0.73942D0, 0.58770D0, 0.49605D0,
52823 & 0.43317D0, 0.35042D0, 0.27659D0, 0.20745D0, 0.16642D0,
52824 & 0.11771D0, 0.08850D0, 0.06847D0, 0.05068D0, 0.03793D0,
52825 & 0.02842D0, 0.02132D0, 0.01595D0, 0.01184D0, 0.00872D0,
52826 & 0.00639D0, 0.00464D0, 0.00334D0, 0.00238D0, 0.00167D0,
52827 & 0.00115D0, 0.00081D0, 0.00056D0, 0.00034D0, 0.00023D0,
52828 & 0.00015D0, 0.00009D0, 0.00006D0, 0.00002D0, 0.00000D0,
52829 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52830 DATA (FMRS(1,6,I,31),I=1,49)/
52831 & 13.04562D0, 9.57419D0, 7.01826D0, 5.84808D0, 5.13599D0,
52832 & 4.64254D0, 3.38483D0, 2.45538D0, 2.02720D0, 1.76492D0,
52833 & 1.57901D0, 1.10697D0, 0.75881D0, 0.60107D0, 0.50610D0,
52834 & 0.44109D0, 0.35574D0, 0.27985D0, 0.20903D0, 0.16716D0,
52835 & 0.11764D0, 0.08810D0, 0.06793D0, 0.05010D0, 0.03737D0,
52836 & 0.02791D0, 0.02089D0, 0.01558D0, 0.01154D0, 0.00848D0,
52837 & 0.00620D0, 0.00450D0, 0.00323D0, 0.00230D0, 0.00160D0,
52838 & 0.00110D0, 0.00077D0, 0.00053D0, 0.00032D0, 0.00022D0,
52839 & 0.00015D0, 0.00008D0, 0.00006D0, 0.00002D0, 0.00000D0,
52840 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52841 DATA (FMRS(1,6,I,32),I=1,49)/
52842 & 13.89443D0, 10.15226D0, 7.40931D0, 6.15805D0, 5.39834D0,
52843 & 4.87276D0, 3.53699D0, 2.55429D0, 2.10325D0, 1.82761D0,
52844 & 1.63256D0, 1.13890D0, 0.77669D0, 0.61332D0, 0.51524D0,
52845 & 0.44825D0, 0.36050D0, 0.28271D0, 0.21036D0, 0.16773D0,
52846 & 0.11750D0, 0.08767D0, 0.06738D0, 0.04952D0, 0.03683D0,
52847 & 0.02743D0, 0.02048D0, 0.01524D0, 0.01125D0, 0.00826D0,
52848 & 0.00603D0, 0.00436D0, 0.00312D0, 0.00222D0, 0.00155D0,
52849 & 0.00106D0, 0.00074D0, 0.00051D0, 0.00031D0, 0.00021D0,
52850 & 0.00014D0, 0.00008D0, 0.00005D0, 0.00002D0, 0.00001D0,
52851 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52852 DATA (FMRS(1,6,I,33),I=1,49)/
52853 & 14.79866D0, 10.76526D0, 7.82209D0, 6.48437D0, 5.67399D0,
52854 & 5.11430D0, 3.69589D0, 2.65710D0, 2.18207D0, 1.89245D0,
52855 & 1.68785D0, 1.17170D0, 0.79496D0, 0.62581D0, 0.52453D0,
52856 & 0.45551D0, 0.36532D0, 0.28560D0, 0.21171D0, 0.16831D0,
52857 & 0.11736D0, 0.08724D0, 0.06684D0, 0.04896D0, 0.03630D0,
52858 & 0.02696D0, 0.02007D0, 0.01490D0, 0.01098D0, 0.00805D0,
52859 & 0.00586D0, 0.00423D0, 0.00302D0, 0.00214D0, 0.00150D0,
52860 & 0.00102D0, 0.00071D0, 0.00049D0, 0.00030D0, 0.00020D0,
52861 & 0.00013D0, 0.00008D0, 0.00005D0, 0.00002D0, 0.00001D0,
52862 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52863 DATA (FMRS(1,6,I,34),I=1,49)/
52864 & 15.70368D0, 11.37564D0, 8.23095D0, 6.80656D0, 5.94554D0,
52865 & 5.35181D0, 3.85123D0, 2.75698D0, 2.25835D0, 1.95501D0,
52866 & 1.74107D0, 1.20298D0, 0.81219D0, 0.63747D0, 0.53315D0,
52867 & 0.46219D0, 0.36968D0, 0.28814D0, 0.21281D0, 0.16870D0,
52868 & 0.11711D0, 0.08674D0, 0.06626D0, 0.04836D0, 0.03575D0,
52869 & 0.02649D0, 0.01967D0, 0.01456D0, 0.01071D0, 0.00784D0,
52870 & 0.00568D0, 0.00409D0, 0.00292D0, 0.00207D0, 0.00144D0,
52871 & 0.00098D0, 0.00068D0, 0.00047D0, 0.00029D0, 0.00019D0,
52872 & 0.00012D0, 0.00007D0, 0.00005D0, 0.00002D0, 0.00000D0,
52873 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52874 DATA (FMRS(1,6,I,35),I=1,49)/
52875 & 16.61098D0, 11.98498D0, 8.63737D0, 7.12604D0, 6.21432D0,
52876 & 5.58657D0, 4.00413D0, 2.85486D0, 2.33290D0, 2.01603D0,
52877 & 1.79291D0, 1.23331D0, 0.82880D0, 0.64868D0, 0.54141D0,
52878 & 0.46858D0, 0.37384D0, 0.29056D0, 0.21385D0, 0.16907D0,
52879 & 0.11687D0, 0.08628D0, 0.06571D0, 0.04780D0, 0.03525D0,
52880 & 0.02604D0, 0.01929D0, 0.01425D0, 0.01046D0, 0.00764D0,
52881 & 0.00552D0, 0.00397D0, 0.00283D0, 0.00200D0, 0.00139D0,
52882 & 0.00095D0, 0.00066D0, 0.00045D0, 0.00028D0, 0.00019D0,
52883 & 0.00012D0, 0.00007D0, 0.00005D0, 0.00002D0, 0.00000D0,
52884 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52885 DATA (FMRS(1,6,I,36),I=1,49)/
52886 & 17.49641D0, 12.57703D0, 9.03053D0, 7.43428D0, 6.47316D0,
52887 & 5.81232D0, 4.15045D0, 2.94807D0, 2.40367D0, 2.07383D0,
52888 & 1.84191D0, 1.26179D0, 0.84428D0, 0.65906D0, 0.54902D0,
52889 & 0.47444D0, 0.37762D0, 0.29271D0, 0.21474D0, 0.16935D0,
52890 & 0.11660D0, 0.08580D0, 0.06517D0, 0.04726D0, 0.03476D0,
52891 & 0.02562D0, 0.01894D0, 0.01396D0, 0.01022D0, 0.00745D0,
52892 & 0.00538D0, 0.00386D0, 0.00274D0, 0.00194D0, 0.00135D0,
52893 & 0.00092D0, 0.00063D0, 0.00044D0, 0.00027D0, 0.00018D0,
52894 & 0.00011D0, 0.00007D0, 0.00005D0, 0.00002D0, 0.00000D0,
52895 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52896 DATA (FMRS(1,6,I,37),I=1,49)/
52897 & 18.41415D0, 13.18812D0, 9.43458D0, 7.75025D0, 6.73800D0,
52898 & 6.04297D0, 4.29926D0, 3.04240D0, 2.47507D0, 2.13202D0,
52899 & 1.89114D0, 1.29020D0, 0.85959D0, 0.66927D0, 0.55646D0,
52900 & 0.48015D0, 0.38126D0, 0.29476D0, 0.21554D0, 0.16955D0,
52901 & 0.11628D0, 0.08530D0, 0.06461D0, 0.04672D0, 0.03427D0,
52902 & 0.02520D0, 0.01858D0, 0.01367D0, 0.00999D0, 0.00727D0,
52903 & 0.00525D0, 0.00375D0, 0.00266D0, 0.00188D0, 0.00131D0,
52904 & 0.00088D0, 0.00061D0, 0.00042D0, 0.00026D0, 0.00017D0,
52905 & 0.00011D0, 0.00006D0, 0.00004D0, 0.00001D0, 0.00000D0,
52906 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52907 DATA (FMRS(1,6,I,38),I=1,49)/
52908 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52909 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52910 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52911 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52912 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52913 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52914 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52915 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52916 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52917 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52918 DATA (FMRS(1,7,I, 1),I=1,49)/
52919 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52920 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52921 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52922 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52923 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52924 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52925 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52926 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52927 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52928 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52929 DATA (FMRS(1,7,I, 2),I=1,49)/
52930 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52931 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52932 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52933 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52934 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52935 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52936 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52937 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52938 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52939 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52940 DATA (FMRS(1,7,I, 3),I=1,49)/
52941 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52942 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52943 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52944 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52945 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52946 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52947 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52948 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52949 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52950 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52951 DATA (FMRS(1,7,I, 4),I=1,49)/
52952 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52953 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52954 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52955 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52956 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52957 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52958 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52959 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52960 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52961 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52962 DATA (FMRS(1,7,I, 5),I=1,49)/
52963 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52964 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52965 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52966 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52967 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52968 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52969 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52970 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52971 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52972 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52973 DATA (FMRS(1,7,I, 6),I=1,49)/
52974 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52975 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52976 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52977 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52978 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52979 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52980 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52981 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52982 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52983 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52984 DATA (FMRS(1,7,I, 7),I=1,49)/
52985 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52986 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52987 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52988 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52989 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52990 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52991 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52992 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52993 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52994 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52995 DATA (FMRS(1,7,I, 8),I=1,49)/
52996 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52997 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52998 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52999 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53000 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53001 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53002 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53003 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53004 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53005 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53006 DATA (FMRS(1,7,I, 9),I=1,49)/
53007 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53008 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53009 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53010 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53011 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53012 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53013 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53014 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53015 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53016 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53017 DATA (FMRS(1,7,I,10),I=1,49)/
53018 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53019 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53020 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53021 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53022 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53023 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53024 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53025 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53026 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53027 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53028 DATA (FMRS(1,7,I,11),I=1,49)/
53029 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53030 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53031 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53032 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53033 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53034 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53035 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53036 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53037 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53038 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53039 DATA (FMRS(1,7,I,12),I=1,49)/
53040 & 0.00042D0, 0.00036D0, 0.00032D0, 0.00030D0, 0.00028D0,
53041 & 0.00027D0, 0.00023D0, 0.00020D0, 0.00019D0, 0.00018D0,
53042 & 0.00017D0, 0.00014D0, 0.00012D0, 0.00011D0, 0.00010D0,
53043 & 0.00009D0, 0.00008D0, 0.00007D0, 0.00006D0, 0.00005D0,
53044 & 0.00005D0, 0.00004D0, 0.00003D0, 0.00003D0, 0.00003D0,
53045 & 0.00002D0, 0.00002D0, 0.00002D0, 0.00002D0, 0.00001D0,
53046 & 0.00001D0, 0.00001D0, 0.00001D0, 0.00001D0, 0.00001D0,
53047 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53048 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53049 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53050 DATA (FMRS(1,7,I,13),I=1,49)/
53051 & 0.21520D0, 0.16773D0, 0.13065D0, 0.11283D0, 0.10165D0,
53052 & 0.09372D0, 0.07266D0, 0.05600D0, 0.04786D0, 0.04266D0,
53053 & 0.03883D0, 0.02862D0, 0.02044D0, 0.01649D0, 0.01402D0,
53054 & 0.01228D0, 0.00994D0, 0.00781D0, 0.00579D0, 0.00460D0,
53055 & 0.00322D0, 0.00243D0, 0.00191D0, 0.00146D0, 0.00114D0,
53056 & 0.00089D0, 0.00070D0, 0.00055D0, 0.00043D0, 0.00034D0,
53057 & 0.00026D0, 0.00020D0, 0.00015D0, 0.00011D0, 0.00009D0,
53058 & 0.00006D0, 0.00005D0, 0.00003D0, 0.00002D0, 0.00001D0,
53059 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53060 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53061 DATA (FMRS(1,7,I,14),I=1,49)/
53062 & 0.62424D0, 0.48455D0, 0.37589D0, 0.32385D0, 0.29126D0,
53063 & 0.26818D0, 0.20706D0, 0.15892D0, 0.13546D0, 0.12053D0,
53064 & 0.10954D0, 0.08034D0, 0.05707D0, 0.04589D0, 0.03892D0,
53065 & 0.03403D0, 0.02747D0, 0.02151D0, 0.01589D0, 0.01258D0,
53066 & 0.00876D0, 0.00658D0, 0.00515D0, 0.00391D0, 0.00303D0,
53067 & 0.00236D0, 0.00185D0, 0.00144D0, 0.00112D0, 0.00088D0,
53068 & 0.00067D0, 0.00051D0, 0.00039D0, 0.00029D0, 0.00022D0,
53069 & 0.00016D0, 0.00011D0, 0.00008D0, 0.00006D0, 0.00004D0,
53070 & 0.00002D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
53071 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53072 DATA (FMRS(1,7,I,15),I=1,49)/
53073 & 1.00765D0, 0.77678D0, 0.59844D0, 0.51350D0, 0.46049D0,
53074 & 0.42306D0, 0.32436D0, 0.24719D0, 0.20981D0, 0.18611D0,
53075 & 0.16874D0, 0.12279D0, 0.08652D0, 0.06923D0, 0.05850D0,
53076 & 0.05102D0, 0.04100D0, 0.03196D0, 0.02347D0, 0.01849D0,
53077 & 0.01279D0, 0.00955D0, 0.00743D0, 0.00560D0, 0.00430D0,
53078 & 0.00334D0, 0.00260D0, 0.00202D0, 0.00157D0, 0.00121D0,
53079 & 0.00093D0, 0.00071D0, 0.00053D0, 0.00040D0, 0.00029D0,
53080 & 0.00021D0, 0.00015D0, 0.00011D0, 0.00007D0, 0.00005D0,
53081 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
53082 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53083 DATA (FMRS(1,7,I,16),I=1,49)/
53084 & 1.42250D0, 1.08981D0, 0.83442D0, 0.71339D0, 0.63810D0,
53085 & 0.58505D0, 0.44575D0, 0.33755D0, 0.28542D0, 0.25249D0,
53086 & 0.22841D0, 0.16506D0, 0.11545D0, 0.09197D0, 0.07747D0,
53087 & 0.06738D0, 0.05394D0, 0.04186D0, 0.03057D0, 0.02399D0,
53088 & 0.01648D0, 0.01223D0, 0.00946D0, 0.00708D0, 0.00541D0,
53089 & 0.00417D0, 0.00323D0, 0.00250D0, 0.00193D0, 0.00149D0,
53090 & 0.00113D0, 0.00086D0, 0.00064D0, 0.00048D0, 0.00035D0,
53091 & 0.00026D0, 0.00018D0, 0.00013D0, 0.00009D0, 0.00005D0,
53092 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
53093 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53094 DATA (FMRS(1,7,I,17),I=1,49)/
53095 & 1.90329D0, 1.44918D0, 1.10274D0, 0.93938D0, 0.83807D0,
53096 & 0.76686D0, 0.58064D0, 0.43692D0, 0.36805D0, 0.32470D0,
53097 & 0.29309D0, 0.21032D0, 0.14604D0, 0.11582D0, 0.09725D0,
53098 & 0.08437D0, 0.06728D0, 0.05198D0, 0.03776D0, 0.02950D0,
53099 & 0.02012D0, 0.01485D0, 0.01142D0, 0.00850D0, 0.00645D0,
53100 & 0.00494D0, 0.00381D0, 0.00293D0, 0.00225D0, 0.00172D0,
53101 & 0.00131D0, 0.00098D0, 0.00073D0, 0.00054D0, 0.00040D0,
53102 & 0.00029D0, 0.00021D0, 0.00014D0, 0.00010D0, 0.00006D0,
53103 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
53104 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53105 DATA (FMRS(1,7,I,18),I=1,49)/
53106 & 2.33137D0, 1.76616D0, 1.33713D0, 1.13567D0, 1.01106D0,
53107 & 0.92363D0, 0.69576D0, 0.52083D0, 0.43738D0, 0.38501D0,
53108 & 0.34690D0, 0.24753D0, 0.17085D0, 0.13502D0, 0.11307D0,
53109 & 0.09789D0, 0.07781D0, 0.05991D0, 0.04333D0, 0.03374D0,
53110 & 0.02288D0, 0.01680D0, 0.01286D0, 0.00952D0, 0.00719D0,
53111 & 0.00549D0, 0.00420D0, 0.00322D0, 0.00246D0, 0.00188D0,
53112 & 0.00142D0, 0.00107D0, 0.00079D0, 0.00059D0, 0.00043D0,
53113 & 0.00031D0, 0.00022D0, 0.00015D0, 0.00010D0, 0.00006D0,
53114 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
53115 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53116 DATA (FMRS(1,7,I,19),I=1,49)/
53117 & 2.89798D0, 2.18213D0, 1.64207D0, 1.38971D0, 1.23410D0,
53118 & 1.12518D0, 0.84241D0, 0.62670D0, 0.52435D0, 0.46034D0,
53119 & 0.41389D0, 0.29333D0, 0.20103D0, 0.15819D0, 0.13206D0,
53120 & 0.11405D0, 0.09031D0, 0.06924D0, 0.04982D0, 0.03863D0,
53121 & 0.02602D0, 0.01899D0, 0.01446D0, 0.01064D0, 0.00798D0,
53122 & 0.00606D0, 0.00462D0, 0.00352D0, 0.00268D0, 0.00204D0,
53123 & 0.00153D0, 0.00115D0, 0.00085D0, 0.00062D0, 0.00046D0,
53124 & 0.00034D0, 0.00024D0, 0.00016D0, 0.00010D0, 0.00006D0,
53125 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
53126 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53127 DATA (FMRS(1,7,I,20),I=1,49)/
53128 & 3.45978D0, 2.59142D0, 1.93977D0, 1.63658D0, 1.45012D0,
53129 & 1.31987D0, 0.98290D0, 0.72728D0, 0.60655D0, 0.53126D0,
53130 & 0.47676D0, 0.33590D0, 0.22879D0, 0.17936D0, 0.14933D0,
53131 & 0.12869D0, 0.10156D0, 0.07757D0, 0.05556D0, 0.04293D0,
53132 & 0.02875D0, 0.02087D0, 0.01582D0, 0.01157D0, 0.00864D0,
53133 & 0.00653D0, 0.00495D0, 0.00376D0, 0.00285D0, 0.00216D0,
53134 & 0.00162D0, 0.00120D0, 0.00089D0, 0.00065D0, 0.00048D0,
53135 & 0.00035D0, 0.00025D0, 0.00017D0, 0.00010D0, 0.00006D0,
53136 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
53137 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53138 DATA (FMRS(1,7,I,21),I=1,49)/
53139 & 3.99390D0, 2.97724D0, 2.21795D0, 1.86604D0, 1.65015D0,
53140 & 1.49961D0, 1.11138D0, 0.81834D0, 0.68051D0, 0.59480D0,
53141 & 0.53289D0, 0.37345D0, 0.25296D0, 0.19764D0, 0.16415D0,
53142 & 0.14119D0, 0.11109D0, 0.08457D0, 0.06032D0, 0.04645D0,
53143 & 0.03094D0, 0.02236D0, 0.01688D0, 0.01228D0, 0.00913D0,
53144 & 0.00687D0, 0.00519D0, 0.00392D0, 0.00296D0, 0.00223D0,
53145 & 0.00167D0, 0.00124D0, 0.00091D0, 0.00067D0, 0.00049D0,
53146 & 0.00036D0, 0.00025D0, 0.00017D0, 0.00010D0, 0.00006D0,
53147 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
53148 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53149 DATA (FMRS(1,7,I,22),I=1,49)/
53150 & 4.74104D0, 3.51318D0, 2.60162D0, 2.18119D0, 1.92405D0,
53151 & 1.74515D0, 1.28558D0, 0.94085D0, 0.77956D0, 0.67959D0,
53152 & 0.60758D0, 0.42298D0, 0.28453D0, 0.22138D0, 0.18331D0,
53153 & 0.15728D0, 0.12329D0, 0.09346D0, 0.06632D0, 0.05087D0,
53154 & 0.03366D0, 0.02418D0, 0.01815D0, 0.01313D0, 0.00971D0,
53155 & 0.00726D0, 0.00546D0, 0.00411D0, 0.00309D0, 0.00232D0,
53156 & 0.00172D0, 0.00128D0, 0.00094D0, 0.00068D0, 0.00049D0,
53157 & 0.00036D0, 0.00026D0, 0.00017D0, 0.00010D0, 0.00006D0,
53158 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
53159 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53160 DATA (FMRS(1,7,I,23),I=1,49)/
53161 & 5.50879D0, 4.05964D0, 2.98973D0, 2.49849D0, 2.19888D0,
53162 & 1.99086D0, 1.45844D0, 1.06135D0, 0.87646D0, 0.76222D0,
53163 & 0.68014D0, 0.47060D0, 0.31455D0, 0.24380D0, 0.20130D0,
53164 & 0.17233D0, 0.13462D0, 0.10166D0, 0.07179D0, 0.05486D0,
53165 & 0.03607D0, 0.02577D0, 0.01926D0, 0.01386D0, 0.01019D0,
53166 & 0.00758D0, 0.00568D0, 0.00425D0, 0.00318D0, 0.00238D0,
53167 & 0.00176D0, 0.00130D0, 0.00095D0, 0.00069D0, 0.00050D0,
53168 & 0.00037D0, 0.00026D0, 0.00017D0, 0.00010D0, 0.00006D0,
53169 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
53170 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53171 DATA (FMRS(1,7,I,24),I=1,49)/
53172 & 6.25919D0, 4.58931D0, 3.36270D0, 2.80183D0, 2.46064D0,
53173 & 2.22421D0, 1.62105D0, 1.17360D0, 0.96617D0, 0.83838D0,
53174 & 0.74677D0, 0.51381D0, 0.34143D0, 0.26369D0, 0.21716D0,
53175 & 0.18553D0, 0.14447D0, 0.10870D0, 0.07643D0, 0.05820D0,
53176 & 0.03805D0, 0.02705D0, 0.02012D0, 0.01441D0, 0.01054D0,
53177 & 0.00781D0, 0.00582D0, 0.00434D0, 0.00324D0, 0.00241D0,
53178 & 0.00178D0, 0.00131D0, 0.00095D0, 0.00069D0, 0.00050D0,
53179 & 0.00037D0, 0.00026D0, 0.00017D0, 0.00010D0, 0.00006D0,
53180 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
53181 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53182 DATA (FMRS(1,7,I,25),I=1,49)/
53183 & 7.07966D0, 5.16501D0, 3.76564D0, 3.12838D0, 2.74171D0,
53184 & 2.47426D0, 1.79422D0, 1.29235D0, 1.06071D0, 0.91840D0,
53185 & 0.81663D0, 0.55877D0, 0.36917D0, 0.28412D0, 0.23339D0,
53186 & 0.19900D0, 0.15447D0, 0.11582D0, 0.08108D0, 0.06153D0,
53187 & 0.03999D0, 0.02830D0, 0.02096D0, 0.01493D0, 0.01087D0,
53188 & 0.00803D0, 0.00595D0, 0.00442D0, 0.00329D0, 0.00244D0,
53189 & 0.00180D0, 0.00131D0, 0.00096D0, 0.00069D0, 0.00050D0,
53190 & 0.00036D0, 0.00026D0, 0.00017D0, 0.00010D0, 0.00006D0,
53191 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
53192 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53193 DATA (FMRS(1,7,I,26),I=1,49)/
53194 & 7.91829D0, 5.74916D0, 4.17141D0, 3.45573D0, 3.02255D0,
53195 & 2.72346D0, 1.96537D0, 1.40870D0, 1.15285D0, 0.99608D0,
53196 & 0.88421D0, 0.60182D0, 0.39541D0, 0.30330D0, 0.24854D0,
53197 & 0.21150D0, 0.16368D0, 0.12231D0, 0.08527D0, 0.06448D0,
53198 & 0.04169D0, 0.02937D0, 0.02165D0, 0.01535D0, 0.01113D0,
53199 & 0.00818D0, 0.00604D0, 0.00447D0, 0.00331D0, 0.00245D0,
53200 & 0.00180D0, 0.00131D0, 0.00095D0, 0.00068D0, 0.00049D0,
53201 & 0.00036D0, 0.00026D0, 0.00017D0, 0.00010D0, 0.00006D0,
53202 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
53203 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53204 DATA (FMRS(1,7,I,27),I=1,49)/
53205 & 8.76657D0, 6.33661D0, 4.57707D0, 3.78184D0, 3.30161D0,
53206 & 2.97059D0, 2.13403D0, 1.52261D0, 1.24269D0, 1.07161D0,
53207 & 0.94977D0, 0.64324D0, 0.42046D0, 0.32150D0, 0.26285D0,
53208 & 0.22328D0, 0.17230D0, 0.12835D0, 0.08912D0, 0.06719D0,
53209 & 0.04322D0, 0.03031D0, 0.02226D0, 0.01571D0, 0.01134D0,
53210 & 0.00830D0, 0.00611D0, 0.00451D0, 0.00333D0, 0.00245D0,
53211 & 0.00180D0, 0.00131D0, 0.00095D0, 0.00068D0, 0.00048D0,
53212 & 0.00036D0, 0.00026D0, 0.00017D0, 0.00010D0, 0.00006D0,
53213 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
53214 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53215 DATA (FMRS(1,7,I,28),I=1,49)/
53216 & 9.60252D0, 6.91204D0, 4.97199D0, 4.09813D0, 3.57154D0,
53217 & 3.20914D0, 2.29574D0, 1.63105D0, 1.32784D0, 1.14296D0,
53218 & 1.01154D0, 0.68194D0, 0.44362D0, 0.33823D0, 0.27595D0,
53219 & 0.23401D0, 0.18011D0, 0.13377D0, 0.09255D0, 0.06957D0,
53220 & 0.04454D0, 0.03111D0, 0.02277D0, 0.01600D0, 0.01150D0,
53221 & 0.00839D0, 0.00616D0, 0.00453D0, 0.00333D0, 0.00245D0,
53222 & 0.00179D0, 0.00130D0, 0.00094D0, 0.00067D0, 0.00048D0,
53223 & 0.00035D0, 0.00025D0, 0.00017D0, 0.00010D0, 0.00006D0,
53224 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
53225 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53226 DATA (FMRS(1,7,I,29),I=1,49)/
53227 & 10.48807D0, 7.51842D0, 5.38590D0, 4.42859D0, 3.85291D0,
53228 & 3.45734D0, 2.46302D0, 1.74255D0, 1.41507D0, 1.21586D0,
53229 & 1.07451D0, 0.72111D0, 0.46688D0, 0.35494D0, 0.28897D0,
53230 & 0.24464D0, 0.18781D0, 0.13908D0, 0.09587D0, 0.07187D0,
53231 & 0.04579D0, 0.03185D0, 0.02323D0, 0.01626D0, 0.01165D0,
53232 & 0.00847D0, 0.00619D0, 0.00454D0, 0.00333D0, 0.00244D0,
53233 & 0.00178D0, 0.00129D0, 0.00093D0, 0.00066D0, 0.00047D0,
53234 & 0.00035D0, 0.00025D0, 0.00017D0, 0.00010D0, 0.00006D0,
53235 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
53236 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53237 DATA (FMRS(1,7,I,30),I=1,49)/
53238 & 11.39334D0, 8.13482D0, 5.80422D0, 4.76138D0, 4.13555D0,
53239 & 3.70617D0, 2.62967D0, 1.85288D0, 1.50103D0, 1.28747D0,
53240 & 1.13621D0, 0.75917D0, 0.48927D0, 0.37093D0, 0.30137D0,
53241 & 0.25473D0, 0.19506D0, 0.14404D0, 0.09894D0, 0.07396D0,
53242 & 0.04691D0, 0.03251D0, 0.02363D0, 0.01647D0, 0.01175D0,
53243 & 0.00851D0, 0.00621D0, 0.00454D0, 0.00332D0, 0.00243D0,
53244 & 0.00176D0, 0.00127D0, 0.00091D0, 0.00065D0, 0.00046D0,
53245 & 0.00034D0, 0.00025D0, 0.00017D0, 0.00010D0, 0.00006D0,
53246 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
53247 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53248 DATA (FMRS(1,7,I,31),I=1,49)/
53249 & 12.30020D0, 8.74942D0, 6.21933D0, 5.09070D0, 4.41468D0,
53250 & 3.95152D0, 2.79315D0, 1.96055D0, 1.58465D0, 1.35697D0,
53251 & 1.19598D0, 0.79580D0, 0.51068D0, 0.38615D0, 0.31314D0,
53252 & 0.26427D0, 0.20189D0, 0.14868D0, 0.10179D0, 0.07589D0,
53253 & 0.04793D0, 0.03309D0, 0.02397D0, 0.01665D0, 0.01184D0,
53254 & 0.00855D0, 0.00621D0, 0.00453D0, 0.00330D0, 0.00241D0,
53255 & 0.00174D0, 0.00126D0, 0.00090D0, 0.00064D0, 0.00046D0,
53256 & 0.00034D0, 0.00025D0, 0.00017D0, 0.00010D0, 0.00006D0,
53257 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
53258 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53259 DATA (FMRS(1,7,I,32),I=1,49)/
53260 & 13.17835D0, 9.34137D0, 6.61692D0, 5.40505D0, 4.68045D0,
53261 & 4.18467D0, 2.94753D0, 2.06155D0, 1.66276D0, 1.42169D0,
53262 & 1.25150D0, 0.82954D0, 0.53019D0, 0.39993D0, 0.32374D0,
53263 & 0.27283D0, 0.20796D0, 0.15278D0, 0.10427D0, 0.07755D0,
53264 & 0.04878D0, 0.03356D0, 0.02424D0, 0.01677D0, 0.01189D0,
53265 & 0.00856D0, 0.00621D0, 0.00451D0, 0.00328D0, 0.00239D0,
53266 & 0.00173D0, 0.00124D0, 0.00089D0, 0.00063D0, 0.00045D0,
53267 & 0.00033D0, 0.00025D0, 0.00017D0, 0.00010D0, 0.00006D0,
53268 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
53269 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53270 DATA (FMRS(1,7,I,33),I=1,49)/
53271 & 14.12059D0, 9.97430D0, 7.04054D0, 5.73929D0, 4.96264D0,
53272 & 4.43195D0, 3.11069D0, 2.16791D0, 1.74484D0, 1.48959D0,
53273 & 1.30967D0, 0.86476D0, 0.55049D0, 0.41422D0, 0.33471D0,
53274 & 0.28168D0, 0.21423D0, 0.15699D0, 0.10682D0, 0.07925D0,
53275 & 0.04965D0, 0.03404D0, 0.02451D0, 0.01690D0, 0.01194D0,
53276 & 0.00857D0, 0.00620D0, 0.00449D0, 0.00326D0, 0.00237D0,
53277 & 0.00171D0, 0.00123D0, 0.00088D0, 0.00062D0, 0.00044D0,
53278 & 0.00032D0, 0.00025D0, 0.00017D0, 0.00010D0, 0.00006D0,
53279 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
53280 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53281 DATA (FMRS(1,7,I,34),I=1,49)/
53282 & 15.05309D0, 10.59701D0, 7.45476D0, 6.06488D0, 5.23678D0,
53283 & 4.67164D0, 3.26773D0, 2.26948D0, 1.82284D0, 1.55389D0,
53284 & 1.36460D0, 0.89767D0, 0.56921D0, 0.42730D0, 0.34468D0,
53285 & 0.28967D0, 0.21983D0, 0.16070D0, 0.10902D0, 0.08069D0,
53286 & 0.05036D0, 0.03441D0, 0.02470D0, 0.01698D0, 0.01196D0,
53287 & 0.00856D0, 0.00617D0, 0.00446D0, 0.00323D0, 0.00234D0,
53288 & 0.00168D0, 0.00121D0, 0.00086D0, 0.00061D0, 0.00043D0,
53289 & 0.00032D0, 0.00024D0, 0.00017D0, 0.00010D0, 0.00006D0,
53290 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
53291 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53292 DATA (FMRS(1,7,I,35),I=1,49)/
53293 & 15.99294D0, 11.22254D0, 7.86947D0, 6.39022D0, 5.51032D0,
53294 & 4.91055D0, 3.42373D0, 2.37005D0, 1.89992D0, 1.61733D0,
53295 & 1.41872D0, 0.92998D0, 0.58753D0, 0.44006D0, 0.35440D0,
53296 & 0.29744D0, 0.22527D0, 0.16430D0, 0.11114D0, 0.08207D0,
53297 & 0.05103D0, 0.03476D0, 0.02489D0, 0.01705D0, 0.01198D0,
53298 & 0.00855D0, 0.00615D0, 0.00444D0, 0.00321D0, 0.00232D0,
53299 & 0.00166D0, 0.00119D0, 0.00085D0, 0.00060D0, 0.00042D0,
53300 & 0.00031D0, 0.00024D0, 0.00017D0, 0.00010D0, 0.00006D0,
53301 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
53302 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53303 DATA (FMRS(1,7,I,36),I=1,49)/
53304 & 16.90825D0, 11.82917D0, 8.26989D0, 6.70353D0, 5.77324D0,
53305 & 5.13985D0, 3.57272D0, 2.46560D0, 1.97292D0, 1.67727D0,
53306 & 1.46976D0, 0.96025D0, 0.60456D0, 0.45187D0, 0.36334D0,
53307 & 0.30458D0, 0.23023D0, 0.16756D0, 0.11304D0, 0.08330D0,
53308 & 0.05162D0, 0.03506D0, 0.02503D0, 0.01710D0, 0.01198D0,
53309 & 0.00853D0, 0.00612D0, 0.00440D0, 0.00318D0, 0.00229D0,
53310 & 0.00164D0, 0.00117D0, 0.00083D0, 0.00059D0, 0.00042D0,
53311 & 0.00031D0, 0.00024D0, 0.00017D0, 0.00010D0, 0.00006D0,
53312 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
53313 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53314 DATA (FMRS(1,7,I,37),I=1,49)/
53315 & 17.85379D0, 12.45318D0, 8.67996D0, 7.02354D0, 6.04126D0,
53316 & 5.37323D0, 3.72362D0, 2.56187D0, 2.04622D0, 1.73730D0,
53317 & 1.52078D0, 0.99029D0, 0.62133D0, 0.46343D0, 0.37206D0,
53318 & 0.31151D0, 0.23502D0, 0.17068D0, 0.11483D0, 0.08444D0,
53319 & 0.05214D0, 0.03531D0, 0.02515D0, 0.01713D0, 0.01196D0,
53320 & 0.00850D0, 0.00608D0, 0.00437D0, 0.00315D0, 0.00226D0,
53321 & 0.00162D0, 0.00115D0, 0.00082D0, 0.00058D0, 0.00041D0,
53322 & 0.00030D0, 0.00024D0, 0.00017D0, 0.00010D0, 0.00006D0,
53323 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
53324 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53325 DATA (FMRS(1,7,I,38),I=1,49)/
53326 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53327 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53328 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53329 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53330 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53331 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53332 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53333 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53334 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53335 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53336 DATA (FMRS(1,8,I, 1),I=1,49)/
53337 & 0.88043D0, 0.77333D0, 0.67888D0, 0.62888D0, 0.59555D0,
53338 & 0.57086D0, 0.50019D0, 0.43775D0, 0.40464D0, 0.38254D0,
53339 & 0.36610D0, 0.31885D0, 0.27689D0, 0.25464D0, 0.23989D0,
53340 & 0.22903D0, 0.21364D0, 0.19859D0, 0.18303D0, 0.17273D0,
53341 & 0.15826D0, 0.14656D0, 0.13527D0, 0.12062D0, 0.10522D0,
53342 & 0.08955D0, 0.07420D0, 0.05981D0, 0.04692D0, 0.03554D0,
53343 & 0.02630D0, 0.01878D0, 0.01298D0, 0.00870D0, 0.00554D0,
53344 & 0.00339D0, 0.00198D0, 0.00110D0, 0.00049D0, 0.00026D0,
53345 & 0.00012D0, 0.00002D0, 0.00002D0, 0.00000D0, -0.00001D0,
53346 & -0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
53347 DATA (FMRS(1,8,I, 2),I=1,49)/
53348 & 0.89442D0, 0.78714D0, 0.69235D0, 0.64208D0, 0.60853D0,
53349 & 0.58367D0, 0.51236D0, 0.44919D0, 0.41561D0, 0.39314D0,
53350 & 0.37639D0, 0.32808D0, 0.28485D0, 0.26176D0, 0.24637D0,
53351 & 0.23501D0, 0.21882D0, 0.20291D0, 0.18634D0, 0.17532D0,
53352 & 0.15979D0, 0.14730D0, 0.13538D0, 0.12014D0, 0.10435D0,
53353 & 0.08847D0, 0.07306D0, 0.05873D0, 0.04595D0, 0.03477D0,
53354 & 0.02571D0, 0.01837D0, 0.01273D0, 0.00855D0, 0.00550D0,
53355 & 0.00340D0, 0.00204D0, 0.00117D0, 0.00055D0, 0.00031D0,
53356 & 0.00017D0, 0.00006D0, 0.00005D0, 0.00001D0, 0.00000D0,
53357 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53358 DATA (FMRS(1,8,I, 3),I=1,49)/
53359 & 0.93116D0, 0.82082D0, 0.72315D0, 0.67127D0, 0.63662D0,
53360 & 0.61092D0, 0.53708D0, 0.47148D0, 0.43647D0, 0.41299D0,
53361 & 0.39541D0, 0.34450D0, 0.29850D0, 0.27374D0, 0.25714D0,
53362 & 0.24483D0, 0.22722D0, 0.20981D0, 0.19154D0, 0.17933D0,
53363 & 0.16210D0, 0.14837D0, 0.13550D0, 0.11937D0, 0.10300D0,
53364 & 0.08681D0, 0.07133D0, 0.05711D0, 0.04449D0, 0.03362D0,
53365 & 0.02480D0, 0.01774D0, 0.01234D0, 0.00831D0, 0.00539D0,
53366 & 0.00338D0, 0.00208D0, 0.00122D0, 0.00062D0, 0.00038D0,
53367 & 0.00022D0, 0.00010D0, 0.00007D0, 0.00002D0, 0.00001D0,
53368 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53369 DATA (FMRS(1,8,I, 4),I=1,49)/
53370 & 0.97222D0, 0.85703D0, 0.75505D0, 0.70088D0, 0.66470D0,
53371 & 0.63785D0, 0.56070D0, 0.49207D0, 0.45539D0, 0.43075D0,
53372 & 0.41225D0, 0.35857D0, 0.30984D0, 0.28350D0, 0.26581D0,
53373 & 0.25266D0, 0.23382D0, 0.21514D0, 0.19549D0, 0.18234D0,
53374 & 0.16379D0, 0.14912D0, 0.13552D0, 0.11873D0, 0.10198D0,
53375 & 0.08556D0, 0.07005D0, 0.05591D0, 0.04344D0, 0.03278D0,
53376 & 0.02413D0, 0.01727D0, 0.01201D0, 0.00813D0, 0.00530D0,
53377 & 0.00334D0, 0.00207D0, 0.00123D0, 0.00065D0, 0.00042D0,
53378 & 0.00025D0, 0.00012D0, 0.00009D0, 0.00002D0, 0.00002D0,
53379 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53380 DATA (FMRS(1,8,I, 5),I=1,49)/
53381 & 1.03488D0, 0.91080D0, 0.80113D0, 0.74294D0, 0.70410D0,
53382 & 0.67529D0, 0.59258D0, 0.51904D0, 0.47974D0, 0.45332D0,
53383 & 0.43343D0, 0.37573D0, 0.32325D0, 0.29486D0, 0.27577D0,
53384 & 0.26158D0, 0.24123D0, 0.22104D0, 0.19979D0, 0.18555D0,
53385 & 0.16552D0, 0.14984D0, 0.13548D0, 0.11801D0, 0.10084D0,
53386 & 0.08422D0, 0.06865D0, 0.05459D0, 0.04229D0, 0.03183D0,
53387 & 0.02342D0, 0.01674D0, 0.01163D0, 0.00790D0, 0.00517D0,
53388 & 0.00326D0, 0.00204D0, 0.00126D0, 0.00069D0, 0.00044D0,
53389 & 0.00027D0, 0.00014D0, 0.00010D0, 0.00004D0, 0.00001D0,
53390 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53391 DATA (FMRS(1,8,I, 6),I=1,49)/
53392 & 1.09976D0, 0.96588D0, 0.84779D0, 0.78524D0, 0.74353D0,
53393 & 0.71261D0, 0.62395D0, 0.54523D0, 0.50318D0, 0.47492D0,
53394 & 0.45362D0, 0.39183D0, 0.33563D0, 0.30525D0, 0.28482D0,
53395 & 0.26964D0, 0.24787D0, 0.22628D0, 0.20357D0, 0.18835D0,
53396 & 0.16700D0, 0.15043D0, 0.13540D0, 0.11734D0, 0.09983D0,
53397 & 0.08303D0, 0.06744D0, 0.05346D0, 0.04131D0, 0.03103D0,
53398 & 0.02280D0, 0.01628D0, 0.01131D0, 0.00768D0, 0.00506D0,
53399 & 0.00319D0, 0.00201D0, 0.00126D0, 0.00071D0, 0.00044D0,
53400 & 0.00028D0, 0.00015D0, 0.00010D0, 0.00005D0, 0.00001D0,
53401 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53402 DATA (FMRS(1,8,I, 7),I=1,49)/
53403 & 1.17764D0, 1.03108D0, 0.90223D0, 0.83415D0, 0.78882D0,
53404 & 0.75526D0, 0.65918D0, 0.57411D0, 0.52875D0, 0.49829D0,
53405 & 0.47532D0, 0.40880D0, 0.34842D0, 0.31585D0, 0.29397D0,
53406 & 0.27773D0, 0.25447D0, 0.23144D0, 0.20722D0, 0.19102D0,
53407 & 0.16837D0, 0.15091D0, 0.13525D0, 0.11665D0, 0.09880D0,
53408 & 0.08184D0, 0.06625D0, 0.05236D0, 0.04036D0, 0.03026D0,
53409 & 0.02219D0, 0.01583D0, 0.01099D0, 0.00745D0, 0.00494D0,
53410 & 0.00313D0, 0.00199D0, 0.00124D0, 0.00071D0, 0.00044D0,
53411 & 0.00028D0, 0.00014D0, 0.00011D0, 0.00005D0, 0.00001D0,
53412 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53413 DATA (FMRS(1,8,I, 8),I=1,49)/
53414 & 1.27508D0, 1.11188D0, 0.96899D0, 0.89374D0, 0.84374D0,
53415 & 0.80677D0, 0.70124D0, 0.60814D0, 0.55864D0, 0.52545D0,
53416 & 0.50042D0, 0.42815D0, 0.36279D0, 0.32765D0, 0.30409D0,
53417 & 0.28664D0, 0.26167D0, 0.23701D0, 0.21111D0, 0.19383D0,
53418 & 0.16977D0, 0.15136D0, 0.13503D0, 0.11586D0, 0.09768D0,
53419 & 0.08056D0, 0.06499D0, 0.05119D0, 0.03935D0, 0.02943D0,
53420 & 0.02154D0, 0.01534D0, 0.01065D0, 0.00723D0, 0.00480D0,
53421 & 0.00305D0, 0.00194D0, 0.00121D0, 0.00071D0, 0.00043D0,
53422 & 0.00029D0, 0.00014D0, 0.00011D0, 0.00005D0, 0.00001D0,
53423 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53424 DATA (FMRS(1,8,I, 9),I=1,49)/
53425 & 1.37316D0, 1.19249D0, 1.03498D0, 0.95232D0, 0.89751D0,
53426 & 0.85705D0, 0.74185D0, 0.64064D0, 0.58699D0, 0.55108D0,
53427 & 0.52402D0, 0.44610D0, 0.37594D0, 0.33836D0, 0.31323D0,
53428 & 0.29464D0, 0.26809D0, 0.24193D0, 0.21452D0, 0.19627D0,
53429 & 0.17094D0, 0.15171D0, 0.13480D0, 0.11515D0, 0.09667D0,
53430 & 0.07946D0, 0.06388D0, 0.05018D0, 0.03847D0, 0.02871D0,
53431 & 0.02099D0, 0.01493D0, 0.01036D0, 0.00705D0, 0.00466D0,
53432 & 0.00297D0, 0.00189D0, 0.00119D0, 0.00071D0, 0.00043D0,
53433 & 0.00029D0, 0.00015D0, 0.00010D0, 0.00005D0, 0.00002D0,
53434 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53435 DATA (FMRS(1,8,I,10),I=1,49)/
53436 & 1.48232D0, 1.28141D0, 1.10710D0, 1.01596D0, 0.95567D0,
53437 & 0.91125D0, 0.78516D0, 0.67489D0, 0.61664D0, 0.57774D0,
53438 & 0.54846D0, 0.46445D0, 0.38919D0, 0.34906D0, 0.32230D0,
53439 & 0.30254D0, 0.27439D0, 0.24670D0, 0.21778D0, 0.19857D0,
53440 & 0.17201D0, 0.15198D0, 0.13451D0, 0.11441D0, 0.09567D0,
53441 & 0.07837D0, 0.06280D0, 0.04920D0, 0.03762D0, 0.02802D0,
53442 & 0.02045D0, 0.01454D0, 0.01009D0, 0.00685D0, 0.00453D0,
53443 & 0.00289D0, 0.00185D0, 0.00117D0, 0.00069D0, 0.00044D0,
53444 & 0.00029D0, 0.00015D0, 0.00011D0, 0.00004D0, 0.00002D0,
53445 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53446 DATA (FMRS(1,8,I,11),I=1,49)/
53447 & 1.57825D0, 1.35904D0, 1.16962D0, 1.07091D0, 1.00575D0,
53448 & 0.95780D0, 0.82207D0, 0.70384D0, 0.64159D0, 0.60009D0,
53449 & 0.56890D0, 0.47964D0, 0.40007D0, 0.35779D0, 0.32966D0,
53450 & 0.30893D0, 0.27945D0, 0.25052D0, 0.22036D0, 0.20038D0,
53451 & 0.17283D0, 0.15216D0, 0.13426D0, 0.11380D0, 0.09487D0,
53452 & 0.07750D0, 0.06195D0, 0.04843D0, 0.03696D0, 0.02748D0,
53453 & 0.02002D0, 0.01423D0, 0.00988D0, 0.00669D0, 0.00443D0,
53454 & 0.00283D0, 0.00181D0, 0.00116D0, 0.00068D0, 0.00044D0,
53455 & 0.00028D0, 0.00016D0, 0.00011D0, 0.00004D0, 0.00001D0,
53456 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53457 DATA (FMRS(1,8,I,12),I=1,49)/
53458 & 1.81391D0, 1.54794D0, 1.32027D0, 1.20251D0, 1.12515D0,
53459 & 1.06843D0, 0.90882D0, 0.77111D0, 0.69913D0, 0.65138D0,
53460 & 0.61560D0, 0.51392D0, 0.42424D0, 0.37702D0, 0.34578D0,
53461 & 0.32285D0, 0.29039D0, 0.25868D0, 0.22580D0, 0.20412D0,
53462 & 0.17445D0, 0.15244D0, 0.13361D0, 0.11242D0, 0.09312D0,
53463 & 0.07561D0, 0.06012D0, 0.04679D0, 0.03556D0, 0.02636D0,
53464 & 0.01913D0, 0.01356D0, 0.00940D0, 0.00637D0, 0.00422D0,
53465 & 0.00270D0, 0.00172D0, 0.00112D0, 0.00066D0, 0.00042D0,
53466 & 0.00027D0, 0.00016D0, 0.00011D0, 0.00004D0, 0.00001D0,
53467 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53468 DATA (FMRS(1,8,I,13),I=1,49)/
53469 & 2.05224D0, 1.73683D0, 1.46916D0, 1.33169D0, 1.24177D0,
53470 & 1.17604D0, 0.99216D0, 0.83488D0, 0.75325D0, 0.69933D0,
53471 & 0.65905D0, 0.54532D0, 0.44603D0, 0.39419D0, 0.36006D0,
53472 & 0.33511D0, 0.29992D0, 0.26571D0, 0.23041D0, 0.20724D0,
53473 & 0.17571D0, 0.15255D0, 0.13296D0, 0.11116D0, 0.09157D0,
53474 & 0.07397D0, 0.05855D0, 0.04538D0, 0.03436D0, 0.02540D0,
53475 & 0.01839D0, 0.01299D0, 0.00900D0, 0.00610D0, 0.00403D0,
53476 & 0.00259D0, 0.00165D0, 0.00107D0, 0.00064D0, 0.00040D0,
53477 & 0.00027D0, 0.00015D0, 0.00011D0, 0.00004D0, 0.00001D0,
53478 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53479 DATA (FMRS(1,8,I,14),I=1,49)/
53480 & 2.36037D0, 1.97834D0, 1.65740D0, 1.49390D0, 1.38749D0,
53481 & 1.31001D0, 1.09465D0, 0.91231D0, 0.81846D0, 0.75678D0,
53482 & 0.71089D0, 0.58224D0, 0.47125D0, 0.41385D0, 0.37630D0,
53483 & 0.34896D0, 0.31058D0, 0.27348D0, 0.23541D0, 0.21054D0,
53484 & 0.17694D0, 0.15252D0, 0.13212D0, 0.10968D0, 0.08980D0,
53485 & 0.07213D0, 0.05680D0, 0.04381D0, 0.03304D0, 0.02434D0,
53486 & 0.01758D0, 0.01241D0, 0.00857D0, 0.00582D0, 0.00382D0,
53487 & 0.00247D0, 0.00159D0, 0.00103D0, 0.00060D0, 0.00038D0,
53488 & 0.00026D0, 0.00014D0, 0.00011D0, 0.00004D0, 0.00001D0,
53489 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53490 DATA (FMRS(1,8,I,15),I=1,49)/
53491 & 2.73224D0, 2.26638D0, 1.87922D0, 1.68367D0, 1.55710D0,
53492 & 1.46530D0, 1.21194D0, 0.99975D0, 0.89148D0, 0.82073D0,
53493 & 0.76831D0, 0.62250D0, 0.49828D0, 0.43470D0, 0.39338D0,
53494 & 0.36342D0, 0.32158D0, 0.28138D0, 0.24036D0, 0.21374D0,
53495 & 0.17800D0, 0.15230D0, 0.13108D0, 0.10804D0, 0.08789D0,
53496 & 0.07017D0, 0.05499D0, 0.04222D0, 0.03170D0, 0.02325D0,
53497 & 0.01673D0, 0.01178D0, 0.00810D0, 0.00551D0, 0.00361D0,
53498 & 0.00232D0, 0.00150D0, 0.00098D0, 0.00058D0, 0.00036D0,
53499 & 0.00025D0, 0.00014D0, 0.00010D0, 0.00004D0, 0.00001D0,
53500 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53501 DATA (FMRS(1,8,I,16),I=1,49)/
53502 & 3.11511D0, 2.55975D0, 2.10267D0, 1.87361D0, 1.72607D0,
53503 & 1.61945D0, 1.32704D0, 1.08455D0, 0.96180D0, 0.88200D0,
53504 & 0.82308D0, 0.66038D0, 0.52333D0, 0.45384D0, 0.40893D0,
53505 & 0.37652D0, 0.33144D0, 0.28836D0, 0.24465D0, 0.21643D0,
53506 & 0.17877D0, 0.15196D0, 0.13002D0, 0.10649D0, 0.08613D0,
53507 & 0.06841D0, 0.05335D0, 0.04078D0, 0.03051D0, 0.02230D0,
53508 & 0.01601D0, 0.01123D0, 0.00772D0, 0.00522D0, 0.00344D0,
53509 & 0.00221D0, 0.00143D0, 0.00094D0, 0.00056D0, 0.00035D0,
53510 & 0.00023D0, 0.00014D0, 0.00009D0, 0.00004D0, 0.00001D0,
53511 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53512 DATA (FMRS(1,8,I,17),I=1,49)/
53513 & 3.54920D0, 2.88904D0, 2.35096D0, 2.08340D0, 1.91191D0,
53514 & 1.78843D0, 1.45191D0, 1.17555D0, 1.03678D0, 0.94701D0,
53515 & 0.88099D0, 0.69993D0, 0.54914D0, 0.47339D0, 0.42472D0,
53516 & 0.38973D0, 0.34130D0, 0.29525D0, 0.24881D0, 0.21897D0,
53517 & 0.17941D0, 0.15149D0, 0.12887D0, 0.10488D0, 0.08433D0,
53518 & 0.06664D0, 0.05172D0, 0.03936D0, 0.02933D0, 0.02138D0,
53519 & 0.01531D0, 0.01070D0, 0.00735D0, 0.00494D0, 0.00327D0,
53520 & 0.00210D0, 0.00135D0, 0.00089D0, 0.00053D0, 0.00034D0,
53521 & 0.00022D0, 0.00013D0, 0.00009D0, 0.00004D0, 0.00001D0,
53522 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53523 DATA (FMRS(1,8,I,18),I=1,49)/
53524 & 3.94722D0, 3.18825D0, 2.57451D0, 2.27128D0, 2.07769D0,
53525 & 1.93872D0, 1.56191D0, 1.25495D0, 1.10181D0, 1.00316D0,
53526 & 0.93081D0, 0.73357D0, 0.57081D0, 0.48966D0, 0.43777D0,
53527 & 0.40060D0, 0.34934D0, 0.30080D0, 0.25209D0, 0.22090D0,
53528 & 0.17980D0, 0.15100D0, 0.12785D0, 0.10349D0, 0.08283D0,
53529 & 0.06518D0, 0.05037D0, 0.03822D0, 0.02839D0, 0.02063D0,
53530 & 0.01472D0, 0.01026D0, 0.00705D0, 0.00475D0, 0.00313D0,
53531 & 0.00200D0, 0.00129D0, 0.00084D0, 0.00049D0, 0.00033D0,
53532 & 0.00020D0, 0.00013D0, 0.00009D0, 0.00003D0, 0.00001D0,
53533 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53534 DATA (FMRS(1,8,I,19),I=1,49)/
53535 & 4.47623D0, 3.58243D0, 2.86642D0, 2.51532D0, 2.29224D0,
53536 & 2.13264D0, 1.70256D0, 1.35552D0, 1.18371D0, 1.07357D0,
53537 & 0.99309D0, 0.77516D0, 0.59726D0, 0.50937D0, 0.45348D0,
53538 & 0.41360D0, 0.35886D0, 0.30730D0, 0.25582D0, 0.22304D0,
53539 & 0.18010D0, 0.15028D0, 0.12653D0, 0.10177D0, 0.08099D0,
53540 & 0.06341D0, 0.04879D0, 0.03686D0, 0.02728D0, 0.01973D0,
53541 & 0.01404D0, 0.00977D0, 0.00668D0, 0.00449D0, 0.00295D0,
53542 & 0.00189D0, 0.00122D0, 0.00079D0, 0.00046D0, 0.00031D0,
53543 & 0.00019D0, 0.00011D0, 0.00008D0, 0.00003D0, 0.00001D0,
53544 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53545 DATA (FMRS(1,8,I,20),I=1,49)/
53546 & 4.99213D0, 3.96349D0, 3.14614D0, 2.74797D0, 2.49601D0,
53547 & 2.31631D0, 1.83458D0, 1.44905D0, 1.25946D0, 1.13844D0,
53548 & 1.05027D0, 0.81294D0, 0.62102D0, 0.52694D0, 0.46740D0,
53549 & 0.42508D0, 0.36719D0, 0.31292D0, 0.25900D0, 0.22482D0,
53550 & 0.18028D0, 0.14958D0, 0.12531D0, 0.10024D0, 0.07938D0,
53551 & 0.06186D0, 0.04742D0, 0.03568D0, 0.02633D0, 0.01896D0,
53552 & 0.01347D0, 0.00937D0, 0.00636D0, 0.00427D0, 0.00280D0,
53553 & 0.00180D0, 0.00116D0, 0.00076D0, 0.00045D0, 0.00029D0,
53554 & 0.00019D0, 0.00009D0, 0.00007D0, 0.00003D0, 0.00001D0,
53555 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53556 DATA (FMRS(1,8,I,21),I=1,49)/
53557 & 5.49949D0, 4.33534D0, 3.41695D0, 2.97216D0, 2.69173D0,
53558 & 2.49225D0, 1.96002D0, 1.53717D0, 1.33047D0, 1.19901D0,
53559 & 1.10350D0, 0.84773D0, 0.64263D0, 0.54279D0, 0.47988D0,
53560 & 0.43530D0, 0.37453D0, 0.31778D0, 0.26166D0, 0.22622D0,
53561 & 0.18027D0, 0.14882D0, 0.12412D0, 0.09878D0, 0.07788D0,
53562 & 0.06045D0, 0.04618D0, 0.03463D0, 0.02546D0, 0.01831D0,
53563 & 0.01296D0, 0.00899D0, 0.00611D0, 0.00409D0, 0.00268D0,
53564 & 0.00172D0, 0.00111D0, 0.00073D0, 0.00045D0, 0.00028D0,
53565 & 0.00018D0, 0.00010D0, 0.00007D0, 0.00003D0, 0.00001D0,
53566 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53567 DATA (FMRS(1,8,I,22),I=1,49)/
53568 & 6.19994D0, 4.84455D0, 3.78480D0, 3.27524D0, 2.95541D0,
53569 & 2.72867D0, 2.12718D0, 1.65361D0, 1.42381D0, 1.27834D0,
53570 & 1.17300D0, 0.89272D0, 0.67027D0, 0.56291D0, 0.49563D0,
53571 & 0.44814D0, 0.38367D0, 0.32378D0, 0.26487D0, 0.22786D0,
53572 & 0.18016D0, 0.14778D0, 0.12256D0, 0.09693D0, 0.07601D0,
53573 & 0.05870D0, 0.04463D0, 0.03333D0, 0.02440D0, 0.01750D0,
53574 & 0.01234D0, 0.00854D0, 0.00580D0, 0.00388D0, 0.00253D0,
53575 & 0.00162D0, 0.00104D0, 0.00069D0, 0.00042D0, 0.00026D0,
53576 & 0.00018D0, 0.00010D0, 0.00006D0, 0.00003D0, 0.00001D0,
53577 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53578 DATA (FMRS(1,8,I,23),I=1,49)/
53579 & 6.91850D0, 5.36248D0, 4.15576D0, 3.57933D0, 3.21903D0,
53580 & 2.96436D0, 2.29236D0, 1.76765D0, 1.51472D0, 1.35530D0,
53581 & 1.24020D0, 0.93576D0, 0.69640D0, 0.58179D0, 0.51031D0,
53582 & 0.46004D0, 0.39207D0, 0.32922D0, 0.26771D0, 0.22925D0,
53583 & 0.17994D0, 0.14672D0, 0.12105D0, 0.09521D0, 0.07427D0,
53584 & 0.05708D0, 0.04320D0, 0.03213D0, 0.02345D0, 0.01676D0,
53585 & 0.01179D0, 0.00813D0, 0.00551D0, 0.00368D0, 0.00240D0,
53586 & 0.00152D0, 0.00099D0, 0.00064D0, 0.00039D0, 0.00024D0,
53587 & 0.00017D0, 0.00009D0, 0.00006D0, 0.00003D0, 0.00001D0,
53588 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53589 DATA (FMRS(1,8,I,24),I=1,49)/
53590 & 7.63491D0, 5.87479D0, 4.51976D0, 3.87632D0, 3.47562D0,
53591 & 3.19317D0, 2.45140D0, 1.87649D0, 1.60104D0, 1.42808D0,
53592 & 1.30355D0, 0.97589D0, 0.72045D0, 0.59900D0, 0.52360D0,
53593 & 0.47074D0, 0.39952D0, 0.33394D0, 0.27005D0, 0.23029D0,
53594 & 0.17956D0, 0.14561D0, 0.11956D0, 0.09355D0, 0.07262D0,
53595 & 0.05557D0, 0.04190D0, 0.03105D0, 0.02258D0, 0.01609D0,
53596 & 0.01128D0, 0.00777D0, 0.00525D0, 0.00350D0, 0.00227D0,
53597 & 0.00145D0, 0.00095D0, 0.00060D0, 0.00036D0, 0.00023D0,
53598 & 0.00015D0, 0.00008D0, 0.00006D0, 0.00003D0, 0.00001D0,
53599 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53600 DATA (FMRS(1,8,I,25),I=1,49)/
53601 & 8.40875D0, 6.42416D0, 4.90727D0, 4.19114D0, 3.74679D0,
53602 & 3.43441D0, 2.61784D0, 1.98954D0, 1.69029D0, 1.50308D0,
53603 & 1.36865D0, 1.01677D0, 0.74472D0, 0.61626D0, 0.53686D0,
53604 & 0.48138D0, 0.40687D0, 0.33856D0, 0.27230D0, 0.23124D0,
53605 & 0.17912D0, 0.14448D0, 0.11807D0, 0.09190D0, 0.07100D0,
53606 & 0.05410D0, 0.04063D0, 0.03001D0, 0.02174D0, 0.01545D0,
53607 & 0.01080D0, 0.00742D0, 0.00500D0, 0.00332D0, 0.00215D0,
53608 & 0.00138D0, 0.00091D0, 0.00056D0, 0.00034D0, 0.00022D0,
53609 & 0.00014D0, 0.00008D0, 0.00005D0, 0.00002D0, 0.00001D0,
53610 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53611 DATA (FMRS(1,8,I,26),I=1,49)/
53612 & 9.20959D0, 6.98865D0, 5.30257D0, 4.51092D0, 4.02140D0,
53613 & 3.67813D0, 2.78472D0, 2.10201D0, 1.77866D0, 1.57708D0,
53614 & 1.43269D0, 1.05659D0, 0.76808D0, 0.63273D0, 0.54942D0,
53615 & 0.49139D0, 0.41371D0, 0.34277D0, 0.27426D0, 0.23197D0,
53616 & 0.17855D0, 0.14327D0, 0.11656D0, 0.09025D0, 0.06944D0,
53617 & 0.05268D0, 0.03941D0, 0.02899D0, 0.02094D0, 0.01485D0,
53618 & 0.01035D0, 0.00708D0, 0.00476D0, 0.00316D0, 0.00205D0,
53619 & 0.00131D0, 0.00085D0, 0.00054D0, 0.00031D0, 0.00021D0,
53620 & 0.00013D0, 0.00008D0, 0.00005D0, 0.00002D0, 0.00001D0,
53621 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53622 DATA (FMRS(1,8,I,27),I=1,49)/
53623 & 10.01660D0, 7.55374D0, 5.69567D0, 4.82767D0, 4.29265D0,
53624 & 3.91834D0, 2.94808D0, 2.21134D0, 1.86419D0, 1.64848D0,
53625 & 1.49433D0, 1.09459D0, 0.79015D0, 0.64820D0, 0.56116D0,
53626 & 0.50070D0, 0.42001D0, 0.34660D0, 0.27598D0, 0.23256D0,
53627 & 0.17794D0, 0.14210D0, 0.11511D0, 0.08871D0, 0.06797D0,
53628 & 0.05137D0, 0.03829D0, 0.02806D0, 0.02022D0, 0.01430D0,
53629 & 0.00994D0, 0.00679D0, 0.00455D0, 0.00301D0, 0.00196D0,
53630 & 0.00124D0, 0.00081D0, 0.00052D0, 0.00030D0, 0.00020D0,
53631 & 0.00013D0, 0.00008D0, 0.00005D0, 0.00002D0, 0.00001D0,
53632 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53633 DATA (FMRS(1,8,I,28),I=1,49)/
53634 & 10.81622D0, 8.11020D0, 6.08037D0, 5.13653D0, 4.55643D0,
53635 & 4.15146D0, 3.10560D0, 2.31605D0, 1.94577D0, 1.71637D0,
53636 & 1.55278D0, 1.13032D0, 0.81070D0, 0.66250D0, 0.57195D0,
53637 & 0.50921D0, 0.42571D0, 0.35000D0, 0.27744D0, 0.23299D0,
53638 & 0.17730D0, 0.14094D0, 0.11373D0, 0.08726D0, 0.06658D0,
53639 & 0.05015D0, 0.03725D0, 0.02723D0, 0.01957D0, 0.01380D0,
53640 & 0.00957D0, 0.00653D0, 0.00437D0, 0.00288D0, 0.00188D0,
53641 & 0.00119D0, 0.00077D0, 0.00050D0, 0.00029D0, 0.00019D0,
53642 & 0.00012D0, 0.00007D0, 0.00005D0, 0.00002D0, 0.00001D0,
53643 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53644 DATA (FMRS(1,8,I,29),I=1,49)/
53645 & 11.66230D0, 8.69558D0, 6.48269D0, 5.45841D0, 4.83067D0,
53646 & 4.39335D0, 3.26805D0, 2.42336D0, 2.02906D0, 1.78549D0,
53647 & 1.61215D0, 1.16634D0, 0.83123D0, 0.67669D0, 0.58260D0,
53648 & 0.51757D0, 0.43126D0, 0.35327D0, 0.27879D0, 0.23332D0,
53649 & 0.17659D0, 0.13975D0, 0.11233D0, 0.08581D0, 0.06521D0,
53650 & 0.04895D0, 0.03623D0, 0.02642D0, 0.01893D0, 0.01332D0,
53651 & 0.00922D0, 0.00628D0, 0.00420D0, 0.00276D0, 0.00179D0,
53652 & 0.00113D0, 0.00073D0, 0.00048D0, 0.00028D0, 0.00018D0,
53653 & 0.00012D0, 0.00007D0, 0.00004D0, 0.00001D0, 0.00001D0,
53654 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53655 DATA (FMRS(1,8,I,30),I=1,49)/
53656 & 12.53147D0, 9.29349D0, 6.89124D0, 5.78416D0, 5.10752D0,
53657 & 4.63707D0, 3.43073D0, 2.53015D0, 2.11162D0, 1.85381D0,
53658 & 1.67070D0, 1.20157D0, 0.85112D0, 0.69035D0, 0.59278D0,
53659 & 0.52552D0, 0.43648D0, 0.35628D0, 0.27996D0, 0.23352D0,
53660 & 0.17581D0, 0.13853D0, 0.11093D0, 0.08439D0, 0.06389D0,
53661 & 0.04778D0, 0.03525D0, 0.02563D0, 0.01832D0, 0.01286D0,
53662 & 0.00888D0, 0.00603D0, 0.00403D0, 0.00265D0, 0.00171D0,
53663 & 0.00109D0, 0.00070D0, 0.00046D0, 0.00026D0, 0.00017D0,
53664 & 0.00011D0, 0.00006D0, 0.00004D0, 0.00001D0, 0.00000D0,
53665 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53666 DATA (FMRS(1,8,I,31),I=1,49)/
53667 & 13.39986D0, 9.88770D0, 7.29509D0, 6.10513D0, 5.37969D0,
53668 & 4.87627D0, 3.58951D0, 2.63377D0, 2.19145D0, 1.91971D0,
53669 & 1.72706D0, 1.23525D0, 0.86997D0, 0.70322D0, 0.60234D0,
53670 & 0.53296D0, 0.44131D0, 0.35903D0, 0.28099D0, 0.23364D0,
53671 & 0.17503D0, 0.13736D0, 0.10960D0, 0.08305D0, 0.06264D0,
53672 & 0.04669D0, 0.03435D0, 0.02491D0, 0.01775D0, 0.01244D0,
53673 & 0.00857D0, 0.00581D0, 0.00387D0, 0.00255D0, 0.00164D0,
53674 & 0.00105D0, 0.00067D0, 0.00044D0, 0.00025D0, 0.00016D0,
53675 & 0.00011D0, 0.00006D0, 0.00004D0, 0.00002D0, 0.00000D0,
53676 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53677 DATA (FMRS(1,8,I,32),I=1,49)/
53678 & 14.24690D0, 10.46430D0, 7.68491D0, 6.41400D0, 5.64102D0,
53679 & 5.10551D0, 3.74084D0, 2.73196D0, 2.26682D0, 1.98174D0,
53680 & 1.77998D0, 1.26662D0, 0.88736D0, 0.71501D0, 0.61103D0,
53681 & 0.53966D0, 0.44562D0, 0.36142D0, 0.28180D0, 0.23363D0,
53682 & 0.17423D0, 0.13620D0, 0.10832D0, 0.08177D0, 0.06147D0,
53683 & 0.04567D0, 0.03352D0, 0.02425D0, 0.01724D0, 0.01204D0,
53684 & 0.00828D0, 0.00559D0, 0.00373D0, 0.00245D0, 0.00158D0,
53685 & 0.00099D0, 0.00065D0, 0.00042D0, 0.00024D0, 0.00015D0,
53686 & 0.00010D0, 0.00006D0, 0.00004D0, 0.00002D0, 0.00000D0,
53687 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53688 DATA (FMRS(1,8,I,33),I=1,49)/
53689 & 15.14936D0, 11.07583D0, 8.09647D0, 6.73922D0, 5.91564D0,
53690 & 5.34608D0, 3.89891D0, 2.83403D0, 2.34496D0, 2.04593D0,
53691 & 1.83464D0, 1.29886D0, 0.90513D0, 0.72701D0, 0.61986D0,
53692 & 0.54647D0, 0.44998D0, 0.36383D0, 0.28262D0, 0.23362D0,
53693 & 0.17343D0, 0.13505D0, 0.10704D0, 0.08050D0, 0.06032D0,
53694 & 0.04468D0, 0.03270D0, 0.02360D0, 0.01675D0, 0.01165D0,
53695 & 0.00800D0, 0.00538D0, 0.00360D0, 0.00236D0, 0.00153D0,
53696 & 0.00094D0, 0.00062D0, 0.00040D0, 0.00024D0, 0.00014D0,
53697 & 0.00010D0, 0.00005D0, 0.00004D0, 0.00002D0, 0.00000D0,
53698 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53699 DATA (FMRS(1,8,I,34),I=1,49)/
53700 & 16.05264D0, 11.68476D0, 8.50413D0, 7.06033D0, 6.18619D0,
53701 & 5.58264D0, 4.05344D0, 2.93321D0, 2.42057D0, 2.10785D0,
53702 & 1.88726D0, 1.32960D0, 0.92187D0, 0.73821D0, 0.62802D0,
53703 & 0.55270D0, 0.45389D0, 0.36590D0, 0.28320D0, 0.23345D0,
53704 & 0.17251D0, 0.13385D0, 0.10575D0, 0.07924D0, 0.05918D0,
53705 & 0.04371D0, 0.03189D0, 0.02297D0, 0.01625D0, 0.01129D0,
53706 & 0.00773D0, 0.00520D0, 0.00346D0, 0.00227D0, 0.00146D0,
53707 & 0.00090D0, 0.00059D0, 0.00038D0, 0.00022D0, 0.00014D0,
53708 & 0.00009D0, 0.00005D0, 0.00004D0, 0.00001D0, 0.00000D0,
53709 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53710 DATA (FMRS(1,8,I,35),I=1,49)/
53711 & 16.95831D0, 12.29275D0, 8.90942D0, 7.37879D0, 6.45402D0,
53712 & 5.81651D0, 4.20556D0, 3.03041D0, 2.49449D0, 2.16827D0,
53713 & 1.93852D0, 1.35941D0, 0.93802D0, 0.74899D0, 0.63586D0,
53714 & 0.55868D0, 0.45763D0, 0.36787D0, 0.28375D0, 0.23328D0,
53715 & 0.17165D0, 0.13272D0, 0.10453D0, 0.07807D0, 0.05811D0,
53716 & 0.04281D0, 0.03114D0, 0.02238D0, 0.01579D0, 0.01096D0,
53717 & 0.00748D0, 0.00503D0, 0.00334D0, 0.00218D0, 0.00141D0,
53718 & 0.00087D0, 0.00056D0, 0.00036D0, 0.00021D0, 0.00013D0,
53719 & 0.00009D0, 0.00005D0, 0.00004D0, 0.00001D0, 0.00000D0,
53720 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53721 DATA (FMRS(1,8,I,36),I=1,49)/
53722 & 17.84218D0, 12.88352D0, 9.30151D0, 7.68607D0, 6.71197D0,
53723 & 6.04141D0, 4.35117D0, 3.12299D0, 2.56467D0, 2.22550D0,
53724 & 1.98697D0, 1.38741D0, 0.95307D0, 0.75895D0, 0.64306D0,
53725 & 0.56414D0, 0.46100D0, 0.36960D0, 0.28418D0, 0.23305D0,
53726 & 0.17079D0, 0.13162D0, 0.10337D0, 0.07695D0, 0.05711D0,
53727 & 0.04196D0, 0.03045D0, 0.02184D0, 0.01537D0, 0.01065D0,
53728 & 0.00725D0, 0.00488D0, 0.00323D0, 0.00211D0, 0.00135D0,
53729 & 0.00084D0, 0.00054D0, 0.00035D0, 0.00020D0, 0.00012D0,
53730 & 0.00009D0, 0.00005D0, 0.00003D0, 0.00001D0, 0.00000D0,
53731 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53732 DATA (FMRS(1,8,I,37),I=1,49)/
53733 & 18.75837D0, 13.49331D0, 9.70449D0, 8.00107D0, 6.97591D0,
53734 & 6.27121D0, 4.49926D0, 3.21668D0, 2.63548D0, 2.28312D0,
53735 & 2.03566D0, 1.41534D0, 0.96795D0, 0.76874D0, 0.65009D0,
53736 & 0.56943D0, 0.46423D0, 0.37122D0, 0.28450D0, 0.23274D0,
53737 & 0.16989D0, 0.13050D0, 0.10219D0, 0.07583D0, 0.05612D0,
53738 & 0.04112D0, 0.02978D0, 0.02129D0, 0.01496D0, 0.01035D0,
53739 & 0.00703D0, 0.00473D0, 0.00312D0, 0.00203D0, 0.00130D0,
53740 & 0.00081D0, 0.00052D0, 0.00034D0, 0.00019D0, 0.00012D0,
53741 & 0.00008D0, 0.00005D0, 0.00003D0, 0.00001D0, 0.00000D0,
53742 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53743 DATA (FMRS(1,8,I,38),I=1,49)/
53744 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53745 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53746 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53747 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53748 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53749 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53750 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53751 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53752 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53753 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53754 DATA (FMRS(2,1,I, 1),I=1,49)/
53755 & 0.01616D0, 0.01968D0, 0.02397D0, 0.02690D0, 0.02921D0,
53756 & 0.03113D0, 0.03797D0, 0.04639D0, 0.05222D0, 0.05685D0,
53757 & 0.06076D0, 0.07508D0, 0.09409D0, 0.10852D0, 0.12095D0,
53758 & 0.13220D0, 0.15265D0, 0.18041D0, 0.22265D0, 0.26180D0,
53759 & 0.33338D0, 0.39710D0, 0.45318D0, 0.51262D0, 0.56037D0,
53760 & 0.59685D0, 0.62256D0, 0.63820D0, 0.64458D0, 0.64218D0,
53761 & 0.63256D0, 0.61605D0, 0.59381D0, 0.56668D0, 0.53544D0,
53762 & 0.50113D0, 0.46441D0, 0.42608D0, 0.38703D0, 0.34764D0,
53763 & 0.30873D0, 0.27101D0, 0.23457D0, 0.16829D0, 0.11224D0,
53764 & 0.06802D0, 0.03588D0, 0.00449D0, 0.00000D0/
53765 DATA (FMRS(2,1,I, 2),I=1,49)/
53766 & 0.01632D0, 0.01989D0, 0.02423D0, 0.02721D0, 0.02954D0,
53767 & 0.03149D0, 0.03843D0, 0.04698D0, 0.05290D0, 0.05761D0,
53768 & 0.06159D0, 0.07621D0, 0.09566D0, 0.11046D0, 0.12320D0,
53769 & 0.13473D0, 0.15566D0, 0.18401D0, 0.22694D0, 0.26649D0,
53770 & 0.33826D0, 0.40154D0, 0.45671D0, 0.51456D0, 0.56041D0,
53771 & 0.59481D0, 0.61838D0, 0.63191D0, 0.63628D0, 0.63211D0,
53772 & 0.62085D0, 0.60298D0, 0.57964D0, 0.55165D0, 0.51988D0,
53773 & 0.48526D0, 0.44851D0, 0.41042D0, 0.37182D0, 0.33308D0,
53774 & 0.29500D0, 0.25823D0, 0.22287D0, 0.15893D0, 0.10532D0,
53775 & 0.06336D0, 0.03315D0, 0.00405D0, 0.00000D0/
53776 DATA (FMRS(2,1,I, 3),I=1,49)/
53777 & 0.01657D0, 0.02020D0, 0.02463D0, 0.02767D0, 0.03005D0,
53778 & 0.03204D0, 0.03912D0, 0.04786D0, 0.05393D0, 0.05876D0,
53779 & 0.06285D0, 0.07791D0, 0.09803D0, 0.11338D0, 0.12658D0,
53780 & 0.13853D0, 0.16018D0, 0.18937D0, 0.23326D0, 0.27335D0,
53781 & 0.34527D0, 0.40778D0, 0.46152D0, 0.51696D0, 0.55995D0,
53782 & 0.59126D0, 0.61170D0, 0.62221D0, 0.62369D0, 0.61697D0,
53783 & 0.60343D0, 0.58371D0, 0.55889D0, 0.52978D0, 0.49735D0,
53784 & 0.46237D0, 0.42568D0, 0.38804D0, 0.35014D0, 0.31246D0,
53785 & 0.27562D0, 0.24027D0, 0.20650D0, 0.14595D0, 0.09580D0,
53786 & 0.05701D0, 0.02946D0, 0.00347D0, 0.00000D0/
53787 DATA (FMRS(2,1,I, 4),I=1,49)/
53788 & 0.01676D0, 0.02044D0, 0.02493D0, 0.02801D0, 0.03042D0,
53789 & 0.03244D0, 0.03964D0, 0.04852D0, 0.05470D0, 0.05962D0,
53790 & 0.06379D0, 0.07918D0, 0.09980D0, 0.11554D0, 0.12909D0,
53791 & 0.14134D0, 0.16349D0, 0.19329D0, 0.23784D0, 0.27828D0,
53792 & 0.35023D0, 0.41207D0, 0.46471D0, 0.51833D0, 0.55923D0,
53793 & 0.58830D0, 0.60648D0, 0.61486D0, 0.61433D0, 0.60584D0,
53794 & 0.59072D0, 0.56980D0, 0.54398D0, 0.51418D0, 0.48131D0,
53795 & 0.44619D0, 0.40966D0, 0.37236D0, 0.33505D0, 0.29814D0,
53796 & 0.26220D0, 0.22791D0, 0.19528D0, 0.13713D0, 0.08936D0,
53797 & 0.05277D0, 0.02703D0, 0.00310D0, 0.00000D0/
53798 DATA (FMRS(2,1,I, 5),I=1,49)/
53799 & 0.01695D0, 0.02068D0, 0.02524D0, 0.02837D0, 0.03082D0,
53800 & 0.03287D0, 0.04018D0, 0.04922D0, 0.05552D0, 0.06053D0,
53801 & 0.06480D0, 0.08053D0, 0.10168D0, 0.11784D0, 0.13174D0,
53802 & 0.14430D0, 0.16698D0, 0.19737D0, 0.24257D0, 0.28331D0,
53803 & 0.35517D0, 0.41625D0, 0.46767D0, 0.51932D0, 0.55801D0,
53804 & 0.58472D0, 0.60061D0, 0.60677D0, 0.60420D0, 0.59394D0,
53805 & 0.57732D0, 0.55511D0, 0.52831D0, 0.49795D0, 0.46473D0,
53806 & 0.42958D0, 0.39324D0, 0.35636D0, 0.31976D0, 0.28363D0,
53807 & 0.24869D0, 0.21549D0, 0.18405D0, 0.12838D0, 0.08307D0,
53808 & 0.04866D0, 0.02468D0, 0.00276D0, 0.00000D0/
53809 DATA (FMRS(2,1,I, 6),I=1,49)/
53810 & 0.01712D0, 0.02090D0, 0.02552D0, 0.02868D0, 0.03117D0,
53811 & 0.03325D0, 0.04066D0, 0.04984D0, 0.05623D0, 0.06133D0,
53812 & 0.06568D0, 0.08172D0, 0.10333D0, 0.11984D0, 0.13405D0,
53813 & 0.14688D0, 0.17001D0, 0.20090D0, 0.24663D0, 0.28761D0,
53814 & 0.35934D0, 0.41972D0, 0.47004D0, 0.51998D0, 0.55675D0,
53815 & 0.58145D0, 0.59540D0, 0.59970D0, 0.59545D0, 0.58373D0,
53816 & 0.56587D0, 0.54263D0, 0.51509D0, 0.48426D0, 0.45082D0,
53817 & 0.41570D0, 0.37956D0, 0.34309D0, 0.30710D0, 0.27167D0,
53818 & 0.23758D0, 0.20532D0, 0.17488D0, 0.12129D0, 0.07799D0,
53819 & 0.04537D0, 0.02283D0, 0.00249D0, 0.00000D0/
53820 DATA (FMRS(2,1,I, 7),I=1,49)/
53821 & 0.01728D0, 0.02111D0, 0.02578D0, 0.02899D0, 0.03151D0,
53822 & 0.03361D0, 0.04113D0, 0.05044D0, 0.05693D0, 0.06211D0,
53823 & 0.06653D0, 0.08287D0, 0.10492D0, 0.12178D0, 0.13628D0,
53824 & 0.14936D0, 0.17290D0, 0.20425D0, 0.25045D0, 0.29164D0,
53825 & 0.36316D0, 0.42280D0, 0.47203D0, 0.52030D0, 0.55522D0,
53826 & 0.57804D0, 0.59016D0, 0.59271D0, 0.58692D0, 0.57390D0,
53827 & 0.55488D0, 0.53075D0, 0.50265D0, 0.47135D0, 0.43776D0,
53828 & 0.40267D0, 0.36679D0, 0.33078D0, 0.29535D0, 0.26064D0,
53829 & 0.22735D0, 0.19600D0, 0.16649D0, 0.11484D0, 0.07339D0,
53830 & 0.04241D0, 0.02117D0, 0.00226D0, 0.00000D0/
53831 DATA (FMRS(2,1,I, 8),I=1,49)/
53832 & 0.01745D0, 0.02133D0, 0.02606D0, 0.02931D0, 0.03187D0,
53833 & 0.03400D0, 0.04163D0, 0.05108D0, 0.05768D0, 0.06295D0,
53834 & 0.06745D0, 0.08411D0, 0.10662D0, 0.12385D0, 0.13865D0,
53835 & 0.15200D0, 0.17596D0, 0.20780D0, 0.25445D0, 0.29582D0,
53836 & 0.36707D0, 0.42589D0, 0.47392D0, 0.52041D0, 0.55338D0,
53837 & 0.57422D0, 0.58442D0, 0.58519D0, 0.57783D0, 0.56344D0,
53838 & 0.54329D0, 0.51831D0, 0.48960D0, 0.45793D0, 0.42423D0,
53839 & 0.38922D0, 0.35366D0, 0.31814D0, 0.28333D0, 0.24940D0,
53840 & 0.21696D0, 0.18656D0, 0.15803D0, 0.10837D0, 0.06882D0,
53841 & 0.03949D0, 0.01956D0, 0.00204D0, 0.00000D0/
53842 DATA (FMRS(2,1,I, 9),I=1,49)/
53843 & 0.01760D0, 0.02152D0, 0.02631D0, 0.02960D0, 0.03218D0,
53844 & 0.03434D0, 0.04207D0, 0.05164D0, 0.05833D0, 0.06368D0,
53845 & 0.06825D0, 0.08519D0, 0.10811D0, 0.12566D0, 0.14073D0,
53846 & 0.15430D0, 0.17863D0, 0.21087D0, 0.25789D0, 0.29938D0,
53847 & 0.37036D0, 0.42844D0, 0.47541D0, 0.52034D0, 0.55162D0,
53848 & 0.57077D0, 0.57932D0, 0.57861D0, 0.56993D0, 0.55438D0,
53849 & 0.53332D0, 0.50767D0, 0.47844D0, 0.44653D0, 0.41277D0,
53850 & 0.37787D0, 0.34261D0, 0.30753D0, 0.27327D0, 0.24001D0,
53851 & 0.20832D0, 0.17873D0, 0.15102D0, 0.10304D0, 0.06508D0,
53852 & 0.03712D0, 0.01826D0, 0.00186D0, 0.00000D0/
53853 DATA (FMRS(2,1,I,10),I=1,49)/
53854 & 0.01775D0, 0.02171D0, 0.02655D0, 0.02988D0, 0.03249D0,
53855 & 0.03468D0, 0.04249D0, 0.05219D0, 0.05897D0, 0.06440D0,
53856 & 0.06904D0, 0.08625D0, 0.10956D0, 0.12741D0, 0.14273D0,
53857 & 0.15651D0, 0.18119D0, 0.21379D0, 0.26115D0, 0.30273D0,
53858 & 0.37339D0, 0.43070D0, 0.47663D0, 0.52004D0, 0.54971D0,
53859 & 0.56723D0, 0.57424D0, 0.57214D0, 0.56221D0, 0.54564D0,
53860 & 0.52375D0, 0.49748D0, 0.46783D0, 0.43572D0, 0.40192D0,
53861 & 0.36718D0, 0.33221D0, 0.29755D0, 0.26385D0, 0.23124D0,
53862 & 0.20028D0, 0.17145D0, 0.14454D0, 0.09813D0, 0.06166D0,
53863 & 0.03497D0, 0.01708D0, 0.00171D0, 0.00000D0/
53864 DATA (FMRS(2,1,I,11),I=1,49)/
53865 & 0.01786D0, 0.02185D0, 0.02674D0, 0.03010D0, 0.03274D0,
53866 & 0.03494D0, 0.04284D0, 0.05263D0, 0.05949D0, 0.06497D0,
53867 & 0.06967D0, 0.08709D0, 0.11072D0, 0.12880D0, 0.14432D0,
53868 & 0.15827D0, 0.18322D0, 0.21609D0, 0.26371D0, 0.30535D0,
53869 & 0.37572D0, 0.43240D0, 0.47751D0, 0.51970D0, 0.54811D0,
53870 & 0.56435D0, 0.57017D0, 0.56701D0, 0.55612D0, 0.53878D0,
53871 & 0.51626D0, 0.48950D0, 0.45957D0, 0.42732D0, 0.39351D0,
53872 & 0.35893D0, 0.32420D0, 0.28986D0, 0.25663D0, 0.22452D0,
53873 & 0.19414D0, 0.16588D0, 0.13961D0, 0.09442D0, 0.05909D0,
53874 & 0.03336D0, 0.01621D0, 0.00160D0, 0.00000D0/
53875 DATA (FMRS(2,1,I,12),I=1,49)/
53876 & 0.01811D0, 0.02217D0, 0.02715D0, 0.03057D0, 0.03326D0,
53877 & 0.03551D0, 0.04357D0, 0.05358D0, 0.06059D0, 0.06620D0,
53878 & 0.07102D0, 0.08890D0, 0.11320D0, 0.13179D0, 0.14772D0,
53879 & 0.16201D0, 0.18751D0, 0.22095D0, 0.26905D0, 0.31076D0,
53880 & 0.38043D0, 0.43573D0, 0.47902D0, 0.51865D0, 0.54434D0,
53881 & 0.55794D0, 0.56131D0, 0.55592D0, 0.54308D0, 0.52418D0,
53882 & 0.50041D0, 0.47277D0, 0.44227D0, 0.40979D0, 0.37605D0,
53883 & 0.34185D0, 0.30765D0, 0.27411D0, 0.24188D0, 0.21085D0,
53884 & 0.18166D0, 0.15463D0, 0.12966D0, 0.08698D0, 0.05397D0,
53885 & 0.03017D0, 0.01449D0, 0.00138D0, 0.00000D0/
53886 DATA (FMRS(2,1,I,13),I=1,49)/
53887 & 0.01832D0, 0.02245D0, 0.02751D0, 0.03099D0, 0.03372D0,
53888 & 0.03601D0, 0.04421D0, 0.05440D0, 0.06155D0, 0.06727D0,
53889 & 0.07220D0, 0.09048D0, 0.11535D0, 0.13437D0, 0.15065D0,
53890 & 0.16524D0, 0.19119D0, 0.22510D0, 0.27356D0, 0.31528D0,
53891 & 0.38427D0, 0.43832D0, 0.48002D0, 0.51742D0, 0.54081D0,
53892 & 0.55220D0, 0.55352D0, 0.54629D0, 0.53189D0, 0.51174D0,
53893 & 0.48699D0, 0.45870D0, 0.42778D0, 0.39517D0, 0.36159D0,
53894 & 0.32774D0, 0.29406D0, 0.26124D0, 0.22984D0, 0.19975D0,
53895 & 0.17155D0, 0.14556D0, 0.12166D0, 0.08107D0, 0.04993D0,
53896 & 0.02767D0, 0.01316D0, 0.00122D0, 0.00000D0/
53897 DATA (FMRS(2,1,I,14),I=1,49)/
53898 & 0.01856D0, 0.02276D0, 0.02791D0, 0.03145D0, 0.03424D0,
53899 & 0.03657D0, 0.04493D0, 0.05533D0, 0.06263D0, 0.06849D0,
53900 & 0.07353D0, 0.09227D0, 0.11778D0, 0.13727D0, 0.15393D0,
53901 & 0.16884D0, 0.19528D0, 0.22966D0, 0.27847D0, 0.32014D0,
53902 & 0.38833D0, 0.44089D0, 0.48079D0, 0.51572D0, 0.53660D0,
53903 & 0.54555D0, 0.54466D0, 0.53550D0, 0.51948D0, 0.49806D0,
53904 & 0.47232D0, 0.44337D0, 0.41209D0, 0.37941D0, 0.34606D0,
53905 & 0.31264D0, 0.27962D0, 0.24761D0, 0.21707D0, 0.18804D0,
53906 & 0.16093D0, 0.13609D0, 0.11331D0, 0.07496D0, 0.04577D0,
53907 & 0.02513D0, 0.01183D0, 0.00106D0, 0.00000D0/
53908 DATA (FMRS(2,1,I,15),I=1,49)/
53909 & 0.01882D0, 0.02309D0, 0.02833D0, 0.03194D0, 0.03478D0,
53910 & 0.03716D0, 0.04569D0, 0.05632D0, 0.06378D0, 0.06977D0,
53911 & 0.07493D0, 0.09414D0, 0.12031D0, 0.14028D0, 0.15732D0,
53912 & 0.17254D0, 0.19946D0, 0.23430D0, 0.28337D0, 0.32492D0,
53913 & 0.39212D0, 0.44309D0, 0.48109D0, 0.51344D0, 0.53176D0,
53914 & 0.53830D0, 0.53520D0, 0.52410D0, 0.50654D0, 0.48389D0,
53915 & 0.45725D0, 0.42772D0, 0.39621D0, 0.36351D0, 0.33050D0,
53916 & 0.29757D0, 0.26525D0, 0.23404D0, 0.20451D0, 0.17653D0,
53917 & 0.15059D0, 0.12691D0, 0.10526D0, 0.06909D0, 0.04183D0,
53918 & 0.02276D0, 0.01059D0, 0.00092D0, 0.00000D0/
53919 DATA (FMRS(2,1,I,16),I=1,49)/
53920 & 0.01904D0, 0.02338D0, 0.02872D0, 0.03239D0, 0.03528D0,
53921 & 0.03770D0, 0.04639D0, 0.05722D0, 0.06483D0, 0.07094D0,
53922 & 0.07621D0, 0.09585D0, 0.12261D0, 0.14301D0, 0.16039D0,
53923 & 0.17588D0, 0.20321D0, 0.23842D0, 0.28769D0, 0.32908D0,
53924 & 0.39530D0, 0.44481D0, 0.48105D0, 0.51110D0, 0.52712D0,
53925 & 0.53155D0, 0.52655D0, 0.51382D0, 0.49491D0, 0.47126D0,
53926 & 0.44390D0, 0.41395D0, 0.38228D0, 0.34968D0, 0.31695D0,
53927 & 0.28453D0, 0.25288D0, 0.22245D0, 0.19380D0, 0.16677D0,
53928 & 0.14180D0, 0.11912D0, 0.09847D0, 0.06418D0, 0.03856D0,
53929 & 0.02081D0, 0.00959D0, 0.00081D0, 0.00000D0/
53930 DATA (FMRS(2,1,I,17),I=1,49)/
53931 & 0.01928D0, 0.02369D0, 0.02911D0, 0.03284D0, 0.03578D0,
53932 & 0.03825D0, 0.04709D0, 0.05813D0, 0.06589D0, 0.07213D0,
53933 & 0.07751D0, 0.09758D0, 0.12493D0, 0.14576D0, 0.16348D0,
53934 & 0.17924D0, 0.20696D0, 0.24251D0, 0.29193D0, 0.33312D0,
53935 & 0.39831D0, 0.44629D0, 0.48077D0, 0.50852D0, 0.52228D0,
53936 & 0.52463D0, 0.51781D0, 0.50355D0, 0.48335D0, 0.45879D0,
53937 & 0.43078D0, 0.40049D0, 0.36872D0, 0.33629D0, 0.30386D0,
53938 & 0.27197D0, 0.24101D0, 0.21137D0, 0.18360D0, 0.15751D0,
53939 & 0.13349D0, 0.11178D0, 0.09210D0, 0.05961D0, 0.03555D0,
53940 & 0.01901D0, 0.00868D0, 0.00071D0, 0.00000D0/
53941 DATA (FMRS(2,1,I,18),I=1,49)/
53942 & 0.01947D0, 0.02394D0, 0.02943D0, 0.03322D0, 0.03621D0,
53943 & 0.03871D0, 0.04769D0, 0.05889D0, 0.06678D0, 0.07312D0,
53944 & 0.07860D0, 0.09903D0, 0.12687D0, 0.14804D0, 0.16603D0,
53945 & 0.18199D0, 0.21002D0, 0.24583D0, 0.29534D0, 0.33632D0,
53946 & 0.40060D0, 0.44729D0, 0.48029D0, 0.50614D0, 0.51810D0,
53947 & 0.51876D0, 0.51049D0, 0.49502D0, 0.47387D0, 0.44861D0,
53948 & 0.42013D0, 0.38960D0, 0.35780D0, 0.32553D0, 0.29342D0,
53949 & 0.26197D0, 0.23158D0, 0.20258D0, 0.17557D0, 0.15022D0,
53950 & 0.12699D0, 0.10608D0, 0.08715D0, 0.05607D0, 0.03324D0,
53951 & 0.01765D0, 0.00799D0, 0.00064D0, 0.00000D0/
53952 DATA (FMRS(2,1,I,19),I=1,49)/
53953 & 0.01970D0, 0.02424D0, 0.02983D0, 0.03369D0, 0.03672D0,
53954 & 0.03927D0, 0.04841D0, 0.05983D0, 0.06787D0, 0.07433D0,
53955 & 0.07993D0, 0.10079D0, 0.12921D0, 0.15080D0, 0.16909D0,
53956 & 0.18531D0, 0.21368D0, 0.24977D0, 0.29932D0, 0.34002D0,
53957 & 0.40312D0, 0.44820D0, 0.47944D0, 0.50301D0, 0.51281D0,
53958 & 0.51154D0, 0.50156D0, 0.48470D0, 0.46252D0, 0.43645D0,
53959 & 0.40748D0, 0.37672D0, 0.34495D0, 0.31293D0, 0.28123D0,
53960 & 0.25036D0, 0.22064D0, 0.19244D0, 0.16630D0, 0.14187D0,
53961 & 0.11955D0, 0.09954D0, 0.08152D0, 0.05209D0, 0.03065D0,
53962 & 0.01614D0, 0.00723D0, 0.00056D0, 0.00000D0/
53963 DATA (FMRS(2,1,I,20),I=1,49)/
53964 & 0.01991D0, 0.02452D0, 0.03019D0, 0.03410D0, 0.03718D0,
53965 & 0.03977D0, 0.04905D0, 0.06066D0, 0.06884D0, 0.07541D0,
53966 & 0.08111D0, 0.10235D0, 0.13129D0, 0.15323D0, 0.17180D0,
53967 & 0.18822D0, 0.21689D0, 0.25320D0, 0.30276D0, 0.34318D0,
53968 & 0.40521D0, 0.44885D0, 0.47855D0, 0.50013D0, 0.50806D0,
53969 & 0.50515D0, 0.49374D0, 0.47571D0, 0.45269D0, 0.42596D0,
53970 & 0.39662D0, 0.36569D0, 0.33399D0, 0.30222D0, 0.27090D0,
53971 & 0.24056D0, 0.21144D0, 0.18393D0, 0.15855D0, 0.13491D0,
53972 & 0.11336D0, 0.09413D0, 0.07687D0, 0.04883D0, 0.02854D0,
53973 & 0.01493D0, 0.00663D0, 0.00051D0, 0.00000D0/
53974 DATA (FMRS(2,1,I,21),I=1,49)/
53975 & 0.02011D0, 0.02477D0, 0.03051D0, 0.03448D0, 0.03760D0,
53976 & 0.04023D0, 0.04965D0, 0.06143D0, 0.06973D0, 0.07641D0,
53977 & 0.08220D0, 0.10379D0, 0.13319D0, 0.15544D0, 0.17424D0,
53978 & 0.19085D0, 0.21976D0, 0.25625D0, 0.30577D0, 0.34590D0,
53979 & 0.40689D0, 0.44921D0, 0.47746D0, 0.49725D0, 0.50352D0,
53980 & 0.49914D0, 0.48649D0, 0.46748D0, 0.44367D0, 0.41645D0,
53981 & 0.38678D0, 0.35582D0, 0.32417D0, 0.29264D0, 0.26169D0,
53982 & 0.23187D0, 0.20335D0, 0.17646D0, 0.15176D0, 0.12881D0,
53983 & 0.10798D0, 0.08943D0, 0.07284D0, 0.04602D0, 0.02675D0,
53984 & 0.01389D0, 0.00613D0, 0.00046D0, 0.00000D0/
53985 DATA (FMRS(2,1,I,22),I=1,49)/
53986 & 0.02035D0, 0.02509D0, 0.03093D0, 0.03496D0, 0.03814D0,
53987 & 0.04081D0, 0.05040D0, 0.06241D0, 0.07087D0, 0.07768D0,
53988 & 0.08359D0, 0.10562D0, 0.13559D0, 0.15824D0, 0.17734D0,
53989 & 0.19417D0, 0.22338D0, 0.26006D0, 0.30949D0, 0.34920D0,
53990 & 0.40885D0, 0.44948D0, 0.47592D0, 0.49348D0, 0.49770D0,
53991 & 0.49152D0, 0.47736D0, 0.45716D0, 0.43246D0, 0.40467D0,
53992 & 0.37468D0, 0.34367D0, 0.31217D0, 0.28097D0, 0.25052D0,
53993 & 0.22133D0, 0.19355D0, 0.16747D0, 0.14359D0, 0.12150D0,
53994 & 0.10155D0, 0.08384D0, 0.06806D0, 0.04272D0, 0.02464D0,
53995 & 0.01269D0, 0.00554D0, 0.00040D0, 0.00000D0/
53996 DATA (FMRS(2,1,I,23),I=1,49)/
53997 & 0.02058D0, 0.02539D0, 0.03132D0, 0.03542D0, 0.03865D0,
53998 & 0.04137D0, 0.05112D0, 0.06333D0, 0.07195D0, 0.07888D0,
53999 & 0.08490D0, 0.10735D0, 0.13786D0, 0.16087D0, 0.18023D0,
54000 & 0.19726D0, 0.22673D0, 0.26356D0, 0.31287D0, 0.35216D0,
54001 & 0.41052D0, 0.44953D0, 0.47430D0, 0.48980D0, 0.49215D0,
54002 & 0.48435D0, 0.46885D0, 0.44758D0, 0.42215D0, 0.39387D0,
54003 & 0.36366D0, 0.33261D0, 0.30132D0, 0.27045D0, 0.24050D0,
54004 & 0.21190D0, 0.18476D0, 0.15947D0, 0.13635D0, 0.11504D0,
54005 & 0.09587D0, 0.07894D0, 0.06387D0, 0.03984D0, 0.02282D0,
54006 & 0.01167D0, 0.00505D0, 0.00036D0, 0.00000D0/
54007 DATA (FMRS(2,1,I,24),I=1,49)/
54008 & 0.02080D0, 0.02568D0, 0.03170D0, 0.03585D0, 0.03914D0,
54009 & 0.04189D0, 0.05180D0, 0.06421D0, 0.07296D0, 0.08001D0,
54010 & 0.08614D0, 0.10897D0, 0.13997D0, 0.16330D0, 0.18290D0,
54011 & 0.20010D0, 0.22978D0, 0.26672D0, 0.31586D0, 0.35473D0,
54012 & 0.41182D0, 0.44931D0, 0.47248D0, 0.48612D0, 0.48676D0,
54013 & 0.47750D0, 0.46081D0, 0.43866D0, 0.41258D0, 0.38389D0,
54014 & 0.35352D0, 0.32245D0, 0.29140D0, 0.26089D0, 0.23143D0,
54015 & 0.20340D0, 0.17690D0, 0.15229D0, 0.12990D0, 0.10931D0,
54016 & 0.09084D0, 0.07461D0, 0.06021D0, 0.03734D0, 0.02125D0,
54017 & 0.01078D0, 0.00462D0, 0.00032D0, 0.00000D0/
54018 DATA (FMRS(2,1,I,25),I=1,49)/
54019 & 0.02102D0, 0.02596D0, 0.03207D0, 0.03629D0, 0.03962D0,
54020 & 0.04242D0, 0.05248D0, 0.06508D0, 0.07398D0, 0.08115D0,
54021 & 0.08738D0, 0.11059D0, 0.14207D0, 0.16573D0, 0.18556D0,
54022 & 0.20292D0, 0.23281D0, 0.26985D0, 0.31879D0, 0.35722D0,
54023 & 0.41303D0, 0.44900D0, 0.47060D0, 0.48240D0, 0.48138D0,
54024 & 0.47074D0, 0.45292D0, 0.42993D0, 0.40324D0, 0.37421D0,
54025 & 0.34370D0, 0.31266D0, 0.28186D0, 0.25172D0, 0.22275D0,
54026 & 0.19528D0, 0.16943D0, 0.14547D0, 0.12379D0, 0.10391D0,
54027 & 0.08611D0, 0.07055D0, 0.05678D0, 0.03501D0, 0.01980D0,
54028 & 0.00997D0, 0.00424D0, 0.00029D0, 0.00000D0/
54029 DATA (FMRS(2,1,I,26),I=1,49)/
54030 & 0.02124D0, 0.02625D0, 0.03244D0, 0.03672D0, 0.04010D0,
54031 & 0.04294D0, 0.05315D0, 0.06595D0, 0.07499D0, 0.08227D0,
54032 & 0.08860D0, 0.11218D0, 0.14413D0, 0.16809D0, 0.18813D0,
54033 & 0.20564D0, 0.23571D0, 0.27281D0, 0.32152D0, 0.35948D0,
54034 & 0.41398D0, 0.44847D0, 0.46857D0, 0.47858D0, 0.47599D0,
54035 & 0.46404D0, 0.44519D0, 0.42139D0, 0.39420D0, 0.36490D0,
54036 & 0.33431D0, 0.30337D0, 0.27282D0, 0.24304D0, 0.21455D0,
54037 & 0.18765D0, 0.16244D0, 0.13911D0, 0.11808D0, 0.09890D0,
54038 & 0.08174D0, 0.06681D0, 0.05361D0, 0.03286D0, 0.01847D0,
54039 & 0.00924D0, 0.00390D0, 0.00026D0, 0.00000D0/
54040 DATA (FMRS(2,1,I,27),I=1,49)/
54041 & 0.02145D0, 0.02652D0, 0.03279D0, 0.03713D0, 0.04055D0,
54042 & 0.04343D0, 0.05378D0, 0.06677D0, 0.07594D0, 0.08333D0,
54043 & 0.08975D0, 0.11368D0, 0.14607D0, 0.17031D0, 0.19054D0,
54044 & 0.20819D0, 0.23841D0, 0.27555D0, 0.32402D0, 0.36153D0,
54045 & 0.41478D0, 0.44786D0, 0.46655D0, 0.47490D0, 0.47088D0,
54046 & 0.45773D0, 0.43795D0, 0.41346D0, 0.38583D0, 0.35628D0,
54047 & 0.32564D0, 0.29483D0, 0.26454D0, 0.23512D0, 0.20709D0,
54048 & 0.18074D0, 0.15610D0, 0.13337D0, 0.11295D0, 0.09439D0,
54049 & 0.07783D0, 0.06346D0, 0.05079D0, 0.03096D0, 0.01730D0,
54050 & 0.00860D0, 0.00360D0, 0.00023D0, 0.00000D0/
54051 DATA (FMRS(2,1,I,28),I=1,49)/
54052 & 0.02164D0, 0.02677D0, 0.03312D0, 0.03751D0, 0.04098D0,
54053 & 0.04390D0, 0.05439D0, 0.06755D0, 0.07684D0, 0.08433D0,
54054 & 0.09084D0, 0.11510D0, 0.14789D0, 0.17239D0, 0.19279D0,
54055 & 0.21056D0, 0.24091D0, 0.27806D0, 0.32630D0, 0.36334D0,
54056 & 0.41540D0, 0.44716D0, 0.46451D0, 0.47135D0, 0.46602D0,
54057 & 0.45177D0, 0.43117D0, 0.40606D0, 0.37805D0, 0.34829D0,
54058 & 0.31763D0, 0.28699D0, 0.25693D0, 0.22788D0, 0.20031D0,
54059 & 0.17447D0, 0.15036D0, 0.12818D0, 0.10834D0, 0.09032D0,
54060 & 0.07432D0, 0.06046D0, 0.04827D0, 0.02929D0, 0.01628D0,
54061 & 0.00804D0, 0.00334D0, 0.00021D0, 0.00000D0/
54062 DATA (FMRS(2,1,I,29),I=1,49)/
54063 & 0.02184D0, 0.02703D0, 0.03346D0, 0.03790D0, 0.04142D0,
54064 & 0.04437D0, 0.05500D0, 0.06833D0, 0.07775D0, 0.08534D0,
54065 & 0.09195D0, 0.11653D0, 0.14972D0, 0.17447D0, 0.19503D0,
54066 & 0.21292D0, 0.24339D0, 0.28054D0, 0.32851D0, 0.36507D0,
54067 & 0.41592D0, 0.44635D0, 0.46240D0, 0.46773D0, 0.46111D0,
54068 & 0.44581D0, 0.42442D0, 0.39875D0, 0.37037D0, 0.34044D0,
54069 & 0.30980D0, 0.27932D0, 0.24952D0, 0.22085D0, 0.19375D0,
54070 & 0.16840D0, 0.14482D0, 0.12320D0, 0.10392D0, 0.08643D0,
54071 & 0.07097D0, 0.05759D0, 0.04588D0, 0.02770D0, 0.01531D0,
54072 & 0.00752D0, 0.00311D0, 0.00019D0, 0.00000D0/
54073 DATA (FMRS(2,1,I,30),I=1,49)/
54074 & 0.02204D0, 0.02729D0, 0.03379D0, 0.03829D0, 0.04185D0,
54075 & 0.04484D0, 0.05560D0, 0.06911D0, 0.07865D0, 0.08634D0,
54076 & 0.09303D0, 0.11793D0, 0.15151D0, 0.17649D0, 0.19722D0,
54077 & 0.21521D0, 0.24577D0, 0.28291D0, 0.33057D0, 0.36667D0,
54078 & 0.41631D0, 0.44543D0, 0.46021D0, 0.46408D0, 0.45622D0,
54079 & 0.43995D0, 0.41780D0, 0.39163D0, 0.36293D0, 0.33287D0,
54080 & 0.30229D0, 0.27195D0, 0.24246D0, 0.21416D0, 0.18750D0,
54081 & 0.16265D0, 0.13957D0, 0.11850D0, 0.09976D0, 0.08278D0,
54082 & 0.06783D0, 0.05492D0, 0.04366D0, 0.02623D0, 0.01442D0,
54083 & 0.00705D0, 0.00289D0, 0.00017D0, 0.00000D0/
54084 DATA (FMRS(2,1,I,31),I=1,49)/
54085 & 0.02222D0, 0.02753D0, 0.03410D0, 0.03866D0, 0.04226D0,
54086 & 0.04528D0, 0.05617D0, 0.06985D0, 0.07951D0, 0.08729D0,
54087 & 0.09407D0, 0.11927D0, 0.15320D0, 0.17841D0, 0.19928D0,
54088 & 0.21737D0, 0.24802D0, 0.28513D0, 0.33249D0, 0.36812D0,
54089 & 0.41660D0, 0.44449D0, 0.45808D0, 0.46059D0, 0.45160D0,
54090 & 0.43442D0, 0.41159D0, 0.38497D0, 0.35599D0, 0.32584D0,
54091 & 0.29532D0, 0.26514D0, 0.23594D0, 0.20800D0, 0.18176D0,
54092 & 0.15738D0, 0.13478D0, 0.11421D0, 0.09597D0, 0.07947D0,
54093 & 0.06498D0, 0.05251D0, 0.04166D0, 0.02491D0, 0.01363D0,
54094 & 0.00662D0, 0.00270D0, 0.00016D0, 0.00000D0/
54095 DATA (FMRS(2,1,I,32),I=1,49)/
54096 & 0.02240D0, 0.02776D0, 0.03441D0, 0.03901D0, 0.04265D0,
54097 & 0.04571D0, 0.05672D0, 0.07055D0, 0.08032D0, 0.08819D0,
54098 & 0.09505D0, 0.12053D0, 0.15480D0, 0.18021D0, 0.20120D0,
54099 & 0.21937D0, 0.25009D0, 0.28716D0, 0.33421D0, 0.36938D0,
54100 & 0.41675D0, 0.44346D0, 0.45593D0, 0.45721D0, 0.44717D0,
54101 & 0.42917D0, 0.40572D0, 0.37869D0, 0.34947D0, 0.31928D0,
54102 & 0.28882D0, 0.25885D0, 0.22992D0, 0.20233D0, 0.17646D0,
54103 & 0.15252D0, 0.13038D0, 0.11028D0, 0.09251D0, 0.07647D0,
54104 & 0.06240D0, 0.05033D0, 0.03984D0, 0.02372D0, 0.01293D0,
54105 & 0.00625D0, 0.00253D0, 0.00015D0, 0.00000D0/
54106 DATA (FMRS(2,1,I,33),I=1,49)/
54107 & 0.02258D0, 0.02800D0, 0.03471D0, 0.03936D0, 0.04304D0,
54108 & 0.04613D0, 0.05727D0, 0.07126D0, 0.08114D0, 0.08911D0,
54109 & 0.09604D0, 0.12181D0, 0.15642D0, 0.18202D0, 0.20315D0,
54110 & 0.22140D0, 0.25219D0, 0.28920D0, 0.33594D0, 0.37065D0,
54111 & 0.41690D0, 0.44243D0, 0.45378D0, 0.45384D0, 0.44278D0,
54112 & 0.42397D0, 0.39993D0, 0.37250D0, 0.34307D0, 0.31283D0,
54113 & 0.28245D0, 0.25269D0, 0.22404D0, 0.19681D0, 0.17131D0,
54114 & 0.14780D0, 0.12613D0, 0.10648D0, 0.08918D0, 0.07357D0,
54115 & 0.05991D0, 0.04824D0, 0.03811D0, 0.02259D0, 0.01226D0,
54116 & 0.00589D0, 0.00237D0, 0.00014D0, 0.00000D0/
54117 DATA (FMRS(2,1,I,34),I=1,49)/
54118 & 0.02276D0, 0.02823D0, 0.03502D0, 0.03972D0, 0.04344D0,
54119 & 0.04656D0, 0.05782D0, 0.07197D0, 0.08196D0, 0.09001D0,
54120 & 0.09702D0, 0.12306D0, 0.15799D0, 0.18378D0, 0.20502D0,
54121 & 0.22334D0, 0.25418D0, 0.29111D0, 0.33751D0, 0.37174D0,
54122 & 0.41686D0, 0.44123D0, 0.45149D0, 0.45035D0, 0.43832D0,
54123 & 0.41874D0, 0.39416D0, 0.36638D0, 0.33679D0, 0.30651D0,
54124 & 0.27625D0, 0.24670D0, 0.21831D0, 0.19144D0, 0.16636D0,
54125 & 0.14329D0, 0.12204D0, 0.10286D0, 0.08597D0, 0.07080D0,
54126 & 0.05755D0, 0.04624D0, 0.03646D0, 0.02153D0, 0.01162D0,
54127 & 0.00556D0, 0.00222D0, 0.00012D0, 0.00000D0/
54128 DATA (FMRS(2,1,I,35),I=1,49)/
54129 & 0.02294D0, 0.02846D0, 0.03531D0, 0.04006D0, 0.04381D0,
54130 & 0.04697D0, 0.05834D0, 0.07264D0, 0.08274D0, 0.09087D0,
54131 & 0.09796D0, 0.12426D0, 0.15949D0, 0.18547D0, 0.20682D0,
54132 & 0.22520D0, 0.25608D0, 0.29293D0, 0.33900D0, 0.37277D0,
54133 & 0.41683D0, 0.44010D0, 0.44933D0, 0.44706D0, 0.43413D0,
54134 & 0.41383D0, 0.38877D0, 0.36068D0, 0.33093D0, 0.30063D0,
54135 & 0.27049D0, 0.24114D0, 0.21302D0, 0.18649D0, 0.16180D0,
54136 & 0.13914D0, 0.11828D0, 0.09955D0, 0.08303D0, 0.06826D0,
54137 & 0.05540D0, 0.04443D0, 0.03497D0, 0.02057D0, 0.01106D0,
54138 & 0.00526D0, 0.00209D0, 0.00012D0, 0.00000D0/
54139 DATA (FMRS(2,1,I,36),I=1,49)/
54140 & 0.02310D0, 0.02867D0, 0.03558D0, 0.04038D0, 0.04417D0,
54141 & 0.04736D0, 0.05885D0, 0.07328D0, 0.08348D0, 0.09170D0,
54142 & 0.09885D0, 0.12540D0, 0.16092D0, 0.18705D0, 0.20850D0,
54143 & 0.22693D0, 0.25784D0, 0.29461D0, 0.34036D0, 0.37368D0,
54144 & 0.41672D0, 0.43895D0, 0.44722D0, 0.44390D0, 0.43013D0,
54145 & 0.40920D0, 0.38369D0, 0.35531D0, 0.32545D0, 0.29515D0,
54146 & 0.26511D0, 0.23598D0, 0.20812D0, 0.18191D0, 0.15758D0,
54147 & 0.13530D0, 0.11483D0, 0.09649D0, 0.08034D0, 0.06595D0,
54148 & 0.05344D0, 0.04278D0, 0.03361D0, 0.01970D0, 0.01054D0,
54149 & 0.00499D0, 0.00197D0, 0.00011D0, 0.00000D0/
54150 DATA (FMRS(2,1,I,37),I=1,49)/
54151 & 0.02327D0, 0.02889D0, 0.03587D0, 0.04071D0, 0.04453D0,
54152 & 0.04775D0, 0.05935D0, 0.07393D0, 0.08423D0, 0.09253D0,
54153 & 0.09975D0, 0.12655D0, 0.16235D0, 0.18864D0, 0.21018D0,
54154 & 0.22866D0, 0.25959D0, 0.29626D0, 0.34166D0, 0.37452D0,
54155 & 0.41652D0, 0.43771D0, 0.44502D0, 0.44067D0, 0.42606D0,
54156 & 0.40453D0, 0.37859D0, 0.34994D0, 0.31996D0, 0.28968D0,
54157 & 0.25976D0, 0.23084D0, 0.20328D0, 0.17738D0, 0.15341D0,
54158 & 0.13150D0, 0.11145D0, 0.09348D0, 0.07773D0, 0.06369D0,
54159 & 0.05153D0, 0.04117D0, 0.03229D0, 0.01885D0, 0.01005D0,
54160 & 0.00474D0, 0.00186D0, 0.00010D0, 0.00000D0/
54161 DATA (FMRS(2,1,I,38),I=1,49)/
54162 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54163 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54164 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54165 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54166 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54167 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54168 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54169 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54170 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54171 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54172 DATA (FMRS(2,2,I, 1),I=1,49)/
54173 & 0.00683D0, 0.00832D0, 0.01013D0, 0.01138D0, 0.01237D0,
54174 & 0.01320D0, 0.01619D0, 0.02004D0, 0.02286D0, 0.02522D0,
54175 & 0.02744D0, 0.03623D0, 0.04952D0, 0.06032D0, 0.06982D0,
54176 & 0.07843D0, 0.09385D0, 0.11395D0, 0.14220D0, 0.16592D0,
54177 & 0.20382D0, 0.23228D0, 0.25344D0, 0.27158D0, 0.28216D0,
54178 & 0.28647D0, 0.28570D0, 0.28068D0, 0.27216D0, 0.26127D0,
54179 & 0.24773D0, 0.23281D0, 0.21663D0, 0.19968D0, 0.18252D0,
54180 & 0.16522D0, 0.14809D0, 0.13153D0, 0.11576D0, 0.10050D0,
54181 & 0.08631D0, 0.07335D0, 0.06127D0, 0.04098D0, 0.02531D0,
54182 & 0.01409D0, 0.00672D0, 0.00064D0, 0.00000D0/
54183 DATA (FMRS(2,2,I, 2),I=1,49)/
54184 & 0.00687D0, 0.00838D0, 0.01023D0, 0.01151D0, 0.01252D0,
54185 & 0.01336D0, 0.01643D0, 0.02037D0, 0.02327D0, 0.02569D0,
54186 & 0.02797D0, 0.03698D0, 0.05059D0, 0.06162D0, 0.07129D0,
54187 & 0.08004D0, 0.09567D0, 0.11595D0, 0.14429D0, 0.16793D0,
54188 & 0.20539D0, 0.23318D0, 0.25356D0, 0.27069D0, 0.28025D0,
54189 & 0.28363D0, 0.28200D0, 0.27624D0, 0.26713D0, 0.25572D0,
54190 & 0.24185D0, 0.22669D0, 0.21040D0, 0.19345D0, 0.17637D0,
54191 & 0.15928D0, 0.14242D0, 0.12615D0, 0.11076D0, 0.09591D0,
54192 & 0.08215D0, 0.06963D0, 0.05800D0, 0.03856D0, 0.02367D0,
54193 & 0.01309D0, 0.00619D0, 0.00057D0, 0.00000D0/
54194 DATA (FMRS(2,2,I, 3),I=1,49)/
54195 & 0.00693D0, 0.00848D0, 0.01038D0, 0.01170D0, 0.01274D0,
54196 & 0.01362D0, 0.01679D0, 0.02088D0, 0.02389D0, 0.02641D0,
54197 & 0.02877D0, 0.03812D0, 0.05220D0, 0.06356D0, 0.07349D0,
54198 & 0.08244D0, 0.09836D0, 0.11888D0, 0.14732D0, 0.17082D0,
54199 & 0.20757D0, 0.23434D0, 0.25356D0, 0.26918D0, 0.27725D0,
54200 & 0.27927D0, 0.27642D0, 0.26960D0, 0.25969D0, 0.24758D0,
54201 & 0.23327D0, 0.21778D0, 0.20136D0, 0.18446D0, 0.16756D0,
54202 & 0.15079D0, 0.13434D0, 0.11852D0, 0.10371D0, 0.08946D0,
54203 & 0.07631D0, 0.06442D0, 0.05345D0, 0.03522D0, 0.02142D0,
54204 & 0.01172D0, 0.00548D0, 0.00049D0, 0.00000D0/
54205 DATA (FMRS(2,2,I, 4),I=1,49)/
54206 & 0.00697D0, 0.00855D0, 0.01050D0, 0.01184D0, 0.01291D0,
54207 & 0.01380D0, 0.01706D0, 0.02126D0, 0.02435D0, 0.02694D0,
54208 & 0.02937D0, 0.03897D0, 0.05339D0, 0.06499D0, 0.07510D0,
54209 & 0.08419D0, 0.10031D0, 0.12100D0, 0.14949D0, 0.17285D0,
54210 & 0.20905D0, 0.23506D0, 0.25342D0, 0.26794D0, 0.27493D0,
54211 & 0.27599D0, 0.27230D0, 0.26475D0, 0.25426D0, 0.24171D0,
54212 & 0.22712D0, 0.21140D0, 0.19495D0, 0.17811D0, 0.16138D0,
54213 & 0.14485D0, 0.12869D0, 0.11323D0, 0.09881D0, 0.08500D0,
54214 & 0.07230D0, 0.06086D0, 0.05034D0, 0.03297D0, 0.01992D0,
54215 & 0.01081D0, 0.00501D0, 0.00044D0, 0.00000D0/
54216 DATA (FMRS(2,2,I, 5),I=1,49)/
54217 & 0.00702D0, 0.00863D0, 0.01062D0, 0.01200D0, 0.01309D0,
54218 & 0.01401D0, 0.01735D0, 0.02167D0, 0.02485D0, 0.02751D0,
54219 & 0.03001D0, 0.03988D0, 0.05465D0, 0.06649D0, 0.07678D0,
54220 & 0.08602D0, 0.10233D0, 0.12317D0, 0.15168D0, 0.17488D0,
54221 & 0.21046D0, 0.23564D0, 0.25309D0, 0.26645D0, 0.27234D0,
54222 & 0.27243D0, 0.26786D0, 0.25959D0, 0.24854D0, 0.23557D0,
54223 & 0.22068D0, 0.20486D0, 0.18841D0, 0.17163D0, 0.15506D0,
54224 & 0.13880D0, 0.12296D0, 0.10788D0, 0.09387D0, 0.08052D0,
54225 & 0.06829D0, 0.05730D0, 0.04726D0, 0.03074D0, 0.01844D0,
54226 & 0.00993D0, 0.00456D0, 0.00039D0, 0.00000D0/
54227 DATA (FMRS(2,2,I, 6),I=1,49)/
54228 & 0.00706D0, 0.00870D0, 0.01073D0, 0.01213D0, 0.01325D0,
54229 & 0.01419D0, 0.01761D0, 0.02203D0, 0.02528D0, 0.02801D0,
54230 & 0.03057D0, 0.04067D0, 0.05575D0, 0.06780D0, 0.07825D0,
54231 & 0.08760D0, 0.10408D0, 0.12504D0, 0.15354D0, 0.17659D0,
54232 & 0.21162D0, 0.23607D0, 0.25274D0, 0.26511D0, 0.27006D0,
54233 & 0.26933D0, 0.26403D0, 0.25518D0, 0.24367D0, 0.23035D0,
54234 & 0.21525D0, 0.19935D0, 0.18289D0, 0.16620D0, 0.14980D0,
54235 & 0.13377D0, 0.11822D0, 0.10346D0, 0.08981D0, 0.07685D0,
54236 & 0.06502D0, 0.05441D0, 0.04475D0, 0.02894D0, 0.01725D0,
54237 & 0.00923D0, 0.00420D0, 0.00035D0, 0.00000D0/
54238 DATA (FMRS(2,2,I, 7),I=1,49)/
54239 & 0.00711D0, 0.00877D0, 0.01083D0, 0.01227D0, 0.01340D0,
54240 & 0.01436D0, 0.01785D0, 0.02237D0, 0.02570D0, 0.02850D0,
54241 & 0.03112D0, 0.04143D0, 0.05680D0, 0.06905D0, 0.07964D0,
54242 & 0.08911D0, 0.10573D0, 0.12679D0, 0.15527D0, 0.17816D0,
54243 & 0.21263D0, 0.23638D0, 0.25229D0, 0.26373D0, 0.26781D0,
54244 & 0.26630D0, 0.26033D0, 0.25095D0, 0.23903D0, 0.22536D0,
54245 & 0.21011D0, 0.19416D0, 0.17766D0, 0.16111D0, 0.14488D0,
54246 & 0.12910D0, 0.11382D0, 0.09936D0, 0.08606D0, 0.07347D0,
54247 & 0.06201D0, 0.05178D0, 0.04247D0, 0.02732D0, 0.01619D0,
54248 & 0.00860D0, 0.00389D0, 0.00031D0, 0.00000D0/
54249 DATA (FMRS(2,2,I, 8),I=1,49)/
54250 & 0.00716D0, 0.00885D0, 0.01095D0, 0.01241D0, 0.01357D0,
54251 & 0.01455D0, 0.01812D0, 0.02275D0, 0.02616D0, 0.02902D0,
54252 & 0.03170D0, 0.04225D0, 0.05792D0, 0.07038D0, 0.08112D0,
54253 & 0.09070D0, 0.10747D0, 0.12863D0, 0.15707D0, 0.17976D0,
54254 & 0.21362D0, 0.23661D0, 0.25172D0, 0.26218D0, 0.26535D0,
54255 & 0.26303D0, 0.25640D0, 0.24647D0, 0.23413D0, 0.22018D0,
54256 & 0.20477D0, 0.18875D0, 0.17228D0, 0.15585D0, 0.13983D0,
54257 & 0.12430D0, 0.10932D0, 0.09519D0, 0.08225D0, 0.07005D0,
54258 & 0.05898D0, 0.04912D0, 0.04018D0, 0.02570D0, 0.01514D0,
54259 & 0.00799D0, 0.00358D0, 0.00028D0, 0.00000D0/
54260 DATA (FMRS(2,2,I, 9),I=1,49)/
54261 & 0.00720D0, 0.00891D0, 0.01105D0, 0.01254D0, 0.01372D0,
54262 & 0.01472D0, 0.01836D0, 0.02308D0, 0.02656D0, 0.02948D0,
54263 & 0.03221D0, 0.04297D0, 0.05891D0, 0.07154D0, 0.08241D0,
54264 & 0.09208D0, 0.10897D0, 0.13020D0, 0.15860D0, 0.18111D0,
54265 & 0.21443D0, 0.23674D0, 0.25116D0, 0.26078D0, 0.26316D0,
54266 & 0.26017D0, 0.25299D0, 0.24260D0, 0.22991D0, 0.21577D0,
54267 & 0.20023D0, 0.18414D0, 0.16776D0, 0.15141D0, 0.13557D0,
54268 & 0.12027D0, 0.10555D0, 0.09171D0, 0.07908D0, 0.06721D0,
54269 & 0.05646D0, 0.04691D0, 0.03829D0, 0.02437D0, 0.01428D0,
54270 & 0.00749D0, 0.00333D0, 0.00026D0, 0.00000D0/
54271 DATA (FMRS(2,2,I,10),I=1,49)/
54272 & 0.00724D0, 0.00898D0, 0.01115D0, 0.01266D0, 0.01386D0,
54273 & 0.01488D0, 0.01859D0, 0.02340D0, 0.02695D0, 0.02993D0,
54274 & 0.03271D0, 0.04366D0, 0.05985D0, 0.07265D0, 0.08364D0,
54275 & 0.09340D0, 0.11040D0, 0.13168D0, 0.16002D0, 0.18235D0,
54276 & 0.21512D0, 0.23679D0, 0.25054D0, 0.25935D0, 0.26099D0,
54277 & 0.25738D0, 0.24967D0, 0.23885D0, 0.22588D0, 0.21153D0,
54278 & 0.19588D0, 0.17977D0, 0.16345D0, 0.14723D0, 0.13156D0,
54279 & 0.11648D0, 0.10202D0, 0.08846D0, 0.07613D0, 0.06457D0,
54280 & 0.05413D0, 0.04488D0, 0.03655D0, 0.02315D0, 0.01349D0,
54281 & 0.00703D0, 0.00311D0, 0.00024D0, 0.00000D0/
54282 DATA (FMRS(2,2,I,11),I=1,49)/
54283 & 0.00727D0, 0.00904D0, 0.01123D0, 0.01276D0, 0.01398D0,
54284 & 0.01501D0, 0.01877D0, 0.02366D0, 0.02727D0, 0.03029D0,
54285 & 0.03311D0, 0.04422D0, 0.06061D0, 0.07353D0, 0.08461D0,
54286 & 0.09444D0, 0.11152D0, 0.13285D0, 0.16112D0, 0.18330D0,
54287 & 0.21564D0, 0.23680D0, 0.25001D0, 0.25818D0, 0.25925D0,
54288 & 0.25517D0, 0.24705D0, 0.23591D0, 0.22272D0, 0.20821D0,
54289 & 0.19248D0, 0.17638D0, 0.16011D0, 0.14399D0, 0.12847D0,
54290 & 0.11356D0, 0.09932D0, 0.08597D0, 0.07388D0, 0.06256D0,
54291 & 0.05235D0, 0.04334D0, 0.03522D0, 0.02223D0, 0.01290D0,
54292 & 0.00670D0, 0.00295D0, 0.00022D0, 0.00000D0/
54293 DATA (FMRS(2,2,I,12),I=1,49)/
54294 & 0.00735D0, 0.00915D0, 0.01141D0, 0.01298D0, 0.01423D0,
54295 & 0.01529D0, 0.01917D0, 0.02422D0, 0.02794D0, 0.03106D0,
54296 & 0.03397D0, 0.04541D0, 0.06221D0, 0.07541D0, 0.08668D0,
54297 & 0.09664D0, 0.11388D0, 0.13528D0, 0.16340D0, 0.18523D0,
54298 & 0.21662D0, 0.23667D0, 0.24876D0, 0.25560D0, 0.25550D0,
54299 & 0.25041D0, 0.24145D0, 0.22968D0, 0.21606D0, 0.20125D0,
54300 & 0.18540D0, 0.16932D0, 0.15319D0, 0.13731D0, 0.12210D0,
54301 & 0.10759D0, 0.09378D0, 0.08090D0, 0.06929D0, 0.05847D0,
54302 & 0.04874D0, 0.04022D0, 0.03256D0, 0.02039D0, 0.01173D0,
54303 & 0.00603D0, 0.00263D0, 0.00019D0, 0.00000D0/
54304 DATA (FMRS(2,2,I,13),I=1,49)/
54305 & 0.00742D0, 0.00926D0, 0.01156D0, 0.01317D0, 0.01446D0,
54306 & 0.01554D0, 0.01952D0, 0.02471D0, 0.02853D0, 0.03173D0,
54307 & 0.03472D0, 0.04644D0, 0.06360D0, 0.07703D0, 0.08845D0,
54308 & 0.09852D0, 0.11589D0, 0.13732D0, 0.16529D0, 0.18680D0,
54309 & 0.21735D0, 0.23643D0, 0.24757D0, 0.25329D0, 0.25220D0,
54310 & 0.24629D0, 0.23665D0, 0.22439D0, 0.21043D0, 0.19540D0,
54311 & 0.17949D0, 0.16343D0, 0.14746D0, 0.13180D0, 0.11686D0,
54312 & 0.10269D0, 0.08926D0, 0.07677D0, 0.06556D0, 0.05517D0,
54313 & 0.04584D0, 0.03772D0, 0.03044D0, 0.01893D0, 0.01082D0,
54314 & 0.00551D0, 0.00238D0, 0.00017D0, 0.00000D0/
54315 DATA (FMRS(2,2,I,14),I=1,49)/
54316 & 0.00750D0, 0.00938D0, 0.01173D0, 0.01339D0, 0.01471D0,
54317 & 0.01583D0, 0.01992D0, 0.02526D0, 0.02920D0, 0.03250D0,
54318 & 0.03557D0, 0.04761D0, 0.06516D0, 0.07882D0, 0.09041D0,
54319 & 0.10060D0, 0.11809D0, 0.13955D0, 0.16731D0, 0.18846D0,
54320 & 0.21802D0, 0.23605D0, 0.24613D0, 0.25062D0, 0.24846D0,
54321 & 0.24169D0, 0.23135D0, 0.21858D0, 0.20428D0, 0.18902D0,
54322 & 0.17309D0, 0.15708D0, 0.14130D0, 0.12590D0, 0.11127D0,
54323 & 0.09745D0, 0.08445D0, 0.07239D0, 0.06165D0, 0.05170D0,
54324 & 0.04281D0, 0.03511D0, 0.02824D0, 0.01743D0, 0.00988D0,
54325 & 0.00499D0, 0.00213D0, 0.00015D0, 0.00000D0/
54326 DATA (FMRS(2,2,I,15),I=1,49)/
54327 & 0.00758D0, 0.00950D0, 0.01192D0, 0.01362D0, 0.01498D0,
54328 & 0.01613D0, 0.02034D0, 0.02584D0, 0.02990D0, 0.03330D0,
54329 & 0.03646D0, 0.04882D0, 0.06676D0, 0.08067D0, 0.09242D0,
54330 & 0.10271D0, 0.12031D0, 0.14177D0, 0.16927D0, 0.19002D0,
54331 & 0.21855D0, 0.23546D0, 0.24445D0, 0.24771D0, 0.24448D0,
54332 & 0.23683D0, 0.22584D0, 0.21262D0, 0.19799D0, 0.18255D0,
54333 & 0.16661D0, 0.15073D0, 0.13511D0, 0.12003D0, 0.10571D0,
54334 & 0.09233D0, 0.07973D0, 0.06812D0, 0.05781D0, 0.04834D0,
54335 & 0.03990D0, 0.03259D0, 0.02612D0, 0.01599D0, 0.00899D0,
54336 & 0.00450D0, 0.00190D0, 0.00013D0, 0.00000D0/
54337 DATA (FMRS(2,2,I,16),I=1,49)/
54338 & 0.00766D0, 0.00962D0, 0.01210D0, 0.01384D0, 0.01522D0,
54339 & 0.01640D0, 0.02073D0, 0.02638D0, 0.03055D0, 0.03403D0,
54340 & 0.03728D0, 0.04992D0, 0.06822D0, 0.08234D0, 0.09422D0,
54341 & 0.10460D0, 0.12228D0, 0.14371D0, 0.17097D0, 0.19133D0,
54342 & 0.21891D0, 0.23481D0, 0.24283D0, 0.24499D0, 0.24085D0,
54343 & 0.23246D0, 0.22090D0, 0.20727D0, 0.19242D0, 0.17687D0,
54344 & 0.16094D0, 0.14517D0, 0.12974D0, 0.11493D0, 0.10094D0,
54345 & 0.08792D0, 0.07568D0, 0.06448D0, 0.05456D0, 0.04548D0,
54346 & 0.03743D0, 0.03047D0, 0.02435D0, 0.01480D0, 0.00826D0,
54347 & 0.00410D0, 0.00171D0, 0.00011D0, 0.00000D0/
54348 DATA (FMRS(2,2,I,17),I=1,49)/
54349 & 0.00775D0, 0.00975D0, 0.01228D0, 0.01406D0, 0.01548D0,
54350 & 0.01669D0, 0.02112D0, 0.02692D0, 0.03120D0, 0.03478D0,
54351 & 0.03810D0, 0.05104D0, 0.06968D0, 0.08400D0, 0.09602D0,
54352 & 0.10648D0, 0.12423D0, 0.14563D0, 0.17261D0, 0.19256D0,
54353 & 0.21918D0, 0.23405D0, 0.24112D0, 0.24221D0, 0.23719D0,
54354 & 0.22809D0, 0.21600D0, 0.20198D0, 0.18694D0, 0.17130D0,
54355 & 0.15541D0, 0.13976D0, 0.12455D0, 0.11000D0, 0.09636D0,
54356 & 0.08368D0, 0.07182D0, 0.06101D0, 0.05149D0, 0.04278D0,
54357 & 0.03510D0, 0.02849D0, 0.02269D0, 0.01370D0, 0.00759D0,
54358 & 0.00374D0, 0.00155D0, 0.00010D0, 0.00000D0/
54359 DATA (FMRS(2,2,I,18),I=1,49)/
54360 & 0.00782D0, 0.00985D0, 0.01243D0, 0.01424D0, 0.01569D0,
54361 & 0.01692D0, 0.02146D0, 0.02738D0, 0.03175D0, 0.03540D0,
54362 & 0.03879D0, 0.05197D0, 0.07089D0, 0.08537D0, 0.09749D0,
54363 & 0.10801D0, 0.12581D0, 0.14716D0, 0.17390D0, 0.19349D0,
54364 & 0.21930D0, 0.23333D0, 0.23963D0, 0.23986D0, 0.23413D0,
54365 & 0.22447D0, 0.21197D0, 0.19769D0, 0.18248D0, 0.16678D0,
54366 & 0.15094D0, 0.13543D0, 0.12040D0, 0.10608D0, 0.09270D0,
54367 & 0.08031D0, 0.06878D0, 0.05828D0, 0.04908D0, 0.04068D0,
54368 & 0.03329D0, 0.02694D0, 0.02140D0, 0.01285D0, 0.00708D0,
54369 & 0.00346D0, 0.00142D0, 0.00009D0, 0.00000D0/
54370 DATA (FMRS(2,2,I,19),I=1,49)/
54371 & 0.00791D0, 0.00998D0, 0.01261D0, 0.01447D0, 0.01595D0,
54372 & 0.01722D0, 0.02186D0, 0.02794D0, 0.03242D0, 0.03616D0,
54373 & 0.03963D0, 0.05310D0, 0.07234D0, 0.08702D0, 0.09924D0,
54374 & 0.10983D0, 0.12767D0, 0.14895D0, 0.17537D0, 0.19453D0,
54375 & 0.21933D0, 0.23238D0, 0.23773D0, 0.23696D0, 0.23039D0,
54376 & 0.22010D0, 0.20715D0, 0.19257D0, 0.17716D0, 0.16147D0,
54377 & 0.14570D0, 0.13034D0, 0.11556D0, 0.10152D0, 0.08847D0,
54378 & 0.07643D0, 0.06526D0, 0.05515D0, 0.04631D0, 0.03827D0,
54379 & 0.03122D0, 0.02519D0, 0.01995D0, 0.01190D0, 0.00650D0,
54380 & 0.00315D0, 0.00128D0, 0.00008D0, 0.00000D0/
54381 DATA (FMRS(2,2,I,20),I=1,49)/
54382 & 0.00799D0, 0.01010D0, 0.01278D0, 0.01467D0, 0.01619D0,
54383 & 0.01748D0, 0.02223D0, 0.02844D0, 0.03302D0, 0.03684D0,
54384 & 0.04038D0, 0.05409D0, 0.07362D0, 0.08846D0, 0.10078D0,
54385 & 0.11143D0, 0.12930D0, 0.15050D0, 0.17662D0, 0.19539D0,
54386 & 0.21931D0, 0.23148D0, 0.23602D0, 0.23438D0, 0.22712D0,
54387 & 0.21628D0, 0.20296D0, 0.18814D0, 0.17260D0, 0.15692D0,
54388 & 0.14124D0, 0.12600D0, 0.11146D0, 0.09768D0, 0.08490D0,
54389 & 0.07317D0, 0.06233D0, 0.05253D0, 0.04400D0, 0.03627D0,
54390 & 0.02950D0, 0.02375D0, 0.01875D0, 0.01112D0, 0.00604D0,
54391 & 0.00291D0, 0.00117D0, 0.00007D0, 0.00000D0/
54392 DATA (FMRS(2,2,I,21),I=1,49)/
54393 & 0.00806D0, 0.01021D0, 0.01293D0, 0.01486D0, 0.01641D0,
54394 & 0.01772D0, 0.02256D0, 0.02890D0, 0.03357D0, 0.03747D0,
54395 & 0.04106D0, 0.05501D0, 0.07479D0, 0.08976D0, 0.10217D0,
54396 & 0.11285D0, 0.13073D0, 0.15184D0, 0.17768D0, 0.19608D0,
54397 & 0.21918D0, 0.23055D0, 0.23436D0, 0.23195D0, 0.22407D0,
54398 & 0.21277D0, 0.19913D0, 0.18411D0, 0.16851D0, 0.15282D0,
54399 & 0.13724D0, 0.12215D0, 0.10780D0, 0.09426D0, 0.08175D0,
54400 & 0.07030D0, 0.05975D0, 0.05024D0, 0.04199D0, 0.03453D0,
54401 & 0.02802D0, 0.02251D0, 0.01772D0, 0.01045D0, 0.00564D0,
54402 & 0.00270D0, 0.00108D0, 0.00006D0, 0.00000D0/
54403 DATA (FMRS(2,2,I,22),I=1,49)/
54404 & 0.00816D0, 0.01035D0, 0.01313D0, 0.01511D0, 0.01669D0,
54405 & 0.01803D0, 0.02299D0, 0.02949D0, 0.03427D0, 0.03826D0,
54406 & 0.04194D0, 0.05616D0, 0.07626D0, 0.09141D0, 0.10390D0,
54407 & 0.11463D0, 0.13252D0, 0.15350D0, 0.17897D0, 0.19689D0,
54408 & 0.21895D0, 0.22932D0, 0.23223D0, 0.22887D0, 0.22024D0,
54409 & 0.20839D0, 0.19437D0, 0.17913D0, 0.16346D0, 0.14778D0,
54410 & 0.13233D0, 0.11744D0, 0.10335D0, 0.09011D0, 0.07794D0,
54411 & 0.06684D0, 0.05665D0, 0.04749D0, 0.03958D0, 0.03245D0,
54412 & 0.02625D0, 0.02103D0, 0.01650D0, 0.00967D0, 0.00518D0,
54413 & 0.00246D0, 0.00097D0, 0.00005D0, 0.00000D0/
54414 DATA (FMRS(2,2,I,23),I=1,49)/
54415 & 0.00826D0, 0.01049D0, 0.01333D0, 0.01534D0, 0.01695D0,
54416 & 0.01833D0, 0.02340D0, 0.03004D0, 0.03494D0, 0.03901D0,
54417 & 0.04276D0, 0.05725D0, 0.07764D0, 0.09293D0, 0.10551D0,
54418 & 0.11628D0, 0.13416D0, 0.15502D0, 0.18011D0, 0.19758D0,
54419 & 0.21867D0, 0.22812D0, 0.23018D0, 0.22598D0, 0.21667D0,
54420 & 0.20434D0, 0.19000D0, 0.17460D0, 0.15883D0, 0.14320D0,
54421 & 0.12787D0, 0.11321D0, 0.09934D0, 0.08640D0, 0.07454D0,
54422 & 0.06376D0, 0.05389D0, 0.04504D0, 0.03744D0, 0.03063D0,
54423 & 0.02471D0, 0.01973D0, 0.01544D0, 0.00899D0, 0.00479D0,
54424 & 0.00225D0, 0.00088D0, 0.00005D0, 0.00000D0/
54425 DATA (FMRS(2,2,I,24),I=1,49)/
54426 & 0.00835D0, 0.01062D0, 0.01351D0, 0.01556D0, 0.01721D0,
54427 & 0.01861D0, 0.02378D0, 0.03057D0, 0.03556D0, 0.03972D0,
54428 & 0.04354D0, 0.05827D0, 0.07891D0, 0.09434D0, 0.10698D0,
54429 & 0.11778D0, 0.13564D0, 0.15636D0, 0.18108D0, 0.19811D0,
54430 & 0.21829D0, 0.22687D0, 0.22819D0, 0.22319D0, 0.21330D0,
54431 & 0.20053D0, 0.18593D0, 0.17036D0, 0.15459D0, 0.13902D0,
54432 & 0.12383D0, 0.10936D0, 0.09573D0, 0.08306D0, 0.07149D0,
54433 & 0.06100D0, 0.05144D0, 0.04289D0, 0.03556D0, 0.02901D0,
54434 & 0.02335D0, 0.01859D0, 0.01451D0, 0.00840D0, 0.00444D0,
54435 & 0.00208D0, 0.00081D0, 0.00004D0, 0.00000D0/
54436 DATA (FMRS(2,2,I,25),I=1,49)/
54437 & 0.00844D0, 0.01075D0, 0.01369D0, 0.01578D0, 0.01746D0,
54438 & 0.01889D0, 0.02417D0, 0.03109D0, 0.03619D0, 0.04043D0,
54439 & 0.04431D0, 0.05929D0, 0.08018D0, 0.09573D0, 0.10844D0,
54440 & 0.11926D0, 0.13709D0, 0.15767D0, 0.18202D0, 0.19861D0,
54441 & 0.21788D0, 0.22561D0, 0.22620D0, 0.22044D0, 0.20998D0,
54442 & 0.19681D0, 0.18196D0, 0.16625D0, 0.15048D0, 0.13499D0,
54443 & 0.11994D0, 0.10567D0, 0.09228D0, 0.07987D0, 0.06858D0,
54444 & 0.05838D0, 0.04911D0, 0.04085D0, 0.03379D0, 0.02749D0,
54445 & 0.02207D0, 0.01753D0, 0.01364D0, 0.00785D0, 0.00413D0,
54446 & 0.00192D0, 0.00074D0, 0.00004D0, 0.00000D0/
54447 DATA (FMRS(2,2,I,26),I=1,49)/
54448 & 0.00853D0, 0.01088D0, 0.01388D0, 0.01600D0, 0.01772D0,
54449 & 0.01917D0, 0.02456D0, 0.03161D0, 0.03680D0, 0.04112D0,
54450 & 0.04508D0, 0.06028D0, 0.08140D0, 0.09707D0, 0.10983D0,
54451 & 0.12067D0, 0.13846D0, 0.15889D0, 0.18286D0, 0.19901D0,
54452 & 0.21739D0, 0.22430D0, 0.22419D0, 0.21773D0, 0.20672D0,
54453 & 0.19320D0, 0.17811D0, 0.16233D0, 0.14654D0, 0.13113D0,
54454 & 0.11622D0, 0.10216D0, 0.08901D0, 0.07686D0, 0.06584D0,
54455 & 0.05592D0, 0.04692D0, 0.03894D0, 0.03214D0, 0.02608D0,
54456 & 0.02089D0, 0.01655D0, 0.01285D0, 0.00735D0, 0.00384D0,
54457 & 0.00177D0, 0.00068D0, 0.00003D0, 0.00000D0/
54458 DATA (FMRS(2,2,I,27),I=1,49)/
54459 & 0.00862D0, 0.01100D0, 0.01405D0, 0.01622D0, 0.01796D0,
54460 & 0.01944D0, 0.02492D0, 0.03211D0, 0.03739D0, 0.04178D0,
54461 & 0.04580D0, 0.06121D0, 0.08256D0, 0.09833D0, 0.11114D0,
54462 & 0.12198D0, 0.13974D0, 0.16000D0, 0.18361D0, 0.19934D0,
54463 & 0.21688D0, 0.22303D0, 0.22227D0, 0.21516D0, 0.20368D0,
54464 & 0.18983D0, 0.17455D0, 0.15870D0, 0.14292D0, 0.12759D0,
54465 & 0.11282D0, 0.09895D0, 0.08604D0, 0.07413D0, 0.06336D0,
54466 & 0.05370D0, 0.04495D0, 0.03722D0, 0.03066D0, 0.02482D0,
54467 & 0.01983D0, 0.01568D0, 0.01214D0, 0.00691D0, 0.00359D0,
54468 & 0.00164D0, 0.00063D0, 0.00003D0, 0.00000D0/
54469 DATA (FMRS(2,2,I,28),I=1,49)/
54470 & 0.00871D0, 0.01113D0, 0.01422D0, 0.01642D0, 0.01819D0,
54471 & 0.01970D0, 0.02527D0, 0.03257D0, 0.03795D0, 0.04240D0,
54472 & 0.04648D0, 0.06209D0, 0.08364D0, 0.09950D0, 0.11235D0,
54473 & 0.12320D0, 0.14090D0, 0.16101D0, 0.18426D0, 0.19960D0,
54474 & 0.21635D0, 0.22178D0, 0.22043D0, 0.21273D0, 0.20082D0,
54475 & 0.18670D0, 0.17123D0, 0.15532D0, 0.13957D0, 0.12434D0,
54476 & 0.10972D0, 0.09602D0, 0.08332D0, 0.07164D0, 0.06111D0,
54477 & 0.05170D0, 0.04318D0, 0.03568D0, 0.02933D0, 0.02371D0,
54478 & 0.01889D0, 0.01491D0, 0.01151D0, 0.00652D0, 0.00337D0,
54479 & 0.00153D0, 0.00058D0, 0.00003D0, 0.00000D0/
54480 DATA (FMRS(2,2,I,29),I=1,49)/
54481 & 0.00880D0, 0.01125D0, 0.01439D0, 0.01662D0, 0.01842D0,
54482 & 0.01995D0, 0.02562D0, 0.03305D0, 0.03850D0, 0.04303D0,
54483 & 0.04716D0, 0.06297D0, 0.08471D0, 0.10067D0, 0.11354D0,
54484 & 0.12440D0, 0.14205D0, 0.16199D0, 0.18487D0, 0.19981D0,
54485 & 0.21577D0, 0.22050D0, 0.21856D0, 0.21030D0, 0.19797D0,
54486 & 0.18358D0, 0.16796D0, 0.15200D0, 0.13629D0, 0.12116D0,
54487 & 0.10670D0, 0.09318D0, 0.08069D0, 0.06924D0, 0.05894D0,
54488 & 0.04976D0, 0.04148D0, 0.03421D0, 0.02806D0, 0.02263D0,
54489 & 0.01799D0, 0.01417D0, 0.01091D0, 0.00615D0, 0.00316D0,
54490 & 0.00143D0, 0.00054D0, 0.00003D0, 0.00000D0/
54491 DATA (FMRS(2,2,I,30),I=1,49)/
54492 & 0.00889D0, 0.01137D0, 0.01456D0, 0.01683D0, 0.01865D0,
54493 & 0.02021D0, 0.02596D0, 0.03351D0, 0.03906D0, 0.04365D0,
54494 & 0.04784D0, 0.06384D0, 0.08576D0, 0.10180D0, 0.11470D0,
54495 & 0.12555D0, 0.14314D0, 0.16292D0, 0.18544D0, 0.19997D0,
54496 & 0.21516D0, 0.21921D0, 0.21670D0, 0.20790D0, 0.19518D0,
54497 & 0.18054D0, 0.16480D0, 0.14880D0, 0.13314D0, 0.11810D0,
54498 & 0.10380D0, 0.09048D0, 0.07819D0, 0.06696D0, 0.05688D0,
54499 & 0.04793D0, 0.03987D0, 0.03282D0, 0.02686D0, 0.02162D0,
54500 & 0.01715D0, 0.01347D0, 0.01036D0, 0.00581D0, 0.00297D0,
54501 & 0.00134D0, 0.00050D0, 0.00002D0, 0.00000D0/
54502 DATA (FMRS(2,2,I,31),I=1,49)/
54503 & 0.00897D0, 0.01149D0, 0.01472D0, 0.01702D0, 0.01887D0,
54504 & 0.02045D0, 0.02630D0, 0.03396D0, 0.03958D0, 0.04424D0,
54505 & 0.04848D0, 0.06466D0, 0.08676D0, 0.10286D0, 0.11579D0,
54506 & 0.12663D0, 0.14416D0, 0.16377D0, 0.18594D0, 0.20009D0,
54507 & 0.21455D0, 0.21797D0, 0.21493D0, 0.20563D0, 0.19256D0,
54508 & 0.17769D0, 0.16185D0, 0.14582D0, 0.13021D0, 0.11528D0,
54509 & 0.10112D0, 0.08798D0, 0.07588D0, 0.06486D0, 0.05500D0,
54510 & 0.04626D0, 0.03841D0, 0.03155D0, 0.02578D0, 0.02071D0,
54511 & 0.01640D0, 0.01285D0, 0.00986D0, 0.00551D0, 0.00280D0,
54512 & 0.00125D0, 0.00046D0, 0.00002D0, 0.00000D0/
54513 DATA (FMRS(2,2,I,32),I=1,49)/
54514 & 0.00905D0, 0.01160D0, 0.01487D0, 0.01721D0, 0.01909D0,
54515 & 0.02069D0, 0.02661D0, 0.03438D0, 0.04008D0, 0.04480D0,
54516 & 0.04909D0, 0.06543D0, 0.08768D0, 0.10385D0, 0.11679D0,
54517 & 0.12763D0, 0.14509D0, 0.16454D0, 0.18637D0, 0.20016D0,
54518 & 0.21393D0, 0.21676D0, 0.21323D0, 0.20346D0, 0.19008D0,
54519 & 0.17502D0, 0.15909D0, 0.14304D0, 0.12749D0, 0.11266D0,
54520 & 0.09863D0, 0.08567D0, 0.07376D0, 0.06293D0, 0.05328D0,
54521 & 0.04474D0, 0.03708D0, 0.03039D0, 0.02479D0, 0.01988D0,
54522 & 0.01572D0, 0.01229D0, 0.00941D0, 0.00524D0, 0.00265D0,
54523 & 0.00118D0, 0.00043D0, 0.00002D0, 0.00000D0/
54524 DATA (FMRS(2,2,I,33),I=1,49)/
54525 & 0.00914D0, 0.01172D0, 0.01503D0, 0.01740D0, 0.01930D0,
54526 & 0.02092D0, 0.02693D0, 0.03481D0, 0.04058D0, 0.04536D0,
54527 & 0.04970D0, 0.06621D0, 0.08862D0, 0.10485D0, 0.11781D0,
54528 & 0.12863D0, 0.14602D0, 0.16531D0, 0.18679D0, 0.20022D0,
54529 & 0.21330D0, 0.21555D0, 0.21154D0, 0.20131D0, 0.18763D0,
54530 & 0.17238D0, 0.15637D0, 0.14031D0, 0.12482D0, 0.11010D0,
54531 & 0.09620D0, 0.08342D0, 0.07168D0, 0.06106D0, 0.05161D0,
54532 & 0.04326D0, 0.03580D0, 0.02928D0, 0.02384D0, 0.01908D0,
54533 & 0.01506D0, 0.01176D0, 0.00899D0, 0.00498D0, 0.00251D0,
54534 & 0.00111D0, 0.00041D0, 0.00002D0, 0.00000D0/
54535 DATA (FMRS(2,2,I,34),I=1,49)/
54536 & 0.00922D0, 0.01183D0, 0.01519D0, 0.01758D0, 0.01951D0,
54537 & 0.02116D0, 0.02725D0, 0.03523D0, 0.04108D0, 0.04592D0,
54538 & 0.05030D0, 0.06698D0, 0.08953D0, 0.10581D0, 0.11878D0,
54539 & 0.12959D0, 0.14690D0, 0.16601D0, 0.18715D0, 0.20021D0,
54540 & 0.21262D0, 0.21429D0, 0.20982D0, 0.19916D0, 0.18519D0,
54541 & 0.16977D0, 0.15369D0, 0.13763D0, 0.12221D0, 0.10760D0,
54542 & 0.09385D0, 0.08123D0, 0.06969D0, 0.05926D0, 0.05001D0,
54543 & 0.04183D0, 0.03456D0, 0.02822D0, 0.02295D0, 0.01833D0,
54544 & 0.01444D0, 0.01126D0, 0.00858D0, 0.00473D0, 0.00238D0,
54545 & 0.00105D0, 0.00038D0, 0.00002D0, 0.00000D0/
54546 DATA (FMRS(2,2,I,35),I=1,49)/
54547 & 0.00930D0, 0.01194D0, 0.01534D0, 0.01777D0, 0.01972D0,
54548 & 0.02138D0, 0.02755D0, 0.03564D0, 0.04156D0, 0.04645D0,
54549 & 0.05088D0, 0.06771D0, 0.09039D0, 0.10673D0, 0.11970D0,
54550 & 0.13050D0, 0.14773D0, 0.16667D0, 0.18748D0, 0.20020D0,
54551 & 0.21197D0, 0.21309D0, 0.20820D0, 0.19714D0, 0.18290D0,
54552 & 0.16734D0, 0.15119D0, 0.13514D0, 0.11978D0, 0.10528D0,
54553 & 0.09167D0, 0.07922D0, 0.06786D0, 0.05760D0, 0.04853D0,
54554 & 0.04052D0, 0.03343D0, 0.02726D0, 0.02213D0, 0.01765D0,
54555 & 0.01387D0, 0.01080D0, 0.00822D0, 0.00451D0, 0.00226D0,
54556 & 0.00099D0, 0.00036D0, 0.00002D0, 0.00000D0/
54557 DATA (FMRS(2,2,I,36),I=1,49)/
54558 & 0.00938D0, 0.01205D0, 0.01549D0, 0.01794D0, 0.01992D0,
54559 & 0.02160D0, 0.02784D0, 0.03602D0, 0.04201D0, 0.04696D0,
54560 & 0.05143D0, 0.06840D0, 0.09121D0, 0.10758D0, 0.12056D0,
54561 & 0.13134D0, 0.14849D0, 0.16728D0, 0.18776D0, 0.20016D0,
54562 & 0.21132D0, 0.21194D0, 0.20664D0, 0.19522D0, 0.18074D0,
54563 & 0.16504D0, 0.14884D0, 0.13281D0, 0.11752D0, 0.10313D0,
54564 & 0.08965D0, 0.07735D0, 0.06616D0, 0.05608D0, 0.04717D0,
54565 & 0.03933D0, 0.03239D0, 0.02637D0, 0.02137D0, 0.01702D0,
54566 & 0.01336D0, 0.01038D0, 0.00788D0, 0.00431D0, 0.00215D0,
54567 & 0.00094D0, 0.00034D0, 0.00001D0, 0.00000D0/
54568 DATA (FMRS(2,2,I,37),I=1,49)/
54569 & 0.00946D0, 0.01216D0, 0.01563D0, 0.01812D0, 0.02011D0,
54570 & 0.02182D0, 0.02814D0, 0.03641D0, 0.04247D0, 0.04747D0,
54571 & 0.05199D0, 0.06909D0, 0.09202D0, 0.10844D0, 0.12142D0,
54572 & 0.13217D0, 0.14925D0, 0.16786D0, 0.18802D0, 0.20008D0,
54573 & 0.21063D0, 0.21075D0, 0.20506D0, 0.19327D0, 0.17856D0,
54574 & 0.16274D0, 0.14648D0, 0.13048D0, 0.11526D0, 0.10099D0,
54575 & 0.08766D0, 0.07551D0, 0.06448D0, 0.05458D0, 0.04583D0,
54576 & 0.03816D0, 0.03137D0, 0.02550D0, 0.02064D0, 0.01641D0,
54577 & 0.01285D0, 0.00997D0, 0.00756D0, 0.00412D0, 0.00204D0,
54578 & 0.00089D0, 0.00032D0, 0.00001D0, 0.00000D0/
54579 DATA (FMRS(2,2,I,38),I=1,49)/
54580 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54581 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54582 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54583 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54584 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54585 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54586 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54587 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54588 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54589 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54590 DATA (FMRS(2,3,I, 1),I=1,49)/
54591 & 2.49594D0, 2.59678D0, 2.70121D0, 2.76381D0, 2.80882D0,
54592 & 2.84400D0, 2.95410D0, 3.06293D0, 3.12376D0, 3.16433D0,
54593 & 3.19612D0, 3.26381D0, 3.24185D0, 3.15396D0, 3.04339D0,
54594 & 2.92461D0, 2.68378D0, 2.34265D0, 1.85814D0, 1.47710D0,
54595 & 0.96403D0, 0.68739D0, 0.56164D0, 0.53053D0, 0.57114D0,
54596 & 0.63752D0, 0.70266D0, 0.75190D0, 0.77864D0, 0.78165D0,
54597 & 0.76223D0, 0.72410D0, 0.67143D0, 0.60861D0, 0.54010D0,
54598 & 0.46946D0, 0.39966D0, 0.33340D0, 0.27271D0, 0.21796D0,
54599 & 0.17035D0, 0.13022D0, 0.09678D0, 0.04919D0, 0.02174D0,
54600 & 0.00799D0, 0.00226D0, 0.00004D0, 0.00000D0/
54601 DATA (FMRS(2,3,I, 2),I=1,49)/
54602 & 4.92533D0, 4.79050D0, 4.65910D0, 4.58370D0, 4.53079D0,
54603 & 4.49006D0, 4.36491D0, 4.24084D0, 4.16793D0, 4.11560D0,
54604 & 4.07957D0, 3.94076D0, 3.72768D0, 3.53640D0, 3.35786D0,
54605 & 3.19001D0, 2.88282D0, 2.48367D0, 1.95213D0, 1.55132D0,
54606 & 1.02835D0, 0.75268D0, 0.62744D0, 0.59181D0, 0.62218D0,
54607 & 0.67462D0, 0.72413D0, 0.75779D0, 0.77032D0, 0.76124D0,
54608 & 0.73236D0, 0.68747D0, 0.63069D0, 0.56612D0, 0.49789D0,
54609 & 0.42912D0, 0.36239D0, 0.29993D0, 0.24354D0, 0.19324D0,
54610 & 0.14994D0, 0.11382D0, 0.08400D0, 0.04209D0, 0.01833D0,
54611 & 0.00664D0, 0.00185D0, 0.00003D0, 0.00000D0/
54612 DATA (FMRS(2,3,I, 3),I=1,49)/
54613 & 9.56993D0, 8.80858D0, 8.10702D0, 7.72221D0, 7.45989D0,
54614 & 7.26226D0, 6.67868D0, 6.13604D0, 5.83460D0, 5.62657D0,
54615 & 5.47187D0, 4.98498D0, 4.45878D0, 4.10350D0, 3.81920D0,
54616 & 3.57625D0, 3.16921D0, 2.68460D0, 2.08542D0, 1.65674D0,
54617 & 1.11953D0, 0.84374D0, 0.71690D0, 0.67195D0, 0.68567D0,
54618 & 0.71718D0, 0.74433D0, 0.75653D0, 0.75014D0, 0.72558D0,
54619 & 0.68509D0, 0.63243D0, 0.57149D0, 0.50592D0, 0.43925D0,
54620 & 0.37400D0, 0.31223D0, 0.25550D0, 0.20529D0, 0.16120D0,
54621 & 0.12380D0, 0.09303D0, 0.06796D0, 0.03337D0, 0.01425D0,
54622 & 0.00506D0, 0.00138D0, 0.00002D0, 0.00000D0/
54623 DATA (FMRS(2,3,I, 4),I=1,49)/
54624 & 13.80940D0, 12.36505D0, 11.07010D0, 10.37511D0, 9.90777D0,
54625 & 9.55916D0, 8.54772D0, 7.63175D0, 7.13319D0, 6.79336D0,
54626 & 6.53831D0, 5.76591D0, 4.99154D0, 4.51033D0, 4.14636D0,
54627 & 3.84778D0, 3.36791D0, 2.82235D0, 2.17611D0, 1.72845D0,
54628 & 1.18134D0, 0.90432D0, 0.77478D0, 0.72147D0, 0.72239D0,
54629 & 0.73883D0, 0.75059D0, 0.74861D0, 0.73014D0, 0.69610D0,
54630 & 0.64889D0, 0.59216D0, 0.52949D0, 0.46423D0, 0.39938D0,
54631 & 0.33717D0, 0.27919D0, 0.22665D0, 0.18078D0, 0.14088D0,
54632 & 0.10742D0, 0.08015D0, 0.05814D0, 0.02814D0, 0.01185D0,
54633 & 0.00415D0, 0.00112D0, 0.00002D0, 0.00000D0/
54634 DATA (FMRS(2,3,I, 5),I=1,49)/
54635 & 18.88911D0, 16.54105D0, 14.48190D0, 13.39606D0, 12.67388D0,
54636 & 12.13950D0, 10.61083D0, 9.25560D0, 8.52999D0, 8.04031D0,
54637 & 7.67199D0, 6.58349D0, 5.54112D0, 4.92668D0, 4.47939D0,
54638 & 4.12305D0, 3.56848D0, 2.96102D0, 2.26733D0, 1.80038D0,
54639 & 1.24179D0, 0.96142D0, 0.82726D0, 0.76409D0, 0.75165D0,
54640 & 0.75317D0, 0.75022D0, 0.73504D0, 0.70570D0, 0.66340D0,
54641 & 0.61066D0, 0.55093D0, 0.48745D0, 0.42321D0, 0.36077D0,
54642 & 0.30193D0, 0.24792D0, 0.19962D0, 0.15797D0, 0.12220D0,
54643 & 0.09245D0, 0.06850D0, 0.04934D0, 0.02353D0, 0.00976D0,
54644 & 0.00337D0, 0.00090D0, 0.00002D0, 0.00000D0/
54645 DATA (FMRS(2,3,I, 6),I=1,49)/
54646 & 24.17862D0, 20.81157D0, 17.90894D0, 16.39907D0, 15.40344D0,
54647 & 14.67132D0, 12.59987D0, 10.79385D0, 9.83948D0, 9.20057D0,
54648 & 8.72036D0, 7.32519D0, 6.02998D0, 5.29291D0, 4.77007D0,
54649 & 4.36196D0, 3.74120D0, 3.07968D0, 2.34504D0, 1.86151D0,
54650 & 1.29269D0, 1.00884D0, 0.87005D0, 0.79769D0, 0.77342D0,
54651 & 0.76224D0, 0.74721D0, 0.72151D0, 0.68376D0, 0.63535D0,
54652 & 0.57871D0, 0.51714D0, 0.45352D0, 0.39051D0, 0.33033D0,
54653 & 0.27444D0, 0.22374D0, 0.17892D0, 0.14065D0, 0.10811D0,
54654 & 0.08127D0, 0.05985D0, 0.04284D0, 0.02018D0, 0.00827D0,
54655 & 0.00283D0, 0.00075D0, 0.00001D0, 0.00000D0/
54656 DATA (FMRS(2,3,I, 7),I=1,49)/
54657 & 29.73861D0, 25.23818D0, 21.41267D0, 19.44500D0, 18.15658D0,
54658 & 17.21404D0, 14.57125D0, 12.29875D0, 11.11092D0, 10.32111D0,
54659 & 9.72854D0, 8.02926D0, 6.48794D0, 5.63342D0, 5.03891D0,
54660 & 4.58210D0, 3.89945D0, 3.18799D0, 2.41570D0, 1.91680D0,
54661 & 1.33767D0, 1.04936D0, 0.90523D0, 0.82366D0, 0.78841D0,
54662 & 0.76591D0, 0.74039D0, 0.70578D0, 0.66114D0, 0.60793D0,
54663 & 0.54844D0, 0.48585D0, 0.42265D0, 0.36114D0, 0.30329D0,
54664 & 0.25030D0, 0.20271D0, 0.16106D0, 0.12587D0, 0.09616D0,
54665 & 0.07187D0, 0.05262D0, 0.03744D0, 0.01745D0, 0.00707D0,
54666 & 0.00239D0, 0.00063D0, 0.00001D0, 0.00000D0/
54667 DATA (FMRS(2,3,I, 8),I=1,49)/
54668 & 36.41777D0, 30.48425D0, 25.50925D0, 22.97827D0, 21.33235D0,
54669 & 20.13434D0, 16.80486D0, 13.98059D0, 12.52029D0, 11.55588D0,
54670 & 10.83420D0, 8.78991D0, 6.97511D0, 5.99232D0, 5.32046D0,
54671 & 4.81154D0, 4.06330D0, 3.29938D0, 2.48793D0, 1.97297D0,
54672 & 1.38262D0, 1.08896D0, 0.93866D0, 0.84707D0, 0.80034D0,
54673 & 0.76640D0, 0.73057D0, 0.68748D0, 0.63647D0, 0.57905D0,
54674 & 0.51730D0, 0.45416D0, 0.39180D0, 0.33216D0, 0.27689D0,
54675 & 0.22693D0, 0.18251D0, 0.14405D0, 0.11189D0, 0.08494D0,
54676 & 0.06310D0, 0.04592D0, 0.03248D0, 0.01496D0, 0.00600D0,
54677 & 0.00201D0, 0.00052D0, 0.00001D0, 0.00000D0/
54678 DATA (FMRS(2,3,I, 9),I=1,49)/
54679 & 42.89913D0, 35.51439D0, 29.39055D0, 26.30256D0, 24.30551D0,
54680 & 22.85784D0, 18.86316D0, 15.51177D0, 13.79420D0, 12.66617D0,
54681 & 11.82423D0, 9.46212D0, 7.39982D0, 6.30264D0, 5.56252D0,
54682 & 5.00794D0, 4.20275D0, 3.39360D0, 2.54868D0, 2.01994D0,
54683 & 1.41958D0, 1.12075D0, 0.96469D0, 0.86425D0, 0.80777D0,
54684 & 0.76439D0, 0.72030D0, 0.67061D0, 0.61480D0, 0.55436D0,
54685 & 0.49120D0, 0.42796D0, 0.36659D0, 0.30874D0, 0.25576D0,
54686 & 0.20835D0, 0.16660D0, 0.13075D0, 0.10101D0, 0.07629D0,
54687 & 0.05637D0, 0.04082D0, 0.02872D0, 0.01310D0, 0.00521D0,
54688 & 0.00173D0, 0.00045D0, 0.00001D0, 0.00000D0/
54689 DATA (FMRS(2,3,I,10),I=1,49)/
54690 & 49.61974D0, 40.67585D0, 33.33157D0, 29.65726D0, 27.29273D0,
54691 & 25.58490D0, 20.90223D0, 17.01226D0, 15.03449D0, 13.74211D0,
54692 & 12.78005D0, 10.10345D0, 7.80003D0, 6.59295D0, 5.78776D0,
54693 & 5.18997D0, 4.33113D0, 3.47979D0, 2.60379D0, 2.06215D0,
54694 & 1.45191D0, 1.14765D0, 0.98577D0, 0.87686D0, 0.81144D0,
54695 & 0.75966D0, 0.70838D0, 0.65310D0, 0.59339D0, 0.53065D0,
54696 & 0.46666D0, 0.40372D0, 0.34354D0, 0.28753D0, 0.23679D0,
54697 & 0.19183D0, 0.15254D0, 0.11910D0, 0.09155D0, 0.06880D0,
54698 & 0.05059D0, 0.03647D0, 0.02554D0, 0.01155D0, 0.00456D0,
54699 & 0.00150D0, 0.00039D0, 0.00001D0, 0.00000D0/
54700 DATA (FMRS(2,3,I,11),I=1,49)/
54701 & 55.39180D0, 45.07076D0, 36.65840D0, 32.47479D0, 29.79258D0,
54702 & 27.86062D0, 22.58892D0, 18.24235D0, 16.04583D0, 14.61602D0,
54703 & 13.55394D0, 10.61757D0, 8.11747D0, 6.82180D0, 5.96451D0,
54704 & 5.33234D0, 4.43100D0, 3.54652D0, 2.64619D0, 2.09446D0,
54705 & 1.47626D0, 1.16746D0, 1.00084D0, 0.88523D0, 0.81292D0,
54706 & 0.75482D0, 0.69824D0, 0.63893D0, 0.57653D0, 0.51229D0,
54707 & 0.44790D0, 0.38538D0, 0.32625D0, 0.27173D0, 0.22275D0,
54708 & 0.17969D0, 0.14226D0, 0.11063D0, 0.08472D0, 0.06341D0,
54709 & 0.04647D0, 0.03337D0, 0.02328D0, 0.01046D0, 0.00410D0,
54710 & 0.00135D0, 0.00035D0, 0.00001D0, 0.00000D0/
54711 DATA (FMRS(2,3,I,12),I=1,49)/
54712 & 68.81419D0, 55.16745D0, 44.20809D0, 38.82247D0, 35.39534D0,
54713 & 32.94036D0, 26.30577D0, 20.91710D0, 18.22705D0, 16.48958D0,
54714 & 15.20488D0, 11.69679D0, 8.77186D0, 7.28789D0, 6.32113D0,
54715 & 5.61724D0, 4.62839D0, 3.67636D0, 2.72714D0, 2.15522D0,
54716 & 1.52072D0, 1.20219D0, 1.02548D0, 0.89610D0, 0.81011D0,
54717 & 0.73981D0, 0.67337D0, 0.60686D0, 0.53995D0, 0.47362D0,
54718 & 0.40911D0, 0.34808D0, 0.29158D0, 0.24046D0, 0.19523D0,
54719 & 0.15609D0, 0.12251D0, 0.09445D0, 0.07178D0, 0.05329D0,
54720 & 0.03875D0, 0.02763D0, 0.01914D0, 0.00848D0, 0.00328D0,
54721 & 0.00107D0, 0.00027D0, 0.00001D0, 0.00000D0/
54722 DATA (FMRS(2,3,I,13),I=1,49)/
54723 & 81.72071D0, 64.73620D0, 51.25830D0, 44.69851D0, 40.54929D0,
54724 & 37.59021D0, 29.65526D0, 23.28836D0, 20.14139D0, 18.12166D0,
54725 & 16.63424D0, 12.61228D0, 9.31401D0, 7.66787D0, 6.60816D0,
54726 & 5.84402D0, 4.78269D0, 3.77556D0, 2.78721D0, 2.19932D0,
54727 & 1.55169D0, 1.22492D0, 1.03973D0, 0.89912D0, 0.80240D0,
54728 & 0.72291D0, 0.64937D0, 0.57800D0, 0.50838D0, 0.44121D0,
54729 & 0.37732D0, 0.31807D0, 0.26412D0, 0.21603D0, 0.17402D0,
54730 & 0.13809D0, 0.10760D0, 0.08235D0, 0.06220D0, 0.04588D0,
54731 & 0.03314D0, 0.02349D0, 0.01618D0, 0.00709D0, 0.00272D0,
54732 & 0.00088D0, 0.00022D0, 0.00001D0, 0.00000D0/
54733 DATA (FMRS(2,3,I,14),I=1,49)/
54734 & 97.52657D0, 76.29261D0, 59.65305D0, 51.63612D0, 46.59734D0,
54735 & 43.02061D0, 33.50751D0, 25.97167D0, 22.28590D0, 19.93624D0,
54736 & 18.21366D0, 13.60275D0, 9.88582D0, 8.06142D0, 6.90102D0,
54737 & 6.07241D0, 4.93443D0, 3.87015D0, 2.84210D0, 2.23830D0,
54738 & 1.57740D0, 1.24193D0, 1.04776D0, 0.89562D0, 0.78827D0,
54739 & 0.70003D0, 0.62012D0, 0.54473D0, 0.47326D0, 0.40608D0,
54740 & 0.34362D0, 0.28678D0, 0.23589D0, 0.19121D0, 0.15279D0,
54741 & 0.12024D0, 0.09296D0, 0.07060D0, 0.05295D0, 0.03880D0,
54742 & 0.02782D0, 0.01961D0, 0.01341D0, 0.00581D0, 0.00221D0,
54743 & 0.00071D0, 0.00018D0, 0.00000D0, 0.00000D0/
54744 DATA (FMRS(2,3,I,15),I=1,49)/
54745 & 115.42858D0, 89.21046D0, 68.91241D0, 59.22810D0, 53.17852D0,
54746 & 48.90368D0, 37.62299D0, 28.79719D0, 24.52433D0, 21.81818D0,
54747 & 19.84305D0, 14.60749D0, 10.45530D0, 8.44881D0, 7.18665D0,
54748 & 6.29326D0, 5.07912D0, 3.95881D0, 2.89174D0, 2.27205D0,
54749 & 1.59726D0, 1.25251D0, 1.04935D0, 0.88634D0, 0.76946D0,
54750 & 0.67380D0, 0.58880D0, 0.51059D0, 0.43833D0, 0.37190D0,
54751 & 0.31141D0, 0.25732D0, 0.20974D0, 0.16850D0, 0.13349D0,
54752 & 0.10422D0, 0.07994D0, 0.06028D0, 0.04489D0, 0.03267D0,
54753 & 0.02328D0, 0.01630D0, 0.01109D0, 0.00475D0, 0.00179D0,
54754 & 0.00057D0, 0.00015D0, 0.00000D0, 0.00000D0/
54755 DATA (FMRS(2,3,I,16),I=1,49)/
54756 & 133.20726D0,101.88441D0, 77.88580D0, 66.53202D0, 59.47687D0,
54757 & 54.51081D0, 41.49468D0, 31.41946D0, 26.58451D0, 23.53963D0,
54758 & 21.32609D0, 15.50695D0, 10.95547D0, 8.78473D0, 7.43186D0,
54759 & 6.48132D0, 5.20052D0, 4.03146D0, 2.93090D0, 2.29753D0,
54760 & 1.61041D0, 1.25744D0, 1.04659D0, 0.87462D0, 0.75027D0,
54761 & 0.64906D0, 0.56054D0, 0.48074D0, 0.40844D0, 0.34317D0,
54762 & 0.28476D0, 0.23329D0, 0.18860D0, 0.15037D0, 0.11827D0,
54763 & 0.09171D0, 0.06985D0, 0.05235D0, 0.03876D0, 0.02805D0,
54764 & 0.01988D0, 0.01385D0, 0.00937D0, 0.00398D0, 0.00150D0,
54765 & 0.00048D0, 0.00012D0, 0.00000D0, 0.00000D0/
54766 DATA (FMRS(2,3,I,17),I=1,49)/
54767 & 152.75288D0,115.66533D0, 87.53463D0, 74.33386D0, 66.17272D0,
54768 & 60.44971D0, 45.54741D0, 34.13087D0, 28.69873D0, 25.29647D0,
54769 & 22.83273D0, 16.40709D0, 11.44748D0, 9.11138D0, 7.66812D0,
54770 & 6.66113D0, 5.31487D0, 4.09842D0, 2.96558D0, 2.31899D0,
54771 & 1.61977D0, 1.25878D0, 1.04063D0, 0.86046D0, 0.72956D0,
54772 & 0.62377D0, 0.53260D0, 0.45191D0, 0.38010D0, 0.31636D0,
54773 & 0.26019D0, 0.21141D0, 0.16955D0, 0.13419D0, 0.10481D0,
54774 & 0.08073D0, 0.06109D0, 0.04550D0, 0.03350D0, 0.02411D0,
54775 & 0.01700D0, 0.01178D0, 0.00794D0, 0.00335D0, 0.00125D0,
54776 & 0.00040D0, 0.00010D0, 0.00000D0, 0.00000D0/
54777 DATA (FMRS(2,3,I,18),I=1,49)/
54778 & 170.01192D0,127.71370D0, 95.88535D0, 81.04548D0, 71.90795D0,
54779 & 65.51928D0, 48.96956D0, 36.39437D0, 30.45131D0, 26.74517D0,
54780 & 24.06967D0, 17.13549D0, 11.83889D0, 9.36824D0, 7.85201D0,
54781 & 6.79985D0, 5.40144D0, 4.14772D0, 2.98965D0, 2.33267D0,
54782 & 1.62383D0, 1.25653D0, 1.03280D0, 0.84662D0, 0.71111D0,
54783 & 0.60235D0, 0.50969D0, 0.42880D0, 0.35778D0, 0.29558D0,
54784 & 0.24138D0, 0.19483D0, 0.15529D0, 0.12217D0, 0.09488D0,
54785 & 0.07271D0, 0.05474D0, 0.04057D0, 0.02974D0, 0.02131D0,
54786 & 0.01497D0, 0.01034D0, 0.00694D0, 0.00291D0, 0.00108D0,
54787 & 0.00035D0, 0.00009D0, 0.00000D0, 0.00000D0/
54788 DATA (FMRS(2,3,I,19),I=1,49)/
54789 & 192.21783D0,143.06714D0,106.42301D0, 89.46533D0, 79.07272D0,
54790 & 71.83153D0, 53.18588D0, 39.15232D0, 32.57201D0, 28.48916D0,
54791 & 25.55252D0, 17.99626D0, 12.29353D0, 9.66291D0, 8.06074D0,
54792 & 6.95556D0, 5.49677D0, 4.20023D0, 3.01333D0, 2.34451D0,
54793 & 1.62470D0, 1.25025D0, 1.02039D0, 0.82787D0, 0.68779D0,
54794 & 0.57628D0, 0.48256D0, 0.40194D0, 0.33226D0, 0.27214D0,
54795 & 0.22041D0, 0.17653D0, 0.13970D0, 0.10915D0, 0.08422D0,
54796 & 0.06416D0, 0.04803D0, 0.03538D0, 0.02582D0, 0.01841D0,
54797 & 0.01287D0, 0.00885D0, 0.00592D0, 0.00247D0, 0.00092D0,
54798 & 0.00029D0, 0.00008D0, 0.00000D0, 0.00000D0/
54799 DATA (FMRS(2,3,I,20),I=1,49)/
54800 & 213.34880D0,157.54303D0,116.26574D0, 97.28644D0, 85.70139D0,
54801 & 77.65329D0, 57.03621D0, 41.64487D0, 34.47643D0, 30.04790D0,
54802 & 26.87277D0, 18.75275D0, 12.68704D0, 9.91527D0, 8.23788D0,
54803 & 7.08656D0, 5.57571D0, 4.24254D0, 3.03117D0, 2.35234D0,
54804 & 1.62325D0, 1.24282D0, 1.00799D0, 0.81051D0, 0.66705D0,
54805 & 0.55370D0, 0.45951D0, 0.37948D0, 0.31121D0, 0.25302D0,
54806 & 0.20347D0, 0.16190D0, 0.12732D0, 0.09891D0, 0.07590D0,
54807 & 0.05752D0, 0.04285D0, 0.03141D0, 0.02283D0, 0.01621D0,
54808 & 0.01129D0, 0.00774D0, 0.00517D0, 0.00215D0, 0.00079D0,
54809 & 0.00025D0, 0.00007D0, 0.00000D0, 0.00000D0/
54810 DATA (FMRS(2,3,I,21),I=1,49)/
54811 & 233.39284D0,171.15466D0,125.43786D0,104.53514D0, 91.82097D0,
54812 & 83.01126D0, 60.54451D0, 43.89167D0, 36.18145D0, 31.43626D0,
54813 & 28.04374D0, 19.41375D0, 13.02433D0, 10.12820D0, 8.38525D0,
54814 & 7.19405D0, 5.63853D0, 4.27419D0, 3.04230D0, 2.35510D0,
54815 & 1.61821D0, 1.23292D0, 0.99418D0, 0.79299D0, 0.64721D0,
54816 & 0.53284D0, 0.43872D0, 0.35966D0, 0.29291D0, 0.23658D0,
54817 & 0.18910D0, 0.14961D0, 0.11702D0, 0.09045D0, 0.06907D0,
54818 & 0.05212D0, 0.03865D0, 0.02823D0, 0.02044D0, 0.01446D0,
54819 & 0.01004D0, 0.00687D0, 0.00457D0, 0.00189D0, 0.00070D0,
54820 & 0.00022D0, 0.00006D0, 0.00000D0, 0.00000D0/
54821 DATA (FMRS(2,3,I,22),I=1,49)/
54822 & 260.44016D0,189.36696D0,137.60457D0,114.10131D0, 99.86725D0,
54823 & 90.03576D0, 65.10178D0, 46.78208D0, 38.36169D0, 33.20363D0,
54824 & 29.52871D0, 20.24143D0, 13.44020D0, 10.38777D0, 8.56307D0,
54825 & 7.32250D0, 5.71195D0, 4.30962D0, 3.05294D0, 2.35572D0,
54826 & 1.60960D0, 1.21865D0, 0.97551D0, 0.77034D0, 0.62226D0,
54827 & 0.50716D0, 0.41356D0, 0.33596D0, 0.27128D0, 0.21734D0,
54828 & 0.17244D0, 0.13547D0, 0.10527D0, 0.08085D0, 0.06139D0,
54829 & 0.04607D0, 0.03398D0, 0.02471D0, 0.01781D0, 0.01255D0,
54830 & 0.00868D0, 0.00593D0, 0.00393D0, 0.00162D0, 0.00060D0,
54831 & 0.00019D0, 0.00005D0, 0.00000D0, 0.00000D0/
54832 DATA (FMRS(2,3,I,23),I=1,49)/
54833 & 287.44696D0,207.38838D0,149.53354D0,123.42919D0,107.68206D0,
54834 & 96.83708D0, 69.47065D0, 49.52397D0, 40.41636D0, 34.86102D0,
54835 & 30.91543D0, 21.00356D0, 13.81644D0, 10.61949D0, 8.71986D0,
54836 & 7.43441D0, 5.77408D0, 4.33783D0, 3.05923D0, 2.35324D0,
54837 & 1.59919D0, 1.20346D0, 0.95679D0, 0.74861D0, 0.59903D0,
54838 & 0.48379D0, 0.39106D0, 0.31505D0, 0.25241D0, 0.20076D0,
54839 & 0.15822D0, 0.12352D0, 0.09541D0, 0.07286D0, 0.05504D0,
54840 & 0.04110D0, 0.03018D0, 0.02185D0, 0.01570D0, 0.01103D0,
54841 & 0.00760D0, 0.00518D0, 0.00342D0, 0.00141D0, 0.00052D0,
54842 & 0.00017D0, 0.00004D0, 0.00000D0, 0.00000D0/
54843 DATA (FMRS(2,3,I,24),I=1,49)/
54844 & 313.51825D0,224.63136D0,160.84229D0,132.22295D0,115.01953D0,
54845 & 103.20245D0, 73.51698D0, 52.03463D0, 42.28400D0, 36.35911D0,
54846 & 32.16307D0, 21.67765D0, 14.14149D0, 10.81558D0, 8.84983D0,
54847 & 7.52509D0, 5.82169D0, 4.35654D0, 3.05952D0, 2.34629D0,
54848 & 1.58590D0, 1.18656D0, 0.93734D0, 0.72724D0, 0.57702D0,
54849 & 0.46218D0, 0.37070D0, 0.29646D0, 0.23590D0, 0.18642D0,
54850 & 0.14603D0, 0.11337D0, 0.08712D0, 0.06621D0, 0.04979D0,
54851 & 0.03702D0, 0.02708D0, 0.01953D0, 0.01399D0, 0.00980D0,
54852 & 0.00674D0, 0.00458D0, 0.00302D0, 0.00124D0, 0.00046D0,
54853 & 0.00015D0, 0.00004D0, 0.00000D0, 0.00000D0/
54854 DATA (FMRS(2,3,I,25),I=1,49)/
54855 & 341.15173D0,242.77290D0,172.65150D0,141.36496D0,122.62321D0,
54856 & 109.78229D0, 77.66644D0, 54.58787D0, 44.17350D0, 37.86890D0,
54857 & 33.41642D0, 22.34751D0, 14.46016D0, 11.00588D0, 8.97477D0,
54858 & 7.61137D0, 5.86592D0, 4.37273D0, 3.05810D0, 2.33803D0,
54859 & 1.57177D0, 1.16920D0, 0.91780D0, 0.70620D0, 0.55570D0,
54860 & 0.44154D0, 0.35145D0, 0.27905D0, 0.22057D0, 0.17322D0,
54861 & 0.13490D0, 0.10417D0, 0.07964D0, 0.06025D0, 0.04510D0,
54862 & 0.03340D0, 0.02434D0, 0.01749D0, 0.01249D0, 0.00873D0,
54863 & 0.00599D0, 0.00406D0, 0.00268D0, 0.00110D0, 0.00041D0,
54864 & 0.00013D0, 0.00004D0, 0.00000D0, 0.00000D0/
54865 DATA (FMRS(2,3,I,26),I=1,49)/
54866 & 368.98822D0,260.90195D0,184.35516D0,150.38000D0,130.09390D0,
54867 & 116.22827D0, 81.69344D0, 57.04021D0, 45.97627D0, 39.30195D0,
54868 & 34.60083D0, 22.97047D0, 14.74975D0, 11.17543D0, 9.08370D0,
54869 & 7.68467D0, 5.90104D0, 4.38251D0, 3.05244D0, 2.32659D0,
54870 & 1.55551D0, 1.15047D0, 0.89759D0, 0.68521D0, 0.53495D0,
54871 & 0.42187D0, 0.33342D0, 0.26295D0, 0.20656D0, 0.16128D0,
54872 & 0.12493D0, 0.09597D0, 0.07303D0, 0.05500D0, 0.04100D0,
54873 & 0.03027D0, 0.02198D0, 0.01575D0, 0.01122D0, 0.00782D0,
54874 & 0.00536D0, 0.00363D0, 0.00239D0, 0.00098D0, 0.00036D0,
54875 & 0.00012D0, 0.00003D0, 0.00000D0, 0.00000D0/
54876 DATA (FMRS(2,3,I,27),I=1,49)/
54877 & 396.49847D0,278.69458D0,195.76036D0,159.12776D0,137.32101D0,
54878 & 122.44904D0, 85.54959D0, 59.36906D0, 47.67925D0, 40.65031D0,
54879 & 35.71157D0, 23.54779D0, 15.01388D0, 11.32784D0, 9.18018D0,
54880 & 7.74858D0, 5.93008D0, 4.38884D0, 3.04508D0, 2.31422D0,
54881 & 1.53913D0, 1.13220D0, 0.87829D0, 0.66558D0, 0.51586D0,
54882 & 0.40401D0, 0.31721D0, 0.24862D0, 0.19419D0, 0.15083D0,
54883 & 0.11625D0, 0.08889D0, 0.06736D0, 0.05053D0, 0.03753D0,
54884 & 0.02761D0, 0.01999D0, 0.01428D0, 0.01015D0, 0.00707D0,
54885 & 0.00483D0, 0.00327D0, 0.00215D0, 0.00088D0, 0.00033D0,
54886 & 0.00011D0, 0.00003D0, 0.00000D0, 0.00000D0/
54887 DATA (FMRS(2,3,I,28),I=1,49)/
54888 & 423.18488D0,295.83777D0,206.67247D0,167.46211D0,144.18538D0,
54889 & 128.34305D0, 89.17443D0, 61.53922D0, 49.25727D0, 41.89430D0,
54890 & 36.73269D0, 24.07136D0, 15.24876D0, 11.46075D0, 9.26257D0,
54891 & 7.80186D0, 5.95221D0, 4.39115D0, 3.03561D0, 2.30059D0,
54892 & 1.52239D0, 1.11417D0, 0.85969D0, 0.64709D0, 0.49822D0,
54893 & 0.38776D0, 0.30261D0, 0.23584D0, 0.18326D0, 0.14166D0,
54894 & 0.10869D0, 0.08277D0, 0.06247D0, 0.04670D0, 0.03458D0,
54895 & 0.02536D0, 0.01831D0, 0.01305D0, 0.00927D0, 0.00644D0,
54896 & 0.00439D0, 0.00297D0, 0.00195D0, 0.00080D0, 0.00030D0,
54897 & 0.00010D0, 0.00003D0, 0.00000D0, 0.00000D0/
54898 DATA (FMRS(2,3,I,29),I=1,49)/
54899 & 450.92862D0,313.54996D0,217.87523D0,175.98549D0,151.18591D0,
54900 & 134.34097D0, 92.83694D0, 63.71518D0, 50.83173D0, 43.13081D0,
54901 & 37.74429D0, 24.58404D0, 15.47489D0, 11.58672D0, 9.33925D0,
54902 & 7.85026D0, 5.97071D0, 4.39081D0, 3.02434D0, 2.28559D0,
54903 & 1.50481D0, 1.09565D0, 0.84093D0, 0.62877D0, 0.48096D0,
54904 & 0.37201D0, 0.28863D0, 0.22371D0, 0.17297D0, 0.13307D0,
54905 & 0.10166D0, 0.07711D0, 0.05798D0, 0.04320D0, 0.03189D0,
54906 & 0.02332D0, 0.01680D0, 0.01195D0, 0.00847D0, 0.00587D0,
54907 & 0.00400D0, 0.00270D0, 0.00178D0, 0.00073D0, 0.00027D0,
54908 & 0.00009D0, 0.00002D0, 0.00000D0, 0.00000D0/
54909 DATA (FMRS(2,3,I,30),I=1,49)/
54910 & 478.88074D0,331.28183D0,229.01660D0,184.42841D0,158.10007D0,
54911 & 140.25114D0, 96.41853D0, 65.82523D0, 52.35015D0, 44.31818D0,
54912 & 38.71195D0, 25.06767D0, 15.68364D0, 11.70050D0, 9.40671D0,
54913 & 7.89123D0, 5.98412D0, 4.38708D0, 3.01099D0, 2.26914D0,
54914 & 1.48646D0, 1.07684D0, 0.82225D0, 0.61085D0, 0.46437D0,
54915 & 0.35704D0, 0.27550D0, 0.21242D0, 0.16347D0, 0.12519D0,
54916 & 0.09525D0, 0.07197D0, 0.05394D0, 0.04005D0, 0.02949D0,
54917 & 0.02151D0, 0.01546D0, 0.01097D0, 0.00776D0, 0.00538D0,
54918 & 0.00366D0, 0.00247D0, 0.00162D0, 0.00067D0, 0.00025D0,
54919 & 0.00008D0, 0.00002D0, 0.00000D0, 0.00000D0/
54920 DATA (FMRS(2,3,I,31),I=1,49)/
54921 & 506.38092D0,348.62979D0,239.85460D0,192.61319D0,164.78622D0,
54922 & 145.95520D0, 99.85363D0, 67.83522D0, 53.79026D0, 45.44058D0,
54923 & 39.62410D0, 25.51892D0, 15.87554D0, 11.80362D0, 9.46678D0,
54924 & 7.92687D0, 5.99445D0, 4.38186D0, 2.99723D0, 2.25276D0,
54925 & 1.46868D0, 1.05889D0, 0.80464D0, 0.59419D0, 0.44909D0,
54926 & 0.34338D0, 0.26361D0, 0.20228D0, 0.15498D0, 0.11820D0,
54927 & 0.08960D0, 0.06746D0, 0.05040D0, 0.03731D0, 0.02741D0,
54928 & 0.01994D0, 0.01431D0, 0.01014D0, 0.00716D0, 0.00495D0,
54929 & 0.00337D0, 0.00227D0, 0.00149D0, 0.00061D0, 0.00023D0,
54930 & 0.00007D0, 0.00002D0, 0.00000D0, 0.00000D0/
54931 DATA (FMRS(2,3,I,32),I=1,49)/
54932 & 532.71063D0,365.14023D0,250.10423D0,200.32385D0,171.06720D0,
54933 & 151.30153D0,103.04897D0, 69.68893D0, 55.11074D0, 46.46502D0,
54934 & 40.45333D0, 25.92270D0, 16.04272D0, 11.89083D0, 9.51556D0,
54935 & 7.95409D0, 5.99947D0, 4.37358D0, 2.98195D0, 2.23557D0,
54936 & 1.45083D0, 1.04132D0, 0.78773D0, 0.57848D0, 0.43489D0,
54937 & 0.33086D0, 0.25280D0, 0.19316D0, 0.14738D0, 0.11200D0,
54938 & 0.08461D0, 0.06352D0, 0.04732D0, 0.03494D0, 0.02560D0,
54939 & 0.01860D0, 0.01332D0, 0.00942D0, 0.00665D0, 0.00459D0,
54940 & 0.00312D0, 0.00210D0, 0.00138D0, 0.00057D0, 0.00021D0,
54941 & 0.00007D0, 0.00002D0, 0.00000D0, 0.00000D0/
54942 DATA (FMRS(2,3,I,33),I=1,49)/
54943 & 560.44952D0,382.45715D0,260.80753D0,208.35481D0,177.59706D0,
54944 & 156.85155D0,106.35128D0, 71.59602D0, 56.46558D0, 47.51407D0,
54945 & 41.30114D0, 26.33344D0, 16.21190D0, 11.97881D0, 9.56466D0,
54946 & 7.98144D0, 6.00450D0, 4.36531D0, 2.96673D0, 2.21850D0,
54947 & 1.43317D0, 1.02401D0, 0.77116D0, 0.56317D0, 0.42112D0,
54948 & 0.31878D0, 0.24243D0, 0.18443D0, 0.14015D0, 0.10612D0,
54949 & 0.07989D0, 0.05980D0, 0.04442D0, 0.03272D0, 0.02392D0,
54950 & 0.01734D0, 0.01239D0, 0.00875D0, 0.00617D0, 0.00426D0,
54951 & 0.00289D0, 0.00195D0, 0.00128D0, 0.00052D0, 0.00020D0,
54952 & 0.00006D0, 0.00002D0, 0.00000D0, 0.00000D0/
54953 DATA (FMRS(2,3,I,34),I=1,49)/
54954 & 587.66711D0,399.34082D0,271.17145D0,216.09799D0,183.87283D0,
54955 & 162.17198D0,109.48943D0, 73.38959D0, 57.73061D0, 48.48780D0,
54956 & 42.08379D0, 26.70440D0, 16.35846D0, 12.05124D0, 9.60203D0,
54957 & 7.99942D0, 6.00308D0, 4.35260D0, 2.94870D0, 2.19937D0,
54958 & 1.41431D0, 1.00609D0, 0.75435D0, 0.54797D0, 0.40769D0,
54959 & 0.30718D0, 0.23257D0, 0.17622D0, 0.13341D0, 0.10068D0,
54960 & 0.07556D0, 0.05639D0, 0.04179D0, 0.03071D0, 0.02240D0,
54961 & 0.01621D0, 0.01157D0, 0.00816D0, 0.00575D0, 0.00396D0,
54962 & 0.00269D0, 0.00181D0, 0.00119D0, 0.00049D0, 0.00018D0,
54963 & 0.00006D0, 0.00002D0, 0.00000D0, 0.00000D0/
54964 DATA (FMRS(2,3,I,35),I=1,49)/
54965 & 614.66376D0,416.01791D0,281.36646D0,223.69629D0,190.02084D0,
54966 & 167.37685D0,112.54659D0, 75.12943D0, 58.95456D0, 49.42817D0,
54967 & 42.83852D0, 27.06040D0, 16.49837D0, 12.12015D0, 9.63748D0,
54968 & 8.01641D0, 6.00168D0, 4.34055D0, 2.93168D0, 2.18137D0,
54969 & 1.39666D0, 0.98938D0, 0.73876D0, 0.53395D0, 0.39535D0,
54970 & 0.29658D0, 0.22360D0, 0.16878D0, 0.12732D0, 0.09577D0,
54971 & 0.07167D0, 0.05334D0, 0.03944D0, 0.02892D0, 0.02106D0,
54972 & 0.01521D0, 0.01085D0, 0.00764D0, 0.00537D0, 0.00370D0,
54973 & 0.00251D0, 0.00169D0, 0.00111D0, 0.00046D0, 0.00017D0,
54974 & 0.00006D0, 0.00002D0, 0.00000D0, 0.00000D0/
54975 DATA (FMRS(2,3,I,36),I=1,49)/
54976 & 640.64490D0,431.98953D0,291.07977D0,230.91319D0,195.84616D0,
54977 & 172.29993D0,115.42027D0, 76.75350D0, 60.09168D0, 50.29848D0,
54978 & 43.53482D0, 27.38445D0, 16.62263D0, 12.17943D0, 9.66642D0,
54979 & 8.02868D0, 5.99763D0, 4.32731D0, 2.91439D0, 2.16350D0,
54980 & 1.37952D0, 0.97339D0, 0.72400D0, 0.52085D0, 0.38394D0,
54981 & 0.28684D0, 0.21543D0, 0.16204D0, 0.12184D0, 0.09139D0,
54982 & 0.06820D0, 0.05064D0, 0.03736D0, 0.02734D0, 0.01987D0,
54983 & 0.01434D0, 0.01021D0, 0.00718D0, 0.00505D0, 0.00348D0,
54984 & 0.00236D0, 0.00159D0, 0.00104D0, 0.00043D0, 0.00016D0,
54985 & 0.00005D0, 0.00001D0, 0.00000D0, 0.00000D0/
54986 DATA (FMRS(2,3,I,37),I=1,49)/
54987 & 667.19971D0,448.23413D0,300.90906D0,238.19307D0,201.70891D0,
54988 & 177.24495D0,118.28902D0, 78.36304D0, 61.21302D0, 51.15329D0,
54989 & 44.21644D0, 27.69705D0, 16.73916D0, 12.23290D0, 9.69072D0,
54990 & 8.03703D0, 5.99069D0, 4.31202D0, 2.89571D0, 2.14460D0,
54991 & 1.36178D0, 0.95706D0, 0.70912D0, 0.50779D0, 0.37268D0,
54992 & 0.27731D0, 0.20750D0, 0.15552D0, 0.11658D0, 0.08719D0,
54993 & 0.06491D0, 0.04808D0, 0.03540D0, 0.02586D0, 0.01877D0,
54994 & 0.01352D0, 0.00961D0, 0.00676D0, 0.00475D0, 0.00327D0,
54995 & 0.00222D0, 0.00149D0, 0.00098D0, 0.00040D0, 0.00015D0,
54996 & 0.00005D0, 0.00001D0, 0.00000D0, 0.00000D0/
54997 DATA (FMRS(2,3,I,38),I=1,49)/
54998 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54999 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55000 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55001 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55002 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55003 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55004 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55005 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55006 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55007 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55008 DATA (FMRS(2,4,I, 1),I=1,49)/
55009 & 0.96883D0, 0.83010D0, 0.71060D0, 0.64853D0, 0.60767D0,
55010 & 0.57770D0, 0.49346D0, 0.42161D0, 0.38501D0, 0.36146D0,
55011 & 0.34535D0, 0.30095D0, 0.26559D0, 0.24803D0, 0.23669D0,
55012 & 0.22831D0, 0.21597D0, 0.20255D0, 0.18524D0, 0.17029D0,
55013 & 0.14323D0, 0.11890D0, 0.09745D0, 0.07499D0, 0.05725D0,
55014 & 0.04365D0, 0.03351D0, 0.02602D0, 0.02043D0, 0.01653D0,
55015 & 0.01318D0, 0.01067D0, 0.00853D0, 0.00671D0, 0.00530D0,
55016 & 0.00405D0, 0.00296D0, 0.00217D0, 0.00162D0, 0.00103D0,
55017 & 0.00065D0, 0.00047D0, 0.00023D0, 0.00008D0, 0.00004D0,
55018 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
55019 DATA (FMRS(2,4,I, 2),I=1,49)/
55020 & 0.97285D0, 0.83723D0, 0.71985D0, 0.65865D0, 0.61827D0,
55021 & 0.58859D0, 0.50491D0, 0.43319D0, 0.39649D0, 0.37279D0,
55022 & 0.35657D0, 0.31149D0, 0.27487D0, 0.25626D0, 0.24402D0,
55023 & 0.23487D0, 0.22125D0, 0.20637D0, 0.18739D0, 0.17135D0,
55024 & 0.14312D0, 0.11837D0, 0.09689D0, 0.07465D0, 0.05719D0,
55025 & 0.04386D0, 0.03391D0, 0.02652D0, 0.02098D0, 0.01703D0,
55026 & 0.01365D0, 0.01107D0, 0.00885D0, 0.00698D0, 0.00550D0,
55027 & 0.00421D0, 0.00309D0, 0.00226D0, 0.00169D0, 0.00108D0,
55028 & 0.00069D0, 0.00049D0, 0.00025D0, 0.00010D0, 0.00003D0,
55029 & 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0/
55030 DATA (FMRS(2,4,I, 3),I=1,49)/
55031 & 0.99630D0, 0.86193D0, 0.74498D0, 0.68373D0, 0.64319D0,
55032 & 0.61334D0, 0.52882D0, 0.45586D0, 0.41827D0, 0.39388D0,
55033 & 0.37707D0, 0.32984D0, 0.29034D0, 0.26968D0, 0.25582D0,
55034 & 0.24531D0, 0.22956D0, 0.21234D0, 0.19077D0, 0.17310D0,
55035 & 0.14315D0, 0.11778D0, 0.09624D0, 0.07426D0, 0.05716D0,
55036 & 0.04417D0, 0.03445D0, 0.02716D0, 0.02168D0, 0.01765D0,
55037 & 0.01422D0, 0.01151D0, 0.00919D0, 0.00726D0, 0.00569D0,
55038 & 0.00437D0, 0.00323D0, 0.00233D0, 0.00177D0, 0.00113D0,
55039 & 0.00072D0, 0.00052D0, 0.00028D0, 0.00011D0, 0.00003D0,
55040 & 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0/
55041 DATA (FMRS(2,4,I, 4),I=1,49)/
55042 & 1.02892D0, 0.89240D0, 0.77327D0, 0.71073D0, 0.66929D0,
55043 & 0.63873D0, 0.55202D0, 0.47687D0, 0.43798D0, 0.41263D0,
55044 & 0.39503D0, 0.34528D0, 0.30287D0, 0.28033D0, 0.26505D0,
55045 & 0.25342D0, 0.23594D0, 0.21688D0, 0.19336D0, 0.17449D0,
55046 & 0.14328D0, 0.11746D0, 0.09586D0, 0.07403D0, 0.05716D0,
55047 & 0.04437D0, 0.03479D0, 0.02755D0, 0.02207D0, 0.01800D0,
55048 & 0.01451D0, 0.01172D0, 0.00935D0, 0.00736D0, 0.00577D0,
55049 & 0.00444D0, 0.00328D0, 0.00236D0, 0.00178D0, 0.00114D0,
55050 & 0.00075D0, 0.00052D0, 0.00029D0, 0.00011D0, 0.00004D0,
55051 & 0.00003D0, 0.00000D0, 0.00000D0, 0.00000D0/
55052 DATA (FMRS(2,4,I, 5),I=1,49)/
55053 & 1.08451D0, 0.94133D0, 0.81630D0, 0.75061D0, 0.70706D0,
55054 & 0.67493D0, 0.58367D0, 0.50437D0, 0.46318D0, 0.43623D0,
55055 & 0.41737D0, 0.36373D0, 0.31732D0, 0.29240D0, 0.27539D0,
55056 & 0.26243D0, 0.24295D0, 0.22186D0, 0.19623D0, 0.17608D0,
55057 & 0.14355D0, 0.11725D0, 0.09556D0, 0.07384D0, 0.05715D0,
55058 & 0.04453D0, 0.03504D0, 0.02784D0, 0.02236D0, 0.01824D0,
55059 & 0.01470D0, 0.01187D0, 0.00949D0, 0.00742D0, 0.00580D0,
55060 & 0.00445D0, 0.00328D0, 0.00235D0, 0.00175D0, 0.00116D0,
55061 & 0.00074D0, 0.00053D0, 0.00029D0, 0.00011D0, 0.00004D0,
55062 & 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0/
55063 DATA (FMRS(2,4,I, 6),I=1,49)/
55064 & 1.14357D0, 0.99242D0, 0.86045D0, 0.79114D0, 0.74518D0,
55065 & 0.71127D0, 0.61492D0, 0.53108D0, 0.48742D0, 0.45878D0,
55066 & 0.43857D0, 0.38094D0, 0.33056D0, 0.30333D0, 0.28470D0,
55067 & 0.27048D0, 0.24918D0, 0.22626D0, 0.19875D0, 0.17749D0,
55068 & 0.14383D0, 0.11711D0, 0.09533D0, 0.07370D0, 0.05713D0,
55069 & 0.04464D0, 0.03521D0, 0.02805D0, 0.02256D0, 0.01839D0,
55070 & 0.01482D0, 0.01197D0, 0.00955D0, 0.00745D0, 0.00580D0,
55071 & 0.00443D0, 0.00326D0, 0.00233D0, 0.00174D0, 0.00116D0,
55072 & 0.00074D0, 0.00053D0, 0.00029D0, 0.00011D0, 0.00004D0,
55073 & 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0/
55074 DATA (FMRS(2,4,I, 7),I=1,49)/
55075 & 1.21691D0, 1.05450D0, 0.91294D0, 0.83868D0, 0.78948D0,
55076 & 0.75319D0, 0.65015D0, 0.56049D0, 0.51374D0, 0.48302D0,
55077 & 0.46120D0, 0.39885D0, 0.34401D0, 0.31429D0, 0.29395D0,
55078 & 0.27845D0, 0.25529D0, 0.23055D0, 0.20123D0, 0.17890D0,
55079 & 0.14416D0, 0.11703D0, 0.09514D0, 0.07357D0, 0.05711D0,
55080 & 0.04471D0, 0.03532D0, 0.02818D0, 0.02268D0, 0.01846D0,
55081 & 0.01487D0, 0.01199D0, 0.00952D0, 0.00742D0, 0.00577D0,
55082 & 0.00441D0, 0.00322D0, 0.00229D0, 0.00172D0, 0.00114D0,
55083 & 0.00072D0, 0.00051D0, 0.00029D0, 0.00010D0, 0.00004D0,
55084 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
55085 DATA (FMRS(2,4,I, 8),I=1,49)/
55086 & 1.31000D0, 1.13230D0, 0.97784D0, 0.89699D0, 0.84348D0,
55087 & 0.80406D0, 0.69226D0, 0.59511D0, 0.54444D0, 0.51110D0,
55088 & 0.48726D0, 0.41913D0, 0.35898D0, 0.32638D0, 0.30408D0,
55089 & 0.28713D0, 0.26192D0, 0.23518D0, 0.20389D0, 0.18042D0,
55090 & 0.14454D0, 0.11697D0, 0.09497D0, 0.07342D0, 0.05705D0,
55091 & 0.04474D0, 0.03539D0, 0.02827D0, 0.02275D0, 0.01851D0,
55092 & 0.01488D0, 0.01197D0, 0.00947D0, 0.00737D0, 0.00571D0,
55093 & 0.00437D0, 0.00318D0, 0.00224D0, 0.00169D0, 0.00111D0,
55094 & 0.00070D0, 0.00049D0, 0.00029D0, 0.00010D0, 0.00004D0,
55095 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
55096 DATA (FMRS(2,4,I, 9),I=1,49)/
55097 & 1.40457D0, 1.21051D0, 1.04237D0, 0.95458D0, 0.89657D0,
55098 & 0.85387D0, 0.73299D0, 0.62815D0, 0.57350D0, 0.53752D0,
55099 & 0.51167D0, 0.43783D0, 0.37258D0, 0.33726D0, 0.31316D0,
55100 & 0.29488D0, 0.26778D0, 0.23925D0, 0.20624D0, 0.18177D0,
55101 & 0.14489D0, 0.11694D0, 0.09483D0, 0.07330D0, 0.05698D0,
55102 & 0.04474D0, 0.03543D0, 0.02831D0, 0.02277D0, 0.01852D0,
55103 & 0.01487D0, 0.01192D0, 0.00942D0, 0.00732D0, 0.00564D0,
55104 & 0.00433D0, 0.00313D0, 0.00219D0, 0.00166D0, 0.00109D0,
55105 & 0.00068D0, 0.00049D0, 0.00028D0, 0.00010D0, 0.00003D0,
55106 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
55107 DATA (FMRS(2,4,I,10),I=1,49)/
55108 & 1.51092D0, 1.29750D0, 1.11331D0, 1.01744D0, 0.95421D0,
55109 & 0.90772D0, 0.77643D0, 0.66288D0, 0.60378D0, 0.56488D0,
55110 & 0.53682D0, 0.45681D0, 0.38616D0, 0.34803D0, 0.32208D0,
55111 & 0.30246D0, 0.27350D0, 0.24321D0, 0.20851D0, 0.18308D0,
55112 & 0.14525D0, 0.11692D0, 0.09469D0, 0.07316D0, 0.05689D0,
55113 & 0.04470D0, 0.03541D0, 0.02828D0, 0.02274D0, 0.01846D0,
55114 & 0.01479D0, 0.01184D0, 0.00933D0, 0.00722D0, 0.00556D0,
55115 & 0.00426D0, 0.00307D0, 0.00215D0, 0.00161D0, 0.00106D0,
55116 & 0.00067D0, 0.00048D0, 0.00027D0, 0.00010D0, 0.00003D0,
55117 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
55118 DATA (FMRS(2,4,I,11),I=1,49)/
55119 & 1.60472D0, 1.37368D0, 1.17498D0, 1.07183D0, 1.00391D0,
55120 & 0.95405D0, 0.81348D0, 0.69224D0, 0.62923D0, 0.58777D0,
55121 & 0.55781D0, 0.47247D0, 0.39725D0, 0.35677D0, 0.32928D0,
55122 & 0.30856D0, 0.27807D0, 0.24637D0, 0.21032D0, 0.18413D0,
55123 & 0.14554D0, 0.11692D0, 0.09459D0, 0.07304D0, 0.05681D0,
55124 & 0.04465D0, 0.03537D0, 0.02823D0, 0.02270D0, 0.01839D0,
55125 & 0.01471D0, 0.01176D0, 0.00923D0, 0.00712D0, 0.00549D0,
55126 & 0.00419D0, 0.00301D0, 0.00213D0, 0.00157D0, 0.00105D0,
55127 & 0.00065D0, 0.00047D0, 0.00027D0, 0.00010D0, 0.00004D0,
55128 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
55129 DATA (FMRS(2,4,I,12),I=1,49)/
55130 & 1.83637D0, 1.55987D0, 1.32404D0, 1.20242D0, 1.12267D0,
55131 & 1.06429D0, 0.90056D0, 0.76032D0, 0.68777D0, 0.64012D0,
55132 & 0.60555D0, 0.50757D0, 0.42172D0, 0.37588D0, 0.34496D0,
55133 & 0.32177D0, 0.28792D0, 0.25312D0, 0.21417D0, 0.18636D0,
55134 & 0.14617D0, 0.11691D0, 0.09435D0, 0.07276D0, 0.05658D0,
55135 & 0.04447D0, 0.03521D0, 0.02807D0, 0.02254D0, 0.01819D0,
55136 & 0.01452D0, 0.01154D0, 0.00905D0, 0.00695D0, 0.00533D0,
55137 & 0.00404D0, 0.00292D0, 0.00205D0, 0.00149D0, 0.00100D0,
55138 & 0.00062D0, 0.00045D0, 0.00024D0, 0.00010D0, 0.00003D0,
55139 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
55140 DATA (FMRS(2,4,I,13),I=1,49)/
55141 & 2.07152D0, 1.74663D0, 1.47172D0, 1.33085D0, 1.23884D0,
55142 & 1.17167D0, 0.98420D0, 0.82476D0, 0.74268D0, 0.68890D0,
55143 & 0.64981D0, 0.53955D0, 0.44363D0, 0.39281D0, 0.35874D0,
55144 & 0.33333D0, 0.29647D0, 0.25893D0, 0.21746D0, 0.18826D0,
55145 & 0.14670D0, 0.11688D0, 0.09412D0, 0.07248D0, 0.05632D0,
55146 & 0.04424D0, 0.03500D0, 0.02787D0, 0.02234D0, 0.01798D0,
55147 & 0.01431D0, 0.01132D0, 0.00886D0, 0.00679D0, 0.00517D0,
55148 & 0.00390D0, 0.00284D0, 0.00195D0, 0.00143D0, 0.00095D0,
55149 & 0.00059D0, 0.00043D0, 0.00023D0, 0.00009D0, 0.00002D0,
55150 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
55151 DATA (FMRS(2,4,I,14),I=1,49)/
55152 & 2.37643D0, 1.98603D0, 1.65879D0, 1.49235D0, 1.38415D0,
55153 & 1.30543D0, 1.08702D0, 0.90288D0, 0.80867D0, 0.74716D0,
55154 & 0.70240D0, 0.57696D0, 0.46881D0, 0.41209D0, 0.37432D0,
55155 & 0.34632D0, 0.30599D0, 0.26535D0, 0.22106D0, 0.19032D0,
55156 & 0.14723D0, 0.11682D0, 0.09381D0, 0.07211D0, 0.05596D0,
55157 & 0.04392D0, 0.03471D0, 0.02757D0, 0.02204D0, 0.01767D0,
55158 & 0.01400D0, 0.01105D0, 0.00862D0, 0.00657D0, 0.00496D0,
55159 & 0.00374D0, 0.00270D0, 0.00182D0, 0.00137D0, 0.00090D0,
55160 & 0.00057D0, 0.00039D0, 0.00023D0, 0.00007D0, 0.00002D0,
55161 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
55162 DATA (FMRS(2,4,I,15),I=1,49)/
55163 & 2.74566D0, 2.27231D0, 1.87960D0, 1.68150D0, 1.55338D0,
55164 & 1.46052D0, 1.20454D0, 0.99082D0, 0.88227D0, 0.81170D0,
55165 & 0.76034D0, 0.61745D0, 0.49560D0, 0.43237D0, 0.39059D0,
55166 & 0.35980D0, 0.31580D0, 0.27191D0, 0.22470D0, 0.19238D0,
55167 & 0.14774D0, 0.11669D0, 0.09344D0, 0.07165D0, 0.05549D0,
55168 & 0.04347D0, 0.03429D0, 0.02720D0, 0.02166D0, 0.01729D0,
55169 & 0.01366D0, 0.01073D0, 0.00832D0, 0.00636D0, 0.00476D0,
55170 & 0.00357D0, 0.00255D0, 0.00175D0, 0.00131D0, 0.00086D0,
55171 & 0.00052D0, 0.00037D0, 0.00021D0, 0.00007D0, 0.00002D0,
55172 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
55173 DATA (FMRS(2,4,I,16),I=1,49)/
55174 & 3.12622D0, 2.56414D0, 2.10216D0, 1.87087D0, 1.72199D0,
55175 & 1.61445D0, 1.31978D0, 1.07596D0, 0.95298D0, 0.87335D0,
55176 & 0.81544D0, 0.65540D0, 0.52031D0, 0.45090D0, 0.40535D0,
55177 & 0.37197D0, 0.32458D0, 0.27772D0, 0.22787D0, 0.19414D0,
55178 & 0.14813D0, 0.11651D0, 0.09303D0, 0.07117D0, 0.05501D0,
55179 & 0.04302D0, 0.03385D0, 0.02678D0, 0.02128D0, 0.01692D0,
55180 & 0.01332D0, 0.01043D0, 0.00806D0, 0.00611D0, 0.00459D0,
55181 & 0.00341D0, 0.00242D0, 0.00166D0, 0.00123D0, 0.00082D0,
55182 & 0.00050D0, 0.00034D0, 0.00020D0, 0.00006D0, 0.00003D0,
55183 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
55184 DATA (FMRS(2,4,I,17),I=1,49)/
55185 & 3.55799D0, 2.89188D0, 2.34954D0, 2.08007D0, 1.90742D0,
55186 & 1.78316D0, 1.44470D0, 1.16721D0, 1.02825D0, 0.93863D0,
55187 & 0.87356D0, 0.69490D0, 0.54567D0, 0.46976D0, 0.42028D0,
55188 & 0.38422D0, 0.33334D0, 0.28346D0, 0.23097D0, 0.19583D0,
55189 & 0.14845D0, 0.11627D0, 0.09257D0, 0.07063D0, 0.05448D0,
55190 & 0.04252D0, 0.03337D0, 0.02631D0, 0.02087D0, 0.01652D0,
55191 & 0.01297D0, 0.01012D0, 0.00778D0, 0.00585D0, 0.00440D0,
55192 & 0.00326D0, 0.00231D0, 0.00157D0, 0.00115D0, 0.00076D0,
55193 & 0.00047D0, 0.00031D0, 0.00019D0, 0.00006D0, 0.00003D0,
55194 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
55195 DATA (FMRS(2,4,I,18),I=1,49)/
55196 & 3.95423D0, 3.18985D0, 2.57232D0, 2.26740D0, 2.07281D0,
55197 & 1.93314D0, 1.55464D0, 1.24668D0, 1.09337D0, 0.99486D0,
55198 & 0.92342D0, 0.72838D0, 0.56689D0, 0.48541D0, 0.43260D0,
55199 & 0.39429D0, 0.34049D0, 0.28810D0, 0.23344D0, 0.19715D0,
55200 & 0.14866D0, 0.11602D0, 0.09214D0, 0.07013D0, 0.05399D0,
55201 & 0.04205D0, 0.03295D0, 0.02591D0, 0.02050D0, 0.01618D0,
55202 & 0.01266D0, 0.00984D0, 0.00753D0, 0.00565D0, 0.00424D0,
55203 & 0.00314D0, 0.00221D0, 0.00150D0, 0.00109D0, 0.00072D0,
55204 & 0.00043D0, 0.00030D0, 0.00018D0, 0.00006D0, 0.00002D0,
55205 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
55206 DATA (FMRS(2,4,I,19),I=1,49)/
55207 & 4.48113D0, 3.58253D0, 2.86323D0, 2.51070D0, 2.28676D0,
55208 & 2.12659D0, 1.69508D0, 1.34718D0, 1.17523D0, 1.06522D0,
55209 & 0.98559D0, 0.76963D0, 0.59272D0, 0.50431D0, 0.44739D0,
55210 & 0.40630D0, 0.34895D0, 0.29355D0, 0.23628D0, 0.19863D0,
55211 & 0.14882D0, 0.11566D0, 0.09156D0, 0.06947D0, 0.05334D0,
55212 & 0.04144D0, 0.03238D0, 0.02540D0, 0.02000D0, 0.01574D0,
55213 & 0.01227D0, 0.00950D0, 0.00724D0, 0.00541D0, 0.00404D0,
55214 & 0.00298D0, 0.00211D0, 0.00142D0, 0.00103D0, 0.00067D0,
55215 & 0.00041D0, 0.00028D0, 0.00016D0, 0.00006D0, 0.00002D0,
55216 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
55217 DATA (FMRS(2,4,I,20),I=1,49)/
55218 & 4.99499D0, 3.96212D0, 3.14196D0, 2.74258D0, 2.48991D0,
55219 & 2.30973D0, 1.82681D0, 1.44056D0, 1.25085D0, 1.12995D0,
55220 & 1.04258D0, 0.80704D0, 0.61586D0, 0.52113D0, 0.46048D0,
55221 & 0.41689D0, 0.35636D0, 0.29827D0, 0.23871D0, 0.19986D0,
55222 & 0.14892D0, 0.11531D0, 0.09101D0, 0.06887D0, 0.05276D0,
55223 & 0.04087D0, 0.03186D0, 0.02494D0, 0.01954D0, 0.01534D0,
55224 & 0.01192D0, 0.00921D0, 0.00699D0, 0.00520D0, 0.00387D0,
55225 & 0.00284D0, 0.00201D0, 0.00135D0, 0.00099D0, 0.00063D0,
55226 & 0.00039D0, 0.00027D0, 0.00014D0, 0.00005D0, 0.00002D0,
55227 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55228 DATA (FMRS(2,4,I,21),I=1,49)/
55229 & 5.50061D0, 4.33261D0, 3.41176D0, 2.96594D0, 2.68491D0,
55230 & 2.48503D0, 1.95181D0, 1.52837D0, 1.32157D0, 1.19023D0,
55231 & 1.09549D0, 0.84140D0, 0.63686D0, 0.53627D0, 0.47219D0,
55232 & 0.42632D0, 0.36291D0, 0.30239D0, 0.24078D0, 0.20086D0,
55233 & 0.14892D0, 0.11489D0, 0.09045D0, 0.06826D0, 0.05215D0,
55234 & 0.04031D0, 0.03135D0, 0.02446D0, 0.01914D0, 0.01497D0,
55235 & 0.01162D0, 0.00892D0, 0.00678D0, 0.00502D0, 0.00373D0,
55236 & 0.00273D0, 0.00191D0, 0.00128D0, 0.00093D0, 0.00060D0,
55237 & 0.00037D0, 0.00026D0, 0.00014D0, 0.00005D0, 0.00001D0,
55238 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
55239 DATA (FMRS(2,4,I,22),I=1,49)/
55240 & 6.19859D0, 4.83989D0, 3.77815D0, 3.26780D0, 2.94753D0,
55241 & 2.72049D0, 2.11828D0, 1.64429D0, 1.41443D0, 1.26909D0,
55242 & 1.16448D0, 0.88574D0, 0.66367D0, 0.55547D0, 0.48697D0,
55243 & 0.43816D0, 0.37106D0, 0.30748D0, 0.24329D0, 0.20204D0,
55244 & 0.14885D0, 0.11433D0, 0.08969D0, 0.06745D0, 0.05136D0,
55245 & 0.03959D0, 0.03069D0, 0.02386D0, 0.01861D0, 0.01451D0,
55246 & 0.01121D0, 0.00856D0, 0.00649D0, 0.00480D0, 0.00355D0,
55247 & 0.00258D0, 0.00180D0, 0.00120D0, 0.00087D0, 0.00057D0,
55248 & 0.00034D0, 0.00024D0, 0.00013D0, 0.00004D0, 0.00001D0,
55249 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55250 DATA (FMRS(2,4,I,23),I=1,49)/
55251 & 6.91462D0, 5.35579D0, 4.14753D0, 3.57056D0, 3.20996D0,
55252 & 2.95511D0, 2.28266D0, 1.75769D0, 1.50477D0, 1.34548D0,
55253 & 1.23109D0, 0.92809D0, 0.68898D0, 0.57345D0, 0.50073D0,
55254 & 0.44914D0, 0.37855D0, 0.31211D0, 0.24552D0, 0.20305D0,
55255 & 0.14871D0, 0.11376D0, 0.08894D0, 0.06666D0, 0.05060D0,
55256 & 0.03890D0, 0.03007D0, 0.02332D0, 0.01811D0, 0.01408D0,
55257 & 0.01081D0, 0.00824D0, 0.00620D0, 0.00458D0, 0.00337D0,
55258 & 0.00246D0, 0.00171D0, 0.00112D0, 0.00082D0, 0.00053D0,
55259 & 0.00032D0, 0.00022D0, 0.00013D0, 0.00004D0, 0.00001D0,
55260 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55261 DATA (FMRS(2,4,I,24),I=1,49)/
55262 & 7.62855D0, 5.86601D0, 4.50985D0, 3.86607D0, 3.46522D0,
55263 & 3.18268D0, 2.44073D0, 1.86575D0, 1.59038D0, 1.41758D0,
55264 & 1.29375D0, 0.96750D0, 0.71223D0, 0.58984D0, 0.51319D0,
55265 & 0.45902D0, 0.38523D0, 0.31616D0, 0.24739D0, 0.20383D0,
55266 & 0.14846D0, 0.11312D0, 0.08817D0, 0.06586D0, 0.04986D0,
55267 & 0.03821D0, 0.02946D0, 0.02275D0, 0.01763D0, 0.01365D0,
55268 & 0.01046D0, 0.00797D0, 0.00597D0, 0.00439D0, 0.00323D0,
55269 & 0.00235D0, 0.00162D0, 0.00107D0, 0.00078D0, 0.00051D0,
55270 & 0.00031D0, 0.00021D0, 0.00012D0, 0.00003D0, 0.00001D0,
55271 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55272 DATA (FMRS(2,4,I,25),I=1,49)/
55273 & 8.39955D0, 6.41302D0, 4.89545D0, 4.17923D0, 3.73489D0,
55274 & 3.42253D0, 2.60607D0, 1.97793D0, 1.67884D0, 1.49183D0,
55275 & 1.35810D0, 1.00761D0, 0.73567D0, 0.60627D0, 0.52562D0,
55276 & 0.46884D0, 0.39183D0, 0.32012D0, 0.24919D0, 0.20455D0,
55277 & 0.14818D0, 0.11246D0, 0.08739D0, 0.06506D0, 0.04911D0,
55278 & 0.03752D0, 0.02885D0, 0.02220D0, 0.01716D0, 0.01324D0,
55279 & 0.01012D0, 0.00771D0, 0.00575D0, 0.00422D0, 0.00309D0,
55280 & 0.00225D0, 0.00154D0, 0.00103D0, 0.00074D0, 0.00048D0,
55281 & 0.00030D0, 0.00020D0, 0.00010D0, 0.00002D0, 0.00001D0,
55282 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55283 DATA (FMRS(2,4,I,26),I=1,49)/
55284 & 9.19737D0, 6.97494D0, 5.28863D0, 4.49714D0, 4.00779D0,
55285 & 3.66466D0, 2.77170D0, 2.08938D0, 1.76629D0, 1.56497D0,
55286 & 1.42130D0, 1.04661D0, 0.75821D0, 0.62194D0, 0.53740D0,
55287 & 0.47810D0, 0.39797D0, 0.32376D0, 0.25078D0, 0.20510D0,
55288 & 0.14782D0, 0.11174D0, 0.08657D0, 0.06424D0, 0.04835D0,
55289 & 0.03684D0, 0.02824D0, 0.02168D0, 0.01670D0, 0.01284D0,
55290 & 0.00977D0, 0.00742D0, 0.00552D0, 0.00404D0, 0.00296D0,
55291 & 0.00214D0, 0.00146D0, 0.00097D0, 0.00071D0, 0.00044D0,
55292 & 0.00028D0, 0.00017D0, 0.00010D0, 0.00003D0, 0.00001D0,
55293 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55294 DATA (FMRS(2,4,I,27),I=1,49)/
55295 & 10.00116D0, 7.53729D0, 5.67949D0, 4.81192D0, 4.27724D0,
55296 & 3.90320D0, 2.93374D0, 2.19765D0, 1.85088D0, 1.63549D0,
55297 & 1.48207D0, 1.08380D0, 0.77950D0, 0.63664D0, 0.54841D0,
55298 & 0.48671D0, 0.40364D0, 0.32707D0, 0.25218D0, 0.20556D0,
55299 & 0.14742D0, 0.11104D0, 0.08576D0, 0.06344D0, 0.04762D0,
55300 & 0.03619D0, 0.02766D0, 0.02119D0, 0.01627D0, 0.01248D0,
55301 & 0.00947D0, 0.00716D0, 0.00532D0, 0.00389D0, 0.00284D0,
55302 & 0.00205D0, 0.00139D0, 0.00092D0, 0.00068D0, 0.00042D0,
55303 & 0.00026D0, 0.00016D0, 0.00009D0, 0.00003D0, 0.00001D0,
55304 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55305 DATA (FMRS(2,4,I,28),I=1,49)/
55306 & 10.79744D0, 8.09092D0, 6.06186D0, 5.11871D0, 4.53915D0,
55307 & 4.13458D0, 3.08987D0, 2.30126D0, 1.93148D0, 1.70248D0,
55308 & 1.53966D0, 1.11875D0, 0.79931D0, 0.65024D0, 0.55853D0,
55309 & 0.49459D0, 0.40879D0, 0.33003D0, 0.25337D0, 0.20589D0,
55310 & 0.14698D0, 0.11033D0, 0.08498D0, 0.06267D0, 0.04691D0,
55311 & 0.03557D0, 0.02711D0, 0.02071D0, 0.01586D0, 0.01214D0,
55312 & 0.00920D0, 0.00692D0, 0.00514D0, 0.00376D0, 0.00272D0,
55313 & 0.00196D0, 0.00133D0, 0.00087D0, 0.00064D0, 0.00040D0,
55314 & 0.00025D0, 0.00016D0, 0.00009D0, 0.00003D0, 0.00001D0,
55315 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55316 DATA (FMRS(2,4,I,29),I=1,49)/
55317 & 11.63983D0, 8.67317D0, 6.46161D0, 5.43834D0, 4.81133D0,
55318 & 4.37457D0, 3.25082D0, 2.40738D0, 2.01373D0, 1.77063D0,
55319 & 1.59811D0, 1.15395D0, 0.81909D0, 0.66374D0, 0.56853D0,
55320 & 0.50235D0, 0.41381D0, 0.33288D0, 0.25448D0, 0.20616D0,
55321 & 0.14650D0, 0.10959D0, 0.08417D0, 0.06189D0, 0.04620D0,
55322 & 0.03495D0, 0.02656D0, 0.02024D0, 0.01545D0, 0.01181D0,
55323 & 0.00893D0, 0.00670D0, 0.00496D0, 0.00362D0, 0.00261D0,
55324 & 0.00187D0, 0.00127D0, 0.00083D0, 0.00060D0, 0.00038D0,
55325 & 0.00023D0, 0.00015D0, 0.00008D0, 0.00003D0, 0.00001D0,
55326 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55327 DATA (FMRS(2,4,I,30),I=1,49)/
55328 & 12.50504D0, 9.26774D0, 6.86743D0, 5.76168D0, 5.08599D0,
55329 & 4.61626D0, 3.41191D0, 2.51292D0, 2.09519D0, 1.83795D0,
55330 & 1.65570D0, 1.18836D0, 0.83825D0, 0.67674D0, 0.57810D0,
55331 & 0.50972D0, 0.41855D0, 0.33552D0, 0.25546D0, 0.20633D0,
55332 & 0.14597D0, 0.10882D0, 0.08334D0, 0.06111D0, 0.04550D0,
55333 & 0.03432D0, 0.02602D0, 0.01977D0, 0.01507D0, 0.01148D0,
55334 & 0.00865D0, 0.00649D0, 0.00478D0, 0.00347D0, 0.00250D0,
55335 & 0.00177D0, 0.00121D0, 0.00078D0, 0.00056D0, 0.00036D0,
55336 & 0.00022D0, 0.00014D0, 0.00008D0, 0.00002D0, 0.00001D0,
55337 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55338 DATA (FMRS(2,4,I,31),I=1,49)/
55339 & 13.36928D0, 9.85846D0, 7.26844D0, 6.08018D0, 5.35592D0,
55340 & 4.85338D0, 3.56907D0, 2.61529D0, 2.17393D0, 1.90285D0,
55341 & 1.71111D0, 1.22123D0, 0.85642D0, 0.68899D0, 0.58709D0,
55342 & 0.51663D0, 0.42295D0, 0.33794D0, 0.25632D0, 0.20644D0,
55343 & 0.14544D0, 0.10808D0, 0.08256D0, 0.06036D0, 0.04483D0,
55344 & 0.03373D0, 0.02551D0, 0.01933D0, 0.01470D0, 0.01117D0,
55345 & 0.00840D0, 0.00629D0, 0.00462D0, 0.00334D0, 0.00240D0,
55346 & 0.00170D0, 0.00116D0, 0.00075D0, 0.00053D0, 0.00034D0,
55347 & 0.00021D0, 0.00014D0, 0.00007D0, 0.00002D0, 0.00001D0,
55348 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55349 DATA (FMRS(2,4,I,32),I=1,49)/
55350 & 14.21204D0, 10.43149D0, 7.65538D0, 6.38652D0, 5.61495D0,
55351 & 5.08051D0, 3.71876D0, 2.71221D0, 2.24821D0, 1.96390D0,
55352 & 1.76311D0, 1.25185D0, 0.87317D0, 0.70020D0, 0.59526D0,
55353 & 0.52288D0, 0.42687D0, 0.34005D0, 0.25702D0, 0.20645D0,
55354 & 0.14487D0, 0.10733D0, 0.08179D0, 0.05963D0, 0.04417D0,
55355 & 0.03317D0, 0.02503D0, 0.01893D0, 0.01436D0, 0.01089D0,
55356 & 0.00816D0, 0.00610D0, 0.00447D0, 0.00322D0, 0.00232D0,
55357 & 0.00164D0, 0.00111D0, 0.00072D0, 0.00051D0, 0.00033D0,
55358 & 0.00020D0, 0.00013D0, 0.00007D0, 0.00002D0, 0.00001D0,
55359 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55360 DATA (FMRS(2,4,I,33),I=1,49)/
55361 & 15.10980D0, 11.03912D0, 8.06381D0, 6.70901D0, 5.88712D0,
55362 & 5.31881D0, 3.87508D0, 2.81294D0, 2.32519D0, 2.02704D0,
55363 & 1.81681D0, 1.28330D0, 0.89029D0, 0.71163D0, 0.60357D0,
55364 & 0.52922D0, 0.43085D0, 0.34218D0, 0.25771D0, 0.20646D0,
55365 & 0.14430D0, 0.10659D0, 0.08103D0, 0.05890D0, 0.04353D0,
55366 & 0.03261D0, 0.02455D0, 0.01854D0, 0.01403D0, 0.01061D0,
55367 & 0.00794D0, 0.00591D0, 0.00432D0, 0.00310D0, 0.00224D0,
55368 & 0.00159D0, 0.00107D0, 0.00069D0, 0.00049D0, 0.00032D0,
55369 & 0.00019D0, 0.00012D0, 0.00006D0, 0.00002D0, 0.00001D0,
55370 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55371 DATA (FMRS(2,4,I,34),I=1,49)/
55372 & 16.00814D0, 11.64399D0, 8.46821D0, 7.02730D0, 6.15513D0,
55373 & 5.55303D0, 4.02783D0, 2.91076D0, 2.39965D0, 2.08793D0,
55374 & 1.86846D0, 1.31328D0, 0.90643D0, 0.72231D0, 0.61128D0,
55375 & 0.53505D0, 0.43443D0, 0.34403D0, 0.25822D0, 0.20634D0,
55376 & 0.14366D0, 0.10580D0, 0.08022D0, 0.05817D0, 0.04288D0,
55377 & 0.03206D0, 0.02408D0, 0.01814D0, 0.01369D0, 0.01034D0,
55378 & 0.00771D0, 0.00572D0, 0.00418D0, 0.00300D0, 0.00216D0,
55379 & 0.00152D0, 0.00103D0, 0.00065D0, 0.00048D0, 0.00031D0,
55380 & 0.00018D0, 0.00012D0, 0.00006D0, 0.00002D0, 0.00001D0,
55381 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55382 DATA (FMRS(2,4,I,35),I=1,49)/
55383 & 16.90871D0, 12.24779D0, 8.87019D0, 7.34290D0, 6.42039D0,
55384 & 5.78454D0, 4.17816D0, 3.00661D0, 2.47242D0, 2.14733D0,
55385 & 1.91876D0, 1.34235D0, 0.92199D0, 0.73258D0, 0.61867D0,
55386 & 0.54063D0, 0.43786D0, 0.34580D0, 0.25870D0, 0.20622D0,
55387 & 0.14305D0, 0.10506D0, 0.07947D0, 0.05749D0, 0.04228D0,
55388 & 0.03154D0, 0.02364D0, 0.01777D0, 0.01338D0, 0.01009D0,
55389 & 0.00750D0, 0.00555D0, 0.00406D0, 0.00290D0, 0.00208D0,
55390 & 0.00145D0, 0.00100D0, 0.00062D0, 0.00047D0, 0.00030D0,
55391 & 0.00017D0, 0.00012D0, 0.00005D0, 0.00002D0, 0.00000D0,
55392 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55393 DATA (FMRS(2,4,I,36),I=1,49)/
55394 & 17.78739D0, 12.83436D0, 9.25897D0, 7.64732D0, 6.67578D0,
55395 & 6.00710D0, 4.32199D0, 3.09786D0, 2.54148D0, 2.20357D0,
55396 & 1.96631D0, 1.36964D0, 0.93649D0, 0.74208D0, 0.62547D0,
55397 & 0.54573D0, 0.44096D0, 0.34736D0, 0.25907D0, 0.20605D0,
55398 & 0.14244D0, 0.10433D0, 0.07874D0, 0.05683D0, 0.04170D0,
55399 & 0.03105D0, 0.02321D0, 0.01741D0, 0.01309D0, 0.00985D0,
55400 & 0.00731D0, 0.00540D0, 0.00394D0, 0.00282D0, 0.00201D0,
55401 & 0.00140D0, 0.00096D0, 0.00060D0, 0.00045D0, 0.00029D0,
55402 & 0.00016D0, 0.00012D0, 0.00005D0, 0.00001D0, 0.00000D0,
55403 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55404 DATA (FMRS(2,4,I,37),I=1,49)/
55405 & 18.69798D0, 13.43965D0, 9.65843D0, 7.95932D0, 6.93703D0,
55406 & 6.23444D0, 4.46823D0, 3.19019D0, 2.61115D0, 2.26017D0,
55407 & 2.01407D0, 1.39688D0, 0.95084D0, 0.75143D0, 0.63213D0,
55408 & 0.55070D0, 0.44393D0, 0.34881D0, 0.25937D0, 0.20581D0,
55409 & 0.14178D0, 0.10356D0, 0.07799D0, 0.05614D0, 0.04110D0,
55410 & 0.03053D0, 0.02278D0, 0.01705D0, 0.01280D0, 0.00961D0,
55411 & 0.00713D0, 0.00525D0, 0.00382D0, 0.00273D0, 0.00195D0,
55412 & 0.00136D0, 0.00092D0, 0.00058D0, 0.00043D0, 0.00028D0,
55413 & 0.00015D0, 0.00011D0, 0.00005D0, 0.00001D0, 0.00000D0,
55414 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55415 DATA (FMRS(2,4,I,38),I=1,49)/
55416 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55417 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55418 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55419 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55420 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55421 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55422 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55423 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55424 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55425 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55426 DATA (FMRS(2,5,I, 1),I=1,49)/
55427 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55428 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55429 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55430 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55431 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55432 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55433 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55434 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55435 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55436 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55437 DATA (FMRS(2,5,I, 2),I=1,49)/
55438 & 0.00003D0, 0.00002D0, 0.00002D0, 0.00002D0, 0.00002D0,
55439 & 0.00002D0, 0.00002D0, 0.00002D0, 0.00002D0, 0.00002D0,
55440 & 0.00002D0, 0.00002D0, 0.00002D0, 0.00002D0, 0.00002D0,
55441 & 0.00002D0, 0.00002D0, 0.00001D0, 0.00001D0, 0.00001D0,
55442 & 0.00001D0, 0.00001D0, 0.00001D0, 0.00001D0, 0.00001D0,
55443 & 0.00001D0, 0.00001D0, 0.00001D0, 0.00001D0, 0.00001D0,
55444 & 0.00001D0, 0.00001D0, 0.00001D0, 0.00001D0, 0.00001D0,
55445 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55446 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55447 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55448 DATA (FMRS(2,5,I, 3),I=1,49)/
55449 & 0.02821D0, 0.02609D0, 0.02411D0, 0.02301D0, 0.02226D0,
55450 & 0.02169D0, 0.01996D0, 0.01827D0, 0.01727D0, 0.01654D0,
55451 & 0.01595D0, 0.01400D0, 0.01174D0, 0.01027D0, 0.00917D0,
55452 & 0.00829D0, 0.00696D0, 0.00558D0, 0.00415D0, 0.00329D0,
55453 & 0.00239D0, 0.00200D0, 0.00182D0, 0.00170D0, 0.00161D0,
55454 & 0.00151D0, 0.00140D0, 0.00127D0, 0.00113D0, 0.00099D0,
55455 & 0.00084D0, 0.00071D0, 0.00058D0, 0.00047D0, 0.00038D0,
55456 & 0.00029D0, 0.00023D0, 0.00017D0, 0.00013D0, 0.00009D0,
55457 & 0.00006D0, 0.00004D0, 0.00003D0, 0.00001D0, 0.00000D0,
55458 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55459 DATA (FMRS(2,5,I, 4),I=1,49)/
55460 & 0.07423D0, 0.06794D0, 0.06215D0, 0.05896D0, 0.05679D0,
55461 & 0.05514D0, 0.05023D0, 0.04550D0, 0.04276D0, 0.04079D0,
55462 & 0.03919D0, 0.03404D0, 0.02827D0, 0.02460D0, 0.02188D0,
55463 & 0.01974D0, 0.01650D0, 0.01320D0, 0.00980D0, 0.00778D0,
55464 & 0.00567D0, 0.00475D0, 0.00430D0, 0.00399D0, 0.00376D0,
55465 & 0.00351D0, 0.00322D0, 0.00290D0, 0.00256D0, 0.00223D0,
55466 & 0.00189D0, 0.00158D0, 0.00129D0, 0.00104D0, 0.00083D0,
55467 & 0.00064D0, 0.00049D0, 0.00037D0, 0.00027D0, 0.00020D0,
55468 & 0.00014D0, 0.00009D0, 0.00006D0, 0.00002D0, 0.00000D0,
55469 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55470 DATA (FMRS(2,5,I, 5),I=1,49)/
55471 & 0.13335D0, 0.12014D0, 0.10818D0, 0.10170D0, 0.09731D0,
55472 & 0.09401D0, 0.08430D0, 0.07519D0, 0.07001D0, 0.06635D0,
55473 & 0.06344D0, 0.05426D0, 0.04442D0, 0.03837D0, 0.03396D0,
55474 & 0.03053D0, 0.02541D0, 0.02025D0, 0.01501D0, 0.01192D0,
55475 & 0.00870D0, 0.00726D0, 0.00654D0, 0.00602D0, 0.00561D0,
55476 & 0.00519D0, 0.00472D0, 0.00422D0, 0.00370D0, 0.00319D0,
55477 & 0.00269D0, 0.00224D0, 0.00183D0, 0.00146D0, 0.00116D0,
55478 & 0.00089D0, 0.00068D0, 0.00051D0, 0.00038D0, 0.00027D0,
55479 & 0.00019D0, 0.00013D0, 0.00008D0, 0.00003D0, 0.00000D0,
55480 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55481 DATA (FMRS(2,5,I, 6),I=1,49)/
55482 & 0.20163D0, 0.17920D0, 0.15918D0, 0.14846D0, 0.14125D0,
55483 & 0.13587D0, 0.12018D0, 0.10574D0, 0.09768D0, 0.09205D0,
55484 & 0.08763D0, 0.07395D0, 0.05979D0, 0.05130D0, 0.04521D0,
55485 & 0.04052D0, 0.03360D0, 0.02669D0, 0.01976D0, 0.01569D0,
55486 & 0.01145D0, 0.00954D0, 0.00855D0, 0.00780D0, 0.00720D0,
55487 & 0.00661D0, 0.00597D0, 0.00530D0, 0.00461D0, 0.00396D0,
55488 & 0.00333D0, 0.00275D0, 0.00223D0, 0.00178D0, 0.00140D0,
55489 & 0.00108D0, 0.00082D0, 0.00061D0, 0.00045D0, 0.00032D0,
55490 & 0.00022D0, 0.00015D0, 0.00010D0, 0.00003D0, 0.00000D0,
55491 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55492 DATA (FMRS(2,5,I, 7),I=1,49)/
55493 & 0.27774D0, 0.24395D0, 0.21415D0, 0.19835D0, 0.18780D0,
55494 & 0.17996D0, 0.15730D0, 0.13677D0, 0.12547D0, 0.11766D0,
55495 & 0.11157D0, 0.09303D0, 0.07437D0, 0.06341D0, 0.05566D0,
55496 & 0.04974D0, 0.04109D0, 0.03255D0, 0.02405D0, 0.01909D0,
55497 & 0.01394D0, 0.01158D0, 0.01033D0, 0.00936D0, 0.00857D0,
55498 & 0.00780D0, 0.00699D0, 0.00616D0, 0.00533D0, 0.00455D0,
55499 & 0.00380D0, 0.00313D0, 0.00253D0, 0.00201D0, 0.00157D0,
55500 & 0.00121D0, 0.00091D0, 0.00068D0, 0.00050D0, 0.00036D0,
55501 & 0.00024D0, 0.00016D0, 0.00011D0, 0.00003D0, 0.00000D0,
55502 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55503 DATA (FMRS(2,5,I, 8),I=1,49)/
55504 & 0.37644D0, 0.32674D0, 0.28346D0, 0.26073D0, 0.24565D0,
55505 & 0.23449D0, 0.20256D0, 0.17404D0, 0.15854D0, 0.14793D0,
55506 & 0.13972D0, 0.11511D0, 0.09095D0, 0.07707D0, 0.06738D0,
55507 & 0.06004D0, 0.04941D0, 0.03901D0, 0.02877D0, 0.02283D0,
55508 & 0.01667D0, 0.01381D0, 0.01226D0, 0.01101D0, 0.01000D0,
55509 & 0.00902D0, 0.00803D0, 0.00703D0, 0.00604D0, 0.00513D0,
55510 & 0.00426D0, 0.00349D0, 0.00280D0, 0.00222D0, 0.00173D0,
55511 & 0.00132D0, 0.00099D0, 0.00074D0, 0.00054D0, 0.00039D0,
55512 & 0.00026D0, 0.00017D0, 0.00011D0, 0.00003D0, 0.00000D0,
55513 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55514 DATA (FMRS(2,5,I, 9),I=1,49)/
55515 & 0.47784D0, 0.41072D0, 0.35284D0, 0.32270D0, 0.30279D0,
55516 & 0.28813D0, 0.24646D0, 0.20968D0, 0.18991D0, 0.17647D0,
55517 & 0.16612D0, 0.13548D0, 0.10603D0, 0.08938D0, 0.07787D0,
55518 & 0.06921D0, 0.05678D0, 0.04472D0, 0.03292D0, 0.02612D0,
55519 & 0.01906D0, 0.01575D0, 0.01392D0, 0.01241D0, 0.01119D0,
55520 & 0.01003D0, 0.00887D0, 0.00772D0, 0.00660D0, 0.00557D0,
55521 & 0.00461D0, 0.00376D0, 0.00301D0, 0.00237D0, 0.00184D0,
55522 & 0.00140D0, 0.00105D0, 0.00077D0, 0.00057D0, 0.00041D0,
55523 & 0.00027D0, 0.00018D0, 0.00011D0, 0.00003D0, 0.00000D0,
55524 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55525 DATA (FMRS(2,5,I,10),I=1,49)/
55526 & 0.58781D0, 0.50078D0, 0.42641D0, 0.38796D0, 0.36269D0,
55527 & 0.34414D0, 0.29176D0, 0.24601D0, 0.22164D0, 0.20518D0,
55528 & 0.19257D0, 0.15561D0, 0.12070D0, 0.10126D0, 0.08794D0,
55529 & 0.07799D0, 0.06379D0, 0.05011D0, 0.03684D0, 0.02922D0,
55530 & 0.02130D0, 0.01755D0, 0.01544D0, 0.01368D0, 0.01225D0,
55531 & 0.01090D0, 0.00959D0, 0.00830D0, 0.00706D0, 0.00594D0,
55532 & 0.00489D0, 0.00397D0, 0.00316D0, 0.00248D0, 0.00192D0,
55533 & 0.00146D0, 0.00109D0, 0.00080D0, 0.00059D0, 0.00042D0,
55534 & 0.00027D0, 0.00018D0, 0.00012D0, 0.00003D0, 0.00000D0,
55535 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55536 DATA (FMRS(2,5,I,11),I=1,49)/
55537 & 0.68602D0, 0.58051D0, 0.49095D0, 0.44491D0, 0.41476D0,
55538 & 0.39269D0, 0.33066D0, 0.27690D0, 0.24847D0, 0.22936D0,
55539 & 0.21477D0, 0.17232D0, 0.13275D0, 0.11095D0, 0.09613D0,
55540 & 0.08510D0, 0.06944D0, 0.05445D0, 0.03997D0, 0.03169D0,
55541 & 0.02308D0, 0.01898D0, 0.01663D0, 0.01466D0, 0.01306D0,
55542 & 0.01157D0, 0.01013D0, 0.00872D0, 0.00740D0, 0.00620D0,
55543 & 0.00508D0, 0.00411D0, 0.00327D0, 0.00256D0, 0.00197D0,
55544 & 0.00149D0, 0.00111D0, 0.00081D0, 0.00060D0, 0.00042D0,
55545 & 0.00028D0, 0.00018D0, 0.00012D0, 0.00003D0, 0.00000D0,
55546 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55547 DATA (FMRS(2,5,I,12),I=1,49)/
55548 & 0.92772D0, 0.77438D0, 0.64603D0, 0.58078D0, 0.53835D0,
55549 & 0.50746D0, 0.42147D0, 0.34811D0, 0.30983D0, 0.28433D0,
55550 & 0.26501D0, 0.20960D0, 0.15924D0, 0.13208D0, 0.11385D0,
55551 & 0.10043D0, 0.08155D0, 0.06370D0, 0.04663D0, 0.03692D0,
55552 & 0.02683D0, 0.02195D0, 0.01909D0, 0.01665D0, 0.01467D0,
55553 & 0.01287D0, 0.01115D0, 0.00952D0, 0.00801D0, 0.00666D0,
55554 & 0.00542D0, 0.00436D0, 0.00344D0, 0.00268D0, 0.00205D0,
55555 & 0.00155D0, 0.00115D0, 0.00083D0, 0.00061D0, 0.00043D0,
55556 & 0.00028D0, 0.00018D0, 0.00011D0, 0.00003D0, 0.00000D0,
55557 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55558 DATA (FMRS(2,5,I,13),I=1,49)/
55559 & 1.17595D0, 0.97076D0, 0.80093D0, 0.71538D0, 0.66007D0,
55560 & 0.61997D0, 0.50921D0, 0.41588D0, 0.36771D0, 0.33586D0,
55561 & 0.31184D0, 0.24377D0, 0.18310D0, 0.15092D0, 0.12956D0,
55562 & 0.11394D0, 0.09216D0, 0.07174D0, 0.05238D0, 0.04143D0,
55563 & 0.03003D0, 0.02446D0, 0.02114D0, 0.01827D0, 0.01595D0,
55564 & 0.01387D0, 0.01193D0, 0.01011D0, 0.00845D0, 0.00698D0,
55565 & 0.00565D0, 0.00451D0, 0.00355D0, 0.00275D0, 0.00209D0,
55566 & 0.00157D0, 0.00116D0, 0.00084D0, 0.00061D0, 0.00043D0,
55567 & 0.00028D0, 0.00018D0, 0.00011D0, 0.00003D0, 0.00000D0,
55568 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55569 DATA (FMRS(2,5,I,14),I=1,49)/
55570 & 1.49839D0, 1.22261D0, 0.99703D0, 0.88447D0, 0.81213D0,
55571 & 0.75993D0, 0.61688D0, 0.49791D0, 0.43718D0, 0.39731D0,
55572 & 0.36742D0, 0.28369D0, 0.21052D0, 0.17237D0, 0.14732D0,
55573 & 0.12915D0, 0.10402D0, 0.08067D0, 0.05873D0, 0.04638D0,
55574 & 0.03352D0, 0.02715D0, 0.02331D0, 0.01995D0, 0.01725D0,
55575 & 0.01486D0, 0.01267D0, 0.01065D0, 0.00884D0, 0.00725D0,
55576 & 0.00583D0, 0.00463D0, 0.00362D0, 0.00279D0, 0.00211D0,
55577 & 0.00158D0, 0.00116D0, 0.00083D0, 0.00061D0, 0.00043D0,
55578 & 0.00027D0, 0.00018D0, 0.00011D0, 0.00003D0, 0.00000D0,
55579 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55580 DATA (FMRS(2,5,I,15),I=1,49)/
55581 & 1.87945D0, 1.51634D0, 1.22268D0, 1.07750D0, 0.98475D0,
55582 & 0.91809D0, 0.73686D0, 0.58798D0, 0.51279D0, 0.46377D0,
55583 & 0.42722D0, 0.32591D0, 0.23902D0, 0.19443D0, 0.16545D0,
55584 & 0.14459D0, 0.11596D0, 0.08960D0, 0.06503D0, 0.05127D0,
55585 & 0.03691D0, 0.02973D0, 0.02534D0, 0.02147D0, 0.01838D0,
55586 & 0.01569D0, 0.01327D0, 0.01107D0, 0.00912D0, 0.00743D0,
55587 & 0.00594D0, 0.00469D0, 0.00364D0, 0.00279D0, 0.00210D0,
55588 & 0.00156D0, 0.00114D0, 0.00082D0, 0.00059D0, 0.00041D0,
55589 & 0.00026D0, 0.00017D0, 0.00010D0, 0.00003D0, 0.00000D0,
55590 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55591 DATA (FMRS(2,5,I,16),I=1,49)/
55592 & 2.27429D0, 1.81716D0, 1.45106D0, 1.27151D0, 1.15736D0,
55593 & 1.07564D0, 0.85491D0, 0.67549D0, 0.58568D0, 0.52749D0,
55594 & 0.48429D0, 0.36563D0, 0.26542D0, 0.21469D0, 0.18200D0,
55595 & 0.15862D0, 0.12673D0, 0.09760D0, 0.07063D0, 0.05559D0,
55596 & 0.03988D0, 0.03195D0, 0.02705D0, 0.02273D0, 0.01930D0,
55597 & 0.01634D0, 0.01371D0, 0.01136D0, 0.00930D0, 0.00753D0,
55598 & 0.00599D0, 0.00470D0, 0.00364D0, 0.00277D0, 0.00208D0,
55599 & 0.00154D0, 0.00112D0, 0.00080D0, 0.00058D0, 0.00040D0,
55600 & 0.00025D0, 0.00016D0, 0.00010D0, 0.00003D0, 0.00000D0,
55601 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55602 DATA (FMRS(2,5,I,17),I=1,49)/
55603 & 2.72539D0, 2.15724D0, 1.70653D0, 1.48715D0, 1.34837D0,
55604 & 1.24937D0, 0.98364D0, 0.76983D0, 0.66373D0, 0.59537D0,
55605 & 0.54484D0, 0.40724D0, 0.29272D0, 0.23547D0, 0.19888D0,
55606 & 0.17287D0, 0.13761D0, 0.10564D0, 0.07622D0, 0.05987D0,
55607 & 0.04278D0, 0.03409D0, 0.02869D0, 0.02390D0, 0.02012D0,
55608 & 0.01691D0, 0.01408D0, 0.01159D0, 0.00943D0, 0.00759D0,
55609 & 0.00600D0, 0.00469D0, 0.00361D0, 0.00273D0, 0.00204D0,
55610 & 0.00151D0, 0.00109D0, 0.00078D0, 0.00056D0, 0.00039D0,
55611 & 0.00024D0, 0.00015D0, 0.00009D0, 0.00003D0, 0.00000D0,
55612 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55613 DATA (FMRS(2,5,I,18),I=1,49)/
55614 & 3.13641D0, 2.46418D0, 1.93488D0, 1.67881D0, 1.51744D0,
55615 & 1.40264D0, 1.09608D0, 0.85138D0, 0.73076D0, 0.65340D0,
55616 & 0.59642D0, 0.44225D0, 0.31539D0, 0.25259D0, 0.21272D0,
55617 & 0.18450D0, 0.14644D0, 0.11211D0, 0.08069D0, 0.06328D0,
55618 & 0.04506D0, 0.03575D0, 0.02993D0, 0.02476D0, 0.02070D0,
55619 & 0.01729D0, 0.01432D0, 0.01172D0, 0.00949D0, 0.00760D0,
55620 & 0.00598D0, 0.00466D0, 0.00357D0, 0.00269D0, 0.00201D0,
55621 & 0.00147D0, 0.00106D0, 0.00075D0, 0.00054D0, 0.00038D0,
55622 & 0.00023D0, 0.00015D0, 0.00009D0, 0.00003D0, 0.00000D0,
55623 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55624 DATA (FMRS(2,5,I,19),I=1,49)/
55625 & 3.68153D0, 2.86757D0, 2.23222D0, 1.92702D0, 1.73553D0,
55626 & 1.59976D0, 1.23927D0, 0.95419D0, 0.81477D0, 0.72581D0,
55627 & 0.66053D0, 0.48527D0, 0.34292D0, 0.27324D0, 0.22931D0,
55628 & 0.19839D0, 0.15691D0, 0.11975D0, 0.08593D0, 0.06725D0,
55629 & 0.04768D0, 0.03762D0, 0.03130D0, 0.02569D0, 0.02130D0,
55630 & 0.01766D0, 0.01453D0, 0.01182D0, 0.00951D0, 0.00757D0,
55631 & 0.00594D0, 0.00459D0, 0.00350D0, 0.00264D0, 0.00195D0,
55632 & 0.00143D0, 0.00103D0, 0.00072D0, 0.00052D0, 0.00036D0,
55633 & 0.00022D0, 0.00014D0, 0.00008D0, 0.00003D0, 0.00000D0,
55634 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55635 DATA (FMRS(2,5,I,20),I=1,49)/
55636 & 4.21665D0, 3.26014D0, 2.51906D0, 2.16522D0, 1.94405D0,
55637 & 1.78768D0, 1.37455D0, 1.05042D0, 0.89295D0, 0.79293D0,
55638 & 0.71977D0, 0.52460D0, 0.36780D0, 0.29178D0, 0.24415D0,
55639 & 0.21076D0, 0.16620D0, 0.12648D0, 0.09052D0, 0.07070D0,
55640 & 0.04993D0, 0.03920D0, 0.03244D0, 0.02644D0, 0.02178D0,
55641 & 0.01794D0, 0.01467D0, 0.01187D0, 0.00951D0, 0.00753D0,
55642 & 0.00588D0, 0.00453D0, 0.00344D0, 0.00258D0, 0.00191D0,
55643 & 0.00139D0, 0.00099D0, 0.00070D0, 0.00050D0, 0.00035D0,
55644 & 0.00021D0, 0.00013D0, 0.00008D0, 0.00003D0, 0.00000D0,
55645 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55646 DATA (FMRS(2,5,I,21),I=1,49)/
55647 & 4.73651D0, 3.63839D0, 2.79314D0, 2.39169D0, 2.14159D0,
55648 & 1.96521D0, 1.50121D0, 1.13968D0, 0.96506D0, 0.85456D0,
55649 & 0.77398D0, 0.56020D0, 0.39006D0, 0.30823D0, 0.25724D0,
55650 & 0.22164D0, 0.17431D0, 0.13232D0, 0.09445D0, 0.07364D0,
55651 & 0.05181D0, 0.04050D0, 0.03335D0, 0.02701D0, 0.02212D0,
55652 & 0.01812D0, 0.01474D0, 0.01187D0, 0.00946D0, 0.00747D0,
55653 & 0.00580D0, 0.00446D0, 0.00337D0, 0.00252D0, 0.00185D0,
55654 & 0.00135D0, 0.00096D0, 0.00068D0, 0.00049D0, 0.00034D0,
55655 & 0.00020D0, 0.00013D0, 0.00007D0, 0.00003D0, 0.00000D0,
55656 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55657 DATA (FMRS(2,5,I,22),I=1,49)/
55658 & 5.45753D0, 4.15887D0, 3.16726D0, 2.69936D0, 2.40907D0,
55659 & 2.20495D0, 1.67083D0, 1.25820D0, 1.06032D0, 0.93568D0,
55660 & 0.84511D0, 0.60646D0, 0.41869D0, 0.32928D0, 0.27391D0,
55661 & 0.23544D0, 0.18455D0, 0.13964D0, 0.09936D0, 0.07728D0,
55662 & 0.05411D0, 0.04206D0, 0.03442D0, 0.02766D0, 0.02248D0,
55663 & 0.01829D0, 0.01478D0, 0.01184D0, 0.00938D0, 0.00736D0,
55664 & 0.00570D0, 0.00435D0, 0.00328D0, 0.00244D0, 0.00179D0,
55665 & 0.00129D0, 0.00092D0, 0.00065D0, 0.00046D0, 0.00032D0,
55666 & 0.00019D0, 0.00012D0, 0.00007D0, 0.00003D0, 0.00000D0,
55667 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55668 DATA (FMRS(2,5,I,23),I=1,49)/
55669 & 6.19783D0, 4.68879D0, 3.54494D0, 3.00840D0, 2.67675D0,
55670 & 2.44420D0, 1.83862D0, 1.37436D0, 1.15316D0, 1.01443D0,
55671 & 0.91394D0, 0.65074D0, 0.44579D0, 0.34906D0, 0.28951D0,
55672 & 0.24830D0, 0.19403D0, 0.14639D0, 0.10384D0, 0.08058D0,
55673 & 0.05616D0, 0.04343D0, 0.03534D0, 0.02820D0, 0.02276D0,
55674 & 0.01841D0, 0.01478D0, 0.01177D0, 0.00929D0, 0.00725D0,
55675 & 0.00558D0, 0.00425D0, 0.00319D0, 0.00236D0, 0.00173D0,
55676 & 0.00124D0, 0.00088D0, 0.00062D0, 0.00044D0, 0.00031D0,
55677 & 0.00018D0, 0.00011D0, 0.00007D0, 0.00003D0, 0.00000D0,
55678 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55679 DATA (FMRS(2,5,I,24),I=1,49)/
55680 & 6.92966D0, 5.20839D0, 3.91218D0, 3.30740D0, 2.93482D0,
55681 & 2.67420D0, 1.99847D0, 1.48399D0, 1.24028D0, 1.08801D0,
55682 & 0.97803D0, 0.69152D0, 0.47043D0, 0.36691D0, 0.30350D0,
55683 & 0.25978D0, 0.20243D0, 0.15231D0, 0.10773D0, 0.08341D0,
55684 & 0.05788D0, 0.04454D0, 0.03605D0, 0.02858D0, 0.02293D0,
55685 & 0.01844D0, 0.01473D0, 0.01167D0, 0.00917D0, 0.00713D0,
55686 & 0.00547D0, 0.00415D0, 0.00310D0, 0.00229D0, 0.00167D0,
55687 & 0.00120D0, 0.00085D0, 0.00059D0, 0.00043D0, 0.00030D0,
55688 & 0.00017D0, 0.00011D0, 0.00006D0, 0.00003D0, 0.00000D0,
55689 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55690 DATA (FMRS(2,5,I,25),I=1,49)/
55691 & 7.72396D0, 5.76848D0, 4.30532D0, 3.62618D0, 3.20915D0,
55692 & 2.91815D0, 2.16681D0, 1.59861D0, 1.33097D0, 1.16435D0,
55693 & 1.04435D0, 0.73337D0, 0.49551D0, 0.38498D0, 0.31761D0,
55694 & 0.27133D0, 0.21084D0, 0.15821D0, 0.11158D0, 0.08620D0,
55695 & 0.05955D0, 0.04560D0, 0.03673D0, 0.02893D0, 0.02307D0,
55696 & 0.01845D0, 0.01466D0, 0.01156D0, 0.00904D0, 0.00700D0,
55697 & 0.00535D0, 0.00404D0, 0.00301D0, 0.00221D0, 0.00161D0,
55698 & 0.00115D0, 0.00081D0, 0.00057D0, 0.00041D0, 0.00028D0,
55699 & 0.00017D0, 0.00010D0, 0.00006D0, 0.00003D0, 0.00000D0,
55700 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55701 DATA (FMRS(2,5,I,26),I=1,49)/
55702 & 8.54145D0, 6.34073D0, 4.70401D0, 3.94803D0, 3.48525D0,
55703 & 3.16305D0, 2.33446D0, 1.71181D0, 1.42007D0, 1.23908D0,
55704 & 1.10907D0, 0.77380D0, 0.51947D0, 0.40212D0, 0.33092D0,
55705 & 0.28218D0, 0.21869D0, 0.16367D0, 0.11510D0, 0.08871D0,
55706 & 0.06103D0, 0.04651D0, 0.03727D0, 0.02918D0, 0.02314D0,
55707 & 0.01840D0, 0.01456D0, 0.01142D0, 0.00889D0, 0.00686D0,
55708 & 0.00522D0, 0.00393D0, 0.00292D0, 0.00214D0, 0.00155D0,
55709 & 0.00111D0, 0.00078D0, 0.00054D0, 0.00039D0, 0.00027D0,
55710 & 0.00016D0, 0.00009D0, 0.00005D0, 0.00003D0, 0.00000D0,
55711 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55712 DATA (FMRS(2,5,I,27),I=1,49)/
55713 & 9.36625D0, 6.91445D0, 5.10115D0, 4.26741D0, 3.75848D0,
55714 & 3.40490D0, 2.49891D0, 1.82207D0, 1.50649D0, 1.31134D0,
55715 & 1.17150D0, 0.81249D0, 0.54219D0, 0.41829D0, 0.34343D0,
55716 & 0.29234D0, 0.22601D0, 0.16873D0, 0.11834D0, 0.09101D0,
55717 & 0.06235D0, 0.04731D0, 0.03774D0, 0.02938D0, 0.02318D0,
55718 & 0.01834D0, 0.01444D0, 0.01128D0, 0.00875D0, 0.00672D0,
55719 & 0.00510D0, 0.00383D0, 0.00283D0, 0.00207D0, 0.00150D0,
55720 & 0.00107D0, 0.00075D0, 0.00052D0, 0.00038D0, 0.00026D0,
55721 & 0.00015D0, 0.00009D0, 0.00005D0, 0.00003D0, 0.00000D0,
55722 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55723 DATA (FMRS(2,5,I,28),I=1,49)/
55724 & 10.18132D0, 7.47793D0, 5.48877D0, 4.57798D0, 4.02345D0,
55725 & 3.63894D0, 2.65699D0, 1.92733D0, 1.58864D0, 1.37981D0,
55726 & 1.23051D0, 0.84875D0, 0.56329D0, 0.43322D0, 0.35493D0,
55727 & 0.30165D0, 0.23267D0, 0.17330D0, 0.12123D0, 0.09305D0,
55728 & 0.06349D0, 0.04798D0, 0.03811D0, 0.02952D0, 0.02317D0,
55729 & 0.01825D0, 0.01431D0, 0.01114D0, 0.00861D0, 0.00659D0,
55730 & 0.00498D0, 0.00373D0, 0.00275D0, 0.00201D0, 0.00145D0,
55731 & 0.00103D0, 0.00072D0, 0.00050D0, 0.00036D0, 0.00026D0,
55732 & 0.00014D0, 0.00008D0, 0.00005D0, 0.00003D0, 0.00000D0,
55733 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55734 DATA (FMRS(2,5,I,29),I=1,49)/
55735 & 11.04388D0, 8.07089D0, 5.89435D0, 4.90182D0, 4.29909D0,
55736 & 3.88193D0, 2.82014D0, 2.03528D0, 1.67258D0, 1.44958D0,
55737 & 1.29048D0, 0.88533D0, 0.58442D0, 0.44808D0, 0.36634D0,
55738 & 0.31085D0, 0.23922D0, 0.17778D0, 0.12404D0, 0.09501D0,
55739 & 0.06457D0, 0.04859D0, 0.03843D0, 0.02962D0, 0.02314D0,
55740 & 0.01814D0, 0.01416D0, 0.01098D0, 0.00846D0, 0.00645D0,
55741 & 0.00486D0, 0.00363D0, 0.00267D0, 0.00194D0, 0.00140D0,
55742 & 0.00099D0, 0.00069D0, 0.00048D0, 0.00035D0, 0.00025D0,
55743 & 0.00014D0, 0.00008D0, 0.00005D0, 0.00003D0, 0.00000D0,
55744 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55745 DATA (FMRS(2,5,I,30),I=1,49)/
55746 & 11.92777D0, 8.67505D0, 6.30518D0, 5.22873D0, 4.57663D0,
55747 & 4.12613D0, 2.98306D0, 2.14237D0, 1.75551D0, 1.51831D0,
55748 & 1.34943D0, 0.92100D0, 0.60483D0, 0.46237D0, 0.37725D0,
55749 & 0.31962D0, 0.24543D0, 0.18198D0, 0.12665D0, 0.09681D0,
55750 & 0.06554D0, 0.04912D0, 0.03869D0, 0.02967D0, 0.02307D0,
55751 & 0.01801D0, 0.01401D0, 0.01082D0, 0.00830D0, 0.00632D0,
55752 & 0.00475D0, 0.00353D0, 0.00259D0, 0.00188D0, 0.00135D0,
55753 & 0.00095D0, 0.00066D0, 0.00047D0, 0.00034D0, 0.00024D0,
55754 & 0.00014D0, 0.00008D0, 0.00004D0, 0.00002D0, 0.00000D0,
55755 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55756 DATA (FMRS(2,5,I,31),I=1,49)/
55757 & 12.81161D0, 9.27611D0, 6.71181D0, 5.55130D0, 4.84990D0,
55758 & 4.36615D0, 3.14234D0, 2.24650D0, 1.83587D0, 1.58474D0,
55759 & 1.40629D0, 0.95519D0, 0.62425D0, 0.47590D0, 0.38756D0,
55760 & 0.32788D0, 0.25125D0, 0.18591D0, 0.12907D0, 0.09846D0,
55761 & 0.06642D0, 0.04959D0, 0.03891D0, 0.02970D0, 0.02299D0,
55762 & 0.01788D0, 0.01385D0, 0.01067D0, 0.00816D0, 0.00619D0,
55763 & 0.00464D0, 0.00344D0, 0.00252D0, 0.00182D0, 0.00130D0,
55764 & 0.00092D0, 0.00064D0, 0.00045D0, 0.00033D0, 0.00023D0,
55765 & 0.00013D0, 0.00007D0, 0.00004D0, 0.00002D0, 0.00000D0,
55766 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55767 DATA (FMRS(2,5,I,32),I=1,49)/
55768 & 13.67059D0, 9.85720D0, 7.10279D0, 5.86046D0, 5.11119D0,
55769 & 4.59523D0, 3.29346D0, 2.34466D0, 1.91134D0, 1.64694D0,
55770 & 1.45941D0, 0.98687D0, 0.64209D0, 0.48825D0, 0.39691D0,
55771 & 0.33535D0, 0.25648D0, 0.18940D0, 0.13119D0, 0.09990D0,
55772 & 0.06714D0, 0.04995D0, 0.03906D0, 0.02968D0, 0.02289D0,
55773 & 0.01773D0, 0.01369D0, 0.01051D0, 0.00801D0, 0.00606D0,
55774 & 0.00453D0, 0.00335D0, 0.00245D0, 0.00177D0, 0.00126D0,
55775 & 0.00089D0, 0.00062D0, 0.00043D0, 0.00032D0, 0.00023D0,
55776 & 0.00013D0, 0.00007D0, 0.00004D0, 0.00002D0, 0.00000D0,
55777 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55778 DATA (FMRS(2,5,I,33),I=1,49)/
55779 & 14.58850D0, 10.47558D0, 7.51716D0, 6.18731D0, 5.38695D0,
55780 & 4.83668D0, 3.45207D0, 2.44727D0, 1.99002D0, 1.71168D0,
55781 & 1.51462D0, 1.01965D0, 0.66046D0, 0.50094D0, 0.40651D0,
55782 & 0.34300D0, 0.26182D0, 0.19296D0, 0.13335D0, 0.10136D0,
55783 & 0.06788D0, 0.05032D0, 0.03921D0, 0.02967D0, 0.02278D0,
55784 & 0.01759D0, 0.01353D0, 0.01035D0, 0.00787D0, 0.00594D0,
55785 & 0.00443D0, 0.00327D0, 0.00238D0, 0.00172D0, 0.00122D0,
55786 & 0.00086D0, 0.00060D0, 0.00042D0, 0.00031D0, 0.00022D0,
55787 & 0.00013D0, 0.00007D0, 0.00004D0, 0.00002D0, 0.00000D0,
55788 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55789 DATA (FMRS(2,5,I,34),I=1,49)/
55790 & 15.50215D0, 11.08776D0, 7.92505D0, 6.50796D0, 5.65681D0,
55791 & 5.07248D0, 3.60600D0, 2.54615D0, 2.06552D0, 1.77359D0,
55792 & 1.56726D0, 1.05062D0, 0.67763D0, 0.51270D0, 0.41535D0,
55793 & 0.35001D0, 0.26666D0, 0.19615D0, 0.13524D0, 0.10260D0,
55794 & 0.06847D0, 0.05058D0, 0.03928D0, 0.02960D0, 0.02264D0,
55795 & 0.01742D0, 0.01336D0, 0.01019D0, 0.00772D0, 0.00581D0,
55796 & 0.00432D0, 0.00318D0, 0.00232D0, 0.00166D0, 0.00118D0,
55797 & 0.00083D0, 0.00058D0, 0.00041D0, 0.00030D0, 0.00022D0,
55798 & 0.00013D0, 0.00007D0, 0.00004D0, 0.00002D0, 0.00000D0,
55799 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55800 DATA (FMRS(2,5,I,35),I=1,49)/
55801 & 16.42021D0, 11.70052D0, 8.33176D0, 6.82695D0, 5.92484D0,
55802 & 5.30641D0, 3.75809D0, 2.64348D0, 2.13966D0, 1.83429D0,
55803 & 1.61881D0, 1.08081D0, 0.69429D0, 0.52409D0, 0.42389D0,
55804 & 0.35678D0, 0.27133D0, 0.19921D0, 0.13706D0, 0.10380D0,
55805 & 0.06904D0, 0.05083D0, 0.03934D0, 0.02953D0, 0.02251D0,
55806 & 0.01726D0, 0.01320D0, 0.01004D0, 0.00759D0, 0.00569D0,
55807 & 0.00422D0, 0.00310D0, 0.00225D0, 0.00162D0, 0.00115D0,
55808 & 0.00080D0, 0.00056D0, 0.00039D0, 0.00029D0, 0.00021D0,
55809 & 0.00013D0, 0.00007D0, 0.00004D0, 0.00002D0, 0.00000D0,
55810 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55811 DATA (FMRS(2,5,I,36),I=1,49)/
55812 & 17.31499D0, 12.29519D0, 8.72473D0, 7.13436D0, 6.18265D0,
55813 & 5.53107D0, 3.90347D0, 2.73604D0, 2.20994D0, 1.89170D0,
55814 & 1.66747D0, 1.10914D0, 0.70980D0, 0.53464D0, 0.43178D0,
55815 & 0.36300D0, 0.27560D0, 0.20200D0, 0.13869D0, 0.10485D0,
55816 & 0.06952D0, 0.05103D0, 0.03937D0, 0.02945D0, 0.02237D0,
55817 & 0.01710D0, 0.01303D0, 0.00989D0, 0.00746D0, 0.00558D0,
55818 & 0.00413D0, 0.00303D0, 0.00220D0, 0.00157D0, 0.00111D0,
55819 & 0.00078D0, 0.00054D0, 0.00038D0, 0.00028D0, 0.00021D0,
55820 & 0.00013D0, 0.00007D0, 0.00004D0, 0.00002D0, 0.00000D0,
55821 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55822 DATA (FMRS(2,5,I,37),I=1,49)/
55823 & 18.24071D0, 12.90782D0, 9.12782D0, 7.44886D0, 6.44591D0,
55824 & 5.76014D0, 4.05101D0, 2.82949D0, 2.28068D0, 1.94934D0,
55825 & 1.71624D0, 1.13734D0, 0.72513D0, 0.54501D0, 0.43949D0,
55826 & 0.36907D0, 0.27974D0, 0.20467D0, 0.14023D0, 0.10583D0,
55827 & 0.06996D0, 0.05118D0, 0.03937D0, 0.02934D0, 0.02221D0,
55828 & 0.01693D0, 0.01286D0, 0.00973D0, 0.00732D0, 0.00547D0,
55829 & 0.00404D0, 0.00296D0, 0.00214D0, 0.00153D0, 0.00108D0,
55830 & 0.00076D0, 0.00052D0, 0.00037D0, 0.00027D0, 0.00020D0,
55831 & 0.00013D0, 0.00007D0, 0.00004D0, 0.00002D0, 0.00000D0,
55832 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55833 DATA (FMRS(2,5,I,38),I=1,49)/
55834 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55835 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55836 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55837 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55838 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55839 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55840 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55841 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55842 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55843 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55844 DATA (FMRS(2,6,I, 1),I=1,49)/
55845 & 0.49855D0, 0.42587D0, 0.36389D0, 0.33197D0, 0.31109D0,
55846 & 0.29584D0, 0.25332D0, 0.21750D0, 0.19938D0, 0.18774D0,
55847 & 0.17961D0, 0.15726D0, 0.13904D0, 0.12982D0, 0.12379D0,
55848 & 0.11933D0, 0.11282D0, 0.10593D0, 0.09760D0, 0.09090D0,
55849 & 0.07946D0, 0.06933D0, 0.06013D0, 0.04980D0, 0.04078D0,
55850 & 0.03302D0, 0.02641D0, 0.02091D0, 0.01639D0, 0.01253D0,
55851 & 0.00964D0, 0.00728D0, 0.00545D0, 0.00406D0, 0.00291D0,
55852 & 0.00211D0, 0.00151D0, 0.00106D0, 0.00067D0, 0.00051D0,
55853 & 0.00036D0, 0.00020D0, 0.00015D0, 0.00005D0, 0.00001D0,
55854 & -0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
55855 DATA (FMRS(2,6,I, 2),I=1,49)/
55856 & 0.50643D0, 0.43610D0, 0.37562D0, 0.34428D0, 0.32368D0,
55857 & 0.30859D0, 0.26628D0, 0.23029D0, 0.21194D0, 0.20007D0,
55858 & 0.19176D0, 0.16857D0, 0.14897D0, 0.13868D0, 0.13176D0,
55859 & 0.12655D0, 0.11883D0, 0.11060D0, 0.10078D0, 0.09314D0,
55860 & 0.08065D0, 0.07007D0, 0.06069D0, 0.05033D0, 0.04135D0,
55861 & 0.03363D0, 0.02706D0, 0.02157D0, 0.01702D0, 0.01315D0,
55862 & 0.01020D0, 0.00777D0, 0.00589D0, 0.00442D0, 0.00323D0,
55863 & 0.00236D0, 0.00171D0, 0.00122D0, 0.00079D0, 0.00059D0,
55864 & 0.00042D0, 0.00024D0, 0.00018D0, 0.00006D0, 0.00002D0,
55865 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55866 DATA (FMRS(2,6,I, 3),I=1,49)/
55867 & 0.53555D0, 0.46535D0, 0.40441D0, 0.37256D0, 0.35153D0,
55868 & 0.33606D0, 0.29238D0, 0.25475D0, 0.23531D0, 0.22262D0,
55869 & 0.21361D0, 0.18804D0, 0.16542D0, 0.15305D0, 0.14451D0,
55870 & 0.13799D0, 0.12824D0, 0.11785D0, 0.10571D0, 0.09664D0,
55871 & 0.08259D0, 0.07132D0, 0.06165D0, 0.05118D0, 0.04219D0,
55872 & 0.03449D0, 0.02794D0, 0.02243D0, 0.01784D0, 0.01392D0,
55873 & 0.01089D0, 0.00837D0, 0.00641D0, 0.00486D0, 0.00360D0,
55874 & 0.00265D0, 0.00193D0, 0.00138D0, 0.00092D0, 0.00067D0,
55875 & 0.00048D0, 0.00029D0, 0.00022D0, 0.00008D0, 0.00002D0,
55876 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55877 DATA (FMRS(2,6,I, 4),I=1,49)/
55878 & 0.57226D0, 0.49911D0, 0.43533D0, 0.40188D0, 0.37974D0,
55879 & 0.36342D0, 0.31717D0, 0.27704D0, 0.25615D0, 0.24242D0,
55880 & 0.23256D0, 0.20428D0, 0.17865D0, 0.16439D0, 0.15446D0,
55881 & 0.14683D0, 0.13543D0, 0.12334D0, 0.10944D0, 0.09929D0,
55882 & 0.08411D0, 0.07232D0, 0.06240D0, 0.05181D0, 0.04280D0,
55883 & 0.03507D0, 0.02851D0, 0.02298D0, 0.01835D0, 0.01437D0,
55884 & 0.01128D0, 0.00872D0, 0.00670D0, 0.00509D0, 0.00378D0,
55885 & 0.00278D0, 0.00204D0, 0.00149D0, 0.00099D0, 0.00072D0,
55886 & 0.00050D0, 0.00032D0, 0.00023D0, 0.00009D0, 0.00003D0,
55887 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55888 DATA (FMRS(2,6,I, 5),I=1,49)/
55889 & 0.63213D0, 0.55147D0, 0.48109D0, 0.44417D0, 0.41970D0,
55890 & 0.40166D0, 0.35046D0, 0.30587D0, 0.28254D0, 0.26712D0,
55891 & 0.25592D0, 0.22358D0, 0.19384D0, 0.17718D0, 0.16554D0,
55892 & 0.15661D0, 0.14330D0, 0.12931D0, 0.11348D0, 0.10220D0,
55893 & 0.08579D0, 0.07344D0, 0.06325D0, 0.05250D0, 0.04341D0,
55894 & 0.03561D0, 0.02901D0, 0.02344D0, 0.01875D0, 0.01473D0,
55895 & 0.01158D0, 0.00897D0, 0.00690D0, 0.00525D0, 0.00392D0,
55896 & 0.00287D0, 0.00212D0, 0.00153D0, 0.00104D0, 0.00075D0,
55897 & 0.00052D0, 0.00033D0, 0.00023D0, 0.00009D0, 0.00002D0,
55898 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55899 DATA (FMRS(2,6,I, 6),I=1,49)/
55900 & 0.69484D0, 0.60548D0, 0.52759D0, 0.48675D0, 0.45969D0,
55901 & 0.43974D0, 0.38311D0, 0.33372D0, 0.30779D0, 0.29059D0,
55902 & 0.27800D0, 0.24152D0, 0.20772D0, 0.18874D0, 0.17549D0,
55903 & 0.16535D0, 0.15028D0, 0.13457D0, 0.11704D0, 0.10475D0,
55904 & 0.08728D0, 0.07444D0, 0.06400D0, 0.05308D0, 0.04390D0,
55905 & 0.03605D0, 0.02939D0, 0.02378D0, 0.01903D0, 0.01499D0,
55906 & 0.01179D0, 0.00914D0, 0.00703D0, 0.00535D0, 0.00400D0,
55907 & 0.00293D0, 0.00217D0, 0.00156D0, 0.00107D0, 0.00077D0,
55908 & 0.00053D0, 0.00034D0, 0.00024D0, 0.00009D0, 0.00002D0,
55909 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55910 DATA (FMRS(2,6,I, 7),I=1,49)/
55911 & 0.77164D0, 0.67034D0, 0.58230D0, 0.53624D0, 0.50577D0,
55912 & 0.48332D0, 0.41966D0, 0.36421D0, 0.33508D0, 0.31572D0,
55913 & 0.30145D0, 0.26012D0, 0.22178D0, 0.20031D0, 0.18536D0,
55914 & 0.17396D0, 0.15711D0, 0.13969D0, 0.12049D0, 0.10724D0,
55915 & 0.08874D0, 0.07542D0, 0.06472D0, 0.05362D0, 0.04433D0,
55916 & 0.03642D0, 0.02969D0, 0.02403D0, 0.01923D0, 0.01516D0,
55917 & 0.01193D0, 0.00926D0, 0.00710D0, 0.00541D0, 0.00405D0,
55918 & 0.00297D0, 0.00219D0, 0.00158D0, 0.00108D0, 0.00077D0,
55919 & 0.00052D0, 0.00033D0, 0.00024D0, 0.00008D0, 0.00002D0,
55920 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55921 DATA (FMRS(2,6,I, 8),I=1,49)/
55922 & 0.86838D0, 0.75105D0, 0.64953D0, 0.59658D0, 0.56163D0,
55923 & 0.53592D0, 0.46317D0, 0.39995D0, 0.36678D0, 0.34473D0,
55924 & 0.32838D0, 0.28112D0, 0.23740D0, 0.21303D0, 0.19616D0,
55925 & 0.18334D0, 0.16450D0, 0.14520D0, 0.12419D0, 0.10991D0,
55926 & 0.09031D0, 0.07647D0, 0.06547D0, 0.05416D0, 0.04475D0,
55927 & 0.03674D0, 0.02994D0, 0.02423D0, 0.01939D0, 0.01529D0,
55928 & 0.01202D0, 0.00932D0, 0.00715D0, 0.00545D0, 0.00407D0,
55929 & 0.00298D0, 0.00220D0, 0.00159D0, 0.00108D0, 0.00077D0,
55930 & 0.00052D0, 0.00033D0, 0.00024D0, 0.00008D0, 0.00002D0,
55931 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55932 DATA (FMRS(2,6,I, 9),I=1,49)/
55933 & 0.96608D0, 0.83177D0, 0.71606D0, 0.65593D0, 0.61632D0,
55934 & 0.58722D0, 0.50510D0, 0.43397D0, 0.39671D0, 0.37195D0,
55935 & 0.35355D0, 0.30046D0, 0.25156D0, 0.22448D0, 0.20581D0,
55936 & 0.19169D0, 0.17103D0, 0.15004D0, 0.12743D0, 0.11224D0,
55937 & 0.09169D0, 0.07737D0, 0.06612D0, 0.05461D0, 0.04508D0,
55938 & 0.03697D0, 0.03013D0, 0.02435D0, 0.01949D0, 0.01536D0,
55939 & 0.01207D0, 0.00933D0, 0.00718D0, 0.00545D0, 0.00407D0,
55940 & 0.00298D0, 0.00219D0, 0.00159D0, 0.00106D0, 0.00076D0,
55941 & 0.00052D0, 0.00033D0, 0.00024D0, 0.00009D0, 0.00002D0,
55942 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55943 DATA (FMRS(2,6,I,10),I=1,49)/
55944 & 1.07543D0, 0.92116D0, 0.78892D0, 0.72047D0, 0.67548D0,
55945 & 0.64249D0, 0.54968D0, 0.46963D0, 0.42782D0, 0.40008D0,
55946 & 0.37941D0, 0.32003D0, 0.26568D0, 0.23578D0, 0.21528D0,
55947 & 0.19985D0, 0.17739D0, 0.15473D0, 0.13057D0, 0.11449D0,
55948 & 0.09302D0, 0.07823D0, 0.06672D0, 0.05501D0, 0.04535D0,
55949 & 0.03715D0, 0.03025D0, 0.02442D0, 0.01953D0, 0.01538D0,
55950 & 0.01207D0, 0.00932D0, 0.00717D0, 0.00543D0, 0.00405D0,
55951 & 0.00296D0, 0.00217D0, 0.00158D0, 0.00105D0, 0.00075D0,
55952 & 0.00051D0, 0.00033D0, 0.00023D0, 0.00008D0, 0.00002D0,
55953 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55954 DATA (FMRS(2,6,I,11),I=1,49)/
55955 & 1.17158D0, 0.99923D0, 0.85209D0, 0.77617D0, 0.72639D0,
55956 & 0.68993D0, 0.58762D0, 0.49971D0, 0.45391D0, 0.42357D0,
55957 & 0.40096D0, 0.33616D0, 0.27719D0, 0.24495D0, 0.22293D0,
55958 & 0.20642D0, 0.18248D0, 0.15848D0, 0.13306D0, 0.11628D0,
55959 & 0.09406D0, 0.07891D0, 0.06718D0, 0.05531D0, 0.04555D0,
55960 & 0.03727D0, 0.03032D0, 0.02446D0, 0.01953D0, 0.01537D0,
55961 & 0.01205D0, 0.00930D0, 0.00714D0, 0.00540D0, 0.00402D0,
55962 & 0.00294D0, 0.00214D0, 0.00155D0, 0.00104D0, 0.00074D0,
55963 & 0.00050D0, 0.00032D0, 0.00022D0, 0.00008D0, 0.00002D0,
55964 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55965 DATA (FMRS(2,6,I,12),I=1,49)/
55966 & 1.40820D0, 1.18938D0, 1.00430D0, 0.90953D0, 0.84767D0,
55967 & 0.80252D0, 0.67658D0, 0.56932D0, 0.51382D0, 0.47719D0,
55968 & 0.44989D0, 0.37226D0, 0.30256D0, 0.26497D0, 0.23955D0,
55969 & 0.22062D0, 0.19343D0, 0.16648D0, 0.13836D0, 0.12007D0,
55970 & 0.09626D0, 0.08032D0, 0.06811D0, 0.05588D0, 0.04588D0,
55971 & 0.03745D0, 0.03039D0, 0.02446D0, 0.01948D0, 0.01531D0,
55972 & 0.01197D0, 0.00921D0, 0.00706D0, 0.00532D0, 0.00395D0,
55973 & 0.00288D0, 0.00209D0, 0.00151D0, 0.00101D0, 0.00072D0,
55974 & 0.00049D0, 0.00031D0, 0.00021D0, 0.00008D0, 0.00002D0,
55975 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55976 DATA (FMRS(2,6,I,13),I=1,49)/
55977 & 1.64756D0, 1.37951D0, 1.15467D0, 1.04031D0, 0.96596D0,
55978 & 0.91188D0, 0.76181D0, 0.63505D0, 0.56988D0, 0.52704D0,
55979 & 0.49515D0, 0.40510D0, 0.32525D0, 0.28268D0, 0.25415D0,
55980 & 0.23303D0, 0.20292D0, 0.17336D0, 0.14288D0, 0.12329D0,
55981 & 0.09812D0, 0.08148D0, 0.06886D0, 0.05629D0, 0.04609D0,
55982 & 0.03753D0, 0.03037D0, 0.02438D0, 0.01937D0, 0.01519D0,
55983 & 0.01185D0, 0.00910D0, 0.00695D0, 0.00523D0, 0.00387D0,
55984 & 0.00281D0, 0.00204D0, 0.00147D0, 0.00097D0, 0.00069D0,
55985 & 0.00048D0, 0.00029D0, 0.00020D0, 0.00007D0, 0.00002D0,
55986 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55987 DATA (FMRS(2,6,I,14),I=1,49)/
55988 & 1.95709D0, 1.62260D0, 1.34467D0, 1.20438D0, 1.11362D0,
55989 & 1.04783D0, 0.86639D0, 0.71460D0, 0.63715D0, 0.58648D0,
55990 & 0.54885D0, 0.44345D0, 0.35130D0, 0.30283D0, 0.27064D0,
55991 & 0.24698D0, 0.21351D0, 0.18099D0, 0.14786D0, 0.12681D0,
55992 & 0.10011D0, 0.08269D0, 0.06959D0, 0.05666D0, 0.04624D0,
55993 & 0.03752D0, 0.03025D0, 0.02422D0, 0.01919D0, 0.01499D0,
55994 & 0.01165D0, 0.00893D0, 0.00678D0, 0.00510D0, 0.00375D0,
55995 & 0.00271D0, 0.00197D0, 0.00141D0, 0.00093D0, 0.00065D0,
55996 & 0.00045D0, 0.00028D0, 0.00019D0, 0.00007D0, 0.00002D0,
55997 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55998 DATA (FMRS(2,6,I,15),I=1,49)/
55999 & 2.33106D0, 1.91266D0, 1.56849D0, 1.39616D0, 1.28524D0,
56000 & 1.20514D0, 0.98569D0, 0.80398D0, 0.71204D0, 0.65222D0,
56001 & 0.60792D0, 0.48491D0, 0.37897D0, 0.32402D0, 0.28785D0,
56002 & 0.26145D0, 0.22441D0, 0.18878D0, 0.15289D0, 0.13035D0,
56003 & 0.10206D0, 0.08383D0, 0.07023D0, 0.05691D0, 0.04625D0,
56004 & 0.03736D0, 0.03004D0, 0.02396D0, 0.01891D0, 0.01473D0,
56005 & 0.01139D0, 0.00872D0, 0.00659D0, 0.00494D0, 0.00362D0,
56006 & 0.00261D0, 0.00189D0, 0.00136D0, 0.00089D0, 0.00062D0,
56007 & 0.00043D0, 0.00026D0, 0.00018D0, 0.00006D0, 0.00002D0,
56008 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56009 DATA (FMRS(2,6,I,16),I=1,49)/
56010 & 2.71585D0, 2.20785D0, 1.79373D0, 1.58787D0, 1.45597D0,
56011 & 1.36104D0, 1.10250D0, 0.89041D0, 0.78391D0, 0.71494D0,
56012 & 0.66403D0, 0.52372D0, 0.40449D0, 0.34337D0, 0.30346D0,
56013 & 0.27452D0, 0.23417D0, 0.19570D0, 0.15732D0, 0.13343D0,
56014 & 0.10373D0, 0.08475D0, 0.07072D0, 0.05705D0, 0.04617D0,
56015 & 0.03716D0, 0.02977D0, 0.02366D0, 0.01861D0, 0.01445D0,
56016 & 0.01114D0, 0.00850D0, 0.00640D0, 0.00478D0, 0.00350D0,
56017 & 0.00251D0, 0.00181D0, 0.00130D0, 0.00086D0, 0.00058D0,
56018 & 0.00040D0, 0.00024D0, 0.00016D0, 0.00006D0, 0.00002D0,
56019 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56020 DATA (FMRS(2,6,I,17),I=1,49)/
56021 & 3.15180D0, 2.53892D0, 2.04375D0, 1.79938D0, 1.64351D0,
56022 & 1.53170D0, 1.22899D0, 0.98294D0, 0.86032D0, 0.78129D0,
56023 & 0.72315D0, 0.56409D0, 0.43066D0, 0.36305D0, 0.31926D0,
56024 & 0.28768D0, 0.24394D0, 0.20257D0, 0.16168D0, 0.13644D0,
56025 & 0.10531D0, 0.08560D0, 0.07112D0, 0.05711D0, 0.04602D0,
56026 & 0.03691D0, 0.02945D0, 0.02332D0, 0.01829D0, 0.01415D0,
56027 & 0.01087D0, 0.00826D0, 0.00621D0, 0.00462D0, 0.00337D0,
56028 & 0.00241D0, 0.00173D0, 0.00124D0, 0.00082D0, 0.00055D0,
56029 & 0.00038D0, 0.00023D0, 0.00015D0, 0.00005D0, 0.00002D0,
56030 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56031 DATA (FMRS(2,6,I,18),I=1,49)/
56032 & 3.55145D0, 2.83962D0, 2.26870D0, 1.98860D0, 1.81061D0,
56033 & 1.68328D0, 1.34021D0, 1.06346D0, 0.92638D0, 0.83839D0,
56034 & 0.77383D0, 0.59827D0, 0.45255D0, 0.37938D0, 0.33229D0,
56035 & 0.29849D0, 0.25191D0, 0.20813D0, 0.16517D0, 0.13882D0,
56036 & 0.10653D0, 0.08622D0, 0.07137D0, 0.05708D0, 0.04584D0,
56037 & 0.03664D0, 0.02914D0, 0.02300D0, 0.01798D0, 0.01388D0,
56038 & 0.01064D0, 0.00807D0, 0.00604D0, 0.00448D0, 0.00326D0,
56039 & 0.00232D0, 0.00166D0, 0.00119D0, 0.00077D0, 0.00053D0,
56040 & 0.00036D0, 0.00022D0, 0.00015D0, 0.00005D0, 0.00001D0,
56041 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56042 DATA (FMRS(2,6,I,19),I=1,49)/
56043 & 4.08243D0, 3.23554D0, 2.56218D0, 2.23414D0, 2.02661D0,
56044 & 1.87862D0, 1.48217D0, 1.16519D0, 1.00935D0, 0.90979D0,
56045 & 0.83697D0, 0.64037D0, 0.47917D0, 0.39910D0, 0.34794D0,
56046 & 0.31141D0, 0.26137D0, 0.21468D0, 0.16924D0, 0.14156D0,
56047 & 0.10788D0, 0.08686D0, 0.07159D0, 0.05697D0, 0.04554D0,
56048 & 0.03624D0, 0.02871D0, 0.02258D0, 0.01759D0, 0.01353D0,
56049 & 0.01034D0, 0.00780D0, 0.00582D0, 0.00431D0, 0.00313D0,
56050 & 0.00222D0, 0.00159D0, 0.00113D0, 0.00073D0, 0.00050D0,
56051 & 0.00034D0, 0.00021D0, 0.00014D0, 0.00005D0, 0.00001D0,
56052 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56053 DATA (FMRS(2,6,I,20),I=1,49)/
56054 & 4.59984D0, 3.61795D0, 2.84314D0, 2.46798D0, 2.23154D0,
56055 & 2.06341D0, 1.61522D0, 1.25965D0, 1.08594D0, 0.97542D0,
56056 & 0.89482D0, 0.67853D0, 0.50302D0, 0.41664D0, 0.36179D0,
56057 & 0.32280D0, 0.26966D0, 0.22039D0, 0.17274D0, 0.14391D0,
56058 & 0.10901D0, 0.08736D0, 0.07173D0, 0.05682D0, 0.04524D0,
56059 & 0.03586D0, 0.02831D0, 0.02220D0, 0.01723D0, 0.01322D0,
56060 & 0.01007D0, 0.00756D0, 0.00563D0, 0.00415D0, 0.00301D0,
56061 & 0.00213D0, 0.00152D0, 0.00108D0, 0.00071D0, 0.00046D0,
56062 & 0.00032D0, 0.00019D0, 0.00013D0, 0.00004D0, 0.00001D0,
56063 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56064 DATA (FMRS(2,6,I,21),I=1,49)/
56065 & 5.10866D0, 3.99099D0, 3.11497D0, 2.69310D0, 2.42814D0,
56066 & 2.24021D0, 1.74141D0, 1.34843D0, 1.15753D0, 1.03651D0,
56067 & 0.94850D0, 0.71355D0, 0.52465D0, 0.43244D0, 0.37419D0,
56068 & 0.33296D0, 0.27700D0, 0.22539D0, 0.17578D0, 0.14590D0,
56069 & 0.10992D0, 0.08772D0, 0.07175D0, 0.05660D0, 0.04490D0,
56070 & 0.03547D0, 0.02791D0, 0.02182D0, 0.01688D0, 0.01291D0,
56071 & 0.00980D0, 0.00735D0, 0.00546D0, 0.00401D0, 0.00289D0,
56072 & 0.00204D0, 0.00145D0, 0.00103D0, 0.00067D0, 0.00045D0,
56073 & 0.00030D0, 0.00018D0, 0.00012D0, 0.00004D0, 0.00001D0,
56074 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56075 DATA (FMRS(2,6,I,22),I=1,49)/
56076 & 5.81063D0, 4.50144D0, 3.48388D0, 2.99716D0, 2.69275D0,
56077 & 2.47752D0, 1.90937D0, 1.46556D0, 1.25149D0, 1.11639D0,
56078 & 1.01845D0, 0.75875D0, 0.55228D0, 0.45248D0, 0.38985D0,
56079 & 0.34573D0, 0.28616D0, 0.23159D0, 0.17950D0, 0.14831D0,
56080 & 0.11099D0, 0.08809D0, 0.07172D0, 0.05628D0, 0.04443D0,
56081 & 0.03495D0, 0.02738D0, 0.02132D0, 0.01642D0, 0.01252D0,
56082 & 0.00947D0, 0.00708D0, 0.00524D0, 0.00384D0, 0.00275D0,
56083 & 0.00194D0, 0.00137D0, 0.00097D0, 0.00062D0, 0.00042D0,
56084 & 0.00028D0, 0.00017D0, 0.00011D0, 0.00004D0, 0.00001D0,
56085 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56086 DATA (FMRS(2,6,I,23),I=1,49)/
56087 & 6.53035D0, 5.02028D0, 3.85558D0, 3.30194D0, 2.95702D0,
56088 & 2.71384D0, 2.07512D0, 1.58008D0, 1.34283D0, 1.19373D0,
56089 & 1.08596D0, 0.80189D0, 0.57834D0, 0.47125D0, 0.40444D0,
56090 & 0.35757D0, 0.29461D0, 0.23726D0, 0.18285D0, 0.15046D0,
56091 & 0.11188D0, 0.08836D0, 0.07162D0, 0.05593D0, 0.04396D0,
56092 & 0.03443D0, 0.02686D0, 0.02084D0, 0.01599D0, 0.01216D0,
56093 & 0.00917D0, 0.00683D0, 0.00504D0, 0.00368D0, 0.00262D0,
56094 & 0.00186D0, 0.00129D0, 0.00092D0, 0.00058D0, 0.00038D0,
56095 & 0.00026D0, 0.00015D0, 0.00010D0, 0.00004D0, 0.00001D0,
56096 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56097 DATA (FMRS(2,6,I,24),I=1,49)/
56098 & 7.24769D0, 5.53321D0, 4.22004D0, 3.59932D0, 3.21397D0,
56099 & 2.94299D0, 2.23445D0, 1.68918D0, 1.42937D0, 1.26671D0,
56100 & 1.14944D0, 0.84202D0, 0.60229D0, 0.48837D0, 0.41766D0,
56101 & 0.36826D0, 0.30216D0, 0.24227D0, 0.18575D0, 0.15227D0,
56102 & 0.11258D0, 0.08849D0, 0.07143D0, 0.05553D0, 0.04345D0,
56103 & 0.03390D0, 0.02636D0, 0.02037D0, 0.01559D0, 0.01181D0,
56104 & 0.00887D0, 0.00659D0, 0.00484D0, 0.00353D0, 0.00252D0,
56105 & 0.00176D0, 0.00124D0, 0.00088D0, 0.00055D0, 0.00037D0,
56106 & 0.00025D0, 0.00014D0, 0.00009D0, 0.00003D0, 0.00001D0,
56107 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56108 DATA (FMRS(2,6,I,25),I=1,49)/
56109 & 8.02203D0, 6.08288D0, 4.60775D0, 3.91431D0, 3.48531D0,
56110 & 3.18439D0, 2.40103D0, 1.80237D0, 1.51875D0, 1.34182D0,
56111 & 1.21461D0, 0.88286D0, 0.62643D0, 0.50552D0, 0.43085D0,
56112 & 0.37888D0, 0.30963D0, 0.24719D0, 0.18858D0, 0.15401D0,
56113 & 0.11322D0, 0.08857D0, 0.07120D0, 0.05510D0, 0.04294D0,
56114 & 0.03336D0, 0.02585D0, 0.01990D0, 0.01519D0, 0.01146D0,
56115 & 0.00858D0, 0.00636D0, 0.00466D0, 0.00338D0, 0.00242D0,
56116 & 0.00168D0, 0.00119D0, 0.00083D0, 0.00052D0, 0.00035D0,
56117 & 0.00023D0, 0.00013D0, 0.00009D0, 0.00003D0, 0.00001D0,
56118 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56119 DATA (FMRS(2,6,I,26),I=1,49)/
56120 & 8.82307D0, 6.64735D0, 5.00295D0, 4.23399D0, 3.75981D0,
56121 & 3.42801D0, 2.56785D0, 1.91480D0, 1.60708D0, 1.41578D0,
56122 & 1.27859D0, 0.92256D0, 0.64966D0, 0.52190D0, 0.44338D0,
56123 & 0.38892D0, 0.31662D0, 0.25175D0, 0.19114D0, 0.15555D0,
56124 & 0.11371D0, 0.08855D0, 0.07090D0, 0.05462D0, 0.04239D0,
56125 & 0.03281D0, 0.02532D0, 0.01944D0, 0.01478D0, 0.01112D0,
56126 & 0.00830D0, 0.00614D0, 0.00448D0, 0.00324D0, 0.00231D0,
56127 & 0.00160D0, 0.00113D0, 0.00079D0, 0.00049D0, 0.00033D0,
56128 & 0.00022D0, 0.00013D0, 0.00008D0, 0.00003D0, 0.00001D0,
56129 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56130 DATA (FMRS(2,6,I,27),I=1,49)/
56131 & 9.62987D0, 7.21210D0, 5.39571D0, 4.55043D0, 4.03076D0,
56132 & 3.66794D0, 2.73100D0, 2.02398D0, 1.69250D0, 1.48708D0,
56133 & 1.34010D0, 0.96040D0, 0.67159D0, 0.53727D0, 0.45509D0,
56134 & 0.39827D0, 0.32310D0, 0.25593D0, 0.19347D0, 0.15692D0,
56135 & 0.11411D0, 0.08848D0, 0.07058D0, 0.05414D0, 0.04185D0,
56136 & 0.03228D0, 0.02482D0, 0.01900D0, 0.01440D0, 0.01080D0,
56137 & 0.00804D0, 0.00593D0, 0.00431D0, 0.00312D0, 0.00222D0,
56138 & 0.00152D0, 0.00108D0, 0.00075D0, 0.00046D0, 0.00031D0,
56139 & 0.00020D0, 0.00012D0, 0.00008D0, 0.00003D0, 0.00001D0,
56140 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56141 DATA (FMRS(2,6,I,28),I=1,49)/
56142 & 10.42894D0, 7.76794D0, 5.77982D0, 4.85875D0, 4.29406D0,
56143 & 3.90061D0, 2.88817D0, 2.12844D0, 1.77387D0, 1.55479D0,
56144 & 1.39837D0, 0.99596D0, 0.69200D0, 0.55150D0, 0.46587D0,
56145 & 0.40684D0, 0.32899D0, 0.25970D0, 0.19552D0, 0.15809D0,
56146 & 0.11441D0, 0.08837D0, 0.07023D0, 0.05366D0, 0.04133D0,
56147 & 0.03176D0, 0.02435D0, 0.01859D0, 0.01405D0, 0.01051D0,
56148 & 0.00780D0, 0.00573D0, 0.00416D0, 0.00301D0, 0.00213D0,
56149 & 0.00146D0, 0.00103D0, 0.00071D0, 0.00045D0, 0.00029D0,
56150 & 0.00020D0, 0.00011D0, 0.00008D0, 0.00003D0, 0.00001D0,
56151 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56152 DATA (FMRS(2,6,I,29),I=1,49)/
56153 & 11.27410D0, 8.35239D0, 6.18132D0, 5.17989D0, 4.56762D0,
56154 & 4.14187D0, 3.05014D0, 2.23540D0, 1.85687D0, 1.62366D0,
56155 & 1.45750D0, 1.03178D0, 0.71238D0, 0.56563D0, 0.47653D0,
56156 & 0.41529D0, 0.33476D0, 0.26336D0, 0.19748D0, 0.15919D0,
56157 & 0.11465D0, 0.08820D0, 0.06985D0, 0.05316D0, 0.04080D0,
56158 & 0.03125D0, 0.02388D0, 0.01817D0, 0.01370D0, 0.01022D0,
56159 & 0.00757D0, 0.00554D0, 0.00401D0, 0.00290D0, 0.00205D0,
56160 & 0.00140D0, 0.00098D0, 0.00068D0, 0.00043D0, 0.00028D0,
56161 & 0.00019D0, 0.00011D0, 0.00007D0, 0.00002D0, 0.00001D0,
56162 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56163 DATA (FMRS(2,6,I,30),I=1,49)/
56164 & 12.14199D0, 8.94909D0, 6.58882D0, 5.50470D0, 4.84361D0,
56165 & 4.38480D0, 3.21222D0, 2.34175D0, 1.93908D0, 1.69167D0,
56166 & 1.51576D0, 1.06678D0, 0.73213D0, 0.57923D0, 0.48674D0,
56167 & 0.42334D0, 0.34023D0, 0.26678D0, 0.19927D0, 0.16016D0,
56168 & 0.11481D0, 0.08798D0, 0.06944D0, 0.05264D0, 0.04025D0,
56169 & 0.03073D0, 0.02343D0, 0.01777D0, 0.01335D0, 0.00994D0,
56170 & 0.00734D0, 0.00536D0, 0.00388D0, 0.00278D0, 0.00196D0,
56171 & 0.00135D0, 0.00094D0, 0.00065D0, 0.00041D0, 0.00027D0,
56172 & 0.00017D0, 0.00010D0, 0.00007D0, 0.00002D0, 0.00001D0,
56173 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56174 DATA (FMRS(2,6,I,31),I=1,49)/
56175 & 13.00875D0, 9.54182D0, 6.99142D0, 5.82458D0, 5.11479D0,
56176 & 4.62308D0, 3.37031D0, 2.44489D0, 2.01852D0, 1.75723D0,
56177 & 1.57179D0, 1.10022D0, 0.75086D0, 0.59207D0, 0.49634D0,
56178 & 0.43089D0, 0.34532D0, 0.26994D0, 0.20090D0, 0.16103D0,
56179 & 0.11492D0, 0.08774D0, 0.06903D0, 0.05213D0, 0.03973D0,
56180 & 0.03024D0, 0.02300D0, 0.01739D0, 0.01303D0, 0.00968D0,
56181 & 0.00712D0, 0.00520D0, 0.00375D0, 0.00268D0, 0.00188D0,
56182 & 0.00130D0, 0.00090D0, 0.00063D0, 0.00039D0, 0.00025D0,
56183 & 0.00016D0, 0.00009D0, 0.00006D0, 0.00002D0, 0.00001D0,
56184 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56185 DATA (FMRS(2,6,I,32),I=1,49)/
56186 & 13.85388D0, 10.11672D0, 7.37984D0, 6.13221D0, 5.37500D0,
56187 & 4.85130D0, 3.52087D0, 2.54252D0, 2.09344D0, 1.81889D0,
56188 & 1.62437D0, 1.13136D0, 0.76814D0, 0.60383D0, 0.50509D0,
56189 & 0.43774D0, 0.34990D0, 0.27275D0, 0.20231D0, 0.16173D0,
56190 & 0.11495D0, 0.08745D0, 0.06859D0, 0.05162D0, 0.03921D0,
56191 & 0.02977D0, 0.02256D0, 0.01702D0, 0.01273D0, 0.00943D0,
56192 & 0.00693D0, 0.00505D0, 0.00364D0, 0.00260D0, 0.00181D0,
56193 & 0.00125D0, 0.00086D0, 0.00060D0, 0.00037D0, 0.00024D0,
56194 & 0.00016D0, 0.00009D0, 0.00006D0, 0.00002D0, 0.00001D0,
56195 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56196 DATA (FMRS(2,6,I,33),I=1,49)/
56197 & 14.75398D0, 10.72621D0, 7.78974D0, 6.45599D0, 5.64833D0,
56198 & 5.09068D0, 3.67806D0, 2.64398D0, 2.17108D0, 1.88265D0,
56199 & 1.67867D0, 1.16335D0, 0.78579D0, 0.61581D0, 0.51399D0,
56200 & 0.44470D0, 0.35453D0, 0.27558D0, 0.20373D0, 0.16245D0,
56201 & 0.11497D0, 0.08717D0, 0.06816D0, 0.05112D0, 0.03871D0,
56202 & 0.02930D0, 0.02213D0, 0.01666D0, 0.01243D0, 0.00919D0,
56203 & 0.00674D0, 0.00490D0, 0.00353D0, 0.00251D0, 0.00175D0,
56204 & 0.00120D0, 0.00083D0, 0.00058D0, 0.00036D0, 0.00023D0,
56205 & 0.00015D0, 0.00009D0, 0.00006D0, 0.00002D0, 0.00001D0,
56206 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56207 DATA (FMRS(2,6,I,34),I=1,49)/
56208 & 15.65461D0, 11.33290D0, 8.19558D0, 6.77553D0, 5.91747D0,
56209 & 5.32596D0, 3.83165D0, 2.74249D0, 2.24617D0, 1.94414D0,
56210 & 1.73088D0, 1.19385D0, 0.80244D0, 0.62703D0, 0.52226D0,
56211 & 0.45111D0, 0.35875D0, 0.27811D0, 0.20493D0, 0.16299D0,
56212 & 0.11490D0, 0.08681D0, 0.06768D0, 0.05059D0, 0.03819D0,
56213 & 0.02883D0, 0.02172D0, 0.01631D0, 0.01213D0, 0.00895D0,
56214 & 0.00656D0, 0.00475D0, 0.00341D0, 0.00243D0, 0.00169D0,
56215 & 0.00116D0, 0.00080D0, 0.00055D0, 0.00034D0, 0.00022D0,
56216 & 0.00015D0, 0.00008D0, 0.00005D0, 0.00002D0, 0.00000D0,
56217 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56218 DATA (FMRS(2,6,I,35),I=1,49)/
56219 & 16.55734D0, 11.93842D0, 8.59892D0, 7.09231D0, 6.18381D0,
56220 & 5.55847D0, 3.98278D0, 2.83900D0, 2.31954D0, 2.00411D0,
56221 & 1.78173D0, 1.22341D0, 0.81850D0, 0.63782D0, 0.53020D0,
56222 & 0.45726D0, 0.36278D0, 0.28052D0, 0.20606D0, 0.16351D0,
56223 & 0.11482D0, 0.08647D0, 0.06722D0, 0.05009D0, 0.03770D0,
56224 & 0.02838D0, 0.02133D0, 0.01598D0, 0.01187D0, 0.00873D0,
56225 & 0.00639D0, 0.00462D0, 0.00330D0, 0.00235D0, 0.00163D0,
56226 & 0.00111D0, 0.00077D0, 0.00053D0, 0.00033D0, 0.00021D0,
56227 & 0.00014D0, 0.00008D0, 0.00005D0, 0.00002D0, 0.00000D0,
56228 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56229 DATA (FMRS(2,6,I,36),I=1,49)/
56230 & 17.43806D0, 12.52661D0, 8.98898D0, 7.39784D0, 6.44021D0,
56231 & 5.78196D0, 4.12737D0, 2.93087D0, 2.38917D0, 2.06088D0,
56232 & 1.82979D0, 1.25117D0, 0.83346D0, 0.64781D0, 0.53752D0,
56233 & 0.46291D0, 0.36645D0, 0.28268D0, 0.20706D0, 0.16393D0,
56234 & 0.11470D0, 0.08612D0, 0.06676D0, 0.04960D0, 0.03723D0,
56235 & 0.02796D0, 0.02096D0, 0.01566D0, 0.01161D0, 0.00852D0,
56236 & 0.00623D0, 0.00449D0, 0.00321D0, 0.00227D0, 0.00158D0,
56237 & 0.00107D0, 0.00074D0, 0.00051D0, 0.00031D0, 0.00020D0,
56238 & 0.00013D0, 0.00008D0, 0.00005D0, 0.00002D0, 0.00000D0,
56239 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56240 DATA (FMRS(2,6,I,37),I=1,49)/
56241 & 18.35067D0, 13.13351D0, 9.38971D0, 7.71095D0, 6.70247D0,
56242 & 6.01024D0, 4.27436D0, 3.02381D0, 2.45940D0, 2.11802D0,
56243 & 1.87806D0, 1.27887D0, 0.84828D0, 0.65765D0, 0.54469D0,
56244 & 0.46841D0, 0.37001D0, 0.28475D0, 0.20797D0, 0.16429D0,
56245 & 0.11453D0, 0.08573D0, 0.06628D0, 0.04909D0, 0.03675D0,
56246 & 0.02752D0, 0.02059D0, 0.01535D0, 0.01135D0, 0.00831D0,
56247 & 0.00606D0, 0.00437D0, 0.00311D0, 0.00220D0, 0.00153D0,
56248 & 0.00103D0, 0.00072D0, 0.00049D0, 0.00030D0, 0.00019D0,
56249 & 0.00013D0, 0.00007D0, 0.00005D0, 0.00001D0, 0.00000D0,
56250 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56251 DATA (FMRS(2,6,I,38),I=1,49)/
56252 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56253 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56254 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56255 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56256 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56257 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56258 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56259 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56260 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56261 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56262 DATA (FMRS(2,7,I, 1),I=1,49)/
56263 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56264 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56265 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56266 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56267 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56268 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56269 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56270 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56271 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56272 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56273 DATA (FMRS(2,7,I, 2),I=1,49)/
56274 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56275 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56276 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56277 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56278 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56279 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56280 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56281 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56282 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56283 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56284 DATA (FMRS(2,7,I, 3),I=1,49)/
56285 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56286 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56287 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56288 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56289 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56290 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56291 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56292 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56293 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56294 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56295 DATA (FMRS(2,7,I, 4),I=1,49)/
56296 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56297 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56298 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56299 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56300 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56301 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56302 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56303 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56304 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56305 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56306 DATA (FMRS(2,7,I, 5),I=1,49)/
56307 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56308 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56309 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56310 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56311 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56312 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56313 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56314 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56315 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56316 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56317 DATA (FMRS(2,7,I, 6),I=1,49)/
56318 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56319 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56320 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56321 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56322 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56323 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56324 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56325 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56326 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56327 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56328 DATA (FMRS(2,7,I, 7),I=1,49)/
56329 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56330 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56331 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56332 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56333 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56334 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56335 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56336 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56337 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56338 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56339 DATA (FMRS(2,7,I, 8),I=1,49)/
56340 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56341 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56342 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56343 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56344 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56345 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56346 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56347 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56348 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56349 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56350 DATA (FMRS(2,7,I, 9),I=1,49)/
56351 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56352 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56353 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56354 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56355 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56356 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56357 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56358 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56359 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56360 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56361 DATA (FMRS(2,7,I,10),I=1,49)/
56362 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56363 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56364 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56365 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56366 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56367 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56368 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56369 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56370 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56371 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56372 DATA (FMRS(2,7,I,11),I=1,49)/
56373 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56374 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56375 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56376 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56377 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56378 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56379 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56380 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56381 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56382 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56383 DATA (FMRS(2,7,I,12),I=1,49)/
56384 & 0.00041D0, 0.00036D0, 0.00032D0, 0.00030D0, 0.00028D0,
56385 & 0.00027D0, 0.00023D0, 0.00021D0, 0.00019D0, 0.00018D0,
56386 & 0.00017D0, 0.00014D0, 0.00012D0, 0.00011D0, 0.00010D0,
56387 & 0.00009D0, 0.00008D0, 0.00007D0, 0.00006D0, 0.00005D0,
56388 & 0.00004D0, 0.00004D0, 0.00003D0, 0.00003D0, 0.00003D0,
56389 & 0.00003D0, 0.00002D0, 0.00002D0, 0.00002D0, 0.00002D0,
56390 & 0.00001D0, 0.00001D0, 0.00001D0, 0.00001D0, 0.00001D0,
56391 & 0.00001D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
56392 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56393 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56394 DATA (FMRS(2,7,I,13),I=1,49)/
56395 & 0.21131D0, 0.16558D0, 0.12967D0, 0.11232D0, 0.10141D0,
56396 & 0.09365D0, 0.07296D0, 0.05647D0, 0.04835D0, 0.04314D0,
56397 & 0.03929D0, 0.02893D0, 0.02049D0, 0.01636D0, 0.01376D0,
56398 & 0.01193D0, 0.00947D0, 0.00725D0, 0.00522D0, 0.00409D0,
56399 & 0.00289D0, 0.00226D0, 0.00187D0, 0.00153D0, 0.00127D0,
56400 & 0.00106D0, 0.00087D0, 0.00071D0, 0.00058D0, 0.00046D0,
56401 & 0.00037D0, 0.00028D0, 0.00022D0, 0.00016D0, 0.00012D0,
56402 & 0.00009D0, 0.00007D0, 0.00005D0, 0.00003D0, 0.00002D0,
56403 & 0.00001D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
56404 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56405 DATA (FMRS(2,7,I,14),I=1,49)/
56406 & 0.61374D0, 0.47881D0, 0.37330D0, 0.32254D0, 0.29066D0,
56407 & 0.26804D0, 0.20788D0, 0.16016D0, 0.13675D0, 0.12177D0,
56408 & 0.11072D0, 0.08109D0, 0.05711D0, 0.04545D0, 0.03813D0,
56409 & 0.03299D0, 0.02611D0, 0.01996D0, 0.01434D0, 0.01121D0,
56410 & 0.00789D0, 0.00617D0, 0.00509D0, 0.00414D0, 0.00341D0,
56411 & 0.00282D0, 0.00231D0, 0.00188D0, 0.00151D0, 0.00120D0,
56412 & 0.00094D0, 0.00073D0, 0.00056D0, 0.00042D0, 0.00031D0,
56413 & 0.00023D0, 0.00016D0, 0.00012D0, 0.00008D0, 0.00005D0,
56414 & 0.00003D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
56415 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56416 DATA (FMRS(2,7,I,15),I=1,49)/
56417 & 0.99259D0, 0.76862D0, 0.59480D0, 0.51168D0, 0.45967D0,
56418 & 0.42287D0, 0.32549D0, 0.24886D0, 0.21152D0, 0.18775D0,
56419 & 0.17025D0, 0.12366D0, 0.08636D0, 0.06840D0, 0.05719D0,
56420 & 0.04937D0, 0.03895D0, 0.02967D0, 0.02125D0, 0.01657D0,
56421 & 0.01162D0, 0.00903D0, 0.00740D0, 0.00597D0, 0.00488D0,
56422 & 0.00399D0, 0.00325D0, 0.00263D0, 0.00210D0, 0.00166D0,
56423 & 0.00130D0, 0.00100D0, 0.00076D0, 0.00057D0, 0.00042D0,
56424 & 0.00031D0, 0.00022D0, 0.00015D0, 0.00011D0, 0.00007D0,
56425 & 0.00004D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
56426 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56427 DATA (FMRS(2,7,I,16),I=1,49)/
56428 & 1.40334D0, 1.07950D0, 0.82983D0, 0.71109D0, 0.63704D0,
56429 & 0.58478D0, 0.44710D0, 0.33953D0, 0.28741D0, 0.25436D0,
56430 & 0.23011D0, 0.16589D0, 0.11498D0, 0.09067D0, 0.07559D0,
56431 & 0.06510D0, 0.05120D0, 0.03889D0, 0.02777D0, 0.02161D0,
56432 & 0.01509D0, 0.01166D0, 0.00950D0, 0.00760D0, 0.00617D0,
56433 & 0.00501D0, 0.00405D0, 0.00325D0, 0.00258D0, 0.00203D0,
56434 & 0.00158D0, 0.00121D0, 0.00091D0, 0.00068D0, 0.00050D0,
56435 & 0.00037D0, 0.00026D0, 0.00018D0, 0.00012D0, 0.00008D0,
56436 & 0.00005D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
56437 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56438 DATA (FMRS(2,7,I,17),I=1,49)/
56439 & 1.88020D0, 1.43681D0, 1.09723D0, 0.93659D0, 0.83676D0,
56440 & 0.76647D0, 0.58212D0, 0.43908D0, 0.37019D0, 0.32667D0,
56441 & 0.29484D0, 0.21099D0, 0.14515D0, 0.11396D0, 0.09473D0,
56442 & 0.08141D0, 0.06382D0, 0.04833D0, 0.03440D0, 0.02672D0,
56443 & 0.01856D0, 0.01428D0, 0.01156D0, 0.00918D0, 0.00739D0,
56444 & 0.00596D0, 0.00478D0, 0.00381D0, 0.00301D0, 0.00236D0,
56445 & 0.00181D0, 0.00138D0, 0.00104D0, 0.00077D0, 0.00057D0,
56446 & 0.00041D0, 0.00030D0, 0.00020D0, 0.00014D0, 0.00009D0,
56447 & 0.00005D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
56448 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56449 DATA (FMRS(2,7,I,18),I=1,49)/
56450 & 2.30534D0, 1.75221D0, 1.33088D0, 1.13244D0, 1.00946D0,
56451 & 0.92305D0, 0.69723D0, 0.52301D0, 0.43952D0, 0.38693D0,
56452 & 0.34856D0, 0.24795D0, 0.16954D0, 0.13265D0, 0.11000D0,
56453 & 0.09436D0, 0.07379D0, 0.05574D0, 0.03958D0, 0.03067D0,
56454 & 0.02123D0, 0.01626D0, 0.01309D0, 0.01033D0, 0.00826D0,
56455 & 0.00663D0, 0.00529D0, 0.00419D0, 0.00329D0, 0.00257D0,
56456 & 0.00197D0, 0.00150D0, 0.00112D0, 0.00083D0, 0.00061D0,
56457 & 0.00044D0, 0.00032D0, 0.00022D0, 0.00015D0, 0.00009D0,
56458 & 0.00005D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
56459 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56460 DATA (FMRS(2,7,I,19),I=1,49)/
56461 & 2.86856D0, 2.16633D0, 1.63487D0, 1.38587D0, 1.23207D0,
56462 & 1.12426D0, 0.84372D0, 0.62876D0, 0.52633D0, 0.46206D0,
56463 & 0.41530D0, 0.29334D0, 0.19914D0, 0.15517D0, 0.12832D0,
56464 & 0.10984D0, 0.08563D0, 0.06450D0, 0.04565D0, 0.03529D0,
56465 & 0.02431D0, 0.01851D0, 0.01482D0, 0.01161D0, 0.00922D0,
56466 & 0.00734D0, 0.00582D0, 0.00458D0, 0.00358D0, 0.00278D0,
56467 & 0.00212D0, 0.00160D0, 0.00119D0, 0.00088D0, 0.00064D0,
56468 & 0.00047D0, 0.00033D0, 0.00023D0, 0.00015D0, 0.00009D0,
56469 & 0.00005D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
56470 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56471 DATA (FMRS(2,7,I,20),I=1,49)/
56472 & 3.42748D0, 2.57399D0, 1.93167D0, 1.63211D0, 1.44759D0,
56473 & 1.31854D0, 0.98395D0, 0.72909D0, 0.60825D0, 0.53267D0,
56474 & 0.47783D0, 0.33544D0, 0.22632D0, 0.17572D0, 0.14495D0,
56475 & 0.12384D0, 0.09630D0, 0.07234D0, 0.05105D0, 0.03938D0,
56476 & 0.02701D0, 0.02047D0, 0.01631D0, 0.01268D0, 0.01001D0,
56477 & 0.00793D0, 0.00625D0, 0.00489D0, 0.00380D0, 0.00294D0,
56478 & 0.00223D0, 0.00168D0, 0.00125D0, 0.00091D0, 0.00066D0,
56479 & 0.00048D0, 0.00035D0, 0.00024D0, 0.00016D0, 0.00009D0,
56480 & 0.00005D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
56481 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56482 DATA (FMRS(2,7,I,21),I=1,49)/
56483 & 3.95907D0, 2.95830D0, 2.20894D0, 1.86088D0, 1.64705D0,
56484 & 1.49778D0, 1.11204D0, 0.81980D0, 0.68185D0, 0.59583D0,
56485 & 0.53354D0, 0.37251D0, 0.24993D0, 0.19343D0, 0.15921D0,
56486 & 0.13581D0, 0.10535D0, 0.07895D0, 0.05557D0, 0.04278D0,
56487 & 0.02922D0, 0.02205D0, 0.01748D0, 0.01352D0, 0.01061D0,
56488 & 0.00835D0, 0.00655D0, 0.00511D0, 0.00395D0, 0.00304D0,
56489 & 0.00230D0, 0.00172D0, 0.00128D0, 0.00093D0, 0.00067D0,
56490 & 0.00049D0, 0.00035D0, 0.00024D0, 0.00016D0, 0.00009D0,
56491 & 0.00005D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
56492 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56493 DATA (FMRS(2,7,I,22),I=1,49)/
56494 & 4.70301D0, 3.49223D0, 2.59131D0, 2.17500D0, 1.92006D0,
56495 & 1.74251D0, 1.28559D0, 0.94171D0, 0.78029D0, 0.68000D0,
56496 & 0.60759D0, 0.42132D0, 0.28074D0, 0.21641D0, 0.17764D0,
56497 & 0.15121D0, 0.11695D0, 0.08738D0, 0.06130D0, 0.04706D0,
56498 & 0.03198D0, 0.02400D0, 0.01891D0, 0.01452D0, 0.01131D0,
56499 & 0.00885D0, 0.00690D0, 0.00535D0, 0.00412D0, 0.00314D0,
56500 & 0.00237D0, 0.00177D0, 0.00130D0, 0.00095D0, 0.00068D0,
56501 & 0.00049D0, 0.00036D0, 0.00024D0, 0.00016D0, 0.00009D0,
56502 & 0.00005D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
56503 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56504 DATA (FMRS(2,7,I,23),I=1,49)/
56505 & 5.46775D0, 4.03669D0, 2.97803D0, 2.49113D0, 2.19384D0,
56506 & 1.98726D0, 1.45764D0, 1.06148D0, 0.87647D0, 0.76190D0,
56507 & 0.67941D0, 0.46817D0, 0.30998D0, 0.23809D0, 0.19493D0,
56508 & 0.16562D0, 0.12774D0, 0.09517D0, 0.06655D0, 0.05097D0,
56509 & 0.03446D0, 0.02573D0, 0.02017D0, 0.01538D0, 0.01190D0,
56510 & 0.00925D0, 0.00718D0, 0.00553D0, 0.00424D0, 0.00322D0,
56511 & 0.00242D0, 0.00179D0, 0.00132D0, 0.00095D0, 0.00069D0,
56512 & 0.00049D0, 0.00036D0, 0.00024D0, 0.00016D0, 0.00009D0,
56513 & 0.00005D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
56514 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56515 DATA (FMRS(2,7,I,24),I=1,49)/
56516 & 6.21519D0, 4.56429D0, 3.34948D0, 2.79317D0, 2.45443D0,
56517 & 2.21950D0, 1.61934D0, 1.17290D0, 0.96539D0, 0.83728D0,
56518 & 0.74526D0, 0.51062D0, 0.33614D0, 0.25732D0, 0.21020D0,
56519 & 0.17828D0, 0.13715D0, 0.10192D0, 0.07106D0, 0.05428D0,
56520 & 0.03653D0, 0.02714D0, 0.02117D0, 0.01604D0, 0.01234D0,
56521 & 0.00954D0, 0.00736D0, 0.00565D0, 0.00431D0, 0.00326D0,
56522 & 0.00243D0, 0.00180D0, 0.00132D0, 0.00095D0, 0.00068D0,
56523 & 0.00049D0, 0.00035D0, 0.00024D0, 0.00016D0, 0.00009D0,
56524 & 0.00005D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
56525 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56526 DATA (FMRS(2,7,I,25),I=1,49)/
56527 & 7.03262D0, 5.13776D0, 3.75072D0, 3.11823D0, 2.73413D0,
56528 & 2.46827D0, 1.79141D0, 1.29068D0, 1.05901D0, 0.91641D0,
56529 & 0.81423D0, 0.55475D0, 0.36312D0, 0.27706D0, 0.22581D0,
56530 & 0.19119D0, 0.14672D0, 0.10875D0, 0.07559D0, 0.05760D0,
56531 & 0.03859D0, 0.02852D0, 0.02214D0, 0.01668D0, 0.01276D0,
56532 & 0.00981D0, 0.00753D0, 0.00575D0, 0.00436D0, 0.00329D0,
56533 & 0.00245D0, 0.00180D0, 0.00132D0, 0.00095D0, 0.00068D0,
56534 & 0.00048D0, 0.00035D0, 0.00024D0, 0.00016D0, 0.00009D0,
56535 & 0.00005D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
56536 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56537 DATA (FMRS(2,7,I,26),I=1,49)/
56538 & 7.86804D0, 5.71947D0, 4.15459D0, 3.44391D0, 3.01342D0,
56539 & 2.71602D0, 1.96133D0, 1.40596D0, 1.15014D0, 0.99314D0,
56540 & 0.88088D0, 0.59694D0, 0.38863D0, 0.29560D0, 0.24039D0,
56541 & 0.20320D0, 0.15555D0, 0.11500D0, 0.07970D0, 0.06059D0,
56542 & 0.04040D0, 0.02973D0, 0.02296D0, 0.01720D0, 0.01308D0,
56543 & 0.01001D0, 0.00765D0, 0.00581D0, 0.00439D0, 0.00330D0,
56544 & 0.00245D0, 0.00180D0, 0.00131D0, 0.00094D0, 0.00067D0,
56545 & 0.00048D0, 0.00034D0, 0.00024D0, 0.00016D0, 0.00009D0,
56546 & 0.00005D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
56547 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56548 DATA (FMRS(2,7,I,27),I=1,49)/
56549 & 8.71308D0, 6.30440D0, 4.55822D0, 3.76823D0, 3.29083D0,
56550 & 2.96160D0, 2.12868D0, 1.51874D0, 1.23894D0, 1.06767D0,
56551 & 0.94548D0, 0.63752D0, 0.41296D0, 0.31319D0, 0.25418D0,
56552 & 0.21452D0, 0.16385D0, 0.12085D0, 0.08351D0, 0.06334D0,
56553 & 0.04205D0, 0.03081D0, 0.02369D0, 0.01765D0, 0.01336D0,
56554 & 0.01017D0, 0.00773D0, 0.00586D0, 0.00441D0, 0.00330D0,
56555 & 0.00244D0, 0.00178D0, 0.00129D0, 0.00092D0, 0.00066D0,
56556 & 0.00047D0, 0.00034D0, 0.00024D0, 0.00016D0, 0.00009D0,
56557 & 0.00005D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
56558 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56559 DATA (FMRS(2,7,I,28),I=1,49)/
56560 & 9.54571D0, 6.87720D0, 4.95101D0, 4.08263D0, 3.55902D0,
56561 & 3.19851D0, 2.28903D0, 1.62602D0, 1.32303D0, 1.13803D0,
56562 & 1.00630D0, 0.67540D0, 0.43546D0, 0.32936D0, 0.26680D0,
56563 & 0.22485D0, 0.17138D0, 0.12612D0, 0.08693D0, 0.06579D0,
56564 & 0.04350D0, 0.03173D0, 0.02430D0, 0.01801D0, 0.01357D0,
56565 & 0.01029D0, 0.00779D0, 0.00587D0, 0.00441D0, 0.00329D0,
56566 & 0.00242D0, 0.00177D0, 0.00128D0, 0.00091D0, 0.00065D0,
56567 & 0.00046D0, 0.00033D0, 0.00024D0, 0.00016D0, 0.00009D0,
56568 & 0.00005D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
56569 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56570 DATA (FMRS(2,7,I,29),I=1,49)/
56571 & 10.42768D0, 7.48069D0, 5.36257D0, 4.41099D0, 3.83846D0,
56572 & 3.44489D0, 2.45481D0, 1.73627D0, 1.40913D0, 1.20986D0,
56573 & 1.06825D0, 0.71372D0, 0.45804D0, 0.34552D0, 0.27937D0,
56574 & 0.23511D0, 0.17881D0, 0.13130D0, 0.09026D0, 0.06816D0,
56575 & 0.04488D0, 0.03260D0, 0.02487D0, 0.01834D0, 0.01375D0,
56576 & 0.01038D0, 0.00783D0, 0.00588D0, 0.00440D0, 0.00327D0,
56577 & 0.00240D0, 0.00175D0, 0.00126D0, 0.00090D0, 0.00063D0,
56578 & 0.00045D0, 0.00033D0, 0.00024D0, 0.00016D0, 0.00009D0,
56579 & 0.00005D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
56580 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56581 DATA (FMRS(2,7,I,30),I=1,49)/
56582 & 11.32906D0, 8.09395D0, 5.77834D0, 4.74153D0, 4.11903D0,
56583 & 3.69178D0, 2.61985D0, 1.84528D0, 1.49390D0, 1.28038D0,
56584 & 1.12893D0, 0.75094D0, 0.47979D0, 0.36099D0, 0.29135D0,
56585 & 0.24485D0, 0.18584D0, 0.13617D0, 0.09335D0, 0.07035D0,
56586 & 0.04613D0, 0.03338D0, 0.02536D0, 0.01861D0, 0.01389D0,
56587 & 0.01045D0, 0.00785D0, 0.00587D0, 0.00438D0, 0.00324D0,
56588 & 0.00237D0, 0.00172D0, 0.00124D0, 0.00088D0, 0.00062D0,
56589 & 0.00044D0, 0.00032D0, 0.00024D0, 0.00016D0, 0.00009D0,
56590 & 0.00005D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
56591 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56592 DATA (FMRS(2,7,I,31),I=1,49)/
56593 & 12.23197D0, 8.70533D0, 6.19083D0, 5.06852D0, 4.39601D0,
56594 & 3.93512D0, 2.78170D0, 1.95161D0, 1.57633D0, 1.34878D0,
56595 & 1.18767D0, 0.78675D0, 0.50057D0, 0.37571D0, 0.30272D0,
56596 & 0.25408D0, 0.19247D0, 0.14074D0, 0.09625D0, 0.07237D0,
56597 & 0.04728D0, 0.03408D0, 0.02579D0, 0.01885D0, 0.01401D0,
56598 & 0.01049D0, 0.00785D0, 0.00586D0, 0.00435D0, 0.00321D0,
56599 & 0.00235D0, 0.00170D0, 0.00122D0, 0.00086D0, 0.00061D0,
56600 & 0.00043D0, 0.00031D0, 0.00023D0, 0.00016D0, 0.00009D0,
56601 & 0.00005D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
56602 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56603 DATA (FMRS(2,7,I,32),I=1,49)/
56604 & 13.10605D0, 9.29397D0, 6.58574D0, 5.38050D0, 4.65963D0,
56605 & 4.16627D0, 2.93446D0, 2.05131D0, 1.65329D0, 1.41245D0,
56606 & 1.24220D0, 0.81972D0, 0.51953D0, 0.38906D0, 0.31298D0,
56607 & 0.26237D0, 0.19840D0, 0.14478D0, 0.09878D0, 0.07413D0,
56608 & 0.04825D0, 0.03465D0, 0.02614D0, 0.01902D0, 0.01408D0,
56609 & 0.01051D0, 0.00784D0, 0.00583D0, 0.00432D0, 0.00318D0,
56610 & 0.00232D0, 0.00167D0, 0.00120D0, 0.00085D0, 0.00060D0,
56611 & 0.00042D0, 0.00031D0, 0.00023D0, 0.00016D0, 0.00009D0,
56612 & 0.00005D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
56613 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56614 DATA (FMRS(2,7,I,33),I=1,49)/
56615 & 14.04396D0, 9.92333D0, 7.00645D0, 5.71217D0, 4.93947D0,
56616 & 4.41134D0, 3.09586D0, 2.15625D0, 1.73413D0, 1.47923D0,
56617 & 1.29933D0, 0.85413D0, 0.53923D0, 0.40291D0, 0.32360D0,
56618 & 0.27095D0, 0.20451D0, 0.14895D0, 0.10139D0, 0.07594D0,
56619 & 0.04925D0, 0.03524D0, 0.02649D0, 0.01920D0, 0.01416D0,
56620 & 0.01053D0, 0.00783D0, 0.00580D0, 0.00428D0, 0.00315D0,
56621 & 0.00229D0, 0.00165D0, 0.00118D0, 0.00083D0, 0.00058D0,
56622 & 0.00041D0, 0.00030D0, 0.00022D0, 0.00016D0, 0.00009D0,
56623 & 0.00005D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
56624 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56625 DATA (FMRS(2,7,I,34),I=1,49)/
56626 & 14.97171D0, 10.54223D0, 7.41762D0, 6.03510D0, 5.21118D0,
56627 & 4.64879D0, 3.25111D0, 2.25643D0, 1.81093D0, 1.54244D0,
56628 & 1.35325D0, 0.88628D0, 0.55744D0, 0.41560D0, 0.33329D0,
56629 & 0.27873D0, 0.21001D0, 0.15267D0, 0.10367D0, 0.07749D0,
56630 & 0.05007D0, 0.03571D0, 0.02675D0, 0.01931D0, 0.01419D0,
56631 & 0.01051D0, 0.00779D0, 0.00576D0, 0.00424D0, 0.00311D0,
56632 & 0.00225D0, 0.00162D0, 0.00115D0, 0.00081D0, 0.00057D0,
56633 & 0.00041D0, 0.00030D0, 0.00022D0, 0.00016D0, 0.00009D0,
56634 & 0.00005D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
56635 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56636 DATA (FMRS(2,7,I,35),I=1,49)/
56637 & 15.90678D0, 11.16388D0, 7.82922D0, 6.35772D0, 5.48225D0,
56638 & 4.88541D0, 3.40531D0, 2.35558D0, 1.88678D0, 1.60477D0,
56639 & 1.40636D0, 0.91783D0, 0.57524D0, 0.42799D0, 0.34272D0,
56640 & 0.28629D0, 0.21535D0, 0.15626D0, 0.10587D0, 0.07899D0,
56641 & 0.05087D0, 0.03616D0, 0.02700D0, 0.01941D0, 0.01421D0,
56642 & 0.01050D0, 0.00776D0, 0.00572D0, 0.00420D0, 0.00307D0,
56643 & 0.00222D0, 0.00159D0, 0.00113D0, 0.00080D0, 0.00056D0,
56644 & 0.00040D0, 0.00029D0, 0.00022D0, 0.00016D0, 0.00009D0,
56645 & 0.00005D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
56646 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56647 DATA (FMRS(2,7,I,36),I=1,49)/
56648 & 16.81722D0, 11.76659D0, 8.22652D0, 6.66831D0, 5.74271D0,
56649 & 5.11243D0, 3.55252D0, 2.44976D0, 1.95860D0, 1.66366D0,
56650 & 1.45643D0, 0.94739D0, 0.59179D0, 0.43945D0, 0.35142D0,
56651 & 0.29325D0, 0.22023D0, 0.15953D0, 0.10786D0, 0.08033D0,
56652 & 0.05156D0, 0.03654D0, 0.02720D0, 0.01949D0, 0.01422D0,
56653 & 0.01047D0, 0.00772D0, 0.00567D0, 0.00416D0, 0.00303D0,
56654 & 0.00219D0, 0.00157D0, 0.00111D0, 0.00078D0, 0.00055D0,
56655 & 0.00039D0, 0.00029D0, 0.00022D0, 0.00016D0, 0.00009D0,
56656 & 0.00005D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
56657 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56658 DATA (FMRS(2,7,I,37),I=1,49)/
56659 & 17.75747D0, 12.38637D0, 8.63327D0, 6.98544D0, 6.00814D0,
56660 & 5.34342D0, 3.70158D0, 2.54461D0, 2.03070D0, 1.72263D0,
56661 & 1.50647D0, 0.97674D0, 0.60811D0, 0.45069D0, 0.35992D0,
56662 & 0.30003D0, 0.22496D0, 0.16268D0, 0.10975D0, 0.08160D0,
56663 & 0.05220D0, 0.03687D0, 0.02737D0, 0.01954D0, 0.01421D0,
56664 & 0.01044D0, 0.00767D0, 0.00562D0, 0.00411D0, 0.00299D0,
56665 & 0.00215D0, 0.00154D0, 0.00109D0, 0.00077D0, 0.00053D0,
56666 & 0.00038D0, 0.00028D0, 0.00021D0, 0.00016D0, 0.00009D0,
56667 & 0.00005D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
56668 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56669 DATA (FMRS(2,7,I,38),I=1,49)/
56670 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56671 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56672 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56673 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56674 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56675 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56676 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56677 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56678 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56679 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56680 DATA (FMRS(2,8,I, 1),I=1,49)/
56681 & 0.98494D0, 0.83942D0, 0.71517D0, 0.65113D0, 0.60921D0,
56682 & 0.57857D0, 0.49313D0, 0.42114D0, 0.38478D0, 0.36147D0,
56683 & 0.34532D0, 0.30109D0, 0.26601D0, 0.24883D0, 0.23797D0,
56684 & 0.23013D0, 0.21908D0, 0.20797D0, 0.19531D0, 0.18554D0,
56685 & 0.16898D0, 0.15367D0, 0.13862D0, 0.11992D0, 0.10161D0,
56686 & 0.08421D0, 0.06813D0, 0.05380D0, 0.04148D0, 0.03102D0,
56687 & 0.02276D0, 0.01618D0, 0.01125D0, 0.00763D0, 0.00500D0,
56688 & 0.00317D0, 0.00203D0, 0.00121D0, 0.00069D0, 0.00043D0,
56689 & 0.00027D0, 0.00012D0, 0.00011D0, 0.00003D0, 0.00000D0,
56690 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56691 DATA (FMRS(2,8,I, 2),I=1,49)/
56692 & 0.98889D0, 0.84649D0, 0.72438D0, 0.66122D0, 0.61978D0,
56693 & 0.58944D0, 0.50458D0, 0.43271D0, 0.39626D0, 0.37282D0,
56694 & 0.35655D0, 0.31168D0, 0.27538D0, 0.25719D0, 0.24547D0,
56695 & 0.23690D0, 0.22464D0, 0.21217D0, 0.19794D0, 0.18712D0,
56696 & 0.16930D0, 0.15330D0, 0.13787D0, 0.11894D0, 0.10059D0,
56697 & 0.08325D0, 0.06732D0, 0.05317D0, 0.04104D0, 0.03076D0,
56698 & 0.02264D0, 0.01619D0, 0.01134D0, 0.00776D0, 0.00516D0,
56699 & 0.00334D0, 0.00218D0, 0.00135D0, 0.00080D0, 0.00052D0,
56700 & 0.00034D0, 0.00018D0, 0.00014D0, 0.00004D0, 0.00001D0,
56701 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56702 DATA (FMRS(2,8,I, 3),I=1,49)/
56703 & 1.01222D0, 0.87111D0, 0.74946D0, 0.68626D0, 0.64467D0,
56704 & 0.61416D0, 0.52846D0, 0.45538D0, 0.41806D0, 0.39393D0,
56705 & 0.37708D0, 0.33010D0, 0.29099D0, 0.27082D0, 0.25752D0,
56706 & 0.24766D0, 0.23338D0, 0.21871D0, 0.20204D0, 0.18963D0,
56707 & 0.16990D0, 0.15288D0, 0.13686D0, 0.11759D0, 0.09914D0,
56708 & 0.08186D0, 0.06611D0, 0.05221D0, 0.04030D0, 0.03030D0,
56709 & 0.02237D0, 0.01612D0, 0.01138D0, 0.00788D0, 0.00532D0,
56710 & 0.00353D0, 0.00233D0, 0.00151D0, 0.00092D0, 0.00061D0,
56711 & 0.00042D0, 0.00024D0, 0.00016D0, 0.00005D0, 0.00002D0,
56712 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56713 DATA (FMRS(2,8,I, 4),I=1,49)/
56714 & 1.04476D0, 0.90153D0, 0.77771D0, 0.71324D0, 0.67074D0,
56715 & 0.63953D0, 0.55166D0, 0.47640D0, 0.43777D0, 0.41269D0,
56716 & 0.39507D0, 0.34558D0, 0.30362D0, 0.28161D0, 0.26695D0,
56717 & 0.25601D0, 0.24007D0, 0.22367D0, 0.20514D0, 0.19155D0,
56718 & 0.17043D0, 0.15264D0, 0.13620D0, 0.11664D0, 0.09810D0,
56719 & 0.08084D0, 0.06518D0, 0.05144D0, 0.03971D0, 0.02989D0,
56720 & 0.02211D0, 0.01600D0, 0.01135D0, 0.00790D0, 0.00539D0,
56721 & 0.00362D0, 0.00238D0, 0.00157D0, 0.00098D0, 0.00066D0,
56722 & 0.00045D0, 0.00026D0, 0.00018D0, 0.00006D0, 0.00003D0,
56723 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56724 DATA (FMRS(2,8,I, 5),I=1,49)/
56725 & 1.10026D0, 0.95040D0, 0.82069D0, 0.75308D0, 0.70848D0,
56726 & 0.67571D0, 0.58330D0, 0.50390D0, 0.46299D0, 0.43632D0,
56727 & 0.41743D0, 0.36409D0, 0.31818D0, 0.29384D0, 0.27750D0,
56728 & 0.26527D0, 0.24742D0, 0.22908D0, 0.20853D0, 0.19368D0,
56729 & 0.17108D0, 0.15248D0, 0.13556D0, 0.11567D0, 0.09702D0,
56730 & 0.07977D0, 0.06421D0, 0.05061D0, 0.03905D0, 0.02941D0,
56731 & 0.02179D0, 0.01578D0, 0.01121D0, 0.00787D0, 0.00539D0,
56732 & 0.00363D0, 0.00243D0, 0.00163D0, 0.00101D0, 0.00068D0,
56733 & 0.00046D0, 0.00028D0, 0.00020D0, 0.00007D0, 0.00002D0,
56734 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56735 DATA (FMRS(2,8,I, 6),I=1,49)/
56736 & 1.15923D0, 1.00143D0, 0.86481D0, 0.79358D0, 0.74658D0,
56737 & 0.71202D0, 0.61454D0, 0.53061D0, 0.48723D0, 0.45888D0,
56738 & 0.43867D0, 0.38135D0, 0.33152D0, 0.30491D0, 0.28699D0,
56739 & 0.27355D0, 0.25394D0, 0.23384D0, 0.21150D0, 0.19554D0,
56740 & 0.17166D0, 0.15236D0, 0.13502D0, 0.11484D0, 0.09608D0,
56741 & 0.07883D0, 0.06335D0, 0.04988D0, 0.03847D0, 0.02897D0,
56742 & 0.02148D0, 0.01557D0, 0.01108D0, 0.00781D0, 0.00536D0,
56743 & 0.00363D0, 0.00245D0, 0.00167D0, 0.00103D0, 0.00070D0,
56744 & 0.00046D0, 0.00029D0, 0.00021D0, 0.00007D0, 0.00002D0,
56745 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56746 DATA (FMRS(2,8,I, 7),I=1,49)/
56747 & 1.23248D0, 1.06345D0, 0.91726D0, 0.84109D0, 0.79085D0,
56748 & 0.75393D0, 0.64976D0, 0.56002D0, 0.51357D0, 0.48314D0,
56749 & 0.46132D0, 0.39931D0, 0.34507D0, 0.31602D0, 0.29642D0,
56750 & 0.28173D0, 0.26034D0, 0.23848D0, 0.21438D0, 0.19736D0,
56751 & 0.17224D0, 0.15227D0, 0.13452D0, 0.11404D0, 0.09516D0,
56752 & 0.07789D0, 0.06251D0, 0.04914D0, 0.03786D0, 0.02851D0,
56753 & 0.02113D0, 0.01532D0, 0.01096D0, 0.00772D0, 0.00530D0,
56754 & 0.00360D0, 0.00243D0, 0.00166D0, 0.00104D0, 0.00071D0,
56755 & 0.00048D0, 0.00030D0, 0.00020D0, 0.00008D0, 0.00002D0,
56756 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56757 DATA (FMRS(2,8,I, 8),I=1,49)/
56758 & 1.32548D0, 1.14118D0, 0.98212D0, 0.89937D0, 0.84484D0,
56759 & 0.80478D0, 0.69187D0, 0.59465D0, 0.54428D0, 0.51124D0,
56760 & 0.48741D0, 0.41964D0, 0.36014D0, 0.32825D0, 0.30675D0,
56761 & 0.29065D0, 0.26725D0, 0.24348D0, 0.21747D0, 0.19931D0,
56762 & 0.17288D0, 0.15217D0, 0.13398D0, 0.11319D0, 0.09418D0,
56763 & 0.07689D0, 0.06158D0, 0.04833D0, 0.03719D0, 0.02798D0,
56764 & 0.02073D0, 0.01504D0, 0.01077D0, 0.00760D0, 0.00523D0,
56765 & 0.00355D0, 0.00240D0, 0.00165D0, 0.00105D0, 0.00070D0,
56766 & 0.00048D0, 0.00029D0, 0.00020D0, 0.00007D0, 0.00002D0,
56767 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56768 DATA (FMRS(2,8,I, 9),I=1,49)/
56769 & 1.41996D0, 1.21934D0, 1.04662D0, 0.95694D0, 0.89790D0,
56770 & 0.85457D0, 0.73259D0, 0.62769D0, 0.57336D0, 0.53768D0,
56771 & 0.51185D0, 0.43840D0, 0.37384D0, 0.33927D0, 0.31599D0,
56772 & 0.29859D0, 0.27338D0, 0.24788D0, 0.22018D0, 0.20102D0,
56773 & 0.17344D0, 0.15210D0, 0.13351D0, 0.11246D0, 0.09333D0,
56774 & 0.07602D0, 0.06075D0, 0.04762D0, 0.03659D0, 0.02749D0,
56775 & 0.02036D0, 0.01479D0, 0.01057D0, 0.00748D0, 0.00516D0,
56776 & 0.00349D0, 0.00238D0, 0.00163D0, 0.00104D0, 0.00069D0,
56777 & 0.00047D0, 0.00028D0, 0.00019D0, 0.00006D0, 0.00002D0,
56778 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56779 DATA (FMRS(2,8,I,10),I=1,49)/
56780 & 1.52623D0, 1.30628D0, 1.11753D0, 1.01977D0, 0.95552D0,
56781 & 0.90841D0, 0.77603D0, 0.66243D0, 0.60365D0, 0.56506D0,
56782 & 0.53703D0, 0.45743D0, 0.38751D0, 0.35017D0, 0.32507D0,
56783 & 0.30636D0, 0.27933D0, 0.25214D0, 0.22280D0, 0.20266D0,
56784 & 0.17397D0, 0.15202D0, 0.13306D0, 0.11174D0, 0.09248D0,
56785 & 0.07516D0, 0.05994D0, 0.04691D0, 0.03600D0, 0.02702D0,
56786 & 0.02000D0, 0.01454D0, 0.01039D0, 0.00736D0, 0.00507D0,
56787 & 0.00344D0, 0.00235D0, 0.00162D0, 0.00103D0, 0.00069D0,
56788 & 0.00047D0, 0.00027D0, 0.00019D0, 0.00006D0, 0.00002D0,
56789 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56790 DATA (FMRS(2,8,I,11),I=1,49)/
56791 & 1.61996D0, 1.38242D0, 1.17917D0, 1.07414D0, 1.00521D0,
56792 & 0.95472D0, 0.81307D0, 0.69180D0, 0.62911D0, 0.58797D0,
56793 & 0.55803D0, 0.47313D0, 0.39867D0, 0.35901D0, 0.33241D0,
56794 & 0.31262D0, 0.28411D0, 0.25553D0, 0.22487D0, 0.20396D0,
56795 & 0.17439D0, 0.15196D0, 0.13270D0, 0.11116D0, 0.09180D0,
56796 & 0.07446D0, 0.05929D0, 0.04635D0, 0.03552D0, 0.02665D0,
56797 & 0.01972D0, 0.01433D0, 0.01024D0, 0.00726D0, 0.00500D0,
56798 & 0.00340D0, 0.00233D0, 0.00161D0, 0.00102D0, 0.00069D0,
56799 & 0.00047D0, 0.00027D0, 0.00019D0, 0.00006D0, 0.00002D0,
56800 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56801 DATA (FMRS(2,8,I,12),I=1,49)/
56802 & 1.85147D0, 1.56851D0, 1.32816D0, 1.20469D0, 1.12394D0,
56803 & 1.06494D0, 0.90014D0, 0.75989D0, 0.68768D0, 0.64036D0,
56804 & 0.60582D0, 0.50832D0, 0.42330D0, 0.37835D0, 0.34837D0,
56805 & 0.32616D0, 0.29437D0, 0.26278D0, 0.22928D0, 0.20671D0,
56806 & 0.17525D0, 0.15178D0, 0.13188D0, 0.10989D0, 0.09032D0,
56807 & 0.07294D0, 0.05789D0, 0.04511D0, 0.03448D0, 0.02582D0,
56808 & 0.01907D0, 0.01385D0, 0.00987D0, 0.00700D0, 0.00482D0,
56809 & 0.00328D0, 0.00224D0, 0.00154D0, 0.00100D0, 0.00066D0,
56810 & 0.00045D0, 0.00027D0, 0.00019D0, 0.00006D0, 0.00002D0,
56811 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56812 DATA (FMRS(2,8,I,13),I=1,49)/
56813 & 2.08649D0, 1.75519D0, 1.47580D0, 1.33308D0, 1.24007D0,
56814 & 1.17230D0, 0.98378D0, 0.82434D0, 0.74261D0, 0.68917D0,
56815 & 0.65012D0, 0.54038D0, 0.44535D0, 0.39548D0, 0.36240D0,
56816 & 0.33801D0, 0.30327D0, 0.26901D0, 0.23303D0, 0.20903D0,
56817 & 0.17595D0, 0.15158D0, 0.13113D0, 0.10875D0, 0.08901D0,
56818 & 0.07161D0, 0.05666D0, 0.04403D0, 0.03356D0, 0.02508D0,
56819 & 0.01848D0, 0.01341D0, 0.00954D0, 0.00676D0, 0.00467D0,
56820 & 0.00317D0, 0.00216D0, 0.00148D0, 0.00096D0, 0.00064D0,
56821 & 0.00043D0, 0.00027D0, 0.00018D0, 0.00006D0, 0.00002D0,
56822 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56823 DATA (FMRS(2,8,I,14),I=1,49)/
56824 & 2.39126D0, 1.99450D0, 1.66281D0, 1.49454D0, 1.38536D0,
56825 & 1.30604D0, 1.08660D0, 0.90248D0, 0.80863D0, 0.74747D0,
56826 & 0.70276D0, 0.57787D0, 0.47070D0, 0.41497D0, 0.37825D0,
56827 & 0.35132D0, 0.31319D0, 0.27591D0, 0.23714D0, 0.21153D0,
56828 & 0.17666D0, 0.15129D0, 0.13023D0, 0.10742D0, 0.08751D0,
56829 & 0.07010D0, 0.05525D0, 0.04280D0, 0.03250D0, 0.02426D0,
56830 & 0.01784D0, 0.01291D0, 0.00918D0, 0.00650D0, 0.00451D0,
56831 & 0.00308D0, 0.00210D0, 0.00146D0, 0.00091D0, 0.00061D0,
56832 & 0.00040D0, 0.00024D0, 0.00017D0, 0.00007D0, 0.00002D0,
56833 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56834 DATA (FMRS(2,8,I,15),I=1,49)/
56835 & 2.76033D0, 2.28068D0, 1.88356D0, 1.68366D0, 1.55456D0,
56836 & 1.46111D0, 1.20412D0, 0.99043D0, 0.88227D0, 0.81205D0,
56837 & 0.76076D0, 0.61847D0, 0.49766D0, 0.43549D0, 0.39480D0,
56838 & 0.36513D0, 0.32340D0, 0.28293D0, 0.24126D0, 0.21400D0,
56839 & 0.17728D0, 0.15089D0, 0.12922D0, 0.10598D0, 0.08590D0,
56840 & 0.06852D0, 0.05375D0, 0.04146D0, 0.03141D0, 0.02338D0,
56841 & 0.01716D0, 0.01238D0, 0.00882D0, 0.00618D0, 0.00431D0,
56842 & 0.00292D0, 0.00200D0, 0.00136D0, 0.00088D0, 0.00058D0,
56843 & 0.00038D0, 0.00023D0, 0.00015D0, 0.00006D0, 0.00002D0,
56844 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56845 DATA (FMRS(2,8,I,16),I=1,49)/
56846 & 3.14075D0, 2.57242D0, 2.10607D0, 1.87299D0, 1.72314D0,
56847 & 1.61501D0, 1.31935D0, 1.07560D0, 0.95301D0, 0.87374D0,
56848 & 0.81592D0, 0.65651D0, 0.52253D0, 0.45423D0, 0.40982D0,
56849 & 0.37760D0, 0.33254D0, 0.28915D0, 0.24485D0, 0.21612D0,
56850 & 0.17773D0, 0.15044D0, 0.12821D0, 0.10460D0, 0.08439D0,
56851 & 0.06702D0, 0.05238D0, 0.04027D0, 0.03041D0, 0.02258D0,
56852 & 0.01653D0, 0.01190D0, 0.00847D0, 0.00593D0, 0.00412D0,
56853 & 0.00279D0, 0.00191D0, 0.00129D0, 0.00084D0, 0.00056D0,
56854 & 0.00036D0, 0.00023D0, 0.00014D0, 0.00006D0, 0.00002D0,
56855 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56856 DATA (FMRS(2,8,I,17),I=1,49)/
56857 & 3.57238D0, 2.90007D0, 2.35339D0, 2.08215D0, 1.90855D0,
56858 & 1.78371D0, 1.44428D0, 1.16687D0, 1.02831D0, 0.93907D0,
56859 & 0.87409D0, 0.69611D0, 0.54805D0, 0.47331D0, 0.42502D0,
56860 & 0.39015D0, 0.34166D0, 0.29530D0, 0.24836D0, 0.21814D0,
56861 & 0.17810D0, 0.14991D0, 0.12715D0, 0.10317D0, 0.08284D0,
56862 & 0.06549D0, 0.05101D0, 0.03909D0, 0.02941D0, 0.02178D0,
56863 & 0.01590D0, 0.01142D0, 0.00811D0, 0.00570D0, 0.00393D0,
56864 & 0.00267D0, 0.00181D0, 0.00123D0, 0.00079D0, 0.00053D0,
56865 & 0.00034D0, 0.00022D0, 0.00013D0, 0.00006D0, 0.00001D0,
56866 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56867 DATA (FMRS(2,8,I,18),I=1,49)/
56868 & 3.96850D0, 3.19797D0, 2.57613D0, 2.26945D0, 2.07391D0,
56869 & 1.93368D0, 1.55423D0, 1.24636D0, 1.09346D0, 0.99533D0,
56870 & 0.92399D0, 0.72966D0, 0.56941D0, 0.48914D0, 0.43755D0,
56871 & 0.40046D0, 0.34910D0, 0.30027D0, 0.25115D0, 0.21971D0,
56872 & 0.17833D0, 0.14941D0, 0.12622D0, 0.10197D0, 0.08154D0,
56873 & 0.06423D0, 0.04986D0, 0.03809D0, 0.02858D0, 0.02112D0,
56874 & 0.01538D0, 0.01101D0, 0.00783D0, 0.00549D0, 0.00377D0,
56875 & 0.00256D0, 0.00173D0, 0.00118D0, 0.00076D0, 0.00050D0,
56876 & 0.00033D0, 0.00020D0, 0.00012D0, 0.00005D0, 0.00002D0,
56877 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56878 DATA (FMRS(2,8,I,19),I=1,49)/
56879 & 4.49525D0, 3.59055D0, 2.86699D0, 2.51271D0, 2.28784D0,
56880 & 2.12710D0, 1.69466D0, 1.34689D0, 1.17536D0, 1.06574D0,
56881 & 0.98622D0, 0.77102D0, 0.59540D0, 0.50826D0, 0.45260D0,
56882 & 0.41278D0, 0.35791D0, 0.30610D0, 0.25436D0, 0.22147D0,
56883 & 0.17849D0, 0.14870D0, 0.12502D0, 0.10045D0, 0.07994D0,
56884 & 0.06271D0, 0.04847D0, 0.03689D0, 0.02761D0, 0.02033D0,
56885 & 0.01477D0, 0.01056D0, 0.00749D0, 0.00523D0, 0.00359D0,
56886 & 0.00243D0, 0.00165D0, 0.00112D0, 0.00070D0, 0.00047D0,
56887 & 0.00031D0, 0.00018D0, 0.00012D0, 0.00004D0, 0.00002D0,
56888 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56889 DATA (FMRS(2,8,I,20),I=1,49)/
56890 & 5.00899D0, 3.97007D0, 3.14567D0, 2.74457D0, 2.49097D0,
56891 & 2.31023D0, 1.82640D0, 1.44029D0, 1.25101D0, 1.13051D0,
56892 & 1.04327D0, 0.80852D0, 0.61869D0, 0.52527D0, 0.46592D0,
56893 & 0.42363D0, 0.36563D0, 0.31116D0, 0.25711D0, 0.22294D0,
56894 & 0.17857D0, 0.14803D0, 0.12392D0, 0.09909D0, 0.07852D0,
56895 & 0.06137D0, 0.04727D0, 0.03584D0, 0.02676D0, 0.01965D0,
56896 & 0.01424D0, 0.01018D0, 0.00720D0, 0.00501D0, 0.00343D0,
56897 & 0.00232D0, 0.00157D0, 0.00107D0, 0.00066D0, 0.00045D0,
56898 & 0.00029D0, 0.00018D0, 0.00012D0, 0.00004D0, 0.00001D0,
56899 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56900 DATA (FMRS(2,8,I,21),I=1,49)/
56901 & 5.51448D0, 4.34048D0, 3.41543D0, 2.96790D0, 2.68596D0,
56902 & 2.48552D0, 1.95141D0, 1.52811D0, 1.32176D0, 1.19083D0,
56903 & 1.09623D0, 0.84295D0, 0.63982D0, 0.54059D0, 0.47785D0,
56904 & 0.43329D0, 0.37244D0, 0.31558D0, 0.25945D0, 0.22413D0,
56905 & 0.17852D0, 0.14733D0, 0.12285D0, 0.09781D0, 0.07721D0,
56906 & 0.06012D0, 0.04616D0, 0.03490D0, 0.02597D0, 0.01904D0,
56907 & 0.01376D0, 0.00981D0, 0.00692D0, 0.00481D0, 0.00330D0,
56908 & 0.00222D0, 0.00150D0, 0.00102D0, 0.00064D0, 0.00042D0,
56909 & 0.00028D0, 0.00017D0, 0.00011D0, 0.00004D0, 0.00001D0,
56910 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56911 DATA (FMRS(2,8,I,22),I=1,49)/
56912 & 6.21231D0, 4.84766D0, 3.78177D0, 3.26973D0, 2.94855D0,
56913 & 2.72097D0, 2.11789D0, 1.64406D0, 1.41467D0, 1.26974D0,
56914 & 1.16528D0, 0.88741D0, 0.66681D0, 0.56001D0, 0.49289D0,
56915 & 0.44543D0, 0.38094D0, 0.32104D0, 0.26228D0, 0.22553D0,
56916 & 0.17838D0, 0.14638D0, 0.12146D0, 0.09617D0, 0.07554D0,
56917 & 0.05855D0, 0.04477D0, 0.03372D0, 0.02502D0, 0.01828D0,
56918 & 0.01316D0, 0.00936D0, 0.00658D0, 0.00457D0, 0.00313D0,
56919 & 0.00210D0, 0.00142D0, 0.00097D0, 0.00060D0, 0.00039D0,
56920 & 0.00026D0, 0.00016D0, 0.00010D0, 0.00004D0, 0.00001D0,
56921 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56922 DATA (FMRS(2,8,I,23),I=1,49)/
56923 & 6.92819D0, 5.36347D0, 4.15110D0, 3.57245D0, 3.21096D0,
56924 & 2.95557D0, 2.28227D0, 1.75749D0, 1.50504D0, 1.34618D0,
56925 & 1.23195D0, 0.92986D0, 0.69228D0, 0.57821D0, 0.50690D0,
56926 & 0.45669D0, 0.38876D0, 0.32601D0, 0.26481D0, 0.22674D0,
56927 & 0.17816D0, 0.14541D0, 0.12011D0, 0.09461D0, 0.07396D0,
56928 & 0.05707D0, 0.04348D0, 0.03263D0, 0.02417D0, 0.01758D0,
56929 & 0.01264D0, 0.00894D0, 0.00628D0, 0.00436D0, 0.00298D0,
56930 & 0.00199D0, 0.00135D0, 0.00091D0, 0.00057D0, 0.00037D0,
56931 & 0.00024D0, 0.00015D0, 0.00010D0, 0.00004D0, 0.00001D0,
56932 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56933 DATA (FMRS(2,8,I,24),I=1,49)/
56934 & 7.64199D0, 5.87362D0, 4.51337D0, 3.86793D0, 3.46620D0,
56935 & 3.18314D0, 2.44035D0, 1.86558D0, 1.59069D0, 1.41834D0,
56936 & 1.29468D0, 0.96937D0, 0.71569D0, 0.59480D0, 0.51959D0,
56937 & 0.46683D0, 0.39572D0, 0.33035D0, 0.26693D0, 0.22767D0,
56938 & 0.17780D0, 0.14441D0, 0.11876D0, 0.09309D0, 0.07246D0,
56939 & 0.05571D0, 0.04226D0, 0.03164D0, 0.02333D0, 0.01693D0,
56940 & 0.01213D0, 0.00857D0, 0.00600D0, 0.00415D0, 0.00282D0,
56941 & 0.00189D0, 0.00128D0, 0.00086D0, 0.00054D0, 0.00035D0,
56942 & 0.00022D0, 0.00014D0, 0.00009D0, 0.00003D0, 0.00001D0,
56943 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56944 DATA (FMRS(2,8,I,25),I=1,49)/
56945 & 8.41285D0, 6.42055D0, 4.89893D0, 4.18106D0, 3.73585D0,
56946 & 3.42298D0, 2.60571D0, 1.97779D0, 1.67919D0, 1.49264D0,
56947 & 1.35909D0, 1.00958D0, 0.73928D0, 0.61142D0, 0.53225D0,
56948 & 0.47690D0, 0.40260D0, 0.33461D0, 0.26898D0, 0.22853D0,
56949 & 0.17741D0, 0.14339D0, 0.11741D0, 0.09159D0, 0.07099D0,
56950 & 0.05437D0, 0.04108D0, 0.03067D0, 0.02252D0, 0.01631D0,
56951 & 0.01165D0, 0.00822D0, 0.00574D0, 0.00396D0, 0.00268D0,
56952 & 0.00180D0, 0.00120D0, 0.00081D0, 0.00050D0, 0.00033D0,
56953 & 0.00021D0, 0.00013D0, 0.00008D0, 0.00003D0, 0.00001D0,
56954 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56955 DATA (FMRS(2,8,I,26),I=1,49)/
56956 & 9.21054D0, 6.98238D0, 5.29207D0, 4.49895D0, 4.00873D0,
56957 & 3.66510D0, 2.77134D0, 2.08927D0, 1.76669D0, 1.56583D0,
56958 & 1.42235D0, 1.04868D0, 0.76198D0, 0.62728D0, 0.54426D0,
56959 & 0.48640D0, 0.40901D0, 0.33853D0, 0.27078D0, 0.22922D0,
56960 & 0.17691D0, 0.14232D0, 0.11604D0, 0.09010D0, 0.06954D0,
56961 & 0.05305D0, 0.03996D0, 0.02972D0, 0.02176D0, 0.01572D0,
56962 & 0.01122D0, 0.00790D0, 0.00548D0, 0.00378D0, 0.00255D0,
56963 & 0.00171D0, 0.00115D0, 0.00078D0, 0.00048D0, 0.00031D0,
56964 & 0.00020D0, 0.00012D0, 0.00008D0, 0.00002D0, 0.00001D0,
56965 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56966 DATA (FMRS(2,8,I,27),I=1,49)/
56967 & 10.01421D0, 7.54466D0, 5.68289D0, 4.81371D0, 4.27818D0,
56968 & 3.90363D0, 2.93340D0, 2.19757D0, 1.85131D0, 1.63639D0,
56969 & 1.48318D0, 1.08596D0, 0.78341D0, 0.64217D0, 0.55547D0,
56970 & 0.49525D0, 0.41494D0, 0.34210D0, 0.27239D0, 0.22977D0,
56971 & 0.17638D0, 0.14126D0, 0.11473D0, 0.08869D0, 0.06818D0,
56972 & 0.05182D0, 0.03892D0, 0.02884D0, 0.02107D0, 0.01518D0,
56973 & 0.01082D0, 0.00760D0, 0.00526D0, 0.00363D0, 0.00244D0,
56974 & 0.00163D0, 0.00110D0, 0.00075D0, 0.00046D0, 0.00030D0,
56975 & 0.00019D0, 0.00012D0, 0.00007D0, 0.00002D0, 0.00001D0,
56976 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56977 DATA (FMRS(2,8,I,28),I=1,49)/
56978 & 10.81038D0, 8.09822D0, 6.06522D0, 5.12048D0, 4.54007D0,
56979 & 4.13500D0, 3.08954D0, 2.30121D0, 1.93196D0, 1.70343D0,
56980 & 1.54082D0, 1.12100D0, 0.80336D0, 0.65594D0, 0.56579D0,
56981 & 0.50334D0, 0.42032D0, 0.34528D0, 0.27377D0, 0.23019D0,
56982 & 0.17582D0, 0.14022D0, 0.11347D0, 0.08735D0, 0.06690D0,
56983 & 0.05067D0, 0.03795D0, 0.02804D0, 0.02043D0, 0.01468D0,
56984 & 0.01043D0, 0.00733D0, 0.00506D0, 0.00348D0, 0.00235D0,
56985 & 0.00155D0, 0.00105D0, 0.00071D0, 0.00043D0, 0.00029D0,
56986 & 0.00018D0, 0.00011D0, 0.00007D0, 0.00002D0, 0.00001D0,
56987 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56988 DATA (FMRS(2,8,I,29),I=1,49)/
56989 & 11.65265D0, 8.68040D0, 6.46494D0, 5.44008D0, 4.81224D0,
56990 & 4.37498D0, 3.25050D0, 2.40736D0, 2.01424D0, 1.77163D0,
56991 & 1.59933D0, 1.15629D0, 0.82328D0, 0.66961D0, 0.57598D0,
56992 & 0.51130D0, 0.42557D0, 0.34836D0, 0.27505D0, 0.23054D0,
56993 & 0.17519D0, 0.13914D0, 0.11219D0, 0.08600D0, 0.06563D0,
56994 & 0.04954D0, 0.03699D0, 0.02726D0, 0.01981D0, 0.01419D0,
56995 & 0.01006D0, 0.00705D0, 0.00487D0, 0.00334D0, 0.00225D0,
56996 & 0.00148D0, 0.00100D0, 0.00068D0, 0.00041D0, 0.00027D0,
56997 & 0.00017D0, 0.00010D0, 0.00006D0, 0.00002D0, 0.00001D0,
56998 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56999 DATA (FMRS(2,8,I,30),I=1,49)/
57000 & 12.51775D0, 9.27489D0, 6.87071D0, 5.76340D0, 5.08688D0,
57001 & 4.61667D0, 3.41161D0, 2.51293D0, 2.09575D0, 1.83900D0,
57002 & 1.65698D0, 1.19078D0, 0.84258D0, 0.68277D0, 0.58574D0,
57003 & 0.51889D0, 0.43052D0, 0.35121D0, 0.27618D0, 0.23078D0,
57004 & 0.17451D0, 0.13804D0, 0.11091D0, 0.08467D0, 0.06438D0,
57005 & 0.04844D0, 0.03605D0, 0.02651D0, 0.01920D0, 0.01373D0,
57006 & 0.00970D0, 0.00677D0, 0.00468D0, 0.00321D0, 0.00215D0,
57007 & 0.00142D0, 0.00096D0, 0.00064D0, 0.00040D0, 0.00026D0,
57008 & 0.00017D0, 0.00010D0, 0.00006D0, 0.00002D0, 0.00001D0,
57009 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57010 DATA (FMRS(2,8,I,31),I=1,49)/
57011 & 13.38188D0, 9.86555D0, 7.27170D0, 6.08188D0, 5.35680D0,
57012 & 4.85378D0, 3.56878D0, 2.61532D0, 2.17453D0, 1.90394D0,
57013 & 1.71244D0, 1.22374D0, 0.86087D0, 0.69518D0, 0.59491D0,
57014 & 0.52599D0, 0.43513D0, 0.35383D0, 0.27719D0, 0.23095D0,
57015 & 0.17383D0, 0.13697D0, 0.10968D0, 0.08342D0, 0.06322D0,
57016 & 0.04742D0, 0.03518D0, 0.02580D0, 0.01865D0, 0.01331D0,
57017 & 0.00937D0, 0.00652D0, 0.00451D0, 0.00308D0, 0.00206D0,
57018 & 0.00136D0, 0.00092D0, 0.00061D0, 0.00038D0, 0.00024D0,
57019 & 0.00016D0, 0.00010D0, 0.00006D0, 0.00002D0, 0.00001D0,
57020 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57021 DATA (FMRS(2,8,I,32),I=1,49)/
57022 & 14.22455D0, 10.43853D0, 7.65861D0, 6.38821D0, 5.61583D0,
57023 & 5.08091D0, 3.71848D0, 2.71227D0, 2.24884D0, 1.96503D0,
57024 & 1.76449D0, 1.25443D0, 0.87775D0, 0.70654D0, 0.60325D0,
57025 & 0.53242D0, 0.43925D0, 0.35613D0, 0.27800D0, 0.23100D0,
57026 & 0.17312D0, 0.13592D0, 0.10849D0, 0.08223D0, 0.06212D0,
57027 & 0.04645D0, 0.03438D0, 0.02514D0, 0.01814D0, 0.01292D0,
57028 & 0.00909D0, 0.00631D0, 0.00435D0, 0.00297D0, 0.00198D0,
57029 & 0.00130D0, 0.00088D0, 0.00059D0, 0.00036D0, 0.00023D0,
57030 & 0.00015D0, 0.00009D0, 0.00006D0, 0.00002D0, 0.00000D0,
57031 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57032 DATA (FMRS(2,8,I,33),I=1,49)/
57033 & 15.12220D0, 11.04609D0, 8.06700D0, 6.71068D0, 5.88799D0,
57034 & 5.31921D0, 3.87481D0, 2.81304D0, 2.32586D0, 2.02823D0,
57035 & 1.81825D0, 1.28597D0, 0.89499D0, 0.71812D0, 0.61173D0,
57036 & 0.53894D0, 0.44342D0, 0.35844D0, 0.27882D0, 0.23104D0,
57037 & 0.17241D0, 0.13488D0, 0.10730D0, 0.08105D0, 0.06103D0,
57038 & 0.04549D0, 0.03359D0, 0.02450D0, 0.01765D0, 0.01253D0,
57039 & 0.00880D0, 0.00610D0, 0.00420D0, 0.00286D0, 0.00191D0,
57040 & 0.00125D0, 0.00083D0, 0.00057D0, 0.00034D0, 0.00022D0,
57041 & 0.00014D0, 0.00008D0, 0.00005D0, 0.00002D0, 0.00000D0,
57042 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57043 DATA (FMRS(2,8,I,34),I=1,49)/
57044 & 16.02044D0, 11.65091D0, 8.47137D0, 7.02895D0, 6.15599D0,
57045 & 5.55343D0, 4.02757D0, 2.91088D0, 2.40036D0, 2.08916D0,
57046 & 1.86995D0, 1.31603D0, 0.91125D0, 0.72894D0, 0.61960D0,
57047 & 0.54494D0, 0.44718D0, 0.36046D0, 0.27943D0, 0.23094D0,
57048 & 0.17160D0, 0.13377D0, 0.10610D0, 0.07985D0, 0.05994D0,
57049 & 0.04455D0, 0.03282D0, 0.02388D0, 0.01715D0, 0.01216D0,
57050 & 0.00853D0, 0.00590D0, 0.00405D0, 0.00275D0, 0.00184D0,
57051 & 0.00120D0, 0.00080D0, 0.00054D0, 0.00033D0, 0.00021D0,
57052 & 0.00013D0, 0.00008D0, 0.00005D0, 0.00002D0, 0.00000D0,
57053 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57054 DATA (FMRS(2,8,I,35),I=1,49)/
57055 & 16.92092D0, 12.25466D0, 8.87333D0, 7.34454D0, 6.42124D0,
57056 & 5.78493D0, 4.17791D0, 3.00675D0, 2.47316D0, 2.14860D0,
57057 & 1.92031D0, 1.34518D0, 0.92693D0, 0.73935D0, 0.62715D0,
57058 & 0.55068D0, 0.45078D0, 0.36238D0, 0.28002D0, 0.23083D0,
57059 & 0.17082D0, 0.13273D0, 0.10496D0, 0.07873D0, 0.05891D0,
57060 & 0.04367D0, 0.03209D0, 0.02331D0, 0.01669D0, 0.01182D0,
57061 & 0.00827D0, 0.00571D0, 0.00391D0, 0.00265D0, 0.00178D0,
57062 & 0.00117D0, 0.00077D0, 0.00052D0, 0.00031D0, 0.00020D0,
57063 & 0.00012D0, 0.00008D0, 0.00005D0, 0.00002D0, 0.00000D0,
57064 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57065 DATA (FMRS(2,8,I,36),I=1,49)/
57066 & 17.79951D0, 12.84117D0, 9.26208D0, 7.64895D0, 6.67663D0,
57067 & 6.00749D0, 4.32176D0, 3.09803D0, 2.54226D0, 2.20489D0,
57068 & 1.96790D0, 1.37254D0, 0.94153D0, 0.74899D0, 0.63410D0,
57069 & 0.55594D0, 0.45404D0, 0.36409D0, 0.28048D0, 0.23067D0,
57070 & 0.17006D0, 0.13172D0, 0.10387D0, 0.07767D0, 0.05796D0,
57071 & 0.04286D0, 0.03142D0, 0.02277D0, 0.01627D0, 0.01150D0,
57072 & 0.00803D0, 0.00554D0, 0.00379D0, 0.00256D0, 0.00172D0,
57073 & 0.00113D0, 0.00074D0, 0.00050D0, 0.00030D0, 0.00019D0,
57074 & 0.00012D0, 0.00007D0, 0.00005D0, 0.00002D0, 0.00000D0,
57075 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57076 DATA (FMRS(2,8,I,37),I=1,49)/
57077 & 18.71000D0, 13.44641D0, 9.66151D0, 7.96092D0, 6.93787D0,
57078 & 6.23483D0, 4.46802D0, 3.19039D0, 2.61196D0, 2.26153D0,
57079 & 2.01571D0, 1.39986D0, 0.95599D0, 0.75847D0, 0.64090D0,
57080 & 0.56106D0, 0.45717D0, 0.36568D0, 0.28085D0, 0.23044D0,
57081 & 0.16924D0, 0.13067D0, 0.10276D0, 0.07660D0, 0.05700D0,
57082 & 0.04204D0, 0.03075D0, 0.02224D0, 0.01586D0, 0.01118D0,
57083 & 0.00780D0, 0.00537D0, 0.00367D0, 0.00247D0, 0.00167D0,
57084 & 0.00108D0, 0.00071D0, 0.00047D0, 0.00029D0, 0.00018D0,
57085 & 0.00011D0, 0.00006D0, 0.00004D0, 0.00002D0, 0.00000D0,
57086 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57087 DATA (FMRS(2,8,I,38),I=1,49)/
57088 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57089 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57090 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57091 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57092 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57093 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57094 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57095 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57096 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57097 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57100 *CMZ :- -27/07/99 13.33.03 by Mike Seymour
57101 *-- Author : Ian Knowles
57102 C-----------------------------------------------------------------------
57103 SUBROUTINE HWUDKL(ID,PMOM,DISP)
57104 C-----------------------------------------------------------------------
57105 C Given a real or virtual particle, flavour ID and 4-momentum PMOM,
57106 C returns DISP its distance travelled in mm.
57108 C Modified 16/01/01 by BRW to force particle on mass shell if
57109 C p^2-m^2 < 10^-10 GeV^2 (rounding errors)
57110 C-----------------------------------------------------------------------
57111 INCLUDE 'HERWIG65.INC'
57112 DOUBLE PRECISION HWRGEN,PMOM(4),DISP(4),PMOM2,SCALE,OFFSH
57115 PMOM2=(PMOM(4)+PMOM(3))*(PMOM(4)-PMOM(3))-PMOM(1)**2-PMOM(2)**2
57116 OFFSH=PMOM2-RMASS(ID)**2
57117 IF (OFFSH.LT.1D-10) OFFSH=ZERO
57118 SCALE=-GEV2MM*LOG(HWRGEN(0))/SQRT(OFFSH**2+(PMOM2/DKLTM(ID))**2)
57119 IF (ID.GT.197.AND.ID.LT.203) SCALE=SCALE*EXAG
57120 CALL HWVSCA(4,SCALE,PMOM,DISP)
57122 C-----------------------------------------------------------------------
57124 *CMZ :- -27/07/99 13.33.03 by Mike Seymour
57125 *-- Author : Ian Knowles
57126 C-----------------------------------------------------------------------
57128 C-----------------------------------------------------------------------
57129 C Sets up internal pointers based on the decay table in HWUDAT or as
57130 C supplied via HWIODK. Computes CoM momenta of two-body decay modes.
57131 C Particles with long lifetimes or no allowed decay (excepting light
57132 C b hadrons when CLEO/EURODEC decays requested) are set stable, else
57133 C calculate DKLTM(I) = mass/width ( = mass * lifetime/hbar).
57134 C Gives warnings if: a particle has no decay modes or antiparticle's
57135 C modes are not the charge conjugates of the particles.
57136 C (N.B. CP violation permits this).
57137 C-----------------------------------------------------------------------
57138 INCLUDE 'HERWIG65.INC'
57139 DOUBLE PRECISION HWUPCM,HWUAEM,HWUALF,BRSUM,EPS,SCALE,
57140 & BRTMP(NMXDKS),FN,X,W,Q,FAC
57141 INTEGER HWUANT,I,IDKY,LAST,LTMP(NMXMOD),J,L,K,M,N,INDX(NMXMOD),
57142 & IRES,IAPDG,IPART,LR,LP,KPRDLR
57143 LOGICAL BPDK,TOPDKS,MATCH(5),PMATCH(NMXMOD)
57144 CHARACTER*7 CVETO(2)
57146 EXTERNAL HWUPCM,HWUAEM,HWUALF,HWUANT
57147 PARAMETER(EPS=1.E-6)
57148 FN(X,Q,W)=X**4/(((X*X-Q*Q)**2+W*W*(X*X+Q*Q)-2.*W**4)
57149 & *SQRT(X**4+Q**4+W**4-2.*(X*X*Q*Q+X*X*W*W+Q*Q*W*W)))
57151 10 FORMAT(/10X,'Checking consistency of decay tables'/)
57153 C First zero arrays
57161 BPDK=BDECAY.NE.'HERW'
57163 C Search for next decaying particle type
57165 C Skip if particle is not recognised or already dealt with
57166 IF (IDKY.EQ.0.OR.IDKY.EQ.20) THEN
57168 40 FORMAT(1X,'Line ',I4,': decaying particle not recognised')
57171 IF (NMODES(IDKY).GT.0) GOTO 180
57172 C Check and include first decay mode, storing a copy
57173 CALL HWDCHK(IDKY,I,*180)
57178 BRTMP(1)=-BRFRAC(I)
57180 C Sets CMMOM(IDKY) = CoM momentum for first 2-body decay mode I (else 0)
57181 IF (NPRODS(I).EQ.2) CMMOM(I)=
57182 & HWUPCM(RMASS(IDKY),RMASS(IDKPRD(1,I)),RMASS(IDKPRD(2,I)))
57183 C Include any other decay modes of IDKY
57185 IF (IDK(J).EQ.IDKY) THEN
57186 C First see if it is a copy of the same decay channel
57187 IF ((IDKPRD(2,J).GE.1.AND.IDKPRD(2,J).LE.13).OR.
57188 & (IDKPRD(3,J).GE.1.AND.IDKPRD(3,J).LE.13)) THEN
57189 C Partonic respect order
57191 DO 50 K=1,NMODES(IDKY)
57192 IF (IDKPRD(1,L).EQ.IDKPRD(1,J).AND.
57193 & IDKPRD(2,L).EQ.IDKPRD(2,J).AND.
57194 & IDKPRD(3,L).EQ.IDKPRD(3,J).AND.
57195 & IDKPRD(4,L).EQ.IDKPRD(4,J).AND.
57196 & IDKPRD(5,L).EQ.IDKPRD(5,J)) GOTO 100
57199 C Allow for different order in matching
57201 DO 90 K=1,NMODES(IDKY)
57203 60 MATCH(M)=.FALSE.
57206 IF (.NOT.MATCH(N).AND.IDKPRD(N,L).EQ.IDKPRD(M,J)) THEN
57212 IF (MATCH(1).AND.MATCH(2).AND.MATCH(3).AND.
57213 & MATCH(4).AND.MATCH(5)) GOTO 100
57216 CALL HWDCHK(IDKY,J,*120)
57217 NMODES(IDKY)=NMODES(IDKY)+1
57218 IF (NMODES(IDKY).GT.NMXMOD) CALL HWWARN('HWUDKS',100,*999)
57220 BRSUM=BRSUM+BRFRAC(J)
57221 LTMP(NMODES(IDKY))=J
57222 BRTMP(NMODES(IDKY))=-BRFRAC(J)
57224 C Sets CMMOM(IDKY) = CoM momentum for next 2-body decay mode J (else 0)
57225 IF (NPRODS(J).EQ.2) CMMOM(J)=
57226 & HWUPCM(RMASS(IDKY),RMASS(IDKPRD(1,J)),RMASS(IDKPRD(2,J)))
57229 100 WRITE(6,110) L,J,BRFRAC(J),NME(J)
57230 BRSUM=BRSUM-BRFRAC(L)+BRFRAC(J)
57231 BRFRAC(L)=BRFRAC(J)
57232 BRTMP(L)=-BRFRAC(L)
57234 110 FORMAT(1X,'Line ',I4,' is the same as line ',I4/
57235 & 1X,'Take BR ',F5.3,' and ME code ',I3,' from second entry')
57237 C Set sum of branching ratios to 1. if necessary
57238 IF (ABS(BRSUM-1.).GT.EPS) THEN
57239 WRITE(6,130) RNAME(IDKY),BRSUM
57240 130 FORMAT(1X,A8,': BR sum =',F8.5)
57241 IF (ABS(BRSUM).LT.EPS) THEN
57243 140 FORMAT(1X,'Setting particle stable'/)
57247 150 FORMAT(1X,'Rescaling to 1'/)
57250 DO 160 J=1,NMODES(IDKY)
57251 BRFRAC(K)=SCALE*BRFRAC(K)
57255 C Sort branching ratios into descending order and rearrange pointers
57256 CALL HWUSOR(BRTMP,NMODES(IDKY),INDX,2)
57257 LSTRT(IDKY)=LTMP(INDX(1))
57258 LNEXT(LTMP(INDX(1)))=LTMP(INDX(1))
57259 DO 170 J=2,NMODES(IDKY)
57260 IF (ABS(BRFRAC(LTMP(INDX(J)))).LT.EPS) THEN
57264 170 LNEXT(LTMP(INDX(J-1)))=LTMP(INDX(J))
57265 175 LNEXT(LTMP(INDX(NMODES(IDKY))))=LTMP(INDX(NMODES(IDKY)))
57267 C If not a short lived particle with a decay mode then set stable
57269 IF (.NOT.RSTAB(I).AND.RLTIM(I).LT.PLTCUT.AND.
57270 & (NMODES(I).GT.0.OR.
57271 & (BPDK.AND.((I.GE.221.AND.I.LE.231).OR.
57272 & (I.GE.245.AND.I.LE.254))))) THEN
57273 DKLTM(I)=RLTIM(I)*RMASS(I)/HBAR
57278 C Set up DKLTM for light quarks
57280 DKLTM(I)=RMASS(I)**2/VMIN2
57281 200 DKLTM(I+6)=DKLTM(I)
57283 DKLTM(13)=RMASS(13)**2/VMIN2
57286 DKLTM(I)=RMASS(I)**2/VMIN2
57287 210 DKLTM(I+6)=DKLTM(I)
57288 C Set up DKLTM for weak bosons
57289 DKLTM(198)=RMASS(198)/GAMW
57290 DKLTM(199)=DKLTM(198)
57291 DKLTM(200)=RMASS(200)/GAMZ
57292 DKLTM(201)=RMASS(201)/GAMH
57293 DKLTM(202)=RMASS(202)/GAMZP
57294 C Set up DKTRM for massive quarks (plus check m_Q > M_W + m_q)
57295 FAC=SWEIN*(FOUR*RMASS(198))**2/HWUAEM(RMASS(198)**2)
57296 IF (.NOT.SUSYIN) THEN
57297 IF (RMASS(6).GT.RMASS(5)+RMASS(198)) THEN
57298 DKLTM(6)=FAC*FN(RMASS(6 ),RMASS(5 ),RMASS(198))
57299 & /(1-HWUALF(1,RMASS(6))*2*(2*PIFAC**2/3-5/2)/(3*PIFAC))
57302 WRITE(6,220) RNAME(6),RNAME(5),RNAME(198)
57305 IF (RMASS(209).GT.RMASS(4)+RMASS(198)) THEN
57306 DKLTM(209)=FAC*FN(RMASS(209),RMASS(4 ),RMASS(198))
57307 DKLTM(215)=DKLTM(209)
57309 WRITE(6,220) RNAME(209),RNAME(4),RNAME(198)
57311 IF (RMASS(210).GT.RMASS(209)+RMASS(198)) THEN
57312 DKLTM(210)=FAC*FN(RMASS(210),RMASS(209),RMASS(198))
57313 DKLTM(216)=DKLTM(210)
57315 WRITE(6,220) RNAME(210),RNAME(209),RNAME(198)
57317 IF (RMASS(211).GT.RMASS(6)+RMASS(198)) THEN
57318 DKLTM(211)=FAC*FN(RMASS(211),RMASS(6 ),RMASS(198))
57319 DKLTM(217)=DKLTM(211)
57321 WRITE(6,220) RNAME(211),RNAME(6),RNAME(198)
57323 IF (RMASS(212).GT.RMASS(211)+RMASS(198)) THEN
57324 DKLTM(212)=FAC*FN(RMASS(212),RMASS(211),RMASS(198))
57325 DKLTM(218)=DKLTM(212)
57327 WRITE(6,220) RNAME(212),RNAME(211),RNAME(198)
57329 220 FORMAT(1X,'W not real in the decay: ',A8,' --> ',A8,' + ',A8)
57330 C Now carry out diagnostic checks on decay table
57331 CALL HWDTOP(TOPDKS)
57333 IAPDG=ABS(IDPDG(IRES))
57334 C Do not check (di-)quarks, gauge bosons, higgses or special particles
57335 IF ((IAPDG.GE.1.AND.IAPDG.LE.9).OR.
57336 & (MOD(IAPDG/10,10).EQ.0.AND.MOD(IAPDG/1000,10).NE.0).OR.
57337 & (IAPDG.GE.21.AND.IAPDG.LE.26).OR.
57339 & (IAPDG.GE.35.AND.IAPDG.LE.37).OR.
57341 & IAPDG.EQ.98.OR.IAPDG.EQ.99) THEN
57343 C Ignore top hadrons if top decays
57344 ELSEIF(TOPDKS.AND.((IRES.GE.232.AND.IRES.LE.244).OR.
57345 & (IRES.GE.255.AND.IRES.LE.264))) THEN
57347 C Ignore particles not produced in cluster or particle decays
57348 ELSEIF(VTOCDK(IRES).AND.VTORDK(IRES)) THEN
57350 C Ignore B's if EURO or CLEO decay package used
57351 ELSEIF(((IRES.GE.221.AND.IRES.LE.223).OR.
57352 & (IRES.GE.245.AND.IRES.LE.247)).AND.BDECAY.NE.'HERW') THEN
57353 WRITE(6,320) BDECAY,RNAME(IRES)
57354 C Check decay modes exist for massive, short lived particles
57355 ELSEIF (NMODES(IRES).EQ.0.AND.RMASS(IRES).NE.ZERO.AND.
57356 & RLTIM(IRES).LT.PLTCUT) THEN
57357 IF (VTOCDK(IRES)) THEN
57362 IF (VTORDK(IRES)) THEN
57367 WRITE(6,330) RNAME(IRES),CVETO(1),CVETO(2)
57368 C ignore particles with no modes if massless or long lived
57369 ELSEIF (NMODES(IRES).EQ.0.AND.
57370 & (RMASS(IRES).EQ.ZERO.OR.RLTIM(IRES).GT.PLTCUT)) THEN
57372 ELSEIF (IDPDG(IRES).LT.0) THEN
57373 C Antiparticle: check decays are charge conjugates of particle decays
57374 CALL HWUIDT(1,-IDPDG(IRES),IPART,CDUM)
57375 IF (NMODES(IPART).EQ.0) THEN
57376 C Nothing to compare to
57377 WRITE(6,340) RNAME(IPART),RNAME(IRES)
57379 C First initialize particle matching array
57380 DO 230 I=1,NMODES(IPART)
57381 230 PMATCH(I)=.FALSE.
57382 C Loop through antiparticle decay modes
57384 DO 290 I=1,NMODES(IRES)
57385 C Search for conjugate mode allowing for different particle order
57387 DO 270 J=1,NMODES(IPART)
57388 IF (PMATCH(J)) GOTO 270
57390 240 MATCH(K)=.FALSE.
57392 KPRDLR=HWUANT(IDKPRD(K,LR))
57394 IF (.NOT.MATCH(L).AND.KPRDLR.EQ.IDKPRD(L,LP) ) THEN
57400 IF (MATCH(1).AND.MATCH(2).AND.MATCH(3).AND.
57401 & MATCH(4).AND.MATCH(5)) GOTO 280
57404 WRITE(6,350) LR,RNAME(IRES),(RNAME(IDKPRD(J,LR)),J=1,5)
57406 C Match found, check branching ratios and matrix element codes
57407 280 PMATCH(J)=.TRUE.
57408 IF (BRFRAC(LR).NE.BRFRAC(LP))
57409 & WRITE(6,360) LR,RNAME(IRES),(RNAME(IDKPRD(J,LR)),J=1,5),
57410 & BRFRAC(LR),BRFRAC(LP)
57411 IF (NME(LR).NE.NME(LP))
57412 & WRITE(6,370) LR,RNAME(IRES),(RNAME(IDKPRD(J,LR)),J=1,5),
57415 C Check for unmatched modes of particle conjugate to antiparticle
57417 DO 300 I=1,NMODES(IPART)
57418 IF (.NOT.PMATCH(I))
57419 & WRITE(6,350) LP,RNAME(IPART),(RNAME(IDKPRD(J,LP)),J=1,5)
57424 320 FORMAT(1X,A8,' decay package to be used for particle ',A8)
57425 330 FORMAT(1X,'No decay modes available for particle ',A8/
57426 & 1X,'Production in cluster decays ',A7,' and particle decays ',A7)
57427 340 FORMAT(1X,A8,' has no modes conjugate to those of ',A8)
57428 350 FORMAT(1X,'Line, ',I4,' decay: ',A8,' --> ',4(A8,1X),A8/
57429 & 1X,'A charge conjugate decay mode does not exist')
57430 360 FORMAT(1X,'Line, ',I4,' decay: ',A8,' --> ',4(A8,1X),A8/
57431 & 1X,'BR ',F5.3,' unequal to that of conjugate mode ',F5.3)
57432 370 FORMAT(1X,'Line, ',I4,' decay: ',A8,' --> ',4(A8,1X),A8/
57433 & 1X,'ME code ',I3,' unequal to that of conjugate mode ',I3)
57437 *CMZ :- -27/07/99 13.33.03 by Mike Seymour
57438 *-- Author : Ian Knowles, Bryan Webber & Kosuke Odagiri
57439 C-----------------------------------------------------------------------
57441 C-----------------------------------------------------------------------
57442 C Prints out particle properies/decay tables in a number of formats:
57443 C If (PRNDEF) ASCII to stout
57444 C If (PRNTEX) LaTeX to the file HW_decays.tex
57445 C Paper size and offsets as set in HWUEPR
57446 C Uses the package longtable.sty
57447 C Designed to be printed as landscape
57448 C If (PRNWEB) HTML to the file HW_decays/index.html
57449 C /PART0000001.html etc.
57450 C-----------------------------------------------------------------------
57451 INCLUDE 'HERWIG65.INC'
57452 INTEGER MMWIDE,MMLONG,MMHOFF,MMVOFF,IUNITT,IUNTW1,IUNTW2,I,NM,J,K,
57455 CHARACTER*2 ZZ,ACHRG
57456 CHARACTER*3 ASPIN(0:10)
57457 CHARACTER*6 BGCOLS(5),TBCOLS(3)
57458 CHARACTER*7 HWUNST,TMPNME
57459 CHARACTER*17 FNAMEP
57460 CHARACTER*33 FNAMEW
57461 COMMON/PAPER/MMWIDE,MMLONG,MMHOFF,MMVOFF
57463 DATA BGCOLS/'ffffff','0000aa','aa0000','00aa00','aa00ff'/
57464 DATA TBCOLS/'ccccff','9966ff','ffff00'/
57465 DATA ASPIN/' 0 ','1/2',' 1 ','3/2',' 2 ','5/2',' 3 ','7/2',
57466 & ' 4 ','9/2',' 5 '/
57474 C Open and write out file header information for index file
57476 IF (NPRFMT.LE.1) THEN
57483 OPEN(IUNITT,STATUS='UNKNOWN',FILE='HW_decays.tex')
57484 IF (NPRFMT.LE.1) THEN
57485 WRITE(IUNITT,30) Z,Z,Z,MMWIDE,Z,MMLONG,Z,MMHOFF,Z,MMVOFF,
57486 & Z,Z,Z,Z,Z,ZZ,Z,Z,Z,Z,Z,Z,NRES,ZZ,Z,Z,ZZ,Z,Z
57488 WRITE(IUNITT,40) Z,Z,Z,MMLONG,Z,MMWIDE,Z,MMHOFF,Z,MMVOFF,
57489 & Z,Z,Z,Z,Z,Z,ZZ,Z,Z,Z,Z,Z,Z,NRES,ZZ,Z,Z,Z,ZZ,Z,Z
57493 OPEN(IUNTW1,STATUS='UNKNOWN',FILE='HW_decays/index.html')
57494 WRITE(IUNTW1,50) BGCOLS,TBCOLS,NRES,((TBCOLS(I),I=2,3),J=1,7)
57496 10 FORMAT(1H1//15X,'TABLE OF PROPERTIES OF',I4,' PARTICLES USED'/)
57497 20 FORMAT(1H1//30X,'TABLE OF PROPERTIES OF',I4,' PARTICLES USED'//
57498 & 5X,'Name IDPDG Mass Chg Spn Lifetime Modes ',
57499 & ' Branching fractions ME codes and decay products')
57500 30 FORMAT(A1,'documentclass{article}'/A1,'usepackage{longtable}'/
57501 & A1,'textwidth ',I4,'mm ',A1,'textheight ',I4,'mm'/
57502 & A1,'hoffset ',I4,'mm ',A1,'voffset ',I4,'mm'/
57503 & A1,'pagestyle{empty}'/A1,'begin{document}'/
57504 & A1,'begin{center}'/A1,'begin{longtable}{|r|c|r|r|r|r|r|r|}'/
57505 & A1,'hline'/'Id HW & Name & Id PDG & Mass & Charge & Spin ',
57506 & '& Lifetime & Modes ',A2/A1,'hline'/
57507 & A1,'endhead'/A1,'hline'/A1,'endfoot'/A1,'hline'/
57508 & A1,'multicolumn{8}{|c|}{HERWIG 6.5: Table of properties',
57509 & ' of the ',I3,' particles used} ',A2/A1,'hline',A1,'hline'/
57510 & 'Id HW & Name & Id PDG & Mass & Charge & Spin & ',
57511 & 'Lifetime & Modes ',A2/A1,'hline'/A1,'endfirsthead')
57512 40 FORMAT(A1,'documentclass{article}'/A1,'usepackage{longtable}'/
57513 & A1,'textwidth ',I4,'mm ',A1,'textheight ',I4,'mm'/
57514 & A1,'hoffset ',I4,'mm ',A1,'voffset ',I4,'mm'/
57515 & A1,'pagestyle{empty}'/A1,'begin{document}'/A1,'begin{center}'/
57516 & A1,'begin{longtable}{|r|c|r|r|r|r|r|r|c|r|ccccc|}'/
57517 & A1,'hline'/'Id HW & Name & Id PDG & Mass & Charge & Spin ',
57518 & '& Lifetime & Modes & B.R. & M.E. & ' /
57519 & A1,'multicolumn{5}{|c|}{Decay Products} ',A2/A1,'hline'/
57520 & A1,'endhead'/A1,'hline'/A1,'endfoot'/A1,'hline'/
57521 & A1,'multicolumn{15}{|c|}{HERWIG 6.5: Table of properties',
57522 & ' of the ',I3,' particles used} ',A2/A1,'hline',A1,'hline'/
57523 & 'Id HW & Name & Id PDG & Mass & Charge & Spin & ',
57524 & 'Lifetime & Modes & B.R. & M.E. & '/
57525 & A1,'multicolumn{5}{|c|}{Decay Products} ',A2/A1,'hline'/
57526 & A1,'endfirsthead')
57527 50 FORMAT('<!-- No Less productions -->'/'<HTML>'/'<HEAD>'/
57528 & '<TITLE>HERWIG 6.5 Particle Properties</TITLE>'/'</HEAD>'/
57529 & '<BODY BGCOLOR=#',A6,' TEXT=#',A6,' LINK=#',A6,
57530 & ' ALINK=#',A6,' VLINK=#',A6,'>'/'<CENTER>'/
57531 & '<TABLE ALIGN="CENTER" BGCOLOR=#',A6,'>',
57532 & '<TR>'/'<TH COLSPAN=8 BGCOLOR=#',A6,' ALIGN="CENTER">',
57533 & '<A HREF=="http://hepwww.rl.ac.uk/theory/seymour/herwig/">',
57534 & 'HERWIG 6.5:</A><FONT COLOR=#',A6,'> Table of properties of',
57535 & ' the ',I3,' particles used</FONT></TH>'/'<TR>'/'<TH></TH>'/
57536 & '<TH BGCOLOR=#',A6,'><FONT COLOR=#',A6,'>Name</FONT></TH>'/
57537 & '<TH BGCOLOR=#',A6,' ALIGN="CENTER"><FONT COLOR=#',A6,'>',
57538 & 'Id PDG</FONT></TH>'/
57539 & '<TH BGCOLOR=#',A6,'><FONT COLOR=#',A6,'>Mass</FONT></TH>'/
57540 & '<TH BGCOLOR=#',A6,'><FONT COLOR=#',A6,'>Charge</FONT></TH>'/
57541 & '<TH BGCOLOR=#',A6,'><FONT COLOR=#',A6,'>Spin</FONT></TH>'/
57542 & '<TH BGCOLOR=#',A6,'><FONT COLOR=#',A6,'>Lifetime</FONT></TH>'/
57543 & '<TH BGCOLOR=#',A6,'><FONT COLOR=#',A6,'>Modes</FONT></TH>'/
57545 C Loop through resonances
57547 C Skip particles that can't be produced or blank lines
57548 IF ((VTOCDK(I).AND.VTORDK(I)).OR.
57549 & (RNAME(I).EQ.' ')) GOTO 260
57550 C Open and write out header information for particle file
57553 WRITE(FNAMEP,'(A5,A7,A5)') 'PART_',TMPNME,'.html'
57554 WRITE(FNAMEW,'(A,A17)') 'HW_decays/',FNAMEP
57555 OPEN(IUNTW2,STATUS='UNKNOWN',FILE=FNAMEW)
57556 WRITE(IUNTW2,60) RNAME(I),BGCOLS
57557 WRITE(IUNTW2,70) TBCOLS,((TBCOLS(L),L=2,3),M=1,6)
57559 60 FORMAT('<!-- No Less productions -->'/'<HTML>'/'<HEAD>'/
57560 & '<TITLE>HERWIG 6.5: ',A8,' properties</TITLE>'/'</HEAD>'/
57561 & '<BODY BGCOLOR=#',A6,' TEXT=#',A6,' LINK=#',A6,
57562 & ' ALINK=#',A6,' VLINK=#',A6,'>'/'<CENTER>')
57563 70 FORMAT('<TABLE ALIGN="CENTER" BGCOLOR=#',A6,'>'/
57564 & '<TR>'/'<TH></TH>'/
57565 & '<TH BGCOLOR=#',A6,'><FONT COLOR=#',A6,'>Name</FONT></TH>'/
57566 & '<TH BGCOLOR=#',A6,' ALIGN="CENTER"><FONT COLOR=#',A6,
57567 & '>Id PDG</FONT></TH>'/
57568 & '<TH BGCOLOR=#',A6,'><FONT COLOR=#',A6,'>Mass</FONT></TH>'/
57569 & '<TH BGCOLOR=#',A6,'><FONT COLOR=#',A6,'>Charge</FONT></TH>'/
57570 & '<TH BGCOLOR=#',A6,'><FONT COLOR=#',A6,'>Spin</FONT></TH>'/
57571 & '<TH BGCOLOR=#',A6,'><FONT COLOR=#',A6,'>Lifetime</FONT></TH>'/
57572 & '<TH BGCOLOR=#',A6,'><FONT COLOR=#',A6,'>Modes</FONT></TH>'/
57574 C Trick to output charge in fractions for di/s - quarks
57575 IF ((I.GE. 1.AND.I.LE. 12).OR.(I.GE.109.AND.I.LE.120).OR.
57576 & (I.GE.209.AND.I.LE.218).OR.(I.GE.401.AND.I.LE.424)) THEN
57581 C Write out special particles with no decay modes
57582 IF (NMODES(I).EQ.0) THEN
57584 IF (NPRFMT.LE.1) THEN
57585 WRITE(6,80) I,RNAME(I),IDPDG(I),RMASS(I),ICHRG(I),
57586 & ASPIN(INT(TWO*RSPIN(I))),RLTIM(I),0
57588 WRITE(6,90) I,RNAME(I),IDPDG(I),RMASS(I),ICHRG(I),
57589 & ASPIN(INT(TWO*RSPIN(I))),RLTIM(I),0
57592 C Add particle to LaTeX file
57594 IF (NPRFMT.LE.1) THEN
57595 WRITE(IUNITT,100) Z,I,TXNAME(1,I),IDPDG(I),RMASS(I),
57596 & ICHRG(I),ACHRG,ASPIN(INT(TWO*RSPIN(I))),RLTIM(I),0,ZZ
57598 WRITE(IUNITT,110) Z,I,TXNAME(1,I),IDPDG(I),RMASS(I),
57599 & ICHRG(I),ACHRG,ASPIN(INT(TWO*RSPIN(I))),RLTIM(I),0,Z,ZZ
57603 C Add properties to Web index
57604 WRITE(IUNTW1,120) TBCOLS(2),TBCOLS(3),I,FNAMEP,TXNAME(2,I),
57605 & IDPDG(I),RMASS(I),ICHRG(I),ACHRG,
57606 & ASPIN(INT(TWO*RSPIN(I))),RLTIM(I),0
57607 C Add properties to Web particle file
57608 WRITE(IUNTW2,130) TBCOLS(2),TBCOLS(3),I,TXNAME(2,I),
57609 & IDPDG(I),RMASS(I),ICHRG(I),ACHRG,
57610 & ASPIN(INT(TWO*RSPIN(I))),RLTIM(I),0
57612 80 FORMAT(/1X,I3,1X,A8,' IDPDG=',I8,', M=',F8.3,', Q=',I2,', J=',
57613 & A3,', T=',1P,E9.3,',',I3,' Modes')
57614 90 FORMAT(/1X,I3,1X,A8,1X,I8,1X,F8.3,1X,I2,1X,A3,1X,1P,E9.3,1X,I3)
57615 100 FORMAT(A1,'hline',I4,' & ',A37,' & $',I8,'$ & ',F8.3,' & $',I2,
57616 & A2,'$ & ',A3,' & $',1P,E9.3,'$ & ',I3,' ',A2)
57617 110 FORMAT(A1,'cline{1-8}'/
57618 & I4,' & ',A37,' & $',I8,'$ & ',F8.3,' & $',I2,A2,'$ & ',A3,
57619 & ' & $',1P,E9.3,'$ & ',I3,' & ',A1,'multicolumn{7}{|c|}{} ',A2)
57621 & '<TD ALIGN="RIGHT" BGCOLOR=#',A6,'><FONT COLOR=#',A6,'>',I3,
57623 & '<TD ALIGN="CENTER"><A HREF="',A17,'">',A37,'</A></TD>'/
57624 & '<TD ALIGN="RIGHT">',I8,'</TD>'/
57625 & '<TD ALIGN="RIGHT">',F8.3,'</TD>'/
57626 & '<TD ALIGN="RIGHT">',I2,A2,'</TD>'/
57627 & '<TD ALIGN="RIGHT">',A3,'</TD>'/
57628 & '<TD ALIGN="RIGHT">',1P,E9.3,'</TD>'/
57629 & '<TD ALIGN="RIGHT">',I3,'</TD>'/'</TR>')
57631 & '<TD ALIGN="RIGHT" BGCOLOR=#',A6,'><FONT COLOR=#',A6,'>',I3,
57633 & '<TD ALIGN="CENTER">',A37,'</TD>'/
57634 & '<TD ALIGN="RIGHT">',I8,'</TD>'/
57635 & '<TD ALIGN="RIGHT">',F8.3,'</TD>'/
57636 & '<TD ALIGN="RIGHT">',I2,A2,'</TD>'/
57637 & '<TD ALIGN="RIGHT">',A3,'</TD>'/
57638 & '<TD ALIGN="RIGHT">',1P,E9.3,'</TD>'/
57639 & '<TD ALIGN="RIGHT">',I3,'</TD>'/'</TR>'/'</TABLE>'/'<P>')
57641 C Particle with decay modes
57644 ELSEIF (VTOCDK(I)) THEN
57650 C Write out properties and first decay mode
57652 IF (NPRFMT.LE.1) THEN
57653 WRITE(6, 80) I,RNAME(I),IDPDG(I),RMASS(I),ICHRG(I),
57654 & ASPIN(INT(TWO*RSPIN(I))),RLTIM(I),NM
57655 WRITE(6,140) (RNAME(IDKPRD(L,K)),L=1,5),BRFRAC(K),NME(K)
57657 WRITE(6,150) I,RNAME(I),IDPDG(I),RMASS(I),ICHRG(I),
57658 & ASPIN(INT(TWO*RSPIN(I))),RLTIM(I),NM,BRFRAC(K),NME(K),
57659 & (RNAME(IDKPRD(L,K)),L=1,5)
57663 IF (NPRFMT.LE.1) THEN
57664 WRITE(IUNITT,160) Z,I,TXNAME(1,I),IDPDG(I),RMASS(I),
57665 & ICHRG(I),ACHRG,ASPIN(INT(TWO*RSPIN(I))),RLTIM(I),NM,ZZ,Z
57666 WRITE(IUNITT,170) Z,Z,(TXNAME(1,IDKPRD(L,K)),L=1,5),Z,
57667 & BRFRAC(K),Z,NME(K),ZZ
57669 WRITE(IUNITT,180) Z,I,TXNAME(1,I),IDPDG(I),RMASS(I),
57670 & ICHRG(I),ACHRG,ASPIN(INT(TWO*RSPIN(I))),RLTIM(I),NM,
57671 & BRFRAC(K),NME(K),(TXNAME(1,IDKPRD(L,K)),L=1,5),ZZ,Z
57675 C Add properties to index
57676 WRITE(IUNTW1,120) TBCOLS(2),TBCOLS(3),I,FNAMEP,TXNAME(2,I),
57677 & IDPDG(I),RMASS(I),ICHRG(I),ACHRG,ASPIN(INT(TWO*RSPIN(I))),
57679 C Add properties to Web particle file
57680 WRITE(IUNTW2,130) TBCOLS(2),TBCOLS(3),I,TXNAME(2,I),IDPDG(I),
57681 & RMASS(I),ICHRG(I),ACHRG,ASPIN(INT(TWO*RSPIN(I))),RLTIM(I),NM
57682 WRITE(IUNTW2,190) TBCOLS,TXNAME(2,I),
57683 & ((TBCOLS(L),L=2,3),M=1,3)
57684 WRITE(IUNTW2,200) TBCOLS(2),TBCOLS(3),1,BRFRAC(K),NME(K),
57685 & (TXNAME(2,IDKPRD(L,K)),L=1,5)
57687 140 FORMAT(5X,'BR[ -->',5(1X,A8),']=',F5.3,', ME code',I5)
57688 150 FORMAT(/1X,I3,1X,A8,1X,I8,1X,F8.3,1X,I2,1X,A3,1X,1P,E9.3,1X,I3,
57689 & 2X,F5.3,1X,I3,5(1X,A8))
57690 160 FORMAT(A1,'hline',
57691 & I4,' & ',A37,' & $',I8,'$ & ',F8.3,' & $',I2,A2,'$ & ',
57692 & A3,' & $',1P,E9.3,'$ & ',I3,' ',A2/A1,'cline{2-8}')
57693 170 FORMAT(' & & ',A1,'multicolumn{2}{l}{$',A1,'longrightarrow$'/
57694 & 5(A37,' '),'}'/' & ',A1,'multicolumn{2}{l}{BR = ',F5.3,'} & ',
57695 & A1,'multicolumn{2}{l|}{ME code = ',I3,'} ',A2)
57696 180 FORMAT(A1,'hline'/
57697 & I4,' & ',A37,' & $',I8,'$ & ',F8.3,' & $',I2,A2,'$ & ',
57698 & A3,' & $',1P,E9.3,'$ & ',I3,' & ',F5.3,' & ',I3,
57699 & 5(' & ',A37), ' ',A2/A1,'cline{2-8}')
57700 190 FORMAT('<TABLE ALIGN="CENTER" BGCOLOR=#',A6,'>'/'<TR>'/
57701 & '<TH COLSPAN=8 BGCOLOR=#',A6,'><FONT COLOR=#',A6,'>',A37,
57702 & ' Decay Modes</FONT></TH>'/'</TR>'/'<TR>'/'<TH></TH>',
57703 & '<TH BGCOLOR=#',A6,'><FONT COLOR=#',A6,'>B.R.</FONT></TH>'/
57704 & '<TH BGCOLOR=#',A6,'><FONT COLOR=#',A6,'>M.E.</FONT></TH>'/
57705 & '<TH BGCOLOR=#',A6,' ALIGN="CENTER" COLSPAN=5>',
57706 & '<FONT COLOR=#',A6,'>Decay products</FONT></TH>'/'</TR>')
57708 & '<TD ALIGN="RIGHT" BGCOLOR=#',A6,'><FONT COLOR=#',A6,'>',
57709 & I3,'</FONT></TD>'/
57710 & '<TD ALIGN="RIGHT">',F5.3,'</TD>'/
57711 & '<TD ALIGN="RIGHT">',I3,'</TD>'/
57712 & 5('<TD ALIGN="CENTER">',A37,'</TD>'/),'</TR>')
57713 C Write out additional decay modes
57714 IF (NMODES(I).GE.2) THEN
57715 DO 210 J=2,NMODES(I)
57718 IF (NPRFMT.LE.1) THEN
57719 WRITE(6,140) (RNAME(IDKPRD(L,K)),L=1,5),BRFRAC(K),NME(K)
57721 WRITE(6,220) BRFRAC(K),NME(K),(RNAME(IDKPRD(L,K)),L=1,5)
57725 IF (NPRFMT.LE.1) THEN
57726 WRITE(IUNITT,170) Z,Z,(TXNAME(1,IDKPRD(L,K)),L=1,5),Z,
57727 & BRFRAC(K),Z,NME(K),ZZ
57729 WRITE(IUNITT,230) Z,BRFRAC(K),NME(K),
57730 & (TXNAME(1,IDKPRD(L,K)),L=1,5),ZZ
57733 IF (PRNWEB) WRITE(IUNTW2,200) TBCOLS(2),TBCOLS(3),J,
57734 & BRFRAC(K),NME(K),(TXNAME(2,IDKPRD(L,K)),L=1,5)
57736 IF (PRNTEX.AND.NPRFMT.EQ.2.AND.NMODES(I+1).EQ.0)
57737 & WRITE(IUNITT,240) Z
57738 220 FORMAT(54X,F5.3,1X,I3,5(1X,A8))
57739 230 FORMAT(' & ',A1,'multicolumn{7}{|c|}{} & ',F5.3,' & ',I3,
57740 & 5(' & ',A37),' ',A2)
57741 240 FORMAT(A1,'hline')
57744 C Close Web particle file
57749 250 FORMAT('</TABLE>'/'</CENTER>'/'<P>'/
57750 & 'Main particle <A HREF="index.html">index</A>'/
57751 & '</BODY>'/'</HTML>')
57753 C Close the LaTeX file
57755 WRITE(IUNITT,270) Z,Z,Z
57758 C Close the index file
57763 270 FORMAT(A1,'end{longtable}'/A1,'end{center}'/A1,'end{document}')
57764 280 FORMAT('</TABLE>'/'</CENTER>'/'</BODY>'/'</HTML>')
57768 *CMZ :- -29/01/93 11.11.55 by Bryan Webber
57769 *-- Author : Giovanni Abbiendi & Luca Stanco
57770 C---------------------------------------------------------------------
57771 FUNCTION HWUECM (S,M1QUAD,M2QUAD)
57772 C-----------------------------------------------------------------------
57773 C C.M. ENERGY OF A PARTICLE IN 1-->2 BRANCH, MAY BE SPACELIKE
57774 C---------------------------------------------------------------------
57775 DOUBLE PRECISION HWUECM,S,M1QUAD,M2QUAD
57776 HWUECM = (S+M1QUAD-M2QUAD)/(2.D0*SQRT(S))
57779 *CMZ :- -09/12/91 12.07.08 by Mike Seymour
57780 *-- Author : Mike Seymour
57781 C-----------------------------------------------------------------------
57782 SUBROUTINE HWUEDT(N,IEDT)
57783 C-----------------------------------------------------------------------
57784 C EDIT THE EVENT RECORD
57785 C IF N>0 DELETE THE N ENTRIES IN IEDT FROM EVENT RECORD
57786 C IF N<0 INSERT LINES AFTER THE -N ENTRIES IN IEDT
57787 C-----------------------------------------------------------------------
57788 INCLUDE 'HERWIG65.INC'
57789 INTEGER N,IEDT(*),IMAP(0:NMXHEP),IHEP,I,J,I1,I2
57790 COMMON /HWUMAP/IMAP
57791 C---MOVE ENTRIES AND CALCULATE MAPPING OF POINTERS
57794 ELSEIF (N.GT.0) THEN
57803 DO 110 IHEP=I1,I2,SIGN(1,I2-I1)
57806 IF (IHEP.EQ.IEDT(J)) THEN
57807 IF (N.GT.0) IMAP(IHEP)=0
57809 IF (N.LT.0) IMAP(IHEP)=I
57812 IF (IMAP(IHEP).EQ.I .AND. IHEP.NE.I) THEN
57813 ISTHEP(I)=ISTHEP(IHEP)
57815 IDHEP(I)=IDHEP(IHEP)
57816 JMOHEP(1,I)=JMOHEP(1,IHEP)
57817 JMOHEP(2,I)=JMOHEP(2,IHEP)
57818 JDAHEP(1,I)=JDAHEP(1,IHEP)
57819 JDAHEP(2,I)=JDAHEP(2,IHEP)
57820 CALL HWVEQU(5,PHEP(1,IHEP),PHEP(1,I))
57821 CALL HWVEQU(4,VHEP(1,IHEP),VHEP(1,I))
57829 CALL HWVZRO(5,PHEP(1,IHEP))
57830 CALL HWVZRO(4,VHEP(1,IHEP))
57835 C---RELABEL POINTERS, SETTING ANY WHICH WERE TO DELETED ENTRIES TO ZERO
57838 JMOHEP(1,IHEP)=IMAP(JMOHEP(1,IHEP))
57839 JMOHEP(2,IHEP)=IMAP(JMOHEP(2,IHEP))
57840 JDAHEP(1,IHEP)=IMAP(JDAHEP(1,IHEP))
57841 JDAHEP(2,IHEP)=IMAP(JDAHEP(2,IHEP))
57845 *CMZ :- -26/04/91 14.22.30 by Federico Carminati
57846 *-- Author : Bryan Webber and Ian Knowles
57847 C-----------------------------------------------------------------------
57848 SUBROUTINE HWUEEC(IL)
57849 C-----------------------------------------------------------------------
57850 C Loads cross-section coefficients, for kinematically open channels,
57851 C in llbar-->qqbar; lepton label IL=1-6: e,nu_e,mu,nu_mu,tau,nu_tau.
57852 C-----------------------------------------------------------------------
57853 INCLUDE 'HERWIG65.INC'
57854 DOUBLE PRECISION Q2
57861 IF (EMSCA.GT.2.*RMASS(IQ)) THEN
57864 CALL HWUCFF(JL,IQ,Q2,CLQ(1,MAXFL))
57865 TQWT=TQWT+CLQ(1,MAXFL)
57868 IF (MAXFL.EQ.0) CALL HWWARN('HWUEEC',100,*999)
57871 *CMZ :- -30/06/94 19.31.08 by Mike Seymour
57872 *-- Author : Mike Seymour
57873 C-----------------------------------------------------------------------
57874 SUBROUTINE HWUEMV(N,IFROM,ITO)
57875 C-----------------------------------------------------------------------
57876 C MOVE A BLOCK OF ENTRIES IN THE EVENT RECORD
57877 C N ENTRIES IN HEPEVT STARTING AT IFROM ARE MOVED TO AFTER ITO
57878 C-----------------------------------------------------------------------
57879 INCLUDE 'HERWIG65.INC'
57880 INTEGER N,IFROM,ITO,IMAP(0:NMXHEP),LFROM,LTO,I,IEDT(NMXHEP),IHEP,
57882 COMMON /HWUMAP/IMAP
57887 CALL HWUEDT(-N,IEDT)
57890 JHEP=IMAP(LFROM+I-1)
57891 ISTHEP(IHEP)=ISTHEP(JHEP)
57892 IDHW(IHEP)=IDHW(JHEP)
57893 IDHEP(IHEP)=IDHEP(JHEP)
57894 JMOHEP(1,IHEP)=JMOHEP(1,JHEP)
57895 JMOHEP(2,IHEP)=JMOHEP(2,JHEP)
57896 JDAHEP(1,IHEP)=JDAHEP(1,JHEP)
57897 JDAHEP(2,IHEP)=JDAHEP(2,JHEP)
57898 CALL HWVEQU(5,PHEP(1,JHEP),PHEP(1,IHEP))
57899 CALL HWVEQU(4,VHEP(1,JHEP),VHEP(1,IHEP))
57901 IF (JMOHEP(1,KHEP).EQ.JHEP) JMOHEP(1,KHEP)=IHEP
57902 IF (JMOHEP(2,KHEP).EQ.JHEP) JMOHEP(2,KHEP)=IHEP
57903 IF (JDAHEP(1,KHEP).EQ.JHEP) JDAHEP(1,KHEP)=IHEP
57904 IF (JDAHEP(2,KHEP).EQ.JHEP) JDAHEP(2,KHEP)=IHEP
57908 CALL HWUEDT(N,IEDT)
57911 *CMZ :- -27/07/99 13.33.03 by Mike Seymour
57912 *-- Author : Ian Knowles, Bryan Webber & Kosuke Odagiri
57913 C-----------------------------------------------------------------------
57915 C-----------------------------------------------------------------------
57916 C Prints out event data in a number of possible formats:
57917 C If (PRNDEF) ASCII to stout
57918 C If (PRNTEX) LaTeX to the file HWEV_*******.tex
57919 C Please check paper size and offsets given in mm
57920 C Uses the package longtable.sty
57921 C If (PRVTX>OR.NPRFMT.EQ.2) designed to be printed
57923 C If (PRNWEB) HTML to the file HWEV_*******.html
57924 C Call HWUDPR to create particle property files in
57925 C the subdirectory HW_decays/
57926 C ******* gives the event number 0000001 etc.
57927 C-----------------------------------------------------------------------
57928 INCLUDE 'HERWIG65.INC'
57929 INTEGER MMWIDE,MMLONG,MMHOFF,MMVOFF,I,IST,IS,ID,MS,J,K,IUNITW,
57933 CHARACTER*6 BGCOLS(5),TBCOLS(3),THEAD(17,3)
57934 CHARACTER*7 HWUNST,TMPNME
57935 CHARACTER*16 FNAMET
57936 CHARACTER*17 FNAMEW
57937 CHARACTER*27 FNAMEP
57938 CHARACTER*28 TITLE(11),SECTXT
57939 LOGICAL FIRST(11),NEWSEC
57940 COMMON/PAPER/MMWIDE,MMLONG,MMHOFF,MMVOFF
57943 DATA BGCOLS/'ffffff','0000aa','aa0000','00aa00','aa00ff'/
57944 DATA TBCOLS/'ccccff','9966ff','ffff00'/
57945 DATA THEAD/ 17*'9966ff',17*'ffff00',
57946 & 'IHEP ',' ID ',' IDPDG',' IST ',' MO1 ',' MO2 ',
57947 & ' DA1 ',' DA2 ',' P-X ',' P-Y ',' P-Z ','ENERGY',
57948 & ' MASS ',' V-X ',' V-Y ',' V-Z ',' V-C*T'/
57949 DATA TITLE/' ---INITIAL STATE--- ',
57950 & ' ---HARD SUBPROCESS--- ',
57951 & ' ---PARTON SHOWERS--- ',
57952 & ' ---GLUON SPLITTING--- ',
57953 & ' ---CLUSTER FORMATION--- ',
57954 & ' ---CLUSTER DECAYS--- ',
57955 & ' ---STRONG HADRON DECAYS--- ',
57956 & ' ---HEAVY PARTICLE DECAYS---',
57957 & ' ---H/W/Z BOSON DECAYS--- ',
57958 & ' ---SOFT UNDERLYING EVENT---',
57959 & ' ---MULTIPLE SCATTERING--- '/
57965 C Write out any required file header information
57966 TMPNME=HWUNST(NEVHEP)
57968 WRITE(FNAMET,'(A5,A7,A4)') 'HWEV_',TMPNME,'.tex'
57969 OPEN(IUNITT,STATUS='UNKNOWN',FILE=FNAMET)
57970 IF (PRVTX.OR.NPRFMT.EQ.2) THEN
57971 WRITE(IUNITT,10) Z,Z,Z,MMLONG,Z,MMWIDE,Z,MMVOFF,Z,MMHOFF,Z,Z,Z
57973 WRITE(IUNITT,10) Z,Z,Z,MMWIDE,Z,MMLONG,Z,MMHOFF,Z,MMVOFF,Z,Z,Z
57977 WRITE(FNAMEW,'(A5,A7,A5)') 'HWEV_',TMPNME,'.html'
57978 OPEN(IUNITW,STATUS='UNKNOWN',FILE=FNAMEW)
57979 WRITE(IUNITW,20) BGCOLS
57981 10 FORMAT(A1,'documentclass{article}'/A1,'usepackage{longtable}'/
57982 & A1,'textwidth ',I4,'mm ',A1,'textheight ',I4,'mm'/
57983 & A1,'hoffset ',I4,'mm ',A1,'voffset ',I4,'mm'/
57984 & A1,'pagestyle{empty}'/A1,'begin{document}'/A1,'begin{center}')
57985 20 FORMAT('<!-- No Less productions -->'/'<HTML>'/'<HEAD>'/
57986 & '<TITLE>HERWIG Event Record</TITLE>'/'</HEAD>'/
57987 & '<BODY BGCOLOR=#',A6,' TEXT=#',A6,' LINK=#',A6,
57988 & ' ALINK=#',A6,' VLINK=#',A6,'>')
57989 C Write out event header details and set up tables
57991 WRITE(6,30) NEVHEP,PBEAM1,PART1,PBEAM2,PART2,
57992 & IPROC,NRN,ISTAT,IERROR,EVWGT
57995 WRITE(IUNITT,40) Z,Z,Z,ISTAT,ZZ,Z,
57996 & IPROC,PBEAM1,PBEAM2,NRN(1),
57997 & IERROR,ZZ,Z,Z,NEVHEP,TXNAME(1,IDHW(1)),TXNAME(1,IDHW(2)),
57998 & NRN(2),EVWGT,ZZ,Z,Z,Z
58000 WRITE(IUNITT,50) Z,Z,Z,Z,Z
58002 WRITE(IUNITT,60) Z,Z,Z,Z,Z
58006 WRITE(IUNITW,70) TBCOLS(1),TBCOLS(2),(TBCOLS(2),TBCOLS(3),
58007 & I=1,4),ISTAT,TBCOLS(2),TBCOLS(3),
58008 & IPROC,PBEAM1,PBEAM2,NRN(1),
58009 & TBCOLS(2),TBCOLS(3),IERROR
58010 WRITE(IUNITW,71) TBCOLS(2),TBCOLS(3),NEVHEP,TXNAME(2,IDHW(1)),
58011 & TXNAME(2,IDHW(2)),NRN(2),TBCOLS(2),TBCOLS(3),EVWGT,TBCOLS(1)
58013 30 FORMAT(///1X,'EVENT ',I7,':',F8.2,' GEV/C ',A8,' ON ',F8.2,
58014 & ' GEV/C ',A8,' PROCESS:',I6/1X,'SEEDS: ',I11,' & ',I11,
58015 & ' STATUS: ',I4,' ERROR:',I4,' WEIGHT: ',1P,E11.4/)
58016 40 FORMAT(A1,'begin{tabular}{|l|r|c|c|r|l|c|}'/A1,'hline'/
58017 & A1,'multicolumn{2}{|c|}{HERWIG 6.5} & Beam 1: & Beam 2: & ',
58018 & 'Seeds: & Status: & ',I4, ' ',A2/A1,'hline'/'Process: & ',I6,
58019 & ' & ',F8.2,'~GeV/c & ',F8.2,'~GeV/c',' & ',I11,' & Error: & ',
58020 & I4,' ',A2/A1,'cline{1-2} ',A1,'cline{6-7}'/'Event: & ',I7,' & ',
58021 & A37,' & ',A37,' & ',I11,' & Weight: & ',1P,E11.4,' ',A2/A1,
58022 & 'hline'/A1,'end{tabular}'/A1,'vskip 5mm')
58023 50 FORMAT(A1,'begin{longtable}{|r|c|r|r|r|r|r|r|r|r|r|r|r|r|r|r|r|}'/
58024 & A1,'hline'/A1,'endhead'/A1,'hline'/A1,'endfoot')
58025 60 FORMAT(A1,'begin{longtable}{|r|c|r|r|r|r|r|r|r|r|r|r|r|}'/
58026 & A1,'hline'/A1,'endhead'/A1,'hline'/A1,'endfoot')
58027 70 FORMAT(/'<CENTER>'/'<TABLE ALIGN="CENTER" BGCOLOR=#',A6,'>'/
58028 & '<TR>'/'<TH BGCOLOR=#',A6,' COLSPAN=2>',
58029 & '<A HREF="http://hepwww.rl.ac.uk/theory/seymour/herwig/">',
58030 & 'HERWIG 6.5</A></TH>'/
58031 & '<TH BGCOLOR=#',A6,'><FONT COLOR=#',A6,'>Beam 1:</FONT></TH>'/
58032 & '<TH BGCOLOR=#',A6,'><FONT COLOR=#',A6,'>Beam 2:</FONT></TH>'/
58033 & '<TH BGCOLOR=#',A6,'><FONT COLOR=#',A6,'>Seeds:</FONT></TH>'/
58034 & '<TH BGCOLOR=#',A6,' ALIGN="LEFTT"><FONT COLOR=#',A6,
58035 & '>Status:</FONT></TH>'/'<TD ALIGN="RIGHT">',I4,'</TD>'/'</TR>'/
58037 & '<TH BGCOLOR=#',A6,' ALIGN="LEFTT"><FONT COLOR=#',A6,
58038 & '>Process:</Th>'/'<TD>',I6,'</TD>'/
58039 & '<TD>',F8.2,' GeV/c</TD>'/'<TD>',F8.2,' GeV/c</TD>'/
58040 & '<TD ALIGN="RIGHT">',I11,'</TD>'/
58041 & '<TH BGCOLOR=#',A6,' ALIGN="LEFT"><FONT COLOR=#',A6,
58042 & '>Error:</FONT></TH>'/'<TD ALIGN="RIGHT">',I4,'</TD>'/'</TR>')
58044 & '<TH BGCOLOR=#',A6,' ALIGN="LEFT"><FONT COLOR=#',A6,
58045 & '>Event:</Th>'/'<TD ALIGN="RIGHT">',I7,'</TD>'/
58046 & '<TD ALIGN="CENTER">',A37,'</TD>'/
58047 & '<TD ALIGN="CENTER">',A37,'</TD>'/
58048 & '<TD ALIGN="RIGHT">',I11,'</TD>'/
58049 & '<TH BGCOLOR=#',A6,' ALIGN="LEFT"><FONT COLOR=#',A6,
58050 & '>Weight:</FONT></TH>'/'<TD>',1P,E11.4,'</TD>'/'</TR>'/
58051 & '</TABLE>'//'<P>'/
58052 & '<TABLE ALIGN="CENTER" BGCOLOR=#',A6,'>')
58053 C Initialize control flags
58056 C Loop through event record
58059 C First find start of new sections
58063 IF (IST.EQ.101) THEN
58066 ELSEIF (FIRST(2).AND.IS.EQ.12) THEN
58070 ELSEIF (FIRST(3).AND.IS.EQ.14) THEN
58077 ELSEIF (FIRST(4).AND.IST.GE.158.AND.IST.NE.160
58078 & .AND.IST.LE.162) THEN
58082 ELSEIF (FIRST(5).AND.(IS.EQ.16.OR.IS.EQ.18)
58083 & .AND.IST.GT.162) THEN
58087 ELSEIF (IS.EQ.19.OR.IST.EQ.1.OR.IST.EQ.200) THEN
58088 MS=ISTHEP(JMOHEP(1,I))/10
58089 IF (MS.EQ.15.OR.MS.EQ.16.OR.MS.EQ.18) THEN
58095 ELSEIF (FIRST(7).AND.(.NOT.FIRST(6))) THEN
58100 ELSEIF (FIRST(8).AND.(IST.EQ.125.OR.IST.EQ.155.OR.
58101 & (IST.EQ.123.AND.ISTHEP(JMOHEP(1,I)).EQ.199))) THEN
58110 ELSEIF (FIRST(9).AND.(IST.EQ.123.OR.IST.EQ.124)) THEN
58111 MS=ABS(IDHEP(JMOHEP(1,I)))
58112 IF (MS.EQ.23.OR.MS.EQ.24.OR.MS.EQ.25) THEN
58123 ELSEIF (IST.EQ.170) THEN
58129 ELSEIF (FIRST(11).AND.(ID.EQ.71.OR.ID.EQ.72)) THEN
58135 C Print out section heading
58139 IF (NPRFMT.EQ.1) THEN
58140 WRITE(6, 90) SECTXT,(THEAD(J,3),J=1,17)
58142 WRITE(6,100) SECTXT,(THEAD(J,3),J=1,17)
58145 IF (PRNTEX) WRITE(IUNITT,110) Z,Z,SECTXT,ZZ,Z,
58146 & (Z,THEAD(J,3),J=1,17),ZZ,Z
58147 IF (PRNWEB) WRITE(IUNITW,120) TBCOLS(2),TBCOLS(3),
58148 & SECTXT,((THEAD(K,J),J=1,3),K=1,17)
58149 90 FORMAT(/46X,A28//1X,A4,2X,A6,3X,A6,5A4,3(2X,A6),A6,3X,A5,
58151 100 FORMAT(/58X,A28//1X,A4,2X,A6,3X,A6,5A4,3(6X,A6),5X,A6,8X,A5,
58152 & 4X,A6,2(5X,A6),6X,A6)
58153 110 FORMAT(A1,'hline'/A1,'multicolumn{17}{|c|}{',A28,'} ',A2/A1,
58154 & 'hline'/16(A1,'multicolumn{1}{|c|}{',A6,'} & '),
58155 & A1,'multicolumn{1}{|c|}{',A6,'} ',A2/A1,'hline')
58156 120 FORMAT('<TR><TH COLSPAN=17 BGCOLOR=#',A6,'>',
58157 & '<FONT COLOR=#',A6,'>',A28,'</FONT></TH></TR>'/
58158 & '<TR>',17(/,1X,'<TH BGCOLOR=#',A6,'>
58159 & <FONT COLOR=',A6,'>',A6,'</FONT></TH>'),'</TR>')
58162 IF (NPRFMT.EQ.1) THEN
58163 WRITE(6,130) SECTXT,(THEAD(J,3),J=1,13)
58165 WRITE(6,140) SECTXT,(THEAD(J,3),J=1,13)
58168 IF (PRNTEX) WRITE(IUNITT,150) Z,Z,SECTXT,ZZ,Z,
58169 & (Z,THEAD(J,3),J=1,13),ZZ,Z
58170 IF (PRNWEB) WRITE(IUNITW,160) TBCOLS(2),TBCOLS(3),
58171 & SECTXT,((THEAD(K,J),J=1,3),K=1,13)
58172 130 FORMAT(/26X,A28//1X,A4,2X,A6,3X,A6,5A4,3(2X,A6),A6,3X,A5)
58173 140 FORMAT(/36X,A28//1X,A4,2X,A6,3X,A6,5A4,3(6X,A6),5X,A6,8X,A5)
58174 150 FORMAT(A1,'hline'/A1,'multicolumn{13}{|c|}{',A28,'} ',A2/A1,
58175 & 'hline'/12(A1,'multicolumn{1}{|c|}{',A6,'} & '),
58176 & A1,'multicolumn{1}{|c|}{',A6,'} ',A2/A1,'hline')
58177 160 FORMAT('<TR><TH COLSPAN=13 BGCOLOR=#',A6,'>',
58178 & '<FONT COLOR=#',A6,'>',A28,'</FONT></TH></TR>'/
58179 & '<TR>',13(/'<TH BGCOLOR=#',A6,'>',
58180 & '<FONT COLOR=#',A6,'>',A6,'</FONT></TH>'),'</TR>')
58183 C Now print out the data line
58185 C Include vertex information
58188 IF (NPRFMT.EQ.1) THEN
58189 WRITE(6,190) I,RNAME(IDHW(I)),IDHEP(I),IST,
58190 & JMOHEP(1,I),JMOHEP(2,I),JDAHEP(1,I),JDAHEP(2,I),
58191 & (PHEP(J,I),J=1,5),(VHEP(J,I),J=1,4)
58193 WRITE(6,200) I,RNAME(IDHW(I)),IDHEP(I),IST,
58194 & JMOHEP(1,I),JMOHEP(2,I),JDAHEP(1,I),JDAHEP(2,I),
58195 & (PHEP(J,I),J=1,5),(VHEP(J,I),J=1,4)
58198 IF (NPRFMT.EQ.1) THEN
58199 WRITE(6,210) I,RNAME(IDHW(I)),IDHEP(I),IST,
58200 & JMOHEP(1,I),JMOHEP(2,I),JDAHEP(1,I),JDAHEP(2,I),
58201 & (PHEP(J,I),J=1,5),(VHEP(J,I),J=1,4)
58203 WRITE(6,220) I,RNAME(IDHW(I)),IDHEP(I),IST,
58204 & JMOHEP(1,I),JMOHEP(2,I),JDAHEP(1,I),JDAHEP(2,I),
58205 & (PHEP(J,I),J=1,5),(VHEP(J,I),J=1,4)
58209 IF (PRNTEX) WRITE(IUNITT,230) I,TXNAME(1,IDHW(I)),IDHEP(I),
58210 & IST,JMOHEP(1,I),JMOHEP(2,I),JDAHEP(1,I),JDAHEP(2,I),
58211 & (PHEP(J,I),J=1,5),(VHEP(J,I),J=1,4),ZZ
58213 WRITE(IUNITW,240) TBCOLS(2),TBCOLS(3),I,I
58214 IF (IDHEP(I).EQ.0.OR.IDHEP(I).EQ.91) THEN
58215 WRITE(IUNITW,250) TXNAME(2,IDHW(I)),IDHEP(I),IST
58217 TMPNME=HWUNST(IDHW(I))
58218 WRITE(FNAMEP,'(A15,A7,A5)')
58219 & 'HW_decays/PART_',TMPNME,'.html'
58220 WRITE(IUNITW,260) FNAMEP,TXNAME(2,IDHW(I)),IDHEP(I),IST
58223 IF (JMOHEP(J,I).NE.0) THEN
58224 WRITE(IUNITW,270) JMOHEP(J,I),JMOHEP(J,I)
58226 WRITE(IUNITW,280) JMOHEP(J,I)
58230 IF (JDAHEP(J,I).NE.0) THEN
58231 WRITE(IUNITW,270) JDAHEP(J,I),JDAHEP(J,I)
58233 WRITE(IUNITW,280) JDAHEP(J,I)
58236 IF (NPRFMT.EQ.1) THEN
58237 WRITE(IUNITW,290) (PHEP(J,I),J=1,5),(VHEP(J,I),J=1,4)
58239 WRITE(IUNITW,300) (PHEP(J,I),J=1,5),(VHEP(J,I),J=1,4)
58242 190 FORMAT(1X,I4,1X,A8,I8,5I4, 2F8.2,2F7.1,F8.2,1P,4E10.3)
58243 200 FORMAT(1X,I4,1X,A8,I8,5I4, 5F12.5,1P,4E11.4)
58244 210 FORMAT(1X,Z4,1X,A8,I8,I4,4Z4,2F8.2,2F7.1,F8.2,1P,4E10.3)
58245 220 FORMAT(1X,Z4,1X,A8,I8,I4,4Z4,5F12.5,1P,4E11.4)
58246 230 FORMAT(I4,' & ',A37,' & $',I8,'$',5(' & ',I4),
58247 & 5(' & $',F8.2,'$'),4(' & $',1P,E11.3,'$'),' ',A2)
58248 240 FORMAT('<TR>'/'<TD BGCOLOR=#',A6,' ALIGN="RIGHT">',
58249 & '<FONT COLOR=#',A6,'><A NAME="',I4,'">',I4,'</A></FONT></TD>'/)
58250 250 FORMAT('<TD ALIGN="CENTER">',A37,'</TD>'/'<TD ALIGN="RIGHT">',
58251 & I8,'</TD>'/'<TD ALIGN="RIGHT">',I4,'</TD>')
58252 260 FORMAT('<TD ALIGN="CENTER"><A HREF="',A27,'">',A37,'</A></TD>'/
58253 & '<TD ALIGN="RIGHT">',I8,'</TD>'/
58254 & '<TD ALIGN="RIGHT">',I4,'</TD>')
58255 270 FORMAT(/'<TD ALIGN="RIGHT"><A HREF="#',I4,'">',I4,'</A></TD>')
58256 280 FORMAT(/'<TD ALIGN="RIGHT">',I4,'</TD>')
58257 290 FORMAT(5(/'<TD ALIGN="RIGHT">',F8.2,'</TD>'),1P,
58258 & 4(/'<TD ALIGN="RIGHT">',E10.3,'</TD>')/'</TR>')
58259 300 FORMAT(5(/'<TD ALIGN="RIGHT">',F12.5,'</TD>'),1P,
58260 & 4(/'<TD ALIGN="RIGHT">',E11.4,'</TD>')/'</TR>')
58262 C Do not include vertex information
58265 IF (NPRFMT.EQ.1) THEN
58266 WRITE(6,330) I,RNAME(IDHW(I)),IDHEP(I),IST,
58267 & JMOHEP(1,I),JMOHEP(2,I),JDAHEP(1,I),JDAHEP(2,I),
58268 & (PHEP(J,I),J=1,5)
58270 WRITE(6,340) I,RNAME(IDHW(I)),IDHEP(I),IST,
58271 & JMOHEP(1,I),JMOHEP(2,I),JDAHEP(1,I),JDAHEP(2,I),
58272 & (PHEP(J,I),J=1,5)
58275 IF (NPRFMT.EQ.1) THEN
58276 WRITE(6,350) I,RNAME(IDHW(I)),IDHEP(I),IST,
58277 & JMOHEP(1,I),JMOHEP(2,I),JDAHEP(1,I),JDAHEP(2,I),
58278 & (PHEP(J,I),J=1,5)
58280 WRITE(6,360) I,RNAME(IDHW(I)),IDHEP(I),IST,
58281 & JMOHEP(1,I),JMOHEP(2,I),JDAHEP(1,I),JDAHEP(2,I),
58282 & (PHEP(J,I),J=1,5)
58287 IF (NPRFMT.EQ.1) THEN
58288 WRITE(IUNITT,370) I,TXNAME(1,IDHW(I)),IDHEP(I),
58289 & IST,JMOHEP(1,I),JMOHEP(2,I),JDAHEP(1,I),JDAHEP(2,I),
58290 & (PHEP(J,I),J=1,5),ZZ
58292 WRITE(IUNITT,380) I,TXNAME(1,IDHW(I)),IDHEP(I),
58293 & IST,JMOHEP(1,I),JMOHEP(2,I),JDAHEP(1,I),JDAHEP(2,I),
58294 & (PHEP(J,I),J=1,5),ZZ
58298 WRITE(IUNITW,240) TBCOLS(2),TBCOLS(3),I,I
58299 IF (IDHEP(I).EQ.0.OR.IDHEP(I).EQ.91) THEN
58300 WRITE(IUNITW,250) TXNAME(2,IDHW(I)),IDHEP(I),IST
58302 TMPNME = HWUNST(IDHW(I))
58303 WRITE(FNAMEP,'(A15,A7,A5)')
58304 & 'HW_decays/PART_',TMPNME,'.html'
58305 WRITE(IUNITW,260) FNAMEP,TXNAME(2,IDHW(I)),IDHEP(I),IST
58308 IF (JMOHEP(J,I).NE.0) THEN
58309 WRITE(IUNITW,270) JMOHEP(J,I),JMOHEP(J,I)
58311 WRITE(IUNITW,280) JMOHEP(J,I)
58315 IF (JDAHEP(J,I).NE.0) THEN
58316 WRITE(IUNITW,270) JDAHEP(J,I),JDAHEP(J,I)
58318 WRITE(IUNITW,280) JDAHEP(J,I)
58321 IF (NPRFMT.EQ.1) THEN
58322 WRITE(IUNITW,390) (PHEP(J,I),J=1,5)
58324 WRITE(IUNITW,400) (PHEP(J,I),J=1,5)
58327 330 FORMAT(1X,I4,1X,A8,I8,5I4 ,2F8.2,2F7.1,F8.2)
58328 340 FORMAT(1X,I4,1X,A8,I8,5I4 ,5F12.5)
58329 350 FORMAT(1X,Z4,1X,A8,I8,I4,4Z4,2F8.2,2F7.1,F8.2)
58330 360 FORMAT(1X,Z4,1X,A8,I8,I4,4Z4,5F12.5)
58331 370 FORMAT(I4,' & ',A37,' & $',I8,'$',5(' & ',I4),
58332 & 5(' & $',F8.2,'$'),' ',A2)
58333 380 FORMAT(I4,' & ',A37,' & $',I8,'$',5(' & ',I4),
58334 & 5(' & $',F12.5,'$'),' ',A2)
58335 390 FORMAT(5(/'<TD ALIGN="RIGHT">',F8.2,'</TD>')/'</TR>')
58336 400 FORMAT(5(/'<TD ALIGN="RIGHT">',F12.5,'</TD>')/'</TR>')
58341 WRITE(IUNITT,420) Z,Z,Z
58342 420 FORMAT(A1,'end{longtable}'/A1,'end{center}'/A1,'end{document}')
58347 430 FORMAT('</TABLE>'/'</CENTER>'/'</BODY>'/'</HTML>')
58353 *CMZ :- -13/02/02 07.20.46 by Peter Richardson
58354 *-- Author : Peter Richardson
58355 C-----------------------------------------------------------------------
58357 C-----------------------------------------------------------------------
58358 C Subroutine to handle termination of HERWIG if reaches end of event
58360 C-----------------------------------------------------------------------
58361 INCLUDE 'HERWIG65.INC'
58362 C--reset the number of events to the correct value
58364 C--output information on the events
58366 C--run users end code
58371 *CMZ :- -16/10/93 12.42.15 by Mike Seymour
58372 *-- Author : Mike Seymour
58373 C-----------------------------------------------------------------------
58375 C-----------------------------------------------------------------------
58376 C FINALISES THE EVENT BY UNDOING THE LORENTZ BOOST IF THERE WAS ONE,
58377 C CHECKING FOR ERRORS, AND PRINTING
58378 C-----------------------------------------------------------------------
58379 INCLUDE 'HERWIG65.INC'
58382 COMMON/HWDBUG/CALLED
58384 C---UNBOOST EVENT RECORD IF NECESSARY
58386 C---CHECK FOR NEGATIVE ENERGY PARTICLES (REMNANT BUG?)
58388 IF (ISTHEP(IHEP).EQ.1.AND.PHEP(4,IHEP).LT.ZERO)
58389 & CALL HWWARN('HWUFNE',100,*99)
58392 C---CHECK FOR FATAL ERROR
58393 IF (IERROR.NE.0) THEN
58394 IF (IERROR.GT.0) THEN
58399 IF (NUMER.GT.MAXER) CALL HWWARN('HWUFNE',300,*999)
58401 IF (NEGWTS.AND.EVWGT.LT.ZERO) NNEGEV=NNEGEV-1
58402 C---PRINT FIRST MAXPR EVENTS
58403 ! ELSEIF (NEVHEP.LE.MAXPR) THEN
58404 ELSEIF (NEVHEP.GE.EV1PR.AND.NEVHEP.LE.EV2PR) THEN
58409 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
58410 *-- Author : Adapted by Bryan Webber
58411 C-----------------------------------------------------------------------
58412 FUNCTION HWUGAU(F,A,B,EPS)
58413 C-----------------------------------------------------------------------
58414 C ADAPTIVE GAUSSIAN INTEGRATION OF FUNCTION F
58415 C IN INTERVAL (A,B) WITH PRECISION EPS
58416 C (MODIFIED CERN LIBRARY ROUTINE GAUSS)
58417 C-----------------------------------------------------------------------
58418 DOUBLE PRECISION HWUGAU,F,A,B,EPS,CONST,AA,BB,C1,C2,S8,U,S16,
58422 PARAMETER (ZERO=0.0D0)
58423 DATA W/.1012285363D0,.2223810345D0,.3137066459D0,
58424 & .3626837834D0,.0271524594D0,.0622535239D0,
58425 & .0951585117D0,.1246289713D0,.1495959888D0,
58426 & .1691565194D0,.1826034150D0,.1894506105D0/
58427 DATA X/.9602898565D0,.7966664774D0,.5255324099D0,
58428 & .1834346425D0,.9894009350D0,.9445750231D0,
58429 & .8656312024D0,.7554044084D0,.6178762444D0,
58430 & .4580167777D0,.2816035508D0,.0950125098D0/
58433 CONST=.005/ABS(B-A)
58442 S8=S8+W(I)*(F(C1+U)+F(C1-U))
58448 S16=S16+W(I)*(F(C1+U)+F(C1-U))
58451 IF (ABS(S16-S8).LE.EPS*(1.+ABS(S16))) GOTO 5
58453 IF (CONST*ABS(C2).NE.ZERO) GOTO 2
58454 C---TOO HIGH ACCURACY REQUESTED
58455 CALL HWWARN('HWUGAU',500,*999)
58456 5 HWUGAU=HWUGAU+S16
58457 IF (BB.NE.B) GOTO 1
58460 *CMZ :- -26/04/91 10.18.58 by Bryan Webber
58461 *-- Author : Bryan Webber
58462 C-----------------------------------------------------------------------
58463 SUBROUTINE HWUIDT(IOPT,IPDG,IWIG,NWIG)
58464 C-----------------------------------------------------------------------
58465 C TRANSLATES PARTICLE IDENTIFIERS:
58466 C IPDG = PARTICLE DATA GROUP CODE
58467 C IWIG = HERWIG IDENTITY CODE
58468 C NWIG = HERWIG CHARACTER*8 NAME
58470 C IOPT= 1 GIVEN IPDG, RETURNS IWIG AND NWIG
58471 C IOPT= 2 GIVEN IWIG, RETURNS IPDG AND NWIG
58472 C IOPT= 3 GIVEN NWIG, RETURNS IPDG AND IWIG
58473 C-----------------------------------------------------------------------
58474 INCLUDE 'HERWIG65.INC'
58475 INTEGER IOPT,IPDG,IWIG,I
58477 IF (IOPT.EQ.1) THEN
58479 IF (IDPDG(I).EQ.IPDG) THEN
58486 20 FORMAT(1X,'Particle not recognised, PDG code: ',I8)
58489 CALL HWWARN('HWUIDT',101,*999)
58490 ELSEIF (IOPT.EQ.2) THEN
58491 IF (IWIG.LT.0.OR.IWIG.GT.NRES) THEN
58493 30 FORMAT(1X,'Particle not recognised, HERWIG code: ',I3)
58496 CALL HWWARN('HWUIDT',102,*999)
58502 ELSEIF (IOPT.EQ.3) THEN
58504 IF (RNAME(I).EQ.NWIG) THEN
58511 50 FORMAT(1X,'Particle not recognised, HERWIG name: ',A8)
58514 CALL HWWARN('HWUIDT',103,*999)
58516 CALL HWWARN('HWUIDT',404,*999)
58520 *CMZ :- -12/10/01 09.56.07 by Peter Richardson
58521 *-- Author : Bryan Webber
58522 C-----------------------------------------------------------------------
58524 C-----------------------------------------------------------------------
58525 C COMPUTES CONSTANTS AND LOOKUP TABLES
58526 C---BRW change 27/8/04: include Frixione's fix to reduce PDFSET calls
58527 C-----------------------------------------------------------------------
58528 INCLUDE 'HERWIG65.INC'
58529 DOUBLE PRECISION HWBVMC,HWUALF,HWUPCM,XMIN,XMAX,XPOW,QR,DQKWT,
58530 & UQKWT,SQKWT,DIQWT,QMAX,PMAX,PTLIM,ETLIM,PGS,PTELM,X,QSCA,UPV,DNV,
58531 & USEA,DSEA,STR,CHM,BTM,TOP,GLU,VAL(20),CLMXPW,RCLPOW,TEST,RPM(2)
58532 INTEGER ISTOP,I,J,IQK,IDB,IDT,ISET,IOP1,IOP2,IP2,ID,IH,IV
58533 INTEGER LPROC,KPROC
58534 INTEGER IS,IP(3),IQ
58535 COMMON/SQSQH/JHIGGS,ILBL,JH,IF1MIN,IF1MAX,IF2MIN,IF2MAX
58536 INTEGER JHIGGS,ILBL,JH,IF1MIN,IF1MAX,IF2MIN,IF2MAX
58538 INTEGER IHLP,JHLP,KHLP,ISIGN,ITMP(8)
58539 DATA ITMP/0,12,-12,0,0,12,-12,0/
58540 LOGICAL FIRST,FSTPDF
58541 CHARACTER*20 PARM(20)
58542 EXTERNAL HWBVMC,HWUALF,HWUPCM
58543 COMMON/HWRPIN/XMIN,XMAX,XPOW,FIRST
58544 COMMON/W50516/FSTPDF
58545 CHARACTER*20 PARMSAVE
58546 DOUBLE PRECISION VALSAVE
58547 COMMON/HWSFSA/PARMSAVE
58548 COMMON/HWSFSB/VALSAVE
58549 C--read in the information frmo the Les Houches common block if needed
58550 IF(IPROC.LE.0) CALL HWIGUP
58551 C---MSSM Higgs processes: additional IDs to distinguish from SM-like ones.
58554 C---Sets even parity of Higgs bosons (in the coupling to fermions) as default.
58556 C...define parity of Neutral MSSM Higgses.
58560 C---IPRO=9,11 (lepton-lepton); 31...38 (hadron-hadron) MSSM Higgs production.
58561 LPROC=MOD(IPROC,10000)
58562 IF((LPROC.LT.3100).OR.(LPROC.GE.3900))THEN
58563 C...add here MSSM Higgs processes in lepton-lepton collisions.
58564 IF((LPROC/100.NE.9).AND.(LPROC/100.NE.11))GOTO 666
58566 C-----------------------------------------------------------------------
58567 C HARD 2 LEPTON/PARTON -> HIGGS + X PROCESSES IN MSSM
58568 C IH = 1 MSSM h^0 IV = 0 SM W+/- IQ = 1,3,5 d,s,b-quark
58569 C = 2 MSSM H^0 = 1 SM Z 2,4,6 u,c,t-quark
58570 C = 3 MSSM A^0 ID = IQ, IL
58571 C = 4/5 MSSM H^+/- IL = 1,2,3 e,mu,tau-lepton
58572 C-----------------------------------------------------------------------
58573 C...leptonic processes.
58574 IF(LPROC/100.EQ.9)THEN
58575 IF(LPROC.EQ.955)THEN
58578 ELSE IF(LPROC.EQ.965)THEN
58581 ELSE IF(LPROC.EQ.975)THEN
58584 ELSE IF((LPROC.EQ.910).OR.(LPROC.EQ.920).OR.
58585 & (LPROC.EQ.960).OR.(LPROC.EQ.970))THEN
58586 KPROC=MIN(951,LPROC)
58587 IV=MAX(KPROC-950,0)
58588 IF((IV.LT.0).OR.(IV.GT.1))CALL HWWARN('HWUINC',627,*999)
58589 IH=LPROC/10-90-5*IV
58590 IF((IH.LE.0).OR.(IH.GT.2))CALL HWWARN('HWUINC',626,*999)
58591 IF(LPROC.LE.920)IMSSM=LPROC-400
58592 IF(LPROC.GE.960)IMSSM=LPROC-300
58593 C...assign enhancement for MSSM Higgs-VV couplings, V->W,Z-gauge bosons.
58595 ENHANC(I )=GHWWSS(IH)
58596 ENHANC(I+1)=GHZZSS(IH)
58598 IF(IH.EQ.1)IHIGGS=203-201
58599 IF(IH.EQ.2)IHIGGS=204-201
58600 IF(IH.EQ.3)IHIGGS=205-201
58602 CALL HWWARN('HWUINC',625,*999)
58604 ELSE IF(LPROC/100.EQ.11)THEN
58606 IF(LPROC.GE.1140)THEN
58611 IF(LPROC.LT.1140)IH=3
58612 IF(LPROC.LT.1130)IH=2
58613 IF(LPROC.LT.1120)IH=1
58614 IF((IH.LE.0).OR.(IH.GT.3))CALL HWWARN('HWUINC',624,*999)
58615 IQ=LPROC-1100-10*IH
58616 IF((IQ.LE.0).OR.(IQ.GT.9))CALL HWWARN('HWUINC',623,*999)
58617 C...assign Neutral MSSM Higgs parity.
58619 C...assign enhancement for MSSM Higgs-QQ couplings, Q->U,D-type quarks.
58621 ENHANC(I )=GHDDSS(IH)
58622 ENHANC(I+1)=GHUUSS(IH)
58624 C...assign enhancement for MSSM Higgs-LL couplings, L->D-type leptons.
58625 ENHANC(7)=GHDDSS(IH)
58626 ENHANC(8)=GHDDSS(IH)
58627 ENHANC(9)=GHDDSS(IH)
58628 C...assign enhancement for MSSM Higgs-VV couplings, V->W,Z-gauge bosons.
58630 ENHANC(I )=GHWWSS(IH)
58631 ENHANC(I+1)=GHZZSS(IH)
58633 IF(IH.EQ.1)IHIGGS=203-201
58634 IF(IH.EQ.2)IHIGGS=204-201
58635 IF(IH.EQ.3)IHIGGS=205-201
58637 C...hadronic processes.
58638 ELSE IF((LPROC/100.EQ.31).OR.(LPROC/100.EQ.32))THEN
58639 IF(LPROC/100.EQ.31)THEN
58640 IF((LPROC.LE.3109).OR.
58641 & ((LPROC.GE.3119).AND.(LPROC.LE.3139)).OR.
58642 & ((LPROC.GE.3149).AND.(LPROC.LE.3169)).OR.
58643 & (LPROC.GE.3179))CALL HWWARN('HWUINC',622,*999)
58645 IF(LPROC/100-LPROC/10*10.LE.4)IHIGGS=5
58646 IF(LPROC/100-LPROC/10*10.GE.5)IHIGGS=6
58647 ELSE IF(LPROC/100.EQ.32)THEN
58648 IF(LPROC.LE.3209)CALL HWWARN('HWUINC',621,*999)
58649 IF(LPROC.EQ.3219)CALL HWWARN('HWUINC',620,*999)
58650 IF(LPROC.EQ.3229)CALL HWWARN('HWUINC',619,*999)
58651 IF(LPROC.EQ.3239)CALL HWWARN('HWUINC',618,*999)
58652 IF(LPROC.EQ.3249)CALL HWWARN('HWUINC',617,*999)
58653 IF(LPROC.EQ.3259)CALL HWWARN('HWUINC',616,*999)
58654 IF(LPROC.EQ.3269)CALL HWWARN('HWUINC',615,*999)
58655 IF(LPROC.EQ.3279)CALL HWWARN('HWUINC',614,*999)
58656 IF(LPROC.EQ.3289)CALL HWWARN('HWUINC',613,*999)
58657 IF(LPROC.GE.3299)CALL HWWARN('HWUINC',612,*999)
58659 IF(LPROC.LT.3300)IHIGGS=4
58660 IF(LPROC.LT.3290)IHIGGS=3
58661 IF(LPROC.LT.3280)IHIGGS=2
58662 IF(LPROC.LT.3270)IHIGGS=4
58663 IF(LPROC.LT.3260)IHIGGS=3
58664 IF(LPROC.LT.3250)IHIGGS=2
58665 IF(LPROC.LT.3240)IHIGGS=4
58666 IF(LPROC.LT.3230)IHIGGS=3
58667 IF(LPROC.LT.3220)IHIGGS=2
58669 C...assign squarks/Higgs-flavours.
58670 IF(LPROC/100.EQ.31)JHIGGS=1
58671 IF(LPROC/100.EQ.32)JHIGGS=IHIGGS-1
58672 IF(LPROC/100.EQ.31)ILBL=3100
58673 IF(LPROC/100.EQ.32)ILBL=3200
58674 IHLP=LPROC-ILBL-60-JHIGGS*10
58675 IF(LPROC.LT.ILBL+70)IHLP=LPROC-ILBL-30-JHIGGS*10
58676 IF(LPROC.LT.ILBL+40)IHLP=LPROC-ILBL -JHIGGS*10
58677 IF(IHLP.LE.8)ISIGN=-1
58678 IF(IHLP.LE.4)ISIGN=+1
58680 KHLP=IHLP/(3+4*JHLP)
58681 ISQ1=405+JHLP+12*KHLP
58682 IF(ILBL.EQ.3100)THEN
58683 ISQ2=ISQ1+ITMP(IHLP)+6+ISIGN
58684 IF(ISIGN.EQ.+1)JH=206
58685 IF(ISIGN.EQ.-1)JH=207
58686 IF(ISIGN.EQ.+1)JHIGGS=4
58687 IF(ISIGN.EQ.-1)JHIGGS=5
58688 ELSE IF(ILBL.EQ.3200)THEN
58689 ISQ2=ISQ1+ITMP(IHLP)+6
58690 IF(JHIGGS.EQ.1)JH=203
58691 IF(JHIGGS.EQ.2)JH=204
58692 IF(JHIGGS.EQ.3)JH=205
58698 IF((LPROC.EQ.3110).OR.(LPROC.EQ.3210).OR.
58699 & (LPROC.EQ.3220).OR.(LPROC.EQ.3230).OR.
58700 & (LPROC.EQ.3140).OR.(LPROC.EQ.3240).OR.
58701 & (LPROC.EQ.3250).OR.(LPROC.EQ.3260).OR.
58702 & (LPROC.EQ.3170).OR.(LPROC.EQ.3270).OR.
58703 & (LPROC.EQ.3280).OR.(LPROC.EQ.3290))THEN
58709 ELSE IF(LPROC/100.EQ.33)THEN
58710 IF((LPROC.EQ.3350).OR.(LPROC.EQ.3355))THEN
58713 ELSE IF((LPROC.EQ.3310).OR.(LPROC.EQ.3320).OR.
58714 & (LPROC.EQ.3360).OR.(LPROC.EQ.3370))THEN
58715 KPROC=MIN(3351,LPROC)
58716 IV=MAX(KPROC-3350,0)
58717 IF((IV.LT.0).OR.(IV.GT.1))CALL HWWARN('HWUINC',611,*999)
58718 IH=LPROC/10-330-5*IV
58719 IF((IH.LE.0).OR.(IH.GT.2))CALL HWWARN('HWUINC',610,*999)
58720 IF(LPROC.LE.3320)IMSSM=LPROC-2600
58721 IF(LPROC.GE.3360)IMSSM=LPROC-2700
58722 C...assign enhancement for MSSM Higgs-VV couplings, V->W,Z-gauge bosons.
58724 ENHANC(I )=GHWWSS(IH)
58725 ENHANC(I+1)=GHZZSS(IH)
58727 IF(IH.EQ.1)IHIGGS=203-201
58728 IF(IH.EQ.2)IHIGGS=204-201
58729 IF(IH.EQ.3)IHIGGS=205-201
58730 ELSE IF((LPROC.EQ.3315).OR.(LPROC.EQ.3365))THEN
58733 ELSE IF((LPROC.EQ.3325).OR.(LPROC.EQ.3375))THEN
58736 ELSE IF(LPROC.EQ.3335)THEN
58740 CALL HWWARN('HWUINC',609,*999)
58742 ELSE IF(LPROC/100.EQ.34)THEN
58744 IF(LPROC.EQ.3410)IHIGGS=203-201
58745 IF(LPROC.EQ.3420)IHIGGS=204-201
58746 IF(LPROC.EQ.3430)IHIGGS=205-201
58747 IF(LPROC.EQ.3450)IHIGGS=206-201
58748 IF(IHIGGS.EQ.0)CALL HWWARN('HWUINC',608,*999)
58749 ELSE IF(LPROC/100.EQ.35)THEN
58752 ELSE IF(LPROC/100.EQ.36)THEN
58753 IF((LPROC.NE.3610).AND.(LPROC.NE.3620).AND.(LPROC.NE.3630))
58754 & CALL HWWARN('HWUINC',607,*999)
58756 IF((IH.LE.0).OR.(IH.GT.3))CALL HWWARN('HWUINC',606,*999)
58757 ID=LPROC-3600-10*IH
58758 IF((ID.LT.0).OR.(ID.GT.9))CALL HWWARN('HWUINC',605,*999)
58759 IMSSM=LPROC-(1600+ID)
58760 C...assign Neutral MSSM Higgs parity.
58761 IF(IH.EQ.3)PARITY=-1
58763 C...assign enhancement for Neutral MSSM Higgs-QQ couplings, Q->U,D-type quarks.
58764 ENHANC(I)=GHDDSS(IH)
58765 ENHANC(I+1)=GHUUSS(IH)
58767 C...assign enhancement for Neutral MSSM Higgs-Q~Q~ couplings,
58768 C Q~->U,D-type squarks.
58770 SENHNC(I )=RMASS(198)*GHSQSS(IH,I,1,1)/RMASS(400+I)**2
58771 SENHNC(I+12)=RMASS(198)*GHSQSS(IH,I,2,2)/RMASS(412+I)**2
58773 IF(IH.EQ.1)IHIGGS=203-201
58774 IF(IH.EQ.2)IHIGGS=204-201
58775 IF(IH.EQ.3)IHIGGS=205-201
58776 ELSE IF(LPROC/100.EQ.37)THEN
58778 IF((IH.LE.0).OR.(IH.GT.2))CALL HWWARN('HWUINC',604,*999)
58780 C...assign enhancement for MSSM Higgs-VV couplings, V->W,Z-gauge bosons.
58782 ENHANC(I )=GHWWSS(IH)
58783 ENHANC(I+1)=GHZZSS(IH)
58785 IF(IH.EQ.1)IHIGGS=203-201
58786 IF(IH.EQ.2)IHIGGS=204-201
58787 IF(IH.EQ.3)IHIGGS=205-201
58788 ELSE IF(LPROC/100.EQ.38)THEN
58790 IF((LPROC.EQ.3839).OR.(LPROC.EQ.3869).OR.(LPROC.EQ.3899))THEN
58795 IF(LPROC.LT.4000)IS=6
58796 IF(LPROC.LT.3870)IS=3
58797 IF(LPROC.LT.3840)IS=0
58799 IF((IH.LE.0).OR.(IH.GT.3))CALL HWWARN('HWUINC',603,*999)
58800 IQ=LPROC-3800-10*(IH+IS)
58801 IF((IQ.LE.0).OR.(IQ.GT.6))CALL HWWARN('HWUINC',602,*999)
58802 C...assign Neutral MSSM Higgs parity.
58804 C...assign enhancement for MSSM Higgs-QQ couplings, Q->U,D-type quarks.
58806 ENHANC(I )=GHDDSS(IH)
58807 ENHANC(I+1)=GHUUSS(IH)
58809 IF(IH.EQ.1)IHIGGS=203-201
58810 IF(IH.EQ.2)IHIGGS=204-201
58811 IF(IH.EQ.3)IHIGGS=205-201
58814 IF((IMSSM.NE.-1).AND.(IPROC.GE.10000))IMSSM=IMSSM+10000
58816 IPRO=MOD(IPROC/100,100)
58819 CALL HWUIDT(3,IDB,IPART1,PART1)
58820 CALL HWUIDT(3,IDT,IPART2,PART2)
58821 EBEAM1=SQRT(PBEAM1**2+RMASS(IPART1)**2)
58822 EBEAM2=SQRT(PBEAM2**2+RMASS(IPART2)**2)
58823 C---PHOTON CUTOFF DEFAULTS TO ROOT S
58824 PTLIM=SQRT(HALF*(EBEAM1*EBEAM2+PBEAM1*PBEAM2))
58826 IF (VPCUT.GT.ETLIM) VPCUT=ETLIM
58827 IF (Q2MAX.GT.ETLIM**2) Q2MAX=ETLIM**2
58828 C---PRINT OUT MOST IMPORTANT INPUT PARAMETERS
58829 IF (IPRINT.EQ.0) GOTO 50
58830 WRITE (6,10) PART1,PBEAM1,PART2,PBEAM2,IPROC,
58831 & NFLAV,NSTRU,AZSPIN,AZSOFT,QCDLAM,(RMASS(I),I=1,6),RMASS(13)
58832 IF (ISPAC.LE.1) THEN
58833 WRITE (6,20) VQCUT,VGCUT,VPCUT,CLMAX,QSPAC,PTRMS
58835 WRITE (6,30) VQCUT,VGCUT,VPCUT,CLMAX,QSPAC,PTRMS
58837 C--switch on three body matrix elements if doing spin correlations
58838 IF(SYSPIN) THREEB=.TRUE.
58839 C--output spin correlation options
58840 WRITE(6,35) SYSPIN,THREEB,FOURB
58841 IF (NOSPAC) WRITE (6,40)
58842 10 FORMAT(/10X,'INPUT CONDITIONS FOR THIS RUN'//
58843 & 10X,'BEAM 1 (',A8,') MOM. =',F10.2/
58844 & 10X,'BEAM 2 (',A8,') MOM. =',F10.2/
58845 & 10X,'PROCESS CODE (IPROC) =',I8/
58846 & 10X,'NUMBER OF FLAVOURS =',I5/
58847 & 10X,'STRUCTURE FUNCTION SET =',I5/
58848 & 10X,'AZIM SPIN CORRELATIONS =',L5/
58849 & 10X,'AZIM SOFT CORRELATIONS =',L5/
58850 & 10X,'QCD LAMBDA (GEV) =',F10.4/
58851 & 10X,'DOWN QUARK MASS =',F10.4/
58852 & 10X,'UP QUARK MASS =',F10.4/
58853 & 10X,'STRANGE QUARK MASS =',F10.4/
58854 & 10X,'CHARMED QUARK MASS =',F10.4/
58855 & 10X,'BOTTOM QUARK MASS =',F10.4/
58856 & 10X,'TOP QUARK MASS =',F10.4/
58857 & 10X,'GLUON EFFECTIVE MASS =',F10.4)
58858 20 FORMAT(10X,'EXTRA SHOWER CUTOFF (Q)=',F10.4/
58859 & 10X,'EXTRA SHOWER CUTOFF (G)=',F10.4/
58860 & 10X,'PHOTON SHOWER CUTOFF =',F10.4/
58861 & 10X,'CLUSTER MASS PARAMETER =',F10.4/
58862 & 10X,'SPACELIKE EVOLN CUTOFF =',F10.4/
58863 & 10X,'INTRINSIC P-TRAN (RMS) =',F10.4)
58864 30 FORMAT(10X,'EXTRA SHOWER CUTOFF (Q)=',F10.4/
58865 & 10X,'EXTRA SHOWER CUTOFF (G)=',F10.4/
58866 & 10X,'PHOTON SHOWER CUTOFF =',F10.4/
58867 & 10X,'CLUSTER MASS PARAMETER =',F10.4/
58868 & 10X,'PDF FREEZING CUTOFF =',F10.4/
58869 & 10X,'INTRINSIC P-TRAN (RMS) =',F10.4)
58870 35 FORMAT(10X,'DECAY SPIN CORRELATIONS=',L5/
58871 & 10X,'SUSY THREE BODY ME =',L5/
58872 & 10X,'SUSY FOUR BODY ME =',L5)
58873 40 FORMAT(10X,'NO SPACE-LIKE SHOWERS')
58875 C---INITIALIZE ALPHA-STRONG
58876 IF (QLIM.GT.ETLIM) QLIM=ETLIM
58878 C---DO SOME SAFETY CHECKS ON INPUT PARAMETERS
58879 C Check beam order for point-like photon/QCD processes
58880 IF (IPRO.GE.50.AND.IPRO.LE.59.AND.
58881 & IDB.NE.22.AND.ABS(IDB).NE.11.AND.ABS(IDB).NE.13) THEN
58883 60 FORMAT(1X,'WARNING: require FIRST beam to be a photon/lepton')
58888 IF (QR.GE.2.01) GOTO 80
58889 WRITE (6,70) QG,QCDLAM,QCDL3
58890 70 FORMAT(//10X,'SHOWER GLUON VIRTUAL MASS CUTOFF =',F8.5/
58891 & 10X,'TOO SMALL RELATIVE TO QCD LAMBDA =',F8.5/
58892 & 10X,'CORRESPONDS TO 3-FLAV MC LAMBDA =',F8.5)
58894 80 QV=MIN(HWBVMC(1),HWBVMC(2))
58895 IF (QV.GE.QG/(QR-1.)) GOTO 100
58897 WRITE (6,90) QV,QCDLAM,QCDL3
58898 90 FORMAT(//10X,'SHOWER QUARK VIRTUAL MASS CUTOFF =',F8.5/
58899 & 10X,'TOO SMALL RELATIVE TO QCD LAMBDA =',F8.5/
58900 & 10X,'CORRESPONDS TO 3-FLAV MC LAMBDA =',F8.5)
58901 100 IF (ISTOP.NE.0) THEN
58902 WRITE (6,110) ISTOP
58903 110 FORMAT(//10X,'EXECUTION PREVENTED BY',I2,
58904 & ' ERRORS IN INPUT PARAMETERS.')
58908 120 RMASS(I+6)=RMASS(I)
58909 RMASS(199)=RMASS(198)
58910 C---A PRIORI WEIGHTS FOR QUARK AND DIQUARKS
58919 PWT(4)=UQKWT*UQKWT*DIQWT
58920 PWT(5)=UQKWT*DQKWT*DIQWT*HALF
58921 PWT(6)=DQKWT*DQKWT*DIQWT
58922 PWT(7)=UQKWT*SQKWT*DIQWT*HALF
58923 PWT(8)=DQKWT*SQKWT*DIQWT*HALF
58924 PWT(9)=SQKWT*SQKWT*DIQWT
58925 QMAX=MAX(PWT(1),PWT(2),PWT(3))
58926 PMAX=MAX(PWT(4),PWT(5),PWT(6),PWT(7),PWT(8),PWT(9),
58927 & PWT(10),PWT(11),PWT(12),QMAX)
58931 130 QWT(I)=PWT(I)*QMAX
58933 140 PWT(I)=PWT(I)*PMAX
58934 C MASSES OF DIQUARKS (ASSUME BINDING NEGLIGIBLE)
58935 RMASS(109)=RMASS(2)+RMASS(2)
58936 RMASS(110)=RMASS(1)+RMASS(2)
58937 RMASS(111)=RMASS(1)+RMASS(1)
58938 RMASS(112)=RMASS(2)+RMASS(3)
58939 RMASS(113)=RMASS(1)+RMASS(3)
58940 RMASS(114)=RMASS(3)+RMASS(3)
58942 150 RMASS(I+6)=RMASS(I)
58943 C MASSES OF TOP HADRONS (ASSUME BINDING NEGLIGIBLE)
58944 RMASS(232)=RMASS(6)+RMASS(5)
58945 RMASS(233)=RMASS(6)+RMASS(1)
58946 RMASS(234)=RMASS(6)+RMASS(2)
58947 RMASS(235)=RMASS(6)+RMASS(3)
58948 RMASS(236)=RMASS(6)+RMASS(2)+RMASS(2)
58949 RMASS(237)=RMASS(6)+RMASS(1)+RMASS(2)
58950 RMASS(238)=RMASS(6)+RMASS(1)+RMASS(1)
58951 RMASS(239)=RMASS(6)+RMASS(2)+RMASS(3)
58952 RMASS(240)=RMASS(6)+RMASS(1)+RMASS(3)
58953 RMASS(241)=RMASS(6)+RMASS(3)+RMASS(3)
58954 RMASS(242)=RMASS(6)+RMASS(4)
58955 RMASS(243)=RMASS(6)+RMASS(5)
58956 RMASS(244)=RMASS(6)+RMASS(6)
58957 RMASS(232)=RMASS(243)
58959 160 RMASS(I+22)=RMASS(I)
58960 C Set up an array of cluster mass threholds
58961 CLMXPW=CLMAX**CLPOW
58963 CALL HWVZRO(144,CTHRPW(1,1))
58966 CTHRPW(I ,J )=(CLMXPW+(RMASS(I )+RMASS(J+6 ))**CLPOW)**RCLPOW
58967 CTHRPW(I ,J+6)=(CLMXPW+(RMASS(I )+RMASS(J+108))**CLPOW)**RCLPOW
58968 170 CTHRPW(I+6,J )=(CLMXPW+(RMASS(I+114)+RMASS(J+6 ))**CLPOW)**RCLPOW
58969 C Decay length conversion factor GEV2MM hbar.c/e
58970 GEV2MM=1.D-15*SQRT(GEV2NB/10.)
58971 C Plank's constant/2pi (GeV.s)
58973 C Check the SUSY DATA has been read in (if needed)
58974 IF((IPRO.EQ.7.OR.IPRO.EQ.8.OR.IPRO.EQ.9.OR.IPRO.EQ.11.
58975 &OR.(IPRO.GE.30.AND.IPRO.LE.41)).AND..NOT.SUSYIN)
58976 & CALL HWWARN('HWUINC',601,*999)
58977 C---IMPORTANCE SAMPLING
58982 IF (IPRO.EQ.5) THEN
58983 IF (EMMAX.GT.ETLIM) EMMAX=ETLIM
58984 IF (PTMAX.GT.PTLIM) PTMAX=PTLIM
58985 ELSEIF (IPRO.EQ.13) THEN
58986 IF (EMMIN.EQ.ZERO) EMMIN=10
58987 IF (EMMAX.GT.ETLIM) EMMAX=ETLIM
58988 IF (IQK.GT.0.AND.IQK.LE.6) EMMIN=MAX(EMMIN,2*RMASS(IQK))
58992 ELSEIF (IPRO.EQ.15.OR.IPRO.EQ.17.OR.IPRO.EQ.18.OR.IPRO.EQ.21
58993 & .OR.IPRO.EQ.22.OR.IPRO.EQ.23.OR.IPRO.EQ.24.OR.IPRO.EQ.50
58994 & .OR.IPRO.EQ.51.OR.IPRO.EQ.53.OR.IPRO.EQ.55.OR.IPRO.EQ.60) THEN
58995 IF (PTMAX.GT.PTLIM) PTMAX=PTLIM
58996 IF (IQK.NE.0.AND.IQK.LT.7.AND.IPRO.NE.23) THEN
58997 XMIN=2.*SQRT(PTMIN**2+RMASS(IQK)**2)
58998 XMAX=2.*SQRT(PTMAX**2+RMASS(IQK)**2)
58999 IF (XMAX.GT.ETLIM) XMAX=ETLIM
59005 C--Gauge Boson pairs in hadron-hadron
59006 ELSEIF(IPRO.EQ.28) THEN
59007 IF(EMMIN.EQ.ZERO) EMMIN=20.0D0
59008 C--Drell-Yan + 2 jets processes
59009 ELSEIF(IPRO.EQ.29) THEN
59010 IF(EMMIN.EQ.ZERO) EMMIN=20.0D0
59011 IF(PTMAX.GT.ETLIM) PTMAX = ETLIM
59012 C--Cuts on the graviton to avoid unitarity violations
59013 C--If the width exceeds 0.1 times the mass this should be reset
59014 ELSEIF(IPRO.EQ.42) THEN
59015 EMMIN = 0.9D0*EMGRV
59016 EMMAX = 1.1D0*EMGRV
59017 ELSEIF (IPRO.EQ.52) THEN
59018 PTELM=PTLIM-RMASS(IQK)**2/(4.*PTLIM)
59019 IF (PTMAX.GT.PTELM) PTMAX=PTELM
59023 ELSEIF (IPRO.EQ.30) THEN
59024 IF (PTMAX.GT.PTLIM) PTMAX=PTLIM
59025 XMIN=2.*SQRT(PTMIN**2+RMMNSS**2)
59026 XMAX=2.*SQRT(PTMAX**2+RMMNSS**2)
59027 IF (XMAX.GT.ETLIM) XMAX=ETLIM
59030 ELSEIF(IPRO.EQ.40.OR.IPRO.EQ.41) THEN
59031 IF (PTMAX.GT.PTLIM) PTMAX=PTLIM
59032 ID = MOD(IPROC,100)
59035 IF(ID.GE.10.AND.ID.LT.20) THEN
59036 RPM(1) = ABS(RMASS(450))
59037 IF(ID.GT.10) RPM(1) = ABS(RMASS(449+MOD(ID,10)))
59038 ELSEIF(ID.GE.20.AND.ID.LT.30) THEN
59039 RPM(1) = ABS(RMASS(454))
59040 IF(ID.GT.20) RPM(1) = ABS(RMASS(453+MOD(ID,20)))
59041 ELSEIF(ID.EQ.30) THEN
59042 RPM(1) = RMASS(449)
59043 ELSEIF(ID.EQ.40) THEN
59044 IF(IPRO.EQ.40) THEN
59045 RPM(1) = RMASS(425)
59047 RPM(1) = MIN(RPM(1),RMASS(425+I))
59050 RPM(1) = MIN(RMASS(405),RMASS(406))
59052 RPM(2) = RMASS(198)
59053 ELSEIF(ID.EQ.50) THEN
59054 IF(IPRO.EQ.40) THEN
59055 RPM(1) = RMASS(425)
59057 RPM(1) = MIN(RPM(1),RMASS(425+I))
59060 RPM(2) = MIN(RPM(1),RMASS(433+2*I))
59062 RPM(1) = MIN(RPM(1),RPM(2))
59063 RPM(2) = RMASS(203)
59065 RPM(2) = MIN(RPM(2),RMASS(204+I))
59068 RPM(1) = RMASS(401)
59069 RPM(2) = RMASS(413)
59071 RPM(1) = MIN(RPM(1),RMASS(401+I))
59072 RPM(2) = MIN(RPM(2),RMASS(413+I))
59074 RPM(1) = MIN(RPM(1),RPM(2))
59075 RPM(2) = RMASS(203)
59077 RPM(2) = MIN(RPM(2),RMASS(204+I))
59080 RPM(2) = RMASS(203)
59082 RPM(2) = MIN(RPM(2),RMASS(204+I))
59084 ELSEIF(ID.GE.60) THEN
59089 XMIN = SQRT(RPM(1)+RPM(2)+TWO*(PTMIN**2+
59090 & SQRT(RPM(1)*RPM(2)+PTMIN**2*(RPM(1)+RPM(2)+PTMIN**2))))
59091 XMAX = SQRT(RPM(1)+RPM(2)+TWO*(PTMAX**2+
59092 & SQRT(RPM(1)*RPM(2)+PTMAX**2*(RPM(1)+RPM(2)+PTMAX**2))))
59093 IF (XMAX.GT.ETLIM) XMAX=ETLIM
59095 ELSEIF (IPRO.EQ.90) THEN
59099 ELSEIF (IPRO.EQ.91) THEN
59100 IF (EMMAX.GT.ETLIM) EMMAX=ETLIM
59102 C---CALCULATE HIGGS WIDTH
59103 IF (IPRO.EQ. 3.OR.IPRO.EQ. 4.OR.IPRO.EQ.10.OR.IPRO.EQ.16
59104 &.OR.IPRO.EQ.19.OR.IPRO.EQ.23.OR.IPRO.EQ.25.OR.IPRO.EQ.26
59105 &.OR.IPRO.EQ.27.OR.IPRO.EQ.95) THEN
59109 C---IF Q**2 CAN BE TOO SMALL, BREIT FRAME MAKES NO SENSE
59110 IF ((IPRO/10.EQ.9.AND.Q2MIN.LE.1.D-2).OR.
59111 & (IPRO.EQ.91.AND.IQK.EQ.7)) BREIT=.FALSE.
59112 IF (IPRINT.NE.0) THEN
59113 IF (PBEAM1.NE.PBEAM2) WRITE (6,180) USECMF
59114 IF (IPRO.EQ.91.OR.IPRO.EQ.92)
59115 & WRITE (6,190) PTMIN
59116 IF (IPRO.EQ.90.OR.(IPRO.EQ.91.AND.IQK.NE.7).OR.IPRO.EQ.92)
59117 & WRITE (6,200) Q2MIN,Q2MAX,BREIT
59118 IF (IPRO.EQ.90.OR.(IPRO.EQ.91.AND.IQK.NE.7).OR.IPRO.EQ.92)
59119 & WRITE (6,210) YBMIN,YBMAX
59120 IF (IPRO.EQ.91.AND.IQK.EQ.7)
59121 & WRITE (6,220) Q2WWMN,Q2WWMX,BREIT,ZJMAX
59122 IF (IPROC/10.EQ.11) WRITE (6,230) THMAX
59123 IF (IPRO.EQ.13) WRITE (6,240) EMMIN,EMMAX
59124 IF (IPRO.EQ.15.OR.IPRO.EQ.17.OR.IPRO.EQ.18.OR.IPRO.EQ.21
59125 & .OR.IPRO.EQ.22.OR.IPRO.EQ.23.OR.IPRO.EQ.24.OR.IPRO.EQ.50
59126 & .OR.IPRO.EQ.51.OR.IPRO.EQ.52.OR.IPRO.EQ.53.OR.IPRO.EQ.55
59128 & WRITE (6,250) PTMIN,PTMAX
59129 IF (IPRO.EQ. 3.OR.IPRO.EQ. 4.OR.IPRO.EQ.10.OR.IPRO.EQ.16
59130 & .OR.IPRO.EQ.19.OR.IPRO.EQ.23.OR.IPRO.EQ.25.OR.IPRO.EQ.26
59131 & .OR.IPRO.EQ.27.OR.IPRO.EQ.95)
59132 & WRITE (6,260) RMASS(201),GAMH,
59133 & GAMMAX,RMASS(201)+GAMMAX*GAMH,(BRHIG(I)*100,I=1,12)
59134 IF (IPRO.EQ.91) WRITE (6,270) BGSHAT,EMMIN,EMMAX
59135 IF (IPRO.EQ.5.AND.IQK.LT.50)
59136 & WRITE (6,280) EMMIN,EMMAX,PTMIN,PTMAX,CTMAX
59137 IF (IPRO.EQ.5.AND.IQK.GE.50)
59138 & WRITE (6,290) EMMIN,EMMAX,Q2MIN,Q2MAX,PTMIN
59139 IF (IPRO.GT.12.AND.
59140 & (IPRO.LT.90.AND.(ABS(IDB).EQ.11.OR.ABS(IDB).EQ.13).OR.
59141 & (ABS(IDT).EQ.11.OR.ABS(IDT).EQ.13))) THEN
59142 WRITE (6,300) Q2WWMN,Q2WWMX,YWWMIN,YWWMAX
59143 IF (PHOMAS.GT.ZERO) WRITE (6,310) PHOMAS
59145 IF (IPROC/10.EQ.10.OR.IPRO.EQ.90)
59146 & WRITE (6,320) HARDME,SOFTME
59147 C Check minimum mass threshold if ISR switched on
59148 IF ((IPRO.LE.3.OR.IPRO.EQ.6).AND.ZMXISR.GT.ZERO) THEN
59149 TEST=TWO*RMASS(IPART1)**2+ETLIM**2
59150 TEST=FOUR*RMASS(2)**2/TEST
59151 IF (TMNISR.LT.TEST) THEN
59152 WRITE(6,175) TMNISR,TEST
59153 175 FORMAT(10X,'Minimum invariant mass',F10.6,' too low'/
59154 & 10X,'increasing to TMNISR=',F10.6)
59157 WRITE (6,330) TMNISR,ONE-ZMXISR
59159 IF (WHMIN.GT.ZERO .AND. IPRO.GT.12.AND.(IPRO.EQ.90.OR.
59160 & (ABS(IDB).EQ.11.OR.ABS(IDB).EQ.13).OR.
59161 & (ABS(IDT).EQ.11.OR.ABS(IDT).EQ.13))) WRITE (6,340) WHMIN
59162 180 FORMAT(10X,'USE BEAM-TARGET C.M.F. =',L5)
59163 190 FORMAT(10X,'MIN P-T FOR O(AS) DILS =',F10.4)
59164 200 FORMAT(10X,'MIN ABS(Q**2) FOR DILS =',E10.4/
59165 & 10X,'MAX ABS(Q**2) FOR DILS =',E10.4/
59166 & 10X,'BREIT FRAME SHOWERING =',L5)
59167 210 FORMAT(10X,'MIN BJORKEN Y FOR DILS =',F10.4/
59168 & 10X,'MAX BJORKEN Y FOR DILS =',F10.4)
59169 220 FORMAT(10X,'MIN ABS(Q**2) FOR J/PSI=',E10.4/
59170 & 10X,'MAX ABS(Q**2) FOR J/PSI=',E10.4/
59171 & 10X,'BREIT FRAME SHOWERING =',L5/
59172 & 10X,'MAX Z FOR J/PSI =',F10.4)
59173 230 FORMAT(10X,'MAX THRUST FOR 2->3 =',F10.4)
59174 240 FORMAT(10X,'MIN MASS FOR DRELL-YAN =',F10.4/
59175 & 10X,'MAX MASS FOR DRELL-YAN =',F10.4)
59176 250 FORMAT(10X,'MIN P-TRAN FOR 2->2 =',F10.4/
59177 & 10X,'MAX P-TRAN FOR 2->2 =',F10.4)
59178 260 FORMAT(10X,'HIGGS BOSON MASS =',F10.4/
59179 & 10X,'HIGGS BOSON WIDTH =',F10.4/
59180 & 10X,'CUTOFF = EMH +',F4.1,'*GAMH=',F10.4/
59181 & 10X,'HIGGS D DBAR =',F10.4/
59182 & 10X,'BRANCHING U UBAR =',F10.4/
59183 & 10X,'FRACTIONS S SBAR =',F10.4/
59184 & 10X,'(PER CENT) C CBAR =',F10.4/
59185 & 10X,' B BBAR =',F10.4/
59186 & 10X,' T TBAR =',F10.4/
59187 & 10X,' E+ E- =',F10.4/
59188 & 10X,' MU+ MU- =',F10.4/
59189 & 10X,' TAU+ TAU- =',F10.4/
59190 & 10X,' W W =',F10.4/
59191 & 10X,' Z Z =',F10.4/
59192 & 10X,' GAMMA GAMMA =',F10.4)
59193 270 FORMAT(10X,'SCALE FOR BGF IS S-HAT =',L5/
59194 & 10X,'MIN MASS FOR BGF =',F10.4/
59195 & 10X,'MAX MASS FOR BGF =',F10.4)
59196 280 FORMAT(10X,'MIN MASS FOR 2 PHOTONS =',F10.4/
59197 & 10X,'MAX MASS FOR 2 PHOTONS =',F10.4/
59198 & 10X,'MIN PT OF 2 PHOTON CMF =',F10.4/
59199 & 10X,'MAX PT OF 2 PHOTON CMF =',F10.4/
59200 & 10X,'MAX COS THETA IN CMF =',F10.4)
59201 290 FORMAT(10X,'MIN MASS FOR GAMMA + W =',F10.4/
59202 & 10X,'MAX MASS FOR GAMMA + W =',F10.4/
59203 & 10X,'MIN ABS(Q**2) =',E10.4/
59204 & 10X,'MAX ABS(Q**2) =',E10.4/
59205 & 10X,'MIN PT =',F10.4)
59206 300 FORMAT(10X,'MIN Q**2 FOR WW PHOTON =',F10.4/
59207 & 10X,'MAX Q**2 FOR WW PHOTON =',F10.4/
59208 & 10X,'MIN MOMENTUM FRACTION =',F10.4/
59209 & 10X,'MAX MOMENTUM FRACTION =',F10.4)
59210 310 FORMAT(10X,'GAMMA* S.F. MASS PARAM =',F10.4)
59211 320 FORMAT(10X,'HARD M.E. MATCHING =',L5/
59212 & 10X,'SOFT M.E. MATCHING =',L5)
59213 330 FORMAT(10X,'MIN MTM FRAC FOR ISR =',1PE10.4/
59214 & 10X,'1-MAX MTM FRAC FOR ISR =',1PE10.4)
59215 340 FORMAT(10X,'MINIMUM HADRONIC MASS =',F10.4)
59216 IF (LWEVT.LE.0) THEN
59219 WRITE (6,360) LWEVT
59221 350 FORMAT(/10X,'NO EVENTS WILL BE WRITTEN TO DISK')
59222 360 FORMAT(/10X,'EVENTS WILL BE OUTPUT ON UNIT',I4)
59224 C Verify and print beam polarisations
59225 IF((IPRO.EQ.1.OR.IPRO.EQ.3).OR.
59226 & ((IPRO.EQ.9).AND.(MOD(IPROC,10000).EQ.960)).OR.
59227 & ((IPRO.EQ.9).AND.(MOD(IPROC,10000).EQ.970)))THEN
59228 C Set up transverse polarisation parameters for e+e-
59229 IF ((EPOLN(1)**2+EPOLN(2)**2)
59230 & *(PPOLN(1)**2+PPOLN(2)**2).GT.ZERO) THEN
59232 COSS=EPOLN(1)*PPOLN(1)-EPOLN(2)*PPOLN(2)
59233 SINS=EPOLN(2)*PPOLN(1)+EPOLN(1)*PPOLN(2)
59237 C print out lepton beam polarisation(s)
59238 IF (IPRINT.NE.0) THEN
59239 IF (IPART1.EQ.121) THEN
59240 WRITE (6,370) PART1,EPOLN,PART2,PPOLN
59242 WRITE (6,370) PART1,PPOLN,PART2,EPOLN
59244 370 FORMAT(/10X,A8,'Beam polarisation=',3F10.4/
59245 & 10X,A8,'Beam polarisation=',3F10.4)
59247 ELSEIF (IPRO.GE.90.AND.IPRO.LE.99) THEN
59248 IF (IDB.GE.11.AND.IDB.LE.16) THEN
59249 CALL HWVZRO(3,PPOLN)
59250 C Check neutrino polarisations for DIS
59251 IF (IDB.EQ. 12.OR.IDB.EQ. 14.OR.IDB.EQ. 16.AND.
59252 & EPOLN(3).NE.-ONE) EPOLN(3)=-ONE
59253 IF (IPRINT.NE.0) WRITE(6,380) PART1,EPOLN(3)
59255 CALL HWVZRO(3,EPOLN)
59256 C Check anti-neutrino polarisations for DIS
59257 IF (IDB.EQ.-12.OR.IDB.EQ.-14.OR.IDB.EQ.-16.AND.
59258 & PPOLN(3).NE.ONE) PPOLN(3)=ONE
59259 IF (IPRINT.NE.0) WRITE(6,380) PART1,PPOLN(3)
59261 380 FORMAT(/10X,A8,1X,'Longitudinal beam polarisation=',F10.4/)
59263 IF (IPRINT.NE.0) THEN
59265 WRITE(6,390) RMASS(200),RMASS(202),GAMZ,GAMZP
59266 WRITE(6,400) (RNAME(I),VFCH(I,1),AFCH(I,1),VFCH(I,2),
59268 WRITE(6,400) (RNAME(110+I),VFCH(I,1),AFCH(I,1),
59269 & VFCH(I,2),AFCH(I,2),I=11,16)
59270 390 FORMAT(/10X,'MASSIVE NEUTRAL VECTOR BOSON PARAMS'/
59271 & 10X,'Z MASS=',F10.4,7X,'Z-PRIME MASS=',F10.4/
59272 & 10X,' WIDTH=',F10.4,7X,' WIDTH=',F10.4/
59273 & 10X,'FERMION COUPLINGS: e.(V.1+A.G_5)G_mu'/
59274 & 10X,'FERMION: VECTOR AXIAL',6X,
59276 400 FORMAT(10X,A8,2X,F10.4,1X,F10.4,1X,F10.4,1X,F10.4)
59279 WRITE(6,410) XMIX(2),YMIX(2),XMIX(1),YMIX(1)
59280 410 FORMAT(/10X,'B_d: Delt-M/Gam =',F6.4,
59281 & ' Delt-Gam/2*Gam =',F6.4,/
59282 & 10X,'B_s: Delt-M/Gam =',F6.2,
59283 & ' Delt-Gam/2*Gam =',F6.4)
59285 IF (CLRECO) WRITE(6,420) PRECO,EXAG
59286 420 FORMAT(/10X,'Colour rearrangement ALLOWED, probability =',F6.4,/
59287 & 10x,'Weak boson life-time exaggeration factor =',F10.6)
59288 C---PDF STRUCTURE FUNCTIONS
59291 IF (MODPDF(I).GE.0) THEN
59292 WRITE (6,430) I,MODPDF(I),AUTPDF(I)
59296 430 FORMAT(10X,'PDFLIB USED FOR BEAM',I2,': SET',I3,' OF ',A20)
59297 440 FORMAT(10X,'PDFLIB NOT USED FOR BEAM',I2)
59299 C---GET THE UGLY INITIALISATION MESSAGES OVER AND DONE WITH NOW TOO
59301 IF (MODPDF(I).GE.0) THEN
59303 VAL(1)=FLOAT(MODPDF(I))
59309 C---FIX TO CALL SCHULER-SJOSTRAND CODE
59310 IF (AUTPDF(I).EQ.'SaSph') THEN
59311 ISET=MOD(MODPDF(I),10)
59312 IOP1=MOD(MODPDF(I)/10,2)
59313 IOP2=MOD(MODPDF(I)/20,2)
59315 IF (ISET.EQ.1) THEN
59316 WRITE (6,'(10X,A)')'SCHULER-SJOSTRAND PHOTON PDF SET 1D'
59317 ELSEIF (ISET.EQ.2) THEN
59318 WRITE (6,'(10X,A)')'SCHULER-SJOSTRAND PHOTON PDF SET 1M'
59319 ELSEIF (ISET.EQ.3) THEN
59320 WRITE (6,'(10X,A)')'SCHULER-SJOSTRAND PHOTON PDF SET 2D'
59321 ELSEIF (ISET.EQ.4) THEN
59322 WRITE (6,'(10X,A)')'SCHULER-SJOSTRAND PHOTON PDF SET 2M'
59324 WRITE (6,'(10X,A)')'UNKNOWN SCHULER-SJOSTRAND PDF SET'
59325 CALL HWWARN('HWUINC',500,*999)
59327 IF (IOP1.EQ.1) THEN
59328 WRITE (6,'(10X,A)') 'WITH DIRECT COMPONENT IN DIS'
59329 IF (IPRO.NE.90) WRITE (6,'(10X,A)')
59330 $ 'NOT RECOMMENDED FOR NON-DIS PROCESSES'
59332 IF (IOP2.EQ.1) THEN
59333 WRITE (6,'(10X,A)') 'WITH P**2 DEPENDENCE INCLUDED'
59334 IF (PHOMAS.GT.ZERO)
59335 $ WRITE (6,'(10X,A)') 'NOT RECOMMENDED WITH PHOMAS.GT.0'
59337 $ WRITE (6,'(10X,A,I2)') 'WITH IP2 OPTION EQUAL TO',IP2
59339 ELSEIF (AUTPDF(I).EQ.'SSph') THEN
59340 WRITE (6,'(10X,A)') 'THE ACRONYM FOR SCHULER-SJOSTRAND'
59341 WRITE (6,'(10X,A)') 'HAS CHANGED TO SaSph ACCORDING TO'
59342 WRITE (6,'(10X,A)') 'THEIR WISHES. SSph NO LONGER WORKS'
59345 CALL PDFSET(PARM,VAL)
59346 CALL STRUCTM(X,QSCA,UPV,DNV,USEA,DSEA,STR,CHM,BTM,TOP,GLU)
59352 C Set up neutral B meson mixing parameters
59353 IF (MIXING.AND..NOT.(RSTAB(223).AND.RSTAB(247))) THEN
59354 XMRCT(1)=XMIX(1)*RMASS(223)/(CSPEED*RLTIM(223))
59355 YMRCT(1)=YMIX(1)*RMASS(223)/(CSPEED*RLTIM(223))
59357 IF (MIXING.AND..NOT.(RSTAB(221).AND.RSTAB(245))) THEN
59358 XMRCT(2)=XMIX(2)*RMASS(221)/(CSPEED*RLTIM(221))
59359 YMRCT(2)=YMIX(2)*RMASS(221)/(CSPEED*RLTIM(221))
59361 C---B DECAY PACKAGE
59362 IF (BDECAY.EQ.'EURO') THEN
59363 IF (IPRINT.NE.0) WRITE (6,470) 'EURODEC'
59364 ELSEIF (BDECAY.EQ.'CLEO') THEN
59365 IF (IPRINT.NE.0) WRITE (6,470) 'CLEO'
59369 470 FORMAT (10X,A,' B DECAY PACKAGE WILL BE USED')
59370 C---TAU DECAY PACKAGE
59371 IF(TAUDEC.EQ.'TAUOLA') THEN
59372 IF(IPRINT.NE.0) WRITE(6,475) 'TAUOLA'
59373 CALL HWDTAU(-1,0,0.0D0)
59375 475 FORMAT(10X,A,' TAU DECAY PACKAGE WILL BE USED'/)
59376 C---COMPUTE PARTICLE PROPERTIES FOR HADRONIZATION
59378 C Prepare internal decay tables and do diagnostic checks
59380 C Convert ampersands to backslahes in particle LaTeX names
59382 C---MISCELLANEOUS DERIVED QUANTITIES
59383 TMTOP=2.*LOG(RMASS(6)/30.)
59384 PXRMS=PTRMS/SQRT(2.)
59386 PSPLT(1)=1./PSPLT(1)
59387 PSPLT(2)=1./PSPLT(2)
59392 PGS=HWUPCM(RMASS(13),RMASS(I),RMASS(I))
59393 IF (PGS.GE.ZERO) NGSPL=I
59394 IF (PGS.GE.PGSMX) PGSMX=PGS
59396 CALL HWVZRO(6,PTINT)
59397 IF (IPRO.NE.80) THEN
59398 C---SET UP TABLES OF SUDAKOV FORM FACTORS, GIVING
59399 C PROBABILITY DISTRIBUTION IN VARIABLE Q = E*SQRT(XI)
59402 C---SET PARAMETERS FOR SPACELIKE BRANCHING
59405 IF (QEV(J,I).GT.QSPAC) GOTO 500
59411 C--optimize the weights for the channels if needed
59413 C--perform the initialisation of the SUSY ME's
59414 IF(SYSPIN.OR.THREEB.OR.FOURB) THEN
59416 IF (IPRINT.NE.0) WRITE (6,510)
59417 510 FORMAT(/10X,'CHECKING SUSY DECAY MATRIX ELEMENTS')
59419 C Print particle decay tables here
59420 IF (IPRINT.GE.2) CALL HWUDPR
59421 C-- initialise photos if needed
59422 IF ((TAUDEC.EQ.'TAUOLA'.AND.IFPHOT.EQ.1).OR.ITOPRD.EQ.1)
59426 *CMZ :- -16/10/93 12.42.15 by Mike Seymour
59427 *-- Author : Bryan Webber
59428 C-----------------------------------------------------------------------
59430 C-----------------------------------------------------------------------
59431 C INITIALISES AN EVENT
59432 C-----------------------------------------------------------------------
59433 INCLUDE 'HERWIG65.INC'
59434 DOUBLE PRECISION HWRGEN,HWRGET,DUMMY
59436 LOGICAL CALLED,HWRLOG
59437 EXTERNAL HWRGEN,HWRGET,HWRLOG
59438 COMMON/HWDBUG/CALLED
59439 C---CHECK THAT MAIN PROGRAM HAS BEEN MODIFIED CORRECTLY
59440 IF (NEVHEP.GT.0.AND..NOT.CALLED) THEN
59442 10 FORMAT (1X,'A call to the subroutine HWUFNE should be added to',
59443 & /,' the main program, immediately after the call to HWMEVT')
59444 CALL HWWARN('HWUINE',500,*999)
59447 C---CHECK TIME LEFT
59449 IF (TL.LT.TLOUT) CALL HWWARN('HWUINE',200,*999)
59450 C---UPDATE RANDOM NUMBER SEED
59451 DUMMY = HWRGET(NRN)
59453 IF (NEGWTS.AND.EVWGT.LT.ZERO) NNEGEV=NNEGEV+1
59461 C---DECIDE WHETHER TO GENERATE SOFT UNDERLYING EVENT
59462 GENSOF=IPROC.GE.1300.AND.IPROC.LT.10000.AND.
59463 & (IPROC.EQ.8000.OR.HWRLOG(PRSOF))
59465 CALL HWVZRI(2*NMXHEP,JMOHEP)
59466 CALL HWVZRI(2*NMXHEP,JDAHEP)
59467 CALL HWVZRO(4*NMXHEP,VHEP)
59468 CALL HWVZRO(3*NMXHEP,RHOHEP)
59472 CALL HWVZRI( NMXHEP,ISNHEP)
59473 CALL HWVZRI( NMXSPN,JMOSPN)
59474 CALL HWVZRI(2*NMXSPN,JDASPN)
59475 CALL HWVZRI( NMXSPN, IDSPN)
59479 *CMZ :- -05/11/95 19.33.42 by Mike Seymour
59480 *-- Author : Adapted by Bryan Webber
59481 C-----------------------------------------------------------------------
59482 SUBROUTINE HWULB4(PS,PI,PF)
59483 C-----------------------------------------------------------------------
59484 C TRANSFORMS PI (GIVEN IN REST FRAME OF PS) INTO PF (IN LAB)
59485 C N.B. P(1,2,3,4) = (PX,PY,PZ,E); PS(5)=M
59486 C-----------------------------------------------------------------------
59487 DOUBLE PRECISION PF4,FN,PS(5),PI(4),PF(4)
59488 IF (PS(4).EQ.PS(5)) THEN
59494 PF4 = (PI(1)*PS(1)+PI(2)*PS(2)
59495 & +PI(3)*PS(3)+PI(4)*PS(4))/PS(5)
59496 FN = (PF4+PI(4)) / (PS(4)+PS(5))
59497 PF(1)= PI(1) + FN*PS(1)
59498 PF(2)= PI(2) + FN*PS(2)
59499 PF(3)= PI(3) + FN*PS(3)
59504 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
59505 *-- Author : Bryan Webber
59506 C----------------------------------------------------------------------
59507 FUNCTION HWULDO(P,Q)
59508 C----------------------------------------------------------------------
59509 C LORENTZ 4-VECTOR DOT PRODUCT
59510 C----------------------------------------------------------------------
59511 DOUBLE PRECISION HWULDO,P(4),Q(4)
59512 HWULDO=P(4)*Q(4)-(P(1)*Q(1)+P(2)*Q(2)+P(3)*Q(3))
59515 *CMZ :- -05/11/95 19.33.42 by Mike Seymour
59516 *-- Author : Adapted by Bryan Webber
59517 C-----------------------------------------------------------------------
59518 SUBROUTINE HWULF4(PS,PI,PF)
59519 C-----------------------------------------------------------------------
59520 C TRANSFORMS PI (GIVEN IN LAB) INTO PF (IN REST FRAME OF PS)
59521 C N.B. P(1,2,3,4) = (PX,PY,PZ,E); PS(5)=M
59522 C-----------------------------------------------------------------------
59523 DOUBLE PRECISION PF4,FN,PS(5),PI(4),PF(4)
59524 IF (PS(4).EQ.PS(5)) THEN
59530 PF4 = (PI(4)*PS(4)-PI(3)*PS(3)
59531 & -PI(2)*PS(2)-PI(1)*PS(1))/PS(5)
59532 FN = (PF4+PI(4)) / (PS(4)+PS(5))
59533 PF(1)= PI(1) - FN*PS(1)
59534 PF(2)= PI(2) - FN*PS(2)
59535 PF(3)= PI(3) - FN*PS(3)
59540 *CMZ :- -23/08/94 13.22.29 by Mike Seymour
59541 *-- Author : Ulrich Baur & Nigel Glover, adapted by Ian Knowles
59542 C-----------------------------------------------------------------------
59544 C-----------------------------------------------------------------------
59545 C Complex dilogarithm function, Li_2 (Spence function)
59546 C-----------------------------------------------------------------------
59548 DOUBLE COMPLEX HWULI2,PROD,Y,Y2,X,Z
59549 DOUBLE PRECISION XR,XI,R2,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,ZETA2,
59551 PARAMETER (ZERO=0.0D0, ONE=1.0D0, HALF=0.5D0)
59552 DATA A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,ZETA2/ -0.250000000000000D0,
59553 & -0.111111111111111D0,-0.010000000000000D0,-0.017006802721088D0,
59554 & -0.019444444444444D0,-0.020661157024793D0,-0.021417300648069D0,
59555 & -0.021948866377231D0,-0.022349233811171D0,-0.022663689135191D0,
59556 & 1.644934066848226D0/
59557 PROD(Y,Y2)=Y*(ONE+A1*Y*(ONE+A2*Y*(ONE+A3*Y2*(ONE+A4*Y2*(ONE+A5*Y2*
59558 & (ONE+A6*Y2*(ONE+A7*Y2*(ONE+A8*Y2*(ONE+A9*Y2*(ONE+A10*Y2))))))))))
59562 IF (R2.GT.ONE.AND.(XR/R2).GT.HALF) THEN
59564 HWULI2=PROD(Z,Z*Z)+ZETA2-LOG(X)*LOG(ONE-X)+HALF*LOG(X)**2
59565 ELSEIF (R2.GT.ONE.AND.(XR/R2).LE.HALF) THEN
59567 HWULI2=-PROD(Z,Z*Z)-ZETA2-HALF*LOG(-X)**2
59568 ELSEIF (R2.EQ.ONE.AND.XI.EQ.ZERO) THEN
59570 ELSEIF (R2.LE.ONE.AND.XR.GT.HALF) THEN
59572 HWULI2=-PROD(Z,Z*Z)+ZETA2-LOG(X)*LOG(ONE-X)
59579 *CMZ :- -05/11/95 19.33.42 by Mike Seymour
59580 *-- Author : Adapted by Bryan Webber
59581 C-----------------------------------------------------------------------
59582 SUBROUTINE HWULOB(PS,PI,PF)
59583 C-----------------------------------------------------------------------
59584 C TRANSFORMS PI (GIVEN IN REST FRAME OF PS) INTO PF (IN LAB)
59585 C N.B. P(1,2,3,4,5) = (PX,PY,PZ,E,M)
59586 C-----------------------------------------------------------------------
59587 DOUBLE PRECISION PS(5),PI(5),PF(5)
59588 CALL HWULB4(PS,PI,PF)
59592 *CMZ :- -05/11/95 19.33.42 by Mike Seymour
59593 *-- Author : Adapted by Bryan Webber
59594 C-----------------------------------------------------------------------
59595 SUBROUTINE HWULOF(PS,PI,PF)
59596 C-----------------------------------------------------------------------
59597 C TRANSFORMS PI (GIVEN IN LAB) INTO PF (IN REST FRAME OF PS)
59598 C N.B. P(1,2,3,4,5) = (PX,PY,PZ,E,M)
59599 C-----------------------------------------------------------------------
59600 DOUBLE PRECISION PS(5),PI(5),PF(5)
59601 CALL HWULF4(PS,PI,PF)
59605 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
59606 *-- Author : Giovanni Abbiendi & Luca Stanco
59607 C-----------------------------------------------------------------------
59608 SUBROUTINE HWULOR (TRANSF,PI,PF)
59609 C-----------------------------------------------------------------------
59610 C Makes the HWULOR transformation specified by TRANSF on the
59611 C quadrivector PI(5), giving PF(5).
59612 C-----------------------------------------------------------------------
59613 DOUBLE PRECISION TRANSF(4,4),PI(5),PF(5)
59620 PF(I) = PF(I) + TRANSF(I,J) * PI(J)
59627 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
59628 *-- Author : Bryan Webber
59629 C-----------------------------------------------------------------------
59630 SUBROUTINE HWUMAS(P)
59631 C-----------------------------------------------------------------------
59632 C PUTS INVARIANT MASS IN 5TH COMPONENT OF VECTOR
59633 C (NEGATIVE SIGN IF SPACELIKE)
59634 C-----------------------------------------------------------------------
59635 DOUBLE PRECISION HWUSQR,P(5)
59637 P(5)=HWUSQR((P(4)+P(3))*(P(4)-P(3))-P(1)**2-P(2)**2)
59640 *CMZ :- -21/02/98 11.11.56 by Bryan Webber
59641 *-- Author : Bryan Webber
59642 C-----------------------------------------------------------------------
59643 FUNCTION HWUMBW(ID)
59644 C-----------------------------------------------------------------------
59645 C CHOOSES MASS ACCORDING TO BREIT-WIGNER DISTRIBUTION
59646 C--BRW fix 27/8/04: changed from mass to mass-squared BW formula
59647 C-----------------------------------------------------------------------
59648 INCLUDE 'HERWIG65.INC'
59649 DOUBLE PRECISION HWUMBW,HWRGEN,WMX,TAU,GAM,T,TM
59651 C--WMX IS MAX NUMBER OF WIDTHS FROM NOMINAL MASS
59654 IF(ID.EQ.198.OR.ID.EQ.199) THEN
59656 ELSEIF(ID.EQ.200) THEN
59658 ELSEIF(ID.EQ.201) THEN
59663 IF (TAU.EQ.ZERO.OR.TAU.GT.1D-18) RETURN
59665 1 T=TAN(PIFAC*(HWRGEN(0)-HALF))
59666 TM=RMASS(ID)*(RMASS(ID)+GAM*T)
59667 IF(TM.LT.ZERO) GOTO 1
59669 IF (ABS(TM-RMASS(ID)).GT.WMX*GAM) GOTO 1
59673 *CMZ :- -27/07/99 13.33.03 by Mike Seymour
59674 *-- Author : Ian Knowles
59675 C-----------------------------------------------------------------------
59677 C-----------------------------------------------------------------------
59678 C Creates a character string of length 7 equivalent to integer N
59679 C-----------------------------------------------------------------------
59680 INTEGER N,I,M,NN(7)
59681 CHARACTER*1 NCHAR(0:9)
59683 DATA NCHAR/'0','1','2','3','4','5','6','7','8','9'/
59688 WRITE(HWUNST,'(7A1)') (NCHAR(NN(I)),I=1,7)
59692 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
59693 *-- Author : Bryan Webber
59694 C-----------------------------------------------------------------------
59695 FUNCTION HWUPCM(EM0,EM1,EM2)
59696 C-----------------------------------------------------------------------
59697 C C.M. MOMENTUM FOR DECAY MASSES EM0 -> EM1 + EM2
59698 C SET TO -1 BELOW THRESHOLD
59699 C-----------------------------------------------------------------------
59700 DOUBLE PRECISION HWUPCM,EM0,EM1,EM2,EMS,EMD
59703 IF (EM0.LT.EMS.OR.EM0.LT.EMD) THEN
59705 ELSEIF (EM0.EQ.EMS.OR.EM0.EQ.EMD) THEN
59708 HWUPCM=SQRT((EM0+EMD)*(EM0-EMD)*
59709 & (EM0+EMS)*(EM0-EMS))*.5/EM0
59713 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
59714 *-- Author : Bryan Webber
59715 C-----------------------------------------------------------------------
59717 C-----------------------------------------------------------------------
59718 C LONGITUDINAL RAPIDITY (SET TO +/-1000 IF TOO LARGE)
59719 C-----------------------------------------------------------------------
59720 DOUBLE PRECISION HWURAP,EMT2,P(5),ZERO
59721 PARAMETER (ZERO=0.D0)
59722 EMT2=P(1)**2+P(2)**2+P(5)**2
59723 IF (P(3).GT.ZERO) THEN
59724 IF (EMT2.EQ.ZERO) THEN
59727 HWURAP= 0.5*LOG((P(3)+P(4))**2/EMT2)
59729 ELSEIF (P(3).LT.ZERO) THEN
59730 IF (EMT2.EQ.ZERO) THEN
59733 HWURAP=-0.5*LOG((P(3)-P(4))**2/EMT2)
59740 *CMZ :- -26/11/00 17.21.55 by Bryan Webber
59741 *-- Author : Kosuke Odagiri
59742 C-----------------------------------------------------------------------
59743 SUBROUTINE HWUMPO(P,M,PMM,MGAM,PPROJ,FPROP)
59744 C-----------------------------------------------------------------------
59745 C RETURNS PROJECTION OPERATOR 1/(P-SLASH - M + I*MGAM) IN WEYL-BASIS
59746 C USED IN SUBROUTINE HWH2QH
59747 C-----------------------------------------------------------------------
59748 DOUBLE PRECISION P(0:3),M,PMM,MGAM,ZERO,ONE
59749 DOUBLE COMPLEX PROP, PPROJ(4,4), CZERO
59751 PARAMETER (ZERO=0.D0,CZERO=(0.D0,0.D0),ONE=1.D0)
59753 PROP=ONE/DCMPLX(PMM,MGAM)
59755 PROP=DCMPLX(ONE/PMM, ZERO)
59757 PPROJ(1,1) = M*PROP
59760 PPROJ(2,2) = PPROJ(1,1)
59761 PPROJ(1,3) = (P(0)-P(3))*PROP
59762 PPROJ(1,4) = DCMPLX(-P(1),P(2))*PROP
59763 PPROJ(2,3) = DCMPLX(-P(1),-P(2))*PROP
59764 PPROJ(2,4) = (P(0)+P(3))*PROP
59765 PPROJ(3,1) = PPROJ(2,4)
59766 PPROJ(3,2) = -PPROJ(1,4)
59767 PPROJ(4,1) = -PPROJ(2,3)
59768 PPROJ(4,2) = PPROJ(1,3)
59769 PPROJ(3,3) = PPROJ(1,1)
59772 PPROJ(4,4) = PPROJ(1,1)
59776 *CMZ :- -26/11/00 17.21.55 by Bryan Webber
59777 *-- Author : Kosuke Odagiri
59778 C-----------------------------------------------------------------------
59779 SUBROUTINE HWUMPP(M,GPM,PERM,U,UU,LR)
59780 C-----------------------------------------------------------------------
59781 C APPLIES OPERATOR FROM HWUMPO ON SPINORS.
59782 C SPINOR COMPONENTS CAN BE PERMUTATED (PERM) AND TRANSVERSED (LR)
59783 C-----------------------------------------------------------------------
59784 DOUBLE COMPLEX U(4), TEMP, A(4,4), M(16), UU(4), CZERO
59785 DOUBLE PRECISION GPM(2), FAC, ZERO, ONE, MONE
59786 INTEGER LR,TV(4,4,2),I,J, PERM(4), IZERO, GTOF(4)
59787 PARAMETER (ZERO=0.D0,CZERO=(0.D0,0.D0),IZERO=0)
59788 PARAMETER (ONE =1.D0,MONE = -1.D0)
59790 DATA TV/1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,
59791 & 1,5,9,13,2,6,10,14,3,7,11,15,4,8,12,16/
59795 IF ((PERM(I).EQ.IZERO).OR.(FAC.EQ.ZERO)) THEN
59800 IF(FAC.EQ.ONE) THEN
59802 ELSEIF(FAC.EQ.MONE) THEN
59805 TEMP = FAC*U(PERM(I))
59807 IF(TEMP.NE.ZERO) THEN
59809 IF(M(TV(I,J,LR)).NE.ZERO) THEN
59810 A(I,J)=TEMP*M(TV(I,J,LR))
59823 UU(J)=A(1,J)+A(2,J)+A(3,J)+A(4,J)
59828 *CMZ :- -13/02/02 16.42.23 by Peter Richardson
59829 *-- Author : Bryan Webber
59830 C----------------------------------------------------------------------
59832 C----------------------------------------------------------------------
59833 C Prints contents of the GUPI (Generic User Process Interface)
59834 C common block HEPEUP
59835 C----------------------------------------------------------------------
59836 INCLUDE 'HERWIG65.INC'
59838 PARAMETER (MAXNUP=500)
59839 INTEGER NUP,IDPRUP,IDUP,ISTUP,MOTHUP,ICOLUP
59840 DOUBLE PRECISION XWGTUP,SCALUP,AQEDUP,AQCDUP,PUP,VTIMUP,SPINUP
59841 COMMON/HEPEUP/NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP,
59842 & IDUP(MAXNUP),ISTUP(MAXNUP),MOTHUP(2,MAXNUP),
59843 & ICOLUP(2,MAXNUP),PUP(5,MAXNUP),VTIMUP(MAXNUP),
59848 PRINT *, ' I ISTUP IDUP NAME MOTHUP ICOLUP PUP'
59850 CALL HWUIDT(1,IDUP(IUP),IWIG,NAME)
59851 PRINT 11,IUP,ISTUP(IUP),IDUP(IUP),NAME,MOTHUP(1,IUP),
59852 & MOTHUP(2,IUP),ICOLUP(1,IUP),ICOLUP(2,IUP),(PUP(I,IUP),I=1,5)
59854 11 Format(2I3,I4,2X,A8,2I3,2I4,5F8.1)
59857 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
59858 *-- Author : Ian Knowles & Bryan Webber
59859 C-----------------------------------------------------------------------
59861 C-----------------------------------------------------------------------
59862 C Using properties of particle I supplied in HWUDAT checks particles
59863 C and antiparticles have compatible properties and sets SWTEF(I) =
59864 C ( rep. enhancement factor)^2 - used in cluster decays
59865 C Finds iso-flavour hadrons and creates pointers for cluster decays.
59866 C Sets CLDKWT(K) =(2J+1) spin weight normalizing largest value to 1.
59867 C-----------------------------------------------------------------------
59868 INCLUDE 'HERWIG65.INC'
59870 PARAMETER (NMXTMP=20)
59871 DOUBLE PRECISION EPS,WTMX,REMMN,RWTMX,WTMP,RESTMP(91),WTMX2,
59872 & REMMN2,WT,CDWTMP(NMXTMP)
59873 INTEGER HWUANT,MAPF(89),MAPC(12,12),I,IANT,IABPDG,J,L,N,K,LTMP,
59874 & NCDKS,IMN,ITMP,LOCTMP(91),NTMP,NCDTMP(NMXTMP),IMN2
59876 PARAMETER (EPS=1.D-6)
59877 DATA MAPF/21,31,41,51,61,12,32,42,52,62,13,23,43,53,63,14,24,34,
59878 & 44,54,64,15,25,35,45,55,65,16,26,36,46,56,66,111,112,113,122,123,
59879 & 133,222,223,233,333,-111,-112,-113,-122,-123,-133,-222,-223,-233,
59880 & -333,114,124,134,224,234,334,-114,-124,-134,-224,-234,-334,115,
59881 & 125,135,225,235,335,-115,-125,-135,-225,-235,-335,116,126,136,
59882 & 226,236,336,-116,-126,-136,-226,-236,-336/
59883 DATA MAPC/90,1,2,47,45,44,48,46,49,3,4,5,6,90,7,50,47,45,51,48,52,
59884 & 8,9,10,11,12,91,51,48,46,52,49,53,13,14,15,37,40,41,6*0,57,69,81,
59885 & 35,37,38,6*0,55,67,79,34,35,36,6*0,54,66,78,38,41,42,6*0,58,70,
59886 & 82,36,38,39,6*0,56,68,80,39,42,43,6*0,59,71,83,16,17,18,63,61,60,
59887 & 64,62,65,19,20,21,22,23,24,75,73,72,76,74,77,25,26,27,28,29,30,
59888 & 87,85,84,88,86,89,31,32,33/
59889 C Check particle/anti-particle properties are compatible
59891 10 FORMAT(/10X,'Checking consistency of particle properties'/)
59893 IF (IDPDG(I).GT.0) THEN
59895 IF (IANT.EQ.20) GOTO 20
59896 IF (MOD(IDPDG(I)/1000,10).EQ.0.AND.
59897 & MOD(IDPDG(I)/100 ,10).NE.0) THEN
59898 IF (MOD(IFLAV(I)/10-IFLAV(IANT),10).NE.0.OR.
59899 & MOD(IFLAV(I)-IFLAV(IANT)/10,10).NE.0)
59900 & WRITE(6,30) RNAME(I),IFLAV(I),IFLAV(IANT)
59902 IF (IFLAV(I)+IFLAV(IANT).NE.0)
59903 & WRITE(6,30) RNAME(I),IFLAV(I),IFLAV(IANT)
59905 IF (ICHRG(I)+ICHRG(IANT).NE.0)
59906 & WRITE(6,40) RNAME(I),RNAME(IANT),ICHRG(I),ICHRG(IANT)
59907 IF (ABS(RMASS(I)-RMASS(IANT)).GT.EPS)
59908 & WRITE(6,50) RNAME(I),RMASS(I),RMASS(IANT)
59909 IF (ABS(RLTIM(I)-RLTIM(IANT)).GT.EPS)
59910 & WRITE(6,60) RNAME(I),RLTIM(I),RLTIM(IANT)
59911 IF (ABS(RSPIN(I)-RSPIN(IANT)).GT.EPS)
59912 & WRITE(6,70) RNAME(I),RSPIN(I),RSPIN(IANT)
59915 30 FORMAT(10X,A8,' flavour code=',I4,5X,' antiparticle=',I4)
59916 40 FORMAT(10X,2A8,' charge =',I2,7X,' antiparticle=',I2)
59917 50 FORMAT(10X,A8,' mass =',F7.3,2X,' antiparticle=',F7.3)
59918 60 FORMAT(10X,A8,' life time =',E9.3,' antiparticle=',E9.3)
59919 70 FORMAT(10X,A8,' spin =',F3.1,6X,' antiparticle=',F3.1)
59920 C Compute resonance properties
59922 C Compute representation weights for hadrons, used in cluster decays
59923 IABPDG=ABS(IDPDG(I))
59925 IF (J.EQ.2.AND.MOD(IABPDG/100,10).LT.MOD(IABPDG/10,10)) THEN
59926 C Singlet (Lambda-like) baryon
59928 ELSEIF (J.EQ.4) THEN
59931 ELSEIF(2*(J/2).NE.J) THEN
59932 C Mesons: identify by spin, angular momentum & radial excitation
59934 L= MOD(IABPDG/10000 ,10)
59935 N= MOD(IABPDG/100000,10)
59936 IF (L.EQ.0.AND.J.EQ.0.AND.N.EQ.0.OR.
59937 & L.GT.3.OR. J.GT.4.OR .N.GT.4) THEN
59940 SWTEF(I)=REPWT(L,J,N)**2
59947 C Prepare tables for cluster decays, except flavourless light mesons
59951 C Store particles, flavour MAPF(I), noting highest spin and lowest mass
59955 IF (VTOCDK(J).OR.IFLAV(J).NE.MAPF(I)) GOTO 90
59957 IF (NCDKS.GT.NMXCDK) CALL HWWARN('HWURES',101,*999)
59959 CLDKWT(NCDKS)=TWO*RSPIN(J)+ONE
59960 IF (CLDKWT(NCDKS).GT.WTMX) WTMX=CLDKWT(NCDKS)
59961 IF (RMASS(J).LT.REMMN) THEN
59966 IF (NCDKS+1-LTMP.EQ.0) THEN
59967 WRITE(6,100) MAPF(I)
59968 100 FORMAT(1X,'No particles exist for a cluster with flavour, ',I4,
59969 & ' to decay into')
59970 CALL HWWARN('HWURES',51,*120)
59972 C Set scaled spin weights
59974 DO 110 J=LTMP,NCDKS
59975 110 CLDKWT(J)=CLDKWT(J)*RWTMX
59976 C Swap order if lightest hadron of given flavour not first
59977 IF (IMN.NE.LTMP) THEN
59980 NCLDK(LTMP)=NCLDK(IMN)
59981 CLDKWT(LTMP)=CLDKWT(IMN)
59987 RESTMP(I)=FLOAT(NCDKS+1-LTMP)
59990 C Now do flavourless light mesons, allowing for mixing in weights
59997 IF (VTOCDK(J)) THEN
59999 C Calculate mixing weight for (|uubar>+|ddbar>)/sqrt(2) component
60000 ELSEIF (IFLAV(J).EQ.11) THEN
60002 ELSEIF (IFLAV(J).EQ.33) THEN
60005 WT=COS(ETAMIX*PIFAC/180.+ATAN(SQRT(TWO)))**2
60006 ELSEIF (J.EQ.25 ) THEN
60007 WT=SIN(ETAMIX*PIFAC/180.+ATAN(SQRT(TWO)))**2
60009 ELSEIF (J.EQ.56 ) THEN
60010 WT=COS(PHIMIX*PIFAC/180.+ATAN(SQRT(TWO)))**2
60011 ELSEIF (J.EQ.24 ) THEN
60012 WT=SIN(PHIMIX*PIFAC/180.+ATAN(SQRT(TWO)))**2
60014 ELSEIF (J.EQ.58 ) THEN
60015 WT=COS(F2MIX *PIFAC/180.+ATAN(SQRT(TWO)))**2
60016 ELSEIF (J.EQ.26 ) THEN
60017 WT=SIN(F2MIX *PIFAC/180.+ATAN(SQRT(TWO)))**2
60018 C f_1(1420) - f_1(1285)
60019 ELSEIF (J.EQ.57 ) THEN
60020 WT=COS(F1MIX *PIFAC/180.+ATAN(SQRT(TWO)))**2
60021 ELSEIF (J.EQ.28 ) THEN
60022 WT=SIN(F1MIX *PIFAC/180.+ATAN(SQRT(TWO)))**2
60023 C h_1(1380) - h_1(1170)
60024 ELSEIF (J.EQ.289) THEN
60025 WT=COS(H1MIX *PIFAC/180.+ATAN(SQRT(TWO)))**2
60026 ELSEIF (J.EQ.288) THEN
60027 WT=SIN(H1MIX *PIFAC/180.+ATAN(SQRT(TWO)))**2
60028 C MISSING - f_0(1370)
60029 ELSEIF (J.EQ.294) THEN
60030 WT=SIN(F0MIX *PIFAC/180.+ATAN(SQRT(TWO)))**2
60032 ELSEIF (J.EQ.396) THEN
60033 WT=COS(PH3MIX*PIFAC/180.+ATAN(SQRT(TWO)))**2
60034 ELSEIF (J.EQ.395) THEN
60035 WT=SIN(PH3MIX*PIFAC/180.+ATAN(SQRT(TWO)))**2
60036 C eta_2(1645) - eta_2(1870)
60037 ELSEIF (J.EQ.397) THEN
60038 WT=COS(ET2MIX*PIFAC/180.+ATAN(SQRT(TWO)))**2
60039 ELSEIF (J.EQ.398) THEN
60040 WT=SIN(ET2MIX*PIFAC/180.+ATAN(SQRT(TWO)))**2
60041 C MISSING - omega(1600)
60042 ELSEIF (J.EQ.399) THEN
60043 WT=SIN(OMHMIX*PIFAC/180.+ATAN(SQRT(TWO)))**2
60047 130 FORMAT(1X,'Isoscalar particle ',I3,' not recognised,',
60048 & ' no I=0 mixing assumed')
60053 IF (WT.GT.EPS) THEN
60055 IF (NCDKS.GT.NMXCDK) CALL HWWARN('HWURES',102,*999)
60057 CLDKWT(NCDKS)=WT*(TWO*RSPIN(J)+ONE)
60058 IF (CLDKWT(NCDKS).GT.WTMX) WTMX=CLDKWT(NCDKS)
60059 IF (RMASS(J).LT.REMMN) THEN
60064 IF (ONE-WT.GT.EPS) THEN
60066 IF (NTMP.GT.NMXTMP) CALL HWWARN('HWURES',103,*999)
60068 CDWTMP(NTMP)=(ONE-WT)*(TWO*RSPIN(J)+ONE)
60069 IF (CDWTMP(NTMP).GT.WTMX2) WTMX2=CDWTMP(NTMP)
60070 IF (RMASS(J).LT.REMMN2) THEN
60076 IF (NCDKS+1-LTMP.EQ.0) THEN
60078 CALL HWWARN('HWURES',52,*160)
60080 C Normalize scaled spin weights
60082 DO 150 I=LTMP,NCDKS
60083 150 CLDKWT(I)=CLDKWT(I)*RWTMX
60084 C Swap order if lightest hadron of flavour 11 not first
60085 IF (IMN.NE.LTMP) THEN
60088 NCLDK(LTMP)=NCLDK(IMN)
60089 CLDKWT(LTMP)=CLDKWT(IMN)
60093 160 IF (NTMP.EQ.0) THEN
60095 CALL HWWARN('HWURES',53,*180)
60097 IF (NCDKS+NTMP.GT.NMXCDK) CALL HWWARN('HWURES',104,*999)
60098 C Store hadrons for |ssbar> channel and normalize their weights
60103 170 CLDKWT(J)=CDWTMP(I)*RWTMX
60104 C Swap order if lightest hadron of flavour 33 not first
60105 IF (IMN2.NE.1) THEN
60106 ITMP=NCLDK(NCDKS+1)
60107 WTMP=CLDKWT(NCDKS+1)
60108 NCLDK(NCDKS+1)=NCLDK(NCDKS+IMN2)
60109 CLDKWT(NCDKS+1)=CLDKWT(NCDKS+IMN2)
60110 NCLDK(NCDKS+IMN2)=ITMP
60111 CLDKWT(NCDKS+IMN2)=WTMP
60114 180 LOCTMP(90)=LTMP
60115 RESTMP(90)=FLOAT(NCDKS+1-LTMP)
60117 RESTMP(91)=FLOAT(NTMP)
60118 C Set pointers to hadrons of given flavours for cluster decays
60125 RMIN(I,J)=MIN(RMASS(NCLDK(LOCN(I,1)))+RMASS(NCLDK(LOCN(1,J))),
60126 $ RMASS(NCLDK(LOCN(I,2)))+RMASS(NCLDK(LOCN(2,J))))+1.D-2
60128 LOCN(I,J)=LOCTMP(K)
60129 RESN(I,J)=RESTMP(K)
60130 RMIN(I,J)=RMASS(NCLDK(LOCN(I,J)))
60135 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
60136 *-- Author : Bryan Webber
60137 C-----------------------------------------------------------------------
60138 SUBROUTINE HWUROB(R,P,Q)
60139 C-----------------------------------------------------------------------
60140 C ROTATES VECTORS BY INVERSE OF ROTATION MATRIX R
60141 C-----------------------------------------------------------------------
60142 DOUBLE PRECISION S1,S2,S3,R(3,3),P(3),Q(3)
60143 S1=P(1)*R(1,1)+P(2)*R(2,1)+P(3)*R(3,1)
60144 S2=P(1)*R(1,2)+P(2)*R(2,2)+P(3)*R(3,2)
60145 S3=P(1)*R(1,3)+P(2)*R(2,3)+P(3)*R(3,3)
60151 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
60152 *-- Author : Bryan Webber
60153 C-----------------------------------------------------------------------
60154 SUBROUTINE HWUROF(R,P,Q)
60155 C-----------------------------------------------------------------------
60156 C ROTATES VECTORS BY ROTATION MATRIX R
60157 C-----------------------------------------------------------------------
60158 DOUBLE PRECISION S1,S2,S3,R(3,3),P(3),Q(3)
60159 S1=R(1,1)*P(1)+R(1,2)*P(2)+R(1,3)*P(3)
60160 S2=R(2,1)*P(1)+R(2,2)*P(2)+R(2,3)*P(3)
60161 S3=R(3,1)*P(1)+R(3,2)*P(2)+R(3,3)*P(3)
60167 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
60168 *-- Author : Bryan Webber
60169 C-----------------------------------------------------------------------
60170 SUBROUTINE HWUROT(P,CP,SP,R)
60171 C-----------------------------------------------------------------------
60172 C R IS ROTATION MATRIX TO GET FROM VECTOR P TO Z AXIS, FOLLOWED BY
60173 C A ROTATION BY PSI ABOUT Z AXIS, WHERE CP = COS-PSI, SP = SIN-PSI
60174 C-----------------------------------------------------------------------
60175 DOUBLE PRECISION WN,CP,SP,PTCUT,PP,PT,CT,ST,CF,SF,P(3),R(3,3)
60176 DATA WN,PTCUT/1.D0,1.D-20/
60179 IF (PT.LE.PP*PTCUT) THEN
60192 R(1,1)= CP*CF*CT+SP*SF
60193 R(1,2)= CP*SF*CT-SP*CF
60195 R(2,1)=-CP*SF+SP*CF*CT
60196 R(2,2)= CP*CF+SP*SF*CT
60203 *CMZ :- -17/07/03 11.11.56 by Bryan Webber
60204 *-- Author : Bryan Webber
60205 C----------------------------------------------------------------------
60206 SUBROUTINE HWURQM(SCALE,RQM)
60207 C-----------------------------------------------------------------------
60208 C RUNNING QUARK MASSES (MSBAR, 2-LOOP, 5 FLAVOUR, NO THRESHOLDS)
60209 C ASSUMING RMASS(IQ) IS POLE MASS
60210 C-----------------------------------------------------------------------
60211 INCLUDE 'HERWIG65.INC'
60212 DOUBLE PRECISION HWUALF,SCALE,ALFAS,P0,C1,CC,MHAT(6),RQM(6)
60215 SAVE P0,C1,MHAT,FIRST
60218 C---INITIALIZE CONSTANTS
60220 C1=3731./(3174.*PIFAC)
60221 CC=C1+4./(3.*PIFAC)
60223 ALFAS=HWUALF(1,RMASS(IQ))
60224 IF (ALFAS.GT.ZERO) THEN
60225 MHAT(IQ)=RMASS(IQ)/(1.+CC*ALFAS)/ALFAS**P0
60227 CALL HWWARN('HWURQM',IQ,*1)
60233 ALFAS=HWUALF(1,SCALE)
60234 CC=(1.+C1*ALFAS)*ALFAS**P0
60236 RQM(IQ)=MHAT(IQ)*CC
60240 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
60241 *-- Author : Adapted by Bryan Webber
60242 C-----------------------------------------------------------------------
60243 SUBROUTINE HWUSOR(A,N,K,IOPT)
60244 C-----------------------------------------------------------------------
60245 C Sort A(N) into ascending order
60246 C IOPT = 1 : return sorted A and index array K
60247 C IOPT = 2 : return index array K only
60248 C-----------------------------------------------------------------------
60249 DOUBLE PRECISION A(N),B(500)
60250 INTEGER N,I,J,IOPT,K(N),IL(500),IR(500)
60251 IF (N.GT.500) CALL HWWARN('HWUSOR',100,*999)
60258 2 IF(A(I).GT.A(J)) GOTO 5
60259 3 IF(IL(J).EQ.0) GOTO 4
60265 5 IF(IR(J).LE.0) GOTO 6
60275 8 IF(IL(J).GT.0) GOTO 20
60284 30 IF(IOPT.EQ.2) RETURN
60289 *CMZ :- -17/10/01 13:59:28 by Peter Richardson
60290 *-- Author : Peter Richardson
60291 C-----------------------------------------------------------------------
60293 C-----------------------------------------------------------------------
60294 C Subroutine to output the contents of the spin common block
60295 C-----------------------------------------------------------------------
60296 INCLUDE 'HERWIG65.INC'
60298 C--write out the header
60301 WRITE(6,1010) I,IDSPN(I),DECSPN(I),JMOSPN(I),JDASPN(1,I),
60304 1000 FORMAT(/1X,'ISPN',1X,'IDSPN',1X,'DECS',1X,'JMOSPN',1X,' JDASPN '/)
60305 1010 FORMAT( 1X, I4 ,1X, I5 ,1X, L4 ,1X, I6 ,1X, I3,2X,I3)
60308 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
60309 *-- Author : Bryan Webber
60310 C-----------------------------------------------------------------------
60312 C-----------------------------------------------------------------------
60313 C SQUARE ROOT WITH SIGN RETENTION
60314 C-----------------------------------------------------------------------
60315 DOUBLE PRECISION HWUSQR,X
60316 HWUSQR=SIGN(SQRT(ABS(X)),X)
60319 *CMZ :- -26/04/91 10.18.58 by Bryan Webber
60320 *-- Author : Bryan Webber
60321 C-----------------------------------------------------------------------
60322 SUBROUTINE HWUSTA(NAME)
60323 C-----------------------------------------------------------------------
60324 C MAKES PARTICLE TYPE 'NAME' STABLE
60325 C-----------------------------------------------------------------------
60326 INCLUDE 'HERWIG65.INC'
60329 CALL HWUIDT(3,IPDG,IWIG,NAME)
60330 IF (IWIG.EQ.20) CALL HWWARN('HWUSTA',500,*999)
60332 WRITE (6,10) IWIG,NAME
60333 10 FORMAT(/10X,'PARTICLE TYPE',I4,'=',A8,' SET STABLE')
60336 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
60337 *-- Author : Adapted by Bryan Webber
60338 C-----------------------------------------------------------------------
60339 FUNCTION HWUTAB(F,A,NN,X,MM)
60340 C-----------------------------------------------------------------------
60341 C MODIFIED CERN INTERPOLATION ROUTINE DIVDIF
60342 C-----------------------------------------------------------------------
60344 INTEGER NN,MM,MMAX,N,M,MPLUS,IX,IY,MID,NPTS,IP,I,J,L,ISUB
60345 DOUBLE PRECISION HWUTAB,SUM,X,F(NN),A(NN),T(20),D(20)
60353 IF (A(1).GT.A(N)) GOTO 4
60355 IF (X.GE.A(MID)) GOTO 2
60359 3 IF (IY-IX.GT.1) GOTO 1
60362 IF (X.LE.A(MID)) GOTO 5
60366 6 IF (IY-IX.GT.1) GOTO 4
60367 7 NPTS=M+2-MOD(M,2)
60374 IF ((1.LE.ISUB).AND.(ISUB.LE.N)) GOTO 10
60380 11 IF (IP.LT.NPTS) GOTO 8
60381 EXTRA=NPTS.NE.MPLUS
60383 IF (.NOT.EXTRA) GOTO 12
60385 D(M+2)=(D(M+2)-D(M))/(T(M+2)-T(ISUB))
60389 D(I)=(D(I)-D(I-1))/(T(I)-T(ISUB))
60394 IF (EXTRA) SUM=0.5*(SUM+D(M+2))
60397 SUM=D(J)+(X-T(J))*SUM
60403 *CMZ :- -26/04/91 11.38.43 by Federico Carminati
60404 *-- Author : Federico Carminati
60405 C-----------------------------------------------------------------------
60406 SUBROUTINE HWUTIM(TRES)
60407 C-----------------------------------------------------------------------
60411 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
60412 *-- Author : Bryan Webber
60413 C-----------------------------------------------------------------------
60414 SUBROUTINE HWVDIF(N,P,Q,R)
60415 C-----------------------------------------------------------------------
60416 C VECTOR DIFFERENCE
60417 C-----------------------------------------------------------------------
60418 DOUBLE PRECISION P(N),Q(N),R(N)
60424 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
60425 *-- Author : Bryan Webber
60426 C-----------------------------------------------------------------------
60427 FUNCTION HWVDOT(N,P,Q)
60428 C-----------------------------------------------------------------------
60429 C VECTOR DOT PRODUCT
60430 C-----------------------------------------------------------------------
60431 DOUBLE PRECISION HWVDOT,PQ,P(N),Q(N)
60439 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
60440 *-- Author : Bryan Webber
60441 C-----------------------------------------------------------------------
60442 SUBROUTINE HWVEQU(N,P,Q)
60443 C-----------------------------------------------------------------------
60445 C-----------------------------------------------------------------------
60446 DOUBLE PRECISION P(N),Q(N)
60452 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
60453 *-- Author : Bryan Webber
60454 C-----------------------------------------------------------------------
60455 SUBROUTINE HWVSCA(N,C,P,Q)
60456 C-----------------------------------------------------------------------
60457 C VECTOR TIMES SCALAR
60458 C-----------------------------------------------------------------------
60459 DOUBLE PRECISION C,P(N),Q(N)
60465 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
60466 *-- Author : Bryan Webber
60467 C-----------------------------------------------------------------------
60468 SUBROUTINE HWVSUM(N,P,Q,R)
60469 C-----------------------------------------------------------------------
60471 C-----------------------------------------------------------------------
60472 DOUBLE PRECISION P(N),Q(N),R(N)
60478 *CMZ :- -05/02/98 11.11.56 by Bryan Webber
60479 *-- Author : Bryan Webber
60480 C-----------------------------------------------------------------------
60481 SUBROUTINE HWVZRI(N,IP)
60482 C-----------------------------------------------------------------------
60483 C ZERO INTEGER VECTOR
60484 C-----------------------------------------------------------------------
60490 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
60491 *-- Author : Bryan Webber
60492 C-----------------------------------------------------------------------
60493 SUBROUTINE HWVZRO(N,P)
60494 C-----------------------------------------------------------------------
60496 C-----------------------------------------------------------------------
60497 DOUBLE PRECISION P(N)
60503 *CMZ :- -26/04/91 10.18.58 by Bryan Webber
60504 *-- Author : Bryan Webber
60505 C-----------------------------------------------------------------------
60506 SUBROUTINE HWWARN(SUBRTN,ICODE,*)
60507 C-----------------------------------------------------------------------
60508 C DEALS WITH ERRORS DURING EXECUTION
60509 C SUBRTN = NAME OF CALLING SUBROUTINE
60510 C ICODE = ERROR CODE: - -1 NONFATAL, KILL EVENT & PRINT NOTHING
60511 C 0- 49 NONFATAL, PRINT WARNING & CONTINUE
60512 C 50- 99 NONFATAL, PRINT WARNING & JUMP
60513 C 100-199 NONFATAL, DUMP & KILL EVENT
60514 C 200-299 FATAL, TERMINATE RUN
60515 C 300-399 FATAL, DUMP EVENT & TERMINATE RUN
60516 C 400-499 FATAL, DUMP EVENT & STOP DEAD
60517 C 500- FATAL, STOP DEAD WITH NO DUMP
60518 C-----------------------------------------------------------------------
60519 INCLUDE 'HERWIG65.INC'
60522 IF (ICODE.GE.0) WRITE (6,10) SUBRTN,ICODE
60523 10 FORMAT(/' HWWARN CALLED FROM SUBPROGRAM ',A6,': CODE =',I4)
60524 IF (ICODE.LT.0) THEN
60527 ELSEIF (ICODE.LT.100) THEN
60528 WRITE (6,20) NEVHEP,NRN,EVWGT
60529 20 FORMAT(' EVENT',I8,': SEEDS =',I11,' &',I11,
60530 &' WEIGHT =',E11.4/' EVENT SURVIVES. EXECUTION CONTINUES')
60531 IF (ICODE.GT.49) RETURN 1
60532 ELSEIF (ICODE.LT.200) THEN
60533 WRITE (6,30) NEVHEP,NRN,EVWGT
60534 30 FORMAT(' EVENT',I8,': SEEDS =',I11,' &',I11,
60535 &' WEIGHT =',E11.4/' EVENT KILLED. EXECUTION CONTINUES')
60538 ELSEIF (ICODE.LT.300) THEN
60540 40 FORMAT(' EVENT SURVIVES. RUN ENDS GRACEFULLY')
60544 ELSEIF (ICODE.LT.400) THEN
60546 50 FORMAT(' EVENT KILLED: DUMP FOLLOWS. RUN ENDS GRACEFULLY')
60553 ELSEIF (ICODE.LT.500) THEN
60555 60 FORMAT(' EVENT KILLED: DUMP FOLLOWS. RUN STOPS DEAD')
60562 70 FORMAT(' RUN CANNOT CONTINUE')
60567 *CMZ :- -28/01/92 12.34.44 by Mike Seymour
60568 *-- Author : Luca Stanco
60569 C-----------------------------------------------------------------------
60571 C-----------------------------------------------------------------------
60572 C DUMMY SUBROUTINE: DELETE AND SET BDECAY='EURO'
60573 C IN MAIN PROGRAM IF YOU USE EURODEC DECAY PACKAGE
60574 C-----------------------------------------------------------------------
60577 10 FORMAT(/10X,'IEUPDG CALLED BUT NOT LINKED')
60582 *CMZ :- -28/01/92 12.34.44 by Mike Seymour
60583 *-- Author : Luca Stanco
60584 C-----------------------------------------------------------------------
60586 C-----------------------------------------------------------------------
60587 C DUMMY SUBROUTINE: DELETE AND SET BDECAY='EURO'
60588 C IN MAIN PROGRAM IF YOU USE EURODEC DECAY PACKAGE
60589 C-----------------------------------------------------------------------
60592 10 FORMAT(/10X,'IPDGEU CALLED BUT NOT LINKED')
60597 *CMZ :- -17/10/01 10.03.37 by Peter Richardson
60598 *-- Author : Peter Richardson
60599 C-----------------------------------------------------------------------
60600 SUBROUTINE INIETC(JAK1,JAK2,ITDKRC,IFPHOT)
60601 C-----------------------------------------------------------------------
60602 C DUMMY SUBROUTINE: DELETE AND SET TAUDEC='TAUOLA'
60603 C IN MAIN PROGRAM IF YOU USE TAUOLA DECAY PACKAGE
60604 C-----------------------------------------------------------------------
60606 INTEGER JAK1,JAK2,ITDKRC,IFPHOT
60608 10 FORMAT(/10X,'INIETC CALLED BUT NOT LINKED')
60612 *CMZ :- -17/10/01 10.03.37 by Peter Richardson
60613 *-- Author : Peter Richardson
60614 C-----------------------------------------------------------------------
60616 C-----------------------------------------------------------------------
60617 C DUMMY SUBROUTINE: DELETE AND SET TAUDEC='TAUOLA'
60618 C IN MAIN PROGRAM IF YOU USE TAUOLA DECAY PACKAGE
60619 C-----------------------------------------------------------------------
60622 10 FORMAT(/10X,'INIMAS CALLED BUT NOT LINKED')
60626 *CMZ :- -17/10/01 10.03.37 by Peter Richardson
60627 *-- Author : Peter Richardson
60628 C-----------------------------------------------------------------------
60629 SUBROUTINE INIPHX(CUT)
60630 C-----------------------------------------------------------------------
60631 C DUMMY SUBROUTINE: DELETE AND SET TAUDEC='TAUOLA'
60632 C IN MAIN PROGRAM IF YOU USE TAUOLA DECAY PACKAGE
60633 C-----------------------------------------------------------------------
60635 DOUBLE PRECISION CUT
60637 10 FORMAT(/10X,'INIPHX CALLED BUT NOT LINKED')
60641 *CMZ :- -17/10/01 10.03.37 by Peter Richardson
60642 *-- Author : Peter Richardson
60643 C-----------------------------------------------------------------------
60645 C-----------------------------------------------------------------------
60646 C DUMMY SUBROUTINE: DELETE AND SET TAUDEC='TAUOLA'
60647 C IN MAIN PROGRAM IF YOU USE TAUOLA DECAY PACKAGE
60648 C-----------------------------------------------------------------------
60651 10 FORMAT(/10X,'INITDK CALLED BUT NOT LINKED')
60655 *CMZ :- -17/10/01 10.03.37 by Peter Richardson
60656 *-- Author : Peter Richardson
60657 C-----------------------------------------------------------------------
60659 C-----------------------------------------------------------------------
60660 C DUMMY SUBROUTINE: DELETE AND SET TAUDEC='TAUOLA'
60661 C IN MAIN PROGRAM IF YOU USE TAUOLA DECAY PACKAGE
60662 C-----------------------------------------------------------------------
60665 10 FORMAT(/10X,'PHOINI CALLED BUT NOT LINKED')
60669 *CMZ :- -17/10/01 10.03.37 by Peter Richardson
60670 *-- Author : Peter Richardson
60671 C-----------------------------------------------------------------------
60672 SUBROUTINE PHOTOS(IHEP)
60673 C-----------------------------------------------------------------------
60674 C DUMMY SUBROUTINE: DELETE AND SET TAUDEC='TAUOLA'
60675 C IN MAIN PROGRAM IF YOU USE TAUOLA DECAY PACKAGE
60676 C-----------------------------------------------------------------------
60680 10 FORMAT(/10X,'PHOTOS CALLED BUT NOT LINKED')
60684 *CMZ :- -28/01/92 12.34.44 by Mike Seymour
60685 *-- Author : Luca Stanco
60686 C-----------------------------------------------------------------------
60687 SUBROUTINE QQINIT(QQLERR)
60688 C-----------------------------------------------------------------------
60689 C DUMMY SUBROUTINE: DELETE AND SET BDECAY='CLEO'
60690 C IN MAIN PROGRAM IF YOU USE CLEO DECAY PACKAGE
60691 C-----------------------------------------------------------------------
60694 10 FORMAT(/10X,'QQINIT CALLED BUT NOT LINKED')
60698 *CMZ :- -28/01/92 12.34.44 by Mike Seymour
60699 *-- Author : Luca Stanco
60700 C-----------------------------------------------------------------------
60701 INTEGER FUNCTION QQLMAT(IDL,NDIR)
60702 C-----------------------------------------------------------------------
60703 C. QQLMAT - Given a particle flavor (KF), converts it to QQ particle number
60704 C. (KF = IDPDG code)
60706 C. Inputs : IDL (input particle code)
60707 C NDIR = 1 LUND --> QQ
60708 C NDIR = 2 QQ --> LUND
60710 C. Outputs : QQLMAT (output particle code)
60712 C-----------------------------------------------------------------------
60714 C-- Calling variable
60716 C-- External declaration
60717 C-- Local variables
60719 DATA (AKF(I), I=1,151) /
60720 + 0, 0, 0, 0, 0, 0, 0, 21, -6, -5,
60721 + -4, -3, -1, -2, 6, 5, 4, 3, 1, 2,
60723 + 22, 23, 24, -24, 90, 0, 11, -11, 12, -12,
60724 + 13, -13, 14, -14, 15, -15, 16, -16,20313,-20313,
60725 + 211, -211, 321, -321, 311, -311, 421, -421, 411, -411,
60726 + 431, -431, -521, 521, -511, 511, -531, 531, -541, 541,
60727 + 621, -621, 611, -611, 631, -631, 641, -641, 651, -651,
60728 + 111, 221, 331, 441,20551, 661, 310, 130,10313,-10313,
60729 + 213, -213, 323, -323, 313, -313, 423, -423, 413, -413,
60730 + 433, -433, -523, 523, -513, 513, -533, 533, -543, 543,
60731 + 623, -623, 613, -613, 633, -633, 643, -643, 653, -653,
60732 + 113, 223, 333, 443, 553, 136, 20553, 30553, 40553, 551,
60733 + 10553, 555, 10551,70553,10555, 0, 20213, 20113, -20213, 10441,
60735 + 3122, -3122, 4122, -4122, 4232, -4232, 4132, -4132, 3212, -3212/
60736 DATA (AKF(I), I=152,321) /
60737 + 4212, -4212, 4322, -4322, 4312, -4312, 2212, -2212, 3222, -3222,
60738 + 4222, -4222, 2112, -2112, 3112, -3112, 4112, -4112, 3322, -3322,
60739 + 3312, -3312, 4332, -4332, 6*0,
60740 + 3214, -3214, 4214, -4214, 4324, -4324, 4314, -4314, 2214, -2214,
60741 + 3224, -3224, 4224, -4224, 2114, -2114, 3114, -3114, 4114, -4114,
60742 + 3324, -3324, 3314, -3314, 4334, -4334, 4*0,
60743 + 0, 0, 2224, -2224, 1114, -1114, 3334, -3334, 0, 0,
60744 + 10323, -10323, 20323, -20323, 6*0,
60745 + 30443, 0, 0, 0, 70443, 50553, 60553, 80553, 20443, 0,
60746 + 10411, 20413, 10413, 415,
60747 + -10411,-20413,-10413,-415,
60748 + 10421, 20423, 10423, 425,
60749 + -10421,-20423,-10423,-425,
60750 + 10431, 20433, 10433, 435,
60751 + -10431,-20433,-10433,-435, 0,0,0,0,0,0,
60752 + 10111, 10211,-10211, 115, 215, -215,10221,10331,20223,20333,
60753 + 225, 335, 10223, 10333, 10113, 10213,-10213, 33*0 /
60756 IF (IDL.EQ.AKF(I)) THEN
60763 20 FORMAT(1X,'Lund code particle ',I6,' not recognized')
60764 ELSEIF(NDIR.EQ.2) THEN
60765 QQLMAT = AKF(IDL+21)
60769 30 FORMAT(1X,'Unrecognized option in QQLMAT')
60773 C-----------------------------------------------------------------------
60774 C...SaSgam version 2 - parton distributions of the photon
60775 C...by Gerhard A. Schuler and Torbjorn Sjostrand
60776 C...For further information see Z. Phys. C68 (1995) 607
60777 C...and CERN-TH/96-04 and LU TP 96-2.
60778 C...Program last changed on 18 January 1996.
60780 C!!!Note that one further call parameter - IP2 - has been added
60781 C!!!to the SASGAM argument list compared with version 1.
60783 C...The user should only need to call the SASGAM routine,
60784 C...which in turn calls the auxiliary routines SASVMD, SASANO,
60785 C...SASBEH and SASDIR. The package is self-contained.
60787 C...One particular aspect of these parametrizations is that F2 for
60788 C...the photon is not obtained just as the charge-squared-weighted
60789 C...sum of quark distributions, but differ in the treatment of
60790 C...heavy flavours (in F2 the DIS relation W2 = Q2*(1-x)/x restricts
60791 C...the kinematics range of heavy-flavour production, but the same
60792 C...kinematics is not relevant e.g. for jet production) and, for the
60793 C...'MSbar' fits, in the addition of a Cgamma term related to the
60794 C...separation of direct processes. Schematically:
60795 C...PDF = VMD (rho, omega, phi) + anomalous (d, u, s, c, b).
60796 C...F2 = VMD (rho, omega, phi) + anomalous (d, u, s) +
60797 C... Bethe-Heitler (c, b) (+ Cgamma (d, u, s)).
60798 C...The J/psi and Upsilon states have not been included in the VMD sum,
60799 C...but low c and b masses in the other components should compensate
60800 C...for this in a duality sense.
60802 C...The calling sequence is the following:
60803 C CALL SASGAM(ISET,X,Q2,P2,IP2,F2GM,XPDFGM)
60804 C...with the following declaration statement:
60805 C DIMENSION XPDFGM(-6:6)
60806 C...and, optionally, further information in:
60807 C COMMON/SASCOM/XPVMD(-6:6),XPANL(-6:6),XPANH(-6:6),XPBEH(-6:6),
60809 C COMMON/SASVAL/VXPVMD(-6:6),VXPANL(-6:6),VXPANH(-6:6),VXPDGM(-6:6)
60810 C...Input: ISET = 1 : SaS set 1D ('DIS', Q0 = 0.6 GeV)
60811 C = 2 : SaS set 1M ('MSbar', Q0 = 0.6 GeV)
60812 C = 3 : SaS set 2D ('DIS', Q0 = 2 GeV)
60813 C = 4 : SaS set 2M ('MSbar', Q0 = 2 GeV)
60816 C P2 : P2 value; should be = 0. for an on-shell photon.
60817 C IP2 : scheme used to evaluate off-shell anomalous component.
60818 C = 0 : recommended default, see = 7.
60819 C = 1 : dipole dampening by integration; very time-consuming.
60820 C = 2 : P_0^2 = max( Q_0^2, P^2 )
60821 C = 3 : P'_0^2 = Q_0^2 + P^2.
60822 C = 4 : P_{eff} that preserves momentum sum.
60823 C = 5 : P_{int} that preserves momentum and average
60825 C = 6 : P_{eff}, matched to P_0 in P2 -> Q2 limit.
60826 C = 7 : P_{eff}, matched to P_0 in P2 -> Q2 limit.
60827 C...Output: F2GM : F2 value of the photon (including factors of alpha_em).
60828 C XPFDGM : x times parton distribution functions of the photon,
60829 C with elements 0 = g, 1 = d, 2 = u, 3 = s, 4 = c, 5 = b,
60830 C 6 = t (always empty!), - for antiquarks (result is same).
60831 C...The breakdown by component is stored in the commonblock SASCOM,
60832 C with elements as above.
60833 C XPVMD : rho, omega, phi VMD part only of output.
60834 C XPANL : d, u, s anomalous part only of output.
60835 C XPANH : c, b anomalous part only of output.
60836 C XPBEH : c, b Bethe-Heitler part only of output.
60837 C XPDIR : Cgamma (direct contribution) part only of output.
60838 C...The above arrays do not distinguish valence and sea contributions,
60839 C...although this information is available internally. The additional
60840 C...commonblock SASVAL provides the valence part only of the above
60841 C...distributions. Array names VXPVMD, VXPANL and VXPANH correspond
60842 C...to XPVMD, XPANL and XPANH, while XPBEH and XPDIR are valence only
60843 C...and therefore not given doubly. VXPDGM gives the sum of valence
60844 C...parts, and so matches XPDFGM. The difference, i.e. XPVMD-VXPVMD
60845 C...and so on, gives the sea part only.
60847 SUBROUTINE SASGAM(ISET,X,Q2,P2,IP2,F2GM,XPDFGM)
60848 C...Purpose: to construct the F2 and parton distributions of the photon
60849 C...by summing homogeneous (VMD) and inhomogeneous (anomalous) terms.
60850 C...For F2, c and b are included by the Bethe-Heitler formula;
60851 C...in the 'MSbar' scheme additionally a Cgamma term is added.
60852 DIMENSION XPDFGM(-6:6)
60853 COMMON/SASCOM/XPVMD(-6:6),XPANL(-6:6),XPANH(-6:6),XPBEH(-6:6),
60855 COMMON/SASVAL/VXPVMD(-6:6),VXPANL(-6:6),VXPANH(-6:6),VXPDGM(-6:6)
60856 SAVE /SASCOM/,/SASVAL/
60858 C...Temporary array.
60859 DIMENSION XPGA(-6:6), VXPGA(-6:6)
60860 C...Charm and bottom masses (low to compensate for J/psi etc.).
60861 DATA PMC/1.3/, PMB/4.6/
60862 C...alpha_em and alpha_em/(2*pi).
60863 DATA AEM/0.007297/, AEM2PI/0.0011614/
60864 C...Lambda value for 4 flavours.
60866 C...Mixture u/(u+d), = 0.5 for incoherent and = 0.8 for coherent sum.
60868 C...VMD couplings f_V**2/(4*pi).
60869 DATA FRHO/2.20/, FOMEGA/23.6/, FPHI/18.4/
60870 C...Masses for rho (=omega) and phi.
60871 DATA PMRHO/0.770/, PMPHI/1.020/
60872 C...Number of points in integration for IP2=1.
60890 C...Check that input sensible.
60891 IF(ISET.LE.0.OR.ISET.GE.5) THEN
60892 WRITE(*,*) ' FATAL ERROR: SaSgam called for unknown set'
60893 WRITE(*,*) ' ISET = ',ISET
60896 IF(X.LE.0..OR.X.GT.1.) THEN
60897 WRITE(*,*) ' FATAL ERROR: SaSgam called for unphysical x'
60898 WRITE(*,*) ' X = ',X
60902 C...Set Q0 cut-off parameter as function of set used.
60910 C...Scale choice for off-shell photon; common factors.
60915 Q2A=Q2+P2*Q02/MAX(Q02,Q2)
60916 FACNOR=LOG(Q2/Q02)/NSTEP
60917 ELSEIF(IP2.EQ.2) THEN
60919 ELSEIF(IP2.EQ.3) THEN
60921 Q2A=Q2+P2*Q02/MAX(Q02,Q2)
60922 ELSEIF(IP2.EQ.4) THEN
60923 P2MX=Q2*(Q02+P2)/(Q2+P2)*EXP(P2*(Q2-Q02)/
60924 & ((Q2+P2)*(Q02+P2)))
60925 ELSEIF(IP2.EQ.5) THEN
60926 P2MXA=Q2*(Q02+P2)/(Q2+P2)*EXP(P2*(Q2-Q02)/
60927 & ((Q2+P2)*(Q02+P2)))
60928 P2MX=Q0*SQRT(P2MXA)
60929 FACNOR=LOG(Q2/P2MXA)/LOG(Q2/P2MX)
60930 ELSEIF(IP2.EQ.6) THEN
60931 P2MX=Q2*(Q02+P2)/(Q2+P2)*EXP(P2*(Q2-Q02)/
60932 & ((Q2+P2)*(Q02+P2)))
60933 P2MX=MAX(0.,1.-P2/Q2)*P2MX+MIN(1.,P2/Q2)*MAX(P2,Q02)
60935 P2MXA=Q2*(Q02+P2)/(Q2+P2)*EXP(P2*(Q2-Q02)/
60936 & ((Q2+P2)*(Q02+P2)))
60937 P2MX=Q0*SQRT(P2MXA)
60939 P2MX=MAX(0.,1.-P2/Q2)*P2MX+MIN(1.,P2/Q2)*MAX(P2,Q02)
60940 P2MXB=MAX(0.,1.-P2/Q2)*P2MXB+MIN(1.,P2/Q2)*P2MXA
60941 FACNOR=LOG(Q2/P2MXA)/LOG(Q2/P2MXB)
60944 C...Call VMD parametrization for d quark and use to give rho, omega,
60945 C...phi. Note dipole dampening for off-shell photon.
60946 CALL SASVMD(ISET,1,X,Q2A,P2MX,ALAM,XPGA,VXPGA)
60950 FACUD=AEM*(1./FRHO+1./FOMEGA)*(PMRHO**2/(PMRHO**2+P2))**2
60951 FACS=AEM*(1./FPHI)*(PMPHI**2/(PMPHI**2+P2))**2
60953 XPVMD(KFL)=(FACUD+FACS)*XPGA(KFL)
60955 XPVMD(1)=XPVMD(1)+(1.-FRACU)*FACUD*XFVAL
60956 XPVMD(2)=XPVMD(2)+FRACU*FACUD*XFVAL
60957 XPVMD(3)=XPVMD(3)+FACS*XFVAL
60958 XPVMD(-1)=XPVMD(-1)+(1.-FRACU)*FACUD*XFVAL
60959 XPVMD(-2)=XPVMD(-2)+FRACU*FACUD*XFVAL
60960 XPVMD(-3)=XPVMD(-3)+FACS*XFVAL
60961 VXPVMD(1)=(1.-FRACU)*FACUD*XFVAL
60962 VXPVMD(2)=FRACU*FACUD*XFVAL
60963 VXPVMD(3)=FACS*XFVAL
60964 VXPVMD(-1)=(1.-FRACU)*FACUD*XFVAL
60965 VXPVMD(-2)=FRACU*FACUD*XFVAL
60966 VXPVMD(-3)=FACS*XFVAL
60969 C...Anomalous parametrizations for different strategies
60970 C...for off-shell photons; except full integration.
60972 C...Call anomalous parametrization for d + u + s.
60973 CALL SASANO(-3,X,Q2A,P2MX,ALAM,XPGA,VXPGA)
60975 XPANL(KFL)=FACNOR*XPGA(KFL)
60976 VXPANL(KFL)=FACNOR*VXPGA(KFL)
60979 C...Call anomalous parametrization for c and b.
60980 CALL SASANO(4,X,Q2A,P2MX,ALAM,XPGA,VXPGA)
60982 XPANH(KFL)=FACNOR*XPGA(KFL)
60983 VXPANH(KFL)=FACNOR*VXPGA(KFL)
60985 CALL SASANO(5,X,Q2A,P2MX,ALAM,XPGA,VXPGA)
60987 XPANH(KFL)=XPANH(KFL)+FACNOR*XPGA(KFL)
60988 VXPANH(KFL)=VXPANH(KFL)+FACNOR*VXPGA(KFL)
60992 C...Special option: loop over flavours and integrate over k2.
60994 DO 160 ISTEP=1,NSTEP
60995 Q2STEP=Q02*(Q2/Q02)**((ISTEP-0.5)/NSTEP)
60996 IF((KF.EQ.4.AND.Q2STEP.LT.PMC**2).OR.
60997 & (KF.EQ.5.AND.Q2STEP.LT.PMB**2)) GOTO 160
60998 CALL SASVMD(0,KF,X,Q2,Q2STEP,ALAM,XPGA,VXPGA)
60999 FACQ=AEM2PI*(Q2STEP/(Q2STEP+P2))**2*FACNOR
61000 IF(MOD(KF,2).EQ.0) FACQ=FACQ*(8./9.)
61001 IF(MOD(KF,2).EQ.1) FACQ=FACQ*(2./9.)
61003 IF(KF.LE.3) XPANL(KFL)=XPANL(KFL)+FACQ*XPGA(KFL)
61004 IF(KF.GE.4) XPANH(KFL)=XPANH(KFL)+FACQ*XPGA(KFL)
61005 IF(KF.LE.3) VXPANL(KFL)=VXPANL(KFL)+FACQ*VXPGA(KFL)
61006 IF(KF.GE.4) VXPANH(KFL)=VXPANH(KFL)+FACQ*VXPGA(KFL)
61012 C...Call Bethe-Heitler term expression for charm and bottom.
61013 CALL SASBEH(4,X,Q2,P2,PMC**2,XPBH)
61016 CALL SASBEH(5,X,Q2,P2,PMB**2,XPBH)
61020 C...For MSbar subtraction call C^gamma term expression for d, u, s.
61021 IF(ISET.EQ.2.OR.ISET.EQ.4) THEN
61022 CALL SASDIR(X,Q2,P2,Q02,XPGA)
61024 XPDIR(KFL)=XPGA(KFL)
61028 C...Store result in output array.
61031 IF(IABS(KFL).EQ.2.OR.IABS(KFL).EQ.4) CHSQ=4./9.
61032 XPF2=XPVMD(KFL)+XPANL(KFL)+XPBEH(KFL)+XPDIR(KFL)
61033 IF(KFL.NE.0) F2GM=F2GM+CHSQ*XPF2
61034 XPDFGM(KFL)=XPVMD(KFL)+XPANL(KFL)+XPANH(KFL)
61035 VXPDGM(KFL)=VXPVMD(KFL)+VXPANL(KFL)+VXPANH(KFL)
61041 C*********************************************************************
61043 SUBROUTINE SASVMD(ISET,KF,X,Q2,P2,ALAM,XPGA,VXPGA)
61044 C...Purpose: to evaluate the VMD parton distributions of a photon,
61045 C...evolved homogeneously from an initial scale P2 to Q2.
61046 C...Does not include dipole suppression factor.
61047 C...ISET is parton distribution set, see above;
61048 C...additionally ISET=0 is used for the evolution of an anomalous photon
61049 C...which branched at a scale P2 and then evolved homogeneously to Q2.
61050 C...ALAM is the 4-flavour Lambda, which is automatically converted
61051 C...to 3- and 5-flavour equivalents as needed.
61052 DIMENSION XPGA(-6:6), VXPGA(-6:6)
61053 DATA PMC/1.3/, PMB/4.6/
61062 C...Calculate Lambda; protect against unphysical Q2 and P2 input.
61063 ALAM3=ALAM*(PMC/ALAM)**(2./27.)
61064 ALAM5=ALAM*(ALAM/PMB)**(2./23.)
61065 P2EFF=MAX(P2,1.2*ALAM3**2)
61066 IF(KFA.EQ.4) P2EFF=MAX(P2EFF,PMC**2)
61067 IF(KFA.EQ.5) P2EFF=MAX(P2EFF,PMB**2)
61068 Q2EFF=MAX(Q2,P2EFF)
61070 C...Find number of flavours at lower and upper scale.
61072 IF(P2EFF.LT.PMC**2) NFP=3
61073 IF(P2EFF.GT.PMB**2) NFP=5
61075 IF(Q2EFF.LT.PMC**2) NFQ=3
61076 IF(Q2EFF.GT.PMB**2) NFQ=5
61078 C...Find s as sum of 3-, 4- and 5-flavour parts.
61082 IF(NFQ.EQ.3) Q2DIV=Q2EFF
61083 S=S+(6./27.)*LOG(LOG(Q2DIV/ALAM3**2)/LOG(P2EFF/ALAM3**2))
61085 IF(NFP.LE.4.AND.NFQ.GE.4) THEN
61087 IF(NFP.EQ.3) P2DIV=PMC**2
61089 IF(NFQ.EQ.5) Q2DIV=PMB**2
61090 S=S+(6./25.)*LOG(LOG(Q2DIV/ALAM**2)/LOG(P2DIV/ALAM**2))
61094 IF(NFP.EQ.5) P2DIV=P2EFF
61095 S=S+(6./23.)*LOG(LOG(Q2EFF/ALAM5**2)/LOG(P2DIV/ALAM5**2))
61098 C...Calculate frequent combinations of x and s.
61105 C...Evaluate homogeneous anomalous parton distributions below or
61106 C...above threshold.
61108 IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR.
61109 &(KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN
61110 XVAL = X * 1.5 * (X**2+X1**2)
61114 XVAL = (1.5/(1.-0.197*S+4.33*S2)*X**2 + (1.5+2.10*S)/
61115 & (1.+3.29*S)*X1**2 + 5.23*S/(1.+1.17*S+19.9*S3)*X*X1) *
61116 & X**(1./(1.+1.5*S)) * (1.-X**2)**(2.667*S)
61117 XGLU = 4.*S/(1.+4.76*S+15.2*S2+29.3*S4) *
61118 & X**(-2.03*S/(1.+2.44*S)) * (X1*XL)**(1.333*S) *
61119 & ((4.*X**2+7.*X+4.)*X1/3. - 2.*X*(1.+X)*XL)
61120 XSEA = S2/(1.+4.54*S+8.19*S2+8.05*S3) *
61121 & X**(-1.54*S/(1.+1.29*S)) * X1**(2.667*S) *
61122 & ((8.-73.*X+62.*X**2)*X1/9. + (3.-8.*X**2/3.)*X*XL +
61123 & (2.*X-1.)*X*XL**2)
61126 C...Evaluate set 1D parton distributions below or above threshold.
61127 ELSEIF(ISET.EQ.1) THEN
61128 IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR.
61129 &(KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN
61130 XVAL = 1.294 * X**0.80 * X1**0.76
61131 XGLU = 1.273 * X**0.40 * X1**1.76
61132 XSEA = 0.100 * X1**3.76
61134 XVAL = 1.294/(1.+0.252*S+3.079*S2) * X**(0.80-0.13*S) *
61135 & X1**(0.76+0.667*S) * XL**(2.*S)
61136 XGLU = 7.90*S/(1.+5.50*S) * EXP(-5.16*S) *
61137 & X**(-1.90*S/(1.+3.60*S)) * X1**1.30 * XL**(0.50+3.*S) +
61138 & 1.273 * EXP(-10.*S) * X**0.40 * X1**(1.76+3.*S)
61139 XSEA = (0.1-0.397*S2+1.121*S3)/(1.+5.61*S2+5.26*S3) *
61140 & X**(-7.32*S2/(1.+10.3*S2)) *
61141 & X1**((3.76+15.*S+12.*S2)/(1.+4.*S))
61142 XSEA0 = 0.100 * X1**3.76
61145 C...Evaluate set 1M parton distributions below or above threshold.
61146 ELSEIF(ISET.EQ.2) THEN
61147 IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR.
61148 &(KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN
61149 XVAL = 0.8477 * X**0.51 * X1**1.37
61150 XGLU = 3.42 * X**0.255 * X1**2.37
61153 XVAL = 0.8477/(1.+1.37*S+2.18*S2+3.73*S3) * X**(0.51+0.21*S)
61154 & * X1**1.37 * XL**(2.667*S)
61155 XGLU = 24.*S/(1.+9.6*S+0.92*S2+14.34*S3) * EXP(-5.94*S) *
61156 & X**((-0.013-1.80*S)/(1.+3.14*S)) * X1**(2.37+0.4*S) *
61157 & XL**(0.32+3.6*S) + 3.42 * EXP(-12.*S) * X**0.255 *
61159 XSEA = 0.842*S/(1.+21.3*S-33.2*S2+229.*S3) *
61160 & X**((0.13-2.90*S)/(1.+5.44*S)) * X1**(3.45+0.5*S) *
61165 C...Evaluate set 2D parton distributions below or above threshold.
61166 ELSEIF(ISET.EQ.3) THEN
61167 IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR.
61168 &(KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN
61169 XVAL = X**0.46 * X1**0.64 + 0.76 * X
61170 XGLU = 1.925 * X1**2
61171 XSEA = 0.242 * X1**4
61173 XVAL = (1.+0.186*S)/(1.-0.209*S+1.495*S2) * X**(0.46+0.25*S)
61174 & * X1**((0.64+0.14*S+5.*S2)/(1.+S)) * XL**(1.9*S) +
61175 & (0.76+0.4*S) * X * X1**(2.667*S)
61176 XGLU = (1.925+5.55*S+147.*S2)/(1.-3.59*S+3.32*S2) *
61177 & EXP(-18.67*S) * X**((-5.81*S-5.34*S2)/(1.+29.*S-4.26*S2))
61178 & * X1**((2.-5.9*S)/(1.+1.7*S)) * XL**(9.3*S/(1.+1.7*S))
61179 XSEA = (0.242-0.252*S+1.19*S2)/(1.-0.607*S+21.95*S2) *
61180 & X**(-12.1*S2/(1.+2.62*S+16.7*S2)) * X1**4 * XL**S
61181 XSEA0 = 0.242 * X1**4
61184 C...Evaluate set 2M parton distributions below or above threshold.
61185 ELSEIF(ISET.EQ.4) THEN
61186 IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR.
61187 &(KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN
61188 XVAL = 1.168 * X**0.50 * X1**2.60 + 0.965 * X
61189 XGLU = 1.808 * X1**2
61190 XSEA = 0.209 * X1**4
61192 XVAL = (1.168+1.771*S+29.35*S2) * EXP(-5.776*S) *
61193 & X**((0.5+0.208*S)/(1.-0.794*S+1.516*S2)) *
61194 & X1**((2.6+7.6*S)/(1.+5.*S)) * XL**(5.15*S/(1.+2.*S)) +
61195 & (0.965+22.35*S)/(1.+18.4*S) * X * X1**(2.667*S)
61196 XGLU = (1.808+29.9*S)/(1.+26.4*S) * EXP(-5.28*S) *
61197 & X**((-5.35*S-10.11*S2)/(1.+31.71*S)) *
61198 & X1**((2.-7.3*S+4.*S2)/(1.+2.5*S)) *
61199 & XL**(10.9*S/(1.+2.5*S))
61200 XSEA = (0.209+0.644*S2)/(1.+0.319*S+17.6*S2) *
61201 & X**((-0.373*S-7.71*S2)/(1.+0.815*S+11.0*S2)) *
61202 & X1**(4.+S) * XL**(0.45*S)
61203 XSEA0 = 0.209 * X1**4
61207 C...Threshold factors for c and b sea.
61208 SLL=LOG(LOG(Q2EFF/ALAM**2)/LOG(P2EFF/ALAM**2))
61210 IF(Q2.GT.PMC**2.AND.Q2.GT.1.001*P2EFF) THEN
61211 SCH=MAX(0.,LOG(LOG(PMC**2/ALAM**2)/LOG(P2EFF/ALAM**2)))
61213 XCHM=XSEA*(1.-(SCH/SLL)**2)
61215 XCHM=MAX(0.,XSEA-XSEA0*X1**(2.667*S))*(1.-SCH/SLL)
61219 IF(Q2.GT.PMB**2.AND.Q2.GT.1.001*P2EFF) THEN
61220 SBT=MAX(0.,LOG(LOG(PMB**2/ALAM**2)/LOG(P2EFF/ALAM**2)))
61222 XBOT=XSEA*(1.-(SBT/SLL)**2)
61224 XBOT=MAX(0.,XSEA-XSEA0*X1**(2.667*S))*(1.-SBT/SLL)
61228 C...Fill parton distributions.
61235 XPGA(KFA)=XPGA(KFA)+XVAL
61237 XPGA(-KFL)=XPGA(KFL)
61245 C*********************************************************************
61247 SUBROUTINE SASANO(KF,X,Q2,P2,ALAM,XPGA,VXPGA)
61248 C...Purpose: to evaluate the parton distributions of the anomalous
61249 C...photon, inhomogeneously evolved from a scale P2 (where it vanishes)
61251 C...KF=0 gives the sum over (up to) 5 flavours,
61252 C...KF<0 limits to flavours up to abs(KF),
61253 C...KF>0 is for flavour KF only.
61254 C...ALAM is the 4-flavour Lambda, which is automatically converted
61255 C...to 3- and 5-flavour equivalents as needed.
61256 DIMENSION XPGA(-6:6), VXPGA(-6:6), ALAMSQ(3:5)
61257 DATA PMC/1.3/, PMB/4.6/, AEM2PI/0.0011614/
61264 IF(Q2.LE.P2) RETURN
61267 C...Calculate Lambda; protect against unphysical Q2 and P2 input.
61268 ALAMSQ(3)=(ALAM*(PMC/ALAM)**(2./27.))**2
61270 ALAMSQ(5)=(ALAM*(ALAM/PMB)**(2./23.))**2
61271 P2EFF=MAX(P2,1.2*ALAMSQ(3))
61272 IF(KF.EQ.4) P2EFF=MAX(P2EFF,PMC**2)
61273 IF(KF.EQ.5) P2EFF=MAX(P2EFF,PMB**2)
61274 Q2EFF=MAX(Q2,P2EFF)
61277 C...Find number of flavours at lower and upper scale.
61279 IF(P2EFF.LT.PMC**2) NFP=3
61280 IF(P2EFF.GT.PMB**2) NFP=5
61282 IF(Q2EFF.LT.PMC**2) NFQ=3
61283 IF(Q2EFF.GT.PMB**2) NFQ=5
61285 C...Define range of flavour loop.
61289 ELSEIF(KF.LT.0) THEN
61297 C...Loop over flavours the photon can branch into.
61298 DO 110 KFL=KFLMN,KFLMX
61300 C...Light flavours: calculate t range and (approximate) s range.
61301 IF(KFL.LE.3.AND.(KFL.EQ.1.OR.KFL.EQ.KF)) THEN
61302 TDIFF=LOG(Q2EFF/P2EFF)
61303 S=(6./(33.-2.*NFQ))*LOG(LOG(Q2EFF/ALAMSQ(NFQ))/
61304 & LOG(P2EFF/ALAMSQ(NFQ)))
61305 IF(NFQ.GT.NFP) THEN
61307 IF(NFQ.EQ.4) Q2DIV=PMC**2
61308 SNFQ=(6./(33.-2.*NFQ))*LOG(LOG(Q2DIV/ALAMSQ(NFQ))/
61309 & LOG(P2EFF/ALAMSQ(NFQ)))
61310 SNFP=(6./(33.-2.*(NFQ-1)))*LOG(LOG(Q2DIV/ALAMSQ(NFQ-1))/
61311 & LOG(P2EFF/ALAMSQ(NFQ-1)))
61312 S=S+(LOG(Q2DIV/P2EFF)/LOG(Q2EFF/P2EFF))*(SNFP-SNFQ)
61314 IF(NFQ.EQ.5.AND.NFP.EQ.3) THEN
61316 SNF4=(6./(33.-2.*4))*LOG(LOG(Q2DIV/ALAMSQ(4))/
61317 & LOG(P2EFF/ALAMSQ(4)))
61318 SNF3=(6./(33.-2.*3))*LOG(LOG(Q2DIV/ALAMSQ(3))/
61319 & LOG(P2EFF/ALAMSQ(3)))
61320 S=S+(LOG(Q2DIV/P2EFF)/LOG(Q2EFF/P2EFF))*(SNF3-SNF4)
61323 C...u and s quark do not need a separate treatment when d has been done.
61324 ELSEIF(KFL.EQ.2.OR.KFL.EQ.3) THEN
61326 C...Charm: as above, but only include range above c threshold.
61327 ELSEIF(KFL.EQ.4) THEN
61328 IF(Q2.LE.PMC**2) GOTO 110
61329 P2EFF=MAX(P2EFF,PMC**2)
61330 Q2EFF=MAX(Q2EFF,P2EFF)
61331 TDIFF=LOG(Q2EFF/P2EFF)
61332 S=(6./(33.-2.*NFQ))*LOG(LOG(Q2EFF/ALAMSQ(NFQ))/
61333 & LOG(P2EFF/ALAMSQ(NFQ)))
61334 IF(NFQ.EQ.5.AND.NFP.EQ.4) THEN
61336 SNFQ=(6./(33.-2.*NFQ))*LOG(LOG(Q2DIV/ALAMSQ(NFQ))/
61337 & LOG(P2EFF/ALAMSQ(NFQ)))
61338 SNFP=(6./(33.-2.*(NFQ-1)))*LOG(LOG(Q2DIV/ALAMSQ(NFQ-1))/
61339 & LOG(P2EFF/ALAMSQ(NFQ-1)))
61340 S=S+(LOG(Q2DIV/P2EFF)/LOG(Q2EFF/P2EFF))*(SNFP-SNFQ)
61343 C...Bottom: as above, but only include range above b threshold.
61344 ELSEIF(KFL.EQ.5) THEN
61345 IF(Q2.LE.PMB**2) GOTO 110
61346 P2EFF=MAX(P2EFF,PMB**2)
61347 Q2EFF=MAX(Q2,P2EFF)
61348 TDIFF=LOG(Q2EFF/P2EFF)
61349 S=(6./(33.-2.*NFQ))*LOG(LOG(Q2EFF/ALAMSQ(NFQ))/
61350 & LOG(P2EFF/ALAMSQ(NFQ)))
61353 C...Evaluate flavour-dependent prefactor (charge^2 etc.).
61355 IF(KFL.EQ.2.OR.KFL.EQ.4) CHSQ=4./9.
61356 FAC=AEM2PI*2.*CHSQ*TDIFF
61358 C...Evaluate parton distributions (normalized to unit momentum sum).
61359 IF(KFL.EQ.1.OR.KFL.EQ.4.OR.KFL.EQ.5.OR.KFL.EQ.KF) THEN
61360 XVAL= ((1.5+2.49*S+26.9*S**2)/(1.+32.3*S**2)*X**2 +
61361 & (1.5-0.49*S+7.83*S**2)/(1.+7.68*S**2)*(1.-X)**2 +
61362 & 1.5*S/(1.-3.2*S+7.*S**2)*X*(1.-X)) *
61363 & X**(1./(1.+0.58*S)) * (1.-X**2)**(2.5*S/(1.+10.*S))
61364 XGLU= 2.*S/(1.+4.*S+7.*S**2) *
61365 & X**(-1.67*S/(1.+2.*S)) * (1.-X**2)**(1.2*S) *
61366 & ((4.*X**2+7.*X+4.)*(1.-X)/3. - 2.*X*(1.+X)*XL)
61367 XSEA= 0.333*S**2/(1.+4.90*S+4.69*S**2+21.4*S**3) *
61368 & X**(-1.18*S/(1.+1.22*S)) * (1.-X)**(1.2*S) *
61369 & ((8.-73.*X+62.*X**2)*(1.-X)/9. + (3.-8.*X**2/3.)*X*XL +
61370 & (2.*X-1.)*X*XL**2)
61372 C...Threshold factors for c and b sea.
61373 SLL=LOG(LOG(Q2EFF/ALAM**2)/LOG(P2EFF/ALAM**2))
61375 IF(Q2.GT.PMC**2.AND.Q2.GT.1.001*P2EFF) THEN
61376 SCH=MAX(0.,LOG(LOG(PMC**2/ALAM**2)/LOG(P2EFF/ALAM**2)))
61377 XCHM=XSEA*(1.-(SCH/SLL)**3)
61380 IF(Q2.GT.PMB**2.AND.Q2.GT.1.001*P2EFF) THEN
61381 SBT=MAX(0.,LOG(LOG(PMB**2/ALAM**2)/LOG(P2EFF/ALAM**2)))
61382 XBOT=XSEA*(1.-(SBT/SLL)**3)
61386 C...Add contribution of each valence flavour.
61387 XPGA(0)=XPGA(0)+FAC*XGLU
61388 XPGA(1)=XPGA(1)+FAC*XSEA
61389 XPGA(2)=XPGA(2)+FAC*XSEA
61390 XPGA(3)=XPGA(3)+FAC*XSEA
61391 XPGA(4)=XPGA(4)+FAC*XCHM
61392 XPGA(5)=XPGA(5)+FAC*XBOT
61393 XPGA(KFL)=XPGA(KFL)+FAC*XVAL
61394 VXPGA(KFL)=VXPGA(KFL)+FAC*XVAL
61397 XPGA(-KFL)=XPGA(KFL)
61398 VXPGA(-KFL)=VXPGA(KFL)
61404 C*********************************************************************
61406 SUBROUTINE SASBEH(KF,X,Q2,P2,PM2,XPBH)
61407 C...Purpose: to evaluate the Bethe-Heitler cross section for
61408 C...heavy flavour production.
61409 DATA AEM2PI/0.0011614/
61415 C...Check kinematics limits.
61416 IF(X.GE.Q2/(4.*PM2+Q2+P2)) RETURN
61419 IF(BETA2.LT.1E-10) RETURN
61423 C...Simple case: P2 = 0.
61424 IF(P2.LT.1E-4) THEN
61425 IF(BETA.LT.0.99) THEN
61426 XBL=LOG((1.+BETA)/(1.-BETA))
61428 XBL=LOG((1.+BETA)**2*W2/(4.*PM2))
61430 SIGBH=BETA*(8.*X*(1.-X)-1.-RMQ*X*(1.-X))+
61431 & XBL*(X**2+(1.-X)**2+RMQ*X*(1.-3.*X)-0.5*RMQ**2*X**2)
61433 C...Complicated case: P2 > 0, based on approximation of
61434 C...C.T. Hill and G.G. Ross, Nucl. Phys. B148 (1979) 373
61436 RPQ=1.-4.*X**2*P2/Q2
61437 IF(RPQ.GT.1E-10) THEN
61438 RPBE=SQRT(RPQ*BETA2)
61439 IF(RPBE.LT.0.99) THEN
61440 XBL=LOG((1.+RPBE)/(1.-RPBE))
61441 XBI=2.*RPBE/(1.-RPBE**2)
61443 RPBESN=4.*PM2/W2+(4.*X**2*P2/Q2)*BETA2
61444 XBL=LOG((1.+RPBE)**2/RPBESN)
61447 SIGBH=BETA*(6.*X*(1.-X)-1.)+
61448 & XBL*(X**2+(1.-X)**2+RMQ*X*(1.-3.*X)-0.5*RMQ**2*X**2)+
61449 & XBI*(2.*X/Q2)*(PM2*X*(2.-RMQ)-P2*X)
61453 C...Multiply by charge-squared etc. to get parton distribution.
61455 IF(IABS(KF).EQ.2.OR.IABS(KF).EQ.4) CHSQ=4./9.
61456 XPBH=3.*CHSQ*AEM2PI*X*SIGBH
61461 C*********************************************************************
61463 SUBROUTINE SASDIR(X,Q2,P2,Q02,XPGA)
61464 C...Purpose: to evaluate the direct contribution, i.e. the C^gamma term,
61465 C...as needed in MSbar parametrizations.
61466 DIMENSION XPGA(-6:6)
61467 DATA AEM2PI/0.0011614/
61474 C...Evaluate common x-dependent expression.
61475 XTMP = (X**2+(1.-X)**2) * (-LOG(X)) - 1.
61476 CGAM = 3.*AEM2PI*X * (XTMP*(1.+P2/(P2+Q02)) + 6.*X*(1.-X))
61478 C...d, u, s part by simple charge factor.
61479 XPGA(1)=(1./9.)*CGAM
61480 XPGA(2)=(4./9.)*CGAM
61481 XPGA(3)=(1./9.)*CGAM
61483 C...Also fill for antiquarks.
61490 C-----------------------------------------------------------------------
61492 *CMZ :- -28/06/01 16.55.32 by Bryan Webber
61493 *-- Author : Bryan Webber
61494 C-----------------------------------------------------------------------
61495 SUBROUTINE TIMEL(TRES)
61496 C-----------------------------------------------------------------------
61497 C DUMMY TIME SUBROUTINE: DELETE AND REPLACE BY SYSTEM
61498 C ROUTINE GIVING TRES = CPU TIME REMAINING (SECONDS)
61499 C-----------------------------------------------------------------------
61506 10 FORMAT(/10X,'SUBROUTINE TIMEL CALLED BUT NOT LINKED.'/
61507 & 10X,'DUMMY TIMEL WILL BE USED. DELETE DUMMY'/
61508 & 10X,'AND LINK CERNLIB FOR CPU TIME REMAINING.')