1 C HERWIG---AliRoot/HERWIG
2 C-----------------------------------------------------------------------
5 C a Monte Carlo event generator for simulating
6 C +---------------------------------------------------+
7 C | Hadron Emission Reactions With Interfering Gluons |
8 C +---------------------------------------------------+
9 C I.G. Knowles(*), G. Marchesini(+), M.H.Seymour($,&) and B.R. Webber(#)
10 C-----------------------------------------------------------------------
11 C with Minimal Supersymmetric Standard Model Matrix Elements by
12 C S. Moretti(") and K. Odagiri(^)
13 C-----------------------------------------------------------------------
14 C R parity violating Supersymmetric Decays and Matrix Elements by
16 C-----------------------------------------------------------------------
17 C matrix element corrections to top decay and Drell-Yan type processes
19 C-----------------------------------------------------------------------
20 C Deep Inelastic Scattering and Heavy Flavour Electroproduction by
21 C G. Abbiendi(@) and L. Stanco(%)
22 C-----------------------------------------------------------------------
23 C and Jet Photoproduction in Lepton-Hadron Collisions by J. Chyla(~)
24 C-----------------------------------------------------------------------
25 C(*) Department of Physics & Astronomy, University of Edinburgh
26 C(+) Dipartimento di Fisica, Universita di Milano-Bicocca
27 C($) School of Physics & Astronomy, University of Manchester
28 C(&) Theory Physics Group, CERN
29 C(#) Cavendish Laboratory, Cambridge
30 C(") School of Physics & Astronomy, Southampton
31 C(^) Academia Sinica, Taiwan
32 C(X) Institute of Particle Physics Phenomenology, University of Durham
33 C(@) Dipartimento di Fisica, Universita di Bologna
34 C(%) Dipartimento di Fisica, Universita di Padova
35 C(~) Institute of Physics, Prague
36 C-----------------------------------------------------------------------
37 C Version 6.510 - 31st October 2005
38 C-----------------------------------------------------------------------
41 C G.Corcella, I.G.Knowles, G.Marchesini, S.Moretti, K.Odagiri,
42 C P.Richardson, M.H.Seymour and B.R.Webber, JHEP 0101 (2001) 010
44 C G.Marchesini, B.R.Webber, G.Abbiendi, I.G.Knowles, M.H.Seymour,
45 C and L.Stanco, Computer Physics Communications 67 (1992) 465.
46 C-----------------------------------------------------------------------
47 C Please see the official HERWIG information page:
48 C http://hepwww.rl.ac.uk/theory/seymour/herwig/
49 C-----------------------------------------------------------------------
51 *CMZ :- -03/07/01 17.07.47 by Bryan Webber
52 *-- Author : Bryan Webber
53 C-----------------------------------------------------------------------
54 FUNCTION CIRCEE (X1, X2)
55 C-----------------------------------------------------------------------
56 C DUMMY FUNCTION: DELETE AND SET CIRCOP NON-ZERO
57 C IN MAIN PROGRAM IF YOU USE CIRCE BEAM SPECTRUM PACKAGE
58 C-----------------------------------------------------------------------
60 DOUBLE PRECISION CIRCEE, X1, X2
62 10 FORMAT(/10X,'CIRCEE CALLED BUT NOT LINKED')
67 *CMZ :- -03/07/01 17.07.47 by Bryan Webber
68 *-- Author : Bryan Webber
69 C-----------------------------------------------------------------------
70 SUBROUTINE CIRCES (XX1M, XX2M, XROOTS, XACC, XVER, XREV, XCHAT)
71 C-----------------------------------------------------------------------
72 C DUMMY SUBROUTINE: DELETE AND SET CIRCOP NON-ZERO
73 C IN MAIN PROGRAM IF YOU USE CIRCE BEAM SPECTRUM PACKAGE
74 C-----------------------------------------------------------------------
76 DOUBLE PRECISION XX1M, XX2M, XROOTS
77 INTEGER XACC, XVER, XREV, XCHAT
79 10 FORMAT(/10X,'CIRCES CALLED BUT NOT LINKED')
83 *CMZ :- -03/07/01 17.07.47 by Bryan Webber
84 *-- Author : Bryan Webber
85 C-----------------------------------------------------------------------
86 FUNCTION CIRCGG (X1, X2)
87 C-----------------------------------------------------------------------
88 C DUMMY FUNCTION: DELETE AND SET CIRCOP NON-ZERO
89 C IN MAIN PROGRAM IF YOU USE CIRCE BEAM SPECTRUM PACKAGE
90 C-----------------------------------------------------------------------
92 DOUBLE PRECISION CIRCGG, X1, X2
94 10 FORMAT(/10X,'CIRCGG CALLED BUT NOT LINKED')
99 *CMZ :- -28/01/92 12.34.44 by Mike Seymour
100 *-- Author : Luca Stanco
101 C-----------------------------------------------------------------------
102 SUBROUTINE DECADD(LOGI)
103 C-----------------------------------------------------------------------
104 C DUMMY SUBROUTINE: DELETE AND SET BDECAY='CLEO'
105 C IN MAIN PROGRAM IF YOU USE CLEO DECAY PACKAGE
106 C-----------------------------------------------------------------------
110 10 FORMAT(/10X,'DECADD CALLED BUT NOT LINKED')
114 *CMZ :- -17/10/01 10.03.37 by Peter Richardson
115 *-- Author : Peter Richardson
116 C-----------------------------------------------------------------------
117 SUBROUTINE DEXAY(IMODE,POL)
118 C-----------------------------------------------------------------------
119 C DUMMY SUBROUTINE: DELETE AND SET TAUDEC='TAUOLA'
120 C IN MAIN PROGRAM IF YOU USE TAUOLA DECAY PACKAGE
121 C-----------------------------------------------------------------------
126 10 FORMAT(/10X,'DEXAY CALLED BUT NOT LINKED')
130 *CMZ :- -28/01/92 12.34.44 by Mike Seymour
131 *-- Author : Luca Stanco
132 C-----------------------------------------------------------------------
134 C-----------------------------------------------------------------------
135 C DUMMY SUBROUTINE: DELETE AND SET BDECAY='EURO'
136 C IN MAIN PROGRAM IF YOU USE EURODEC DECAY PACKAGE
137 C-----------------------------------------------------------------------
140 10 FORMAT(/10X,'EUDINI CALLED BUT NOT LINKED')
144 *CMZ :- -17/10/01 09:42:21 by Peter Richardson
145 *-- Author : Martin W. Gruenewald
146 C-----------------------------------------------------------------------
147 SUBROUTINE FILHEP(N,IST,ID,JMO1,JMO2,JDA1,JDA2,P4,PINV,PHFLAG)
148 C ----------------------------------------------------------------------
149 C this subroutine fills one entry into the HEPEVT common
150 C and updates the information for affected mother entries
153 C written by Martin W. Gruenewald (91/01/28)
154 C ----------------------------------------------------------------------
155 INCLUDE 'herwig65.inc'
157 COMMON /PHORAD/ QEDRAD(NMXHEP)
158 INTEGER N,IHEP,IST,ID,JMO1,JMO2,JDA1,JDA2,I,IP
167 ELSE IF (N.GT.0) THEN
175 IF ((IHEP.LE.0).OR.(IHEP.GT.NMXHEP)) RETURN
181 IF(JMO1.LT.0)JMOHEP(1,IHEP)=JMOHEP(1,IHEP)+IHEP
183 IF(JMO2.LT.0)JMOHEP(2,IHEP)=JMOHEP(2,IHEP)+IHEP
188 C KORAL-B and KORAL-Z do not provide vertex and/or lifetime informations
195 DO IP=JMOHEP(1,IHEP),JMOHEP(2,IHEP)
197 C if there is a daughter at IHEP, mother entry at IP has decayed
198 IF(ISTHEP(IP).EQ.1)ISTHEP(IP)=2
199 C and daughter pointers of mother entry must be updated
200 IF(JDAHEP(1,IP).EQ.0)THEN
204 JDAHEP(2,IP)=MAX(IHEP,JDAHEP(2,IP))
210 *CMZ :- -28/01/92 12.34.44 by Mike Seymour
211 *-- Author : Luca Stanco
212 C-----------------------------------------------------------------------
213 SUBROUTINE FRAGMT(I,J,K)
214 C-----------------------------------------------------------------------
215 C DUMMY SUBROUTINE: DELETE AND SET BDECAY='EURO'
216 C IN MAIN PROGRAM IF YOU USE EURODEC DECAY PACKAGE
217 C-----------------------------------------------------------------------
221 10 FORMAT(/10X,'FRAGMT CALLED BUT NOT LINKED')
225 *CMZ :- -28/01/92 12.34.44 by Mike Seymour
226 *-- Author : Mike Seymour
227 C-----------------------------------------------------------------------
229 C-----------------------------------------------------------------------
230 C DUMMY ROUTINE: DELETE IF YOU LINK TO BARYON NUMBER VIOLATN PACKAGE
231 C-----------------------------------------------------------------------
234 10 FORMAT(/10X,'HVCBVI CALLED BUT NOT LINKED')
238 *CMZ :- -28/01/92 12.34.44 by Mike Seymour
239 *-- Author : Mike Seymour
240 C-----------------------------------------------------------------------
242 C-----------------------------------------------------------------------
243 C DUMMY ROUTINE: DELETE IF YOU LINK TO BARYON NUMBER VIOLATN PACKAGE
244 C-----------------------------------------------------------------------
247 10 FORMAT(/10X,'HERBVI CALLED BUT NOT LINKED')
251 *CMZ :- -26/04/91 11.11.54 by Bryan Webber
252 *-- Author : Ian Knowles
253 C-----------------------------------------------------------------------
254 SUBROUTINE HWBAZF(IPAR,JPAR,VEC1,VEC2,VEC3,VEC)
255 C-----------------------------------------------------------------------
256 C Azimuthal correlation functions for Collins' algorithm,
257 C see I.G.Knowles, Comp. Phys. Comm. 58 (90) 271 for notation.
258 C-----------------------------------------------------------------------
259 INCLUDE 'herwig65.inc'
260 DOUBLE PRECISION Z1,Z2,DOT12,DOT23,DOT31,TR,FN(7),VEC1(2),VEC2(2),
264 IF (.NOT.AZSPIN) RETURN
265 Z1=PPAR(4,JPAR)/PPAR(4,IPAR)
267 GLUI=IDPAR(IPAR).EQ.13
268 GLUJ=IDPAR(JPAR).EQ.13
275 FN(1)=FN(2)+FN(3)+FN(4)
280 C Branching: g--->qqbar
281 FN(1)=(Z1*Z1+Z2*Z2)/2.
292 FN(1)=(1.+Z2*Z2)/(2.*Z1)
301 FN(1)=(1.+Z1*Z1)/(2.*Z2)
310 DOT12=VEC1(1)*VEC2(1)+VEC1(2)*VEC2(2)
311 DOT23=VEC2(1)*VEC3(1)+VEC2(2)*VEC3(2)
312 DOT31=VEC3(1)*VEC1(1)+VEC3(2)*VEC1(2)
313 TR=1./(FN(1)+FN(2)*DOT23+FN(3)*DOT31+FN(4)*DOT12)
314 VEC(1)=((FN(2)+FN(5)*DOT23)*VEC1(1)
315 & +(FN(3)+FN(6)*DOT31)*VEC2(1)
316 & +(FN(4)+FN(7)*DOT12)*VEC3(1))*TR
317 VEC(2)=((FN(2)+FN(5)*DOT23)*VEC1(2)
318 & +(FN(3)+FN(6)*DOT31)*VEC2(2)
319 & +(FN(4)+FN(7)*DOT12)*VEC3(2))*TR
322 *CMZ :- -11/10/01 12.01.52 by Peter Richardson
323 *-- Author : Bryan Webber
324 C-----------------------------------------------------------------------
326 C-----------------------------------------------------------------------
327 C MAKES COLOUR CONNECTIONS BETWEEN JETS
328 C MODIFIED 12/10/97 BY BRW FOR SUSY PROCESSES
329 C MODIFIED 11/01/01 BY PR FOR SPIN CORRELATIONS(PROBLEM WITH ORDER
331 C NEW VARAIBLE BACK TO ALLOW CODE TO SEARCH DOWN CHAIN
332 C-----------------------------------------------------------------------
333 INCLUDE 'herwig65.inc'
334 INTEGER IHEP,IST,ID,JC,KC,JD,JHEP,LHEP,ID2,NTRY,KHEP
336 IF (IERROR.NE.0) RETURN
344 C---LOOK FOR PARTONS WITHOUT COLOUR MOTHERS
345 IF (IST.LT.145.OR.IST.GT.152) GOTO 20
346 51 IF (JMOHEP(2,IHEP).EQ.0.OR.BACK.OR.
347 & ISTHEP(JMOHEP(2,IHEP)).EQ.155) THEN
348 C---FIND COLOUR-CONNECTED PARTON
350 IF(JMOHEP(2,IHEP).EQ.0) THEN
352 IF (IST.NE.152) JC=JMOHEP(1,JC)
359 CALL HWWARN('HWBCON',51)
362 C---FIND SPECTATOR WHEN JC IS DECAYED HEAVY QUARK OR SUSY PARTICLE
363 52 IF (ISTHEP(JC).EQ.155.OR.BACK) THEN
364 IF (IDHEP(JMOHEP(1,JC)).EQ.94.OR.BACK) THEN
365 C---DECAYED BEFORE HADRONIZING
366 IF(BACK.OR.(JMOHEP(2,IHEP).NE.0.AND.
367 & ISTHEP(JMOHEP(2,IHEP)).EQ.155)) GOTO 53
369 C--new bit to try and fix the problems for spin correlations
370 C--move one step further up the tree and hope this helps
376 IF(JHEP.NE.0.AND.ISTHEP(JHEP).EQ.155)
377 & JHEP = JMOHEP(2,JHEP)
378 IF(JHEP.EQ.0.AND.NTRY.LT.NHEP) GOTO 1
379 IF(NHEP.EQ.NTRY) GOTO 20
382 IF (ISTHEP(JHEP).EQ.155) THEN
383 C---SPECIAL FOR GLUINO DECAYS
386 C---N.B. WILL NEED MODS WHEN SUSY PARTICLES CAN SHOWER
387 IF (ID.EQ.449.OR.ID.EQ.13.OR.
388 & (ID.GE.401.AND.ID.LE.406).OR.
389 & (ID.GE.413.AND.ID.LE.418).OR.
390 & ID.LE.6.OR.(ID.GE.115.AND.ID.LE.120)) THEN
391 C---LOOK FOR ANTI(S)QUARK OR GLUON
392 DO KC=JDAHEP(1,JHEP),JDAHEP(2,JHEP)
394 IF ((ID.GE. 7.AND.ID.LE. 13).OR.
395 & (ID.GE.407.AND.ID.LE.412).OR.
396 & (ID.GE.419.AND.ID.LE.424)) GOTO 5
399 C---LOOK FOR (S)QUARK OR GLUON
400 DO KC=JDAHEP(1,JHEP),JDAHEP(2,JHEP)
402 IF (ID.LE. 6.OR. ID.EQ. 13.OR.
403 & (ID.GE.401.AND.ID.LE.406).OR.
404 & (ID.GE.413.AND.ID.LE.418)) GOTO 5
408 CALL HWWARN('HWBCON',101)
412 C--PR MOD 30/6/99 should fix HWCFOR 104 errors
414 IF(IDHW(JDAHEP(1,JHEP)).EQ.449.AND.
415 & (ID2.LE.6.OR.(ID2.GE.115.AND.ID2.LE.120).OR.
416 & (ID2.GE.401.AND.ID2.LE.406).OR.ID2.EQ.13.OR.
417 & (ID2.GE.413.AND.ID2.LE.418).OR.ID2.EQ.449)) THEN
420 C--modifcation for top ME correction (modified for additional photon radiation)
421 IF(IDHW(JHEP).EQ.6) THEN
422 JC = JDAHEP(1,JHEP)+1
424 JC = JDAHEP(1,JHEP)+1
425 IF(IDHW(JDAHEP(1,JHEP)+2).EQ.13) JC=JC+1
429 ELSEIF (ID.EQ.6.OR.ID.EQ.12.OR.
430 & (ID.GE.209.AND.ID.LE.218).OR.
431 & (ID.GE.401.AND.ID.LE.424).OR.ID.EQ.449) THEN
432 C Wait for partner heavy quark to decay
434 C---N.B. MAY BE A PROBLEM HERE
447 C---SEARCH IN CORRESPONDING JET
451 IF (ISTHEP(JHEP).LT.145.OR.ISTHEP(JHEP).GT.152) GOTO 10
452 IF (JDAHEP(2,JHEP).EQ.IHEP) LHEP=JHEP
453 IF (JDAHEP(2,JHEP).NE.0) GOTO 10
454 C---JOIN IHEP AND JHEP
463 C--search down the tree
465 IF(ISTHEP(KHEP).EQ.3.AND.ISTHEP(JDAHEP(1,KHEP)).EQ.155) THEN
466 JHEP = JDAHEP(1,KHEP)
471 C---DIDN'T FIND PARTNER OF IHEP YET
472 C CALL HWWARN('HWBCON',52)
477 C---BREAK COLOUR CONNECTIONS WITH PHOTONS
479 30 IF (IHEP.LE.NHEP) THEN
480 IF (IDHW(IHEP).EQ.59 .AND. ISTHEP(IHEP).EQ.149) THEN
482 IF (JMOHEP(2,IHEP).NE.0) THEN
483 IF (JDAHEP(2,JMOHEP(2,IHEP)).EQ.IHEP)
484 & JDAHEP(2,JMOHEP(2,IHEP))=JDAHEP(2,IHEP)
487 IF (JDAHEP(2,IHEP).NE.0) THEN
488 IF (JMOHEP(2,JDAHEP(2,IHEP)).EQ.IHEP)
489 & JMOHEP(2,JDAHEP(2,IHEP))=JMOHEP(2,IHEP)
500 *CMZ :- -22/04/96 13.54.08 by Mike Seymour
501 *-- Author : Mike Seymour
502 C-----------------------------------------------------------------------
503 SUBROUTINE HWBDED(IOPT)
504 C FILL MISSING AREA OF DALITZ PLOT WITH 3-JET AND 2-JET+GAMMA EVENTS
505 C IF (IOPT.EQ.1) SET UP EVENT RECORD
506 C IF (IOPT.EQ.2) CLEAN UP EVENT RECORD AFTER SHOWERING
508 C********MODIFIED 13/11/00 BY BRW TO ALLOW MULTIPLE APPLICATION IN
509 C*******SAME EVENT (FOR WW AND ZZ) N.B. NO CLEANUP CALLS FOR THESE!
510 C-----------------------------------------------------------------------
511 INCLUDE 'herwig65.inc'
512 DOUBLE PRECISION HWBVMC,HWRGEN,HWUALF,HWUSQR,X(3),W,WMAX,WSUM,
513 & X1MIN,X1MAX,X2MIN,X2MAX,QSCALE,GAMFAC,GLUFAC,R(3,3),CS,SN,M(3),
514 & E(3),LAMBDA,A,B,C,PTSQ,EM,P1(5),P2(5),PVRT(4),EPS,MASDEP
515 INTEGER ID,ID3,EMIT,NOEMIT,IEVT,IHEP,JHEP,KHEP,ICMF,IOPT,IEDT(3),
516 & I,NDEL,LHEP,IP,JP,KP,IDUN
517 EXTERNAL HWBVMC,HWRGEN,HWUALF,HWUSQR
519 SAVE WSUM, X1MIN,X1MAX,EMIT,ICMF,IEVT
520 DATA WSUM,WMAX,X1MIN,X1MAX,EMIT,ICMF,IEVT
521 & /0.994651D0,1.84096D0,0.0D0,0.773459D0,3*0.0D0/
522 LAMBDA(A,B,C)=(A**2+B**2+C**2-2*A*B-2*B*C-2*C*A)/(4*A)
524 C---FIND AN UNTREATED CMF
525 IF (IEVT.EQ.NEVHEP+NWGTS) RETURN
529 DO 10 IHEP=IDUN+1,NHEP
530 10 IF (ICMF.EQ.IDUN .AND. ISTHEP(IHEP).EQ.110 .AND.
531 & JDAHEP(2,IHEP).EQ.JDAHEP(1,IHEP)+1) ICMF=IHEP
532 IF (ICMF.EQ.IDUN) RETURN
534 IF (EM.LT.2*HWBVMC(1)) GOTO 5
535 C---ONLY APPLY THE CORRECTION TO HADRONIC DECAYS
536 IF (IDHW(JDAHEP(1,ICMF)).GT.12) GOTO 5
537 C---GENERATE X1,X2 ACCORDING TO 1/((1-X1)*(1-X2))
540 X(1)=1-(1-X1MAX)*((1-X1MIN)/(1-X1MAX))**HWRGEN(0)
542 X2MIN=MAX(X(1),1-X(1))
543 X2MAX=(4*X(1)-3+2*DREAL( DCMPLX( X(1)**3+135*(X(1)-1)**3,
544 & 3*HWUSQR(3*(128*X(1)**4-368*X(1)**3+405*X(1)**2-216*X(1)+54))*
545 & (X(1)-1) )**(1./3) ))/3
546 IF (X2MAX.GE.ONE.OR.X2MIN.GE.ONE.OR.X2MAX.LE.X2MIN) GOTO 100
547 X(2)=1-(1-X2MAX)*((1-X2MIN)/(1-X2MAX))**HWRGEN(1)
549 W=2 * LOG((1-X1MIN)/(1-X1MAX))*LOG((1-X2MIN)/(1-X2MAX)) *
551 C---GENERATE UNWEIGHTED (X1,X2) PAIRS (EFFICIENCY IS ~50%)
552 IF (WMAX*HWRGEN(2).GT.W) GOTO 100
555 IF (HWRGEN(5).GT.HALF) THEN
559 C---CHOOSE WHICH PARTON WILL EMIT
561 IF (HWRGEN(6).LT.X(1)**2/(X(1)**2+X(2)**2)) EMIT=2
563 IHEP=JDAHEP( EMIT,ICMF)
564 JHEP=JDAHEP(NOEMIT,ICMF)
565 C---PREFACTORS FOR GAMMA AND GLUON CASES
566 QSCALE=HWUSQR((1-X(1))*(1-X(2))*(1-X(3)))*EM/X(NOEMIT)
567 ID=IDHW(JDAHEP(1,ICMF))
568 GAMFAC=ALPFAC*ALPHEM*ICHRG(ID)**2/(18*PIFAC)
570 IF (QSCALE.GT.HWBVMC(13))
571 & GLUFAC=CFFAC/(2*PIFAC)*HWUALF(1,QSCALE)
572 C---SWITCH OFF PHOTON EMISSION IN W DECAYS (THE M-E DOES NOT FACTORIZE)
573 IF (ICHRG(IDHW(ICMF)).NE.0) GAMFAC=0
574 C---IN FRACTION FAC*WSUM OF EVENTS ADD A GAMMA/GLUON
575 IF (GAMFAC*WSUM .GT. HWRGEN(3)) THEN
577 ELSEIF (GLUFAC*WSUM .GT. HWRGEN(4)) THEN
583 C---CHECK INFRA-RED CUT-OFF FOR GAMMA/GLUON
584 M(EMIT)=PHEP(5,IHEP)+VQCUT
585 M(NOEMIT)=PHEP(5,JHEP)+VQCUT
587 E(1)=HALF*EM*(X(1)+(M(1)**2-M(2)**2-M(3)**2)/EM**2)
588 E(2)=HALF*EM*(X(2)+(M(2)**2-M(3)**2-M(1)**2)/EM**2)
590 PTSQ=-LAMBDA(E(NOEMIT)**2-M(NOEMIT)**2,E(3)**2-M(3)**2,
591 & E(EMIT)**2-M(EMIT)**2)
592 IF (PTSQ.LE.ZERO .OR.
593 $ E(1).LE.M(1).OR.E(2).LE.M(2).OR.E(3).LE.M(3)) THEN
597 C---CALCULATE MASS-DEPENDENT SUPRESSION
598 IF (MOD(IPROC,10).GT.0) THEN
599 EPS=(RMASS(ID)/EM)**2
600 MASDEP=X(1)**2+X(2)**2
601 $ -4*EPS*X(3)-2*EPS*((1-X(2))/(1-X(1))+(1-X(1))/(1-X(2)))
602 $ -4*EPS**2*X(3)**2/((1-X(1))*(1-X(2)))
603 IF (MASDEP.LT.HWRGEN(7)*(X(1)**2+X(2)**2)) THEN
608 C---STORE OLD MOMENTA
609 CALL HWVEQU(5,PHEP(1,JDAHEP(1,ICMF)),P1)
610 CALL HWVEQU(5,PHEP(1,JDAHEP(2,ICMF)),P2)
611 C---GET THE NON-EMITTING PARTON'S CMF DIRECTION
612 CALL HWULOF(PHEP(1,ICMF),PHEP(1,JHEP),PHEP(1,JHEP))
613 CALL HWRAZM(ONE,CS,SN)
614 CALL HWUROT(PHEP(1,JHEP),CS,SN,R)
616 M(NOEMIT)=PHEP(5,JHEP)
620 IF (NHEP.GT.KHEP) THEN
621 C---MOVE UP REST OF EVENT
624 ISTHEP(JP)= ISTHEP(IP)
631 IF (JDAHEP(1,KP).EQ.IP) JDAHEP(1,KP)=JP
632 IF (JDAHEP(2,KP).EQ.IP) JDAHEP(2,KP)=JP
636 IF (KP.GT.KHEP) KP=KP+1
639 IF (KP.GT.KHEP) KP=KP+1
642 IF (KP.GT.KHEP) KP=KP+1
644 CALL HWVEQU(5,PHEP(1,IP),PHEP(1,JP))
645 CALL HWVEQU(4,VHEP(1,IP),VHEP(1,JP))
648 C---REORDER ENTRIES: IHEP=EMITTER, JHEP=NON-EMITTER, KHEP=EMITTED
650 IF (IDHW(IHEP).LT.IDHW(JHEP)) THEN
658 PHEP(5,JHEP)=M(NOEMIT)
661 PHEP(4,JHEP)=HALF*EM*(X(NOEMIT)+
662 & (M(NOEMIT)**2-M(EMIT)**2-M(3)**2)/EM**2)
663 PHEP(4,IHEP)=HALF*EM*(X(EMIT)+
664 & (M(EMIT)**2-M(NOEMIT)**2-M(3)**2)/EM**2)
665 PHEP(4,KHEP)=EM-PHEP(4,IHEP)-PHEP(4,JHEP)
666 PHEP(3,JHEP)=HWUSQR(PHEP(4,JHEP)**2-PHEP(5,JHEP)**2)
667 PHEP(3,IHEP)=( (PHEP(4,KHEP)**2-PHEP(5,KHEP)**2) -
668 & (PHEP(4,IHEP)**2-PHEP(5,IHEP)**2) -
669 & (PHEP(3,JHEP)**2) )*HALF/PHEP(3,JHEP)
670 PHEP(3,KHEP)=-PHEP(3,IHEP)-PHEP(3,JHEP)
675 PHEP(1,IHEP)=HWUSQR(PHEP(4,IHEP)**2-
676 & PHEP(3,IHEP)**2-PHEP(5,IHEP)**2)
677 PHEP(1,KHEP)=-PHEP(1,IHEP)
678 C---ORIENT IN CMF, THEN BOOST TO LAB
679 CALL HWUROB(R,PHEP(1,IHEP),PHEP(1,IHEP))
680 CALL HWUROB(R,PHEP(1,JHEP),PHEP(1,JHEP))
681 CALL HWUROB(R,PHEP(1,KHEP),PHEP(1,KHEP))
682 CALL HWULOB(PHEP(1,ICMF),PHEP(1,IHEP),PHEP(1,IHEP))
683 CALL HWULOB(PHEP(1,ICMF),PHEP(1,JHEP),PHEP(1,JHEP))
684 CALL HWULOB(PHEP(1,ICMF),PHEP(1,KHEP),PHEP(1,KHEP))
685 C---CALCULATE PRODUCTION VERTICES
686 CALL HWVZRO(4,VHEP(1,JHEP))
687 CALL HWVSUM(4,PHEP(1,IHEP),PHEP(1,KHEP),PVRT)
688 CALL HWUDKL(ID,PVRT,VHEP(1,KHEP))
689 CALL HWVEQU(4,VHEP(1,KHEP),VHEP(1,IHEP))
690 C---REORDER ENTRIES: IHEP=QUARK, JHEP=ANTI-QUARK, KHEP=EMITTED
691 IF (IHEP.EQ.LHEP) THEN
695 C---STATUS, ID AND POINTERS
697 IDHW(JHEP)=IDHW(KHEP)
698 IDHEP(JHEP)=IDHEP(KHEP)
700 IDHEP(KHEP)=IDPDG(ID3)
704 C---COLOUR CONNECTIONS AND GLUON POLARIZATION
712 GPOLN=((1-X(1))**2+(1-X(2))**2)/(4*(1-X(3)))
722 ELSEIF (IOPT.EQ.2) THEN
723 C---MAKE THREE-JET EVENTS FROM THE `DEAD-ZONE' LOOK LIKE TWO-JET EVENTS
724 IF (EMIT.EQ.0.OR.IEVT.NE.NEVHEP+NWGTS) THEN
726 ELSEIF (EMIT.EQ.1) THEN
727 IHEP=JDAHEP(1,JDAHEP(1,ICMF)+1)
728 JHEP=JDAHEP(1,JDAHEP(1,ICMF))
730 IHEP=JDAHEP(1,JDAHEP(2,ICMF))
731 JHEP=JDAHEP(1,JDAHEP(1,ICMF)+1)
732 JDAHEP(1,JDAHEP(2,ICMF))=JHEP
733 IDHW(JHEP)=IDHW(IHEP)
734 IF (ISTHEP(IHEP+1).EQ.100 .AND. ISTHEP(JHEP+1).EQ.100)
735 & CALL HWVEQU(5,PHEP(1,IHEP+1),PHEP(1,JHEP+1))
737 JMOHEP(2,JDAHEP(1,ICMF))=JDAHEP(2,ICMF)
738 JDAHEP(2,JDAHEP(1,ICMF))=JDAHEP(2,ICMF)
739 JMOHEP(2,JDAHEP(2,ICMF))=JDAHEP(1,ICMF)
740 JDAHEP(2,JDAHEP(2,ICMF))=JDAHEP(1,ICMF)
741 CALL HWVEQU(5,P1,PHEP(1,JDAHEP(1,ICMF)))
742 CALL HWVEQU(5,P2,PHEP(1,JDAHEP(2,ICMF)))
743 CALL HWVSUM(4,PHEP(1,IHEP),PHEP(1,JHEP),PHEP(1,JHEP))
744 CALL HWUMAS(PHEP(1,JHEP))
745 JDAHEP(2,JHEP)=JDAHEP(2,IHEP)
746 IEDT(1)=JDAHEP(1,ICMF)+1
750 IF (ISTHEP(IHEP+1).NE.100) NDEL=2
751 CALL HWUEDT(NDEL,IEDT)
753 IHEP=JDAHEP(1,JDAHEP(I,ICMF))
754 JMOHEP(1,IHEP)=JDAHEP(I,ICMF)
755 IF (ISTHEP(IHEP+1).EQ.100) THEN
756 JMOHEP(1,IHEP+1)=JMOHEP(1,IHEP)
757 JMOHEP(2,IHEP+1)=JMOHEP(2,JMOHEP(1,IHEP))
759 DO 400 JHEP=JDAHEP(1,IHEP),JDAHEP(2,IHEP)
762 CALL HWVZRO(4,VHEP(1,JDAHEP(I,ICMF)))
763 CALL HWVZRO(4,VHEP(1,IHEP))
764 IF (ISTHEP(IHEP+1).EQ.100) CALL HWVZRO(4,VHEP(1,IHEP+1))
769 CALL HWWARN('HWBDED',500)
773 *CMZ :- -17/05/94 09.33.08 by Mike Seymour
774 *-- Author : Mike Seymour
775 C-----------------------------------------------------------------------
776 SUBROUTINE HWBDIS(IOPT)
777 C-----------------------------------------------------------------------
778 C FILL MISSING AREA OF DIS PHASE-SPACE WITH 2+1-JET EVENTS
779 C IF (IOPT.EQ.1) SET UP EVENT RECORD
780 C IF (IOPT.EQ.2) CLEAN UP EVENT RECORD AFTER SHOWERING
781 C-----------------------------------------------------------------------
782 INCLUDE 'herwig65.inc'
783 DOUBLE PRECISION HWRGEN,HWBVMC,HWUALF,HWULDO,P1(5),P2(5),P3(5),
784 & PCMF(5),L(5),R(3,3),Q,XBJ,RN,XPMIN,XPMAX,XP,ZPMIN,ZPMAX,ZP,FAC,
785 & X1,X2,XTSQ,XT,PTSQ,SIN1,SIN2,W1,W2,CFAC,PDFOLD(13),PDFNEW(13),
786 & PHI,SCALE,Q1(5),Q2(5),DIR1,DIR2,DIR,PM(5),POLD,PNEW,COMINT,
787 & BGFINT,COMWGT,C1,C2,CM,B1,B2,BM,PVRT(4)
788 INTEGER IOPT,EMIT,ICMF,IHEP,JHEP,IIN,IOUT,ILEP,IHAD,ID,IDNEW,
789 & IEDT(3),NDEL,NTRY,ITEMP
791 EXTERNAL HWRGEN,HWBVMC,HWUALF,HWULDO
792 SAVE BGF,IIN,IOUT,ICMF,ID,Q1,Q2,XP,XBJ
793 SAVE EMIT,COMINT,BGFINT,COMWGT,C1,C2,CM,B1,B2,BM
794 DATA EMIT,COMINT,BGFINT,COMWGT/0D0,3.9827D0,1.2462D0,0.3D0/
795 DATA C1,C2,CM,B1,B2,BM/0.56D0,0.20D0,10D0,0.667D0,0.167D0,3D0/
796 IF (IERROR.NE.0) RETURN
798 C---FIND AN UNTREATED CMF
799 IF (EMIT.EQ.NEVHEP+NWGTS) RETURN
802 10 IF (ICMF.EQ.0 .AND. ISTHEP(IHEP).EQ.110 .AND.
803 & JDAHEP(2,IHEP).EQ.JDAHEP(1,IHEP)+1) ICMF=IHEP
804 IF (ICMF.EQ.0) RETURN
808 CALL HWVEQU(5,PHEP(1,IIN),P1)
809 CALL HWVEQU(5,PHEP(1,IOUT),P2)
810 CALL HWVEQU(5,PHEP(1,ILEP),L)
812 IF (JDAHEP(1,IHAD).NE.0) IHAD=JDAHEP(1,IHAD)
814 C---STORE OLD MOMENTA
817 C---BOOST AND ROTATE THE MOMENTA TO THE BREIT FRAME
818 CALL HWVDIF(4,P2,P1,PCMF)
820 CALL HWVEQU(5,PHEP(1,IHAD),PM)
822 XBJ=HALF*Q**2/HWULDO(PM,PCMF)
823 CALL HWVSCA(4,HALF/XBJ,PCMF,PCMF)
824 CALL HWVSUM(4,PM,PCMF,PCMF)
826 CALL HWULOF(PCMF,L,L)
827 CALL HWULOF(PCMF,PM,PM)
828 CALL HWUROT(PM,ONE,ZERO,R)
831 CALL HWUROT(PM,COS(PHI),SIN(PHI),R)
832 C---CHOOSE THE HADRONIC-PLANE CONFIGURATION, XP,ZP
833 IF (HWRGEN(0).LT.COMWGT) THEN
834 C-----CONSIDER GENERATING A QCD COMPTON EVENT
842 FAC=1/C1*2*XPMAX/((1-XP)*(1-ZP))*
843 $ (1+(1-XP-ZP+2*XP*ZP)**2+2*(1-XP)*(1-ZP)*XP*ZP)
844 IF (HWRGEN(4).LT.HALF) THEN
849 ELSEIF (RN.LT.C1+C2) THEN
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 ZP=1-((1-ZPMIN)/(1-ZPMAX))**HWRGEN(4)*(1-ZPMAX)
857 FAC=1/C2*XPMAX*LOG((1-ZPMIN)/(1-ZPMAX))/(1-XP)*
858 $ (1+(1-XP-ZP+2*XP*ZP)**2+2*(1-XP)*(1-ZP)*XP*ZP)
863 XPMAX=(1+4*ZP*(1-ZP))/(1+6*ZP*(1-ZP))
864 XP=1-((1-XPMIN)/(1-XPMAX))**HWRGEN(4)*(1-XPMAX)
865 FAC=1/(1-C1-C2)*ZPMAX*LOG((1-XPMIN)/(1-XPMAX))/(1-ZP)*
866 $ (1+(1-XP-ZP+2*XP*ZP)**2+2*(1-XP)*(1-ZP)*XP*ZP)
868 XPMAX=(1+4*ZP*(1-ZP))/(1+6*ZP*(1-ZP))
869 ZPMAX=1-2./3.*XP*(1+DREAL( DCMPLX(10-45*XP+18*XP**2,3*SQRT(
870 $ 3*(9+66*XP-93*XP**2+12*XP**3-8*XP**4+24*XP**5-8*XP**6)))
871 $ **(1./3.) * DCMPLX(0.5D0,0.86602540378444D0) ))
872 IF (XP.GT.XPMAX.OR.ZP.GT.ZPMAX.OR.CM*HWRGEN(4).GT.FAC)
875 C-----CONSIDER GENERATING A BGF EVENT
884 FAC=1/B1*2*XPMAX/(1-ZP)*
885 $ (( XP+ZP-2*XP*ZP)**2+2*(1-XP)*(1-ZP)*XP*ZP
886 $ +(1-XP-ZP+2*XP*ZP)**2+2*(1-XP)*(1-ZP)*XP*ZP)
887 IF (HWRGEN(4).LT.HALF) XP=1-XP
888 ELSEIF (RN.LT.B1+B2) THEN
892 ZPMAX=1-2./3.*XP*(1+DREAL( DCMPLX(10-45*XP+18*XP**2,3*SQRT(
893 $ 3*(9+66*XP-93*XP**2+12*XP**3-8*XP**4+24*XP**5-8*XP**6)))
894 $ **(1./3.) * DCMPLX(0.5D0,0.86602540378444D0) ))
895 ZP=1-((1-ZPMIN)/(1-ZPMAX))**HWRGEN(4)*(1-ZPMAX)
896 FAC=1/B2*XPMAX*LOG((1-ZPMIN)/(1-ZPMAX))*
897 $ (( XP+ZP-2*XP*ZP)**2+2*(1-XP)*(1-ZP)*XP*ZP
898 $ +(1-XP-ZP+2*XP*ZP)**2+2*(1-XP)*(1-ZP)*XP*ZP)
903 ZPMIN=2./3.*XP*(1+DREAL( DCMPLX(10-45*XP+18*XP**2,3*SQRT(
904 $ 3*(9+66*XP-93*XP**2+12*XP**3-8*XP**4+24*XP**5-8*XP**6)))
905 $ **(1./3.) * DCMPLX(0.5D0,0.86602540378444D0) ))
906 ZP=(ZPMAX-ZPMIN)*HWRGEN(4)+ZPMIN
907 FAC=1/(1-B1-B2)*XPMAX*(ZPMAX-ZPMIN)/(1-ZP)*
908 $ (( XP+ZP-2*XP*ZP)**2+2*(1-XP)*(1-ZP)*XP*ZP
909 $ +(1-XP-ZP+2*XP*ZP)**2+2*(1-XP)*(1-ZP)*XP*ZP)
911 ZPMAX=1-2./3.*XP*(1+DREAL( DCMPLX(10-45*XP+18*XP**2,3*SQRT(
912 $ 3*(9+66*XP-93*XP**2+12*XP**3-8*XP**4+24*XP**5-8*XP**6)))
913 $ **(1./3.) * DCMPLX(0.5D0,0.86602540378444D0) ))
914 IF (ZP.GT.ZPMAX.OR.ZP.LT.ONE-ZPMAX.OR.BM*HWRGEN(4).GT.FAC)
917 C---CALCULATE THE ADDITIONAL FACTORS IN THE WEIGHT
921 FAC=BGFINT/(1-COMWGT)
927 SCALE=Q*SQRT((1-XP)*(1-ZP)*ZP/XP+1)
930 CALL HWSFUN(XBJ,Q,IDHW(IHAD),NSTRU,PDFOLD,2)
932 IF (PDFOLD(ID).LE.ZERO) THEN
933 CALL HWWARN('HWBDIS',100)
937 CALL HWSFUN(XBJ/XP,SCALE,IDHW(IHAD),NSTRU,PDFNEW,2)
938 FAC=CFAC/(2*PIFAC) * HWUALF(1,SCALE) * FAC *
939 $ PDFNEW(IDNEW)/PDFOLD(ID)
943 C---FOR PHOTON BEAMS, INCLUDE DIRECT PHOTON COUPLING
944 IF (IDHW(IHAD).EQ.59) THEN
945 ZPMIN=2./3.*XBJ*(1+DREAL( DCMPLX(10-45*XBJ+18*XBJ**2,3*SQRT(
946 $ 3*(9+66*XBJ-93*XBJ**2+12*XBJ**3-8*XBJ**4+24*XBJ**5
947 $ -8*XBJ**6)))**(1./3.)*DCMPLX(0.5D0,0.86602540378444D0) ))
949 DIR1=(XBJ**2+(1-XBJ)**2)*(LOG(ZPMAX/ZPMIN)-(ZPMAX-ZPMIN))
950 DIR2=4*XBJ*(1-XBJ)*(ZPMAX-ZPMIN)
951 DIR=QFCH(MOD(ID-1,6)+1)**2*ALPHEM/(2*PIFAC*PDFOLD(ID))*XBJ
956 C---DECIDE WHETHER TO MAKE AN EVENT HERE
957 IF (HWRGEN(4).GT.FAC+DIR) RETURN
958 C---FOR DIRECT COUPLING, CHOOSE ZP VALUE
959 IF ((FAC+DIR)*HWRGEN(8).GT.FAC) THEN
960 IF ((DIR1+DIR2)*HWRGEN(9).LT.DIR1) THEN
963 ZP=1-(ZPMAX/ZPMIN)**HWRGEN(NTRY+1)*ZPMIN
964 IF ((ZPMIN**2+(1-ZPMIN)**2)*HWRGEN(NTRY).GT.ZP**2+(1-ZP)**2)
967 ZP=SQRT((ZPMAX-ZPMIN)*HWRGEN(10)+ZPMIN**2)
976 XTSQ=4*(1-XP)*(1-ZP)*ZP/XP
978 SIN1=XT/SQRT(X1**2+XTSQ)
979 SIN2=XT/SQRT(X2**2+XTSQ)
980 C---CHOOSE THE AZIMUTH BETWEEN THE TWO PLANES
982 W1=XP**2*(X1**2+1.5*XTSQ)
986 W2=XP**2*(X2**2+1.5*XTSQ)
987 IF (HWRGEN(5)*(W1+W2).GT.W2) THEN
989 C-----WEIGHTED BY (1+SIN1*COS(PHI))**2
990 200 PHI=(2*HWRGEN(6)-1)*PIFAC
991 IF (HWRGEN(7)*(1+SIN1)**2.GT.(1+SIN1*COS(PHI))**2) GOTO 200
994 PHI=(2*HWRGEN(6)-1)*PIFAC
997 C-----WEIGHTED BY (1-SIN2*COS(PHI))**2
998 210 PHI=(2*HWRGEN(6)-1)*PIFAC
999 IF (HWRGEN(7)*(1+SIN2)**2.GT.(1-SIN2*COS(PHI))**2) GOTO 210
1001 C---RECONSTRUCT MOMENTA AND BOOST BACK TO LAB
1005 P1(4)=SQRT(P1(3)**2+P1(5)**2)
1006 PTSQ=((ZP*Q*(P1(4)+P1(3)-Q)-P2(5)**2)*(P1(4)-P1(3)+(1-ZP)*Q)
1007 $ -P3(5)**2*ZP*Q)/(P1(4)-P1(3)+Q)
1008 C---CHECK INFRARED CUTOFF FOR THIS PARTON TYPE
1009 IF (PTSQ.LT.MAX(HWBVMC(ID),HWBVMC(IDHW(IOUT)))**2) RETURN
1010 P2(1)=SQRT(PTSQ)*COS(PHI)
1011 P2(2)=SQRT(PTSQ)*SIN(PHI)
1012 P2(3)=-0.5*(ZP*Q-(PTSQ+P2(5)**2)/(ZP*Q))
1013 P2(4)= 0.5*(ZP*Q+(PTSQ+P2(5)**2)/(ZP*Q))
1018 CALL HWUROB(R,P1,P1)
1019 CALL HWUROB(R,P2,P2)
1020 CALL HWUROB(R,P3,P3)
1021 CALL HWULOB(PCMF,P1,P1)
1022 CALL HWULOB(PCMF,P2,P2)
1023 CALL HWULOB(PCMF,P3,P3)
1024 C---SPECIAL CASE FOR DIRECT PHOTON - COPY THE EXACT BEAM MOMENTUM
1025 C---SHARE THE MISMATCH EQUALLY BETWEEN THE OUTGOING PARTONS
1026 C---AND PUT THEM BACK ON SHELL
1028 CALL HWVDIF(4,PHEP(1,IHAD),P1,PM)
1029 CALL HWVSCA(4,HALF,PM,PM)
1030 CALL HWVSUM(4,PM,P2,P2)
1031 CALL HWVSUM(4,PM,P3,P3)
1034 CALL HWVEQU(5,PHEP(1,IHAD),P1)
1035 CALL HWVSUM(4,P2,P3,PCMF)
1037 POLD=HWULDO(P2,PCMF)**2/PCMF(5)**2-SIGN(P2(5)**2,P2(5))
1038 PNEW=PCMF(5)**2/4-RMASS(ID)**2
1039 IF (PCMF(5).LE.ZERO.OR.POLD.LE.ZERO.OR.PNEW.LE.ZERO) RETURN
1040 CALL HWVSCA(4,SQRT(PNEW/POLD),P2,P2)
1041 CALL HWVSCA(4,HALF-HWULDO(P2,PCMF)/PCMF(5)**2,PCMF,PM)
1042 CALL HWVSUM(4,PM,P2,P2)
1044 CALL HWVDIF(4,PCMF,P2,P3)
1048 CALL HWVEQU(5,P1,PHEP(1,IIN))
1049 IF (BGF.AND.ID.GT.6.OR..NOT.BGF.AND.ID.LT.7) THEN
1050 CALL HWVEQU(5,P2,PHEP(1,IOUT))
1051 CALL HWVEQU(5,P3,PHEP(1,NHEP))
1053 CALL HWVEQU(5,P3,PHEP(1,IOUT))
1054 CALL HWVEQU(5,P2,PHEP(1,NHEP))
1056 CALL HWVSUM(4,PHEP(1,ILEP),PHEP(1,IIN),PHEP(1,ICMF))
1057 CALL HWUMAS(PHEP(1,ICMF))
1058 C Decide which quark radiated and assign production vertices
1060 C Boson-Gluon fusion case
1061 IF (1-ZP.LT.HWRGEN(0)) THEN
1062 C Gluon splitting to quark
1063 CALL HWVZRO(4,VHEP(1,NHEP-1))
1064 CALL HWVDIF(4,PHEP(1,NHEP-4),PHEP(1,NHEP),PVRT)
1065 CALL HWUDKL(ID,PVRT,VHEP(1,NHEP))
1066 CALL HWVEQU(4,VHEP(1,NHEP),VHEP(1,NHEP-4))
1068 C Gluon splitting to antiquark
1069 CALL HWVZRO(4,VHEP(1,NHEP))
1070 CALL HWVDIF(4,PHEP(1,NHEP-4),PHEP(1,NHEP-1),PVRT)
1071 CALL HWUDKL(ID,PVRT,VHEP(1,NHEP-1))
1072 CALL HWVEQU(4,VHEP(1,NHEP-1),VHEP(1,NHEP-4))
1076 IF (1.LT.HWRGEN(0)*(1+(1-XP-ZP)**2+6*XP*(1-XP)*ZP*(1-ZP)))THEN
1077 C Incoming quark radiated the gluon
1078 CALL HWVZRO(4,VHEP(1,NHEP-1))
1079 CALL HWVDIF(4,PHEP(1,NHEP-4),PHEP(1,NHEP),PVRT)
1080 CALL HWUDKL(ID,PVRT,VHEP(1,NHEP))
1081 CALL HWVEQU(4,VHEP(1,NHEP),VHEP(1,NHEP-4))
1083 C Outgoing quark radiated the gluon
1084 CALL HWVZRO(4,VHEP(1,NHEP-4))
1085 CALL HWVSUM(4,PHEP(1,NHEP-1),PHEP(1,NHEP),PVRT)
1086 CALL HWUDKL(ID,PVRT,VHEP(1,NHEP))
1087 CALL HWVEQU(4,VHEP(1,NHEP),VHEP(1,NHEP-1))
1090 C---STATUS, ID AND POINTERS
1095 IDHEP(IIN)=IDPDG(59)
1098 IDHEP(IIN)=IDPDG(13)
1101 IDHW(NHEP)=IDHW(IOUT)
1102 IDHEP(NHEP)=IDHEP(IOUT)
1103 IDHW(IOUT)=MOD(ID,6)+6
1104 IDHEP(IOUT)=IDPDG(IDHW(IOUT))
1106 IDHW(NHEP)=MOD(ID,6)
1107 IDHEP(NHEP)=IDPDG(IDHW(NHEP))
1109 ELSEIF (ID.LT.7) THEN
1111 IDHEP(NHEP)=IDPDG(13)
1113 IDHW(NHEP)=IDHW(IOUT)
1114 IDHEP(NHEP)=IDHEP(IOUT)
1116 IDHEP(IOUT)=IDPDG(13)
1120 C---COLOUR CONNECTIONS
1134 C---FACTORISATION SCALE
1137 ELSEIF (IOPT.EQ.2) THEN
1138 C---MAKE TWO-JET EVENTS LOOK LIKE ONE-JET EVENTS
1139 IF (EMIT.NE.NEVHEP+NWGTS .OR. XP.EQ.XBJ) RETURN
1141 CALL HWVEQU(5,Q1,PHEP(1,IIN))
1142 CALL HWVEQU(5,Q2,PHEP(1,IOUT))
1149 JHEP=JDAHEP(1,IOUT+1)
1150 CALL HWVSUM(4,PHEP(1,IHEP),PHEP(1,JHEP),PHEP(1,IHEP))
1151 CALL HWUMAS(PHEP(1,IHEP))
1152 JDAHEP(2,IHEP)=JDAHEP(2,JHEP)
1157 IF (ISTHEP(JHEP+1).NE.100) NDEL=2
1160 IF (ISTHEP(IHEP+1).EQ.100) THEN
1161 JMOHEP(1,IHEP+1)=IOUT
1162 JMOHEP(2,IHEP+1)=IIN
1164 DO 300 JHEP=JDAHEP(1,IHEP),JDAHEP(2,IHEP)
1167 IF (IDHW(IOUT).EQ.13) IDHW(IOUT)=IDHW(IOUT+1)
1168 IDHEP(IOUT)=IDPDG(IDHW(IOUT))
1169 IDHW(IHEP)=IDHW(IOUT)
1170 CALL HWUEDT(NDEL,IEDT)
1171 ELSEIF (ID.LT.7) THEN
1172 CALL HWVEQU(5,Q1,PHEP(1,IIN))
1173 CALL HWVEQU(5,Q2,PHEP(1,IOUT+1))
1174 JMOHEP(2,IIN)=IOUT+1
1175 JDAHEP(2,IIN)=IOUT+1
1176 JMOHEP(2,IOUT+1)=IIN
1177 JDAHEP(2,IOUT+1)=IIN
1178 JDAHEP(2,ICMF)=IOUT+1
1181 CALL HWVDIF(4,PHEP(1,IHEP),PHEP(1,JHEP),PHEP(1,IHEP))
1182 CALL HWUMAS(PHEP(1,IHEP))
1183 CALL HWVDIF(4,PHEP(1,ICMF),PHEP(1,JHEP),PHEP(1,ICMF))
1184 CALL HWUMAS(PHEP(1,ICMF))
1185 CALL HWUEMV(JDAHEP(2,JHEP)-JDAHEP(1,JHEP)+1,
1186 $ JDAHEP(1,JHEP),JDAHEP(2,IHEP))
1188 JDAHEP(2,IHEP)=JDAHEP(2,JHEP)
1193 IF (ISTHEP(JHEP+1).NE.100) NDEL=2
1194 CALL HWUEDT(NDEL,IEDT)
1196 DO 400 JHEP=JDAHEP(1,IHEP),JDAHEP(2,IHEP)
1200 IDHEP(IIN)=IDPDG(ID)
1203 CALL HWVEQU(5,Q1,PHEP(1,IIN))
1204 CALL HWVEQU(5,Q2,PHEP(1,IOUT))
1211 JHEP=JDAHEP(1,IOUT+1)
1212 CALL HWVDIF(4,PHEP(1,IHEP),PHEP(1,JHEP),PHEP(1,IHEP))
1213 CALL HWUMAS(PHEP(1,IHEP))
1214 CALL HWVDIF(4,PHEP(1,ICMF),PHEP(1,JHEP),PHEP(1,ICMF))
1215 CALL HWUMAS(PHEP(1,ICMF))
1216 CALL HWUEMV(JDAHEP(2,JHEP)-JDAHEP(1,JHEP)+1,
1217 $ JDAHEP(1,JHEP),JDAHEP(1,IHEP)-1)
1218 JHEP=JDAHEP(1,IOUT+1)
1219 JDAHEP(1,IHEP)=JDAHEP(1,JHEP)
1224 IF (ISTHEP(JHEP+1).NE.100.OR.JHEP.EQ.NHEP) NDEL=2
1225 CALL HWUEDT(NDEL,IEDT)
1227 DO 500 JHEP=JDAHEP(1,IHEP),JDAHEP(2,IHEP)
1231 IDHEP(IIN)=IDPDG(ID)
1234 CALL HWVZRO(4,VHEP(1,IIN))
1235 CALL HWVZRO(4,VHEP(1,JDAHEP(1,IIN)))
1236 IF (ISTHEP(JDAHEP(1,IIN)+1).EQ.100)
1237 $ CALL HWVZRO(4,VHEP(1,JDAHEP(1,IIN)+1))
1238 CALL HWVZRO(4,VHEP(1,IOUT))
1239 CALL HWVZRO(4,VHEP(1,JDAHEP(1,IOUT)))
1240 IF (ISTHEP(JDAHEP(1,IOUT)+1).EQ.100)
1241 $ CALL HWVZRO(4,VHEP(1,JDAHEP(1,IOUT)+1))
1244 CALL HWWARN('HWBDIS',500)
1249 *CMZ :- -26/10/99 17.46.56 by Mike Seymour
1250 *-- Author : Gennaro Corcella
1251 C-----------------------------------------------------------------------
1252 SUBROUTINE HWBDYP(IOPT)
1253 C MATRIX ELEMENT CORRECTIONS TO DRELL-YAN PROCESSES
1254 C-----------------------------------------------------------------------
1255 INCLUDE 'herwig65.inc'
1256 DOUBLE PRECISION HWBVMC,HWRGEN,HWUALF,HWUSQR,PMODK,AZ,CZ,
1257 & T,U,S,EM,TMIN,TMAX,PMOD2,GLUFAC,SMIN,SMAX,SZ,TEST,
1258 & JAC,M(3),W1,W,PMOD3,SCAPR,CPHI,SPHI,SCALE,XI1,XI2,
1259 & PDFOLD1(13),PDFOLD2(13),PDFNEW1(13),PDFNEW2(13),ETA1,ETA2,Y,
1260 & COMWGT1,COMWGT2,WW,COS3,MODP,RN,BETA1,SIN3,R3(3,3),CTH,STH,M1,
1261 & M2,M3,GAMMA1,R5(3,3),CW,SW,R4(3,3),SCALE1,X1,X2,X3,MM,
1262 & PHAD1(5),PHAD2(5),P1(5),P2(5),P3(5),P4(5),PF(5),PV(5),PK(5),
1263 & PR(5),PNE(5),PE(5),PP1(5),PP2(5),PZ(5),PS(5),PD(5),P2N(5),
1264 & PBOS(5),PLAB(5),PTOT(5),P3N(5),SVNTN
1266 INTEGER EMIT,NOEMIT,IHEP,JHEP,KHEP,ICMF,IOPT,CHEP,
1267 & ID2,ID1,K,ID4,ID5,IDBOS,IHAD1,IHAD2,NTMP
1268 EXTERNAL HWBVMC,HWRGEN,HWUALF,HWUSQR
1269 SAVE PS,PF,ICMF,ID4,ID5
1275 C-----CHOOSE WEIGHTS
1278 C---FIND AN UNTREATED CMF
1281 10 IF (ICMF.EQ.0 .AND. ISTHEP(IHEP).EQ.110.AND.
1282 & JDAHEP(2,IHEP).EQ.JDAHEP(1,IHEP)+1) ICMF=IHEP
1283 IF (ICMF.EQ.0) RETURN
1285 C-----SET THE VECTOR BOSON RAPIDITY
1286 Y=HALF*LOG((PHEP(4,ICMF)+PHEP(3,ICMF))/
1287 & (PHEP(4,ICMF)-PHEP(3,ICMF)))
1288 C------SET PARTICLE IDENTIES
1289 c------ID1=QUARK, ID2=ANTIQUARK, IDBOS=VECTOR BOSON, ID4-5 BOSON DECAY
1291 ID1=IDHW(JMOHEP(1,ICMF))
1292 ID2=IDHW(JMOHEP(2,ICMF))
1293 ID4=IDHW(JDAHEP(1,ICMF))
1294 ID5=IDHW(JDAHEP(2,ICMF))
1298 C---STORE OLD MOMENTA
1299 C------VECTOR BOSON MOMENTUM
1300 CALL HWVEQU(5,PHEP(1,ICMF),PBOS)
1302 CALL HWVEQU(5,PHEP(1,JMOHEP(1,ICMF)),P1)
1303 C------ANTIQUARK MOMENTUM
1304 CALL HWVEQU(5,PHEP(1,JMOHEP(2,ICMF)),P2)
1305 C-------VECTOR DECAY (LEPTON) PRODUCT MOMENTA
1306 CALL HWVEQU(5,PHEP(1,JDAHEP(1,ICMF)),P3)
1307 CALL HWVEQU(5,PHEP(1,JDAHEP(2,ICMF)),P4)
1308 C------LEPTON MOMENTA IN THE BOSON REST FRAME
1309 CALL HWULOF(PHEP(1,ICMF),P2,P2N)
1310 CALL HWULOF(PHEP(1,ICMF),P3,P3N)
1311 C------AZ=AZIMUTHAL ANGLE OF P3N
1312 AZ=ATAN2(P3N(2),P3N(1))
1315 C------PHI=ANGLE BETWEEN P2N AND P3N
1316 SCAPR=P2N(1)*P3N(1)+P2N(2)*P3N(2)+P2N(3)*P3N(3)
1317 PMOD2=SQRT(P2N(1)**2+P2N(2)**2+P2N(3)**2)
1318 PMOD3=SQRT(P3N(1)**2+P3N(2)**2+P3N(3)**2)
1319 CPHI=SCAPR/(PMOD3*PMOD2)
1320 SPHI=SQRT(1-CPHI**2)
1321 C------HADRON MOMENTA
1324 IF (JDAHEP(1,IHAD1).NE.0) IHAD1=JDAHEP(1,IHAD1)
1325 IF (JDAHEP(1,IHAD2).NE.0) IHAD2=JDAHEP(1,IHAD2)
1326 CALL HWVEQU(5,PHEP(1,IHAD1),PHAD1)
1327 CALL HWVEQU(5,PHEP(1,IHAD2),PHAD2)
1328 CALL HWVSUM(4,PHAD1,PHAD2,PTOT)
1330 C------ Q - QBAR ENERGY FRACTIONS (BORN PROCESS)
1331 c---minorimprovement---mhs---4/8/04---include mass effects correctly
1332 ETA1=(P1(4)+P1(3))/(PHAD1(4)+PHAD1(3))
1333 ETA2=(P2(4)-P2(3))/(PHAD2(4)-PHAD2(3))
1334 C------ PDFs FOR THE BORN PROCESS
1335 CALL HWSFUN(ETA1,EM,IDHW(IHAD1),NSTRU,PDFOLD1,1)
1336 CALL HWSFUN(ETA2,EM,IDHW(IHAD2),NSTRU,PDFOLD2,2)
1337 C-------CONSIDER Q(QBAR) IN THE INITIAL STATE
1339 IF (RN.LT.COMWGT1) THEN
1340 C-------NO GLUON IN THE INITIAL STATE
1342 C---CHOOSE S ACCORDING TO 1/S**2
1344 SMIN=HALF*EM**2*(7-SQRT(SVNTN))
1346 IF (SMAX.LE.SMIN) RETURN
1347 S=SMIN*SMAX/(SMIN+HWRGEN(0)*(SMAX-SMIN))
1348 JAC=S**2*(1/SMIN-1/SMAX)
1349 C---CHOOSE T ACCORDING TO (S-EM**2)/(T*U)=1/T+1/U
1350 TMAX=-HALF*EM**2*(3-HWUSQR(1+8*EM**2/S))
1352 IF (TMAX.LE.TMIN) RETURN
1353 T=TMAX*(TMIN/TMAX)**HWRGEN(1)
1354 IF (HWRGEN(2).GT.HALF) T=EM**2-S-T
1356 JAC=JAC*2*T*U/(S-EM**2)*LOG(TMIN/TMAX)
1358 SCALE1=SQRT(U*T/S+EM**2)
1360 IF (SCALE1.GT.HWBVMC(13)) GLUFAC=HWUALF(1,SCALE1)/(2*PIFAC)
1361 C----Q-QBAR ENERGY FRACTIONS FOR Q QBAR-> VG
1362 XI1=(HALF/PHAD1(4))*EXP(Y)*SQRT(S*(S+T)/(S+U))
1363 XI2=S/(4*XI1*PHAD1(4)*PHAD2(4))
1364 c---minorimprovement---mhs---4/8/04---apply infrared cutoff for large x
1365 IF ((1-XI1)*SCALE.LT.HWBVMC(ID1)) RETURN
1366 IF ((1-XI2)*SCALE.LT.HWBVMC(ID2)) RETURN
1367 C-----PDFs WITH AN EMITTED GLUON
1368 CALL HWSFUN(XI1,SCALE,IDHW(IHAD1),NSTRU,PDFNEW1,1)
1369 CALL HWSFUN(XI2,SCALE,IDHW(IHAD2),NSTRU,PDFNEW2,2)
1370 C------CALCULATE WEIGHT
1371 W=JAC*((EM**2-T)**2+(EM**2-U)**2)/(S**2*T*U)
1372 W1=(GLUFAC/COMWGT1)*W*PDFNEW1(ID1)*PDFNEW2(ID2)/(PDFOLD1(ID1)*
1373 & PDFOLD2(ID2))*(CFFAC*ETA1*ETA2/(XI1*XI2))
1374 C-------CHOOSE WHICH PARTON WILL EMIT
1376 IF (HWRGEN(6).LT.(EM**2-U)**2/((EM**2-U)**2+(EM**2-T)**2))
1380 C--------GLUON IN THE INITIAL STATE
1382 C---CHOOSE S ACCORDING TO 1/S**2
1385 IF (SMAX.LE.SMIN) RETURN
1386 S=SMIN*SMAX/(SMIN+HWRGEN(0)*(SMAX-SMIN))
1387 JAC=S**2*(1/SMIN-1/SMAX)
1388 C---CHOOSE T ACCORDING TO 1/T
1389 TMAX=-HALF*EM**2*(3-HWUSQR(1+8*EM**2/S))
1391 IF (TMAX.LE.TMIN) RETURN
1392 T=TMAX*(TMIN/TMAX)**HWRGEN(1)
1393 JAC=JAC*T*LOG(TMAX/TMIN)
1396 SCALE1=SQRT(U*T/S+EM**2)
1398 IF (SCALE1.GT.HWBVMC(13)) GLUFAC=HWUALF(1,SCALE1)/(2*PIFAC)
1399 C--------INITIAL STATE GLUON COMING FROM HADRON 1
1400 IF (RN.LE.COMWGT2) THEN
1402 C--------ENERGY FRACTIONS and PDFs
1403 c---bug fix---mhs---4/8/04---swap u and t in mtm frac definitions
1404 XI1=(HALF/PHAD1(4))*EXP(Y)*SQRT(S*(S+T)/(S+U))
1405 XI2=S/(4*XI1*PHAD1(4)*PHAD2(4))
1406 c---minorimprovement---mhs---4/8/04---apply infrared cutoff for large x
1407 IF ((1-XI1)*SCALE.LT.HWBVMC(13)) RETURN
1408 IF ((1-XI2)*SCALE.LT.HWBVMC(ID2)) RETURN
1409 CALL HWSFUN(XI1,SCALE,IDHW(IHAD1),NSTRU,PDFNEW1,1)
1410 CALL HWSFUN(XI2,SCALE,IDHW(IHAD2),NSTRU,PDFNEW2,2)
1411 WW=PDFNEW1(13)*PDFNEW2(ID2)/((COMWGT2-COMWGT1)*
1412 & PDFOLD1(ID1)*PDFOLD2(ID2))
1414 C-------INITIAL STATE GLUON COMING FROM HADRON 2
1416 C-------ENERGY FRACTIONS AND PDFs
1417 c---bug fix---mhs---4/8/04---swap u and t in mtm frac definitions
1418 XI1=(HALF/PHAD1(4))*EXP(Y)*SQRT(S*(S+U)/(S+T))
1419 XI2=S/(4*XI1*PHAD1(4)*PHAD2(4))
1420 c---minorimprovement---mhs---4/8/04---apply infrared cutoff for large x
1421 IF ((1-XI1)*SCALE.LT.HWBVMC(ID1)) RETURN
1422 IF ((1-XI2)*SCALE.LT.HWBVMC(13)) RETURN
1423 CALL HWSFUN(XI1,SCALE,IDHW(IHAD1),NSTRU,PDFNEW1,1)
1424 CALL HWSFUN(XI2,SCALE,IDHW(IHAD2),NSTRU,PDFNEW2,2)
1425 WW=PDFNEW1(ID1)*PDFNEW2(13)/((1-COMWGT2)*
1426 & PDFOLD1(ID1)*PDFOLD2(ID2))
1428 W=-HALF*JAC*((EM**2-T)**2+(EM**2-S)**2)/(S**3*T)
1429 C-------CHOOSE WHICH PARTON WILL EMIT
1430 c---bug fix---mhs---4/8/04---swap emitter and nonemitter
1432 IF (HWRGEN(10).LT.(EM**2-S)**2/((EM**2-S)**2+(EM**2-T)**2))
1435 C-------FINAL WEIGHT FOR ALL THE CONSIDERED OPTIONS
1436 W1=GLUFAC*W*WW*ETA1*ETA2/(XI1*XI2)
1438 C--------ADD ONE MORE GLUON
1439 IF (W1.GT.HWRGEN(4)) THEN
1444 C---------INCLUDE MASSES
1445 S=S+M1**2+M2**2+M3**2
1446 IF (.NOT.GLUIN) THEN
1447 TEST=((S+M1**2-M2**2)*(S+M3**2-EM**2)-2*S*(M1**2+M3**2-T))**2
1448 $ -((S-M1**2-M2**2)**2-4*M1**2*M2**2)*
1449 $ ((S-M3**2-EM**2)**2-4*M3**2*EM**2)
1451 TEST=((S+M3**2-M2**2)*(S+M1**2-EM**2)-2*S*(M3**2+M1**2-T))**2
1452 $ -((S-M3**2-M2**2)**2-4*M3**2*M2**2)*
1453 $ ((S-M1**2-EM**2)**2-4*M1**2*EM**2)
1455 TEST=((S+M3**2-M1**2)*(S+M2**2-EM**2)-2*S*(M3**2+M2**2-T))**2
1456 $ -((S-M3**2-M1**2)**2-4*M3**2*M1**2)*
1457 $ ((S-M2**2-EM**2)**2-4*M2**2*EM**2)
1466 C----MOMENTA IN THE V-REST FRAME WITH NON EMITTER ALONG THE Z AXIS
1467 C----V=BOSON,K=GLUON,E=EMITTER,NE=NON-EMITTER
1475 IF (.NOT.GLUIN) THEN
1476 PK(4)=(S-M(3)**2-EM**2)/(2*EM)
1477 PMODK=SQRT(PK(4)**2-M(3)**2)
1489 PNE(4)=(EM**2+MM**2-X1)/(2*EM)
1490 PNE(3)=X3*SQRT(PNE(4)**2-MM**2)
1491 COS3=HALF*(X2-MM**2-M(3)**2+2*PNE(4)*PK(4))/(PNE(3)*PMODK)
1493 PK(4)=(EM**2+M(3)**2-U)/(2*EM)
1494 PMODK=SQRT(PK(4)**2-M(3)**2)
1503 PNE(4)=(S-MM**2-EM**2)/(2*EM)
1504 PNE(3)=X3*SQRT(PNE(4)**2-MM**2)
1505 COS3=HALF*(T-MM**2-M(3)**2+2*PNE(4)*PK(4))/(PNE(3)*PMODK)
1514 PNE(4)=(EM**2+MM**2-T)/(2*EM)
1515 PNE(3)=X3*SQRT(PNE(4)**2-MM**2)
1516 COS3=HALF*(MM**2+M(3)**2-S+2*PNE(4)*PK(4))/(PNE(3)*PMODK)
1520 SIN3=SQRT(1-COS3**2)
1521 C---------DEFINE A RANDOM ROTATION AROUND THE Z-AXIS
1522 CALL HWRAZM(PMODK*SIN3,PK(1),PK(2))
1526 IF (.NOT.GLUIN) THEN
1527 PE(K)=PV(K)+PK(K)-PNE(K)
1530 PE(K)=PV(K)+PNE(K)-PK(K)
1532 PE(K)=PNE(K)+PK(K)-PV(K)
1537 c------LEPTON MOMENTA IN THE BOSON REST FRAME, WITH THE DIRECTION
1538 C------TAKEN FROM THE BORN PROCESS
1540 PS(4)=(EM**2+P3(5)**2-P4(5)**2)/(2*EM)
1541 PS(3)=-SQRT(PS(4)**2-P3(5)**2)*CPHI
1542 PS(2)=SQRT(PS(4)**2-P3(5)**2)*SPHI*SZ
1543 PS(1)=SQRT(PS(4)**2-P3(5)**2)*SPHI*CZ
1545 PF(4)=(EM**2+P4(5)**2-P3(5)**2)/(2*EM)
1549 C----FIND A STATIONARY VECTOR PLAB IN THE LAB FRAME
1550 IF (.NOT.GLUIN) THEN
1552 CALL HWVEQU(5,PE,PP1)
1553 CALL HWVEQU(5,PNE,PP2)
1555 CALL HWVEQU(5,PNE,PP1)
1556 CALL HWVEQU(5,PE,PP2)
1560 CALL HWVEQU(5,PK,PP1)
1562 CALL HWVEQU(5,PE,PP2)
1564 CALL HWVEQU(5,PNE,PP2)
1567 CALL HWVEQU(5,PK,PP2)
1569 CALL HWVEQU(5,PE,PP1)
1571 CALL HWVEQU(5,PNE,PP1)
1575 CALL HWVSCA(4,1/XI1,PP1,PP1)
1576 CALL HWVSCA(4,1/XI2,PP2,PP2)
1577 CALL HWVSUM(4,PP1,PP2,PLAB)
1579 C------BOOST TO PLAB REST FRAME
1580 CALL HWULOF(PLAB,PE,PE)
1581 CALL HWULOF(PLAB,PNE,PNE)
1582 CALL HWULOF(PLAB,PK,PK)
1583 CALL HWULOF(PLAB,PS,PS)
1584 CALL HWULOF(PLAB,PF,PF)
1585 CALL HWULOF(PLAB,PV,PV)
1586 C----PUT THE INITIAL PARTON BELONGING TO HADRON 1 ON THE Z-AXIS
1587 IF (.NOT.GLUIN) THEN
1589 CALL HWVEQU(5,PE,PZ)
1591 CALL HWVEQU(5,PNE,PZ)
1595 CALL HWVEQU(5,PK,PZ)
1598 CALL HWVEQU(5,PE,PZ)
1600 CALL HWVEQU(5,PNE,PZ)
1604 MODP=SQRT(PZ(1)**2+PZ(2)**2)
1607 CALL HWUROT(PZ,CTH,STH,R3)
1608 C-----ROTATE EVERYTHING BY R3
1609 CALL HWUROF(R3,PE,PE)
1610 CALL HWUROF(R3,PNE,PNE)
1611 CALL HWUROF(R3,PV,PV)
1612 CALL HWUROF(R3,PK,PK)
1613 CALL HWUROF(R3,PS,PS)
1614 CALL HWUROF(R3,PF,PF)
1615 C--REORDER ENTRIES:--IHEP=EMITTER,JHEP=NON-EMITTER,KHEP=EMITTED
1616 IF (.NOT.GLUIN) THEN
1617 IHEP=JMOHEP(EMIT,ICMF)
1618 JHEP=JMOHEP(NOEMIT,ICMF)
1622 IDHEP(CHEP)=IDPDG(15)
1625 IDHEP(ICMF)=IDPDG(IDBOS)
1626 C-----NO GLUON IN THE INITIAL STATE: JUST ADD IT AFTER THE VECTOR BOSON
1627 IF (.NOT.GLUIN) THEN
1630 C---STATUS OF EMITTER/NON EMITTER
1631 ISTHEP(IHEP)=110+EMIT
1632 ISTHEP(JHEP)=110+NOEMIT
1634 C-----GLUON COMING FROM THE 1ST HADRON
1664 C------GLUON COMING FROM THE HADRON 2
1695 IDHEP(IHEP)=IDPDG(IDHW(IHEP))
1696 IDHEP(JHEP)=IDPDG(IDHW(JHEP))
1700 IDHEP(KHEP)=IDPDG(13)
1701 C---------DEFINE MOMENTA IN THE LAB FRAME
1702 CALL HWVEQU(5,PV,PHEP(1,ICMF))
1703 CALL HWVEQU(5,PK,PHEP(1,KHEP))
1704 CALL HWVEQU(5,PNE,PHEP(1,JHEP))
1705 CALL HWVEQU(5,PE,PHEP(1,IHEP))
1706 IF (.NOT.GLUIN) THEN
1707 CALL HWVSUM(4,PHEP(1,IHEP),PHEP(1,JHEP),PHEP(1,CHEP))
1710 CALL HWVSUM(4,PHEP(1,IHEP),PHEP(1,KHEP),PHEP(1,CHEP))
1712 CALL HWVSUM(4,PHEP(1,KHEP),PHEP(1,JHEP),PHEP(1,CHEP))
1715 CALL HWUMAS(PHEP(1,CHEP))
1716 IF (.NOT.GLUIN) THEN
1743 C---COLOUR CONNECTIONS
1744 IF (.NOT.GLUIN) THEN
1745 IF (IDHW(IHEP).LT.IDHW(JHEP)) THEN
1763 IF (IDHEP(IHEP).GT.0) THEN
1779 IF (IDHEP(JHEP).GT.0) THEN
1796 EMSCA=SQRT(EM**2+PHEP(1,ICMF)**2+PHEP(2,ICMF)**2)
1797 C--------SET STATUS AND LEPTON MOMENTA AFTER THE PARTON SHOWER
1798 ELSEIF (IOPT.EQ.2) THEN
1799 IF (EMIT.EQ.0.OR.NEVHEP+NWGTS.NE.NTMP) RETURN
1800 ISTHEP(JDAHEP(1,ICMF))=195
1803 IDHEP(NHEP+1)=IDPDG(ID4)
1804 IDHEP(NHEP+2)=IDPDG(ID5)
1807 CW=PHEP(3,ICMF)/SQRT(PHEP(1,ICMF)**2+PHEP(2,ICMF)**2+
1810 CALL HWUROT(PHEP(1,ICMF),CW,SW,R4)
1811 CALL HWUROF(R4,PHEP(1,ICMF),PR)
1814 CALL HWUROF(R4,PS,PS)
1815 CALL HWUROF(R4,PF,PF)
1818 CALL HWUROT(PHEP(1,JDAHEP(1,ICMF)),CW,SW,R5)
1819 CALL HWUROF(R5,PHEP(1,JDAHEP(1,ICMF)),PD)
1820 PD(4)=PHEP(4,JDAHEP(1,ICMF))
1822 BETA1=(PR(4)*PR(3)-SQRT(PR(4)**2*PD(3)**2-PR(3)**2*PD(3)**2+
1823 & PD(3)**4))/(PD(3)**2+PR(4)**2)
1824 GAMMA1=1/SQRT(1-BETA1**2)
1825 PHEP(4,NHEP+1)=GAMMA1*PS(4)-BETA1*GAMMA1*PS(3)
1826 PHEP(3,NHEP+1)=-BETA1*GAMMA1*PS(4)+GAMMA1*PS(3)
1827 PHEP(4,NHEP+2)=GAMMA1*PF(4)-BETA1*GAMMA1*PF(3)
1828 PHEP(3,NHEP+2)=-BETA1*GAMMA1*PF(4)+GAMMA1*PF(3)
1829 PHEP(1,NHEP+1)=PS(1)
1830 PHEP(2,NHEP+1)=PS(2)
1831 PHEP(1,NHEP+2)=PF(1)
1832 PHEP(2,NHEP+2)=PF(2)
1833 CALL HWUMAS(PHEP(1,NHEP+1))
1834 CALL HWUMAS(PHEP(1,NHEP+2))
1835 CALL HWUROB(R5,PHEP(1,NHEP+1),PHEP(1,NHEP+1))
1836 CALL HWUROB(R5,PHEP(1,NHEP+2),PHEP(1,NHEP+2))
1837 JDAHEP(1,JDAHEP(1,ICMF))=NHEP+1
1838 JDAHEP(2,JDAHEP(1,ICMF))=NHEP+2
1839 JMOHEP(1,NHEP+1)=JDAHEP(1,ICMF)
1840 JMOHEP(1,NHEP+2)=JDAHEP(1,ICMF)
1841 JMOHEP(2,NHEP+1)=NHEP+2
1842 JDAHEP(2,NHEP+1)=NHEP+2
1843 JMOHEP(2,NHEP+2)=NHEP+1
1844 JDAHEP(2,NHEP+2)=NHEP+1
1845 C--special for spin correlations(relabel in spin common block)
1846 IF(SYSPIN.AND.NSPN.NE.0) THEN
1857 *CMZ :- -26/04/91 10.18.56 by Bryan Webber
1858 *-- Author : Bryan Webber
1859 C-----------------------------------------------------------------------
1860 SUBROUTINE HWBFIN(IHEP)
1861 C-----------------------------------------------------------------------
1862 C DELETES INTERNAL LINES FROM SHOWER, MAKES COLOUR CONNECTION INDEX
1863 C AND COPIES INTO /HEPEVT/ IN COLOUR ORDER.
1864 C-----------------------------------------------------------------------
1865 INCLUDE 'herwig65.inc'
1866 INTEGER IHEP,ID,IJET,KHEP,IPAR,JPAR,NXPAR,IP,JP
1867 IF (IERROR.NE.0) RETURN
1868 C---SAVE VIRTUAL PARTON DATA
1870 IF(NHEP.GT.NMXHEP) THEN
1871 CALL HWWARN('HWBFIN',100)
1876 IDHEP(NHEP)=IDPDG(ID)
1877 ISTHEP(NHEP)=ISTHEP(IHEP)+20
1879 JMOHEP(2,NHEP)=JMOHEP(1,IHEP)
1883 CALL HWVEQU(5,PPAR(1,2),PHEP(1,NHEP))
1884 CALL HWVEQU(4,VPAR(1,2),VHEP(1,NHEP))
1885 C---FINISHED FOR SPECTATOR OR NON-PARTON JETS
1886 IF (ISTHEP(NHEP).GT.136) RETURN
1887 IF (ID.GT.13.AND.ID.LT.209 .AND. ID.NE.59) RETURN
1888 IF (ID.GT.220.AND.ABS(IDPDG(ID)).LT.1000000) RETURN
1889 IF (ID.GT.424.AND.ID.NE.449) RETURN
1890 IF (.NOT.TMPAR(2).AND.ID.EQ.59) RETURN
1896 IF(NHEP.GT.NMXHEP) THEN
1897 CALL HWWARN('HWBFIN',101)
1904 JMOHEP(2,NHEP)=JCOPAR(1,1)
1907 CALL HWVEQU(5,PPAR,PHEP(1,NHEP))
1908 CALL HWVEQU(4,VPAR(1,2),VHEP(1,NHEP))
1911 C---START WITH ANTICOLOUR DAUGHTER OF HARDEST PARTON
1917 IF (JPAR.EQ.0) GOTO 15
1918 IF (JCOPAR(2,JPAR).EQ.IPAR) THEN
1926 C---COULDN'T FIND COLOUR PARTNER
1927 CALL HWWARN('HWBFIN',1)
1928 15 JPAR=JCOPAR(1,IPAR)
1930 IF(KHEP.GT.NMXHEP) THEN
1931 CALL HWWARN('HWBFIN',102)
1935 IF (TMPAR(IPAR)) THEN
1938 ELSEIF (ID.EQ.59) THEN
1940 ELSEIF (ID.LT.109) THEN
1942 ELSEIF (ID.LT.120) THEN
1944 ELSEIF (ABS(IDPDG(ID)).LT.1000000) THEN
1946 ELSEIF (ID.LT.425) THEN
1948 ELSEIF (ID.EQ.449) THEN
1954 ISTHEP(KHEP)=ISTHEP(IHEP)+24
1957 IDHEP(KHEP)=IDPDG(ID)
1958 CALL HWVEQU(5,PPAR(1,IPAR),PHEP(1,KHEP))
1959 CALL HWVEQU(4,VPAR(1,IPAR),VHEP(1,KHEP))
1961 JMOHEP(2,KHEP)=KHEP+1
1963 JDAHEP(2,KHEP)=KHEP-1
1967 JDAHEP(1,IJET)=NHEP+1
1973 *CMZ :- -14/10/99 18.04.56 by Mike Seymour
1974 *-- Author : Bryan Webber
1975 C-----------------------------------------------------------------------
1977 C-----------------------------------------------------------------------
1978 C BRANCHING GENERATOR WITH INTERFERING GLUONS
1979 C HWBGEN EVOLVES QCD JETS ACCORDING TO THE METHOD OF
1980 C G.MARCHESINI & B.R.WEBBER, NUCL. PHYS. B238(1984)1
1981 C-----------------------------------------------------------------------
1982 INCLUDE 'herwig65.inc'
1983 DOUBLE PRECISION HWULDO,HWRGAU,EINHEP,ERTXI,RTXI,XF
1984 INTEGER NTRY,LASHEP,IHEP,NRHEP,ID,IST,JHEP,KPAR,I,J,IRHEP(NMXJET),
1987 EXTERNAL HWULDO,HWRGAU
1988 IF (IERROR.NE.0) RETURN
1989 IF (IPRO.EQ.80) RETURN
1990 C---CHECK THAT EMSCA IS SET
1991 IF (EMSCA.LE.ZERO) CALL HWWARN('HWBGEN',200)
1993 C---FORCE A BRANCH INTO THE `DEAD ZONE' IN E+E-
1995 C**********13/11/00 BRW FIX TO ALLOW ALSO WW AND ZZ
1996 IF (JPR.EQ.10.OR.JPR.EQ.20.OR.JPR.EQ.25) CALL HWBDED(1)
1998 C---FORCE A BRANCH INTO THE `DEAD ZONE' IN DIS
1999 IF (IPRO.EQ.90) CALL HWBDIS(1)
2000 C---FORCE A BRANCH INTO THE `DEAD ZONE' IN DRELL-YAN PROCESSES
2001 IF (IPRO.EQ.13.OR.IPRO.EQ.14) CALL HWBDYP(1)
2002 C---FORCE A BRANCH INTO THE `DEAD ZONE' IN TOP DECAYS
2005 C---GENERATE INTRINSIC PT ONCE AND FOR ALL
2007 IF (PTRMS.NE.0.) THEN
2008 PTINT(1,JNHAD)=HWRGAU(1,ZERO,PXRMS)
2009 PTINT(2,JNHAD)=HWRGAU(2,ZERO,PXRMS)
2010 PTINT(3,JNHAD)=PTINT(1,JNHAD)**2+PTINT(2,JNHAD)**2
2012 CALL HWVZRO(3,PTINT(1,JNHAD))
2018 IF (NTRY.GT.NETRY) THEN
2019 CALL HWWARN('HWBGEN',ISLENT*100)
2025 DO 100 IHEP=1,LASHEP
2027 IF (IST.GE.111.AND.IST.LE.115) THEN
2032 IF (IST.NE.115) THEN
2033 C---FOUND A PARTON TO EVOLVE
2045 C---SET UP EVOLUTION SCALE AND FRAME
2048 IF (HWRLOG(HALF)) JHEP=JDAHEP(2,IHEP)
2049 ELSEIF (IST.GT.112) THEN
2050 IF ((ID.GT.6.AND.ID.LT.13).OR.
2051 & (ID.GT.214.AND.ID.LT.221)) JHEP=JDAHEP(2,IHEP)
2053 IF (ID.LT.7.OR.(ID.GT.208.AND.ID.LT.215)) JHEP=JDAHEP(2,IHEP)
2055 IF (JHEP.LE.0.OR.JHEP.GT.NHEP) THEN
2056 CALL HWWARN('HWBGEN',1)
2061 ERTXI=HWULDO(PHEP(1,IHEP),PHEP(1,JHEP))
2062 IF (ERTXI.LT.ZERO) ERTXI=0.
2063 IF (IST.LE.112.AND.IHEP.EQ.JHEP) ERTXI=0.
2064 IF (ISTHEP(JHEP).EQ.155) THEN
2065 ERTXI=ERTXI/PHEP(5,JHEP)
2071 IF (RTXI.EQ.ZERO) THEN
2086 IF (PPAR(4,2).LT.PHEP(5,IHEP)) PPAR(4,2)=PHEP(5,IHEP)
2088 PPAR(5,2)=PHEP(5,IHEP)
2089 CALL HWVZRO(4,VPAR(1,1))
2090 CALL HWVZRO(4,VPAR(1,2))
2091 IF (IST.GT.112) THEN
2100 IF (JDAHEP(1,JNHAD).NE.0) INHAD=JDAHEP(1,JNHAD)
2101 XFACT=XF/PHEP(4,INHAD)
2102 ANOMSC(1,JNHAD)=ZERO
2103 ANOMSC(2,JNHAD)=ZERO
2105 C---FOR QUARKS IN A COLOUR SINGLET, ALLOW SOFT MATRIX-ELEMENT CORRECTION
2107 IF (SOFTME.AND.IDHW(IHEP).LT.13.AND.
2108 $ ((JMOHEP(2,JHEP).EQ.IHEP.AND.JDAHEP(2,JHEP).EQ.IHEP).OR.
2109 $ ISTHEP(JHEP).EQ.155)) HARDST=0
2110 C---CREATE BRANCHES AND COMPUTE ENERGIES
2112 IF (TMPAR(KPAR)) THEN
2117 IF (IERROR.NE.0) RETURN
2119 IF (KPAR.EQ.NPAR) GOTO 30
2121 C---COMPUTE MASSES AND 3-MOMENTA
2124 IF (AZSPIN) CALL HWBSPN
2130 C---ENTER PARTON JET IN /HEPEVT/
2135 IF (ID.GT.120.AND.ID.LT.133 .OR. ID.GE.198.AND.ID.LE.201) THEN
2141 IDHEP(NHEP)=IDPDG(ID)
2146 CALL HWVEQU(5,PHEP(1,IHEP),PHEP(1,NHEP))
2148 ISTHEP(IHEP)=ISTHEP(IHEP)+10
2151 IF (.NOT.FROST) THEN
2156 IF (.NOT.FROST) THEN
2157 C---ATTACH SPECTATORS
2162 C---BAD JET: RESTORE PARTONS AND RE-EVOLVE
2164 120 ISTHEP(IRHEP(I))=IRST(I)
2172 C---CLEAN UP IF THERE WAS A BRANCH IN THE `DEAD ZONE' IN E+E-
2173 IF (IPROC/10.EQ.10) CALL HWBDED(2)
2174 C---CLEAN UP IF THERE WAS A BRANCH IN THE `DEAD ZONE' IN DIS
2175 IF (IPRO.EQ.90) CALL HWBDIS(2)
2176 C---CLEAN UP IF THERE WAS A BRANCH IN THE `DEAD ZONE' IN DRELL-YAN PROC
2177 IF (IPRO.EQ.13.OR.IPRO.EQ.14) CALL HWBDYP(2)
2179 C---IF THE CLEAN-UP OPERATION ADDED ANY PARTONS TO THE EVENT RECORD
2180 C IT MIGHT NEED RESHOWERING
2181 IF (NHEP.GT.LASHEP) THEN
2188 *CMZ :- -16/07/02 09.40.25 by Peter Richardson
2189 *-- Author : Peter Richardson
2190 C----------------------------------------------------------------------
2191 SUBROUTINE HWBGUP(ISTART,ICMF)
2192 C----------------------------------------------------------------------
2193 C Makes the colour connections and performs the parton shower
2194 C for events read in from the GUPI (Generic User Process Interface)
2195 C event common block
2196 C----------------------------------------------------------------------
2197 INCLUDE 'herwig65.inc'
2199 PARAMETER (MAXNUP=500)
2200 INTEGER NUP,IDPRUP,IDUP,ISTUP,MOTHUP,ICOLUP
2201 DOUBLE PRECISION XWGTUP,SCALUP,AQEDUP,AQCDUP,PUP,VTIMUP,SPINUP
2202 COMMON/HEPEUP/NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP,
2203 & IDUP(MAXNUP),ISTUP(MAXNUP),MOTHUP(2,MAXNUP),
2204 & ICOLUP(2,MAXNUP),PUP(5,MAXNUP),VTIMUP(MAXNUP),
2207 INTEGER ISTART,ICMF,J,K,I,JCOL,ICOL
2209 COMMON /HWGUP/ILOC(NMXHEP),JLOC(MAXNUP)
2211 C--now we need to do the colour connections
2212 20 ISTART = ISTART+1
2213 IF(ISTART.GT.NHEP) GOTO 30
2214 IF(ISTART.EQ.ICMF) ISTART = ISTART+1
2215 IF(JMOHEP(2,ISTART).NE.0.AND.JDAHEP(2,ISTART).NE.0) GOTO 20
2218 IF(ICOLUP(1,J).NE.0) THEN
2230 C--now search for the partner
2231 C--first search for the flavour partner if not looking for colour partner
2232 C--search for the flavour partner of the particle
2233 C--this must be set or HERWIG won't work
2234 10 IF(JDAHEP(2,K).NE.0.AND.JMOHEP(2,K).NE.0) GOTO 20
2237 C--look for unpaired particle
2239 IF(JLOC(I).EQ.0) GOTO 15
2240 IF(IDUP(I).EQ.21.OR.IDUP(I).EQ.9) GOTO 15
2241 IF(JLOC(I).EQ.ISTART) GOTO 15
2242 IF(ICOLUP(1,I).EQ.0.AND.ICOLUP(2,I).EQ.0) GOTO 15
2243 C--antiflavour partner
2244 IF(JDAHEP(2,JLOC(I)).EQ.0) THEN
2245 C--pair incoming particle with outgoing particle
2246 C-- or outgoing antiparticle with outgoing particle
2247 IF(ISTUP(I).GT.0.AND.IDUP(I).GT.0.AND.
2248 & ((IDUP(J).GT.0.AND.ISTUP(J).EQ.-1).OR.
2249 & (IDUP(J).LT.0.AND.ISTUP(J).GT.0 ))) THEN
2252 C--pair incoming particle with incoming antiparticle
2253 C-- or outgoing antiparticle with incoming antiparticle
2254 ELSEIF(IDUP(I).LT.0.AND.ISTUP(I).EQ.-1.AND.
2255 & ((IDUP(J).GT.0.AND.ISTUP(J).EQ.-1).OR.
2256 & (IDUP(J).LT.0.AND.ISTUP(J).GT.0 ))) THEN
2260 C--make the connection
2262 JMOHEP(2,K) = JLOC(I)
2263 JDAHEP(2,JLOC(I)) = K
2267 IF(JMOHEP(2,JLOC(I)).EQ.0.AND.(.NOT.FOUND)) THEN
2268 C--pair incoming antiparticle with outgoing antiparticle
2269 C-- or outgoing particle with outgoing antiparticle
2270 IF(IDUP(I).LT.0.AND.ISTUP(I).GT.0.AND.
2271 & ((IDUP(J).LT.0.AND.ISTUP(J).EQ.-1).OR.
2272 & (IDUP(J).GT.0.AND.ISTUP(J).GT.0 ))) THEN
2275 C--pair incoming antiparticle with incoming particle
2276 C-- or outgoing particle with incoming particle
2277 ELSEIF(IDUP(I).GT.0.AND.ISTUP(I).EQ.-1.AND.
2278 & ((IDUP(J).LT.0.AND.ISTUP(J).EQ.-1).OR.
2279 & (IDUP(J).GT.0.AND.ISTUP(J).GT.0 ))) THEN
2283 C--make the connection
2285 JDAHEP(2,K) = JLOC(I)
2286 JMOHEP(2,JLOC(I)) = K
2289 C--set up the search for the next partner
2292 ICOL = ICOLUP(JCOL,I)
2298 C--if no other choice then connect to the first particle in the loop
2299 IF(JDAHEP(2,K).EQ.0.AND.JMOHEP(2,ISTART).EQ.0) THEN
2300 JDAHEP(2,K) = ISTART
2301 JMOHEP(2,ISTART) = K
2302 ELSEIF(JDAHEP(2,ISTART).EQ.0.AND.JMOHEP(2,K).EQ.0) THEN
2303 JMOHEP(2,K) = ISTART
2304 JDAHEP(2,ISTART) = K
2306 CALL HWWARN('HWBGUP',100)
2311 C--now the bit to find colour partners
2313 C--special for particle from a decaying coloured particle
2314 IF(MOTHUP(1,J).NE.0) THEN
2315 IF(ISTUP(MOTHUP(1,J)).EQ.2.OR.ISTUP(MOTHUP(1,J)).EQ.3) THEN
2316 IF(IDUP(J).LT.0.AND.ICOL.EQ.ICOLUP(2,MOTHUP(1,J))) THEN
2317 JDAHEP(2,K) = JLOC(MOTHUP(1,J))
2318 JMOHEP(2,K) = JLOC(MOTHUP(1,J))
2320 ELSEIF(IDUP(J).GT.0.AND.ICOL.EQ.ICOLUP(1,MOTHUP(1,J))) THEN
2321 JDAHEP(2,K) = JLOC(MOTHUP(1,J))
2322 JMOHEP(2,K) = JLOC(MOTHUP(1,J))
2327 C--search for the partner
2329 IF(ICOLUP(1,I).EQ.ICOL.AND.I.NE.J) THEN
2330 IF((JCOL.EQ.1.AND.ISTUP(J).EQ.-1.AND.ISTUP(I).GT.0).OR.
2331 & (JCOL.EQ.2.AND.ISTUP(J).GT.0.AND.ISTUP(I).GE.0)) THEN
2332 JDAHEP(2,K) = JLOC(I)
2333 JMOHEP(2,JLOC(I)) = K
2335 ELSEIF((JCOL.EQ.1.AND.ISTUP(J).GT.0.AND.ISTUP(I).EQ.-1).OR.
2336 & (JCOL.EQ.2.AND.ISTUP(J).EQ.-1.AND.ISTUP(I).EQ.-1)) THEN
2337 JMOHEP(2,K) = JLOC(I)
2338 JDAHEP(2,JLOC(I)) = K
2342 ELSEIF(ICOLUP(2,I).EQ.ICOL.AND.I.NE.J) THEN
2343 IF((JCOL.EQ.1.AND.ISTUP(J).EQ.-1.AND.ISTUP(I).EQ.-1).OR.
2344 & (JCOL.EQ.2.AND.ISTUP(J).GT.0.AND.ISTUP(I).EQ.-1)) THEN
2345 JDAHEP(2,K) = JLOC(I)
2346 JMOHEP(2,JLOC(I)) = K
2348 ELSEIF((JCOL.EQ.1.AND.ISTUP(J).GE.0.AND.ISTUP(I).GE.0).OR.
2349 & (JCOL.EQ.2.AND.ISTUP(J).EQ.-1.AND.ISTUP(I).GE.0)) THEN
2350 JMOHEP(2,K) = JLOC(I)
2351 JDAHEP(2,JLOC(I)) = K
2359 ICOL = ICOLUP(JCOL,I)
2363 C--special for self connected gluons
2364 IF(IDUP(J).EQ.21.OR.IDUP(J).EQ.9.AND.
2365 & ICOLUP(1,J).EQ.ICOLUP(2,J)) THEN
2368 C--options for self connected gluons
2370 CALL HWWARN('HWBGUP',1)
2372 CALL HWWARN('HWBGUP',101)
2377 C--perform the shower
2382 *CMZ :- -30/09/02 09.19.58 by Peter Richardson
2383 *-- Author : Bryan Webber
2384 C-----------------------------------------------------------------------
2386 C-----------------------------------------------------------------------
2387 C COMBINES JETS WITH REQUIRED KINEMATICS
2388 C-----------------------------------------------------------------------
2389 INCLUDE 'herwig65.inc'
2390 DOUBLE PRECISION HWULDO,EPS,PTX,PTY,PF,PTINF,PTCON,CN,CP,SP,PP0,
2391 & PM0,ET0,DET,ECM,EMJ,EMP,EMS,DMS,ES,DPF,ALF,AL(2),ET(2),PP(2),
2392 & PT(3),PA(5),PB(5),PC(5),PQ(5),PR(5),PS(5),RR(3,3),RS(3,3),ETC,
2393 & PJ(NMXJET),PM(NMXJET),PBR(5),RBR(3,3),DISP(4),PLAB(5)
2394 INTEGER LJET,IJ1,IST,IP,ICM,IP1,IP2,NP,IHEP,MHEP,JP,KP,LP,KHEP,
2395 & JHEP,NE,IJT,IEND(2),IJET(NMXJET),IPAR(NMXJET)
2396 LOGICAL AZCOR,JETRAD,DISPRO,DISLOW
2398 PARAMETER (EPS=1.D-4)
2399 IF (IERROR.NE.0) RETURN
2400 AZCOR=AZSOFT.OR.AZSPIN
2406 IF (IST.EQ.137.OR.IST.EQ.138) IST=133
2407 IF (IST.EQ.LJET) THEN
2408 C---FOUND AN UNBOOSTED JET - FIND PARTNERS
2411 DISPRO=IPRO/10.EQ.9.AND.IDHW(ICM).EQ.15
2412 DISLOW=DISPRO.AND.JDAHEP(1,ICM).EQ.JDAHEP(2,ICM)-1
2413 IF (IST.EQ.131) THEN
2421 CALL HWWARN('HWBJCO',100)
2428 30 IJET(NP)=JDAHEP(1,JHEP)
2433 IF (LJET.EQ.131) THEN
2438 50 IF (LJET.EQ.131) THEN
2439 C---SPACELIKE JETS: FIND SPACELIKE PARTONS
2441 CALL HWWARN('HWBJCO',103)
2444 C---special for DIS: FIND BOOST AND ROTATION FROM LAB TO BREIT FRAME
2445 IF (DISPRO.AND.BREIT) THEN
2447 IF (JDAHEP(1,IP).NE.0) IP=JDAHEP(1,IP)
2448 CALL HWVDIF(4,PHEP(1,JMOHEP(1,ICM)),PHEP(1,JDAHEP(1,ICM)),PB)
2450 C---IF Q**2<10**-2, SOMETHING MUST HAVE ALREADY GONE WRONG
2451 IF (PB(5)**2.LT.1.D-2) THEN
2452 CALL HWWARN('HWBJCO',102)
2455 CALL HWVSCA(4,PB(5)**2/HWULDO(PHEP(1,IP),PB),PHEP(1,IP),PBR)
2456 CALL HWVSUM(4,PB,PBR,PBR)
2458 CALL HWULOF(PBR,PB,PB)
2459 CALL HWUROT(PB,ONE,ZERO,RBR)
2466 IF (JDAHEP(1,MHEP).EQ.0) THEN
2467 C---SPECIAL FOR NON-PARTON JETS
2472 DO 60 IHEP=MHEP,NHEP
2473 60 IF (ISTHEP(IHEP).EQ.IST) GOTO 70
2474 C---COULDN'T FIND SPACELIKE PARTON
2475 CALL HWWARN('HWBJCO',101)
2478 70 CALL HWVSCA(3,PF,PHEP(1,IHEP),PS)
2479 IF (PTINT(3,IP).GT.ZERO) THEN
2480 C---ADD INTRINSIC PT
2484 CALL HWUROT(PS, ONE,ZERO,RS)
2485 CALL HWUROB(RS,PT,PT)
2486 CALL HWVSUM(3,PS,PT,PS)
2489 IF (AZCOR.AND.JP.LE.NHEP.AND.IDHW(JP).EQ.17) THEN
2490 C---ALIGN CONE WITH INTERFERING PARTON
2491 CALL HWUROT(PS, ONE,ZERO,RS)
2492 CALL HWUROF(RS,PHEP(1,JP),PR)
2493 PTCON=PR(1)**2+PR(2)**2
2496 CALL HWWARN('HWBJCO',1)
2499 CALL HWVEQU(4,PHEP(1,KP),PB)
2500 IF (DISPRO.AND.BREIT) THEN
2501 CALL HWULOF(PBR,PB,PB)
2502 CALL HWUROF(RBR,PB,PB)
2504 PTINF=PB(1)**2+PB(2)**2
2505 IF (PTINF.LT.EPS) THEN
2506 C---COLLINEAR JETS: ALIGN CONES
2508 C---BUG FIX BY MHS 17/03/05: RETURNED TO VERSION 6.500!
2509 IF (ISTHEP(KP).EQ.100.AND.ISTHEP(KP-1).GE.141
2510 $ .AND.ISTHEP(KP-1).LE.144) THEN
2512 CALL HWVEQU(4,PHEP(1,KP),PB)
2513 IF (DISPRO.AND.BREIT) THEN
2514 CALL HWULOF(PBR,PB,PB)
2515 CALL HWUROF(RBR,PB,PB)
2517 PTINF=PB(1)**2+PB(2)**2
2523 IF (PTCON.NE.ZERO.AND.PTINF.NE.ZERO) THEN
2524 CN=1./SQRT(PTINF*PTCON)
2525 CP=CN*(PR(1)*PB(1)+PR(2)*PB(2))
2526 SP=CN*(PR(1)*PB(2)-PR(2)*PB(1))
2528 CALL HWRAZM( ONE,CP,SP)
2531 CALL HWRAZM( ONE,CP,SP)
2533 C---ROTATE SO SPACELIKE IS ALONG AXIS (APART FROM INTRINSIC PT)
2534 CALL HWUROT(PS,CP,SP,RS)
2537 IF (KHEP.LT.IHEP) KHEP=IHEP
2539 DO 80 JHEP=IHEP,KHEP
2540 CALL HWUROF(RS,PHEP(1,JHEP),PHEP(1,JHEP))
2541 80 CALL HWUROF(RS,VHEP(1,JHEP),VHEP(1,JHEP))
2542 PP(IP)=PHEP(4,IHEP)+PF*PHEP(3,IHEP)
2543 ET(IP)=PHEP(1,IHEP)**2+PHEP(2,IHEP)**2-PHEP(5,IHEP)**2
2544 C---REDEFINE HARD CM
2545 PTX=PTX+PHEP(1,IHEP)
2546 PTY=PTY+PHEP(2,IHEP)
2550 C---special for DIS: keep lepton momenta fixed
2555 C---IJT will be used to store lepton momentum transfer
2556 CALL HWVDIF(4,PHEP(1,IP1),PHEP(1,IP2),PHEP(1,IJT))
2557 CALL HWUMAS(PHEP(1,IJT))
2558 IF (IDHEP(IP1).EQ.IDHEP(IP2)) THEN
2560 ELSEIF (IDHEP(IP1).LT.IDHEP(IP2)) THEN
2565 IDHEP(IJT)=IDPDG(IDHW(IJT))
2567 C---calculate boost for struck parton
2568 C PC is momentum of outgoing parton(s)
2570 IF (.NOT.DISLOW) THEN
2571 C---FOR heavy QQbar PQ and PC are old and new QQbar momenta
2572 CALL HWVSUM(4,PHEP(1,IP2-1),PHEP(1,IP2),PQ)
2576 PC(5)=PHEP(5,JDAHEP(1,IP2))
2578 CALL HWVSUM(2,PHEP(1,IJT),PHEP(1,IJET(2)),PC)
2580 C---USE BREIT FRAME BOSON MOMENTUM IF NECESSARY
2582 ET(2)=ET(1)+PC(5)**2+PHEP(5,IJET(2))**2
2586 ET(2)=PC(1)**2+PC(2)**2+PC(5)**2
2587 PP0=PHEP(4,IJT)+PHEP(3,IJT)
2588 PM0=PHEP(4,IJT)-PHEP(3,IJT)
2590 ET0=(PP0*PM0)+ET(1)-ET(2)
2591 DET=ET0**2-4.*(PP0*PM0)*ET(1)
2592 IF (DET.LT.ZERO) THEN
2596 ALF=(SQRT(DET)-ET0)/(2.*PP0*PP(2))
2602 DO 100 IHEP=IJET(2),IEND(2)
2603 CALL HWULOF(PB,PHEP(1,IHEP),PHEP(1,IHEP))
2604 CALL HWULF4(PB,VHEP(1,IHEP),VHEP(1,IHEP))
2605 C---BOOST FROM BREIT FRAME IF NECESSARY
2607 CALL HWUROB(RBR,PHEP(1,IHEP),PHEP(1,IHEP))
2608 CALL HWULOB(PBR,PHEP(1,IHEP),PHEP(1,IHEP))
2609 CALL HWUROB(RBR,VHEP(1,IHEP),VHEP(1,IHEP))
2610 CALL HWULB4(PBR,VHEP(1,IHEP),VHEP(1,IHEP))
2612 100 ISTHEP(IHEP)=ISTHEP(IHEP)+10
2613 CALL HWVDIF(4,VHEP(1,IPAR(2)),VHEP(1,IJET(2)),DISP)
2614 DO 110 IHEP=IJET(2),IEND(2)
2615 110 CALL HWVSUM(4,DISP,VHEP(1,IHEP),VHEP(1,IHEP))
2616 IF (IEND(2).GT.IJET(2)+1) ISTHEP(IJET(2)+1)=100
2617 CALL HWVSUM(4,PHEP(1,IJT),PHEP(1,IJET(2)),PC)
2618 CALL HWVSUM(4,PHEP(1,IP1),PHEP(1,IJET(2)),PHEP(1,ICM))
2619 CALL HWUMAS(PHEP(1,ICM))
2620 ELSEIF (IPRO/10.EQ.5) THEN
2621 C Special to preserve photon momentum
2622 ETC=PTX**2+PTY**2+PHEP(5,ICM)**2
2624 DET=ET0**2-4.*ETC*ET(1)
2625 IF (DET.LT.ZERO) THEN
2629 ALF=(SQRT(DET)+ET0-2.*ET(1))/(2.*PP(1)*PP(2))
2636 DO 120 IHEP=IJT,IEND(2)
2637 CALL HWULOF(PB,PHEP(1,IHEP),PHEP(1,IHEP))
2638 CALL HWULF4(PB,VHEP(1,IHEP),VHEP(1,IHEP))
2639 120 ISTHEP(IHEP)=ISTHEP(IHEP)+10
2640 CALL HWVDIF(4,VHEP(1,IPAR(2)),VHEP(1,IJT),DISP)
2641 DO 130 IHEP=IJT,IEND(2)
2642 130 CALL HWVSUM(4,DISP,VHEP(1,IHEP),VHEP(1,IHEP))
2643 IF (IEND(2).GT.IJT+1) ISTHEP(IJT+1)=100
2644 ISTHEP(IJET(1))=ISTHEP(IJET(1))+10
2645 CALL HWVSUM(2,PHEP(3,IPAR(1)),PHEP(3,IJT),PHEP(3,ICM))
2647 C--change to preserve either long mom or rapidity rather than long mom
2648 C--by PR and BRW 30/9/02
2650 C--PRESERVE LONG MOM OF CMF
2652 & SQRT(PTX**2+PTY**2+PHEP(3,ICM)**2+PHEP(5,ICM)**2)
2654 C--PRESERVE RAPIDITY OF CMF
2655 DET=SQRT(ONE+(PTX**2+PTY**2)/(PHEP(4,ICM)**2
2657 CALL HWVSCA(2,DET,PHEP(3,ICM),PHEP(3,ICM))
2659 C---NOW BOOST TO REQUIRED Q**2 AND X-F
2660 PP0=PHEP(4,ICM)+PHEP(3,ICM)
2661 PM0=PHEP(4,ICM)-PHEP(3,ICM)
2662 ET0=(PP0*PM0)+ET(1)-ET(2)
2663 DET=ET0**2-4.*(PP0*PM0)*ET(1)
2664 IF (DET.LT.ZERO) THEN
2669 AL(1)= 2.*PM0*PP(1)/DET
2670 AL(2)=(PM0/PP(2))*(1.-2.*ET(1)/DET)
2675 PB(3)=AL(IP)-(1./AL(IP))
2676 PB(4)=AL(IP)+(1./AL(IP))
2678 DO 140 IHEP=IJT,IEND(IP)
2679 CALL HWULOF(PB,PHEP(1,IHEP),PHEP(1,IHEP))
2680 CALL HWULF4(PB,VHEP(1,IHEP),VHEP(1,IHEP))
2681 140 ISTHEP(IHEP)=ISTHEP(IHEP)+10
2682 CALL HWVDIF(4,VHEP(1,IPAR(IP)),VHEP(1,IJT),DISP)
2683 DO 150 IHEP=IJT,IEND(IP)
2684 150 CALL HWVSUM(4,DISP,VHEP(1,IHEP),VHEP(1,IHEP))
2685 IF (IEND(IP).GT.IJT+1) THEN
2687 ELSEIF (IEND(IP).EQ.IJT) THEN
2696 C---SPECIAL CASE: IF HARD PROCESS IS W/Z DECAY, PERFORM KINEMATIC
2697 C RECONSTRUCTION IN ITS REST FRAME INSTEAD OF THE LAB FRAME
2698 IF (IDHW(ICM).GE.198.AND.IDHW(ICM).LE.200.AND.WZRFR) THEN
2699 CALL HWVEQU(5,PHEP(1,ICM),PLAB)
2700 CALL HWULOF(PLAB,PHEP(1,ICM),PHEP(1,ICM))
2701 CALL HWULF4(PLAB,VHEP(1,ICM),VHEP(1,ICM))
2703 CALL HWULOF(PLAB,PHEP(1,IPAR(IP)),PHEP(1,IPAR(IP)))
2704 CALL HWULF4(PLAB,VHEP(1,IPAR(IP)),VHEP(1,IPAR(IP)))
2707 C special for DIS: preserve outgoing lepton momentum
2709 CALL HWVEQU(5,PHEP(1,IPAR(1)),PHEP(1,IJET(1)))
2713 CALL HWVEQU(5,PHEP(1,ICM),PC)
2714 C--- PQ AND PC ARE OLD AND NEW PARTON CM
2715 CALL HWVSUM(4,PHEP(1,IPAR(1)),PHEP(1,IPAR(2)),PQ)
2719 170 CALL HWVSUM(4,PHEP(1,IPAR(KP)),PQ,PQ)
2723 IF (.NOT.DISLOW) THEN
2724 C---FIND JET CM MOMENTA
2729 EMJ=PHEP(5,IJET(KP))
2730 EMP=PHEP(5,IPAR(KP))
2731 JETRAD=JETRAD.OR.EMJ.NE.EMP
2734 C---N.B. ROUNDING ERRORS HERE AT HIGH ENERGIES
2735 PJ(KP)=(HWULDO(PHEP(1,IPAR(KP)),PQ)/ECM)**2-EMP**2
2736 IF (PJ(KP).LE.ZERO) THEN
2737 CALL HWWARN('HWBJCO',104)
2743 C---JETS DID RADIATE
2744 IF (EMS.GE.ECM) THEN
2752 ES=SQRT(PF*PJ(KP)+PM(KP))
2754 190 DMS=DMS+PJ(KP)/ES
2756 IF (DPF.GT.PF) DPF=0.9*PF
2758 200 IF (ABS(DPF).LT.EPS) GOTO 210
2759 CALL HWWARN('HWBJCO',105)
2764 C---BOOST PC AND PQ TO BREIT FRAME IF NECESSARY
2765 IF (DISPRO.AND.BREIT) THEN
2766 CALL HWULOF(PBR,PC,PC)
2767 CALL HWUROF(RBR,PC,PC)
2768 IF (.NOT.DISLOW) THEN
2769 CALL HWULOF(PBR,PQ,PQ)
2770 CALL HWUROF(RBR,PQ,PQ)
2774 C---FIND CM ROTATION FOR JET IP
2775 IF (.NOT.DISLOW) THEN
2776 CALL HWVEQU(4,PHEP(1,IPAR(IP)),PR)
2777 IF (DISPRO.AND.BREIT) THEN
2778 CALL HWULOF(PBR,PR,PR)
2779 CALL HWUROF(RBR,PR,PR)
2781 C--Modified by MHS 17/08/05 to do unboost in 2 stages (trans,long)
2785 PA(5)=SQRT(PQ(3)**2+PQ(5)**2)
2787 CALL HWULOF(PA,PR,PR)
2793 CALL HWULOF(PA,PR,PR)
2795 CALL HWUROT(PR, ONE,ZERO,RR)
2798 PR(3)=SQRT(PF*PJ(IP))
2799 PR(4)=SQRT(PF*PJ(IP)+PM(IP))
2800 PR(5)=PHEP(5,IJET(IP))
2801 CALL HWUROB(RR,PR,PR)
2802 C--Modified by BRW 25/10/02 to do boost in 2 stages (long,trans)
2807 PA(4)=SQRT(PA(3)**2+PA(5)**2)
2808 CALL HWULOB(PA,PR,PR)
2814 CALL HWULOB(PA,PR,PR)
2817 CALL HWVEQU(5,PC,PR)
2819 C---NOW PR IS LAB/BREIT MOMENTUM OF JET IP
2821 IF (AZCOR.AND.KP.LE.NHEP.AND.IDHW(KP).EQ.17) THEN
2822 C---ALIGN CONE WITH INTERFERING PARTON
2823 CALL HWUROT(PR, ONE,ZERO,RS)
2826 CALL HWWARN('HWBJCO',2)
2829 CALL HWVEQU(4,PHEP(1,JP),PS)
2830 IF (DISPRO.AND.BREIT) THEN
2831 CALL HWULOF(PBR,PS,PS)
2832 CALL HWUROF(RBR,PS,PS)
2834 CALL HWUROF(RS,PS,PS)
2835 PTINF=PS(1)**2+PS(2)**2
2836 IF (PTINF.LT.EPS) THEN
2837 C---COLLINEAR JETS: ALIGN CONES
2839 C---BUG FIX BY MHS 17/03/05: RETURNED TO VERSION 6.500!
2840 IF (ISTHEP(JP).EQ.100.AND.ISTHEP(JP-1).GE.141
2841 $ .AND.ISTHEP(JP-1).LE.144) THEN
2843 CALL HWVEQU(4,PHEP(1,JP),PS)
2844 IF (DISPRO.AND.BREIT) THEN
2845 CALL HWULOF(PBR,PS,PS)
2846 CALL HWUROF(RBR,PS,PS)
2848 CALL HWUROF(RS,PS,PS)
2849 PTINF=PS(1)**2+PS(2)**2
2855 CALL HWVEQU(4,PHEP(1,KP),PB)
2856 IF (DISPRO.AND.BREIT) THEN
2857 CALL HWULOF(PBR,PB,PB)
2858 CALL HWUROF(RBR,PB,PB)
2860 PTCON=PB(1)**2+PB(2)**2
2861 IF (PTCON.NE.ZERO.AND.PTINF.NE.ZERO) THEN
2862 CN=1./SQRT(PTINF*PTCON)
2863 CP=CN*(PS(1)*PB(1)+PS(2)*PB(2))
2864 SP=CN*(PS(1)*PB(2)-PS(2)*PB(1))
2866 CALL HWRAZM( ONE,CP,SP)
2869 CALL HWRAZM( ONE,CP,SP)
2871 CALL HWUROT(PR,CP,SP,RS)
2872 C---FIND BOOST FOR JET IP
2873 ALF=(PHEP(3,IJET(IP))+PHEP(4,IJET(IP)))/
2874 & (PR(4)+SQRT((PR(4)+PR(5))*(PR(4)-PR(5))))
2882 IF (KHEP.LT.IHEP) KHEP=IHEP
2883 DO 220 JHEP=IHEP,KHEP
2884 CALL HWULOF(PB,PHEP(1,JHEP),PHEP(1,JHEP))
2885 CALL HWUROB(RS,PHEP(1,JHEP),PHEP(1,JHEP))
2886 CALL HWULF4(PB,VHEP(1,JHEP),VHEP(1,JHEP))
2887 CALL HWUROB(RS,VHEP(1,JHEP),VHEP(1,JHEP))
2888 C---BOOST FROM BREIT FRAME IF NECESSARY
2889 IF (DISPRO.AND.BREIT) THEN
2890 CALL HWUROB(RBR,PHEP(1,JHEP),PHEP(1,JHEP))
2891 CALL HWULOB(PBR,PHEP(1,JHEP),PHEP(1,JHEP))
2892 CALL HWUROB(RBR,VHEP(1,JHEP),VHEP(1,JHEP))
2893 CALL HWULB4(PBR,VHEP(1,JHEP),VHEP(1,JHEP))
2895 CALL HWVSUM(4,VHEP(1,JHEP),VHEP(1,IPAR(IP)),VHEP(1,JHEP))
2896 C--MHS FIX 07/03/05 FOR VERTEX POSITION OF LONG LIVED NON-PARTON JETS
2897 IF (KHEP.EQ.IHEP.AND.(IDHW(JHEP).GE.121.AND.IDHW(JHEP).LE.132
2898 $ .OR.IDHW(JHEP).EQ.59))
2899 $ CALL HWVSUM(4,VTXPIP,VHEP(1,JHEP),VHEP(1,JHEP))
2901 220 ISTHEP(JHEP)=ISTHEP(JHEP)+10
2902 IF (KHEP.GT.IHEP+1) THEN
2904 ELSEIF (KHEP.EQ.IHEP) THEN
2909 IF (ISTHEP(ICM).EQ.110) ISTHEP(ICM)=120
2910 C---SPECIAL CASE: FOR W/Z DECAY BOOST BACK TO THE LAB FRAME
2911 240 IF (IDHW(ICM).GE.198.AND.IDHW(ICM).LE.200.AND.WZRFR) THEN
2912 CALL HWULOB(PLAB,PHEP(1,ICM),PHEP(1,ICM))
2913 CALL HWULB4(PLAB,VHEP(1,ICM),VHEP(1,ICM))
2915 CALL HWULOB(PLAB,PHEP(1,IPAR(IP)),PHEP(1,IPAR(IP)))
2916 CALL HWULB4(PLAB,VHEP(1,IPAR(IP)),VHEP(1,IPAR(IP)))
2917 CALL HWULOB(PLAB,PHEP(1,IJET(IP)),PHEP(1,IJET(IP)))
2918 C--MHS FIX 07/03/05 - DO NOT REBOOST PRIMARY VERTEX
2919 IF (ISTHEP(IJET(IP)).EQ.190)
2920 $ CALL HWVDIF(4,VHEP(1,IJET(IP)),VTXPIP,VHEP(1,IJET(IP)))
2921 CALL HWULB4(PLAB,VHEP(1,IJET(IP)),VHEP(1,IJET(IP)))
2922 IF (ISTHEP(IJET(IP)).EQ.190)
2923 $ CALL HWVSUM(4,VHEP(1,IJET(IP)),VTXPIP,VHEP(1,IJET(IP)))
2925 IF (JDAHEP(1,IJET(IP)).GT.0) THEN
2926 IF (JDAHEP(2,IJET(IP)).GT.JDAHEP(1,IJET(IP))) THEN
2927 CALL HWULOB(PLAB,PHEP(1,IJET(IP)+1),PHEP(1,IJET(IP)+1))
2928 CALL HWULB4(PLAB,VHEP(1,IJET(IP)+1),VHEP(1,IJET(IP)+1))
2930 DO 250 IHEP=JDAHEP(1,IJET(IP)),JDAHEP(2,IJET(IP))
2931 CALL HWULOB(PLAB,PHEP(1,IHEP),PHEP(1,IHEP))
2932 CALL HWULB4(PLAB,VHEP(1,IHEP),VHEP(1,IHEP))
2943 *CMZ :- -26/04/91 11.11.54 by Bryan Webber
2944 *-- Author : Bryan Webber
2945 C-----------------------------------------------------------------------
2947 C-----------------------------------------------------------------------
2948 C Passes backwards through a jet cascade calculating the masses
2949 C and magnitudes of the longitudinal and transverse three momenta.
2950 C Components given relative to direction of parent for a time-like
2951 C vertex and with respect to z-axis for space-like vertices.
2953 C On input PPAR(1-5,*) contains:
2954 C (E*sqrt(Xi),Xi,3-mom (if external),E,M-sq (if external))
2956 C On output PPAR(1-5,*) (if TMPAR(*)), containts:
2957 C (P-trans,Xi or Xilast,P-long,E,M)
2958 C-----------------------------------------------------------------------
2959 INCLUDE 'herwig65.inc'
2960 DOUBLE PRECISION HWUSQR,EXI,PISQ,PJPK,EJEK,PTSQ,Z,ZMIN,ZMAX,
2961 $ EMI,EMJ,EMK,C,NQ,HWBVMC,RHO,POLD,PNEW,EOLD,ENEW,A,B
2962 INTEGER IPAR,JPAR,KPAR,MPAR,I,J,K
2964 IF (IERROR.NE.0) RETURN
2966 DO 30 MPAR=NPAR-1,3,-2
2968 C Find parent and partner of this branch
2971 C Determine type of branching
2972 IF (TMPAR(IPAR)) THEN
2973 C Time-like branching
2974 C Compute mass of parent
2975 EXI=PPAR(1,JPAR)*PPAR(1,KPAR)
2976 PPAR(5,IPAR)=PPAR(5,JPAR)+PPAR(5,KPAR)+2.*EXI
2977 C Compute three momentum of parent
2978 PISQ=PPAR(4,IPAR)*PPAR(4,IPAR)-PPAR(5,IPAR)
2979 PPAR(3,IPAR)=HWUSQR(PISQ)
2980 C---SPECIAL FOR G-->QQBAR: READJUST ANGULAR DISTRIBUTION
2981 IF (IDPAR(IPAR).EQ.13 .AND. IDPAR(JPAR).LT.13) THEN
2982 Z=PPAR(4,JPAR)/PPAR(4,IPAR)
2983 ZMIN=HWBVMC(IDPAR(JPAR))/PPAR(1,JPAR)*Z
2984 RHO=(Z*(3-Z*(3-2*Z))-ZMIN*(3-ZMIN*(3-2*ZMIN)))
2985 $ /(2*(1-2*ZMIN)*(1-ZMIN*(1-ZMIN)))
2986 NQ=PPAR(3,IPAR)*(PPAR(3,IPAR)+PPAR(4,IPAR))
2990 ZMIN=MAX((EMI+EMJ-EMK)/(2*(EMI+NQ)),
2991 $ (EMI+EMJ-EMK-SQRT(ABS((EMI-EMJ-EMK)**2-4*EMJ*EMK)))/(2*EMI))
2992 ZMAX=1-MAX((EMI-EMJ+EMK)/(2*(EMI+NQ)),
2993 $ (EMI-EMJ+EMK-SQRT(ABS((EMI-EMJ-EMK)**2-4*EMJ*EMK)))/(2*EMI))
2994 C=2*RMASS(IDPAR(JPAR))**2/EMI
2995 Z=(4*ZMIN*(1.5*(1+C-ZMIN)+ZMIN**2)*(1-RHO)
2996 $ +4*ZMAX*(1.5*(1+C-ZMAX)+ZMAX**2)*RHO-2-3*C)/(1+2*C)**1.5
2997 Z=SQRT(1+2*C)*SINH(LOG(Z+SQRT(Z**2+1))/3)+0.5
2998 Z=(Z*NQ+(EMI+EMJ-EMK)/2)/(NQ+EMI)
2999 PPAR(4,JPAR)=Z*PPAR(4,IPAR)
3000 PPAR(4,KPAR)=PPAR(4,IPAR)-PPAR(4,JPAR)
3001 PPAR(3,JPAR)=HWUSQR(PPAR(4,JPAR)**2-EMJ)
3002 PPAR(3,KPAR)=HWUSQR(PPAR(4,KPAR)**2-EMK)
3003 PPAR(2,JPAR)=EXI/(PPAR(4,JPAR)*PPAR(4,KPAR))
3004 IF(JDAPAR(2,JPAR).NE.0)PPAR(2,JDAPAR(2,JPAR))=PPAR(2,JPAR)
3005 IF(JDAPAR(2,KPAR).NE.0)PPAR(2,JDAPAR(2,KPAR))=PPAR(2,JPAR)
3006 C---FIND DESCENDENTS OF THIS SPLITTING AND READJUST THEIR MOMENTA TOO
3007 DO 20 J=JPAR+2,NPAR-1,2
3010 IF (I.GT.IPAR) GOTO 10
3014 POLD=PPAR(3,J)+PPAR(3,K)
3015 EOLD=PPAR(4,J)+PPAR(4,K)
3016 PNEW=HWUSQR(PPAR(4,I)**2-PPAR(5,I))
3018 A=(ENEW*EOLD-PNEW*POLD)/PPAR(5,I)
3019 B=(PNEW*EOLD-ENEW*POLD)/PPAR(5,I)
3020 PPAR(3,J)=A*PPAR(3,J)+B*PPAR(4,J)
3021 PPAR(4,J)=(PPAR(4,J)+B*PPAR(3,J))/A
3022 PPAR(3,K)=PNEW-PPAR(3,J)
3023 PPAR(4,K)=ENEW-PPAR(4,J)
3024 PPAR(2,J)=1-(PPAR(3,J)*PPAR(3,K)+PPAR(1,J)*PPAR(1,K))
3025 $ /(PPAR(4,J)*PPAR(4,K))
3026 IF (JDAPAR(2,J).NE.0) PPAR(2,JDAPAR(2,J))=PPAR(2,J)
3027 IF (JDAPAR(2,K).NE.0) PPAR(2,JDAPAR(2,K))=PPAR(2,J)
3031 C Compute daughter' transverse and longitudinal momenta
3032 PJPK=PPAR(3,JPAR)*PPAR(3,KPAR)
3033 EJEK=PPAR(4,JPAR)*PPAR(4,KPAR)-EXI
3034 PTSQ=(PJPK+EJEK)*(PJPK-EJEK)/PISQ
3035 PPAR(1,JPAR)=HWUSQR(PTSQ)
3036 PPAR(3,JPAR)=HWUSQR(PPAR(3,JPAR)*PPAR(3,JPAR)-PTSQ)
3037 PPAR(1,KPAR)=-PPAR(1,JPAR)
3038 PPAR(3,KPAR)= PPAR(3,IPAR)-PPAR(3,JPAR)
3040 C Space-like branching
3041 C Re-arrange such that JPAR is time-like
3042 IF (TMPAR(KPAR)) THEN
3046 C Compute time-like branch
3047 PTSQ=(2.-PPAR(2,JPAR))*PPAR(1,JPAR)*PPAR(1,JPAR)
3049 PPAR(1,JPAR)=HWUSQR(PTSQ)
3050 PPAR(3,JPAR)=(1.-PPAR(2,JPAR))*PPAR(4,JPAR)
3051 PPAR(3,IPAR)=PPAR(3,KPAR)-PPAR(3,JPAR)
3055 C Reset Xi to Xilast
3056 PPAR(2,KPAR)=PPAR(2,IPAR)
3060 40 PPAR(5,IPAR)=HWUSQR(PPAR(5,IPAR))
3065 *CMZ :- -14/10/99 18.04.56 by Mike Seymour
3066 *-- Author : Bryan Webber & Mike Seymour
3067 C-----------------------------------------------------------------------
3068 SUBROUTINE HWBRAN(KPAR)
3069 C-----------------------------------------------------------------------
3070 C BRANCHES TIMELIKE PARTON KPAR INTO TWO, PUTS PRODUCTS
3071 C INTO NPAR+1 AND NPAR+2, AND INCREASES NPAR BY TWO
3072 C-----------------------------------------------------------------------
3073 INCLUDE 'herwig65.inc'
3074 DOUBLE PRECISION HWBVMC,HWRGEN,HWUALF,HWUTAB,HWRUNI,HWULDO,PMOM,
3075 & QNOW,QLST,QKTHR,RN,QQBAR,DQQ,QGTHR,SNOW,QSUD,ZMIN,ZMAX,ZRAT,WMIN,
3076 & QLAM,Z1,Z2,ETEST,ZTEST,ENOW,XI,XIPREV,EPREV,QMAX,QGAM,SLST,SFNL,
3077 & TARG,ALF,BETA0(3:6),BETAP(3:6),SQRK(4:6,5),REJFAC,Z,X1,X2,OTHXI,
3078 & OTHZ,X3,FF,AW,XCUT,CC,JJ,HWUSQR
3079 INTEGER HWRINT,KPAR,ID,JD,IS,NTRY,N,ID1,ID2,MPAR,ISUD(13),IHEP,
3080 & JHEP,M,NF,NN,IREJ,NREJ,ITOP
3081 EXTERNAL HWBVMC,HWRGEN,HWUALF,HWUTAB,HWRUNI,HWULDO,HWRINT,HWUSQR
3082 SAVE BETA0,BETAP,SQRK
3084 DATA ISUD,BETA0/2,2,3,4,5,6,2,2,3,4,5,6,1,4*ZERO/
3085 IF (IERROR.NE.0) RETURN
3086 C---SET SQRK(M,N) TO THE PROBABILITY THAT A GLUON WILL NOT PRODUCE A
3087 C QUARK-ANTIQUARK PAIR BETWEEN SCALES RMASS(M) AND 2*HWBVMC(N)
3088 IF (SUDORD.NE.1.AND.BETA0(3).EQ.ZERO) THEN
3090 BETA0(M)=(11.*CAFAC-2.*M)*0.5
3091 100 BETAP(M)=(17.*CAFAC**2-(5.*CAFAC+3.*CFFAC)*M)
3092 & /BETA0(M)*0.25/PIFAC
3097 ELSEIF (M.EQ.4.OR.M.EQ.N+1) THEN
3099 IF (2*HWBVMC(N).GT.RMASS(M)) NF=M+1
3100 SQRK(M,N)=((BETAP(NF-1)+1/HWUALF(1,2*HWBVMC(N)))/
3101 $ (BETAP(NF-1)+1/HWUALF(1,RMASS(M))))**(1/BETA0(NF-1))
3103 SQRK(M,N)=SQRK(M-1,N)*
3104 $ ((BETAP(M-1)+1/HWUALF(1,RMASS(M-1)))/
3105 $ (BETAP(M-1)+1/HWUALF(1,RMASS(M))))**(1/BETA0(M-1))
3111 C--TEST FOR PARTON TYPE
3115 ELSEIF (ID.GE.209.AND.ID.LE.220) THEN
3123 C--TIMELIKE PARTON BRANCHING
3126 IF (JMOPAR(1,KPAR).EQ.0) THEN
3129 EPREV=PPAR(4,JMOPAR(1,KPAR))
3131 C--IF THIS IS CHARGED & PHOTONS ARE ALLOWED, ANGLES MIGHT NOT BE ORDERED
3134 IF (ICHRG(ID).NE.0 .AND. VPCUT.LT.PPAR(1,2)) THEN
3135 C--LOOK FOR A PREVIOUS G->QQBAR, IF ANY
3137 1 IF (JMOPAR(1,MPAR).NE.0) THEN
3138 IF (IDPAR(JMOPAR(1,MPAR)).EQ.ID) THEN
3143 C--IF CLIMBED TO THE TOP OF THE LIST, FIND QED INTERFERENCE PARTNER
3147 IHEP=JDAHEP(2,JCOPAR(1,1))
3148 IF (IHEP.GT.0) JHEP=JDAHEP(2,IHEP)
3150 IHEP=JMOHEP(2,JCOPAR(1,1))
3151 IF (IHEP.GT.0) JHEP=JMOHEP(2,IHEP)
3153 IF (IHEP.GT.0.AND.JHEP.GT.0) THEN
3154 QMAX=HWULDO(PHEP(1,IHEP),PHEP(1,JHEP))
3155 & *(ENOW/PPAR(4,2))**2
3157 C--FIX AT HARD PROCESS SCALE IF POINTER NOT YET SET
3158 C (CAN HAPPEN IN SUSY EVENTS)
3162 QMAX=ENOW**2*PPAR(2,MPAR)
3164 C--IF PREVIOUS BRANCHING WAS Q->QGAMMA, LOOK FOR A QCD BRANCHING
3166 2 IF (JMOPAR(1,MPAR).NE.0) THEN
3167 IF (IDPAR(JDAPAR(1,JMOPAR(1,MPAR))).EQ.59 .OR.
3168 & IDPAR(JDAPAR(2,JMOPAR(1,MPAR))).EQ.59) THEN
3173 QLST=ENOW**2*PPAR(2,MPAR)
3174 QMAX=SQRT(MAX(ZERO,MIN(
3175 & QMAX , EPREV**2*XIPREV , ENOW**2*XIPREV*(2-XIPREV))))
3177 & QLST , EPREV**2*XIPREV , ENOW**2*XIPREV*(2-XIPREV)))
3181 IF (NTRY.GT.NBTRY) THEN
3182 CALL HWWARN('HWBRAN',100)
3186 C--GLUON -> QUARK+ANTIQUARK OPTION
3187 IF (QLST.GT.QCDL3) THEN
3190 IF (QLST.GT.QKTHR) THEN
3192 IF (SUDORD.NE.1) THEN
3193 C---FIND IN WHICH FLAVOUR INTERVAL THE UPPER LIMIT LIES
3195 DO 200 M=MAX(3,N),NFLAV
3196 200 IF (QLST.GT.RMASS(M)) NF=M
3197 C---CALCULATE THE FORM FACTOR
3198 IF (NF.EQ.MAX(3,N)) THEN
3199 SFNL=((BETAP(NF)+1/HWUALF(1,QKTHR))/
3200 $ (BETAP(NF)+1/HWUALF(1,QLST)))**(1/BETA0(NF))
3203 SFNL=((BETAP(NF)+1/HWUALF(1,RMASS(NF)))/
3204 $ (BETAP(NF)+1/HWUALF(1,QLST)))**(1/BETA0(NF))
3205 SLST=SFNL*SQRK(NF,N)
3208 IF (RN.GT.1.E-3) THEN
3209 QQBAR=QCDL3*(QLST/QCDL3)**(RN**BETAF)
3213 IF (SUDORD.NE.1) THEN
3214 C---FIND IN WHICH FLAVOUR INTERVAL THE SOLUTION LIES
3215 IF (RN.GE.SFNL) THEN
3217 ELSEIF (RN.GE.SLST) THEN
3219 DO 210 M=MAX(3,N)+1,NF-1
3220 210 IF (RN.GE.SLST/SQRK(M,N)) NN=M
3229 TARG=HWUALF(1,RMASS(NN+1))
3230 RN=RN/SLST*SQRK(NN+1,N)
3232 TARG=1/((BETAP(NN)+1/TARG)*RN**BETA0(NN)-BETAP(NN))
3233 C---NOW SOLVE HWUALF(1,QQBAR)=TARG FOR QQBAR ITERATIVELY
3234 7 QQBAR=MAX(QQBAR,HALF*QKTHR)
3236 IF (ABS(ALF-TARG).GT.ACCUR) THEN
3238 IF (NTRY.GT.NBTRY) THEN
3239 CALL HWWARN('HWBRAN',101)
3242 QQBAR=QQBAR*(1+3*PIFAC*(ALF-TARG)
3243 $ /(BETA0(NN)*ALF**2*(1+BETAP(NN)*ALF)))
3248 IF (QQBAR.GT.QNOW.AND.QQBAR.GT.QKTHR) THEN
3257 C--GLUON->DIQUARKS OPTION
3258 9 IF (QLST.LT.QDIQK) THEN
3259 IF (PDIQK.NE.ZERO) THEN
3261 DQQ=QLST*EXP(-RN/PDIQK)
3262 IF (DQQ.GT.QNOW) THEN
3263 IF (DQQ.GT.2.*RMASS(115)) THEN
3271 C--ENHANCE GLUON AND PHOTON EMISSION BY A FACTOR OF TWO IF THIS BRANCH
3272 C IS CAPABLE OF BEING THE HARDEST SO FAR
3274 IF (TMPAR(2).AND.0.25*MAX(QLST,QMAX).GT.HARDST) NREJ=2
3275 C--BRANCHING ID->ID+GLUON
3276 QGTHR=HWBVMC(ID)+HWBVMC(13)
3277 IF (QLST.GT.QGTHR) THEN
3280 SLST=HWUTAB(SUD(1,IS),QEV(1,IS),NQEV,QLST,INTER)
3281 IF (RN.EQ.ZERO) THEN
3286 IF (SNOW.LT.ONE) THEN
3287 QSUD=HWUTAB(QEV(1,IS),SUD(1,IS),NQEV,SNOW,INTER)
3288 C---IF FORM FACTOR DID NOT GET INVERTED CORRECTLY TRY LINEAR INSTEAD
3289 IF (QSUD.GT.QLST) THEN
3290 SNOW=HWUTAB(SUD(1,IS),QEV(1,IS),NQEV,QLST,1)/RN
3291 QSUD=HWUTAB(QEV(1,IS),SUD(1,IS),NQEV,SNOW,1)
3292 IF (QSUD.GT.QLST) THEN
3293 CALL HWWARN('HWBRAN',1)
3297 IF (QSUD.GT.QGTHR.AND.QSUD.GT.QNOW) THEN
3304 C--BRANCHING ID->ID+PHOTON
3305 IF (ICHRG(ID).NE.0) THEN
3306 QGTHR=MAX(HWBVMC(ID)+HWBVMC(59),HWBVMC(59)*EXP(0.75))
3307 IF (QMAX.GT.QGTHR) THEN
3310 IF (RN.EQ.ZERO) THEN
3313 QGAM=(LOG(QMAX/HWBVMC(59))-0.75)**2
3314 & +PIFAC*9/(ICHRG(ID)**2*ALPFAC*ALPHEM)*LOG(RN)
3315 IF (QGAM.GT.ZERO) THEN
3316 QGAM=HWBVMC(59)*EXP(0.75+SQRT(QGAM))
3321 IF (QGAM.GT.QGTHR.AND.QGAM.GT.QNOW) THEN
3328 IF (QNOW.GT.ZERO) THEN
3329 C--BRANCHING HAS OCCURRED
3330 ZMIN=HWBVMC(ID2)/QNOW
3334 C--GLUON -> GLUON + GLUON
3337 ETEST=(1.-WMIN)**2*HWUALF(5-SUDORD*2,QNOW*WMIN)
3338 ZRAT=(ZMAX*(1-ZMIN))/(ZMIN*(1-ZMAX))
3339 C--CHOOSE Z1 DISTRIBUTED ON (ZMIN,ZMAX)
3340 C ACCORDING TO GLUON BRANCHING FUNCTION
3341 10 Z1=ZMAX/(ZMAX+(1-ZMAX)*ZRAT**HWRGEN(0))
3343 ZTEST=(1.-(Z1*Z2))**2*HWUALF(5-SUDORD*2,QNOW*(Z1*Z2))
3344 IF (ZTEST.LT.ETEST*HWRGEN(1)) GOTO 10
3346 ELSEIF (ID2.NE.115) THEN
3349 ETEST=ZMIN**2+ZMAX**2
3350 20 Z1=HWRUNI(0,ZMIN,ZMAX)
3353 IF (ZTEST.LT.ETEST*HWRGEN(0)) GOTO 20
3355 C--GLUON -> DIQUARKS
3358 Z1=HWRUNI(0,ZMIN,ZMAX)
3362 C--QUARK OR ANTIQUARK BRANCHING
3365 ZMAX=1.-HWBVMC(ID)/QNOW
3366 WMIN=MIN(ZMIN*(1.-ZMIN),ZMAX*(1.-ZMAX))
3367 ETEST=(1.+ZMAX**2)*HWUALF(5-SUDORD*2,QNOW*WMIN)
3369 30 Z1=ZMIN*ZRAT**HWRGEN(0)
3371 ZTEST=(1.+Z2*Z2)*HWUALF(5-SUDORD*2,QNOW*Z1*Z2)
3372 IF (ZTEST.LT.ETEST*HWRGEN(1)) GOTO 30
3375 ZMIN= HWBVMC(59)/QNOW
3376 ZMAX=1-HWBVMC(ID)/QNOW
3379 40 Z1=ZMIN*ZRAT**HWRGEN(0)
3382 IF (ZTEST.LT.ETEST*HWRGEN(1)) GOTO 40
3384 C--QUARKS EMIT ON LOWER SIDE, ANTIQUARKS ON UPPER SIDE
3395 C--UPDATE THIS BRANCH AND CREATE NEW BRANCHES
3397 IF (ID1.NE.59.AND.ID2.NE.59) THEN
3398 IF (ID.EQ.13.AND.ID1.NE.13) THEN
3403 IF (SUDORD.EQ.1.AND.HWUALF(2,QLAM).LT.HWRGEN(0) .OR.
3404 & (2.-XI)*(QNOW*Z1*Z2)**2.GT.EMSCA**2) THEN
3405 C--BRANCHING REJECTED: REDUCE Q AND REPEAT
3412 C--IF THIS IS HARDEST EMISSION SO FAR, APPLY MATRIX-ELEMENT CORRECTION
3413 IF (ID.NE.13.OR.ID1.EQ.13) THEN
3416 IF (TMPAR(2).AND.QLAM.GT.HARDST) THEN
3417 C----SOFT MATRIX-ELEMENT CORRECTION TO TOP DECAYS
3419 IF (ISTHEP(ITOP).EQ.155.AND.(IDHW(ITOP).EQ.6
3420 $ .OR.IDHW(ITOP).EQ.12)) THEN
3421 AW=(PHEP(5,JDAHEP(1,ITOP))/PHEP(5,ITOP))**2
3422 FF=0.5*(1-AW)*(1-2*AW+1/AW)
3424 X1=1-2*CC*Z*(1-Z)*XI
3425 X3=0.5*(1-AW+2*CC*Z*(1-Z)*XI-(1-2*Z)
3426 & *HWUSQR(((1+AW-2*CC*Z*(1-Z)*XI)**2-4*AW)
3427 & /(1-2*Z*(1-Z)*XI)))
3428 C-----JACOBIAN FACTOR
3429 JJ=(1-X1)*(2-AW-X1-2*X3)*(1-2*Z*(1-Z)*XI)/(
3430 $ 4*CC**2*((X1+AW)**2-4*AW)*Z**2*(1-Z)**2*(1-2*Z)*XI)
3431 C-----REJECTION FACTOR
3432 XCUT=2*GCUTME/PHEP(5,ITOP)
3433 IF (X3.GT.XCUT) REJFAC=FF*JJ
3434 & *X3**2*(1-X1)*(1+(1-Z)**2)/(Z*XI)
3435 & /((1+1/AW-2*AW)*((1-AW)*X3-(1-X1)
3436 & *(1-X3)-X3**2)+(1+1/(2*AW))*X3*(X1+X3-1)**2
3438 ELSEIF (MOD(ISTHEP(JCOPAR(1,1)),10).GE.3) THEN
3439 C---COLOUR PARTNER IS ALSO OUTGOING
3441 X2=0.5*(1+Z*(1-Z)*XI +
3442 $ (1-Z*(1-Z)*XI)*(1-2*Z)/SQRT(1-2*Z*(1-Z)*XI))
3443 REJFAC=SQRT(2*X1-1)/(X1*Z*(1-Z))
3444 $ *(1+(1-Z)**2)/(Z*XI)
3445 $ *(1-X1)*(1-X2)/(X1**2+X2**2)
3446 C---CHECK WHETHER IT IS IN THE OVERLAP REGION
3447 OTHXI=4*(1-X2)*X2**2/(X2**2-(2*X2-1)*(2*X1+X2-2)**2)
3448 IF (OTHXI.LT.ONE) THEN
3449 OTHZ=0.5*(1-SQRT(2*X2-1)/X2*(2*X1+X2-2))
3450 REJFAC=REJFAC+SQRT(2*X2-1)/(X2*OTHZ*(1-OTHZ))
3451 $ *(1+(1-OTHZ)**2)/(OTHZ*OTHXI)
3452 $ *(1-X2)*(1-X1)/(X2**2+X1**2)
3455 C---COLOUR PARTNER IS INCOMING (X1=XP, X2=ZP)
3457 X2=0.5*(1+(1-2*Z)/SQRT(1-2*Z*(1-Z)*XI))
3458 REJFAC=SQRT(3-2/X1)/(X1**2*Z*(1-Z))
3459 $ *(1+(1-Z)**2)/(Z*XI)
3461 $ (1+(1-X1-X2+2*X1*X2)**2+2*(1-X1)*(1-X2)*X1*X2)
3462 C---CHECK WHETHER IT IS IN THE OVERLAP REGION
3463 OTHXI=(SQRT(X1+2*(1-X2)*(1-X2+X1*X2))-SQRT(X1))**2/
3464 $ (1+X1-X2-SQRT(X1*(X1+2*(1-X2)*(1-X2+X1*X2))))
3465 OTHZ=(SQRT(X1*(X1+2*(1-X2)*(1-X2+X1*X2)))-X1)/(1-X2)
3466 IF (OTHXI.LT.OTHZ**2) THEN
3467 REJFAC=REJFAC+OTHZ**3*(1-X1-X2+2*X1*X2)
3468 $ /(X1**2*(1-OTHZ)*(OTHZ+OTHXI*(1-OTHZ)))
3469 $ *(1+OTHZ**2)/((1-OTHZ)*OTHXI)
3471 $ (1+(1-X1-X2+2*X1*X2)**2+2*(1-X1)*(1-X2)*X1*X2)
3475 IF (NREJ*REJFAC*HWRGEN(NREJ).GT.ONE) THEN
3481 IF (QLAM.GT.HARDST) HARDST=QLAM
3486 PPAR(1,MPAR)=QNOW*Z1
3488 PPAR(4,MPAR)=ENOW*Z1
3492 PPAR(1,NPAR)=QNOW*Z2
3494 PPAR(4,NPAR)=ENOW*Z2
3495 C---NEW MOTHER-DAUGHTER RELATIONS
3500 C---NEW COLOUR CONNECTIONS
3510 IF (QNOW.LT.ZERO) THEN
3512 IF (ID.EQ.IDPAR(2).AND.PPAR(5,2).GT.1D-6) THEN
3513 PPAR(5,KPAR)=PPAR(5,2)**2
3515 PPAR(5,KPAR)=RMASS(ID)**2
3517 PMOM=PPAR(4,KPAR)**2-PPAR(5,KPAR)
3518 IF (PMOM.LT.-1E-6) THEN
3519 CALL HWWARN('HWBRAN',104)
3522 IF (PMOM.LT.ZERO) PMOM=ZERO
3523 PPAR(3,KPAR)=SQRT(PMOM)
3532 *CMZ :- -31/03/00 17:54:05 by Peter Richardson
3533 *-- Author : Peter Richardson
3534 C-----------------------------------------------------------------------
3536 C-----------------------------------------------------------------------
3537 C SUBROUTINE TO REPLACE HWBCON IN RPARITY VIOLATING SUSY
3538 C BASED ON HWBCON BY BRW
3539 C-----------------------------------------------------------------------
3540 INCLUDE 'herwig65.inc'
3541 INTEGER IHEP,IST,ID,JC,JD,JHEP,IDP,IDM,IDM2,
3542 & RHEP,IST2,ANTC,XHEP,IP,COLP
3543 LOGICAL BVVUSE,BVVHRD,BVDEC1,BVDEC2,COLRD,ACOLRD,BVHRD,BVHRD2,
3546 C--logical functions to decide if baryon number violating
3548 BVDEC1(IP) = ((IDHW(IP).GE.419.AND.IDHW(IP).LE.424).OR.
3549 & IDHW(IP).EQ.411.OR.IDHW(IP).EQ.412.OR.
3550 & IDHW(IP).EQ.449).AND.IDHW(JDAHEP(1,IP)).LE.6.
3551 & AND.IDHW(JDAHEP(1,IP)+1).LE.6.AND.
3552 & IDHW(JDAHEP(2,IP)).LE.6
3554 BVDEC2(IP) = ((IDHW(IP).GE.413.AND.IDHW(IP).LE.418).OR.
3555 & IDHW(IP).EQ.405.OR.IDHW(IP).EQ.406.OR.
3556 & IDHW(IP).EQ.449).AND.
3557 & IDHW(JDAHEP(1,IP)).GE.7.AND.IDHW(JDAHEP(1,IP)).LE.12.AND.
3558 & IDHW(JDAHEP(1,IP)+1).GE.7.AND.IDHW(JDAHEP(1,IP)+1).LE.12.AND.
3559 & IDHW(JDAHEP(2,IP)).GE.7.AND.IDHW(JDAHEP(2,IP)).LE.12
3560 C--Neutralino and Chargino Decays
3561 BVDEC3(IP) = ((IDHW(IP).GE.450.AND.IDHW(IP).LE.457).AND.
3562 & (IDHW(JDAHEP(1,IP)).LE.12.AND.IDHW(JDAHEP(1,IP)+1).LE.12.
3563 & .AND.IDHW(JDAHEP(2,IP)).LE.12))
3564 C--Now the hard vertices
3565 BVHRD(IP) = IDHW(IP).EQ.15.AND.IDHW(JMOHEP(1,IP)).LE.12.
3566 & AND.IDHW(JMOHEP(2,IP)).LE.12.AND.IDHW(JDAHEP(1,IP)).LE.12.
3567 & AND.IDHW(JDAHEP(2,IP)).GE.449.AND.IDHW(JDAHEP(2,IP)).LE.457
3568 BVHRD2(IP) = IDHW(IP).EQ.15.AND.IDHW(JMOHEP(1,IP)).LE.12.
3569 & AND.IDHW(JMOHEP(2,IP)).LE.12.AND.IDHW(JDAHEP(1,IP)).GE.198.
3570 & AND.IDHW(JDAHEP(1,IP)).LE.207.
3571 & AND.ABS(IDHEP(JDAHEP(2,IP))).GT.1000000
3572 C--Those particles which are coloured
3573 COLRD(IP) = IP.LE.6.OR.IP.EQ.13.OR.IP.EQ.449.OR.
3574 & (IP.GE.401.AND.IP.LE.406).OR.(IP.GE.413.AND.IP.LE.418).OR.
3575 & (IP.GE.115.AND.IP.LE.120).OR.IP.EQ.59
3576 C--Those particles which are anticoloured
3577 ACOLRD(IP) = (IP.GE.7.AND.IP.LE.12).OR.IP.EQ.13.OR.IP.EQ.449.OR.
3578 & (IP.GE.407.AND.IP.LE.412).OR.(IP.GE.419.AND.IP.LE.424).OR.
3579 & (IP.GE.109.AND.IP.LE.114).OR.IP.EQ.59
3580 IF (IERROR.NE.0) RETURN
3581 C--Added 31/03/00 PR
3582 IF(NHEP.GT.NMXHEP) THEN
3583 CALL HWWARN('HWBRCN',101)
3587 IF(COLUPD.AND.HRDCOL(1,3).NE.0) THEN
3589 DO IHEP = HRDCOL(1,3),HRDCOL(1,3)+4
3592 JMOHEP(2,IHEP) = HRDCOL(1,JD)
3593 JDAHEP(2,IHEP) = HRDCOL(2,JD)
3610 C---LOOK FOR PARTONS WITHOUT COLOUR MOTHERS
3611 IF ((IST.LT.145.OR.IST.GT.152).AND.IST.NE.155) GOTO 110
3612 IF (JMOHEP(2,IHEP).EQ.0) THEN
3613 C---FIND COLOUR-CONNECTED PARTON
3614 IF(IST.EQ.155.AND.ABS(IDHEP(IHEP)).EQ.6) THEN
3616 ELSEIF(IST.EQ.155) THEN
3621 IF (IST.NE.152) JC=JMOHEP(1,JC)
3622 C--Correction for BV
3623 IF(HRDCOL(1,1).NE.0) THEN
3624 IDP = IDHW(HRDCOL(1,1))
3629 IF(BVDEC1(IDM).OR.BVDEC2(IDM)) THEN
3630 IF(IDHW(IDM).EQ.449.AND.JDAHEP(1,IDM).EQ.JC) THEN
3635 IF(JC.EQ.JD) JD= JDAHEP(2,JC-1)
3638 C--NEW FOR BV HARD PROCESS
3639 ELSEIF(BVHRD(IDM)) THEN
3640 IF(IDHW(JDAHEP(2,JMOHEP(1,JC))).EQ.449) THEN
3642 IDM2 = JDAHEP(2,HRDCOL(1,2))
3643 IF(JD.EQ.IDM2) JD = HRDCOL(1,1)
3644 IF(JC.EQ.JDAHEP(2,IDM2).AND.COLRD(IDHW(IHEP))) THEN
3646 ELSEIF(JC.EQ.IDM2) THEN
3647 IF(JDAHEP(2,JMOHEP(2,JC)).EQ.JC) THEN
3650 JMOHEP(2,IHEP)=JMOHEP(2,JC)
3657 IF(ACOLRD(IDHW(IHEP))) JC = JD
3658 IF(JC.EQ.IDM2) GOTO 110
3665 ELSEIF(BVHRD2(IDM)) THEN
3667 IF(JC.EQ.JDAHEP(2,HRDCOL(1,2))) THEN
3668 JMOHEP(2,IHEP)=JMOHEP(2,JC)
3671 IF(JD.EQ.JDAHEP(2,HRDCOL(1,2))) JD = HRDCOL(1,1)
3674 IF(JC.EQ.JDAHEP(2,HRDCOL(1,2))) THEN
3683 CALL HWWARN('HWBCON',51)
3686 C---FIND SPECTATOR WHEN JC IS DECAYED HEAVY QUARK OR SUSY PARTICLE
3687 IF (ISTHEP(JC).EQ.155) THEN
3688 IF (IDHEP(JMOHEP(1,JC)).EQ.94) THEN
3689 C---DECAYED BEFORE HADRONIZING
3697 IF(JHEP.EQ.0.AND.ABS(IDHEP(JC)).EQ.6) THEN
3698 JHEP = JMOHEP(1,JMOHEP(1,JC))
3699 IF(BVDEC1(JMOHEP(1,JHEP)).OR.BVDEC2(JMOHEP(1,JHEP))) THEN
3701 JHEP = JDAHEP(2,JC-1)
3706 IF(BVVUSE.AND.ABS(IDHEP(JHEP)).GT.1000000.AND.
3707 & ISTHEP(JHEP).NE.155.OR.JHEP.EQ.0) GOTO 110
3709 IF (ISTHEP(JHEP).EQ.155) THEN
3710 C---SPECIAL FOR GLUINO DECAYS
3715 IF(ID.LE.6.OR.ID.EQ.13.OR.
3716 & (ID.GE.115.AND.ID.LE.120)) THEN
3722 CALL HWBRC1(JC,ID,JHEP,.TRUE.,IFGO)
3724 IF(BVVUSE.AND.JMOHEP(1,JC).EQ.JMOHEP(1,JD)) JC =JD
3727 IF(COLRD(IDHW(IHEP)).AND.IDHW(JDAHEP(1,JHEP)).EQ.449)
3729 IF(BVVUSE.AND.JMOHEP(1,JC).EQ.JMOHEP(1,JD)) JC =JD
3733 IF(BVDEC2(JMOHEP(1,JHEP)).OR.JD.NE.JHEP.OR.
3734 & BVHRD(JMOHEP(1,JHEP)).OR.BVHRD2(JMOHEP(1,JHEP))) THEN
3740 IF((ID.GE.7.AND.ID.LE.12).OR.
3741 & (ID.GE.109.AND.ID.LE.114)) JMOHEP(2,JHEP)=IHEP
3744 C--new for particles connected to BV
3745 IDM = JMOHEP(1,JHEP)
3746 IF(BVDEC1(IDM).OR.BVHRD(IDM).OR.BVHRD2(IDM)) THEN
3748 IF(ABS(IDHEP(IHEP)).LT.1000000) GOTO 100
3752 C--new for top's from BV
3754 IDP = JMOHEP(1,JMOHEP(1,JMOHEP(1,JC)))
3755 IF((ID.EQ.6.AND.(BVDEC1(IDP))).
3756 & OR.(ID.EQ.12.AND.BVDEC2(IDP)).
3757 & OR.((ID.EQ.12.OR.ID.EQ.449).AND.BVHRD(IDP))) THEN
3759 IF(JDAHEP(2,JHEP).EQ.JC) JDAHEP(2,JHEP)=IHEP
3761 IF((IDHW(IHEP).GE.7.AND.IDHW(IHEP).LE.12.
3762 & AND.IDHW(JHEP).GE.7.AND.IDHW(JHEP).LE.12).OR.
3763 & (IDHW(IHEP).LE.6.AND.IDHW(JHEP).LE.6)) THEN
3767 IF((COLRD(IDHW(IHEP)).AND.ACOLRD(IDHW(JHEP))).OR.
3768 & (.NOT.COLRD(IDHW(IHEP)).AND.
3769 & .NOT.ACOLRD(IDHW(JHEP)))) THEN
3770 IF(JDAHEP(2,JHEP).EQ.0) THEN
3772 ELSEIF(JMOHEP(2,JDAHEP(2,JHEP)).NE.JHEP) THEN
3776 IF(JMOHEP(2,JHEP).EQ.JC) JMOHEP(2,JHEP)=IHEP
3788 IF(BVVUSE.AND.ABS(IDHEP(JC)).LT.1000000.AND.JC.NE.JD
3789 & .AND.JD.NE.0.AND.JD.NE.JMOHEP(1,JC)) JC = JD
3790 IF(BVVUSE.AND.ABS(IDHEP(JC)).GT.1000000) THEN
3791 IF(COLRD(IDHW(IHEP)).AND..NOT.BVVHRD) GOTO 110
3793 IF(BVVUSE.AND.ISTHEP(JC).EQ.149) JC=JMOHEP(1,JMOHEP(1,JC))
3794 C--SEARCH IN THE JET
3795 IF((ISTHEP(JC).GT.145.AND.ISTHEP(JC).LT.152).AND.
3796 & ISTHEP(IHEP).EQ.155) THEN
3800 CALL HWBRC2(COLP,IHEP,JC,.TRUE.,BVVUSE,BVVHRD)
3802 JMOHEP(2,IHEP) = COLP
3803 IF(COLRD(IDHW(IHEP)).AND.ACOLRD(IDHW(COLP)).
3804 & AND.JDAHEP(2,COLP).EQ.0)
3805 & JDAHEP(2,COLP) = IHEP
3806 IF((IDHW(IHEP).GE.7.AND.IDHW(IHEP).LE.12).AND.
3807 & (IDHW(COLP).GE.7.AND.IDHW(COLP).LE.12)) THEN
3808 IF(JMOHEP(2,COLP).EQ.0) JMOHEP(2,COLP) = IHEP
3813 C---BREAK COLOUR CONNECTIONS WITH PHOTONS modified for Rslash
3815 130 IF (IHEP.LE.NHEP) THEN
3816 IF (IDHW(IHEP).EQ.59 .AND. ISTHEP(IHEP).EQ.149.AND.
3817 & (JMOHEP(2,IHEP).NE.IHEP.OR.JDAHEP(2,IHEP).NE.IHEP)) THEN
3818 IF(JMOHEP(2,IHEP).NE.0) THEN
3819 IF (JDAHEP(2,JMOHEP(2,IHEP)).EQ.IHEP)
3820 & JDAHEP(2,JMOHEP(2,IHEP))=JDAHEP(2,IHEP)
3822 IF (JDAHEP(2,IHEP).NE.0) THEN
3823 IF (JMOHEP(2,JDAHEP(2,IHEP)).EQ.IHEP)
3824 & JMOHEP(2,JDAHEP(2,IHEP))=JMOHEP(2,IHEP)
3828 IF((IST.GE.147.AND.IST.LE.149).AND.JDAHEP(2,RHEP).EQ.IHEP)
3829 & JDAHEP(2,RHEP)=JMOHEP(2,IHEP)
3833 IF((IST.GE.147.AND.IST.LE.149).AND.JMOHEP(2,RHEP).EQ.IHEP)
3834 & JMOHEP(2,RHEP) = JDAHEP(2,IHEP)
3842 C--Update the BV anticolour corrections
3843 DO 210 IHEP=1,NHEP+1
3844 IF(IHEP.EQ.1) GOTO 210
3846 IF(IHEP.EQ.NHEP+1) THEN
3848 IF(ANTC.EQ.0.OR.(IDHW(JMOHEP(1,HRDCOL(1,2))).LE.6)) GOTO 210
3851 IF(ANTC.EQ.JDAHEP(2,XHEP)) ANTC=JDAHEP(1,JDAHEP(1,ANTC))
3852 IF(ANTC.NE.0.AND.JDAHEP(1,ANTC).NE.0) IST2=ISTHEP(ANTC)
3854 ANTC = JDAHEP(2,IHEP-1)
3855 IF(ANTC.NE.0) IST2=ISTHEP(ANTC)
3863 IF(IST.EQ.155.AND.IST2.EQ.155) THEN
3865 IF(BVDEC1(XHEP).OR.BVDEC2(XHEP).OR.BVHRD(XHEP).OR.
3866 & BVHRD2(XHEP)) THEN
3870 IF(BVDEC1(JC).OR.BVDEC2(JC)) THEN
3871 IF(IHEP.EQ.(NHEP+1)) ANTC=JDAHEP(1,JC)
3875 C--SPECIAL FOR GLUINO DECAYS
3877 IF(IHEP.EQ.NHEP+1) ID = 407
3878 CALL HWBRC1(JC,ID,JHEP,.FALSE.,IFGO)
3881 IF(IDHW(JDAHEP(1,JHEP)).EQ.449) THEN
3888 CALL HWBRC2(COLP,XHEP,JC,.FALSE.,BVVUSE,.FALSE.)
3890 IF(IHEP.LE.NHEP.AND.ACOLRD(IDHW(IHEP)).AND.
3891 & COLRD(IDHW(COLP)).AND.JMOHEP(2,COLP).EQ.0) THEN
3892 JMOHEP(2,COLP) = IHEP
3893 ELSEIF(IHEP.LE.NHEP.AND.IDHW(IHEP).LE.6.AND.
3894 & IDHW(COLP).LE.6.AND.JDAHEP(2,COLP).EQ.0) THEN
3895 JDAHEP(2,COLP) = IHEP
3896 ELSEIF(IHEP.GT.NHEP.AND.
3897 & ((BVHRD(XHEP).AND.COLRD(JDAHEP(1,XHEP))).
3898 & OR.(BVHRD2(XHEP).AND.ACOLRD(JDAHEP(2,XHEP)))).AND.
3899 & ACOLRD(IDHW(COLP)).AND.JDAHEP(2,COLP).EQ.0) THEN
3900 JDAHEP(2,COLP) = IHEP
3905 IF(IHEP.EQ.NHEP+1) THEN
3906 IF(HRDCOL(1,1).NE.ANTC.AND.ANTC.NE.0) THEN
3908 IF(JDAHEP(2,ANTC).EQ.IHEP) THEN
3909 IF(JDAHEP(2,JMOHEP(1,HRDCOL(1,2))).EQ.JDAHEP(2,HRDCOL(1,2)).
3910 & AND.JMOHEP(2,JDAHEP(2,HRDCOL(1,2))).EQ.JMOHEP(1,HRDCOL(1,2)))
3912 JDAHEP(2,ANTC) = JMOHEP(2,HRDCOL(1,2))
3914 JDAHEP(2,ANTC) = JMOHEP(1,HRDCOL(1,2))
3916 ELSEIF(JMOHEP(2,ANTC).EQ.IHEP) THEN
3917 JMOHEP(2,ANTC) = JMOHEP(1,HRDCOL(1,2))
3920 ELSEIF(IHEP.NE.1) THEN
3921 IF(JDAHEP(2,IHEP-1).NE.ANTC.AND.ANTC.NE.0) JDAHEP(2,IHEP-1)=ANTC
3924 C--Update BV decaying particles connections
3925 DO 310 IHEP=1,NHEP+1
3926 IF(IHEP.EQ.1) GOTO 310
3927 IF(IHEP.EQ.NHEP+1) THEN
3929 IF(ANTC.EQ.0.OR.IDHW(JDAHEP(1,HRDCOL(1,2))).LE.6) GOTO 310
3932 IF(ANTC.EQ.JDAHEP(2,XHEP)) ANTC=JDAHEP(1,JDAHEP(1,ANTC))
3942 IF(ANTC.NE.0.AND.IHEP.NE.NHEP+1) THEN
3943 IF(JDAHEP(1,ANTC).NE.0) IST2 = ISTHEP(ANTC)
3944 ELSEIF(ANTC.NE.0.AND.IHEP.EQ.NHEP+1) THEN
3947 IF(IST.EQ.155.AND.IST2.EQ.155) THEN
3948 IF(BVDEC2(XHEP).OR.BVHRD(XHEP).OR.BVHRD2(XHEP)) THEN
3949 C--FIND COLOUR CONNECTED PARTON
3953 IF(BVDEC2(JHEP)) THEN
3959 IF(IHEP.EQ.NHEP+1) ID = 401
3960 C--SPECIAL FOR GLUINO DECAYS
3961 CALL HWBRC1(JC,ID,JHEP,.TRUE.,IFGO)
3964 IF(IDHW(JDAHEP(1,JHEP)).EQ.449) THEN
3971 CALL HWBRC2(COLP,XHEP,JC,.TRUE.,BVVUSE,.FALSE.)
3973 IF(COLP.EQ.0) GOTO 300
3974 IF(IHEP.LE.NHEP) THEN
3975 IF(JDAHEP(2,COLP).EQ.0) THEN
3976 JDAHEP(2,COLP) = JDAHEP(2,IHEP)
3977 ELSEIF(JMOHEP(2,JDAHEP(2,COLP)).NE.COLP) THEN
3978 JDAHEP(2,COLP) = JDAHEP(2,IHEP)
3980 ELSEIF(IHEP.GT.NHEP.AND.
3981 & ((BVHRD(XHEP).AND.ACOLRD(JDAHEP(1,XHEP)).AND.
3982 & IDHW(JDAHEP(2,XHEP)).EQ.449).
3983 & OR.(BVHRD2(XHEP).AND.ACOLRD(JDAHEP(2,XHEP)))).AND.
3984 & ACOLRD(IDHW(COLP)).AND.JDAHEP(2,COLP).EQ.0) THEN
3985 JDAHEP(2,COLP) = IHEP
3990 IF(IHEP.NE.NHEP+1.AND.IHEP.NE.1) THEN
3991 IF(JMOHEP(2,IHEP).NE.ANTC.AND.ANTC.NE.0) JMOHEP(2,IHEP)=ANTC
3992 ELSEIF(IHEP.GT.NHEP) THEN
3993 IF(HRDCOL(1,1).NE.ANTC.AND.ANTC.NE.0) HRDCOL(1,1)=ANTC
3994 IF(ANTC.EQ.0) GOTO 310
3995 IF(JDAHEP(2,ANTC).EQ.IHEP) THEN
3996 IF(JDAHEP(2,JMOHEP(1,HRDCOL(1,2))).EQ.JDAHEP(2,HRDCOL(1,2)).
3997 & AND.JMOHEP(2,JDAHEP(2,HRDCOL(1,2))).EQ.JMOHEP(1,HRDCOL(1,2)))
3999 JDAHEP(2,ANTC) = JMOHEP(2,HRDCOL(1,2))
4001 JDAHEP(2,ANTC) = JMOHEP(1,HRDCOL(1,2))
4003 ELSEIF(JMOHEP(2,ANTC).EQ.IHEP) THEN
4004 JMOHEP(2,ANTC) = JMOHEP(1,HRDCOL(1,2))
4008 C--Update partons connected to decaying SUSY particle
4011 C--LOOK FOR PARTONS CONNECTED TO A DECAYING SUSY PARTICLE
4012 IF (IST.LT.145.OR.IST.GT.152) GOTO 400
4013 IF(JMOHEP(2,IHEP).EQ.0) GOTO 400
4014 IF(ISTHEP(JMOHEP(2,IHEP)).EQ.155) THEN
4015 C--FIND THE COLOUR CONNECTED PARTON
4019 IF(BVDEC2(JC).AND.IDHW(JC).NE.449) THEN
4020 IF(IDHW(IHEP).GE.7.AND.IDHW(IHEP).LE.12)
4021 & JMOHEP(2,IHEP)=JDAHEP(1,JC)
4025 C--SPECIAL FOR GLUINO DECAYS
4027 CALL HWBRC1(JC,ID,JHEP,.TRUE.,IFGO)
4031 IF(COLRD(ID).AND.IDHW(JDAHEP(1,JC)).EQ.449) THEN
4035 IF(IDHW(JHEP).EQ.6.AND.IDHW(JC).EQ.13) JC=JC-1
4039 CALL HWBRC2(COLP,IHEP,JC,.TRUE.,BVVUSE,.FALSE.)
4040 JMOHEP(2,IHEP) = COLP
4043 C--Update partons connected to decaying SUSY particle
4046 C--LOOK FOR PARTONS CONNECTED TO A DECAYING SUSY PARTICLE
4047 IF (IST.LT.145.OR.IST.GT.152) GOTO 500
4048 IF(JDAHEP(2,IHEP).EQ.0) GOTO 500
4049 IF(ISTHEP(JDAHEP(2,IHEP)).EQ.155) THEN
4050 C--FIND THE COLOUR CONNECTED PARTON
4056 C--SPECIAL FOR GLUINO DECAYS
4058 CALL HWBRC1(JC,ID,JHEP,.FALSE.,IFGO)
4061 IF(ACOLRD(IDHW(IHEP)).AND.IDHW(JDAHEP(1,JC)).EQ.449) THEN
4067 C--SEARCH IN THE JET
4068 CALL HWBRC2(COLP,IHEP,JC,.FALSE.,BVVUSE,.FALSE.)
4069 IF(COLP.NE.0) JDAHEP(2,IHEP) = COLP
4072 C--Flavour and anticolour connections in Rslash
4075 IF(IST.LT.145.OR.IST.GT.152.OR.JDAHEP(2,IHEP).NE.0) GOTO 610
4079 IF(IST.NE.152) JC = JMOHEP(1,JC)
4081 CALL HWWARN('HWBRCN',51)
4084 C--For particles which came from a top decay
4085 IF(ABS(IDHEP(JMOHEP(1,JC))).EQ.6) THEN
4086 JD = JMOHEP(1,JMOHEP(1,JMOHEP(1,JC)))
4087 C--flavour connect to self if needed
4088 IF(JDAHEP(2,JMOHEP(1,JC)-1).EQ.JMOHEP(1,JC)) THEN
4089 JDAHEP(2,IHEP) = IHEP
4091 ELSEIF(JDAHEP(2,JMOHEP(1,JC)-1).NE.0) THEN
4092 JDAHEP(2,IHEP) = JDAHEP(2,JMOHEP(1,JC)-1)
4098 C--Decide if this came from a BV decay
4100 IF(BVDEC1(IDM).OR.BVDEC2(IDM).OR.BVDEC3(IDM).
4101 & OR.BVHRD(IDM).OR.BVHRD2(IDM)) THEN
4103 IF(JDAHEP(2,JC).EQ.JMOHEP(1,JC)) THEN
4104 IF(IDHW(JMOHEP(1,JC)).EQ.449.AND.
4105 & JDAHEP(1,JMOHEP(1,JC)).EQ.JC) THEN
4106 JC = JDAHEP(2,JMOHEP(1,JC)-1)
4108 JC = JMOHEP(2,JMOHEP(1,JC))
4110 IF(ABS(IDHEP(JC)).LT.1000000) THEN
4111 IF(JDAHEP(1,JC).EQ.0) THEN
4117 ELSEIF(ABS(IDHEP(JC)).GT.1000000
4118 & .AND.ISTHEP(JC).NE.155) THEN
4121 IF(ISTHEP(JC).EQ.155.AND.ACOLRD(IDHW(IHEP))) THEN
4124 IF(ISTHEP(JC).EQ.155.AND.IDHW(JDAHEP(1,JC)).NE.449) THEN
4131 C--For the hard process
4132 IF(IDHW(IDM).EQ.15.AND.JC.EQ.JDAHEP(2,JMOHEP(1,JC))) THEN
4133 JDAHEP(2,IHEP) = JDAHEP(2,JC)
4135 ELSEIF(IDHW(IDM).EQ.15.AND.IDHW(IHEP).NE.449) THEN
4137 IF(BVHRD(IDM).AND.IDHW(JDAHEP(2,IDM)).NE.449) THEN
4140 ELSEIF(JMOHEP(1,JDAHEP(2,JC)).EQ.JD) THEN
4144 IF(JDAHEP(2,JC).EQ.8) JC = JD
4146 JD=JMOHEP(2,JMOHEP(1,JC))
4148 IF(COLRD(IDHW(IHEP)).AND..NOT.ACOLRD(IDHW(IHEP)).AND.
4149 & ABS(IDHEP(JD)).GT.1000000.AND.ISTHEP(JD).NE.155) THEN
4151 IF(JDAHEP(2,JD).EQ.0) JDAHEP(2,JD) = IHEP
4153 IF(ABS(IDHEP(JD)).GT.1000000
4154 & .AND.ISTHEP(JD).NE.155) GOTO 610
4155 IF(ISTHEP(JC).EQ.149) THEN
4159 IF(ACOLRD(IDHW(IHEP)).AND.IDHW(JC).EQ.449.AND.BVDEC2(JC)) THEN
4165 C--SEARCH IN THE JET
4166 600 CALL HWBRC2(COLP,IHEP,JC,.FALSE.,BVVUSE,.FALSE.)
4168 IF(ABS(IDHEP(COLP)).EQ.6.AND.JDAHEP(1,COLP).NE.0) THEN
4169 IF(ISTHEP(COLP).EQ.155) THEN
4172 JC = JDAHEP(2,JDAHEP(2,COLP))
4176 JDAHEP(2,IHEP) = COLP
4179 C--check if it came from a top
4180 IF(ABS(IDHEP(JC)).EQ.6) THEN
4181 C--start the analysis again
4183 IF(IST.NE.152) JC = JMOHEP(1,JC)
4186 CALL HWWARN('HWBRCN',52)
4189 IF(ISTHEP(JC).EQ.155) THEN
4190 IF (IDHEP(JMOHEP(1,JC)).EQ.94) THEN
4191 C---DECAYED BEFORE HADRONIZING
4193 IF (JHEP.EQ.0) GO TO 610
4195 IF (ISTHEP(JHEP).EQ.155) THEN
4196 C---SPECIAL FOR GLUINO DECAYS
4198 CALL HWBRC1(JC,ID,JHEP,.TRUE.,IFGO)
4204 IF(JMOHEP(2,JHEP).EQ.JC) JMOHEP(2,JHEP)=IHEP
4205 JDAHEP(2,IHEP) = JHEP
4213 CALL HWBRC2(COLP,IHEP,JC,.FALSE.,BVVUSE,.FALSE.)
4214 IF(COLP.NE.0) JDAHEP(2,IHEP) = COLP
4216 IF(ISTHEP(JMOHEP(1,JC)).EQ.155
4217 & .AND.IDHW(JC).LE.6) THEN
4218 JDAHEP(2,IHEP) = JDAHEP(2,JMOHEP(1,JC)-1)
4219 IF(JDAHEP(2,IHEP).NE.0) GOTO 610
4221 CALL HWWARN('HWBRCN',100)
4229 *CMZ :- -20/07/99 10:56:12 by Peter Richardson
4230 *-- Author : PeterRichardson
4231 C-----------------------------------------------------------------------
4232 SUBROUTINE HWBRC1(JC,ID,JHEP,COL,IFGO)
4233 C-----------------------------------------------------------------------
4234 C--Function to find the right daugther of a decaying gluino
4235 C-----------------------------------------------------------------------
4236 INCLUDE 'herwig65.inc'
4237 INTEGER ID,JHEP,KC,JC
4239 C---N.B. WILL NEED MODS WHEN SUSY PARTICLES CAN SHOWER
4240 C--Rparity take the first daughther
4242 IF(IDHW(JDAHEP(1,JHEP)).LE.12.AND.IDHW(JDAHEP(1,JHEP)+1).LE.12
4243 & .AND.IDHW(JDAHEP(2,JHEP)).LE.12) THEN
4246 ELSEIF ((COL.AND.(ID.EQ.449.OR.ID.EQ.13)).OR.
4247 & (ID.GE.401.AND.ID.LE.406).OR.
4248 & (ID.GE.413.AND.ID.LE.418).OR.ID.LE.6.OR.
4249 & (ID.GE.115.AND.ID.LE.120)) THEN
4250 C---LOOK FOR ANTI(S)QUARK OR GLUON
4251 DO KC=JDAHEP(1,JHEP),JDAHEP(2,JHEP)
4253 IF ((ID.GE.7.AND.ID.LE.13).OR.(ID.GE.407.AND.ID.LE.412).OR.
4254 & (ID.GE.419.AND.ID.LE.424)) GOTO 20
4257 C---LOOK FOR (S)QUARK OR GLUON
4258 DO KC=JDAHEP(1,JHEP),JDAHEP(2,JHEP)
4260 IF (ID.LE. 6.OR. ID.EQ. 13.OR.(ID.GE.401.AND.ID.LE.406).OR.
4261 & (ID.GE.413.AND.ID.LE.418)) GOTO 20
4264 C---COULDNT FIND ONE
4265 CALL HWWARN('HWBRC1',100)
4271 *CMZ :- -20/07/99 10:56:12 by Peter Richardson
4272 *-- Author : Peter Richardson
4273 C-----------------------------------------------------------------------
4274 SUBROUTINE HWBRC2(COLP,IHEP,JC,CON,BVVUSE,BVVHRD)
4275 C-----------------------------------------------------------------------
4276 C--Function to search in the jet for the particle
4277 C-----------------------------------------------------------------------
4278 INCLUDE 'herwig65.inc'
4279 INTEGER JC,JD,QHEP,LHEP,IHEP,JHEP,IDM,NCOUNT,ID,IP,IDM2,COLP
4280 LOGICAL CON,BVVUSE,FLA,AFLA,BVVHRD
4281 FLA(IP) = (IP.LE.6.OR.(IP.GE.115.AND.IP.LE.120).
4282 & OR.(IP.GE.401.AND.IP.LE.406).
4283 & OR.(IP.GE.413.AND.IP.LE.418))
4284 AFLA(IP) = ((IP.LE.12.AND.IP.GE.7).OR.(IP.GE.109.AND.IP.LE.114).
4285 & OR.(IP.GE.407.AND.IP.LE.412).
4286 & OR.(IP.GE.419.AND.IP.LE.424))
4289 C--begining and end of jet
4290 IF(JDAHEP(1,JC).NE.0) THEN
4300 C--SEARCH FOR A COLOUR PARTNER
4303 IF (ISTHEP(JHEP).LT.145.OR.ISTHEP(JHEP).GT.152) GOTO 110
4304 IF(AFLA(ID).AND.IDM.EQ.13) GOTO 110
4305 IF (JDAHEP(2,JHEP).EQ.IHEP) LHEP=JHEP
4306 IF ((BVVUSE.AND.JMOHEP(2,JHEP).NE.0).OR.
4307 & (.NOT.BVVUSE.AND.JDAHEP(2,JHEP).NE.0)) GOTO 110
4308 IF(BVVUSE.AND.ABS(IDHEP(JHEP)).GT.1000000) THEN
4309 IF(BVVHRD.AND.AFLA(ID)) THEN
4316 & ((FLA(ID).OR.ID.EQ.13.OR.ID.EQ.449).AND.AFLA(IDM)).
4317 & OR.(AFLA(ID).AND.(FLA(IDM).OR.IDM.EQ.13.OR.IDM.EQ.449))))
4319 IF(AFLA(ID).AND.(IDM.EQ.59.OR.IDM.EQ.449.OR.IDM.EQ.13)) GOTO 110
4320 C---JOIN IHEP AND JHEP
4322 IF(BVVUSE.OR.(ID.GE.7.AND.ID.LE.12.
4323 & AND.((IDM.GE.7.AND.IDM.LE.12)))) RETURN
4324 IF(IHEP.NE.HRDCOL(1,2).AND.
4325 & (((FLA(ID).OR.ID.EQ.13.OR.ID.EQ.449.OR.ID.EQ.59)
4326 & .AND.(AFLA(IDM).OR.IDM.EQ.13.OR.IDM.EQ.449.OR.IDM.EQ.59))
4327 & .OR.(AFLA(ID).AND.(FLA(IDM).OR.IDM.EQ.59))))
4328 & JDAHEP(2,JHEP)=IHEP
4331 IF (LHEP.NE.0) COLP=LHEP
4332 C--Additional Baryon number violating piece
4335 IF(JMOHEP(1,JC).LT.6) THEN
4338 ELSEIF(IDM2.GT.6) THEN
4342 IF(IHEP.EQ.HRDCOL(1,2).OR.
4343 & ((FLA(ID).OR.ID.EQ.13.OR.ID.EQ.449.OR.ID.EQ.15.OR.ID.EQ.59)
4344 & .AND.(AFLA(IDM2).OR.IDM2.EQ.13.OR.IDM2.EQ.13))) THEN
4347 IF(IDHEP(QHEP).EQ.0) GOTO 12
4348 IF(IDHW(QHEP).EQ.59) THEN
4349 IF(JC.EQ.JD.AND.IDHW(JMOHEP(1,QHEP)).EQ.59) THEN
4357 11 IF(JDAHEP(2,QHEP).NE.0) THEN
4358 IF(JMOHEP(2,JDAHEP(2,QHEP)).EQ.QHEP.AND.
4359 & JDAHEP(2,QHEP).NE.QHEP) THEN
4360 IF(JDAHEP(2,QHEP).GE.JC.AND.JDAHEP(2,QHEP).LE.JD) THEN
4361 QHEP = JDAHEP(2,QHEP)
4363 IF(NCOUNT.LT.NHEP) GOTO 11
4370 IF(IDHEP(QHEP).EQ.0) GOTO 13
4371 IF(IDHW(QHEP).EQ.59) THEN
4372 IF(JC.EQ.JD.AND.IDHW(JMOHEP(1,QHEP)).EQ.59) THEN
4380 9 IF(JMOHEP(2,QHEP).NE.0) THEN
4381 IF(JDAHEP(2,JMOHEP(2,QHEP)).EQ.QHEP.AND.
4382 & JMOHEP(2,QHEP).NE.QHEP) THEN
4383 IF(JMOHEP(2,QHEP).GE.JC.AND.JMOHEP(2,QHEP).LE.JD) THEN
4384 QHEP = JMOHEP(2,QHEP)
4386 IF(NCOUNT.LT.NHEP) GOTO 9
4391 IF(ABS(IDHEP(QHEP)).LT.1000000) COLP=QHEP
4394 C--Search for an anticolour partner
4396 IF (ISTHEP(JHEP).LT.145.OR.ISTHEP(JHEP).GT.152) GOTO 210
4397 IF (JMOHEP(2,JHEP).EQ.IHEP) LHEP=JHEP
4398 IF (JMOHEP(2,JHEP).NE.0) GOTO 210
4399 C---JOIN IHEP AND JHEP
4403 IF (LHEP.NE.0) COLP=LHEP
4407 IF(JMOHEP(1,JC).LT.6) THEN
4410 ELSEIF(IDM2.GT.6) THEN
4414 C--Additional Baryon number violating piece
4415 IF((FLA(ID).AND.AFLA(IDM2)).OR.
4416 & ((AFLA(ID).OR.ID.EQ.13.OR.ID.EQ.449.OR.ID.EQ.15.OR.ID.EQ.59)
4417 & .AND.(FLA(IDM2).OR.IDM2.EQ.13.OR.IDM2.EQ.449)
4418 & .AND..NOT.(IDHW(JMOHEP(1,JC)).EQ.13.AND.
4419 & IDHW(JMOHEP(1,JMOHEP(1,JC))).EQ.12.AND.
4420 & ISTHEP(JMOHEP(1,JMOHEP(1,JC))).EQ.155)
4422 C--special for gluino decay to gluon
4423 IF(ID.EQ.449.AND.IDHW(JMOHEP(1,JMOHEP(1,JC))).EQ.449.AND.
4424 & IDHW(JMOHEP(1,JC)).EQ.13) RETURN
4427 IF(IDHEP(QHEP).EQ.0) GOTO 211
4428 IF(IDHW(QHEP).EQ.59) THEN
4429 IF(JC.EQ.JD.AND.IDHW(JMOHEP(1,QHEP)).EQ.59) THEN
4437 209 IF(JMOHEP(2,QHEP).NE.0) THEN
4438 IF(JDAHEP(2,JMOHEP(2,QHEP)).EQ.QHEP.AND.
4439 & JMOHEP(2,QHEP).NE.QHEP) THEN
4440 IF(JMOHEP(2,QHEP).GE.JC.AND.JMOHEP(2,QHEP).LE.JD) THEN
4441 QHEP = JMOHEP(2,QHEP)
4443 IF(NCOUNT.LT.NHEP) GOTO 209
4447 IF(QHEP.NE.0) COLP=QHEP
4448 IF(JDAHEP(2,QHEP).EQ.0.AND.IHEP.NE.6) THEN
4450 IF(FLA(IHEP).AND.FLA(QHEP).OR.
4451 & ((AFLA(IHEP).OR.ID.EQ.13.OR.ID.EQ.449).AND.
4452 & (AFLA(QHEP).OR.IDM2.EQ.13.OR.IDM2.EQ.449)))
4453 & JDAHEP(2,QHEP)=IHEP
4458 IF(IDHEP(QHEP).EQ.0) GOTO 220
4459 IF(IDHW(QHEP).EQ.59) THEN
4460 IF(JC.EQ.JD.AND.IDHW(JMOHEP(1,QHEP)).EQ.59) THEN
4468 219 IF(JDAHEP(2,QHEP).NE.0) THEN
4469 IF(JMOHEP(2,JDAHEP(2,QHEP)).EQ.QHEP) THEN
4470 IF(JDAHEP(2,QHEP).GE.JC.AND.JDAHEP(2,QHEP).LE.JD) THEN
4471 QHEP = JDAHEP(2,QHEP)
4473 IF(NCOUNT.LT.200) GOTO 219
4477 IF(QHEP.NE.0) COLP=QHEP
4479 IF(JDAHEP(2,QHEP).EQ.0.AND.
4480 & (((AFLA(ID).OR.ID.EQ.13).AND.(AFLA(IDM2).OR.IDM2.EQ.13)).OR.
4481 & (FLA(ID).AND.FLA(IDM2)))) JDAHEP(2,QHEP)=IHEP
4487 *CMZ :- -26/04/91 14.26.44 by Federico Carminati
4488 *-- Author : Ian Knowles
4489 C-----------------------------------------------------------------------
4491 C-----------------------------------------------------------------------
4492 C Constructs time-like 4-momenta & production vertices in space-like
4493 C jet started by parton no.2 interference partner 1 and spin density
4494 C DECPAR(2). RHOPAR(2) gives the jet spin density matrix.
4495 C See I.G. Knowles, Comp. Phys. Comm. 58 (90) 271.
4496 C-----------------------------------------------------------------------
4497 INCLUDE 'herwig65.inc'
4498 DOUBLE PRECISION HWRGEN,DMIN,PT,EIKON,EISCR,EINUM,EIDEN1,EIDEN2,
4499 & WT,SPIN,Z1,Z2,TR,PRMAX,CX,SX,CAZ,ROHEP(3),RMAT(3,3),ZERO2(2)
4500 INTEGER IPAR,JPAR,KPAR,LPAR,MPAR,JSTR,LSTR,MSTR
4504 DATA ZERO2,DMIN/2*0D0,1D-15/
4505 IF (IERROR.NE.0) RETURN
4509 CALL HWVZRO(2,RHOPAR(1,2))
4512 C Generate azimuthal angle of JPAR's branching using an M-function
4513 C Find the daughters of JPAR, with LPAR time-like
4514 10 LPAR=JDAPAR(1,JPAR)
4515 IF (TMPAR(LPAR)) THEN
4522 CALL HWUROT(PPAR(1,JPAR), ONE,ZERO,RMAT)
4523 CALL HWUROF(RMAT,PPAR(1,KPAR),ROHEP)
4524 PT=MAX(SQRT(ROHEP(1)*ROHEP(1)+ROHEP(2)*ROHEP(2)),DMIN)
4526 EICOR=AZSOFT.AND.IDPAR(LPAR).EQ.13
4528 IF (ABS(PPAR(5,MPAR)).LT.DMIN) THEN
4531 EISCR=ONE-(PPAR(5,MPAR)/PPAR(4,MPAR))**2
4532 & /MIN(PPAR(2,LPAR),PPAR(2,MPAR))
4534 EINUM=PPAR(4,KPAR)*PPAR(4,LPAR)*ABS(PPAR(2,LPAR)-PPAR(2,MPAR))
4535 EIDEN1=PPAR(4,KPAR)*PPAR(4,LPAR)-ROHEP(3)*PPAR(3,LPAR)
4536 EIDEN2=PT*ABS(PPAR(1,LPAR))
4537 EIKON=MAX(EISCR+EINUM/MAX(EIDEN1-EIDEN2,DMIN),ZERO)
4542 IF (AZSPIN.AND.IDPAR(JPAR).EQ.13) THEN
4543 Z1=PPAR(4,JPAR)/PPAR(4,MPAR)
4545 IF (IDPAR(MPAR).EQ.13) THEN
4546 TR=Z1/Z2+Z2/Z1+Z1*Z2
4547 ELSEIF (IDPAR(MPAR).LT.13) THEN
4548 TR=(ONE+Z2**2)/(TWO*Z1)
4552 C Assign the azimuthal angle
4553 PRMAX=(1.+ABS(WT))*EIKON
4554 50 CALL HWRAZM( ONE,CX,SX)
4555 CALL HWUROT(PPAR(1,JPAR),CX,SX,RMAT)
4556 C Determine the angle between the branching planes
4557 CALL HWUROF(RMAT,PPAR(1,KPAR),ROHEP)
4559 PHIPAR(1,JPAR)=2.*CAZ*CAZ-1.
4560 PHIPAR(2,JPAR)=2.*CAZ*ROHEP(2)/PT
4561 IF (EICOR) EIKON=MAX(EISCR+EINUM/MAX(EIDEN1-EIDEN2*CAZ,DMIN),ZERO)
4562 IF (AZSPIN) SPIN=1.+WT*(DECPAR(1,JPAR)*PHIPAR(1,JPAR)
4563 & +DECPAR(2,JPAR)*PHIPAR(2,JPAR))
4564 IF (SPIN*EIKON.LT.HWRGEN(0)*PRMAX) GOTO 50
4565 C Construct full 4-momentum of LPAR, sum P-trans of MPAR
4568 CALL HWUROB(RMAT,PPAR(1,LPAR),PPAR(1,LPAR))
4569 CALL HWVDIF(2,PPAR(1,2),PPAR(1,LPAR),PPAR(1,2))
4570 C Test for end of space-like branches
4571 IF (JDAPAR(1,MPAR).EQ.0) GOTO 60
4572 C Generate new Decay matrix
4573 CALL HWBAZF(MPAR,JPAR,ZERO2,DECPAR(1,JPAR),
4574 & PHIPAR(1,JPAR),DECPAR(1,MPAR))
4575 C Advance along the space-like branch
4579 C Retreat along space-like line
4580 C Assign initial spin density matrix
4582 CALL HWVEQU(2,ZERO2,RHOPAR(1,MPAR))
4583 CALL HWUMAS(PPAR(1,2))
4584 CALL HWVZRO(4,VPAR(1,MPAR))
4591 CALL HWVEQU(4,VPAR(1,MPAR),VPAR(1,LPAR))
4592 IF (MPAR.EQ.2) RETURN
4593 C Construct spin density matrix for time-like branch
4594 CALL HWBAZF(MPAR,JPAR,RHOPAR(1,MPAR),PHIPAR(1,JPAR),
4595 & DECPAR(1,JPAR),RHOPAR(1,LPAR))
4596 C Evolve time-like side branch
4597 CALL HWBTIM(LPAR,MPAR)
4598 C Construct spin density matrix for space-like branch
4599 CALL HWBAZF(MPAR,JPAR,PHIPAR(1,JPAR),RHOPAR(1,MPAR),
4600 & DECPAR(1,LPAR),RHOPAR(1,JPAR))
4601 C Assign production vertex to J
4602 CALL HWVDIF(4,PPAR(1,MPAR),PPAR(1,LPAR),PPAR(1,JPAR))
4603 CALL HWUDKL(IDPAR(JPAR),PPAR(1,JPAR),VPAR(1,JPAR))
4604 CALL HWVSUM(4,VPAR(1,MPAR),VPAR(1,JPAR),VPAR(1,JPAR))
4605 C Find parent and partner of MPAR
4608 C BRW modified here 19/06/01 to avoid compiler-dependent bug
4609 C (overwriting of JPAR etc.)
4612 IF (JPAR.EQ.KPAR) THEN
4623 *CMZ :- -26/04/91 11.11.54 by Bryan Webber
4624 *-- Author : Ian Knowles
4625 C-----------------------------------------------------------------------
4627 C-----------------------------------------------------------------------
4628 C Constructs appropriate spin density/decay matrix for parton
4629 C in hard subprocess, otherwise zero. Assignments based upon
4630 C Comp. Phys. Comm. 58 (1990) 271.
4631 C-----------------------------------------------------------------------
4632 INCLUDE 'herwig65.inc'
4633 DOUBLE PRECISION C,V12,V23,V13,TR,C1,C2,C3,R1(2),R2(2)
4636 IF (IERROR.NE.0) RETURN
4637 IST=MOD(ISTHEP(NEVPAR),10)
4638 C Assumed partons processed in the order IST=1,2,3,4
4639 IF (IPROC.GE.100.AND.IPROC.LE.116) THEN
4640 C An e+e- ---> qqbar g event
4641 IF (IDPAR(2).EQ.13) THEN
4646 ELSEIF (IPRO.EQ.15.OR.IPRO.EQ.17) THEN
4647 IF (IHPRO.EQ. 7.OR.IHPRO.EQ. 8.OR.
4648 & IHPRO.EQ.10.OR.IHPRO.EQ.11.OR.
4649 & IHPRO.EQ.15.OR.IHPRO.EQ.16.OR.
4650 & (IHPRO.GE.21.AND.IHPRO.LE.31)) THEN
4651 C A hard 2 --- > 2 QCD subprocess involving gluons
4653 CALL HWVEQU(2,RHOPAR(1,2),R1(1))
4658 ELSEIF (IST.EQ.3) THEN
4659 CALL HWVEQU(2,RHOPAR(1,2),R2(1))
4660 V12=R1(1)*R2(1)+R1(2)*R2(2)
4661 TR=1./(GCOEF(1)+GCOEF(2)*V12)
4662 RHOPAR(1,2)= (GCOEF(3)*R1(1)+GCOEF(4)*R2(1))*TR
4663 RHOPAR(2,2)=-(GCOEF(3)*R1(2)+GCOEF(4)*R2(2))*TR
4665 ELSEIF (IST.EQ.4) THEN
4666 V13=R1(1)*DECPAR(1,2)+R1(2)*DECPAR(2,2)
4667 V23=R2(1)*DECPAR(1,2)+R2(2)*DECPAR(2,2)
4668 TR=1./(GCOEF(1)+GCOEF(2)*V12+GCOEF(3)*V13+GCOEF(4)*V23)
4669 C1=(GCOEF(2)+GCOEF(5))*TR
4670 C2=(GCOEF(3)+GCOEF(6))*TR
4671 C3=(GCOEF(4)+GCOEF(6))*TR
4672 RHOPAR(1,2)=C1*DECPAR(1,2)+C2*R2(1)+C3*R1(1)
4673 RHOPAR(2,2)=C1*DECPAR(2,2)-C2*R1(2)-C3*R2(2)
4677 ELSEIF ((IPRO.EQ.16).OR.(IPRO.EQ.36)) THEN
4678 C A gluon fusion ---> Higgs event
4680 IF (IHIGGS.NE.4) THEN
4681 DECPAR(1,2)=RHOPAR(1,2)
4682 DECPAR(2,2)=-RHOPAR(2,2)
4684 DECPAR(1,2)=-RHOPAR(1,2)
4685 DECPAR(2,2)=RHOPAR(2,2)
4689 ELSEIF (IPRO.EQ.42) THEN
4690 C A gluon fusion (or qq-bar annihilation) ---> graviton production event
4692 DECPAR(1,2)=RHOPAR(1,2)
4693 DECPAR(2,2)=RHOPAR(2,2)
4697 CALL HWVZRO(2,RHOPAR(1,2))
4698 CALL HWVZRO(2,DECPAR(1,2))
4701 *CMZ :- -13/07/92 20.15.54 by Mike Seymour
4702 *-- Author : Bryan Webber, modified by Mike Seymour
4703 C-----------------------------------------------------------------------
4704 FUNCTION HWBSU1(ZLOG)
4705 C-----------------------------------------------------------------------
4706 C Z TIMES THE INTEGRAND IN EXPONENT OF QUARK SUDAKOV FORM FACTOR.
4707 C HWBSU1 IS FOR UPPER PART OF Z INTEGRATION REGION
4708 C-----------------------------------------------------------------------
4710 DOUBLE PRECISION HWBSU1,HWBSUL,Z,ZLOG,U
4714 HWBSU1=HWBSUL(Z)*(1.+U*U)
4717 *CMZ :- -13/07/92 20.15.54 by Mike Seymour
4718 *-- Author : Bryan Webber, modified by Mike Seymour
4719 C-----------------------------------------------------------------------
4721 C-----------------------------------------------------------------------
4722 C INTEGRAND IN EXPONENT OF QUARK SUDAKOV FORM FACTOR.
4723 C HWBSU2 IS FOR LOWER PART OF Z INTEGRATION REGION
4724 C-----------------------------------------------------------------------
4726 DOUBLE PRECISION HWBSU2,HWBSUL,Z,U
4729 HWBSU2=HWBSUL(Z)*(1.+Z*Z)/U
4732 *CMZ :- -14/07/92 13.28.23 by Mike Seymour
4733 *-- Author : Bryan Webber
4734 C-----------------------------------------------------------------------
4736 C-----------------------------------------------------------------------
4737 C COMPUTES (OR READS) TABLES OF SUDAKOV FORM FACTORS
4738 C-----------------------------------------------------------------------
4739 INCLUDE 'herwig65.inc'
4740 DOUBLE PRECISION HWUGAU,HWBVMC,HWBSUG,HWBSU1,HWBSU2,G1,G2,QRAT,
4741 & QLAM,POWER,AFAC,QMIN,QFAC,QNOW,ZMIN,ZMAX,Q1,QCOLD,VGOLD,VQOLD,
4742 & RMOLD(6),ACOLD,ZLO,ZHI
4743 INTEGER IQ,IS,L1,L2,L,LL,I,INOLD,NQOLD,NSOLD,NCOLD,NFOLD,SDOLD
4744 EXTERNAL HWUGAU,HWBVMC,HWBSUG,HWBSU1,HWBSU2
4745 SAVE NQOLD,NSOLD,NCOLD,NFOLD,SDOLD,QCOLD,VGOLD,VQOLD,RMOLD,ACOLD,
4747 COMMON/HWSINT/QRAT,QLAM
4748 IF (LRSUD.EQ.0) THEN
4749 POWER=1./FLOAT(NQEV-1)
4752 QFAC=(1.1*QLIM/QMIN)**POWER
4755 C--IS=1 FOR GLUON->GLUON+GLUON FORM FACTOR
4757 QNOW=QFAC*QEV(IQ-1,1)
4765 IF (I.NE.6) ZLO=MAX(ZLO,QG/RMASS(I+1))
4766 IF (I.NE.3) ZHI=MIN(ZHI,QG/RMASS(I))
4767 IF (ZHI.GT.ZLO) G1=G1+HWUGAU(HWBSUG,LOG(ZLO),LOG(ZHI),ACCUR)
4769 SUD(IQ,1)=EXP(AFAC*G1)
4772 C--QUARK FORM FACTORS.
4773 C--IS=2,3,4,5,6,7 FOR U/D,S,C,B,T,V
4776 IF (IS.EQ.7) Q1=HWBVMC(209)
4778 IF (QMIN.GT.QLIM) GOTO 15
4779 QFAC=(1.1*QLIM/QMIN)**POWER
4783 QNOW=QFAC*QEV(IQ-1,IS)
4792 IF (I.NE.6) ZLO=MAX(ZLO,QG/RMASS(I+1))
4793 IF (I.NE.3) ZHI=MIN(ZHI,QG/RMASS(I))
4794 IF (ZHI.GT.ZLO) G1=G1+HWUGAU(HWBSU1,LOG(ZLO),LOG(ZHI),ACCUR)
4803 IF (I.NE.6) ZLO=MAX(ZLO,Q1/RMASS(I+1))
4804 IF (I.NE.3) ZHI=MIN(ZHI,Q1/RMASS(I))
4805 IF (ZHI.GT.ZLO) G2=G2+HWUGAU(HWBSU2,ZLO,ZHI,ACCUR)
4807 SUD(IQ,IS)=EXP(AFAC*(G1+G2))
4821 16 RMOLD(IS)=RMASS(IS)
4823 IF (LRSUD.GT.0) THEN
4824 IF (IPRINT.NE.0) WRITE (6,17) LRSUD
4825 17 FORMAT(/10X,'READING SUDAKOV TABLE ON UNIT',I4)
4826 OPEN(UNIT=LRSUD,FORM='UNFORMATTED',STATUS='UNKNOWN')
4827 READ(UNIT=LRSUD) QCOLD,VGOLD,VQOLD,RMOLD,
4828 & ACOLD,QEV,SUD,INOLD,NQOLD,NSOLD,NCOLD,NFOLD,SDOLD
4831 C---CHECK THAT RELEVANT PARAMETERS ARE UNCHANGED
4832 IF (QCDLAM.NE.QCOLD) CALL HWWARN('HWBSUD',501)
4833 IF (VGCUT .NE.VGOLD) CALL HWWARN('HWBSUD',502)
4834 IF (VQCUT .NE.VQOLD) CALL HWWARN('HWBSUD',503)
4835 IF (ACCUR .NE.ACOLD) CALL HWWARN('HWBSUD',504)
4836 IF (INTER .NE.INOLD) CALL HWWARN('HWBSUD',505)
4837 IF (NQEV .NE.NQOLD) CALL HWWARN('HWBSUD',506)
4838 IF (NSUD .NE.NSOLD) CALL HWWARN('HWBSUD',507)
4839 IF (NCOLO .NE.NCOLD) CALL HWWARN('HWBSUD',508)
4840 IF (NFLAV .NE.NFOLD) CALL HWWARN('HWBSUD',509)
4841 IF (SUDORD.NE.SDOLD) CALL HWWARN('HWBSUD',510)
4842 C---CHECK MASSES AND THAT TABLES ARE BIG ENOUGH FOR THIS RUN
4844 IF (RMASS(IS).NE.RMOLD(IS))
4845 & CALL HWWARN('HWBSUD',510+IS)
4846 IF (QEV(NQEV,IS).LT.QLIM.AND.HWBVMC(IS)+QG.LT.QLIM)
4847 & CALL HWWARN('HWBSUD',500)
4850 IF (LWSUD.GT.0) THEN
4851 IF (IPRINT.NE.0) WRITE (6,19) LWSUD
4852 19 FORMAT(/10X,'WRITING SUDAKOV TABLE ON UNIT',I4)
4853 OPEN (UNIT=LWSUD,FORM='UNFORMATTED',STATUS='UNKNOWN')
4854 WRITE(UNIT=LWSUD) QCDLAM,VGCUT,VQCUT,(RMASS(I),I=1,6),
4855 & ACCUR,QEV,SUD,INTER,NQEV,NSUD,NCOLO,NFLAV,SUDORD
4858 IF (IPRINT.GT.2) THEN
4859 C--PRINT EXTRACTS FROM TABLES OF FORM FACTORS
4862 20 FORMAT(1H1//10X,'EXTRACT FROM TABLE OF SUDAKOV FORM FACTOR NO.',
4863 & I2,' (',I5,' ACTUAL ENTRIES)'//10X,'SUD IS PROBABILITY THAT',
4864 & ' PARTON WITH GIVEN UPPER LIMIT ON Q WILL REACH THRESHOLD',
4865 & ' WITHOUT BRANCHING'///2X,8(' Q SUD ')/)
4871 WRITE(6,30) (QEV(I,IS),SUD(I,IS),I=L,LL,L2)
4872 30 FORMAT(2X,8(F9.2,F7.4))
4879 *CMZ :- -13/07/92 20.15.54 by Mike Seymour
4880 *-- Author : Bryan Webber, modified by Mike Seymour
4881 C-----------------------------------------------------------------------
4882 FUNCTION HWBSUG(ZLOG)
4883 C-----------------------------------------------------------------------
4884 C Z TIMES INTEGRAND IN EXPONENT OF GLUON SUDAKOV FORM FACTOR
4885 C-----------------------------------------------------------------------
4887 DOUBLE PRECISION HWBSUG,HWBSUL,Z,ZLOG,W
4891 HWBSUG=HWBSUL(Z)*(W-2.+1./W)*Z
4894 *CMZ :- -13/07/92 20.15.54 by Mike Seymour
4895 *-- Author : Mike Seymour
4896 C-----------------------------------------------------------------------
4898 C-----------------------------------------------------------------------
4899 C LOGARITHMIC PART OF INTEGRAND IN EXPONENT OF SUDAKOV FORM FACTOR.
4900 C THE SECOND ORDER ALPHAS CASE COMES FROM CONVERTING INTEGRAL OVER
4901 C Q^2 INTO ONE OVER ALPHAS, WITH FLAVOUR THRESHOLDS.
4902 C-----------------------------------------------------------------------
4903 INCLUDE 'herwig65.inc'
4904 DOUBLE PRECISION HWBSUL,HWUALF,Z,QRAT,QLAM,U,AL,BL,QNOW,QMIN,
4905 & BET(6),BEP(6),MUMI(6),MUMA(6),ALMI(6),ALMA(6),FINT(6),ALFINT,
4906 & MUMIN,MUMAX,ALMIN,ALMAX
4910 SAVE FIRST,BET,BEP,MUMI,MUMA
4911 COMMON/HWSINT/QRAT,QLAM
4913 ALFINT(AL,BL)=1/BET(NF)*
4914 & LOG(BL/(AL*(1+BEP(NF)*BL))*(1+BEP(NF)*AL))
4917 IF (SUDORD.EQ.1) THEN
4920 HWBSUL=LOG(1.-AL/BL)
4924 BET(NF)=(11*CAFAC-2*NF)/(12*PIFAC)
4925 BEP(NF)=(17*CAFAC**2-(5*CAFAC+3*CFFAC)*NF)/(24*PIFAC**2)
4932 ALMI(NF)=HWUALF(1,MUMI(NF))
4938 MUMA(NF)=RMASS(NF+1)
4939 ALMA(NF)=HWUALF(1,MUMA(NF))
4941 IF (NF.NE.3.AND.NF.NE.6) FINT(NF)=ALFINT(ALMI(NF),ALMA(NF))
4949 IF (MUMAX.LE.MUMIN) RETURN
4950 ALMIN=HWUALF(1,MUMIN)
4951 ALMAX=HWUALF(1,MUMAX)
4953 20 IF (MUMIN.GT.MUMA(NF)) THEN
4957 IF (MUMAX.LT.MUMA(NF)) THEN
4958 HWBSUL=ALFINT(ALMIN,ALMAX)
4960 HWBSUL=ALFINT(ALMIN,ALMA(NF))
4962 30 IF (MUMAX.GT.MUMA(NF)) THEN
4963 HWBSUL=HWBSUL+FINT(NF)
4967 HWBSUL=HWBSUL+ALFINT(ALMI(NF),ALMAX)
4969 HWBSUL=HWBSUL*BET(5)
4973 *CMZ :- -26/04/91 14.27.17 by Federico Carminati
4974 *-- Author : Ian Knowles
4975 C-----------------------------------------------------------------------
4976 SUBROUTINE HWBTIM(INITBR,INTERF)
4977 C-----------------------------------------------------------------------
4978 C Constructs full 4-momentum & production vertices in time-like jet
4979 C initiated by INITBR, interference partner INTERF and spin density
4980 C RHOPAR(INITBR). DECPAR(INITBR) returns jet's spin density matrix.
4981 C Includes azimuthal angular correlations between branching planes
4982 C due to spin (if AZSPIN) using the algorithm of Knowles & Collins.
4983 C Ses Nucl. Phys. B304 (1988) 794 & Comp. Phys. Comm. 58 (1990) 271.
4984 C-----------------------------------------------------------------------
4985 INCLUDE 'herwig65.inc'
4986 DOUBLE PRECISION HWRGEN,DMIN,PT,EIKON,EINUM,EIDEN1,EIDEN2,EISCR,
4987 & WT,SPIN,Z1,Z2,PRMAX,CAZ,CX,SX,ROHEP(3),RMAT(3,3),ZERO2(2)
4988 INTEGER INITBR,INTERF,IPAR,JPAR,KPAR,LPAR,MPAR,NTRY,JOLD
4992 DATA ZERO2,DMIN/ZERO,ZERO,1.D-15/
4993 IF (IERROR.NE.0) RETURN
4996 IF ((JDAPAR(1,JPAR).NE.0).OR.(IDPAR(JPAR).EQ.13)) GOTO 30
4997 C No branching, assign decay matrix
4998 CALL HWVZRO(2,DECPAR(1,JPAR))
5000 C Advance up the leader
5001 C Find the parent and partner of J
5002 10 IPAR=JMOPAR(1,JPAR)
5005 IF (JMOPAR(1,KPAR).EQ.IPAR) THEN
5007 CALL HWBAZF(IPAR,JPAR,PHIPAR(1,IPAR),RHOPAR(1,IPAR),
5008 & ZERO2,RHOPAR(1,JPAR))
5011 IF (JMOPAR(1,KPAR).NE.IPAR) THEN
5012 CALL HWWARN('HWBTIM',100)
5016 CALL HWBAZF(IPAR,KPAR,RHOPAR(1,IPAR),PHIPAR(1,IPAR),
5017 & DECPAR(1,KPAR),RHOPAR(1,JPAR))
5019 C Generate azimuthal angle of J's branching
5020 30 IF (JDAPAR(1,JPAR).EQ.0) THEN
5022 CALL HWVZRO(2,DECPAR(1,JPAR))
5023 IF (JPAR.EQ.INITBR) RETURN
5026 C Assign an angle to a branching using an M-function
5027 C Find the daughters of J
5031 CALL HWUROT(PPAR(1,JPAR), ONE,ZERO,RMAT)
5032 CALL HWUROF(RMAT,PPAR(1,KPAR),ROHEP)
5033 PT=MAX(SQRT(ROHEP(1)*ROHEP(1)+ROHEP(2)*ROHEP(2)),DMIN)
5036 EICOR=AZSOFT.AND.((IDPAR(LPAR).EQ.13).OR.(IDPAR(MPAR).EQ.13))
5038 C Rearrange s.t. LPAR is the (softest) gluon
5039 IF (IDPAR(MPAR).EQ.13) THEN
5040 IF (IDPAR(LPAR).NE.13.OR.
5041 & PPAR(4,MPAR).LT.PPAR(4,LPAR)) THEN
5047 EINUM=(PPAR(4,KPAR)*PPAR(4,LPAR))
5048 & *ABS(PPAR(2,LPAR)-PPAR(2,MPAR))
5049 EIDEN1=(PPAR(4,KPAR)*PPAR(4,LPAR))-ROHEP(3)*PPAR(3,LPAR)
5050 EIDEN2=PT*ABS(PPAR(1,LPAR))
5051 IF (ABS(PPAR(2,MPAR)).LT.DMIN) THEN
5052 IF (ABS(PPAR(5,MPAR)).LT.DMIN) THEN
5055 CALL HWWARN('HWBTIM',102)
5059 EISCR=ONE-(PPAR(5,MPAR)/PPAR(4,MPAR))**2
5060 & /MIN(PPAR(2,LPAR),PPAR(2,MPAR))
5062 EIKON=EISCR+EINUM/MAX(EIDEN1-EIDEN2,DMIN)
5068 Z1=PPAR(4,LPAR)/PPAR(4,JPAR)
5070 IF (IDPAR(JPAR).EQ.13.AND.IDPAR(LPAR).EQ.13) THEN
5071 WT=Z1*Z2/(Z1/Z2+Z2/Z1+Z1*Z2)
5072 ELSEIF (IDPAR(JPAR).EQ.13.AND.IDPAR(LPAR).LT.13) THEN
5073 WT=-2.*Z1*Z2/(Z1*Z1+Z2*Z2)
5076 C Assign the azimuthal angle
5077 PRMAX=(1.+ABS(WT))*EIKON
5080 IF (NTRY.GT.NBTRY) THEN
5081 CALL HWWARN('HWBTIM',101)
5084 CALL HWRAZM( ONE,CX,SX)
5085 CALL HWUROT(PPAR(1,JPAR),CX,SX,RMAT)
5086 C Determine the angle between the branching planes
5087 CALL HWUROF(RMAT,PPAR(1,KPAR),ROHEP)
5089 PHIPAR(1,JPAR)=2.*CAZ*CAZ-1.
5090 PHIPAR(2,JPAR)=2.*CAZ*ROHEP(2)/PT
5091 IF (EICOR) EIKON=EISCR+EINUM/MAX(EIDEN1-EIDEN2*CAZ,DMIN)
5092 IF (AZSPIN) SPIN=1.+WT*(RHOPAR(1,JPAR)*PHIPAR(1,JPAR)
5093 & +RHOPAR(2,JPAR)*PHIPAR(2,JPAR))
5094 IF (SPIN*EIKON.LT.HWRGEN(0)*PRMAX) GOTO 50
5095 C Construct full 4-momentum of L and M
5098 PPAR(1,LPAR)=-PPAR(1,LPAR)
5099 PPAR(1,MPAR)=-PPAR(1,MPAR)
5105 CALL HWUROB(RMAT,PPAR(1,LPAR),PPAR(1,LPAR))
5107 CALL HWUROB(RMAT,PPAR(1,MPAR),PPAR(1,MPAR))
5108 C Assign production vertex to L and M
5109 CALL HWUDKL(IDPAR(JOLD),PPAR(1,JOLD),VPAR(1,LPAR))
5110 CALL HWVSUM(4,VPAR(1,JOLD),VPAR(1,LPAR),VPAR(1,LPAR))
5111 CALL HWVEQU(4,VPAR(1,LPAR),VPAR(1,MPAR))
5113 60 IF (JDAPAR(1,JPAR).NE.0) GOTO 10
5114 C Assign decay matrix
5115 CALL HWVZRO(2,DECPAR(1,JPAR))
5116 C Backtrack down the leader
5117 70 IPAR=JMOPAR(1,JPAR)
5119 IF (KPAR.EQ.JPAR) THEN
5120 C Develop the side branch
5124 C Construct decay matrix
5125 CALL HWBAZF(IPAR,KPAR,DECPAR(1,JPAR),DECPAR(1,KPAR),
5126 & PHIPAR(1,IPAR),DECPAR(1,IPAR))
5128 IF (IPAR.EQ.INITBR) RETURN
5134 *CMZ :- -31/03/00 17:54:05 by Peter Richardson
5135 *-- Author : Gennaro Corcella
5136 C-----------------------------------------------------------------------
5138 C-----------------------------------------------------------------------
5139 INCLUDE 'herwig65.inc'
5140 DOUBLE PRECISION HWBVMC,HWRGEN,HWUALF,HWUSQR,X(3),W,
5141 & X3MIN,X3MAX,X1MIN,X1MAX,QSCALE,GLUFAC,R(3,3),M(3),
5142 & E(3),AW,PTSQ,EM,EPS,MASDEP,A,B,C,GAMDEP,LAMBDA,
5143 & PW(5),PT(5),PW1(5),CS,SN,EPG,QQ,RR,CC
5144 INTEGER ID,ID3,IHEP,KHEP,WHEP,ICMF,K
5145 EXTERNAL HWBVMC,HWUALF,HWUSQR,HWRGEN
5146 LAMBDA(A,B,C)=(A**2+B**2+C**2-2*A*B-2*B*C-2*C*A)/(4*A)
5147 C---FIND AN UNTREATED CMF
5150 C----FIND A DECAYING TOP QUARK
5151 10 IF (ISTHEP(IHEP).EQ.155.AND.ISTHEP(JDAHEP(1,IHEP)).EQ.113
5152 & .AND.(IDHW(IHEP).EQ.6.OR.IDHW(IHEP).EQ.12))
5154 IF (ICMF.EQ.0) RETURN
5157 C---GENERATE X(1),X(3) ACCORDING TO 1/((1-X(1))*X(3)**2)
5160 AW=(PHEP(5,JDAHEP(1,ICMF))/EM)**2
5163 X(3)=X3MIN*X3MAX/(X3MIN+(X3MAX-X3MIN)*HWRGEN(0))
5164 C--CC, QQ AND RR ARE THE VARIABLE DEFINED IN OUR PAPER
5165 C--IN ORDER TO SOLVE THE CUBIC EQUATION
5167 QQ=(AW**2-4*(1-X(3))*(2-CC-X(3))-2*AW*(3+2*X(3)))/3
5168 & -((3+2*AW-4*X(3))**2)/9
5169 RR=((3+2*AW-4*X(3))*(AW**2-4*(1-X(3))*(2-CC-X(3))
5170 & -2*AW*(3+2*X(3)))-3*(AW*(4-AW)*(2-CC)+(1-CC)
5171 & *(2*(1-X(3))-AW)**2))/6-(ONE/27)*(3+2*AW-4*X(3))**3
5173 X1MAX=2*(-QQ**3)**(ONE/6)*COS(ACOS(RR/SQRT(-QQ**3))/3)
5174 & -(3+2*AW-4*X(3))/3
5175 X1MIN=1-X(3)+(AW*X(3))/(1-X(3))
5176 IF (X1MAX.GE.1.OR.X1MIN.GE.1.OR.X1MAX.LE.X1MIN) GOTO 100
5177 X(1)=1-(1-X1MAX)*((1-X1MIN)/(1-X1MAX))**HWRGEN(1)
5178 C---CALCULATE WEIGHT
5179 W=((1+1/AW-2*AW)*((1-AW)*X(3)-(1-X(1))*(1-X(3))-X(3)**2)
5180 & +(1+1/(2*AW))*X(3)*(X(1)+X(3)-1)**2+2*X(3)**2*(1-X(1)))
5181 & *(1/X3MIN-1/X3MAX)*LOG((1-X1MIN)/(1-X1MAX))
5182 C---QSCALE=DURHAM-LIKE TRANSVERSE MOMENTUM OF THE GLUON
5183 QSCALE=EM*HWUSQR(X(3)*(1-X(1))/(2-X(1)-X(3)-AW))
5184 C---FACTOR FOR GLUON EMISSION
5185 ID=IDHW(JDAHEP(2,ICMF))
5187 IF (QSCALE.GT.HWBVMC(13)) GLUFAC=CFFAC*HWUALF(1,QSCALE)
5188 & /(PIFAC*(1-AW)*(1-2*AW+1/AW))
5189 C---IN FRACTION GLUFAC*W OF EVENTS ADD A GLUON
5190 IF (GLUFAC*W.GT.HWRGEN(4)) THEN
5195 C---CHECK INFRA-RED CUT-OFF FOR GLUON
5196 M(1)=PHEP(5,JDAHEP(1,ICMF))
5199 E(1)=HALF*EM*(X(1)+AW+(-M(2)**2-M(3)**2)/EM**2)
5202 PTSQ=-LAMBDA(E(1)**2-M(1)**2,E(3)**2-M(3)**2,
5204 IF (PTSQ.LE.0.OR.E(1).LE.M(1).OR.E(2).LE.M(2).OR.E(3).LE.M(3))
5206 C---CALCULATE MASS-DEPENDENT SUPPRESSION
5207 EPS=(RMASS(ID)/EM)**2
5208 EPG=(RMASS(ID3)/EM)**2
5209 GAMDEP=(1-AW)*(1+1/AW-2*AW)/(SQRT(1+AW**2+EPS**2
5210 & -2*AW-2*EPS-2*AW*EPS)*(1+EPS+(1-EPS)**2/AW-2*AW))
5211 MASDEP=GAMDEP/(1-X(1))*((1+EPS+(1-EPS)**2/AW-2*AW)
5212 & *((1-AW+EPS)*X(3)*(1-X(1))-(1-X(1))**2*(1-X(3))
5213 & -X(3)**2*(1-X(1)+EPS))+(1+(1+EPS)/(2*AW))*X(3)
5214 & *(1-X(1))*(X(1)+X(3)-1)**2+2*X(3)**2*(1-X(1))**2)
5215 IF (MASDEP.LT.HWRGEN(7)*((1+1/AW-2*AW)*((1-AW)*X(3)
5216 & -(1-X(1))*(1-X(3))-X(3)**2)+(1+1/(2*AW))*X(3)
5217 & *(X(1)+X(3)-1)**2+2*X(3)**2*(1-X(1)))) GOTO 1000
5218 C---STORE OLD MOMENTA
5219 c---PT = TOP MOMENTUM, PW= W MOMENTUM
5220 CALL HWVEQU(5,PHEP(1,ICMF),PT)
5221 CALL HWVEQU(5,PHEP(1,JDAHEP(1,ICMF)),PW)
5222 C--------GET THE NON-EMITTING PARTON CMF DIRECTION
5223 CALL HWULOF(PHEP(1,ICMF),PW,PW)
5224 CALL HWRAZM(ONE,CS,SN)
5225 CALL HWUROT(PW,CS,SN,R)
5226 CALL HWUROF(R,PW,PW)
5228 C---REORDER ENTRIES: IHEP=EMITTER, KHEP=EMITTED
5233 C---SET UP MOMENTA IN TOP REST FRAME
5239 PHEP(4,IHEP)=HALF*EM*(2-X(1)-X(3)+EPS-AW+EPG)
5240 PHEP(4,KHEP)=HALF*EM*X(3)
5241 PHEP(5,IHEP)=RMASS(ID)
5242 PHEP(5,KHEP)=RMASS(ID3)
5243 PHEP(3,KHEP)=HALF*EM*((X(1)+AW-EPS-EPG)*X(3)-2*(1+EPS-AW
5244 $ -EPG-(2+EPS+EPG-AW-X(1)-X(3))))/HWUSQR((X(1)+AW
5245 $ -EPS-EPG)**2-4*AW)
5246 PHEP(3,IHEP)=-PHEP(3,KHEP)-HALF*EM
5247 $ *HWUSQR((X(1)+AW-EPS-EPG)**2-4*AW)
5249 PHEP(1,KHEP)=HWUSQR(PHEP(4,KHEP)**2-PHEP(5,KHEP)**2
5251 PHEP(1,IHEP)=-PHEP(1,KHEP)
5253 CALL HWVSUM(4,PHEP(1,IHEP),PHEP(1,KHEP),PW1)
5254 CALL HWVDIF(4,PHEP(1,ICMF),PW1,PW1)
5259 C---ORIENT IN CMF, THEN BOOST TO LAB
5260 CALL HWUROB(R,PHEP(1,ICMF),PHEP(1,ICMF))
5261 CALL HWUROB(R,PHEP(1,IHEP),PHEP(1,IHEP))
5262 CALL HWUROB(R,PHEP(1,WHEP),PHEP(1,WHEP))
5263 CALL HWUROB(R,PHEP(1,KHEP),PHEP(1,KHEP))
5264 CALL HWULOB(PT,PHEP(1,IHEP),PHEP(1,IHEP))
5265 CALL HWULOB(PT,PHEP(1,KHEP),PHEP(1,KHEP))
5266 CALL HWULOB(PT,PHEP(1,ICMF),PHEP(1,ICMF))
5267 CALL HWULOB(PT,PHEP(1,WHEP),PHEP(1,WHEP))
5268 C---STATUS AND COLOUR CONNECTION
5269 C--Bug fix 31/03/00 PR
5272 IDHEP(KHEP)=IDPDG(ID3)
5277 IF(IDHW(ICMF).EQ.6) THEN
5283 JDAHEP(2,IHEP) = KHEP
5284 JDAHEP(2,KHEP) = ICMF
5285 JMOHEP(2,IHEP) = ICMF
5286 JMOHEP(2,KHEP) = IHEP
5289 C--modification to allow photon radiation via photos in top decay
5290 1000 IF(ITOPRD.EQ.1) CALL HWPHTP(ICMF)
5293 *CMZ :- -26/04/91 11.11.54 by Bryan Webber
5294 *-- Author : Bryan Webber
5295 C-----------------------------------------------------------------------
5297 C-----------------------------------------------------------------------
5298 C VIRTUAL MASS CUTOFF FOR PARTON TYPE ID
5299 C-----------------------------------------------------------------------
5300 INCLUDE 'herwig65.inc'
5301 DOUBLE PRECISION HWBVMC
5304 HWBVMC=RMASS(ID)+VGCUT
5305 ELSEIF (ID.LT.13) THEN
5306 HWBVMC=RMASS(ID)+VQCUT
5307 ELSEIF (ID.EQ.59) THEN
5308 HWBVMC=RMASS(ID)+VPCUT
5314 *CMZ :- -20/07/99 10:56:12 by Peter Richardson
5315 *-- Author : Peter Richardson
5316 C-----------------------------------------------------------------------
5317 SUBROUTINE HWCBCT(JHEP,KHEP,THEP,PCL,SPLIT)
5318 C-----------------------------------------------------------------------
5319 C Subroutine to split a baryonic cluster containing two heavy quarks
5321 C-----------------------------------------------------------------------
5322 INCLUDE 'herwig65.inc'
5323 DOUBLE PRECISION HWUPCM,HWRGEN,HWVDOT,EMC,QM1,QM2,QM3,QM4,
5324 & PXY,PCX,PCY,RCM,PCL(5),AX(5),PA(5),PB(5),PC(5),
5325 & VCLUS(4),DQM,EMX,EMY,SKAPPA,RKAPPA,VTMP(4),
5326 & DELTM,PDIQUK(5),AY(5)
5327 INTEGER HWRINT,JHEP,KHEP,LHEP,MHEP,THEP,ID1,ID2,ID3,ID4,NTRY,
5330 EXTERNAL HWUPCM,HWRGEN,HWVDOT
5331 PARAMETER(SKAPPA=1.,NTRYMX=100)
5332 IF(IERROR.NE.0) RETURN
5342 C Decide if cluster contains a b-(anti)quark
5343 IF (ID1.EQ.5.OR.ID1.EQ.11.OR.ID2.EQ.5.OR.ID2.EQ.11.OR.
5344 & ID3.EQ.5.OR.ID3.EQ.11) THEN
5349 C-- Set the positon of the cluster to be that of the heavy quark
5350 CALL HWVEQU(4,VHEP(1,THEP),VCLUS)
5351 C--SPLIT THE BARYONIC CLUSTER INTO A HEAVY FLAVOUR MESON AND A HEAVY
5355 IF(NTRY.GT.NTRYMX) RETURN
5356 30 EMX=QM1+QM2+PXY*HWRGEN(0)**PSPLT(IB)
5357 EMY= QM3+PXY*HWRGEN(1)**PSPLT(IB)
5358 IF(EMX+EMY.GE.EMC) GOTO 30
5359 C--PULL A LIGHT QUARK PAIR OUT OF THE VACUUM
5361 IF(QWT(ID4).LT.HWRGEN(3)) GOTO 40
5363 C--Now combine particles 3 & 4 into a diquark
5364 C--If three also heavy this diquark doesn't exist in HERWIG
5365 C--just assume mass is sum of quark masses,as for other diquarks
5367 C--Now obtain the masses for the cluster splitting
5368 PCX=HWUPCM(EMX,QM1,DQM)
5369 IF(PCX.LT.ZERO) GOTO 20
5370 PCY=HWUPCM(EMY,QM2,QM4)
5371 IF(PCY.LT.ZERO) GOTO 20
5373 C--Now we've decided which light quark to pull out of the vacuum
5374 C--Find the direction of the second heavy quark
5375 CALL HWULOF(PCL,PHEP(1,THEP),AX)
5376 RCM=1./SQRT(HWVDOT(3,AX,AX))
5377 CALL HWVSCA(3,RCM,AX,AX)
5378 C--Construct the new CoM momenta(collinear)
5379 PXY=HWUPCM(EMC,EMX,EMY)
5380 CALL HWVSCA(3,PXY,AX,PC)
5381 C--pc is momenta of Y cluster along 2nd quark dirn in cluster frame
5382 PC(4)=SQRT(PXY**2+EMY**2)
5384 C--pa is momenta of 2nd quark in Y frame
5385 CALL HWVSCA(3,PCY,AX,PA)
5386 PA(4)=SQRT(PCY**2+QM3**2)
5388 C--pb is momenta of 2nd quark in cluster frame,pa now momenta of antiquark
5389 CALL HWULOB(PC,PA,PB)
5390 CALL HWVDIF(4,PC,PB,PA)
5394 C--boost these momenta back to lab frame
5395 CALL HWULOB(PCL,PB,PHEP(1,THEP))
5396 CALL HWULOB(PCL,PA,PHEP(1,MHEP))
5397 C--pc now becomes momenta of X cluster in cluster frame
5398 CALL HWVSCA(3,-ONE,PC,PC)
5401 C--find the dirn of the 1st heavy quark in the X frame
5402 C--transform to cluster frame
5403 CALL HWULOF(PCL,PHEP(1,JHEP),AY)
5404 C--transform to X-frame
5405 CALL HWULOF(PC,AY,AY)
5406 RCM=1./SQRT(HWVDOT(3,AY,AY))
5407 CALL HWVSCA(3,RCM,AY,AY)
5408 C--pa now momenta of 1st havy quark along this dirn
5409 CALL HWVSCA(3,PCX,AY,PA)
5410 PA(4)=SQRT(PCX**2+QM1**2)
5412 C--pb now momenta of 1st heavy quark in cluster frame then to lab
5413 CALL HWULOB(PC,PA,PB)
5414 CALL HWULOB(PCL,PB,PHEP(1,JHEP))
5415 C--now find the diquark momenta by momentum conservation
5417 50 PDIQUK(J)=PCL(J)-PHEP(J,THEP)-PHEP(J,MHEP)-PHEP(J,JHEP)
5419 C--Now obtain the quark momenta from the diquark
5424 CALL HWULOB(PDIQUK,PA,PHEP(1,KHEP))
5425 CALL HWVDIF(4,PDIQUK,PHEP(1,KHEP),PHEP(1,LHEP))
5426 C--Construct new vertex positions
5427 RKAPPA=GEV2MM/SKAPPA
5428 CALL HWVSCA(3,RKAPPA,AX,AX)
5429 DELTM=(EMX-EMY)*(EMX+EMY)/(TWO*EMC)
5430 CALL HWVSCA(3,DELTM,AX,VTMP)
5431 VTMP(4)=(HALF*EMC-PXY)*RKAPPA
5432 CALL HWULB4(PCL,VTMP,VTMP)
5433 CALL HWVSUM(4,VTMP,VCLUS,VHEP(1,LHEP))
5434 CALL HWVEQU(4,VHEP(1,LHEP),VHEP(1,MHEP))
5435 C--Relabel the colours of the quarks
5436 IDHEP(LHEP) = IDPDG(ID4)
5437 IDHEP(MHEP) = IDPDG(ID4)
5438 IF(IDHEP(JHEP).GT.0) THEN
5440 IDHEP(LHEP) = -IDHEP(LHEP)
5442 JDAHEP(2,LHEP) = JHEP
5443 JMOHEP(2,LHEP) = MHEP
5444 JMOHEP(2,MHEP) = JMOHEP(2,JHEP)
5445 JDAHEP(2,MHEP) = LHEP
5446 JMOHEP(2,JHEP) = LHEP
5450 IDHEP(MHEP) = -IDHEP(MHEP)
5451 JMOHEP(2,LHEP) = JHEP
5452 JDAHEP(2,MHEP) = JDAHEP(2,JHEP)
5453 JDAHEP(2,LHEP) = MHEP
5454 JMOHEP(2,MHEP) = LHEP
5455 JDAHEP(2,JHEP) = LHEP
5459 JMOHEP(1,LHEP) = JMOHEP(1,KHEP)
5461 JMOHEP(1,MHEP) = JMOHEP(1,JHEP)
5466 *CMZ :- -12/12/01 14:59:58 by Peter Richardson
5467 *-- Author : Mark Gibbs, modified by Peter Richardson
5468 C-----------------------------------------------------------------------
5470 C-----------------------------------------------------------------------
5471 C FINDS UNPAIRED PARTONS AFTER BARYON-NUMBER VIOLATION
5472 C MODIFIED FOR RPARITY VIOLATING SUSY
5473 C-----------------------------------------------------------------------
5474 INCLUDE 'herwig65.inc'
5475 COMMON/HWBVIC/NBV,IBV(18)
5476 DOUBLE PRECISION HWRGEN,PDQ(5)
5477 INTEGER NBV,IBV,JBV,KBV,LBV,IHEP,IP1,IP2,IP3,JP1,JP2,JP3,
5478 & HWCBVT,NBR,MBV,IQ1,IQ2,IQ3,ID1,ID2,IDQ,IDIQK(3,3)
5479 LOGICAL SPLIT,DUNBV(18)
5481 DATA IDIQK/111,110,113,110,109,112,113,112,114/
5482 C---Check for errors
5483 IF (IERROR.NE.0) RETURN
5484 C---Correct colour connections are gluon splitting
5486 C---Reset bvi clustering flag
5488 C---LIST PARTONS WITH WRONG COLOUR PARTNERS-QUARKS ONLY
5491 IF (ISTHEP(IHEP).GT.149.AND.ISTHEP(IHEP).LT.155) THEN
5492 IF (QORQQB(IDHW(IHEP))) THEN
5493 IF (.NOT.QORQQB(IDHW(JMOHEP(2,IHEP))).
5494 & AND.JMOHEP(2,IHEP).GT.6) GOTO 10
5496 C---Extra check for Gamma's
5497 IF (IDHW(IHEP).EQ.59) GO TO 10
5499 IF (QORQQB(IDHW(JDAHEP(2,IHEP)))) GO TO 10
5502 IF(JMOHEP(2,IHEP).LT.6.AND.
5503 & .NOT.QBORQQ(IDHW(JMOHEP(2,IHEP)))) GOTO 10
5504 C--new for hard process
5507 CALL HWWARN('HWCBVI',100)
5514 C--NOW FIND THE ANTIQUARKS WITH WRONG COLOUR CONNECTIONS
5516 IF(ISTHEP(IHEP).GT.149.AND.ISTHEP(IHEP).LT.155) THEN
5517 IF(QBORQQ(IDHW(IHEP))) THEN
5518 IF(.NOT.QBORQQ(IDHW(JDAHEP(2,IHEP))).AND.
5519 & JDAHEP(2,IHEP).GT.6) GO TO 11
5521 C--Extra check for gamma's
5522 IF(IDHW(IHEP).EQ.59) GO TO 11
5523 IF(QBORQQ(IDHW(JMOHEP(2,IHEP)))) GO TO 11
5526 IF(JDAHEP(2,IHEP).LT.6.AND.
5527 & .NOT.QORQQB(IDHW(JDAHEP(2,IHEP)))) GOTO 11
5530 CALL HWWARN('HWCBVI',100)
5537 IF (NBV.EQ.0) RETURN
5538 IF(MOD(NBV,3).NE.0) THEN
5539 CALL HWWARN('HWCBVI',101)
5542 C---PROCESS FOUND PARTONS, STARTING AT RANDOM POINT IN LIST
5543 NBR=INT(NBV*HWRGEN(0))
5546 IF (JBV.GT.NBV) JBV=JBV-NBV
5547 IF (.NOT.DUNBV(JBV)) THEN
5551 C---FIND ASSOCIATED PARTONS
5553 IF (.NOT.DUNBV(KBV)) THEN
5556 IF (JP2.EQ.JP1) THEN
5559 IF (.NOT.DUNBV(LBV)) THEN
5562 IF (JP3.EQ.JP2) THEN
5571 CALL HWWARN('HWCBVI',102)
5574 C---LOOK FOR DIQUARK
5575 IF (ABS(IDHEP(IP1)).GT.100) THEN
5579 ELSEIF (ABS(IDHEP(IP2)).GT.100) THEN
5583 ELSEIF (ABS(IDHEP(IP3)).GT.100) THEN
5589 C---NO DIQUARKS: COMBINE TWO (ANTI)QUARKS
5590 IF (ABS(IDHEP(IP1)).GT.3) THEN
5594 ELSEIF (ABS(IDHEP(IP2)).GT.3) THEN
5606 IF (ID1.GT.0.AND.ID1.LT.4.AND.
5607 & ID2.GT.0.AND.ID2.LT.4) THEN
5609 ELSEIF (ID1.LT.0.AND.ID1.GT.-4.AND.
5610 & ID1.LT.0.AND.ID2.GT.-4) THEN
5611 IDQ=IDIQK(-ID1,-ID2)+6
5613 C---CANT MAKE DIQUARKS WITH HEAVY QUARKS: TRY CLUSTER SPLITTING
5614 CALL HWVSUM(4,PHEP(1,IQ1),PHEP(1,IQ2),PDQ)
5616 C--Use the original splitting procedure
5617 CALL HWCCUT(IQ1,IQ2,PDQ,.FALSE.,SPLIT)
5618 IF (IERROR.NE.0) RETURN
5620 C--If it fails try the new procedure
5621 CALL HWVSUM(4,PDQ,PHEP(1,IQ3),PDQ)
5623 IF(ABS(ID1).GT.3) THEN
5624 CALL HWCBCT(IQ3,IQ2,IQ1,PDQ,SPLIT)
5625 ELSEIF(ABS(ID2).GT.3) THEN
5626 CALL HWCBCT(IQ3,IQ1,IQ2,PDQ,SPLIT)
5628 CALL HWWARN('HWCBVI',100)
5632 C---Unable to form cluster; dispose of event
5633 CALL HWWARN('HWCBVI',-3)
5636 C---OVERWRITE FIRST AND CANCEL SECOND
5638 IDHEP(IQ1)=IDPDG(IDQ)
5639 CALL HWVSUM(4,PHEP(1,IQ1),PHEP(1,IQ2),PHEP(1,IQ1))
5640 CALL HWUMAS(PHEP(1,IQ1))
5642 C---REMAKE COLOUR CONNECTIONS
5643 IF (QORQQB(IDQ)) THEN
5653 CALL HWVSCA(5,HALF,PHEP(1,IQ1),PHEP(1,IQ1))
5654 CALL HWVEQU(5,PHEP(1,IQ1),PHEP(1,NHEP))
5656 JMOHEP(1,NHEP)=JMOHEP(1,IQ1)
5662 IF (IDIQK(ID1,ID2).EQ.IDQ) THEN
5665 C---REMAKE COLOUR CONNECTIONS (DIQUARK)
5675 ELSEIF (IDIQK(ID1,ID2).EQ.IDQ-6) THEN
5678 C---REMAKE COLOUR CONNECTIONS (ANTIDIQUARK)
5690 CALL HWWARN('HWCBVI',104)
5692 35 IDHEP(IQ1)=IDPDG(IDHW(IQ1))
5693 IDHEP(NHEP)=IDPDG(IDHW(NHEP))
5701 *-- Author : Peter Richardson
5702 C-----------------------------------------------------------------------
5704 C-----------------------------------------------------------------------
5705 C Function to find the baryon number violating vertex a parton came from
5706 C-----------------------------------------------------------------------
5707 INCLUDE 'herwig65.inc'
5708 INTEGER HWCBVT,IP,JP(2),KP,I,J,ID,TYPE,IDM,IDM2,IDM3,IDM4
5711 IF(ID.LE.6.OR.(ID.GE.115.AND.ID.LE.120)) THEN
5712 JP(2) = JMOHEP(2,IP)
5714 JP(2) = JDAHEP(2,IP)
5717 IDM = JMOHEP(1,JMOHEP(1,JMOHEP(1,JMOHEP(1,JP(I)))))
5718 IF(IDHW(IDM).EQ.6.OR.IDHW(IDM).EQ.12) THEN
5724 KP = JMOHEP(1,JP(I))
5726 IDM2 = IDHW(JDAHEP(1,KP))
5727 IDM3 = IDHW(JDAHEP(2,KP))
5728 IDM4 = IDHW(JDAHEP(1,KP)+1)
5729 IF((ISTHEP(KP).EQ.155.AND.
5730 & ((IDM.GE.449.AND.IDM.LE.457.AND.IDM2.LE.12.AND.
5731 & IDM3.LE.12.AND.IDM4.LE.12).OR.
5732 & (((IDM.GE.411.AND.IDM.LE.424).OR.IDM.EQ.405.OR.IDM.EQ.406)
5733 & .AND.IDM2.LE.12.AND.IDM3.LE.12)))
5734 & .OR.(IDM.EQ.15.AND.IDM2.LE.12.AND.
5735 & IDHW(JMOHEP(1,KP)).LE.12.AND.
5736 & IDHW(JMOHEP(2,KP)).LE.12.AND.IDM3.GE.449.AND.
5738 & (IDM.EQ.15.AND.IDM2.GE.198.AND.IDM2.LE.200.
5739 & AND.ABS(IDPDG(IDM3)).GT.1000000)) THEN
5740 IF(IDHW(KP).EQ.449.AND.JDAHEP(1,KP).EQ.JP(I)) THEN
5742 ELSEIF(IDHW(KP).EQ.15) THEN
5743 TYPE=IDHW(JDAHEP(1,KP))
5744 IF(TYPE.GE.7.AND.TYPE.LE.12.AND.
5745 & JMOHEP(2,JDAHEP(2,KP)).EQ.JP(I)) THEN
5747 ELSEIF(TYPE.LE.6.AND.
5748 & JDAHEP(2,JDAHEP(2,KP)).EQ.JP(I)) THEN
5766 *-- Author : Peter Richardson
5767 C-----------------------------------------------------------------------
5769 C-----------------------------------------------------------------------
5770 C Subroutine to correct colour connections after the gluon splitting
5771 C-----------------------------------------------------------------------
5772 INCLUDE 'herwig65.inc'
5773 INTEGER IHEP,STFSPT,LHEP,MHEP,RHEP
5774 IF(IERROR.NE.0) RETURN
5775 C--Find the first particle in the event record with status 150
5777 IF(ISTHEP(IHEP).GE.150.AND.ISTHEP(IHEP).LE.154) THEN
5783 C--Now find any that are colour connected to earlier particles
5784 C--in the event record
5786 C--First the quarks and antidiquarks
5787 IF(IDHW(IHEP).LT.6.OR.
5788 & (IDHW(IHEP).GE.115.AND.IDHW(IHEP).LE.120)) THEN
5789 IF(JMOHEP(2,IHEP).LT.STFSPT) THEN
5791 MHEP = JMOHEP(2,IHEP)
5793 IF(MHEP.GT.6) RHEP = JDAHEP(1,MHEP)
5794 C--As from Rparity connect to particle not to antiparticle
5795 IF(IDHW(MHEP).NE.13) THEN
5796 JMOHEP(2,LHEP) = RHEP
5799 JMOHEP(2,LHEP) = RHEP
5803 C--Now the antiquarks
5804 IF((IDHW(IHEP).GT.6.AND.IDHW(IHEP).LE.12).OR.
5805 & (IDHW(IHEP).GE.109.AND.IDHW(IHEP).LE.114)) THEN
5806 IF(JDAHEP(2,IHEP).LT.STFSPT) THEN
5808 MHEP = JDAHEP(2,IHEP)
5810 IF(MHEP.GT.6) RHEP = JDAHEP(1,MHEP)
5811 C--As from Rparity connect to antiparticle not particle
5812 IF(IDHW(MHEP).NE.13) THEN
5813 JDAHEP(2,LHEP) = RHEP
5815 JDAHEP(2,LHEP) = RHEP
5822 *CMZ :- -26/04/91 14.29.39 by Federico Carminati
5823 *-- Author : Bryan Webber
5824 C-----------------------------------------------------------------------
5825 SUBROUTINE HWCCUT(JHEP,KHEP,PCL,BTCLUS,SPLIT)
5826 C-----------------------------------------------------------------------
5827 C Cuts into 2 the cluster, momentum PCL, made of partons JHEP & KHEP
5828 C-----------------------------------------------------------------------
5829 INCLUDE 'herwig65.inc'
5830 DOUBLE PRECISION HWREXQ,HWUPCM,HWRGEN,HWVDOT,EMC,QM1,QM2,EMX,EMY,
5831 & QM3,PXY,PCX,PCY,RCM,PCL(5),AX(5),PA(5),PB(5),PC(5),SKAPPA,DELTM,
5832 & VSCA,VTMP(4),RKAPPA,VCLUS
5833 INTEGER HWRINT,JHEP,KHEP,LHEP,MHEP,ID1,ID2,ID3,NTRY,NTRYMX,J,IB
5834 LOGICAL BTCLUS,SPLIT
5835 EXTERNAL HWREXQ,HWUPCM,HWRGEN,HWVDOT,HWRINT
5836 COMMON/HWCFRM/VCLUS(4,NMXHEP)
5837 PARAMETER (SKAPPA=1.,NTRYMX=100)
5838 IF (IERROR.NE.0) RETURN
5846 C Decide if cluster contains a b-(anti)quark
5847 IF (ID1.EQ.5.OR.ID1.EQ.11.OR.ID2.EQ.5.OR.ID2.EQ.11) THEN
5853 C Split beam and target clusters as soft clusters
5854 C Both (remnant) children treated like soft clusters if IOPREM=0(1)
5857 IF (EMC.LE.QM1+QM2+2.*QM3) THEN
5860 IF (EMC.LE.QM1+QM2+2.*QM3) RETURN
5862 PXY=EMC-QM1-QM2-TWO*QM3
5863 IF (ISTHEP(JHEP).EQ.153.OR.ISTHEP(JHEP).EQ.154.OR.
5865 EMX=QM1+QM3+HWREXQ(BTCLM,PXY)
5867 EMX=QM1+QM3+PXY*HWRGEN(0)**PSPLT(IB)
5869 IF (ISTHEP(KHEP).EQ.153.OR.ISTHEP(KHEP).EQ.154.OR.
5871 EMY=QM2+QM3+HWREXQ(BTCLM,PXY)
5873 EMY=QM2+QM3+PXY*HWRGEN(1)**PSPLT(IB)
5875 IF (EMX+EMY.GE.EMC) THEN
5877 IF (NTRY.GT.NTRYMX) RETURN
5880 PCX=HWUPCM(EMX,QM1,QM3)
5881 PCY=HWUPCM(EMY,QM2,QM3)
5883 C Choose fragment masses for ordinary cluster
5886 IF (NTRY.GT.NTRYMX) RETURN
5887 30 EMX=QM1+PXY*HWRGEN(0)**PSPLT(IB)
5888 EMY=QM2+PXY*HWRGEN(1)**PSPLT(IB)
5889 IF (EMX+EMY.GE.EMC) GOTO 30
5890 C u,d,s pair production with weights QWT
5892 IF (QWT(ID3).LT.HWRGEN(3)) GOTO 40
5894 PCX=HWUPCM(EMX,QM1,QM3)
5895 IF (PCX.LT.ZERO) GOTO 20
5896 PCY=HWUPCM(EMY,QM2,QM3)
5897 IF (PCY.LT.ZERO) GOTO 20
5900 C Boost antiquark to CoM frame to find axis
5901 CALL HWULOF(PCL,PHEP(1,KHEP),AX)
5902 RCM=1./SQRT(HWVDOT(3,AX,AX))
5903 CALL HWVSCA(3,RCM,AX,AX)
5904 C Construct new CoM momenta (collinear)
5905 PXY=HWUPCM(EMC,EMX,EMY)
5906 CALL HWVSCA(3,PXY,AX,PC)
5907 PC(4)=SQRT(PXY**2+EMY**2)
5909 CALL HWVSCA(3,PCY,AX,PA)
5910 PA(4)=SQRT(PCY**2+QM2**2)
5912 CALL HWULOB(PC,PA,PB)
5913 CALL HWVDIF(4,PC,PB,PA)
5917 IF (MHEP.GT.NMXHEP) THEN
5918 CALL HWWARN('HWCCUT',100)
5921 CALL HWULOB(PCL,PB,PHEP(1,KHEP))
5922 CALL HWULOB(PCL,PA,PHEP(1,MHEP))
5923 CALL HWVSCA(3,-ONE,PC,PC)
5926 CALL HWVSCA(3,PCX,AX,PA)
5927 PA(4)=SQRT(PCX**2+QM3**2)
5928 CALL HWULOB(PC,PA,PB)
5929 CALL HWULOB(PCL,PB,PHEP(1,LHEP))
5931 50 PHEP(J,JHEP)=PCL(J)-PHEP(J,KHEP)-PHEP(J,LHEP)-PHEP(J,MHEP)
5933 CALL HWVEQU(4,VHEP(1,LHEP),VHEP(1,MHEP))
5934 C Construct new vertex positions
5935 RKAPPA=GEV2MM/SKAPPA
5936 CALL HWVSCA(3,RKAPPA,AX,AX)
5937 DELTM=(EMX-EMY)*(EMX+EMY)/(TWO*EMC)
5938 CALL HWVSCA(3,DELTM,AX,VTMP)
5939 VTMP(4)=(HALF*EMC-PXY)*RKAPPA
5940 CALL HWULB4(PCL,VTMP,VTMP)
5941 CALL HWVSUM(4,VTMP,VCLUS(1,JHEP),VHEP(1,LHEP))
5942 CALL HWVEQU(4,VHEP(1,LHEP),VHEP(1,MHEP))
5943 VSCA=0.25*EMC+HALF*(PXY+DELTM)
5944 CALL HWVSCA(3,VSCA,AX,VTMP)
5945 VTMP(4)=(EMC-VSCA)*RKAPPA
5946 CALL HWULB4(PCL,VTMP,VTMP)
5947 CALL HWVSUM(4,VTMP,VCLUS(1,JHEP),VCLUS(1,MHEP))
5948 VSCA=-0.25*EMC+HALF*(DELTM-PXY)
5949 CALL HWVSCA(3,VSCA,AX,VTMP)
5950 VTMP(4)=(EMC+VSCA)*RKAPPA
5951 CALL HWULB4(PCL,VTMP,VTMP)
5952 CALL HWVSUM(4,VTMP,VCLUS(1,JHEP),VCLUS(1,JHEP))
5956 IDHEP(MHEP)= IDPDG(ID3)
5957 IDHEP(LHEP)=-IDPDG(ID3)
5962 JMOHEP(1,LHEP)=JMOHEP(1,KHEP)
5966 JMOHEP(1,MHEP)=JMOHEP(1,JHEP)
5974 *CMZ :- -26/04/91 10.18.56 by Bryan Webber
5975 *-- Author : Bryan Webber
5976 C-----------------------------------------------------------------------
5978 C-----------------------------------------------------------------------
5979 C DECAYS CLUSTERS INTO PRIMARY HADRONS
5980 C-----------------------------------------------------------------------
5981 INCLUDE 'herwig65.inc'
5982 INTEGER JCL,KCL,IP,JP,KP,IST,ID1,ID2,ID3
5983 IF (IERROR.NE.0) RETURN
5984 IF (IPRO/10.EQ.9.OR.IPRO/10.EQ.5) THEN
5985 C---RELABEL CLUSTER CONNECTED TO REMNANT IN DIS
5987 IF (ISTHEP(JCL).EQ.164) GOTO 20
5988 IF (ISTHEP(JCL).EQ.165) THEN
5992 IF (ISTHEP(IP).EQ.162) THEN
5996 IF (JMOHEP(2,KP).NE.JP) THEN
6002 IF (ISTHEP(KCL)/10.NE.16) THEN
6003 CALL HWWARN('HWCDEC',100)
6014 IF (IST.GT.162.AND.IST.LT.166) THEN
6015 C---DON'T HADRONIZE BEAM/TARGET CLUSTERS
6016 IF (IST.EQ.163.OR..NOT.GENSOF) THEN
6017 C---SET UP FLAVOURS FOR CLUSTER DECAY
6018 CALL HWCFLA(IDHW(JMOHEP(1,JCL)),IDHW(JMOHEP(2,JCL)),ID1,ID3)
6019 CALL HWCHAD(JCL,ID1,ID3,ID2)
6027 *CMZ :- -26/04/91 10.18.56 by Bryan Webber
6028 *-- Author : Bryan Webber
6029 C-----------------------------------------------------------------------
6030 SUBROUTINE HWCFLA(JD1,JD2,ID1,ID2)
6031 C-----------------------------------------------------------------------
6032 C SETS UP FLAVOURS FOR CLUSTER DECAY
6033 C-----------------------------------------------------------------------
6035 INTEGER JD1,JD2,ID1,ID2,JD,JDEC(12)
6037 DATA JDEC/1,2,3,10,11,12,4,5,6,7,8,9/
6039 IF (JD.GT.12) JD=JD-108
6042 IF (JD.GT.12) JD=JD-96
6046 *CMZ :- -26/04/91 14.15.56 by Federico Carminati
6047 *-- Author : Bryan Webber
6048 C-----------------------------------------------------------------------
6050 C-----------------------------------------------------------------------
6051 C Converts colour-connected quark-antiquark pairs into clusters
6052 C Modified by IGK to include BRW's colour rearrangement and
6053 C MHS's cluster vertices
6054 C MODIFIED 16/10/97 BY BRW FOR SUSY PROCESSES
6055 C-----------------------------------------------------------------------
6056 INCLUDE 'herwig65.inc'
6057 DOUBLE PRECISION HWULDO,HWVDOT,HWRGEN,HWUPCM,DCL0,DCL(4),DCL1,
6058 & DFAC,DISP1(4),DISP2(4),DMAX,PCL(5),DOT1,DOT2,FAC,VCLUS,SCA1,SCA2,
6059 & EM0,EM1,EM2,PC0,PC1
6060 INTEGER HWRINT,MAP(120),IBHEP,IBCL,JBHEP,JHEP,
6061 & KHEP,LHEP,LCL,IHEP,MCL,I,ISTJ,ISTK,JCL,ID1,ID3,L
6062 LOGICAL HWRLOG,SPLIT
6063 EXTERNAL HWULDO,HWVDOT,HWRGEN,HWUPCM,HWRINT
6064 COMMON/HWCFRM/VCLUS(4,NMXHEP)
6066 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,
6068 IF (IERROR.NE.0) RETURN
6071 C Find colour partners after baryon number violating event
6079 IF (IERROR.NE.0) RETURN
6080 C Look for partons to cluster
6082 10 IF (ISTHEP(IBHEP).GE.150.AND.ISTHEP(IBHEP).LE.154) GOTO 20
6086 C--Final check for colour disconnections
6087 DO 25 JHEP=IBHEP,NHEP
6088 IF (ISTHEP(JHEP).GE.150.AND.ISTHEP(JHEP).LE.154.AND.
6089 & QORQQB(IDHW(JHEP))) THEN
6092 IF (KHEP.EQ.0.OR..NOT.(
6093 & ISTHEP(KHEP).GE.150.AND.ISTHEP(KHEP).LE.154.AND.
6094 & QBORQQ(IDHW(KHEP)))) THEN
6096 IF (ISTHEP(KHEP).GE.150.AND.ISTHEP(KHEP).LE.154
6097 & .AND.QBORQQ(IDHW(KHEP))) THEN
6099 IF (LHEP.EQ.0.OR..NOT.(
6100 & ISTHEP(LHEP).GE.150.AND.ISTHEP(LHEP).LE.154.AND.
6101 & QORQQB(IDHW(LHEP)))) THEN
6109 CALL HWWARN('HWCFOR',100)
6115 C Allow for colour rearrangement of primary clusters
6117 C Randomize starting point
6118 JBHEP=HWRINT(IBHEP,NHEP)
6121 IF (JHEP.GT.NHEP) JHEP=IBHEP
6122 IF (ISTHEP(JHEP).GE.150.AND.ISTHEP(JHEP).LE.154.AND.
6123 & QORQQB(IDHW(JHEP))) THEN
6124 C Find colour connected antiquark or diquark
6126 C Find partner antiquark or diquark
6128 C Find closest antiquark or diquark
6131 DO 40 IHEP=IBHEP,NHEP
6132 IF (ISTHEP(IHEP).GE.150.AND.ISTHEP(IHEP).LE.154.AND.
6133 & QBORQQ(IDHW(IHEP))) THEN
6134 C Check whether already reconnected
6135 IF (JDAHEP(2,IHEP).GT.0.AND.IHEP.NE.LHEP) THEN
6136 CALL HWVDIF(4,VHEP(1,IHEP),VHEP(1,JHEP),DCL)
6137 DCL1=ABS(HWULDO(DCL,DCL))
6138 IF (DCL1.LT.DCL0) THEN
6145 IF (LCL.NE.0.AND.LCL.NE.KHEP) THEN
6147 IF (JDAHEP(2,MCL).NE.KHEP) THEN
6148 C Pairwise reconnection is possible
6149 CALL HWVDIF(4,VHEP(1,KHEP),VHEP(1,MCL ),DCL)
6150 DCL0=DCL0+ABS(HWULDO(DCL,DCL))
6151 CALL HWVDIF(4,VHEP(1,JHEP),VHEP(1,KHEP),DCL)
6152 DCL1=ABS(HWULDO(DCL,DCL))
6153 CALL HWVDIF(4,VHEP(1,LCL ),VHEP(1,MCL ),DCL)
6154 DCL1=DCL1+ABS(HWULDO(DCL,DCL))
6155 IF (DCL0.LT.DCL1.AND.HWRLOG(PRECO)) THEN
6156 C Reconnection occurs
6158 JDAHEP(2,LCL )=-JHEP
6159 JMOHEP(2,MCL) = KHEP
6166 IF (JHEP.NE.JBHEP) GOTO 30
6167 IF (NRECO.NE.0) THEN
6168 DO 50 IHEP=IBHEP,NHEP
6169 50 JDAHEP(2,IHEP)=ABS(JDAHEP(2,IHEP))
6172 C Find (adjusted) cluster positions using MHS prescription
6175 DO 70 JHEP=IBHEP,NHEP
6176 IF (ISTHEP(JHEP).GE.150.AND.ISTHEP(JHEP).LE.154.AND.
6177 & QORQQB(IDHW(JHEP))) THEN
6179 CALL HWUDKL(IDHW(JHEP),PHEP(1,JHEP),DISP1)
6180 CALL HWVSCA(4,DFAC,DISP1,DISP1)
6181 CALL HWUDKL(IDHW(KHEP),PHEP(1,KHEP),DISP2)
6182 CALL HWVSCA(4,DFAC,DISP2,DISP2)
6183 C Rescale the lengths of DISP1,DISP2 if too long
6184 DOT1=HWVDOT(3,DISP1,DISP1)
6185 DOT2=HWVDOT(3,DISP2,DISP2)
6186 IF (MAX(DOT1,DOT2).GT.DMAX**2) THEN
6187 CALL HWVSCA(4,DMAX/SQRT(DOT1),DISP1,DISP1)
6188 CALL HWVSCA(4,DMAX/SQRT(DOT2),DISP2,DISP2)
6190 CALL HWVSUM(4,PHEP(1,JHEP),PHEP(1,KHEP),PCL)
6191 DOT1=HWVDOT(3,DISP1,PCL)
6192 DOT2=HWVDOT(3,DISP2,PCL)
6193 C If PCL > 90^o from either quark, use a vector which isn't
6194 IF (DOT1.LE.ZERO.OR. DOT2.LE.ZERO) THEN
6195 CALL HWVSUM(4,DISP1,DISP2,PCL)
6196 DOT1=HWVDOT(3,DISP1,PCL)
6197 DOT2=HWVDOT(3,DISP2,PCL)
6199 C If vectors are exactly opposite each other this method cannot work
6200 IF (DOT1.EQ.ZERO.OR.DOT2.EQ.ZERO) THEN
6201 C So use midpoint of quark constituents
6202 CALL HWVSUM(4,VHEP(1,JHEP),VHEP(1,KHEP),VCLUS(1,JHEP))
6203 CALL HWVSCA(4,HALF,VCLUS(1,JHEP),VCLUS(1,JHEP))
6206 C Rescale DISP1 or DISP2 to give equal components in the PCL direction
6208 IF (FAC.GT.ONE) THEN
6209 CALL HWVSCA(4, FAC,DISP2,DISP2)
6212 CALL HWVSCA(4,ONE/FAC,DISP1,DISP1)
6215 C Shift VHEP(1,JHEP) or VHEP(1,KHEP) s.t. their line is perp to PCL
6216 FAC=(HWVDOT(3,PCL,VHEP(1,KHEP))
6217 & -HWVDOT(3,PCL,VHEP(1,JHEP)))/DOT1
6218 SCA1=MAX(ONE,ONE+FAC)
6219 SCA2=MAX(ONE,ONE-FAC)
6221 60 VCLUS(I,JHEP)=.5*(VHEP(I,JHEP)+VHEP(I,KHEP)
6222 & +SCA1*DISP1(I)+SCA2*DISP2(I))
6225 C First chop up beam/target clusters
6226 DO 80 JHEP=IBHEP,NHEP
6230 C--PR MOD here 8/7/99
6231 IF (QORQQB(IDHW(JHEP)).AND.
6232 & (((ISTJ.EQ.153.OR.ISTJ.EQ.154).AND.ISTK.NE.151.AND.ISTK.NE.0)
6233 & .OR.((ISTK.EQ.153.OR.ISTK.EQ.154).
6234 & AND.ISTJ.NE.151.AND.ISTJ.NE.0))) THEN
6236 CALL HWVSUM(4,PHEP(1,JHEP),PHEP(1,KHEP),PCL)
6238 CALL HWCCUT(JHEP,KHEP,PCL,.TRUE.,SPLIT)
6239 IF (IERROR.NE.0) RETURN
6242 C Second chop up massive pairs
6243 DO 100 JHEP=IBHEP,NMXHEP
6244 IF (JHEP.GT.NHEP) GOTO 110
6245 IF (ISTHEP(JHEP).GE.150.AND.ISTHEP(JHEP).LE.154.AND.
6246 & QORQQB(IDHW(JHEP))) THEN
6247 90 KHEP=JMOHEP(2,JHEP)
6248 CALL HWVSUM(4,PHEP(1,JHEP),PHEP(1,KHEP),PCL)
6250 IF (PCL(5).GT.CTHRPW(MAP(IDHW(JHEP)),MAP(IDHW(KHEP)))) THEN
6251 CALL HWCCUT(JHEP,KHEP,PCL,.FALSE.,SPLIT)
6252 IF (IERROR.NE.0) RETURN
6257 C Third create clusters and store production vertex
6260 DO 120 JHEP=IBHEP,NHEP
6261 IF (ISTHEP(JHEP).GE.150.AND.ISTHEP(JHEP).LE.154.AND.
6262 & QORQQB(IDHW(JHEP))) THEN
6264 IF(JCL.GT.NMXHEP) THEN
6265 CALL HWWARN('HWCFOR',105)
6271 IF (KHEP.EQ.0.OR..NOT.(
6272 & ISTHEP(KHEP).GE.150.AND.ISTHEP(KHEP).LE.154.AND.
6273 & QBORQQ(IDHW(KHEP)))) THEN
6274 CALL HWWARN('HWCFOR',104)
6277 CALL HWVSUM(4,PHEP(1,JHEP),PHEP(1,KHEP),PHEP(1,JCL))
6278 CALL HWUMAS(PHEP(1,JCL))
6279 IF (ISTHEP(JHEP).EQ.153.OR.ISTHEP(KHEP).EQ.153) THEN
6281 ELSEIF (ISTHEP(JHEP).EQ.154.OR.ISTHEP(KHEP).EQ.154) THEN
6292 ISTHEP(JHEP)=ISTHEP(JHEP)+8
6293 ISTHEP(KHEP)=ISTHEP(KHEP)+8
6294 CALL HWVEQU(4,VCLUS(1,JHEP),VHEP(1,JCL))
6298 C Fix up momenta for single-hadron clusters
6299 130 DO 150 JCL=IBCL,NHEP
6300 C Don't hadronize beam/target clusters
6301 IF (ISTHEP(JCL).LT.163.OR.ISTHEP(JCL).GT.165) GOTO 150
6302 IF (ISTHEP(JCL).NE.163.AND.GENSOF) GOTO 150
6303 C Set up flavours for cluster decay
6304 CALL HWCFLA(IDHW(JMOHEP(1,JCL)),IDHW(JMOHEP(2,JCL)),ID1,ID3)
6306 IF ((B1LIM.EQ.ZERO).OR.(ID1.NE.11.AND.ID3.NE.11)) THEN
6307 IF (EM0.GT.MIN(RMIN(ID1,1)+RMIN(1,ID3),
6308 $ RMIN(ID1,2)+RMIN(2,ID3))) GOTO 150
6310 C Special for b clusters: allow 1-hadron decay above threshold
6311 IF (B1LIM*HWRGEN(1).LT.EM0/(MIN(RMIN(ID1,1)+RMIN(1,ID3),
6312 $ RMIN(ID1,2)+RMIN(2,ID3)))-1.)
6316 IF (ABS(EM0-EM1).LT.1.D-5) GOTO 150
6317 C Decide to go backward or forward to transfer 4-momentum
6323 IF (LCL.LT.IBCL) LCL=LCL+MCL
6324 IF (LCL.GT.NHEP) LCL=LCL-MCL
6325 IF (LCL.EQ.JCL) THEN
6326 IF (EM0.GE.EM1+RMIN(1,1)) GOTO 150
6327 CALL HWWARN('HWCFOR',101)
6330 IF (ISTHEP(LCL).LT.163.OR.ISTHEP(LCL).GT.165) GOTO 140
6331 C Rescale momenta in 2-cluster CoM
6332 CALL HWVSUM(4,PHEP(1,JCL),PHEP(1,LCL),PCL)
6335 PC0=HWUPCM(PCL(5),EM0,EM2)
6336 PC1=HWUPCM(PCL(5),EM1,EM2)
6337 IF (PC1.LT.ZERO) THEN
6338 C Need to rescale other mass as well
6339 CALL HWCFLA(IDHW(JMOHEP(1,LCL)),IDHW(JMOHEP(2,LCL)),ID1,ID3)
6341 PC1=HWUPCM(PCL(5),EM1,EM2)
6342 IF (PC1.LT.ZERO) GOTO 140
6345 IF (PC0.GT.ZERO) THEN
6347 CALL HWULOF(PCL,PHEP(1,JCL),PHEP(1,JCL))
6348 CALL HWVSCA(3,PC0,PHEP(1,JCL),PHEP(1,JCL))
6349 PHEP(4,JCL)=SQRT(PC1**2+EM1**2)
6351 CALL HWULOB(PCL,PHEP(1,JCL),PHEP(1,JCL))
6352 CALL HWVDIF(4,PCL,PHEP(1,JCL),PHEP(1,LCL))
6354 ELSEIF (PC0.EQ.ZERO) THEN
6356 CALL HWDTWO(PCL,PHEP(1,JCL),PHEP(1,LCL),PC1,TWO,.TRUE.)
6359 CALL HWWARN('HWCFOR',102)
6363 CALL HWWARN('HWCFOR',103)
6367 C Non-partons labelled as partons (ie photons) should get copied
6369 IF (ISTHEP(IHEP).EQ.150) THEN
6374 IDHW(NHEP)=IDHW(IHEP)
6375 IDHEP(NHEP)=IDPDG(IDHW(IHEP))
6376 CALL HWVEQU(5,PHEP(1,IHEP),PHEP(1,NHEP))
6377 C--MHS FIX 07/03/05 - VERTEX SHOULD BE RELATIVE TO FIXED AXES
6378 CALL HWVSUM(4,VTXPIP,VHEP(1,IHEP),VHEP(1,NHEP))
6381 JMOHEP(2,NHEP)=JMOHEP(1,IHEP)
6389 *CMZ :- -13/07/92 20.15.54 by Mike Seymour
6390 *-- Author : Bryan Webber
6391 C-----------------------------------------------------------------------
6393 C-----------------------------------------------------------------------
6394 C SPLITS ANY TIMELIKE GLUONS REMAINING AFTER PERTURBATIVE
6395 C BRANCHING INTO LIGHT (I.E. U OR D) Q-QBAR PAIRS
6396 C-----------------------------------------------------------------------
6397 INCLUDE 'herwig65.inc'
6398 DOUBLE PRECISION HWRGEN,PF
6399 INTEGER HWRINT,IHEP,JHEP,KHEP,LHEP,MHEP,ID,J,IST
6400 EXTERNAL HWRGEN,HWRINT
6401 IF (NGSPL.EQ.0) CALL HWWARN('HWCGSP',400)
6405 IF (ISTHEP(IHEP).GE.147.AND.ISTHEP(IHEP).LE.149) THEN
6411 IF (ISTHEP(JHEP).GE.147.AND.ISTHEP(JHEP).LE.149
6412 & .AND.JDAHEP(2,JHEP).LE.0) THEN
6419 CALL HWWARN('HWCGSP',102)
6423 CALL HWWARN('HWCGSP',103)
6428 C---CHECK FOR DECAYED HEAVY ANTIQUARKS
6429 IF (ISTHEP(JHEP).EQ.155) THEN
6430 JHEP=JDAHEP(1,JDAHEP(2,JHEP))
6431 DO 10 J=JDAHEP(1,JHEP),JDAHEP(2,JHEP)
6432 10 IF (ISTHEP(J).EQ.149.AND.JDAHEP(2,J).EQ.0) GOTO 20
6433 CALL HWWARN('HWCGSP',100)
6442 IF (ISTHEP(JHEP).GE.147.AND.ISTHEP(JHEP).LE.149
6443 & .AND.JMOHEP(2,JHEP).LE.0) THEN
6450 CALL HWWARN('HWCGSP',104)
6454 CALL HWWARN('HWCGSP',105)
6460 C---CHECK FOR DECAYED HEAVY QUARKS
6461 IF (ISTHEP(KHEP).EQ.155) THEN
6462 CALL HWWARN('HWCGSP',101)
6465 IF (IDHW(IHEP).EQ.13) THEN
6469 IF(MHEP.GT.NMXHEP) THEN
6470 CALL HWWARN('HWCGSP',106)
6473 30 ID=HWRINT(1,NGSPL)
6474 IF (PGSPL(ID).LT.PGSMX*HWRGEN(0)) GOTO 30
6475 PHEP(5,LHEP)=RMASS(ID)
6476 PHEP(5,MHEP)=RMASS(ID)
6477 C---ASSUME ISOTROPIC ANGULAR DISTRIBUTION
6478 IF (PHEP(5,IHEP).GT.PHEP(5,LHEP)+PHEP(5,MHEP)) THEN
6479 CALL HWDTWO(PHEP(1,IHEP),PHEP(1,LHEP),
6480 & PHEP(1,MHEP),PGSPL(ID),TWO,.TRUE.)
6483 CALL HWVSCA(4,PF,PHEP(1,IHEP),PHEP(1,LHEP))
6484 CALL HWVDIF(4,PHEP(1,IHEP),PHEP(1,LHEP),PHEP(1,MHEP))
6485 PHEP(5,LHEP)=PF*PHEP(5,IHEP)
6486 PHEP(5,MHEP)=PHEP(5,IHEP)-PHEP(5,LHEP)
6488 CALL HWUDKL(13,PHEP(1,IHEP),VHEP(1,LHEP))
6489 CALL HWVSUM(4,VHEP(1,IHEP),VHEP(1,LHEP),VHEP(1,LHEP))
6490 CALL HWVEQU(4,VHEP(1,LHEP),VHEP(1,MHEP))
6493 IDHEP(MHEP)= IDPDG(ID)
6494 IDHEP(LHEP)=-IDPDG(ID)
6498 C---NEW COLOUR CONNECTIONS
6499 IF(RPARTY.OR.JMOHEP(2,KHEP).EQ.IHEP) JMOHEP(2,KHEP)=LHEP
6500 IF(RPARTY.OR.JDAHEP(2,JHEP).EQ.IHEP) JDAHEP(2,JHEP)=MHEP
6501 JMOHEP(1,LHEP)=JMOHEP(1,IHEP)
6503 JMOHEP(1,MHEP)=JMOHEP(1,IHEP)
6512 C---COPY A NON-GLUON
6515 IF(MHEP.GT.NMXHEP) THEN
6516 CALL HWWARN('HWCGSP',107)
6519 CALL HWVEQU(5,PHEP(1,IHEP),PHEP(1,MHEP))
6520 CALL HWVEQU(4,VHEP(1,IHEP),VHEP(1,MHEP))
6521 IDHW(MHEP)=IDHW(IHEP)
6522 IDHEP(MHEP)=IDHEP(IHEP)
6525 IF (IST.EQ.149) THEN
6530 C---NEW COLOUR CONNECTIONS
6531 IF(RPARTY.OR.JMOHEP(2,KHEP).EQ.IHEP)
6532 & JMOHEP(2,KHEP)=MHEP
6533 IF(RPARTY.OR.(JHEP.NE.IHEP.AND.JDAHEP(2,JHEP).EQ.IHEP))
6534 & JDAHEP(2,JHEP)=MHEP
6535 JMOHEP(1,MHEP)=JMOHEP(1,IHEP)
6536 JMOHEP(2,MHEP)=JMOHEP(2,IHEP)
6538 JDAHEP(2,MHEP)=JDAHEP(2,IHEP)
6547 *CMZ :- -26/04/91 14.00.57 by Federico Carminati
6548 *-- Author : Bryan Webber
6549 C-----------------------------------------------------------------------
6550 SUBROUTINE HWCHAD(JCL,ID1,ID3,ID2)
6551 C-----------------------------------------------------------------------
6552 C HADRONIZES CLUSTER JCL, CONSISTING OF PARTONS ID1,ID3
6553 C ID2 RETURNS PARTON-ANTIPARTON PAIR CREATED
6554 C (IN SPECIAL CLUSTER CODE - SEE HWCFLA)
6556 C MODIFIED 15/11/99 TO SMEAR POSITIONS OF HADRONS BY 1/(CLUSTER MASS)
6557 C-----------------------------------------------------------------------
6558 INCLUDE 'herwig65.inc'
6559 DOUBLE PRECISION HWRGEN,HWRGAU,HWVDOT,EM0,EM1,EM2,EMADU,EMSQ,
6560 & PCMAX,PCM,PTEST,PCQK,PP(5),EMLOW,RMAT(3,3),CT,ST,CX,SX,HPSMR
6561 INTEGER HWRINT,JCL,ID1,ID2,ID3,ID,IR1,IR2,NTRY,IDMIN,IMAX,I,MHEP,
6564 EXTERNAL HWRGEN,HWRINT
6565 DIQK(ID)=ID.GT.3.AND.ID.LT.10
6566 IF (IERROR.NE.0) RETURN
6569 IF (LOCN(ID1,ID3).LE.0) THEN
6570 CALL HWWARN('HWCHAD',104)
6573 IR1=NCLDK(LOCN(ID1,ID3))
6575 IF (ABS(EM0-EM1).LT.0.001) THEN
6576 C---SINGLE-HADRON CLUSTER
6578 IF (NHEP.GT.NMXHEP) THEN
6579 CALL HWWARN('HWCHAD',100)
6583 IDHEP(NHEP)=IDPDG(IR1)
6587 CALL HWVEQU(5,PHEP(1,JCL),PHEP(1,NHEP))
6588 CALL HWVSUM(4,VHEP(1,JCL),VTXPIP,VHEP(1,NHEP))
6592 EMLOW=RMIN(ID1,1)+RMIN(1,ID3)
6593 EMADU=RMIN(ID1,2)+RMIN(2,ID3)
6594 IF (EMADU.LT.EMLOW) THEN
6600 IF (PCMAX.GE.ZERO) THEN
6601 C---SET UP TWO QUARK-ANTIQUARK PAIRS OR A
6602 C QUARK-DIQUARK AND AN ANTIDIQUARK-ANTIQUARK
6603 PCMAX=PCMAX*(EMSQ-(RMIN(ID1,IDMIN)-RMIN(IDMIN,ID3))**2)
6605 IF (DIQK(ID1).OR.DIQK(ID3)) IMAX=3
6607 IF (EM0.LT.RMIN(ID1,I)+RMIN(I,ID3)) GOTO 20
6610 20 ID2=HWRINT(1,I-1)
6611 IF (PWT(ID2).NE.ONE) THEN
6612 IF (PWT(ID2).LT.HWRGEN(1)) GOTO 20
6614 C---PICK TWO PARTICLES WITH THESE QUANTUM NUMBERS
6616 30 IR1=LOCN(ID1,ID2)+INT(RESN(ID1,ID2)*HWRGEN(2))
6617 IF (CLDKWT(IR1).LT.HWRGEN(3)) GOTO 30
6619 40 IR2=LOCN(ID2,ID3)+INT(RESN(ID2,ID3)*HWRGEN(4))
6620 IF (CLDKWT(IR2).LT.HWRGEN(5)) GOTO 40
6624 PCM=EMSQ-(EM1+EM2)**2
6625 IF (PCM.GT.ZERO) GOTO 70
6626 IF (NTRY.LE.NDTRY) GOTO 20
6627 C---CAN'T FIND A DECAY MODE - CHOOSE LIGHTEST
6629 IR1=NCLDK(LOCN(ID1,ID2))
6630 IR2=NCLDK(LOCN(ID2,ID3))
6633 PCM=EMSQ-(EM1+EM2)**2
6634 IF (PCM.GT.ZERO) GOTO 70
6636 IF (NTRY.LE.NDTRY+50) GOTO 60
6637 CALL HWWARN('HWCHAD',101)
6639 C---DECAY IS ALLOWED
6640 70 PCM=PCM*(EMSQ-(EM1-EM2)**2)
6641 IF (NTRY.GT.NCTRY) GOTO 80
6642 PTEST=PCM*SWTEF(IR1)*SWTEF(IR2)
6643 IF (PTEST.LT.PCMAX*HWRGEN(0)**2) GOTO 20
6645 C---ALLOW DECAY BY PI0 EMISSION IF ONLY POSSIBILITY
6647 IR2=NCLDK(LOCN(1,1))
6649 PCM=(EMSQ-(EM1+EM2)**2)*(EMSQ-(EM1-EM2)**2)
6651 C---DECAY IS CHOSEN. GENERATE DECAY MOMENTA
6652 C AND PUT PARTICLES IN /HEPEVT/
6653 80 IF (PCM.LT.ZERO) THEN
6654 CALL HWWARN('HWCHAD',102)
6657 PCM=0.5*SQRT(PCM)/EM0
6660 IF (NHEP.GT.NMXHEP) THEN
6661 CALL HWWARN('HWCHAD',103)
6666 C Decide if cluster contains a b-(anti)quark or not
6667 IF (ID1.EQ.11.OR.ID2.EQ.11.OR.ID3.EQ.11) THEN
6672 IF (CLDIR(IB).NE.0) THEN
6675 IF (JM.EQ.0) GOTO 110
6676 IF (ISTHEP(JM).NE.158) GOTO 110
6677 C LOOK FOR PARENT PARTON
6678 DO 100 KM=JMOHEP(1,JM)+1,JM
6679 IF (ISTHEP(KM).EQ.2) THEN
6680 IF (JDAHEP(1,KM).EQ.JM) THEN
6681 C FOUND PARENT PARTON
6682 IF (IDHW(KM).NE.13) THEN
6683 C FIND ITS DIRECTION IN CLUSTER CMF
6684 CALL HWULOF(PHEP(1,JCL),PHEP(1,KM),PP)
6685 PCQK=PP(1)**2+PP(2)**2+PP(3)**2
6686 IF (PCQK.GT.ZERO) THEN
6688 IF (CLSMR(IB).GT.ZERO) THEN
6689 C DO GAUSSIAN SMEARING OF DIRECTION
6690 90 CT=ONE+CLSMR(IB)*LOG(HWRGEN(0))
6691 IF (CT.LT.-ONE) GOTO 90
6693 IF (ST.GT.ZERO) ST=SQRT(ST)
6694 CALL HWRAZM( ONE,CX,SX)
6695 CALL HWUROT(PP,CX,SX,RMAT)
6699 CALL HWUROB(RMAT,PP,PP)
6702 IF (IM.EQ.2) PCQK=-PCQK
6703 CALL HWVSCA(3,PCQK,PP,PHEP(1,MHEP))
6704 PHEP(4,MHEP)=SQRT(PHEP(5,MHEP)**2+PCM**2)
6705 CALL HWULOB(PHEP(1,JCL),PHEP(1,MHEP),PHEP(1,MHEP))
6706 CALL HWVDIF(4,PHEP(1,JCL),PHEP(1,MHEP),PHEP(1,NHEP))
6712 ELSEIF (ISTHEP(KM).GT.140) THEN
6719 120 CALL HWDTWO(PHEP(1,JCL),PHEP(1,MHEP),PHEP(1,NHEP),
6723 IDHEP(MHEP)=IDPDG(IR1)
6724 IDHEP(NHEP)=IDPDG(IR2)
6728 C---SECOND MOTHER OF HADRON IS JET
6729 JMOHEP(2,MHEP)=JMOHEP(1,JMOHEP(1,JCL))
6732 C---SMEAR HADRON POSITIONS
6733 HPSMR=GEV2MM/PHEP(5,JCL)
6735 VHEP(I,MHEP)=HWRGAU(I,ZERO,HPSMR)
6737 VHEP(4,MHEP)=ABS(VHEP(4,MHEP))
6738 & +SQRT(HWVDOT(3,VHEP(1,MHEP),VHEP(1,MHEP)))
6739 CALL HWULB4(PHEP(1,JCL),VHEP(1,MHEP),VHEP(1,MHEP))
6740 CALL HWVSUM(4,VHEP(1,JCL),VHEP(1,MHEP),VHEP(1,MHEP))
6741 CALL HWVSUM(4,VTXPIP,VHEP(1,MHEP),VHEP(1,MHEP))
6743 VHEP(I,NHEP)=HWRGAU(I,ZERO,HPSMR)
6745 VHEP(4,NHEP)=ABS(VHEP(4,NHEP))
6746 & +SQRT(HWVDOT(3,VHEP(1,NHEP),VHEP(1,NHEP)))
6747 CALL HWULB4(PHEP(1,JCL),VHEP(1,NHEP),VHEP(1,NHEP))
6748 CALL HWVSUM(4,VHEP(1,JCL),VHEP(1,NHEP),VHEP(1,NHEP))
6749 CALL HWVSUM(4,VTXPIP,VHEP(1,NHEP),VHEP(1,NHEP))
6751 ISTHEP(JCL)=180+MOD(ISTHEP(JCL),10)
6753 JMOHEP(2,NHEP)=JMOHEP(1,JMOHEP(1,JCL))
6757 *CMZ :- -09/04/02 13:37:38 by Peter Richardson
6758 *-- Author : Peter Richardson
6759 C-----------------------------------------------------------------------
6760 SUBROUTINE HWD2ME(IMODE)
6761 C-----------------------------------------------------------------------
6762 C Computes the width and maximum weight for a two body mode
6763 C-----------------------------------------------------------------------
6764 INCLUDE 'herwig65.inc'
6766 DOUBLE PRECISION A(2),M(3),PCM,E1,E2,HWUPCM,PHS,WGT,MWGT,PCM2,
6769 C--set up the masses and couplings
6770 M(1) = RMASS(IDK(ID2PRT(IMODE)))
6772 A(I) = A2MODE(I,IMODE)
6773 1 M(I+1) = RMASS(IDKPRD(I,ID2PRT(IMODE)))
6776 C--first compute the masses etc
6777 PCM = HWUPCM(M(1),M(2),M(3))
6779 PHS = PCM/M2(1)/8.0D0/PIFAC
6780 C--now compute the width and max weight
6781 C--first the fermion --> fermion scalar diagrams
6782 IF(I2DRTP(IMODE).EQ.1) THEN
6783 WGT = HALF*((A(1)**2+A(2)**2)*(M2(1)+M2(2)-M2(3))
6784 & +FOUR*A(1)*A(2)*M(1)*M(2))
6785 E1 = SQRT(M2(2)+PCM2)
6786 E2 = SQRT(M2(3)+PCM2)
6787 MWGT = HALF*M2(1)/(E1+E2)*(E1+PCM)*ABS(A(1)**2-A(2)**2)+WGT
6788 C--next the fermion --> scalar fermion diagrams
6789 ELSEIF(I2DRTP(IMODE).EQ.2) THEN
6790 WGT = HALF*((A(1)**2+A(2)**2)*(M2(1)+M2(3)-M2(2))
6791 & +FOUR*A(1)*A(2)*M(1)*M(3))
6792 E1 = SQRT(M2(2)+PCM2)
6793 E2 = SQRT(M2(3)+PCM2)
6794 MWGT = HALF*M2(1)/(E1+E2)*(E2+PCM)*ABS(A(1)**2-A(2)**2)+WGT
6795 C--next the fermion --> scalar antifermion diagrams
6796 ELSEIF(I2DRTP(IMODE).EQ.3) THEN
6797 WGT = HALF*((A(1)**2+A(2)**2)*(M2(1)+M2(3)-M2(2))
6798 & +FOUR*A(1)*A(2)*M(1)*M(3))
6799 E1 = SQRT(M2(2)+PCM2)
6800 E2 = SQRT(M2(3)+PCM2)
6801 MWGT = HALF*M2(1)/(E1+E2)*(E2+PCM)*ABS(A(1)**2-A(2)**2)+WGT
6802 C--next the fermion --> fermion gauge boson diagrams
6803 ELSEIF(I2DRTP(IMODE).EQ.4) THEN
6804 WGT = 2.0D0*(M2(1)-M2(2))**2
6806 C--next the scalar --> fermion antifermion diagrams
6807 ELSEIF(I2DRTP(IMODE).EQ.5) THEN
6808 WGT = (M2(1)-M2(2)-M2(3))*(A(1)**2+A(2)**2)
6809 & -FOUR*M(2)*M(3)*A(1)*A(2)
6811 C--next the scalar --> fermion fermion diagrams
6812 ELSEIF(I2DRTP(IMODE).EQ.6) THEN
6813 WGT = (M2(1)-M2(2)-M2(3))*(A(1)**2+A(2)**2)
6814 & -FOUR*M(2)*M(3)*A(1)*A(2)
6816 C--next the fermion --> fermion pion diagrams
6817 ELSEIF(I2DRTP(IMODE).EQ.7) THEN
6818 WGT = HALF/FOUR/RMASS(198)**4*(
6819 & (A(1)**2+A(2)**2)*((M2(1)-M2(2))**2-M2(3)*(M2(1)+M2(2)))
6820 & +FOUR*M(1)*M(2)*M2(3)*A(1)*A(2))
6821 E1 = SQRT(M2(2)+PCM2)
6822 E2 = SQRT(M2(3)+PCM2)
6823 MWGT =ONE/8.0D0/RMASS(198)**4*ABS(A(1)**2-A(2)**2)*
6824 & M(1)*(M(1)*M2(3)+(M2(1)-M2(2)+M2(3))*(E2+PCM))+WGT
6825 C--next scalar --> antifermion fermion diagrams
6826 ELSEIF(I2DRTP(IMODE).EQ.8) THEN
6827 WGT = (M2(1)-M2(2)-M2(3))*(A(1)**2+A(2)**2)
6828 & -FOUR*M(2)*M(3)*A(1)*A(2)
6830 C--next fermion --> gravitino photon
6831 ELSEIF(I2DRTP(IMODE).EQ.9) THEN
6832 WGT = 8.0D0*M2(1)**3
6834 C--next fermion --> gravitino scalar
6835 ELSEIF(I2DRTP(IMODE).EQ.10) THEN
6836 WGT = HALF*(M2(1)-M2(3))**3
6837 E1 = SQRT(M2(2)+PCM2)
6838 E2 = SQRT(M2(3)+PCM2)
6839 MWGT = TWO*M2(1)/(E1+E2)*(E1+PCM)*(M2(1)-M2(3))**2 +WGT
6840 C--next sfermion --> fermion gravitino
6841 ELSEIF(I2DRTP(IMODE).EQ.11) THEN
6842 WGT = (M2(1)-M2(2))**3
6844 C--next antisfermion --> fermion gravitino
6845 ELSEIF(I2DRTP(IMODE).EQ.12) THEN
6846 WGT = (M2(1)-M2(2))**3
6848 C--next the scalar --> antifermion antifermion diagrams
6849 ELSEIF(I2DRTP(IMODE).EQ.13) THEN
6850 WGT = (M2(1)-M2(2)-M2(3))*(A(1)**2+A(2)**2)
6851 & -FOUR*M(2)*M(3)*A(1)*A(2)
6853 C--next the antifermion --> scalar antifermion diagrams
6854 ELSEIF(I2DRTP(IMODE).EQ.14) THEN
6855 WGT = HALF*((A(1)**2+A(2)**2)*(M2(1)+M2(3)-M2(2))
6856 & +FOUR*A(1)*A(2)*M(1)*M(3))
6857 E1 = SQRT(M2(2)+PCM2)
6858 E2 = SQRT(M2(3)+PCM2)
6859 MWGT = HALF*M2(1)/(E1+E2)*(E2+PCM)*ABS(A(1)**2-A(2)**2)+WGT
6860 C--unrecognised issue warning
6862 CALL HWWARN('HWITWO',500)
6864 WGT = P2MODE(IMODE)* WGT*PHS
6865 MWGT = 1.1D0*P2MODE(IMODE)*MWGT*PHS
6866 C--put the information in the common block
6867 WT2MAX(IMODE) = MWGT
6868 C--output the information
6869 IF(IPRINT.EQ.2) THEN
6872 WRITE(*,3030) WGT/HBAR/BRFRAC(ID2PRT(IMODE))*
6873 & RLTIM(IDK(ID2PRT(IMODE)))
6876 C--format statements
6877 3010 FORMAT(' PARTIAL WIDTH = ',G12.4)
6878 3020 FORMAT(' MAXIMUM WEIGHT = ',E12.4)
6879 3030 FORMAT(' RATIO TO ISAJET VALUE = ',G12.4)
6882 *CMZ :- -20/10/99 09:46:43 by Peter Richardson
6883 *-- Author : Peter Richardson
6884 C-----------------------------------------------------------------------
6885 SUBROUTINE HWD3ME(ID,ITYPE,IMODE,RHOIN,IDSPIN)
6886 C-----------------------------------------------------------------------
6887 C Subroutine to perform the three body decays for spin correlations
6888 C and SUSY three body modes
6889 C-----------------------------------------------------------------------
6890 INCLUDE 'herwig65.inc'
6891 INTEGER IMODE,I,J,ID,IDP(4+NDIAGR),ITYPE,NDIA,ID1,ID2,
6892 & DRTYPE(NDIAGR),NTRY,IDSPIN,NCTHRE,DRCF(NDIAGR)
6893 DOUBLE PRECISION A,B,MS,MWD,MA,MB,MA2,MB2,WGT,M342,HWRUNI,
6894 & HWUPCM,M232,M242,WMAX,WSUM,WSSUM,MR,PRE,TEMP,HWRGEN,WTMAX,
6895 & BRW(6),BRZ(12),P(5,4),PM(5,4),WGTM,CFTHRE(NCFMAX,NCFMAX)
6896 DOUBLE COMPLEX S,D,RHOIN(2,2),F0(2,2,8),F3(2,2,8),F1(2,2,8),
6897 & F2(2,2,8),F0M(2,2,8),F1M(2,2,8),F01(2,2,8,8)
6898 EXTERNAL HWRUNI,HWUPCM,HWRGEN
6899 COMMON/HWHEWS/S(8,8,2),D(8,8)
6900 COMMON/HWD3BY/F0,F0M,F1M,F1,F2,F3,F01,A(2,NDIAGR),B(2,NDIAGR),
6901 & MS(NDIAGR),MWD(NDIAGR),MR(NDIAGR),MA(4),MA2(4),MB(4),MB2(4),
6902 & M342,M232,M242,P,PM,CFTHRE,IDP,DRTYPE,NCTHRE,DRCF
6904 DATA BRW/0.321D0,0.321D0,0.000D0,0.108D0,0.108D0,0.108D0/
6905 DATA BRZ/0.154D0,0.120D0,0.154D0,0.120D0,0.152D0,0.000D0,
6906 & 0.033D0,0.067D0,0.033D0,0.067D0,0.033D0,0.067D0/
6907 C--compute the masses of external particles for the decay mode
6908 C--first for true three body decay modes
6910 C--initalisation for the diagrams
6911 WTMAX = WT3MAX(IMODE)
6913 NCTHRE = N3NCFL(IMODE)
6914 NDIA = NDI3BY(IMODE)
6915 IDP(1) = IDK(ID3PRT(IMODE))
6917 1 IDP(I+1) = IDKPRD(I,ID3PRT(IMODE))
6920 2 CFTHRE(I,J) = SPN3CF(I,J,IMODE)
6921 C--enter the couplings for the diagrams
6922 DO 3 I=1,NDI3BY(IMODE)
6923 DRTYPE(I) = I3DRTP(I,IMODE)
6924 DRCF (I) = I3DRCF(I,IMODE)
6926 A(J,I) = A3MODE(J,I,IMODE)
6927 3 B(J,I) = B3MODE(J,I,IMODE)
6928 C--enter the intermediate masses for the diagrams
6929 DO 4 I=1,NDI3BY(IMODE)
6930 IDP(I+4) = I3MODE(I,IMODE)
6931 MR(I) = RMASS(I3MODE(I,IMODE))
6933 IF(I3MODE(I,IMODE).GT.200) THEN
6934 MWD(I) = RMASS(I3MODE(I,IMODE))*HBAR/RLTIM(I3MODE(I,IMODE))
6935 ELSEIF(I3MODE(I,IMODE).EQ.200) THEN
6936 MWD(I) = RMASS(200)*GAMZ
6937 ELSEIF(I3MODE(I,IMODE).EQ.198.OR.I3MODE(I,IMODE).EQ.199) THEN
6938 MWD(I) = RMASS(198)*GAMW
6939 ELSEIF(I3MODE(I,IMODE).EQ.59) THEN
6943 C--reorder for top quark decay modes(b first then W products)
6944 IF(IDP(1).EQ.6.OR.IDP(1).EQ.12) THEN
6950 C--reorder if fermion not first
6951 IF(IDP(3).GT.IDP(4).AND.((IDP(1).EQ.6.OR.IDP(1).EQ.12).OR.
6952 & IDP(2).GE.400)) THEN
6957 C--then for two body modes to gauge bosons including boson decays
6959 C--initalisation for the diagram
6960 WTMAX = WTBMAX(ITYPE,IMODE)
6962 PRE = PBMODE(ITYPE,IMODE)
6963 DRTYPE(1) = IBDRTP(IMODE)
6967 C--particles in decay
6968 IDP(1) = IDK(IDBPRT(IMODE))
6969 IDP(2) = IDKPRD(1,IDBPRT(IMODE))
6970 IF(IDP(2).GE.198.AND.IDP(2).LE.200)
6971 & IDP(2) = IDKPRD(2,IDBPRT(IMODE))
6972 IDP(5) = IBMODE(IMODE)
6973 C--masses of virtual particles and couplings
6974 MR(1) = RMASS(IBMODE(IMODE))
6977 A(J,1) = ABMODE(J,IMODE)
6978 B(J,1) = BBMODE(J,ITYPE,IMODE)
6980 IF(IBMODE(IMODE).EQ.200) THEN
6981 MWD(1) = RMASS(200)*GAMZ
6983 MWD(1) = RMASS(198)*GAMW
6985 C--particles from boson decay
6986 IF(IBMODE(IMODE).EQ.200) THEN
6988 IF(ITYPE.GT.6) ID1 = ID1+114
6992 IF(ITYPE.GT.3) ID1 = ID1+114
6994 IF(IBMODE(IMODE).EQ.198) THEN
7002 C--only do the decay if possible for an on-shell boson
7003 IF(RMASS(ID1)+RMASS(ID2).GT.MR(1)) RETURN
7004 IF(IPRINT.EQ.2.AND..NOT.GENEV)
7005 & WRITE(6,3000) RNAME(IDP(5)),RNAME(IDP(3)),RNAME(IDP(4))
7006 MA(3) = RMASS(IDP(3))
7007 MA(4) = RMASS(IDP(4))
7011 C--set up the masses MA OFF SHELL MB ON SHELL
7013 MB(I) = RMASS(IDP(I))
7020 IF(MA(1).LT.MA(2)+MA(3)+MA(4)) RETURN
7021 C--compute the width and maximum weight if initialising
7023 C--search for maximum weight
7028 CALL HWD3M0(1,NDIA,WGT,WGTM,RHOIN,IDSPIN)
7031 IF(WGTM.GT.WMAX) WMAX = WGTM
7033 WSSUM = WSSUM+WGT**2
7034 IF(WGT.LT.ZERO) CALL HWWARN('HWD3ME',500)
7036 C--compute width and maximum weight
7037 WSUM = WSUM/DBLE(NSEARCH)
7038 WSSUM = MAX(ZERO,WSSUM/DBLE(NSEARCH)-WSUM**2)
7039 WSSUM = SQRT(WSSUM/DBLE(NSEARCH))
7040 C--if required output results
7041 IF(IPRINT.EQ.2) THEN
7042 WRITE(6,3010) WSUM,WSSUM
7045 TEMP = BRFRAC(ID3PRT(IMODE))*HBAR/RLTIM(IDK(ID3PRT(IMODE)))
7047 IF(IBMODE(IMODE).EQ.200) THEN
7048 TEMP = BRFRAC(IDBPRT(IMODE))*HBAR/
7049 & RLTIM(IDK(IDBPRT(IMODE)))*BRZ(ITYPE)
7051 TEMP = BRFRAC(IDBPRT(IMODE))*HBAR/
7052 & RLTIM(IDK(IDBPRT(IMODE)))*BRW(ITYPE)
7055 WRITE(6,3030) WSUM/TEMP,WSSUM/TEMP
7057 C--set up the maximum weight
7059 WT3MAX(IMODE) = 1.1D0*WMAX
7061 WTBMAX(ITYPE,IMODE) = 1.1D0*WMAX
7063 C--if not initialising generate the momenta
7065 C--generate a configuation
7068 CALL HWD3M0(ID,NDIA,WGT,WGTM,RHOIN,IDSPIN)
7070 C--check maximum isn't violated, increase and issue warning if it is
7071 IF(WGT.GT.WTMAX) THEN
7072 CALL HWWARN('HWD3ME',1)
7074 WRITE(6,3040) RNAME(IDP(1)),RNAME(IDP(2)),RNAME(IDP(3)),
7075 & RNAME(IDP(4)),WTMAX,WGT*1.1D0
7077 WRITE(6,3050) RNAME(IDP(1)),RNAME(IDP(2)),RNAME(IDP(5))
7078 WRITE(6,3060) RNAME(IDP(5)),RNAME(IDP(3)),RNAME(IDP(4)),
7083 WT3MAX(IMODE) = WTMAX
7085 WTBMAX(ITYPE,IMODE) = WTMAX
7088 IF(HWRGEN(0)*WTMAX.GT.WGT.AND.NTRY.LT.NSNTRY) GOTO 100
7089 IF(NTRY.GE.NSNTRY) THEN
7090 CALL HWWARN('HWD3ME',100)
7095 C--format statements for the outputs
7096 3000 FORMAT(/' FOLLOWED BY ',A8,' --> ',A8,' ',A8)
7097 3010 FORMAT(' PARTIAL WIDTH = ',G12.4,' +/- ',G12.4)
7098 3020 FORMAT(' MAXIMUM WEIGHT = ',E12.4)
7099 3030 FORMAT(' RATIO TO ISAJET VALUE = ',G12.4,' +/- ',G12.4)
7100 3040 FORMAT(/'WEIGHT FOR DECAY ',A8,' --> ',A8,' ',A8,' ',A8,
7102 & /10X,' MAXIMUM WEIGHT =',1PG24.16,
7103 & /10X,'NEW MAXIMUM WEIGHT =',1PG24.16)
7104 3050 FORMAT(/'WEIGHT FOR DECAY ',A8,' --> ',A8,' ',A8)
7105 3060 FORMAT(/' FOLLOWED BY ',A8,' --> ',A8,' ',A8,' EXCEEDS MAX',
7106 & /10X,' MAXIMUM WEIGHT =',1PG24.16,
7107 & /10X,'NEW MAXIMUM WEIGHT =',1PG24.16)
7111 *CMZ :- -09/04/02 13:46:07 by Peter Richardson
7112 *-- Author : Peter Richardson
7113 C-----------------------------------------------------------------------
7114 SUBROUTINE HWD3M0(ID,NDIA,WGT,MWGT,RHOIN,IDSPIN)
7115 C-----------------------------------------------------------------------
7116 C Subroutine to calculate the matrix element for a given mode
7117 C-----------------------------------------------------------------------
7118 INCLUDE 'herwig65.inc'
7119 INTEGER I,J,P0,P1,P2,P3,P0P,IB,ID,IDP(4+NDIAGR),IDSPIN,NDIA,
7120 & DRTYPE(NDIAGR),NCTHRE,DRCF(NDIAGR)
7121 DOUBLE PRECISION A,B,MS,MWD,MA,MB,MA2,MB2,WGT,FJAC,M342,HWRUNI,
7122 & M34,PCMA,PCMB,HWUPCM,PHS,N(3),HWVDOT,PP,HWULDO,EPS,PTMP(5),
7123 & M232,M242,PRE,PLAB,PRW,XMASS,PCM,P(5,4),PM(5,4),MR,PREF(5),
7124 & MMIN,MMAX,MWGT,CFTHRE(NCFMAX,NCFMAX),WGTB(NCFMAX),WGTC,
7126 DOUBLE COMPLEX S,D,ME(2,2,2,2,NCFMAX),MED(2,2,2,2),F01(2,2,8,8),
7127 & RHOIN(2,2),F0(2,2,8),F1(2,2,8),F2(2,2,8),F0M(2,2,8),
7128 & RHOB(2,2),F1M(2,2,8),F3(2,2,8)
7129 EXTERNAL HWRUNI,HWUPCM,HWVDOT,HWULDO,HWRGEN
7130 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
7131 COMMON/HWD3BY/F0,F0M,F1M,F1,F2,F3,F01,A(2,NDIAGR),B(2,NDIAGR),
7132 & MS(NDIAGR),MWD(NDIAGR),MR(NDIAGR),MA(4),MA2(4),MB(4),MB2(4),
7133 & M342,M232,M242,P,PM,CFTHRE,IDP,DRTYPE,NCTHRE,DRCF
7134 COMMON/HWHEWS/S(8,8,2),D(8,8)
7135 PARAMETER(EPS=1D-10)
7137 DATA PREF/1.0D0,0.0D0,0.0D0,1.0D0,0.0D0/
7138 C--select the momenta of the particles
7139 C--first see if there is a boson mode
7142 IF(DRTYPE(I).EQ.1.OR.DRTYPE(I).EQ.5.OR.DRTYPE(I).EQ.6.OR.
7143 & DRTYPE(I).EQ.7) IB = IDP(I+4)
7145 C--compute the mass of the 34 subsystem flat if no boson otherwise Breit-Wigner
7146 MMIN = (MA(3)+MA(4))**2
7147 MMAX = (MA(1)-MA(2))**2
7148 IF(IB.GT.0.AND.IB.NE.59) THEN
7149 CALL HWHGB1(1,2,IB,FJAC,M342,MMAX,MMIN)
7150 ELSEIF(IB.EQ.59) THEN
7151 M342 = HWRUNI(1,LOG(MMIN),LOG(MMAX))
7153 FJAC = (LOG(MMAX)-LOG(MMIN))*M342
7154 ELSEIF((DRTYPE(1).EQ.2.OR.DRTYPE(1).EQ.17).AND.
7155 & IDP(5).EQ.206.OR.IDP(5).EQ.207) THEN
7156 A02 = ATAN((MMIN-MS(1))/MWD(1))
7157 A2 = ATAN((MMAX-MS(1))/MWD(1))-A02
7158 M342 = MS(1)+MWD(1)*TAN(A02+A2*HWRGEN(1))
7159 FJAC = A2*((M342-MS(1))**2+MWD(1)**2)/MWD(1)
7162 M342 = HWRUNI(1,MMIN,MMAX)
7165 FJAC = HALF*FJAC/M34
7166 C--copy the momentum of the decaying particle into the internal common block
7167 CALL HWVEQU(5,PHEP(1,ID),P(1,1))
7170 C--perform the decay 1---> 2+34
7171 PCMA = HWUPCM(MA(1),MA(2),M34)
7173 CALL HWDTWO(P(1,1),PLAB(1,1),P(1,2),PCMA,2.0D0,.TRUE.)
7174 C--perform the decay 34 --> 3+4
7175 PCMB = HWUPCM(M34,MA(3),MA(4))
7176 CALL HWDTWO(PLAB(1,1),P(1,3),P(1,4),PCMB,2.0D0,.TRUE.)
7177 C--compute the phase sapce factors
7178 PHS = PCMA*PCMB*FJAC/32.0D0/PIFAC**3/MA2(1)
7179 C--compute the other possible masses for the propagator
7180 M232 = MA2(2)+MA2(3)+TWO*HWULDO(P(1,2),P(1,3))
7181 M242 = MA2(2)+MA2(4)+TWO*HWULDO(P(1,2),P(1,4))
7182 C--compute the vectors for the helicity amplitudes
7184 C--compute the references vectors
7185 C--not important if SM particle which can't have spin measured
7186 C--ie anything other the top and tau
7187 C--also not important if particle is approx massless
7188 C--first the SM particles other than top and tau
7189 IF(IDP(I).LT.400.AND.(IDP(I).NE.6.AND.IDP(I).NE.12
7190 & .AND.IDP(I).NE.125.AND.IDP(I).NE.131)) THEN
7191 CALL HWVEQU(5,PREF,PLAB(1,I+4))
7192 C--all other particles
7194 PP = SQRT(HWVDOT(3,P(1,I),P(1,I)))
7195 CALL HWVSCA(3,ONE/PP,P(1,I),N)
7196 PLAB(4,I+4) = HALF*(P(4,I)-PP)
7197 PP = HALF*(PP-MA(I)-PP**2/(MA(I)+P(4,I)))
7198 CALL HWVSCA(3,PP,N,PLAB(1,I+4))
7199 CALL HWUMAS(PLAB(1,I+4))
7200 PP = HWVDOT(3,PLAB(1,I+4),PLAB(1,I+4))
7201 C--fix to avoid problems if approx massless due to energy
7202 IF(PP.LT.EPS) CALL HWVEQU(5,PREF,PLAB(1,I+4))
7204 C--now the massless vectors
7205 PP = HALF*MA2(I)/HWULDO(PLAB(1,I+4),P(1,I))
7207 4 PLAB(J,I) = P(J,I)-PP*PLAB(J,I+4)
7208 3 CALL HWUMAS(PLAB(1,I))
7209 C--change order of momenta for call to HE code
7221 6 PCM(5,I)=PLAB(5,I)
7222 C--compute the S functions
7223 CALL HWHEW2(8,PCM(1,1),S(1,1,2),S(1,1,1),D)
7226 S(I,J,2) = -S(I,J,2)
7227 7 D(I,J) = TWO*D(I,J)
7228 C--compute the F functions
7229 CALL HWVSUM(5,PM(1,1),PM(1,2),PTMP)
7231 CALL HWH2F2(8,F0 ,5,PM(1,1), MA(1))
7232 CALL HWH2F1(8,F1 ,6,PM(1,2), MA(2))
7233 CALL HWH2F1(8,F2 ,7,PM(1,3), MA(3))
7234 CALL HWH2F1(8,F3 ,8,PM(1,4), MA(4))
7235 CALL HWH2F1(8,F0M,5,PM(1,1),-MA(1))
7236 CALL HWH2F2(8,F1M,6,PM(1,2),-MA(2))
7237 CALL HWH2F3(8,F01,PTMP,ZERO)
7238 C--now find the prefactor for all the diagrams
7239 PRE = HWULDO(PCM(1,5),PM(1,1))*HWULDO(PCM(1,6),PM(1,2))*
7240 & HWULDO(PCM(1,7),PM(1,3))*HWULDO(PCM(1,8),PM(1,4))
7242 C--zero the matrix element
7248 8 ME(P0,P1,P2,P3,I) = (0.0D0,0.0D0)
7249 C--now call the subroutines to compute the individual diagrams
7251 C--vector boson exchange diagram
7252 IF(DRTYPE(I).EQ.1) THEN
7254 C--Higgs boson exchange diagram
7255 ELSEIF(DRTYPE(I).EQ.2) THEN
7257 C--antisfermion exchange diagram
7258 ELSEIF(DRTYPE(I).EQ.3) THEN
7260 C--sfermion exchange diagram
7261 ELSEIF(DRTYPE(I).EQ.4) THEN
7263 C--antifermion vector boson exchange diagram
7264 ELSEIF(DRTYPE(I).EQ.5) THEN
7266 C--scalar vector boson exchange diagram
7267 ELSEIF(DRTYPE(I).EQ.6) THEN
7269 C--gravitino fermion fermion
7270 ELSEIF(DRTYPE(I).EQ.7) THEN
7273 ELSEIF(DRTYPE(I).EQ.8) THEN
7276 ELSEIF(DRTYPE(I).EQ.9) THEN
7279 ELSEIF(DRTYPE(I).EQ.10) THEN
7281 C--fermion --> 3 fermions 1
7282 ELSEIF(DRTYPE(I).EQ.11) THEN
7284 C--fermion --> 3 fermions 2
7285 ELSEIF(DRTYPE(I).EQ.12) THEN
7287 C--fermion --> 3 fermions 3
7288 ELSEIF(DRTYPE(I).EQ.13) THEN
7290 C--fermion --> 3 antifermions 1
7291 ELSEIF(DRTYPE(I).EQ.14) THEN
7293 C--fermion --> 3 antifermions 2
7294 ELSEIF(DRTYPE(I).EQ.15) THEN
7296 C--fermion --> 3 antifermions 3
7297 ELSEIF(DRTYPE(I).EQ.16) THEN
7299 C--antifermion --> antifermion fermion fermion
7300 ELSEIF(DRTYPE(I).EQ.17) THEN
7304 CALL HWWARN('HWD3M0',501)
7306 C--add up the matrix elements
7311 10 ME(P0,P1,P2,P3,DRCF(I)) = ME(P0,P1,P2,P3,DRCF(I))
7314 C--preform the final normalisation
7320 15 ME(P0,P1,P2,P3,I) = PRE*ME(P0,P1,P2,P3,I)
7321 C--compute the unnormalised spin density matrix
7324 RHOB(P0,P0P) = (0.0D0,0.0D0)
7330 35 RHOB(P0,P0P)=RHOB(P0,P0P)+CFTHRE(I,J)*ME(P0,P1,P2,P3,I)*
7331 & DCONJG(ME(P0P,P1,P2,P3,J))
7332 C--compute the weight
7336 45 WGT = WGT+DREAL(RHOIN(P0,P0P)*RHOB(P0,P0P))
7337 C--normalise this for phase space
7339 C--if initialising select the max weight
7340 IF(SYSPIN.OR.THREEB)
7341 & MWGT = PHS*(MAX(DBLE(RHOB(1,1)),DBLE(RHOB(2,2)))
7342 & +ABS(DBLE(RHOB(1,2)))+ABS(DIMAG(RHOB(1,2))))
7343 C--if generating the event put the information in the common block
7345 C--put the matrix element into the spin common block
7352 25 MESPN(P0,P1,P2,P3,I,IDSPIN) = ME(P0,P1,P2,P3,I)
7353 NCFL(IDSPIN) = NCTHRE
7355 C--if more than one colour flow pick the flow
7356 IF(SPCOPT.EQ.2.AND.NCTHRE.NE.1) THEN
7357 C--contstruct the matrix elements for the colour flows
7366 55 WGTB(I) = WGTB(I)+CFTHRE(I,I)*DREAL(
7367 & RHOIN(P0,P0P)*ME(P0 ,P1,P2,P3,I)*DCONJG(ME(P0P,P1,P2,P3,I)))
7368 WGTB(I) = WGTB(I)*PHS
7369 50 WGTC = WGTC+WGTB(I)
7372 60 WGTB(I) = WGTB(I)*WGTC
7373 C--select the colour flow
7374 WGTC = HWRGEN(1)*WGT
7376 IF(WGTB(I).GE.WGTC) THEN
7380 70 WGTC = WGTC-WGTB(I)
7381 C--otherwise if wrong options set issue warning
7382 ELSEIF(NCTHRE.NE.1) THEN
7384 CALL HWWARN('HWD3M0',500)
7387 1000 FORMAT(/'MULTIPLE COLOUR FLOWS IN DECAY'/'SPCOPT=2 MUST BE USED')
7390 *CMZ :- -10/10/01 14:34:54 by Peter Richardson
7391 *-- Author : Peter Richardson
7392 C-----------------------------------------------------------------------
7393 SUBROUTINE HWD3M1(ID,ME)
7394 C-----------------------------------------------------------------------
7395 C Subroutine to calculate the helicity amplitudes for the three body
7396 C gauge boson exchange diagram
7397 C-----------------------------------------------------------------------
7398 INCLUDE 'herwig65.inc'
7399 DOUBLE COMPLEX ME(2,2,2,2),S,D,F0(2,2,8),F1(2,2,8),F01(2,2,8,8),
7400 & F0M(2,2,8),F2(2,2,8),PRE,C(2,2),E(2,2),ZI,APP(2,2),APM(2,2),
7401 & AMP(2,2),AMM(2,2),F1M(2,2,8),F3(2,2,8)
7402 DOUBLE PRECISION A,B,MS,MWD,MA,MB,MA2,MB2,M342,M232,M242,CN,
7403 & MR,P(5,4),PM(5,4),CFTHRE(NCFMAX,NCFMAX)
7404 INTEGER P0,P1,P2,P3,ID,O(2),IDP(4+NDIAGR),DRTYPE(NDIAGR),NCTHRE,
7406 COMMON/HWD3BY/F0,F0M,F1M,F1,F2,F3,F01,A(2,NDIAGR),B(2,NDIAGR),
7407 & MS(NDIAGR),MWD(NDIAGR),MR(NDIAGR),MA(4),MA2(4),MB(4),MB2(4),
7408 & M342,M232,M242,P,PM,CFTHRE,IDP,DRTYPE,NCTHRE,DRCF
7409 PARAMETER(ZI=(0.0D0,1.0D0))
7410 COMMON/HWHEWS/S(8,8,2),D(8,8)
7413 C--compute the propagator factor
7414 PRE = -0.25D0/(M342-MS(ID)+ZI*MWD(ID))
7416 C--compute the C and D functions
7421 APP(P1,P2) = B( P2 ,ID)*S(7,3,O(P1))*S(4,8, P1 )
7424 AMM(P1,P2) = -B(O(P2),ID)*MA(3)*MA(4)
7425 C--the C and E functions
7426 C(P1,P2) = A( P1 ,ID)*( MA2(1)*S(6,2,O(P2))*S(2,5, P2 )
7427 & -MA2(2)*S(6,1,O(P2))*S(1,5, P2 ))
7428 & +A(O(P1),ID)*MA(1)*MA(2)*( S(6,1,O(P2))*S(1,5, P2 )
7429 & -S(6,2,O(P2))*S(2,5, P2 ))
7430 E(P1,P2) =CN*(B( P2 ,ID)*( MA2(3)*S(7,4,O(P1))*S(4,8, P1 )
7431 & +MA2(4)*S(7,3,O(P1))*S(3,8, P1 ))
7432 & -B(O(P2),ID)*MA(3)*MA(4)*( S(7,3,O(P1))*S(3,8, P1 )
7433 & +S(7,4,O(P1))*S(4,8, P1 )))
7437 APM(P1,P2) = B( P2 ,ID)*MA(3)*S(4,8,O(P1))
7438 AMP(P1,P2) =-B(O(P2),ID)*MA(4)*S(7,3,O(P1))
7440 C--the C and D functions
7441 C(P1,P2) = A( P1 ,ID)*MA(2)*( MA2(1)*S(6,5,O(P2))
7442 & -S(6,2,O(P2))*S(2,1, P2 )*S(1,5,O(P2)))
7443 & +A(O(P1),ID)*MA(1)*(-MA2(2)*S(6,5,O(P2))
7444 & +S(6,2,O(P2))*S(2,1, P2 )*S(1,5,O(P2)))
7445 E(P1,P2) =CN*( B( P2 ,ID)*MA(3)*( MA2(4)*S(7,8,O(P1))
7446 & +S(7,3,O(P1))*S(3,4, P1 )*S(4,8,O(P1)))
7447 & -B(O(P2),ID)*MA(4)*( MA2(3)*S(7,8,O(P1))
7448 & +S(7,3,O(P1))*S(3,4, P1 )*S(4,8,O(P1))))
7451 C--compute the matrix element
7457 & APP(P2,P3)*( A(O(P2),ID)*F1(O(P1), P2 ,4)*F0( P2 ,O(P0),3)
7458 & +A( P2 ,ID)*F1(O(P1),O(P2),3)*F0(O(P2),O(P0),4))
7459 & +APM(P2,P3)*( A( P2 ,ID)*F1(O(P1),O(P2),4)*F0(O(P2),O(P0),7)
7460 & +A(O(P2),ID)*F1(O(P1), P2 ,7)*F0( P2 ,O(P0),4))
7461 & +AMP(P2,P3)*( A(O(P2),ID)*F1(O(P1), P2 ,8)*F0( P2 ,O(P0),3)
7462 & +A( P2 ,ID)*F1(O(P1),O(P2),3)*F0(O(P2),O(P0),8))
7463 & +AMM(P2,P3)*( A( P2 ,ID)*F1(O(P1),O(P2),8)*F0(O(P2),O(P0),7)
7464 & +A(O(P2),ID)*F1(O(P1), P2 ,7)*F0( P2 ,O(P0),8))
7465 20 ME(P0,P1,P2,P3) =PRE*(TWO*ME(P0,P1,P2,P3)+C(P0,P1)*E(P2,P3))
7468 *CMZ :- -10/10/01 14:34:54 by Peter Richardson
7469 *-- Author : Peter Richardson
7470 C-----------------------------------------------------------------------
7471 SUBROUTINE HWD3M2(ID,ME)
7472 C-----------------------------------------------------------------------
7473 C Subroutine to calculate the helicity amplitudes for the three body
7474 C Higgs boson exchange diagram
7475 C-----------------------------------------------------------------------
7476 INCLUDE 'herwig65.inc'
7477 DOUBLE COMPLEX ME(2,2,2,2),S,D,F0(2,2,8),F1(2,2,8),F01(2,2,8,8),
7478 & F0M(2,2,8),F2(2,2,8),PRE,ZI,V1(2,2),V2(2,2),F1M(2,2,8),
7480 DOUBLE PRECISION A,B,MS,MWD,MA,MB,MA2,MB2,M342,M232,M242,MR,
7481 & P(5,4),PM(5,4),CFTHRE(NCFMAX,NCFMAX)
7482 INTEGER P0,P1,P2,P3,ID,O(2),IDP(4+NDIAGR),DRTYPE(NDIAGR),NCTHRE,
7484 COMMON/HWD3BY/F0,F0M,F1M,F1,F2,F3,F01,A(2,NDIAGR),B(2,NDIAGR),
7485 & MS(NDIAGR),MWD(NDIAGR),MR(NDIAGR),MA(4),MA2(4),MB(4),MB2(4),
7486 & M342,M232,M242,P,PM,CFTHRE,IDP,DRTYPE,NCTHRE,DRCF
7487 COMMON/HWHEWS/S(8,8,2),D(8,8)
7488 PARAMETER(ZI=(0.0D0,1.0D0))
7491 C--decide whether to do the diagram
7492 IF(MB(2)+MR(ID).LT.MB(1).AND.MR(ID).GT.MB(3)+MB(4).AND.
7493 & IDP(4+ID).NE.206) THEN
7498 5 ME(P0,P1,P2,P3) = (0.0D0,0.0D0)
7501 C--calculate the propagator factor
7502 PRE = 0.25D0/(M342-MS(ID)+ZI*MWD(ID))
7503 C--calculate the vertex functions
7506 V1(P1,P2) = PRE*( A( P1 ,ID)*F1(O(P2), P1 ,1)*S(1,5,P1)
7507 & +A(O(P1),ID)*F1(O(P2),O(P1),5)*MA(1))
7508 10 V2(P1,P2) = B( P2 ,ID)*F2(O(P1), P2 ,4)*S(4,8,P2)
7509 & -B(O(P2),ID)*F2(O(P1),O(P2),8)*MA(4)
7510 C--calculate the matrix element
7515 20 ME(P0,P1,P2,P3) = V1(P0,P1)*V2(P2,P3)
7518 *CMZ :- -10/10/01 14:34:54 by Peter Richardson
7519 *-- Author : Peter Richardson
7520 C-----------------------------------------------------------------------
7521 SUBROUTINE HWD3M3(ID,ME)
7522 C-----------------------------------------------------------------------
7523 C Subroutine to calculate the helicity amplitudes for the three body
7524 C antisfermion exchange diagram
7525 C-----------------------------------------------------------------------
7526 INCLUDE 'herwig65.inc'
7527 DOUBLE COMPLEX ME(2,2,2,2),S,D,F0(2,2,8),F1(2,2,8),F01(2,2,8,8),
7528 & F0M(2,2,8),F2(2,2,8),PRE,V1(2,2),V2(2,2),ZI,F1M(2,2,8),
7530 DOUBLE PRECISION A,B,MS,MWD,MA,MB,MA2,MB2,M342,M232,M242,MR,
7531 & P(5,4),PM(5,4),CFTHRE(NCFMAX,NCFMAX)
7532 INTEGER P0,P1,P2,P3,ID,O(2),IDP(4+NDIAGR),DRTYPE(NDIAGR),NCTHRE,
7534 COMMON/HWD3BY/F0,F0M,F1M,F1,F2,F3,F01,A(2,NDIAGR),B(2,NDIAGR),
7535 & MS(NDIAGR),MWD(NDIAGR),MR(NDIAGR),MA(4),MA2(4),MB(4),MB2(4),
7536 & M342,M232,M242,P,PM,CFTHRE,IDP,DRTYPE,NCTHRE,DRCF
7537 COMMON/HWHEWS/S(8,8,2),D(8,8)
7538 PARAMETER(ZI=(0.0D0,1.0D0))
7541 C--decide whether to do the diagram
7542 IF(MB(3)+MR(ID).LT.MB(1).AND.MR(ID).GT.MB(2)+MB(4)) THEN
7547 5 ME(P0,P1,P2,P3) = (0.0D0,0.0D0)
7550 C--compute the propagator factor
7551 PRE = -0.25D0/(M242-MS(ID)+ZI*MWD(ID))
7552 C--compute the vertex factors
7555 V1(P1,P2) = PRE*( A( P1 ,ID)*F2(O(P2), P1 ,1)*S(1,5,P1)
7556 & +A(O(P1),ID)*F2(O(P2),O(P1),5)*MA(1))
7557 10 V2(P1,P2) = B( P2 ,ID)*F1(O(P1), P2 ,4)*S(4,8,P2)
7558 & -B(O(P2),ID)*F1(O(P1),O(P2),8)*MA(4)
7559 C--compute the matrix element
7564 20 ME(P0,P1,P2,P3) = V1(P0,P2)*V2(P1,P3)
7567 *CMZ :- -10/10/01 14:34:54 by Peter Richardson
7568 *-- Author : Peter Richardson
7569 C-----------------------------------------------------------------------
7570 SUBROUTINE HWD3M4(ID,ME)
7571 C-----------------------------------------------------------------------
7572 C Subroutine to calculate the helicity amplitudes for the three body
7573 C sfermion exchange diagram
7574 C-----------------------------------------------------------------------
7575 INCLUDE 'herwig65.inc'
7576 DOUBLE COMPLEX ME(2,2,2,2),S,D,F0(2,2,8),F1(2,2,8),F01(2,2,8,8),
7577 & F0M(2,2,8),F2(2,2,8),PRE,ZI,V1(2,2),V2(2,2),F1M(2,2,8),
7579 DOUBLE PRECISION A,B,MS,MWD,MA,MB,MA2,MB2,M342,M232,M242,MR,
7580 &P(5,4),PM(5,4),CFTHRE(NCFMAX,NCFMAX)
7581 INTEGER P0,P1,P2,P3,ID,O(2),IDP(4+NDIAGR),DRTYPE(NDIAGR),NCTHRE,
7583 COMMON/HWHEWS/S(8,8,2),D(8,8)
7584 COMMON/HWD3BY/F0,F0M,F1M,F1,F2,F3,F01,A(2,NDIAGR),B(2,NDIAGR),
7585 & MS(NDIAGR),MWD(NDIAGR),MR(NDIAGR),MA(4),MA2(4),MB(4),MB2(4),
7586 & M342,M232,M242,P,PM,CFTHRE,IDP,DRTYPE,NCTHRE,DRCF
7587 PARAMETER(ZI=(0.0D0,1.0D0))
7590 C--decide whether to do the diagram
7591 IF(MB(4)+MR(ID).LT.MB(1).AND.MR(ID).GT.MB(2)+MB(3)) THEN
7596 5 ME(P0,P1,P2,P3) = (0.0D0,0.0D0)
7599 C--compute the propagator factor
7600 PRE = 0.25D0/(M232-MS(ID)+ZI*MWD(ID))
7601 C--compute the factors for the two vertices
7604 V1(P1,P2) = PRE*( A( P2 ,ID)*F0M( P1 , P2 ,4)*S(4,8, P2 )
7605 & -A(O(P2),ID)*F0M( P1 ,O(P2),8)*MA(4))
7606 10 V2(P1,P2) = B(O(P1),ID)*F2 (O(P2),O(P1),2)*S(2,6,O(P1))
7607 & -B( P1 ,ID)*F2 (O(P2), P1 ,6)*MA(2)
7608 C--now compute the matrix element
7613 20 ME(P0,P1,P2,P3) = V1(P0,P3)*V2(P1,P2)
7616 *CMZ :- -10/10/01 14:34:54 by Peter Richardson
7617 *-- Author : Peter Richardson
7618 C-----------------------------------------------------------------------
7619 SUBROUTINE HWD3M5(ID,ME)
7620 C-----------------------------------------------------------------------
7621 C Subroutine to calculate the helicity amplitudes for the three body
7622 C gauge boson exchange diagram (antiparticle decay)
7623 C-----------------------------------------------------------------------
7624 INCLUDE 'herwig65.inc'
7625 DOUBLE COMPLEX ME(2,2,2,2),S,D,F0(2,2,8),F1(2,2,8),
7626 & F0M(2,2,8),F2(2,2,8),PRE,C(2,2),E(2,2),ZI,APP(2,2),APM(2,2),
7627 & AMP(2,2),AMM(2,2),F1M(2,2,8),F3(2,2,8),F01(2,2,8,8)
7628 DOUBLE PRECISION A,B,MS,MWD,MA,MB,MA2,MB2,M342,M232,M242,CN,MR,
7629 & P(5,4),PM(5,4),CFTHRE(NCFMAX,NCFMAX)
7630 INTEGER P0,P1,P2,P3,ID,O(2),IDP(4+NDIAGR),DRTYPE(NDIAGR),NCTHRE,
7632 COMMON/HWD3BY/F0,F0M,F1M,F1,F2,F3,F01,A(2,NDIAGR),B(2,NDIAGR),
7633 & MS(NDIAGR),MWD(NDIAGR),MR(NDIAGR),MA(4),MA2(4),MB(4),MB2(4),
7634 & M342,M232,M242,P,PM,CFTHRE,IDP,DRTYPE,NCTHRE,DRCF
7635 PARAMETER(ZI=(0.0D0,1.0D0))
7636 COMMON/HWHEWS/S(8,8,2),D(8,8)
7639 C--compute the propagator factor
7640 PRE = -0.25D0/(M342-MS(ID)+ZI*MWD(ID))
7642 C--compute the C and D functions
7647 APP(P1,P2) = B( P2 ,ID)*S(7,3,O(P1))*S(4,8, P1 )
7650 AMM(P1,P2) = -B(O(P2),ID)*MA(3)*MA(4)
7651 C--the C and E functions
7652 C(P1,P2) = A( P2 ,ID)*( MA2(1)*S(5,2,O(P1))*S(2,6, P1 )
7653 & -MA2(2)*S(5,1,O(P1))*S(1,6, P1 ))
7654 & +A(O(P2),ID)*MA(1)*MA(2)*( S(5,1,O(P1))*S(1,6, P1 )
7655 & -S(5,2,O(P1))*S(2,6, P1 ))
7656 E(P1,P2) =CN*(B( P2 ,ID)*( MA2(3)*S(7,4,O(P1))*S(4,8, P1 )
7657 & +MA2(4)*S(7,3,O(P1))*S(3,8, P1 ))
7658 & -B(O(P2),ID)*MA(3)*MA(4)*( S(7,3,O(P1))*S(3,8, P1 )
7659 & +S(7,4,O(P1))*S(4,8, P1 )))
7663 APM(P1,P2) = B( P2 ,ID)*MA(3)*S(4,8,O(P1))
7664 AMP(P1,P2) =-B(O(P2),ID)*MA(4)*S(7,3,O(P1))
7666 C--the C and D functions
7667 C(P1,P2) = A( P2 ,ID)*MA(1)*( MA2(2)*S(5,6,O(P1))
7668 & -S(5,1,O(P1))*S(1,2, P1 )*S(2,6,O(P1)))
7669 & +A(O(P2),ID)*MA(2)*(-MA2(1)*S(5,6,O(P1))
7670 & +S(5,1,O(P1))*S(1,2, P1 )*S(2,6,O(P1)))
7671 E(P1,P2) =CN*( B( P2 ,ID)*MA(3)*( MA2(4)*S(7,8,O(P1))
7672 & +S(7,3,O(P1))*S(3,4, P1 )*S(4,8,O(P1)))
7673 & -B(O(P2),ID)*MA(4)*( MA2(3)*S(7,8,O(P1))
7674 & +S(7,3,O(P1))*S(3,4, P1 )*S(4,8,O(P1))))
7677 C--compute the matrix element
7683 & APP(P2,P3)*( A(O(P2),ID)*F0M(O(P0), P2 ,4)*F1M( P2 ,O(P1),3)
7684 & +A( P2 ,ID)*F0M(O(P0),O(P2),3)*F1M(O(P2),O(P1),4))
7685 & +APM(P2,P3)*( A( P2 ,ID)*F0M(O(P0),O(P2),4)*F1M(O(P2),O(P1),7)
7686 & +A(O(P2),ID)*F0M(O(P0), P2 ,7)*F1M( P2 ,O(P1),4))
7687 & +AMP(P2,P3)*( A(O(P2),ID)*F0M(O(P0), P2 ,8)*F1M( P2 ,O(P1),3)
7688 & +A( P2 ,ID)*F0M(O(P0),O(P2),3)*F1M(O(P2),O(P1),8))
7689 & +AMM(P2,P3)*( A( P2 ,ID)*F0M(O(P0),O(P2),8)*F1M(O(P2),O(P1),7)
7690 & +A(O(P2),ID)*F0M(O(P0), P2 ,7)*F1M( P2 ,O(P1),8))
7691 20 ME(P0,P1,P2,P3) =PRE*(TWO*ME(P0,P1,P2,P3)+C(P0,P1)*E(P2,P3))
7694 *CMZ :- -10/10/01 14:34:54 by Peter Richardson
7695 *-- Author : Peter Richardson
7696 C-----------------------------------------------------------------------
7697 SUBROUTINE HWD3M6(ID,ME)
7698 C-----------------------------------------------------------------------
7699 C Subroutine to calculate the helicity amplitudes for the three body
7700 C gauge boson exchange diagram
7701 C-----------------------------------------------------------------------
7702 INCLUDE 'herwig65.inc'
7703 DOUBLE COMPLEX ME(2,2,2,2),S,D,F0(2,2,8),F1(2,2,8),
7704 & F0M(2,2,8),F2(2,2,8),PRE,C(2,2),ZI,APP(2,2),APM(2,2),
7705 & AMP(2,2),AMM(2,2),F1M(2,2,8),F3(2,2,8),F01(2,2,8,8)
7706 DOUBLE PRECISION A,B,MS,MWD,MA,MB,MA2,MB2,M342,M232,M242,CN,MR,
7707 & P(5,4),DOT,HWULDO,PM(5,4),CFTHRE(NCFMAX,NCFMAX)
7708 INTEGER P0,P1,P2,P3,ID,O(2),IDP(4+NDIAGR),DRTYPE(NDIAGR),NCTHRE,
7710 COMMON/HWD3BY/F0,F0M,F1M,F1,F2,F3,F01,A(2,NDIAGR),B(2,NDIAGR),
7711 & MS(NDIAGR),MWD(NDIAGR),MR(NDIAGR),MA(4),MA2(4),MB(4),MB2(4),
7712 & M342,M232,M242,P,PM,CFTHRE,IDP,DRTYPE,NCTHRE,DRCF
7713 DOUBLE PRECISION XMASS,PLAB,PRW,PCM
7714 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
7715 PARAMETER(ZI=(0.0D0,1.0D0))
7716 COMMON/HWHEWS/S(8,8,2),D(8,8)
7720 C--compute the propagator factor
7721 PRE = SQRT(HWULDO(PCM(1,5),PM(1,1))*HWULDO(PCM(1,6),PM(1,2)))
7722 PRE = -HALF*PRE*A(1,ID)/(M342-MS(ID)+ZI*MWD(ID))
7724 DOT = HWULDO(P(1,1),P(1,3))+HWULDO(P(1,1),P(1,4))
7725 & +HWULDO(P(1,2),P(1,3))+HWULDO(P(1,2),P(1,4))
7726 C--compute the C and D functions
7731 APP(P1,P2) = B( P2 ,ID)*S(7,3,O(P1))*S(4,8, P1 )
7734 AMM(P1,P2) = -B(O(P2),ID)*MA(3)*MA(4)
7736 C(P1,P2) =CN*(B( P2 ,ID)*( MA2(3)*S(7,4,O(P1))*S(4,8, P1 )
7737 & +MA2(4)*S(7,3,O(P1))*S(3,8, P1 ))
7738 & -B(O(P2),ID)*MA(3)*MA(4)*( S(7,3,O(P1))*S(3,8, P1 )
7739 & +S(7,4,O(P1))*S(4,8, P1 )))
7743 APM(P1,P2) = B( P2 ,ID)*MA(3)*S(4,8,O(P1))
7744 AMP(P1,P2) =-B(O(P2),ID)*MA(4)*S(7,3,O(P1))
7747 C(P1,P2) =CN*( B( P2 ,ID)*MA(3)*( MA2(4)*S(7,8,O(P1))
7748 & +S(7,3,O(P1))*S(3,4, P1 )*S(4,8,O(P1)))
7749 & -B(O(P2),ID)*MA(4)*( MA2(3)*S(7,8,O(P1))
7750 & +S(7,3,O(P1))*S(3,4, P1 )*S(4,8,O(P1))))
7753 C--compute the matrix element
7758 15 ME(P0,P1,P2,P3) = (0.0D0,0.0D0)
7761 20 ME(1,1,P2,P3) = PRE*(DOT*C(P2,P3)
7762 & +APP(P2,P3)*F01( P2 , P2 ,3,4)+APM(P2,P3)*F01(O(P2),O(P2),7,4)
7763 & +AMP(P2,P3)*F01( P2 , P2 ,3,8)+AMM(P2,P3)*F01(O(P2),O(P2),7,8))
7766 *CMZ :- -13/03/02 14:19:47 by Peter Richardson
7767 *-- Author : Peter Richardson
7768 C-----------------------------------------------------------------------
7769 SUBROUTINE HWD3M7(ID,ME)
7770 C-----------------------------------------------------------------------
7771 C Subroutine to calculate the helicity amplitudes for the three body
7772 C decay fermion --> gravitino fermion antifermion (via gauge boson)
7773 C-----------------------------------------------------------------------
7774 INCLUDE 'herwig65.inc'
7775 DOUBLE COMPLEX ME(2,2,2,2),S,D,F0(2,2,8),F1(2,2,8),F01(2,2,8,8),
7776 & F0M(2,2,8),F2(2,2,8),PRE,ZI,F1M(2,2,8),F3(2,2,8)
7777 DOUBLE PRECISION A,B,MS,MWD,MA,MB,MA2,MB2,M342,M232,M242,MR,
7778 &P(5,4),PM(5,4),CFTHRE(NCFMAX,NCFMAX),HWULDO,DL(2,2)
7779 INTEGER P0,P1,ID,O(2),IDP(4+NDIAGR),DRTYPE(NDIAGR),NCTHRE,
7781 COMMON/HWHEWS/S(8,8,2),D(8,8)
7782 COMMON/HWD3BY/F0,F0M,F1M,F1,F2,F3,F01,A(2,NDIAGR),B(2,NDIAGR),
7783 & MS(NDIAGR),MWD(NDIAGR),MR(NDIAGR),MA(4),MA2(4),MB(4),MB2(4),
7784 & M342,M232,M242,P,PM,CFTHRE,IDP,DRTYPE,NCTHRE,DRCF
7785 PARAMETER(ZI=(0.0D0,1.0D0))
7786 DOUBLE PRECISION XMASS,PLAB,PRW,PCM
7787 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
7791 DATA DL/1.0D0,0.0D0,0.0D0,1.0D0/
7792 C--compute the propagator factor
7793 PRE = HALF*HWULDO(PCM(1,6),PM(1,2))*
7794 & HWULDO(PCM(1,7),PM(1,3))*HWULDO(PCM(1,8),PM(1,4))
7796 PRE = PRE/(M342-MS(ID)+ZI*MWD(ID))
7799 ME(P0,P1, P1 , P1 ) = PRE*B( P1 ,ID)*(
7800 & A(1,ID)*S(2,3,P1)*S(3,4,O(P1))*S(3,2, P1 )*F0(O(P1),O(P0),2)
7801 & +A(2,ID)* DL(P1,1)*S(2,3, P1 )*S(4,2,O(P1))*F0( 1 ,O(P0),2))
7802 ME(P0,P1,O(P1),O(P1)) = PRE*B(O(P1),ID)*(
7803 & A(1,ID)*S(2,4,P1)*S(4,3,O(P1))*S(4,2, P1 )*F0(O(P1),O(P0),2)
7804 & +A(2,ID)* DL(P1,1)*S(2,4, P1 )*S(3,2,O(P1))*F0( 1 ,O(P0),2))
7805 ME(P0,P1,O(P1), P1 ) = (0.0D0,0.0D0)
7806 10 ME(P0,P1, P1 ,O(P1)) = (0.0D0,0.0D0)
7809 *CMZ :- -08/04/02 14:48:42 by Peter Richardson
7810 *-- Author : Peter Richardson
7811 C-----------------------------------------------------------------------
7812 SUBROUTINE HWD3M8(ID,ME)
7813 C-----------------------------------------------------------------------
7814 C Subroutine to calculate the helicity amplitudes for 1st 3 body RPV
7815 C diagram f--> fbar fbar f
7816 C-----------------------------------------------------------------------
7817 INCLUDE 'herwig65.inc'
7818 DOUBLE COMPLEX ME(2,2,2,2),S,D,F0(2,2,8),F1(2,2,8),F01(2,2,8,8),
7819 & F0M(2,2,8),F2(2,2,8),PRE,ZI,V1(2,2),V2(2,2),F1M(2,2,8),
7821 DOUBLE PRECISION A,B,MS,MWD,MA,MB,MA2,MB2,M342,M232,M242,MR,
7822 & P(5,4),PM(5,4),CFTHRE(NCFMAX,NCFMAX)
7823 INTEGER P0,P1,P2,P3,ID,O(2),IDP(4+NDIAGR),DRTYPE(NDIAGR),NCTHRE,
7825 COMMON/HWD3BY/F0,F0M,F1M,F1,F2,F3,F01,A(2,NDIAGR),B(2,NDIAGR),
7826 & MS(NDIAGR),MWD(NDIAGR),MR(NDIAGR),MA(4),MA2(4),MB(4),MB2(4),
7827 & M342,M232,M242,P,PM,CFTHRE,IDP,DRTYPE,NCTHRE,DRCF
7828 COMMON/HWHEWS/S(8,8,2),D(8,8)
7829 PARAMETER(ZI=(0.0D0,1.0D0))
7832 C--decide whether to do the diagram
7833 IF(MB(2)+MR(ID).LT.MB(1).AND.MR(ID).GT.MB(3)+MB(4)) THEN
7838 5 ME(P0,P1,P2,P3) = (0.0D0,0.0D0)
7841 C--calculate the propagator factor
7842 PRE = 0.25D0/(M342-MS(ID)+ZI*MWD(ID))
7843 C--calculate the vertex functions
7846 V1(P1,P2) = PRE*( A( P2 ,ID)*F0M( P1 , P2 ,2)*S(2,6, P2)
7847 & -A(O(P2),ID)*F0M( P1 ,O(P2),6)*MA(2))
7848 10 V2(P1,P2) = B( P1 ,ID)*F3 (O(P2), P1 ,3)*S(3,7,P1)
7849 & -B(O(P1),ID)*F3 (O(P2),O(P1),7)*MA(3)
7850 C--calculate the matrix element
7855 20 ME(P0,P1,P2,P3) = V1(P0,P1)*V2(P2,P3)
7858 *CMZ :- -08/04/02 14:48:42 by Peter Richardson
7859 *-- Author : Peter Richardson
7860 C-----------------------------------------------------------------------
7861 SUBROUTINE HWD3M9(ID,ME)
7862 C-----------------------------------------------------------------------
7863 C Subroutine to calculate the helicity amplitudes for 2nd 3 body RPV
7864 C diagram f --> fbar fbar f
7865 C-----------------------------------------------------------------------
7866 INCLUDE 'herwig65.inc'
7867 DOUBLE COMPLEX ME(2,2,2,2),S,D,F0(2,2,8),F1(2,2,8),F01(2,2,8,8),
7868 & F0M(2,2,8),F2(2,2,8),PRE,V1(2,2),V2(2,2),ZI,F1M(2,2,8),
7870 DOUBLE PRECISION A,B,MS,MWD,MA,MB,MA2,MB2,M342,M232,M242,MR,
7871 & P(5,4),PM(5,4),CFTHRE(NCFMAX,NCFMAX)
7872 INTEGER P0,P1,P2,P3,ID,O(2),IDP(4+NDIAGR),DRTYPE(NDIAGR),NCTHRE,
7874 COMMON/HWD3BY/F0,F0M,F1M,F1,F2,F3,F01,A(2,NDIAGR),B(2,NDIAGR),
7875 & MS(NDIAGR),MWD(NDIAGR),MR(NDIAGR),MA(4),MA2(4),MB(4),MB2(4),
7876 & M342,M232,M242,P,PM,CFTHRE,IDP,DRTYPE,NCTHRE,DRCF
7877 COMMON/HWHEWS/S(8,8,2),D(8,8)
7878 PARAMETER(ZI=(0.0D0,1.0D0))
7881 C--decide whether to do the diagram
7882 IF(MB(3)+MR(ID).LT.MB(1).AND.MR(ID).GT.MB(2)+MB(4)) THEN
7887 5 ME(P0,P1,P2,P3) = (0.0D0,0.0D0)
7890 C--compute the propagator factor
7891 PRE = -0.25D0/(M242-MS(ID)+ZI*MWD(ID))
7892 C--compute the vertex factors
7895 V1(P1,P2) = PRE*( A( P2 ,ID)*F0M( P1 , P2 ,3)*S(3,7,P2)
7896 & -A(O(P2),ID)*F0M( P1 ,O(P2),7)*MA(3))
7897 10 V2(P1,P2) = B( P1 ,ID)*F3 (O(P2), P1 ,2)*S(2,6,P1)
7898 & -B(O(P1),ID)*F3 (O(P2),O(P1),6)*MA(2)
7899 C--compute the matrix element
7904 20 ME(P0,P1,P2,P3) = V1(P0,P2)*V2(P1,P3)
7907 *CMZ :- -08/04/02 14:48:42 by Peter Richardson
7908 *-- Author : Peter Richardson
7909 C-----------------------------------------------------------------------
7910 SUBROUTINE HWD3MA(ID,ME)
7911 C-----------------------------------------------------------------------
7912 C Subroutine to calculate the helicity amplitudes for 3rd 3 body RPV
7913 C diagram f --> fbar fbar f
7914 C-----------------------------------------------------------------------
7915 INCLUDE 'herwig65.inc'
7916 DOUBLE COMPLEX ME(2,2,2,2),S,D,F0(2,2,8),F1(2,2,8),F01(2,2,8,8),
7917 & F0M(2,2,8),F2(2,2,8),PRE,ZI,V1(2,2),V2(2,2),F1M(2,2,8),
7919 DOUBLE PRECISION A,B,MS,MWD,MA,MB,MA2,MB2,M342,M232,M242,MR,
7920 &P(5,4),PM(5,4),CFTHRE(NCFMAX,NCFMAX)
7921 INTEGER P0,P1,P2,P3,ID,O(2),IDP(4+NDIAGR),DRTYPE(NDIAGR),NCTHRE,
7923 COMMON/HWHEWS/S(8,8,2),D(8,8)
7924 COMMON/HWD3BY/F0,F0M,F1M,F1,F2,F3,F01,A(2,NDIAGR),B(2,NDIAGR),
7925 & MS(NDIAGR),MWD(NDIAGR),MR(NDIAGR),MA(4),MA2(4),MB(4),MB2(4),
7926 & M342,M232,M242,P,PM,CFTHRE,IDP,DRTYPE,NCTHRE,DRCF
7927 PARAMETER(ZI=(0.0D0,1.0D0))
7930 C--decide whether to do the diagram
7931 IF(MB(4)+MR(ID).LT.MB(1).AND.MR(ID).GT.MB(2)+MB(3)) THEN
7936 5 ME(P0,P1,P2,P3) = (0.0D0,0.0D0)
7939 C--compute the propagator factor
7940 PRE = 0.25D0/(M232-MS(ID)+ZI*MWD(ID))
7941 C--compute the factors for the two vertices
7944 V1(P1,P2) = PRE*( A( P1 ,ID)*F3(O(P2), P1 ,1)*S(1,5,P1)
7945 & +A(O(P1),ID)*F3(O(P2),O(P1),5)*MA(1))
7946 10 V2(P1,P2) = B( P2 ,ID)*F1( P1 , P2 ,3)*S(3,7,P2)
7947 & -B(O(P2),ID)*F1( P1 ,O(P2),7)*MA(3)
7948 C--now compute the matrix element
7953 20 ME(P0,P1,P2,P3) = V1(P0,P3)*V2(P1,P2)
7956 *CMZ :- -08/04/02 14:48:42 by Peter Richardson
7957 *-- Author : Peter Richardson
7958 C-----------------------------------------------------------------------
7959 SUBROUTINE HWD3MB(ID,ME)
7960 C-----------------------------------------------------------------------
7961 C Subroutine to calculate the helicity amplitudes for 4th 3 body RPV
7962 C diagram f --> f f f
7963 C-----------------------------------------------------------------------
7964 INCLUDE 'herwig65.inc'
7965 DOUBLE COMPLEX ME(2,2,2,2),S,D,F0(2,2,8),F1(2,2,8),F01(2,2,8,8),
7966 & F0M(2,2,8),F2(2,2,8),PRE,ZI,V1(2,2),V2(2,2),F1M(2,2,8),
7968 DOUBLE PRECISION A,B,MS,MWD,MA,MB,MA2,MB2,M342,M232,M242,MR,
7969 & P(5,4),PM(5,4),CFTHRE(NCFMAX,NCFMAX)
7970 INTEGER P0,P1,P2,P3,ID,O(2),IDP(4+NDIAGR),DRTYPE(NDIAGR),NCTHRE,
7972 COMMON/HWD3BY/F0,F0M,F1M,F1,F2,F3,F01,A(2,NDIAGR),B(2,NDIAGR),
7973 & MS(NDIAGR),MWD(NDIAGR),MR(NDIAGR),MA(4),MA2(4),MB(4),MB2(4),
7974 & M342,M232,M242,P,PM,CFTHRE,IDP,DRTYPE,NCTHRE,DRCF
7975 COMMON/HWHEWS/S(8,8,2),D(8,8)
7976 PARAMETER(ZI=(0.0D0,1.0D0))
7979 C--decide whether to do the diagram
7980 IF(MB(2)+MR(ID).LT.MB(1).AND.MR(ID).GT.MB(3)+MB(4)) THEN
7985 5 ME(P0,P1,P2,P3) = (0.0D0,0.0D0)
7988 C--calculate the propagator factor
7989 PRE = 0.25D0/(M342-MS(ID)+ZI*MWD(ID))
7990 C--calculate the vertex functions
7993 V1(P1,P2) = PRE*( A( P1 ,ID)*F1(O(P2), P1 ,1)*S(1,5,P1)
7994 & +A(O(P1),ID)*F1(O(P2),O(P1),5)*MA(1))
7995 10 V2(P1,P2) = B(O(P2),ID)*F2(O(P1),O(P2),4)*S(4,8,O(P2))
7996 & -B( P2 ,ID)*F2(O(P1), P2 ,8)*MA(4)
7997 C--calculate the matrix element
8002 20 ME(P0,P1,P2,P3) = V1(P0,P1)*V2(P2,P3)
8005 *CMZ :- -08/04/02 14:48:42 by Peter Richardson
8006 *-- Author : Peter Richardson
8007 C-----------------------------------------------------------------------
8008 SUBROUTINE HWD3MC(ID,ME)
8009 C-----------------------------------------------------------------------
8010 C Subroutine to calculate the helicity amplitudes for 5th 3 body RPV
8011 C diagram f --> f f f
8012 C-----------------------------------------------------------------------
8013 INCLUDE 'herwig65.inc'
8014 DOUBLE COMPLEX ME(2,2,2,2),S,D,F0(2,2,8),F1(2,2,8),F01(2,2,8,8),
8015 & F0M(2,2,8),F2(2,2,8),PRE,V1(2,2),V2(2,2),ZI,F1M(2,2,8),
8017 DOUBLE PRECISION A,B,MS,MWD,MA,MB,MA2,MB2,M342,M232,M242,MR,
8018 & P(5,4),PM(5,4),CFTHRE(NCFMAX,NCFMAX)
8019 INTEGER P0,P1,P2,P3,ID,O(2),IDP(4+NDIAGR),DRTYPE(NDIAGR),NCTHRE,
8021 COMMON/HWD3BY/F0,F0M,F1M,F1,F2,F3,F01,A(2,NDIAGR),B(2,NDIAGR),
8022 & MS(NDIAGR),MWD(NDIAGR),MR(NDIAGR),MA(4),MA2(4),MB(4),MB2(4),
8023 & M342,M232,M242,P,PM,CFTHRE,IDP,DRTYPE,NCTHRE,DRCF
8024 COMMON/HWHEWS/S(8,8,2),D(8,8)
8025 PARAMETER(ZI=(0.0D0,1.0D0))
8028 C--decide whether to do the diagram
8029 IF(MB(3)+MR(ID).LT.MB(1).AND.MR(ID).GT.MB(2)+MB(4)) THEN
8034 5 ME(P0,P1,P2,P3) = (0.0D0,0.0D0)
8037 C--compute the propagator factor
8038 PRE =-0.25D0/(M242-MS(ID)+ZI*MWD(ID))
8039 C--compute the vertex factors
8042 V1(P1,P2) = PRE*( A( P1 ,ID)*F2(O(P2), P1 ,1)*S(1,5,P1)
8043 & +A(O(P1),ID)*F2(O(P2),O(P1),5)*MA(1))
8044 10 V2(P1,P2) = B(O(P2),ID)*F1(O(P1),O(P2),4)*S(4,8,O(P2))
8045 & -B( P2 ,ID)*F1(O(P1), P2 ,8)*MA(4)
8046 C--compute the matrix element
8051 20 ME(P0,P1,P2,P3) = V1(P0,P2)*V2(P1,P3)
8054 *CMZ :- -08/04/02 14:48:42 by Peter Richardson
8055 *-- Author : Peter Richardson
8056 C-----------------------------------------------------------------------
8057 SUBROUTINE HWD3MD(ID,ME)
8058 C-----------------------------------------------------------------------
8059 C Subroutine to calculate the helicity amplitudes for 6th 3 body RPV
8060 C diagram f --> f f f
8061 C-----------------------------------------------------------------------
8062 INCLUDE 'herwig65.inc'
8063 DOUBLE COMPLEX ME(2,2,2,2),S,D,F0(2,2,8),F1(2,2,8),F01(2,2,8,8),
8064 & F0M(2,2,8),F2(2,2,8),PRE,ZI,V1(2,2),V2(2,2),F1M(2,2,8),
8066 DOUBLE PRECISION A,B,MS,MWD,MA,MB,MA2,MB2,M342,M232,M242,MR,
8067 &P(5,4),PM(5,4),CFTHRE(NCFMAX,NCFMAX)
8068 INTEGER P0,P1,P2,P3,ID,O(2),IDP(4+NDIAGR),DRTYPE(NDIAGR),NCTHRE,
8070 COMMON/HWHEWS/S(8,8,2),D(8,8)
8071 COMMON/HWD3BY/F0,F0M,F1M,F1,F2,F3,F01,A(2,NDIAGR),B(2,NDIAGR),
8072 & MS(NDIAGR),MWD(NDIAGR),MR(NDIAGR),MA(4),MA2(4),MB(4),MB2(4),
8073 & M342,M232,M242,P,PM,CFTHRE,IDP,DRTYPE,NCTHRE,DRCF
8074 PARAMETER(ZI=(0.0D0,1.0D0))
8077 C--decide whether to do the diagram
8078 IF(MB(4)+MR(ID).LT.MB(1).AND.MR(ID).GT.MB(2)+MB(3)) THEN
8083 5 ME(P0,P1,P2,P3) = (0.0D0,0.0D0)
8086 C--compute the propagator factor
8087 PRE = 0.25D0/(M232-MS(ID)+ZI*MWD(ID))
8088 C--compute the factors for the two vertices
8091 V1(P1,P2) = PRE*( A(O(P2),ID)*F0M( P1 ,O(P2),4)*S(4,8,O(P2))
8092 & -A( P2 ,ID)*F0M( P1 , P2 ,8)*MA(4))
8093 10 V2(P1,P2) = B(O(P1),ID)*F2 (O(P2),O(P1),2)*S(2,6,O(P1))
8094 & -B( P1 ,ID)*F2 (O(P2), P1 ,6)*MA(2)
8095 C--now compute the matrix element
8100 20 ME(P0,P1,P2,P3) = V1(P0,P3)*V2(P1,P2)
8103 *CMZ :- -08/04/02 14:48:42 by Peter Richardson
8104 *-- Author : Peter Richardson
8105 C-----------------------------------------------------------------------
8106 SUBROUTINE HWD3MF(ID,ME)
8107 C-----------------------------------------------------------------------
8108 C Subroutine to calculate the helicity amplitudes for 7th 3 body RPV
8109 C diagram f --> fbar fbar fbar
8110 C-----------------------------------------------------------------------
8111 INCLUDE 'herwig65.inc'
8112 DOUBLE COMPLEX ME(2,2,2,2),S,D,F0(2,2,8),F1(2,2,8),F01(2,2,8,8),
8113 & F0M(2,2,8),F2(2,2,8),PRE,ZI,V1(2,2),V2(2,2),F1M(2,2,8),
8115 DOUBLE PRECISION A,B,MS,MWD,MA,MB,MA2,MB2,M342,M232,M242,MR,
8116 & P(5,4),PM(5,4),CFTHRE(NCFMAX,NCFMAX)
8117 INTEGER P0,P1,P2,P3,ID,O(2),IDP(4+NDIAGR),DRTYPE(NDIAGR),NCTHRE,
8119 COMMON/HWD3BY/F0,F0M,F1M,F1,F2,F3,F01,A(2,NDIAGR),B(2,NDIAGR),
8120 & MS(NDIAGR),MWD(NDIAGR),MR(NDIAGR),MA(4),MA2(4),MB(4),MB2(4),
8121 & M342,M232,M242,P,PM,CFTHRE,IDP,DRTYPE,NCTHRE,DRCF
8122 COMMON/HWHEWS/S(8,8,2),D(8,8)
8123 PARAMETER(ZI=(0.0D0,1.0D0))
8126 C--decide whether to do the diagram
8127 IF(MB(2)+MR(ID).LT.MB(1).AND.MR(ID).GT.MB(3)+MB(4)) THEN
8132 5 ME(P0,P1,P2,P3) = (0.0D0,0.0D0)
8135 C--calculate the propagator factor
8136 PRE = 0.25D0/(M342-MS(ID)+ZI*MWD(ID))
8137 C--calculate the vertex functions
8140 V1(P1,P2) = PRE*( A( P2 ,ID)*F0M( P1 , P2 ,2)*S(2,6,P2)
8141 & -A(O(P2),ID)*F0M( P1 ,O(P2),6)*MA(2))
8142 10 V2(P1,P2) = B( P2 ,ID)*F2( P1 , P2 ,4)*S(4,8,P2)
8143 & -B(O(P2),ID)*F2( P1 ,O(P2),8)*MA(4)
8144 C--calculate the matrix element
8149 20 ME(P0,P1,P2,P3) = V1(P0,P1)*V2(P2,P3)
8152 *CMZ :- -08/04/02 14:48:42 by Peter Richardson
8153 *-- Author : Peter Richardson
8154 C-----------------------------------------------------------------------
8155 SUBROUTINE HWD3MG(ID,ME)
8156 C-----------------------------------------------------------------------
8157 C Subroutine to calculate the helicity amplitudes for 8th 3 body RPV
8158 C diagram f --> fbar fbar fbar
8159 C-----------------------------------------------------------------------
8160 INCLUDE 'herwig65.inc'
8161 DOUBLE COMPLEX ME(2,2,2,2),S,D,F0(2,2,8),F1(2,2,8),F01(2,2,8,8),
8162 & F0M(2,2,8),F2(2,2,8),PRE,V1(2,2),V2(2,2),ZI,F1M(2,2,8),
8164 DOUBLE PRECISION A,B,MS,MWD,MA,MB,MA2,MB2,M342,M232,M242,MR,
8165 & P(5,4),PM(5,4),CFTHRE(NCFMAX,NCFMAX)
8166 INTEGER P0,P1,P2,P3,ID,O(2),IDP(4+NDIAGR),DRTYPE(NDIAGR),NCTHRE,
8168 COMMON/HWD3BY/F0,F0M,F1M,F1,F2,F3,F01,A(2,NDIAGR),B(2,NDIAGR),
8169 & MS(NDIAGR),MWD(NDIAGR),MR(NDIAGR),MA(4),MA2(4),MB(4),MB2(4),
8170 & M342,M232,M242,P,PM,CFTHRE,IDP,DRTYPE,NCTHRE,DRCF
8171 COMMON/HWHEWS/S(8,8,2),D(8,8)
8172 PARAMETER(ZI=(0.0D0,1.0D0))
8175 C--decide whether to do the diagram
8176 IF(MB(3)+MR(ID).LT.MB(1).AND.MR(ID).GT.MB(2)+MB(4)) THEN
8181 5 ME(P0,P1,P2,P3) = (0.0D0,0.0D0)
8184 C--compute the propagator factor
8185 PRE = 0.25D0/(M242-MS(ID)+ZI*MWD(ID))
8186 C--compute the vertex factors
8189 V1(P1,P2) = PRE*( A( P2 ,ID)*F0M( P1 , P2 ,3)*S(3,7, P2 )
8190 & -A(O(P2),ID)*F0M( P1 ,O(P2),7)*MA(3))
8191 10 V2(P1,P2) = B( P1 ,ID)*F3 ( P2 , P1 ,2)*S(2,6, P1 )
8192 & -B(O(P1),ID)*F3 ( P2 ,O(P1),6)*MA(2)
8193 C--compute the matrix element
8198 20 ME(P0,P1,P2,P3) = V1(P0,P2)*V2(P1,P3)
8201 *CMZ :- -08/04/02 14:48:42 by Peter Richardson
8202 *-- Author : Peter Richardson
8203 C-----------------------------------------------------------------------
8204 SUBROUTINE HWD3MH(ID,ME)
8205 C-----------------------------------------------------------------------
8206 C Subroutine to calculate the helicity amplitudes for 9th 3 body RPV
8207 C diagram f --> fbar fbar fbar
8208 C-----------------------------------------------------------------------
8209 INCLUDE 'herwig65.inc'
8210 DOUBLE COMPLEX ME(2,2,2,2),S,D,F0(2,2,8),F1(2,2,8),F01(2,2,8,8),
8211 & F0M(2,2,8),F2(2,2,8),PRE,ZI,V1(2,2),V2(2,2),F1M(2,2,8),
8213 DOUBLE PRECISION A,B,MS,MWD,MA,MB,MA2,MB2,M342,M232,M242,MR,
8214 &P(5,4),PM(5,4),CFTHRE(NCFMAX,NCFMAX)
8215 INTEGER P0,P1,P2,P3,ID,O(2),IDP(4+NDIAGR),DRTYPE(NDIAGR),NCTHRE,
8217 COMMON/HWHEWS/S(8,8,2),D(8,8)
8218 COMMON/HWD3BY/F0,F0M,F1M,F1,F2,F3,F01,A(2,NDIAGR),B(2,NDIAGR),
8219 & MS(NDIAGR),MWD(NDIAGR),MR(NDIAGR),MA(4),MA2(4),MB(4),MB2(4),
8220 & M342,M232,M242,P,PM,CFTHRE,IDP,DRTYPE,NCTHRE,DRCF
8221 PARAMETER(ZI=(0.0D0,1.0D0))
8224 C--decide whether to do the diagram
8225 IF(MB(4)+MR(ID).LT.MB(1).AND.MR(ID).GT.MB(2)+MB(3)) THEN
8230 5 ME(P0,P1,P2,P3) = (0.0D0,0.0D0)
8233 C--compute the propagator factor
8234 PRE = -0.25D0/(M232-MS(ID)+ZI*MWD(ID))
8235 C--compute the factors for the two vertices
8238 V1(P1,P2) = PRE*( A( P2 ,ID)*F0M( P1 , P2 ,4)*S(4,8,P2)
8239 & -A(O(P2),ID)*F0M( P1 ,O(P2),8)*MA(4))
8240 10 V2(P1,P2) = B( P1 ,ID)*F2 ( P2 , P1 ,2)*S(2,6,P1)
8241 & -B(O(P1),ID)*F2 ( P2 ,O(P1),6)*MA(2)
8242 C--now compute the matrix element
8247 20 ME(P0,P1,P2,P3) = V1(P0,P3)*V2(P1,P2)
8250 *CMZ :- -09/04/02 13:37:38 by Peter Richardson
8251 *-- Author : Peter Richardson
8252 C-----------------------------------------------------------------------
8253 SUBROUTINE HWD3MI(ID,ME)
8254 C-----------------------------------------------------------------------
8255 C Subroutine to calculate the helicity amplitudes for the three body
8256 C Higgs boson exchange diagram antifermion decay
8257 C-----------------------------------------------------------------------
8258 INCLUDE 'herwig65.inc'
8259 DOUBLE COMPLEX ME(2,2,2,2),S,D,F0(2,2,8),F1(2,2,8),F01(2,2,8,8),
8260 & F0M(2,2,8),F2(2,2,8),PRE,ZI,V1(2,2),V2(2,2),F1M(2,2,8),
8262 DOUBLE PRECISION A,B,MS,MWD,MA,MB,MA2,MB2,M342,M232,M242,MR,
8263 & P(5,4),PM(5,4),CFTHRE(NCFMAX,NCFMAX)
8264 INTEGER P0,P1,P2,P3,ID,O(2),IDP(4+NDIAGR),DRTYPE(NDIAGR),NCTHRE,
8266 COMMON/HWD3BY/F0,F0M,F1M,F1,F2,F3,F01,A(2,NDIAGR),B(2,NDIAGR),
8267 & MS(NDIAGR),MWD(NDIAGR),MR(NDIAGR),MA(4),MA2(4),MB(4),MB2(4),
8268 & M342,M232,M242,P,PM,CFTHRE,IDP,DRTYPE,NCTHRE,DRCF
8269 COMMON/HWHEWS/S(8,8,2),D(8,8)
8270 PARAMETER(ZI=(0.0D0,1.0D0))
8273 C--decide whether to do the diagram
8274 IF(MB(2)+MR(ID).LT.MB(1).AND.MR(ID).GT.MB(3)+MB(4).AND.
8275 & IDP(4+ID).NE.207) THEN
8280 5 ME(P0,P1,P2,P3) = (0.0D0,0.0D0)
8283 C--calculate the propagator factor
8284 PRE = 0.25D0/(M342-MS(ID)+ZI*MWD(ID))
8285 C--calculate the vertex functions
8288 V1(P1,P2) = PRE*( A( P2 ,ID)*F0M(O(P1), P2 ,2)*S(2,6,P2)
8289 & -A(O(P2),ID)*F0M(O(P1),O(P2),6)*MA(2))
8290 10 V2(P1,P2) = B( P2 ,ID)*F2(O(P1), P2 ,4)*S(4,8,P2)
8291 & -B(O(P2),ID)*F2(O(P1),O(P2),8)*MA(4)
8292 C--calculate the matrix element
8297 20 ME(P0,P1,P2,P3) = V1(P0,P1)*V2(P2,P3)
8300 *CMZ :- -20/10/99 09:46:43 by Peter Richardson
8301 *-- Author : Peter Richardson
8302 C-----------------------------------------------------------------------
8303 SUBROUTINE HWD4ME(ID,ITYPE1,ITYPE2,IMODE)
8304 C-----------------------------------------------------------------------
8305 C Subroutine to perform the four body Higgs decays
8306 C-----------------------------------------------------------------------
8307 INCLUDE 'herwig65.inc'
8308 INTEGER IMODE,I,J,ID,IDP(4+NDIAGR),ITYPE(2),NTRY,ITYPE1,ITYPE2
8309 DOUBLE PRECISION A,B,MS,MWD,M,M2,WGT,HWRUNI,BRW(6),BRZ(12),
8310 & HWUPCM,WMAX,WSUM,WSSUM,MR,PRE,TEMP,HWRGEN,WTMAX,P(5,5)
8311 EXTERNAL HWRUNI,HWUPCM,HWRGEN
8312 COMMON/HWD4BY/A(2),B(2),MS(2),MWD(2),MR(2),M(5),M2(5),P,IDP
8314 DATA BRW/0.321D0,0.321D0,0.000D0,0.108D0,0.108D0,0.108D0/
8315 DATA BRZ/0.154D0,0.120D0,0.154D0,0.120D0,0.152D0,0.000D0,
8316 & 0.033D0,0.067D0,0.033D0,0.067D0,0.033D0,0.067D0/
8319 WTMAX = WT4MAX(ITYPE(1),ITYPE(2),IMODE)
8320 PRE=P4MODE(ITYPE(1),ITYPE(2),IMODE)
8321 C--compute the masses of external particles for the decay mode
8323 C--couplings and masses of the internal particles
8324 A(I) = A4MODE(I,ITYPE1,IMODE)
8325 B(I) = B4MODE(I,ITYPE2,IMODE)
8326 MR(I) = RMASS(I4MODE(I,IMODE))
8328 IF(I4MODE(I,IMODE).EQ.200) THEN
8333 IDP(5+I) = I4MODE(I,IMODE)
8334 C--id's of outgoing particles
8335 IF(I4MODE(I,IMODE).EQ.200) THEN
8336 IDP(2*I ) = ITYPE(I)
8337 IF(ITYPE(I).GT.6) IDP(2*I) = IDP(2*I)+114
8338 IDP(2*I+1) = IDP(2*I)+6
8340 IDP(2*I ) = 2*ITYPE(I)-1
8341 IF(ITYPE(I).GT.3) IDP(2*I) = IDP(2*I)+114
8342 IDP(2*I+1) = IDP(2*I)+7
8343 IF(I4MODE(I,IMODE).EQ.198) THEN
8345 IDP(2*I) = IDP(2*I+1)-6
8350 IDP(1) = IDK(ID4PRT(IMODE))
8352 M(I) = RMASS(IDP(I))
8354 IF(M(1).LT.M(2)+M(3)+M(4)+M(5).OR.MR(1).LT.M(2)+M(3).OR.
8355 & MR(2).LT.M(4)+M(5)) RETURN
8356 IF(IPRINT.EQ.2.AND..NOT.GENEV)
8357 & WRITE(6,3000) RNAME(IDP(6)),RNAME(IDP(2)),RNAME(IDP(3)),
8358 & RNAME(IDP(7)),RNAME(IDP(4)),RNAME(IDP(5))
8359 C--compute the width and maximum weight if initialising
8367 IF(WGT.GT.WMAX) WMAX = WGT
8369 WSSUM = WSSUM+WGT**2
8370 IF(WGT.LT.ZERO) CALL HWWARN('HWD4ME',500)
8372 WSUM = WSUM/DBLE(NSEARCH)
8373 WSSUM = MAX(ZERO,WSSUM/DBLE(NSEARCH)-WSUM**2)
8374 WSSUM = SQRT(WSSUM/DBLE(NSEARCH))
8375 IF(IPRINT.EQ.2) WRITE(6,3010) WSUM,WSSUM
8376 IF(IPRINT.EQ.2) WRITE(6,3020) WMAX
8377 TEMP = BRFRAC(ID4PRT(IMODE))*HBAR/RLTIM(IDK(ID4PRT(IMODE)))
8379 IF(I4MODE(J,IMODE).EQ.200) THEN
8380 TEMP = TEMP*BRZ(ITYPE(J))
8382 TEMP = TEMP*BRW(ITYPE(J))
8385 IF(IPRINT.EQ.2) WRITE(6,3030) WSUM/TEMP,WSSUM/TEMP
8386 C--set up the maximum weight
8387 WT4MAX(ITYPE(1),ITYPE(2),IMODE) = WMAX
8389 C--generate a configuation
8391 IF(SYSPIN.AND.NSPN.NE.0) CALL HWWARN('HWD4ME',501)
8395 IF(HWRGEN(0)*WTMAX.GT.WGT.AND.NTRY.LT.NSNTRY) GOTO 100
8396 IF(NTRY.GE.NSNTRY) THEN
8397 CALL HWWARN('HWD4ME',100)
8401 3000 FORMAT(/' FOLLOWED BY ',A8,' --> ',A8,' ',A8,' AND ',
8402 & A8,' --> ',A8,' ',A8)
8403 3010 FORMAT(' PARTIAL WIDTH = ',G12.4,' +/- ',G12.4)
8404 3020 FORMAT(' MAXIMUM WEIGHT = ',E12.4)
8405 3030 FORMAT(' RATIO TO ISAJET VALUE = ',G12.4,' +/- ',G12.4)
8409 *CMZ :- -11/10/01 12:32:39 by Peter Richardson
8410 *-- Author : Peter Richardson
8411 C-----------------------------------------------------------------------
8412 SUBROUTINE HWD4M0(ID,WGT)
8413 C-----------------------------------------------------------------------
8414 C Subroutine to calculate the matrix element for a given four body
8416 C-----------------------------------------------------------------------
8417 INCLUDE 'herwig65.inc'
8418 INTEGER I,J,P0,P1,P2,P3,ID,O(2),IDP(4+NDIAGR),II,P4
8419 DOUBLE PRECISION A,B,MS,MWD,M,M2,WGT,HWRUNI,
8420 & M23,PCMA,PCMB(2),HWUPCM,PHS,N(3),HWVDOT,PP,HWULDO,EPS,
8421 & M232,PRE,PLAB,PRW,XMASS,PCM,P(5,5),PM(5,5),MR,PREF(5),
8422 & M45,M452,MJAC(2),PTMP(5,2),CN(2),DOT
8423 DOUBLE COMPLEX S,D,ME(2,2,2,2),APP(2,2),AMP(2,2),APM(2,2),
8424 & AMM(2,2),BPP(2,2),BPM(2,2),BMP(2,2),BMM(2,2),ZI,
8425 & F45(2,2,8,8),F23(2,2,8,8),C(2,2),E(2,2)
8427 EXTERNAL HWRUNI,HWUPCM,HWVDOT,HWULDO,HWRLOG
8428 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
8429 COMMON/HWD4BY/A(2),B(2),MS(2),MWD(2),MR(2),M(5),M2(5),P,IDP
8430 COMMON/HWHEWS/S(8,8,2),D(8,8)
8431 PARAMETER(EPS=1D-20,ZI=(0.0D0,1.0D0))
8434 DATA PREF/1.0D0,0.0D0,0.0D0,1.0D0,0.0D0/
8435 C--select the masses of the gauge bosons and compute Jacobians
8436 IF(HWRLOG(HALF)) THEN
8437 CALL HWHGB1(1,2,IDP(6),MJAC(1),M232,(M(1)-M(4)-M(5))**2,
8440 CALL HWHGB1(1,2,IDP(7),MJAC(2),M452,
8441 & (M(1)-M23)**2,(M(4)+M(5))**2)
8444 CALL HWHGB1(1,2,IDP(7),MJAC(2),M452,(M(1)-M(2)-M(3))**2,
8447 CALL HWHGB1(1,2,IDP(6),MJAC(1),M232,(M(1)-M45)**2,
8451 MJAC(1) = MJAC(1)/((M232-MS(1))**2+MWD(1)**2)
8452 MJAC(2) = MJAC(2)/((M452-MS(2))**2+MWD(2)**2)
8456 2 CN(I) = -ONE/MS(I)
8457 C--now perform the decay of the Higgs to the bosons
8458 PCMA = HWUPCM(M(1),M23,M45)
8461 CALL HWVEQU(5,PHEP(1,ID),P(1,1))
8462 CALL HWDTWO(P(1,1),PLAB(1,1),PLAB(1,2),PCMA,2.0D0,.TRUE.)
8463 PCMB(1) = HWUPCM(M23,M(2),M(3))
8464 CALL HWDTWO(PLAB(1,1),P(1,2),P(1,3),PCMB(1),2.0D0,.TRUE.)
8465 PCMB(2) = HWUPCM(M45,M(4),M(5))
8466 CALL HWDTWO(PLAB(1,2),P(1,4),P(1,5),PCMB(2),2.0D0,.TRUE.)
8467 DOT = HWULDO(PLAB(1,1),PLAB(1,2))
8468 C--compute the phase sapce factors
8469 PHS = PCMA*PCMB(1)*PCMB(2)*MJAC(1)*MJAC(2)/512.0D0/PIFAC**5/
8471 C--compute the vectors for the helicity amplitudes
8474 C--compute the references vectors
8475 C--not important if SM particle which can't have spin measured
8476 C--ie anything other the top and tau
8477 C--also not important if particle is approx massless
8478 C--first the SM particles other than top and tau
8479 IF(IDP(II).LT.400.AND.(IDP(II).NE.6.AND.IDP(II).NE.12
8480 & .AND.IDP(II).NE.125.AND.IDP(II).NE.131)) THEN
8481 CALL HWVEQU(5,PREF,PLAB(1,I+4))
8482 C--all other particles
8484 PP = SQRT(HWVDOT(3,P(1,II),P(1,II)))
8485 CALL HWVSCA(3,ONE/PP,P(1,II),N)
8486 PLAB(4,I+4) = HALF*(P(4,II)-PP)
8487 PP = HALF*(PP-M(II)-PP**2/(M(II)+P(4,II)))
8488 CALL HWVSCA(3,PP,N,PLAB(1,I+4))
8489 CALL HWUMAS(PLAB(1,I+4))
8490 PP = HWVDOT(3,PLAB(1,I+4),PLAB(1,I+4))
8491 C--fix to avoid problems if approx massless due to energy
8492 IF(PP.LT.EPS) CALL HWVEQU(5,PREF,PLAB(1,I+4))
8494 C--now the massless vectors
8495 PP = HALF*M2(II)/HWULDO(PLAB(1,I+4),P(1,II))
8497 4 PLAB(J,I) = P(J,II)-PP*PLAB(J,I+4)
8498 3 CALL HWUMAS(PLAB(1,I))
8499 C--change ordr of momenta for call to HE code
8511 6 PCM(5,I)=PLAB(5,I)
8512 C--compute the S functions
8513 CALL HWHEW2(8,PCM(1,1),S(1,1,2),S(1,1,1),D)
8516 S(I,J,2) = -S(I,J,2)
8517 7 D(I,J) = TWO*D(I,J)
8518 CALL HWVSUM(4,PM(1,2),PM(1,3),PTMP(1,1))
8519 CALL HWVSUM(4,PM(1,4),PM(1,5),PTMP(1,2))
8520 CALL HWUMAS(PTMP(1,1))
8521 CALL HWUMAS(PTMP(1,2))
8522 C--compute the F functions
8523 CALL HWH2F3(8,F23,PTMP(1,1),ZERO)
8524 CALL HWH2F3(8,F45,PTMP(1,2),ZERO)
8525 C--now find the prefactor for all the diagrams
8526 PRE = HWULDO(PCM(1,5),PM(1,2))*HWULDO(PCM(1,6),PM(1,3))*
8527 & HWULDO(PCM(1,7),PM(1,4))*HWULDO(PCM(1,8),PM(1,5))
8528 PRE = 0.25D0/SQRT(PRE)
8529 C--zero the matrix element
8534 8 ME(P0,P1,P2,P3) = (0.0D0,0.0D0)
8535 C--compute the A, B, C and E functions
8539 C--the A and B functions
8540 APP(P1,P2) = A( P2 )*S(5,1,O(P1))*S(2,6, P1 )
8543 AMM(P1,P2) = -A(O(P2))*M(2)*M(3)
8544 BPP(P1,P2) = B( P2 )*S(7,3,O(P1))*S(4,8, P1 )
8547 BMM(P1,P2) = -B(O(P2))*M(4)*M(5)
8548 C--the C and E functions
8549 C(P1,P2) =CN(1)*(A( P2 )*( M2(2)*S(5,2,O(P1))*S(2,6, P1 )
8550 & +M2(3)*S(5,1,O(P1))*S(1,6, P1 ))
8551 & -A(O(P2))*M(2)*M(3)*( S(5,1,O(P1))*S(1,6, P1 )
8552 & +S(5,2,O(P1))*S(2,6, P1 )))
8553 E(P1,P2) =CN(2)*(B( P2 )*( M2(4)*S(7,4,O(P1))*S(4,8, P1 )
8554 & +M2(5)*S(7,3,O(P1))*S(3,8, P1 ))
8555 & -B(O(P2))*M(4)*M(5)*( S(7,3,O(P1))*S(3,8, P1 )
8556 & +S(7,4,O(P1))*S(4,8, P1 )))
8560 APM(P1,P2) = A( P2 )*M(2)*S(2,6,O(P1))
8561 AMP(P1,P2) =-A(O(P2))*M(3)*S(5,1,O(P1))
8564 BPM(P1,P2) = B( P2 )*M(4)*S(4,8,O(P1))
8565 BMP(P1,P2) =-B(O(P2))*M(5)*S(7,3,O(P1))
8567 C--the C and D functions
8568 C(P1,P2) =CN(1)*( A( P2 )*M(2)*( M2(3)*S(5,6,O(P1))
8569 & +S(5,1,O(P1))*S(1,2, P1 )*S(2,6,O(P1)))
8570 & -A(O(P2))*M(3)*( M2(2)*S(5,6,O(P1))
8571 & +S(5,1,O(P1))*S(1,2, P1 )*S(2,6,O(P1))))
8572 E(P1,P2) =CN(2)*( B( P2 )*M(4)*( M2(5)*S(7,8,O(P1))
8573 & +S(7,3,O(P1))*S(3,4, P1 )*S(4,8,O(P1)))
8574 & -B(O(P2))*M(5)*( M2(4)*S(7,8,O(P1))
8575 & +S(7,3,O(P1))*S(3,4, P1 )*S(4,8,O(P1))))
8578 C--now put the whole thing together to give the matrix element
8586 & APP(P1,P2)*(S(1,3,P1)*(BPP(P3,P4)*S(4,2,P0)+BMP(P3,P4)*S(8,2,P0))
8587 & +S(7,2,P0)*(BPM(P3,P4)*S(1,4,P1)+BMM(P3,P4)*S(1,8,P1)))
8588 &+APM(P1,P2)*(S(5,7,P0)*(BPM(P3,P4)*S(4,2,P1)+BMM(P3,P4)*S(8,2,P1))
8589 & +S(3,2,P1)*(BPP(P3,P4)*S(5,4,P0)+BMP(P3,P4)*S(5,8,P0)))
8590 &+AMP(P1,P2)*(S(1,3,P1)*(BPP(P3,P4)*S(4,6,P0)+BMP(P3,P4)*S(8,6,P0))
8591 & +S(7,6,P0)*(BPM(P3,P4)*S(1,4,P1)+BMM(P3,P4)*S(1,8,P1)))
8592 &+AMM(P1,P2)*(S(3,6,P1)*(BPP(P3,P4)*S(5,4,P0)+BMP(P3,P4)*S(5,8,P0))
8593 & +S(5,7,P0)*(BPM(P3,P4)*S(4,6,P1)+BMM(P3,P4)*S(8,6,P1)))
8596 & APP(P1,P2)*(S(3,2,P0)*(BPP(P3,P4)*S(1,4,P1)+BMP(P3,P4)*S(1,8,P1))
8597 & +S(1,7,P1)*(BPM(P3,P4)*S(4,2,P0)+BMM(P3,P4)*S(8,2,P0)))
8598 &+APM(P1,P2)*(S(5,3,P0)*(BPP(P3,P4)*S(4,2,P1)+BMP(P3,P4)*S(8,2,P1))
8599 & +S(7,2,P1)*(BPM(P3,P4)*S(5,4,P0)+BMM(P3,P4)*S(5,8,P0)))
8600 &+AMP(P1,P2)*(S(3,6,P0)*(BPP(P3,P4)*S(1,4,P1)+BMP(P3,P3)*S(1,8,P1))
8601 & +S(1,7,P1)*(BPM(P3,P4)*S(4,6,P0)+BMM(P3,P4)*S(8,6,P0)))
8602 &+AMM(P1,P2)*(S(5,3,P0)*(BPP(P3,P4)*S(4,6,P1)+BMP(P3,P4)*S(8,6,P1))
8603 & +S(7,6,P1)*(BPM(P3,P4)*S(5,4,P0)+BMM(P3,P4)*S(5,8,P0)))
8605 ME(P1,P2,P3,P4) = TWO*ME(P1,P2,P3,P4)
8607 & BPP(P3,P4)*F23(P3,P3,3,4)+BPM(P3,P4)*F23(O(P3),O(P3),7,4)
8608 & +BMP(P3,P4)*F23(P3,P3,3,8)+BMM(P3,P4)*F23(O(P3),O(P3),7,8))
8610 & APP(P1,P2)*F45(P1,P1,1,2)+APM(P1,P2)*F45(P0,P0,5,2)
8611 & +AMP(P1,P2)*F45(P1,P1,1,6)+AMM(P1,P2)*F45(P0,P0,5,6))
8612 & +DOT*C(P1,P2)*E(P3,P4)
8613 10 ME(P1,P2,P3,P4) = PRE*ME(P1,P2,P3,P4)
8614 C--compute the weight
8620 40 WGT = WGT+DREAL(ME(P1,P2,P3,P4)*DCONJG(ME(P1,P2,P3,P4)))
8621 C--normalise this for phase space
8623 C--enter the matrix element into the spin common block
8624 IF(GENEV.AND.SYSPIN) THEN
8630 11 MESPN(P1,P2,P3,P4,1,1) = ME(P1,P2,P3,P4)
8636 *CMZ :- -23/05/96 18.34.17 by Mike Seymour
8637 *-- Author : Mike Seymour
8638 C-----------------------------------------------------------------------
8639 SUBROUTINE HWDBOS(IBOSON)
8640 C-----------------------------------------------------------------------
8641 C DECAY GAUGE BOSONS (ALREADY FOUND BY HWDHAD)
8642 C USES SPIN DENSITY MATRIX IN RHOHEP (1ST CMPT=>-VE,2=>LONG,3=>+VE)
8643 C IF BOSON CAME FROM HIGGS DECAY, GIVE BOTH THE SAME HELICITY (EPR)
8644 C IF BOSON CAME FROM W+1JET, GIVE IT THE CORRECT DECAY CORRELATIONS
8645 C--BRW FIX 20/07/04: ADD FULL DECAY CORRELATIONS FOR W/Z+HIGGS
8646 C-----------------------------------------------------------------------
8647 INCLUDE 'herwig65.inc'
8648 DOUBLE PRECISION HWRGEN,HWRUNI,HWUPCM,HWULDO,R(3,3),CV,CA,BR,PCM,
8649 & PBOS(5),PMAX,PROB,RRLL,RLLR
8650 INTEGER HWRINT,IBOS,IBOSON,IPAIR,ICMF,IOPT,IHEL,IMOTH,
8653 EXTERNAL HWRGEN,HWRUNI,HWUPCM,HWULDO,HWRINT
8655 IF (IDHW(IBOS).LT.198.OR.IDHW(IBOS).GT.200) THEN
8656 CALL HWWARN('HWDBOS',101)
8660 C---SEE IF IT IS PART OF A PAIR
8661 IMOTH=JMOHEP(1,IBOS)
8662 IPAIR=JMOHEP(2,IBOS)
8665 IF (IPAIR.EQ.IBOS) THEN
8667 IF (IPRO.EQ.26.OR.IPRO.EQ.27) ICMF=JMOHEP(1,IMOTH)
8669 IF (IDHW(ICMF).EQ.IDHW(IBOS).AND.ISTHEP(ICMF)/10.EQ.12) THEN
8670 IPAIR=JMOHEP(2,ICMF)
8671 IF (IPAIR.NE.0) THEN
8672 IPAIR=JDAHEP(1,IPAIR)
8673 IF (IPAIR.NE.0) JMOHEP(2,IPAIR)=IBOS
8678 IF (IPAIR.NE.0) THEN
8679 IF (JMOHEP(2,IPAIR).NE.IBOS.OR.
8680 & IDHW(IPAIR).LT.198.OR.IDHW(IPAIR).GT.200) IPAIR=0
8682 IF (IPAIR.GT.0.AND.IPAIR.NE.IBOS) IOPT=1
8685 C---SELECT DECAY PRODUCTS
8686 10 CALL HWDBOZ(IDHW(IBOS),IDN(1),IDN(2),CV,CA,BR,IOPT)
8687 C---V + 1JET, V+HIGGS DECAYS ARE NOW HANDLED HERE !
8688 IF (IPRO.EQ.21.OR.IPRO.EQ.26.OR.IPRO.EQ.27) THEN
8689 IQRK=IDHW(JMOHEP(1,ICMF))
8690 IANT=IDHW(JMOHEP(2,ICMF))
8691 IF (IQRK.EQ.13 .AND. IANT.LE.6) THEN
8694 ELSEIF (IQRK.EQ.13) THEN
8697 ELSEIF (IANT.EQ.13 .AND. IQRK.LE.6) THEN
8700 ELSEIF (IANT.EQ.13) THEN
8703 ELSEIF (IQRK.GT.IANT) THEN
8710 PHEP(5,NHEP+1)=RMASS(IDN(1))
8711 PHEP(5,NHEP+2)=RMASS(IDN(2))
8712 PCM=HWUPCM(PHEP(5,IBOS),PHEP(5,NHEP+1),PHEP(5,NHEP+2))
8713 IF (PCM.LT.ZERO) THEN
8714 CALL HWWARN('HWDBOS',103)
8717 IF (IDHW(IBOS).EQ.200) THEN
8719 IF (ID.GT.120) ID=ID-110
8721 IF (IQ.GT.6) IQ=IQ-6
8722 RRLL=(VFCH(IQ,1)**2+AFCH(IQ,1)**2)*
8723 $ (VFCH(ID,1)**2+AFCH(ID,1)**2)
8724 $ +4*VFCH(IQ,1)*AFCH(IQ,1)*
8725 $ VFCH(ID,1)*AFCH(ID,1)
8726 RLLR=(VFCH(IQ,1)**2+AFCH(IQ,1)**2)*
8727 $ (VFCH(ID,1)**2+AFCH(ID,1)**2)
8728 $ -4*VFCH(IQ,1)*AFCH(IQ,1)*
8729 $ VFCH(ID,1)*AFCH(ID,1)
8734 IF (IPRO.EQ.21) THEN
8735 PMAX=(RRLL+RLLR)*(HWULDO(PHEP(1,IANT),PHEP(1,IBOS))**2+
8736 & HWULDO(PHEP(1,IQRK),PHEP(1,IBOS))**2)
8738 PMAX=(RRLL+RLLR)* HWULDO(PHEP(1,IANT),PHEP(1,IBOS))*
8739 & HWULDO(PHEP(1,IQRK),PHEP(1,IBOS))
8741 1 CALL HWDTWO(PHEP(1,IBOS),PHEP(1,NHEP+1),PHEP(1,NHEP+2),
8743 IF (IPRO.EQ.21) THEN
8744 PROB=RRLL*(HWULDO(PHEP(1,IANT),PHEP(1,NHEP+1))**2+
8745 & HWULDO(PHEP(1,IQRK),PHEP(1,NHEP+2))**2)+
8746 & RLLR*(HWULDO(PHEP(1,IANT),PHEP(1,NHEP+2))**2+
8747 & HWULDO(PHEP(1,IQRK),PHEP(1,NHEP+1))**2)
8749 PROB=RRLL* HWULDO(PHEP(1,IANT),PHEP(1,NHEP+1))*
8750 & HWULDO(PHEP(1,IQRK),PHEP(1,NHEP+2))+
8751 & RLLR* HWULDO(PHEP(1,IANT),PHEP(1,NHEP+2))*
8752 & HWULDO(PHEP(1,IQRK),PHEP(1,NHEP+1))
8754 IF (PROB.GT.PMAX.OR.PROB.LT.ZERO) THEN
8755 CALL HWWARN('HWDBOS',104)
8758 IF (PMAX*HWRGEN(0).GT.PROB) GOTO 1
8760 C---SELECT HELICITY, UNLESS IT IS THE SECOND OF A HIGGS DECAY (EPR)
8761 IF (IPAIR.NE.IBOS .OR. IDHW(ICMF).NE.201) THEN
8762 IF (RHOHEP(1,IBOS)+RHOHEP(2,IBOS)+RHOHEP(3,IBOS).LE.ZERO) THEN
8763 C---COPY PARENT HELICITY IF IT WAS A GAUGE BOSON
8764 IF (IDHW(IMOTH).GE.198.AND.IDHW(IMOTH).LE.200) THEN
8765 CALL HWVEQU(3,RHOHEP(1,IMOTH),RHOHEP(1,IBOS))
8766 IF (RHOHEP(1,IBOS)+RHOHEP(2,IBOS)+RHOHEP(3,IBOS).GT.ZERO)
8768 C---MAY BE FROM A SUSY DECAY
8769 ELSEIF (ABS(IDHEP(IMOTH)).LT.1000000) THEN
8770 CALL HWWARN('HWDBOS',1)
8777 IF (HWRGEN(0).GT.RHOHEP(IHEL,IBOS)) GOTO 20
8779 C---SELECT DIRECTION OF FERMION
8780 30 COSTH=HWRUNI(0,-ONE,ONE)
8781 IF (IHEL.EQ.1 .AND. (ONE+COSTH)**2.LT.HWRGEN(0)*FOUR) GOTO 30
8782 IF (IHEL.EQ.2 .AND. (ONE-COSTH**2).LT.HWRGEN(0) ) GOTO 30
8783 IF (IHEL.EQ.3 .AND. (ONE-COSTH)**2.LT.HWRGEN(0)*FOUR) GOTO 30
8784 C---GENERATE DECAY RELATIVE TO Z-AXIS
8785 PHEP(5,NHEP+1)=RMASS(IDN(1))
8786 PHEP(5,NHEP+2)=RMASS(IDN(2))
8787 PCM=HWUPCM(PHEP(5,IBOS),PHEP(5,NHEP+1),PHEP(5,NHEP+2))
8788 IF (PCM.LT.ZERO) THEN
8789 CALL HWWARN('HWDBOS',102)
8792 CALL HWRAZM(PCM*SQRT(1-COSTH**2),PHEP(1,NHEP+1),PHEP(2,NHEP+1))
8793 PHEP(3,NHEP+1)=PCM*COSTH
8794 PHEP(4,NHEP+1)=SQRT(PHEP(5,NHEP+1)**2+PCM**2)
8795 C---ROTATE SO THAT Z-AXIS BECOMES BOSON'S DIRECTION IN ORIGINAL CM FRAME
8796 CALL HWULOF(PHEP(1,ICMF),PHEP(1,IBOS),PBOS)
8797 CALL HWUROT(PBOS, ONE,ZERO,R)
8798 CALL HWUROB(R,PHEP(1,NHEP+1),PHEP(1,NHEP+1))
8799 C---BOOST BACK TO LAB
8800 CALL HWULOB(PHEP(1,IBOS),PHEP(1,NHEP+1),PHEP(1,NHEP+1))
8801 CALL HWVDIF(4,PHEP(1,IBOS),PHEP(1,NHEP+1),PHEP(1,NHEP+2))
8803 C---STATUS, IDs AND POINTERS
8808 IDHEP(NHEP+I)=IDPDG(IDN(I))
8809 JDAHEP(I,IBOS)=NHEP+I
8810 JMOHEP(1,NHEP+I)=IBOS
8811 JMOHEP(2,NHEP+I)=JMOHEP(1,IBOS)
8814 IF (IDN(1).LE.12) THEN
8817 JMOHEP(2,NHEP)=NHEP-1
8818 JDAHEP(2,NHEP)=NHEP-1
8819 JMOHEP(2,NHEP-1)=NHEP
8820 JDAHEP(2,NHEP-1)=NHEP
8823 C--MHS FIX 07/03/05 - VERTEX POSITION FOR DECAYS TO LEPTONS
8824 CALL HWVEQU(4,VTXPIP,VHEP(1,NHEP-1))
8825 CALL HWVEQU(4,VTXPIP,VHEP(1,NHEP))
8828 C---IF FIRST OF A PAIR, DO SECOND DECAY
8829 IF (IPAIR.NE.0 .AND. IPAIR.NE.IBOS) THEN
8833 C---IF QUARK DECAY, HADRONIZE
8844 *CMZ :- -29/04/91 18.00.03 by Federico Carminati
8845 *-- Author : Mike Seymour
8846 C-----------------------------------------------------------------------
8847 SUBROUTINE HWDBOZ(IDBOS,IFER,IANT,CV,CA,BR,IOPT)
8848 C-----------------------------------------------------------------------
8849 C CHOOSE DECAY MODE OF BOSON
8850 C IOPT=2 TO RESET COUNTERS, 1 FOR BOSON PAIR, 0 FOR ANY OTHERS
8851 C-----------------------------------------------------------------------
8852 INCLUDE 'herwig65.inc'
8853 DOUBLE PRECISION HWRGEN,BRMODE(12,3),CV,CA,BR,BRLST,BRCOM,FACZ,
8855 INTEGER HWRINT,IDBOS,IDEC,IDMODE(2,12,3),IFER,IANT,IOPT,I1,I2,
8856 & I1LST,I2LST,NWGLST,NUMDEC,NPAIR,MODTMP,JFER
8858 EXTERNAL HWRGEN,HWRINT
8859 SAVE FACW,FACZ,NWGLST,GENLST,NUMDEC,NPAIR,I1LST,I2LST,BRLST
8861 DATA NWGLST,GENLST,NPAIR/-1,.FALSE.,0/
8862 C---STORE THE DECAY MODES (FERMION FIRST)
8863 DATA IDMODE/ 2, 7, 4, 9, 6, 11, 2, 9, 4, 7,
8864 & 122,127,124,129,126,131,8*0,
8865 & 1, 8, 3, 10, 5, 12, 3, 8, 1, 10,
8866 & 121,128,123,130,125,132,8*0,
8867 & 1, 7, 2, 8, 3, 9, 4, 10, 5, 11, 6, 12,
8868 & 121,127,123,129,125,131,122,128,124,130,126,132/
8869 C---STORE THE BRANCHING RATIOS TO THESE MODES
8870 DATA BRMODE/0.321D0,0.321D0,0.000D0,0.017D0,0.017D0,0.108D0,
8871 & 0.108D0,0.108D0,4*0.0D0,
8872 & 0.321D0,0.321D0,0.000D0,0.017D0,0.017D0,0.108D0,
8873 & 0.108D0,0.108D0,4*0.0D0,
8874 & 0.154D0,0.120D0,0.154D0,0.120D0,0.152D0,0.000D0,
8875 & 0.033D0,0.033D0,0.033D0,0.067D0,0.067D0,0.067D0/
8876 C---FACTORS FOR CV AND CA FOR W AND Z
8877 DATA FACW,FACZ/2*0.0D0/
8878 IF (FACZ.EQ.ZERO) FACZ=SQRT(SWEIN)
8879 IF (FACW.EQ.ZERO) FACW=0.5/SQRT(2D0)
8880 IF (IDBOS.LT.198.OR.IDBOS.GT.200) THEN
8881 CALL HWWARN('HWDBOZ',101)
8884 C---IF THIS IS A NEW EVENT SINCE LAST TIME, ZERO COUNTERS
8885 IF (NWGTS.NE.NWGLST .OR.(GENEV.NEQV.GENLST).OR. IOPT.EQ.2) THEN
8890 IF (IOPT.EQ.2) RETURN
8893 IF (NUMDEC.GT.MODMAX) THEN
8894 CALL HWWARN('HWDBOZ',102)
8897 C---IF PAIR OPTION SPECIFIED FOR THE FIRST TIME, MAKE CHOICE
8899 IF (NUMDEC.GT.MODMAX-1) THEN
8900 CALL HWWARN('HWDBOZ',103)
8903 IF (NPAIR.EQ.0) THEN
8904 IF (HWRGEN(1).GT.HALF) THEN
8905 MODTMP=MODBOS(NUMDEC+1)
8906 MODBOS(NUMDEC+1)=MODBOS(NUMDEC)
8907 MODBOS(NUMDEC)=MODTMP
8914 C---SELECT USER'S CHOICE
8915 IF (IDBOS.EQ.200) THEN
8916 IF (MODBOS(NUMDEC).EQ.1) THEN
8919 ELSEIF (MODBOS(NUMDEC).EQ.2) THEN
8922 ELSEIF (MODBOS(NUMDEC).EQ.3) THEN
8925 ELSEIF (MODBOS(NUMDEC).EQ.4) THEN
8928 ELSEIF (MODBOS(NUMDEC).EQ.5) THEN
8931 ELSEIF (MODBOS(NUMDEC).EQ.6) THEN
8934 ELSEIF (MODBOS(NUMDEC).EQ.7) THEN
8942 IF (MODBOS(NUMDEC).EQ.1) THEN
8945 ELSEIF (MODBOS(NUMDEC).EQ.2) THEN
8948 ELSEIF (MODBOS(NUMDEC).EQ.3) THEN
8951 ELSEIF (MODBOS(NUMDEC).EQ.4) THEN
8954 ELSEIF (MODBOS(NUMDEC).EQ.5) THEN
8962 10 IDEC=HWRINT(I1,I2)
8963 IF (HWRGEN(0).GT.BRMODE(IDEC,IDBOS-197).AND.I1.NE.I2) GOTO 10
8964 IFER=IDMODE(1,IDEC,IDBOS-197)
8965 IANT=IDMODE(2,IDEC,IDBOS-197)
8966 C---CALCULATE BRANCHING RATIO
8967 C (RESULT IS NOT WELL-DEFINED AFTER THE FIRST CALL OF A PAIR)
8970 20 BR=BR+BRMODE(IDEC,IDBOS-197)
8972 IF (NPAIR.NE.0) THEN
8978 DO 30 IDEC=MAX(I1,I1LST),MIN(I2,I2LST)
8979 30 BRCOM=BRCOM+BRMODE(IDEC,IDBOS-197)
8980 BR=2*BR*BRLST - BRCOM**2
8983 C---SET UP VECTOR AND AXIAL VECTOR COUPLINGS (NORMALIZED TO THE
8984 C CONVENTION WHERE THE WEAK CURRENT IS G*(CV-CA*GAM5) )
8985 IF (IDBOS.EQ.200) THEN
9005 *CMZ :- -02/04/01 12.11.55 by Peter Richardson
9006 *-- Author : Peter Richardson based on Mike Seymour's HWDBOZ
9007 C-----------------------------------------------------------------------
9008 SUBROUTINE HWDBZ2(IDBOS,IFER,IANT,CV,CA,BR,IOPT,MASS)
9009 C-----------------------------------------------------------------------
9010 C CHOOSE DECAY MODE OF BOSON
9011 C IOPT=2 TO RESET COUNTERS, 1 FOR BOSON PAIR, 0 FOR ANY OTHERS
9012 C IDENTICAL TO HWDBOZ BUT REQUIRES DECAY MODE ACCESSIBLE FOR GIVEN
9014 C-----------------------------------------------------------------------
9015 INCLUDE 'herwig65.inc'
9016 DOUBLE PRECISION HWRGEN,BRMODE(12,3),CV,CA,BR,BRLST,BRCOM,FACZ,
9017 & FACW,MSMODE(12,3),MASS
9018 INTEGER HWRINT,IDBOS,IDEC,IDMODE(2,12,3),IFER,IANT,IOPT,I1,I2,
9019 & I1LST,I2LST,NWGLST,NUMDEC,NPAIR,MODTMP,JFER,NTRY
9021 EXTERNAL HWRGEN,HWRINT
9022 SAVE FACW,FACZ,MSMODE,NWGLST,GENLST,NUMDEC,NPAIR,I1LST,I2LST,BRLST
9024 DATA NWGLST,GENLST,NPAIR/-1,.FALSE.,0/
9025 C---STORE THE DECAY MODES (FERMION FIRST)
9026 DATA IDMODE/ 2, 7, 4, 9, 6, 11, 2, 9, 4, 7,
9027 & 122,127,124,129,126,131,8*0,
9028 & 1, 8, 3, 10, 5, 12, 3, 8, 1, 10,
9029 & 121,128,123,130,125,132,8*0,
9030 & 1, 7, 2, 8, 3, 9, 4, 10, 5, 11, 6, 12,
9031 & 121,127,123,129,125,131,122,128,124,130,126,132/
9032 C---STORE THE BRANCHING RATIOS TO THESE MODES
9033 DATA BRMODE/0.321D0,0.321D0,0.000D0,0.017D0,0.017D0,0.108D0,
9034 & 0.108D0,0.108D0,4*0.0D0,
9035 & 0.321D0,0.321D0,0.000D0,0.017D0,0.017D0,0.108D0,
9036 & 0.108D0,0.108D0,4*0.0D0,
9037 & 0.154D0,0.120D0,0.154D0,0.120D0,0.152D0,0.000D0,
9038 & 0.033D0,0.033D0,0.033D0,0.067D0,0.067D0,0.067D0/
9039 DATA MSMODE/36*0.0D0/
9040 C---FACTORS FOR CV AND CA FOR W AND Z
9041 DATA FACW,FACZ/2*0.0D0/
9042 IF (FACZ.EQ.ZERO) FACZ=SQRT(SWEIN)
9043 IF (FACW.EQ.ZERO) FACW=0.5/SQRT(2D0)
9044 IF (IDBOS.LT.198.OR.IDBOS.GT.200) THEN
9045 CALL HWWARN('HWDBZ2',101)
9048 IF(MSMODE(1,1).EQ.ZERO) THEN
9051 MSMODE(I1,I2)=RMASS(IDMODE(1,I1,I2))+RMASS(IDMODE(2,I1,I2))
9055 C---IF THIS IS A NEW EVENT SINCE LAST TIME, ZERO COUNTERS
9056 IF (NWGTS.NE.NWGLST .OR.(GENEV.NEQV.GENLST).OR. IOPT.EQ.2) THEN
9061 IF (IOPT.EQ.2) RETURN
9064 IF (NUMDEC.GT.MODMAX) THEN
9065 CALL HWWARN('HWDBZ2',102)
9068 C---IF PAIR OPTION SPECIFIED FOR THE FIRST TIME, MAKE CHOICE
9070 IF (NUMDEC.GT.MODMAX-1) THEN
9071 CALL HWWARN('HWDBZ2',103)
9074 IF (NPAIR.EQ.0) THEN
9075 IF (HWRGEN(1).GT.HALF) THEN
9076 MODTMP=MODBOS(NUMDEC+1)
9077 MODBOS(NUMDEC+1)=MODBOS(NUMDEC)
9078 MODBOS(NUMDEC)=MODTMP
9085 C---SELECT USER'S CHOICE
9086 IF (IDBOS.EQ.200) THEN
9087 IF (MODBOS(NUMDEC).EQ.1) THEN
9090 ELSEIF (MODBOS(NUMDEC).EQ.2) THEN
9093 ELSEIF (MODBOS(NUMDEC).EQ.3) THEN
9096 ELSEIF (MODBOS(NUMDEC).EQ.4) THEN
9099 ELSEIF (MODBOS(NUMDEC).EQ.5) THEN
9102 ELSEIF (MODBOS(NUMDEC).EQ.6) THEN
9105 ELSEIF (MODBOS(NUMDEC).EQ.7) THEN
9113 IF (MODBOS(NUMDEC).EQ.1) THEN
9116 ELSEIF (MODBOS(NUMDEC).EQ.2) THEN
9119 ELSEIF (MODBOS(NUMDEC).EQ.3) THEN
9122 ELSEIF (MODBOS(NUMDEC).EQ.4) THEN
9125 ELSEIF (MODBOS(NUMDEC).EQ.5) THEN
9134 10 IDEC=HWRINT(I1,I2)
9136 IF (HWRGEN(0).GT.BRMODE(IDEC,IDBOS-197).AND.I1.NE.I2) GOTO 10
9137 IF(MASS.LT.MSMODE(IDEC,IDBOS-197).AND.NTRY.LT.NBTRY) GOTO 10
9138 IF(NTRY.GE.NBTRY) THEN
9142 IFER=IDMODE(1,IDEC,IDBOS-197)
9143 IANT=IDMODE(2,IDEC,IDBOS-197)
9144 C---CALCULATE BRANCHING RATIO
9145 C (RESULT IS NOT WELL-DEFINED AFTER THE FIRST CALL OF A PAIR)
9148 20 IF(MSMODE(IDEC,IDBOS-197).LT.MASS) BR=BR+BRMODE(IDEC,IDBOS-197)
9150 IF (NPAIR.NE.0) THEN
9156 DO 30 IDEC=MAX(I1,I1LST),MIN(I2,I2LST)
9157 30 IF(MSMODE(IDEC,IDBOS-197).LT.MASS)
9158 & BRCOM=BRCOM+BRMODE(IDEC,IDBOS-197)
9159 BR=2*BR*BRLST - BRCOM**2
9162 C---SET UP VECTOR AND AXIAL VECTOR COUPLINGS (NORMALIZED TO THE
9163 C CONVENTION WHERE THE WEAK CURRENT IS G*(CV-CA*GAM5) )
9164 IF (IDBOS.EQ.200) THEN
9184 *CMZ :- -27/07/99 13.33.03 by Mike Seymour
9185 *-- Author : Ian Knowles
9186 C-----------------------------------------------------------------------
9187 SUBROUTINE HWDCHK(IDKY,L,IFGO)
9188 C-----------------------------------------------------------------------
9189 C Checks line L of decay table is compatible with decay of particle
9190 C IDKY, tidies up the line and sets NPRODS.
9191 C-----------------------------------------------------------------------
9192 INCLUDE 'herwig65.inc'
9193 DOUBLE PRECISION EPS,QS,Q,DM
9194 INTEGER IDKY,L,IFAULT,I,ID,J
9196 PARAMETER (EPS=1.D-6)
9198 IF (VTOCDK(IDKY).AND.VTORDK(IDKY)) THEN
9203 QS=FLOAT(ICHRG(IDKY))
9204 IF (IDKY.LE.12.OR.(IDKY.GE.109.AND.IDKY.LE.120)
9205 & .OR.(IDKY.GE.209.AND.IDKY.LE.220)
9206 & .OR.(IDKY.GE.401.AND.IDKY.LE.424)) QS=QS/3.
9211 IF (ID.LT.0.OR.ID.EQ.20.OR.ID.GT.NRES) THEN
9212 WRITE(6,20) L,RNAME(IDKY),(RNAME(IDKPRD(J,L)),J=1,5)
9214 ELSEIF (ID.NE.0) THEN
9215 IF (VTORDK(ID)) THEN
9216 WRITE(6,30) L,RNAME(IDKY),(RNAME(IDKPRD(J,L)),J=1,5),RNAME(ID)
9219 NPRODS(L)=NPRODS(L)+1
9220 IDKPRD(NPRODS(L),L)=ID
9222 IF (ID.LE.12.OR.(ID.GE.109.AND.ID.LE.120)
9223 & .OR.(ID.GE.209.AND.ID.LE.220)
9224 & .OR.(ID.GE.401.AND.ID.LE.424)) Q=Q/3.
9229 C print any warnings
9230 IF (NPRODS(L).EQ.0) THEN
9231 WRITE(6,20) L,RNAME(IDKY),(RNAME(IDKPRD(I,L)),I=1,5)
9234 IF (ABS(QS).GT.EPS) THEN
9235 WRITE(6,40) L,RNAME(IDKY),(RNAME(IDKPRD(I,L)),I=1,5),QS
9238 C--modification so doesn't remove H --> W*W* Z*Z* modes
9239 IF (DM.LT.ZERO.AND..NOT.
9240 & (FOURB.AND.IDK(L).GE.203.AND.IDK(L).LE.205.AND.
9241 & IDKPRD(1,L).GE.198.AND.IDKPRD(2,L).LE.200.AND.
9242 & IDKPRD(2,L).GE.198.AND.IDKPRD(2,L).LE.200)) THEN
9243 WRITE(6,50) L,RNAME(IDKY),(RNAME(IDKPRD(I,L)),I=1,5),DM
9247 20 FORMAT(1X,'Line ',I4,' decay: ',A8,' --> ',4(A8,1X),A8/
9248 & 1X,'contains no or unrecognised decay product(s)')
9249 30 FORMAT(1X,'Line ',I4,' decay: ',A8,' --> ',4(A8,1X),A8/
9250 & 1X,'contains decay product ',A8,' which is vetoed')
9251 40 FORMAT(1X,'Line ',I4,' decay: ',A8,' --> ',4(A8,1X),A8/
9252 & 1X,'violates charge conservation, Qin-Qout= ',F6.3)
9253 50 FORMAT(1X,'Line ',I4,' decay: ',A8,' --> ',4(A8,1X),A8/
9254 & 1X,'is kinematically not allowed, Min-Mout= ',F10.3)
9255 IF (IFAULT.NE.0) THEN
9263 *CMZ :- -28/01/92 12.34.44 by Mike Seymour
9264 *-- Author : Luca Stanco
9265 C-----------------------------------------------------------------------
9266 SUBROUTINE HWDCLE(IHEP)
9267 C-----------------------------------------------------------------------
9268 C INTERFACE TO QQ-CLEO MONTE CARLO (LS 11/12/91)
9269 C-----------------------------------------------------------------------
9270 INCLUDE 'herwig65.inc'
9271 INTEGER IHEP,IIHEP,NHEPHF,QQLMAT
9275 C---QQ-CLEO COMMON'S
9277 INTEGER MCTRK, NTRKS, MCVRTX, NVTXS, MCHANS, MCDTRS, MPOLQQ
9278 INTEGER MCNUM, MCSTBL, MCSTAB, MCTLQQ, MDECQQ
9279 INTEGER MHLPRB, MHLLST, MHLANG, MCPLST, MFDECA
9280 PARAMETER (MCTRK = 512)
9281 PARAMETER (NTRKS = MCTRK)
9282 PARAMETER (MCVRTX = 256)
9283 PARAMETER (NVTXS = MCVRTX)
9284 PARAMETER (MCHANS = 4000)
9285 PARAMETER (MCDTRS = 8000)
9286 PARAMETER (MPOLQQ = 300)
9287 PARAMETER (MCNUM = 500)
9288 PARAMETER (MCSTBL = 40)
9289 PARAMETER (MCSTAB = 512)
9290 PARAMETER (MCTLQQ = 100)
9291 PARAMETER (MDECQQ = 300)
9292 PARAMETER (MHLPRB = 500)
9293 PARAMETER (MHLLST = 1000)
9294 PARAMETER (MHLANG = 500)
9295 PARAMETER (MCPLST = 200)
9296 PARAMETER (MFDECA = 5)
9298 REAL AMASS, CHARGE, CTAU, SPIN, RWIDTH, RMASMN, RMASMX
9300 INTEGER NPMNQQ, NPMXQQ, IDMC, INVMC, LPARTY, CPARTY
9301 INTEGER IMIXPP, ICPMIX
9304 * AMASS(-20:MCNUM), CHARGE(-20:MCNUM), CTAU(-20:MCNUM),
9305 * IDMC(-20:MCNUM), SPIN(-20:MCNUM),
9306 * RWIDTH(-20:MCNUM), RMASMN(-20:MCNUM), RMASMX(-20:MCNUM),
9307 * LPARTY(-20:MCNUM), CPARTY(-20:MCNUM),
9308 * IMIXPP(-20:MCNUM), RMIXPP(-20:MCNUM),
9309 * ICPMIX(-20:MCNUM), RCPMIX(-20:MCNUM),
9312 INTEGER NPOLQQ, IPOLQQ
9314 * NPOLQQ, IPOLQQ(5,MPOLQQ)
9316 CHARACTER QNAME*10, PNAME*10
9318 * QNAME(37), PNAME(-20:MCNUM)
9321 INTEGER NCTLQQ, NDECQQ, IVRSQQ, IORGQQ, IRS1QQ
9322 INTEGER IEVTQQ, IRUNQQ, IBMRAD
9323 INTEGER NTRKMC, QQNTRK, NSTBMC, NSTBQQ, NCHGMC, NCHGQQ
9324 INTEGER IRANQQ, IRANMC, IRANCC, IRS2QQ
9325 INTEGER IPFTQQ, IPCDQQ, IPRNTV, ITYPEV, IDECSV, IDAUTV
9326 INTEGER ISTBMC, NDAUTV
9327 INTEGER IVPROD, IVDECA
9329 REAL ENERQQ, BEAMQQ, BMPSQQ, BMNGQQ, EWIDQQ, BWPSQQ, BWNGQQ
9331 REAL ECM, P4CMQQ, P4PHQQ, ENERNW, BEAMNW, BEAMP, BEAMN
9332 REAL PSAV, P4QQ, HELCQQ
9333 CHARACTER DATEQQ*20, TIMEQQ*20, FOUTQQ*80, FCTLQQ*80, FDECQQ*80
9335 CHARACTER CCTLQQ*80, CDECQQ*80
9338 * NCTLQQ, NDECQQ, IVRSQQ, IORGQQ, IRS1QQ(3), BFLDQQ,
9339 * ENERQQ, BEAMQQ, BMPSQQ, BMNGQQ, EWIDQQ, BWPSQQ, BWNGQQ,
9340 * BPOSQQ(3), BSIZQQ(3),
9342 * IBMRAD, ECM, P4CMQQ(4), P4PHQQ(4),
9343 * ENERNW, BEAMNW, BEAMP, BEAMN,
9344 * NTRKMC, QQNTRK, NSTBMC, NSTBQQ, NCHGMC, NCHGQQ,
9345 * IRANQQ(2), IRANMC(2), IRANCC(2), IRS2QQ(5),
9346 * IPFTQQ(MCTRK), IPCDQQ(MCTRK), IPRNTV(MCTRK), ITYPEV(MCTRK,2),
9347 * IDECSV(MCTRK), IDAUTV(MCTRK), ISTBMC(MCTRK), NDAUTV(MCTRK),
9348 * IVPROD(MCTRK), IVDECA(MCTRK),
9349 * PSAV(MCTRK,4), HELCQQ(MCTRK), P4QQ(4,MCTRK)
9352 * DATEQQ, TIMEQQ, FOUTQQ, FCTLQQ, FDECQQ, FGEOQQ,
9353 * CCTLQQ(MCTLQQ), CDECQQ(MDECQQ)
9355 INTEGER NVRTX, ITRKIN, NTRKOU, ITRKOU, IVKODE
9356 REAL XVTX, TVTX, RVTX
9358 * NVRTX, XVTX(MCVRTX,3), TVTX(MCVRTX), RVTX(MCVRTX),
9359 * ITRKIN(MCVRTX), NTRKOU(MCVRTX), ITRKOU(MCVRTX),
9362 INTEGER QQIST,QQIFR,QQN,QQK,QQMESO,QQNC,QQKC,QQLASTN
9363 REAL QQPUD,QQPS1,QQSIGM,QQMAS,QQPAR,QQCMIX,QQCND,QQBSPI,QQBSYM,QQP
9366 COMMON/DATA1/QQIST,QQIFR,QQPUD,QQPS1,QQSIGM,QQMAS(15),QQPAR(25)
9367 COMMON/DATA2/QQCZF(15),QQMESO(36),QQCMIX(6,2)
9368 COMMON/DATA3/QQCND(3)
9369 COMMON/DATA5/QQBSPI(5),QQBSYM(3)
9370 COMMON/JET/QQN,QQK(250,2),QQP(250,5),QQNC,QQKC(10),QQPC(10,4),
9374 C---INITIALIZE QQ-CLEO
9376 IF(QQLERR) CALL HWWARN('HWDEUR',500)
9378 C---CONSTRUCT THE HADRON FOR QQ-CLEO
9379 C NOTE: THE IDPDG CODE IS PROVIDED THROUGH THE QQLMAT ROUTINE
9380 C FROM THE CLEO PACKAGE (QQ-CLEO <--> IDPDG CODE TRANSFORMATION)
9382 IDHEP(IHEP)=IDPDG(IDHW(IHEP))
9384 QQK(1,2)=QQLMAT(IDHEP(IHEP),1)
9385 QQP(1,1)=SNGL(PHEP(1,IHEP))
9386 QQP(1,2)=SNGL(PHEP(2,IHEP))
9387 QQP(1,3)=SNGL(PHEP(3,IHEP))
9388 QQP(1,5)=AMASS(QQK(1,2))
9389 QQP(1,4)=SQRT(QQP(1,5)**2+QQP(1,1)**2+QQP(1,2)**2+QQP(1,3)**2)
9390 C---LET QQ-CLEO DO THE JOB
9393 CALL DECADD(.FALSE.)
9394 C---UPDATE THE HERWIG TABLE : LOOP OVER QQN-CLEO FINAL PARTICLES
9398 IF(ITYPEV(IIHEP,2).GE.0) ISTHEP(NHEP)=1
9399 IDHEP(NHEP)=QQLMAT(ITYPEV(IIHEP,1),2)
9400 CALL HWUIDT(1,IDHEP(NHEP),IDHW(NHEP),NAME)
9410 JMOHEP(1,NHEP)=IPRNTV(IIHEP)+NHEPHF-1
9411 JMOHEP(2,NHEP)=NHEPHF
9415 IF(NDAUTV(IIHEP).GT.0) THEN
9416 JDAHEP(1,NHEP)=IDAUTV(IIHEP)+NHEPHF-1
9417 JDAHEP(2,NHEP)=JDAHEP(1,NHEP)+NDAUTV(IIHEP)-1
9419 PHEP(1,NHEP)=QQP(IIHEP,1)
9420 PHEP(2,NHEP)=QQP(IIHEP,2)
9421 PHEP(3,NHEP)=QQP(IIHEP,3)
9422 PHEP(4,NHEP)=QQP(IIHEP,4)
9423 PHEP(5,NHEP)=QQP(IIHEP,5)
9424 VHEP(1,NHEP)=XVTX(IVPROD(IIHEP),1)
9425 VHEP(2,NHEP)=XVTX(IVPROD(IIHEP),2)
9426 VHEP(3,NHEP)=XVTX(IVPROD(IIHEP),3)
9431 *CMZ :- -28/01/92 12.34.44 by Mike Seymour
9432 *-- Author : Luca Stanco
9433 C-----------------------------------------------------------------------
9434 SUBROUTINE HWDEUR(IHEP)
9435 C-----------------------------------------------------------------------
9436 C INTERFACE TO EURODEC PACKAGE (LS 10/29/91)
9437 C-----------------------------------------------------------------------
9438 INCLUDE 'herwig65.inc'
9439 INTEGER IHEP,IIHEP,NHEPHF,IEUPDG,IPDGEU
9441 C---EURODEC COMMON'S : INITIAL INPUT
9442 INTEGER EULUN0,EULUN1,EULUN2,EURUN,EUEVNT
9443 CHARACTER*4 EUDATD,EUTIT
9444 REAL AMINIE(12),EUWEI
9445 COMMON/INPOUT/EULUN0,EULUN1,EULUN2
9446 COMMON/FILNAM/EUDATD,EUTIT
9447 COMMON/HVYINI/AMINIE
9448 COMMON/RUNINF/EURUN,EUEVNT,EUWEI
9449 C---EURODEC WORKING COMMON'S
9451 PARAMETER (NPMAX=18,NTMAX=2000)
9452 INTEGER EUNP,EUIP(NPMAX),EUPHEL(NPMAX),EUTEIL,EUINDX(NTMAX),
9453 & EUORIG(NTMAX),EUDCAY(NTMAX),EUTHEL(NTMAX)
9454 REAL EUAPM(NPMAX),EUPCM(5,NPMAX),EUPVTX(3,NPMAX),EUPTEI(5,NTMAX),
9456 COMMON/MOMGEN/EUNP,EUIP,EUAPM,EUPCM,EUPHEL,EUPVTX
9457 COMMON/RESULT/EUTEIL,EUPTEI,EUINDX,EUORIG,EUDCAY,EUTHEL,EUSECV
9458 C---EURODEC COMMON'S FOR DECAY PROPERTIES
9460 PARAMETER (NGMAX=400,NCMAX=9000)
9461 INTEGER EUNPA,EUIPC(NGMAX),EUIPDG(NGMAX),EUIDP(NGMAX),
9463 REAL EUPM(NGMAX),EUPLT(NGMAX)
9464 COMMON/PCTABL/EUNPA,EUIPC,EUIPDG,EUPM,EUPLT,EUIDP
9465 COMMON/CONVRT/EUCONV
9468 C---CHANGE HERE THE DEFAULT VALUES OF EURODEC COMMON'S
9470 C---INITIALIZE EURODEC COMMON'S
9472 C---INITIALIZE EURODEC
9475 C---CONSTRUCT THE HADRON FOR EURODEC FROM ID1,ID2
9477 IDHEP(IHEP)=IDPDG(IDHW(IHEP))
9478 EUIP(1)=IPDGEU(IDHEP(IHEP))
9479 EUAPM(1)=EUPM(EUCONV(IABS(EUIP(1))))
9480 EUPCM(1,1)=SNGL(PHEP(1,IHEP))
9481 EUPCM(2,1)=SNGL(PHEP(2,IHEP))
9482 EUPCM(3,1)=SNGL(PHEP(3,IHEP))
9483 EUPCM(5,1)=SQRT(EUPCM(1,1)**2+EUPCM(2,1)**2+EUPCM(3,1)**2)
9484 EUPCM(4,1)=SQRT(EUPCM(5,1)**2+EUAPM(1)**2)
9485 C NOT POLARIZED HADRONS
9487 C HADRONS START FROM PRIMARY VERTEX
9491 C---LET EURODEC DO THE JOB
9494 C---UPDATE THE HERWIG TABLE : LOOP OVER N-EURODEC FINAL PARTICLES
9495 DO 40 IIHEP=1,EUTEIL
9498 IF(EUDCAY(IIHEP).EQ.0) ISTHEP(NHEP)=1
9499 IDHEP(NHEP)=IEUPDG(EUINDX(IIHEP))
9500 CALL HWUIDT(1,IDHEP(NHEP),IDHW(NHEP),NAME)
9509 JDAHEP(1,NHEP)=EUDCAY(IIHEP)/10000+NHEPHF-1
9510 JDAHEP(2,NHEP)=MOD(EUDCAY(IIHEP),10000)+NHEPHF-1
9512 JMOHEP(1,NHEP)=MOD(EUORIG(IIHEP),10000)+NHEPHF-1
9513 JMOHEP(2,NHEP)=NHEPHF
9514 JDAHEP(1,NHEP)=EUDCAY(IIHEP)/10000+NHEPHF-1
9515 JDAHEP(2,NHEP)=MOD(EUDCAY(IIHEP),10000)+NHEPHF-1
9517 PHEP(1,NHEP)=EUPTEI(1,IIHEP)
9518 PHEP(2,NHEP)=EUPTEI(2,IIHEP)
9519 PHEP(3,NHEP)=EUPTEI(3,IIHEP)
9520 PHEP(4,NHEP)=EUPTEI(4,IIHEP)
9521 PHEP(5,NHEP)=EUPTEI(5,IIHEP)
9522 VHEP(1,NHEP)=EUSECV(1,IIHEP)
9523 VHEP(2,NHEP)=EUSECV(2,IIHEP)
9524 VHEP(3,NHEP)=EUSECV(3,IIHEP)
9526 IF (IIHEP.GT.NTMAX) THEN
9527 CALL HWWARN('HWDEUR',99)
9534 *CMZ :- -01/04/99 19.52.44 by Mike Seymour
9535 *-- Author : Ian Knowles
9536 C-----------------------------------------------------------------------
9537 SUBROUTINE HWDFOR(P0,P1,P2,P3,P4)
9538 C-----------------------------------------------------------------------
9539 C Generates 4-body decay 0->1+2+3+4 using pure phase space
9540 C-----------------------------------------------------------------------
9541 INCLUDE 'herwig65.inc'
9542 DOUBLE PRECISION HWRGEN,P0(5),P1(5),P2(5),P3(5),P4(5),B,C,AA,BB,
9543 & CC,DD,EE,TT,S1,RS1,FF,S2,PP,QQ,RR,P1CM,P234(5),P2CM,P34(5),P3CM
9549 CALL HWWARN('HWDFOR',100)
9557 TT=(B-C)*P0(5)**7/16
9558 C Select squared masses S1 and S2 of 234 and 34 subsystems
9561 IF(NTRY.GT.NDETRY) THEN
9562 CALL HWWARN('HWDFOR',101)
9565 S1=BB+HWRGEN(1)*(CC-BB)
9568 S2=DD+HWRGEN(2)*(FF-DD)
9570 QQ=((RS1+P2(5))**2-S2)*(FF-S2)/S1
9571 RR=(S2-DD)*(S2-EE)/S2
9572 IF (PP*QQ*RR*(FF-DD)**2.LT.TT*S1*S2*HWRGEN(3)**2) GOTO 10
9573 C Do two body decays: 0-->1+234, 234-->2+34 and 34-->3+4
9574 P1CM=SQRT(PP/4)/P0(5)
9579 CALL HWDTWO(P0 ,P1,P234,P1CM,TWO,.TRUE.)
9580 CALL HWDTWO(P234,P2,P34 ,P2CM,TWO,.TRUE.)
9581 CALL HWDTWO(P34 ,P3,P4 ,P3CM,TWO,.TRUE.)
9585 *CMZ :- -01/04/99 19.52.44 by Mike Seymour
9586 *-- Author : Ian Knowles
9587 C-----------------------------------------------------------------------
9588 SUBROUTINE HWDFIV(P0,P1,P2,P3,P4,P5)
9589 C-----------------------------------------------------------------------
9590 C Generates 5-body decay 0->1+2+3+4+5 using pure phase space
9591 C-----------------------------------------------------------------------
9592 INCLUDE 'herwig65.inc'
9593 DOUBLE PRECISION HWRGEN,P0(5),P1(5),P2(5),P3(5),P4(5),P5(5),B,C,
9594 & AA,BB,CC,DD,EE,FF,TT,S1,RS1,GG,S2,RS2,HH,S3,PP,QQ,RR,SS,P1CM,
9595 & P2345(5),P2CM,P345(5),P3CM,P45(5),P4CM
9599 C=P2(5)+P3(5)+P4(5)+P5(5)
9601 CALL HWWARN('HWDFIV',100)
9607 DD=(P3(5)+P4(5)+P5(5))**2
9610 TT=(B-C)*P0(5)**11/729
9611 C Select squared masses S1, S2 and S3 of 2345, 345 and 45 subsystems
9614 IF(NTRY.GT.NDETRY) THEN
9615 CALL HWWARN('HWDFIV',101)
9618 S1=BB+HWRGEN(1)*(CC-BB)
9621 S2=DD+HWRGEN(2)*(GG-DD)
9624 S3=EE+HWRGEN(3)*(HH-EE)
9626 QQ=((RS1+P2(5))**2-S2)*(GG-S2)/S1
9627 RR=((RS2+P3(5))**2-S3)*(HH-S3)/S2
9628 SS=(S3-EE)*(S3-FF)/S3
9629 IF (PP*QQ*RR*SS*((GG-DD)*(HH-EE))**2.LT.TT*S1*S2*S3*HWRGEN(4)**2)
9631 C Do two body decays: 0-->1+2345, 2345-->2+345, 345-->3+45 and 45-->4+5
9632 P1CM=SQRT(PP/4)/P0(5)
9639 CALL HWDTWO(P0 ,P1,P2345,P1CM,TWO,.TRUE.)
9640 CALL HWDTWO(P2345,P2,P345 ,P2CM,TWO,.TRUE.)
9641 CALL HWDTWO(P345 ,P3,P45 ,P3CM,TWO,.TRUE.)
9642 CALL HWDTWO(P45 ,P4,P5 ,P4CM,TWO,.TRUE.)
9646 *CMZ :- -26/04/91 11.11.54 by Peter Richardson
9647 *-- Author : Ian Knowles, Bryan Webber & Mike Seymour
9648 C-----------------------------------------------------------------------
9650 C-----------------------------------------------------------------------
9651 C GENERATES DECAYS OF UNSTABLE HADRONS AND LEPTONS
9652 C Modified for TAUOLA interface 16/10/01 PR
9653 C-----------------------------------------------------------------------
9654 INCLUDE 'herwig65.inc'
9656 COMMON/SFF/IT1,IB1,IT2,IB2
9657 DOUBLE PRECISION TB,BT
9658 INTEGER IT1,IB1,IT2,IB2
9659 DOUBLE PRECISION HWRGEN,HWULDO,RN,BF,COSANG,RSUM,DIST(4),VERTX(4),
9660 & PMIX,WTMX,WTMX2,XS,DOT1,DOT2,HWDPWT,HWDWWT,HWDHWT,XXX,YYY
9661 INTEGER IHEP,ID,MHEP,IDM,I,IDS,IM,MO,IPDG
9663 EXTERNAL HWRGEN,HWDPWT,HWDWWT,HWDHWT,HWULDO
9664 IF (IERROR.NE.0) RETURN
9665 DO 100 IHEP=1,NMXHEP
9666 IF (IHEP.GT.NHEP) THEN
9669 ELSEIF (ISTHEP(IHEP).EQ.120 .AND.
9670 & JDAHEP(1,IHEP).EQ.IHEP.AND.JDAHEP(2,IHEP).EQ.IHEP) THEN
9671 C---COPY COLOUR SINGLET CMF
9673 IF (NHEP.GT.NMXHEP) THEN
9674 CALL HWWARN('HWDHAD',100)
9677 CALL HWVEQU(5,PHEP(1,IHEP),PHEP(1,NHEP))
9678 CALL HWVEQU(4,VHEP(1,IHEP),VHEP(1,NHEP))
9679 IDHW(NHEP)=IDHW(IHEP)
9680 IDHEP(NHEP)=IDHEP(IHEP)
9687 ELSEIF (ISTHEP(IHEP).GE.190.AND.ISTHEP(IHEP).LE.193) THEN
9688 C---FIRST CHECK FOR STABILITY
9694 C---SPECIAL FOR GAUGE BOSON DECAY
9695 IF (ID.GE.198.AND.ID.LE.200) CALL HWDBOS(IHEP)
9696 C---SPECIAL FOR HIGGS BOSON DECAY
9697 IF (ID.EQ.201) CALL HWDHIG(ZERO)
9700 C Calculate position of decay vertex
9701 IF (DKLTM(ID).EQ.ZERO) THEN
9702 CALL HWVEQU(4,VHEP(1,IHEP),VERTX)
9706 CALL HWUDKL(ID,PHEP(1,IHEP),DIST)
9707 CALL HWVSUM(4,VHEP(1,IHEP),DIST,VERTX)
9709 CALL HWDXLM(VERTX,STABLE)
9717 IF (MIXING.AND.(ID.EQ.221.OR.ID.EQ.223.OR.
9718 & ID.EQ.245.OR.ID.EQ.247)) THEN
9719 C Select flavour of decaying b-meson allowing for flavour oscillation
9721 XXX=XMRCT(IDS)*DIST(4)/PHEP(4,IHEP)
9722 YYY=YMRCT(IDS)*DIST(4)/PHEP(4,IHEP)
9723 IF (ABS(YYY).LT.10) THEN
9724 PMIX=HALF*(ONE-COS(XXX)/COSH(YYY))
9728 IF (HWRGEN(1).LE.PMIX) THEN
9737 C Introduce a decaying neutral b-meson
9738 IF (NHEP+1.GT.NMXHEP) THEN
9739 CALL HWWARN('HWDHAD',101)
9743 ISTHEP(MHEP)=ISTHEP(IHEP)
9748 IDHEP(MHEP)=IDPDG(IDM)
9750 JMOHEP(2,MHEP)=JMOHEP(2,IHEP)
9751 CALL HWVEQU(5,PHEP(1,IHEP),PHEP(1,MHEP))
9752 CALL HWVEQU(4,VERTX,VHEP(1,MHEP))
9759 C Use CLEO/EURODEC packages for b-hadrons if requested
9760 IF ((IDM.GE.221.AND.IDM.LE.231).OR.
9761 & (IDM.GE.245.AND.IDM.LE.254)) THEN
9762 IF (BDECAY.EQ.'CLEO') THEN
9765 ELSEIF (BDECAY.EQ.'EURO') THEN
9770 C Use TAUOLA package for tau decays if requested
9771 IF((IDM.EQ.125.OR.IDM.EQ.131).AND.TAUDEC.EQ.'TAUOLA') THEN
9772 CALL HWDTAU(1,MHEP,0.0D0)
9776 ISTHEP(MHEP)=ISTHEP(MHEP)+5
9780 DO 10 I=1,NMODES(IDM)
9782 IF (BF.GE.RN) GOTO 20
9784 CALL HWWARN('HWDHAD',50)
9786 20 IF ((IDKPRD(1,IM).GE.1.AND.IDKPRD(1,IM).LE.13).OR.
9787 & (IDKPRD(3,IM).GE.1.AND.IDKPRD(3,IM).LE.13)) THEN
9788 C Partonic decay of a heavy-(b,c)-hadron, store details
9790 IF (NQDK.GT.NMXQDK) THEN
9791 CALL HWWARN('HWDHAD',102)
9796 CALL HWVEQU(4,VERTX,VTXQDK(1,NQDK))
9799 C Exclusive decay, add decay products to event record
9800 IF (NHEP+NPRODS(IM).GT.NMXHEP) THEN
9801 CALL HWWARN('HWDHAD',103)
9804 JDAHEP(1,MHEP)=NHEP+1
9805 DO 30 I=1,NPRODS(IM)
9807 IDHW(NHEP)=IDKPRD(I,IM)
9808 IDHEP(NHEP)=IDPDG(IDKPRD(I,IM))
9811 JMOHEP(2,NHEP)=JMOHEP(2,MHEP)
9812 PHEP(5,NHEP)=RMASS(IDKPRD(I,IM))
9813 30 CALL HWVEQU(4,VERTX,VHEP(1,NHEP))
9816 C Next choose momenta:
9817 IF (NPRODS(IM).EQ.1) THEN
9818 C 1-body decay: K0(BR) --> K0S,K0L
9819 CALL HWVEQU(4,PHEP(1,MHEP),PHEP(1,NHEP))
9820 ELSEIF (NPRODS(IM).EQ.2) THEN
9822 C---SPECIAL TREATMENT OF POLARIZED MESONS
9824 IF (ID.EQ.IDHW(JMOHEP(1,MHEP))) THEN
9828 40 RSUM=RSUM+RHOHEP(I,MO)
9829 IF (RSUM.GT.ZERO) THEN
9831 IF (RSUM.LT.RHOHEP(1,MO)) THEN
9833 COSANG=MAX(HWRGEN(4),HWRGEN(5),HWRGEN(6))*TWO-ONE
9834 ELSEIF (RSUM.LT.RHOHEP(1,MO)+RHOHEP(2,MO)) THEN
9836 COSANG=2*COS((ACOS(HWRGEN(7)*TWO-ONE)+PIFAC)/THREE)
9839 COSANG=MIN(HWRGEN(8),HWRGEN(9),HWRGEN(10))*TWO-ONE
9843 CALL HWDTWO(PHEP(1,MHEP),PHEP(1,NHEP-1),
9844 & PHEP(1,NHEP),CMMOM(IM),COSANG,.FALSE.)
9845 ELSEIF (NPRODS(IM).EQ.3) THEN
9847 IF (NME(IM).EQ.100) THEN
9848 C Use free massless (V-A)*(V-A) Matrix Element
9849 CALL HWDTHR(PHEP(1,MHEP),PHEP(1,NHEP-1),PHEP(1,NHEP-2),
9850 & PHEP(1,NHEP),HWDWWT)
9851 ELSEIF (NME(IM).EQ.101) THEN
9852 C Use bound massless (V-A)*(V-A) Matrix Element
9853 WTMX=((PHEP(5,MHEP)-PHEP(5,NHEP))
9854 & *(PHEP(5,MHEP)+PHEP(5,NHEP))
9855 & +(PHEP(5,NHEP-1)-PHEP(5,NHEP-2))
9856 & *(PHEP(5,NHEP-1)+PHEP(5,NHEP-2)))/TWO
9858 IPDG=ABS(IDHEP(MHEP))
9859 XS=ONE-MAX(RMASS(MOD(IPDG/1000,10)),
9860 & RMASS(MOD(IPDG/100,10)),RMASS(MOD(IPDG/10,10)))
9861 & /(RMASS(MOD(IPDG/1000,10))+RMASS(MOD(IPDG/100,10))
9862 & +RMASS(MOD(IPDG/10,10)))
9863 50 CALL HWDTHR(PHEP(1,MHEP),PHEP(1,NHEP-1),PHEP(1,NHEP-2),
9864 & PHEP(1,NHEP),HWDWWT)
9865 DOT1=HWULDO(PHEP(1,MHEP),PHEP(1,NHEP-1))
9866 DOT2=HWULDO(PHEP(1,MHEP),PHEP(1,NHEP-2))
9867 IF (DOT1*(WTMX-DOT1-XS*DOT2).LT.HWRGEN(11)*WTMX2) GOTO 50
9868 ELSE IF (NME(IM).EQ.200) THEN
9869 C Use free massless ((V-A)*TB1+(V+A)*CT1)*((V-A)*TB2+(V+A)*CT2)) Matrix Element
9871 IF((IDK(IM).EQ. 2).OR.(IDK(IM).EQ. 4).OR.
9872 & (IDK(IM).EQ. 6).OR.(IDK(IM).EQ. 8).OR.
9873 & (IDK(IM).EQ. 10).OR.(IDK(IM).EQ. 12).OR.
9874 & (IDK(IM).EQ.122).OR.(IDK(IM).EQ.124).OR.
9875 & (IDK(IM).EQ.126).OR.(IDK(IM).EQ.128).OR.
9876 & (IDK(IM).EQ.130).OR.(IDK(IM).EQ.132))THEN
9881 IF((IDKPRD(1,IM).EQ. 2).OR.(IDKPRD(1,IM).EQ. 4).OR.
9882 & (IDKPRD(1,IM).EQ. 6).OR.(IDKPRD(1,IM).EQ. 8).OR.
9883 & (IDKPRD(1,IM).EQ. 10).OR.(IDKPRD(1,IM).EQ. 12).OR.
9884 & (IDKPRD(1,IM).EQ.122).OR.(IDKPRD(1,IM).EQ.124).OR.
9885 & (IDKPRD(1,IM).EQ.126).OR.(IDKPRD(1,IM).EQ.128).OR.
9886 & (IDKPRD(1,IM).EQ.130).OR.(IDKPRD(1,IM).EQ.132))THEN
9895 CALL HWDTHR(PHEP(1,MHEP),PHEP(1,NHEP),PHEP(1,NHEP-2),
9896 & PHEP(1,NHEP-1),HWDHWT)
9898 CALL HWDTHR(PHEP(1,MHEP),PHEP(1,NHEP-2),PHEP(1,NHEP-1),
9899 & PHEP(1,NHEP),HWDPWT)
9901 ELSEIF (NPRODS(IM).EQ.4) THEN
9903 CALL HWDFOR(PHEP(1,MHEP ),PHEP(1,NHEP-3),PHEP(1,NHEP-2),
9904 & PHEP(1,NHEP-1),PHEP(1,NHEP))
9905 IF(IERROR.NE.0) RETURN
9906 ELSEIF (NPRODS(IM).EQ.5) THEN
9908 CALL HWDFIV(PHEP(1,MHEP ),PHEP(1,NHEP-4),PHEP(1,NHEP-3),
9909 & PHEP(1,NHEP-2),PHEP(1,NHEP-1),PHEP(1,NHEP))
9910 IF(IERROR.NE.0) RETURN
9912 CALL HWWARN('HWDHAD',104)
9918 C---MAY HAVE OVERFLOWED /HEPEVT/
9919 CALL HWWARN('HWDHAD',105)
9923 *CMZ :- -26/04/91 11.11.55 by Bryan Webber
9924 *-- Author : Mike Seymour
9925 C-----------------------------------------------------------------------
9926 SUBROUTINE HWDHGC(TAU,FNREAL,FNIMAG)
9927 C-----------------------------------------------------------------------
9928 C CALCULATE THE COMPLEX FUNCTION F OF HHG eq 2.18
9929 C FOR USE IN H-->GAMMGAMM DECAYS
9930 C-----------------------------------------------------------------------
9931 INCLUDE 'herwig65.inc'
9932 DOUBLE PRECISION TAU,FNREAL,FNIMAG,FNLOG,FNSQR
9933 IF (TAU.GT.ONE) THEN
9934 FNREAL=(ASIN(1/SQRT(TAU)))**2
9936 ELSEIF (TAU.LT.ONE) THEN
9938 FNLOG=LOG((1+FNSQR)/(1-FNSQR))
9939 FNREAL=-0.25 * (FNLOG**2 - PIFAC**2)
9940 FNIMAG= 0.5 * PIFAC*FNLOG
9942 FNREAL=0.25*PIFAC**2
9947 *CMZ :- -02/05/91 11.11.45 by Federico Carminati
9948 *-- Author : Mike Seymour
9949 C-----------------------------------------------------------------------
9950 FUNCTION HWDHGF(X,Y)
9951 C-----------------------------------------------------------------------
9952 C CALCULATE THE DOUBLE BREIT-WIGNER INTEGRAL
9953 C X=(EMV/EMH)**2 , Y=EMV*GAMV/EMH**2
9954 C-----------------------------------------------------------------------
9955 INCLUDE 'herwig65.inc'
9956 DOUBLE PRECISION HWDHGF,X,Y,CHANGE,X1,X2,FAC1,FAC2,TH1,TH2,TH1HI,
9957 & TH1LO,TH2HI,TH2LO,X2MAX,SQFAC
9958 INTEGER NBIN,IBIN1,IBIN2
9959 C CHANGE IS THE POINT WHERE DIRECT INTEGRATION BEGINS TO CONVERGE
9960 C FASTER THAN STANDARD BREIT-WIGNER SUBSTITUTION
9962 DATA CHANGE,NBIN/0.425D0,25/
9964 IF (Y.LT.ZERO) RETURN
9965 IF (X.GT.CHANGE) THEN
9966 C---DIRECT INTEGRATION
9969 X1=(IBIN1-0.5) * FAC1
9970 FAC2=( (1-SQRT(X1))**2-X1 ) / NBIN
9972 X2=(IBIN2-0.5) * FAC2 + X1
9973 SQFAC=1+X1**2+X2**2-2*(X1+X2+X1*X2)
9974 IF (SQFAC.LT.ZERO) GOTO 100
9976 & * ((1-X1-X2)**2+8*X1*X2)
9978 & / ((X1-X)**2+Y**2) *Y
9979 & / ((X2-X)**2+Y**2) *Y
9984 C---INTEGRATION USING TAN THETA SUBSTITUTIONS
9987 FAC1=(TH1HI-TH1LO) / NBIN
9989 TH1=(IBIN1-0.5) * FAC1 + TH1LO
9991 X2MAX=MIN(X1,(1-SQRT(X1))**2)
9993 TH2HI=ATAN((X2MAX-X)/Y)
9994 FAC2=(TH2HI-TH2LO) / NBIN
9996 TH2=(IBIN2-0.5) * FAC2 + TH2LO
9998 SQFAC=1+X1**2+X2**2-2*(X1+X2+X1*X2)
9999 IF (SQFAC.LT.ZERO) GOTO 300
10001 & * ((1-X1-X2)**2+8*X1*X2)
10007 HWDHGF=HWDHGF/(PIFAC*PIFAC)
10010 *CMZ :- -24/04/92 14.23.44 by Mike Seymour
10011 *-- Author : Mike Seymour
10012 C-----------------------------------------------------------------------
10013 SUBROUTINE HWDHIG(GAMINP)
10014 C-----------------------------------------------------------------------
10015 C HIGGS DECAY ROUTINE
10016 C A) FOR GAMinp=0 FIND AND DECAY HIGGS
10017 C B) FOR GAMinp>0 CALCULATE TOTAL HIGGS WIDTH
10018 C FOR EMH=GAMINP. STORE RESULT IN GAMINP.
10019 C-----------------------------------------------------------------------
10020 INCLUDE 'herwig65.inc'
10021 DOUBLE PRECISION HWDHGF,HWRGEN,HWRUNI,HWUSQR,HWUPCM,GAMINP,EMH,
10022 & EMF,COLFAC,ENF,K1,K0,BET0,BET1,GAM0,GAM1,SCLOG,CFAC,XF,EM,GAMLIM,
10023 & GAM,XW,EMW,XZ,EMZ,YW,YZ,EMI,TAUT,TAUW,WIDHIG,VECDEC,EMB,GAMB,
10024 & TMIN,TMAX1,EM1,TMAX2,EM2,X1,X2,PROB,PCM,SUMR,SUMI,TAUTR,TAUTI,
10025 & TAUWR,TAUWI,GFACTR
10026 INTEGER HWRINT,IHIG,I,IFERM,NLOOK,I1,I2,IPART,IMODE,IDEC,MMAX
10028 EXTERNAL HWDHGF,HWRGEN,HWRUNI,HWUSQR,HWUPCM,HWRINT,HWRLOG
10030 PARAMETER (NLOOK=100)
10031 DIMENSION VECDEC(2,0:NLOOK)
10032 EQUIVALENCE (EMW,RMASS(198)),(EMZ,RMASS(200))
10034 DATA GAMLIM,GAM,EM/10D0,2*0D0/
10035 C---IF DECAY, FIND HIGGS (HWDHAD WILL HAVE GIVEN IT STATUS=1)
10036 IF (GAMINP.EQ.ZERO) THEN
10039 10 IF (IHIG.EQ.0.AND.IDHW(I).EQ.201.AND.ISTHEP(I).EQ.1) IHIG=I
10040 IF (IHIG.EQ.0) THEN
10041 CALL HWWARN('HWDHIG',101)
10045 IF (EMH.LE.ZERO) THEN
10046 CALL HWWARN('HWDHIG',102)
10052 IF (EMH.LE.ZERO) THEN
10057 C---CALCULATE BRANCHING FRACTIONS
10059 C---NLL CORRECTION TO QUARK DECAY RATE (HHG eq 2.6-9)
10062 1 IF (2*RMASS(I).LT.EMH) ENF=ENF+1
10065 BET0=(11*CAFAC-2*ENF)/3
10066 BET1=(34*CAFAC**2-(10*CAFAC+6*CFFAC)*ENF)/3
10068 GAM1=-404./3+40*ENF/9
10069 SCLOG=LOG(EMH**2/QCDLAM**2)
10070 CFAC=1 + ( K1/K0 - 2*GAM0 + GAM0*BET1/BET0**2*LOG(SCLOG)
10071 & + (GAM0*BET1-GAM1*BET0)/BET0**2) / (BET0*SCLOG)
10073 IF (IFERM.LE.6) THEN
10076 COLFAC=FLOAT(NCOLO)
10078 & EMF=EMF*(LOG(EMH/QCDLAM)/LOG(EMF/QCDLAM))**(GAM0/(2*BET0))
10080 EMF=RMASS(107+IFERM*2)
10085 IF (FOUR*XF.LT.ONE) THEN
10086 GFACTR=ALPHEM/(8.*SWEIN*EMW**2)
10087 BRHIG(IFERM)=COLFAC*GFACTR*EMH*EMF**2 * (1-4*XF)**1.5 * CFAC
10093 IF (ABS(EM-EMH).GE.GAMLIM*GAM) THEN
10094 C---OFF EDGE OF LOOK-UP TABLE
10099 BRHIG(10)=.50*GFACTR * EMH**3 * HWDHGF(XW,YW)
10100 BRHIG(11)=.25*GFACTR * EMH**3 * HWDHGF(XZ,YZ)
10103 EMI=((EMH-EM)/(GAM*GAMLIM)+1)*NLOOK/2.0
10106 BRHIG(10)=.50*GFACTR * EMH**3 * ( VECDEC(1,I1)*(I2-EMI) +
10107 & VECDEC(1,I2)*(EMI-I1) )
10108 BRHIG(11)=.25*GFACTR * EMH**3 * ( VECDEC(2,I1)*(I2-EMI) +
10109 & VECDEC(2,I2)*(EMI-I1) )
10112 TAUT=(2*RMASS(6)/EMH)**2
10113 TAUW=(2*EMW/EMH)**2
10114 CALL HWDHGC(TAUT,TAUTR,TAUTI)
10115 CALL HWDHGC(TAUW,TAUWR,TAUWI)
10116 SUMR=4./3*( - 2*TAUT*( 1 + (1-TAUT)*TAUTR ) ) * ENHANC(6)
10117 & +(2 + 3*TAUW*( 1 + (2-TAUW)*TAUWR ) ) * ENHANC(10)
10118 SUMI=4./3*( - 2*TAUT*( (1-TAUT)*TAUTI ) ) * ENHANC(6)
10119 & +( 3*TAUW*( (2-TAUW)*TAUWI ) ) * ENHANC(10)
10120 BRHIG(12)=GFACTR*.03125*(ALPHEM/PIFAC)**2
10121 & *EMH**3 * (SUMR**2 + SUMI**2)
10124 IF (IPART.LT.12) BRHIG(IPART)=BRHIG(IPART)*ENHANC(IPART)**2
10125 200 WIDHIG=WIDHIG+BRHIG(IPART)
10126 IF (WIDHIG.EQ.ZERO) THEN
10127 CALL HWWARN('HWDHIG',103)
10131 300 BRHIG(IPART)=BRHIG(IPART)/WIDHIG
10132 IF (EM.NE.RMASS(201)) THEN
10133 C---SET UP W*W*/Z*Z* LOOKUP TABLES
10136 GAMLIM=MAX(GAMLIM,GAMMAX)
10138 EMH=(I*2.0/NLOOK-1)*GAM*GAMLIM+EM
10143 VECDEC(1,I)=HWDHGF(XW,YW)
10144 VECDEC(2,I)=HWDHGF(XZ,YZ)
10148 IF (GAMINP.GT.ZERO) THEN
10152 C---SEE IF USER SPECIFIED A DECAY MODE
10153 IMODE=MOD(ABS(IPROC),100)
10154 C---IF NOT, CHOOSE ONE
10155 IF (IMODE.LT.1.OR.IMODE.GT.12) THEN
10157 IF (IMODE.LT.1) MMAX=6
10158 500 IMODE=HWRINT(1,MMAX)
10159 IF (BRHIG(IMODE).LT.HWRGEN(0)) GOTO 500
10161 C---SEE IF SPECIFIED DECAY IS POSSIBLE
10162 IF (BRHIG(IMODE).EQ.ZERO) THEN
10163 CALL HWWARN('HWDHIG',104)
10166 IF (IMODE.LE.6) THEN
10168 ELSEIF (IMODE.LE.9) THEN
10170 ELSEIF (IMODE.EQ.10) THEN
10172 ELSEIF (IMODE.EQ.11) THEN
10174 ELSEIF (IMODE.EQ.12) THEN
10177 C---STATUS, IDs AND POINTERS
10182 IDHEP(NHEP+I)=IDPDG(IDEC)
10183 JDAHEP(I,IHIG)=NHEP+I
10184 JMOHEP(1,NHEP+I)=IHIG
10185 JMOHEP(2,NHEP+I)=NHEP+(3-I)
10186 JDAHEP(2,NHEP+I)=NHEP+(3-I)
10187 PHEP(5,NHEP+I)=RMASS(IDEC)
10189 IF (IDEC.EQ.204) IDEC=199
10190 IF (IDEC.EQ.206) IDEC=200
10191 IF (IDEC.EQ. 65) IDEC= 59
10193 C---ALLOW W/Z TO BE OFF-SHELL
10194 IF (IMODE.EQ.10.OR.IMODE.EQ.11) THEN
10195 IF (IMODE.EQ.10) THEN
10202 C---STANDARD MASS DISTRIBUTION
10203 700 TMIN=ATAN(-EMB/GAMB)
10204 TMAX1=ATAN((EMH**2/EMB-EMB)/GAMB)
10205 EM1=HWUSQR(EMB*(GAMB*TAN(HWRUNI(0,TMIN,TMAX1))+EMB))
10206 TMAX2=ATAN(((EMH-EM1)**2/EMB-EMB)/GAMB)
10207 EM2=HWUSQR(EMB*(GAMB*TAN(HWRUNI(0,TMIN,TMAX2))+EMB))
10210 C---CORRECT MASS DISTRIBUTION
10211 PROB=HWUSQR(1+X1**2+X2**2-2*X1-2*X2-2*X1*X2)
10212 & * ((X1+X2-1)**2 + 8*X1*X2)
10213 IF (.NOT.HWRLOG(PROB)) GOTO 700
10214 C---CALCULATE SPIN DENSITY MATRIX
10215 RHOHEP(1,NHEP+1)=4*X1*X2 / (8*X1*X2 + (X1+X2-1)**2)
10216 RHOHEP(2,NHEP+1)=(X1+X2-1)**2 / (8*X1*X2 + (X1+X2-1)**2)
10217 RHOHEP(3,NHEP+1)=RHOHEP(1,NHEP+1)
10218 C---SYMMETRIZE DISTRIBUTIONS IN PARTICLES 1,2
10219 IF (HWRLOG(HALF)) THEN
10228 PCM=HWUPCM(EMH,PHEP(5,NHEP+1),PHEP(5,NHEP+2))
10229 IF (PCM.LT.ZERO) THEN
10230 CALL HWWARN('HWDHIG',105)
10233 CALL HWDTWO(PHEP(1,IHIG),PHEP(1,NHEP+1),PHEP(1,NHEP+2),
10236 C---IF QUARK DECAY, HADRONIZE
10237 IF (IMODE.LE.6) THEN
10244 C--MHS FIX 07/03/05 - VERTEX POSITION FOR DECAYS TO LEPTONS OR PHOTONS
10245 ELSEIF (IMODE.LE.9.OR.IMODE.EQ.12) THEN
10246 CALL HWVEQU(4,VTXPIP,VHEP(1,NHEP-1))
10247 CALL HWVEQU(4,VTXPIP,VHEP(1,NHEP))
10253 *CMZ :- -17/10/01 10:19:15 by Peter Richardson
10254 *-- Author : Ian Knowles & Bryan Webber
10255 C-----------------------------------------------------------------------
10257 C-----------------------------------------------------------------------
10258 C Performs decays of heavy objects (heavy quarks & SUSY particles)
10259 C MODIFIED TO INCLUDE R-PARITY VIOLATING SUSY PR 9/4/99
10260 C MODIFIED TO CALL A NUMBER OF ROUTINES TO DO THE VARIOUS BITS OF
10262 C-----------------------------------------------------------------------
10263 INCLUDE 'herwig65.inc'
10264 DOUBLE PRECISION PW(5)
10265 INTEGER IHEP,IS,ID,IM,KHEP,LHEP,MHEP,NPR,CLSAVE(2),NHEPST
10268 IF (IERROR.NE.0) RETURN
10273 DO 60 IHEP=1,NMXHEP
10276 IF(SYSPIN.AND.NSPN.NE.0) CALL HWDSIN(CLSAVE)
10277 IF (.NOT.RSTAB(ID).AND.(ID.EQ.6.OR.ID.EQ.12.OR.
10278 & (ID.GE.203.AND.ID.LE.218).OR.ABS(IDPDG(ID)).GT.1000000).AND.
10279 & ((IS.EQ.120.AND.JDAHEP(1,IHEP).EQ.IHEP).OR.
10280 & IS.EQ.190.OR.(IS.GE.147.AND.IS.LE.151))) THEN
10282 C--select the decay mode and enter the decay products in the event record
10283 CALL HWDHO1(IHEP,ID,IM,NPR,LHEP,MHEP)
10284 IF (IERROR.NE.0) RETURN
10285 C--select the momenta of the decay products
10286 CALL HWDHO2(IHEP,IM,NPR,MHEP,LHEP,KHEP,PW)
10287 IF (IERROR.NE.0) RETURN
10288 C--make the colour connections
10289 CALL HWDHO3(ID,IM,NPR,MHEP,LHEP,KHEP,CLSAVE)
10290 IF (IERROR.NE.0) RETURN
10291 C--perform the parton-showers
10292 CALL HWDHO4(IHEP,ID,IM,NPR,MHEP,LHEP,KHEP,PW)
10293 IF (IERROR.NE.0) RETURN
10295 C--perform the colour corrections for RPV
10296 CALL HWDHO5(MHEP,LHEP,CLSAVE)
10297 IF(IERROR.NE.0) RETURN
10298 IF (IHEP.EQ.NHEP) GOTO 70
10300 70 IF(SYSPIN.AND.NHEP.NE.NHEPST) FOUND=.TRUE.
10302 C--final check for colour disconnection
10304 C Go back to check for further heavy decay products
10309 *CMZ :- -17/10/01 10:19:15 by Peter Richardson
10310 *-- Author : Ian Knowles & Bryan Webber
10311 C-----------------------------------------------------------------------
10312 SUBROUTINE HWDHO1(IHEP,ID,IM,NPR,LHEP,MHEP)
10313 C-----------------------------------------------------------------------
10314 C Subroutine to perform the first part of the heavy object decays
10315 C IE to select the decay mode
10316 C was part of HWDHOB
10317 C-----------------------------------------------------------------------
10318 INCLUDE 'herwig65.inc'
10319 DOUBLE PRECISION HWUMBW,HWRGEN,SDKM,RN,BF
10320 INTEGER IST(3),IHEP,ID,IM,I,JHEP,LHEP,MHEP,NPR,MTRY,NTRY,IS
10323 DATA IST/113,114,114/
10324 IF (IERROR.NE.0) RETURN
10325 IF(.NOT.RPARTY) THEN
10330 CALL HWVEQU(5,PHEP(1,IHEP),PHEP(1,NHEP))
10331 CALL HWVEQU(4,VHEP(1,IHEP),VHEP(1,NHEP))
10332 JMOHEP(1,NHEP)=JMOHEP(1,IHEP)
10333 JMOHEP(2,NHEP)=JMOHEP(2,IHEP)
10334 JDAHEP(1,NHEP)=JDAHEP(1,IHEP)
10335 JDAHEP(2,NHEP)=JDAHEP(2,IHEP)
10337 C Make a copy of decaying object
10340 IDHW(NHEP)=IDHW(IHEP)
10341 IDHEP(NHEP)=IDHEP(IHEP)
10342 CALL HWVEQU(5,PHEP(1,IHEP),PHEP(1,NHEP))
10343 CALL HWVEQU(4,VHEP(1,IHEP),VHEP(1,NHEP))
10344 JMOHEP(1,NHEP)=JMOHEP(1,IHEP)
10345 JMOHEP(2,NHEP)=JMOHEP(2,IHEP)
10346 C--copy the location of the particle in the spin block
10347 IF(SYSPIN.AND.NSPN.NE.0) THEN
10348 IF(ISNHEP(IHEP).EQ.0) THEN
10353 IF(ISNHEP(IS).EQ.0.AND.MTRY.LE.NETRY) GOTO 5
10354 IF(MTRY.GT.NETRY) THEN
10355 CALL HWWARN('HWDHO1',102)
10358 ISNHEP(IHEP) = ISNHEP(IS)
10360 ISNHEP(NHEP) = ISNHEP(JMOHEP(1,NHEP))
10364 C Select decay mode
10368 DO 20 I=1,NMODES(ID)
10370 IF (BF.GE.RN) GOTO 30
10372 CALL HWWARN('HWDHO1',50)
10373 30 IF (NHEP+5.GT.NMXHEP) THEN
10374 CALL HWWARN('HWDHO1',100)
10378 JDAHEP(1,NHEP)=NHEP+1
10379 JDAHEP(2,NHEP)=NHEP+NPR
10380 C Reset colour pointers (if set)
10381 JHEP=JMOHEP(2,IHEP)
10382 IF (JHEP.GT.0) THEN
10383 IF (JDAHEP(2,JHEP).EQ.IHEP) JDAHEP(2,JHEP)=NHEP
10384 IF(.NOT.RPARTY.AND.ISTHEP(JHEP).EQ.155
10385 & .AND.ABS(IDHEP(JHEP)).GT.1000000
10386 & .AND.JDAHEP(2,JHEP-1).EQ.IHEP) JDAHEP(2,JHEP-1) = NHEP
10388 JHEP=JDAHEP(2,IHEP)
10389 IF (JHEP.GT.0) THEN
10390 IF (JMOHEP(2,JHEP).EQ.IHEP) JMOHEP(2,JHEP)=NHEP
10391 IF(.NOT.RPARTY.AND.ISTHEP(JHEP).EQ.155
10392 & .AND.ABS(IDHEP(JHEP)).GT.1000000
10393 & .AND.JMOHEP(2,JHEP-1).EQ.IHEP) JMOHEP(2,JHEP-1) = NHEP
10395 C--Reset colour pointers if baryon number violated
10396 IF(.NOT.RPARTY) THEN
10398 IF(ISTHEP(JHEP).EQ.155
10399 & .AND.ABS(IDHEP(JHEP)).GT.1000000.AND.
10400 & JDAHEP(2,JHEP-1).EQ.IHEP) JDAHEP(2,JHEP-1)= NHEP
10401 IF(JDAHEP(2,JHEP).EQ.IHEP) JDAHEP(2,JHEP)=NHEP
10402 IF(JMOHEP(2,JHEP).EQ.IHEP) JMOHEP(2,JHEP)=NHEP
10404 IF(HRDCOL(1,1).EQ.IHEP) HRDCOL(1,1)=NHEP
10406 C Relabel original track
10407 IF (ISTHEP(IHEP).NE.120) ISTHEP(IHEP)=3
10408 JMOHEP(2,IHEP)=JMOHEP(1,IHEP)
10409 JDAHEP(1,IHEP)=NHEP
10410 JDAHEP(2,IHEP)=NHEP
10411 C Label decay products and choose masses
10419 IDHW(NHEP)=IDKPRD(I,IM)
10420 IDHEP(NHEP)=IDPDG(IDKPRD(I,IM))
10421 ISTHEP(NHEP)=IST(I)
10422 JMOHEP(1,NHEP)=LHEP
10424 PHEP(5,NHEP)=HWUMBW(IDKPRD(I,IM))
10425 40 SDKM=SDKM-PHEP(5,NHEP)
10426 IF (SDKM.LT.ZERO) THEN
10428 IF (NTRY.LE.NETRY) GO TO 35
10429 CALL HWWARN('HWDHO1',1)
10430 IF (MTRY.LE.NETRY) GO TO 15
10431 CALL HWWARN('HWDHO1',101)
10434 C Assign production vertices to decay products
10435 CALL HWUDKL(ID,PHEP(1,IHEP),VHEP(1,MHEP))
10436 CALL HWVSUM(4,VHEP(1,IHEP),VHEP(1,MHEP),VHEP(1,MHEP))
10437 CALL HWVEQU(4,VHEP(1,MHEP),VHEP(1,NHEP))
10441 *CMZ :- -30/09/02 14:05:28 by Peter Richardson
10442 *-- Author : Ian Knowles & Bryan Webber
10443 C-----------------------------------------------------------------------
10444 SUBROUTINE HWDHO2(IHEP,IM,NPR,MHEP,LHEP,KHEP,PW)
10445 C-----------------------------------------------------------------------
10446 C Subroutine to perform the second part of the heavy object decays
10447 C IE generate the kinematics for the decay
10448 C was part of HWDHOB
10449 C-----------------------------------------------------------------------
10450 INCLUDE 'herwig65.inc'
10452 COMMON/SFF/IT1,IB1,IT2,IB2
10453 DOUBLE PRECISION TB,BT
10454 INTEGER IT1,IB1,IT2,IB2,ISP
10455 DOUBLE PRECISION GAMHPM
10456 DOUBLE PRECISION HWUPCM,HWRGEN,PCM,
10457 & EMMX,EMWSQ,GMWSQ,EMLIM,PW(5),EMTST,HWDPWT,HWDWWT,HWULDO,HWDHWT
10458 DOUBLE COMPLEX RHOIN(2,2,2)
10459 INTEGER IHEP,IM,KHEP,LHEP,MHEP,NPR,RHEP
10460 EXTERNAL HWRGEN,HWDPWT,HWDWWT,HWDHWT
10462 DATA RHOIN/(1.0D0,0.0D0),(0.0D0,0.0D0),
10463 & (0.0D0,0.0D0),(0.0D0,0.0D0),
10464 & (0.5D0,0.0D0),(0.0D0,0.0D0),
10465 & (0.0D0,0.0D0),(0.5D0,0.0D0)/
10466 ISP = INT(2*RSPIN(IDHW(IHEP)))+1
10467 IF (IERROR.NE.0) RETURN
10469 C Two body decay: LHEP -> MHEP + NHEP
10470 IF(NME(IM).GT.20000.AND.NME(IM).LT.30000) THEN
10471 C--generate a two body decay to a gauge boson as a three body decay
10472 CALL HWDSM3(2,IHEP,MHEP,NHEP,0,NME(IM)-20000,RHOIN(1,1,ISP),1)
10473 C--generate a two body decay of a Higgs to two gauge bosons
10474 ELSEIF(NME(IM).GT.40000.AND.NME(IM).LT.50000) THEN
10475 CALL HWDSM4(1,IHEP,MHEP,NHEP,NME(IM)-40000)
10476 C--if spin correlations call the routine to set-up the matrix element
10477 ELSEIF(SYSPIN.AND.NME(IM).GE.30000.AND.NME(IM).LE.40000) THEN
10478 CALL HWDSM2(IHEP,MHEP,NHEP,NME(IM)-30000,RHOIN(1,1,ISP),1)
10480 PCM=HWUPCM(PHEP(5,IHEP),PHEP(5,MHEP),PHEP(5,NHEP))
10481 CALL HWDTWO(PHEP(1,IHEP),PHEP(1,MHEP),
10482 & PHEP(1,NHEP),PCM,TWO,.FALSE.)
10484 ELSEIF (NPR.EQ.3) THEN
10485 C Three body decay: LHEP -> KHEP + MHEP + NHEP
10488 C Provisional colour self-connection of KHEP
10489 JMOHEP(2,KHEP)=KHEP
10490 JDAHEP(2,KHEP)=KHEP
10491 IF (NME(IM).EQ.100) THEN
10492 C Generate decay momenta using full (V-A)*(V-A) matrix element
10493 EMMX=PHEP(5,IHEP)-PHEP(5,NHEP)
10494 EMWSQ=RMASS(198)**2
10495 GMWSQ=(RMASS(198)*GAMW)**2
10497 IF (EMMX.LT.RMASS(198)) EMLIM=EMLIM+(EMWSQ-EMMX**2)**2
10498 50 CALL HWDTHR(PHEP(1,IHEP),PHEP(1,MHEP),
10499 & PHEP(1,KHEP),PHEP(1,NHEP),HWDWWT)
10500 CALL HWVSUM(4,PHEP(1,KHEP),PHEP(1,MHEP),PW)
10501 PW(5)=HWULDO(PW,PW)
10502 EMTST=(EMWSQ-PW(5))**2
10503 IF ((EMTST+GMWSQ)*HWRGEN(1).GT.EMLIM) GOTO 50
10505 C Assign production vertices to 1 and 2
10506 CALL HWUDKL(198,PW,VHEP(1,KHEP))
10507 CALL HWVSUM(4,VHEP(1,NHEP),VHEP(1,KHEP),VHEP(1,KHEP))
10508 ELSE IF (NME(IM).EQ.200) THEN
10509 C Generate decay momenta using full
10510 C ((V-A)*TB1+(V+A)*CT1)*((V-A)*TB2+(V+A)*CT2)) matrix element
10511 GAMHPM=RMASS(206)/DKLTM(206)
10513 IF((IDK(IM).EQ. 2).OR.(IDK(IM).EQ. 4).OR.
10514 & (IDK(IM).EQ. 6).OR.(IDK(IM).EQ. 8).OR.
10515 & (IDK(IM).EQ. 10).OR.(IDK(IM).EQ. 12).OR.
10516 & (IDK(IM).EQ.122).OR.(IDK(IM).EQ.124).OR.
10517 & (IDK(IM).EQ.126).OR.(IDK(IM).EQ.128).OR.
10518 & (IDK(IM).EQ.130).OR.(IDK(IM).EQ.132))THEN
10523 IF((IDKPRD(1,IM).EQ. 2).OR.(IDKPRD(1,IM).EQ. 4).OR.
10524 & (IDKPRD(1,IM).EQ. 6).OR.(IDKPRD(1,IM).EQ. 8).OR.
10525 & (IDKPRD(1,IM).EQ. 10).OR.(IDKPRD(1,IM).EQ. 12).OR.
10526 & (IDKPRD(1,IM).EQ.122).OR.(IDKPRD(1,IM).EQ.124).OR.
10527 & (IDKPRD(1,IM).EQ.126).OR.(IDKPRD(1,IM).EQ.128).OR.
10528 & (IDKPRD(1,IM).EQ.130).OR.(IDKPRD(1,IM).EQ.132))THEN
10537 EMMX=PHEP(5,IHEP)-PHEP(5,NHEP)
10538 EMWSQ=RMASS(206)**2
10539 GMWSQ=(RMASS(206)*GAMHPM)**2
10541 IF (EMMX.LT.RMASS(206)) EMLIM=EMLIM+(EMWSQ-EMMX**2)**2
10542 55 CALL HWDTHR(PHEP(1,IHEP),PHEP(1,NHEP),
10543 & PHEP(1,KHEP),PHEP(1,MHEP),HWDHWT)
10544 CALL HWVSUM(4,PHEP(1,KHEP),PHEP(1,MHEP),PW)
10545 PW(5)=HWULDO(PW,PW)
10546 EMTST=(EMWSQ-PW(5))**2
10547 IF ((EMTST+GMWSQ)*HWRGEN(2).GT.EMLIM) GOTO 55
10549 C Assign production vertices to 1 and 2
10550 CALL HWUDKL(206,PW,VHEP(1,KHEP))
10551 CALL HWVSUM(4,VHEP(1,NHEP),VHEP(1,KHEP),VHEP(1,KHEP))
10552 ELSEIF(NME(IM).EQ.300) THEN
10553 C Generate momenta using 3-body RPV matrix element
10554 CALL HWDRME(LHEP,KHEP)
10555 C--Three body SUSY decay
10556 ELSEIF(NME(IM).GE.10000.AND.NME(IM).LT.20000) THEN
10557 CALL HWDSM3(3,IHEP,MHEP,KHEP,NHEP,NME(IM)-10000,
10558 & RHOIN(1,1,ISP),1)
10559 C--special for top decay
10560 IF(ABS(IDHEP(IHEP)).EQ.6) THEN
10561 CALL HWVSUM(4,PHEP(1,KHEP),PHEP(1,MHEP),PW)
10565 C Three body phase space decay
10566 CALL HWDTHR(PHEP(1,IHEP),PHEP(1,MHEP),
10567 & PHEP(1,KHEP),PHEP(1,NHEP),HWDPWT)
10569 CALL HWVEQU(4,VHEP(1,KHEP),VHEP(1,MHEP))
10570 ELSEIF(NPR.EQ.4) THEN
10571 C Four body decay: LHEP -> KHEP + RHEP + MHEP + NHEP
10576 C Provisional colour connections of KHEP and RHEP
10577 JMOHEP(2,KHEP)=RHEP
10578 JDAHEP(2,KHEP)=RHEP
10579 JMOHEP(2,RHEP)=KHEP
10580 JDAHEP(2,RHEP)=KHEP
10581 C Four body phase space decay
10582 CALL HWDFOR(PHEP(1,IHEP),PHEP(1,KHEP),PHEP(1,RHEP),
10583 & PHEP(1,MHEP),PHEP(1,NHEP))
10584 IF(IERROR.NE.0) RETURN
10585 CALL HWVEQU(4,VHEP(1,KHEP),VHEP(1,RHEP))
10586 CALL HWVEQU(4,VHEP(1,KHEP),VHEP(1,MHEP))
10588 CALL HWWARN('HWDHO2',100)
10592 *CMZ :- -17/10/01 10:19:15 by Peter Richardson
10593 *-- Author : Ian Knowles & Bryan Webber
10594 C-----------------------------------------------------------------------
10595 SUBROUTINE HWDHO3(ID,IM,NPR,MHEP,LHEP,KHEP,CLSAVE)
10596 C-----------------------------------------------------------------------
10597 C Subroutine to perform the third part of the heavy object decays
10598 C IE setup the colour connections
10599 C was part of HWDHOB
10600 C-----------------------------------------------------------------------
10601 INCLUDE 'herwig65.inc'
10602 INTEGER ID,IM,KHEP,LHEP,MHEP,NPR,CLSAVE(2)
10603 IF (IERROR.NE.0) RETURN
10604 C Colour connections
10605 IF (ID.EQ.6.OR.ID.EQ.12.OR.(ID.GE.209.AND.ID.LE.212)
10606 & .OR.(ID.GE.215.AND.ID.LE.218)) THEN
10607 IF ((NPR.EQ.3.AND.NME(IM).EQ.100).OR.
10608 & ((SYSPIN.OR.THREEB).AND.NPR.EQ.3.AND.
10609 & NME(IM).GE.10000.AND.NME(IM).LE.20000)) THEN
10610 C usual heavy quark decay
10611 JMOHEP(2,KHEP)=MHEP
10612 JDAHEP(2,KHEP)=MHEP
10613 JMOHEP(2,MHEP)=KHEP
10614 JDAHEP(2,MHEP)=KHEP
10615 JMOHEP(2,NHEP)=LHEP
10616 JDAHEP(2,NHEP)=LHEP
10617 ELSEIF (ABS(IDHEP(MHEP)).EQ.37) THEN
10618 C heavy quark to charged Higgs 2->2
10619 JMOHEP(2,MHEP)=MHEP
10620 JDAHEP(2,MHEP)=MHEP
10621 JMOHEP(2,NHEP)=LHEP
10622 JDAHEP(2,NHEP)=LHEP
10623 ELSEIF (ABS(IDHEP(NHEP)).EQ.37) THEN
10624 C heavy quark to charged Higgs 2->2
10625 JMOHEP(2,MHEP)=LHEP
10626 JDAHEP(2,MHEP)=LHEP
10627 JMOHEP(2,NHEP)=NHEP
10628 JDAHEP(2,NHEP)=NHEP
10629 ELSE IF (NPR.EQ.3.AND.NME(IM).EQ.200) THEN
10630 C heavy quark to charged Higgs 2->3
10631 JMOHEP(2,KHEP)=MHEP
10632 JDAHEP(2,KHEP)=MHEP
10633 JMOHEP(2,MHEP)=KHEP
10634 JDAHEP(2,MHEP)=KHEP
10635 JMOHEP(2,NHEP)=LHEP
10636 JDAHEP(2,NHEP)=LHEP
10638 CALL HWWARN('HWDHO3',100)
10642 IF(.NOT.RPARTY.AND.
10643 & ((NPR.EQ.2.AND.ID.GE.401.AND.ID.LT.448.AND.
10644 & IDHW(MHEP).LE.132.AND.IDHW(NHEP).LE.132)
10645 & .OR.(NPR.EQ.3.AND.ID.GE.449.AND.ID.LE.457.AND.
10646 & IDHW(MHEP).LE.132.AND.IDHW(NHEP).LE.132.AND.
10647 & IDHW(MHEP-1).LE.132))) THEN
10648 C R-parity violating SUSY decays
10650 C--Rparity slepton colour connections
10651 IF(ID.GE.425.AND.ID.LE.448) THEN
10652 IF(IDHW(MHEP).GT.12) THEN
10653 JMOHEP(2,MHEP) = MHEP
10654 JDAHEP(2,MHEP) = MHEP
10655 JMOHEP(2,NHEP) = NHEP
10656 JDAHEP(2,NHEP) = NHEP
10658 JMOHEP(2,MHEP) = NHEP
10659 JDAHEP(2,MHEP) = NHEP
10660 JMOHEP(2,NHEP) = MHEP
10661 JDAHEP(2,NHEP) = MHEP
10663 C--Rparity squark colour connections
10665 IF(IDHEP(LHEP).GT.0) THEN
10666 C--LQD decay colour connections
10667 IF(IDHW(MHEP).GT.12) THEN
10668 JMOHEP(2,MHEP) = MHEP
10669 JDAHEP(2,MHEP) = MHEP
10670 JMOHEP(2,NHEP) = LHEP
10671 JDAHEP(2,NHEP) = LHEP
10673 C--UDD decay colour connections
10675 CALL HWDRCL(LHEP,MHEP,CLSAVE)
10678 C--Antisquark connections
10679 IF(IDHW(MHEP).GT.12) THEN
10680 JMOHEP(2,MHEP) = MHEP
10681 JDAHEP(2,MHEP) = MHEP
10682 JMOHEP(2,NHEP) = LHEP
10683 JDAHEP(2,NHEP) = LHEP
10686 CALL HWDRCL(LHEP,MHEP,CLSAVE)
10691 IF(ID.GE.450.AND.ID.LE.457) THEN
10692 C--Rparity Neutralino/Chargino colour connection
10693 IF(IDHW(MHEP-1).LE.12.AND.IDHW(MHEP).LE.12.
10694 & AND.IDHW(NHEP).LE.12) THEN
10696 CALL HWDRCL(LHEP,MHEP,CLSAVE)
10698 JMOHEP(2,MHEP) = NHEP
10699 JDAHEP(2,MHEP) = NHEP
10700 JMOHEP(2,NHEP) = MHEP
10701 JDAHEP(2,NHEP) = MHEP
10703 C--Rparity gluino colour connections
10704 ELSEIF(ID.EQ.449) THEN
10705 IF(IDHW(MHEP-1).LE.12.AND.IDHW(MHEP).LE.12.
10706 & AND.IDHW(NHEP).LE.12) THEN
10708 CALL HWDRCL(LHEP,MHEP,CLSAVE)
10709 C--Now the lepton number violating decay
10711 IF(IDHW(MHEP).LE.6) THEN
10712 JMOHEP(2,MHEP) = LHEP
10713 JDAHEP(2,MHEP) = NHEP
10714 JMOHEP(2,NHEP) = MHEP
10715 JDAHEP(2,NHEP) = LHEP
10717 JMOHEP(2,MHEP) = NHEP
10718 JDAHEP(2,MHEP) = LHEP
10719 JMOHEP(2,NHEP) = LHEP
10720 JDAHEP(2,NHEP) = MHEP
10724 CALL HWWARN('HWDHO3',101)
10729 C Normal SUSY decays
10730 IF (ID.LE.448.AND.ID.GT.207) THEN
10731 C Squark (or slepton)
10732 IF (IDHW(MHEP).EQ.449) THEN
10733 IF (IDHEP(LHEP).GT.0) THEN
10734 JMOHEP(2,MHEP)=LHEP
10735 JDAHEP(2,MHEP)=NHEP
10736 JMOHEP(2,NHEP)=MHEP
10737 JDAHEP(2,NHEP)=LHEP
10739 JMOHEP(2,MHEP)=NHEP
10740 JDAHEP(2,MHEP)=LHEP
10741 JMOHEP(2,NHEP)=LHEP
10742 JDAHEP(2,NHEP)=MHEP
10745 IF(NPR.EQ.3.AND.IDHW(MHEP).LE.12) THEN
10746 JMOHEP(2,MHEP)=NHEP
10747 JDAHEP(2,MHEP)=NHEP
10748 JMOHEP(2,NHEP)=MHEP
10749 JDAHEP(2,NHEP)=MHEP
10751 JMOHEP(2,MHEP)=MHEP
10752 JDAHEP(2,MHEP)=MHEP
10753 JMOHEP(2,NHEP)=LHEP
10754 JDAHEP(2,NHEP)=LHEP
10757 ELSEIF (ID.EQ.449) THEN
10759 IF (IDHW(NHEP).EQ.13) THEN
10760 JMOHEP(2,MHEP)=MHEP
10761 JDAHEP(2,MHEP)=MHEP
10762 JMOHEP(2,NHEP)=LHEP
10763 JDAHEP(2,NHEP)=LHEP
10764 ELSEIF (IDHEP(MHEP).GT.0) THEN
10765 JMOHEP(2,MHEP)=LHEP
10766 JDAHEP(2,MHEP)=NHEP
10767 JMOHEP(2,NHEP)=MHEP
10768 JDAHEP(2,NHEP)=LHEP
10770 JMOHEP(2,MHEP)=NHEP
10771 JDAHEP(2,MHEP)=LHEP
10772 JMOHEP(2,NHEP)=LHEP
10773 JDAHEP(2,NHEP)=MHEP
10777 JMOHEP(2,MHEP)=NHEP
10778 JDAHEP(2,MHEP)=NHEP
10779 JMOHEP(2,NHEP)=MHEP
10780 JDAHEP(2,NHEP)=MHEP
10787 *CMZ :- -30/09/02 14:05:28 by Peter Richardson
10788 *-- Author : Ian Knowles & Bryan Webber
10789 C-----------------------------------------------------------------------
10790 SUBROUTINE HWDHO4(IHEP,ID,IM,NPR,MHEP,LHEP,KHEP,PW)
10791 C-----------------------------------------------------------------------
10792 C Subroutine to perform the fourth part of the heavy object decays
10793 C IE parton-showers with special treatment for top
10794 C was part of HWDHOB
10795 C-----------------------------------------------------------------------
10796 INCLUDE 'herwig65.inc'
10797 DOUBLE PRECISION PW(5),PDW(5,3)
10798 INTEGER IHEP,ID,IM,I,KHEP,LHEP,MHEP,NPR,NTRY,WHEP,SHEP
10799 DOUBLE COMPLEX RHOIN(2,2)
10801 DATA RHOIN/(0.5D0,0.0D0),(0.0D0,0.0D0),
10802 & (0.0D0,0.0D0),(0.5D0,0.0D0)/
10803 IF (IERROR.NE.0) RETURN
10805 C---SPECIAL CASE FOR THREE-BODY TOP DECAYS:
10806 C RELABEL THEM AS TWO TWO-BODY DECAYS FOR PARTON SHOWERING
10807 IF ((ID.EQ.6.OR.ID.EQ.12).AND.NPR.EQ.3.AND.
10808 & (NME(IM).EQ.100.OR.NME(IM).EQ.200.OR.
10809 & (NME(IM).GT.10000.AND.NME(IM).LE.20000.AND.
10810 & (SYSPIN.OR.THREEB)))) THEN
10811 C---STORE W/H DECAY PRODUCTS
10812 CALL HWVEQU(10,PHEP(1,KHEP),PDW)
10813 C---BOOST THEM INTO W/H REST FRAME
10814 CALL HWULOF(PW,PDW(1,1),PDW(1,3))
10815 C---REPLACE THEM BY W/H
10816 CALL HWVEQU(5,PW,PHEP(1,KHEP))
10818 IF (NME(IM).EQ.100.OR.(NME(IM).GT.10000.AND.
10819 & NME(IM).LE.20000.AND.(SYSPIN.OR.THREEB)))IDHW(KHEP)=198
10820 IF((NME(IM).EQ.100.OR.(NME(IM).GT.10000.AND.
10821 & NME(IM).LE.20000.AND.(SYSPIN.OR.THREEB))).AND.(ID.EQ.12))
10823 IF (NME(IM).EQ.200)IDHW(KHEP)=206
10824 IF((NME(IM).EQ.200).AND.(ID.EQ.12))IDHW(KHEP)=207
10825 IDHEP(KHEP)=IDPDG(IDHW(KHEP))
10826 JMOHEP(2,KHEP)=KHEP
10827 JDAHEP(2,KHEP)=KHEP
10828 CALL HWVEQU(4,VHEP(1,NHEP),VHEP(1,KHEP))
10830 CALL HWVEQU(5,PHEP(1,NHEP),PHEP(1,MHEP))
10831 IDHW(MHEP)=IDHW(NHEP)
10832 IDHEP(MHEP)=IDHEP(NHEP)
10833 JDAHEP(2,LHEP)=MHEP
10834 JMOHEP(2,MHEP)=JMOHEP(2,NHEP)
10835 JDAHEP(2,MHEP)=JDAHEP(2,NHEP)
10836 CALL HWVEQU(4,VHEP(1,NHEP),VHEP(1,MHEP))
10838 C---DO PARTON SHOWER
10841 IF (IERROR.NE.0) RETURN
10842 C---FIND BOOSTED W/H MOMENTUM
10845 IF (NTRY.GT.NHEP.OR.WHEP.LE.0.OR.WHEP.GT.NHEP) THEN
10846 CALL HWWARN('HWDHO4',100)
10849 WHEP=JDAHEP(1,WHEP)
10850 IF (ISTHEP(WHEP).NE.190) GOTO 41
10851 C---AND HENCE ITS CHILDRENS MOMENTA
10852 CALL HWULOB(PHEP(1,WHEP),PDW(1,3),PHEP(1,NHEP+1))
10853 CALL HWVDIF(4,PHEP(1,WHEP),PHEP(1,NHEP+1),PHEP(1,NHEP+2))
10854 PHEP(5,NHEP+2)=PDW(5,2)
10858 IDHW(NHEP+I)=IDKPRD(I,IM)
10859 IDHEP(NHEP+I)=IDPDG(IDHW(NHEP+I))
10860 ISTHEP(NHEP+I)=112+I
10861 JDAHEP(I,WHEP)=NHEP+I
10862 JMOHEP(1,NHEP+I)=WHEP
10863 JMOHEP(2,NHEP+I)=NHEP+3-I
10864 JDAHEP(2,NHEP+I)=NHEP+3-I
10867 C---ASSIGN PRODUCTION VERTICES TO 1 AND 2
10868 IF(NME(IM).EQ.100)CALL HWUDKL(198,PW,VHEP(1,NHEP))
10869 IF(NME(IM).EQ.200)CALL HWUDKL(206,PW,VHEP(1,NHEP))
10870 CALL HWVSUM(4,VHEP(1,WHEP),VHEP(1,NHEP),VHEP(1,NHEP))
10871 CALL HWVEQU(4,VHEP(1,NHEP),VHEP(1,NHEP-1))
10872 C---DO PARTON SHOWERS
10874 C--modification to use photos in top decays
10875 IF(ITOPRD.EQ.1) CALL HWPHTP(WHEP)
10876 C--end of modification
10878 IF (IERROR.NE.0) RETURN
10880 C Do parton showers
10883 IF (IERROR.NE.0) RETURN
10884 C--special for gauge boson decay modes of gauginos and four body higgs
10885 C--call routine to add decay products and generate parton shower
10886 IF(NME(IM).GT.20000.AND.NME(IM).LT.30000) THEN
10887 CALL HWDSM3(-1,IHEP,MHEP,SHEP,0,NME(IM)-20000,RHOIN,
10889 ELSEIF(NME(IM).GT.40000.AND.NME(IM).LT.50000) THEN
10890 CALL HWDSM4(2,IHEP,MHEP,SHEP,NME(IM)-40000)
10892 IF (IERROR.NE.0) RETURN
10897 *CMZ :- -17/10/01 10:19:15 by Peter Richardson
10898 *-- Author : Ian Knowles & Bryan Webber
10899 C-----------------------------------------------------------------------
10900 SUBROUTINE HWDHO5(MHEP,LHEP,CLSAVE)
10901 C-----------------------------------------------------------------------
10902 C Subroutine to perform the fifth part of the heavy object decays
10903 C IE sort out RPV colour connections
10904 C was part of HWDHOB
10905 C-----------------------------------------------------------------------
10906 INCLUDE 'herwig65.inc'
10907 INTEGER ID,LHEP,MHEP,IDM,IDM2,THEP,CLSAVE(2)
10908 IF (IERROR.NE.0) RETURN
10909 C--New to correct colour connections in Rslash
10910 IF(CLSAVE(1).NE.0) THEN
10912 ID = IDHW(CLSAVE(1))
10913 IDM = IDHW(JMOHEP(1,CLSAVE(1)))
10915 IF(IDM.EQ.15) ID=IDHW(JMOHEP(1,JMOHEP(1,CLSAVE(1))))
10916 IF((ID.LE.6.AND.((IDM.GE.419.AND.IDM.LE.424).OR.IDM.EQ.411.OR.
10918 & AND.((IDM2.GE.413.AND.IDM2.LE.418)
10919 & .OR.IDM2.EQ.449).OR.IDM2.EQ.405.OR.IDM2.EQ.406)
10920 & .OR.(ID.LE.6.AND.IDM.EQ.449.AND.
10921 & (((IDM2.GE.413.AND.IDM2.LE.418).OR.IDM2.EQ.405.OR.IDM2.EQ.406)
10922 & .OR.IDM2.EQ.449)).OR.
10923 & (IDM.EQ.15.AND.ID.LE.12.AND.ID.GE.7.AND.((IDM2.GE.413.AND.
10924 & IDM2.LE.418).OR.IDM2.EQ.449.OR.IDM2.
10925 & EQ.405.OR.IDM2.EQ.406))) THEN
10926 IF(JMOHEP(2,CLSAVE(1)).EQ.MHEP) THEN
10927 IF(IDHW(CLSAVE(1)).NE.13.AND.IDHW(CLSAVE(1)).NE.449)
10928 & JMOHEP(2,CLSAVE(2)) = THEP
10929 JDAHEP(2,MHEP) = CLSAVE(1)
10930 JDAHEP(2,THEP) = CLSAVE(2)
10932 IF(IDHW(CLSAVE(1)).NE.13.AND.IDHW(CLSAVE(1)).NE.449)
10933 & JMOHEP(2,CLSAVE(2)) = MHEP
10934 JDAHEP(2,MHEP) = CLSAVE(2)
10935 JDAHEP(2,THEP) = CLSAVE(1)
10937 ELSEIF((ID.GT.6.AND.ID.LE.12.
10938 & AND.((IDM.GE.413.AND.IDM.LE.418).OR.IDM.EQ.405.OR.
10940 & ((IDM2.GE.419.AND.IDM2.LE.424).OR.IDM2.EQ.449.OR.
10941 & IDM2.EQ.411.OR.IDM2.EQ.412)).OR.
10942 & (ID.GT.6.AND.ID.LE.12.AND.IDM.EQ.449.
10943 & AND.((IDM2.GE.419.AND.IDM2.LE.424).OR.IDM2.EQ.449.OR.
10944 & IDM2.EQ.411.OR.IDM2.EQ.412)).OR.
10945 & (IDM.EQ.15.AND.ID.LE.6.AND.((IDM2.GE.419.AND.
10946 & IDM2.LE.424).OR.IDM2.EQ.449.OR.IDM2.EQ.411.OR.
10947 & IDM2.EQ.412))) THEN
10948 IF(JDAHEP(2,CLSAVE(1)).EQ.MHEP) THEN
10949 JDAHEP(2,CLSAVE(2))=THEP
10950 JMOHEP(2,MHEP)=CLSAVE(1)
10951 JMOHEP(2,THEP)=CLSAVE(2)
10953 JDAHEP(2,CLSAVE(2))=MHEP
10954 JMOHEP(2,MHEP)=CLSAVE(2)
10955 JMOHEP(2,THEP)=CLSAVE(1)
10963 *CMZ :- -17/10/01 10:19:15 by Peter Richardson
10964 *-- Author : Ian Knowles & Bryan Webber
10965 C-----------------------------------------------------------------------
10967 C-----------------------------------------------------------------------
10968 C Subroutine to perform the final part of the heavy object decays
10969 C IE sort out any colour connection problems
10970 C-----------------------------------------------------------------------
10971 INCLUDE 'herwig65.inc'
10972 INTEGER IHEP,IM,JHEP,ISM,JCM
10973 IF (IERROR.NE.0) RETURN
10974 C Fix any SUSY colour disconnections
10976 IF (ISTHEP(IHEP).GE.147.AND.ISTHEP(IHEP).LE.151
10977 & .AND.JDAHEP(2,IHEP).EQ.0) THEN
10979 C Chase connection back through SUSY decays
10982 IF (ISM.EQ.120) GOTO 80
10983 IF (ISM.NE.123.AND.ISM.NE.124.AND.ISM.NE.155) GOTO 75
10984 C Look for unclustered parton to connect
10986 IF (ISTHEP(JHEP).GE.147.AND.ISTHEP(JHEP).LE.151) THEN
10988 IF (JCM.EQ.IM) THEN
10989 C Found it: connect
10990 JMOHEP(2,JHEP)=IHEP
10991 JDAHEP(2,IHEP)=JHEP
10996 C Not found: need to go further back
11002 *CMZ :- -26/04/91 12.19.24 by Federico Carminati
11003 *-- Author : Ian Knowles & Bryan Webber
11004 C-----------------------------------------------------------------------
11006 C-----------------------------------------------------------------------
11007 C Performs partonic decays of hadrons containing heavy quark(s):
11008 C either, meson/baryon spectator model weak decays;
11009 C or, quarkonia -> 2-gluons, q-qbar, 3-gluons, or 2-gluons + photon.
11010 C-----------------------------------------------------------------------
11011 INCLUDE 'herwig65.inc'
11013 COMMON/SFF/IT1,IB1,IT2,IB2
11014 DOUBLE PRECISION TB,BT
11015 INTEGER IT1,IB1,IT2,IB2
11016 DOUBLE PRECISION GAMHPM
11017 DOUBLE PRECISION HWULDO,HWRGEN,XS,XB,EMWSQ,GMWSQ,EMLIM,PW(4),
11018 & EMTST,X1,X2,X3,TEST,HWDWWT,HWDHWT,HWDPWT
11019 INTEGER IST(3),I,IHEP,IM,ID,IDQ,IQ,IS,J
11020 EXTERNAL HWRGEN,HWDWWT,HWDHWT,HWDPWT,HWULDO
11022 DATA IST/113,114,114/
11023 IF (IERROR.NE.0) RETURN
11025 IF (I.GT.NQDK) THEN
11030 IF (ISTHEP(IHEP).EQ.199) GOTO 100
11032 IF (NHEP+NPRODS(IM).GT.NMXHEP) THEN
11033 CALL HWWARN('HWDHVY',100)
11036 IF (IDKPRD(4,IM).NE.0) THEN
11037 C Weak decay of meson or baryon
11038 C Idenitify decaying heavy quark and spectator
11040 IF (ID.EQ.136.OR.ID.EQ.140.OR.ID.EQ.144.OR.
11041 & ID.EQ.150.OR.ID.EQ.155.OR.ID.EQ.158.OR.ID.EQ.161.OR.
11042 & (ID.EQ.254.AND.IDKPRD(4,IM).EQ.11)) THEN
11043 C c hadron or c decay of B_c+
11047 ELSEIF (ID.EQ.171.OR.ID.EQ.175.OR.ID.EQ.179.OR.
11048 & ID.EQ.185.OR.ID.EQ.190.OR.ID.EQ.194.OR.ID.EQ.196.OR.
11049 & (ID.EQ.230.AND.IDKPRD(4,IM).EQ.5)) THEN
11050 C cbar hadron or cbar decay of B_c-
11054 ELSEIF ((ID.GE.221.AND.ID.LE.229).OR.
11055 & (ID.EQ.230.AND.IDKPRD(4,IM).EQ.10)) THEN
11056 C b hadron or b decay of B_c-
11060 ELSEIF ((ID.GE.245.AND.ID.LE.253).OR.
11061 & (ID.EQ.254.AND.IDKPRD(4,IM).EQ.4)) THEN
11062 C bbar hadron or bbar decay of B_c+
11067 C Decay not recognized
11068 CALL HWWARN('HWDHVY',101)
11071 C Label constituents
11072 IF (NHEP+5.GT.NMXHEP) THEN
11073 CALL HWWARN('HWDHVY',102)
11077 JDAHEP(1,IHEP)=NHEP+1
11078 JDAHEP(2,IHEP)=NHEP+2
11080 IDHW(IS)=IDKPRD(4,IM)
11081 IDHEP(IQ)=IDPDG(IDQ)
11082 IDHEP(IS)=IDPDG(IDKPRD(4,IM))
11087 JDAHEP(1,IQ)=NHEP+3
11088 JDAHEP(2,IQ)=NHEP+5
11090 JMOHEP(2,IS)=NHEP+5
11092 JDAHEP(2,IS)=NHEP+5
11094 C and weak decay product jets
11097 IDHW(NHEP)=IDKPRD(J,IM)
11098 IDHEP(NHEP)=IDPDG(IDKPRD(J,IM))
11099 ISTHEP(NHEP)=IST(J)
11102 10 PHEP(5,NHEP)=RMASS(IDKPRD(J,IM))
11103 JMOHEP(2,NHEP-2)=NHEP-1
11104 JDAHEP(2,NHEP-2)=NHEP-1
11105 JMOHEP(2,NHEP-1)=NHEP-2
11106 JDAHEP(2,NHEP-1)=NHEP-2
11109 C Share momenta in ratio of masses, preserving specator mass
11110 XS=RMASS(IDHW(IS))/PHEP(5,IHEP)
11112 CALL HWVSCA(5,XB,PHEP(1,IHEP),PHEP(1,IQ))
11113 CALL HWVSCA(5,XS,PHEP(1,IHEP),PHEP(1,IS))
11114 IF (NME(IM).EQ.100) THEN
11115 C Generate decay momenta using full (V-A)*(V-A) matrix element
11116 EMWSQ=RMASS(198)**2
11117 GMWSQ=(RMASS(198)*GAMW)**2
11118 EMLIM=GMWSQ+(EMWSQ-(PHEP(5,IQ)-PHEP(5,NHEP))**2)**2
11119 20 CALL HWDTHR(PHEP(1,IQ ),PHEP(1,NHEP-1),
11120 & PHEP(1,NHEP-2),PHEP(1,NHEP),HWDWWT)
11121 CALL HWVSUM(4,PHEP(1,NHEP-2),PHEP(1,NHEP-1),PW)
11122 EMTST=(HWULDO(PW,PW)-EMWSQ)**2
11123 IF ((EMTST+GMWSQ)*HWRGEN(0).GT.EMLIM) GOTO 20
11124 ELSEIF (NME(IM).EQ.200) THEN
11125 C Generate decay momenta using full
11126 C ((V-A)*TB1+(V+A)*CT1)*((V-A)*TB2+(V+A)*CT2)) matrix element
11127 GAMHPM=RMASS(206)/DKLTM(206)
11129 IF((IQ.EQ. 2).OR.(IQ.EQ. 4).OR.
11130 & (IQ.EQ. 6).OR.(IQ.EQ. 8).OR.
11131 & (IQ.EQ. 10).OR.(IQ.EQ. 12).OR.
11132 & (IQ.EQ.122).OR.(IQ.EQ.124).OR.
11133 & (IQ.EQ.126).OR.(IQ.EQ.128).OR.
11134 & (IQ.EQ.130).OR.(IQ.EQ.132))THEN
11139 IF((IDKPRD(1,IM).EQ. 2).OR.(IDKPRD(1,IM).EQ. 4).OR.
11140 & (IDKPRD(1,IM).EQ. 6).OR.(IDKPRD(1,IM).EQ. 8).OR.
11141 & (IDKPRD(1,IM).EQ. 10).OR.(IDKPRD(1,IM).EQ. 12).OR.
11142 & (IDKPRD(1,IM).EQ.122).OR.(IDKPRD(1,IM).EQ.124).OR.
11143 & (IDKPRD(1,IM).EQ.126).OR.(IDKPRD(1,IM).EQ.128).OR.
11144 & (IDKPRD(1,IM).EQ.130).OR.(IDKPRD(1,IM).EQ.132))THEN
11153 EMWSQ=RMASS(206)**2
11154 GMWSQ=(RMASS(206)*GAMHPM)**2
11155 EMLIM=GMWSQ+(EMWSQ-(PHEP(5,IQ)-PHEP(5,NHEP))**2)**2
11156 25 CALL HWDTHR(PHEP(1,IQ ),PHEP(1,NHEP),
11157 & PHEP(1,NHEP-2),PHEP(1,NHEP-1),HWDHWT)
11158 CALL HWVSUM(4,PHEP(1,NHEP-2),PHEP(1,NHEP-1),PW)
11159 EMTST=(HWULDO(PW,PW)-EMWSQ)**2
11160 IF ((EMTST+GMWSQ)*HWRGEN(0).GT.EMLIM) GOTO 25
11163 CALL HWDTHR(PHEP(1,IQ ),PHEP(1,NHEP-2),
11164 & PHEP(1,NHEP-1),PHEP(1,NHEP),HWDPWT)
11165 CALL HWVSUM(4,PHEP(1,NHEP-2),PHEP(1,NHEP-1),PW)
11167 C Set up production vertices
11168 CALL HWVZRO(4,VHEP(1,IQ))
11169 CALL HWVEQU(4,VHEP(1,IQ),VHEP(1,IS))
11170 CALL HWVEQU(4,VHEP(1,IQ),VHEP(1,NHEP))
11171 CALL HWUDKL(198,PW,VHEP(1,NHEP-2))
11172 CALL HWVSUM(4,VHEP(1,IQ),VHEP(1,NHEP-2),VHEP(1,NHEP-2))
11173 CALL HWVEQU(4,VHEP(1,NHEP-2),VHEP(1,NHEP-1))
11179 JDAHEP(1,IHEP)=NHEP+1
11180 DO 30 J=1,NPRODS(IM)
11182 IDHW(NHEP)=IDKPRD(J,IM)
11183 IDHEP(NHEP)=IDPDG(IDKPRD(J,IM))
11184 ISTHEP(NHEP)=IST(J)
11185 JMOHEP(1,NHEP)=IHEP
11187 PHEP(5,NHEP)=RMASS(IDKPRD(J,IM))
11188 30 CALL HWVZRO(4,VHEP(1,NHEP))
11189 JDAHEP(2,IHEP)=NHEP
11190 C Establish colour connections and select momentum configuration
11191 IF (NPRODS(IM).EQ.3) THEN
11192 IF (IDKPRD(3,IM).EQ.13) THEN
11194 JMOHEP(2,NHEP-2)=NHEP
11195 JMOHEP(2,NHEP-1)=NHEP-2
11196 JMOHEP(2,NHEP )=NHEP-1
11197 JDAHEP(2,NHEP-2)=NHEP-1
11198 JDAHEP(2,NHEP-1)=NHEP
11199 JDAHEP(2,NHEP )=NHEP-2
11201 C or 2-gluon + photon decay
11202 JMOHEP(2,NHEP-2)=NHEP-1
11203 JMOHEP(2,NHEP-1)=NHEP-2
11204 JMOHEP(2,NHEP )=NHEP
11205 JDAHEP(2,NHEP-2)=NHEP-1
11206 JDAHEP(2,NHEP-1)=NHEP-2
11207 JDAHEP(2,NHEP )=NHEP
11209 IF (NME(IM).EQ.130) THEN
11210 C Use Ore & Powell orthopositronium matrix element
11211 40 CALL HWDTHR(PHEP(1,IHEP),PHEP(1,NHEP-2),
11212 & PHEP(1,NHEP-1),PHEP(1,NHEP),HWDPWT)
11213 X1=TWO*HWULDO(PHEP(1,IHEP),PHEP(1,NHEP-2))/PHEP(5,IHEP)**2
11214 X2=TWO*HWULDO(PHEP(1,IHEP),PHEP(1,NHEP-1))/PHEP(5,IHEP)**2
11216 TEST=((X1*(ONE-X1))**2+(X2*(ONE-X2))**2+(X3*(ONE-X3))**2)
11218 IF (TEST.LT.TWO*HWRGEN(0)) GOTO 40
11221 CALL HWDTHR(PHEP(1,IHEP),PHEP(1,NHEP-2),
11222 & PHEP(1,NHEP-1),PHEP(1,NHEP),HWDPWT)
11225 C Parapositronium 2-gluon or q-qbar decay
11226 JMOHEP(2,NHEP-1)=NHEP
11227 JMOHEP(2,NHEP )=NHEP-1
11228 JDAHEP(2,NHEP-1)=NHEP
11229 JDAHEP(2,NHEP )=NHEP-1
11230 CALL HWDTWO(PHEP(1,IHEP),PHEP(1,NHEP-1),
11231 & PHEP(1,NHEP),CMMOM(IM),TWO,.FALSE.)
11235 C Process this new hard scatter
11236 CALL HWVEQU(4,VTXQDK(1,I),VTXPIP)
11246 *CMZ :- -20/07/99 10:56:12 by Peter Richardson
11247 *-- Author : Peter Richardson
11248 C-----------------------------------------------------------------------
11249 SUBROUTINE HWDRCL(IHEP,MHEP,CLSAVE)
11250 C-----------------------------------------------------------------------
11251 C Sets the colour connections in Baryon number violating decays
11252 C-----------------------------------------------------------------------
11253 INCLUDE 'herwig65.inc'
11254 INTEGER IHEP,MHEP,ID,ID2,IDM2,IDM3,COLCON(2,2,3),FLACON(2,3),JHEP,
11255 & DECAY,COLANT,KHEP,IDM,IDMB,IDMB2,IDMB3,IDMB4,QHEP,IDM4,
11256 & CLSAVE(2),XHEP,I,HWRINT,THEP
11258 C--Colour connections for the decays
11260 DATA COLCON/-1,1,-1,-2,-2,1,-3,-1,-1,1,-2,-1/
11261 DATA FLACON/1,-1,1,-1,-1,0/
11262 C--identify the decay
11263 IF(IERROR.NE.0) RETURN
11266 IF(ID.GE.450.AND.ID.LE.457) THEN
11268 ELSEIF(ID.EQ.449) THEN
11270 ELSEIF((ID.GE.411.AND.ID.LE.424).OR.ID.EQ.405.OR.ID.EQ.406) THEN
11274 CALL HWWARN('HWDRCL',100)
11278 C--identify the colour partner
11279 IF(DECAY.GT.1.AND.ID2.LE.6) THEN
11282 KHEP = JDAHEP(2,IHEP-1)
11283 ELSEIF(DECAY.GT.1.AND.ID2.GE.7) THEN
11284 C--anticolour partner
11286 KHEP = JMOHEP(2,IHEP)
11290 IDM = IDHW(JMOHEP(1,KHEP))
11291 IF(ABS(IDPDG(IDM)).GT.1000000.OR.IDM.EQ.15) THEN
11292 IDM2 = IDHW(JDAHEP(1,JMOHEP(1,KHEP)))
11293 IDM3 = IDHW(JDAHEP(2,JMOHEP(1,KHEP)))
11294 IDM4 = IDHW(JDAHEP(2,JMOHEP(1,KHEP))-1)
11295 QHEP = JMOHEP(1,KHEP)
11296 IDMB = IDHW(JMOHEP(1,QHEP))
11297 IDMB2 = IDHW(JMOHEP(2,QHEP))
11298 IDMB3 = IDHW(JDAHEP(1,QHEP))
11299 IDMB4 = IDHW(JDAHEP(2,QHEP))
11301 C--Now decide if the colour partner decayed via BV
11302 IF(COLANT.EQ.2.AND.((((IDM.GE.413.AND.IDM.LE.418).OR.
11303 & IDM.EQ.449.OR.IDM.EQ.405.OR.IDM.EQ.406).AND.
11304 & (IDM2.GE.7.AND.IDM2.LE.12.AND.
11305 & IDM3.GE.7.AND.IDM3.LE.12.AND.
11306 & IDM4.GE.7.AND.IDM4.LE.12)).OR.
11307 & (IDM.EQ.15.AND.IDMB.LE.6.AND.IDMB2.LE.6.AND.
11308 & ((IDMB3.GE.7.AND.IDMB4.GE.12.AND.IDMB4.EQ.449).OR.
11309 & (IDMB3.GE.198.AND.IDMB3.LE.207.AND.
11310 & ABS(IDPDG(IDMB4)).GT.1000000))))) THEN
11314 XHEP = JMOHEP(2,JDAHEP(2,JMOHEP(1,KHEP)))
11315 ELSEIF(COLANT.EQ.3.AND.((((IDM.GE.419.AND.IDM.LE.424).OR.
11316 & IDM.EQ.449.OR.IDM.EQ.411.OR.IDM.EQ.412).AND.
11317 & (IDM2.LE.6.AND.IDM3.LE.6.AND.IDM4.LE.6)).OR.
11318 & (IDM.EQ.15.AND.IDMB.GE.7.AND.IDMB.LE.12.AND.
11319 & IDMB2.GE.7.AND.IDMB2.LE.12.AND.((IDMB3.LE.6.AND.
11320 & IDMB4.EQ.449).OR.(ABS(IDPDG(IDMB4)).GT.1000000
11321 & .AND.IDMB3.GE.198.AND.IDMB3.LE.207))))) THEN
11325 XHEP = JDAHEP(2,JDAHEP(2,JMOHEP(1,KHEP)))
11333 CLSAVE(1) = JDAHEP(2,JMOHEP(1,KHEP))-1
11334 CLSAVE(2) = CLSAVE(1)+1
11336 IF(IDMB4.EQ.449) THEN
11338 CLSAVE(I) = JMOHEP(I,JMOHEP(1,KHEP))
11339 IF(CLSAVE(I).EQ.XHEP) CLSAVE(I)=JDAHEP(1,JMOHEP(1,KHEP))
11342 CLSAVE(1) = JMOHEP(1,JMOHEP(1,KHEP))
11343 CLSAVE(2) = JMOHEP(2,JMOHEP(1,KHEP))
11350 C--Now set the colours for angular ordering
11352 IF(DECAY.EQ.1) THEN
11354 JMOHEP(2,THEP) = THEP+HWRINT(1,2)
11355 JDAHEP(2,THEP) = THEP
11357 JMOHEP(2,THEP) = THEP
11358 JDAHEP(2,THEP) = THEP+HWRINT(1,2)
11360 ELSEIF(DECAY.EQ.2) THEN
11362 JMOHEP(2,THEP) = IHEP
11363 JDAHEP(2,THEP) = THEP
11365 JMOHEP(2,THEP) = THEP
11366 JDAHEP(2,THEP) = IHEP
11369 C--Colour of the second two
11372 JMOHEP(2,MHEP+JHEP-1) = MHEP+JHEP-1+
11373 & COLCON(HWRINT(1,2),JHEP,DECAY)
11374 JDAHEP(2,MHEP+JHEP-1) = MHEP+JHEP-1+FLACON(JHEP,DECAY)
11376 JDAHEP(2,MHEP+JHEP-1) = MHEP+JHEP-1+
11377 & COLCON(HWRINT(1,2),JHEP,DECAY)
11378 JMOHEP(2,MHEP+JHEP-1) = MHEP+JHEP-1+FLACON(JHEP,DECAY)
11381 C--Now set the colours of the colour partner
11382 IF(DECAY.GT.1.AND..NOT.CONBV) THEN
11383 IF(ID2.LE.6) JMOHEP(2,KHEP) = MHEP+HWRINT(0,1)
11384 IF(ID2.GE.7) JDAHEP(2,KHEP) = MHEP+HWRINT(0,1)
11387 JMOHEP(2,CLSAVE(1)) = MHEP+HWRINT(0,1)
11388 IF(JMOHEP(2,CLSAVE(1)).EQ.MHEP) THEN
11389 JMOHEP(2,CLSAVE(2)) = MHEP+1
11391 JMOHEP(2,CLSAVE(2)) = MHEP
11394 JDAHEP(2,CLSAVE(1)) = MHEP+HWRINT(0,1)
11395 IF(JDAHEP(2,CLSAVE(1)).EQ.MHEP) THEN
11396 JDAHEP(2,CLSAVE(2)) = MHEP+1
11398 JDAHEP(2,CLSAVE(2)) = MHEP
11405 *CMZ :- -20/07/99 10:56:12 by Peter Richardson
11406 *-- Author : Peter Richardson
11407 C-----------------------------------------------------------------------
11408 SUBROUTINE HWDRME(LHEP,MHEP)
11409 C-----------------------------------------------------------------------
11410 C SUBROUTINE TO IMPLEMENT ALL RPARITY DECAY MATRIX ELEMENTS
11411 C-----------------------------------------------------------------------
11412 INCLUDE 'herwig65.inc'
11413 DOUBLE PRECISION SM(6),SW(6),HWULDO,INFCOL,AM, M12SQ,M23SQ,MSGN,
11414 & M13SQ,A(6),B(6),SWEAK,MW,DECMOM(5),TEST(3),EPS,
11415 & M12SQT(6),M23SQT(6),M13SQT(6),LIMIT,M(4),RAND,
11416 & MC(2),MX2(6),MX(6),HWDPWT,HWRGEN,HWDRM1,LAMD(3),
11418 EXTERNAL HWDRM1,HWULDO,HWDPWT,HWRGEN
11419 INTEGER K,SN(3),LHEP,CSP,I,SB(3),J,ND,LTRY,MHEP,NSP,ID(3),IG,
11420 & IDHWTP,IDHPTP,MTRY
11421 PARAMETER(EPS=1D-20)
11422 IF(IERROR.NE.0) RETURN
11423 C--Electroweak parameters, etc
11424 SWEAK = SQRT(SWEIN)
11426 M(4) = PHEP(5,LHEP)
11428 C--Find the masses of the final state and zero parameters
11430 ID(K) = IDHW(MHEP+K-1)
11431 IF(ID(K).LE.12) THEN
11436 IF(SN(K).GT.6) SN(K)=SN(K)-6
11437 M(K) = PHEP(5,LHEP+K)
11448 C--Evaluate the coefficents for the mode we want
11449 IF(IG.GE.450.AND.IG.LE.453) THEN
11454 MC(1) = ZMIXSS(NSP,3)/(2*MW*COSB*SWEAK)
11455 MC(2) = ZMIXSS(NSP,4)/(2*MW*SINB*SWEAK)
11456 C--Calculate the combinations of couplings needed
11457 IF(ID(1).LE.12.AND.ID(2).LE.12.AND.ID(3).LE.12) THEN
11458 C--first for the UDD modes
11460 A(J) = M(1)*MC(2)*QMIXSS(SN(1),2,J)
11461 & +SLFCH(SN(1),NSP)*QMIXSS(SN(1),1,J)
11462 B(J) = MSGN*(M(1)*MC(2)*QMIXSS(SN(1),1,J)
11463 & +SRFCH(SN(1),NSP)*QMIXSS(SN(1),2,J))
11464 MX2(J) = QMIXSS(SN(1),2,J)
11465 A(J+2) = M(2)*MC(1)*QMIXSS(SN(2),2,J)
11466 & +SLFCH(SN(2),NSP)*QMIXSS(SN(2),1,J)
11467 B(J+2) = MSGN*(M(2)*MC(1)*QMIXSS(SN(2),1,J)
11468 & +SRFCH(SN(2),NSP)*QMIXSS(SN(2),2,J))
11469 MX2(J+2) = QMIXSS(SN(2),2,J)
11470 A(J+4) = M(3)*MC(1)*QMIXSS(SN(3),2,J)
11471 & +SLFCH(SN(3),NSP)*QMIXSS(SN(3),1,J)
11472 B(J+4) = MSGN*(M(3)*MC(1)*QMIXSS(SN(3),1,J)
11473 & +SRFCH(SN(3),NSP)*QMIXSS(SN(3),2,J))
11474 MX2(J+2) = QMIXSS(SN(3),2,J)
11480 ELSEIF(ID(1).GE.121.AND.ID(2).GE.121.AND.ID(3).GE.121) THEN
11481 C--Now for the LLE modes
11483 A(J) = MSGN*(M(1)*MC(1)*LMIXSS(SN(1),1,J)
11484 & +SRFCH(10+SN(1),NSP)*LMIXSS(SN(1),2,J))
11485 B(J) = M(1)*MC(1)*LMIXSS(SN(1),2,J)
11486 & +SLFCH(10+SN(1),NSP)*LMIXSS(SN(2),1,J)
11487 MX2(J)= LMIXSS(SN(1),1,J)
11489 B(J+2) = SLFCH(10+SN(2),NSP)*LMIXSS(SN(2),1,J)
11490 MX2(J+2) = LMIXSS(SN(2),1,J)
11491 A(J+4) = M(3)*MC(1)*LMIXSS(SN(3),2,J)
11492 & +SLFCH(10+SN(3),NSP)*LMIXSS(SN(3),1,J)
11493 B(J+4) = MSGN*(M(3)*MC(1)*LMIXSS(SN(3),1,J)
11494 & +SRFCH(10+SN(3),NSP)*LMIXSS(SN(3),2,J))
11495 MX2(4+J) = LMIXSS(SN(3),2,J)
11498 SN(J) = SN(J) + 424
11499 SB(J) = SB(J) + 436
11502 C--Now for both types of LQD modes
11503 IF(MOD(SN(1),2).EQ.0) THEN
11504 C--First the neutrino,down,antidown mode
11507 B(J) = SLFCH(10+SN(1),NSP)*
11508 & LMIXSS(SN(1),1,J)
11509 MX2(J) = LMIXSS(SN(1),1,J)
11510 A(J+2) = MSGN*(M(2)*MC(1)*QMIXSS(SN(2),1,J)
11511 & +SRFCH(SN(2),NSP)*QMIXSS(SN(2),2,J))
11512 B(J+2) = M(2)*MC(1)*QMIXSS(SN(2),2,J)
11513 & +SLFCH(SN(2),NSP)*QMIXSS(SN(2),1,J)
11514 MX2(2+J) = QMIXSS(SN(2),1,J)
11515 A(J+4) = M(3)*MC(1)*QMIXSS(SN(3),2,J)
11516 & +SLFCH(SN(3),NSP)*QMIXSS(SN(3),1,J)
11517 B(J+4) = MSGN*(M(3)*MC(1)*QMIXSS(SN(3),1,J)
11518 & +SRFCH(SN(3),NSP)*QMIXSS(SN(3),2,J))
11519 MX2(J+4) = QMIXSS(SN(3),2,J)
11522 C--Now the charged lepton, antiup,down modes
11524 A(J) = MSGN*(M(1)*MC(1)*LMIXSS(SN(1),1,J)
11525 & +SRFCH(10+SN(1),NSP)*LMIXSS(SN(1),2,J))
11526 B(J) = M(1)*MC(1)*LMIXSS(SN(1),2,J)
11527 & +SLFCH(10+SN(1),NSP)*LMIXSS(SN(1),1,J)
11528 MX2(J) = LMIXSS(SN(1),1,J)
11529 A(J+2) =MSGN*(M(2)*MC(2)*QMIXSS(SN(2),1,J)
11530 & +SRFCH(SN(2),NSP)*QMIXSS(SN(2),2,J))
11531 B(J+2) = M(2)*MC(2)*QMIXSS(SN(2),2,J)
11532 & +SLFCH(SN(2),NSP)*QMIXSS(SN(2),1,J)
11533 MX2(2+J) = QMIXSS(SN(2),1,J)
11534 A(J+4) = M(3)*MC(1)*QMIXSS(SN(3),2,J)
11535 & +SLFCH(SN(3),NSP)*QMIXSS(SN(3),1,J)
11536 B(J+4) = MSGN*(M(3)*MC(1)*QMIXSS(SN(3),1,J)
11537 & +SRFCH(SN(3),NSP)*QMIXSS(SN(3),2,J))
11538 MX2(J+4) = QMIXSS(SN(3),2,J)
11541 SN(1) = SN(1) + 424
11542 SB(1) = SB(1) + 436
11544 SN(J) = SN(J) + 400
11545 SB(J) = SB(J) + 412
11549 SM(2*K-1) = RMASS(SN(K))
11550 SM(2*K) = RMASS(SB(K))
11551 SW(2*K-1) = HBAR/RLTIM(SN(K))
11552 SW(2*K) = HBAR/RLTIM(SB(K))
11559 ELSEIF(IG.EQ.449) THEN
11561 C--First obtian the masses and widths needed
11564 C--Calculate the combinations of couplings needed
11565 IF(ID(1).LE.12.AND.ID(2).LE.12.AND.ID(3).LE.12) THEN
11566 C--first for the UDD modes
11571 A(2*I-2+J) = -QMIXSS(SN(I),1,J)
11572 B(2*I-2+J) = QMIXSS(SN(I),2,J)
11573 MX2(2*I-2+J) = QMIXSS(SN(I),2,J)
11580 C--Now for both types of LQD modes
11581 IF(MOD(SN(1),2).EQ.0) THEN
11582 C--First the neutrino,down,antidown mode
11587 A(J+2) = QMIXSS(SN(2),2,J)
11588 B(J+2) = -QMIXSS(SN(2),1,J)
11589 MX2(J+2) = QMIXSS(SN(2),1,J)
11590 A(J+4) = -QMIXSS(SN(3),1,J)
11591 B(J+4) = QMIXSS(SN(3),2,J)
11592 MX2(4+J) = QMIXSS(SN(3),2,J)
11594 ELSEIF(MOD(SN(1),2).EQ.1) THEN
11595 C--Now the charged lepton, antiup,down modes
11600 A(J+2) = QMIXSS(SN(2),2,J)
11601 B(J+2) = -QMIXSS(SN(2),1,J)
11602 MX2(J+2) = QMIXSS(SN(2),1,J)
11603 A(J+4) = -QMIXSS(SN(3),1,J)
11604 B(J+4) = QMIXSS(SN(3),2,J)
11605 MX2(J+4) = QMIXSS(SN(3),2,J)
11608 SN(1) = SN(1) + 424
11609 SB(1) = SB(1) + 436
11611 SN(K) = SN(K) + 400
11612 SB(K) = SB(K) + 412
11616 SM(2*K-1) = RMASS(SN(K))
11617 SM(2*K) = RMASS(SB(K))
11618 SW(2*K-1) = HBAR/RLTIM(SN(K))
11619 SW(2*K) = HBAR/RLTIM(SB(K))
11624 ELSEIF(IG.GE.454.AND.IG.LE.457) THEN
11627 IF(CSP.GT.2) CSP = CSP-2
11631 MC(1) = ONE/(SQRT(2.0D0)*MW*COSB)
11632 MC(2) = ONE/(SQRT(2.0D0)*MW*SINB)
11633 C--Calculate the combinations of the couplings needed
11634 IF(ID(1).GT.120.AND.ID(2).GT.120.AND.ID(3).GT.120) THEN
11635 C--first for the LLE modes, three modes
11636 IF(MOD(SN(1),2).EQ.0.AND.MOD(SN(3),2).EQ.0) THEN
11637 C--the one diagram mode nubar,positron, nu
11639 A(J+4) = LMIXSS(SN(3)-1,1,J)*WMXUSS(CSP,1)
11640 & -RMASS(SN(3)+119)*MC(1)*LMIXSS(SN(3)-1,2,J)*WMXUSS(CSP,2)
11642 MX2(J+4) = LMIXSS(SN(3)-1,2,J)
11647 ELSEIF(MOD(SN(1),2).EQ.0.AND.MOD(SN(2),2).EQ.0) THEN
11648 C--the first two diagram mode nu, nu, positron
11651 B(J) = LMIXSS(SN(1)-1,1,J)*WMXUSS(CSP,1)
11652 & -RMASS(SN(1)+119)*MC(1)*LMIXSS(SN(1)-1,2,J)*WMXUSS(CSP,2)
11654 B(J+2) = LMIXSS(SN(2)-1,1,J)*WMXUSS(CSP,1)
11655 & -RMASS(SN(2)+119)*MC(1)*LMIXSS(SN(2)-1,2,J)*WMXUSS(CSP,2)
11656 MX2(J) = LMIXSS(SN(1)-1,1,J)
11657 MX2(J+2) = LMIXSS(SN(2)-1,1,J)
11665 C--the second two diagram mode positron, positron, electron
11667 A(J) = -M(1)*WMXUSS(CSP,2)*MC(1)*LMIXSS(SN(1)+1,1,J)
11668 B(J) = MSGN*WMXVSS(CSP,1)*LMIXSS(SN(1)+1,1,J)
11669 A(J+2) = -M(2)*WMXUSS(CSP,2)*MC(1)*LMIXSS(SN(2)+1,1,J)
11670 B(J+2) = MSGN*WMXVSS(CSP,1)*LMIXSS(SN(2)+1,1,J)
11671 MX2(J) = LMIXSS(SN(1)+1,1,J)
11672 MX2(J+2) = LMIXSS(SN(2)+1,1,J)
11683 ELSEIF(ID(1).LE.12.AND.ID(2).LE.12.AND.ID(3).LE.12) THEN
11685 IF(MOD(SN(1),2).EQ.0) THEN
11686 C--two diagram mode
11687 LAMD(1) = LAMDA3(SN(2)/2,SN(1)/2,(SN(3)+1)/2)
11688 LAMD(2) = LAMDA3(SN(1)/2,SN(2)/2,(SN(3)+1)/2)
11690 A(J) = WMXUSS(CSP,1)*QMIXSS(SN(1)-1,1,J)
11691 & -RMASS(SN(1)-1)*MC(1)*WMXUSS(CSP,2)*QMIXSS(SN(1)-1,2,J)
11692 B(J) = -MSGN*M(2)*WMXVSS(CSP,2)*QMIXSS(SN(1)-1,1,J)
11693 A(J+2) = WMXUSS(CSP,1)*QMIXSS(SN(2)-1,1,J)
11694 & -RMASS(SN(2)-1)*MC(1)*WMXUSS(CSP,2)*QMIXSS(SN(2)-1,2,J)
11695 B(J+2) = -MSGN*M(2)*WMXVSS(CSP,2)*QMIXSS(SN(2)-1,1,J)
11696 MX2(J) = QMIXSS(SN(1)-1,2,J)
11697 MX2(J+2) = QMIXSS(SN(2)-1,2,J)
11700 SN(J) = SN(J) + 399
11701 SB(J) = SB(J) + 411
11705 C--three diagram mode
11706 LAMD(1) = LAMDA3((SN(1)+1)/2,(SN(2)+1)/2,(SN(3)+1)/2)
11707 LAMD(2) = LAMDA3((SN(2)+1)/2,(SN(1)+1)/2,(SN(3)+1)/2)
11708 LAMD(3) = LAMDA3((SN(3)+1)/2,(SN(2)+1)/2,(SN(1)+1)/2)
11711 A(J+2*I-2) = MSGN*(WMXVSS(CSP,1)*QMIXSS(SN(I)+1,1,J)
11712 & -RMASS(SN(I)+1)*MC(2)*WMXVSS(CSP,2)*QMIXSS(SN(I)+1,2,J))
11713 B(J+2*I-2) = -M(I)*MC(1)*WMXUSS(CSP,2)
11714 & *QMIXSS(SN(I)+1,1,J)
11715 MX2(J+2*I-2) = QMIXSS(SN(I)+1,2,J)
11717 SN(I) = SN(I) + 401
11718 SB(I) = SB(I) + 413
11723 C--now for the LQD modes
11724 IF(MOD(SN(2),2).EQ.1.AND.MOD(SN(3),2).EQ.0) THEN
11725 C--first one diagram mode nubar, dbar, up
11727 A(J+4) = -MSGN*M(3)*WMXVSS(CSP,2)*MC(2)*
11728 & QMIXSS(SN(3)-1,1,J)
11729 B(J+4) = WMXUSS(CSP,1)*QMIXSS(SN(3)-1,1,J)
11730 & -RMASS(SN(3)-1)*MC(1)*WMXUSS(CSP,2)*QMIXSS(SN(3)-1,2,1)
11731 MX2(J+4) = QMIXSS(SN(3)-1,2,J)
11733 SN(3) = SN(3) + 399
11734 SB(3) = SB(3) + 411
11736 ELSEIF(MOD(SN(2),2).EQ.0.AND.MOD(SN(3),2).EQ.0) THEN
11737 C--second one diagram mode positron, ubar, up
11739 A(J+4) = -MSGN*M(3)*WMXVSS(CSP,2)*MC(2)*
11740 & QMIXSS(SN(3)-1,1,J)
11741 B(J+4) = WMXUSS(CSP,1)*QMIXSS(SN(3)-1,1,J)
11742 & -RMASS(SN(3)-1)*MC(1)*WMXUSS(CSP,2)*QMIXSS(SN(3)-1,2,1)
11743 MX2(J+4) = QMIXSS(SN(3)-1,2,J)
11745 SN(3) = SN(3) + 399
11746 SB(3) = SB(3) + 411
11748 ELSEIF(MOD(SN(2),2).EQ.1.AND.MOD(SN(3),2).EQ.1) THEN
11749 C--first two diagram mode positron, dbar, down
11751 A(J) = -M(1)*MC(1)*WMXUSS(CSP,2)*LMIXSS(SN(1)+1,1,J)
11752 B(J) = MSGN*WMXVSS(CSP,1)*LMIXSS(SN(2)+1,1,J)
11753 A(J+2) = -M(2)*WMXUSS(CSP,2)*MC(1)*QMIXSS(SN(2)+1,1,J)
11754 B(J+2) = MSGN*(WMXVSS(CSP,1)*QMIXSS(SN(2)+1,1,J)
11755 & -RMASS(SN(2)+1)*MC(2)*WMXVSS(CSP,2)*QMIXSS(SN(2)+1,2,J))
11756 MX2(J) = LMIXSS(SN(1)+1,1,J)
11757 MX2(J+2) = QMIXSS(SN(2)+1,1,J)
11759 SN(1) = SN(1) + 425
11760 SB(1) = SB(1) + 437
11761 SN(2) = SN(2) + 401
11762 SB(2) = SB(2) + 413
11765 C--second two diagram mode nu, up, dbar
11768 B(J) = WMXUSS(CSP,1)*LMIXSS(SN(1)-1,1,J)
11769 & -RMASS(119+SN(1))*MC(1)*WMXUSS(CSP,2)*LMIXSS(SN(1)-1,2,J)
11770 A(J+2) = -MSGN*M(2)*MC(2)*WMXVSS(CSP,2)*
11771 & QMIXSS(SN(2)-1,1,J)
11772 B(J+2) = WMXUSS(CSP,1)*QMIXSS(SN(2)-1,1,J)
11773 & -RMASS(SN(2)-1)*MC(1)*WMXUSS(CSP,2)*QMIXSS(SN(2)-1,2,J)
11774 MX2(J) = LMIXSS(SN(1)-1,1,J)
11775 MX2(J+2) = QMIXSS(SN(2)-1,1,J)
11777 SN(1) = SN(1) + 423
11778 SB(1) = SB(1) + 435
11779 SN(2) = SN(2) + 399
11780 SB(2) = SB(2) + 411
11794 SM(5) = RMASS(SN(3))
11795 SM(6) = RMASS(SB(3))
11796 SW(5) = HBAR/RLTIM(SN(3))
11797 SW(6) = HBAR/RLTIM(SB(3))
11800 SM(2*K-1) = RMASS(SN(K))
11801 SM(2*K) = RMASS(SB(K))
11802 SW(2*K-1) = HBAR/RLTIM(SN(K))
11803 SW(2*K) = HBAR/RLTIM(SB(K))
11810 CALL HWWARN('HWDRME',500)
11812 C--Set mixing to zero if diagram not available
11813 IF((AM.LT.(ABS(SM(1))+M(1)).OR.ABS(SM(1)).LT.(M(2)+M(3)))
11814 & .AND.ABS(MX2(1)).GT.ZERO.AND.ND.NE.1) MX(1) = MX2(1)*LAMD(1)
11815 IF((AM.LT.(ABS(SM(2))+M(1)).OR.ABS(SM(2)).LT.(M(2)+M(3)))
11816 & .AND.ABS(MX2(2)).GT.ZERO.AND.ND.NE.1) MX(2) = MX2(2)*LAMD(1)
11817 IF((AM.LT.(ABS(SM(3))+M(2)).OR.ABS(SM(3)).LT.(M(1)+M(3)))
11818 & .AND.ABS(MX2(3)).GT.ZERO.AND.ND.NE.1) MX(3) = MX2(3)*LAMD(2)
11819 IF((AM.LT.(ABS(SM(4))+M(2)).OR.ABS(SM(4)).LT.(M(1)+M(3)))
11820 & .AND.ABS(MX2(4)).GT.ZERO.AND.ND.NE.1) MX(4) = MX2(4)*LAMD(2)
11821 IF((AM.LT.(ABS(SM(5))+M(3)).OR.ABS(SM(5)).LT.(M(1)+M(2)))
11822 & .AND.ABS(MX2(5)).GT.ZERO.AND.ND.NE.2) MX(5) = MX2(5)*LAMD(3)
11823 IF((AM.LT.(ABS(SM(6))+M(3)).OR.ABS(SM(6)).LT.(M(1)+M(2)))
11824 & .AND.ABS(MX2(6)).GT.ZERO.AND.ND.NE.2) MX(6) = MX2(6)*LAMD(3)
11825 C--Calculate the limiting points
11828 IF(ABS(MX(J)).GT.EPS) CALL HWDRM5(M23SQT(J),M13SQT(J),
11829 & M12SQT(J),A(J),B(J),M(2),M(3),M(1),M(4),SM(J),SW(J))
11830 IF(ABS(MX(J+2)).GT.EPS) CALL HWDRM5(M13SQT(2+J),M23SQT(2+J),
11831 & M12SQT(2+J),A(2+J),B(2+J),M(1),M(3),M(2),M(4),SM(2+J),SW(2+J))
11834 IF(ABS(MX(J+4)).GT.EPS) CALL HWDRM5(M12SQT(4+J),M23SQT(4+J),
11835 & M13SQT(4+J),A(4+J),B(4+J),M(1),M(2),M(3),M(4),SM(4+J),SW(4+J))
11838 C--Now evaluate the limit using these points
11841 IF(ABS(MX(I)).LT.EPS) GOTO 100
11842 LIMIT = LIMIT+HWDRM1(TEST,M12SQT(I),M13SQT(I),M23SQT(I),A,B,MX,
11843 & M,SM,SW,INFCOL,AM,0,ND)
11846 C--Now evaluate at a random point
11851 CALL HWDTHR(PHEP(1,LHEP),PHEP(1,MHEP),
11852 & PHEP(1,MHEP+1),PHEP(1,MHEP+2),HWDPWT)
11853 C--Now calculate the m12sq etc for the actual point
11854 M12SQ = M(1)**2+M(2)**2+2*HWULDO(PHEP(1,MHEP),PHEP(1,MHEP+1))
11855 M13SQ = M(1)**2+M(3)**2+2*HWULDO(PHEP(1,MHEP),PHEP(1,MHEP+2))
11856 M23SQ = M(2)**2+M(3)**2+2*HWULDO(PHEP(1,MHEP+1),PHEP(1,MHEP+2))
11857 C--Now calulate the matrix element
11858 TEST2 = HWDRM1(TEST,M12SQ,M13SQ,M23SQ,A,B,MX,
11859 & M,SM,SW,INFCOL,AM,1,ND)
11860 C--Now test the value againest the limit
11861 RAND = HWRGEN(0)*LIMIT
11862 IF(TEST2.GT.LIMIT) THEN
11863 LIMIT = 1.1D0*TEST2
11864 CALL HWWARN('HWDRME',51)
11867 150 IF(TEST2.LT.RAND.AND.LTRY.LT.NETRY) THEN
11869 ELSEIF(LTRY.GE.NETRY) THEN
11870 IF(MTRY.LE.NETRY) THEN
11871 LIMIT = LIMIT*0.9D0
11872 CALL HWWARN('HWDRME',52)
11875 CALL HWWARN('HWDRME',100)
11879 C--Reorder the particles in gluino decay to get angular ordering right
11880 IF(IG.EQ.449.AND.ID(1).LE.12.AND.ID(2).LE.12.AND.ID(3).LE.12) THEN
11882 IF(TEST(LTRY).GT.RAND) THEN
11884 IDHWTP = IDHW(MHEP)
11885 IDHW(MHEP) = IDHW(MHEP+1)
11886 IDHW(MHEP+1) = IDHWTP
11887 IDHPTP = IDHEP(MHEP)
11888 IDHEP(MHEP) = IDHEP(MHEP+1)
11889 IDHEP(MHEP+1) = IDHPTP
11890 CALL HWVEQU(5,PHEP(1,MHEP),DECMOM)
11891 CALL HWVEQU(5,PHEP(1,MHEP+1),PHEP(1,MHEP))
11892 CALL HWVEQU(5,DECMOM,PHEP(1,MHEP+1))
11893 ELSEIF(LTRY.EQ.3) THEN
11894 IDHWTP = IDHW(MHEP)
11895 IDHW(MHEP) = IDHW(MHEP+2)
11896 IDHW(MHEP+2) = IDHWTP
11897 IDHPTP = IDHEP(MHEP)
11898 IDHEP(MHEP) = IDHEP(MHEP+2)
11899 IDHEP(MHEP+2) = IDHPTP
11901 CALL HWVEQU(5,PHEP(1,MHEP),DECMOM)
11902 CALL HWVEQU(5,PHEP(1,MHEP+2),PHEP(1,MHEP))
11903 CALL HWVEQU(5,DECMOM,PHEP(1,MHEP+2))
11908 RAND=RAND-TEST(LTRY)
11915 *CMZ :- -20/07/99 10:56:12 by Peter Richardson
11916 *-- Author : Peter Richardson
11917 C-----------------------------------------------------------------------
11918 FUNCTION HWDRM1(TEST,M12SQ,M13SQ,M23SQ,A,B,MX,M,SM,SW
11919 & ,INFCOL,AM,LM,ND)
11920 C-----------------------------------------------------------------------
11921 C FUNCTION TO GIVE THE R-PARITY VIOLATING MATRIX ELEMENT AT A GIVEN
11922 C PHASE-SPACE POINT
11923 C-----------------------------------------------------------------------
11925 DOUBLE PRECISION M12SQ,M13SQ,M23SQ,MX(6),A(6),B(6),SM(6),SW(6),
11926 & INFCOL,AM,TERM(21),TEST(3),PLN,NPLN,ZERO,
11927 & M(4),HWDRM1,HWDRM2,HWDRM3,HWDRM4
11929 EXTERNAL HWDRM2,HWDRM3,HWDRM4
11937 IF(ABS(MX(1)).GT.ZERO.AND.ND.NE.1) THEN
11938 TERM(1) = MX(1)**2*HWDRM2(M23SQ,M(2),M(3),M(1),M(4),SM(1),
11940 IF(ABS(MX(2)).GT.ZERO) TERM(7)= MX(1)*MX(2)*HWDRM3(M23SQ,M(2),
11941 & M(3),M(1),M(4),SM(1),SM(2),SW(1),SW(2),A(1),A(2),B(1),B(2))
11942 IF(ABS(MX(3)).GT.ZERO) TERM(10)=-MX(1)*MX(3)*HWDRM4(M13SQ,M23SQ,
11943 & M(1),M(3),M(2),M(4),SM(3),SM(1),SW(3),SW(1),A(1),A(3),B(1),B(3))
11944 IF(ABS(MX(4)).GT.ZERO) TERM(11)=-MX(1)*MX(4)*HWDRM4(M13SQ,M23SQ,
11945 & M(1),M(3),M(2),M(4),SM(4),SM(1),SW(4),SW(1),A(1),A(4),B(1),B(4))
11946 IF(ABS(MX(5)).GT.ZERO) TERM(12)=-MX(1)*MX(5)*HWDRM4(M23SQ,M12SQ,
11947 & M(3),M(2),M(1),M(4),SM(1),SM(5),SW(1),SW(5),A(5),A(1),B(5),B(1))
11948 IF(ABS(MX(6)).GT.ZERO) TERM(13)=-MX(1)*MX(6)*HWDRM4(M23SQ,M12SQ,
11949 & M(3),M(2),M(1),M(4),SM(1),SM(6),SW(1),SW(6),A(6),A(1),B(6),B(1))
11951 IF(ABS(MX(2)).GT.ZERO.AND.ND.NE.1) THEN
11952 TERM(2) = MX(2)**2*HWDRM2(M23SQ,M(2),M(3),M(1),M(4),SM(2),
11954 IF(ABS(MX(3)).GT.ZERO) TERM(14)=-MX(2)*MX(3)*HWDRM4(M13SQ,M23SQ,
11955 & M(1),M(3),M(2),M(4),SM(3),SM(2),SW(3),SW(2),A(2),A(3),B(2),B(3))
11956 IF(ABS(MX(4)).GT.ZERO) TERM(15)=-MX(2)*MX(4)*HWDRM4(M13SQ,M23SQ,
11957 & M(1),M(3),M(2),M(4),SM(4),SM(2),SW(4),SW(2),A(2),A(4),B(2),B(4))
11958 IF(ABS(MX(5)).GT.ZERO) TERM(16)=-MX(2)*MX(5)*HWDRM4(M23SQ,M12SQ,
11959 & M(3),M(2),M(1),M(4),SM(2),SM(5),SW(2),SW(5),A(5),A(2),B(5),B(2))
11960 IF(ABS(MX(6)).GT.ZERO) TERM(17)=-MX(2)*MX(6)*HWDRM4(M23SQ,M12SQ,
11961 & M(3),M(2),M(1),M(4),SM(2),SM(6),SW(2),SW(6),A(6),A(2),B(6),B(2))
11963 IF(ABS(MX(3)).GT.ZERO.AND.ND.NE.1) THEN
11964 TERM(3) = MX(3)**2*HWDRM2(M13SQ,M(1),M(3),M(2),M(4),SM(3),
11966 IF(ABS(MX(4)).GT.ZERO) TERM(8)= MX(3)*MX(4)*HWDRM3(M13SQ,M(1),
11967 & M(3),M(2),M(4),SM(3),SM(4),SW(3),SW(4),A(3),A(4),B(3),B(4))
11968 IF(ABS(MX(5)).GT.ZERO) TERM(18)=-MX(3)*MX(5)*HWDRM4(M12SQ,M13SQ,
11969 & M(2),M(1),M(3),M(4),SM(5),SM(3),SW(5),SW(3),A(3),A(5),B(3),B(5))
11970 IF(ABS(MX(6)).GT.ZERO) TERM(19)=-MX(3)*MX(6)*HWDRM4(M12SQ,M13SQ,
11971 & M(2),M(1),M(3),M(4),SM(6),SM(3),SW(6),SW(3),A(3),A(6),B(3),B(6))
11973 IF(ABS(MX(4)).GT.ZERO.AND.ND.NE.1) THEN
11974 TERM(4) = MX(4)**2*HWDRM2(M13SQ,M(1),M(3),M(2),M(4),SM(4),
11976 IF(ABS(MX(5)).GT.ZERO) TERM(20)=-MX(4)*MX(5)*HWDRM4(M12SQ,M13SQ,
11977 & M(2),M(1),M(3),M(4),SM(5),SM(4),SW(5),SW(4),A(4),A(5),B(4),B(5))
11978 IF(ABS(MX(6)).GT.ZERO) TERM(21)=-MX(4)*MX(6)*HWDRM4(M12SQ,M13SQ,
11979 & M(2),M(1),M(3),M(4),SM(6),SM(4),SW(6),SW(4),A(4),A(6),B(4),B(6))
11981 IF(ABS(MX(5)).GT.ZERO.AND.ND.NE.2) THEN
11982 TERM(5) = MX(5)**2*HWDRM2(M12SQ,M(1),M(2),M(3),M(4),SM(5),
11984 IF(ABS(MX(6)).GT.ZERO) TERM(9)= MX(5)*MX(6)*HWDRM3(M12SQ,M(1),
11985 & M(2),M(3),M(4),SM(5),SM(6),SW(5),SW(6),A(5),A(6),B(5),B(6))
11987 IF(ABS(MX(6)).GT.ZERO.AND.ND.NE.2) TERM(6) = MX(6)**2*
11988 & HWDRM2(M12SQ,M(1),M(2),M(3),M(4),SM(6),SW(6),A(6),B(6))
11990 TERM(K)=TERM(K)*INFCOL
11994 HWDRM1 = HWDRM1+TERM(K)
11996 C--Different colour flows for the gluino
12007 TEST(K) = (TERM(2*K-1)+TERM(2*K)+TERM(6+K))*(1+NPLN/PLN)
12014 IF(HWDRM1.LT.ZERO) CALL HWWARN('HWDRM1',50)
12017 *CMZ :- -20/07/99 10:56:12 by Peter Richardson
12018 *-- Author : Peter Richardson
12019 C-----------------------------------------------------------------------
12020 FUNCTION HWDRM2(X,MA,MB,MC,MD,MR1,GAM1,A,B)
12021 C-----------------------------------------------------------------------
12022 C Function to compute the matrix element squared part of a 3-body
12024 C-----------------------------------------------------------------------
12026 DOUBLE PRECISION X,MA,MB,MC,MD,A,B,HWDRM2,MR1,GAM1
12027 HWDRM2 = (X - MA**2 - MB**2)*(4*A*B*MC*MD +
12028 & (A**2 + B**2)*(-X + MC**2 + MD**2))/
12029 & ((X-MR1**2)**2+GAM1**2*MR1**2)
12032 *CMZ :- -20/07/99 10:56:12 by Peter Richardson
12033 *-- Author : Peter Richardson
12034 C-----------------------------------------------------------------------
12035 FUNCTION HWDRM3(X,MA,MB,MC,MD,MR1,MR2,GAM1,GAM2,A1,A2,B1,B2)
12036 C-----------------------------------------------------------------------
12037 C Function to compute the light/heavy interference part of a 3-body
12039 C-----------------------------------------------------------------------
12041 DOUBLE PRECISION X,MA,MB,MC,MD,A1,A2,B1,B2,HWDRM3,MR1,MR2,GAM1
12044 HWDRM3 = 2*(X - MA**2 - MB**2)*(2*(A2*B1 + A1*B2)*MC*MD +
12045 & (A1*A2 + B1*B2)*(-X + MC**2 + MD**2))*
12046 & (GAM1*GAM2*MR1*MR2 + (X - MR1**2)*(X - MR2**2))/
12047 & (((X-MR1**2)**2+GAM1**2*MR1**2)*((X-MR2**2)**2+GAM2**2*MR2**2))
12050 *CMZ :- -20/07/99 10:56:12 by Peter Richardson
12051 *-- Author : Peter Richardson
12052 C-----------------------------------------------------------------------
12053 FUNCTION HWDRM4(X,Y,MA,MB,MC,MD,MR1,MR2,GAM1,GAM2,A1,A2,B1,B2)
12054 C-----------------------------------------------------------------------
12055 C Function to compute the interference part of a 3-body
12057 C-----------------------------------------------------------------------
12059 DOUBLE PRECISION X,Y,MA,MB,MC,MD,A1,A2,B1,B2,HWDRM4,MR1,MR2,GAM1
12062 HWDRM4 = 2*((GAM1*GAM2*MR1*MR2 + (X - MR1**2)*(Y - MR2**2))*
12063 & (A2*B1*MC*MD*(X - MA**2 - MB**2) +
12064 & A1*A2*MA*MC*(X + Y - MA**2 - MC**2) +
12065 & A1*B2*MA*MD*(Y - MB**2 - MC**2) +
12066 & B1*B2*(X*Y - MA**2*MC**2 - MB**2*MD**2)))/
12067 & (((X-MR1**2)**2+GAM1**2*MR1**2)*((Y-MR2**2)**2+GAM2**2*MR2**2))
12070 *CMZ :- -20/07/99 10:56:12 by Peter Richardson
12071 *-- Author : Peter Richardson
12072 C-----------------------------------------------------------------------
12073 SUBROUTINE HWDRM5(X,Y,Z,A,B,MA,MB,MC,MD,MR,GAM)
12074 C-----------------------------------------------------------------------
12075 C Subroutine to find the maximum of the ME
12076 C-----------------------------------------------------------------------
12078 DOUBLE PRECISION X,Y,Z,MA,MB,MC,MD,MR,GAM,RES(3),A,B,C,D,
12079 & E2S,E3S,E2M,E3M,LOW,UPP,HWRUNI,EPS,ZERO
12081 PARAMETER(EPS=1D-9,ZERO=0)
12084 RES(1) = -D*(MA**2 + MB**2)*MC*MD +
12085 & C*(GAM**2*MR**2 + MR**4 - MA**2*MC**2 - MB**2*MC**2 -
12086 & MA**2*MD**2 - MB**2*MD**2)
12087 RES(2) = (GAM**2*MR**2 + (-MR**2 + MA**2 + MB**2)**2)*
12088 & (D**2*MC**2*MD**2 +
12089 & 2*C*D*MC*MD*(-MR**2 + MC**2 + MD**2) +
12090 & C**2*(GAM**2*MR**2 + (-MR**2 + MC**2 + MD**2)**2))
12091 RES(3) = -D*MC*MD+C*(2*MR**2-(MA**2+MB**2+MC**2+MD**2))
12092 IF(RES(2).GT.ZERO) THEN
12093 RES(2) = SQRT(RES(2))
12097 IF((RES(1)+RES(2))/RES(3).GT.(MD-MC)**2.OR.
12098 & (RES(1)+RES(2))/RES(3).LT.(MA+MB)**2) THEN
12099 X = (RES(1)-RES(2))/RES(3)
12101 X = (RES(1)+RES(2))/RES(3)
12103 IF(X.GT.(MD-MC)**2) X = (MD-MC)**2
12104 IF(X.LT.(MA+MB)**2) X = (MA+MB)**2
12105 E2S = (X-MA**2+MB**2)/(2*SQRT(X))
12106 E3S = (MD**2-X-MC**2)/(2*SQRT(X))
12109 IF(E2M.LT.ZERO) THEN
12110 IF(ABS(E2M/E2S).GT.EPS) CALL HWWARN('HWDRM5',2)
12113 IF(E3M.LT.ZERO) THEN
12114 IF(ABS(E3M/E3S).GT.EPS) CALL HWWARN('HWDRM5',3)
12119 LOW = (E2S+E3S)**2-(E2M+E3M)**2
12120 UPP = (E2S+E3S)**2-(E2M-E3M)**2
12121 Y = HWRUNI(1,LOW,UPP)
12122 Z = MA**2+MB**2+MC**2+MD**2-X-Y
12125 *CMZ :- -26/04/91 11.11.55 by Bryan Webber
12126 *-- Author : Bryan Webber
12127 C-----------------------------------------------------------------------
12128 FUNCTION HWDPWT(EMSQ,A,B,C)
12129 C-----------------------------------------------------------------------
12130 C MATRIX ELEMENT SQUARED FOR PHASE SPACE DECAY
12131 C-----------------------------------------------------------------------
12133 DOUBLE PRECISION HWDPWT,EMSQ,A,B,C
12137 *CMZ :- -30/09/02 14:05:28 by Peter Richardson
12138 *-- Author : Peter Richardson
12139 C-----------------------------------------------------------------------
12140 SUBROUTINE HWDSIN(CLSAVE)
12141 C-----------------------------------------------------------------------
12142 C Subroutine to perform decays including spin correlations
12143 C-----------------------------------------------------------------------
12144 INCLUDE 'herwig65.inc'
12145 DOUBLE PRECISION PW(5)
12146 INTEGER IDEC,IP,IS,IHEP,ID,IM,LHEP,MHEP,NPR,KHEP,CLSAVE(2),NTRY,
12148 IF(IERROR.NE.0) RETURN
12152 C--search the decay products and decide which one to decay next
12153 IF(.NOT.DECSPN(IDEC)) THEN
12154 CALL HWDSI1(IDEC,IP)
12156 IDEC = JMOSPN(IDEC)
12159 C--first no more particles in this decay to develop so move up chain
12161 IDEC = JMOSPN(IDEC)
12162 C--reached the end of this spin chain go back to HWDHOB
12166 C--otherwise keep going up the chain
12168 IF(NTRY.LE.NBTRY) THEN
12171 CALL HWWARN('HWDSIN',100)
12175 C--special for tau decays call spin correlation in tau decay routine
12176 ELSEIF(ABS(IDHEP(IDSPN(IP))).EQ.15) THEN
12178 IF(IERROR.NE.0) RETURN
12181 C--work out where that particle is
12183 C--if particle has daughters
12184 10 IF(JDAHEP(1,IHEP).NE.0) THEN
12185 IF(ISTHEP(IHEP).GE.141.AND.ISTHEP(IHEP).LE.144) THEN
12186 DO ID1=JDAHEP(1,IHEP),JDAHEP(2,IHEP)
12187 IF(IDHW(ID1).EQ.ID) IHEP=ID1
12190 IHEP = JDAHEP(1,IHEP)
12196 IF(NTRY.GE.NBTRY) THEN
12197 CALL HWWARN('HWDSIN',101)
12200 IF (.NOT.RSTAB(ID).AND.(ID.EQ.6.OR.ID.EQ.12.OR.
12201 & (ID.GE.203.AND.ID.LE.218).OR.ABS(IDPDG(ID)).GT.1000000).AND.
12202 & (IS.EQ.190.OR.(IS.GE.147.AND.IS.LE.151))) THEN
12203 CALL HWDHO1(IHEP,ID,IM,NPR,LHEP,MHEP)
12204 IF(IERROR.NE.0) RETURN
12208 C--perform the decay including spin correlations
12209 CALL HWDSI2(IHEP,IM,NPR,MHEP,KHEP,PW)
12210 IF(IERROR.NE.0) RETURN
12211 C--make the colour connections
12212 CALL HWDHO3(ID,IM,NPR,MHEP,LHEP,KHEP,CLSAVE)
12213 IF (IERROR.NE.0) RETURN
12214 C--perform the parton-showers
12215 CALL HWDHO4(IHEP,ID,IM,NPR,MHEP,LHEP,KHEP,PW)
12216 IF(IERROR.NE.0) RETURN
12217 C--perform RPV colour connections
12218 CALL HWDHO5(MHEP,LHEP,CLSAVE)
12219 IF(IERROR.NE.0) RETURN
12220 C--continue and perform the next decay
12222 IF(NTRY.LE.NBTRY) THEN
12225 CALL HWWARN('HWDSIN',102)
12230 *CMZ :- -30/09/02 14:05:28 by Peter Richardson
12231 *-- Author : Peter Richardson
12232 C-----------------------------------------------------------------------
12233 SUBROUTINE HWDSI1(IDEC,IP)
12234 C-----------------------------------------------------------------------
12235 C Subroutine to check a vertex and decide which branch to treat
12236 C-----------------------------------------------------------------------
12237 INCLUDE 'herwig65.inc'
12238 INTEGER IDEC,I,IPICK(5),IP,HWRINT,P1,P2,P3,P4,P3P,P4P,NPR,P0,P0P,
12239 & P1P,P2P,IF1,IF2,P5,P5P
12240 DOUBLE PRECISION NORM
12241 DOUBLE COMPLEX RHOLP(2,2),RHOPS(2,2)
12243 C--loop over the daughters and decide what to do
12245 C--if daughters of particle the same issue warning
12246 IF(JDASPN(1,IDEC).EQ.JDASPN(2,IDEC)) THEN
12247 CALL HWWARN('HWDSI1',100)
12250 C--loop over the decay products
12251 DO I=JDASPN(1,IDEC),JDASPN(2,IDEC)
12252 IF(.NOT.DECSPN(I)) THEN
12253 C--first SM particles other than tau and top and stable particles
12254 IF(RSTAB(IDHW(IDSPN(I)))
12255 & .OR.(IDHW(IDSPN(I)).LE.12.AND.ABS(IDHEP(IDSPN(I))).NE.6)
12256 & .OR.(IDHW(IDSPN(I)).GE.121.AND.IDHW(IDSPN(I)).LE.132.AND.
12257 & ABS(IDHEP(IDSPN(I))).NE.15)) THEN
12259 RHOSPN(1,1,I) = HALF
12260 RHOSPN(1,2,I) = ZERO
12261 RHOSPN(2,1,I) = ZERO
12262 RHOSPN(2,2,I) = HALF
12263 C--spinless particles
12264 ELSEIF(RSPIN(IDHW(IDSPN(I))).EQ.ZERO) THEN
12266 RHOSPN(1,1,I) = ONE
12267 RHOSPN(1,2,I) = ZERO
12268 RHOSPN(2,1,I) = ZERO
12269 RHOSPN(2,2,I) = ZERO
12271 C--particle which needs development
12277 C--pick the particle to decay next
12279 IF(JMOSPN(IDEC).EQ.0) RETURN
12280 C--done everything compute the decay matrix and move up
12281 DECSPN(IDEC) = .TRUE.
12282 NPR = JDASPN(2,IDEC)-JDASPN(1,IDEC)+1
12285 20 RHOSPN(P0,P0P,IDEC) = ZERO
12294 21 RHOSPN(P0,P0P,IDEC) = RHOSPN(P0,P0P,IDEC)+
12295 & MESPN(P0 ,P1 ,P2 ,1,NCFL(IDEC),IDEC)*
12296 & DCONJG(MESPN(P0P,P1P,P2P,1,NCFL(IDEC),IDEC))*
12297 & RHOSPN(P1,P1P,JDASPN(1,IDEC))*RHOSPN(P2,P2P,JDASPN(2,IDEC))
12298 C--three body decay
12299 ELSEIF(NPR.EQ.3) THEN
12308 25 RHOSPN(P0,P0P,IDEC) = RHOSPN(P0,P0P,IDEC)+
12309 & MESPN(P0 ,P1 ,P2 ,P3 ,NCFL(IDEC),IDEC)*
12310 & DCONJG(MESPN(P0P,P1P,P2P,P3P,NCFL(IDEC),IDEC))*
12311 & RHOSPN(P1,P1P,JDASPN(1,IDEC))*RHOSPN(P2,P2P,JDASPN(1,IDEC)+1)*
12312 & RHOSPN(P3,P3P,JDASPN(2,IDEC))
12315 CALL HWWARN('HWDSI1',500)
12317 C--now normalise this
12318 NORM = DBLE(RHOSPN(1,1,IDEC))+DBLE(RHOSPN(2,2,IDEC))
12319 IF(NORM.GT.ZERO) THEN
12323 35 RHOSPN(P0,P0P,IDEC) = NORM*RHOSPN(P0,P0P,IDEC)
12325 CALL HWWARN('HWDSI1',101)
12329 C--pick the particle to be decayed
12330 IP = IPICK(HWRINT(1,IP))
12331 C--setup the spin density matrix for the decay
12332 C--special for the hard process
12333 IF(ISTHEP(IDSPN(IDEC)).EQ.120) THEN
12334 NPR = JDASPN(2,IDEC)-JDASPN(1,IDEC)+1
12335 C--set up the spin density matrices for the incoming partons
12336 C--zero off diagonal elements
12341 C--set up for polarized incoming beams in lepton collisons
12342 IF(IDHW(JMOHEP(1,IDSPN(IDEC))).GE.121.AND.
12343 & IDHW(JMOHEP(1,IDSPN(IDEC))).LE.132) THEN
12344 RHOLP(1,1) = HALF*(ONE+EPOLN(3))
12345 RHOLP(2,2) = HALF*(ONE-EPOLN(3))
12346 RHOPS(1,1) = HALF*(ONE-PPOLN(3))
12347 RHOPS(2,2) = HALF*(ONE+PPOLN(3))
12348 C--otherwise average
12355 C--first decay product
12357 IF(IP.EQ.JDASPN(1,IDEC)) THEN
12358 C--if using first colour flow option
12359 IF(SPCOPT.EQ.1) THEN
12362 RHOSPN(P3,P3P,IP) = ZERO
12371 5 RHOSPN(P3,P3P,IP) = RHOSPN(P3,P3P,IP)+SPNCFC(IF1,IF2,1)*
12372 & MESPN(P1 ,P2 ,P3 ,P4 ,IF1,1)*
12373 & DCONJG(MESPN(P1P,P2P,P3P,P4P,IF2,1))*
12374 & RHOLP(P1,P1P)*RHOPS(P2,P2P)*RHOSPN(P4,P4P,IP+1)
12375 C--if using second colour flow option
12376 ELSEIF(SPCOPT.EQ.2) THEN
12379 RHOSPN(P3,P3P,IP) = ZERO
12386 6 RHOSPN(P3,P3P,IP) = RHOSPN(P3,P3P,IP)
12387 & +SPNCFC(NCFL(1),NCFL(1),1)*
12388 & MESPN(P1 ,P2 ,P3 ,P4 ,NCFL(1),1)*
12389 & DCONJG(MESPN(P1P,P2P,P3P,P4P,NCFL(1),1))*
12390 & RHOLP(P1,P1P)*RHOPS(P2,P2P)*RHOSPN(P4,P4P,IP+1)
12391 C--unknown option issue warning
12393 CALL HWWARN('HWDSI1',501)
12395 C--second decay product
12397 IF(SPCOPT.EQ.1) THEN
12400 RHOSPN(P4,P4P,IP) = (0.0D0,0.0D0)
12401 DO 10 IF1=1,NCFL(1)
12402 DO 10 IF2=1,NCFL(1)
12409 10 RHOSPN(P4,P4P,IP) = RHOSPN(P4,P4P,IP)+SPNCFC(IF1,IF2,1)*
12410 & MESPN(P1 ,P2 ,P3 ,P4 ,IF1,1)*
12411 & DCONJG(MESPN(P1P,P2P,P3P,P4P,IF2,1))*
12412 & RHOLP(P1,P1P)*RHOPS(P2,P2P)*RHOSPN(P3,P3P,IP-1)
12413 ELSEIF(SPCOPT.EQ.2) THEN
12416 RHOSPN(P4,P4P,IP) = (0.0D0,0.0D0)
12423 11 RHOSPN(P4,P4P,IP) = RHOSPN(P4,P4P,IP)
12424 & +SPNCFC(NCFL(1),NCFL(1),1)*
12425 & MESPN(P1 ,P2 ,P3 ,P4 ,NCFL(1),1)*
12426 & DCONJG(MESPN(P1P,P2P,P3P,P4P,NCFL(1),1))*
12427 & RHOLP(P1,P1P)*RHOPS(P2,P2P)*RHOSPN(P3,P3P,IP-1)
12429 CALL HWWARN('HWDSI1',502)
12433 C--new for four body gauge boson pair processes
12434 ELSEIF(NPR.EQ.4) THEN
12436 IF(IP.EQ.JDASPN(1,IDEC)) THEN
12439 RHOSPN(P1,P1P,IP) = (0.0D0,0.0D0)
12444 41 RHOSPN(P1,P1P,IP) = RHOSPN(P1,P1P,IP)+
12445 & MESPN(P5,P1,P3,1,1,1)*DCONJG(MESPN(P5P,P1P,P3P,1,1,1))*
12446 & RHOSPN(P1,P1P,JDASPN(1,IDEC)+1)*
12447 & RHOSPN(P3,P3P,JDASPN(1,IDEC)+2)*
12448 & RHOSPN(P3,P3P,JDASPN(2,IDEC))
12450 ELSEIF(IP.EQ.JDASPN(1,IDEC)+1) THEN
12453 RHOSPN(P1,P1P,IP) = (0.0D0,0.0D0)
12458 42 RHOSPN(P1,P1P,IP) = RHOSPN(P1,P1P,IP)+
12459 & MESPN(P5,P1,P3,1,1,1)*DCONJG(MESPN(P5P,P1P,P3P,1,1,1))*
12460 & RHOSPN(P1,P1P,JDASPN(1,IDEC))*
12461 & RHOSPN(P3,P3P,JDASPN(1,IDEC)+2)*
12462 & RHOSPN(P3,P3P,JDASPN(2,IDEC))
12464 ELSEIF(IP.EQ.JDASPN(1,IDEC)+2) THEN
12467 RHOSPN(P3,P3P,IP) = (0.0D0,0.0D0)
12472 43 RHOSPN(P3,P3P,IP) = RHOSPN(P3,P3P,IP)+
12473 & MESPN(P5,P1,P3,1,1,1)*DCONJG(MESPN(P5P,P1P,P3P,1,1,1))*
12474 & RHOSPN(P1,P1P,JDASPN(1,IDEC))*
12475 & RHOSPN(P1,P1P,JDASPN(1,IDEC)+1)*
12476 & RHOSPN(P3,P3P,JDASPN(2,IDEC))
12478 ELSEIF(IP.EQ.JDASPN(2,IDEC)) THEN
12481 RHOSPN(P3,P3P,IP) = (0.0D0,0.0D0)
12486 44 RHOSPN(P3,P3P,IP) = RHOSPN(P3,P3P,IP)+
12487 & MESPN(P5,P1,P3,1,1,1)*DCONJG(MESPN(P5P,P1P,P3P,1,1,1))*
12488 & RHOSPN(P1,P1P,JDASPN(1,IDEC))*
12489 & RHOSPN(P1,P1P,JDASPN(1,IDEC)+1)*
12490 & RHOSPN(P3,P3P,JDASPN(1,IDEC)+2)
12491 C--unrecognized issue warning
12493 CALL HWWARN('HWDSI1',509)
12496 C--unrecognized issue warning
12498 CALL HWWARN('HWDSI1',508)
12502 NPR = JDASPN(2,IDEC)-JDASPN(1,IDEC)+1
12505 50 RHOSPN(P1,P1P,IP) = (0.0D0,0.0D0)
12506 C--set-up matrix for 2-body decay
12508 IF(NCFL(IDEC).NE.1) CALL HWWARN('HWDSI1',503)
12509 IF(IP.EQ.JDASPN(1,IDEC)) THEN
12516 60 RHOSPN(P1,P1P,IP) = RHOSPN(P1,P1P,IP)+RHOSPN(P0,P0P,IDEC)*
12517 & MESPN(P0 ,P1 ,P2 ,1,1,IDEC)*
12518 & DCONJG(MESPN(P0P,P1P,P2P,1,1,IDEC))*
12519 & RHOSPN(P2,P2P,JDASPN(2,IDEC))
12527 70 RHOSPN(P2,P2P,IP) = RHOSPN(P2,P2P,IP)+RHOSPN(P0,P0P,IDEC)*
12528 & MESPN(P0 ,P1 ,P2 ,1,1,IDEC)*
12529 & DCONJG(MESPN(P0P,P1P,P2P,1,1,IDEC))*
12530 & RHOSPN(P1,P1P,JDASPN(1,IDEC))
12532 C--set-up matrix for 3-body decay
12533 ELSEIF(NPR.EQ.3) THEN
12534 IF(SPCOPT.NE.2.AND.NCFL(IDEC).NE.1)
12535 & CALL HWWARN('HWDSI1',504)
12537 IF(IP.EQ.JDASPN(1,IDEC)) THEN
12546 100 RHOSPN(P1,P1P,IP) = RHOSPN(P1,P1P,IP)+RHOSPN(P0,P0P,IDEC)*
12547 & MESPN(P0 ,P1 ,P2 ,P3 ,NCFL(IDEC),IDEC)*
12548 & DCONJG(MESPN(P0P,P1P,P2P,P3P,NCFL(IDEC),IDEC))*
12549 & RHOSPN(P2,P2P,JDASPN(1,IDEC)+1)*
12550 & RHOSPN(P3,P3P,JDASPN(2,IDEC))
12552 ELSEIF(IP.EQ.JDASPN(1,IDEC)+1) THEN
12561 105 RHOSPN(P2,P2P,IP) = RHOSPN(P2,P2P,IP)+RHOSPN(P0,P0P,IDEC)*
12562 & MESPN(P0 ,P1 ,P2 ,P3 ,NCFL(IDEC),IDEC)*
12563 & DCONJG(MESPN(P0P,P1P,P2P,P3P,NCFL(IDEC),IDEC))*
12564 & RHOSPN(P1,P1P,JDASPN(1,IDEC))*
12565 & RHOSPN(P3,P3P,JDASPN(2,IDEC))
12567 ELSEIF(IP.EQ.JDASPN(2,IDEC)) THEN
12576 110 RHOSPN(P3,P3P,IP) = RHOSPN(P3,P3P,IP)+RHOSPN(P0,P0P,IDEC)*
12577 & MESPN(P0 ,P1 ,P2 ,P3 ,NCFL(IDEC),IDEC)*
12578 & DCONJG(MESPN(P0P,P1P,P2P,P3P,NCFL(IDEC),IDEC))*
12579 & RHOSPN(P1,P1P,JDASPN(1,IDEC))*
12580 & RHOSPN(P2,P2P,JDASPN(1,IDEC)+1)
12583 CALL HWWARN('HWDSI1',102)
12586 ELSEIF(NPR.EQ.4) THEN
12588 IF(IP.EQ.JDASPN(1,IDEC)) THEN
12591 RHOSPN(P1,P1P,IP) = (0.0D0,0.0D0)
12598 151 RHOSPN(P1,P1P,IP) = RHOSPN(P1,P1P,IP)+
12599 & MESPN(P1 ,P2 ,P3 ,P4 ,1,1)*
12600 & DCONJG(MESPN(P1P,P2P,P3P,P4P,1,1))*
12601 & RHOSPN(P2,P2P,JDASPN(1,IDEC)+1)*
12602 & RHOSPN(P3,P3P,JDASPN(1,IDEC)+2)*
12603 & RHOSPN(P4,P4P,JDASPN(2,IDEC))
12605 ELSEIF(IP.EQ.JDASPN(1,IDEC)+1) THEN
12608 RHOSPN(P2,P2P,IP) = (0.0D0,0.0D0)
12615 152 RHOSPN(P2,P2P,IP) = RHOSPN(P2,P2P,IP)+
12616 & MESPN(P1 ,P2 ,P3 ,P4 ,1,1)*
12617 & DCONJG(MESPN(P1P,P2P,P3P,P4P,1,1))*
12618 & RHOSPN(P1,P1P,JDASPN(1,IDEC))*
12619 & RHOSPN(P3,P3P,JDASPN(1,IDEC)+2)*
12620 & RHOSPN(P4,P4P,JDASPN(2,IDEC))
12622 ELSEIF(IP.EQ.JDASPN(1,IDEC)+2) THEN
12625 RHOSPN(P3,P3P,IP) = (0.0D0,0.0D0)
12632 153 RHOSPN(P3,P3P,IP) = RHOSPN(P3,P3P,IP)+
12633 & MESPN(P1 ,P2 ,P3 ,P4 ,1,1)*
12634 & DCONJG(MESPN(P1P,P2P,P3P,P4P,1,1))*
12635 & RHOSPN(P1,P1P,JDASPN(1,IDEC))*
12636 & RHOSPN(P2,P2P,JDASPN(1,IDEC)+1)*
12637 & RHOSPN(P4,P4P,JDASPN(2,IDEC))
12639 ELSEIF(IP.EQ.JDASPN(2,IDEC)) THEN
12642 RHOSPN(P4,P4P,IP) = (0.0D0,0.0D0)
12649 154 RHOSPN(P4,P4P,IP) = RHOSPN(P4,P4P,IP)+
12650 & MESPN(P1 ,P2 ,P3 ,P4 ,1,1)*
12651 & DCONJG(MESPN(P1P,P2P,P3P,P4P,1,1))*
12652 & RHOSPN(P1,P1P,JDASPN(1,IDEC))*
12653 & RHOSPN(P2,P2P,JDASPN(1,IDEC)+1)*
12654 & RHOSPN(P3,P3P,JDASPN(1,IDEC)+2)
12656 CALL HWWARN('HWDSI1',505)
12659 CALL HWWARN('HWDSI1',506)
12662 C--normalise the spin density matrix
12663 NORM = DBLE(RHOSPN(1,1,IP))+DBLE(RHOSPN(2,2,IP))
12664 IF(NORM.GT.ZERO) THEN
12668 15 RHOSPN(P3,P3P,IP) = NORM*RHOSPN(P3,P3P,IP)
12670 CALL HWWARN('HWDSI1',107)
12677 *CMZ :- -30/09/02 14:05:28 by Peter Richardson
12678 *-- Author : Peter Richardson
12679 C-----------------------------------------------------------------------
12680 SUBROUTINE HWDSI2(IHEP,IM,NPR,MHEP,KHEP,PW)
12681 C-----------------------------------------------------------------------
12682 C Subroutine to perform the second part of the heavy object decays
12683 C IE generate the kinematics for the decay
12684 C including spin correlations
12685 C was part of HWDHOB
12686 C-----------------------------------------------------------------------
12687 INCLUDE 'herwig65.inc'
12688 DOUBLE PRECISION HWRGEN,PW(5),HWDPWT,HWDWWT,PCM,HWUPCM
12689 INTEGER IHEP,IM,KHEP,MHEP,NPR,ISN,RHEP
12690 EXTERNAL HWRGEN,HWDPWT,HWDWWT,HWUPCM
12691 IF (IERROR.NE.0) RETURN
12694 C Two body decay: LHEP -> MHEP + NHEP
12695 IF(NME(IM).GT.20000.AND.NME(IM).LT.30000) THEN
12696 C--generate a two body decay to a gauge boson as a three body decay
12697 CALL HWDSM3(2,IHEP,MHEP,NHEP,0,NME(IM)-20000,
12698 & RHOSPN(1,1,ISN),ISN)
12700 ELSEIF(NME(IM).GT.30000.AND.NME(IM).LT.40000) THEN
12701 CALL HWDSM2(IHEP,MHEP,NHEP,NME(IM)-30000,
12702 & RHOSPN(1,1,ISN),ISN)
12703 C--otherwise issue warning
12704 C--change by PR 9/30/02 to issue non-terminal warning and continue
12706 CALL HWWARN('HWDSI2',1)
12707 PCM=HWUPCM(PHEP(5,IHEP),PHEP(5,MHEP),PHEP(5,NHEP))
12708 CALL HWDTWO(PHEP(1,IHEP),PHEP(1,MHEP),
12709 & PHEP(1,NHEP),PCM,TWO,.FALSE.)
12710 DECSPN(ISN) = .TRUE.
12711 IF(RSPIN(IDHW(IHEP)).EQ.ZERO) THEN
12712 RHOSPN(1,1,ISN) = ONE
12713 RHOSPN(1,2,ISN) = ZERO
12714 RHOSPN(2,1,ISN) = ZERO
12715 RHOSPN(2,2,ISN) = ZERO
12717 RHOSPN(1,1,ISN) = HALF
12718 RHOSPN(1,2,ISN) = ZERO
12719 RHOSPN(2,1,ISN) = ZERO
12720 RHOSPN(2,2,ISN) = HALF
12723 ELSEIF (NPR.EQ.3) THEN
12724 C Three body decay: LHEP -> KHEP + MHEP + NHEP
12727 C Provisional colour self-connection of KHEP
12728 JMOHEP(2,KHEP)=KHEP
12729 JDAHEP(2,KHEP)=KHEP
12730 C--if old codes issue warning
12731 IF (NME(IM).EQ.100.OR.NME(IM).EQ.200.OR.NME(IM).EQ.300) THEN
12732 CALL HWWARN('HWDSI2',502)
12733 C--three body spin matrix element
12734 ELSEIF(NME(IM).GE.10000.AND.NME(IM).LT.20000) THEN
12735 CALL HWDSM3(3,IHEP,MHEP,KHEP,NHEP,NME(IM)-10000,
12736 & RHOSPN(1,1,ISN),ISN)
12737 C--special for top decay
12738 IF(ABS(IDHEP(IHEP)).EQ.6) THEN
12739 CALL HWVSUM(4,PHEP(1,KHEP),PHEP(1,MHEP),PW)
12742 C--unknown issue warning
12744 CALL HWWARN('HWDSI2',2)
12745 C Three body phase space decay
12746 CALL HWDTHR(PHEP(1,IHEP),PHEP(1,MHEP),
12747 & PHEP(1,KHEP),PHEP(1,NHEP),HWDPWT)
12748 CALL HWVEQU(4,VHEP(1,KHEP),VHEP(1,MHEP))
12749 DECSPN(ISN) = .TRUE.
12750 IF(RSPIN(IDHW(IHEP)).EQ.ZERO) THEN
12751 RHOSPN(1,1,ISN) = ONE
12752 RHOSPN(1,2,ISN) = ZERO
12753 RHOSPN(2,1,ISN) = ZERO
12754 RHOSPN(2,2,ISN) = ZERO
12756 RHOSPN(1,1,ISN) = HALF
12757 RHOSPN(1,2,ISN) = ZERO
12758 RHOSPN(2,1,ISN) = ZERO
12759 RHOSPN(2,2,ISN) = HALF
12762 ELSEIF(NPR.EQ.4) THEN
12763 CALL HWWARN('HWDSI2',3)
12764 C Four body decay: LHEP -> KHEP + RHEP + MHEP + NHEP
12769 C Provisional colour connections of KHEP and RHEP
12770 JMOHEP(2,KHEP)=RHEP
12771 JDAHEP(2,KHEP)=RHEP
12772 JMOHEP(2,RHEP)=KHEP
12773 JDAHEP(2,RHEP)=KHEP
12774 C Four body phase space decay
12775 CALL HWDFOR(PHEP(1,IHEP),PHEP(1,KHEP),PHEP(1,RHEP),
12776 & PHEP(1,MHEP),PHEP(1,NHEP))
12777 IF(IERROR.NE.0) RETURN
12778 CALL HWVEQU(4,VHEP(1,KHEP),VHEP(1,RHEP))
12779 CALL HWVEQU(4,VHEP(1,KHEP),VHEP(1,MHEP))
12780 DECSPN(ISN) = .TRUE.
12781 IF(RSPIN(IDHW(IHEP)).EQ.ZERO) THEN
12782 RHOSPN(1,1,ISN) = ONE
12783 RHOSPN(1,2,ISN) = ZERO
12784 RHOSPN(2,1,ISN) = ZERO
12785 RHOSPN(2,2,ISN) = ZERO
12787 RHOSPN(1,1,ISN) = HALF
12788 RHOSPN(1,2,ISN) = ZERO
12789 RHOSPN(2,1,ISN) = ZERO
12790 RHOSPN(2,2,ISN) = HALF
12793 CALL HWWARN('HWDSI2',100)
12797 *CMZ :- -30/09/02 14:05:28 by Peter Richardson
12798 *-- Author : Peter Richardson
12799 C-----------------------------------------------------------------------
12800 SUBROUTINE HWDSI3(IP)
12801 C-----------------------------------------------------------------------
12802 C Subroutine to handle spin correlations in tau decays
12803 C averages spin if not using TAUOLA
12804 C if using TAUOLA selects the spin and uses TAUOLA to perform the
12806 C-----------------------------------------------------------------------
12807 INCLUDE 'herwig65.inc'
12808 INTEGER IP,IHEP,ID1,ID,NTRY
12809 DOUBLE PRECISION PPOL,HWRGEN,POL
12811 C--if HERWIG is performing tau decays average over spins and return
12812 C--spin averaged tau decay will be done later
12813 IF(TAUDEC.EQ.'HERWIG') THEN
12814 DECSPN(IP) = .TRUE.
12815 RHOSPN(1,1,IP) = HALF
12816 RHOSPN(2,1,IP) = ZERO
12817 RHOSPN(1,2,IP) = ZERO
12818 RHOSPN(2,2,IP) = HALF
12819 C--if using tauola select the polarization for the decay
12820 ELSEIF(TAUDEC.EQ.'TAUOLA') THEN
12821 C--work out where that particle is
12825 IF(JDAHEP(1,IHEP).NE.0) THEN
12826 IF(ISTHEP(IHEP).GE.141.AND.ISTHEP(IHEP).LE.144) THEN
12827 DO ID1=JDAHEP(1,IHEP),JDAHEP(2,IHEP)
12828 IF(IDHW(ID1).EQ.ID) IHEP=ID1
12831 IHEP = JDAHEP(1,IHEP)
12834 IF(NTRY.LT.NBTRY) THEN
12837 CALL HWWARN('HWDSI3',100)
12841 C--select the tau polarization
12842 PPOL = DBLE(RHOSPN(1,1,IP))
12843 IF(PPOL.GE.HWRGEN(0)) THEN
12845 RHOSPN(1,1,IP) = ONE
12846 RHOSPN(2,1,IP) = ZERO
12847 RHOSPN(1,2,IP) = ZERO
12848 RHOSPN(2,2,IP) = ZERO
12851 RHOSPN(1,1,IP) = ZERO
12852 RHOSPN(2,1,IP) = ZERO
12853 RHOSPN(1,2,IP) = ZERO
12854 RHOSPN(2,2,IP) = ONE
12856 C--decay the particle
12857 CALL HWDTAU(1,IHEP,POL)
12858 DECSPN(IP) = .TRUE.
12860 CALL HWWARN('HWDSI3',500)
12865 *CMZ :- -09/04/02 13:46:07 by Peter Richardson
12866 *-- Author : Peter Richardson
12867 C-----------------------------------------------------------------------
12868 SUBROUTINE HWDSM2(ID,IOUT1,IOUT2,IMODE,RHOIN,IDSPIN)
12869 C-----------------------------------------------------------------------
12870 C Subroutine to calculate the two body matrix element for spin
12872 C-----------------------------------------------------------------------
12873 INCLUDE 'herwig65.inc'
12874 INTEGER IOUT1,IOUT2,IMODE,IDSPIN,ID,I,J,IDP(3),P0,P1,P2,O(2),P0P,
12876 DOUBLE PRECISION XMASS,PLAB,PRW,PCM,PREF(5),P(5,3),PM(5,3),PCMA,
12877 & HWUPCM,MA(3),MA2(3),HWULDO,PP,HWVDOT,N(3),EPS,PRE,PHS,A(2),
12879 DOUBLE COMPLEX RHOIN(2,2),S,D,ME(2,2,2),F1(2,2,8),F0(2,2,8),
12880 & F2M(2,2,8),F1M(2,2,8),F1F(2,2,8),F2(2,2,8,8),F0B(2,2,8,8)
12881 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
12883 DATA PREF/1.0D0,0.0D0,0.0D0,1.0D0,0.0D0/
12885 COMMON/HWHEWS/S(8,8,2),D(8,8)
12886 PARAMETER(EPS=1D-20)
12887 EXTERNAL HWUPCM,HWULDO,HWVDOT,HWRGEN
12888 C--first setup if this is the start of a new spin chain
12890 C--zero the elements of the array
12891 CALL HWVZRI( NMXHEP,ISNHEP)
12892 CALL HWVZRI( NMXSPN,JMOSPN)
12893 CALL HWVZRI(2*NMXSPN,JDASPN)
12894 CALL HWVZRI( NMXSPN, IDSPN)
12898 DECSPN(NSPN) = .FALSE.
12899 IF(RSPIN(IDHW(ID)).EQ.ZERO) THEN
12900 RHOSPN(1,1,NSPN) = ONE
12901 RHOSPN(2,1,NSPN) = ZERO
12902 RHOSPN(1,2,NSPN) = ZERO
12903 RHOSPN(2,2,NSPN) = ZERO
12905 RHOSPN(1,1,NSPN) = HALF
12906 RHOSPN(2,1,NSPN) = ZERO
12907 RHOSPN(1,2,NSPN) = ZERO
12908 RHOSPN(2,2,NSPN) = HALF
12912 C--MA is mass for this decay (OFF-SHELL)
12913 C--generate the momenta for a two body decay
12914 P(5,1) = PHEP(5, ID)
12915 P(5,2) = PHEP(5,IOUT1)
12916 P(5,3) = PHEP(5,IOUT2)
12918 IDP(2) = IDHW(IOUT1)
12919 IDP(3) = IDHW(IOUT2)
12922 1 MA2(I) = MA(I)**2
12923 PCMA = HWUPCM(P(5,1),P(5,2),P(5,3))
12924 C--setup the couplings
12926 2 A(I) = A2MODE(I,IMODE)
12927 C--phase space factor
12928 PHS = PCMA/MA2(1)/8.0D0/PIFAC
12930 WTMAX = WT2MAX(IMODE)
12933 CALL HWVEQU(5,PHEP(1,ID),P(1,1))
12934 CALL HWDTWO(P(1,1),P(1,2),P(1,3),PCMA,2.0D0,.TRUE.)
12936 C--compute the references vectors
12937 C--not important if SM particle which can't have spin measured
12938 C--ie anything other the top and tau
12939 C--also not important if particle is approx massless
12940 C--first the SM particles other than top and tau
12941 IF(IDP(I).LT.400.AND.(IDP(I).NE.6.AND.IDP(I).NE.12
12942 & .AND.IDP(I).NE.125.AND.IDP(I).NE.131)) THEN
12943 CALL HWVEQU(5,PREF,PLAB(1,I+3))
12944 C--all other particles
12946 PP = SQRT(HWVDOT(3,P(1,I),P(1,I)))
12947 CALL HWVSCA(3,ONE/PP,P(1,I),N)
12948 PLAB(4,I+3) = HALF*(P(4,I)-PP)
12949 PP = HALF*(PP-MA(I)-PP**2/(MA(I)+P(4,I)))
12950 CALL HWVSCA(3,PP,N,PLAB(1,I+3))
12951 CALL HWUMAS(PLAB(1,I+3))
12952 PP = HWVDOT(3,PLAB(1,I+3),PLAB(1,I+3))
12953 C--fix to avoid problems if approx massless due to energy
12954 IF(PP.LT.EPS) CALL HWVEQU(5,PREF,PLAB(1,I+3))
12956 C--now the massless vectors
12957 PP = HALF*P(5,I)**2/HWULDO(PLAB(1,I+3),P(1,I))
12959 4 PLAB(J,I) = P(J,I)-PP*PLAB(J,I+3)
12960 3 CALL HWUMAS(PLAB(1,I))
12961 C--change order of momenta for call to HE code
12973 6 PCM(5,I)=PLAB(5,I)
12974 C--compute the S functions
12975 CALL HWHEW2(6,PCM(1,1),S(1,1,2),S(1,1,1),D)
12978 S(I,J,2) = -S(I,J,2)
12979 7 D(I,J) = TWO*D(I,J)
12980 C--now compute the F functions needed
12981 CALL HWH2F2(6,F1 ,5,PM(1,2), MA(2))
12982 CALL HWH2F2(6,F0 ,4,PM(1,1), MA(1))
12983 CALL HWH2F2(6,F1M,5,PM(1,2),-MA(2))
12984 CALL HWH2F2(6,F2M,6,PM(1,3),-MA(3))
12985 CALL HWH2F1(6,F1F,5,PM(1,2), MA(2))
12986 CALL HWH2F3(6,F2 ,PM(1,3),ZERO )
12987 CALL HWH2F3(6,F0B ,PM(1,1),ZERO )
12988 C--now compute the diagrams
12989 C--fermion --> fermion scalar
12990 IF(I2DRTP(IMODE).EQ.1) THEN
12991 PRE = HWULDO(PM(1,1),PCM(1,4))*HWULDO(PM(1,2),PCM(1,5))
12992 PRE = HALF/SQRT(PRE)
12995 ME(P0,P1,2) = (0.0D0,0.0D0)
12996 10 ME(P0,P1,1) = PRE*( A(O(P1))*S(5,2,O(P1))*F0( P1 ,O(P0),2)
12997 & +A( P1 )*MA(2)* F0(O(P1),O(P0),5))
12998 C--fermion --> scalar fermion diagrams
12999 ELSEIF(I2DRTP(IMODE).EQ.2) THEN
13000 PRE = HWULDO(PM(1,1),PCM(1,4))*HWULDO(PM(1,3),PCM(1,6))
13001 PRE = HALF/SQRT(PRE)
13004 ME(P0,2,P2) = (0.0D0,0.0D0)
13005 20 ME(P0,1,P2) = PRE*( A(O(P2))*S(6,3,O(P2))*F0( P2 ,O(P0),3)
13006 & +A( P2 )*MA(3)* F0(O(P2),O(P0),6))
13007 C--fermion --> scalar antifermion
13008 ELSEIF(I2DRTP(IMODE).EQ.3) THEN
13009 PRE = HWULDO(PM(1,1),PCM(1,4))*HWULDO(PM(1,3),PCM(1,6))
13010 PRE =-HALF/SQRT(PRE)
13013 ME(P0,2,P2) = (0.0D0,0.0D0)
13014 30 ME(P0,1,P2) = PRE*( A( P0 )*S(4,1,P0)*F2M(O(P0),O(P2),1)
13015 & -A(O(P0))*MA(1) *F2M( P0 ,O(P2),4))
13016 C--fermion --> fermion gauge boson
13017 ELSEIF(I2DRTP(IMODE).EQ.4) THEN
13018 PRE = HWULDO(PM(1,1),PCM(1,4))*HWULDO(PM(1,2),PCM(1,5))*
13019 & HWULDO(PM(1,3),PCM(1,6))
13020 PRE = HALF/SQRT(PRE)
13023 ME(P0,P1,1) =-PRE*A(1)*F1F(O(P1),2,3)*S(3,6,2)*F0(1,O(P0),3)
13024 40 ME(P0,P1,2) = PRE* F1F(O(P1),1,3)*S(3,6,1)*F0(2,O(P0),3)
13025 C--scalar --> fermion antifermion
13026 ELSEIF(I2DRTP(IMODE).EQ.5) THEN
13027 PRE = HWULDO(PM(1,2),PCM(1,5))*HWULDO(PM(1,3),PCM(1,6))
13028 PRE =-HALF/SQRT(PRE)
13031 ME(2,P1,P2) = (0.0D0,0.0D0)
13032 50 ME(1,P1,P2) = PRE*( A(O(P1))*S(5,2,O(P1))*F2M( P1 ,O(P2),2)
13033 & +A( P1 )*MA(2)* F2M(O(P1),O(P2),5))
13034 C--scalar --> fermion fermion
13035 ELSEIF(I2DRTP(IMODE).EQ.6) THEN
13036 PRE = HWULDO(PM(1,2),PCM(1,5))*HWULDO(PM(1,3),PCM(1,6))
13037 PRE = HALF/SQRT(PRE)
13040 ME(2,P1,P2) = (0.0D0,0.0D0)
13041 60 ME(1,P1,P2) = PRE*( A(O(P2))*S(6,3,O(P2))*F1M( P2 ,P1,3)
13042 & +A( P2 )*MA(3)* F1M(O(P2),P1,6))
13043 C--fermion --> fermion pion
13044 ELSEIF(I2DRTP(IMODE).EQ.7) THEN
13045 PRE = HWULDO(PM(1,1),PCM(1,4))*HWULDO(PM(1,2),PCM(1,5))
13046 PRE = 0.25D0/SQRT(PRE)/RMASS(198)**2
13049 ME(P0,P1,2) = (0.0D0,0.0D0)
13050 70 ME(P0,P1,1) =PRE*(
13051 & MA(1)*A(O(P0))*( S(5,2,O(P1))*F2( P1 ,O(P0),2,4)
13052 & +MA(2)*F2(O(P1),O(P0),5,4))
13053 & +A(P0)*S(1,4,P0)*( S(5,2,O(P1))*F2( P1 , P0 ,2,1)
13054 & +MA(2)*F2(O(P1), P0 ,5,1)))
13055 C--scalar --> antifermion fermion
13056 ELSEIF(I2DRTP(IMODE).EQ.8) THEN
13057 PRE = HWULDO(PM(1,2),PCM(1,5))*HWULDO(PM(1,3),PCM(1,6))
13058 PRE =-HALF/SQRT(PRE)
13061 ME(2,P1,P2) = (0.0D0,0.0D0)
13062 80 ME(1,P1,P2) = PRE*( A(O(P2))*S(6,3,O(P2))*F1M( P2 ,O(P1),3)
13063 & +A( P2 )*MA(3)* F1M(O(P2),O(P1),6))
13064 C--neutralino --> gravitino photon
13065 ELSEIF(I2DRTP(IMODE).EQ.9) THEN
13066 PRE = TWO*HWULDO(PM(1,1),PCM(1,4))*HWULDO(PM(1,3),PCM(1,6))
13067 PRE = TWO/SQRT(PRE)
13070 ME(P1,P2,O(P2)) = (0.0D0,0.0D0)
13071 90 ME(P1,P2, P2 ) = PRE*S(2,3,P2)*S(3,6,O(P2))*
13072 & S(3,2,P2)*F0(O(P2),P1,2)
13073 C--neutralino --> gravitino scalar
13074 ELSEIF(I2DRTP(IMODE).EQ.10) THEN
13075 PRE = TWO*HWULDO(PM(1,1),PCM(1,4))
13076 PRE = ONE/SQRT(PRE)
13079 ME(P1,P2,2) = (0.0D0,0.0D0)
13080 100 ME(P1,P2,1) = PRE*F2(P2,1,2,2)*F0(1,O(P1),2)
13081 C--sfermion --> fermion gravitino
13082 ELSEIF(I2DRTP(IMODE).EQ.11) THEN
13083 PRE = TWO*HWULDO(PM(1,2),PCM(1,5))
13084 PRE = ONE/SQRT(PRE)
13087 ME(2,P1,P2) = (0.0D0,0.0D0)
13088 110 ME(1,P1,P2) = PRE*A(O(P2))*F1M(O(P1),P2,3)*F0B(P2,P2,3,3)
13089 C--antisfermion --> antifermion gravitino
13090 ELSEIF(I2DRTP(IMODE).EQ.12) THEN
13091 PRE = TWO*HWULDO(PM(1,2),PCM(1,5))
13092 PRE = ONE/SQRT(PRE)
13095 ME(2,P1,P2) = (0.0D0,0.0D0)
13096 120 ME(1,P1,P2) = PRE*A(O(P2))*F0B(P2,P2,3,3)*F1(P2,O(P1),3)
13097 C--scalar --> antifermion antifermion
13098 ELSEIF(I2DRTP(IMODE).EQ.13) THEN
13099 PRE = HWULDO(PM(1,2),PCM(1,5))*HWULDO(PM(1,3),PCM(1,6))
13100 PRE = HALF/SQRT(PRE)
13103 ME(2,P1,P2) = (0.0D0,0.0D0)
13104 130 ME(1,P1,P2) = PRE*( A( P1 )*S(5,2, P1 )*F2M(O(P1),O(P2),2)
13105 & +A(O(P1))*MA(2) *F2M( P1 ,O(P2),5))
13106 C--antifermion --> scalar antifermion
13107 ELSEIF(I2DRTP(IMODE).EQ.14) THEN
13108 PRE = HWULDO(PM(1,1),PCM(1,4))*HWULDO(PM(1,3),PCM(1,6))
13109 PRE = HALF/SQRT(PRE)
13112 ME(P0,2,P2) = (0.0D0,0.0D0)
13113 140 ME(P0,1,P2) = PRE*( A(O(P0))*S(4,1,O(P0))*F2M( P0 ,O(P2),1)
13114 & -A( P0 )*MA(1) *F2M(O(P0),O(P2),4))
13115 C--unrecognized type of diagram
13117 CALL HWWARN('HWDSM2',500)
13119 C--now compute the weight
13125 500 WGT = WGT+PHS*P2MODE(IMODE)*DREAL(
13126 & ME(P0,P1,P2)*DCONJG(ME(P0P,P1,P2))*RHOIN(P0,P0P))
13127 IF(I2DRTP(IMODE).EQ.5.OR.I2DRTP(IMODE).EQ.6.OR.
13128 & I2DRTP(IMODE).EQ.8.OR.I2DRTP(IMODE).EQ.13) GOTO 300
13129 C--issue warning if greater than maximum
13130 IF(WGT.GT.WTMAX) THEN
13131 CALL HWWARN('HWDSM2',1)
13132 WRITE(6,2000) RNAME(IDK(ID2PRT(IMODE))),
13133 & RNAME(IDKPRD(1,ID2PRT(IMODE))),RNAME(IDKPRD(2,ID2PRT(IMODE))),
13135 WT2MAX(IMODE) = 1.1D0*WGT
13136 WTMAX = WT2MAX(IMODE)
13138 IF(HWRGEN(0)*WTMAX.GT.WGT.AND.NTRY.LT.NSNTRY) GOTO 1000
13139 IF(NTRY.GE.NSNTRY) THEN
13140 CALL HWWARN('HWDSM2',100)
13143 C--now enter the momenta in the common block
13144 300 CALL HWVEQU(5,P(1,2),PHEP(1,IOUT1))
13145 CALL HWVEQU(5,P(1,3),PHEP(1,IOUT2))
13146 C--set up the spin information
13147 C--setup for all decays
13148 JMOSPN(NSPN+1) = IDSPIN
13149 JMOSPN(NSPN+2) = IDSPIN
13150 JDASPN(1,IDSPIN) = NSPN+1
13151 JDASPN(2,IDSPIN) = NSPN+2
13152 IDSPN(NSPN+1) = IOUT1
13153 IDSPN(NSPN+2) = IOUT2
13155 DECSPN(NSPN+I) = .FALSE.
13157 11 JDASPN(I,NSPN+J) = 0
13158 ISNHEP(IOUT1) = NSPN+1
13159 ISNHEP(IOUT2) = NSPN+2
13161 IF(RSPIN(IDHW(IDSPN(NSPN+I))).EQ.ZERO) THEN
13162 RHOSPN(1,1,NSPN+I) = ONE
13163 RHOSPN(2,1,NSPN+I) = ZERO
13164 RHOSPN(1,2,NSPN+I) = ZERO
13165 RHOSPN(2,2,NSPN+I) = ZERO
13167 RHOSPN(1,1,NSPN+I) = HALF
13168 RHOSPN(2,1,NSPN+I) = ZERO
13169 RHOSPN(1,2,NSPN+I) = ZERO
13170 RHOSPN(2,2,NSPN+I) = HALF
13174 C--now enter the matrix element
13178 MESPN(P0,P1,P2,2,1,IDSPIN) = (0.0D0,0.0D0)
13179 150 MESPN(P0,P1,P2,1,1,IDSPIN) = ME(P0,P1,P2)
13180 SPNCFC(1,1,IDSPIN) = ONE
13183 C--format statements
13184 2000 FORMAT(/'WEIGHT FOR DECAY ',A8,' --> ',A8,' ',A8, 'EXCEEDS MAX',
13185 & /10X,' MAXIMUM WEIGHT =',1PG24.16,
13186 & /10X,'NEW MAXIMUM WEIGHT =',1PG24.16)
13190 *CMZ :- -09/04/02 13:46:07 by Peter Richardson
13191 *-- Author : Peter Richardson
13192 C-----------------------------------------------------------------------
13193 SUBROUTINE HWDSM3(NPR,ID,IOUT1,IOUT2,IOUT3,IMODE,RHOIN,IDSPIN)
13194 C-----------------------------------------------------------------------
13195 C Master subroutine for three body SUSY and spin ME's
13196 C Uses HWD3ME to generate the momenta etc
13197 C-----------------------------------------------------------------------
13198 INCLUDE 'herwig65.inc'
13199 DOUBLE COMPLEX F0(2,2,8),F1(2,2,8),F1M(2,2,8),F3(2,2,8),
13200 & F0M(2,2,8),F2(2,2,8),RHOIN(2,2),F01(2,2,8,8)
13201 DOUBLE PRECISION A,B,MS,MWD,MA,MB,MA2,MB2,M342,M232,M242,MR,
13202 & P(5,4),PZ(5),HWRGEN,CV,CA,BR,PM(5,4),CFTHRE(NCFMAX,NCFMAX)
13203 INTEGER ID,IDP(4+NDIAGR),NPR,ITYPE,I,IB,ID1,ID2,IDSPIN,
13204 & DRTYPE(NDIAGR),IOUT(3),IMODE,IOUT1,IOUT2,IOUT3,J,NCTHRE,
13206 COMMON/HWD3BY/F0,F0M,F1M,F1,F2,F3,F01,A(2,NDIAGR),B(2,NDIAGR),
13207 & MS(NDIAGR),MWD(NDIAGR),MR(NDIAGR),MA(4),MA2(4),MB(4),MB2(4),
13208 & M342,M232,M242,P,PM,CFTHRE,IDP,DRTYPE,NCTHRE,DRCF
13210 SAVE PZ,IOUT,ITYPE,ID1,ID2
13211 C--calculate the matrix element for a three body decay
13213 C--set up the decay products, if a SUSY decay the SUSY particle
13214 C--must be the first decay product
13215 IF(ABS(IDHEP(IOUT1)).GT.1000000) THEN
13219 ELSEIF(ABS(IDHEP(IOUT2)).GT.1000000) THEN
13223 ELSEIF(ABS(IDHEP(IOUT3)).GT.1000000) THEN
13227 C--special for top decay (bottom must be first)
13228 ELSEIF(ABS(IDHEP(ID)).EQ.6) THEN
13237 C--fermion must be second and antifermion third
13238 IF(IDHEP(IOUT(2)).LT.0.AND.
13239 & (ABS(IDHEP(IOUT(1))).GT.1000000.OR.ABS(IDHEP(ID)).EQ.6)) THEN
13244 C--setup the OFF SHELL MASSES
13247 1 MA(I+1) = PHEP(5,IOUT(I))
13249 2 MA2(I) = MA(I)**2
13251 CALL HWD3ME(ID,0,IMODE,RHOIN,IDSPIN)
13252 IF(IERROR.NE.0) RETURN
13253 C--juggle the momenta for the RPV BV gluino if needed
13254 IF(SPCOPT.EQ.2.AND.N3NCFL(IMODE).EQ.3) THEN
13255 IF(NCFL(IDSPIN).EQ.2) THEN
13259 ELSEIF(NCFL(IDSPIN).EQ.3) THEN
13265 IDHW(IOUT(I)) = IDP(I+1)
13268 C--copy momenta into event record
13270 3 CALL HWVEQU(5,P(1,1+I),PHEP(1,IOUT(I)))
13271 C--enter the spin information in the common block
13273 C--set up if start of new spin chain
13275 C--zero the elements
13276 CALL HWVZRI( NMXHEP,ISNHEP)
13277 CALL HWVZRI( NMXSPN,JMOSPN)
13278 CALL HWVZRI(2*NMXSPN,JDASPN)
13279 CALL HWVZRI( NMXSPN, IDSPN)
13283 DECSPN(NSPN) = .FALSE.
13284 C--set up spin density matrix for particle
13285 IF(RSPIN(IDHW(ID)).EQ.ZERO) THEN
13286 RHOSPN(1,1,NSPN) = ONE
13287 RHOSPN(2,1,NSPN) = ZERO
13288 RHOSPN(1,2,NSPN) = ZERO
13289 RHOSPN(2,2,NSPN) = ZERO
13291 RHOSPN(1,1,NSPN) = HALF
13292 RHOSPN(2,1,NSPN) = ZERO
13293 RHOSPN(1,2,NSPN) = ZERO
13294 RHOSPN(2,2,NSPN) = HALF
13298 C--enter the decay products
13299 JDASPN(1,IDSPIN) = NSPN+1
13300 JDASPN(2,IDSPIN) = NSPN+3
13302 JMOSPN(NSPN+I ) = IDSPIN
13303 IDSPN (NSPN+I ) = IOUT(I)
13304 DECSPN(NSPN+I ) = .FALSE.
13305 ISNHEP(IOUT(I) ) = NSPN+I
13306 IF(RSPIN(IDHW(IOUT(I))).EQ.ZERO) THEN
13307 RHOSPN(1,1,NSPN+I) = ONE
13308 RHOSPN(2,1,NSPN+I) = ZERO
13309 RHOSPN(1,2,NSPN+I) = ZERO
13310 RHOSPN(2,2,NSPN+I) = ZERO
13312 RHOSPN(1,1,NSPN+I) = HALF
13313 RHOSPN(2,1,NSPN+I) = ZERO
13314 RHOSPN(1,2,NSPN+I) = ZERO
13315 RHOSPN(2,2,NSPN+I) = HALF
13318 7 JDASPN(J,NSPN+I) = 0
13321 C--select the decay mode and generate the decay for a two body mode
13322 ELSEIF(NPR.EQ.2) THEN
13323 IF(IDHW(IOUT2).GE.198.AND.IDHW(IOUT2).LE.200) THEN
13327 ELSEIF(IDHW(IOUT1).GE.198.AND.IDHW(IOUT1).LE.200) THEN
13332 CALL HWWARN('HWDSM3',501)
13334 C--setup the off shell masses and particle ids for me code
13336 MA(2) = PHEP(5,IOUT(1))
13337 CALL HWDBOZ(IB,ID1,ID2,CV,CA,BR,0)
13339 IF(IB.EQ.199) ITYPE = ITYPE+1
13340 IF(ITYPE.GT.120) ITYPE = ITYPE-114
13341 IF(IB.NE.200) ITYPE = ITYPE/2
13342 C--generate momenta of decay products
13343 CALL HWD3ME(ID,ITYPE,IMODE,RHOIN,IDSPIN)
13344 CALL HWVEQU(5,P(1,2),PHEP(1,IOUT(1)))
13345 CALL HWVSUM(4,P(1,3),P(1,4),PZ)
13347 CALL HWVEQU(5,PZ,PHEP(1,IOUT(2)))
13348 C--enter the spin information in the common block if starting new chain
13349 IF(SYSPIN.AND.NSPN.EQ.0) THEN
13350 C--zero elements of common block
13351 CALL HWVZRI( NMXHEP,ISNHEP)
13352 CALL HWVZRI( NMXSPN,JMOSPN)
13353 CALL HWVZRI(2*NMXSPN,JDASPN)
13354 CALL HWVZRI( NMXSPN, IDSPN)
13358 DECSPN(NSPN) = .FALSE.
13359 IF(RSPIN(IDHW(ID)).EQ.ZERO) THEN
13360 RHOSPN(1,1,NSPN) = ONE
13361 RHOSPN(2,1,NSPN) = ZERO
13362 RHOSPN(1,2,NSPN) = ZERO
13363 RHOSPN(2,2,NSPN) = ZERO
13365 RHOSPN(1,1,NSPN) = HALF
13366 RHOSPN(2,1,NSPN) = ZERO
13367 RHOSPN(1,2,NSPN) = ZERO
13368 RHOSPN(2,2,NSPN) = HALF
13373 IDSPN (NSPN+1 ) = IOUT(1)
13374 ISNHEP(IOUT(1)) = NSPN+1
13376 C--put the boson decay products into the event record for a two body mode
13377 ELSEIF(NPR.EQ.-1) THEN
13378 IOUT(1) = JDAHEP(1,IOUT(2))
13381 C--set up the status of the particles
13382 ISTHEP(IOUT(1)) = 195
13383 JDAHEP(1,IOUT(1)) = NHEP+1
13384 JDAHEP(2,IOUT(1)) = NHEP+2
13385 C--find the ID's of the particles
13386 IF(IDHW(IOUT(1)).EQ.200) THEN
13388 IF(ITYPE.GT.6) ID1 = ID1+114
13392 IF(ITYPE.GT.3) ID1 = ID1+114
13394 IF(IDHW(IOUT(1)).EQ.198) THEN
13400 C--put id's of decay products into the event record
13403 IDHEP(NHEP+1) = IDPDG(ID1)
13404 IDHEP(NHEP+2) = IDPDG(ID2)
13405 C--boost decay products momenta to rest frame of boson
13406 CALL HWULOF(PZ,P(1,3),P(1,3))
13407 CALL HWULOF(PZ,P(1,4),P(1,4))
13408 C--boost back to lab using new boson
13409 CALL HWULOB(PHEP(1,IOUT(1)),P(1,3),PHEP(1,NHEP+1))
13410 CALL HWULOB(PHEP(1,IOUT(1)),P(1,4),PHEP(1,NHEP+2))
13411 C--setup for decay to quarks
13413 ISTHEP(NHEP+1) = 113
13414 ISTHEP(NHEP+2) = 114
13415 JMOHEP(2,NHEP+1) = NHEP+2
13416 JDAHEP(2,NHEP+1) = NHEP+2
13417 JMOHEP(2,NHEP+2) = NHEP+1
13418 JDAHEP(2,NHEP+2) = NHEP+1
13419 JMOHEP(1,NHEP+1) = IOUT(1)
13420 JMOHEP(1,NHEP+2) = IOUT(1)
13421 C--setup for decay to leptons
13423 ISTHEP(NHEP+1) = 193
13424 ISTHEP(NHEP+2) = 193
13425 JMOHEP(1,NHEP+1) = IOUT(1)
13426 JMOHEP(1,NHEP+2) = IOUT(1)
13427 JMOHEP(2,NHEP+1) = JMOHEP(1,IOUT(1))
13428 JMOHEP(2,NHEP+2) = JMOHEP(1,IOUT(1))
13429 JDAHEP(1,NHEP+1) = 0
13430 JDAHEP(1,NHEP+2) = 0
13431 JDAHEP(2,NHEP+1) = 0
13432 JDAHEP(2,NHEP+2) = 0
13435 C--finish entering the spin information in the common block
13437 JDASPN(1,IDSPIN) = NSPN+1
13438 JDASPN(2,IDSPIN) = NSPN+3
13440 JMOSPN(NSPN+I ) = IDSPIN
13441 DECSPN(NSPN+I ) = .FALSE.
13442 IF(RSPIN(IDHW(IOUT(I))).EQ.ZERO) THEN
13443 RHOSPN(1,1,NSPN+I) = ONE
13444 RHOSPN(2,1,NSPN+I) = ZERO
13445 RHOSPN(1,2,NSPN+I) = ZERO
13446 RHOSPN(2,2,NSPN+I) = ZERO
13448 RHOSPN(1,1,NSPN+I) = HALF
13449 RHOSPN(2,1,NSPN+I) = ZERO
13450 RHOSPN(1,2,NSPN+I) = ZERO
13451 RHOSPN(2,2,NSPN+I) = HALF
13454 6 JDASPN(J,NSPN+I) =0
13456 IDSPN (NSPN-1) = NHEP-1
13457 IDSPN (NSPN ) = NHEP
13458 ISNHEP(NHEP-1) = NSPN-1
13459 ISNHEP(NHEP ) = NSPN
13461 C--perform the parton shower for the decay products of the gauge boson
13462 IF(ID1.LE.12) CALL HWBGEN
13463 C--error issue warning
13465 CALL HWWARN('HWDSM3',500)
13469 *CMZ :- -11/10/01 14:03:42 by Peter Richardson
13470 *-- Author : Peter Richardson
13471 C-----------------------------------------------------------------------
13472 SUBROUTINE HWDSM4(IOPT,ID,IOUT1,IOUT2,IMODE)
13473 C-----------------------------------------------------------------------
13474 C Subroutine to perform the four body decays
13475 C IOPT = 1 select decay mode and generate momenta
13476 C IOPT = 2 enter first decays and perform parton shower
13477 C-----------------------------------------------------------------------
13478 INCLUDE 'herwig65.inc'
13479 INTEGER IOPT,ID,IOUT1,IOUT2,IB(2),I,IDF(4),ITYPE(2),IMODE,
13480 & IDP(4+NDIAGR),ID1,ID2,J
13481 DOUBLE PRECISION CV,CA,A,B,MS,MWD,MR,M,M2,P(5,5),PW(5,2),BR
13482 COMMON/HWD4BY/A(2),B(2),MS(2),MWD(2),MR(2),M(5),M2(5),P,IDP
13484 C--generate the decay
13486 IB(1) = IDHW(IOUT1)
13487 IB(2) = IDHW(IOUT2)
13488 C--select the decays of the bosons
13490 CALL HWDBOZ(IB(I),IDF(2*I-1),IDF(2*I),CV,CA,BR,1)
13491 ITYPE(I) = IDF(2*I-1)
13492 IF(IB(I).EQ.199) ITYPE(I) = ITYPE(I)+1
13493 IF(ITYPE(I).GT.120) ITYPE(I) = ITYPE(I)-114
13494 1 IF(IB(I).NE.200) ITYPE(I) = ITYPE(I)/2
13495 C--generate the momenta of the decay products
13496 CALL HWD4ME(ID,ITYPE(1),ITYPE(2),IMODE)
13498 CALL HWVSUM(4,P(1,2*I),P(1,2*I+1),PW(1,I))
13499 2 CALL HWUMAS(PW(1,I))
13500 CALL HWVEQU(5,PW(1,1),PHEP(1,IOUT1))
13501 CALL HWVEQU(5,PW(1,2),PHEP(1,IOUT2))
13503 IDSPN(1) = JDAHEP(1,ID)
13504 DECSPN(1) = .FALSE.
13505 ISNHEP(JDAHEP(1,ID)) = 1
13509 DECSPN(I) = .FALSE.
13512 ELSEIF(IOPT.EQ.2) THEN
13513 IB(1) = JDAHEP(1,IOUT1)
13514 IB(2) = JDAHEP(1,IOUT2)
13516 ISTHEP(IB(I)) = 195
13517 JDAHEP(1,IB(I)) = NHEP+1
13518 JDAHEP(2,IB(I)) = NHEP+2
13519 C--find the ID's of the particles
13520 IF(IDHW(IB(I)).EQ.200) THEN
13522 IF(ITYPE(I).GT.6) ID1 = ID1+114
13526 IF(ITYPE(I).GT.3) ID1 = ID1+114
13528 IF(IDHW(IB(I)).EQ.198) THEN
13534 C--put id's of decay products into the event record
13537 IDHEP(NHEP+1) = IDPDG(ID1)
13538 IDHEP(NHEP+2) = IDPDG(ID2)
13539 C--boost decay products momenta to rest frame of boson
13540 CALL HWULOF(PW(1,I),P(1,2*I ),P(1,2*I ))
13541 CALL HWULOF(PW(1,I),P(1,2*I+1),P(1,2*I+1))
13542 C--boost back to lab using new boson
13543 CALL HWULOB(PHEP(1,IB(I)),P(1,2*I ),PHEP(1,NHEP+1))
13544 CALL HWULOB(PHEP(1,IB(I)),P(1,2*I+1),PHEP(1,NHEP+2))
13545 C--setup for decay to quarks
13547 ISTHEP(NHEP+1) = 113
13548 ISTHEP(NHEP+2) = 114
13549 JMOHEP(2,NHEP+1) = NHEP+2
13550 JDAHEP(2,NHEP+1) = NHEP+2
13551 JMOHEP(2,NHEP+2) = NHEP+1
13552 JDAHEP(2,NHEP+2) = NHEP+1
13553 JMOHEP(1,NHEP+1) = IB(I)
13554 JMOHEP(1,NHEP+2) = IB(I)
13555 C--setup for decay to leptons
13557 ISTHEP(NHEP+1) = 193
13558 ISTHEP(NHEP+2) = 193
13559 JMOHEP(1,NHEP+1) = IB(I)
13560 JMOHEP(1,NHEP+2) = IB(I)
13561 JMOHEP(2,NHEP+1) = JMOHEP(1,IB(I))
13562 JMOHEP(2,NHEP+2) = JMOHEP(1,IB(I))
13564 C--enter the information in the spin common block
13566 IDSPN(2*I ) = NHEP+1
13567 IDSPN(2*I+1) = NHEP+2
13568 ISNHEP(NHEP+1) = 2*I
13569 ISNHEP(NHEP+2) = 2*I+1
13572 C--perform the parton shower for the decay products of the gauge boson
13573 IF(ID1.LE.12) CALL HWBGEN
13578 *CMZ :- -17/10/01 09:42:21 by Peter Richardson
13579 *-- Author : Peter Richardson
13580 C-----------------------------------------------------------------------
13581 SUBROUTINE HWDTAU(IOPT,IHEP,POL)
13582 C-----------------------------------------------------------------------
13583 C HERWIG-TAUOLA interface to perform tau decays using TAUOLA rather
13585 C IOPT =-1 initialises
13586 C IOPT = 1 performs decay
13587 C IOPT = 2 write outs final TAUOLA information
13588 C-----------------------------------------------------------------------
13589 INCLUDE 'herwig65.inc'
13590 INTEGER IOPT,IHEP,ID,ITAU,I,IMO,NHEPPO
13591 DOUBLE PRECISION POL
13594 C--common block for PHOTOS
13596 COMMON /PHOQED/ QEDRAD(NMXHEP)
13597 C--common blocks for TAUOLA
13599 COMMON /TAUPOS/ NP1, NP2
13600 DOUBLE PRECISION Q1(4),Q2(4),P1(4),P2(4),P3(4),P4(4)
13601 COMMON / MOMDEC / Q1,Q2,P1,P2,P3,P4
13603 IF(IOPT.EQ.-1) THEN
13604 C--initialise TAUOLA
13605 CALL INIETC(JAK1,JAK2,ITDKRC,IFPHOT)
13607 CALL INIPHX(0.01d0)
13609 C--generate a decay
13610 ELSEIF(IOPT.EQ.1) THEN
13614 1 IMO = JMOHEP(1,IMO)
13615 IF(IDHW(IMO).EQ.ID) GOTO 1
13616 C--id of tau for tauola
13621 ELSEIF(ID.EQ.131) THEN
13626 CALL HWWARN('HWDTAU',501)
13628 C--set up the tau polarization
13631 POL1(3) = REAL(POL)
13634 C--three components
13637 P1(I) =-PHEP(I,IHEP)
13638 P2(I) = PHEP(I,IHEP)
13640 P1(I) = PHEP(I,IHEP)
13641 P2(I) =-PHEP(I,IHEP)
13643 C--we measure tau spins in lab frame
13650 C--perform the decay and generate QED radiation if needed
13652 CALL DEXAY(ITAU,POL1)
13653 IF(IFPHOT.EQ.1) THEN
13660 IF(NHEPPO.NE.NHEP) THEN
13661 DO 2 I=NHEPPO+1,NHEP
13662 CALL HWVEQU(4,VHEP(1,IHEP),VHEP(1,I))
13663 2 CALL HWUIDT(1,IDHEP(I),IDHW(I),DUMMY)
13665 C--write out info at end
13666 ELSEIF(IOPT.EQ.2) THEN
13667 CALL DEXAY(100,POL1)
13668 C--otherwise issue warning
13670 CALL HWWARN('HWDTAU',500)
13674 *CMZ :- -26/04/91 14.55.44 by Federico Carminati
13675 *-- Author : Bryan Webber
13676 C-----------------------------------------------------------------------
13677 SUBROUTINE HWDTHR(P0,P1,P2,P3,WEIGHT)
13678 C-----------------------------------------------------------------------
13679 C GENERATES THREE-BODY DECAY 0->1+2+3 DISTRIBUTED
13680 C ACCORDING TO PHASE SPACE * WEIGHT
13681 C-----------------------------------------------------------------------
13683 DOUBLE PRECISION HWRGEN,HWRUNI,A,B,C,D,AA,BB,CC,DD,EE,FF,PP,QQ,WW,
13684 & RR,PCM1,PC23,WEIGHT,P0(5),P1(5),P2(5),P3(5),P23(5),TWO
13685 EXTERNAL HWRGEN,HWRUNI,WEIGHT
13686 PARAMETER (TWO=2.D0)
13691 CALL HWWARN('HWDTHR',100)
13704 C CHOOSE MASS OF SUBSYSTEM 23 WITH PRESCRIBED DISTRIBUTION
13706 10 FF=HWRUNI(0,BB,CC)
13709 WW=WEIGHT(FF,A,B,C)**2
13711 IF (PP*QQ*WW.LT.RR*RR) GOTO 10
13713 C FF IS MASS SQUARED OF SUBSYSTEM 23.
13715 C DO 2-BODY DECAYS 0->1+23, 23->2+3
13718 PCM1=SQRT(PP)*0.5/P0(5)
13719 PC23=SQRT(QQ)*0.5/P23(5)
13720 CALL HWDTWO(P0,P1,P23,PCM1,TWO,.TRUE.)
13721 CALL HWDTWO(P23,P2,P3,PC23,TWO,.TRUE.)
13725 *CMZ :- -09/12/92 11.03.46 by Bryan Webber
13726 *-- Author : Bryan Webber
13727 C-----------------------------------------------------------------------
13728 SUBROUTINE HWDTOP(DECAY)
13729 C-----------------------------------------------------------------------
13730 C DECIDES WHETHER TO DO TOP QUARK DECAY BEFORE HADRONIZATION
13731 C-----------------------------------------------------------------------
13732 INCLUDE 'herwig65.inc'
13734 DECAY=RMASS(6).GT.130D0
13737 *CMZ :- -27/01/94 17.38.49 by Mike Seymour
13738 *-- Author : Bryan Webber & Mike Seymour
13739 C-----------------------------------------------------------------------
13740 SUBROUTINE HWDTWO(P0,P1,P2,PCM,COSTH,ZAXIS)
13741 C-----------------------------------------------------------------------
13742 C GENERATES DECAY 0 -> 1+2
13744 C PCM IS CM MOMENTUM
13746 C COSTH = COS THETA IN P0 REST FRAME (>1 FOR ISOTROPIC)
13747 C IF ZAXIS=.TRUE., COS THETA IS MEASURED FROM THE ZAXIS
13748 C IF .FALSE., IT IS MEASURED FROM P0'S DIRECTION
13749 C-----------------------------------------------------------------------
13751 DOUBLE PRECISION HWRUNI,ONE,ZERO,PCM,COSTH,C,S,P0(5),P1(5),P2(5),
13755 PARAMETER (ZERO=0.D0, ONE=1.D0)
13756 C--CHOOSE C.M. ANGLES
13758 IF (C.GT.ONE) C=HWRUNI(0,-ONE,ONE)
13760 CALL HWRAZM(PCM*S,PP(1),PP(2))
13761 C--PP IS MOMENTUM OF 2 IN C.M.
13763 PP(4)=SQRT(P2(5)**2+PCM**2)
13765 C--ROTATE IF NECESSARY
13766 IF (COSTH.LE.ONE.AND..NOT.ZAXIS) THEN
13767 CALL HWUROT(P0,ONE,ZERO,R)
13768 CALL HWUROB(R,PP,PP)
13770 C--BOOST FROM C.M. TO LAB FRAME
13771 CALL HWULOB(P0,PP,P2)
13772 CALL HWVDIF(4,P0,P2,P1)
13775 *CMZ :- -26/04/91 11.11.55 by Bryan Webber
13776 *-- Author : Bryan Webber
13777 C-----------------------------------------------------------------------
13778 FUNCTION HWDWWT(EMSQ,A,B,C)
13779 C-----------------------------------------------------------------------
13780 C MATRIX ELEMENT SQUARED FOR V-A WEAK DECAY
13781 C-----------------------------------------------------------------------
13783 DOUBLE PRECISION HWDWWT,EMSQ,A,B,C
13784 HWDWWT=(A-EMSQ)*(EMSQ-B)*C
13787 *CMZ :- -26/06/01 14.44.53 by Stefano Moretti
13788 *-- Author : Stefano Moretti
13789 C-----------------------------------------------------------------------
13790 FUNCTION HWDHWT(EMSQ,DUMMYA,DUMMYB,DUMMYC)
13791 C-----------------------------------------------------------------------
13792 C MATRIX ELEMENT SQUARED FOR
13793 C ((V-A)*TB1+(V+A)*CT1)*((V-A)*TB2+(V+A)*CT2)) WEAK DECAY
13794 C-----------------------------------------------------------------------
13795 INCLUDE 'herwig65.inc'
13797 COMMON/SFF/IT1,IB1,IT2,IB2
13798 DOUBLE PRECISION TB,BT
13799 INTEGER IT1,IB1,IT2,IB2
13800 DOUBLE PRECISION TBH,HBT,CB1,TB1,CB2,TB2
13801 DOUBLE PRECISION DUMMYA,DUMMYB,DUMMYC
13802 DOUBLE PRECISION HWDHWT,EMSQ
13807 C use formula (4.52) page 217 of `Higgs Hunter Guide'.
13808 TBH=(TB1+CB1-EMSQ)*(TB1*TB*TB+CB1/TB/TB)+4.*TB1*CB1
13809 C use formula (B. 1) page 411 of `Higgs Hunter Guide'.
13810 HBT=(EMSQ-TB2-CB2)*(TB2*BT*BT+CB2/BT/BT)-4.*TB2*CB2
13812 HWDHWT=ABS(HWDHWT)*SQRT(EMSQ)
13815 *CMZ :- -07/09/00 10:06:23 by Peter Richardson
13816 *-- Author : Ian Knowles
13817 C-----------------------------------------------------------------------
13818 SUBROUTINE HWDXLM(DKVRTX,STAB)
13819 C-----------------------------------------------------------------------
13820 C Sets STAB=.TRUE. if DKVRTX lies outside the specified region.
13821 C Revised 05/09/00 by BRW to put parameters in common
13822 C-----------------------------------------------------------------------
13823 INCLUDE 'herwig65.inc'
13824 DOUBLE PRECISION DKVRTX(4),RR
13827 RR=DKVRTX(1)**2+DKVRTX(2)**2
13828 IF (IOPDKL.EQ.1) THEN
13829 C Cylindrical geometry
13830 IF (RR.GE.DXRCYL**2.OR.ABS(DKVRTX(3)).GE.DXZMAX) STAB=.TRUE.
13831 ELSEIF (IOPDKL.EQ.2) THEN
13832 C Spherical geometry
13834 IF (RR.GE.DXRSPH**2) STAB=.TRUE.
13836 C User supplied geometry -- missing
13837 CALL HWWARN('HWDXLM',500)
13841 *CMZ :- -11/05/01 15.44.55 by Mike Seymour
13842 *-- Author : Mike Seymour
13843 C-----------------------------------------------------------------------
13845 C-----------------------------------------------------------------------
13846 C INTEGRAND OF BEAMSTRAHLUNG FUNCTION INTEGRATION
13847 C NOTE THAT THE JACOBIAN TRANSFORMATION (1-Z)^ETA HAS ETA HARDCODED
13848 C-----------------------------------------------------------------------
13850 DOUBLE PRECISION HWECIR,Y,Z,ETA,CIRCEE
13854 HWECIR=(1-Z)**ETA/(1-ETA)*CIRCEE(Z,-1D0)/SQRT(CIRCEE(-1D0,-1D0))
13857 *CMZ :- -15/07/02 17.56.53 by Peter Richardson
13858 *-- Author : Bryan Webber
13859 C-----------------------------------------------------------------------
13861 C-----------------------------------------------------------------------
13862 C TERMINAL CALCULATIONS ON ELEMENTARY PROCESS
13863 C Modified 28/03/01 by BRW to handle negative weights
13864 C Modified 15/07/02 by PR for Les Houches Accord
13865 C-----------------------------------------------------------------------
13866 INCLUDE 'herwig65.inc'
13868 DOUBLE PRECISION RNWGT,SPWGT,ERWGT
13869 C--Les Houches Common Block
13871 PARAMETER(MAXPUP=100)
13872 INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP
13873 DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP
13874 COMMON /HEPRUP/ IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2),
13875 & IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),
13876 & XMAXUP(MAXPUP),LPRUP(MAXPUP)
13877 IF(TAUDEC.EQ.'TAUOLA') CALL HWDTAU(2,0,0.0D0)
13878 IF (NWGTS.EQ.0) THEN
13881 10 FORMAT(10X,'NO WEIGHTS GENERATED')
13884 C--output Les Houches common block information
13885 IF(IPROC.LE.0) THEN
13886 C--WRITE THE HEADER
13889 C--FOR THE FIRST WEIGHT OPTION CALCULATE THE CROSS SECTION
13890 IF(ABS(IDWTUP).EQ.1) THEN
13892 RNWGT = 1.0D0/DBLE(LHIWGT(I))
13893 LHXSCT(I) = LHWGT(I)*RNWGT
13894 LHXERR(I) = SQRT(MAX(LHWGTS(I)*RNWGT-LHXSCT(I)**2,ZERO))
13895 LHXERR(I) = LHXERR(I)*SQRT(RNWGT)
13896 LHXSCT(I) = LHXSCT(I)*1.0D3
13897 LHXERR(I) = LHXERR(I)*1.0D3
13898 LHXMAX(I) = LHXMAX(I)*1.0D3
13900 C--FOR THE SECOND WEIGHT OPTION THIS WAS AN INPUT
13901 ELSEIF(ABS(IDWTUP).EQ.2) THEN
13903 LHXMAX(I) = LHXMAX(I)*1.0D3
13906 IF(ABS(IDWTUP).LE.2) THEN
13910 WRITE(6,15) LPRUP(I),LHXSCT(I),LHXERR(I),LHXMAX(I)*1.0D-3,
13912 AVWGT = AVWGT+LHXSCT(I)
13913 ERWGT = ERWGT+LHXERR(I)**2
13915 AVWGT = AVWGT*1.0D-3
13916 ERWGT = SQRT(ERWGT)*1.0D-3
13918 RNWGT=1./FLOAT(NWGTS)
13919 IF (NEGWTS) AVABW=ABWSUM*RNWGT
13921 SPWGT=SQRT(MAX(WSQSUM*RNWGT-AVWGT**2,ZERO))
13922 ERWGT=SPWGT*SQRT(RNWGT)
13923 IF (.NOT.NOWGT) WGTMAX=AVWGT
13924 IF (WGTMAX.EQ.ZERO) WGTMAX=ONE
13926 C--STANDARD HERWIG OPTION
13928 RNWGT=1./FLOAT(NWGTS)
13929 IF (NEGWTS) AVABW=ABWSUM*RNWGT
13931 SPWGT=SQRT(MAX(WSQSUM*RNWGT-AVWGT**2,ZERO))
13932 ERWGT=SPWGT*SQRT(RNWGT)
13933 IF (.NOT.NOWGT) WGTMAX=AVWGT
13934 IF (WGTMAX.EQ.ZERO) WGTMAX=ONE
13936 C--PRINT OUT THE INFO
13938 1 FORMAT(/10X,'OUTPUT ON ELEMENTARY PROCESS'/)
13940 WRITE (6,12) NEVHEP,NNEGEV,NWGTS,NNEGWT,AVWGT,SPWGT,
13941 & AVABW,WBIGST,WGTMAX,IPROC,
13942 & 1000.*AVWGT,1000.*ERWGT,100.*AVWGT/WGTMAX
13944 WRITE (6,11) NEVHEP,NWGTS,AVWGT,SPWGT,WBIGST,WGTMAX,
13946 & 1000.*AVWGT,1000.*ERWGT,100.*AVWGT/WGTMAX
13949 & 10X,'N.B. NEGATIVE WEIGHTS NOT ALLOWED'//
13950 & 10X,'NUMBER OF EVENTS = ',I11/
13951 & 10X,'NUMBER OF WEIGHTS = ',I11/
13952 & 10X,'MEAN VALUE OF WGT =',E12.4/
13953 & 10X,'RMS SPREAD IN WGT =',E12.4/
13954 & 10X,'ACTUAL MAX WEIGHT =',E12.4/
13955 & 10X,'ASSUMED MAX WEIGHT =',E12.4//
13956 & 10X,'PROCESS CODE IPROC = ',I11/
13957 & 10X,'CROSS SECTION (PB) =',G12.4/
13958 & 10X,'ERROR IN C-S (PB) =',G12.4/
13959 & 10X,'EFFICIENCY PERCENT =',G12.4)
13961 & 10X,'N.B. NEGATIVE WEIGHTS ALLOWED'//
13962 & 10X,'NUMBER OF EVENTS = ',I11/
13963 & 10X,'NEGATIVE EVENTS = ',I11/
13964 & 10X,'NUMBER OF WEIGHTS = ',I11/
13965 & 10X,'NEGATIVE WEIGHTS = ',I11/
13966 & 10X,'MEAN VALUE OF WGT =',E12.4/
13967 & 10X,'RMS SPREAD IN WGT =',E12.4/
13968 & 10X,'MEAN ABS WEIGHT =',E12.4/
13969 & 10X,'ACTUAL MAX ABS WGT =',E12.4/
13970 & 10X,'ASSUMED MAXABS WGT =',E12.4//
13971 & 10X,'PROCESS CODE IPROC = ',I11/
13972 & 10X,'CROSS SECTION (PB) =',G12.4/
13973 & 10X,'ERROR IN C-S (PB) =',G12.4/
13974 & 10X,'EFFICIENCY PERCENT =',G12.4)
13975 13 FORMAT(/1P,10X,'OUTPUT ON LES HOUCHES EVENTS'/)
13976 14 FORMAT(/1P,5X,' PROC CODE',1X,' XSECT(pb) ',1X,
13977 & ' XERR(pb) ',1X,' Max wgt(nb)',1X,'No. of events'/)
13978 15 FORMAT(5X,I7,E15.5,1X,E15.5,1X,E15.5,2X,I7)
13981 *CMZ :- -26/04/91 11.11.55 by Bryan Webber
13982 *-- Author : Bryan Webber & Luca Stanco
13983 C-----------------------------------------------------------------------
13984 SUBROUTINE HWEGAM(IHEP,ZMI,ZMA,WWA)
13985 C-----------------------------------------------------------------------
13986 C GENERATES A PHOTON IN WEIZSACKER-WILLIAMS (WWA=.TRUE.) OR
13987 C ELSE EQUIVALENT PHOTON APPROX FROM INCOMING E+, E-, MU+ OR MU-
13988 C-----------------------------------------------------------------------
13989 INCLUDE 'herwig65.inc'
13990 DOUBLE PRECISION HWRGEN,HWRUNI,EGMIN,ZMIN,ZMAX,ZGAM,SS,ZMI,ZMA,
13991 & PPL,PMI,QT2,Q2,QQMIN,QQMAX,S0,A
13992 INTEGER IHEP,IHADIS
13994 EXTERNAL HWRGEN,HWRUNI
13997 IF (IERROR.NE.0) RETURN
13998 IF (IHEP.LT.1.OR.IHEP.GT.2) CALL HWWARN('HWEGAM',500)
14000 IF (IHEP.EQ.1) THEN
14004 IF (JDAHEP(1,IHADIS).NE.0) IHADIS=JDAHEP(1,IHADIS)
14006 C---DEFINE LIMITS FOR GAMMA MOMENTUM FRACTION
14007 IF (ZMI.LE.ZERO .OR. ZMA.GT.ONE) THEN
14009 IF (S0.GT.ZERO) THEN
14010 S0 = (SQRT(S0)+ABS(PHEP(5,IHADIS)))**2-PHEP(5,IHADIS)**2
14011 S0 = MAX(S0,WHMIN**2)
14012 ZMIN = S0 / (SS**2 - PHEP(5,IHEP)**2 - PHEP(5,IHADIS)**2)
14015 C---UNKNOWN PROCESS: USE ENERGY CUTOFF, AND WARN USER
14016 IF (FSTWGT) CALL HWWARN('HWEGAM',1)
14017 ZMIN = EGMIN / PHEP(4,IHEP)
14024 C---APPLY USER DEFINED CUTS YWWMIN,YWWMAX AND INDIRECT LIMITS ON Z
14026 ZMIN=MAX(ZMIN,YWWMIN,SQRT(Q2WWMN)/ABS(PHEP(3,IHEP)))
14027 ZMAX=MIN(ZMAX,YWWMAX)
14029 ZMAX=MIN(ZMAX,1-PHEP(5,IHEP)/PHEP(4,IHEP))
14031 IF (ZMIN.GE.ZMAX) THEN
14035 C---GENERATE GAMMA MOMENTUM FRACTION
14037 10 IF (HWRGEN(2).LT.A) THEN
14038 ZGAM=(ZMIN/ZMAX)**HWRGEN(1)*ZMAX
14040 ZGAM=(ZMAX-ZMIN)*HWRGEN(1)+ZMIN
14042 GAMWT = GAMWT * .5*ALPHEM/PIFAC *
14043 + (1+(1-ZGAM)**2)/(A/LOG(ZMAX/ZMIN)+(1-A)/(ZMAX-ZMIN)*ZGAM)
14045 GAMWT = GAMWT * LOG((ONE-ZGAM)/ZGAM*(SS/PHEP(5,IHEP))**2)
14047 C---Q2WWMN AND Q2WWMX ARE USER-DEFINED LIMITS IN THE Q**2 INTEGRATION
14048 QQMAX=MIN(Q2WWMX,(ZGAM*PHEP(3,IHEP))**2)
14049 QQMIN=MAX(Q2WWMN,(PHEP(5,IHEP)*ZGAM)**2/(1.-ZGAM))
14050 IF (QQMIN.GT.QQMAX) THEN
14051 CALL HWWARN('HWEGAM',50)
14054 Q2=EXP(HWRUNI(0,LOG(QQMIN),LOG(QQMAX)))
14055 GAMWT = GAMWT * LOG(QQMAX/QQMIN)
14057 IF (GAMWT.LT.ZERO) GAMWT=ZERO
14063 JMOHEP(1,NHEP)=IHEP
14067 JDAHEP(1,IHEP)=NHEP
14069 C---FOR COLLINEAR KINEMATICS, ZGAM IS THE ENERGY FRACTION
14070 PHEP(4,NHEP)=PHEP(4,IHEP)*ZGAM
14071 PHEP(3,NHEP)=PHEP(3,IHEP)-SIGN(SQRT(
14072 & (PHEP(4,IHEP)-PHEP(4,NHEP))**2-PHEP(5,IHEP)**2),PHEP(3,IHEP))
14075 CALL HWUMAS(PHEP(1,NHEP))
14077 C---FOR EXACT KINEMATICS, ZGAM IS TAKEN TO BE FRACTION OF (E+PZ)
14078 PPL=ZGAM*(ABS(PHEP(3,IHEP))+PHEP(4,IHEP))
14079 QT2=(ONE-ZGAM)*Q2-(ZGAM*PHEP(5,IHEP))**2
14081 PHEP(5,NHEP)=-SQRT(Q2)
14082 PHEP(4,NHEP)=(PPL+PMI)/TWO
14083 PHEP(3,NHEP)=SIGN((PPL-PMI)/TWO,PHEP(3,IHEP))
14084 CALL HWRAZM(SQRT(QT2),PHEP(1,NHEP),PHEP(2,NHEP))
14086 C---UPDATE OVERALL CM FRAME
14087 JMOHEP(IHEP,3)=NHEP
14088 CALL HWVDIF(4,PHEP(1,3),PHEP(1,IHEP),PHEP(1,3))
14089 CALL HWVSUM(4,PHEP(1,NHEP),PHEP(1,3),PHEP(1,3))
14090 CALL HWUMAS(PHEP(1,3))
14091 C---FILL OUTGOING LEPTON
14093 IDHW(NHEP)=IDHW(IHEP)
14095 IDHEP(NHEP)=IDHEP(IHEP)
14096 JMOHEP(1,NHEP)=IHEP
14100 JDAHEP(2,IHEP)=NHEP
14101 CALL HWVDIF(4,PHEP(1,IHEP),PHEP(1,NHEP-1),PHEP(1,NHEP))
14102 PHEP(5,NHEP)=PHEP(5,IHEP)
14105 *CMZ :- -18/04/04 10.45.55 by Mike Seymour
14106 *-- Author : Bryan Webber & Luca Stanco
14107 C-----------------------------------------------------------------------
14108 SUBROUTINE HWEGAS(S0)
14109 C-----------------------------------------------------------------------
14110 C FIND MINIMUM INVARIANT MASS SQUARED NEEDED FOR HARD PROCESS, S0
14111 C-----------------------------------------------------------------------
14112 INCLUDE 'herwig65.inc'
14113 DOUBLE PRECISION S0,RPM(2)
14115 IF (IPRO.EQ.13.OR.IPRO.EQ.14) THEN
14117 ELSEIF(IPRO.EQ.15.OR.IPRO.EQ.18.OR.IPRO.EQ.22.OR.IPRO.EQ.24.OR.
14118 & IPRO.EQ.50.OR.IPRO.EQ.53.OR.IPRO.EQ.55)THEN
14120 ELSEIF (IPRO.EQ.17.OR.IPRO.EQ.51) THEN
14121 HQ = MOD(IPROC,100)
14122 S0 = 4.D0*(PTMIN**2+RMASS(HQ)**2)
14123 ELSEIF (IPRO.EQ.16.OR.IPRO.EQ.19.OR.
14124 & IPRO.EQ.25.OR.IPRO.EQ.26.OR.IPRO.EQ.27.OR.
14126 S0 = MAX(2*RMASS(1),RMASS(201)-GAMMAX*GAMH)**2
14127 ELSEIF ((IPRO.EQ.31).OR.(IPRO.EQ.32)) THEN
14128 S0 = MAX(2*RMASS(1),RMASS(201+IHIGGS))**2
14129 ELSEIF (IPRO.EQ.33) THEN
14130 IF((MOD(IPROC,10000).EQ.3350).OR.
14131 & (MOD(IPROC,10000).EQ.3355))THEN
14132 S0 = MAX(2*RMASS(1),RMASS(206))**2
14133 ELSEIF(MOD(IPROC,10000).EQ.3315)THEN
14134 S0 = MAX(2*RMASS(1),RMASS(206),RMASS(203))**2
14135 ELSEIF(MOD(IPROC,10000).EQ.3325)THEN
14136 S0 = MAX(2*RMASS(1),RMASS(206),RMASS(204))**2
14137 ELSEIF(MOD(IPROC,10000).EQ.3335)THEN
14138 S0 = MAX(2*RMASS(1),RMASS(206),RMASS(205))**2
14139 ELSEIF(MOD(IPROC,10000).EQ.3365)THEN
14140 S0 = MAX(2*RMASS(1),RMASS(205),RMASS(203))**2
14141 ELSEIF(MOD(IPROC,10000).EQ.3375)THEN
14142 S0 = MAX(2*RMASS(1),RMASS(205),RMASS(204))**2
14144 S0 = MAX(2*RMASS(1),RMASS(201+IHIGGS))**2
14146 ELSEIF ((IPRO.EQ.34).OR.(IPRO.EQ.35)) THEN
14147 S0 = MAX(RMASS(5),RMASS(201+IHIGGS))**2
14148 ELSEIF (IPRO.EQ.36.OR.IPRO.EQ.37) THEN
14149 S0 = MAX(2*RMASS(1),RMASS(201+IHIGGS))**2
14150 ELSEIF (IPRO.EQ.38) THEN
14151 IF((MOD(IPROC,10000).EQ.3839).OR.
14152 & (MOD(IPROC,10000).EQ.3869).OR.
14153 & (MOD(IPROC,10000).EQ.3899))THEN
14154 S0 = MAX(RMASS(6),RMASS(206))**2
14156 S0 = RMASS(201+IHIGGS)**2
14158 ELSEIF (IPRO.EQ.23) THEN
14159 S0 = MAX(2*RMASS(1),RMASS(201)-GAMMAX*GAMH)**2
14160 S0 = (PTMIN+SQRT(PTMIN**2+S0))**2
14161 ELSEIF (IPRO.EQ.20) THEN
14163 ELSEIF (IPRO.EQ.21) THEN
14164 S0 = (PTMIN+SQRT(PTMIN**2+RMASS(198)**2))**2
14166 ELSEIF (IPRO.EQ.30) THEN
14167 S0 = 4.0D0*(PTMIN**2+RMMNSS**2)
14168 ELSEIF(IPRO.EQ.40.OR.IPRO.EQ.41) THEN
14169 HQ = MOD(IPROC,100)
14172 IF(HQ.GE.10.AND.HQ.LT.20) THEN
14173 RPM(1) = ABS(RMASS(450))
14174 IF(HQ.GT.10) RPM(1) = ABS(RMASS(449+MOD(HQ,10)))
14175 ELSEIF(HQ.GE.20.AND.HQ.LT.30) THEN
14176 RPM(1) = ABS(RMASS(454))
14177 IF(HQ.GT.20) RPM(1) = ABS(RMASS(453+MOD(HQ,20)))
14178 ELSEIF(HQ.EQ.30) THEN
14179 RPM(1) = RMASS(449)
14180 ELSEIF(HQ.EQ.40) THEN
14181 IF(IPRO.EQ.40) THEN
14182 RPM(1) = RMASS(425)
14184 RPM(1) = MIN(RPM(1),RMASS(425+I))
14187 RPM(1) = MIN(RMASS(405),RMASS(406))
14189 RPM(2) = RMASS(198)
14190 ELSEIF(HQ.EQ.50) THEN
14191 IF(IPRO.EQ.40) THEN
14192 RPM(1) = RMASS(425)
14194 RPM(1) = MIN(RPM(1),RMASS(425+I))
14197 RPM(2) = MIN(RPM(1),RMASS(433+2*I))
14199 RPM(1) = MIN(RPM(1),RPM(2))
14200 RPM(2) = RMASS(203)
14202 RPM(2) = MIN(RPM(2),RMASS(204+I))
14205 RPM(1) = RMASS(401)
14206 RPM(2) = RMASS(413)
14208 RPM(1) = MIN(RPM(1),RMASS(401+I))
14209 RPM(2) = MIN(RPM(2),RMASS(413+I))
14211 RPM(1) = MIN(RPM(1),RPM(2))
14212 RPM(2) = RMASS(203)
14214 RPM(2) = MIN(RPM(2),RMASS(204+I))
14217 RPM(2) = RMASS(203)
14219 RPM(2) = MIN(RPM(2),RMASS(204+I))
14221 ELSEIF(HQ.GE.60) THEN
14226 S0 = RPM(1)+RPM(2)+TWO*(PTMIN**2+
14227 & SQRT(RPM(1)*RPM(2)+PTMIN**2*(RPM(1)+RPM(2)+PTMIN**2)))
14230 ELSEIF (IPRO.EQ.42) THEN
14232 ELSEIF (IPRO.EQ.52) THEN
14233 HQ = MOD(IPROC,100)
14234 S0 = (PTMIN+SQRT(PTMIN**2+RMASS(HQ)**2))**2
14235 ELSEIF (IPRO.EQ.60) THEN
14236 HQ = MOD(IPROC,100)
14240 IF (HQ.GT.6) HQ=2*HQ+107
14241 IF (HQ.EQ.127) HQ=198
14242 S0 = 4.D0*(PTMIN**2+RMASS(HQ)**2)
14244 ELSEIF (IPRO.EQ.80) THEN
14246 ELSEIF (IPRO.EQ.90) THEN
14248 ELSEIF (IPRO.EQ.91.OR.IPRO.EQ.92) THEN
14249 S0 = Q2MIN+4.D0*PTMIN**2
14250 HQ = MOD(IPROC,100)
14251 IF (HQ.GT.0) S0 = S0+4.D0*RMASS(HQ)**2
14252 IF (IPRO.EQ.91) S0 = MAX(S0,EMMIN**2)
14258 *CMZ :- -26/04/91 12.42.30 by Federico Carminati
14259 *-- Author : Bryan Webber
14260 C-----------------------------------------------------------------------
14262 C-----------------------------------------------------------------------
14263 C INITIALISES ELEMENTARY PROCESS
14264 C Modified 28/03/01 by BRW to handle negative weights
14265 C-----------------------------------------------------------------------
14266 INCLUDE 'herwig65.inc'
14267 DOUBLE PRECISION HWRSET,DUMMY,SAFETY
14269 PARAMETER (SAFETY=1.001)
14271 C---NO OF WEIGHT GENERATED
14274 C---ACCUMULATED WEIGHTS
14277 C---ACCUMULATED WEIGHT-SQUARED
14279 C---CURRENT MAX WEIGHT
14281 C---LAST VALUE OF SCALE
14283 C---NUMBER OF ERRORS REPORTED
14285 C---NUMBER OF ERRORS UNREPORTED
14287 C---FIND MAXIMUM ABSOLUTE WEIGHT IN CASES WHERE THIS IS REQUIRED
14289 IF (WGTMAX.EQ.ZERO.AND.IPROC.GT.0) THEN
14291 DUMMY = HWRSET(IBRN)
14292 WRITE(6,10) IPROC,IBRN,NBSH
14293 10 FORMAT(/10X,'INITIAL SEARCH FOR MAX WEIGHT'//
14294 & 10X,'PROCESS CODE IPROC = ',I11/
14295 & 10X,'RANDOM NO. SEED 1 = ',I11/
14296 & 10X,' SEED 2 = ',I11/
14297 & 10X,'NUMBER OF SHOTS = ',I11)
14303 20 FORMAT(/10X,'INITIAL SEARCH FINISHED')
14304 IF (WBIGST*NWGTS.LT.SAFETY*WGTSUM)
14305 & WGTMAX=SAFETY*WBIGST
14314 WRITE(6,21) AVWGT,WGTMAX
14315 21 FORMAT(/1P,10X,'INPUT EVT WEIGHT =',E12.4/
14316 & 10X,'INPUT MAX WEIGHT =',E12.4)
14319 C---RESET RANDOM NUMBER
14320 DUMMY = HWRSET(NRN)
14324 *CMZ :- -01/04/99 19.55.17 by Mike Seymour
14325 *-- Author : Mike Seymour
14326 C-----------------------------------------------------------------------
14327 SUBROUTINE HWEISR(IHEP)
14328 C-----------------------------------------------------------------------
14329 C GENERATES AN ISR PHOTON FROM INCOMING E+, E-, MU+ OR MU-
14330 C-----------------------------------------------------------------------
14331 INCLUDE 'herwig65.inc'
14332 DOUBLE PRECISION CIRCKP(2)
14333 COMMON /HWCIR2/CIRCKP
14334 DOUBLE PRECISION HWRGEN,QSQMAX,QSQMIN,A,B,B1,B2,B3,B4,B5,B6,B7,B8,
14335 $ R,AA,T0,T1,C1,C2,T,Z(2),QSQ(2),PHI(2),C,NWID,NMASS
14339 C---IF ZMXISR IS ZERO, THERE CAN BE NO ISR
14340 IF (ZMXISR.EQ.ZERO.OR.(IPRO.GT.3.AND.IPRO.LT.6)
14341 & .OR.IPRO.GT.12.OR.IPROC.EQ.850) RETURN
14342 C---CHECK CONSISTENCY OF TMNISR AND ZMXISR
14343 IF (ZMXISR**2.LT.TMNISR) CALL HWWARN('HWEISR',200)
14344 C---CALCULATE VIRTUALITY LIMITS
14345 QSQMAX=4*PHEP(4,IHEP)**2
14346 QSQMIN=PHEP(5,IHEP)**2
14347 C---AND THEREFORE THE Z DEPENDENCE
14349 B=A*(LOG(QSQMAX/QSQMIN)-1)
14350 C---DECIDE HOW MUCH WEIGHT TO GIVE THE Z RESONANCE
14351 IF (IHEP.EQ.1) THEN
14352 IF (IPRO.EQ.1.OR.IPRO.EQ.6.OR.IPRO.EQ.8) THEN
14354 ELSEIF (IPRO.EQ.2) THEN
14356 ELSEIF (IPRO.EQ.3.OR.IPRO.EQ.7.OR.IPRO.EQ.10.OR.IPRO.EQ.11) THEN
14358 ELSEIF (IPRO.EQ.9) THEN
14360 IF((MOD(IPROC,10000).EQ.960).OR.
14361 & (MOD(IPROC,10000).EQ.970))THEN
14369 C--set up the parameters for the resonance
14371 C--first the standard parameters if smoothing the Z resonance
14372 T0=RMASS(200)**2/QSQMAX
14373 T1=GAMZ*RMASS(200)/QSQMAX
14375 C--now the parameters for a resonant sneutrino in RPV
14376 C--uses the average of the muon and tau sneutrino mass and either the
14377 C--larger width or the difference in masses (whichever is larger)
14378 NMASS = HALF*(RMASS(428)+RMASS(430))
14379 NWID = MAX(HBAR/RLTIM(428),HBAR/RLTIM(430))
14380 NWID = MAX(NWID,ABS(RMASS(428)-RMASS(430)))
14381 T0 = NMASS**2/QSQMAX
14382 T1 = NWID*NMASS/QSQMAX
14384 IF (T0.GT.ONE) THEN
14389 C---GENERATE A T VALUE BETWEEN TMNISR AND 1 ACCORDING TO:
14390 C ( b**2*log(zmxisr**2/t)/t + 2*b*(1-(1-zmxisr)**b)*((1-t)**(2*b-1)+1/t
14391 C +(1-t0)**(2b-1)*aa*t1/((t-t0)**2+t1**2)) ) *theta(zmxisr**2-t)
14392 C +( 2*b*(1-zmxisr)**b*((1-t)**(b-1)+1/t
14393 C +(1-t0)**(b-1)*aa*t1/((t-t0)**2+t1**2)) ) *theta(zmxisr-t)
14394 C +( (1-zmxisr)**(2*b) ) *delta(1-t)
14395 B1=(1-ZMXISR)**(2*B)
14396 B2=B1+2*(1-ZMXISR)**B*((1-TMNISR)**B-(1-ZMXISR)**B)
14397 B3=B2+2*B*(1-ZMXISR)**B*LOG(ZMXISR/TMNISR)
14398 B4=B3+2*B*(1-ZMXISR)**B*AA*(1-T0)**(B-1)
14399 $ *(ATAN((ZMXISR-T0)/T1)-ATAN((TMNISR-T0)/T1))
14400 B5=B4+(1-(1-ZMXISR)**B)*((1-TMNISR)**(2*B)-(1-ZMXISR**2)**(2*B))
14401 B6=B5+2*B*(1-(1-ZMXISR)**B)*LOG(ZMXISR**2/TMNISR)
14402 B7=B6+B**2*LOG(ZMXISR**2/TMNISR)**2/2
14403 B8=B7+2*B*(1-(1-ZMXISR)**B)*AA*(1-T0)**(2*B-1)
14404 $ *(ATAN((ZMXISR**2-T0)/T1)-ATAN((TMNISR-T0)/T1))
14411 ELSEIF (R.LE.B4) THEN
14415 T=1-(1-TMNISR)*(1-R*(1-((1-ZMXISR)/(1-TMNISR))**B))**(1/B)
14416 ELSEIF (R.LE.B3) THEN
14418 T=(TMNISR/ZMXISR)**R*ZMXISR
14422 $ ATAN((ZMXISR-T0)/T1)*R+ATAN((TMNISR-T0)/T1)*(1-R))
14424 GAMWT=GAMWT*B8/(2*B*(1-ZMXISR)**B*((1-T)**(B-1)+1/T+
14425 $ (1-T0)**(B-1)*AA*T1/((T-T0)**2+T1**2)))
14427 IF (HWRGEN(1).GT.HALF) Z(1)=T
14434 $ (1-R*(1-((1-ZMXISR**2)/(1-TMNISR))**(2*B)))**(.5/B)
14435 ELSEIF (R.LE.B6) THEN
14437 T=(TMNISR/ZMXISR**2)**R*ZMXISR**2
14438 ELSEIF (R.LE.B7) THEN
14440 T=(TMNISR/ZMXISR**2)**SQRT(R)*ZMXISR**2
14444 $ ATAN((ZMXISR**2-T0)/T1)*R+ATAN((TMNISR-T0)/T1)*(1-R))
14446 GAMWT=GAMWT*B8/(B**2*LOG(ZMXISR**2/T)/T
14447 $ + 2*B*(1-(1-ZMXISR)**B)*((1-T)**(2*B-1)+1/T+
14448 $ (1-T0)**(B-1)*AA*T1/((T-T0)**2+T1**2)))
14449 C---GENERATE A Z VALUE BETWEEN T/ZMXISR AND ZMXISR ACCORDING TO:
14450 C 1/z+(1-z)**(b-1)+t/z**2*(1-t/z)**(b-1)
14451 C1=LOG(ZMXISR**2/T)
14452 C2=C1+2/B*((1-T/ZMXISR)**B-(1-ZMXISR)**B)
14453 IF (C2.GT.ZERO) THEN
14456 Z(1)=(T/ZMXISR**2)**HWRGEN(5)*ZMXISR
14458 Z(1)=1-(1-T/ZMXISR)*
14459 $ (1-HWRGEN(6)*(1-((1-ZMXISR)/(1-T/ZMXISR))**B))**(1/B)
14460 IF (2*R.LE.C2+C1) Z(1)=T/Z(1)
14465 GAMWT=GAMWT*C2/Z(1)
14466 $ /(1/Z(1)+(1-Z(1))**(B-1)+T/Z(1)**2*(1-T/Z(1))**(B-1))
14468 C---INCLUDE DISTRIBUTION FUNCTIONS
14471 IF (Z(I).GT.ZMXISR) THEN
14473 CIRCKP(I)=(1-ZMXISR)**B*EXP(3*B/4)*(1-B**2*PIFAC**2/12)
14475 CIRCKP(I)=(B*(1-Z(I))**(B-1)*(1+Z(I)**2)/2
14476 $ *EXP(B*Z(I)/2*(1+Z(I)/2))*(1-B**2*PIFAC**2/12)
14477 $ +B**2/8*((1+Z(I))*((1+Z(I))**2+3*LOG(Z(I)))
14478 $ -4*LOG(Z(I))/(1-Z(I))))
14480 GAMWT=GAMWT*CIRCKP(I)
14482 C---CHOOSE BOTH QSQ VALUES
14484 IF (Z(I).GT.ZMXISR .OR. COLISR) THEN
14488 C---ACCORDING TO 1/(QSQ+QSQMIN) FROM 0 TO (1-Z)*(T/(Z+T))*QSQMAX
14489 20 QSQ(I)=(((1-Z(I))*(T/(Z(I)+T))
14490 $ *QSQMAX/QSQMIN+1)**HWRGEN(7)-1)*QSQMIN
14491 C---AND REJECT TO QSQ/(QSQ+QSQMIN)**2
14492 IF (HWRGEN(8)*(QSQ(I)+QSQMIN).GT.QSQ(I)) GOTO 20
14495 C---CHOOSE BOTH AZIMUTHS
14496 PHI(1)=HWRGEN(9)*2*PIFAC
14497 PHI(2)=HWRGEN(10)*2*PIFAC
14498 C---USE S-HAT PRESCRIPTION TO MODIFY Z VALUES
14500 IF ((1-Z(1))*QSQ(1).GT.(1-Z(2))*QSQ(2)) I=1
14501 IF ((1-Z(2))*QSQ(2).GT.(1-Z(1))*QSQ(1)) I=2
14504 Z(I)=Z(I)+QSQ(I)/QSQMAX
14505 IF (QSQ(J).GT.ZERO) THEN
14506 Z(J)=((QSQ(I)*QSQMAX+QSQ(J)*QSQMAX
14507 $ -QSQ(I)*QSQ(J))/QSQMAX**2+T)/Z(I)
14508 C=COS(PHI(1)-PHI(2))*SQRT(QSQ(1)*QSQ(2))/QSQMAX
14509 Z(J)=Z(J)+(-2*C**2*(1-Z(I))+2*C*SQRT((1-Z(I))
14510 $ *(C**2*(1-Z(I))+Z(I)**2*(1-Z(J)))))/Z(I)**2
14513 ELSEIF (IHEP.EQ.2) THEN
14514 C---EVERYTHING WAS GENERATED LAST TIME
14516 C---ROUTINE CALLED UNEXPECTEDLY
14517 CALL HWWARN('HWEISR',201)
14519 C---IF Z IS TOO LARGE THERE IS NO EMISSION
14520 IF (Z(IHEP).GT.ZMXISR) RETURN
14521 C---PUT NEW LEPTON IN EVENT RECORD
14523 IDHW(NHEP)=IDHW(IHEP)
14524 IDHEP(NHEP)=IDHEP(IHEP)
14526 JMOHEP(1,NHEP)=IHEP
14530 JDAHEP(1,IHEP)=NHEP
14531 C---AND OUTGOING PHOTON
14536 JMOHEP(1,NHEP)=IHEP
14540 JDAHEP(2,IHEP)=NHEP
14541 C---RECONSTRUCT PHOTON KINEMATICS (Z IS LIGHT-CONE MOMENTUM FRACTION)
14542 PHEP(1,NHEP)=SQRT(QSQ(IHEP)*(1-Z(IHEP)))*COS(PHI(IHEP))
14543 PHEP(2,NHEP)=SQRT(QSQ(IHEP)*(1-Z(IHEP)))*SIN(PHI(IHEP))
14544 PHEP(3,NHEP)=(1-Z(IHEP))*PHEP(4,IHEP)-QSQ(IHEP)/(4*PHEP(4,IHEP))
14545 IF (IHEP.EQ.2) PHEP(3,NHEP)=-PHEP(3,NHEP)
14546 PHEP(4,NHEP)=(1-Z(IHEP))*PHEP(4,IHEP)+QSQ(IHEP)/(4*PHEP(4,IHEP))
14549 CALL HWVDIF(4,PHEP(1,IHEP),PHEP(1,NHEP),PHEP(1,NHEP-1))
14550 CALL HWUMAS(PHEP(1,NHEP-1))
14551 C---UPDATE OVERALL CM FRAME
14552 JMOHEP(IHEP,3)=NHEP-1
14553 CALL HWVDIF(4,PHEP(1,3),PHEP(1,IHEP),PHEP(1,3))
14554 CALL HWVSUM(4,PHEP(1,NHEP-1),PHEP(1,3),PHEP(1,3))
14555 CALL HWUMAS(PHEP(1,3))
14558 *CMZ :- -26/04/91 11.11.55 by Bryan Webber
14559 *-- Author : Bryan Webber
14560 C-----------------------------------------------------------------------
14562 C-----------------------------------------------------------------------
14563 C SETS UP 2->1 (COLOUR SINGLET) HARD SUBPROCESS
14564 C-----------------------------------------------------------------------
14565 INCLUDE 'herwig65.inc'
14566 DOUBLE PRECISION PA
14567 INTEGER ICMF,I,IBM,IHEP
14572 C---FIND BEAM AND TARGET
14573 IF (JDAHEP(1,I).NE.0) IBM=JDAHEP(1,I)
14576 IDHEP(IHEP)=IDPDG(IDN(I))
14578 JMOHEP(1,IHEP)=ICMF
14579 JMOHEP(I,ICMF)=IHEP
14580 JDAHEP(1,IHEP)=ICMF
14581 C---SPECIAL - IF INCOMING PARTON IS INCOMING BEAM THEN COPY IT
14582 IF (XX(I).EQ.ONE.AND.IDHW(IBM).EQ.IDN(I)) THEN
14583 CALL HWVEQU(5,PHEP(1,IBM),PHEP(1,IHEP))
14584 IF (I.EQ.2) PHEP(3,IHEP)=-PHEP(3,IHEP)
14588 PHEP(5,IHEP)=RMASS(IDN(I))
14589 PA=XX(I)*(PHEP(4,IBM)+ABS(PHEP(3,IBM)))
14590 PHEP(4,IHEP)=0.5*(PA+PHEP(5,IHEP)**2/PA)
14591 PHEP(3,IHEP)=PA-PHEP(4,IHEP)
14594 PHEP(3,NHEP+2)=-PHEP(3,NHEP+2)
14595 C---HARD CENTRE OF MASS
14597 IDHEP(ICMF)=IDPDG(IDCMF)
14599 CALL HWVSUM(4,PHEP(1,NHEP+1),PHEP(1,NHEP+2),PHEP(1,ICMF))
14600 CALL HWUMAS(PHEP(1,ICMF))
14601 C---SET UP COLOUR STRUCTURE LABELS
14602 JMOHEP(2,NHEP+1)=NHEP+2
14603 JDAHEP(2,NHEP+1)=NHEP+2
14604 JMOHEP(2,NHEP+2)=NHEP+1
14605 JDAHEP(2,NHEP+2)=NHEP+1
14606 JDAHEP(1,NHEP+3)=NHEP+3
14607 JDAHEP(2,NHEP+3)=NHEP+3
14611 *CMZ :- -15/07/02 17.56.53 by Peter Richardson
14612 *-- Author : Bryan Webber
14613 C-----------------------------------------------------------------------
14615 C-----------------------------------------------------------------------
14616 C WHEN NEVHEP=0, CHOOSES X VALUES AND FINDS WEIGHT FOR PROCESS IPROC
14617 C OTHERWISE, CHOOSES AND LOADS ALL VARIABLES FOR HARD PROCESS
14618 C modifications for Les Houches accord by PR (7/15/02)
14619 C-----------------------------------------------------------------------
14620 INCLUDE 'herwig65.inc'
14621 DOUBLE PRECISION CIRCKP(2)
14622 COMMON /HWCIR2/CIRCKP
14623 DOUBLE PRECISION Z1,Z2,C1,C2,B1,B2,CIRCEE,CIRCGG,RS,MISS,ETA,
14624 $ HWUGAU,HWECIR,QMX1,QMN1,QMX2,QMN2,TEST
14627 DOUBLE PRECISION HWRGEN
14628 EXTERNAL HWRGEN,HWECIR
14629 C--Les Houches Common Block
14631 PARAMETER(MAXPUP=100)
14632 INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP
14633 DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP
14634 COMMON /HEPRUP/ IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2),
14635 & IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),
14636 & XMAXUP(MAXPUP),LPRUP(MAXPUP)
14637 IF (IERROR.NE.0) RETURN
14638 C--pick the type of event to generate if using Les Houches accord
14639 C--first choice according to maxiumum weight
14640 IF(IPROC.LT.0) THEN
14641 IF(ABS(IDWTUP).EQ.1) THEN
14642 IF(ITYPLH.EQ.0) THEN
14643 TEST = HWRGEN(1)*LHMXSM
14645 IF(TEST.LE.ABS(LHXMAX(ITYPLH))) GOTO 5
14646 TEST = TEST-ABS(LHXMAX(ITYPLH))
14648 5 WGTMAX = ABS(LHXMAX(ITYPLH))
14649 WBIGST = ABS(LHXMAX(ITYPLH))
14651 C--second choice according to cross section
14652 ELSEIF(ABS(IDWTUP).EQ.2) THEN
14653 IF(ITYPLH.EQ.0) THEN
14654 TEST = HWRGEN(1)*LHMXSM
14656 IF(TEST.LE.ABS(LHXSCT(ITYPLH))) GOTO 6
14657 TEST = TEST-ABS(LHXSCT(ITYPLH))
14659 6 WGTMAX = ABS(LHXMAX(ITYPLH))
14660 WBIGST = ABS(LHXMAX(ITYPLH))
14668 C---ROUTINE LOOPS BACK TO HERE IF GENERATED WEIGHT WAS NOT ACCEPTED
14670 C---FSTWGT IS .TRUE. DURING FIRST CALL TO HARD PROCESS ROUTINE
14672 C---FSTEVT IS .TRUE. THROUGHOUT THE FIRST EVENT
14674 C---SET COLOUR CORRECTION TO FALSE
14678 C---SET UP INITIAL STATE
14683 PHEP(3,NHEP)=PBEAM1
14684 PHEP(4,NHEP)=EBEAM1
14685 PHEP(5,NHEP)=RMASS(IPART1)
14691 IDHEP(NHEP)=IDPDG(IPART1)
14696 PHEP(3,NHEP)=-PBEAM2
14697 PHEP(4,NHEP)=EBEAM2
14698 PHEP(5,NHEP)=RMASS(IPART2)
14704 IDHEP(NHEP)=IDPDG(IPART2)
14705 C---NEXT ENTRY IS OVERALL CM FRAME
14710 JMOHEP(1,NHEP)=NHEP-2
14711 JMOHEP(2,NHEP)=NHEP-1
14714 CALL HWVSUM(4,PHEP(1,NHEP-1),PHEP(1,NHEP-2),PHEP(1,NHEP))
14715 CALL HWUMAS(PHEP(1,NHEP))
14716 C Select a primary interaction point
14720 CALL HWVZRO(4,VTXPIP)
14722 CALL HWVEQU(3,VTXPIP,VHEP(1,NHEP))
14724 C---GENERATE PHOTONS (WEIZSACKER-WILLIAMS APPROX)
14725 C FOR HADRONIC PROCESSES WITH LEPTON BEAMS
14727 IF (IPRO.GT.12.AND.IPRO.LT.90) THEN
14728 IF (CIRCOP.EQ.0) THEN
14729 IF (ABS(IDHEP(1)).EQ.11.OR.ABS(IDHEP(1)).EQ.13)
14730 & CALL HWEGAM(1,ZERO, ONE,.FALSE.)
14731 IF (ABS(IDHEP(2)).EQ.11.OR.ABS(IDHEP(2)).EQ.13)
14732 & CALL HWEGAM(2,ZERO, ONE,.FALSE.)
14734 C---MODIFIED TO USE CIRCE FOR BEAMSTRAHLUNG EFFECTS
14735 IF (ABS(IDHEP(1)).NE.11.OR.IDHEP(1)+IDHEP(2).NE.0) STOP
14736 $ 'This version only works for e+e- annihilation'
14738 RS=NINT(PHEP(5,3)*10)/1D1
14739 CALL CIRCES(ZERO,ZERO,RS,CIRCAC,CIRCVR,CIRCRV,CIRCCH)
14741 CALL HWEGAM(1,ZERO, ONE,.TRUE.)
14742 CALL HWEGAM(2,ZERO, ONE,.TRUE.)
14743 Z1=PHEP(4,4)/PHEP(4,1)
14744 Z2=PHEP(4,6)/PHEP(4,2)
14745 C---FACTORIZE THE DISTRIBUTIONS FROM CIRCE
14746 C1=CIRCGG(Z1,-1D0)/SQRT(CIRCGG(-1D0,-1D0))
14747 C2=CIRCGG(-1D0,Z2)/SQRT(CIRCGG(-1D0,-1D0))
14748 C---REMOVE SPURIOUS WEIGHT GIVEN IN HWEGAM
14749 GAMWT=GAMWT/(.5*ALPHEM/PIFAC*(1+(1-Z1)**2)/Z1*
14750 $ LOG((ONE-Z1)/Z1*4*PHEP(4,1)*PHEP(4,2)/PHEP(5,1)**2))
14751 $ /(.5*ALPHEM/PIFAC*(1+(1-Z2)**2)/Z2*
14752 $ LOG((ONE-Z2)/Z2*4*PHEP(4,4)*PHEP(4,2)/PHEP(5,1)**2))
14753 C---REPLACE IT BY THE SUM OF BEAM AND BREM STRAHLUNG
14754 QMX1=MIN(Q2WWMX,(Z1*PHEP(3,1))**2)
14755 QMN1=MAX(Q2WWMN,(PHEP(5,1)*Z1)**2/(1-Z1))
14756 QMX2=MIN(Q2WWMX,(Z2*PHEP(3,2))**2)
14757 QMN2=MAX(Q2WWMN,(PHEP(5,2)*Z2)**2/(1-Z2))
14758 B1=.5*ALPHEM/PIFAC*(1+(1-Z1)**2)/Z1*LOG(QMX1/QMN1)
14759 B2=.5*ALPHEM/PIFAC*(1+(1-Z2)**2)/Z2*LOG(QMX2/QMN2)
14760 IF (CIRCOP.EQ.1) THEN
14762 ELSEIF (CIRCOP.EQ.2) THEN
14764 ELSEIF (CIRCOP.EQ.3) THEN
14765 GAMWT=GAMWT*(C1+B1)*(C2+B2)
14767 STOP 'Illegal value of circop!'
14770 ELSEIF (IPRO.GE.90) THEN
14771 IF (CIRCOP.NE.0) STOP 'Circe not interfaced for DIS processes'
14772 IF (ABS(IDHEP(2)).EQ.11.OR.ABS(IDHEP(2)).EQ.13)
14773 & CALL HWEGAM(2,ZERO, ONE,.FALSE.)
14775 C---GENERATE ISR PHOTONS FOR LEPTONIC PROCESSES
14776 IF (IPRO.GT.0.AND.IPRO.LE.12) THEN
14777 IF (CIRCOP.EQ.0) THEN
14781 C---MODIFIED TO USE CIRCE FOR BEAMSTRAHLUNG EFFECTS
14782 IF (ABS(IDHEP(1)).NE.11.OR.IDHEP(1)+IDHEP(2).NE.0) STOP
14783 $ 'This version only works for e+e- annihilation'
14785 RS=NINT(PHEP(5,3)*10)/1D1
14786 CALL CIRCES(ZERO,ZERO,RS,CIRCAC,CIRCVR,CIRCRV,CIRCCH)
14787 C---PRECALCULATE THE PART OF THE SPECTRUM MISSED BETWEEN ZMXISR AND 1
14789 MISS=HWUGAU(HWECIR,1D-15**(1-ETA),(1-ZMXISR)**(1-ETA),1D-12)
14795 IF (JDAHEP(1,IHAD).NE.0) IHAD=JDAHEP(1,IHAD)
14796 Z1=PHEP(4,IHAD)/PHEP(4,1)
14798 IF (JDAHEP(1,IHAD).NE.0) IHAD=JDAHEP(1,IHAD)
14799 Z2=PHEP(4,IHAD)/PHEP(4,2)
14800 C---FACTORIZE THE DISTRIBUTIONS FROM CIRCE
14801 C1=CIRCEE(Z1,-1D0)/SQRT(CIRCEE(-1D0,-1D0))
14802 C2=CIRCEE(-1D0,Z2)/SQRT(CIRCEE(-1D0,-1D0))
14803 IF (Z1.EQ.ONE) C1=C1+MISS
14804 IF (Z2.EQ.ONE) C2=C2+MISS
14805 C---REMOVE WEIGHT GIVEN IN HWEISR
14808 GAMWT=GAMWT/(B1*B2)
14809 C---REPLACE IT BY THE SUM OF BEAM AND BREM STRAHLUNG
14810 IF (CIRCOP.EQ.1) THEN
14812 ELSEIF (CIRCOP.EQ.2) THEN
14814 ELSEIF (CIRCOP.EQ.3) THEN
14815 C---IN THE APPROXIMATION OF DOMINANCE BY THE DELTA-FUNCTION TERM
14816 IF (Z1.EQ.ONE) C1=C1-1
14817 IF (Z2.EQ.ONE) C2=C2-1
14818 C---IF IT DOES NOT DOMINATE, ZMXISR SHOULD BE DECREASED
14819 IF (B1+C1.LT.ZERO) CALL HWWARN('HWEPRO',501)
14820 IF (B2+C2.LT.ZERO) CALL HWWARN('HWEPRO',502)
14821 GAMWT=GAMWT*(C1+B1)*(C2+B2)
14823 STOP 'Illegal value of circop!'
14827 C---IF USER LIMITS WERE TOO TIGHT, MIGHT NOT BE ANY PHASE-SPACE
14828 IF (GAMWT.LE.ZERO) GOTO 30
14829 C---IF CMF HAS ACQUIRED A TRANSVERSE BOOST, OR USER REQUESTS IT ANYWAY,
14830 C BOOST EVENT RECORD BACK TO CMF
14831 IF (PHEP(1,3)**2+PHEP(2,3)**2.GT.ZERO .OR. USECMF) CALL HWUBST(1)
14832 C---ROUTINE LOOPS BACK TO HERE IF GENERATED WEIGHT WAS ACCEPTED
14834 IPRO=MOD(IPROC/100,100)
14835 C---PROCESS GENERATED BY LES HOUCHES INTERFACE
14838 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
14839 ELSEIF (IPRO.EQ.1) THEN
14840 IF (IPROC.LT.110.OR.IPROC.GE.120) THEN
14841 C--- E+E- -> Q-QBAR OR L-LBAR
14844 C--- E+E- -> Q-QBAR-GLUON
14847 ELSEIF (IPRO.EQ.2) THEN
14850 ELSEIF (IPRO.EQ.3) THEN
14853 ELSEIF (IPRO.EQ.4) THEN
14854 C---E+E- -> NUEB NUE H
14856 ELSEIF (IPRO.EQ.5 .AND. IPROC.LT.550) THEN
14857 C---EE -> EE GAMGAM -> EE FFBAR/WW
14859 ELSEIF (IPRO.EQ.5) THEN
14860 C---EE -> ENU GAMW -> ENU FF'BAR/WZ
14862 ELSEIF (IPRO.EQ.6) THEN
14863 C---EE -> FOUR JETS
14865 ELSEIF(IPRO.EQ.7) THEN
14866 C--EE -> SUSY PARTICLES(PAIR PRODUCTION)
14868 ELSEIF(IPRO.EQ.8) THEN
14869 C--EE -> RPV SUSY PARTICLE PRODUCTION
14871 ELSEIF (IPRO.EQ.9) THEN
14872 IF((MOD(IPROC,10000).EQ.955).OR.
14873 & (MOD(IPROC,10000).EQ.965).OR.
14874 & (MOD(IPROC,10000).EQ.975))THEN
14875 C---MSSM Higgs pair production in l+l-: H+ H- and A0 Higgs, Higgs=h0,H0.
14877 ELSEIF((MOD(IPROC,10000).EQ.910).OR.
14878 & (MOD(IPROC,10000).EQ.920))THEN
14879 C---MSSM scalar Higgs production from vector-vector fusion.
14881 ELSEIF((MOD(IPROC,10000).EQ.960).OR.
14882 & (MOD(IPROC,10000).EQ.970))THEN
14883 C---MSSM scalar Higgs production from Higgs-strahlung.
14886 ELSEIF ((IPRO.EQ.10).OR.(IPRO.EQ.11)) THEN
14887 C---SM/MSSM Higgs production with heavy quark flavours via e+e-.
14889 ELSEIF (IPRO.EQ.13) THEN
14890 C---GAMMA/Z0/Z' DRELL-YAN PROCESS
14892 ELSEIF (IPRO.EQ.14) THEN
14893 C---W+/- PRODUCTION VIA DRELL-YAN PROCESS
14895 ELSEIF (IPRO.EQ.15) THEN
14896 C---QCD HARD 2->2 PROCESSES
14898 ELSEIF ((IPRO.EQ.16).OR.(IPRO.EQ.36)) THEN
14899 C---SM/MSSM HIGGS PRODUCTION VIA QUARK/GLUON FUSION
14901 ELSEIF (IPRO.EQ.17) THEN
14902 C---QCD HEAVY FLAVOUR PRODUCTION
14904 ELSEIF (IPRO.EQ.18) THEN
14905 C---QCD DIRECT PHOTON + JET PRODUCTION
14907 ELSEIF ((IPRO.EQ.19).OR.(IPRO.EQ.37)) THEN
14908 C---SM/MSSM HIGGS PRODUCTION VIA W/Z FUSION
14910 ELSEIF (IPRO.EQ.20) THEN
14911 C---TOP PRODUCTION FROM W EXCHANGE
14913 ELSEIF (IPRO.EQ.21) THEN
14914 C---VECTOR BOSON + JET PRODUCTION
14916 ELSEIF (IPRO.EQ.22) THEN
14917 C QCD direct photon pair production
14919 ELSEIF (IPRO.EQ.23) THEN
14920 C QCD Higgs plus jet production
14922 ELSEIF (IPRO.EQ.24) THEN
14923 C---COLOUR-SINGLET EXCHANGE
14925 ELSEIF (IPRO.EQ.25) THEN
14926 C---SM Higgs production with heavy quark flavours via qq and gg.
14928 ELSEIF ((IPRO.EQ.26).OR.(IPRO.EQ.27)) THEN
14929 C---SM Higgs production with heavy gauge bosons via qq(').
14931 C---Gauge boson pair in hadron hadron
14932 ELSEIF (IPRO.EQ.28) THEN
14933 IF (MOD(IPROC,10000).LT.2850) THEN
14938 C--Vector boson + two jets
14939 ELSEIF(IPRO.EQ.29) THEN
14941 ELSEIF (IPRO.EQ.30) THEN
14942 C---HADRON-HADRON SUSY PROCESSES
14944 ELSEIF ((IPRO.EQ.31).OR.(IPRO.EQ.32)) THEN
14945 C---MSSM charged/neutral Higgs production in association with squarks.
14947 ELSEIF (IPRO.EQ.33) THEN
14948 IF(MOD(IPROC,10000).EQ.3350)THEN
14949 C---MSSM charged Higgs production in association with W: W+H- + W-H+.
14951 ELSEIF((MOD(IPROC,10000).EQ.3310).OR.
14952 & (MOD(IPROC,10000).EQ.3320).OR.
14953 & (MOD(IPROC,10000).EQ.3360).OR.
14954 & (MOD(IPROC,10000).EQ.3370))THEN
14955 C---MSSM Higgs production with heavy gauge bosons via qq(').
14958 C---MSSM charged/neutral Higgs pair production.
14961 ELSEIF (IPRO.EQ.34) THEN
14962 C---MSSM charged/neutral Higgs production via bg fusion.
14964 ELSEIF (IPRO.EQ.35) THEN
14965 C---MSSM charged Higgs production via bq fusion.
14967 ELSEIF (IPRO.EQ.38) THEN
14968 C---MSSM charged/neutral Higgs production with heavy quarks via qq and gg.
14970 ELSEIF(IPRO.EQ.40.OR.IPRO.EQ.41) THEN
14971 C---HADRON-HADRON R-PARITY VIOLATING SUSY PROCESSES
14973 ELSEIF (IPRO.EQ.42) THEN
14974 C---SPIN-TWO RESONANCE
14976 ELSEIF (IPRO.EQ.50) THEN
14977 C Point-like photon two-jet production
14979 ELSEIF (IPRO.EQ.51) THEN
14980 C Point-like photon/QCD heavy flavour pair production
14982 ELSEIF (IPRO.EQ.52) THEN
14983 C Point-like photon/QCD heavy flavour single excitation
14985 ELSEIF (IPRO.EQ.53) THEN
14986 C Compton scattering of point-like photon and (anti)quark
14988 ELSEIF (IPRO.EQ.55) THEN
14989 C Point-like photon/higher twist meson production
14991 ELSEIF (IPRO.EQ.60) THEN
14992 C---QPM GAMMA-GAMMA-->QQBAR
14994 ELSEIF (IPRO.GE.70.AND.IPRO.LE.79) THEN
14995 C---BARYON-NUMBER VIOLATION, AND OTHER MULTI-W PRODUCTION PROCESSES
14997 ELSEIF (IPRO.EQ.80) THEN
14998 C---MINIMUM-BIAS: NO HARD SUBPROCESS
15001 ELSEIF (IPRO.EQ.90) THEN
15004 ELSEIF(IPRO.EQ.91) THEN
15005 C---BOSON - GLUON(QUARK) FUSION --> ANTIQUARK(GLUON) + QUARK
15007 ELSEIF(IPRO.EQ.92) THEN
15008 C---DEEP INELASTIC WITH EXTRA JET: OBSOLETE PROCESS
15010 40 FORMAT (1X,' IPROC=92** is no longer supported.'
15011 & /1X,' Please use IPROC=91** instead.')
15012 CALL HWWARN('HWEPRO',500)
15013 ELSEIF(IPRO.EQ.95) THEN
15014 C---HIGGS PRODUCTION VIA W FUSION IN E P
15016 C !!!!!!!!! IPRO >=0 NOT USED BY LH INTERFACE
15018 C---UNKNOWN PROCESS
15019 CALL HWWARN('HWEPRO',102)
15022 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
15027 IF (EVWGT.LT.ZERO) THEN
15037 C--New call spin correlation code if needed
15038 IF(SYSPIN.AND.(IPRO.EQ. 1.OR.IPRO.EQ.13.OR.IPRO.EQ.14.OR.
15039 & IPRO.EQ.15.OR.IPRO.EQ.17.OR.IPRO.EQ.20.OR.
15040 & IPRO.EQ. 7.OR.IPRO.EQ.30.OR.IPRO.EQ.40.OR.
15041 & IPRO.EQ.41.OR.IPRO.EQ.8)) CALL HWHSPN
15042 C--generate additional photon radiation in top production
15043 IF(ITOPRD.EQ.1.AND.MOD(IPROC,10000).EQ.1706) CALL HWPHTT
15046 C---IF AN EVENT IS CANCELLED BEFORE IT IS GENERATED, GIVE IT ZERO WEIGHT
15047 IF (IERROR.NE.0) THEN
15054 IF (EVWGT.LT.ZERO) THEN
15058 IF (EVWGT.LT.-1.D-9) CALL HWWARN('HWEPRO',3)
15063 WGTSUM=WGTSUM+EVWGT
15064 WSQSUM=WSQSUM+EVWGT**2
15065 ABWSUM=ABWSUM+ABWGT
15066 C--weight addition for Les Houches accord
15067 IF(IPROC.LE.0) THEN
15068 IF(ABS(IDWTUP).EQ.1) THEN
15069 LHWGT (ITYPLH) = LHWGT (ITYPLH)+EVWGT
15070 LHWGTS(ITYPLH) = LHWGTS(ITYPLH)+EVWGT**2
15071 LHIWGT(ITYPLH) = LHIWGT(ITYPLH)+1
15074 IF (ABWGT.GT.WBIGST) THEN
15076 IF (NOWGT.AND.WBIGST.GT.WGTMAX) THEN
15077 IF (NEVHEP.NE.0) CALL HWWARN('HWEPRO',1)
15079 WRITE (6,99) WGTMAX
15080 C--additional for Les Houche accord
15081 IF(IPROC.LE.0) THEN
15082 IF(ABS(IDWTUP).EQ.1)
15083 & LHMXSM = LHMXSM-LHXMAX(ITYPLH)+ABWGT
15084 LHXMAX(ITYPLH) = EVWGT
15088 IF (NEVHEP.NE.0) THEN
15089 C---LOW EFFICIENCY WARNINGS:
15090 C WARN AT 10*EFFMIN, STOP AT EFFMIN
15091 IF (10*EFFMIN*NWGTS.GT.NEVHEP) THEN
15092 IF (EFFMIN*NWGTS.GT.NEVHEP) THEN
15094 CALL HWWARN('HWEPRO',200)
15096 IF (EFFMIN.GT.ZERO) THEN
15097 IF (MOD(NWGTS,INT(10/EFFMIN)).EQ.0) THEN
15098 CALL HWWARN('HWEPRO',2)
15099 WRITE (6,98) WGTMAX
15104 GENEV=ABWGT.GT.WGTMAX*HWRGEN(0)
15106 GENEV=ABWGT.NE.ZERO
15112 98 FORMAT(10X,' MAXIMUM WEIGHT =',1PG24.16)
15113 99 FORMAT(10X,'NEW MAXIMUM WEIGHT =',1PG24.16)
15117 *CMZ :- -26/04/91 11.11.55 by Bryan Webber
15118 *-- Author : Bryan Webber
15119 C-----------------------------------------------------------------------
15120 SUBROUTINE HWETWO(SMR3,SMR4)
15121 C-----------------------------------------------------------------------
15122 C SETS UP 2->2 HARD SUBPROCESS
15123 c BRW change 18/8/04: BW smearing of mass i only if SMRi is true
15124 C-----------------------------------------------------------------------
15125 INCLUDE 'herwig65.inc'
15126 DOUBLE PRECISION HWUMBW,HWUPCM,PA,PCM
15127 INTEGER ICMF,IBM,I,J,K,IHEP,NTRY
15134 C---FIND BEAM AND TARGET
15135 IF (JDAHEP(1,I).NE.0) IBM=JDAHEP(1,I)
15138 IDHEP(IHEP)=IDPDG(IDN(I))
15140 JMOHEP(1,IHEP)=ICMF
15141 JMOHEP(I,ICMF)=IHEP
15142 JDAHEP(1,IHEP)=ICMF
15143 C---SPECIAL - IF INCOMING PARTON IS INCOMING BEAM THEN COPY IT
15144 IF (XX(I).EQ.ONE.AND.IDHW(IBM).EQ.IDN(I)) THEN
15145 CALL HWVEQU(5,PHEP(1,IBM),PHEP(1,IHEP))
15146 IF (I.EQ.2) PHEP(3,IHEP)=-PHEP(3,IHEP)
15150 PHEP(5,IHEP)=RMASS(IDN(I))
15151 PA=XX(I)*(PHEP(4,IBM)+ABS(PHEP(3,IBM)))
15152 PHEP(4,IHEP)=0.5*(PA+PHEP(5,IHEP)**2/PA)
15153 PHEP(3,IHEP)=PA-PHEP(4,IHEP)
15156 PHEP(3,NHEP+2)=-PHEP(3,NHEP+2)
15157 C---HARD CENTRE OF MASS
15159 IDHEP(ICMF)=IDPDG(IDCMF)
15161 CALL HWVSUM(4,PHEP(1,NHEP+1),PHEP(1,NHEP+2),PHEP(1,ICMF))
15162 CALL HWUMAS(PHEP(1,ICMF))
15168 IDHEP(IHEP)=IDPDG(IDN(I))
15170 JMOHEP(1,IHEP)=ICMF
15171 16 JDAHEP(I-2,ICMF)=IHEP
15174 PHEP(5,NHEP+4)=HWUMBW(IDN(3))
15176 PHEP(5,NHEP+4)=RMASS(IDN(3))
15179 PHEP(5,NHEP+5)=HWUMBW(IDN(4))
15181 PHEP(5,NHEP+5)=RMASS(IDN(4))
15183 PCM=HWUPCM(PHEP(5,NHEP+3),PHEP(5,NHEP+4),PHEP(5,NHEP+5))
15184 IF (PCM.LT.ZERO) THEN
15186 IF (NTRY.LE.NETRY) GO TO 19
15187 CALL HWWARN('HWETWO',103)
15191 PHEP(4,IHEP)=SQRT(PCM**2+PHEP(5,IHEP)**2)
15192 PHEP(3,IHEP)=PCM*COSTH
15193 PHEP(1,IHEP)=SQRT((PCM+PHEP(3,IHEP))*(PCM-PHEP(3,IHEP)))
15194 CALL HWRAZM(PHEP(1,IHEP),PHEP(1,IHEP),PHEP(2,IHEP))
15195 CALL HWULOB(PHEP(1,NHEP+3),PHEP(1,IHEP),PHEP(1,IHEP))
15196 CALL HWVDIF(4,PHEP(1,NHEP+3),PHEP(1,IHEP),PHEP(1,NHEP+5))
15197 C---SET UP COLOUR STRUCTURE LABELS
15203 JMOHEP(2,NHEP+J)=NHEP+K
15204 30 JDAHEP(2,NHEP+K)=NHEP+J
15209 *CMZ :- -26/11/00 17.21.55 by Bryan Webber
15210 *-- Author : Stefano Moretti
15211 C-----------------------------------------------------------------------
15212 SUBROUTINE HWH2BK(P1,P2,P3,P4,RMW,RMH,RES,RESL,REST)
15213 C-----------------------------------------------------------------------
15214 C...Matrix element for q(1) + q-bar(2) -> W+/-(3) + H-/+(4),
15215 C...all masses retained.
15216 C...It factorises (PIFAC*ALPHA/SWEIN/RMW/RMW/SQRT(2.))**2
15218 C...First release: 1-APR-1998 by Stefano Moretti
15219 C-----------------------------------------------------------------------
15220 INCLUDE 'herwig65.inc'
15222 DOUBLE PRECISION P1(0:3),P2(0:3),P3(0:3),P4(0:3)
15223 DOUBLE PRECISION P(0:3)
15224 DOUBLE PRECISION RES,S,T,U,MB2,MT2,MW2,MHP2,MH02,MA02,MSH2,
15225 & MGAMH0,MGAMA0,MGAMSH,PT,NC,KT2,RESL,REST
15226 DOUBLE PRECISION TT,UU,KKT2,TL
15227 DOUBLE COMPLEX Z,PV,PA
15228 DOUBLE PRECISION RMB,RMT,RMW,RMH
15229 DOUBLE PRECISION RMH01,GAMH01,
15232 DOUBLE PRECISION VP,CFC
15233 EQUIVALENCE (RMB ,RMASS( 5)),(RMT ,RMASS( 6))
15234 EQUIVALENCE (RMH01,RMASS(204)),
15235 & (RMH02,RMASS(203)),
15236 & (RMH03,RMASS(205))
15237 PARAMETER (Z=(0D0,1D0),NC=3)
15239 GAMH01=RMASS(204)/DKLTM(204)
15240 GAMH02=RMASS(203)/DKLTM(203)
15241 GAMH03=RMASS(205)/DKLTM(205)
15242 C...constant terms.
15250 MGAMH0=RMH01*GAMH01
15251 MGAMA0=RMH03*GAMH03
15252 MGAMSH=RMH02*GAMH02
15253 C...Mandelstam invariants.
15258 S=S-(P1(I)+P2(I))**2
15259 T=T-(P1(I)-P3(I))**2
15260 U=U-(P1(I)-P4(I))**2
15262 C...propagators and couplings.
15263 PV=(-SINA*COSBMA/(S-MSH2+Z*MGAMSH)
15264 & -COSA*SINBMA/(S-MH02+Z*MGAMH0) )/COSB
15265 PA= TANB/(S-MA02+Z*MGAMA0)
15267 KT2=(U*T-MHP2*MW2)/S
15269 RES=S/NC*( MB2/2.*((S-MW2-MHP2)**2-4.*MW2*MHP2)*
15270 & DREAL(DCONJG(PV)*PV+DCONJG(PA)*PA)+
15271 & MB2*TANB*PT*(MW2*MHP2-S*KT2-T**2)*DREAL(PV-PA)+
15272 & PT**2*((MT2/TANB)**2*(2.*MW2+KT2)
15273 & +MB2*TANB**2*(2.*MW2*KT2+T**2)))
15275 C...Extracts spin dependence.
15276 VP=SQRT(P3(1)**2+P3(2)**2+P3(3)**2)
15281 P(0)=VP**2/P3(0)*CFC
15285 TT=TT-(P1(I)-P(I))**2
15286 UU=UU-(P2(I)-P(I))**2
15288 KKT2=((MW2+TT)*(MW2+UU)+(MW2+MHP2-T-U)*MW2)/S
15289 TL=((TT+MW2)*(UU+MW2)*((S+U-MW2)*(TT+MW2)/(UU+MW2)-T)
15290 & +MW2*((MW2-T)*(MW2-U)-S*MW2))/S
15291 C...Longitudinal ME (along V direction).
15292 RESL=S/NC*(MB2/2.*((S-MW2-MHP2)**2-4.*MW2*MHP2)*
15293 & DREAL(DCONJG(PV)*PV+DCONJG(PA)*PA)+
15294 & MB2*TANB*PT*(MW2*MHP2-S*KT2-T**2)*DREAL(PV-PA)+
15295 & PT**2*((MT2/TANB)**2*(KKT2)
15296 & +MB2*TANB**2*(TL)))
15298 C...Transverse ME (perpendicular to V direction).
15302 *CMZ :- -27/02/01 17:04:16 by Peter Richardson
15303 *-- Author : Peter Richardson
15304 C-----------------------------------------------------------------------
15305 FUNCTION HWH2DD(ND,I,J,K,L,Z1,Z2)
15306 C-----------------------------------------------------------------------
15307 C Returns the coefficient D1-10 from Nucl. Phys. B262 (1985) 235-262
15308 C N.B. THE STRONG COUPLING AND GV+/-GA ARE INCLUDED IN THE CROSS
15310 C I-L are the particles (all outgoing)
15311 C Z1 and Z2 are the decay products of the Z
15312 C-----------------------------------------------------------------------
15313 INCLUDE 'herwig65.inc'
15314 INTEGER ND,I,J,K,L,Z1,Z2
15315 DOUBLE COMPLEX HWH2DD,ZI,S,D,F
15316 PARAMETER(ZI=(0.0D0,1.0D0))
15317 COMMON/HWHEWS/S(8,8,2),D(8,8)
15318 COMMON/HWHZBB/F(8,8)
15321 ELSEIF(ND.EQ.2) THEN
15322 HWH2DD = ZI/F(J,K)/SQRT(TWO*D(I,K))
15323 ELSEIF(ND.EQ.3) THEN
15324 HWH2DD = -ZI/F(I,K)/SQRT(TWO*D(I,K))
15325 ELSEIF(ND.EQ.4) THEN
15326 HWH2DD = -ZI/F(K,L)/(F(Z1,I)+F(Z2,I)+F(Z1,Z2))
15327 ELSEIF(ND.EQ.5) THEN
15328 HWH2DD = ZI/F(K,L)/(F(Z1,J)+F(Z2,J)+F(Z1,Z2))
15329 ELSEIF(ND.EQ.6) THEN
15330 HWH2DD = ZI*HALF/F(J,L)/(F(J,L)+F(J,K)+F(K,L))/D(K,L)
15331 ELSEIF(ND.EQ.7) THEN
15332 HWH2DD = -ZI*HALF/F(I,K)/F(J,L)/D(K,L)
15333 ELSEIF(ND.EQ.8) THEN
15334 HWH2DD = ZI*HALF/F(I,K)/(F(I,K)+F(I,L)+F(K,L))/D(K,L)
15335 ELSEIF(ND.EQ.9) THEN
15336 HWH2DD = -ZI/F(K,L)/(F(J,K)+F(J,L)+F(K,L))
15337 ELSEIF(ND.EQ.10) THEN
15338 HWH2DD = ZI/F(K,L)/(F(I,K)+F(I,L)+F(K,L))
15342 *CMZ :- -30/06/01 18.21.35 by Stefano Moretti
15343 *-- Author : Kosuke Odagiri & Stefano Moretti
15344 C-----------------------------------------------------------------------
15345 SUBROUTINE HWH2BH(P1,P2,P3,P4,P5,
15346 & EMW,EMH,EMH01,EMH02,EMH03,EMB,EMT,IFL,IRES,CKM,
15348 C-----------------------------------------------------------------------
15349 C...Matrix element for b(1) + q(2) -> b(3) + q'(4) + H+/-(5) and C.C.,
15350 C...q(q') massless incoming(outgoing) quark, all other masses retained.
15351 C...It factorises 64.*PIFAC**3*ALPHA**3/4./SWEIN/SWEIN/SWEIN/EMW/EMW.
15353 C...First release: 01-APR-1998 by Kosuke Odagiri
15354 C...First modified: 12-APR-1998 by Stefano Moretti
15355 C-----------------------------------------------------------------------
15356 INCLUDE 'herwig65.inc'
15357 INTEGER MU,IRES,IFL
15358 DOUBLE PRECISION P1(0:3),P2(0:3),P3(0:3),P4(0:3),P5(0:3)
15359 DOUBLE PRECISION EMB,EMT,EMW,EMH,EMH01,EMH02,EMH03
15360 DOUBLE PRECISION GAMT,GAMWTMP,GAMH01,GAMH03,GAMH02,CKM
15361 DOUBLE PRECISION QW(0:3),QS(0:3)
15362 DOUBLE PRECISION N0,DOTHH,DOTSS,DOTWW,E1234
15363 DOUBLE PRECISION DOTTT,DOT12,DOT13,DOT14,DOT23
15364 DOUBLE PRECISION DOT24,DOT2H,DOT34,DOT3H,DOT4H
15365 DOUBLE PRECISION PT2,PV2,PA2
15366 DOUBLE PRECISION M2
15367 DOUBLE COMPLEX PV,PA,PT,PW,Z
15368 PARAMETER (GAMWTMP=0.D0,GAMH01=0.D0,GAMH03=0.D0,GAMH02=0.D0)
15369 PARAMETER (Z=(0.D0,1.D0))
15370 DOUBLE PRECISION SC,RICCI
15374 QW(MU)=P2(MU)-P4(MU)
15375 QS(MU)=P1(MU)-P3(MU)
15381 DOT13=EMB*EMB-DOTSS/2.D0
15392 E1234=RICCI(P1,P2,P3,P4)
15393 ELSE IF(IFL.EQ.-1)THEN
15399 E1234=-RICCI(P1,P2,P3,P4)
15402 DOTTT=DOTHH+EMB*EMB+2.D0*DOT3H
15404 PV=COSA*SINBMA/(DOTSS-EMH01*EMH01+Z*EMH01*GAMH01)+
15405 1 SINA*COSBMA/(DOTSS-EMH02*EMH02+Z*EMH02*GAMH02)
15406 PA=SINB/(DOTSS-EMH03*EMH03+Z*EMH03*GAMH03)
15407 PW=1./(DOTWW-EMW*EMW+Z*EMW*GAMWTMP)
15408 C REMOVE TOP DIAGRAM.
15409 IF(IRES.EQ.1)PT=1./(DOTTT-EMT*EMT+Z*EMT*GAMT)
15410 IF(IRES.EQ.0)PT=(0.D0,0.D0)
15412 PT2 =DREAL(DCONJG(PT)*PT)
15413 PV2 =DREAL(DCONJG(PV)*PV)
15414 PA2 =DREAL(DCONJG(PA)*PA)
15418 M2=N0*N0* ( EMB*EMB/COSB/COSB*(PV2+PA2)*DOT13*
15419 & (2.D0*DOT4H*DOT2H-DOT24*DOTHH)+
15421 O (EMB*EMB*TANB*TANB*(2.D0*DOT3H*DOT4H-DOT34*DOTHH)+
15422 P EMT*EMT/TANB/TANB*(EMT*EMT*DOT34))+
15423 & EMB*EMB*TANB/COSB*DREAL(PV+PA)*
15424 X (DREAL(PT)*(4.D0*DOT4H*DOT12*DOT13-
15425 T (2.D0*DOT4H+DOTHH)*(DOT12*DOT34+DOT13*DOT24-DOT14*DOT23))+
15426 M DIMAG(PT)*(2.D0*DOT4H+DOTHH)*E1234) )
15429 DOUBLE PRECISION FUNCTION SC(A,B)
15431 DOUBLE PRECISION A(0:3),B(0:3)
15432 SC=A(0)*B(0)-A(1)*B(1)-A(2)*B(2)-A(3)*B(3)
15435 DOUBLE PRECISION FUNCTION RICCI(A,B,C,D)
15437 DOUBLE PRECISION A(0:3),B(0:3),C(0:3),D(0:3)
15439 & A(0)*B(1)*C(2)*D(3)+A(0)*B(2)*C(3)*D(1)+A(0)*B(3)*C(1)*D(2)-
15440 & A(0)*B(3)*C(2)*D(1)-A(0)*B(1)*C(3)*D(2)-A(0)*B(2)*C(1)*D(3)+
15441 & A(1)*B(0)*C(3)*D(2)+A(1)*B(2)*C(0)*D(3)+A(1)*B(3)*C(2)*D(0)-
15442 & A(1)*B(2)*C(3)*D(0)-A(1)*B(3)*C(0)*D(2)-A(1)*B(0)*C(2)*D(3)+
15443 & A(2)*B(3)*C(0)*D(1)+A(2)*B(0)*C(1)*D(3)+A(2)*B(1)*C(3)*D(0)-
15444 & A(2)*B(1)*C(0)*D(3)-A(2)*B(3)*C(1)*D(0)-A(2)*B(0)*C(3)*D(1)+
15445 & A(3)*B(2)*C(1)*D(0)+A(3)*B(0)*C(2)*D(1)+A(3)*B(1)*C(0)*D(2)-
15446 & A(3)*B(0)*C(1)*D(2)-A(3)*B(1)*C(2)*D(0)-A(3)*B(2)*C(0)*D(1)
15449 *CMZ :- -27/02/01 17:04:16 by Peter Richardson
15450 C-----------------------------------------------------------------------
15451 SUBROUTINE HWH2F1(NP,F,I,P,MQ)
15452 C-----------------------------------------------------------------------
15453 C Subroutine to implement the F function of Eijk and Kliess
15454 C fixed first momenta and all second momenta
15455 C-----------------------------------------------------------------------
15456 INCLUDE 'herwig65.inc'
15457 DOUBLE PRECISION P(5),MQ,PM(5),XMASS,PLAB,PRW,PCM,HWULDO,PDOT,EPS
15458 DOUBLE COMPLEX F(2,2,8),S,D,SIP(2),SJP(2)
15461 COMMON/HWHEWS/S(8,8,2),D(8,8)
15462 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
15463 PARAMETER(EPS=1D-10)
15464 C--find the massless momentum we need
15465 PDOT = HWULDO(PCM(1,I),P)
15466 P(5) = P(4)**2-P(1)**2-P(2)**2-P(3)**2
15467 IF(ABS(PDOT).LT.EPS.AND.ABS(P(5)).LT.EPS) THEN
15470 PDOT = HALF*P(5)/PDOT
15473 PM(J) = P(J)-PDOT*PCM(J,I)
15475 IF(P(5).GT.ZERO) THEN
15481 C--calculate its spinor product with the fixed momentum
15482 CALL HWH2SS(SIP,PCM(1,I),PM)
15483 C--calculate the F functions
15485 CALL HWH2SS(SJP,PM,PCM(1,J))
15486 F(1,1,J) = SIP(1)*SJP(2)
15487 F(1,2,J) = MQ*S(I,J,1)
15488 F(2,1,J) = MQ*S(I,J,2)
15489 F(2,2,J) = SIP(2)*SJP(1)
15493 *CMZ :- -27/02/01 17:04:16 by Peter Richardson
15494 C-----------------------------------------------------------------------
15495 SUBROUTINE HWH2F2(NP,F,I,P,MQ)
15496 C-----------------------------------------------------------------------
15497 C Subroutine to implement the F function of Eijk and Kliess
15498 C fixed second momenta and all first momenta
15499 C-----------------------------------------------------------------------
15500 INCLUDE 'herwig65.inc'
15501 DOUBLE PRECISION P(5),MQ,PM(5),XMASS,PLAB,PRW,PCM,HWULDO,PDOT,EPS
15502 DOUBLE COMPLEX F(2,2,8),S,D,SIP(2),SJP(2)
15505 COMMON/HWHEWS/S(8,8,2),D(8,8)
15506 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
15507 PARAMETER(EPS=1D-10)
15508 C--find the massless momentum we need
15509 PDOT = HWULDO(PCM(1,I),P)
15510 P(5) = P(4)**2-P(1)**2-P(2)**2-P(3)**2
15511 IF(ABS(PDOT).LT.EPS.AND.ABS(P(5)).LT.EPS) THEN
15514 PDOT = HALF*P(5)/PDOT
15517 PM(J) = P(J)-PDOT*PCM(J,I)
15519 IF(P(5).GT.ZERO) THEN
15525 C--calculate its spinor product with the fixed momentum
15526 CALL HWH2SS(SIP,PM,PCM(1,I))
15527 C--calculate the F functions
15529 CALL HWH2SS(SJP,PCM(1,J),PM)
15530 F(1,1,J) = SIP(2)*SJP(1)
15531 F(1,2,J) = MQ*S(J,I,1)
15532 F(2,1,J) = MQ*S(J,I,2)
15533 F(2,2,J) = SIP(1)*SJP(2)
15537 *CMZ :- -27/02/01 17:04:16 by Peter Richardson
15538 C-----------------------------------------------------------------------
15539 SUBROUTINE HWH2F3(NP,F,P,MQ)
15540 C-----------------------------------------------------------------------
15541 C Subroutine to implement the F function of Eijk and Kliess
15542 C All first and second momenta
15543 C-----------------------------------------------------------------------
15544 INCLUDE 'herwig65.inc'
15545 DOUBLE PRECISION P(5),MQ,PM(5),XMASS,PLAB,PRW,PCM,HWULDO,PDOT,EPS
15546 DOUBLE COMPLEX F(2,2,8,8),SIP(2),SJP(2),S,D
15548 COMMON/HWHEWS/S(8,8,2),D(8,8)
15549 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
15551 PARAMETER(EPS=1D-10)
15552 C--find the massless momentum we need
15554 PDOT = HWULDO(PCM(1,I),P)
15555 P(5) = P(4)**2-P(1)**2-P(2)**2-P(3)**2
15556 IF(ABS(PDOT).LT.EPS.AND.ABS(P(5)).LT.EPS) THEN
15559 PDOT = HALF*P(5)/PDOT
15562 PM(J) = P(J)-PDOT*PCM(J,I)
15564 IF(P(5).GT.ZERO) THEN
15570 C--calculate its spinor product with the fixed momentum
15571 CALL HWH2SS(SIP,PCM(1,I),PM)
15572 C--calculate the F functions
15574 CALL HWH2SS(SJP,PM,PCM(1,J))
15575 F(1,1,I,J) = SIP(1)*SJP(2)
15576 F(1,2,I,J) = MQ*S(I,J,1)
15577 F(2,1,I,J) = MQ*S(I,J,2)
15578 F(2,2,I,J) = SIP(2)*SJP(1)
15583 F(1,1,J,I) = F(2,2,I,J)
15584 F(1,2,J,I) = -F(1,2,I,J)
15585 F(2,1,J,I) = -F(2,1,I,J)
15586 F(2,2,J,I) = F(1,1,I,J)
15591 *CMZ :- -13/10/02 09.43.05 by Peter Richardson
15592 *-- Author : Kosuke Odagiri and Stefano Moretti
15593 C-----------------------------------------------------------------------
15594 SUBROUTINE HWH2HE(FIRST,GAUGE,IFL,IH,HFC,HBC,
15595 & E,S2W,TANB,AL,RMW,S,Q3, P3,P4,P5,
15596 & RM3,YM3,GAM3,RM4,YM4,GAM4,RM5,GAM5,
15597 & RML,GAML,RMH,GAMH,RMA,GAMA,
15598 & RMZ,GAMZ,CFAC,RES)
15599 C-----------------------------------------------------------------------
15600 C MATRIX ELEMENT SQUARED FOR
15601 C e-(1) e+(2) -> f(3) f(')bar(4) Higgs(5)
15602 C (SAME QUARK MASSES IN YUKAWA AND KINEMATICS)
15603 C-----------------------------------------------------------------------
15605 LOGICAL FIRST,GAUGE
15606 DOUBLE PRECISION HFC,HBC
15607 DOUBLE PRECISION CFAC
15608 DOUBLE PRECISION E,S2W,TANB,AL,RMW,S,Q3,RES
15609 DOUBLE PRECISION P3(0:3),P4(0:3),P5(0:3)
15610 DOUBLE PRECISION RM3,YM3,GAM3,RM4,YM4,GAM4,RM5,GAM5,RMZ,GAMZ
15611 DOUBLE PRECISION RML,GAML,RMH,GAMH,RMA,GAMA,Q2
15612 DOUBLE PRECISION XW,GE(-1:1),G3(-1:1),G4(-1:1),G5(-1:1)
15613 DOUBLE PRECISION RM(-1:1),RN1(-1:1),RN2(-1:1),RN3
15614 DOUBLE PRECISION SQS,TWOSQS,HLFSQS,P34,M34,PREFAC
15615 DOUBLE PRECISION RLE,RLLE,EP3(-1:1),EP4(-1:1),ZERO,ONE,TWO,HLF
15616 DOUBLE PRECISION BE,SA,CA,SB,CB
15617 INTEGER I,LE,L,IFL,IH
15618 DOUBLE COMPLEX PROPZ,PROP3(-1:1),PROP4(-1:1),PROP5,PROP6
15619 DOUBLE COMPLEX PROP7(-1:1)
15620 DOUBLE COMPLEX PP(-1:1),MM(-1:1),QQ(-1:1),ZP3,ZP4,ZP5
15621 PARAMETER (ZERO=0.D0,ONE=1.D0,TWO=2.D0,HLF=.5D0)
15622 SAVE XW,GE,G3,G4,G5,RM,PREFAC
15623 C QUANTITIES WHICH CAN BE COMPUTED ONLY ONCE
15625 C SOME COMMON INITIALISATIONS
15639 G3(-1)=-ONE*(-Q3/ABS(Q3))+G3(1)
15652 C MSSM SCALING FACTORS FOR COUPLINGS
15654 RM(-1)=+YM3/RMW*HFC
15655 RM(+1)=+YM4/RMW*HFC
15656 ELSE IF(IH.EQ.3)THEN
15657 RM(-1)=+YM3/RMW*HFC
15658 RM(+1)=-YM4/RMW*HFC
15661 IF(IH.EQ.1)RN1(-1)=+YM3/RMW*((2-IFL)*TANB+(IFL-1)/TANB)
15662 & *(-SQRT(ABS(ONE-HBC**2)))
15663 IF(IH.EQ.1)RN1(+1)=-YM4/RMW*((2-IFL)*TANB+(IFL-1)/TANB)
15664 & *(-SQRT(ABS(ONE-HBC**2)))
15665 IF(IH.EQ.2)RN1(-1)=-YM3/RMW*((2-IFL)*TANB+(IFL-1)/TANB)
15666 & *(+SQRT(ABS(ONE-HBC**2)))
15667 IF(IH.EQ.2)RN1(+1)=+YM4/RMW*((2-IFL)*TANB+(IFL-1)/TANB)
15668 & *(+SQRT(ABS(ONE-HBC**2)))
15671 IF(IH.EQ.0)RN3=1.D0
15674 ELSE IF(IH.EQ.3)THEN
15675 RN1(-1)=+YM3/RMW*((2-IFL)*(-SA/CB)+(IFL-1)*(+CA/SB))
15677 RN1(+1)=+YM4/RMW*((2-IFL)*(-SA/CB)+(IFL-1)*(+CA/SB))
15679 RN2(-1)=+YM3/RMW*((2-IFL)*(+CA/CB)+(IFL-1)*(+SA/SB))
15681 RN2(+1)=+YM4/RMW*((2-IFL)*(+CA/CB)+(IFL-1)*(+SA/SB))
15685 PREFAC=E**6/(XW*S)*CFAC/TWO
15696 RM(-1)=YM3*TANB/RMW
15697 RM(+1)=YM4/TANB/RMW
15703 PREFAC=E**6/(XW*S)*CFAC
15707 C SOME ENERGY CONSTANTS
15711 PROPZ=S/(XW*(TWO-XW)*DCMPLX(S-RMZ**2,-RMZ*GAMZ))
15713 P34=P3(0)*P4(0)-P3(1)*P4(1)-P3(2)*P4(2)-P3(3)*P4(3)
15716 C FF(')-BAR PROPAGATOR
15717 Q2=RM3**2+RM4**2+TWO*P34
15718 C CONSTRUCT AMPLITUDE
15722 PROP5=(GE(0)*G5(0)+GE(LE)*G5(-1)*PROPZ)/
15723 & DCMPLX(Q2-RMA**2,-RMA*GAMA)
15725 ELSE IF(IH.EQ.3)THEN
15726 PROP5=(GE(0)*G5(0)+GE(LE)*G5(-1)*PROPZ)/
15727 & DCMPLX(Q2-RML**2,-RML*GAML)
15728 PROP6=(GE(0)*G5(0)+GE(LE)*G5(-1)*PROPZ)/
15729 & DCMPLX(Q2-RMH**2,-RMH*GAMH)
15731 PROP5=(GE(0)*G5(0)+GE(LE)*G5(-1)*PROPZ)/
15732 & DCMPLX(Q2-RM5**2,-RM5*GAM5)
15734 ZP3=DCMPLX(P3(1),-RLE*P3(2))
15735 ZP4=DCMPLX(P4(1),-RLE*P4(2))
15738 PROP3(L)=(GE(0)*G3(0)+GE(LE)*G3(L)*PROPZ)/
15739 & DCMPLX(S-TWOSQS*P3(0),-RM3*GAM3)
15740 PROP4(L)=(GE(0)*G4(0)+GE(LE)*G4(L)*PROPZ)/
15741 & DCMPLX(S-TWOSQS*P4(0),-RM4*GAM4)
15742 PROP7(L)=GE(LE)*G3(L)*PROPZ/DCMPLX(Q2-RMZ**2,-RMZ*GAMZ)
15745 PP(L)=-RM(-L)*SQS*(PROP3(L)+PROP4(-L))
15746 MM(L)=RM3*RM(+L)*(PROP3(L)-PROP3(-L))
15747 & +RM4*RM(-L)*(PROP4(L)-PROP4(-L))
15748 & +TWO*RMZ**2/RMW*RN3*PROP7(L)
15753 PP(L)=DCMPLX(ZERO,ZERO)
15754 MM(L)=MM(L)+PROPZ*GE(LE)*DFLOAT(L)/TWOSQS*
15755 & (RM3*RM(L)/ZP3-RM4*RM(-L)/ZP4)
15757 QQ(L)=RM(L)*(PROP3(-L)*ZP3-PROP4(L)*ZP4)
15758 & +RN1(L)*PROP5*ZP5
15759 & -RN2(L)*PROP6*ZP5
15760 & +RM3/RMW*RN3*(PROP7(L)-PROP7(-L))*ZP5
15762 EP3(L)=P3(0)+RLLE*P3(3)
15763 EP4(L)=P4(0)+RLLE*P4(3)
15767 & EP3(+L)*EP4(+L)*DCONJG(PP(+L))*PP(+L)+
15768 & EP3(+L)*EP4(-L)*DCONJG(MM(+L))*MM(+L)-
15769 & TWO*RM3*EP4(+L)*DCONJG(PP(+L))*MM(-L)-
15770 & TWO*RM4*EP3(+L)*DCONJG(PP(+L))*MM(+L)+
15771 & M34*(DCONJG(PP(-L))*PP(+L)+DCONJG(MM(-L))*MM(+L))
15772 & +TWO*DCONJG(QQ(-L))
15773 & *((RM3*MM(-L)-EP3(+L)*PP(+L))*ZP4-
15774 & (RM4*MM(+L)-EP4(+L)*PP(+L))*ZP3+
15775 & P34*QQ(-L)-M34*QQ(+L)))
15781 *CMZ :- -14/03/01 09:03:25 by Peter Richardson
15782 *-- Author : Peter Richardson
15783 C-----------------------------------------------------------------------
15784 SUBROUTINE HWH2M0(IQ,IDZ,MG,MQ)
15785 C-----------------------------------------------------------------------
15786 C Massless matrix elements for gg-->qqZ and qq-->qqZ
15787 C using the matrix elements given in Nucl. Phys. B262 (1985) 235-242
15788 C-----------------------------------------------------------------------
15789 INCLUDE 'herwig65.inc'
15790 INTEGER IQ,I,J,OZ(2,2),IDZ,P1,P2,P3,P4,IQI,ID(2),K
15791 DOUBLE PRECISION MG(2),MQ(2,5),G(12,2),FLOW(3,3),CQFC,CQIFC,
15793 DOUBLE COMPLEX MQAMP(2),HWH2T1,HWH2T2,HWH2T3,HWH2T4,HWH2T5,
15794 & HWH2T6,HWH2T7,HWH2T8,HWH2T9,HWH2T0,DCF(8),HWH2DD,
15795 & MGAMP(2,2,2,2,2),TRPGL(2)
15796 EXTERNAL HWH2DD,HWH2T0,HWH2T1,HWH2T2,HWH2T3,HWH2T4,HWH2T5,HWH2T6,
15797 & HWH2T7,HWH2T8,HWH2T9
15798 PARAMETER(CQFC=2.0D0,CQIFC=-2.0D0/3.0D0,CGFC=16.0D0/3.0D0,
15799 & CGIFC=-2.0D0/3.0D0)
15804 C--flavour of the final-state quark (1 is down-type and 2 is up-type)
15807 C--calculate qqbar---> q'q'barZ
15808 DCF(1) = HWH2DD(4,2,1,3,4,5,6)
15809 DCF(2) = HWH2DD(5,2,1,3,4,5,6)
15810 DCF(3) = HWH2DD(4,3,4,2,1,5,6)
15811 DCF(4) = HWH2DD(5,3,4,2,1,5,6)
15812 DCF(5) = HWH2DD(4,3,1,2,4,5,6)
15813 DCF(6) = HWH2DD(5,3,1,2,4,5,6)
15814 DCF(7) = HWH2DD(4,2,4,3,1,5,6)
15815 DCF(8) = HWH2DD(5,2,4,3,1,5,6)
15822 C--calculate the matrix element, N.B. two possibe colour flows
15826 MQAMP(1)= G(IDZ,P3)*(
15827 & G(ID(I),P1)*(DCF(1)*HWH2T4(2,1,3,4,OZ(P3,1),OZ(P3,2),P1,P2)
15828 & +DCF(2)*HWH2T5(2,1,3,4,OZ(P3,1),OZ(P3,2),P1,P2))
15829 & +G(IQ,P2)*(DCF(3)*HWH2T4(3,4,2,1,OZ(P3,1),OZ(P3,2),P2,P1)
15830 & +DCF(4)*HWH2T5(3,4,2,1,OZ(P3,1),OZ(P3,2),P2,P1)))
15831 IF(ID(I).NE.IQI) THEN
15834 MQAMP(2)= G(IDZ,P3)*(
15835 & G(IQ,P1)*(DCF(5)*HWH2T4(3,1,2,4,OZ(P3,1),OZ(P3,2),P1,P2)
15836 & +DCF(6)*HWH2T5(3,1,2,4,OZ(P3,1),OZ(P3,2),P1,P2))
15837 & +G(IQ,P2)*(DCF(7)*HWH2T4(2,4,3,1,OZ(P3,1),OZ(P3,2),P2,P1)
15838 & +DCF(8)*HWH2T5(2,4,3,1,OZ(P3,1),OZ(P3,2),P2,P1)))
15840 FLOW(I,1) = FLOW(I,1)+DBLE(MQAMP(1)*DCONJG(MQAMP(1)))
15843 IF(IQI.EQ.ID(I)) THEN
15844 FLOW(3,1) = FLOW(3,1)+DBLE(MQAMP(1)*DCONJG(MQAMP(1)))
15845 FLOW(3,2) = FLOW(3,2)+DBLE(MQAMP(2)*DCONJG(MQAMP(2)))
15846 IF(P1.EQ.P2) FLOW(3,3) = FLOW(3,3)
15847 & -TWO*DBLE(MQAMP(1)*DCONJG(MQAMP(2)))
15854 FLOW(I,1) = CQFC*FLOW(I,1)
15855 FLOW(I,2) = CQFC*FLOW(I,2)
15856 FLOW(I,3) = CQIFC*FLOW(I,3)
15858 C--now find the matrix elements
15864 IF(FLOW(K,J).NE.ZERO) MQ(J,I) = FLOW(K,J)*
15865 & (ONE+FLOW(K,3)/(FLOW(K,1)+FLOW(K,2)))
15868 C--calculate gg---> bbbarZ
15869 C--coefficients for the diagrams
15870 DCF(1) = HWH2DD( 6,3,4,1,2,5,6)
15871 DCF(2) = HWH2DD( 7,3,4,1,2,5,6)
15872 DCF(3) = HWH2DD( 8,3,4,1,2,5,6)
15873 DCF(4) = HWH2DD( 6,3,4,2,1,5,6)
15874 DCF(5) = HWH2DD( 7,3,4,2,1,5,6)
15875 DCF(6) = HWH2DD( 8,3,4,2,1,5,6)
15876 DCF(7) = HWH2DD( 9,3,4,1,2,5,6)
15877 DCF(8) = HWH2DD(10,3,4,1,2,5,6)
15878 C--helicity amplitudes
15884 & DCF(7)*HWH2T9(3,4,1,2,OZ(P4,1),OZ(P4,2),P3,P1,P2)
15885 & +DCF(8)*HWH2T0(3,4,1,2,OZ(P4,1),OZ(P4,2),P3,P1,P2)
15887 & DCF(7)*HWH2T9(3,4,1,2,OZ(P4,1),OZ(P4,2),P3,P2,P1)
15888 & +DCF(8)*HWH2T0(3,4,1,2,OZ(P4,1),OZ(P4,2),P3,P2,P1)
15889 MGAMP(1,P1,P2,P3,P4) = G(IDZ,P4)*G(IQ,P3)*(
15891 & +DCF(1)*HWH2T6(3,4,1,2,OZ(P4,1),OZ(P4,2),P3,P1,P2)
15892 & +DCF(2)*HWH2T7(3,4,1,2,OZ(P4,1),OZ(P4,2),P3,P1,P2)
15893 & +DCF(3)*HWH2T8(3,4,1,2,OZ(P4,1),OZ(P4,2),P3,P1,P2)
15895 MGAMP(2,P2,P1,P3,P4) = G(IDZ,P4)*G(IQ,P3)*(-TRPGL(2)
15896 & +DCF(4)*HWH2T6(3,4,2,1,OZ(P4,1),OZ(P4,2),P3,P1,P2)
15897 & +DCF(5)*HWH2T7(3,4,2,1,OZ(P4,1),OZ(P4,2),P3,P1,P2)
15898 & +DCF(6)*HWH2T8(3,4,2,1,OZ(P4,1),OZ(P4,2),P3,P1,P2))
15903 C--square to obtain the matrix element
15911 FLOW(1,1) = FLOW(1,1)+DBLE(MGAMP(1,P1,P2,P3,P4)*
15912 & DCONJG(MGAMP(1,P1,P2,P3,P4)))
15913 FLOW(1,2) = FLOW(1,2)+DBLE(MGAMP(2,P1,P2,P3,P4)*
15914 & DCONJG(MGAMP(2,P1,P2,P3,P4)))
15915 FLOW(1,3) = FLOW(1,3)+TWO*DBLE(MGAMP(1,P1,P2,P3,P4)*
15916 & DCONJG(MGAMP(2,P1,P2,P3,P4)))
15921 FLOW(1,1) = CGFC*FLOW(1,1)
15922 FLOW(1,2) = CGFC*FLOW(1,2)
15923 FLOW(1,3) = CGIFC*FLOW(1,3)
15925 MG(I) = FLOW(1,I)*(ONE+FLOW(1,3)/(FLOW(1,1)+FLOW(1,2)))
15929 *CMZ :- -14/03/01 09:03:25 by Peter Richardson
15930 *-- Author : Peter Richardson
15931 C-----------------------------------------------------------------------
15932 SUBROUTINE HWH2MQ(IQ,IDZ,MG,MQ)
15933 C-----------------------------------------------------------------------
15934 C Massive matrix elements for gg --> qqbarZ and qqbar --> qqbarZ
15935 C-----------------------------------------------------------------------
15936 INCLUDE 'herwig65.inc'
15937 INTEGER IQ,I,IDZ,P1,P2,PL,PB,PBB,O(2),J,IQI
15938 DOUBLE PRECISION MG(2),MQ(2,5),G(12,2),CQFC,CQIFC,CGFC,CGIFC,
15939 & PTMP(5,10),XMASS,PLAB,PRW,PCM,HWULDO,QBL,QBBL,Q2B,Q1B,Q2BB,
15940 & Q1BB,QM2,FLOW(3,3),PG,PBQB,PBBQBB,QM,PQ,Q1L,Q2L,
15941 & Q1LB,Q2LB,MQB(2,3),QBB
15942 DOUBLE COMPLEX S,D,FBB(2,2,8),FBBB(2,2,8),FBLL(2,2,8,8),MQP(2),
15943 & FBBLL(2,2,8,8),F1B(2,2,8,8),F1BB(2,2,8,8),F2B(2,2,8,8),
15944 & F2BB(2,2,8,8),DL(2,2),DCF(8),MGAMP(3),MQAMP(3,2,2,2,2),
15945 & MQQAMP(2,2,2,2,2),F1LL(2,2,8,8),F2LL(2,2,8,8)
15947 COMMON/HWHEWS/S(8,8,2),D(8,8)
15948 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
15949 PARAMETER(CQFC=2.0D0,CQIFC=-2.0D0/3.0D0,CGFC=16.0D0/3.0D0,
15950 & CGIFC=-2.0D0/3.0D0)
15953 DATA DL/(1.0D0,0.0D0),(0.0D0,0.0D0),(0.0D0,0.0D0),(1.0D0,0.0D0)/
15955 C--mass of the final-state quark
15958 C--first calculate the F functions we will need
15960 PTMP(I,1) = PCM(I,9)+PCM(I,5)+PCM(I,6)
15961 PTMP(I,2) = -PCM(I,10)-PCM(I,5)-PCM(I,6)
15962 PTMP(I,3) = PCM(I,9)-PCM(I,1)
15963 PTMP(I,4) = PCM(I,1)-PCM(I,10)
15964 PTMP(I,5) = PCM(I,9)-PCM(I,2)
15965 PTMP(I,6) = PCM(I,2)-PCM(I,10)
15966 PTMP(I,7) = PCM(I,9)
15967 PTMP(I,8) = -PCM(I,10)
15968 PTMP(I,9) = PCM(I,1)-PCM(I,5)-PCM(I,6)
15969 PTMP(I,10) =-PCM(I,2)+PCM(I,5)+PCM(I,6)
15971 CALL HWH2F3(8,FBLL , PTMP(1, 1),QM)
15972 CALL HWH2F3(8,FBBLL, PTMP(1, 2),QM)
15973 CALL HWH2F3(8,F1B , PTMP(1, 3),QM)
15974 CALL HWH2F3(8,F1BB , PTMP(1, 4),QM)
15975 CALL HWH2F3(8,F2B , PTMP(1, 5),QM)
15976 CALL HWH2F3(8,F2BB , PTMP(1, 6),QM)
15977 CALL HWH2F1(8,FBB ,3,PTMP(1, 7),QM)
15978 CALL HWH2F2(8,FBBB ,4,PTMP(1, 8),QM)
15979 CALL HWH2F3(8,F1LL , PTMP(1, 9),QM)
15980 CALL HWH2F3(8,F2LL , PTMP(1,10),QM)
15981 C--calculate the momenta squared for the denominators
15982 QBB = HALF/(QM2+HWULDO(PCM(1,9),PCM(1,10)))
15983 QBL = ONE/(HWULDO(PTMP(1,1),PTMP(1,1))-QM2)
15984 QBBL = ONE/(HWULDO(PTMP(1,2),PTMP(1,2))-QM2)
15985 Q1B = ONE/(HWULDO(PTMP(1,3),PTMP(1,3))-QM2)
15986 Q1BB = ONE/(HWULDO(PTMP(1,4),PTMP(1,4))-QM2)
15987 Q2B = ONE/(HWULDO(PTMP(1,5),PTMP(1,5))-QM2)
15988 Q2BB = ONE/(HWULDO(PTMP(1,6),PTMP(1,6))-QM2)
15989 Q1L = HWULDO(PTMP(1, 9),PTMP(1, 9))
15990 Q2L = HWULDO(PTMP(1,10),PTMP(1,10))
15991 Q1LB = ONE/(Q1L-QM2)
15992 Q2LB = ONE/(Q2L-QM2)
15995 C--first construct the massless momenta
15996 PBQB = HWULDO(PCM(1,3),PCM(1,9))
15997 PBBQBB = HWULDO(PCM(1,4),PCM(1,10))
15998 C--first gg --> q qbar Z
15999 C--calculate the denominators due gluon polaizations and massive quarks
16000 PG = 0.25D0/(PBQB*PBBQBB*DREAL(D(1,2)*D(1,2)))
16001 C--and the denominators
16002 DCF(1) = FOUR*QBL*Q2BB
16003 DCF(2) = FOUR*QBL*Q1BB
16004 DCF(3) = FOUR*Q1B*Q2BB
16005 DCF(4) = FOUR*Q2B*Q1BB
16006 DCF(5) = FOUR*Q1B*QBBL
16007 DCF(6) = FOUR*Q2B*QBBL
16008 DCF(7) = TWO*QBL/D(1,2)
16009 DCF(8) = TWO*QBBL/D(1,2)
16010 C--now calculate the matrix elements we need
16019 C--first amplitude from notes
16020 MGAMP(1) = DCF(1)*(
16021 & ( G(IQ,O(PL))*FBB(PB, PL,6)*FBLL( PL ,P1,5,2)
16022 & +G(IQ, PL )*FBB(PB,O(PL),5)*FBLL(O(PL),P1,6,2))*
16023 & (F2BB( P1 , P2 ,1,1)*FBBB( P2 ,PBB,2)+
16024 & F2BB( P1 ,O(P2),1,2)*FBBB(O(P2),PBB,1))
16025 & +( G(IQ,O(PL))*FBB(PB, PL ,6)*FBLL( PL,O(P1),5,1)
16026 & +G(IQ, PL )*FBB(PB,O(PL),5)*FBLL(O(PL),O(P1),6,1))*
16027 & (F2BB(O(P1), P2 ,2,1)*FBBB( P2 ,PBB,2)+
16028 & F2BB(O(P1),O(P2),2,2)*FBBB(O(P2),PBB,1)))
16029 C--second amplitude from notes (1st with gluons interchanged)
16030 MGAMP(2) = DCF(2)*(
16031 & ( G(IQ,O(PL))*FBB(PB, PL ,6)*FBLL( PL , P2 ,5,1)
16032 & +G(IQ, PL )*FBB(PB,O(PL),5)*FBLL(O(PL), P2 ,6,1))*
16033 & (F1BB( P2 , P1 ,2,2)*FBBB( P1 ,PBB,1)+
16034 & F1BB( P2 ,O(P1),2,1)*FBBB(O(P1),PBB,2))
16035 & +( G(IQ,O(PL))*FBB(PB, PL ,6)*FBLL( PL ,O(P2),5,2)
16036 & +G(IQ, PL )*FBB(PB,O(PL),5)*FBLL(O(PL),O(P2),6,2))*
16037 & (F1BB(O(P2), P1 ,1,2)*FBBB( P1 ,PBB,1)+
16038 & F1BB(O(P2),O(P1),1,1)*FBBB(O(P1),PBB,2)))
16039 C--third amplitude from notes
16040 MGAMP(1) = MGAMP(1)+DCF(3)*(
16041 & G(IQ,O(PL))*( FBB(PB, P1 ,2)*F1B( P1 , PL ,1,6)
16042 & +FBB(PB,O(P1),1)*F1B(O(P1), PL ,2,6))*
16043 & (F2BB(PL, P2 ,5,1)*FBBB( P2 ,PBB,2)+
16044 & F2BB(PL,O(P2),5,2)*FBBB(O(P2),PBB,1))
16045 & +G(IQ, PL )*( FBB(PB, P1 ,2)*F1B( P1 ,O(PL),1,5)
16046 & +FBB(PB,O(P1),1)*F1B(O(P1),O(PL),2,5))*
16047 & (F2BB(O(PL), P2 ,6,1)*FBBB( P2 ,PBB,2)+
16048 & F2BB(O(PL),O(P2),6,2)*FBBB(O(P2),PBB,1)))
16049 C--fourth amplitude from notes (3rd with gluons interchanged)
16050 MGAMP(2) = MGAMP(2)+DCF(4)*(
16051 & G(IQ,O(PL))*( FBB(PB, P2 ,1)*F2B( P2 , PL ,2,6)
16052 & +FBB(PB,O(P2),2)*F2B(O(P2), PL ,1,6))*
16053 & (F1BB( PL , P1 ,5,2)*FBBB( P1 ,PBB,1)+
16054 & F1BB( PL ,O(P1),5,1)*FBBB(O(P1),PBB,2))
16055 & +G(IQ, PL )*( FBB(PB, P2 ,1)*F2B( P2 ,O(PL),2,5)
16056 & +FBB(PB,O(P2),2)*F2B(O(P2),O(PL),1,5))*
16057 & ( F1BB(O(PL), P1 ,6,2)*FBBB( P1 ,PBB,1)
16058 & +F1BB(O(PL),O(P1),6,1)*FBBB(O(P1),PBB,2)))
16059 C--fifth amplitude from notes
16060 MGAMP(1) = MGAMP(1)+DCF(5)*(
16061 & ( G(IQ,O(PL))*FBBLL( P2 , PL ,2,6)*FBBB( PL ,PBB,5)
16062 & +G(IQ, PL )*FBBLL( P2 ,O(PL),2,5)*FBBB(O(PL),PBB,6))*
16063 & ( FBB(PB, P1 ,2)*F1B( P1 , P2 ,1,1)
16064 & +FBB(PB,O(P1),1)*F1B(O(P1), P2 ,2,1))
16065 & +( G(IQ,O(PL))*FBBLL(O(P2), PL ,1,6)*FBBB( PL ,PBB,5)
16066 & +G(IQ, PL )*FBBLL(O(P2),O(PL),1,5)*FBBB(O(PL),PBB,6))*
16067 & ( FBB(PB, P1 ,2)*F1B( P1 ,O(P2),1,2)
16068 & +FBB(PB,O(P1),1)*F1B(O(P1),O(P2),2,2)))
16069 C--sixth amplitude from notes (5th with gluons interchanged)
16070 MGAMP(2) = MGAMP(2)+DCF(6)*(
16071 & ( G(IQ,O(PL))*FBBLL( P1 , PL ,1,6)*FBBB( PL ,PBB,5)
16072 & +G(IQ, PL )*FBBLL( P1 ,O(PL),1,5)*FBBB(O(PL),PBB,6))*
16073 & ( FBB(PB, P2 ,1)*F2B( P2 , P1 ,2,2)
16074 & +FBB(PB,O(P2),2)*F2B(O(P2), P1 ,1,2))
16075 & +( G(IQ,O(PL))*FBBLL(O(P1), PL ,2,6)*FBBB( PL ,PBB,5)
16076 & +G(IQ, PL )*FBBLL(O(P1),O(PL),2,5)*FBBB(O(PL),PBB,6))*
16077 & ( FBB(PB, P2 ,1)*F2B( P2 ,O(P1),2,1)
16078 & +FBB(PB,O(P2),2)*F2B(O(P2),O(P1),1,1)))
16079 C--seventh amplitude from notes (first non-Abelian one)
16080 MGAMP(3) = DCF(7)*DL(P1,P2)*S(1,2,P1)*S(1,2,O(P1))*(
16081 & G(IQ,O(PL))*FBB(PB, PL ,6)*
16082 & ( FBLL( PL ,1,5,1)*FBBB(1,PBB,1)
16083 & +FBLL( PL ,2,5,1)*FBBB(2,PBB,1)
16084 & -FBLL( PL ,1,5,2)*FBBB(1,PBB,2)
16085 & -FBLL( PL ,2,5,2)*FBBB(2,PBB,2))
16086 & +G(IQ, PL )*FBB(PB,O(PL),5)*
16087 & ( FBLL(O(PL),1,6,1)*FBBB(1,PBB,1)
16088 & +FBLL(O(PL),2,6,1)*FBBB(2,PBB,1)
16089 & -FBLL(O(PL),1,6,2)*FBBB(1,PBB,2)
16090 & -FBLL(O(PL),2,6,2)*FBBB(2,PBB,2)))
16091 C--eighth amplitude from notes (second non-Abelian one)
16092 C--bug fix 12/7/03 by PR (too many continuations for NAG)
16093 MGAMP(3) = MGAMP(3)
16094 & + DCF(8)*DL(P1,P2)*S(1,2,P1)*S(1,2,O(P1))*(
16095 & G(IQ,O(PL))*FBBB( PL ,PBB,5)*
16096 & ( FBB(PB,1,1)*FBBLL(1,PL,1,6)
16097 & +FBB(PB,2,1)*FBBLL(2,PL,1,6)
16098 & -FBB(PB,1,2)*FBBLL(1,PL,2,6)
16099 & -FBB(PB,2,2)*FBBLL(2,PL,2,6))
16100 & +G(IQ, PL )*FBBB(O(PL),PBB,6)*
16101 & ( FBB(PB,1,1)*FBBLL(1,O(PL),1,5)
16102 & +FBB(PB,2,1)*FBBLL(2,O(PL),1,5)
16103 & -FBB(PB,1,2)*FBBLL(1,O(PL),2,5)
16104 & -FBB(PB,2,2)*FBBLL(2,O(PL),2,5)))
16105 MGAMP(1) = G(IDZ,PL)*(MGAMP(1)+MGAMP(3))
16106 MGAMP(2) = G(IDZ,PL)*(MGAMP(2)-MGAMP(3))
16108 FLOW(1,1) = FLOW(1,1)+DREAL(MGAMP(1)*DCONJG(MGAMP(1)))
16109 FLOW(1,2) = FLOW(1,2)+DREAL(MGAMP(2)*DCONJG(MGAMP(2)))
16110 FLOW(1,3) = FLOW(1,3)+TWO*DREAL(MGAMP(1)*DCONJG(MGAMP(2)))
16116 C--add up the diagrams to obtain the amplitudes for the two colour flows
16117 FLOW(1,1) = CGFC*FLOW(1,1)
16118 FLOW(1,2) = CGFC*FLOW(1,2)
16119 FLOW(1,3) = CGIFC*FLOW(1,3)
16121 IF(FLOW(1,3).NE.ZERO) THEN
16122 MG(I) = PG*FLOW(1,I)*(ONE+FLOW(1,3)/(FLOW(1,1)+FLOW(1,2)))
16124 MG(I) = PG*FLOW(1,I)
16127 C--now q qbar --> q qbar Z
16128 C--calculate the denominators
16129 DCF(1) = -TWO*QBL/D(1,2)
16130 DCF(2) = -TWO*QBBL/D(1,2)
16131 DCF(3) = -TWO*Q1L*QBB
16132 DCF(4) = +TWO*Q2L*QBB
16133 DCF(5) = TWO*Q1LB*Q2BB
16134 DCF(6) = -TWO*Q2LB*Q1B
16135 DCF(7) = TWO*QBL*Q2BB
16136 DCF(8) = -TWO*QBBL*Q1B
16137 PQ = ONE/PBQB/PBBQBB
16142 C--first the amplitudes for q qbar --> q' q'bar Z
16143 C--the first two amplitudes have Z off the final state and therefore
16144 C--the flavour of the incoming quarks doesn't matter
16145 C--first amplitude from notes
16146 MQAMP(3,P1,PL,PB,PBB) = G(IDZ,PL)*(
16147 & DCF(1)*(G(IQ,O(PL))*FBB(O(PB), PL ,6)*
16148 & ( FBLL( PL , P1 ,5,1)*FBBB( P1 ,O(PBB),2)
16149 & +FBLL( PL ,O(P1),5,2)*FBBB(O(P1),O(PBB),1))
16150 & +G(IQ, PL )*FBB(O(PB),O(PL),5)*
16151 & ( FBLL(O(PL), P1 ,6,1)*FBBB( P1 ,O(PBB),2)
16152 & +FBLL(O(PL),O(P1),6,2)*FBBB(O(P1),O(PBB),1)))
16153 C--second amplitide from notes
16154 & +DCF(2)*(G(IQ,O(PL))*FBBB( PL ,O(PBB),5)*
16155 & ( FBB(O(PB), P1 ,1)*FBBLL( P1 , PL ,2,6)
16156 & +FBB(O(PB),O(P1),2)*FBBLL(O(P1), PL ,1,6))
16157 & +G(IQ, PL )*FBBB(O(PL),O(PBB),6)*
16158 & ( FBB(O(PB), P1 ,1)*FBBLL( P1 ,O(PL),2,5)
16159 & +FBB(O(PB),O(P1),2)*FBBLL(O(P1),O(PL),1,5))))
16160 C--third amplitide from notes
16162 MQAMP(I,P1,PL,PB,PBB) =
16163 & DCF(3)*(G(I,O(PL))*DL(P1,O(PL))*S(5,1, PL )*(
16164 & S(1,6,O(PL))*( FBB(O(PB), P1 ,1)*FBBB( P1 ,O(PBB),2)
16165 & +FBB(O(PB),O(P1),2)*FBBB(O(P1),O(PBB),1))
16166 & -S(5,6,O(PL))*( FBB(O(PB), P1 ,5)*FBBB( P1 ,O(PBB),2)
16167 & +FBB(O(PB),O(P1),2)*FBBB(O(P1),O(PBB),5)))
16168 & +G(I, PL )*DL(P1, PL )*S(6,1,O(PL))*(
16169 & S(1,5, PL )*( FBB(O(PB), P1 ,1)*FBBB( P1 ,O(PBB),2)
16170 & +FBB(O(PB),O(P1),2)*FBBB(O(P1),O(PBB),1))
16171 & -S(6,5, PL )*( FBB(O(PB), P1 ,6)*FBBB( P1 ,O(PBB),2)
16172 & +FBB(O(PB),O(P1),2)*FBBB(O(P1),O(PBB),6))))
16173 C--fourth amplitude from notes
16174 MQAMP(I,P1,PL,PB,PBB) = MQAMP(I,P1,PL,PB,PBB)
16175 & +DCF(4)*(G(I,O(PL))*DL(P1,O(PL))*S(2,6, P1 )*(
16176 & S(5,2, PL )*( FBB(O(PB), P1 ,1)*FBBB( P1 ,O(PBB),2)
16177 & +FBB(O(PB),O(P1),2)*FBBB(O(P1),O(PBB),1))
16178 & -S(5,6, PL )*( FBB(O(PB), P1 ,1)*FBBB( P1 ,O(PBB),6)
16179 & +FBB(O(PB),O(P1),6)*FBBB(O(P1),O(PBB),1)))
16180 & +G(I, PL )*DL(P1, PL )*S(2,5, P1 )*(
16181 & S(6,2,O(PL))*( FBB(O(PB), P1 ,1)*FBBB( P1 ,O(PBB),2)
16182 & +FBB(O(PB),O(P1),2)*FBBB(O(P1),O(PBB),1))
16183 & -S(6,5,O(PL))*( FBB(O(PB), P1 ,1)*FBBB( P1 ,O(PBB),5)
16184 & +FBB(O(PB),O(P1),5)*FBBB(O(P1),O(PBB),1))))
16185 MQAMP(I,P1,PL,PB,PBB) = G(IDZ,PL)*MQAMP(I,P1,PL,PB,PBB)
16187 C--now the extra amplitudes for q qbar --> q qbar Z
16189 C--first amplitude for notes
16190 MQQAMP(P1,P2,PL,PB,PBB) =
16191 & DCF(5)*(DL(P2,PBB)*S(8,4,PBB)*(
16192 & G(IQ,O(PL))*DL(P1,O(PL))*S(5,1, PL )*
16193 & ( FBB(O(PB), PBB,8)*F1LL( P2 , PL ,2,6)
16194 & +FBB(O(PB),O(P2),2)*F1LL(O(PBB), PL ,8,6))
16195 & +G(IQ, PL )*DL(P1, PL )*S(6,1,O(PL))*
16196 & ( FBB(O(PB), PBB ,8)*F1LL( P2 ,O(PL),2,5)
16197 & +FBB(O(PB),O(P2) ,2)*F1LL(O(PBB),O(PL),8,5)))
16198 & -QM*DL(P2,O(PBB))*(
16199 & G(IQ,O(PL))*DL(P1,O(PL))*S(5,1,PL)*
16200 & ( FBB(O(PB),O(PBB),8)*F1LL( P2 , PL ,2,6)
16201 & +FBB(O(PB),O(P2) ,2)*F1LL( PBB , PL ,8,6))
16202 & +G(IQ, PL )*DL(P1, PL )*S(6,1,O(PL))*
16203 & ( FBB(O(PB),O(PBB),8)*F1LL( P2 ,O(PL),2,5)
16204 & +FBB(O(PB), O(P2),2)*F1LL( PBB ,O(PL),8,5))))
16205 C--second amplitude from notes
16206 MQQAMP(P1,P2,PL,PB,PBB) = MQQAMP(P1,P2,PL,PB,PBB)
16207 & +DCF(6)*(DL(P1,PB)*S(3,7,O(PB))*(
16208 & G(IQ,O(PL))*DL(P2,O(PL))*S(2,6, P2 )*
16209 & ( F2LL( PL , P1 ,5,1)*FBBB( PB ,O(PBB),7)
16210 & +F2LL( PL ,O(PB),5,7)*FBBB(O(P1),O(PBB),1))
16211 & +G(IQ, PL )*DL(P2, PL )*S(2,5, P2 )*
16212 & ( F2LL(O(PL), P1 ,6,1)*FBBB( PB ,O(PBB),7)
16213 & +F2LL(O(PL),O(PB),6,7)*FBBB(O(P1),O(PBB),1)))
16214 & -QM*DL(P1,O(PB))*(
16215 & G(IQ,O(PL))*DL(P2,O(PL))*S(2,6, P2 )*
16216 & ( F2LL( PL , P1 ,5,1)*FBBB(O(PB),O(PBB),7)
16217 & +F2LL( PL , PB ,5,7)*FBBB(O(P1),O(PBB),1))
16218 & +G(IQ, PL )*DL(P2, PL )*S(2,5, P2 )*
16219 & ( F2LL(O(PL), P1 ,6,1)*FBBB(O(PB),O(PBB),7)
16220 & +F2LL(O(PL), PB ,6,7)*FBBB(O(P1),O(PBB),1))))
16221 C--third amplitude from notes
16222 MQQAMP(P1,P2,PL,PB,PBB) = MQQAMP(P1,P2,PL,PB,PBB)
16223 & +DCF(7)*(DL(P2,PBB)*S(8,4,PBB)*(
16224 & G(IQ,O(PL))*FBB(O(PB), PL ,6)*
16225 & ( DL(P2,O(P1) )*S(2,1, P2 )*FBLL( PL , PBB ,5,8)
16226 & +DL(P1,PBB )*S(8,1,O(PBB))*FBLL( PL ,O(P2),5,2))
16227 & +G(IQ, PL )*FBB(O(PB),O(PL),5)*
16228 & ( DL(P2,O(P1) )*S(2,1, P2 )*FBLL(O(PL), PBB ,6,8)
16229 & +DL(P1,PBB )*S(8,1,O(PBB))*FBLL(O(PL),O(P2),6,2)))
16230 & -QM*DL(P2,O(PBB))*(
16231 & G(IQ,O(PL))*FBB(O(PB),PL,6)*
16232 & ( DL(P2,O(P1) )*S(2,1, P2 )*FBLL( PL ,O(PBB),5,8)
16233 & +DL(P1,O(PBB))*S(8,1, PBB )*FBLL( PL ,O(P2) ,5,2))
16234 & +G(IQ, PL )*FBB(O(PB),O(PB),5)*
16235 & ( DL(P2,O(PL) )*S(2,1, P2 )*FBLL(O(PL),O(PBB),6,8)
16236 & +DL(P1,O(PBB))*S(8,1, PBB )*FBLL(O(PL),O(P2) ,6,2))))
16237 C--fourth amplitude from notes
16238 MQQAMP(P1,P2,PL,PB,PBB) = MQQAMP(P1,P2,PL,PB,PBB)
16239 & +DCF(8)*(DL(P1,PB)*S(3,7,O(PB))*(
16240 & DL(P1,O(P2))*S(2,1,P2)*
16241 & ( G(IQ,O(PL))*FBBLL(PB, PL ,7,6)*FBBB( PL ,O(PBB),5)
16242 & +G(IQ, PL )*FBBLL(PB,O(PL),7,5)*FBBB(O(PL),O(PBB),6))
16243 & +DL(P2,PB)*S(2,7,P2)*
16244 & (G(IQ,O(PL))*FBBLL(O(P1), PL ,1,6)*FBBB( PL ,O(PBB),5)
16245 & +G(IQ, PL )*FBBLL(O(P1),O(PL),1,5)*FBBB(O(PL),O(PBB),6)))
16246 & +QM*DL(P1,O(PB))*(
16247 & DL(P2,O(P1))*S(2,1,P2)*
16248 & ( G(IQ,O(PL))*FBBLL(O(PB), PL ,3,6)*FBBB( PL ,O(PBB),5)
16249 & +G(IQ, PL )*FBBLL(O(PB),O(PL),3,5)*FBBB(O(PL),O(PBB),6))
16250 & +DL(P2,O(PB))*S(2,3,P2)*
16251 & ( G(IQ,O(PL))*FBBLL(O(P1), PL ,1,6)*FBBB( PL ,O(PBB),5)
16252 & +G(IQ, PL )*FBBLL(O(P1),O(PL),1,5)*FBBB(O(PL),O(PBB),6))))
16253 MQQAMP(P1,P2,PL,PB,PBB) = G(IDZ,PL)*MQQAMP(P1,P2,PL,PB,PBB)
16259 C--now obtain the matrix elements squared for the quarks
16265 IF(MOD(IQ,2).EQ.1) THEN
16274 C--different quarks in inital and final states
16276 MQP(I) = MQAMP(I,P1,PL,PB,PBB)+MQAMP(3,P1,PL,PB,PBB)
16277 FLOW(I,1) = FLOW(I,1)+DREAL(DCONJG(MQP(I))*MQP(I))
16279 C--same quark in inital and final state
16281 FLOW(3,2) = FLOW(3,2)+DREAL(
16282 & DCONJG(MQQAMP(P1,P2,PL,PB,PBB))*MQQAMP(P1,P2,PL,PB,PBB))
16284 FLOW(3,1) = FLOW(3,1)+DREAL(DCONJG(MQP(IQI))*MQP(IQI))
16285 FLOW(3,3) = FLOW(3,3)-TWO*
16286 & DREAL(DCONJG(MQP(IQI))*MQQAMP(P1,P2,PL,PB,PBB))
16293 C--split up the non-planar pieces according to Kosuke's prescription
16295 FLOW(I,1) = CQFC*FLOW(I,1)
16296 FLOW(I,2) = CQFC*FLOW(I,2)
16297 FLOW(I,3) = CQIFC*FLOW(I,3)
16299 IF(FLOW(I,J).NE.ZERO) THEN
16300 MQB(J,I) = PQ*FLOW(I,J)*
16301 & (ONE+FLOW(I,3)/(FLOW(I,1)+FLOW(I,2)))
16313 ELSEIF(MOD(I,2).EQ.1) THEN
16325 *CMZ :- -14/03/01 09:03:25 by Peter Richardson
16326 *-- Author : Peter Richardson
16327 C-----------------------------------------------------------------------
16328 SUBROUTINE HWH2PS(WEIGHT,GEN,MQ,MQ2)
16329 C-----------------------------------------------------------------------
16330 C Phase Space for vector boson plus 2 jets
16331 C-----------------------------------------------------------------------
16332 INCLUDE 'herwig65.inc'
16333 DOUBLE PRECISION WEIGHT,XMASS,PLAB,PRW,PCM,Y(3),Y35,Y34,Y45,RAND,
16334 & HWRGEN,HWRUNI,M35,M35S,G(IMAXCH),DEM,MT(3),PT(3),MJAC,ETOT,
16335 & STOT,MQ(3),MQ2(3),PS35,HWUPCM,TWOPI2,MT35,PTJ(3),MT2(3),A,C,
16336 & PT2(3),YMIN,YMAX,EY(3),EY34,YJAC,YJJMAX,YJJMIN,EY35,PHI(3),
16337 & MT45,PS45,EY45,M45,M45S,M34,PS34,M34S,MT34,XJAC,SJAC,PST,TAU,
16338 & FLUX,ETMP,PZTMP,XT1,XT2,WI(IMAXCH)
16341 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
16343 EXTERNAL HWRGEN,HWRUNI,HWUPCM
16344 PARAMETER(YJJMIN=-8.0D0,YJJMAX=8.0D0)
16345 IF(IERROR.NE.0) RETURN
16346 TWOPI2 = FOUR*PIFAC**2
16354 C--centre of mass energy
16357 C--first select the channel to be used
16361 IF(CHNPRB(ICH).GT.RAND) GOTO 10
16362 RAND = RAND-CHNPRB(ICH)
16366 C--generate the phase space according to the channel selected
16369 C--first generate the mass of 35
16370 CALL HWH2P1(2,MJAC,MQ2(1),M35S,(ETOT-MQ(2))**2,(MQ(1)+MQ(3))**2)
16372 PS35 = HWUPCM(M35,MQ(1),MQ(3))
16373 MJAC = HALF*MJAC*PS35/M35/TWOPI2
16374 C--the generate the PT of 4
16375 CALL HWH2P2(2,PTJ(1),MT2(2),MQ2(2)+PTMAX**2,MQ2(2)+PTMIN**2)
16376 MT (2) = SQRT(MT2(2))
16377 PT2(2) = MT2(2)-MQ2(2)
16378 PT(2) = SQRT(PT2(2))
16379 MT35 = SQRT(M35S+PT2(2))
16380 C--generate the rapidities of 4 and 35
16381 YMAX = MIN(YJJMAX, LOG(PHEP(5,3)/MT35))
16382 YMIN = MAX(YJJMIN,-LOG(PHEP(5,3)/MT35))
16383 IF(YMAX.LT.YMIN) RETURN
16384 Y35 = HWRUNI(1,YMIN,YMAX)
16387 YMAX = MIN(YJMAX, LOG((PHEP(5,3)-MT35*EY35)/MT(2)))
16388 YMIN = MAX(YJMIN,-LOG((PHEP(5,3)-MT35/EY35)/MT(2)))
16389 IF(YMAX.LT.YMIN) RETURN
16390 Y(2) = HWRUNI(2,YMIN,YMAX)
16391 YJAC = (YMAX-YMIN)*YJAC
16393 C--generate the incoming quark momentum fractions
16394 XX(1) = (MT(2)*EY(2)+MT35*EY35)/ETOT
16395 XX(2) = (MT(2)/EY(2)+MT35/EY35)/ETOT
16396 STOT = XX(1)*XX(2)*STOT
16397 C--azimuthal angle of 4 and 35
16398 PHI(1) = HWRUNI(3,ZERO,TWO*PIFAC)
16399 C--construct the momenta of 4 and 35
16400 PLAB(1,4) = PT(2)*SIN(PHI(1))
16401 PLAB(2,4) = PT(2)*COS(PHI(1))
16402 PLAB(3,4) = HALF*MT(2)*(EY(2)-ONE/EY(2))
16403 PLAB(4,4) = HALF*MT(2)*(EY(2)+ONE/EY(2))
16405 PLAB(1,6) =-PT(2)*SIN(PHI(1))
16406 PLAB(2,6) =-PT(2)*COS(PHI(1))
16407 PLAB(3,6) = HALF*MT35*(EY35-ONE/EY35)
16408 PLAB(4,6) = HALF*MT35*(EY35+ONE/EY35)
16410 C--perform the decay 35 --> 3+5
16413 CALL HWDTWO(PLAB(1,6),PLAB(1,3),PLAB(1,5),PS35,TWO,.TRUE.)
16414 C--phase space weight
16415 FLUX = MJAC*YJAC*PTJ(1)/16.0D0/PIFAC/STOT**2
16417 ELSEIF(ICH.EQ.2) THEN
16418 C--first generate the pt's and azimuthal angles of 3 and 4
16420 CALL HWH2P2(2,PTJ(I),MT2(I),MQ2(I)+PTMAX**2,MQ2(I)+PTMIN**2)
16421 PT2(I) = MT2(I)-MQ2(I)
16422 MT(I) = SQRT(MT2(I))
16423 PT(I) = SQRT(PT2(I))
16424 PHI(I) = HWRUNI(I,ZERO,TWO*PIFAC)
16426 C--find the pt and azimuth of 5 by conservation of transverse momentum
16427 A = PT(1)*SIN(PHI(1))+PT(2)*SIN(PHI(2))
16428 C = PT(1)*COS(PHI(1))+PT(2)*COS(PHI(2))
16430 MT(3) = SQRT(PT(3)+MQ2(3))
16431 PT(3) = SQRT(PT(3))
16432 PHI(3) = -ACOS(-C/PT(3))
16433 IF(A.LT.ZERO) PHI(3)=-PHI(3)
16434 C--generate the rapidities of 3,4 and 5
16439 YMAX = MIN(YJMAX, LOG((PHEP(5,3)-XX(1))/MT(I)))
16440 YMIN = MAX(YJMIN,-LOG((PHEP(5,3)-XX(2))/MT(I)))
16441 IF(YMAX.LT.YMIN) RETURN
16442 Y(I) = HWRUNI(I+2,YMIN,YMAX)
16444 XX(1) = XX(1)+MT(I)*EY(I)
16445 XX(2) = XX(2)+MT(I)/EY(I)
16446 YJAC = YJAC*(YMAX-YMIN)
16448 C--generate the incoming quark momentum fractions
16449 XX(1) = XX(1)/PHEP(5,3)
16450 XX(2) = XX(2)/PHEP(5,3)
16451 IF(XX(1).GT.ONE.OR.XX(2).GT.ONE) RETURN
16452 C--Construct the 4-momenta of the outgoing particles
16454 PLAB(1,I+2) = PT(I)*SIN(PHI(I))
16455 PLAB(2,I+2) = PT(I)*COS(PHI(I))
16456 PLAB(3,I+2) = HALF*MT(I)*(EY(I)-ONE/EY(I))
16457 PLAB(4,I+2) = HALF*MT(I)*(EY(I)+ONE/EY(I))
16458 PLAB(5,I+2) = MQ(I)
16460 C--phase space weight
16461 STOT = XX(1)*XX(2)*STOT
16462 FLUX = YJAC*PTJ(1)*PTJ(2)/64.0D0/PIFAC/TWOPI2/STOT**2
16464 ELSEIF(ICH.EQ.3) THEN
16465 C--first generate the mass of 45
16466 CALL HWH2P1(2,MJAC,MQ2(2),M45S,(ETOT-MQ(1))**2,(MQ(2)+MQ(3))**2)
16468 PS45 = HWUPCM(M45,MQ(2),MQ(3))
16469 MJAC = HALF*MJAC*PS45/M45/TWOPI2
16470 C--the generate the PT of 4
16471 CALL HWH2P2(2,PTJ(1),MT2(1),MQ2(1)+PTMAX**2,MQ2(1)+PTMIN**2)
16472 MT (1) = SQRT(MT2(1))
16473 PT2(1) = MT2(1)-MQ2(1)
16474 PT(1) = SQRT(PT2(1))
16475 MT45 = SQRT(M45S+PT2(1))
16476 C--generate the rapidities of 3 and 45
16477 YMAX = MIN(YJJMAX, LOG(PHEP(5,3)/MT45))
16478 YMIN = MAX(YJJMIN,-LOG(PHEP(5,3)/MT45))
16479 IF(YMAX.LT.YMIN) RETURN
16480 Y45 = HWRUNI(1,YMIN,YMAX)
16483 YMAX = MIN(YJMAX, LOG((PHEP(5,3)-MT45*EY45)/MT(1)))
16484 YMIN = MAX(YJMIN,-LOG((PHEP(5,3)-MT45/EY45)/MT(1)))
16485 IF(YMAX.LT.YMIN) RETURN
16486 Y(1) = HWRUNI(2,YMIN,YMAX)
16487 YJAC = (YMAX-YMIN)*YJAC
16489 C--generate the incoming quark momentum fractions
16490 XX(1) = (MT(1)*EY(1)+MT45*EY45)/ETOT
16491 XX(2) = (MT(1)/EY(1)+MT45/EY45)/ETOT
16492 STOT = XX(1)*XX(2)*STOT
16493 C--azimuthal angle of 3 and 45
16494 PHI(1) = HWRUNI(3,ZERO,TWO*PIFAC)
16495 C--construct the momenta of 3 and 45
16496 PLAB(1,3) = PT(1)*SIN(PHI(1))
16497 PLAB(2,3) = PT(1)*COS(PHI(1))
16498 PLAB(3,3) = HALF*MT(1)*(EY(1)-ONE/EY(1))
16499 PLAB(4,3) = HALF*MT(1)*(EY(1)+ONE/EY(1))
16501 PLAB(1,6) =-PT(1)*SIN(PHI(1))
16502 PLAB(2,6) =-PT(1)*COS(PHI(1))
16503 PLAB(3,6) = HALF*MT45*(EY45-ONE/EY45)
16504 PLAB(4,6) = HALF*MT45*(EY45+ONE/EY45)
16506 C--perform the decay 45 --> 4+5
16509 CALL HWDTWO(PLAB(1,6),PLAB(1,4),PLAB(1,5),PS45,TWO,.TRUE.)
16510 C--phase space weight
16511 FLUX = MJAC*YJAC*PTJ(1)/16.0D0/PIFAC/STOT**2
16513 ELSEIF(ICH.EQ.4) THEN
16514 C--generate shat according to a power law
16515 CALL HWHGB1(1,2,200,SJAC,STOT,PHEP(5,3)**2,
16516 & (MQ(1)+MQ(2)+MQ(3))**2)
16519 TAU = STOT/PHEP(5,3)**2
16521 XX(1) = EXP(HWRUNI(2,LOG(TAU),ZERO))
16524 CALL HWH2P1(2,MJAC,MQ2(1),M35S,(ETOT-MQ(2))**2,
16525 & (MQ(1)+MQ(3))**2)
16527 PS35 = HWUPCM(M35,MQ(1),MQ(3))
16528 MJAC = HALF*MJAC*PS35/M35/TWOPI2
16529 C--generate the momenta of 4 and 35
16530 PST = HWUPCM(ETOT,M35,MQ(2))
16533 PLAB(3,7) = HALF*(XX(1)-XX(2))*PHEP(5,3)
16534 PLAB(4,7) = HALF*(XX(1)+XX(2))*PHEP(5,3)
16539 CALL HWDTWO(PLAB(1,7),PLAB(1,4),PLAB(1,6),PST,TWO,.TRUE.)
16540 C--perform the decay 35 --> 3+5
16543 CALL HWDTWO(PLAB(1,6),PLAB(1,3),PLAB(1,5),PS35,TWO,.TRUE.)
16544 C--phase space weight
16545 FLUX = SJAC*XJAC*MJAC*PST/ETOT/STOT**2/8.0D0/PIFAC
16547 ELSEIF(ICH.EQ.5) THEN
16548 C--generate shat according to a power law
16549 CALL HWHGB1(1,2,200,SJAC,STOT,PHEP(5,3)**2,
16550 & (MQ(1)+MQ(2)+MQ(3))**2)
16553 TAU = STOT/PHEP(5,3)**2
16555 XX(1) = EXP(HWRUNI(2,LOG(TAU),ZERO))
16558 CALL HWH2P1(2,MJAC,MQ2(2),M45S,(ETOT-MQ(1))**2,(MQ(2)+MQ(3))**2)
16560 PS45 = HWUPCM(M45,MQ(2),MQ(3))
16561 MJAC = HALF*MJAC*PS45/M45/TWOPI2
16562 C--generate the momenta of 4 and 35
16563 PST = HWUPCM(ETOT,M45,MQ(1))
16566 PLAB(3,7) = HALF*(XX(1)-XX(2))*PHEP(5,3)
16567 PLAB(4,7) = HALF*(XX(1)+XX(2))*PHEP(5,3)
16571 CALL HWDTWO(PLAB(1,7),PLAB(1,3),PLAB(1,6),PST,TWO,.TRUE.)
16572 C--perform the decay 45 --> 4+5
16575 CALL HWDTWO(PLAB(1,6),PLAB(1,4),PLAB(1,5),PS45,TWO,.TRUE.)
16576 C--phase space weight
16577 FLUX = SJAC*XJAC*MJAC*PST/ETOT/STOT**2/8.0D0/PIFAC
16579 ELSEIF(ICH.EQ.6) THEN
16580 C--first generate the mass of 34
16581 CALL HWH2P1(2,MJAC,ZERO,M34S,(ETOT-MQ(3))**2,MJJMIN**2)
16583 PS34 = HWUPCM(M34,MQ(1),MQ(2))
16584 MJAC = HALF*MJAC*PS34/M34/TWOPI2
16585 C--the generate the PT of 5
16586 CALL HWH2P2(2,PTJ(1),MT2(3),MQ2(3)+PTMAX**2,MQ2(3))
16587 MT (3) = SQRT(MT2(3))
16588 PT2(3) = MT2(3)-MQ2(3)
16589 PT(3) = SQRT(PT2(3))
16590 MT34 = SQRT(M34S+PT2(3))
16591 C--generate the rapidities of 5 and 34
16592 YMAX = MIN(YJJMAX, LOG(PHEP(5,3)/MT34))
16593 YMIN = MAX(YJJMIN,-LOG(PHEP(5,3)/MT34))
16594 IF(YMAX.LT.YMIN) RETURN
16595 Y34 = HWRUNI(1,YMIN,YMAX)
16598 YMAX = MIN(YJMAX, LOG((PHEP(5,3)-MT34*EY34)/MT(3)))
16599 YMIN = MAX(YJMIN,-LOG((PHEP(5,3)-MT34/EY34)/MT(3)))
16600 IF(YMAX.LT.YMIN) RETURN
16601 Y(3) = HWRUNI(2,YMIN,YMAX)
16602 YJAC = (YMAX-YMIN)*YJAC
16604 C--generate the incoming quark momentum fractions
16605 XX(1) = (MT(3)*EY(3)+MT34*EY34)/ETOT
16606 XX(2) = (MT(3)/EY(3)+MT34/EY34)/ETOT
16607 STOT = XX(1)*XX(2)*STOT
16608 C--azimuthal angle of 3 and 45
16609 PHI(1) = HWRUNI(3,ZERO,TWO*PIFAC)
16610 C--construct the momenta of 5 and 34
16611 PLAB(1,5) = PT(3)*SIN(PHI(1))
16612 PLAB(2,5) = PT(3)*COS(PHI(1))
16613 PLAB(3,5) = HALF*MT(3)*(EY(3)-ONE/EY(3))
16614 PLAB(4,5) = HALF*MT(3)*(EY(3)+ONE/EY(3))
16616 PLAB(1,6) =-PT(3)*SIN(PHI(1))
16617 PLAB(2,6) =-PT(3)*COS(PHI(1))
16618 PLAB(3,6) = HALF*MT34*(EY34-ONE/EY34)
16619 PLAB(4,6) = HALF*MT34*(EY34+ONE/EY34)
16621 C--perform the decay 34 --> 3+4
16624 CALL HWDTWO(PLAB(1,6),PLAB(1,3),PLAB(1,4),PS34,TWO,.TRUE.)
16625 C--phase space weight
16626 FLUX = MJAC*YJAC*PTJ(1)/16.0D0/PIFAC/STOT**2
16628 CALL HWWARN('HWH2PS',500)
16630 C--calculate the variables we need for the smoothing functions
16631 C--pt,mt and y for outgoing particles
16634 PT2(I) = PLAB(1,J)**2+PLAB(2,J)**2
16635 PT(I) = SQRT(PT2(I))
16636 MT2(I) = MQ2(I)+PT2(I)
16637 MT(I) = SQRT(MT2(I))
16638 Y(I) = HALF*LOG((PLAB(4,J)+PLAB(3,J))/(PLAB(4,J)-PLAB(3,J)))
16640 IF(I.LE.2.AND.(Y(I).LT.YJMIN.OR.Y(I).GT.YJMAX)) RETURN
16642 IF(PT(1).LT.PTMIN.OR.PT(2).LT.PTMIN) RETURN
16643 C--masses of composite particles
16644 M34S = (PLAB(4,3)+PLAB(4,4))**2
16645 M45S = (PLAB(4,4)+PLAB(4,5))**2
16646 M35S = (PLAB(4,3)+PLAB(4,5))**2
16648 M34S = M34S-(PLAB(I,3)+PLAB(I,4))**2
16649 M45S = M45S-(PLAB(I,4)+PLAB(I,5))**2
16650 M35S = M35S-(PLAB(I,3)+PLAB(I,5))**2
16655 IF(M34.LT.MJJMIN) RETURN
16656 C--tramsverse masses of the composite particles
16661 MT34 = MT34+(PLAB(I,3)+PLAB(I,4))**2
16662 MT35 = MT35+(PLAB(I,3)+PLAB(I,5))**2
16663 MT45 = MT45+(PLAB(I,4)+PLAB(I,5))**2
16665 MT34 = SQRT(M34S+MT34)
16666 MT35 = SQRT(M35S+MT35)
16667 MT45 = SQRT(M45S+MT45)
16668 C--final the momenta
16669 PS34 = HWUPCM(M34,MQ(1),MQ(2))
16670 PS35 = HWUPCM(M35,MQ(1),MQ(3))
16671 PS45 = HWUPCM(M45,MQ(2),MQ(3))
16672 C--the rapidities of the composite particles
16673 ETMP = PLAB(4,3)+PLAB(4,4)
16674 PZTMP = PLAB(3,3)+PLAB(3,4)
16675 Y34 = HALF*LOG((ETMP+PZTMP)/(ETMP-PZTMP))
16677 ETMP = PLAB(4,3)+PLAB(4,5)
16678 PZTMP = PLAB(3,3)+PLAB(3,5)
16679 Y35 = HALF*LOG((ETMP+PZTMP)/(ETMP-PZTMP))
16681 ETMP = PLAB(4,4)+PLAB(4,5)
16682 PZTMP = PLAB(3,4)+PLAB(3,5)
16683 Y45 = HALF*LOG((ETMP+PZTMP)/(ETMP-PZTMP))
16685 C--find the pdf's and set the scale
16688 CALL HWSGEN(.FALSE.)
16689 C--construct the incoming momenta
16693 PLAB(3,I) = HALF*XX(I)*PHEP(5,3)
16694 PLAB(4,I) = HALF*XX(I)*PHEP(5,3)
16697 PLAB(3,2) = -PLAB(3,2)
16699 C--find the smoothing functions for the different channels
16700 C--function for first channel
16702 CALL HWH2P1(1,MJAC,MQ2(1),M35S,(PHEP(5,3)-MQ(2))**2,
16703 & (MQ(1)+MQ(3))**2)
16704 MJAC = MJAC/PS35*M35
16705 CALL HWH2P2(1,PTJ(1),MT2(2),PTMAX**2+MQ2(2),MQ2(2)+PTMIN**2)
16706 YMAX = MIN(YJJMAX, LOG(PHEP(5,3)/MT35))
16707 YMIN = MAX(YJJMIN,-LOG(PHEP(5,3)/MT35))
16709 YMAX = MIN(YJMAX, LOG((PHEP(5,3)-MT35*EY35)/MT(2)))
16710 YMIN = MAX(YJMIN,-LOG((PHEP(5,3)-MT35/EY35)/MT(2)))
16711 YJAC = (YMAX-YMIN)*YJAC
16712 G(1) = 2.0D0*MJAC*PTJ(1)/YJAC
16714 C--function for second channel
16717 CALL HWH2P2(1,PTJ(I),MT2(I),PTMAX**2+MQ2(I),MQ2(I)+PTMIN**2)
16723 YMAX = MIN(YJMAX, LOG((PHEP(5,3)-XT1)/MT(I)))
16724 YMIN = MAX(YJMIN,-LOG((PHEP(5,3)-XT2)/MT(I)))
16725 XT1 = XT1+MT(I)*EY(I)
16726 XT2 = XT2+MT(I)/EY(I)
16727 YJAC = YJAC*(YMAX-YMIN)
16729 G(2) = 4.0D0*PTJ(1)*PTJ(2)/YJAC
16731 C--function for third channel
16733 CALL HWH2P1(1,MJAC,MQ2(2),M45S,(PHEP(5,3)-MQ(1))**2,
16734 & (MQ(2)+MQ(3))**2)
16735 MJAC = MJAC/PS45*M45
16736 CALL HWH2P2(1,PTJ(1),MT2(1),PTMAX**2+MQ2(1),MQ2(1)+PTMIN**2)
16737 YMAX = MIN(YJJMAX, LOG(PHEP(5,3)/MT45))
16738 YMIN = MAX(YJJMIN,-LOG(PHEP(5,3)/MT45))
16740 YMAX = MIN(YJMAX, LOG((PHEP(5,3)-MT45*EY45)/MT(1)))
16741 YMIN = MAX(YJMIN,-LOG((PHEP(5,3)-MT45/EY45)/MT(1)))
16742 YJAC = (YMAX-YMIN)*YJAC
16743 G(3) = 2.0D0*MJAC*PTJ(1)/YJAC
16745 C--function for fourth channel
16747 CALL HWHGB1(1,1,200,SJAC,STOT,PHEP(5,3)**2,
16748 & (MQ(1)+MQ(2)+MQ(3))**2)
16750 CALL HWH2P1(1,MJAC,MQ2(1),M35S,(ETOT-MQ(2))**2,(MQ(1)+MQ(3))**2)
16752 MJAC = MJAC/PS35*M35
16753 PST = HWUPCM(ETOT,M35,MQ(2))
16754 G(4) = SJAC*MJAC/XJAC*ETOT/PST
16756 C--function for fifth channel
16758 CALL HWHGB1(1,1,200,SJAC,STOT,PHEP(5,3)**2,
16759 & (MQ(1)+MQ(2)+MQ(3))**2)
16761 CALL HWH2P1(1,MJAC,MQ2(2),M45S,(ETOT-MQ(1))**2,(MQ(2)+MQ(3))**2)
16762 MJAC = MJAC/PS45*M45
16763 PST = HWUPCM(ETOT,M45,MQ(1))
16764 G(5) = SJAC/XJAC*MJAC/PST*ETOT
16766 C--function for sixth chaneel
16768 CALL HWH2P1(1,MJAC,ZERO,M34S,(PHEP(5,3)-MQ(3))**2,MJJMIN**2)
16769 MJAC = MJAC/PS34*M34
16770 CALL HWH2P2(1,PTJ(1),MT2(3),MQ2(3)+PTMAX**2,MQ2(3))
16771 YMAX = MIN(YJJMAX, LOG(PHEP(5,3)/MT34))
16772 YMIN = MAX(YJJMIN,-LOG(PHEP(5,3)/MT34))
16774 YMAX = MIN(YJMAX, LOG((PHEP(5,3)-MT34*EY34)/MT(3)))
16775 YMIN = MAX(YJMIN,-LOG((PHEP(5,3)-MT34/EY34)/MT(3)))
16776 YJAC = (YMAX-YMIN)*YJAC
16777 G(6) = 2.0D0*MJAC/YJAC*PTJ(1)
16782 IF(CHON(I)) DEM = DEM+CHNPRB(I)*G(I)
16785 WEIGHT = FLUX*GEV2NB*G(ICH)/DEM
16787 C--compute the weights for the different channels if optimizing
16790 IF(CHON(I)) WI(I)=G(I)*WEIGHT**2/DEM
16795 *CMZ :- -02/04/01 12.11.55 by Peter Richardson
16796 *-- Author : Peter Richardson
16797 C-----------------------------------------------------------------------
16798 SUBROUTINE HWH2P1(IOPT,FJAC,MQ2,M2,MMX,MMN)
16799 C-----------------------------------------------------------------------
16800 C Subroutine to select virtual quark mass for HWH2PS
16801 C IOPT=1 return the function at M2
16802 C IOPT=2 calculate M2
16803 C-----------------------------------------------------------------------
16804 INCLUDE 'herwig65.inc'
16806 DOUBLE PRECISION FJAC,MPOW,MMN,MQ2,M2,A1,A01,RPOW,QPOW,HWRGEN,MMX
16808 C--smooth a powerlaw
16809 IF(EMPOW.EQ.TWO) THEN
16811 A1 = LOG(MMX-MQ2)-A01
16813 FJAC = ONE/(M2-MQ2)/A1
16815 M2 = EXP(A01+A1*HWRGEN(2))
16823 A01 = (MMN-MQ2)**QPOW
16824 A1 = (MMX-MQ2)**QPOW-A01
16826 FJAC = QPOW*(M2-MQ2)**MPOW/A1
16828 M2 = (A01+A1*HWRGEN(2))**RPOW
16829 FJAC = A1*RPOW/M2**MPOW
16835 *CMZ :- -02/04/01 12.11.55 by Peter Richardson
16836 *-- Author : Peter Richardson
16837 C-----------------------------------------------------------------------
16838 SUBROUTINE HWH2P2(IOPT,FJAC,PT2,PTMX2,PTMN2)
16839 C-----------------------------------------------------------------------
16840 C Subroutine to select virtual quark mass for HWH2PS
16841 C IOPT=1 return the function at M2
16842 C IOPT=2 calculate M2
16843 C-----------------------------------------------------------------------
16844 INCLUDE 'herwig65.inc'
16846 DOUBLE PRECISION FJAC,MPOW,A1,A01,RPOW,QPOW,HWRGEN,PT2,
16847 & PPOW,PTMN2,PTMX2,Z
16849 C--smooth a powerlaw
16851 IF(PPOW.EQ.ONE) THEN
16853 A1 = LOG(PTMX2)-A01
16857 PT2 = EXP(A01+A1*HWRGEN(2))
16865 A1 = PTMX2**QPOW-A01
16867 FJAC = QPOW*PT2**MPOW/A1
16869 Z = A01+A1*HWRGEN(2)
16871 FJAC = A1*RPOW/Z*PT2
16876 *CMZ :- -26/11/00 17.21.55 by Bryan Webber
16877 *-- Author : Kosuke Odagiri
16878 C-----------------------------------------------------------------------
16879 SUBROUTINE HWH2QH(SQS,P1,P2,P3,P4,P5,RM3,RM4,RM5,FACGPM,MGM3,
16880 & IGG,IQQ,GGQQHT,GGQQHU,GGQQHNP,QQQQH)
16881 C-----------------------------------------------------------------------
16882 C MATRIX ELEMENT SQUARED FOR THE PROCESS GG/QQ(BAR) -> QQ(BAR) HIGGS
16883 C-----------------------------------------------------------------------
16884 C NEEDS PREFACTOR G_S^4. COUPLINGS, E.G. FOR T(3)B(4)H-(5) ARE:
16885 C FACGPM(1) = GW/SQRT(TWO) M_B / M_W * TANB
16886 C FACGPM(2) = GW/SQRT(TWO) M_T / M_W / TANB
16887 C MGM3 = (TOP MASS)*(TOP WIDTH)
16888 C INITIAL STATE MOMENTA: P1=(SQS/2)(1,0,0,1), P2=(SQS/2)(1,0,0,-1)
16890 C GGQQHTOT = (G_S**4)*(GGQQHT+GGQQHU-GGQQHNP/CAFAC**2)/(8.*CFFAC)
16891 C QQQQHTOT = (G_S**4)*(QQQQH )*(1.-1./CAFAC**2)/4.
16892 C N.B. SUBROUTINE CANNOT BE USED FOR PHOTON PHOTON -> ...
16893 C-----------------------------------------------------------------------
16897 C --- CENTRE-OF-MASS ENERGY, FOUR-MOMENTA, MASSES AND WIDTHS
16898 DOUBLE PRECISION SQS,P1(0:3),P2(0:3),P3(0:3),P4(0:3),P5(0:3)
16899 DOUBLE PRECISION K3(0:3),K4(0:3), Q3(0:3),Q4(0:3), R3(0:3),R4(0:3)
16900 DOUBLE PRECISION RM3,RM4,RM5, MGM3,MGM4, TWOSQS
16902 DOUBLE COMPLEX U0(4), F3(4,2),F4(4,2), F3K(4,2),F4K(4,2)
16903 DOUBLE COMPLEX F3Q(4,2,2),F4Q(4,2,2), F3R(4,2,2),F4R(4,2,2)
16904 C --- MOMENTUM PROJECTION OPERATORS
16905 DOUBLE COMPLEX P3PROJ(4,4),P4PROJ(4,4),K3PROJ(4,4),K4PROJ(4,4)
16906 DOUBLE COMPLEX Q3PROJ(4,4),Q4PROJ(4,4),R3PROJ(4,4),R4PROJ(4,4)
16907 C --- SPINOR INDICES AND PERMUTATION MATRICES
16908 INTEGER I,J,K,L, PERM0(4), PL(4,2),PR(4,2), PERMU0(4)
16909 C --- CHIRALITY PROJECTION OPERATORS: 1 = - , 2 = +
16910 DOUBLE PRECISION FACGPM(2),FACL(2,2),FACR(2,2),FAC0(2,2)
16911 C --- GG AMPLITUDES
16912 DOUBLE COMPLEX AMPS1(2,2),AMPS2(2,2)
16913 DOUBLE COMPLEX AMPT1(2,2,2,2),AMPT2(2,2,2,2),AMPT3(2,2,2,2)
16914 DOUBLE COMPLEX AMPU1(2,2,2,2),AMPU2(2,2,2,2),AMPU3(2,2,2,2)
16915 DOUBLE COMPLEX AMPS, AMPT, AMPU, AMPST, AMPSU, AMPTU
16916 DOUBLE PRECISION AMPST2, AMPSU2, AMPTU2
16917 DOUBLE PRECISION GGQQHT,GGQQHU,GGQQHNP,QQQQH
16918 C --- QQ AMPLITUDES
16919 DOUBLE PRECISION RM3452
16920 DOUBLE PRECISION S,PT32,PT42,PT52,GLAMBDA,LAMBDA,LAMBDAI,LA34,
16921 & PROP2,PROP3R,PROP3I,PROP4R,PROP4I,PROP34R,PT3452
16922 DOUBLE COMPLEX PROP3,PROP4,PROP
16924 DOUBLE PRECISION ZERO,ONE,TWO,MONE,FAC
16925 DOUBLE COMPLEX CZERO,CONE
16927 C --- PARAMETER DEFINITIONS
16928 PARAMETER (ZERO=0.D0,ONE=1.D0,TWO=2.D0,MONE=-ONE, LEFT=1,RIGHT=2)
16929 PARAMETER (CZERO=(0.D0,0.D0),CONE=(1.D0,0.D0))
16930 SAVE MGM4,PERM0,PL,FACL,PR,FACR,PERMU0,FAC0,U0
16931 DATA MGM4,U0,FAC0 /ZERO, 4*CONE , ONE,ZERO, ZERO, ONE /
16932 DATA PERM0 ,PERMU0 / 1,2, 3,4 , 1,0, 0,4 /
16933 DATA PL ,PR / 0,3, 0,1, 4,0, 2,0, 4,0, 2,0, 0,3, 0,1 /
16934 DATA FACL ,FACR /MONE, ONE, ONE,MONE, ONE,MONE, MONE, ONE /
16941 IF(IGG.EQ.0)GOTO 100
16944 Q3(I) = P3(I)-P1(I)
16945 Q4(I) = P4(I)-P2(I)
16946 R3(I) = P3(I)-P2(I)
16947 R4(I) = P4(I)-P1(I)
16948 K3(I) = P3(I)+P5(I)
16949 K4(I) = P4(I)+P5(I)
16951 CALL HWUMPO(P3, RM3, (P3(0)-P3(3)) ,ZERO,P3PROJ, .FALSE.)
16952 CALL HWUMPO(P4,-RM4, (P4(0)+P4(3)) ,ZERO,P4PROJ, .FALSE.)
16953 CALL HWUMPO(Q3, RM3,-SQS*(P3(0)-P3(3)) ,ZERO,Q3PROJ, .FALSE.)
16954 CALL HWUMPO(Q4,-RM4,-SQS*(P4(0)+P4(3)) ,ZERO,Q4PROJ, .FALSE.)
16955 CALL HWUMPO(R3, RM3,-SQS*(P3(0)+P3(3)) ,ZERO,R3PROJ, .FALSE.)
16956 CALL HWUMPO(R4,-RM4,-SQS*(P4(0)-P4(3)) ,ZERO,R4PROJ, .FALSE.)
16957 CALL HWUMPO(K3, RM4,SQS*(SQS-2.D0*P4(0)),MGM4,K3PROJ, .TRUE.)
16958 CALL HWUMPO(K4,-RM3,SQS*(SQS-2.D0*P3(0)),MGM3,K4PROJ, .TRUE.)
16960 CALL HWUMPP(P3PROJ,FAC0(1,I),PERMU0 ,U0 ,F3(1,I) , LEFT)
16961 CALL HWUMPP(K3PROJ,FACGPM ,PERM0 ,F3(1,I),F3K(1,I) , LEFT)
16962 CALL HWUMPP(P4PROJ,FAC0(1,I),PERMU0 ,U0 ,F4(1,I) , RIGHT)
16963 CALL HWUMPP(K4PROJ,FACGPM ,PERM0 ,F4(1,I),F4K(1,I) , RIGHT)
16965 CALL HWUMPP(Q3PROJ,FACL(1,J),PL(1,J),F3(1,I),F3Q(1,I,J), LEFT)
16966 CALL HWUMPP(R3PROJ,FACL(1,J),PL(1,J),F3(1,I),F3R(1,I,J), LEFT)
16967 CALL HWUMPP(R4PROJ,FACR(1,J),PR(1,J),F4(1,I),F4R(1,I,J), RIGHT)
16968 CALL HWUMPP(Q4PROJ,FACR(1,J),PR(1,J),F4(1,I),F4Q(1,I,J), RIGHT)
16973 AMPS1(I,J)=( - F3K(1,I)* F4(3,J) + F3K(2,I)* F4(4,J)
16974 & + F3K(3,I)* F4(1,J) - F3K(4,I)* F4(2,J) ) * TWOSQS
16975 AMPS2(I,J)=( - F3(1,I)*F4K(3,J) + F3(2,I)*F4K(4,J)
16976 & + F3(3,I)*F4K(1,J) - F3(4,I)*F4K(2,J) ) * TWOSQS
16978 AMPT1(1,K,I,J)= F3K(1,I)*F4Q(4,J,K)-F3K(3,I)*F4Q(2,J,K)
16979 AMPT1(2,K,I,J)=-F3K(2,I)*F4Q(3,J,K)+F3K(4,I)*F4Q(1,J,K)
16980 AMPT3(K,1,I,J)= F3Q(1,I,K)*F4K(4,J)-F3Q(3,I,K)*F4K(2,J)
16981 AMPT3(K,2,I,J)=-F3Q(2,I,K)*F4K(3,J)+F3Q(4,I,K)*F4K(1,J)
16982 AMPU1(K,1,I,J)= F3K(1,I)*F4R(4,J,K)-F3K(3,I)*F4R(2,J,K)
16983 AMPU1(K,2,I,J)=-F3K(2,I)*F4R(3,J,K)+F3K(4,I)*F4R(1,J,K)
16984 AMPU3(1,K,I,J)= F3R(1,I,K)*F4K(4,J)-F3R(3,I,K)*F4K(2,J)
16985 AMPU3(2,K,I,J)=-F3R(2,I,K)*F4K(3,J)+F3R(4,I,K)*F4K(1,J)
16988 & = FACGPM(1)*( F3Q(1,I,K)*F4Q(1,J,L)+F3Q(2,I,K)*F4Q(2,J,L) )
16989 & + FACGPM(2)*( F3Q(3,I,K)*F4Q(3,J,L)+F3Q(4,I,K)*F4Q(4,J,L) )
16991 & = FACGPM(1)*( F3R(1,I,K)*F4R(1,J,L)+F3R(2,I,K)*F4R(2,J,L) )
16992 & + FACGPM(2)*( F3R(3,I,K)*F4R(3,J,L)+F3R(4,I,K)*F4R(4,J,L) )
17005 AMPS = AMPS1(K,L) - AMPS2(K,L)
17009 AMPT = AMPT1(I,J,K,L)+AMPT2(I,J,K,L)+AMPT3(I,J,K,L)
17010 AMPU = AMPU1(I,J,K,L)+AMPU2(I,J,K,L)+AMPU3(I,J,K,L)
17011 AMPST = AMPS - AMPT
17012 AMPSU = AMPS + AMPU
17013 AMPTU = AMPT + AMPU
17014 AMPST2 = AMPST2 + DREAL(DCONJG(AMPST)*AMPST)
17015 AMPSU2 = AMPSU2 + DREAL(DCONJG(AMPSU)*AMPSU)
17016 AMPTU2 = AMPTU2 + DREAL(DCONJG(AMPTU)*AMPTU)
17021 FAC = (P3(0)-P3(3))*(P4(0)+P4(3))
17022 GGQQHT = FAC*AMPST2
17023 GGQQHU = FAC*AMPSU2
17024 GGQQHNP = FAC*AMPTU2
17027 IF(IQQ.EQ.0)GOTO 200
17029 PT32 = P3(1)**2+P3(2)**2
17030 PT42 = P4(1)**2+P4(2)**2
17031 PT52 = P5(1)**2+P5(2)**2
17032 PT3452 = (PT32+PT42-PT52)/TWO
17033 RM3452 = (RM3**2+RM4**2-RM5**2)/TWO
17034 GLAMBDA = FACGPM(1)**2+FACGPM(2)**2
17035 LAMBDA = TWO*FACGPM(1)*FACGPM(2)/GLAMBDA
17036 LAMBDAI = (FACGPM(2)**2-FACGPM(1)**2)/GLAMBDA
17037 LA34 = S/TWO-SQS*P5(0)-RM3452-LAMBDA*RM3*RM4
17038 PROP3 = ONE/DCMPLX(SQS*(SQS-TWO*P4(0)),ZERO)
17039 PROP4 = ONE/DCMPLX(SQS*(SQS-TWO*P3(0)),MGM3)
17041 PROP2 = DREAL(DCONJG(PROP)*PROP)
17042 PROP3R = DREAL(DCONJG(PROP)*PROP3)
17043 PROP3I = DIMAG(DCONJG(PROP)*PROP3)
17044 PROP4R = DREAL(DCONJG(PROP)*PROP4)
17045 PROP4I = DIMAG(DCONJG(PROP)*PROP4)
17046 PROP34R = DREAL(DCONJG(PROP3)*PROP4)
17047 QQQQH = TWO*GLAMBDA/S*(S*PROP2*(PT3452+TWO*P3(0)*P4(0)-
17048 & LA34)+TWO*LA34*(PROP3R*PT42+PROP4R*PT32-PROP34R*PT52)-TWO*SQS*((
17049 & PROP3R*(P3(0)*PT42+P4(0)*PT3452)+PROP4R*(P4(0)*PT32+P3(0)*PT3452)
17050 & )-(PROP3I*P4(3)-PROP4I*P3(3))*LAMBDAI*(P3(1)*P4(2)-P3(2)*P4(1))))
17054 *CMZ :- -30/06/01 18.25.35 by Stefano Moretti
17055 *-- Author : Kosuke Odagiri & Stefano Moretti
17056 C-----------------------------------------------------------------------
17057 SUBROUTINE HWH2SH(SQS,P1,P2,P3,P4,P5,RM3,RM4,RM5,MGM3,MGM4,
17058 & IGG,IQQ,GGSQHT,GGSQHU,GGSQHN,QQSQH)
17059 C-----------------------------------------------------------------------
17060 C MATRIX ELEMENT SQUARED FOR THE PROCESS GG/QQ(BAR) -> SQ SQ* HIGGS
17061 C-----------------------------------------------------------------------
17062 C NEEDS PREFACTOR G_S^4 AND G_(HIGGS-SQ-SQ)^2
17063 C MGM3, MGM4 = MASS * WIDTH
17064 C INITIAL STATE MOMENTA: P1=(SQS/2)(1,0,0,1), P2=(SQS/2)(1,0,0,-1)
17067 C (G_S**4)*(G_HIGGS**2)*(GGSQHT+GGSQHU-GGSQHN/CAFAC**2)/(8.*CFFAC)
17069 C (G_S**4)*(G_HIGGS**2)*(QQSQH )*(1.-1./CAFAC**2)/4.
17070 C N.B. SUBROUTINE CANNOT BE USED FOR PHOTON PHOTON -> ...
17072 C...First release: 08-OCT-1999 by Kosuke Odagiri
17073 C...First modified: 12-NOV-1999 by Stefano Moretti
17074 C-----------------------------------------------------------------------
17078 C --- CENTRE-OF-MASS ENERGY, FOUR-MOMENTA, MASSES AND WIDTHS
17079 DOUBLE PRECISION SQS,P1(0:3),P2(0:3),P3(0:3),P4(0:3),P5(0:3)
17080 DOUBLE PRECISION RM3,RM4,RM5, MGM3,MGM4
17081 C --- POLARISATION INDICES, PROPAGATORS AND GG AMPLITUDES
17083 DOUBLE PRECISION G14,G24,G23,G13,MSQS, GGSQHT,GGSQHU,GGSQHN
17084 DOUBLE COMPLEX G35,G45, AMPT,AMPU,AMPS,AMPC, AMPST,AMPSU,AMPTU
17085 C --- QQ AMPLITUDES
17086 DOUBLE PRECISION QQSQH
17087 DOUBLE PRECISION PT32,PT42,PT34
17088 DOUBLE COMPLEX PROP3,PROP4
17089 C --- CONSTANT PARAMETERS
17090 DOUBLE PRECISION ZERO,ONE,TWO,SQTWO,MSQTWO
17091 PARAMETER (ZERO=0.D0,ONE=1.D0,TWO=2.D0)
17098 IF(IGG.EQ.0)GOTO 100
17099 C -- GG SCATTERING.
17101 G13 = MSQS/(P3(0)-P3(3))
17102 G23 = MSQS/(P3(0)+P3(3))
17103 G14 = MSQS/(P4(0)-P4(3))
17104 G24 = MSQS/(P4(0)+P4(3))
17105 G35 = SQTWO/CMPLX(SQS*(SQS-TWO*P4(0)),MGM4)
17106 G45 = SQTWO/CMPLX(SQS*(SQS-TWO*P3(0)),MGM3)
17107 AMPS = 0.5D0*MSQS*(P4(3)*G35-P3(3)*G45)
17108 AMPC = MSQTWO*(G35+G45)
17111 AMPT=P3(I)*P4(J)*G24*G13-P4(I)*P4(J)*G24*G35-P3(I)*P3(J)*G13*G45
17112 AMPU=P4(I)*P3(J)*G14*G23-P4(I)*P4(J)*G14*G35-P3(I)*P3(J)*G23*G45
17114 AMPST = AMPT-AMPS+AMPC
17115 AMPSU = AMPU+AMPS+AMPC
17120 AMPTU = AMPST+AMPSU
17121 GGSQHT = GGSQHT + DREAL(DCONJG(AMPST)*AMPST)
17122 GGSQHU = GGSQHU + DREAL(DCONJG(AMPSU)*AMPSU)
17123 GGSQHN = GGSQHN + DREAL(DCONJG(AMPTU)*AMPTU)
17127 IF(IQQ.EQ.0)GOTO 200
17128 C -- QQ SCATTERING.
17129 PT32 = P3(1)**2+P3(2)**2
17130 PT42 = P4(1)**2+P4(2)**2
17131 PT34 = P3(1)*P4(1)+P3(2)*P4(2)
17132 PROP3 = ONE/CMPLX(SQS*(SQS-TWO*P3(0)),MGM3)
17133 PROP4 = ONE/CMPLX(SQS*(SQS-TWO*P4(0)),MGM4)
17134 QQSQH = TWO/SQS**2*DREAL(PT32*DCONJG(PROP3)*PROP3+
17135 & PT42*DCONJG(PROP4)*PROP4-TWO*PT34*DCONJG(PROP3)*PROP4)
17139 *CMZ :- -27/02/01 17:04:16 by Peter Richardson
17140 C-----------------------------------------------------------------------
17141 SUBROUTINE HWH2SS(S,K,KK)
17142 C-----------------------------------------------------------------------
17143 C Subroutine to calculate the spinor products in the notation of
17144 C Kleiss and Strirling S(1) is S and S(2) is T
17145 C-----------------------------------------------------------------------
17146 INCLUDE 'herwig65.inc'
17147 DOUBLE PRECISION WRN(2),K(5),KK(5),P(5,2),Q1,Q2,EPS,QTI,PTI,
17148 & PT,QT,DPM,DMP,QP,QM,P1,P2,PP,PM
17149 DOUBLE COMPLEX S(2),ZI,Z1,ZT,ZQ,ZQS,ZPS,ZP,ZDPM,ZDMP
17152 ZI=DCMPLX(ZERO,ONE)
17153 Z1=DCMPLX(ONE,ZERO)
17154 C FOLLOWING DO LOOP IS TO CONVERT TO OUR STANDARD INDEXING
17161 IF(P(4,II).LT.ZERO) WRN(II)=-ONE
17163 P(JJ,II)=WRN(II)*P(JJ,II)
17165 C THE ABOVE CHECKS FOR MOMENTA WITH NEGATIVE ENERGY,INNER PRODUCTS
17166 C ARE EXPRESSED DIFFERENTLY FOR DIFFERENT CASES
17169 IF(Q1.GT.EPS) QP=SQRT(Q1)
17172 IF(Q2.GT.EPS)QM=SQRT(Q2)
17175 IF(P1.GT.EPS)PP=SQRT(P1)
17178 IF(P2.GT.EPS)PM=SQRT(P2)
17180 ZDMP=DCMPLX(DMP,ZERO)
17182 ZDPM=DCMPLX(DPM,ZERO)
17183 C NOTE THAT IN OUR INNER PRODUCT NOTATION WE ARE COMPUTING <P,Q>
17184 PT=SQRT(P(2,2)**2+P(3,2)**2)
17185 QT=SQRT(P(2,1)**2+P(3,1)**2)
17186 IF(PT.GT.EPS) GOTO 99
17190 ZP=DCMPLX(PTI*P(2,2),PTI*P(3,2))
17192 IF(QT.GT.EPS) GOTO 89
17196 ZQ=DCMPLX(QTI*P(2,1),QTI*P(3,1))
17199 IF(WRN(1).LT.ZERO) ZT=ZT*ZI
17200 IF(WRN(2).LT.ZERO) ZT=ZT*ZI
17201 S(2)=-(ZDMP*ZP-ZDPM*ZQ)*ZT
17202 S(1)=(ZDMP*ZPS-ZDPM*ZQS)*ZT
17205 *CMZ :- -27/02/01 17:04:16 by Peter Richardson
17206 *-- Author : Peter Richardson
17207 C-----------------------------------------------------------------------
17208 FUNCTION HWH2T1(I,J,K,L,Z1,Z2,P1)
17209 C-----------------------------------------------------------------------
17210 C Returns the amplitude T1 from Nucl. Phys. B262 (1985) 235-262
17211 C I-L are the particles
17212 C Z1 and Z2 are the decay products of the Z
17213 C P1 is the polarization of the line I,J
17214 C-----------------------------------------------------------------------
17215 INCLUDE 'herwig65.inc'
17216 DOUBLE COMPLEX HWH2T1,S,D
17217 INTEGER I,J,K,L,Z1,Z2,P1
17218 COMMON/HWHEWS/S(8,8,2),D(8,8)
17220 HWH2T1 = TWO*S(I,Z2,1)*S(Z1,J,2)
17221 ELSEIF(P1.EQ.2) THEN
17222 HWH2T1 = TWO*S(I,Z1,2)*S(Z2,J,1)
17224 CALL HWWARN('HWH2T1',500)
17228 *CMZ :- -27/02/01 17:04:16 by Peter Richardson
17229 *-- Author : Peter Richardson
17230 C-----------------------------------------------------------------------
17231 FUNCTION HWH2T2(I,J,K,L,Z1,Z2,P1,P2)
17232 C-----------------------------------------------------------------------
17233 C Returns the amplitude T2 from Nucl. Phys. B262 (1985) 235-262
17234 C I-L are the particles
17235 C Z1 and Z2 are the decay products of the Z
17236 C P1 is the polarization of the line I,J
17237 C P2 is the polarization of the gluon K
17238 C-----------------------------------------------------------------------
17239 INCLUDE 'herwig65.inc'
17240 DOUBLE COMPLEX HWH2T2,S,D
17241 INTEGER I,J,K,L,Z1,Z2,P1,P2
17242 DOUBLE PRECISION B(6)
17243 COMMON/HWHEWS/S(8,8,2),D(8,8)
17245 DATA B/-1.0D0,-1.0D0,1.0D0,1.0D0,1.0D0,1.0D0/
17246 IF(P1.EQ.1.AND.P2.EQ.1) THEN
17247 HWH2T2 = FOUR*B(J)*S(I,Z2,1)*S(Z1,J,2)*S(J,K,1)*S(I,J,2)
17248 ELSEIF(P1.EQ.1.AND.P2.EQ.2) THEN
17249 HWH2T2 = FOUR*S(I,Z2,1)*S(K,J,2)*(B(J)*S(Z1,J,2)*S(J,I,1)
17250 & +B(K)*S(Z1,K,2)*S(K,I,1))
17251 ELSEIF(P1.EQ.2.AND.P2.EQ.1) THEN
17252 HWH2T2 = FOUR*S(I,Z1,2)*S(K,J,1)*(B(J)*S(Z2,J,1)*S(J,I,2)
17253 & +B(K)*S(Z2,K,1)*S(K,I,2))
17254 ELSEIF(P1.EQ.2.AND.P2.EQ.2) THEN
17255 HWH2T2 = FOUR*B(J)*S(I,Z1,2)*S(Z2,J,1)*S(J,K,2)*S(I,J,1)
17257 CALL HWWARN('HWH2T2',500)
17261 *CMZ :- -27/02/01 17:04:16 by Peter Richardson
17262 *-- Author : Peter Richardson
17263 C-----------------------------------------------------------------------
17264 FUNCTION HWH2T3(I,J,K,L,Z1,Z2,P1,P2)
17265 C-----------------------------------------------------------------------
17266 C Returns the amplitude T3 from Nucl. Phys. B262 (1985) 235-262
17267 C I-L are the particles
17268 C Z1 and Z2 are the decay products of the Z
17269 C P1 is the polarization of the line I,J
17270 C P2 is the polarization of the gluon K
17271 C-----------------------------------------------------------------------
17272 INCLUDE 'herwig65.inc'
17273 DOUBLE COMPLEX HWH2T3,S,D
17274 INTEGER I,J,K,L,Z1,Z2,P1,P2
17275 DOUBLE PRECISION B(6)
17276 COMMON/HWHEWS/S(8,8,2),D(8,8)
17278 DATA B/-1.0D0,-1.0D0,1.0D0,1.0D0,1.0D0,1.0D0/
17279 IF(P1.EQ.1.AND.P2.EQ.1) THEN
17280 HWH2T3 = FOUR*B(K)*S(I,K,1)*S(I,K,2)*S(K,Z2,1)*S(Z1,J,2)
17281 ELSEIF(P1.EQ.1.AND.P2.EQ.2) THEN
17283 ELSEIF(P1.EQ.2.AND.P2.EQ.1) THEN
17285 ELSEIF(P1.EQ.2.AND.P2.EQ.2) THEN
17286 HWH2T3 = FOUR*B(K)*S(I,K,2)*S(I,K,1)*S(K,Z1,2)*S(Z2,J,1)
17288 CALL HWWARN('HWH2T3',500)
17292 *CMZ :- -27/02/01 17:04:16 by Peter Richardson
17293 *-- Author : Peter Richardson
17294 C-----------------------------------------------------------------------
17295 FUNCTION HWH2T4(I,J,K,L,Z1,Z2,P1,P2)
17296 C-----------------------------------------------------------------------
17297 C Returns the amplitude T4 from Nucl. Phys. B262 (1985) 235-262
17298 C I-L are the particles
17299 C Z1 and Z2 are the decay products of the Z
17300 C P1 is the polarization of the line I,J
17301 C P2 is the polarization of the line K,L
17302 C-----------------------------------------------------------------------
17303 INCLUDE 'herwig65.inc'
17304 DOUBLE COMPLEX HWH2T4,AP,AM,S,D
17305 INTEGER I,J,K,L,Z1,Z2,J1,J2,J3,J4,P1,P2
17306 DOUBLE PRECISION B(6)
17307 COMMON/HWHEWS/S(8,8,2),D(8,8)
17309 DATA B/-1.0D0,-1.0D0,1.0D0,1.0D0,1.0D0,1.0D0/
17310 AP(J1,J2,J3,J4) = FOUR*S(J1,Z2,1)*S(J4,J2,2)*
17311 & (S(Z1,Z2,2)*S(Z2,J3,1)+B(J1)*S(Z1,J1,2)*S(J1,J3,1))
17312 AM(J1,J2,J3,J4) = FOUR*S(J1,Z1,2)*S(J4,J2,1)*
17313 & (S(Z2,Z1,1)*S(Z1,J3,2)+B(J1)*S(Z2,J1,1)*S(J1,J3,2))
17314 IF(P1.EQ.1.AND.P2.EQ.1) THEN
17315 HWH2T4 = AP(I,J,K,L)
17316 ELSEIF(P1.EQ.1.AND.P2.EQ.2) THEN
17317 HWH2T4 = AP(I,J,L,K)
17318 ELSEIF(P1.EQ.2.AND.P2.EQ.1) THEN
17319 HWH2T4 = AM(I,J,L,K)
17320 ELSEIF(P1.EQ.2.AND.P2.EQ.2) THEN
17321 HWH2T4 = AM(I,J,K,L)
17323 CALL HWWARN('HWH2T4',500)
17327 *CMZ :- -27/02/01 17:04:16 by Peter Richardson
17328 *-- Author : Peter Richardson
17329 C-----------------------------------------------------------------------
17330 FUNCTION HWH2T5(I,J,K,L,Z1,Z2,P1,P2)
17331 C-----------------------------------------------------------------------
17332 C Returns the amplitude T5 from Nucl. Phys. B262 (1985) 235-262
17333 C I-L are the particles
17334 C Z1 and Z2 are the decay products of the Z
17335 C P1 is the polarization of the line I,J
17336 C P2 is the polarization of the line K,L
17337 C-----------------------------------------------------------------------
17338 INCLUDE 'herwig65.inc'
17339 DOUBLE COMPLEX HWH2T5,AP,AM,S,D
17340 INTEGER I,J,K,L,Z1,Z2,J1,J2,J3,J4,P1,P2
17341 DOUBLE PRECISION B(6)
17342 COMMON/HWHEWS/S(8,8,2),D(8,8)
17344 DATA B/-1.0D0,-1.0D0,1.0D0,1.0D0,1.0D0,1.0D0/
17345 AP(J1,J2,J3,J4) = FOUR*S(J1,Z2,1)*S(J4,J2,2)*
17346 & (S(Z1,Z2,2)*S(Z2,J3,1)+B(J1)*S(Z1,J1,2)*S(J1,J3,1))
17347 AM(J1,J2,J3,J4) = FOUR*S(J1,Z1,2)*S(J4,J2,1)*
17348 & (S(Z2,Z1,1)*S(Z1,J3,2)+B(J1)*S(Z2,J1,1)*S(J1,J3,2))
17349 IF(P1.EQ.1.AND.P2.EQ.1) THEN
17350 HWH2T5 = AM(J,I,L,K)
17351 ELSEIF(P1.EQ.1.AND.P2.EQ.2) THEN
17352 HWH2T5 = AM(J,I,K,L)
17353 ELSEIF(P1.EQ.2.AND.P2.EQ.1) THEN
17354 HWH2T5 = AP(J,I,K,L)
17355 ELSEIF(P1.EQ.2.AND.P2.EQ.2) THEN
17356 HWH2T5 = AP(J,I,L,K)
17358 CALL HWWARN('HWH2T5',500)
17362 *CMZ :- -27/02/01 17:04:16 by Peter Richardson
17363 *-- Author : Peter Richardson
17364 C-----------------------------------------------------------------------
17365 FUNCTION HWH2T6(I,J,K,L,Z1,Z2,P1,P2,P3)
17366 C-----------------------------------------------------------------------
17367 C Returns the amplitude T6 from Nucl. Phys. B262 (1985) 235-262
17368 C I-L are the particles
17369 C Z1 and Z2 are the decay products of the Z
17370 C P1 is the polarization of the line I,J
17371 C P2 is the polarization of the gluon K
17372 C P3 is the polarization of the gluon L
17373 C-----------------------------------------------------------------------
17374 INCLUDE 'herwig65.inc'
17375 DOUBLE COMPLEX HWH2T6,S,D
17376 INTEGER I,J,K,L,Z1,Z2,J1,J2,P1,P2,P3
17377 DOUBLE PRECISION B(6)
17378 COMMON/HWHEWS/S(8,8,2),D(8,8)
17380 DATA B/-1.0D0,-1.0D0,1.0D0,1.0D0,1.0D0,1.0D0/
17388 IF((P1.EQ.1.AND.P2.EQ.1.AND.P3.EQ.1).OR.
17389 & (P1.EQ.2.AND.P2.EQ.2.AND.P3.EQ.2)) THEN
17390 HWH2T6 = 8.0D0*B(J)*S(I,J2,1)*D(L,J)*S(K,J,2)*
17391 & (B(J)*S(J1,J,2)*S(J,K,1)+B(L)*S(J1,L,2)*S(L,K,1))
17392 ELSEIF((P1.EQ.1.AND.P2.EQ.1.AND.P3.EQ.2).OR.
17393 & (P1.EQ.2.AND.P2.EQ.2.AND.P3.EQ.1)) THEN
17394 HWH2T6 = 8.0D0*B(J)*S(I,J2,1)*S(L,J,2)*S(J,K,1)*S(L,J,2)*
17395 & (B(J)*S(J1,J,2)*S(J,K,1)+B(L)*S(J1,L,2)*S(L,K,1))
17396 ELSEIF((P1.EQ.1.AND.P2.EQ.2.AND.P3.EQ.1).OR.
17397 & (P1.EQ.2.AND.P2.EQ.1.AND.P3.EQ.2)) THEN
17398 HWH2T6 = 8.0D0*B(J)*S(I,J2,1)*S(K,J,2)*S(J,L,1)*S(K,J,2)*
17399 & (B(J)*S(J1,J,2)*S(J,L,1)+B(K)*S(J1,K,2)*S(K,L,1))
17400 ELSEIF((P1.EQ.1.AND.P2.EQ.2.AND.P3.EQ.2).OR.
17401 & (P1.EQ.2.AND.P2.EQ.1.AND.P3.EQ.1)) THEN
17402 HWH2T6 = 8.0D0*S(I,J2,1)*S(L,J,2)*(B(J)*D(K,J)+B(L)*D(K,L))*
17403 & (B(J)*S(J1,J,2)*S(J,L,1)+B(K)*S(J1,K,2)*S(K,L,1))
17405 CALL HWWARN('HWH2T6',500)
17407 IF(P1.EQ.2) HWH2T6 = DCONJG(HWH2T6)
17410 *CMZ :- -27/02/01 17:04:16 by Peter Richardson
17411 *-- Author : Peter Richardson
17412 C-----------------------------------------------------------------------
17413 FUNCTION HWH2T7(I,J,K,L,Z1,Z2,P1,P2,P3)
17414 C-----------------------------------------------------------------------
17415 C Returns the amplitude T7 from Nucl. Phys. B262 (1985) 235-262
17416 C I-L are the particles
17417 C Z1 and Z2 are the decay products of the Z
17418 C P1 is the polarization of the line I,J
17419 C P2 is the polarization of the gluon K
17420 C P3 is the polarization of the gluon L
17421 C-----------------------------------------------------------------------
17422 INCLUDE 'herwig65.inc'
17423 DOUBLE COMPLEX HWH2T7,S,D
17424 INTEGER I,J,K,L,Z1,Z2,J1,J2,P1,P2,P3
17425 DOUBLE PRECISION B(6)
17426 COMMON/HWHEWS/S(8,8,2),D(8,8)
17428 DATA B/-1.0D0,-1.0D0,1.0D0,1.0D0,1.0D0,1.0D0/
17436 IF((P1.EQ.1.AND.P2.EQ.1.AND.P3.EQ.1).OR.
17437 & (P1.EQ.2.AND.P2.EQ.2.AND.P3.EQ.2)) THEN
17438 HWH2T7 = 8.0D0*B(J)*S(I,K,1)*S(J1,J,2)*S(J,L,1)*S(K,J,2)*
17439 & (B(I)*S(L,I,2)*S(I,J2,1)+B(K)*S(L,K,2)*S(K,J2,1))
17440 ELSEIF((P1.EQ.1.AND.P2.EQ.1.AND.P3.EQ.2).OR.
17441 & (P1.EQ.2.AND.P2.EQ.2.AND.P3.EQ.1)) THEN
17442 HWH2T7 = 8.0D0*S(I,K,1)*S(L,J,2)*
17443 & (B(I)*S(L,I,2)*S(I,J2,1)+B(K)*S(L,K,2)*S(K,J2,1))*
17444 & (B(J)*S(J1,J,2)*S(J,K,1)+B(L)*S(J1,L,2)*S(L,K,1))
17445 ELSEIF((P1.EQ.1.AND.P2.EQ.2.AND.P3.EQ.1).OR.
17446 & (P1.EQ.2.AND.P2.EQ.1.AND.P3.EQ.2)) THEN
17447 HWH2T7 = 8.0D0*B(I)*B(J)*S(I,L,1)*S(K,I,2)*
17448 & S(I,J2,1)*S(J1,J,2)*S(J,L,1)*S(K,J,2)
17449 ELSEIF((P1.EQ.1.AND.P2.EQ.2.AND.P3.EQ.2).OR.
17450 & (P1.EQ.2.AND.P2.EQ.1.AND.P3.EQ.1)) THEN
17451 HWH2T7 = 8.0D0*B(I)*S(I,L,1)*S(K,I,2)*S(I,J2,1)*S(L,J,2)*
17452 & (B(J)*S(J1,J,2)*S(J,K,1)+B(L)*S(J1,L,2)*S(L,K,1))
17454 CALL HWWARN('HWH2T7',500)
17456 IF(P1.EQ.2) HWH2T7 = DCONJG(HWH2T7)
17459 *CMZ :- -27/02/01 17:04:16 by Peter Richardson
17460 *-- Author : Peter Richardson
17461 C-----------------------------------------------------------------------
17462 FUNCTION HWH2T8(I,J,K,L,Z1,Z2,P1,P2,P3)
17463 C-----------------------------------------------------------------------
17464 C Returns the amplitude T8 from Nucl. Phys. B262 (1985) 235-262
17465 C I-L are the particles
17466 C Z1 and Z2 are the decay products of the Z
17467 C P1 is the polarization of the line I,J
17468 C P2 is the polarization of the gluon K
17469 C P3 is the polarization of the gluon L
17470 C-----------------------------------------------------------------------
17471 INCLUDE 'herwig65.inc'
17472 DOUBLE COMPLEX HWH2T8,S,D
17473 INTEGER I,J,K,L,Z1,Z2,J1,J2,P1,P2,P3
17474 DOUBLE PRECISION B(6)
17475 COMMON/HWHEWS/S(8,8,2),D(8,8)
17477 DATA B/-1.0D0,-1.0D0,1.0D0,1.0D0,1.0D0,1.0D0/
17485 IF((P1.EQ.1.AND.P2.EQ.1.AND.P3.EQ.1).OR.
17486 & (P1.EQ.2.AND.P2.EQ.2.AND.P3.EQ.2)) THEN
17487 HWH2T8 = 8.0D0*S(I,K,1)*S(J1,J,2)*(B(I)*D(L,I)+B(K)*D(L,K))*
17488 & (B(I)*S(K,I,2)*S(I,J2,1)+B(L)*S(K,L,2)*S(L,J2,1))
17489 ELSEIF((P1.EQ.1.AND.P2.EQ.1.AND.P3.EQ.2).OR.
17490 & (P1.EQ.2.AND.P2.EQ.2.AND.P3.EQ.1)) THEN
17491 HWH2T8 = 8.0D0*B(I)*S(I,K,1)*S(L,I,2)*S(I,K,1)*S(J1,J,2)*
17492 & (B(I)*S(L,I,2)*S(I,J2,1)+B(K)*S(L,K,2)*S(K,J2,1))
17493 ELSEIF((P1.EQ.1.AND.P2.EQ.2.AND.P3.EQ.1).OR.
17494 & (P1.EQ.2.AND.P2.EQ.1.AND.P3.EQ.2)) THEN
17495 HWH2T8 = 8.0D0*B(I)*S(I,L,1)*S(K,I,2)*S(I,L,1)*S(J1,J,2)*
17496 & (B(I)*S(K,I,2)*S(I,J2,1)+B(L)*S(K,L,2)*S(L,J2,1))
17497 ELSEIF((P1.EQ.1.AND.P2.EQ.2.AND.P3.EQ.2).OR.
17498 & (P1.EQ.2.AND.P2.EQ.1.AND.P3.EQ.1)) THEN
17499 HWH2T8 = 8.0D0*B(I)*S(I,L,1)*D(I,K)*S(J1,J,2)*
17500 & (B(I)*S(L,I,2)*S(I,J2,1)+B(K)*S(L,K,2)*S(K,J2,1))
17502 CALL HWWARN('HWH2T8',500)
17504 IF(P1.EQ.2) HWH2T8 = DCONJG(HWH2T8)
17507 *CMZ :- -27/02/01 17:04:16 by Peter Richardson
17508 *-- Author : Peter Richardson
17509 C-----------------------------------------------------------------------
17510 FUNCTION HWH2T9(I,J,K,L,Z1,Z2,P1,P2,P3)
17511 C-----------------------------------------------------------------------
17512 C Returns the amplitude T9 from Nucl. Phys. B262 (1985) 235-262
17513 C N.B. DELTA FUNCTION FOR THE GLUON POLARIZATIONS HERE
17514 C I-L are the particles
17515 C Z1 and Z2 are the decay products of the Z
17516 C P1 is the polarization of the line I,J
17517 C P2 is the polarization of the gluon K
17518 C P3 is the polarization of the gluon L
17519 C-----------------------------------------------------------------------
17520 INCLUDE 'herwig65.inc'
17521 DOUBLE COMPLEX HWH2T9,S,D
17522 INTEGER I,J,K,L,Z1,Z2,J1,J2,P1,P2,P3
17523 DOUBLE PRECISION B(6)
17524 COMMON/HWHEWS/S(8,8,2),D(8,8)
17526 DATA B/-1.0D0,-1.0D0,1.0D0,1.0D0,1.0D0,1.0D0/
17533 ELSEIF(P1.EQ.2) THEN
17537 HWH2T9 = TWO*S(I,J2,1)*(
17538 & B(K)*S(K,J,2)*(B(J)*S(J1,J,2)*S(J,K,1)
17539 & +B(L)*S(J1,L,2)*S(L,K,1))
17540 & -B(L)*S(L,J,2)*(B(J)*S(J1,J,2)*S(J,L,1)
17541 & +B(K)*S(J1,K,2)*S(K,L,1)))
17542 IF(P1.EQ.2) HWH2T9 = DCONJG(HWH2T9)
17546 *CMZ :- -27/02/01 17:04:16 by Peter Richardson
17547 *-- Author : Peter Richardson
17548 C-----------------------------------------------------------------------
17549 FUNCTION HWH2T0(I,J,K,L,Z1,Z2,P1,P2,P3)
17550 C-----------------------------------------------------------------------
17551 C Returns the amplitude T10 from Nucl. Phys. B262 (1985) 235-262
17552 C N.B. DELTA FUNCTION FOR THE GLUON POLARIZATIONS HERE
17553 C I-L are the particles
17554 C Z1 and Z2 are the decay products of the Z
17555 C P1 is the polarization of the line I,J
17556 C P2 is the polarization of the gluon K
17557 C P3 is the polarization of the gluon L
17558 C-----------------------------------------------------------------------
17559 INCLUDE 'herwig65.inc'
17560 DOUBLE COMPLEX HWH2T0,S,D
17561 INTEGER I,J,K,L,Z1,Z2,J1,J2,P1,P2,P3
17562 DOUBLE PRECISION B(6)
17563 COMMON/HWHEWS/S(8,8,2),D(8,8)
17565 DATA B/-1.0D0,-1.0D0,1.0D0,1.0D0,1.0D0,1.0D0/
17572 ELSEIF(P1.EQ.2) THEN
17576 HWH2T0 = TWO*S(J1,J,2)*(
17577 & B(K)*S(I,K,1)*(B(I)*S(K,I,2)*S(I,J2,1)
17578 & +B(L)*S(K,L,2)*S(L,J2,1))
17579 & -B(L)*S(I,L,1)*(B(I)*S(L,I,2)*S(I,J2,1)
17580 & +B(K)*S(L,K,2)*S(K,J2,1)))
17581 IF(P1.EQ.2) HWH2T0 = DCONJG(HWH2T0)
17585 *CMZ :- -26/11/00 17.21.55 by Bryan Webber
17586 *-- Author : Stefano Moretti
17587 C-----------------------------------------------------------------------
17588 SUBROUTINE HWH2VH(P1,P2,P3,P4,RMV,RES,RESL,REST)
17589 C-----------------------------------------------------------------------
17590 C...Matrix element for q(1) + q(')-bar(2) -> V(3) + Higgs(4),
17591 C...V=Z(W+/-), all masses retained (but no Yukawa couplings to quarks).
17592 C...It factorises 64.*PIFAC**3*ALPHA**3/4./SWEIN/SWEIN/SWEIN/EMW/EMW
17594 C... (VQ*VQ+AQ*AQ)/(1.-SWEIN)/(1.-SWEIN) if V=Z
17595 C... VCKM(q,q') if V=W+/-
17597 C...First release: 1-APR-1998 by Stefano Moretti
17598 C-----------------------------------------------------------------------
17600 DOUBLE PRECISION P1(0:3),P2(0:3),P3(0:3),P4(0:3)
17601 DOUBLE PRECISION P(0:3)
17602 DOUBLE PRECISION RMV,GAMV,RES,RESL,REST
17604 DOUBLE PRECISION S,S12,S13,S23
17605 DOUBLE PRECISION T, T13,T23
17606 DOUBLE PRECISION PV,CFC
17607 PARAMETER (GAMV=0.D0)
17610 S=S-(P1(I)+P2(I))**2
17616 S12=S12-P1(I)*P2(I)
17617 S13=S13-P1(I)*P3(I)
17618 S23=S23-P2(I)*P3(I)
17621 RES=(S12+2.D0/RMV/RMV*(S13*S23))
17622 & /((S-RMV**2)**2+GAMV**2*RMV**2)
17624 C...Extracts spin dependence.
17625 PV=SQRT(P3(1)**2+P3(2)**2+P3(3)**2)
17630 P(0)=PV**2/P3(0)*CFC
17641 C...Longitudinal ME (along V direction).
17642 RESL=(2.D0/RMV/RMV*(T13*T23)-S12*T/RMV/RMV)
17643 & /((S-RMV**2)**2+GAMV**2*RMV**2)
17645 C...Transverse ME (perpendicular to V direction).
17649 *CMZ :- -01/04/99 19.47.55 by Mike Seymour
17650 *-- Author : Ian Knowles
17651 C-----------------------------------------------------------------------
17653 C-----------------------------------------------------------------------
17654 C Four jet production in e^+e^- annihilation: qqbar+gg & qqbar+qqbar
17655 C IOP4JT controls the treatment of the colour flow interference term
17657 C IOP4JT(1)=0 neglect, =1 extreme 2341; =2 extreme 3421
17658 C qqbar-qqbar (identical quark flavour) case:
17659 C IOP4JT(2)=0 neglect, =1 extreme 4123; =2 extreme 2143
17661 C Matrix elements based on Ellis Ross & Terrano and Catani & Seymour
17663 C WARNING: Phase space factor inaccurate for JADE y_cut > 0.14.
17664 C-----------------------------------------------------------------------
17665 INCLUDE 'herwig65.inc'
17666 INTEGER LM,LP,IQK,I,J,IDMN,IDMX,ID1,ID2,IST(4)
17667 DOUBLE PRECISION HWRGEN,HWUALF,HWUAEM,HWULDO,HWH4J1,HWH4J2,
17668 & HWH4J4,HWH4J5,HWH4J6,HWH4J7,QNOW,Q2NOW,QLST,SCUT,PSFAC,FACT,
17669 & X12,X13,X14,X23,X24,X34,
17670 & COLA,COLB,COLC,CLF(7,6),P12,P13,P14,P23,P24,P34,FACTR,EP1,EP2,
17671 & EP3,EP4,GG1,GG2,GG12,GG3,GG13,GG23,GGINT,WTGG,QQ,QP,QQINT,QQ1,
17672 & QQ2,WTQQ,WTQP,HCS,WTAB,WTBA,WTOT,RCS,YLST
17674 LOGICAL INCLQG(6),INCLQQ(6,6),ORIENT
17675 EXTERNAL HWRGEN,HWUALF,HWUAEM,HWULDO,HWH4J1,HWH4J2,HWH4J4,
17676 & HWH4J5,HWH4J6,HWH4J7
17677 SAVE HCS,QLST,WTQP,WTQQ,WTGG,FACTR,COLA,COLB,COLC,IDMN,IDMX,
17678 & CLF,GG1,GG2,GGINT,INCLQG,INCLQQ,LM,LP,QQ1,QQ2,QQINT,FACT,ORIENT,
17681 DATA QLST,YLST,IST/-1D0,-1D0,113,114,114,114/
17686 IF (NHEP+5.GT.NMXHEP) THEN
17687 CALL HWWARN('HWH4JT',100)
17691 IF (QNOW.NE.QLST.OR.Y4JT.NE.YLST) THEN
17696 C Calculate allowed fraction of Phase Space using parameterization
17698 PSFAC=(1.-6.*Y4JT)**5.50*(1.-173.3*Y4JT*(1.-247.3*Y4JT
17699 & *(1.+148.3*Y4JT*(1.+3.913*Y4JT))))
17700 & /(1.-8.352*Y4JT*(1.-1102.*Y4JT
17701 & *(1.+1603.*Y4JT*(1.+22.99*Y4JT))))
17703 PSFAC=(1.-6.*Y4JT)**4.62*(1.-44.72*Y4JT*(1.-176.0*Y4JT
17704 & *(1.+102.9*Y4JT*(1.-6.579*Y4JT))))
17705 & /(1.-3.392*Y4JT*(1.-946.5*Y4JT
17706 & *(1.+423.4*Y4JT*(1.-3.971*Y4JT))))
17708 FACT=GEV2NB*HWUAEM(Q2NOW)**2*CFFAC*FLOAT(NCOLO)*PSFAC
17709 & /(THREE*16*PIFAC)
17711 COLB=CFFAC-HALF*CAFAC
17714 IF (JDAHEP(1,LM).NE.0) LM=JDAHEP(1,LM)
17716 IF (JDAHEP(1,LP).NE.0) LP=JDAHEP(1,LP)
17726 CALL HWUCFF(11,I,Q2NOW,CLF(1,I))
17727 IF (QNOW.GT.TWO*(RMASS(I)+RMASS(13))) THEN
17733 IF (QNOW.GT.TWO*(RMASS(I)+RMASS(J ))) THEN
17737 INCLQQ(I,J)=.FALSE.
17738 INCLQQ(J,I)=.FALSE.
17741 IF (MOD(IPROC/10,10).EQ.5) THEN
17747 C Generate phase space point and check it passes cuts
17748 CALL HWVEQU(5,PHEP(1,3),PHEP(1,NHEP+1))
17750 20 PHEP(5,NHEP+I)=0.
17751 30 CALL HWDFOR(PHEP(1,NHEP+1),PHEP(1,NHEP+2),PHEP(1,NHEP+3),
17752 & PHEP(1,NHEP+4),PHEP(1,NHEP+5))
17753 IF(IERROR.NE.0) RETURN
17755 P12=2*HWULDO(PHEP(1,NHEP+2),PHEP(1,NHEP+3))
17756 X12=MIN(PHEP(4,NHEP+2)/PHEP(4,NHEP+3),
17757 & PHEP(4,NHEP+3)/PHEP(4,NHEP+2))*P12
17758 IF (X12.GT.SCUT) THEN
17759 P13=2*HWULDO(PHEP(1,NHEP+2),PHEP(1,NHEP+4))
17760 X13=MIN(PHEP(4,NHEP+2)/PHEP(4,NHEP+4),
17761 & PHEP(4,NHEP+4)/PHEP(4,NHEP+2))*P13
17762 IF (X13.GT.SCUT) THEN
17763 P14=2*HWULDO(PHEP(1,NHEP+2),PHEP(1,NHEP+5))
17764 X14=MIN(PHEP(4,NHEP+2)/PHEP(4,NHEP+5),
17765 & PHEP(4,NHEP+5)/PHEP(4,NHEP+2))*P14
17766 IF (X14.GT.SCUT) THEN
17767 P23=2*HWULDO(PHEP(1,NHEP+3),PHEP(1,NHEP+4))
17768 X23=MIN(PHEP(4,NHEP+3)/PHEP(4,NHEP+4),
17769 & PHEP(4,NHEP+4)/PHEP(4,NHEP+3))*P23
17770 IF (X23.GT.SCUT) THEN
17771 P24=2*HWULDO(PHEP(1,NHEP+3),PHEP(1,NHEP+5))
17772 X24=MIN(PHEP(4,NHEP+3)/PHEP(4,NHEP+5),
17773 & PHEP(4,NHEP+5)/PHEP(4,NHEP+3))*P24
17774 IF (X24.GT.SCUT) THEN
17775 P34=2*HWULDO(PHEP(1,NHEP+4),PHEP(1,NHEP+5))
17776 X34=MIN(PHEP(4,NHEP+4)/PHEP(4,NHEP+5),
17777 & PHEP(4,NHEP+5)/PHEP(4,NHEP+4))*P34
17778 IF (X34.GT.SCUT) GOTO 40
17785 P12=2*HWULDO(PHEP(1,NHEP+2),PHEP(1,NHEP+3))
17786 IF (P12.GT.SCUT) THEN
17787 P13=2*HWULDO(PHEP(1,NHEP+2),PHEP(1,NHEP+4))
17788 IF (P13.GT.SCUT) THEN
17789 P14=2*HWULDO(PHEP(1,NHEP+2),PHEP(1,NHEP+5))
17790 IF (P14.GT.SCUT) THEN
17791 P23=2*HWULDO(PHEP(1,NHEP+3),PHEP(1,NHEP+4))
17792 IF (P23.GT.SCUT) THEN
17793 P24=2*HWULDO(PHEP(1,NHEP+3),PHEP(1,NHEP+5))
17794 IF (P24.GT.SCUT) THEN
17795 P34=2*HWULDO(PHEP(1,NHEP+4),PHEP(1,NHEP+5))
17796 IF (P34.GT.SCUT) GOTO 40
17803 C Failed cuts retry
17805 C Passed cuts: calculate contributions to Matrix Elements
17806 40 EMSCA=SQRT(MIN(P12,P13,P14,P23,P24,P34))
17807 IF (DURHAM) EMSCA=SQRT(MIN(X12,X13,X14,X23,X24,X34))
17808 IF (FIX4JT) EMSCA=SQRT(SCUT)
17809 FACTR=FACT*HWUALF(1,EMSCA)**2
17811 QF=HWULDO(PHEP(1,LP),PHEP(1,3))
17812 EF=Q2NOW/(2*SQRT(QF**2-HWULDO(PHEP(1,LP),PHEP(1,LP))*Q2NOW))
17813 QF=HALF-EF*QF/Q2NOW
17815 E(I)=EF*PHEP(I,LP)+QF*PHEP(I,3)
17817 EP1=HWULDO(E,PHEP(1,NHEP+2))
17818 EP2=HWULDO(E,PHEP(1,NHEP+3))
17819 EP3=HWULDO(E,PHEP(1,NHEP+4))
17820 EP4=HWULDO(E,PHEP(1,NHEP+5))
17823 GG1=HWH4J1(P12,P13,P14,P23,P24,P34,EP1,EP2,EP3,EP4,ORIENT)
17824 & +HWH4J1(P12,P24,P23,P14,P13,P34,EP2,EP1,EP4,EP3,ORIENT)
17825 GG2=HWH4J1(P12,P23,P24,P13,P14,P34,EP2,EP1,EP3,EP4,ORIENT)
17826 & +HWH4J1(P12,P14,P13,P24,P23,P34,EP1,EP2,EP4,EP3,ORIENT)
17827 GG12=HWH4J2(P12,P13,P14,P23,P24,P34,EP1,EP2,EP3,EP4,ORIENT)
17828 & +HWH4J2(P12,P14,P13,P24,P23,P34,EP1,EP2,EP4,EP3,ORIENT)
17829 & +HWH4J2(P12,P23,P24,P13,P14,P34,EP2,EP1,EP3,EP4,ORIENT)
17830 & +HWH4J2(P12,P24,P23,P14,P13,P34,EP2,EP1,EP4,EP3,ORIENT)
17831 GG3=HWH4J4(P12,P13,P14,P23,P24,P34,EP1,EP2,EP3,EP4,ORIENT)
17832 & +HWH4J4(P12,P24,P23,P14,P13,P34,EP2,EP1,EP4,EP3,ORIENT)
17833 GG13=GG3+HWH4J5(P12,P13,P14,P23,P24,P34,EP1,EP2,EP3,EP4,ORIENT)
17834 & +HWH4J5(P12,P24,P23,P14,P13,P34,EP2,EP1,EP4,EP3,ORIENT)
17835 GG23=GG3+HWH4J5(P12,P14,P13,P24,P23,P34,EP1,EP2,EP4,EP3,ORIENT)
17836 & +HWH4J5(P12,P23,P24,P13,P14,P34,EP2,EP1,EP3,EP4,ORIENT)
17838 GG1 =COLA*(GG1 +GG13)
17839 GG2 =COLA*(GG2 +GG23)
17840 GGINT=COLB*(GG12-GG13-GG23)
17841 WTGG=FACTR*(GG1+GG2+GGINT)
17843 QP=HWH4J6(P13,P12,P14,P23,P34,P24,EP1,EP3,EP2,EP4,ORIENT)
17844 & +HWH4J6(P24,P12,P23,P14,P34,P13,EP2,EP4,EP1,EP3,ORIENT)
17845 & +HWH4J6(P13,P34,P23,P14,P12,P24,EP3,EP1,EP4,EP2,ORIENT)
17846 & +HWH4J6(P24,P34,P14,P23,P12,P13,EP4,EP2,EP3,EP1,ORIENT)
17847 QQ=HWH4J6(P13,P23,P34,P12,P14,P24,EP3,EP1,EP2,EP4,ORIENT)
17848 & +HWH4J6(P24,P23,P12,P34,P14,P13,EP2,EP4,EP3,EP1,ORIENT)
17849 & +HWH4J6(P13,P14,P12,P34,P23,P24,EP1,EP3,EP4,EP2,ORIENT)
17850 & +HWH4J6(P24,P14,P34,P12,P23,P13,EP4,EP2,EP1,EP3,ORIENT)
17851 QQINT=HWH4J7(P13,P12,P14,P23,P34,P24,EP1,EP3,EP2,EP4,ORIENT)
17852 & +HWH4J7(P24,P12,P23,P14,P34,P13,EP2,EP4,EP1,EP3,ORIENT)
17853 & +HWH4J7(P13,P23,P34,P12,P14,P24,EP3,EP1,EP2,EP4,ORIENT)
17854 & +HWH4J7(P24,P23,P12,P34,P14,P13,EP2,EP4,EP3,EP1,ORIENT)
17855 & +HWH4J7(P13,P14,P12,P34,P23,P24,EP1,EP3,EP4,EP2,ORIENT)
17856 & +HWH4J7(P24,P14,P34,P12,P23,P13,EP4,EP2,EP1,EP3,ORIENT)
17857 & +HWH4J7(P13,P34,P23,P14,P12,P24,EP3,EP1,EP4,EP2,ORIENT)
17858 & +HWH4J7(P24,P34,P14,P23,P12,P13,EP4,EP2,EP3,EP1,ORIENT)
17860 WTQP=FACTR*COLC*QP/TWO
17864 WTQQ=FACTR*(QQ1+QQ2+QQINT)/2
17868 DO 60 ID1=IDMN,IDMX
17869 IF (INCLQG(ID1)) THEN
17871 HCS=HCS+CLF(1,ID1)*WTGG
17872 IF (GENEV.AND.HCS.GT.RCS) THEN
17873 C Select colour flow
17876 IF (IOP4JT(1).EQ.1) THEN
17877 IF (GGINT.GE.ZERO) THEN
17880 WTBA=MAX(WTBA,WTBA+GGINT)
17882 ELSEIF (IOP4JT(1).EQ.2) THEN
17883 IF (GGINT.GE.ZERO) THEN
17886 WTAB=MAX(WTAB,WTAB+GGINT)
17888 ELSEIF (IOP4JT(1).NE.0) THEN
17889 CALL HWWARN('HWH4JT',101)
17893 IF (WTAB.GT.HWRGEN(1)*WTOT) THEN
17894 CALL HWHQCP( 13, 13,3142,91)
17897 CALL HWHQCP( 13, 13,4123,92)
17904 C Identical quark pairs
17905 IF (ID1.EQ.ID2.AND.INCLQQ(ID1,ID1)) THEN
17906 HCS=HCS+CLF(1,ID1)*WTQQ
17907 IF (GENEV.AND.HCS.GT.RCS) THEN
17908 C Select colour flow
17911 IF (IOP4JT(2).EQ.1) THEN
17912 IF (QQINT.GE.ZERO) THEN
17915 WTBA=MAX(WTBA,WTBA+QQINT)
17917 ELSEIF (IOP4JT(2).EQ.2) THEN
17918 IF (QQINT.GE.ZERO) THEN
17921 WTAB=MAX(WTAB,WTAB+QQINT)
17923 ELSEIF (IOP4JT(2).NE.0) THEN
17924 CALL HWWARN('HWH4JT',102)
17928 IF (WTAB.GT.HWRGEN(1)*WTOT) THEN
17929 CALL HWHQCP(ID1,ID1+6,4123,93)
17932 CALL HWHQCP(ID1,ID1+6,2143,94)
17936 C Unlike quark pairs
17937 ELSEIF (INCLQQ(ID1,ID2)) THEN
17938 HCS=HCS+(CLF(1,ID1)+CLF(1,ID2))*WTQP
17939 IF (GENEV.AND.HCS.GT.RCS) THEN
17940 CALL HWHQCP(ID2,ID2+6,4123,95)
17948 C Set up labels for selected final state
17962 IDHEP(J)=IDPDG(IDN(I))
17966 C And colour structure pointers
17969 JMOHEP(2,NHEP+1+I)=NHEP+1+J
17970 110 JDAHEP(2,NHEP+1+J)=NHEP+1+I
17975 *CMZ :- -01/04/99 19.47.55 by Mike Seymour
17976 *-- Author : Ian Knowles
17977 *- Split in 6 files by M. Kirsanov.
17978 C-----------------------------------------------------------------------
17979 FUNCTION HWH4J1(S12,S13,S14,S23,S24,S34,EP1,EP2,EP3,EP4,ORIENT)
17980 C-----------------------------------------------------------------------
17981 C Evaluate `ERT' functions A, B, C, D, E; S12=(p1+p2)^2 etc.
17982 C-----------------------------------------------------------------------
17984 DOUBLE PRECISION HWH4J1,
17985 & S12,S13,S14,S23,S24,S34,S123,S124,S134,S234,S,EP1,EP2,EP3,EP4
17991 S=S12+S13+S14+S23+S24+S34
17992 HWH4J1=(S12*((S12+S14+S23+S34)**2+S13*(S12+S14-S24)+S24*(S12+S23))
17993 & +(S14*S23-S12*S34-S13*S24)*(S14+S23+S34)/2)
17994 & /(S13*S24*S134*S234)
17995 & +((S12+S24)*(S13+S34)-S14*S23)/(S13*S134**2)
17996 & +2*S23*(S-S13)/(S13*S134*S24) + S34/(2*S13*S24)
17999 & +4*((EP1*EP1*((S-S13)*(S23+S24)-S24*S34)
18000 & -EP1*EP2*(S12*(S123+S124)+(S+S12)*(S14+S23)+2*S14*S23
18001 & +S24*S134+S234*(S13+2*S234))
18002 & +EP1*EP3*(S*(S24-S12)+S12*S13+(S14+2*S234-S34)*S24)
18003 & -EP1*EP4*(S12*S124+S23*(S+S12+S14))
18004 & +EP2*EP2*((S-S24)*(S13+S14)+2*(S13+S34)*S234-S13*S34)
18005 & -EP2*EP3*((S+S23)*(S12+S14)+(S12+2*(S23+S234))*S234)
18006 & +EP2*EP4*(S12*(S24-S)+S13*(S+S23-S34)+2*(S13+S34-S234)*S234)
18007 & +EP3*EP3*(S14+2*S234)*S24
18008 & +EP3*EP4*(-S234*(2*(S12+S23)+S134)+S12*S34-S13*S24-S14*S23)
18009 & +EP4*EP4*S13*S23)*S134
18010 & +EP2*(EP1+EP3+EP4)*2*S14*S24*S234)/(S*S13*S24*S134**2*S234)
18016 *CMZ :- -01/04/99 19.47.55 by Mike Seymour
18017 *-- Author : Ian Knowles
18018 C-----------------------------------------------------------------------
18019 FUNCTION HWH4J2(S12,S13,S14,S23,S24,S34,EP1,EP2,EP3,EP4,ORIENT)
18020 C-----------------------------------------------------------------------
18021 C Evaluate `ERT' functions A, B, C, D, E; S12=(p1+p2)^2 etc.
18022 C-----------------------------------------------------------------------
18024 DOUBLE PRECISION HWH4J2,
18025 & S12,S13,S14,S23,S24,S34,S123,S124,S134,S234,S,EP1,EP2,EP3,EP4
18031 S=S12+S13+S14+S23+S24+S34
18032 HWH4J2=(S12*S14*(S24+S34)+S24*(S12*(S14+S34)+S13*(S14-S24)))
18033 & /(S14*S23*S13*S134)
18034 & +S12*(S+S34)*S124/(S24*S234*S14*S134)
18035 & -(S13*(2*(S12+S24)+S23)+S14**2)/(S134*S13*S14)
18036 & +S12*S123*S124/(2*S13*S24*S14*S23)
18039 & +4*((EP1*EP1*(S12*S134*S234-4*S23*S24*S34)
18040 & +EP1*EP2*(2*(2*S13*S234+S14*S123)*S24-S12*S134*(S+S12+S34))
18041 & +EP1*EP3*(S12*(4*S24*S34-S134*(S12+S14-S24))
18042 & -4*(S13*S24-S14*S23)*S24)
18043 & +EP1*EP4*(4*(S13+S14)*S23*S24-S12*S134*(S12+S13-S23))
18044 & +EP2*EP2*(S12*S134-4*S13*S24)*S134
18045 & +EP2*EP3*(4*S13*(S12+S23+S24)*S24-S12*S134*(S12-S14+S24))
18046 & -EP2*EP4*(4*(S12*(S14+S134)+S13*(S134-S234))*S24
18047 & +S12*(S12-S13+S23)*S134)
18048 & -EP3*EP3*4*S12*S14*S24
18049 & -EP3*EP4*2*S12*(2*S14*S24+S12*S134))*S234
18050 & +(EP1*(EP1*(S23+S24)+EP2*(S134-2*S))
18051 & -(EP1+EP2)*(EP3+EP4)*S12+EP2*EP2*(S13+S14))*2*S14*S24*S123)
18052 & /(2*S*S13*S14*S234*S23*S24*S134)
18058 *CMZ :- -01/04/99 19.47.55 by Mike Seymour
18059 *-- Author : Ian Knowles
18060 C-----------------------------------------------------------------------
18061 FUNCTION HWH4J4(S12,S13,S14,S23,S24,S34,EP1,EP2,EP3,EP4,ORIENT)
18062 C-----------------------------------------------------------------------
18063 C Evaluate `ERT' functions A, B, C, D, E; S12=(p1+p2)^2 etc.
18064 C-----------------------------------------------------------------------
18066 DOUBLE PRECISION HWH4J4,
18067 & S12,S13,S14,S23,S24,S34,S134,S234,S,EP1,EP2,EP3,EP4
18071 S=S12+S13+S14+S23+S24+S34
18072 HWH4J4=-(S12*(S34*(3*(S+S34)+S12)-S134*S234-2*(S13*S24+S14*S23))
18073 & +(S14*S23-S13*S24)*(S13-S14+S24-S23))/(2*S134*S234*S34**2)
18074 & -(S12*(S134**2/2+2*S13*S14+S34*(S13+S14-S34))
18075 & +S34*((S13+S14)*(S23+S24)+S14*S24+S13*S23)
18076 & +(S13*S24-S14*S23)*(S14-S13))/(S34*S134)**2
18079 & +4*((-EP1*EP1*2*(S23+S24)*S34
18080 & -EP1*EP2*(S13*(S23+3*S24)+S14*(3*S23+S24)-(4*S12-S34)*S34)
18081 & +EP1*EP3*((2*S12-S24)*S34-(S13-S14)*S24)
18082 & +EP1*EP4*((2*S12-S23)*S34+(S13-S14)*S23)
18083 & -EP2*EP2*2*(S13+S14)*S34
18084 & +EP2*EP3*(2*S12*S34-S14*(S23-S24+S34))
18085 & +EP2*EP4*(2*S12*S34+S13*(S23-S24-S34))
18086 & +EP3*EP3*2*S14*S24
18087 & +EP3*EP4*2*(S12*S34-S13*S24-S14*S23)
18088 & +EP4*EP4*2*S13*S23)/(S*S134*S234*S34**2)
18089 & +(EP1*EP2*(S134*(S134+2*S34)+4*(S13*S14-S34**2))
18090 & +EP2*EP3*2*(2*S13*S34+S14*(S13-S14+S34))
18091 & +EP2*EP4*2*(2*S14*S34-S13*(S13-S14-S34)))
18092 & /(S*(S134*S34)**2))
18098 *CMZ :- -01/04/99 19.47.55 by Mike Seymour
18099 *-- Author : Ian Knowles
18100 C-----------------------------------------------------------------------
18101 FUNCTION HWH4J5(S12,S13,S14,S23,S24,S34,EP1,EP2,EP3,EP4,ORIENT)
18102 C-----------------------------------------------------------------------
18103 C Evaluate `ERT' functions A, B, C, D, E; S12=(p1+p2)^2 etc.
18104 C-----------------------------------------------------------------------
18106 DOUBLE PRECISION HWH4J5,
18107 & S12,S13,S14,S23,S24,S34,S134,S234,S,EP1,EP2,EP3,EP4,
18112 S=S12+S13+S14+S23+S24+S34
18113 HWH4J5=(3*S12*S34**2-3*S13*S24*S34+3*S12*S24*S34+3*S14*S23*S34-
18114 $ S13*S24**2-S12*S23*S34+6*S12*S14*S34+2*S12*S13*S34-
18115 $ 2*S12**2*S34+S14*S23*S24-3*S13*S23*S24-2*S13*S14*S24+
18116 $ 4*S12*S14*S24+2*S12*S13*S24+3*S14*S23**2+2*S14**2*S23+
18117 $ 2*S14**2*S12+2*S12**2*S14+6*S12*S14*S23-2*S12*S13**2-
18118 $ 2*S12**2*S13)/(2*S13*S134*S234*S34)+
18119 $ (2*S12*S34**2-2*S13*S24*S34+S12*S24*S34+4*S13*S23*S34+
18120 $ 4*S12*S14*S34+2*S12*S13*S34+2*S12**2*S34-S13*S24**2+
18121 $ 3*S14*S23*S24+4*S13*S23*S24-2*S13*S14*S24+4*S12*S14*S24+
18122 $ 2*S12*S13*S24+2*S14*S23**2+4*S13*S23**2+2*S13*S14*S23+
18123 $ 2*S12*S14*S23+4*S12*S13*S23+2*S12*S14**2+4*S12**2*S13+
18124 $ 4*S12*S13*S14+2*S12**2*S14)/(2*S13*S134*S24*S34)-
18125 $ (S12*S34**2-2*S14*S24*S34-2*S13*S24*S34-S14*S23*S34+
18126 $ S13*S23*S34+S12*S14*S34+2*S12*S13*S34-2*S14**2*S24-
18127 $ 4*S13*S14*S24-4*S13**2*S24-S14**2*S23-S13**2*S23+
18128 $ S12*S13*S14-S12*S13**2)/(S13*S34*S134**2)
18131 & +EP1*EP1*((S13-S14+S23-3*S24)*S34+(S134+S14+2*S34)*S234)
18133 & +EP1*EP2*((2*(S12-S24)+S34)*S134-S14*(4*S12+S14+3*S23)
18134 & +S13*(S13+S23)+S24*S34 )*S24*S134
18135 & -EP1*EP2*(((2*S12*S134+S13*(2*(S12+S14+S23)-S24+S34)
18136 & +S14*(S14-S23)+(2*S14-S34)*S234)*S234)*S134
18137 & + 4*S13**2*S24*S234)
18138 & +EP1*EP3*(S12*(2*S13-S134)+S13*(S24+2*S234)+S14*(3*S24-S234)
18139 & +S34*(S234-3*S24))*S24*S134
18140 & +EP1*EP4*((S12*(S13-S14+3*S34)-S23*(S13+3*S14-S34))*S24
18141 & -(S12*(S13+S134+2*S34)+2*S13*S24
18142 & +(S13-2*S14)*S23)*S234)*S134
18143 & +EP2*EP2*(S13*((2*S13+S34)*S234+S24*(S134-2*S34))
18144 & +2*S14*S134*(S24+S234))*S134
18146 & -EP2*EP3*(((S12*(S13+2*S14-S34)+S14*(S+2*S23-S34))*S24
18147 & +(S12*(S13+S134)+(S13+S24+2*S234)*S14
18148 & +2*S13*(2*S23+S34))*S234)*S134
18149 & +4*S13**2*S24*S234)
18150 & +EP2*EP4*(((S12*(S13-2*S134)+S13*(S+2*S23-3*S34))*S24
18151 & -((S-3*S13+S23+2*S24)*S13+2*S12*S14
18152 & +2*S14*(S23+2*S24))*S234)*S134-4*S13**2*S24*S234)
18153 & +EP3*EP3*2*(S13*S234+S14*S24)*S24*S134
18154 & +EP3*EP4*(2*(S12*S34-S13*S24-S14*S23)*S24
18155 & -(S12*S134+2*S13*S23)*S234)*S134
18156 & +EP4*EP4*2*(S12*S234+S23*S24)*S13*S134
18157 HWH4J5=HWH4J5+4*SUM/(S*S234*S134**2*S13*S34*S24)
18163 *CMZ :- -01/04/99 19.47.55 by Mike Seymour
18164 *-- Author : Ian Knowles
18165 C-----------------------------------------------------------------------
18166 FUNCTION HWH4J6(S12,S13,S14,S23,S24,S34,EP1,EP2,EP3,EP4,ORIENT)
18167 C-----------------------------------------------------------------------
18168 C Evaluate `ERT' functions A, B, C, D, E; S12=(p1+p2)^2 etc.
18169 C-----------------------------------------------------------------------
18171 DOUBLE PRECISION HWH4J6,
18172 & S12,S13,S14,S23,S24,S34,S123,S124,S134,S234,S,EP1,EP2,EP3,EP4
18178 S=S12+S13+S14+S23+S24+S34
18179 HWH4J6=(S23*(S123*S234-S*S23)+S12*(S123*S124-S*S12))/(S13*S123)**2
18180 & -(S12*S34*(S234-2*S23)+S14*S23*(S234-2*S34)
18181 & -S13*S24*(S234+S13))/(S13**2*S123*S134)
18184 & +4*(-EP1*EP1*2*S23*S34
18185 & +EP1*EP2*((S12-S23)*S34-S13*(S24-S34))
18186 & +(EP1*EP3+EP2*EP4)*2*(S12*S34-S13*S24+S14*S23)
18187 & -EP1*EP4*(S13*S24-(3*(S13+S14)+S34)*S23)
18188 & -(EP1+EP2+EP3)*EP4*2
18189 & *(S12*(S13+S23)+(S12+S13)*S23)*S134/S123
18190 & +EP2*EP2*S13*(S14+S34)
18191 & +EP2*EP3*(S13*(S14-S24)-(S12-S23)*S14)
18192 & -EP3*EP3*2*S12*S14
18193 & -EP3*EP4*(S13*S24-(3*(S13+S34)+S14)*S12)
18194 & +EP4*EP4*(S12+S23)*S13)/(S*S134*S123*S13**2)
18200 *CMZ :- -01/04/99 19.47.55 by Mike Seymour
18201 *-- Author : Ian Knowles
18202 C-----------------------------------------------------------------------
18203 FUNCTION HWH4J7(S12,S13,S14,S23,S24,S34,EP1,EP2,EP3,EP4,ORIENT)
18204 C-----------------------------------------------------------------------
18205 C Evaluate `ERT' functions A, B, C, D, E; S12=(p1+p2)^2 etc.
18206 C-----------------------------------------------------------------------
18208 DOUBLE PRECISION HWH4J7,
18209 & S12,S13,S14,S23,S24,S34,S123,S124,S134,S234,S,EP1,EP2,EP3,EP4
18215 S=S12+S13+S14+S23+S24+S34
18216 HWH4J7=((S12*S34+S13*S24-S14*S23)*(S13+S14+S23+S24)-2*S12*S24*S34)
18217 & /(S13*S134*S23*S123)
18218 & -S12*(S12*S-S123*S124)/(S123**2*S13*S23)
18219 & -(S13+S14)*(S23+S24)*S34/(S13*S134*S23*S234)
18222 & +4*(+2*(EP1+EP2)*(S23*EP1-S13*EP2)*S34*S134
18223 & -EP1*EP2*2*S34**2*S123
18224 & +EP1*EP3*(S123*(S23+S24)*S34+2*S134*(S13*S24-S14*S23))
18225 & +EP1*EP4*(S123*(S23+S24)*S34+2*S12**2*S134*S234/S123
18226 & +2*S134*(S24*(S13-S12)-S23*(S12+S14)))
18227 & +EP2*EP3*(2*(S12*S34+S13*S24-S14*S23)*S134
18228 & +S123*(S13+S14)*S34)
18229 & +EP2*EP4*(S123*(S13+S14)*S34+2*S12**2*S234*S134/S123
18230 & -2*S134*(S12*S234-S13*S24+S14*S23))
18231 & -EP3*EP3*S12*(2*S24*S134+S123*S34)
18232 & +EP3*EP4*2*S12*(S134*(S23-S24)-S34*S123+S12*S134*S234/S123)
18233 & +EP4*EP4*S12*(2*S23*S134-S123*S34))
18234 & /(S*S13*S23*S123*S134*S234)
18240 *CMZ :- -26/04/91 11.11.55 by Bryan Webber
18241 *-- Author : Giovanni Abbiendi & Luca Stanco
18242 C-----------------------------------------------------------------------
18244 C-----------------------------------------------------------------------
18245 C Order Alpha_s processes in charged lepton-hadron collisions
18247 C Process code IPROC has to be set in the Main Program
18248 C the following codes IPROC may be selected
18250 C 9100 : NC BOSON-GLUON FUSION
18251 C 9100+IQK (IQK=1,...,6) : produced flavour is IQK
18252 C 9107 : produced J/psi + gluon
18254 C 9110 : NC QCD COMPTON
18255 C 9110+IQK (IQK=1,...,12) : struck parton is IQK
18257 C 9130 : NC order alpha_s processes (9100+9110)
18259 C Select maximum and minimum generated flavour when IQK=0
18260 C setting IFLMIN and IFLMAX in the Main Program
18261 C (allowed values from 1 to 6), default are 1 and 5
18262 C allowing d,u,s,c,b,dbar,ubar,sbar,cbar,bbar
18264 C CHARGED CURRENT Boson-Gluon Fusion processes
18265 C 9141 : CC s cbar (c sbar)
18266 C 9142 : CC b cbar (c bbar)
18267 C 9143 : CC s tbar (t cbar)
18268 C 9144 : CC b tbar (t bbar)
18270 C other inputs : Q2MIN,Q2MAX,YBMIN,YBMAX,PTMIN,EMMIN,EMMAX
18271 C when IPROC=(1)9107 : as above but Q2WWMN, Q2WWMX substitute
18272 C Q2MIN and Q2MAX (EPA is used); ZJMAX cut
18274 C Add 10000 to suppress soft remnant fragmentation
18276 C Mean EVWGT = cross section in nanoBarn
18278 C-----------------------------------------------------------------------
18279 INCLUDE 'herwig65.inc'
18280 DOUBLE PRECISION HWRGEN,Y,Q2,SHAT,Z,PHI,AJACOB,DSIGMA,ME,MP,
18281 & ML,MREMIF(18),MFIN1(18),MFIN2(18),RS,SMA,W2,RSHAT,FSIGMA(18),
18282 & SIGSUM,PROB,PRAN,PVRT(4),X
18284 INTEGER IQK,IFLAVU,IFLAVD,IMIN,IMAX,IFL,IPROO,LEPFIN,ID1,ID2,I,IDD
18285 LOGICAL CHARGD,INCLUD(18),INSIDE(18),IFGO
18287 SAVE LEPFIN,ID1,ID2,FSIGMA,SIGSUM
18288 COMMON /HWAREA/ Y,Q2,SHAT,Z,PHI,AJACOB,DSIGMA,ME,MP,ML,MREMIF,
18289 & MFIN1,MFIN2,RS,SMA,W2,RSHAT,IQK,IFLAVU,IFLAVD,IMIN,IMAX,IFL,LEP,
18290 & IPROO,CHARGD,INCLUD,INSIDE
18293 C---LEP = 1 FOR LEPTONS, -1 FOR ANTILEPTONS
18295 IF (IDHW(1).GE.121.AND.IDHW(1).LE.126) THEN
18297 ELSEIF (IDHW(1).GE.127.AND.IDHW(1).LE.132) THEN
18300 IF (LEP.EQ.0) CALL HWWARN('HWHBGF',500)
18301 IPROO=MOD(IPROC,100)/10
18302 IF (IPROO.EQ.0.OR.IPROO.EQ.4) THEN
18305 IF (IQK.EQ.7) IFL=164
18307 ELSEIF (IPROO.EQ.1.OR.IPROO.EQ.2) THEN
18308 IQK=MOD(IPROC,100)-10
18311 ELSEIF (IPROO.EQ.3) THEN
18316 CALL HWWARN('HWHBGF',501)
18327 ELSEIF (IQK.EQ.2) THEN
18332 ELSEIF (IQK.EQ.3) THEN
18343 IF (LEP.EQ.-1) THEN
18357 IF (I.LT.IFLMIN.OR.I.GT.IFLMAX) INCLUD(I)=.FALSE.
18361 IF (I-6.LT.IFLMIN.OR.I-6.GT.IFLMAX) INCLUD(I)=.FALSE.
18363 IF (I-12.LT.IFLMIN.OR.I-12.GT.IFLMAX) INCLUD(I)=.FALSE.
18366 IF (IPROO.EQ.0) THEN
18372 ELSEIF (IPROO.EQ.1.OR.IPROO.EQ.2) THEN
18378 ELSEIF (IPROO.EQ.3) THEN
18382 ELSEIF (IQK.NE.0 .AND. (.NOT.CHARGD)) THEN
18386 IF (IFL.LE.18) THEN
18390 ELSEIF (IFL.EQ.164) THEN
18397 C---End of initialization
18399 IF (.NOT.CHARGD) THEN
18401 PRAN= SIGSUM * HWRGEN(0)
18403 DO 10 IFL=IMIN,IMAX
18404 IF (.NOT.INSIDE(IFL)) GOTO 10
18405 PROB=PROB+FSIGMA(IFL)
18406 IF (PROB.GE.PRAN) GOTO 20
18409 C---at this point the subprocess has been selected (IFL)
18412 C---Boson-Gluon Fusion event
18413 IDHW(NHEP+1)=IDHW(1)
18416 IDHW(NHEP+4)=LEPFIN
18419 ELSEIF (IFL.GE.7.AND.IFL.LE.18) THEN
18420 C---QCD_Compton event
18421 IDHW(NHEP+1)=IDHW(1)
18424 IDHW(NHEP+4)=LEPFIN
18427 ELSEIF (IFL.EQ.164) THEN
18428 C---gamma+gluon-->J/Psi+gluon
18429 IDHW(NHEP+1)=IDHW(1)
18432 IDHW(NHEP+4)=LEPFIN
18436 CALL HWWARN('HWHBGF',503)
18439 C---Charged current event of specified flavours
18440 IDHW(NHEP+1)=IDHW(1)
18443 IDHW(NHEP+4)=LEPFIN
18448 DO 1 I=NHEP+1,NHEP+6
18449 1 IDHEP(I)=IDPDG(IDHW(I))
18451 C---Codes common for all processes
18463 C---Incoming lepton
18464 JMOHEP(2,NHEP+1)=NHEP+4
18465 JDAHEP(2,NHEP+1)=NHEP+4
18466 C---Hard Process C.M.
18467 JMOHEP(1,NHEP+3)=NHEP+1
18468 JMOHEP(2,NHEP+3)=NHEP+2
18469 JDAHEP(1,NHEP+3)=NHEP+4
18470 JDAHEP(2,NHEP+3)=NHEP+6
18471 C---Outgoing lepton
18472 JMOHEP(2,NHEP+4)=NHEP+1
18473 JDAHEP(2,NHEP+4)=NHEP+1
18475 IF (IFL.LE.6 .OR. CHARGD) THEN
18476 C---Codes for boson-gluon fusion processes
18477 C--- Incoming gluon
18478 JMOHEP(2,NHEP+2)=NHEP+6
18479 JDAHEP(2,NHEP+2)=NHEP+5
18480 C--- Outgoing quark
18481 JMOHEP(2,NHEP+5)=NHEP+2
18482 JDAHEP(2,NHEP+5)=NHEP+6
18483 C--- Outgoing antiquark
18484 JMOHEP(2,NHEP+6)=NHEP+5
18485 JDAHEP(2,NHEP+6)=NHEP+2
18486 ELSEIF (IFL.GE.7 .AND. IFL.LE.12) THEN
18487 C---Codes for V+q --> q+g
18488 C--- Incoming quark
18489 JMOHEP(2,NHEP+2)=NHEP+5
18490 JDAHEP(2,NHEP+2)=NHEP+6
18491 C--- Outgoing quark
18492 JMOHEP(2,NHEP+5)=NHEP+6
18493 JDAHEP(2,NHEP+5)=NHEP+2
18494 C--- Outgoing gluon
18495 JMOHEP(2,NHEP+6)=NHEP+2
18496 JDAHEP(2,NHEP+6)=NHEP+5
18497 ELSEIF (IFL.GE.13 .AND. IFL.LE.18) THEN
18498 C---Codes for V+qbar --> qbar+g
18499 C--- Incoming antiquark
18500 JMOHEP(2,NHEP+2)=NHEP+6
18501 JDAHEP(2,NHEP+2)=NHEP+5
18502 C--- Outgoing antiquark
18503 JMOHEP(2,NHEP+5)=NHEP+2
18504 JDAHEP(2,NHEP+5)=NHEP+6
18505 C--- Outgoing gluon
18506 JMOHEP(2,NHEP+6)=NHEP+5
18507 JDAHEP(2,NHEP+6)=NHEP+2
18508 ELSEIF (IFL.EQ.164) THEN
18509 C---Codes for Gamma+gluon --> J/Psi+gluon
18510 C--- Incoming gluon
18511 JMOHEP(2,NHEP+2)=NHEP+6
18512 JDAHEP(2,NHEP+2)=NHEP+6
18513 C--- Outgoing J/Psi
18514 JMOHEP(2,NHEP+5)=NHEP+1
18515 JDAHEP(2,NHEP+5)=NHEP+1
18516 C--- Outgoing gluon
18517 JMOHEP(2,NHEP+6)=NHEP+2
18518 JDAHEP(2,NHEP+6)=NHEP+2
18520 C---Computation of momenta in Laboratory frame of reference
18523 C Decide which quark radiated and assign production vertices
18525 C Boson-Gluon fusion case
18526 IF (1-Z.LT.HWRGEN(0)) THEN
18527 C Gluon splitting to quark
18528 CALL HWVZRO(4,VHEP(1,NHEP-1))
18529 CALL HWVDIF(4,PHEP(1,NHEP-4),PHEP(1,NHEP),PVRT)
18530 CALL HWUDKL(IFL,PVRT,VHEP(1,NHEP))
18531 CALL HWVEQU(4,VHEP(1,NHEP),VHEP(1,NHEP-4))
18533 C Gluon splitting to antiquark
18534 CALL HWVZRO(4,VHEP(1,NHEP))
18535 CALL HWVDIF(4,PHEP(1,NHEP-4),PHEP(1,NHEP-1),PVRT)
18536 CALL HWUDKL(IFL,PVRT,VHEP(1,NHEP-1))
18537 CALL HWVEQU(4,VHEP(1,NHEP-1),VHEP(1,NHEP-4))
18539 ELSEIF (IFL.GE.7.AND.IFL.LE.18) THEN
18542 IF (1.LT.HWRGEN(0)*(1+(1-X-Z)**2+6*X*(1-X)*Z*(1-Z))) THEN
18543 C Incoming quark radiated the gluon
18544 CALL HWVZRO(4,VHEP(1,NHEP-1))
18545 CALL HWVDIF(4,PHEP(1,NHEP-4),PHEP(1,NHEP),PVRT)
18546 CALL HWUDKL(IFL-6,PVRT,VHEP(1,NHEP))
18547 CALL HWVEQU(4,VHEP(1,NHEP),VHEP(1,NHEP-4))
18549 C Outgoing quark radiated the gluon
18550 CALL HWVZRO(4,VHEP(1,NHEP-4))
18551 CALL HWVSUM(4,PHEP(1,NHEP-1),PHEP(1,NHEP),PVRT)
18552 CALL HWUDKL(IFL-6,PVRT,VHEP(1,NHEP))
18553 CALL HWVEQU(4,VHEP(1,NHEP),VHEP(1,NHEP-1))
18556 C---HERWIG gets confused if lepton momentum is different from beam
18557 C momentum, which it can be if incoming hadron has negative virtuality
18558 C As a temporary fix, simply copy the momentum.
18559 C Momentum conservation somehow gets taken care of HWBGEN!
18560 call hwvequ(5,phep(1,1),phep(1,nhep-5))
18563 C---generation of the 5 variables Y,Q2,SHAT,Z,PHI and Jacobian computation
18564 C---in the largest phase space avalaible for selected processes and
18565 C---filling of logical vector INSIDE to tag contributing ones
18568 C---calculate differential cross section corresponding to the chosen
18569 C---variables and the weight for MC generation
18571 C---many subprocesses included
18577 IF (INSIDE(I)) THEN
18582 SIGSUM=SIGSUM+DSIGMA
18585 EVWGT=SIGSUM * AJACOB
18587 C---only one subprocess included
18589 EVWGT= DSIGMA * AJACOB
18591 IF (EVWGT.LT.ZERO) EVWGT=ZERO
18596 *CMZ :- -26/04/91 13.19.32 by Federico Carminati
18597 *-- Author : Giovanni Abbiendi & Luca Stanco
18598 C----------------------------------------------------------------------
18600 C----------------------------------------------------------------------
18601 C gives the fourmomenta in the laboratory system for the particles
18602 C of the hard 2-->3 subprocess, to match with HERWIG routines of
18604 C----------------------------------------------------------------------
18605 INCLUDE 'herwig65.inc'
18606 DOUBLE PRECISION HWUECM,HWUPCM,HWUSQR,Y,Q2,SHAT,Z,PHI,AJACOB,
18607 & DSIGMA,ME,MP,ML,MREMIF(18),MFIN1(18),MFIN2(18),RS,SMA,W2,RSHAT,
18608 & PGAMMA(5),SG,MF1,MF2,EP,PP,EL,PL,E1,E2,Q1,COSBET,SINBET,COSTHE,
18609 & SINTHE,SINAZI,COSAZI,ROTAZI(3,3),EGAM,A,PPROT,MREMIN,PGAM,PEP(5),
18610 & COSPHI,SINPHI,ROT(3,3),EPROT,PROTON(5),MPART
18611 INTEGER IQK,IFLAVU,IFLAVD,IMIN,IMAX,IFL,IPROO,I,IHAD,J,IS,ICMF,LEP
18612 LOGICAL CHARGD,INCLUD(18),INSIDE(18)
18613 EXTERNAL HWUECM,HWUPCM,HWUSQR
18614 COMMON /HWAREA/ Y,Q2,SHAT,Z,PHI,AJACOB,DSIGMA,ME,MP,ML,MREMIF,
18615 & MFIN1,MFIN2,RS,SMA,W2,RSHAT,IQK,IFLAVU,IFLAVD,IMIN,IMAX,IFL,LEP,
18616 & IPROO,CHARGD,INCLUD,INSIDE
18619 IF (JDAHEP(1,IHAD).NE.0) IHAD=JDAHEP(1,IHAD)
18623 MF1=RMASS(IDHW(NHEP+5))
18624 MF2=RMASS(IDHW(NHEP+6))
18628 IF (IFL.EQ.164) IS=IQK
18630 IF (IFL.GE.7.AND.IFL.LE.18) MPART=RMASS(IFL-6)
18633 MREMIN = MREMIF(IS)
18635 C---Calculation of kinematical variables for the generated event
18636 C in the center of mass frame of the incoming boson and parton
18637 C with parton along +z
18638 EGAM = HWUECM (SHAT, -Q2, MPART**2)
18639 PGAM = SQRT( EGAM**2 + Q2 )
18642 A = (W2+Q2-MP**2)/TWO
18643 PPROT = (A*PGAM-EGAM*SQRT(A**2+MP**2*Q2))/Q2
18644 IF (PPROT.LT.ZERO) THEN
18645 CALL HWWARN('HWHBKI',101)
18648 EPROT = SQRT(PPROT**2+MP**2)
18649 IF ((EPROT+PPROT).LT.(EP+PP)) THEN
18650 CALL HWWARN('HWHBKI',102)
18653 EL = ( PGAM / PPROT * SMA - Q2 ) / TWO
18654 + / (EGAM + PGAM / PPROT * EPROT)
18656 PL = SQRT ( EL**2 - ME**2 )
18658 CALL HWWARN ('HWHBKI',103)
18661 COSBET = (TWO * EPROT * EL - SMA) / (TWO * PPROT * PL)
18662 IF ( ABS(COSBET) .GE. ONE ) THEN
18663 COSBET = SIGN (ONE,COSBET)
18666 SINBET = SQRT (ONE - COSBET**2)
18668 SG = ME**2 + MPART**2 + Q2 + TWO * RSHAT * EL
18669 IF (SG.LE.(RSHAT+ML)**2 .OR. SG.GE.(RS-MREMIN)**2) THEN
18670 CALL HWWARN ('HWHBKI',104)
18673 Q1 = HWUPCM( RSHAT, MF1, MF2)
18674 E1 = SQRT(Q1**2+MF1**2)
18675 E2 = SQRT(Q1**2+MF2**2)
18676 IF (Q1 .GT. ZERO) THEN
18677 COSTHE=(TWO*EP*E1 - Z*(SHAT+Q2))/(TWO*PP*Q1)
18678 IF (ABS(COSTHE) .GT. ONE) THEN
18679 COSTHE=SIGN(ONE,COSTHE)
18682 SINTHE=SQRT(ONE-COSTHE**2)
18689 PHEP(1,NHEP+1)=PL*SINBET
18690 PHEP(2,NHEP+1)=ZERO
18691 PHEP(3,NHEP+1)=PL*COSBET
18693 PHEP(5,NHEP+1)=RMASS(IDHW(1))
18699 CALL HWUMAS (PROTON)
18701 PHEP(1,NHEP+2)=ZERO
18702 PHEP(2,NHEP+2)=ZERO
18705 PHEP(5,NHEP+2)=MPART
18706 C---HARD SUBPROCESS 2-->3 CENTRE OF MASS
18707 PHEP(1,NHEP+3)=PHEP(1,NHEP+1)+PHEP(1,NHEP+2)
18708 PHEP(2,NHEP+3)=PHEP(2,NHEP+1)+PHEP(2,NHEP+2)
18709 PHEP(3,NHEP+3)=PHEP(3,NHEP+1)+PHEP(3,NHEP+2)
18710 PHEP(4,NHEP+3)=PHEP(4,NHEP+1)+PHEP(4,NHEP+2)
18711 CALL HWUMAS ( PHEP(1,NHEP+3) )
18717 PGAMMA(5)=HWUSQR(Q2)
18718 C---Scattered lepton
18719 PHEP(1,NHEP+4)=PHEP(1,NHEP+1)-PGAMMA(1)
18720 PHEP(2,NHEP+4)=PHEP(2,NHEP+1)-PGAMMA(2)
18721 PHEP(3,NHEP+4)=PHEP(3,NHEP+1)-PGAMMA(3)
18722 PHEP(4,NHEP+4)=PHEP(4,NHEP+1)-PGAMMA(4)
18723 PHEP(5,NHEP+4)=RMASS(IDHW(1))
18724 IF (CHARGD) PHEP(5,NHEP+4)=ZERO
18725 C---First Final parton: quark (or J/psi) in Boson-Gluon Fusion
18726 C--- quark or antiquark in QCD Compton
18727 PHEP(1,NHEP+5)=Q1*SINTHE*COS(PHI)
18728 PHEP(2,NHEP+5)=Q1*SINTHE*SIN(PHI)
18729 PHEP(3,NHEP+5)=Q1*COSTHE
18732 C---Second Final parton: antiquark in Boson-Gluon Fusion
18733 C--- gluon in QCD Compton
18734 PHEP(1,NHEP+6)=-PHEP(1,NHEP+5)
18735 PHEP(2,NHEP+6)=-PHEP(2,NHEP+5)
18736 PHEP(3,NHEP+6)=-PHEP(3,NHEP+5)
18739 C---Boost to lepton-hadron CM frame
18740 PEP(1) = PHEP(1,NHEP+1)
18741 PEP(2) = PHEP(2,NHEP+1)
18742 PEP(3) = PHEP(3,NHEP+1) + PPROT
18743 PEP(4) = PHEP(4,NHEP+1) + EPROT
18746 CALL HWULOF (PEP,PHEP(1,NHEP+I),PHEP(1,NHEP+I))
18748 CALL HWULOF (PEP,PROTON,PROTON)
18749 CALL HWULOF (PEP,PGAMMA,PGAMMA)
18750 C---Rotation around y-axis to align lepton beam with z-axis
18751 COSPHI = PHEP(3,NHEP+1) /
18752 & SQRT( PHEP(1,NHEP+1)**2 + PHEP(3,NHEP+1)**2 )
18753 SINPHI = PHEP(1,NHEP+1) /
18754 & SQRT( PHEP(1,NHEP+1)**2 + PHEP(3,NHEP+1)**2 )
18766 CALL HWUROF (ROT,PHEP(1,NHEP+I),PHEP(1,NHEP+I))
18768 CALL HWUROF (ROT,PROTON,PROTON)
18769 CALL HWUROF (ROT,PGAMMA,PGAMMA)
18770 C---Boost to the LAB frame
18773 CALL HWULOB (PHEP(1,ICMF),PHEP(1,NHEP+I),PHEP(1,NHEP+I))
18775 CALL HWULOB (PHEP(1,ICMF),PROTON,PROTON)
18776 CALL HWULOB (PHEP(1,ICMF),PGAMMA,PGAMMA)
18777 C---Random azimuthal rotation
18778 CALL HWRAZM (ONE,COSAZI,SINAZI)
18784 ROTAZI(1,1) = COSAZI
18785 ROTAZI(1,2) = SINAZI
18786 ROTAZI(2,1) = -SINAZI
18787 ROTAZI(2,2) = COSAZI
18790 CALL HWUROF (ROTAZI,PHEP(1,NHEP+I),PHEP(1,NHEP+I))
18792 CALL HWUROF (ROTAZI,PROTON,PROTON)
18793 CALL HWUROF (ROTAZI,PGAMMA,PGAMMA)
18797 *CMZ :- -03/07/95 19.02.12 by Giovanni Abbiendi
18798 *-- Author : Giovanni Abbiendi & Luca Stanco
18799 C-----------------------------------------------------------------------
18800 SUBROUTINE HWHBRN (IFGO)
18801 C----------------------------------------------------------------------
18802 C Returns a point in the phase space (Y,Q2,SHAT,Z,PHI) and the
18803 C corresponding Jacobian factor AJACOB
18804 C Fill the logical vector INSIDE to tag contributing subprocesses
18805 C to the cross-section
18806 C-----------------------------------------------------------------------
18807 INCLUDE 'herwig65.inc'
18809 DOUBLE PRECISION HWRUNI,HWRGEN,HWUPCM,Y,Q2,SHAT,Z,PHI,AJACOB,
18810 & DSIGMA,ME,MP,ML,MREMIF(18),MFIN1(18),MFIN2(18),RS,SMA,W2,RSHAT,
18811 & MF1,MF2,YMIN,YMAX,YJAC,Q2INF,Q2SUP,Q2JAC,EMW2,ZMIN,ZMAX,ZJAC,
18812 & GAMMA2,LAMBDA,PHIJAC,ZINT,ZLMIN,ZL,EMW,TMIN,TMAX,EMLMIN,EMLMAX,
18813 & SHMIN,EMMIF(18),EMMAF(18),WMIF(18),WMIN,MREMIN,YMIF(18),Q1CM(18),
18814 & Q2MAF(18),EMMAWF(18),ZMIF(18),ZMAF(18),PLMAX,PINC,SHINF,SHSUP,
18815 & SHJAC,CTHLIM,Q1,DETDSH,SRY,SRY0,SRY1
18817 INTEGER IQK,IFLAVU,IFLAVD,I,IMIN,IMAX,IFL,IPROO,IHAD,NTRY,DEBUG
18818 LOGICAL CHARGD,INCLUD(18),INSIDE(18)
18819 EXTERNAL HWRUNI,HWRGEN,HWUPCM
18820 SAVE EMLMIN,EMLMAX,EMMIF,EMMAF,MREMIN,MF1,MF2,YMIF,
18821 & YMIN,YMAX,WMIN,WMIF
18822 COMMON /HWAREA/ Y,Q2,SHAT,Z,PHI,AJACOB,DSIGMA,ME,MP,ML,MREMIF,
18823 & MFIN1,MFIN2,RS,SMA,W2,RSHAT,IQK,IFLAVU,IFLAVD,IMIN,IMAX,IFL,LEP,
18824 & IPROO,CHARGD,INCLUD,INSIDE
18825 EQUIVALENCE (EMW,RMASS(198))
18829 IF (JDAHEP(1,IHAD).NE.0) IHAD=JDAHEP(1,IHAD)
18831 IF (FSTWGT.OR.IHAD.NE.2) THEN
18832 ME = RMASS(IDHW(1))
18833 MP = RMASS(IDHW(IHAD))
18835 SMA = RS**2-ME**2-MP**2
18836 PINC = HWUPCM(RS,ME,MP)
18837 C---Charged current
18839 ML=RMASS(IDHW(1)+1)
18840 YMAX = ONE - TWO*ML*MP / SMA
18841 YMAX = MIN(YMAX,YBMAX)
18850 SHMIN = MF1**2+MF2**2 + TWO * PTMIN**2 +
18851 + TWO * SQRT(PTMIN**2+MF1**2) * SQRT(PTMIN**2+MF2**2)
18852 EMLMIN=MAX(EMMIN,SQRT(SHMIN))
18853 EMLMAX=MIN(EMMAX,RS-ML-MREMIN)
18855 IF (EMLMIN.GT.EMLMAX) GOTO 888
18857 PLMAX=HWUPCM(RS,ML,WMIN)
18858 YMIN = ONE-TWO*(SQRT(PINC**2+MP**2)*SQRT(PLMAX**2+ML**2)+
18860 YMIN = MAX(YMIN,YBMIN)
18862 IF (YMIN.GT.YMAX) GOTO 888
18864 C---Neutral current
18866 YMAX = ONE - TWO*ML*MP / SMA
18867 YMAX = MIN(YMAX,YBMAX)
18874 C---Boson-Gluon Fusion (also J/Psi) and QCD Compton with struck u or d
18878 MFIN2(I)=RMASS(I+6)
18880 MFIN1(I)=RMASS(I-6)
18884 C---QCD Compton with struck non-valence parton
18885 MREMIF(I)=MP+RMASS(I-6)
18886 MFIN1(I)=RMASS(I-6)
18890 IF (IFL.EQ.164) THEN
18892 MFIN1(7)=RMASS(164)
18895 C---y boundaries for different flavours and processes
18897 IF (INCLUD(I)) THEN
18901 SHMIN = MF1**2+MF2**2 + TWO * PTMIN**2 +
18902 + TWO * SQRT(PTMIN**2+MF1**2) * SQRT(PTMIN**2+MF2**2)
18903 EMMIF(I) = MAX(EMMIN,SQRT(SHMIN))
18904 EMMAF(I) = MIN(EMMAX,RS-ML-MREMIN)
18905 IF (EMMIF(I).GT.EMMAF(I)) THEN
18907 CALL HWWARN('HWHBRN',3)
18910 WMIF(I) = EMMIF(I)+MREMIF(I)
18912 PLMAX = HWUPCM(RS,ML,WMIN)
18913 YMIF(I)=ONE-TWO*(SQRT(PINC**2+MP**2)*SQRT(PLMAX**2+ML**2)+
18915 IF (YMIF(I).GT.YMAX) THEN
18917 CALL HWWARN('HWHBRN',4)
18922 C---considering the largest boundaries
18925 IF (IPROO.EQ.3) THEN
18926 EMLMIN=MIN(EMMIF(IMIN),EMMIF(IMIN+6))
18927 EMLMAX=MAX(EMMAF(IMIN),EMMAF(IMIN+6))
18930 IF (EMLMIN.GT.EMLMAX) GOTO 888
18932 IF (IPROO.EQ.3) YMIN=MIN(YMIF(IMIN),YMIF(IMIN+6))
18933 YMIN = MAX(YMIN,YBMIN)
18935 IF (YMIN.GT.YMAX) GOTO 888
18937 MREMIN = MREMIF(IMIN)
18940 IF (IPROO.EQ.3) THEN
18941 WMIN = MIN(WMIF(IMIN),WMIF(IMIN+6))
18942 MREMIN = MIN(MREMIF(IMIN),MREMIF(IMIN+6))
18946 C---Random generation in largest phase space
18954 IF (.NOT.CHARGD) THEN
18955 IF (IFL.LE.5.OR.(IFL.GE.7.AND.IFL.LE.18)) THEN
18958 SRY = HWRUNI(0,SRY0,SRY1)
18960 YJAC = TWO*SRY*(SRY1-SRY0)
18961 ELSEIF (IFL.EQ.6) THEN
18962 Y = SQRT(HWRUNI(0,YMIN**2,YMAX**2))
18963 YJAC = HALF * (YMAX**2-YMIN**2) / Y
18964 ELSEIF (IFL.EQ.164) THEN
18965 C---in J/psi photoproduction Y and Q2 are given by the Equivalent Photon
18969 IF (NTRY.GT.NETRY) THEN
18970 CALL HWWARN('HWHBRN',50)
18973 Y = (YMIN/YMAX)**HWRGEN(1)*YMAX
18974 IF (ONE+(ONE-Y)**2.LT.TWO*HWRGEN(2)) GOTO 20
18975 YJAC=(TWO*LOG(YMAX/YMIN)-TWO*(YMAX-YMIN)
18976 & +HALF*(YMAX**2-YMIN**2))
18979 IF (IPRO.EQ.5) THEN
18980 Y = EXP(HWRUNI(0,LOG(YMIN),LOG(YMAX)))
18981 YJAC = Y * LOG(YMAX/YMIN)
18983 Y = HWRUNI(0,YMIN,YMAX)
18987 C---Q**2 generation
18988 Q2INF = ME**2*Y**2 / (ONE-Y)
18989 Q2SUP = MP**2 + SMA*Y - WMIN**2
18990 IF (IFL.EQ.164) THEN
18991 Q2INF = MAX(Q2INF,Q2WWMN)
18992 Q2SUP = MIN(Q2SUP,Q2WWMX)
18994 Q2INF = MAX(Q2INF,Q2MIN)
18995 Q2SUP = MIN(Q2SUP,Q2MAX)
18998 IF (Q2INF .GT. Q2SUP) GOTO 888
19000 IF (.NOT.CHARGD) THEN
19001 IF (IFL.EQ.164) THEN
19002 Q2 = EXP(HWRUNI(0,LOG(Q2INF),LOG(Q2SUP)))
19003 Q2JAC = LOG(Q2SUP/Q2INF)
19004 ELSEIF (Q2INF.LT.RMASS(4)**2) THEN
19005 Q2 = EXP(HWRUNI(0,LOG(Q2INF),LOG(Q2SUP)))
19006 Q2JAC = Q2 * LOG(Q2SUP/Q2INF)
19008 Q2 = Q2INF*Q2SUP/HWRUNI(0,Q2INF,Q2SUP)
19009 Q2JAC = Q2**2 * (Q2SUP-Q2INF)/(Q2SUP*Q2INF)
19013 Q2=(Q2INF+EMW2)*(Q2SUP+EMW2)/(HWRUNI(0,Q2INF,Q2SUP)+EMW2)-EMW2
19014 Q2JAC=(Q2+EMW2)**2*(Q2SUP-Q2INF)/((Q2SUP+EMW2)*(Q2INF+EMW2))
19016 W2 = MP**2 + SMA*Y - Q2
19017 C---s_hat generation
19019 SHSUP = (MIN(SQRT(W2)-MREMIN,EMLMAX))**2
19021 IF (SHINF .GT. SHSUP) GOTO 888
19023 IF (IPRO.EQ.91) THEN
19024 IF (.NOT.CHARGD) THEN
19025 SHAT = SHINF*SHSUP/HWRUNI(0,SHINF,SHSUP)
19026 SHJAC = SHAT**2 * (SHSUP-SHINF)/(SHSUP*SHINF)
19028 SHAT = EXP(HWRUNI(0,LOG(SHINF),LOG(SHSUP)))
19029 SHJAC = SHAT*(LOG(SHSUP/SHINF))
19033 IF (SHINF.GT.EMW2+10*GAMW*EMW) THEN
19034 SHAT = SHINF*SHSUP/HWRUNI(0,SHINF,SHSUP)
19035 SHJAC = SHAT**2 * (SHSUP-SHINF)/(SHSUP*SHINF)
19036 ELSEIF (SHSUP.LT.EMW2-10*EMW*GAMW) THEN
19037 SHAT = HWRUNI(0,SHINF,SHSUP)
19038 SHJAC = SHSUP-SHINF
19040 TMIN=ATAN((SHINF-EMW2)/(GAMW*EMW))
19041 TMAX=ATAN((SHSUP-EMW2)/(GAMW*EMW))
19042 SHAT = GAMW*EMW*TAN(HWRUNI(0,TMIN,TMAX))+EMW2
19043 SHJAC=((SHAT-EMW2)**2+(GAMW*EMW)**2)/(GAMW*EMW)*(TMAX-TMIN)
19048 RSHAT = SQRT (SHAT)
19052 IF (.NOT.CHARGD) THEN
19059 IF (INCLUD(I)) THEN
19060 Q1CM(I) = HWUPCM( RSHAT, MFIN1(I), MFIN2(I) )
19061 IF (Q1CM(I) .LT. PTMIN) THEN
19065 CTHLIM = SQRT(ONE - (PTMIN / Q1CM(I))**2)
19066 GAMMA2 = SHAT + MFIN1(I)**2 - MFIN2(I)**2
19067 LAMBDA = (SHAT-MFIN1(I)**2-MFIN2(I)**2)**2 -
19068 + 4.D0*MFIN1(I)**2*MFIN2(I)**2
19069 ZMIF(I) = (GAMMA2 - SQRT(LAMBDA)*CTHLIM)/TWO/SHAT
19070 ZMIF(I) = MAX(ZMIF(I),ZERO)
19071 ZMAF(I) = (GAMMA2 + SQRT(LAMBDA)*CTHLIM)/TWO/SHAT
19072 ZMAF(I) = MIN(ZMAF(I),ONE)
19073 ZMIN = MIN( ZMIN, ZMIF(I) )
19074 ZMAX = MAX( ZMAX, ZMAF(I) )
19077 IF (IFL.EQ.164) ZMAX=MIN(ZMAX,ZJMAX)
19079 Q1 = HWUPCM(RSHAT,MF1,MF2)
19081 IF (Q1.LT.PTMIN) GOTO 888
19082 CTHLIM = SQRT(ONE-(PTMIN/Q1)**2)
19083 GAMMA2 = SHAT+MF1**2-MF2**2
19084 LAMBDA = (SHAT-MF1**2-MF2**2)**2-4.D0*MF1**2*MF2**2
19085 ZMIN = (GAMMA2-SQRT(LAMBDA)*CTHLIM)/TWO/SHAT
19086 ZMIN = MAX(ZMIN,1D-6)
19087 ZMAX = (GAMMA2+SQRT(LAMBDA)*CTHLIM)/TWO/SHAT
19088 ZMAX = MIN(ZMAX,ONE-1D-6)
19091 IF (ZMIN .GT. ZMAX) GOTO 888
19092 ZLMIN = LOG(ZMIN/(ONE-ZMIN))
19093 ZINT = LOG(ZMAX/(ONE-ZMAX)) - LOG(ZMIN/(ONE-ZMIN))
19094 ZL = ZLMIN+HWRGEN(0)*ZINT
19095 Z = EXP(ZL)/(ONE+EXP(ZL))
19096 ZJAC = Z*(ONE-Z)*ZINT
19099 IF ((Y.LT.YMIN.OR.Y.GT.YMAX).OR.(Q2.LT.Q2INF.OR.Q2.GT.Q2SUP).OR.
19100 + (SHAT.LT.SHINF.OR.SHAT.GT.SHSUP).OR.(Z.LT.ZMIN.OR.Z.GT.ZMAX))
19103 PHI = HWRUNI(0,ZERO,2*PIFAC)
19105 IF (IFL.EQ.164) PHIJAC=ONE
19107 AJACOB = YJAC * Q2JAC * SHJAC * ZJAC * PHIJAC
19109 IF (IQK.NE.0.OR.IPRO.EQ.5) GOTO 999
19110 C---contributing subprocesses: filling of logical vector INSIDE
19117 IF (INCLUD(I)) THEN
19118 IF ( Y.LT.YMIF(I) ) GOTO 200
19120 Q2MAF(I) = MP**2 + SMA*Y - WMIF(I)**2
19121 Q2MAF(I) = MIN( Q2MAF(I), Q2MAX)
19122 IF (Q2INF .GT. Q2MAF(I)) GOTO 200
19123 IF (Q2.LT.Q2INF .OR. Q2.GT.Q2MAF(I)) GOTO 200
19125 EMMAWF(I) = SQRT(W2) - MREMIF(I)
19126 EMMAWF(I) = MIN( EMMAWF(I), EMLMAX )
19128 IF (EMMIF(I) .GT. EMMAWF(I)) GOTO 200
19129 IF (SHAT.LT.EMMIF(I)**2.OR.SHAT.GT.EMMAWF(I)**2) GOTO 200
19131 IF (ZMIF(I) .GT. ZMAF(I)) GOTO 200
19132 IF (Z.LT.ZMIF(I) .OR. Z.GT.ZMAF(I)) GOTO 200
19138 C---UNCOMMENT THIS LINE TO GET A DEBUGGING WARNING FOR NO PHASE-SPACE
19139 C CALL HWWARN('HWHBRN',DEBUG)
19143 *CMZ :- -03/07/95 19.02.12 by Giovanni Abbiendi
19144 *-- Author : Giovanni Abbiendi & Luca Stanco
19145 C----------------------------------------------------------------------
19147 C----------------------------------------------------------------------
19148 C Returns differential cross section DSIGMA in (Y,Q2,ETA,Z,PHI)
19149 C Scale for structure functions and alpha_s selected by BGSHAT
19150 C----------------------------------------------------------------------
19151 INCLUDE 'herwig65.inc'
19152 DOUBLE PRECISION HWUALF,HWUAEM,Y,Q2,SHAT,Z,PHI,AJACOB,DSIGMA,
19153 & ME,MP,ML,MREMIF(18),MFIN1(18),MFIN2(18),RS,SMA,W2,RSHAT,
19154 & SFUN(13),ALPHA,LDSIG,DLQ(7),SG,XG,MF1,MF2,MSUM,MDIF,MPRO,FFUN,
19155 & GFUN,H43,H41,H11,H12,H14,H16,H21,H22,G11,G12,G1A,G1B,G21,G22,G3,
19156 & GC,A11,A12,A44,ALPHAS,PDENS,AFACT,BFACT,CFACT,DFACT,GAMMA,S,T,U,
19157 & MREMIN,POL,CCOL,ETA
19159 INTEGER IQK,IFLAVU,IFLAVD,IMIN,IMAX,IFL,IPROO,IHAD,ILEPT,IQ,IS
19160 LOGICAL CHARGD,INCLUD(18),INSIDE(18)
19161 EXTERNAL HWUALF,HWUAEM
19162 COMMON /HWAREA/ Y,Q2,SHAT,Z,PHI,AJACOB,DSIGMA,ME,MP,ML,MREMIF,
19163 & MFIN1,MFIN2,RS,SMA,W2,RSHAT,IQK,IFLAVU,IFLAVD,IMIN,IMAX,IFL,LEP,
19164 & IPROO,CHARGD,INCLUD,INSIDE
19167 IF (JDAHEP(1,IHAD).NE.0) IHAD=JDAHEP(1,IHAD)
19180 IF (IFL.EQ.164) IS=IQK
19181 MREMIN = MREMIF(IS)
19185 C---choose subprocess scale
19190 IF (IFL.GE.7.AND.IFL.LE.18) S=SHAT+Q2-MF1**2
19193 IF (IFL.GE.7.AND.IFL.LE.18) U=-S-T-2*MF1**2
19194 EMSCA = SQRT(TWO*S*T*U/(S**2+T**2+U**2))
19195 IF (IFL.EQ.164) EMSCA=SQRT(-U)
19197 ALPHAS = HWUALF(1,EMSCA)
19198 IF (ALPHAS.GE.ONE.OR.ALPHAS.LE.ZERO) THEN
19199 CALL HWWARN('HWHBSG',51)
19202 C---structure functions
19203 ETA = (SHAT+Q2)/SMA/Y
19204 IF (ETA.GT.ONE) ETA=ONE
19205 CALL HWSFUN (ETA,EMSCA,IDHW(IHAD),NSTRU,SFUN,2)
19206 XG = Q2/(SHAT + Q2)
19208 IF (SG.LE.(RSHAT+ML)**2.OR.SG.GE.(RS-MREMIN)**2) GOTO 888
19210 IF (IFL.EQ.164) GOTO 200
19212 C---Electroweak couplings
19215 POL = PPOLN(3) - EPOLN(3)
19216 DLQ(1)=.0625*VCKM(IFLAVU/2,(IFLAVD+1)/2)/SWEIN**2 *
19217 + Q2**2/((Q2+RMASS(198)**2)**2+(RMASS(198)*GAMW)**2) *
19223 ILEPT=MOD(IDHW(1)-121,6)+11
19224 CALL HWUCFF(ILEPT,IQ,-Q2,DLQ(1))
19228 C---For Boson-Gluon Fusion
19229 PDENS = SFUN(13)/ETA
19231 MSUM = (MF1**2 + MF2**2) / (Y*SG)
19232 MDIF = (MF1**2 - MF2**2) / (Y*SG)
19233 MPRO = MF1*MF2 / (Y*SG)
19235 FFUN = (1.D0-XG)*Z*(1.D0-Z) + (MDIF*(2.D0*Z-1.D0)-MSUM)/2.D0
19236 GFUN = (1.D0-XG)*(1.D0-Z) + XG*Z + MDIF
19237 IF ( FFUN .LT. ZERO ) FFUN = ZERO
19238 H43 = (8.D0*(2.D0*Z**2*XG-Z**2-2.D0*Z*XG+2.D0*Z*MDIF+Z-MDIF
19239 & -MSUM)) / (Z*(1.D0-Z))**2
19241 H41 = (8.D0*(Z**2-Z*XG+Z*MDIF-MDIF-MSUM)) / (Z**2*(1.D0-Z))
19243 H11 = (4.D0*(2.D0*Z**4-4.D0*Z**3+2.D0*Z**2*MSUM*XG
19244 & -2.D0*Z**2*MSUM+2.D0*Z**2*XG**2-2.D0*Z**2*XG+3.D0*Z**2
19245 & +2.D0*Z*MDIF*MSUM+2.D0*Z*MDIF*XG-2.D0*Z*MSUM*XG
19246 & +2.D0*Z*MSUM-2.D0*Z*XG**2+2.D0*Z*XG-Z-MDIF*MSUM-MDIF*XG
19247 & -MSUM**2-MSUM*XG)) / (Z*(1.D0-Z))**2
19249 H12 = (16.D0*(-Z*MDIF+Z*XG+MDIF+MSUM))/(Z**2*(1.D0-Z))
19251 H14 = (16.D0*(-2.D0*Z**2*XG-2.D0*Z*MDIF+2.D0*Z*XG+MDIF+MSUM))
19252 & / (Z*(1.D0-Z))**2
19254 H16 = (32.D0*(Z*MDIF-Z*XG-MDIF-MSUM)) / (Z**2*(1.D0-Z))
19256 H21 = (8.D0*MPRO*(-2.D0*Z**2*XG+2.D0*Z**2-2.D0*Z*MDIF+2.D0*Z*XG
19257 + -2.D0*Z+MDIF+MSUM)) / (Z*(1.D0-Z))**2
19259 H22 = (-32.D0*MPRO) / (Z*(1.D0-Z))
19261 G11 = -2.D0*H11 + FFUN*H14
19262 G12 = 2.D0*XG*FFUN*H14 + H12 + GFUN * ( H16+GFUN*H14 )
19263 G1A = SQRT( XG*FFUN ) * ( H16 + 2.D0*GFUN*H14 )
19267 G3 = H41 - GFUN*H43
19268 GC = SQRT( XG*FFUN ) * (-2.D0*XG*H43 )
19270 C---for QCD Compton, massless matrix element
19271 PDENS = SFUN(IFL-6)/ETA
19273 FFUN = XG*(ONE-XG)*Z*(ONE-Z)
19274 GFUN = (ONE-XG)*(ONE-Z)+XG*Z
19275 G11 = 8.D0*((Z**2+XG**2)/(ONE-XG)/(ONE-Z)+TWO*(XG*Z+ONE))
19276 G12 = 64.D0*XG**2*Z+TWO*XG*G11
19277 G1A = 32.D0*XG*GFUN*SQRT(FFUN)/((ONE-XG)*(ONE-Z))
19279 G3 = -16.D0*(ONE-XG)*(ONE-Z)+G11
19280 GC = -16.D0*XG*SQRT(FFUN)*(ONE-Z-XG)/((ONE-XG)*(ONE-Z))
19285 A11 = XG * Y**2 * G11 + (1.D0-Y) * G12
19286 & - (2.D0-Y) * SQRT( 1.D0-Y ) * G1A * COS( PHI )
19287 & + 2.D0 * XG * (1.D0-Y) * G1B * COS( 2.D0*PHI )
19289 A12 = XG * Y**2 * G21 + (1.D0-Y) * G22
19291 A44 = XG * Y * (2.D0-Y) * G3
19292 & - 2.D0 * Y * SQRT( 1.D0-Y ) * GC * COS( PHI )
19294 IF ( Y*Q2**2 .LT. 1D-38 ) THEN
19295 C---prevent numerical uncertainties in DSIGMA computation
19296 DSIGMA = PDENS*ALPHA**2*ALPHAS*GEV2NB*CCOL/(16.D0*PIFAC)
19297 & *(DLQ(1)*A11 + DLQ(2)*A12 + FLOAT(LEP)*DLQ(3)*A44)
19298 IF ( DSIGMA .LE. ZERO ) GOTO 888
19299 LDSIG = LOG (DSIGMA) - LOG (Y) - 2.D0 * LOG (Q2)
19300 DSIGMA = EXP (LDSIG)
19302 DSIGMA = PDENS*ALPHA**2*ALPHAS*GEV2NB*CCOL
19303 & * (DLQ(1)*A11 + DLQ(2)*A12 + FLOAT(LEP)*DLQ(3)*A44)
19304 & / (16.D0*PIFAC*Y*Q2**2)
19306 IF (DSIGMA.LT.ZERO) GOTO 888
19310 C--- J/psi production
19311 ALPHA = HWUAEM(-Q2)
19313 PDENS = SFUN(13)/ETA
19314 AFACT = (8.D0*PIFAC*ALPHAS**2*RMASS(164)**3*GAMMA)/(3.D0*ALPHA)
19315 BFACT = ONE/(Y*SG*Z**2*((Z-ONE)*Y*SG-RMASS(164)**2)**2)
19316 CFACT = (RMASS(164)**2-Z*Y*SG)**2/(Y*SG*(ONE-XG)**2*
19317 & ((ONE-XG)*Y*SG-RMASS(164)**2)**2*
19318 & ((Z-ONE)*Y*SG-RMASS(164)**2)**2)
19319 DFACT = ((Z-ONE)*Y*SG)**2/(Y*SG*(ONE-XG)**2*
19320 & ((ONE-XG)*Y*SG-RMASS(164)**2)**2*(Z*Y*SG)**2)
19321 DSIGMA = GEV2NB*ALPHA/(TWO*PIFAC)*AFACT*(BFACT+CFACT+DFACT)*PDENS
19322 IF (DSIGMA.LT.ZERO ) GOTO 888
19327 *CMZ :- -26/04/91 14.55.44 by Federico Carminati
19328 *-- Author : Giovanni Abbiendi & Luca Stanco
19329 C----------------------------------------------------------------------
19331 C----------------------------------------------------------------------
19332 C DEEP INELASTIC LEPTON-HADRON SCATTERING: MEAN EVWGT = SIGMA IN NB
19333 C----------------------------------------------------------------------
19334 INCLUDE 'herwig65.inc'
19335 DOUBLE PRECISION HWRGEN,HWRUNI,HWUPCM,PRAN,PROB,SAMP,SIG,Q2,
19336 & XBJ,Y,W,S,MLEP,MHAD,MLSCAT,YMIN,YMAX,XXMAX,Q2JAC,XXJAC,
19337 & JACOBI,A1,A2,A3,B1,B2,PCM,PCMEP,PCMLW,PCMEQ,PCMLQ,COSPHI,PA,
19338 & EQ,PZQ,SHAT,PROP,DLEFT,DRGHT,DUP,DWN,FACT,EFACT,OMY2,YPLUS,
19339 & YMNUS,SIGMA,AF(7,12),SMA,Q2SUP,HWUAEM,DCHRG,DNEUT
19340 INTEGER I,IQK,IQKIN,IQKOUT,IDSCAT,IHAD,ILEPT,LEP
19342 EXTERNAL HWRGEN,HWRUNI,HWUPCM
19343 SAVE MLEP,MHAD,S,SMA,PCM,MLSCAT,A1,A2,A3,B1,B2,DLEFT,DRGHT,Q2,
19344 & AF,XBJ,Y,YPLUS,YMNUS,OMY2,FACT,EFACT,SIGMA,IDSCAT,CHARGD,
19345 & ILEPT,DCHRG,DNEUT,LEP
19348 IF (JDAHEP(1,IHAD).NE.0) IHAD=JDAHEP(1,IHAD)
19349 IF (FSTWGT.OR.IHAD.NE.2) THEN
19350 C---INITIALISE PROCESS (MUST BE DONE EVERY TIME IF S VARIES)
19351 C---LEPTON AND HADRON MASSES, INVARIANT MASS, MOMENTUM IN C.M. FRAME
19355 SMA=S-MLEP**2-MHAD**2
19356 PCM=HWUPCM(SQRT(S),MLEP,MHAD)
19357 C---LEP = 1 FOR LEPTONS, -1 FOR ANTILEPTONS
19358 IF (IDHW(1).GE.121.AND.IDHW(1).LE.126) THEN
19360 ELSEIF (IDHW(1).GE.127.AND.IDHW(1).LE.132) THEN
19363 CALL HWWARN('HWHDIS',500)
19365 DCHRG=FLOAT(MOD(IDHW(1) ,2))
19366 DNEUT=FLOAT(MOD(IDHW(1)+1,2))
19367 ILEPT=MOD(IDHW(1)-121,6)+11
19368 C---DLEFT,DRIGHT = 1,0 for leptons; = 0,1 for anti-leptons
19371 CHARGD=MOD(IPROC,100)/10.EQ.1
19372 C---Evaluate constant factor in cross section and
19373 C find and store scattered lepton identity
19375 IF ((EPOLN(3)-PPOLN(3)).EQ.ONE) THEN
19377 CALL HWWARN('HWHDIS',501)
19378 5 FORMAT(1X,'WARNING: Cross-section is zero for the',
19379 & ' specified lepton helicity')
19381 FACT=GEV2NB*(ONE-(EPOLN(3)-PPOLN(3)))*.25D0*PIFAC
19382 & /(SWEIN*RMASS(198)**2)**2
19383 IDSCAT=IDHW(1)+NINT(DCHRG-DNEUT)
19385 FACT=GEV2NB*TWO*PIFAC
19388 MLSCAT=RMASS(IDSCAT)
19389 C---PARAMETERS USED FOR THE WEIGHT GENERATION IN NEUTRAL CURRENT
19390 C PROCESSES. ASSUME D(SIGMA)/D(Q**2) GOES LIKE A1+A2/Q**2+A3/Q**4
19391 C AND D(SIGMA)/D(X) LIKE B1+B2/X
19399 C---GENERATE EVENT (KINEMATICAL VARIABLES AND STRUCTURE FUNCTION
19401 PRAN=SIGMA*HWRGEN(0)
19403 C---CHARGED CURRENT PROCESS
19405 C---FIND FLAVOUR OF THE STRUCK QUARK (IF NOT SELECTED BY THE USER)
19411 & ((DCHRG*(DLEFT*DUP+DRGHT*DWN*OMY2)
19412 & +DNEUT*(DLEFT*DWN+DRGHT*DUP*OMY2))*DISF(I ,1)
19413 & +(DCHRG*(DLEFT*DWN*OMY2+DRGHT*DUP)
19414 & +DNEUT*(DLEFT*DUP*OMY2+DRGHT*DWN))*DISF(I+6,1))
19415 IF (PROB.GE.PRAN) GOTO 20
19423 IF ((LEP.EQ. 1.AND.MOD(IQK+IDHW(1),2).EQ.0)
19424 & .OR.(LEP.EQ.-1.AND.MOD(IQK+IDHW(1),2).EQ.1)) IQKIN=IQK+6
19425 C---FIND FLAVOUR OF THE OUTGOING QUARK
19428 IF (DUP.EQ.ONE) THEN
19430 PROB=PROB+VCKM(IQK/2,I)
19431 IF (PROB.GE.PRAN) GOTO 40
19435 IF (IQKIN.GT.6) IQKOUT=IQKOUT+6
19438 PROB=PROB+VCKM(I,(IQK+1)/2)
19439 IF (PROB.GE.PRAN) GOTO 60
19443 IF (IQKIN.GT.6) IQKOUT=IQKOUT+6
19446 C---NEUTRAL CURRENT PROCESS
19449 PROB=EFACT*(AF(1,IQK)*YPLUS*DISF(IQK,1)+
19450 & FLOAT(LEP)*AF(3,IQK)*YMNUS*DISF(IQK,1))
19451 IF (PROB.LT.PRAN) IQKIN=IQK+6
19453 C---FIND FLAVOUR OF THE STRUCK QUARK (IF NOT SELECTED BY THE USER)
19457 IF (I.GT.6) SIG=-ONE
19458 PROB=PROB+EFACT*(AF(1,I)*YPLUS*DISF(I,1)+
19459 & FLOAT(LEP)*SIG*AF(3,I)*YMNUS*DISF(I,1))
19460 IF (PROB.GE.PRAN) GOTO 80
19477 C---CHECK PHASE SPACE WITH THE SELECTED FLAVOUR. IF OUTSIDE THE
19479 PA=XBJ*(PHEP(4,IHAD)+ABS(PHEP(3,IHAD)))
19480 EQ=HALF*(PA+RMASS(IDN(2))**2/PA)
19482 SHAT=(PHEP(4,1)+EQ)**2-(PHEP(3,1)+PZQ)**2
19483 PCMEQ=HWUPCM(SQRT(SHAT),MLEP,RMASS(IDN(2)))
19484 PCMLQ=HWUPCM(SQRT(SHAT),MLSCAT,RMASS(IDN(4)))
19485 IF (PCMLQ.LT.ZERO) THEN
19486 CALL HWWARN('HWHDIS',101)
19488 ELSEIF (PCMLQ.EQ.ZERO) THEN
19491 COSTH=(TWO*SQRT(PCMEQ**2+MLEP**2)*SQRT(PCMLQ**2+MLSCAT**2)
19492 & -(Q2+MLEP**2+MLSCAT**2))/(TWO*PCMEQ*PCMLQ)
19494 IF (ABS(COSTH).GT.ONE) THEN
19495 CALL HWWARN('HWHDIS',102)
19499 CALL HWETWO(.TRUE.,.TRUE.)
19503 C---CHOOSE X,Y (CC PROCESS)
19504 YMIN=MAX(YBMIN,Q2MIN/SMA)
19505 YMAX=MIN(YBMAX,ONE)
19506 IF (YMIN.GT.YMAX) GOTO 999
19507 Y=HWRUNI(0,YMIN,YMAX)
19509 XXMAX=MIN(Q2MAX/SMA/Y,ONE)
19510 IF (XXMIN.GT.XXMAX) GOTO 999
19511 XBJ=HWRUNI(0,XXMIN,XXMAX)
19512 Q2=XBJ*Y*(S-MLEP**2-MHAD**2)
19513 JACOBI=(YMAX-YMIN)*(XXMAX-XXMIN)*(S-MLEP**2-MHAD**2)*XBJ
19515 C---CHOOSE X,Q**2 (NC PROCESS)
19516 Q2SUP=MIN(Q2MAX,SMA*YBMAX)
19517 IF (Q2MIN.GT.Q2SUP) GOTO 999
19518 SAMP=(A1+A2+A3)*HWRGEN(0)
19519 IF (SAMP.LE.A1) THEN
19520 Q2=HWRUNI(0,Q2MIN,Q2SUP)
19521 ELSEIF (SAMP.LE.(A1+A2)) THEN
19522 Q2=EXP(HWRUNI(0,LOG(Q2MIN),LOG(Q2SUP)))
19524 Q2=-ONE/HWRUNI(0,-ONE/Q2MIN,-ONE/Q2SUP)
19527 & (A1/(Q2SUP-Q2MIN)
19528 & +A2/LOG(Q2SUP/Q2MIN)/Q2
19529 & +A3*Q2MIN*Q2SUP/(Q2SUP-Q2MIN)/Q2**2)
19532 IF (YBMIN.GT.ZERO) XXMAX=MIN(Q2/SMA/YBMIN,ONE)
19533 IF (XXMIN.GT.XXMAX) GOTO 999
19534 SAMP=(B1+B2)*HWRGEN(0)
19535 IF (SAMP.LE.B1) THEN
19536 XBJ=HWRUNI(0,XXMIN,XXMAX)
19538 XBJ=EXP(HWRUNI(0,LOG(XXMIN),LOG(XXMAX)))
19540 XXJAC=(B1+B2)/(B1/(XXMAX-XXMIN)+B2/LOG(XXMAX/XXMIN)/XBJ)
19541 Y=Q2/(S-MLEP**2-MHAD**2)/XBJ
19544 C---CHECK IF THE GENERATED POINT IS INSIDE PHASE SPACE. IF NOT
19545 C RETURN WITH WEIGHT EQUAL TO ZERO.
19546 W=SQRT(MHAD**2+Q2*(ONE-XBJ)/XBJ)
19547 IF (W.LT.WHMIN) RETURN
19549 PCMLW=HWUPCM(SQRT(S),MLSCAT,W)
19550 IF (PCMLW.LT.ZERO) THEN
19553 ELSEIF (PCMLW.EQ.ZERO) THEN
19557 & (TWO*SQRT(PCMEP**2+MLEP**2)*SQRT(PCMLW**2+MLSCAT**2)
19558 & -(Q2+MLEP**2+MLSCAT**2))/(TWO*PCMEP*PCMLW)
19560 IF (ABS(COSPHI).GT.ONE) THEN
19564 C---SET SCALE EQUAL Q. EVALUATE STRUCTURE FUNCTIONS.
19566 CALL HWSFUN(XBJ,EMSCA,IDHW(IHAD),NSTRU,DISF,2)
19567 C---SWITCH OFF ANY FLAVOURS THAT ARE BELOW THRESHOLD
19569 90 IF (W.LT.2*RMASS(I)) DISF(I,1)=0
19570 C---EVALUATE DIFFERENTIAL CROSS SECTION
19572 PROP=RMASS(198)**2/(Q2+RMASS(198)**2)
19573 EFACT=FACT*(HWUAEM(-Q2)*PROP)**2/XBJ
19579 IF (IQK.NE.0.AND.IQK.NE.I) GOTO 100
19581 & ((DCHRG*(DLEFT*DUP+DRGHT*DWN*OMY2)
19582 & +DNEUT*(DLEFT*DWN+DRGHT*DUP*OMY2))*DISF(I ,1)
19583 & +(DCHRG*(DLEFT*DWN*OMY2+DRGHT*DUP)
19584 & +DNEUT*(DLEFT*DUP*OMY2+DRGHT*DWN))*DISF(I+6,1))
19587 EFACT=FACT/XBJ*(HWUAEM(-Q2)/Q2)**2
19588 YPLUS=ONE+(ONE-Y)**2
19589 YMNUS=ONE-(ONE-Y)**2
19591 CALL HWUCFF(ILEPT,I,-Q2,AF(1,I))
19597 IF (IQK.NE.0.AND.IQK.NE.I) GOTO 200
19598 SIGMA=SIGMA+EFACT*(AF(1,I)*YPLUS*(DISF(I,1)+DISF(I+6,1))+
19599 & FLOAT(LEP)*AF(3,I)*YMNUS*(DISF(I,1)-DISF(I+6,1)))
19602 C---FIND WEIGHT: DIFFERENTIAL CROSS SECTION TIME THE JACOBIAN FACTOR
19604 IF (EVWGT.LT.ZERO) EVWGT=ZERO
19609 *CMZ :- -18/05/99 12.41.07 by Mike Seymour
19610 *-- Author : Bryan Webber, Ian Knowles and Mike Seymour
19611 C-----------------------------------------------------------------------
19613 C-----------------------------------------------------------------------
19614 C Drell-Yan Production of fermion pairs via photon, Z0 & (if ZPRIME)
19615 C Z' exchange. Lepton universality is assumed for photon and Z, and
19616 C for Z' if no lepton flavour is specified.
19617 C MEAN EVWGT = SIGMA IN NB
19619 C Modified 16/01/01 by BRW to implement Peter Richardson's
19620 C fix for bug in lepton mass effects on branching ratio
19621 C-----------------------------------------------------------------------
19622 INCLUDE 'herwig65.inc'
19623 DOUBLE PRECISION HWRGEN,HWRUNI,HWUAEM,EPS,C1,C2,C3,EMSQZ,EMGMZ,
19624 & EMSQZP,EMGMZP,CQF(7,6,16),QPOW,RPOW,A01,A1,A02,A2,A03,A3,CRAN,
19625 & EMJ1,EMJ2,EMJ3,EMJAC,FACT,QSQ,HCS,FACTR,RCS,EXTRA,PMAX,PTHETA
19626 INTEGER IMODE,JQMN,JQMX,JQ,JLMN,JLMX,JL,IQ,I,IADD(2,2),ID1,ID2,
19628 EXTERNAL HWRGEN,HWRUNI,HWUAEM
19629 SAVE HCS,JQMN,JQMX,JLMN,JLMX,C1,C2,C3,QPOW,RPOW,EMSQZ,EMGMZ,
19630 & A1,A01,A2,A02,A3,A03,EMSQZP,EMGMZP,FACT,CQF
19631 PARAMETER (EPS=1.D-9)
19638 C Set limits for which particles to include
19643 IMODE=MOD(IPROC,100)
19644 IF (IMODE.EQ.0) THEN
19647 ELSEIF (IMODE.LE.10) THEN
19650 ELSEIF (IMODE.EQ.50) THEN
19653 ELSEIF (IMODE.GE.50.AND.IMODE.LE.60) THEN
19656 ELSEIF (IMODE.EQ.99) THEN
19662 CALL HWWARN('HWHDYP',500)
19664 C Set up parameters for importance sampling:
19665 C sum of power law and two Breit-Wigners (relative weights C1,C2,C3)
19670 IF (EMPOW.EQ.ONE) CALL HWWARN('HWHDYP',501)
19671 IF (C2.EQ.ZERO) CALL HWWARN('HWHDYP',502)
19672 IF (C3.EQ.ZERO.AND.ZPRIME) CALL HWWARN('HWHDYP',503)
19675 EMSQZ=RMASS(200)**2
19676 EMGMZ=RMASS(200)*GAMZ
19678 A1=(EMMAX**QPOW-A01)/C1
19679 A02=ATAN((EMMIN**2-EMSQZ)/EMGMZ)
19680 A2=(ATAN((EMMAX**2-EMSQZ)/EMGMZ)-A02)/C2
19681 IF (C3.GT.ZERO) THEN
19682 EMSQZP=RMASS(202)**2
19683 EMGMZP=RMASS(202)*GAMZP
19684 A03=ATAN((EMMIN**2-EMSQZP)/EMGMZP)
19685 A3=(ATAN((EMMAX**2-EMSQZP)/EMGMZP)-A03)/C3
19689 C Select a mass for the produced pair
19690 CRAN=(C1+C2+C3)*HWRGEN(1)
19691 IF (CRAN.LT.C1) THEN
19693 EMSCA=(A01+A1*CRAN)**RPOW
19695 ELSEIF (CRAN.LT.C1+C2) THEN
19696 C Use Z Breit-Wigner
19698 QSQ=EMSQZ+EMGMZ*TAN(A02+A2*CRAN)
19701 C Use Z' Breit-Wigner
19703 QSQ=EMSQZP+EMGMZP*TAN(A03+A3*CRAN)
19706 EMJ1=EMSCA**EMPOW/(1-EMPOW)*A1
19707 EMJ2=((QSQ-EMSQZ)**2+EMGMZ**2)/(2*EMSCA*EMGMZ)*A2
19708 IF (C3.GT.ZERO) THEN
19709 EMJ3=((QSQ-EMSQZP)**2+EMGMZP**2)/(2*EMSCA*EMGMZP)*A3
19710 EMJAC=(C1+C2+C3)/(1/EMJ1+1/EMJ2+1/EMJ3)
19712 EMJAC=(C1+C2)/(1/EMJ1+1/EMJ2)
19714 C Select initial momentum fractions
19715 XXMIN=QSQ/PHEP(5,3)**2
19717 CALL HWSGEN(.TRUE.)
19718 FACT=-GEV2NB*HWUAEM(QSQ)**2*PIFAC*8*EMJAC*XLMIN
19719 $ /(3*NCOLO*EMSCA**3)
19720 C Store cross-section coefficients
19723 IF (EMSCA.GT.2.*RMASS(JQ)) THEN
19724 CALL HWUCFF(IQ,JQ,QSQ,CQF(1,IQ,JQ))
19726 CALL HWVZRO(7,CQF(1,IQ,JQ))
19730 IF (EMSCA.GT.2.*RMASS(JL+110)) THEN
19731 CALL HWUCFF(IQ,JL,QSQ,CQF(1,IQ,JL))
19733 CALL HWVZRO(7,CQF(1,IQ,JL))
19741 C I=1 quark first, I=2 anti-quark first
19745 IF (DISF(ID1,1).LT.EPS.OR.DISF(ID2,2).LT.EPS) GOTO 80
19746 FACTR=FACT*DISF(ID1,1)*DISF(ID2,2)
19747 C Quark final states
19752 HCS=HCS+FACTR*(CQF(1,IQ,JQ)*FLOAT(NCOLO)+3*HALF*QFCH(IQ)**4)
19753 IF (GENEV.AND.HCS.GT.RCS) THEN
19754 CALL HWHQCP(ID3,ID4,2143,50)
19758 HCS=HCS+FACTR*CQF(1,IQ,JQ)*FLOAT(NCOLO)
19759 IF (GENEV.AND.HCS.GT.RCS) THEN
19760 CALL HWHQCP(ID3,ID4,2143,50)
19765 C Lepton final states
19769 HCS=HCS+FACTR*CQF(1,IQ,JL)
19770 IF (GENEV.AND.HCS.GT.RCS) THEN
19771 CALL HWHQCP(ID3,ID4,2134,50)
19788 C Select polar angle from distribution:
19789 C CQF(1,IQ,JF)*(ONE+COSTH**2)+CQF(3,IQ,JF)*COSTH+EXTRA*(ONE+COSTH)
19790 IF (ID1.EQ.ID3.OR.ID2.EQ.ID3) THEN
19791 EXTRA=TWO*QFCH(ID3)**4/NCOLO
19795 PMAX=2.*(CQF(1,IQ,JF)+EXTRA)+ABS(CQF(3,IQ,JF))
19796 100 COSTH=HWRUNI(0,-ONE,ONE)
19797 PTHETA=CQF(1,IQ,JF)*(ONE+COSTH**2)+TWO*CQF(3,IQ,JF)*COSTH
19798 & +EXTRA*(ONE+COSTH)
19799 IF (PTHETA.LT.PMAX*HWRGEN(1)) GOTO 100
19800 IF (ID1.GT.ID2) COSTH=-COSTH
19802 CALL HWETWO(.TRUE.,.TRUE.)
19805 *CMZ :- -14/03/01 09:03:25 by Peter Richardson
19806 *-- Author : Peter Richardson
19807 C-----------------------------------------------------------------------
19808 SUBROUTINE HWHDYQ(FSTCLL,HCS,IFLOW,IDP,ORD,IQ,MASS)
19809 C-----------------------------------------------------------------------
19810 C Drell-Yan production with a q qbar pair
19811 C-----------------------------------------------------------------------
19812 INCLUDE 'herwig65.inc'
19813 INTEGER I,MAP(12),ORD,IFL,IDP(6),IFLOW,QCFL(2,2),GCFL(2),IDZ,IQ
19814 DOUBLE PRECISION HCS,RCS,MQ(2,5),HWRGEN,G(12,2),DIST(2),MG(2)
19815 LOGICAL FSTCLL,MASS
19820 DATA MAP/1,2,3,4,5,6,11,12,13,14,15,16/
19821 DATA QCFL/2413,3142,4123,2341/
19822 DATA GCFL/2413,4123/
19824 RCS = HCS*HWRGEN(1)
19826 C--to the initalisation
19828 C--G(I,1) is the right charge and G(I,2) is the left charge
19830 G(I,1) = VFCH(MAP(I),1)-AFCH(MAP(I),1)
19831 G(I,2) = VFCH(MAP(I),1)+AFCH(MAP(I),1)
19835 C--identify the Z decay product
19837 IF(IDZ.GT.6) IDZ = IDZ-114
19838 C--calculate the matrix elements
19841 CALL HWH2MQ(IQ,IDZ,MG,MQ)
19844 CALL HWH2M0(IQ,IDZ,MG,MQ)
19847 C--multiply the matrix elements by the PDF's to obtain the cross section
19851 C--first the qqbar initial states
19855 DIST(1) = DISF(IDP(1),1)*DISF(IDP(2),2)
19856 DIST(2) = DISF(IDP(1),2)*DISF(IDP(2),1)
19859 IFLOW = QCFL(IFL,ORD)
19860 HCS = HCS+DIST(ORD)*MQ(IFL,IDP(1))/36.0D0
19861 IF(GENEV.AND.HCS.GT.RCS) RETURN
19865 C--then the gluon gluon inital state
19868 DIST(1) = DISF(IDP(1),1)*DISF(IDP(1),2)
19871 HCS = HCS+DIST(1)*MG(IFL)/256.0D0
19872 IF(GENEV.AND.HCS.GT.RCS) RETURN
19876 *CMZ :- -19/03/92 10.13.56 by Mike Seymour
19877 *-- Author : Mike Seymour
19878 C-----------------------------------------------------------------------
19880 C----------------------------------------------------------------------
19881 C HARD PROCESS: EE --> EEGAMGAM --> EEFFBAR/WW
19882 C MEAN EVENT WEIGHT = CROSS-SECTION IN NB
19883 C AFTER CUTS ON PT AND MASS OF CENTRE-OF-MASS SYSTEM
19884 C AND COS(THETA) IN CENTRE-OF-MASS SYSTEM
19885 C AND TIMES BRANCHING FRACTION IF WW
19886 C-----------------------------------------------------------------------
19887 INCLUDE 'herwig65.inc'
19888 DOUBLE PRECISION HWRGEN,HWULDO,EMSQ,BETA,S,T,U,TMIN,TMAX,TRAT,
19889 & DSDT,PROB,X,Z(2),ZMIN,ZMAX,PCMIN,PCMAX,PCFAC,PLOGMI,PLOGMA,PTCMF,
19890 & Q,PC,BLOG,EMCMIN,EMCMAX,EMLMIN,EMLMAX,WGT(6),RWGT,CV,CA,BR,QT(2),
19891 & QX(2),QY(2),PX,PY,ROOTS,DOT,A,B,C,SHAT,PCF(2),PCM(2),PCMAC,ZZ(2),
19893 INTEGER I,IGAM,ID,IDL,ID1,ID2,IHEP,JHEP,NADD,NTRY,NQ,JGAM
19895 EXTERNAL HWRGEN,HWULDO,HWRLOG
19896 SAVE S,BETA,X,ID,NQ,WGT,EMLMIN,EMLMAX,PCFAC,PLOGMA,PLOGMI,SHAT,
19897 & PCF,PCM,Z,PCMAC,NADD
19898 IF (IERROR.NE.0) RETURN
19899 C---INITIALIZE LOCAL COPIES OF EMMIN,EMMAX
19904 IF (.NOT.GENEV) THEN
19905 C---CHOOSE Z1,Z2 AND CALCULATE SUB-PROCESS CROSS-SECTION
19907 C-----FIND FINAL STATE PARTICLES
19908 IHPRO=MOD(IPROC,100)
19909 IF (IHPRO.EQ.0) THEN
19912 COLFAC=FLOAT(NCOLO)
19914 ELSEIF (IHPRO.LE.6) THEN
19917 COLFAC=FLOAT(NCOLO)
19920 ELSEIF (IHPRO.LE.9) THEN
19926 ELSEIF (IHPRO.LE.10) THEN
19931 CALL HWWARN('HWHEGG',200)
19933 C-----SPLIT ELECTRONS TO PHOTONS
19936 S=2*HWULDO(PHEP(1,1),PHEP(1,2))
19938 EMCMIN=MAX(EMLMIN,MAX(2*RMASS(ID),PTMIN))
19939 EMCMAX=MIN(EMLMAX,ROOTS)
19940 IF (EMCMIN.GT.EMCMAX) RETURN
19942 ZMAX=1-PHEP(5,1)/PHEP(4,1)
19943 IF (ZMIN.GT.ZMAX) RETURN
19944 CALL HWEGAM(1,ZMIN,ZMAX,.TRUE.)
19945 Z(1)=PHEP(4,NHEP-1)/PHEP(4,1)
19946 ZMIN=EMCMIN**2/(Z(1)*S)
19947 ZMAX=MIN(EMCMAX**2/(Z(1)*S), ONE-PHEP(5,2)/PHEP(4,2))
19948 IF (ZMIN.GT.ZMAX) RETURN
19949 CALL HWEGAM(2,ZMIN,ZMAX,.TRUE.)
19950 Z(2)=PHEP(4,NHEP-1)/PHEP(4,2)
19953 C-----REMOVE LOG TERMS FROM WEIGHT, CALCULATE NEW ONES FROM PT LIMITS
19954 GAMWT=GAMWT/(0.5*LOG((1-Z(1))*S/(Z(1)*PHEP(5,1)**2))
19955 & *0.5*LOG((1-Z(2))*Z(1)*S/(Z(2)*PHEP(5,2)**2)))
19956 PCF(1)=Z(1)*PHEP(5,1)
19957 PCF(2)=Z(2)*PHEP(5,2)
19958 PCFAC=SQRT(PCF(1)*PCF(2))
19959 PCM(1)=(1-Z(1))*PHEP(4,1)
19960 PCM(2)=(1-Z(2))*PHEP(4,2)
19961 PCMAC=SQRT(PCM(1)*PCM(2))
19962 PCMIN=MAX(PTMIN,MAX(PCF(1),PCF(2)))
19963 PCMAX=MIN( MIN(PTMAX,PHEP(5,3)) , MIN(PCM(1),PCM(2)) )
19964 IF (PCMIN.GT.PCMAX) RETURN
19965 PLOGMI=(LOG(PCMIN/PCFAC))**2
19966 PLOGMA=(LOG(PCMAX/PCFAC))**2
19967 GAMWT=GAMWT*(PLOGMA-PLOGMI)
19968 C-----CALCULATE CROSS-SECTION
19971 IF (IHPRO.EQ.0) THEN
19977 IF (X.GT.ONE) GOTO 10
19979 BLOG=LOG((1+BETA*CTMAX)/(1-BETA*CTMAX))/BETA
19980 IF (IHPRO.LE.9) THEN
19981 EVWGT=EVWGT+GEV2NB*4*PIFAC*COLFAC*Q**4*ALPHEM**2*BETA
19982 & /SHAT * GAMWT * ( (1+X-0.5*X**2)*BLOG
19983 & - CTMAX*(1+X**2/(CTMAX**2*(X-1)+1)) )
19986 CALL HWDBOZ(198,ID1,ID2,CV,CA,BR,1)
19987 CALL HWDBOZ(199,ID1,ID2,CV,CA,BR,1)
19988 EVWGT=EVWGT + GEV2NB*6*PIFAC*ALPHEM**2*BETA/SHAT*BR
19989 & * GAMWT * (-( X-0.5*X**2)*BLOG
19990 & + CTMAX*(1+(X**2+16/3.)/(CTMAX**2*(X-1)+1)) )
19993 C-----GAMWT MUST BE RESET TO ONE, SINCE IT IS REAPPLIED LATER!
19997 C-----CHOOSE PT OF THE CMF
19998 PTCMF=PCFAC*EXP(SQRT(HWRGEN(0)*(PLOGMA-PLOGMI)+PLOGMI))
19999 C-----CHOOSE WHICH PHOTON USUALLY HAS SMALLER PT
20002 IF (LOG(PCM(1)/PCF(1)).LT.HWRGEN(1)*2*LOG(PCMAC/PCFAC)) IGAM=2
20004 C-----CHOOSE ITS PT
20006 IF (NTRY.GT.NBTRY) THEN
20007 CALL HWWARN('HWHEGG',100)
20010 QT(IGAM)=(PCM(IGAM)/PCF(IGAM))**HWRGEN(2)
20011 PROB=(QT(IGAM)**2/(QT(IGAM)**2+1))**2
20012 QT(IGAM)=QT(IGAM)*PCF(IGAM)
20013 IF (HWRLOG(1-PROB)) GOTO 30
20014 C-----CHOOSE ITS DIRECTION
20015 CALL HWRAZM(QT(IGAM),QX(IGAM),QY(IGAM))
20016 C-----CALCULATE THE OTHER PHOTON'S PT
20017 QX(JGAM)=PTCMF-QX(IGAM)
20018 QY(JGAM)= -QY(IGAM)
20019 QT(JGAM)=SQRT(QX(JGAM)**2+QY(JGAM)**2)
20020 IF (QT(JGAM).LT.PCF(JGAM).OR.QT(JGAM).GT.PCM(JGAM)) GOTO 20
20021 C-----APPLY A RANDOM ROTATION AROUND THE BEAM AXIS
20022 CALL HWRAZM(ONE,PX,PY)
20023 IF (PX.EQ.ZERO) PX=1D-20
20024 QX(1)=(QX(1)*PX -QY(1)*PY)
20025 QY(1)=(QY(1) +QX(1)*PY)/PX
20026 QX(2)=(QX(2)*PX -QY(2)*PY)
20027 QY(2)=(QY(2) +QX(2)*PY)/PX
20028 C-----RECONSTRUCT MOMENTA
20029 IF (QT(IGAM).GT.QT(JGAM)) THEN
20033 DOT=-Z(JGAM)*S+SHAT+2*(QX(1)*QX(2)+QY(1)*QY(2))
20034 C-------SOLVE QUADRATIC IN Z(IGAM) TO FIND ELECTRON ENERGIES
20035 A=S*(S*Z(JGAM)+QT(JGAM)**2)
20036 B=S*DOT*(1+Z(JGAM))
20037 C=DOT**2+S*QT(IGAM)**2*(1-Z(JGAM))**2-4*QT(IGAM)**2*QT(JGAM)**2
20038 IF (B**2.LT.4*A*C) GOTO 20
20039 ZZ(IGAM)=(-B+SQRT(B**2-4*A*C))/(2*A)
20040 IF (ZZ(IGAM).LT.ZERO .OR. ZZ(IGAM).GT.ONE-Z(IGAM)) GOTO 20
20042 C-------REJECT AGAINST PHOTON DISTRIBUTION FUNCTION
20043 PROB=((1+ZZ(IGAM)**2)/(1-ZZ(IGAM)))/((1+(1-Z(IGAM))**2)/Z(IGAM))
20044 & *((1+ZZ(JGAM)**2)/(1-ZZ(JGAM)))/((1+(1-Z(JGAM))**2)/Z(JGAM))
20045 IF (HWRLOG(1-PROB)) GOTO 20
20046 C-------RECONSTRUCT ALL OTHER VARIABLES
20051 PHEP(4,IGAM)=ZZ(I)*PHEP(4,I)
20052 PHEP(5,IGAM)=RMASS(IDHW(IGAM))
20053 C---------IF MOMENTUM CANNOT BE CONSERVED TRY AGAIN
20054 IF (PHEP(4,IGAM)**2-PHEP(5,IGAM)**2-QT(I)**2 .LT. 0) GOTO 20
20055 PHEP(3,IGAM)=SIGN(SQRT(PHEP(4,IGAM)**2-PHEP(5,IGAM)**2-
20056 & QT(I)**2),PHEP(3,IGAM))
20057 CALL HWVDIF(4,PHEP(1,I),PHEP(1,IGAM),PHEP(1,IGAM-1))
20058 CALL HWUMAS(PHEP(1,IGAM-1))
20060 C-----TIDY UP EVENT RECORD
20063 IDHEP(NHEP)=IDHEP(3)
20065 CALL HWVSUM(4,PHEP(1,4),PHEP(1,6),PHEP(1,NHEP))
20066 CALL HWVSUM(4,PHEP(1,1),PHEP(1,2),PHEP(1,3))
20067 CALL HWUMAS(PHEP(1,NHEP))
20068 CALL HWUMAS(PHEP(1,3))
20073 C-----CHOOSE FINAL STATE QUARK
20074 IF (IHPRO.EQ.0) THEN
20075 RWGT=HWRGEN(2)*EVWGT
20078 IF (RWGT.GT.WGT(IDL)) ID=IDL+1
20084 C-----CHOOSE T (WHERE T = MANDELSTAM_T - EMSQ)
20086 TMAX=-SHAT/2*(1-BETA*CTMAX)
20089 IF (IHPRO.LE.9) THEN
20090 C-------FOR FFBAR, CHOOSE T ACCORDING TO -SHAT/T
20092 IF (NTRY.GT.NBTRY) THEN
20093 CALL HWWARN('HWHEGG',101)
20096 T=TRAT**HWRGEN(3)*TMIN
20098 C-------REWEIGHT TO CORRECT DISTRIBUTION
20099 DSDT=(T*U-2*EMSQ*(T+2*EMSQ))/T**2
20100 & +( 2*EMSQ*(SHAT-4*EMSQ))/(T*U)
20101 & +(T*U-2*EMSQ*(U+2*EMSQ))/U**2
20102 PROB=-DSDT*T/SHAT / (1 + 2*X - 2*X**2)
20103 IF (HWRLOG(1-PROB)) GOTO 60
20105 C-------FOR WW, CHOOSE T ACCORDING TO (SHAT/T)**2
20107 IF (NTRY.GT.NBTRY) THEN
20108 CALL HWWARN('HWHEGG',102)
20111 T=TMAX/(1-(1-TRAT)*HWRGEN(4))
20113 C-------REWEIGHT TO CORRECT DISTRIBUTION
20114 DSDT=( 3*(T*U)**2 - SHAT*T*U*(4*SHAT+6*EMSQ)
20115 & + SHAT**2*(2*SHAT**2+6*EMSQ**2) ) / (T*U)**2
20116 PROB=DSDT*(T/SHAT)**2 / (4.75 - 1.5*X + 1.5*X**2)
20117 IF (HWRLOG(1-PROB)) GOTO 70
20119 C-----SYMMETRIZE IN T,U
20120 IF (HWRLOG(HALF)) T=U
20121 C-----FILL EVENT RECORD
20122 COSTH=(1+2*T/SHAT)/BETA
20123 PC=0.5*BETA*PHEP(5,NHEP)
20124 PHEP(5,NHEP+1)=RMASS(ID)
20125 PHEP(5,NHEP+2)=RMASS(ID)
20126 CALL HWDTWO(PHEP(1,NHEP),PHEP(1,NHEP+1),PHEP(1,NHEP+2),
20132 IF (IHPRO.LE.6) ISTHEP(IHEP)=112+I
20133 IDHW(IHEP)=ID+NADD*(I-1)
20134 IDHEP(IHEP)=IDPDG(IDHW(IHEP))
20135 JDAHEP(I,NHEP)=IHEP
20136 JMOHEP(1,IHEP)=NHEP
20137 JMOHEP(2,IHEP)=JHEP
20138 JDAHEP(2,IHEP)=JHEP
20139 IF (IHPRO.EQ.10) THEN
20140 RHOHEP(1,IHEP)=0.3333
20141 RHOHEP(2,IHEP)=0.3333
20142 RHOHEP(3,IHEP)=0.3333
20150 *CMZ :- -26/04/91 10.18.56 by Bryan Webber
20151 *-- Author : Mike Seymour
20152 C-----------------------------------------------------------------------
20154 C----------------------------------------------------------------------
20155 C W + GAMMA --> FF'BAR : MEAN EVWGT = CROSS SECTION IN NANOBARN
20156 C BASED ON BOSON GLUON FUSION OF ABBIENDI AND STANCO
20157 C-----------------------------------------------------------------------
20158 INCLUDE 'herwig65.inc'
20159 DOUBLE PRECISION HWRGEN,GMASS,EV(3),RV,Y,Q2,SHAT,Z,PHI,AJACOB,
20160 & DSIGMA,ME,MP,ML,MREMIF(18),MFIN1(18),MFIN2(18),RS,SMA,W2,RSHAT
20162 INTEGER LEPFIN,ID1,ID2,I,IQK,IFLAVU,IFLAVD,IMIN,IMAX,IFL,IPROO
20163 LOGICAL CHARGD,INCLUD(18),INSIDE(18),IFGO
20165 SAVE LEPFIN,ID1,ID2
20166 COMMON /HWAREA/ Y,Q2,SHAT,Z,PHI,AJACOB,DSIGMA,ME,MP,ML,MREMIF,
20167 & MFIN1,MFIN2,RS,SMA,W2,RSHAT,IQK,IFLAVU,IFLAVD,IMIN,IMAX,IFL,LEP,
20168 & IPROO,CHARGD,INCLUD,INSIDE
20180 1 IDHEP(I)=IDPDG(IDHW(I))
20216 C---COMPUTATION OF MOMENTA IN LABORATORY FRAME OF REFERENCE
20217 C---Persuade HWHBKI that the gluon is actually a photon...
20222 C---put the other outgoing lepton in as well
20224 IDHEP(10)=IDPDG(IDHW(10))
20232 CALL HWVDIF(4,PHEP(1,2),PHEP(1,5),PHEP(1,10))
20233 CALL HWUMAS(PHEP(1,10))
20236 C---if antilepton was first, do charge conjugation
20237 IF (LEP.EQ.-1) THEN
20239 IF (IDHEP(I).NE.0 .AND. ABS(IDHEP(I)).LT.20) THEN
20240 IDHW(I)=IDHW(I) + 6*SIGN(1,IDHEP(I))
20246 C---half the time, do charge conjugation and parity flip
20247 IF (HWRGEN(0).GT.HALF) THEN
20249 IF (IDHEP(I).NE.0 .AND. ABS(IDHEP(I)).LT.20) THEN
20250 IDHW(I)=IDHW(I) + 6*SIGN(1,IDHEP(I))
20253 PHEP(1,I)=-PHEP(1,I)
20254 PHEP(2,I)=-PHEP(2,I)
20255 PHEP(3,I)=-PHEP(3,I)
20257 JMOHEP(1,10)=3-JMOHEP(1,10)
20263 C---LEP = 1 IF TRACK 1 IS A LEPTON, -1 FOR ANTILEPTON
20265 IF (IDHW(1).GE.121.AND.IDHW(1).LE.126) THEN
20267 ELSEIF (IDHW(1).GE.127.AND.IDHW(1).LE.132) THEN
20270 IF (LEP.EQ.0) CALL HWWARN('HWHEGW',500)
20271 C---program only works if beam and target are charge conjugates
20272 IF (LEP*(IDHW(2)-IDHW(1)).NE.6) CALL HWWARN('HWHEGW',501)
20273 C---program only works for equal energy beams colliding
20274 IF (PHEP(3,3).NE.ZERO) CALL HWWARN('HWHEGW',503)
20276 C---FINAL STATE IS ALWAYS SET UP AS IF PARTICLE IS BEFORE ANTI-PARTICLE
20277 C AND THEN INVERTED IF NECESSARY
20278 LEPFIN = MIN(IDHW(1),IDHW(2))+1
20284 ELSEIF (IQK.LE.4) THEN
20289 ELSEIF (IQK.LE.6) THEN
20294 ELSEIF (IQK.EQ.7) THEN
20299 C---INTERFERENCE TERMS IN EE -> EE NUE NUEB NEGLECTED: SIGMA UNRELIABLE
20300 IF (FSTWGT) CALL HWWARN('HWHEGW',1)
20301 ELSEIF (IQK.EQ.8) THEN
20306 ELSEIF (IQK.EQ.9) THEN
20312 CALL HWWARN('HWHEGW',504)
20315 IF (IQK.LE.6) IQK=0
20319 EVWGT = 2 * DSIGMA * AJACOB
20320 IF (EVWGT.LT.ZERO) EVWGT=ZERO
20322 C---SUM OVER QUARK FLAVOURS
20326 IF (SHAT.GT.(RMASS(IFLAVD)+RMASS(IFLAVU))**2) THEN
20328 EV(I) = 2 * DSIGMA * AJACOB
20329 IF (EV(I).LT.ZERO) EV(I)=ZERO
20338 C---CHOOSE QUARK FLAVOUR
20340 IF (RV.LT.EV(1)) THEN
20343 ELSEIF (RV.LT.EV(2)) THEN
20355 *CMZ :- -17/07/92 16.42.56 by Mike Seymour
20356 *-- Author : Mike Seymour
20357 C-----------------------------------------------------------------------
20359 C-----------------------------------------------------------------------
20360 C COMPUTES DIFFERENTIAL CROSS SECTION DSIGMA IN (Y,Q2,ETA,Z,PHI)
20361 C-----------------------------------------------------------------------
20362 INCLUDE 'herwig65.inc'
20363 DOUBLE PRECISION TMAX,TMIN,A1,A2,B1,B2,I0,I1,I2,I3,I4,I5,MUSQ,
20364 & MDSQ,ETA,Q1,COSTHE,S,G,T,U,C1,C2,D1,D2,F1,F2,COSBET,WPROP,D(4,4),
20365 & C(4,4),QU,QD,QE,QW,PHOTON,EMWSQ,EMSSQ,CFAC,Y,Q2,SHAT,Z,PHI,
20366 & AJACOB,DSIGMA,ME,MP,ML,MREMIF(18),MFIN1(18),MFIN2(18),RS,SMA,W2,
20368 INTEGER IQK,IFLAVU,IFLAVD,IMIN,IMAX,IFL,IPROO,I,J,LEP
20369 LOGICAL CHARGD,INCLUD(18),INSIDE(18)
20370 COMMON /HWAREA/ Y,Q2,SHAT,Z,PHI,AJACOB,DSIGMA,ME,MP,ML,MREMIF,
20371 & MFIN1,MFIN2,RS,SMA,W2,RSHAT,IQK,IFLAVU,IFLAVD,IMIN,IMAX,IFL,LEP,
20372 & IPROO,CHARGD,INCLUD,INSIDE
20373 C---INPUT VARIABLES
20374 IF (IERROR.NE.0) RETURN
20376 IF (IFLAVU.LE.12) THEN
20377 QU=QFCH(MOD(IFLAVU-1,6)+1)
20378 QD=QFCH(MOD(IFLAVD-1,6)+1)
20381 QU=QFCH(MOD(IFLAVU-1,6)+11)
20382 QD=QFCH(MOD(IFLAVD-1,6)+11)
20387 EMWSQ=RMASS(198)**2
20390 MUSQ=RMASS(IFLAVU)**2
20391 MDSQ=RMASS(IFLAVD)**2
20392 ETA=(SHAT+Q2)/EMSSQ/Y
20393 IF (ETA.GT.ONE) RETURN
20394 C---CALCULATE KINEMATIC TERMS
20395 G=0.5*(ETA*EMSSQ*Y-Q2) -0.5*(MUSQ+MDSQ)
20397 T=0.5*ETA*EMSSQ*(1-Y)
20399 C1=0.5*ETA*EMSSQ*Y*Z
20400 C2=0.5*ETA*EMSSQ*Y*(1-Z)
20401 COSBET=(-ETA*EMSSQ*Y+Q2*(2-Y))/(Y*(ETA*EMSSQ-Q2))
20402 IF (SHAT.LE.(RMASS(IFLAVU)+RMASS(IFLAVD))**2) RETURN
20403 Q1=SQRT((SHAT**2+MUSQ**2+MDSQ**2
20404 & -2*SHAT*MUSQ-2*SHAT*MDSQ-2*MUSQ*MDSQ)/SHAT**2)
20405 COSTHE=(1+(MDSQ-MUSQ)/SHAT-2*Z)/Q1
20406 IF (ABS(COSTHE).GE.ONE .OR. ABS(COSBET).GE.ONE) RETURN
20407 D1=0.25*(ETA*EMSSQ-Q2)*(1+(MDSQ-MUSQ)/SHAT-Q1*
20408 & (COSTHE*COSBET+SQRT((1-COSTHE**2)*(1-COSBET**2))*COS(PHI)))
20412 C---CALCULATE TRACE TERMS
20417 D(3,3)=-D1*(2*F2*G-D2*(F1+2*U))
20418 & -D2*F1*(F2+U-D2+F1)
20420 & -G*(-2*D1*(F1+F2+U)-F1*(D2+2*U)+2*D2*(U-F2)+2*U*(F2-U+G))
20422 D(1,2)=(D1+U-F2)*(D1*F2-F1*D2)-G*(D1*(F2+U)+U*(U-F2-G)+F1*D2)
20423 D(1,3)=D1*F2*(-2*F1+U-F2+D1)
20424 & +F1*(F2*(D2-2*U)+F1*D2)
20425 & +G*(-D1*(2*F1+F2+U)-F1*(D2+2*U)+U*(F2-U+G))
20426 D(1,4)=-2*F1*(D1+U)*(F2+G)
20427 D(2,3)=D1*(D2*(F1+2*(U-F2))+F2*(F2-U-D1))
20429 & +G*(D1*(F2+U)+D2*(F1-2*(U-F2))+U*(U-F2-G))
20430 D(2,4)=-D1*F2*(U-F2+D1)
20431 & -F1*D2*(U-D1-G-F2)
20432 & -G*(U*(F2-U+G)-D1*(F2+U))
20433 D(3,4)=D1*(F1*(D2+2*F2)+F2*(F2-U-D1))
20434 & +F1*(2*F2*U-D2*(U+F1))
20435 & +G*(D1*(2*F1+F2+U)+U*(2*F1-F2+U-G))
20436 C---REGULATE PROPAGATORS
20439 A1=2*C1+MDSQ*(G+U)/G
20440 A2=2*C2+MUSQ*(G+U)/G
20441 B1=(2*U+MUSQ)/(2*G+2*U)
20442 B2=(2*U+MDSQ)/(2*G+2*U)
20444 I1=1/A1*(I0-LOG((A1+B1*TMAX)/(A1+B1*TMIN)))
20445 I2=1/A2*(I0-LOG((A2+B2*TMAX)/(A2+B2*TMIN)))
20446 I3=(B1*I1-B2*I2)/(B1*A2-B2*A1)
20447 I4=1/A1*(I1+1/(A1+B1*TMAX)-1/(A1+B1*TMIN))
20448 I5=1/A2*(I2+1/(A2+B2*TMAX)-1/(A2+B2*TMIN))
20449 WPROP=1/((2*G-EMWSQ)**2+GAMW**2*EMWSQ)
20450 C---CALCULATE COEFFICIENTS
20451 C(1,1)= QU**2/(2*U+EMWSQ)**2 *I5
20452 C(2,2)= QD**2/(2*U+EMWSQ)**2 *I4
20453 C(3,3)= QW**2/(2*U+EMWSQ)**2 *WPROP *I0
20454 C(4,4)= QE**2/(2*S)**2 *WPROP *I0
20455 C(1,2)= 2*QU*QD/(2*U+EMWSQ)**2 *I3
20456 C(1,3)= 2*QW*QU/(2*U+EMWSQ)**2 *WPROP*(2*G-EMWSQ) *I2
20457 C(1,4)= 2*QU*QE/(2*S*(2*U+EMWSQ)) *WPROP*(2*G-EMWSQ) *I2
20458 C(2,3)= 2*QW*QD/(2*U+EMWSQ)**2 *WPROP*(2*G-EMWSQ) *I1
20459 C(2,4)= 2*QD*QE/(2*S*(2*U+EMWSQ)) *WPROP*(2*G-EMWSQ) *I1
20460 C(3,4)= 2*QW*QE/(2*S*(2*U+EMWSQ)) *WPROP *I0
20461 C---CALCULATE PHOTON STRUCTURE FUNCTION
20462 PHOTON=ALPHEM * (1+(1-ETA)**2) / (2*PIFAC*ETA)
20463 C---SUM ALL TENSOR CONTRIBUTIONS
20466 10 DSIGMA=DSIGMA + C(I,J)*D(I,J)
20467 C---CALCULATE TOTAL SUMMED AND AVERAGED MATRIX ELEMENT SQUARED
20468 DSIGMA = DSIGMA * 2*CFAC*(4*PIFAC*ALPHEM)**3/SWEIN**2
20469 C---CALCULATE DIFFERENTIAL CROSS-SECTION
20470 DSIGMA = DSIGMA * GEV2NB*PHOTON/(512*PIFAC**4*ETA*EMSSQ)
20473 *CMZ :- -12/10/01 10.05.16 by Peter Richardson
20474 *-- Author : Bryan Webber and Ian Knowles
20475 C-----------------------------------------------------------------------
20477 C-----------------------------------------------------------------------
20478 C (Initially polarised) e+e- --> ffbar (f=quark, mu or tau)
20479 C If IPROC=107: --> gg, distributed as sum of light quarks.
20480 C If fermion flavour specified mass effects fully included.
20481 C EVWGT=sig(e+e- --> ffbar) in nb
20482 C-----------------------------------------------------------------------
20483 INCLUDE 'herwig65.inc'
20484 DOUBLE PRECISION HWRGEN,HWRUNI,HWUPCM,HWUAEM,Q2NOW,Q2LST,FACTR,
20485 & VF2,VF,CLF(7),PRAN,PQWT,PMAX,PTHETA,SINTH2,CPHI,SPHI,C2PHI,S2PHI,
20486 & PPHI,SINTH,PCM,PP(5),EWGT
20487 INTEGER ID1,ID2,IDF,IQ,IQ1,I
20488 EXTERNAL HWRGEN,HWRUNI,HWUPCM,HWUAEM
20489 SAVE Q2LST,FACTR,ID1,ID2,VF2,VF,CLF,EWGT
20493 C Choose quark flavour
20494 PRAN=TQWT*HWRGEN(0)
20497 PQWT=PQWT+CLQ(1,IQ)
20498 IF (PQWT.GT.PRAN) GOTO 11
20503 20 CLF(I)=CLQ(I,IQ)
20507 C Label particles, assign outgoing particle masses
20516 PHEP(5,NHEP+2)=RMASS(13)
20517 PHEP(5,NHEP+3)=RMASS(13)
20521 IDHEP(NHEP+2)=IDPDG(IQ1)
20522 IDHEP(NHEP+3)=-IDHEP(NHEP+2)
20523 PHEP(5,NHEP+2)=RMASS(IQ1)
20524 PHEP(5,NHEP+3)=RMASS(IQ1)
20529 IF (JDAHEP(1,1).NE.0) JMOHEP(1,NHEP+1)=JDAHEP(1,1)
20531 IF (JDAHEP(1,2).NE.0) JMOHEP(2,NHEP+1)=JDAHEP(1,2)
20532 JMOHEP(1,NHEP+2)=NHEP+1
20533 JMOHEP(2,NHEP+2)=NHEP+3
20534 JMOHEP(1,NHEP+3)=NHEP+1
20535 JMOHEP(2,NHEP+3)=NHEP+2
20536 JDAHEP(1,NHEP+1)=NHEP+2
20537 JDAHEP(2,NHEP+1)=NHEP+3
20539 JDAHEP(2,NHEP+2)=NHEP+3
20541 JDAHEP(2,NHEP+3)=NHEP+2
20542 C Generate polar and azimuthal angular distributions:
20543 C CLF(1)*(1+(VF*COSTH)**2)+CLF(2)*(1-VF**2)+CLF(3)*2.*VF*COSTH
20544 C +(VF*SINTH)**2*(CLF(4)*COS(2*PHI-PHI1-PHI2)
20545 C +CLF(6)*SIN(2*PHI-PHI1-PHI2))
20546 PMAX=CLF(1)*(1.+VF2)+CLF(2)*(1.-VF2)+ABS(CLF(3))*2.*VF
20547 30 COSTH=HWRUNI(0,-ONE, ONE)
20548 PTHETA=CLF(1)*(1.+VF2*COSTH**2)+CLF(2)*(1.-VF2)
20549 & +CLF(3)*2.*VF*COSTH
20550 IF (PTHETA.LT.PMAX*HWRGEN(1)) GOTO 30
20551 IF (IDHW(1).GT.IDHW(2)) COSTH=-COSTH
20554 PMAX=PTHETA+VF2*SINTH2*SQRT(CLF(4)**2+CLF(6)**2)
20555 40 CALL HWRAZM(ONE,CPHI,SPHI)
20556 C2PHI=2.*CPHI**2-1.
20558 PPHI=PTHETA+(CLF(4)*(C2PHI*COSS+S2PHI*SINS)
20559 & +CLF(6)*(S2PHI*COSS-C2PHI*SINS))*VF2*SINTH2
20560 IF (PPHI.LT.PMAX*HWRGEN(1)) GOTO 40
20562 CALL HWRAZM(ONE,CPHI,SPHI)
20564 C Construct final state 4-mommenta
20565 CALL HWVEQU(5,PHEP(1,3),PHEP(1,NHEP+1))
20566 PCM=HWUPCM(PHEP(5,NHEP+1),PHEP(5,NHEP+2),PHEP(5,NHEP+3))
20567 C PP is momentum of track NHEP+2 in CoM (track NHEP+1) frame
20569 PP(5)=PHEP(5,NHEP+2)
20570 PP(1)=PCM*SINTH*CPHI
20571 PP(2)=PCM*SINTH*SPHI
20573 PP(4)=SQRT(PCM**2+PP(5)**2)
20574 CALL HWULOB(PHEP(1,NHEP+1),PP(1),PHEP(1,NHEP+2))
20575 CALL HWVDIF(4,PHEP(1,NHEP+1),PHEP(1,NHEP+2),PHEP(1,NHEP+3))
20576 C Set production vertices
20577 CALL HWVZRO(4,VHEP(1,NHEP+2))
20578 CALL HWVEQU(4,VHEP(1,NHEP+2),VHEP(1,NHEP+3))
20583 IF (Q2NOW.NE.Q2LST) THEN
20584 C Calculate coefficients for cross-section
20587 FACTR=PIFAC*GEV2NB*HWUAEM(Q2NOW)**2/Q2NOW
20594 EWGT=FACTR*FLOAT(NCOLO)*TQWT*4./3.
20596 IF (IPROC.LT.150) THEN
20598 FACTR=FACTR*FLOAT(NCOLO)
20603 IF (EMSCA.LE.2.*RMASS(ID1)) THEN
20606 CALL HWUCFF(11,IDF,Q2NOW,CLF(1))
20607 VF2=1.-4.*RMASS(ID1)**2/Q2NOW
20609 EWGT=FACTR*VF*(CLF(1)*(1.+VF2/3.)+CLF(2)*(1.-VF2))
20617 *CMZ :- -02/05/91 10.57.27 by Federico Carminati
20618 *-- Author : Bryan Webber and Ian Knowles
20619 C-----------------------------------------------------------------------
20621 C-----------------------------------------------------------------------
20622 C (Initially polarised) e-e+ --> qqbar g with parton thrust < THMAX,
20623 C equivalent to: maximum parton energy < THMAX*EMSCA/2; or a JADE E0
20624 c scheme, y_cut=1.-THMAX.
20625 C If flavour specified mass effects fully included.
20626 C EVWGT=sig(e^-e^+ --> qqbar g) in nb
20627 C-----------------------------------------------------------------------
20628 INCLUDE 'herwig65.inc'
20629 DOUBLE PRECISION HWRGEN,HWUALF,HWUAEM,HWULDO,HWDPWT,Q2NOW,Q2LST,
20630 & PHASP,QGMAX,QGMIN,FACTR,QM2,CLF(7),ORDER,PRAN,PQWT,QQG,QBG,SUM,
20631 & RUT,QQLM,QQLP,QBLM,QBLP,DYN1,DYN2,DYN3,DYN4,DYN5,DYN6,XQ2,X2SUM,
20633 INTEGER ID1,IQ,I,LM,LP,IQ1
20635 EXTERNAL HWRGEN,HWUALF,HWUAEM,HWULDO,HWDPWT
20636 SAVE Q2NOW,Q2LST,QGMAX,QGMIN,FACTR,ORDER,ID1,MASS,QM2,CLF,LM,LP,
20640 C Label produced partons and calculate gluon spin
20653 JMOHEP(1,NHEP+1)=LM
20654 JMOHEP(2,NHEP+1)=LP
20655 JMOHEP(1,NHEP+2)=NHEP+1
20656 JMOHEP(2,NHEP+2)=NHEP+3
20657 JMOHEP(1,NHEP+3)=NHEP+1
20658 JMOHEP(2,NHEP+3)=NHEP+4
20659 JMOHEP(1,NHEP+4)=NHEP+1
20660 JMOHEP(2,NHEP+4)=NHEP+2
20661 JDAHEP(1,NHEP+1)=NHEP+2
20662 JDAHEP(2,NHEP+1)=NHEP+4
20664 JDAHEP(2,NHEP+2)=NHEP+4
20666 JDAHEP(2,NHEP+3)=NHEP+2
20668 JDAHEP(2,NHEP+4)=NHEP+3
20669 C Decide which quark radiated and assign production vertices
20670 XQ2=(Q2NOW-2.*QBG)**2
20671 X2SUM=XQ2+(Q2NOW-2.*QQG)**2
20672 IF (XQ2.LT.HWRGEN(0)*X2SUM) THEN
20673 C Quark radiated the gluon
20674 CALL HWVZRO(4,VHEP(1,NHEP+4))
20675 CALL HWVSUM(4,PHEP(1,NHEP+2),PHEP(1,NHEP+3),PVRT)
20676 CALL HWUDKL(IQ1,PVRT,VHEP(1,NHEP+3))
20677 CALL HWVEQU(4,VHEP(1,NHEP+3),VHEP(1,NHEP+2))
20679 C Anti-quark radiated the gluon
20680 CALL HWVZRO(4,VHEP(1,NHEP+2))
20681 CALL HWVSUM(4,PHEP(1,NHEP+4),PHEP(1,NHEP+3),PVRT)
20682 CALL HWUDKL(IQ1,PVRT,VHEP(1,NHEP+3))
20683 CALL HWVEQU(4,VHEP(1,NHEP+3),VHEP(1,NHEP+4))
20686 C Calculate the transverse polarisation of the gluon
20687 C Correlation with leptons presently neglected
20688 GPOLN=(QQG**2+QBG**2)/((Q2NOW-2.*SUM)*Q2NOW)
20689 GPOLN=2./(2.+GPOLN)
20695 IF (Q2NOW.NE.Q2LST) THEN
20698 IF (PHASP.LE.ZERO) CALL HWWARN('HWHEPG',400)
20699 QGMAX=.5*Q2NOW*THMAX
20700 QGMIN=.5*Q2NOW*(1.-THMAX)
20701 FACTR=GEV2NB*FLOAT(NCOLO)*CFFAC*HWUALF(1,EMSCA)
20702 & *.5*(HWUAEM(Q2NOW)*PHASP)**2/Q2NOW
20704 IF (JDAHEP(1,LM).NE.0) LM=JDAHEP(1,LM)
20706 IF (JDAHEP(1,LP).NE.0) LP=JDAHEP(1,LP)
20708 IF (IDHW(1).GT.IDHW(2)) ORDER=-ORDER
20713 CALL HWUCFF(11,ID1,Q2NOW,CLF(1))
20722 C Select quark flavour
20723 PRAN=TQWT*HWRGEN(1)
20726 PQWT=PQWT+CLQ(1,IQ)
20727 IF (PQWT.GT.PRAN) GOTO 11
20732 20 CLF(I)=CLQ(I,IQ)
20733 ELSEIF (Q2NOW.GT.4*QM2/(2*THMAX-1)) THEN
20739 C Select final state momentum configuration
20740 CALL HWVEQU(5,PHEP(1,3),PHEP(1,NHEP+1))
20741 PHEP(5,NHEP+2)=RMASS(IQ1)
20742 PHEP(5,NHEP+3)=RMASS(13)
20743 PHEP(5,NHEP+4)=RMASS(IQ1)
20744 30 CALL HWDTHR(PHEP(1,NHEP+1),PHEP(1,NHEP+2),
20745 & PHEP(1,NHEP+3),PHEP(1,NHEP+4),HWDPWT)
20746 QQG=HWULDO(PHEP(1,NHEP+2),PHEP(1,NHEP+3))
20747 IF (QQG.LT.QGMIN) GOTO 30
20748 QBG=HWULDO(PHEP(1,NHEP+4),PHEP(1,NHEP+3))
20750 IF (QBG.LT.QGMIN.OR.SUM.GT.QGMAX) GOTO 30
20751 QQLM=HWULDO(PHEP(1,NHEP+2),PHEP(1,LM))
20752 QQLP=HWULDO(PHEP(1,NHEP+2),PHEP(1,LP))
20753 QBLM=HWULDO(PHEP(1,NHEP+4),PHEP(1,LM))
20754 QBLP=HWULDO(PHEP(1,NHEP+4),PHEP(1,LP))
20755 DYN1=QQLM**2+QQLP**2+QBLM**2+QBLP**2
20757 DYN3=DYN1-2.*(QQLM**2+QBLP**2)
20760 DYN1=DYN1+8.*QM2*(1.-.25*Q2NOW*RUT
20761 & +QQLM*QQLP/(Q2NOW*QBG)+QBLM*QBLP/(Q2NOW*QQG))
20762 DYN2=QM2*(Q2NOW-SUM*(2.+QM2*RUT)
20763 & -4.*HWULDO(PHEP(1,NHEP+3),PHEP(1,LM))
20764 & *HWULDO(PHEP(1,NHEP+3),PHEP(1,LP))/Q2NOW)
20765 DYN3=DYN3+QM2*2.*RUT*(QBG*(QBLP-QBLM)-QQG*(QQLP-QQLM))
20767 EVWGT=CLF(1)*DYN1+CLF(2)*DYN2+ORDER*CLF(3)*DYN3
20769 C Include event plane azimuthal angle
20774 DYN4=DYN4-QM2*SUM/QBG
20775 DYN5=DYN5-QM2*SUM/QQG
20779 & +(CLF(4)*COSS-CLF(6)*SINS)
20780 & *(DYN4*(PHEP(1,NHEP+2)**2-PHEP(2,NHEP+2)**2)
20781 & +DYN5*(PHEP(1,NHEP+4)**2-PHEP(2,NHEP+4)**2))
20782 & +(CLF(4)*SINS+CLF(6)*COSS)*2.
20783 & *(DYN4*PHEP(1,NHEP+2)*PHEP(2,NHEP+2)
20784 & +DYN5*PHEP(1,NHEP+4)*PHEP(2,NHEP+4))
20785 & +(CLF(5)*COSS-CLF(7)*SINS)*DYN6
20786 & *(PHEP(1,NHEP+3)**2-PHEP(2,NHEP+3)**2)
20787 & +(CLF(5)*SINS+CLF(7)*COSS)*DYN6*2.
20788 & *PHEP(1,NHEP+3)*PHEP(2,NHEP+3)
20790 C Assign event weight
20791 EVWGT=EVWGT*FACTR/(QQG*QBG*CLF(1))
20795 *CMZ :- -17/10/00 17:43:25 by Peter Richardson
20796 *-- Author : Kosuke Odagiri & Peter Richardson
20797 C-----------------------------------------------------------------------
20799 C-----------------------------------------------------------------------
20800 C SUSY E+E- -> 2 SLEPTON PROCESSES
20801 C-----------------------------------------------------------------------
20802 INCLUDE 'herwig65.inc'
20803 DOUBLE PRECISION HWRGEN,HWUAEM,EPS,HCS,RCS,S,PF,QPE,HWUPCM,PCM,
20804 & FACTR,SN2TH,MZ,ME2(2,2,6),EMSC2,HWUMBW,HWRUNI,T,SQPE
20805 INTEGER ID1,ID2,IL,IL1,IL2,I,J,IG,IG1,IHEP,NTRY,IDL,ILP,IDLR(2),
20808 PARAMETER (SSNU = 449, SSCH = 453)
20809 EXTERNAL HWRGEN, HWUAEM,HWUMBW,HWUPCM,HWRUNI
20810 SAVE HCS,ME2,IDLR,IDSLP
20811 PARAMETER (EPS = 1.D-9)
20812 DOUBLE COMPLEX Z, GZ, A, BL, BR, CL, CR, D, E
20813 DOUBLE PRECISION F,FACT0
20814 PARAMETER (Z = (0.D0,1.D0))
20815 EQUIVALENCE (MZ, RMASS(200))
20819 EMSCA = SQRT(EMSC2)
20821 IL = MOD((IPROC-740),5)
20822 IF(IPROC.EQ.700.OR.IPROC.EQ.740) THEN
20831 IDSLP(1) = 2*(IPROC-740)/5
20832 ELSEIF(IL.EQ.1) THEN
20835 IDSLP(1) = 2*(IPROC-741)/5+1
20836 ELSEIF(IL.EQ.2) THEN
20839 IDSLP(1) = 2*(IPROC-742)/5+1
20840 ELSEIF(IL.EQ.3) THEN
20843 IDSLP(1) = 2*(IPROC-743)/5+1
20844 ELSEIF(IL.EQ.4) THEN
20847 IDSLP(1) = 2*(IPROC-744)/5+1
20849 IDSLP(2) = IDSLP(1)
20853 RCS = HCS*HWRGEN(0)
20855 IDL = ABS(IDHEP(1))
20857 COSTH = HWRUNI(1,-ONE,ONE)
20858 SN2TH = 0.25D0 - 0.25D0*COSTH**2
20859 FACT0 = GEV2NB*PIFAC*HWUAEM(EMSC2)**2/S
20860 FACTR = FACT0*SN2TH
20861 GZ = (S-MZ**2+Z*S*GAMZ/MZ)/S
20872 DO IL = IDSLP(1),IDSLP(2)
20875 IF ((I.EQ.2.OR.J.EQ.2).AND.(((IL/2)*2).EQ.IL).OR.
20876 & (IDLR(1).NE.0.AND.(IDLR(1).NE.I.OR.IDLR(2).NE.J)
20877 & .AND.(IDLR(1).NE.J.OR.IDLR(2).NE.I))) THEN
20880 ID1 = 412 + I*12 + IL
20881 ID2 = 412 + J*12 + IL
20883 QPE = S-(RMASS(ID1)+RMASS(ID2))**2
20885 IF (QPE.GT.ZERO) THEN
20886 SQPE = SQRT(QPE*(S-(RMASS(ID1)-RMASS(ID2))**2))
20888 IF ((IL.NE.ILP).OR.(I.EQ.J)) THEN
20889 A = QFCH(IL1)*QFCH(IDL)
20892 CL = LMIXSS(IL,1,I)*LMIXSS(IL,1,J)
20893 CR = LMIXSS(IL,2,I)*LMIXSS(IL,2,J)
20894 D = (A+BL*LFCH(IDL))*CL+(A+BR*LFCH(IDL))*CR
20895 E = (A+BL*RFCH(IDL))*CL+(A+BR*RFCH(IDL))*CR
20896 IF (IL.EQ.ILP+1.OR.IL.EQ.ILP) THEN
20898 T = HALF*(SQPE*COSTH-S+RMASS(ID1)**2+RMASS(ID2)**2)
20899 IF (IL.EQ.ILP) THEN
20904 F = F + SLFCH(IL1,IG)**2/(T-RMASS(IG1)**2)
20910 F = F +SRFCH(IL1,IG)**2/(T-RMASS(IG1)**2)
20919 F = F + WMXVSS(IG,1)**2/(T-RMASS(IG1)**2)
20921 D = D + F*S/(TWO*SWEIN)
20924 ME2(I,J,IL)=FACTR*PF**3*DREAL(
20925 & (ONE-EPOLN(3))*(ONE+PPOLN(3))*DCONJG(D)*D
20926 & +(ONE+EPOLN(3))*(ONE-PPOLN(3))*DCONJG(E)*E)
20929 T = HALF*(SQPE*COSTH-S+RMASS(ID1)**2+RMASS(ID2)**2)
20932 F = F + SLFCH(IL1,IG)*SRFCH(IL1,IG)*
20933 & ZSGNSS(IG)*RMASS(IG1)/(T-RMASS(IG1)**2)
20935 C--production of el- er+
20936 IF(I.EQ.1.AND.J.EQ.2) THEN
20937 ME2(I,J,IL)=FACT0*PF*F**2*S*
20938 & (ONE-EPOLN(3))*(ONE-PPOLN(3))
20940 C--production of er- el+
20941 ME2(I,J,IL)=FACT0*PF*F**2*S*
20942 & (ONE+EPOLN(3))*(ONE+PPOLN(3))
20959 HCS = HCS + ME2(I,J,IL)
20960 IF (GENEV.AND.HCS.GT.RCS) GOTO 100
20966 C--change sign of COSTH if antiparticle first
20967 IF(IDHEP(1).LT.IDHEP(2)) COSTH = -COSTH
20970 ISTHEP(NHEP+1) = 110
20973 IDHEP(NHEP+2) = IDPDG(IL1)
20974 IDHEP(NHEP+3) = IDPDG(IL2)
20975 C--select the particle masses and momenta
20978 PHEP(5,NHEP+2) = HWUMBW(IL1)
20979 PHEP(5,NHEP+3) = HWUMBW(IL2)
20980 CALL HWVEQU(5,PHEP(1,3),PHEP(1,NHEP+1))
20981 PCM = HWUPCM(PHEP(5,NHEP+1),PHEP(5,NHEP+2),PHEP(5,NHEP+3))
20982 IF(PCM.LT.ZERO.AND.NTRY.LE.NETRY) THEN
20984 ELSEIF(PCM.LT.ZERO) THEN
20985 CALL HWWARN('HWHESL',100)
20988 C--Set up the colours etc
20989 ISTHEP(NHEP+2) = 113
20990 ISTHEP(NHEP+3) = 114
20991 JMOHEP(1,NHEP+1) = 1
20992 IF (JDAHEP(1,1).NE.0) JMOHEP(1,NHEP+1)=JDAHEP(1,1)
20993 JMOHEP(2,NHEP+1) = 2
20994 IF (JDAHEP(1,2).NE.0) JMOHEP(2,NHEP+1)=JDAHEP(1,2)
20995 JMOHEP(1,NHEP+2) = NHEP+1
20996 JMOHEP(2,NHEP+2) = NHEP+2
20997 JMOHEP(1,NHEP+3) = NHEP+1
20998 JMOHEP(2,NHEP+3) = NHEP+3
20999 JDAHEP(1,NHEP+1) = NHEP+2
21000 JDAHEP(2,NHEP+1) = NHEP+3
21001 JDAHEP(1,NHEP+2) = 0
21002 JDAHEP(2,NHEP+2) = NHEP+2
21003 JDAHEP(1,NHEP+3) = 0
21004 JDAHEP(2,NHEP+3) = NHEP+3
21005 C--Set up the momenta
21008 PHEP(4,IHEP) = SQRT(PCM**2+PHEP(5,IHEP)**2)
21009 PHEP(3,IHEP) = PCM*COSTH
21010 PHEP(1,IHEP) = SQRT((PCM+PHEP(3,IHEP))*(PCM-PHEP(3,IHEP)))
21011 PHEP(2,IHEP) = ZERO
21012 CALL HWRAZM(PHEP(1,IHEP),PHEP(1,IHEP),PHEP(2,IHEP))
21013 CALL HWULOB(PHEP(1,NHEP+1),PHEP(1,IHEP),PHEP(1,IHEP))
21014 CALL HWVDIF(4,PHEP(1,NHEP+1),PHEP(1,IHEP),PHEP(1,IHEP+1))
21022 *CMZ :- -18/10/00 13:46:47 by Peter Richardson
21023 *-- Author : Kosuke Odagiri & Peter Richardson
21024 C-----------------------------------------------------------------------
21026 C-----------------------------------------------------------------------
21027 C SUSY E+E- -> 2 GAUGINO PROCESSES
21028 C-----------------------------------------------------------------------
21029 INCLUDE 'herwig65.inc'
21030 DOUBLE PRECISION HWRGEN,HWUAEM,HCS,RCS,MNU(4),MNU2(4),HWRUNI,
21031 & FACA,M1(4,4),S2W,XC(4),XD(4),MSNU,
21032 & MZ,HWHSS2,U,T,QPE,SQPE,MSL,MSL2,MSR,MSR2,
21033 & SGN,S,SM,DM,PF,PCM,HWUPCM,XW,S22W,
21034 & MSNU2,MCH(2),MCH2(2),DAB,M2(2,2),HWUMBW
21035 INTEGER I,IQ1,IQ2,SSNU,NTID(2),CHID(2),IG1,IG2,IHEP,SSCH,ISL,ISR,
21038 SAVE HCS,M1,M2,NTID,ISL,ISR,ISN,IDL,CHID,NEUT,CHAR
21039 EXTERNAL HWRGEN,HWUAEM,HWRUNI,HWHSS2,HWUPCM,HWUMBW
21040 DOUBLE COMPLEX Z, Z0, Z1, C1, C2, C3,GZ, CLL, CLR, CRL, CRR
21041 PARAMETER (Z = (0.D0,1.D0), Z0 = (0.D0,0.D0), Z1 = (1.D0,0.D0))
21042 PARAMETER (SSNU=449,SSCH = 453)
21043 EQUIVALENCE (MZ, RMASS(200))
21044 EQUIVALENCE (XC(1), ZMIXSS(1,3)), (XC(2), ZMIXSS(2,3))
21045 EQUIVALENCE (XC(3), ZMIXSS(3,3)), (XC(4), ZMIXSS(4,3))
21046 EQUIVALENCE (XD(1), ZMIXSS(1,4)), (XD(2), ZMIXSS(2,4))
21047 EQUIVALENCE (XD(3), ZMIXSS(3,4)), (XD(4), ZMIXSS(4,4))
21048 C--Start of the code
21050 RCS = HCS*HWRGEN(0)
21052 C--Decide which processes to generate
21056 C--neutralino pair production
21057 IF(IPROC.GE.710.AND.IPROC.LE.726) THEN
21059 IF(IPROC.EQ.710) THEN
21063 NTID(1) = INT((IPROC-707)/4)
21064 NTID(2) = MOD((IPROC-711),4)+1
21066 C--chargino pair production
21067 ELSEIF(IPROC.GE.730.AND.IPROC.LE.734) THEN
21069 IF(IPROC.EQ.730) THEN
21073 CHID(1) = INT((IPROC-729)/2)
21074 CHID(2) = MOD((IPROC-731),2)+1
21076 ELSEIF(IPROC.NE.700) THEN
21077 CALL HWWARN('HWHESG',500)
21079 C--check the particles in the beam
21080 IF(ABS(IDHEP(1)).EQ.11) THEN
21085 ELSEIF(ABS(IDHEP(1)).EQ.13) THEN
21091 CALL HWWARN('HWHESG',501)
21096 MNU(I) = RMASS(SSNU+I)
21097 MNU2(I) = MNU(I)**2
21100 MCH(IG1) = RMASS(IG1+SSCH)
21101 MCH2(IG1) = MCH(IG1)**2
21103 COSTH = HWRUNI(1,-ONE,ONE)
21105 S22W = XW * (TWO - XW)
21109 FACA = HWUAEM(S)**2
21110 GZ = S-MZ**2+Z*S/MZ*GAMZ
21117 C--neutralino pair production
21128 SM = MNU(IQ1) + MNU(IQ2)
21130 IF(QPE.GE.ZERO.AND.
21131 & (NTID(1).EQ.0.OR.(IQ1.EQ.NTID(1).AND.IQ2.EQ.NTID(2))
21132 & .OR.(IQ1.EQ.NTID(2).AND.IQ2.EQ.NTID(1)))) THEN
21133 DM = MNU(IQ1) - MNU(IQ2)
21134 SQPE = SQRT(QPE*(S-DM**2))
21136 T = HALF*(SQPE*COSTH - S + MNU2(IQ1) + MNU2(IQ2))
21137 U = - T - S + MNU2(IQ1) + MNU2(IQ2)
21138 C1 = (XD(IQ1)*XD(IQ2)-XC(IQ1)*XC(IQ2))/S2W/GZ
21140 SGN = ZSGNSS(IQ1)*ZSGNSS(IQ2)
21141 CLL = LFCH(IDL)*C1+SLFCH(IDL,IQ1)*SLFCH(IDL,IQ2)/(U-MSL2)
21142 CLR = LFCH(IDL)*C2-SLFCH(IDL,IQ1)*SLFCH(IDL,IQ2)/(T-MSL2)
21143 CRL = RFCH(IDL)*C1-SRFCH(IDL,IQ1)*SRFCH(IDL,IQ2)/(T-MSR2)
21144 CRR = RFCH(IDL)*C2+SRFCH(IDL,IQ1)*SRFCH(IDL,IQ2)/(U-MSR2)
21145 C--modified to include beam polarization PR 10/10/01
21146 M1(IQ1,IQ2) = FACA*PF*GEV2NB*PIFAC/S*HALF*
21147 & HWHSS2(S,T,U,MNU(IQ1),MNU(IQ2),SGN,CLL,CLR,CRL,CRR)
21153 C--chargino pair production
21154 100 IF(.NOT.CHAR) THEN
21164 SM = MCH(IG1) + MCH(IG2)
21166 IF (QPE.GE.ZERO.AND.
21167 & (CHID(1).EQ.0.OR.(CHID(1).EQ.IG1.AND.CHID(2).EQ.IG2)
21168 & .OR.(CHID(1).EQ.IG2.AND.CHID(2).EQ.IG1))) THEN
21169 DM = MCH(IG1) - MCH(IG2)
21170 SQPE = SQRT(QPE*(S-DM**2))
21172 T = HALF*(SQPE*COSTH - S + MCH2(IG1) + MCH2(IG2))
21173 U = - T - S + MCH2(IG1) + MCH2(IG2)
21174 DAB = ABS(FLOAT(IG1+IG2-3))
21175 C1 = (-WMXVSS(IG1,2)*WMXVSS(IG2,2)+DAB*S22W/XW)/S2W/GZ
21176 C2 = (-WMXUSS(IG1,2)*WMXUSS(IG2,2)+DAB*S22W/XW)/S2W/GZ
21177 SGN = WSGNSS(IG1)*WSGNSS(IG2)
21178 C3 = -DAB*QFCH(IDL)/S
21179 CLL = C3- LFCH(IDL)*C1
21180 & +WMXVSS(IG1,1)*WMXVSS(IG2,1)/((U-MSNU2)*XW)
21181 CLR = C3- LFCH(IDL)*C2
21182 CRL = C3- RFCH(IDL)*C1
21183 CRR = C3- RFCH(IDL)*C2
21184 C--modified to include beam polarization PR 10/10/01
21185 M2(IG1,IG2)=FACA*PF*GEV2NB*PIFAC/S*
21186 & HWHSS2(S,T,U,MCH(IG1),MCH(IG2),SGN,CLL,CLR,CRL,CRR)
21193 C--Add up the weights now
21195 IF(.NOT.NEUT) GOTO 250
21200 HCS = HCS+M1(IQ1,IQ2)
21201 IF(GENEV.AND.HCS.GT.RCS) GOTO 900
21204 250 IF(.NOT.CHAR) GOTO 900
21209 HCS = HCS + M2(IQ1,IQ2)
21210 IF (GENEV.AND.HCS.GT.RCS) GOTO 900
21214 C--change sign of COSTH if antiparticle first
21215 IF(IDHEP(1).LT.IDHEP(2)) COSTH = -COSTH
21216 C-Set up the particle types
21219 ISTHEP(NHEP+1) = 110
21222 IDHEP(NHEP+2) = IDPDG(IG1)
21223 IDHEP(NHEP+3) = IDPDG(IG2)
21224 C--select the particle masses and momenta
21227 PHEP(5,NHEP+2) = HWUMBW(IG1)
21228 PHEP(5,NHEP+3) = HWUMBW(IG2)
21229 CALL HWVEQU(5,PHEP(1,3),PHEP(1,NHEP+1))
21230 PCM = HWUPCM(PHEP(5,NHEP+1),PHEP(5,NHEP+2),PHEP(5,NHEP+3))
21231 IF(PCM.LT.ZERO.AND.NTRY.LE.NETRY) THEN
21233 ELSEIF(PCM.LT.ZERO) THEN
21234 CALL HWWARN('HWHESG',100)
21237 C--Set up the colours etc
21238 ISTHEP(NHEP+2) = 113
21239 ISTHEP(NHEP+3) = 114
21240 JMOHEP(1,NHEP+1) = 1
21241 C--PR Bug fix 10/10/01
21242 IF (JDAHEP(1,1).NE.0) JMOHEP(1,NHEP+1)=JDAHEP(1,1)
21243 JMOHEP(2,NHEP+1) = 2
21244 IF (JDAHEP(1,2).NE.0) JMOHEP(2,NHEP+1)=JDAHEP(1,2)
21245 JMOHEP(1,NHEP+2) = NHEP+1
21246 JMOHEP(2,NHEP+2) = NHEP+2
21247 JMOHEP(1,NHEP+3) = NHEP+1
21248 JMOHEP(2,NHEP+3) = NHEP+3
21249 JDAHEP(1,NHEP+1) = NHEP+2
21250 JDAHEP(2,NHEP+1) = NHEP+3
21251 JDAHEP(1,NHEP+2) = 0
21252 JDAHEP(2,NHEP+2) = NHEP+3
21253 JDAHEP(1,NHEP+3) = 0
21254 JDAHEP(2,NHEP+3) = NHEP+2
21255 C--Set up the momenta
21257 PHEP(4,IHEP) = SQRT(PCM**2+PHEP(5,IHEP)**2)
21258 PHEP(3,IHEP) = PCM*COSTH
21259 PHEP(1,IHEP) = SQRT((PCM+PHEP(3,IHEP))*(PCM-PHEP(3,IHEP)))
21260 PHEP(2,IHEP) = ZERO
21261 CALL HWRAZM(PHEP(1,IHEP),PHEP(1,IHEP),PHEP(2,IHEP))
21262 CALL HWULOB(PHEP(1,NHEP+1),PHEP(1,IHEP),PHEP(1,IHEP))
21263 CALL HWVDIF(4,PHEP(1,NHEP+1),PHEP(1,IHEP),PHEP(1,IHEP+1))
21271 *CMZ :- -18/10/00 13:46:47 by Peter Richardson
21272 *-- Author : Kosuke Odagiri & Peter Richardson
21273 C-----------------------------------------------------------------------
21275 C-----------------------------------------------------------------------
21276 C SUSY E+E- -> 2 SPARTICLE PROCESSES
21277 C-----------------------------------------------------------------------
21278 INCLUDE 'herwig65.inc'
21279 DOUBLE PRECISION SAVWT(3),RANWT,HWRGEN
21282 IF(IPROC.EQ.700) THEN
21284 RANWT = SAVWT(3)*HWRGEN(0)
21285 IF(RANWT.LT.SAVWT(1)) THEN
21287 ELSEIF(RANWT.LT.SAVWT(2)) THEN
21289 ELSEIF(RANWT.LT.SAVWT(3)) THEN
21296 SAVWT(2) = SAVWT(1)+EVWGT
21298 SAVWT(3) = SAVWT(2)+EVWGT
21301 ELSEIF(IPROC.LT.740) THEN
21303 ELSEIF(IPROC.LT.760) THEN
21305 ELSEIF(IPROC.LT.790) THEN
21308 C---UNRECOGNIZED PROCESS
21309 CALL HWWARN('HWHESP',500)
21313 *CMZ :- -16/10/00 15:34:113 by Peter Richardson
21314 *-- Author : Kosuke Odagiri & Peter Richardson
21315 C-----------------------------------------------------------------------
21317 C-----------------------------------------------------------------------
21318 C SUSY E+E- -> 2 SQUARK PROCESSES
21319 C-----------------------------------------------------------------------
21320 INCLUDE 'herwig65.inc'
21321 DOUBLE PRECISION HWRGEN,HWUAEM,EPS,HCS,RCS,S,PF,QPE,HWUPCM,PCM,
21322 & FACTR,SN2TH,MZ,ME2(2,2,6),EMSC2,HWUMBW,HWRUNI,SQPE
21323 INTEGER ID1,ID2,IQ,IQ1,IQ2,I,J,IHEP,IDL,IDLR(2),IDSQU(2),NTRY
21324 EXTERNAL HWRGEN,HWUAEM,HWUMBW,HWUPCM,HWRUNI
21325 SAVE HCS,ME2,IDLR,IDSQU
21326 PARAMETER (EPS = 1.D-9)
21327 DOUBLE COMPLEX Z, GZ, A, BL, BR, CL, CR, D, E
21328 PARAMETER (Z = (0.D0,1.D0))
21329 EQUIVALENCE (MZ, RMASS(200))
21333 EMSCA = SQRT(EMSC2)
21335 IF(IPROC.EQ.700.OR.IPROC.EQ.760) THEN
21340 ELSEIF(IPROC.GT.760.AND.IPROC.LE.784) THEN
21341 IQ = MOD((IPROC-761),4)
21345 ELSEIF(IQ.EQ.1) THEN
21348 ELSEIF(IQ.EQ.2) THEN
21351 ELSEIF(IQ.EQ.3) THEN
21355 IDSQU(1) = (IPROC-761)/4+1
21356 IDSQU(2) = IDSQU(1)
21358 CALL HWWARN('HWHESQ',500)
21362 RCS = HCS*HWRGEN(0)
21364 COSTH = HWRUNI(1,-ONE,ONE)
21365 SN2TH = 0.25D0 - 0.25D0*COSTH**2
21366 FACTR = CAFAC*GEV2NB*PIFAC*HWUAEM(EMSC2)**2*SN2TH/S
21367 GZ = (S-MZ**2+Z*S*GAMZ/MZ)/S
21368 IDL = ABS(IDHEP(1))
21379 DO IQ = IDSQU(1),IDSQU(2)
21382 IF ((I.NE.J).AND.(IQ.LT.5).OR.
21383 & (IDLR(1).NE.0.AND.(IDLR(1).NE.I.OR.IDLR(2).NE.J)
21384 & .AND.(IDLR(1).NE.J.OR.IDLR(2).NE.I))) THEN
21387 ID1 = 388 + I*12 + IQ
21388 ID2 = 388 + J*12 + IQ
21389 QPE = S-(RMASS(ID1)+RMASS(ID2))**2
21391 IF (QPE.GT.ZERO) THEN
21392 SQPE = SQRT(QPE*(S-(RMASS(ID1)-RMASS(ID2))**2))
21394 A = QFCH(IQ)*QFCH(IDL)
21397 CL = QMIXSS(IQ,1,I)*QMIXSS(IQ,1,J)
21398 CR = QMIXSS(IQ,2,I)*QMIXSS(IQ,2,J)
21399 D = (A+BL*LFCH(IDL))*CL+(A+BR*LFCH(IDL))*CR
21400 E = (A+BL*RFCH(IDL))*CL+(A+BR*RFCH(IDL))*CR
21401 ME2(I,J,IQ)=FACTR*PF**3*DREAL(
21402 & (ONE-EPOLN(3))*(ONE+PPOLN(3))*DCONJG(D)*D
21403 & +(ONE+EPOLN(3))*(ONE-PPOLN(3))*DCONJG(E)*E)
21418 HCS = HCS + ME2(I,J,IQ)
21419 IF (GENEV.AND.HCS.GT.RCS) GOTO 100
21427 ISTHEP(NHEP+1) = 110
21430 IDHEP(NHEP+2) = IDPDG(IQ1)
21431 IDHEP(NHEP+3) = IDPDG(IQ2)
21432 C--Select the particle masses and momenta
21434 PHEP(5,NHEP+2) = HWUMBW(IQ1)
21435 PHEP(5,NHEP+3) = HWUMBW(IQ2)
21436 CALL HWVEQU(5,PHEP(1,3),PHEP(1,NHEP+1))
21437 PCM = HWUPCM(PHEP(5,NHEP+1),PHEP(5,NHEP+2),PHEP(5,NHEP+3))
21438 IF(PCM.LT.ZERO.AND.NTRY.LE.NETRY) THEN
21440 ELSEIF(PCM.LT.ZERO) THEN
21441 CALL HWWARN('HWHESQ',100)
21444 C--Set up the colours etc
21445 ISTHEP(NHEP+2) = 113
21446 ISTHEP(NHEP+3) = 114
21447 JMOHEP(1,NHEP+1) = 1
21448 IF (JDAHEP(1,1).NE.0) JMOHEP(1,NHEP+1)=JDAHEP(1,1)
21449 JMOHEP(2,NHEP+1) = 2
21450 IF (JDAHEP(1,2).NE.0) JMOHEP(2,NHEP+1)=JDAHEP(1,2)
21451 JMOHEP(1,NHEP+2) = NHEP+1
21452 JMOHEP(2,NHEP+2) = NHEP+3
21453 JMOHEP(1,NHEP+3) = NHEP+1
21454 JMOHEP(2,NHEP+3) = NHEP+2
21455 JDAHEP(1,NHEP+1) = NHEP+2
21456 JDAHEP(2,NHEP+1) = NHEP+3
21457 JDAHEP(1,NHEP+2) = 0
21458 JDAHEP(2,NHEP+2) = NHEP+3
21459 JDAHEP(1,NHEP+3) = 0
21460 JDAHEP(2,NHEP+3) = NHEP+2
21461 C--Set up the momenta
21463 PHEP(4,IHEP) = SQRT(PCM**2+PHEP(5,IHEP)**2)
21464 PHEP(3,IHEP) = PCM*COSTH
21465 PHEP(1,IHEP) = SQRT((PCM+PHEP(3,IHEP))*(PCM-PHEP(3,IHEP)))
21466 CALL HWRAZM(PHEP(1,IHEP),PHEP(1,IHEP),PHEP(2,IHEP))
21467 CALL HWULOB(PHEP(1,NHEP+1),PHEP(1,IHEP),PHEP(1,IHEP))
21468 CALL HWVDIF(4,PHEP(1,NHEP+1),PHEP(1,IHEP),PHEP(1,IHEP+1))
21476 *CMZ :- -26/04/91 11.11.55 by Bryan Webber
21477 *-- Author : Zoltan Kunszt, modified by Bryan Webber & Mike Seymour
21478 C-----------------------------------------------------------------------
21479 SUBROUTINE HWHEW0(IP,ETOT,XM,PR,WEIGHT,CR)
21480 C-----------------------------------------------------------------------
21481 INCLUDE 'herwig65.inc'
21482 DOUBLE PRECISION HWRGEN,ETOT,XM(2),PR(5,2),WEIGHT,CR,XM1,XM2,S,
21483 & D1,PABS,D,CX,C,E,F,SC,G
21491 PABS=D1*D1-4.*XM1*XM2
21492 IF (PABS.LE.ZERO) RETURN
21497 C=D-(D+CX)*((D-CR)/(D+CX))**HWRGEN(2)
21499 3 E=((D+ONE)/(D-ONE))*(TWO*HWRGEN(3)-ONE)
21500 C=D*((E-ONE)/(E+ONE))
21501 4 F=2D0*PIFAC*HWRGEN(4)
21503 PR(4,1)=(S+XM1-XM2)/(TWO*ETOT)
21504 PR(5,1)=PR(4,1)*PR(4,1)-XM1
21505 IF (PR(5,1).LE.ZERO) RETURN
21506 PR(5,1)=SQRT(PR(5,1))
21507 PR(4,2)=ETOT-PR(4,1)
21510 PR(2,1)=PR(5,1)*SC*COS(F)
21511 PR(1,1)=PR(5,1)*SC*SIN(F)
21515 IF(IP.EQ.1)G=(D-C)*LOG((D+CX)/(D-CR))
21516 IF(IP.EQ.2)G=(D*D-C*C)/D*LOG((D+ONE)/(D-ONE))
21517 WEIGHT=PIFAC*G*PR(5,1)/ETOT*HALF
21520 *CMZ :- -26/04/91 11.11.55 by Bryan Webber
21521 *-- Author : Zoltan Kunszt, modified by Bryan Webber
21522 C-----------------------------------------------------------------------
21523 SUBROUTINE HWHEW1(NPART)
21524 C-----------------------------------------------------------------------
21526 DOUBLE PRECISION P(4,7),XMASS,PLAB,PRW,PCM
21527 INTEGER NPART,I,J,K
21528 COMMON/HWHEWP/ XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
21536 DO 30 K=1,(NPART-2)
21537 30 PCM(J,K)=P(J,K+2)
21538 PCM(J,NPART-1)=-P(J,1)
21539 PCM(J,NPART)=-P(J,2)
21543 *CMZ :- -26/04/91 13.22.25 by Federico Carminati
21544 *-- Author : Zoltan Kunszt, modified by Bryan Webber
21545 C-----------------------------------------------------------------------
21546 SUBROUTINE HWHEW2(NPART,PPCM,H,CH,D)
21547 C-----------------------------------------------------------------------
21548 C PCM SHOULD BE DEFINED SUCH THAT ALL 4-MOMENTA ARE OUTGOING.
21549 C CONVENTION FOR PCM AND P IS THAT DIRECTION 1 =BEAM, COMPONENT
21550 C 4 = ENERGY AND COMPONENT 2 AND 3 ARE TRANSVERSE COMPONENTS.
21551 C THUS INCOMING MOMENTA SHOULD CORRESPOND TO OUTGOING MOMENTA
21552 C OF NEGATIVE ENERGY.
21553 C PCM IS FILLED BY PHASE SPACE MONTE CARLO.
21554 C I1-I7 HERE REFER TO HOW PCM INDEXING IS MAPPED TO OUR STANDARD
21555 C 1-6=GLUON,GLUON,Q,QBAR,QP,QPBAR ORDERING `
21556 C-----------------------------------------------------------------------
21558 DOUBLE COMPLEX PT5,ZT,Z1,ZI,ZP,ZQ,ZD,ZPS,ZQS,ZDPM,ZDMP,H(8,8),
21560 DOUBLE PRECISION ZERO,ONE,PPCM(5,8),P(5,8),WRN(8),EPS,Q1,Q2,QP,QM,
21561 & P1,P2,PP,PM,DMP,DPM,PT,QT,PTI,QTI,HALF
21562 INTEGER J,L,IJ,II,JJ,I,NPART,IP1,IPP1
21563 PARAMETER (ZERO=0.D0,ONE=1.D0,HALF=0.5D0)
21565 ZI=DCMPLX(ZERO,ONE)
21566 Z1=DCMPLX(ONE,ZERO)
21567 C FOLLOWING DO LOOP IS TO CONVERT TO OUR STANDARD INDEXING
21570 1 P(IJ,L)=PPCM(IJ,L)
21573 IF(P(4,II).LT.ZERO) WRN(II)=-ONE
21575 P(JJ,II)=WRN(II)*P(JJ,II)
21577 C THE ABOVE CHECKS FOR MOMENTA WITH NEGATIVE ENERGY,INNER PRODUCTS
21578 C ARE EXPRESSED DIFFERENTLY FOR DIFFERENT CASES
21584 IF(Q1.GT.EPS)QP=SQRT(Q1)
21587 IF(Q2.GT.EPS)QM=SQRT(Q2)
21590 IF(P1.GT.EPS)PP=SQRT(P1)
21593 IF(P2.GT.EPS)PM=SQRT(P2)
21595 ZDMP=DCMPLX(DMP,ZERO)
21597 ZDPM=DCMPLX(DPM,ZERO)
21598 C NOTE THAT IN OUR INNER PRODUCT NOTATION WE ARE COMPUTING <P,Q>
21599 PT=SQRT(P(2,J)**2+P(3,J)**2)
21600 QT=SQRT(P(2,I)**2+P(3,I)**2)
21601 IF(PT.GT.EPS) GOTO 99
21605 ZP=DCMPLX(PTI*P(2,J),PTI*P(3,J))
21607 IF(QT.GT.EPS) GOTO 89
21611 ZQ=DCMPLX(QTI*P(2,I),QTI*P(3,I))
21614 IF(WRN(I).LT.ZERO) ZT=ZT*ZI
21615 IF(WRN(J).LT.ZERO) ZT=ZT*ZI
21616 H(J,I)=(ZDMP*ZP-ZDPM*ZQ)*ZT
21617 CH(J,I)=(ZDMP*ZPS-ZDPM*ZQS)*ZT
21619 PT5=DCMPLX(HALF,ZERO)
21630 *CMZ :- -27/03/92 19.48.55 by Mike Seymour
21631 *-- Author : Zoltan Kunszt, modified by Bryan Webber
21632 C-----------------------------------------------------------------------
21633 SUBROUTINE HWHEW3(N1,N2,N3,N4,N5,N6,AMPWW)
21634 C-----------------------------------------------------------------------
21635 C RECALL THAT N1,N3,N5 MUST BE OUTGOING FERMIONS, AND N2,N4,N6 MUST BE
21636 C OUTGOING ANTI-FERMIONS; 3,4 FOR W-, 5,6 FOR W+
21638 C EQ1 AND T31 ARE FOR OUTOING INITIAL QUARK
21639 C CHOOSE APPROPRIATE CASE ACCORDING TO NUPDN
21640 C NUPDN=1 FOR UUBAR COLLISIONS, NUPDN=2 FOR DDBAR COLLISIONS
21641 C NFINAL CHOOSES THE FINAL DECAYS, 1 FOR DOUBLE LEPTON, 2 FOR 1 FLAVOR
21642 C LEPTON+2FAMILIES OF QUARKS, 3 THE SAME, 4 FOR DOUBLE 2FAM3COLOR QUARKS
21644 C NOTE: EXTERNAL FACTOR OF COLOR AVERAGE AND SPIN AVERAGE AND
21645 C COUPLING (E**8/4/9) MUST BE INCLUDED AS WELL AS COMPENSATION
21646 C FOR ON POLE APPROXIMATION AS DESIRED.
21647 C-----------------------------------------------------------------------
21648 INCLUDE 'herwig65.inc'
21649 DOUBLE COMPLEX HWHEW4,ZH,ZCH,ZD,ZAMP1,ZAMP3,DWW,CWW,BWW,AWW,
21650 & AWWM,AWWP,AMPTEM,ZTWO,ZHALF
21651 DOUBLE PRECISION XW,ZMASS,T3,EQ1,RR,RL,ZM2,AMP2,RKW,COLFAC(4),
21653 INTEGER I,N1,N2,N3,N4,N5,N6
21655 COMMON/HWHEWQ/ZH(8,8),ZCH(8,8),ZD(8,8)
21656 EQUIVALENCE (XW,SWEIN),(ZMASS,RMASS(200))
21657 SAVE COLFAC,ZTWO,ZHALF
21658 DATA COLFAC/1.D0,3.D0,3.D0,9.D0/
21659 DATA ZTWO,ZHALF/(2.0D0,0.0D0),(0.5D0,0.0D0)/
21665 ZAMP1=DCMPLX(ZM2)/(ZTWO*ZD(N1,N2))
21666 & /(ZTWO*ZD(N1,N2)+DCMPLX(-ZM2,GAMZ*ZMASS))
21667 ZAMP3=ZHALF/(ZD(N1,N5)+ZD(N1,N6)+ZD(N5,N6))
21668 DWW=DCMPLX(RL)*ZAMP1+T3/(ZTWO*ZD(N1,N2))
21669 CWW=DCMPLX(RR)*ZAMP1
21672 AWWM=AWW*HWHEW4(N1,N2,N3,N4,N5,N6)-BWW*HWHEW4(N1,N2,N5,N6,N3,N4)
21673 AWWP=CWW*(HWHEW4(N2,N1,N5,N6,N3,N4)-HWHEW4(N2,N1,N3,N4,N5,N6))
21674 AMPTEM=AWWM*DCONJG(AWWM)+AWWP*DCONJG(AWWP)
21676 C AMP2 DOES NOT INCLUDE COLOR OR FLAVOR SUMS OR AVERAGES YET
21677 C NOR DOES IT INCLUDE TO THIS POINT KWW**2
21678 C 1 LEPTON FLAVOR IF APPROPRIATE FOR NFINAL CHOICE
21681 6 AMPWW(I)=AMP2*COLFAC(I)*RKW*RKW
21684 *CMZ :- -26/04/91 10.18.57 by Bryan Webber
21685 *-- Author : Zoltan Kunszt, modified by Bryan Webber
21686 C-----------------------------------------------------------------------
21687 FUNCTION HWHEW4(N1,N2,N3,N4,N5,N6)
21688 C-----------------------------------------------------------------------
21690 DOUBLE COMPLEX HWHEW4,ZH,ZCH,ZD
21691 INTEGER N1,N2,N3,N4,N5,N6
21692 COMMON/HWHEWQ/ZH(8,8),ZCH(8,8),ZD(8,8)
21693 HWHEW4=4*ZH(N1,N3)*ZCH(N2,N6)*(ZH(N1,N5)*ZCH(N1,N4)
21694 X +ZH(N3,N5)*ZCH(N3,N4))
21697 *CMZ : 20/08/91 22.09.33 by Federico Carminati
21698 *-- Author : Zoltan Kunszt, modified by Mike Seymour
21699 C-----------------------------------------------------------------------
21700 SUBROUTINE HWHEW5(N1,N2,N3,N4,N5,N6,HELSUM,HELCTY,ID1,ID2)
21701 C-----------------------------------------------------------------------
21702 C RECALL THAT N1,N3,N5 MUST BE OUTGOING FERMIONS, AND N2,N4,N6 MUST BE
21703 C OUTGOING ANTI-FERMIONS; 3,4 FOR Z0, 5,6 FOR Z0
21705 C EQ1 AND T31 ARE FOR OUTOING INITIAL QUARK
21706 C CHOOSE APPROPRIATE CASE ACCORDING TO NUPDN
21707 C NUPDN=1 FOR UUBAR COLLISIONS, NUPDN=2 FOR DDBAR COLLISIONS
21708 C NFINAL CHOOSES THE FINAL DECAYS, 1 FOR DOUBLE LEPTON, 2 FOR 1 FLAVOR
21709 C LEPTON+2FAMILIES OF QUARKS, 3 THE SAME, 4 FOR DOUBLE 2FAM3COLOR QUARKS
21711 C NOTE: EXTERNAL FACTOR OF COLOR AVERAGE AND SPIN AVERAGE AND
21712 C COUPLING (E**8/4/9) MUST BE INCLUDED AS WELL AS COMPENSATION
21713 C FOR ON POLE APPROXIMATION AS DESIRED.
21715 C---SLIGHTLY MODIFIED BY MHS, SO THAT HELCTY REFERS TO THE FINAL STATE
21716 C INDICATED BY ID1,ID2
21717 C-----------------------------------------------------------------------
21719 DOUBLE COMPLEX HWHEW4,ZH,ZCH,ZD,ZAMM(8),ZS134,ZS156,ZS234,ZS256,
21721 DOUBLE PRECISION CPFAC,CPALL,HELSUM,HELCTY,AMM
21722 INTEGER N1,N2,N3,N4,N5,N6,ID1,ID2,I
21724 COMMON/HWHEWQ/ZH(8,8),ZCH(8,8),ZD(8,8)
21725 COMMON/HWHEWR/CPFAC(12,12,8),CPALL(8)
21727 DATA ZTWO/(2.0D0,0.0D0)/
21728 C THE MATRIX ELEMENT DEPENDS ON
21729 ZS134=(ZD(N1,N3)+ZD(N1,N4)+ZD(N3,N4))*ZTWO
21730 ZS156=(ZD(N1,N5)+ZD(N1,N6)+ZD(N5,N6))*ZTWO
21731 ZS234=(ZD(N2,N3)+ZD(N2,N4)+ZD(N3,N4))*ZTWO
21732 ZS256=(ZD(N2,N5)+ZD(N2,N6)+ZD(N5,N6))*ZTWO
21733 ZAMM(1)=HWHEW4(N1,N2,N3,N4,N5,N6)/ZS134+
21734 > HWHEW4(N1,N2,N5,N6,N3,N4)/ZS156
21735 ZAMM(2)=HWHEW4(N1,N2,N4,N3,N5,N6)/ZS134+
21736 > HWHEW4(N1,N2,N5,N6,N4,N3)/ZS156
21737 ZAMM(3)=HWHEW4(N1,N2,N3,N4,N6,N5)/ZS134+
21738 > HWHEW4(N1,N2,N6,N5,N3,N4)/ZS156
21739 ZAMM(4)=HWHEW4(N1,N2,N4,N3,N6,N5)/ZS134+
21740 > HWHEW4(N1,N2,N6,N5,N4,N3)/ZS156
21741 ZAMM(5)=HWHEW4(N2,N1,N3,N4,N5,N6)/ZS234+
21742 > HWHEW4(N2,N1,N5,N6,N3,N4)/ZS256
21743 ZAMM(6)=HWHEW4(N2,N1,N4,N3,N5,N6)/ZS234+
21744 > HWHEW4(N2,N1,N5,N6,N4,N3)/ZS256
21745 ZAMM(7)=HWHEW4(N2,N1,N3,N4,N6,N5)/ZS234+
21746 > HWHEW4(N2,N1,N6,N5,N3,N4)/ZS256
21747 ZAMM(8)=HWHEW4(N2,N1,N4,N3,N6,N5)/ZS234+
21748 > HWHEW4(N2,N1,N6,N5,N4,N3)/ZS256
21752 AMM=DREAL(ZAMM(I)*DCONJG(ZAMM(I)))
21753 HELSUM=HELSUM+CPALL(I)*AMM
21754 HELCTY=HELCTY+CPFAC(ID1,ID2,I)*AMM
21758 *CMZ :- -02/05/91 10.58.29 by Federico Carminati
21759 *-- Author : Zoltan Kunszt, modified by Bryan Webber
21760 C-----------------------------------------------------------------------
21762 C-----------------------------------------------------------------------
21763 C E+E- -> W+W-/Z0Z0 (BASED ON ZOLTAN KUNSZT'S PROGRAM)
21764 C-----------------------------------------------------------------------
21765 INCLUDE 'herwig65.inc'
21766 DOUBLE COMPLEX ZH,ZCH,ZD
21767 DOUBLE PRECISION HWUAEM,HWRGEN,HWUPCM,ETOT,STOT,FLUXW,GAMM,GIMM,
21768 & WM2,WXMIN,WX1MAX,WX2MAX,FJAC1,FJAC2,WX1,WX2,WMM1,WMM2,XXM,W2BO,
21769 & PST,WEIGHT,TOTSIG,WMASS,WWIDTH,ELST,CV,CA,BR,XMASS,PLAB,PRW,PCM,
21770 & AMPWW(4),CCC,HELSUM,HELCTY,BRZED(12),BRTOT,CPFAC,CPALL,RLL(12),
21772 INTEGER IB,IBOS,I,ID1,ID2,NTRY,IDP(10),IDBOS(2),J1,J2,IPRC,ILST,
21773 & IDZOLT(16),MAP(12),NEWHEP
21774 LOGICAL EISBM1,HWRLOG
21775 EXTERNAL HWUAEM,HWRGEN,HWUPCM
21776 SAVE IDP,STOT,FLUXW,GAMM,GIMM,WM2,WXMIN,WX1MAX,FJAC1,ELST,ILST,
21777 & IDBOS,WMASS,WWIDTH,BRZED
21778 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
21779 COMMON/HWHEWQ/ZH(8,8),ZCH(8,8),ZD(8,8)
21780 COMMON/HWHEWR/CPFAC(12,12,8),CPALL(8)
21782 DATA ELST,ILST/0.D0,0/
21783 DATA IDZOLT/4,3,8,7,12,11,4*0,2,1,6,5,10,9/
21784 DATA MAP/12,11,2,1,14,13,4,3,16,15,6,5/
21785 IF (IERROR.NE.0) RETURN
21786 EISBM1=IDHW(1).LT.IDHW(2)
21792 CALL HWVEQU(5,PRW(1,IB),PHEP(1,IBOS))
21793 IF (EISBM1) PHEP(3,IBOS)=-PHEP(3,IBOS)
21794 CALL HWVZRO(4,VHEP(1,IBOS))
21795 CALL HWUDKL(IDBOS(IB),PHEP(1,IBOS),DIST)
21796 CALL HWVSUM(4,VHEP(1,IBOS),DIST,DIST)
21797 IDHW(IBOS)=IDBOS(IB)
21798 IDHEP(IBOS)=IDPDG(IDBOS(IB))
21803 CALL HWVEQU(5,PLAB(1,2*IB+I),PHEP(1,NHEP+I))
21804 IF (EISBM1) PHEP(3,NHEP+I)=-PHEP(3,NHEP+I)
21805 CALL HWVEQU(4,DIST,VHEP(1,NHEP+I))
21806 C---STATUS, IDs AND POINTERS
21807 ISTHEP(NHEP+I)=112+I
21808 IDHW(NHEP+I)=IDP(2*IB+I)
21809 IDHEP(NHEP+I)=IDPDG(IDP(2*IB+I))
21810 JDAHEP(I,IBOS)=NHEP+I
21811 JMOHEP(1,NHEP+I)=IBOS
21812 JMOHEP(2,NHEP+I)=JMOHEP(1,IBOS)
21815 JMOHEP(2,NHEP)=NHEP-1
21816 JDAHEP(2,NHEP)=NHEP-1
21817 JMOHEP(2,NHEP-1)=NHEP
21818 JDAHEP(2,NHEP-1)=NHEP
21823 IPRC=MOD(IPROC,100)
21824 IF (ETOT.NE.ELST .OR. IPRC.NE.ILST) THEN
21826 FLUXW=GEV2NB*.125*(HWUAEM(STOT)/PIFAC)**4/STOT
21827 IF (IPRC.EQ.0) THEN
21832 ELSEIF (IPRC.EQ.50) THEN
21837 C---LOAD FERMION COUPLINGS TO Z
21839 RLL(I)=VFCH(MAP(I),1)+AFCH(MAP(I),1)
21840 RRL(I)=VFCH(MAP(I),1)-AFCH(MAP(I),1)
21849 IF (MOD(J1-1,4).GE.2) CCC=CCC*CAFAC
21850 IF (MOD(J2-1,4).GE.2) CCC=CCC*CAFAC
21851 CPFAC(J1,J2,1)=CCC*(RLL(2)**2*RLL(J1)*RLL(J2))**2
21852 CPFAC(J1,J2,2)=CCC*(RLL(2)**2*RRL(J1)*RLL(J2))**2
21853 CPFAC(J1,J2,3)=CCC*(RLL(2)**2*RLL(J1)*RRL(J2))**2
21854 CPFAC(J1,J2,4)=CCC*(RLL(2)**2*RRL(J1)*RRL(J2))**2
21855 CPFAC(J1,J2,5)=CCC*(RRL(2)**2*RLL(J1)*RLL(J2))**2
21856 CPFAC(J1,J2,6)=CCC*(RRL(2)**2*RRL(J1)*RLL(J2))**2
21857 CPFAC(J1,J2,7)=CCC*(RRL(2)**2*RLL(J1)*RRL(J2))**2
21858 CPFAC(J1,J2,8)=CCC*(RRL(2)**2*RRL(J1)*RRL(J2))**2
21860 IF (J1.EQ.1.AND.J2.EQ.1) CPALL(I)=0
21861 CPALL(I)=CPALL(I)+CPFAC(J1,J2,I)
21862 BRZED(J1)=BRZED(J1)+CPFAC(J1,J2,I)
21863 BRTOT=BRTOT+CPFAC(J1,J2,I)
21868 70 BRZED(I)=BRZED(I)/BRTOT
21870 CALL HWWARN('HWHEWW',500)
21875 WXMIN=ATAN(-WMASS/WWIDTH)
21876 WX1MAX=ATAN((STOT-WM2)*GIMM)
21882 C---CHOOSE W MASSES
21883 WX1=WXMIN+FJAC1*HWRGEN(1)
21884 WMM1=GAMM*TAN(WX1)+WM2
21885 IF (WMM1.LE.0) RETURN
21886 XMASS(1)=SQRT(WMM1)
21887 WX2MAX=ATAN(((ETOT-XMASS(1))**2-WM2)*GIMM)
21889 WX2=WXMIN+FJAC2*HWRGEN(2)
21890 WMM2=GAMM*TAN(WX2)+WM2
21891 IF (WMM2.LE.0) RETURN
21892 XMASS(2)=SQRT(WMM2)
21893 IF (HWRLOG(HALF))THEN
21898 C---CTMAX=ANGULAR CUT ON COS W-ANGLE
21899 CALL HWHEW0(1,ETOT,XMASS(1),PRW(1,1),W2BO,CTMAX)
21900 IF (W2BO.EQ.ZERO) RETURN
21901 C---FOR ZZ EVENTS, FORCE BOSE STATISTICS, BY KILLING EVENTS WITH COS1<0
21902 IF (IPRC.NE.0) THEN
21903 IF (PRW(3,1).LT.ZERO) RETURN
21904 C---AND THEN SYMMETRIZE (THIS PROCEDURE VASTLY IMPROVES EFFICIENCY)
21905 IF (HWRLOG(HALF)) THEN
21911 PLAB(4,1)=PLAB(3,1)
21912 PLAB(3,2)=-PLAB(3,1)
21913 PLAB(4,2)=PLAB(3,1)
21915 C---LET THE W BOSONS DECAY
21919 CALL HWDBOZ(IDBOS(IB),ID1,ID2,CV,CA,BR,1)
21920 PST=HWUPCM(XMASS(IB),RMASS(ID1),RMASS(ID2))
21921 IF (PST.LT.ZERO) THEN
21922 CALL HWDBOZ(IDBOS(IB),ID1,ID2,CV,CA,BR,2)
21923 IF (NTRY.LE.NBTRY) GOTO 80
21924 C CALL HWWARN('HWHEWW',1)
21927 PRW(5,IB)=XMASS(IB)
21930 PLAB(5,2*IB+1)=RMASS(ID1)
21931 PLAB(5,2*IB+2)=RMASS(ID2)
21932 CALL HWDTWO(PRW(1,IB),PLAB(1,2*IB+1),PLAB(1,2*IB+2),
21935 WEIGHT=FLUXW*W2BO*FJAC1*FJAC2*(0.5D0*PIFAC*GIMM)**2
21937 CALL HWHEW2(6,PCM(1,1),ZH,ZCH,ZD)
21938 IF (IPRC.EQ.0) THEN
21939 CALL HWHEW3(5,6,3,4,1,2,AMPWW)
21940 TOTSIG=9.*AMPWW(1)+6.*(AMPWW(2)+AMPWW(3))+4.*AMPWW(4)
21941 EVWGT=TOTSIG*WEIGHT*BR
21943 ID1=IDZOLT(IDPDG(IDP(3)))
21944 ID2=IDZOLT(IDPDG(IDP(5)))
21945 CALL HWHEW5(5,6,3,4,1,2,HELSUM,HELCTY,ID1,ID2)
21946 EVWGT=HELCTY*WEIGHT*BR/(BRZED(ID1)*BRZED(ID2))
21951 *CMZ :- -02/04/01 12.11.55 by Peter Richardson
21952 *-- Author : Peter Richardson
21953 C-----------------------------------------------------------------------
21955 C-----------------------------------------------------------------------
21956 C Hadron-Hadron to WW/WZ/ZZ (BASED ON ZOLTAN KUNSZT'S PROGRAM)
21957 C-----------------------------------------------------------------------
21958 INCLUDE 'herwig65.inc'
21959 DOUBLE COMPLEX ZH,ZCH,ZD
21960 DOUBLE PRECISION HWUAEM,HWRGEN,HWUPCM,FLUXW,CSW,XMASS,
21961 & PLAB,PRW,PCM,HWRUNI,P(5,10),AMPWW,DIST(4),MW2,CFAC1,AMP,
21962 & MZ2,GMW,GMZ,G(4,2),EE(4),CKM2(12),RF(2),LF(2),TAUI(2),FPI4
21963 INTEGER IB,IBOS,I,IDP,IDBOS,IPRC,NEWHEP,J,ICMF,IHEP,IBRAD,K,IOPT,
21966 EXTERNAL HWUAEM,HWRGEN,HWUPCM,HWRUNI
21967 COMMON/HWHEWQ/ZH(8,8),ZCH(8,8),ZD(8,8)
21968 COMMON/HWHGBC/ MW2,MZ2,GMW,GMZ,G,EE,CKM2,RF,LF,TAUI,CSW,CFAC1
21969 COMMON /HWBOSN/XMASS(2),PLAB(5,10),PRW(5,2),PCM(5,10),IDBOS(2),
21970 & IDRES,IDP(10),IOPT
21971 SAVE AMPWW,IPRC,PHOTON
21972 PARAMETER(FPI4=24936.72731D0)
21973 DOUBLE PRECISION WI(IMAXCH)
21976 DATA MAP/1,2,11,12/
21977 IF (IERROR.NE.0) RETURN
21979 IF (IPRC.EQ.0) THEN
21980 CALL HWHGB2(AMPWW,IDP,PHOTON)
21981 ELSEIF(IPRC.EQ.10) THEN
21982 CALL HWHGB3(AMPWW,IDP,PHOTON)
21983 ELSEIF(IPRC.EQ.20) THEN
21984 CALL HWHGB4(AMPWW,IDP,PHOTON)
21985 IF((IDP(1).LE.6.AND.MOD(IDP(1),2).EQ.1).OR.
21986 & (IDP(2).LE.6.AND.MOD(IDP(2),2).EQ.1)) THEN
21992 C--change the sign of the z component (in CMF) if particle first
21993 IF(IDP(1).LT.IDP(2)) THEN
21995 PRW(3,IB) = -PRW(3,IB)
21997 PLAB(3,2*IB+I)=-PLAB(3,2*IB+I)
22001 C--boost particles back to the lab frame from the centre of mass frame
22003 CALL HWULOB(PLAB(1,7),PRW(1,IB),PRW(1,IB))
22006 CALL HWULOB(PLAB(1,7),PLAB(1,I),PLAB(1,I))
22008 C--put the particles in the event record
22009 C--first the incoming quarks
22013 CALL HWVEQU(5,PLAB(1,I),PHEP(1,IHEP))
22014 IDHW(IHEP) = IDP(I)
22015 IDHEP(IHEP)=IDPDG(IDP(I))
22017 JMOHEP(1,IHEP)=ICMF
22018 JMOHEP(I,ICMF)=IHEP
22019 JDAHEP(1,IHEP)=ICMF
22021 JMOHEP(2,NHEP+1) = NHEP+2
22022 JMOHEP(2,NHEP+2) = NHEP+1
22023 JDAHEP(2,NHEP+1) = NHEP+2
22024 JDAHEP(2,NHEP+2) = NHEP+1
22025 C--Centre-of-mass energy
22027 C--new for spin correlations
22034 DECSPN(1) = .FALSE.
22037 IDHEP(ICMF)=IDPDG(15)
22039 CALL HWVEQU(5,PLAB(1,7),PHEP(1,ICMF))
22040 CALL HWUMAS(PHEP(1,ICMF))
22041 JDAHEP(1,ICMF) = ICMF+1
22042 JDAHEP(2,ICMF) = ICMF+2
22049 CALL HWVEQU(5,PRW(1,IB),PHEP(1,IBOS))
22050 CALL HWVZRO(4,VHEP(1,IBOS))
22051 CALL HWUDKL(IDBOS(IB),PHEP(1,IBOS),DIST)
22052 CALL HWVSUM(4,VHEP(1,IBOS),DIST,DIST)
22053 IDHW(IBOS)=IDBOS(IB)
22054 IDHEP(IBOS)=IDPDG(IDBOS(IB))
22055 JMOHEP(1,IBOS)=ICMF
22056 JMOHEP(2,IBOS)=ICMF
22057 JDAHEP(2,IBOS)=IBOS
22058 ISTHEP(IBOS)=112+IB
22060 C--now generate the initial state shower
22062 IF(IERROR.NE.0) RETURN
22063 C--now add the outgoing fermions to the event record
22066 IBRAD = JDAHEP(1,IBOS)
22067 ISTHEP(IBRAD) = 195
22069 CALL HWVEQU(5,PLAB(1,2*IB+I),PHEP(1,NHEP+I))
22070 CALL HWVEQU(4,DIST,VHEP(1,NHEP+I))
22071 C--Boost the fermion momenta to the rest frame of the original W
22072 CALL HWULOF(PRW(1,IB),PHEP(1,NHEP+I),PHEP(1,NHEP+I))
22073 C--Now boost back to the lab from rest frame of the W after radiation
22074 CALL HWULOB(PHEP(1,IBRAD),PHEP(1,NHEP+I),PHEP(1,NHEP+I))
22075 C--Set the status and pointers
22076 ISTHEP(NHEP+I)=112+I
22077 IDHW(NHEP+I)=IDP(2*IB+I)
22078 IDHEP(NHEP+I)=IDPDG(IDP(2*IB+I))
22079 JDAHEP(I,IBRAD)=NHEP+I
22080 JMOHEP(1,NHEP+I)=IBRAD
22081 C--New for spin correlations
22083 ISNHEP(NHEP+I) = 2*IB+I-1
22084 IDSPN(2*IB+I-1) = NHEP+I
22085 JMOSPN(2*IB+I-1) = 1
22086 DECSPN(2*IB+I-1) = .FALSE.
22087 RHOSPN(1,1,2*IB+I-1) = HALF
22088 RHOSPN(1,2,2*IB+I-1) = ZERO
22089 RHOSPN(2,1,2*IB+I-1) = ZERO
22090 RHOSPN(2,2,2*IB+I-1) = HALF
22095 JMOHEP(2,NHEP)=NHEP-1
22096 JDAHEP(2,NHEP)=NHEP-1
22097 JMOHEP(2,NHEP-1)=NHEP
22098 JDAHEP(2,NHEP-1)=NHEP
22102 IPRC=MOD(IPROC,100)
22103 IF(MOD(IPRC,5).EQ.0.AND.MOD(IPRC,10).NE.0) THEN
22110 IF (IPRC.EQ.0) THEN
22116 ELSEIF (IPRC.EQ.10) THEN
22120 ELSEIF(IPRC.EQ.20) THEN
22127 CALL HWWARN('HWHGBP',500)
22129 C--calculate the couplings etc
22130 MW2 = RMASS(198)**2
22131 GMW = RMASS(198)*GAMW
22132 MZ2 = RMASS(200)**2
22133 GMZ = RMASS(200)*GAMZ
22134 C--couplings to Z and photon
22136 G(I,1) = VFCH(MAP(I),1)+AFCH(MAP(I),1)
22137 G(I,2) = VFCH(MAP(I),1)-AFCH(MAP(I),1)
22138 EE(I) = QFCH(MAP(I))
22140 C--elements of the CKM matrix for the various decay modes of the W
22143 C**Bug fix 2/7/01 by BRW (unsquare)
22144 CKM2(3*I-3+J) = VCKM(J,I)
22149 C--couplings of the up and down
22153 RF(I) = -TWO*QFCH(I)*SWEIN
22154 LF(I) = TAUI(I)+RF(I)
22157 CSW = SQRT((ONE-SWEIN)/SWEIN)
22160 C--find the momenta and the phase space weight
22161 CALL HWHGBS(FLUXW,GEN)
22162 IF(.NOT.GEN) RETURN
22164 AMP = FPI4*HWUAEM(EMSCA**2)**4
22165 C--copy the momenta and change the sign of the beam
22174 130 PCM(J,K)=P(J,K)
22178 C--use the e+e- code to calulate the spinor products
22179 CALL HWHEW2(6,PCM(1,1),ZH,ZCH,ZD)
22180 C--calculate the matrix elements
22181 IF (IPRC.EQ.0) THEN
22182 C--WW matrix element
22183 CALL HWHGB2(AMPWW,IDP,PHOTON)
22184 ELSEIF(IPRC.EQ.10) THEN
22185 C--ZZ matrix element
22186 CALL HWHGB3(AMPWW,IDP,PHOTON)
22187 ELSEIF(IPRC.EQ.20) THEN
22188 C--WZ matrix element
22189 CALL HWHGB4(AMPWW,IDP,PHOTON)
22191 C--Now calculate the cross section
22192 EVWGT = AMPWW*FLUXW*AMP
22195 IF(CHON(I)) WI(I) = WI(I)*AMPWW**2*AMP**2
22201 *CMZ :- -02/04/01 12.11.55 by Peter Richardson
22202 *-- Author : Peter Richardson
22203 C-----------------------------------------------------------------------
22204 SUBROUTINE HWHGBS(WEIGHT,GEN)
22205 C-----------------------------------------------------------------------
22206 C Multichannel phase space for gauge boson pair production
22207 C ICH returns the channel used if OPTM=.FALSE.
22208 C ICH specifies the channel to be used if OPTM=.TRUE.
22209 C This is used in optimising the weights for the different channels
22210 C-----------------------------------------------------------------------
22211 INCLUDE 'herwig65.inc'
22212 INTEGER ICH,IDBOS,ISM(2,IMAXCH),I,J,IB(2),IDRES,IDP,IOPT,IPRC,ID1
22213 DOUBLE PRECISION XMASS,PLAB,PRW,PCM,RAND,HWRGEN,BMS2(2),TJAC,PLM,
22214 & MJAC(2),TWOPI2,SJAC,STOT,THAT,UHAT,TMIN,TMAX,UMIN,UMAX,PS(2),
22215 & ETOT,HWUPCM,PST,HWRUNI,TAU,XJAC,PHI,SINTH,SIG(2),CV,CA,BR(2),
22216 & G(IMAXCH),XF,DEM,TN,UN,SN,S1,S2,MB1,MB2,WEIGHT,BRFAC,BRZ(12)
22218 COMMON /HWBOSN/ XMASS(2),PLAB(5,10),PRW(5,2),PCM(5,10),IDBOS(2),
22219 & IDRES,IDP(10),IOPT
22220 EXTERNAL HWRGEN,HWRLOG,HWUPCM,HWRUNI
22222 PARAMETER(TWOPI2=39.4784176D0)
22223 DOUBLE PRECISION WI(IMAXCH)
22226 DATA SIG/1.0D0,-1.0D0/
22227 DATA BRZ/0.154D0,0.120D0,0.154D0,0.120D0,0.152D0,0.000D0,
22228 & 0.033D0,0.067D0,0.033D0,0.067D0,0.033D0,0.067D0/
22229 IF(IERROR.NE.0) RETURN
22237 C--set the smoothing for the bosons in the various channels
22239 IPRC = MOD(IPROC,100)
22243 ISM(1,4*I-2+J ) = 1
22245 ISM(2,4*I+2*J-3) = 1
22246 ISM(2,4*I+2*J-2) = 2
22252 C--select the channel to be used
22256 IF(CHNPRB(ICH).GT.RAND) GOTO 10
22257 RAND = RAND-CHNPRB(ICH)
22261 C--select the boson masses and compute that part of the denominator
22262 C--decide which boson to do first
22263 IF(HWRLOG(HALF)) THEN
22270 C--find the boson masses
22271 CALL HWHGB1(ISM(IB(1),ICH),2,IDBOS(IB(1)),MJAC(IB(1)),BMS2(IB(1)),
22272 & (PHEP(5,3)-EMMIN)**2,EMMIN**2)
22273 XMASS(IB(1)) = SQRT(BMS2(IB(1)))
22274 CALL HWHGB1(ISM(IB(2),ICH),2,IDBOS(IB(2)),MJAC(IB(2)),BMS2(IB(2)),
22275 & (PHEP(5,3)-XMASS(IB(1)))**2,EMMIN**2)
22276 XMASS(IB(2)) = SQRT(BMS2(IB(2)))
22278 MJAC(I) = HALF*MJAC(I)/TWOPI2
22280 C--now generate the values of s
22281 C--according to a Breit-Wigner for the first two
22283 CALL HWHGB1(1,2,IDRES,SJAC,STOT,PHEP(5,3)**2,
22284 & (SQRT(BMS2(1)+PTMIN**2)+SQRT(BMS2(2)+PTMIN**2))**2)
22285 C--according to a power law for the rest
22287 CALL HWHGB1(2,2,IDRES,SJAC,STOT,PHEP(5,3)**2,
22288 & (SQRT(BMS2(1)+PTMIN**2)+SQRT(BMS2(2)+PTMIN**2))**2)
22291 C--find the centre of mass momenta
22292 PST = HWUPCM(ETOT,XMASS(1),XMASS(2))
22293 IF(PST.LT.PTMIN) RETURN
22294 PRW(4,1) = SQRT(BMS2(1)+PST**2)
22295 PRW(4,2) = SQRT(BMS2(2)+PST**2)
22296 C--now generate the value of t and u
22297 PLM = SQRT(PST**2-PTMIN**2)
22298 TMIN = BMS2(1)-ETOT*(PRW(4,1)+PLM)
22299 TMAX = BMS2(1)-ETOT*(PRW(4,1)-PLM)
22300 UMIN = BMS2(2)-ETOT*(PRW(4,2)+PLM)
22301 UMAX = BMS2(2)-ETOT*(PRW(4,2)-PLM)
22302 SN = ONE/(TMAX-TMIN)
22303 C--for the first two channels uniform in t
22305 THAT = HWRUNI(1,TMIN,TMAX)
22306 UHAT = BMS2(1)+BMS2(2)-STOT-THAT
22308 C--for the next four channels generate t according to 1/t
22309 ELSEIF(ICH.LE.6) THEN
22310 CALL HWHGB5(2,TJAC,THAT,TMAX,TMIN)
22311 UHAT = BMS2(1)+BMS2(2)-STOT-THAT
22312 C--for the last four channels generate u according to 1/u
22313 ELSEIF(ICH.LE.10) THEN
22314 CALL HWHGB5(2,TJAC,UHAT,UMAX,UMIN)
22315 THAT = BMS2(1)+BMS2(2)-STOT-UHAT
22317 CALL HWWARN('HWHGBS',500)
22319 CALL HWHGB5(1,TN,THAT,TMAX,TMIN)
22320 CALL HWHGB5(1,UN,UHAT,UMAX,UMIN)
22321 C--generate the parton momentum fractions and find the pdf's
22322 TAU = STOT/PHEP(5,3)**2
22323 XX(1) = EXP(HWRUNI(3,LOG(TAU),ZERO))
22325 XJAC = -LOG(TAU)*XX(1)
22328 CALL HWSGEN(.FALSE.)
22329 C--Centre of mass collison angle
22330 COSTH = (THAT-BMS2(1)+ETOT*PRW(4,1))/ETOT/PST
22331 PHI = HWRUNI(4,ZERO,TWO*PIFAC)
22332 SINTH = SQRT(ONE-COSTH**2)
22333 C--incoming momenta in the centre of mass frame
22337 PLAB(3,I) = HALF*ETOT
22338 PLAB(4,I) = HALF*ETOT
22341 PLAB(3,2) = -PLAB(3,2)
22342 C--outgoing boson momenta in the centre of mass frame
22344 PRW(1,I) = SIG(I)*SINTH*COS(PHI)*PST
22345 PRW(2,I) = SIG(I)*SINTH*SIN(PHI)*PST
22346 PRW(3,I) = SIG(I)*COSTH*PST
22347 PRW(5,I) = XMASS(I)
22349 C--now find the boson decay products
22350 C--find the momenta of the boson decay products
22351 IF(IPRC.EQ.20) IDBOS(1)=198
22353 CALL HWDBZ2(IDBOS(I),IDP(2*I+1),IDP(2*I+2),CV,CA,BR(I),IOPT,
22355 IF(BR(I).EQ.ZERO) RETURN
22357 PLAB(5,2*I+1) = ZERO
22358 PLAB(5,2*I+2) = ZERO
22359 PS(I) = HALF*XMASS(I)
22362 CALL HWDTWO(PRW(1,I),PLAB(1,2*I+1),PLAB(1,2*I+2),
22363 & PS(I),TWO,.TRUE.)
22366 IF(IOPT.EQ.0) BRFAC = BRFAC*BR(1)
22368 IF(IDBOS(I).EQ.200) THEN
22370 IF(ID1.GE.121) ID1 = ID1-114
22371 BRFAC = BRFAC/BRZ(ID1)
22375 MJAC(I) = MJAC(I)*PS(I)/XMASS(I)
22377 C--set up a vector with the centre of mass
22380 PLAB(3,7) = HALF*PHEP(5,3)*(XX(1)-XX(2))
22381 PLAB(4,7) = HALF*PHEP(5,3)*(XX(1)+XX(2))
22383 C--now find the denominator
22384 CALL HWHGB1(1,1,IDRES,S1,STOT,PHEP(5,3)**2,
22385 & (XMASS(1)+XMASS(2))**2)
22386 CALL HWHGB1(2,1,IDRES,S2,STOT,PHEP(5,3)**2,
22387 & (XMASS(1)+XMASS(2))**2)
22391 C--factors due to the choice of s and t
22394 ELSEIF(I.LE.6) THEN
22399 C--factors due to the boson masses
22400 CALL HWHGB1(ISM(IB(1),I),1,IDBOS(IB(1)),MB1,BMS2(IB(1)),
22401 & (PHEP(5,3)-EMMIN)**2,EMMIN**2)
22402 CALL HWHGB1(ISM(IB(2),I),1,IDBOS(IB(2)),MB2,BMS2(IB(2)),
22403 & (PHEP(5,3)-XMASS(IB(1)))**2,EMMIN**2)
22404 G(I) = G(I)*MB1*MB2*XF
22405 DEM = DEM+CHNPRB(I)*G(I)
22408 C--now combine everything to get the weight
22409 WEIGHT = GEV2NB*TJAC*SJAC*G(ICH)/DEM/XX(1)*
22410 & MJAC(1)*MJAC(2)*XJAC/64.0D0/PIFAC/STOT**3*BRFAC
22412 C--compute the weights for the different channels if optimizing
22415 IF(CHON(I)) WI(I)=G(I)*WEIGHT**2/DEM
22420 *CMZ :- -02/04/01 12.11.55 by Peter Richardson
22421 *-- Author : Peter Richardson
22422 C-----------------------------------------------------------------------
22423 SUBROUTINE HWHGB1(ISM,IOPT,IDBOZ,FJAC,MBOS2,MMAX,MMIN)
22424 C-----------------------------------------------------------------------
22425 C Subroutine to select gauge boson mass for HWHGBP
22426 C ISM=1 select according to Breit-Wigner for IDBOZ
22427 C ISM=2 select according to power law for IDBOZ
22428 C IOPT=1 return the function at MBOS2
22429 C IOPT=2 calculate MBOS2
22430 C-----------------------------------------------------------------------
22431 INCLUDE 'herwig65.inc'
22432 INTEGER IDBOZ,ISM,IOPT
22433 DOUBLE PRECISION MBOZ,FJAC,GBOZ,GMBOZ,MPOW,MMIN,
22434 & MBOS2,A1,A2,A01,A02,RPOW,QPOW,HWRGEN,MMAX,EMSQ
22436 C--set the boson mass
22437 IF(IDBOZ.EQ.198.OR.IDBOZ.EQ.199) THEN
22440 ELSEIF(IDBOZ.EQ.200) THEN
22444 CALL HWWARN('HWHGB1',500)
22448 C--smooth a Breit-Wigner only
22450 A02 = ATAN((MMIN-EMSQ)/GMBOZ)
22451 A2 = ATAN((MMAX-EMSQ)/GMBOZ)-A02
22453 FJAC = GMBOZ/((MBOS2-EMSQ)**2+GMBOZ**2)/A2
22455 MBOS2 = EMSQ+GMBOZ*TAN(A02+A2*HWRGEN(1))
22456 FJAC = A2*((MBOS2-EMSQ)**2+GMBOZ**2)/GMBOZ
22458 C--smooth a powerlaw only
22459 ELSEIF(ISM.EQ.2) THEN
22460 IF(EMPOW.EQ.TWO) THEN
22464 FJAC = ONE/MBOS2/A1
22466 MBOS2 = EXP(A01+A1*HWRGEN(2))
22474 A1 = (MMAX**QPOW-A01)
22476 FJAC = QPOW*MBOS2**MPOW/A1
22478 MBOS2 = (A01+A1*HWRGEN(2))**RPOW
22479 FJAC = A1*RPOW/MBOS2**MPOW
22483 CALL HWWARN('HWHGB1',501)
22487 *CMZ :- -02/04/01 12.11.55 by Peter Richardson
22488 *-- Author : Peter Richardson
22489 C-----------------------------------------------------------------------
22490 SUBROUTINE HWHGB2(HCS,IDP,PHOTON)
22491 C-----------------------------------------------------------------------
22492 C WW cross section in hadron hadron
22493 C-----------------------------------------------------------------------
22494 INCLUDE 'herwig65.inc'
22495 DOUBLE PRECISION HCS,RCS,HWRGEN,DIST(2),CFAC,WAMP(2),S34,S56,KWW2,
22496 & MW2,MZ2,GMW,GMZ,G(4,2),EE(4),CKM2(12),RF(2),LF(2),TAUI(2),
22498 DOUBLE COMPLEX ZH,ZCH,ZD,Z1,Z2,ZHF,P12,Z12,S134,S156,AWW,BWW,
22499 & CWW,DWW,AWWM(2),AWWP(2),HWHEW4
22500 INTEGER IDP(10),I,I1,I2,MAPZ(4,3),P1,P2,P3,P4
22501 PARAMETER(Z1=(0.0D0,1.0D0),Z2=(2.0D0,0.0D0),
22502 & ZHF=(0.5D0,0.0D0))
22504 EXTERNAL HWRGEN,HWHEW4
22505 COMMON/HWHEWQ/ZH(8,8),ZCH(8,8),ZD(8,8)
22506 COMMON /HWHGBC/ MW2,MZ2,GMW,GMZ,G,EE,CKM2,RF,LF,TAUI,CSW,CFAC1
22507 SAVE WAMP,AWWM,AWWP
22509 DATA MAPZ/1,2,121,122,3,4,123,125,5,6,124,126/
22511 RCS = HCS*HWRGEN(1)
22513 C--Now calculate the matrix element
22514 Z12 = ONE/(Z2*ZD(1,2)-MZ2+Z1*GMZ)
22515 P12 = ZHF*(Z2*ZD(1,2)-MZ2)*Z12/ZD(1,2)
22516 S134 = ZHF*(Z2*ZD(1,2)-MZ2)*Z12/(ZD(1,3)+ZD(1,4)+ZD(3,4))
22517 S156 = ZHF*(Z2*ZD(1,2)-MZ2)*Z12/(ZD(1,5)+ZD(1,6)+ZD(5,6))
22518 S34 = DBLE(Z2*ZD(3,4))
22519 S56 = DBLE(Z2*ZD(5,6))
22520 KWW2 = ONE/((S34-MW2)**2+GMW**2)/((S56-MW2)**2+GMW**2)
22523 DWW = LF(I)*Z12-RF(I)*P12
22524 CWW = RF(I)*(Z12-P12)
22525 AWW = DWW + ZHF*S134*(TAUI(I)+ONE)
22526 BWW = DWW + ZHF*S156*(TAUI(I)-ONE)
22527 AWWM(I) = AWW*HWHEW4(1,2,3,4,5,6)-BWW*HWHEW4(1,2,5,6,3,4)
22528 AWWP(I) = CWW*(HWHEW4(2,1,5,6,3,4)-HWHEW4(2,1,3,4,5,6))
22529 WAMP(I) = KWW2*DBLE( AWWM(I)*DCONJG(AWWM(I))
22530 & +AWWP(I)*DCONJG(AWWP(I)))
22534 CFAC = CFAC1*81.0D0
22537 IDP(1) = MAPZ(I,I1)
22539 DIST(1)=DISF(IDP(1),1)*DISF(IDP(2),2)
22540 DIST(2)=DISF(IDP(2),1)*DISF(IDP(1),2)
22542 HCS = HCS+DIST(I2)*CFAC*WAMP(I)
22543 IF(GENEV.AND.HCS.GT.RCS) THEN
22544 C--new for spin correlations
22551 10 MESPN(P1,P2,P3,P4,1,1) = (0.0D0,0.0D0)
22552 MESPN(1,2,2,1,1,1) = AWWP(I)
22553 MESPN(2,2,2,1,1,1) = AWWM(I)
22555 SPNCFC(1,1,1) = ONE
22567 *CMZ :- -02/04/01 12.11.55 by Peter Richardson
22568 *-- Author : Peter Richardson
22569 C-----------------------------------------------------------------------
22570 SUBROUTINE HWHGB3(HCS,IDP,PHOTON)
22571 C-----------------------------------------------------------------------
22572 C ZZ cross section in hadron hadron
22573 C-----------------------------------------------------------------------
22574 INCLUDE 'herwig65.inc'
22575 DOUBLE PRECISION AMP(2),RCS,HCS,HWRGEN,DIST(2),S34,S56,CFAC,
22576 & MW2,MZ2,GMW,GMZ,G(4,2),EE(4),CKM2(12),RF(2),LF(2),TAUI(2),
22578 DOUBLE COMPLEX ZH,ZCH,ZD,P34,P56,Z34,Z56,Z1,ZAMP(8),S134,S156,
22579 & HWHEW4,TAMP,Z0,AMPT(2,2,2,2),CP
22580 INTEGER I,P1,P2,P3,IDP(10),I2,MAPZ(4,3),I1,ID(2),O(2)
22581 EXTERNAL HWHEW4,HWRGEN
22583 COMMON/HWHEWQ/ZH(8,8),ZCH(8,8),ZD(8,8)
22584 COMMON /HWHGBC/ MW2,MZ2,GMW,GMZ,G,EE,CKM2,RF,LF,TAUI,CSW,CFAC1
22585 PARAMETER(Z0=(0.0D0,0.0D0),Z1=(0.0D0,1.0D0))
22588 DATA MAPZ/1,2,121,122,3,4,123,125,5,6,124,126/
22592 RCS = HCS*HWRGEN(0)
22594 C--Identitiys of the decay prodcucts (d=1,u=2,e=3,nu=4)
22597 IF(ID(I).GE.121) ID(I) = ID(I)-114
22598 ID(I) = MOD(ID(I)+1,2)+2*INT((ID(I)-1)/6)+1
22600 C--the various propagators we need
22601 S34 = TWO*DBLE(ZD(3,4))
22602 S56 = TWO*DBLE(ZD(5,6))
22603 Z34 = ONE/(S34-MZ2+Z1*GMZ)
22604 Z56 = ONE/(S56-MZ2+Z1*GMZ)
22606 P34 = Z34*(S34-MZ2)/S34
22607 P56 = Z56*(S56-MZ2)/S56
22612 S134 = HALF/(ZD(1,3)+ZD(1,4)+ZD(3,4))
22613 S156 = HALF/(ZD(1,5)+ZD(1,6)+ZD(5,6))
22614 C--Now calculate the amplitudes
22615 ZAMP(1)=HWHEW4(1,2,3,4,5,6)*S134+HWHEW4(1,2,5,6,3,4)*S156
22616 ZAMP(2)=HWHEW4(1,2,4,3,5,6)*S134+HWHEW4(1,2,5,6,4,3)*S156
22617 ZAMP(3)=HWHEW4(1,2,3,4,6,5)*S134+HWHEW4(1,2,6,5,3,4)*S156
22618 ZAMP(4)=HWHEW4(1,2,4,3,6,5)*S134+HWHEW4(1,2,6,5,4,3)*S156
22619 ZAMP(5)=HWHEW4(2,1,3,4,5,6)*S156+HWHEW4(2,1,5,6,3,4)*S134
22620 ZAMP(6)=HWHEW4(2,1,4,3,5,6)*S156+HWHEW4(2,1,5,6,4,3)*S134
22621 ZAMP(7)=HWHEW4(2,1,3,4,6,5)*S156+HWHEW4(2,1,6,5,3,4)*S134
22622 ZAMP(8)=HWHEW4(2,1,4,3,6,5)*S156+HWHEW4(2,1,6,5,4,3)*S134
22623 C--Now the amplitudes squared for the process
22630 CP = G(I,P1)**2*G(ID(1),P2)*G(ID(2),P3)*Z34*Z56
22631 & +G(I,P1)*EE(I)*G(ID(1),P2)*EE(ID(2))*Z34*P56
22632 & +G(I,P1)*EE(I)*EE(ID(1))*G(ID(2),P3)*P34*Z56
22633 & +EE(I)**2*EE(ID(1))*EE(ID(2))*P34*P56
22635 CP = G(I,P1)**2*G(ID(1),P2)*G(ID(2),P3)*Z34*Z56
22637 AMPT(I,P1,P2,P3) = ZAMP(4*P1+2*P3+P2-6)*CP
22638 TAMP = TAMP+AMPT(I,P1,P2,P3)*DCONJG(AMPT(I,P1,P2,P3))
22642 AMP(I) = HALF*DBLE(TAMP)
22645 C--Now calculate the cross section
22648 IF(ID(1).LE.2) CFAC = CFAC*THREE
22649 IF(ID(2).LE.2) CFAC = CFAC*THREE
22652 IDP(1) = MAPZ(I,I1)
22653 IDP(2) = MAPZ(I,I1)+6
22654 DIST(1)=DISF(IDP(1),1)*DISF(IDP(2),2)
22655 DIST(2)=DISF(IDP(2),1)*DISF(IDP(1),2)
22657 HCS = HCS+CFAC*DIST(I2)*AMP(I)
22658 IF(GENEV.AND.HCS.GT.RCS) THEN
22659 C--New for spin correlations
22665 MESPN(P1,P2,P3,1,1,1) = AMPT(I,O(P1),O(P2),O(P3))
22666 10 MESPN(P1,P2,P3,2,1,1) = (0.0D0,0.0D0)
22668 SPNCFC(1,1,1) = ONE
22680 *CMZ :- -02/04/01 12.11.55 by Peter Richardson
22681 *-- Author : Peter Richardson
22682 C-----------------------------------------------------------------------
22683 SUBROUTINE HWHGB4(HCS,IDP,PHOTON)
22684 C-----------------------------------------------------------------------
22685 C WZ cross section in hadron hadron
22686 C-----------------------------------------------------------------------
22687 INCLUDE 'herwig65.inc'
22688 DOUBLE PRECISION AMP(2),HCS,RCS,HWRGEN,W34,DIST(2),S34,S56,CFAC,
22689 & TCS,S12,MW2,MZ2,GMW,GMZ,G(4,2),EE(4),CKM2(12),RF(2),LF(2),
22690 & TAUI(2),CSW,CFAC1
22691 DOUBLE COMPLEX ZH,ZCH,ZD,P56,Z56,Z1,Z0,S134,S156,HWHEW4,
22692 & CP(4),W12,F(4),TAMP(2,2)
22693 INTEGER IDP(10),I,J,I1,I2,ID,P1,P2,P3,P4
22695 EXTERNAL HWRGEN,HWHEW4
22696 COMMON/HWHEWQ/ZH(8,8),ZCH(8,8),ZD(8,8)
22697 COMMON /HWHGBC/ MW2,MZ2,GMW,GMZ,G,EE,CKM2,RF,LF,TAUI,CSW,CFAC1
22698 PARAMETER(Z0=(0.0D0,0.0D0),Z1=(0.0D0,1.0D0))
22701 RCS = HCS*HWRGEN(1)
22703 C--identity of the Z decay product (d=1,u=2,e=3,nu=4)
22705 IF(ID.GE.121) ID = ID-114
22706 ID = MOD(ID+1,2)+2*INT((ID-1)/6)+1
22707 C--the various propagators we need
22708 S12 = TWO*DBLE(ZD(1,2))
22709 S34 = TWO*DBLE(ZD(3,4))
22710 S56 = TWO*DBLE(ZD(5,6))
22711 Z56 = ONE/(S56-MZ2+Z1*GMZ)
22713 P56 = Z56*(S56-MZ2)/S56
22717 W12 = ONE/(S12-MW2+Z1*GMW)
22718 S134 = HALF*W12*(S12-MW2)/(ZD(1,3)+ZD(1,4)+ZD(3,4))
22719 S156 = HALF*W12*(S12-MW2)/(ZD(1,5)+ZD(1,6)+ZD(5,6))
22720 W34 = ONE/((S34-MW2)**2+GMW**2)/SWEIN**2/FOUR
22721 C--calculate the coefficents of the various amplitudes
22722 F(1) = HWHEW4(1,2,3,4,5,6)
22723 F(2) = HWHEW4(1,2,5,6,3,4)
22724 F(3) = HWHEW4(1,2,3,4,6,5)
22725 F(4) = HWHEW4(1,2,6,5,3,4)
22732 CP(1) = G(J,1)*S134-TAUI(I)*CSW*W12
22733 CP(2) = G(I,1)*S156+TAUI(I)*CSW*W12
22735 CP(3) = EE(J)*S134-TAUI(I)*W12
22736 CP(4) = EE(I)*S156+TAUI(I)*W12
22741 TAMP(I,1) = F(1)*(G(ID,1)*Z56*CP(1)+EE(ID)*P56*CP(3))
22742 & +F(2)*(G(ID,1)*Z56*CP(2)+EE(ID)*P56*CP(4))
22743 TAMP(I,2) = F(3)*(G(ID,2)*Z56*CP(1)+EE(ID)*P56*CP(3))
22744 & +F(4)*(G(ID,2)*Z56*CP(2)+EE(ID)*P56*CP(4))
22745 AMP(I) = W34*DBLE( TAMP(I,1)*DCONJG(TAMP(I,1))
22746 & +TAMP(I,2)*DCONJG(TAMP(I,2)))
22749 C--Now calculate the cross section
22752 IF(ID.LE.2) CFAC = CFAC*THREE
22763 C**Bug fix 2/7/01 by BRW (unsquare)
22770 DIST(1) = TCS*DISF(IDP(1),1)*DISF(IDP(2),2)
22771 DIST(2) = TCS*DISF(IDP(2),1)*DISF(IDP(1),2)
22773 HCS = HCS+CFAC*DIST(I2)*AMP(I)
22774 IF(GENEV.AND.HCS.GT.RCS) GOTO 900
22779 900 IF(GENEV.AND.I2.EQ.2) THEN
22784 IF(SYSPIN.AND.GENEV) THEN
22790 10 MESPN(P1,P2,P3,P4,1,1) = (0.0D0,0.0D0)
22791 MESPN(2 ,2 ,1 ,1 ,1,1) = TAMP(I,2)
22792 MESPN(2 ,2 ,2 ,1 ,1,1) = TAMP(I,1)
22794 SPNCFC(1,1,1) = ONE
22798 *CMZ :- -02/04/01 12.11.55 by Peter Richardson
22799 *-- Author : Peter Richardson
22800 C-----------------------------------------------------------------------
22801 SUBROUTINE HWHGB5(IOPT,FJAC,T,TMAX,TMIN)
22802 C-----------------------------------------------------------------------
22803 C Subroutine to select t or u for HWHGBP
22804 C-----------------------------------------------------------------------
22805 INCLUDE 'herwig65.inc'
22807 DOUBLE PRECISION FJAC,TPOW,TMIN,T,A1,A01,RPOW,QPOW,HWRGEN,TMAX,TN,
22813 IF(TPOW.EQ.-ONE) THEN
22818 T = -TN*EXP(A1*HWRGEN(2))
22825 A1 = (TX**QPOW-A01)
22828 FJAC =QPOW*MT**TPOW/A1
22830 MT = (A01+A1*HWRGEN(2))**RPOW
22832 FJAC = A1*RPOW/MT**TPOW
22837 *CMZ :- -13/10/00 10:48:07 by Peter Richardson
22838 *-- Author Kosuke Odagiri
22839 C-----------------------------------------------------------------------
22841 C-----------------------------------------------------------------------
22842 C Massive spin-2 resonance (massive graviton)
22843 C Universal tensor coupling to the energy-momentum tensor is assumed
22844 C viz L = - G(mu,nu) T(mu,nu) / GRVLAM
22845 C If GAMGRV is zero, it is revaluated during the first run
22846 C MEAN EVWGT = SIGMA IN NB
22847 C-----------------------------------------------------------------------
22848 INCLUDE 'herwig65.inc'
22849 DOUBLE PRECISION HWRGEN,HWRUNI,EPS,EMSQG,
22850 & EMGMG,S,CC,SS,SS2,M1(16),M2(16),M3,M4,M5(3),M6(3),
22851 & RNGLU,FACT,HCS,FACTR,RCS,A2,A02,QPE,SQPE,RGRV
22852 INTEGER IMODE,JQMN,JQMX,JQ,JLMN,JLMX,JL,IQ,I,ID1,ID2,ID3,ID4,
22854 LOGICAL JGLU,JPHO,JW,JZ,JH
22855 EXTERNAL HWRGEN,HWRUNI
22856 SAVE HCS,JQMN,JQMX,JLMN,JLMX,JGLU,JPHO,JW,JZ,JH,EMSQG,EMGMG,
22857 & A2,A02,FACT,RNGLU,M1,M2,M3,M4,M5,M6
22858 PARAMETER (EPS=1.D-9)
22865 C Set limits for which particles to include
22875 IMODE=MOD(IPROC,100)
22876 IF (IMODE.EQ.0) THEN
22886 ELSEIF (IMODE.EQ.10) THEN
22890 ELSEIF (IMODE.GT.10.AND.IMODE.LE.16) THEN
22893 ELSEIF (IMODE.EQ.20) THEN
22895 ELSEIF (IMODE.EQ.50) THEN
22899 ELSEIF (IMODE.GT.50.AND.IMODE.LE.56) THEN
22902 ELSEIF (IMODE.EQ.60) THEN
22904 ELSEIF (IMODE.EQ.70) THEN
22908 ELSEIF (IMODE.EQ.71) THEN
22910 ELSEIF (IMODE.EQ.72) THEN
22912 ELSEIF (IMODE.EQ.73) THEN
22915 CALL HWWARN('HWHGRV',500)
22918 IF (GAMGRV.EQ.ZERO) THEN
22919 C Calculate the width if GAMGRV=ZERO.
22922 RGRV=(RMASS(JQ)/EMGRV)**2
22924 IF (QPE.GT.ZERO) THEN
22926 GAMGRV=GAMGRV+CAFAC*SQPE**3*(ONE+8.D0/3.D0*RGRV)/4.D0
22931 RGRV=(RMASS(JL)/EMGRV)**2
22933 IF (QPE.GT.ZERO) THEN
22935 GAMGRV=GAMGRV+SQPE**3*(ONE+8.D0/3.D0*RGRV)/4.D0
22941 GAMGRV=GAMGRV+HALF*RNGLU
22943 RGRV=(RMASS(200)/EMGRV)**2
22945 IF (QPE.GT.ZERO) THEN
22947 GAMGRV=GAMGRV+SQPE*
22948 & (13.D0/12.D0+14.D0/3.D0*RGRV+4.D0*RGRV**2)/TWO
22951 RGRV=(RMASS(198)/EMGRV)**2
22953 IF (QPE.GT.ZERO) THEN
22955 GAMGRV=GAMGRV+SQPE*
22956 & (13.D0/12.D0+14.D0/3.D0*RGRV+4.D0*RGRV**2)
22959 RGRV=(RMASS(201)/EMGRV)**2
22961 IF (QPE.GT.ZERO) THEN
22963 GAMGRV=GAMGRV+SQPE**5/12.D0/TWO
22965 GAMGRV=GAMGRV*EMGRV**3/(GRVLAM**2*40.D0*PIFAC)
22969 A02=ATAN((EMMIN**2-EMSQG)/EMGMG)
22970 A2 =ATAN((EMMAX**2-EMSQG)/EMGMG)-A02
22973 C Select a mass for the produced pair
22974 S=EMSQG+EMGMG*TAN(A02+A2*HWRGEN(1))
22976 C Select initial momentum fractions
22977 XXMIN=S/PHEP(5,3)**2
22979 CALL HWSGEN(.TRUE.)
22980 COSTH=HWRUNI(0,-ONE,ONE)
22982 FACT=-GEV2NB*A2*XLMIN*S**2/(GRVLAM**4*EMGMG*16.D0*PIFAC)
22990 QPE=ONE-4.D0*RMASS(JQ)**2/S
22991 IF (QPE.GT.ZERO) THEN
22993 M1(JQ)=SQPE*QPE*(ONE+CC-4.D0*QPE*SS*CC)/64.D0/CAFAC
22994 M2(JQ)=SQPE*QPE*SS*(TWO-QPE*SS)/16.D0/RNGLU
22999 QPE=ONE-4.D0*RMASS(JL+110)**2/S
23000 IF (QPE.GT.ZERO) THEN
23002 M1(JL)=SQPE*QPE*(ONE+CC-4.D0*QPE*SS*CC)/64.D0/CAFAC
23003 M2(JL)=SQPE*QPE*SS*(TWO-QPE*SS)/16.D0/RNGLU
23009 C QQ,GG -> BB (massless)
23010 M3=SS*(ONE+CC)/32.D0/CAFAC
23011 M4=(CC+SS2/8.D0)/4.D0/RNGLU
23013 QPE=ONE-4.D0*RMASS(198)**2/S
23014 IF (QPE.GT.ZERO) THEN
23016 M5(1)=SQPE*(ONE-.5D0*QPE*(ONE+CC)+.75D0*QPE**2*CC*SS)/8.D0/CAFAC
23017 M6(1)=SQPE*(ONE-QPE*SS+3.D0*QPE**2*SS2/16.D0)/2.D0/RNGLU
23022 QPE=ONE-4.D0*RMASS(200)**2/S
23023 IF (QPE.GT.ZERO) THEN
23025 M5(2)=SQPE*(ONE-.5D0*QPE*(ONE+CC)+.75D0*QPE**2*CC*SS)/16.D0/CAFAC
23026 M6(2)=SQPE*(ONE-QPE*SS+3.D0*QPE**2*SS2/16.D0)/4.D0/RNGLU
23031 QPE=ONE-4.D0*RMASS(201)**2/S
23032 IF (QPE.GT.ZERO) THEN
23034 M5(3)=SQPE*(QPE**2*SS*CC)/64.D0/CAFAC
23035 M6(3)=SQPE*(QPE**2*SS2)/64.D0/RNGLU
23043 C I=1 quark first, I=2 anti-quark first
23047 IF (DISF(ID1,1).LT.EPS.OR.DISF(ID2,2).LT.EPS) GOTO 80
23048 FACTR=FACT*DISF(ID1,1)*DISF(ID2,2)
23049 C Quark final states
23053 HCS=HCS+FACTR*M1(JQ)*CAFAC
23054 IF (GENEV.AND.HCS.GT.RCS) THEN
23055 CALL HWHQCP(ID3,ID4,2143,50)
23059 C Lepton final states
23063 HCS=HCS+FACTR*M1(JL)
23064 IF (GENEV.AND.HCS.GT.RCS) THEN
23065 CALL HWHQCP(ID3,ID4,2134,50)
23069 C Bosonic final states
23074 IF (GENEV.AND.HCS.GT.RCS) THEN
23075 CALL HWHQCP(ID3,ID4,2134,50)
23082 HCS=HCS+FACTR*M5(1)
23083 IF (GENEV.AND.HCS.GT.RCS) THEN
23084 CALL HWHQCP(ID3,ID4,2134,50)
23091 HCS=HCS+FACTR*M5(2)
23092 IF (GENEV.AND.HCS.GT.RCS) THEN
23093 CALL HWHQCP(ID3,ID4,2134,50)
23100 HCS=HCS+FACTR*M5(3)
23101 IF (GENEV.AND.HCS.GT.RCS) THEN
23102 CALL HWHQCP(ID3,ID4,2134,50)
23109 HCS=HCS+FACTR*M3*RNGLU
23110 IF (GENEV.AND.HCS.GT.RCS) THEN
23111 CALL HWHQCP(ID3,ID4,2143,50)
23117 C Gluon initial states
23120 IF (DISF(ID1,1).LT.EPS.OR.DISF(ID2,2).LT.EPS) GOTO 30
23121 FACTR=FACT*DISF(ID1,1)*DISF(ID2,2)
23122 C Quark final states
23126 HCS=HCS+FACTR*M2(JQ)*CAFAC
23127 IF (GENEV.AND.HCS.GT.RCS) THEN
23128 CALL HWHQCP(ID3,ID4,2143,51)
23132 C Lepton final states
23136 HCS=HCS+FACTR*M2(JL)
23137 IF (GENEV.AND.HCS.GT.RCS) THEN
23138 CALL HWHQCP(ID3,ID4,2134,51)
23142 C Vector boson final states
23147 IF (GENEV.AND.HCS.GT.RCS) THEN
23148 CALL HWHQCP(ID3,ID4,2134,51)
23155 HCS=HCS+FACTR*M6(1)
23156 IF (GENEV.AND.HCS.GT.RCS) THEN
23157 CALL HWHQCP(ID3,ID4,2134,51)
23164 HCS=HCS+FACTR*M6(2)
23165 IF (GENEV.AND.HCS.GT.RCS) THEN
23166 CALL HWHQCP(ID3,ID4,2134,51)
23173 HCS=HCS+FACTR*M6(3)
23174 IF (GENEV.AND.HCS.GT.RCS) THEN
23175 CALL HWHQCP(ID3,ID4,2134,51)
23182 HCS=HCS+FACTR*M4*RNGLU
23183 IF (GENEV.AND.HCS.GT.RCS) THEN
23184 CALL HWHQCP(ID3,ID4,2143,51)
23195 CALL HWETWO(.TRUE.,.TRUE.)
23197 C Calculate coefficients for constructing spin density matrices
23198 C Set to zero for now
23199 CALL HWVZRO(7,GCOEF)
23203 *CMZ :- -16/07/02 09.40.25 by Peter Richardson
23204 *-- Author : Peter Richardson
23205 C----------------------------------------------------------------------
23207 C----------------------------------------------------------------------
23208 C Use the GUPI (Generic User Process Interface) event common block
23209 C as the hard process for HERWIG
23210 C----------------------------------------------------------------------
23211 INCLUDE 'herwig65.inc'
23212 C--Les Houches Common Block
23214 PARAMETER(MAXPUP=100)
23215 INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP
23216 DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP
23217 COMMON /HEPRUP/ IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2),
23218 & IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),
23219 & XMAXUP(MAXPUP),LPRUP(MAXPUP)
23221 PARAMETER (MAXNUP=500)
23222 INTEGER NUP,IDPRUP,IDUP,ISTUP,MOTHUP,ICOLUP
23223 DOUBLE PRECISION XWGTUP,SCALUP,AQEDUP,AQCDUP,PUP,VTIMUP,SPINUP
23224 COMMON/HEPEUP/NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP,
23225 & IDUP(MAXNUP),ISTUP(MAXNUP),MOTHUP(2,MAXNUP),
23226 & ICOLUP(2,MAXNUP),PUP(5,MAXNUP),VTIMUP(MAXNUP),
23229 COMMON /HWGUP/ILOC(NMXHEP),JLOC(MAXNUP)
23230 INTEGER ILOC,JLOC,JHEP,ID
23231 INTEGER IHEP,IDIN(2),I,IDRES(2,MAXPUP),IRES,ICMF,ISTART,JRES,J
23232 DOUBLE PRECISION PTEMP(5)
23237 C--zero the variables
23244 c---generate hard subprocess
23245 C--now do the event selection bit
23246 IF(.NOT.GENEV) THEN
23247 IDPRUP = LPRUP(ITYPLH)
23249 IF(ABS(IDWTUP).EQ.1.OR.ABS(IDWTUP).EQ.2.OR.
23250 & ABS(IDWTUP).EQ.4) THEN
23251 EVWGT = XWGTUP*1.0D-3
23252 ELSEIF(ABS(IDWTUP).EQ.3) THEN
23253 EVWGT = SIGN(ONE,XWGTUP)
23255 CALL HWWARN('HWHGUP',510)
23257 C--check the sign of the weight
23258 IF(IDWTUP.GT.ZERO.AND.EVWGT.LT.ZERO) CALL HWWARN('HWHGUP',520)
23261 C--update the number of events
23262 LHNEVT(ITYPLH) = LHNEVT(ITYPLH)+1
23264 C--first search to see if there are incoming beam particles in the record
23267 IF(ISTUP(IHEP).EQ.-9) THEN
23270 CALL HWWARN('HWHGUP',102)
23276 C--put the beam particles in the record
23277 C--require the soft event
23278 GENSOF = LHSOFT.AND.HWRLOG(PRSOF)
23279 C--if given for event from event common block
23282 C--otherwise from the process common block
23283 ELSEIF(I.EQ.0) THEN
23285 CALL HWUIDT(1,IDBMUP(I),IDHW(I),DUMMY)
23288 PHEP(4,I) = EBMUP(I)
23289 PHEP(5,I) = RMASS(IDHW(I))
23290 PHEP(3,I) = SQRT(EBMUP(I)**2-RMASS(IDHW(I))**2)
23293 PHEP(3,2) = -PHEP(3,2)
23295 C--if not correct issue warning
23297 CALL HWWARN('HWHGUP',103)
23300 C--setup the centre-of-mass energy
23301 CALL HWVSUM(4,PHEP(1,NHEP-1),PHEP(1,NHEP),PHEP(1,NHEP+1))
23302 CALL HWUMAS(PHEP(1,NHEP+1))
23303 JMOHEP(1,NHEP+1) = NHEP-1
23304 JMOHEP(2,NHEP+1) = NHEP
23308 C--search for the incoming particles in collision
23311 IF(ISTUP(IHEP).EQ.-1) THEN
23314 CALL HWWARN('HWHGUP',100)
23320 C--require two incoming particles
23322 CALL HWWARN('HWHGUP',101)
23325 C--Now write these particles into the event record
23327 IDHEP(NHEP+I) = IDUP(IDIN(I))
23328 ISTHEP(NHEP+I) = 110+I
23329 CALL HWUIDT(1,IDUP(IDIN(I)),IDHW(NHEP+I),DUMMY)
23330 CALL HWVEQU(5,PUP(1,IDIN(I)),PHEP(1,NHEP+I))
23331 JMOHEP(1,NHEP+I) = NHEP+3
23332 ILOC(NHEP+I) = IDIN(I)
23334 C--special for pairtcles which are identical to the beam
23336 IF(IDHEP(NHEP+I).EQ.IDHEP(J)) THEN
23337 JDAHEP(1,J) = NHEP+I
23338 JDAHEP(2,J) = NHEP+I
23342 CALL HWVSUM(4,PHEP(1,NHEP+1),PHEP(1,NHEP+2),PHEP(1,NHEP+3))
23343 CALL HWUMAS(PHEP(1,NHEP+3))
23344 C--add the hard entry
23346 ISTHEP(NHEP+3) = 110
23347 JMOHEP(1,NHEP+3) = NHEP+1
23348 JMOHEP(2,NHEP+3) = NHEP+2
23349 JDAHEP(1,NHEP+3) = NHEP+4
23352 C--now search for the outgoing particles and add them to the event record
23354 C--normal outgoing particles
23355 IF(ISTUP(I).EQ.1.AND.
23356 & (MOTHUP(1,I).EQ.IDIN(1).OR.MOTHUP(1,I).EQ.IDIN(2))) THEN
23358 IDHEP(NHEP) = IDUP(I)
23359 CALL HWUIDT(1,IDUP(I),IDHW(NHEP),DUMMY)
23360 CALL HWVEQU(5,PUP(1,I),PHEP(1,NHEP))
23361 JMOHEP(1,NHEP) = ICMF
23366 C--resonances which must have mass preserved and resonances
23367 C-- which don't have to have mass preserved
23368 C--for the time being we won't disguish between these two options
23369 ELSEIF((ISTUP(I).EQ.2.OR.ISTUP(I).EQ.3).AND.
23370 & (MOTHUP(1,I).EQ.IDIN(1).OR.MOTHUP(1,I).EQ.IDIN(2))) THEN
23372 IDHEP(NHEP) = IDUP(I)
23373 CALL HWUIDT(1,IDUP(I),IDHW(NHEP),DUMMY)
23374 CALL HWVEQU(5,PUP(1,I),PHEP(1,NHEP))
23376 IDRES(1,IRES) = NHEP
23378 JMOHEP(1,NHEP) = ICMF
23383 ELSEIF(ISTUP(I).NE.-9.AND.ISTUP(I).NE.-1.AND.ISTUP(I).NE.1.AND.
23384 & ISTUP(I).NE.2.AND.ISTUP(I).NE.3) THEN
23385 CALL HWWARN('HWHGUP',500)
23388 C--Modified 2/7/03 for 2->1 processes
23389 IF(ICMF+1.EQ.NHEP) THEN
23391 IDHEP(NHEP) = IDHEP(NHEP+1)
23393 IDHW(NHEP) = IDHW(NHEP+1)
23395 CALL HWVEQU(5,PHEP(1,NHEP+1),PHEP(1,NHEP))
23396 JMOHEP(1,NHEP+1) = 0
23397 JMOHEP(2,NHEP+1) = 0
23398 JDAHEP(1,NHEP+1) = 0
23399 JDAHEP(2,NHEP+1) = 0
23400 JDAHEP(1,NHEP ) = NHEP
23401 JDAHEP(2,NHEP ) = NHEP
23402 ILOC(NHEP) = ILOC(NHEP+1)
23404 JLOC(ILOC(NHEP)) = NHEP
23407 IF(IDRES(1,IRES).EQ.NHEP+1) IDRES(1,IRES) = NHEP
23410 JDAHEP(2,ICMF) = NHEP
23411 C--setup the status codes
23412 ISTHEP(ICMF+1) = 113
23413 DO IHEP=ICMF+2,NHEP
23420 C--generate parton shower
23421 CALL HWBGUP(ISTART,ICMF)
23422 C--now we need to sort out the resonances
23423 IF(IRES.EQ.0) RETURN
23425 35 ID = IDHEP(IDRES(1,JRES))
23426 36 IF(JDAHEP(1,IDRES(1,JRES)).NE.0.AND.
23427 & JDAHEP(1,IDRES(1,JRES)).NE.IDRES(1,JRES)) THEN
23428 IF(IDHEP(IDRES(1,JRES)).EQ.94) THEN
23429 DO IHEP=JDAHEP(1,IDRES(1,JRES)),JDAHEP(2,IDRES(1,JRES))
23430 IF(IDHEP(IHEP).EQ.ID) THEN
23431 IDRES(1,JRES) = IHEP
23436 IDRES(1,JRES) = JDAHEP(1,IDRES(1,JRES))
23440 C--make a copy of this particle
23441 IHEP = IDRES(1,JRES)
23442 JMOHEP(1,NHEP+1) = JMOHEP(1,IDRES(1,JRES))
23443 JMOHEP(2,NHEP+1) = JMOHEP(2,IDRES(1,JRES))
23444 IDHEP(NHEP+1) = IDHEP(IDRES(1,JRES))
23445 IDHW(NHEP+1) = IDHW(IDRES(1,JRES))
23446 CALL HWVEQU(5,PHEP(1,IDRES(1,JRES)),PHEP(1,NHEP+1))
23447 IDRES(1,JRES) = NHEP+1
23448 JLOC(IDRES(2,JRES)) = IDRES(1,JRES)
23449 ISTHEP(NHEP+1) = 155
23451 C Reset colour pointers (if set)
23452 JHEP=JMOHEP(2,IHEP)
23453 IF (JHEP.GT.0) THEN
23454 IF (JDAHEP(2,JHEP).EQ.IHEP) JDAHEP(2,JHEP)=NHEP
23455 IF(.NOT.RPARTY.AND.ISTHEP(JHEP).EQ.155
23456 & .AND.ABS(IDHEP(JHEP)).GT.1000000
23457 & .AND.JDAHEP(2,JHEP-1).EQ.IHEP) JDAHEP(2,JHEP-1) = NHEP
23459 JHEP=JDAHEP(2,IHEP)
23460 IF (JHEP.GT.0) THEN
23461 IF (JMOHEP(2,JHEP).EQ.IHEP) JMOHEP(2,JHEP)=NHEP
23462 IF(.NOT.RPARTY.AND.ISTHEP(JHEP).EQ.155
23463 & .AND.ABS(IDHEP(JHEP)).GT.1000000
23464 & .AND.JMOHEP(2,JHEP-1).EQ.IHEP) JMOHEP(2,JHEP-1) = NHEP
23466 C Relabel original track
23467 IF (ISTHEP(IHEP).NE.120) ISTHEP(IHEP)=3
23468 JMOHEP(2,IHEP)=JMOHEP(1,IHEP)
23469 JDAHEP(1,IHEP)=NHEP
23470 JDAHEP(2,IHEP)=NHEP
23471 C--look for all the particles which have this as a mother
23472 C--now search for the outgoing particles and add them to the event record
23473 JDAHEP(1,NHEP) = NHEP+1
23474 ISTHEP(NHEP+1) = 113
23476 IF(ISTUP(I).EQ.1.AND.MOTHUP(1,I).EQ.IDRES(2,JRES)) THEN
23478 IDHEP(NHEP) = IDUP(I)
23479 CALL HWUIDT(1,IDUP(I),IDHW(NHEP),DUMMY)
23480 CALL HWULOF(PUP(1,IDRES(2,JRES)),PUP(1,I),PHEP(1,NHEP))
23481 CALL HWULOB(PHEP(1,IDRES(1,JRES)),PHEP(1,NHEP),PHEP(1,NHEP))
23482 JMOHEP(1,NHEP) = IDRES(1,JRES)
23487 ELSEIF((ISTUP(I).EQ.2.OR.ISTUP(I).EQ.3).AND.
23488 & MOTHUP(1,I).EQ.IDRES(2,JRES)) THEN
23490 IDHEP(NHEP) = IDUP(I)
23491 CALL HWUIDT(1,IDUP(I),IDHW(NHEP),DUMMY)
23492 CALL HWULOF(PUP(1,IDRES(2,JRES)),PUP(1,I),PHEP(1,NHEP))
23493 CALL HWULOB(PHEP(1,IDRES(1,JRES)),PHEP(1,NHEP),PHEP(1,NHEP))
23495 IDRES(1,IRES) = NHEP
23497 JMOHEP(1,NHEP) = IDRES(1,JRES)
23504 C--special for top decays to ensure b is second and W is first, this seems
23505 C--to cause problems if the order is the other way around
23506 IF(ABS(IDHEP(IDRES(1,JRES))).EQ.6.AND.
23507 & NHEP-IDRES(1,JRES).EQ.2) THEN
23508 IF(ABS(IDHEP(NHEP-1)).EQ.5) THEN
23510 CALL HWVEQU(5,PHEP(1,NHEP),PTEMP)
23511 CALL HWVEQU(5,PHEP(1,NHEP-1),PHEP(1,NHEP))
23512 CALL HWVEQU(5,PTEMP,PHEP(1,NHEP-1))
23515 IDHW(NHEP) = IDHW(NHEP-1)
23518 IDHEP(NHEP) = IDHEP(NHEP-1)
23522 ILOC(NHEP) = ILOC(NHEP-1)
23524 JLOC(ILOC(NHEP-1)) = NHEP-1
23525 JLOC(ILOC(NHEP)) = NHEP
23528 IF(IDRES(1,I).EQ.NHEP) IDRES(1,I) = NHEP-1
23532 DO IHEP=IDRES(1,JRES)+2,NHEP
23535 JDAHEP(2,IDRES(1,JRES)) = NHEP
23536 ISTART = IDRES(1,JRES)
23537 EMSCA = PHEP(4,IDRES(1,JRES))
23538 CALL HWBGUP(ISTART,0)
23539 IF(JRES.NE.IRES) THEN
23546 *CMZ :- -18/05/99 14.55.44 by Kosuke Odagiri
23547 *-- Author : Bryan Webber
23548 C-----------------------------------------------------------------------
23550 C-----------------------------------------------------------------------
23551 C QCD HEAVY FLAVOUR PRODUCTION: MEAN EVWGT = SIGMA IN NB
23552 C-----------------------------------------------------------------------
23553 INCLUDE 'herwig65.inc'
23554 DOUBLE PRECISION HWRGEN,HWRUNI,HWUALF,EPS,RCS,Z1,Z2,ET,EJ,
23555 & QM2,QPE,FACTR,S,T,U,ST,TU,US,TUS,UST,EN,RN,AF,ASTU,
23556 & AUST,CF,CN,CS,CSTU,CSUT,CTSU,CTUS,HCS,UT,SU,GT,DIST,KK,KK2,
23557 & YJ1INF,YJ1SUP,YJ2INF,YJ2SUP
23558 INTEGER IQ1,IQ2,ID1,ID2
23560 EXTERNAL HWRGEN,HWRUNI,HWUALF
23561 SAVE HCS,ASTU,AUST,CSTU,CSUT,CTSU,CTUS,S,T,TU,U,US
23562 PARAMETER (EPS=1.D-9)
23570 IF (KK.GE.ONE) RETURN
23571 YJ1INF = MAX( YJMIN, LOG((ONE-SQRT(ONE-KK2))/KK) )
23572 YJ1SUP = MIN( YJMAX, LOG((ONE+SQRT(ONE-KK2))/KK) )
23573 IF (YJ1INF.GE.YJ1SUP) RETURN
23574 Z1=EXP(HWRUNI(1,YJ1INF,YJ1SUP))
23575 YJ2INF = MAX( YJMIN, -LOG(TWO/KK-ONE/Z1) )
23576 YJ2SUP = MIN( YJMAX, LOG(TWO/KK-Z1) )
23577 IF (YJ2INF.GE.YJ2SUP) RETURN
23578 Z2=EXP(HWRUNI(2,YJ2INF,YJ2SUP))
23579 XX(1)=HALF*(Z1+Z2)*KK
23580 IF (XX(1).GE.ONE) RETURN
23581 XX(2)=XX(1)/(Z1*Z2)
23582 IF (XX(2).GE.ONE) RETURN
23583 S=XX(1)*XX(2)*PHEP(5,3)**2
23587 IF (QPE.LE.ZERO) RETURN
23588 COSTH=HALF*ET*(Z1-Z2)/SQRT(Z1*Z2*QPE)
23589 IF (ABS(COSTH).GT.ONE) RETURN
23590 C---REDEFINE S, T, U AS P1.P2, -P1.P3, -P1.P4
23592 T=-HALF*(1.+Z2/Z1)*(HALF*ET)**2
23594 C---SET EMSCA TO HEAVY HARD PROCESS SCALE
23595 EMSCA=SQRT(4.*S*T*U/(S*S+T*T+U*U))
23596 FACTR = GEV2NB*.125*PIFAC*EJ*ET*(HWUALF(1,EMSCA)/S)**2
23597 & *(YJ1SUP-YJ1INF)*(YJ2SUP-YJ2INF)
23598 CALL HWSGEN(.FALSE.)
23611 ASTU=AF*(1.-2.*UST+QM2/T)
23612 AUST=AF*(1.-2.*TUS+QM2/S)
23613 CF=FACTR/(2.*CFFAC)
23615 C-----------------------------------------------------------------------
23616 C---Heavy flavour colour decomposition modifications below (KO)
23617 C-----------------------------------------------------------------------
23618 CS=(TU+UT-CN/TUS)*(HALF-TUS+QM2/S-QM2**2/U/T/TWO)
23619 CSTU=CF*CS/(ONE+TU**2)
23620 CSUT=CF*CS/(ONE+UT**2)
23621 CS=(SU+US-CN/UST)*(HALF-UST+QM2/T-QM2**2/U/S/TWO)
23622 CTSU=-FACTR*CS/(ONE+SU**2)
23623 CTUS=-FACTR*CS/(ONE+US**2)
23624 C-----------------------------------------------------------------------
23625 C CS=HALF/TU-QM2/T-HALF*(QM2/T)**2
23626 C CSTU=CF*(CS- US**2-QM2/S - CN*(CS+QM2*QM2/(S*T)))
23627 C CS=HALF*TU-QM2/U-HALF*(QM2/U)**2
23628 C CSUT=CF*(CS-1./ST**2-QM2/S - CN*(CS+QM2*QM2/(S*U)))
23629 C CS=HALF*US-QM2/S-HALF*(QM2/S)**2
23630 C CTSU=-FACTR*(CS-1./TU**2-QM2/T - CN*(CS+QM2*QM2/(S*T)))
23631 C CS=HALF/US-QM2/U-HALF*(QM2/U)**2
23632 C CTUS=-FACTR*(CS- ST**2-QM2/T - CN*(CS+QM2*QM2/(T*U)))
23633 C-----------------------------------------------------------------------
23639 IF (DISF(ID1,1).LT.EPS) GOTO 6
23640 HQ1=ID1.EQ.IQ1.OR.ID1.EQ.IQ2
23642 IF (DISF(ID2,2).LT.EPS) GOTO 5
23643 HQ2=ID2.EQ.IQ1.OR.ID2.EQ.IQ2
23644 DIST=DISF(ID1,1)*DISF(ID2,2)
23645 IF (HQ1.OR.HQ2) THEN
23646 C---PROCESSES INVOLVING HEAVY CONSTITUENT
23647 C N.B. NEGLECT CASE THAT BOTH ARE HEAVY
23648 IF (HQ1.AND.HQ2) GOTO 5
23653 IF (GENEV.AND.HCS.GT.RCS) THEN
23654 CALL HWHQCP(ID1,ID2,3421, 3)
23657 ELSEIF (ID2.NE.13) THEN
23659 IF (GENEV.AND.HCS.GT.RCS) THEN
23660 CALL HWHQCP(ID1,ID2,3142, 9)
23665 IF (GENEV.AND.HCS.GT.RCS) THEN
23666 CALL HWHQCP(ID1,ID2,3142,10)
23670 IF (GENEV.AND.HCS.GT.RCS) THEN
23671 CALL HWHQCP(ID1,ID2,3421,11)
23675 ELSEIF (ID1.NE.13) THEN
23679 IF (GENEV.AND.HCS.GT.RCS) THEN
23680 CALL HWHQCP(ID1,ID2,2413,17)
23683 ELSEIF (ID2.NE.13) THEN
23685 IF (GENEV.AND.HCS.GT.RCS) THEN
23686 CALL HWHQCP(ID1,ID2,4312,20)
23691 IF (GENEV.AND.HCS.GT.RCS) THEN
23692 CALL HWHQCP(ID1,ID2,2413,21)
23696 IF (GENEV.AND.HCS.GT.RCS) THEN
23697 CALL HWHQCP(ID1,ID2,4312,22)
23705 IF (GENEV.AND.HCS.GT.RCS) THEN
23706 CALL HWHQCP(ID1,ID2,2413,23)
23710 IF (GENEV.AND.HCS.GT.RCS) THEN
23711 CALL HWHQCP(ID1,ID2,3421,24)
23714 ELSEIF (ID2.LT.13) THEN
23716 IF (GENEV.AND.HCS.GT.RCS) THEN
23717 CALL HWHQCP(ID1,ID2,3142,25)
23721 IF (GENEV.AND.HCS.GT.RCS) THEN
23722 CALL HWHQCP(ID1,ID2,4312,26)
23727 ELSEIF (ID2.NE.13.AND.ID2.EQ.ID1+6) THEN
23728 C---LIGHT Q-QBAR ANNIHILATION
23730 IF (GENEV.AND.HCS.GT.RCS) THEN
23731 CALL HWHQCP(IQ1,IQ2,2413, 4)
23734 ELSEIF (ID1.NE.13.AND.ID1.EQ.ID2+6) THEN
23735 C---LIGHT QBAR-Q ANNIHILATION
23737 IF (GENEV.AND.HCS.GT.RCS) THEN
23738 CALL HWHQCP(IQ2,IQ1,3142,12)
23741 ELSEIF (ID1.EQ.13.AND.ID2.EQ.13) THEN
23744 IF (GENEV.AND.HCS.GT.RCS) THEN
23745 CALL HWHQCP(IQ1,IQ2,2413,27)
23749 IF (GENEV.AND.HCS.GT.RCS) THEN
23750 CALL HWHQCP(IQ1,IQ2,4123,28)
23762 CALL HWETWO(.TRUE.,.TRUE.)
23764 C Calculate coefficients for constructing spin density matrices
23765 IF (IHPRO.EQ.7 .OR.IHPRO.EQ.8 .OR.
23766 & IHPRO.EQ.15.OR.IHPRO.EQ.16) THEN
23767 C qqbar-->gg or qbarq-->gg
23776 ELSEIF (IHPRO.EQ.10.OR.IHPRO.EQ.11.OR.
23777 & IHPRO.EQ.21.OR.IHPRO.EQ.22.OR.
23778 & IHPRO.EQ.23.OR.IHPRO.EQ.24.OR.
23779 & IHPRO.EQ.25.OR.IHPRO.EQ.26) THEN
23780 C qg-->qg or qbarg-->qbarg or gq-->gq or gqbar-->gqbar
23789 ELSEIF (IHPRO.EQ.27.OR.IHPRO.EQ.28) THEN
23799 ELSEIF (IHPRO.EQ.29.OR.IHPRO.EQ.30.OR.
23800 & IHPRO.EQ.31) THEN
23803 GCOEF(2)=2.*U*U*T*T
23804 GCOEF(3)=2.*S*S*U*U
23805 GCOEF(4)=2.*S*S*T*T
23806 GCOEF(1)=GT*GT-GCOEF(2)-GCOEF(3)-GCOEF(4)
23807 GCOEF(5)=GT*(GT-2.*S*S)-GCOEF(2)
23808 GCOEF(6)=GT*(GT-2.*T*T)-GCOEF(3)
23809 GCOEF(7)=GT*(GT-2.*U*U)-GCOEF(4)
23811 CALL HWVZRO(7,GCOEF)
23816 *CMZ :- -26/11/00 17.21.55 by Bryan Webber
23817 *-- Author : Kosuke Odagiri & Stefano Moretti
23818 C-----------------------------------------------------------------------
23819 C...Generate completely differential cross section (EVWGT) in the variables
23820 C...X(I) with I=1,3 (see below) for the processes IPROC=3410,3420,3430,3450
23821 C...as described in the HERWIG 6 documentation file.
23822 C...It includes interface to PDFs and takes into account color connections
23825 C...First release: 6-AUG-1999 by Kosuke Odagiri
23826 C...Last modified: 6-SEP-1999 by Stefano Moretti
23828 C-----------------------------------------------------------------------
23830 C-----------------------------------------------------------------------
23831 C HIGGS + HEAVY QUARK (BOTTOM & TOP) PRODUCTION (2HDM)
23832 C-----------------------------------------------------------------------
23833 INCLUDE 'herwig65.inc'
23834 DOUBLE PRECISION HWRGEN, HWUALF, HWUAEM, EPS, HCS, RCS,
23835 & DIST, SM, DM, QPE, PF, SQPE, EMSC2, FACTR, S, T3, U4,
23836 & SN2TH, ME2(0:4), MW, XWEIN, PT2MIN, PT2, GQH(0:4), G1, RMMIN,
23837 & EMG, EMQ, EMH, EMG2, EMQ2, EMH2, EMHWT, ECM_MAX, X(3), XL(3),
23838 & XU(3), WEIGHT, ECM, SHAT, TAU, T, TL, TLMIN, TLMAX, TTMIN, TTMAX,
23839 & CTMP, PCM, PCM2, RCM, RCM2, FKLN
23840 INTEGER ID1, ID2, IH, IQ, I
23841 EXTERNAL HWRGEN, HWUALF, HWUAEM
23842 SAVE HCS,ME2,S,SHAT
23843 PARAMETER (EPS = 1.D-9)
23844 EQUIVALENCE (MW, RMASS(198))
23845 PARAMETER (EMG=0.,EMG2=0.)
23846 C...generate event.
23848 RCS = HCS*HWRGEN(0)
23852 C...minimum transverse momentum.
23855 C...accompanying quark.
23857 IF(IHIGGS.GE.5)IQ=6
23860 C...on-shell Higgs.
23861 EMH=RMASS(201+IHIGGS)
23865 C...energy at hadron level.
23866 ECM_MAX=PBEAM1+PBEAM2
23868 C...phase space variables.
23869 C...IF IQ=5 -> X(1)=(LOG(|T|)-LOG(|TMIN|))/(LOG(|TMAX|)-LOG(|TMIN|),
23870 C...IF IQ=6 -> X(1)=COS(THETA_CM);
23871 C...X(2)=(1./SHAT-1./ECM_MAX**2)/(1./(EMQ+EMH)**2-1./ECM_MAX**2),
23872 C...X(3)=(LOG(TAU)-LOG(X1))/LOG(TAU),
23873 C...phase space borders.
23874 IF(IQ.EQ.5)XL(1)=0.
23875 IF(IQ.EQ.6)XL(1)=-1.
23881 C...single phase space point.
23884 X(I)=XL(I)+(XU(I)-XL(I))*HWRGEN(0)
23885 WEIGHT=WEIGHT*ABS(XU(I)-XL(I))
23887 C...energy at parton level.
23888 ECM=SQRT(1./(X(2)*(1./(EMQ+EMH)**2-1./ECM_MAX**2)
23890 IF((EMH.LE.0.).OR.(EMH.GE.ECM))RETURN
23893 C...momentum fractions X1 and X2.
23894 XX(1)=EXP(LOG(TAU)*(1.-X(3)))
23896 C...reconstruct polar angle.
23898 PCM2=((SHAT-EMQ2-EMG2)**2
23899 & -(2.*EMQ*EMG)**2)/(4.*SHAT)
23901 RCM2=((SHAT-EMQ2-EMH2)**2
23902 & -(2.*EMQ*EMH)**2)/(4.*SHAT)
23904 FKLN=SQRT((SHAT-(EMQ+EMG)**2)*(SHAT-(EMQ-EMG)**2))
23905 & *SQRT((SHAT-(EMQ+EMH)**2)*(SHAT-(EMQ-EMH)**2))
23906 TTMAX=EMG2+EMQ2-0.5D0/ECM/ECM
23907 & *((SHAT+EMG2-EMQ2)*(SHAT+EMQ2-EMH2)
23909 TTMIN=EMG2+EMQ2-0.5D0/ECM/ECM
23910 & *((SHAT+EMG2-EMQ2)*(SHAT+EMQ2-EMH2)
23912 TLMAX=LOG(ABS(TTMIN))
23913 TLMIN=LOG(ABS(TTMAX))
23914 TL=X(1)*(TLMAX-TLMIN)+TLMIN
23917 & +2.*SQRT(PCM2+EMG2)*SQRT(RCM2+EMQ2)
23918 COSTH = CTMP/2./PCM/RCM
23919 ELSE IF(IQ.EQ.6)THEN
23922 SN2TH = 0.25D0 - 0.25D0*COSTH**2
23923 IF((0.25D0-RMMIN**2/SHAT).LT.0.)THEN
23927 T3 = ( SQRT(0.25D0-RMMIN**2/SHAT) * COSTH - HALF ) * SHAT
23929 EMSC2 = TWO*SHAT*T3*U4/(SHAT**2+T3**2+U4**2)
23930 EMSCA = SQRT( EMSC2 )
23931 CALL HWSGEN(.FALSE.)
23933 XWEIN = TWO * SWEIN
23934 FACTR = GEV2NB*PIFAC*HWUAEM(EMSC2)/XWEIN/SHAT
23935 & *HWUALF(1,EMSCA)/TWO/CAFAC/2.
23936 C...Jacobians from COSTH to X(1).
23938 FACTR=FACTR*(TLMAX-TLMIN)/2./PCM/RCM*T
23942 C...Jacobians from X1,X2 to X(2),X(3).
23943 FACTR=FACTR/S*(-LOG(TAU))*(1./(EMQ+EMH)**2-1./ECM_MAX**2)
23944 C...CKM mixing top/bottom quark.
23945 c bug fix 20/05/01 SM.
23946 IF(IQ.EQ.6)FACTR=FACTR*VCKM(3,3)
23948 C...Higgs resonance.
23950 C...constant weight.
23952 C...SM/MSSM couplings.
23953 IF (IHIGGS.EQ.0) THEN
23954 GQH(0)=(RMASS(5)/MW)**2/TWO
23956 G1 = (RMASS(5)/MW/COSB)**2/TWO
23957 GQH(1) = G1*SINA**2
23958 GQH(2) = G1*COSA**2
23959 GQH(3) = G1*SINB**2
23960 GQH(4) = GQH(3)+(RMASS(6)/MW/TANB)**2/TWO
23962 C...Matrix elements.
23971 IF(IHIGGS.NE.0)IH=IHIGGS-1
23972 IF (IH.EQ.4) ID1 = 6
23974 SM = RMASS(ID1)+RMASS(ID2)
23976 IF (QPE.GT.ZERO) THEN
23977 DM = RMASS(ID1)-RMASS(ID2)
23978 QPE = QPE*(SHAT-DM**2)/SHAT
23981 IF (PT2.GT.PT2MIN) THEN
23982 SQPE = SQRT(QPE*SHAT)
23984 T3 = (SQPE*COSTH - SHAT - SM*DM) / TWO
23986 ME2(IH) = FACTR*PF * GQH(IH) *
23987 & U4/SHAT/T3*(-U4+TWO*SM*DM/T3/U4*SHAT*PT2)
23997 IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN
23998 DIST = DISF(ID1,1)*DISF(ID2,2)*S*SHAT
24000 HCS = HCS + DIST*ME2(IH)
24001 IF (GENEV.AND.HCS.GT.RCS) THEN
24002 CALL HWHQCP(5,IHIGGS+201,2314,1)
24006 HCS = HCS + DIST*ME2(4)
24007 IF (GENEV.AND.HCS.GT.RCS) THEN
24008 CALL HWHQCP(6,207,2314,1)
24016 IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN
24017 DIST = DISF(ID1,1)*DISF(ID2,2)*S*SHAT
24019 HCS = HCS + DIST*ME2(IH)
24020 IF (GENEV.AND.HCS.GT.RCS) THEN
24021 CALL HWHQCP(11,IHIGGS+201,3124,1)
24025 HCS = HCS + DIST*ME2(4)
24026 IF (GENEV.AND.HCS.GT.RCS) THEN
24027 CALL HWHQCP(12,206,3124,1)
24035 IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN
24036 DIST = DISF(ID1,1)*DISF(ID2,2)*S*SHAT
24038 HCS = HCS + DIST*ME2(IH)
24039 IF (GENEV.AND.HCS.GT.RCS) THEN
24040 CALL HWHQCP(IHIGGS+201,5,4132,1)
24044 HCS = HCS + DIST*ME2(4)
24045 IF (GENEV.AND.HCS.GT.RCS) THEN
24046 CALL HWHQCP(207,6,4132,1)
24054 IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN
24055 DIST = DISF(ID1,1)*DISF(ID2,2)*S*SHAT
24057 HCS = HCS + DIST*ME2(IH)
24058 IF (GENEV.AND.HCS.GT.RCS) THEN
24059 CALL HWHQCP(IHIGGS+201,11,2431,1)
24063 HCS = HCS + DIST*ME2(4)
24064 IF (GENEV.AND.HCS.GT.RCS) THEN
24065 CALL HWHQCP(206,12,2431,1)
24075 CALL HWETWO(.TRUE.,.TRUE.)
24077 C Calculate coefficients for constructing spin density matrices
24078 C Set to zero for now
24079 CALL HWVZRO(7,GCOEF)
24083 *CMZ :- -26/11/00 17.21.55 by Bryan Webber
24084 *-- Author : Stefano Moretti
24085 C-----------------------------------------------------------------------
24086 C...Generate completely differential cross section (EVWGT) in the variables
24087 C...X(I) with I=1,4 (see below) for the process IPROC=3350, as described
24088 C...in the HERWIG 6 documentation file.
24089 C...It includes interface to PDFs and takes into account color connections
24092 C...First release: 8-APR-1999 by Stefano Moretti
24095 C-----------------------------------------------------------------------
24096 C ASSOCIATE PRODUCTION W+H- FROM QUARK FUSION (2HDM)
24097 C-----------------------------------------------------------------------
24098 INCLUDE 'herwig65.inc'
24100 DOUBLE PRECISION EMH,EMHWT,RMW,EMW
24101 DOUBLE PRECISION RMH
24102 DOUBLE PRECISION X(4),XL(4),XU(4)
24103 DOUBLE PRECISION CT,ST
24104 DOUBLE PRECISION P1(0:3),P2(0:3),P3(0:3),P4(0:3)
24105 DOUBLE PRECISION ECM_MAX,ECM,SHAT,S,TAU
24106 DOUBLE PRECISION EMIN,PCM2,PCM,RCM2,RCM
24107 DOUBLE PRECISION M2,M2L,M2T
24108 DOUBLE PRECISION ALPHA,EMSC2
24109 DOUBLE PRECISION HWRGEN,HWUAEM
24110 DOUBLE PRECISION RNMIN,RNMAX,THETA_MIN,THETA_MAX
24111 DOUBLE PRECISION EPS,HCS,RCS,FACT,DIST
24112 DOUBLE PRECISION WEIGHT
24113 DOUBLE PRECISION VSAVE
24114 SAVE EMH,EMW,HCS,M2,M2L,M2T,FACT,S,CT
24116 EXTERNAL HWHIGM,HWRGEN,HWUAEM,HWH2BK,HWETWO,HWRLOG
24117 PARAMETER (EPS=1.D-9)
24118 EQUIVALENCE (RMW ,RMASS(198))
24119 EQUIVALENCE (RMH ,RMASS(206))
24125 C...assign final state masses.
24128 C...energy at hadron level.
24129 ECM_MAX=PBEAM1+PBEAM2
24131 C...phase space variables.
24132 C...X(1)=COS(THETA_CM),
24133 C...X(2)=(1./SHAT-1./ECM_MAX**2)/(1./(EMW+EMH)**2-1./ECM_MAX**2),
24134 C...X(3)=(LOG(TAU)-LOG(X1))/LOG(TAU),
24135 C...X(4)=(THETA-THETA_MIN)/(THETA_MAX-THETA_MIN),
24136 C...where THETA=ATAN((EMW*EMW-RMW*RMW)/RMW/GAMW);
24137 C...phase space borders.
24146 C...single phase space point.
24149 X(I)=XL(I)+(XU(I)-XL(I))*HWRGEN(0)
24150 WEIGHT=WEIGHT*ABS(XU(I)-XL(I))
24152 C...resonant boson mass (limits to -10*W-widths to improve efficiency).
24153 RNMIN=RMW-GAMMAX*GAMW
24154 THETA_MIN=ATAN((RNMIN*RNMIN-RMW*RMW)/RMW/GAMW)
24156 THETA_MAX=ATAN((RNMAX*RNMAX-RMW*RMW)/RMW/GAMW)
24157 EMW=SQRT((TAN(X(4)*(THETA_MAX-THETA_MIN)+THETA_MIN))
24158 & *RMW*GAMW+RMW*RMW)
24159 C...energy at parton level.
24160 ECM=SQRT(1./(X(2)*(1./(EMW+EMH)**2-1./ECM_MAX**2)
24162 IF((EMH.LE.0.).OR.(EMH.GE.ECM))RETURN
24165 C...momentum fractions X1 and X2.
24166 XX(1)=EXP(LOG(TAU)*(1.-X(3)))
24168 C...two particle kinematics.
24170 IF(HWRLOG(HALF))THEN
24175 RCM2=((SHAT-EMW*EMW-EMH*EMH)**2
24176 & -(2.*EMW*EMH)**2)/(4.*SHAT)
24178 P3(0)=SQRT(RCM2+EMW*EMW)
24182 P4(0)=SQRT(RCM2+EMH*EMH)
24186 C...incoming parton: massless.
24188 C...initial state momenta in the partonic CM.
24189 PCM2=((SHAT-EMIN*EMIN-EMIN*EMIN)**2
24190 & -(2.*EMIN*EMIN)**2)/(4.*SHAT)
24192 P1(0)=SQRT(PCM2+EMIN*EMIN)
24196 P2(0)=SQRT(PCM2+EMIN*EMIN)
24200 C...color structured ME summed/averaged over final/initial spins and colors.
24201 CALL HWH2BK(P1,P2,P3,P4,EMW,EMH,M2,M2L,M2T)
24203 C...charge conjugation.
24207 C...constant factors: phi along beam and conversion GeV^2->nb.
24208 FACT=2.*PIFAC*GEV2NB
24209 C...Jacobians from X1,X2 to X(2),X(3)
24210 FACT=FACT/S*(-LOG(TAU))*(1./(EMW+EMH)**2-1./ECM_MAX**2)
24211 C...phase space Jacobians, pi's and flux.
24212 FACT=FACT/64./PIFAC/PIFAC*RCM/PCM
24217 ALPHA=HWUAEM(EMSC2)
24218 FACT=FACT*(PIFAC*ALPHA/SWEIN/RMW/RMW/SQRT(2.))**2
24219 C...Higgs resonance.
24221 C...vector boson resonance.
24222 FACT=FACT*(THETA_MAX-THETA_MIN)/PIFAC
24223 C...constant weight.
24228 CALL HWSGEN(.FALSE.)
24230 IF(DISF(I,1).LT.EPS)THEN
24235 IF(DISF(J,2).LT.EPS)THEN
24238 DIST=DISF(I,1)*DISF(J,2)*S
24239 C...no need to set up color connections.
24240 HCS=HCS+M2*DIST*FACT
24241 IF(GENEV.AND.HCS.GT.RCS)THEN
24242 C...generate event.
24245 IDN(3)=NINT(198.+HWRGEN(0))
24246 IF(IDN(3).EQ.198)IDN(4)=207
24247 IF(IDN(3).EQ.199)IDN(4)=206
24248 C...set up status and IDs: use HWETWO.
24255 C...trick HWETWO in using off-shell V mass
24256 VSAVE=RMASS(IDN(3))
24258 C-- BRW fix 27/8/04: avoid double smearing of V mass
24259 CALL HWETWO(.FALSE.,.TRUE.)
24260 RMASS(IDN(3))=VSAVE
24262 C...set to zero the coefficients of the spin density matrices.
24263 CALL HWVZRO(7,GCOEF)
24265 C...calculates approximately polarized decay matrix of gauge boson.
24266 IF(IERROR.NE.0)RETURN
24268 IF(ICHRG(I)*ICHRG(IDN(3)).LT.0.D0)IHEL=1
24269 IF(M2L.LT.0.)M2L=0.
24270 IF(M2T.LT.0.)M2T=0.
24271 RHOHEP(2,NHEP-1)=M2L/M2
24272 RHOHEP(1,NHEP-1)=M2T/M2*(1-IHEL)
24273 RHOHEP(3,NHEP-1)=M2T/M2*( IHEL)
24281 *CMZ :- -23/08/94 13.22.29 by Mike Seymour
24282 *-- Author : Ulrich Baur & Nigel Glover, adapted by Ian Knowles
24283 *- Split in 3 files by M. Kirsanov
24284 C-----------------------------------------------------------------------
24285 FUNCTION HWHIG1(S,T,U,EH2,EQ2,I,J,K,I1,J1,K1)
24286 C-----------------------------------------------------------------------
24287 C Basic matrix elements for Higgs + jet production; used in HWHIGA
24288 C-----------------------------------------------------------------------
24290 DOUBLE COMPLEX HWHIG1,BI(4),CI(7),DI(3)
24291 DOUBLE PRECISION S,T,U,EH2,EQ2,S1,T1,U1,ONE,TWO,FOUR,HALF
24292 INTEGER I,J,K,I1,J1,K1
24293 COMMON/CINTS/BI,CI,DI
24294 PARAMETER (ONE =1.D0, TWO =2.D0, FOUR =4.D0, HALF =0.5D0)
24295 C-----------------------------------------------------------------------
24296 C +++ helicity amplitude for: g+g --> g+H
24297 C-----------------------------------------------------------------------
24301 HWHIG1=EQ2*FOUR*DSQRT(TWO*S*T*U)*(
24302 & -FOUR*(ONE/(U*T)+ONE/(U*U1)+ONE/(T*T1))
24303 & -FOUR*((TWO*S+T)*BI(K)/U1**2+(TWO*S+U)*BI(J)/T1**2)/S
24304 & -(S-FOUR*EQ2)*(S1*CI(I1)+(U-S)*CI(J1)+(T-S)*CI(K1))/(S*T*U)
24305 & -8.D0*EQ2*(CI(J1)/(T*T1)+CI(K1)/(U*U1))
24306 & +HALF*(S-FOUR*EQ2)*(S*T*DI(K)+U*S*DI(J)-U*T*DI(I))/(S*T*U)
24307 & +FOUR*EQ2*DI(I)/S
24308 & -TWO*(U*CI(K)+T*CI(J)+U1*CI(K1)+T1*CI(J1)-U*T*DI(I))/S**2 )
24311 *CMZ :- -23/08/94 13.22.29 by Mike Seymour
24312 *-- Author : Ulrich Baur & Nigel Glover, adapted by Ian Knowles
24313 C-----------------------------------------------------------------------
24314 FUNCTION HWHIG2(S,T,U,EH2,EQ2,I,J,K,I1,J1,K1)
24315 C-----------------------------------------------------------------------
24316 C Basic matrix elements for Higgs + jet production; used in HWHIGA
24317 C-----------------------------------------------------------------------
24319 DOUBLE COMPLEX HWHIG2,BI(4),CI(7),DI(3)
24320 DOUBLE PRECISION S,T,U,EH2,EQ2,S1,T1,U1,ONE,TWO,FOUR,HALF
24321 INTEGER I,J,K,I1,J1,K1
24322 COMMON/CINTS/BI,CI,DI
24323 PARAMETER (ONE =1.D0, TWO =2.D0, FOUR =4.D0, HALF =0.5D0)
24324 C-----------------------------------------------------------------------
24325 C ++- helicity amplitude for: g+g --> g+H
24326 C-----------------------------------------------------------------------
24330 HWHIG2=EQ2*FOUR*DSQRT(TWO*S*T*U)*(FOUR*EH2
24331 & +(EH2-FOUR*EQ2)*(S1*CI(4)+T1*CI(5)+U1*CI(6))
24332 & -HALF*(EH2-FOUR*EQ2)*(S*T*DI(3)+U*S*DI(2)+U*T*DI(1)) )/(S*T*U)
24335 *CMZ :- -23/08/94 13.22.29 by Mike Seymour
24336 *-- Author : Ulrich Baur & Nigel Glover, adapted by Ian Knowles
24337 C-----------------------------------------------------------------------
24338 FUNCTION HWHIG5(S,T,U,EH2,EQ2,I,J,K,I1,J1,K1)
24339 C-----------------------------------------------------------------------
24340 C Basic matrix elements for Higgs + jet production; used in HWHIGA
24341 C-----------------------------------------------------------------------
24343 DOUBLE COMPLEX HWHIG5,BI(4),CI(7),DI(3)
24344 DOUBLE PRECISION S,T,U,EH2,EQ2,ONE,TWO,FOUR,HALF
24345 INTEGER I,J,K,I1,J1,K1
24346 COMMON/CINTS/BI,CI,DI
24347 PARAMETER (ONE =1.D0, TWO =2.D0, FOUR =4.D0, HALF =0.5D0)
24348 C-----------------------------------------------------------------------
24349 C Amplitude for: q+qbar --> g+H
24350 C-----------------------------------------------------------------------
24351 HWHIG5=DCMPLX(TWO)+DCMPLX(TWO*S/(S-EH2))*BI(I)
24352 & +DCMPLX(FOUR*EQ2-U-T)*CI(K)
24355 *CMZ :- -30/06/01 18.40.33 by Stefano Moretti
24356 *-- Author : Stefano Moretti
24357 C-----------------------------------------------------------------------
24358 C...Generate completely differential cross section (EVWGT) in the variables
24359 C...X(I) with I=1,6 (see below) for the process IPROC=3500, as described
24360 C...in the HERWIG 6 documentation file.
24361 C...It includes interface to PDFs and takes into account color connections
24364 C...First release: 12-APR-2000 by Stefano Moretti
24366 C-----------------------------------------------------------------------
24368 C-----------------------------------------------------------------------
24369 C PRODUCTION OF MSSM CHARGED HIGGSES FROM B-QUARK+LIGHT-QUARK FUSION
24370 C-----------------------------------------------------------------------
24371 INCLUDE 'herwig65.inc'
24372 INTEGER I,J,K,L,M,N
24375 DOUBLE PRECISION EMQ,ENQ,EMQH,EMB,EMH,EMHWT,EMT,EMW
24376 DOUBLE PRECISION EMH01,EMH02,EMH03
24377 DOUBLE PRECISION WCKM,CKM,GAMT
24378 DOUBLE PRECISION X(6),XL(6),XU(6)
24379 DOUBLE PRECISION Q3(0:3),Q35(0:3)
24380 DOUBLE PRECISION Q1(5),Q2(5),H(5)
24381 DOUBLE PRECISION CT4,ST4,CT3,ST3,CF3,SF3,RQ42,RQ4,RQ32,RQ3,PQ3
24382 DOUBLE PRECISION P1(0:3),P2(0:3),P3(0:3),P4(0:3),P5(0:3)
24383 DOUBLE PRECISION ECM_MAX,ECM,SHAT,S,TAU
24384 DOUBLE PRECISION XTMP
24385 DOUBLE PRECISION EMIN1,EMIN2,PCM2,PCM
24386 DOUBLE PRECISION M2B,M2BBAR
24387 DOUBLE PRECISION ALPHA,EMSC2
24388 DOUBLE PRECISION HWRGEN,HWUAEM
24389 DOUBLE PRECISION PHI,CPHI,SPHI,ROT(3,3)
24390 DOUBLE PRECISION QAUX(0:3)
24391 DOUBLE PRECISION EPS,HCS,RCS,FACT,DIST
24392 DOUBLE PRECISION WEIGHT
24393 SAVE HCS,M2B,M2BBAR,FACT,S,WCKM,P3,P4,P5
24395 EXTERNAL HWRGEN,HWUAEM,HWH2BH,HWEONE,HWRLOG,
24397 EQUIVALENCE (EMB,RMASS(5)),(EMT,RMASS(6))
24398 EQUIVALENCE (EMW,RMASS(198))
24399 EQUIVALENCE (EMH01,RMASS(204)),
24400 & (EMH02,RMASS(203)),
24401 & (EMH03,RMASS(205))
24402 EQUIVALENCE (CKM,VCKM(3,3))
24403 PARAMETER (EPS=1.D-9)
24409 C...assign final state masses.
24414 C...assign top width.
24416 C...energy at hadron level.
24417 ECM_MAX=PBEAM1+PBEAM2
24419 C...phase space variables.
24420 C...X(1)=(EMQH-EMQ-EMH)/(ECM-EMQ-ENQ-EMH),
24421 C...X(2)=1/[-(P2-P3)^2+MW^2],X(3)=COS(THETA4_CM_35),X(4)=FI4_CM_35,
24422 C...X(5)=(1./SHAT-1./ECM_MAX**2)/(1./(EMQ+ENQ+EMH)**2-1./ECM_MAX**2),
24423 C...X(6)=(LOG(TAU)-LOG(X1))/LOG(TAU);
24424 C...phase space borders.
24427 c...for XL(2),XU(2) see below (non constant).
24436 C...single phase space point.
24441 X(I)=XL(I)+(XU(I)-XL(I))*HWRGEN(0)
24442 WEIGHT=WEIGHT*ABS(XU(I)-XL(I))
24445 C...energy at parton level.
24446 ECM=SQRT(1./(X(5)*(1./(EMQ+ENQ+EMH)**2-1./ECM_MAX**2)
24448 IF((EMH.LE.0.).OR.(EMH.GE.ECM))RETURN
24451 C...momentum fractions X1 and X2.
24452 XX(1)=EXP(LOG(TAU)*(1.-X(6)))
24454 C...incoming partons massless.
24457 C...initial state momenta in the partonic CM.
24458 PCM2=((SHAT-EMIN1*EMIN1-EMIN2*EMIN2)**2
24459 & -(2.*EMIN1*EMIN2)**2)/(4.*SHAT)
24461 C...three particle kinematics.
24462 EMQH=X(1)*(ECM-EMQ-ENQ-EMH)+EMQ+EMH
24463 RQ42=((ECM*ECM-ENQ*ENQ-EMQH*EMQH)**2-(2.*ENQ*EMQH)**2)/
24470 C...X(2): integrate over W propagator.
24471 XL(2)=1./(4.*SQRT(PCM2+EMIN2*EMIN2)*RQ4+EMW*EMW)
24473 X(2)=XL(2)+(XU(2)-XL(2))*HWRGEN(0)
24474 WEIGHT=WEIGHT*ABS(XU(2)-XL(2))
24476 XTMP=(XTMP-EMW*EMW)/2./SQRT(PCM2+EMIN2*EMIN2)
24477 CT4=1.-XTMP/((SHAT-EMQH*EMQH+2.*ENQ*ENQ)/(2.*ECM))
24478 IF(CT4.GT.+1.)CT4=+1.
24479 IF(CT4.LT.-1.)CT4=-1.
24480 IF(HWRLOG(HALF))THEN
24481 ST4=+SQRT(1.-CT4*CT4)
24483 ST4=-SQRT(1.-CT4*CT4)
24486 ST3=SQRT(1.-CT3*CT3)
24492 P4(0)=SQRT(RQ42+ENQ*ENQ)
24496 Q35(0)=SQRT(RQ42+EMQH*EMQH)
24497 RQ32=((EMQH*EMQH-EMH*EMH-EMQ*EMQ)**2-(2.*EMH*EMQ)**2)/
24507 Q3(0)=SQRT(RQ32+EMQ*EMQ)
24510 PQ3=PQ3+Q35(I)*Q3(I)
24512 P3(0)=(Q35(0)*Q3(0)+PQ3)/EMQH
24515 P3(I)=Q3(I)+Q35(I)*(P3(0)+Q3(0))/(Q35(0)+EMQH)
24519 P1(0)=SQRT(PCM2+EMIN1*EMIN1)
24523 P2(0)=SQRT(PCM2+EMIN2*EMIN2)
24527 C...option: top diagram removed if can be resonant to avoid double counting.
24529 C IF((EMT-EMB-EMH).GE.0.)IRES=0
24530 C...color structured ME summed/averaged over final/initial spins and colors.
24531 C...IFL=+1 selects b.
24533 CALL HWH2BH(P1,P2,P3,P4,P5,EMW,EMH,EMH01,EMH02,EMH03,EMB,EMT,
24534 & IFL,IRES,CKM,GAMT,M2B)
24535 C...IFL=-1 selects b-bar.
24537 CALL HWH2BH(P1,P2,P3,P4,P5,EMW,EMH,EMH01,EMH02,EMH03,EMB,EMT,
24538 & IFL,IRES,CKM,GAMT,M2BBAR)
24539 C...constant factors: phi along beam and conversion GeV^2->nb.
24540 FACT=2.*PIFAC*GEV2NB
24541 C...Jacobians from X1,X2 to X(5),X(6)
24542 FACT=FACT/S*(-LOG(TAU))*(1./(EMQ+ENQ+EMH)**2-1./ECM_MAX**2)
24543 C...phase space Jacobians, pi's and flux.
24544 FACT=FACT*RQ3*RQ4/PCM/32./(2.*PIFAC)**5
24545 & *(ECM-EMQ-ENQ-EMH)
24546 FACT=FACT/2./P2(0)/P4(0)
24547 FACT=FACT*(2.*P2(0)*P4(0)*(1.-CT4)+EMW*EMW)**2
24551 ALPHA=HWUAEM(EMSC2)
24552 FACT=FACT*64.*PIFAC**3*ALPHA**3/4./SWEIN/SWEIN/SWEIN/EMW/EMW
24553 C...Higgs resonance.
24555 C...constant weight.
24560 CALL HWSGEN(.FALSE.)
24562 IF(DISF(I,1).LT.EPS)THEN
24566 IF(DISF(J,2).LT.EPS)THEN
24569 IF((I.NE.5).AND.(I.NE.11).AND.
24570 & (J.NE.5).AND.(J.NE.11))THEN
24574 IF((I.NE.5).AND.(I.NE.11))II=I
24581 IF((ITMP.EQ.5).AND.(II.EQ.3).AND.(JJ.EQ.3))WCKM=0.
24582 DIST=DIST+DISF(I,1)*DISF(J,2)*WCKM*S
24584 IF((I.LE.6).AND.(J.LE.6))THEN
24585 HCS=HCS+M2B*DIST*FACT
24586 ELSE IF((I.LE.6).AND.(J.GE.7))THEN
24587 IF(J.NE.11)HCS=HCS+M2B*DIST*FACT
24588 IF(J.EQ.11)HCS=HCS+M2BBAR*DIST*FACT
24589 ELSE IF((I.GE.7).AND.(J.LE.6))THEN
24590 IF(I.NE.11)HCS=HCS+M2B*DIST*FACT
24591 IF(I.EQ.11)HCS=HCS+M2BBAR*DIST*FACT
24592 ELSE IF((I.GE.7).AND.(J.GE.7))THEN
24593 HCS=HCS+M2BBAR*DIST*FACT
24595 IF(GENEV.AND.HCS.GT.RCS)THEN
24596 C...generate event.
24599 IF((I.EQ.5).OR.(I.EQ.11))THEN
24610 IF(IDN(2).EQ.IDN(4))THEN
24612 & NINT(198.5-.1667*FLOAT(ICHRG(IDN(1))-ICHRG(IDN(3))))
24615 & NINT(198.5-.1667*FLOAT(ICHRG(IDN(2))-ICHRG(IDN(4))))
24618 C...sets up incoming status and IDs only for 2->1: use HWEONE.
24621 JDAHEP(1,NHEP)=NHEP+1
24622 JDAHEP(2,NHEP)=NHEP+3
24623 JMOHEP(1,NHEP+1)=NHEP
24624 JMOHEP(1,NHEP+2)=NHEP
24625 JMOHEP(1,NHEP+3)=NHEP
24626 C...randomly rotate final state momenta around beam axis.
24627 PHI=2.*PIFAC*HWRGEN(0)
24643 IF(L.EQ.1)QAUX(M)=QAUX(M)+ROT(M,N)*P3(N)
24644 IF(L.EQ.2)QAUX(M)=QAUX(M)+ROT(M,N)*P4(N)
24645 IF(L.EQ.3)QAUX(M)=QAUX(M)+ROT(M,N)*P5(N)
24649 IF(L.EQ.1)P3(M)=QAUX(M)
24650 IF(L.EQ.2)P4(M)=QAUX(M)
24651 IF(L.EQ.3)P5(M)=QAUX(M)
24654 C...outgoing momenta (give quark masses non covariantly!)
24663 Q1(5)=RMASS(IDN(3))
24664 Q1(4)=SQRT(Q1(4)**2+Q1(5)**2)
24665 Q2(5)=RMASS(IDN(4))
24666 Q2(4)=SQRT(Q2(4)**2+Q2(5)**2)
24667 H(4)=-Q1(4)-Q2(4)+PHEP(5,NHEP)
24669 CALL HWULOB(PHEP(1,NHEP),Q1,PHEP(1,NHEP+1))
24670 CALL HWULOB(PHEP(1,NHEP),Q2,PHEP(1,NHEP+2))
24671 CALL HWULOB(PHEP(1,NHEP),H ,PHEP(1,NHEP+3))
24672 C...sets up outgoing status and IDs.
24676 IDHW(NHEP+1)=IDN(3)
24677 IDHEP(NHEP+1)=IDPDG(IDN(3))
24678 IDHW(NHEP+2)=IDN(4)
24679 IDHEP(NHEP+2)=IDPDG(IDN(4))
24680 IDHW(NHEP+3)=IDN(5)
24681 IDHEP(NHEP+3)=IDPDG(IDN(5))
24682 C...sets up colour connections.
24683 JMOHEP(2,NHEP+1)=NHEP-2
24684 JMOHEP(2,NHEP+2)=NHEP-1
24685 JMOHEP(2,NHEP-1)=NHEP+2
24686 JMOHEP(2,NHEP-2)=NHEP+1
24687 JMOHEP(2,NHEP+3)=NHEP+3
24688 JDAHEP(2,NHEP+1)=NHEP-2
24689 JDAHEP(2,NHEP+2)=NHEP-1
24690 JDAHEP(2,NHEP-1)=NHEP+2
24691 JDAHEP(2,NHEP-2)=NHEP+1
24692 JDAHEP(2,NHEP+3)=NHEP+3
24695 C...set to zero the coefficients of the spin density matrices.
24696 CALL HWVZRO(7,GCOEF)
24708 *CMZ :- -23/08/94 13.22.29 by Mike Seymour
24709 *-- Author : Ulrich Baur & Nigel Glover, adapted by Ian Knowles
24710 C-----------------------------------------------------------------------
24711 SUBROUTINE HWHIGA(S,T,U,EMH2,WTQQ,WTQG,WTGQ,WTGG)
24712 C-----------------------------------------------------------------------
24713 C Gives amplitudes squared for q-qbar, q(bar)-g and gg -> Higgs +jet
24714 C IAPHIG (set in HWIGIN)=0: zero mass approximation =1: exact result
24715 C =2: infinite mass limit.
24716 C Only top loop included. A factor (alpha_s**3*alpha_W) is extracted
24717 C-----------------------------------------------------------------------
24718 INCLUDE 'herwig65.inc'
24719 DOUBLE COMPLEX HWHIGB,HWHIGC,HWHIGD,HWHIG5,HWHIG1,HWHIG2,BI(4),
24720 & CI(7),DI(3),EPSI,TAMP(7)
24721 DOUBLE PRECISION S,T,U,EMH2,WTQQ,WTQG,WTGQ,WTGG,EMW2,RNGLU,RNQRK,
24722 & FLUXGG,FLUXGQ,FLUXQQ,EMQ2,TAMPI(7),TAMPR(7)
24725 EXTERNAL HWHIGB,HWHIGC,HWHIGD,HWHIG5,HWHIG1,HWHIG2
24727 COMMON/CINTS/BI,CI,DI
24728 EPSI=DCMPLX(ZERO,-1.D-10)
24730 C Spin and colour flux factors plus enhancement factor
24731 RNGLU=1./FLOAT(NCOLO**2-1)
24732 RNQRK=1./FLOAT(NCOLO)
24733 FLUXGG=.25*RNGLU**2*ENHANC(6)**2
24734 FLUXGQ=.25*RNGLU*RNQRK*ENHANC(6)**2
24735 FLUXQQ=.25*RNQRK**2*ENHANC(6)**2
24736 IF (IAPHIG.EQ.2) THEN
24737 C Infinite mass limit in loops
24738 WTGG=(2./3.)**2*FLOAT(NCOLO*(NCOLO**2-1))
24739 & *(EMH2**4+S**4+T**4+U**4)/(S*T*U*EMW2)*FLUXGG
24740 WTQQ= 16./9.*(U**2+T**2)/(S*EMW2)*FLUXQQ
24741 WTQG=-16./9.*(U**2+S**2)/(T*EMW2)*FLUXGQ
24742 WTGQ=-16./9.*(S**2+T**2)/(U*EMW2)*FLUXGQ
24744 ELSEIF (IAPHIG.EQ.1) THEN
24745 C Exact result for loops
24747 ELSEIF (IAPHIG.EQ.0) THEN
24748 C Small mass approximation in loops
24751 CALL HWWARN('HWHIGA',500)
24753 C Include only top quark contribution
24755 BI(1)=HWHIGB(NOMASS,S,ZERO,ZERO,EMQ2)
24756 BI(2)=HWHIGB(NOMASS,T,ZERO,ZERO,EMQ2)
24757 BI(3)=HWHIGB(NOMASS,U,ZERO,ZERO,EMQ2)
24758 BI(4)=HWHIGB(NOMASS,EMH2,ZERO,ZERO,EMQ2)
24762 CI(1)=HWHIGC(NOMASS,S,ZERO,ZERO,EMQ2)
24763 CI(2)=HWHIGC(NOMASS,T,ZERO,ZERO,EMQ2)
24764 CI(3)=HWHIGC(NOMASS,U,ZERO,ZERO,EMQ2)
24765 CI(7)=HWHIGC(NOMASS,EMH2,ZERO,ZERO,EMQ2)
24766 CI(4)=(S*CI(1)-EMH2*CI(7))/(S-EMH2)
24767 CI(5)=(T*CI(2)-EMH2*CI(7))/(T-EMH2)
24768 CI(6)=(U*CI(3)-EMH2*CI(7))/(U-EMH2)
24769 DI(1)=HWHIGD(NOMASS,U,T,EMH2,EMQ2)
24770 DI(2)=HWHIGD(NOMASS,S,U,EMH2,EMQ2)
24771 DI(3)=HWHIGD(NOMASS,S,T,EMH2,EMQ2)
24772 C Compute complex amplitudes
24773 TAMP(1)=HWHIG1(S,T,U,EMH2,EMQ2,1,2,3,4,5,6)
24774 TAMP(2)=HWHIG2(S,T,U,EMH2,EMQ2,1,2,3,0,0,0)
24775 TAMP(3)=HWHIG1(T,S,U,EMH2,EMQ2,2,1,3,5,4,6)
24776 TAMP(4)=HWHIG1(U,T,S,EMH2,EMQ2,3,2,1,6,5,4)
24777 TAMP(5)=HWHIG5(S,T,U,EMH2,EMQ2,1,0,4,0,0,0)
24778 TAMP(6)=HWHIG5(T,S,U,EMH2,EMQ2,2,0,5,0,0,0)
24779 TAMP(7)=HWHIG5(U,T,S,EMH2,EMQ2,3,0,6,0,0,0)
24781 TAMPI(I)= DREAL(TAMP(I))
24782 20 TAMPR(I)=-DIMAG(TAMP(I))
24783 C Square and add prefactors
24784 WTGG=0.03125*FLOAT(NCOLO*(NCOLO**2-1))/EMW2
24785 & *(TAMPR(1)**2+TAMPI(1)**2+TAMPR(2)**2+TAMPI(2)**2
24786 & +TAMPR(3)**2+TAMPI(3)**2+TAMPR(4)**2+TAMPI(4)**2)*FLUXGG
24787 WTQQ= 16.*(U**2+T**2)/(U+T)**2*EMQ2**2/(S*EMW2)
24788 & *(TAMPR(5)**2+TAMPI(5)**2)*FLUXQQ
24789 WTQG=-16.*(U**2+S**2)/(U+S)**2*EMQ2**2/(T*EMW2)
24790 & *(TAMPR(6)**2+TAMPI(6)**2)*FLUXGQ
24791 WTGQ=-16.*(S**2+T**2)/(S+T)**2*EMQ2**2/(U*EMW2)
24792 & *(TAMPR(7)**2+TAMPI(7)**2)*FLUXGQ
24795 *CMZ :- -23/08/94 13.22.29 by Mike Seymour
24796 *-- Author : Ulrich Baur & Nigel Glover, adapted by Ian Knowles
24797 *- split in 3 files by M. Kirsanov
24798 C-----------------------------------------------------------------------
24799 FUNCTION HWHIGB(NOMASS,S,T,EH2,EQ2)
24800 C-----------------------------------------------------------------------
24801 C One loop scalar integrals, used in HWHIGJ.
24802 C If NOMASS=.TRUE. use a small mass approx. for particle in loop.
24803 C-----------------------------------------------------------------------
24804 INCLUDE 'herwig65.inc'
24805 DOUBLE COMPLEX HWHIGB,HWUCI2,HWULI2,EPSI,PII
24806 DOUBLE PRECISION S,T,EQ2,EH2,RAT
24808 EXTERNAL HWULI2,HWUCI2
24810 C-----------------------------------------------------------------------
24811 C B_0(2p1.p2=S;mq,mq)
24812 C-----------------------------------------------------------------------
24813 PII=DCMPLX(ZERO,PIFAC)
24816 HWHIGB=-DLOG(RAT)+TWO
24817 IF (S.GT.ZERO) HWHIGB=HWHIGB+PII
24820 IF (S.LT.ZERO) THEN
24821 HWHIGB=TWO-TWO*DSQRT(ONE-ONE/RAT)
24822 & *DLOG(DSQRT(-RAT)+DSQRT(ONE-RAT))
24823 ELSEIF (S.GT.ZERO.AND.RAT.LT.ONE) THEN
24824 HWHIGB=TWO-TWO*DSQRT(ONE/RAT-ONE)*DASIN(DSQRT(RAT))
24825 ELSEIF (RAT.GT.ONE) THEN
24826 HWHIGB=TWO-DSQRT(ONE-ONE/RAT)
24827 & *(TWO*DLOG(DSQRT(RAT)+DSQRT(RAT-ONE))-PII)
24832 *CMZ :- -23/08/94 13.22.29 by Mike Seymour
24833 *-- Author : Ulrich Baur & Nigel Glover, adapted by Ian Knowles
24834 C-----------------------------------------------------------------------
24835 FUNCTION HWHIGC(NOMASS,S,T,EH2,EQ2)
24836 C-----------------------------------------------------------------------
24837 C One loop scalar integrals, used in HWHIGJ.
24838 C If NOMASS=.TRUE. use a small mass approx. for particle in loop.
24839 C-----------------------------------------------------------------------
24840 INCLUDE 'herwig65.inc'
24841 DOUBLE COMPLEX HWHIGC,HWUCI2,HWULI2,EPSI,PII
24842 DOUBLE PRECISION S,T,EQ2,EH2,RAT,COSH
24844 EXTERNAL HWULI2,HWUCI2
24846 C-----------------------------------------------------------------------
24847 C C_0(p{1,2}^2=0,2p1.p2=S;mq,mq,mq)
24848 C-----------------------------------------------------------------------
24849 PII=DCMPLX(ZERO,PIFAC)
24852 HWHIGC=HALF*DLOG(RAT)**2
24853 IF (S.GT.ZERO) HWHIGC=HWHIGC-HALF*PIFAC**2-PII*DLOG(RAT)
24857 IF (S.LT.ZERO) THEN
24858 HWHIGC=TWO*DLOG(DSQRT(-RAT)+DSQRT(ONE-RAT))**2/S
24859 ELSEIF (S.GT.ZERO.AND.RAT.LT.ONE) THEN
24860 HWHIGC=-TWO*(DASIN(DSQRT(RAT)))**2/S
24861 ELSEIF (RAT.GT.ONE) THEN
24862 COSH=DLOG(DSQRT(RAT)+DSQRT(RAT-ONE))
24863 HWHIGC=TWO*(COSH**2-PIFAC**2/FOUR-PII*COSH)/S
24868 *CMZ :- -23/08/94 13.22.29 by Mike Seymour
24869 *-- Author : Ulrich Baur & Nigel Glover, adapted by Ian Knowles
24870 C-----------------------------------------------------------------------
24871 FUNCTION HWHIGD(NOMASS,S,T,EH2,EQ2)
24872 C-----------------------------------------------------------------------
24873 C One loop scalar integrals, used in HWHIGJ.
24874 C If NOMASS=.TRUE. use a small mass approx. for particle in loop.
24875 C-----------------------------------------------------------------------
24876 INCLUDE 'herwig65.inc'
24877 DOUBLE COMPLEX HWHIGD,HWUCI2,HWULI2,EPSI,PII,Z1,Z2
24878 DOUBLE PRECISION S,T,EQ2,EH2,DLS,DLT,DLM,RZ12,DL1,DL2,
24881 EXTERNAL HWULI2,HWUCI2
24883 C-----------------------------------------------------------------------
24884 C D_0(p{1,2,3}^2=0,p4^2=EH2,2p1.p2=S,2p2.p3=T;mq,mq,mq,mq)
24885 C-----------------------------------------------------------------------
24886 PII=DCMPLX(ZERO,PIFAC)
24888 DLS=DLOG(DABS(S/EQ2))
24889 DLT=DLOG(DABS(T/EQ2))
24890 DLM=DLOG(DABS(EH2/EQ2))
24891 IF (S.GE.ZERO.AND.T.LE.ZERO) THEN
24892 DL1=DLOG((EH2-T)/S)
24895 HWHIGD=DLS**2+DLT**2-DLM**2+DL1**2
24896 & +TWO*(DLOG(S/(EH2-T))*DLOG(-T/S)+HWULI2(Z1)-HWULI2(Z2)
24897 & +PII*DLOG(EH2/(EH2-T)))
24898 ELSEIF (S.LT.ZERO.AND.T.LT.ZERO) THEN
24901 RZ12=ONE/DREAL(Z1*Z2)
24902 DL1=DLOG((T-EH2)/(S-EH2))
24904 HWHIGD=DLS**2+DLT**2-DLM**2+TWO*PIFAC**2/THREE
24905 & +TWO*DLOG(S/(T-EH2))*DLOG(ONE/DREAL(Z2))
24906 & +TWO*DLOG(T/(S-EH2))*DLOG(ONE/DREAL(Z1))
24907 & -DL1**2-DL2**2-TWO*(HWULI2(Z1)+HWULI2(Z2))
24908 & +TWO*PII*DLOG(RZ12**2*EH2/EQ2)
24910 HWHIGD=HWHIGD/(S*T)
24913 ROOT=DSQRT(ST**2-FOUR*ST*EQ2*(S+T-EH2))
24914 XP=HALF*(ST+ROOT)/ST
24916 HWHIGD=TWO/ROOT*(-HWUCI2(EQ2,S,XP)-HWUCI2(EQ2,T,XP)
24917 & +HWUCI2(EQ2,EH2,XP)+DLOG(-XM/XP)
24918 & *(LOG(EQ2+EPSI)-LOG(EQ2+EPSI-S*XP*XM)
24919 & +LOG(EQ2+EPSI-EH2*XP*XM)-LOG(EQ2+EPSI-T*XP*XM)))
24923 *CMZ :- -13/10/02 09.43.05 by Peter Richardson
24924 *-- Author : Kosuke Odagiri and Stefano Moretti
24925 C-----------------------------------------------------------------------
24926 C...Generate completely differential cross section (EVWGT) in the variables
24927 C...X(I) with I=1,4 (see below) for the processes from IPROC=1000-1099 (SM),
24928 C...IPROC=1111-1139 (MSSM), as described in the HERWIG 6 documentation file.
24929 C...(For IPROC=1140-1145 it describes MSSM charged Higgs production.)
24931 C...First release: 18-SEP-2002 by Stefano Moretti
24934 C--------------------------------------------------------------------------
24935 C LEPTOPRODUCTION OF MS(SM) HIGGSES IN ASSOCIATION WITH HEAVY QUARK PAIRS
24936 C--------------------------------------------------------------------------
24937 INCLUDE 'herwig65.inc'
24940 INTEGER IH,IQ,JQ,IIQ,JJQ
24944 DOUBLE PRECISION CV,CA,BR
24945 DOUBLE PRECISION BRHIGQ,EMQ,ENQ,GMQ,EMQQ,EMH,GMH,EMHWT
24946 DOUBLE PRECISION T,TL,TLMIN,TLMAX,TTMIN,TTMAX,CTMP,RCM,RCM2
24947 DOUBLE PRECISION X(4),XL(4),XU(4)
24948 DOUBLE PRECISION Q4(0:3),Q34(0:3)
24949 DOUBLE PRECISION CT5,ST5,CT4,ST4,CF4,SF4,RQ52,RQ5,RQ42,RQ4,PQ4
24950 DOUBLE PRECISION P1(0:3),P2(0:3),P3(0:3),P4(0:3),P5(0:3)
24951 DOUBLE PRECISION F(0:3),G(0:3)
24952 DOUBLE PRECISION ECM,SHAT,S
24953 DOUBLE PRECISION EMIN,EMIN1,EMIN2,PCM2,PCM
24954 DOUBLE PRECISION HFC,HBC
24955 DOUBLE PRECISION M2EE
24956 DOUBLE PRECISION ALPHA,EMSC2
24957 DOUBLE PRECISION HWRGEN,HWUAEM
24958 DOUBLE PRECISION PHI,CPHI,SPHI,ROT(3,3)
24959 DOUBLE PRECISION QAUX(0:3)
24960 DOUBLE PRECISION EPS,HCS,RCS,FACT
24961 DOUBLE PRECISION WEIGHT
24962 INTEGER IFL,KHIGGS,JH,JFL
24963 LOGICAL FIRST,GAUGE
24964 DOUBLE PRECISION E,Q3,YM3,GAM3,YM4,GAM4,GAM5,COLOUR
24965 DOUBLE PRECISION RM3,RM4,RM5
24966 DOUBLE PRECISION S2W,RMW,RMZ
24967 DOUBLE PRECISION RMHL,GAMHL
24968 DOUBLE PRECISION RMHH,GAMHH
24969 DOUBLE PRECISION RMHA,GAMHA
24970 EQUIVALENCE (RMHL,RMASS(203)),(RMHH,RMASS(204)),(RMHA,RMASS(205))
24972 EXTERNAL HWHIGM,HWRGEN,HWUAEM,HWH2HE,HWEONE,HWRLOG
24973 PARAMETER (EPS=1.D-9)
24974 SAVE HCS,M2EE,FACT,S,SHAT,P3,P4,P5
24975 SAVE IIQ,JJQ,JHIGGS
24976 C...ASSIGN Q/Q'-FLAVOUR.
24977 IF(IPROC.GE.1140)THEN
24979 IF(IPROC.EQ.1140)IQ=2
24980 IF(IPROC.EQ.1141)IQ=4
24981 IF(IPROC.EQ.1142)IQ=6
24982 IF(IPROC.EQ.1143)IQ=7
24983 IF(IPROC.EQ.1144)IQ=8
24984 IF(IPROC.EQ.1145)IQ=9
24988 IF(JQ.EQ.11)GMQ=HBAR/RLTIM(6)
24994 IF(IPROC.LT.1140)IH=3
24995 IF(IPROC.LT.1130)IH=2
24996 IF(IPROC.LT.1120)IH=1
24997 IQ=IPROC-1100-10*IH
25009 C...ASSIGN FINAL STATE MASSES.
25014 EMQ=RMASS(2*IQ-7+114+IAD)
25015 ENQ=RMASS(2*IQ-7+114 )
25017 EMH=RMASS(201+IHIGGS)
25018 GMH=HBAR/RLTIM(201+IHIGGS)
25020 C...ENERGY AT PARTON LEVEL.
25024 IF((EMH.LE.0.).OR.(EMH.GE.ECM))RETURN
25025 C...PHASE SPACE VARIABLES.
25026 C...X(1)=(EMQQ**2-(EMQ+ENQ)**2)/((ECM-EMH)**2-(EMQ+ENQ)**2),
25027 C...LIGHT QUARKS -> X(2)=(LOG|T|-LOG|TMIN|)/(LOG|TMAX|-LOG|TMIN|),
25028 C... X(3)=SIN(THETA4_CM_34),X(4)=COS(FI4_CM_34),
25029 C...HEAVY QUARKS -> X(2)=COS(THETA5_CM),
25030 C... X(3)=COS(THETA4_CM_34),X(4)=FI4_CM_34,
25031 C...PHASE SPACE BORDERS.
25034 IF((IQ+JQ).EQ.18)THEN
25046 C...SINGLE PHASE SPACE POINT.
25050 X(I)=XL(I)+(XU(I)-XL(I))*HWRGEN(0)
25051 WEIGHT=WEIGHT*ABS(XU(I)-XL(I))
25053 C...THREE PARTICLE KINEMATICS.
25054 EMQQ=SQRT(X(1)*((ECM-EMH)**2-(EMQ+ENQ)**2)+(EMQ+ENQ)**2)
25055 C...INCOMING PARTONS: ALL MASSLESS.
25057 IF((IQ+JQ).EQ.18)THEN
25060 ST4=SQRT(1.-CT4*CT4)
25064 PCM2=((ECM*ECM-EMIN*EMIN-EMIN*EMIN)**2
25065 & -(2.*EMIN*EMIN)**2)/(4.*ECM*ECM)
25067 RCM2=((ECM*ECM-EMQQ*EMQQ-EMH*EMH)**2
25068 & -(2.*EMQQ*EMH)**2)/(4.*ECM*ECM)
25070 TTMAX=EMIN**2+EMQQ**2-0.5D0/ECM/ECM
25071 & *((ECM*ECM+EMIN**2-EMIN**2)*(ECM*ECM+EMQQ**2-EMH**2)
25072 & -SQRT((ECM*ECM-(EMIN+EMIN)**2)*(ECM*ECM-(EMIN-EMIN)**2))
25073 & *SQRT((ECM*ECM-(EMQQ+EMH)**2)*(ECM*ECM-(EMQQ-EMH)**2)))
25074 TTMIN=EMIN**2+EMQQ**2-0.5D0/ECM/ECM
25075 & *((ECM*ECM+EMIN**2-EMIN**2)*(ECM*ECM+EMQQ**2-EMH**2)
25076 & +SQRT((ECM*ECM-(EMIN+EMIN)**2)*(ECM*ECM-(EMIN-EMIN)**2))
25077 & *SQRT((ECM*ECM-(EMQQ+EMH)**2)*(ECM*ECM-(EMQQ-EMH)**2)))
25078 TLMIN=LOG(ABS(TTMAX))
25079 TLMAX=LOG(ABS(TTMIN))
25080 TL=X(2)*(TLMAX-TLMIN)+TLMIN
25082 CTMP=-T-EMIN**2-EMQQ**2
25083 & +2.*SQRT(PCM**2+EMIN**2)*SQRT(RCM**2+EMQQ**2)
25084 CT5=CTMP/2./PCM/RCM
25086 CT4=SQRT(1.-ST4*ST4)
25088 SF4=SQRT(1.-CF4*CF4)
25090 IF(HWRLOG(HALF))THEN
25091 ST5=+SQRT(1.-CT5*CT5)
25093 ST5=-SQRT(1.-CT5*CT5)
25095 RQ52=((ECM*ECM-EMH*EMH-EMQQ*EMQQ)**2-(2.*EMH*EMQQ)**2)/
25105 P5(0)=SQRT(RQ52+EMH*EMH)
25109 Q34(0)=SQRT(RQ52+EMQQ*EMQQ)
25110 RQ42=((EMQQ*EMQQ-EMQ*EMQ-ENQ*ENQ)**2-(2.*EMQ*ENQ)**2)/
25120 Q4(0)=SQRT(RQ42+ENQ*ENQ)
25123 PQ4=PQ4+Q34(I)*Q4(I)
25125 P4(0)=(Q34(0)*Q4(0)+PQ4)/EMQQ
25128 P4(I)=Q4(I)+Q34(I)*(P4(0)+Q4(0))/(Q34(0)+EMQQ)
25132 IF(IPROC.GE.1140)THEN
25133 IF(SQRT(P4(1)**2+P4(2)**2).LT.PTMIN)RETURN
25135 IF((IQ.NE.6).AND.(IQ.NE.12).AND.
25136 & (JQ.NE.6).AND.(JQ.NE.12))THEN
25137 IF(SQRT(P3(1)**2+P3(2)**2).LT.PTMIN)RETURN
25138 IF(SQRT(P4(1)**2+P4(2)**2).LT.PTMIN)RETURN
25144 C...INITIAL STATE MOMENTA IN THE PARTONIC CM.
25145 PCM2=((SHAT-EMIN*EMIN-EMIN*EMIN)**2
25146 & -(2.*EMIN*EMIN)**2)/(4.*SHAT)
25148 P1(0)=SQRT(PCM2+EMIN*EMIN)
25152 P2(0)=SQRT(PCM2+EMIN*EMIN)
25156 C...COLOR STRUCTURED ME SUMMED/AVERAGED OVER FINAL/INITIAL SPINS AND COLORS.
25157 C...EW AND QCD COUPLINGS.
25160 ALPHA=HWUAEM(EMSC2)
25163 E=SQRT(4.D0*PIFAC*ALPHA)
25164 IF(IPROC.GE.1140)THEN
25167 IF(IQ.EQ.8)IFL=IQ+1
25168 IF(IQ.EQ.9)IFL=IQ+2
25175 C...CHARGED HIGGSES
25177 IF(IFL.LE.6)Q3=-1.D0/3.D0
25180 C...ASSIGN FERMION MOMENTA
25188 IF(IQ.EQ.8)IFL=IQ+1
25189 IF(IQ.EQ.9)IFL=IQ+2
25196 C...NEUTRAL HIGGSES
25197 IF((IFL.EQ.1).OR.(IFL.EQ.3).OR.(IFL.EQ.5 ))THEN
25199 ELSEIF((IFL.EQ.2).OR.(IFL.EQ.4).OR.(IFL.EQ.6 ))THEN
25201 ELSEIF((IFL.EQ.7).OR.(IFL.EQ.9).OR.(IFL.EQ.11))THEN
25204 IF((IFL.EQ.1).OR.(IFL.EQ.3).OR.(IFL.EQ. 5).OR.
25205 & (IFL.EQ.7).OR.(IFL.EQ.9).OR.(IFL.EQ.11))THEN
25207 ELSEIF((IFL.EQ.2).OR.(IFL.EQ.4).OR.(IFL.EQ.6))THEN
25211 IF(IHIGGS.NE.0)KHIGGS=IHIGGS-1
25213 C...ASSIGN FERMION MOMENTA
25224 GAMHL=HBAR/RLTIM(203)
25225 GAMHH=HBAR/RLTIM(204)
25226 GAMHA=HBAR/RLTIM(205)
25228 IF(IFL.LE.6)COLOUR=3.D0
25229 C...MSSM COUPLINGS.
25238 CALL HWH2HE(FIRST,GAUGE,JFL,JH,HFC,HBC,
25239 & E,S2W,TANB,ALPHAH,RMW,S,Q3,F,G,P5,
25240 & RM3,YM3,GAM3,RM4,YM4,GAM4,RM5,GAM5,
25241 & RMHL,GAMHL,RMHH,GAMHH,RMHA,GAMHA,
25242 & RMZ,GAMZ,COLOUR,M2EE)
25243 C...CONSTANT FACTORS: PHI ALONG BEAM AND CONVERSION GEV^2->NB.
25244 FACT=2.*PIFAC*GEV2NB
25245 C...PHASE SPACE JACOBIANS, PI'S AND FLUX.
25246 FACT=FACT*RQ4*RQ5/PCM/32./(2.*PIFAC)**5
25247 & *((ECM-EMH)**2-(EMQ+ENQ)**2)
25249 C...JACOBIANS FROM CT5 TO X(2).
25250 IF((IQ+JQ).EQ.18)THEN
25253 FACT=FACT*(TLMAX-TLMIN)/2./PCM/RCM*ABS(T)
25254 FACT=FACT*2.*ABS(ST4/CT4/SF4)
25256 C...CHARGE CONJUGATION.
25257 IF(IPROC.GE.1140)THEN
25258 C...YES FOR CHARGED HIGGS.
25261 C...NO FOR NEUTRAL HIGGSES.
25264 C...HIGGS RESONANCE.
25266 C...CONSTANT WEIGHT.
25268 C...INCLUDE BR OF HIGGS.
25270 IDEC=MOD(IPROC,100)
25271 IF (IDEC.GT.0.AND.IDEC.LE.12) FACT=FACT*BRHIG(IDEC)
25272 IF (IDEC.EQ.0) THEN
25275 BRHIGQ=BRHIGQ+BRHIG(I)
25279 IF (IDEC.EQ.10) THEN
25280 CALL HWDBOZ(198,ID1,ID2,CV,CA,BR,1)
25281 CALL HWDBOZ(199,ID1,ID2,CV,CA,BR,1)
25283 ELSEIF (IDEC.EQ.11) THEN
25284 CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,1)
25285 CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,1)
25290 C...SET UP FLAVOURS IN FINAL STATE.
25291 IF(IPROC.GE.1140)THEN
25292 IF(HWRGEN(0).LT.0.5)THEN
25310 IF (GENEV.AND.HCS.GT.RCS) THEN
25311 C...GENERATE EVENT.
25314 IF(IIQ.LE.12.AND.JJQ.LE.12)THEN
25319 IDN(4)=2*IIQ-7+114+IAD
25322 C...INCOMING PARTONS: NOW MASSIVE.
25323 EMIN1=RMASS(IDN(1))
25324 EMIN2=RMASS(IDN(2))
25325 C...REDO INITIAL STATE MOMENTA IN THE PARTONIC CM.
25326 PCM2=((SHAT-EMIN1*EMIN1-EMIN2*EMIN2)**2
25327 & -(2.*EMIN1*EMIN2)**2)/(4.*SHAT)
25329 P1(0)=SQRT(PCM2+EMIN1*EMIN1)
25333 P2(0)=SQRT(PCM2+EMIN2*EMIN2)
25337 C...SETS UP INCOMING STATUS AND IDS ONLY FOR 2->1: USE HWEONE.
25342 JDAHEP(1,NHEP )=NHEP+1
25343 JDAHEP(2,NHEP )=NHEP+3
25344 JMOHEP(1,NHEP+1)=NHEP
25345 JMOHEP(1,NHEP+2)=NHEP
25346 JMOHEP(1,NHEP+3)=NHEP
25347 C...RANDOMLY ROTATE FINAL STATE MOMENTA AROUND BEAM AXIS.
25348 PHI=2.*PIFAC*HWRGEN(0)
25364 IF(L.EQ.1)QAUX(M)=QAUX(M)+ROT(M,N)*P3(N)
25365 IF(L.EQ.2)QAUX(M)=QAUX(M)+ROT(M,N)*P4(N)
25366 IF(L.EQ.3)QAUX(M)=QAUX(M)+ROT(M,N)*P5(N)
25370 IF(L.EQ.1)P3(M)=QAUX(M)
25371 IF(L.EQ.2)P4(M)=QAUX(M)
25372 IF(L.EQ.3)P5(M)=QAUX(M)
25375 C...DO REAL INCOMING, OUTGOING MOMENTA IN THE LAB FRAME.
25377 IF(M.EQ.NHEP )GO TO 888
25381 IF(M.EQ.NHEP-2)PHEP(NN,M)=P1(N)
25382 IF(M.EQ.NHEP-1)PHEP(NN,M)=P2(N)
25383 IF(M.EQ.NHEP+1)PHEP(NN,M)=P3(N)*(1-FLIP)+P4(N)*FLIP
25384 IF(M.EQ.NHEP+2)PHEP(NN,M)=P4(N)*(1-FLIP)+P3(N)*FLIP
25385 IF(M.EQ.NHEP+3)PHEP(NN,M)=P5(N)
25389 C...NEEDS TO SET ALL FINAL STATE MASSES.
25390 PHEP(5,NHEP+1)=SQRT(ABS(PHEP(4,NHEP+1)**2
25391 & -PHEP(3,NHEP+1)**2
25392 & -PHEP(2,NHEP+1)**2
25393 & -PHEP(1,NHEP+1)**2))
25394 PHEP(5,NHEP+2)=SQRT(ABS(PHEP(4,NHEP+2)**2
25395 & -PHEP(3,NHEP+2)**2
25396 & -PHEP(2,NHEP+2)**2
25397 & -PHEP(1,NHEP+2)**2))
25398 PHEP(5,NHEP+3)=SQRT(ABS(PHEP(4,NHEP+3)**2
25399 & -PHEP(3,NHEP+3)**2
25400 & -PHEP(2,NHEP+3)**2
25401 & -PHEP(1,NHEP+3)**2))
25404 PHEP(I,NHEP )=PHEP(I,NHEP-2)+PHEP(I,NHEP-1)
25406 PHEP(5,NHEP )=SQRT(ABS(PHEP(4,NHEP )**2
25407 & -PHEP(3,NHEP )**2
25408 & -PHEP(2,NHEP )**2
25409 & -PHEP(1,NHEP )**2))
25410 C...SETS UP OUTGOING STATUS AND IDS.
25414 IDHW(NHEP+1)=IDN(3)
25415 IDHEP(NHEP+1)=IDPDG(IDN(3))
25416 IDHW(NHEP+2)=IDN(4)
25417 IDHEP(NHEP+2)=IDPDG(IDN(4))
25418 IDHW(NHEP+3)=IDN(5)
25419 IDHEP(NHEP+3)=IDPDG(IDN(5))
25420 C...SETS UP COLOUR CONNECTIONS.
25421 JMOHEP(2,NHEP+1)=NHEP+2
25422 JMOHEP(2,NHEP+2)=NHEP+1
25423 JMOHEP(2,NHEP-1)=NHEP-2
25424 JMOHEP(2,NHEP-2)=NHEP-1
25425 JMOHEP(2,NHEP+3)=NHEP+3
25426 JDAHEP(2,NHEP+1)=NHEP+2
25427 JDAHEP(2,NHEP+2)=NHEP+1
25428 JDAHEP(2,NHEP-1)=NHEP-1
25429 JDAHEP(2,NHEP-2)=NHEP-2
25430 JDAHEP(2,NHEP+3)=NHEP+3
25433 C...SET TO ZERO THE COEFFICIENTS OF THE SPIN DENSITY MATRICES.
25434 CALL HWVZRO(7,GCOEF)
25437 C...COLLECT WEIGHT.
25441 *CMZ :- -26/11/00 17.21.55 by Bryan Webber
25442 *-- Author : Kosuke Odagiri & Stefano Moretti
25443 C-----------------------------------------------------------------------
25444 C...Generate completely differential cross section (EVWGT) in the variables
25445 C...X(I) with I=1,3 (see below) for the processes IPROC=3315,3325,3335,3355,
25446 C...3365,3375 as described in the HERWIG 6 documentation file.
25447 C...It includes interface to PDFs and takes into account color connections
25450 C...First release: 16-AUG-1999 by Kosuke Odagiri
25451 C...Last modified: 26-SEP-1999 by Stefano Moretti
25452 C-----------------------------------------------------------------------
25454 C-----------------------------------------------------------------------
25455 C DRELL-YAN 2 PARTON -> 2 HIGGS PAIR (2HDM)
25456 C-----------------------------------------------------------------------
25457 INCLUDE 'herwig65.inc'
25458 DOUBLE PRECISION HWRGEN, HWUAEM, EPS, HCS, RCS, DIST, S, PF, QPE,
25459 & FACTR, SN2TH, MZ, MW, MNN(2,2), MCC(2), MCN(3), EMSC2, GW2, GZ2,
25460 & GHH(4), XWEIN, S2W, ECM_MAX, X(3), XL(3),
25461 & XU(3), WEIGHT, ECM, SHAT, TAU, RMH1, RMH2, EMH1, EMH2,
25462 & EMHWT1, EMHWT2, EMHHWT
25463 INTEGER I, J, IQ, IQ1, IQ2, ID1, ID2, IH, JH, IH1, IH2
25464 EXTERNAL HWRGEN, HWUAEM
25465 SAVE HCS,MNN,MCC,MCN,EMHHWT,S,SHAT
25466 PARAMETER (EPS = 1.D-9)
25467 DOUBLE COMPLEX Z, GZ, A, D, E
25468 PARAMETER (Z = (0.D0,1.D0))
25469 EQUIVALENCE (MZ, RMASS(200)), (MW, RMASS(198))
25472 RCS = HCS*HWRGEN(0)
25476 C...minimum transverse momentum.
25478 C...energy at hadron level.
25479 ECM_MAX=PBEAM1+PBEAM2
25481 C...phase space variables.
25482 C...X(1)=COS(THETA_CM),
25483 C...X(2)=(1./SHAT-1./ECM_MAX**2)/(1./(EMH1+EMH2)**2-1./ECM_MAX**2),
25484 C...X(3)=(LOG(TAU)-LOG(X1))/LOG(TAU),
25485 C...phase space borders.
25492 C...single phase space point.
25495 X(I)=XL(I)+(XU(I)-XL(I))*HWRGEN(0)
25496 WEIGHT=WEIGHT*ABS(XU(I)-XL(I))
25498 C...final state masses.
25499 IF((MOD(IPROC,10000).EQ.3365).OR.
25500 & (MOD(IPROC,10000).EQ.3375))THEN
25504 ELSE IF(MOD(IPROC,10000).EQ.3355)THEN
25508 ELSE IF((MOD(IPROC,10000).EQ.3315).OR.
25509 & (MOD(IPROC,10000).EQ.3325).OR.
25510 & (MOD(IPROC,10000).EQ.3335))THEN
25521 EMHHWT=EMHWT1*EMHWT2
25522 C...energy at parton level.
25523 ECM=SQRT(1./(X(2)*(1./(EMH1+EMH2)**2-1./ECM_MAX**2)
25525 IF((EMH1.LE.0.).OR.(EMH1.GE.ECM))RETURN
25526 IF((EMH2.LE.0.).OR.(EMH2.GE.ECM))RETURN
25529 C...momentum fractions X1 and X2.
25530 XX(1) = EXP(LOG(TAU)*(1.-X(3)))
25533 SN2TH = 0.25D0 - 0.25D0*COSTH**2
25535 EMSC2 = EMSCA*EMSCA
25536 CALL HWSGEN(.FALSE.)
25538 FACTR = GEV2NB*PIFAC*(HWUAEM(EMSC2))**2/SHAT/CAFAC*SN2TH/2.
25539 C...Jacobians from X1,X2 to X(2),X(3).
25540 FACTR = FACTR/S*(-LOG(TAU))*(1./(EMH1+EMH2)**2-1./ECM_MAX**2)
25541 C...constant weight.
25542 FACTR = FACTR*WEIGHT
25543 C...couplings and propagators.
25545 S2W = DSQRT(XWEIN*(TWO-XWEIN))
25546 GZ = S2W*(SHAT-MZ**2+Z*SHAT*GAMZ/MZ)/SHAT
25547 GZ2 = DREAL(DCONJG(GZ)*GZ)
25548 GW2 = ((ONE-MW**2/SHAT)**2+(GAMW/MW)**2)*XWEIN**2
25549 C...labels: 1 = h0, 2 = H0, 3 = A0, 4 = H+, 5 = H-.
25554 C...set to zero all MEs.
25563 C...start subprocesses.
25564 IF((MOD(IPROC,10000).EQ.3365).OR.
25565 & (MOD(IPROC,10000).EQ.3375))THEN
25571 QPE = SHAT-(EMH1+EMH2)**2
25572 IF (QPE.GT.ZERO) THEN
25573 PF = SQRT(QPE*(SHAT-(EMH1-EMH2)**2))/SHAT
25576 & FACTR*PF**3*GHH(IH)**2*(LFCH(IQ)**2+RFCH(IQ)**2)/GZ2
25582 ELSE IF(MOD(IPROC,10000).EQ.3355)THEN
25588 QPE = SHAT-(EMH1+EMH2)**2
25589 IF (QPE.GT.ZERO) THEN
25590 PF = SQRT(QPE*(SHAT-(EMH1-EMH2)**2))/SHAT
25593 D = QFCH(IQ)+A*LFCH(IQ)
25594 E = QFCH(IQ)+A*RFCH(IQ)
25595 MCC(IQ)=FACTR*PF**3*DREAL(DCONJG(D)*D+DCONJG(E)*E)
25600 ELSE IF((MOD(IPROC,10000).EQ.3315).OR.
25601 & (MOD(IPROC,10000).EQ.3325).OR.
25602 & (MOD(IPROC,10000).EQ.3335))THEN
25605 c q q' -> H h / H / A
25608 QPE = SHAT-(EMH1+EMH2)**2
25609 IF (QPE.GT.ZERO) THEN
25610 PF = SQRT(QPE*(SHAT-(EMH1-EMH2)**2))/SHAT
25611 MCN(IH)=FACTR*PF**3/GW2*HALF*GHH(IH)**2
25621 IF (DISF(ID1,1).LT.EPS) GOTO 1
25627 IQ = ID1 - ((ID1-1)/2)*2
25628 IF (DISF(ID2,2).LT.EPS) GOTO 1
25629 DIST = DISF(ID1,1)*DISF(ID2,2)*S*SHAT
25632 HCS = HCS + DIST*EMHHWT*MNN(1,IQ)
25633 IF (GENEV.AND.HCS.GT.RCS) THEN
25634 CALL HWHQCP(IH1,IH2,2134,1)
25638 HCS = HCS + DIST*EMHHWT*MNN(2,IQ)
25639 IF (GENEV.AND.HCS.GT.RCS) THEN
25640 CALL HWHQCP(IH1,IH2,2134,2)
25645 HCS = HCS + DIST*EMHHWT*MCC(IQ)
25646 IF (GENEV.AND.HCS.GT.RCS) THEN
25647 CALL HWHQCP(IH1,IH2,2134,3)
25652 c ud(+), ud(-), du(-), du(+)
25656 IF(VCKM(IQ1,IQ2).GT.EPS) THEN
25663 IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN
25664 DIST = VCKM(IQ1,IQ2)*DISF(ID1,1)*DISF(ID2,2)*S*SHAT
25667 HCS = HCS + DIST*EMHHWT*MCN(IH)
25668 IF (GENEV.AND.HCS.GT.RCS) THEN
25669 CALL HWHQCP(IH1,IH2,2134,3+IH)
25680 IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN
25681 DIST = VCKM(IQ1,IQ2)*DISF(ID1,1)*DISF(ID2,2)*S*SHAT
25684 HCS = HCS + DIST*EMHHWT*MCN(IH)
25685 IF (GENEV.AND.HCS.GT.RCS) THEN
25686 CALL HWHQCP(IH1,IH2,2134,3+IH)
25697 IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN
25698 DIST = VCKM(IQ1,IQ2)*DISF(ID1,1)*DISF(ID2,2)*S*SHAT
25701 HCS = HCS + DIST*EMHHWT*MCN(IH)
25702 IF (GENEV.AND.HCS.GT.RCS) THEN
25703 CALL HWHQCP(IH1,IH2,2134,3+IH)
25714 IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN
25715 DIST = VCKM(IQ1,IQ2)*DISF(ID1,1)*DISF(ID2,2)*S*SHAT
25718 HCS = HCS + DIST*EMHHWT*MCN(IH)
25719 IF (GENEV.AND.HCS.GT.RCS) THEN
25720 CALL HWHQCP(IH1,IH2,2134,3+IH)
25730 C...generate event.
25734 CALL HWETWO(.TRUE.,.TRUE.)
25736 CALL HWVZRO(7,GCOEF)
25740 *CMZ :- -23/08/94 13.22.29 by Mike Seymour
25741 *-- Author : Ian Knowles
25742 C-----------------------------------------------------------------------
25744 C-----------------------------------------------------------------------
25745 C QCD Higgs plus jet production; mean EVWGT = Sigma in nb*Higgs B.R.
25746 C Adapted from the program of U. Baur and E.W.N. Glover
25747 C See: Nucl. Phys. B339 (1990) 38
25748 C-----------------------------------------------------------------------
25749 INCLUDE 'herwig65.inc'
25750 DOUBLE PRECISION HWRGEN,HWRUNI,HWUALF,HWUAEM,EPS,RCS,EMH,EMHWT,
25751 & EMHTMP,BR,CV,CA,EMH2,ET,EJ,PT,EMT,EMAX,YMAX,YHINF,YHSUP,EXYH,
25752 & YMIN,YJINF,YJSUP,EXYJ,S,T,U,FACT,AMPQQ,AMPQG,AMPGQ,AMPGG,HCS,
25754 INTEGER I,IDEC,ID1,ID2
25755 EXTERNAL HWRGEN,HWRUNI,HWUALF,HWUAEM
25756 SAVE HCS,AMPGG,AMPGQ,AMPQG,AMPQQ,EMH,FACT
25757 PARAMETER (EPS=1.D-9)
25762 C Select a Higgs mass
25763 CALL HWHIGM(EMH,EMHWT)
25764 IF (EMH.LE.ZERO .OR. EMH.GE.PHEP(5,3)) RETURN
25765 C Store branching ratio for specified Higgs deacy channel
25766 IDEC=MOD(IPROC,100)
25768 IF (IDEC.EQ.0) THEN
25772 ELSEIF (IDEC.EQ.10) THEN
25773 CALL HWDBOZ(198,ID1,ID2,CV,CA,BR,1)
25774 CALL HWDBOZ(199,ID1,ID2,CV,CA,BR,1)
25776 ELSEIF (IDEC.EQ.11) THEN
25777 CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,1)
25778 CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,1)
25780 ELSEIF (IDEC.LE.12) THEN
25783 C Select subprocess kinematics
25787 EMT=SQRT(PT**2+EMH2)
25788 EMAX=0.5*(PHEP(5,3)+EMH2/PHEP(5,3))
25789 IF (EMAX.LE.EMT) RETURN
25790 YMAX=LOG((EMAX+SQRT(EMAX**2-EMT**2))/EMT)
25791 YHINF=MAX(YJMIN,-YMAX)
25792 YHSUP=MIN(YJMAX, YMAX)
25793 IF (YHSUP.LE.YHINF) RETURN
25794 EXYH=EXP(HWRUNI(1,YHINF,YHSUP))
25795 YMIN=LOG(PT/(PHEP(5,3)-EMT/EXYH))
25796 YMAX=LOG((PHEP(5,3)-EMT*EXYH)/PT)
25797 YJINF=MAX(YJMIN,YMIN)
25798 YJSUP=MIN(YJMAX,YMAX)
25799 IF (YJSUP.LE.YJINF) RETURN
25800 EXYJ=EXP(HWRUNI(2,YJINF,YJSUP))
25801 XX(1)=(EMT*EXYH+PT*EXYJ)/PHEP(5,3)
25802 XX(2)=(EMT/EXYH+PT/EXYJ)/PHEP(5,3)
25803 S=XX(1)*XX(2)*PHEP(5,3)**2
25804 T=EMH2-XX(1)*EMT*PHEP(5,3)/EXYH
25806 COSTH=(S+2.*T-EMH2)/(S-EMH2)
25807 C Set subprocess scale
25809 CALL HWSGEN(.FALSE.)
25810 FACT=GEV2NB*PT*EJ*(YHSUP-YHINF)*(YJSUP-YJINF)*BR*EMHWT
25811 & *HWUALF(1,EMSCA)**3*HWUAEM(EMH2)/(SWEIN*16*PIFAC*S**2)
25812 CALL HWHIGA(S,T,U,EMH2,AMPQQ,AMPQG,AMPGQ,AMPGG)
25816 IF (DISF(ID1,1).LT.EPS) GOTO 30
25817 FACTR=FACT*DISF(ID1,1)
25821 HCS=HCS+FACTR*DISF(ID2,2)*AMPQQ
25822 IF (GENEV.AND.HCS.GT.RCS) THEN
25823 CALL HWHQCP(13 ,201,2314,81)
25827 HCS=HCS+FACTR*DISF(ID2,2)*AMPQG
25828 IF (GENEV.AND.HCS.GT.RCS) THEN
25829 CALL HWHQCP(ID1,201,3124,82)
25832 ELSEIF (ID1.LT.13) THEN
25835 HCS=HCS+FACTR*DISF(ID2,2)*AMPQQ
25836 IF (GENEV.AND.HCS.GT.RCS) THEN
25837 CALL HWHQCP(13 ,201,3124,83)
25841 HCS=HCS+FACTR*DISF(ID2,2)*AMPQG
25842 IF (GENEV.AND.HCS.GT.RCS) THEN
25843 CALL HWHQCP(ID1,201,2314,84)
25849 IF (DISF(ID2,2).LT.EPS) GOTO 20
25851 HCS=HCS+FACTR*DISF(ID2,2)*AMPGQ
25852 IF (GENEV.AND.HCS.GT.RCS) THEN
25853 CALL HWHQCP(ID2,201,2314,85)
25857 HCS=HCS+FACTR*DISF(ID2,2)*AMPGQ
25858 IF (GENEV.AND.HCS.GT.RCS) THEN
25859 CALL HWHQCP(ID2,201,3124,86)
25864 HCS=HCS+FACTR*DISF(13,2)*AMPGG
25865 IF (GENEV.AND.HCS.GT.RCS) THEN
25866 CALL HWHQCP(13 ,201,2314,87)
25877 C Trick HWETWO into using off-shell Higgs mass
25878 EMHTMP=RMASS(IDN(4))
25880 C-- BRW fix 27/8/04: avoid double smearing of H mass
25881 CALL HWETWO(.TRUE.,.FALSE.)
25882 RMASS(IDN(4))=EMHTMP
25885 *CMZ :- -02/05/91 11.17.14 by Federico Carminati
25886 *-- Author : Mike Seymour
25887 C-----------------------------------------------------------------------
25888 SUBROUTINE HWHIGM(EM,WEIGHT)
25889 C-----------------------------------------------------------------------
25890 C CHOOSE HIGGS MASS:
25891 C IF (IOPHIG.EQ.0.OR.IOPHIG.EQ.2) THEN
25892 C CHOOSE HIGGS MASS ACCORDING TO
25893 C EM**4 / (EM**2-EMH**2)**2 + (GAMH*EMH)**2
25895 C CHOOSE HIGGS MASS ACCORDING TO
25896 C EMH * GAMH / (EM**2-EMH**2)**2 + (GAMH*EMH)**2
25898 C IF (IOPHIG.EQ.0.OR.IOPHIG.EQ.1) THEN
25899 C SUPPLY WEIGHT FACTOR TO YIELD
25900 C EM * GAM(EM)/ (EM**2-EMH**2)**2 + (GAM(EM)*EM)**2
25902 C SUPPLY WEIGHT FACTOR TO YIELD
25903 C EM*(EMH/EM)**4 * GAM(EM)
25904 C / (EM**2-EMH**2)**2 + (GAM(EM)*EMH**2/EM)**2
25905 C AS SUGGESTED IN M.H.SEYMOUR, PHYS.LETT.B354(1995)409.
25907 C-----------------------------------------------------------------------
25908 INCLUDE 'herwig65.inc'
25909 DOUBLE PRECISION HWRUNI,EM,WEIGHT,EMH,DIF,FUN,THETA,T,EMHLST,W0,
25910 & W1,EMM,GAMEM,T0,TMIN,TMAX,THEMIN,THEMAX,ZMIN,ZMAX,Z,F,GAMOFS
25913 SAVE EMHLST,GAMEM,T0,TMIN,TMAX,THEMIN,THEMAX,ZMIN,ZMAX,W0,W1
25914 EQUIVALENCE (EMH,RMASS(201))
25916 C---SET UP INTEGRAND AND INDEFINITE INTEGRAL OF DISTRIBUTION
25917 C THETA=ATAN((EM**2-EMH**2)/(GAMH*EMH)); T=TAN(THETA); T0=EMH/GAMH
25918 DIF(T,T0)=(T+T0)**2
25919 FUN(THETA,T,T0)=T + (T0*T0-1)*THETA + T0*LOG(1+T*T)
25920 C---SET UP CONSTANTS
25921 IF (EMH.NE.EMHLST .OR. FSTWGT) THEN
25925 TMIN=(MAX(ONE*1E-10,EMH-GAMMAX*GAMH))**2/GAMEM-T0
25926 TMAX=( EMH+GAMMAX*GAMH )**2/GAMEM-T0
25929 ZMIN=FUN(THEMIN,TMIN,T0)
25930 ZMAX=FUN(THEMAX,TMAX,T0)
25931 W0=(ZMAX-ZMIN) / PIFAC * GAMEM
25932 W1=(THEMAX-THEMIN) / PIFAC
25934 C---CHOOSE HIGGS MASS
25935 IF (IOPHIG.EQ.0.OR.IOPHIG.EQ.2) THEN
25938 Z=HWRUNI(1,ZMIN,ZMAX)
25939 C---SOLVE FUN(THETA,TAN(THETA))=Z BY NEWTON'S METHOD
25940 THETA=MAX(THEMIN, MIN(THEMAX, Z/T0**2 ))
25943 10 IF (I.LE.20 .AND. ABS(1-F/Z).GT.1E-4) THEN
25945 IF (2*ABS(THETA).GT.PIFAC) THEN
25946 CALL HWWARN('HWHIGM',51)
25951 THETA=THETA-(F-Z)/DIF(T,T0)
25954 IF (I.GT.20) CALL HWWARN('HWHIGM',1)
25956 THETA=HWRUNI(0,THEMIN,THEMAX)
25958 EM=SQRT(GAMEM*(T0+TAN(THETA)))
25959 C---NOW CALCULATE WEIGHT FACTOR FOR NON-CONSTANT HIGGS WIDTH
25961 CALL HWDHIG(GAMOFS)
25962 IF (IOPHIG.EQ.0) THEN
25963 WEIGHT=W0*GAMOFS*EM /EM**4 *((EM**2-EMH**2)**2 + GAMEM**2)
25964 & /((EM**2-EMH**2)**2 +(GAMOFS*EM)**2)
25965 ELSEIF (IOPHIG.EQ.1) THEN
25966 WEIGHT=W1*GAMOFS*EM /GAMEM *((EM**2-EMH**2)**2 + GAMEM**2)
25967 & /((EM**2-EMH**2)**2 +(GAMOFS*EM)**2)
25968 ELSEIF (IOPHIG.EQ.2) THEN
25970 WEIGHT=W0*GAMOFS*EMM/EM**4 *((EM**2-EMH**2)**2 + GAMEM**2)
25971 & /((EM**2-EMH**2)**2 +(GAMOFS*EMM)**2)
25972 ELSEIF (IOPHIG.EQ.3) THEN
25974 WEIGHT=W1*GAMOFS*EMM/GAMEM *((EM**2-EMH**2)**2 + GAMEM**2)
25975 & /((EM**2-EMH**2)**2 +(GAMOFS*EMM)**2)
25977 CALL HWWARN('HWHIGM',500)
25982 *CMZ :- -26/11/00 17.21.55 by Bryan Webber
25983 *-- Author : Stefano Moretti
25984 C-----------------------------------------------------------------------
25985 C...Generate completely differential cross section (EVWGT) in the variables
25986 C...X(I) with I=1,6 (see below) for the processes from IPROC=2500-2599 (SM),
25987 C...IPROC=3811-3899, as described in the HERWIG 6 documentation file.
25988 C...(For IPROC=3839,3869,3899 it describes MSSM charged Higgs production.)
25989 C...It includes interface to PDFs and takes into account color connections
25992 C...First release: 08-APR-1999 by Stefano Moretti
25993 C...Last modified: 28-JUN-2001 by Stefano Moretti
25996 C-----------------------------------------------------------------------
25997 C PRODUCTION OF MSSM HIGGSES IN ASSOCIATION WITH HEAVY QUARK PAIRS
25998 C-----------------------------------------------------------------------
25999 INCLUDE 'herwig65.inc'
26001 INTEGER I,J,K,L,M,N
26002 INTEGER IS,IH,IQ,JQ,IIQ,JJQ,IQMIN,IQMAX,IGG,IQQ
26003 INTEGER IDEC,NC,FLIP
26005 DOUBLE PRECISION CV,CA,BR
26006 DOUBLE PRECISION BRHIGQ,EMQ,ENQ,EMQQ,EMH,EMHWT,EMW
26007 DOUBLE PRECISION PTMMIN,PTNMIN
26008 DOUBLE PRECISION T,TL,TLMIN,TLMAX,TTMIN,TTMAX,CTMP,RCM,RCM2
26009 DOUBLE PRECISION X(6),XL(6),XU(6)
26010 DOUBLE PRECISION Q4(0:3),Q34(0:3)
26011 DOUBLE PRECISION CT5,ST5,CT4,ST4,CF4,SF4,RQ52,RQ5,RQ42,RQ4,PQ4
26012 DOUBLE PRECISION P1(0:3),P2(0:3),P3(0:3),P4(0:3),P5(0:3)
26013 DOUBLE PRECISION ECM_MAX,ECM,SHAT,S,TAU
26014 DOUBLE PRECISION EMIN,EMIN1,EMIN2,PCM2,PCM
26015 DOUBLE PRECISION M2GG,M2GGPL,M2GGMN,M2QQ
26016 DOUBLE PRECISION GM,GRND,FACGPM(2)
26017 DOUBLE PRECISION GGQQHT,GGQQHU,GGQQHNP,QQQQH
26018 DOUBLE PRECISION ALPHA,ALPHAS,EMSC2
26019 DOUBLE PRECISION HWRGEN,HWUAEM,HWUALF
26020 DOUBLE PRECISION PHI,CPHI,SPHI,ROT(3,3)
26021 DOUBLE PRECISION VCOL,GCOL,QAUX(0:3)
26022 DOUBLE PRECISION EPS,HCS,RCS,FACT,DIST
26023 DOUBLE PRECISION WEIGHT
26024 SAVE HCS,M2QQ,M2GG,M2GGPL,M2GGMN,FACT,S,SHAT,P3,P4,P5
26025 SAVE IIQ,JJQ,JHIGGS
26027 EXTERNAL HWHIGM,HWRGEN,HWUAEM,HWUALF,HWHQCP,HWH2QH,HWETWO,HWRLOG
26028 PARAMETER (EPS=1.D-9)
26029 EQUIVALENCE (EMW,RMASS(198)),(NC,NCOLO)
26030 C...assign Q/Q'-flavour.
26031 IF((MOD(IPROC,10000).EQ.3839).OR.
26032 & (MOD(IPROC,10000).EQ.3869).OR.
26033 & (MOD(IPROC,10000).EQ.3899))THEN
26036 GM=HBAR/RLTIM(6)*RMASS(6)
26043 IF(MOD(IPROC,10000).LT.4000)IS=6
26044 IF(MOD(IPROC,10000).LT.3870)IS=3
26045 IF(MOD(IPROC,10000).LT.3840)IS=0
26046 IH=MOD(IPROC,10000)/10-380-IS
26047 IQ=MOD(IPROC,10000)-3800-10*(IH+IS)
26058 C...assign final state masses.
26061 EMH=RMASS(201+IHIGGS)
26063 IF(IMSSM.EQ.0)CALL HWHIGM(EMH,EMHWT)
26064 C...energy at hadron level.
26065 ECM_MAX=PBEAM1+PBEAM2
26067 C...phase space variables.
26068 C...X(1)=(EMQQ**2-(EMQ+ENQ)**2)/((ECM-EMH)**2-(EMQ+ENQ)**2),
26069 C...LIGHT QUARKS -> X(2)=(LOG|T|-LOG|TMIN|)/(LOG|TMAX|-LOG|TMIN|),
26070 C... X(3)=SIN(THETA4_CM_34),X(4)=COS(FI4_CM_34),
26071 C...HEAVY QUARKS -> X(2)=COS(THETA5_CM),
26072 C... X(3)=COS(THETA4_CM_34),X(4)=FI4_CM_34,
26073 C...X(5)=(1./SHAT-1./ECM_MAX**2)/(1./(EMQ+ENQ+EMH)**2-1./ECM_MAX**2),
26074 C...X(6)=(LOG(TAU)-LOG(X1))/LOG(TAU);
26075 C...phase space borders.
26078 IF((IQ+JQ).EQ.18)THEN
26094 C...single phase space point.
26098 X(I)=XL(I)+(XU(I)-XL(I))*HWRGEN(0)
26099 WEIGHT=WEIGHT*ABS(XU(I)-XL(I))
26101 C...energy at parton level.
26105 IF((MOD(IPROC,10000).EQ.3839).OR.
26106 & (MOD(IPROC,10000).EQ.3869).OR.
26107 & (MOD(IPROC,10000).EQ.3899))THEN
26110 IF((IQ.NE.6).AND.(IQ.NE.12).AND.
26111 & (JQ.NE.6).AND.(JQ.NE.12))THEN
26119 ECM=SQRT(1./(X(5)*(1./(SQRT(PTMMIN**2+EMQ**2)
26120 & +SQRT(PTNMIN**2+ENQ**2)+EMH)**2
26123 IF((EMH.LE.0.).OR.(EMH.GE.ECM))RETURN
26126 C...momentum fractions X1 and X2.
26127 XX(1)=EXP(LOG(TAU)*(1.-X(6)))
26129 C...three particle kinematics.
26130 EMQQ=SQRT(X(1)*((ECM-EMH)**2-(EMQ+ENQ)**2)+(EMQ+ENQ)**2)
26131 C...incoming partons: all massless.
26133 IF((IQ+JQ).EQ.18)THEN
26136 ST4=SQRT(1.-CT4*CT4)
26140 PCM2=((ECM*ECM-EMIN*EMIN-EMIN*EMIN)**2
26141 & -(2.*EMIN*EMIN)**2)/(4.*ECM*ECM)
26143 RCM2=((ECM*ECM-EMQQ*EMQQ-EMH*EMH)**2
26144 & -(2.*EMQQ*EMH)**2)/(4.*ECM*ECM)
26146 TTMAX=EMIN**2+EMQQ**2-0.5D0/ECM/ECM
26147 & *((ECM*ECM+EMIN**2-EMIN**2)*(ECM*ECM+EMQQ**2-EMH**2)
26148 & -SQRT((ECM*ECM-(EMIN+EMIN)**2)*(ECM*ECM-(EMIN-EMIN)**2))
26149 & *SQRT((ECM*ECM-(EMQQ+EMH)**2)*(ECM*ECM-(EMQQ-EMH)**2)))
26150 TTMIN=EMIN**2+EMQQ**2-0.5D0/ECM/ECM
26151 & *((ECM*ECM+EMIN**2-EMIN**2)*(ECM*ECM+EMQQ**2-EMH**2)
26152 & +SQRT((ECM*ECM-(EMIN+EMIN)**2)*(ECM*ECM-(EMIN-EMIN)**2))
26153 & *SQRT((ECM*ECM-(EMQQ+EMH)**2)*(ECM*ECM-(EMQQ-EMH)**2)))
26154 TLMIN=LOG(ABS(TTMAX))
26155 TLMAX=LOG(ABS(TTMIN))
26156 TL=X(2)*(TLMAX-TLMIN)+TLMIN
26158 CTMP=-T-EMIN**2-EMQQ**2
26159 & +2.*SQRT(PCM**2+EMIN**2)*SQRT(RCM**2+EMQQ**2)
26160 CT5=CTMP/2./PCM/RCM
26162 CT4=SQRT(1.-ST4*ST4)
26163 IF (HWRLOG(HALF)) CT4=-CT4
26165 SF4=SQRT(1.-CF4*CF4)
26166 IF (HWRLOG(HALF)) SF4=-SF4
26168 ST5=SQRT(1.-CT5*CT5)
26169 IF (HWRLOG(HALF)) ST5=-ST5
26170 RQ52=((ECM*ECM-EMH*EMH-EMQQ*EMQQ)**2-(2.*EMH*EMQQ)**2)/
26180 P5(0)=SQRT(RQ52+EMH*EMH)
26184 Q34(0)=SQRT(RQ52+EMQQ*EMQQ)
26185 RQ42=((EMQQ*EMQQ-EMQ*EMQ-ENQ*ENQ)**2-(2.*EMQ*ENQ)**2)/
26195 Q4(0)=SQRT(RQ42+ENQ*ENQ)
26198 PQ4=PQ4+Q34(I)*Q4(I)
26200 P4(0)=(Q34(0)*Q4(0)+PQ4)/EMQQ
26203 P4(I)=Q4(I)+Q34(I)*(P4(0)+Q4(0))/(Q34(0)+EMQQ)
26207 IF((MOD(IPROC,10000).EQ.3839).OR.
26208 & (MOD(IPROC,10000).EQ.3869).OR.
26209 & (MOD(IPROC,10000).EQ.3899))THEN
26210 IF(SQRT(P4(1)**2+P4(2)**2).LT.PTMIN)RETURN
26212 IF((IQ.NE.6).AND.(IQ.NE.12).AND.
26213 & (JQ.NE.6).AND.(JQ.NE.12))THEN
26214 IF(SQRT(P3(1)**2+P3(2)**2).LT.PTMIN)RETURN
26215 IF(SQRT(P4(1)**2+P4(2)**2).LT.PTMIN)RETURN
26221 C...initial state momenta in the partonic CM.
26222 PCM2=((SHAT-EMIN*EMIN-EMIN*EMIN)**2
26223 & -(2.*EMIN*EMIN)**2)/(4.*SHAT)
26225 P1(0)=SQRT(PCM2+EMIN*EMIN)
26229 P2(0)=SQRT(PCM2+EMIN*EMIN)
26233 C...color structured ME summed/averaged over final/initial spins and colors.
26236 IF((MOD(IPROC,10000).EQ.3839).OR.
26237 & (MOD(IPROC,10000).EQ.3869).OR.
26238 & (MOD(IPROC,10000).EQ.3899))THEN
26239 IF(MOD(IPROC,10000).EQ.3869)IQQ=0
26240 IF(MOD(IPROC,10000).EQ.3899)IGG=0
26244 IF((MOD(IPROC,10000)/10-380).EQ.4)IQQ=0
26245 IF((MOD(IPROC,10000)/10-380).EQ.7)IGG=0
26249 FACGPM(1) = ENQ *GRND
26250 FACGPM(2) = EMQ*PARITY/GRND
26251 CALL HWH2QH(ECM,P1,P2,P3,P4,P5,EMQ,ENQ,EMH,FACGPM,GM,IGG,IQQ,
26252 & GGQQHT,GGQQHU,GGQQHNP,QQQQH)
26253 M2GG=GGQQHNP/(8.*CFFAC)
26254 M2GGPL=GGQQHT/(8.*CFFAC)
26255 M2GGMN=GGQQHU/(8.*CFFAC)
26256 M2QQ=QQQQH*(1.-1./CAFAC**2)/4.
26257 C...constant factors: phi along beam and conversion GeV^2->nb.
26258 FACT=2.*PIFAC*GEV2NB
26259 C...Jacobians from X1,X2 to X(5),X(6)
26260 FACT=FACT/S*(-LOG(TAU))*(1./(EMQ+ENQ+EMH)**2-1./ECM_MAX**2)
26261 C...phase space Jacobians, pi's and flux.
26262 FACT=FACT*RQ4*RQ5/PCM/32./(2.*PIFAC)**5
26263 & *((ECM-EMH)**2-(EMQ+ENQ)**2)
26265 C...Jacobians from CT5 to X(2).
26266 IF((IQ+JQ).EQ.18)THEN
26269 FACT=FACT*(TLMAX-TLMIN)/2./PCM/RCM*ABS(T)
26270 FACT=FACT*2.*ABS(ST4/CT4/SF4)
26272 C...EW and QCD couplings.
26275 ALPHA=HWUAEM(EMSC2)
26276 ALPHAS=HWUALF(1,EMSCA)
26277 FACT=FACT*4.*PIFAC*ALPHA/4./SWEIN/EMW/EMW
26278 FACT=FACT*16.*PIFAC**2*ALPHAS**2
26279 IF((MOD(IPROC,10000).EQ.3839).OR.
26280 & (MOD(IPROC,10000).EQ.3869).OR.
26281 & (MOD(IPROC,10000).EQ.3899))THEN
26282 C...enhancement factor for coupling+c.c.
26283 FACT=FACT*4.*VCKM(3,3)
26285 C...enhancement factor for MSSM.
26286 FACT=FACT*ENHANC(IQ)*ENHANC(IQ)
26288 C...Higgs resonance.
26290 C...constant weight.
26292 C...include BR of Higgs.
26294 IDEC=MOD(IPROC,100)
26295 IF (IDEC.GT.0.AND.IDEC.LE.12) FACT=FACT*BRHIG(IDEC)
26296 IF (IDEC.EQ.0) THEN
26299 BRHIGQ=BRHIGQ+BRHIG(I)
26303 c bug fix 11/10/02 SM.
26304 IF (IDEC.EQ.10) THEN
26305 CALL HWDBOZ(198,ID1,ID2,CV,CA,BR,1)
26306 CALL HWDBOZ(199,ID1,ID2,CV,CA,BR,1)
26308 ELSEIF (IDEC.EQ.11) THEN
26309 CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,1)
26310 CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,1)
26316 C...set up flavours in final state.
26317 IF((MOD(IPROC,10000).EQ.3839).OR.
26318 & (MOD(IPROC,10000).EQ.3869).OR.
26319 & (MOD(IPROC,10000).EQ.3899))THEN
26320 IF(HWRGEN(0).LT.0.5)THEN
26339 CALL HWSGEN(.FALSE.)
26342 IF((MOD(IPROC,10000).EQ.3839).OR.
26343 & (MOD(IPROC,10000).EQ.3869).OR.
26344 & (MOD(IPROC,10000).EQ.3899))THEN
26345 IF(MOD(IPROC,10000).EQ.3869)IQMIN=13
26346 IF(MOD(IPROC,10000).EQ.3899)IQMAX=12
26349 C...Some compilers don't like this statement.
26350 C Since it does nothing, just comment it out.
26351 C IF((MOD(IPROC,10000).GE.3811).AND.
26352 C & (MOD(IPROC,10000).LE.3836))CONTINUE
26353 IF((MOD(IPROC,10000).GE.3841).AND.
26354 & (MOD(IPROC,10000).LE.3866))IQMIN=13
26355 IF((MOD(IPROC,10000).GE.3871).AND.
26356 & (MOD(IPROC,10000).LE.3896))IQMAX=12
26360 IF(DISF(I,1).LT.EPS)THEN
26367 IF(DISF(J,2).LT.EPS)THEN
26370 DIST=DISF(I,1)*DISF(J,2)*S
26372 C...set up color connections: qq-scattering.
26374 HCS=HCS+M2QQ*DIST*FACT
26375 IF(GENEV.AND.HCS.GT.RCS)THEN
26377 CALL HWHQCP(IIQ,JJQ,2413, 4)
26380 ELSE IF(I.EQ.J+6)THEN
26381 HCS=HCS+M2QQ*DIST*FACT
26382 IF(GENEV.AND.HCS.GT.RCS)THEN
26384 CALL HWHQCP(JJQ,IIQ,3142,12)
26389 C...set up color connections: gg-scattering.
26391 & +(M2GGPL-M2GG*M2GGPL/(M2GGPL+M2GGMN)/FLOAT(NC)**2)*DIST*FACT
26392 IF(GENEV.AND.HCS.GT.RCS) THEN
26393 CALL HWHQCP(IIQ,JJQ,2413,27)
26397 & +(M2GGMN-M2GG*M2GGMN/(M2GGPL+M2GGMN)/FLOAT(NC)**2)*DIST*FACT
26398 IF(GENEV.AND.HCS.GT.RCS) THEN
26399 CALL HWHQCP(IIQ,JJQ,4123,28)
26407 C...generate event.
26411 C...incoming partons: now massive.
26412 EMIN1=RMASS(IDN(1))
26413 EMIN2=RMASS(IDN(2))
26414 C...redo initial state momenta in the partonic CM.
26415 PCM2=((SHAT-EMIN1*EMIN1-EMIN2*EMIN2)**2
26416 & -(2.*EMIN1*EMIN2)**2)/(4.*SHAT)
26418 P1(0)=SQRT(PCM2+EMIN1*EMIN1)
26422 P2(0)=SQRT(PCM2+EMIN2*EMIN2)
26426 C...randomly rotate final state momenta around beam axis.
26427 PHI=2.*PIFAC*HWRGEN(0)
26443 IF(L.EQ.1)QAUX(M)=QAUX(M)+ROT(M,N)*P3(N)
26444 IF(L.EQ.2)QAUX(M)=QAUX(M)+ROT(M,N)*P4(N)
26445 IF(L.EQ.3)QAUX(M)=QAUX(M)+ROT(M,N)*P5(N)
26449 IF(L.EQ.1)P3(M)=QAUX(M)
26450 IF(L.EQ.2)P4(M)=QAUX(M)
26451 IF(L.EQ.3)P5(M)=QAUX(M)
26454 C...use HWETWO only to set up status and IDs of quarks.
26457 CALL HWETWO(.TRUE.,.TRUE.)
26458 C...do real incoming, outgoing momenta in the lab frame.
26459 VCOL=(XX(1)-XX(2))/(XX(1)+XX(2))
26460 GCOL=(XX(1)+XX(2))/2./SQRT(XX(1)*XX(2))
26462 IF(M.EQ.NHEP-2)GO TO 888
26464 IF(M.EQ.NHEP-4)QAUX(N)=P1(N)
26465 IF(M.EQ.NHEP-3)QAUX(N)=P2(N)
26466 IF(M.EQ.NHEP-1)QAUX(N)=P3(N)*(1-FLIP)+P4(N)*FLIP
26467 IF(M.EQ.NHEP )QAUX(N)=P4(N)*(1-FLIP)+P3(N)*FLIP
26468 IF(M.EQ.NHEP+1)QAUX(N)=P5(N)
26471 PHEP(4,M)=GCOL*(QAUX(0)+VCOL*QAUX(3))
26472 PHEP(3,M)=GCOL*(QAUX(3)+VCOL*QAUX(0))
26477 C...needs to set all final state masses.
26478 PHEP(5,NHEP-1)=SQRT(ABS(PHEP(4,NHEP-1)**2
26479 & -PHEP(3,NHEP-1)**2
26480 & -PHEP(2,NHEP-1)**2
26481 & -PHEP(1,NHEP-1)**2))
26482 PHEP(5,NHEP )=SQRT(ABS(PHEP(4,NHEP )**2
26483 & -PHEP(3,NHEP )**2
26484 & -PHEP(2,NHEP )**2
26485 & -PHEP(1,NHEP )**2))
26486 PHEP(5,NHEP+1)=SQRT(ABS(PHEP(4,NHEP+1)**2
26487 & -PHEP(3,NHEP+1)**2
26488 & -PHEP(2,NHEP+1)**2
26489 & -PHEP(1,NHEP+1)**2))
26492 PHEP(I,NHEP-2)=PHEP(I,NHEP-4)+PHEP(I,NHEP-3)
26494 PHEP(5,NHEP-2)=SQRT(ABS(PHEP(4,NHEP-2)**2
26495 & -PHEP(3,NHEP-2)**2
26496 & -PHEP(2,NHEP-2)**2
26497 & -PHEP(1,NHEP-2)**2))
26498 C...status and IDs for Higgs.
26500 IDHW(NHEP+1)=IDN(5)
26501 IDHEP(NHEP+1)=IDPDG(IDN(5))
26502 C...Higgs colour (self-)connections.
26503 JMOHEP(1,NHEP+1)=NHEP-2
26504 JMOHEP(2,NHEP+1)=NHEP+1
26505 JDAHEP(2,NHEP+1)=NHEP+1
26506 JDAHEP(2,NHEP-2)=NHEP+1
26509 C...set to zero the coefficients of the spin density matrices.
26510 CALL HWVZRO(7,GCOEF)
26513 C-----------------------------------------------------------------------
26515 *CMZ :- -02/04/98 14.52.22 by Mike Seymour
26516 *-- Author : Mike Seymour
26517 *-- Modified: Stefano Moretti 04/05/98
26518 C-----------------------------------------------------------------------
26520 C-----------------------------------------------------------------------
26521 C HIGGS PRODUCTION VIA GLUON OR QUARK FUSION
26522 C MEAN EVWGT = HIGGS PRODN C-S * BRANCHING FRACTION IN NB
26523 C-----------------------------------------------------------------------
26524 INCLUDE 'herwig65.inc'
26525 DOUBLE PRECISION HWUALF,HWHIGT,HWRGEN,HWUSQR,HWUAEM,BRHIGQ,EMH,
26526 & CSFAC(13),EVSUM(13),EMFAC,CV,CA,BR,RWGT,E1,E2,EMQ,GFACTR,RQM(6)
26527 INTEGER IDEC,I,J,ID1,ID2
26528 EXTERNAL HWUALF,HWHIGT,HWRGEN,HWUSQR,HWUAEM
26529 SAVE CSFAC,BR,EVSUM
26531 RWGT=HWRGEN(0)*EVSUM(13)
26534 10 IF (RWGT.GT.EVSUM(I)) IDN(1)=I+1
26536 IF (IDN(1).LE.12) IDN(2)=IDN(1)-6
26537 IF (IDN(1).LE. 6) IDN(2)=IDN(1)+6
26542 EMH=RMASS(201+IHIGGS)
26544 IF(IMSSM.EQ.0)CALL HWHIGM(EMH,EMFAC)
26545 IF (EMH.LE.0 .OR. EMH.GE.PHEP(5,3)) RETURN
26547 IF (EMSCA.NE.EMLST) THEN
26549 XXMIN=(EMH/PHEP(5,3))**2
26551 GFACTR=GEV2NB*HWUAEM(EMH**2)/(576.*SWEIN*RMASS(198)**2)
26552 C--MOD BY BRW 16/07/03 TO USE RUNNING MASSES
26553 CALL HWURQM(EMH,RQM)
26556 CSFAC(I)=-GFACTR*HWHIGT( EMH)*XLMIN
26557 & *HWUALF(1,EMH)**2*EMFAC
26558 ELSEIF (I.GT.6) THEN
26559 CSFAC(I)=CSFAC(I-6)
26562 IF (EMQ.GT.ZERO.AND.EMH.GT.TWO*EMQ) THEN
26563 CSFAC(I)=-GFACTR*96.*PIFAC**2 *(1-(TWO*EMQ/EMH)**2)
26564 & *(EMQ/EMH)**2 *XLMIN *EMFAC*ENHANC(I)**2
26571 C INCLUDE BRANCHING RATIO OF HIGGS
26572 IDEC=MOD(IPROC,100)
26576 IF (IDEC.EQ.0) THEN
26579 30 BRHIGQ=BRHIGQ+BRHIG(I)
26581 ELSEIF (IDEC.EQ.10) THEN
26582 CALL HWDBOZ(198,ID1,ID2,CV,CA,BR,1)
26583 CALL HWDBOZ(199,ID1,ID2,CV,CA,BR,1)
26585 ELSEIF (IDEC.EQ.11) THEN
26586 CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,1)
26587 CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,1)
26589 ELSEIF (IDEC.LE.12) THEN
26594 CALL HWSGEN(.TRUE.)
26596 E1=PHEP(4,MAX(1,JDAHEP(1,1)))
26597 E2=PHEP(4,MAX(2,JDAHEP(1,2)))
26600 IF (EMH.GT.2*EMQ) THEN
26604 IF (XX(1).LT.0.5*(1-EMQ/E1+HWUSQR(1-2*EMQ/E1)) .AND.
26605 & XX(2).LT.0.5*(1-EMQ/E2+HWUSQR(1-2*EMQ/E2)))
26606 & EVWGT=EVWGT+DISF(I,1)*DISF(J,2)*CSFAC(I)*BR
26613 *CMZ :- -02/04/98 15.00.39 by Mike Seymour
26614 *-- Author : Mike Seymour
26615 C-----------------------------------------------------------------------
26616 FUNCTION HWHIGT(EMH)
26617 C-----------------------------------------------------------------------
26618 C CALCULATE MOD SQUARED I DEFINED AS IN BARGER & PHILLIPS p433
26619 C WARNING: THIS IS A FACTOR OF 3 GREATER THAN EHLQ'S ETA FUNCTION
26620 C PARITY=+1 FOR SCALAR AND -1 FOR PSEUDOSCALAR
26621 C-----------------------------------------------------------------------
26622 INCLUDE 'herwig65.inc'
26623 DOUBLE PRECISION HWHIGT,RATIO,RAT2,EMH,FREAL,FIMAG,ETALOG,AIREAL,
26627 IF (ABS(PARITY).NE.1) CALL HWWARN('HWHIGT',500)
26630 C---CONTRIBUTION FROM QUARK LOOPS
26634 IF (RAT2.GT.0.25) THEN
26635 FREAL=-2.*ASIN(0.5/RATIO)**2
26637 ELSEIF (RAT2.LT.0.25) THEN
26638 ETALOG=LOG( (0.5+SQRT(0.25-RAT2)) / (0.5-SQRT(0.25-RAT2)) )
26639 FREAL=0.5 * (ETALOG**2 - PIFAC**2)
26640 FIMAG=PIFAC * ETALOG
26642 FREAL=0.5 * ( - PIFAC**2)
26645 IF (PARITY.EQ.1) THEN
26646 AIREAL=AIREAL+3*RAT2*(2 + (4*RAT2-1)*FREAL)*ENHANC(I)
26647 AIIMAG=AIIMAG+3*RAT2*( (4*RAT2-1)*FIMAG)*ENHANC(I)
26649 AIREAL=AIREAL-2*RAT2*(FREAL)*ENHANC(I)
26650 AIIMAG=AIIMAG-2*RAT2*(FIMAG)*ENHANC(I)
26653 C---CONTRIBUTION FROM SQUARK LOOPS
26661 IF (RAT2.GT.0.25) THEN
26662 FREAL=-2.*ASIN(0.5/RATIO)**2
26664 ELSEIF (RAT2.LT.0.25) THEN
26665 ETALOG=LOG( (0.5+SQRT(0.25-RAT2)) / (0.5-SQRT(0.25-RAT2)) )
26666 FREAL=0.5 * (ETALOG**2 - PIFAC**2)
26667 FIMAG=PIFAC * ETALOG
26669 FREAL=0.5 * ( - PIFAC**2)
26672 IF (PARITY.EQ.1) THEN
26673 AIREAL=AIREAL-3*RAT2*(1 + 2*RAT2*FREAL)*SENHNC(K)
26674 AIIMAG=AIIMAG-3*RAT2*( 2*RAT2*FIMAG)*SENHNC(K)
26677 C---FUNCTION RETURNS MOD-SQUARED OF SUM
26678 HWHIGT=AIREAL**2 + AIIMAG**2
26681 *CMZ :- -26/11/00 17.21.55 by Bryan Webber
26682 *-- Author : Stefano Moretti
26683 C-----------------------------------------------------------------------
26684 C...Generate completely differential cross section (EVWGT) in the variables
26685 C...X(I) with I=1,4 (see below) for the processes of ther series
26686 C...IPROC=2600,2700 as described in the HERWIG 6 documentation file.
26687 C...It includes interface to PDFs and takes into account color connections
26690 C...First release: 8-APR-1999 by Stefano Moretti
26693 C-----------------------------------------------------------------------
26694 C MSSM NEUTRAL HIGGS PRODUCTION IN ASSOCIATION WITH GAUGE BOSON
26695 C--BRW fix 27/8/04: corrected off-shell gauge boson mass dependence
26696 C-----------------------------------------------------------------------
26697 INCLUDE 'herwig65.inc'
26698 INTEGER I,J,K,L,M,N
26701 DOUBLE PRECISION CV,CA,BR
26702 DOUBLE PRECISION BRHIGQ,EMH,EMHWT,EMV,RMV,GAMV,RMH
26703 DOUBLE PRECISION X(4),XL(4),XU(4)
26704 DOUBLE PRECISION CT,ST,CCT
26705 DOUBLE PRECISION P1(0:3),P2(0:3),P3(0:3),P4(0:3)
26706 DOUBLE PRECISION ECM_MAX,ECM,SHAT,S,TAU
26707 DOUBLE PRECISION EMIN,PCM2,PCM,RCM2,RCM
26708 DOUBLE PRECISION QQV(12,12),C4W,VQ(12),AQ(12)
26709 DOUBLE PRECISION M2,M2L,M2T
26710 DOUBLE PRECISION ALPHA,EMSC2
26711 DOUBLE PRECISION HWRGEN,HWUAEM
26712 DOUBLE PRECISION RNMIN,RNMAX,THETA_MIN,THETA_MAX
26713 DOUBLE PRECISION EPS,HCS,RCS,FACT,DIST
26714 DOUBLE PRECISION WEIGHT
26715 DOUBLE PRECISION VSAVE,HSAVE,CFT,QR,QL
26716 SAVE EMH,EMV,HCS,M2,M2L,M2T,FACT,QQV,S,CT
26718 EXTERNAL HWHIGM,HWRGEN,HWUAEM,HWH2VH,HWETWO,HWRLOG
26719 PARAMETER (EPS=1.D-9)
26724 IF((MOD(IPROC,10000).EQ.3310).OR.
26725 & (MOD(IPROC,10000).EQ.3320))THEN
26727 ELSEIF((MOD(IPROC,10000).EQ.3360).OR.
26728 & (MOD(IPROC,10000).EQ.3370))THEN
26737 C...assign final state masses.
26738 RMV=RMASS(198+2*IV)
26739 RMH=RMASS(201+IHIGGS)
26740 IF(IV.EQ.0)GAMV=GAMW
26741 IF(IV.EQ.1)GAMV=GAMZ
26744 IF(IMSSM.EQ.0)CALL HWHIGM(EMH,EMHWT)
26745 C...energy at hadron level.
26746 ECM_MAX=PBEAM1+PBEAM2
26748 C...phase space variables.
26749 C...X(1)=COS(THETA_CM),
26750 C...X(2)=(1./SHAT-1./ECM_MAX**2)/(1./(EMV+EMH)**2-1./ECM_MAX**2),
26751 C...X(3)=(LOG(TAU)-LOG(X1))/LOG(TAU),
26752 C...X(4)=(THETA-THETA_MIN)/(THETA_MAX-THETA_MIN),
26753 C...where THETA=ATAN((EMV*EMV-RMV*RMV)/RMV/GAMV);
26754 C...phase space borders.
26763 C...single phase space point.
26766 X(I)=XL(I)+(XU(I)-XL(I))*HWRGEN(0)
26767 WEIGHT=WEIGHT*ABS(XU(I)-XL(I))
26769 C...resonant boson mass.
26770 RNMIN=RMV-GAMMAX*GAMV
26771 THETA_MIN=ATAN((RNMIN*RNMIN-RMV*RMV)/RMV/GAMV)
26773 THETA_MAX=ATAN((RNMAX*RNMAX-RMV*RMV)/RMV/GAMV)
26774 EMV=SQRT((TAN(X(4)*(THETA_MAX-THETA_MIN)+THETA_MIN))
26775 & *RMV*GAMV+RMV*RMV)
26776 C...energy at parton level.
26777 ECM=SQRT(1./(X(2)*(1./(EMV+EMH)**2-1./ECM_MAX**2)
26779 IF((EMH.LE.0.).OR.(EMH.GE.ECM))RETURN
26782 C...momentum fractions X1 and X2.
26783 XX(1)=EXP(LOG(TAU)*(1.-X(3)))
26785 C...two particle kinematics.
26787 IF(HWRLOG(HALF))THEN
26792 C...single phase space point.
26793 RCM2=((SHAT-EMV*EMV-EMH*EMH)**2
26794 & -(2.*EMV*EMH)**2)/(4.*SHAT)
26796 P3(0)=SQRT(RCM2+EMV*EMV)
26800 P4(0)=SQRT(RCM2+EMH*EMH)
26804 C...incoming partons: massless.
26806 C...initial state momenta in the partonic CM.
26807 PCM2=((SHAT-EMIN*EMIN-EMIN*EMIN)**2
26808 & -(2.*EMIN*EMIN)**2)/(4.*SHAT)
26810 P1(0)=SQRT(PCM2+EMIN*EMIN)
26814 P2(0)=SQRT(PCM2+EMIN*EMIN)
26818 C...color structured ME summed/averaged over final/initial spins and colors.
26819 CALL HWH2VH(P1,P2,P3,P4,EMV,M2,M2L,M2T)
26821 C...vector-axial couplings of V to qq'/qq.
26832 c bug fix 20/05/01 SM.
26839 ELSE IF(IV.EQ.1)THEN
26840 C4W=(1.-SWEIN)*(1.-SWEIN)
26842 VQ(I)=2.*VFCH(1,1)*SQRT(SWEIN)*SQRT(1.-SWEIN)
26843 AQ(I)=2.*AFCH(1,1)*SQRT(SWEIN)*SQRT(1.-SWEIN)
26846 QQV(I,J)=(VQ(I)*VQ(I)+AQ(I)*AQ(I))/C4W
26849 VQ(I)=2.*VFCH(2,1)*SQRT(SWEIN)*SQRT(1.-SWEIN)
26850 AQ(I)=2.*AFCH(2,1)*SQRT(SWEIN)*SQRT(1.-SWEIN)
26853 QQV(I,J)=(VQ(I)*VQ(I)+AQ(I)*AQ(I))/C4W
26856 C...constant factors: phi along beam and conversion GeV^2->nb.
26857 FACT=2.*PIFAC*GEV2NB
26858 C...Jacobians from X1,X2 to X(2),X(3)
26859 FACT=FACT/S*(-LOG(TAU))*(1./(EMV+EMH)**2-1./ECM_MAX**2)
26860 C...phase space Jacobians, pi's and flux.
26861 FACT=FACT/64./PIFAC/PIFAC*RCM/PCM
26865 ALPHA=HWUAEM(EMSC2)
26866 C--BRW fix 27/8/04: RMV*RMV --> EMV*EMV
26867 FACT=FACT*16.*PIFAC**2*ALPHA**2/SWEIN/SWEIN*EMV*EMV
26868 C...enhancement factor for MSSM.
26869 FACT=FACT*ENHANC(10+IV)*ENHANC(10+IV)
26870 C...Higgs resonance.
26872 C...vector boson resonance.
26873 FACT=FACT*(THETA_MAX-THETA_MIN)/PIFAC
26874 C...constant weight.
26876 C...include BR of Higgs.
26878 IDEC=MOD(IPROC,100)
26879 IF (IDEC.GT.0.AND.IDEC.LE.12) FACT=FACT*BRHIG(IDEC)
26880 IF (IDEC.EQ.0) THEN
26883 BRHIGQ=BRHIGQ+BRHIG(I)
26887 c bug fix 11/10/02 SM.
26888 IF (IDEC.EQ.10) THEN
26889 CALL HWDBOZ(198,ID1,ID2,CV,CA,BR,1)
26890 CALL HWDBOZ(199,ID1,ID2,CV,CA,BR,1)
26892 ELSEIF (IDEC.EQ.11) THEN
26893 CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,1)
26894 CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,1)
26902 CALL HWSGEN(.FALSE.)
26904 IF(DISF(I,1).LT.EPS)THEN
26910 J=I+L*6+(-1)**(I+1)
26911 ELSE IF(IV.EQ.1)THEN
26914 IF(DISF(J,2).LT.EPS)THEN
26917 DIST=DISF(I,1)*DISF(J,2)*S
26918 C...QQV vector and axial couplings.
26920 C...no need to set up color connections.
26921 HCS=HCS+M2*DIST*FACT
26922 IF(GENEV.AND.HCS.GT.RCS)THEN
26923 C...generate event.
26927 & IDN(3)=NINT(198.5-.1667*FLOAT(ICHRG(IDN(1))+ICHRG(IDN(2))))
26928 IF(IV.EQ.1)IDN(3)=200
26936 C...trick HWETWO in using off-shell V and H masses.
26937 VSAVE=RMASS(IDN(3))
26938 HSAVE=RMASS(IDN(4))
26941 C-- BRW fix 27/8/04: avoid double smearing of W and H masses
26942 CALL HWETWO(.FALSE.,.FALSE.)
26943 RMASS(IDN(3))=VSAVE
26944 RMASS(IDN(4))=HSAVE
26946 C...set to zero the coefficients of the spin density matrices.
26947 CALL HWVZRO(7,GCOEF)
26949 C...calculates exactly polarized decay matrix of gauge boson.
26950 IF(IERROR.NE.0)RETURN
26953 IF(M2L.LT.0.)M2L=0.
26954 IF(M2T.LT.0.)M2T=0.
26955 RHOHEP(2,NHEP-1)=M2L/M2
26956 CFT=(M2-M2L)/(1.+CCT**2)/2.
26958 RHOHEP(1,NHEP-1)=CFT*(1.+CCT)**2/M2
26959 RHOHEP(3,NHEP-1)=CFT*(1.-CCT)**2/M2
26960 ELSE IF(IV.EQ.1)THEN
26961 QR=(VQ(I)-AQ(I))/2.
26962 QL=(VQ(I)+AQ(I))/2.
26963 RHOHEP(1,NHEP-1)=CFT*(QR**2*(1.-CCT)**2+QL**2*(1.+CCT)**2)
26964 & /(QR**2+QL**2)/M2
26965 RHOHEP(3,NHEP-1)=CFT*(QR**2*(1.+CCT)**2+QL**2*(1.-CCT)**2)
26966 & /(QR**2+QL**2)/M2
26975 *CMZ :- -26/04/91 14.55.44 by Federico Carminati
26976 *-- Author : Mike Seymour, modified by Stefano Moretti
26977 C-----------------------------------------------------------------------
26979 C-----------------------------------------------------------------------
26980 C HIGGS PRODUCTION VIA W/Z BOSON FUSION
26981 C MEAN EVWGT = HIGGS PRODN C-S * BRANCHING FRACTION IN NB
26982 C-----------------------------------------------------------------------
26983 INCLUDE 'herwig65.inc'
26984 DOUBLE PRECISION HWULDO,HWRUNI,HWRGEN,HWUAEM,K1MAX2,K1MIN2,K12,
26985 & K2MAX2,K2MIN2,K22,EMW2,EMW,ROOTS,EMH2,EMH,ROOTS2,P1,PHI1,PHI2,
26986 & COSPHI,COSTH1,SINTH1,COSTH2,SINTH2,P2,WEIGHT,TAU,TAULN,CSFAC,
26987 & PSUM,PROB,Q1(5),Q2(5),H(5),A,B,C,TERM2,BRHIGQ,G1WW,G2WW,G1ZZ(6),
26988 & G2ZZ(6),AWW,AZZ(6),PWW,PZZ(6),EMZ,EMZ2,RSUM,GLUSQ,GRUSQ,GLDSQ,
26989 & GRDSQ,GLESQ,GRESQ,CW,CZ,EMFAC,CV,CA,BR,X2,ETA,P1JAC,FACTR,EH2
26990 INTEGER HWRINT,IDEC,I,ID1,ID2,IHAD
26992 EXTERNAL HWULDO,HWRUNI,HWRGEN,HWUAEM,HWRINT
26993 SAVE EMW2,EMZ2,EE,GLUSQ,GRUSQ,GLDSQ,GRDSQ,GLESQ,GRESQ,G1ZZ,G2ZZ,
26994 & G1WW,G2WW,CW,CZ,PSUM,AWW,PWW,AZZ,PZZ,ROOTS,Q1,Q2,H,FACTR
26995 EQUIVALENCE (EMW,RMASS(198)),(EMZ,RMASS(200))
26997 IF (JDAHEP(1,IHAD).NE.0) IHAD=JDAHEP(1,IHAD)
27001 GLUSQ=(VFCH(2,1)+AFCH(2,1))**2
27002 GRUSQ=(VFCH(2,1)-AFCH(2,1))**2
27003 GLDSQ=(VFCH(1,1)+AFCH(1,1))**2
27004 GRDSQ=(VFCH(1,1)-AFCH(1,1))**2
27005 GLESQ=(VFCH(11,1)+AFCH(11,1))**2
27006 GRESQ=(VFCH(11,1)-AFCH(11,1))**2
27007 G1ZZ(1)=GLUSQ*GLUSQ+GRUSQ*GRUSQ
27008 G2ZZ(1)=GLUSQ*GRUSQ+GRUSQ*GLUSQ
27009 G1ZZ(2)=GLUSQ*GLDSQ+GRUSQ*GRDSQ
27010 G2ZZ(2)=GLUSQ*GRDSQ+GRUSQ*GLDSQ
27011 G1ZZ(3)=GLDSQ*GLDSQ+GRDSQ*GRDSQ
27012 G2ZZ(3)=GLDSQ*GRDSQ+GRDSQ*GLDSQ
27013 G1ZZ(4)=GLESQ*GLESQ+GRESQ*GRESQ
27014 G2ZZ(4)=GLESQ*GRESQ+GRESQ*GLESQ
27015 G1ZZ(5)=GLESQ*GLUSQ+GRESQ*GRUSQ
27016 G2ZZ(5)=GLESQ*GRUSQ+GRESQ*GLUSQ
27017 G1ZZ(6)=GLESQ*GLDSQ+GRESQ*GRDSQ
27018 G2ZZ(6)=GLESQ*GRDSQ+GRESQ*GLDSQ
27021 FACTR=GEV2NB/(128.*PIFAC**3)
27022 EH2=RMASS(201+IHIGGS)**2
27023 CW=256*(PIFAC*HWUAEM(EH2)/SWEIN)**3*EMW2
27024 CZ=256.*(PIFAC*HWUAEM(EH2))**3*EMZ2/(SWEIN*(1.-SWEIN))
27028 IF (.NOT.GENEV) THEN
27029 C---CHOOSE PARAMETERS
27031 EMH=RMASS(201+IHIGGS)
27033 IF(IMSSM.EQ.0)CALL HWHIGM(EMH,EMFAC)
27034 IF (EMH.LE.ZERO .OR. EMH.GE.PHEP(5,3)) RETURN
27039 TAU=(EMH/PHEP(5,3))**2
27041 ROOTS=PHEP(5,3)*SQRT(EXP(HWRUNI(0,-1D-10,TAULN)))
27045 C---CHOOSE P1 ACCORDING TO (1-ETA)*(ETA-X2)/ETA**2
27046 C WHERE ETA=1-2P1/ROOTS AND X2=EMH**2/S
27048 1 ETA=X2**HWRGEN(0)
27049 IF (HWRGEN(0)*(1-EMH/ROOTS)**2*ETA.GT.(1-ETA)*(ETA-X2))GOTO 1
27050 P1JAC=0.5*ROOTS*ETA**2/((1-ETA)*(ETA-X2))
27051 & *(-LOG(X2)*(1+X2)-2*(1-X2))
27052 P1=0.5*ROOTS*(1-ETA)
27053 C---CHOOSE PHI1,2 UNIFORMLY
27054 PHI1=2*PIFAC*HWRGEN(0)
27055 PHI2=2*PIFAC*HWRGEN(0)
27056 COSPHI=COS(PHI2-PHI1)
27057 C---CHOOSE K1^2, ON PROPAGATOR FACTOR
27060 K12=EMW2-(EMW2+K1MAX2)*(EMW2+K1MIN2)/
27061 & ((K1MAX2-K1MIN2)*HWRGEN(0)+(EMW2+K1MIN2))
27062 C---CALCULATE COSTH1 FROM K1^2
27063 COSTH1=1+K12/(P1*ROOTS)
27064 SINTH1=SQRT(1-COSTH1**2)
27066 K2MAX2=ROOTS*(ROOTS2-EMH2-2*ROOTS*P1)*(ROOTS-P1-P1*COSTH1)
27067 & /((ROOTS-P1)**2-(P1*COSTH1)**2-(P1*SINTH1*COSPHI)**2)
27069 K22=EMW2-(EMW2+K2MAX2)*(EMW2+K2MIN2)/
27070 & ((K2MAX2-K2MIN2)*HWRGEN(0)+(EMW2+K2MIN2))
27071 C---CALCULATE A,B,C FACTORS, AND...
27072 A=-2*K22*P1*COSTH1 - ROOTS*(ROOTS2-EMH2-2*ROOTS*P1)
27073 B=-2*K22*P1*SINTH1*COSPHI
27074 C=+2*K22*P1 - 2*ROOTS*K22 - ROOTS*(ROOTS2-EMH2-2*ROOTS*P1)
27075 C---SOLVE A*COSTH2 + B*SINTH2 + C = 0 FOR COSTH2
27076 TERM2=B**2 + A**2 - C**2
27077 IF (TERM2.LT.ZERO) RETURN
27078 TERM2=B*SQRT(TERM2)
27079 IF (A.GE.ZERO) RETURN
27080 COSTH2=(-A*C + TERM2)/(A**2+B**2)
27081 SINTH2=SQRT(1-COSTH2**2)
27082 C---FINALLY, GET P2
27083 IF (COSTH2.EQ.-ONE) RETURN
27084 P2=-K22/(ROOTS*(1+COSTH2))
27085 C---LOAD UP CMF MOMENTA
27086 Q1(1)=P1*SINTH1*COS(PHI1)
27087 Q1(2)=P1*SINTH1*SIN(PHI1)
27091 Q2(1)=P2*SINTH2*COS(PHI2)
27092 Q2(2)=P2*SINTH2*SIN(PHI2)
27099 H(4)=-Q1(4)-Q2(4)+ROOTS
27101 C---CALCULATE MATRIX ELEMENTS SQUARED
27102 AWW=ENHANC(10)**2 * CW*(ROOTS2/2*HWULDO(Q1,Q2)*G1WW
27103 & +ROOTS2/4*P1*P2*(1+COSTH1)*(1-COSTH2)*G2WW)
27105 AZZ(I)=ENHANC(11)**2 * CZ*(ROOTS2/2*HWULDO(Q1,Q2)*G1ZZ(I)
27106 & +ROOTS2/4*P1*P2*(1+COSTH1)*(1-COSTH2)*G2ZZ(I))
27107 & *((K12-EMW2)/(K12-EMZ2)*(K22-EMW2)/(K22-EMZ2))**2
27109 C---CALCULATE WEIGHT IN INTEGRAL
27110 WEIGHT=FACTR*P2*P1JAC/(ROOTS2**2*HWULDO(H,Q2))
27111 & *(K1MAX2-K1MIN2)/((K1MAX2+EMW2)*(K1MIN2+EMW2))
27112 & *(K2MAX2-K2MIN2)/((K2MAX2+EMW2)*(K2MIN2+EMW2))
27115 XXMIN=(ROOTS/PHEP(5,3))**2
27117 C---INCLUDE BRANCHING RATIO OF HIGGS
27119 IDEC=MOD(IPROC,100)
27120 IF (IDEC.GT.0.AND.IDEC.LE.12) WEIGHT=WEIGHT*BRHIG(IDEC)
27121 IF (IDEC.EQ.0) THEN
27124 20 BRHIGQ=BRHIGQ+BRHIG(I)
27125 WEIGHT=WEIGHT*BRHIGQ
27127 IF (IDEC.EQ.10) THEN
27128 CALL HWDBOZ(198,ID1,ID2,CV,CA,BR,1)
27129 CALL HWDBOZ(199,ID1,ID2,CV,CA,BR,1)
27131 ELSEIF (IDEC.EQ.11) THEN
27132 CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,1)
27133 CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,1)
27142 CSFAC=-WEIGHT*TAULN
27145 CALL HWSFUN(XX(2),EMSCA,IDHW(IHAD),NSTRU,DISF(1,2),2)
27146 IF (IDHW(1).LE.126) THEN
27147 PWW=(DISF(2,2)+DISF(4,2)+DISF(7,2)+DISF( 9,2))*AWW
27149 PWW=(DISF(1,2)+DISF(3,2)+DISF(8,2)+DISF(10,2))*AWW
27151 PZZ(5)=(DISF(2,2)+DISF(4,2)+DISF(8,2)+DISF(10,2))*AZZ(5)
27152 PZZ(6)=(DISF(1,2)+DISF(3,2)+DISF(7,2)+DISF( 9,2))*AZZ(6)
27153 PSUM=PWW+PZZ(5)+PZZ(6)
27156 CSFAC=WEIGHT*TAULN*XLMIN
27157 CALL HWSGEN(.TRUE.)
27158 PWW=((DISF(2,1)+DISF(4, 1)+DISF(7,1)+DISF(9,1))
27159 & *(DISF(8,2)+DISF(10,2)+DISF(1,2)+DISF(3,2))
27160 & +(DISF(8,1)+DISF(10,1)+DISF(1,1)+DISF(3,1))
27161 & *(DISF(2,2)+DISF(4, 2)+DISF(7,2)+DISF(9,2)))
27163 PZZ(1)=((DISF(2,1)+DISF(4,1)+DISF(8,1)+DISF(10,1))
27164 & *(DISF(2,2)+DISF(4,2)+DISF(8,2)+DISF(10,2)))
27166 PZZ(2)=((DISF(2,1)+DISF(4,1)+DISF(8,1)+DISF(10,1))
27167 & *(DISF(1,2)+DISF(3,2)+DISF(7,2)+DISF(9, 2))
27168 & +(DISF(1,1)+DISF(3,1)+DISF(7,1)+DISF(9, 1))
27169 & *(DISF(2,2)+DISF(4,2)+DISF(8,2)+DISF(10,2)))
27171 PZZ(3)=((DISF(1,1)+DISF(3,1)+DISF(7,1)+DISF(9,1))
27172 & *(DISF(1,2)+DISF(3,2)+DISF(7,2)+DISF(9,2)))
27174 PSUM=PWW+PZZ(1)+PZZ(2)+PZZ(3)
27175 C---EVENT WEIGHT IS SUM OVER ALL COMBINATIONS
27180 C---CHOOSE EVENT TYPE
27181 RSUM=PSUM*HWRGEN(0)
27182 C---ELECTRON BEAMS?
27187 IF (RSUM.LT.AWW) THEN
27195 C---LEPTON-HADRON COLLISION?
27199 IF (RSUM.LT.PWW) THEN
27200 24 IDN(2)=HWRINT(1,8)
27201 IF (IDN(2).GE.5) IDN(2)=IDN(2)+2
27202 IF (ICHRG(IDN(1))*ICHRG(IDN(2)).GT.0) GOTO 24
27203 PROB=DISF(IDN(2),2)*AWW/PWW
27204 IF (HWRGEN(0).GT.PROB) GOTO 24
27206 IF (HWRGEN(0).GT.SCABI) THEN
27207 IDN(4)= 4*INT((IDN(2)-1)/2)-IDN(2)+3
27209 IDN(4)=12*INT((IDN(2)-1)/6)-IDN(2)+5
27211 C---ZZ FUSION FROM U-TYPE QUARK?
27212 ELSEIF (RSUM.LT.PWW+PZZ(5)) THEN
27213 26 IDN(2)=2*HWRINT(1,4)
27214 IF (IDN(2).GE.5) IDN(2)=IDN(2)+2
27215 PROB=DISF(IDN(2),2)*AZZ(5)/PZZ(5)
27216 IF (HWRGEN(0).GT.PROB) GOTO 26
27219 C---ZZ FUSION FROM D-TYPE QUARK?
27221 28 IDN(2)=2*HWRINT(1,4)-1
27222 IF (IDN(2).GE.5) IDN(2)=IDN(2)+2
27223 PROB=DISF(IDN(2),2)*AZZ(6)/PZZ(6)
27224 IF (HWRGEN(0).GT.PROB) GOTO 28
27231 IF (RSUM.LT.PWW) THEN
27234 IF (IDN(I).GE.5) IDN(I)=IDN(I)+2
27236 IF (ICHRG(IDN(1))*ICHRG(IDN(2)).GT.0) GOTO 31
27237 PROB=DISF(IDN(1),1)*DISF(IDN(2),2)*AWW/PWW
27238 IF (HWRGEN(0).GT.PROB) GOTO 31
27239 C---CHOOSE OUTGOING QUARKS
27241 IF (HWRGEN(0).GT.SCABI) THEN
27242 IDN(I+2)=4*INT((IDN(I)-1)/2)-IDN(I)+3
27244 IDN(I+2)=12*INT((IDN(I)-1)/6)-IDN(I)+5
27247 C---ZZ FUSION FROM U-TYPE QUARKS?
27248 ELSEIF (RSUM.LT.PWW+PZZ(1)) THEN
27250 IDN(I)=2*HWRINT(1,4)
27251 IF (IDN(I).GE.5) IDN(I)=IDN(I)+2
27253 PROB=DISF(IDN(1),1)*DISF(IDN(2),2)*AZZ(1)/PZZ(1)
27254 IF (HWRGEN(0).GT.PROB) GOTO 41
27257 C---ZZ FUSION FROM D-TYPE QUARKS?
27258 ELSEIF (RSUM.LT.PWW+PZZ(1)+PZZ(3)) THEN
27260 IDN(I)=2*HWRINT(1,4)-1
27261 IF (IDN(I).GE.5) IDN(I)=IDN(I)+2
27263 PROB=DISF(IDN(1),1)*DISF(IDN(2),2)*AZZ(3)/PZZ(3)
27264 IF (HWRGEN(0).GT.PROB) GOTO 51
27267 C---ZZ FUSION FROM UD-TYPE PAIRS?
27269 61 IF (HWRGEN(0).GT.HALF) THEN
27270 IDN(1)=2*HWRINT(1,4)-1
27271 IDN(2)=2*HWRINT(1,4)
27273 IDN(1)=2*HWRINT(1,4)
27274 IDN(2)=2*HWRINT(1,4)-1
27277 62 IF (IDN(I).GE.5) IDN(I)=IDN(I)+2
27278 PROB=DISF(IDN(1),1)*DISF(IDN(2),2)*AZZ(2)/PZZ(2)
27279 IF (HWRGEN(0).GT.PROB) GOTO 61
27284 C---NOW BOOST TO LAB, AND SET UP STATUS CODES etc
27287 IF (.NOT.EE) CALL HWEONE
27289 JDAHEP(1,NHEP)=NHEP+1
27290 JDAHEP(2,NHEP)=NHEP+3
27291 JMOHEP(1,NHEP+1)=NHEP
27292 JMOHEP(1,NHEP+2)=NHEP
27293 JMOHEP(1,NHEP+3)=NHEP
27294 C---OUTGOING MOMENTA (GIVE QUARKS MASS NON-COVARIANTLY!)
27295 Q1(5)=RMASS(IDN(1))
27296 Q1(4)=SQRT(Q1(4)**2+Q1(5)**2)
27297 Q2(5)=RMASS(IDN(2))
27298 Q2(4)=SQRT(Q2(4)**2+Q2(5)**2)
27299 H(4)=-Q1(4)-Q2(4)+PHEP(5,NHEP)
27301 CALL HWULOB(PHEP(1,NHEP),Q1,PHEP(1,NHEP+1))
27302 CALL HWULOB(PHEP(1,NHEP),Q2,PHEP(1,NHEP+2))
27303 CALL HWULOB(PHEP(1,NHEP),H,PHEP(1,NHEP+3))
27308 IDHW(NHEP+1)=IDN(3)
27309 IDHEP(NHEP+1)=IDPDG(IDN(3))
27310 IDHW(NHEP+2)=IDN(4)
27311 IDHEP(NHEP+2)=IDPDG(IDN(4))
27312 IDHW(NHEP+3)=201+IHIGGS
27313 IDHEP(NHEP+3)=IDPDG(201+IHIGGS)
27315 JMOHEP(2,NHEP+1)=NHEP-2
27316 JMOHEP(2,NHEP+2)=NHEP-1
27317 JMOHEP(2,NHEP-1)=NHEP+2
27318 JMOHEP(2,NHEP-2)=NHEP+1
27319 JMOHEP(2,NHEP+3)=NHEP+3
27320 JDAHEP(2,NHEP+1)=NHEP-2
27321 JDAHEP(2,NHEP+2)=NHEP-1
27322 JDAHEP(2,NHEP-1)=NHEP+2
27323 JDAHEP(2,NHEP-2)=NHEP+1
27324 JDAHEP(2,NHEP+3)=NHEP+3
27329 *CMZ :- -26/04/91 13.37.37 by Federico Carminati
27330 *-- Author : Mike Seymour
27331 C-----------------------------------------------------------------------
27332 FUNCTION HWHIGY(A,B,XP)
27333 C-----------------------------------------------------------------------
27334 C CALCULATE THE INTEGRAL OF BERENDS AND KLEISS APPENDIX B
27335 C-----------------------------------------------------------------------
27337 DOUBLE COMPLEX XQ,Z1,Z2,Z3,Z4,C0,C1,C2,C3,C4,C5,C6,C7,C8,FUN,Z
27338 DOUBLE PRECISION HWHIGY,TWO,A,B,XP,Y
27339 PARAMETER (TWO=2.D0)
27340 C---DECLARE ALL THE STATEMENT-FUNCTION DEFINITIONS
27341 C0(Z,A)=(Z**2-A)**2*((Z**2+A)**2-24*Z*(Z**2+A)+8*Z**2*(A+6))/Z**4
27343 C2(Z,A)=-A**3*(24*Z-A)/(2*Z**2)
27344 C3(Z,A)=A**2*(8*Z**2*(A+6)-24*A*Z+A**2)/Z**3
27345 C4(Z,A)=-A**2*(24*Z**3+8*Z**2*(A+6)-24*A*Z+A**2)/Z**4
27346 C5(Z,A)=Z**3-24*Z**2+8*Z*(A+6)+24*A
27347 C6(Z,A)=0.5*Z**2-12*Z+4*(A+6)
27350 FUN(Z,Y,A)=C0(Z,A)*LOG(Y-Z)
27359 C---NOW EVALUATE THE INTEGRAL
27363 Z1=XQ+SQRT(XQ**2-A)
27364 Z2=XQ-SQRT(XQ**2-A)
27365 Z3=FUN(Z1,TWO,A)-FUN(Z1,SQRT(A),A)
27366 Z4=FUN(Z2,TWO,A)-FUN(Z2,SQRT(A),A)
27367 HWHIGY=DIMAG((Z3-Z4)/(Z1-Z2))/(8*B)
27370 *CMZ :- -02/05/91 11.18.44 by Federico Carminati
27371 *-- Author : Mike Seymour, modified by Stefano Moretti
27372 C-----------------------------------------------------------------------
27374 C-----------------------------------------------------------------------
27375 C HIGGS PRODUCTION VIA THE BJORKEN PROCESS: E+E- --> Z(*) --> Z(*)H
27376 C WHERE ONE OR BOTH OF THE Zs IS OFF-SHELL
27377 C USES ALGORITHM OF BERENDS AND KLEISS: NUCL.PHYS. B260(1985)32
27379 C MEAN EVWGT = CROSS-SECTION (IN NB) * HIGGS BRANCHING FRACTION
27380 C-----------------------------------------------------------------------
27381 INCLUDE 'herwig65.inc'
27382 DOUBLE PRECISION HWUAEM,HWHIGY,HWRUNI,HWRGEN,HWULDO,EMZ,CVE,CAE,
27383 & POL1,POL2,CE1,CE2,CE3,PMAX,EMZ2,S,B,FACTR,EMH,EMFAC,EMH2,A,XP,
27384 & CV,CA,BRHIGQ,BR,X1,X2,FAC1,FAC2,XPP,XPPSQ,COEF,X,XSQ,PROB,C1,C2,
27385 & CHIGG,PTHETA,SHIGG,C3,PHIMAX,CPHI,SPHI,C2PHI,S2PHI,PCM,ELST
27386 INTEGER IDEC,I,NLOOP,ICMF,IHIG,IZED,IFER,IANT,ID1,ID2,IN1,IN2
27387 EXTERNAL HWUAEM,HWHIGY,HWRUNI,HWRGEN,HWULDO
27388 SAVE CVE,CAE,CE1,CE2,CE3,PMAX,EMZ2,S,EMH,B,FACTR,A,EMH2
27389 EQUIVALENCE (EMZ,RMASS(200))
27392 C---SET UP CONSTANTS
27394 IF (JDAHEP(1,IN1).NE.0) IN1=JDAHEP(1,IN1)
27396 IF (JDAHEP(1,IN2).NE.0) IN2=JDAHEP(1,IN2)
27397 IF (FSTWGT.OR.ELST.NE.PHEP(5,3)) THEN
27401 POL1=1.-EPOLN(3)*PPOLN(3)
27402 POL2=EPOLN(3)-PPOLN(3)
27403 CE1=(POL1*(CVE**2+CAE**2)+POL2*2.*CVE*CAE)
27404 CE2=(POL1*2.*CVE*CAE+POL2*(CVE**2+CAE**2))
27405 IF ((IDHW(IN1).GT.IDHW(IN2).AND.PHEP(3,IN1).LT.ZERO).OR.
27406 & (IDHW(IN2).GT.IDHW(IN1).AND.PHEP(3,IN2).LT.ZERO)) CE2=-CE2
27407 IF (TPOL) CE3=(CVE**2-CAE**2)
27412 FACTR=GEV2NB*CE1*(HWUAEM(RMASS(201+IHIGGS)**2)*ENHANC(11))**2
27413 & /(12.*S*SWEIN*(1.-SWEIN))*B/((1-EMZ2/S)**2+B**2)
27415 IF (.NOT.GENEV) THEN
27416 C---CHOOSE HIGGS MASS, AND CALCULATE EVENT WEIGHT
27418 EMH=RMASS(201+IHIGGS)
27420 IF(IMSSM.EQ.0)CALL HWHIGM(EMH,EMFAC)
27421 IF (EMH.LE.ZERO .OR. EMH.GT.PHEP(5,3)) RETURN
27426 EVWGT=FACTR*HWHIGY(A,B,XP)*EMFAC
27427 C---INCLUDE BRANCHING RATIO OF HIGGS
27429 IDEC=MOD(IPROC,100)
27430 IF (IDEC.GT.0.AND.IDEC.LE.12) EVWGT=EVWGT*BRHIG(IDEC)
27431 IF (IDEC.EQ.0) THEN
27434 10 BRHIGQ=BRHIGQ+BRHIG(I)
27437 C Add Z branching fractions
27438 CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,0)
27440 IF (IDEC.EQ.10) THEN
27441 CALL HWDBOZ(198,ID1,ID2,CV,CA,BR,1)
27442 CALL HWDBOZ(199,ID1,ID2,CV,CA,BR,1)
27444 ELSEIF (IDEC.EQ.11) THEN
27445 CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,1)
27446 CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,1)
27457 CALL HWVEQU(5,PHEP(1,3),PHEP(1,ICMF))
27459 C---CHOOSE ENERGY FRACTION OF HIGGS
27463 FAC1=ATAN((X1-XP)/B)
27464 FAC2=ATAN((X2-XP)/B)
27465 XPP=MIN(X2,MAX(X1+B,XP))
27468 COEF=1./((12+2*A-12*XPP+XPPSQ)*SQRT(XPPSQ-A))
27470 IF (NLOOP.GT.NBTRY) THEN
27471 CALL HWWARN('HWHIGZ',101)
27474 X=XP+B*TAN(HWRUNI(1,FAC1,FAC2))
27476 PROB=COEF*((12+2*A-12*X+XSQ)*SQRT(XSQ-A))
27477 IF (PROB.GT.PMAX) THEN
27479 CALL HWWARN('HWHIGZ',1)
27481 21 FORMAT(7X,'NEW HWHIGZ MAX WEIGHT =',F8.4)
27483 IF (PROB.LT.PMAX*HWRGEN(0)) GOTO 20
27484 C Choose Z decay mode
27485 CALL HWDBOZ(200,IDHW(IFER),IDHW(IANT),CV,CA,BR,0)
27486 C1=CE1*(CV**2+CA**2)
27488 C---CHOOSE HIGGS DIRECTION
27489 C First polar angle
27491 COEF=(XSQ-A)/(8.*(1.-X)+XSQ+A)
27493 IF (NLOOP.GT.NBTRY) THEN
27494 CALL HWWARN('HWHIGZ',102)
27497 CHIGG=HWRUNI(2,-ONE, ONE)
27498 PTHETA=1-COEF*CHIGG**2
27499 IF (PTHETA.LT.HWRGEN(1)) GOTO 30
27500 SHIGG=SQRT(1-CHIGG**2)
27501 C Now azimuthal angle
27503 C3=CE3*(CV*2+CA**2)
27504 COEF=COEF*SHIGG**2*C3/C1
27505 PHIMAX=PTHETA+ABS(COEF)
27506 40 CALL HWRAZM(ONE,CPHI,SPHI)
27507 C2PHI=2.*CPHI**2-1.
27509 PROB=PTHETA-COEF*(C2PHI*COSS+S2PHI*SINS)
27510 IF (PROB.LT.HWRGEN(1)*PHIMAX) GOTO 40
27512 CALL HWRAZM(ONE,CPHI,SPHI)
27514 C Construct Higgs and Z momenta
27516 PHEP(4,IHIG)=X*PHEP(5,ICMF)/2
27517 PCM=SQRT(PHEP(4,IHIG)**2-EMH2)
27518 PHEP(3,IHIG)=CHIGG*PCM
27519 PHEP(1,IHIG)=SHIGG*PCM*CPHI
27520 PHEP(2,IHIG)=SHIGG*PCM*SPHI
27521 CALL HWVDIF(4,PHEP(1,ICMF),PHEP(1,IHIG),PHEP(1,IZED))
27522 CALL HWUMAS(PHEP(1,IZED))
27523 C Choose orientation of Z decay
27525 COEF=2.*(C1+ABS(C2))*HWULDO(PHEP(1,IN1),PHEP(1,IZED))
27526 & *HWULDO(PHEP(1,IN2),PHEP(1,IZED))/S
27527 IF (TPOL) COEF=COEF*(C1+ABS(C2)+ABS(C3))/(C1+ABS(C2))
27532 IF (NLOOP.GT.NBTRY) THEN
27533 CALL HWWARN('HWHIGZ',103)
27536 CALL HWDTWO(PHEP(1,IZED),PHEP(1,IFER),PHEP(1,IANT),
27538 PROB=C1*(PHEP(4,IFER)*PHEP(4,IANT)-PHEP(3,IFER)*PHEP(3,IANT))
27539 & +C2*(PHEP(4,IFER)*PHEP(3,IANT)-PHEP(3,IFER)*PHEP(4,IANT))
27540 IF (TPOL) PROB=PROB+C3*
27541 & (COSS*(PHEP(1,IFER)*PHEP(1,IANT)-PHEP(2,IFER)*PHEP(2,IANT))
27542 & +SINS*(PHEP(1,IFER)*PHEP(2,IANT)+PHEP(2,IFER)*PHEP(1,IANT)))
27543 IF (PROB.LT.HWRGEN(2)*COEF) GOTO 50
27544 C---SET UP STATUS CODES,
27550 C---COLOR CONNECTIONS,
27553 JDAHEP(1,ICMF)=IHIG
27554 JDAHEP(2,ICMF)=IZED
27555 JMOHEP(1,IHIG)=ICMF
27556 JMOHEP(1,IZED)=ICMF
27557 JMOHEP(1,IFER)=IZED
27558 JMOHEP(1,IANT)=IZED
27559 JMOHEP(2,IFER)=IANT
27560 JMOHEP(2,IANT)=IFER
27561 JDAHEP(1,IZED)=IFER
27562 JDAHEP(2,IZED)=IANT
27563 JDAHEP(2,IFER)=IANT
27564 JDAHEP(2,IANT)=IFER
27567 IDHW(IHIG)=201+IHIGGS
27569 IDHEP(ICMF)=IDPDG(IDHW(ICMF))
27570 IDHEP(IHIG)=IDPDG(IDHW(IHIG))
27571 IDHEP(IZED)=IDPDG(IDHW(IZED))
27572 IDHEP(IFER)=IDPDG(IDHW(IFER))
27573 IDHEP(IANT)=IDPDG(IDHW(IANT))
27578 *CMZ :- -25/11/01 17.11.33 by Stefano Moretti
27579 *-- Author : Kosuke Odagiri, modified by Stefano Moretti
27580 C-----------------------------------------------------------------------
27581 C...Generate completely differential cross section (EVWGT) in the variable
27582 C...X(I) with I=1 (see below) for the processes IPROC=955,965,975 as
27583 C...described in the HERWIG 6 documentation file.
27585 C...First release: 12-NOV-2001 by Stefano Moretti
27587 C-----------------------------------------------------------------------
27589 C-----------------------------------------------------------------------
27590 C PRODUCTION OF MSSM HIGGS PAIRS IN L+L- (L=E,MU)
27591 C-----------------------------------------------------------------------
27592 INCLUDE 'herwig65.inc'
27593 DOUBLE PRECISION HWRGEN, HWUAEM, HCS, RCS, S, PF, QPE,
27594 & FACTR, SN2TH, MZ, MNN(2), MCC, EMSC2, GZ2,
27595 & GHH(4), XWEIN, S2W, X(1), XL(1),
27596 & XU(1), WEIGHT, ECM, RMH1, RMH2, EMH1, EMH2,
27597 & EMHWT1, EMHWT2, EMHHWT, SHAT
27598 INTEGER I, ID1, ID2, IH1, IH2, IH, JH
27599 EXTERNAL HWRGEN, HWUAEM
27600 SAVE HCS,MNN,MCC,EMHHWT,S,SHAT
27601 DOUBLE COMPLEX Z, GZ, A, D, E
27602 PARAMETER (Z = (0.D0,1.D0))
27603 EQUIVALENCE (MZ, RMASS(200))
27606 RCS = HCS*HWRGEN(0)
27610 C...energy at parton level.
27611 ECM = PBEAM1+PBEAM2
27614 C...phase space variables.
27615 C...X(1)=COS(THETA_CM),
27616 C...phase space borders.
27619 C...single phase space point.
27622 X(I)=XL(I)+(XU(I)-XL(I))*HWRGEN(0)
27623 WEIGHT=WEIGHT*ABS(XU(I)-XL(I))
27625 C...final state masses.
27626 IF((MOD(IPROC,10000).EQ.965).OR.
27627 & (MOD(IPROC,10000).EQ.975))THEN
27631 ELSE IF(MOD(IPROC,10000).EQ.955)THEN
27642 EMHHWT=EMHWT1*EMHWT2
27645 SN2TH = 0.25D0 - 0.25D0*COSTH**2
27647 EMSC2 = EMSCA*EMSCA
27649 FACTR = GEV2NB*PIFAC*(HWUAEM(EMSC2))**2/SHAT*SN2TH/2.
27650 C...constant weight.
27651 FACTR = FACTR*WEIGHT
27652 C...couplings and propagators.
27654 S2W = DSQRT(XWEIN*(TWO-XWEIN))
27655 GZ = S2W*(SHAT-MZ**2+Z*SHAT*GAMZ/MZ)/SHAT
27656 GZ2 = DREAL(DCONJG(GZ)*GZ)
27657 C...labels: 1 = h0, 2 = H0, 3 = A0, 4 = H+, 5 = H-.
27662 C...set to zero all MEs.
27667 C...start subprocesses.
27668 IF((MOD(IPROC,10000).EQ.965).OR.
27669 & (MOD(IPROC,10000).EQ.975))THEN
27675 QPE = SHAT-(EMH1+EMH2)**2
27676 IF (QPE.GT.ZERO) THEN
27677 PF = SQRT(QPE*(SHAT-(EMH1-EMH2)**2))/SHAT
27679 & FACTR*PF**3*GHH(IH)**2*(LFCH(11)**2+RFCH(11)**2)/GZ2
27684 ELSE IF(MOD(IPROC,10000).EQ.955)THEN
27690 QPE = SHAT-(EMH1+EMH2)**2
27691 IF (QPE.GT.ZERO) THEN
27692 PF = SQRT(QPE*(SHAT-(EMH1-EMH2)**2))/SHAT
27694 D = QFCH(11)+A*LFCH(11)
27695 E = QFCH(11)+A*RFCH(11)
27696 MCC=FACTR*PF**3*DREAL(DCONJG(D)*D+DCONJG(E)*E)
27703 IF(MOD(IPROC,10000).EQ.965)THEN
27706 HCS = HCS + EMHHWT*MNN(1)
27707 ELSE IF(MOD(IPROC,10000).EQ.975)THEN
27710 HCS = HCS + EMHHWT*MNN(2)
27711 ELSE IF(MOD(IPROC,10000).EQ.955)THEN
27714 HCS = HCS + EMHHWT*MCC
27716 IF (GENEV.AND.HCS.GT.RCS) THEN
27717 C...generate event.
27725 CALL HWETWO(.TRUE.,.TRUE.)
27727 CALL HWVZRO(7,GCOEF)
27733 *CMZ :- -30/06/01 18.41.23 by Stefano Moretti
27734 *-- Author : Stefano Moretti
27735 C-----------------------------------------------------------------------
27736 C...Generate completely differential cross section (EVWGT) in the variables
27737 C...X(I) with I=1,6 (see below) for the processes from IPROC=3110
27738 C...to IPROC=3298, as described in the HERWIG 6 documentation file.
27739 C...It includes interface to PDFs and takes into account color connections
27742 C...First release: 08-APR-2000 by Stefano Moretti
27743 C...Last modified: 29-JUN-2001 by Stefano Moretti
27745 C-----------------------------------------------------------------------
27747 C-----------------------------------------------------------------------
27748 C PRODUCTION OF MSSM HIGGSES IN ASSOCIATION WITH B,T-SQUARK PAIRS
27749 C-----------------------------------------------------------------------
27750 INCLUDE 'herwig65.inc'
27751 COMMON/SQSQH/JHIGGS,ILBL,JH,IF1MIN,IF1MAX,IF2MIN,IF2MAX
27752 INTEGER JHIGGS,ILBL,JH,IF1MIN,IF1MAX,IF2MIN,IF2MAX
27753 INTEGER I,J,K,L,M,N
27754 INTEGER IQMIN,IQMAX,IGG,IQQ,JPP
27757 INTEGER JHH,IMIX1,IMIX2
27758 INTEGER JSQ,JSQ1,JSQ2
27760 DOUBLE PRECISION EMSQ1,EMSQ2,GAMSQ1,GAMSQ2,EMSQQ,EMH,EMHWT
27761 DOUBLE PRECISION GSQ1,GSQ2
27762 DOUBLE PRECISION X(6),XL(6),XU(6)
27763 DOUBLE PRECISION Q4(0:3),Q34(0:3)
27764 DOUBLE PRECISION CT5,ST5,CT4,ST4,CF4,SF4,RQ52,RQ5,RQ42,RQ4,PQ4
27765 DOUBLE PRECISION P1(0:3),P2(0:3),P3(0:3),P4(0:3),P5(0:3)
27766 DOUBLE PRECISION ECM_MAX,ECM,SHAT,S,TAU
27767 DOUBLE PRECISION EMIN,EMIN1,EMIN2,PCM2,PCM
27768 DOUBLE PRECISION GGSQHT,GGSQHU,GGSQHN,QQSQH
27769 DOUBLE PRECISION M2GG(8),M2GGPL(8),M2GGMN(8),M2QQ(8)
27770 DOUBLE PRECISION ALPHA,ALPHAS,EMSC2
27771 DOUBLE PRECISION HWRGEN,HWUAEM,HWUALF
27772 DOUBLE PRECISION PHI,CPHI,SPHI,ROT(3,3)
27773 DOUBLE PRECISION VCOL,GCOL,QAUX(0:3)
27774 DOUBLE PRECISION EPS,HCS,RCS,GACT,FACT(8),DIST
27775 DOUBLE PRECISION WEIGHT
27776 SAVE HCS,M2QQ,M2GG,M2GGPL,M2GGMN,FACT,S,SHAT,P3,P4,P5
27779 EXTERNAL HWRGEN,HWUAEM,HWUALF,HWHQCP,HWH2SH,HWETWO,HWRLOG
27780 PARAMETER (EPS=1.D-9)
27781 EQUIVALENCE (NC,NCOLO)
27782 C...process the event.
27788 C...loop over final state flavours.
27797 DO 2 IF1=IF1MIN,IF1MAX
27798 IF((IF1.GE.407).AND.(IF1.LE.416))GOTO 2
27799 DO 1 IF2=IF2MIN,IF2MAX
27800 IF((IF2.GE.413).AND.(IF2.LE.422))GOTO 1
27801 C...assign squark flavour.
27805 IF((ICHRG(JSQ1)+ICHRG(JSQ2))/3.NE.-ICHRG(201+JHIGGS+1))GOTO 1
27807 IF((IME.LE.0).OR.(IME.GT.8)) THEN
27808 CALL HWWARN('HWHISQ',100)
27811 C...assign final state masses and widths.
27814 GAMSQ1=HBAR/RLTIM(JSQ1)
27815 GAMSQ2=HBAR/RLTIM(JSQ2)
27816 EMH=RMASS(201+JHIGGS+1)
27818 C...energy at hadron level.
27819 ECM_MAX=PBEAM1+PBEAM2
27821 C...phase space variables.
27822 C...X(1)=(EMSQQ-EMSQ1-EMSQ2)/(ECM-EMSQ1-EMSQ2-EMH),
27823 C...X(2)=COS(THETA5_CM),X(3)=COS(THETA4_CM_34),X(4)=FI4_CM_34,
27824 C...X(5)=(1./SHAT-1./ECM_MAX**2)/(1./(EMSQ1+EMSQ2+EMH)**2-1./ECM_MAX**2),
27825 C...X(6)=(LOG(TAU)-LOG(X1))/LOG(TAU);
27826 C...phase space borders.
27839 C...single phase space point.
27843 X(I)=XL(I)+(XU(I)-XL(I))*HWRGEN(0)
27844 WEIGHT=WEIGHT*ABS(XU(I)-XL(I))
27846 C...energy at parton level.
27847 ECM=SQRT(1./(X(5)*(1./(EMSQ1+EMSQ2+EMH)**2-1./ECM_MAX**2)
27849 IF((EMH.LE.0.).OR.(EMH.GE.ECM))RETURN
27852 C...momentum fractions X1 and X2.
27853 XX(1)=EXP(LOG(TAU)*(1.-X(6)))
27855 C...three particle kinematics.
27856 EMSQQ=X(1)*(ECM-EMSQ1-EMSQ2-EMH)+EMSQ1+EMSQ2
27858 IF(HWRLOG(HALF))THEN
27859 ST5=+SQRT(1.-CT5*CT5)
27861 ST5=-SQRT(1.-CT5*CT5)
27864 ST4=SQRT(1.-CT4*CT4)
27867 RQ52=((ECM*ECM-EMH*EMH-EMSQQ*EMSQQ)**2-(2.*EMH*EMSQQ)**2)/
27877 P5(0)=SQRT(RQ52+EMH*EMH)
27881 Q34(0)=SQRT(RQ52+EMSQQ*EMSQQ)
27882 RQ42=((EMSQQ*EMSQQ-EMSQ1*EMSQ1-EMSQ2*EMSQ2)**2
27883 & -(2.*EMSQ1*EMSQ2)**2)/
27893 Q4(0)=SQRT(RQ42+EMSQ2*EMSQ2)
27896 PQ4=PQ4+Q34(I)*Q4(I)
27898 P4(0)=(Q34(0)*Q4(0)+PQ4)/EMSQQ
27901 P4(I)=Q4(I)+Q34(I)*(P4(0)+Q4(0))/(Q34(0)+EMSQQ)
27904 C...incoming partons: all massless.
27906 C...initial state momenta in the partonic CM.
27907 PCM2=((SHAT-EMIN*EMIN-EMIN*EMIN)**2
27908 & -(2.*EMIN*EMIN)**2)/(4.*SHAT)
27910 P1(0)=SQRT(PCM2+EMIN*EMIN)
27914 P2(0)=SQRT(PCM2+EMIN*EMIN)
27918 C...color structured ME summed/averaged over final/initial spins and colors.
27921 JPP=(MOD(IPROC,10000)/10-ILBL/10)
27922 IF((JPP.EQ.4).OR.(JPP.EQ.5).OR.(JPP.EQ.6))IQQ=0
27923 IF((JPP.EQ.7).OR.(JPP.EQ.8).OR.(JPP.EQ.9))IGG=0
27926 CALL HWH2SH(ECM,P1,P2,P3,P4,P5,EMSQ1,EMSQ2,EMH,GSQ1,GSQ2,
27927 & IGG,IQQ,GGSQHT,GGSQHU,GGSQHN,QQSQH)
27928 M2GG(IME)=GGSQHN/(8.*CFFAC)
27929 M2GGPL(IME)=GGSQHT/(8.*CFFAC)
27930 M2GGMN(IME)=GGSQHU/(8.*CFFAC)
27931 M2QQ(IME)=QQSQH*(1.-1./CAFAC**2)/4.
27932 C...constant factors: phi along beam and conversion GeV^2->nb.
27933 GACT=2.*PIFAC*GEV2NB
27934 C...Jacobians from X1,X2 to X(5),X(6)
27935 GACT=GACT/S*(-LOG(TAU))*(1./(EMSQ1+EMSQ2+EMH)**2-1./ECM_MAX**2)
27936 C...phase space Jacobians, pi's and flux.
27937 GACT=GACT*RQ4*RQ5/PCM/32./(2.*PIFAC)**5
27938 & *(ECM-EMSQ1-EMSQ2-EMH)
27939 C...EW and QCD couplings.
27940 EMSCA=EMSQ1+EMSQ2+EMH
27942 ALPHA=HWUAEM(EMSC2)
27943 ALPHAS=HWUALF(1,EMSCA)
27944 GACT=GACT*4.*PIFAC*ALPHA/SWEIN
27945 GACT=GACT*16.*PIFAC**2*ALPHAS**2
27946 C...enhancement factor for MSSM.
27948 IF(JHIGGS.EQ.5)JHH=4
27950 IF(JSQ1.GT.412)JSQ=JSQ1-412
27953 IF(JSQ1.GT.412)IMIX1=2
27954 IF(JSQ2.GT.418)IMIX2=2
27955 SENHNC(JSQ)=GHSQSS(JHH,JSQ,IMIX1,IMIX2)
27956 GACT=GACT*SENHNC(JSQ)*SENHNC(JSQ)
27957 C...Higgs resonance.
27959 C...constant weight.
27966 C...set up flavours in final state.
27970 CALL HWSGEN(.FALSE.)
27972 IF(MOD(IPROC,10000)-ILBL.GE.70)IQMAX=12
27974 IF(MOD(IPROC,10000)-ILBL.GE.40)IQMIN=13
27975 IF(MOD(IPROC,10000)-ILBL.GE.70)IQMIN=1
27977 IF((M2GGPL(JME)+M2GGMN(JME)).EQ.0.)GOTO 3
27979 IF(DISF(I,1).LT.EPS)THEN
27986 IF(DISF(J,2).LT.EPS)THEN
27989 DIST=DISF(I,1)*DISF(J,2)*S
27991 C...set up color connections: qq-scattering.
27993 HCS=HCS+M2QQ(JME)*DIST*FACT(JME)
27994 IF(GENEV.AND.HCS.GT.RCS)THEN
27996 CALL HWHQCP(JSQ1,JSQ2,2413, 4)
27999 ELSE IF(I.EQ.J+6)THEN
28000 HCS=HCS+M2QQ(JME)*DIST*FACT(JME)
28001 IF(GENEV.AND.HCS.GT.RCS)THEN
28003 CALL HWHQCP(JSQ2,JSQ1,3142,12)
28008 C...set up color connections: gg-scattering.
28010 & +(M2GGPL(JME)-M2GG(JME)*M2GGPL(JME)
28011 & /(M2GGPL(JME)+M2GGMN(JME))/FLOAT(NC)**2)*DIST*FACT(JME)
28012 IF(GENEV.AND.HCS.GT.RCS) THEN
28013 CALL HWHQCP(JSQ1,JSQ2,2413,27)
28017 & +(M2GGMN(JME)-M2GG(JME)*M2GGMN(JME)
28018 & /(M2GGPL(JME)+M2GGMN(JME))/FLOAT(NC)**2)*DIST*FACT(JME)
28019 IF(GENEV.AND.HCS.GT.RCS) THEN
28020 CALL HWHQCP(JSQ1,JSQ2,4123,28)
28029 C...generate event.
28033 C...incoming partons: now massive.
28034 EMIN1=RMASS(IDN(1))
28035 EMIN2=RMASS(IDN(2))
28036 C...redo initial state momenta in the partonic CM.
28037 PCM2=((SHAT-EMIN1*EMIN1-EMIN2*EMIN2)**2
28038 & -(2.*EMIN1*EMIN2)**2)/(4.*SHAT)
28040 P1(0)=SQRT(PCM2+EMIN1*EMIN1)
28044 P2(0)=SQRT(PCM2+EMIN2*EMIN2)
28048 C...randomly rotate final state momenta around beam axis.
28049 PHI=2.*PIFAC*HWRGEN(0)
28065 IF(L.EQ.1)QAUX(M)=QAUX(M)+ROT(M,N)*P3(N)
28066 IF(L.EQ.2)QAUX(M)=QAUX(M)+ROT(M,N)*P4(N)
28067 IF(L.EQ.3)QAUX(M)=QAUX(M)+ROT(M,N)*P5(N)
28071 IF(L.EQ.1)P3(M)=QAUX(M)
28072 IF(L.EQ.2)P4(M)=QAUX(M)
28073 IF(L.EQ.3)P5(M)=QAUX(M)
28076 C...use HWETWO only to set up status and IDs of (s)quarks.
28079 CALL HWETWO(.TRUE.,.TRUE.)
28080 C...do real incoming, outgoing momenta in the lab frame.
28081 VCOL=(XX(1)-XX(2))/(XX(1)+XX(2))
28082 GCOL=(XX(1)+XX(2))/2./SQRT(XX(1)*XX(2))
28084 IF(M.EQ.NHEP-2)GO TO 888
28086 IF(M.EQ.NHEP-4)QAUX(N)=P1(N)
28087 IF(M.EQ.NHEP-3)QAUX(N)=P2(N)
28088 IF(M.EQ.NHEP-1)QAUX(N)=P3(N)*(1-FLIP)+P4(N)*FLIP
28089 IF(M.EQ.NHEP )QAUX(N)=P4(N)*(1-FLIP)+P3(N)*FLIP
28090 IF(M.EQ.NHEP+1)QAUX(N)=P5(N)
28093 PHEP(4,M)=GCOL*(QAUX(0)+VCOL*QAUX(3))
28094 PHEP(3,M)=GCOL*(QAUX(3)+VCOL*QAUX(0))
28099 C...needs to set all final state masses.
28100 PHEP(5,NHEP-1)=SQRT(ABS(PHEP(4,NHEP-1)**2
28101 & -PHEP(3,NHEP-1)**2
28102 & -PHEP(2,NHEP-1)**2
28103 & -PHEP(1,NHEP-1)**2))
28104 PHEP(5,NHEP )=SQRT(ABS(PHEP(4,NHEP )**2
28105 & -PHEP(3,NHEP )**2
28106 & -PHEP(2,NHEP )**2
28107 & -PHEP(1,NHEP )**2))
28108 PHEP(5,NHEP+1)=SQRT(ABS(PHEP(4,NHEP+1)**2
28109 & -PHEP(3,NHEP+1)**2
28110 & -PHEP(2,NHEP+1)**2
28111 & -PHEP(1,NHEP+1)**2))
28114 PHEP(I,NHEP-2)=PHEP(I,NHEP-4)+PHEP(I,NHEP-3)
28116 PHEP(5,NHEP-2)=SQRT(ABS(PHEP(4,NHEP-2)**2
28117 & -PHEP(3,NHEP-2)**2
28118 & -PHEP(2,NHEP-2)**2
28119 & -PHEP(1,NHEP-2)**2))
28120 C...status and IDs for Higgs.
28122 IDHW(NHEP+1)=IDN(5)
28123 IDHEP(NHEP+1)=IDPDG(IDN(5))
28124 C...Higgs colour (self-)connections.
28125 JMOHEP(1,NHEP+1)=NHEP-2
28126 JMOHEP(2,NHEP+1)=NHEP+1
28127 JDAHEP(2,NHEP+1)=NHEP+1
28128 JDAHEP(2,NHEP-2)=NHEP+1
28131 C...set to zero the coefficients of the spin density matrices.
28132 CALL HWVZRO(7,GCOEF)
28137 *CMZ :- -12/01/93 10.12.43 by Bryan Webber
28138 *-- Author : Ian Knowles
28139 C-----------------------------------------------------------------------
28141 C-----------------------------------------------------------------------
28142 C QQD direct photon pair production: mean EVWGT = sigma in nb
28143 C-----------------------------------------------------------------------
28144 INCLUDE 'herwig65.inc'
28145 DOUBLE PRECISION HWRGEN,HWRUNI,HWUALF,HWHPPB,EPS,RCS,ET,EJ,KK,KK2,
28146 & YJ1INF,YJ1SUP,Z1,YJ2INF,YJ2SUP,Z2,FACT,FACTR,RS,S,T,U,CSTU,TQSQ,
28149 EXTERNAL HWRGEN,HWRUNI,HWUALF,HWHPPB
28150 SAVE HCS,CSTU,DSTU,FACT
28151 PARAMETER (EPS=1.D-9)
28159 IF (KK.GE.ONE) RETURN
28160 YJ1INF=MAX( YJMIN , LOG((1.-SQRT(1.-KK2))/KK) )
28161 YJ1SUP=MIN( YJMAX , LOG((1.+SQRT(1.-KK2))/KK) )
28162 IF (YJ1INF.GE.YJ1SUP) RETURN
28163 Z1=EXP(HWRUNI(1,YJ1INF,YJ1SUP))
28164 YJ2INF=MAX( YJMIN , -LOG(2./KK-1./Z1) )
28165 YJ2SUP=MIN( YJMAX , LOG(2./KK-Z1) )
28166 IF (YJ2INF.GE.YJ2SUP) RETURN
28167 Z2=EXP(HWRUNI(2,YJ2INF,YJ2SUP))
28168 XX(1)=0.5*(Z1+Z2)*KK
28169 IF (XX(1).GE.ONE) RETURN
28170 XX(2)=XX(1)/(Z1*Z2)
28171 IF (XX(2).GE.ONE) RETURN
28172 COSTH=(Z1-Z2)/(Z1+Z2)
28173 S=XX(1)*XX(2)*PHEP(5,3)**2
28175 T=-0.5*S*(1.-COSTH)
28177 EMSCA=SQRT(2.*S*T*U/(S*S+T*T+U*U))
28178 FACT=GEV2NB*PIFAC*0.5*ET*EJ*(YJ1SUP-YJ1INF)*(YJ2SUP-YJ2INF)
28180 CALL HWSGEN(.FALSE.)
28181 CSTU=2.*(U/T+T/U)/CAFAC
28182 IF (DISF(13,1).GT.EPS.AND.DISF(13,2).GT.EPS) THEN
28185 10 IF (RMASS(ID).LT.RS) TQSQ=TQSQ+QFCH(ID)**2
28186 DSTU=DISF(13,1)*DISF(13,2)*FACT*HWHPPB(S,T,U)
28187 & /64.*(HWUALF(1,EMSCA)*TQSQ/PIFAC)**2
28194 FACTR=FACT*CSTU*QFCH(ID)**4
28195 C q+qbar ---> gamma+gamma
28198 IF (DISF(ID1,1).LT.EPS.OR.DISF(ID2,2).LT.EPS) GOTO 20
28199 HCS=HCS+FACTR*DISF(ID1,1)*DISF(ID2,2)
28200 IF (GENEV.AND.HCS.GT.RCS) THEN
28201 CALL HWHQCP(59,59,2134,61)
28204 C qbar+q ---> gamma+gamma
28207 IF (DISF(ID1,1).LT.EPS.OR.DISF(ID2,2).LT.EPS) GOTO 30
28208 HCS=HCS+FACTR*DISF(ID1,1)*DISF(ID2,2)
28209 IF (GENEV.AND.HCS.GT.RCS) THEN
28210 CALL HWHQCP(59,59,2134,62)
28214 C g+g ---> gamma+gamma
28218 IF (GENEV.AND.HCS.GT.RCS) THEN
28219 CALL HWHQCP(59,59,2134,63)
28228 CALL HWETWO(.TRUE.,.TRUE.)
28231 *CMZ :- -26/04/91 14.55.45 by Federico Carminati
28232 *-- Author : Bryan Webber
28233 C-----------------------------------------------------------------------
28235 C-----------------------------------------------------------------------
28236 C QCD DIRECT PHOTON + JET PRODUCTION: MEAN EVWGT = SIGMA IN NB
28237 C-----------------------------------------------------------------------
28238 INCLUDE 'herwig65.inc'
28239 DOUBLE PRECISION HWRGEN,HWRUNI,HWUALF,HWHPPB,EPS,RCS,ET,EJ,KK,KK2,
28240 & YJ1INF,YJ1SUP,Z1,YJ2INF,YJ2SUP,Z2,FACT,FACTR,FACTF,RS,S,T,U,CF,
28241 & AF,CSTU,CTSU,CUST,DSTU,HCS,TQCH
28243 EXTERNAL HWRGEN,HWRUNI,HWUALF,HWHPPB
28244 SAVE HCS,FACT,CSTU,CTSU,CUST,DSTU
28245 PARAMETER (EPS=1.D-9)
28253 IF (KK.GE.ONE) RETURN
28254 YJ1INF=MAX( YJMIN , LOG((1.-SQRT(1.-KK2))/KK) )
28255 YJ1SUP=MIN( YJMAX , LOG((1.+SQRT(1.-KK2))/KK) )
28256 IF (YJ1INF.GE.YJ1SUP) RETURN
28257 Z1=EXP(HWRUNI(1,YJ1INF,YJ1SUP))
28258 YJ2INF=MAX( YJMIN , -LOG(2./KK-1./Z1) )
28259 YJ2SUP=MIN( YJMAX , LOG(2./KK-Z1) )
28260 IF (YJ2INF.GE.YJ2SUP) RETURN
28261 Z2=EXP(HWRUNI(2,YJ2INF,YJ2SUP))
28262 XX(1)=0.5*(Z1+Z2)*KK
28263 IF (XX(1).GE.ONE) RETURN
28264 XX(2)=XX(1)/(Z1*Z2)
28265 IF (XX(2).GE.ONE) RETURN
28266 COSTH=(Z1-Z2)/(Z1+Z2)
28267 S=XX(1)*XX(2)*PHEP(5,3)**2
28269 T=-0.5*S*(1.-COSTH)
28271 C---SET EMSCA TO HARD PROCESS SCALE (APPROX ET-JET)
28272 EMSCA=SQRT(2.*S*T*U/(S*S+T*T+U*U))
28273 FACT=GEV2NB*PIFAC*0.5*ET*EJ*ALPHEM
28274 & *HWUALF(1,EMSCA)*(YJ1SUP-YJ1INF)*(YJ2SUP-YJ2INF)/S**2
28275 CALL HWSGEN(.FALSE.)
28282 IF (DISF(13,1).GT.EPS.AND.DISF(13,2).GT.EPS) THEN
28285 10 IF (RMASS(ID).LT.RS) TQCH=TQCH+QFCH(ID)
28286 DSTU=DISF(13,1)*DISF(13,2)*FACT*HWHPPB(S,T,U)
28287 & *5./768.*(HWUALF(1,EMSCA)*TQCH/PIFAC)**2
28295 FACTR=FACT*QFCH(ID)**2
28298 IF (DISF(ID1,1).LT.EPS) GOTO 20
28300 HCS=HCS+CSTU*FACTR*DISF(ID1,1)*DISF(ID2,2)
28301 IF (GENEV.AND.HCS.GT.RCS) THEN
28302 CALL HWHQCP( 13, 59,2314,41)
28306 HCS=HCS+CTSU*FACTR*DISF(ID1,1)*DISF(ID2,2)
28307 IF (GENEV.AND.HCS.GT.RCS) THEN
28308 CALL HWHQCP(ID1, 59,3124,42)
28313 IF (DISF(ID1,1).LT.EPS) GOTO 30
28315 HCS=HCS+CSTU*FACTR*DISF(ID1,1)*DISF(ID2,2)
28316 IF (GENEV.AND.HCS.GT.RCS) THEN
28317 CALL HWHQCP( 13, 59,3124,43)
28321 HCS=HCS+CTSU*FACTR*DISF(ID1,1)*DISF(ID2,2)
28322 IF (GENEV.AND.HCS.GT.RCS) THEN
28323 CALL HWHQCP(ID1, 59,2314,44)
28329 FACTF=FACT*CUST*DISF(ID1,1)
28331 FACTR=FACTF*QFCH(ID)**2
28333 IF (DISF(ID2,2).LT.EPS) GOTO 40
28334 HCS=HCS+FACTR*DISF(ID2,2)
28335 IF (GENEV.AND.HCS.GT.RCS) THEN
28336 CALL HWHQCP(ID2, 59,2314,45)
28340 IF (DISF(ID2,2).LT.EPS) GOTO 50
28341 HCS=HCS+FACTR*DISF(ID2,2)
28342 IF (GENEV.AND.HCS.GT.RCS) THEN
28343 CALL HWHQCP(ID2, 59,3124,46)
28350 IF (GENEV.AND.HCS.GT.RCS) THEN
28351 CALL HWHQCP( 13, 59,2314,47)
28360 CALL HWETWO(.TRUE.,.TRUE.)
28363 *CMZ :- -12/01/93 10.12.43 by Bryan Webber
28364 *-- Author : Ian Knowles
28365 C-----------------------------------------------------------------------
28366 FUNCTION HWHPPB(S,T,U)
28367 C-----------------------------------------------------------------------
28368 C Quark box diagram contribution to photon/gluon scattering
28369 C Internal quark mass neglected: m_q << U,T,S
28370 C-----------------------------------------------------------------------
28372 DOUBLE PRECISION HWHPPB,S,T,U,S2,T2,U2,PI2,ALNTU,ALNST,ALNSU
28381 & +((2.*S2+2.*(U2-T2)*ALNTU+(T2+U2)*(ALNTU**2+PI2))/S2)**2
28382 & +((2.*U2+2.*(T2-S2)*ALNST+(T2+S2)* ALNST**2 )/U2)**2
28383 & +((2.*T2+2.*(U2-S2)*ALNSU+(U2+S2)* ALNSU**2 )/T2)**2
28384 & +4.*PI2*(((T2-S2+(T2+S2)*ALNST)/U2)**2
28385 & +((U2-S2+(U2+S2)*ALNSU)/T2)**2)
28388 *CMZ :- -12/01/93 10.12.43 by Bryan Webber
28389 *-- Author : Ian Knowles
28390 C-----------------------------------------------------------------------
28392 C-----------------------------------------------------------------------
28393 C point-like photon/QCD heavy flavour single excitation, using exact
28394 C massive lightcone kinematics, mean EVWGT = sigma in nb.
28395 C-----------------------------------------------------------------------
28396 INCLUDE 'herwig65.inc'
28397 DOUBLE PRECISION HWRGEN,HWRUNI,HWUALF,EPS,PP1,PP2,QM2,FACTR,
28398 & PT,PJ,PT2,PTM,EXY,T,CC,EXY2,S,U,C,SIGE,HCS,RCS
28399 INTEGER IQ1,IQ2,ID1,ID2,IHAD1,IHAD2
28400 EXTERNAL HWRGEN,HWRUNI,HWUALF
28401 SAVE PP1,PP2,IQ1,IQ2,QM2,FACTR,SIGE,HCS
28402 PARAMETER (EPS=1.E-9)
28404 IF (JDAHEP(1,IHAD1).NE.0) IHAD1=JDAHEP(1,IHAD1)
28406 IF (JDAHEP(1,IHAD2).NE.0) IHAD2=JDAHEP(1,IHAD2)
28407 IF (FSTWGT.OR.IHAD1.NE.1.OR.IHAD2.NE.2) THEN
28408 PP1=PHEP(4,IHAD1)+ABS(PHEP(3,IHAD1))
28409 PP2=PHEP(4,IHAD2)+ABS(PHEP(3,IHAD2))
28414 FACTR=GEV2NB*(YJMAX-YJMIN)*4.*PIFAC*CFFAC*PP1
28415 & *ALPHEM*QFCH(IQ1)**2
28424 EXY=EXP(HWRUNI(1,YJMIN,YJMAX))
28426 CC=T**2-4.*QM2*(PT2+T)
28427 IF (CC.LT.ZERO) RETURN
28428 EXY2=(2.*PT2+T-SQRT(CC))*PP1/(2.*T*PTM)
28429 IF (EXY2.LT.EXP(YJMIN).OR.EXY2.GT.EXP(YJMAX)) RETURN
28430 XX(2)=(PT/EXY+PTM/EXY2)/PP2
28431 IF (XX(2).GT.ONE) RETURN
28432 C define: S=Shat-M**2, T=That ,U=Uhat-M**2 (2p.Q, -2p.g, -2p.Q')
28435 COSTH=(1.+QM2/S)*(T-U)/S-QM2/S
28436 C Set hard process scale (Approx ET-jet)
28437 EMSCA=SQRT(2.*S*T*U/(S*S+T*T+U*U))
28439 SIGE=-FACTR*PT*PJ*HWUALF(1,EMSCA)*(S/U+U/S+4.*C*(1.-C))
28440 & /(S**2*EXY2*PTM*(1-QM2/(XX(2)*PP2*EXY2)**2))
28441 CALL HWSFUN(XX(2),EMSCA,IDHW(IHAD2),NSTRU,DISF(1,2),2)
28445 C photon+Q ---> g+Q
28447 IF (DISF(ID2,2).LT.EPS) GOTO 10
28448 HCS=HCS+SIGE*DISF(ID2,2)
28449 IF (GENEV.AND.HCS.GT.RCS) THEN
28450 CALL HWHQCP(13,ID2,1423,51)
28453 C photon+Qbar ---> g+Qbar
28455 IF (DISF(ID2,2).LT.EPS) GOTO 20
28456 HCS=HCS+SIGE*DISF(ID2,2)
28457 IF (GENEV.AND.HCS.GT.RCS) THEN
28458 CALL HWHQCP(13,ID2,1342,52)
28467 CALL HWETWO(.TRUE.,.TRUE.)
28470 *CMZ :- -12/01/93 10.12.43 by Bryan Webber
28471 *-- Author : Ian Knowles
28472 C-----------------------------------------------------------------------
28474 C-----------------------------------------------------------------------
28475 C Point-like photon/gluon heavy flavour pair production, with
28476 C exact lightcone massive kinematics, mean EVWGT = sigma in nb.
28477 C-----------------------------------------------------------------------
28478 INCLUDE 'herwig65.inc'
28479 DOUBLE PRECISION HWRUNI,HWUALF,EPS,PP1,PP2,QM2,FACTR,ET,EJ,ET2,
28481 INTEGER IQ1,IHAD1,IHAD2
28482 EXTERNAL HWRUNI,HWUALF
28483 SAVE PP1,PP2,IQ1,QM2,FACTR
28484 PARAMETER (EPS=1.E-9)
28486 IF (JDAHEP(1,IHAD1).NE.0) IHAD1=JDAHEP(1,IHAD1)
28488 IF (JDAHEP(1,IHAD2).NE.0) IHAD2=JDAHEP(1,IHAD2)
28489 IF (FSTWGT.OR.IHAD1.NE.1.OR.IHAD2.NE.2) THEN
28490 PP1=PHEP(4,IHAD1)+ABS(PHEP(3,IHAD1))
28491 PP2=PHEP(4,IHAD2)+ABS(PHEP(3,IHAD2))
28496 FACTR=-GEV2NB*(YJMAX-YJMIN)*.5*PIFAC*ALPHEM*QFCH(IQ1)**2
28509 CALL HWETWO(.TRUE.,.TRUE.)
28511 C Select kinematics
28515 EXY=EXP(HWRUNI(1,YJMIN,YJMAX))
28517 IF (EXY2.LT.EXP(YJMIN).OR.EXY2.GT.EXP(YJMAX)) RETURN
28518 XX(2)=.5*ET*(1./EXY+1./EXY2)/PP2
28519 IF (XX(2).LT.ZERO.OR.XX(2).GT.ONE) RETURN
28521 IF (S.LT.ET2) RETURN
28522 C define: S=Shat, T=That-M**2, U=Uhat-M**2 (2p.g, -2p.Q, -2p.QBar)
28525 COSTH=(T-U)/(S*SQRT(1.-4.*QM2/S))
28526 EMSCA=SQRT(2.*S*T*U/(S*S+T*T+U*U))
28527 CALL HWSFUN(XX(2),EMSCA,IDHW(IHAD2),NSTRU,DISF(1,2),2)
28528 C photon+g ---> Q+Qbar
28529 IF (DISF(13,2).LT.EPS) THEN
28533 EVWGT=FACTR*EJ*ET*HWUALF(1,EMSCA)
28534 & *DISF(13,2)*(T/U+U/T+4.*C*(1.-C))/(S*T)
28539 *CMZ :- -09/12/93 15.50.26 by Mike Seymour
28540 *-- Author : Ian Knowles & Mike Seymour
28541 C-----------------------------------------------------------------------
28543 C-----------------------------------------------------------------------
28544 C Point-like photon/QCD direct meson production
28545 C See M. Benayoun, et al., Nucl. Phys. B282 (1987) 653 for details.
28546 C mean EVWGT = sigma in nb
28547 C-----------------------------------------------------------------------
28548 INCLUDE 'herwig65.inc'
28549 DOUBLE PRECISION HWRGEN,HWRUNI,HWUALF,EPS,PP1,PP2,ET,EJ,EXY,EXY2,
28550 & FACT,FACTR,S,T,U,REDS,DELT(3,3),C1STU,C3STU,HCS,RCS,CMIX,SMIX,
28551 & C1WVFN,FPI,FETA8,FETA1,FRHO,FPHI8,FPHI1,FPI2,FETA2(3),FETAP2(3),
28552 7 FRHO2,FPHI2(3),FOMEG2(3)
28553 INTEGER MNAME(3,3,2),N4(3),I,J,ID2,ID4,I2,I4,M1,M2,IHAD1,IHAD2
28554 LOGICAL SPIN0,SPIN1
28555 EXTERNAL HWRGEN,HWRUNI,HWUALF
28556 SAVE FPI2,FETA2,FETAP2,FRHO2,FPHI2,FOMEG2,HCS,REDS,FACT,DELT,
28558 PARAMETER (EPS=1.D-20)
28559 SAVE MNAME,N4,SPIN0,SPIN1,C1WVFN,FPI,FETA8,FETA1,FRHO,FPHI8,FPHI1
28560 DATA MNAME/21,38,42,30,21,34,50,46,0,23,39,43,31,23,35,51,47,0/
28561 DATA N4,SPIN0,SPIN1/3,3,2,.TRUE.,.TRUE./
28562 DATA C1WVFN,FPI,FETA8,FETA1,FRHO,FPHI8,FPHI1
28563 & /1.D0,3*0.093D0,3*0.107D0/
28566 CMIX=COS(ETAMIX*PIFAC/180.D0)
28567 SMIX=SIN(ETAMIX*PIFAC/180.D0)
28568 FETA2(1) =(+CMIX*FETA8/SQRT(TWO)-SMIX*FETA1)**2/THREE
28570 FETA2(3) =(-CMIX*FETA8*SQRT(TWO)-SMIX*FETA1)**2/THREE
28571 FETAP2(1)=(+SMIX*FETA8/SQRT(TWO)+CMIX*FETA1)**2/THREE
28572 FETAP2(2)=FETAP2(1)
28573 FETAP2(3)=(-SMIX*FETA8*SQRT(TWO)+CMIX*FETA1)**2/THREE
28575 CMIX=COS(PHIMIX*PIFAC/180.D0)
28576 SMIX=SIN(PHIMIX*PIFAC/180.D0)
28577 FPHI2(1) =(+CMIX*FPHI8/SQRT(TWO)-SMIX*FPHI1)**2/THREE
28579 FPHI2(3) =(-CMIX*FPHI8*SQRT(TWO)-SMIX*FPHI1)**2/THREE
28580 FOMEG2(1)=(+SMIX*FPHI8/SQRT(TWO)+CMIX*FPHI1)**2/THREE
28581 FOMEG2(2)=FOMEG2(1)
28582 FOMEG2(3)=(-SMIX*FPHI8*SQRT(TWO)+CMIX*FPHI1)**2/THREE
28584 SPIN0=.NOT.(MOD(IPROC/10,10).EQ.2)
28585 SPIN1=.NOT.(MOD(IPROC/10,10).EQ.1)
28591 IF (JDAHEP(1,IHAD1).NE.0) IHAD1=JDAHEP(1,IHAD1)
28593 IF (JDAHEP(1,IHAD2).NE.0) IHAD2=JDAHEP(1,IHAD2)
28594 PP1=PHEP(4,IHAD1)+ABS(PHEP(3,IHAD1))
28595 PP2=PHEP(4,IHAD2)+ABS(PHEP(3,IHAD2))
28598 EXY=EXP(HWRUNI(1,YJMIN,YJMAX))
28599 EXY2=TWO*PP1/ET-EXY
28600 IF (EXY2.LE.EXP(YJMIN).OR.EXY2.GE.EXP(YJMAX)) RETURN
28601 XX(2)=PP1/(PP2*EXY*EXY2)
28602 IF (XX(2).LE.ZERO.OR.XX(2).GE.ONE) RETURN
28604 REDS=SQRT(S-ET*SQRT(S))
28608 C Set EMSCA to hard process scale (Approx ET-jet)
28609 EMSCA=SQRT(TWO*S*T*U/(S*S+T*T+U*U))
28610 FACT=-GEV2NB*ET*EJ*(YJMAX-YJMIN)*ALPHEM*CFFAC
28611 & *(HWUALF(1,EMSCA)*PIFAC*C1WVFN)**2*32.D0/(THREE*S*T)
28612 CALL HWSFUN(XX(2),EMSCA,IDHW(IHAD2),NSTRU,DISF(1,2),2)
28615 10 DELT(I,J)=(QFCH(I)*U+QFCH(J)*S)**2
28616 C1STU=-(S**2+U**2)/(T*S**2*U**2)
28617 C3STU=-8.D0*T/(S**2*U**2)
28621 C Quark initiated processes
28623 IF (DISF(ID2,2).LT.EPS) GOTO 30
28625 M1=MNAME(ID2,ID4,1)
28626 FACTR=FACT*DELT(ID2,ID4)*DISF(ID2,2)
28627 IF (ID2.EQ.ID4) FACTR=HALF*FACTR
28628 IF (SPIN0.AND.REDS.GT.RMASS(M1)) THEN
28629 C photon+q --> meson_0+q'
28630 HCS=HCS+HALF*FACTR*C1STU*FPI2
28631 IF (GENEV.AND.HCS.GT.RCS) THEN
28632 CALL HWHQCP(M1,ID4,1432,71)
28636 M2=MNAME(ID2,ID4,2)
28637 IF (SPIN1.AND.REDS.GT.RMASS(M2)) THEN
28638 C photon+q --> meson_L+q'
28639 HCS=HCS+FACTR*C1STU*FRHO2
28640 IF (GENEV.AND.HCS.GT.RCS) THEN
28641 CALL HWHQCP(M2,ID4,1432,72)
28644 C photon+q --> meson_T+q'
28645 HCS=HCS+FACTR*C3STU*FRHO2
28646 IF (GENEV.AND.HCS.GT.RCS) THEN
28647 CALL HWHQCP(M2,ID4,1432,73)
28652 FACTR=FACT*DELT(I2,I2)*DISF(ID2,2)
28653 IF (SPIN0.AND.REDS.GT.RMASS(22)) THEN
28654 C photon+q -->eta+q
28655 HCS=HCS+HALF*FACTR*C1STU*FETA2(I2)
28656 IF (GENEV.AND.HCS.GT.RCS) THEN
28657 CALL HWHQCP(22,ID2,1432,71)
28661 IF (SPIN0.AND.REDS.GT.RMASS(25)) THEN
28662 C photon+q -->eta'+q
28663 HCS=HCS+HALF*FACTR*C1STU*FETAP2(I2)
28664 IF (GENEV.AND.HCS.GT.RCS) THEN
28665 CALL HWHQCP(25,ID2,1432,71)
28669 IF (SPIN1.AND.REDS.GT.RMASS(56)) THEN
28670 C photon+q -->phi_L+q
28671 HCS=HCS+FACTR*C1STU*FPHI2(I2)
28672 IF (GENEV.AND.HCS.GT.RCS) THEN
28673 CALL HWHQCP(56,ID2,1432,72)
28676 C photon+q -->phi_T+q
28677 HCS=HCS+FACTR*C3STU*FPHI2(I2)
28678 IF (GENEV.AND.HCS.GT.RCS) THEN
28679 CALL HWHQCP(56,ID2,1432,73)
28683 IF (SPIN1.AND.REDS.GT.RMASS(24)) THEN
28684 C photon+q -->omega_L+q
28685 HCS=HCS+FACTR*C1STU*FOMEG2(I2)
28686 IF (GENEV.AND.HCS.GT.RCS) THEN
28687 CALL HWHQCP(24,ID2,1432,72)
28690 C photon+q -->omega_T+q
28691 HCS=HCS+FACTR*C3STU*FOMEG2(I2)
28692 IF (GENEV.AND.HCS.GT.RCS) THEN
28693 CALL HWHQCP(24,ID2,1432,73)
28697 C Anti-quark initiated processes
28699 IF (DISF(ID2,2).LT.EPS) GOTO 50
28702 FACTR=FACT*DELT(I2,I4)*DISF(ID2,2)
28703 IF (ID2.EQ.ID4) FACTR=HALF*FACTR
28705 IF (SPIN0.AND.REDS.GT.RMASS(M1)) THEN
28706 C photon+qbar --> meson_0+qbar'
28707 HCS=HCS+HALF*FACTR*C1STU*FPI2
28708 IF (GENEV.AND.HCS.GT.RCS) THEN
28709 CALL HWHQCP(M1,ID4,1432,74)
28714 IF (SPIN1.AND.REDS.GT.RMASS(M2)) THEN
28715 C photon+qbar --> meson_L+qbar'
28716 HCS=HCS+FACTR*C1STU*FRHO2
28717 IF (GENEV.AND.HCS.GT.RCS) THEN
28718 CALL HWHQCP(M2,ID4,1432,75)
28721 C photon+qbar --> meson_T+qbar'
28722 HCS=HCS+FACTR*C3STU*FRHO2
28723 IF (GENEV.AND.HCS.GT.RCS) THEN
28724 CALL HWHQCP(M2,ID4,1432,76)
28729 FACTR=FACT*DELT(I2,I2)*DISF(ID2,2)
28730 IF (SPIN0.AND.REDS.GT.RMASS(22)) THEN
28731 C photon+qbar -->eta+qbar
28732 HCS=HCS+HALF*FACTR*C1STU*FETA2(I2)
28733 IF (GENEV.AND.HCS.GT.RCS) THEN
28734 CALL HWHQCP(22,ID2,1432,74)
28738 IF (SPIN0.AND.REDS.GT.RMASS(25)) THEN
28739 C photon+qbar -->eta'+qbar
28740 HCS=HCS+HALF*FACTR*C1STU*FETAP2(I2)
28741 IF (GENEV.AND.HCS.GT.RCS) THEN
28742 CALL HWHQCP(25,ID2,1432,74)
28746 IF (SPIN1.AND.REDS.GT.RMASS(56)) THEN
28747 C photon+qbar -->phi_L+qbar
28748 HCS=HCS+FACTR*C1STU*FPHI2(I2)
28749 IF (GENEV.AND.HCS.GT.RCS) THEN
28750 CALL HWHQCP(56,ID2,1432,75)
28753 C photon+qbar -->phi_T+qbar
28754 HCS=HCS+FACTR*C3STU*FPHI2(I2)
28755 IF (GENEV.AND.HCS.GT.RCS) THEN
28756 CALL HWHQCP(56,ID2,1432,76)
28760 IF (SPIN1.AND.REDS.GT.RMASS(24)) THEN
28761 C photon+qbar -->omega_L+qbar
28762 HCS=HCS+FACTR*C1STU*FOMEG2(I2)
28763 IF (GENEV.AND.HCS.GT.RCS) THEN
28764 CALL HWHQCP(24,ID2,1432,75)
28767 C photon+qbar -->omega_T+qbar
28768 HCS=HCS+FACTR*C3STU*FOMEG2(I2)
28769 IF (GENEV.AND.HCS.GT.RCS) THEN
28770 CALL HWHQCP(24,ID2,1432,76)
28781 CALL HWETWO(.TRUE.,.TRUE.)
28782 C Set polarization vector
28783 IF (IHPRO.EQ.72.OR.IHPRO.EQ.75) THEN
28784 RHOHEP(2,NHEP-1)=ONE
28785 ELSEIF (IHPRO.EQ.73.OR.IHPRO.EQ.76) THEN
28786 RHOHEP(1,NHEP-1)=HALF
28787 RHOHEP(3,NHEP-1)=HALF
28791 *CMZ :- -12/01/93 10.12.43 by Bryan Webber
28792 *-- Author : Ian Knowles
28793 C-----------------------------------------------------------------------
28795 C-----------------------------------------------------------------------
28796 C point-like photon/QCD di-jet production: mean EVWGT = sigma in nb
28797 C-----------------------------------------------------------------------
28798 INCLUDE 'herwig65.inc'
28799 DOUBLE PRECISION HWRGEN,HWRUNI,HWUALF,EPS,RCS,PP1,PP2,ET,EJ,
28800 & EXY,EXY2,FACTR,RS,S,T,U,CSTU,CTSU,HCS
28801 INTEGER ID1,ID2,ID3,ID4,IHAD1,IHAD2
28802 EXTERNAL HWRGEN,HWRUNI,HWUALF
28803 SAVE CSTU,CTSU,HCS,FACTR,RS
28804 PARAMETER (EPS=1.E-9)
28806 IF (JDAHEP(1,IHAD1).NE.0) IHAD1=JDAHEP(1,IHAD1)
28808 IF (JDAHEP(1,IHAD2).NE.0) IHAD2=JDAHEP(1,IHAD2)
28813 PP1=PHEP(4,IHAD1)+ABS(PHEP(3,IHAD1))
28814 PP2=PHEP(4,IHAD2)+ABS(PHEP(3,IHAD2))
28817 EXY=EXP(HWRUNI(1,YJMIN,YJMAX))
28819 IF (EXY2.LE.EXP(YJMIN).OR.EXY2.GE.EXP(YJMAX)) RETURN
28820 XX(2)=PP1/(PP2*EXY*EXY2)
28821 IF (XX(2).LE.ZERO.OR.XX(2).GE.ONE) RETURN
28827 C Set EMSCA to hard process scale (Approx ET-jet)
28828 EMSCA=SQRT(2.*S*T*U/(S*S+T*T+U*U))
28829 FACTR=-GEV2NB*0.5*EJ*(YJMAX-YJMIN)*ET*PIFAC*ALPHEM
28830 & *HWUALF(1,EMSCA)/(S*T)
28831 CALL HWSFUN(XX(2),EMSCA,IDHW(IHAD2),NSTRU,DISF(1,2),2)
28833 CTSU=-2.*CFFAC*(U/S+S/U)
28838 IF (DISF(ID2,2).LT.EPS) GOTO 20
28840 C photon+q ---> g+q
28841 HCS=HCS+CTSU*DISF(ID2,2)*QFCH(ID2)**2
28842 IF (GENEV.AND.HCS.GT.RCS) THEN
28843 CALL HWHQCP( 13,ID2,1423,51)
28846 ELSEIF (ID2.LT.13) THEN
28847 C photon+qbar ---> g+qbar
28848 HCS=HCS+CTSU*DISF(ID2,2)*QFCH(ID2-6)**2
28849 IF (GENEV.AND.HCS.GT.RCS) THEN
28850 CALL HWHQCP( 13,ID2,1342,52)
28854 C photon+g ---> q+qbar
28856 IF (RS.GT.RMASS(ID3)) THEN
28858 HCS=HCS+CSTU*DISF(ID2,2)*QFCH(ID3)**2
28859 IF (GENEV.AND.HCS.GT.RCS) THEN
28860 CALL HWHQCP(ID3,ID4,1423,53)
28873 CALL HWETWO(.TRUE.,.TRUE.)
28876 *CMZ :- -27/03/95 13.27.22 by Mike Seymour
28877 *-- Author : Ian Knowles
28878 C-----------------------------------------------------------------------
28880 C-----------------------------------------------------------------------
28881 C Compton scattering of point-like photon and (anti)quark
28882 C mean EVWGT = sigma in nb
28883 C-----------------------------------------------------------------------
28884 INCLUDE 'herwig65.inc'
28885 DOUBLE PRECISION HWRGEN,HWRUNI,EPS,RCS,PP1,PP2,ET,EJ,EXY,EXY2,
28886 & FACTR,S,T,U,CTSU,HCS
28887 INTEGER ID1,ID2,IHAD1,IHAD2
28888 EXTERNAL HWRGEN,HWRUNI
28889 SAVE CTSU,HCS,FACTR
28890 PARAMETER (EPS=1.E-9)
28892 IF (JDAHEP(1,IHAD1).NE.0) IHAD1=JDAHEP(1,IHAD1)
28894 IF (JDAHEP(1,IHAD2).NE.0) IHAD2=JDAHEP(1,IHAD2)
28899 PP1=PHEP(4,IHAD1)+ABS(PHEP(3,IHAD1))
28900 PP2=PHEP(4,IHAD2)+ABS(PHEP(3,IHAD2))
28903 EXY=EXP(HWRUNI(1,YJMIN,YJMAX))
28905 IF (EXY2.LE.EXP(YJMIN).OR.EXY2.GE.EXP(YJMAX)) RETURN
28906 XX(2)=PP1/(PP2*EXY*EXY2)
28907 IF (XX(2).LE.ZERO.OR.XX(2).GE.ONE) RETURN
28912 C Set EMSCA to hard process scale (Approx ET-jet)
28913 EMSCA=SQRT(2.*S*T*U/(S*S+T*T+U*U))
28914 FACTR=-GEV2NB*0.5*EJ*(YJMAX-YJMIN)*ET*PIFAC*ALPHEM**2/(S*T)
28915 CALL HWSFUN(XX(2),EMSCA,IDHW(IHAD2),NSTRU,DISF(1,2),2)
28921 IF (DISF(ID2,2).LT.EPS) GOTO 20
28923 C photon+q ---> photon+q
28924 HCS=HCS+CTSU*DISF(ID2,2)*QFCH(ID2)**4
28925 IF (GENEV.AND.HCS.GT.RCS) THEN
28926 CALL HWHQCP( 59,ID2,1432,66)
28930 C photon+qbar ---> photon+qbar
28931 HCS=HCS+CTSU*DISF(ID2,2)*QFCH(ID2-6)**4
28932 IF (GENEV.AND.HCS.GT.RCS) THEN
28933 CALL HWHQCP( 59,ID2,1432,67)
28944 CALL HWETWO(.TRUE.,.TRUE.)
28947 *CMZ :- -20/05/99 12.39.45 by Kosuke Odagiri
28948 *-- Author : Bryan Webber
28949 C-----------------------------------------------------------------------
28951 C-----------------------------------------------------------------------
28952 C QCD HARD 2->2 PROCESSES: MEAN EVWGT = SIGMA IN NB
28953 C-----------------------------------------------------------------------
28954 INCLUDE 'herwig65.inc'
28955 DOUBLE PRECISION HWRGEN,HWRUNI,HWUALF,RS,EPS,HF,RCS,Z1,Z2,ET,EJ,
28956 & FACTR,S,T,U,ST,TU,US,STU,TUS,UST,EN,RN,GFLA,AF,ASTU,ASUT,AUST,
28957 & BF,BSTU,BSUT,BUST,BUTS,CF,CSTU,CSUT,CTSU,CTUS,DF,DSTU,DTSU,DUTS,
28958 & DIST,HCS,UT,SU,GT,KK,KK2,YJ1INF,YJ1SUP,YJ2INF,YJ2SUP
28960 EXTERNAL HWRGEN,HWRUNI,HWUALF
28961 SAVE HCS,ASTU,AUST,BSTU,BSUT,BUST,BUTS,CSTU,CSUT,CTSU,CTUS,
28962 & DSTU,DTSU,DUTS,GFLA,RCS,S,T,TU,U,US
28963 PARAMETER (EPS=1.E-9,HF=0.5)
28971 IF (KK.GE.ONE) RETURN
28972 YJ1INF = MAX( YJMIN, LOG((ONE-SQRT(ONE-KK2))/KK) )
28973 YJ1SUP = MIN( YJMAX, LOG((ONE+SQRT(ONE-KK2))/KK) )
28974 IF (YJ1INF.GE.YJ1SUP) RETURN
28975 Z1=EXP(HWRUNI(1,YJ1INF,YJ1SUP))
28976 YJ2INF = MAX( YJMIN, -LOG(TWO/KK-ONE/Z1) )
28977 YJ2SUP = MIN( YJMAX, LOG(TWO/KK-Z1) )
28978 IF (YJ2INF.GE.YJ2SUP) RETURN
28979 Z2=EXP(HWRUNI(2,YJ2INF,YJ2SUP))
28980 XX(1)=.5*(Z1+Z2)*KK
28981 IF (XX(1).GE.ONE) RETURN
28982 XX(2)=XX(1)/(Z1*Z2)
28983 IF (XX(2).GE.ONE) RETURN
28984 COSTH=(Z1-Z2)/(Z1+Z2)
28985 S=XX(1)*XX(2)*PHEP(5,3)**2
28988 IF (RS.LT.RMASS(I)) GOTO 4
28992 IF (MAXFL.EQ.0) THEN
28993 CALL HWWARN('HWHQCD',100)
28999 C---SET EMSCA TO HARD PROCESS SCALE (APPROX ET-JET)
29000 EMSCA=SQRT(2.*S*T*U/(S*S+T*T+U*U))
29001 FACTR = GEV2NB*.5*PIFAC*EJ*ET*(HWUALF(1,EMSCA)/S)**2
29002 & * (YJ1SUP-YJ1INF)*(YJ2SUP-YJ2INF)
29003 CALL HWSGEN(.FALSE.)
29014 GFLA=HF*FLOAT(MAXFL)/(EN*RN)**2
29016 ASTU=AF*(1.-2.*UST)
29017 ASUT=AF*(1.-2.*STU)
29018 AUST=AF*(1.-2.*TUS)
29019 C-----------------------------------------------------------------------
29020 C---Colour decomposition modifications below (KO)
29021 C-----------------------------------------------------------------------
29022 BF=HF-AF/EN/TUS/(ASTU+ASUT)
29025 BF=ONE-TWO*AF/EN/STU/(AUST+ASTU)
29028 C-----------------------------------------------------------------------
29030 C BSTU=HF*(ASTU+BF*ST)
29031 C BSUT=HF*(ASUT+BF/US)
29034 C-----------------------------------------------------------------------
29036 CSTU=(CF*(RN-TUS))/TU
29037 CSUT=(CF*(RN-TUS))*TU
29038 CTSU=(FACTR*(UST-RN))*US
29039 CTUS=(FACTR*(UST-RN))/US
29041 DSTU=DF*(1.+1./TUS-STU-UST)
29042 DTSU=DF*(1.+1./UST-STU-TUS)
29043 DUTS=DF*(1.+1./STU-UST-TUS)
29048 IF (DISF(ID1,1).LT.EPS) GOTO 6
29050 IF (DISF(ID2,2).LT.EPS) GOTO 5
29051 DIST=DISF(ID1,1)*DISF(ID2,2)
29055 IF (ID1.NE.ID2) THEN
29057 IF (GENEV.AND.HCS.GT.RCS) THEN
29058 CALL HWHQCP(ID1,ID2,3421, 3)
29063 IF (GENEV.AND.HCS.GT.RCS) THEN
29064 CALL HWHQCP(ID1,ID2,3421, 1)
29068 IF (GENEV.AND.HCS.GT.RCS) THEN
29069 CALL HWHQCP(ID1,ID2,4312, 2)
29073 ELSEIF (ID2.NE.13) THEN
29074 IF (ID2.NE.ID1+6) THEN
29076 IF (GENEV.AND.HCS.GT.RCS) THEN
29077 CALL HWHQCP(ID1,ID2,3142, 9)
29081 HCS=HCS+FLOAT(MAXFL-1)*AUST*DIST
29082 IF (GENEV.AND.HCS.GT.RCS) THEN
29083 CALL HWHQCP(-ID1, 0,2413, 4)
29087 IF (GENEV.AND.HCS.GT.RCS) THEN
29088 CALL HWHQCP(ID1,ID2,3142, 5)
29092 IF (GENEV.AND.HCS.GT.RCS) THEN
29093 CALL HWHQCP(ID1,ID2,2413, 6)
29097 IF (GENEV.AND.HCS.GT.RCS) THEN
29098 CALL HWHQCP( 13, 13,2413, 7)
29102 IF (GENEV.AND.HCS.GT.RCS) THEN
29103 CALL HWHQCP( 13, 13,2341, 8)
29109 IF (GENEV.AND.HCS.GT.RCS) THEN
29110 CALL HWHQCP(ID1,ID2,3142,10)
29114 IF (GENEV.AND.HCS.GT.RCS) THEN
29115 CALL HWHQCP(ID1,ID2,3421,11)
29119 ELSEIF (ID1.NE.13) THEN
29122 IF (ID1.NE.ID2+6) THEN
29124 IF (GENEV.AND.HCS.GT.RCS) THEN
29125 CALL HWHQCP(ID1,ID2,2413,17)
29129 HCS=HCS+FLOAT(MAXFL-1)*AUST*DIST
29130 IF (GENEV.AND.HCS.GT.RCS) THEN
29131 CALL HWHQCP(-ID1, 0,3142,12)
29135 IF (GENEV.AND.HCS.GT.RCS) THEN
29136 CALL HWHQCP(ID1,ID2,2413,13)
29140 IF (GENEV.AND.HCS.GT.RCS) THEN
29141 CALL HWHQCP(ID1,ID2,3142,14)
29145 IF (GENEV.AND.HCS.GT.RCS) THEN
29146 CALL HWHQCP( 13, 13,3142,15)
29150 IF (GENEV.AND.HCS.GT.RCS) THEN
29151 CALL HWHQCP( 13, 13,4123,16)
29155 ELSEIF (ID2.NE.13) THEN
29156 IF (ID1.NE.ID2) THEN
29158 IF (GENEV.AND.HCS.GT.RCS) THEN
29159 CALL HWHQCP(ID1,ID2,4312,20)
29164 IF (GENEV.AND.HCS.GT.RCS) THEN
29165 CALL HWHQCP(ID1,ID2,4312,18)
29169 IF (GENEV.AND.HCS.GT.RCS) THEN
29170 CALL HWHQCP(ID1,ID2,3421,19)
29176 IF (GENEV.AND.HCS.GT.RCS) THEN
29177 CALL HWHQCP(ID1,ID2,2413,21)
29181 IF (GENEV.AND.HCS.GT.RCS) THEN
29182 CALL HWHQCP(ID1,ID2,4312,22)
29190 IF (GENEV.AND.HCS.GT.RCS) THEN
29191 CALL HWHQCP(ID1,ID2,2413,23)
29195 IF (GENEV.AND.HCS.GT.RCS) THEN
29196 CALL HWHQCP(ID1,ID2,3421,24)
29199 ELSEIF (ID2.LT.13) THEN
29201 IF (GENEV.AND.HCS.GT.RCS) THEN
29202 CALL HWHQCP(ID1,ID2,3142,25)
29206 IF (GENEV.AND.HCS.GT.RCS) THEN
29207 CALL HWHQCP(ID1,ID2,4312,26)
29211 HCS=HCS+GFLA*CSTU*DIST
29212 IF (GENEV.AND.HCS.GT.RCS) THEN
29213 CALL HWHQCP( 0, 0,2413,27)
29216 HCS=HCS+GFLA*CSUT*DIST
29217 IF (GENEV.AND.HCS.GT.RCS) THEN
29218 CALL HWHQCP( 0, 0,4123,28)
29222 IF (GENEV.AND.HCS.GT.RCS) THEN
29223 CALL HWHQCP(ID1,ID2,2341,29)
29227 IF (GENEV.AND.HCS.GT.RCS) THEN
29228 CALL HWHQCP(ID1,ID2,3421,30)
29232 IF (GENEV.AND.HCS.GT.RCS) THEN
29233 CALL HWHQCP(ID1,ID2,2413,31)
29246 CALL HWETWO(.TRUE.,.TRUE.)
29248 C Calculate coefficients for constructing spin density matrices
29249 IF (IHPRO.EQ.7 .OR.IHPRO.EQ.8 .OR.
29250 & IHPRO.EQ.15.OR.IHPRO.EQ.16) THEN
29251 C qqbar-->gg or qbarq-->gg
29260 ELSEIF (IHPRO.EQ.10.OR.IHPRO.EQ.11.OR.
29261 & IHPRO.EQ.21.OR.IHPRO.EQ.22.OR.
29262 & IHPRO.EQ.23.OR.IHPRO.EQ.24.OR.
29263 & IHPRO.EQ.25.OR.IHPRO.EQ.26) THEN
29264 C qg-->qg or qbarg-->qbarg or gq-->gq or gqbar-->gqbar
29273 ELSEIF (IHPRO.EQ.27.OR.IHPRO.EQ.28) THEN
29283 ELSEIF (IHPRO.EQ.29.OR.IHPRO.EQ.30.OR.
29284 & IHPRO.EQ.31) THEN
29287 GCOEF(2)=2.*U*U*T*T
29288 GCOEF(3)=2.*S*S*U*U
29289 GCOEF(4)=2.*S*S*T*T
29290 GCOEF(1)=GT*GT-GCOEF(2)-GCOEF(3)-GCOEF(4)
29291 GCOEF(5)=GT*(GT-2.*S*S)-GCOEF(2)
29292 GCOEF(6)=GT*(GT-2.*T*T)-GCOEF(3)
29293 GCOEF(7)=GT*(GT-2.*U*U)-GCOEF(4)
29295 CALL HWVZRO(7,GCOEF)
29301 *CMZ :- -26/04/91 10.18.57 by Bryan Webber
29302 *-- Author : Bryan Webber
29303 C-----------------------------------------------------------------------
29304 SUBROUTINE HWHQCP(ID3,ID4,IPERM,IHPR)
29305 C-----------------------------------------------------------------------
29306 C IDENTIFIES HARD SUBPROCESS
29307 C-----------------------------------------------------------------------
29308 INCLUDE 'herwig65.inc'
29309 INTEGER HWRINT,ID3,ID4,IPERM,IHPR,ND3
29317 IF (ID3.GT.-7) THEN
29318 1 IDN(3)=HWRINT(1,MAXFL)
29319 IF (IDN(3).EQ.ND3) GOTO 1
29322 2 IDN(3)=HWRINT(1,MAXFL)+6
29323 IF (IDN(3).EQ.ND3) GOTO 2
29328 ICO(2)=IPERM/100-10*ICO(1)
29329 ICO(3)=IPERM/10 -10*(IPERM/100)
29330 ICO(4)=IPERM -10*(IPERM/10)
29333 *CMZ :- -27/07/95 14.13.56 by Mike Seymour
29334 *-- Author : Mike Seymour
29335 C-----------------------------------------------------------------------
29337 C HARD PROCESS: GAMGAM --> QQBAR/LLBAR/W+W-
29338 C MEAN EVENT WEIGHT = CROSS-SECTION IN NB AFTER CUTS ON PT
29339 C-----------------------------------------------------------------------
29340 INCLUDE 'herwig65.inc'
29341 DOUBLE PRECISION RCS,HCS,RS,S,EMSQ,BE,TMIN,TMAX,T,U,FACTR,Q,CFAC,
29343 INTEGER IHAD1,IHAD2,HQ,ID3,ID4,I1,I2
29344 SAVE HCS,FACTR,HQ,RS
29346 IF (JDAHEP(1,IHAD1).NE.0) IHAD1=JDAHEP(1,IHAD1)
29348 IF (JDAHEP(1,IHAD2).NE.0) IHAD2=JDAHEP(1,IHAD2)
29361 IF (HQ.GT.6) HQ=2*HQ+107
29362 IF (HQ.EQ.127) HQ=198
29365 IF (BE.LT.ZERO) RETURN
29368 IF (HQ.LE.6) CFAC=3
29370 TMIN=S/2*(1-SQRT(MAX(1-4*(EMSQ+PTMIN**2)/S,ZERO)))
29371 TMAX=S/2*(1-SQRT(MAX(1-4*(EMSQ+PTMAX**2)/S,ZERO)))
29372 IF (TMIN.GE.TMAX) RETURN
29373 T=-(TMAX/TMIN)**HWRGEN(1)*TMIN
29374 IF (HWRGEN(2).GT.HALF) T=-S-T
29377 EMSCA=SQRT(2.*S*T*U/(S*S+T*T+U*U))
29378 IF (HQ.NE.198) THEN
29379 FACTR=-GEV2NB*2*LOG(TMAX/TMIN)*MAX(T,U)
29380 $ *2*PIFAC*CFAC*ALPHEM**2/S**2
29381 $ *((U-4*EMSQ)/T+(T-4*EMSQ)/U-4*(EMSQ/T+EMSQ/U)**2)
29383 FACTR=-GEV2NB*2*LOG(TMAX/TMIN)*MAX(T,U)
29384 $ *6*PIFAC*CFAC*ALPHEM**2/S**2
29385 $ *(1-S/(T*U)*(4D0/3*S+2*EMSQ)
29386 $ +(S/(T*U))**2*(2D0/3*S**2+2*EMSQ**2))
29400 IF (RS.GT.2*RMASS(ID3)) THEN
29402 IF (HQ.LE.6) Q=Q/THREE
29404 IF (HQ.EQ.198) ID4=199
29406 IF (GENEV.AND.HCS.GT.RCS) THEN
29407 CALL HWHQCP(ID3,ID4,1243,61)
29417 CALL HWETWO(.TRUE.,.TRUE.)
29420 *CMZ :- -20/10/99 09:46:43 by Peter Richardson
29421 *-- Author : Peter Richardson
29422 C-----------------------------------------------------------------------
29424 C-----------------------------------------------------------------------
29425 C Subroutine for 2 parton -> 2 parton via UDD resonant squarks
29426 C-----------------------------------------------------------------------
29427 INCLUDE 'herwig65.inc'
29428 DOUBLE PRECISION HCS,S,RCS,HWRGEN,MQ1,MQ2,TAU,LOWTLM,UPPTLM,RTAB,
29429 & SQSH,MATELM,SCF(12),CHANPB(2),HWRUNI,PCM,MIX(12),
29430 & ME(2,3,3,3,3),WD,MS(12),SWD(12),RAND,TAUA,
29431 & CHAN(12),EPS,SH,FAC,TAUB,LAM(6,3,3,3,3),
29432 & XMIN,XMAX,XPOW,XUPP,MS2(12),MSWD(12)
29433 INTEGER I,J,K,L,I1,J1,K1,L1,N,THEP,CONECT(4,5),HWRINT,
29434 & GENR,GN,MIG,MXG,GEN
29436 EXTERNAL HWRGEN,HWRUNI
29437 PARAMETER(EPS=1D-20)
29438 COMMON/HWRPIN/XMIN,XMAX,XPOW,FIRST
29439 SAVE HCS,ME,MS,SWD,CHAN,LAM,MIX,FAC,SH,SQSH,SCF,MS2,MSWD
29441 DATA CONECT/1,1,3,4,-1,-1,2,3,0,0,0,0,1,1,-2,-3,-1,-1,-3,-4/
29443 RCS = HCS*HWRGEN(0)
29446 C--Extract masses and width's needed
29448 MS(2*I-1) = RMASS(399+2*I)
29449 MS(2*I) = RMASS(411+2*I)
29450 MS(2*I+5) = RMASS(400+2*I)
29451 MS(2*I+6) = RMASS(412+2*I)
29452 SWD(2*I-1) = HBAR/RLTIM(399+2*I)
29453 SWD(2*I) = HBAR/RLTIM(411+2*I)
29454 SWD(2*I+5) = HBAR/RLTIM(400+2*I)
29455 SWD(2*I+6) = HBAR/RLTIM(412+2*I)
29459 MSWD(I) = MS(I)*SWD(I)
29461 C--Now set up the parmaters for multichannel integration
29468 CHANPB(1)=CHANPB(1)+LAMDA3(I,J,K)**2
29469 CHANPB(2)=CHANPB(2)+LAMDA3(K,I,J)**2
29472 RAND=RAND+CHANPB(1)+CHANPB(2)
29474 CHAN(2*K-2+J) = CHANPB(1)*QMIXSS(2*K-1,2,J)**2
29475 CHAN(2*K+4+J) = CHANPB(2)*QMIXSS(2*K ,2,J)**2
29476 MIX(2*K-2+J) = QMIXSS(2*K-1,2,J)**2
29477 MIX(2*K+4+J) = QMIXSS(2*K,2,J)**2
29480 IF(RAND.GT.ZERO) THEN
29482 CHAN(I)=CHAN(I)/RAND
29486 CALL HWWARN('HWHRBB',500)
29488 C--find the couplings
29494 LAM(GN,I,J,K,L) =LAMDA3(I,J,GN)*LAMDA3(K,L,GN)
29495 LAM(GN+3,I,J,K,L)=LAMDA3(GN,I,J)*LAMDA3(GN,K,L)
29504 COSTH = HWRUNI(0,-ONE,ONE)
29505 C--Generate the smoothing
29506 RAND=HWRUNI(0,ZERO,ONE)
29508 IF(CHAN(I).GT.RAND) GOTO 20
29512 C--Calculate hard scale and obtain parton distributions
29514 TAUB = SWD(GENR)**2/S
29515 RTAB = SQRT(TAUA*TAUB)
29517 IF(XMAX**2.GT.S) XUPP = SQRT(S)
29518 LOWTLM = DATAN((XMIN**2/S-TAUA)/RTAB)/RTAB
29519 UPPTLM = DATAN((XUPP**2/S-TAUA)/RTAB)/RTAB
29520 TAU = HWRUNI(0,LOWTLM,UPPTLM)
29521 TAU = RTAB*TAN(RTAB*TAU)+TAUA
29525 XX(1) = EXP(HWRUNI(0,ZERO,LOG(TAU)))
29527 CALL HWSGEN(.FALSE.)
29528 C--Calculate the prefactor due multichannel approach
29531 SCF(GN)=1/((SH-MS2(GN))**2+MSWD(GN)**2)
29532 FAC=FAC+CHAN(GN)*SCF(GN)
29534 FAC=-(UPPTLM-LOWTLM)*LOG(TAU)*GEV2NB
29535 & /(24*PIFAC*SQSH*SH*TAU*FAC*S**2)
29537 C--loop over the quarks
29555 IF(GN.EQ.2.AND.L1.GE.K1) GOTO 70
29559 IF(SQSH.GT.(MQ1+MQ2)) THEN
29560 PCM=SQRT((SH-(MQ1+MQ2)**2)*(SH-(MQ1-MQ2)**2)/(4*SH))
29561 WD = SH*(SH-MQ1**2-MQ2**2)*PCM
29573 IF(J1.GT.I1) GOTO 60
29578 IF(ABS(MIX(GEN)).LT.EPS.OR.
29579 & ABS(LAM(INT((GEN+1)/2),I1,J1,K1,L1)).LT.EPS) GOTO 40
29581 IF(ABS(LAM(INT((GENR+1)/2),I1,J1,K1,L1)).LT.EPS.
29582 & OR.ABS(MIX(GENR)).LT.EPS) GOTO 30
29583 MATELM =MATELM+SCF(GEN)*SCF(GENR)*WD*
29584 & ((SH-MS2(GEN))*(SH-MS2(GENR))+
29585 & MSWD(GEN)*MSWD(GENR))
29586 & *LAM(INT((GEN+1)/2),I1,J1,K1,L1)*MIX(GEN)
29587 & *LAM(INT((GENR+1)/2),I1,J1,K1,L1)*MIX(GENR)
29590 ME(GN,I1,J1,K1,L1) = MATELM*FAC
29591 C--Add up the term to get the cross-section
29592 50 HCS = HCS+ME(GN,I1,J1,K1,L1)*DISF(I,1)*DISF(J,2)
29593 IF(HCS.GT.RCS.AND.GENEV) THEN
29594 CALL HWHRSS(1,I,J,K,L,0,0)
29597 HCS = HCS+ME(GN,I1,J1,K1,L1)*DISF(J,1)*DISF(I,2)
29598 IF(HCS.GT.RCS.AND.GENEV) THEN
29599 CALL HWHRSS(2,J,I,K,L,0,0)
29602 HCS = HCS+ME(GN,I1,J1,K1,L1)*DISF(I+6,1)*DISF(J+6,2)
29603 IF(HCS.GT.RCS.AND.GENEV) THEN
29604 CALL HWHRSS(1,I,J,K,L,1,0)
29607 HCS = HCS+ME(GN,I1,J1,K1,L1)*DISF(J+6,1)*DISF(I+6,2)
29608 IF(HCS.GT.RCS.AND.GENEV) THEN
29609 CALL HWHRSS(2,J,I,K,L,1,0)
29618 CALL HWETWO(.TRUE.,.TRUE.)
29619 C--first stage of the colour connection corrections
29622 JMOHEP(2,THEP+NHEP-5)=NHEP-5+THEP+CONECT(HWRINT(1,4),THEP)
29623 JDAHEP(2,THEP+NHEP-5) = JMOHEP(2,THEP+NHEP-5)
29627 IF(HWRINT(1,2).EQ.1) THEN
29628 HRDCOL(2,1) = THEP+3
29629 HRDCOL(2,2) = THEP+4
29631 HRDCOL(1,5) = THEP+1
29633 HRDCOL(2,1) = THEP+4
29634 HRDCOL(2,2) = THEP+3
29635 HRDCOL(1,4) = THEP+1
29640 HRDCOL(1,N)=HRDCOL(2,N)
29641 ELSEIF(N.GE.4) THEN
29642 HRDCOL(2,N)=HRDCOL(1,N)
29652 *CMZ :- -20/10/99 09:46:43 by Peter Richardson
29653 *-- Author : Peter Richardson
29654 C-----------------------------------------------------------------------
29656 C-----------------------------------------------------------------------
29657 C Subroutine for 2 parton -> parton SUSY particle via UDD resonant
29659 C-----------------------------------------------------------------------
29660 INCLUDE 'herwig65.inc'
29661 DOUBLE PRECISION HCS,S,RCS,HWRGEN,ME(4),CW,MER(6),MZ,TAU,TAUA,
29662 & TAUB,LOWTLM,UPPTLM,HWRUNI,SH,SQSH,SCF(12),MW2,
29663 & LAMC(3),CHANPB(2),PCM,ECM,RAND,MEN(7,6,3,3),
29664 & MEC(2,6,3,3),RTAB,MS(12),SWD(12),AS,HWUALF,
29665 & MQ,MN,MQS,TH,UH,FAC,MX(14),CHAN(12),MC(2),
29666 & MNS,HWUAEM,SW,G,EC,MW,A(7,14),B(7,14),EPS,XUPP,
29667 & MEH(3,42),XMIN,XMAX,XPOW,FAC2,MH(4),ZSQU(2,2),
29668 & ZQRK(2),MZ2,GUU(4),GDD(4),ME2,MS2(12),MSWD(12)
29669 INTEGER I,J,K,I1,J1,GEN,THEP,HWRINT,L,GT,GU,GR,I2,
29670 & CONECT(2,6,5),GN,GENR,SP,SPMN,SPMX,CON,CHARMN,CHARMX,
29672 LOGICAL RAD,NEUT,CHAR,HIGGS,FIRST
29673 EXTERNAL HWRGEN,HWRUNI,HWUAEM,HWUALF,HWRINT
29674 COMMON/HWRPIN/XMIN,XMAX,XPOW,FIRST
29675 SAVE HCS,MS,SWD,MX,CHAN,A,B,SPMN,SPMX,RAD,MEN,MEC,HIGGS,
29676 & CHARMN,CHARMX,NEUT,CHAR,SQSH,MEH,SW,CW,MW,MZ,MER,SH,MH,
29677 & AS,EC,FAC,G,SCF,ZSQU,ZQRK,MW2,MZ2,MS2,MSWD,GUU,GDD
29678 PARAMETER(EPS=1D-20)
29680 DATA CONECT/ 4, 4, 2, 3, 0, 0, 1,-2,-1,-3,-4,-4,
29681 & 3, 4, 3, 3, 0, 0, 1,-3,-1,-4,-3,-3,
29682 & 1, 4,-1, 3, 0, 0, 1, 1,-3,-4,-1,-1,
29683 & 1, 3,-1, 2, 0, 0,-3,-2, 0, 0, 0, 0,
29684 & 1, 4,-1, 3, 0, 0,-3,-2,-1,-1,-1,-1/
29686 RCS = HCS*HWRGEN(0)
29689 C--Extract masses and width's needed
29691 MS(2*I-1) = RMASS(399+2*I)
29692 MS(2*I) = RMASS(411+2*I)
29693 MS(2*I+5) = RMASS(400+2*I)
29694 MS(2*I+6) = RMASS(412+2*I)
29695 SWD(2*I-1) = HBAR/RLTIM(399+2*I)
29696 SWD(2*I) = HBAR/RLTIM(411+2*I)
29697 SWD(2*I+5) = HBAR/RLTIM(400+2*I)
29698 SWD(2*I+6) = HBAR/RLTIM(412+2*I)
29702 MSWD(I) = MS(I)*SWD(I)
29704 C--Electroweak parameters
29711 C--Now set up the parmaters for multichannel integration
29718 CHANPB(1)=CHANPB(1)+LAMDA3(I,J,K)**2
29719 CHANPB(2)=CHANPB(2)+LAMDA3(K,I,J)**2
29722 RAND=RAND+CHANPB(1)+CHANPB(2)
29724 CHAN(2*K-2+J) = CHANPB(1)*QMIXSS(2*K-1,2,J)**2
29725 CHAN(2*K+4+J) = CHANPB(2)*QMIXSS(2*K ,2,J)**2
29726 MX(2*K-2+J) = QMIXSS(2*K-1,2,J)
29727 MX(2*K+4+J) = QMIXSS(2*K,2,J)
29732 IF(RAND.GT.ZERO) THEN
29734 CHAN(I)=CHAN(I)/RAND
29737 CALL HWWARN('HWHRBS',500)
29739 C--Couplings we need for the various processes
29743 A(1,2*I-2+J) = QMIXSS(2*I-1,2,J)
29744 B(1,2*I-2+J) = -QMIXSS(2*I-1,1,J)
29745 A(1,2*I+4+J) = QMIXSS(2*I,2,J)
29746 B(1,2*I+4+J) = -QMIXSS(2*I,1,J)
29749 C--Now the neutralinos
29751 MC(1) = ZMIXSS(L,3)/(2*MW*COSB*SW)
29752 MC(2) = ZMIXSS(L,4)/(2*MW*SINB*SW)
29755 A(L+1,2*I-2+J) = ZSGNSS(L)*(MC(1)*QMIXSS(2*I-1,1,J)*
29756 & RMASS(2*I-1)+SRFCH(2*I-1,L)*QMIXSS(2*I-1,2,J))
29757 B(L+1,2*I-2+J) = MC(1)*QMIXSS(2*I-1,2,J)*
29758 & RMASS(2*I-1)+SLFCH(2*I-1,L)*QMIXSS(2*I-1,1,J)
29759 A(L+1,2*I+4+J) = ZSGNSS(L)*(MC(2)*QMIXSS(2*I,1,J)*
29760 & RMASS(2*I)+SRFCH(2*I ,L)*QMIXSS(2*I,2,J))
29761 B(L+1,2*I+4+J) = MC(2)*QMIXSS(2*I,2,J)*
29762 & RMASS(2*I)+SLFCH(2*I, L)*QMIXSS(2*I,1,J)
29766 C--Now for the charginos
29768 MC(1) = 1/(SQRT(2.0D0)*MW*COSB)
29769 MC(2) = 1/(SQRT(2.0D0)*MW*SINB)
29772 A(5+L,2*I-2+J) = -WSGNSS(L)*WMXVSS(L,2)*MC(2)*
29773 & RMASS(2*I)*QMIXSS(2*I-1,1,J)
29774 B(5+L,2*I-2+J) = WMXUSS(L,1)*QMIXSS(2*I-1,1,J)
29775 & -WMXUSS(L,2)*MC(1)*RMASS(2*I-1)*QMIXSS(2*I-1,2,J)
29776 A(5+L,2*I+4+J) = -WMXUSS(L,2)*MC(1)*RMASS(2*I-1)
29778 B(5+L,2*I+4+J) = WSGNSS(L)*(WMXVSS(L,1)*QMIXSS(2*I,1,J)
29779 & -WMXVSS(L,2)*MC(2)*RMASS(2*I)*QMIXSS(2*I,2,J))
29790 C--Couplings to the Z boson of squarks and right-handed quarks
29791 ZQRK(1) = -SW**2/6.0D0/CW
29792 ZQRK(2) = SW**2/3.0D0/CW
29793 ZSQU(1,1) = HALF*(QMIXSS(5,1,1)**2-2.0D0*SW**2/3.0D0)/CW
29794 ZSQU(1,2) = HALF*QMIXSS(5,1,1)*QMIXSS(5,1,2)/CW
29795 ZSQU(2,1) = -HALF*(QMIXSS(6,1,1)**2-4.0D0*SW**2/3.0D0)/CW
29796 ZSQU(2,2) = -HALF*QMIXSS(6,1,1)*QMIXSS(6,1,2)/CW
29799 MH(I) = RMASS(202+I)
29801 C--Higgs couplings to quarks
29803 GUU(I) = GHUUSS(I)**2*HALF**2/MW2
29804 GDD(I) = GHDDSS(I)**2*HALF**2/MW2
29806 GUU(4) = ONE/TANB**2/MW2/8.0D0
29807 GDD(4) = ONE*TANB**2/MW2/8.0D0
29808 C--decide which processes to generate from IPROC
29817 IF(MOD(IPROC,10000).EQ.4100) THEN
29822 ELSEIF(MOD(IPROC,10000).LT.4120) THEN
29824 IF(MOD(IPROC,10000).NE.4110) THEN
29825 SPMN = MOD(IPROC,10)+1
29829 ELSEIF(MOD(IPROC,10000).LT.4130) THEN
29830 IF(MOD(IPROC,10000).NE.4120) THEN
29831 CHARMN = MOD(IPROC,10)
29835 ELSEIF(MOD(IPROC,10000).EQ.4130) THEN
29838 ELSEIF(MOD(IPROC,10000).EQ.4140) THEN
29840 ELSEIF(MOD(IPROC,10000).EQ.4150) THEN
29843 CALL HWWARN('HWHRBS',501)
29848 COSTH = HWRUNI(0,-ONE,ONE)
29862 C--Multichannel peak
29863 RAND=HWRUNI(0,ZERO,ONE)
29865 IF(CHAN(I).GT.RAND) GOTO 25
29869 C--Calculate the hard scale and obtain parton distributions
29871 TAUB = SWD(GENR)**2/S
29872 RTAB = SQRT(TAUA*TAUB)
29874 IF(XMAX**2.GT.S) XUPP = SQRT(S)
29875 LOWTLM = DATAN((XMIN**2/S-TAUA)/RTAB)/RTAB
29876 UPPTLM = DATAN((XUPP**2/S-TAUA)/RTAB)/RTAB
29877 TAU = HWRUNI(0,LOWTLM,UPPTLM)
29878 TAU = RTAB*TAN(RTAB*TAU)+TAUA
29882 XX(1) = EXP(HWRUNI(0,ZERO,LOG(TAU)))
29884 CALL HWSGEN(.FALSE.)
29885 C--Strong, EM coupling and weak couplings
29886 AS = HWUALF(1,EMSCA)
29887 EC = SQRT(4*PIFAC*HWUAEM(SH))
29889 C--Calculate the prefactor due multichannel approach
29892 SCF(GN)=1/((SH-MS2(GN))**2+MSWD(GN)**2)
29893 FAC=FAC+CHAN(GN)*SCF(GN)
29895 FAC=-(UPPTLM-LOWTLM)*LOG(TAU)*GEV2NB
29896 & /(48*PIFAC*SQSH*SH*TAU*FAC*S**2)
29899 IF(.NOT.NEUT) GOTO 200
29902 IF(CHAN(GR).LT.EPS) GOTO 140
29905 IF(GN.GT.3) K = 2*GN
29907 MN = ABS(RMASS(448+L))
29910 IF(SQSH.LT.(MQ+MN)) GOTO 130
29911 PCM=SQRT((SH-(MQ+MN)**2)*(SH-(MQ-MN)**2)/(4*SH))
29912 ECM=SQRT(PCM**2+MQS)
29913 TH = MQS-SQSH*(ECM-PCM*COSTH)
29914 UH = MQS-SQSH*(ECM+PCM*COSTH)
29920 LAMC(1) = LAMDA3(I,J,GN)**2
29924 LAMC(1) = LAMDA3(GN-3,I,J)**2
29925 IF(J.GT.I) LAMC(1) = ZERO
29929 C--Now the matrix elements
29930 IF(LAMC(1).LT.EPS) GOTO 120
29933 ME(3) = MX(GR)**2*SCF(GR)*SH*((SH-MQS-MNS)*(A(L,GR)**2+
29934 & B(L,GR)**2)-4*MQ*MN*A(L,GR)*B(L,GR))
29935 ME(4) =-TWO*MX(GU)*MX(GT)*(MQS*MNS-UH*TH)*A(L,GT)*A(L,GU)
29936 & /(TH-MS2(GT))/(UH-MS2(GU))
29937 & +TWO*MX(GR)*MX(GU)*(SH-MS2(GR))*SCF(GR)*SH*
29938 & A(L,GU)*(A(L,GR)*UH+B(L,GR)*MQ*MN)/(UH-MS2(GU))
29939 & +TWO*MX(GR)*MX(GT)*(SH-MS2(GR))*SCF(GR)*SH*
29940 & A(L,GT)*(A(L,GR)*TH+B(L,GR)*MQ*MN)/(TH-MS2(GT))
29941 C--L/R s channel and interference
29942 IF(ABS(MX(GR-1)).GT.EPS) THEN
29944 & MX(GR-1)**2*SCF(GR-1)*SH*((SH-MQS-MNS)*(A(L,GR-1)**2
29945 & +B(L,GR-1)**2)-4*MQ*MN*A(L,GR-1)*B(L,GR-1))
29946 & +TWO*MX(GR)*MX(GR-1)*SCF(GR)*SCF(GR-1)*SH*
29947 & ((SH-MS2(GR))*(SH-MS2(GR-1))+MSWD(GR)*MSWD(GR-1))*
29948 & ((SH-MQS-MNS)*(A(L,GR)*A(L,GR-1)
29949 & +B(L,GR)*B(L,GR-1))
29950 & -TWO*MQ*MN*(A(L,GR)*B(L,GR-1)+A(L,GR-1)*B(L,GR)))
29951 ME(4) = ME(4)+TWO*MX(GR-1)*MX(GU)*(SH-MS2(GR-1))
29952 & *SCF(GR-1)*A(L,GU)*SH*(A(L,GR-1)*UH+B(L,GR-1)*MQ*MN)
29954 & +TWO*MX(GR-1)*MX(GT)*(SH-MS2(GR-1))*SCF(GR-1)*SH*
29955 & A(L,GT)*(A(L,GR-1)*TH+B(L,GR-1)*MQ*MN)/(TH-MS2(GT))
29956 IF(ABS(MX(GU-1)).GT.EPS) ME(4)=ME(4)+TWO*MX(GR-1)*
29957 & MX(GU-1)*(SH-MS2(GR-1))*SCF(GR-1)*A(L,GU-1)*SH*(
29958 & A(L,GR-1)*UH+B(L,GR-1)*MQ*MN)/(UH-MS2(GU-1))
29959 IF(ABS(MX(GT-1)).GT.EPS) ME(4)=ME(4)+TWO*MX(GR-1)*
29960 & MX(GT-1)*(SH-MS2(GR-1))*SCF(GR-1)*A(L,GT-1)*SH*
29961 & (A(L,GR-1)*TH+B(L,GR-1)*MQ*MN)/(TH-MS2(GT-1))
29963 C--u channel and L/R mixing
29964 ME(1)= MX(GU)**2*(MQS-UH)*(MNS-UH)*
29965 & (A(L,GU)**2+B(L,GU)**2)/(UH-MS2(GU))**2
29966 IF(ABS(MX(GU-1)).GT.EPS) THEN
29967 ME(1) = ME(1)+MX(GU-1)**2*(MQS-UH)*(MNS-UH)*
29968 & (A(L,GU-1)**2+B(L,GU-1)**2)/(UH-MS2(GU-1))**2
29969 & +TWO*MX(GU)*MX(GU-1)*(MQS-UH)*(MNS-UH)*
29970 & (A(L,GU)*A(L,GU-1)+B(L,GU)*B(L,GU-1))
29971 & /(UH-MS2(GU))/(UH-MS2(GU-1))
29972 ME(4) =ME(4)+TWO*MX(GR)*MX(GU-1)*(SH-MS2(GR))*
29973 & SCF(GR)*A(L,GU-1)*SH*(A(L,GR)*UH+B(L,GR)*MQ*MN)
29975 & -2*MX(GU-1)*MX(GT)*(MQS*MNS-UH*TH)*A(L,GT)*
29976 & A(L,GU-1)/(TH-MS2(GT))/(UH-MS2(GU-1))
29977 IF(ABS(MX(GT-1)).GT.EPS) ME(4)=ME(4)-2*MX(GU-1)*MX(GT-1)
29978 & *(MQS*MNS-UH*TH)*A(L,GT-1)*A(L,GU-1)
29979 & /(TH-MS2(GT-1))/(UH-MS2(GU-1))
29981 C--t channel and t channel L/R mixing
29982 ME(2) = MX(GT)**2*(MQS-TH)*(MNS-TH)*
29983 & (A(L,GT)**2+B(L,GT)**2)/(TH-MS2(GT))**2
29984 IF(ABS(MX(GT-1)).GT.EPS) THEN
29985 ME(2) = ME(2)+MX(GT-1)**2*(MQS-TH)*(MNS-TH)*
29986 & (A(L,GT-1)**2+B(L,GT-1)**2)/(TH-MS2(GT-1))**2
29987 & +TWO*MX(GT)*MX(GT-1)*(MQS-TH)*(MNS-TH)*(A(L,GT)*
29988 & A(L,GT-1)+ B(L,GT)*B(L,GT-1))
29989 & /(TH-MS2(GT))/(TH-MS2(GT-1))
29990 ME(4)=ME(4)-TWO*MX(GU)*MX(GT-1)*(MQS*MNS-UH*TH)*
29991 & A(L,GT-1)*A(L,GU)/(TH-MS2(GT-1))/(UH-MS2(GU))
29992 & +TWO*MX(GR)*MX(GT-1)*(SH-MS2(GR))*SCF(GR)*
29993 & A(L,GT-1)*SH*(A(L,GR)*TH+B(L,GR)*MQ*MN)
29996 C--Angular ordering and the phase space factors
29998 ME(4)=-HALF*ME(4)/(ME(1)+ME(2)+ME(3))
29999 LAMC(1) = 32.0D0*LAMC(1)*AS*PIFAC/THREE
30001 MEN(GEN,GN,I,J) = FAC*PCM*LAMC(1)*ME(GEN)*(ONE+ME(4))
30004 LAMC(1) = TWO*LAMC(1)*EC**2
30005 MEN(L+2,GN,I,J)=FAC*PCM*LAMC(1)*(ME(1)+ME(2)+ME(3)+ME(4))
30007 C--Multiply by the pdf's
30008 110 IF(L.EQ.1) THEN
30017 IF(GEN.LE.3) CON = GEN
30018 HCS=HCS+MEN(GEN,GN,I,J)*DISF(I1,1)*DISF(J1,2)
30019 IF(GENEV.AND.HCS.GT.RCS) THEN
30020 CALL HWHRSS(3,I1,J1,K,GEN,0,0)
30023 HCS=HCS+MEN(GEN,GN,I,J)*DISF(J1,1)*DISF(I1,2)
30024 IF(GENEV.AND.HCS.GT.RCS) THEN
30025 CALL HWHRSS(4,J1,I1,K,GEN,0,0)
30028 HCS=HCS+MEN(GEN,GN,I,J)*DISF(I1+6,1)*DISF(J1+6,2)
30029 IF(GENEV.AND.HCS.GT.RCS) THEN
30030 CALL HWHRSS(3,I1,J1,K,GEN,1,0)
30033 HCS=HCS+MEN(GEN,GN,I,J)*DISF(J1+6,1)*DISF(I1+6,2)
30034 IF(GENEV.AND.HCS.GT.RCS) THEN
30035 CALL HWHRSS(4,J1,I1,K,GEN,1,0)
30043 C--Now the chargino processes if wanted
30044 200 IF(.NOT.CHAR) GOTO 300
30047 IF(CHAN(GR).LT.EPS) GOTO 240
30048 DO 230 L=CHARMN,CHARMX
30051 IF(GN.GT.3) K = 2*GN-1
30053 MN = ABS(RMASS(453+L))
30056 IF(SQSH.LT.(MQ+MN)) GOTO 230
30057 PCM=SQRT((SH-(MQ+MN)**2)*(SH-(MQ-MN)**2)/(4*SH))
30058 ECM=SQRT(PCM**2+MQS)
30059 TH = MQS-SQSH*(ECM-PCM*COSTH)
30060 UH = MQS-SQSH*(ECM+PCM*COSTH)
30067 LAMC(1) = LAMDA3(I,J,GN)
30068 LAMC(2) = LAMDA3(GN,I,J)
30074 LAMC(1) = LAMDA3(GN-3,I,J)
30075 LAMC(2) = LAMDA3(I,J,GN-3)
30076 LAMC(3) = LAMDA3(J,GN-3,I)
30077 IF(J.GT.I) LAMC(1) = ZERO
30080 IF(ABS(LAMC(1)).LT.EPS) GOTO 220
30084 ME(1) = LAMC(1)**2*MX(GR)**2*SCF(GR)*SH*((SH-MQS-MNS)*
30085 & (A(SP,GR)**2+B(SP,GR)**2)-4*MQ*MN*A(SP,GR)*B(SP,GR))
30086 IF(ABS(MX(GU)).GT.EPS) THEN
30087 ME(1) = ME(1)+LAMC(2)**2*MX(GU)**2*(MQS-UH)*(MNS-UH)*
30088 & (A(SP,GU)**2+B(SP,GU)**2)/(UH-MS2(GU))**2
30089 & +LAMC(1)*LAMC(2)*TWO*MX(GR)*MX(GU)*
30090 & (SH-MS2(GR))*SCF(GR)*A(SP,GU)*SH*
30091 & (A(SP,GR)*UH+B(SP,GR)*MQ*MN)/(UH-MS2(GU))
30092 IF(ABS(MX(GT)).GT.EPS) ME(1) = ME(1)-LAMC(2)*LAMC(3)*
30093 & TWO*MX(GU)*MX(GT)*(MQS*MNS-UH*TH)*A(SP,GT)*
30094 & A(SP,GU)/(TH-MS2(GT))/(UH-MS2(GU))
30096 IF(ABS(MX(GT)).GT.EPS) THEN
30097 ME(1) = ME(1)+LAMC(3)**2*MX(GT)**2*(MQS-TH)*(MNS-TH)*
30098 & (A(SP,GT)**2+B(SP,GT)**2)/(TH-MS2(GT))**2
30099 & +LAMC(1)*LAMC(3)*TWO*MX(GR)*MX(GT)*
30100 & (SH-MS2(GR))*SCF(GR)*A(SP,GT)*SH*
30101 & (A(SP,GR)*TH+B(SP,GR)*MQ*MN)/(TH-MS2(GT))
30103 c--L/R s channel and interference
30104 IF(ABS(MX(GR-1)).GT.EPS) THEN
30105 ME(1) = ME(1)+LAMC(1)**2*MX(GR-1)**2*SCF(GR-1)*SH*
30106 & ((SH-MQS-MNS)*(A(SP,GR-1)**2+B(SP,GR-1)**2)
30107 & -4*MQ*MN*A(SP,GR-1)*B(SP,GR-1))
30108 & +LAMC(1)**2*TWO*MX(GR)*MX(GR-1)*SCF(GR)*
30110 & ((SH-MS2(GR))*(SH-MS2(GR-1))+
30111 & MSWD(GR)*MSWD(GR-1))*
30112 & ((SH-MQS-MNS)*(A(SP,GR)*A(SP,GR-1)+
30113 & B(SP,GR)*B(SP,GR-1))-TWO*MQ*MN*
30114 & (A(SP,GR)*B(SP,GR-1)+A(SP,GR-1)*B(SP,GR)))
30115 IF(ABS(MX(GU)).GT.EPS) ME(1) = ME(1)+LAMC(1)*LAMC(2)*
30116 & TWO*MX(GR-1)*MX(GU)*(SH-MS2(GR-1))*SCF(GR-1)*
30117 & A(SP,GU)*SH*(A(SP,GR-1)*UH+B(SP,GR-1)*MQ*MN)
30119 IF(ABS(MX(GT)).GT.EPS) ME(1) = ME(1)+LAMC(1)*LAMC(3)*
30120 & TWO*MX(GR-1)*MX(GT)*(SH-MS2(GR-1))*SCF(GR-1)*
30121 & A(SP,GT)*SH*(A(SP,GR-1)*TH+B(SP,GR-1)*MQ*MN)
30123 IF(ABS(MX(GU-1)).GT.EPS) ME(1)=ME(1)+LAMC(1)*LAMC(2)*
30124 & TWO*MX(GR-1)*MX(GU-1)*(SH-MS2(GR-1))*
30125 & SCF(GR-1)*A(SP,GU-1)*SH*(A(SP,GR-1)*UH+
30126 & B(SP,GR-1)*MQ*MN)/(UH-MS2(GU-1))
30127 IF(ABS(MX(GT-1)).GT.EPS) ME(1)=ME(1)+LAMC(1)*LAMC(3)*
30128 & TWO*MX(GR-1)*MX(GT-1)*(SH-MS2(GR-1))*
30129 & SCF(GR-1)*A(SP,GT-1)*SH*(A(SP,GR-1)*TH+
30130 & B(SP,GR-1)*MQ*MN)/(TH-MS2(GT-1))
30132 C--u channel and L/R mixing
30133 IF(ABS(MX(GU-1)).GT.EPS) THEN
30134 ME(1) = ME(1)+LAMC(2)**2*MX(GU-1)**2*(MQS-UH)*(MNS-UH)*
30135 & (A(SP,GU-1)**2+B(SP,GU-1)**2)/(UH-MS2(GU-1))**2
30136 & +LAMC(2)**2*TWO*MX(GU)*MX(GU-1)*(MQS-UH)*(MNS-UH)*
30137 & (A(SP,GU)*A(SP,GU-1)+B(SP,GU)*B(SP,GU-1))
30138 & /(UH-MS2(GU))/(UH-MS2(GU-1))
30139 & +TWO*LAMC(1)*LAMC(2)*MX(GR)*MX(GU-1)*
30140 & (SH-MS2(GR))*SCF(GR)*A(SP,GU-1)*SH*
30141 & (A(SP,GR)*UH+B(SP,GR)*MQ*MN)/(UH-MS2(GU-1))
30142 IF(ABS(MX(GT)).GT.EPS) ME(1)=ME(1)-LAMC(2)*LAMC(3)*TWO*
30143 & MX(GU-1)*MX(GT)*(MQS*MNS-UH*TH)*A(SP,GT)*A(SP,GU-1)
30144 & /(TH-MS2(GT))/(UH-MS2(GU-1))
30145 IF(ABS(MX(GT-1)).GT.EPS) ME(1)=ME(1)-LAMC(2)*LAMC(3)*
30146 & TWO*MX(GU-1)*MX(GT-1)*(MQS*MNS-UH*TH)*A(SP,GT-1)*
30147 & A(SP,GU-1)/(TH-MS2(GT-1))/(UH-MS2(GU-1))
30149 C--t channel and t channel L/R mixing
30150 IF(ABS(MX(GT-1)).GT.EPS) THEN
30151 ME(1) = ME(1)+LAMC(3)**2*MX(GT-1)**2*(MQS-TH)*(MNS-TH)*
30152 & (A(SP,GT-1)**2+B(SP,GT-1)**2)/(TH-MS2(GT-1))**2
30153 & +LAMC(3)**2*TWO*MX(GT)*MX(GT-1)*(MQS-TH)*(MNS-TH)*
30154 & (A(SP,GT)*A(SP,GT-1)+B(SP,GT)*B(SP,GT-1))
30155 & /(TH-MS2(GT))/(TH-MS2(GT-1))
30156 & +LAMC(1)*LAMC(3)*TWO*MX(GR)*MX(GT-1)*
30157 & (SH-MS2(GR))*SCF(GR)*A(SP,GT-1)*SH*
30158 & (A(SP,GR)*TH+B(SP,GR)*MQ*MN)/(TH-MS2(GT-1))
30159 IF(ABS(MX(GU)).GT.EPS) ME(1)=ME(1)-LAMC(2)*LAMC(3)*TWO*
30160 & MX(GU)*MX(GT-1)*(MQS*MNS-UH*TH)*A(SP,GT-1)*A(SP,GU)
30161 & /(TH-MS2(GT-1))/(UH-MS2(GU))
30163 c--phase space factors
30164 MEC(L,GN,I,J) = G**2*FAC*ME(1)*PCM
30167 IF(MOD(K,2).EQ.1) I2 =I2+2
30168 HCS=HCS+MEC(L,GN,I,J)*DISF(I1,1)*DISF(J1,2)
30169 IF(GENEV.AND.HCS.GT.RCS) THEN
30170 CALL HWHRSS(3,I1,J1,K,I2,0,0)
30173 HCS=HCS+MEC(L,GN,I,J)*DISF(J1,1)*DISF(I1,2)
30174 IF(GENEV.AND.HCS.GT.RCS) THEN
30175 CALL HWHRSS(4,J1,I1,K,I2,0,0)
30178 HCS=HCS+MEC(L,GN,I,J)*DISF(I1+6,1)*DISF(J1+6,2)
30179 IF(GENEV.AND.HCS.GT.RCS) THEN
30180 CALL HWHRSS(3,I1,J1,K,I2+2,1,0)
30183 HCS=HCS+MEC(L,GN,I,J)*DISF(J1+6,1)*DISF(I1+6,2)
30184 IF(GENEV.AND.HCS.GT.RCS) THEN
30185 CALL HWHRSS(4,J1,I1,K,I2+2,1,0)
30192 C--Now the radiative decays, if possible
30193 300 IF(.NOT.RAD.OR.(CHAN(5).LT.EPS.AND.CHAN(11).LT.EPS)) GOTO 400
30197 C--stop to light stop and Z
30198 IF(SH.GT.(MZ+MS(11))**2) THEN
30199 PCM = SQRT((SH-(MZ+MS(11))**2)*(SH-(MZ-MS(11))**2))*HALF/SQSH
30200 ECM=SQRT(PCM**2+MZ2)
30201 TH = MZ2-SQSH*(ECM-PCM*COSTH)
30202 UH = MZ2-SQSH*(ECM+PCM*COSTH)
30203 MER(3) = SH**2*PCM**2*(SCF(11)*ZSQU(2,1)**2*QMIXSS(6,2,1)**2
30204 & +SCF(12)*ZSQU(2,2)**2*QMIXSS(6,2,2)**2
30205 & +TWO*SCF(11)*SCF(12)*QMIXSS(6,2,1)*QMIXSS(6,2,2)*
30206 & ZSQU(2,1)*ZSQU(2,2)*((SH-MS2(11))*
30207 & (SH-MS2(12))+MSWD(11)*MSWD(12)))
30208 & +QMIXSS(6,2,1)**2/UH**2*ZQRK(1)**2*(
30209 & TWO*MZ2*(UH*TH-MS2(11)*MZ2)+UH**2*SH)
30210 & +QMIXSS(6,2,1)**2/TH**2*ZQRK(1)**2*(
30211 & TWO*MZ2*(UH*TH-MS2(11)*MZ2)+TH**2*SH)
30212 & +ZQRK(1)*SH*QMIXSS(6,2,1)*
30213 & (QMIXSS(6,2,1)*ZSQU(2,1)*(SH-MS2(11))*SCF(11)
30214 & +QMIXSS(6,2,2)*ZSQU(2,2)*(SH-MS2(12))*SCF(12))
30215 & *((MZ2*(TWO*MS2(11)-TH)+TH*(SH-MS2(11)))/TH
30216 & +(MZ2*(TWO*MS2(11)-UH)+UH*(SH-MS2(11)))/UH)
30217 & -TWO*QMIXSS(6,2,1)**2/UH/TH*ZQRK(1)**2*
30218 & (TWO*MZ2*(MS2(11)-UH)*(MS2(11)-TH)-SH*TH*UH)
30219 MER(3) = MER(3)*FOUR*PCM/MZ2
30221 C--sbottom to light sbottom and Z
30222 IF(SH.GT.(MZ+MS(5))**2) THEN
30223 PCM = SQRT((SH-(MZ+MS(5))**2)*(SH-(MZ-MS(5))**2))*HALF/SQSH
30224 ECM=SQRT(PCM**2+MZ2)
30225 TH = MZ2-SQSH*(ECM-PCM*COSTH)
30226 UH = MZ2-SQSH*(ECM+PCM*COSTH)
30227 MER(6) = SH**2*PCM**2*(SCF(5)*QMIXSS(5,2,1)**2*ZSQU(1,1)**2
30228 & +SCF(6)*QMIXSS(5,2,2)**2*ZSQU(1,2)**2
30229 & +TWO*SCF(5)*SCF(6)*QMIXSS(5,2,1)*QMIXSS(5,2,2)*
30230 & ZSQU(1,1)*ZSQU(1,2)*((SH-MS2(5))*
30231 & (SH-MS2(6))+MSWD(5)*MSWD(6)))
30232 & +QMIXSS(5,2,1)**2/UH**2*ZQRK(1)**2*
30233 & (TWO*MZ2*(UH*TH-MS2(5)*MZ2)+UH**2*SH)
30234 & +QMIXSS(5,2,1)**2/TH**2*ZQRK(2)**2*
30235 & (TWO*MZ2*(UH*TH-MS2(5)*MZ2)+TH**2*SH)
30236 & +QMIXSS(5,2,1)*SH*
30237 & (QMIXSS(5,2,1)*ZSQU(1,1)*(SH-MS2(5))*SCF(5)
30238 & +QMIXSS(5,2,2)*ZSQU(1,2)*(SH-MS2(6))*SCF(6))*
30239 & (ZQRK(1)/UH*(MZ2*(TWO*MS2(5)-UH)+(SH-MS2(5))*UH)
30240 & +ZQRK(2)/TH*(MZ2*(TWO*MS2(5)-TH)+(SH-MS2(5))*TH))
30241 & -TWO*QMIXSS(5,2,1)**2*ZQRK(1)*ZQRK(2)/UH/TH*
30242 & (TWO*MZ2*(MS2(5)-UH)*(MS2(5)-TH)-SH*TH*UH)
30243 MER(6) = MER(6)*FOUR*PCM/MZ2
30245 C--stop to sbottom and W
30247 IF(SH.GT.(MW+MS(4+J))**2) THEN
30248 PCM =SQRT((SH-(MW+MS(4+J))**2)*(SH-(MW-MS(4+J))**2))*HALF/SQSH
30249 C--diagram square pieces
30251 MER(J)=MER(J)+SCF(10+I)*
30252 & (QMIXSS(6,2,I)*QMIXSS(6,1,I)*QMIXSS(5,1,J))**2
30254 C--light/heavy interference
30255 MER(J)=TWO*SH**2*PCM**3/MW2*(MER(J)+TWO*SCF(11)*SCF(12)*
30256 & ((SH-MS2(11))*(SH-MS2(12))
30257 & +MSWD(11)*MSWD(12))*QMIXSS(5,1,J)**2*
30258 & QMIXSS(6,2,1)*QMIXSS(6,2,2)*QMIXSS(6,1,1)*QMIXSS(6,1,2))
30260 C--sbottom to stop and W
30261 IF(SH.GT.(MW+MS(10+J))**2) THEN
30262 PCM=SQRT((SH-(MW+MS(10+J))**2)*(SH-(MW-MS(10+J))**2))*HALF/SQSH
30263 C--diagram square pieces
30265 MER(J+3)=MER(J+3)+SCF(4+I)*
30266 & (QMIXSS(5,2,I)*QMIXSS(5,1,I)*QMIXSS(6,1,J))**2
30268 C--light/heavy interference
30269 MER(J+3)=TWO*SH**2*PCM**3/MW2*(MER(J+3)+TWO*SCF(5)*SCF(6)*
30270 & ((SH-MS2(5))*(SH-MS2(6))+
30271 & MSWD(5)*MSWD(6))*QMIXSS(6,1,J)**2*
30272 & QMIXSS(5,2,1)*QMIXSS(5,2,2)*QMIXSS(5,1,1)*QMIXSS(5,1,2))
30275 C--Now multiply by the parton distributions and phase space factors
30280 IF(ABS(LAMDA3(3,J,K)).GT.EPS.AND.J.LT.K) THEN
30281 FAC2 = LAMDA3(3,J,K)**2*FAC*G**2
30286 HCS=HCS+ME2*DISF(I1,1)*DISF(J1,2)
30287 IF(GENEV.AND.HCS.GT.RCS) THEN
30288 CALL HWHRSS(5,I1,J1,I,I,0,0)
30291 HCS=HCS+ME2*DISF(J1,1)*DISF(I1,2)
30292 IF(GENEV.AND.HCS.GT.RCS) THEN
30293 CALL HWHRSS(6,J1,I1,I,I,0,0)
30296 HCS=HCS+ME2*DISF(I1+6,1)*DISF(J1+6,2)
30297 IF(GENEV.AND.HCS.GT.RCS) THEN
30298 CALL HWHRSS(5,I1,J1,I,I,1,0)
30301 HCS=HCS+ME2*DISF(J1+6,1)*DISF(I1+6,2)
30302 IF(GENEV.AND.HCS.GT.RCS) THEN
30303 CALL HWHRSS(6,J1,I1,I,I,1,0)
30308 C--resonant sbottom's
30309 IF(ABS(LAMDA3(J,K,3)).GT.EPS) THEN
30310 FAC2 = LAMDA3(J,K,3)**2*FAC*G**2
30315 HCS=HCS+ME2*DISF(I1,1)*DISF(J1,2)
30316 IF(GENEV.AND.HCS.GT.RCS) THEN
30317 CALL HWHRSS(5,I1,J1,I,I,0,0)
30320 HCS=HCS+ME2*DISF(J1,1)*DISF(I1,2)
30321 IF(GENEV.AND.HCS.GT.RCS) THEN
30322 CALL HWHRSS(6,J1,I1,I,I,0,0)
30325 HCS=HCS+ME2*DISF(I1+6,1)*DISF(J1+6,2)
30326 IF(GENEV.AND.HCS.GT.RCS) THEN
30327 CALL HWHRSS(5,I1,J1,I,I,1,0)
30330 HCS=HCS+ME2*DISF(J1+6,1)*DISF(I1+6,2)
30331 IF(GENEV.AND.HCS.GT.RCS) THEN
30332 CALL HWHRSS(6,J1,I1,I,I,1,0)
30339 C--Now the Higgs decays if possible
30340 400 IF(.NOT.HIGGS) GOTO 900
30344 405 MEH(I,J) = ZERO
30348 C--Neutral Higgs down type squark
30349 IF(SQSH.LT.MH(J)+MS(2*I-1)) GOTO 410
30350 PCM = SQRT((SH-(MH(J)+MS(2*I-1))**2)*
30351 & (SH-(MH(J)-MS(2*I-1))**2))*HALF/SQSH
30352 ECM=SQRT(PCM**2+MH(J)**2)
30353 TH = MH(J)**2-SQSH*(ECM-PCM*COSTH)
30354 UH = MH(J)**2-SQSH*(ECM+PCM*COSTH)
30355 MEH(1,3*I-3+J) = PCM*SH*(
30356 & QMIXSS(2*I-1,2,1)**2*SCF(2*I-1)*GHSQSS(J,2*I-1,1,1)**2
30357 & +QMIXSS(2*I-1,2,2)**2*SCF(2*I)*GHSQSS(J,2*I-1,2,1)**2
30358 & +TWO*QMIXSS(2*I-1,2,1)*QMIXSS(2*I-1,2,2)*SCF(2*I-1)
30359 & *SCF(2*I)*GHSQSS(J,2*I-1,1,1)*GHSQSS(J,2*I-1,2,1)*
30360 & ((SH-MS2(2*I-1))*(SH-MS2(2*I))+MSWD(2*I-1)*MSWD(2*I)))
30361 MEH(2,3*I-3+J) = PCM*GUU(J)*QMIXSS(2*I,2,1)**2/TH**2*
30362 & (TH*UH-MH(J)**2*MS2(2*I-1))
30363 MEH(3,3*I-3+J) = PCM*GDD(J)*QMIXSS(2*I,2,1)**2/UH**2*
30364 & (TH*UH-MH(J)**2*MS2(2*I-1))
30365 C--Neutral Higgs up type squarks
30366 410 IF(SQSH.LT.MH(J)+MS(2*I+5)) GOTO 420
30367 PCM = SQRT((SH-(MH(J)+MS(2*I+5))**2)*
30368 & (SH-(MH(J)-MS(2*I+5))**2))*HALF/SQSH
30369 ECM=SQRT(PCM**2+MH(J)**2)
30370 TH = MH(J)**2-SQSH*(ECM-PCM*COSTH)
30371 UH = MH(J)**2-SQSH*(ECM+PCM*COSTH)
30372 MEH(1,3*I+6+J) = PCM*SH*(
30373 & QMIXSS(2*I,2,1)**2*SCF(2*I+5)*GHSQSS(J,2*I,1,1)**2
30374 & +QMIXSS(2*I,2,2)**2*SCF(2*I+6)*GHSQSS(J,2*I,2,1)**2
30375 & +TWO*QMIXSS(2*I,2,1)*QMIXSS(2*I,2,2)*SCF(2*I+5)
30376 & *SCF(2*I+6)*GHSQSS(J,2*I,1,1)*GHSQSS(J,2*I,2,1)*
30377 & ((SH-MS2(2*I+5))*(SH-MS2(2*I+6))+
30378 & MSWD(2*I+5)*MSWD(2*I+6)))
30379 MEH(2,3*I+6+J) = PCM*GDD(J)*QMIXSS(2*I-1,2,1)**2/TH**2*
30380 & (TH*UH-MH(J)**2*MS2(2*I+5))
30381 MEH(3,3*I+6+J) = PCM*GDD(J)*QMIXSS(2*I-1,2,1)**2/UH**2*
30382 & (TH*UH-MH(J)**2*MS2(2*I+5))
30384 C--Charged Higgs up type squark
30386 IF(SQSH.LT.MH(4)+MS(2*I+4+J)) GOTO 430
30387 PCM = SQRT((SH-(MH(4)+MS(2*I+4+J))**2)*
30388 & (SH-(MH(4)-MS(2*I+4+J))**2))*HALF/SQSH
30389 ECM=SQRT(PCM**2+MH(4)**2)
30390 TH = MH(4)**2-SQSH*(ECM-PCM*COSTH)
30391 UH = MH(4)**2-SQSH*(ECM+PCM*COSTH)
30392 MEH(1,4*I+14+J) = PCM*SH*(
30393 & QMIXSS(2*I-1,2,1)**2*GHSQSS(4,2*I,J,1)**2*SCF(2*I-1)
30394 & +QMIXSS(2*I-1,2,2)**2*GHSQSS(4,2*I,J,2)**2*SCF(2*I)
30395 & +TWO*QMIXSS(2*I-1,2,1)*QMIXSS(2*I-1,2,2)*SCF(2*I-1)
30396 & *SCF(2*I)*GHSQSS(4,2*I,J,1)*GHSQSS(4,2*I,J,2)*
30397 & ((SH-MS2(2*I-1))*(SH-MS2(2*I))+
30398 & MSWD(2*I-1)*MSWD(2*I)))
30399 MEH(2,4*I+14+J) = PCM*QMIXSS(2*I,2,J)**2*GDD(4)/TH**2*
30400 & (UH*TH-MS2(2*I+4+J)*MH(4)**2)
30401 C--Charged Higgs down type squark
30402 430 IF(SQSH.LT.MH(4)+MS(2*I-2+J)) GOTO 440
30403 PCM = SQRT((SH-(MH(4)+MS(2*I-2+J))**2)*
30404 & (SH-(MH(4)-MS(2*I-2+J))**2))*HALF/SQSH
30405 ECM=SQRT(PCM**2+MH(4)**2)
30406 TH = MH(4)**2-SQSH*(ECM-PCM*COSTH)
30407 UH = MH(4)**2-SQSH*(ECM+PCM*COSTH)
30408 MEH(1,4*I+16+J) = PCM*SH*(
30409 & QMIXSS(2*I,2,1)**2*GHSQSS(4,2*I-1,J,1)**2*SCF(2*I+5)
30410 & +QMIXSS(2*I,2,2)**2*GHSQSS(4,2*I-1,J,2)**2*SCF(2*I+6)
30411 & +TWO*QMIXSS(2*I,2,1)*QMIXSS(2*I,2,2)*SCF(2*I+5)
30412 & *SCF(2*I+6)*GHSQSS(4,2*I-1,J,1)*GHSQSS(4,2*I-1,J,2)*
30413 & ((SH-MS2(2*I+5))*(SH-MS2(2*I+6))+
30414 & MSWD(2*I+5)*MSWD(2*I+6)))
30415 MEH(2,4*I+16+J) = PCM*QMIXSS(2*I-1,2,J)**2*GUU(4)/TH**2*
30416 & (UH*TH-MS2(2*I-2+J)*MH(4)**2)
30417 MEH(3,4*I+16+J) = PCM*QMIXSS(2*I-1,2,J)**2*GUU(4)/UH**2*
30418 & (UH*TH-MS2(2*I-2+J)*MH(4)**2)
30426 IF(ABS(LAMDA3(J,K,I)).GT.EPS) THEN
30427 C--neutral higgs and sdown
30428 FAC2 = FAC*G**2*LAMDA3(J,K,I)**2
30431 ME2 = FAC2*(MEH(1,3*I-3+L)+RMASS(I1)**2*MEH(2,3*I-3+L)
30432 & +RMASS(J1)**2*MEH(3,3*I-3+L))
30433 HCS=HCS+ME2*DISF(I1,1)*DISF(J1,2)
30434 IF(GENEV.AND.HCS.GT.RCS) THEN
30435 CALL HWHRSS(7,I1,J1,L,2*I-1,0,0)
30438 HCS=HCS+ME2*DISF(J1,1)*DISF(I1,2)
30439 IF(GENEV.AND.HCS.GT.RCS) THEN
30440 CALL HWHRSS(8,J1,I1,L,2*I-1,0,0)
30443 IF(I2.NE.200) I2=198
30444 HCS=HCS+ME2*DISF(I1+6,1)*DISF(J1+6,2)
30445 IF(GENEV.AND.HCS.GT.RCS) THEN
30446 CALL HWHRSS(7,I1,J1,L,2*I-1,1,0)
30449 HCS=HCS+ME2*DISF(J1+6,1)*DISF(I1+6,2)
30450 IF(GENEV.AND.HCS.GT.RCS) THEN
30451 CALL HWHRSS(8,J1,I1,L,2*I-1,1,0)
30455 IF(ABS(LAMDA3(I,J,K)).GT.EPS.AND.J.LT.K) THEN
30456 FAC2 = FAC*G**2*LAMDA3(I,J,K)**2
30457 C--neutral higgs and sup
30460 ME2 = FAC2*(MEH(1,3*I+6+L)+RMASS(I1)**2*MEH(2,3*I+6+L)
30461 & +RMASS(J1)**2*MEH(3,3*I+6+L))
30462 HCS=HCS+ME2*DISF(I1,1)*DISF(J1,2)
30463 IF(GENEV.AND.HCS.GT.RCS) THEN
30464 CALL HWHRSS(7,I1,J1,L,2*I+5,0,0)
30467 HCS=HCS+ME2*DISF(J1,1)*DISF(I1,2)
30468 IF(GENEV.AND.HCS.GT.RCS) THEN
30469 CALL HWHRSS(8,J1,I1,L,2*I+5,0,0)
30472 HCS=HCS+ME2*DISF(I1+6,1)*DISF(J1+6,2)
30473 IF(GENEV.AND.HCS.GT.RCS) THEN
30474 CALL HWHRSS(7,I1,J1,L,2*I+5,1,0)
30477 HCS=HCS+ME2*DISF(J1+6,1)*DISF(I1+6,2)
30478 IF(GENEV.AND.HCS.GT.RCS) THEN
30479 CALL HWHRSS(8,J1,I1,L,2*I+5,1,0)
30485 IF(ABS(LAMDA3(J,K,I)).GT.EPS) THEN
30486 C--charged higgs and sup
30490 ME2 = FAC2*(LAMDA3(J,K,I)**2*MEH(1,4*I+L+14)
30491 & +LAMDA3(I,J,K)**2*RMASS(I1-1)**2*MEH(2,4*I+L+14))
30492 HCS= HCS+ME2*DISF(I1,1)*DISF(J1,2)
30493 IF(GENEV.AND.HCS.GT.RCS) THEN
30494 CALL HWHRSS(7,I1,J1,4,2*I+4+L,0,0)
30497 HCS= HCS+ME2*DISF(J1,1)*DISF(I1,2)
30498 IF(GENEV.AND.HCS.GT.RCS) THEN
30499 CALL HWHRSS(8,J1,I1,4,2*I+4+L,0,0)
30502 HCS= HCS+ME2*DISF(I1+6,1)*DISF(J1+6,2)
30503 IF(GENEV.AND.HCS.GT.RCS) THEN
30504 CALL HWHRSS(7,I1,J1,5,2*I+4+L,1,0)
30507 HCS= HCS+ME2*DISF(J1+6,1)*DISF(I1+6,2)
30508 IF(GENEV.AND.HCS.GT.RCS) THEN
30509 CALL HWHRSS(8,J1,I1,5,2*I+4+L,1,0)
30513 C--charged higgs and sdown
30514 IF(ABS(LAMDA3(I,J,K)).GT.EPS.AND.J.LT.K) THEN
30518 ME2 = FAC2*(MEH(1,4*I+L+16)*LAMDA3(I,J,K)**2
30519 & +RMASS(I1+1)**2*LAMDA3(J,I,K)**2*MEH(2,4*I+L+16)
30520 & +RMASS(J1+1)**2*LAMDA3(K,I,J)**2*MEH(3,4*I+L+16))
30521 HCS=HCS+ME2*DISF(I1,1)*DISF(J1,2)
30522 IF(GENEV.AND.HCS.GT.RCS) THEN
30523 CALL HWHRSS(7,I1,J1,5,2*I-2+L,0,0)
30526 HCS=HCS+ME2*DISF(J1,1)*DISF(I1,2)
30527 IF(GENEV.AND.HCS.GT.RCS) THEN
30528 CALL HWHRSS(8,J1,I1,5,2*I-2+L,0,0)
30531 HCS=HCS+ME2*DISF(I1+6,1)*DISF(J1+6,2)
30532 IF(GENEV.AND.HCS.GT.RCS) THEN
30533 CALL HWHRSS(7,I1,J1,4,2*I-2+L,1,0)
30536 HCS=HCS+ME2*DISF(J1+6,1)*DISF(I1+6,2)
30537 IF(GENEV.AND.HCS.GT.RCS) THEN
30538 CALL HWHRSS(8,J1,I1,4,2*I-2+L,1,0)
30546 C--calculate of the matrix elements
30548 CALL HWETWO(.TRUE.,.TRUE.)
30549 IF(IERROR.NE.0) RETURN
30551 C--first stage of the colour connection corrections
30554 JMOHEP(2,THEP+NHEP-5)=NHEP-5+THEP
30555 & +CONECT(HWRINT(1,2),THEP,CON)
30556 JDAHEP(2,THEP+NHEP-5) = JMOHEP(2,THEP+NHEP-5)
30559 IF(IDHEP(NHEP-4).LT.0) THEN
30560 JDAHEP(2,NHEP-4)=NHEP-1
30561 JDAHEP(2,NHEP-3)=NHEP-3
30562 JDAHEP(2,NHEP-1)=NHEP-4
30563 IF(CON.EQ.5) JDAHEP(2,NHEP-4)=NHEP
30564 JDAHEP(2,NHEP)=CONECT(1,6,CON)+NHEP
30566 JMOHEP(2,NHEP-4)=NHEP-1
30567 JMOHEP(2,NHEP-3)=NHEP-3
30568 JMOHEP(2,NHEP-1)=NHEP-4
30569 IF(CON.EQ.5) JMOHEP(2,NHEP-4)=NHEP
30570 JMOHEP(2,NHEP)=CONECT(1,6,CON)+NHEP
30574 JDAHEP(2,NHEP) = JDAHEP(2,NHEP-1)
30575 JDAHEP(2,NHEP-1) = SP
30577 JMOHEP(2,NHEP) = JMOHEP(2,NHEP-1)
30578 JMOHEP(2,NHEP-1) = SP
30581 HRDCOL(1,2) = NHEP-2
30587 *CMZ :- -05/04/02 15:40:41 by Peter Richardson
30588 *-- Author : Peter Richardson
30589 C-----------------------------------------------------------------------
30591 C-----------------------------------------------------------------------
30592 C SUSY E+E- --> SM PARTICLES VIA RPV
30593 C MODIFIED TO INCLUDE BEAM POLARIZATION EFFECTS BY PETER RICHARDSON
30594 C-----------------------------------------------------------------------
30595 INCLUDE 'herwig65.inc'
30596 DOUBLE PRECISION HWRGEN,HWRUNI,HWUPCM,HWUMBW,HWUAEM,HCS,RCS,FACA,
30597 & S,T,PCM,MQ1,MQ2,SP,TP,TPZ,TPN,TPN2,MSL2(3),MZ,
30598 & MZ2,MSU2(3,2),MWD(3),GL,GR,GLP,GRP,EC,EE,THTMIN,
30599 & MIX(3,2),CFAC,LAM(4,3,3,3,3,3),MET,ME(2,3,3)
30600 DOUBLE COMPLEX FSLL,FSLR,FSRL,FSRR,FTLL,FTLR,FTRL,FTRR,Z,Z0,GZ,
30602 INTEGER I,IHEP,RSID(2),IL,GN,J,K,L,GNMN,GNMX,K1,L1,NTRY,GNR,FID(2)
30603 SAVE HCS,MSL2,MWD,LAM,ME,GL,GR,MZ,MZ2,MSU2,MIX,GNMN,GNMX,IL,RSID,
30605 EXTERNAL HWRGEN,HWRUNI,HWUPCM,HWUMBW,HWUAEM
30606 PARAMETER(Z=(0.D0,1.D0),Z0=(0.D0,0.D0))
30607 C--Start of the code
30609 RCS = HCS*HWRGEN(0)
30612 C--identify the beam particles
30613 IF(ABS(IDHEP(1)).EQ.11) THEN
30617 ELSEIF(ABS(IDHEP(1)).EQ.13) THEN
30621 C--unrecognized beam particles issue warning
30623 CALL HWWARN('HWHREE',500)
30626 C--masses of the sleptons
30628 MSL2(I) = RMASS(424+2*I)
30629 MWD(I) = MSL2(I)*HBAR/RLTIM(424+2*I)
30630 MSL2(I) = MSL2(I)**2
30632 C--masses and mixings of the t channel squarks
30634 MSU2(I,1) = RMASS(400+2*I)
30635 MSU2(I,2) = RMASS(412+2*I)
30637 MIX(I,J) = QMIXSS(2*I,1,J)**2
30638 MSU2(I,J) = MSU2(I,J)**2
30644 C--find the couplings
30650 LAM(1,GN,I,J,K,L) = LAMDA1(GN,I,J)*LAMDA1(GN,K,L)
30651 LAM(2,GN,I,J,K,L) = LAMDA1(GN,I,J)*LAMDA2(GN,K,L)
30652 LAM(3,GN,I,J,K,L) = LAM(1,GN,I,J,K,L)
30653 LAM(4,GN,I,J,K,L) = LAMDA2(I,GN,J)*LAMDA2(K,GN,L)
30662 C--select the process from the IPROC code
30663 IF(IPROC.EQ.860) THEN
30668 ELSEIF(IPROC.GE.870.AND.IPROC.LT.890) THEN
30670 IF(MOD(IPROC,10).EQ.0) THEN
30674 FID(1) = MOD(J-1,3)+1
30675 FID(2) = INT((J-1)/3)+1
30677 IF(IPROC.LT.880) THEN
30684 CALL HWWARN('HWHREE',501)
30687 C--calculate the kinematic varibles
30690 THTMIN = ONE-FOUR*PTMIN**2/S
30691 IF(THTMIN.LT.ZERO) CALL HWWARN('HWHREE',502)
30692 THTMIN = SQRT(THTMIN)
30693 COSTH = HWRUNI(0,-THTMIN,THTMIN)
30695 GZ = ONE/(S-MZ**2+Z*MZ*GAMZ)
30697 FACA = GEV2NB*EE**2*PIFAC*S/FOUR
30698 EE = 0.25D0/EE/PIFAC
30700 T = -HALF*S*(ONE-COSTH)
30703 C--Calculate the prefactor due multichannel approach
30705 IF(GN.EQ.RSID(1).OR.GN.EQ.RSID(2)) THEN
30706 SCF(GN)= ONE/(S-MSL2(GN)+Z*MWD(GN))
30712 C--Now the loop to actually calculate the cross sections
30718 IF(FID(1).NE.0.AND.(FID(1).NE.K1.OR.FID(2).NE.L1).AND.
30719 & (FID(1).NE.L1.OR.FID(2).NE.K1)) GOTO 80
30727 ELSEIF(GN.EQ.2) THEN
30737 IF(EMSCA.LT.(MQ1+MQ2)) GOTO 80
30740 C--calculate the matrix element
30741 C--set all coefficents to zero
30750 C--Standard Model terms
30752 C--first if same flavour pair production
30753 FSLL = EC*SP+GL*GRP*GZ
30754 FSLR = EC*SP+GL*GLP*GZ
30755 FSRL = EC*SP+GR*GRP*GZ
30756 FSRR = EC*SP+GR*GLP*GZ
30757 C--t channel terms if e+e- --> e+e-
30758 IF(K1.EQ.IL.AND.GN.EQ.1) THEN
30759 FTLL = TP+GL*GR*TPZ
30760 FTLR = TP+GL**2*TPZ
30761 FTRL = TP+GR**2*TPZ
30762 FTRR = TP+GL*GR*TPZ
30765 C--Now add the RPV terms
30768 TPN = ONE/(T-MSL2(I))
30771 TPN = MIX(I,1)/(T-MSU2(I,1))+ MIX(I,2)/(T-MSU2(I,2))
30774 FSLL = FSLL+HALF*LAM(GNR,I,IL,K1,IL,L1)*EE*TPN
30775 FSRR = FSRR+HALF*LAM(GNR,I,K1,IL,L1,IL)*EE*TPN2
30776 FTLL = FTLL+HALF*LAM(GN,I,IL,IL,K1,L1)*EE*SCF(I)
30777 FTRR = FTRR+HALF*LAM(GN,I,IL,IL,L1,K1)*EE*SCF(I)
30779 C--now calculate the matrix element (including beam polarization)
30780 MET =(ONE+COSTH)**2*DREAL(
30781 & DCONJG(FSLR)*FSLR*(ONE-EPOLN(3))*(ONE+PPOLN(3))
30782 & +DCONJG(FSRL)*FSRL*(ONE+EPOLN(3))*(ONE-PPOLN(3))
30783 & +DCONJG(FTLR)*FTLR*(ONE-EPOLN(3))*(ONE+PPOLN(3))
30784 & +DCONJG(FTRL)*FTRL*(ONE+EPOLN(3))*(ONE-PPOLN(3))
30785 & +TWO*FTLR*DCONJG(FSLR)*(ONE-EPOLN(3))*(ONE+PPOLN(3))
30786 & +TWO*FTRL*DCONJG(FSRL)*(ONE+EPOLN(3))*(ONE-PPOLN(3)))
30787 & +(ONE-COSTH)**2*DREAL(
30788 & DCONJG(FSLL)*FSLL*(ONE-EPOLN(3))*(ONE+PPOLN(3))
30789 & +DCONJG(FSRR)*FSRR*(ONE+EPOLN(3))*(ONE-PPOLN(3)))
30791 & DCONJG(FTLL)*FTLL*(ONE+EPOLN(3))*(ONE+PPOLN(3))
30792 & +DCONJG(FTRR)*FTRR*(ONE-EPOLN(3))*(ONE-PPOLN(3)))
30793 C--final phase space factors
30794 ME(GN,K1,L1) = MET*CFAC*FACA*THTMIN
30795 60 HCS = HCS+ME(GN,K1,L1)
30796 IF(HCS.GT.RCS.AND.GENEV) GOTO 900
30801 C--change sign of COSTH if antiparticle first
30802 IF(IDHEP(1).LT.IDHEP(2)) COSTH = -COSTH
30803 C-Set up the particle types
30806 ISTHEP(NHEP+1) = 110
30809 IDHEP(NHEP+2) = IDPDG(K)
30810 IDHEP(NHEP+3) = IDPDG(L)
30811 C--Select the masses of the particles and the final-state momenta
30813 PHEP(5,NHEP+2) = HWUMBW(K)
30814 PHEP(5,NHEP+3) = HWUMBW(L)
30815 CALL HWVEQU(5,PHEP(1,3),PHEP(1,NHEP+1))
30816 PCM = HWUPCM(PHEP(5,NHEP+1),PHEP(5,NHEP+2),PHEP(5,NHEP+3))
30817 IF(PCM.LT.ZERO.AND.NTRY.LE.NETRY) THEN
30819 ELSEIF(PCM.LT.ZERO) THEN
30820 CALL HWWARN('HWHREE',100)
30823 C--Set up the colours etc
30824 ISTHEP(NHEP+2) = 113
30825 ISTHEP(NHEP+3) = 114
30826 JMOHEP(1,NHEP+1) = 1
30827 IF (JDAHEP(1,1).NE.0) JMOHEP(1,NHEP+1)=JDAHEP(1,1)
30828 JMOHEP(2,NHEP+1) = 2
30829 IF (JDAHEP(1,2).NE.0) JMOHEP(2,NHEP+1)=JDAHEP(1,2)
30830 JMOHEP(1,NHEP+2) = NHEP+1
30831 JMOHEP(2,NHEP+2) = NHEP+3
30832 JMOHEP(1,NHEP+3) = NHEP+1
30833 JMOHEP(2,NHEP+3) = NHEP+2
30834 JDAHEP(1,NHEP+1) = NHEP+2
30835 JDAHEP(2,NHEP+1) = NHEP+3
30836 JDAHEP(1,NHEP+2) = 0
30837 JDAHEP(2,NHEP+2) = NHEP+3
30838 JDAHEP(1,NHEP+3) = 0
30839 JDAHEP(2,NHEP+3) = NHEP+2
30840 C--Set up the momenta
30842 PHEP(4,IHEP) = SQRT(PCM**2+PHEP(5,IHEP)**2)
30843 PHEP(3,IHEP) = PCM*COSTH
30844 PHEP(1,IHEP) = SQRT((PCM+PHEP(3,IHEP))*(PCM-PHEP(3,IHEP)))
30845 PHEP(2,IHEP) = ZERO
30846 CALL HWRAZM(PHEP(1,IHEP),PHEP(1,IHEP),PHEP(2,IHEP))
30847 CALL HWULOB(PHEP(1,NHEP+1),PHEP(1,IHEP),PHEP(1,IHEP))
30848 CALL HWVDIF(4,PHEP(1,NHEP+1),PHEP(1,IHEP),PHEP(1,IHEP+1))
30856 *CMZ :- -01/06/94 17.03.31 by Mike Seymour
30857 *-- Author : Mike Seymour
30858 C-----------------------------------------------------------------------
30859 SUBROUTINE HWHREM(IBEAM,ITARG)
30860 C-----------------------------------------------------------------------
30861 C IDENTIFY THE REMNANTS OF THE HARD SCATTERING
30862 C AND BREAK THEIR COLOUR CONNECTION IF NECESSARY
30863 C-----------------------------------------------------------------------
30864 INCLUDE 'herwig65.inc'
30865 DOUBLE PRECISION PCL(5),
30866 $ P1P2,P1SQ,P2SQ,S,M1SQ,M2SQ,TMP1,TMP2,A,B,C,D,PTOT(4),HWULDO
30867 INTEGER IBEAM,ITARG,IHEP,NTEMP,I,ICOL,IANT
30868 LOGICAL LTEMP,T,COL,ANT
30869 PARAMETER (T=.TRUE.)
30870 COL(I)=I.EQ.13 .OR. I.GE.1.AND.I.LE.6 .OR. I.GE.115.AND.I.LE.120
30871 ANT(I)=I.EQ.13 .OR. I.GE.7.AND.I.LE.12.OR. I.GE.109.AND.I.LE.114
30872 C---LOOK FOR UNTREATED BEAM AND TARGET REMNANTS
30876 IF (ISTHEP(IHEP).EQ.148) THEN
30877 IF (ITARG.NE.0) THEN
30878 CALL HWWARN('HWHREM',100)
30882 ELSEIF (ISTHEP(IHEP).EQ.147) THEN
30883 IF (IBEAM.NE.0) THEN
30884 CALL HWWARN('HWHREM',101)
30890 IF (ITARG.EQ.0) THEN
30891 CALL HWWARN('HWHREM',102)
30894 IF (IBEAM.EQ.0) THEN
30895 CALL HWWARN('HWHREM',103)
30898 C---MHS FIX TO PREVENT MOMENTUM VIOLATION DUE TO OFF-SHELL BEAM REMNANTS
30899 C---FIND REMNANT MOMENTA AND MASSES
30900 P1P2=HWULDO(PHEP(1,IBEAM),PHEP(1,ITARG))
30901 P1SQ=HWULDO(PHEP(1,IBEAM),PHEP(1,IBEAM))
30902 P2SQ=HWULDO(PHEP(1,ITARG),PHEP(1,ITARG))
30904 TMP1=P1P2**2-P1SQ*P2SQ
30905 IF (TMP1.LE.0) THEN
30906 CALL HWWARN('HWHREM',104)
30910 M1SQ=RMASS(IDHW(IBEAM))**2
30911 M2SQ=RMASS(IDHW(ITARG))**2
30912 TMP2=(S-M1SQ-M2SQ)**2-4*M1SQ*M2SQ
30913 IF (TMP2.LE.0) THEN
30914 CALL HWWARN('HWHREM',105)
30918 C---EXCHANGE A LITTLE MOMENTUM TO PUT THEM BOTH ON MASS-SHELL
30919 A=(1-(P1P2+P2SQ)/TMP1)/2
30920 B=(1-(P1P2+P1SQ)/TMP1)/2
30921 C=(S-M1SQ+M2SQ-TMP2)/(2*S)
30922 D=(S+M1SQ-M2SQ-TMP2)/(2*S)
30923 CALL HWVSUM(4,PHEP(1,IBEAM),PHEP(1,ITARG),PTOT)
30924 CALL HWVSCA(4,(1-A)*(1-C)+A*D,PHEP(1,IBEAM),PHEP(1,IBEAM))
30925 CALL HWVSCA(4,B*(1-C)+(1-B)*D,PHEP(1,ITARG),PHEP(1,ITARG))
30926 CALL HWVSUM(4,PHEP(1,IBEAM),PHEP(1,ITARG),PHEP(1,IBEAM))
30927 CALL HWVDIF(4,PTOT,PHEP(1,IBEAM),PHEP(1,ITARG))
30928 CALL HWUMAS(PHEP(1,IBEAM))
30929 CALL HWUMAS(PHEP(1,ITARG))
30931 C---IF THEY ARE COLOUR CONNECTED, DISCONNECT THEM BY EMITTING A SOFT
30932 C GLUON AND SPLITTING THAT GLUON TO LIGHT QUARKS
30933 C (WHICH NORMALLY GETS DONE AS THE FIRST STAGE OF CLUSTER FORMATION)
30934 C---LOOP OVER COLOUR/ANTICOLOUR LINE
30943 IF (COL(IDHW(ICOL)).AND.ANT(IDHW(IANT)).AND.
30944 $ JMOHEP(2,ICOL).EQ.IANT.AND.JDAHEP(2,IANT).EQ.ICOL) THEN
30945 CALL HWVSUM(4,PHEP(1,ICOL),PHEP(1,IANT),PCL)
30948 CALL HWCCUT(ICOL,IANT,PCL,T,LTEMP)
30949 IF (IERROR.NE.0) RETURN
30950 C---IF NOTHING WAS CREATED THEY MUST BE BELOW THRESHOLD, SO GIVE UP
30951 IF (NHEP.NE.NTEMP+2) RETURN
30952 C---RELABEL THEM AS PERTUBATIVE JUST TO NEATEN UP THE EVENT RECORD
30960 *CMZ :- -18/10/00 13:46:47 by Peter Richardson
30961 *-- Author : Peter Richardson
30962 C-----------------------------------------------------------------------
30964 C-----------------------------------------------------------------------
30965 C SUSY E+E- RPV PRODUCTION
30966 C-----------------------------------------------------------------------
30967 INCLUDE 'herwig65.inc'
30968 IF(IPROC.GE.800.AND.IPROC.LE.850) THEN
30970 ELSEIF(IPROC.GE.860.AND.IPROC.LT.890) THEN
30972 C---UNRECOGNIZED PROCESS
30974 CALL HWWARN('HWHREP',500)
30978 *CMZ :- -07/04/02 10:38:51 by Peter Richardson
30979 *-- Author : Peter Richardson
30980 C-----------------------------------------------------------------------
30982 C-----------------------------------------------------------------------
30983 C SUSY E+E- --> RPV SINGLE SPARTICLE PRODUCTION
30984 C POLARZATION EFFECTS ADDED 5/4/02 BY PETER RICHARDSON
30985 C-----------------------------------------------------------------------
30986 INCLUDE 'herwig65.inc'
30987 DOUBLE PRECISION HWRGEN,HWUAEM,HWRUNI,HWUPCM,HWUMBW,HCS,RCS,FACA,
30988 & FACB,FACC,FACD,FACE,M1(4,4),M2(2,4),M3(8,2),
30989 & MW,MZ,MSCL(2,2),MSCL2(2,2),MZ2,MSL2,MSR2,MSNU2,
30990 & MW2,MCH(2),MCH2(2),MNU(4),MNU2(4),MLT(3),MLT2(3),
30991 & MNUT(2),MNUT2(2),RMNUT(2),S,U,T,QPE,SQPE,SM,DM,
30992 & PF,PCM,SCF(2),UP,TP,MH(4),MH2(4),THCOS(2),THTMIN,
30993 & A(6,4),B(6,4),SW,CW,MC,SIN2B,ZNU,RHO,HSL(2,2),
30994 & HL(4),M4(10,2),HNU(3)
30995 INTEGER I,SSNU,NTID(2),CHID(2),IG1,IG2,IHEP,SSCH,ISL,ISR,NTRY,
30996 & ISN,IDL,J,L,RSID(2),K,L2,IL,IDZ,RADID(2,8),GMIN,GMAX
30997 LOGICAL NEUT,CHAR,RAD,HIGGS,THSGN
30998 SAVE HCS,M1,M2,M3,M4,SW,CW,MW,MZ,MW2,MZ2,MLT,MLT2,MNUT,MNUT2,
30999 & RMNUT,MNU,MNU2,MCH,MCH2,MSNU2,A,B,MSL2,MSR2,MSCL,
31000 & MSCL2,ZNU,THCOS,HSL,HL,HNU,MH,MH2,GMIN,GMAX,
31001 & RADID,NTID,ISL,ISR,ISN,IDL,CHID,RSID,IL,NEUT,CHAR,RAD,HIGGS
31002 EXTERNAL HWRGEN,HWUAEM,HWRUNI,HWUPCM,HWUMBW
31003 PARAMETER (SSNU=449,SSCH = 455)
31004 C--Start of the code
31006 RCS = HCS*HWRGEN(0)
31008 C--Initialise the hard processes
31010 C--Decide which processes to generate
31015 C--all single sparticle production
31016 IF(IPROC.EQ.800) THEN
31027 C--single neutralino production
31028 ELSEIF(IPROC.GE.810.AND.IPROC.LE.814) THEN
31030 IF(IPROC.EQ.810) THEN
31034 NTID(1) = IPROC-810
31037 C--single chargino production
31038 ELSEIF(IPROC.GE.820.AND.IPROC.LE.822) THEN
31040 IF(IPROC.EQ.820) THEN
31044 CHID(1) = IPROC-820
31047 C--single slepton production with gauge boson
31048 ELSEIF(IPROC.EQ.830) THEN
31052 C--single slepton production with Higgs boson
31053 ELSEIF(IPROC.EQ.840) THEN
31055 C--photon radiation processes
31056 ELSEIF(IPROC.EQ.850) THEN
31060 C--unrecognized process issue warning
31062 CALL HWWARN('HWHRES',500)
31064 C--check the particles in the beam
31066 IF(ABS(IDHEP(1)).EQ.11) THEN
31073 ELSEIF(ABS(IDHEP(1)).EQ.13) THEN
31080 C--unrecognised beam particles issue warning
31082 CALL HWWARN('HWHRES',501)
31085 C--masses and electroweak parameters
31092 SIN2B = TWO*SINB*COSB
31093 C--neutralino and chargino masses
31095 MNU(I) = RMASS(SSNU+I)
31096 MNU2(I) = MNU(I)**2
31099 MCH(I) = RMASS(I+SSCH)
31100 MCH2(I) = MCH(I)**2
31102 C--incoming lepton mass
31103 MLT(1) = RMASS(IDL+110)
31104 C--lepton masses in chargino production
31106 MLT(I+1) = RMASS(119+2*RSID(I))
31109 MLT2(I) = MLT(I)**2
31111 C--t-channel slepton masses
31112 MSL2 = RMASS(ISL)**2
31113 MSR2 = RMASS(ISR)**2
31114 MSNU2 = RMASS(ISN)**2
31115 C--resonant sneutrino masses and widths
31117 MNUT(I) = RMASS(424+2*RSID(I))
31118 MNUT2(I) = MNUT(I)**2
31119 RMNUT(I) = MNUT2(I)*HBAR**2/RLTIM(424+2*RSID(I))**2
31121 C--now calculate the coefficients for the processes
31122 C--first neutralino production
31124 MC = MLT(1)*ZMIXSS(L,3)/(TWO*MW*COSB*SW)
31125 C--first for the left slepton
31126 A(L,1) = SLFCH(IDL,L)
31127 B(L,1) = ZSGNSS(L)*MC
31128 C--then the right slepton
31129 A(L,2) = ZSGNSS(L)*SRFCH(IDL,L)
31131 C--the resonant sneutrino
31133 A(L,2+I) = SLFCH(10+2*RSID(I),L)
31137 C--now chargino production
31140 MC = WMXUSS(L,2)/(SQRT(TWO)*MW*COSB*SW)
31141 C--first for the t channel sneutrino
31142 A(J,1) = WSGNSS(L)*WMXVSS(L,1)/SW
31143 B(J,1) = -MLT(1)*MC
31144 C--now for the resonant sneutrinos
31146 A(J,I+1) = WSGNSS(L)*WMXVSS(L,1)/SW
31147 B(J,I+1) = -MLT(I+1)*MC
31150 C--coupling of the Z to the sneutrino
31152 C--now the masses and IDs of the slepton in the radiative processes
31153 C--IDs and masses of the charged sleptons
31155 RADID(2,2*I-1) = 423+RSID(I)*2
31156 RADID(2,2*I ) = 435+RSID(I)*2
31157 MSCL(I,1) = RMASS(RADID(2,2*I-1))
31158 MSCL(I,2) = RMASS(RADID(2,2*I))
31160 MSCL2(I,J) = MSCL(I,J)**2
31163 C--ID of the W for charged slepton processes
31167 C--ID's for the Z and gamma processes
31171 RADID(2,I+4) = 424+RSID(I)*2
31172 RADID(2,I+6) = RADID(2,I+4)
31174 C--couplings of the sleptons to the Higgs
31179 HSL(I,J) = LMIXSS(K,1,J)*(RMASS(L)**2*TANB-MW2*SIN2B)
31180 & +LMIXSS(K,2,J)*RMASS(L)*MUSS
31181 IF(RSID(I).EQ.3) HSL(I,J) = HSL(I,J)
31182 & +LMIXSS(K,2,J)*RMASS(L)*ALSS*TANB
31183 HSL(I,J) = HSL(I,J)/SQRT(HALF)/MW
31186 C--coupling of the sneutrino to the Higgs
31187 HNU(1) = HALF*MZ*SINBPA/CW
31188 HNU(2) = -HALF*MZ*COSBPA/CW
31190 C--couplings of the leptons to the Higgs
31191 RHO = HALF*MLT(1)/MW
31192 HL(1) = -RHO*SINA/COSB
31193 HL(2) = RHO*COSA/COSB
31195 HL(4) = RHO*TANB/SQRT(HALF)
31198 MH(I) = RMASS(202+I)
31202 C--Now calculate the weights
31203 COSTH = HWRUNI(1,-ONE,ONE)
31206 FACA = HWUAEM(S)*GEV2NB/S/8.0D0
31207 FACD = HALF*FACA/SWEIN
31208 FACB = HALF*FACD/MW2
31209 FACC = HALF*FACA/MZ2
31210 FACE = ALPHEM*GEV2NB/S/8.0D0
31212 SCF(I) = ONE/((S-MNUT2(I))**2+RMNUT(I))
31214 C--single neutralino production
31223 DO L=NTID(1),NTID(2)
31227 IF(SQPE.GE.ZERO) THEN
31229 T = HALF*(SQPE*COSTH-S+MNU2(L))
31233 C--neutralino antineutrino production (including beam polarization)
31234 M1(L,J) = (ONE-EPOLN(3))*(ONE-PPOLN(3))*(
31235 & A(L,K)**2*S*(S-MNU2(L))*SCF(J)
31236 & +TWO*S*U*(S-MNUT2(J))*UP*SCF(J)*A(L,K)*A(L,1)
31237 & +TWO*S*T*(S-MNUT2(J))*TP*SCF(J)*A(L,K)*A(L,2)
31238 & +TWO*U*T*UP*TP*A(L,1)*A(L,2))
31239 & +U*(U-MNU2(L))*UP**2*(ONE-PPOLN(3))*
31240 & (A(L,1)**2*(ONE-EPOLN(3))+B(L,1)**2*(ONE+EPOLN(3)))
31241 & +T*(T-MNU2(L))*TP**2*(ONE-EPOLN(3))*
31242 & (A(L,2)**2*(ONE-PPOLN(3))+B(L,2)**2*(ONE+PPOLN(3)))
31243 C--neutralino neutrino production (including beam polarization)
31244 M1(L,K) = (ONE+EPOLN(3))*(ONE+PPOLN(3))*(
31245 & A(L,K)**2*S*(S-MNU2(L))*SCF(J)
31246 & +TWO*S*U*(S-MNUT2(J))*UP*SCF(J)*A(L,K)*A(L,1)
31247 & +TWO*S*T*(S-MNUT2(J))*TP*SCF(J)*A(L,K)*A(L,2)
31248 & +TWO*U*T*UP*TP*A(L,1)*A(L,2))
31249 & +U*(U-MNU2(L))*UP**2*(ONE+PPOLN(3))*
31250 & (A(L,1)**2*(ONE+EPOLN(3))+B(L,1)**2*(ONE-EPOLN(3)))
31251 & +T*(T-MNU2(L))*TP**2*(ONE+EPOLN(3))*
31252 & (A(L,2)**2*(ONE+PPOLN(3))+B(L,2)**2*(ONE-PPOLN(3)))
31253 C--final coefficients
31254 M1(L,J) = LAMDA1(RSID(J),IL,IL)**2*FACA*PF*M1(L,J)
31255 M1(L,K) = LAMDA1(RSID(J),IL,IL)**2*FACA*PF*M1(L,K)
31262 C--single chargino production
31263 100 IF(.NOT.CHAR) THEN
31271 DO L = CHID(1),CHID(2)
31275 SM = MCH(L) + MLT(K)
31277 IF (QPE.GE.ZERO) THEN
31278 DM = MCH(L) - MLT(K)
31279 SQPE = SQRT(QPE*(S-DM**2))
31281 T = HALF*(SQPE*COSTH-S+MCH2(L)+MLT2(K))
31282 U = -T-S+MCH2(L)+MLT2(K)
31284 C--chargino antilepton (including beam polarization)
31285 M2(L,J) = S*SCF(J)*(-FOUR*MLT(K)*MCH(L)*A(L2,K)*B(L2,K)
31286 & +(S-MLT2(K)-MCH2(L))*(A(L2,K)**2+B(L2,K)**2))*
31287 & (ONE-EPOLN(3))*(ONE-PPOLN(3))
31288 & +(MLT2(K)-U)*(MCH2(L)-U)*UP**2*(ONE-PPOLN(3))*
31289 & (A(L2,1)**2*(ONE-EPOLN(3))+B(L2,1)**2*(ONE+EPOLN(3)))
31290 & -TWO*S*(S-MNUT2(J))*UP*SCF(J)*A(L2,1)*(ONE-EPOLN(3))*
31291 & (ONE-PPOLN(3))*(U*A(L2,K)+MLT(K)*MCH(L)*B(L2,K))
31292 C--chargino lepton (including beam polarization)
31293 M2(L,J+2) = S*SCF(J)*(-FOUR*MLT(K)*MCH(L)*A(L2,K)*B(L2,K)
31294 & +(S-MLT2(K)-MCH2(L))*(A(L2,K)**2+B(L2,K)**2))*
31295 & (ONE+EPOLN(3))*(ONE+PPOLN(3))
31296 & +(MLT2(K)-U)*(MCH2(L)-U)*UP**2*(ONE+PPOLN(3))*
31297 & (A(L2,1)**2*(ONE+EPOLN(3))+B(L2,1)**2*(ONE-EPOLN(3)))
31298 & -TWO*S*(S-MNUT2(J))*UP*SCF(J)*A(L2,1)*(ONE+EPOLN(3))*
31299 & (ONE+PPOLN(3))*(U*A(L2,K)+MLT(K)*MCH(L)*B(L2,K))
31300 C--final coefficients
31301 M2(L,J) =HALF*LAMDA1(RSID(J),IL,IL)**2*FACA*PF*M2(L,J)
31302 M2(L,J+2)=HALF*LAMDA1(RSID(J),IL,IL)**2*FACA*PF*M2(L,J+2)
31309 C--Radiative processes
31310 200 IF(.NOT.RAD) THEN
31319 C--W charged slepton production
31322 QPE = S-(MW+MSCL(I,J))**2
31323 IF(QPE.GE.ZERO) THEN
31325 SQPE = SQRT(QPE*(S-DM**2))
31327 T = HALF*(SQPE*COSTH-S+MW2+MSCL2(I,J))
31328 U = -T-S+MW2+MSCL2(I,J)
31331 M3(2*I+J-2,1) = SCF(I)*S*SQPE**2
31332 & +UP**2*(TWO*MW2*(U*T-MW2*MSCL2(I,J))+U**2*S)
31333 & -TWO*UP*SCF(I)*(S-MNUT2(I))*S*(MW2*(TWO*MSCL2(I,J)-U)+
31334 & U*(S-MSCL2(I,J)))
31335 M3(2*I+J-2,1) = LAMDA1(RSID(I),IL,IL)**2*FACB*PF
31336 & *LMIXSS(2*RSID(I)-1,1,J)**2*M3(2*I+J-2,1)
31337 C--W- antislepton (including beam polarization)
31338 M3(2*I+J-2,2) = (ONE-EPOLN(3))*(ONE-PPOLN(3))*
31340 C--W+ antislepton (including beam polarization)
31341 M3(2*I+J-2,1) = (ONE+EPOLN(3))*(ONE+PPOLN(3))*
31344 M3(2*I+J-2,1) = ZERO
31345 M3(2*I+J-2,2) = ZERO
31349 C--Z sneutrino production
31351 QPE = S-(MZ+MNUT(I))**2
31352 IF(QPE.GE.ZERO) THEN
31354 SQPE = SQRT(QPE*(S-DM**2))
31356 T = HALF*(SQPE*COSTH-S+MZ2+MNUT2(I))
31357 U = -T-S+MZ2+MNUT2(I)
31361 C--Z sneutrino production
31362 M3(I+4,1) = SCF(I)*S*SQPE**2*ZNU**2
31363 & +TP**2*RFCH(IDZ)**2*(TWO*MZ2*(U*T-MNUT2(I)*MZ2)+S*T**2)
31364 & +UP**2*LFCH(IDZ)**2*(TWO*MZ2*(U*T-MNUT2(I)*MZ2)+S*U**2)
31365 & -TWO*ZNU*RFCH(IDZ)*TP*S*SCF(I)*(S-MNUT2(I))*
31366 & (MZ2*(TWO*MNUT2(I)-T)+T*(S-MNUT2(I)))
31367 & +TWO*ZNU*LFCH(IDZ)*UP*S*SCF(I)*(S-MNUT2(I))*
31368 & (MZ2*(TWO*MNUT2(I)-U)+U*(S-MNUT2(I)))
31369 & +TWO*LFCH(IDZ)*RFCH(IDZ)*UP*TP*
31370 & (TWO*MZ2*(MNUT2(I)-T)*(MNUT2(I)-U)-S*U*T)
31371 M3(I+4,1) = LAMDA1(RSID(I),IL,IL)**2*FACC*PF*M3(I+4,1)
31372 C--Z antisneutrino (including beam polarization)
31373 M3(I+4,2) = (ONE-EPOLN(3))*(ONE-PPOLN(3))*M3(I+4,1)
31374 C--Z sneutrino (including beam polarization)
31375 M3(I+4,1) = (ONE+EPOLN(3))*(ONE+PPOLN(3))*M3(I+4,1)
31382 C--gamma sneutrino production (includes Jacobian 1-costh**2)
31383 C--now includes polarization effects
31386 IF(SQPE.GE.ZERO) THEN
31388 PCM = HALF*EMSCA*PF
31390 IF(THTMIN.GT.ONE) CALL HWWARN('HWHRES',502)
31391 THTMIN = ONE-THTMIN**2
31392 THTMIN = HALF*LOG((1+THTMIN)/(1-THTMIN))
31393 RHO = HWRUNI(2,-THTMIN,THTMIN)
31394 THCOS(I) = -TANH(RHO)
31395 T = HALF*(SQPE*THCOS(I)-S+MNUT2(I))
31399 M3(I+6,1) = U*TP+T*UP+TWO*UP*TP*(MNUT2(I)-U)*(MNUT2(I)-T)
31400 M3(I+6,1) = LAMDA1(RSID(I),IL,IL)**2*FACE*PF*M3(I+6,1)*
31401 & (ONE-THCOS(I)**2)*THTMIN
31402 M3(I+6,2) = M3(I+6,1)*(ONE-EPOLN(3))*(ONE-PPOLN(3))
31403 M3(I+6,1) = M3(I+6,1)*(ONE+EPOLN(3))*(ONE+PPOLN(3))
31411 300 IF(.NOT.HIGGS) THEN
31419 C--Charged Higgs charged slepton production
31422 QPE = S-(MH(4)+MSCL(I,J))**2
31423 IF(QPE.GE.ZERO) THEN
31424 DM = MH(4)-MSCL(I,J)
31425 SQPE = SQRT(QPE*(S-DM**2))
31427 T = HALF*(SQPE*COSTH-S+MH2(4)+MSCL2(I,J))
31428 U = -T-S+MH2(4)+MSCL2(I,J)
31429 C--charged Higgs antislepton
31430 M4(2*I+J-2,1) = HSL(I,J)**2*S*SCF(I)*
31431 & (ONE-EPOLN(3))*(ONE-PPOLN(3))
31432 & +FOUR*LMIXSS(2*RSID(I)-1,1,J)**2*HL(4)**2
31433 & *(U*T-MSCL2(I,J)*MH2(4))/U**2*
31434 & (ONE+EPOLN(3))*(ONE-PPOLN(3))
31435 C--charged Higgs slepton
31436 M4(2*I+J-2,2) = HSL(I,J)**2*S*SCF(I)*
31437 & (ONE+EPOLN(3))*(ONE+PPOLN(3))
31438 & +FOUR*LMIXSS(2*RSID(I)-1,1,J)**2*HL(4)**2
31439 & *(U*T-MSCL2(I,J)*MH2(4))/U**2*
31440 & (ONE-EPOLN(3))*(ONE+PPOLN(3))
31441 C--final coefficients
31442 M4(2*I+J-2,1) = FACD*LAMDA1(RSID(I),IL,IL)**2*
31444 M4(2*I+J-2,2) = FACD*LAMDA1(RSID(I),IL,IL)**2*
31447 M4(2*I+J-2,1) = ZERO
31448 M4(2*I+J-2,2) = ZERO
31452 C--neutral higgs sneutrino production
31455 QPE = S-(MH(L)+MNUT(I))**2
31456 IF(QPE.GE.ZERO) THEN
31458 SQPE = SQRT(QPE*(S-DM**2))
31460 T = HALF*(SQPE*COSTH-S+MH2(L)+MNUT2(I))
31461 U = -T-S+MH2(L)+MNUT2(I)
31463 C--h0, H0 antisneutrino (including beam polarization)
31464 M4(2*L+I+2,1) = HNU(L)**2*S*SCF(I)*
31465 & (ONE-EPOLN(3))*(ONE-PPOLN(3))
31466 & +HL(L)**2*( ONE/T**2*(ONE+EPOLN(3))*(ONE-PPOLN(3))
31467 & +ONE/U**2*(ONE-EPOLN(3))*(ONE+PPOLN(3)))
31468 & *(U*T-MH2(L)*MNUT2(I))
31469 C--h0, H0 sneutrino (including beam polarization)
31470 M4(2*L+I+2,2) = HNU(L)**2*S*SCF(I)*
31471 & (ONE+EPOLN(3))*(ONE+PPOLN(3))
31472 & +HL(L)**2*( ONE/T**2*(ONE-EPOLN(3))*(ONE+PPOLN(3))
31473 & +ONE/U**2*(ONE+EPOLN(3))*(ONE-PPOLN(3)))
31474 & *(U*T-MH2(L)*MNUT2(I))
31476 C--A0 antisneutrino (including beam polarization)
31477 M4(2*L+I+2,1) = (ONE-EPOLN(3))*(ONE-PPOLN(3))*(
31478 & HNU(L)**2*S*SCF(I)
31479 & +HL(L)**2*(ONE/T**2+ONE/U**2)*(U*T-MH2(L)*MNUT2(I)))
31480 C--A0 sneutrino (including beam polarization)
31481 M4(2*L+I+2,2) = (ONE+EPOLN(3))*(ONE+PPOLN(3))*(
31482 & HNU(L)**2*S*SCF(I)
31483 & +HL(L)**2*(ONE/T**2+ONE/U**2)*(U*T-MH2(L)*MNUT2(I)))
31485 C--final coefficients
31486 M4(2*L+I+2,1) = FACD*LAMDA1(RSID(I),IL,IL)**2*
31488 M4(2*L+I+2,2) = FACD*LAMDA1(RSID(I),IL,IL)**2*
31491 M4(2*L+I+2,1) = ZERO
31492 M4(2*L+I+2,2) = ZERO
31497 C--Add up the weights now
31499 C--single neutralino production
31500 IF(.NOT.NEUT) GOTO 550
31501 DO L=NTID(1),NTID(2)
31504 IG2 = 126+2*RSID(MOD(J-1,2)+1)-6*INT((J-1)/2)
31506 THSGN = (IDHEP(1).LT.IDHEP(2).AND.J.GT.2).OR.
31507 & (IDHEP(1).GT.IDHEP(2).AND.J.LE.2)
31508 IF(GENEV.AND.HCS.GT.RCS) GOTO 900
31511 C--single chargino production
31512 550 IF(.NOT.CHAR) GOTO 600
31513 DO L=CHID(1),CHID(2)
31515 IG1 = SSCH+L-2*INT((J-1)/2)
31516 IG2 = 125+2*RSID(MOD((J-1),2)+1)-6*INT((J-1)/2)
31517 HCS = HCS + M2(L,J)
31518 THSGN = (IDHEP(1).LT.IDHEP(2).AND.J.GT.2).OR.
31519 & (IDHEP(1).GT.IDHEP(2).AND.J.LE.2)
31520 IF (GENEV.AND.HCS.GT.RCS) GOTO 900
31523 C--gauge boson slepton production
31524 600 IF(.NOT.RAD) GOTO 650
31528 IF(I.GE.7) COSTH = THCOS(I-6)
31531 THSGN = (IDHEP(1).LT.IDHEP(2).AND.J.EQ.1).OR.
31532 & (IDHEP(1).GT.IDHEP(2).AND.J.EQ.2)
31533 IF(GENEV.AND.HCS.GT.RCS) GOTO 900
31534 IF(I.LE.4) IG1 = IG1+1
31538 C--higgs slepton production
31539 650 IF(.NOT.HIGGS) GOTO 900
31540 C--charged Higgs slepton
31546 THSGN = (IDHEP(1).LT.IDHEP(2).AND.J.EQ.1).OR.
31547 & (IDHEP(1).GT.IDHEP(2).AND.J.EQ.2)
31548 IF(GENEV.AND.HCS.GT.RCS) GOTO 900
31553 C--Neutral Higgs sneutrino
31557 IG2 = 430+2*RSID(I)
31559 HCS = HCS+M4(2+2*L+I,J)
31560 THSGN = (IDHEP(1).LT.IDHEP(2).AND.J.EQ.1).OR.
31561 & (IDHEP(1).GT.IDHEP(2).AND.J.EQ.2)
31562 IF(GENEV.AND.HCS.GT.RCS) GOTO 900
31568 C--change sign of COSTH if antiparticle first
31569 IF(THSGN) COSTH = -COSTH
31570 C-Set up the particle types
31573 ISTHEP(NHEP+1) = 110
31576 IDHEP(NHEP+2) = IDPDG(IG1)
31577 IDHEP(NHEP+3) = IDPDG(IG2)
31578 C--generate the particle masses and final-state momenta
31581 PHEP(5,NHEP+2) = HWUMBW(IG1)
31582 PHEP(5,NHEP+3) = HWUMBW(IG2)
31583 C--Set up the Centre-of-mass energy
31584 CALL HWVEQU(5,PHEP(1,3),PHEP(1,NHEP+1))
31585 PCM = HWUPCM(PHEP(5,NHEP+1),PHEP(5,NHEP+2),PHEP(5,NHEP+3))
31586 IF(PCM.LT.ZERO.AND.NTRY.LE.NETRY) THEN
31588 ELSEIF(PCM.LT.ZERO) THEN
31589 CALL HWWARN('HWHRES',100)
31592 C--Set up the colours etc
31593 ISTHEP(NHEP+2) = 113
31594 ISTHEP(NHEP+3) = 114
31595 JMOHEP(1,NHEP+1) = 1
31596 IF (JDAHEP(1,1).NE.0) JMOHEP(1,NHEP+1)=JDAHEP(1,1)
31597 JMOHEP(2,NHEP+1) = 2
31598 IF (JDAHEP(1,2).NE.0) JMOHEP(2,NHEP+1)=JDAHEP(1,2)
31599 JMOHEP(1,NHEP+2) = NHEP+1
31600 JMOHEP(2,NHEP+2) = NHEP+2
31601 JMOHEP(1,NHEP+3) = NHEP+1
31602 JMOHEP(2,NHEP+3) = NHEP+3
31603 JDAHEP(1,NHEP+1) = NHEP+2
31604 JDAHEP(2,NHEP+1) = NHEP+3
31605 JDAHEP(1,NHEP+2) = 0
31606 JDAHEP(2,NHEP+2) = NHEP+2
31607 JDAHEP(1,NHEP+3) = 0
31608 JDAHEP(2,NHEP+3) = NHEP+3
31609 C--set up the rest of the momenta
31611 PHEP(4,IHEP) = SQRT(PCM**2+PHEP(5,IHEP)**2)
31612 PHEP(3,IHEP) = PCM*COSTH
31613 PHEP(1,IHEP) = SQRT((PCM+PHEP(3,IHEP))*(PCM-PHEP(3,IHEP)))
31614 PHEP(2,IHEP) = ZERO
31615 CALL HWRAZM(PHEP(1,IHEP),PHEP(1,IHEP),PHEP(2,IHEP))
31616 CALL HWULOB(PHEP(1,NHEP+1),PHEP(1,IHEP),PHEP(1,IHEP))
31617 CALL HWVDIF(4,PHEP(1,NHEP+1),PHEP(1,IHEP),PHEP(1,IHEP+1))
31625 *CMZ :- -08/04/02 09:00:27 by Peter Richardson
31626 *-- Author : Peter Richardson
31627 C-----------------------------------------------------------------------
31629 C-----------------------------------------------------------------------
31630 C Subroutine for resonant sleptons to standard model particles
31631 C slepton mass and mass*width added to save statement to
31632 C avoid problems with Linux by Peter Richardson
31633 C-----------------------------------------------------------------------
31634 INCLUDE 'herwig65.inc'
31635 DOUBLE PRECISION HCS,S,RCS,HWRGEN,FAC,ECM,TH,PCM,CFAC,CHANPB,SH,
31636 & TAU,TAUA,TAUB,LOWTLM,UPPTLM,HWRUNI,MSL(12),
31637 & SQSH,MET(2),SCF(12),MIX(12),ME(4,3,3,3,3,2),
31638 & RAND,CHAN(12),LAM(2,7,3,3,3,3),SLWD(12),RTAB,
31639 & WD,MQ1,MQ2,EPS,XMIN,XMAX,XPOW,XUPP,MSL2(12),
31641 INTEGER I,J,K,L,I1,J1,K1,L1,GEN,GN,GR,GNMX,GNMN,MIG,MXG,CUP,CF
31643 EXTERNAL HWRGEN,HWRUNI
31644 PARAMETER(EPS=1D-20)
31645 COMMON/HWRPIN/XMIN,XMAX,XPOW,FIRST
31646 SAVE HCS,ME,MSL,SLWD,LAM,MIX,CHAN,GNMN,GNMX,SH,SQSH,FAC,SCF,MSL2,
31649 RCS = HCS*HWRGEN(0)
31653 MSL(2*I-1) = RMASS(423+2*I)
31654 MSL(2*I) = RMASS(435+2*I)
31655 MSL(2*I+5) = RMASS(424+2*I)
31656 MSL(2*I+6) = RMASS(436+2*I)
31657 SLWD(2*I-1) = HBAR/RLTIM(423+2*I)
31658 SLWD(2*I) = HBAR/RLTIM(435+2*I)
31659 SLWD(2*I+5) = HBAR/RLTIM(424+2*I)
31660 SLWD(2*I+6) = HBAR/RLTIM(436+2*I)
31663 MSL2(I) = MSL(I)**2
31664 MSWD(I) = MSL(I)*SLWD(I)
31671 CHANPB=CHANPB+LAMDA2(I,J,K)**4
31676 CHAN(2*I-2+J) = LMIXSS(2*I-1,1,J)**2*CHANPB
31677 CHAN(2*I+4+J) = LMIXSS(2*I ,1,J)**2*CHANPB
31678 MIX(2*I-2+J) = LMIXSS(2*I-1,1,J)**2
31679 MIX(2*I+4+J) = LMIXSS(2*I ,1,J)**2
31682 IF(RAND.GT.ZERO) THEN
31684 CHAN(I)=CHAN(I)/RAND
31687 CALL HWWARN('HWHRLL',500)
31689 C--find the couplings
31695 LAM(1,GN,I,J,K,L) =LAMDA2(GN,I,J)*LAMDA1(GN,K,L)
31696 LAM(2,GN,I,J,K,L) =LAMDA2(GN,I,J)*LAMDA2(GN,K,L)
31697 LAM(1,GN+3,I,J,K,L)=LAM(1,GN,I,J,K,L)
31698 LAM(2,GN+3,I,J,K,L)=LAM(2,GN,I,J,K,L)
31704 C--select the process from the IPROC code
31707 IF(MOD(IPROC,10000).EQ.4070) THEN
31709 ELSEIF(MOD(IPROC,10000).EQ.4080) THEN
31715 COSTH = HWRUNI(0,-ONE,ONE)
31716 C--Generate the smoothing
31717 RAND=HWRUNI(0,ZERO,ONE)
31719 IF(CHAN(I).GT.RAND) GOTO 20
31723 C--Calculate hard scale and obtain parton distributions
31725 TAUB = SLWD(GR)**2/S
31726 RTAB = SQRT(TAUA*TAUB)
31728 IF(XMAX**2.GT.S) XUPP = SQRT(S)
31729 LOWTLM = DATAN((XMIN**2/S-TAUA)/RTAB)/RTAB
31730 UPPTLM = DATAN((XUPP**2/S-TAUA)/RTAB)/RTAB
31731 TAU = HWRUNI(0,LOWTLM,UPPTLM)
31732 TAU = RTAB*TAN(RTAB*TAU)+TAUA
31736 XX(1) = EXP(HWRUNI(0,ZERO,LOG(TAU)))
31738 CALL HWSGEN(.FALSE.)
31739 C--Calculate the prefactor due multichannel approach
31742 SCF(GN)=1/((SH-MSL2(GN))**2+MSWD(GN)**2)
31743 FAC=FAC+CHAN(GN)*SCF(GN)
31745 FAC=-(UPPTLM-LOWTLM)*LOG(TAU)*GEV2NB
31746 & /(96*PIFAC*SQSH*SH*TAU*FAC*S**2)
31748 C--Now the loop to actually calculate the cross-sections
31751 IF(MOD(GN,2).EQ.1) THEN
31770 ELSEIF(GN.EQ.2) THEN
31773 ELSEIF(GN.EQ.3) THEN
31776 ELSEIF(GN.EQ.4) THEN
31782 IF(SQSH.GT.(MQ1+MQ2)) THEN
31783 PCM = SQRT((SH-(MQ1+MQ2)**2)*(SH-(MQ1-MQ2)**2))/(2*SQSH)
31784 WD = (SH-MQ1**2-MQ2**2)*SH*PCM
31790 IF(MOD(GN,2).EQ.1) THEN
31802 IF(ABS(LAM(CUP,INT((GEN+1)/2),I1,J1,K1,L1)).LT.EPS.
31803 & OR.ABS(MIX(GEN)).LT.EPS) GOTO 50
31805 IF(ABS(LAM(CUP,INT((GR+1)/2),I1,J1,K1,L1)).GT.EPS.
31806 & AND.ABS(MIX(GR)).GT.EPS) THEN
31807 MET(1) =MET(1)+SCF(GEN)*SCF(GR)*WD*
31808 & ((SH-MSL2(GEN))*(SH-MSL2(GR))+MSWD(GEN)*MSWD(GR))
31809 & *LAM(CUP,INT((GEN+1)/2),I1,J1,K1,L1)*MIX(GEN)
31810 & *LAM(CUP,INT((GR+1)/2),I1,J1,K1,L1)*MIX(GR)
31813 C--Now the t-channel diagrams if the s-channel particles is a sneutrino
31815 ECM=SQRT(PCM**2+MQ1**2)
31816 TH=MQ1**2-SQSH*(ECM-PCM*COSTH)
31818 MET(2)=MET(2)+(MQ1**2-TH)*(MQ2**2-TH)*PCM*
31819 & LAM(2,INT((GEN+1)/2),I1,K1,J1,L1)*MIX(GEN)*
31820 & LAM(2,INT((GR+1)/2),I1,K1,J1,L1)*MIX(GR)
31821 & /((TH-MSL2(GEN))*(TH-MSL2(GR)))
31825 C--final phase space factors
31826 IF(MET(1).LT.EPS.AND.MET(2).LT.EPS) GOTO 70
31828 ME(GN,I1,J1,K1,L1,GR) = MET(GR)*CFAC
31833 HCS = HCS+ME(GN,I1,J1,K1,L1,GR)*DISF(I,1)*DISF(J,2)
31834 IF(HCS.GT.RCS.AND.GENEV) THEN
31835 CALL HWHRSS(9,I,J,K,L,0,CF)
31838 HCS = HCS+ME(GN,I1,J1,K1,L1,GR)*DISF(J,1)*DISF(I,2)
31839 IF(HCS.GT.RCS.AND.GENEV) THEN
31840 CALL HWHRSS(10,J,I,K,L,0,CF)
31843 HCS = HCS+ME(GN,I1,J1,K1,L1,GR)
31844 & *DISF(I+6,1)*DISF(J-6,2)
31845 IF(HCS.GT.RCS.AND.GENEV) THEN
31846 CALL HWHRSS(9,I,J,K,L,1,CF)
31849 HCS = HCS+ME(GN,I1,J1,K1,L1,GR)
31850 & *DISF(J-6,1)*DISF(I+6,2)
31851 IF(HCS.GT.RCS.AND.GENEV) THEN
31852 CALL HWHRSS(10,J,I,K,L,1,CF)
31862 CALL HWETWO(.TRUE.,.TRUE.)
31868 *CMZ :- -23/10/00 13:53:06 by Peter Richardson
31869 *-- Author : Peter Richardson
31870 C-----------------------------------------------------------------------
31872 C-----------------------------------------------------------------------
31873 C Subroutine for 2 parton -> sparticle + X via LQD
31874 C-----------------------------------------------------------------------
31875 INCLUDE 'herwig65.inc'
31876 DOUBLE PRECISION HCS,A(6,12),B(6,12),S,RCS,HWRGEN,CW,FAC2,EC,ME2,
31877 & MW,G,TAU,TAUA,TAUB,LOWTLM,UPPTLM,HWRUNI,SW,SQSH,LC,
31878 & SH,MSL(12),MSU(12),MST(6),C(2,6,12),D(2,6,12),UH,
31879 & TH,MEN(4,6,3,3),SCF(12),SLWD(12),MLT(6),MNT(4),PCM,
31880 & MXS(12),MER(8),MCR(2),RTAB,H(18),MEH(3,18),MXT(12),
31881 & CHAN(12),MXU(12),RAND,FAC,ECM,MC(2),MEC(2,6,3,3),
31882 & MZ,CHPROB,EPS,HWUAEM,XMIN,XMAX,XPOW,SIN2B,GUU(4),
31883 & ML,MN,MLS,MNS,XUPP,MW2,MZ2,ZSLP(2),ZQRK(2),GDD(4),
31884 & MSL2(12),MH(4),MSWD(12)
31885 INTEGER I,J,K,L,J1,K1,GN,GR,SP,GU,GT,I2,I1,NEUTMN
31886 & ,NEUTMX,CHARMN,CHARMX,P
31887 LOGICAL RAD,NEUT,CHAR,HIGGS,FIRST
31888 EXTERNAL HWRGEN,HWRUNI,HWUAEM
31889 COMMON/HWRPIN/XMIN,XMAX,XPOW,FIRST
31890 SAVE HCS,A,B,C,D,FAC,MER,MEC,MEN,MLT,MSL,MSU,MST,SLWD,MNT,MXT,MXU,
31891 & SW,CW,MXS,H,MEH,CHAN,NEUTMN,NEUTMX,CHARMN,CHARMX,RAD,NEUT,
31892 & CHAR,HIGGS,MW,MZ,MW2,MZ2,MCR,SH,SQSH,EC,G,SCF,ZSLP,ZQRK,GUU,
31894 PARAMETER(EPS=1D-20)
31896 RCS = HCS*HWRGEN(0)
31899 C--Calculate Electroweak parameters needed
31906 SIN2B = TWO*SINB*COSB
31907 C--Masses and widths
31909 MSL(2*I-1) = RMASS(423+2*I)
31910 MSL(2*I) = RMASS(435+2*I)
31911 MSL(2*I+5) = RMASS(424+2*I)
31912 MSL(2*I+6) = RMASS(436+2*I)
31913 SLWD(2*I-1) = HBAR/RLTIM(423+2*I)
31914 SLWD(2*I) = HBAR/RLTIM(435+2*I)
31915 SLWD(2*I+5) = HBAR/RLTIM(424+2*I)
31916 SLWD(2*I+6) = HBAR/RLTIM(436+2*I)
31917 MSU(2*I-1) = RMASS(400+2*I)**2
31918 MSU(2*I) = RMASS(412+2*I)**2
31919 MSU(2*I+5) = RMASS(399+2*I)**2
31920 MSU(2*I+6) = RMASS(411+2*I)**2
31921 MST(2*I-1) = RMASS(399+2*I)**2
31922 MST(2*I) = RMASS(411+2*I)**2
31924 MLT(2*I-1) = RMASS(119+2*I)
31927 MSL2(I) = MSL(I)**2
31928 MSWD(I) = MSL(I)*SLWD(I)
31931 MNT(I) = ABS(RMASS(449+I))
31933 MCR(1) = ABS(RMASS(454))
31934 MCR(2) = ABS(RMASS(455))
31935 C--Couplings for the neutralinos
31937 MC(1) = ZMIXSS(L,3)/(2*MW*COSB*SW)
31938 MC(2) = ZMIXSS(L,4)/(2*MW*SINB*SW)
31941 C--resonant charged sleptons
31942 A(L,2*I-2+J) = MC(1)*MLT(2*I-1)*LMIXSS(2*I-1,2,J)
31943 & +SLFCH(9+2*I,L)*LMIXSS(2*I-1,1,J)
31944 B(L,2*I-2+J) = ZSGNSS(L)*(MC(1)*MLT(2*I-1)*
31945 & LMIXSS(2*I-1,1,J)+SRFCH(9+2*I,L)*LMIXSS(2*I-1,2,J))
31946 C--resonant sneutrinos
31947 A(L,2*I+4+J) = SLFCH(10+2*I,L)*LMIXSS(2*I,1,J)
31948 B(L,2*I+4+J) = ZERO
31949 C--u channel up type squarks
31950 C(1,L,2*I-2+J) = MC(2)*QMIXSS(2*I,2,J)*
31951 & RMASS(2*I)+SLFCH(2*I,L)*QMIXSS(2*I,1,J)
31952 D(1,L,2*I-2+J) = ZSGNSS(L)*(MC(2)*QMIXSS(2*I,1,J)*
31953 & RMASS(2*I)+SRFCH(2*I ,L)*QMIXSS(2*I,2,J))
31954 C--u channel down type squarks
31955 C(1,L,2*I+4+J) = MC(1)*QMIXSS(2*I-1,2,J)*
31956 & RMASS(2*I-1)+SLFCH(2*I-1,L)*QMIXSS(2*I-1,1,J)
31957 D(1,L,2*I+4+J) = ZSGNSS(L)*(MC(1)*QMIXSS(2*I-1,1,J)*
31958 & RMASS(2*I-1)+SRFCH(2*I-1,L)*QMIXSS(2*I-1,2,J))
31959 C--t channel down type squarks
31960 C(2,L,2*I-2+J) = ZSGNSS(L)*(MC(1)*QMIXSS(2*I-1,1,J)*
31961 & RMASS(2*I-1)+SRFCH(2*I-1,L)*QMIXSS(2*I-1,2,J))
31962 D(2,L,2*I-2+J) = MC(1)*QMIXSS(2*I-1,2,J)*
31963 & RMASS(2*I-1)+SLFCH(2*I-1,L)*QMIXSS(2*I-1,1,J)
31967 C(2,L,6+I) = C(2,L,I)
31968 D(2,L,6+I) = D(2,L,I)
31971 C--Couplings for charginos
31973 MC(1) = 1/(SQRT(2.0D0)*MW*COSB)
31974 MC(2) = 1/(SQRT(2.0D0)*MW*SINB)
31978 C--resonant charged slepton
31979 A(SP,2*I-2+J) = WMXUSS(L,1)*LMIXSS(2*I-1,1,J)
31980 & -LMIXSS(2*I-1,2,J)*WMXUSS(L,2)*
31982 B(SP,2*I-2+J) = ZERO
31983 C--resonant sneutrinos
31984 A(SP,2*I+4+J) = WSGNSS(L)*WMXVSS(L,1)*LMIXSS(2*I,1,J)
31985 B(SP,2*I+4+J) = -MLT(2*I-1)*WMXUSS(L,2)*LMIXSS(2*I,1,J)
31988 C(1,SP,2*I-2+J) = WSGNSS(L)*(WMXVSS(L,1)*QMIXSS(2*I,1,J)
31989 & -WMXVSS(L,2)*MC(2)*RMASS(2*I)*QMIXSS(2*I,2,J))
31990 D(1,SP,2*I-2+J) = -WMXUSS(L,2)*MC(1)*RMASS(2*I-1)
31993 C(1,SP,2*I+4+J) = WMXUSS(L,1)*QMIXSS(2*I-1,1,J)
31994 & -WMXUSS(L,2)*MC(1)*RMASS(2*I-1)*QMIXSS(2*I-1,2,J)
31995 D(1,SP,2*I+4+J) = -WSGNSS(L)*WMXVSS(L,2)*MC(2)*
31996 & RMASS(2*I)*QMIXSS(2*I-1,1,J)
32000 C--Couplings and massesfor Higgs
32002 MH(I) = RMASS(202+I)
32004 C--first the neutral Higgs
32005 C--fix to the sign of the A and mu term 31/03/00 PR
32007 H(I) = MLT(2*I-1)*HALF/MW/COSB*MUSS*COSA
32008 H(I+4) = MLT(2*I-1)*HALF/MW/COSB*MUSS*SINA
32009 H(I+8) = -MLT(2*I-1)*HALF/MW*MUSS
32011 H(3) = (H(3)+MLT(5)*HALF/MW/COSB*ALSS*SINA)*TWO*
32012 & LMIXSS(5,2,1)*LMIXSS(5,1,1)
32013 & -MZ*SINBPA/CW*(LMIXSS(5,1,1)**2*(HALF-SWEIN)
32014 & +SWEIN*LMIXSS(5,2,1)**2)+MLT(5)**2*SINA/MW/COSB
32015 H(4) = -MZ*SINBPA/CW*(LMIXSS(5,1,1)*LMIXSS(5,1,2)*(HALF-SWEIN)
32016 & +SWEIN*LMIXSS(5,2,1)*LMIXSS(5,2,2))
32017 & +MLT(5)*HALF/COSB/MW*(MUSS*COSA+ALSS*SINA)*
32018 & (LMIXSS(5,2,2)*LMIXSS(5,1,1)+LMIXSS(5,1,2)*LMIXSS(5,2,1))
32019 H(7) = (H(7)-MLT(5)*HALF/MW/COSB*ALSS*COSA)*TWO*
32020 & LMIXSS(5,2,1)*LMIXSS(5,1,1)
32021 & +MZ*COSBPA/CW*(LMIXSS(5,1,1)**2*(HALF-SWEIN)
32022 & +LMIXSS(5,2,1)**2*SWEIN)-MLT(5)**2*COSA/MW/COSB
32023 H(8) = MZ*COSBPA/CW*(LMIXSS(5,1,2)*LMIXSS(5,1,1)*(HALF-SWEIN)
32024 & +LMIXSS(5,2,2)*LMIXSS(5,2,1)*SWEIN)
32025 & +MLT(5)*HALF/MW/COSB*(MUSS*SINA-ALSS*COSA)*
32026 & (LMIXSS(5,2,2)*LMIXSS(5,1,1)+LMIXSS(5,1,2)*LMIXSS(5,2,1))
32027 H(12) = H(11)-MLT(5)*HALF/MW*ALSS*TANB
32029 C--Now the charged Higgs
32032 H(10+2*I+J) = LMIXSS(2*I-1,1,J)*
32033 & (MLT(2*I-1)**2*TANB-MW2*SIN2B)
32034 & +LMIXSS(2*I-1,2,J)*MLT(2*I-1)*MUSS
32036 H(16+J) = H(16+J)+LMIXSS(5,2,J)*MLT(5)*ALSS*TANB
32039 C--couplings of the Higgs to quarks
32041 GUU(I) = GHUUSS(I)**2/MW2*HALF**2
32042 GDD(I) = GHDDSS(I)**2/MW2*HALF**2
32044 GUU(4) = ONE/TANB**2/MW2/8.0D0
32045 GDD(4) = ONE*TANB**2/MW2/8.0D0
32046 C--Couplings of the Z to quarks, left up right down, and charged sleptons
32047 ZQRK(1) = -SW**2/6.0D0/CW
32048 ZQRK(2) = (SW**2/3.0D0-HALF**2)/CW
32049 ZSLP(1) = HALF*(LMIXSS(5,1,1)**2-2.0D0*SW**2)/CW
32050 ZSLP(2) = HALF*LMIXSS(5,1,1)*LMIXSS(5,1,2)/CW
32051 C--parameters for multichannel integration
32057 CHPROB=CHPROB+LAMDA2(I,J,K)**2
32060 RAND = RAND+2*CHPROB
32062 MXS(2*I-2+J) = LMIXSS(2*I-1,1,J)
32063 MXS(2*I+4+J) = LMIXSS(2*I,1,J)
32064 MXU(2*I-2+J) = QMIXSS(2*I,1,J)
32065 MXU(2*I+4+J) = QMIXSS(2*I-1,1,J)
32066 MXT(2*I-2+J) = QMIXSS(2*I-1,2,J)
32067 MXT(2*I+4+J) = QMIXSS(2*I-1,2,J)
32068 CHAN(2*I-2+J) = LMIXSS(2*I-1,1,J)**2*CHPROB
32069 CHAN(2*I+4+J) = LMIXSS(2*I,1,J)**2*CHPROB
32072 IF(RAND.GT.ZERO) THEN
32074 CHAN(I)=CHAN(I)/RAND
32077 CALL HWWARN('HWHRLS',500)
32079 C--decide what processes to generate
32088 C--Decide which process to generate
32089 IF(MOD(IPROC,10000).EQ.4000) THEN
32094 ELSEIF(MOD(IPROC,10000).LT.4020) THEN
32095 IF(MOD(IPROC,10000).NE.4010) THEN
32096 NEUTMN = MOD(IPROC,10)
32100 ELSEIF(MOD(IPROC,10000).LT.4030) THEN
32101 IF(MOD(IPROC,10000).NE.4020) THEN
32102 CHARMN = MOD(IPROC,10)
32106 ELSEIF(MOD(IPROC,10000).EQ.4040) THEN
32108 ELSEIF(MOD(IPROC,10000).EQ.4050) THEN
32112 C--basic parameters
32115 COSTH = HWRUNI(0,-ONE,ONE)
32116 RAND = HWRUNI(0,ZERO,ONE)
32122 MEN(L,I,J,K) = ZERO
32123 MEN(L+2,I,J,K) = ZERO
32124 MEC(L,I,J,K) = ZERO
32132 C--Perform multichannel integration
32134 IF(CHAN(I).GT.RAND) THEN
32140 C--Calculate the hard scale and obtain parton distributions
32141 25 TAUA = MSL2(GR)/S
32142 TAUB = SLWD(GR)**2/S
32143 RTAB = SQRT(TAUA*TAUB)
32145 IF(XMAX**2.GT.S) XUPP = SQRT(S)
32146 LOWTLM = DATAN((XMIN**2/S-TAUA)/RTAB)/RTAB
32147 UPPTLM = DATAN((XUPP**2/S-TAUA)/RTAB)/RTAB
32148 TAU = HWRUNI(0,LOWTLM,UPPTLM)
32149 TAU = RTAB*TAN(RTAB*TAU)+TAUA
32153 XX(1) = EXP(HWRUNI(0,LOG(TAU),ZERO))
32155 CALL HWSGEN(.FALSE.)
32156 C--EM and Weak couplings
32157 EC = SQRT(4*PIFAC*HWUAEM(SH))
32159 C--Calculate the prefactor due multichannel approach
32162 SCF(GN)=1/((SH-MSL2(GN))**2+MSWD(GN)**2)
32163 FAC=FAC+CHAN(GN)*SCF(GN)
32165 FAC=-(UPPTLM-LOWTLM)*GEV2NB*LOG(TAU)/
32166 & (48*TAU*FAC*PIFAC*S**2*SH*SQSH)
32169 C--First we do the neutralino production
32170 IF(.NOT.NEUT) GOTO 200
32179 IF(CHAN(GR).LT.EPS) GOTO 140
32180 DO 130 L=NEUTMN,NEUTMX
32185 IF((ML+MN).GT.SQSH) GOTO 130
32187 PCM = SQRT((SH-(ML+MN)**2)*(SH-(ML-MN)**2))*HALF/SQSH
32188 ECM = SQRT(PCM**2+MLS)
32189 TH = MLS-SQSH*(ECM-PCM*COSTH)
32190 UH = MLS-SQSH*(ECM+PCM*COSTH)
32193 IF(ABS(LAMDA2(I,J,K)).LT.EPS) GOTO 120
32196 IF(GN.GT.3) J1=J1-1
32198 C--squarks in u and t channels
32199 GU = 6*INT((GN-1)/3)+2*J-1
32201 C--calulate the matrix element
32202 ME2=MXS(GR)**2*SCF(GR)*SH*((SH-MLS-MNS)*
32203 & (A(L,GR)**2+B(L,GR)**2)-4*ML*MN*A(L,GR)*B(L,GR))
32204 & +MXU(GU)**2*(MLS-UH)*(MNS-UH)*
32205 & (C(1,L,GU)**2+D(1,L,GU)**2)/(UH-MSU(GU))**2
32206 & +MXT(GT)**2*(MLS-TH)*(MNS-TH)*
32207 & (C(2,L,GT)**2+D(2,L,GT)**2)/(TH-MST(GT))**2
32208 & -TWO*MXT(GT)*MXU(GU)*C(1,L,GU)*C(2,L,GT)*(MLS*MNS-UH*TH)
32209 & /(UH-MSU(GU))/(TH-MST(GT))
32210 & +TWO*MXS(GR)*MXU(GU)*(SH-MSL2(GR))*SCF(GR)*C(1,L,GU)*
32211 & SH*(UH*A(L,GR)+ML*MN*B(L,GR))/(UH-MSU(GU))
32212 & +TWO*MXS(GR)*MXT(GT)*(SH-MSL2(GR))*SCF(GR)*C(2,L,GT)*
32213 & SH*(TH*A(L,GR)+ML*MN*B(L,GR))/(TH-MST(GT))
32214 C--s channel mixing L/R mixing
32215 IF(ABS(MXS(GR+1)).GT.EPS) THEN
32216 ME2=ME2+MXS(GR+1)**2*SCF(GR+1)*SH*((SH-MLS-MNS)*
32217 & (A(L,GR+1)**2+B(L,GR+1)**2)
32218 & -4*ML*MN*A(L,GR+1)*B(L,GR+1))
32219 & +TWO*MXS(GR)*MXS(GR+1)*SCF(GR)*SCF(GR+1)*
32220 & ((SH-MSL2(GR))*(SH-MSL2(GR+1))+
32221 & MSWD(GR)*MSWD(GR+1))*SH*
32222 & ((SH-MLS-MNS)*(A(L,GR)*A(L,GR+1)+B(L,GR)*B(L,GR+1))
32223 & -2*ML*MN*(A(L,GR)*B(L,GR+1)+A(L,GR+1)*B(L,GR)))
32224 & +TWO*MXS(GR+1)*MXU(GU)*(SH-MSL2(GR+1))*SCF(GR+1)*
32225 & SH*C(1,L,GU)*(UH*A(L,GR+1)+ML*MN*B(L,GR+1))
32227 & +TWO*MXS(GR+1)*MXT(GT)*(SH-MSL2(GR+1))*SCF(GR+1)*
32228 & SH*C(2,L,GT)*(TH*A(L,GR+1)+ML*MN*B(L,GR+1))
32230 IF(ABS(MXU(GU+1)).GT.EPS) ME2=ME2+TWO*MXS(GR+1)*MXU(GU+1)*
32231 & (SH-MSL2(GR+1))*SCF(GR+1)*SH*C(1,L,GU+1)*
32232 & (UH*A(L,GR+1)+ML*MN*B(L,GR+1))/(UH-MSU(GU+1))
32233 IF(ABS(MXT(GT-1)).GT.EPS) ME2=ME2+TWO*MXS(GR+1)*MXT(GT-1)*
32234 & (SH-MSL2(GR+1))*SCF(GR+1)*SH*C(2,L,GT-1)*
32235 & (TH*A(L,GR+1)+ML*MN*B(L,GR+1))/(TH-MST(GT-1))
32237 C--u channel L/R mixing
32238 IF(ABS(MXU(GU+1)).GT.EPS) THEN
32239 ME2=ME2+MXU(GU+1)**2*(MLS-UH)*(MNS-UH)*(C(1,L,GU+1)**2+
32240 & D(1,L,GU+1)**2)/(UH-MSU(GU+1))**2
32241 & +TWO*MXU(GU)*MXU(GU+1)*(MLS-UH)*(MNS-UH)*
32242 & (C(1,L,GU)*C(1,L,GU+1)+D(1,L,GU)*D(1,L,GU+1))
32243 & /(UH-MSU(GU))/(UH-MSU(GU+1))
32244 & -TWO*MXT(GT)*MXU(GU+1)*C(1,L,GU+1)*C(2,L,GT)*
32245 & (MLS*MNS-UH*TH)/(UH-MSU(GU+1))/(TH-MST(GT))
32246 & +TWO*MXS(GR)*MXU(GU+1)*(SH-MSL2(GR))*SCF(GR)*
32247 & SH*C(1,L,GU+1)*(UH*A(L,GR)+ML*MN*B(L,GR))
32249 IF(ABS(MXT(GT-1)).GT.EPS) ME2=ME2-TWO*MXT(GT-1)*MXU(GU+1)*
32250 & C(1,L,GU+1)*C(2,L,GT-1)*(MLS*MNS-UH*TH)
32251 & /(UH-MSU(GU+1))/(TH-MST(GT-1))
32253 C--t channel L/R mixing
32254 IF(ABS(MXT(GT-1)).GT.EPS) THEN
32255 ME2=ME2+MXT(GT-1)**2*(MLS-TH)*(MNS-TH)*(C(2,L,GT-1)**2
32256 & +D(2,L,GT-1)**2)/(TH-MST(GT-1))**2
32257 & +TWO*MXT(GT)*MXT(GT-1)*(MLS-TH)*(MNS-TH)*
32258 & (C(2,L,GT)*C(2,L,GT-1)+D(2,L,GT)*D(2,L,GT-1))
32259 & /(TH-MST(GT))/(TH-MST(GT-1))
32260 & -TWO*MXT(GT-1)*MXU(GU)*C(1,L,GU)*C(2,L,GT-1)*
32261 & (MLS*MNS-UH*TH)/(UH-MSU(GU))/(TH-MST(GT-1))
32262 & +TWO*MXS(GR)*MXT(GT-1)*(SH-MSL2(GR))*SCF(GR)*
32263 & SH*C(2,L,GT-1)*(TH*A(L,GR)+ML*MN*B(L,GR))
32266 C--multiply by lamda and factors
32267 MEN(L,GN,J,K) = FAC*ME2*EC**2*LAMDA2(I,J,K)**2*PCM
32269 HCS = HCS+MEN(L,GN,J,K)*DISF(J1,1)*DISF(K1,2)
32270 IF(GENEV.AND.HCS.GT.RCS) THEN
32271 CALL HWHRSS(11,J1,K1,I2,L,0,0)
32274 HCS = HCS+MEN(L,GN,J,K)*DISF(K1,1)*DISF(J1,2)
32275 IF(GENEV.AND.HCS.GT.RCS) THEN
32276 CALL HWHRSS(12,K1,J1,I2,L,0,0)
32279 HCS = HCS+MEN(L,GN,J,K)*DISF(J1+6,1)*DISF(K1-6,2)
32280 IF(GENEV.AND.HCS.GT.RCS) THEN
32281 CALL HWHRSS(11,J1,K1,I2,L,1,0)
32284 HCS = HCS+MEN(L,GN,J,K)*DISF(K1-6,1)*DISF(J1+6,2)
32285 IF(GENEV.AND.HCS.GT.RCS) THEN
32286 CALL HWHRSS(12,K1,J1,I2,L,1,0)
32293 200 IF(.NOT.CHAR) GOTO 300
32294 C--Chargino production
32303 IF(CHAN(GR).LT.EPS) GOTO 240
32304 DO 230 L=CHARMN,CHARMX
32310 IF((ML+MN).GT.EMSCA) GOTO 230
32311 PCM = SQRT((SH-(ML+MN)**2)*(SH-(ML-MN)**2))*HALF/SQSH
32312 ECM = SQRT(PCM**2+MLS)
32313 TH = MLS-SQSH*(ECM-PCM*COSTH)
32314 UH = MLS-SQSH*(ECM+PCM*COSTH)
32317 IF(ABS(LAMDA2(I,J,K)).LT.EPS) GOTO 220
32320 IF(GN.GT.3) J1=J1-1
32323 IF(GN.LE.3) GU=GU+6
32324 C--Calculate the matrix element, s and u terms
32325 ME2 =MXS(GR)**2*SCF(GR)*SH*(
32326 & (SH-MLS-MNS)*(A(SP,GR)**2+B(SP,GR)**2)
32327 & -4*ML*MN*A(SP,GR)*B(SP,GR))
32328 & +MXU(GU)**2*(MLS-UH)*(MNS-UH)*
32329 & (C(1,SP,GU)**2+D(1,SP,GU)**2)/(UH-MSU(GU))**2
32330 & -2*MXS(GR)*MXU(GU)*(SH-MSL2(GR))*SCF(GR)*C(1,SP,GU)*
32331 & SH*(UH*A(SP,GR)+B(SP,GR)*ML*MN)/(UH-MSU(GU))
32332 C--s channel L/R mixing
32333 IF(ABS(MXS(GR+1)).GT.EPS) THEN
32334 ME2=ME2+MXS(GR+1)**2*SCF(GR+1)*SH*((SH-MLS-MNS)*
32335 & (A(SP,GR+1)**2+B(SP,GR+1)**2)
32336 & -4*ML*MN*A(SP,GR+1)*B(SP,GR+1))
32337 & +2*MXS(GR)*MXS(GR+1)*SCF(GR)*SCF(GR+1)*
32338 & ((SH-MSL2(GR))*(SH-MSL2(GR+1))+
32339 & MSWD(GR)*MSWD(GR+1))*SH*
32340 & ((SH-MLS-MNS)*(A(SP,GR)*A(SP,GR+1)
32341 & +B(SP,GR)*B(SP,GR+1))-4*ML*MN*
32342 & (A(SP,GR)*B(SP,GR+1)+B(SP,GR)*A(SP,GR+1)))
32343 & -2*MXS(GR+1)*MXU(GU)*(SH-MSL2(GR+1))*SCF(GR+1)*SH*
32344 & C(1,SP,GU)*(UH*A(SP,GR+1)+B(SP,GR+1)*ML*MN)
32346 IF(ABS(MXU(GU+1)).GT.EPS) ME2=ME2-2*MXS(GR+1)*MXU(GU+1)*
32347 & (SH-MSL2(GR+1))*SCF(GR+1)*C(1,SP,GU+1)*SH*
32348 & (UH*A(SP,GR+1)+B(SP,GR+1)*ML*MN)/(UH-MSU(GU+1))
32350 C--u channel L/R mixing
32351 IF(ABS(MXU(GU+1)).GT.EPS) ME2 = ME2+MXU(GU+1)**2*(MLS-UH)*
32352 & (MNS-UH)*(C(1,SP,GU+1)**2+D(1,SP,GU+1)**2)
32353 & /(UH-MSU(GU+1))**2
32354 & +2*MXU(GU)*MXU(GU+1)*(MLS-UH)*(MNS-UH)*
32355 & (C(1,SP,GU)*C(1,SP,GU+1)+D(1,SP,GU)*D(1,SP,GU+1))
32356 & /(UH-MSU(GU))/(UH-MSU(GU+1))
32357 & -2*MXS(GR)*MXU(GU+1)*(SH-MSL2(GR))*SCF(GR)*SH*
32358 & C(1,SP,GU+1)*(UH*A(SP,GR)+B(SP,GR)*ML*MN)
32360 MEC(L,GN,J,K) = FAC*ME2*G**2*LAMDA2(I,J,K)**2*PCM*HALF
32363 HCS = HCS+MEC(L,GN,J,K)*DISF(J1,1)*DISF(K1,2)
32364 IF(GN.GT.3) P = P+2
32365 IF(GENEV.AND.HCS.GT.RCS) THEN
32366 CALL HWHRSS(11,J1,K1,I2,P,0,0)
32369 HCS = HCS+MEC(L,GN,J,K)*DISF(K1,1)*DISF(J1,2)
32370 IF(GENEV.AND.HCS.GT.RCS) THEN
32371 CALL HWHRSS(12,K1,J1,I2,P,0,0)
32374 HCS = HCS+MEC(L,GN,J,K)*DISF(J1+6,1)*DISF(K1-6,2)
32375 IF(GENEV.AND.HCS.GT.RCS) THEN
32376 CALL HWHRSS(11,J1,K1,I2,P,1,0)
32379 HCS = HCS+MEC(L,GN,J,K)*DISF(K1-6,1)*DISF(J1+6,2)
32380 IF(GENEV.AND.HCS.GT.RCS) THEN
32381 CALL HWHRSS(12,K1,J1,I2,P,1,0)
32388 300 IF(.NOT.RAD) GOTO 400
32389 C--Radiative decays
32394 C--charged slepton to sneutrino W
32395 IF(SQSH.GT.(MW+MSL(I1))) THEN
32396 PCM = SQRT((SH-(MW+MSL(I1))**2)*(SH-(MW-MSL(I1))**2))*HALF/SQSH
32397 ECM = SQRT(PCM**2+MW2)
32398 TH = MW2-SQSH*(ECM-PCM*COSTH)
32399 UH = MW2-SQSH*(ECM+PCM*COSTH)
32400 ME2 = MXS(I)**4*SCF(I)*SH**2*PCM**2
32401 & +HALF**2/TH**2*(TWO*MW2*(UH*TH-MSL2(I1)*MW2)+TH**2*SH)
32402 & -HALF*MXS(I)**2*SH*(SH-MSL2(I))*SCF(I)/TH*
32403 & (MW2*(TWO*MSL2(I1)-TH)+(SH-MSL2(I1))*TH)
32404 IF(GN.EQ.3) ME2 = ME2+MXS(I+1)**4*SCF(I+1)*SH**2*PCM**2
32405 & +2.0D0*MXS(I)**2*MXS(I+1)**2*SCF(I)*SCF(I+1)*SH**2*PCM**2
32406 & *((SH-MSL2(I))*(SH-MSL2(I+1))+MSWD(I)*MSWD(I+1))
32407 & -HALF*MXS(I+1)**2*SH*(SH-MSL2(I+1))*SCF(I+1)/TH*
32408 & (MW2*(TWO*MSL2(I1)-TH)+(SH-MSL2(I1))*TH)
32409 MER(GN) = ME2*PCM/MW2
32411 C--sneutrino to charged slepton W
32412 IF(SQSH.GT.(MW+MSL(I))) THEN
32413 PCM = SQRT((SH-(MW+MSL(I))**2)*(SH-(MW-MSL(I))**2))*HALF/SQSH
32414 ECM = SQRT(PCM**2+MW2)
32415 TH = MW2-SQSH*(ECM-PCM*COSTH)
32416 UH = MW2-SQSH*(ECM+PCM*COSTH)
32417 ME2 = MXS(I)**2*SCF(I1)*SH**2*PCM**2
32418 & +HALF**2*MXS(I)**2/TH**2*
32419 & (TWO*MW2*(UH*TH-MW2*MSL2(I))+TH**2*SH)
32420 & -HALF*MXS(I)**2*SH*(SH-MSL2(I1))*SCF(I1)/TH*
32421 & (MW2*(TWO*MSL2(I)-TH)+(SH-MSL2(I))*TH)
32422 MER(GN+4) = ME2*PCM/MW2
32425 C--now the decay stau_2 to stau_1 Z
32426 IF(SQSH.GT.(MZ+MSL(5))) THEN
32427 PCM = SQRT((SH-(MZ+MSL(5))**2)*(SH-(MZ-MSL(5))**2))*HALF/SQSH
32428 ECM = SQRT(PCM**2+MZ2)
32429 TH = MZ2-SQSH*(ECM-PCM*COSTH)
32430 UH = MZ2-SQSH*(ECM+PCM*COSTH)
32431 ME2 = SH**2*PCM**2*(SCF(5)*MXS(5)**2*ZSLP(1)**2
32432 & +SCF(6)*MXS(6)**2*ZSLP(2)**2+TWO*SCF(5)*SCF(6)*
32433 & MXS(5)*MXS(6)*ZSLP(1)*ZSLP(2)*((SH-MSL2(5))*
32434 & (SH-MSL2(6))+MSWD(5)*MSWD(6)))
32435 & +MXS(5)**2*ZQRK(2)**2/TH**2*
32436 & (TWO*MZ2*(UH*TH-MZ2*MSL2(5))+TH**2*SH)
32437 & +MXS(5)**2*ZQRK(1)**2/UH**2*
32438 & (TWO*MZ2*(UH*TH-MZ2*MSL2(5))+UH**2*SH)
32439 & +MXS(5)*SH*(MXS(5)*SCF(5)*ZSLP(1)*(SH-MSL2(5))
32440 & +MXS(6)*SCF(6)*ZSLP(2)*(SH-MSL2(6)))*
32441 & (-ZQRK(2)/TH*(MZ2*(TWO*MSL2(5)-TH)+TH*(SH-MSL2(5)))
32442 & +ZQRK(1)/UH*(MZ2*(TWO*MSL2(5)-UH)+UH*(SH-MSL2(5))))
32443 & +TWO*MXS(5)**2*ZQRK(1)*ZQRK(2)/UH/TH*
32444 & (TWO*MZ2*(MSL2(5)-UH)*(MSL2(5)-TH)-SH*UH*TH)
32445 MER(4) = TWO*ME2*PCM/MZ2
32447 C--now the decay tau sneutrino to tau_2 W
32448 IF(SQSH.GT.(MW+MSL(6))) THEN
32449 PCM = SQRT((SH-(MW+MSL(6))**2)*(SH-(MW-MSL(6))**2))*HALF/SQSH
32450 ECM = SQRT(PCM**2+MW2)
32451 TH = MW2-SQSH*(ECM-PCM*COSTH)
32452 UH = MW2-SQSH*(ECM+PCM*COSTH)
32453 ME2 = MXS(6)**2*SCF(11)*SH**2*PCM**2
32454 & +HALF**2*MXS(6)**2/TH**2*
32455 & (TWO*MW2*(UH*TH-MW2*MSL2(6))+TH**2*SH)
32456 & -HALF*MXS(6)**2*SH*(SH-MSL2(11))*SCF(11)/TH*
32457 & (MW2*(2*MSL2(6)-TH)+(SH-MSL2(6))*TH)
32458 MER(8) = ME2*PCM/MW2
32460 C--Multiply by the parton distributions
32465 LC = LAMDA2(I,J,K)**2
32467 LC = LAMDA2(3,J,K)**2
32469 IF(LC.LT.EPS) GOTO 330
32471 C--radiative cross-sections
32475 HCS = HCS+ME2*DISF(J1,1)*DISF(K1,2)
32476 IF(GENEV.AND.HCS.GT.RCS) THEN
32477 CALL HWHRSS(13,J1,K1,I,I,0,0)
32480 HCS = HCS+ME2*DISF(K1,1)*DISF(J1,2)
32481 IF(GENEV.AND.HCS.GT.RCS) THEN
32482 CALL HWHRSS(14,K1,J1,I,I,0,0)
32485 HCS = HCS+ME2*DISF(J1+6,1)*DISF(K1-6,2)
32486 IF(GENEV.AND.HCS.GT.RCS) THEN
32487 CALL HWHRSS(13,J1,K1,I,I,1,0)
32490 HCS = HCS+ME2*DISF(K1-6,1)*DISF(J1+6,2)
32491 IF(GENEV.AND.HCS.GT.RCS) THEN
32492 CALL HWHRSS(14,K1,J1,I,I,1,0)
32497 ME2 = FAC2*MER(I+4)
32498 HCS = HCS+ME2*DISF(J1,1)*DISF(K1,2)
32499 IF(GENEV.AND.HCS.GT.RCS) THEN
32500 CALL HWHRSS(13,J1,K1,I+4,I+4,0,0)
32503 HCS = HCS+ME2*DISF(K1,1)*DISF(J1,2)
32504 IF(GENEV.AND.HCS.GT.RCS) THEN
32505 CALL HWHRSS(14,K1,J1,I+4,I+4,0,0)
32508 HCS = HCS+ME2*DISF(J1+6,1)*DISF(K1-6,2)
32509 IF(GENEV.AND.HCS.GT.RCS) THEN
32510 CALL HWHRSS(13,J1,K1,I+4,I+4,1,0)
32513 HCS = HCS+ME2*DISF(K1-6,1)*DISF(J1+6,2)
32514 IF(GENEV.AND.HCS.GT.RCS) THEN
32515 CALL HWHRSS(14,K1,J1,I+4,I+4,1,0)
32521 400 IF(.NOT.HIGGS) GOTO 500
32525 405 MEH(I,J) = ZERO
32527 C--Neutral higgs charged slepton
32530 C--first two generations
32531 IF(SQSH.LT.MH(L)+MSL(2*I)) GOTO 410
32532 PCM = SQRT((SH-(MSL(2*I)+MH(L))**2)*
32533 & (SH-(MSL(2*I)-MH(L))**2))*HALF/SQSH
32534 MEH(1,3*L-3+I) = PCM*SH*SCF(2*I-1)*H(4*L+I-4)**2
32536 C--third generation
32537 IF(SQSH.LT.MH(L)+MSL(5)) GOTO 420
32538 PCM = SQRT((SH-(MSL(5)+MH(L))**2)*
32539 & (SH-(MSL(5)-MH(L))**2))*HALF/SQSH
32540 ECM = SQRT(PCM**2+MH(L)**2)
32541 TH = MH(L)**2-SQSH*(ECM-PCM*COSTH)
32542 UH = MH(L)**2-SQSH*(ECM+PCM*COSTH)
32543 MEH(1,3*L) = PCM*SH*(MXS(5)**2*SCF(5)*H(4*L-1)**2
32544 & +MXS(6)**2*SCF(6)*H(4*L)**2
32545 & +TWO*MXS(5)*MXS(6)*SCF(5)*SCF(6)*H(4*L-1)*
32546 & H(4*L)*((SH-MSL2(5))*(SH-MSL2(6))+
32547 & MSWD(5)*MSWD(6)) )
32548 ME2 = MXS(5)**2*PCM*(UH*TH-MSL2(5)*MH(L)**2)
32549 MEH(2,3*L) =ME2*GUU(L)/TH**2
32550 MEH(3,3*L) =ME2*GDD(L)/UH**2
32554 C--charged slepton charged Higgs
32556 IF(SQSH.LT.(MH(4)+MSL(2*I-2+J))) GOTO 430
32557 PCM = SQRT((SH-(MH(4)+MSL(2*I-2+J))**2)*
32558 & (SH-(MH(4)-MSL(2*I-2+J))**2))*HALF/SQSH
32559 ECM = SQRT(PCM**2+MH(4)**2)
32560 TH = MH(4)**2-SQSH*(ECM-PCM*COSTH)
32561 UH = MH(4)**2-SQSH*(ECM+PCM*COSTH)
32562 MEH(1,2*I+J+7) = PCM*SH*HALF/MW2*H(2*I+J+10)**2*SCF(5+2*I)
32563 MEH(2,2*I+J+7) = PCM*GDD(4)*MXS(2*I-2+J)**2*
32564 & (UH*TH-MH(4)**2*MSL2(2*I-2+J))/TH**2
32566 C--Sneutrino Charged Higgs
32567 IF(SQSH.LT.(MH(4)+MSL(2*I+5))) GOTO 440
32568 PCM = SQRT((SH-(MH(4)+MSL(2*I+5))**2)*
32569 & (SH-(MH(4)-MSL(2*I+5))**2))*HALF/SQSH
32570 ECM = SQRT(PCM**2+MH(4)**2)
32571 TH = MH(4)**2-SQSH*(ECM-PCM*COSTH)
32572 UH = MH(4)**2-SQSH*(ECM+PCM*COSTH)
32573 MEH(1,15+I) = PCM*SH*HALF/MW2*(
32574 & MXS(2*I-1)**2*SCF(2*I-1)*H(11+2*I)**2
32575 & +MXS(2*I)**2*SCF(2*I)*H(12+2*I)**2
32576 & +TWO*MXS(2*I-1)*MXS(2*I)*SCF(2*I-1)*
32577 & SCF(2*I)*H(11+2*I)*H(12+2*I)*
32578 & ((SH-MSL2(2*I-1))*(SH-MSL2(2*I))+
32579 & MSWD(2*I-1)*MSWD(2*I)))
32580 MEH(2,15+I) = PCM*GUU(4)*
32581 & (UH*TH-MH(4)**2*MSL2(2*I+5))/TH**2
32583 C--Multiply by the parton distributions
32587 IF(LAMDA2(I,J,K).LT.EPS) GOTO 490
32588 C--Higgs cross-sections
32591 FAC2 = G**2*LAMDA2(I,J,K)**2*FAC*HALF
32593 ME2 = FAC2*(MEH(1,3*L-3+I)+RMASS(J1)**2*MEH(2,3*L-3+I)
32594 & +RMASS(K1)**2*MEH(3,3*L-3+I))
32595 HCS = HCS+ME2*DISF(J1,1)*DISF(K1,2)
32596 IF(GENEV.AND.HCS.GT.RCS) THEN
32597 CALL HWHRSS(15,J1,K1,I,L,0,0)
32600 HCS = HCS+ME2*DISF(K1,1)*DISF(J1,2)
32601 IF(GENEV.AND.HCS.GT.RCS) THEN
32602 CALL HWHRSS(16,K1,J1,I,L,0,0)
32605 HCS = HCS+ME2*DISF(J1+6,1)*DISF(K1-6,2)
32606 IF(GENEV.AND.HCS.GT.RCS) THEN
32607 CALL HWHRSS(15,J1,K1,I,L,1,0)
32610 HCS = HCS+ME2*DISF(K1-6,1)*DISF(J1+6,2)
32611 IF(GENEV.AND.HCS.GT.RCS) THEN
32612 CALL HWHRSS(16,K1,J1,I,L,1,0)
32616 ME2 = FAC2*(MEH(1,15+I)+RMASS(J1)**2*MEH(2,15+I))
32617 HCS = HCS+ME2*DISF(J1,1)*DISF(K1,2)
32618 IF(GENEV.AND.HCS.GT.RCS) THEN
32619 CALL HWHRSS(15,J1,K1,9+I,4,0,0)
32622 HCS = HCS+ME2*DISF(K1,1)*DISF(J1,2)
32623 IF(GENEV.AND.HCS.GT.RCS) THEN
32624 CALL HWHRSS(16,K1,J1,9+I,4,0,0)
32627 HCS = HCS+ME2*DISF(J1+6,1)*DISF(K1-6,2)
32628 IF(GENEV.AND.HCS.GT.RCS) THEN
32629 CALL HWHRSS(15,J1,K1,9+I,5,1,0)
32632 HCS = HCS+ME2*DISF(K1-6,1)*DISF(J1+6,2)
32633 IF(GENEV.AND.HCS.GT.RCS) THEN
32634 CALL HWHRSS(16,K1,J1,9+I,5,1,0)
32640 ME2 = FAC2*(MEH(1,2*I+L+6)+RMASS(J1)**2*MEH(2,2*I+L+6))
32641 HCS = HCS+ME2*DISF(J1,1)*DISF(K1,2)
32642 IF(GENEV.AND.HCS.GT.RCS) THEN
32643 CALL HWHRSS(15,J1,K1,2*I+L,5,0,0)
32646 HCS = HCS+ME2*DISF(K1,1)*DISF(J1,2)
32647 IF(GENEV.AND.HCS.GT.RCS) THEN
32648 CALL HWHRSS(16,K1,J1,2*I+L,5,0,0)
32651 HCS = HCS+ME2*DISF(J1+6,1)*DISF(K1-6,2)
32652 IF(GENEV.AND.HCS.GT.RCS) THEN
32653 CALL HWHRSS(15,J1,K1,2*I+L,4,1,0)
32656 HCS = HCS+ME2*DISF(K1-6,1)*DISF(J1+6,2)
32657 IF(GENEV.AND.HCS.GT.RCS) THEN
32658 CALL HWHRSS(16,K1,J1,2*I+L,4,1,0)
32665 C--Setup to generate the event
32667 CALL HWETWO(.TRUE.,.TRUE.)
32673 *CMZ :- -20/07/99 10:56:12 by Peter Richardson
32674 *-- Author : Peter Richardson
32675 C-----------------------------------------------------------------------
32677 C-----------------------------------------------------------------------
32678 C Subroutine for all hadron-hadron Rparity violating processes
32679 C-----------------------------------------------------------------------
32680 INCLUDE 'herwig65.inc'
32681 IF(MOD(IPROC,10000).GE.4000.AND.MOD(IPROC,10000).LT.4060) THEN
32682 C--SINGLE SPARTICLE VIA LQD
32684 ELSEIF(MOD(IPROC,10000).GE.4060.AND.MOD(IPROC,10000).LT.4100) THEN
32685 C--RESONANT SLEPTONS TO STANDARD MODEL VIA LQD
32687 ELSEIF(MOD(IPROC,10000).GE.4100.AND.MOD(IPROC,10000).LT.4160) THEN
32688 C--SINGLE SPARTICLE VIA UDD
32690 C--RESONANT SQUARKS TO STANDARD MODEL VIA UDD
32691 ELSEIF(MOD(IPROC,10000).EQ.4160) THEN
32695 CALL HWWARN('HWHRSP',500)
32699 *CMZ :- -20/07/99 10:56:12 by Peter Richardson
32700 *-- Author : Peter Richardson
32701 C-----------------------------------------------------------------------
32702 SUBROUTINE HWHRSS(TYPE,ID1,ID2,ID3,ID4,R4,IPERM)
32703 C-----------------------------------------------------------------------
32704 C IDENTIDY HARD R-PARITY VIOLATING PROCESS
32705 C-----------------------------------------------------------------------
32706 INCLUDE 'herwig65.inc'
32707 INTEGER ID3, ID4, R4, IPERM,TYPE,ID1,ID2,NEUTD1(8),SLEPID(8),
32708 & NEUTD2(13),SQUID(6),SGN,HWUANT,SQUID2(12),SLPID2(12),
32709 & GAGID1(6),GAGID2(8)
32711 SAVE NEUTD1,NEUTD2,SLEPID,SQUID ,SQUID2,SLPID2,GAGID1,GAGID2
32712 DATA NEUTD1 /450,451,452,453,454,455,456,457/
32713 DATA NEUTD2 /449,449,449,450,451,452,453,454,455,456,457,454,455/
32714 DATA SLEPID /432,434,436,435,431,433,435,447/
32715 DATA SQUID /411,423,412,412,424,411/
32716 DATA SQUID2 /407,419,409,421,411,423,408,420,410,422,412,424/
32717 DATA SLPID2 /443,445,435,431,443,433,445,435,447,432,434,436/
32718 DATA GAGID1 /199,199,200,198,198,200/
32719 DATA GAGID2 /198,198,198,200,199,199,199,199/
32721 IF(IPERM.EQ.0) THEN
32726 ELSEIF(IPERM.EQ.1) THEN
32731 ELSEIF(IPERM.EQ.2) THEN
32737 CALL HWWARN('HWHRSS',100)
32745 IF(MOD(TYPE,2).EQ.0) SGN = -1
32746 IDN(1) = ID1+R4*6*SGN
32747 IDN(2) = ID2-R4*6*SGN
32752 ELSEIF(TYPE.GE.3.AND.TYPE.LE.4) THEN
32754 IDN(4) = NEUTD2(ID4)
32755 ELSEIF(TYPE.GE.5.AND.TYPE.LE.6) THEN
32756 IDN(3) = GAGID1(ID3)
32757 IDN(4) = SQUID(ID4)-R4*6
32758 IF(R4.EQ.1) IDN(3) = HWUANT(IDN(3))
32759 ELSEIF(TYPE.GE.7.AND.TYPE.LE.8) THEN
32761 IDN(4) = SQUID2(ID4)-R4*6
32762 ELSEIF(TYPE.GE.9.AND.TYPE.LE.10) THEN
32765 IF(IPERM.EQ.2.AND.TYPE.EQ.10) THEN
32770 ELSEIF(TYPE.GE.11.AND.TYPE.LE.12) THEN
32771 IDN(3) = 120+ID3-R4*6
32772 IDN(4) = NEUTD1(ID4)
32773 IF(R4.EQ.1) IDN(4) = HWUANT(IDN(4))
32774 ELSEIF(TYPE.GE.13.AND.TYPE.LE.14) THEN
32775 IDN(3) = SLEPID(ID3)-R4*6
32776 IDN(4) = GAGID2(ID4)
32777 IF(R4.NE.0) IDN(4) = HWUANT(IDN(4))
32778 ELSEIF(TYPE.GE.15.AND.TYPE.LE.16) THEN
32779 IDN(3) = SLPID2(ID3)-R4*6
32782 IF(MOD(TYPE,2).EQ.0.AND.TYPE.NE.8) COSTH=-COSTH
32786 *CMZ :- -18/03/04 18.42.43 by Mike Seymour
32787 *-- Author : Mike Seymour
32788 C-----------------------------------------------------------------------
32789 SUBROUTINE HWHSCT(REPORT,FIRSTC,JMUEO,PTJIM)
32790 C-----------------------------------------------------------------------
32791 C RELABEL THE EVENT RECORD FOR EXTRA HARD SCATTERING,
32792 C DO THE SCATTERING, PARTON SHOWER IT, AND CLEAN UP THE EVENT RECORD
32793 C REPORT RETURNS THE OUTCOME:
32795 C 1 = FAILED DUE TO ERROR IN HARD SCATTERING GENERATION
32796 C 2 = FAILED DUE TO ENERGY CONSERVATION IN HARD SCATTERING
32797 C 3 = FAILED DUE TO ERROR IN PARTON EVOLUTION
32798 C 4 = FAILED DUE TO ENERGY CONSERVATION IN PARTON EVOLUTION
32799 C 5 = COMPLETELY FAILED (IERROR IS ALSO NON-ZERO TO CANCEL EVENT)
32800 C FIRSTC IS AN INPUT FLAG THAT SAYS THAT THIS IS THE FIRST CALL
32802 C JMUEO IS THE UNDERLYING EVENT OPTION: 1=>VETO EVENTS WITH M
32803 C SCATTERS ABOVE PTMIN WITH PROBABILITY 1/(M+1)
32804 C PTJIM IS THE MINIMUM TRANSVERSE MOMENTUM FOR ADDITIONAL SCATTERS
32805 C-----------------------------------------------------------------------
32806 INCLUDE 'herwig65.inc'
32807 DOUBLE PRECISION HWRGEN,HWRGET,HWRSET,WGT,PBOOST(5),RBOOST(3,3),
32808 $ WJMAX,PT,PTJIM,DUMMY,HWUPCM
32809 INTEGER IHEP,IBM,ITG,IBMN,ITGN,IBMT,ITGT,I,REPORT,NHARD,
32810 $ MYRN(2),TMPRN(2),JMUEO
32811 LOGICAL COL,FIRSTC,TMPFLG
32813 EXTERNAL HWRGEN,HWRGET,HWRSET,HWUPCM
32814 SAVE WJMAX,MYRN,NHARD
32815 DATA WJMAX,MYRN,NHARD/0,004122,7679781,0/
32816 COL(I)=I.EQ.13 .OR. I.GE.1.AND.I.LE.6 .OR. I.GE.115.AND.I.LE.120
32818 IF (IERROR.NE.0) RETURN
32819 C---RESET THE COUNTER FOR HARD SCATTERS ON THE FIRST CALL
32820 IF (FIRSTC) NHARD=0
32821 C---FIND BEAM AND TARGET REMNANTS
32822 CALL HWHREM(IBM,ITG)
32823 IF (IERROR.NE.0) RETURN
32824 C---RECALCULATE THEIR MASS CORRECTLY
32825 CALL HWUMAS(PHEP(1,IBM))
32826 CALL HWUMAS(PHEP(1,ITG))
32827 C---SET UP NEW ENTRIES IN THE EVENT RECORD
32829 CALL HWVEQU(5,PHEP(1,IBM),PHEP(1,NHEP))
32833 IF (IBMT.EQ.0) THEN
32837 JMOHEP(1,NHEP)=IBMT
32843 IDHEP(NHEP)=IDPDG(IDHW(NHEP))
32845 CALL HWVEQU(5,PHEP(1,ITG),PHEP(1,NHEP))
32849 IF (ITGT.EQ.0) THEN
32853 JMOHEP(1,NHEP)=ITGT
32859 IDHEP(NHEP)=IDPDG(IDHW(NHEP))
32860 C---BOOST TO THEIR CENTRE-OF-MASS FRAME
32861 CALL HWVSUM(4,PHEP(1,IBMN),PHEP(1,ITGN),PBOOST)
32862 CALL HWUMAS(PBOOST)
32863 DO 100 IHEP=IBMN,NHEP
32864 CALL HWULOF(PBOOST,PHEP(1,IHEP),PHEP(1,IHEP))
32866 CALL HWUROT(PHEP(1,IBMN),ONE,ZERO,RBOOST)
32867 DO 110 IHEP=IBMN,NHEP
32868 CALL HWUROF(RBOOST,PHEP(1,IHEP),PHEP(1,IHEP))
32870 C---PERFORM A SEARCH FOR THE MAXIMUM WEIGHT, IF IT IS NOT YET FOUND
32871 IF (WJMAX.EQ.0) THEN
32872 C---USING LOCAL RANDOM NUMBER SEEDS
32873 DUMMY=HWRGET(TMPRN)
32877 CALL HWHSCU(WGT,PTJIM)
32878 WJMAX=MAX(WJMAX,WGT)
32880 WRITE (6,'(A,G12.4)') ' Jimmy search for maximum weight=',WJMAX
32882 DUMMY=HWRSET(TMPRN)
32883 C---BECAUSE OF THE ENERGY DEPENDENCE, LEAVE LOTS OF SAFETY MARGIN
32886 C---GENERATE A NEW HARD SCATTERING
32888 10 CALL HWHSCU(WGT,PTJIM)
32889 IF (WGT.GT.WJMAX) THEN
32890 WRITE (6,'(A,G12.4/A,G12.4,A,G12.4)')
32891 $ ' Jimmy maximum weight exceeded! SQRT(S)=',PHEP(5,3),
32892 $ ' Increasing from ',WJMAX,' to ',WGT*2
32895 IF (WGT.LE.WJMAX*HWRGEN(0)) GOTO 10
32897 CALL HWHSCU(WGT,PTJIM)
32898 C---IF ADDING LOW PT SCATTERS TO HIGH PT EVENTS ADD AN EXTRA VETO ON
32899 C SCATTERS THAT HAPPEN TO BE HIGH PT
32901 IF (JMUEO.EQ.1) THEN
32902 C---FIRST RECONSTRUCT THE PT THAT WAS GENERATED IN THE SCATTERING
32903 PT=SQRT(PHEP(1,NHEP)**2+PHEP(2,NHEP)**2)*
32904 $ SQRT(XX(1)*XX(2))*PHEP(5,3)
32905 $ /(2*HWUPCM(PHEP(5,NHEP-2),PHEP(5,NHEP-1),PHEP(5,NHEP)))
32906 C---IF IT IS ABOVE THE TRIGGER THRESHOLD APPLY THE VETO
32907 IF (PT.GT.PTMIN) THEN
32908 IF ((NHARD+2)*HWRGEN(1).LT.1) THEN
32915 C---IF MOMENTUM CANNOT BE CONSERVED, STOP GENERATING HARD SCATTERS
32916 IF ( PHEP(4,IBMN+2) .GT. PHEP(4,IBMN).OR.
32917 $ PHEP(4,ITGN+2) .GT. PHEP(4,ITGN).OR.
32918 $ PHEP(3,IBMN+2) .GT. PHEP(3,IBMN).OR.
32919 $ -PHEP(3,ITGN+2) .GT.-PHEP(3,ITGN).OR.IERROR.NE.0) THEN
32920 IF (IERROR.GT.0) THEN
32922 $ ' THIS ERROR OCCURED DURING A SECONDARY SCATTER AND WAS',
32923 $ ' CAUGHT BY HWHSCT, SO EVENT IS NOT KILLED AFTER ALL'
32932 C---RELABEL OUTGOING REMNANTS AS INCOMING HADRONS
32937 C---SAVE THE CURRENT PROCESS TYPE, AND SWITCH TO
32938 C QCD SCATTERING TO AVOID PROBLEMS WITH THE
32945 C---PUT THE LABELS BACK
32948 C---IF THERE WERE ANY PROBLEMS, STOP GENERATING HARD SCATTERS
32949 IF (IERROR.NE.0) THEN
32950 IF (IERROR.GT.0) THEN
32952 $ ' THIS ERROR OCCURED DURING A SECONDARY SCATTER AND WAS',
32953 $ ' CAUGHT BY HWHSCT, SO EVENT IS NOT KILLED AFTER ALL'
32962 C---UNDO THE LORENTZ BOOST
32963 DO 200 IHEP=IBMN,NHEP
32964 CALL HWUROB(RBOOST,PHEP(1,IHEP),PHEP(1,IHEP))
32965 CALL HWULOB(PBOOST,PHEP(1,IHEP),PHEP(1,IHEP))
32967 C---FIND THE NEW BEAM AND TARGET REMNANTS
32970 CALL HWHREM(IBMN,ITGN)
32971 IF (IERROR.NE.0) RETURN
32972 C---CONNECT UP THE COLOUR/FLAVOUR LINES OF THE TWO SCATTERS
32973 IDHW(IBMN)=IDHW(IBM)
32974 IDHEP(IBMN)=IDHEP(IBM)
32975 IF (COL(IDHW(IBM))) THEN
32976 JMOHEP(2,JDAHEP(2,IBMN))=JMOHEP(2,IBM)
32977 JDAHEP(2,JMOHEP(2,IBM))=JDAHEP(2,IBMN)
32978 JDAHEP(2,IBMN)=JDAHEP(2,IBM)
32979 JMOHEP(2,JDAHEP(2,IBM))=IBMN
32981 JDAHEP(2,JMOHEP(2,IBMN))=JDAHEP(2,IBM)
32982 JMOHEP(2,JDAHEP(2,IBM))=JMOHEP(2,IBMN)
32983 JMOHEP(2,IBMN)=JMOHEP(2,IBM)
32984 JDAHEP(2,JMOHEP(2,IBM))=IBMN
32989 IDHW(ITGN)=IDHW(ITG)
32990 IDHEP(ITGN)=IDHEP(ITG)
32991 IF (COL(IDHW(ITG))) THEN
32992 JMOHEP(2,JDAHEP(2,ITGN))=JMOHEP(2,ITG)
32993 JDAHEP(2,JMOHEP(2,ITG))=JDAHEP(2,ITGN)
32994 JDAHEP(2,ITGN)=JDAHEP(2,ITG)
32995 JMOHEP(2,JDAHEP(2,ITG))=ITGN
32997 JDAHEP(2,JMOHEP(2,ITGN))=JDAHEP(2,ITG)
32998 JMOHEP(2,JDAHEP(2,ITG))=JMOHEP(2,ITGN)
32999 JMOHEP(2,ITGN)=JMOHEP(2,ITG)
33000 JDAHEP(2,JMOHEP(2,ITG))=ITGN
33005 C---LOOK FOR COLOUR SINGLET GLUONS (A RARE BUT ANNOYING SPECIAL CASE)
33007 IF (IDHW(IHEP).EQ.13.AND.JMOHEP(2,IHEP).EQ.IHEP) THEN
33008 CALL HWWARN('HWHSCT',120)
33013 IF (TMPFLG) NHARD=NHARD+1
33017 *CMZ :- -17/03/04 14.37.43 by Mike Seymour
33018 *-- Author : Mike Seymour
33019 C-----------------------------------------------------------------------
33020 SUBROUTINE HWHSCU(WGT,PTJIM)
33021 C-----------------------------------------------------------------------
33022 C SWAP THE HARD PROCESS GENERATION PARAMETERS,
33023 C CALL HWHQCD, AND SWAP BACK
33024 C WGT IS THE OUTPUT EVENT WEIGHT
33025 C-----------------------------------------------------------------------
33026 INCLUDE 'herwig65.inc'
33027 DOUBLE PRECISION WGT,PTJIM,XMIN,XMAX,XPOW,
33028 $ TMPXMN,TMPXMX,TMPXPW,TMPWGT
33030 COMMON/HWRPIN/XMIN,XMAX,XPOW,FIRST
33031 C---STORE THE CURRENT VALUES
33036 C---REPLACE BY NEW ONES
33038 XMAX=2*SQRT(HALF*(EBEAM1*EBEAM2+PBEAM1*PBEAM2))
33040 C---AND ENSURE THAT HWRPOW GETS REINITIALIZED
33042 C---GENERATE A PHASE SPACE POINT
33044 IF (IERROR.NE.0.OR.EVWGT.LT.0) THEN
33049 C---PUT THE OLD VALUES BACK
33054 C---AND AGAIN ENSURE THAT HWRPOW GETS REINITIALIZED
33056 C---INCLUDE GAMWT HERE
33060 *CMZ :- -20/09/95 14.59.15 by Mike Seymour
33061 *-- Author : Mike Seymour
33062 C-----------------------------------------------------------------------
33064 C PARTON-PARTON SCATTERING VIA COLOUR SINGLET
33065 C MEAN EVWGT = SIGMA IN NB
33066 C TREATS ALL PARTONS ON EQUAL FOOTING WITH HWHSNM(ID1,ID2,S,T)
33067 C PROVIDING THE MATRIX ELEMENT SQUARED FOR PARTON TYPES ID1 AND ID2
33068 C-----------------------------------------------------------------------
33069 INCLUDE 'herwig65.inc'
33071 DOUBLE PRECISION HWRGEN,HWRUNI,HWHSNM,EPS,RCS,ET,EJ,KK,KK2,
33072 & YJ1INF,YJ1SUP,Z1,YJ2INF,YJ2SUP,Z2,FACT,S,T,U,HCS
33074 PARAMETER (EPS=1.D-9)
33082 IF (KK.GE.ONE) RETURN
33083 YJ1INF=MAX( YJMIN , LOG((1.-SQRT(1.-KK2))/KK) )
33084 YJ1SUP=MIN( YJMAX , LOG((1.+SQRT(1.-KK2))/KK) )
33085 IF (YJ1INF.GE.YJ1SUP) RETURN
33086 Z1=EXP(HWRUNI(1,YJ1INF,YJ1SUP))
33087 YJ2INF=MAX( YJMIN , -LOG(2./KK-1./Z1) )
33088 YJ2SUP=MIN( YJMAX , LOG(2./KK-Z1) )
33089 IF (YJ2INF.GE.YJ2SUP) RETURN
33090 Z2=EXP(HWRUNI(2,YJ2INF,YJ2SUP))
33091 XX(1)=0.5*(Z1+Z2)*KK
33092 IF (XX(1).GE.ONE) RETURN
33093 XX(2)=XX(1)/(Z1*Z2)
33094 IF (XX(2).GE.ONE) RETURN
33095 COSTH=(Z1-Z2)/(Z1+Z2)
33096 S=XX(1)*XX(2)*PHEP(5,3)**2
33097 T=-0.5*S*(1.-COSTH)
33099 C---SET EMSCA TO HARD PROCESS SCALE (APPROX ET-JET)
33100 EMSCA=SQRT(2.*S*T*U/(S*S+T*T+U*U))
33101 FACT=GEV2NB*0.5*ET*EJ*(YJ1SUP-YJ1INF)*(YJ2SUP-YJ2INF)
33103 CALL HWSGEN(.FALSE.)
33108 IF (DISF(ID1,1).LT.EPS) GOTO 20
33110 IF (DISF(ID2,1).LT.EPS) GOTO 10
33111 HCS=HCS+FACT*DISF(ID1,1)*DISF(ID2,2)*HWHSNM(ID1,ID2,S,T)
33112 IF (GENEV.AND.HCS.GT.RCS) THEN
33113 CALL HWHQCP(ID1,ID2,3412,90)
33124 CALL HWETWO(.TRUE.,.TRUE.)
33127 *CMZ :- -20/09/95 15.28.53 by Mike Seymour
33128 *-- Author : Mike Seymour
33129 C-----------------------------------------------------------------------
33130 FUNCTION HWHSNM(ID1,ID2,S,T)
33131 C MATRIX ELEMENT SQUARED FOR COLOUR-SINGLET PARTON-PARTON SCATTERING
33132 C INCLUDES SPIN AND COLOUR AVERAGES AND SUMS.
33133 C FOR PHOTON EXCHANGE, INTERFERENCE WITH U-CHANNEL CONTRIBUTION IS
33134 C INCLUDED FOR IDENTICAL QUARKS AND LIKEWISE S-CHANNEL CONTRIBUTION
33135 C FOR IDENTICAL QUARK-ANTIQUARK PAIRS.
33136 C-----------------------------------------------------------------------
33137 INCLUDE 'herwig65.inc'
33138 DOUBLE PRECISION HWHSNM,HWUAEM,HWUALF,S,T,ASQ,AINU,AINS,Y,SOLD,
33139 $ TOLD,QQ(13,13),ZETA3
33142 C---ZETA3=RIEMANN ZETA FUNCTION(3)
33143 PARAMETER (ZETA3=1.202056903159594D0)
33144 SAVE ASQ,AINU,AINS,SOLD,TOLD,QQ
33145 DATA ASQ,AINU,AINS,SOLD,TOLD,QQ/5*0,169*-1/
33146 C---PHOTON=.TRUE. FOR PHOTON EXCHANGE, .FALSE. FOR MUELLER-TANG
33147 PHOTON=MOD(IPROC,100).GE.50
33148 C---QQ CACHES THE KINEMATIC-INDEPENDENT FACTORS, TO MAKE IT RUN FASTER
33149 C (BEARING IN MIND THAT THIS ROUTINE IS CALLED 169 TIMES PER EVENT)
33150 IF (QQ(ID1,ID2).LT.ZERO) THEN
33152 IF (ID1.EQ.13.OR.ID2.EQ.13) THEN
33155 QQ(ID1,ID2)=(QFCH(MOD(ID1-1,6)+1)*QFCH(MOD(ID2-1,6)+1))**2
33159 IF (ID1.EQ.13.AND.ID2.EQ.13) THEN
33160 QQ(ID1,ID2)=CAFAC**4
33161 ELSEIF (ID1.EQ.13.OR.ID2.EQ.13) THEN
33162 QQ(ID1,ID2)=(CAFAC*CFFAC)**2
33164 QQ(ID1,ID2)=CFFAC**4
33166 QQ(ID1,ID2)=QQ(ID1,ID2)*
33167 $ PIFAC**3/(4*(3.5*ASFIXD*CAFAC*ZETA3)**3)
33171 C---THE KINEMATIC-DEPENDENT PART IS ALSO CACHED
33172 IF (S.NE.SOLD.OR.T.NE.TOLD) THEN
33175 ASQ=2*(S**2+(S+T)**2)/T**2*AINS
33176 AINU=-4*S/T*AINS/NCOLO
33177 AINS=4*AINS/NCOLO-AINU
33180 ASQ=HWUALF(1,EMSCA)**4*(S/T)**2*EXP(2*OMEGA0*Y)/Y**3
33185 C---THE FINAL ANSWER IS JUST THEIR PRODUCT
33186 IF (ID1.EQ.ID2) THEN
33187 HWHSNM=QQ(ID1,ID2)*(ASQ+AINU)
33188 ELSEIF (ABS(ID1-ID2).EQ.6) THEN
33189 HWHSNM=QQ(ID1,ID2)*(ASQ+AINS)
33191 HWHSNM=QQ(ID1,ID2)*ASQ
33195 *CMZ :- -01/10/01 19.41.18 by Peter Richardson
33196 *-- Author : Peter Richardson
33197 C-----------------------------------------------------------------------
33199 C-----------------------------------------------------------------------
33200 C Calculates the spin correlations for the hard process
33201 C-----------------------------------------------------------------------
33202 INCLUDE 'herwig65.inc'
33204 PARAMETER(NDIAHD=10)
33205 DOUBLE COMPLEX ZI,S,D,ME(2,2,2,2,NCFMAX),MED(2,2,2,2),F3(2,2,8),
33206 & F4(2,2,8),F3M(2,2,8),F4M(2,2,8),FTP(2,2,8,8),FTM(2,2,8,8),
33207 & FUP(2,2,8,8),FUM(2,2,8,8),FST(2,2,8)
33208 DOUBLE PRECISION P(5,4),A(2,NDIAHD),B(2,NDIAHD),XMASS,PLAB,
33209 & PRW,PCM,MS(NDIAHD),MWD(NDIAHD),MR(NDIAHD),HWULDO,EE,
33210 & PREF(5),EPS,N(3),HWVDOT,PP,PRE,SH,TH,UH,PM(5,4),DIJ(2,2),
33211 & MA(4),MA2(4),PTMP(5),WGT,WGTB(NCFMAX),WGTC,HWRGEN
33212 INTEGER ICM,IHEP,IST,JHEP,KHEP,ID,LHEP,MHEP,IK,IL,IM,IJ,L1,L2,I,J,
33213 & IDP(4+NDIAHD),DRTYPE(NDIAHD),NDIA,P1,P2,P3,P4,IFLOW(NDIAHD),
33214 & ID1,ID2,III,JJJ,KKK,O(2),LLL,MMM
33215 DOUBLE PRECISION SW,CW,TW,E,G,RT,ORT,MW,MZ,GS,AFN(2,12,2,4),
33216 & AFG(2,6,2),AFC(2,12,2,2),OIJ(2,4,2),OIJP(2,2,2),OIJPP(2,4,4),
33217 & HNN(2,3,4,4),HCC(2,3,2,2),HNC(2,4,2),HFF(2,4,12),HWW(2),
33218 & HZZ(2),ZAB(12,2,2),HHB(2,3),HWUAEM
33219 COMMON /HWSPNC/ SW,CW,TW,E,G,RT,ORT,MW,MZ,GS,AFN,AFG,AFC,OIJ,OIJP,
33220 & OIJPP,HNN,HCC,HNC,HFF,HWW,HZZ,ZAB,HHB
33223 PARAMETER(ZI=(0.0D0,1.0D0))
33224 COMMON/HWHEWS/S(8,8,2),D(8,8)
33225 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
33226 & MA2,SH,TH,UH,IDP,DRTYPE
33227 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
33228 PARAMETER(EPS=1D-20)
33229 EXTERNAL HWULDO,HWVDOT,HWRGEN
33230 SAVE PREF,DIJ,O,FIRST
33231 DATA PREF/1.0D0,0.0D0,0.0D0,1.0D0,0.0D0/
33232 DATA DIJ/1.0D0,0.0D0,0.0D0,1.0D0/
33235 IF(IERROR.NE.0) RETURN
33240 C--search the event record for the hard process
33243 IF(IST.EQ.110.OR.IST.EQ.120) THEN
33248 C--now decide whether or not to perform spin correlation
33249 2 KHEP = JDAHEP(1,ICM)
33251 JHEP = JDAHEP(2,ICM)
33253 IF(JHEP-KHEP+1.NE.2) CALL HWWARN('HWHSPN',500)
33255 DO 3 IHEP=KHEP,JHEP
33257 IF(RSPIN(ID).EQ.0.5D0) SPIN=.TRUE.
33259 IF(.NOT.SPIN) RETURN
33260 IF((RSPIN(IDHW(KHEP)).EQ.ONE.AND.RSPIN(IDHW(JHEP)).EQ.ZERO).OR.
33261 & (RSPIN(IDHW(KHEP)).EQ.ZERO.AND.RSPIN(IDHW(JHEP)).EQ.ONE)) RETURN
33262 LHEP = JMOHEP(1,ICM)
33263 MHEP = JMOHEP(2,ICM)
33264 C--now identify the hard process
33265 C--SM processes first
33266 C--fermion-antifermion production in lepton-lepton collisions
33267 C--or via Z/gamma in hadron-hadron collisions
33268 IF(IPRO.EQ.1.OR.IPRO.EQ.13) THEN
33269 C--only need spin correlations for top and tau production
33270 IF((IK.EQ. 6.AND.IJ.EQ. 12).OR.(IK.EQ. 12.AND.IJ.EQ.6 ).OR.
33271 & (IK.EQ.125.AND.IJ.EQ.131).OR.(IK.EQ.131.AND.IJ.EQ.125)) THEN
33272 C--check fermion first and change order if not
33273 IF(IDHEP(LHEP).LT.0) THEN
33278 C--Id's of the incoming and outgoing fermions
33280 ID1 = IL-6*INT((IL-1)/6)+10*INT((IL-1)/120)
33281 ID2 = IK-6*INT((IK-1)/6)+10*INT((IK-1)/120)
33282 C--couplings for the diagrams
33283 C--first the photon exchange
33284 A(1,1) = -QFCH(ID1)
33285 A(2,1) = -QFCH(ID1)
33286 B(1,1) = -QFCH(ID2)
33287 B(2,1) = -QFCH(ID2)
33290 C--then the Z exchange
33291 A(1,2) = -RFCH(ID1)
33292 A(2,2) = -LFCH(ID1)
33293 B(1,2) = -RFCH(ID2)
33294 B(2,2) = -LFCH(ID2)
33297 C--setup the colour flow
33300 SPNCFC(1,1,1) = ONE
33306 C--fermion-antifermion via s-channel W in hadron-hadron
33307 ELSEIF(IPRO.EQ.14) THEN
33308 IF(IK.EQ. 6.OR.IK.EQ. 12.OR.IJ.EQ. 6.OR.IJ.EQ. 12.OR.
33309 & IK.EQ.125.OR.IJ.EQ.131.OR.IK.EQ.131.OR.IJ.EQ.125) THEN
33310 C--check fermion first and reorder if not
33311 IF(IDHEP(LHEP).LT.0) THEN
33316 C--couplings for the diagram
33325 SPNCFC(1,1,1) = ONE
33330 C--top quark production via QCD
33331 ELSEIF(IPRO.EQ.15.OR.IPRO.EQ.17) THEN
33332 IF((IK.EQ.6.AND.IJ.EQ.12).OR.(IK.EQ.12.AND.IJ.EQ.6)) THEN
33333 C--check if the outgoing fermion is first and change order if not
33334 IF(IDHEP(KHEP).LT.0) THEN
33339 C--quark-quark to t tbar
33340 IF(IDHW(LHEP).LE.12.AND.IDHW(MHEP).LE.12) THEN
33341 C--first check the incoming fermion is first and change order if not
33342 IF(IDHEP(LHEP).LT.0) THEN
33348 C--couplings for the diagram
33356 C--setup the colour flow
33358 SPNCFC(1,1,1) = TWO/9.0D0
33360 C--gluon-gluon to t tbar
33361 ELSEIF(IDHW(LHEP).EQ.13.AND.IDHW(MHEP).EQ.13) THEN
33362 C--setup the diagrams
33372 C--setup the colour flow
33378 SPNCFC(1,1,1) = 0.25D0/THREE
33379 SPNCFC(2,2,1) = SPNCFC(1,1,1)
33380 SPNCFC(1,2,1) = ONE/THREE/32.0D0
33381 SPNCFC(2,1,1) = ONE/THREE/32.0D0
33382 C--incorrect initial state
33384 CALL HWWARN('HWHSPN',501)
33386 C--don't need spin correlations haven't produced top
33390 C--single top quark production in hadron collisions
33391 ELSEIF(IPRO.EQ.20) THEN
33392 C--change order if b quark not first and identify incoming particles
33393 IF(ABS(IDHEP(LHEP)).NE.5) THEN
33400 C--change order if t quark not first
33401 IF(ABS(IDHEP(KHEP)).NE.6) THEN
33406 C--identify diagram type
33408 IF(IL.GT.0.AND.IM.GT.0) THEN
33410 C--fermion antifermion
33411 ELSEIF(IL.GT.0.AND.IM.LT.0) THEN
33413 C--antifermion fermion
33414 ELSEIF(IL.LT.0.AND.IM.GT.0) THEN
33416 C--antifermion antifermion
33417 ELSEIF(IL.LT.0.AND.IM.LT.0) THEN
33419 C--incorrect initial state
33421 CALL HWWARN('HWHSPN',502)
33428 C--virtual particle etc
33432 SPNCFC(1,1,1) = ONE
33434 C--SUSY particle production
33435 ELSEIF(IPRO.EQ.7.OR.IPRO.EQ.30) THEN
33436 IF(MOD(IPROC,10000).GT.3030) RETURN
33437 C--fermion-antifermion to neutralino neutralino
33438 IF(IK.GE.450.AND.IK.LE.453.AND.IJ.GE.450.AND.IJ.LE.453) THEN
33439 C--first check the fermion is first and change order if not
33440 IF(IDHEP(LHEP).LT.0) THEN
33447 C--couplings of the various diagrams
33450 ID = IL-6*INT((IL-1)/6)+10*INT((IL-1)/120)
33451 C--couplings for the Z exchange diagram
33454 B(2,1) = HALF*(-ZMIXSS(L1,3)*ZMIXSS(L2,3)
33455 & +ZMIXSS(L1,4)*ZMIXSS(L2,4))/SW/CW
33457 B(2,1) = B(2,1)*ZSGNSS(L1)*ZSGNSS(L2)
33460 C--couplings for the t-channel diagrams
33462 A(2,2) =-RT*SLFCH(ID,L1)
33463 B(1,2) =-RT*SLFCH(ID,L2)
33465 IDP(6) = IL-6*INT((IL-1)/6)+24*INT((IL-1)/120)+400
33466 A(1,3) =-RT*SRFCH(ID,L1)*ZSGNSS(L1)
33469 B(2,3) =-RT*SRFCH(ID,L2)*ZSGNSS(L2)
33470 IDP(7) = IL-6*INT((IL-1)/6)+24*INT((IL-1)/120)+412
33473 C--couplings for the u-channel diagrams
33475 A(2,4) =-RT*SLFCH(ID,L2)*ZSGNSS(L2)
33476 B(1,4) =-RT*SLFCH(ID,L1)*ZSGNSS(L1)
33479 A(1,5) =-RT*SRFCH(ID,L2)
33482 B(2,5) =-RT*SRFCH(ID,L1)
33487 C--setup the colour flow
33489 SPNCFC(1,1,1) = ONE
33495 C--chargino pair production
33496 ELSEIF(IK.GE.454.AND.IK.LE.457.AND.IJ.GE.454.AND.IJ.LE.457) THEN
33497 C--first check the fermion is first and change order if not
33498 IF(IDHEP(LHEP).LT.0) THEN
33505 C--couplings of the various diagrams
33506 L1 = IK-453-2*INT((IK-454)/2)
33507 L2 = IJ-453-2*INT((IJ-454)/2)
33508 ID = IL-6*INT((IL-1)/6)+10*INT((IL-1)/120)
33509 C--couplings for the s-channel photon exchange
33512 B(1,1) = -DIJ(L1,L2)
33513 B(2,1) = -DIJ(L1,L2)
33516 C--couplings for the s-channel Z exchange
33519 B(1,2) =(-WMXUSS(L1,1)*WMXUSS(L2,1)
33520 & -HALF*WMXUSS(L1,2)*WMXUSS(L2,2)+DIJ(L1,L2)*SWEIN)/CW/SW
33521 B(2,2) =WSGNSS(L1)*WSGNSS(L2)*(-WMXVSS(L1,1)*WMXVSS(L2,1)
33522 & -HALF*WMXVSS(L1,2)*WMXVSS(L2,2)+DIJ(L1,L2)*SWEIN)/CW/SW
33525 C--couplings for the t-channel diagram
33526 IF(IDHEP(KHEP).GT.0.AND.MOD(IL,2).EQ.0) THEN
33528 A(2,3) =-WMXUSS(L1,1)/SW
33529 B(1,3) =-WMXUSS(L2,1)/SW
33532 ELSEIF(IDHEP(KHEP).LT.0.AND.MOD(IL,2).NE.0) THEN
33533 A(1,3) =-WMXVSS(L1,1)*WSGNSS(L1)/SW
33536 B(2,3) =-WMXVSS(L2,1)*WSGNSS(L2)/SW
33538 ELSEIF(IDHEP(KHEP).GT.0.AND.MOD(IL,2).NE.0) THEN
33540 A(2,3) =-WMXVSS(L2,1)*WSGNSS(L2)/SW
33541 B(1,3) =-WMXVSS(L1,1)*WSGNSS(L1)/SW
33545 A(1,3) =-WMXUSS(L2,1)/SW
33548 B(2,3) =-WMXUSS(L1,1)/SW
33551 IDP(7) = IL-6*INT((IL-1)/6)+24*INT((IL-1)/120)+400
33554 C--setup the colour flow
33556 SPNCFC(1,1,1) = ONE
33560 C--chargino neutralino production
33561 ELSEIF((IK.GE.454.AND.IK.LE.457.AND.IJ.GE.450.AND.IJ.LE.453).OR.
33562 & (IJ.GE.454.AND.IJ.LE.457.AND.IK.GE.450.AND.IK.LE.453)) THEN
33563 C--first check the fermion is first and change order if not
33564 IF(IDHEP(LHEP).LT.0) THEN
33571 C--change order of outgoing particles if negative chargino
33572 IF(IDHEP(KHEP).LT.0) THEN
33577 L1 = IK-453-2*INT((IK-454)/2)
33581 IF(IDHEP(JHEP).GT.0) THEN
33586 L1 = IJ-453-2*INT((IJ-454)/2)
33589 C--first the W exchange diagram
33592 B(1,1) =( ORT*ZMXNSS(L2,3)*WMXUSS(L1,2)
33593 & +ZMXNSS(L2,2)*WMXUSS(L1,1))/SW
33594 B(2,1) =WSGNSS(L1)*ZSGNSS(L2)*(-ORT*ZMXNSS(L2,4)*WMXVSS(L1,2)
33595 & +ZMXNSS(L2,2)*WMXVSS(L1,1))/SW
33598 C--intermediate particles for the t and u channel diagrams
33603 IF(MOD(IL,2).EQ.0) THEN
33605 A(2,2) =-WMXUSS(L1,1)/SW
33606 B(1,2) =-RT*SLFCH(IM-6,L2)
33610 A(2,3) =-RT*ZSGNSS(L2)*SLFCH(IL,L2)
33611 B(1,3) =-WSGNSS(L1)*WMXVSS(L1,1)/SW
33616 A(2,2) =-WSGNSS(L1)*WMXVSS(L1,1)/SW
33617 B(1,2) =-RT*ZSGNSS(L2)*SLFCH(IM-6,L2)
33621 A(2,3) =-RT*SLFCH(IL,L2)
33622 B(1,3) =-WMXUSS(L1,1)/SW
33626 C--setup the colour flow
33629 SPNCFC(1,1,1) = ONE
33633 C--neutralino gluino production
33634 ELSEIF((IK.EQ.449.AND.IJ.GE.450.AND.IJ.LE.453).OR.
33635 & (IJ.EQ.449.AND.IK.GE.450.AND.IK.LE.453)) THEN
33636 C--first check the fermion is first and change order if not
33637 IF(IDHEP(LHEP).LT.0) THEN
33642 C--check neutralino first and change order if not
33652 C--coupling for the diagrams
33653 C--first t-channel squark exchange
33656 A(2,1) =-RT*SLFCH(IL,L1)
33661 A(1,2) =-RT*ZSGNSS(L1)*SRFCH(IL,L1)
33666 C--then u-channel s squark exchange
33670 B(1,3) =-RT*ZSGNSS(L1)*SLFCH(IL,L1)
33677 B(2,4) =-RT*SRFCH(IL,L1)
33679 C--colour flow information
33686 SPNCFC(1,1,1) = ONE
33687 C--chargino gluino production
33688 ELSEIF((IK.GE.454.AND.IK.LE.457.AND.IJ.EQ.449).OR.
33689 & (IJ.GE.454.AND.IJ.LE.457.AND.IK.EQ.449)) THEN
33690 C--first check the fermion is first and change order if not
33691 IF(IDHEP(LHEP).LT.0) THEN
33696 C--check chargino first and change order if not
33698 L1 = IJ-453-2*INT((IJ-454)/2)
33703 L1 = IK-453-2*INT((IK-454)/2)
33709 IF(MOD(IL,2).EQ.0) THEN
33711 A(2,1) =-WMXUSS(L1,1)/SW
33717 B(1,2) =-WSGNSS(L1)*WMXVSS(L1,1)/SW
33722 A(2,1) =-WSGNSS(L1)*WMXVSS(L1,1)/SW
33728 B(1,2) =-WMXUSS(L1,1)/SW
33732 C--setup the colour flow
33735 SPNCFC(1,1,1) = ONE
33738 C--quark quark to gluino gluino
33739 ELSEIF(IJ.EQ.449.AND.IK.EQ.449.AND.
33740 & IDHW(LHEP).LE.12.AND.IDHW(MHEP).LE.12) THEN
33741 C--change order if antiquark first
33742 IF(IDHEP(LHEP).LT.0) THEN
33748 C--couplings of the various diagrams
33770 C--intermediate particles
33777 C--types of diagram
33785 C--setup the colour flow
33787 SPNCFC(1,1,1) = 8.0D0/27.0D0
33788 SPNCFC(2,2,1) = 8.0D0/27.0D0
33789 SPNCFC(1,2,1) =-ONE/27.0D0
33790 SPNCFC(2,1,1) =-ONE/27.0D0
33797 C--gluon gluon to gluino gluino
33798 ELSEIF(IDHW(LHEP).EQ.13.AND.IDHW(MHEP).EQ.13.AND.IJ.EQ.449
33799 & .AND.IK.EQ.449) THEN
33800 C--setup the diagrams
33810 C--setup the colour flow
33816 SPNCFC(1,1,1) = 9.0D0/16.0D0
33817 SPNCFC(2,2,1) = SPNCFC(1,1,1)
33818 SPNCFC(1,2,1) =-9.0D0/32.0D0
33819 SPNCFC(2,1,1) =-9.0D0/32.0D0
33820 C--neutralino squark production
33821 ELSEIF( (IK.GE.450.AND.IK.LE.453.AND.
33822 & ((IJ.GE.401.AND.IJ.LE.406).OR.(IJ.GE.413.AND.IJ.LE.418)))
33823 & .OR.(IJ.GE.450.AND.IJ.LE.453.AND.
33824 & ((IK.GE.401.AND.IK.LE.406).OR.(IK.GE.413.AND.IK.LE.418))))
33826 C--change order if gluon first
33827 IF(IDHW(LHEP).EQ.13) THEN
33832 C--change order in squark first
33842 C--left handed (lighter) squark
33844 A(1,1) =-RT*SRFCH(IL,L1)*QMIXSS(IL,2,1)
33845 A(2,1) =-RT*ZSGNSS(L1)*SLFCH(IL,L1)*QMIXSS(IL,1,1)
33846 C--right handed (heavier) squark
33847 ELSEIF(IJ.GT.412) THEN
33848 A(1,1) =-RT*SRFCH(IL,L1)*QMIXSS(IL,2,2)
33849 A(2,1) =-RT*ZSGNSS(L1)*SLFCH(IL,L1)*QMIXSS(IL,1,2)
33855 C--colour flow info
33860 SPNCFC(1,1,1) = HALF/THREE
33863 C--neutralino antisquark production
33864 ELSEIF( (IK.GE.450.AND.IK.LE.453.AND.
33865 & ((IJ.GE.407.AND.IJ.LE.412).OR.(IJ.GE.419.AND.IJ.LE.424)))
33866 & .OR.(IJ.GE.450.AND.IJ.LE.453.AND.
33867 & ((IK.GE.407.AND.IK.LE.412).OR.(IK.GE.419.AND.IK.LE.424))))
33869 C--change order if gluon first
33870 IF(IDHW(LHEP).EQ.13) THEN
33875 C--change order in squark first
33885 C--left handed (lighter) squark
33887 A(1,1) =-RT*ZSGNSS(L1)*SLFCH(IL,L1)*QMIXSS(IL,1,1)
33888 A(2,1) =-RT*SRFCH(IL,L1)*QMIXSS(IL,2,1)
33889 C--right handed (heavier) squark
33890 ELSEIF(IJ.GT.412) THEN
33891 A(1,1) =-RT*ZSGNSS(L1)*SLFCH(IL,L1)*QMIXSS(IL,1,2)
33892 A(2,1) =-RT*SRFCH(IL,L1)*QMIXSS(IL,2,2)
33898 C--colour flow info
33903 SPNCFC(1,1,1) = HALF/THREE
33907 ELSEIF((IK.GE.454.AND.IK.LE.457.AND.
33908 & ((IJ.GE.401.AND.IJ.LE.406).OR.(IJ.GE.413.AND.IJ.LE.418)))
33909 & .OR.(IJ.GE.454.AND.IJ.LE.457.AND.
33910 & ((IK.GE.401.AND.IK.LE.406).OR.(IK.GE.413.AND.IK.LE.418))))
33912 C--change order if gluon first
33913 IF(IDHW(LHEP).EQ.13) THEN
33918 C--change order if squark first
33927 L1 = IK-453-2*INT((IK-454)/2)
33928 C--left handed (lighter) squark
33931 IF(MOD(IL,2).EQ.0) THEN
33932 A(2,1) = -WMXUSS(L1,1)*QMIXSS(IL-1,1,1)/SW
33934 A(2,1) = -WSGNSS(L1)*WMXVSS(L1,1)*QMIXSS(IL+1,1,1)/SW
33936 C--right handed (heavier) squark
33937 ELSEIF(IJ.GT.412) THEN
33938 IF(MOD(IL,2).EQ.0) THEN
33939 A(2,1) = -WMXUSS(L1,1)*QMIXSS(IL-1,1,2)/SW
33941 A(2,1) = -WSGNSS(L1)*WMXVSS(L1,1)*QMIXSS(IL+1,1,2)/SW
33948 C--colour flow info
33953 SPNCFC(1,1,1) = HALF/THREE
33956 C--chargino antisquark
33957 ELSEIF((IK.GE.454.AND.IK.LE.457.AND.
33958 & ((IJ.GE.407.AND.IJ.LE.412).OR.(IJ.GE.419.AND.IJ.LE.424)))
33959 & .OR.(IJ.GE.454.AND.IJ.LE.457.AND.
33960 & ((IK.GE.407.AND.IK.LE.412).OR.(IK.GE.419.AND.IK.LE.424))))
33962 C--change order if gluon first
33963 IF(IDHW(LHEP).EQ.13) THEN
33968 C--change order in squark first
33977 L1 = IK-453-2*INT((IK-454)/2)
33978 C--left handed (lighter) squark
33981 IF(MOD(IL,2).EQ.0) THEN
33982 A(1,1) = -WMXUSS(L1,1)*QMIXSS(IL-1,1,1)/SW
33984 A(1,1) = -WSGNSS(L1)*WMXVSS(L1,1)*QMIXSS(IL+1,1,1)/SW
33986 C--right handed (heavier) squark
33987 ELSEIF(IJ.GT.412) THEN
33988 IF(MOD(IL,2).EQ.0) THEN
33989 A(1,1) = -WMXUSS(L1,1)*QMIXSS(IL-1,1,2)/SW
33991 A(1,1) = -WMXVSS(L1,1)*QMIXSS(IL+1,1,2)/SW
33998 C--colour flow info
34003 SPNCFC(1,1,1) = ONE
34006 C--squark gluino production
34007 ELSEIF((IK.EQ.449.AND.((IJ.GE.401.AND.IJ.LE.406)
34008 & .OR.(IJ.GE.413.AND.IJ.LE.418)))
34009 & .OR.(IJ.GE.449.AND.((IK.GE.401.AND.IK.LE.406)
34010 & .OR.(IK.GE.413.AND.IK.LE.418)))) THEN
34011 C--change order if gluon first
34012 IF(IDHW(LHEP).EQ.13) THEN
34018 C--change order in squark first
34025 ID = INT((IJ-401)/12)+1
34052 SPNCFC(1,1,1) = 2.0D0/9.0D0
34053 SPNCFC(2,2,1) = 2.0D0/9.0D0
34054 SPNCFC(1,2,1) = -0.25D0/9.0D0
34055 SPNCFC(2,1,1) = -0.25D0/9.0D0
34056 C--antisquark gluino production
34057 ELSEIF((IK.GE.449..AND.((IJ.GE.407.AND.IJ.LE.412)
34058 & .OR.(IJ.GE.419.AND.IJ.LE.424)))
34059 & .OR.(IJ.GE.449.AND.((IK.GE.407.AND.IK.LE.412)
34060 & .OR.(IK.GE.419.AND.IK.LE.424)))) THEN
34061 C--change order if gluon first
34062 IF(IDHW(LHEP).EQ.13) THEN
34068 C--change order in squark first
34075 ID = INT((IJ-401)/12)+1
34102 SPNCFC(1,1,1) = 2.0D0/9.0D0
34103 SPNCFC(2,2,1) = 2.0D0/9.0D0
34104 SPNCFC(1,2,1) = -0.25D0/9.0D0
34105 SPNCFC(2,1,1) = -0.25D0/9.0D0
34106 C--unrecognised SUSY process
34108 CALL HWWARN('HWHSPN',503)
34111 ELSEIF(IPRO.EQ.8) THEN
34112 C--neutralino antineutrino production
34113 IF(IK.GE.450.AND.IK.LE.453.AND.
34114 & IJ.GE.127.AND.IJ.LE.132.AND.MOD(IJ,2).EQ.0) THEN
34115 C--ensure lepton first
34116 IF(IDHEP(LHEP).LT.0) THEN
34123 JJJ = (IDHW(LHEP)-119)/2
34124 KKK = (IDHW(MHEP)-125)/2
34128 IDP(5+I) = 423+2*JJJ+(I-1)*12
34129 11 IDP(7+I) = 423+2*KKK+(I-1)*12
34130 C--types of diagram
34138 A(2,1) = -LAMDA1(III,JJJ,KKK)
34141 B(2,I+1) = -LMIXSS(2*JJJ-1,1,I)*LAMDA1(III,JJJ,KKK)
34143 12 A(2,I+3) = -LMIXSS(2*KKK-1,2,I)*LAMDA1(III,JJJ,KKK)
34146 B(J,1) = AFN(O(J),2*III+6,1,L1)
34148 A(J,I+1) = AFN(O(J),2*JJJ+5,I,L1)
34149 13 B(J,I+3) = AFN( J ,2*KKK+5,I,L1)
34155 SPNCFC(1,1,1) = ONE
34156 C--neutralino neutrino production
34157 ELSEIF(IK.GE.450.AND.IK.LE.453.AND.
34158 & IJ.GE.121.AND.IJ.LE.126.AND.MOD(IJ,2).EQ.0) THEN
34159 C--ensure lepton first
34160 IF(IDHEP(LHEP).LT.0) THEN
34167 JJJ = (IDHW(MHEP)-125)/2
34168 KKK = (IDHW(LHEP)-119)/2
34172 IDP(5+I) = 423+2*JJJ+(I-1)*12
34173 15 IDP(7+I) = 423+2*KKK+(I-1)*12
34174 C--types of diagram
34181 A(1,1) = -LAMDA1(III,JJJ,KKK)
34184 B(1,I+1) = -LMIXSS(2*JJJ-1,1,I)*LAMDA1(III,JJJ,KKK)
34186 A(1,I+3) = -LMIXSS(2*KKK-1,2,I)*LAMDA1(III,JJJ,KKK)
34190 B(J,1) = AFN( J ,2*III+6,1,L1)
34192 A(J,I+1) = AFN( J ,2*JJJ+5,I,L1)
34193 17 B(J,I+3) = AFN(O(J),2*KKK+5,I,L1)
34199 SPNCFC(1,1,1) = ONE
34200 C--chargino antilepton
34201 ELSEIF(IK.GE.456.AND.IK.LE.457.AND.
34202 & IJ.GE.127.AND.IJ.LE.132.AND.MOD(IJ,2).EQ.1) THEN
34203 C--ensure lepton first
34204 IF(IDHEP(LHEP).LT.0) THEN
34211 JJJ = (IDHW(LHEP)-119)/2
34212 KKK = (IDHW(MHEP)-125)/2
34218 A(2,1) = LAMDA1(III,JJJ,KKK)
34220 B(2,2) =-LAMDA1(III,JJJ,KKK)
34223 B(J,1) = AFC(O(J),2*III+6,1,L1)
34224 19 A(J,2) = AFC(O(J),2*JJJ+6,1,L1)
34232 SPNCFC(1,1,1) = ONE
34234 ELSEIF(IK.GE.454.AND.IK.LE.455.AND.
34235 & IJ.GE.121.AND.IJ.LE.126.AND.MOD(IJ,2).EQ.1) THEN
34236 C--ensure lepton first
34237 IF(IDHEP(LHEP).LT.0) THEN
34244 JJJ = (IDHW(MHEP)-125)/2
34245 KKK = (IDHW(LHEP)-119)/2
34250 A(1,1) = LAMDA1(III,JJJ,KKK)
34252 B(1,2) =-LAMDA1(III,JJJ,KKK)
34256 B(J,1) = AFC(J,2*III+6,1,L1)
34257 21 A(J,2) = AFC(J,2*JJJ+6,1,L1)
34265 SPNCFC(1,1,1) = ONE
34267 ELSEIF(IK.GE.121.AND.IK.LE.132.AND.MOD(IK,2).EQ.1.AND.
34268 & IJ.GE.121.AND.IJ.LE.132.AND.MOD(IJ,2).EQ.1) THEN
34269 C--ensure incoming lepton first
34270 IF(IDHEP(LHEP).LT.0) THEN
34275 C--ensure outgoing lepton first
34276 IF(IDHEP(KHEP).LT.0) THEN
34284 C--only need the correlations for tau production
34285 IF(IK.NE.125.AND.IJ.NE.131) RETURN
34286 C--find the RPV indices
34287 III = (IDHW(LHEP)-119)/2
34291 EE = SQRT(HWUAEM(SH)*FOUR*PIFAC)
34292 C--s-channel photon and Z exchange if needed
34293 IF(KKK.EQ.LLL) THEN
34298 A(1,1) = -EE*QFCH(ID1)
34299 A(2,1) = -EE*QFCH(ID1)
34300 B(1,1) = -EE*QFCH(ID2)
34301 B(2,1) = -EE*QFCH(ID2)
34304 C--then the Z exchange
34305 A(1,2) = -EE*RFCH(ID1)
34306 A(2,2) = -EE*LFCH(ID1)
34307 B(1,2) = -EE*RFCH(ID2)
34308 B(2,2) = -EE*LFCH(ID2)
34313 C--s-channel sneutrino exchange
34314 IF(ABS(LAMDA1(III,JJJ,III)*LAMDA1(LLL,JJJ,KKK)).GT.EPS) THEN
34317 IDP(NDIA+4) = 424+2*JJJ
34318 A(1,NDIA) = LAMDA1(III,JJJ,III)
34321 B(2,NDIA) = LAMDA1(LLL,JJJ,KKK)
34323 C--s-channel antisneutrino exchange
34324 IF(ABS(LAMDA1(III,JJJ,III)*LAMDA1(KKK,JJJ,LLL)).GT.EPS) THEN
34327 IDP(NDIA+4) = 424+2*JJJ
34329 A(2,NDIA) = LAMDA1(III,JJJ,III)
34330 B(1,NDIA) = LAMDA1(KKK,JJJ,LLL)
34333 C--t-channel sneutrino exchange
34334 IF(ABS(LAMDA1(KKK,JJJ,III)*LAMDA1(LLL,JJJ,III)).GT.EPS) THEN
34337 IDP(NDIA+4) = 424+2*JJJ
34338 A(1,NDIA) = LAMDA1(KKK,JJJ,III)
34341 B(2,NDIA) = LAMDA1(LLL,JJJ,III)
34343 C--t-channel antisneutrino exchange
34344 IF(ABS(LAMDA1(III,JJJ,KKK)*LAMDA1(III,JJJ,LLL)).GT.EPS) THEN
34347 IDP(NDIA+4) = 424+2*JJJ
34349 A(2,NDIA) = LAMDA1(III,JJJ,KKK)
34350 B(1,NDIA) = LAMDA1(III,JJJ,LLL)
34354 C--setup the colour flow
34356 SPNCFC(1,1,1) = ONE
34359 C--d dbar production
34360 ELSEIF(IK.LE.12.AND.IK.LE.12.AND.
34361 & MOD(IJ,2).EQ.1.AND.MOD(IK,2).EQ.1) THEN
34362 C--can't produce quark which decays before hadronization
34364 C--unrecognised process
34366 CALL HWWARN('HWHSPN',504)
34369 ELSEIF(IPRO.EQ.40) THEN
34370 C--change outgoing order
34377 C--neutrino neutralino production
34378 IF(IK.GE.450.AND.IK.LE.453.AND.MOD(IJ,2).EQ.0.AND.
34379 & IDPDG(IJ).GT.0) THEN
34380 C--change order if antiparticle first
34381 IF(IDHEP(LHEP).LT.0) THEN
34386 C--indices for RPV coupling
34388 JJJ = (IDHW(MHEP)-5)/2
34389 KKK = (IDHW(LHEP)+1)/2
34393 IDP(5+I) = 399+2*JJJ+(I-1)*12
34394 25 IDP(7+I) = 399+2*KKK+(I-1)*12
34395 C--types of diagram
34402 A(1,1) = -LAMDA2(III,JJJ,KKK)
34405 B(1,I+1) = -QMIXSS(2*JJJ-1,1,I)*LAMDA2(III,JJJ,KKK)
34407 A(1,I+3) = -QMIXSS(2*KKK-1,2,I)*LAMDA2(III,JJJ,KKK)
34411 B(J,1) = AFN( J ,2*III+6,1,L1)
34413 A(J,I+1) = AFN( J ,2*JJJ-1,I,L1)
34414 27 B(J,I+3) = AFN(O(J),2*KKK-1,I,L1)
34420 SPNCFC(1,1,1) = ONE/THREE
34421 C--antineutrino neutralino production
34422 ELSEIF(IK.GE.450.AND.IK.LE.453.AND.MOD(IJ,2).EQ.0.AND.
34423 & IDPDG(IJ).LT.0) THEN
34424 C--change order if antiparticle first
34425 IF(IDHEP(LHEP).LT.0) THEN
34430 C--indices for RPV coupling
34432 JJJ = (IDHW(LHEP)+1)/2
34433 KKK = (IDHW(MHEP)-5)/2
34437 IDP(5+I) = 399+2*JJJ+(I-1)*12
34438 29 IDP(7+I) = 399+2*KKK+(I-1)*12
34439 C--types of diagram
34447 A(2,1) = -LAMDA2(III,JJJ,KKK)
34450 B(2,I+1) = -QMIXSS(2*JJJ-1,1,I)*LAMDA2(III,JJJ,KKK)
34452 30 A(2,I+3) = -QMIXSS(2*KKK-1,2,I)*LAMDA2(III,JJJ,KKK)
34455 B(J,1) = AFN(O(J),2*III+6,1,L1)
34457 A(J,I+1) = AFN(O(J),2*JJJ-1,I,L1)
34458 31 B(J,I+3) = AFN( J ,2*KKK-1,I,L1)
34464 SPNCFC(1,1,1) = ONE/THREE
34465 C--lepton neutralino production
34466 ELSEIF(IK.GE.450.AND.IK.LE.453.AND.MOD(IJ,2).EQ.1.AND.
34467 & IDPDG(IJ).GT.0) THEN
34468 C--change order if antiparticle first
34469 IF(IDHEP(LHEP).LT.0) THEN
34474 C--indices for RPV coupling
34476 JJJ = (IDHW(MHEP)-6)/2
34477 KKK = (IDHW(LHEP)+1)/2
34480 IDP(4+I) = 423+2*III+(I-1)*12
34481 IDP(6+I) = 400+2*JJJ+(I-1)*12
34482 33 IDP(8+I) = 399+2*KKK+(I-1)*12
34483 C--types of diagram
34492 A(1,I ) = LMIXSS(2*III-1,1,I)*LAMDA2(III,JJJ,KKK)
34494 B(1,I+2) = QMIXSS(2*JJJ ,1,I)*LAMDA2(III,JJJ,KKK)
34496 A(1,I+4) = QMIXSS(2*KKK-1,2,I)*LAMDA2(III,JJJ,KKK)
34500 B(J,I ) = AFN( J ,2*III+5,I,L1)
34501 A(J,I+2) = AFN( J ,2*JJJ ,I,L1)
34502 34 B(J,I+4) = AFN(O(J),2*KKK-1,I,L1)
34508 SPNCFC(1,1,1) = ONE/THREE
34509 C--antilepton neutralino production
34510 ELSEIF(IK.GE.450.AND.IK.LE.453.AND.MOD(IJ,2).EQ.1.AND.
34511 & IDPDG(IJ).LT.0) THEN
34512 C--change order if antiparticle first
34513 IF(IDHEP(LHEP).LT.0) THEN
34518 C--indices for RPV coupling
34521 KKK = (IDHW(MHEP)-5)/2
34524 IDP(4+I) = 423+2*III+(I-1)*12
34525 IDP(6+I) = 400+2*JJJ+(I-1)*12
34526 36 IDP(8+I) = 399+2*KKK+(I-1)*12
34527 C--types of diagram
34537 A(2,I ) = LMIXSS(2*III-1,1,I)*LAMDA2(III,JJJ,KKK)
34539 B(2,I+2) = QMIXSS(2*JJJ ,1,I)*LAMDA2(III,JJJ,KKK)
34541 A(2,I+4) = QMIXSS(2*KKK-1,2,I)*LAMDA2(III,JJJ,KKK)
34544 B(J,I ) = AFN(O(J),2*III+5,I,L1)
34545 A(J,I+2) = AFN(O(J),2*JJJ ,I,L1)
34546 37 B(J,I+4) = AFN( J ,2*KKK-1,I,L1)
34552 SPNCFC(1,1,1) = ONE/THREE
34553 C-- +ve chargino antineutrino
34554 ELSEIF(IK.GE.454.AND.IK.LE.455.AND.MOD(IJ,2).EQ.0) THEN
34555 C--change order if antiparticle first
34556 IF(IDHEP(LHEP).LT.0) THEN
34564 KKK = (IDHW(MHEP)-5)/2
34567 IDP(4+I) = 423+2*III+(I-1)*12
34568 40 IDP(6+I) = 399+2*JJJ+(I-1)*12
34569 C--types of diagram
34577 A(2,I ) = LMIXSS(2*III-1,1,I)*LAMDA2(III,JJJ,KKK)
34579 B(2,I+2) =-QMIXSS(2*JJJ-1,1,I)*LAMDA2(III,JJJ,KKK)
34582 B(J,I ) = AFC(O(J),2*III+5,I,L1)
34583 41 A(J,I+2) = AFC(O(J),2*JJJ-1,I,L1)
34589 SPNCFC(1,1,1) = ONE/THREE
34590 C-- -ve chargino neutrino
34591 ELSEIF(IK.GE.456.AND.IK.LE.457.AND.MOD(IJ,2).EQ.0) THEN
34592 C--change order if antiparticle first
34593 IF(IDHEP(LHEP).LT.0) THEN
34600 JJJ = (IDHW(MHEP)-6)/2
34601 KKK = (IDHW(LHEP)+1)/2
34604 IDP(4+I) = 423+2*III+(I-1)*12
34605 43 IDP(6+I) = 399+2*JJJ+(I-1)*12
34606 C--types of diagram
34613 A(1,I ) = LMIXSS(2*III-1,1,I)*LAMDA2(III,JJJ,KKK)
34615 B(1,I+2) =-QMIXSS(2*JJJ-1,1,I)*LAMDA2(III,JJJ,KKK)
34619 B(J,I ) = AFC(J,2*III+5,I,L1)
34620 44 A(J,I+2) = AFC(J,2*JJJ-1,I,L1)
34626 SPNCFC(1,1,1) = ONE/THREE
34627 C-- -ve chargino antilepton
34628 ELSEIF(IK.GE.456.AND.IK.LE.457.AND.MOD(IJ,2).EQ.1) THEN
34629 C--change order if antiparticle first
34630 IF(IDHEP(LHEP).LT.0) THEN
34637 JJJ = (IDHW(LHEP)+1)/2
34638 KKK = (IDHW(MHEP)-5)/2
34642 46 IDP(5+I) = 400+2*JJJ+(I-1)*12
34643 C--types of diagram
34649 A(2,1) =-LAMDA2(III,JJJ,KKK)
34652 47 B(2,I+1) = QMIXSS(2*JJJ,1,I)*LAMDA2(III,JJJ,KKK)
34655 B(J,1) = AFC(O(J),2*III+6,1,L1)
34657 48 A(J,I+1) = AFC(O(J),2*JJJ,I,L1)
34663 SPNCFC(1,1,1) = ONE/THREE
34664 C-- +ve chargino lepton
34665 ELSEIF(IK.GE.454.AND.IK.LE.455.AND.MOD(IJ,2).EQ.1) THEN
34666 C--change order if antiparticle first
34667 IF(IDHEP(LHEP).LT.0) THEN
34674 JJJ = (IDHW(MHEP)-5)/2
34675 KKK = (IDHW(LHEP)+1)/2
34679 50 IDP(5+I) = 400+2*JJJ+(I-1)*12
34680 C--types of diagram
34685 A(1,1) =-LAMDA2(III,JJJ,KKK)
34688 B(1,I+1) = QMIXSS(2*JJJ,1,I)*LAMDA2(III,JJJ,KKK)
34689 51 B(2,I+1) = 0.0D0
34692 B(J,1) = AFC(J,2*III+6,1,L1)
34694 52 A(J,I+1) = AFC(J,2*JJJ,I,L1)
34700 SPNCFC(1,1,1) = ONE/THREE
34702 ELSEIF(IK.LE.12.AND.IJ.LE.12.AND.
34703 & MOD(IJ,2).EQ.1.AND.MOD(IK,2).EQ.1) THEN
34704 C--can't produce unstable quark (on hadronization timescale)
34706 C--u dbar --> u dbar
34707 ELSEIF((IJ.LE. 6.AND.MOD(IJ,2).EQ.0.AND.
34708 & IK.LE.12.AND.MOD(IK,2).EQ.1).OR.
34709 & (IK.LE.6 .AND.MOD(IK,2).EQ.0.AND.
34710 & IJ.LE.12.AND.MOD(IJ,2).EQ.1)) THEN
34711 C--ensure u first (incoming)
34712 IF(MOD(IDHW(LHEP),2).EQ.1) THEN
34717 C--ensure u first (outgoing)
34718 IF(MOD(IK,2).EQ.1) THEN
34726 C--can't produce unstable quark (on hadronization timescale)
34730 KKK = (IDHW(MHEP)-5)/2
34735 IF(ABS(LAMDA2(III,JJJ,KKK)*LAMDA2(III,LLL,MMM)).LT.EPS)
34739 IDP(4+NDIA+J) = 423+2*III+12*(J-1)
34741 A(2,NDIA+J) = LAMDA2(III,JJJ,KKK)*LMIXSS(2*III-1,1,J)
34742 B(1,NDIA+J) = LAMDA2(III,LLL,MMM)*LMIXSS(2*III-1,1,J)
34744 55 DRTYPE(NDIA+J) = 21
34748 SPNCFC(1,1,1) = ONE
34749 C--ubar d --> ubar d
34750 ELSEIF((IJ.LE.12.AND.MOD(IJ,2).EQ.0.AND.
34751 & IK.LE. 6.AND.MOD(IK,2).EQ.1).OR.
34752 & (IK.LE.12.AND.MOD(IK,2).EQ.0.AND.
34753 & IJ.LE. 6.AND.MOD(IJ,2).EQ.1)) THEN
34754 C--ensure d first (incoming)
34755 IF(MOD(IDHW(LHEP),2).EQ.0) THEN
34760 C--ensure d first (outgoing)
34761 IF(MOD(IK,2).EQ.0) THEN
34769 C--can't produce unstable quark (on hadronization timescale)
34770 IF(IJ.NE.12) RETURN
34772 JJJ = (IDHW(MHEP)-6)/2
34773 KKK = (IDHW(LHEP)+1)/2
34778 IF(ABS(LAMDA2(III,JJJ,KKK)*LAMDA2(III,LLL,MMM)).LT.EPS)
34782 IDP(4+NDIA+J) = 423+2*III+12*(J-1)
34783 A(1,NDIA+J) = LAMDA2(III,JJJ,KKK)*LMIXSS(2*III-1,1,J)
34786 B(2,NDIA+J) = LAMDA2(III,LLL,MMM)*LMIXSS(2*III-1,1,J)
34787 57 DRTYPE(NDIA+J) = 21
34791 SPNCFC(1,1,1) = ONE
34792 C--d dbar --> ell- ell+
34793 ELSEIF(IDHW(LHEP).LE.12.AND.MOD(IDHW(LHEP),2).EQ.1.AND.
34794 & IDHW(MHEP).LE.12.AND.MOD(IDHW(MHEP),2).EQ.1.AND.
34795 & IK.GE.127.AND.IK.LE.132.AND.MOD(IK,2).EQ.1.AND.
34796 & IJ.GE.121.AND.IJ.LE.126.AND.MOD(IJ,2).EQ.1) THEN
34797 C--change outgoing order
34804 C--change order if dbar first
34805 IF(IDHEP(LHEP).LT.0) THEN
34810 C--don't do correlations if no taus
34811 IF(IK.NE.125.AND.IJ.NE.131) RETURN
34813 JJJ = (IDHW(LHEP)+1)/2
34814 KKK = (IDHW(MHEP)-5)/2
34819 IF(ABS(LAMDA2(III,JJJ,KKK)*LAMDA1(III,LLL,MMM)).LT.EPS)
34823 IDP(4+NDIA) = 424+2*III
34825 A(2,NDIA) = LAMDA2(III,JJJ,KKK)
34826 B(1,NDIA) = LAMDA1(III,LLL,MMM)
34831 SPNCFC(1,1,1) = ONE/THREE
34832 C--dbar d --> ell+ ell-
34833 ELSEIF(IDHW(LHEP).LE.12.AND.MOD(IDHW(LHEP),2).EQ.1.AND.
34834 & IDHW(MHEP).LE.12.AND.MOD(IDHW(MHEP),2).EQ.1.AND.
34835 & IK.GE.121.AND.IK.LE.126.AND.MOD(IK,2).EQ.1.AND.
34836 & IJ.GE.127.AND.IJ.LE.132.AND.MOD(IJ,2).EQ.1) THEN
34837 C--change order if dbar first
34838 IF(IDHEP(LHEP).LT.0) THEN
34843 C--don't do correlations if no taus
34844 IF(IK.NE.125.AND.IJ.NE.131) RETURN
34846 JJJ = (IDHW(MHEP)-5)/2
34847 KKK = (IDHW(LHEP)+1)/2
34852 IF(ABS(LAMDA2(III,JJJ,KKK)*LAMDA1(III,LLL,MMM)).LT.EPS)
34856 IDP(4+NDIA) = 424+2*III
34857 A(1,NDIA) = LAMDA2(III,JJJ,KKK)
34860 B(2,NDIA) = LAMDA1(III,LLL,MMM)
34864 SPNCFC(1,1,1) = ONE/THREE
34865 C--u dbar --> nu ell+
34866 ELSEIF((IK.GE.121.AND.IK.LE.126.AND.MOD(IK,2).EQ.0.AND.
34867 & IJ.GE.127.AND.IJ.LE.132.AND.MOD(IJ,2).EQ.1).OR.
34868 & (IK.GE.127.AND.IK.LE.132.AND.MOD(IK,2).EQ.1.AND.
34869 & IJ.GE.121.AND.IJ.LE.126.AND.MOD(IJ,2).EQ.0)) THEN
34871 IF(MOD(IDHW(LHEP),2).NE.0) THEN
34877 IF(MOD(IK,2).NE.0) THEN
34885 C--only need correlations if tau
34886 IF(IJ.NE.131) RETURN
34889 KKK = (IDHW(MHEP)-5)/2
34894 IF(ABS(LAMDA2(III,JJJ,KKK)*LAMDA1(III,LLL,MMM)).LT.EPS)
34898 IDP(4+NDIA+J) = 423+2*III+12*(J-1)
34900 A(2,NDIA+J) = LAMDA2(III,JJJ,KKK)*LMIXSS(2*III-1,1,J)
34901 B(1,NDIA+J) = LAMDA1(III,LLL,MMM)*LMIXSS(2*III-1,1,J)
34903 61 DRTYPE(NDIA+J) = 21
34907 SPNCFC(1,1,1) = ONE/THREE
34908 C--ubar d --> ell nubar
34909 ELSEIF((IK.GE.127.AND.IK.LE.132.AND.MOD(IK,2).EQ.0.AND.
34910 & IJ.GE.121.AND.IJ.LE.126.AND.MOD(IJ,2).EQ.1).OR.
34911 & (IK.GE.121.AND.IK.LE.126.AND.MOD(IK,2).EQ.1.AND.
34912 & IJ.GE.127.AND.IJ.LE.132.AND.MOD(IJ,2).EQ.0)) THEN
34914 IF(MOD(IDHW(MHEP),2).NE.0) THEN
34919 C-- ensure nu second
34920 IF(MOD(IJ,2).NE.0) THEN
34928 C--only need correlations if tau
34929 IF(IK.NE.125) RETURN
34931 JJJ = (IDHW(MHEP)-6)/2
34932 KKK = (IDHW(LHEP)+1)/2
34937 IF(ABS(LAMDA2(III,JJJ,KKK)*LAMDA1(III,LLL,MMM)).LT.EPS)
34941 IDP(4+NDIA+J) = 423+2*III+12*(J-1)
34942 A(1,NDIA+J) = LAMDA2(III,JJJ,KKK)*LMIXSS(2*III-1,1,J)
34945 B(2,NDIA+J) = LAMDA1(III,LLL,MMM)*LMIXSS(2*III-1,1,J)
34946 63 DRTYPE(NDIA+J) = 21
34950 SPNCFC(1,1,1) = ONE/THREE
34951 C--unrecognized process
34953 CALL HWWARN('HWHSPN',505)
34956 ELSEIF(IPRO.EQ.41) THEN
34957 C--change outgoing order
34965 IF(IK.GE.450.AND.IK.LE.453.AND.MOD(IJ,2).EQ.0.AND.
34966 & IDPDG(IJ).LT.0) THEN
34969 JJJ = (IDHW(LHEP)+1)/2
34970 KKK = (IDHW(MHEP)+1)/2
34972 C--types of diagram
34981 A(1,J ) = QMIXSS(2*III,2,J)*LAMDA3(III,JJJ,KKK)
34983 B(1,J+2) = QMIXSS(2*JJJ-1,2,J)*LAMDA3(III,JJJ,KKK)
34985 A(1,J+4) = QMIXSS(2*KKK-1,2,J)*LAMDA3(III,JJJ,KKK)
34988 IDP(4+J) = 400+2*III+12*(J-1)
34989 IDP(6+J) = 399+2*JJJ+12*(J-1)
34990 IDP(8+J) = 399+2*KKK+12*(J-1)
34993 B(I,J) = AFN(O(I),2*III,J,L1)
34994 A(I,J+2) = AFN(O(I),2*JJJ-1,J,L1)
34995 64 B(I,J+4) = AFN(O(I),2*KKK-1,J,L1)
35001 SPNCFC(1,1,1) = TWO/THREE
35003 ELSEIF(IK.GE.450.AND.IK.LE.453.AND.MOD(IJ,2).EQ.0.AND.
35004 & IDPDG(IJ).GT.0) THEN
35007 JJJ = (IDHW(LHEP)-5)/2
35008 KKK = (IDHW(MHEP)-5)/2
35010 C--types of diagram
35020 A(2,J ) = QMIXSS(2*III,2,J)*LAMDA3(III,JJJ,KKK)
35022 B(2,J+2) = QMIXSS(2*JJJ-1,2,J)*LAMDA3(III,JJJ,KKK)
35024 A(2,J+4) = QMIXSS(2*KKK-1,2,J)*LAMDA3(III,JJJ,KKK)
35026 IDP(4+J) = 400+2*III+12*(J-1)
35027 IDP(6+J) = 399+2*JJJ+12*(J-1)
35028 IDP(8+J) = 399+2*KKK+12*(J-1)
35031 B(I,J) = AFN(I,2*III,J,L1)
35032 A(I,J+2) = AFN(I,2*JJJ-1,J,L1)
35033 66 B(I,J+4) = AFN(I,2*KKK-1,J,L1)
35039 SPNCFC(1,1,1) = TWO/THREE
35041 ELSEIF(IK.GE.450.AND.IK.LE.453.AND.MOD(IJ,2).EQ.1.AND.
35042 & IDPDG(IJ).LT.0) THEN
35043 C--ensure u type first
35044 IF(MOD(IDHW(LHEP),2).NE.0) THEN
35051 JJJ = (IDHW(MHEP)+1)/2
35054 C--types of diagram
35063 A(1,I ) = QMIXSS(2*KKK-1,2,I)*LAMDA3(III,JJJ,KKK)
35065 B(1,I+2) = QMIXSS(2*III,2,I)*LAMDA3(III,JJJ,KKK)
35067 A(1,I+4) = QMIXSS(2*JJJ-1,2,I)*LAMDA3(III,JJJ,KKK)
35070 IDP(4+I) = 399+2*KKK+12*(I-1)
35071 IDP(6+I) = 400+2*III+12*(I-1)
35072 IDP(8+I) = 399+2*JJJ+12*(I-1)
35075 B(J,I ) = AFN(O(J),2*KKK-1,I,L1)
35076 A(J,I+2) = AFN(O(J),2*III ,I,L1)
35077 68 B(J,I+4) = AFN(O(J),2*JJJ-1,I,L1)
35083 SPNCFC(1,1,1) = TWO/THREE
35085 ELSEIF(IK.GE.450.AND.IK.LE.453.AND.MOD(IJ,2).EQ.1.AND.
35086 & IDPDG(IJ).GT.0) THEN
35087 C--ensure u type first
35088 IF(MOD(IDHW(LHEP),2).NE.0) THEN
35094 III = (IDHW(LHEP)-6)/2
35095 JJJ = (IDHW(MHEP)-5)/2
35098 C--types of diagram
35108 A(2,I ) = QMIXSS(2*KKK-1,2,I)*LAMDA3(III,JJJ,KKK)
35110 B(2,I+2) = QMIXSS(2*III,2,I)*LAMDA3(III,JJJ,KKK)
35112 A(2,I+4) = QMIXSS(2*JJJ-1,2,I)*LAMDA3(III,JJJ,KKK)
35114 IDP(4+I) = 399+2*KKK+12*(I-1)
35115 IDP(6+I) = 400+2*III+12*(I-1)
35116 IDP(8+I) = 399+2*JJJ+12*(I-1)
35119 B(J,I ) = AFN(J,2*KKK-1,I,L1)
35120 A(J,I+2) = AFN(J,2*III ,I,L1)
35121 70 B(J,I+4) = AFN(J,2*JJJ-1,I,L1)
35127 SPNCFC(1,1,1) = TWO/THREE
35129 ELSEIF(IK.EQ.449.AND.MOD(IJ,2).EQ.0.AND.IDPDG(IJ).LT.0) THEN
35132 JJJ = (IDHW(LHEP)+1)/2
35133 KKK = (IDHW(MHEP)+1)/2
35134 C--types of diagram
35143 A(1,J ) = QMIXSS(2*III,2,J)*LAMDA3(III,JJJ,KKK)
35145 B(1,J+2) = QMIXSS(2*JJJ-1,2,J)*LAMDA3(III,JJJ,KKK)
35147 A(1,J+4) = QMIXSS(2*KKK-1,2,J)*LAMDA3(III,JJJ,KKK)
35150 IDP(4+J) = 400+2*III+12*(J-1)
35151 IDP(6+J) = 399+2*JJJ+12*(J-1)
35152 IDP(8+J) = 399+2*KKK+12*(J-1)
35155 B(I,J) = AFG(O(I),2*III,J)
35156 A(I,J+2) = AFG(O(I),2*JJJ-1,J)
35157 72 B(I,J+4) = AFG(O(I),2*KKK-1,J)
35168 SPNCFC(I,J,1) = 8.0D0/9.0D0
35170 SPNCFC(I,J,1) =-4.0D0/9.0D0
35174 ELSEIF(IK.EQ.449.AND.MOD(IJ,2).EQ.0.AND.IDPDG(IJ).GT.0) THEN
35177 JJJ = (IDHW(LHEP)-5)/2
35178 KKK = (IDHW(MHEP)-5)/2
35179 C--types of diagram
35189 A(2,J ) = QMIXSS(2*III,2,J)*LAMDA3(III,JJJ,KKK)
35191 B(2,J+2) = QMIXSS(2*JJJ-1,2,J)*LAMDA3(III,JJJ,KKK)
35193 A(2,J+4) = QMIXSS(2*KKK-1,2,J)*LAMDA3(III,JJJ,KKK)
35195 IDP(4+J) = 400+2*III+12*(J-1)
35196 IDP(6+J) = 399+2*JJJ+12*(J-1)
35197 IDP(8+J) = 399+2*KKK+12*(J-1)
35200 B(I,J) = AFG(I,2*III,J)
35201 A(I,J+2) = AFG(I,2*JJJ-1,J)
35202 75 B(I,J+4) = AFG(I,2*KKK-1,J)
35213 SPNCFC(I,J,1) = 8.0D0/9.0D0
35215 SPNCFC(I,J,1) =-4.0D0/9.0D0
35219 ELSEIF(IK.EQ.449.AND.MOD(IJ,2).EQ.1.AND.IDPDG(IJ).LT.0) THEN
35220 C--ensure u type first
35221 IF(MOD(IDHW(LHEP),2).NE.0) THEN
35228 JJJ = (IDHW(MHEP)+1)/2
35230 C--types of diagram
35239 A(1,I ) = QMIXSS(2*KKK-1,2,I)*LAMDA3(III,JJJ,KKK)
35241 B(1,I+2) = QMIXSS(2*III,2,I)*LAMDA3(III,JJJ,KKK)
35243 A(1,I+4) = QMIXSS(2*JJJ-1,2,I)*LAMDA3(III,JJJ,KKK)
35246 IDP(4+I) = 399+2*KKK+12*(I-1)
35247 IDP(6+I) = 400+2*III+12*(I-1)
35248 IDP(8+I) = 399+2*JJJ+12*(I-1)
35251 B(J,I ) = AFG(O(J),2*KKK-1,I)
35252 A(J,I+2) = AFG(O(J),2*III ,I)
35253 78 B(J,I+4) = AFG(O(J),2*JJJ-1,I)
35264 SPNCFC(I,J,1) = 8.0D0/9.0D0
35266 SPNCFC(I,J,1) =-4.0D0/9.0D0
35270 ELSEIF(IK.EQ.449.AND.MOD(IJ,2).EQ.1.AND.IDPDG(IJ).GT.0) THEN
35271 C--ensure u type first
35272 IF(MOD(IDHW(LHEP),2).NE.0) THEN
35278 III = (IDHW(LHEP)-6)/2
35279 JJJ = (IDHW(MHEP)-5)/2
35281 C--types of diagram
35291 A(2,I ) = QMIXSS(2*KKK-1,2,I)*LAMDA3(III,JJJ,KKK)
35293 B(2,I+2) = QMIXSS(2*III,2,I)*LAMDA3(III,JJJ,KKK)
35295 A(2,I+4) = QMIXSS(2*JJJ-1,2,I)*LAMDA3(III,JJJ,KKK)
35297 IDP(4+I) = 399+2*KKK+12*(I-1)
35298 IDP(6+I) = 400+2*III+12*(I-1)
35299 IDP(8+I) = 399+2*JJJ+12*(I-1)
35302 B(J,I ) = AFG(J,2*KKK-1,I)
35303 A(J,I+2) = AFG(J,2*III ,I)
35304 81 B(J,I+4) = AFG(J,2*JJJ-1,I)
35315 SPNCFC(I,J,1) = 8.0D0/9.0D0
35317 SPNCFC(I,J,1) =-4.0D0/9.0D0
35320 C--dbar -ve chargino
35321 ELSEIF(IK.GE.456.AND.IK.LE.457.AND.MOD(IJ,2).EQ.1) THEN
35322 C--change order so highest generation first
35323 IF(IDHW(MHEP).GT.IDHW(LHEP)) THEN
35330 JJJ = (IDHW(LHEP)+1)/2
35331 KKK = (IDHW(MHEP)+1)/2
35333 C--types of diagram
35342 A(1,I ) = QMIXSS(2*III,2,I)*LAMDA3(III,JJJ,KKK)
35344 B(1,I+2) = QMIXSS(2*JJJ,2,I)*LAMDA3(JJJ,KKK,III)
35346 A(1,I+4) = QMIXSS(2*KKK,2,I)*LAMDA3(KKK,III,JJJ)
35349 IDP(4+I) = 400+2*III+12*(I-1)
35350 IDP(6+I) = 400+2*JJJ+12*(I-1)
35351 IDP(8+I) = 400+2*KKK+12*(I-1)
35354 B(J,I ) = AFC(O(J),2*III,I,L1)
35355 A(J,I+2) = AFC(O(J),2*JJJ,I,L1)
35356 84 B(J,I+4) = AFC(O(J),2*KKK,I,L1)
35362 SPNCFC(1,1,1) = TWO/THREE
35364 ELSEIF(IK.GE.454.AND.IK.LE.455.AND.MOD(IJ,2).EQ.1) THEN
35365 C--change order so highest generation first
35366 IF(IDHW(MHEP).GT.IDHW(LHEP)) THEN
35373 JJJ = (IDHW(LHEP)-5)/2
35374 KKK = (IDHW(MHEP)-5)/2
35376 C--types of diagram
35386 A(2,I ) = QMIXSS(2*III,2,I)*LAMDA3(III,JJJ,KKK)
35388 B(2,I+2) = QMIXSS(2*JJJ,2,I)*LAMDA3(JJJ,KKK,III)
35390 A(2,I+4) = QMIXSS(2*KKK,2,I)*LAMDA3(KKK,III,JJJ)
35392 IDP(4+I) = 400+2*III+12*(I-1)
35393 IDP(6+I) = 400+2*JJJ+12*(I-1)
35394 IDP(8+I) = 400+2*KKK+12*(I-1)
35397 B(J,I ) = AFC(J,2*III,I,L1)
35398 A(J,I+2) = AFC(J,2*JJJ,I,L1)
35399 86 B(J,I+4) = AFC(J,2*KKK,I,L1)
35405 SPNCFC(1,1,1) = TWO/THREE
35406 C--ubar +ve chargino
35407 ELSEIF(IK.GE.454.AND.IK.LE.455.AND.MOD(IJ,2).EQ.0) THEN
35408 C--ensure u type first
35409 IF(MOD(IDHW(LHEP),2).NE.0) THEN
35416 JJJ = (IDHW(MHEP)+1)/2
35419 C--types of diagram
35426 A(1,I ) = QMIXSS(2*KKK-1,2,I)*LAMDA3(III,JJJ,KKK)
35428 B(1,I+2) = QMIXSS(2*III-1,2,I)*LAMDA3(KKK,III,JJJ)
35431 IDP(4+I) = 399+2*KKK+12*(I-1)
35432 IDP(6+I) = 399+2*III+12*(I-1)
35435 B(J,I ) = AFC(O(J),2*KKK-1,I,L1)
35436 88 A(J,I+2) = AFC(O(J),2*III-1,I,L1)
35442 SPNCFC(1,1,1) = TWO/THREE
35444 ELSEIF(IK.GE.456.AND.IK.LE.457.AND.MOD(IJ,2).EQ.0) THEN
35445 C--ensure u type first
35446 IF(MOD(IDHW(LHEP),2).NE.0) THEN
35452 III = (IDHW(LHEP)-6)/2
35453 JJJ = (IDHW(MHEP)-5)/2
35456 C--types of diagram
35464 A(2,I ) = QMIXSS(2*KKK-1,2,I)*LAMDA3(III,JJJ,KKK)
35466 B(2,I+2) = QMIXSS(2*III-1,2,I)*LAMDA3(KKK,III,JJJ)
35468 IDP(4+I) = 399+2*KKK+12*(I-1)
35469 IDP(6+I) = 399+2*III+12*(I-1)
35472 B(J,I ) = AFC(J,2*KKK-1,I,L1)
35473 90 A(J,I+2) = AFC(J,2*III-1,I,L1)
35479 SPNCFC(1,1,1) = TWO/THREE
35481 ELSEIF(IDPDG(IK).GT.0.AND.IDPDG(IK).GT.0.AND.
35482 & MOD(IK,2).EQ.1.AND.MOD(IJ,2).EQ.1) THEN
35483 C--can't produce unstable quark on hadronisation timescale
35485 C--dbar dbar --> dbar dbar
35486 ELSEIF(IDPDG(IK).LT.0.AND.IDPDG(IJ).LT.0.AND.
35487 & MOD(IJ,2).EQ.1.AND.MOD(IK,2).EQ.1) THEN
35488 C--can't produce unstable quark on hadronisation timescale
35491 ELSEIF(IDPDG(IK).GT.0.AND.IDPDG(IJ).GT.0.AND.
35492 & ((MOD(IJ,2).EQ.1.AND.MOD(IK,2).EQ.0).OR.
35493 & (MOD(IJ,2).EQ.0.AND.MOD(IK,2).EQ.1))) THEN
35494 C--ensure u first (incoming)
35495 IF(MOD(IDHW(LHEP),2).EQ.1) THEN
35500 C--ensure u first (outgoing)
35501 IF(MOD(IK,2).EQ.1) THEN
35509 C--can't produce unstable quark on hadronisation timescale
35513 KKK = (IDHW(MHEP)+1)/2
35518 IF(ABS(LAMDA3(III,JJJ,KKK)*LAMDA3(LLL,JJJ,MMM)).LT.EPS)
35522 IDP(4+NDIA+J) = 399+2*JJJ+12*(J-1)
35523 A(1,NDIA+J) = LAMDA3(III,JJJ,KKK)*QMIXSS(2*JJJ-1,2,J)
35526 B(2,NDIA+J) = LAMDA3(LLL,JJJ,MMM)*QMIXSS(2*JJJ-1,2,J)
35527 93 DRTYPE(NDIA+J) = 33
35531 SPNCFC(1,1,1) = ONE/THREE
35532 C--ubar dbar --> ubar dbar
35533 ELSEIF(IDPDG(IK).LT.0.AND.IDPDG(IJ).LT.0.AND.
35534 & ((MOD(IJ,2).EQ.1.AND.MOD(IK,2).EQ.0).OR.
35535 & (MOD(IJ,2).EQ.0.AND.MOD(IK,2).EQ.1))) THEN
35536 C--ensure u first (incoming)
35537 IF(MOD(IDHW(LHEP),2).EQ.1) THEN
35542 C--ensure u first (outgoing)
35543 IF(MOD(IK,2).EQ.1) THEN
35551 C--can't produce unstable quark on hadronisation timescale
35554 III = (IDHW(LHEP)-6)/2
35555 KKK = (IDHW(MHEP)-5)/2
35560 IF(ABS(LAMDA3(III,JJJ,KKK)*LAMDA3(LLL,JJJ,MMM)).LT.EPS)
35564 IDP(4+NDIA+J) = 399+2*JJJ+12*(J-1)
35566 A(2,NDIA+J) = LAMDA3(III,JJJ,KKK)*QMIXSS(2*JJJ-1,2,J)
35567 B(1,NDIA+J) = LAMDA3(LLL,JJJ,MMM)*QMIXSS(2*JJJ-1,2,J)
35569 95 DRTYPE(NDIA+J) = 34
35573 SPNCFC(1,1,1) = ONE/THREE
35574 C--unrecognized process
35576 CALL HWWARN('HWHSPN',506)
35578 C--unrecognized process
35580 CALL HWWARN('HWHSPN',507)
35582 C--copy the momenta into the internal array
35583 CALL HWVEQU(5,PHEP(1,LHEP),P(1,1))
35584 CALL HWVEQU(5,PHEP(1,MHEP),P(1,2))
35585 CALL HWVEQU(5,PHEP(1,KHEP),P(1,3))
35586 CALL HWVEQU(5,PHEP(1,JHEP),P(1,4))
35587 C--now compute the masses etc for the diagrams
35588 IDP(1) = IDHW(LHEP)
35589 IDP(2) = IDHW(MHEP)
35590 IDP(3) = IDHW(KHEP)
35591 IDP(4) = IDHW(JHEP)
35594 104 MA2(I) = SIGN(MA(I)**2,MA(I))
35596 MR(I) = RMASS(IDP(4+I))
35598 IF(IDP(I+4).EQ.200) THEN
35599 MWD(I) = RMASS(200)*GAMZ
35600 ELSEIF(IDP(I+4).EQ.198.OR.IDP(I+4).EQ.199) THEN
35601 MWD(I) = RMASS(198)*GAMW
35602 ELSEIF(IDP(I+4).EQ.59.OR.IDP(I+4).EQ.13.OR.
35603 & IDP(I+4).LE.5.OR.(IDP(I+4).GE.7.AND.IDP(I+4).LE.11)) THEN
35608 MWD(I) = MR(I)*HBAR/RLTIM(IDP(I+4))
35611 C--set up the mandelstam variables
35612 SH = TWO*HWULDO(P(1,1),P(1,2))
35613 CALL HWVSCA(4,-ONE,P(1,3),PLAB(1,2))
35614 CALL HWVSUM(5,P(1,1),PLAB(1,2),PLAB(1,1))
35615 TH = P(5,3)**2-TWO*HWULDO(P(1,1),P(1,3))
35616 UH = P(5,4)**2-TWO*HWULDO(P(1,1),P(1,4))
35617 C--copy the momenta into the common block for spinor computation
35619 IF(IDP(I).LT.400.AND.(IDP(I).NE.6.AND.IDP(I).NE.12
35620 & .AND.IDP(I).NE.125.AND.IDP(I).NE.131)) THEN
35621 CALL HWVEQU(5,PREF,PLAB(1,I+4))
35622 C--all other particles
35624 PP = SQRT(HWVDOT(3,P(1,I),P(1,I)))
35625 CALL HWVSCA(3,ONE/PP,P(1,I),N)
35626 PLAB(4,I+4) = HALF*(P(4,I)-PP)
35627 PP = HALF*(PP-P(5,I)-PP**2/(P(5,I)+P(4,I)))
35628 CALL HWVSCA(3,PP,N,PLAB(1,I+4))
35629 CALL HWUMAS(PLAB(1,I+4))
35630 PP = HWVDOT(3,PLAB(1,I+4),PLAB(1,I+4))
35631 C--fix to avoid problems if approx massless due to energy
35632 IF(PP.LT.EPS) CALL HWVEQU(5,PREF,PLAB(1,I+4))
35634 C--now the massless vectors
35635 PP = HALF*MA2(I)/HWULDO(PLAB(1,I+4),P(1,I))
35637 107 PLAB(J,I) = P(J,I)-PP*PLAB(J,I+4)
35638 106 CALL HWUMAS(PLAB(1,I))
35639 C--change order of momenta for call to HE code
35645 108 PM(5,I) = P(5,I)
35651 109 PCM(5,I)=PLAB(5,I)
35652 C--compute the S functions
35653 CALL HWHEW2(8,PCM(1,1),S(1,1,2),S(1,1,1),D)
35656 S(I,J,2) = -S(I,J,2)
35657 110 D(I,J) = TWO*D(I,J)
35658 C--compute the F functions
35659 CALL HWH2F1(8,F3 ,7,PM(1,3), MA(3))
35660 CALL HWH2F2(8,F4 ,8,PM(1,4),-MA(4))
35661 CALL HWH2F1(8,F4M,8,PM(1,4), MA(4))
35662 CALL HWH2F2(8,F3M,7,PM(1,3),-MA(3))
35663 C--t and u channel functions
35664 C--first the t channel ones
35665 CALL HWVSCA(4,-ONE,PM(1,4),PTMP)
35666 CALL HWVSUM(4,PM(1,2),PTMP,PTMP)
35668 CALL HWH2F3(8,FTP,PTMP, MR(1))
35669 CALL HWH2F3(8,FTM,PTMP,-MR(1))
35670 C--then the u-channel ones
35671 CALL HWVSCA(4,-ONE,PM(1,4),PTMP)
35672 CALL HWVSUM(4,PM(1,1),PTMP,PTMP)
35674 CALL HWH2F3(8,FUP,PTMP, MR(1))
35675 CALL HWH2F3(8,FUM,PTMP,-MR(1))
35676 C--function for t-channel scalar exchange
35677 CALL HWVSUM(4,PM(1,4),PM(1,4),PTMP)
35679 CALL HWH2F1(8,FST,2,PTMP,ZERO)
35680 C--compute the prefactor for all diagrams
35681 PRE = HWULDO(PCM(1,7),PM(1,3))*HWULDO(PCM(1,8),PM(1,4))
35682 PRE = ONE/SQRT(PRE)
35683 C--zero the matrix element
35689 200 ME(P1,P2,P3,P4,I) = (0.0D0,0.0D0)
35690 C--now call the subroutines to compute the individual diagrams
35692 C--s-channel vector boson exchange diagram (f fbar to fermion fermion)
35693 IF(DRTYPE(I).EQ.1) THEN
35695 C--t-channel sfermion exchange diagram (f fbar to fermion fermion)
35696 ELSEIF(DRTYPE(I).EQ.2) THEN
35698 C--u-channel sfermion exchange diagram(f fbar to fermion fermion)
35699 ELSEIF(DRTYPE(I).EQ.3) THEN
35701 C--s-channel vector boson (f fbar to fermion antifermion)
35702 ELSEIF(DRTYPE(I).EQ.4) THEN
35704 C--t-channel fermion exchange (g g to fermion antifermion)
35705 ELSEIF(DRTYPE(I).EQ.5) THEN
35707 C--u-channel fermion exchange (g g to fermion antifermion)
35708 ELSEIF(DRTYPE(I).EQ.6) THEN
35710 C--s-channel gluon exchange (g g to fermion antifermion)
35711 ELSEIF(DRTYPE(I).EQ.7) THEN
35713 C--t-channel sfermion exchange (g q to fermion sfermion)
35714 ELSEIF(DRTYPE(I).EQ.8) THEN
35716 C--t-channel sfermion exchange (g qbar to fermion antisfermion)
35717 ELSEIF(DRTYPE(I).EQ.9) THEN
35719 C--s-channel quark exchange (g q to fermion antisfermion)
35720 ELSEIF(DRTYPE(I).EQ.10) THEN
35722 C--s-channel antiquark exchange (g qbar to fermion antisfermion)
35723 ELSEIF(DRTYPE(I).EQ.11) THEN
35725 C--u-channel gluino exchange (g q to fermion antisfermion)
35726 ELSEIF(DRTYPE(I).EQ.12) THEN
35728 C--u-channel gluino exchange (g qbar to fermion antisfermion)
35729 ELSEIF(DRTYPE(I).EQ.13) THEN
35731 C--t-channel fermion exchange (g g to fermion fermion)
35732 ELSEIF(DRTYPE(I).EQ.14) THEN
35734 C--u-channel fermion exchange (g g to fermion fermion)
35735 ELSEIF(DRTYPE(I).EQ.15) THEN
35737 C--s-channel gluon exchange (g g to fermion fermion)
35738 ELSEIF(DRTYPE(I).EQ.16) THEN
35740 C--t-channel gauge boson exchange (fermion fermion)
35741 ELSEIF(DRTYPE(I).EQ.17) THEN
35743 C--t-channel gauge boson exchange (fermion antifermion)
35744 ELSEIF(DRTYPE(I).EQ.18) THEN
35746 C--t-channel gauge boson exchange (antifermion fermion)
35747 ELSEIF(DRTYPE(I).EQ.19) THEN
35749 C--t-channel gauge boson exchange (antifermion antifermion)
35750 ELSEIF(DRTYPE(I).EQ.20) THEN
35752 C--s-channel scalar exchange (f fbar --> f fbar)
35753 ELSEIF(DRTYPE(I).EQ.21) THEN
35755 C--t-channel scalar exchange (f fbar --> f fbar)
35756 ELSEIF(DRTYPE(I).EQ.22) THEN
35758 C--u-channel scalar exchange (f fbar --> f fbar)
35759 ELSEIF(DRTYPE(I).EQ.23) THEN
35761 C--s-channel scalar exchange (fbar f --> f f)
35762 ELSEIF(DRTYPE(I).EQ.24) THEN
35764 C--t-channel scalar exchange (fbar f --> f f)
35765 ELSEIF(DRTYPE(I).EQ.25) THEN
35767 C--u-channel scalar exchange (fbar f --> f f)
35768 ELSEIF(DRTYPE(I).EQ.26) THEN
35770 C--s-channel scalar exchange (f f --> f fbar)
35771 ELSEIF(DRTYPE(I).EQ.27) THEN
35773 C--t-channel scalar exchange (f f --> f fbar)
35774 ELSEIF(DRTYPE(I).EQ.28) THEN
35776 C--u-channel scalar exchange (f f --> f fbar)
35777 ELSEIF(DRTYPE(I).EQ.29) THEN
35779 C--s-channel scalar exchange (fbar fbar --> f f)
35780 ELSEIF(DRTYPE(I).EQ.30) THEN
35782 C--t-channel scalar exchange (fbar fbar --> f f)
35783 ELSEIF(DRTYPE(I).EQ.31) THEN
35785 C--u-channel scalar exchange (fbar fbar --> f f)
35786 ELSEIF(DRTYPE(I).EQ.32) THEN
35788 C--s-channel scalar exchange (f f --> f f)
35789 ELSEIF(DRTYPE(I).EQ.33) THEN
35791 C--s-channel scalar exchange (fbar fbar --> fbar fbar)
35792 ELSEIF(DRTYPE(I).EQ.34) THEN
35796 CALL HWWARN('HWHSPN',508)
35798 C--add up the matrix elements
35803 210 ME(P1,P2,P3,P4,IFLOW(I)) = ME(P1,P2,P3,P4,IFLOW(I))
35804 & +MED(P1,P2,P3,P4)
35805 C--preform the final normalisation
35811 215 ME(P1,P2,P3,P4,I) = PRE*ME(P1,P2,P3,P4,I)
35812 C--now enter the matrix element in the spin common block
35819 DECSPN(1) = .FALSE.
35825 225 MESPN(P1,P2,P3,P4,I,1) = ME(P1,P2,P3,P4,I)
35826 C--now enter the daughter particles
35834 C--spin density matrices for daughter particles
35838 RHOSPN(1,1,I) = HALF
35839 RHOSPN(1,2,I) = ZERO
35840 RHOSPN(2,1,I) = ZERO
35841 230 RHOSPN(2,2,I) = HALF
35842 DECSPN(2) = .FALSE.
35843 DECSPN(3) = .FALSE.
35844 C--select the colour flow if needed
35845 IF(SPCOPT.EQ.2.AND.NCFL(1).NE.1) THEN
35847 C--assume no incoming polarization, no processes with more than one
35848 C--colour flow in e+e-
35849 DO 335 I =1,NCFL(1)
35855 WGTB(I) = WGTB(I)+SPNCFC(I,I,1)*DREAL(
35856 & MESPN(P1,P2,P3,P4,I,1)*DCONJG(MESPN(P1,P2,P3,P4,I,1)))
35857 DO 335 J =1,NCFL(1)
35858 335 WGT = WGT+SPNCFC(I,J,1)*DREAL(
35859 & MESPN(P1,P2,P3,P4,I,1)*DCONJG(MESPN(P1,P2,P3,P4,J,1)))
35862 340 WGTC = WGTC+WGTB(I)
35865 345 WGTB(I) = WGTB(I)*WGTC
35866 WGTC = WGT*HWRGEN(0)
35868 IF(WGTB(I).GE.WGTC) THEN
35872 350 WGTC =WGTC-WGTB(I)
35876 *CMZ :- -02/10/01 10:17:10 by Peter Richardson
35877 *-- Author : Peter Richardson
35878 C-----------------------------------------------------------------------
35879 SUBROUTINE HWHS01(ID,ME)
35880 C-----------------------------------------------------------------------
35881 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
35882 C section f fbar --> gauge boson --> fermion fermion
35883 C This diagram 1 from DAMTP-2001-83 with opposite sign of P4
35884 C-----------------------------------------------------------------------
35885 INCLUDE 'herwig65.inc'
35887 PARAMETER(NDIAHD=10)
35888 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE,ZI
35889 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),
35890 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
35891 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
35892 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
35893 INTEGER P1,P2,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
35894 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
35895 & MA2,SH,TH,UH,IDP,DRTYPE
35896 PARAMETER(ZI=(0.0D0,1.0D0))
35897 COMMON/HWHEWS/S(8,8,2),D(8,8)
35900 C--compute the propagator factor
35901 PRE = -ONE/(SH-MS(ID)+ZI*MWD(ID))
35907 ME(P1,P2,P3,P4) = PRE*A(P1,ID)*(
35908 & B(O(P1),ID)*F3(O(P3), P1 ,1)*F4( P1 ,P4,2)
35909 & +B( P1 ,ID)*F3(O(P3),O(P1),2)*F4(O(P1),P4,1))
35911 ME(P1,P2,P3,P4) = ZERO
35916 *CMZ :- -02/10/01 10:17:10 by Peter Richardson
35917 *-- Author : Peter Richardson
35918 C-----------------------------------------------------------------------
35919 SUBROUTINE HWHS02(ID,ME)
35920 C-----------------------------------------------------------------------
35921 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
35922 C section f fbar ---> fermion fermion via t-channel scalar exchange
35923 C This diagram 2 from DAMTP-2001-83 with opposite sign of P4
35924 C-----------------------------------------------------------------------
35925 INCLUDE 'herwig65.inc'
35927 PARAMETER(NDIAHD=10)
35928 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE
35929 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),
35930 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
35931 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
35932 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
35933 INTEGER P1,P2,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
35934 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
35935 & MA2,SH,TH,UH,IDP,DRTYPE
35936 COMMON/HWHEWS/S(8,8,2),D(8,8)
35939 C--compute the propagator factor
35940 PRE = -HALF/(TH-MS(ID))
35945 10 ME(P1,P2,P3,P4) = PRE*A(P1,ID)*B(O(P2),ID)*
35946 & F3(O(P3),P1,1)*F4(P2,P4,2)
35949 *CMZ :- -02/10/01 10:17:10 by Peter Richardson
35950 *-- Author : Peter Richardson
35951 C-----------------------------------------------------------------------
35952 SUBROUTINE HWHS03(ID,ME)
35953 C-----------------------------------------------------------------------
35954 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
35955 C section f fbar ---> fermion fermion via u-channel scalar exchange
35956 C This diagram 3 from DAMTP-2001-83 with opposite sign of P4
35957 C-----------------------------------------------------------------------
35958 INCLUDE 'herwig65.inc'
35960 PARAMETER(NDIAHD=10)
35961 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE,
35962 & F3M(2,2,8),F4M(2,2,8),FST(2,2,8),
35963 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
35964 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
35965 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
35966 INTEGER P1,P2,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
35967 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
35968 & MA2,SH,TH,UH,IDP,DRTYPE
35969 COMMON/HWHEWS/S(8,8,2),D(8,8)
35972 C--compute the propagator factor
35973 PRE = HALF/(UH-MS(ID))
35978 10 ME(P1,P2,P3,P4) = PRE*A(P1,ID)*B(O(P2),ID)*
35979 & F4M(O(P4),P1,1)*F3M(P2,P3,2)
35982 *CMZ :- -02/10/01 10:17:10 by Peter Richardson
35983 *-- Author : Peter Richardson
35984 C-----------------------------------------------------------------------
35985 SUBROUTINE HWHS04(ID,ME)
35986 C-----------------------------------------------------------------------
35987 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
35988 C section f fbar --> gauge boson --> fermion antifermion
35989 C This diagram 1 from DAMTP-2001-83
35990 C-----------------------------------------------------------------------
35991 INCLUDE 'herwig65.inc'
35993 PARAMETER(NDIAHD=10)
35994 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE,ZI
35995 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),
35996 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
35997 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
35998 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
35999 INTEGER P1,P2,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
36000 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
36001 & MA2,SH,TH,UH,IDP,DRTYPE
36002 PARAMETER(ZI=(0.0D0,1.0D0))
36003 COMMON/HWHEWS/S(8,8,2),D(8,8)
36006 C--compute the propagator factor
36007 PRE = -ONE/(SH-MS(ID)+ZI*MWD(ID))
36013 ME(P1,P2,P3,P4) = PRE*A(P1,ID)*(
36014 & B(O(P1),ID)*F3(O(P3), P1 ,1)*F4( P1 ,O(P4),2)
36015 & +B( P1 ,ID)*F3(O(P3),O(P1),2)*F4(O(P1),O(P4),1))
36017 ME(P1,P2,P3,P4) = (0.0D0,0.0D0)
36022 *CMZ :- -02/10/01 10:17:10 by Peter Richardson
36023 *-- Author : Peter Richardson
36024 C-----------------------------------------------------------------------
36025 SUBROUTINE HWHS05(ID,ME)
36026 C-----------------------------------------------------------------------
36027 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
36028 C section gluon gluon --> fermion antifermion (1st colour flow)
36029 C N.B. a gauge choice has been made to simplify the triple gluon vertex
36030 C This diagram 4 from DAMTP-2001-83 with the gauge choice L1=2 L2=1
36031 C-----------------------------------------------------------------------
36032 INCLUDE 'herwig65.inc'
36034 PARAMETER(NDIAHD=10)
36035 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE,ZI
36036 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),
36037 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
36038 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
36039 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
36040 INTEGER P1,P2,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
36041 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
36042 & MA2,SH,TH,UH,IDP,DRTYPE
36043 PARAMETER(ZI=(0.0D0,1.0D0))
36044 COMMON/HWHEWS/S(8,8,2),D(8,8)
36047 C--compute the propagator factor
36048 PRE =+ONE/SH/(TH-MS(ID))
36053 10 ME(P1,P2,P3,P4) = PRE*(
36054 & F3(O(P3), P1 ,2)*( FTP( P1 , P2 ,1,1)*F4( P2 ,O(P4),2)
36055 & +FTP( P1 ,O(P2),1,2)*F4(O(P2),O(P4),1))
36056 & +F3(O(P3),O(P1),1)*( FTP(O(P1), P2 ,2,1)*F4( P2 ,O(P4),2)
36057 & +FTP(O(P1),O(P2),2,2)*F4(O(P2),O(P4),1)))
36060 *CMZ :- -02/10/01 10:17:10 by Peter Richardson
36061 *-- Author : Peter Richardson
36062 C-----------------------------------------------------------------------
36063 SUBROUTINE HWHS06(ID,ME)
36064 C-----------------------------------------------------------------------
36065 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
36066 C section gluon gluon --> fermion antifermion (2st colour flow)
36067 C N.B. a gauge choice has been made to simplify the triple gluon vertex
36068 C This diagram 5 from DAMTP-2001-83 with the gauge choice L1=2 L2=1
36069 C-----------------------------------------------------------------------
36070 INCLUDE 'herwig65.inc'
36072 PARAMETER(NDIAHD=10)
36073 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE,ZI
36074 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),
36075 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
36076 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
36077 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
36078 INTEGER P1,P2,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
36079 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
36080 & MA2,SH,TH,UH,IDP,DRTYPE
36081 PARAMETER(ZI=(0.0D0,1.0D0))
36082 COMMON/HWHEWS/S(8,8,2),D(8,8)
36085 C--compute the propagator factor
36086 PRE =-ONE/SH/(UH-MS(ID))
36091 10 ME(P1,P2,P3,P4) = PRE*(
36092 & F3(O(P3), P2 ,1)*( FUP( P2 , P1 ,2,2)*F4( P1 ,O(P4),1)
36093 & +FUP( P2 ,O(P1),2,1)*F4(O(P1),O(P4),2))
36094 & +F3(O(P3),O(P2),2)*( FUP(O(P2), P1 ,1,2)*F4( P1 ,O(P4),1)
36095 & +FUP(O(P2),O(P1),1,1)*F4(O(P1),O(P4),2)))
36098 *CMZ :- -02/10/01 10:17:10 by Peter Richardson
36099 *-- Author : Peter Richardson
36100 C-----------------------------------------------------------------------
36101 SUBROUTINE HWHS07(ID,ME)
36102 C-----------------------------------------------------------------------
36103 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
36104 C section gluon gluon --> fermion antifermion (triple gluon piece)
36105 C N.B. a gauge choice has been made to simplify the triple gluon vertex
36106 C This diagram 6 from DAMTP-2001-83 with the gauge choice L1=2 L2=1
36107 C-----------------------------------------------------------------------
36108 INCLUDE 'herwig65.inc'
36110 PARAMETER(NDIAHD=10)
36111 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE,ZI
36112 & ,F3M(2,2,8),F4M(2,2,8),MET,FST(2,2,8),
36113 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
36114 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
36115 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
36116 INTEGER I,P1,P2,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
36117 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
36118 & MA2,SH,TH,UH,IDP,DRTYPE
36119 PARAMETER(ZI=(0.0D0,1.0D0))
36120 COMMON/HWHEWS/S(8,8,2),D(8,8)
36123 C--compute the propagator factor
36127 MET = (0.0D0,0.0D0)
36129 5 MET=MET+F3(O(P3),I,1)*F4(I,O(P4),1)-F3(O(P3),I,2)*F4(I,O(P4),2)
36133 ME(P1,P2,P3,P4) = PRE*S(1,2,P1)*S(1,2,O(P1))*MET
36135 ME(P1,P2,P3,P4) = (0.0D0,0.0D0)
36140 *CMZ :- -02/10/01 10:17:10 by Peter Richardson
36141 *-- Author : Peter Richardson
36142 C-----------------------------------------------------------------------
36143 SUBROUTINE HWHS08(ID,ME)
36144 C-----------------------------------------------------------------------
36145 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
36146 C section quark gluon --> fermion sfermion
36147 C This diagram 7 from DAMTP-2001-83 with the gauge choice L2=1
36148 C-----------------------------------------------------------------------
36149 INCLUDE 'herwig65.inc'
36151 PARAMETER(NDIAHD=10)
36152 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE,ZI
36153 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),
36154 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
36155 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
36156 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH,HWULDO,XMASS,PLAB,PRW,PCM
36157 INTEGER P1,P2,P3,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
36158 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
36159 & MA2,SH,TH,UH,IDP,DRTYPE
36160 PARAMETER(ZI=(0.0D0,1.0D0))
36161 COMMON/HWHEWS/S(8,8,2),D(8,8)
36162 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
36166 C--compute the propagator factor
36167 PRE = HALF*SQRT(HWULDO(PCM(1,8),PCM(1,4)))/SQRT(TWO)/
36168 & SQRT(HWULDO(PCM(1,1),PCM(1,2)))/
36173 ME(P1,P2,P3,2) = ZERO
36174 10 ME(P1,P2,P3,1) = A(P1,ID)*PRE*FST(P2,P2,1)*F3(O(P3), P1,1)
36177 *CMZ :- -02/10/01 10:17:10 by Peter Richardson
36178 *-- Author : Peter Richardson
36179 C-----------------------------------------------------------------------
36180 SUBROUTINE HWHS09(ID,ME)
36181 C-----------------------------------------------------------------------
36182 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
36183 C section antiquark gluon --> fermion antisfermion
36184 C This diagram 10 from DAMTP-2001-83 with the gauge choice L2=1
36185 C-----------------------------------------------------------------------
36186 INCLUDE 'herwig65.inc'
36188 PARAMETER(NDIAHD=10)
36189 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE,ZI
36190 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),
36191 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
36192 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
36193 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH,HWULDO,XMASS,PLAB,PRW,PCM
36194 INTEGER P1,P2,P3,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
36195 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
36196 & MA2,SH,TH,UH,IDP,DRTYPE
36197 PARAMETER(ZI=(0.0D0,1.0D0))
36198 COMMON/HWHEWS/S(8,8,2),D(8,8)
36199 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
36203 C--compute the propagator factor
36204 PRE = HALF*SQRT(HWULDO(PCM(1,8),PCM(1,4)))/SQRT(TWO)/
36205 & SQRT(HWULDO(PCM(1,1),PCM(1,2)))/
36210 ME(P1,P2,P3,2) = ZERO
36211 10 ME(P1,P2,P3,1) = A(O(P1),ID)*PRE*FST(P2,P2,1)*F3M(P1,P3,1)
36214 *CMZ :- -02/10/01 10:17:10 by Peter Richardson
36215 *-- Author : Peter Richardson
36216 C-----------------------------------------------------------------------
36217 SUBROUTINE HWHS10(ID,ME)
36218 C-----------------------------------------------------------------------
36219 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
36220 C section quark gluon --> fermion antisfermion (s-channel quark)
36221 C This is diagram 8 from DAMTP-2001-83 with the gauge choice L2=1
36222 C-----------------------------------------------------------------------
36223 INCLUDE 'herwig65.inc'
36225 PARAMETER(NDIAHD=10)
36226 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE,ZI
36227 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),
36228 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
36229 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
36230 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH,HWULDO,XMASS,PLAB,PRW,PCM
36231 INTEGER P1,P2,P3,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
36232 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
36233 & MA2,SH,TH,UH,IDP,DRTYPE
36234 PARAMETER(ZI=(0.0D0,1.0D0))
36235 COMMON/HWHEWS/S(8,8,2),D(8,8)
36236 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
36240 C--compute the propagator factor
36241 PRE = SQRT(HWULDO(PCM(1,8),PCM(1,4)))/SQRT(TWO)/
36242 & SQRT(HWULDO(PCM(1,1),PCM(1,2)))/SH
36247 ME(p1,p2,p3,1) = PRE*A( P2 ,ID)*F3(O(P3), P2 ,1)*S(1,2,P2)*
36250 ME(P1,P2,P3,1) = PRE*
36251 & A(O(P2),ID)*( F3(O(P3),O(P2),1)*S(1,1,O(P2))
36252 & +F3(O(P3),O(P2),2)*S(2,1,O(P2)))*S(2,1,P2)
36254 10 ME(P1,P2,P3,2) = ZERO
36257 *CMZ :- -02/10/01 10:17:10 by Peter Richardson
36258 *-- Author : Peter Richardson
36259 C-----------------------------------------------------------------------
36260 SUBROUTINE HWHS11(ID,ME)
36261 C-----------------------------------------------------------------------
36262 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
36263 C section quark gluon --> fermion antisfermion (s-channel quark)
36264 C This is diagram 11 from DAMTP-2001-83 with the gauge choice L2=1
36265 C-----------------------------------------------------------------------
36266 INCLUDE 'herwig65.inc'
36268 PARAMETER(NDIAHD=10)
36269 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE,ZI
36270 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),
36271 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
36272 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
36273 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH,HWULDO,XMASS,PLAB,PRW,PCM
36274 INTEGER P1,P2,P3,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
36275 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
36276 & MA2,SH,TH,UH,IDP,DRTYPE
36277 PARAMETER(ZI=(0.0D0,1.0D0))
36278 COMMON/HWHEWS/S(8,8,2),D(8,8)
36279 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
36283 C--compute the propagator factor
36284 PRE = SQRT(HWULDO(PCM(1,8),PCM(1,4)))/SQRT(TWO)/
36285 & SQRT(HWULDO(PCM(1,1),PCM(1,2)))/SH
36290 ME(P1,P2,P3,1) = PRE*A(O(P2),ID)*S(1,2,P1)*
36291 & (S(1,1,O(P2))*F3M(P2,P3,1)+S(1,2,O(P2))*F3M(P2,P3,2))
36293 ME(P1,P2,P3,1)=PRE*A(P2,ID)*S(1,1,P1)*S(2,1,P2)*F3M(O(P2),P3,1)
36295 10 ME(P1,P2,P3,2) = ZERO
36298 *CMZ :- -02/10/01 10:17:10 by Peter Richardson
36299 *-- Author : Peter Richardson
36300 C-----------------------------------------------------------------------
36301 SUBROUTINE HWHS12(ID,ME)
36302 C-----------------------------------------------------------------------
36303 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
36304 C section quark gluon --> fermion antisfermion (s-channel quark)
36305 C This is diagram 9 from DAMTP-2001-83 with the gauge choice L2=1
36306 C-----------------------------------------------------------------------
36307 INCLUDE 'herwig65.inc'
36309 PARAMETER(NDIAHD=10)
36310 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE,ZI
36311 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),
36312 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
36313 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
36314 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH,HWULDO,XMASS,PLAB,PRW,PCM
36315 INTEGER P1,P2,P3,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
36316 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
36317 & MA2,SH,TH,UH,IDP,DRTYPE
36318 PARAMETER(ZI=(0.0D0,1.0D0))
36319 COMMON/HWHEWS/S(8,8,2),D(8,8)
36320 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
36324 C--compute the propagator factor
36325 PRE =-SQRT(HWULDO(PCM(1,8),PCM(1,4)))/SQRT(TWO)/
36326 & SQRT(HWULDO(PCM(1,1),PCM(1,2)))/(UH-MS(ID))
36330 ME(P1,P2,P3,1) = PRE*A(P1,ID)*(
36331 & F3(O(P3), P2 ,1)*FUP( P2 ,P1, 2,1)
36332 & +F3(O(P3),O(P2), 2)*FUP(O(P2),P1,1,1))
36333 10 ME(P1,P2,P3,2) = ZERO
36336 *CMZ :- -02/10/01 10:17:10 by Peter Richardson
36337 *-- Author : Peter Richardson
36338 C-----------------------------------------------------------------------
36339 SUBROUTINE HWHS13(ID,ME)
36340 C-----------------------------------------------------------------------
36341 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
36342 C section quark gluon --> fermion antisfermion (s-channel quark)
36343 C This is diagram 12 from DAMTP-2001-83 with the gauge choice L2=1
36344 C-----------------------------------------------------------------------
36345 INCLUDE 'herwig65.inc'
36347 PARAMETER(NDIAHD=10)
36348 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE,ZI
36349 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),
36350 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
36351 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
36352 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH,HWULDO,XMASS,PLAB,PRW,PCM
36353 INTEGER P1,P2,P3,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
36354 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
36355 & MA2,SH,TH,UH,IDP,DRTYPE
36356 PARAMETER(ZI=(0.0D0,1.0D0))
36357 COMMON/HWHEWS/S(8,8,2),D(8,8)
36358 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
36362 C--compute the propagator factor
36363 PRE =-SQRT(HWULDO(PCM(1,8),PCM(1,4)))/SQRT(TWO)/
36364 & SQRT(HWULDO(PCM(1,1),PCM(1,2)))/(UH-MS(ID))
36368 ME(P1,P2,P3,1) = PRE*A(O(P1),ID)*(
36369 & FUM(P1, P2 ,1,1)*F3M( P2 ,P3, 2)
36370 & +FUM(P1,O(P2),1, 2)*F3M(O(P2),P3,1))
36371 10 ME(P1,P2,P3,2) = ZERO
36374 *CMZ :- -02/10/01 10:17:10 by Peter Richardson
36375 *-- Author : Peter Richardson
36376 C-----------------------------------------------------------------------
36377 SUBROUTINE HWHS14(ID,ME)
36378 C-----------------------------------------------------------------------
36379 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
36380 C section gluon gluon --> fermion antifermion (1st colour flow)
36381 C N.B. a gauge choice has been made to simplify the triple gluon vertex
36382 C This diagram 4 from DAMTP-2001-83 with opposite helicity for 4
36383 C and gauge choice L1=2 L2=1
36384 C-----------------------------------------------------------------------
36385 INCLUDE 'herwig65.inc'
36387 PARAMETER(NDIAHD=10)
36388 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE,ZI,
36389 & F3M(2,2,8),F4M(2,2,8),FST(2,2,8),FTP(2,2,8,8),FTM(2,2,8,8),
36390 & FUP(2,2,8,8),FUM(2,2,8,8)
36391 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
36392 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
36393 INTEGER P1,P2,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
36394 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
36395 & MA2,SH,TH,UH,IDP,DRTYPE
36396 PARAMETER(ZI=(0.0D0,1.0D0))
36397 COMMON/HWHEWS/S(8,8,2),D(8,8)
36400 C--compute the propagator factor
36401 PRE =+ONE/(TH-MS(ID))/SH
36407 10 ME(P1,P2,P3,P4) = PRE*(
36408 & F3(O(P3), P1 ,2)*( FTP( P1 , P2 , 1,1)*F4( P2 ,P4,2)
36409 & +FTP( P1 ,O(P2), 1,2)*F4(O(P2),P4,1))
36410 & +F3(O(P3),O(P1),1)*( FTP(O(P1), P2 ,2,1)*F4( P2 ,P4,2)
36411 & +FTP(O(P1),O(P2),2,2)*F4(O(P2),P4,1)))
36414 *CMZ :- -02/10/01 10:17:10 by Peter Richardson
36415 *-- Author : Peter Richardson
36416 C-----------------------------------------------------------------------
36417 SUBROUTINE HWHS15(ID,ME)
36418 C-----------------------------------------------------------------------
36419 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
36420 C section gluon gluon --> fermion antifermion (2st colour flow)
36421 C N.B. a gauge choice has been made to simplify the triple gluon vertex
36422 C This diagram 5 from DAMTP-2001-83 with opposite helicity for 4
36423 C and gauge choice L1=2 L2=1
36424 C-----------------------------------------------------------------------
36425 INCLUDE 'herwig65.inc'
36427 PARAMETER(NDIAHD=10)
36428 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE,ZI,
36429 & F3M(2,2,8),F4M(2,2,8),FST(2,2,8),FTP(2,2,8,8),FTM(2,2,8,8),
36430 & FUP(2,2,8,8),FUM(2,2,8,8)
36431 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
36432 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
36433 INTEGER P1,P2,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
36434 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST, A,B,MS,MWD,MR,MA,
36435 & MA2,SH,TH,UH,IDP,DRTYPE
36436 PARAMETER(ZI=(0.0D0,1.0D0))
36437 COMMON/HWHEWS/S(8,8,2),D(8,8)
36440 C--compute the propagator factor
36441 PRE =-ONE/(UH-MS(ID))/SH
36447 10 ME(P1,P2,P3,P4) = PRE*(
36448 & F3(O(P3), P2 ,1)*( FUP( P2 , P1 ,2,2)*F4( P1 ,P4,1)
36449 & +FUP( P2 ,O(P1),2,1)*F4(O(P1),P4,2))
36450 &+F3(O(P3),O(P2),2)*( FUP(O(P2), P1 ,1,2)*F4( P1 ,P4,1)
36451 & +FUP(O(P2),O(P1),1,1)*F4(O(P1),P4,2)))
36454 *CMZ :- -02/10/01 10:17:10 by Peter Richardson
36455 *-- Author : Peter Richardson
36456 C-----------------------------------------------------------------------
36457 SUBROUTINE HWHS16(ID,ME)
36458 C-----------------------------------------------------------------------
36459 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
36460 C section gluon gluon --> fermion antifermion (triple gluon piece)
36461 C N.B. a gauge choice has been made to simplify the triple gluon vertex
36462 C This diagram 6 from DAMTP-2001-83 with opposite helicity for 4
36463 C and gauge choice L1=2 L2=1
36464 C-----------------------------------------------------------------------
36465 INCLUDE 'herwig65.inc'
36467 PARAMETER(NDIAHD=10)
36468 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE,ZI
36469 & ,F3M(2,2,8),F4M(2,2,8),MET,FST(2,2,8),
36470 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
36471 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
36472 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
36473 INTEGER I,P1,P2,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
36474 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
36475 & MA2,SH,TH,UH,IDP,DRTYPE
36476 PARAMETER(ZI=(0.0D0,1.0D0))
36477 COMMON/HWHEWS/S(8,8,2),D(8,8)
36480 C--compute the propagator factor
36485 MET = (0.0D0,0.0D0)
36487 5 MET=MET+F3(O(P3),I,1)*F4(I,P4,1)-F3(O(P3),I,2)*F4(I,P4,2)
36491 ME(P1,P2,P3,P4) = PRE*MET*S(1,2,P1)*S(1,2,O(P1))
36493 ME(P1,P2,P3,P4) = (0.0D0,0.0D0)
36498 *CMZ :- -02/10/01 10:17:10 by Peter Richardson
36499 *-- Author : Peter Richardson
36500 C-----------------------------------------------------------------------
36501 SUBROUTINE HWHS17(ID,ME)
36502 C-----------------------------------------------------------------------
36503 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
36504 C section fermion fermion --> fermion fermion (t-channel boson)
36505 C This diagram 13 from DAMTP-2001-83
36506 C-----------------------------------------------------------------------
36507 INCLUDE 'herwig65.inc'
36509 PARAMETER(NDIAHD=10)
36510 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE,ZI,
36511 & F3M(2,2,8),F4M(2,2,8),FST(2,2,8),
36512 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8),DL(2,2)
36513 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
36514 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH,HWULDO,XMASS,PLAB,PRW,PCM
36515 INTEGER P1,P2,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
36516 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
36517 & MA2,SH,TH,UH,IDP,DRTYPE
36518 PARAMETER(ZI=(0.0D0,1.0D0))
36519 COMMON/HWHEWS/S(8,8,2),D(8,8)
36520 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
36524 DATA DL/(1.0,0.0D0),(0.0D0,0.0D0),(0.0D0,0.0D0),(1.0D0,0.0D0)/
36525 C--compute the propagator factor
36526 PRE = SQRT(TWO*HWULDO(PCM(1,8),PCM(1,4)))/(TH-MS(ID))
36532 ME(P1,P2,P3,P4) = PRE*A(P1,ID)*B(P2,ID)*
36533 & ( DL(P1,O(P2))*F3(O(P3), P2 ,2)*S(4,1, P2 )
36534 & +DL(P1, P2 )*F3(O(P3),O(P2),4)*S(2,1,O(P2)))
36536 ME(P1,P2,P3,P4) = (0.0D0,0.0D0)
36541 *CMZ :- -02/10/01 10:17:10 by Peter Richardson
36542 *-- Author : Peter Richardson
36543 C-----------------------------------------------------------------------
36544 SUBROUTINE HWHS18(ID,ME)
36545 C-----------------------------------------------------------------------
36546 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
36547 C section fermion antifermion --> fermion antifermion (t-channel boson)
36548 C This diagram 14 from DAMTP-2001-83
36549 C-----------------------------------------------------------------------
36550 INCLUDE 'herwig65.inc'
36552 PARAMETER(NDIAHD=10)
36553 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE,ZI,
36554 & F3M(2,2,8),F4M(2,2,8),FST(2,2,8),
36555 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8),DL(2,2)
36556 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
36557 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH,HWULDO,XMASS,PLAB,PRW,PCM
36558 INTEGER P1,P2,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
36559 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
36560 & MA2,SH,TH,UH,IDP,DRTYPE
36561 PARAMETER(ZI=(0.0D0,1.0D0))
36562 COMMON/HWHEWS/S(8,8,2),D(8,8)
36563 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
36567 DATA DL/(1.0,0.0D0),(0.0D0,0.0D0),(0.0D0,0.0D0),(1.0D0,0.0D0)/
36568 C--compute the propagator factor
36569 PRE = SQRT(TWO*HWULDO(PCM(1,8),PCM(1,4)))/(TH-MS(ID))
36575 ME(P1,P2,P3,P4) = PRE*A(P1,ID)*B(P2,ID)*
36576 & ( DL(P1,O(P2))*F3(O(P3), P2 ,4)*S(2,1, P2 )
36577 & +DL(P1, P2 )*F3(O(P3),O(P2),2)*S(4,1,O(P2)))
36579 ME(P1,P2,P3,P4) = (0.0D0,0.0D0)
36584 *CMZ :- -02/10/01 10:17:10 by Peter Richardson
36585 *-- Author : Peter Richardson
36586 C-----------------------------------------------------------------------
36587 SUBROUTINE HWHS19(ID,ME)
36588 C-----------------------------------------------------------------------
36589 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
36590 C section antifermion fermion --> antifermion fermion (t-channel boson)
36591 C This diagram 15 from DAMTP-2001-83
36592 C-----------------------------------------------------------------------
36593 INCLUDE 'herwig65.inc'
36595 PARAMETER(NDIAHD=10)
36596 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE,ZI,
36597 & F3M(2,2,8),F4M(2,2,8),FST(2,2,8),
36598 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8),DL(2,2)
36599 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
36600 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH,HWULDO,XMASS,PLAB,PRW,PCM
36601 INTEGER P1,P2,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
36602 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
36603 & MA2,SH,TH,UH,IDP,DRTYPE
36604 PARAMETER(ZI=(0.0D0,1.0D0))
36605 COMMON/HWHEWS/S(8,8,2),D(8,8)
36606 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
36610 DATA DL/(1.0,0.0D0),(0.0D0,0.0D0),(0.0D0,0.0D0),(1.0D0,0.0D0)/
36611 C--compute the propagator factor
36612 PRE = SQRT(TWO*HWULDO(PCM(1,8),PCM(1,4)))/(TH-MS(ID))
36618 ME(P1,P2,P3,P4) = PRE*A(P1,ID)*B(P2,ID)*
36619 & ( DL(P1,O(P2))*S(1,2, P1 )*F3M( P2 ,O(P3),4)
36620 & +DL(P1, P2 )*S(1,4, P1 )*F3M(O(P2),O(P3),2))
36622 ME(P1,P2,P3,P4) = (0.0D0,0.0D0)
36627 *CMZ :- -02/10/01 10:17:10 by Peter Richardson
36628 *-- Author : Peter Richardson
36629 C-----------------------------------------------------------------------
36630 SUBROUTINE HWHS20(ID,ME)
36631 C-----------------------------------------------------------------------
36632 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
36633 C section antifermion fermion --> antifermion fermion (t-channel boson)
36634 C This diagram 16 from DAMTP-2001-83
36635 C-----------------------------------------------------------------------
36636 INCLUDE 'herwig65.inc'
36638 PARAMETER(NDIAHD=10)
36639 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE,ZI,
36640 & F3M(2,2,8),F4M(2,2,8),FST(2,2,8),
36641 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8),DL(2,2)
36642 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
36643 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH,HWULDO,XMASS,PLAB,PRW,PCM
36644 INTEGER P1,P2,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
36645 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
36646 & MA2,SH,TH,UH,IDP,DRTYPE
36647 PARAMETER(ZI=(0.0D0,1.0D0))
36648 COMMON/HWHEWS/S(8,8,2),D(8,8)
36649 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
36653 DATA DL/(1.0,0.0D0),(0.0D0,0.0D0),(0.0D0,0.0D0),(1.0D0,0.0D0)/
36654 C--compute the propagator factor
36655 PRE = SQRT(TWO*HWULDO(PCM(1,8),PCM(1,4)))/(TH-MS(ID))
36661 ME(P1,P2,P3,P4) = PRE*A(P1,ID)*B(P2,ID)*
36662 & ( DL(P1,O(P2))*S(1,4, P1 )*F3M( P2 ,O(P3),2)
36663 & +DL(P1, P2 )*S(1,2, P1 )*F3M(O(P2),O(P3),4))
36665 ME(P1,P2,P3,P4) = (0.0D0,0.0D0)
36670 *CMZ :- -02/10/01 10:17:10 by Peter Richardson
36671 *-- Author : Peter Richardson
36672 C-----------------------------------------------------------------------
36673 SUBROUTINE HWHS21(ID,ME)
36674 C-----------------------------------------------------------------------
36675 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
36676 C section f fbar ---> f fbar via s-channel scalar exchange
36677 C This is diagram 1 from RPV notes
36678 C-----------------------------------------------------------------------
36679 INCLUDE 'herwig65.inc'
36681 PARAMETER(NDIAHD=10)
36682 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE
36683 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),ZI,
36684 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
36685 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
36686 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
36687 INTEGER P1,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
36688 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
36689 & MA2,SH,TH,UH,IDP,DRTYPE
36690 COMMON/HWHEWS/S(8,8,2),D(8,8)
36691 PARAMETER(ZI=(0.0D0,1.0D0))
36694 C--compute the propagator factor
36695 PRE = HALF/(SH-MS(ID)+ZI*MWD(ID))
36699 ME(P1, P1 ,P3,P4) = (0.0D0,0.0D0)
36700 10 ME(P1,O(P1),P3,P4) = PRE*A(P1,ID)*S(2,1,O(P1))*
36701 & ( B( P4 ,ID)*F3(O(P3), P4 ,4)*S(4,8,P4)
36702 & -B(O(P4),ID)*F3(O(P3),O(P4),8)*MA(4))
36705 *CMZ :- -08/04/02 11:54:39 by Peter Richardson
36706 *-- Author : Peter Richardson
36707 C-----------------------------------------------------------------------
36708 SUBROUTINE HWHS22(ID,ME)
36709 C-----------------------------------------------------------------------
36710 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
36711 C section f fbar ---> f fbar via t-channel scalar exchange
36712 C This is diagram 2 from RPV notes
36713 C-----------------------------------------------------------------------
36714 INCLUDE 'herwig65.inc'
36716 PARAMETER(NDIAHD=10)
36717 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE
36718 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),
36719 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
36720 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
36721 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
36722 INTEGER P1,P2,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
36723 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
36724 & MA2,SH,TH,UH,IDP,DRTYPE
36725 COMMON/HWHEWS/S(8,8,2),D(8,8)
36728 C--compute the propagator factor
36729 PRE = -HALF/(TH-MS(ID))
36734 10 ME(P1,P2,P3,P4) = PRE*B(O(P2),ID)*A( P1 ,ID)*
36735 & F4(P2,O(P4),2)*F3(O(P3),P1,1)
36738 *CMZ :- -08/04/02 11:54:39 by Peter Richardson
36739 *-- Author : Peter Richardson
36740 C-----------------------------------------------------------------------
36741 SUBROUTINE HWHS23(ID,ME)
36742 C-----------------------------------------------------------------------
36743 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
36744 C section f fbar ---> fermion fermion via t-channel scalar exchange
36745 C This is diagram 3 from RPV notes
36746 C-----------------------------------------------------------------------
36747 INCLUDE 'herwig65.inc'
36749 PARAMETER(NDIAHD=10)
36750 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE
36751 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),
36752 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
36753 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
36754 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
36755 INTEGER P1,P2,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
36756 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
36757 & MA2,SH,TH,UH,IDP,DRTYPE
36758 COMMON/HWHEWS/S(8,8,2),D(8,8)
36761 C--compute the propagator factor
36762 PRE = HALF/(UH-MS(ID))
36767 10 ME(P1,P2,P3,P4) = PRE*B(O(P2),ID)*A( P1 ,ID)*
36768 & F4M(P4,P1,1)*F3M(P2,P3,2)
36771 *CMZ :- -08/04/02 11:54:39 by Peter Richardson
36772 *-- Author : Peter Richardson
36773 C-----------------------------------------------------------------------
36774 SUBROUTINE HWHS24(ID,ME)
36775 C-----------------------------------------------------------------------
36776 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
36777 C section f fbar ---> f f via s-channel scalar exchange
36778 C This is diagram 4 from RPV notes
36779 C-----------------------------------------------------------------------
36780 INCLUDE 'herwig65.inc'
36782 PARAMETER(NDIAHD=10)
36783 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE
36784 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),ZI,
36785 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
36786 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
36787 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
36788 INTEGER P1,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
36789 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
36790 & MA2,SH,TH,UH,IDP,DRTYPE
36791 COMMON/HWHEWS/S(8,8,2),D(8,8)
36792 PARAMETER(ZI=(0.0D0,1.0D0))
36795 C--compute the propagator factor
36796 PRE = HALF/(SH-MS(ID)+ZI*MWD(ID))
36800 ME(P1, P1 ,P3,P4) = (0.0D0,0.0D0)
36801 10 ME(P1,O(P1),P3,P4) = PRE*A(P1,ID)*S(2,1,O(P1))*
36802 & ( B(O(P3),ID)*F4M(O(P4),O(P3),3)*S(3,7,O(P3))
36803 & -B( P3 ,ID)*F4M(O(P4), P3 ,7)*MA(3))
36806 *CMZ :- -08/04/02 11:54:39 by Peter Richardson
36807 *-- Author : Peter Richardson
36808 C-----------------------------------------------------------------------
36809 SUBROUTINE HWHS25(ID,ME)
36810 C-----------------------------------------------------------------------
36811 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
36812 C section f fbar ---> f f via u-channel scalar exchange
36813 C This is diagram 5 from RPV notes
36814 C-----------------------------------------------------------------------
36815 INCLUDE 'herwig65.inc'
36817 PARAMETER(NDIAHD=10)
36818 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE
36819 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),
36820 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
36821 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
36822 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
36823 INTEGER P1,P2,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
36824 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
36825 & MA2,SH,TH,UH,IDP,DRTYPE
36826 COMMON/HWHEWS/S(8,8,2),D(8,8)
36829 C--compute the propagator factor
36830 PRE = -HALF/(UH-MS(ID))
36835 10 ME(P1,P2,P3,P4) = PRE*B(P1,ID)*A(O(P2),ID)*
36836 & F4M(O(P4),P1,1)*F3M(P2,P3,2)
36839 *CMZ :- -08/04/02 11:54:39 by Peter Richardson
36840 *-- Author : Peter Richardson
36841 C-----------------------------------------------------------------------
36842 SUBROUTINE HWHS26(ID,ME)
36843 C-----------------------------------------------------------------------
36844 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
36845 C section f fbar ---> f f via t-channel scalar exchange
36846 C This is diagram 6 from RPV notes
36847 C-----------------------------------------------------------------------
36848 INCLUDE 'herwig65.inc'
36850 PARAMETER(NDIAHD=10)
36851 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE
36852 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),
36853 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
36854 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
36855 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
36856 INTEGER P1,P2,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
36857 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
36858 & MA2,SH,TH,UH,IDP,DRTYPE
36859 COMMON/HWHEWS/S(8,8,2),D(8,8)
36862 C--compute the propagator factor
36863 PRE = HALF/(TH-MS(ID))
36868 10 ME(P1,P2,P3,P4) = PRE*B(P1,ID)*A(O(P2),ID)*
36869 & F4(P2,P4,2)*F3(O(P3),P1,1)
36872 *CMZ :- -08/04/02 11:54:39 by Peter Richardson
36873 *-- Author : Peter Richardson
36874 C-----------------------------------------------------------------------
36875 SUBROUTINE HWHS27(ID,ME)
36876 C-----------------------------------------------------------------------
36877 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
36878 C section f f ---> f fbar via s-channel scalar exchange
36879 C This is diagram 7 from RPV notes
36880 C-----------------------------------------------------------------------
36881 INCLUDE 'herwig65.inc'
36883 PARAMETER(NDIAHD=10)
36884 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE
36885 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),ZI,
36886 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
36887 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
36888 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
36889 INTEGER P1,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
36890 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
36891 & MA2,SH,TH,UH,IDP,DRTYPE
36892 COMMON/HWHEWS/S(8,8,2),D(8,8)
36893 PARAMETER(ZI=(0.0D0,1.0D0))
36896 C--compute the propagator factor
36897 PRE =-HALF/(SH-MS(ID)+ZI*MWD(ID))
36901 ME(P1,O(P1),P3,P4) = (0.0D0,0.0D0)
36902 10 ME(P1, P1 ,P3,P4) = PRE*A(P1,ID)*S(1,2,O(P1))*
36903 & ( B( P4 ,ID)*F3(O(P3), P4 ,4)*S(4,8,P4)
36904 & -B(O(P4),ID)*F3(O(P3),O(P4),8)*MA(4))
36907 *CMZ :- -08/04/02 11:54:39 by Peter Richardson
36908 *-- Author : Peter Richardson
36909 C-----------------------------------------------------------------------
36910 SUBROUTINE HWHS28(ID,ME)
36911 C-----------------------------------------------------------------------
36912 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
36913 C section f f ---> f fbar via t-channel scalar exchange
36914 C This is diagram 8 from RPV notes
36915 C-----------------------------------------------------------------------
36916 INCLUDE 'herwig65.inc'
36918 PARAMETER(NDIAHD=10)
36919 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE
36920 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),ZI,
36921 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
36922 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
36923 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
36924 INTEGER P1,P2,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
36925 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
36926 & MA2,SH,TH,UH,IDP,DRTYPE
36927 COMMON/HWHEWS/S(8,8,2),D(8,8)
36928 PARAMETER(ZI=(0.0D0,1.0D0))
36931 C--compute the propagator factor
36932 PRE = -HALF/(TH-MS(ID))
36937 10 ME(P1,P2,P3,P4) = PRE*B(P2,ID)*A( P1 ,ID)*
36938 & F4(O(P2),O(P4),2)*F3(O(P3),P1,1)
36941 *CMZ :- -08/04/02 11:54:39 by Peter Richardson
36942 *-- Author : Peter Richardson
36943 C-----------------------------------------------------------------------
36944 SUBROUTINE HWHS29(ID,ME)
36945 C-----------------------------------------------------------------------
36946 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
36947 C section f f ---> f fbar via u-channel scalar exchange
36948 C This is diagram 9 from RPV notes
36949 C-----------------------------------------------------------------------
36950 INCLUDE 'herwig65.inc'
36952 PARAMETER(NDIAHD=10)
36953 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE
36954 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),ZI,
36955 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
36956 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
36957 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
36958 INTEGER P1,P2,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
36959 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
36960 & MA2,SH,TH,UH,IDP,DRTYPE
36961 COMMON/HWHEWS/S(8,8,2),D(8,8)
36962 PARAMETER(ZI=(0.0D0,1.0D0))
36965 C--compute the propagator factor
36966 PRE = HALF/(UH-MS(ID))
36971 10 ME(P1,P2,P3,P4) = PRE*B(P2,ID)*A(P1,ID)*
36972 & F3(O(P3),P2,2)*F4(O(P1),O(P4),1)
36975 *CMZ :- -08/04/02 11:54:39 by Peter Richardson
36976 *-- Author : Peter Richardson
36977 C-----------------------------------------------------------------------
36978 SUBROUTINE HWHS30(ID,ME)
36979 C-----------------------------------------------------------------------
36980 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
36981 C section fbar fbar ---> f f via s-channel scalar exchange
36982 C This is diagram 10 from RPV notes
36983 C-----------------------------------------------------------------------
36984 INCLUDE 'herwig65.inc'
36986 PARAMETER(NDIAHD=10)
36987 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE
36988 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),ZI,
36989 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
36990 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
36991 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
36992 INTEGER P1,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
36993 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
36994 & MA2,SH,TH,UH,IDP,DRTYPE
36995 COMMON/HWHEWS/S(8,8,2),D(8,8)
36996 PARAMETER(ZI=(0.0D0,1.0D0))
36999 C--compute the propagator factor
37000 PRE = HALF/(SH-MS(ID)+ZI*MWD(ID))
37004 ME(P1,O(P1),P3,P4) = (0.0D0,0.0D0)
37005 10 ME(P1, P1 ,P3,P4) = PRE*A(O(P1),ID)*S(2,1,P1)*
37006 & ( B(O(P3),ID)*F4M(O(P4),O(P3),3)*S(3,7,O(P3))
37007 & -B( P3 ,ID)*F4M(O(P4), P3 ,7)*MA(3))
37010 *CMZ :- -08/04/02 11:54:39 by Peter Richardson
37011 *-- Author : Peter Richardson
37012 C-----------------------------------------------------------------------
37013 SUBROUTINE HWHS31(ID,ME)
37014 C-----------------------------------------------------------------------
37015 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
37016 C section fbar fbar ---> f f via t-channel scalar exchange
37017 C This is diagram 11 from RPV notes
37018 C-----------------------------------------------------------------------
37019 INCLUDE 'herwig65.inc'
37021 PARAMETER(NDIAHD=10)
37022 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE
37023 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),ZI,
37024 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
37025 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
37026 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
37027 INTEGER P1,P2,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
37028 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
37029 & MA2,SH,TH,UH,IDP,DRTYPE
37030 COMMON/HWHEWS/S(8,8,2),D(8,8)
37031 PARAMETER(ZI=(0.0D0,1.0D0))
37034 C--compute the propagator factor
37035 PRE = HALF/(TH-MS(ID))
37040 10 ME(P1,P2,P3,P4) = PRE*B(O(P2),ID)*A(O(P1),ID)*
37041 & F4M(O(P4),O(P2),2)*F3M(P1,P3,1)
37044 *CMZ :- -08/04/02 11:54:39 by Peter Richardson
37045 *-- Author : Peter Richardson
37046 C-----------------------------------------------------------------------
37047 SUBROUTINE HWHS32(ID,ME)
37048 C-----------------------------------------------------------------------
37049 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
37050 C section fbar fbar ---> f f via u-channel scalar exchange
37051 C This is diagram 12 from RPV notes
37052 C-----------------------------------------------------------------------
37053 INCLUDE 'herwig65.inc'
37055 PARAMETER(NDIAHD=10)
37056 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE
37057 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),ZI,
37058 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
37059 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
37060 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
37061 INTEGER P1,P2,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
37062 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
37063 & MA2,SH,TH,UH,IDP,DRTYPE
37064 COMMON/HWHEWS/S(8,8,2),D(8,8)
37065 PARAMETER(ZI=(0.0D0,1.0D0))
37068 C--compute the propagator factor
37069 PRE =-HALF/(UH-MS(ID))
37074 10 ME(P1,P2,P3,P4) = PRE*B(O(P2),ID)*A(O(P1),ID)*
37075 & F4M(O(P4),O(P1),1)*F3M(P2,P3,2)
37078 *CMZ :- -08/04/02 11:54:39 by Peter Richardson
37079 *-- Author : Peter Richardson
37080 C-----------------------------------------------------------------------
37081 SUBROUTINE HWHS33(ID,ME)
37082 C-----------------------------------------------------------------------
37083 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
37084 C section f f ---> f f via s-channel scalar exchange
37085 C This is diagram 13 from RPV
37086 C-----------------------------------------------------------------------
37087 INCLUDE 'herwig65.inc'
37089 PARAMETER(NDIAHD=10)
37090 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE
37091 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),ZI,
37092 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
37093 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
37094 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
37095 INTEGER P1,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
37096 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
37097 & MA2,SH,TH,UH,IDP,DRTYPE
37098 COMMON/HWHEWS/S(8,8,2),D(8,8)
37099 PARAMETER(ZI=(0.0D0,1.0D0))
37102 C--compute the propagator factor
37103 PRE = HALF/(SH-MS(ID)+ZI*MWD(ID))
37107 ME(P1,O(P1),P3,P4) = (0.0D0,0.0D0)
37108 10 ME(P1, P1 ,P3,P4) = PRE*A(P1,ID)*S(1,2,O(P1))*
37109 & ( B(O(P3),ID)*F4M(O(P4),O(P3),3)*S(3,7,O(P3))
37110 & -B( P3 ,ID)*F4M(O(P4), P3 ,7)*MA(3))
37113 *CMZ :- -08/04/02 11:54:39 by Peter Richardson
37114 *-- Author : Peter Richardson
37115 C-----------------------------------------------------------------------
37116 SUBROUTINE HWHS34(ID,ME)
37117 C-----------------------------------------------------------------------
37118 C Subroutine to calculate the helicity amplitudes for the 2-to-2 cross
37119 C section fbar fbar ---> fbar fbar via t-channel scalar exchange
37120 C This is diagram 14 from RPV notes
37121 C-----------------------------------------------------------------------
37122 INCLUDE 'herwig65.inc'
37124 PARAMETER(NDIAHD=10)
37125 DOUBLE COMPLEX ME(2,2,2,2),S,D,F3(2,2,8),F4(2,2,8),PRE
37126 & ,F3M(2,2,8),F4M(2,2,8),FST(2,2,8),ZI,
37127 & FTP(2,2,8,8),FTM(2,2,8,8),FUP(2,2,8,8),FUM(2,2,8,8)
37128 DOUBLE PRECISION A(2,NDIAHD),B(2,NDIAHD),MS(NDIAHD),MWD(NDIAHD),
37129 & MA(4),MA2(4),MR(NDIAHD),SH,TH,UH
37130 INTEGER P1,P3,P4,ID,O(2),IDP(4+NDIAHD),DRTYPE(NDIAHD)
37131 COMMON/HWSPHC/F3,F4,F3M,F4M,FTP,FTM,FUP,FUM,FST,A,B,MS,MWD,MR,MA,
37132 & MA2,SH,TH,UH,IDP,DRTYPE
37133 COMMON/HWHEWS/S(8,8,2),D(8,8)
37134 PARAMETER(ZI=(0.0D0,1.0D0))
37137 C--compute the propagator factor
37138 PRE = HALF/(SH-MS(ID)+ZI*MWD(ID))
37142 ME(P1,O(P1),P3,P4) = (0.0D0,0.0D0)
37143 10 ME(P1, P1 ,P3,P4) = PRE*A(O(P1),ID)*S(2,1,P1)*
37144 & ( B( P4 ,ID)*F3(P3, P4 ,4)*S(4,8,P4)
37145 & -B(O(P4),ID)*F3(P3,O(P4),8)*MA(4))
37148 *CMZ :- -18/05/99 20.33.45 by Kosuke Odagiri
37149 *-- Author : Kosuke Odagiri
37150 C-----------------------------------------------------------------------
37151 FUNCTION HWHSS1(S, T, U, M3, M4, SGN, CLL, CLR, CRL, CRR)
37152 C-----------------------------------------------------------------------
37153 C QQ(BAR) -> GAUGINOS
37154 C-----------------------------------------------------------------------
37156 DOUBLE PRECISION HWHSS1, S, T, U, M3, M4, SGN
37157 DOUBLE COMPLEX CLL, CLR, CRL, CRR
37159 & (DCONJG(CLL)*CLL+DCONJG(CRR)*CRR)*(U-M3*M3)*(U-M4*M4)+
37160 & (DCONJG(CLR)*CLR+DCONJG(CRL)*CRL)*(T-M3*M3)*(T-M4*M4)+
37161 & (DCONJG(CLL)*CLR+DCONJG(CRL)*CRR)*2.*SGN*M3*M4*S )
37164 *CMZ :- -10/10/01 10:38:15 by Peter Richardson
37165 *-- Author : Kosuke Odagiri
37166 C-----------------------------------------------------------------------
37167 FUNCTION HWHSS2(S, T, U, M3, M4, SGN, CLL, CLR, CRL, CRR)
37168 C-----------------------------------------------------------------------
37169 C LL(BAR) -> GAUGINOS (including beam polarization)
37170 C-----------------------------------------------------------------------
37171 INCLUDE 'herwig65.inc'
37172 DOUBLE PRECISION HWHSS2, S, T, U, M3, M4, SGN
37173 DOUBLE COMPLEX CLL, CLR, CRL, CRR
37175 C--first the incoming left electron
37176 & (ONE-EPOLN(3))*(ONE+PPOLN(3))*DREAL(
37177 & DCONJG(CLL)*CLL*(U-M3*M3)*(U-M4*M4)+
37178 & DCONJG(CLR)*CLR*(T-M3*M3)*(T-M4*M4)+
37179 & DCONJG(CLL)*CLR*2.*SGN*M3*M4*S )
37180 C--then the incoming right electron
37181 &+(ONE+EPOLN(3))*(ONE-PPOLN(3))*DREAL(
37182 & DCONJG(CRR)*CRR*(U-M3*M3)*(U-M4*M4)+
37183 & DCONJG(CRL)*CRL*(T-M3*M3)*(T-M4*M4)+
37184 & DCONJG(CRL)*CRR*2.*SGN*M3*M4*S )
37187 *CMZ :- -31/03/00 17:54:05 by Peter Richardson
37188 *-- Author : Kosuke Odagiri
37189 C-----------------------------------------------------------------------
37191 C-----------------------------------------------------------------------
37192 C SUSY 2 PARTON -> 2 GAUGINOS PROCESSES (1 - 3)
37193 C -> GAUGINO + SPARTON PROCESSES (4 - 7)
37194 C-----------------------------------------------------------------------
37195 INCLUDE 'herwig65.inc'
37196 DOUBLE PRECISION HWRGEN, HWUALF, HWUAEM, EPS, HCS, RCS, DIST,
37197 & ML(6), ML2(6), MR(6), MR2(6), MCH(2), MCH2(2), MNU(4), MNU2(4),
37198 & MSQK, MG, MG2, SM, DM, DAB, QPE, SGN, PF, SQPE, EMSC2,
37199 & FAC0, FACA, FACB, FACC, S, T, T3, U, U4, SN2TH
37200 DOUBLE PRECISION M1(2,2,6), M2(4,4,6), M3(2,4,6,6),
37201 & M4(4,6), M5(2,6,6), M6L(4,6), M6R(4,6), M7(2,2,6,6),
37202 & XA(4), XB(4), XC(4), XD(4), MZ, MW, XW, SQXW, S2W, S22W
37203 INTEGER I, IQ, IQ1, IQ2, IQ3, IQ4, IG1, IG2, IG3, IG4,
37204 & ID1, ID2, IGL, SSL, SSR, GLU, SSNU, SSCH, INU, ICH, IWD(6), IPB
37205 DOUBLE PRECISION DQD(6), DQU(6), HWHSS1
37206 EXTERNAL HWRGEN, HWUALF, HWUAEM, HWHSS1
37207 SAVE HCS, M1, M2, M3, M4, M5, M6L, M6R, M7
37208 PARAMETER (EPS = 1.D-9, IGL = 49, SSL = 400, SSR = 412, GLU = 449)
37209 PARAMETER (SSNU = 449, SSCH = 453, INU = 49, ICH = 53)
37210 DOUBLE COMPLEX Z, Z0, C1, C2, C3, GZ, GW, CLL, CLR, CRL, CRR
37211 PARAMETER (Z = (0.D0,1.D0), Z0 = (0.D0,0.D0))
37212 EQUIVALENCE (MZ, RMASS(200)), (MW, RMASS(198)), (MG, RMASS(GLU))
37213 EQUIVALENCE (XA(1), ZMIXSS(1,1)), (XA(2), ZMIXSS(2,1))
37214 EQUIVALENCE (XA(3), ZMIXSS(3,1)), (XA(4), ZMIXSS(4,1))
37215 EQUIVALENCE (XB(1), ZMIXSS(1,2)), (XB(2), ZMIXSS(2,2))
37216 EQUIVALENCE (XB(3), ZMIXSS(3,2)), (XB(4), ZMIXSS(4,2))
37217 EQUIVALENCE (XC(1), ZMIXSS(1,3)), (XC(2), ZMIXSS(2,3))
37218 EQUIVALENCE (XC(3), ZMIXSS(3,3)), (XC(4), ZMIXSS(4,3))
37219 EQUIVALENCE (XD(1), ZMIXSS(1,4)), (XD(2), ZMIXSS(2,4))
37220 EQUIVALENCE (XD(3), ZMIXSS(3,4)), (XD(4), ZMIXSS(4,4))
37222 DATA IWD/2,1,4,3,6,5/
37223 DATA DQD/ONE,ZERO,ONE,ZERO,ONE,ZERO/
37224 DATA DQU/ZERO,ONE,ZERO,ONE,ZERO,ONE/
37226 CALL HWSGEN(.FALSE.)
37228 RCS = HCS*HWRGEN(0)
37230 SN2TH = 0.25D0 - 0.25D0*COSTH**2
37231 S=XX(1)*XX(2)*PHEP(5,3)**2
37233 FAC0 = FACTSS*HWUAEM(EMSC2)
37234 c prefactor for pair production, includes 1/Nc colour factor
37235 FACA = FAC0*HWUAEM(EMSC2) / CAFAC
37236 c prefactor for qq -> gaugino + gluino, includes CF/Nc colour factor
37237 FACB = FAC0*HWUALF(1,EMSCA) * CFFAC / CAFAC
37238 c prefactor for qg -> gaugino + squark, includes 1/2Nc colour factor
37239 FACC = FACB / CFFAC / TWO
37241 GZ = S-MZ**2+Z*S/MZ*GAMZ
37242 GW = S-MW**2+Z*S/MW*GAMW
37246 ML(IQ) = RMASS(IQ1)
37247 ML2(IQ) = ML(IQ)**2
37248 MR(IQ) = RMASS(IQ2)
37249 MR2(IQ) = MR(IQ)**2
37253 S22W = XW * (TWO - XW)
37256 MNU(IG1) = RMASS(IG1+SSNU)
37257 MNU2(IG1) = MNU(IG1)**2
37260 MCH(IG1) = RMASS(IG1+SSCH)
37261 MCH2(IG1) = MCH(IG1)**2
37268 SM = MCH(IG1) + MCH(IG2)
37270 IF (QPE.GE.ZERO) THEN
37271 DM = MCH(IG1) - MCH(IG2)
37272 SQPE = SQRT(QPE*(S-DM**2))
37274 T = (SQPE*COSTH - S + MCH2(IG1) + MCH2(IG2)) / TWO
37275 U = - T - S + MCH2(IG1) + MCH2(IG2)
37276 DAB = ABS(FLOAT(IG1+IG2-3))
37277 C1 = (-WMXVSS(IG1,2)*WMXVSS(IG2,2)+DAB*S22W/XW)/S2W/GZ
37278 C2 = (-WMXUSS(IG1,2)*WMXUSS(IG2,2)+DAB*S22W/XW)/S2W/GZ
37279 SGN = WSGNSS(IG1)*WSGNSS(IG2)
37280 C--PR bug fix 31/03/00
37282 C3 = -DAB*QFCH(IQ)/S
37283 CLL = C3 - LFCH(IQ)*C1 +
37284 & DQD(IQ)*WMXVSS(IG1,1)*WMXVSS(IG2,1)/((U-ML2(IWD(IQ)))*XW)
37285 CLR = C3 - LFCH(IQ)*C2 -
37286 & DQU(IQ)*WMXUSS(IG1,1)*WMXUSS(IG2,1)/((T-ML2(IWD(IQ)))*XW)
37287 CRL = C3 - RFCH(IQ)*C1
37288 CRR = C3 - RFCH(IQ)*C2
37289 M1(IG1,IG2,IQ)=FACA*PF*
37290 & HWHSS1(S,T,U,MCH(IG1),MCH(IG2),SGN,CLL,CLR,CRL,CRR)
37295 M1(IG1,IG2,IQ) = ZERO
37305 SM = MNU(IG1) + MNU(IG2)
37307 IF (QPE.GE.ZERO) THEN
37308 DM = MNU(IG1) - MNU(IG2)
37309 SQPE = SQRT(QPE*(S-DM**2))
37311 T = (SQPE*COSTH - S + MNU2(IG1) + MNU2(IG2)) / TWO
37312 U = - T - S + MNU2(IG1) + MNU2(IG2)
37313 C1 = (XD(IG1)*XD(IG2)-XC(IG1)*XC(IG2))/S2W/GZ
37315 SGN = ZSGNSS(IG1)*ZSGNSS(IG2)
37317 CLL =LFCH(IQ)*C1+SLFCH(IQ,IG1)*SLFCH(IQ,IG2)/(U-ML2(IQ))
37318 CLR =LFCH(IQ)*C2-SLFCH(IQ,IG1)*SLFCH(IQ,IG2)/(T-ML2(IQ))
37319 CRL =RFCH(IQ)*C1-SRFCH(IQ,IG1)*SRFCH(IQ,IG2)/(T-MR2(IQ))
37320 CRR =RFCH(IQ)*C2+SRFCH(IQ,IG1)*SRFCH(IQ,IG2)/(U-MR2(IQ))
37321 M2(IG1,IG2,IQ) = FACA*PF*HALF*
37322 & HWHSS1(S,T,U,MNU(IG1),MNU(IG2),SGN,CLL,CLR,CRL,CRR)
37326 M2(IG1,IG2,IQ) = ZERO
37336 SM = MCH(IG1) + MNU(IG2)
37338 IF (QPE.GE.ZERO) THEN
37339 DM = MCH(IG1) - MNU(IG2)
37340 SQPE = SQRT(QPE*(S-DM**2))
37342 T = (SQPE*COSTH - S + MCH2(IG1) + MNU2(IG2)) / TWO
37343 U = - T - S + MCH2(IG1) + MNU2(IG2)
37344 C1 = XA(IG2)+S2W/XW*XB(IG2)
37345 c note the new s-channel signs below. (PR BUG FIX 3/9/01)
37346 C2 = (-XD(IG2)*WMXVSS(IG1,2)/SQXW+C1*WMXVSS(IG1,1))/GW
37347 C3 = ( XC(IG2)*WMXUSS(IG1,2)/SQXW+C1*WMXUSS(IG1,1))/GW
37348 SGN = WSGNSS(IG1)*ZSGNSS(IG2)
37353 CLL = C2+WMXVSS(IG1,1)*SLFCH(IQ3,IG2)/(U-ML2(IQ3))
37354 CLR = C3-WMXUSS(IG1,1)*SLFCH(IQ4,IG2)/(T-ML2(IQ4))
37355 M3(IG1,IG2,IQ1,IQ2) = FACA*PF*VCKM(IQ1,IQ2)/XW*
37356 & HWHSS1(S,T,U,MCH(IG1),MNU(IG2),SGN,CLL,CLR,Z0,Z0)
37362 M3(IG1,IG2,IQ1,IQ2) = ZERO
37374 IF (QPE.GE.ZERO) THEN
37376 SQPE = SQRT(QPE*(S-DM**2))
37378 T = (SQPE*COSTH - S + MG2 + MNU2(IG1)) / TWO
37379 U = - T - S + MG2 + MNU2(IG1)
37381 CLL = SLFCH(IQ,IG1)/(U-ML2(IQ))
37382 CLR = - SLFCH(IQ,IG1)/(T-ML2(IQ))
37383 CRL = - SRFCH(IQ,IG1)/(T-MR2(IQ))
37384 CRR = SRFCH(IQ,IG1)/(U-MR2(IQ))
37385 M4(IG1,IQ) = FACB*PF*
37386 & HWHSS1(S,T,U,MNU(IG1),MG,ZSGNSS(IG1),CLL,CLR,CRL,CRR)
37400 IF (QPE.GE.ZERO) THEN
37402 SQPE = SQRT(QPE*(S-DM**2))
37404 T = (SQPE*COSTH - S + MCH2(IG1) + MG2) / TWO
37405 U = - T - S + MCH2(IG1) + MG2
37410 CLL = WMXVSS(IG1,1)/(U-ML2(IQ3))
37411 CLR = - WMXUSS(IG1,1)/(T-ML2(IQ4))
37412 M5(IG1,IQ1,IQ2) = FACB*PF*VCKM(IQ1,IQ2)/XW*
37413 & HWHSS1(S,T,U,MCH(IG1),MG,WSGNSS(IG1),CLL,CLR,Z0,Z0)
37419 M5(IG1,IQ1,IQ2) = ZERO
37430 SM = MNU(IG1)+ML(IQ)
37432 IF (QPE.GE.ZERO) THEN
37433 DM = MNU(IG1)-ML(IQ)
37434 SQPE = SQRT(QPE*(S-DM**2))
37436 T3 = (SQPE*COSTH - S - SM*DM) / TWO
37438 C--KO bug fix 06/10/00
37439 M6L(IG1,IQ) = FACC*PF*((QMIXSS(IQ,1,1)*SLFCH(IQ,IG1))**2
37440 & +(QMIXSS(IQ,2,1)*SRFCH(IQ,IG1))**2)*
37441 & T3/S/U4*(-U4+TWO*SM*DM/T3/U4*SQPE*SQPE*SN2TH)
37446 SM = MNU(IG1)+MR(IQ)
37448 IF (QPE.GE.ZERO) THEN
37449 DM = MNU(IG1)-MR(IQ)
37450 SQPE = SQRT(QPE*(S-DM**2))
37452 T3 = (SQPE*COSTH - S - SM*DM) / TWO
37454 C--PR bug fix 28/08/01
37455 M6R(IG1,IQ) = FACC*PF * ((QMIXSS(IQ,1,2)*SLFCH(IQ,IG1))**2
37456 & +(QMIXSS(IQ,2,2)*SRFCH(IQ,IG1))**2)*
37457 & T3/S/U4*(-U4+TWO*SM*DM/T3/U4*SQPE*SQPE*SN2TH)
37472 c U initiated processes
37478 SM = MCH(IG1) + MSQK
37480 IF (((I.EQ.1).OR.(IQ2.EQ.3)).AND.(QPE.GE.ZERO)) THEN
37481 DM = MCH(IG1) - MSQK
37482 SQPE = SQRT(QPE*(S-DM**2))
37484 T3 = (SQPE*COSTH - S - SM*DM) / TWO
37486 M7(I,IG1,IQ3,IQ4)=FACC*PF*WMXUSS(IG1,1)**2*VCKM(IQ1,IQ2)
37487 & /XW*T3/S/U4*(-U4+TWO*SM*DM/T3/U4*SQPE*SQPE*SN2TH)*
37488 & QMIXSS(IQ4,1,I)**2
37490 M7(I,IG1,IQ3,IQ4) = ZERO
37492 c D initiated processes
37498 SM = MCH(IG1) + MSQK
37500 IF (((I.EQ.1).OR.(IQ1.EQ.3)).AND.(QPE.GE.ZERO)) THEN
37501 DM = MCH(IG1) - MSQK
37502 SQPE = SQRT(QPE*(S-DM**2))
37504 T3 = (SQPE*COSTH - S - SM*DM) / TWO
37506 M7(I,IG1,IQ4,IQ3)=FACC*PF*WMXVSS(IG1,1)**2*VCKM(IQ1,IQ2)
37507 & /XW*T3/S/U4*(-U4+TWO*SM*DM/T3/U4*SQPE*SQPE*SN2TH)*
37508 & QMIXSS(IQ3,1,I)**2
37510 M7(I,IG1,IQ4,IQ3) = ZERO
37518 c _ _ ~+ ~- ~o ~o ~o ~
37519 c q q , q q -> X X , X X , X g
37522 IF (DISF(ID1,1).LT.EPS) GOTO 1
37532 IF (DISF(ID2,2).LT.EPS) GOTO 1
37533 DIST = DISF(ID1,1)*DISF(ID2,2)
37538 HCS = HCS + DIST*M1(IG1,IG2,IQ)
37539 C--PR bug fix 10/10/01
37540 IF (GENEV.AND.HCS.GT.RCS) THEN
37541 IF(ID2.LT.ID1) COSTH=-COSTH
37542 CALL HWHSSS(IG3,0,IG4,0,2134,21)
37551 IF (IG2.GE.IG1) HCS = HCS + DIST*M2(IG1,IG2,IQ)
37552 C--PR bug fix 10/10/01
37553 IF (GENEV.AND.HCS.GT.RCS) THEN
37554 IF(ID2.LT.ID1) COSTH=-COSTH
37555 CALL HWHSSS(IG3,0,IG4,0,2134,22)
37559 HCS = HCS + DIST*M4(IG1,IQ)
37560 C--PR bug fix 10/10/01
37561 IF (GENEV.AND.HCS.GT.RCS) THEN
37562 IF(ID2.LT.ID1) COSTH=-COSTH
37563 CALL HWHSSS(IG3,0,IGL,0, IPB,24)
37569 c q q', q q' -> X X , X g
37573 c ud(+), ud(-), du(-), du(+)
37576 IF(VCKM(IQ1,IQ2).GT.EPS) THEN
37581 IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN
37582 DIST = DISF(ID1,1)*DISF(ID2,2)
37587 HCS = HCS + DIST*M3(IG1,IG2,IQ1,IQ2)
37588 IF (GENEV.AND.HCS.GT.RCS) THEN
37589 CALL HWHSSS(IG3,0,IG4,0,2134,23)
37593 HCS = HCS + DIST*M5(IG1,IQ1,IQ2)
37594 IF (GENEV.AND.HCS.GT.RCS) THEN
37595 CALL HWHSSS(IG3,0,IGL,0,2431,25)
37604 IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN
37605 DIST = DISF(ID1,1)*DISF(ID2,2)
37610 HCS = HCS + DIST*M3(IG1,IG2,IQ1,IQ2)
37611 IF (GENEV.AND.HCS.GT.RCS) THEN
37612 CALL HWHSSS(IG4,0,IG3,0,2134,23)
37616 HCS = HCS + DIST*M5(IG1,IQ1,IQ2)
37617 IF (GENEV.AND.HCS.GT.RCS) THEN
37618 CALL HWHSSS(IGL,0,IG3,0,3124,25)
37627 IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN
37628 DIST = DISF(ID1,1)*DISF(ID2,2)
37633 HCS = HCS + DIST*M3(IG1,IG2,IQ1,IQ2)
37634 IF (GENEV.AND.HCS.GT.RCS) THEN
37635 CALL HWHSSS(IG4,0,IG3,0,2134,23)
37639 HCS = HCS + DIST*M5(IG1,IQ1,IQ2)
37640 IF (GENEV.AND.HCS.GT.RCS) THEN
37641 CALL HWHSSS(IGL,0,IG3,0,2314,25)
37650 IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN
37651 DIST = DISF(ID1,1)*DISF(ID2,2)
37656 HCS = HCS + DIST*M3(IG1,IG2,IQ1,IQ2)
37657 IF (GENEV.AND.HCS.GT.RCS) THEN
37658 CALL HWHSSS(IG3,0,IG4,0,2134,23)
37662 HCS = HCS + DIST*M5(IG1,IQ1,IQ2)
37663 IF (GENEV.AND.HCS.GT.RCS) THEN
37664 CALL HWHSSS(IG3,0,IGL,0,4132,25)
37673 c g q , g q , q g , q g -> X q , X q'
37681 IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN
37682 DIST = DISF(ID1,1)*DISF(ID2,2)
37685 HCS = HCS + DIST*M6L(IG1,IQ1)
37686 IF (GENEV.AND.HCS.GT.RCS) THEN
37687 CALL HWHSSS(IG3,0,ID2,0,2431,26)
37690 HCS = HCS + DIST*M6R(IG1,IQ1)
37691 IF (GENEV.AND.HCS.GT.RCS) THEN
37692 CALL HWHSSS(IG3,0,ID2,2,2431,26)
37701 IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN
37702 DIST = DISF(ID1,1)*DISF(ID2,2)
37705 HCS = HCS + DIST*M6L(IG1,IQ1)
37706 IF (GENEV.AND.HCS.GT.RCS) THEN
37707 CALL HWHSSS(IG3,0,ID2,0,4132,26)
37710 HCS = HCS + DIST*M6R(IG1,IQ1)
37711 IF (GENEV.AND.HCS.GT.RCS) THEN
37712 CALL HWHSSS(IG3,0,ID2,2,4132,26)
37721 IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN
37722 DIST = DISF(ID1,1)*DISF(ID2,2)
37725 HCS = HCS + DIST*M6L(IG1,IQ1)
37726 IF (GENEV.AND.HCS.GT.RCS) THEN
37727 CALL HWHSSS(ID1,0,IG3,0,3124,26)
37730 HCS = HCS + DIST*M6R(IG1,IQ1)
37731 IF (GENEV.AND.HCS.GT.RCS) THEN
37732 CALL HWHSSS(ID1,2,IG3,0,3124,26)
37741 IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN
37742 DIST = DISF(ID1,1)*DISF(ID2,2)
37745 HCS = HCS + DIST*M6L(IG1,IQ1)
37746 IF (GENEV.AND.HCS.GT.RCS) THEN
37747 CALL HWHSSS(ID1,0,IG3,0,2314,26)
37750 HCS = HCS + DIST*M6R(IG1,IQ1)
37751 IF (GENEV.AND.HCS.GT.RCS) THEN
37752 CALL HWHSSS(ID1,2,IG3,0,2314,26)
37762 IF (VCKM(IQ1,IQ2).LT.EPS) GOTO 3
37771 HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(1,IG1,IQ3,IQ4)
37772 IF (GENEV.AND.HCS.GT.RCS) THEN
37773 CALL HWHSSS(IG3,0,IQ4,0,2431,27)
37776 HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(2,IG1,IQ3,IQ4)
37777 IF (GENEV.AND.HCS.GT.RCS) THEN
37778 CALL HWHSSS(IG3,0,IQ4,2,2431,27)
37782 HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(1,IG1,IQ4,IQ3)
37783 IF (GENEV.AND.HCS.GT.RCS) THEN
37784 CALL HWHSSS(IG4,0,IQ3,0,2431,27)
37787 HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(2,IG1,IQ4,IQ3)
37788 IF (GENEV.AND.HCS.GT.RCS) THEN
37789 CALL HWHSSS(IG4,0,IQ3,2,2431,27)
37794 HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(1,IG1,IQ3,IQ4)
37795 IF (GENEV.AND.HCS.GT.RCS) THEN
37796 CALL HWHSSS(IQ4,0,IG3,0,3124,27)
37799 HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(2,IG1,IQ3,IQ4)
37800 IF (GENEV.AND.HCS.GT.RCS) THEN
37801 CALL HWHSSS(IQ4,2,IG3,0,3124,27)
37805 HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(1,IG1,IQ4,IQ3)
37806 IF (GENEV.AND.HCS.GT.RCS) THEN
37807 CALL HWHSSS(IQ3,0,IG4,0,3124,27)
37810 HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(2,IG1,IQ4,IQ3)
37811 IF (GENEV.AND.HCS.GT.RCS) THEN
37812 CALL HWHSSS(IQ3,2,IG4,0,3124,27)
37819 HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(1,IG1,IQ3,IQ4)
37820 IF (GENEV.AND.HCS.GT.RCS) THEN
37821 CALL HWHSSS(IG4,0,IQ4,1,4132,27)
37824 HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(2,IG1,IQ3,IQ4)
37825 IF (GENEV.AND.HCS.GT.RCS) THEN
37826 CALL HWHSSS(IG4,0,IQ4,3,4132,27)
37830 HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(1,IG1,IQ4,IQ3)
37831 IF (GENEV.AND.HCS.GT.RCS) THEN
37832 CALL HWHSSS(IG3,0,IQ3,1,4132,27)
37835 HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(2,IG1,IQ4,IQ3)
37836 IF (GENEV.AND.HCS.GT.RCS) THEN
37837 CALL HWHSSS(IG3,0,IQ3,3,4132,27)
37842 HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(1,IG1,IQ3,IQ4)
37843 IF (GENEV.AND.HCS.GT.RCS) THEN
37844 CALL HWHSSS(IQ4,1,IG4,0,2314,27)
37847 HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(2,IG1,IQ3,IQ4)
37848 IF (GENEV.AND.HCS.GT.RCS) THEN
37849 CALL HWHSSS(IQ4,3,IG4,0,2314,27)
37853 HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(1,IG1,IQ4,IQ3)
37854 IF (GENEV.AND.HCS.GT.RCS) THEN
37855 CALL HWHSSS(IQ3,1,IG3,0,2314,27)
37858 HCS = HCS + DISF(ID1,1)*DISF(ID2,2)*M7(2,IG1,IQ4,IQ3)
37859 IF (GENEV.AND.HCS.GT.RCS) THEN
37860 CALL HWHSSS(IQ3,3,IG3,0,2314,27)
37872 CALL HWETWO(.TRUE.,.TRUE.)
37874 C Calculate coefficients for constructing spin density matrices
37875 C Set to zero for now
37876 CALL HWVZRO(7,GCOEF)
37880 *CMZ :- -18/05/99 20.33.45 by Kosuke Odagiri
37881 *-- Author : Kosuke Odagiri
37882 C-----------------------------------------------------------------------
37884 C-----------------------------------------------------------------------
37885 C SUSY 2 PARTON -> 2 SLEPTON PROCESSES
37886 C-----------------------------------------------------------------------
37887 INCLUDE 'herwig65.inc'
37888 DOUBLE PRECISION HWRGEN, HWUAEM, EPS, HCS, RCS, DIST, S, PF, QPE,
37889 & FACTR, SN2TH, MZ, MW, ME2(2,2,6,2), ME2W(2,3), EMSC2, GW2
37890 INTEGER IQ, IQ1, IQ2, ID1, ID2, IL, IL1, IL2, I, J
37891 EXTERNAL HWRGEN, HWUAEM
37892 SAVE HCS, ME2, ME2W
37893 PARAMETER (EPS = 1.D-9)
37894 DOUBLE COMPLEX Z, GZ, A, BL, BR, CL, CR, D, E
37895 PARAMETER (Z = (0.D0,1.D0))
37896 EQUIVALENCE (MZ, RMASS(200)), (MW, RMASS(198))
37898 S = XX(1)*XX(2)*PHEP(5,3)**2
37900 EMSCA = SQRT(EMSC2)
37901 CALL HWSGEN(.FALSE.)
37903 RCS = HCS*HWRGEN(0)
37905 SN2TH = 0.25D0 - 0.25D0*COSTH**2
37906 FACTR = FACTSS*HWUAEM(EMSC2)**2/CAFAC*SN2TH
37907 GZ = (S-MZ**2+Z*S*GAMZ/MZ)/S
37908 GW2 = ((ONE-MW**2/S)**2+(GAMW/MW)**2)*(TWO*SWEIN)**2
37915 IF (((I.NE.J).AND.(IL.NE.5)).OR.
37916 & ((I.EQ.2).AND.(((IL/2)*2).EQ.IL))) THEN
37919 ID1 = 412 + I*12 + IL
37920 ID2 = 412 + J*12 + IL
37922 QPE = S-(RMASS(ID1)+RMASS(ID2))**2
37924 IF (QPE.GT.ZERO) THEN
37925 PF = SQRT(QPE*(S-(RMASS(ID1)-RMASS(ID2))**2))/S
37927 A = QFCH(IL1)*QFCH(IQ)
37930 CL = LMIXSS(IL,1,I)*LMIXSS(IL,1,J)
37931 CR = LMIXSS(IL,2,I)*LMIXSS(IL,2,J)
37932 D = (A+BL*LFCH(IQ))*CL+(A+BR*LFCH(IQ))*CR
37933 E = (A+BL*RFCH(IQ))*CL+(A+BR*RFCH(IQ))*CR
37934 ME2(I,J,IL,IQ)=FACTR*PF**3
37935 $ *DREAL(DCONJG(D)*D+DCONJG(E)*E)
37949 IF ((IL.NE.3).AND.(I.EQ.2)) THEN
37952 ID1 = 411 + IL*2 + I*12
37954 QPE = S-(RMASS(ID1)+RMASS(ID2))**2
37956 IF (QPE.GT.ZERO) THEN
37957 PF = SQRT(QPE*(S-(RMASS(ID1)-RMASS(ID2))**2))/S
37958 ME2W(I,IL)=FACTR*PF**3/GW2
37959 IF (IL.EQ.3) ME2W(I,3)=ME2W(I,3)*LMIXSS(5,1,I)**2
37969 IF (DISF(ID1,1).LT.EPS) GOTO 1
37975 IQ = ID1 - ((ID1-1)/2)*2
37976 IF (DISF(ID2,2).LT.EPS) GOTO 1
37977 DIST = DISF(ID1,1)*DISF(ID2,2)
37983 HCS = HCS + DIST*ME2(I,J,IL,IQ)
37984 IF (GENEV.AND.HCS.GT.RCS) THEN
37985 CALL HWHSSS(IL1,2,IL2,3,2134,30)
37993 c ud(+), ud(-), du(-), du(+)
37996 IF(VCKM(IQ1,IQ2).GT.EPS) THEN
38001 IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN
38002 DIST = VCKM(IQ1,IQ2)*DISF(ID1,1)*DISF(ID2,2)
38006 HCS = HCS + DIST*ME2W(1,IL)
38007 IF (GENEV.AND.HCS.GT.RCS) THEN
38008 CALL HWHSSS(IL1,5,IL2,4,2134,30)
38012 HCS = HCS + DIST*ME2W(2,3)
38013 IF (GENEV.AND.HCS.GT.RCS) THEN
38014 CALL HWHSSS(5,7,6,4,2134,30)
38022 IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN
38023 DIST = VCKM(IQ1,IQ2)*DISF(ID1,1)*DISF(ID2,2)
38027 HCS = HCS + DIST*ME2W(1,IL)
38028 IF (GENEV.AND.HCS.GT.RCS) THEN
38029 CALL HWHSSS(IL1,5,IL2,4,2134,30)
38033 HCS = HCS + DIST*ME2W(2,3)
38034 IF (GENEV.AND.HCS.GT.RCS) THEN
38035 CALL HWHSSS(5,7,6,4,2134,30)
38043 IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN
38044 DIST = VCKM(IQ1,IQ2)*DISF(ID1,1)*DISF(ID2,2)
38048 HCS = HCS + DIST*ME2W(1,IL)
38049 IF (GENEV.AND.HCS.GT.RCS) THEN
38050 CALL HWHSSS(IL1,4,IL2,5,2134,30)
38054 HCS = HCS + DIST*ME2W(2,3)
38055 IF (GENEV.AND.HCS.GT.RCS) THEN
38056 CALL HWHSSS(5,6,6,5,2134,30)
38064 IF ((DISF(ID1,1).GT.EPS).AND.(DISF(ID2,2).GT.EPS)) THEN
38065 DIST = VCKM(IQ1,IQ2)*DISF(ID1,1)*DISF(ID2,2)
38069 HCS = HCS + DIST*ME2W(1,IL)
38070 IF (GENEV.AND.HCS.GT.RCS) THEN
38071 CALL HWHSSS(IL1,4,IL2,5,2134,30)
38075 HCS = HCS + DIST*ME2W(2,3)
38076 IF (GENEV.AND.HCS.GT.RCS) THEN
38077 CALL HWHSSS(5,6,6,5,2134,30)
38090 CALL HWETWO(.TRUE.,.TRUE.)
38092 C Calculate coefficients for constructing spin density matrices
38093 C Set to zero for now
38094 CALL HWVZRO(7,GCOEF)
38098 *CMZ :- -18/05/99 20.33.45 by Kosuke Odagiri
38099 *-- Author : Kosuke Odagiri
38100 C-----------------------------------------------------------------------
38102 C-----------------------------------------------------------------------
38103 C SUSY HARD 2 PARTON -> 2 SPARTON PROCESSES
38104 C-----------------------------------------------------------------------
38105 INCLUDE 'herwig65.inc'
38106 DOUBLE PRECISION HWRGEN, HWUALF, EPS, HCS, RCS, DIST, NC, NC2,
38107 & NC2C, ML2(6), ML4(6), MR2(6), MR4(6), MG2, SM, DM, QPE,
38108 & SQPE, FACTR, AFAC, AF, BONE, CFAC, CFC2, CFC3, CONE,
38109 & CONN, CONT, CONU, CONL, CONR, DFAC, DONE, PF, S,
38110 & S2, TT, TT2, TMG, TMG2, UU, UU2, UMG, UMG2,
38111 & L, L2, TTML, UUML, R, R2, TTMR, UUMR, SN2TH
38113 & AUSTLL(6), AUSTRR(6),
38114 & ASTULL(6,6), ASTURR(6,6), ASTULR(6,6), ASTURL(6,6),
38115 & AUTSLL(6,6), AUTSRR(6,6), AUTSLR(6,6), AUTSRL(6,6),
38116 & BSTULL(6), BSTURR(6), BSTULR(6), BSTURL(6),
38117 & BSUTLL(6), BSUTRR(6), BSUTLR(6), BSUTRL(6),
38118 & BUTSLL(6), BUTSRR(6), BUTSLR(6), BUTSRL(6),
38119 & BUSTLL(6), BUSTRR(6), BUSTLR(6), BUSTRL(6),
38120 & CSTU(6), CSUT(6), CSTUL(6), CSTUR(6), CSUTL(6), CSUTR(6),
38121 & CTSUL(6), CTSUR(6), CTUSL(6), CTUSR(6), DUTS, DTSU, DSTU
38122 INTEGER IQ, IQ1, IQ2, ID1, ID2, ID2MIN, IGL, SSL, SSR, GLU
38123 EXTERNAL HWRGEN, HWUALF
38124 SAVE HCS, AUSTLL, AUSTRR, ASTULL, ASTURR, ASTULR, ASTURL,
38125 & AUTSLL, AUTSRR, AUTSLR, AUTSRL, BSTULL, BSTURR, BSTULR,
38126 & BSTURL, BSUTLL, BSUTRR, BSUTLR, BSUTRL, BUTSLL, BUTSRR, BUTSLR,
38127 & BUTSRL, BUSTLL, BUSTRR, BUSTLR, BUSTRL, CSTU, CSUT, CSTUL, CSTUR,
38128 & CSUTL, CSUTR, CTSUL, CTSUR, CTUSL, CTUSR, DUTS, DTSU, DSTU
38129 PARAMETER (EPS = 1.D-9, IGL = 49, SSL = 400, SSR = 412, GLU = 449)
38130 CALL HWSGEN(.FALSE.)
38132 RCS = HCS*HWRGEN(0)
38134 SN2TH = 0.25D0 - 0.25D0*COSTH**2
38135 S = XX(1)*XX(2)*PHEP(5,3)**2
38136 FACTR = FACTSS*HWUALF(1,EMSCA)**2
38139 NC2C = ONE - ONE/NC2
38140 AFAC = FACTR*NC2C/FOUR
38141 CFAC = FACTR*CFFAC/FOUR
38142 CFC2 = FACTR/CFFAC/FOUR
38146 MG2 = RMASS(GLU)**2
38150 ML2(IQ) = RMASS(IQ1)**2
38151 ML4(IQ) = ML2(IQ)**2
38152 MR2(IQ) = RMASS(IQ2)**2
38153 MR4(IQ) = MR2(IQ)**2
38155 c gluino pair production
38157 IF (QPE.GE.ZERO) THEN
38160 TT = (SQPE*COSTH - S) / TWO
38168 & DFAC*PF/TWO*(UU2+TT2+FOUR*MG2*S*SQPE**2*SN2TH/TT/UU)/S2/TT/UU
38184 CONE = TWO*PF**2*SN2TH
38185 CONL = CONE/UUML/TTML
38186 CONR = CONE/UUMR/TTMR
38187 CONT = (UU2-L2)*CONL+(UU2-R2)*CONR+L2/TTML**2+R2/TTMR**2
38188 CONU = (TT2-L2)*CONL+(TT2-R2)*CONR+L2/UUML**2+R2/UUMR**2
38189 CONN = CFAC*(PF-PF/NC2/(CONT+CONU)*( S2*(CONL+CONR)+
38190 & L2*((TT-UU)*CONL/CONE)**2+R2*((TT-UU)*CONR/CONE)**2 ))
38191 CSTU(IQ) = CONT*CONN
38192 CSUT(IQ) = CONU*CONN
38203 c left handed squark (identical flavour) pair production
38205 QPE = S - FOUR*ML2(IQ)
38206 IF (QPE.GE.ZERO) THEN
38209 TT = (SQPE*COSTH - S) / TWO
38216 CONE = CFC2*PF*((SQPE*PF*SN2TH)**2+ML4(IQ))/TT2/UU2
38217 CONN = CONE-CONE*S2/(TT2+UU2)/NC2
38218 CSTUL(IQ) = CONN*UU2
38219 CSUTL(IQ) = CONN*TT2
38223 TMG = TT+ML2(IQ)-MG2
38225 UMG = UU+ML2(IQ)-MG2
38227 BONE = AFAC*PF*MG2*S*(HALF-TMG*UMG/(TMG2+UMG2)/NC)
38228 BSTULL(IQ) = BONE/TMG2
38229 BSUTLL(IQ) = BONE/UMG2
38233 AF = AFAC*PF*PF**2*SN2TH
38234 BONE = AF/TMG2-AF*S/(HALF*S2+TMG2)/TMG/NC
38235 BUTSLL(IQ) = BONE*S2
38236 BUSTLL(IQ) = BONE*TWO*TMG2
38238 c q q -> q'q' q =/= q'
38240 AUSTLL(IQ) = TWO*AF
38250 c right handed squark (identical flavour) pair production
38251 QPE = S - FOUR*MR2(IQ)
38252 IF (QPE.GE.ZERO) THEN
38255 TT = (SQPE*COSTH - S) / TWO
38262 CONE = CFC2*PF*((SQPE*PF*SN2TH)**2+MR4(IQ))/TT2/UU2
38263 CONN = CONE-CONE*S2/(TT2+UU2)/NC2
38264 CSTUR(IQ) = CONN*UU2
38265 CSUTR(IQ) = CONN*TT2
38269 TMG = TT+MR2(IQ)-MG2
38271 UMG = UU+MR2(IQ)-MG2
38273 BONE = AFAC*PF*MG2*S*(HALF-TMG*UMG/(TMG2+UMG2)/NC)
38274 BSTURR(IQ) = BONE/TMG2
38275 BSUTRR(IQ) = BONE/UMG2
38279 AF = AFAC*PF*PF**2*SN2TH
38280 BONE = AF/TMG2-AF*S/(HALF*S2+TMG2)/TMG/NC
38281 BUTSRR(IQ) = BONE*S2
38282 BUSTRR(IQ) = BONE*TWO*TMG2
38284 c q q -> q'q' q =/= q'
38286 AUSTRR(IQ) = TWO*AF
38296 c left and right handed squark (identical flavour) pair production
38299 SM = RMASS(IQ1)+RMASS(IQ2)
38301 IF (QPE.GE.ZERO) THEN
38302 DM = RMASS(IQ1)-RMASS(IQ2)
38303 SQPE = SQRT( QPE*(S-DM**2) )
38306 TT = (SQPE*COSTH - S - SM*DM) / TWO
38308 TMG = TT + ML2(IQ) - MG2
38310 UMG = UU + MR2(IQ) - MG2
38315 BONE = AFAC*PF*SQPE**2*SN2TH
38316 BSTULR(IQ) = BONE/TMG2
38317 BSUTLR(IQ) = BONE/UMG2
38321 BUTSLR(IQ) = AFAC*PF*MG2*S/TMG2
38323 TT = (SQPE*COSTH - S + SM*DM) / TWO
38325 TMG = TT + MR2(IQ) - MG2
38327 UMG = UU + ML2(IQ) - MG2
38332 c BONE = AFAC*PF*SQPE**2*SN2TH
38333 c BSTURL(IQ) = BONE/TMG2
38334 c BSUTRL(IQ) = BONE/UMG2
38340 BUTSRL(IQ) = AFAC*PF*MG2*S/TMG2
38353 c distinct flavours - gq, qq'
38356 SM = RMASS(GLU)+RMASS(IQ1)
38358 IF (QPE.GE.ZERO) THEN
38359 DM = RMASS(GLU)-RMASS(IQ1)
38360 SQPE = SQRT( QPE*(S-DM**2) )
38362 TT = (SQPE*COSTH - S - SM*DM) / TWO
38369 CONE = (-UU+TWO*SM*DM*(ONE+MG2/TT+ML2(ID1)/UU))/S/TT/UU
38370 CONN = CFC3*PF*CONE*(ONE-TT2/(UU2+S2)/NC2)
38371 CTSUL(ID1) = CONN*UU2
38372 CTUSL(ID1) = CONN*S2
38378 SM = RMASS(GLU)+RMASS(IQ2)
38380 IF (QPE.GE.ZERO) THEN
38381 DM = RMASS(GLU)-RMASS(IQ2)
38382 SQPE = SQRT( QPE*(S-DM**2) )
38384 TT = (SQPE*COSTH - S - SM*DM) / TWO
38391 CONE = (-UU+TWO*SM*DM*(ONE+MG2/TT+MR2(ID1)/UU))/S/TT/UU
38392 CONN = CFC3*PF*CONE*(ONE-TT2/(UU2+S2)/NC2)
38393 CTSUR(ID1) = CONN*UU2
38394 CTUSR(ID1) = CONN*S2
38399 IF(ID1.EQ.6) GOTO 11
38401 DO 12 ID2 = ID2MIN, 6
38404 SM = RMASS(IQ1)+RMASS(IQ2)
38406 IF (QPE.GE.ZERO) THEN
38407 DM = RMASS(IQ1)-RMASS(IQ2)
38408 SQPE = SQRT( QPE*(S-DM**2) )
38410 TT = (SQPE*COSTH - S - SM*DM) / TWO
38412 TMG = TT+ML2(ID1)-MG2
38413 AF = AFAC*PF/TMG/TMG
38417 ASTULL(ID1,ID2) = AF*MG2*S
38418 ASTULL(ID2,ID1) = ASTULL(ID1,ID2)
38422 AUTSLL(ID1,ID2) = AF*SQPE**2*SN2TH
38423 AUTSLL(ID2,ID1) = AUTSLL(ID1,ID2)
38425 ASTULL(ID1,ID2) = ZERO
38426 ASTULL(ID2,ID1) = ZERO
38427 AUTSLL(ID1,ID2) = ZERO
38428 AUTSLL(ID2,ID1) = ZERO
38432 SM = RMASS(IQ1)+RMASS(IQ2)
38434 IF (QPE.GE.ZERO) THEN
38435 DM = RMASS(IQ1)-RMASS(IQ2)
38436 SQPE = SQRT( QPE*(S-DM**2) )
38438 TT = (SQPE*COSTH - S - SM*DM) / TWO
38440 TMG = TT+MR2(ID1)-MG2
38441 AF = AFAC*PF/TMG/TMG
38445 ASTURR(ID1,ID2) = AF*MG2*S
38446 ASTURR(ID2,ID1) = ASTURR(ID1,ID2)
38450 AUTSRR(ID1,ID2) = AF*SQPE**2*SN2TH
38451 AUTSRR(ID2,ID1) = AUTSRR(ID1,ID2)
38453 ASTURR(ID1,ID2) = ZERO
38454 ASTURR(ID2,ID1) = ZERO
38455 AUTSRR(ID1,ID2) = ZERO
38456 AUTSRR(ID2,ID1) = ZERO
38460 SM = RMASS(IQ1)+RMASS(IQ2)
38462 IF (QPE.GE.ZERO) THEN
38463 DM = RMASS(IQ1)-RMASS(IQ2)
38464 SQPE = SQRT( QPE*(S-DM**2) )
38466 TT = (SQPE*COSTH - S - SM*DM) / TWO
38468 TMG = TT+ML2(ID1)-MG2
38469 AF = AFAC*PF/TMG/TMG
38473 ASTULR(ID1,ID2) = AF*SQPE**2*SN2TH
38474 ASTULR(ID2,ID1) = ASTULR(ID1,ID2)
38478 AUTSLR(ID1,ID2) = AF*MG2*S
38479 AUTSLR(ID2,ID1) = AUTSLR(ID1,ID2)
38480 TT = (SQPE*COSTH - S + SM*DM) / TWO
38482 TMG = TT+MR2(ID1)-MG2
38483 AF = AFAC*PF/TMG/TMG
38487 ASTURL(ID1,ID2) = AF*SQPE**2*SN2TH
38488 ASTURL(ID2,ID1) = ASTULR(ID1,ID2)
38492 AUTSRL(ID1,ID2) = AF*MG2*S
38493 AUTSRL(ID2,ID1) = AUTSLR(ID1,ID2)
38495 ASTULR(ID1,ID2) = ZERO
38496 ASTULR(ID2,ID1) = ZERO
38497 AUTSLR(ID1,ID2) = ZERO
38498 AUTSLR(ID2,ID1) = ZERO
38499 ASTURL(ID1,ID2) = ZERO
38500 ASTURL(ID2,ID1) = ZERO
38501 AUTSRL(ID1,ID2) = ZERO
38502 AUTSRL(ID2,ID1) = ZERO
38509 IF (DISF(ID1,1).LT.EPS) GOTO 6
38511 IF (DISF(ID2,2).LT.EPS) GOTO 5
38512 DIST = DISF(ID1,1)*DISF(ID2,2)
38517 IF (IQ1.NE.IQ2) THEN
38520 HCS = HCS + ASTULL(IQ1,IQ2)*DIST
38521 IF (GENEV.AND.HCS.GT.RCS) THEN
38522 CALL HWHSSS(IQ1,0,IQ2,0,3421,10)
38525 HCS = HCS + ASTURR(IQ1,IQ2)*DIST
38526 IF (GENEV.AND.HCS.GT.RCS) THEN
38527 CALL HWHSSS(IQ1,2,IQ2,2,3421,10)
38530 HCS = HCS + ASTULR(IQ1,IQ2)*DIST
38531 IF (GENEV.AND.HCS.GT.RCS) THEN
38532 CALL HWHSSS(IQ1,0,IQ2,2,3421,10)
38535 HCS = HCS + ASTURL(IQ1,IQ2)*DIST
38536 IF (GENEV.AND.HCS.GT.RCS) THEN
38537 CALL HWHSSS(IQ1,2,IQ2,0,3421,10)
38543 HCS = HCS + BSTULL(IQ1)*DIST
38544 IF (GENEV.AND.HCS.GT.RCS) THEN
38545 CALL HWHSSS(IQ1,0,IQ2,0,3421,10)
38548 HCS = HCS + BSTURR(IQ1)*DIST
38549 IF (GENEV.AND.HCS.GT.RCS) THEN
38550 CALL HWHSSS(IQ1,2,IQ2,2,3421,10)
38553 HCS = HCS + BSTULR(IQ1)*DIST
38554 IF (GENEV.AND.HCS.GT.RCS) THEN
38555 CALL HWHSSS(IQ1,0,IQ2,2,3421,10)
38558 HCS = HCS + BSTURL(IQ1)*DIST
38559 IF (GENEV.AND.HCS.GT.RCS) THEN
38560 CALL HWHSSS(IQ1,2,IQ2,0,3421,10)
38563 HCS = HCS + BSUTLL(IQ1)*DIST
38564 IF (GENEV.AND.HCS.GT.RCS) THEN
38565 CALL HWHSSS(IQ1,0,IQ2,0,4312,10)
38568 HCS = HCS + BSUTRR(IQ1)*DIST
38569 IF (GENEV.AND.HCS.GT.RCS) THEN
38570 CALL HWHSSS(IQ1,2,IQ2,2,4312,10)
38573 HCS = HCS + BSUTLR(IQ1)*DIST
38574 IF (GENEV.AND.HCS.GT.RCS) THEN
38575 CALL HWHSSS(IQ1,0,IQ2,2,4312,10)
38578 HCS = HCS + BSUTRL(IQ1)*DIST
38579 IF (GENEV.AND.HCS.GT.RCS) THEN
38580 CALL HWHSSS(IQ1,2,IQ2,0,4312,10)
38584 ELSEIF (ID2.NE.13) THEN
38586 IF (IQ1.NE.IQ2) THEN
38589 HCS = HCS + AUTSLL(IQ1,IQ2)*DIST
38590 IF (GENEV.AND.HCS.GT.RCS) THEN
38591 CALL HWHSSS(IQ1,0,IQ2,1,3142,10)
38594 HCS = HCS + AUTSRR(IQ1,IQ2)*DIST
38595 IF (GENEV.AND.HCS.GT.RCS) THEN
38596 CALL HWHSSS(IQ1,2,IQ2,3,3142,10)
38599 HCS = HCS + AUTSLR(IQ1,IQ2)*DIST
38600 IF (GENEV.AND.HCS.GT.RCS) THEN
38601 CALL HWHSSS(IQ1,0,IQ2,3,3142,10)
38604 HCS = HCS + AUTSRL(IQ1,IQ2)*DIST
38605 IF (GENEV.AND.HCS.GT.RCS) THEN
38606 CALL HWHSSS(IQ1,2,IQ2,1,3142,10)
38611 c qq -> q'q' (q =/= q')
38613 IF (IQ .EQ.IQ1) GOTO 30
38614 HCS = HCS + AUSTLL(IQ )*DIST
38615 IF (GENEV.AND.HCS.GT.RCS) THEN
38616 CALL HWHSSS(IQ ,0,IQ ,1,2413,10)
38619 HCS = HCS + AUSTRR(IQ )*DIST
38620 IF (GENEV.AND.HCS.GT.RCS) THEN
38621 CALL HWHSSS(IQ ,2,IQ ,3,2413,10)
38627 HCS = HCS + BUTSLL(IQ1)*DIST
38628 IF (GENEV.AND.HCS.GT.RCS) THEN
38629 CALL HWHSSS(IQ1,0,IQ2,1,3142,10)
38632 HCS = HCS + BUTSRR(IQ1)*DIST
38633 IF (GENEV.AND.HCS.GT.RCS) THEN
38634 CALL HWHSSS(IQ1,2,IQ2,3,3142,10)
38637 HCS = HCS + BUTSLR(IQ1)*DIST
38638 IF (GENEV.AND.HCS.GT.RCS) THEN
38639 CALL HWHSSS(IQ1,0,IQ2,3,3142,10)
38642 HCS = HCS + BUTSRL(IQ1)*DIST
38643 IF (GENEV.AND.HCS.GT.RCS) THEN
38644 CALL HWHSSS(IQ1,2,IQ2,1,3142,10)
38647 HCS = HCS + BUSTLL(IQ1)*DIST
38648 IF (GENEV.AND.HCS.GT.RCS) THEN
38649 CALL HWHSSS(IQ1,0,IQ2,1,2413,10)
38652 HCS = HCS + BUSTRR(IQ1)*DIST
38653 IF (GENEV.AND.HCS.GT.RCS) THEN
38654 CALL HWHSSS(IQ1,2,IQ2,3,2413,10)
38657 HCS = HCS + BUSTLR(IQ1)*DIST
38658 IF (GENEV.AND.HCS.GT.RCS) THEN
38659 CALL HWHSSS(IQ1,0,IQ2,3,2413,10)
38662 HCS = HCS + BUSTRL(IQ1)*DIST
38663 IF (GENEV.AND.HCS.GT.RCS) THEN
38664 CALL HWHSSS(IQ1,2,IQ2,1,2413,10)
38670 HCS = HCS + CSTU(IQ1)*DIST
38671 IF (GENEV.AND.HCS.GT.RCS) THEN
38672 CALL HWHSSS(IQ ,0,IQ ,0,2413,10)
38675 HCS = HCS + CSUT(IQ1)*DIST
38676 IF (GENEV.AND.HCS.GT.RCS) THEN
38677 CALL HWHSSS(IQ ,0,IQ ,0,2341,10)
38685 HCS = HCS + CTSUL(IQ1)*DIST
38686 IF (GENEV.AND.HCS.GT.RCS) THEN
38687 CALL HWHSSS(IQ1,0,IQ2,0,3142,10)
38690 HCS = HCS + CTSUR(IQ1)*DIST
38691 IF (GENEV.AND.HCS.GT.RCS) THEN
38692 CALL HWHSSS(IQ1,2,IQ2,0,3142,10)
38695 HCS = HCS + CTUSL(IQ1)*DIST
38696 IF (GENEV.AND.HCS.GT.RCS) THEN
38697 CALL HWHSSS(IQ1,0,IQ2,0,3421,10)
38700 HCS = HCS + CTUSR(IQ1)*DIST
38701 IF (GENEV.AND.HCS.GT.RCS) THEN
38702 CALL HWHSSS(IQ1,2,IQ2,0,3421,10)
38706 ELSEIF (ID1.NE.13) THEN
38710 IF (IQ1.NE.IQ2) THEN
38713 HCS = HCS + AUTSLL(IQ1,IQ2)*DIST
38714 IF (GENEV.AND.HCS.GT.RCS) THEN
38715 CALL HWHSSS(IQ1,1,IQ2,0,2413,10)
38718 HCS = HCS + AUTSRR(IQ1,IQ2)*DIST
38719 IF (GENEV.AND.HCS.GT.RCS) THEN
38720 CALL HWHSSS(IQ1,3,IQ2,2,2413,10)
38723 HCS = HCS + AUTSLR(IQ1,IQ2)*DIST
38724 IF (GENEV.AND.HCS.GT.RCS) THEN
38725 CALL HWHSSS(IQ1,1,IQ2,2,2413,10)
38728 HCS = HCS + AUTSRL(IQ1,IQ2)*DIST
38729 IF (GENEV.AND.HCS.GT.RCS) THEN
38730 CALL HWHSSS(IQ1,3,IQ2,0,2413,10)
38735 c qq -> q'q' (q =/= q')
38737 IF (IQ .EQ.IQ1) GOTO 31
38738 HCS = HCS + AUSTLL(IQ)*DIST
38739 IF (GENEV.AND.HCS.GT.RCS) THEN
38740 CALL HWHSSS(IQ ,1,IQ ,0,3142,10)
38743 HCS = HCS + AUSTRR(IQ)*DIST
38744 IF (GENEV.AND.HCS.GT.RCS) THEN
38745 CALL HWHSSS(IQ ,3,IQ ,2,3142,10)
38751 HCS = HCS + BUTSLL(IQ1)*DIST
38752 IF (GENEV.AND.HCS.GT.RCS) THEN
38753 CALL HWHSSS(IQ1,1,IQ2,0,2413,10)
38756 HCS = HCS + BUTSRR(IQ1)*DIST
38757 IF (GENEV.AND.HCS.GT.RCS) THEN
38758 CALL HWHSSS(IQ1,3,IQ2,2,2413,10)
38761 HCS = HCS + BUTSLR(IQ1)*DIST
38762 IF (GENEV.AND.HCS.GT.RCS) THEN
38763 CALL HWHSSS(IQ1,1,IQ2,2,2413,10)
38766 HCS = HCS + BUTSRL(IQ1)*DIST
38767 IF (GENEV.AND.HCS.GT.RCS) THEN
38768 CALL HWHSSS(IQ1,3,IQ2,0,2413,10)
38771 HCS = HCS + BUSTLL(IQ1)*DIST
38772 IF (GENEV.AND.HCS.GT.RCS) THEN
38773 CALL HWHSSS(IQ1,1,IQ2,0,3142,10)
38776 HCS = HCS + BUSTRR(IQ1)*DIST
38777 IF (GENEV.AND.HCS.GT.RCS) THEN
38778 CALL HWHSSS(IQ1,3,IQ2,2,3142,10)
38781 HCS = HCS + BUSTLR(IQ1)*DIST
38782 IF (GENEV.AND.HCS.GT.RCS) THEN
38783 CALL HWHSSS(IQ1,1,IQ2,2,3142,10)
38786 HCS = HCS + BUSTRL(IQ1)*DIST
38787 IF (GENEV.AND.HCS.GT.RCS) THEN
38788 CALL HWHSSS(IQ1,3,IQ2,0,3142,10)
38793 HCS = HCS + CSTU(IQ1)*DIST
38794 IF (GENEV.AND.HCS.GT.RCS) THEN
38795 CALL HWHSSS(IGL,0,IGL,0,3142,10)
38798 HCS = HCS + CSUT(IQ1)*DIST
38799 IF (GENEV.AND.HCS.GT.RCS) THEN
38800 CALL HWHSSS(IGL,0,IGL,0,4123,10)
38804 ELSEIF (ID2.NE.13) THEN
38806 IF (IQ1.NE.IQ2) THEN
38809 HCS = HCS + ASTULL(IQ1,IQ2)*DIST
38810 IF (GENEV.AND.HCS.GT.RCS) THEN
38811 CALL HWHSSS(IQ1,1,IQ2,1,4312,10)
38814 HCS = HCS + ASTURR(IQ1,IQ2)*DIST
38815 IF (GENEV.AND.HCS.GT.RCS) THEN
38816 CALL HWHSSS(IQ1,3,IQ2,3,4312,10)
38819 HCS = HCS + ASTULR(IQ1,IQ2)*DIST
38820 IF (GENEV.AND.HCS.GT.RCS) THEN
38821 CALL HWHSSS(IQ1,1,IQ2,3,4312,10)
38824 HCS = HCS + ASTURL(IQ1,IQ2)*DIST
38825 IF (GENEV.AND.HCS.GT.RCS) THEN
38826 CALL HWHSSS(IQ1,3,IQ2,1,4312,10)
38832 HCS = HCS + BSTULL(IQ1)*DIST
38833 IF (GENEV.AND.HCS.GT.RCS) THEN
38834 CALL HWHSSS(IQ1,1,IQ2,1,4312,10)
38837 HCS = HCS + BSTURR(IQ1)*DIST
38838 IF (GENEV.AND.HCS.GT.RCS) THEN
38839 CALL HWHSSS(IQ1,3,IQ2,3,4312,10)
38842 HCS = HCS + BSTULR(IQ1)*DIST
38843 IF (GENEV.AND.HCS.GT.RCS) THEN
38844 CALL HWHSSS(IQ1,1,IQ2,3,4312,10)
38847 HCS = HCS + BSTURL(IQ1)*DIST
38848 IF (GENEV.AND.HCS.GT.RCS) THEN
38849 CALL HWHSSS(IQ1,3,IQ2,1,4312,10)
38852 HCS = HCS + BSUTLL(IQ1)*DIST
38853 IF (GENEV.AND.HCS.GT.RCS) THEN
38854 CALL HWHSSS(IQ1,1,IQ2,1,3421,10)
38857 HCS = HCS + BSUTRR(IQ1)*DIST
38858 IF (GENEV.AND.HCS.GT.RCS) THEN
38859 CALL HWHSSS(IQ1,3,IQ2,3,3421,10)
38862 HCS = HCS + BSUTLR(IQ1)*DIST
38863 IF (GENEV.AND.HCS.GT.RCS) THEN
38864 CALL HWHSSS(IQ1,1,IQ2,3,3421,10)
38867 HCS = HCS + BSUTRL(IQ1)*DIST
38868 IF (GENEV.AND.HCS.GT.RCS) THEN
38869 CALL HWHSSS(IQ1,3,IQ2,1,3421,10)
38877 HCS = HCS + CTSUL(IQ1)*DIST
38878 IF (GENEV.AND.HCS.GT.RCS) THEN
38879 CALL HWHSSS(IQ1,1,IQ2,0,2413,10)
38882 HCS = HCS + CTSUR(IQ1)*DIST
38883 IF (GENEV.AND.HCS.GT.RCS) THEN
38884 CALL HWHSSS(IQ1,3,IQ2,0,2413,10)
38887 HCS = HCS + CTUSL(IQ1)*DIST
38888 IF (GENEV.AND.HCS.GT.RCS) THEN
38889 CALL HWHSSS(IQ1,1,IQ2,0,4312,10)
38892 HCS = HCS + CTUSR(IQ1)*DIST
38893 IF (GENEV.AND.HCS.GT.RCS) THEN
38894 CALL HWHSSS(IQ1,3,IQ2,0,4312,10)
38904 HCS = HCS + CTSUL(IQ2)*DIST
38905 IF (GENEV.AND.HCS.GT.RCS) THEN
38906 CALL HWHSSS(IQ1,0,IQ2,0,2413,10)
38909 HCS = HCS + CTSUR(IQ2)*DIST
38910 IF (GENEV.AND.HCS.GT.RCS) THEN
38911 CALL HWHSSS(IQ1,0,IQ2,2,2413,10)
38914 HCS = HCS + CTUSL(IQ2)*DIST
38915 IF (GENEV.AND.HCS.GT.RCS) THEN
38916 CALL HWHSSS(IQ1,0,IQ2,0,3421,10)
38919 HCS = HCS + CTUSR(IQ2)*DIST
38920 IF (GENEV.AND.HCS.GT.RCS) THEN
38921 CALL HWHSSS(IQ1,0,IQ2,2,3421,10)
38924 ELSEIF (ID2.LT.13) THEN
38928 HCS = HCS + CTSUL(IQ2)*DIST
38929 IF (GENEV.AND.HCS.GT.RCS) THEN
38930 CALL HWHSSS(IQ1,0,IQ2,1,3142,10)
38933 HCS = HCS + CTSUR(IQ2)*DIST
38934 IF (GENEV.AND.HCS.GT.RCS) THEN
38935 CALL HWHSSS(IQ1,0,IQ2,3,3142,10)
38938 HCS = HCS + CTUSL(IQ2)*DIST
38939 IF (GENEV.AND.HCS.GT.RCS) THEN
38940 CALL HWHSSS(IQ1,0,IQ2,1,4312,10)
38943 HCS = HCS + CTUSR(IQ2)*DIST
38944 IF (GENEV.AND.HCS.GT.RCS) THEN
38945 CALL HWHSSS(IQ1,0,IQ2,3,4312,10)
38953 HCS = HCS + CSTUL(IQ)*DIST
38954 IF (GENEV.AND.HCS.GT.RCS) THEN
38955 CALL HWHSSS(IQ ,0,IQ ,1,2413,10)
38958 HCS = HCS + CSTUR(IQ)*DIST
38959 IF (GENEV.AND.HCS.GT.RCS) THEN
38960 CALL HWHSSS(IQ ,2,IQ ,3,2413,10)
38963 HCS = HCS + CSUTL(IQ)*DIST
38964 IF (GENEV.AND.HCS.GT.RCS) THEN
38965 CALL HWHSSS(IQ ,0,IQ ,1,4123,10)
38968 HCS = HCS + CSUTR(IQ)*DIST
38969 IF (GENEV.AND.HCS.GT.RCS) THEN
38970 CALL HWHSSS(IQ ,2,IQ ,3,4123,10)
38976 HCS = HCS + DTSU*DIST
38977 IF (GENEV.AND.HCS.GT.RCS) THEN
38978 CALL HWHSSS(IQ1,0,IQ2,0,2341,10)
38981 HCS = HCS + DSTU*DIST
38982 IF (GENEV.AND.HCS.GT.RCS) THEN
38983 CALL HWHSSS(IQ1,0,IQ2,0,3421,10)
38986 HCS = HCS + DUTS*DIST
38987 IF (GENEV.AND.HCS.GT.RCS) THEN
38988 CALL HWHSSS(IQ1,0,IQ2,0,2413,10)
39001 CALL HWETWO(.TRUE.,.TRUE.)
39003 C Calculate coefficients for constructing spin density matrices
39004 C Set to zero for now
39005 CALL HWVZRO(7,GCOEF)
39009 *CMZ :- -25/06/99 20.33.45 by Kosuke Odagiri
39010 *-- Author : Kosuke Odagiri & Bryan Webber
39011 C-----------------------------------------------------------------------
39013 C-----------------------------------------------------------------------
39014 C SUSY HARD 2 PARTON -> 2 SPARTON/GAUGINO/SLEPTON PROCESSES
39015 C-----------------------------------------------------------------------
39016 INCLUDE 'herwig65.inc'
39017 DOUBLE PRECISION SAVWT(3),RANWT,HWRGEN,HWRUNI,Z1,Z2,ET,EJ,
39018 & QPE,S,T,U,KK,KK2,YJ1INF,YJ1SUP,YJ2INF,YJ2SUP,SVEMSC
39020 EXTERNAL HWRGEN,HWRUNI
39022 IF (.NOT.GENEV) THEN
39027 IF (KK.GE.ONE) RETURN
39028 YJ1INF = MAX( YJMIN, LOG((ONE-SQRT(ONE-KK2))/KK) )
39029 YJ1SUP = MIN( YJMAX, LOG((ONE+SQRT(ONE-KK2))/KK) )
39030 IF (YJ1INF.GE.YJ1SUP) RETURN
39031 Z1=EXP(HWRUNI(1,YJ1INF,YJ1SUP))
39032 YJ2INF = MAX( YJMIN, -LOG(TWO/KK-ONE/Z1) )
39033 YJ2SUP = MIN( YJMAX, LOG(TWO/KK-Z1) )
39034 IF (YJ2INF.GE.YJ2SUP) RETURN
39035 Z2=EXP(HWRUNI(2,YJ2INF,YJ2SUP))
39036 XX(1)=HALF*(Z1+Z2)*KK
39037 IF (XX(1).GE.ONE) RETURN
39038 XX(2)=XX(1)/(Z1*Z2)
39039 IF (XX(2).GE.ONE) RETURN
39040 S=XX(1)*XX(2)*PHEP(5,3)**2
39041 QPE=S-(TWO*RMMNSS)**2
39042 IF (QPE.LE.ZERO) RETURN
39043 COSTH=HALF*ET*(Z1-Z2)/SQRT(Z1*Z2*QPE)
39044 IF (ABS(COSTH).GT.ONE) RETURN
39045 T=-(ONE+Z2/Z1)*(HALF*ET)**2
39047 C---SET EMSCA TO HEAVY HARD PROCESS SCALE
39048 SVEMSC = SQRT(TWO*S*T*U/(S*S+T*T+U*U))
39049 FACTSS = GEV2NB*HALF*PIFAC*EJ*ET/S**2
39050 & * (YJ1SUP-YJ1INF)*(YJ2SUP-YJ2INF)
39057 RANWT=SAVWT(3)*HWRGEN(0)
39058 IF (RANWT.LT.SAVWT(1)) THEN
39060 ELSEIF (RANWT.LT.SAVWT(2)) THEN
39069 SAVWT(2)=SAVWT(1)+EVWGT
39071 SAVWT(3)=SAVWT(2)+EVWGT
39074 ELSEIF (ISP.EQ.10) THEN
39076 ELSEIF (ISP.EQ.20) THEN
39078 ELSEIF (ISP.EQ.30) THEN
39081 C---UNRECOGNIZED PROCESS
39082 CALL HWWARN('HWHSSP',500)
39086 *CMZ :- -18/05/99 20.33.45 by Kosuke Odagiri
39087 *-- Author : Kosuke Odagiri
39088 C-----------------------------------------------------------------------
39089 SUBROUTINE HWHSSS(ID3,R3,ID4,R4,IPERM,IHPR)
39090 C-----------------------------------------------------------------------
39091 C IDENTIFIES HARD SUSY SUBPROCESS
39092 C-----------------------------------------------------------------------
39093 INCLUDE 'herwig65.inc'
39094 INTEGER ID3, R3, ID4, R4, IPERM, IHPR, SSL
39095 PARAMETER (SSL = 400)
39096 IHPRO = 3000 + IHPR
39097 IDN(3) = SSL + ID3 + R3*6
39098 IDN(4) = SSL + ID4 + R4*6
39099 ICO(1) = IPERM/1000
39100 ICO(2) = IPERM/100 - 10*ICO(1)
39101 ICO(3) = IPERM/10 - 10*(IPERM/100)
39102 ICO(4) = IPERM - 10*(IPERM/10)
39105 *CMZ :- -18/05/99 14.37.45 by Mike Seymour
39106 *-- Author : Mike Seymour
39107 C-----------------------------------------------------------------------
39109 C-----------------------------------------------------------------------
39110 C V + 1 JET PRODUCTION, WHERE V=W (IHPRO.LT.5) OR Z (IHPRO.GE.5).
39111 C USES CROSS-SECTIONS OF EHLQ FOR ANNIHILATION AND COMPTON SCATTERING
39112 C IHPRO=0 FOR BOTH, 1 FOR ANNIHILATION, AND 2 FOR COMPTON.
39113 C-----------------------------------------------------------------------
39114 INCLUDE 'herwig65.inc'
39115 DOUBLE PRECISION HWRGEN,HWRUNI,DISFAC(2,12,2),EMV2,DISMAX,S,T,U,
39116 & SHAT,THAT,UHAT,Z,HWUALF,PT,EMT,GFACTR,SIGANN,SIGCOM(2),CSFAC,ET,
39117 & EJ,YMIN,YMAX,VYMIN,VYMAX,EMAX,CV,CA,BR,EMV,GAMV,HWUAEM,TMIN,TMAX
39118 INTEGER HWRINT,IDINIT(2,12,2),ICOFLO(4,2),I,J,K,L,M,ID1,ID2,
39121 SAVE DISFAC,SHAT,THAT,EMV,EMV2,IDV,IDI
39123 C---IDINIT HOLDS THE INITIAL STATES FOR ANNIHILATION PROCESSES
39124 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,
39125 $ 1,7,2,8,3,9,4,10,5,11,6,12,1,7,2,8,3,9,4,10,5,11,6,12/
39126 C---ICOFLO HOLDS THE COLOR FLOW FOR EACH PROCESS
39127 C---DISFAC HOLDS THE DISTRIBUTION FUNCTION*CROSS-SECTION FOR EACH
39128 C POSSIBLE SUB-PROCESS.
39129 C INDEX1=INITIAL STATE PERMUTATION (1=AS IDINIT/QG;2=OPPOSITE/GQ),
39130 C 2=QUARK (FOR ANNIHILATION, >6 IMPLIES CABIBBO ROTATED PAIR),
39131 C 3=PROCESS (1=ANNIHILATION, 2=COMPTON)
39132 DATA ICOFLO,DISFAC/2,4,3,1,4,1,3,2,48*0.D0/
39138 110 DISMAX=MAX(DISFAC(K,J,I),DISMAX)
39142 IF (HWRGEN(0)*DISMAX.GT.DISFAC(K,J,I)) GOTO 120
39145 IDN(1)=IDINIT(K,J,IDI)
39146 IDN(2)=IDINIT(3-K,J,IDI)
39149 C---COMPTON SCATTERING
39152 IF (IDV.EQ.200) THEN
39155 IF (J.EQ.5.OR.J.EQ.6.OR.J.GE.11.OR.HWRGEN(0).GT.SCABI) THEN
39156 C---CHANGE QUARKS (1->2,2->1,3->4,4->3,...)
39157 IDN(4)=4*INT((J-1)/2)-J+3
39159 C---CHANGE AND CABIBBO ROTATE QUARKS (1->4,2->3,3->2,...)
39160 IDN(4)=12*INT((J-1)/6)-J+5
39163 IF ((SQRT(EMV2)+RMASS(IDN(4)))**2.GT.SHAT) GOTO 120
39165 C---SWAP INITIAL STATES
39171 IF (IDV.EQ.200) THEN
39174 C---W+ OR W-? USE CHARGE CONSERVATION TO WORK OUT
39175 IDN(3)=NINT(198.5-.1667*FLOAT(ICHRG(IDN(1))+ICHRG(IDN(2))))
39178 IF (I.EQ.2.AND.J.LE.6) M=3-K
39180 130 ICO(L)=ICOFLO(L,M)
39182 COSTH=(SHAT+2*THAT-EMV2)/(SHAT-EMV2)
39183 C---TRICK HWETWO INTO USING THE OFF-SHELL V MASS
39184 RMASS(IDN(3))=SQRT(EMV2)
39185 C-- BRW fix 27/8/04: avoid double smearing of V mass
39186 CALL HWETWO(.FALSE.,.TRUE.)
39188 RHOHEP(1,NHEP-1)=0.5
39189 RHOHEP(2,NHEP-1)=0.0
39190 RHOHEP(3,NHEP-1)=0.5
39193 IHPRO=MOD(IPROC,100)/10
39194 IF (IHPRO.LT.5) THEN
39207 c---mhs---implement cut on number of widths from nominal mass
39208 TMIN=-ATAN(2*GAMMAX-GAMV*GAMMAX**2/EMV)
39209 TMAX=ATAN(2*GAMMAX+GAMV*GAMMAX**2/EMV)
39210 EMV2=EMV*(EMV+GAMV*TAN(HWRUNI(0,TMIN,TMAX)))
39211 IF (EMV2.LE.ZERO) RETURN
39214 EMT=SQRT(PT**2+EMV2)
39215 EMAX=0.5*(PHEP(5,3)+EMV2/PHEP(5,3))
39216 IF (EMAX.LE.EMT) RETURN
39217 VYMAX=0.5*LOG((EMAX+SQRT(EMAX**2-EMT**2))
39218 & /(EMAX-SQRT(EMAX**2-EMT**2)))
39220 IF (VYMAX.LE.VYMIN) RETURN
39221 Z=EXP(HWRUNI(0,VYMIN,VYMAX))
39223 T=-PHEP(5,3)*EMT/Z+EMV2
39224 U=-PHEP(5,3)*EMT*Z+EMV2
39225 XXMIN=-U/(S+T-EMV2)
39226 IF (XXMIN.LT.ZERO.OR.XXMIN.GT.ONE) RETURN
39227 YMIN=MAX(LOG((XXMIN*PHEP(5,3)-EMT*Z)/PT),YJMIN)
39228 YMAX=MIN(LOG((PHEP(5,3)-EMT*Z)/PT),YJMAX)
39229 IF (YMAX.LE.YMIN) RETURN
39230 XX(1)=(Z*EMT+EXP(HWRUNI(2,YMIN,YMAX))*PT)/PHEP(5,3)
39231 IF (XX(1).LE.ZERO.OR.XX(1).GT.ONE) RETURN
39232 THAT =XX(1)*T+(1.-XX(1))*EMV2
39233 XX(2)=-THAT / (XX(1)*S+U-EMV2)
39234 IF (XX(2).LT.ZERO.OR.XX(2).GT.ONE) RETURN
39235 UHAT =XX(2)*U+(1.-XX(2))*EMV2
39236 SHAT =XX(1)*XX(2)*S
39238 CALL HWSGEN(.FALSE.)
39239 c---mhs minor improvement: replace thomson coupling by running coupling
39240 c---mhs bug fix: missing factor of m^2/m0^2, where m0 is nominal mass
39241 GFACTR=GEV2NB*2.*PIFAC*HWUAEM(EMV2)*HWUALF(1,EMSCA)/(9.*SWEIN)
39243 SIGANN=GFACTR*((THAT-EMV2)**2+(UHAT-EMV2)**2)
39244 & /(SHAT**2*THAT*UHAT)
39245 SIGCOM(2)=.375*GFACTR*(SHAT**2+UHAT**2+2*EMV2*THAT)
39247 SIGCOM(1)=.375*GFACTR*(SHAT**2+THAT**2+2*EMV2*UHAT)
39249 C---IF USER SPECIFIED A SUB-PROCESS, ZERO THE OTHER
39250 IF (IHPRO.EQ.1) THEN
39254 IF (IHPRO.EQ.2) SIGANN=0.
39256 IF (IDV.EQ.200) THEN
39259 DISFAC(1,I,1)=4*SWEIN*(VFCH(J,1)**2+AFCH(J,1)**2)
39262 DISFAC(1,I,1)=1-SCABI
39263 ELSEIF (I.GE.7) THEN
39264 DISFAC(1,I,1)=SCABI
39269 DISFAC(2,I,1)=DISFAC(1,I,1) *
39270 & SIGANN*DISF(IDINIT(1,I,IDI),2)*DISF(IDINIT(2,I,IDI),1)
39271 DISFAC(1,I,1)=DISFAC(1,I,1) *
39272 & SIGANN*DISF(IDINIT(1,I,IDI),1)*DISF(IDINIT(2,I,IDI),2)
39279 IF (IDV.EQ.200) THEN
39282 DISFAC(1,I,2)=4*SWEIN*(VFCH(J,1)**2+AFCH(J,1)**2)
39285 c---mhs fix: switch off bg->Wt process since we neglect quark masses!
39286 IF (I.EQ.5.OR.I.EQ.11) DISFAC(1,I,2)=0
39288 DISFAC(2,I,2)=DISFAC(1,I,2)*SIGCOM(2)*DISF(I,2)*DISF(13,1)
39289 DISFAC(1,I,2)=DISFAC(1,I,2)*SIGCOM(1)*DISF(I,1)*DISF(13,2)
39294 230 EVWGT=EVWGT+DISFAC(K,J,I)
39295 CSFAC=PT*EJ*(YMAX-YMIN)*(VYMAX-VYMIN)*(TMAX-TMIN)/PIFAC
39296 C---INCLUDE BRANCHING RATIO OF V
39297 CALL HWDBOZ(IDV,ID1,ID2,CV,CA,BR,0)
39298 EVWGT=EVWGT*CSFAC*BR
39302 *CMZ :- -14/03/01 09:03:25 by Peter Richardson
39303 *-- Author : Peter Richardson
39304 C-----------------------------------------------------------------------
39306 C-----------------------------------------------------------------------
39307 C Vector Boson production with two hard jets
39308 C Master subroutine for all vector boson + 2 jet processes
39309 C Currently implemented qqbar Z only
39310 C-----------------------------------------------------------------------
39311 INCLUDE 'herwig65.inc'
39312 INTEGER I,J,K,IDBS,IPRC,IDP(6),ORD,IB,ICMF,IHEP,IFLOW,IZ,IBRAD,
39314 DOUBLE PRECISION HWRGEN,HWRUNI,XMASS,PLAB,PRW,PCM,HWUAEM,BR,FLUX,
39315 & MBOS,MBOS2,ME,DT(4),B(6),HWUPCM,CV,CA,PST,HWUALF,GMBS,FPI4,
39316 & MQ(3),MQ2(3),MJAC,BRZED(12),PTP(5,2),PDOT(2),HWULDO,TWOPI2,
39318 DOUBLE COMPLEX S,D,F
39319 LOGICAL FSTCLL,MASS,GEN
39320 EXTERNAL HWRGEN,HWRUNI,HWUPCM,HWUALF,HWUAEM,HWULDO
39321 COMMON/HWHEWP/XMASS(10),PLAB(5,10),PRW(5,2),PCM(5,10)
39322 COMMON/HWHEWS/S(8,8,2),D(8,8)
39323 COMMON/HWHZBB/F(8,8)
39325 SAVE ME,MBOS,MBOS2,GMBS,IDBS,IPRC,IDP,FSTCLL,MQ,MQ2,TWOPI2,FPI4,
39328 DATA B/-1.0D0,-1.0D0,1.0D0,1.0D0,1.0D0,1.0D0/
39329 DATA BRZED/0.154D0,0.120D0,0.154D0,0.120D0,0.152D0,0.000D0,
39330 & 0.033D0,0.067D0,0.033D0,0.067D0,0.033D0,0.067D0/
39331 C--generate the event
39333 C--find the particles produced
39337 ELSEIF(IPRC.GT.0.AND.IPRC.LE.16) THEN
39338 CALL HWHDYQ(FSTCLL,ME,IFLOW,IDP,ORD,IQ,MASS)
39340 CALL HWWARN('HWHV2J',502)
39346 PRW(3,1) = -PRW(3,1)
39348 PLAB(3,I)=-PLAB(3,I)
39351 C--enter the incoming particles
39355 CALL HWVEQU(5,PLAB(1,I),PHEP(1,IHEP))
39356 IDHW(IHEP) = IDP(I)
39357 IDHEP(IHEP)= IDPDG(IDP(I))
39359 JMOHEP(1,IHEP)=ICMF
39360 JMOHEP(I,ICMF)=IHEP
39361 JDAHEP(1,IHEP)=ICMF
39364 IDHEP(ICMF)=IDPDG(15)
39366 CALL HWVSUM(4,PHEP(1,NHEP+1),PHEP(1,NHEP+2),PHEP(1,ICMF))
39367 CALL HWUMAS(PHEP(1,ICMF))
39368 JDAHEP(1,ICMF) = ICMF+1
39369 JDAHEP(2,ICMF) = ICMF+3
39371 C--Now the outgoing jets
39373 CALL HWVEQU(5,PLAB(1,2+I),PHEP(1,NHEP+I))
39374 C--Set the status and pointers
39376 IDHW(NHEP+I)=IDP(2+I)
39377 IDHEP(NHEP+I)=IDPDG(IDP(2+I))
39378 JMOHEP(1,NHEP+I)=NHEP
39381 C--Now sort out the colour connections
39383 ICOL(2)=IFLOW/100-10*ICOL(1)
39384 ICOL(3)=IFLOW/10 -10*(IFLOW/100)
39385 ICOL(4)=IFLOW -10*(IFLOW/10)
39391 JMOHEP(2,NHEP-5+J)=NHEP+K-5
39392 30 JDAHEP(2,NHEP-5+K)=NHEP+J-5
39393 C--Now add the Z to the event record
39394 CALL HWVEQU(5,PRW(1,1),PHEP(1,NHEP+1))
39395 CALL HWVZRO(4,VHEP(1,NHEP+1))
39396 CALL HWUDKL(200,PHEP(1,NHEP+1),DT)
39397 CALL HWVSUM(4,VHEP(1,NHEP+1),DT,DT)
39399 IDHEP(NHEP+1)=IDPDG(IDBS)
39400 JMOHEP(1,NHEP+1)=ICMF
39401 JMOHEP(2,NHEP+1)=ICMF
39405 C--generate the inital-state shower
39407 C--now add the decay products of the Z
39408 IZ = JDAHEP(1,IBRAD)
39410 JDAHEP(1,IZ) = NHEP+1
39411 JDAHEP(2,IZ) = NHEP+2
39412 IDHW(NHEP+1) = IDP(5)
39413 IDHW(NHEP+2) = IDP(6)
39414 ISTHEP(NHEP+1) = 113
39415 ISTHEP(NHEP+2) = 114
39416 IDHEP(NHEP+1) = IDPDG(IDP(5))
39417 IDHEP(NHEP+2) = IDPDG(IDP(6))
39418 JMOHEP(1,NHEP+1) = IZ
39419 JMOHEP(1,NHEP+2) = IZ
39420 JMOHEP(2,NHEP+1) = NHEP+2
39421 JDAHEP(2,NHEP+1) = NHEP+2
39422 JMOHEP(2,NHEP+2) = NHEP+1
39423 JDAHEP(2,NHEP+2) = NHEP+1
39424 CALL HWVEQU(5,PLAB(1,5),PHEP(1,NHEP+1))
39425 CALL HWVEQU(5,PLAB(1,6),PHEP(1,NHEP+2))
39426 DO IHEP=NHEP+1,NHEP+2
39427 CALL HWVEQU(4,DT,VHEP(1,IHEP))
39428 C--Boost the fermion momenta to the rest frame of the original Z
39429 CALL HWULOF(PRW(1,1),PHEP(1,IHEP),PHEP(1,IHEP))
39430 C--Now boost back to the lab from rest frame of the Z after radiation
39431 CALL HWULOB(PHEP(1,IZ),PHEP(1,IHEP),PHEP(1,IHEP))
39437 C--for second option minimum invariant mass of the jet pair
39438 C--set the type of events to be generated
39439 TWOPI2= FOUR*PIFAC**2
39440 FPI4 = (FOUR*PIFAC)**4
39441 IPRC = MOD(IPROC,100)
39442 IF(IPRC.GE.0.AND.IPRC.LE.16) THEN
39446 GMBS = MBOS2*GAMZ**2
39452 ELSEIF(IPRC.GT.0.AND.IPRC.LE.6) THEN
39454 IF(MJJMIN.LT.TWO*RMASS(IQ)) MJJMIN = TWO*RMASS(IQ)
39455 ELSEIF(IPRC.GE.11.AND.IPRC.LE.16) THEN
39460 IF(MJJMIN.LT.(MQ(1)+MQ(2))) MJJMIN = MQ(1)+MQ(2)
39462 CALL HWWARN('HWHV2J',500)
39468 CALL HWWARN('HWHV2J',503)
39472 C--generate the weight
39474 C--find the mass of the gauge boson
39475 CALL HWHGB1(1,2,IDBS,MJAC,MQ2(3),(PHEP(5,3)-MQ(1)-MQ(2))**2,
39477 MQ(3) = SQRT(MQ2(3))
39478 MJAC = MJAC/((MQ2(3)-MBOS2)**2+GMBS)
39479 C--do the phase space
39480 CALL HWH2PS(FLUX,GEN,MQ,MQ2)
39482 IF(.NOT.GEN) RETURN
39483 C--copy the gauge boson momentum
39484 CALL HWVEQU(5,PLAB(1,5),PRW(1,1))
39485 C--select the decay mode of the boson
39486 CALL HWDBOZ(IDBS,IDP(5),IDP(6),CV,CA,BR,0)
39488 IF(IDZ.GT.6) IDZ = IDZ-114
39490 IF(IDZ.LE.6) AMP = AMP*THREE
39491 C--Finds the momenta of the boson decay products
39492 PST=HWUPCM(PRW(5,1),ZERO,ZERO)
39495 IF(PRW(5,1).LT.(RMASS(IDP(5))+RMASS(IDP(6)))) RETURN
39496 CALL HWDTWO(PRW(1,1),PLAB(1,5),PLAB(1,6),PST,TWO,.FALSE.)
39497 MJAC = HALF*PST*MJAC/TWOPI2/MQ(3)
39498 C--copy the momenta, change order and boost to CMF
39501 PTP(3,1) = HALF*(XX(1)-XX(2))*PHEP(5,3)
39502 PTP(4,1) = HALF*(XX(1)+XX(2))*PHEP(5,3)
39503 PTP(5,1) = PHEP(5,3)*SQRT(XX(1)*XX(2))
39505 CALL HWULOF(PTP(1,1),PLAB(1,I),PTP(1,2))
39512 C--Massive momentum case
39513 C--reorder the products
39514 C--move b and bbar to 9 and 10
39517 PCM(J,I+6) = PCM(J,I)
39520 C--select the reference momenta for the b and bbar and put in 3,4
39521 C--the results is independent of this choice
39522 CALL HWVEQU(5,PCM(1,1),PCM(1,3))
39523 CALL HWVEQU(5,PCM(1,1),PCM(1,4))
39524 C--find the massless vectors for the b and bbar
39525 PDOT(1) = HALF*MQ2(1)/HWULDO(PCM(1,3),PCM(1, 9))
39526 PDOT(2) = HALF*MQ2(2)/HWULDO(PCM(1,4),PCM(1,10))
39528 PCM(I,7) = PCM(I,9) -PDOT(1)*PCM(I,3)
39529 PCM(I,8) = PCM(I,10)-PDOT(2)*PCM(I,4)
39533 C--use e+e- code to calculate the spinor products
39534 CALL HWHEW2(8,PCM(1,1),S(1,1,2),S(1,1,1),D)
39537 S(I,J,2) = -S(I,J,2)
39538 D(I,J) = TWO*D(I,J)
39542 C--Massless case, use the e+e- code to calculate the spinor products
39543 CALL HWHEW2(6,PCM(1,1),S(1,1,2),S(1,1,1),D)
39546 D(I,J) = TWO*D(I,J)
39547 F(I,J) = B(I)*B(J)*D(I,J)
39548 S(I,J,2) = -S(I,J,2)
39552 C--now call the code to calculate the matrix element*PDF
39556 ELSEIF(IPRC.GT.0.AND.IPRC.LE.16) THEN
39557 CALL HWHDYQ(FSTCLL,ME,IFLOW,IDP,ORD,IQ,MASS)
39559 CALL HWWARN('HWHV2J',501)
39562 AMP = AMP*MJAC*BR*FPI4*HWUAEM(EMSCA**2)**2*HWUALF(1,EMSCA)**2
39563 EVWGT = FLUX*ME*AMP
39566 IF(CHON(I)) WI(I) = WI(I)*ME**2*AMP**2
39571 1000 FORMAT('DRELL-YAN + 2 JETS NOT YET IMPLEMENTED')
39575 *CMZ :- -11/05/01 09.19.45 by Bryan Webber
39576 *-- Author : Bryan Webber
39577 C-----------------------------------------------------------------------
39579 C-----------------------------------------------------------------------
39580 C VV + 1 JET PRODUCTION, WHERE VV=WW,ZZ,WZ FOR IPROC=2850,2860,2870
39581 C-----------------------------------------------------------------------
39583 PRINT *,' VV + 1 JET CALLED BUT NOT YET IMPLEMENTED'
39584 CALL HWWARN('HWHVVJ',500)
39587 *CMZ :- -26/04/91 14.55.45 by Federico Carminati
39588 *-- Author : Mike Seymour
39589 C-----------------------------------------------------------------------
39591 C-----------------------------------------------------------------------
39592 C TOP QUARK PRODUCTION VIA W EXCHANGE: MEAN EVWGT=TOP PROD C-S IN NB
39594 C UbarBbar, DBbar, DbarB, UB, CbarBbar, SBbar, SbarB, AND CB
39595 C UNLESS USER SPECIFIES OTHERWISE BY MOD(IPROC,100)=1-8 RESPECTIVELY
39596 C---DSDCOS HOLDS THE CROSS-SECTIONS FOR THE PROCESSES LISTED ABOVE
39597 C (1-8) ARE WITH B FROM BEAM 1, (9-16) ARE WITH B FROM BEAM 2.
39598 C-----------------------------------------------------------------------
39599 INCLUDE 'herwig65.inc'
39600 DOUBLE PRECISION HWRGEN,HWRUNI,DSDCOS(16),EMT2,EMT,EMW2,EMW,
39601 & CMFMIN,TAUMIN,TAUMLN,S,T,U,ROOTS,DSMAX
39602 INTEGER HWRINT,IDHWEX(2,16),I
39603 EXTERNAL HWRGEN,HWRUNI,HWRINT
39605 EQUIVALENCE (EMW,RMASS(198)),(EMT,RMASS(6))
39606 C---IDHWEX HOLDS THE IDs OF THE INCOMING PARTICLES FOR EACH SUB-PROCESS
39608 DATA IDHWEX/11,8,11,1,5,7,5,2,11,10,11,3,5,9,5,4,
39609 & 8,11,1,11,7,5,2,5,10,11,3,11,9,5,4,5/
39613 300 IHPRO=HWRINT(1,16)
39614 IF (HWRGEN(0).GT.DSDCOS(IHPRO)/DSMAX) GOTO 300
39616 IDN(I)=IDHWEX(I,IHPRO)
39617 IF (IDN(I).EQ.5 .OR. IDN(I).EQ.11) THEN
39618 C---CHANGE B QUARK INTO T QUARK
39620 ELSEIF (HWRGEN(0).GT.SCABI) THEN
39621 C---CHANGE QUARKS (1->2,2->1,3->4,4->3,7->8,8->7,...)
39622 IDN(I+2)=4*INT((IDN(I)-1)/2)-IDN(I)+3
39624 C---CHANGE AND CABIBBO ROTATE QUARKS (1->4,2->3,3->2,4->1,7->10,...)
39625 IDN(I+2)=12*INT((IDN(I)-1)/6)-IDN(I)+5
39631 CALL HWETWO(.TRUE.,.TRUE.)
39635 TAUMIN=(CMFMIN/PHEP(5,3))**2
39637 ROOTS=PHEP(5,3)*SQRT(EXP(HWRUNI(0,ZERO,TAUMLN)))
39638 XXMIN=(ROOTS/PHEP(5,3))**2
39640 COSTH=HWRUNI(0,-ONE, ONE)
39644 EMSCA=SQRT(2*S*T*U/(S*S+T*T+U*U))
39645 DSDCOS(1)=GEV2NB*PIFAC*.125*(ALPHEM/SWEIN)**2
39646 & *(S-EMT2)**2 / S / (EMW2 + 0.5*(S-EMT2)*(1-COSTH))**2
39647 DSDCOS(2)=DSDCOS(1) / 4
39648 & * (1 + EMT2/S + 2*COSTH + (1-EMT2/S)*COSTH**2)
39649 DSDCOS(3)=DSDCOS(2)
39650 DSDCOS(4)=DSDCOS(1)
39651 C---IF USER SPECIFIED SUB-PROCESS THEN ZERO ALL THE OTHERS
39652 IHPRO=MOD(IPROC,100)
39653 IF (IHPRO.GT.8) THEN
39654 CALL HWWARN('HWHWEX',1)
39658 IF (I.LE.4) DSDCOS(I+4)=DSDCOS(I)
39659 IF (IHPRO.NE.0 .AND. IHPRO.NE.I) DSDCOS(I)=0
39660 DSDCOS(I+8)=DSDCOS(I)
39662 CALL HWSGEN(.TRUE.)
39665 DSDCOS(I)=DSDCOS(I)*DISF(IDHWEX(1,I),1)*DISF(IDHWEX(2,I),2)
39666 EVWGT=EVWGT + 2*TAUMLN*XLMIN*DSDCOS(I)
39667 IF (DSDCOS(I).GT.DSMAX) DSMAX=DSDCOS(I)
39672 *CMZ :- -18/05/99 14.22.13 by Mike Seymour
39673 *-- Author : Bryan Webber
39674 C-----------------------------------------------------------------------
39676 C-----------------------------------------------------------------------
39677 C W+/- PRODUCTION AND DECAY VIA DRELL-YAN PROCESS
39678 C MEAN EVWGT IS SIG(W+/-)*(BRANCHING FRACTION) IN NB
39679 C-----------------------------------------------------------------------
39680 INCLUDE 'herwig65.inc'
39681 DOUBLE PRECISION HWRGEN,HWRUNI,HWUPCM,PRAN,PROB,COEF,CSFAC,EMW,
39682 & FTQK,PTOP,ETOP,EBOT,PMAX,FHAD,FTOT,BRAF,FLEP,TMIN,HWUAEM,TMAX
39683 INTEGER HWRINT,ICH,IC,IL,ID,IDEC,JDEC,IWP(2,16)
39685 EXTERNAL HWRGEN,HWRUNI,HWUPCM,HWRINT,HWRLOG
39686 SAVE CSFAC,IDEC,FLEP,FTQK,ETOP,PTOP,EBOT,PMAX,PROB
39688 DATA IWP/2,7,1,8,7,2,8,1,4,9,3,10,9,4,10,3,
39689 & 2,9,3,8,9,2,8,3,4,7,1,10,7,4,10,1/
39691 C---GENERATE EVENT (X'S AND STRUCTURE FUNCTIONS ALREADY FOUND)
39692 PRAN=PROB*HWRGEN(0)
39693 C---LOOP OVER PARTON FLAVOURS
39697 IF (IC.EQ.9) COEF=SCABI
39698 PROB=PROB+DISF(IWP(1,IC),1)*DISF(IWP(2,IC),2)*COEF
39699 IF (PROB.GE.PRAN) GOTO 20
39701 C---STORE INCOMING PARTONS
39702 20 IDN(1)=IWP(1,IC)
39706 C---ICH=1/2 FOR W+/-
39708 IF ((IDEC.GT.49.AND.IDEC.LT.54).OR.
39709 & (IDEC.EQ.99.AND.HWRLOG(FLEP))) THEN
39712 IF (IL.EQ.0.OR.IL.GT.3) IL=HWRINT(1,3)
39713 IDN(3)=2*IL+121-ICH
39714 IDN(4)=2*IL+124+ICH
39715 C---W DECAY ANGLE (1+COSTH)**2
39716 COSTH=2.*HWRGEN(1)**0.3333-1.
39717 ELSEIF (IDEC.EQ.5.OR.IDEC.EQ.6.OR.
39718 & ((IDEC.EQ.0.OR.IDEC.EQ.99).AND.HWRLOG(FTQK))) THEN
39719 C---W -> TOP + BOTTOM DECAY
39722 21 COSTH=HWRUNI(1,-ONE, ONE)
39723 IF ((ETOP+(PTOP*COSTH))*(EBOT+(PTOP*COSTH)).LT.
39724 & PMAX*HWRGEN(1)) GOTO 21
39726 C---OTHER HADRONIC DECAY
39731 IF (ID.GT.8) COEF=SCABI
39733 IF (PROB.GE.PRAN) THEN
39740 IF (IDEC.GT.0.AND.IDEC.LT.5) THEN
39742 IF (IDN(3).NE.IDEC.AND.IDN(4).NE.IDEC
39743 & .AND.IDN(3).NE.JDEC.AND.IDN(4).NE.JDEC) GOTO 25
39745 COSTH=2.*HWRGEN(1)**0.3333-1.
39748 IF (IDN(1).GT.6) COSTH=-COSTH
39751 CALL HWETWO(.TRUE.,.TRUE.)
39753 IDEC=MOD(IPROC,100)
39754 IF (IDEC.EQ.5.OR.IDEC.EQ.6) THEN
39755 TMIN=ATAN((RMASS(6)**2-RMASS(199)**2)/(GAMW*RMASS(199)))
39757 TMIN=-ATAN(RMASS(199)/GAMW)
39760 c---mhs---implement cut on number of widths from nominal mass
39761 TMIN=MAX(TMIN,-ATAN(2*GAMMAX-GAMW*GAMMAX**2/RMASS(199)))
39762 TMAX=ATAN(2*GAMMAX+GAMW*GAMMAX**2/RMASS(199))
39763 EMW=GAMW*TAN(HWRUNI(0,TMIN,TMAX))+RMASS(199)
39764 IF (EMW.LE.ZERO) RETURN
39765 EMW=SQRT(EMW*RMASS(199))
39766 IF (EMW.LE.QSPAC.OR.EMW.GE.PHEP(5,3)) RETURN
39768 IF (EMLST.NE.EMW) THEN
39770 XXMIN=(EMW/PHEP(5,3))**2
39772 CSFAC=-GEV2NB*PIFAC**2*HWUAEM(EMSCA**2)
39773 & /(3.*SWEIN*RMASS(199)**2)*XLMIN
39774 C---COMPUTE TOP AND LEPTONIC FRACTIONS
39776 IF (NFLAV.GT.5) THEN
39777 PTOP=HWUPCM(EMW,RMASS(5),RMASS(6))
39778 IF (PTOP.GT.ZERO) THEN
39779 ETOP=SQRT(PTOP**2+RMASS(6)**2)
39781 FTQK=2.*PTOP*(3.*ETOP*EBOT+PTOP**2)/EMW**3
39782 PMAX=(ETOP+PTOP)*(EBOT+PTOP)
39787 C---MULTIPLY WEIGHT BY BRANCHING FRACTION
39788 IF (IDEC.EQ.0) THEN
39790 ELSEIF (IDEC.LT.5.OR.IDEC.EQ.50) THEN
39792 ELSEIF (IDEC.LT.7) THEN
39794 ELSEIF (IDEC.EQ.99) THEN
39799 c---mhs fix: normalization should be to on-shell total width
39800 c (only different if chosen mass is above top threshold)
39801 CSFAC=CSFAC*BRAF/THREE*(TMAX-TMIN)/PIFAC
39805 CALL HWSGEN(.TRUE.)
39806 C---LOOP OVER PARTON FLAVOURS
39810 IF (IC.EQ.9) COEF=SCABI
39811 PROB=PROB+DISF(IWP(1,IC),1)*DISF(IWP(2,IC),2)*COEF
39817 *-- Author : M. Kirsanov
39818 C-----------------------------------------------------------------------
39820 C-----------------------------------------------------------------------
39821 INCLUDE 'herwig65.inc'
39822 IF(RMASS(1).LT.0.1.OR.RMASS(1).GT.1.0.OR.
39823 & FMRS(1,1,20,1).LT.0.1.OR.FMRS(1,1,20,1).GT.1.0) THEN
39824 STOP 'Block data hwudat not loaded, stop execution'
39828 *CMZ :- -27/07/99 13.33.03 by Mike Seymour
39829 *-- Author : Ian Knowles
39830 C-----------------------------------------------------------------------
39831 SUBROUTINE HWIODK(IUNIT,IOPT,IME)
39832 C-----------------------------------------------------------------------
39833 C If IUNIT > 0 writes out present HERWIG decay tables to unit IUNIT
39834 C < 0 reads in decay tables from unit IUNIT
39835 C The format used during the read/write is specified by IOPT
39836 C =1 PDG; =2 HERWIG numeric; =3 HERWIG character name.
39837 C When reading in if IME =1 matrix element codes >= 100 are accepted
39839 C-----------------------------------------------------------------------
39840 INCLUDE 'herwig65.inc'
39841 INTEGER IUNIT,IOPT,IME,JUNIT,I,J,K,L,IDKY,ITMP(5),IDUM
39842 CHARACTER*8 CDK(NMXDKS),CDKPRD(5,NMXDKS),CDUM
39844 OPEN(UNIT=JUNIT,FORM='FORMATTED',STATUS='UNKNOWN')
39845 IF (IUNIT.GT.0) THEN
39846 C Write out the decay table
39847 WRITE(JUNIT,100) NDKYS
39848 IF (IOPT.EQ.1) THEN
39850 IF (NMODES(I).EQ.0) GOTO 20
39852 DO 10 J=1,NMODES(I)
39853 WRITE(JUNIT,110) IDPDG(I),BRFRAC(K),NME(K),
39854 & (IDPDG(IDKPRD(L,K)),L=1,5)
39857 ELSEIF (IOPT.EQ.2) THEN
39859 IF (NMODES(I).EQ.0) GOTO 40
39861 DO 30 J=1,NMODES(I)
39862 WRITE(JUNIT,120) I,BRFRAC(K),NME(K),(IDKPRD(L,K),L=1,5)
39865 ELSEIF (IOPT.EQ.3) THEN
39867 IF (NMODES(I).EQ.0) GOTO 60
39869 DO 50 J=1,NMODES(I)
39870 WRITE(JUNIT,130) RNAME(I),BRFRAC(K),NME(K),
39871 & (RNAME(IDKPRD(L,K)),L=1,5)
39875 ELSEIF (IUNIT.LT.0) THEN
39876 C Read in the decay table and convert to HERWIG numeric format
39877 READ(JUNIT,100) NDKYS
39878 IF (NDKYS.GT.NMXDKS) THEN
39879 CALL HWWARN('HWIODK',100)
39882 IF (IOPT.EQ.1) THEN
39884 READ(JUNIT,110) IDKY,BRFRAC(I),NME(I),ITMP
39885 IF (IME.EQ.0.AND.NME(I).GE.100) NME(I)=0
39886 CALL HWUIDT(1,IDKY,IDK(I),CDUM)
39888 70 CALL HWUIDT(1,ITMP(J),IDKPRD(J,I),CDUM)
39889 ELSEIF (IOPT.EQ.2) THEN
39891 READ(JUNIT,120) IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5)
39892 IF (IDK(I).LT.0.OR.IDK(I).GT.NRES) IDK(I)=20
39893 80 IF (IME.EQ.0.AND.NME(I).GE.100) NME(I)=0
39894 ELSEIF (IOPT.EQ.3) THEN
39896 READ(JUNIT,130) CDK(I),BRFRAC(I),NME(I),(CDKPRD(J,I),J=1,5)
39897 IF (IME.EQ.0.AND.NME(I).GE.100) NME(I)=0
39898 CALL HWUIDT(3,IDUM,IDK(I),CDK(I))
39900 90 CALL HWUIDT(3,IDUM,IDKPRD(J,I),CDKPRD(J,I))
39902 CALL HWWARN('HWIODK',101)
39908 110 FORMAT(1X,I7,1X,F7.5,1X,I3,5(1X,I7))
39909 120 FORMAT(1X,I3,1X,F7.5,6(1X,I3))
39910 130 FORMAT(1X,A8,1X,F7.5,1X,I3,5(1X,A8))
39914 *CMZ :- -12/10/01 09.50.50 by Peter Richardson
39915 *-- Author : Bryan Webber
39916 C----------------------------------------------------------------------
39918 C-----------------------------------------------------------------------
39919 C SETS INPUT PARAMETERS
39920 C----------------------------------------------------------------------
39921 INCLUDE 'herwig65.inc'
39922 DOUBLE PRECISION FAC,ANGLE
39926 DATA TITLE/'HERWIG 6.510 31st Oct. 2005'/
39928 10 FORMAT(//10X,A28//,
39929 & 10X,'Please reference: G. Marchesini, B.R. Webber,',/,
39930 & 10X,'G.Abbiendi, I.G.Knowles, M.H.Seymour & L.Stanco',/,
39931 & 10X,'Computer Physics Communications 67 (1992) 465',/,
39933 & 10X,'G.Corcella, I.G.Knowles, G.Marchesini, S.Moretti,'
39934 & ,/, 10X,'K.Odagiri, P.Richardson, M.H.Seymour & B.R.Webber,'
39935 & ,/, 10X,'JHEP 0101 (2001) 010')
39938 C IPRINT=0 NO PRINTOUT
39939 C 1 PRINT SELECTED INPUT PARAMETERS
39940 C 2 1 + TABLE OF PARTICLE CODES AND PROPERTIES
39941 C 3 2 + TABLES OF SUDAKOV FORM FACTORS
39943 C Format for track numbers in event listing
39944 C PRNDEC=.TRUE. use decimal
39945 C .FALSE. use hexadecimal
39946 PRNDEC=(NMXHEP.LE.9999)
39947 C Number of significant figures to print out in event listing
39948 C NPRFMT (< 2) compact 80 character stout and A4-long tex output,
39949 C (= 2) 2 decimal places in stout, (> 2) - 5 decimal places in stout
39951 C Print out vertex information
39953 C Print out particle properties/event record to stout, tex or web
39957 C---MAX NO OF EVENTS TO PRINT
39959 C---UNIT FOR READING SUDAKOV FORM FACTORS (IF ZERO THEN COMPUTE THEM)
39961 C---UNIT FOR WRITING SUDAKOV FORM FACTORS (IF ZERO THEN NOT WRITTEN)
39963 C---UNIT FOR WRITING EVENT DATA IN HWANAL (IF ZERO THEN NOT WRITTEN)
39965 C---SEEDS FOR RANDOM NUMBER GENERATOR (CALLED HWRGEN)
39968 C---ALLOW NEGATIVE WEIGHTS?
39970 C---AZIMUTHAL CORRELATIONS?
39971 C THESE INCLUDE SOFT GLUON (INSIDE CONE)
39973 C AND NEAREST-NEIGHBOUR SPIN CORRELATIONS
39975 C---MATRIX-ELEMENT MATCHING FOR E+E-, DIS, DRELL-YAN AND TOP DECAY
39980 C---GLUON ENERGY CUT FOR TOP DECAY CASE
39982 C Electromagnetic fine structure constant: Thomson limit
39984 C---QCD LAMBDA: CORRESPONDS TO 5-FLAVOUR LAMBDA-MS-BAR AT LARGE X ONLY
39986 C---NUMBER OF COLOURS
39988 C---NUMBER OF FLAVOURS
39990 C---QUARK, GLUON AND PHOTON VIRTUAL MASS CUTOFFS IN
39991 C PARTON SHOWER (ADDED TO MASSES GIVEN BELOW)
39996 C---D,U,S,C,B,T QUARK AND GLUON MASSES (IN THAT ORDER)
40004 C---W+/- AND Z0 MASSES
40008 C---HIGGS BOSON MASS
40010 C---WIDTHS OF W, Z, HIGGS
40013 C SM Higgs width is actually recomputed by HWDHIG
40014 C but this value corresponds to RMASS(201)=115.
40016 C Include additional neutral, massive vector boson (Z')
40018 C Z' mass and width
40021 C Graviton properties
40022 C Graviton mass and width (default mass 1 TeV and calculated width)
40025 C Graviton coupling (this has dimensions of mass)
40027 C Lepton (EPOLN) and anti-lepton (PPOLN) beam polarisations used in:
40028 C e+e- --> ffbar/qqbar g; and l/lbar N DIS.
40029 C Cpts. 1,2 Transverse polarisation; cpt. 3 longitudinal polarisation.
40030 C Note require POLN(1)**2+POLN(2)**2+POLN(3)**2 < 1.
40034 C-----------------------------------------------------------------------
40035 C Specify couplings of weak vector bosons to fermions:
40037 C electric current: QFCH(I)*e*G_mu (electric charge, e>0)
40038 C weak neutral current: [VFCH(I,J).1+AFCH(I,J).G_5]*e*G_mu
40039 C weak charged current: SQRT(VCKM(K,L)/2.)*g*(1+G_5)*G_mu
40041 C I= 1- 6: d,u,s,c,b,t (quarks)
40042 C =11-16: e,nu_e,mu,nu_mu,tau,nu_tau (leptons) (`I=IDHW-110')
40043 C J=1 for minimal SM:
40044 C =2 for Z' couplings (ZPRIME=.TRUE.)
40045 C K=1,2,3 for u,c,t; L=1,2,3 for d,s,b
40046 C-----------------------------------------------------------------------
40047 C Minimal standard model neutral vector boson couplings
40048 C VFCH(I,1)=(T3/2-Q*S^2_W)/(C_W*S_W); AFCH(I,1)=T3/(2*C_W*S_W)
40049 C sin**2 Weinberg angle (PDG '94)
40051 FAC=1./SQRT(SWEIN*(1.-SWEIN))
40056 VFCH(J,1)=(-0.25+SWEIN/3.)*FAC
40057 AFCH(J,1)= -0.25*FAC
40061 VFCH(J,1)=(+0.25-2.*SWEIN/3.)*FAC
40062 AFCH(J,1)= +0.25*FAC
40066 VFCH(J,1)=(-0.25+SWEIN)*FAC
40067 AFCH(J,1)= -0.25*FAC
40071 VFCH(J,1)=+0.25*FAC
40072 AFCH(J,1)=+0.25*FAC
40074 C Additional Z' couplings (To be set by the user)
40075 IF (.NOT.ZPRIME) THEN
40083 C--calculate left and right couplings of bosons for axial and vector ones
40085 IF(J.LE.6.OR.J.GE.11) THEN
40086 LFCH(J)=VFCH(J,1)+AFCH(J,1)
40087 RFCH(J)=VFCH(J,1)-AFCH(J,1)
40090 C Cabibbo-Kobayashi-Maskawa matrix elements squared (PDG '92):
40091 C sin**2 of Cabibbo angle
40099 VCKM(2,2)=1.-SCABI-.002
40105 C---GAUGE BOSON DECAYS
40114 C THE iTH GAUGE BOSON DECAY PER EVENT IS CONTROLLED BY MODBOS AS FOLLOWS
40115 C MODBOS(i) W DECAY Z DECAY
40121 C 5 enu & munu ee & mumu
40125 C BOSON PAIRS (eg FROM HIGGS DECAY)ARE CHOSEN FROM MODBOS(i),MODBOS(i+1)
40127 C---CONTROL OF LARGE EMH BEHAVIOUR (SEE HWHIGM FOR DETAILS)
40130 C Specify approximation used in HWHIGA
40132 C---MASSES OF HYPOTHETICAL NEW QUARKS GO
40133 C INTO 209-214 (ANTIQUARKS IN 215-220)
40134 C ID = 209,210 ARE B',T' WITH DECAYS T'->B'->C
40135 C 211,212 ARE B',T' WITH DECAYS T'->B'->T
40136 C 215-218 ARE THEIR ANTIQUARKS
40139 C---MAXIMUM CLUSTER MASS PARAMETERS
40140 C N.B. LIMIT FOR Q1-Q2BAR CLUSTER MASS
40141 C IS (CLMAX**CLPOW + (QM1+QM2)**CLPOW)**(1/CLPOW)
40144 C For PSPLT(I), CLDIR(I) & CLSMR(I): I=1 light u,d,s,c cluster
40145 C =2 heavy b cluster
40146 C---MASS SPECTRUM OF PRODUCTS IN CLUSTER
40147 C SPLITTING ABOVE CLMAX - FLAT IN M**PSPLT(*)
40150 C---KINEMATIC TREATMENT OF CLUSTER DECAY
40151 C 0=ISOTROPIC, 1=REMEMBER DIRECTION OF PERTURBATIVELY PRODUCED QUARKS
40154 C IF CLDIR(*)=1, DO GAUSSIAN SMEARING OF DIRECTION:
40155 C ACTUALLY EXPONENTIAL IN 1-COS(THETA) WITH MEAN CLSMR(*)
40158 C---OPTION FOR TREATMENT OF REMNANT CLUSTERS:
40159 C 0=BOTH CHILDREN ARE SOFT, (EQUIVALENT TO PREVIOUS VERSIONS)
40160 C 1=REMNANT CHILD IS SOFT, BUT PERTURBATIVE CHILD IS NORMAL
40162 C---TREATMENT OF LOWER LIMIT FOR SPACELIKE EVOLUTION
40163 C 0=EVOLUTION STOPS AT QSPAC, BUT STRUCT FUNS CAN GET CALLED AT
40164 C SMALLER SCALES IN FORCED EMISSION (EQUIVALENT TO V5.7 AND EARLIER)
40165 C 1=EVOLUTION STOPS AT QSPAC, STRUCTURE FUNCTIONS FREEZE AT QSPAC
40166 C 2=EVOLUTION CONTINUES TO INFRARED CUT, BUT S.F.S FREEZE AT QSPAC
40168 C---LOWER LIMIT FOR SPACELIKE EVOLUTION
40170 C---SWITCH OFF SPACE-LIKE SHOWERS
40172 C---INTRINSIC PT OF SPACELIKE PARTONS (RMS)
40174 C---MASS PARAMETER IN REMNANT FRAGMENTATION
40176 C---PARAMETERS CONTROLLING VERY SMALL-X BEHAVIOUR OF PDFS
40179 C---STRUCTURE FUNCTION SET:
40180 C SET MODPDF(I)=MODE AND AUTPDF='AUTHOR GROUP' TO USE CERN LIBRARY
40181 C PDFLIB PACKAGE FOR STRUCTURE FUNCTIONS IN BEAM I
40186 C OR SET MODPDF(I)=-1 TO USE BUILT-IN STRUCTURE FUNCTION SET:
40187 C 1,2 FOR DUKE+OWENS SETS 1,2 (SOFT/HARD GLUE)
40188 C 3,4 FOR EICHTEN+AL SETS 1,2 (NUCLEONS ONLY)
40189 C 5 FOR OWENS SET 1.1 (SOFT GLUE ONLY)
40190 C 6 FOR MRST98LO central alpha_s/gluon
40191 C 7 FOR MRST98LO higher gluon
40192 C 8 FOR MRST98LO average of central and higher gluon (default)
40194 C PARAMETER FOR B CLUSTER DECAY TO 1 HADRON. IF MCL IS CLUSTER MASS
40195 C AND MTH IS THRESHOLD FOR 2-HADRON DECAY, THEN PROBABILITY IS
40196 C 1 IF MCL<MTH, 0 IF MCL>(1+B1LIM)*MTH, WITH LINEAR INTERPOLATION,
40198 C---B DECAY PACKAGE ('HERW'=>HERWIG, 'EURO'=>EURODEC, 'CLEO'=>CLEO)
40200 C---TAU DECAY PACKAGE ('HERWIG'=>HERWIG, 'TAUOLA'=> TAUOLA)
40202 C--default options for TAUOLA (if used)
40204 C JAK=1 ELECTRON MODE
40212 C--tau decay modes (1 is tau+ and 2 is tau-)
40215 C--radiative corrections in tau decay (1 on/ 0 off)
40217 C--use PHOTOS in tau decays (1 PHOTOS/ 0 no PHOTOS)
40219 C--use PHOTOS in ttbar production and decay
40221 C---HARD SUBPROCESS SCALE TO BE USED IN 4-JET MATRIX ELEMENT OPTION
40222 C IF (FIX4JT) THEN SCALE=C.M. ENERGY
40223 C ELSE SCALE=2.*MIN(PI.PJ)
40225 C---HARD SUBPROCESS SCALE TO BE USED IN BOSON-GLUON FUSION
40226 C IF (BGSHAT) THEN SCALE=SHAT
40227 C ELSE SCALE=2.*SHAT*THAT*UHAT/(SHAT**2+THAT**2+UHAT**2)
40229 C---RECONSTRUCT DIS EVENTS IN BREIT FRAME
40231 C---TREAT ALL EVENTS IN THEIR CMF (ELSE USE LAB FRAME)
40233 C---TREAT W/Z DECAY IN ITS REST FRAME
40235 C---PROBABILITY OF UNDERLYING SOFT EVENT:
40237 C---SOFT UNDERLYING OR MIN BIAS EVENT PARAMETERS
40238 C DEFAULT VALUES ARE FROM UA5 COLLAB, NPB291(1987)445
40239 C NCH_PPBAR(SQRT(S)) = PMBN1*S**PMBN2+PMBN3
40243 C 1/K (IN NEG BINOMIAL) = PMBK1*LN(S)+PMBK2
40246 C SOFT CLUSTER MASS SPECTRUM (M-M1-M2-PMBM1)*EXP(-PMBM2*M)
40249 C SOFT CLUSTER PT SPECTRUM PT*EXP(-B*SQRT(PT**2+M**2))
40250 C B=PMBP1 FOR D,U, PMBP2 FOR S,C, PMBP3 FOR DIQUARKS
40254 C---MULTIPLICITY ENHANCEMENT FOR UNDERLYING SOFT EVENT:
40255 C NCH = NCH_PPBAR(ENSOF*SQRT(S))
40257 C PARAMETERS FOR MUELLER TANG FORMULA: IPROC=2400
40258 C---THE VALUE TO USE FOR FIXED ALPHA_S IN DENOMINATOR
40260 C---OMEGA0=12*LOG(2)*ALPHA_S/PI, BUT NOT NECESSARILY THE SAME ALPHA_S
40262 C---MIN AND MAX JET RAPIDITIES IN QCD 2->2,
40263 C HEAVY FLAVOUR, SUSY AND DIRECT PHOTON PROCESSES
40266 C---MIN AND MAX PARTON TRANSVERSE MOMENTUM
40267 C IN ELEMENTARY 2 -> 2 SUBPROCESSES
40270 C---UPPER LIMIT ON HARD PROCESS SCALE
40272 C---MAX PARTON THRUST IN 2->3 HARD PROCESSES
40274 C Set parameters for 2->4 hard process
40275 C Choose inter-jet metric (else JADE) and minimum y-cut
40278 C---TREATMENT OF COLOUR INTERFERENCE IN E+E- -> 4 JETS:
40280 C IOP4JT(1)=0 neglect, =1 extreme 2341; =2 extreme 3421
40281 C qqbar-qqbar (identical quark flavour) case:
40282 C IOP4JT(2)=0 neglect, =1 extreme 4123; =2 extreme 2143
40285 C---MIN AND MAX DILEPTON INVARIANT MASS IN DRELL-YAN PROCESS
40288 C---MIN AND MAX ABS(Q**2) IN DEEP INELASTIC LEPTON SCATTERING
40291 C---MIN AND MAX ABS(Q**2) IN WEISZACKER-WILLIAMS APPROXIMATION
40294 C---MIN AND MAX ENERGY FRACTION IN WEISZACKER-WILLIAMS APPROXIMATION
40297 C---MINIMUM HADRONIC MASS FOR PHOTON-INDUCED PROCESSES (INCLUDING DIS)
40299 C---IF PHOMAS IS NON-ZERO, PARTON DISTRIBUTION FUNCTIONS FOR OFF-SHELL
40300 C PHOTONS IS DAMPED, WITH MASS PARAMETER = PHOMAS
40302 C---MIN AND MAX FLAVOURS GENERATED BY IPROC=9100,9110,9130
40305 C---MAX Z IN J/PSI PHOTO- AND ELECTRO- PRODUCTION
40307 C---MIN AND MAX BJORKEN-Y
40310 C---MIN jet-jet mass in Drell-Yan+2 jets
40312 C---MAX COS(THETA) FOR W'S IN E+E- -> W+W-
40314 C Minimum virtuality^2 of partons to use in calculating distances
40316 C Exageration factor for lifetimes of weakly decaying heavy particles
40318 C Include colour rearrangement in cluster formation
40320 C Probability for colour rearrangement to occur
40322 C Minimum lifetime for particle to be considered stable
40324 C Incude neutral B-meson mixing
40326 C Set B_s and B_d mixing parameters: X=Delta m/Gamma
40329 C Y=Delta Gamma/2*Gamma
40332 C Include a cut on particle decay lengths
40334 C Set option for decay length cut (see HWDXLM)
40336 C Radius for cylindrical option (mm) (IOPDKL=1)
40338 C Length for cylindrical option(IOPDKL=1)
40340 C Radius for spherical option(IOPDKL=2)
40342 C Smear the primary interaction vertex: see HWRPIP for details
40344 C Widths of Gaussian smearing in x,y,z (mm)
40349 C Veto cluster decays into particle type I
40351 C Veto unstable particle decays into modes involving particle type I
40352 60 VTORDK(I)=.FALSE.
40353 C Veto f_0(980) and a_0(980) production in cluster decays
40358 C---MINIMUM AND MAXIMUM S-HAT/S RANGE FOR PHOTON ISR
40361 C---COLISR IS .TRUE. TO MAKE ISR PHOTONS COLLINEAR WITH BEAMS
40363 C A Priori weights for mesons w.r.t. pionic n=1, 0-(+) states:
40364 C old VECWT=REPWT(0,1,0) & TENWT=REPWT(0,2,0)
40369 C and singlet (Lambda-like) and decuplet barons
40372 C---A PRIORI WEIGHTS FOR D,U,S,C,B,T QUARKS AND DIQUARKS (IN THAT ORDER)
40380 C Octet-Singlet isoscalar mixing angles in degrees
40381 C (use ANGLE for ideal mixing, recommended for F0MIX & OMHMIX)
40382 ANGLE=ATAN(ONE/SQRT(TWO))*180./ACOS(-ONE)
40387 C h_1(1380) - h_1(1170)
40389 C MISSING - f_0(1370)
40391 C f_1(1420) - f_1(1285)
40395 C MISSING - omega(1600)
40397 C eta_2(1645) - eta_2(1870)
40401 C---PARAMETERS FOR NON-PERTURBATIVE SPLITTING OF GLUONS INTO
40402 C DIQUARK-ANTIDIQUARK PAIRS:
40403 C SCALE AT WHICH GLUONS CAN BE SPLIT INTO DIQUARKS
40404 C (0.0 FOR NO SPLITTING)
40406 C PROBABILITY (PER UNIT LOG SCALE) OF DIQUARK SPLITTING
40408 C---PARAMETERS FOR IMPORTANCE SAMPLING
40409 C ASSUME QCD 2->2 DSIG/DET FALLS LIKE ET**(-PTPOW)
40410 C WHERE ET=SQRT(MQ**2+PT**2) FOR HEAVY FLAVOURS
40412 C DEFAULT PTPOW=2 FOR SUSY PROCESSES
40413 IF (MOD(IPROC/100,100).EQ.30) PTPOW=2.
40414 C ASSUME DRELL-YAN DSIG/DEM FALLS LIKE EM**(-EMPOW)
40416 C ASSUME DEEP INELASTIC DSIG/DQ**2 FALLS LIKE (Q**2)**(-Q2POW)
40418 C---GENERATE UNWEIGHTED EVENTS (EVWGT=AVWGT)?
40420 C---DEFAULT MEAN EVENT WEIGHT
40422 C---ASSUMED MAXIMUM WEIGHT (ZERO TO RECOMPUTE)
40424 C---MINIMUM ACCEPTABLE EVENT GENERATION EFFICIENCY
40426 C---MAX NO OF (CODE.GE.100) ERRORS
40427 MAXER=MAX(10,MAXEV/100)
40428 C---TIME (SEC) NEEDED TO TERMINATE GRACEFULLY
40430 C---CURRENT NO OF EVENTS
40432 C---CURRENT NO OF ENTRIES IN /HEPEVT/
40434 C---ISTAT IS STATUS OF EVENT (I.E. STAGE IN PROCESSING)
40436 C---IERROR IS ERROR CODE
40438 C---MORE TECHNICAL PARAMETERS - SHOULDN'T NEED ADJUSTMENT
40441 C Speed of light (mm/s)
40443 C Cross-section conversion factor (hbar.c/e)**2
40445 C---NUMBER OF SHOTS FOR INITIAL MAX WEIGHT SEARCH
40447 C---RANDOM NO. SEEDS FOR INITIAL MAX WEIGHT SEARCH
40450 C--Number of shots and steps for the optimisation procedure
40453 C---NUMBER OF ENTRIES IN LOOKUP TABLES OF SUDAKOV FORM FACTORS
40455 C---MAXIMUM BIN SIZE IN Z FOR SPACELIKE BRANCHING
40457 C---MAXIMUM NUMBER OF Z BINS FOR SPACELIKE BRANCHING
40459 C---MAXIMUM NUMBER OF BRANCH REJECTIONS (TO AVOID INFINITE LOOPS)
40461 C---MAXIMUM NUMBER OF TRIES TO GENERATE CLUSTER DECAY
40463 C---MAXIMUM NUMBER OF TRIES TO GENERATE MASS REQUESTED
40465 C---MAXIMUM NUMBER OF TRIES TO GENERATE SOFT SUBPROCESS
40467 C---MAXIMUM NUMBER OF TRIES TO GENERATE SPIN DECAYS
40469 C---MAXIMUM NUMBER OF TRIES TO GENERATE FOUR/FIVE BODY DECAYS
40471 C---PRECISION FOR GAUSSIAN INTEGRATION
40473 C---ORDER OF INTERPOLATION IN SUDAKOV TABLES
40475 C---ORDER TO USE FOR ALPHAS IN SUDAKOV TABLES
40477 C---DEFAULT UNIT FOR THE SUSY DATA FILE
40479 C---CONSERVATION OF RPARITY
40481 C---CHECK WHETHER SUSY DATA INPUTTED
40483 C---SPIN CORRELATIONS IN TOP/TAU/SUSY DECAYS
40485 C---THREE BODY SUSY MATRIX ELEMENTS
40487 C---FOUR BODY SUSY MATRIX ELEMENTS
40489 C---OPTION FOR DIFFERENT COLOUR FLOWS IN SPIN CORRELATION
40490 C---(1 is first option in DAMTP-2001-83 only for SM/MSSM)
40491 C---(2 is second option in DAMTP-2001-83 needed for RPV)
40493 C---number of weights for maximum search for 3/4 body MEs
40495 C--unit to read three/four body decays from (if 0 computed)
40497 C--unit to write three/four body decays to (if 0 not written)
40499 C--WHETHER OR NOT TO OPTIMIZE THE WEIGHTS IN MULTICHANNEL PROCESSES
40501 C--initializes the multichannel integrals
40504 C---CIRCE IS CONTROLLED BY THESE NEW VARIABLES:
40505 C---CIRCOP = CIRCE OPTION: 0=NO CIRCE, STANDARD HERWIG
40506 C 1=NO CIRCE, HERWIG WITH COLLINEAR KINEMATICS
40507 C 2=BEAMSTRAHLUNG FROM CIRCE
40508 C 3=BEAMSTRAHLUNG FROM CIRCE PLUS BREMSTRAHLUNG
40509 C THEREFORE 0 SHOULD BE REGARDED AS OFF AND 3 AS ON. THE OTHERS ARE
40510 C MAINLY THERE FOR CROSS-CHECKING PURPOSES
40512 C---CIRCAC, CIRCVR, CIRCRV, CIRCCH = CIRCE INPUTS ACC, VER, REV AND CHAT
40513 C EG CIRCAC=1=SBAND, CIRCAC=2=TESLA, CIRCAC=3=XBAND
40518 C---END OF CIRCE VARIABLES
40519 C--options for Les Houches Accord
40520 C--allow self connected gluons (.TRUE.) or forbid (.FALSE.)
40522 C--generate the soft event (.TRUE.) or don't (.FALSE.)
40524 C--conserve longitudinal momentum (.true.) or rapidity of hard process
40528 *CMZ :- -15/07/02 16.42.23 by Peter Richardson
40529 *-- Author : Peter Richardson
40530 C----------------------------------------------------------------------
40532 C----------------------------------------------------------------------
40533 C Use the GUPI (Generic User Process Interface) run common block
40534 C to initialise HERWIG -- Initialization for Les Houches interface
40535 C----------------------------------------------------------------------
40536 INCLUDE 'herwig65.inc'
40538 PARAMETER(MAXPUP=100)
40539 INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP
40540 DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP
40541 COMMON /HEPRUP/ IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2),
40542 & IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),
40543 & XMAXUP(MAXPUP),LPRUP(MAXPUP)
40544 CHARACTER *8 DUMMY,PDFNUC(9),PDFPI(9),PDFPHT(9)
40546 SAVE PDFNUC,PDFPI ,PDFPHT
40547 DATA PDFNUC/ 'DO','DFLM','MRS','CTEQ','GRV','ABFOW','BM',
40549 DATA PDFPI / 'OW-P',' ','SMRS-P',' ','GRV-P',
40550 & 'ABFKW-P',' ',' ',' '/
40551 DATA PDFPHT /'DO-G','DG-G','LAC-G','GS-G','GRV-G','ACG-G',
40552 & ' ','WHIT-G','SaSph'/
40553 C--call the user routine to do the initialisation
40555 C$$$$$$ I modified the previous sentence UPINIT for UPINIT_GUP (otherwise it can't call it, why??? I have no idea!!)
40556 C--setup the beam particles and momentum
40557 CALL HWUIDT(1,IDBMUP(1),IDB(1),DUMMY)
40559 CALL HWUIDT(1,IDBMUP(2),IDB(2),DUMMY)
40561 PBEAM1 = SQRT(EBMUP(1)**2-RMASS(IDB(1))**2)
40562 PBEAM2 = SQRT(EBMUP(2)**2-RMASS(IDB(2))**2)
40563 C--set up for PDFLIB if need
40565 IF(PDFGUP(I).NE.-1) THEN
40566 IF(PDFGUP(I).LT.1.OR.PDFGUP(I).GT.9) CALL HWWARN('HWIGUP',500)
40567 MODPDF(I) = PDFSUP(I)
40568 C--proton/neutron beams
40569 IF(ABS(IDBMUP(I)).EQ.2212.OR.ABS(IDBMUP(I)).EQ.2112) THEN
40570 AUTPDF(I) = PDFNUC(PDFGUP(I))
40572 ELSEIF(ABS(IDBMUP(I)).EQ.22) THEN
40573 AUTPDF(I) = PDFPHT(PDFGUP(I))
40575 ELSEIF(ABS(IDBMUP(I)).EQ.211) THEN
40576 AUTPDF(I) = PDFPI(PDFGUP(I))
40577 C--unknown beam type
40579 CALL HWWARN('HWIGUP',500)
40583 C--decide what to do about the weights
40584 IF(ABS(IDWTUP).EQ.1) THEN
40589 C--sum up the magnitudes of the maximum weight
40592 LHXMAX(I) = XMAXUP(I)*1.0D-3
40593 LHMXSM = LHMXSM+ABS(LHXMAX(I))
40596 ELSEIF(ABS(IDWTUP).EQ.2) THEN
40601 C--sum the cross sections and obtain the total
40604 LHXSCT(I) = XSECUP(I)*1.0D-3
40605 LHXMAX(I) = XMAXUP(I)*1.0D-3
40606 LHMXSM = LHMXSM+ABS(LHXSCT(I))
40609 ELSEIF(ABS(IDWTUP).EQ.3) THEN
40614 ELSEIF(ABS(IDWTUP).EQ.4) THEN
40619 IF(IDWTUP.LT.0) NEGWTS = .TRUE.
40629 *CMZ :- -12/10/01 17.14.22 by Peter Richardson
40630 *-- Author : Peter Richardson
40631 C-----------------------------------------------------------------------
40633 C-----------------------------------------------------------------------
40634 C Subroutine to merge Higgs WW/ZZ decay modes for four body ME
40635 C-----------------------------------------------------------------------
40636 INCLUDE 'herwig65.inc'
40637 INTEGER IH,I,NMODE,J,K
40639 DOUBLE PRECISION BR
40641 C--first identify the WW modes
40646 IF(IDK(I).EQ.IH.AND.((IDKPRD(3,I).NE.0.AND.IDKPRD(4,I).EQ.0
40647 & .AND.(IDKPRD(1,I).EQ.198.OR.IDKPRD(1,I).EQ.199).AND.
40648 & ((IDKPRD(2,I).LE.12 .AND.IDKPRD(3,I).LE.12).OR.
40649 & (IDKPRD(2,I).GE.121.AND.IDKPRD(3,I).GE.121.AND.
40650 & IDKPRD(2,I).LE.132.AND.IDKPRD(3,I).LE.132)))
40651 & .OR.((IDKPRD(4,I).NE.0.AND.IDKPRD(5,I).EQ.0.AND.
40652 & (((IDKPRD(1,I).LE.12 .AND.IDKPRD(2,I).LE.12).OR.
40653 & (IDKPRD(1,I).GE.121.AND.IDKPRD(2,I).GE.121.AND.
40654 & IDKPRD(1,I).LE.132.AND.IDKPRD(2,I).LE.132))
40655 & .AND.ICHRG(IDKPRD(1,I))+ICHRG(IDKPRD(2,I)).NE.0)
40657 & (((IDKPRD(3,I).LE.12 .AND.IDKPRD(4,I).LE.12).OR.
40658 & (IDKPRD(3,I).GE.121.AND.IDKPRD(4,I).GE.121.AND.
40659 & IDKPRD(3,I).LE.132.AND.IDKPRD(4,I).LE.132))
40660 & .AND.ICHRG(IDKPRD(3,I))+ICHRG(IDKPRD(4,I)).NE.0))))) THEN
40666 C--add the new mode to the event record
40667 IF(NMODE.GT.0) THEN
40673 IDKPRD(1,NDKYS) = 198
40674 IDKPRD(2,NDKYS) = 199
40676 IDKPRD(I,NDKYS) = 0
40680 C--now do the ZZ modes
40685 IF(IDK(I).EQ.IH.AND.(IDKPRD(3,I).NE.0.AND.IDKPRD(4,I).EQ.0
40686 & .AND.IDKPRD(1,I).EQ.200.AND.
40687 & ((IDKPRD(2,I).LE.12 .AND.IDKPRD(3,I).LE.12).OR.
40688 & (IDKPRD(2,I).GE.121.AND.IDKPRD(3,I).GE.121.AND.
40689 & IDKPRD(2,I).LE.132.AND.IDKPRD(3,I).LE.132))
40690 & .OR.((IDKPRD(4,I).NE.0.AND.IDKPRD(5,I).EQ.0.AND.
40691 & (((IDKPRD(1,I).LE.12 .AND.IDKPRD(2,I).LE.12).OR.
40692 & (IDKPRD(1,I).GE.121.AND.IDKPRD(2,I).GE.121.AND.
40693 & IDKPRD(1,I).LE.132.AND.IDKPRD(2,I).LE.132))
40694 & .AND.ICHRG(IDKPRD(1,I))+ICHRG(IDKPRD(2,I)).EQ.0)
40696 & (((IDKPRD(3,I).LE.12 .AND.IDKPRD(4,I).LE.12).OR.
40697 & (IDKPRD(3,I).GE.121.AND.IDKPRD(4,I).GE.121.AND.
40698 & IDKPRD(3,I).LE.132.AND.IDKPRD(4,I).LE.132))
40699 & .AND.ICHRG(IDKPRD(3,I))+ICHRG(IDKPRD(4,I)).EQ.0))))) THEN
40705 C--add the new mode to the event record
40706 IF(NMODE.GT.0) THEN
40712 IDKPRD(1,NDKYS) = 200
40713 IDKPRD(2,NDKYS) = 200
40715 IDKPRD(I,NDKYS) = 0
40719 IF(.NOT.REMOVE) RETURN
40720 C--now remove the modes we have marked
40723 10 IF(NME(I+J).EQ.-100) I=I+1
40725 BRFRAC(J)=BRFRAC(I+J)
40728 IDKPRD(K,J)=IDKPRD(K,I+J)
40730 IF(NME(J).EQ.-100) GOTO 10
40732 C--reset the number of modes
40736 *CMZ :- -02/04/01 12.11.55 by Peter Richardson
40737 *-- Author : Peter Richardson
40738 C-----------------------------------------------------------------------
40739 SUBROUTINE HWIPHS(IOPT)
40740 C-----------------------------------------------------------------------
40741 C Subroutine to initialise the multichannel integration
40742 C IOPT = 1 sets the weights for the different channels to their
40744 C IOPT = 2 optimises the weights for the process selected
40745 C-----------------------------------------------------------------------
40746 INCLUDE 'herwig65.inc'
40747 INTEGER I,IPRC,ICH,IOPT,ISTP,IWGT,IFER,IANT,IGAU,IQRK
40748 LOGICAL CALLED,TEV,LHC
40749 DOUBLE PRECISION CHNPST(IMAXCH,IMAXOP),D(IMAXOP),CHWGTS(IMAXCH),
40750 & TOTAL,DEM,DMIN,CV,CA,BR,WA(IMAXCH),WITOT,WI(IMAXCH),
40751 & TEVGWT(10,5),LHCGWT(10,5),TEVQWT(6,6,2),LHCQWT(6,6,2)
40753 SAVE CALLED,DEM,TEVGWT,LHCGWT,TEVQWT,LHCQWT
40754 DATA CALLED/.FALSE./
40755 DATA TEVGWT/0.19684D0,0.00403D0,0.63772D0,0.01209D0,0.01321D0,
40756 & 0.00054D0,0.12984D0,0.00257D0,0.00296D0,0.00019D0,
40757 & 0.24146D0,0.00944D0,0.33949D0,0.01430D0,0.01918D0,
40758 & 0.00169D0,0.33919D0,0.01433D0,0.01931D0,0.00161D0,
40759 & 0.22270D0,0.00004D0,0.38873D0,0.00007D0,0.00009D0,
40760 & 0.00000D0,0.38820D0,0.00007D0,0.00009D0,0.00000D0,
40761 & 0.03228D0,0.00629D0,0.43227D0,0.01147D0,0.00010D0,
40762 & 0.03685D0,0.43270D0,0.01193D0,0.00010D0,0.03602D0,
40763 & 0.05828D0,0.00018D0,0.46870D0,0.00033D0,0.00047D0,
40764 & 0.00092D0,0.46940D0,0.00033D0,0.00047D0,0.00094D0/
40765 DATA LHCGWT/0.10679D0,0.00075D0,0.50915D0,0.00105D0,0.00126D0,
40766 & 0.00039D0,0.37853D0,0.00080D0,0.00092D0,0.00037D0,
40767 & 0.18163D0,0.00456D0,0.38555D0,0.00906D0,0.01160D0,
40768 & 0.00095D0,0.38498D0,0.00920D0,0.01163D0,0.00084D0,
40769 & 0.16647D0,0.00003D0,0.41691D0,0.00007D0,0.00009D0,
40770 & 0.00000D0,0.41627D0,0.00007D0,0.00009D0,0.00000D0,
40771 & 0.01957D0,0.00578D0,0.42971D0,0.01087D0,0.00015D0,
40772 & 0.02305D0,0.47944D0,0.00750D0,0.00016D0,0.02377D0,
40773 & 0.03659D0,0.00027D0,0.45268D0,0.00041D0,0.00063D0,
40774 & 0.00062D0,0.50700D0,0.00045D0,0.00069D0,0.00066D0/
40775 DATA TEVQWT/0.37855D0,0.15212D0,0.38016D0,0.00048D0,0.00047D0,
40776 & 0.08822D0,0.37292D0,0.19051D0,0.36770D0,0.00178D0,
40777 & 0.00180D0,0.06529D0,0.37724D0,0.12202D0,0.37579D0,
40778 & 0.00013D0,0.00013D0,0.12470D0,0.36728D0,0.12100D0,
40779 & 0.36521D0,0.00014D0,0.00014D0,0.14622D0,0.37548D0,
40780 & 0.12144D0,0.37410D0,0.00013D0,0.00013D0,0.12873D0,
40781 & 0.08694D0,0.32633D0,0.07192D0,0.00000D0,0.00000D0,
40782 & 0.51481D0,0.37831D0,0.15131D0,0.38081D0,0.00079D0,
40783 & 0.00077D0,0.08801D0,0.37494D0,0.19012D0,0.36496D0,
40784 & 0.00243D0,0.00246D0,0.06509D0,0.37726D0,0.12071D0,
40785 & 0.37641D0,0.00031D0,0.00032D0,0.12499D0,0.36248D0,
40786 & 0.12007D0,0.36203D0,0.00242D0,0.00243D0,0.15057D0,
40787 & 0.31054D0,0.13065D0,0.30760D0,0.04158D0,0.04178D0,
40788 & 0.16785D0,0.04116D0,0.00125D0,0.04116D0,0.32149D0,
40789 & 0.32030D0,0.27465D0/
40790 DATA LHCQWT/0.45556D0,0.06337D0,0.45712D0,0.00022D0,0.00022D0,
40791 & 0.02351D0,0.43712D0,0.07332D0,0.45023D0,0.00021D0,
40792 & 0.00021D0,0.03890D0,0.44611D0,0.08021D0,0.44572D0,
40793 & 0.00176D0,0.00170D0,0.02450D0,0.47268D0,0.03728D0,
40794 & 0.46843D0,0.00004D0,0.00004D0,0.02152D0,0.45662D0,
40795 & 0.06644D0,0.45586D0,0.00065D0,0.00063D0,0.01980D0,
40796 & 0.18486D0,0.27252D0,0.19067D0,0.00000D0,0.00000D0,
40797 & 0.35195D0,0.45530D0,0.06307D0,0.45770D0,0.00037D0,
40798 & 0.00038D0,0.02318D0,0.43653D0,0.07295D0,0.45173D0,
40799 & 0.00036D0,0.00036D0,0.03807D0,0.47312D0,0.04168D0,
40800 & 0.46993D0,0.00010D0,0.00010D0,0.01506D0,0.47047D0,
40801 & 0.03721D0,0.46860D0,0.00101D0,0.00100D0,0.02172D0,
40802 & 0.44379D0,0.05231D0,0.45440D0,0.01608D0,0.01624D0,
40803 & 0.01717D0,0.25443D0,0.04115D0,0.25503D0,0.18346D0,
40804 & 0.18255D0,0.08337D0/
40805 IF(IERROR.NE.0) RETURN
40806 C--initialize for tevatron or LHC based on energy
40807 TEV = NINT(PBEAM1/1000.0D0).EQ.1
40808 LHC = NINT(PBEAM1/1000.0D0).EQ.7
40809 C--first the initalisation
40811 IPRO = MOD(IPROC/100,100)
40812 IPRC=MOD(IPROC,100)
40817 C--gauge boson pair production
40818 IF(IPRO.EQ.28.AND.IPRC.LT.50) THEN
40819 IF(MOD(IPRC,5).NE.0.OR.IPRC.EQ.5.OR.IPRC.GT.25)
40820 & CALL HWWARN('HWIPHS',500)
40824 C--select the process
40826 IF(IGAU.EQ.0) IGAU = IGAU+1
40829 CHNPRB(I) = TEVGWT(I,IGAU)
40833 CHNPRB(I) = LHCGWT(I,IGAU)
40841 DEM = ONE/DBLE(IOPSH)
40842 C--Drell Yan + 2 jet production
40843 ELSEIF(IPRO.EQ.29) THEN
40849 ELSEIF(IPRC.GE.11.AND.IPRC.LE.16) THEN
40852 CALL HWWARN('HWIPHS',502)
40854 IQRK = MOD(IPRC,10)
40855 IF(IQRK.EQ.0.OR.IQRK.GT.6) CALL HWWARN('HWIPHS',503)
40858 CHNPRB(I) = TEVQWT(I,IQRK,IGAU)
40862 CHNPRB(I) = LHCQWT(I,IQRK,IGAU)
40866 CHNPRB(I) = 1.0D0/6.0D0
40870 DEM = ONE/DBLE(IOPSH)
40876 IF(.NOT.CALLED) RETURN
40879 IF(CHON(I)) TOTAL = TOTAL+CHNPRB(I)
40881 IF(TOTAL.EQ.ZERO) CALL HWWARN('HWIPHS',501)
40882 IF(TOTAL.NE.ONE) THEN
40884 IF(CHON(I)) CHNPRB(I) = CHNPRB(I)/TOTAL
40887 IF(.NOT.OPTM) RETURN
40889 C--optimise the weights
40891 C---SET UP INITIAL STATE
40896 PHEP(3,NHEP)=PBEAM1
40897 PHEP(4,NHEP)=EBEAM1
40898 PHEP(5,NHEP)=RMASS(IPART1)
40904 IDHEP(NHEP)=IDPDG(IPART1)
40909 PHEP(3,NHEP)=-PBEAM2
40910 PHEP(4,NHEP)=EBEAM2
40911 PHEP(5,NHEP)=RMASS(IPART2)
40917 IDHEP(NHEP)=IDPDG(IPART2)
40918 C---NEXT ENTRY IS OVERALL CM FRAME
40923 JMOHEP(1,NHEP)=NHEP-2
40924 JMOHEP(2,NHEP)=NHEP-1
40927 CALL HWVSUM(4,PHEP(1,NHEP-1),PHEP(1,NHEP-2),PHEP(1,NHEP))
40928 CALL HWUMAS(PHEP(1,NHEP))
40933 CHNPST(ICH,ISTP) = CHNPRB(ICH)
40934 IF(CHON(ICH)) WRITE(*,200) ICH,CHNPRB(ICH)
40936 C--compute the weights for the various channels
40938 IF(IPRO.EQ.28) THEN
40941 CALL HWDBZ2(200,IFER,IANT,CV,CA,BR,2,ZERO)
40942 ELSEIF(IPRO.EQ.29) THEN
40945 CALL HWDBOZ(200,IFER,IANT,CV,CA,BR,2)
40948 IF(CHON(ICH)) CHWGTS(ICH) = CHWGTS(ICH)+WI(ICH)
40954 WA(ICH) = CHWGTS(ICH)*DEM
40955 WITOT = WITOT+WA(ICH)*CHNPRB(ICH)
40958 C--now pick the next set of probablities for the different channels
40962 CHNPRB(ICH) = CHNPRB(ICH)*SQRT(WA(ICH))
40963 TOTAL = TOTAL+CHNPRB(ICH)
40967 CHNPRB(ICH)=CHNPRB(ICH)/TOTAL
40972 IF(D(ISTP).EQ.ZERO) THEN
40973 D(ISTP) = ABS(WITOT-WA(ICH))
40975 D(ISTP) = MAX(D(ISTP),ABS(WITOT-WA(ICH)))
40979 WRITE(*,300) D(ISTP)
40981 C--pick the best set of weights
40985 IF(D(I).LT.DMIN) THEN
40993 CHNPRB(I)=CHNPST(I,IWGT)
40994 WRITE(*,200) I,CHNPRB(I)
41000 50 FORMAT(/10X,'OPTIMIZING THE WEIGHTS FOR MULTICHANNEL INTEGRATION')
41001 100 FORMAT(/10X,'PERFORMING ITERATION',I2,/10X)
41002 200 FORMAT( 12X,'CHNPRB(',I2,') = ',F7.5)
41003 300 FORMAT(/10X,'DIFFERENCE IN W BETWEEN CHANNELS',E15.5)
41004 500 FORMAT(/10X,'SELECTED ITERATION',I2)
41007 *CMZ :- -27/07/99 16.38.25 by Peter Richardson
41008 *-- Author : Peter Richardson
41009 C-----------------------------------------------------------------------
41011 C-----------------------------------------------------------------------
41012 C Calculates the couplings for the SUSY decays for spin correlations
41013 C and 3/4 body matrix elements
41014 C-----------------------------------------------------------------------
41015 INCLUDE 'herwig65.inc'
41016 DOUBLE PRECISION HWUALF,PRE,MCHAR(2),QIJPP(4,4),SIJPP(4,4),
41017 & DIJ(2,2),QIJ(2,2),R(4,2),SIJ(2,2)
41018 INTEGER I,J,K,L,IH,IK,IL,IQ
41019 COMMON /HWSPNC/ SW,CW,TW,E,G,RT,ORT,MW,MZ,GS,AFN,AFG,AFC,OIJ,OIJP,
41020 & OIJPP,HNN,HCC,HNC,HFF,HWW,HZZ,ZAB,HHB
41021 DOUBLE PRECISION SW,CW,TW,E,G,RT,ORT,MW,MZ,GS,AFN(2,12,2,4),
41022 & AFG(2,6,2),AFC(2,12,2,2),OIJ(2,4,2),OIJP(2,2,2),OIJPP(2,4,4),
41023 & HNN(2,3,4,4),HCC(2,3,2,2),HNC(2,4,2),HFF(2,4,12),HWW(2),
41024 & HZZ(2),ZAB(12,2,2),HHB(2,3)
41027 DATA DIJ/1.0D0,0.0D0,0.0D0,1.0D0/
41028 IF(IERROR.NE.0) RETURN
41029 C--coupling constants
41031 CW = SQRT(ONE-SWEIN)
41033 E = SQRT(FOUR*PIFAC/128.0D0)
41039 IF(.NOT.SUSYIN) RETURN
41040 GS = SQRT(HWUALF(3,RMASS(449))*FOUR*PIFAC)
41041 C--couplings of the neutralinos to the squarks
41043 MCHAR(1) = ORT*G*ZMIXSS(L,3)/MW/COSB
41044 MCHAR(2) = ORT*G*ZMIXSS(L,4)/MW/SINB
41048 AFN(1,J,K,L) =-MCHAR(1)*RMASS(J)*QMIXSS(J,2,K)
41049 & -RT*E*QMIXSS(J,1,K)*SLFCH(J,L)
41050 2 AFN(2,J,K,L) =-ZSGNSS(L)*(MCHAR(1)*RMASS(J)*QMIXSS(J,1,K)
41051 & +RT*E*QMIXSS(J,2,K)*SRFCH(J,L))
41054 AFN(1,J,K,L) =-MCHAR(2)*RMASS(J)*QMIXSS(J,2,K)
41055 & -RT*E*QMIXSS(J,1,K)*SLFCH(J,L)
41056 1 AFN(2,J,K,L) =-ZSGNSS(L)*(MCHAR(2)*RMASS(J)*QMIXSS(J,1,K)
41057 & +RT*E*QMIXSS(J,2,K)*SRFCH(J,L))
41058 C--couplings of the neutralinos to the sleptons
41060 MCHAR(1) = ORT*G*ZMIXSS(L,3)/MW/COSB
41066 AFN(1,IK,K,L) =-(MCHAR(1)*RMASS(110+IL)*LMIXSS(J,2,K)
41067 & +RT*E*LMIXSS(J,1,K)*SLFCH(IL,L))
41068 4 AFN(2,IK,K,L) =-ZSGNSS(L)*(MCHAR(1)*RMASS(110+IL)*LMIXSS(J,1,K)
41069 & +RT*E*LMIXSS(J,2,K)*SRFCH(IL,L))
41074 AFN(1,IK,K,L) =-RT*E*LMIXSS(J,1,K)*SLFCH(IL,L)
41075 3 AFN(2,IK,K,L) = ZERO
41076 C--couplings of the gluinos to the squarks
41079 AFG(1,I,K) = -GS*RT*QMIXSS(I,1,K)
41080 5 AFG(2,I,K) = +GS*RT*QMIXSS(I,2,K)
41081 C--couplings of the charginos to the squarks
41083 MCHAR(1) =-WMXVSS(L,2)*ORT/MW/SINB
41084 MCHAR(2) =-WMXUSS(L,2)*ORT/MW/COSB
41088 AFC(1,J,K,L) = -G*( WMXUSS(L,1)*QMIXSS(J,1,K)
41089 & +MCHAR(2)*RMASS(J)*QMIXSS(J,2,K))
41090 7 AFC(2,J,K,L) = -G*WSGNSS(L)*MCHAR(1)*
41091 & RMASS(J+1)*QMIXSS(J,1,K)
41094 AFC(1,J,K,L) = -G*WSGNSS(L)*( WMXVSS(L,1)*QMIXSS(J,1,K)
41095 & +MCHAR(1)*RMASS(J)*QMIXSS(J,2,K))
41096 6 AFC(2,J,K,L) = -G*MCHAR(2)*RMASS(J-1)*QMIXSS(J,1,K)
41097 C--couplings of the charginos to the sleptons
41099 MCHAR(1) = -WMXUSS(L,2)*ORT/MW/COSB
41104 AFC(1,IL,K,L) = -G*(WMXUSS(L,1)*LMIXSS(J,1,K)
41105 & +RMASS(120+J)*MCHAR(1)*LMIXSS(J,2,K))
41106 9 AFC(2,IL,K,L) = ZERO
41110 AFC(1,IL,K,L) =-WSGNSS(L)*G*WMXVSS(L,1)
41111 8 AFC(2,IL,K,L) =-MCHAR(1)*G*RMASS(119+J)
41112 C--couplings of chargino-neutralino to the W
41115 OIJ(1,I,J) = G*( ORT*ZMXNSS(I,3)*WMXUSS(J,2)
41116 & +ZMXNSS(I,2)*WMXUSS(J,1))
41117 10 OIJ(2,I,J) = ZSGNSS(I)*WSGNSS(J)*G*(-ORT*ZMXNSS(I,4)*WMXVSS(J,2)
41118 & +ZMXNSS(I,2)*WMXVSS(J,1))
41119 C--couplings of chargino-chargino to the Z
41123 OIJP(1,I,J) = PRE*(-WMXUSS(I,1)*WMXUSS(J,1)
41124 & -HALF*WMXUSS(I,2)*WMXUSS(J,2)+DIJ(I,J)*SWEIN)
41125 11 OIJP(2,I,J) = WSGNSS(I)*WSGNSS(J)*PRE*(-WMXVSS(I,1)*WMXVSS(J,1)
41126 & -HALF*WMXVSS(I,2)*WMXVSS(J,2)+DIJ(I,J)*SWEIN)
41127 C--couplings of neutralino-neutralino to the Z
41131 OIJPP(1,I,J) = PRE*(ZMIXSS(I,3)*ZMIXSS(J,3)
41132 & -ZMIXSS(I,4)*ZMIXSS(J,4))
41133 12 OIJPP(2,I,J) = -ZSGNSS(I)*ZSGNSS(J)*OIJPP(1,I,J)
41134 C--couplings of the neutralino-neutralino to the Higgs
41137 QIJPP(I,J) = HALF*ZSGNSS(I)*
41138 & (ZMXNSS(I,3)*(ZMXNSS(J,2)-ZMXNSS(J,1)*TW)
41139 & +ZMXNSS(J,3)*(ZMXNSS(I,2)-ZMXNSS(I,1)*TW))
41140 13 SIJPP(I,J) = HALF*ZSGNSS(I)*
41141 & (ZMXNSS(I,4)*(ZMXNSS(J,2)-ZMXNSS(J,1)*TW)
41142 & +ZMXNSS(J,4)*(ZMXNSS(I,2)-ZMXNSS(I,1)*TW))
41145 HNN(1,1,I,J) = G*(QIJPP(I,J)*SINA+SIJPP(I,J)*COSA)
41146 HNN(2,1,I,J) = G*(QIJPP(J,I)*SINA+SIJPP(J,I)*COSA)
41147 HNN(1,2,I,J) = G*(SIJPP(I,J)*SINA-QIJPP(I,J)*COSA)
41148 HNN(2,2,I,J) = G*(SIJPP(J,I)*SINA-QIJPP(J,I)*COSA)
41149 HNN(1,3,I,J) = G*(QIJPP(I,J)*SINB-SIJPP(I,J)*COSB)
41150 14 HNN(2,3,I,J) =-G*(QIJPP(J,I)*SINB-SIJPP(J,I)*COSB)
41151 C--couplings of chargino-chargino to the Higgs
41154 QIJ(I,J) = ORT*WSGNSS(I)*WMXVSS(I,1)*WMXUSS(J,2)
41155 15 SIJ(I,J) = ORT*WSGNSS(I)*WMXVSS(I,2)*WMXUSS(J,1)
41158 HCC(1,1,I,J) = G*(QIJ(I,J)*SINA-SIJ(I,J)*COSA)
41159 HCC(2,1,I,J) = G*(QIJ(J,I)*SINA-SIJ(J,I)*COSA)
41160 HCC(1,2,I,J) =-G*(QIJ(I,J)*COSA+SIJ(I,J)*SINA)
41161 HCC(2,2,I,J) =-G*(QIJ(J,I)*COSA+SIJ(J,I)*SINA)
41162 HCC(1,3,I,J) = G*(QIJ(I,J)*SINB+SIJ(I,J)*COSB)
41163 16 HCC(2,3,I,J) =-G*(QIJ(J,I)*SINB+SIJ(J,I)*COSB)
41164 C--couplings of chargino-neutralino to the Higgs
41167 HNC(1,I,J) =-G*ZSGNSS(I)*SINB*(ZMXNSS(I,3)*WMXUSS(J,1)
41168 & -ORT*(ZMXNSS(I,2)+ZMXNSS(I,1)*TW)*WMXUSS(J,2))
41169 17 HNC(2,I,J) =-G*WSGNSS(J)*COSB*(ZMXNSS(I,4)*WMXVSS(J,1)
41170 & +ORT*(ZMXNSS(I,2)+ZMXNSS(I,1)*TW)*WMXVSS(J,2))
41171 C--fermion couplings to the Higgs
41172 R(1,1) = HALF*G*SINA/MW/COSB
41173 R(1,2) =-HALF*G*COSA/MW/SINB
41174 R(2,1) =-HALF*G*COSA/MW/COSB
41175 R(2,2) =-HALF*G*SINA/MW/SINB
41176 R(3,1) = HALF*G*TANB/MW
41177 R(3,2) = HALF*G*COTB/MW
41178 R(4,1) = G*ORT*TANB/MW
41179 R(4,2) = G*ORT*COTB/MW
41187 HFF(L,IK,J ) = R(IK,1)*RMASS(J)
41188 HFF(L,IK,K ) = R(IK,2)*RMASS(K)
41189 HFF(L,IK,IL) = R(IK,1)*RMASS(114+IL)
41190 19 HFF(L,IK,IQ) = ZERO
41191 HFF(2,3,J ) = -HFF(2,3, J)
41192 HFF(2,3,K ) = -HFF(2,3, K)
41193 HFF(2,3,IL) = -HFF(2,3,IL)
41194 HFF(1,4,I) = RMASS(J)*R(4,1)
41195 HFF(2,4,I) = RMASS(K)*R(4,2)
41196 HFF(1,4,I+3) = RMASS(114+IL)*R(4,1)
41197 18 HFF(2,4,I+3) = ZERO
41198 C--couplings of the Higgs to gauge boson pairs
41199 HWW(1) = G*MW*SINBMA
41200 HWW(2) = G*MW*COSBMA
41201 HZZ(1) = G*MZ*SINBMA/CW
41202 HZZ(2) = G*MZ*COSBMA/CW
41203 C--couplings of the Z to the sfermions
41211 ZAB(IQ,J,K) = G/CW*HALF*( QMIXSS(IQ,1,J)*QMIXSS(IQ,1,K)
41212 & -TWO*DIJ(J,K) *SWEIN/THREE)
41213 ZAB(IL,J,K) = G/CW*HALF*(-QMIXSS(IL,1,J)*QMIXSS(IL,1,K)
41214 & -FOUR*DIJ(J,K)*SWEIN/THREE)
41215 ZAB(IK,J,K) = G/CW*HALF*( LMIXSS(IQ,1,J)*LMIXSS(IQ,1,K)
41216 & -TWO*DIJ(J,K)*SWEIN)
41217 20 ZAB(IH,J,K) =-G/CW*HALF*DIJ(J,1)*DIJ(K,1)
41218 C--couplings of the Higgs Higgs to the gauge bosons
41219 HHB(1,1) = HALF*G*COSBMA
41220 HHB(1,2) = HALF*G*SINBMA
41222 HHB(2,1) =-HALF*G*COSBMA/CW
41223 HHB(2,2) = HALF*G*SINBMA/CW
41227 *CMZ :- -12/10/01 17.22.48 by Peter Richardson
41228 *-- Author : Peter Richardson
41229 C-----------------------------------------------------------------------
41231 C-----------------------------------------------------------------------
41232 C Initialise all the decay modes for three/four body MEs and spin
41234 C-----------------------------------------------------------------------
41235 INCLUDE 'herwig65.inc'
41236 INTEGER I,J,K,NDKYST
41237 C--set the number of two and three body modes to zero
41242 C--if not reading in decay info calculate it
41243 IF(LRDEC.EQ.0) THEN
41244 C--initialise the couplings for the various decay modes
41246 C--Top decays and SUSY three body decays (including SUSY gauge
41247 C--boson 2 body modes which are treated as three body)
41248 IF(THREEB) CALL HWISP3
41249 IF(IERROR.NE.0) RETURN
41250 C--then four body modes if needed
41251 IF(FOURB) CALL HWISP4
41252 IF(IERROR.NE.0) RETURN
41253 C--Two body modes if needed for spin correlations
41254 IF(SYSPIN) CALL HWISP2
41255 IF(IERROR.NE.0) RETURN
41256 C--otherwise read it in
41257 ELSEIF(LRDEC.GT.0) THEN
41259 IF (IPRINT.NE.0) WRITE (6,1) LRDEC
41260 1 FORMAT(/10X,'READING MATRIX ELEMENT TABLE ON UNIT',I4)
41261 OPEN(UNIT=LRDEC,FORM='UNFORMATTED',STATUS='UNKNOWN')
41263 READ(UNIT=LRDEC) NDKYST
41264 IF(NDKYS.NE.NDKYST) CALL HWWARN('HWISPN',501)
41265 READ(UNIT=LRDEC) SYSPIN,THREEB,FOURB
41266 C--read two body decays
41268 READ(UNIT=LRDEC) N2MODE
41270 2 READ(UNIT=LRDEC) (A2MODE(J,I),J=1,2),P2MODE(I),WT2MAX(I),
41271 & ID2PRT(I),I2DRTP(I)
41273 C--read three body decays
41274 IF(SYSPIN.OR.THREEB) THEN
41275 READ(UNIT=LRDEC) N3MODE
41277 READ(UNIT=LRDEC) P3MODE(I),WT3MAX(I),ID3PRT(I),NDI3BY(I),
41278 & ((SPN3CF(J,K,I),J=1,NCFMAX),K=1,NCFMAX),N3NCFL(I)
41280 3 READ(UNIT=LRDEC) (A3MODE(K,J,I),K=1,2),(B3MODE(K,J,I),K=1,2),
41281 & I3DRTP(J,I),I3MODE(J,I),I3DRCF(J,I)
41282 C--read two body gauge boson modes
41283 READ(UNIT=LRDEC) NBMODE
41285 4 READ(UNIT=LRDEC) (ABMODE(J,I),J=1,2),
41286 & ((BBMODE(J,K,I),J=1,2),K=1,12),(PBMODE(K,I),K=1,12),
41287 & (WTBMAX(K,I),K=1,12),IDBPRT(I),IBMODE(I),IBDRTP(I)
41289 C--read four body decays
41291 READ(UNIT=LRDEC) N4MODE
41293 5 READ(UNIT=LRDEC) ((A4MODE(J,K,I),J=1,2),K=1,12),
41294 & ((B4MODE(J,K,I),J=1,2),K=1,12),
41295 & ((P4MODE(J,K,I),J=1,12),K=1,12),
41296 & ((WT4MAX(J,K,I),J=1,12),K=1,12),ID4PRT(I),
41297 & (I4MODE(J,I),J=1,2)
41299 C--finally read in the matrix element codes
41300 READ(UNIT=LRDEC) NME
41302 CALL HWWARN('HWISPN',500)
41304 C--write the decay information if needed
41305 IF(LWDEC.GT.0) THEN
41307 IF (IPRINT.NE.0) WRITE (6,6) LWDEC
41308 6 FORMAT(/10X,'WRITING MATRIX ELEMENT TABLE ON UNIT',I4)
41309 OPEN(UNIT=LWDEC,FORM='UNFORMATTED',STATUS='UNKNOWN')
41311 WRITE(UNIT=LWDEC) NDKYS
41312 WRITE(UNIT=LWDEC) SYSPIN,THREEB,FOURB
41313 C--write two body decays
41315 WRITE(UNIT=LWDEC) N2MODE
41317 7 WRITE(UNIT=LWDEC) (A2MODE(J,I),J=1,2),P2MODE(I),WT2MAX(I),
41318 & ID2PRT(I),I2DRTP(I)
41320 C--write three body decays
41321 IF(SYSPIN.OR.THREEB) THEN
41322 WRITE(UNIT=LWDEC) N3MODE
41324 WRITE(UNIT=LWDEC) P3MODE(I),WT3MAX(I),ID3PRT(I),NDI3BY(I),
41325 & ((SPN3CF(J,K,I),J=1,NCFMAX),K=1,NCFMAX),N3NCFL(I)
41327 8 WRITE(UNIT=LWDEC) (A3MODE(K,J,I),K=1,2),(B3MODE(K,J,I),K=1,2),
41328 & I3DRTP(J,I),I3MODE(J,I),I3DRCF(J,I)
41329 C--write two body gauge boson modes
41330 WRITE(UNIT=LWDEC) NBMODE
41332 9 WRITE(UNIT=LWDEC) (ABMODE(J,I),J=1,2),
41333 & ((BBMODE(J,K,I),J=1,2),K=1,12),(PBMODE(K,I),K=1,12),
41334 & (WTBMAX(K,I),K=1,12),IDBPRT(I),IBMODE(I),IBDRTP(I)
41336 C--write four body decays
41338 WRITE(UNIT=LWDEC) N4MODE
41340 10 WRITE(UNIT=LWDEC) ((A4MODE(J,K,I),J=1,2),K=1,12),
41341 & ((B4MODE(J,K,I),J=1,2),K=1,12),
41342 & ((P4MODE(J,K,I),J=1,12),K=1,12),
41343 & ((WT4MAX(J,K,I),J=1,12),K=1,12),ID4PRT(I),
41344 & (I4MODE(J,I),J=1,2)
41346 C--finally write the matrix element codes
41347 WRITE(UNIT=LWDEC) NME
41351 *CMZ :- -30/09/02 14:05:28 by Peter Richardson
41352 *-- Author : Peter Richardson
41353 C-----------------------------------------------------------------------
41355 C-----------------------------------------------------------------------
41356 C Initialise the SUSY two body modes for spin correlations
41357 C-----------------------------------------------------------------------
41358 INCLUDE 'herwig65.inc'
41359 INTEGER I,J,IL,IH,L,L1,IM,O(2),II,JJ,III,JJJ,KKK
41360 COMMON /HWSPNC/ SW,CW,TW,E,G,RT,ORT,MW,MZ,GS,AFN,AFG,AFC,OIJ,OIJP,
41361 & OIJPP,HNN,HCC,HNC,HFF,HWW,HZZ,ZAB,HHB
41362 DOUBLE PRECISION SW,CW,TW,E,G,RT,ORT,MW,MZ,GS,AFN(2,12,2,4),
41363 & AFG(2,6,2),AFC(2,12,2,2),OIJ(2,4,2),OIJP(2,2,2),OIJPP(2,4,4),
41364 & HNN(2,3,4,4),HCC(2,3,2,2),HNC(2,4,2),HFF(2,4,12),HWW(2),
41365 & HZZ(2),ZAB(12,2,2),HHB(2,3),FPI
41368 DATA FPI/0.09298D0/
41369 IF(IERROR.NE.0.OR..NOT.SUSYIN) RETURN
41370 C--now the two body modes for spin corrections
41372 DO 1000 II=1,NMODES(JJ)
41378 IF(IDKPRD(2,I).EQ.0.OR.IDKPRD(3,I).NE.0.OR.
41379 & (NME(I).GT.10000.AND.NME(I).LT.50000)) GOTO 1000
41381 C--two body top to charged higgs decay
41382 IF(IDK(I).EQ.6.AND.IDKPRD(1,I).EQ.206.AND.
41383 & IDKPRD(2,I).EQ.5) THEN
41385 IF(N2MODE.GT.NMODE2) THEN
41386 CALL HWWARN('HWISP2',100)
41389 NME(I) = 30000+N2MODE
41392 P2MODE(N2MODE) = ONE
41394 201 A2MODE(J,N2MODE) = HFF(O(J),4,3)
41395 C--two body antitop to charged higgs
41396 ELSEIF(IDK(I).EQ.12.AND.IDKPRD(1,I).EQ.207.AND.
41397 & IDKPRD(2,I).EQ.11) THEN
41399 IF(N2MODE.GT.NMODE2) THEN
41400 CALL HWWARN('HWISP2',101)
41403 NME(I) = 30000+N2MODE
41405 I2DRTP(N2MODE) = 14
41406 P2MODE(N2MODE) = ONE
41408 202 A2MODE(J,N2MODE) = HFF( J ,4,3)
41409 C--two body modes of the gluino
41410 ELSEIF(L1.EQ.0) THEN
41411 L = IDKPRD(1,I)-449
41412 C--gluino to antisfermion fermion
41413 IF(IDPDG(IDKPRD(2,I)).GT.0.AND.L.GE.-48.AND.L.LE.-1) THEN
41415 IF(N2MODE.GT.NMODE2) THEN
41416 CALL HWWARN('HWISP2',102)
41419 NME(I) = 30000+N2MODE
41422 P2MODE(N2MODE) = HALF
41423 IM = MOD(INT((IDKPRD(1,I)-389)/12)+1,2)+1
41424 IL = 6*INT((IDKPRD(1,I)-401)/24)+MOD(IDKPRD(1,I)-401,6)+1
41426 1 A2MODE(J,N2MODE) = AFG(J,IL,IM)
41427 C--gluino to sfermion antifermion
41428 ELSEIF(IDPDG(IDKPRD(2,I)).LT.0.AND.L.GE.-48.AND.L.LE.-1) THEN
41430 IF(N2MODE.GT.NMODE2) THEN
41431 CALL HWWARN('HWISP2',103)
41434 NME(I) = 30000+N2MODE
41437 P2MODE(N2MODE) = HALF
41438 IM = MOD(INT((IDKPRD(1,I)-389)/12)+1,2)+1
41439 IL = 6*INT((IDKPRD(1,I)-401)/24)+MOD(IDKPRD(1,I)-401,6)+1
41441 2 A2MODE(J,N2MODE) = AFG(O(J),IL,IM)
41442 C--gluino to neutralino gluon
41443 ELSEIF(L.GE.1.AND.L.LE.4.AND.IDKPRD(2,I).EQ.13) THEN
41445 IF(N2MODE.GT.NMODE2) THEN
41446 CALL HWWARN('HWISP2',104)
41449 NME(I) = 30000+N2MODE
41452 P2MODE(N2MODE) = 8.0D0*PIFAC*RMASS(IDK(I))**3/
41453 & (RMASS(IDK(I))**2-RMASS(IDKPRD(1,I))**2)**3*
41454 & HBAR/RLTIM(IDK(I))*BRFRAC(I)
41455 A2MODE(1,N2MODE) = ZSGNSS(L)
41456 C--gluino to gravitino gluon
41457 ELSEIF(IDKPRD(1,I).EQ.458.AND.IDKPRD(2,I).EQ.13) THEN
41459 IF(N2MODE.GT.NMODE2) THEN
41460 CALL HWWARN('HWISP2',105)
41463 NME(I) = 30000+N2MODE
41466 P2MODE(N2MODE) = ONE/24.0D0
41468 C--two body modes of the neutralinos
41469 ELSEIF(L1.GE.1.AND.L1.LE.4) THEN
41470 L = IDKPRD(1,I)-449
41471 IH = IDKPRD(2,I)-202
41472 C--first the neutralino modes to neutralino Higgs
41473 IF(L.GE.1.AND.L.LE.4.AND.IH.GE.1.AND.IH.LE.3) THEN
41475 IF(N2MODE.GE.NMODE2) THEN
41476 CALL HWWARN('HWISP2',106)
41479 NME(I) = 30000+N2MODE
41482 P2MODE(N2MODE) = ONE
41484 3 A2MODE(J,N2MODE) = HNN(J,IH,L,L1)
41485 C--neutralino to positive chargino negative Higgs
41486 ELSEIF((L.EQ.5.OR.L.EQ.6).AND.IH.EQ.5) THEN
41489 IF(N2MODE.GE.NMODE2) THEN
41490 CALL HWWARN('HWISP2',107)
41493 NME(I) = 30000+N2MODE
41496 P2MODE(N2MODE) = ONE
41498 4 A2MODE(J,N2MODE) = HNC(O(J),L1,L)
41499 C--neutralino to negative chargino positive Higgs
41500 ELSEIF((L.EQ.7.OR.L.EQ.8).AND.IH.EQ.6) THEN
41503 IF(N2MODE.GE.NMODE2) THEN
41504 CALL HWWARN('HWISP2',108)
41507 NME(I) = 30000+N2MODE
41510 P2MODE(N2MODE) = ONE
41512 5 A2MODE(J,N2MODE) = HNC(J,L1,L)
41513 C--neutralino to antisfermion sfermion
41514 ELSEIF(IDPDG(IDKPRD(2,I)).GT.0.AND.L.GE.-48.AND.L.LE.-1) THEN
41516 IF(N2MODE.GT.NMODE2) THEN
41517 CALL HWWARN('HWISP2',109)
41520 NME(I) = 30000+N2MODE
41523 P2MODE(N2MODE) = ONE
41524 IM = MOD(INT((IDKPRD(1,I)-389)/12)+1,2)+1
41525 IL = 6*INT((IDKPRD(1,I)-401)/24)+MOD(IDKPRD(1,I)-401,6)+1
41526 IF(IL.LE.6) P2MODE(N2MODE) = THREE
41528 6 A2MODE(J,N2MODE) = AFN(J,IL,IM,L1)
41529 C--neutralino to sfermion antifermion
41530 ELSEIF(IDPDG(IDKPRD(2,I)).LT.0.AND.L.GE.-48.AND.L.LE.-1) THEN
41532 IF(N2MODE.GT.NMODE2) THEN
41533 CALL HWWARN('HWISP2',110)
41536 NME(I) = 30000+N2MODE
41539 P2MODE(N2MODE) = ONE
41540 IM = MOD(INT((IDKPRD(1,I)-389)/12)+1,2)+1
41541 IL = 6*INT((IDKPRD(1,I)-401)/24)+MOD(IDKPRD(1,I)-401,6)+1
41542 IF(IL.LE.6) P2MODE(N2MODE) = THREE
41544 7 A2MODE(J,N2MODE) = AFN(O(J),IL,IM,L1)
41545 C--neutralino to neutralino photon
41546 ELSEIF(L.GE.1.AND.L.LE.4.AND.IDKPRD(2,I).EQ.59) THEN
41548 IF(N2MODE.GT.NMODE2) THEN
41549 CALL HWWARN('HWISP2',111)
41552 NME(I) = 30000+N2MODE
41555 P2MODE(N2MODE) = 8.0D0*PIFAC*RMASS(IDK(I))**3/
41556 & (RMASS(IDK(I))**2-RMASS(IDKPRD(1,I))**2)**3*
41557 & HBAR/RLTIM(IDK(I))*BRFRAC(I)
41558 A2MODE(1,N2MODE) = ZSGNSS(L)*ZSGNSS(L1)
41559 C--neutralino to gravitino photon for GMSB
41560 ELSEIF(IDKPRD(1,I).EQ.458.AND.IDKPRD(2,I).EQ.59) THEN
41562 IF(N2MODE.GT.NMODE2) THEN
41563 CALL HWWARN('HWISP2',112)
41566 NME(I) = 30000+N2MODE
41569 P2MODE(N2MODE) = ZMIXSS(L1,1)**2/24.0D0
41570 C--neutralino to gravitino Higgs for GMSB
41571 ELSEIF(IDKPRD(1,I).EQ.458.AND.IH.GE.1.AND.IH.LE.3) THEN
41573 IF(N2MODE.GT.NMODE2) THEN
41574 CALL HWWARN('HWISP2',113)
41577 NME(I) = 30000+N2MODE
41579 I2DRTP(N2MODE) = 10
41581 P2MODE(N2MODE) = ZMIXSS(L1,3)*SINA-ZMIXSS(L1,4)*COSA
41582 ELSEIF(IH.EQ.2) THEN
41583 P2MODE(N2MODE) = ZMIXSS(L1,3)*COSA+ZMIXSS(L1,4)*SINA
41585 P2MODE(N2MODE) = ZMIXSS(L1,3)*SINB+ZMIXSS(L1,4)*COSB
41587 P2MODE(N2MODE) = P2MODE(N2MODE)**2/3.0D0
41589 CALL HWWARN('HWISP2',1)
41591 C--two body modes of the positive charginos
41592 ELSEIF(L1.EQ.5.OR.L1.EQ.6) THEN
41594 L = IDKPRD(1,I)-449
41595 IH = IDKPRD(2,I)-202
41596 C--first the chargino modes to chargino Higgs
41597 IF((L.EQ.5.OR.L.EQ.6).AND.IH.GE.1.AND.IH.LE.3) THEN
41600 IF(N2MODE.GT.NMODE2) THEN
41601 CALL HWWARN('HWISP2',114)
41604 NME(I) = 30000+N2MODE
41607 P2MODE(N2MODE) = ONE
41609 8 A2MODE(J,N2MODE) = HCC(J,IH,L,L1)
41610 C--then the chargino modes to neutralino Higgs
41611 ELSEIF(L.GE.1.AND.L.LE.4.AND.IH.EQ.4) THEN
41613 IF(N2MODE.GT.NMODE2) THEN
41614 CALL HWWARN('HWISP2',115)
41617 NME(I) = 30000+N2MODE
41620 P2MODE(N2MODE) = ONE
41622 9 A2MODE(J,N2MODE) = HNC(J,L,L1)
41623 C--chargino modes to antisfermion fermion
41624 ELSEIF(IDPDG(IDKPRD(2,I)).GT.0.AND.L.GE.-48.AND.L.LE.-1) THEN
41626 IF(N2MODE.GT.NMODE2) THEN
41627 CALL HWWARN('HWISP2',116)
41630 NME(I) = 30000+N2MODE
41633 P2MODE(N2MODE) = ONE
41634 IM = MOD(INT((IDKPRD(1,I)-389)/12)+1,2)+1
41635 IL = 6*INT((IDKPRD(1,I)-401)/24)+MOD(IDKPRD(1,I)-401,6)+1
41636 IF(IL.LE.6) P2MODE(N2MODE) = THREE
41638 10 A2MODE(J,N2MODE) = AFC(J,IL,IM,L1)
41639 C--chargino modes to sfermion antifermion
41640 ELSEIF(IDPDG(IDKPRD(2,I)).LT.0.AND.L.GE.-48.AND.L.LE.-1) THEN
41642 IF(N2MODE.GT.NMODE2) THEN
41643 CALL HWWARN('HWISP2',117)
41646 NME(I) = 30000+N2MODE
41649 P2MODE(N2MODE) = ONE
41650 IM = MOD(INT((IDKPRD(1,I)-389)/12)+1,2)+1
41651 IL = 6*INT((IDKPRD(1,I)-401)/24)+MOD(IDKPRD(1,I)-401,6)+1
41652 IF(IL.LE.6) P2MODE(N2MODE) = THREE
41654 11 A2MODE(J,N2MODE) = AFC(O(J),IL,IM,L1)
41655 C--chargino --> neutralino pi+
41656 ELSEIF(L.GE.1.AND.L.LE.4.AND.IDKPRD(2,I).EQ.38) THEN
41658 IF(N2MODE.GT.NMODE2) THEN
41659 CALL HWWARN('HWISP2',118)
41662 NME(I) = 30000+N2MODE
41665 P2MODE(N2MODE) = FPI**2*G**2
41667 12 A2MODE(J,N2MODE) = OIJ(J,L,L1)
41669 C--two body modes of the negative charginos
41670 ELSEIF(L1.EQ.7.OR.L1.EQ.8) THEN
41672 L = IDKPRD(1,I)-449
41673 IH = IDKPRD(2,I)-202
41674 C--first the chargino modes to chargino Higgs
41675 IF((L.EQ.7.OR.L.EQ.8).AND.IH.GE.1.AND.IH.LE.3) THEN
41678 IF(N2MODE.GT.NMODE2) THEN
41679 CALL HWWARN('HWISP2',119)
41682 NME(I) = 30000+N2MODE
41685 P2MODE(N2MODE) = ONE
41687 13 A2MODE(J,N2MODE) = HCC(O(J),IH,L,L1)
41688 C--then the chargino modes to neutralino Higgs
41689 ELSEIF(L.GE.1.AND.L.LE.4.AND.IH.EQ.5) THEN
41691 IF(N2MODE.GT.NMODE2) THEN
41692 CALL HWWARN('HWISP2',120)
41695 NME(I) = 30000+N2MODE
41698 P2MODE(N2MODE) = ONE
41700 14 A2MODE(J,N2MODE) = HNC(O(J),L,L1)
41701 C--chargino to antisfermion fermion
41702 ELSEIF(IDPDG(IDKPRD(2,I)).GT.0.AND.L.GE.-48.AND.L.LE.-1) THEN
41704 IF(N2MODE.GT.NMODE2) THEN
41705 CALL HWWARN('HWISP2',121)
41708 NME(I) = 30000+N2MODE
41711 P2MODE(N2MODE) = ONE
41712 IM = MOD(INT((IDKPRD(1,I)-389)/12)+1,2)+1
41713 IL = 6*INT((IDKPRD(1,I)-401)/24)+MOD(IDKPRD(1,I)-401,6)+1
41714 IF(IL.LE.6) P2MODE(N2MODE) = THREE
41716 15 A2MODE(J,N2MODE) = AFC(J,IL,IM,L1)
41717 C--chargino to sfermion antifermion
41718 ELSEIF(IDPDG(IDKPRD(2,I)).LT.0.AND.L.GE.-48.AND.L.LE.-1) THEN
41720 IF(N2MODE.GT.NMODE2) THEN
41721 CALL HWWARN('HWISP2',122)
41724 NME(I) = 30000+N2MODE
41727 P2MODE(N2MODE) = ONE
41728 IM = MOD(INT((IDKPRD(1,I)-389)/12)+1,2)+1
41729 IL = 6*INT((IDKPRD(1,I)-401)/24)+MOD(IDKPRD(1,I)-401,6)+1
41730 IF(IL.LE.6) P2MODE(N2MODE) = THREE
41732 16 A2MODE(J,N2MODE) = AFC(O(J),IL,IM,L1)
41733 C--chargino --> neutralino pi-
41734 ELSEIF(L.GE.1.AND.L.LE.4.AND.IDKPRD(2,I).EQ.30) THEN
41736 IF(N2MODE.GT.NMODE2) THEN
41737 CALL HWWARN('HWISP2',123)
41740 NME(I) = 30000+N2MODE
41743 P2MODE(N2MODE) = FPI**2*G**2
41745 17 A2MODE(J,N2MODE) =-OIJ(O(J),L,L1)
41747 ELSEIF(L1.GE.-48.AND.L1.LT.0) THEN
41748 C--sfermion decay modes
41749 L = IDKPRD(1,I)-449
41750 C--first sfermion modes to gluinos
41752 C--first sfermion --> fermion gluino
41753 IF(IDPDG(IDKPRD(2,I)).GT.0) THEN
41755 IF(N2MODE.GT.NMODE2) THEN
41756 CALL HWWARN('HWISP2',124)
41759 NME(I) = 30000+N2MODE
41762 P2MODE(N2MODE) = FOUR/THREE
41763 IM = MOD(INT((IDK(I)-389)/12)+1,2)+1
41764 IL = 6*INT((IDK(I)-401)/24)+MOD(IDK(I)-401,6)+1
41766 18 A2MODE(J,N2MODE) = AFG(J,IL,IM)
41767 C--then antisfermion --> antifermion gluino
41770 IF(N2MODE.GT.NMODE2) THEN
41771 CALL HWWARN('HWISP2',125)
41774 NME(I) = 30000+N2MODE
41777 P2MODE(N2MODE) = FOUR/THREE
41778 IM = MOD(INT((IDK(I)-389)/12)+1,2)+1
41779 IL = 6*INT((IDK(I)-401)/24)+MOD(IDK(I)-401,6)+1
41781 19 A2MODE(J,N2MODE) = AFG(O(J),IL,IM)
41783 C--then sfermion modes to neutralinos
41784 ELSEIF(L.GE.1.AND.L.LE.4) THEN
41785 C--first sfermion --> fermion neutralino
41786 IF(IDPDG(IDKPRD(2,I)).GT.0) THEN
41788 IF(N2MODE.GT.NMODE2) THEN
41789 CALL HWWARN('HWISP2',126)
41792 NME(I) = 30000+N2MODE
41795 P2MODE(N2MODE) = ONE
41796 IM = MOD(INT((IDK(I)-389)/12)+1,2)+1
41797 IL = 6*INT((IDK(I)-401)/24)+MOD(IDK(I)-401,6)+1
41799 20 A2MODE(J,N2MODE) = AFN(J,IL,IM,L)
41800 C--then antisfermion --> fermion neutralino
41803 IF(N2MODE.GT.NMODE2) THEN
41804 CALL HWWARN('HWISP2',127)
41807 NME(I) = 30000+N2MODE
41810 P2MODE(N2MODE) = ONE
41811 IM = MOD(INT((IDK(I)-389)/12)+1,2)+1
41812 IL = 6*INT((IDK(I)-401)/24)+MOD(IDK(I)-401,6)+1
41814 21 A2MODE(J,N2MODE) = AFN(O(J),IL,IM,L)
41816 C--sfermion modes to charginos
41817 ELSEIF(L.GE.5.AND.L.LE.8) THEN
41819 C--first sfermion --> fermion chargino
41820 IF(IDPDG(IDKPRD(2,I)).GT.0) THEN
41822 IF(N2MODE.GT.NMODE2) THEN
41823 CALL HWWARN('HWISP2',128)
41826 NME(I) = 30000+N2MODE
41829 P2MODE(N2MODE) = ONE
41830 IM = MOD(INT((IDK(I)-389)/12)+1,2)+1
41831 IL = 6*INT((IDK(I)-401)/24)+MOD(IDK(I)-401,6)+1
41833 22 A2MODE(J,N2MODE) = AFC(J,IL,IM,L)
41834 C--then antisfermion --> fermion chargino
41837 IF(N2MODE.GT.NMODE2) THEN
41838 CALL HWWARN('HWISP2',129)
41841 NME(I) = 30000+N2MODE
41844 P2MODE(N2MODE) = ONE
41845 IM = MOD(INT((IDK(I)-389)/12)+1,2)+1
41846 IL = 6*INT((IDK(I)-401)/24)+MOD(IDK(I)-401,6)+1
41848 23 A2MODE(J,N2MODE) = AFC(O(J),IL,IM,L)
41850 C--sfermion modes to fermion gravitino
41851 ELSEIF(IDKPRD(2,I).EQ.458) THEN
41852 IF(IDPDG(IDKPRD(1,I)).GT.0) THEN
41854 IF(N2MODE.GT.NMODE2) THEN
41855 CALL HWWARN('HWISP2',130)
41858 NME(I) = 30000+N2MODE
41860 I2DRTP(N2MODE) = 11
41861 P2MODE(N2MODE) = ONE/THREE
41862 IM = MOD(INT((IDK(I)-389)/12)+1,2)+1
41863 IL = 6*INT((IDK(I)-401)/24)+MOD(IDK(I)-401,6)+1
41866 40 A2MODE(J,N2MODE) = QMIXSS(IL,O(J),IM)
41869 41 A2MODE(J,N2MODE) = LMIXSS(IL-6,O(J),IM)
41873 IF(N2MODE.GT.NMODE2) THEN
41874 CALL HWWARN('HWISP2',131)
41877 NME(I) = 30000+N2MODE
41879 I2DRTP(N2MODE) = 12
41880 P2MODE(N2MODE) = ONE/THREE
41881 IM = MOD(INT((IDK(I)-389)/12)+1,2)+1
41882 IL = 6*INT((IDK(I)-401)/24)+MOD(IDK(I)-401,6)+1
41885 42 A2MODE(J,N2MODE) = QMIXSS(IL,O(J),IM)
41888 43 A2MODE(J,N2MODE) = LMIXSS(IL-6,O(J),IM)
41891 C--R-parity violating decay modes
41893 ELSEIF(IDK(I).GE.425.AND.IDK(I).LE.448.AND.
41894 & IDKPRD(1,I).GE.121.AND.IDKPRD(1,I).LE.132.AND.
41895 & IDKPRD(2,I).GE.121.AND.IDKPRD(2,I).LE.132) THEN
41896 C--charged slepton decays
41897 IF(MOD(IDK(I),2).EQ.1) THEN
41898 C--right slepton decay
41899 IF(IDPDG(IDKPRD(1,I))/ABS(IDPDG(IDKPRD(1,I))).EQ.
41900 & IDPDG(IDKPRD(2,I))/ABS(IDPDG(IDKPRD(2,I)))) THEN
41903 IF(N2MODE.GT.NMODE2) THEN
41904 CALL HWWARN('HWISP2',132)
41907 NME(I) = 30000+N2MODE
41909 P2MODE(N2MODE) = ONE
41910 IF(IDPDG(IDK(I)).GT.0) THEN
41911 KKK = (IDK(I)-423)/2
41918 IF(MOD(IDKPRD(1,I),2).EQ.0) THEN
41919 III = (IDKPRD(1,I)-120)/2
41920 JJJ = (IDKPRD(2,I)-119)/2
41922 III = (IDKPRD(2,I)-120)/2
41923 JJJ = (IDKPRD(1,I)-119)/2
41926 A2MODE(1,N2MODE) = LMIXSS(2*KKK-1,2,IM)*
41927 & LAMDA1(III,JJJ,KKK)
41928 A2MODE(2,N2MODE) = 0.0D0
41930 C--antiparticle decay
41931 KKK = (IDK(I)-429)/2
41938 IF(MOD(IDKPRD(1,I),2).EQ.0) THEN
41939 III = (IDKPRD(1,I)-126)/2
41940 JJJ = (IDKPRD(2,I)-125)/2
41942 III = (IDKPRD(2,I)-126)/2
41943 JJJ = (IDKPRD(1,I)-125)/2
41945 I2DRTP(N2MODE) = 13
41946 A2MODE(1,N2MODE) = 0.0D0
41947 A2MODE(2,N2MODE) = LMIXSS(2*KKK-1,2,IM)*
41948 & LAMDA1(III,JJJ,KKK)
41950 C--left slepton decay
41953 IF(N2MODE.GT.NMODE2) THEN
41954 CALL HWWARN('HWISP2',133)
41957 NME(I) = 30000+N2MODE
41959 P2MODE(N2MODE) = ONE
41960 IF(IDPDG(IDK(I)).GT.0) THEN
41961 JJJ = (IDK(I)-423)/2
41968 IF(MOD(IDKPRD(1,I),2).EQ.0) THEN
41969 III = (IDKPRD(1,I)-126)/2
41970 KKK = (IDKPRD(2,I)-119)/2
41973 III = (IDKPRD(2,I)-126)/2
41974 KKK = (IDKPRD(1,I)-119)/2
41977 A2MODE(1,N2MODE) = 0.0D0
41978 A2MODE(2,N2MODE) = LMIXSS(2*JJJ-1,1,IM)*
41979 & LAMDA1(III,JJJ,KKK)
41981 JJJ = (IDK(I)-429)/2
41988 IF(MOD(IDKPRD(1,I),2).EQ.0) THEN
41989 III = (IDKPRD(1,I)-120)/2
41990 KKK = (IDKPRD(2,I)-125)/2
41993 III = (IDKPRD(2,I)-120)/2
41994 KKK = (IDKPRD(1,I)-125)/2
41997 A2MODE(1,N2MODE) = LMIXSS(2*JJJ-1,1,IM)*
41998 & LAMDA1(III,JJJ,KKK)
41999 A2MODE(2,N2MODE) = 0.0D0
42002 C--sneutrino decays
42003 ELSEIF(MOD(IDK(I),2).EQ.0.AND.IDK(I).LE.436) THEN
42006 IF(N2MODE.GT.NMODE2) THEN
42007 CALL HWWARN('HWISP2',134)
42010 NME(I) = 30000+N2MODE
42012 P2MODE(N2MODE) = ONE
42013 IF(IDPDG(IDK(I)).GT.0) THEN
42014 III = (IDK(I)-424)/2
42015 IF(IDPDG(IDKPRD(1,I)).GT.0) THEN
42016 KKK = (IDKPRD(1,I)-119)/2
42017 JJJ = (IDKPRD(2,I)-125)/2
42020 JJJ = (IDKPRD(1,I)-125)/2
42021 KKK = (IDKPRD(2,I)-119)/2
42024 A2MODE(1,N2MODE) = 0.0D0
42025 A2MODE(2,N2MODE) = LAMDA1(III,JJJ,KKK)
42026 C--antisneutrino decay
42028 III = (IDK(I)-430)/2
42029 IF(IDPDG(IDKPRD(1,I)).LT.0) THEN
42030 KKK = (IDKPRD(1,I)-125)/2
42031 JJJ = (IDKPRD(2,I)-119)/2
42034 JJJ = (IDKPRD(1,I)-119)/2
42035 KKK = (IDKPRD(2,I)-125)/2
42038 A2MODE(1,N2MODE) = LAMDA1(III,JJJ,KKK)
42039 A2MODE(2,N2MODE) = 0.0D0
42044 ELSEIF(IDK(I).GE.401.AND.IDK(I).LE.424.AND.
42045 & IDKPRD(1,I).GE.121.AND.IDKPRD(2,I).LE.132.AND.
42046 & IDKPRD(2,I).LE.12) THEN
42047 C--up type squark decay
42048 IF(MOD(IDK(I),2).EQ.0) THEN
42050 IF(N2MODE.GT.NMODE2) THEN
42051 CALL HWWARN('HWISP2',135)
42054 NME(I) = 30000+N2MODE
42056 P2MODE(N2MODE) = ONE
42057 IF(IDPDG(IDK(I)).GT.0) THEN
42058 JJJ = (IDK(I)-400)/2
42065 III = (IDKPRD(1,I)-125)/2
42066 KKK = (IDKPRD(2,I)+1)/2
42068 A2MODE(1,N2MODE) = ZERO
42069 A2MODE(2,N2MODE) = QMIXSS(2*JJJ,1,IM)*
42070 & LAMDA2(III,JJJ,KKK)
42072 JJJ = (IDK(I)-406)/2
42079 III = (IDKPRD(1,I)-119)/2
42080 KKK = (IDKPRD(2,I)-5)/2
42082 A2MODE(1,N2MODE) = QMIXSS(2*JJJ,1,IM)*
42083 & LAMDA2(III,JJJ,KKK)
42084 A2MODE(2,N2MODE) = ZERO
42086 C--down type squark to lepton up
42087 ELSEIF(MOD(IDK(I),2).EQ.1.AND.MOD(IDKPRD(1,I),2).EQ.1) THEN
42089 IF(N2MODE.GT.NMODE2) THEN
42090 CALL HWWARN('HWISP2',136)
42093 NME(I) = 30000+N2MODE
42095 P2MODE(N2MODE) = ONE
42097 IF(IDPDG(IDK(I)).GT.0) THEN
42098 KKK = (IDK(I)-399)/2
42105 III = (IDKPRD(1,I)-119)/2
42106 JJJ = IDKPRD(2,I)/2
42108 A2MODE(1,N2MODE) = QMIXSS(2*KKK-1,2,IM)*
42109 & LAMDA2(III,JJJ,KKK)
42110 A2MODE(2,N2MODE) = ZERO
42113 KKK = (IDK(I)-405)/2
42120 III = (IDKPRD(1,I)-125)/2
42121 JJJ = (IDKPRD(2,I)-6)/2
42122 I2DRTP(N2MODE) = 13
42123 A2MODE(1,N2MODE) = ZERO
42124 A2MODE(2,N2MODE) = QMIXSS(2*KKK-1,2,IM)*
42125 & LAMDA2(III,JJJ,KKK)
42127 C--down (left) squark --> nu d
42128 ELSEIF(MOD(IDK(I),2).EQ.1.AND.
42129 & IDPDG(IDK(I))/ABS(IDPDG(IDK(I))).EQ.
42130 & -IDPDG(IDKPRD(1,I))/ABS(IDPDG(IDKPRD(1,I)))) THEN
42132 IF(N2MODE.GT.NMODE2) THEN
42133 CALL HWWARN('HWISP2',137)
42136 NME(I) = 30000+N2MODE
42138 P2MODE(N2MODE) = ONE
42139 IF(IDPDG(IDK(I)).GT.0) THEN
42140 JJJ = (IDK(I)-399)/2
42147 III = (IDKPRD(1,I)-126)/2
42148 KKK = (IDKPRD(2,I)+1)/2
42150 A2MODE(1,N2MODE) = ZERO
42151 A2MODE(2,N2MODE) = QMIXSS(2*JJJ-1,1,IM)*
42152 & LAMDA2(III,JJJ,KKK)
42154 JJJ = (IDK(I)-405)/2
42161 III = (IDKPRD(1,I)-120)/2
42162 KKK = (IDKPRD(2,I)-5)/2
42164 A2MODE(1,N2MODE) = QMIXSS(2*JJJ-1,1,IM)*
42165 & LAMDA2(III,JJJ,KKK)
42166 A2MODE(2,N2MODE) = ZERO
42168 C--down (right) squark --> nu d
42169 ELSEIF(MOD(IDK(I),2).EQ.1.AND.
42170 & IDPDG(IDK(I))/ABS(IDPDG(IDK(I))).EQ.
42171 & IDPDG(IDKPRD(1,I))/ABS(IDPDG(IDKPRD(1,I)))) THEN
42173 IF(N2MODE.GT.NMODE2) THEN
42174 CALL HWWARN('HWISP2',138)
42177 NME(I) = 30000+N2MODE
42179 P2MODE(N2MODE) = ONE
42180 IF(IDPDG(IDK(I)).GT.0) THEN
42181 KKK = (IDK(I)-399)/2
42188 III = (IDKPRD(1,I)-120)/2
42189 JJJ = (IDKPRD(2,I)+1)/2
42191 A2MODE(1,N2MODE) = QMIXSS(2*KKK-1,2,IM)*
42192 & LAMDA2(III,JJJ,KKK)
42193 A2MODE(2,N2MODE) = ZERO
42195 KKK = (IDK(I)-405)/2
42202 III = (IDKPRD(1,I)-126)/2
42203 JJJ = (IDKPRD(2,I)-5)/2
42204 I2DRTP(N2MODE) = 13
42205 A2MODE(1,N2MODE) = ZERO
42206 A2MODE(2,N2MODE) = QMIXSS(2*KKK-1,2,IM)*
42207 & LAMDA2(III,JJJ,KKK)
42210 CALL HWWARN('HWISP2',2)
42213 ELSEIF(IDK(I).GE.425.AND.IDK(I).LE.448.AND.
42214 & IDKPRD(1,I).LE.12.AND.IDKPRD(2,I).LE.12) THEN
42216 IF(MOD(IDK(I),2).EQ.0) THEN
42218 IF(N2MODE.GT.NMODE2) THEN
42219 CALL HWWARN('HWISP2',140)
42222 NME(I) = 30000+N2MODE
42224 P2MODE(N2MODE) = THREE
42226 IF(IDPDG(IDK(I)).GT.0) THEN
42227 III = (IDK(I)-424)/2
42228 JJJ = (IDKPRD(1,I)-5)/2
42229 KKK = (IDKPRD(2,I)+1)/2
42231 A2MODE(1,N2MODE) = 0.0D0
42232 A2MODE(2,N2MODE) = LAMDA2(III,JJJ,KKK)
42235 III = (IDK(I)-430)/2
42236 JJJ = (IDKPRD(1,I)+1)/2
42237 KKK = (IDKPRD(2,I)-5)/2
42239 A2MODE(1,N2MODE) = LAMDA2(III,JJJ,KKK)
42240 A2MODE(2,N2MODE) = 0.0D0
42243 ELSEIF(MOD(IDK(I),2).EQ.1) THEN
42245 IF(N2MODE.GT.NMODE2) THEN
42246 CALL HWWARN('HWISP2',141)
42249 NME(I) = 30000+N2MODE
42251 P2MODE(N2MODE) = THREE
42253 IF(IDPDG(IDK(I)).GT.0) THEN
42254 III = (IDK(I)-423)/2
42261 JJJ = (IDKPRD(1,I)-6)/2
42262 KKK = (IDKPRD(2,I)+1)/2
42264 A2MODE(1,N2MODE) = 0.0D0
42265 A2MODE(2,N2MODE) = LMIXSS(2*III-1,1,IM)*
42266 & LAMDA2(III,JJJ,KKK)
42269 III = (IDK(I)-429)/2
42276 JJJ = IDKPRD(1,I)/2
42277 KKK = (IDKPRD(2,I)-5)/2
42279 A2MODE(1,N2MODE) = LMIXSS(2*III-1,1,IM)*
42280 & LAMDA2(III,JJJ,KKK)
42281 A2MODE(2,N2MODE) = 0.0D0
42284 CALL HWWARN('HWISP2',3)
42287 ELSEIF(IDK(I).GE.401.AND.IDK(I).LE.424.AND.
42288 & IDKPRD(1,I).LE.12.AND.IDKPRD(2,I).LE.12) THEN
42289 C--up type squark decay
42290 IF(MOD(IDK(I),2).EQ.0) THEN
42292 IF(N2MODE.GT.NMODE2) THEN
42293 CALL HWWARN('HWISP2',143)
42296 NME(I) = 30000+N2MODE
42298 P2MODE(N2MODE) = 2.0D0
42300 IF(IDPDG(IDK(I)).GT.0) THEN
42301 III = (IDK(I)-400)/2
42308 JJJ = (IDKPRD(1,I)-5)/2
42309 KKK = (IDKPRD(2,I)-5)/2
42310 I2DRTP(N2MODE) = 13
42311 A2MODE(1,N2MODE)=QMIXSS(2*III,2,IM)*LAMDA3(III,JJJ,KKK)
42312 A2MODE(2,N2MODE)=0.0D0
42313 C--antisquark decay
42315 III = (IDK(I)-406)/2
42322 JJJ = (IDKPRD(1,I)+1)/2
42323 KKK = (IDKPRD(2,I)+1)/2
42325 A2MODE(1,N2MODE) =0.0D0
42326 A2MODE(2,N2MODE) =QMIXSS(2*III,2,IM)*LAMDA3(III,JJJ,KKK)
42329 C--down type squark decay
42331 IF(N2MODE.GT.NMODE2) THEN
42332 CALL HWWARN('HWISP2',144)
42335 NME(I) = 30000+N2MODE
42337 P2MODE(N2MODE) = 2.0D0
42339 IF(IDPDG(IDK(I)).GT.0) THEN
42340 JJJ = (IDK(I)-399)/2
42347 III = (IDKPRD(1,I)-6)/2
42348 KKK = (IDKPRD(2,I)-5)/2
42349 I2DRTP(N2MODE) = 13
42350 A2MODE(1,N2MODE)= QMIXSS(2*JJJ-1,2,IM)*
42351 & LAMDA3(III,JJJ,KKK)
42352 A2MODE(2,N2MODE)= 0.0D0
42353 C--antisquark decay
42355 JJJ = (IDK(I)-405)/2
42362 III = IDKPRD(1,I)/2
42363 KKK = (IDKPRD(2,I)+1)/2
42365 A2MODE(1,N2MODE) = 0.0D0
42366 A2MODE(2,N2MODE) = QMIXSS(2*JJJ-1,2,IM)*
42367 & LAMDA3(III,JJJ,KKK)
42371 IF(.NOT.(RSPIN(IDKPRD(1,I)).EQ.ZERO.AND.
42372 & RSPIN(IDKPRD(2,I)).EQ.ZERO)) CALL HWWARN('HWISP2',4)
42374 ELSEIF(IDK(I).GE.203.AND.IDK(I).LE.207) THEN
42376 L = IDKPRD(1,I)-449
42377 L1 = IDKPRD(2,I)-449
42378 C--Neutral Higgs decays
42379 IF(IH.GE.1.AND.IH.LE.3) THEN
42380 C--Higgs to neutralino neutralino
42381 IF(L.GE.1.AND.L.LE.4) THEN
42383 IF(N2MODE.GT.NMODE2) THEN
42384 CALL HWWARN('HWISP2',146)
42387 NME(I) = 30000+N2MODE
42390 P2MODE(N2MODE) = ONE
42391 IF(L.EQ.L1) P2MODE(N2MODE) = HALF
42393 24 A2MODE(J,N2MODE) = HNN(J,IH,L,L1)
42394 C--Higgs to chargino chargino
42395 ELSEIF(L.GE.5.AND.L.LE.8) THEN
42399 IF(N2MODE.GT.NMODE2) THEN
42400 CALL HWWARN('HWISP2',147)
42403 NME(I) = 30000+N2MODE
42406 P2MODE(N2MODE) = ONE
42408 IF(IDPDG(IDKPRD(1,I)).GT.0) THEN
42409 A2MODE(J,N2MODE) = HCC( J ,IH,L,L1)
42411 A2MODE(J,N2MODE) = HCC(O(J),IH,L,L1)
42414 C--Higgs to fermion antifermion
42415 ELSEIF((L.GE.-448.AND.L.LE.-437)
42416 & .OR.(L.GE.-328.AND.L.LE.-317)) THEN
42418 IF(N2MODE.GT.NMODE2) THEN
42419 CALL HWWARN('HWISP2',148)
42422 NME(I) = 30000+N2MODE
42425 P2MODE(N2MODE) = ONE
42427 IL = IL-6*INT((IL-1)/6)+6*INT((IL-1)/120)
42428 IF(IL.LE.6) P2MODE(N2MODE) = THREE
42430 26 A2MODE(J,N2MODE) = HFF(J,IH,IL)
42433 & (RSPIN(IDKPRD(1,I)).EQ.ZERO.AND.RSPIN(IDKPRD(2,I)).EQ.ZERO)
42434 & .AND..NOT.(IDKPRD(1,I).EQ.13.AND.IDKPRD(2,I).EQ.13)
42435 & .AND..NOT.(IDKPRD(1,I).EQ.59.AND.IDKPRD(2,I).EQ.59)
42436 & .AND..NOT.(IDKPRD(1,I).GE.198.AND.IDKPRD(1,I).LE.200.AND.
42437 & IDKPRD(2,I).GE.198.AND.IDKPRD(2,I).LE.200))
42438 & CALL HWWARN('HWISP2',5)
42440 C--charged Higgs decays
42443 L = IDKPRD(1,I)-449
42444 L1 = IDKPRD(2,I)-449
42445 C--positive Higgs decays
42447 C--decay to chargino neutralino
42448 IF(L.EQ.5.OR.L.EQ.6) THEN
42451 IF(N2MODE.GT.NMODE2) THEN
42452 CALL HWWARN('HWISP2',149)
42455 NME(I) = 30000+N2MODE
42458 P2MODE(N2MODE) = ONE
42460 27 A2MODE(J,N2MODE) = HNC(O(J),L1,L)
42461 C--decay to neutralino chargino
42462 ELSEIF(L.GE.1.AND.L.LE.4) THEN
42465 IF(N2MODE.GT.NMODE2) THEN
42466 CALL HWWARN('HWISP2',150)
42469 NME(I) = 30000+N2MODE
42472 P2MODE(N2MODE) = ONE
42474 28 A2MODE(J,N2MODE) = HNC(O(J),L1,L)
42475 C--fermion antifermion decay modes
42476 ELSEIF((L.GE.-448.AND.L.LE.-437)
42477 & .OR.(L.GE.-328.AND.L.LE.-317)) THEN
42479 IF(N2MODE.GT.NMODE2) THEN
42480 CALL HWWARN('HWISP2',151)
42483 NME(I) = 30000+N2MODE
42486 P2MODE(N2MODE) = ONE
42488 IL = IL-6*INT((IL-1)/6)+6*INT((IL-1)/120)
42490 IF(IL.LE.3) P2MODE(N2MODE) = THREE
42492 29 A2MODE(J,N2MODE) = HFF(J,4,IL)
42494 IF(RSPIN(IDKPRD(1,I)).NE.ZERO.OR.RSPIN(IDKPRD(2,I)).NE.
42495 & ZERO) CALL HWWARN('HWISP2',6)
42497 C--negative Higgs decays
42499 C--Higgs to chargino neutralino
42500 IF(L.EQ.7.OR.L.EQ.8) THEN
42503 IF(N2MODE.GT.NMODE2) THEN
42504 CALL HWWARN('HWISP2',152)
42507 NME(I) = 30000+N2MODE
42510 P2MODE(N2MODE) = ONE
42512 30 A2MODE(J,N2MODE) = HNC(J,L1,L)
42513 C--Higgs to neutralino chargino
42514 ELSEIF(L.GE.1.AND.L.LE.4) THEN
42517 IF(N2MODE.GT.NMODE2) THEN
42518 CALL HWWARN('HWISP2',153)
42521 NME(I) = 30000+N2MODE
42524 P2MODE(N2MODE) = ONE
42526 31 A2MODE(J,N2MODE) = HNC(J,L1,L)
42527 C--fermion antifermion decay modes
42528 ELSEIF((L.GE.-448.AND.L.LE.-437)
42529 & .OR.(L.GE.-328.AND.L.LE.-317)) THEN
42531 IF(N2MODE.GT.NMODE2) THEN
42532 CALL HWWARN('HWISP2',154)
42535 NME(I) = 30000+N2MODE
42538 P2MODE(N2MODE) = ONE
42540 IL = IL-6*INT((IL-1)/6)+6*INT((IL-1)/120)
42542 IF(IL.LE.3) P2MODE(N2MODE) = THREE
42544 32 A2MODE(J,N2MODE) = HFF(O(J),4,IL)
42546 IF(RSPIN(IDKPRD(1,I)).NE.ZERO.OR.RSPIN(IDKPRD(1,I)).NE.
42547 & ZERO) CALL HWWARN('HWISP2',7)
42553 C--now find the maximum weights and compute the decay rates
42555 IF(IPRINT.EQ.2) WRITE(6,5010) RNAME(IDK(ID2PRT(I))),
42556 & RNAME(IDKPRD(1,ID2PRT(I))),RNAME(IDKPRD(2,ID2PRT(I)))
42557 2000 CALL HWD2ME(I)
42559 5010 FORMAT(/'CALCULATING TWO BODY DECAY ',
42560 & A8,' --> ',A8,' ',A8/)
42564 *CMZ :- -30/09/02 14:05:28 by Peter Richardson
42565 *-- Author : Peter Richardson
42566 C-----------------------------------------------------------------------
42568 C-----------------------------------------------------------------------
42569 C Initialise the top/SUSY three body decay modes
42570 C gravitino and RPV modes added by Peter Richardson
42571 C-----------------------------------------------------------------------
42572 INCLUDE 'herwig65.inc'
42573 INTEGER I,J,K,L,L1,IL,IQ,IQ1,IQ2,IFR,SIFR,IH,IH1,IM,O(2),II,JJ,
42575 DOUBLE PRECISION SW,CW,TW,E,G,RT,ORT,MW,MZ,GS,AFN(2,12,2,4),
42576 & AFG(2,6,2),AFC(2,12,2,2),OIJ(2,4,2),OIJP(2,2,2),OIJPP(2,4,4),
42577 & HNN(2,3,4,4),HCC(2,3,2,2),HNC(2,4,2),HFF(2,4,12),HWW(2),
42578 & HZZ(2),ZAB(12,2,2),HHB(2,3)
42579 DOUBLE COMPLEX RHOIN(2,2)
42580 COMMON /HWSPNC/ SW,CW,TW,E,G,RT,ORT,MW,MZ,GS,AFN,AFG,AFC,OIJ,OIJP,
42581 & OIJPP,HNN,HCC,HNC,HFF,HWW,HZZ,ZAB,HHB
42584 IF(IERROR.NE.0) RETURN
42585 C--loop over the decays and find the top decays
42587 DO 1000 II=1,NMODES(JJ)
42594 IF(IDK(I).EQ.6.AND.NME(I).EQ.100) THEN
42596 IF(N3MODE.GT.NMODE3) THEN
42597 CALL HWWARN('HWISP3',100)
42600 P3MODE(N3MODE) = ONE
42601 IF(IDKPRD(1,I).LE.12) P3MODE(N3MODE) = THREE
42602 SPN3CF(1,1,N3MODE) = ONE
42605 NME(I) = 10000+N3MODE
42607 I3DRTP(1,N3MODE) = 1
42608 I3DRCF(1,N3MODE) = 1
42609 I3MODE(1,N3MODE) = 198
42610 A3MODE(1,1,N3MODE) = ZERO
42611 A3MODE(2,1,N3MODE) = -G*ORT
42612 B3MODE(1,1,N3MODE) = ZERO
42613 B3MODE(2,1,N3MODE) = -G*ORT
42614 C--antitop decay via W
42615 ELSEIF(IDK(I).EQ.12.AND.NME(I).EQ.100) THEN
42617 IF(N3MODE.GT.NMODE3) THEN
42618 CALL HWWARN('HWISP3',101)
42621 P3MODE(N3MODE) = ONE
42622 IF(IDKPRD(1,I).LE.12) P3MODE(N3MODE) = THREE
42623 SPN3CF(1,1,N3MODE) = ONE
42626 NME(I) = 10000+N3MODE
42628 I3DRTP(1,N3MODE) = 5
42629 I3DRCF(1,N3MODE) = 1
42630 I3MODE(1,N3MODE) = 199
42631 A3MODE(1,1,N3MODE) = ZERO
42632 A3MODE(2,1,N3MODE) = -G*ORT
42633 B3MODE(1,1,N3MODE) = ZERO
42634 B3MODE(2,1,N3MODE) = -G*ORT
42635 C--top decay via charged Higgs
42636 ELSEIF(IDK(I).EQ.6.AND.NME(I).EQ.200) THEN
42638 IF(N3MODE.GT.NMODE3) THEN
42639 CALL HWWARN('HWISP3',102)
42642 P3MODE(N3MODE) = ONE
42643 IF(IDKPRD(1,I).LE.12) P3MODE(N3MODE) = THREE
42644 SPN3CF(1,1,N3MODE) = ONE
42647 NME(I) = 10000+N3MODE
42649 I3DRTP(1,N3MODE) = 2
42650 I3DRCF(1,N3MODE) = 1
42651 I3MODE(1,N3MODE) = 206
42653 IL = IL-6*INT((IL-1)/6)+6*INT((IL-1)/120)
42656 A3MODE(J,1,N3MODE) = HFF(O(J),4,3)
42657 201 B3MODE(J,1,N3MODE) = HFF( J ,4,IL)
42658 C--antitop decay via charged Higgs
42659 ELSEIF(IDK(I).EQ.12.AND.NME(I).EQ.200) THEN
42661 IF(N3MODE.GT.NMODE3) THEN
42662 CALL HWWARN('HWISP3',103)
42665 P3MODE(N3MODE) = ONE
42666 IF(IDKPRD(1,I).LE.12) P3MODE(N3MODE) = THREE
42667 SPN3CF(1,1,N3MODE) = ONE
42670 NME(I) = 10000+N3MODE
42672 I3DRTP(1,N3MODE) = 17
42673 I3DRCF(1,N3MODE) = 1
42674 I3MODE(1,N3MODE) = 207
42676 IL = IL-6*INT((IL-1)/6)+6*INT((IL-1)/120)
42679 A3MODE(J,1,N3MODE) = HFF( J ,4,3)
42680 202 B3MODE(J,1,N3MODE) = HFF(O(J),4,IL)
42683 IF(.NOT.SUSYIN) GOTO 2999
42684 C--loop over all the SUSY decay modes and find the ones we want
42685 C--first the true three body gaugino decays
42687 DO 2000 II=1,NMODES(JJ)
42693 L = IDKPRD(1,I)-449
42694 IF(IDKPRD(3,I).EQ.0.OR.IDKPRD(4,I).NE.0) GOTO 2500
42695 C--gluino modes first
42696 IF(IDK(I).EQ.449) THEN
42697 C--first the gluino modes to quark-antiquark neutralino
42698 IF(L.GE.1.AND.L.LE.4.AND.(IDKPRD(2,I).LE.12.OR.
42699 & (IDKPRD(2,I).GE.121.AND.IDKPRD(2,I).LE.132))) THEN
42701 IF(IQ.GT.6) IQ=IQ-6
42702 IF(IQ.GT.6.OR.IQ.LT.1) CALL HWWARN('HWISP3',200)
42704 IF(N3MODE.GT.NMODE3) THEN
42705 CALL HWWARN('HWISP3',104)
42708 P3MODE(N3MODE) = HALF
42709 SPN3CF(1,1,N3MODE) = ONE
42712 NME(I) = 10000+N3MODE
42714 C--only squark exchange diagrams
42716 I3DRTP(K ,N3MODE) = 3
42717 I3DRCF(K ,N3MODE) = 1
42718 I3DRTP(K+2,N3MODE) = 4
42719 I3DRCF(K+2,N3MODE) = 1
42720 I3MODE(K ,N3MODE) = 12*(K-1)+400+IQ
42721 I3MODE(K+2,N3MODE) = 12*(K-1)+406+IQ
42723 A3MODE(J,K ,N3MODE) = AFG( J ,IQ,K)
42724 B3MODE(J,K ,N3MODE) = AFN(O(J),IQ,K,L)
42725 A3MODE(J,K+2,N3MODE) = AFG(O(J),IQ,K)
42726 1 B3MODE(J,K+2,N3MODE) = ZSGNSS(L)*AFN( J ,IQ,K,L)
42727 C--then the gluino modes to quark-antiquark +ve chargino
42728 ELSEIF(L.EQ.5.OR.L.EQ.6.AND.(IDKPRD(2,I).LE.12.OR.
42729 & (IDKPRD(2,I).GE.121.AND.IDKPRD(2,I).LE.132))) THEN
42732 IF(IQ.GT.6) IQ=IQ-6
42733 IF(IQ.GT.6.OR.IQ.LT.1) CALL HWWARN('HWISP3',201)
42734 IQ = (IQ+MOD(IQ,2))/2
42738 IF(N3MODE.GT.NMODE3) THEN
42739 CALL HWWARN('HWISP3',105)
42742 P3MODE(N3MODE) = HALF
42743 SPN3CF(1,1,N3MODE) = ONE
42746 NME(I) = 10000+N3MODE
42748 C--only squark exchange diagrams
42750 I3DRTP(K ,N3MODE) = 3
42751 I3DRCF(K ,N3MODE) = 1
42752 I3DRTP(K+2,N3MODE) = 4
42753 I3DRCF(K+2,N3MODE) = 1
42754 I3MODE(K ,N3MODE) = 12*(K-1)+400+IQ1
42755 I3MODE(K+2,N3MODE) = 12*(K-1)+406+IQ2
42757 A3MODE(J,K ,N3MODE) = AFG( J ,IQ1,K)
42758 B3MODE(J,K ,N3MODE) = AFC(O(J),IQ1,K,L)
42759 A3MODE(J,K+2,N3MODE) = AFG(O(J),IQ2,K)
42760 2 B3MODE(J,K+2,N3MODE) = AFC( J ,IQ2,K,L)
42761 C--then the gluino modes to quark-antiquark -ve chargino
42762 ELSEIF(L.EQ.7.OR.L.EQ.8.AND.(IDKPRD(2,I).LE.12.OR.
42763 & (IDKPRD(2,I).GE.121.AND.IDKPRD(2,I).LE.132))) THEN
42766 IF(IQ.GT.6) IQ=IQ-6
42767 IF(IQ.GT.6.OR.IQ.LT.1) CALL HWWARN('HWISP3',202)
42768 IQ = (IQ+MOD(IQ,2))/2
42772 IF(N3MODE.GT.NMODE3) THEN
42773 CALL HWWARN('HWISP3',106)
42776 P3MODE(N3MODE) = HALF
42777 SPN3CF(1,1,N3MODE) = ONE
42780 NME(I) = 10000+N3MODE
42782 C--only squark exchange diagrams
42784 I3DRTP(K ,N3MODE) = 3
42785 I3DRCF(K ,N3MODE) = 1
42786 I3DRTP(K+2,N3MODE) = 4
42787 I3DRCF(K+2,N3MODE) = 1
42788 I3MODE(K ,N3MODE) = 12*(K-1)+400+IQ1
42789 I3MODE(K+2,N3MODE) = 12*(K-1)+406+IQ2
42791 A3MODE(J,K ,N3MODE) = AFG( J ,IQ1,K)
42792 B3MODE(J,K ,N3MODE) = AFC(O(J),IQ1,K,L)
42793 A3MODE(J,K+2,N3MODE) = AFG(O(J),IQ2,K)
42794 3 B3MODE(J,K+2,N3MODE) = AFC( J ,IQ2,K,L)
42797 ELSEIF(IDKPRD(1,I).GE.121.AND.IDKPRD(1,I).LE.132.AND.
42798 & IDKPRD(2,I).LE.12 .AND.IDKPRD(3,I).LE.12) THEN
42800 IF(N3MODE.GT.NMODE3) THEN
42801 CALL HWWARN('HWISP3',107)
42805 NME(I) = 10000+N3MODE
42806 P3MODE(N3MODE) = HALF
42807 SPN3CF(1,1,N3MODE) = ONE
42811 98 I3DRCF(J,N3MODE) = 1
42812 C--first the neutrino mode
42813 IF(MOD(IDKPRD(1,I),2).EQ.0) THEN
42815 IF(IDPDG(IDKPRD(1,I)).GT.0) THEN
42816 III = (IDKPRD(1,I)-120)/2
42817 JJJ = (IDKPRD(2,I)+1)/2
42818 KKK = (IDKPRD(3,I)-5)/2
42820 I3DRTP(K ,N3MODE) = 3
42821 I3DRTP(K+2,N3MODE) = 4
42822 I3MODE(K ,N3MODE) = 399+2*JJJ+(K-1)*12
42823 I3MODE(K+2,N3MODE) = 399+2*KKK+(K-1)*12
42824 B3MODE(2,K ,N3MODE) = 0.0D0
42825 B3MODE(1,K ,N3MODE) = -QMIXSS(2*JJJ-1,1,K)*
42826 & LAMDA2(III,JJJ,KKK)
42827 B3MODE(2,K+2,N3MODE) = 0.0D0
42828 B3MODE(1,K+2,N3MODE) = -QMIXSS(2*KKK-1,2,K)*
42829 & LAMDA2(III,JJJ,KKK)
42831 A3MODE(J,K ,N3MODE) = AFG( J ,2*JJJ-1,K)
42832 99 A3MODE(J,K+2,N3MODE) = AFG(O(J),2*KKK-1,K)
42833 C--antiparticle mode
42835 III = (IDKPRD(1,I)-126)/2
42836 JJJ = (IDKPRD(2,I)-5)/2
42837 KKK = (IDKPRD(3,I)+1)/2
42839 I3DRTP(K ,N3MODE) = 9
42840 I3DRTP(K+2,N3MODE) = 10
42841 I3MODE(K ,N3MODE) = 399+2*JJJ+(K-1)*12
42842 I3MODE(K+2,N3MODE) = 399+2*KKK+(K-1)*12
42843 B3MODE(1,K ,N3MODE) = 0.0D0
42844 B3MODE(2,K ,N3MODE) = -QMIXSS(2*JJJ-1,1,K)*
42845 & LAMDA2(III,JJJ,KKK)
42846 B3MODE(1,K+2,N3MODE) = 0.0D0
42847 B3MODE(2,K+2,N3MODE) = -QMIXSS(2*KKK-1,2,K)*
42848 & LAMDA2(III,JJJ,KKK)
42850 A3MODE(J,K ,N3MODE) = AFG(O(J),2*JJJ-1,K)
42851 101 A3MODE(J,K+2,N3MODE) = AFG( J ,2*KKK-1,K)
42853 C--then the charged lepton mode
42856 IF(IDPDG(IDKPRD(1,I)).GT.0) THEN
42857 III = (IDKPRD(1,I)-119)/2
42858 JJJ = IDKPRD(2,I)/2
42859 KKK = (IDKPRD(3,I)-5)/2
42861 I3DRTP(K ,N3MODE) = 3
42862 I3DRTP(K+2,N3MODE) = 4
42863 I3MODE(K ,N3MODE) = 400+2*JJJ+(K-1)*12
42864 I3MODE(K+2,N3MODE) = 399+2*KKK+(K-1)*12
42865 B3MODE(2,K ,N3MODE) = 0.0D0
42866 B3MODE(1,K ,N3MODE) = QMIXSS(2*JJJ,1,K)*
42867 & LAMDA2(III,JJJ,KKK)
42868 B3MODE(2,K+2,N3MODE) = 0.0D0
42869 B3MODE(1,K+2,N3MODE) = QMIXSS(2*KKK-1,2,K)*
42870 & LAMDA2(III,JJJ,KKK)
42872 A3MODE(J,K ,N3MODE) = AFG( J ,2*JJJ ,K)
42873 102 A3MODE(J,K+2,N3MODE) = AFG(O(J),2*KKK-1,K)
42874 C--antiparticle mode
42876 III = (IDKPRD(1,I)-125)/2
42877 JJJ = (IDKPRD(2,I)-6)/2
42878 KKK = (IDKPRD(3,I)+1)/2
42880 I3DRTP(K ,N3MODE) = 9
42881 I3DRTP(K+2,N3MODE) = 10
42882 I3MODE(K ,N3MODE) = 400+2*JJJ+(K-1)*12
42883 I3MODE(K+2,N3MODE) = 399+2*KKK+(K-1)*12
42884 B3MODE(1,K ,N3MODE) = 0.0D0
42885 B3MODE(2,K ,N3MODE) = QMIXSS(2*JJJ,1,K)*
42886 & LAMDA2(III,JJJ,KKK)
42887 B3MODE(1,K+2,N3MODE) = 0.0D0
42888 B3MODE(2,K+2,N3MODE) = QMIXSS(2*KKK-1,2,K)*
42889 & LAMDA2(III,JJJ,KKK)
42891 A3MODE(J,K ,N3MODE) = AFG(O(J),2*JJJ ,K)
42892 103 A3MODE(J,K+2,N3MODE) = AFG( J ,2*KKK-1,K)
42896 ELSEIF(IDKPRD(1,I).LE.12.AND.IDKPRD(2,I).LE.12.AND.
42897 & IDKPRD(3,I).LE.12) THEN
42899 IF(N3MODE.GT.NMODE3) THEN
42900 CALL HWWARN('HWISP3',108)
42903 P3MODE(N3MODE) = ONE
42906 NME(I) = 10000+N3MODE
42911 SPN3CF(J,K,N3MODE) = -HALF
42913 SPN3CF(J,K,N3MODE) = ONE
42917 IF(IDKPRD(1,I).LE.6) THEN
42918 C--antiparticle mode
42919 III = IDKPRD(1,I)/2
42920 JJJ = (IDKPRD(2,I)+1)/2
42921 KKK = (IDKPRD(3,I)+1)/2
42923 I3DRTP(K ,N3MODE) = 11
42924 I3DRCF(K ,N3MODE) = 1
42925 I3DRTP(K+2,N3MODE) = 12
42926 I3DRCF(K+2,N3MODE) = 2
42927 I3DRTP(K+4,N3MODE) = 13
42928 I3DRCF(K+4,N3MODE) = 3
42929 I3MODE(K ,N3MODE) = 400+2*III+(K-1)*12
42930 I3MODE(K+2,N3MODE) = 399+2*JJJ+(K-1)*12
42931 I3MODE(K+4,N3MODE) = 399+2*KKK+(K-1)*12
42932 B3MODE(2,K ,N3MODE) = QMIXSS(2*III,2,K)*
42933 & LAMDA3(III,JJJ,KKK)
42934 B3MODE(2,K+2,N3MODE) = QMIXSS(2*JJJ-1,2,K)*
42935 & LAMDA3(III,JJJ,KKK)
42936 B3MODE(2,K+4,N3MODE) = QMIXSS(2*KKK-1,2,K)*
42937 & LAMDA3(III,JJJ,KKK)
42938 B3MODE(1,K ,N3MODE) = 0.0D0
42939 B3MODE(1,K+2,N3MODE) = 0.0D0
42940 B3MODE(1,K+4,N3MODE) = 0.0D0
42942 A3MODE(J,K ,N3MODE) = AFG(J,2*III ,K)
42943 A3MODE(J,K+2,N3MODE) = AFG(J,2*JJJ-1,K)
42944 71 A3MODE(J,K+4,N3MODE) = AFG(J,2*KKK-1,K)
42946 III = (IDKPRD(1,I)-6)/2
42947 JJJ = (IDKPRD(2,I)-5)/2
42948 KKK = (IDKPRD(3,I)-5)/2
42950 I3DRTP(K ,N3MODE) = 14
42951 I3DRCF(K ,N3MODE) = 1
42952 I3DRTP(K+2,N3MODE) = 15
42953 I3DRCF(K+2,N3MODE) = 2
42954 I3DRTP(K+4,N3MODE) = 16
42955 I3DRCF(K+4,N3MODE) = 3
42956 I3MODE(K ,N3MODE) = 400+2*III+(K-1)*12
42957 I3MODE(K+2,N3MODE) = 399+2*JJJ+(K-1)*12
42958 I3MODE(K+4,N3MODE) = 399+2*KKK+(K-1)*12
42959 B3MODE(1,K ,N3MODE) = QMIXSS(2*III,2,K)*
42960 & LAMDA3(III,JJJ,KKK)
42961 B3MODE(1,K+2,N3MODE) = QMIXSS(2*JJJ-1,2,K)*
42962 & LAMDA3(III,JJJ,KKK)
42963 B3MODE(1,K+4,N3MODE) = QMIXSS(2*KKK-1,2,K)*
42964 & LAMDA3(III,JJJ,KKK)
42965 B3MODE(2,K ,N3MODE) = 0.0D0
42966 B3MODE(2,K+2,N3MODE) = 0.0D0
42967 B3MODE(2,K+4,N3MODE) = 0.0D0
42969 A3MODE(J,K ,N3MODE) = AFG(O(J),2*III ,K)
42970 A3MODE(J,K+2,N3MODE) = AFG(O(J),2*JJJ-1,K)
42971 72 A3MODE(J,K+4,N3MODE) = AFG(O(J),2*KKK-1,K)
42973 C--unrecognized decay issue warning
42975 CALL HWWARN('HWISP3',1)
42977 ELSEIF(IDK(I).GE.450.AND.IDK(I).LE.453) THEN
42979 C--neutralino modes next
42980 IF(L.GE.1.AND.L.LE.4.AND.(IDKPRD(2,I).LE.12.OR.
42981 & (IDKPRD(2,I).GE.121.AND.IDKPRD(2,I).LE.132))) THEN
42982 C--first the neutralino modes to fermion-antifermion neutralino
42984 J = INT((IFR-1)/120)
42985 IFR = IFR-6*INT((IFR-1)/6)+6*J
42989 IF(N3MODE.GT.NMODE3) THEN
42990 CALL HWWARN('HWISP3',109)
42993 P3MODE(N3MODE) = ONE
42994 IF(IFR.LE.6) P3MODE(N3MODE)=THREE
42995 SPN3CF(1,1,N3MODE) = ONE
42998 NME(I) = 10000+N3MODE
43000 C--sfermion exchange diagrams
43002 I3DRTP(K ,N3MODE) = 3
43003 I3DRCF(K ,N3MODE) = 1
43004 I3DRTP(K+2,N3MODE) = 4
43005 I3DRCF(K+2,N3MODE) = 1
43006 I3MODE(K ,N3MODE) = 12*(K-1)+400+SIFR
43007 I3MODE(K+2,N3MODE) = 12*(K-1)+406+SIFR
43009 A3MODE(J,K ,N3MODE) = AFN( J ,IFR,K,L1)
43010 B3MODE(J,K ,N3MODE) = AFN(O(J),IFR,K,L )
43011 A3MODE(J,K+2,N3MODE) = ZSGNSS(L1)*AFN(O(J),IFR,K,L1)
43012 4 B3MODE(J,K+2,N3MODE) = ZSGNSS(L )*AFN( J ,IFR,K,L )
43013 C--now add higgs diagrams if third generation fermion, if Higgs off shell
43014 IF(IFR.EQ.5.OR.IFR.EQ.6.OR.IFR.EQ.11) THEN
43016 IF(RMASS(IDK(I)).LT.
43017 & RMASS(203+J)+RMASS(IDKPRD(1,I))) THEN
43018 NDI3BY(N3MODE) = NDI3BY(N3MODE)+1
43019 I3DRTP( NDI3BY(N3MODE),N3MODE) = 2
43020 I3DRCF( NDI3BY(N3MODE),N3MODE) = 1
43021 I3MODE( NDI3BY(N3MODE),N3MODE) = 203+J
43023 A3MODE(K,NDI3BY(N3MODE),N3MODE) = HNN(K,J,L,L1)
43024 6 B3MODE(K,NDI3BY(N3MODE),N3MODE) = HFF(K,J,IFR)
43028 C-- and gauge boson diagrams if Z not on-shell
43029 IF(RMASS(IDK(I)).LT.MZ+RMASS(IDKPRD(1,I))) THEN
43030 NDI3BY(N3MODE) = NDI3BY(N3MODE)+1
43031 I3DRTP(NDI3BY(N3MODE),N3MODE) = 1
43032 I3DRCF(NDI3BY(N3MODE),N3MODE) = 1
43033 I3MODE(NDI3BY(N3MODE),N3MODE) = 200
43035 7 A3MODE(J,NDI3BY(N3MODE),N3MODE) = OIJPP(J,L,L1)
43036 B3MODE(1,NDI3BY(N3MODE),N3MODE) = -E*RFCH(IL)
43037 B3MODE(2,NDI3BY(N3MODE),N3MODE) = -E*LFCH(IL)
43039 ELSEIF(L.EQ.5.OR.L.EQ.6.AND.(IDKPRD(2,I).LE.12.OR.
43040 & (IDKPRD(2,I).GE.121.AND.IDKPRD(2,I).LE.132))) THEN
43041 C--then the neutralino modes to fermion-antifermion +ve chargino
43042 C--NB ISAJET ONLY HAS W EXCHANGE AND THEREFORE SO DO WE
43043 IF(RMASS(IDK(I)).GT.MW+RMASS(IDKPRD(1,I))) GOTO 2000
43046 IF(N3MODE.GT.NMODE3) THEN
43047 CALL HWWARN('HWISP3',110)
43051 NME(I) = 10000+N3MODE
43053 P3MODE(N3MODE) = ONE
43054 IF(IDKPRD(2,I).LE.12) P3MODE(N3MODE) = THREE
43055 SPN3CF(1,1,N3MODE) = ONE
43057 C--gauge boson diagram
43058 I3DRTP(1,N3MODE) = 1
43059 I3DRCF(1,N3MODE) = 1
43060 I3MODE(1,N3MODE) = 199
43062 8 A3MODE(J,1,N3MODE) = OIJ(J,L1,L)
43063 B3MODE(1,1,N3MODE) = ZERO
43064 B3MODE(2,1,N3MODE) = -G*ORT
43065 ELSEIF(L.EQ.7.OR.L.EQ.8.AND.(IDKPRD(2,I).LE.12.OR.
43066 & (IDKPRD(2,I).GE.121.AND.IDKPRD(2,I).LE.132))) THEN
43067 C--then the neutralino modes to fermion-antifermion -ve chargino
43068 C--NB ISAJET ONLY HAS W EXCHANGE AND THEREFORE SO DO WE
43069 IF(RMASS(IDK(I)).GT.MW+RMASS(IDKPRD(1,I))) GOTO 2000
43072 IF(N3MODE.GT.NMODE3) THEN
43073 CALL HWWARN('HWISP3',111)
43077 NME(I) = 10000+N3MODE
43079 P3MODE(N3MODE) = ONE
43080 IF(IDKPRD(2,I).LE.12) P3MODE(N3MODE) = THREE
43081 SPN3CF(1,1,N3MODE) = ONE
43083 C--gauge boson diagram
43084 I3DRTP(1,N3MODE) = 1
43085 I3DRCF(1,N3MODE) = 1
43086 I3MODE(1,N3MODE) = 198
43088 9 A3MODE(J,1,N3MODE) =-OIJ(O(J),L1,L)
43089 B3MODE(1,1,N3MODE) = ZERO
43090 B3MODE(2,1,N3MODE) = -G*ORT
43091 C--gravitino E+e- modes
43092 ELSEIF(L.EQ.9.AND.(IDKPRD(2,I).LE.12.OR.
43093 & (IDKPRD(2,I).GE.121.AND.IDKPRD(2,I).LE.132))) THEN
43095 J = INT((IFR-1)/120)
43096 IFR = IFR-6*INT((IFR-1)/6)+6*J
43099 IF(N3MODE.GT.NMODE3) THEN
43100 CALL HWWARN('HWISP3',112)
43104 NME(I) = 10000+N3MODE
43106 P3MODE(N3MODE) = ONE
43107 IF(IDKPRD(2,I).LE.12) P3MODE(N3MODE) = THREE
43108 SPN3CF(1,1,N3MODE) = ONE
43111 I3DRTP(1,N3MODE) = 7
43112 I3DRCF(1,N3MODE) = 1
43113 I3MODE(1,N3MODE) = 59
43114 A3MODE(1,1,N3MODE) = 2.0D0/SQRT(6.0D0)*ZMIXSS(L1,1)
43115 A3MODE(2,1,N3MODE) = 0
43116 B3MODE(1,1,N3MODE) = -E*QFCH(IL)
43117 B3MODE(2,1,N3MODE) = -E*QFCH(IL)
43118 C--R-parity violating modes
43120 ELSEIF(IDKPRD(1,I).GE.121.AND.IDKPRD(1,I).LE.132.AND.
43121 & IDKPRD(2,I).GE.121.AND.IDKPRD(2,I).LE.132.AND.
43122 & IDKPRD(3,I).GE.121.AND.IDKPRD(3,I).LE.132) THEN
43124 IF(N3MODE.GT.NMODE3) THEN
43125 CALL HWWARN('HWISP3',113)
43129 NME(I) = 10000+N3MODE
43131 P3MODE(N3MODE) = ONE
43132 SPN3CF(1,1,N3MODE) = ONE
43136 53 I3DRCF(J,N3MODE) = 1
43137 IF(IDPDG(IDKPRD(1,I)).GT.0) THEN
43138 III = (IDKPRD(1,I)-119)/2
43139 JJJ = (IDKPRD(2,I)-120)/2
43140 KKK = (IDKPRD(3,I)-125)/2
43142 I3DRTP(J ,N3MODE) = 2
43143 I3DRTP(J+2,N3MODE) = 4
43144 I3MODE(J ,N3MODE) = 423+2*III+(J-1)*12
43145 I3MODE(J+2,N3MODE) = 423+2*KKK+(J-1)*12
43146 B3MODE(1,J ,N3MODE) = LMIXSS(2*III-1,1,J)*
43147 & LAMDA1(III,JJJ,KKK)
43148 B3MODE(2,J ,N3MODE) = 0.0D0
43149 B3MODE(1,J+2,N3MODE) = LMIXSS(2*KKK-1,2,J)*
43150 & LAMDA1(III,JJJ,KKK)
43151 B3MODE(2,J+2,N3MODE) = 0.0D0
43153 A3MODE(K,J ,N3MODE) = AFN( K ,5+2*III,J,L1)
43154 51 A3MODE(K,J+2,N3MODE) = AFN(O(K),5+2*KKK,J,L1)
43156 48 A3MODE(K,5,N3MODE) = AFN( K ,6+2*JJJ,1,L1)
43157 I3DRTP(5,N3MODE) = 3
43158 I3MODE(5,N3MODE) = 430+2*JJJ
43159 B3MODE(1,5,N3MODE) = LAMDA1(III,JJJ,KKK)
43160 B3MODE(2,5,N3MODE) = 0.0D0
43161 C--antiparticle mode
43163 III = (IDKPRD(1,I)-125)/2
43164 JJJ = (IDKPRD(2,I)-126)/2
43165 KKK = (IDKPRD(3,I)-119)/2
43167 I3DRTP(J ,N3MODE) = 8
43168 I3DRTP(J+2,N3MODE) = 10
43169 I3MODE(J ,N3MODE) = 423+2*III+(J-1)*12
43170 I3MODE(J+2,N3MODE) = 423+2*KKK+(J-1)*12
43171 B3MODE(2,J ,N3MODE) = LMIXSS(2*III-1,1,J)*
43172 & LAMDA1(III,JJJ,KKK)
43173 B3MODE(1,J ,N3MODE) = 0.0D0
43174 B3MODE(2,J+2,N3MODE) = LMIXSS(2*KKK-1,2,J)*
43175 & LAMDA1(III,JJJ,KKK)
43176 B3MODE(1,J+2,N3MODE) = 0.0D0
43178 A3MODE(K,J ,N3MODE) = AFN(O(K),5+2*III,J,L1)
43179 52 A3MODE(K,J+2,N3MODE) = AFN( K ,5+2*KKK,J,L1)
43181 49 A3MODE(K,5,N3MODE) = AFN(O(K),6+2*JJJ,1,L1)
43182 I3DRTP(5,N3MODE) = 9
43183 I3MODE(5,N3MODE) = 430+2*JJJ
43184 B3MODE(2,5,N3MODE) = LAMDA1(III,JJJ,KKK)
43185 B3MODE(1,5,N3MODE) = 0.0D0
43188 ELSEIF(IDKPRD(1,I).GE.121.AND.IDKPRD(1,I).LE.132.AND.
43189 & IDKPRD(2,I).LE.12 .AND.IDKPRD(3,I).LE.12) THEN
43191 IF(N3MODE.GT.NMODE3) THEN
43192 CALL HWWARN('HWISP3',114)
43196 NME(I) = 10000+N3MODE
43197 P3MODE(N3MODE) = 3.0D0
43198 SPN3CF(1,1,N3MODE) = ONE
43201 81 I3DRCF(J,N3MODE) = 1
43202 C--first the neutrino mode
43203 IF(MOD(IDKPRD(1,I),2).EQ.0) THEN
43206 IF(IDPDG(IDKPRD(1,I)).GT.0) THEN
43207 III = (IDKPRD(1,I)-120)/2
43208 JJJ = (IDKPRD(2,I)+1)/2
43209 KKK = (IDKPRD(3,I)-5)/2
43211 I3DRTP(K ,N3MODE) = 3
43212 I3DRTP(K+2,N3MODE) = 4
43213 I3MODE(K ,N3MODE) = 399+2*JJJ+(K-1)*12
43214 I3MODE(K+2,N3MODE) = 399+2*KKK+(K-1)*12
43215 B3MODE(2,K ,N3MODE) = 0.0D0
43216 B3MODE(1,K ,N3MODE) = -QMIXSS(2*JJJ-1,1,K)*
43217 & LAMDA2(III,JJJ,KKK)
43218 B3MODE(2,K+2,N3MODE) = 0.0D0
43219 B3MODE(1,K+2,N3MODE) = -QMIXSS(2*KKK-1,2,K)*
43220 & LAMDA2(III,JJJ,KKK)
43222 A3MODE(J,K ,N3MODE) = AFN( J ,2*JJJ-1,K,L1)
43223 82 A3MODE(J,K+2,N3MODE) = AFN(O(J),2*KKK-1,K,L1)
43224 I3DRTP(5,N3MODE) = 2
43225 I3MODE(5,N3MODE) = 424+2*III
43226 B3MODE(2,5,N3MODE) = 0.0D0
43227 B3MODE(1,5,N3MODE) = -LAMDA2(III,JJJ,KKK)
43229 83 A3MODE(J,5,N3MODE) = AFN(J,6+2*III,1,L1)
43230 C--antiparticle mode
43232 III = (IDKPRD(1,I)-126)/2
43233 JJJ = (IDKPRD(2,I)-5)/2
43234 KKK = (IDKPRD(3,I)+1)/2
43236 I3DRTP(K ,N3MODE) = 9
43237 I3DRTP(K+2,N3MODE) = 10
43238 I3MODE(K ,N3MODE) = 399+2*JJJ+(K-1)*12
43239 I3MODE(K+2,N3MODE) = 399+2*KKK+(K-1)*12
43240 B3MODE(1,K ,N3MODE) = 0.0D0
43241 B3MODE(2,K ,N3MODE) = -QMIXSS(2*JJJ-1,1,K)*
43242 & LAMDA2(III,JJJ,KKK)
43243 B3MODE(1,K+2,N3MODE) = 0.0D0
43244 B3MODE(2,K+2,N3MODE) = -QMIXSS(2*KKK-1,2,K)*
43245 & LAMDA2(III,JJJ,KKK)
43247 A3MODE(J,K ,N3MODE) = AFN(O(J),2*JJJ-1,K,L1)
43248 84 A3MODE(J,K+2,N3MODE) = AFN( J ,2*KKK-1,K,L1)
43249 I3DRTP(5,N3MODE) = 8
43250 I3MODE(5,N3MODE) = 424+2*III
43251 B3MODE(1,5,N3MODE) = 0.0D0
43252 B3MODE(2,5,N3MODE) = -LAMDA2(III,JJJ,KKK)
43254 85 A3MODE(J,5,N3MODE) = AFN(O(J),6+2*III,1,L1)
43256 C--then the charged lepton mode
43260 IF(IDPDG(IDKPRD(1,I)).GT.0) THEN
43261 III = (IDKPRD(1,I)-119)/2
43262 JJJ = IDKPRD(2,I)/2
43263 KKK = (IDKPRD(3,I)-5)/2
43265 I3DRTP(K ,N3MODE) = 2
43266 I3DRTP(K+2,N3MODE) = 3
43267 I3DRTP(K+4,N3MODE) = 4
43268 I3MODE(K ,N3MODE) = 423+2*III+(K-1)*12
43269 I3MODE(K+2,N3MODE) = 400+2*JJJ+(K-1)*12
43270 I3MODE(K+4,N3MODE) = 399+2*KKK+(K-1)*12
43271 B3MODE(2,K ,N3MODE) = 0.0D0
43272 B3MODE(1,K ,N3MODE) = LMIXSS(2*III-1,1,K)*
43273 & LAMDA2(III,JJJ,KKK)
43274 B3MODE(2,K+2,N3MODE) = 0.0D0
43275 B3MODE(1,K+2,N3MODE) = QMIXSS(2*JJJ,1,K)*
43276 & LAMDA2(III,JJJ,KKK)
43277 B3MODE(2,K+4,N3MODE) = 0.0D0
43278 B3MODE(1,K+4,N3MODE) = QMIXSS(2*KKK-1,2,K)*
43279 & LAMDA2(III,JJJ,KKK)
43281 A3MODE(J,K ,N3MODE) = AFN( J ,2*III+5,K,L1)
43282 A3MODE(J,K+2,N3MODE) = AFN( J ,2*JJJ ,K,L1)
43283 86 A3MODE(J,K+4,N3MODE) = AFN(O(J),2*KKK-1,K,L1)
43284 C--antiparticle mode
43286 III = (IDKPRD(1,I)-125)/2
43287 JJJ = (IDKPRD(2,I)-6)/2
43288 KKK = (IDKPRD(3,I)+1)/2
43290 I3DRTP(K ,N3MODE) = 8
43291 I3DRTP(K+2,N3MODE) = 9
43292 I3DRTP(K+4,N3MODE) = 10
43293 I3MODE(K ,N3MODE) = 423+2*III+(K-1)*12
43294 I3MODE(K+2,N3MODE) = 400+2*JJJ+(K-1)*12
43295 I3MODE(K+4,N3MODE) = 399+2*KKK+(K-1)*12
43296 B3MODE(1,K ,N3MODE) = 0.0D0
43297 B3MODE(2,K ,N3MODE) = LMIXSS(2*III-1,1,K)*
43298 & LAMDA2(III,JJJ,KKK)
43299 B3MODE(1,K+2,N3MODE) = 0.0D0
43300 B3MODE(2,K+2,N3MODE) = QMIXSS(2*JJJ,1,K)*
43301 & LAMDA2(III,JJJ,KKK)
43302 B3MODE(1,K+4,N3MODE) = 0.0D0
43303 B3MODE(2,K+4,N3MODE) = QMIXSS(2*KKK-1,2,K)*
43304 & LAMDA2(III,JJJ,KKK)
43306 A3MODE(J,K ,N3MODE) = AFN(O(J),2*III+5,K,L1)
43307 A3MODE(J,K+2,N3MODE) = AFN(O(J),2*JJJ ,K,L1)
43308 87 A3MODE(J,K+4,N3MODE) = AFN( J ,2*KKK-1,K,L1)
43312 ELSEIF(IDKPRD(1,I).LE.12.AND.IDKPRD(2,I).LE.12.AND.
43313 & IDKPRD(3,I).LE.12) THEN
43315 IF(N3MODE.GT.NMODE3) THEN
43316 CALL HWWARN('HWISP3',115)
43320 NME(I) = 10000+N3MODE
43322 P3MODE(N3MODE) = 6.0D0
43323 SPN3CF(1,1,N3MODE) = ONE
43326 61 I3DRCF(J,N3MODE) = 1
43328 IF(IDPDG(IDKPRD(1,I)).GT.0) THEN
43329 III = IDKPRD(1,I)/2
43330 JJJ = (IDKPRD(2,I)+1)/2
43331 KKK = (IDKPRD(3,I)+1)/2
43333 I3DRTP(J ,N3MODE) = 11
43334 I3DRTP(J+2,N3MODE) = 12
43335 I3DRTP(J+4,N3MODE) = 13
43336 I3MODE(J ,N3MODE) = 400+2*III+(J-1)*12
43337 I3MODE(J+2,N3MODE) = 399+2*JJJ+(J-1)*12
43338 I3MODE(J+4,N3MODE) = 399+2*KKK+(J-1)*12
43339 B3MODE(2,J ,N3MODE) = QMIXSS(2*III,2,J)*
43340 & LAMDA3(III,JJJ,KKK)
43341 B3MODE(2,J+2,N3MODE) = QMIXSS(2*JJJ-1,2,J)*
43342 & LAMDA3(III,JJJ,KKK)
43343 B3MODE(2,J+4,N3MODE) = QMIXSS(2*KKK-1,2,J)*
43344 & LAMDA3(III,JJJ,KKK)
43345 B3MODE(1,J ,N3MODE) = 0.0D0
43346 B3MODE(1,J+2,N3MODE) = 0.0D0
43347 B3MODE(1,J+4,N3MODE) = 0.0D0
43349 A3MODE(K,J ,N3MODE) = AFN(K,2*III ,J,L1)
43350 A3MODE(K,J+2,N3MODE) = AFN(K,2*JJJ-1,J,L1)
43351 62 A3MODE(K,J+4,N3MODE) = AFN(K,2*KKK-1,J,L1)
43352 C--antiparticle mode
43354 III = (IDKPRD(1,I)-6)/2
43355 JJJ = (IDKPRD(2,I)-5)/2
43356 KKK = (IDKPRD(3,I)-5)/2
43358 I3DRTP(J ,N3MODE) = 14
43359 I3DRTP(J+2,N3MODE) = 15
43360 I3DRTP(J+4,N3MODE) = 16
43361 I3MODE(J ,N3MODE) = 400+2*III+(J-1)*12
43362 I3MODE(J+2,N3MODE) = 399+2*JJJ+(J-1)*12
43363 I3MODE(J+4,N3MODE) = 399+2*KKK+(J-1)*12
43364 B3MODE(2,J ,N3MODE) = 0.0D0
43365 B3MODE(2,J+2,N3MODE) = 0.0D0
43366 B3MODE(2,J+4,N3MODE) = 0.0D0
43367 B3MODE(1,J ,N3MODE) = QMIXSS(2*III,2,J)*
43368 & LAMDA3(III,JJJ,KKK)
43369 B3MODE(1,J+2,N3MODE) = QMIXSS(2*JJJ-1,2,J)*
43370 & LAMDA3(III,JJJ,KKK)
43371 B3MODE(1,J+4,N3MODE) = QMIXSS(2*KKK-1,2,J)*
43372 & LAMDA3(III,JJJ,KKK)
43374 A3MODE(K,J ,N3MODE) = AFN(O(K),2*III ,J,L1)
43375 A3MODE(K,J+2,N3MODE) = AFN(O(K),2*JJJ-1,J,L1)
43376 63 A3MODE(K,J+4,N3MODE) = AFN(O(K),2*KKK-1,J,L1)
43378 C--unrecognized decay issue warning
43380 CALL HWWARN('HWISP3',2)
43382 ELSEIF(IDK(I).GE.454.AND.IDK(I).LE.455) THEN
43383 C--+ve chargino modes
43384 C--first the chargino modes to fermion-antifermion neutralino
43385 IF(L.GE.1.AND.L.LE.4.AND.(IDKPRD(2,I).LE.12.OR.
43386 & (IDKPRD(2,I).GE.121.AND.IDKPRD(2,I).LE.132))) THEN
43388 IFR = IFR+MOD(IFR,2)
43389 J = INT((IFR-1)/120)
43390 IFR = IFR-6*INT((IFR-1)/6)+6*J
43395 IF(N3MODE.GT.NMODE3) THEN
43396 CALL HWWARN('HWISP3',116)
43400 NME(I) = 10000+N3MODE
43402 P3MODE(N3MODE) = ONE
43403 IF(IDKPRD(2,I).LE.12) P3MODE(N3MODE) = THREE
43404 SPN3CF(1,1,N3MODE) = ONE
43406 C--sfermion exchange diagrams
43408 I3DRTP(K ,N3MODE) = 3
43409 I3DRCF(K ,N3MODE) = 1
43410 I3DRTP(K+2,N3MODE) = 4
43411 I3DRCF(K+2,N3MODE) = 1
43412 I3MODE(K ,N3MODE) = 12*(K-1)+405+SIFR
43413 I3MODE(K+2,N3MODE) = 12*(K-1)+400+SIFR
43415 A3MODE(J,K ,N3MODE) = AFC( J ,IFR-1,K,L1)
43416 B3MODE(J,K ,N3MODE) = AFN(O(J),IFR-1,K,L )
43417 A3MODE(J,K+2,N3MODE) = AFC(O(J),IFR ,K,L1)
43418 10 B3MODE(J,K+2,N3MODE) = AFN( J ,IFR ,K,L )
43419 C--gauge boson diagram
43420 IF(RMASS(IDK(I)).LT.MW+RMASS(IDKPRD(1,I))) THEN
43421 NDI3BY(N3MODE) = NDI3BY(N3MODE)+1
43422 I3DRTP(NDI3BY(N3MODE),N3MODE) = 1
43423 I3DRCF(NDI3BY(N3MODE),N3MODE) = 1
43424 I3MODE(NDI3BY(N3MODE),N3MODE) = 198
43426 11 A3MODE(J,NDI3BY(N3MODE),N3MODE) = OIJ(J,L,L1)
43427 B3MODE(1,NDI3BY(N3MODE),N3MODE) = ZERO
43428 B3MODE(2,NDI3BY(N3MODE),N3MODE) = -G*ORT
43430 C--then the chargino modes to fermion-antifermion chargino
43431 ELSEIF(L.GE.5.AND.L.LE.8.AND.(IDKPRD(2,I).LE.12.OR.
43432 & (IDKPRD(2,I).GE.121.AND.IDKPRD(2,I).LE.132))) THEN
43435 J = INT((IFR-1)/120)
43436 IFR = IFR-6*INT((IFR-1)/6)+6*J
43439 IF(MOD(IFR,2).EQ.0) THEN
43448 IF(N3MODE.GT.NMODE3) THEN
43449 CALL HWWARN('HWISP3',117)
43453 NME(I) = 10000+N3MODE
43455 P3MODE(N3MODE) = ONE
43456 IF(IDKPRD(2,I).LE.12) P3MODE(N3MODE) = THREE
43457 SPN3CF(1,1,N3MODE) = ONE
43459 C--sfermion exchange diagrams
43460 IF(MOD(IL,2).EQ.0) THEN
43462 I3DRTP(K,N3MODE) = 3
43463 I3DRCF(K,N3MODE) = 1
43464 I3MODE(K,N3MODE) = 12*(K-1)+400+SIFR
43466 A3MODE(J,K,N3MODE) = AFC( J ,IFR,K,L1)
43467 12 B3MODE(J,K,N3MODE) = AFC(O(J),IFR,K,L )
43470 I3DRTP(K,N3MODE) = 4
43471 I3DRCF(K,N3MODE) = 1
43472 I3MODE(K,N3MODE) = 12*(K-1)+400+SIFR
43474 A3MODE(J,K,N3MODE) = AFC(O(J),IFR,K,L1)
43475 13 B3MODE(J,K,N3MODE) = AFC( J ,IFR,K,L )
43477 C--gauge boson diagram
43478 IF(RMASS(IDK(I)).LT.MZ+RMASS(IDKPRD(1,I))) THEN
43479 NDI3BY(N3MODE) = NDI3BY(N3MODE)+1
43480 I3DRTP(NDI3BY(N3MODE),N3MODE) = 1
43481 I3DRCF(NDI3BY(N3MODE),N3MODE) = 1
43482 I3MODE(NDI3BY(N3MODE),N3MODE) = 200
43484 14 A3MODE(J,NDI3BY(N3MODE),N3MODE) = OIJP(J,L,L1)
43485 B3MODE(1,NDI3BY(N3MODE),N3MODE) = -E*RFCH(IL)
43486 B3MODE(2,NDI3BY(N3MODE),N3MODE) = -E*LFCH(IL)
43488 C--R-parity violating decays
43490 ELSEIF(IDKPRD(1,I).GE.121.AND.IDKPRD(1,I).LE.132.AND.
43491 & IDKPRD(2,I).GE.121.AND.IDKPRD(2,I).LE.132.AND.
43492 & IDKPRD(1,I).GE.121.AND.IDKPRD(3,I).LE.132) THEN
43494 C--neutrino lepton neutrino
43495 IF(MOD(IDKPRD(1,I),2).EQ.0.AND.MOD(IDKPRD(2,I),2).EQ.1.AND.
43496 & MOD(IDKPRD(3,I),2).EQ.0) THEN
43498 IF(N3MODE.GT.NMODE3) THEN
43499 CALL HWWARN('HWISP3',118)
43503 NME(I) = 10000+N3MODE
43505 P3MODE(N3MODE) = ONE
43507 SPN3CF(1,1,N3MODE) = ONE
43508 III = (IDKPRD(1,I)-126)/2
43509 JJJ = (IDKPRD(2,I)-125)/2
43510 KKK = (IDKPRD(3,I)-120)/2
43512 I3DRTP(K,N3MODE) = 10
43513 I3DRCF(K,N3MODE) = 1
43514 I3MODE(K,N3MODE) = 423+2*KKK+12*(K-1)
43515 B3MODE(1,K,N3MODE) = 0.0D0
43516 B3MODE(2,K,N3MODE)=LAMDA1(III,JJJ,KKK)*LMIXSS(2*KKK-1,2,K)
43518 54 A3MODE(J,K,N3MODE) = AFC(J,5+2*KKK,K,L1)
43519 C--neutrino neutrino lepton
43520 ELSEIF(MOD(IDKPRD(1,I),2).EQ.0.AND.MOD(IDKPRD(2,I),2).EQ.0
43521 & .AND.MOD(IDKPRD(3,I),2).EQ.1) THEN
43523 IF(N3MODE.GT.NMODE3) THEN
43524 CALL HWWARN('HWISP3',119)
43528 NME(I) = 10000+N3MODE
43530 P3MODE(N3MODE) = ONE
43532 SPN3CF(1,1,N3MODE) = ONE
43533 III = (IDKPRD(1,I)-120)/2
43534 JJJ = (IDKPRD(2,I)-120)/2
43535 KKK = (IDKPRD(3,I)-125)/2
43537 I3DRTP(K ,N3MODE) = 2
43538 I3DRTP(K+2,N3MODE) = 3
43539 I3DRCF(K ,N3MODE) = 1
43540 I3DRCF(K+2,N3MODE) = 1
43541 I3MODE(K ,N3MODE) = 423+2*III+12*(K-1)
43542 I3MODE(K+2,N3MODE) = 423+2*JJJ+12*(K-1)
43543 B3MODE(1,K,N3MODE) = LAMDA1(III,JJJ,KKK)*
43544 & LMIXSS(2*III-1,1,K)
43545 B3MODE(2,K,N3MODE) = 0.0D0
43546 B3MODE(1,K+2,N3MODE) =-LAMDA1(III,JJJ,KKK)*
43547 & LMIXSS(2*JJJ-1,1,K)
43548 B3MODE(2,K+2,N3MODE) = 0.0D0
43550 A3MODE(J,K,N3MODE) = AFC(J,5+2*III,K,L1)
43551 55 A3MODE(J,K+2,N3MODE) = AFC(J,5+2*JJJ,K,L1)
43552 C--lepton lepton lepton
43553 ELSEIF(MOD(IDKPRD(1,I),2).EQ.1.AND.MOD(IDKPRD(2,I),2).EQ.1
43554 & .AND.MOD(IDKPRD(3,I),2).EQ.1) THEN
43556 IF(N3MODE.GT.NMODE3) THEN
43557 CALL HWWARN('HWISP3',120)
43561 NME(I) = 10000+N3MODE
43563 P3MODE(N3MODE) = ONE
43565 SPN3CF(1,1,N3MODE) = ONE
43566 III = (IDKPRD(1,I)-125)/2
43567 JJJ = (IDKPRD(2,I)-125)/2
43568 KKK = (IDKPRD(3,I)-119)/2
43569 I3DRTP(1,N3MODE) = 8
43570 I3DRTP(2,N3MODE) = 9
43571 I3DRCF(1,N3MODE) = 1
43572 I3DRCF(2,N3MODE) = 1
43573 I3MODE(1,N3MODE) = 424+2*III
43574 I3MODE(2,N3MODE) = 424+2*JJJ
43575 B3MODE(1,1,N3MODE) = 0.0D0
43576 B3MODE(2,1,N3MODE) = LAMDA1(III,JJJ,KKK)
43577 B3MODE(1,2,N3MODE) = 0.0D0
43578 B3MODE(2,2,N3MODE) =-LAMDA1(III,JJJ,KKK)
43580 A3MODE(J,1,N3MODE) = AFC(O(J),6+2*III,1,L1)
43581 56 A3MODE(J,2,N3MODE) = AFC(O(J),6+2*JJJ,1,L1)
43583 CALL HWWARN('HWISP3',3)
43586 ELSEIF(IDKPRD(1,I).GE.121.AND.IDKPRD(1,I).LE.132.AND.
43587 & IDKPRD(2,I).LE.12 .AND.IDKPRD(3,I).LE. 12) THEN
43590 IF(IDKPRD(1,I).GE.128.AND.MOD(IDKPRD(1,I),2).EQ.0) THEN
43592 IF(N3MODE.GT.NMODE3) THEN
43593 CALL HWWARN('HWISP3',121)
43597 NME(I) = 10000+N3MODE
43599 P3MODE(N3MODE) = THREE
43601 SPN3CF(1,1,N3MODE) = ONE
43602 III = (IDKPRD(1,I)-126)/2
43603 JJJ = (IDKPRD(2,I)-5)/2
43604 KKK = IDKPRD(3,I)/2
43606 I3DRTP(K,N3MODE) = 10
43607 I3DRCF(K,N3MODE) = 1
43608 I3MODE(K,N3MODE) = 399+2*KKK+12*(K-1)
43609 B3MODE(1,K,N3MODE) = 0.0D0
43610 B3MODE(2,K,N3MODE) = QMIXSS(2*KKK-1,2,K)*
43611 & LAMDA2(III,JJJ,KKK)
43613 88 A3MODE(J,K,N3MODE) = AFC(J,2*KKK-1,K,L1)
43615 ELSEIF(IDKPRD(1,I).GE.127.AND.MOD(IDKPRD(1,I),2).EQ.1.AND.
43616 & MOD(IDKPRD(2,I),2).EQ.0) THEN
43618 IF(N3MODE.GT.NMODE3) THEN
43619 CALL HWWARN('HWISP3',122)
43623 NME(I) = 10000+N3MODE
43625 P3MODE(N3MODE) = THREE
43627 SPN3CF(1,1,N3MODE) = ONE
43628 III = (IDKPRD(1,I)-125)/2
43629 JJJ = (IDKPRD(2,I)-6)/2
43630 KKK = IDKPRD(3,I)/2
43632 I3DRTP(K,N3MODE) = 10
43633 I3DRCF(K,N3MODE) = 1
43634 I3MODE(K,N3MODE) = 399+2*KKK+12*(K-1)
43635 B3MODE(1,K,N3MODE) = 0.0D0
43636 B3MODE(2,K,N3MODE) = QMIXSS(2*KKK-1,2,K)*
43637 & LAMDA2(III,JJJ,KKK)
43639 89 A3MODE(J,K,N3MODE) = AFC(J,2*KKK-1,K,L1)
43641 ELSEIF(IDKPRD(1,I).GE.127.AND.MOD(IDKPRD(1,I),2).EQ.1.AND.
43642 & MOD(IDKPRD(2,I),2).EQ.1) THEN
43644 IF(N3MODE.GT.NMODE3) THEN
43645 CALL HWWARN('HWISP3',123)
43649 NME(I) = 10000+N3MODE
43651 P3MODE(N3MODE) = THREE
43653 SPN3CF(1,1,N3MODE) = ONE
43654 III = (IDKPRD(1,I)-125)/2
43655 JJJ = (IDKPRD(2,I)-5)/2
43656 KKK = (IDKPRD(3,I)+1)/2
43657 I3DRTP(1,N3MODE) = 8
43658 I3DRCF(1,N3MODE) = 1
43659 I3MODE(1,N3MODE) = 424+2*III
43660 B3MODE(1,1,N3MODE) = 0.0D0
43661 B3MODE(2,1,N3MODE) = -LAMDA2(III,JJJ,KKK)
43663 91 A3MODE(J,1,N3MODE) = AFC(O(J),2*III+6,1,L1)
43665 I3DRTP(K+1,N3MODE) = 9
43666 I3DRCF(K+1,N3MODE) = 1
43667 I3MODE(K+1,N3MODE) = 400+2*JJJ+12*(K-1)
43668 B3MODE(1,K+1,N3MODE) = 0.0D0
43669 B3MODE(2,K+1,N3MODE) = QMIXSS(2*JJJ,1,K)*
43670 & LAMDA2(III,JJJ,KKK)
43672 92 A3MODE(J,K+1,N3MODE) = AFC(O(J),2*JJJ,K,L1)
43674 ELSEIF(IDKPRD(1,I).LE.126.AND.MOD(IDKPRD(1,I),2).EQ.0) THEN
43676 IF(N3MODE.GT.NMODE3) THEN
43677 CALL HWWARN('HWISP3',124)
43681 NME(I) = 10000+N3MODE
43683 P3MODE(N3MODE) = THREE
43685 SPN3CF(1,1,N3MODE) = ONE
43686 III = (IDKPRD(1,I)-120)/2
43687 JJJ = IDKPRD(2,I)/2
43688 KKK = (IDKPRD(3,I)-5)/2
43690 I3DRTP(K ,N3MODE) = 2
43691 I3DRTP(K+2,N3MODE) = 3
43692 I3DRCF(K ,N3MODE) = 1
43693 I3DRCF(K+2,N3MODE) = 1
43694 I3MODE(K ,N3MODE) = 423+2*III+12*(K-1)
43695 I3MODE(K+2,N3MODE) = 399+2*JJJ+12*(K-1)
43696 B3MODE(1,K ,N3MODE) = LMIXSS(2*III-1,1,K)*
43697 & LAMDA2(III,JJJ,KKK)
43698 B3MODE(2,K ,N3MODE) = 0.0D0
43699 B3MODE(1,K+2,N3MODE) = -QMIXSS(2*JJJ-1,1,K)*
43700 & LAMDA2(III,JJJ,KKK)
43701 B3MODE(2,K+2,N3MODE) = 0.0D0
43703 A3MODE(J,K ,N3MODE) = AFC(J,2*III+5,K,L1)
43704 90 A3MODE(J,K+2,N3MODE) = AFC(J,2*JJJ-1,K,L1)
43707 CALL HWWARN('HWISP3',4)
43710 ELSEIF(IDKPRD(1,I).LE.12.AND.IDKPRD(2,I).LE.12.AND.
43711 & IDKPRD(3,I).LE.12) THEN
43713 C--dbar dbar dbar mode
43714 IF(MOD(IDKPRD(1,I),2).EQ.1.AND.MOD(IDKPRD(2,I),2).EQ.1.AND.
43715 & MOD(IDKPRD(3,I),2).EQ.1) THEN
43717 IF(N3MODE.GT.NMODE3) THEN
43718 CALL HWWARN('HWISP3',125)
43722 NME(I) = 10000+N3MODE
43725 SPN3CF(1,1,N3MODE) = ONE
43726 III = (IDKPRD(1,I)-5)/2
43727 JJJ = (IDKPRD(2,I)-5)/2
43728 KKK = (IDKPRD(3,I)-5)/2
43729 P3MODE(N3MODE) = ONE
43730 IF(III.EQ.JJJ) P3MODE(N3MODE) = P3MODE(N3MODE)+ONE
43731 IF(JJJ.EQ.KKK) P3MODE(N3MODE) = P3MODE(N3MODE)+ONE
43732 IF(III.EQ.KKK) P3MODE(N3MODE) = P3MODE(N3MODE)+ONE
43733 P3MODE(N3MODE) = 6.0D0/P3MODE(N3MODE)
43735 66 I3DRCF(K,N3MODE) = 1
43737 I3DRTP(K ,N3MODE) = 14
43738 I3DRTP(K+2,N3MODE) = 15
43739 I3DRTP(K+4,N3MODE) = 16
43740 I3MODE(K ,N3MODE) = 400+2*III+(K-1)*12
43741 I3MODE(K+2,N3MODE) = 400+2*JJJ+(K-1)*12
43742 I3MODE(K+4,N3MODE) = 400+2*KKK+(K-1)*12
43743 B3MODE(1,K ,N3MODE) = QMIXSS(2*III,2,K)*
43744 & LAMDA3(III,JJJ,KKK)
43745 B3MODE(2,K ,N3MODE) = 0.0D0
43746 B3MODE(1,K+2,N3MODE) =-QMIXSS(2*JJJ,2,K)*
43747 & LAMDA3(JJJ,III,KKK)
43748 B3MODE(2,K+2,N3MODE) = 0.0D0
43749 B3MODE(1,K+4,N3MODE) = QMIXSS(2*KKK,2,K)*
43750 & LAMDA3(KKK,III,JJJ)
43751 B3MODE(2,K+4,N3MODE) = 0.0D0
43753 A3MODE(J,K ,N3MODE) = AFC(O(J),2*III,K,L1)
43754 A3MODE(J,K+2,N3MODE) = AFC(O(J),2*JJJ,K,L1)
43755 65 A3MODE(J,K+4,N3MODE) = AFC(O(J),2*KKK,K,L1)
43757 ELSEIF(MOD(IDKPRD(1,I),2).EQ.0.AND.MOD(IDKPRD(2,I),2).EQ.0
43758 & .AND.MOD(IDKPRD(3,I),2).EQ.1) THEN
43760 IF(N3MODE.GT.NMODE3) THEN
43761 CALL HWWARN('HWISP3',126)
43765 NME(I) = 10000+N3MODE
43767 P3MODE(N3MODE) = 6.0D0
43769 SPN3CF(1,1,N3MODE) = ONE
43770 III = IDKPRD(1,I)/2
43771 JJJ = IDKPRD(2,I)/2
43772 KKK = (IDKPRD(3,I)+1)/2
43773 IF(III.EQ.JJJ) P3MODE(N3MODE) = HALF*P3MODE(N3MODE)
43775 I3DRTP(K ,N3MODE) = 11
43776 I3DRTP(K+2,N3MODE) = 12
43777 I3DRCF(K ,N3MODE) = 1
43778 I3DRCF(K+2,N3MODE) = 1
43779 I3MODE(K ,N3MODE) = 399+2*III+(K-1)*12
43780 I3MODE(K+2,N3MODE) = 399+2*JJJ+(K-1)*12
43781 B3MODE(1,K ,N3MODE) = 0.0D0
43782 B3MODE(2,K ,N3MODE) = QMIXSS(2*III-1,2,K)*
43783 & LAMDA3(JJJ,III,KKK)
43784 c B3MODE(2,K,N3MODE) = 0.0D0
43785 B3MODE(1,K+2,N3MODE) = 0.0D0
43786 B3MODE(2,K+2,N3MODE) =-QMIXSS(2*JJJ-1,2,K)*
43787 & LAMDA3(III,JJJ,KKK)
43789 A3MODE(J,K ,N3MODE) = AFC(J,2*III-1,K,L1)
43790 64 A3MODE(J,K+2,N3MODE) = AFC(J,2*JJJ-1,K,L1)
43791 C--unrecognized decay issue warning
43793 CALL HWWARN('HWISP3',5)
43795 C--unrecognized decay issue warning
43797 CALL HWWARN('HWISP3',6)
43799 ELSEIF(IDK(I).GE.456.AND.IDK(I).LE.457) THEN
43800 C-- -ve chargino modes last
43801 C--first the chargino modes to fermion-antifermion neutralino
43802 IF(L.GE.1.AND.L.LE.4.AND.(IDKPRD(2,I).LE.12.OR.
43803 & (IDKPRD(2,I).GE.121.AND.IDKPRD(2,I).LE.132))) THEN
43805 IFR = IFR+MOD(IFR,2)
43806 J = INT((IFR-1)/120)
43807 IFR = IFR-6*INT((IFR-1)/6)+6*J
43812 IF(N3MODE.GT.NMODE3) THEN
43813 CALL HWWARN('HWISP3',127)
43817 NME(I) = 10000+N3MODE
43819 P3MODE(N3MODE) = ONE
43820 IF(IDKPRD(2,I).LE.12) P3MODE(N3MODE) = THREE
43821 SPN3CF(1,1,N3MODE) = ONE
43823 C--sfermion exchange diagrams
43825 I3DRTP(K ,N3MODE) = 3
43826 I3DRCF(K ,N3MODE) = 1
43827 I3DRTP(K+2,N3MODE) = 4
43828 I3DRCF(K+2,N3MODE) = 1
43829 I3MODE(K ,N3MODE) = 12*(K-1)+406+SIFR
43830 I3MODE(K+2,N3MODE) = 12*(K-1)+399+SIFR
43832 A3MODE(J,K ,N3MODE) = AFC( J ,IFR ,K,L1)
43833 B3MODE(J,K ,N3MODE) = AFN(O(J),IFR ,K,L )
43834 A3MODE(J,K+2,N3MODE) = AFC(O(J),IFR-1,K,L1)
43835 15 B3MODE(J,K+2,N3MODE) = AFN( J ,IFR-1,K,L )
43836 C--gauge boson diagram
43837 IF(RMASS(IDK(I)).LT.MW+RMASS(IDKPRD(1,I))) THEN
43838 NDI3BY(N3MODE) = NDI3BY(N3MODE)+1
43839 I3DRTP(NDI3BY(N3MODE),N3MODE) = 1
43840 I3DRCF(NDI3BY(N3MODE),N3MODE) = 1
43841 I3MODE(NDI3BY(N3MODE),N3MODE) = 199
43843 16 A3MODE(J,NDI3BY(N3MODE),N3MODE) =-OIJ(O(J),L,L1)
43844 B3MODE(1,NDI3BY(N3MODE),N3MODE) = ZERO
43845 B3MODE(2,NDI3BY(N3MODE),N3MODE) = -G*ORT
43847 C--then the chargino modes to fermion-antifermion chargino
43848 ELSEIF(L.GE.5.AND.L.LE.8.AND.(IDKPRD(2,I).LE.12.OR.
43849 & (IDKPRD(2,I).GE.121.AND.IDKPRD(2,I).LE.132))) THEN
43852 J = INT((IFR-1)/120)
43853 IFR = IFR-6*INT((IFR-1)/6)+6*J
43856 IF(MOD(IFR,2).EQ.0) THEN
43865 IF(N3MODE.GT.NMODE3) THEN
43866 CALL HWWARN('HWISP3',128)
43870 NME(I) = 10000+N3MODE
43872 P3MODE(N3MODE) = ONE
43873 IF(IDKPRD(2,I).LE.12) P3MODE(N3MODE) = THREE
43874 SPN3CF(1,1,N3MODE) = ONE
43876 C--sfermion exchange diagrams
43877 IF(MOD(IL,2).EQ.0) THEN
43879 I3DRTP(K,N3MODE) = 4
43880 I3DRCF(K,N3MODE) = 1
43881 I3MODE(K,N3MODE) = 12*(K-1)+400+SIFR
43883 A3MODE(J,K,N3MODE) = AFC(O(J),IFR,K,L1)
43884 17 B3MODE(J,K,N3MODE) = AFC( J ,IFR,K,L )
43887 I3DRTP(K,N3MODE) = 3
43888 I3DRCF(K,N3MODE) = 1
43889 I3MODE(K,N3MODE) = 12*(K-1)+400+SIFR
43891 A3MODE(J,K,N3MODE) = AFC( J ,IFR,K,L1)
43892 18 B3MODE(J,K,N3MODE) = AFC(O(J),IFR,K,L )
43894 C--gauge boson diagram
43895 IF(RMASS(IDK(I)).LT.MZ+RMASS(IDKPRD(1,I))) THEN
43896 NDI3BY(N3MODE) = NDI3BY(N3MODE)+1
43897 I3DRTP(NDI3BY(N3MODE),N3MODE) = 1
43898 I3DRCF(NDI3BY(N3MODE),N3MODE) = 1
43899 I3MODE(NDI3BY(N3MODE),N3MODE) = 200
43901 19 A3MODE(J,NDI3BY(N3MODE),N3MODE) =-OIJP(O(J),L,L1)
43902 B3MODE(1,NDI3BY(N3MODE),N3MODE) = -E*RFCH(IL)
43903 B3MODE(2,NDI3BY(N3MODE),N3MODE) = -E*LFCH(IL)
43905 C--R-parity violating decays
43907 ELSEIF(IDKPRD(1,I).GE.121.AND.IDKPRD(1,I).LE.132.AND.
43908 & IDKPRD(2,I).GE.121.AND.IDKPRD(2,I).LE.132.AND.
43909 & IDKPRD(1,I).GE.121.AND.IDKPRD(3,I).LE.132) THEN
43911 C--neutrino lepton neutrino
43912 IF(MOD(IDKPRD(1,I),2).EQ.0.AND.MOD(IDKPRD(2,I),2).EQ.1.AND.
43913 & MOD(IDKPRD(3,I),2).EQ.0) THEN
43915 IF(N3MODE.GT.NMODE3) THEN
43916 CALL HWWARN('HWISP3',129)
43920 NME(I) = 10000+N3MODE
43922 P3MODE(N3MODE) = ONE
43924 SPN3CF(1,1,N3MODE) = ONE
43925 III = (IDKPRD(1,I)-120)/2
43926 JJJ = (IDKPRD(2,I)-119)/2
43927 KKK = (IDKPRD(3,I)-126)/2
43929 I3DRTP(K,N3MODE) = 4
43930 I3DRCF(K,N3MODE) = 1
43931 I3MODE(K,N3MODE) = 423+2*KKK+12*(K-1)
43932 B3MODE(2,K,N3MODE) = 0.0D0
43933 B3MODE(1,K,N3MODE)=LAMDA1(III,JJJ,KKK)*LMIXSS(2*KKK-1,2,K)
43935 57 A3MODE(J,K,N3MODE) = AFC(O(J),5+2*KKK,K,L1)
43936 C--neutrino neutrino lepton
43937 ELSEIF(MOD(IDKPRD(1,I),2).EQ.0.AND.MOD(IDKPRD(2,I),2).EQ.0
43938 & .AND.MOD(IDKPRD(3,I),2).EQ.1) THEN
43940 IF(N3MODE.GT.NMODE3) THEN
43941 CALL HWWARN('HWISP3',130)
43945 NME(I) = 10000+N3MODE
43947 P3MODE(N3MODE) = ONE
43949 SPN3CF(1,1,N3MODE) = ONE
43950 III = (IDKPRD(1,I)-126)/2
43951 JJJ = (IDKPRD(2,I)-126)/2
43952 KKK = (IDKPRD(3,I)-119)/2
43954 I3DRTP(K ,N3MODE) = 8
43955 I3DRTP(K+2,N3MODE) = 9
43956 I3DRCF(K ,N3MODE) = 1
43957 I3DRCF(K+2,N3MODE) = 1
43958 I3MODE(K ,N3MODE) = 423+2*III+12*(K-1)
43959 I3MODE(K+2,N3MODE) = 423+2*JJJ+12*(K-1)
43960 B3MODE(2,K,N3MODE) = LAMDA1(III,JJJ,KKK)*
43961 & LMIXSS(2*III-1,1,K)
43962 B3MODE(1,K,N3MODE) = 0.0D0
43963 B3MODE(2,K+2,N3MODE) =-LAMDA1(III,JJJ,KKK)*
43964 & LMIXSS(2*JJJ-1,1,K)
43965 B3MODE(1,K+2,N3MODE) = 0.0D0
43967 A3MODE(J,K,N3MODE) = AFC(O(J),5+2*III,K,L1)
43968 58 A3MODE(J,K+2,N3MODE) = AFC(O(J),5+2*JJJ,K,L1)
43969 C--lepton lepton lepton
43970 ELSEIF(MOD(IDKPRD(1,I),2).EQ.1.AND.MOD(IDKPRD(2,I),2).EQ.1
43971 & .AND.MOD(IDKPRD(3,I),2).EQ.1) THEN
43973 IF(N3MODE.GT.NMODE3) THEN
43974 CALL HWWARN('HWISP3',131)
43978 NME(I) = 10000+N3MODE
43980 P3MODE(N3MODE) = ONE
43982 SPN3CF(1,1,N3MODE) = ONE
43983 III = (IDKPRD(1,I)-119)/2
43984 JJJ = (IDKPRD(2,I)-119)/2
43985 KKK = (IDKPRD(3,I)-125)/2
43986 I3DRTP(1,N3MODE) = 2
43987 I3DRTP(2,N3MODE) = 3
43988 I3DRCF(1,N3MODE) = 1
43989 I3DRCF(2,N3MODE) = 1
43990 I3MODE(1,N3MODE) = 424+2*III
43991 I3MODE(2,N3MODE) = 424+2*JJJ
43992 B3MODE(1,1,N3MODE) = LAMDA1(III,JJJ,KKK)
43993 B3MODE(2,1,N3MODE) = 0.0D0
43994 B3MODE(1,2,N3MODE) =-LAMDA1(III,JJJ,KKK)
43995 B3MODE(2,2,N3MODE) = 0.0D0
43997 A3MODE(J,1,N3MODE) = AFC(J,6+2*III,1,L1)
43998 59 A3MODE(J,2,N3MODE) = AFC(J,6+2*JJJ,1,L1)
44000 CALL HWWARN('HWISP3',7)
44003 ELSEIF(IDKPRD(1,I).GE.121.AND.IDKPRD(1,I).LE.132.AND.
44004 & IDKPRD(2,I).LE.12 .AND.IDKPRD(3,I).LE. 12) THEN
44007 IF(IDKPRD(1,I).LE.126.AND.MOD(IDKPRD(1,I),2).EQ.0) THEN
44009 IF(N3MODE.GT.NMODE3) THEN
44010 CALL HWWARN('HWISP3',132)
44014 NME(I) = 10000+N3MODE
44016 P3MODE(N3MODE) = THREE
44018 SPN3CF(1,1,N3MODE) = ONE
44019 III = (IDKPRD(1,I)-120)/2
44020 JJJ = (IDKPRD(2,I)+1)/2
44021 KKK = (IDKPRD(3,I)-6)/2
44023 I3DRTP(K,N3MODE) = 4
44024 I3DRCF(K,N3MODE) = 1
44025 I3MODE(K,N3MODE) = 399+2*KKK+12*(K-1)
44026 B3MODE(2,K,N3MODE) = 0.0D0
44027 B3MODE(1,K,N3MODE) = QMIXSS(2*KKK-1,2,K)*
44028 & LAMDA2(III,JJJ,KKK)
44030 93 A3MODE(J,K,N3MODE) = AFC(O(J),2*KKK-1,K,L1)
44032 ELSEIF(IDKPRD(1,I).LE.125.AND.MOD(IDKPRD(1,I),2).EQ.1.AND.
44033 & MOD(IDKPRD(2,I),2).EQ.0) THEN
44035 IF(N3MODE.GT.NMODE3) THEN
44036 CALL HWWARN('HWISP3',133)
44040 NME(I) = 10000+N3MODE
44042 P3MODE(N3MODE) = THREE
44044 SPN3CF(1,1,N3MODE) = ONE
44045 III = (IDKPRD(1,I)-119)/2
44046 JJJ = IDKPRD(2,I)/2
44047 KKK = (IDKPRD(3,I)-6)/2
44049 I3DRTP(K,N3MODE) = 4
44050 I3DRCF(K,N3MODE) = 1
44051 I3MODE(K,N3MODE) = 399+2*KKK+12*(K-1)
44052 B3MODE(2,K,N3MODE) = 0.0D0
44053 B3MODE(1,K,N3MODE) = QMIXSS(2*KKK-1,2,K)*
44054 & LAMDA2(III,JJJ,KKK)
44056 94 A3MODE(J,K,N3MODE) = AFC(J,2*KKK-1,K,L1)
44058 ELSEIF(IDKPRD(1,I).LE.125.AND.MOD(IDKPRD(1,I),2).EQ.1.AND.
44059 & MOD(IDKPRD(2,I),2).EQ.1) THEN
44061 IF(N3MODE.GT.NMODE3) THEN
44062 CALL HWWARN('HWISP3',134)
44066 NME(I) = 10000+N3MODE
44068 P3MODE(N3MODE) = THREE
44070 SPN3CF(1,1,N3MODE) = ONE
44071 III = (IDKPRD(1,I)-119)/2
44072 JJJ = (IDKPRD(2,I)+1)/2
44073 KKK = (IDKPRD(3,I)-5)/2
44074 I3DRTP(1,N3MODE) = 2
44075 I3DRCF(1,N3MODE) = 1
44076 I3MODE(1,N3MODE) = 424+2*III
44077 B3MODE(2,1,N3MODE) = 0.0D0
44078 B3MODE(1,1,N3MODE) = -LAMDA2(III,JJJ,KKK)
44080 95 A3MODE(J,1,N3MODE) = AFC(J,2*III+6,1,L1)
44082 I3DRTP(K+1,N3MODE) = 3
44083 I3DRCF(K+1,N3MODE) = 1
44084 I3MODE(K+1,N3MODE) = 400+2*JJJ+12*(K-1)
44085 B3MODE(2,K+1,N3MODE) = 0.0D0
44086 B3MODE(1,K+1,N3MODE) = QMIXSS(2*JJJ,1,K)*
44087 & LAMDA2(III,JJJ,KKK)
44089 96 A3MODE(J,K+1,N3MODE) = AFC(J,2*JJJ,K,L1)
44091 ELSEIF(IDKPRD(1,I).GE.128.AND.MOD(IDKPRD(1,I),2).EQ.0) THEN
44093 IF(N3MODE.GT.NMODE3) THEN
44094 CALL HWWARN('HWISP3',135)
44098 NME(I) = 10000+N3MODE
44100 P3MODE(N3MODE) = THREE
44102 SPN3CF(1,1,N3MODE) = ONE
44103 III = (IDKPRD(1,I)-126)/2
44104 JJJ = (IDKPRD(2,I)-6)/2
44105 KKK = (IDKPRD(3,I)+1)/2
44107 I3DRTP(K ,N3MODE) = 8
44108 I3DRTP(K+2,N3MODE) = 9
44109 I3DRCF(K ,N3MODE) = 1
44110 I3DRCF(K+2,N3MODE) = 1
44111 I3MODE(K ,N3MODE) = 423+2*III+12*(K-1)
44112 I3MODE(K+2,N3MODE) = 399+2*JJJ+12*(K-1)
44113 B3MODE(2,K ,N3MODE) = LMIXSS(2*III-1,1,K)*
44114 & LAMDA2(III,JJJ,KKK)
44115 B3MODE(1,K ,N3MODE) = 0.0D0
44116 B3MODE(2,K+2,N3MODE) = -QMIXSS(2*JJJ-1,1,K)*
44117 & LAMDA2(III,JJJ,KKK)
44118 B3MODE(1,K+2,N3MODE) = 0.0D0
44120 A3MODE(J,K ,N3MODE) = AFC(O(J),2*III+5,K,L1)
44121 97 A3MODE(J,K+2,N3MODE) = AFC(O(J),2*JJJ-1,K,L1)
44124 CALL HWWARN('HWISP3',8)
44127 ELSEIF(IDKPRD(1,I).LE.12.AND.IDKPRD(2,I).LE.12.AND.
44128 & IDKPRD(3,I).LE.12) THEN
44131 IF(MOD(IDKPRD(1,I),2).EQ.1.AND.MOD(IDKPRD(2,I),2).EQ.1.AND.
44132 & MOD(IDKPRD(3,I),2).EQ.1) THEN
44134 IF(N3MODE.GT.NMODE3) THEN
44135 CALL HWWARN('HWISP3',136)
44139 NME(I) = 10000+N3MODE
44142 SPN3CF(1,1,N3MODE) = ONE
44143 III = (IDKPRD(1,I)+1)/2
44144 JJJ = (IDKPRD(2,I)+1)/2
44145 KKK = (IDKPRD(3,I)+1)/2
44146 P3MODE(N3MODE) = ONE
44147 IF(III.EQ.JJJ) P3MODE(N3MODE) = P3MODE(N3MODE)+ONE
44148 IF(JJJ.EQ.KKK) P3MODE(N3MODE) = P3MODE(N3MODE)+ONE
44149 IF(III.EQ.KKK) P3MODE(N3MODE) = P3MODE(N3MODE)+ONE
44150 P3MODE(N3MODE) = 6.0D0/P3MODE(N3MODE)
44152 68 I3DRCF(K,N3MODE) = 1
44154 I3DRTP(K ,N3MODE) = 12
44155 I3DRTP(K+2,N3MODE) = 13
44156 I3DRTP(K+4,N3MODE) = 14
44157 I3MODE(K ,N3MODE) = 400+2*III+(K-1)*12
44158 I3MODE(K+2,N3MODE) = 400+2*JJJ+(K-1)*12
44159 I3MODE(K+4,N3MODE) = 400+2*KKK+(K-1)*12
44160 B3MODE(1,K ,N3MODE) = 0.0D0
44161 B3MODE(1,K+2,N3MODE) = 0.0D0
44162 B3MODE(1,K+4,N3MODE) = 0.0D0
44163 B3MODE(2,K ,N3MODE) = QMIXSS(2*III,2,K)*
44164 & LAMDA3(III,JJJ,KKK)
44165 B3MODE(2,K+2,N3MODE) =-QMIXSS(2*JJJ,2,K)*
44166 & LAMDA3(JJJ,III,KKK)
44167 B3MODE(2,K+4,N3MODE) = QMIXSS(2*KKK,2,K)*
44168 & LAMDA3(KKK,III,JJJ)
44170 A3MODE(J,K ,N3MODE) = AFC(J,2*III,K,L1)
44171 A3MODE(J,K+2,N3MODE) = AFC(J,2*JJJ,K,L1)
44172 67 A3MODE(J,K+4,N3MODE) = AFC(J,2*KKK,K,L1)
44174 ELSEIF(MOD(IDKPRD(1,I),2).EQ.0.AND.MOD(IDKPRD(2,I),2).EQ.0
44175 & .AND.MOD(IDKPRD(3,I),2).EQ.1) THEN
44177 IF(N3MODE.GT.NMODE3) THEN
44178 CALL HWWARN('HWISP3',137)
44182 NME(I) = 10000+N3MODE
44184 P3MODE(N3MODE) = 6.0D0
44186 SPN3CF(1,1,N3MODE) = ONE
44187 III = (IDKPRD(1,I)-6)/2
44188 JJJ = (IDKPRD(2,I)-6)/2
44189 KKK = (IDKPRD(3,I)-5)/2
44190 IF(III.EQ.JJJ) P3MODE(N3MODE) = HALF*P3MODE(N3MODE)
44192 I3DRTP(K ,N3MODE) = 11
44193 I3DRTP(K+2,N3MODE) = 12
44194 I3DRCF(K ,N3MODE) = 1
44195 I3DRCF(K+2,N3MODE) = 1
44196 I3MODE(K ,N3MODE) = 399+2*III+(K-1)*12
44197 I3MODE(K+2,N3MODE) = 399+2*JJJ+(K-1)*12
44198 B3MODE(1,K ,N3MODE) = QMIXSS(2*III-1,2,K)*
44199 & LAMDA3(JJJ,III,KKK)
44200 B3MODE(1,K+2,N3MODE) =-QMIXSS(2*JJJ-1,2,K)*
44201 & LAMDA3(III,JJJ,KKK)
44202 B3MODE(2,K+2,N3MODE) = 0.0D0
44203 B3MODE(2,K+2,N3MODE) = 0.0D0
44205 A3MODE(J,K ,N3MODE) = AFC(O(J),2*III-1,K,L1)
44206 69 A3MODE(J,K+2,N3MODE) = AFC(O(J),2*JJJ-1,K,L1)
44207 C--unrecognized decay issue warning
44209 CALL HWWARN('HWISP3',9)
44211 C--unrecognized decay issue warning
44213 CALL HWWARN('HWISP3',10)
44216 C--NOW FIND THE TWO BODY MODES WE WILL TREAT AS THREE BODY
44217 2500 IF(IDKPRD(2,I).EQ.0.OR.IDKPRD(3,I).NE.0) GOTO 2000
44220 IH = IDKPRD(1,I)-202
44221 C--first the neutralino decay modes
44222 IF(L1.GE.1.AND.L1.LE.4.AND.
44223 & IDKPRD(2,I).GE.198.AND.IDKPRD(2,I).LE.200) THEN
44224 C--neutralino --> neutralino Z
44225 IF(L.GE.1.AND.L.LE.4.AND.IDKPRD(2,I).EQ.200) THEN
44227 IF(NBMODE.GT.NMODEB) THEN
44228 CALL HWWARN('HWISP3',138)
44231 NME(I) = 20000+NBMODE
44233 IBMODE(NBMODE) = 200
44236 20 ABMODE(J,NBMODE) = OIJPP(J,L,L1)
44240 PBMODE(K,NBMODE) = THREE
44243 PBMODE(K,NBMODE) = ONE
44245 BBMODE(1,K,NBMODE) = -E*RFCH(IL)
44246 21 BBMODE(2,K,NBMODE) = -E*LFCH(IL)
44247 C--neutralino --> chargino+ W-
44248 ELSEIF((L.EQ.5.OR.L.EQ.6).AND.IDKPRD(2,I).EQ.199) THEN
44251 IF(NBMODE.GT.NMODEB) THEN
44252 CALL HWWARN('HWISP3',139)
44255 NME(I) = 20000+NBMODE
44257 IBMODE(NBMODE) = 199
44260 22 ABMODE(J,NBMODE) = OIJ(J,L1,L)
44262 PBMODE(K,NBMODE) = ONE
44263 IF(K.LE.3) PBMODE(K,NBMODE) = THREE
44264 BBMODE(1,K,NBMODE) = ZERO
44265 23 BBMODE(2,K,NBMODE) = -G*ORT
44266 C--neutralino --> chargino- W+
44267 ELSEIF((L.EQ.7.OR.L.EQ.8).AND.IDKPRD(2,I).EQ.198) THEN
44270 IF(NBMODE.GT.NMODEB) THEN
44271 CALL HWWARN('HWISP3',140)
44274 NME(I) = 20000+NBMODE
44276 IBMODE(NBMODE) = 198
44279 24 ABMODE(J,NBMODE) =-OIJ(O(J),L1,L)
44281 PBMODE(K,NBMODE) = ONE
44282 IF(K.LE.3) PBMODE(K,NBMODE) = THREE
44283 BBMODE(1,K,NBMODE) = ZERO
44284 25 BBMODE(2,K,NBMODE) = -G*ORT
44285 C--gravitino Z modes
44286 ELSEIF(L.EQ.9.AND.IDKPRD(2,I).EQ.200) THEN
44288 IF(NBMODE.GT.NMODEB) THEN
44289 CALL HWWARN('HWISP3',141)
44292 NME(I) = 20000+NBMODE
44294 IBMODE(NBMODE) = 200
44296 ABMODE(1,NBMODE) = 2.0D0/SQRT(6.0D0)*ZMIXSS(L1,2)
44297 ABMODE(2,NBMODE) = 2.0D0/SQRT(6.0D0)*RMASS(200)*
44298 & (ZMIXSS(L1,3)*COSB-ZMIXSS(L1,4)*SINB)
44302 PBMODE(K,NBMODE) = THREE
44305 PBMODE(K,NBMODE) = ONE
44307 BBMODE(1,K,NBMODE) = -E*RFCH(IL)
44308 41 BBMODE(2,K,NBMODE) = -E*LFCH(IL)
44309 C--unrecognized decay issue warning
44311 CALL HWWARN('HWISP3',11)
44313 C--then the +ve chargino decay modes
44314 ELSEIF((L1.EQ.5.OR.L1.EQ.6)
44315 & .AND.IDKPRD(2,I).GE.198.AND.IDKPRD(2,I).LE.200) THEN
44317 C--chargino --> chargino Z
44318 IF((L.EQ.5.OR.L.EQ.6).AND.IDKPRD(2,I).EQ.200) THEN
44321 IF(NBMODE.GT.NMODEB) THEN
44322 CALL HWWARN('HWISP3',142)
44325 NME(I) = 20000+NBMODE
44327 IBMODE(NBMODE) = 200
44330 26 ABMODE(J,NBMODE) = OIJP(J,L,L1)
44334 PBMODE(K,NBMODE) = THREE
44337 PBMODE(K,NBMODE) = ONE
44339 BBMODE(1,K,NBMODE) = -E*RFCH(IL)
44340 27 BBMODE(2,K,NBMODE) = -E*LFCH(IL)
44341 C--chargino --> neutralino W+
44342 ELSEIF(L.GE.1.AND.L.LE.4.AND.IDKPRD(2,I).EQ.198) THEN
44344 IF(NBMODE.GT.NMODEB) THEN
44345 CALL HWWARN('HWISP3',143)
44348 NME(I) = 20000+NBMODE
44350 IBMODE(NBMODE) = 198
44353 28 ABMODE(J,NBMODE) = OIJ(J,L,L1)
44355 PBMODE(K,NBMODE) = ONE
44356 IF(K.LE.3) PBMODE(K,NBMODE) = THREE
44357 BBMODE(1,K,NBMODE) = ZERO
44358 29 BBMODE(2,K,NBMODE) = -G*ORT
44359 C--unrecognised decay issue warning
44361 CALL HWWARN('HWISP3',12)
44363 C--then the -ve chargino decay modes
44364 ELSEIF((L1.EQ.7.OR.L1.EQ.8)
44365 & .AND.IDKPRD(2,I).GE.198.AND.IDKPRD(2,I).LE.200) THEN
44367 C--chargino --> chargino Z
44368 IF((L.EQ.7.OR.L.EQ.8).AND.IDKPRD(2,I).EQ.200) THEN
44371 IF(NBMODE.GT.NMODEB) THEN
44372 CALL HWWARN('HWISP3',144)
44375 NME(I) = 20000+NBMODE
44377 IBMODE(NBMODE) = 200
44380 30 ABMODE(J,NBMODE) =-OIJP(O(J),L,L1)
44384 PBMODE(K,NBMODE) = THREE
44387 PBMODE(K,NBMODE) = ONE
44389 BBMODE(1,K,NBMODE) = -E*RFCH(IL)
44390 31 BBMODE(2,K,NBMODE) = -E*LFCH(IL)
44391 C--chargino --> neutralino W-
44392 ELSEIF(L.GE.1.AND.L.LE.4.AND.IDKPRD(2,I).EQ.199) THEN
44394 IF(NBMODE.GT.NMODEB) THEN
44395 CALL HWWARN('HWISP3',145)
44398 NME(I) = 20000+NBMODE
44400 IBMODE(NBMODE) = 199
44403 32 ABMODE(J,NBMODE) =-OIJ(O(J),L,L1)
44405 PBMODE(K,NBMODE) = ONE
44406 IF(K.LE.3) PBMODE(K,NBMODE) = THREE
44407 BBMODE(1,K,NBMODE) = ZERO
44408 33 BBMODE(2,K,NBMODE) = -G*ORT
44409 C--unrecognised decay issue warning
44411 CALL HWWARN('HWISP3',13)
44413 C--gauge boson decay modes of the Higgs
44414 ELSEIF(IH.GE.1.AND.IH.LE.5.AND.IH1.GE.1.AND.IH1.LE.5.AND.
44415 & IDKPRD(1,I).GE.198.AND.IDKPRD(2,I).LE.200) THEN
44416 C--decay of the A0 to scalar Higgs and Z boson
44417 IF(IH1.EQ.3.AND.IH.LE.2) THEN
44419 IF(NBMODE.GT.NMODEB) THEN
44420 CALL HWWARN('HWISP3',146)
44423 NME(I) = 20000+NBMODE
44425 IBMODE(NBMODE) = 200
44427 ABMODE(1,NBMODE) =-HHB(2,IH)
44428 ABMODE(2,NBMODE) = ZERO
44432 PBMODE(K,NBMODE) = 3.0D0
44435 PBMODE(K,NBMODE) = 1.0D0
44437 BBMODE(1,K,NBMODE) = -E*RFCH(IL)
44438 34 BBMODE(2,K,NBMODE) = -E*LFCH(IL)
44439 C--decay of scalar Higgs to A0 and Z
44440 ELSEIF(IH.EQ.3.AND.IH1.LE.3) THEN
44442 IF(NBMODE.GT.NMODEB) THEN
44443 CALL HWWARN('HWISP3',147)
44446 NME(I) = 20000+NBMODE
44448 IBMODE(NBMODE) = 200
44450 ABMODE(1,NBMODE) = HHB(2,IH1)
44451 ABMODE(2,NBMODE) = ZERO
44455 PBMODE(K,NBMODE) = 3.0D0
44458 PBMODE(K,NBMODE) = 1.0D0
44460 BBMODE(1,K,NBMODE) = -E*RFCH(IL)
44461 35 BBMODE(2,K,NBMODE) = -E*LFCH(IL)
44462 C--decay of the positively charged Higgs
44463 ELSEIF(IH1.EQ.4.AND.IH.LE.3) THEN
44465 IF(NBMODE.GT.NMODEB) THEN
44466 CALL HWWARN('HWISP3',148)
44469 NME(I) = 20000+NBMODE
44471 IBMODE(NBMODE) = 198
44473 ABMODE(1,NBMODE) =-HHB(1,IH)
44474 ABMODE(2,NBMODE) = ZERO
44476 PBMODE(K,NBMODE) = 1.0D0
44477 IF(K.LE.3) PBMODE(K,NBMODE) = 3.0D0
44478 BBMODE(1,K,NBMODE) = ZERO
44479 36 BBMODE(2,K,NBMODE) = -G*ORT
44480 C--decay of the negatively charged Higgs
44481 ELSEIF(IH1.EQ.5.AND.IH.LE.3) THEN
44483 IF(NBMODE.GT.NMODEB) THEN
44484 CALL HWWARN('HWISP3',149)
44487 NME(I) = 20000+NBMODE
44489 IBMODE(NBMODE) = 199
44491 ABMODE(1,NBMODE) =-HHB(1,IH)
44492 ABMODE(2,NBMODE) = ZERO
44494 PBMODE(K,NBMODE) = 1.0D0
44495 IF(K.LE.3) PBMODE(K,NBMODE) = 3.0D0
44496 BBMODE(1,K,NBMODE) = ZERO
44497 37 BBMODE(2,K,NBMODE) = -G*ORT
44499 C--finally sfermion modes to gauge bosons
44500 ELSEIF(IDK(I).GE.401.AND.IDK(I).LE.448.AND.
44501 & IDKPRD(2,I).GE.401.AND.IDKPRD(2,I).LE.448.AND.
44502 & IDKPRD(1,I).GE.198.AND.IDKPRD(1,I).LE.200) THEN
44503 C--change the order of the decay products
44504 IM = MOD(INT((IDK(I)-389)/12)+1,2)+1
44505 IL = 6*INT((IDK(I)-401)/24)+MOD(IDK(I)-401,6)+1
44506 IH = MOD(INT((IDKPRD(2,I)-389)/12)+1,2)+1
44507 IQ = 6*INT((IDKPRD(2,I)-401)/24)+MOD(IDKPRD(2,I)-401,6)+1
44508 C--first the Z decay modes
44509 IF(IDKPRD(1,I).EQ.200) THEN
44511 IF(NBMODE.GT.NMODEB) THEN
44512 CALL HWWARN('HWISP3',150)
44515 NME(I) = 20000+NBMODE
44517 IBMODE(NBMODE) = 200
44519 ABMODE(1,NBMODE) = ZAB(IL,IM,IH)
44520 ABMODE(2,NBMODE) = ZERO
44524 PBMODE(K,NBMODE) = 3.0D0
44527 PBMODE(K,NBMODE) = 1.0D0
44529 BBMODE(1,K,NBMODE) = -E*RFCH(IL)
44530 38 BBMODE(2,K,NBMODE) = -E*LFCH(IL)
44531 C--then the W+ decay modes
44532 ELSEIF(IDKPRD(1,I).EQ.198) THEN
44534 IF(NBMODE.GT.NMODEB) THEN
44535 CALL HWWARN('HWISP3',151)
44538 NME(I) = 20000+NBMODE
44540 IBMODE(NBMODE) = 198
44543 ABMODE(1,NBMODE) = -G*ORT*QMIXSS(IL,1,IM)*QMIXSS(IQ,1,IH)
44545 ABMODE(1,NBMODE) = -G*ORT*LMIXSS(IL-6,1,IM)*
44546 & LMIXSS(IQ-6,1,IH)
44548 ABMODE(2,NBMODE) = ZERO
44550 PBMODE(K,NBMODE) = 1.0D0
44551 IF(K.LE.3) PBMODE(K,NBMODE) = 3.0D0
44552 BBMODE(1,K,NBMODE) = ZERO
44553 39 BBMODE(2,K,NBMODE) = -G*ORT
44554 ELSEIF(IDKPRD(1,I).EQ.199) THEN
44556 IF(NBMODE.GT.NMODEB) THEN
44557 CALL HWWARN('HWISP3',152)
44560 NME(I) = 20000+NBMODE
44562 IBMODE(NBMODE) = 199
44565 ABMODE(1,NBMODE) = -G*ORT*QMIXSS(IL,1,IM)*QMIXSS(IQ,1,IH)
44567 ABMODE(1,NBMODE) = -G*ORT*LMIXSS(IL-6,1,IM)*
44568 & LMIXSS(IQ-6,1,IH)
44570 ABMODE(2,NBMODE) = ZERO
44572 PBMODE(K,NBMODE) = 1.0D0
44573 IF(K.LE.3) PBMODE(K,NBMODE) = 3.0D0
44574 BBMODE(1,K,NBMODE) = ZERO
44575 40 BBMODE(2,K,NBMODE) = -G*ORT
44579 C--now compute the maximum weights for the three body decays found
44582 IF(RSPIN(IDK(ID3PRT(I))).EQ.ZERO) THEN
44593 PHEP(5,1) = RMASS(IDK(ID3PRT(I)))
44594 PHEP(4,1) = SQRT(100.0D0**2+PHEP(5,1)**2)
44595 PHEP(1,1) = 100.0D0
44598 IF(IPRINT.EQ.2) WRITE(6,5000) RNAME(IDK(ID3PRT(I))),
44599 & RNAME(IDKPRD(1,ID3PRT(I))),RNAME(IDKPRD(2,ID3PRT(I))),
44600 & RNAME(IDKPRD(3,ID3PRT(I)))
44601 3000 CALL HWD3ME(1,0,I,RHOIN,1)
44602 IF(.NOT.SUSYIN) RETURN
44603 C--and for the two body gauge boson modes
44605 IF(RSPIN(IDK(IDBPRT(I))).EQ.ZERO) THEN
44616 PHEP(5,1) = RMASS(IDK(IDBPRT(I)))
44617 PHEP(4,1) = SQRT(100.0D0**2+PHEP(5,1)**2)
44618 PHEP(1,1) = 100.0D0
44621 IF(IPRINT.EQ.2) WRITE(6,5010) RNAME(IDK(IDBPRT(I))),
44622 & RNAME(IDKPRD(1,IDBPRT(I))),RNAME(IDKPRD(2,IDBPRT(I)))
44624 IF(IBMODE(I).NE.200) IL = 6
44626 4000 CALL HWD3ME(1,J,I,RHOIN,1)
44628 5000 FORMAT(/'CALCULATING THREE BODY DECAY ',
44629 & A8,' --> ',A8,' ',A8,' ',A8/)
44630 5010 FORMAT(/'CALCULATING TWO BODY DECAY ',
44631 & A8,' --> ',A8,' ',A8/)
44635 *CMZ :- -12/10/01 12.04.54 by Peter Richardson
44636 *-- Author : Peter Richardson
44637 C-----------------------------------------------------------------------
44639 C-----------------------------------------------------------------------
44640 C Initialise the Higgs four body modes
44641 C-----------------------------------------------------------------------
44642 INCLUDE 'herwig65.inc'
44643 INTEGER I,J,K,IL,IH,II,JJ
44644 DOUBLE PRECISION COL(2),SW,CW,TW,E,G,RT,ORT,MW,MZ,AFN(2,12,2,4),
44645 & AFG(2,6,2),AFC(2,12,2,2),OIJ(2,4,2),OIJP(2,2,2),OIJPP(2,4,4),
44646 & HNN(2,3,4,4),HCC(2,3,2,2),HNC(2,4,2),HFF(2,4,12),HWW(2),
44647 & HZZ(2),ZAB(12,2,2),HHB(2,3),GS
44648 COMMON /HWSPNC/ SW,CW,TW,E,G,RT,ORT,MW,MZ,GS,AFN,AFG,AFC,OIJ,OIJP,
44649 & OIJPP,HNN,HCC,HNC,HFF,HWW,HZZ,ZAB,HHB
44650 IF(IERROR.NE.0.OR..NOT.SUSYIN) RETURN
44651 C--four body Higgs modes via virtual WW and ZZ
44653 DO 1000 II=1,NMODES(JJ)
44660 IF((IH.EQ.1.OR.IH.EQ.2).AND.IDKPRD(3,I).EQ.0.AND.
44661 & IDKPRD(1,I).GE.198.AND.IDKPRD(1,I).LE.200.AND.
44662 & IDKPRD(2,I).GE.198.AND.IDKPRD(2,I).LE.200) THEN
44663 C--first the WW modes
44664 IF(IDKPRD(1,I).NE.200) THEN
44666 IF(N4MODE.GT.NMODE4) THEN
44667 CALL HWWARN('HWISP4',100)
44670 NME(I) = 40000+N4MODE
44672 I4MODE(1,N4MODE) = 198
44673 I4MODE(2,N4MODE) = 199
44675 A4MODE(1,K,N4MODE) = ZERO
44676 A4MODE(2,K,N4MODE) =-G*ORT
44677 B4MODE(1,K,N4MODE) = ZERO
44678 1 B4MODE(2,K,N4MODE) =-G*ORT
44679 C--now the prefactors
44681 COL(1) = HWW(IH)**2
44682 IF(J.LE.3) COL(1) = THREE*COL(1)
44685 IF(K.LE.3) COL(2) = THREE*COL(2)
44686 2 P4MODE(J,K,N4MODE) = COL(1)*COL(2)
44687 C--then the ZZ modes
44690 IF(N4MODE.GT.NMODE4) THEN
44691 CALL HWWARN('HWISP4',101)
44694 NME(I) = 40000+N4MODE
44696 I4MODE(1,N4MODE) = 200
44697 I4MODE(2,N4MODE) = 200
44701 A4MODE(1,K,N4MODE) =-E*RFCH(IL)
44702 A4MODE(2,K,N4MODE) =-E*LFCH(IL)
44703 B4MODE(1,K,N4MODE) =-E*RFCH(IL)
44704 3 B4MODE(2,K,N4MODE) =-E*LFCH(IL)
44706 COL(1) = HALF*HZZ(IH)**2
44707 IF(J.LE.6) COL(1)=THREE*COL(1)
44710 IF(K.LE.6) COL(2) = THREE
44711 4 P4MODE(J,K,N4MODE) = COL(1)*COL(2)
44715 C--compute the maximum weights
44716 IF(N4MODE.EQ.0) RETURN
44718 PHEP(5,1) = RMASS(IDK(ID4PRT(I)))
44719 PHEP(4,1) = SQRT(100.0D0**2+PHEP(5,1)**2)
44720 PHEP(1,1) = 100.0D0
44723 IF(IPRINT.EQ.2) WRITE(6,5010) RNAME(IDK(ID4PRT(I))),
44724 & RNAME(IDKPRD(1,ID4PRT(I))),RNAME(IDKPRD(2,ID4PRT(I)))
44726 IF(I4MODE(1,I).NE.200) IL = 6
44729 2000 CALL HWD4ME(1,J,K,I)
44731 5010 FORMAT(/'CALCULATING TWO BODY DECAY ',
44732 & A8,' --> ',A8,' ',A8/)
44736 *CMZ :- -12/10/01 09:41:43 by Peter Richardson
44737 *-- Author : Bryan Webber, modified by Kosuke Odagiri
44738 C-----------------------------------------------------------------------
44740 C-----------------------------------------------------------------------
44741 C Reads in SUSY particle properties and decays,
44742 C in format generated by ISAWIG
44743 C-----------------------------------------------------------------------
44744 INCLUDE 'herwig65.inc'
44745 INTEGER I,J,K,IH,IHW,NSSP,NDEC,MDKYS
44746 DOUBLE PRECISION BETAH, WEINCOS,WEINSIN, MW,MZ, RMMAX
44747 DOUBLE PRECISION FTM,FTMUU(4),FTMDD(4),FTMTT(4),FTMBB(4),FTMU,FTMD
44748 DOUBLE PRECISION YTM,YTM1,DTERM(4), SQHF,SNBCSB,MZSW2
44750 EQUIVALENCE (MW,RMASS(198)), (MZ,RMASS(200))
44760 C--reset susy input flag
44761 IF (LRSUSY.LT.0) CALL HWWARN('HWISSP',500)
44764 C Input SUSY particle + top quark table
44767 9 FORMAT(//10X,A28//,
44768 & 10X,'Since SUSY processes are called,'
44769 & ,/, 10X,'please also reference: S.Moretti, K.Odagiri,'
44770 & ,/, 10X,'P.Richardson, M.H.Seymour & B.R.Webber,'
44771 & ,/, 10X,'JHEP 0204 (2002) 028')
44772 WRITE (6,10) LRSUSY
44773 10 FORMAT (/10X,'Reading in SUSY data from unit',I3)
44774 READ (LRSUSY,'(I4)') NSSP
44775 IF (NSSP.LE.0) RETURN
44776 RMMAX=SQRT(HALF*(EBEAM1*EBEAM2+PBEAM1*PBEAM2))
44779 READ (LRSUSY,1) IHW,RMASS(IHW),RLTIM(IHW)
44780 C Negative gaugino mass means physical field is gamma_5*psi
44782 IF ((IHW.GE.450).AND.(IHW.LE.457)) THEN
44783 IF (IHW.LE.453) THEN
44785 ZSGNSS(J)=RMASS(IHW)/ABS(RMASS(IHW))
44786 ELSEIF (IHW.LE.455) THEN
44788 WSGNSS(J)=RMASS(IHW)/ABS(RMASS(IHW))
44790 RMASS(IHW)=ABS(RMASS(IHW))
44792 IF (ABS(IDPDG(IHW)).GT.1000000.AND.(RMASS(IHW).NE.ZERO))
44793 & RMMNSS=MIN(RMMNSS,RMASS(IHW))
44794 IF (IHW.GT.NRES) THEN
44795 IF (IHW.GT.NMXRES) CALL HWWARN('HWISSP',501)
44799 XLMNSS=TWO*LOG(RMMNSS/RMMAX)
44800 1 FORMAT(I5,F12.4,E15.5)
44802 C Input decay modes
44806 READ (LRSUSY,'(I4)') NDEC
44807 IF (NDEC.GT.0) THEN
44810 IF (NDKYS.GT.NMXDKS) THEN
44811 CALL HWWARN('HWISSP',100)
44814 READ (LRSUSY,11) IDK(NDKYS),BRFRAC(NDKYS),NME(NDKYS),
44815 & (IDKPRD(K,NDKYS),K=1,5)
44816 11 FORMAT(I6,F16.8,6I6)
44821 C Mixings and other SUSY parameters
44823 READ (LRSUSY,'(2F16.8)') TANB,ALPHAH
44825 READ (LRSUSY,13) ZMXNSS(I,1),ZMXNSS(I,2),ZMXNSS(I,3),ZMXNSS(I,4)
44827 WEINSIN = SQRT(SWEIN)
44828 WEINCOS = SQRT(1.-SWEIN)
44830 ZMIXSS(I,1) = WEINCOS*ZMXNSS(I,1)+WEINSIN*ZMXNSS(I,2)
44831 ZMIXSS(I,2) = -WEINSIN*ZMXNSS(I,1)+WEINCOS*ZMXNSS(I,2)
44832 ZMIXSS(I,3) = ZMXNSS(I,3)
44833 ZMIXSS(I,4) = ZMXNSS(I,4)
44836 IF ((J.LE.6).OR.(J.GE.11)) THEN
44837 C--left and right couplings now computed in HWIGIN
44839 SLFCH(J,I)= ZMIXSS(I,1)*QFCH(J)+ZMIXSS(I,2)*LFCH(J)
44840 SRFCH(J,I)=-ZMIXSS(I,1)*QFCH(J)-ZMIXSS(I,2)*RFCH(J)
44844 READ (LRSUSY,13) WMXVSS(1,1),WMXVSS(1,2), WMXVSS(2,1),WMXVSS(2,2)
44845 READ (LRSUSY,13) WMXUSS(1,1),WMXUSS(1,2), WMXUSS(2,1),WMXUSS(2,2)
44846 READ (LRSUSY,'(3F16.8)') THETAT,THETAB,THETAL
44847 READ (LRSUSY,'(3F16.8)') ATSS,ABSS,ALSS
44848 READ (LRSUSY,'( F16.8)') MUSS
44859 QMIXSS(6,1,1)= COS(THETAT)
44860 QMIXSS(6,1,2)= SIN(THETAT)
44861 QMIXSS(6,2,1)=-QMIXSS(6,1,2)
44862 QMIXSS(6,2,2)= QMIXSS(6,1,1)
44863 QMIXSS(5,1,1)= COS(THETAB)
44864 QMIXSS(5,1,2)= SIN(THETAB)
44865 QMIXSS(5,2,1)=-QMIXSS(5,1,2)
44866 QMIXSS(5,2,2)= QMIXSS(5,1,1)
44867 LMIXSS(5,1,1)= COS(THETAL)
44868 LMIXSS(5,1,2)= SIN(THETAL)
44869 LMIXSS(5,2,1)=-LMIXSS(5,1,2)
44870 LMIXSS(5,2,2)= LMIXSS(5,1,1)
44871 C--Evaluating Higgs parameters and couplings
44874 COSBPA=COS(BETAH+ALPHAH)
44875 SINBPA=SIN(BETAH+ALPHAH)
44876 COSBMA=COS(BETAH-ALPHAH)
44877 SINBMA=SIN(BETAH-ALPHAH)
44886 GHZZSS(I)=GHWWSS(I)
44888 GHDDSS(1)=-SINA/COSB
44889 GHDDSS(2)= COSA/COSB
44891 GHUUSS(1)= COSA/SINB
44892 GHUUSS(2)= SINA/SINB
44897 MZSW2 = MZ**2 * SQRT(SWEIN*(ONE-SWEIN))
44898 DTERM(1) =-SINBPA*MZSW2
44899 DTERM(2) = COSBPA*MZSW2
44901 FTMUU(1) = MUSS*SINA/SINB
44902 FTMUU(2) =-MUSS*COSA/SINB
44905 FTMTT(1) = ATSS*COSA/SINB
44906 FTMTT(2) = ATSS*SINA/SINB
44907 FTMTT(3) =-ATSS*COTB
44908 FTMTT(4) =-ATSS*COTB
44909 FTMDD(1) =-MUSS*COSA/COSB
44910 FTMDD(2) =-MUSS*SINA/COSB
44913 FTMBB(1) =-ABSS*SINA/COSB
44914 FTMBB(2) = ABSS*COSA/COSB
44915 FTMBB(3) =-ABSS*TANB
44916 FTMBB(4) =-ABSS*TANB
44921 IF (I.EQ.5) FTMU=FTMU+FTMTT(IH)
44922 IF (I.EQ.5) FTMD=FTMD+FTMBB(IH)
44923 IF (MOD(I,2).EQ.0) THEN
44931 GHSQSS(IH,I,1,1) = ZERO
44932 GHSQSS(IH,I,2,2) = ZERO
44933 GHSQSS(IH,I,1,2) = FTM*HALF*RMASS(I)/MW
44934 GHSQSS(IH,I,2,1) = - GHSQSS(IH,I,1,2)
44936 ELSEIF (IH.EQ.4) THEN
44941 IF (MOD(I,2).EQ.1) THEN
44942 GHSQSS(IH,I,J,K)=SQHF*(
44943 & RMASS(I )*FTMD*QMIXSS(I,2,J)*QMIXSS(I+1,1,K)
44944 & +RMASS(I+1)*FTMU*QMIXSS(I,1,J)*QMIXSS(I+1,2,K)
44945 & +( MW**2*TWO*SNBCSB-RMASS(I+1)**2*COTB
44946 & -RMASS(I )**2*TANB )*QMIXSS(I,1,J)*QMIXSS(I+1,1,K)
44947 & -RMASS(I)*RMASS(I+1)/SNBCSB
44948 & *QMIXSS(I,2,J)*QMIXSS(I+1,2,K) ) / MW
44950 GHSQSS(IH,I,J,K)=GHSQSS(IH,I-1,K,J)
44958 IF (J.EQ.K) YTM1=YTM*RMASS(I)**2
44959 GHSQSS(IH,I,J,K)=( YTM1
44960 & +( LFCH(I)*QMIXSS(I,1,J)*QMIXSS(I,1,K)
44961 & -RFCH(I)*QMIXSS(I,2,J)*QMIXSS(I,2,K) )*DTERM(IH)
44962 & +FTM*HALF*RMASS(I)*(QMIXSS(I,1,J)*QMIXSS(I,2,K)
44963 & +QMIXSS(I,2,J)*QMIXSS(I,1,K)) ) / MW
44969 C--Rparity violation
44970 READ (LRSUSY,'(L5)') RPARTY
44971 IF(.NOT.RPARTY) THEN
44972 READ(LRSUSY,20) (((LAMDA1(I,J,K),K=1,3),J=1,3),I=1,3)
44973 READ(LRSUSY,20) (((LAMDA2(I,J,K),K=1,3),J=1,3),I=1,3)
44974 READ(LRSUSY,20) (((LAMDA3(I,J,K),K=1,3),J=1,3),I=1,3)
44979 IF(FOURB) CALL HWIMDE
44983 *CMZ :- -04/05/99 14.28.59 by Bryan Webber
44984 *-- Author : Bryan Webber
44985 C-----------------------------------------------------------------------
44987 C-----------------------------------------------------------------------
44988 C IPROC = 1000,... ADDS SOFT UNDERLYING EVENT
44989 C = 8000: CREATES MINIMUM-BIAS EVENT
44990 C SUPPRESSED BY ADDING 10000 TO IPROC
44991 C-----------------------------------------------------------------------
44992 INCLUDE 'herwig65.inc'
44993 DOUBLE PRECISION HWREXP,ENFAC,TECM,SECM,SUMM,EMCL,BMP(5),BMR(3,3)
44994 INTEGER HWRINT,NETC,IBT,IDBT,ID1,ID2,ID3,KHEP,LHEP,NTRY,ICMS,
44995 & NPPBAR,MCHT,JCL,JD1,JD2,JD3,ICH,MODC,NCHT,INHEP(2),
44997 C--BRW FIX 30/12/04 FOR SPACE-TIME STRUCTURE
44998 C--RMS CLUSTER COORDINATES (GAUSSIAN) AND C*LIFETIME (IN MM)
44999 DOUBLE PRECISION VCLX,VCLY,VCLZ,VCLT,HWRGAU,HWRGEN
45000 EXTERNAL HWREXP,HWRINT,HWRGAU,HWRGEN
45001 SAVE VCLX,VCLY,VCLZ,VCLT
45002 DATA VCLX,VCLY,VCLZ,VCLT/4*1D-12/
45004 IF (IERROR.NE.0) RETURN
45005 IF (.NOT.GENSOF) GOTO 990
45006 IF (IPROC.EQ.8000) THEN
45007 C---SET UP BEAM AND TARGET CLUSTERS
45011 IF (JDAHEP(1,IBT).NE.0) JBT=JDAHEP(1,IBT)
45013 IF (IDBT.EQ.73.OR.IDBT.EQ.75) THEN
45014 INID(1,IBT)=HWRINT(1,2)
45016 ELSEIF (IDBT.EQ.91.OR.IDBT.EQ.93) THEN
45018 INID(2,IBT)=HWRINT(7,8)
45019 ELSEIF (IDBT.EQ.30) THEN
45020 INID(1,IBT)=HWRINT(1,2)
45022 ELSEIF (IDBT.EQ.38) THEN
45024 INID(2,IBT)=HWRINT(7,8)
45025 ELSEIF (IDBT.EQ.34) THEN
45027 INID(2,IBT)=HWRINT(7,8)
45028 ELSEIF (IDBT.EQ.46) THEN
45029 INID(1,IBT)=HWRINT(1,2)
45031 ELSEIF (IDBT.EQ.59) THEN
45032 INID(1,IBT)=HWRINT(1,2)
45033 INID(2,IBT)=HWRINT(7,8)
45035 CALL HWWARN('HWMEVT',100)
45038 NETC=NETC+ICHRG(IDBT)
45039 & -(ICHRG(INID(1,IBT))+ICHRG(INID(2,IBT)))/3
45043 ISTHEP(NHEP+IBT)=163+IBT
45044 JMOHEP(1,NHEP+IBT)=JBT
45046 IF (NETC.EQ.0) THEN
45048 ELSEIF (NETC.EQ.-1) THEN
45050 ELSEIF (NETC.EQ.1) THEN
45058 IF (JDAHEP(1,IBT).NE.0) JBT=JDAHEP(1,IBT)
45059 CALL HWVEQU(5,PHEP(1,JBT),PHEP(1,NHEP))
45062 C---FIND BEAM AND TARGET CLUSTERS
45065 IF (ISTHEP(KHEP).EQ.163+IBT) THEN
45067 INID(1,IBT)=IDHW(JMOHEP(1,KHEP))
45068 INID(2,IBT)=IDHW(JMOHEP(2,KHEP))
45072 C---COULDN'T FIND ONE
45076 C---TEST FOR BOTH FOUND
45077 IF (INHEP(1).EQ.0) JCL=INHEP(2)
45078 IF (INHEP(2).EQ.0) JCL=INHEP(1)
45080 CALL HWWARN('HWMEVT',101)
45095 C---FIND SOFT CM MOMENTUM AND MULTIPLICITY
45098 IF (NHEP.GT.NMXHEP) THEN
45099 CALL HWWARN('HWMEVT',102)
45105 C--Bug Fix 31/03/00 PR
45106 JMOHEP(1,ICMS)=INHEP(1)
45107 JMOHEP(2,ICMS)=INHEP(2)
45110 CALL HWVSUM(4,PHEP(1,INHEP(1)),PHEP(1,INHEP(2)),PHEP(1,NHEP))
45111 CALL HWUMAS(PHEP(1,NHEP))
45113 IF (IPRO/10.EQ.9.OR.IPRO/10.EQ.5) THEN
45116 SECM=PHEP(5,3)*ENFAC
45118 C---CHOOSE MULTIPLICITY
45119 25 CALL HWMULT(SECM,NPPBAR)
45126 C---CREATE CLUSTERS
45129 IF (NHEP.GT.NMXHEP) THEN
45130 CALL HWWARN('HWMEVT',103)
45137 ISTHEP(JCL)=170+NCL
45142 IF (NCL.EQ.3) ID1=ID3
45148 CALL HWVZRO(3,PHEP(1,JCL))
45149 PHEP(4,JCL)=RMASS(ID1)+RMASS(ID2)+PMBM1+HWREXP(TWO/PMBM2)
45150 PHEP(5,JCL)=PHEP(4,JCL)
45151 C--BRW FIX 30/12/04 FOR SPACE-TIME STRUCTURE
45152 C--VERTEX POSITION FOR CLUSTER FORMATION
45153 VHEP(1,JCL)=HWRGAU(1,ZERO,VCLX)
45154 VHEP(2,JCL)=HWRGAU(2,ZERO,VCLY)
45155 VHEP(3,JCL)=HWRGAU(3,ZERO,VCLZ)
45156 VHEP(4,JCL)=SQRT(VHEP(1,JCL)**2+VHEP(2,JCL)**2+VHEP(3,JCL)**2)
45157 & -VCLT*LOG(HWRGEN(0))
45158 C--MHS FIX 07/03/05 - MEASURE DISPLACEMENTS RELATIVE TO SOFT CM
45159 CALL HWVZRO(4,VTXPIP)
45161 C---HADRONIZE AND DECAY CLUSTERS
45162 CALL HWCFLA(ID1,ID2,JD1,JD2)
45163 CALL HWCHAD(JCL,JD1,JD2,JD3)
45164 IF (IERROR.NE.0) RETURN
45166 EMCL=RMASS(IDHW(NHEP))
45167 IF (PHEP(4,JCL).NE.EMCL) THEN
45181 IF (IERROR.NE.0) RETURN
45182 C---CHECK CHARGED MULTIPLICITY
45184 DO 50 KHEP=JCL,NHEP
45185 IF (ISTHEP(KHEP).EQ.1) THEN
45186 ICH=ICHRG(IDHW(KHEP))
45194 NCHT=NPPBAR+NETC+ABS(MODC)
45196 ELSEIF (NCL.EQ.2) THEN
45197 NCHT=NCHT+ABS(MODC)
45198 IF (NCHT.LT.0) NCHT=NCHT+2
45200 IF (MCHT.LT.NCHT) THEN
45202 ELSEIF (MCHT.GT.NCHT) THEN
45203 IF (MOD(NTRY,50).EQ.0) GOTO 25
45204 IF (NTRY.LT.NSTRY) GOTO 30
45205 C---NO PHASE SPACE FOR SOFT EVENT
45207 IF (IPROC.EQ.8000) THEN
45208 C---MINIMUM BIAS: RELABEL BEAM AND TARGET CLUSTERS
45211 LHEP=JMOHEP(1,KHEP)
45213 IDHEP(KHEP)=IDHEP(LHEP)
45214 IDHW(KHEP)=IDHW(LHEP)
45217 C---UNDERLYING EVENT: DECAY THEM
45218 ISTHEP(INHEP(1))=163
45219 ISTHEP(INHEP(2))=163
45227 C---GENERATE CLUSTER MOMENTA IN CLUSTER CM
45228 C FRAME. N.B. SECOND CLUSTER IS TARGET
45229 IF (SUMM.GT.TECM) GOTO 25
45231 IF (NCL.EQ.0) GOTO 25
45233 C---ROTATE & BOOST CLUSTERS & DECAY PRODUCTS
45234 CALL HWULOF(PHEP(1,ICMS),PHEP(1,INHEP(1)),BMP)
45235 CALL HWUROT(BMP, ONE,ZERO,BMR)
45236 C---BMR PUTS BEAM ALONG Z AXIS (WE WANT INVERSE)
45237 DO 70 KHEP=ICMS+1,NHEP
45238 IF (ISTHEP(KHEP).GT.180.AND.ISTHEP(KHEP).LT.190
45239 $ .AND.JMOHEP(1,KHEP).EQ.ICMS) THEN
45240 ISTHEP(KHEP)=ISTHEP(KHEP)+3
45243 CALL HWUROB(BMR,PPCL(1,JCL),PPCL(1,JCL))
45244 CALL HWULOB(PHEP(1,ICMS),PPCL(1,JCL),PPCL(1,JCL))
45245 C---NOW PPCL(*,JCL) IS LAB MOMENTUM OF JTH CLUSTER
45247 CALL HWULOB(PPCL(1,JCL),PHEP(1,KHEP),PHEP(1,KHEP))
45248 C--BRW FIX 30/12/04 FOR SPACE-TIME STRUCTURE
45249 CALL HWULOB(PPCL(1,JCL),VHEP(1,KHEP),VHEP(1,KHEP))
45250 C--MHS FIX 07/03/05 - ASSUME THAT SOFT CM COINCIDES WITH PRIMARY IP
45251 IF (.NOT.(ISTHEP(KHEP).GT.180.AND.ISTHEP(KHEP).LT.190
45252 $ .AND.JMOHEP(1,KHEP).EQ.ICMS))
45253 $ CALL HWVSUM(4,VHEP(1,3),VHEP(1,KHEP),VHEP(1,KHEP))
45256 ISTHEP(INHEP(1))=167
45257 ISTHEP(INHEP(2))=168
45258 JDAHEP(1,INHEP(1))=ICMS
45259 JDAHEP(2,INHEP(1))=0
45260 JDAHEP(1,INHEP(2))=ICMS
45261 JDAHEP(2,INHEP(2))=0
45262 JDAHEP(1,ICMS)=ICMS+1
45263 JDAHEP(2,ICMS)=LHEP
45269 *CMZ :- -04/05/99 14.17.04 by Bryan Webber
45270 *-- Author : David Ward, modified by Bryan Webber
45271 C-----------------------------------------------------------------------
45272 SUBROUTINE HWMLPS(TECM)
45273 C-----------------------------------------------------------------------
45274 C GENERATES CYLINDRICAL PHASE SPACE USING THE METHOD OF JADACH
45275 C RETURNS WITH NCL=0 IF UNSUCCESSFUL
45276 C-----------------------------------------------------------------------
45277 INCLUDE 'herwig65.inc'
45278 DOUBLE PRECISION HWREXT,HWRUNG,HWUSQR,TECM,ESS,ALOGS,EPS,SUMX,
45279 & SUMY,PT,PX,PY,PT2,SUMPT2,SUMTM,XIMIN,XIMAX,YY,SUM1,SUM2,SUM3,
45280 & SUM4,EX,FY,DD,DYY,ZZ,E1,TM,SLOP,XI(NMXCL)
45281 INTEGER NTRY,I,NIT,IY(NMXCL),IDP
45282 EXTERNAL HWREXT,HWRUNG,HWUSQR
45283 IF (NCL.GT.NMXCL) THEN
45284 CALL HWWARN('HWMLPS',1)
45292 IF (NTRY.GT.NSTRY) THEN
45299 C---Pt distribution of form exp(-b*Mt)
45300 C---Factors for pt slopes to fit data. IDCL contains the type of
45301 C q-qbar pair produced in this cluster (0 if 1-particle cluster).
45305 ELSEIF(IDP.EQ.3.OR.IDP.EQ.10) THEN
45307 ELSEIF(IDP.GT.3.AND.IDP.LE.9) THEN
45310 CALL HWWARN('HWMLPS',IDP)
45311 IF(IDP.LT.0.OR.IDP.GT.49) GOTO 999
45314 PT=HWREXT(PPCL(5,I),SLOP)
45315 PT=HWUSQR(PT**2-PPCL(5,I)**2)
45316 CALL HWRAZM(PT,PX,PY)
45319 SUMX=SUMX+PPCL(1,I)
45320 12 SUMY=SUMY+PPCL(2,I)
45326 PPCL(1,I)=PPCL(1,I)-SUMX
45327 PPCL(2,I)=PPCL(2,I)-SUMY
45328 PT2=PPCL(1,I)**2+PPCL(2,I)**2
45330 C---STORE TRANSVERSE MASS IN PPCL(3,I) TEMPORARILY
45331 PPCL(3,I)=SQRT(PT2+PPCL(5,I)**2)
45332 13 SUMTM=SUMTM+PPCL(3,I)
45333 IF (SUMTM.GT.TECM) GOTO 11
45335 C---Form of "reduced rapidity" distribution
45336 XI(I)=HWRUNG(0.6*ONE,ONE)
45338 CALL HWUSOR(XI,NCL,IY,1)
45340 XIMAX=XI(NCL)-XI(1)
45341 C---N.B. TARGET CLUSTER IS SECOND
45344 XI(I+1)=(XI(I)-XIMIN)/XIMAX
45347 YY=LOG(ESS/(PPCL(3,1)*PPCL(3,2)))
45358 SUM3=SUM3+(TM*EX)*XI(I)
45359 19 SUM4=SUM4+(TM/EX)*XI(I)
45360 FY=ALOGS-LOG(SUM1*SUM2)
45361 DD=(SUM3*SUM2-SUM1*SUM4)/(SUM1*SUM2)
45363 IF(ABS(DYY/YY).LT.EPS) GOTO 20
45365 C---Y ITERATIONS EXCEEDED - TRY AGAIN
45366 IF (NTRY.LT.100) GOTO 11
45368 IF (EPS.GT.ONE) THEN
45369 CALL HWWARN('HWMLPS',100)
45372 CALL HWWARN('HWMLPS',50)
45378 E1=EXP(ZZ+YY*XI(I))
45379 PPCL(3,I)=(0.5*TM)*((1./E1)-E1)
45380 PPCL(4,I)=(0.5*TM)*((1./E1)+E1)
45385 *CMZ :- -26/04/91 11.11.55 by Bryan Webber
45386 *-- Author : David Ward, modified by Bryan Webber
45387 C-----------------------------------------------------------------------
45388 FUNCTION HWMNBI(N,AVNCH,EK)
45389 C-----------------------------------------------------------------------
45390 C---Computes negative binomial probability
45391 C-----------------------------------------------------------------------
45393 DOUBLE PRECISION HWMNBI,AVNCH,EK,R
45399 HWMNBI=(1.+R)**(-EK)
45402 HWMNBI=HWMNBI*R*(EK+I-1)/I
45407 *CMZ :- -27/07/99 13.33.03 by Mike Seymour
45408 *-- Author : Ian Knowles
45409 C-----------------------------------------------------------------------
45410 SUBROUTINE HWMODK(IDKTMP,BRTMP,IMETMP,
45411 & IATMP,IBTMP,ICTMP,IDTMP,IETMP)
45412 C-----------------------------------------------------------------------
45413 C Takes the decay, IDKTMP -> I-(A+B+C+D+E)-TMP, and simply stores it
45414 C if internal pointers not set up (.NOT.DKPSET) else if pre-existing
45415 C mode updates branching ratio BRTMP and matrix element code IMETMP,
45416 C if -ve leaves as is. If a new mode adds to table and if consistent
45417 C adjusts pointers, sets CMMOM (for two-body mode) and resets RSTAB
45418 C if necessary. The branching ratios of any other IDKTMP decays are
45419 C scaled by (1.-BRTMP)/(1.-BR_OLD)
45420 C-----------------------------------------------------------------------
45421 INCLUDE 'herwig65.inc'
45422 DOUBLE PRECISION HWUPCM,BRTMP,SCALE,EPS
45423 INTEGER IDKTMP,IMETMP,IATMP,IBTMP,ICTMP,IDTMP,IETMP,IDKY,ITMP(5),
45425 LOGICAL MATCH(5),IFGO
45428 PARAMETER (EPS=1.D-6)
45429 C Convert to internal format
45430 CALL HWUIDT(1,IDKTMP,IDKY,CDUM)
45431 IF (IDKY.EQ.20) THEN
45433 10 FORMAT(1X,'Particle decaying,',I7,', is not recognised')
45436 CALL HWUIDT(1,IATMP,ITMP(1),CDUM)
45437 CALL HWUIDT(1,IBTMP,ITMP(2),CDUM)
45438 CALL HWUIDT(1,ICTMP,ITMP(3),CDUM)
45439 CALL HWUIDT(1,IDTMP,ITMP(4),CDUM)
45440 CALL HWUIDT(1,IETMP,ITMP(5),CDUM)
45441 C If internal pointers not yet set up simply store decay
45442 IF (.NOT.DKPSET) THEN
45444 IF (NDKYS.GT.NMXDKS) THEN
45445 CALL HWWARN('HWMODK',100)
45449 BRFRAC(NDKYS)=BRTMP
45452 20 IDKPRD(I,NDKYS)=ITMP(I)
45454 IF (NMODES(IDKY).GT.0) THEN
45455 C First search to see if mode pre-exists
45456 IF ((ITMP(2).GE.1.AND.ITMP(2).LE.13).OR.
45457 & (ITMP(3).GE.1.AND.ITMP(3).LE.13)) THEN
45458 C Partonic respect order
45460 DO 30 K=1,NMODES(IDKY)
45461 IF (ITMP(1).EQ.IDKPRD(1,L).AND.
45462 & ITMP(2).EQ.IDKPRD(2,L).AND.
45463 & ITMP(3).EQ.IDKPRD(3,L).AND.
45464 & ITMP(4).EQ.IDKPRD(4,L).AND.
45465 & ITMP(5).EQ.IDKPRD(5,L)) GOTO 90
45468 C Allow for different order in matching
45470 DO 70 I=1,NMODES(IDKY)
45472 40 MATCH(J)=.FALSE.
45475 IF (.NOT.MATCH(K).AND.ITMP(K).EQ.IDKPRD(J,L)) THEN
45481 IF (MATCH(1).AND.MATCH(2).AND.MATCH(3).AND.
45482 & MATCH(4).AND.MATCH(5)) GOTO 90
45486 C A new mode put decay products in table
45488 IF (NDKYS.GT.NMXDKS) THEN
45489 CALL HWWARN('HWMODK',101)
45493 80 IDKPRD(I,NDKYS)=ITMP(I)
45494 C If decay consistent set up new pointers
45495 CALL HWDCHK(IDKY,NDKYS,IFGO)
45497 IF (NMODES(IDKY).EQ.0) THEN
45499 IF (RLTIM(IDKY).LT.PLTCUT.AND.RMASS(IDKY).NE.ZERO) THEN
45500 RSTAB(IDKY)=.FALSE.
45501 DKLTM(IDKY)=RLTIM(IDKY)*RMASS(IDKY)/HBAR
45508 NMODES(IDKY)=NMODES(IDKY)+1
45511 C Set CMMOM if two body decay
45512 IF (NPRODS(L).EQ.2) CMMOM(L)=
45513 & HWUPCM(RMASS(IDKY),RMASS(IDKPRD(1,L)),RMASS(IDKPRD(2,L)))
45514 C A Pre-existing mode, line L, add/update ME code and BR, scaling all
45515 C other branching fractions
45516 90 IF (IMETMP.GT.0) NME(L)=IMETMP
45517 IF (ABS(BRTMP-1.).LT.EPS) THEN
45518 C This modes dominant: eliminate others
45523 ELSEIF (ABS(BRTMP).LT.EPS) THEN
45524 C This mode insignificant: eliminate it
45525 IF (NMODES(IDKY).EQ.1) THEN
45530 LSTRT(IDKY)=LNEXT(J)
45533 DO 100 I=2,NMODES(IDKY)
45535 IF (J.EQ.L) LNEXT(JPREV)=LNEXT(J)
45538 C Rescale other modes
45539 SCALE=ONE/(ONE-BRFRAC(L))
45541 DO 110 I=1,NMODES(IDKY)-1
45542 BRFRAC(J)=SCALE*BRFRAC(J)
45545 NMODES(IDKY)=NMODES(IDKY)-1
45547 C Rescale all other modes
45548 IF (NMODES(IDKY).EQ.1) THEN
45551 IF (L.EQ.NDKYS) THEN
45554 SCALE=(ONE-BRTMP)/(ONE-BRFRAC(L))
45557 DO 120 I=1,NMODES(IDKY)
45558 IF (J.NE.L) BRFRAC(J)=SCALE*BRFRAC(J)
45566 990 FORMAT(1X,'Decay mode inconsistent, no modifications made')
45570 *CMZ :- -04/05/99 11.11.55 by Bryan Webber
45571 *-- Author : David Ward, modified by Bryan Webber
45572 C-----------------------------------------------------------------------
45573 SUBROUTINE HWMULT(EPPBAR,NCHT)
45574 C-----------------------------------------------------------------------
45575 C Chooses charged multiplicity NCHT at the p-pbar c.m. energy EPPBAR
45576 C-----------------------------------------------------------------------
45577 INCLUDE 'herwig65.inc'
45578 DOUBLE PRECISION HWMNBI,HWRGEN,EPPBAR,E0,ALOGS,RK,EK,AVN,SUM,R,
45580 INTEGER NCHT,IMAX,I,N
45582 EXTERNAL HWMNBI,HWRGEN
45584 IF (EPPBAR.NE.E0) THEN
45587 ALOGS=2.*LOG(EPPBAR)
45588 RK=PMBK1*ALOGS+PMBK2
45589 IF (ABS(RK).GT.1000.) RK=1000.
45591 AVN=PMBN1*EXP(PMBN2*ALOGS)+PMBN3
45592 IF (AVN.LT.ONE) AVN=1.
45597 CUM(I)=HWMNBI(N,AVN,EK)
45598 IF (CUM(I).LT.1D-7*SUM) GOTO 11
45604 IF (IMAX.LE.1) THEN
45607 ELSEIF (IMAX.EQ.500) THEN
45609 CALL HWWARN('HWMULT',101)
45613 12 CUM(I)=CUM(I)/SUM
45619 IF(R.GT.CUM(I)) GOTO 20
45623 CALL HWWARN('HWMULT',100)
45627 *CMZ :- -02/11/93 11.11.55 by Bryan Webber
45628 *-- Author : Bryan Webber
45629 C-----------------------------------------------------------------------
45631 C-----------------------------------------------------------------------
45632 C COMPUTES WEIGHT FOR MINIMUM-BIAS EVENT
45633 C-----------------------------------------------------------------------
45634 INCLUDE 'herwig65.inc'
45635 DOUBLE PRECISION S,X,Y
45636 INTEGER IDB,IDT,IDBT
45637 IF (IERROR.NE.0) RETURN
45639 IF (JDAHEP(1,1).NE.0) IDB=IDHW(JDAHEP(1,1))
45641 IF (JDAHEP(1,2).NE.0) IDT=IDHW(JDAHEP(1,2))
45643 IF (IDT.GT.IDB) IDBT=100*IDT+IDB
45644 C---USE TOTAL CROSS SECTION FITS OF DONNACHIE & LANDSHOFF
45646 IF (IDBT.EQ.9173) THEN
45649 ELSEIF (IDBT.EQ.7373) THEN
45652 ELSEIF (IDBT.EQ.7330) THEN
45655 ELSEIF (IDBT.EQ.7338) THEN
45658 ELSEIF (IDBT.EQ.7334) THEN
45661 ELSEIF (IDBT.EQ.7346) THEN
45664 ELSEIF (IDBT.EQ.7359) THEN
45667 ELSEIF (IDBT.EQ.9175) THEN
45670 ELSEIF (IDBT.EQ.7573) THEN
45673 ELSEIF (IDBT.EQ.5959) THEN
45674 C---FOR GAMMA-GAMMA ASSUME X AND Y FACTORIZE
45678 PRINT *,' IDBT=',IDBT
45679 CALL HWWARN('HWMWGT',100)
45683 C---EVWGT IS NON-DIFFRACTIVE CROSS SECTION IN NANOBARNS
45684 C ASSUMING NON-DIFFRACTIVE = TOTAL*0.7
45685 EVWGT=.7E6*(X*S**.0808 + Y*S**(-.4525))
45689 *CMZ :- -11/08/03 15:30:25 by Peter Richardson
45690 *-- Author : Peter Richardson and Zbigniew Was
45691 C-----------------------------------------------------------------------
45692 SUBROUTINE HWPHTP(IHEP)
45693 C-----------------------------------------------------------------------
45694 C subroutine for radiation in top decays
45695 C-----------------------------------------------------------------------
45696 INCLUDE 'herwig65.inc'
45697 INTEGER IHEP,KK,IPOS,NN,NHEP0,KK1,KK2,JMOH(NMXHEP)
45698 DOUBLE PRECISION HWDPWT
45700 C--add an extra photon for top or W
45701 IF(IERROR.NE.0) RETURN
45702 IF(ABS(IDHEP(IHEP)).EQ.6.OR.ABS(IDHEP(IHEP)).EQ.24) THEN
45706 C--copy the colour mother infomation
45708 JMOH(KK)=JMOHEP(2,KK)
45714 C--reset the colour mother infomation
45716 JMOHEP(2,KK)=JMOH(KK)
45718 C--update the decaying particle
45719 JDAHEP(2,IHEP) = NHEP
45720 C--set up the additions photons in the record
45725 C--photon mass probably not needed
45726 PHEP(5,NHEP+1) = ZERO
45727 C--info on the photon
45728 ISTHEP(NHEP+1) = 114
45731 JMOHEP(1,NHEP+1) = IHEP
45732 JMOHEP(2,NHEP+1) = NHEP+1
45733 JDAHEP(2,NHEP+1) = NHEP+1
45740 *CMZ :- -11/08/03 15:30:25 by Peter Richardson
45741 *-- Author : Peter Richardson and Zbigniew Was
45742 C-----------------------------------------------------------------------
45744 C-----------------------------------------------------------------------
45745 C subroutine for radiation in top production
45746 C-----------------------------------------------------------------------
45747 INCLUDE 'herwig65.inc'
45749 INTEGER IMO(10),IFOUND,JMO(2),I,J,K,L,NSTART,NHEPX
45751 IF(IERROR.NE.0) RETURN
45756 C--loop to find mothers of any tops
45759 IF (ABS(IDHEP(I)).EQ.6) THEN
45761 IF(IMO(K).EQ.JMOHEP(1,I)) GOTO 10
45764 IMO(IFOUND)=JMOHEP(1,I)
45768 C--generate the radiation
45770 C--save the colour mother pointers
45771 JMO(1)=JMOHEP(2,JDAHEP(1,IMO(K)))
45772 JMO(2)=JMOHEP(2,1+JDAHEP(1,IMO(K)))
45773 C--zero the second mothers
45774 JMOHEP(2,JDAHEP(1,IMO(K)))=0
45775 JMOHEP(2,JDAHEP(2,IMO(K)))=0
45776 C--call photos to generate radiation
45777 CALL PHOTOS(IMO(K))
45780 IF(IDHEP(J).EQ.22) THEN
45786 C--reset the colour pointers
45787 JMOHEP(2, JDAHEP(1,IMO(K)))=JMO(1)
45788 JMOHEP(2,1+JDAHEP(1,IMO(K)))=JMO(2)
45789 C--setup the photons
45799 *CMZ :- -26/04/91 11.11.55 by Bryan Webber
45800 *-- Author : Bryan Webber
45801 C-----------------------------------------------------------------------
45802 SUBROUTINE HWRAZM(PT,PX,PY)
45803 C-----------------------------------------------------------------------
45804 C RANDOMLY ROTATED 2-VECTOR (PX,PY) OF LENGTH PT
45805 C-----------------------------------------------------------------------
45807 DOUBLE PRECISION HWRGEN,PT,PX,PY,C,S,CS,QT,ONE,ZERO
45808 PARAMETER(ONE=1.0D0, ZERO=0.0D0)
45810 10 C=2.*HWRGEN(1)-1.
45813 IF (CS.GT.ONE .OR. CS.EQ.ZERO) GOTO 10
45819 *CMZ :- -26/04/91 11.11.55 by Bryan Webber
45820 *-- Author : David Ward, modified by Bryan Webber
45821 C-----------------------------------------------------------------------
45822 FUNCTION HWREXP(AV)
45823 C-----------------------------------------------------------------------
45824 C Random number from dN/d(x**2)=exp(-b*x) with mean AV
45825 C-----------------------------------------------------------------------
45827 DOUBLE PRECISION HWREXP,HWRGEN,AV,B,R1,R2
45832 HWREXP=-LOG(R1*R2)/B
45835 *CMZ :- -02/06/94 11.02.47 by Mike Seymour
45836 *-- Author : David Ward, modified by Bryan Webber and Mike Seymour
45837 C-----------------------------------------------------------------------
45838 FUNCTION HWREXQ(AV,XMAX)
45839 C-----------------------------------------------------------------------
45840 C Random number from dN/d(x**2)=EXQ(-b*x) with mean AV,
45841 C But truncated at XMAX
45842 C-----------------------------------------------------------------------
45844 DOUBLE PRECISION HWREXQ,HWRGEN,AV,B,BXMAX,R1,R2,XMAX,R,RMIN
45848 IF (BXMAX.LT.50) THEN
45853 10 R1=HWRGEN(0)*(1-RMIN)+RMIN
45854 R2=HWRGEN(1)*(1-RMIN)+RMIN
45856 IF (R.LT.RMIN) GOTO 10
45860 *CMZ :- -26/04/91 11.11.55 by Bryan Webber
45861 *-- Author : David Ward, modified by Bryan Webber
45862 C-----------------------------------------------------------------------
45863 FUNCTION HWREXT(AM0,B)
45864 C-----------------------------------------------------------------------
45865 C Random number from dN/d(x**2)=exp(-B*TM) distribution, where
45866 C TM = SQRT(X**2+AM0**2). Uses Newton's method to solve F-R=0
45867 C-----------------------------------------------------------------------
45869 DOUBLE PRECISION HWREXT,HWRGEN,AM0,B,R,A,F,DF,DAM,AM
45873 C --- Starting value
45876 A=EXP(-B*(AM-AM0))/(1.+B*AM0)
45881 IF(AM.LT.AM0) AM=AM0+.001
45882 IF(ABS(DAM).LT..001) GOTO 2
45884 CALL HWWARN('HWREXT',1)
45888 *CMZ :- -19/05/99 11.11.56 by Mike Seymour
45889 *-- Author : Mike Seymour
45890 C-----------------------------------------------------------------------
45891 FUNCTION HWRGAU(J,A,B)
45892 C-----------------------------------------------------------------------
45893 C Gaussian random number, mean A, standard deviation B.
45894 C Generates uncorrelated pairs and throws one of them away.
45895 C-----------------------------------------------------------------------
45896 INCLUDE 'herwig65.inc'
45897 DOUBLE PRECISION HWRGAU,HWRGEN,A,B,X,TRASH
45901 IF (X.LE.ZERO.OR.X.GT.ONE) GOTO 10
45902 X=SQRT(-TWO*LOG(X))
45903 CALL HWRAZM(X,X,TRASH)
45907 *CMZ :- -26/04/91 12.42.30 by Federico Carminati
45908 *-- Author : F. James, modified by Mike Seymour
45909 *- Split in 3 files by M. Kirsanov. Initial seeds ISEED set in HWUDAT
45910 C-----------------------------------------------------------------------
45912 C FUNCTION HWRGEN(I)
45913 C-----------------------------------------------------------------------
45914 C MAIN RANDOM NUMBER GENERATOR
45915 C USES METHOD OF l'Ecuyer, (VIA F.JAMES, COMP PHYS COMM 60(1990)329)
45916 C-----------------------------------------------------------------------
45918 C DOUBLE PRECISION HWRGEN
45919 C COMMON/HWSEED/ISEED(2)
45924 C ISEED(1)=40014*(ISEED(1)-K*53668)-K*12211
45925 C IF (ISEED(1).LT.0) ISEED(1)=ISEED(1)+2147483563
45927 C ISEED(2)=40692*(ISEED(2)-K*52774)-K*3791
45928 C IF (ISEED(2).LT.0) ISEED(2)=ISEED(2)+2147483399
45929 C IZ=ISEED(1)-ISEED(2)
45930 C IF (IZ.LT.1) IZ=IZ+2147483562
45931 C HWRGEN=DBLE(IZ)*4.656613001013252D-10
45932 C---> (4.656613001013252D-10 = 1.D0/2147483589)
45935 *CMZ :- -26/04/91 12.42.30 by Federico Carminati
45936 *-- Author : F. James, modified by Mike Seymour
45937 C-----------------------------------------------------------------------
45938 FUNCTION HWRSET(JSEED)
45939 C-----------------------------------------------------------------------
45940 C MAIN RANDOM NUMBER GENERATOR
45942 C-----------------------------------------------------------------------
45944 DOUBLE PRECISION HWRSET
45945 COMMON/HWSEED/ISEED(2)
45949 IF (JSEED(1).EQ.0.OR.JSEED(2).EQ.0) THEN
45950 CALL HWWARN('HWRSET',99)
45958 *CMZ :- -26/04/91 12.42.30 by Federico Carminati
45959 *-- Author : F. James, modified by Mike Seymour
45960 C-----------------------------------------------------------------------
45961 FUNCTION HWRGET(JSEED)
45962 C-----------------------------------------------------------------------
45963 C MAIN RANDOM NUMBER GENERATOR
45965 C-----------------------------------------------------------------------
45967 DOUBLE PRECISION HWRGET
45968 COMMON/HWSEED/ISEED(2)
45977 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
45978 *-- Author : Bryan Webber
45979 C-----------------------------------------------------------------------
45980 FUNCTION HWRINT(IMIN,IMAX)
45981 C-----------------------------------------------------------------------
45982 C RANDOM INTEGER IN [IMIN,IMAX]. N.B. ASSUMES IMAX.GE.IMIN
45983 C-----------------------------------------------------------------------
45985 DOUBLE PRECISION HWRGEN,RN,ONE
45986 INTEGER HWRINT,IMIN,IMAX
45988 PARAMETER (ONE=1.0D0)
45990 IF (RN.EQ.ONE) GOTO 1
45991 RN=RN*(IMAX-IMIN+1)
45992 HWRINT=IMIN+INT(RN)
45995 *CMZ :- -26/04/91 14.15.56 by Federico Carminati
45996 *-- Author : Bryan Webber
45997 C-----------------------------------------------------------------------
45999 C-----------------------------------------------------------------------
46000 C Returns .TRUE. with probability A
46001 C-----------------------------------------------------------------------
46003 DOUBLE PRECISION HWRGEN,A,R
46008 IF(R.GT.A) HWRLOG=.FALSE.
46011 *CMZ :- -07/09/00 10:06:23 by Peter Richardson
46012 *-- Author : Ian Knowles
46013 C-----------------------------------------------------------------------
46015 C-----------------------------------------------------------------------
46016 C Generates a random primary IP using a triple Gaussian distribution
46017 C-----------------------------------------------------------------------
46018 INCLUDE 'herwig65.inc'
46019 DOUBLE PRECISION HWRGAU
46023 10 VTXPIP(I)=HWRGAU(I,ZERO,VIPWID(I))
46027 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
46028 *-- Author : Bryan Webber
46029 C-----------------------------------------------------------------------
46030 SUBROUTINE HWRPOW(XVAL,XJAC)
46031 C-----------------------------------------------------------------------
46032 C RETURNS XVAL DISTRIBUTED ON (XMIN,XMAX) LIKE XVAL**XPOW
46033 C AND CORRESPONDING JACOBIAN FACTOR XJAC
46034 C SET FIRST=.TRUE. IF NEW XMIN,XMAX OR XPOW
46035 C-----------------------------------------------------------------------
46037 DOUBLE PRECISION HWRGEN,XVAL,XJAC,XMIN,XMAX,XPOW,P,Q,A,B,C,Z,ZERO
46039 PARAMETER(ZERO=0.0D0)
46042 COMMON/HWRPIN/XMIN,XMAX,XPOW,FIRST
46045 IF (P.EQ.ZERO) CALL HWWARN('HWRPOW',500)
46057 *CMZ :- -26/04/91 14.55.45 by Federico Carminati
46058 *-- Author : David Ward, modified by Bryan Webber
46059 C-----------------------------------------------------------------------
46060 FUNCTION HWRUNG(A,B)
46061 C-----------------------------------------------------------------------
46062 C Random number from distribution having flat top [-A,A] & gaussian
46064 C-----------------------------------------------------------------------
46066 DOUBLE PRECISION HWRUNG,HWRGAU,HWRUNI,A,B,PRUN,ZERO
46068 EXTERNAL HWRGAU,HWRUNI,HWRLOG
46069 PARAMETER (ZERO=0.D0)
46070 IF (A.EQ.ZERO) THEN
46073 PRUN=1./(1.+B*1.2533/A)
46075 IF(HWRLOG(PRUN)) THEN
46076 HWRUNG=HWRUNI(0,-A,A)
46078 HWRUNG=HWRGAU(0,ZERO,B)
46079 HWRUNG=HWRUNG+SIGN(A,HWRUNG)
46083 *CMZ :- -26/04/91 14.55.45 by Federico Carminati
46084 *-- Author : Bryan Webber
46085 C-----------------------------------------------------------------------
46086 FUNCTION HWRUNI(I,A,B)
46087 C-----------------------------------------------------------------------
46088 C Uniform random random number in range [A,B]
46089 C-----------------------------------------------------------------------
46091 DOUBLE PRECISION HWRUNI,HWRGEN,A,B,RN
46098 *CMZ :- -18/10/99 19.08.45 by Mike Seymour
46099 *-- Author : Bryan Webber
46100 C-----------------------------------------------------------------------
46101 SUBROUTINE HWSBRN(KPAR)
46102 C-----------------------------------------------------------------------
46103 C DOES BRANCHING OF SPACELIKE PARTON KPAR
46104 C-----------------------------------------------------------------------
46105 INCLUDE 'herwig65.inc'
46106 DOUBLE PRECISION HWBVMC,HWRGEN,HWRUNI,HWSTAB,HWUALF,HWUTAB,HWSGQQ,
46107 & HWSSUD,XLAST,QNOW,QLST,QP,QMIN,QLAM,QSAV,SMAX,SLST,SNOW,RN,SUDA,
46108 & SUDB,ZZ,ENOW,XI,PMOM,DIST(13),DMIN,X1,X2,REJFAC,OTHXI,OTHZ,QTMP,
46109 & PTMP(2),JAC,OTHJAC,S,T,U,EMB2,PTMX
46110 INTEGER N0,IS,ID,ID1,ID2,IDHAD,N1,I,MQ,NTRY,NDEL,NA,NB,IW1,IW2,
46111 & KPAR,LPAR,MPAR,ISUD(13),IREJ,NREJ
46112 LOGICAL HWSVAL,FORCE,VALPAR,FTMP
46113 EXTERNAL HWBVMC,HWRGEN,HWRUNI,HWSTAB,HWUALF,HWUTAB,HWSGQQ,HWSSUD,
46115 COMMON/HWTABC/XLAST,N0,IS,ID
46117 DATA ISUD,DMIN/2,2,3,4,5,6,2,2,3,4,5,6,1,1.D-15/
46118 IF (IERROR.NE.0) RETURN
46120 C--TEST FOR PARTON TYPE
46123 ELSEIF (ID.GE.208) THEN
46130 C--SPACELIKE PARTON BRANCHING
46135 XLAST=XFACT*PPAR(4,KPAR)
46136 IF (XLAST.GE.ONE) THEN
46137 CALL HWWARN('HWSBRN',107)
46140 C--SET UP Q BOUNDARY
46143 ELSEIF (ID.EQ.13) THEN
46146 QMIN=.5*(QP+QV+SQRT((QP-QV)**2+4.*QP*QV*XLAST))/(1.-XLAST)
46149 IF (QMIN.LE.QSPAC.AND.ISPAC.LT.2) THEN
46152 ELSEIF (QMIN.LE.QEV(1,IS)) THEN
46157 IF (QEV(I,IS).GT.QMIN) GOTO 120
46166 IF (QLST.GT.QMIN.AND..NOT.NOSPAC.OR..NOT.VALPAR) THEN
46167 IF (QLST.LE.QMIN) THEN
46168 C--CHECK PHASE SPACE FOR FORCED SPLITTING OF NON-VALENCE PARTON
46169 IF (QLST.LT.QSAV) THEN
46170 CALL HWWARN('HWSBRN',ISLENT*105)
46174 QNOW=(QLST/QSAV)**HWRGEN(0)*QSAV
46176 C--ENHANCE EMISSION BY A FACTOR OF TWO IF THIS BRANCH
46177 C IS CAPABLE OF BEING THE HARDEST SO FAR
46178 IF (QLST.GT.HARDST) NREJ=2
46181 C--FIND NEW VALUE OF SUD/DIST
46182 CALL HWSFUN(XLAST,QMIN,IDHAD,NSTRU,DIST,JNHAD)
46183 IF (ID.EQ.13) DIST(ID)=DIST(ID)*HWSGQQ(QMIN)
46184 IF (DIST(ID).LT.DMIN) DIST(ID)=DMIN
46185 SMAX=HWUTAB(SUD(N1,IS),QEV(N1,IS),MQ,QMIN,INTER)/DIST(ID)
46186 CALL HWSFUN(XLAST,QLST,IDHAD,NSTRU,DIST,JNHAD)
46187 IF (ID.EQ.13) DIST(ID)=DIST(ID)*HWSGQQ(QLST)
46188 IF (DIST(ID).LT.DMIN) DIST(ID)=DMIN
46189 SLST=HWUTAB(SUD(N1,IS),QEV(N1,IS),MQ,QLST,INTER)/DIST(ID)
46191 IF (RN.EQ.ZERO) THEN
46196 IF (VALPAR.AND.SNOW.GE.SMAX) GOTO 200
46197 IF (SNOW.LT.SMAX.AND..NOT.NOSPAC) THEN
46200 C--FORCE SPLITTING OF NON-VALENCE PARTON
46202 QNOW=(MIN(QLST,1.1*QMIN)/QSAV)**HWRGEN(0)*QSAV
46204 IF (QNOW.LT.ZERO) THEN
46205 C--BRANCHING OCCURS. FIRST CHECK FOR MONOTONIC FORM FACTOR
46210 IF (NB.GT.NQEV) THEN
46211 CALL HWWARN('HWSBRN',103)
46214 CALL HWSFUN(XLAST,QEV(NB,IS),IDHAD,NSTRU,DIST,JNHAD)
46215 IF (ID.EQ.13) DIST(ID)=DIST(ID)*HWSGQQ(QEV(NB,IS))
46216 IF (DIST(ID).LT.DMIN) DIST(ID)=DMIN
46217 SUDB=SUD(NB,IS)/DIST(ID)
46218 IF (SUDB.GT.SUDA) THEN
46222 ELSEIF (NA.NE.N1) THEN
46223 IF (SUDB.LT.SNOW) THEN
46225 IF (NDEL.EQ.0) THEN
46226 CALL HWWARN('HWSBRN',100)
46236 QNOW=HWSTAB(QEV(N1,IS),HWSSUD,MQ,SNOW,INTER)
46237 IF (QNOW.LE.QMIN.OR.QNOW.GT.QLST) THEN
46238 C--INTERPOLATION PROBLEM: USE LINEAR INSTEAD
46239 C CALL HWWARN('HWSBRN',1)
46240 QNOW=HWRUNI(0,QMIN,QLST)
46244 IF (QNOW.GT.QTMP) THEN
46253 IF (QNOW.LT.ZERO) GOTO 210
46255 CALL HWSFBR(XLAST,QNOW,FORCE,ID,1,ID1,ID2,IW1,IW2,ZZ)
46257 C--NO PHASE SPACE FOR BRANCHING
46260 ELSEIF (ID1.EQ.0) THEN
46261 C--BRANCHING REJECTED: REDUCE Q AND REPEAT
46262 IF (NTRY.GT.NBTRY.OR.IERROR.NE.0) THEN
46263 CALL HWWARN('HWSBRN',102)
46269 ELSEIF (ID1.EQ.59) THEN
46270 C--ANOMALOUS PHOTON SPLITTING: ADD PT TO INTRINSIC PT AND STOP BRANCHING
46271 IF (IDHAD.NE.59) THEN
46272 CALL HWWARN('HWSBRN',109)
46275 ENOW=PPAR(4,KPAR)/XLAST
46277 QLAM=QNOW*(1.-XLAST)
46278 IF ((2.-XI)*QLAM**2.GT.EMSCA**2) THEN
46279 C--BRANCHING REJECTED: REDUCE Q AND REPEAT
46280 IF (NTRY.GT.NBTRY) THEN
46281 CALL HWWARN('HWSBRN',110)
46288 CALL HWRAZM(QNOW*(1.-XLAST),PTMP(1),PTMP(2))
46289 CALL HWVSUM(2,PTMP,PTINT(1,JNHAD),PTINT(1,JNHAD))
46290 PTINT(3,JNHAD)=PTINT(1,JNHAD)**2+PTINT(2,JNHAD)**2
46291 ANOMSC(1,JNHAD)=QNOW
46292 ANOMSC(2,JNHAD)=QNOW*(1.-XLAST)
46296 ELSEIF (FORCE.AND..NOT.HWSVAL(ID1).AND.ID1.NE.13) THEN
46297 C--FORCED BRANCHING PRODUCED A NON-VALENCE PARTON: TRY AGAIN
46298 IF (NTRY.GT.NBTRY) THEN
46299 CALL HWWARN('HWSBRN',108)
46308 IF (QNOW.GT.ZERO) THEN
46309 C--BRANCHING HAS OCCURRED
46310 ENOW=PPAR(4,KPAR)/ZZ
46313 IF ((SUDORD.EQ.1.AND.HWUALF(2,QLAM).LT.HWRGEN(0) .OR.
46314 & (2.-XI)*QLAM**2.GT.EMSCA**2).AND..NOT.FORCE) THEN
46315 C--BRANCHING REJECTED: REDUCE Q AND REPEAT
46316 IF (NTRY.GT.NBTRY) THEN
46317 CALL HWWARN('HWSBRN',104)
46324 C--IF THIS IS HARDEST EMISSION SO FAR, APPLY MATRIX-ELEMENT CORRECTION
46325 IF (.NOT.FORCE) THEN
46327 IF (QLAM.GT.HARDST .AND. ID.NE.13) THEN
46328 IF (MOD(ISTHEP(JCOPAR(1,1)),10).GE.3) THEN
46329 C---COLOUR PARTNER IS OUTGOING (X1=XP, X2=ZP)
46330 X2=SQRT((ZZ**2-(1-ZZ)*XI)**2+2*(ZZ*(1-ZZ))**2*XI*(2-XI))
46331 X1=(ZZ**2+(1-ZZ)*XI-X2)/(2*(1-ZZ)*XI)
46332 X2=(ZZ**2-(1-ZZ)*XI+X2)/(2*ZZ**2)
46333 IF (ID2.EQ.13) THEN
46335 REJFAC=ZZ**3*(1-X1-X2+2*X1*X2)
46336 $ /(X1**2*(1-ZZ)*(ZZ+XI*(1-ZZ)))
46337 $ *(1+ZZ**2)/((1-ZZ)*XI)
46339 $ (1+(1-X1-X2+2*X1*X2)**2+2*(1-X1)*(1-X2)*X1*X2)
46340 C---CHECK WHETHER IT IS IN THE OVERLAP REGION
46341 OTHXI=2*(1-X1)/(1-X1+2*(3*X1-2)*X2*(1-X2))
46342 IF (OTHXI.LT.ONE) THEN
46343 OTHZ=(1-(2*X2-1)*SQRT((3*X1-2)/X1))/2
46344 REJFAC=REJFAC+SQRT(3-2/X1)/(X1**2*OTHZ*(1-OTHZ))
46345 $ *(1+(1-OTHZ)**2)/(OTHZ*OTHXI)
46347 $ (1+(1-X1-X2+2*X1*X2)**2+2*(1-X1)*(1-X2)*X1*X2)
46349 ELSEIF (ID1.EQ.13) THEN
46350 C---GLUON SPLITTING
46351 REJFAC=ZZ**3*(1-X1-X2+2*X1*X2)
46352 $ /(X1**2*(1-ZZ)*(ZZ+XI*(1-ZZ)))
46353 $ *(ZZ**2+(1-ZZ)**2)/XI
46355 $ (( X1+X2-2*X1*X2)**2+2*(1-X1)*(1-X2)*X1*X2
46356 $ +(1-X1-X2+2*X1*X2)**2+2*(1-X1)*(1-X2)*X1*X2)
46359 C---COLOUR PARTNER IS ALSO INCOMING
46361 S=2*(ZZ**2+(1-ZZ)*XI)/(ZZ**2*(2*ZZ+XI*(1-ZZ)))
46363 JAC=-T*(1-T)/S**2*ZZ**5/(XI*(1-ZZ)**2*(ZZ+XI*(1-ZZ)))
46364 IF (ID2.EQ.13) THEN
46366 REJFAC=(1+ZZ**2)/((1-ZZ)*ZZ*XI)
46367 & *JAC*S**2*T*U/((1-U)**2+(1-T)**2)
46368 C---CHECK WHETHER IT IS IN THE OVERLAPPING REGION
46369 OTHZ=(1+SQRT(1-2*U*(1-U)/S))/U
46370 OTHXI=2*(1-OTHZ+T/S)/(1-OTHZ)
46371 IF (OTHXI.LT.OTHZ**2) THEN
46372 OTHJAC=-U*(1-U)/S**2*OTHZ**5/(OTHXI*
46373 & (1-OTHZ)**2*(OTHZ+OTHXI*(1-OTHZ)))
46374 REJFAC=REJFAC+(1+OTHZ**2)/((1-OTHZ)*OTHZ*OTHXI)
46375 & *OTHJAC*S**2*T*U/((1-U)**2+(1-T)**2)
46377 ELSEIF (ID1.EQ.13) THEN
46378 C---GLUON SPLITTING
46379 REJFAC=-((1-ZZ)**2+ZZ**2)/(ZZ*XI)
46380 & *JAC*S**3*T/((1-S)**2+(1-T)**2)
46384 IF (NREJ*REJFAC*HWRGEN(NREJ).GT.ONE) THEN
46389 IF (QLAM.GT.HARDST) HARDST=QLAM
46391 IF (IW2.GT.IW1) THEN
46394 C---NEW MOTHER-DAUGHTER RELATIONS
46395 C N.B. DEFINED MOVING AWAY FROM HARD PROCESS
46396 JDAPAR(1,KPAR)=LPAR
46397 JDAPAR(2,KPAR)=MPAR
46398 C---NEW COLOUR CONNECTIONS
46399 JCOPAR(3,KPAR)=MPAR
46400 JCOPAR(4,KPAR)=LPAR
46401 JCOPAR(1,MPAR)=KPAR
46402 JCOPAR(2,MPAR)=LPAR
46403 JCOPAR(1,LPAR)=MPAR
46404 JCOPAR(2,LPAR)=KPAR
46408 JDAPAR(1,KPAR)=MPAR
46409 JDAPAR(2,KPAR)=LPAR
46410 JCOPAR(3,KPAR)=LPAR
46411 JCOPAR(4,KPAR)=MPAR
46412 JCOPAR(1,MPAR)=LPAR
46413 JCOPAR(2,MPAR)=KPAR
46414 JCOPAR(1,LPAR)=KPAR
46415 JCOPAR(2,LPAR)=MPAR
46417 JMOPAR(1,LPAR)=KPAR
46418 JMOPAR(1,MPAR)=KPAR
46421 TMPAR(LPAR)=.FALSE.
46426 PPAR(1,MPAR)=QNOW*(1.-ZZ)
46428 PPAR(4,MPAR)=ENOW*(1.-ZZ)
46432 IF (QNOW.LT.ZERO) THEN
46439 C---PUT SPECTATOR (APPROXIMATELY) ON-SHELL
46440 XLAST=XFACT*PPAR(4,KPAR)
46441 IF ((1-XLAST)**2.LT.(RMASS(ID)**2+PTINT(3,JNHAD))*XFACT**2)
46446 C---BRW MOD: INCLUDE HIGHER ORDER CORRECTION IN MASS CALCULATION
46447 c$$$ PPAR(5,KPAR)=-(RMASS(ID)**2*XLAST+PTINT(3,JNHAD))/(1.-XLAST)
46448 c$$$ & +XLAST*SIGN(PHEP(5,INHAD)**2,PHEP(5,INHAD))
46449 PTMX=(RMASS(ID)**2+PTINT(3,JNHAD))/(ONE-XLAST)
46450 EMB2=SIGN(PHEP(5,INHAD)**2,PHEP(5,INHAD))
46451 PPAR(5,KPAR)=-PTINT(3,JNHAD)-XLAST*(PTMX-EMB2)-0.25D0*
46452 $ ((PTMX-EMB2)**2+XLAST*(PTMX**2/(ONE-XLAST)-EMB2**2))*XFACT**2
46454 ELSEIF (ID.EQ.IDHW(INHAD)) THEN
46455 C---IF INCOMING PARTON IS INCOMING BEAM, ALLOW IT TO BE OFF-SHELL
46456 PPAR(5,KPAR)=SIGN(PHEP(5,INHAD)**2,PHEP(5,INHAD))
46458 PPAR(5,KPAR)=RMASS(ID)**2
46460 PMOM=PPAR(4,KPAR)**2-PPAR(5,KPAR)
46461 IF (PMOM.LT.ZERO) THEN
46465 PPAR(3,KPAR)=SQRT(PMOM)
46470 *CMZ := =26/04/91 12.47.48 by Federico Carminati
46471 *-- Author : Drees, Grassie, Charchula, modified by Bryan Webber
46472 C ===============================================================
46473 C DREES & GRASSIE PARAMETRIZATION OF PHOTON STRUCTURE FUNCTION
46475 C HWSDGQ(X,Q2,NFL,NCH) - X*QUARK_IN_PHOTON/ALPHA (!)
46476 C HWSDGG(X,Q2,NFL) - X*GLUON_IN_PHOTON/ALPHA (!)
46478 C (INTEGER) NCH - QUARK CHARGE: 1 FOR 1/3
46480 C (INTEGER) NFL - NUMBER OF QUARK FLAVOURS /3 OR 4/
46481 C Q2 - SQUARE OF MOMENTUM Q /IN GEV2/
46482 C X - LONGITUDINAL FRACTION
46485 C NFL=3: 1 < Q2 < 50 GEV^2
46486 C NFL=4: 20 < Q2 < 500 GEV^2
46487 C NFL=5: 200 < Q2 < 10^4 GEV^2
46490 C KRZYSZTOF CHARCHULA /14.02.1989/
46491 C================================================================
46493 C PS. Note that for the case of three flavors, one has to add
46494 C the QPM charm contribution for getting F2.
46496 C================================================================
46497 C MODIFIED FOR HERWIG BY BRW 19/4/91
46498 C--- -----------------------------------------------
46499 C GLUON PART OF THE PHOTON SF
46500 C--- -----------------------------------------------
46501 FUNCTION HWSDGG(X,Q2,NFL)
46502 IMPLICIT REAL (A-H,P-Z)
46504 DIMENSION A(3,4,3),AT(3)
46507 C- --- CHECK WHETHER NFL HAVE RIGHT VALUES -----
46508 IF (.NOT.((NFL.EQ.3).OR.(NFL.EQ.4).OR.(NFL.EQ.5)))THEN
46510 131 FORMAT(' NUMBER OF FLAVOURS(NFL) HAS NOT BEEN SET TO: 3,4 OR 5;'/
46511 *' NFL=3 IS ASSUMED')
46513 ELSEIF (T.LE.0) THEN
46515 132 FORMAT(' HWSDGG CALLED WITH SCALE < LAMBDA. RETURNING ZERO.')
46519 C ------ INITIALIZATION OF PARAMETERS ARRAY -----
46520 DATA(((A(I,J,K),I=1,3),J=1,4),K=1,3)/
46521 + -0.20700,-0.19870, 5.11900,
46522 + 0.61580, 0.62570,-0.27520,
46523 + 1.07400, 8.35200,-6.99300,
46524 + 0.00000, 5.02400, 2.29800,
46525 + 0.8926E-2, 0.05090,-0.23130,
46526 + 0.659400, 0.27740, 0.13820,
46527 + 0.476600,-0.39060, 6.54200,
46528 + 0.019750,-0.32120, 0.51620,
46529 + 0.031970, -0.618E-2, -0.1216,
46530 + 1.0180, 0.94760, 0.90470,
46531 + 0.24610, -0.60940, 2.6530,
46532 + 0.027070, -0.010670, 0.2003E-2/
46533 C ------ Q2 DEPENDENCE -----------
46536 AT(I)=A(I,1,LF)*T**A(I,2,LF)+A(I,3,LF)*T**(-A(I,4,LF))
46538 C ------ GLUON DISTRIBUTION -------------
46539 HWSDGG=AT(1)*X**AT(2)*(1.0-X)**AT(3)/137.
46542 *CMZ :- -26/04/91 13.04.45 by Federico Carminati
46543 *-- Author : Drees, Grassie, Charchula, modified by Bryan Webber
46544 C --------------------------------------
46545 C QUARK PART OF THE PHOTON SF
46546 C --------------------------------------
46547 FUNCTION HWSDGQ(X,Q2,NFL,NCH)
46548 IMPLICIT REAL (A-H,P-Z)
46550 DIMENSION A(5,4,2,3),AT(5,2),XQPOM(2),E(2)
46552 C SQUARE OF LAMBDA=0.4 GEV
46556 C CHECK WHETHER NFL AND NCH HAVE RIGHT VALUES
46558 IF(.NOT.((NFL.EQ.3).OR.(NFL.EQ.4).OR.(NFL.EQ.5))) THEN
46560 111 FORMAT('NUMBER OF FLAVOURS (NFL) HAS NOT BEEN SET TO: 3,4 OR 5'/
46561 *' NFL=3 IS ASSUMED')
46563 ELSEIF (T.LE.0) THEN
46565 132 FORMAT(' HWSDGQ CALLED WITH SCALE < LAMBDA. RETURNING ZERO.')
46569 IF (.NOT.((NCH.EQ.1).OR.(NCH.EQ.2))) THEN
46571 121 FORMAT(' QUARK CHARGE NUMBER (NCH) HAS NOT BEEN SET',
46573 *' NCH=1 IS ASSUMED')
46576 C ------ INITIALIZATION ------
46577 DATA(((A(I,J,K,1),I=1,5),J=1,4),K=1,2)/
46578 + 2.28500, 6.07300, -0.42020,-0.08080, 0.05530,
46579 +-0.01530, -0.81320, 0.01780, 0.63460, 1.13600,
46580 + 1.3300E3,-41.3100, 0.92160, 1.20800, 0.95120,
46581 + 4.21900, 3.16500, 0.18000, 0.20300, 0.01160,
46582 +16.6900, 0.17600, -0.02080,-0.01680,-0.19860,
46583 +-0.79160, 0.04790, 0.3386E-2,1.35300, 1.10000,
46584 + 1.0990E3, 1.04700, 4.85300, 1.42600, 1.13600,
46585 + 4.42800, 0.02500, 0.84040, 1.23900,-0.27790/
46586 DATA(((A(I,J,K,2),I=1,5),J=1,4),K=1,2)/
46587 +-0.37110,-0.17170, 0.087660,-0.89150,-0.18160,
46588 + 1.06100, 0.78150, 0.021970, 0.28570, 0.58660,
46589 + 4.75800, 1.53500, 0.109600, 2.97300, 2.42100,
46590 +-0.01500, 0.7067E-2,0.204000, 0.11850, 0.40590,
46591 +-0.12070,25.00000,-0.012300,-0.09190, 0.020150,
46592 + 1.07100,-1.64800, 1.162000, 0.79120, 0.98690,
46593 + 1.97700,-0.015630,0.482400, 0.63970,-0.070360,
46594 +-0.8625E-2,6.43800,-0.011000, 2.32700, 0.016940/
46595 DATA(((A(I,J,K,3),I=1,5),J=1,4),K=1,2)/
46596 +15.80, 2.7420, 0.029170,-0.03420, -0.023020,
46597 +-0.94640, -0.73320, 0.046570, 0.71960, 0.92290,
46598 +-0.50, 0.71480, 0.17850, 0.73380, 0.58730,
46599 +-0.21180, 3.2870, 0.048110, 0.081390,-0.79E-4,
46600 + 6.7340, 59.880, -0.3226E-2,-0.03321, 0.10590,
46601 +-1.0080, -2.9830, 0.84320, 0.94750, 0.69540,
46602 +-0.085940, 4.480, 0.36160, -0.31980, -0.66630,
46603 + 0.076250, 0.96860, 0.1383E-2, 0.021320, 0.36830/
46604 C ------- EVALUATION OF PARAMETERS IN Q2 ---------
46609 ELSEIF (NFL.EQ.4) THEN
46612 ELSEIF (NFL.EQ.5) THEN
46618 ATP=A(I,1,J,LF)*T**A(I,2,J,LF)
46619 AT(I,J)=ATP+A(I,3,J,LF)*T**(-A(I,4,J,LF))
46623 POM1=X*(X*X+(1.0-X)**2)/(AT(1,J)-AT(2,J)*ALOG(1.0-X))
46624 POM2=AT(3,J)*X**AT(4,J)*(1.0-X)**AT(5,J)
46625 XQPOM(J)=E(J)*POM1+POM2
46627 C ------- QUARK DISTRIBUTIONS ----------
46631 HWSDGQ=1.0/6.0*(XQPOM(2)+9.0*XQPOM(1))
46632 ELSEIF(NCH.EQ.1) THEN
46633 HWSDGQ=1.0/6.0*(XQPOM(2)-9.0/2.0*XQPOM(1))
46635 F2=2.0/9.0*XQPOM(2)+XQPOM(1)
46636 ELSEIF (NFL.EQ.4) THEN
46638 HWSDGQ=1.0/8.0*(XQPOM(2)+6.0*XQPOM(1))
46639 ELSEIF(NCH.EQ.1) THEN
46640 HWSDGQ=1.0/8.0*(XQPOM(2)-6.0*XQPOM(1))
46642 F2=5.0/18.0*XQPOM(2)+XQPOM(1)
46643 ELSEIF (NFL.EQ.5) THEN
46645 HWSDGQ=1.0/10.0*(XQPOM(2)+15.0/2.0*XQPOM(1))
46646 ELSEIF(NCH.EQ.1) THEN
46647 HWSDGQ=1.0/10.0*(XQPOM(2)-5.0*XQPOM(1))
46649 F2=11.0/45.0*XQPOM(2)+XQPOM(1)
46654 *CMZ :- -15/07/92 14.08.45 by Mike Seymour
46655 *-- Author : Bryan Webber
46656 C-----------------------------------------------------------------------
46657 SUBROUTINE HWSFBR(X,QQ,FORCED,ID,IW,ID1,ID2,IW1,IW2,Z)
46658 C-----------------------------------------------------------------------
46659 C FINDS BRANCHING (ID1->ID+ID2) AND Z=X/X1 IN BACKWARD
46660 C EVOLUTION AT ENERGY FRACTION X AND SCALE QQ
46662 C FORCED=.TRUE. FORCES SPLITTING OF NON-VALENCE PARTON
46664 C IW,IW1,IW2 ARE COLOUR CONNECTION WORDS
46666 C ID1.LT.0 ON RETURN MEANS NO PHASE SPACE
46667 C ID1.EQ.0 ON RETURN FLAGS REJECTED BRANCHINGS
46668 C-----------------------------------------------------------------------
46669 INCLUDE 'herwig65.inc'
46670 DOUBLE PRECISION HWBVMC,HWRGEN,HWUALF,HWUAEM,QP,X,QQ,Z,WQG,WQV,
46671 & WQP,XQV,ZMIN,ZMAX,YMIN,YMAX,DELY,YY,PSUM,EZ,WQN,WR,ZR,WZ,ZZ,AZ,
46672 & PVAL,EY,DIST(13),PROB(13,100),PPHO
46673 INTEGER ID,IW,ID1,ID2,IW1,IW2,NZ,IDHAD,IP,IZ
46674 LOGICAL HWRLOG,HWSVAL,FORCED,NONF,NONV,PHOTPR
46675 EXTERNAL HWBVMC,HWRGEN,HWUALF,HWUAEM,HWRLOG,HWSVAL
46682 NONV=.NOT.HWSVAL(ID)
46704 IF (ZMIN.GE.ZMAX) RETURN
46706 C---INTERPOLATION VARIABLE IS Y=LN(Z/(1-Z))
46707 YMIN=LOG(ZMIN/(1.-ZMIN))
46708 YMAX=LOG(ZMAX/(1.-ZMAX))
46710 NZ=MIN(INT(ZBINM*DELY)+1,NZBIN)
46711 DELY=(YMAX-YMIN)/FLOAT(NZ)
46715 C---SET UP TABLES FOR CHOOSING BRANCHING
46722 AZ=WZ*ZZ*HWUALF(5-2*SUDORD,MAX(WZ*QQ,QG))
46723 CALL HWSFUN(X*ZR,QQ,IDHAD,NSTRU,DIST,JNHAD)
46725 C---SPLITTING INTO QUARK
46727 10 PROB(IP,IZ)=PSUM
46728 IF (NONF) PSUM=PSUM+DIST(ID)*AZ*CFFAC*(1.+ZZ*ZZ)*WR
46730 20 PROB(IP,IZ)=PSUM
46731 PSUM=PSUM+DIST(13)*AZ*0.5*(ZZ*ZZ+WZ*WZ)
46734 C---SPLITTING INTO GLUON
46736 PSUM=PSUM+DIST(IP)*AZ*CFFAC*(1.+WZ*WZ)*ZR
46737 30 PROB(IP,IZ)=PSUM
46738 IF (NONF) PSUM=PSUM+DIST(13)*AZ*2.*CAFAC*(WZ*ZR+ZZ*WR+WZ*ZZ)
46742 50 PHOTPR=IDHAD.EQ.59.AND.ID.NE.13
46744 C---ALLOW ANOMALOUS PHOTON SPLITTING
46745 PPHO=ZMIN*HWUAEM(-QQ*QQ)*CAFAC*(ZMIN**2+(1.-ZMIN)**2)
46746 & *ICHRG(ID)**2/9D0
46747 IF (PPHO.GT.(PPHO+PSUM*DELY)*HWRGEN(2)) THEN
46748 C---ANOMALOUS PHOTON SPLITTING OCCURRED
46753 IF (PSUM.LE.ZERO) RETURN
46755 PVAL=PSUM*HWRGEN(0)
46757 IF (PROB(13,IZ).GT.PVAL) GOTO 70
46760 70 EY=EXP(YMIN+DELY*(FLOAT(IZ)-HWRGEN(1)))
46762 C---CHOOSE BRANCHING
46764 IF (PROB(IP,IZ).GT.PVAL) GOTO 90
46767 C---CHECK THAT Z IS INSIDE PHASE SPACE (RETURN IF NOT)
46771 IF ((NONV.AND.ZZ*WQP.LT.XQV).OR.ZZ.GT.WQG) THEN
46772 IF (PHOTPR) GOTO 50
46776 IF (ZZ.LT.XQV.OR.ZZ.GT.WQP) THEN
46777 IF (PHOTPR) GOTO 50
46783 IF (ZZ.LT.XQV.OR.ZZ.GT.WQG) RETURN
46784 ELSEIF (.NOT.HWSVAL(IP)) THEN
46785 WQN=1.-HWBVMC(IP)/QQ
46786 IF (ZZ*WQN.LT.XQV.OR.ZZ.GT.WQN) RETURN
46789 C---EVERYTHING OK: LABEL NEW BRANCHES
46795 IF (ID1.EQ.13) THEN
46801 ELSE IF (ID.NE.13) THEN
46802 IF (ID1.EQ.13) THEN
46810 IF (ID1.EQ.13) THEN
46811 IF (HWRLOG(HALF)) IW2=IW1
46812 ELSE IF (ID1.GT.6) THEN
46816 IF (IW2.EQ.IW1) IW1=IW1+1
46819 *CMZ :- -02/05/91 11.30.51 by Federico Carminati
46820 *-- Author : Miscellaneous, combined by Bryan Webber
46821 C-----------------------------------------------------------------------
46822 SUBROUTINE HWSFUN(XIN,SCALE,IDHAD,NSET,DIST,IBEAM)
46823 C-----------------------------------------------------------------------
46824 C NUCLEON AND PION STRUCTURE FUNCTIONS DIST=X*QRK(X,Q=SCALE)
46826 C IDHAD = TYPE OF HADRON:
46827 C 73=P 91=PBAR 75=N 93=NBAR 38=PI+ 30=PI- 59=PHOTON
46829 C NEW SPECIAL CODES:
46830 C 71=`REMNANT PHOTON' 72=`REMNANT NUCLEON'
46832 C NSET = STRUCTURE FUNCTION SET
46833 C = 1,2 FOR DUKE+OWENS SETS 1,2 (SOFT/HARD GLUE)
46834 C = 3,4 FOR EICHTEN ET AL SETS 1,2 (NUCLEON ONLY)
46835 C = 5 FOR OWENS SET 1.1 (PREPRINT FSU-HEP-910606)
46837 C FOR PHOTON DREES+GRASSIE IS USED
46839 C N.B. IF IBEAM.GT.0.AND.MODPDF(IBEAM).GE.0 THEN NSET IS
46840 C IGNORED AND CERN PDFLIB WITH AUTHOR GROUP=AUTPDF(IBEAM) AND
46841 C SET=MODPDF(IBEAM) IS USED. FOR COMPATABILITY WITH VERSIONS 3
46842 C AND EARLIER, AUTPDF SHOULD BE SET TO 'MODE'
46843 C NOTE THAT NO CONSISTENCY CHECK IS MADE, FOR EXAMPLE THAT THE
46844 C REQUESTED SET FOR A PHOTON IS ACTUALLY A PHOTON SET
46846 C IF (ISPAC.GT.0) SCALE IS REPLACED BY MAX(SCALE,QSPAC)
46848 C IF (X.LT.PDFX0) REPLACE X*F(X) BY PDFX0*F(PDFX0)*(X/PDFX0)**PDFPOW
46850 C FOR PHOTON, IF (PHOMAS.GT.0) THEN QUARK DISTRIBUTIONS ARE
46851 C SUPPRESSED BY LOG((Q**2+PHOMAS**2)/(P**2+PHOMAS**2))
46852 C L = -------------------------------------- ,
46853 C LOG((Q**2+PHOMAS**2)/( PHOMAS**2))
46854 C WHILE GLUON DISTRIBUTIONS ARE SUPPRESSED BY L**2,
46855 C WHERE Q=SCALE AND P=VIRTUALITY OF THE PHOTON
46857 C DUKE+OWENS = D.W.DUKE AND J.F.OWENS, PHYS. REV. D30 (1984) 49 (P/N)
46858 C + J.F.OWENS, PHYS. REV. D30 (1984) 943 (PI+/-)
46859 C WITH EXTRA SIGNIFICANT FIGURES VIA ED BERGER
46860 C WARNING....MOMENTUM SUM RULE BADLY VIOLATED ABOVE 1 TEV
46861 C DUKE+OWENS SETS 1,2 OBSOLETE. SET 1 UPDATED TO OWENS 1.1 (1991)
46862 C PION NOT RELIABLE ABOVE SCALE = 50 GEV
46864 C EICHTEN ET AL = E.EICHTEN,I.HINCHLIFFE,K.LANE AND C.QUIGG,
46865 C REV. MOD. PHYS. 56 (1984) 579
46866 C REVISED AS IN REV. MOD. PHYS. 58 (1986) 1065
46867 C RELIABLE RANGE : SQRT(5)GEV < SCALE < 10TEV, 1E-4 < X < 1
46869 C DREES+GRASSIE = M.DREES & K.GRASSIE, ZEIT. PHYS. C28 (1985) 451
46870 C MODIFIED IN M.DREES & C.S.KIM, DESY 91-039
46871 C AND C.S.KIM, DTP/91/16 FOR HEAVY QUARKS
46873 C FOR CERN PDFLIB DETAILS SEE PDFLIB DOC Q ON CERNVM OR
46874 C CERN_ROOT:[DOC]PDFLIB.TXT ON VXCERN
46875 C-----------------------------------------------------------------------
46876 C---BRW change 27/8/04: include Frixione's fix to reduce PDFSET calls
46877 C-----------------------------------------------------------------------
46878 INCLUDE 'herwig65.inc'
46879 DOUBLE PRECISION HWSGAM,X,SCALE,XOLD,QOLD,XMWN,QSCA,SS,SMIN,S,T,
46880 & TMIN,TMAX,VX,AA,VT,WT,UPV,DNV,SEA,STR,CHM,BTM,TOP,GLU,WX,XQSUM,
46881 & DMIN,TPMIN,TPMAX,DIST(13),G(2),Q0(5),QL(5),F(5),A(6,5),
46882 & B(3,6,5,4),XQ(6),TX(6),TT(6),TB(6),NEHLQ(8,2),CEHLQ(6,6,2,8,2),
46883 & BB(4,6,5),VAL(20),USEA,DSEA,TOTAL,SCALEF,FAC,TBMIN(2),TTMIN(2)
46884 DOUBLE PRECISION XIN,PDFFAC
46885 REAL HWSDGG,HWSDGQ,XSP,Q2,P2,W2,EMB2,EMC2,ALAM2,XPGA(-6:6),F2GM,
46886 & XPVMD,XPANL,XPANH,XPBEH,XPDIR
46887 COMMON/SASCOM/XPVMD(-6:6),XPANL(-6:6),XPANH(-6:6),XPBEH(-6:6),
46889 LOGICAL PDFWRX(2,2),PDFWRQ(2,2)
46890 DOUBLE PRECISION PDFXMN,PDFXMX,PDFQMN,PDFQMX
46891 COMMON /W50513/PDFXMN,PDFXMX,PDFQMN,PDFQMX
46892 INTEGER IDHAD,NSET,IBEAM,IOLD,NOLD,IP,I,J,K,NX,IT,IX,IFL,NFL,
46893 & MPDF,IHAD,ISET,IOP1,IOP2,IP2
46894 CHARACTER*20 PARM(20)
46895 CHARACTER*20 PARMSAVE
46896 DOUBLE PRECISION VALSAVE
46897 COMMON/HWSFSA/PARMSAVE
46898 COMMON/HWSFSB/VALSAVE
46899 EXTERNAL HWSGAM,HWSDGG,HWSDGQ
46900 SAVE QOLD,IOLD,NOLD,XOLD,SS,S,T,TMIN,TMAX,G,A,TX,TT,TB,IP,NX
46901 SAVE PDFWRX,PDFWRQ,B,BB,NEHLQ,CEHLQ,TBMIN,TTMIN,DMIN,Q0,QL
46902 DATA PDFWRX,PDFWRQ/8*.TRUE./
46903 DATA (((B(I,J,K,1),I=1,3),J=1,6),K=1,5)/
46904 &3.D0,0.D0,0.D0,.419D0,.004383D0,-.007412D0,
46905 &3.46D0,.72432D0,-.065998D0,4.4D0,-4.8644D0,1.3274D0,
46907 &0.D0,0.D0,.763D0,-.23696D0,.025836D0,4.D0,.62664D0,-.019163D0,
46908 &0.D0,-.42068D0,.032809D0,6*0.D0,1.265D0,-1.1323D0,.29268D0,
46909 &0.D0,-.37162D0,-.028977D0,8.05D0,1.5877D0,-.15291D0,
46910 &0.D0,6.3059D0,-.27342D0,0.D0,-10.543D0,-3.1674D0,
46911 &0.D0,14.698D0,9.798D0,0.D0,.13479D0,-.074693D0,
46912 &-.0355D0,-.22237D0,-.057685D0,6.3494D0,3.2649D0,-.90945D0,
46913 &0.D0,-3.0331D0,1.5042D0,0.D0,17.431D0,-11.255D0,
46914 &0.D0,-17.861D0,15.571D0,1.564D0,-1.7112D0,.63751D0,
46915 &0.D0,-.94892D0,.32505D0,6.D0,1.4345D0,-1.0485D0,
46916 &9.D0,-7.1858D0,.25494D0,0.D0,-16.457D0,10.947D0,
46917 &0.D0,15.261D0,-10.085D0/
46918 DATA (((B(I,J,K,2),I=1,3),J=1,6),K=1,5)/
46919 &3.D0,0.D0,0.D0,.3743D0,.013946D0,-.00031695D0,
46920 &3.329D0,.75343D0,-.076125D0,6.032D0,-6.2153D0,1.5561D0,
46922 &0.D0,.7608D0,-.2317D0,.023232D0,3.83D0,.62746D0,-.019155D0,
46923 &0.D0,-.41843D0,.035972D0,6*0.D0,1.6714D0,-1.9168D0,.58175D0,
46924 &0.D0,-.27307D0,-.16392D0,9.145D0,.53045D0,-.76271D0,
46925 &0.D0,15.665D0,-2.8341D0,0.D0,-100.63D0,44.658D0,
46926 &0.D0,223.24D0,-116.76D0,0.D0,.067368D0,-.030574D0,
46927 &-.11989D0,-.23293D0,-.023273D0,3.5087D0,3.6554D0,-.45313D0,
46928 &0.D0,-.47369D0,.35793D0,0.D0,9.5041D0,-5.4303D0,
46929 &0.D0,-16.563D0,15.524D0,.8789D0,-.97093D0,.43388D0,
46930 &0.D0,-1.1612D0,.4759D0,4.D0,1.2271D0,-.25369D0,
46931 &9.D0,-5.6354D0,-.81747D0,0.D0,-7.5438D0,5.5034D0,
46932 &0.D0,-.59649D0,.12611D0/
46933 DATA (((B(I,J,K,3),I=1,3),J=1,6),K=1,5)/
46934 &1.D0,0.D0,0.D0,0.4D0,-0.06212D0,-0.007109D0,0.7D0,0.6478D0,
46935 &0.01335D0,27*0.D0,0.9D0,-0.2428D0,0.1386D0,0.D0,-0.2120D0,
46936 &0.003671D0,5.0D0,0.8673D0,0.04747D0,
46937 &0.D0,1.266D0,-2.215D0,0.D0,2.382D0,0.3482D0,3*0.D0,
46938 &0.D0,0.07928D0,-0.06134D0,-0.02212D0,-0.3785D0,-0.1088D0,2.894D0,
46940 &-10.852D0,0.D0,5.248D0,-7.187D0,0.D0,8.388D0,-11.61D0,3*0.D0,
46941 &0.888D0,-1.802D0,1.812D0,0.D0,-1.576D0,1.20D0,3.11D0,-0.1317D0,
46942 &0.5068D0,6.0D0,2.801D0,-12.16D0,0.D0,-17.28D0,20.49D0,3*0.D0/
46943 DATA (((B(I,J,K,4),I=1,3),J=1,6),K=1,5)/
46944 &1.D0,0.D0,0.D0,0.4D0,-0.05909D0,-0.006524D0,0.628D0,0.6436D0,
46945 &0.01451D0,27*0.D0,
46946 &0.90D0,-0.1417D0,-0.1740D0,0.D0,-0.1697D0,-0.09623D0,5.0D0,
46948 &0.D0,-2.534D0,1.378D0,0.D0,0.5621D0,-0.2701D0,3*0.D0,
46949 &0.D0,0.06229D0,-0.04099D0,-0.0882D0,-0.2892D0,-0.1082D0,1.924D0,
46951 &2.036D0,0.D0,-4.463D0,5.209D0,0.D0,-0.8367D0,-0.04840D0,3*0.D0,
46952 &0.794D0,-0.9144D0,0.5966D0,0.D0,-1.237D0,0.6582D0,2.89D0,0.5966D0,
46954 &6.0D0,-3.671D0,-2.304D0,0.D0,-8.191D0,7.758D0,3*0.D0/
46955 C---COEFFTS FOR NEW OWENS 1.1 SET
46956 DATA BB/3.D0,3*0.D0,.665D0,-.1097D0,-.002442D0,0.D0,
46957 &3.614D0,.8395D0,-.02186D0,0.D0,.8673D0,-1.6637D0,.342D0,0.D0,
46958 &0.D0,1.1049D0,-.2369D0,5*0.D0,1.D0,3*0.D0,
46959 &.8388D0,-.2092D0,.02657D0,0.D0,4.667D0,.7951D0,.1081D0,0.D0,
46960 &0.D0,-1.0232D0,.05799D0,0.D0,0.D0,.8616D0,.153D0,5*0.D0,
46961 &.909D0,-.4023D0,.006305D0,0.D0,
46962 &0.D0,-.3823D0,.02766D0,0.D0,7.278D0,-.7904D0,.8108D0,0.D0,
46963 &0.D0,-1.6629D0,.5719D0,0.D0,0.D0,-.01333D0,.5299D0,0.D0,
46964 &0.D0,.1211D0,-.1739D0,0.D0,0.D0,.09469D0,-.07066D0,.01236D0,
46965 &-.1447D0,-.402D0,.1533D0,-.06479D0,6.7599D0,1.6596D0,.6798D0,
46966 &-.8525D0,0.D0,-4.4559D0,3.3756D0,-.9468D0,
46967 &0.D0,7.862D0,-3.6591D0,.03672D0,0.D0,-.2472D0,-.751D0,.0487D0,
46968 &3.017D0,-4.7347D0,3.3594D0,-.9443D0,0.D0,-.9342D0,.5454D0,
46970 &5.304D0,1.4654D0,-1.4292D0,.7569D0,0.D0,-3.9141D0,2.8445D0,
46972 &0.D0,9.0176D0,-10.426D0,4.0983D0,0.D0,-5.9602D0,7.515D0,-2.7329D0/
46973 C...THE FOLLOWING DATA LINES ARE COEFFICIENTS NEEDED IN THE
46974 C...EICHTEN, HINCHLIFFE, LANE, QUIGG PROTON STRUCTURE FUNCTION
46975 C...POWERS OF 1-X IN DIFFERENT CASES
46976 DATA NEHLQ/3,4,7,5,7,7,7,7,3,4,7,6,7,7,7,7/
46977 C...EXPANSION COEFFICIENTS FOR UP VALENCE QUARK DISTRIBUTION
46978 DATA (((CEHLQ(IX,IT,NX,1,1),IX=1,6),IT=1,6),NX=1,2)/
46979 1 7.677D-01,-2.087D-01,-3.303D-01,-2.517D-02,-1.570D-02,-1.000D-04,
46980 2-5.326D-01,-2.661D-01, 3.201D-01, 1.192D-01, 2.434D-02, 7.620D-03,
46981 3 2.162D-01, 1.881D-01,-8.375D-02,-6.515D-02,-1.743D-02,-5.040D-03,
46982 4-9.211D-02,-9.952D-02, 1.373D-02, 2.506D-02, 8.770D-03, 2.550D-03,
46983 5 3.670D-02, 4.409D-02, 9.600D-04,-7.960D-03,-3.420D-03,-1.050D-03,
46984 6-1.549D-02,-2.026D-02,-3.060D-03, 2.220D-03, 1.240D-03, 4.100D-04,
46985 1 2.395D-01, 2.905D-01, 9.778D-02, 2.149D-02, 3.440D-03, 5.000D-04,
46986 2 1.751D-02,-6.090D-03,-2.687D-02,-1.916D-02,-7.970D-03,-2.750D-03,
46987 3-5.760D-03,-5.040D-03, 1.080D-03, 2.490D-03, 1.530D-03, 7.500D-04,
46988 4 1.740D-03, 1.960D-03, 3.000D-04,-3.400D-04,-2.900D-04,-1.800D-04,
46989 5-5.300D-04,-6.400D-04,-1.700D-04, 4.000D-05, 6.000D-05, 4.000D-05,
46990 6 1.700D-04, 2.200D-04, 8.000D-05, 1.000D-05,-1.000D-05,-1.000D-05/
46991 DATA (((CEHLQ(IX,IT,NX,1,2),IX=1,6),IT=1,6),NX=1,2)/
46992 1 7.237D-01,-2.189D-01,-2.995D-01,-1.909D-02,-1.477D-02, 2.500D-04,
46993 2-5.314D-01,-2.425D-01, 3.283D-01, 1.119D-01, 2.223D-02, 7.070D-03,
46994 3 2.289D-01, 1.890D-01,-9.859D-02,-6.900D-02,-1.747D-02,-5.080D-03,
46995 4-1.041D-01,-1.084D-01, 2.108D-02, 2.975D-02, 9.830D-03, 2.830D-03,
46996 5 4.394D-02, 5.116D-02,-1.410D-03,-1.055D-02,-4.230D-03,-1.270D-03,
46997 6-1.991D-02,-2.539D-02,-2.780D-03, 3.430D-03, 1.720D-03, 5.500D-04,
46998 1 2.410D-01, 2.884D-01, 9.369D-02, 1.900D-02, 2.530D-03, 2.400D-04,
46999 2 1.765D-02,-9.220D-03,-3.037D-02,-2.085D-02,-8.440D-03,-2.810D-03,
47000 3-6.450D-03,-5.260D-03, 1.720D-03, 3.110D-03, 1.830D-03, 8.700D-04,
47001 4 2.120D-03, 2.320D-03, 2.600D-04,-4.900D-04,-3.900D-04,-2.300D-04,
47002 5-6.900D-04,-8.200D-04,-2.000D-04, 7.000D-05, 9.000D-05, 6.000D-05,
47003 6 2.400D-04, 3.100D-04, 1.100D-04, 0.000D+00,-2.000D-05,-2.000D-05/
47004 C...EXPANSION COEFFICIENTS FOR DOWN VALENCE QUARK DISTRIBUTION
47005 DATA (((CEHLQ(IX,IT,NX,2,1),IX=1,6),IT=1,6),NX=1,2)/
47006 1 3.813D-01,-8.090D-02,-1.634D-01,-2.185D-02,-8.430D-03,-6.200D-04,
47007 2-2.948D-01,-1.435D-01, 1.665D-01, 6.638D-02, 1.473D-02, 4.080D-03,
47008 3 1.252D-01, 1.042D-01,-4.722D-02,-3.683D-02,-1.038D-02,-2.860D-03,
47009 4-5.478D-02,-5.678D-02, 8.900D-03, 1.484D-02, 5.340D-03, 1.520D-03,
47010 5 2.220D-02, 2.567D-02,-3.000D-05,-4.970D-03,-2.160D-03,-6.500D-04,
47011 6-9.530D-03,-1.204D-02,-1.510D-03, 1.510D-03, 8.300D-04, 2.700D-04,
47012 1 1.261D-01, 1.354D-01, 3.958D-02, 8.240D-03, 1.660D-03, 4.500D-04,
47013 2 3.890D-03,-1.159D-02,-1.625D-02,-9.610D-03,-3.710D-03,-1.260D-03,
47014 3-1.910D-03,-5.600D-04, 1.590D-03, 1.590D-03, 8.400D-04, 3.900D-04,
47015 4 6.400D-04, 4.900D-04,-1.500D-04,-2.900D-04,-1.800D-04,-1.000D-04,
47016 5-2.000D-04,-1.900D-04, 0.000D+00, 6.000D-05, 4.000D-05, 3.000D-05,
47017 6 7.000D-05, 8.000D-05, 2.000D-05,-1.000D-05,-1.000D-05,-1.000D-05/
47018 DATA (((CEHLQ(IX,IT,NX,2,2),IX=1,6),IT=1,6),NX=1,2)/
47019 1 3.578D-01,-8.622D-02,-1.480D-01,-1.840D-02,-7.820D-03,-4.500D-04,
47020 2-2.925D-01,-1.304D-01, 1.696D-01, 6.243D-02, 1.353D-02, 3.750D-03,
47021 3 1.318D-01, 1.041D-01,-5.486D-02,-3.872D-02,-1.038D-02,-2.850D-03,
47022 4-6.162D-02,-6.143D-02, 1.303D-02, 1.740D-02, 5.940D-03, 1.670D-03,
47023 5 2.643D-02, 2.957D-02,-1.490D-03,-6.450D-03,-2.630D-03,-7.700D-04,
47024 6-1.218D-02,-1.497D-02,-1.260D-03, 2.240D-03, 1.120D-03, 3.500D-04,
47025 1 1.263D-01, 1.334D-01, 3.732D-02, 7.070D-03, 1.260D-03, 3.400D-04,
47026 2 3.660D-03,-1.357D-02,-1.795D-02,-1.031D-02,-3.880D-03,-1.280D-03,
47027 3-2.100D-03,-3.600D-04, 2.050D-03, 1.920D-03, 9.800D-04, 4.400D-04,
47028 4 7.700D-04, 5.400D-04,-2.400D-04,-3.900D-04,-2.400D-04,-1.300D-04,
47029 5-2.600D-04,-2.300D-04, 2.000D-05, 9.000D-05, 6.000D-05, 4.000D-05,
47030 6 9.000D-05, 1.000D-04, 2.000D-05,-2.000D-05,-2.000D-05,-1.000D-05/
47031 C...EXPANSION COEFFICIENTS FOR UP AND DOWN SEA QUARK DISTRIBUTIONS
47032 DATA (((CEHLQ(IX,IT,NX,3,1),IX=1,6),IT=1,6),NX=1,2)/
47033 1 6.870D-02,-6.861D-02, 2.973D-02,-5.400D-03, 3.780D-03,-9.700D-04,
47034 2-1.802D-02, 1.400D-04, 6.490D-03,-8.540D-03, 1.220D-03,-1.750D-03,
47035 3-4.650D-03, 1.480D-03,-5.930D-03, 6.000D-04,-1.030D-03,-8.000D-05,
47036 4 6.440D-03, 2.570D-03, 2.830D-03, 1.150D-03, 7.100D-04, 3.300D-04,
47037 5-3.930D-03,-2.540D-03,-1.160D-03,-7.700D-04,-3.600D-04,-1.900D-04,
47038 6 2.340D-03, 1.930D-03, 5.300D-04, 3.700D-04, 1.600D-04, 9.000D-05,
47039 1 1.014D+00,-1.106D+00, 3.374D-01,-7.444D-02, 8.850D-03,-8.700D-04,
47040 2 9.233D-01,-1.285D+00, 4.475D-01,-9.786D-02, 1.419D-02,-1.120D-03,
47041 3 4.888D-02,-1.271D-01, 8.606D-02,-2.608D-02, 4.780D-03,-6.000D-04,
47042 4-2.691D-02, 4.887D-02,-1.771D-02, 1.620D-03, 2.500D-04,-6.000D-05,
47043 5 7.040D-03,-1.113D-02, 1.590D-03, 7.000D-04,-2.000D-04, 0.000D+00,
47044 6-1.710D-03, 2.290D-03, 3.800D-04,-3.500D-04, 4.000D-05, 1.000D-05/
47045 DATA (((CEHLQ(IX,IT,NX,3,2),IX=1,6),IT=1,6),NX=1,2)/
47046 1 1.008D-01,-7.100D-02, 1.973D-02,-5.710D-03, 2.930D-03,-9.900D-04,
47047 2-5.271D-02,-1.823D-02, 1.792D-02,-6.580D-03, 1.750D-03,-1.550D-03,
47048 3 1.220D-02, 1.763D-02,-8.690D-03,-8.800D-04,-1.160D-03,-2.100D-04,
47049 4-1.190D-03,-7.180D-03, 2.360D-03, 1.890D-03, 7.700D-04, 4.100D-04,
47050 5-9.100D-04, 2.040D-03,-3.100D-04,-1.050D-03,-4.000D-04,-2.400D-04,
47051 6 1.190D-03,-1.700D-04,-2.000D-04, 4.200D-04, 1.700D-04, 1.000D-04,
47052 1 1.081D+00,-1.189D+00, 3.868D-01,-8.617D-02, 1.115D-02,-1.180D-03,
47053 2 9.917D-01,-1.396D+00, 4.998D-01,-1.159D-01, 1.674D-02,-1.720D-03,
47054 3 5.099D-02,-1.338D-01, 9.173D-02,-2.885D-02, 5.890D-03,-6.500D-04,
47055 4-3.178D-02, 5.703D-02,-2.070D-02, 2.440D-03, 1.100D-04,-9.000D-05,
47056 5 8.970D-03,-1.392D-02, 2.050D-03, 6.500D-04,-2.300D-04, 2.000D-05,
47057 6-2.340D-03, 3.010D-03, 5.000D-04,-3.900D-04, 6.000D-05, 1.000D-05/
47058 C...EXPANSION COEFFICIENTS FOR GLUON DISTRIBUTION
47059 DATA (((CEHLQ(IX,IT,NX,4,1),IX=1,6),IT=1,6),NX=1,2)/
47060 1 9.482D-01,-9.578D-01, 1.009D-01,-1.051D-01, 3.456D-02,-3.054D-02,
47061 2-9.627D-01, 5.379D-01, 3.368D-01,-9.525D-02, 1.488D-02,-2.051D-02,
47062 3 4.300D-01,-8.306D-02,-3.372D-01, 4.902D-02,-9.160D-03, 1.041D-02,
47063 4-1.925D-01,-1.790D-02, 2.183D-01, 7.490D-03, 4.140D-03,-1.860D-03,
47064 5 8.183D-02, 1.926D-02,-1.072D-01,-1.944D-02,-2.770D-03,-5.200D-04,
47065 6-3.884D-02,-1.234D-02, 5.410D-02, 1.879D-02, 3.350D-03, 1.040D-03,
47066 1 2.948D+01,-3.902D+01, 1.464D+01,-3.335D+00, 5.054D-01,-5.915D-02,
47067 2 2.559D+01,-3.955D+01, 1.661D+01,-4.299D+00, 6.904D-01,-8.243D-02,
47068 3-1.663D+00, 1.176D+00, 1.118D+00,-7.099D-01, 1.948D-01,-2.404D-02,
47069 4-2.168D-01, 8.170D-01,-7.169D-01, 1.851D-01,-1.924D-02,-3.250D-03,
47070 5 2.088D-01,-4.355D-01, 2.239D-01,-2.446D-02,-3.620D-03, 1.910D-03,
47071 6-9.097D-02, 1.601D-01,-5.681D-02,-2.500D-03, 2.580D-03,-4.700D-04/
47072 DATA (((CEHLQ(IX,IT,NX,4,2),IX=1,6),IT=1,6),NX=1,2)/
47073 1 2.367D+00, 4.453D-01, 3.660D-01, 9.467D-02, 1.341D-01, 1.661D-02,
47074 2-3.170D+00,-1.795D+00, 3.313D-02,-2.874D-01,-9.827D-02,-7.119D-02,
47075 3 1.823D+00, 1.457D+00,-2.465D-01, 3.739D-02, 6.090D-03, 1.814D-02,
47076 4-1.033D+00,-9.827D-01, 2.136D-01, 1.169D-01, 5.001D-02, 1.684D-02,
47077 5 5.133D-01, 5.259D-01,-1.173D-01,-1.139D-01,-4.988D-02,-2.021D-02,
47078 6-2.881D-01,-3.145D-01, 5.667D-02, 9.161D-02, 4.568D-02, 1.951D-02,
47079 1 3.036D+01,-4.062D+01, 1.578D+01,-3.699D+00, 6.020D-01,-7.031D-02,
47080 2 2.700D+01,-4.167D+01, 1.770D+01,-4.804D+00, 7.862D-01,-1.060D-01,
47081 3-1.909D+00, 1.357D+00, 1.127D+00,-7.181D-01, 2.232D-01,-2.481D-02,
47082 4-2.488D-01, 9.781D-01,-8.127D-01, 2.094D-01,-2.997D-02,-4.710D-03,
47083 5 2.506D-01,-5.427D-01, 2.672D-01,-3.103D-02,-1.800D-03, 2.870D-03,
47084 6-1.128D-01, 2.087D-01,-6.972D-02,-2.480D-03, 2.630D-03,-8.400D-04/
47085 C...EXPANSION COEFFICIENTS FOR STRANGE SEA QUARK DISTRIBUTION
47086 DATA (((CEHLQ(IX,IT,NX,5,1),IX=1,6),IT=1,6),NX=1,2)/
47087 1 4.968D-02,-4.173D-02, 2.102D-02,-3.270D-03, 3.240D-03,-6.700D-04,
47088 2-6.150D-03,-1.294D-02, 6.740D-03,-6.890D-03, 9.000D-04,-1.510D-03,
47089 3-8.580D-03, 5.050D-03,-4.900D-03,-1.600D-04,-9.400D-04,-1.500D-04,
47090 4 7.840D-03, 1.510D-03, 2.220D-03, 1.400D-03, 7.000D-04, 3.500D-04,
47091 5-4.410D-03,-2.220D-03,-8.900D-04,-8.500D-04,-3.600D-04,-2.000D-04,
47092 6 2.520D-03, 1.840D-03, 4.100D-04, 3.900D-04, 1.600D-04, 9.000D-05,
47093 1 9.235D-01,-1.085D+00, 3.464D-01,-7.210D-02, 9.140D-03,-9.100D-04,
47094 2 9.315D-01,-1.274D+00, 4.512D-01,-9.775D-02, 1.380D-02,-1.310D-03,
47095 3 4.739D-02,-1.296D-01, 8.482D-02,-2.642D-02, 4.760D-03,-5.700D-04,
47096 4-2.653D-02, 4.953D-02,-1.735D-02, 1.750D-03, 2.800D-04,-6.000D-05,
47097 5 6.940D-03,-1.132D-02, 1.480D-03, 6.500D-04,-2.100D-04, 0.000D+00,
47098 6-1.680D-03, 2.340D-03, 4.200D-04,-3.400D-04, 5.000D-05, 1.000D-05/
47099 DATA (((CEHLQ(IX,IT,NX,5,2),IX=1,6),IT=1,6),NX=1,2)/
47100 1 6.478D-02,-4.537D-02, 1.643D-02,-3.490D-03, 2.710D-03,-6.700D-04,
47101 2-2.223D-02,-2.126D-02, 1.247D-02,-6.290D-03, 1.120D-03,-1.440D-03,
47102 3-1.340D-03, 1.362D-02,-6.130D-03,-7.900D-04,-9.000D-04,-2.000D-04,
47103 4 5.080D-03,-3.610D-03, 1.700D-03, 1.830D-03, 6.800D-04, 4.000D-04,
47104 5-3.580D-03, 6.000D-05,-2.600D-04,-1.050D-03,-3.800D-04,-2.300D-04,
47105 6 2.420D-03, 9.300D-04,-1.000D-04, 4.500D-04, 1.700D-04, 1.100D-04,
47106 1 9.868D-01,-1.171D+00, 3.940D-01,-8.459D-02, 1.124D-02,-1.250D-03,
47107 2 1.001D+00,-1.383D+00, 5.044D-01,-1.152D-01, 1.658D-02,-1.830D-03,
47108 3 4.928D-02,-1.368D-01, 9.021D-02,-2.935D-02, 5.800D-03,-6.600D-04,
47109 4-3.133D-02, 5.785D-02,-2.023D-02, 2.630D-03, 1.600D-04,-8.000D-05,
47110 5 8.840D-03,-1.416D-02, 1.900D-03, 5.800D-04,-2.500D-04, 1.000D-05,
47111 6-2.300D-03, 3.080D-03, 5.500D-04,-3.700D-04, 7.000D-05, 1.000D-05/
47112 C...EXPANSION COEFFICIENTS FOR CHARM SEA QUARK DISTRIBUTION
47113 DATA (((CEHLQ(IX,IT,NX,6,1),IX=1,6),IT=1,6),NX=1,2)/
47114 1 9.270D-03,-1.817D-02, 9.590D-03,-6.390D-03, 1.690D-03,-1.540D-03,
47115 2 5.710D-03,-1.188D-02, 6.090D-03,-4.650D-03, 1.240D-03,-1.310D-03,
47116 3-3.960D-03, 7.100D-03,-3.590D-03, 1.840D-03,-3.900D-04, 3.400D-04,
47117 4 1.120D-03,-1.960D-03, 1.120D-03,-4.800D-04, 1.000D-04,-4.000D-05,
47118 5 4.000D-05,-3.000D-05,-1.800D-04, 9.000D-05,-5.000D-05,-2.000D-05,
47119 6-4.200D-04, 7.300D-04,-1.600D-04, 5.000D-05, 5.000D-05, 5.000D-05,
47120 1 8.098D-01,-1.042D+00, 3.398D-01,-6.824D-02, 8.760D-03,-9.000D-04,
47121 2 8.961D-01,-1.217D+00, 4.339D-01,-9.287D-02, 1.304D-02,-1.290D-03,
47122 3 3.058D-02,-1.040D-01, 7.604D-02,-2.415D-02, 4.600D-03,-5.000D-04,
47123 4-2.451D-02, 4.432D-02,-1.651D-02, 1.430D-03, 1.200D-04,-1.000D-04,
47124 5 1.122D-02,-1.457D-02, 2.680D-03, 5.800D-04,-1.200D-04, 3.000D-05,
47125 6-7.730D-03, 7.330D-03,-7.600D-04,-2.400D-04, 1.000D-05, 0.000D+00/
47126 DATA (((CEHLQ(IX,IT,NX,6,2),IX=1,6),IT=1,6),NX=1,2)/
47127 1 9.980D-03,-1.945D-02, 1.055D-02,-6.870D-03, 1.860D-03,-1.560D-03,
47128 2 5.700D-03,-1.203D-02, 6.250D-03,-4.860D-03, 1.310D-03,-1.370D-03,
47129 3-4.490D-03, 7.990D-03,-4.170D-03, 2.050D-03,-4.400D-04, 3.300D-04,
47130 4 1.470D-03,-2.480D-03, 1.460D-03,-5.700D-04, 1.200D-04,-1.000D-05,
47131 5-9.000D-05, 1.500D-04,-3.200D-04, 1.200D-04,-6.000D-05,-4.000D-05,
47132 6-4.200D-04, 7.600D-04,-1.400D-04, 4.000D-05, 7.000D-05, 5.000D-05,
47133 1 8.698D-01,-1.131D+00, 3.836D-01,-8.111D-02, 1.048D-02,-1.300D-03,
47134 2 9.626D-01,-1.321D+00, 4.854D-01,-1.091D-01, 1.583D-02,-1.700D-03,
47135 3 3.057D-02,-1.088D-01, 8.022D-02,-2.676D-02, 5.590D-03,-5.600D-04,
47136 4-2.845D-02, 5.164D-02,-1.918D-02, 2.210D-03,-4.000D-05,-1.500D-04,
47137 5 1.311D-02,-1.751D-02, 3.310D-03, 5.100D-04,-1.200D-04, 5.000D-05,
47138 6-8.590D-03, 8.380D-03,-9.200D-04,-2.600D-04, 1.000D-05,-1.000D-05/
47139 C...EXPANSION COEFFICIENTS FOR BOTTOM SEA QUARK DISTRIBUTION
47140 DATA (((CEHLQ(IX,IT,NX,7,1),IX=1,6),IT=1,6),NX=1,2)/
47141 1 9.010D-03,-1.401D-02, 7.150D-03,-4.130D-03, 1.260D-03,-1.040D-03,
47142 2 6.280D-03,-9.320D-03, 4.780D-03,-2.890D-03, 9.100D-04,-8.200D-04,
47143 3-2.930D-03, 4.090D-03,-1.890D-03, 7.600D-04,-2.300D-04, 1.400D-04,
47144 4 3.900D-04,-1.200D-03, 4.400D-04,-2.500D-04, 2.000D-05,-2.000D-05,
47145 5 2.600D-04, 1.400D-04,-8.000D-05, 1.000D-04, 1.000D-05, 1.000D-05,
47146 6-2.600D-04, 3.200D-04, 1.000D-05,-1.000D-05, 1.000D-05,-1.000D-05,
47147 1 8.029D-01,-1.075D+00, 3.792D-01,-7.843D-02, 1.007D-02,-1.090D-03,
47148 2 7.903D-01,-1.099D+00, 4.153D-01,-9.301D-02, 1.317D-02,-1.410D-03,
47149 3-1.704D-02,-1.130D-02, 2.882D-02,-1.341D-02, 3.040D-03,-3.600D-04,
47150 4-7.200D-04, 7.230D-03,-5.160D-03, 1.080D-03,-5.000D-05,-4.000D-05,
47151 5 3.050D-03,-4.610D-03, 1.660D-03,-1.300D-04,-1.000D-05, 1.000D-05,
47152 6-4.360D-03, 5.230D-03,-1.610D-03, 2.000D-04,-2.000D-05, 0.000D+00/
47153 DATA (((CEHLQ(IX,IT,NX,7,2),IX=1,6),IT=1,6),NX=1,2)/
47154 1 8.980D-03,-1.459D-02, 7.510D-03,-4.410D-03, 1.310D-03,-1.070D-03,
47155 2 5.970D-03,-9.440D-03, 4.800D-03,-3.020D-03, 9.100D-04,-8.500D-04,
47156 3-3.050D-03, 4.440D-03,-2.100D-03, 8.500D-04,-2.400D-04, 1.400D-04,
47157 4 5.300D-04,-1.300D-03, 5.600D-04,-2.700D-04, 3.000D-05,-2.000D-05,
47158 5 2.000D-04, 1.400D-04,-1.100D-04, 1.000D-04, 0.000D+00, 0.000D+00,
47159 6-2.600D-04, 3.200D-04, 0.000D+00,-3.000D-05, 1.000D-05,-1.000D-05,
47160 1 8.672D-01,-1.174D+00, 4.265D-01,-9.252D-02, 1.244D-02,-1.460D-03,
47161 2 8.500D-01,-1.194D+00, 4.630D-01,-1.083D-01, 1.614D-02,-1.830D-03,
47162 3-2.241D-02,-5.630D-03, 2.815D-02,-1.425D-02, 3.520D-03,-4.300D-04,
47163 4-7.300D-04, 8.030D-03,-5.780D-03, 1.380D-03,-1.300D-04,-4.000D-05,
47164 5 3.460D-03,-5.380D-03, 1.960D-03,-2.100D-04, 1.000D-05, 1.000D-05,
47165 6-4.850D-03, 5.950D-03,-1.890D-03, 2.600D-04,-3.000D-05, 0.000D+00/
47166 C...EXPANSION COEFFICIENTS FOR TOP SEA QUARK DISTRIBUTION
47167 DATA (((CEHLQ(IX,IT,NX,8,1),IX=1,6),IT=1,6),NX=1,2)/
47168 1 4.410D-03,-7.480D-03, 3.770D-03,-2.580D-03, 7.300D-04,-7.100D-04,
47169 2 3.840D-03,-6.050D-03, 3.030D-03,-2.030D-03, 5.800D-04,-5.900D-04,
47170 3-8.800D-04, 1.660D-03,-7.500D-04, 4.700D-04,-1.000D-04, 1.000D-04,
47171 4-8.000D-05,-1.500D-04, 1.200D-04,-9.000D-05, 3.000D-05, 0.000D+00,
47172 5 1.300D-04,-2.200D-04,-2.000D-05,-2.000D-05,-2.000D-05,-2.000D-05,
47173 6-7.000D-05, 1.900D-04,-4.000D-05, 2.000D-05, 0.000D+00, 0.000D+00,
47174 1 6.623D-01,-9.248D-01, 3.519D-01,-7.930D-02, 1.110D-02,-1.180D-03,
47175 2 6.380D-01,-9.062D-01, 3.582D-01,-8.479D-02, 1.265D-02,-1.390D-03,
47176 3-2.581D-02, 2.125D-02, 4.190D-03,-4.980D-03, 1.490D-03,-2.100D-04,
47177 4 7.100D-04, 5.300D-04,-1.270D-03, 3.900D-04,-5.000D-05,-1.000D-05,
47178 5 3.850D-03,-5.060D-03, 1.860D-03,-3.500D-04, 4.000D-05, 0.000D+00,
47179 6-3.530D-03, 4.460D-03,-1.500D-03, 2.700D-04,-3.000D-05, 0.000D+00/
47180 DATA (((CEHLQ(IX,IT,NX,8,2),IX=1,6),IT=1,6),NX=1,2)/
47181 1 4.260D-03,-7.530D-03, 3.830D-03,-2.680D-03, 7.600D-04,-7.300D-04,
47182 2 3.640D-03,-6.050D-03, 3.030D-03,-2.090D-03, 5.900D-04,-6.000D-04,
47183 3-9.200D-04, 1.710D-03,-8.200D-04, 5.000D-04,-1.200D-04, 1.000D-04,
47184 4-5.000D-05,-1.600D-04, 1.300D-04,-9.000D-05, 3.000D-05, 0.000D+00,
47185 5 1.300D-04,-2.100D-04,-1.000D-05,-2.000D-05,-2.000D-05,-1.000D-05,
47186 6-8.000D-05, 1.800D-04,-5.000D-05, 2.000D-05, 0.000D+00, 0.000D+00,
47187 1 7.146D-01,-1.007D+00, 3.932D-01,-9.246D-02, 1.366D-02,-1.540D-03,
47188 2 6.856D-01,-9.828D-01, 3.977D-01,-9.795D-02, 1.540D-02,-1.790D-03,
47189 3-3.053D-02, 2.758D-02, 2.150D-03,-4.880D-03, 1.640D-03,-2.500D-04,
47190 4 9.200D-04, 4.200D-04,-1.340D-03, 4.600D-04,-8.000D-05,-1.000D-05,
47191 5 4.230D-03,-5.660D-03, 2.140D-03,-4.300D-04, 6.000D-05, 0.000D+00,
47192 6-3.890D-03, 5.000D-03,-1.740D-03, 3.300D-04,-4.000D-05, 0.000D+00/
47193 DATA TBMIN,TTMIN/8.1905D0,7.4474D0,11.5528D0,10.8097D0/
47194 DATA XOLD,QOLD,IOLD,NOLD/-1.D0,0.D0,0,0/
47195 DATA DMIN,Q0,QL/0.D0,2*2.D0,2*2.236D0,2.D0,.2D0,
47196 & .4D0,.2D0,.29D0,.177D0/
47197 C---X IS EQUAL TO XIN, UNLESS IT IS LESS THAN PDFX0
47199 IF (X.LE.ZERO) THEN
47200 CALL HWWARN('HWSFUN',100)
47204 IF (XMWN.LE.ZERO) THEN
47210 C---FREEZE THE SCALE IF REQUIRED
47212 IF (ISPAC.GT.0) SCALEF=MAX(SCALEF,QSPAC)
47213 C---CHECK IF PDFLIB REQUESTED
47214 IF (IBEAM.EQ.1.OR.IBEAM.EQ.2) THEN
47220 IF (IDHAD.EQ.59.OR.IDHAD.EQ.71) THEN
47221 IF (MPDF.GE.0) THEN
47222 C---USE PDFLIB PHOTON STRUCTURE FUNCTIONS
47223 PARM(1)=AUTPDF(IBEAM)
47225 C---FIX TO CALL SCHULER-SJOSTRAND CODE
47226 IF (AUTPDF(IBEAM).EQ.'SaSph') THEN
47228 IF ( XSP.LE.ZERO) THEN
47229 CALL HWWARN('HWSFUN',102)
47232 IF (ONE-XSP.LE.ZERO) THEN
47233 CALL HWWARN('HWSFUN',103)
47237 ISET=MOD(MODPDF(IBEAM),10)
47238 IOP1=MOD(MODPDF(IBEAM)/10,2)
47239 IOP2=MOD(MODPDF(IBEAM)/20,2)
47240 IP2=MODPDF(IBEAM)/100
47241 IF (IOP2.EQ.0) THEN
47245 IF (JDAHEP(1,IHAD).NE.0) IHAD=JDAHEP(1,IHAD)
47246 P2=SNGL(PHEP(5,IHAD)**2)
47248 CALL SASGAM(ISET,XSP,Q2,P2,IP2,F2GM,XPGA)
47249 IF (IOP1.EQ.1 .AND. ISTAT.LT.10) THEN
47251 5 XPGA(I)=XPVMD(I)+XPANL(I)+XPBEH(I)+XPDIR(I)
47263 IF(PARM(1).NE.PARMSAVE.OR.VAL(1).NE.VALSAVE)THEN
47266 CALL PDFSET_HERWIG(PARM,VAL)
47268 IF (X.LT.PDFXMN.AND.PDFWRX(IBEAM,1) .OR.
47269 & X.GT.PDFXMX.AND.PDFWRX(IBEAM,2)) THEN
47270 CALL HWWARN('HWSFUN',2)
47271 WRITE (6,'(2A)') ' WARNING: PDFLIB CALLED WITH X',
47272 & ' OUTSIDE ALLOWED RANGE!'
47273 WRITE (6,'(1P,3(A,E9.3))') ' X VALUE=',X,
47274 & ', MINIMUM=',PDFXMN,', MAXIMUM=',PDFXMX
47275 WRITE (6,'(A)') ' NO FURTHER WARNINGS WILL BE ISSUED'
47276 IF (X.LT.PDFXMN) PDFWRX(IBEAM,1)=.FALSE.
47277 IF (X.GT.PDFXMX) PDFWRX(IBEAM,2)=.FALSE.
47279 IF (QSCA**2.LT.PDFQMN.AND.PDFWRQ(IBEAM,1) .OR.
47280 & QSCA**2.GT.PDFQMX.AND.PDFWRQ(IBEAM,2)) THEN
47281 CALL HWWARN('HWSFUN',3)
47282 WRITE (6,'(2A)') ' WARNING: PDFLIB CALLED WITH Q',
47283 & ' OUTSIDE ALLOWED RANGE!'
47284 WRITE (6,'(1P,3(A,E9.3))') ' Q VALUE=',QSCA,
47285 & ', MINIMUM=',SQRT(PDFQMN),', MAXIMUM=',SQRT(PDFQMX)
47286 WRITE (6,'(A)') ' NO FURTHER WARNINGS WILL BE ISSUED'
47287 IF (QSCA**2.LT.PDFQMN) PDFWRQ(IBEAM,1)=.FALSE.
47288 IF (QSCA**2.GT.PDFQMN) PDFWRQ(IBEAM,2)=.FALSE.
47290 CALL STRUCTM(X,QSCA,UPV,DNV,USEA,DSEA,STR,CHM,BTM,TOP,GLU)
47298 IF ( XSP.LE.ZERO) THEN
47299 CALL HWWARN('HWSFUN',102)
47302 IF (ONE-XSP.LE.ZERO) THEN
47303 CALL HWWARN('HWSFUN',103)
47308 EMC2=SNGL(4*RMASS(4)**2)
47309 EMB2=SNGL(4*RMASS(5)**2)
47312 IF (Q2.GT.50.) NFL=4
47313 IF (Q2.GT.500.) NFL=5
47314 STR=HWSDGQ(XSP,Q2,NFL,1)
47315 CHM=HWSDGQ(XSP,Q2,NFL,2)
47316 GLU=HWSDGG(XSP,Q2,NFL)
47321 IF (W2.GT.EMB2) THEN
47323 IF (W2*ALAM2.LT.Q2*EMB2)
47324 & BTM=BTM*LOG(W2/EMB2)/LOG(Q2/ALAM2)
47328 IF (W2.GT.EMC2) THEN
47329 IF (W2*ALAM2.LT.Q2*EMC2)
47330 & CHM=CHM*LOG(W2/EMC2)/LOG(Q2/ALAM2)
47336 C---INCLUDE SUPPRESSION FROM PHOTON VIRTUALITY IF NECESSARY
47337 IF (PHOMAS.GT.ZERO.AND.(IBEAM.EQ.1.OR.IBEAM.EQ.2)) THEN
47339 IF (JDAHEP(1,IHAD).NE.0) IHAD=JDAHEP(1,IHAD)
47340 IF (IDHW(IHAD).EQ.59) THEN
47341 FAC=LOG((QSCA**2+PHOMAS**2)/(PHEP(5,IHAD)**2+PHOMAS**2))/
47342 $ LOG((QSCA**2+PHOMAS**2)/( PHOMAS**2))
47343 IF (FAC.LT.ZERO) FAC=ZERO
47344 DIST(1)=DIST(1)*FAC
47345 DIST(2)=DIST(2)*FAC
47346 DIST(7)=DIST(7)*FAC
47347 DIST(8)=DIST(8)*FAC
47354 CALL HWWARN('HWSFUN',1)
47359 IF (MPDF.GE.0) THEN
47360 C---USE PDFLIB NUCLEON STRUCTURE FUNCTIONS
47361 PARM(1)=AUTPDF(IBEAM)
47363 IF(PARM(1).NE.PARMSAVE.OR.VAL(1).NE.VALSAVE)THEN
47366 CALL PDFSET_HERWIG(PARM,VAL)
47368 IF (X.LT.PDFXMN.AND.PDFWRX(IBEAM,1) .OR.
47369 & X.GT.PDFXMX.AND.PDFWRX(IBEAM,2)) THEN
47370 CALL HWWARN('HWSFUN',4)
47371 WRITE (6,'(2A)') ' WARNING: PDFLIB CALLED WITH X',
47372 & ' OUTSIDE ALLOWED RANGE!'
47373 WRITE (6,'(1P,3(A,E9.3))') ' X VALUE=',X,
47374 & ', MINIMUM=',PDFXMN,', MAXIMUM=',PDFXMX
47375 WRITE (6,'(A)') ' NO FURTHER WARNINGS WILL BE ISSUED'
47376 IF (X.LT.PDFXMN) PDFWRX(IBEAM,1)=.FALSE.
47377 IF (X.GT.PDFXMX) PDFWRX(IBEAM,2)=.FALSE.
47379 IF (QSCA**2.LT.PDFQMN.AND.PDFWRQ(IBEAM,1) .OR.
47380 & QSCA**2.GT.PDFQMX.AND.PDFWRQ(IBEAM,2)) THEN
47381 CALL HWWARN('HWSFUN',5)
47382 WRITE (6,'(2A)') ' WARNING: PDFLIB CALLED WITH Q',
47383 & ' OUTSIDE ALLOWED RANGE!'
47384 WRITE (6,'(1P,3(A,E9.3))') ' Q VALUE=',QSCA,
47385 & ', MINIMUM=',SQRT(PDFQMN),', MAXIMUM=',SQRT(PDFQMX)
47386 WRITE (6,'(A)') ' NO FURTHER WARNINGS WILL BE ISSUED'
47387 IF (QSCA**2.LT.PDFQMN) PDFWRQ(IBEAM,1)=.FALSE.
47388 IF (QSCA**2.GT.PDFQMN) PDFWRQ(IBEAM,2)=.FALSE.
47390 CALL STRUCTM(X,QSCA,UPV,DNV,USEA,DSEA,STR,CHM,BTM,TOP,GLU)
47391 C--new MRST98 LO PDF's
47392 ELSEIF(NSET.GE.6.AND.NSET.LE.8) THEN
47393 CALL HWSMRS(X,SCALEF,NSET-5,UPV,DNV,USEA,DSEA,STR,CHM,BTM,GLU)
47396 IF (NSET.LT.1.OR.NSET.GT.5) CALL HWWARN('HWSFUN',400)
47397 IF (QSCA.LT.Q0(NSET)) QSCA=Q0(NSET)
47398 IF (QSCA.NE.QOLD.OR.IDHAD.NE.IOLD.OR.NSET.NE.NOLD) THEN
47403 SS=LOG(QSCA/QL(NSET))
47404 SMIN=LOG(Q0(NSET)/QL(NSET))
47405 IF (NSET.LT.3.OR.NSET.EQ.5) THEN
47410 TMAX=2.*LOG(1.E4/QL(NSET))
47412 IF (IDHAD.GE.72) THEN
47413 IF (NSET.LT.3) THEN
47417 10 A(J,I)=B(1,J,I,IP)+S*(B(2,J,I,IP)+S*B(3,J,I,IP))
47419 AA=ONE+A(2,K)+A(3,K)
47420 20 G(K)=HWSGAM(AA)/((ONE+A(2,K)*A(4,K)/AA)*HWSGAM(A(2,K))
47421 & *HWSGAM(ONE+A(3,K)))
47422 ELSEIF (NSET.EQ.5) THEN
47425 21 A(J,I)=BB(1,J,I)+S*(BB(2,J,I)+S*(BB(3,J,I)+S*BB(4,J,I)))
47427 AA=ONE+A(2,K)+A(3,K)
47428 22 G(K)=HWSGAM(AA)/((ONE+A(2,K)/AA*(A(4,K)+
47429 & (ONE+A(2,K))/(ONE+AA)*A(5,K)))*HWSGAM(A(2,K))
47430 & *HWSGAM(ONE+A(3,K)))
47433 VT=MAX(-ONE,MIN(ONE,(2.*T-TMAX-TMIN)/(TMAX-TMIN)))
47435 C...CHEBYSHEV POLYNOMIALS FOR T EXPANSION
47439 TT(4)= (4.*WT- 3.)*VT
47440 TT(5)= (8.*WT- 8.)*WT+1.
47441 TT(6)=((16.*WT-20.)*WT+5.)*VT
47443 ELSEIF (NSET.LT.3) THEN
47447 30 A(J,I)=B(1,J,I,IP)+S*(B(2,J,I,IP)+S*B(3,J,I,IP))
47448 AA=ONE+A(2,1)+A(3,1)
47449 G(1)=HWSGAM(AA)/(HWSGAM(A(2,1))*HWSGAM(ONE+A(3,1)))
47454 IF (NSET.LT.3.OR.NSET.EQ.5) THEN
47456 50 F(I)=A(1,I)*X**A(2,I)*XMWN**A(3,I)*(ONE+X*
47457 & (A(4,I)+X*(A(5,I) + X*A(6,I))))
47469 IF (X.NE.XOLD) THEN
47476 VX=MAX(-ONE,(2.*LOG(X)+11.51293)/6.90776)
47482 TX(4)= (4.*WX- 3.)*VX
47483 TX(5)= (8.*WX- 8.)*WX+1.
47484 TX(6)=((16.*WX-20.)*WX+5.)*VX
47486 C...CALCULATE STRUCTURE FUNCTIONS
47491 110 XQSUM=XQSUM+CEHLQ(IX,IT,NX,IFL,IP)*TX(IX)*TT(IT)
47492 120 XQ(IFL)=XQSUM*XMWN**NEHLQ(IFL,IP)
47499 C...SPECIAL EXPANSION FOR BOTTOM (THRESHOLD EFFECTS)
47500 IF (NFLAV.LT.5.OR.T.LE.TBMIN(IP)) THEN
47503 VT=MAX(-ONE,MIN(ONE,(2.*T-TMAX-TBMIN(IP))/(TMAX-TBMIN(IP))))
47508 TB(4)= (4.*WT- 3.)*VT
47509 TB(5)= (8.*WT- 8.)*WT+1.
47510 TB(6)=((16.*WT-20.)*WT+5.)*VT
47514 130 XQSUM=XQSUM+CEHLQ(IX,IT,NX,7,IP)*TX(IX)*TB(IT)
47515 BTM=XQSUM*XMWN**NEHLQ(7,IP)
47517 C...SPECIAL EXPANSION FOR TOP (THRESHOLD EFFECTS)
47518 TPMIN=TTMIN(IP)+TMTOP
47519 C---TMTOP=2.*LOG(TOPMAS/30.)
47521 IF (NFLAV.LT.6.OR.T.LE.TPMIN) THEN
47524 VT=MAX(-ONE,MIN(ONE,(2.*T-TPMAX-TPMIN)/(TPMAX-TPMIN)))
47529 TB(4)= (4.*WT- 3.)*VT
47530 TB(5)= (8.*WT- 8.)*WT+1.
47531 TB(6)=((16.*WT-20.)*WT+5.)*VT
47535 150 XQSUM=XQSUM+CEHLQ(IX,IT,NX,8,IP)*TX(IX)*TB(IT)
47536 TOP=XQSUM*XMWN**NEHLQ(8,IP)
47540 IF (MPDF.LT.0.AND.NSET.LE.5) THEN
47544 IF(MPDF.LT.0.AND.NSET.GT.2.AND.(IDHAD.EQ.38.OR.IDHAD.EQ.30)) THEN
47545 WRITE(6,*) ' THIS SET OF PDFS DOES NOT SUPPORT PIONS'
47546 WRITE(6,*) 'EITHER USE SET NSTRU=1,2 OR A PION SET FROM PDFLIB'
47549 IF (IDHAD.EQ.73.OR.IDHAD.EQ.72) THEN
47554 ELSEIF (IDHAD.EQ.91) THEN
47559 ELSEIF (IDHAD.EQ.75) THEN
47564 ELSEIF (IDHAD.EQ.93) THEN
47569 ELSEIF (IDHAD.EQ.38) THEN
47574 ELSEIF (IDHAD.EQ.30) THEN
47580 PRINT *,' CALLED HWSFUN FOR IDHAD =',IDHAD
47581 CALL HWWARN('HWSFUN',401)
47593 IF (DIST(I).LT.DMIN) DIST(I)=DMIN
47595 C---FOR REMNANT NUCLEONS SWITCH OFF VALENCE QUARKS,
47596 C WHILE MAINTAINING MOMENTUM SUM RULE
47597 IF (IDHAD.EQ.72) THEN
47600 TOTAL=TOTAL+DIST(I)
47602 DIST(1)=DIST(1)-DNV
47603 DIST(2)=DIST(2)-UPV
47604 IF (TOTAL.GT.DNV+UPV) THEN
47606 DIST(I)=DIST(I)*TOTAL/(TOTAL-DNV-UPV)
47610 C---IF X HAS BEEN FROZEN USE A POWER LAW
47611 IF (XIN.LT.PDFX0) THEN
47612 PDFFAC=(XIN/PDFX0)**PDFPOW
47614 DIST(I)=DIST(I)*PDFFAC
47620 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
47621 *-- Author : Adapted by Bryan Webber
47622 C-----------------------------------------------------------------------
47623 FUNCTION HWSGAM(ZINPUT)
47624 C-----------------------------------------------------------------------
47625 C Gamma function computed by eq. 6.1.40, Abramowitz.
47626 C B(M) = B2m/(2m *(2m-1)) where B2m is the 2m'th Bernoulli number.
47627 C HLNTPI = .5*LOG(2.*PI)
47628 C-----------------------------------------------------------------------
47630 DOUBLE PRECISION HWSGAM,ZINPUT,B(10),HLNTPI,Z,SHIFT,G,T,RECZSQ
47634 1 0.83333333333333333333D-01, -0.27777777777777777778D-02,
47635 1 0.79365079365079365079D-03, -0.59523809523809523810D-03,
47636 1 0.84175084175084175084D-03, -0.19175269175269175269D-02,
47637 1 0.64102564102564102564D-02, -0.29550653594771241830D-01,
47638 1 0.17964437236883057316D0 , -1.3924322169059011164D0 /
47639 DATA HLNTPI/0.91893853320467274178D0/
47641 C Shift argument to large value ( > 20 )
47645 10 IF (Z.LT.20.D0) THEN
47651 C Compute asymptotic formula
47653 G = (Z-.5D0)*LOG(Z) - Z + HLNTPI
47660 HWSGAM = EXP(G)/SHIFT
47663 *CMZ :- -26/04/91 14.55.45 by Federico Carminati
47664 *-- Author : Bryan Webber
47665 C-----------------------------------------------------------------------
47666 SUBROUTINE HWSGEN(GENEX)
47667 C-----------------------------------------------------------------------
47668 C GENERATES X VALUES (IF GENEX)
47669 C EVALUATES STRUCTURE FUNCTIONS AND ENFORCES CUTOFFS ON X
47670 C-----------------------------------------------------------------------
47671 INCLUDE 'herwig65.inc'
47672 DOUBLE PRECISION HWBVMC,HWRUNI,X,QL
47675 EXTERNAL HWBVMC,HWRUNI
47677 XX(1)=EXP(HWRUNI(0,ZERO,XLMIN))
47682 IF (JDAHEP(1,I).NE.0) J=JDAHEP(1,I)
47685 CALL HWSFUN(X,EMSCA,IDHW(J),NSTRU,DISF(1,I),I)
47687 IF (QL.LT.HWBVMC(J)) DISF(J,I)=0.
47691 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
47692 *-- Author : Bryan Webber
47693 C-----------------------------------------------------------------------
47694 FUNCTION HWSGQQ(QSCA)
47695 C-----------------------------------------------------------------------
47696 C CORRECTION TO GLUON STRUCTURE FUNCTION FOR BACKWARD EVOLUTION:
47697 C G->Q-QBAR PART OF FORM FACTOR
47698 C-----------------------------------------------------------------------
47699 INCLUDE 'herwig65.inc'
47700 DOUBLE PRECISION HWSGQQ,HWUALF,QSCA,GG
47702 GG=HWUALF(1,QSCA)**(-ONE/BETAF)
47703 IF (GG.LT.ONE) GG=ONE
47704 IF (QSCA.GT.RMASS(6)) THEN
47706 ELSEIF (QSCA.GT.RMASS(5)) THEN
47708 ELSEIF (QSCA.GT.RMASS(4)) THEN
47715 *CMZ :- -26/04/01 10.00.16 by Peter Richardson
47716 *-- Author : Dick Roberts, modified by Peter Richardson
47717 C-----------------------------------------------------------------------
47718 SUBROUTINE HWSMRS(X,Q,MODE,UPV,DNV,USEA,DSEA,STR,CHM,BOT,GLU)
47719 C-----------------------------------------------------------------------
47720 C MRST98 Leading order PDF's central and higher gluon + average
47721 C-----------------------------------------------------------------------
47722 INCLUDE 'herwig65.inc'
47723 DOUBLE PRECISION X,Q,UPV,DNV,USEA,DSEA,STR,CHM,BOT,GLU,XMIN,XMAX,
47724 & QSQMIN,QSQMAX,Q2,QQ(NQMRS),XXMRS(NXMRS),G(NPMRS),N0(NPMRS),
47725 & XSAVE,Q2SAVE,XXX,A,B,FAC
47726 INTEGER MODE,INIT,NTENTH,N,M,I,J,K,ML,WARN(2)
47727 PARAMETER(NTENTH=23)
47728 SAVE INIT,WARN,XMIN,XMAX,QSQMIN,QSQMAX,XXMRS,QQ,N0
47729 DATA XMIN,XMAX,QSQMIN,QSQMAX/1D-5,1D0,1.25D0,1D7/
47730 DATA XXMRS/1d-5,2d-5,4d-5,6d-5,8d-5,
47731 & 1d-4,2d-4,4d-4,6d-4,8d-4,
47732 & 1d-3,2d-3,4d-3,6d-3,8d-3,
47733 & 1d-2,1.4d-2,2d-2,3d-2,4d-2,6d-2,8d-2,
47734 & .1d0,.125d0,.15d0,.175d0,.2d0,.225d0,.25d0,.275d0,
47735 & .3d0,.325d0,.35d0,.375d0,.4d0,.425d0,.45d0,.475d0,
47736 & .5d0,.525d0,.55d0,.575d0,.6d0,.65d0,.7d0,.75d0,
47738 DATA QQ/1.25d0,1.5d0,2d0,2.5d0,3.2d0,4d0,5d0,6.4d0,8d0,1d1,
47739 & 1.2d1,1.8d1,2.6d1,4d1,6.4d1,1d2,
47740 & 1.6d2,2.4d2,4d2,6.4d2,1d3,1.8d3,3.2d3,5.6d3,1d4,
47741 & 1.8d4,3.2d4,5.6d4,1d5,1.8d5,3.2d5,5.6d5,1d6,
47742 & 1.8d6,3.2d6,5.6d6,1d7/
47743 DATA N0/3,4,5,9,9,9,9,9/
47744 DATA INIT,WARN/0,0,0/
47746 C--issue warning if x or q out of range
47747 IF((Q2.LT.QSQMIN.OR.Q2.GT.QSQMAX).AND.WARN(1).EQ.0) THEN
47748 CALL HWWARN('HWSMRS',5)
47749 WRITE (6,'(2A)') ' WARNING: MRST98 CALLED WITH Q',
47750 & ' OUTSIDE ALLOWED RANGE!'
47751 WRITE (6,'(1P,3(A,E9.3))') ' Q VALUE=',Q,
47752 & ', MINIMUM=',SQRT(QSQMIN),', MAXIMUM=',SQRT(QSQMAX)
47753 WRITE (6,'(A)') ' NO FURTHER WARNINGS WILL BE ISSUED'
47756 IF((X.LT.XMIN.OR.X.GT.XMAX).AND.WARN(2).EQ.0) THEN
47757 CALL HWWARN('HWSMRS',4)
47758 WRITE (6,'(2A)') ' WARNING: MRST98 CALLED WITH X',
47759 & ' OUTSIDE ALLOWED RANGE!'
47760 WRITE (6,'(1P,3(A,E9.3))') ' X VALUE=',X,
47761 & ', MINIMUM=',XMIN,', MAXIMUM=',XMAX
47762 WRITE (6,'(A)') ' NO FURTHER WARNINGS WILL BE ISSUED'
47765 C--now the evaluation
47768 C--first the initialisation
47769 IF(INIT.NE.0) GOTO 10
47774 c notation: 1=uval 2=val 3=glue 4=usea 5=chm 6=str 7=btm 8=dsea
47776 FMRS(ML,I,N,M) = FMRS(ML,I,N,M)/(1.0D0-XXMRS(N))**N0(I)
47778 FMRS(ML,I,N,M) = 0.5D0*(FMRS(1,I,N,M)+FMRS(2,I,N,M))/
47779 & (1.0D0-XXMRS(N))**N0(I)
47784 IF(I.EQ.5.OR.I.EQ.7) GOTO 31
47786 30 FMRS(ML,I,J,K)=DLOG10(FMRS(ML,I,J,K)/FMRS(ML,I,NTENTH,K))
47787 & +FMRS(ML,I,NTENTH,K)
47791 40 FMRS(ML,I,NXMRS,M)=0.0D0
47794 32 XXMRS(J)=DLOG10(XXMRS(J)/XXMRS(NTENTH))+XXMRS(NTENTH)
47797 C--check x and q within range of set
47798 IF(X.LT.XMIN) X=XMIN
47799 IF(X.GT.XMAX) X=XMAX
47800 IF(Q2.LT.QSQMIN) Q2=QSQMIN
47801 IF(Q2.GT.QSQMAX) Q2=QSQMAX
47804 IF(X.LT.XXMRS(NTENTH)) XXX=DLOG10(X/XXMRS(NTENTH))+XXMRS(NTENTH)
47807 IF(XXX.GT.XXMRS(N+1)) GOTO 70
47808 A=(XXX-XXMRS(N))/(XXMRS(N+1)-XXMRS(N))
47811 IF(Q2.GT.QQ(M+1)) GOTO 80
47812 B=(Q2-QQ(M))/(QQ(M+1)-QQ(M))
47814 G(I)= (1.0D0-A)*(1.0D0-B)*FMRS(MODE,I,N ,M )
47815 & +(1.0D0-A)* B *FMRS(MODE,I,N ,M+1)
47816 & + A *(1.0D0-B)*FMRS(MODE,I,N+1,M )
47817 & + A * B *FMRS(MODE,I,N+1,M+1)
47818 IF(N.GE.NTENTH) GOTO 65
47819 IF(I.EQ.5.OR.I.EQ.7) GOTO 65
47820 FAC = (1.0D0-B)*FMRS(MODE,I,NTENTH,M)+B*FMRS(MODE,I,NTENTH,M+1)
47821 G(I) = FAC*10.0d0**(G(I)-FAC)
47823 G(I)=G(I)*(1.0d0-X)**N0(I)
47837 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
47838 *-- Author : Bryan Webber
47839 C-----------------------------------------------------------------------
47841 C-----------------------------------------------------------------------
47842 C REPLACES SPACELIKE PARTONS BY SPECTATORS
47843 C-----------------------------------------------------------------------
47844 INCLUDE 'herwig65.inc'
47845 DOUBLE PRECISION HWUSQR,EMSQ,EMTR,EPAR,XPAR,QSQ,PCL(5)
47846 INTEGER KHEP,IP,JP,IDH,IDP,ISP,IDSPC,JHEP
47848 IF (IERROR.NE.0) RETURN
47850 IF (ISTHEP(KHEP).EQ.145.OR.ISTHEP(KHEP).EQ.146) THEN
47851 IP=ISTHEP(KHEP)-144
47853 IF (JDAHEP(1,IP).NE.0) JP=JDAHEP(1,IP)
47856 IF (IDH.NE.IDP) THEN
47857 IF (IDH.EQ.59) THEN
47861 ELSEIF (IDP.LT.13) THEN
47864 CALL HWWARN('HWSSPC',100)
47867 C---IDENTIFY SPECTATOR
47869 ELSEIF (IDP.LE.3) THEN
47871 10 IF (IDH.EQ.NCLDK(LOCN(IDP,ISP))) GOTO 20
47872 CALL HWWARN('HWSSPC',101)
47874 20 IF (ISP.LE.3) THEN
47876 ELSEIF (ISP.LE.9) THEN
47881 C---(2) ANTIQUARK CASE
47882 ELSEIF (IDP.GT.6.AND.IDP.LE.9) THEN
47885 30 IF (IDH.EQ.NCLDK(LOCN(ISP,IDP))) GOTO 40
47886 CALL HWWARN('HWSSPC',103)
47888 40 IF (ISP.LE.3) THEN
47890 ELSEIF (ISP.LE.9) THEN
47895 C---SPECIAL CASE FOR REMNANT HADRON
47896 ELSEIF (IDH.EQ.71.OR.IDH.EQ.72) THEN
47897 IF (IDP.EQ.13) THEN
47900 CALL HWWARN('HWSSPC',106)
47904 CALL HWWARN('HWSSPC',105)
47907 C---REPLACE PARTON BY SPECTATOR
47909 IDHEP(KHEP)=IDPDG(IDSPC)
47910 ISTHEP(KHEP)=146+IP
47911 EMSQ=SIGN(PHEP(5,KHEP)**2,PHEP(5,KHEP))
47912 EMTR=EMSQ+PHEP(1,KHEP)**2+PHEP(2,KHEP)**2
47914 CALL HWVDIF(4,PHEP(1,JP),PHEP(1,KHEP),PHEP(1,KHEP))
47915 IF (EPAR**2.LT.10000.*ABS(EMTR)) THEN
47916 CALL HWUMAS(PHEP(1,KHEP))
47918 C---COMPUTE SPECTATOR MASS ELIMINATING ROUNDING ERRORS
47919 XPAR=EPAR/PHEP(4,JP)
47920 QSQ=SIGN(PHEP(5,JP)**2,PHEP(5,JP))
47921 PHEP(5,KHEP)=HWUSQR((1.-XPAR)*QSQ+EMSQ-EMTR/XPAR
47922 & -((QSQ*XPAR**2-EMTR)/(2*EPAR*XPAR**2))**2*XPAR)
47924 C---CHECK FOR UNPHYSICAL SPECTATOR
47925 IF (PHEP(4,KHEP).LT.ZERO) FROST=.TRUE.
47926 C---FIND MASS OF CORRESPONDING CLUSTER, IF PARTNER IS IN THE SAME JET
47927 IF (QORQQB(IDHW(KHEP))) THEN
47928 JHEP=JMOHEP(2,KHEP)
47929 ELSEIF (QBORQQ(IDHW(KHEP))) THEN
47930 JHEP=JDAHEP(2,KHEP)
47934 IF (JHEP.GT.0) THEN
47935 CALL HWVSUM(4,PHEP(1,KHEP),PHEP(1,JHEP),PCL)
47937 C---IF IT IS NEGATIVE, REJECT
47938 IF (PCL(5).LT.ZERO) FROST=.TRUE.
47946 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
47947 *-- Author : Bryan Webber
47948 C-----------------------------------------------------------------------
47950 C-----------------------------------------------------------------------
47951 INCLUDE 'herwig65.inc'
47952 DOUBLE PRECISION HWSSUD,HWSGQQ,DMIN,QSCA,XLAST,DIST(13)
47955 COMMON/HWTABC/XLAST,N0,IS,ID
47959 CALL HWSFUN(XLAST,QSCA,IDHW(INHAD),NSTRU,DIST,JNHAD)
47960 IF (ID.EQ.13) DIST(ID)=DIST(ID)*HWSGQQ(QSCA)
47961 IF (DIST(ID).LT.DMIN) DIST(ID)=DMIN
47962 HWSSUD=SUD(N0+I,IS)/DIST(ID)
47965 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
47966 *-- Author : Adapted by Bryan Webber
47967 C-----------------------------------------------------------------------
47968 FUNCTION HWSTAB(F,AFUN,NN,X,MM)
47969 C-----------------------------------------------------------------------
47970 C MODIFIED CERN INTERPOLATION ROUTINE DIVDIF
47971 C LIKE HWUTAB BUT USES FUNCTION AFUN IN PLACE OF ARRAY A
47972 C-----------------------------------------------------------------------
47974 INTEGER NN,MM,MMAX,N,M,MPLUS,IX,IY,MID,NPTS,IP,I,J,L,ISUB
47975 DOUBLE PRECISION HWSTAB,AFUN,SUM,X,F(NN),T(20),D(20)
47985 IF (AFUN(1).GT.AFUN(N)) GOTO 94
47987 IF (X.GE.AFUN(MID)) GOTO 92
47991 93 IF (IY-IX.GT.1) GOTO 91
47994 IF (X.LE.AFUN(MID)) GOTO 95
47998 96 IF (IY-IX.GT.1) GOTO 94
47999 97 NPTS=M+2-MOD(M,2)
48006 IF ((1.LE.ISUB).AND.(ISUB.LE.N)) GOTO 100
48012 101 IF (IP.LT.NPTS) GOTO 98
48013 EXTRA=NPTS.NE.MPLUS
48015 IF (.NOT.EXTRA) GOTO 12
48017 D(M+2)=(D(M+2)-D(M))/(T(M+2)-T(ISUB))
48021 D(I)=(D(I)-D(I-1))/(T(I)-T(ISUB))
48026 IF (EXTRA) SUM=0.5*(SUM+D(M+2))
48029 SUM=D(J)+(X-T(J))*SUM
48035 *CMZ :- -26/04/91 10.18.58 by Bryan Webber
48036 *-- Author : Bryan Webber
48037 C-----------------------------------------------------------------------
48038 FUNCTION HWSVAL(ID)
48039 C-----------------------------------------------------------------------
48040 C TRUE FOR VALENCE PARTON ID IN INCOMING HADRON INHAD
48041 C-----------------------------------------------------------------------
48042 INCLUDE 'herwig65.inc'
48047 IF (IDHAD.EQ.73.OR.IDHAD.EQ.75) THEN
48048 IF (ID.EQ.1.OR.ID.EQ.2) HWSVAL=.TRUE.
48049 ELSEIF (IDHAD.EQ.91.OR.IDHAD.EQ.93) THEN
48050 IF (ID.EQ.7.OR.ID.EQ.8) HWSVAL=.TRUE.
48051 ELSEIF (IDHAD.EQ.30) THEN
48052 IF (ID.EQ.1.OR.ID.EQ.8) HWSVAL=.TRUE.
48053 ELSEIF (IDHAD.EQ.38) THEN
48054 IF (ID.EQ.2.OR.ID.EQ.7) HWSVAL=.TRUE.
48055 ELSEIF (IDHAD.EQ.59) THEN
48056 IF (ID.LT.6.OR.(ID.GT.6.AND.ID.LT.12)) HWSVAL=.TRUE.
48057 ELSEIF (IDHAD.EQ.71.OR.IDHAD.EQ.72) THEN
48058 IF (ID.EQ.13) HWSVAL=.TRUE.
48060 CALL HWWARN('HWSVAL',100)
48064 *CMZ :- -23/08/94 13.22.29 by Mike Seymour
48065 *-- Author : Ian Knowles
48066 C-----------------------------------------------------------------------
48067 FUNCTION HWUAEM(Q2)
48068 C-----------------------------------------------------------------------
48069 C Running electromagnetic coupling constant.
48070 C See R. Kleiss et al.: CERN yellow report 89-08, vol.3 p.129
48071 C Hadronic component from: H. Burkhardt et al.: Z. Phys C43 (89) 497
48072 C-----------------------------------------------------------------------
48073 INCLUDE 'herwig65.inc'
48074 DOUBLE PRECISION HWUAEM,HWUAER,Q2,EPS,A1,B1,C1,A2,B2,C2,A3,B3,C3,
48075 & A4,B4,C4,AEMPI,EEL2,EMU2,ETAU2,ETOP2,REPIGG,X
48078 SAVE FIRST,AEMPI,EEL2,EMU2,ETAU2,ETOP2
48079 PARAMETER (EPS=1.D-6)
48080 SAVE A1,B1,C1,A2,B2,C2,A3,B3,C3,A4,B4,C4
48081 DATA A1,B1,C1/0.0 D0,0.00835D0,1.000D0/
48082 DATA A2,B2,C2/0.0 D0,0.00238D0,3.927D0/
48083 DATA A3,B3,C3/0.00165D0,0.00299D0,1.000D0/
48084 DATA A4,B4,C4/0.00221D0,0.00293D0,1.000D0/
48087 AEMPI=ALPHEM/(THREE*PIFAC)
48088 EEL2 =RMASS(121)**2
48089 EMU2 =RMASS(123)**2
48090 ETAU2=RMASS(125)**2
48094 IF (ABS(Q2).LT.EPS) THEN
48098 C Leptonic component
48099 REPIGG=AEMPI*(HWUAER(EEL2/Q2)+HWUAER(EMU2/Q2)+HWUAER(ETAU2/Q2))
48100 C Hadronic component from light quarks
48102 IF (X.LT.9.D-2) THEN
48103 REPIGG=REPIGG+A1+B1*LOG(ONE+C1*X)
48104 ELSEIF (X.LT.9.D0) THEN
48105 REPIGG=REPIGG+A2+B2*LOG(ONE+C2*X)
48106 ELSEIF (X.LT.1.D4) THEN
48107 REPIGG=REPIGG+A3+B3*LOG(ONE+C3*X)
48109 REPIGG=REPIGG+A4+B4*LOG(ONE+C4*X)
48112 REPIGG=REPIGG+AEMPI*HWUAER(ETOP2/Q2)
48113 HWUAEM=ALPHEM/(ONE-REPIGG)
48116 *CMZ :- -23/08/94 13.22.29 by Mike Seymour
48117 *-- Author : Ian Knowles
48118 C-----------------------------------------------------------------------
48120 C-----------------------------------------------------------------------
48121 C Real part of photon self-energy: Pi_{gg}(R=M^2/Q^2)
48122 C-----------------------------------------------------------------------
48124 DOUBLE PRECISION HWUAER,R,ZERO,ONE,TWO,FOUR,FVTHR,THIRD,RMAX,BETA
48125 PARAMETER (ZERO=0.D0, ONE=1.D0, TWO=2.D0, FOUR=4.D0,
48126 & FVTHR=1.666666666666667D0, THIRD=.3333333333333333D0)
48127 PARAMETER (RMAX=1.D6)
48128 IF (ABS(R).LT.1.D-3) THEN
48129 C Use assymptotic formula
48130 HWUAER=-FVTHR-LOG(ABS(R))
48131 ELSEIF (ABS(R).GT.RMAX) THEN
48133 ELSEIF (FOUR*R.GT.ONE) THEN
48134 BETA=SQRT(FOUR*R-ONE)
48136 & -(ONE+TWO*R)*(TWO-BETA*ACOS(ONE-ONE/(TWO*R)))
48138 BETA=SQRT(ONE-FOUR*R)
48140 & -(ONE+TWO*R)*(TWO+BETA*LOG(ABS((BETA-ONE)/(BETA+ONE))))
48144 *CMZ :- -15/07/92 14.08.45 by Mike Seymour
48145 *-- Author : Bryan Webber
48146 C-----------------------------------------------------------------------
48147 FUNCTION HWUALF(IOPT,SCALE)
48148 C-----------------------------------------------------------------------
48149 C STRONG COUPLING CONSTANT
48150 C IOPT.EQ.0 INITIALIZES
48151 C .EQ.1 TWO-LOOP, FLAVOUR THRESHOLDS
48152 C .EQ.2 RATIO OF ABOVE TO ONE-LOOP
48153 C WITH 5-FLAVOUR BETA, LAMBDA=QCDL3
48154 C .EQ.3 ONE-LOOP WITH 5-FLAVOUR BETA, LAMBDA=QCDL3
48155 C-----------------------------------------------------------------------
48156 INCLUDE 'herwig65.inc'
48157 DOUBLE PRECISION HWUALF,SCALE,KAFAC,B3,B4,B5,B6,C3,C4,C5,C6,C35,
48158 & C45,C65,D35,RHO,RAT,RLF,DRH,EPS
48160 SAVE B3,B4,B5,B6,C3,C4,C5,C6,C35,C45,C65,D35
48163 IF (IOPT.EQ.0) THEN
48164 C---INITIALIZE CONSTANTS
48166 CFFAC=FLOAT(NCOLO**2-1)/(2.*CAFAC)
48167 B3=((11.*CAFAC)- 6.)/(12.*PIFAC)
48168 B4=((11.*CAFAC)- 8.)/(12.*PIFAC)
48169 B5=((11.*CAFAC)-10.)/(12.*PIFAC)
48170 B6=((11.*CAFAC)-12.)/(12.*PIFAC)
48172 C3=((17.*CAFAC**2)-(5.*CAFAC+3.*CFFAC)*3.)/(24.*PIFAC**2)/B3**2
48173 C4=((17.*CAFAC**2)-(5.*CAFAC+3.*CFFAC)*4.)/(24.*PIFAC**2)/B4**2
48174 C5=((17.*CAFAC**2)-(5.*CAFAC+3.*CFFAC)*5.)/(24.*PIFAC**2)/B5**2
48175 C6=((17.*CAFAC**2)-(5.*CAFAC+3.*CFFAC)*6.)/(24.*PIFAC**2)/B6**2
48176 KAFAC=CAFAC*(67./18.-PIFAC**2/6.)-25./9.
48177 C---QCDLAM IS 5-FLAVOUR LAMBDA-MS-BAR AT LARGE X OR Z
48178 C---QCDL5 IS 5-FLAVOUR LAMBDA-MC
48179 QCDL5=QCDLAM*EXP(KAFAC/(4.*PIFAC*B5))/SQRT(2.D0)
48180 C---COMPUTE THRESHOLD MATCHING
48181 RHO=2.*LOG(RMASS(6)/QCDL5)
48183 C65=(B5/(1.-C5*RAT)-B6/(1.-C6*RAT))*RHO
48184 RHO=2.*LOG(RMASS(5)/QCDL5)
48186 C45=(B5/(1.-C5*RAT)-B4/(1.-C4*RAT))*RHO
48187 RHO=2.*LOG(RMASS(4)/QCDL5)
48189 C35=(B4/(1.-C4*RAT)-B3/(1.-C3*RAT))*RHO+C45
48194 RLF=B3*D35/(1.-C3*RAT)
48195 DRH=B3*(RLF+C35)*D35**2/((1.-2.*C3*RAT+C3/D35)*RLF**2)
48197 IF (ABS(DRH).LT.EPS*D35) GOTO 20
48199 20 QCDL3=QCDL5*EXP(0.5*D35)
48201 IF (SCALE.LE.QCDL5) THEN
48202 CALL HWWARN('HWUALF',51)
48205 RHO=2.*LOG(SCALE/QCDL5)
48206 IF (IOPT.EQ.3) THEN
48207 IF (RHO.LE.D35) THEN
48208 CALL HWWARN('HWUALF',52)
48211 HWUALF=1./(B5*(RHO-D35))
48215 IF (SCALE.GT.RMASS(6)) THEN
48216 RLF=B6*RHO/(1.-C6*RAT)+C65
48217 ELSEIF (SCALE.GT.RMASS(5)) THEN
48218 RLF=B5*RHO/(1.-C5*RAT)
48219 ELSEIF (SCALE.GT.RMASS(4)) THEN
48220 RLF=B4*RHO/(1.-C4*RAT)+C45
48222 RLF=B3*RHO/(1.-C3*RAT)+C35
48224 IF (RLF.LE.ZERO) THEN
48225 CALL HWWARN('HWUALF',53)
48228 IF (IOPT.EQ.1) THEN
48231 HWUALF=B5*(RHO-D35)/RLF
48232 IF (HWUALF.GT.ONE) THEN
48233 CALL HWWARN('HWUALF',54)
48241 *CMZ :- -27/07/99 13.33.03 by Mike Seymour
48242 *-- Author : Ian Knowles
48243 C-----------------------------------------------------------------------
48244 FUNCTION HWUANT(IPART)
48245 C-----------------------------------------------------------------------
48246 C Returns the antiparticle of IPART; uses HERWIG numbering
48247 C-----------------------------------------------------------------------
48248 INCLUDE 'herwig65.inc'
48249 INTEGER HWUANT,IPART,IPDG,IANTI,OLDERR
48253 IF (IPDG.EQ. 9.OR.IPDG.EQ.21.OR.IPDG.EQ.22.OR.IPDG.EQ.23.OR.
48254 & IPDG.EQ.25.OR.IPDG.EQ.26.OR.IPDG.EQ.32.OR.IPDG.EQ.35.OR.
48255 & IPDG.EQ.36.OR.IPDG.EQ.39.OR.IPDG.EQ.91.OR.IPDG.EQ.98.OR.
48256 & IPDG.EQ.99.OR.IPDG.EQ.130.OR.IPDG.EQ.310.OR.
48257 & IPDG.EQ.1000021.OR.IPDG.EQ.1000022.OR.IPDG.EQ.1000023.OR.
48258 & IPDG.EQ.1000025.OR.IPDG.EQ.1000035.OR.IPDG.EQ.1000039.OR.
48259 & (FLOAT(INT(RSPIN(IPART))).EQ.RSPIN(IPART).AND.
48260 & MOD(IPDG/100,10).EQ.MOD(IPDG/10,10).AND.
48261 & MOD(IPDG/10,10).NE.0)) THEN
48262 C Self-conjugate boson
48264 ELSEIF(IPART.EQ.211.OR.IPART.EQ.212) THEN
48265 C Fourth generation (anti-)quarks
48267 ELSEIF(IPART.EQ.217.OR.IPART.EQ.218) THEN
48270 C Non-zero charge particle
48271 CALL HWUIDT(1,-IPDG,IANTI,CDUM)
48273 IF (IANTI.EQ.20) WRITE(6,10) RNAME(IPART)
48274 10 FORMAT(1X,A8,' has no antiparticle'/)
48279 *CMZ :- -07/07/99 17.42.00 by Kosuke Odagiri
48280 *-- Author : Kosuke Odagiri
48281 C-----------------------------------------------------------------------
48283 C-----------------------------------------------------------------------
48284 C Replaces all &'s in TXNAME by backslashes
48285 C-----------------------------------------------------------------------
48286 INCLUDE 'herwig65.inc'
48293 IF (TXNAME(1,I)(J:J).EQ.'&') TXNAME(1,I)(J:J)=Z
48298 *CMZ :- -26/04/91 10.18.58 by Bryan Webber
48299 *-- Author : Bryan Webber
48300 C-----------------------------------------------------------------------
48302 C-----------------------------------------------------------------------
48303 C PRINTS OUT DATA ON PARTON SHOWER
48304 C-----------------------------------------------------------------------
48305 INCLUDE 'herwig65.inc'
48308 WRITE(6,10) INHAD,XFACT
48309 10 FORMAT(///10X,'DATA ON LAST PARTON SHOWER: INHAD =',I3,
48310 & ' XFACT =',E11.3//' IPAR ID TM DA1 CMO AMO CDA',
48311 & ' ADA P-X P-Y P-Z ENERGY MASS',
48312 & ' V-X V-Y V-Z V-C*T')
48314 20 WRITE(6,30) J,RNAME(ABS(IDPAR(J))),TMPAR(J),JDAPAR(1,J),
48315 & (JCOPAR(I,J),I=1,4),(PPAR(I,J),I=1,5),(VPAR(I,J),I=1,4)
48316 30 FORMAT(I5,1X,A8,L2,5I4,F7.2,4F8.2,4E11.4)
48318 WRITE(6,40) INHAD,XFACT
48319 40 FORMAT(///10X,'DATA ON LAST PARTON SHOWER: INHAD =',I3,
48320 & ' XFACT =',E11.3//' IPAR ID TM DA1 CMO AMO CDA',
48321 & ' ADA P-X P-Y P-Z ENERGY MASS')
48323 50 WRITE(6,60) J,RNAME(ABS(IDPAR(J))),TMPAR(J),JDAPAR(1,J),
48324 & (JCOPAR(I,J),I=1,4),(PPAR(I,J),I=1,5)
48325 60 FORMAT(I5,1X,A8,L2,5I4,F7.2,4F8.2)
48329 *CMZ :- -18/10/93 10.21.56 by Mike Seymour
48330 *-- Author : Mike Seymour
48331 C-----------------------------------------------------------------------
48332 SUBROUTINE HWUBST(IOPT)
48333 C-----------------------------------------------------------------------
48334 C BOOST THE ENTIRE EVENT RECORD TO (IOPT=1) OR FROM (IOPT=0) ITS
48335 C CENTRE-OF-MASS FRAME, WITH INCOMING HADRONS ON Z-AXIS
48336 C-----------------------------------------------------------------------
48337 INCLUDE 'herwig65.inc'
48338 DOUBLE PRECISION PBOOST(5),RBOOST(3,3)
48339 INTEGER IOPT,IHEP,BOOSTD,IHAD
48340 SAVE BOOSTD,PBOOST,RBOOST
48342 IF (IERROR.NE.0) RETURN
48343 IF (IOPT.EQ.1) THEN
48344 C---FIND FIRST INCOMING HADRON
48346 IF (JDAHEP(1,IHAD).NE.0) IHAD=JDAHEP(1,IHAD)
48347 C---IF WE'RE ALREADY IN THE RIGHT FRAME, DON'T DO ANYTHING
48348 IF (PHEP(1,3)**2+PHEP(2,3)**2+PHEP(3,3)**2.EQ.ZERO .AND.
48349 & PHEP(1,IHAD)**2+PHEP(2,IHAD)**2.EQ.ZERO) RETURN
48350 C---FIND AND APPLY BOOST
48351 CALL HWVEQU(5,PHEP(1,3),PBOOST)
48353 CALL HWULOF(PBOOST,PHEP(1,IHEP),PHEP(1,IHEP))
48354 CALL HWULOF(PBOOST,VHEP(1,IHEP),VHEP(1,IHEP))
48356 CALL HWULOF(PBOOST,VTXPIP,VTXPIP)
48357 C---FIND AND APPLY ROTATION TO PUT IT ON Z-AXIS
48358 CALL HWUROT(PHEP(1,IHAD),ONE,ZERO,RBOOST)
48360 CALL HWUROF(RBOOST,PHEP(1,IHEP),PHEP(1,IHEP))
48361 CALL HWUROF(RBOOST,VHEP(1,IHEP),VHEP(1,IHEP))
48363 CALL HWUROF(RBOOST,VTXPIP,VTXPIP)
48364 C---ENSURE THAT WE ONLY EVER UNBOOST THE SAME EVENT THAT WE BOOSTED
48365 C (BEARING IN MIND THAT NWGTS IS UPDATED AFTER GENERATING THE WEIGHT)
48367 ELSEIF (IOPT.EQ.0) THEN
48368 IF (BOOSTD.NE.NWGTS) RETURN
48369 C---UNDO ROTATION AND BOOST
48371 CALL HWUROB(RBOOST,PHEP(1,IHEP),PHEP(1,IHEP))
48372 CALL HWULOB(PBOOST,PHEP(1,IHEP),PHEP(1,IHEP))
48373 CALL HWUROB(RBOOST,VHEP(1,IHEP),VHEP(1,IHEP))
48374 CALL HWULB4(PBOOST,VHEP(1,IHEP),VHEP(1,IHEP))
48379 *CMZ :- -23/08/94 13.22.29 by Mike Seymour
48380 *-- Author : Bryan Webber and Ian Knowles
48381 C-----------------------------------------------------------------------
48382 SUBROUTINE HWUCFF(I,J,QSQ,CLF)
48383 C-----------------------------------------------------------------------
48384 C Calculates basic coefficients in cross-section formula for
48385 C ffbar --> f'fbar', at virtuality QSQ, I labels initial, J
48386 C labels final fermion; type given as:
48387 C I,J= 1- 6: d,u,s,c,b,t
48388 C =11-16: e,nu_e,mu,nu_mu,tau,nu_tau
48389 C-----------------------------------------------------------------------
48390 INCLUDE 'herwig65.inc'
48391 DOUBLE PRECISION QSQ,CLF(7),POL1,POL2,QIF,VI,AI,VF,AF,PG,DQM,PMW,
48392 & DEN,XRE,XIM,XSQ,VI2,AI2,VF2,AF2,PG2,PG12,DQM2,PMW2,DEN2,XRE2,
48393 & XIM2,XSQ2,XRE12,XIM12
48395 C Longitudinal Polarisation factors
48396 POL1=1.-EPOLN(3)*PPOLN(3)
48397 POL2=PPOLN(3)-EPOLN(3)
48398 C Standard model couplings
48399 QIF=QFCH(I)*QFCH(J)
48404 PG=POL1*(VI**2+AI**2)+POL2*2.*VI*AI
48405 C Z propagator factors
48406 DQM=QSQ-RMASS(200)**2
48407 PMW=GAMZ*RMASS(200)
48408 DEN=QSQ/(DQM**2+PMW**2)
48412 C Calculate cross-section coefficients
48413 CLF(1)=POL1*QIF**2+XRE*2.*QIF*(POL1*VI+POL2*AI)*VF
48414 & +XSQ*PG*(VF**2+AF**2)
48415 CLF(2)=CLF(1)-2.*XSQ*PG*AF**2
48416 CLF(3)=2.*(XRE*QIF*(POL1*AI+POL2*VI)*AF
48417 & +XSQ*(POL1*2.*VI*AI+POL2*(VI**2+AI**2))*VF*AF)
48419 CLF(4)=QIF**2+XRE*2.*QIF*VI*VF+XSQ*(VI**2-AI**2)*(VF**2+AF**2)
48420 CLF(5)=CLF(4)-2.*XSQ*(VI**2-AI**2)*AF**2
48421 CLF(6)=XIM*2.*QIF*AI*VF
48430 PG2=POL1*(VI2**2+AI2**2)+POL2*2.*VI2*AI2
48431 PG12=POL1*(VI*VI2+AI*AI2)+POL2*(VI*AI2+AI+VI2)
48432 C Z' propagator factors
48433 DQM2=QSQ-RMASS(202)**2
48434 PMW2=RMASS(202)*GAMZP
48435 DEN2=QSQ/(DQM2**2+PMW2**2)
48439 XRE12=DEN*DEN2*(DQM*DQM2+PMW*PMW2)
48440 XIM12=DEN*DEN2*(DQM*PMW2-DQM2*PMW)
48441 C Additional contributions to cross-section coefficients
48442 CLF(1)=CLF(1)+XRE2*2.*QIF*(POL1*VI2+POL2*AI2)*VF2
48443 & +XSQ2*PG2*(VF2**2+AF2**2)+XRE12*2.*PG12*(VF*VF2+AF*AF2)
48444 CLF(2)=CLF(1)-2.*(XSQ2*PG2*AF2**2+XRE12*2.*PG12*AF*AF2)
48445 CLF(3)=CLF(3)+2.*(XRE2*QIF*(POL1*AI2+POL2*VI2)*AF2
48446 & +XSQ2*(POL1*2.*VI2*AI2+POL2*(VI2**2+AI2**2))*VF2*AF2
48447 & +XRE12*(POL1*(VI*AI2+AI*VI2)+POL1*(VI*VI2+AI*AI2))
48448 & *(VF*VF2+AF*AF2))
48450 CLF(4)=CLF(4)+XRE2*2.*QIF*VI2*VF2
48451 & +XSQ2*(VI2**2-AI2**2)*(VF2**2+AF2**2)
48452 & +XRE12*2.*(VI*VI2-AI*AI2)*(VF*VF2+AF*AF2)
48453 CLF(5)=CLF(4)-2*(XSQ2*(VI2**2-AI2**2)*AF2**2
48454 & +XRE12*2.*(VI*VI2-AI*AI2)*AF*AF2)
48455 CLF(6)=CLF(6)+2.*(XIM2*QIF*AI2*VF2
48456 & -XIM12*(VI*AI2-AI*VI2)*(VF*VF2+AF*AF2))
48457 CLF(7)=CLF(6)+4.*XIM12*(VI*AI2-AI*AI2)*AF*AF2
48462 *CMZ :- -23/08/94 13.22.29 by Mike Seymour
48463 *-- Author : Ulrich Baur & Nigel Glover, adapted by Ian Knowles
48464 C-----------------------------------------------------------------------
48465 FUNCTION HWUCI2(A,B,Y0)
48466 C-----------------------------------------------------------------------
48467 C Integral LOG(A-EPSI-BY(1-Y))/(Y-Y0)
48468 C-----------------------------------------------------------------------
48470 DOUBLE COMPLEX HWUCI2,HWULI2,EPSI,Y1,Y2,Z1,Z2,Z3,Z4
48471 DOUBLE PRECISION A,B,Y0,ZERO,ONE,FOUR,HALF
48474 PARAMETER (ZERO=0.D0, ONE =1.D0, FOUR= 4.D0, HALF=0.5D0)
48476 HWUCI2=DCMPLX(ZERO,ZERO)
48478 Y1=HALF*(ONE+SQRT(ONE-FOUR*(A+EPSI)/B))
48481 Z2=(Y0-ONE)/(Y0-Y1)
48483 Z4=(Y0-ONE)/(Y0-Y2)
48484 HWUCI2=HWULI2(Z1)-HWULI2(Z2)+HWULI2(Z3)-HWULI2(Z4)
48488 *CMZ :- -26/04/91 10.18.58 by Bryan Webber
48489 *-- Author : Ian Knowles & Bryan Webber
48490 C-----------------------------------------------------------------------
48492 C-----------------------------------------------------------------------
48493 C Loads common blocks with particle properties data; for particle I:
48495 C IDPDG(I) = PDG code
48496 C IFLAV(I) = HERWIG flavour code
48497 C ICHRG(I) = Electric charge (|e-|) (*3 for (di-)quarks)
48498 C RMASS(I) = Mass (GeV/c^2)
48499 C RLTIM(I) = Proper life time (s)
48501 C QORQQB(I) = .TRUE. if it is a quark or an antidiquark
48502 C QBORQQ(I) = .TRUE. if it is an antiquark or a diquark
48503 C And stores the particle decay tables: call HWUDPR to print them
48504 C-----------------------------------------------------------------------
48505 INCLUDE 'herwig65.inc'
48506 COMMON/HWSEED/ISEED(2)
48508 INTEGER NLAST,NNEXT,NLEFT,NREST,I,J,MMWIDE,MMLONG,MMHOFF,MMVOFF
48509 COMMON/PAPER/MMWIDE,MMLONG,MMHOFF,MMVOFF
48510 c PARAMETER (NLAST=458,NNEXT=458+1,NLEFT=NMXRES-458)
48511 c PARAMETER (NREST=NMXRES-120)
48513 PARAMETER (NLAST=458,NNEXT=NLAST+1,NLEFT=NMXRES-NLAST)
48514 PARAMETER (NREST=NMXRES-120)
48516 C Don't forget to change the three occurances above as well
48517 DATA MMWIDE,MMLONG,MMHOFF,MMVOFF/190,280,-39,-35/
48518 DATA ISEED/12345,67890/
48519 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
48520 & RSPIN(I),I=0,16)/
48521 & ' ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
48522 & 'DQRK ', 1, 0,-1,0.3200D0,0.000D+00,0.5D0,
48523 & 'UQRK ', 2, 0,+2,0.3200D0,0.000D+00,0.5D0,
48524 & 'SQRK ', 3, 0,-1,0.5000D0,0.000D+00,0.5D0,
48525 & 'CQRK ', 4, 0,+2,1.5500D0,0.000D+00,0.5D0,
48526 & 'BQRK ', 5, 0,-1,4.9500D0,0.000D+00,0.5D0,
48527 & 'TQRK ', 6, 0,+2,174.30D0,4.000D-25,0.5D0,
48528 & 'DBAR ', -1, 0,+1,0.3200D0,0.000D+00,0.5D0,
48529 & 'UBAR ', -2, 0,-2,0.3200D0,0.000D+00,0.5D0,
48530 & 'SBAR ', -3, 0,+1,0.5000D0,0.000D+00,0.5D0,
48531 & 'CBAR ', -4, 0,-2,1.5500D0,0.000D+00,0.5D0,
48532 & 'BBAR ', -5, 0,+1,4.9500D0,0.000D+00,0.5D0,
48533 & 'TBAR ', -6, 0,-2,174.30D0,4.000D-25,0.5D0,
48534 & 'GLUON ', 21, 0, 0,0.7500D0,0.000D+00,1.0D0,
48535 & 'CMF ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
48536 & 'HARD ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
48537 & 'SOFT ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0/
48538 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
48539 & RSPIN(I),I=17,32)/
48540 & 'CONE ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
48541 & 'HEAVY ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
48542 & 'CLUS ', 91, 0, 0,0.0000D0,0.000D+00,0.0D0,
48543 & '**** ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
48544 & 'PI0 ', 111, 11, 0,.13498D0,8.400D-17,0.0D0,
48545 & 'ETA ', 221, 33, 0,.54730D0,0.000D+00,0.0D0,
48546 & 'RHO0 ', 113, 11, 0,.77000D0,0.000D+00,1.0D0,
48547 & 'OMEGA ', 223, 33, 0,.78194D0,0.000D+00,1.0D0,
48548 & 'ETAP ', 331, 33, 0,.95778D0,0.000D+00,0.0D0,
48549 & 'F_2 ', 225, 33, 0,1.2750D0,0.000D+00,2.0D0,
48550 & 'A_10 ', 20113, 11, 0,1.2300D0,0.000D+00,1.0D0,
48551 & 'FL_1 ', 20223, 33, 0,1.2819D0,0.000D+00,1.0D0,
48552 & 'A_20 ', 115, 11, 0,1.3181D0,0.000D+00,2.0D0,
48553 & 'PI- ', -211, 12,-1,.13957D0,2.603D-08,0.0D0,
48554 & 'RHO- ', -213, 12,-1,.77000D0,0.000D+00,1.0D0,
48555 & 'A_1- ', -20213, 12,-1,1.2300D0,0.000D+00,1.0D0/
48556 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
48557 & RSPIN(I),I=33,48)/
48558 & 'A_2- ', -215, 12,-1,1.3181D0,0.000D+00,2.0D0,
48559 & 'K- ', -321, 32,-1,.49368D0,1.237D-08,0.0D0,
48560 & 'K*- ', -323, 32,-1,.89166D0,0.000D+00,1.0D0,
48561 & 'KH_1- ', -20323, 32,-1,1.8500D0,0.000D+00,1.0D0,
48562 & 'K*_2- ', -325, 32,-1,1.4256D0,0.000D+00,2.0D0,
48563 & 'PI+ ', 211, 21,+1,.13957D0,2.603D-08,0.0D0,
48564 & 'RHO+ ', 213, 21,+1,.77000D0,0.000D+00,1.0D0,
48565 & 'A_1+ ', 20213, 21,+1,1.2300D0,0.000D+00,1.0D0,
48566 & 'A_2+ ', 215, 21,+1,1.3181D0,0.000D+00,2.0D0,
48567 & 'KBAR0 ', -311, 31, 0,.49767D0,0.000D+00,0.0D0,
48568 & 'K*BAR0 ', -313, 31, 0,.89610D0,0.000D+00,1.0D0,
48569 & 'KH_1BAR0', -20313, 31, 0,1.8500D0,0.000D+00,1.0D0,
48570 & 'K*_2BAR0', -315, 31, 0,1.4324D0,0.000D+00,2.0D0,
48571 & 'K+ ', 321, 23,+1,.49368D0,1.237D-08,0.0D0,
48572 & 'K*+ ', 323, 23,+1,.89166D0,0.000D+00,1.0D0,
48573 & 'KH_1+ ', 20323, 23,+1,1.8500D0,0.000D+00,1.0D0/
48574 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
48575 & RSPIN(I),I=49,64)/
48576 & 'K*_2+ ', 325, 23,+1,1.4256D0,0.000D+00,2.0D0,
48577 & 'K0 ', 311, 13, 0,.49767D0,0.000D+00,0.0D0,
48578 & 'K*0 ', 313, 13, 0,.89610D0,0.000D+00,1.0D0,
48579 & 'KH_10 ', 20313, 13, 0,1.8500D0,0.000D+00,1.0D0,
48580 & 'K*_20 ', 315, 13, 0,1.4324D0,0.000D+00,2.0D0,
48581 & ' ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
48582 & ' ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
48583 & 'PHI ', 333, 33, 0,1.0194D0,0.000D+00,1.0D0,
48584 & 'FH_1 ', 20333, 33, 0,1.4262D0,0.000D+00,1.0D0,
48585 & 'FP_2 ', 335, 33, 0,1.5250D0,0.000D+00,2.0D0,
48586 & 'GAMMA ', 22, 0, 0,0.0000D0,1.000D+30,1.0D0,
48587 & 'K_S0 ', 310, 0, 0,.49767D0,8.926D-11,0.0D0,
48588 & 'K_L0 ', 130, 0, 0,.49767D0,5.170D-08,0.0D0,
48589 & 'A_0(H)0 ', 10111, 11, 0,1.4740D0,0.000D+00,0.0D0,
48590 & 'A_0(H)+ ', 10211, 21,+1,1.4740D0,0.000D+00,0.0D0,
48591 & 'A_0(H)- ', -10211, 12,-1,1.4740D0,0.000D+00,0.0D0/
48592 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
48593 & RSPIN(I),I=65,80)/
48594 & ' ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
48595 & ' ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
48596 & ' ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
48597 & ' ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
48598 & ' ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
48599 & ' ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
48600 & 'REMG ', 98, 0, 0,0.0000D0,0.000D+00,0.0D0,
48601 & 'REMN ', 99, 0, 0,0.0000D0,0.000D+00,0.0D0,
48602 & 'P ', 2212, 122,+1,.93827D0,1.000D+30,0.5D0,
48603 & 'DELTA+ ', 2214, 122,+1,1.2320D0,0.000D+00,1.5D0,
48604 & 'N ', 2112, 112, 0,.93957D0,8.870D+02,0.5D0,
48605 & 'DELTA0 ', 2114, 112, 0,1.2320D0,0.000D+00,1.5D0,
48606 & 'DELTA- ', 1114, 111,-1,1.2320D0,0.000D+00,1.5D0,
48607 & 'LAMBDA ', 3122, 123, 0,1.1157D0,2.632D-10,0.5D0,
48608 & 'SIGMA0 ', 3212, 123, 0,1.1926D0,7.400D-20,0.5D0,
48609 & 'SIGMA*0 ', 3214, 123, 0,1.3837D0,0.000D+00,1.5D0/
48610 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
48611 & RSPIN(I),I=81,96)/
48612 & 'SIGMA- ', 3112, 113,-1,1.1974D0,1.479D-10,0.5D0,
48613 & 'SIGMA*- ', 3114, 113,-1,1.3872D0,0.000D+00,1.5D0,
48614 & 'XI- ', 3312, 133,-1,1.3213D0,1.639D-10,0.5D0,
48615 & 'XI*- ', 3314, 133,-1,1.5350D0,0.000D+00,1.5D0,
48616 & 'DELTA++ ', 2224, 222,+2,1.2320D0,0.000D+00,1.5D0,
48617 & 'SIGMA+ ', 3222, 223,+1,1.1894D0,7.990D-11,0.5D0,
48618 & 'SIGMA*+ ', 3224, 223,+1,1.3828D0,0.000D+00,1.5D0,
48619 & 'XI0 ', 3322, 233, 0,1.3149D0,2.900D-10,0.5D0,
48620 & 'XI*0 ', 3324, 233, 0,1.5318D0,0.000D+00,1.5D0,
48621 & 'OMEGA- ', 3334, 333,-1,1.6725D0,8.220D-11,1.5D0,
48622 & 'PBAR ', -2212,-122,-1,.93827D0,1.000D+30,0.5D0,
48623 & 'DELTABR-', -2214,-122,-1,1.2320D0,0.000D+00,1.5D0,
48624 & 'NBAR ', -2112,-112, 0,.93957D0,8.870D+02,0.5D0,
48625 & 'DELTABR0', -2114,-112, 0,1.2320D0,0.000D+00,1.5D0,
48626 & 'DELTABR+', -1114,-111,+1,1.2320D0,0.000D+00,1.5D0,
48627 & 'LAMBDABR', -3122,-123, 0,1.1157D0,2.632D-10,0.5D0/
48628 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
48629 & RSPIN(I),I=97,112)/
48630 & 'SIGMABR0', -3212,-123, 0,1.1926D0,7.400D-20,0.5D0,
48631 & 'SGMA*BR0', -3214,-123, 0,1.3837D0,0.000D+00,1.5D0,
48632 & 'SIGMABR+', -3112,-113,+1,1.1974D0,1.479D-10,0.5D0,
48633 & 'SGMA*BR+', -3114,-113,+1,1.3872D0,0.000D+00,1.5D0,
48634 & 'XIBAR+ ', -3312,-133,+1,1.3213D0,1.639D-10,0.5D0,
48635 & 'XI*BAR+ ', -3314,-133,+1,1.5350D0,0.000D+00,1.5D0,
48636 & 'DLTABR--', -2224,-222,-2,1.2320D0,0.000D+00,1.5D0,
48637 & 'SIGMABR-', -3222,-223,-1,1.1894D0,7.990D-11,0.5D0,
48638 & 'SGMA*BR-', -3224,-223,-1,1.3828D0,0.000D+00,1.5D0,
48639 & 'XIBAR0 ', -3322,-233, 0,1.3149D0,2.900D-10,0.5D0,
48640 & 'XI*BAR ', -3324,-233, 0,1.5318D0,0.000D+00,1.5D0,
48641 & 'OMEGABR+', -3334,-333,+1,1.6725D0,8.220D-11,1.5D0,
48642 & 'UU ', 2203, 0,+4,0.6400D0,0.000D+00,0.0D0,
48643 & 'UD ', 2101, 0,+1,0.6400D0,0.000D+00,0.0D0,
48644 & 'DD ', 1103, 0,-2,0.6400D0,0.000D+00,0.0D0,
48645 & 'US ', 3201, 0,+1,0.8200D0,0.000D+00,0.0D0/
48646 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
48647 & RSPIN(I),I=113,128)/
48648 & 'DS ', 3101, 0,-2,0.8200D0,0.000D+00,0.0D0,
48649 & 'SS ', 3303, 0,-2,1.0000D0,0.000D+00,0.0D0,
48650 & 'UBARUBAR', -2203, 0,-4,0.6400D0,0.000D+00,0.0D0,
48651 & 'UBARDBAR', -2101, 0,-1,0.6400D0,0.000D+00,0.0D0,
48652 & 'DBARDBAR', -1103, 0,+2,0.6400D0,0.000D+00,0.0D0,
48653 & 'UBARSBAR', -3201, 0,-1,0.8200D0,0.000D+00,0.0D0,
48654 & 'DBARSBAR', -3101, 0,+2,0.8200D0,0.000D+00,0.0D0,
48655 & 'SBARSBAR', -3303, 0,+2,1.0000D0,0.000D+00,0.0D0,
48656 & 'E- ', 11, 0,-1,5.11D-04,1.000D+30,0.5D0,
48657 & 'NU_E ', 12, 0, 0,0.0000D0,1.000D+30,0.5D0,
48658 & 'MU- ', 13, 0,-1,.10566D0,2.197D-06,0.5D0,
48659 & 'NU_MU ', 14, 0, 0,0.0000D0,1.000D+30,0.5D0,
48660 & 'TAU- ', 15, 0,-1,1.7771D0,2.916D-13,0.5D0,
48661 & 'NU_TAU ', 16, 0, 0,0.0000D0,1.000D+30,0.5D0,
48662 & 'E+ ', -11, 0,+1,5.11D-04,1.000D+30,0.5D0,
48663 & 'NU_EBAR ', -12, 0, 0,0.0000D0,1.000D+30,0.5D0/
48664 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
48665 & RSPIN(I),I=129,144)/
48666 & 'MU+ ', -13, 0,+1,.10566D0,2.197D-06,0.5D0,
48667 & 'NU_MUBAR', -14, 0, 0,0.0000D0,1.000D+30,0.5D0,
48668 & 'TAU+ ', -15, 0,+1,1.7771D0,2.916D-13,0.5D0,
48669 & 'NU_TAUBR', -16, 0, 0,0.0000D0,1.000D+30,0.5D0,
48670 & ' ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
48671 & ' ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
48672 & ' ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
48673 & 'D+ ', 411, 41,+1,1.8693D0,1.057D-12,0.0D0,
48674 & 'D*+ ', 413, 41,+1,2.0100D0,0.000D+00,1.0D0,
48675 & 'DH_1+ ', 20413, 41,+1,2.4270D0,0.000D+00,1.0D0,
48676 & 'D*_2+ ', 415, 41,+1,2.4590D0,0.000D+00,2.0D0,
48677 & 'D0 ', 421, 42, 0,1.8646D0,4.150D-13,0.0D0,
48678 & 'D*0 ', 423, 42, 0,2.0067D0,0.000D+00,1.0D0,
48679 & 'DH_10 ', 20423, 42, 0,2.4222D0,0.000D+00,1.0D0,
48680 & 'D*_20 ', 425, 42, 0,2.4589D0,0.000D+00,2.0D0,
48681 & 'D_S+ ', 431, 43,+1,1.9685D0,4.670D-13,0.0D0/
48682 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
48683 & RSPIN(I),I=145,160)/
48684 & 'D*_S+ ', 433, 43,+1,2.1124D0,0.000D+00,1.0D0,
48685 & 'DH_S1+ ', 20433, 43,+1,2.5354D0,0.000D+00,1.0D0,
48686 & 'D*_S2+ ', 435, 43,+1,2.5735D0,0.000D+00,2.0D0,
48687 & 'SGMA_C++', 4222, 224,+2,2.4528D0,0.000D+00,0.5D0,
48688 & 'SGM*_C++', 4224, 224,+2,2.5194D0,0.000D+00,1.5D0,
48689 & 'LMBDA_C+', 4122, 124,+1,2.2849D0,2.060D-13,0.5D0,
48690 & 'SIGMA_C+', 4212, 124,+1,2.4536D0,0.000D+00,0.5D0,
48691 & 'SGMA*_C+', 4214, 124,+1,2.5185D0,0.000D+00,1.5D0,
48692 & 'SIGMA_C0', 4112, 114, 0,2.4522D0,0.000D+00,0.5D0,
48693 & 'SGMA*_C0', 4114, 114, 0,2.5175D0,0.000D+00,1.5D0,
48694 & 'XI_C+ ', 4232, 234,+1,2.4656D0,3.500D-13,0.5D0,
48695 & 'XIP_C+ ', 4322, 234,+1,2.5750D0,0.000D+00,0.5D0,
48696 & 'XI*_C+ ', 4324, 234,+1,2.6446D0,0.000D+00,1.5D0,
48697 & 'XI_C0 ', 4132, 134, 0,2.4703D0,9.800D-14,0.5D0,
48698 & 'XIP_C0 ', 4312, 134, 0,2.5800D0,0.000D+00,0.5D0,
48699 & 'XI*_C0 ', 4314, 134, 0,2.6438D0,0.000D+00,1.5D0/
48700 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
48701 & RSPIN(I),I=161,176)/
48702 & 'OMEGA_C0', 4332, 334, 0,2.7040D0,6.400D-14,0.5D0,
48703 & 'OMGA*_C0', 4334, 334, 0,2.7300D0,0.000D+00,1.5D0,
48704 & 'ETA_C ', 441, 44, 0,2.9798D0,0.000D+00,0.0D0,
48705 & 'JPSI ', 443, 44, 0,3.0969D0,0.000D+00,1.0D0,
48706 & 'CHI_C1 ', 10441, 44, 0,3.4173D0,0.000D+00,0.0D0,
48707 & 'PSI2S ', 100443, 44, 0,3.6860D0,0.000D+00,1.0D0,
48708 & 'PSID ', 30443, 44, 0,3.7699D0,0.000D+00,1.0D0,
48709 & ' ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
48710 & ' ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
48711 & ' ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
48712 & 'D- ', -411, 14,-1,1.8693D0,1.057D-12,0.0D0,
48713 & 'D*- ', -413, 14,-1,2.0100D0,0.000D+00,1.0D0,
48714 & 'DH_1- ', -20413, 14,-1,2.4270D0,0.000D+00,1.0D0,
48715 & 'D*_2- ', -415, 14,-1,2.4590D0,0.000D+00,2.0D0,
48716 & 'DBAR0 ', -421, 24, 0,1.8646D0,4.140D-13,0.0D0,
48717 & 'D*BAR0 ', -423, 24, 0,2.0067D0,0.000D+00,1.0D0/
48718 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
48719 & RSPIN(I),I=177,192)/
48720 & 'DH_1BAR0', -20423, 24, 0,2.4222D0,0.000D+00,1.0D0,
48721 & 'D*_2BAR0', -425, 24, 0,2.4589D0,0.000D+00,2.0D0,
48722 & 'D_S- ', -431, 34,-1,1.9685D0,4.670D-13,0.0D0,
48723 & 'D*_S- ', -433, 34,-1,2.1124D0,0.000D+00,1.0D0,
48724 & 'DH_S1- ', -20433, 34,-1,2.5354D0,0.000D+00,1.0D0,
48725 & 'D*_S2- ', -435, 34,-1,2.5735D0,0.000D+00,2.0D0,
48726 & 'SGMA_C--', -4222,-224,-2,2.4528D0,0.000D+00,0.5D0,
48727 & 'SGM*_C--', -4224,-224,-2,2.5194D0,0.000D+00,1.5D0,
48728 & 'LMBDA_C-', -4122,-124,-1,2.2849D0,2.060D-13,0.5D0,
48729 & 'SIGMA_C-', -4212,-124,-1,2.4536D0,0.000D+00,0.5D0,
48730 & 'SGMA*_C-', -4214,-124,-1,2.5185D0,0.000D+00,1.5D0,
48731 & 'SGM_CBR0', -4112,-114, 0,2.4522D0,0.000D+00,0.5D0,
48732 & 'SG*_CBR0', -4114,-114, 0,2.5175D0,0.000D+00,1.5D0,
48733 & 'XI_C- ', -4232,-234,-1,2.4656D0,3.500D-13,0.5D0,
48734 & 'XIP_C- ', -4322,-234,-1,2.5750D0,0.000D+00,0.5D0,
48735 & 'XI*_C- ', -4324,-234,-1,2.6446D0,0.000D+00,1.5D0/
48736 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
48737 & RSPIN(I),I=193,208)/
48738 & 'XI_CBAR0', -4132,-134, 0,2.4703D0,9.800D-14,0.5D0,
48739 & 'XIP_CBR0', -4312,-134, 0,2.5800D0,0.000D+00,0.5D0,
48740 & 'XI*_CBR0', -4314,-134, 0,2.6438D0,0.000D+00,1.5D0,
48741 & 'OMG_CBR0', -4332,-334, 0,2.7040D0,6.400D-14,0.5D0,
48742 & 'OM*_CBR0', -4334,-334, 0,2.7300D0,0.000D+00,1.5D0,
48743 & 'W+ ', 24, 0,+1,80.420D0,0.000D+00,1.0D0,
48744 & 'W- ', -24, 0,-1,80.420D0,0.000D+00,1.0D0,
48745 & 'Z0/GAMA*', 23, 0, 0,91.188D0,0.000D+00,1.0D0,
48746 & 'HIGGS ', 25, 0, 0,115.00D0,0.000D+00,0.0D0,
48747 & 'Z0P ', 32, 0, 0,500.00D0,0.000D+00,1.0D0,
48748 & 'HIGGSL0 ', 26, 0, 0,0.0000D0,1.000D+30,0.0D0,
48749 & 'HIGGSH0 ', 35, 0, 0,0.0000D0,1.000D+30,0.0D0,
48750 & 'HIGGSA0 ', 36, 0, 0,0.0000D0,1.000D+30,0.0D0,
48751 & 'HIGGS+ ', 37, 0,+1,0.0000D0,1.000D+30,0.0D0,
48752 & 'HIGGS- ', -37, 0,-1,0.0000D0,1.000D+30,0.0D0,
48753 & 'GRAVITON', 39, 0, 0,0.0000D0,1.000D+30,2.0D0/
48754 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
48755 & RSPIN(I),I=209,224)/
48756 & 'VQRK ', 7, 0,-1,200.00D0,0.000D+00,0.5D0,
48757 & 'AQRK ', 8, 0,+2,400.00D0,0.000D+00,0.5D0,
48758 & 'HQRK ', 7, 0,-1,400.00D0,0.000D+00,0.5D0,
48759 & 'HPQK ', 8, 0,+2,600.00D0,0.000D+00,0.5D0,
48760 & ' ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
48761 & ' ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
48762 & 'VBAR ', -7, 0,+1,200.00D0,0.000D+00,0.5D0,
48763 & 'ABAR ', -8, 0,-2,400.00D0,0.000D+00,0.5D0,
48764 & 'HBAR ', -7, 0,+1,400.00D0,0.000D+00,0.5D0,
48765 & 'HPBR ', -8, 0,-2,600.00D0,0.000D+00,0.5D0,
48766 & ' ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
48767 & ' ', 0, 0, 0,0.0000D0,0.000D+00,0.0D0,
48768 & 'B_DBAR0 ', -511, 51, 0,5.2792D0,1.614D-12,0.0D0,
48769 & 'B- ', -521, 52,-1,5.2789D0,1.652D-12,0.0D0,
48770 & 'B_SBAR0 ', -531, 53, 0,5.3693D0,1.540D-12,0.0D0,
48771 & 'SIGMA_B+', 5222, 225,+1,5.8200D0,1.070D-12,0.5D0/
48772 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
48773 & RSPIN(I),I=225,240)/
48774 & 'LMBDA_B0', 5122, 125, 0,5.6240D0,1.070D-12,0.5D0,
48775 & 'SIGMA_B-', 5112, 115,-1,5.8200D0,1.070D-12,0.5D0,
48776 & 'XI_B0 ', 5232, 235, 0,5.8000D0,1.070D-12,0.5D0,
48777 & 'XI_B- ', 5132, 135,-1,5.8000D0,1.070D-12,0.5D0,
48778 & 'OMEGA_B-', 5332, 335,-1,6.0400D0,1.070D-12,0.5D0,
48779 & 'B_C- ', -541, 54,-1,6.2500D0,1.000D-12,0.5D0,
48780 & 'UPSLON1S', 553, 55, 0,9.4604D0,0.000D+00,1.0D0,
48781 & 'T_B- ', -651, 56,-1,0.0000D0,0.000D+00,0.0D0,
48782 & 'T+ ', 611, 61,+1,0.0000D0,0.000D+00,0.0D0,
48783 & 'T0 ', 621, 62, 0,0.0000D0,0.000D+00,0.0D0,
48784 & 'T_S+ ', 631, 63,+1,0.0000D0,0.000D+00,0.0D0,
48785 & 'SGMA_T++', 6222, 226,+2,0.0000D0,0.000D+00,0.5D0,
48786 & 'LMBDA_T0', 6122, 126,+1,0.0000D0,0.000D+00,0.5D0,
48787 & 'SIGMA_T0', 6112, 116, 0,0.0000D0,0.000D+00,0.5D0,
48788 & 'XI_T+ ', 6232, 236,+1,0.0000D0,0.000D+00,0.5D0,
48789 & 'XI_T0 ', 6132, 136, 0,0.0000D0,0.000D+00,0.5D0/
48790 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
48791 & RSPIN(I),I=241,256)/
48792 & 'OMEGA_T0', 6332, 336, 0,0.0000D0,0.000D+00,0.5D0,
48793 & 'T_C0 ', 641, 64, 0,0.0000D0,0.000D+00,0.0D0,
48794 & 'T_B+ ', 651, 65,+1,0.0000D0,0.000D+00,0.0D0,
48795 & 'TOPONIUM', 663, 66, 0,0.0000D0,0.000D+00,1.0D0,
48796 & 'B_D0 ', 511, 15, 0,5.2792D0,1.614D-12,0.0D0,
48797 & 'B+ ', 521, 25,+1,5.2789D0,1.652D-12,0.0D0,
48798 & 'B_S0 ', 531, 35, 0,5.3693D0,1.540D-12,0.0D0,
48799 & 'SGM_BBR-', -5222,-225,-1,5.8200D0,1.070D-12,0.5D0,
48800 & 'LMD_BBR0', -5122,-125, 0,5.6240D0,1.070D-12,0.5D0,
48801 & 'SGM_BBR+', -5112,-115,+1,5.8200D0,1.070D-12,0.5D0,
48802 & 'XI_BBAR0', -5232,-235, 0,5.8000D0,1.070D-12,0.5D0,
48803 & 'XI_B+ ', -5132,-135,+1,5.8000D0,1.070D-12,0.5D0,
48804 & 'OMG_BBR+', -5332,-335,+1,6.0400D0,1.070D-12,0.5D0,
48805 & 'B_C+ ', 541, 45,+1,6.2500D0,1.000D-12,0.5D0,
48806 & 'T- ', -611, 16,-1,0.0000D0,0.000D+00,0.0D0,
48807 & 'TBAR0 ', -621, 26, 0,0.0000D0,0.000D+00,0.0D0/
48808 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
48809 & RSPIN(I),I=257,272)/
48810 & 'T_S- ', -631, 36,-1,0.0000D0,0.000D+00,0.0D0,
48811 & 'SGMA_T--', -6222,-226,-2,0.0000D0,0.000D+00,0.5D0,
48812 & 'LAMDA_T-', -6122,-126,-1,0.0000D0,0.000D+00,0.5D0,
48813 & 'SGM_TBR0', -6112,-116, 0,0.0000D0,0.000D+00,0.5D0,
48814 & 'XI_T- ', -6232,-236,-1,0.0000D0,0.000D+00,0.5D0,
48815 & 'XI_TBAR0', -6132,-136, 0,0.0000D0,0.000D+00,0.5D0,
48816 & 'OMG_TBR0', -6332,-336, 0,0.0000D0,0.000D+00,0.5D0,
48817 & 'T_CBAR0 ', -641, 46, 0,0.0000D0,0.000D+00,0.0D0,
48818 & 'B*BAR0 ', -513, 51, 0,5.3249D0,0.000D+00,1.0D0,
48819 & 'B*- ', -523, 52,-1,5.3249D0,0.000D+00,1.0D0,
48820 & 'B*_SBAR0', -533, 53, 0,5.4163D0,0.000D+00,1.0D0,
48821 & 'BH_1BAR0', -20513, 51, 0,5.7600D0,0.000D+00,1.0D0,
48822 & 'BH_1- ', -20523, 52,-1,5.7600D0,0.000D+00,1.0D0,
48823 & 'BH_S1BR0', -20533, 53, 0,5.8550D0,0.000D+00,1.0D0,
48824 & 'B*_2BAR0', -515, 51, 0,5.7700D0,0.000D+00,2.0D0,
48825 & 'B*_2- ', -525, 52,-1,5.7700D0,0.000D+00,2.0D0/
48826 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
48827 & RSPIN(I),I=273,288)/
48828 & 'B*_S2BR0', -535, 53, 0,5.8650D0,0.000D+00,2.0D0,
48829 & 'B*0 ', 513, 15, 0,5.3249D0,0.000D+00,1.0D0,
48830 & 'B*+ ', 523, 25,+1,5.3249D0,0.000D+00,1.0D0,
48831 & 'B*_S0 ', 533, 35, 0,5.4163D0,0.000D+00,1.0D0,
48832 & 'BH_10 ', 20513, 15, 0,5.7600D0,0.000D+00,1.0D0,
48833 & 'BH_1+ ', 20523, 25,+1,5.7600D0,0.000D+00,1.0D0,
48834 & 'BH_S10 ', 20533, 35, 0,5.8550D0,0.000D+00,1.0D0,
48835 & 'B*_20 ', 515, 15, 0,5.7700D0,0.000D+00,2.0D0,
48836 & 'B*_2+ ', 525, 25,+1,5.7700D0,0.000D+00,2.0D0,
48837 & 'B*_S20 ', 535, 35, 0,5.8650D0,0.000D+00,2.0D0,
48838 & ' ', 0, 0, 0,0.0000D0,0.000D+00, 0D0,
48839 & ' ', 0, 0, 0,0.0000D0,0.000D+00, 0D0,
48840 & 'B_10 ', 10113, 11, 0,1.2295D0,0.000D+00,1.0D0,
48841 & 'B_1+ ', 10213, 21,+1,1.2295D0,0.000D+00,1.0D0,
48842 & 'B_1- ', -10213, 12,-1,1.2295D0,0.000D+00,1.0D0,
48843 & 'HL_10 ', 10223, 33, 0,1.1700D0,0.000D+00,1.0D0/
48844 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
48845 & RSPIN(I),I=289,304)/
48846 & 'HH_10 ', 10333, 33, 0,1.3950D0,0.000D+00,1.0D0,
48847 & 'A_00 ', 9000111, 11, 0,.99600D0,0.000D+00,0.0D0,
48848 & 'A_0+ ', 9000211, 21,+1,.99600D0,0.000D+00,0.0D0,
48849 & 'A_0- ',-9000211, 12,-1,.99600D0,0.000D+00,0.0D0,
48850 & 'F0P0 ', 9010221, 33, 0,.99600D0,0.000D+00,0.0D0,
48851 & 'FH_00 ', 10221, 33, 0,1.3500D0,0.000D+00,0.0D0,
48852 & 'B*_C+ ', 543, 45,+1,6.2950D0,0.000D+00,1.0D0,
48853 & 'B*_C- ', -543, 54,-1,6.2950D0,0.000D+00,1.0D0,
48854 & 'BH_C1+ ', 20543, 45,+1,6.7300D0,0.000D+00,1.0D0,
48855 & 'BH_C1- ', -20543, 54,-1,6.7300D0,0.000D+00,1.0D0,
48856 & 'B*_C2+ ', 545, 45,+1,6.7400D0,0.000D+00,2.0D0,
48857 & 'B*_C2- ', -545, 54,-1,6.7400D0,0.000D+00,2.0D0,
48858 & 'H_C ', 10443, 44, 0,3.5261D0,0.000D+00,1.0D0,
48859 & 'CHI_C0 ', 20443, 44, 0,3.5105D0,0.000D+00,0.0D0,
48860 & 'CHI_C2 ', 445, 44, 0,3.5562D0,0.000D+00,2.0D0,
48861 & 'ETA_B ', 551, 55, 0,9.0000D0,0.000D+00,0.0D0/
48862 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
48863 & RSPIN(I),I=305,320)/
48864 & 'H_B ', 10553, 55, 0,9.8880D0,0.000D+00,1.0D0,
48865 & 'CHI_B0 ', 10551, 55, 0,9.8598D0,0.000D+00,0.0D0,
48866 & 'CHI_B1 ', 20553, 55, 0,9.8919D0,0.000D+00,1.0D0,
48867 & 'CHI_B2 ', 555, 55, 0,9.9132D0,0.000D+00,2.0D0,
48868 & 'KL_10 ', 10313, 13, 0,1.5700D0,0.000D+00,1.0D0,
48869 & 'KL_1+ ', 10323, 23,+1,1.5700D0,0.000D+00,1.0D0,
48870 & 'KL_1BAR0', -10313, 31, 0,1.5700D0,0.000D+00,1.0D0,
48871 & 'KL_1- ', -10323, 32,-1,1.5700D0,0.000D+00,1.0D0,
48872 & 'DL_1+ ', 10413, 41,+1,2.4270D0,0.000D+00,1.0D0,
48873 & 'DL_10 ', 10423, 42, 0,2.4222D0,0.000D+00,1.0D0,
48874 & 'DL_S1+ ', 10433, 43,+1,2.5354D0,0.000D+00,1.0D0,
48875 & 'DL_1- ', -10413, 14,-1,2.4270D0,0.000D+00,1.0D0,
48876 & 'DL_1BAR0', -10423, 24, 0,2.4222D0,0.000D+00,1.0D0,
48877 & 'DL_S1- ', -10433, 34,-1,2.5354D0,0.000D+00,1.0D0,
48878 & 'BL_10 ', 10513, 15, 0,5.7600D0,0.000D+00,1.0D0,
48879 & 'BL_1+ ', 10523, 25,+1,5.7600D0,0.000D+00,1.0D0/
48880 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
48881 & RSPIN(I),I=321,336)/
48882 & 'BL_S10 ', 10533, 35, 0,5.8530D0,0.000D+00,1.0D0,
48883 & 'BL_C1+ ', 10543, 45,+1,6.7300D0,0.000D+00,1.0D0,
48884 & 'BL_1BAR0', -10513, 51, 0,5.7600D0,0.000D+00,1.0D0,
48885 & 'BL_1- ', -10523, 52,-1,5.7600D0,0.000D+00,1.0D0,
48886 & 'BL_S1BR0', -10533, 53, 0,5.8530D0,0.000D+00,1.0D0,
48887 & 'BL_C1- ', -10543, 54,-1,6.7300D0,0.000D+00,1.0D0,
48888 & 'K*_0+ ', 10321, 23,+1,1.4290D0,0.000D+00,0.0D0,
48889 & 'K*_00 ', 10311, 13, 0,1.4290D0,0.000D+00,0.0D0,
48890 & 'K*_0BAR0', -10311, 31, 0,1.4290D0,0.000D+00,0.0D0,
48891 & 'K*_0- ', -10321, 32,-1,1.4290D0,0.000D+00,0.0D0,
48892 & 'D*_0+ ', 10411, 41,+1,2.4230D0,0.000D+00,0.0D0,
48893 & 'D*_00 ', 10421, 42, 0,2.4230D0,0.000D+00,0.0D0,
48894 & 'D*_S0+ ', 10431, 43,+1,2.5250D0,0.000D+00,0.0D0,
48895 & 'D*_0- ', -10411, 14,-1,2.4230D0,0.000D+00,0.0D0,
48896 & 'D*_0BAR0', -10421, 24, 0,2.4230D0,0.000D+00,0.0D0,
48897 & 'D*_S0- ', -10431, 34,-1,2.5250D0,0.000D+00,0.0D0/
48898 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
48899 & RSPIN(I),I=337,352)/
48900 & 'B*_00 ', 10511, 15, 0,5.7600D0,0.000D+00,0.0D0,
48901 & 'B*_0+ ', 10521, 25,+1,5.7600D0,0.000D+00,0.0D0,
48902 & 'B*_S00 ', 10531, 35, 0,5.8550D0,0.000D+00,0.0D0,
48903 & 'B*_C0+ ', 10541, 45,+1,6.7300D0,0.000D+00,0.0D0,
48904 & 'B*_0BAR0', -10511, 51, 0,5.7600D0,0.000D+00,0.0D0,
48905 & 'B*_0- ', -10521, 52,-1,5.7600D0,0.000D+00,0.0D0,
48906 & 'B*_S0BR0', -10531, 53, 0,5.8550D0,0.000D+00,0.0D0,
48907 & 'B*_C0- ', -10541, 54,-1,6.7300D0,0.000D+00,0.0D0,
48908 & 'SGMA*_B-', 5114, 115,-1,5.8400D0,0.000D+00,1.5D0,
48909 & 'SIGMA_B0', 5212, 125, 0,5.8200D0,0.000D+00,0.5D0,
48910 & 'SGMA*_B0', 5214, 125, 0,5.8400D0,0.000D+00,1.5D0,
48911 & 'SGMA*_B+', 5224, 225,+1,5.8400D0,0.000D+00,1.5D0,
48912 & 'XIP_B0 ', 5322, 235, 0,5.9450D0,0.000D+00,0.5D0,
48913 & 'XI*_B0 ', 5324, 235, 0,5.9450D0,0.000D+00,1.5D0,
48914 & 'XIP_B- ', 5312, 135,-1,5.9450D0,0.000D+00,0.5D0,
48915 & 'XI*_B- ', 5314, 135,-1,5.9450D0,0.000D+00,1.5D0/
48916 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
48917 & RSPIN(I),I=353,368)/
48918 & '0MGA*_B-', 5334, 335,-1,6.0600D0,0.000D+00,1.5D0,
48919 & 'SG*_BBR+', -5114,-115,+1,5.8400D0,0.000D+00,1.5D0,
48920 & 'SGM_BBR0', -5212,-125, 0,5.8200D0,0.000D+00,0.5D0,
48921 & 'SG*_BBR0', -5214,-125, 0,5.8400D0,0.000D+00,1.5D0,
48922 & 'SG*_BBR-', -5224,-225,-1,5.8400D0,0.000D+00,1.5D0,
48923 & 'XIP_BBR0', -5322,-235, 0,5.9450D0,0.000D+00,0.5D0,
48924 & 'XI*_BBR0', -5324,-235, 0,5.9450D0,0.000D+00,1.5D0,
48925 & 'XIP_B+ ', -5312,-135,+1,5.9450D0,0.000D+00,0.5D0,
48926 & 'XI*_B+ ', -5314,-135,+1,5.9450D0,0.000D+00,1.5D0,
48927 & '0MGA*_B+', -5334,-335,+1,6.0600D0,0.000D+00,1.5D0,
48928 & 'KDL_2+ ', 10325, 23,+1,1.7730D0,0.000D+00,2.0D0,
48929 & 'KDL_20 ', 10315, 13, 0,1.7730D0,0.000D+00,2.0D0,
48930 & 'KDL_2BR0', -10315, 31, 0,1.7730D0,0.000D+00,2.0D0,
48931 & 'KDL_2- ', -10325, 32,-1,1.7730D0,0.000D+00,2.0D0,
48932 & 'KD*+ ', 30323, 23,+1,1.7170D0,0.000D+00,1.0D0,
48933 & 'KD*0 ', 30313, 13, 0,1.7170D0,0.000D+00,1.0D0/
48934 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
48935 & RSPIN(I),I=369,384)/
48936 & 'KD*BAR0 ', -30313, 31, 0,1.7170D0,0.000D+00,1.0D0,
48937 & 'KD*- ', -30323, 32,-1,1.7170D0,0.000D+00,1.0D0,
48938 & 'KDH_2+ ', 20325, 23,+1,1.8160D0,0.000D+00,2.0D0,
48939 & 'KDH_20 ', 20315, 13, 0,1.8160D0,0.000D+00,2.0D0,
48940 & 'KDH_2BR0', -20315, 31, 0,1.8160D0,0.000D+00,2.0D0,
48941 & 'KDH_2- ', -20325, 32,-1,1.8160D0,0.000D+00,2.0D0,
48942 & 'KD_3+ ', 327, 23,+1,1.7730D0,0.000D+00,3.0D0,
48943 & 'KD_30 ', 317, 13, 0,1.7730D0,0.000D+00,3.0D0,
48944 & 'KD_3BAR0', -317, 31, 0,1.7730D0,0.000D+00,3.0D0,
48945 & 'KD_3- ', -327, 32,-1,1.7730D0,0.000D+00,3.0D0,
48946 & 'PI_2+ ', 10215, 21,+1,1.6700D0,0.000D+00,2.0D0,
48947 & 'PI_20 ', 10115, 11, 0,1.6700D0,0.000D+00,2.0D0,
48948 & 'PI_2- ', -10215, 12,-1,1.6700D0,0.000D+00,2.0D0,
48949 & 'RHOD+ ', 30213, 21,+1,1.7000D0,0.000D+00,1.0D0,
48950 & 'RHOD0 ', 30113, 11, 0,1.7000D0,0.000D+00,1.0D0,
48951 & 'RHOD- ', -30213, 12,-1,1.7000D0,0.000D+00,1.0D0/
48952 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
48953 & RSPIN(I),I=385,400)/
48954 & 'RHO_3+ ', 217, 21,+1,1.6910D0,0.000D+00,3.0D0,
48955 & 'RHO_30 ', 117, 11, 0,1.6910D0,0.000D+00,3.0D0,
48956 & 'RHO_3- ', -217, 12,-1,1.6910D0,0.000D+00,3.0D0,
48957 & 'UPSLON2S', 100553, 55, 0,10.023D0,0.000D+00,1.0D0,
48958 & 'CHI2P_B0', 110551, 55, 0,10.232D0,0.000D+00,0.0D0,
48959 & 'CHI2P_B1', 120553, 55, 0,10.255D0,0.000D+00,1.0D0,
48960 & 'CHI2P_B2', 100555, 55, 0,10.269D0,0.000D+00,2.0D0,
48961 & 'UPSLON3S', 200553, 55, 0,10.355D0,0.000D+00,1.0D0,
48962 & 'UPSLON4S', 300553, 55, 0,10.580D0,0.000D+00,1.0D0,
48963 & ' ', 0, 0, 0,0.0 D0, 0.0D+00, 0D0,
48964 & 'OMEGA_3 ', 227, 33, 0,1.6670D0,0.000D+00,3.0D0,
48965 & 'PHI_3 ', 337, 33, 0,1.8540D0,0.000D+00,3.0D0,
48966 & 'ETA_2(L)', 10225, 33, 0,1.6320D0,0.000D+00,2.0D0,
48967 & 'ETA_2(H)', 10335, 33, 0,1.8540D0,0.000D+00,2.0D0,
48968 & 'OMEGA(H)', 30223, 33, 0,1.6490D0,0.000D+00,1.0D0,
48969 & ' ', 0, 0, 0,0.0 D0,0.0D+00 , 0D0/
48970 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
48971 & RSPIN(I),I=401,416)/
48972 & 'SSDL ', 1000001, 0,-1,0.00D0,1.000D+30,0.0D0,
48973 & 'SSUL ', 1000002, 0,+2,0.00D0,1.000D+30,0.0D0,
48974 & 'SSSL ', 1000003, 0,-1,0.00D0,1.000D+30,0.0D0,
48975 & 'SSCL ', 1000004, 0,+2,0.00D0,1.000D+30,0.0D0,
48976 & 'SSB1 ', 1000005, 0,-1,0.00D0,1.000D+30,0.0D0,
48977 & 'SST1 ', 1000006, 0,+2,0.00D0,1.000D+30,0.0D0,
48978 & 'SSDLBR ',-1000001, 0,+1,0.00D0,1.000D+30,0.0D0,
48979 & 'SSULBR ',-1000002, 0,-2,0.00D0,1.000D+30,0.0D0,
48980 & 'SSSLBR ',-1000003, 0,+1,0.00D0,1.000D+30,0.0D0,
48981 & 'SSCLBR ',-1000004, 0,-2,0.00D0,1.000D+30,0.0D0,
48982 & 'SSB1BR ',-1000005, 0,+1,0.00D0,1.000D+30,0.0D0,
48983 & 'SST1BR ',-1000006, 0,-2,0.00D0,1.000D+30,0.0D0,
48984 & 'SSDR ', 2000001, 0,-1,0.00D0,1.000D+30,0.0D0,
48985 & 'SSUR ', 2000002, 0,+2,0.00D0,1.000D+30,0.0D0,
48986 & 'SSSR ', 2000003, 0,-1,0.00D0,1.000D+30,0.0D0,
48987 & 'SSCR ', 2000004, 0,+2,0.00D0,1.000D+30,0.0D0/
48988 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
48989 & RSPIN(I),I=417,432)/
48990 & 'SSB2 ', 2000005, 0,-1,0.00D0,1.000D+30,0.0D0,
48991 & 'SST2 ', 2000006, 0,+2,0.00D0,1.000D+30,0.0D0,
48992 & 'SSDRBR ',-2000001, 0,+1,0.00D0,1.000D+30,0.0D0,
48993 & 'SSURBR ',-2000002, 0,-2,0.00D0,1.000D+30,0.0D0,
48994 & 'SSSRBR ',-2000003, 0,+1,0.00D0,1.000D+30,0.0D0,
48995 & 'SSCRBR ',-2000004, 0,-2,0.00D0,1.000D+30,0.0D0,
48996 & 'SSB2BR ',-2000005, 0,+1,0.00D0,1.000D+30,0.0D0,
48997 & 'SST2BR ',-2000006, 0,-2,0.00D0,1.000D+30,0.0D0,
48998 & 'SSEL- ', 1000011, 0,-1,0.00D0,1.000D+30,0.0D0,
48999 & 'SSNUEL ', 1000012, 0, 0,0.00D0,1.000D+30,0.0D0,
49000 & 'SSMUL- ', 1000013, 0,-1,0.00D0,1.000D+30,0.0D0,
49001 & 'SSNUMUL ', 1000014, 0, 0,0.00D0,1.000D+30,0.0D0,
49002 & 'SSTAU1- ', 1000015, 0,-1,0.00D0,1.000D+30,0.0D0,
49003 & 'SSNUTL ', 1000016, 0, 0,0.00D0,1.000D+30,0.0D0,
49004 & 'SSEL+ ',-1000011, 0,+1,0.00D0,1.000D+30,0.0D0,
49005 & 'SSNUELBR',-1000012, 0, 0,0.00D0,1.000D+30,0.0D0/
49006 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
49007 & RSPIN(I),I=433,448)/
49008 & 'SSMUL+ ',-1000013, 0,+1,0.00D0,1.000D+30,0.0D0,
49009 & 'SSNUMLBR',-1000014, 0, 0,0.00D0,1.000D+30,0.0D0,
49010 & 'SSTAU1+ ',-1000015, 0,+1,0.00D0,1.000D+30,0.0D0,
49011 & 'SSNUTLBR',-1000016, 0, 0,0.00D0,1.000D+30,0.0D0,
49012 & 'SSER- ', 2000011, 0,-1,0.00D0,1.000D+30,0.0D0,
49013 & 'SSNUER ', 2000012, 0, 0,0.00D0,1.000D+30,0.0D0,
49014 & 'SSMUR- ', 2000013, 0,-1,0.00D0,1.000D+30,0.0D0,
49015 & 'SSNUMUR ', 2000014, 0, 0,0.00D0,1.000D+30,0.0D0,
49016 & 'SSTAU2- ', 2000015, 0,-1,0.00D0,1.000D+30,0.0D0,
49017 & 'SSNUTR ', 2000016, 0, 0,0.00D0,1.000D+30,0.0D0,
49018 & 'SSER+ ',-2000011, 0,+1,0.00D0,1.000D+30,0.0D0,
49019 & 'SSNUERBR',-2000012, 0, 0,0.00D0,1.000D+30,0.0D0,
49020 & 'SSMUR+ ',-2000013, 0,+1,0.00D0,1.000D+30,0.0D0,
49021 & 'SSNUMRBR',-2000014, 0, 0,0.00D0,1.000D+30,0.0D0,
49022 & 'SSTAU2+ ',-2000015, 0,+1,0.00D0,1.000D+30,0.0D0,
49023 & 'SSNUTRBR',-2000016, 0, 0,0.00D0,1.000D+30,0.0D0/
49024 DATA (RNAME(I),IDPDG(I),IFLAV(I),ICHRG(I),RMASS(I),RLTIM(I),
49025 & RSPIN(I),I=449,NLAST)/
49026 & 'GLUINO ', 1000021, 0, 0,0.00D0,1.000D+30,0.5D0,
49027 & 'NTLINO1 ', 1000022, 0, 0,0.00D0,1.000D+30,0.5D0,
49028 & 'NTLINO2 ', 1000023, 0, 0,0.00D0,1.000D+30,0.5D0,
49029 & 'NTLINO3 ', 1000025, 0, 0,0.00D0,1.000D+30,0.5D0,
49030 & 'NTLINO4 ', 1000035, 0, 0,0.00D0,1.000D+30,0.5D0,
49031 & 'CHGINO1+', 1000024, 0,+1,0.00D0,1.000D+30,0.5D0,
49032 & 'CHGINO2+', 1000037, 0,+1,0.00D0,1.000D+30,0.5D0,
49033 & 'CHGINO1-',-1000024, 0,-1,0.00D0,1.000D+30,0.5D0,
49034 & 'CHGINO2-',-1000037, 0,-1,0.00D0,1.000D+30,0.5D0,
49035 & 'GRAVTINO', 1000039, 0, 0,0.00D0,1.000D+30,1.5D0/
49037 DATA QORQQB/.FALSE.,
49038 & 6*.TRUE.,6*.FALSE.,96*.FALSE.,6*.FALSE.,6*.TRUE.,NREST*.FALSE./
49039 DATA QBORQQ/.FALSE.,
49040 & 6*.FALSE.,6*.TRUE.,96*.FALSE.,6*.TRUE.,6*.FALSE.,NREST*.FALSE./
49042 C In the character strings use an ampersand to represent a backslash
49043 C to avoid compiler problems with the C escape character
49044 DATA ((TXNAME(J,I),J=1,2),I=0,8)/
49059 & ' $&bar{&rm d}$',
49061 & ' $&bar{&rm u}$',
49063 DATA ((TXNAME(J,I),J=1,2),I=9,16)/
49064 & ' $&bar{&rm s}$',
49066 & ' $&bar{&rm c}$',
49068 & ' $&bar{&rm b}$',
49070 & ' $&bar{&rm t}$',
49080 DATA ((TXNAME(J,I),J=1,2),I=17,24)/
49087 & ' $&star&star&star&star$',
49090 & ' pi<SUP>0</SUP>',
49094 & ' rho<SUP>0</SUP>',
49097 DATA ((TXNAME(J,I),J=1,2),I=25,32)/
49098 & ' $&eta^&prime$',
49099 & ' eta<SUP>''</SUP>',
49101 & ' f<SUB>2</SUB>',
49103 & ' a<SUB>1</SUB><SUP>0</SUP>',
49105 & ' f<SUB>1</SUB>(L)',
49107 & ' a<SUB>2</SUB><SUP>0</SUP>',
49109 & ' pi<SUP>-</SUP>',
49111 & ' rho<SUP>-</SUP>',
49113 & ' a<SUB>1</SUB><SUP>-</SUP>'/
49114 DATA ((TXNAME(J,I),J=1,2),I=33,40)/
49116 & ' a<SUB>2</SUB><SUP>-</SUP>',
49118 & ' K<SUP>-</SUP>',
49120 & ' K<SUP>*-</SUP>',
49122 & ' K<SUB>1</SUB>(H)<SUP>-</SUP>',
49123 & ' K$^{&star-}_2$',
49124 & ' K<SUB>2</SUB><SUP>*-</SUP>',
49126 & ' pi<SUP>+</SUP>',
49128 & ' rho<SUP>+</SUP>',
49130 & ' a<SUB>1</SUB><SUP>+</SUP>'/
49131 DATA ((TXNAME(J,I),J=1,2),I=41,48)/
49133 & ' a<SUB>2</SUB><SUP>+</SUP>',
49134 & ' $&overline{&rm K}^0$',
49135 & ' -K<SUP>0</SUP>',
49136 & ' $&overline{&rm K}^{&star0}$',
49137 & ' -K<SUP>*0</SUP>',
49138 & ' $&overline{&rm K}_1(H)^0$',
49139 & ' -K<SUB>1</SUB>(H)<SUP>0</SUP>',
49140 & ' $&overline{&rm K}^{&star0}_2$',
49141 & ' -K<SUB>2</SUB><SUP>*0</SUP>',
49143 & ' K<SUP>+</SUP>',
49145 & ' K<SUP>*+</SUP>',
49147 & ' K<SUB>1</SUB>(H)<SUP>+</SUP>'/
49148 DATA ((TXNAME(J,I),J=1,2),I=49,56)/
49149 & ' K$^{&star+}_2$',
49150 & ' K<SUB>2</SUB>(H)<SUP>*+</SUP>',
49152 & ' K<SUP>0</SUP>',
49154 & ' K<SUP>*-</SUP>',
49156 & ' K<SUB>1</SUB>(H)<SUP>0</SUP>',
49157 & ' K$^{&star0}_2$',
49158 & ' K<SUB>2</SUB><SUP>*0</SUP>',
49165 DATA ((TXNAME(J,I),J=1,2),I=57,64)/
49167 & ' f<SUB>1</SUB>(1420)',
49169 & ' f<SUP>''</SUP><SUB>2</SUB>',
49172 & ' K$^0_{&rm S}$',
49173 & ' K<SUB>S</SUB><SUP>0</SUP>',
49174 & ' K$^0_{&rm L}$',
49175 & ' K<SUB>L</SUB><SUP>0</SUP>',
49176 & ' $a_0(1450)^0$',
49177 & ' a<SUB>0</SUB>(1450)<SUP>0</SUP>',
49178 & ' $a_0(1450)^+$',
49179 & ' a<SUB>0</SUB>(1450)<SUP>+</SUP>',
49180 & ' $a_0(1450)^-$',
49181 & ' a<SUB>0</SUB>(1450)<SUP>-</SUP>'/
49182 DATA ((TXNAME(J,I),J=1,2),I=65,72)/
49195 & ' $&gamma$-remnant',
49196 & ' gamma-remnant',
49199 DATA ((TXNAME(J,I),J=1,2),I=73,80)/
49203 & ' Delta<SUP>+</SUP>',
49207 & ' Delta<SUP>0</SUP>',
49209 & ' Delta<SUP>-</SUP>',
49213 & ' Sigma<SUP>0</SUP>',
49214 & ' $&Sigma^{&star0}$',
49215 & ' Sigma<SUP>*0</SUP>'/
49216 DATA ((TXNAME(J,I),J=1,2),I=81,88)/
49218 & ' Sigma<SUP>-</SUP>',
49219 & ' $&Sigma^{&star-}$',
49220 & ' Sigma<SUP>*-</SUP>',
49222 & ' Xi<SUP>-</SUP>',
49223 & ' $&Xi^{&star-}$',
49224 & ' Xi<SUP>*-</SUP>',
49225 & ' $&Delta^{++}$',
49226 & ' Delta<SUP>++</SUP>',
49228 & ' Sigma<SUP>+</SUP>',
49229 & ' $&Sigma^{&star+}$',
49230 & ' Sigma<SUP>*+</SUP>',
49232 & ' Xi<SUP>0</SUP>'/
49233 DATA ((TXNAME(J,I),J=1,2),I=89,96)/
49234 & ' $&Xi^{&star0}$',
49235 & ' Xi<SUP>*0</SUP>',
49237 & ' Omega<SUP>-</SUP>',
49238 & ' $&bar{&rm p}$',
49240 & ' $&overline{&Delta}^-$',
49241 & ' -Delta<SUP>-</SUP>',
49242 & ' $&bar{&rm n}$',
49244 & ' $&overline{&Delta}^0$',
49245 & ' -Delta<SUP>0</SUP>',
49246 & ' $&overline{&Delta}^+$',
49247 & ' -Delta<SUP>+</SUP>',
49248 & ' $&overline{&Lambda}$',
49250 DATA ((TXNAME(J,I),J=1,2),I=97,104)/
49251 & ' $&overline{&Sigma}^0$',
49252 & ' -Sigma<SUP>0</SUP>',
49253 & ' $&overline{&Sigma}^{&star0}$',
49254 & ' -Sigma<SUP>*0</SUP>',
49255 & ' $&overline{&Sigma}^+$',
49256 & ' -Sigma<SUP>+</SUP>',
49257 & ' $&overline{&Sigma}^{&star+}$',
49258 & ' -Sigma<SUP>*+</SUP>',
49259 & ' $&overline{&Xi}^+$',
49260 & ' -Xi<SUP>+</SUP>',
49261 & ' $&overline{&Xi}^{&star+}$',
49262 & ' -Xi<SUP>*+</SUP>',
49263 & ' $&overline{&Delta}^{--}$',
49264 & ' -Delta<SUP>--</SUP>',
49265 & ' $&overline{&Sigma}^-$',
49266 & ' -Sigma<SUP>-</SUP>'/
49267 DATA ((TXNAME(J,I),J=1,2),I=105,112)/
49268 & ' $&overline{&Sigma}^{&star-}$',
49269 & ' -Sigma<SUP>*-</SUP>',
49270 & ' $&overline{&Xi}^0$',
49271 & ' -Xi<SUP>0</SUP>',
49272 & ' $&overline&Xi^{&star0}$',
49273 & ' -Xi<SUP>*0</SUP>',
49274 & ' $&overline{&Omega}^+$',
49275 & ' -Omega<SUP>+</SUP>',
49284 DATA ((TXNAME(J,I),J=1,2),I=113,120)/
49289 & ' $&bar{&rm u}&bar{&rm u}$',
49291 & ' $&bar{&rm u}&bar{&rm d}$',
49293 & ' $&bar{&rm d}&bar{&rm d}$',
49295 & ' $&bar{&rm u}&bar{&rm s}$',
49297 & ' $&bar{&rm d}&bar{&rm s}$',
49299 & ' $&bar{&rm s}&bar{&rm s}$',
49301 DATA ((TXNAME(J,I),J=1,2),I=121,128)/
49303 & ' e<SUP>-</SUP>',
49304 & ' $&nu_{&rm e}$',
49305 & ' nu<SUB>e</SUB>',
49307 & ' mu<SUP>-</SUP>',
49309 & ' nu<SUB>mu</SUB>',
49311 & ' tau<SUP>-</SUP>',
49313 & ' nu<SUB>tau</SUB>',
49315 & ' e<SUP>+</SUP>',
49316 & ' $&bar{&nu}_{&rm e}$',
49317 & ' -nu<SUB>e</SUB>'/
49318 DATA ((TXNAME(J,I),J=1,2),I=129,136)/
49320 & ' mu<SUP>+</SUP>',
49321 & ' $&bar{&nu}_&mu$',
49322 & ' -nu<SUB>mu</SUB>',
49324 & ' tau<SUP>+</SUP>',
49325 & ' $&bar{&nu}_&tau$',
49326 & ' -nu<SUB>tau</SUB>',
49334 & ' D<SUP>+</SUP>'/
49335 DATA ((TXNAME(J,I),J=1,2),I=137,144)/
49337 & ' D<SUP>*+</SUP>',
49339 & ' D<SUB>1</SUB>(H)<SUP>+</SUP>',
49340 & ' D$_2^{&star+}$',
49341 & ' D<SUB>2</SUB><SUP>*+</SUP>',
49343 & ' D<SUP>0</SUP>',
49345 & ' D<SUP>*0</SUP>',
49347 & ' D<SUB>1</SUB>(H)<SUP>0</SUP>',
49348 & ' D$_2^{&star0}$',
49349 & ' D<SUB>2</SUB><SUP>*0</SUP>',
49350 & ' D$_{&rm s}^+$',
49351 & ' D<SUB>s</SUB><SUP>+</SUP>'/
49352 DATA ((TXNAME(J,I),J=1,2),I=145,152)/
49353 & ' D$_{&rm s}^{&star+}$',
49354 & ' D<SUB>s</SUB><SUP>*+</SUP>',
49355 & ' D$_{&rm s1}(H)^+$',
49356 & ' D<SUB>s1</SUB>(H)<SUP>+</SUP>',
49357 & ' D$^{&star+}_{&rm s2}$',
49358 & ' D<SUB>s1</SUB>(H)<SUP>*+</SUP>',
49359 & ' $&Sigma_{&rm c}^{++}$',
49360 & ' Sigma<SUB>c</SUB><SUP>++</SUP>',
49361 & ' $&Sigma_{&rm c}^{&star++}$',
49362 & ' Sigma<SUB>c</SUB><SUP>*++</SUP>',
49363 & ' $&Lambda_{&rm c}^+$',
49364 & ' Lambda<SUB>c</SUB><SUP>+</SUP>',
49365 & ' $&Sigma_{&rm c}^+$',
49366 & ' Sigma<SUB>c</SUB><SUP>+</SUP>',
49367 & ' $&Sigma_{&rm c}^{&star+}$',
49368 & ' Sigma<SUB>c</SUB><SUP>*+</SUP>'/
49369 DATA ((TXNAME(J,I),J=1,2),I=153,160)/
49370 & ' $&Sigma_{&rm c}^0$',
49371 & ' Sigma<SUB>c</SUB><SUP>0</SUP>',
49372 & ' $&Sigma_{&rm c}^{&star0}$',
49373 & ' Sigma<SUB>c</SUB><SUP>*0</SUP>',
49374 & ' $&Xi_{&rm c}^+$',
49375 & ' Xi<SUB>c</SUB><SUP>+</SUP>',
49376 & ' $&Xi_{&rm c}^{&prime+}$',
49377 & ' Xi<SUB>c</SUB><SUP>''+</SUP>',
49378 & ' $&Xi_{&rm c}^{&star+}$',
49379 & ' Xi<SUB>c</SUB><SUP>*+</SUP>',
49380 & ' $&Xi_{&rm c}^0$',
49381 & ' Xi<SUB>c</SUB><SUP>0</SUP>',
49382 & ' $&Xi_{&rm c}^{&prime0}$',
49383 & ' Xi<SUB>c</SUB><SUP>''0</SUP>',
49384 & ' $&Xi_{&rm c}^{&star0}$',
49385 & ' Xi<SUB>c</SUB><SUP>*0</SUP>'/
49386 DATA ((TXNAME(J,I),J=1,2),I=161,168)/
49387 & ' $&Omega_{&rm c}^0$',
49388 & ' Omega<SUB>c</SUB><SUP>0</SUP>',
49389 & ' $&Omega_{&rm c}^{&star0}$',
49390 & ' Omega<SUB>c</SUB><SUP>*0</SUP>',
49391 & ' $&eta_{&rm c}(1S)$',
49392 & ' eta<SUB>c</SUB>(1S)',
49395 & ' $&chi_{&rm c0}(1P)$',
49396 & ' chi<SUB>c0</SUB>(1P)',
49403 DATA ((TXNAME(J,I),J=1,2),I=169,176)/
49409 & ' D<SUP>-</SUP>',
49411 & ' D<SUP>*-</SUP>',
49413 & ' D<SUB>1</SUB>(H)<SUP>-</SUP>',
49414 & ' D$_2^{&star-}$',
49415 & ' D<SUB>2</SUB><SUP>*-</SUP>',
49416 & ' $&overline{&rm D}^0$',
49417 & ' -D<SUP>0</SUP>',
49418 & ' $&overline{&rm D}^{&star0}$',
49419 & ' -D<SUP>*0</SUP>'/
49420 DATA ((TXNAME(J,I),J=1,2),I=177,184)/
49421 & ' $&overline{&rm D}_1(H)^0$',
49422 & ' -D<SUB>1</SUB>(H)<SUP>0</SUP>',
49423 & ' $&overline{&rm D}_2^{&star0}$',
49424 & ' -D<SUB>2</SUB><SUP>*0</SUP>',
49425 & ' D$_{&rm s}^-$',
49426 & ' D<SUB>s</SUB><SUP>-</SUP>',
49427 & ' D$_{&rm s}^{&star-}$',
49428 & ' D<SUB>s</SUB><SUP>*-</SUP>',
49429 & ' D$_{&rm s1}(H)^-$',
49430 & ' D<SUB>s1</SUB>(H)<SUP>-</SUP>',
49431 & ' D$_{&rm s2}^{&star-}$',
49432 & ' D<SUB>s1</SUB>(H)<SUP>*-</SUP>',
49433 & ' $&overline{&Sigma}_{&rm c}^{--}$',
49434 & ' -Sigma<SUB>c</SUB><SUP>--</SUP>',
49435 & '$&overline{&Sigma}_{&rm c}^{&star--}$',
49436 & ' -Sigma<SUB>c</SUB><SUP>*--</SUP>'/
49437 DATA ((TXNAME(J,I),J=1,2),I=185,192)/
49438 & ' $&overline{&Lambda}_{&rm c}^-$',
49439 & ' -Lambda<SUB>c</SUB><SUP>-</SUP>',
49440 & ' $&overline{&Sigma}_{&rm c}^-$',
49441 & ' -Sigma<SUB>c</SUB><SUP>-</SUP>',
49442 & ' $&overline{&Sigma}_{&rm c}^{&star-}$',
49443 & ' -Sigma<SUB>c</SUB><SUP>*-</SUP>',
49444 & ' $&overline{&Sigma}_{&rm c}^0$',
49445 & ' -Sigma<SUB>c</SUB><SUP>0</SUP>',
49446 & ' $&overline{&Sigma}_{&rm c}^{&star0}$',
49447 & ' -Sigma<SUB>c</SUB><SUP>*0</SUP>',
49448 & ' $&overline{&Xi}_{&rm c}^-$',
49449 & ' -Xi<SUB>c</SUB><SUP>-</SUP>',
49450 & ' $&overline{&Xi}_{&rm c}^{&prime-}$',
49451 & ' -Xi<SUB>c</SUB><SUP>''-</SUP>',
49452 & ' $&overline{&Xi}_{&rm c}^{&star-}$',
49453 & ' -Xi<SUB>c</SUB><SUP>*-</SUP>'/
49454 DATA ((TXNAME(J,I),J=1,2),I=193,200)/
49455 & ' $&overline{&Xi}_{&rm c}^0$',
49456 & ' -Xi<SUB>c</SUB><SUP>0</SUP>',
49457 & ' $&overline{&Xi}_{&rm c}^{&prime0}$',
49458 & ' -Xi<SUB>c</SUB><SUP>''0</SUP>',
49459 & ' $&overline{&Xi}_{&rm c}^{&star0}$',
49460 & ' -Xi<SUB>c</SUB><SUP>*0</SUP>',
49461 & ' $&overline{&Omega}_{&rm c}^0$',
49462 & ' -Omega<SUB>c</SUB><SUP>0</SUP>',
49463 & ' $&overline{&Omega}_{&rm c}^{&star0}$',
49464 & ' -Omega<SUB>c</SUB><SUP>*0</SUP>',
49466 & ' W<SUP>+</SUP>',
49468 & ' W<SUP>-</SUP>',
49469 & ' Z$^0/&gamma^&star$',
49470 & ' Z<SUP>0</SUP>/gamma<SUP>*</SUP>'/
49471 DATA ((TXNAME(J,I),J=1,2),I=201,208)/
49472 & ' $H^0_{&rm SM}$',
49473 & ' H<SUP>0</SUP><SUB>SM</SUB>',
49474 & ' Z$^{&prime0}$',
49475 & ' Z<SUP>''0</SUP>',
49477 & ' h<SUP>0</SUP>',
49479 & ' H<SUP>0</SUP>',
49481 & ' A<SUP>0</SUP>',
49483 & ' H<SUP>+</SUP>',
49485 & ' H<SUP>-</SUP>',
49488 DATA ((TXNAME(J,I),J=1,2),I=209,216)/
49495 & ' H$^&prime$-quark',
49496 & ' H<SUP>''</SUP>-quark',
49501 & ' $&overline{&rm V}$-quark',
49503 & ' $&overline{&rm A}$-quark',
49505 DATA ((TXNAME(J,I),J=1,2),I=217,224)/
49506 & ' $&overline{&rm H}$-quark',
49508 & ' $&overline{&rm H}^&prime$-quark',
49509 & ' -H<SUP>''</SUP>-quark',
49514 & ' $&overline{&rm B}_{&rm d}^0$',
49515 & ' -B<SUB>d</SUB><SUP>0</SUP>',
49517 & ' B<SUP>-</SUP>',
49518 & ' $&overline{&rm B}_{&rm s}^0$',
49519 & ' -B<SUB>s</SUB><SUP>0</SUP>',
49520 & ' $&Sigma_{&rm b}^+$',
49521 & ' Sigma<SUB>b</SUB><SUP>+</SUP>'/
49522 DATA ((TXNAME(J,I),J=1,2),I=225,232)/
49523 & ' $&Lambda_{&rm b}^0$',
49524 & ' Lambda<SUB>b</SUB><SUP>0</SUP>',
49525 & ' $&Sigma_{&rm b}^-$',
49526 & ' Sigma<SUB>b</SUB><SUP>-</SUP>',
49527 & ' $&Xi_{&rm b}^0$',
49528 & ' Xi<SUB>b</SUB><SUP>0</SUP>',
49529 & ' $&Xi_{&rm b}^-$',
49530 & ' Xi<SUB>b</SUB><SUP>-</SUP>',
49531 & ' $&Omega_{&rm b}^-$',
49532 & ' Omega<SUB>b</SUB><SUP>-</SUP>',
49533 & ' B$_{&rm c}^-$',
49534 & ' B<SUB>c</SUB><SUP>-</SUP>',
49535 & ' $&Upsilon(1S)$',
49537 & ' T$_{&rm b}^-$',
49538 & ' T<SUB>b</SUB><SUP>-</SUP>'/
49539 DATA ((TXNAME(J,I),J=1,2),I=233,240)/
49541 & ' T<SUP>+</SUP>',
49543 & ' T<SUP>0</SUP>',
49544 & ' T$_{&rm s}^+$',
49545 & ' T<SUB>s</SUB><SUP>+</SUP>',
49546 & ' $&Sigma_{&rm t}^{++}$',
49547 & ' Sigma<SUB>t</SUB><SUP>++</SUP>',
49548 & ' $&Lambda_{&rm t}^0$',
49549 & ' Lambda<SUB>t</SUB><SUP>0</SUP>',
49550 & ' $&Sigma_{&rm t}^0$',
49551 & ' Sigma<SUB>t</SUB><SUP>0</SUP>',
49552 & ' $&chi_{&rm t}^+$',
49553 & ' Xi<SUB>t</SUB><SUP>+</SUP>',
49554 & ' $&chi_{&rm t}^0$',
49555 & ' Xi<SUB>t</SUB><SUP>0</SUP>'/
49556 DATA ((TXNAME(J,I),J=1,2),I=241,248)/
49557 & ' $&Omega_{&rm t}^0$',
49558 & ' Omega<SUB>t</SUB><SUP>0</SUP>',
49559 & ' T$_{&rm c}^0$',
49560 & ' T<SUB>c</SUB><SUP>0</SUP>',
49561 & ' T$_{&rm b}^+$',
49562 & ' T<SUB>b</SUB><SUP>+</SUP>',
49565 & ' B$_{&rm d}^0$',
49566 & ' B<SUB>d</SUB><SUP>0</SUP>',
49568 & ' B<SUP>+</SUP>',
49569 & ' B$_{&rm s}^0$',
49570 & ' B<SUB>s</SUB><SUP>0</SUP>',
49571 & ' $&overline{&Sigma}_{&rm b}^-$',
49572 & ' -Sigma<SUB>b</SUB><SUP>-</SUP>'/
49573 DATA ((TXNAME(J,I),J=1,2),I=249,256)/
49574 & ' $&overline{&Lambda}_{&rm b}^-$',
49575 & ' -Lambda<SUB>b</SUB><SUP>-</SUP>',
49576 & ' $&overline{&Sigma}_{&rm b}^+$',
49577 & ' -Sigma<SUB>b</SUB><SUP>+</SUP>',
49578 & ' $&overline{&Xi}_{&rm b}^0$',
49579 & ' -Xi<SUB>b</SUB><SUP>0</SUP>',
49580 & ' $&Xi_{&rm b}^+$',
49581 & ' Xi<SUB>b</SUB><SUP>+</SUP>',
49582 & ' $&overline{&Omega}_{&rm b}^+$',
49583 & ' -Omega<SUB>b</SUB><SUP>+</SUP>',
49584 & ' B$_{&rm c}^+$',
49585 & ' B<SUB>c</SUB><SUP>+</SUP>',
49587 & ' T<SUP>-</SUP>',
49588 & ' $&overline{&rm T}^0$',
49589 & ' T<SUP>0</SUP>'/
49590 DATA ((TXNAME(J,I),J=1,2),I=257,264)/
49591 & ' T$_{&rm s}^-$',
49592 & ' T<SUB>s</SUB><SUP>-</SUP>',
49593 & ' $&overline{&Sigma}_{&rm t}^{--}$',
49594 & ' Sigma<SUB>t</SUB><SUP>--</SUP>',
49595 & ' $&overline{&Lambda}_{&rm t}^-$',
49596 & ' -Lambda<SUB>t</SUB><SUP>-</SUP>',
49597 & ' $&overline{&Sigma}_{&rm t}^0$',
49598 & ' -Sigma<SUB>t</SUB><SUP>0</SUP>',
49599 & ' $&overline{&Xi}_{&rm t}^-$',
49600 & ' -Xi<SUB>t</SUB><SUP>-</SUP>',
49601 & ' $&overline{&Xi}_{&rm t}^0$',
49602 & ' -Xi<SUB>t</SUB><SUP>0</SUP>',
49603 & ' $&overline{&Omega}_{&rm t}^0$',
49604 & ' -Omega<SUB>t</SUB><SUP>0</SUP>',
49605 & ' $&overline{&rm T}_{&rm c}^0$',
49606 & ' T<SUB>c</SUB><SUP>0</SUP>'/
49607 DATA ((TXNAME(J,I),J=1,2),I=265,272)/
49608 & ' $&overline{&rm B}^{&star0}$',
49609 & ' -B<SUP>*0</SUP>',
49611 & ' B<SUP>*-</SUP>',
49612 & ' $&overline{&rm B}_{&rm s}^{&star0}$',
49613 & ' -B<SUB>s</SUB><SUP>*0</SUP>',
49614 & ' $&overline{&rm B}_1(H)^0$',
49615 & ' -B<SUB>1</SUB>(H)<SUP>0</SUP>',
49617 & ' B<SUB>1</SUB>(H)<SUP>-</SUP>',
49618 & ' $&overline{&rm B}_{&rm s1}(H)^0$',
49619 & ' -B<SUB>s1</SUB>(H)<SUP>0</SUP>',
49620 & ' $&overline{&rm B}_2^{&star0}$',
49621 & ' -B<SUB>2</SUB><SUP>*0</SUP>',
49622 & ' B$_2^{&star-}$',
49623 & ' B<SUB>2</SUB><SUP>*-</SUP>'/
49624 DATA ((TXNAME(J,I),J=1,2),I=273,280)/
49625 & ' B$_{&rm s2}^{&star0}$',
49626 & ' B<SUB>s2</SUB><SUP>*0</SUP>',
49628 & ' B<SUP>*0</SUP>',
49630 & ' B<SUP>*+</SUP>',
49631 & ' B$_{&rm s}^{&star0}$',
49632 & ' B<SUB>s</SUB><SUP>*0</SUP>',
49634 & ' B<SUB>1</SUB>(H)<SUP>0</SUP>',
49636 & ' B<SUB>1</SUB>(H)<SUP>+</SUP>',
49637 & ' B$_{&rm s1}(H)^0$',
49638 & ' B<SUB>s1</SUB>(H)<SUP>0</SUP>',
49639 & ' B$_2^{&star0}$',
49640 & ' B<SUB>2</SUB><SUP>*0</SUP>'/
49641 DATA ((TXNAME(J,I),J=1,2),I=281,288)/
49642 & ' B$_2^{&star+}$',
49643 & ' B<SUB>2</SUB><SUP>*+</SUP>',
49644 & ' B$_{&rm s2}^{&star0}$',
49645 & ' B<SUB>s2</SUB><SUP>*0</SUP>',
49651 & ' b<SUB>1</SUB><SUP>0</SUP>',
49653 & ' b<SUB>1</SUB><SUP>+</SUP>',
49655 & ' b<SUB>1</SUB><SUP>-</SUP>',
49657 & ' h<SUB>1</SUB>(L)<SUP>0</SUP>'/
49658 DATA ((TXNAME(J,I),J=1,2),I=289,296)/
49660 & ' h<SUB>1</SUB>(H)<SUP>0</SUP>',
49662 & ' a<SUB>0</SUB>(980)<SUP>0</SUP>',
49664 & ' a<SUB>0</SUB>(980)<SUP>+</SUP>',
49666 & ' a<SUB>0</SUB>(980)<SUP>-</SUP>',
49668 & ' f<SUB>0</SUB>(980)',
49670 & ' f<SUB>0</SUB>(1370)',
49671 & ' B$_{&rm c}^{&star+}$',
49672 & ' B<SUB>c</SUB><SUP>*+</SUP>',
49673 & ' B$_{&rm c}^{&star-}$',
49674 & ' B<SUB>c</SUB><SUP>*-</SUP>'/
49675 DATA ((TXNAME(J,I),J=1,2),I=297,304)/
49676 & ' B$_{&rm c1}(H)^+$',
49677 & ' B<SUB>c1</SUB>(H)<SUP>+</SUP>',
49678 & ' B$_{&rm c1}(H)^-$',
49679 & ' B<SUB>c1</SUB>(H)<SUP>-</SUP>',
49680 & ' B$_{&rm c2}^{&star+}$',
49681 & ' B<SUB>c2</SUB><SUP>*+</SUP>',
49682 & ' B$_{&rm c2}^{&star-}$',
49683 & ' B<SUB>c2</SUB><SUP>*-</SUP>',
49684 & ' h$_{&rm c}(1P)$',
49685 & ' h<SUB>c</SUB>(1P)',
49686 & ' $&chi_{&rm c0}(1P)$',
49687 & ' chi<SUB>c0</SUB>(1P)',
49688 & ' $&chi_{&rm c2}(1P)$',
49689 & ' chi<SUB>c2</SUB>(1P)',
49690 & ' $&eta_{&rm b}(1S)$',
49691 & ' eta<SUB>b</SUB>(1S)'/
49692 DATA ((TXNAME(J,I),J=1,2),I=305,312)/
49693 & ' h$_{&rm b}(1P)$',
49694 & ' h<SUB>b</SUB>(1P)',
49695 & ' $&chi_{&rm b0}(1P)$',
49696 & ' chi<SUB>b0</SUB>(1P)',
49697 & ' $&chi_{&rm b1}(1P)$',
49698 & ' chi<SUB>b1</SUB>(1P)',
49699 & ' $&chi_{&rm b2}(1P)$',
49700 & ' chi<SUB>b2</SUB>(1P)',
49702 & ' K<SUB>1</SUB>(L)<SUP>0</SUP>',
49704 & ' K<SUB>1</SUB>(L)<SUP>+</SUP>',
49705 & ' $&overline{&rm K}_1(L)^0$',
49706 & ' -K<SUB>1</SUB>(L)<SUP>0</SUP>',
49708 & ' K<SUB>1</SUB>(L)<SUP>-</SUP>'/
49709 DATA ((TXNAME(J,I),J=1,2),I=313,320)/
49711 & ' D<SUB>1</SUB>(L)<SUP>+</SUP>',
49713 & ' D<SUB>1</SUB>(L)<SUP>0</SUP>',
49714 & ' D$_{&rm s1}(L)^+$',
49715 & ' D<SUB>s1</SUB>(L)<SUP>+</SUP>',
49717 & ' D<SUB>1</SUB>(L)<SUP>-</SUP>',
49718 & ' $&overline{&rm D}_1(L)^0$',
49719 & ' D<SUB>1</SUB>(L)<SUP>0</SUP>',
49720 & ' D$_{&rm s1}(L)^-$',
49721 & ' D<SUB>s1</SUB>(L)<SUP>-</SUP>',
49723 & ' B<SUB>1</SUB>(L)<SUP>0</SUP>',
49725 & ' B<SUB>1</SUB>(L)<SUP>+</SUP>'/
49726 DATA ((TXNAME(J,I),J=1,2),I=321,328)/
49727 & ' B$_{&rm s1}(L)^0$',
49728 & ' B<SUB>s1</SUB>(L)<SUP>0</SUP>',
49729 & ' B$_{&rm c1}(L)^+$',
49730 & ' B<SUB>c1</SUB>(L)<SUP>+</SUP>',
49731 & ' $&overline{&rm B}_1(L)^0$',
49732 & ' -B<SUB>1</SUB>(L)<SUP>0</SUP>',
49734 & ' B<SUB>1</SUB>(L)<SUP>-</SUP>',
49735 & ' $&overline{&rm B}_{&rm s1}(L)^0$',
49736 & ' -B<SUB>s1</SUB>(L)<SUP>0</SUP>',
49737 & ' B$_{&rm c1}(L)^-$',
49738 & ' B<SUB>c1</SUB>(L)<SUP>-</SUP>',
49739 & ' K$_0^{&star+}$',
49740 & ' K<SUB>0</SUB><SUP>*+</SUP>',
49741 & ' K$_0^{&star0}$',
49742 & ' K<SUB>0</SUB><SUP>*0</SUP>'/
49743 DATA ((TXNAME(J,I),J=1,2),I=329,336)/
49744 & ' $&overline{&rm K}_0^{&star0}$',
49745 & ' -K<SUB>0</SUB><SUP>*0</SUP>',
49746 & ' K$_0^{&star-}$',
49747 & ' K<SUB>0</SUB><SUP>*-</SUP>',
49748 & ' D$_0^{&star+}$',
49749 & ' D<SUB>0</SUB><SUP>*+</SUP>',
49750 & ' D$_0^{&star0}$',
49751 & ' D<SUB>0</SUB><SUP>*0</SUP>',
49752 & ' D$_{&rm s0}^{&star+}$',
49753 & ' D<SUB>s0</SUB><SUP>*+</SUP>',
49754 & ' D$_0^{&star-}$',
49755 & ' D<SUB>0</SUB><SUP>*-</SUP>',
49756 & ' $&overline{&rm D}_0^{&star0}$',
49757 & ' -D<SUB>0</SUB><SUP>*0</SUP>',
49758 & ' D$_{&rm s0}^{&star-}$',
49759 & ' D<SUB>s0</SUB><SUP>*-</SUP>'/
49760 DATA ((TXNAME(J,I),J=1,2),I=337,344)/
49761 & ' B$_0^{&star0}$',
49762 & ' B<SUB>0</SUB><SUP>*0</SUP>',
49763 & ' B$_0^{&star+}$',
49764 & ' B<SUB>0</SUB><SUP>*+</SUP>',
49765 & ' B$_{&rm s0}^{&star0}$',
49766 & ' B<SUB>s0</SUB><SUP>*0</SUP>',
49767 & ' B$_{&rm c0}^{&star+}$',
49768 & ' B<SUB>c0</SUB><SUP>*+</SUP>',
49769 & ' $&overline{&rm B}_0^{&star0}$',
49770 & ' -B<SUB>0</SUB><SUP>*0</SUP>',
49771 & ' B$_0^{&star-}$',
49772 & ' B<SUB>0</SUB><SUP>*-</SUP>',
49773 & ' $&overline{&rm B}_{&rm s0}^{&star0}$',
49774 & ' -B<SUB>s0</SUB><SUP>*0</SUP>',
49775 & ' B$_{&rm c0}^{&star-}$',
49776 & ' B<SUB>c0</SUB><SUP>*-</SUP>'/
49777 DATA ((TXNAME(J,I),J=1,2),I=345,352)/
49778 & ' $&Sigma_{&rm b}^0$',
49779 & ' Sigma<SUB>b</SUB><SUP>0</SUP>',
49780 & ' $&Sigma_{&rm b}^{&star-}$',
49781 & ' Sigma<SUB>b</SUB><SUP>*-</SUP>',
49782 & ' $&Sigma_{&rm b}^{&star0}$',
49783 & ' Sigma<SUB>b</SUB><SUP>*0</SUP>',
49784 & ' $&Sigma_{&rm b}^{&star+}$',
49785 & ' Sigma<SUB>b</SUB><SUP>*+</SUP>',
49786 & ' $&Xi_{&rm b}^{&prime0}$',
49787 & ' Xi<SUB>b</SUB><SUP>''0</SUP>',
49788 & ' $&Xi_{&rm b}^{&star0}$',
49789 & ' Xi<SUB>b</SUB><SUP>*0</SUP>',
49790 & ' $&Xi_{&rm b}^{&prime-}$',
49791 & ' Xi<SUB>b</SUB><SUP>''-</SUP>',
49792 & ' $&Xi_{&rm b}^{&star-}$',
49793 & ' Xi<SUB>b</SUB><SUP>*-</SUP>'/
49794 DATA ((TXNAME(J,I),J=1,2),I=353,360)/
49795 & ' $&Omega_{&rm b}^{&star-}$',
49796 & ' -Omega<SUB>b</SUB><SUP>*-</SUP>',
49797 & ' $&overline{&Sigma}_{&rm b}^{&star+}$',
49798 & ' Sigma<SUB>b</SUB><SUP>*+</SUP>',
49799 & ' $&overline{&Sigma}_{&rm b}^0$',
49800 & ' -Sigma<SUB>b</SUB><SUP>0</SUP>',
49801 & ' $&overline{&Sigma}_{&rm b}^{&star0}$',
49802 & ' -Sigma<SUB>b</SUB><SUP>*0</SUP>',
49803 & ' $&overline{&Sigma}_{&rm b}^{&star-}$',
49804 & ' -Sigma<SUB>b</SUB><SUP>*-</SUP>',
49805 & ' $&overline{&Xi}_{&rm b}^{&prime0}$',
49806 & ' -Xi<SUB>b</SUB><SUP>''0</SUP>',
49807 & ' $&overline{&Xi}_{&rm b}^{&star0}$',
49808 & ' -Xi<SUB>b</SUB><SUP>*0</SUP>',
49809 & ' $&overline{&Xi}_{&rm b}^{&prime+}$',
49810 & ' -Xi<SUB>b</SUB><SUP>''+</SUP>'/
49811 DATA ((TXNAME(J,I),J=1,2),I=361,368)/
49812 & ' $&overline{&Xi}_{&rm b}^{&star+}$',
49813 & ' -Xi<SUB>b</SUB><SUP>*+</SUP>',
49814 & ' $&Omega_{&rm b}^{&star+}$',
49815 & ' Omega<SUB>b</SUB><SUP>*+</SUP>',
49817 & ' K(DL)<SUB>2</SUB><SUP>+</SUP>',
49819 & ' K(DL)<SUB>2</SUB><SUP>0</SUP>',
49820 & ' $&overline{&rm K}(DL)_2^0$',
49821 & ' -K(DL)<SUB>2</SUB><SUP>0</SUP>',
49823 & ' K(DL)<SUB>2</SUB><SUP>-</SUP>',
49824 & ' K$(D)^{&star+}$',
49825 & ' K(D)<SUP>*+</SUP>',
49826 & ' K$(D)^{&star0}$',
49827 & ' K(D)<SUP>*0</SUP>'/
49828 DATA ((TXNAME(J,I),J=1,2),I=369,376)/
49829 & ' $&overline{&rm K}(D)^{&star0}$',
49830 & ' -K(D)<SUP>*0</SUP>',
49831 & ' K$(D)^{&star-}$',
49832 & ' K(D)<SUP>*-</SUP>',
49834 & ' K(DH)<SUB>2</SUB><SUP>+</SUP>',
49836 & ' K(DH)<SUB>2</SUB><SUP>0</SUP>',
49837 & ' $&overline{&rm K}(DH)_2^0$',
49838 & ' -K(DH)<SUB>2</SUB><SUP>0</SUP>',
49840 & ' K(DH)<SUB>2</SUB><SUP>-</SUP>',
49842 & ' K(D)<SUB>3</SUB><SUP>+</SUP>',
49844 & ' K(D)<SUB>3</SUB><SUP>0</SUP>'/
49845 DATA ((TXNAME(J,I),J=1,2),I=377,384)/
49846 & ' $&overline{&rm K}(D)_3^0$',
49847 & ' -K(D)<SUB>3</SUB><SUP>0</SUP>',
49849 & ' K(D)<SUB>3</SUB><SUP>-</SUP>',
49851 & ' pi<SUB>2</SUB><SUP>+</SUP>',
49853 & ' pi<SUB>2</SUB><SUP>0</SUP>',
49855 & ' pi<SUB>2</SUB><SUP>-</SUP>',
49857 & ' rho(D)<SUP>+</SUP>',
49859 & ' rho(D)<SUP>0</SUP>',
49861 & ' rho(D)<SUP>-</SUP>'/
49862 DATA ((TXNAME(J,I),J=1,2),I=385,392)/
49864 & ' rho<SUB>3</SUB><SUP>+</SUP>',
49866 & ' rho<SUB>3</SUB><SUP>0</SUP>',
49868 & ' rho<SUB>3</SUB><SUP>-</SUP>',
49869 & ' $&Upsilon(2S)$',
49871 & ' $&chi_{&rm b0}(2P)$',
49872 & ' Chi<SUB>b0</SUB>(2P)',
49873 & ' $&chi_{&rm b1}(2P)$',
49874 & ' Chi<SUB>b1</SUB>(2P)',
49875 & ' $&chi_{&rm b2}(2P)$',
49876 & ' Chi<SUB>b2</SUB>(2P)',
49877 & ' $&Upsilon(3S)$',
49879 DATA ((TXNAME(J,I),J=1,2),I=393,400)/
49880 & ' $&Upsilon(4S)$',
49885 & ' omega<SUB>3</SUB>',
49887 & ' phi<SUB>3</SUB>',
49889 & ' eta<SUB>2</SUB>(L)',
49891 & ' eta<SUB>2</SUB>(H)',
49896 DATA ((TXNAME(J,I),J=1,2),I=401,408)/
49897 & ' $&tilde{&rm d}_{&rm L}$',
49898 & ' ~d<SUB>L</SUB>',
49899 & ' $&tilde{&rm u}_{&rm L}$',
49900 & ' ~u<SUB>L</SUB>',
49901 & ' $&tilde{&rm s}_{&rm L}$',
49902 & ' ~s<SUB>L</SUB>',
49903 & ' $&tilde{&rm c}_{&rm L}$',
49904 & ' ~c<SUB>L</SUB>',
49905 & ' $&tilde{&rm b}_1$',
49906 & ' ~b<SUB>1</SUB>',
49907 & ' $&tilde{&rm t}_1$',
49908 & ' ~t<SUB>1</SUB>',
49909 & ' $&overline{&tilde{&rm d}}_{&rm L}$',
49910 & ' -~d<SUB>L</SUB>',
49911 & ' $&overline{&tilde{&rm u}}_{&rm L}$',
49912 & ' -~u<SUB>L</SUB>'/
49913 DATA ((TXNAME(J,I),J=1,2),I=409,416)/
49914 & ' $&overline{&tilde{&rm s}}_{&rm L}$',
49915 & ' -~s<SUB>L</SUB>',
49916 & ' $&overline{&tilde{&rm c}}_{&rm L}$',
49917 & ' -~c<SUB>L</SUB>',
49918 & ' $&overline{&tilde{&rm b}}_1$',
49919 & ' -~b<SUB>1</SUB>',
49920 & ' $&overline{&tilde{&rm t}}_1$',
49921 & ' -~t<SUB>1</SUB>',
49922 & ' $&tilde{&rm d}_{&rm R}$',
49923 & ' ~d<SUB>R</SUB>',
49924 & ' $&tilde{&rm u}_{&rm R}$',
49925 & ' ~u<SUB>R</SUB>',
49926 & ' $&tilde{&rm s}_{&rm R}$',
49927 & ' ~s<SUB>R</SUB>',
49928 & ' $&tilde{&rm c}_{&rm R}$',
49929 & ' ~c<SUB>R</SUB>'/
49930 DATA ((TXNAME(J,I),J=1,2),I=417,424)/
49931 & ' $&tilde{&rm b}_2$',
49932 & ' ~b<SUB>2</SUB>',
49933 & ' $&tilde{&rm t}_2$',
49934 & ' ~t<SUB>2</SUB>',
49935 & ' $&overline{&tilde{&rm d}}_{&rm R}$',
49936 & ' -~d<SUB>R</SUB>',
49937 & ' $&overline{&tilde{&rm u}}_{&rm R}$',
49938 & ' -~u<SUB>R</SUB>',
49939 & ' $&overline{&tilde{&rm s}}_{&rm R}$',
49940 & ' -~s<SUB>R</SUB>',
49941 & ' $&overline{&tilde{&rm c}}_{&rm R}$',
49942 & ' -~c<SUB>R</SUB>',
49943 & ' $&overline{&tilde{&rm b}}_2$',
49944 & ' -~b<SUB>2</SUB>',
49945 & ' $&overline{&tilde{&rm t}}_2$',
49946 & ' -~t<SUB>2</SUB>'/
49947 DATA ((TXNAME(J,I),J=1,2),I=425,432)/
49948 & ' $&tilde{&rm e}^-_{&rm L}$',
49949 & ' ~e<SUP>-</SUP><SUB>L</SUB>',
49950 & ' $&tilde{&nu}_{&rm e}$',
49951 & ' ~nu<SUB>e L</SUB>',
49952 & ' $&tilde{&mu}^-_{&rm L}$',
49953 & ' ~mu<SUP>-</SUP><SUB>L</SUB>',
49954 & ' $&tilde{&nu}_&mu$',
49955 & ' ~nu<SUB>mu L</SUB>',
49956 & ' $&tilde{&tau}^-_1$',
49957 & ' ~tau<SUP>-</SUP><SUB>1</SUB>',
49958 & ' $&tilde{&nu}_&tau$',
49959 & ' ~nu<SUB>tau L</SUB>',
49960 & ' $&tilde{&rm e}^+_{&rm L}$',
49961 & ' ~e<SUP>+</SUP><SUB>L</SUB>',
49962 & ' $&overline{&tilde{&nu}}_{&rm eL}$',
49963 & ' -~nu<SUB>eL</SUB>'/
49964 DATA ((TXNAME(J,I),J=1,2),I=433,440)/
49965 & ' $&tilde{&mu}^+_{&rm L}$',
49966 & ' ~mu<SUP>+</SUP><SUB>L</SUB>',
49967 & ' $&overline{&tilde{&nu}}_{&rm&mu L}$',
49968 & ' -~nu<SUB>mu L</SUB>',
49969 & ' $&tilde{&tau}^+_1$',
49970 & ' ~tau<SUP>+</SUP><SUB>1</SUB>',
49971 & ' $&overline{&tilde{&nu}}_{&rm&tau L}$',
49972 & ' -~nu<SUB>tau L</SUB>',
49973 & ' $&tilde{&rm e}^-_{&rm R}$',
49974 & ' ~e<SUP>-</SUP><SUB>R</SUB>',
49975 & ' $&tilde{&nu}_{&rm eR}$',
49976 & ' ~nu<SUB>e R</SUB>',
49977 & ' $&tilde{&mu}^-_{&rm R}$',
49978 & ' ~mu<SUP>-</SUP><SUB>R</SUB>',
49979 & ' $&tilde{&nu}_{&mu{&rm R}}$',
49980 & ' ~nu<SUB>mu R</SUB>'/
49981 DATA ((TXNAME(J,I),J=1,2),I=441,448)/
49982 & ' $&tilde{&tau}^-_2$',
49983 & ' ~tau<SUP>-</SUP><SUB>2</SUB>',
49984 & ' $&tilde{&nu}_{&tau{&rm R}}$',
49985 & ' ~nu<SUB>tau R</SUB>',
49986 & ' $&tilde{&rm e}^+_{&rm R}$',
49987 & ' ~e<SUP>+</SUP><SUB>R</SUB>',
49988 & ' $&overline{&tilde{&nu}}_{&rm eR}$',
49989 & ' -~nu<SUB>e R</SUB>',
49990 & ' $&tilde{&mu}^+_{&rm R}$',
49991 & ' ~mu<SUP>+</SUP><SUB>R</SUB>',
49992 & ' $&overline{&tilde{&nu}}_{&rm&mu R}$',
49993 & ' -~nu<SUB>mu R</SUB>',
49994 & ' $&tilde{&tau}^+_2$',
49995 & ' ~tau<SUP>+</SUP><SUB>2</SUB>',
49996 & ' $&overline{&tilde{&nu}}_{&rm&tau R}$',
49997 & ' -~nu<SUB>tau R</SUB>'/
49998 DATA ((TXNAME(J,I),J=1,2),I=449,456)/
50001 & ' $&tilde{&chi}^0_1$',
50002 & ' ~chi<SUP>0</SUP><SUB>1</SUB>',
50003 & ' $&tilde{&chi}^0_2$',
50004 & ' ~chi<SUP>0</SUP><SUB>2</SUB>',
50005 & ' $&tilde{&chi}^0_3$',
50006 & ' ~chi<SUP>0</SUP><SUB>3</SUB>',
50007 & ' $&tilde{&chi}^0_4$',
50008 & ' ~chi<SUP>0</SUP><SUB>4</SUB>',
50009 & ' $&tilde{&chi}^+_1$',
50010 & ' ~chi<SUP>+</SUP><SUB>1</SUB>',
50011 & ' $&tilde{&chi}^+_2$',
50012 & ' ~chi<SUP>+</SUP><SUB>2</SUB>',
50013 & ' $&tilde{&chi}^-_1$',
50014 & ' ~chi<SUP>-</SUP><SUB>1</SUB>'/
50015 DATA ((TXNAME(J,I),J=1,2),I=457,NLAST)/
50016 & ' $&tilde{&chi}^-_2$',
50017 & ' ~chi<SUP>-</SUP><SUB>2</SUB>',
50021 DATA (RNAME(I),I=NNEXT,NMXRES)/NLEFT*' '/
50022 DATA (IDPDG(I),I=NNEXT,NMXRES)/NLEFT*0/
50023 DATA (IFLAV(I),I=NNEXT,NMXRES)/NLEFT*0/
50024 DATA (RMASS(I),I=NNEXT,NMXRES)/NLEFT*0.0000D0/
50025 DATA (RLTIM(I),I=NNEXT,NMXRES)/NLEFT*0.000D+00/
50026 DATA (RSPIN(I),I=NNEXT,NMXRES)/NLEFT*0.0D0/
50027 DATA (TXNAME(1,I),I=NNEXT,NMXRES)/
50029 DATA (TXNAME(2,I),I=NNEXT,NMXRES)/
50032 DATA (RSTAB(I),I=1,NMXRES)/NMXRES*.FALSE./
50033 DATA DKPSET/.FALSE./
50036 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 1, 19)/
50037 & 6,0.334D0,100, 2, 7, 5, 0, 0,
50038 & 6,0.333D0,100, 4, 9, 5, 0, 0,
50039 & 6,0.111D0,100,122,127, 5, 0, 0,
50040 & 6,0.111D0,100,124,129, 5, 0, 0,
50041 & 6,0.111D0,100,126,131, 5, 0, 0,
50042 & 12,0.334D0,100, 8, 1, 11, 0, 0,
50043 & 12,0.333D0,100, 10, 3, 11, 0, 0,
50044 & 12,0.111D0,100,128,121, 11, 0, 0,
50045 & 12,0.111D0,100,130,123, 11, 0, 0,
50046 & 12,0.111D0,100,132,125, 11, 0, 0,
50047 & 21,0.988D0, 0, 59, 59, 0, 0, 0,
50048 & 21,0.012D0, 0,127,121, 59, 0, 0,
50049 & 22,0.388D0, 0, 59, 59, 0, 0, 0,
50050 & 22,0.319D0, 0, 21, 21, 21, 0, 0,
50051 & 22,0.001D0, 0, 21, 59, 59, 0, 0,
50052 & 22,0.236D0, 0, 38, 30, 21, 0, 0,
50053 & 22,0.049D0, 0, 38, 30, 59, 0, 0,
50054 & 22,0.005D0, 0,127,121, 59, 0, 0,
50055 & 22,0.002D0, 0, 38, 30,127,121, 0/
50056 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 20, 38)/
50057 & 23,0.989D0, 0, 38, 30, 0, 0, 0,
50058 & 23,0.010D0, 0, 38, 30, 59, 0, 0,
50059 & 23,0.001D0, 0, 21, 59, 0, 0, 0,
50060 & 24,0.888D0, 0, 38, 30, 21, 0, 0,
50061 & 24,0.085D0, 0, 21, 59, 0, 0, 0,
50062 & 24,0.022D0, 0, 38, 30, 0, 0, 0,
50063 & 24,0.001D0, 0, 22, 59, 0, 0, 0,
50064 & 24,0.001D0, 0, 21,127,121, 0, 0,
50065 & 24,0.003D0, 0, 38, 30, 21, 21, 0,
50066 & 25,0.437D0, 0, 38, 30, 22, 0, 0,
50067 & 25,0.302D0, 0, 23, 59, 0, 0, 0,
50068 & 25,0.208D0, 0, 21, 21, 22, 0, 0,
50069 & 25,0.030D0, 0, 24, 59, 0, 0, 0,
50070 & 25,0.021D0, 0, 59, 59, 0, 0, 0,
50071 & 25,0.002D0, 0, 21, 21, 21, 0, 0,
50072 & 26,0.566D0, 0, 38, 30, 0, 0, 0,
50073 & 26,0.283D0, 0, 21, 21, 0, 0, 0,
50074 & 26,0.069D0, 0, 38, 30, 21, 21, 0,
50075 & 26,0.023D0, 0, 46, 34, 0, 0, 0/
50076 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 39, 57)/
50077 & 26,0.023D0, 0, 50, 42, 0, 0, 0,
50078 & 26,0.028D0, 0, 38, 38, 30, 30, 0,
50079 & 26,0.005D0, 0, 22, 22, 0, 0, 0,
50080 & 26,0.003D0, 0, 21, 21, 21, 21, 0,
50081 & 27,0.499D0, 0, 39, 30, 0, 0, 0,
50082 & 27,0.499D0, 0, 31, 38, 0, 0, 0,
50083 & 27,0.002D0, 0, 21, 59, 59, 0, 0,
50084 & 28,0.148D0, 0, 21, 21, 38, 30, 0,
50085 & 28,0.148D0, 0, 23, 38, 30, 0, 0,
50086 & 28,0.147D0, 0,291, 30, 0, 0, 0,
50087 & 28,0.147D0, 0,290, 21, 0, 0, 0,
50088 & 28,0.147D0, 0,292, 38, 0, 0, 0,
50089 & 28,0.067D0, 0, 22, 38, 30, 0, 0,
50090 & 28,0.033D0, 0, 22, 21, 21, 0, 0,
50091 & 28,0.032D0, 0, 46, 42, 30, 0, 0,
50092 & 28,0.016D0, 0, 46, 34, 21, 0, 0,
50093 & 28,0.016D0, 0, 50, 42, 21, 0, 0,
50094 & 28,0.032D0, 0, 50, 34, 38, 0, 0,
50095 & 28,0.066D0, 0, 59, 23, 0, 0, 0/
50096 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 58, 76)/
50097 & 28,0.001D0, 0, 56, 59, 0, 0, 0,
50098 & 29,0.349D0, 0, 39, 30, 0, 0, 0,
50099 & 29,0.349D0, 0, 31, 38, 0, 0, 0,
50100 & 29,0.144D0, 0, 22, 21, 0, 0, 0,
50101 & 29,0.104D0, 0, 24, 38, 30, 0, 0,
50102 & 29,0.024D0, 0, 46, 34, 0, 0, 0,
50103 & 29,0.024D0, 0, 50, 42, 0, 0, 0,
50104 & 29,0.006D0, 0, 25, 21, 0, 0, 0,
50105 & 30,1.000D0, 0,123,130, 0, 0, 0,
50106 & 31,1.000D0, 0, 30, 21, 0, 0, 0,
50107 & 32,0.499D0, 0, 31, 21, 0, 0, 0,
50108 & 32,0.499D0, 0, 23, 30, 0, 0, 0,
50109 & 32,0.002D0, 0, 30, 59, 0, 0, 0,
50110 & 33,0.349D0, 0, 31, 21, 0, 0, 0,
50111 & 33,0.349D0, 0, 23, 30, 0, 0, 0,
50112 & 33,0.144D0, 0, 22, 30, 0, 0, 0,
50113 & 33,0.101D0, 0, 24, 30, 21, 0, 0,
50114 & 33,0.048D0, 0, 50, 34, 0, 0, 0,
50115 & 33,0.006D0, 0, 25, 30, 0, 0, 0/
50116 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 77, 95)/
50117 & 33,0.003D0, 0, 30, 59, 0, 0, 0,
50118 & 34,0.629D0, 0,123,130, 0, 0, 0,
50119 & 34,0.212D0, 0, 30, 21, 0, 0, 0,
50120 & 34,0.056D0, 0, 30, 38, 30, 0, 0,
50121 & 34,0.017D0, 0, 30, 21, 21, 0, 0,
50122 & 34,0.048D0,101,121,128, 21, 0, 0,
50123 & 34,0.032D0,101,123,130, 21, 0, 0,
50124 & 34,0.006D0, 0,123,130, 59, 0, 0,
50125 & 35,0.666D0, 0, 42, 30, 0, 0, 0,
50126 & 35,0.333D0, 0, 34, 21, 0, 0, 0,
50127 & 35,0.001D0, 0, 34, 59, 0, 0, 0,
50128 & 36,0.627D0, 0, 43, 30, 0, 0, 0,
50129 & 36,0.313D0, 0, 35, 21, 0, 0, 0,
50130 & 36,0.020D0, 0, 42, 31, 0, 0, 0,
50131 & 36,0.010D0, 0, 34, 23, 0, 0, 0,
50132 & 36,0.020D0, 0, 34,294, 0, 0, 0,
50133 & 36,0.010D0, 0, 34, 24, 0, 0, 0,
50134 & 37,0.331D0, 0, 42, 30, 0, 0, 0,
50135 & 37,0.166D0, 0, 34, 21, 0, 0, 0/
50136 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 96, 114)/
50137 & 37,0.168D0, 0, 43, 30, 0, 0, 0,
50138 & 37,0.084D0, 0, 35, 21, 0, 0, 0,
50139 & 37,0.087D0, 0, 35, 38, 30, 0, 0,
50140 & 37,0.044D0, 0, 35, 21, 21, 0, 0,
50141 & 37,0.059D0, 0, 42, 31, 0, 0, 0,
50142 & 37,0.029D0, 0, 34, 23, 0, 0, 0,
50143 & 37,0.029D0, 0, 34, 24, 0, 0, 0,
50144 & 37,0.002D0, 0, 34, 59, 0, 0, 0,
50145 & 37,0.001D0, 0, 34, 22, 0, 0, 0,
50146 & 38,1.000D0, 0,129,124, 0, 0, 0,
50147 & 39,1.000D0, 0, 38, 21, 0, 0, 0,
50148 & 40,0.499D0, 0, 39, 21, 0, 0, 0,
50149 & 40,0.499D0, 0, 23, 38, 0, 0, 0,
50150 & 40,0.002D0, 0, 38, 59, 0, 0, 0,
50151 & 41,0.349D0, 0, 39, 21, 0, 0, 0,
50152 & 41,0.349D0, 0, 23, 38, 0, 0, 0,
50153 & 41,0.144D0, 0, 22, 38, 0, 0, 0,
50154 & 41,0.101D0, 0, 24, 38, 21, 0, 0,
50155 & 41,0.048D0, 0, 46, 42, 0, 0, 0/
50156 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 115, 133)/
50157 & 41,0.006D0, 0, 25, 38, 0, 0, 0,
50158 & 41,0.003D0, 0, 38, 59, 0, 0, 0,
50159 & 42,0.500D0, 0, 60, 0, 0, 0, 0,
50160 & 42,0.500D0, 0, 61, 0, 0, 0, 0,
50161 & 43,0.665D0, 0, 34, 38, 0, 0, 0,
50162 & 43,0.333D0, 0, 42, 21, 0, 0, 0,
50163 & 43,0.002D0, 0, 42, 59, 0, 0, 0,
50164 & 44,0.627D0, 0, 35, 38, 0, 0, 0,
50165 & 44,0.313D0, 0, 43, 21, 0, 0, 0,
50166 & 44,0.020D0, 0, 34, 39, 0, 0, 0,
50167 & 44,0.010D0, 0, 42, 23, 0, 0, 0,
50168 & 44,0.020D0, 0, 42,294, 0, 0, 0,
50169 & 44,0.010D0, 0, 42, 24, 0, 0, 0,
50170 & 45,0.331D0, 0, 34, 38, 0, 0, 0,
50171 & 45,0.166D0, 0, 42, 21, 0, 0, 0,
50172 & 45,0.168D0, 0, 35, 38, 0, 0, 0,
50173 & 45,0.084D0, 0, 43, 21, 0, 0, 0,
50174 & 45,0.089D0, 0, 42, 38, 30, 0, 0,
50175 & 45,0.044D0, 0, 42, 21, 21, 0, 0/
50176 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 134, 152)/
50177 & 45,0.059D0, 0, 34, 39, 0, 0, 0,
50178 & 45,0.029D0, 0, 42, 23, 0, 0, 0,
50179 & 45,0.029D0, 0, 42, 24, 0, 0, 0,
50180 & 45,0.001D0, 0, 42, 22, 0, 0, 0,
50181 & 46,0.629D0, 0,129,124, 0, 0, 0,
50182 & 46,0.212D0, 0, 38, 21, 0, 0, 0,
50183 & 46,0.056D0, 0, 38, 38, 30, 0, 0,
50184 & 46,0.017D0, 0, 38, 21, 21, 0, 0,
50185 & 46,0.032D0,101,129,124, 21, 0, 0,
50186 & 46,0.048D0,101,127,122, 21, 0, 0,
50187 & 46,0.006D0, 0,129,124, 59, 0, 0,
50188 & 47,0.666D0, 0, 50, 38, 0, 0, 0,
50189 & 47,0.333D0, 0, 46, 21, 0, 0, 0,
50190 & 47,0.001D0, 0, 46, 59, 0, 0, 0,
50191 & 48,0.627D0, 0, 51, 38, 0, 0, 0,
50192 & 48,0.313D0, 0, 47, 21, 0, 0, 0,
50193 & 48,0.020D0, 0, 50, 39, 0, 0, 0,
50194 & 48,0.010D0, 0, 46, 23, 0, 0, 0,
50195 & 48,0.020D0, 0, 46,294, 0, 0, 0/
50196 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 153, 171)/
50197 & 48,0.010D0, 0, 46, 24, 0, 0, 0,
50198 & 49,0.331D0, 0, 50, 38, 0, 0, 0,
50199 & 49,0.166D0, 0, 46, 21, 0, 0, 0,
50200 & 49,0.168D0, 0, 51, 38, 0, 0, 0,
50201 & 49,0.084D0, 0, 47, 21, 0, 0, 0,
50202 & 49,0.087D0, 0, 47, 38, 30, 0, 0,
50203 & 49,0.044D0, 0, 47, 21, 21, 0, 0,
50204 & 49,0.059D0, 0, 50, 39, 0, 0, 0,
50205 & 49,0.029D0, 0, 46, 23, 0, 0, 0,
50206 & 49,0.029D0, 0, 46, 24, 0, 0, 0,
50207 & 49,0.002D0, 0, 46, 59, 0, 0, 0,
50208 & 49,0.001D0, 0, 46, 22, 0, 0, 0,
50209 & 50,0.500D0, 0, 60, 0, 0, 0, 0,
50210 & 50,0.500D0, 0, 61, 0, 0, 0, 0,
50211 & 51,0.665D0, 0, 46, 30, 0, 0, 0,
50212 & 51,0.333D0, 0, 50, 21, 0, 0, 0,
50213 & 51,0.002D0, 0, 50, 59, 0, 0, 0,
50214 & 52,0.627D0, 0, 47, 30, 0, 0, 0,
50215 & 52,0.313D0, 0, 51, 21, 0, 0, 0/
50216 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 172, 190)/
50217 & 52,0.020D0, 0, 46, 31, 0, 0, 0,
50218 & 52,0.010D0, 0, 50, 23, 0, 0, 0,
50219 & 52,0.020D0, 0, 50,294, 0, 0, 0,
50220 & 52,0.010D0, 0, 50, 24, 0, 0, 0,
50221 & 53,0.331D0, 0, 46, 30, 0, 0, 0,
50222 & 53,0.166D0, 0, 50, 21, 0, 0, 0,
50223 & 53,0.168D0, 0, 47, 30, 0, 0, 0,
50224 & 53,0.084D0, 0, 51, 21, 0, 0, 0,
50225 & 53,0.089D0, 0, 50, 38, 30, 0, 0,
50226 & 53,0.044D0, 0, 50, 21, 21, 0, 0,
50227 & 53,0.059D0, 0, 46, 31, 0, 0, 0,
50228 & 53,0.029D0, 0, 50, 23, 0, 0, 0,
50229 & 53,0.029D0, 0, 50, 24, 0, 0, 0,
50230 & 53,0.001D0, 0, 50, 22, 0, 0, 0,
50231 & 56,0.490D0, 0, 46, 34, 0, 0, 0,
50232 & 56,0.342D0, 0, 61, 60, 0, 0, 0,
50233 & 56,0.043D0, 0, 39, 30, 0, 0, 0,
50234 & 56,0.043D0, 0, 23, 21, 0, 0, 0,
50235 & 56,0.043D0, 0, 31, 38, 0, 0, 0/
50236 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 191, 209)/
50237 & 56,0.025D0, 0, 38, 30, 21, 0, 0,
50238 & 56,0.013D0, 0, 22, 59, 0, 0, 0,
50239 & 56,0.001D0, 0, 21, 59, 0, 0, 0,
50240 & 57,0.250D0, 0, 50, 43, 0, 0, 0,
50241 & 57,0.250D0, 0, 34, 47, 0, 0, 0,
50242 & 57,0.250D0, 0, 42, 51, 0, 0, 0,
50243 & 57,0.250D0, 0, 46, 35, 0, 0, 0,
50244 & 58,0.356D0, 0, 46, 34, 0, 0, 0,
50245 & 58,0.356D0, 0, 50, 42, 0, 0, 0,
50246 & 58,0.279D0, 0, 22, 22, 0, 0, 0,
50247 & 58,0.006D0, 0, 38, 30, 0, 0, 0,
50248 & 58,0.003D0, 0, 21, 21, 0, 0, 0,
50249 & 60,0.684D0, 0, 38, 30, 0, 0, 0,
50250 & 60,0.314D0, 0, 21, 21, 0, 0, 0,
50251 & 60,0.002D0, 0, 38, 30, 59, 0, 0,
50252 & 61,0.216D0, 0, 21, 21, 21, 0, 0,
50253 & 61,0.124D0, 0, 38, 30, 21, 0, 0,
50254 & 61,0.135D0,101,123,130, 38, 0, 0,
50255 & 61,0.135D0,101,124,129, 30, 0, 0/
50256 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 210, 228)/
50257 & 61,0.187D0,101,121,128, 38, 0, 0,
50258 & 61,0.187D0,101,122,127, 30, 0, 0,
50259 & 61,0.006D0, 0,121,128, 38, 59, 0,
50260 & 61,0.006D0, 0,122,127, 30, 59, 0,
50261 & 61,0.002D0, 0, 38, 30, 0, 0, 0,
50262 & 61,0.001D0, 0, 21, 21, 0, 0, 0,
50263 & 61,0.001D0, 0, 59, 59, 0, 0, 0,
50264 & 74,0.663D0, 0, 73, 21, 0, 0, 0,
50265 & 74,0.331D0, 0, 75, 38, 0, 0, 0,
50266 & 74,0.006D0, 0, 73, 59, 0, 0, 0,
50267 & 75,1.000D0,101,121,128, 73, 0, 0,
50268 & 76,0.663D0, 0, 75, 21, 0, 0, 0,
50269 & 76,0.331D0, 0, 73, 30, 0, 0, 0,
50270 & 76,0.006D0, 0, 75, 59, 0, 0, 0,
50271 & 77,1.000D0, 0, 75, 30, 0, 0, 0,
50272 & 78,0.638D0, 0, 73, 30, 0, 0, 0,
50273 & 78,0.358D0, 0, 75, 21, 0, 0, 0,
50274 & 78,0.002D0, 0, 75, 59, 0, 0, 0,
50275 & 78,0.001D0, 0, 73, 30, 59, 0, 0/
50276 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 229, 247)/
50277 & 78,0.001D0,101,121,128, 73, 0, 0,
50278 & 79,0.995D0, 0, 78, 59, 0, 0, 0,
50279 & 79,0.005D0, 0, 78,127,121, 0, 0,
50280 & 80,0.880D0, 0, 78, 21, 0, 0, 0,
50281 & 80,0.060D0, 0, 86, 30, 0, 0, 0,
50282 & 80,0.060D0, 0, 81, 38, 0, 0, 0,
50283 & 81,0.998D0, 0, 75, 30, 0, 0, 0,
50284 & 81,0.001D0, 0, 75, 30, 59, 0, 0,
50285 & 81,0.001D0,101,121,128, 75, 0, 0,
50286 & 82,0.880D0, 0, 78, 30, 0, 0, 0,
50287 & 82,0.060D0, 0, 79, 30, 0, 0, 0,
50288 & 82,0.060D0, 0, 81, 21, 0, 0, 0,
50289 & 83,0.999D0, 0, 78, 30, 0, 0, 0,
50290 & 83,0.001D0,101,121,128, 78, 0, 0,
50291 & 84,0.667D0, 0, 88, 30, 0, 0, 0,
50292 & 84,0.333D0, 0, 83, 21, 0, 0, 0,
50293 & 85,1.000D0, 0, 73, 38, 0, 0, 0,
50294 & 86,0.516D0, 0, 73, 21, 0, 0, 0,
50295 & 86,0.483D0, 0, 75, 38, 0, 0, 0/
50296 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 248, 266)/
50297 & 86,0.001D0, 0, 73, 59, 0, 0, 0,
50298 & 87,0.880D0, 0, 78, 38, 0, 0, 0,
50299 & 87,0.060D0, 0, 86, 21, 0, 0, 0,
50300 & 87,0.060D0, 0, 79, 38, 0, 0, 0,
50301 & 88,0.995D0, 0, 78, 21, 0, 0, 0,
50302 & 88,0.001D0, 0, 78, 59, 0, 0, 0,
50303 & 88,0.004D0, 0, 79, 59, 0, 0, 0,
50304 & 89,0.667D0, 0, 83, 38, 0, 0, 0,
50305 & 89,0.333D0, 0, 88, 21, 0, 0, 0,
50306 & 90,0.675D0, 0, 78, 34, 0, 0, 0,
50307 & 90,0.233D0, 0, 88, 30, 0, 0, 0,
50308 & 90,0.086D0, 0, 83, 21, 0, 0, 0,
50309 & 90,0.006D0,101,121,128, 88, 0, 0,
50310 & 92,0.663D0, 0, 91, 21, 0, 0, 0,
50311 & 92,0.331D0, 0, 93, 30, 0, 0, 0,
50312 & 92,0.006D0, 0, 91, 59, 0, 0, 0,
50313 & 93,1.000D0,101,127,122, 91, 0, 0,
50314 & 94,0.663D0, 0, 93, 21, 0, 0, 0,
50315 & 94,0.331D0, 0, 91, 38, 0, 0, 0/
50316 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 267, 285)/
50317 & 94,0.006D0, 0, 93, 59, 0, 0, 0,
50318 & 95,1.000D0, 0, 93, 38, 0, 0, 0,
50319 & 96,0.638D0, 0, 91, 38, 0, 0, 0,
50320 & 96,0.358D0, 0, 93, 21, 0, 0, 0,
50321 & 96,0.002D0, 0, 93, 59, 0, 0, 0,
50322 & 96,0.001D0, 0, 91, 38, 59, 0, 0,
50323 & 96,0.001D0,101,127,122, 91, 0, 0,
50324 & 97,0.995D0, 0, 96, 59, 0, 0, 0,
50325 & 97,0.005D0, 0, 96,127,121, 0, 0,
50326 & 98,0.880D0, 0, 96, 21, 0, 0, 0,
50327 & 98,0.060D0, 0,104, 38, 0, 0, 0,
50328 & 98,0.060D0, 0, 99, 30, 0, 0, 0,
50329 & 99,0.998D0, 0, 93, 38, 0, 0, 0,
50330 & 99,0.001D0, 0, 93, 38, 59, 0, 0,
50331 & 99,0.001D0,101,127,122, 93, 0, 0,
50332 & 100,0.880D0, 0, 96, 38, 0, 0, 0,
50333 & 100,0.060D0, 0, 97, 38, 0, 0, 0,
50334 & 100,0.060D0, 0, 99, 21, 0, 0, 0,
50335 & 101,0.999D0, 0, 96, 38, 0, 0, 0/
50336 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 286, 304)/
50337 & 101,0.001D0,101,127,122, 96, 0, 0,
50338 & 102,0.667D0, 0,106, 38, 0, 0, 0,
50339 & 102,0.333D0, 0,101, 21, 0, 0, 0,
50340 & 103,1.000D0, 0, 91, 30, 0, 0, 0,
50341 & 104,0.516D0, 0, 91, 21, 0, 0, 0,
50342 & 104,0.483D0, 0, 93, 30, 0, 0, 0,
50343 & 104,0.001D0, 0, 91, 59, 0, 0, 0,
50344 & 105,0.880D0, 0, 96, 30, 0, 0, 0,
50345 & 105,0.060D0, 0,104, 21, 0, 0, 0,
50346 & 105,0.060D0, 0, 97, 30, 0, 0, 0,
50347 & 106,0.995D0, 0, 96, 21, 0, 0, 0,
50348 & 106,0.001D0, 0, 96, 59, 0, 0, 0,
50349 & 106,0.004D0, 0, 97, 59, 0, 0, 0,
50350 & 107,0.667D0, 0,101, 30, 0, 0, 0,
50351 & 107,0.333D0, 0,106, 21, 0, 0, 0,
50352 & 108,0.675D0, 0, 96, 46, 0, 0, 0,
50353 & 108,0.233D0, 0,106, 38, 0, 0, 0,
50354 & 108,0.086D0, 0,101, 21, 0, 0, 0,
50355 & 108,0.006D0,101,127,122,106, 0, 0/
50356 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 305, 323)/
50357 & 123,0.986D0,100,121,128,124, 0, 0,
50358 & 123,0.014D0, 0,121,128,124, 59, 0,
50359 & 125,0.178D0,100,121,128,126, 0, 0,
50360 & 125,0.171D0,100,123,130,126, 0, 0,
50361 & 125,0.002D0, 0,123,130, 59,126, 0,
50362 & 125,0.111D0, 0, 30,126, 0, 0, 0,
50363 & 125,0.253D0, 0, 31,126, 0, 0, 0,
50364 & 125,0.181D0, 0, 32,126, 0, 0, 0,
50365 & 125,0.002D0, 0, 30, 22, 21,126, 0,
50366 & 125,0.018D0, 0, 30, 24,126, 0, 0,
50367 & 125,0.004D0, 0, 30, 24, 21,126, 0,
50368 & 125,0.015D0, 0, 31, 23,126, 0, 0,
50369 & 125,0.001D0, 0, 31, 24, 21,126, 0,
50370 & 125,0.024D0, 0, 32, 21,126, 0, 0,
50371 & 125,0.002D0, 0, 32, 38, 30,126, 0,
50372 & 125,0.007D0, 0, 34,126, 0, 0, 0,
50373 & 125,0.014D0, 0, 35,126, 0, 0, 0,
50374 & 125,0.003D0, 0, 35, 21,126, 0, 0,
50375 & 125,0.001D0, 0, 34, 38, 30,126, 0/
50376 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 324, 342)/
50377 & 125,0.004D0, 0, 30, 43,126, 0, 0,
50378 & 125,0.003D0, 0, 34, 50,126, 0, 0,
50379 & 125,0.003D0, 0, 34, 51,126, 0, 0,
50380 & 125,0.003D0, 0, 30, 50, 42,126, 0,
50381 & 129,0.986D0,100,127,122,130, 0, 0,
50382 & 129,0.014D0, 0,127,122,130, 59, 0,
50383 & 131,0.178D0,100,127,122,132, 0, 0,
50384 & 131,0.171D0,100,129,124,132, 0, 0,
50385 & 131,0.002D0, 0,129,124, 59,132, 0,
50386 & 131,0.111D0, 0, 38,132, 0, 0, 0,
50387 & 131,0.253D0, 0, 39,132, 0, 0, 0,
50388 & 131,0.181D0, 0, 40,132, 0, 0, 0,
50389 & 131,0.002D0, 0, 38, 22, 21,132, 0,
50390 & 131,0.018D0, 0, 38, 24,132, 0, 0,
50391 & 131,0.004D0, 0, 38, 24, 21,132, 0,
50392 & 131,0.015D0, 0, 39, 23,132, 0, 0,
50393 & 131,0.001D0, 0, 39, 24, 21,132, 0,
50394 & 131,0.024D0, 0, 40, 21,132, 0, 0,
50395 & 131,0.002D0, 0, 40, 38, 30,132, 0/
50396 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 343, 361)/
50397 & 131,0.007D0, 0, 46,132, 0, 0, 0,
50398 & 131,0.014D0, 0, 47,132, 0, 0, 0,
50399 & 131,0.003D0, 0, 47, 21,132, 0, 0,
50400 & 131,0.001D0, 0, 46, 38, 30,132, 0,
50401 & 131,0.004D0, 0, 38, 51,132, 0, 0,
50402 & 131,0.003D0, 0, 46, 42,132, 0, 0,
50403 & 131,0.003D0, 0, 46, 43,132, 0, 0,
50404 & 131,0.003D0, 0, 38, 50, 42,132, 0,
50405 & 136,0.067D0,101,122,127, 42, 0, 0,
50406 & 136,0.067D0,101,124,129, 42, 0, 0,
50407 & 136,0.048D0,101,122,127, 43, 0, 0,
50408 & 136,0.048D0,101,124,129, 43, 0, 0,
50409 & 136,0.003D0, 0, 34, 38,122,127, 0,
50410 & 136,0.003D0, 0, 34, 38,124,129, 0,
50411 & 136,0.006D0,101,122,127, 21, 0, 0,
50412 & 136,0.006D0,101,124,129, 21, 0, 0,
50413 & 136,0.002D0,101,122,127, 23, 0, 0,
50414 & 136,0.002D0,101,124,129, 23, 0, 0,
50415 & 136,0.055D0, 0, 34, 38, 38, 0, 0/
50416 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 362, 380)/
50417 & 136,0.031D0, 0, 34, 39, 38, 0, 0,
50418 & 136,0.042D0, 0, 34, 38, 38, 21, 21,
50419 & 136,0.002D0, 0, 34, 38, 38, 38, 31,
50420 & 136,0.021D0, 0, 35, 38, 38, 0, 0,
50421 & 136,0.027D0, 0, 42, 38, 0, 0, 0,
50422 & 136,0.066D0, 0, 42, 39, 0, 0, 0,
50423 & 136,0.081D0, 0, 42, 40, 0, 0, 0,
50424 & 136,0.024D0, 0, 42, 38, 21, 0, 0,
50425 & 136,0.004D0, 0, 42, 38, 23, 0, 0,
50426 & 136,0.069D0, 0, 42, 38, 38, 30, 21,
50427 & 136,0.001D0, 0, 42, 38, 38, 30, 23,
50428 & 136,0.022D0, 0, 43, 38, 0, 0, 0,
50429 & 136,0.021D0, 0, 43, 39, 0, 0, 0,
50430 & 136,0.042D0, 0, 43, 38, 21, 0, 0,
50431 & 136,0.008D0, 0, 43, 38, 23, 0, 0,
50432 & 136,0.010D0, 0, 43, 38, 38, 30, 0,
50433 & 136,0.050D0, 0,311, 38, 0, 0, 0,
50434 & 136,0.034D0, 0,329, 38, 0, 0, 0,
50435 & 136,0.010D0, 0,369, 38, 0, 0, 0/
50436 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 381, 399)/
50437 & 136,0.031D0, 0, 46, 42, 42, 0, 0,
50438 & 136,0.003D0, 0, 38, 21, 0, 0, 0,
50439 & 136,0.001D0, 0, 38, 23, 0, 0, 0,
50440 & 136,0.002D0, 0, 38, 38, 30, 0, 0,
50441 & 136,0.008D0, 0, 38, 22, 0, 0, 0,
50442 & 136,0.001D0, 0, 38, 38, 38, 30, 30,
50443 & 136,0.003D0, 0, 38, 38, 38, 30, 31,
50444 & 136,0.008D0, 0, 46, 42, 0, 0, 0,
50445 & 136,0.005D0, 0, 46, 43, 0, 0, 0,
50446 & 136,0.026D0, 0, 47, 43, 0, 0, 0,
50447 & 136,0.005D0, 0, 46, 34, 38, 0, 0,
50448 & 136,0.007D0, 0, 38, 56, 0, 0, 0,
50449 & 136,0.023D0, 0, 38, 56, 21, 0, 0,
50450 & 136,0.005D0, 0, 46, 46, 34, 0, 0,
50451 & 137,0.683D0, 0,140, 38, 0, 0, 0,
50452 & 137,0.306D0, 0,136, 21, 0, 0, 0,
50453 & 137,0.011D0, 0,136, 59, 0, 0, 0,
50454 & 138,0.667D0, 0,141, 38, 0, 0, 0,
50455 & 138,0.333D0, 0,137, 21, 0, 0, 0/
50456 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 400, 418)/
50457 & 139,0.220D0, 0,140, 38, 0, 0, 0,
50458 & 139,0.110D0, 0,136, 21, 0, 0, 0,
50459 & 139,0.380D0, 0,141, 38, 0, 0, 0,
50460 & 139,0.190D0, 0,137, 21, 0, 0, 0,
50461 & 139,0.004D0, 0,136, 22, 0, 0, 0,
50462 & 139,0.064D0, 0,141, 38, 21, 0, 0,
50463 & 139,0.032D0, 0,137, 38, 30, 0, 0,
50464 & 140,0.037D0,101,122,127, 34, 0, 0,
50465 & 140,0.037D0,101,124,129, 34, 0, 0,
50466 & 140,0.016D0,101,122,127, 35, 0, 0,
50467 & 140,0.016D0,101,124,129, 35, 0, 0,
50468 & 140,0.013D0, 0, 34, 21,122,127, 0,
50469 & 140,0.013D0, 0, 34, 21,124,129, 0,
50470 & 140,0.012D0, 0, 42, 30,122,127, 0,
50471 & 140,0.012D0, 0, 42, 30,124,129, 0,
50472 & 140,0.003D0,101,122,127, 30, 0, 0,
50473 & 140,0.003D0,101,124,129, 30, 0, 0,
50474 & 140,0.039D0, 0, 34, 38, 0, 0, 0,
50475 & 140,0.091D0, 0, 34, 39, 0, 0, 0/
50476 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 419, 437)/
50477 & 140,0.067D0, 0, 34, 40, 0, 0, 0,
50478 & 140,0.004D0, 0, 34, 38, 21, 0, 0,
50479 & 140,0.100D0, 0, 34, 38, 21, 21, 0,
50480 & 140,0.058D0, 0, 34, 38, 23, 0, 0,
50481 & 140,0.020D0, 0, 34, 38, 24, 0, 0,
50482 & 140,0.006D0, 0, 34, 38, 25, 0, 0,
50483 & 140,0.043D0, 0, 35, 38, 0, 0, 0,
50484 & 140,0.035D0, 0, 35, 39, 0, 0, 0,
50485 & 140,0.007D0, 0,312, 38, 0, 0, 0,
50486 & 140,0.007D0, 0,330, 38, 0, 0, 0,
50487 & 140,0.020D0, 0, 42, 21, 0, 0, 0,
50488 & 140,0.006D0, 0, 42, 22, 0, 0, 0,
50489 & 140,0.009D0, 0, 42, 23, 0, 0, 0,
50490 & 140,0.016D0, 0, 42, 24, 0, 0, 0,
50491 & 140,0.014D0, 0, 42, 25, 0, 0, 0,
50492 & 140,0.003D0, 0, 42,293, 0, 0, 0,
50493 & 140,0.007D0, 0, 42, 56, 0, 0, 0,
50494 & 140,0.003D0, 0, 42, 26, 0, 0, 0,
50495 & 140,0.004D0, 0, 42,294, 0, 0, 0/
50496 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 438, 456)/
50497 & 140,0.006D0, 0, 42, 21, 21, 0, 0,
50498 & 140,0.042D0, 0, 42, 38, 30, 21, 0,
50499 & 140,0.004D0, 0, 42, 38, 38, 30, 30,
50500 & 140,0.076D0, 0, 42, 38, 30, 21, 21,
50501 & 140,0.026D0, 0, 43, 21, 0, 0, 0,
50502 & 140,0.014D0, 0, 43, 22, 0, 0, 0,
50503 & 140,0.014D0, 0, 43, 23, 0, 0, 0,
50504 & 140,0.011D0, 0, 43, 24, 0, 0, 0,
50505 & 140,0.018D0, 0, 43, 38, 30, 0, 0,
50506 & 140,0.004D0, 0, 42, 46, 34, 0, 0,
50507 & 140,0.004D0, 0, 42, 46, 34, 21, 0,
50508 & 140,0.005D0, 0, 42, 42, 50, 0, 0,
50509 & 140,0.002D0, 0, 38, 30, 0, 0, 0,
50510 & 140,0.001D0, 0, 21, 21, 0, 0, 0,
50511 & 140,0.008D0, 0, 38, 30, 21, 0, 0,
50512 & 140,0.007D0, 0, 38, 38, 30, 30, 0,
50513 & 140,0.015D0, 0, 38, 38, 30, 30, 21,
50514 & 140,0.004D0, 0, 46, 34, 0, 0, 0,
50515 & 140,0.003D0, 0, 47, 34, 0, 0, 0/
50516 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 457, 475)/
50517 & 140,0.002D0, 0, 46, 35, 0, 0, 0,
50518 & 140,0.001D0, 0, 50, 42, 0, 0, 0,
50519 & 140,0.002D0, 0, 51, 43, 0, 0, 0,
50520 & 140,0.003D0, 0, 50, 34, 38, 0, 0,
50521 & 140,0.003D0, 0, 42, 46, 30, 0, 0,
50522 & 140,0.001D0, 0, 46, 34, 38, 30, 21,
50523 & 140,0.002D0, 0, 56, 23, 0, 0, 0,
50524 & 140,0.001D0, 0, 56, 38, 30, 0, 0,
50525 & 141,0.636D0, 0,140, 21, 0, 0, 0,
50526 & 141,0.364D0, 0,140, 59, 0, 0, 0,
50527 & 142,0.667D0, 0,137, 30, 0, 0, 0,
50528 & 142,0.333D0, 0,141, 21, 0, 0, 0,
50529 & 143,0.220D0, 0,136, 30, 0, 0, 0,
50530 & 143,0.110D0, 0,140, 21, 0, 0, 0,
50531 & 143,0.380D0, 0,137, 30, 0, 0, 0,
50532 & 143,0.190D0, 0,141, 21, 0, 0, 0,
50533 & 143,0.004D0, 0,140, 22, 0, 0, 0,
50534 & 143,0.064D0, 0,137, 30, 21, 0, 0,
50535 & 143,0.032D0, 0,141, 38, 30, 0, 0/
50536 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 476, 494)/
50537 & 144,0.009D0, 0,124,129, 0, 0, 0,
50538 & 144,0.019D0,101,122,127, 56, 0, 0,
50539 & 144,0.019D0,101,124,129, 56, 0, 0,
50540 & 144,0.025D0,101,122,127, 22, 0, 0,
50541 & 144,0.025D0,101,124,129, 22, 0, 0,
50542 & 144,0.009D0,101,122,127, 25, 0, 0,
50543 & 144,0.009D0,101,124,129, 25, 0, 0,
50544 & 144,0.036D0, 0, 46, 42, 0, 0, 0,
50545 & 144,0.034D0, 0, 46, 43, 0, 0, 0,
50546 & 144,0.007D0, 0, 46,329, 0, 0, 0,
50547 & 144,0.043D0, 0, 47, 42, 0, 0, 0,
50548 & 144,0.058D0, 0, 47, 43, 0, 0, 0,
50549 & 144,0.011D0, 0, 46, 34, 38, 0, 0,
50550 & 144,0.055D0, 0, 46, 34, 38, 21, 0,
50551 & 144,0.003D0, 0, 46, 34, 38, 38, 30,
50552 & 144,0.014D0, 0, 46, 42, 38, 30, 0,
50553 & 144,0.017D0, 0, 50, 34, 38, 38, 0,
50554 & 144,0.036D0, 0, 56, 38, 0, 0, 0,
50555 & 144,0.067D0, 0, 56, 39, 0, 0, 0/
50556 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 495, 513)/
50557 & 144,0.023D0, 0, 56, 38, 21, 0, 0,
50558 & 144,0.018D0, 0, 56, 38, 38, 30, 0,
50559 & 144,0.020D0, 0, 22, 38, 0, 0, 0,
50560 & 144,0.001D0, 0, 23, 38, 0, 0, 0,
50561 & 144,0.009D0, 0, 24, 38, 0, 0, 0,
50562 & 144,0.049D0, 0, 25, 38, 0, 0, 0,
50563 & 144,0.011D0, 0,293, 38, 0, 0, 0,
50564 & 144,0.015D0, 0, 22, 38, 21, 0, 0,
50565 & 144,0.016D0, 0, 25, 38, 21, 0, 0,
50566 & 144,0.103D0, 0, 22, 39, 0, 0, 0,
50567 & 144,0.120D0, 0, 25, 39, 0, 0, 0,
50568 & 144,0.010D0, 0, 38, 38, 30, 0, 0,
50569 & 144,0.046D0, 0, 38, 38, 30, 21, 0,
50570 & 144,0.003D0, 0, 38, 38, 38, 30, 30,
50571 & 144,0.042D0, 0, 38, 30, 30, 38, 39,
50572 & 144,0.001D0, 0, 46, 23, 0, 0, 0,
50573 & 144,0.005D0, 0, 46, 38, 30, 0, 0,
50574 & 144,0.001D0, 0, 46, 56, 0, 0, 0,
50575 & 144,0.004D0, 0, 50, 38, 0, 0, 0/
50576 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 514, 532)/
50577 & 144,0.007D0, 0, 51, 38, 0, 0, 0,
50578 & 145,0.900D0, 0,144, 59, 0, 0, 0,
50579 & 145,0.100D0, 0,144, 21, 0, 0, 0,
50580 & 146,0.500D0, 0,137, 50, 0, 0, 0,
50581 & 146,0.500D0, 0,141, 46, 0, 0, 0,
50582 & 147,0.440D0, 0,136, 50, 0, 0, 0,
50583 & 147,0.440D0, 0,140, 46, 0, 0, 0,
50584 & 147,0.055D0, 0,137, 50, 0, 0, 0,
50585 & 147,0.055D0, 0,141, 46, 0, 0, 0,
50586 & 147,0.010D0, 0,144, 22, 0, 0, 0,
50587 & 148,1.000D0, 0,150, 38, 0, 0, 0,
50588 & 149,1.000D0, 0,150, 38, 0, 0, 0,
50589 & 150,0.028D0,101,122,127, 78, 0, 0,
50590 & 150,0.010D0,101,122,127, 80, 0, 0,
50591 & 150,0.028D0,101,124,129, 78, 0, 0,
50592 & 150,0.010D0,101,124,129, 80, 0, 0,
50593 & 150,0.026D0, 0, 73, 42, 0, 0, 0,
50594 & 150,0.030D0, 0, 73, 42, 21, 0, 0,
50595 & 150,0.029D0, 0, 73, 42, 38, 30, 0/
50596 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 533, 551)/
50597 & 150,0.014D0, 0, 73, 42, 22, 0, 0,
50598 & 150,0.020D0, 0, 73, 43, 0, 0, 0,
50599 & 150,0.029D0, 0, 73, 34, 38, 0, 0,
50600 & 150,0.039D0, 0, 73, 34, 38, 21, 0,
50601 & 150,0.002D0, 0, 73, 34, 38, 38, 30,
50602 & 150,0.010D0, 0, 73, 34, 38, 21, 21,
50603 & 150,0.014D0, 0, 73, 35, 38, 0, 0,
50604 & 150,0.010D0, 0, 74, 42, 0, 0, 0,
50605 & 150,0.020D0, 0, 74, 43, 0, 0, 0,
50606 & 150,0.010D0, 0, 74, 43, 21, 0, 0,
50607 & 150,0.007D0, 0, 85, 34, 0, 0, 0,
50608 & 150,0.014D0, 0, 85, 35, 0, 0, 0,
50609 & 150,0.004D0, 0, 73,293, 0, 0, 0,
50610 & 150,0.003D0, 0, 73, 38, 30, 0, 0,
50611 & 150,0.003D0, 0, 73, 38, 30, 38, 30,
50612 & 150,0.001D0, 0, 73, 56, 0, 0, 0,
50613 & 150,0.002D0, 0, 73, 46, 34, 0, 0,
50614 & 150,0.010D0, 0, 78, 38, 0, 0, 0,
50615 & 150,0.020D0, 0, 78, 39, 0, 0, 0/
50616 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 552, 570)/
50617 & 150,0.030D0, 0, 78, 38, 21, 0, 0,
50618 & 150,0.010D0, 0, 78, 38, 22, 0, 0,
50619 & 150,0.020D0, 0, 78, 38, 24, 0, 0,
50620 & 150,0.035D0, 0, 78, 38, 38, 30, 0,
50621 & 150,0.020D0, 0, 78, 38, 21, 21, 0,
50622 & 150,0.010D0, 0, 78, 38, 38, 30, 21,
50623 & 150,0.010D0, 0, 78, 38, 21, 21, 21,
50624 & 150,0.007D0, 0, 78, 46, 42, 0, 0,
50625 & 150,0.011D0, 0, 79, 38, 0, 0, 0,
50626 & 150,0.022D0, 0, 79, 38, 21, 0, 0,
50627 & 150,0.013D0, 0, 79, 38, 38, 30, 0,
50628 & 150,0.010D0, 0, 79, 38, 21, 21, 0,
50629 & 150,0.007D0, 0, 79, 38, 38, 30, 21,
50630 & 150,0.005D0, 0, 79, 38, 21, 21, 21,
50631 & 150,0.005D0, 0, 80, 38, 0, 0, 0,
50632 & 150,0.015D0, 0, 80, 39, 0, 0, 0,
50633 & 150,0.011D0, 0, 86, 21, 0, 0, 0,
50634 & 150,0.007D0, 0, 86, 22, 0, 0, 0,
50635 & 150,0.010D0, 0, 86, 23, 0, 0, 0/
50636 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 571, 589)/
50637 & 150,0.031D0, 0, 86, 24, 0, 0, 0,
50638 & 150,0.010D0, 0, 86, 25, 0, 0, 0,
50639 & 150,0.004D0, 0, 86, 56, 0, 0, 0,
50640 & 150,0.026D0, 0, 86, 38, 30, 0, 0,
50641 & 150,0.005D0, 0, 86, 38, 38, 30, 30,
50642 & 150,0.005D0, 0, 86, 38, 30, 21, 21,
50643 & 150,0.005D0, 0, 87, 21, 0, 0, 0,
50644 & 150,0.006D0, 0, 87, 23, 0, 0, 0,
50645 & 150,0.004D0, 0, 86, 46, 34, 0, 0,
50646 & 150,0.002D0, 0, 86, 46, 30, 0, 0,
50647 & 150,0.001D0, 0, 86, 46, 30, 21, 0,
50648 & 150,0.016D0, 0, 81, 38, 38, 0, 0,
50649 & 150,0.003D0, 0, 88, 46, 0, 0, 0,
50650 & 150,0.002D0, 0, 89, 46, 0, 0, 0,
50651 & 150,0.003D0, 0, 83, 46, 38, 0, 0,
50652 & 150,0.040D0, 0, 75, 46, 21, 0, 0,
50653 & 150,0.040D0, 0, 75, 46, 38, 30, 0,
50654 & 150,0.020D0, 0, 75, 46, 21, 21, 0,
50655 & 150,0.010D0, 0, 75, 46, 38, 30, 21/
50656 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 590, 608)/
50657 & 150,0.010D0, 0, 75, 46, 21, 21, 21,
50658 & 150,0.020D0, 0, 75, 47, 21, 0, 0,
50659 & 150,0.040D0, 0, 75, 42, 38, 0, 0,
50660 & 150,0.020D0, 0, 75, 42, 39, 0, 0,
50661 & 150,0.010D0, 0, 75, 42, 38, 38, 30,
50662 & 150,0.010D0, 0, 75, 42, 38, 21, 21,
50663 & 150,0.006D0, 0, 75, 43, 38, 0, 0,
50664 & 151,1.000D0, 0,150, 21, 0, 0, 0,
50665 & 152,1.000D0, 0,150, 21, 0, 0, 0,
50666 & 153,1.000D0, 0,150, 30, 0, 0, 0,
50667 & 154,1.000D0, 0,150, 30, 0, 0, 0,
50668 & 155,0.045D0,101,122,127, 88, 0, 0,
50669 & 155,0.005D0,101,122,127, 89, 0, 0,
50670 & 155,0.045D0,101,124,129, 88, 0, 0,
50671 & 155,0.005D0,101,124,129, 89, 0, 0,
50672 & 155,0.021D0, 0, 86, 42, 0, 0, 0,
50673 & 155,0.032D0, 0, 87, 42, 0, 0, 0,
50674 & 155,0.032D0, 0, 79, 38, 42, 0, 0,
50675 & 155,0.045D0, 0, 86, 43, 0, 0, 0/
50676 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 609, 627)/
50677 & 155,0.065D0, 0, 87, 43, 0, 0, 0,
50678 & 155,0.065D0, 0, 79, 38, 43, 0, 0,
50679 & 155,0.055D0, 0, 88, 38, 0, 0, 0,
50680 & 155,0.160D0, 0, 88, 39, 0, 0, 0,
50681 & 155,0.105D0, 0, 89, 38, 0, 0, 0,
50682 & 155,0.320D0, 0, 89, 39, 0, 0, 0,
50683 & 156,1.000D0, 0,155, 59, 0, 0, 0,
50684 & 157,0.667D0, 0,158, 38, 0, 0, 0,
50685 & 157,0.333D0, 0,155, 21, 0, 0, 0,
50686 & 158,0.045D0,101,122,127, 83, 0, 0,
50687 & 158,0.045D0,101,124,129, 83, 0, 0,
50688 & 158,0.005D0,101,122,127, 84, 0, 0,
50689 & 158,0.005D0,101,124,129, 84, 0, 0,
50690 & 158,0.020D0, 0, 79, 42, 0, 0, 0,
50691 & 158,0.020D0, 0, 79, 21, 42, 0, 0,
50692 & 158,0.020D0, 0, 80, 42, 0, 0, 0,
50693 & 158,0.060D0, 0, 79, 43, 0, 0, 0,
50694 & 158,0.060D0, 0, 79, 21, 43, 0, 0,
50695 & 158,0.060D0, 0, 80, 43, 0, 0, 0/
50696 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 628, 646)/
50697 & 158,0.020D0, 0, 86, 34, 0, 0, 0,
50698 & 158,0.060D0, 0, 86, 35, 0, 0, 0,
50699 & 158,0.040D0, 0, 87, 34, 0, 0, 0,
50700 & 158,0.120D0, 0, 87, 35, 0, 0, 0,
50701 & 158,0.020D0, 0, 83, 38, 0, 0, 0,
50702 & 158,0.060D0, 0, 83, 39, 0, 0, 0,
50703 & 158,0.040D0, 0, 84, 38, 0, 0, 0,
50704 & 158,0.120D0, 0, 84, 39, 0, 0, 0,
50705 & 158,0.010D0, 0, 88, 21, 0, 0, 0,
50706 & 158,0.030D0, 0, 88, 23, 0, 0, 0,
50707 & 158,0.020D0, 0, 89, 21, 0, 0, 0,
50708 & 158,0.060D0, 0, 89, 23, 0, 0, 0,
50709 & 158,0.030D0, 0, 88, 56, 0, 0, 0,
50710 & 158,0.030D0, 0, 90, 46, 0, 0, 0,
50711 & 159,1.000D0, 0,158, 59, 0, 0, 0,
50712 & 160,0.670D0, 0,155, 30, 0, 0, 0,
50713 & 160,0.330D0, 0,158, 21, 0, 0, 0,
50714 & 161,0.050D0,101,122,127, 90, 0, 0,
50715 & 161,0.050D0,101,124,129, 90, 0, 0/
50716 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 647, 665)/
50717 & 161,0.075D0, 0, 88, 42, 0, 0, 0,
50718 & 161,0.225D0, 0, 88, 43, 0, 0, 0,
50719 & 161,0.150D0, 0, 89, 42, 0, 0, 0,
50720 & 161,0.450D0, 0, 89, 43, 0, 0, 0,
50721 & 162,1.000D0, 0,161, 59, 0, 0, 0,
50722 & 163,0.028D0, 0, 25, 38, 30, 0, 0,
50723 & 163,0.014D0, 0, 25, 21, 21, 0, 0,
50724 & 163,0.018D0, 0, 39, 31, 0, 0, 0,
50725 & 163,0.009D0, 0, 23, 23, 0, 0, 0,
50726 & 163,0.010D0, 0, 51, 34, 38, 0, 0,
50727 & 163,0.010D0, 0, 43, 47, 30, 0, 0,
50728 & 163,0.004D0, 0, 51, 43, 0, 0, 0,
50729 & 163,0.004D0, 0, 47, 35, 0, 0, 0,
50730 & 163,0.007D0, 0, 56, 56, 0, 0, 0,
50731 & 163,0.022D0, 0, 46, 42, 30, 0, 0,
50732 & 163,0.011D0, 0, 46, 34, 21, 0, 0,
50733 & 163,0.011D0, 0, 50, 42, 21, 0, 0,
50734 & 163,0.022D0, 0, 50, 34, 38, 0, 0,
50735 & 163,0.032D0, 0, 22, 38, 30, 0, 0/
50736 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 666, 684)/
50737 & 163,0.016D0, 0, 22, 21, 21, 0, 0,
50738 & 163,0.020D0, 0, 38, 30, 46, 34, 0,
50739 & 163,0.012D0, 0, 38, 30, 38, 30, 0,
50740 & 163,0.001D0, 0, 73, 91, 0, 0, 0,
50741 & 163,0.001D0, 0, 59, 59, 0, 0, 0,
50742 & 163,0.748D0, 0, 13, 13, 0, 0, 0,
50743 & 164,0.060D0, 0,121,127, 0, 0, 0,
50744 & 164,0.060D0, 0,123,129, 0, 0, 0,
50745 & 164,0.004D0, 0, 39, 30, 0, 0, 0,
50746 & 164,0.004D0, 0, 23, 21, 0, 0, 0,
50747 & 164,0.004D0, 0, 31, 38, 0, 0, 0,
50748 & 164,0.003D0, 0, 41, 31, 0, 0, 0,
50749 & 164,0.003D0, 0, 29, 23, 0, 0, 0,
50750 & 164,0.003D0, 0, 33, 39, 0, 0, 0,
50751 & 164,0.009D0, 0, 24, 38, 38, 30, 30,
50752 & 164,0.007D0, 0, 24, 38, 30, 0, 0,
50753 & 164,0.003D0, 0, 51, 45, 0, 0, 0,
50754 & 164,0.003D0, 0, 43, 53, 0, 0, 0,
50755 & 164,0.003D0, 0, 24, 51, 42, 0, 0/
50756 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 685, 703)/
50757 & 164,0.003D0, 0, 24, 43, 50, 0, 0,
50758 & 164,0.004D0, 0, 24, 26, 0, 0, 0,
50759 & 164,0.003D0, 0, 46, 35, 0, 0, 0,
50760 & 164,0.003D0, 0, 34, 47, 0, 0, 0,
50761 & 164,0.002D0, 0, 50, 43, 0, 0, 0,
50762 & 164,0.002D0, 0, 42, 51, 0, 0, 0,
50763 & 164,0.003D0, 0, 24, 21, 21, 0, 0,
50764 & 164,0.002D0, 0,286, 30, 0, 0, 0,
50765 & 164,0.002D0, 0,287, 38, 0, 0, 0,
50766 & 164,0.003D0, 0, 24, 46, 42, 30, 0,
50767 & 164,0.003D0, 0, 24, 34, 50, 38, 0,
50768 & 164,0.002D0, 0,285, 21, 0, 0, 0,
50769 & 164,0.001D0, 0, 56, 51, 42, 0, 0,
50770 & 164,0.001D0, 0, 56, 43, 50, 0, 0,
50771 & 164,0.001D0, 0, 24, 50, 42, 0, 0,
50772 & 164,0.001D0, 0, 24, 46, 34, 0, 0,
50773 & 164,0.002D0, 0, 56, 38, 30, 38, 30,
50774 & 164,0.002D0, 0, 85, 91, 30, 0, 0,
50775 & 164,0.002D0, 0,103, 73, 38, 0, 0/
50776 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 704, 722)/
50777 & 164,0.002D0, 0, 24, 22, 0, 0, 0,
50778 & 164,0.001D0, 0, 56, 50, 42, 0, 0,
50779 & 164,0.001D0, 0, 56, 46, 34, 0, 0,
50780 & 164,0.001D0, 0, 73, 91, 24, 0, 0,
50781 & 164,0.001D0, 0, 85,103, 0, 0, 0,
50782 & 164,0.001D0, 0, 82,100, 0, 0, 0,
50783 & 164,0.001D0, 0, 87,105, 0, 0, 0,
50784 & 164,0.001D0, 0, 73, 91, 25, 0, 0,
50785 & 164,0.001D0, 0, 56, 58, 0, 0, 0,
50786 & 164,0.001D0, 0, 56, 38, 30, 0, 0,
50787 & 164,0.001D0, 0, 56, 46, 42, 30, 0,
50788 & 164,0.001D0, 0, 56, 34, 50, 38, 0,
50789 & 164,0.001D0, 0, 56, 22, 0, 0, 0,
50790 & 164,0.001D0, 0, 84,102, 0, 0, 0,
50791 & 164,0.001D0, 0, 73, 34, 98, 0, 0,
50792 & 164,0.001D0, 0, 91, 46, 80, 0, 0,
50793 & 164,0.034D0, 0, 38, 38, 30, 30, 21,
50794 & 164,0.029D0, 0, 23, 23, 23, 21, 0,
50795 & 164,0.015D0, 0, 38, 30, 21, 0, 0/
50796 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 723, 741)/
50797 & 164,0.012D0, 0, 38, 30, 21, 34, 46,
50798 & 164,0.009D0, 0, 23, 23, 23, 24, 0,
50799 & 164,0.007D0, 0, 38, 30, 34, 46, 0,
50800 & 164,0.002D0, 0, 46, 42, 30, 0, 0,
50801 & 164,0.001D0, 0, 46, 34, 21, 0, 0,
50802 & 164,0.001D0, 0, 50, 42, 21, 0, 0,
50803 & 164,0.002D0, 0, 50, 34, 38, 0, 0,
50804 & 164,0.006D0, 0, 73, 91, 38, 30, 0,
50805 & 164,0.004D0, 0, 38, 30, 38, 30, 0,
50806 & 164,0.004D0, 0, 38, 30, 38, 30, 23,
50807 & 164,0.004D0, 0, 75, 93, 38, 30, 0,
50808 & 164,0.001D0, 0, 86,104, 0, 0, 0,
50809 & 164,0.001D0, 0, 79, 97, 0, 0, 0,
50810 & 164,0.001D0, 0, 81, 99, 0, 0, 0,
50811 & 164,0.003D0, 0, 23, 23, 34, 46, 0,
50812 & 164,0.002D0, 0, 73, 91, 38, 30, 21,
50813 & 164,0.002D0, 0, 73, 91, 0, 0, 0,
50814 & 164,0.002D0, 0, 73, 91, 22, 0, 0,
50815 & 164,0.002D0, 0, 73, 93, 30, 0, 0/
50816 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 742, 760)/
50817 & 164,0.002D0, 0, 75, 93, 0, 0, 0,
50818 & 164,0.001D0, 0, 83,102, 0, 0, 0,
50819 & 164,0.001D0, 0, 88,106, 0, 0, 0,
50820 & 164,0.001D0, 0, 78, 96, 0, 0, 0,
50821 & 164,0.001D0, 0, 73, 91, 21, 0, 0,
50822 & 164,0.001D0, 0, 78,104, 38, 0, 0,
50823 & 164,0.001D0, 0, 96, 86, 30, 0, 0,
50824 & 164,0.001D0, 0, 73, 34, 96, 0, 0,
50825 & 164,0.001D0, 0, 91, 46, 78, 0, 0,
50826 & 164,0.001D0, 0, 46, 34, 46, 34, 0,
50827 & 164,0.013D0, 0, 59,163, 0, 0, 0,
50828 & 164,0.008D0, 0, 59, 38, 30, 21, 21,
50829 & 164,0.004D0, 0, 59, 22, 38, 30, 0,
50830 & 164,0.002D0, 0, 59, 22, 21, 21, 0,
50831 & 164,0.003D0, 0, 59, 39, 31, 0, 0,
50832 & 164,0.002D0, 0, 59, 23, 23, 0, 0,
50833 & 164,0.004D0, 0, 59, 25, 0, 0, 0,
50834 & 164,0.003D0, 0, 59, 38, 30, 38, 30,
50835 & 164,0.002D0, 0, 59, 24, 24, 0, 0/
50836 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 761, 779)/
50837 & 164,0.001D0, 0, 59, 26, 0, 0, 0,
50838 & 164,0.001D0, 0, 59, 22, 0, 0, 0,
50839 & 164,0.001D0, 0, 59, 28, 0, 0, 0,
50840 & 164,0.001D0, 0, 59, 58, 0, 0, 0,
50841 & 164,0.020D0, 0, 1, 7, 0, 0, 0,
50842 & 164,0.080D0, 0, 2, 8, 0, 0, 0,
50843 & 164,0.020D0, 0, 3, 9, 0, 0, 0,
50844 & 164,0.364D0,130, 13, 13, 13, 0, 0,
50845 & 164,0.091D0,130, 13, 13, 59, 0, 0,
50846 & 165,0.037D0, 0, 38, 30, 38, 30, 0,
50847 & 165,0.030D0, 0, 38, 30, 46, 34, 0,
50848 & 165,0.016D0, 0, 23, 38, 30, 0, 0,
50849 & 165,0.015D0, 0, 23, 38, 30, 38, 30,
50850 & 165,0.004D0, 0, 46, 43, 30, 0, 0,
50851 & 165,0.002D0, 0, 46, 35, 21, 0, 0,
50852 & 165,0.002D0, 0, 51, 43, 21, 0, 0,
50853 & 165,0.004D0, 0, 51, 35, 38, 0, 0,
50854 & 165,0.008D0, 0, 38, 30, 0, 0, 0,
50855 & 165,0.007D0, 0, 46, 34, 0, 0, 0/
50856 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 780, 798)/
50857 & 165,0.005D0, 0, 38, 30, 73, 91, 0,
50858 & 165,0.003D0, 0, 21, 21, 0, 0, 0,
50859 & 165,0.003D0, 0, 22, 22, 0, 0, 0,
50860 & 165,0.007D0, 0, 59,164, 0, 0, 0,
50861 & 165,0.857D0, 0, 13, 13, 0, 0, 0,
50862 & 166,0.008D0, 0,121,127, 0, 0, 0,
50863 & 166,0.008D0, 0,123,129, 0, 0, 0,
50864 & 166,0.001D0, 0,125,131, 0, 0, 0,
50865 & 166,0.338D0, 0,164, 38, 30, 0, 0,
50866 & 166,0.169D0, 0,164, 21, 21, 0, 0,
50867 & 166,0.027D0, 0,164, 22, 0, 0, 0,
50868 & 166,0.001D0, 0,164, 21, 0, 0, 0,
50869 & 166,0.004D0, 0, 23, 23, 23, 21, 0,
50870 & 166,0.003D0, 0, 23, 23, 21, 0, 0,
50871 & 166,0.002D0, 0, 38, 30, 46, 34, 0,
50872 & 166,0.001D0, 0, 38, 30, 73, 91, 0,
50873 & 166,0.093D0, 0, 59,165, 0, 0, 0,
50874 & 166,0.087D0, 0, 59,302, 0, 0, 0,
50875 & 166,0.078D0, 0, 59,303, 0, 0, 0/
50876 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 799, 817)/
50877 & 166,0.003D0, 0, 59,163, 0, 0, 0,
50878 & 166,0.003D0, 0, 1, 7, 0, 0, 0,
50879 & 166,0.012D0, 0, 2, 8, 0, 0, 0,
50880 & 166,0.003D0, 0, 3, 9, 0, 0, 0,
50881 & 166,0.127D0,130, 13, 13, 13, 0, 0,
50882 & 166,0.032D0,130, 13, 13, 59, 0, 0,
50883 & 167,0.500D0, 0,136,171, 0, 0, 0,
50884 & 167,0.500D0, 0,140,175, 0, 0, 0,
50885 & 171,0.067D0,101,128,121, 50, 0, 0,
50886 & 171,0.067D0,101,130,123, 50, 0, 0,
50887 & 171,0.048D0,101,128,121, 51, 0, 0,
50888 & 171,0.048D0,101,130,123, 51, 0, 0,
50889 & 171,0.003D0, 0,128,121, 46, 30, 0,
50890 & 171,0.003D0, 0,130,123, 46, 30, 0,
50891 & 171,0.006D0,101,128,121, 21, 0, 0,
50892 & 171,0.006D0,101,130,123, 21, 0, 0,
50893 & 171,0.002D0,101,128,121, 23, 0, 0,
50894 & 171,0.002D0,101,130,123, 23, 0, 0,
50895 & 171,0.055D0, 0, 46, 30, 30, 0, 0/
50896 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 818, 836)/
50897 & 171,0.031D0, 0, 46, 31, 30, 0, 0,
50898 & 171,0.042D0, 0, 46, 30, 30, 21, 21,
50899 & 171,0.002D0, 0, 46, 30, 30, 30, 39,
50900 & 171,0.021D0, 0, 47, 30, 30, 0, 0,
50901 & 171,0.027D0, 0, 50, 30, 0, 0, 0,
50902 & 171,0.066D0, 0, 50, 31, 0, 0, 0,
50903 & 171,0.081D0, 0, 50, 32, 0, 0, 0,
50904 & 171,0.024D0, 0, 50, 30, 21, 0, 0,
50905 & 171,0.004D0, 0, 50, 30, 23, 0, 0,
50906 & 171,0.069D0, 0, 50, 30, 30, 38, 21,
50907 & 171,0.001D0, 0, 50, 30, 30, 38, 23,
50908 & 171,0.022D0, 0, 51, 30, 0, 0, 0,
50909 & 171,0.021D0, 0, 51, 31, 0, 0, 0,
50910 & 171,0.042D0, 0, 51, 30, 21, 0, 0,
50911 & 171,0.008D0, 0, 51, 30, 23, 0, 0,
50912 & 171,0.010D0, 0, 51, 30, 30, 38, 0,
50913 & 171,0.050D0, 0,309, 30, 0, 0, 0,
50914 & 171,0.034D0, 0,328, 30, 0, 0, 0,
50915 & 171,0.010D0, 0,368, 30, 0, 0, 0/
50916 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 837, 855)/
50917 & 171,0.031D0, 0, 34, 50, 50, 0, 0,
50918 & 171,0.003D0, 0, 30, 21, 0, 0, 0,
50919 & 171,0.001D0, 0, 30, 23, 0, 0, 0,
50920 & 171,0.002D0, 0, 30, 30, 38, 0, 0,
50921 & 171,0.008D0, 0, 30, 22, 0, 0, 0,
50922 & 171,0.001D0, 0, 30, 30, 30, 38, 38,
50923 & 171,0.003D0, 0, 30, 30, 30, 38, 39,
50924 & 171,0.008D0, 0, 34, 50, 0, 0, 0,
50925 & 171,0.005D0, 0, 34, 51, 0, 0, 0,
50926 & 171,0.026D0, 0, 35, 51, 0, 0, 0,
50927 & 171,0.005D0, 0, 34, 46, 30, 0, 0,
50928 & 171,0.007D0, 0, 30, 56, 0, 0, 0,
50929 & 171,0.023D0, 0, 30, 56, 21, 0, 0,
50930 & 171,0.005D0, 0, 34, 34, 46, 0, 0,
50931 & 172,0.683D0, 0,175, 30, 0, 0, 0,
50932 & 172,0.306D0, 0,171, 21, 0, 0, 0,
50933 & 172,0.011D0, 0,171, 59, 0, 0, 0,
50934 & 173,0.667D0, 0,176, 30, 0, 0, 0,
50935 & 173,0.333D0, 0,172, 21, 0, 0, 0/
50936 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 856, 874)/
50937 & 174,0.220D0, 0,175, 30, 0, 0, 0,
50938 & 174,0.110D0, 0,171, 21, 0, 0, 0,
50939 & 174,0.380D0, 0,176, 30, 0, 0, 0,
50940 & 174,0.190D0, 0,172, 21, 0, 0, 0,
50941 & 174,0.004D0, 0,171, 22, 0, 0, 0,
50942 & 174,0.064D0, 0,176, 30, 21, 0, 0,
50943 & 174,0.032D0, 0,172, 38, 30, 0, 0,
50944 & 175,0.037D0,101,128,121, 46, 0, 0,
50945 & 175,0.037D0,101,130,123, 46, 0, 0,
50946 & 175,0.016D0,101,128,121, 47, 0, 0,
50947 & 175,0.016D0,101,130,123, 47, 0, 0,
50948 & 175,0.013D0, 0,128,121, 46, 21, 0,
50949 & 175,0.013D0, 0,130,123, 46, 21, 0,
50950 & 175,0.012D0, 0,128,121, 50, 38, 0,
50951 & 175,0.012D0, 0,130,123, 50, 38, 0,
50952 & 175,0.003D0,101,128,121, 38, 0, 0,
50953 & 175,0.003D0,101,130,123, 38, 0, 0,
50954 & 175,0.039D0, 0, 46, 30, 0, 0, 0,
50955 & 175,0.091D0, 0, 46, 31, 0, 0, 0/
50956 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 875, 893)/
50957 & 175,0.067D0, 0, 46, 32, 0, 0, 0,
50958 & 175,0.004D0, 0, 46, 30, 21, 0, 0,
50959 & 175,0.100D0, 0, 46, 30, 21, 21, 0,
50960 & 175,0.058D0, 0, 46, 30, 23, 0, 0,
50961 & 175,0.020D0, 0, 46, 30, 24, 0, 0,
50962 & 175,0.006D0, 0, 46, 30, 25, 0, 0,
50963 & 175,0.043D0, 0, 47, 30, 0, 0, 0,
50964 & 175,0.035D0, 0, 47, 31, 0, 0, 0,
50965 & 175,0.007D0, 0,310, 30, 0, 0, 0,
50966 & 175,0.007D0, 0,327, 30, 0, 0, 0,
50967 & 175,0.020D0, 0, 50, 21, 0, 0, 0,
50968 & 175,0.006D0, 0, 50, 22, 0, 0, 0,
50969 & 175,0.009D0, 0, 50, 23, 0, 0, 0,
50970 & 175,0.016D0, 0, 50, 24, 0, 0, 0,
50971 & 175,0.014D0, 0, 50, 25, 0, 0, 0,
50972 & 175,0.003D0, 0, 50,293, 0, 0, 0,
50973 & 175,0.007D0, 0, 50, 56, 0, 0, 0,
50974 & 175,0.003D0, 0, 50, 26, 0, 0, 0,
50975 & 175,0.004D0, 0, 50,294, 0, 0, 0/
50976 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 894, 912)/
50977 & 175,0.006D0, 0, 50, 21, 21, 0, 0,
50978 & 175,0.042D0, 0, 50, 30, 38, 21, 0,
50979 & 175,0.004D0, 0, 50, 30, 30, 38, 38,
50980 & 175,0.076D0, 0, 50, 30, 38, 21, 21,
50981 & 175,0.026D0, 0, 51, 21, 0, 0, 0,
50982 & 175,0.014D0, 0, 51, 22, 0, 0, 0,
50983 & 175,0.014D0, 0, 51, 23, 0, 0, 0,
50984 & 175,0.011D0, 0, 51, 24, 0, 0, 0,
50985 & 175,0.018D0, 0, 51, 30, 38, 0, 0,
50986 & 175,0.004D0, 0, 50, 34, 46, 0, 0,
50987 & 175,0.004D0, 0, 50, 34, 46, 21, 0,
50988 & 175,0.005D0, 0, 50, 50, 42, 0, 0,
50989 & 175,0.002D0, 0, 30, 38, 0, 0, 0,
50990 & 175,0.001D0, 0, 21, 21, 0, 0, 0,
50991 & 175,0.008D0, 0, 30, 38, 21, 0, 0,
50992 & 175,0.007D0, 0, 30, 30, 38, 38, 0,
50993 & 175,0.015D0, 0, 30, 30, 38, 38, 21,
50994 & 175,0.004D0, 0, 34, 46, 0, 0, 0,
50995 & 175,0.003D0, 0, 35, 46, 0, 0, 0/
50996 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 913, 931)/
50997 & 175,0.002D0, 0, 34, 47, 0, 0, 0,
50998 & 175,0.001D0, 0, 42, 50, 0, 0, 0,
50999 & 175,0.002D0, 0, 43, 51, 0, 0, 0,
51000 & 175,0.003D0, 0, 42, 46, 30, 0, 0,
51001 & 175,0.003D0, 0, 50, 34, 38, 0, 0,
51002 & 175,0.001D0, 0, 34, 46, 30, 38, 21,
51003 & 175,0.002D0, 0, 56, 23, 0, 0, 0,
51004 & 175,0.001D0, 0, 56, 30, 38, 0, 0,
51005 & 176,0.636D0, 0,175, 21, 0, 0, 0,
51006 & 176,0.364D0, 0,175, 59, 0, 0, 0,
51007 & 177,0.667D0, 0,172, 38, 0, 0, 0,
51008 & 177,0.333D0, 0,176, 21, 0, 0, 0,
51009 & 178,0.220D0, 0,171, 38, 0, 0, 0,
51010 & 178,0.110D0, 0,175, 21, 0, 0, 0,
51011 & 178,0.380D0, 0,172, 38, 0, 0, 0,
51012 & 178,0.190D0, 0,176, 21, 0, 0, 0,
51013 & 178,0.004D0, 0,175, 22, 0, 0, 0,
51014 & 178,0.064D0, 0,172, 38, 21, 0, 0,
51015 & 178,0.032D0, 0,176, 38, 30, 0, 0/
51016 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 932, 950)/
51017 & 179,0.009D0, 0,130,123, 0, 0, 0,
51018 & 179,0.019D0,101,128,121, 56, 0, 0,
51019 & 179,0.019D0,101,130,123, 56, 0, 0,
51020 & 179,0.025D0,101,128,121, 22, 0, 0,
51021 & 179,0.025D0,101,130,123, 22, 0, 0,
51022 & 179,0.009D0,101,128,121, 25, 0, 0,
51023 & 179,0.009D0,101,130,123, 25, 0, 0,
51024 & 179,0.036D0, 0, 34, 50, 0, 0, 0,
51025 & 179,0.034D0, 0, 34, 51, 0, 0, 0,
51026 & 179,0.007D0, 0, 34,328, 0, 0, 0,
51027 & 179,0.043D0, 0, 35, 50, 0, 0, 0,
51028 & 179,0.058D0, 0, 35, 51, 0, 0, 0,
51029 & 179,0.011D0, 0, 34, 46, 30, 0, 0,
51030 & 179,0.055D0, 0, 34, 46, 30, 21, 0,
51031 & 179,0.003D0, 0, 34, 46, 30, 38, 30,
51032 & 179,0.014D0, 0, 34, 50, 38, 30, 0,
51033 & 179,0.017D0, 0, 42, 46, 30, 30, 0,
51034 & 179,0.036D0, 0, 56, 30, 0, 0, 0,
51035 & 179,0.067D0, 0, 56, 31, 0, 0, 0/
51036 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 951, 969)/
51037 & 179,0.023D0, 0, 56, 30, 21, 0, 0,
51038 & 179,0.018D0, 0, 56, 30, 38, 30, 0,
51039 & 179,0.020D0, 0, 22, 30, 0, 0, 0,
51040 & 179,0.001D0, 0, 23, 30, 0, 0, 0,
51041 & 179,0.009D0, 0, 24, 30, 0, 0, 0,
51042 & 179,0.049D0, 0, 25, 30, 0, 0, 0,
51043 & 179,0.011D0, 0,293, 30, 0, 0, 0,
51044 & 179,0.015D0, 0, 22, 30, 21, 0, 0,
51045 & 179,0.016D0, 0, 25, 30, 21, 0, 0,
51046 & 179,0.103D0, 0, 22, 31, 0, 0, 0,
51047 & 179,0.120D0, 0, 25, 31, 0, 0, 0,
51048 & 179,0.010D0, 0, 30, 38, 30, 0, 0,
51049 & 179,0.046D0, 0, 30, 38, 30, 21, 0,
51050 & 179,0.003D0, 0, 30, 38, 38, 30, 30,
51051 & 179,0.042D0, 0, 30, 38, 38, 30, 31,
51052 & 179,0.001D0, 0, 34, 23, 0, 0, 0,
51053 & 179,0.005D0, 0, 34, 38, 30, 0, 0,
51054 & 179,0.001D0, 0, 34, 56, 0, 0, 0,
51055 & 179,0.004D0, 0, 42, 30, 0, 0, 0/
51056 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 970, 988)/
51057 & 179,0.007D0, 0, 43, 30, 0, 0, 0,
51058 & 180,0.900D0, 0,179, 59, 0, 0, 0,
51059 & 180,0.100D0, 0,179, 21, 0, 0, 0,
51060 & 181,0.500D0, 0,172, 42, 0, 0, 0,
51061 & 181,0.500D0, 0,176, 34, 0, 0, 0,
51062 & 182,0.440D0, 0,171, 42, 0, 0, 0,
51063 & 182,0.440D0, 0,175, 34, 0, 0, 0,
51064 & 182,0.055D0, 0,172, 42, 0, 0, 0,
51065 & 182,0.055D0, 0,176, 34, 0, 0, 0,
51066 & 182,0.010D0, 0,179, 22, 0, 0, 0,
51067 & 183,1.000D0, 0,185, 30, 0, 0, 0,
51068 & 184,1.000D0, 0,185, 30, 0, 0, 0,
51069 & 185,0.028D0,101,128,121, 96, 0, 0,
51070 & 185,0.010D0,101,128,121, 98, 0, 0,
51071 & 185,0.028D0,101,130,123, 96, 0, 0,
51072 & 185,0.010D0,101,130,123, 98, 0, 0,
51073 & 185,0.026D0, 0, 91, 50, 0, 0, 0,
51074 & 185,0.030D0, 0, 91, 50, 21, 0, 0,
51075 & 185,0.029D0, 0, 91, 50, 38, 30, 0/
51076 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I= 989,1007)/
51077 & 185,0.014D0, 0, 91, 50, 22, 0, 0,
51078 & 185,0.020D0, 0, 91, 51, 0, 0, 0,
51079 & 185,0.029D0, 0, 91, 46, 30, 0, 0,
51080 & 185,0.039D0, 0, 91, 46, 30, 21, 0,
51081 & 185,0.002D0, 0, 91, 46, 30, 30, 38,
51082 & 185,0.010D0, 0, 91, 46, 30, 21, 21,
51083 & 185,0.014D0, 0, 91, 47, 30, 0, 0,
51084 & 185,0.010D0, 0, 92, 50, 0, 0, 0,
51085 & 185,0.020D0, 0, 92, 51, 0, 0, 0,
51086 & 185,0.010D0, 0, 92, 51, 21, 0, 0,
51087 & 185,0.007D0, 0,103, 46, 0, 0, 0,
51088 & 185,0.014D0, 0,103, 47, 0, 0, 0,
51089 & 185,0.004D0, 0, 91,293, 0, 0, 0,
51090 & 185,0.003D0, 0, 91, 38, 30, 0, 0,
51091 & 185,0.003D0, 0, 91, 38, 30, 38, 30,
51092 & 185,0.001D0, 0, 91, 56, 0, 0, 0,
51093 & 185,0.002D0, 0, 91, 46, 34, 0, 0,
51094 & 185,0.010D0, 0, 96, 30, 0, 0, 0,
51095 & 185,0.020D0, 0, 96, 31, 0, 0, 0/
51096 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1008,1026)/
51097 & 185,0.030D0, 0, 96, 30, 21, 0, 0,
51098 & 185,0.010D0, 0, 96, 30, 22, 0, 0,
51099 & 185,0.020D0, 0, 96, 30, 24, 0, 0,
51100 & 185,0.035D0, 0, 96, 30, 30, 38, 0,
51101 & 185,0.020D0, 0, 96, 30, 21, 21, 0,
51102 & 185,0.010D0, 0, 96, 30, 38, 30, 21,
51103 & 185,0.010D0, 0, 96, 30, 21, 21, 21,
51104 & 185,0.007D0, 0, 96, 34, 50, 0, 0,
51105 & 185,0.011D0, 0, 97, 30, 0, 0, 0,
51106 & 185,0.022D0, 0, 97, 30, 21, 0, 0,
51107 & 185,0.013D0, 0, 97, 30, 38, 30, 0,
51108 & 185,0.010D0, 0, 97, 30, 21, 21, 0,
51109 & 185,0.007D0, 0, 97, 30, 38, 30, 21,
51110 & 185,0.005D0, 0, 97, 30, 21, 21, 21,
51111 & 185,0.005D0, 0, 98, 30, 0, 0, 0,
51112 & 185,0.015D0, 0, 98, 31, 0, 0, 0,
51113 & 185,0.011D0, 0,104, 21, 0, 0, 0,
51114 & 185,0.007D0, 0,104, 22, 0, 0, 0,
51115 & 185,0.010D0, 0,104, 23, 0, 0, 0/
51116 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1027,1045)/
51117 & 185,0.031D0, 0,104, 24, 0, 0, 0,
51118 & 185,0.010D0, 0,104, 25, 0, 0, 0,
51119 & 185,0.004D0, 0,104, 56, 0, 0, 0,
51120 & 185,0.026D0, 0,104, 38, 30, 0, 0,
51121 & 185,0.005D0, 0,104, 38, 38, 30, 30,
51122 & 185,0.005D0, 0,104, 38, 30, 21, 21,
51123 & 185,0.005D0, 0,105, 21, 0, 0, 0,
51124 & 185,0.006D0, 0,105, 23, 0, 0, 0,
51125 & 185,0.004D0, 0,104, 46, 34, 0, 0,
51126 & 185,0.002D0, 0,104, 34, 38, 0, 0,
51127 & 185,0.001D0, 0,104, 34, 38, 21, 0,
51128 & 185,0.016D0, 0, 99, 30, 30, 0, 0,
51129 & 185,0.003D0, 0,106, 34, 0, 0, 0,
51130 & 185,0.002D0, 0,107, 34, 0, 0, 0,
51131 & 185,0.003D0, 0,101, 34, 30, 0, 0,
51132 & 185,0.040D0, 0, 93, 34, 21, 0, 0,
51133 & 185,0.040D0, 0, 93, 34, 38, 30, 0,
51134 & 185,0.020D0, 0, 93, 34, 21, 21, 0,
51135 & 185,0.010D0, 0, 93, 34, 38, 30, 21/
51136 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1046,1064)/
51137 & 185,0.010D0, 0, 93, 34, 21, 21, 21,
51138 & 185,0.020D0, 0, 93, 35, 21, 0, 0,
51139 & 185,0.040D0, 0, 93, 50, 30, 0, 0,
51140 & 185,0.020D0, 0, 93, 50, 31, 0, 0,
51141 & 185,0.010D0, 0, 93, 50, 30, 38, 30,
51142 & 185,0.010D0, 0, 93, 50, 30, 21, 21,
51143 & 185,0.006D0, 0, 93, 51, 30, 0, 0,
51144 & 186,1.000D0, 0,185, 21, 0, 0, 0,
51145 & 187,1.000D0, 0,185, 21, 0, 0, 0,
51146 & 188,1.000D0, 0,185, 38, 0, 0, 0,
51147 & 189,1.000D0, 0,185, 38, 0, 0, 0,
51148 & 190,0.045D0,101,128,121,106, 0, 0,
51149 & 190,0.005D0,101,128,121,107, 0, 0,
51150 & 190,0.045D0,101,130,123,106, 0, 0,
51151 & 190,0.005D0,101,130,123,107, 0, 0,
51152 & 190,0.021D0, 0,104, 50, 0, 0, 0,
51153 & 190,0.032D0, 0,105, 50, 0, 0, 0,
51154 & 190,0.032D0, 0, 97, 30, 50, 0, 0,
51155 & 190,0.045D0, 0,104, 51, 0, 0, 0/
51156 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1065,1083)/
51157 & 190,0.065D0, 0,105, 51, 0, 0, 0,
51158 & 190,0.065D0, 0, 97, 30, 51, 0, 0,
51159 & 190,0.055D0, 0,106, 30, 0, 0, 0,
51160 & 190,0.160D0, 0,106, 31, 0, 0, 0,
51161 & 190,0.105D0, 0,107, 30, 0, 0, 0,
51162 & 190,0.320D0, 0,107, 31, 0, 0, 0,
51163 & 191,1.000D0, 0,190, 59, 0, 0, 0,
51164 & 192,0.667D0, 0,193, 30, 0, 0, 0,
51165 & 192,0.333D0, 0,190, 21, 0, 0, 0,
51166 & 193,0.045D0,101,128,121,101, 0, 0,
51167 & 193,0.045D0,101,130,123,101, 0, 0,
51168 & 193,0.005D0,101,128,121,102, 0, 0,
51169 & 193,0.005D0,101,130,123,102, 0, 0,
51170 & 193,0.020D0, 0, 97, 50, 0, 0, 0,
51171 & 193,0.020D0, 0, 97, 21, 50, 0, 0,
51172 & 193,0.020D0, 0, 98, 50, 0, 0, 0,
51173 & 193,0.060D0, 0, 97, 51, 0, 0, 0,
51174 & 193,0.060D0, 0, 97, 21, 51, 0, 0,
51175 & 193,0.060D0, 0, 98, 51, 0, 0, 0/
51176 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1084,1102)/
51177 & 193,0.020D0, 0,104, 46, 0, 0, 0,
51178 & 193,0.060D0, 0,104, 47, 0, 0, 0,
51179 & 193,0.040D0, 0,105, 46, 0, 0, 0,
51180 & 193,0.120D0, 0,105, 47, 0, 0, 0,
51181 & 193,0.020D0, 0,101, 30, 0, 0, 0,
51182 & 193,0.060D0, 0,101, 31, 0, 0, 0,
51183 & 193,0.040D0, 0,102, 30, 0, 0, 0,
51184 & 193,0.120D0, 0,102, 31, 0, 0, 0,
51185 & 193,0.010D0, 0,106, 21, 0, 0, 0,
51186 & 193,0.030D0, 0,106, 23, 0, 0, 0,
51187 & 193,0.020D0, 0,107, 21, 0, 0, 0,
51188 & 193,0.060D0, 0,107, 23, 0, 0, 0,
51189 & 193,0.030D0, 0,106, 56, 0, 0, 0,
51190 & 193,0.030D0, 0,108, 34, 0, 0, 0,
51191 & 194,1.000D0, 0,193, 59, 0, 0, 0,
51192 & 195,0.670D0, 0,190, 38, 0, 0, 0,
51193 & 195,0.330D0, 0,193, 21, 0, 0, 0,
51194 & 196,0.050D0,101,128,121,108, 0, 0,
51195 & 196,0.050D0,101,130,123,108, 0, 0/
51196 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1103,1121)/
51197 & 196,0.075D0, 0,106, 50, 0, 0, 0,
51198 & 196,0.225D0, 0,106, 51, 0, 0, 0,
51199 & 196,0.150D0, 0,107, 50, 0, 0, 0,
51200 & 196,0.450D0, 0,107, 51, 0, 0, 0,
51201 & 197,1.000D0, 0,196, 59, 0, 0, 0,
51202 & 209,0.250D0,100, 1, 8, 4, 0, 0,
51203 & 209,0.250D0,100, 3, 10, 4, 0, 0,
51204 & 209,0.250D0,100, 5, 12, 4, 0, 0,
51205 & 209,0.085D0,100,121,128, 4, 0, 0,
51206 & 209,0.085D0,100,123,130, 4, 0, 0,
51207 & 209,0.080D0,100,125,132, 4, 0, 0,
51208 & 210,0.250D0,100, 2, 7,209, 0, 0,
51209 & 210,0.250D0,100, 4, 9,209, 0, 0,
51210 & 210,0.250D0,100, 6, 11,209, 0, 0,
51211 & 210,0.085D0,100,122,127,209, 0, 0,
51212 & 210,0.085D0,100,124,129,209, 0, 0,
51213 & 210,0.080D0,100,126,131,209, 0, 0,
51214 & 211,0.250D0,100, 1, 8, 6, 0, 0,
51215 & 211,0.250D0,100, 3, 10, 6, 0, 0/
51216 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1122,1140)/
51217 & 211,0.250D0,100, 5, 12, 6, 0, 0,
51218 & 211,0.085D0,100,121,128, 6, 0, 0,
51219 & 211,0.085D0,100,123,130, 6, 0, 0,
51220 & 211,0.080D0,100,125,132, 6, 0, 0,
51221 & 212,0.250D0,100, 2, 7,211, 0, 0,
51222 & 212,0.250D0,100, 4, 9,211, 0, 0,
51223 & 212,0.250D0,100, 6, 11,211, 0, 0,
51224 & 212,0.085D0,100,122,127,211, 0, 0,
51225 & 212,0.085D0,100,124,129,211, 0, 0,
51226 & 212,0.080D0,100,126,131,211, 0, 0,
51227 & 215,0.250D0,100, 7, 2, 10, 0, 0,
51228 & 215,0.250D0,100, 9, 4, 10, 0, 0,
51229 & 215,0.250D0,100, 11, 6, 10, 0, 0,
51230 & 215,0.085D0,100,127,122, 10, 0, 0,
51231 & 215,0.085D0,100,129,124, 10, 0, 0,
51232 & 215,0.080D0,100,131,126, 10, 0, 0,
51233 & 216,0.250D0,100, 8, 1,215, 0, 0,
51234 & 216,0.250D0,100, 10, 3,215, 0, 0,
51235 & 216,0.250D0,100, 12, 5,215, 0, 0/
51236 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1141,1159)/
51237 & 216,0.085D0,100,128,121,215, 0, 0,
51238 & 216,0.085D0,100,130,123,215, 0, 0,
51239 & 216,0.080D0,100,132,125,215, 0, 0,
51240 & 217,0.250D0,100, 7, 2, 12, 0, 0,
51241 & 217,0.250D0,100, 9, 4, 12, 0, 0,
51242 & 217,0.250D0,100, 11, 6, 12, 0, 0,
51243 & 217,0.085D0,100,127,122, 12, 0, 0,
51244 & 217,0.085D0,100,129,124, 12, 0, 0,
51245 & 217,0.080D0,100,131,126, 12, 0, 0,
51246 & 218,0.250D0,100, 8, 1,217, 0, 0,
51247 & 218,0.250D0,100, 10, 3,217, 0, 0,
51248 & 218,0.250D0,100, 12, 5,217, 0, 0,
51249 & 218,0.085D0,100,128,121,217, 0, 0,
51250 & 218,0.085D0,100,130,123,217, 0, 0,
51251 & 218,0.080D0,100,132,125,217, 0, 0,
51252 & 221,0.016D0,101,121,128,136, 0, 0,
51253 & 221,0.016D0,101,123,130,136, 0, 0,
51254 & 221,0.008D0,101,125,132,136, 0, 0,
51255 & 221,0.048D0,101,121,128,137, 0, 0/
51256 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1160,1178)/
51257 & 221,0.048D0,101,123,130,137, 0, 0,
51258 & 221,0.022D0,101,125,132,137, 0, 0,
51259 & 221,0.003D0,101,121,128,331, 0, 0,
51260 & 221,0.003D0,101,123,130,331, 0, 0,
51261 & 221,0.001D0,101,125,132,331, 0, 0,
51262 & 221,0.008D0,101,121,128,138, 0, 0,
51263 & 221,0.008D0,101,123,130,138, 0, 0,
51264 & 221,0.004D0,101,125,132,138, 0, 0,
51265 & 221,0.008D0,101,121,128,313, 0, 0,
51266 & 221,0.008D0,101,123,130,313, 0, 0,
51267 & 221,0.004D0,101,125,132,313, 0, 0,
51268 & 221,0.013D0,101,121,128,139, 0, 0,
51269 & 221,0.013D0,101,123,130,139, 0, 0,
51270 & 221,0.006D0,101,125,132,139, 0, 0,
51271 & 221,0.004D0, 0,136, 30, 0, 0, 0,
51272 & 221,0.010D0, 0,136, 31, 0, 0, 0,
51273 & 221,0.006D0, 0,136, 32, 0, 0, 0,
51274 & 221,0.003D0, 0,137, 30, 0, 0, 0,
51275 & 221,0.009D0, 0,137, 31, 0, 0, 0/
51276 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1179,1197)/
51277 & 221,0.017D0, 0,137, 32, 0, 0, 0,
51278 & 221,0.011D0, 0,136,179, 0, 0, 0,
51279 & 221,0.015D0, 0,136,180, 0, 0, 0,
51280 & 221,0.011D0, 0,137,179, 0, 0, 0,
51281 & 221,0.022D0, 0,137,180, 0, 0, 0,
51282 & 221,0.001D0, 0,164, 42, 0, 0, 0,
51283 & 221,0.002D0, 0,164, 43, 0, 0, 0,
51284 & 221,0.001D0, 0,165, 42, 0, 0, 0,
51285 & 221,0.001D0, 0,165, 43, 0, 0, 0,
51286 & 221,0.001D0, 0,166, 42, 0, 0, 0,
51287 & 221,0.001D0, 0,166, 43, 0, 0, 0,
51288 & 221,0.207D0,100, 1, 8, 4, 7, 0,
51289 & 221,0.207D0,100, 3, 10, 4, 7, 0,
51290 & 221,0.024D0,100, 1, 8, 2, 7, 0,
51291 & 221,0.024D0,100, 3, 10, 2, 7, 0,
51292 & 221,0.012D0,100, 3, 8, 4, 7, 0,
51293 & 221,0.012D0,100, 1, 10, 4, 7, 0,
51294 & 221,0.069D0,100, 4, 8, 1, 7, 0,
51295 & 221,0.069D0,100, 4, 10, 3, 7, 0/
51296 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1198,1216)/
51297 & 221,0.008D0,100, 2, 8, 1, 7, 0,
51298 & 221,0.008D0,100, 2, 10, 3, 7, 0,
51299 & 221,0.004D0,100, 4, 8, 3, 7, 0,
51300 & 221,0.004D0,100, 4, 10, 1, 7, 0,
51301 & 222,0.016D0,101,121,128,140, 0, 0,
51302 & 222,0.016D0,101,123,130,140, 0, 0,
51303 & 222,0.008D0,101,125,132,140, 0, 0,
51304 & 222,0.048D0,101,121,128,141, 0, 0,
51305 & 222,0.048D0,101,123,130,141, 0, 0,
51306 & 222,0.022D0,101,125,132,141, 0, 0,
51307 & 222,0.003D0,101,121,128,332, 0, 0,
51308 & 222,0.003D0,101,123,130,332, 0, 0,
51309 & 222,0.001D0,101,125,132,332, 0, 0,
51310 & 222,0.008D0,101,121,128,142, 0, 0,
51311 & 222,0.008D0,101,123,130,142, 0, 0,
51312 & 222,0.004D0,101,125,132,142, 0, 0,
51313 & 222,0.008D0,101,121,128,314, 0, 0,
51314 & 222,0.008D0,101,123,130,314, 0, 0,
51315 & 222,0.004D0,101,125,132,314, 0, 0/
51316 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1217,1235)/
51317 & 222,0.013D0,101,121,128,143, 0, 0,
51318 & 222,0.013D0,101,123,130,143, 0, 0,
51319 & 222,0.006D0,101,125,132,143, 0, 0,
51320 & 222,0.004D0, 0,140, 30, 0, 0, 0,
51321 & 222,0.010D0, 0,140, 31, 0, 0, 0,
51322 & 222,0.006D0, 0,140, 32, 0, 0, 0,
51323 & 222,0.003D0, 0,141, 30, 0, 0, 0,
51324 & 222,0.009D0, 0,141, 31, 0, 0, 0,
51325 & 222,0.017D0, 0,141, 32, 0, 0, 0,
51326 & 222,0.011D0, 0,140,179, 0, 0, 0,
51327 & 222,0.015D0, 0,140,180, 0, 0, 0,
51328 & 222,0.011D0, 0,141,179, 0, 0, 0,
51329 & 222,0.022D0, 0,141,180, 0, 0, 0,
51330 & 222,0.001D0, 0,164, 34, 0, 0, 0,
51331 & 222,0.002D0, 0,164, 35, 0, 0, 0,
51332 & 222,0.001D0, 0,165, 34, 0, 0, 0,
51333 & 222,0.001D0, 0,165, 35, 0, 0, 0,
51334 & 222,0.001D0, 0,166, 34, 0, 0, 0,
51335 & 222,0.001D0, 0,166, 35, 0, 0, 0/
51336 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1236,1254)/
51337 & 222,0.207D0,100, 1, 8, 4, 8, 0,
51338 & 222,0.207D0,100, 3, 10, 4, 8, 0,
51339 & 222,0.024D0,100, 1, 8, 2, 8, 0,
51340 & 222,0.024D0,100, 3, 10, 2, 8, 0,
51341 & 222,0.012D0,100, 3, 8, 4, 8, 0,
51342 & 222,0.012D0,100, 1, 10, 4, 8, 0,
51343 & 222,0.069D0,100, 4, 8, 1, 8, 0,
51344 & 222,0.069D0,100, 4, 10, 3, 8, 0,
51345 & 222,0.008D0,100, 2, 8, 1, 8, 0,
51346 & 222,0.008D0,100, 2, 10, 3, 8, 0,
51347 & 222,0.004D0,100, 4, 8, 3, 8, 0,
51348 & 222,0.004D0,100, 4, 10, 1, 8, 0,
51349 & 223,0.016D0,101,121,128,144, 0, 0,
51350 & 223,0.016D0,101,123,130,144, 0, 0,
51351 & 223,0.008D0,101,125,132,144, 0, 0,
51352 & 223,0.048D0,101,121,128,145, 0, 0,
51353 & 223,0.048D0,101,123,130,145, 0, 0,
51354 & 223,0.022D0,101,125,132,145, 0, 0,
51355 & 223,0.003D0,101,121,128,333, 0, 0/
51356 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1255,1273)/
51357 & 223,0.003D0,101,123,130,333, 0, 0,
51358 & 223,0.001D0,101,125,132,333, 0, 0,
51359 & 223,0.008D0,101,121,128,146, 0, 0,
51360 & 223,0.008D0,101,123,130,146, 0, 0,
51361 & 223,0.004D0,101,125,132,146, 0, 0,
51362 & 223,0.008D0,101,121,128,315, 0, 0,
51363 & 223,0.008D0,101,123,130,315, 0, 0,
51364 & 223,0.004D0,101,125,132,315, 0, 0,
51365 & 223,0.013D0,101,121,128,147, 0, 0,
51366 & 223,0.013D0,101,123,130,147, 0, 0,
51367 & 223,0.006D0,101,125,132,147, 0, 0,
51368 & 223,0.004D0, 0,144, 30, 0, 0, 0,
51369 & 223,0.010D0, 0,144, 31, 0, 0, 0,
51370 & 223,0.006D0, 0,144, 32, 0, 0, 0,
51371 & 223,0.003D0, 0,145, 30, 0, 0, 0,
51372 & 223,0.009D0, 0,145, 31, 0, 0, 0,
51373 & 223,0.017D0, 0,145, 32, 0, 0, 0,
51374 & 223,0.011D0, 0,144,179, 0, 0, 0,
51375 & 223,0.015D0, 0,144,180, 0, 0, 0/
51376 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1274,1292)/
51377 & 223,0.011D0, 0,145,179, 0, 0, 0,
51378 & 223,0.022D0, 0,145,180, 0, 0, 0,
51379 & 223,0.001D0, 0,164, 25, 0, 0, 0,
51380 & 223,0.002D0, 0,164, 56, 0, 0, 0,
51381 & 223,0.001D0, 0,165, 25, 0, 0, 0,
51382 & 223,0.001D0, 0,165, 56, 0, 0, 0,
51383 & 223,0.001D0, 0,166, 25, 0, 0, 0,
51384 & 223,0.001D0, 0,166, 56, 0, 0, 0,
51385 & 223,0.207D0,100, 1, 8, 4, 9, 0,
51386 & 223,0.207D0,100, 3, 10, 4, 9, 0,
51387 & 223,0.024D0,100, 1, 8, 2, 9, 0,
51388 & 223,0.024D0,100, 3, 10, 2, 9, 0,
51389 & 223,0.012D0,100, 3, 8, 4, 9, 0,
51390 & 223,0.012D0,100, 1, 10, 4, 9, 0,
51391 & 223,0.069D0,100, 4, 8, 1, 9, 0,
51392 & 223,0.069D0,100, 4, 10, 3, 9, 0,
51393 & 223,0.008D0,100, 2, 8, 1, 9, 0,
51394 & 223,0.008D0,100, 2, 10, 3, 9, 0,
51395 & 223,0.004D0,100, 4, 8, 3, 9, 0/
51396 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1293,1311)/
51397 & 223,0.004D0,100, 4, 10, 1, 9, 0,
51398 & 224,0.090D0,100,121,128, 4,109, 0,
51399 & 224,0.090D0,100,123,130, 4,109, 0,
51400 & 224,0.045D0,100,125,132, 4,109, 0,
51401 & 224,0.010D0,100,121,128, 2,109, 0,
51402 & 224,0.010D0,100,123,130, 2,109, 0,
51403 & 224,0.005D0,100,125,132, 2,109, 0,
51404 & 224,0.242D0,100, 1, 8, 4,109, 0,
51405 & 224,0.242D0,100, 3, 10, 4,109, 0,
51406 & 224,0.027D0,100, 1, 8, 2,109, 0,
51407 & 224,0.027D0,100, 3, 10, 2,109, 0,
51408 & 224,0.012D0,100, 3, 8, 4,109, 0,
51409 & 224,0.012D0,100, 1, 10, 4,109, 0,
51410 & 224,0.081D0,100, 4, 8, 1,109, 0,
51411 & 224,0.081D0,100, 4, 10, 3,109, 0,
51412 & 224,0.009D0,100, 2, 8, 1,109, 0,
51413 & 224,0.009D0,100, 2, 10, 3,109, 0,
51414 & 224,0.004D0,100, 4, 8, 3,109, 0,
51415 & 224,0.004D0,100, 4, 10, 1,109, 0/
51416 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1312,1330)/
51417 & 225,0.090D0,100,121,128, 4,110, 0,
51418 & 225,0.090D0,100,123,130, 4,110, 0,
51419 & 225,0.045D0,100,125,132, 4,110, 0,
51420 & 225,0.010D0,100,121,128, 2,110, 0,
51421 & 225,0.010D0,100,123,130, 2,110, 0,
51422 & 225,0.005D0,100,125,132, 2,110, 0,
51423 & 225,0.242D0,100, 1, 8, 4,110, 0,
51424 & 225,0.242D0,100, 3, 10, 4,110, 0,
51425 & 225,0.027D0,100, 1, 8, 2,110, 0,
51426 & 225,0.027D0,100, 3, 10, 2,110, 0,
51427 & 225,0.012D0,100, 3, 8, 4,110, 0,
51428 & 225,0.012D0,100, 1, 10, 4,110, 0,
51429 & 225,0.081D0,100, 4, 8, 1,110, 0,
51430 & 225,0.081D0,100, 4, 10, 3,110, 0,
51431 & 225,0.009D0,100, 2, 8, 1,110, 0,
51432 & 225,0.009D0,100, 2, 10, 3,110, 0,
51433 & 225,0.004D0,100, 4, 8, 3,110, 0,
51434 & 225,0.004D0,100, 4, 10, 1,110, 0,
51435 & 226,0.090D0,100,121,128, 4,111, 0/
51436 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1331,1349)/
51437 & 226,0.090D0,100,123,130, 4,111, 0,
51438 & 226,0.045D0,100,125,132, 4,111, 0,
51439 & 226,0.010D0,100,121,128, 2,111, 0,
51440 & 226,0.010D0,100,123,130, 2,111, 0,
51441 & 226,0.005D0,100,125,132, 2,111, 0,
51442 & 226,0.242D0,100, 1, 8, 4,111, 0,
51443 & 226,0.242D0,100, 3, 10, 4,111, 0,
51444 & 226,0.027D0,100, 1, 8, 2,111, 0,
51445 & 226,0.027D0,100, 3, 10, 2,111, 0,
51446 & 226,0.012D0,100, 3, 8, 4,111, 0,
51447 & 226,0.012D0,100, 1, 10, 4,111, 0,
51448 & 226,0.081D0,100, 4, 8, 1,111, 0,
51449 & 226,0.081D0,100, 4, 10, 3,111, 0,
51450 & 226,0.009D0,100, 2, 8, 1,111, 0,
51451 & 226,0.009D0,100, 2, 10, 3,111, 0,
51452 & 226,0.004D0,100, 4, 8, 3,111, 0,
51453 & 226,0.004D0,100, 4, 10, 1,111, 0,
51454 & 227,0.090D0,100,121,128, 4,112, 0,
51455 & 227,0.090D0,100,123,130, 4,112, 0/
51456 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1350,1368)/
51457 & 227,0.045D0,100,125,132, 4,112, 0,
51458 & 227,0.010D0,100,121,128, 2,112, 0,
51459 & 227,0.010D0,100,123,130, 2,112, 0,
51460 & 227,0.005D0,100,125,132, 2,112, 0,
51461 & 227,0.242D0,100, 1, 8, 4,112, 0,
51462 & 227,0.242D0,100, 3, 10, 4,112, 0,
51463 & 227,0.027D0,100, 1, 8, 2,112, 0,
51464 & 227,0.027D0,100, 3, 10, 2,112, 0,
51465 & 227,0.012D0,100, 3, 8, 4,112, 0,
51466 & 227,0.012D0,100, 1, 10, 4,112, 0,
51467 & 227,0.081D0,100, 4, 8, 1,112, 0,
51468 & 227,0.081D0,100, 4, 10, 3,112, 0,
51469 & 227,0.009D0,100, 2, 8, 1,112, 0,
51470 & 227,0.009D0,100, 2, 10, 3,112, 0,
51471 & 227,0.004D0,100, 4, 8, 3,112, 0,
51472 & 227,0.004D0,100, 4, 10, 1,112, 0,
51473 & 228,0.090D0,100,121,128, 4,113, 0,
51474 & 228,0.090D0,100,123,130, 4,113, 0,
51475 & 228,0.045D0,100,125,132, 4,113, 0/
51476 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1369,1387)/
51477 & 228,0.010D0,100,121,128, 2,113, 0,
51478 & 228,0.010D0,100,123,130, 2,113, 0,
51479 & 228,0.005D0,100,125,132, 2,113, 0,
51480 & 228,0.242D0,100, 1, 8, 4,113, 0,
51481 & 228,0.242D0,100, 3, 10, 4,113, 0,
51482 & 228,0.027D0,100, 1, 8, 2,113, 0,
51483 & 228,0.027D0,100, 3, 10, 2,113, 0,
51484 & 228,0.012D0,100, 3, 8, 4,113, 0,
51485 & 228,0.012D0,100, 1, 10, 4,113, 0,
51486 & 228,0.081D0,100, 4, 8, 1,113, 0,
51487 & 228,0.081D0,100, 4, 10, 3,113, 0,
51488 & 228,0.009D0,100, 2, 8, 1,113, 0,
51489 & 228,0.009D0,100, 2, 10, 3,113, 0,
51490 & 228,0.004D0,100, 4, 8, 3,113, 0,
51491 & 228,0.004D0,100, 4, 10, 1,113, 0,
51492 & 229,0.090D0,100,121,128, 4,114, 0,
51493 & 229,0.090D0,100,123,130, 4,114, 0,
51494 & 229,0.045D0,100,125,132, 4,114, 0,
51495 & 229,0.010D0,100,121,128, 2,114, 0/
51496 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1388,1406)/
51497 & 229,0.010D0,100,123,130, 2,114, 0,
51498 & 229,0.005D0,100,125,132, 2,114, 0,
51499 & 229,0.242D0,100, 1, 8, 4,114, 0,
51500 & 229,0.242D0,100, 3, 10, 4,114, 0,
51501 & 229,0.027D0,100, 1, 8, 2,114, 0,
51502 & 229,0.027D0,100, 3, 10, 2,114, 0,
51503 & 229,0.012D0,100, 3, 8, 4,114, 0,
51504 & 229,0.012D0,100, 1, 10, 4,114, 0,
51505 & 229,0.081D0,100, 4, 8, 1,114, 0,
51506 & 229,0.081D0,100, 4, 10, 3,114, 0,
51507 & 229,0.009D0,100, 2, 8, 1,114, 0,
51508 & 229,0.009D0,100, 2, 10, 3,114, 0,
51509 & 229,0.004D0,100, 4, 8, 3,114, 0,
51510 & 229,0.004D0,100, 4, 10, 1,114, 0,
51511 & 230,0.080D0,100,121,128, 4, 10, 0,
51512 & 230,0.080D0,100,123,130, 4, 10, 0,
51513 & 230,0.040D0,100,125,132, 4, 10, 0,
51514 & 230,0.080D0,100,121,128, 9, 5, 0,
51515 & 230,0.080D0,100,123,130, 9, 5, 0/
51516 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1407,1425)/
51517 & 230,0.228D0,100, 1, 8, 4, 10, 0,
51518 & 230,0.228D0,100, 3, 10, 4, 10, 0,
51519 & 230,0.012D0,100, 3, 8, 4, 10, 0,
51520 & 230,0.012D0,100, 1, 10, 4, 10, 0,
51521 & 230,0.076D0,100, 4, 8, 1, 10, 0,
51522 & 230,0.076D0,100, 4, 10, 3, 10, 0,
51523 & 230,0.004D0,100, 4, 8, 3, 10, 0,
51524 & 230,0.004D0,100, 4, 10, 1, 10, 0,
51525 & 231,0.025D0, 0,121,127, 0, 0, 0,
51526 & 231,0.025D0, 0,123,129, 0, 0, 0,
51527 & 231,0.025D0, 0,125,131, 0, 0, 0,
51528 & 231,0.008D0, 0, 1, 7, 0, 0, 0,
51529 & 231,0.033D0, 0, 2, 8, 0, 0, 0,
51530 & 231,0.008D0, 0, 3, 9, 0, 0, 0,
51531 & 231,0.033D0, 0, 4, 10, 0, 0, 0,
51532 & 231,0.801D0,130, 13, 13, 13, 0, 0,
51533 & 231,0.042D0,130, 13, 13, 59, 0, 0,
51534 & 245,0.016D0,101,127,122,171, 0, 0,
51535 & 245,0.016D0,101,129,124,171, 0, 0/
51536 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1426,1444)/
51537 & 245,0.008D0,101,131,126,171, 0, 0,
51538 & 245,0.048D0,101,127,122,172, 0, 0,
51539 & 245,0.048D0,101,129,124,172, 0, 0,
51540 & 245,0.022D0,101,131,126,172, 0, 0,
51541 & 245,0.003D0,101,127,122,334, 0, 0,
51542 & 245,0.003D0,101,129,124,334, 0, 0,
51543 & 245,0.001D0,101,131,126,334, 0, 0,
51544 & 245,0.008D0,101,127,122,173, 0, 0,
51545 & 245,0.008D0,101,129,124,173, 0, 0,
51546 & 245,0.004D0,101,131,126,173, 0, 0,
51547 & 245,0.008D0,101,127,122,316, 0, 0,
51548 & 245,0.008D0,101,129,124,316, 0, 0,
51549 & 245,0.004D0,101,131,126,316, 0, 0,
51550 & 245,0.013D0,101,127,122,174, 0, 0,
51551 & 245,0.013D0,101,129,124,174, 0, 0,
51552 & 245,0.006D0,101,131,126,174, 0, 0,
51553 & 245,0.004D0, 0,171, 38, 0, 0, 0,
51554 & 245,0.010D0, 0,171, 39, 0, 0, 0,
51555 & 245,0.006D0, 0,171, 40, 0, 0, 0/
51556 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1445,1463)/
51557 & 245,0.003D0, 0,172, 38, 0, 0, 0,
51558 & 245,0.009D0, 0,172, 39, 0, 0, 0,
51559 & 245,0.017D0, 0,172, 40, 0, 0, 0,
51560 & 245,0.011D0, 0,171,144, 0, 0, 0,
51561 & 245,0.015D0, 0,171,145, 0, 0, 0,
51562 & 245,0.011D0, 0,172,144, 0, 0, 0,
51563 & 245,0.022D0, 0,172,145, 0, 0, 0,
51564 & 245,0.001D0, 0,164, 50, 0, 0, 0,
51565 & 245,0.002D0, 0,164, 51, 0, 0, 0,
51566 & 245,0.001D0, 0,165, 50, 0, 0, 0,
51567 & 245,0.001D0, 0,165, 51, 0, 0, 0,
51568 & 245,0.001D0, 0,166, 50, 0, 0, 0,
51569 & 245,0.001D0, 0,166, 51, 0, 0, 0,
51570 & 245,0.207D0,100, 7, 2, 10, 1, 0,
51571 & 245,0.207D0,100, 9, 4, 10, 1, 0,
51572 & 245,0.024D0,100, 7, 2, 8, 1, 0,
51573 & 245,0.024D0,100, 9, 4, 8, 1, 0,
51574 & 245,0.012D0,100, 9, 2, 10, 1, 0,
51575 & 245,0.012D0,100, 7, 4, 10, 1, 0/
51576 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1464,1482)/
51577 & 245,0.069D0,100, 10, 2, 7, 1, 0,
51578 & 245,0.069D0,100, 10, 4, 9, 1, 0,
51579 & 245,0.008D0,100, 8, 2, 7, 1, 0,
51580 & 245,0.008D0,100, 8, 4, 9, 1, 0,
51581 & 245,0.004D0,100, 10, 2, 9, 1, 0,
51582 & 245,0.004D0,100, 10, 4, 7, 1, 0,
51583 & 246,0.016D0,101,127,122,175, 0, 0,
51584 & 246,0.016D0,101,129,124,175, 0, 0,
51585 & 246,0.008D0,101,131,126,175, 0, 0,
51586 & 246,0.048D0,101,127,122,176, 0, 0,
51587 & 246,0.048D0,101,129,124,176, 0, 0,
51588 & 246,0.022D0,101,131,126,176, 0, 0,
51589 & 246,0.003D0,101,127,122,335, 0, 0,
51590 & 246,0.003D0,101,129,124,335, 0, 0,
51591 & 246,0.001D0,101,131,126,335, 0, 0,
51592 & 246,0.008D0,101,127,122,177, 0, 0,
51593 & 246,0.008D0,101,129,124,177, 0, 0,
51594 & 246,0.004D0,101,131,126,177, 0, 0,
51595 & 246,0.008D0,101,127,122,317, 0, 0/
51596 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1483,1501)/
51597 & 246,0.008D0,101,129,124,317, 0, 0,
51598 & 246,0.004D0,101,131,126,317, 0, 0,
51599 & 246,0.013D0,101,127,122,178, 0, 0,
51600 & 246,0.013D0,101,129,124,178, 0, 0,
51601 & 246,0.006D0,101,131,126,178, 0, 0,
51602 & 246,0.004D0, 0,175, 38, 0, 0, 0,
51603 & 246,0.010D0, 0,175, 39, 0, 0, 0,
51604 & 246,0.006D0, 0,175, 40, 0, 0, 0,
51605 & 246,0.003D0, 0,176, 38, 0, 0, 0,
51606 & 246,0.009D0, 0,176, 39, 0, 0, 0,
51607 & 246,0.017D0, 0,176, 40, 0, 0, 0,
51608 & 246,0.011D0, 0,175,144, 0, 0, 0,
51609 & 246,0.015D0, 0,175,145, 0, 0, 0,
51610 & 246,0.011D0, 0,176,144, 0, 0, 0,
51611 & 246,0.022D0, 0,176,145, 0, 0, 0,
51612 & 246,0.001D0, 0,164, 46, 0, 0, 0,
51613 & 246,0.002D0, 0,164, 47, 0, 0, 0,
51614 & 246,0.001D0, 0,165, 46, 0, 0, 0,
51615 & 246,0.001D0, 0,165, 47, 0, 0, 0/
51616 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1502,1520)/
51617 & 246,0.001D0, 0,166, 46, 0, 0, 0,
51618 & 246,0.001D0, 0,166, 47, 0, 0, 0,
51619 & 246,0.207D0,100, 7, 2, 10, 2, 0,
51620 & 246,0.207D0,100, 9, 4, 10, 2, 0,
51621 & 246,0.024D0,100, 7, 2, 8, 2, 0,
51622 & 246,0.024D0,100, 9, 4, 8, 2, 0,
51623 & 246,0.012D0,100, 9, 2, 10, 2, 0,
51624 & 246,0.012D0,100, 7, 4, 10, 2, 0,
51625 & 246,0.069D0,100, 10, 2, 7, 2, 0,
51626 & 246,0.069D0,100, 10, 4, 9, 2, 0,
51627 & 246,0.008D0,100, 8, 2, 7, 2, 0,
51628 & 246,0.008D0,100, 8, 4, 9, 2, 0,
51629 & 246,0.004D0,100, 10, 2, 9, 2, 0,
51630 & 246,0.004D0,100, 10, 4, 7, 2, 0,
51631 & 247,0.016D0,101,127,122,179, 0, 0,
51632 & 247,0.016D0,101,129,124,179, 0, 0,
51633 & 247,0.008D0,101,131,126,179, 0, 0,
51634 & 247,0.048D0,101,127,122,180, 0, 0,
51635 & 247,0.048D0,101,129,124,180, 0, 0/
51636 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1521,1539)/
51637 & 247,0.022D0,101,131,126,180, 0, 0,
51638 & 247,0.003D0,101,127,122,336, 0, 0,
51639 & 247,0.003D0,101,129,124,336, 0, 0,
51640 & 247,0.001D0,101,131,126,336, 0, 0,
51641 & 247,0.008D0,101,127,122,181, 0, 0,
51642 & 247,0.008D0,101,129,124,181, 0, 0,
51643 & 247,0.004D0,101,131,126,181, 0, 0,
51644 & 247,0.008D0,101,127,122,318, 0, 0,
51645 & 247,0.008D0,101,129,124,318, 0, 0,
51646 & 247,0.004D0,101,131,126,318, 0, 0,
51647 & 247,0.013D0,101,127,122,182, 0, 0,
51648 & 247,0.013D0,101,129,124,182, 0, 0,
51649 & 247,0.006D0,101,131,126,182, 0, 0,
51650 & 247,0.004D0, 0,179, 38, 0, 0, 0,
51651 & 247,0.010D0, 0,179, 39, 0, 0, 0,
51652 & 247,0.006D0, 0,179, 40, 0, 0, 0,
51653 & 247,0.003D0, 0,180, 38, 0, 0, 0,
51654 & 247,0.009D0, 0,180, 39, 0, 0, 0,
51655 & 247,0.017D0, 0,180, 40, 0, 0, 0/
51656 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1540,1558)/
51657 & 247,0.011D0, 0,179,144, 0, 0, 0,
51658 & 247,0.015D0, 0,179,145, 0, 0, 0,
51659 & 247,0.011D0, 0,180,144, 0, 0, 0,
51660 & 247,0.022D0, 0,180,145, 0, 0, 0,
51661 & 247,0.001D0, 0,164, 25, 0, 0, 0,
51662 & 247,0.002D0, 0,164, 56, 0, 0, 0,
51663 & 247,0.001D0, 0,165, 25, 0, 0, 0,
51664 & 247,0.001D0, 0,165, 56, 0, 0, 0,
51665 & 247,0.001D0, 0,166, 25, 0, 0, 0,
51666 & 247,0.001D0, 0,166, 56, 0, 0, 0,
51667 & 247,0.207D0,100, 7, 2, 10, 3, 0,
51668 & 247,0.207D0,100, 9, 4, 10, 3, 0,
51669 & 247,0.024D0,100, 7, 2, 8, 3, 0,
51670 & 247,0.024D0,100, 9, 4, 8, 3, 0,
51671 & 247,0.012D0,100, 9, 2, 10, 3, 0,
51672 & 247,0.012D0,100, 7, 4, 10, 3, 0,
51673 & 247,0.069D0,100, 10, 2, 7, 3, 0,
51674 & 247,0.069D0,100, 10, 4, 9, 3, 0,
51675 & 247,0.008D0,100, 8, 2, 7, 3, 0/
51676 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1559,1577)/
51677 & 247,0.008D0,100, 8, 4, 9, 3, 0,
51678 & 247,0.004D0,100, 10, 2, 9, 3, 0,
51679 & 247,0.004D0,100, 10, 4, 7, 3, 0,
51680 & 248,0.090D0,100,127,122, 10,115, 0,
51681 & 248,0.090D0,100,129,124, 10,115, 0,
51682 & 248,0.045D0,100,131,126, 10,115, 0,
51683 & 248,0.010D0,100,127,122, 8,115, 0,
51684 & 248,0.010D0,100,129,124, 8,115, 0,
51685 & 248,0.005D0,100,131,126, 8,115, 0,
51686 & 248,0.242D0,100, 7, 2, 10,115, 0,
51687 & 248,0.242D0,100, 9, 4, 10,115, 0,
51688 & 248,0.027D0,100, 7, 2, 8,115, 0,
51689 & 248,0.027D0,100, 9, 4, 8,115, 0,
51690 & 248,0.012D0,100, 9, 2, 10,115, 0,
51691 & 248,0.012D0,100, 7, 4, 10,115, 0,
51692 & 248,0.081D0,100, 10, 2, 7,115, 0,
51693 & 248,0.081D0,100, 10, 4, 9,115, 0,
51694 & 248,0.009D0,100, 8, 2, 7,115, 0,
51695 & 248,0.009D0,100, 8, 4, 9,115, 0/
51696 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1578,1596)/
51697 & 248,0.004D0,100, 10, 2, 9,115, 0,
51698 & 248,0.004D0,100, 10, 4, 7,115, 0,
51699 & 249,0.090D0,100,127,122, 10,116, 0,
51700 & 249,0.090D0,100,129,124, 10,116, 0,
51701 & 249,0.045D0,100,131,126, 10,116, 0,
51702 & 249,0.010D0,100,127,122, 8,116, 0,
51703 & 249,0.010D0,100,129,124, 8,116, 0,
51704 & 249,0.005D0,100,131,126, 8,116, 0,
51705 & 249,0.242D0,100, 7, 2, 10,116, 0,
51706 & 249,0.242D0,100, 9, 4, 10,116, 0,
51707 & 249,0.027D0,100, 7, 2, 8,116, 0,
51708 & 249,0.027D0,100, 9, 4, 8,116, 0,
51709 & 249,0.012D0,100, 9, 2, 10,116, 0,
51710 & 249,0.012D0,100, 7, 4, 10,116, 0,
51711 & 249,0.081D0,100, 10, 2, 7,116, 0,
51712 & 249,0.081D0,100, 10, 4, 9,116, 0,
51713 & 249,0.009D0,100, 8, 2, 7,116, 0,
51714 & 249,0.009D0,100, 8, 4, 9,116, 0,
51715 & 249,0.004D0,100, 10, 2, 9,116, 0/
51716 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1597,1615)/
51717 & 249,0.004D0,100, 10, 4, 7,116, 0,
51718 & 250,0.090D0,100,127,122, 10,117, 0,
51719 & 250,0.090D0,100,129,124, 10,117, 0,
51720 & 250,0.045D0,100,131,126, 10,117, 0,
51721 & 250,0.010D0,100,127,122, 8,117, 0,
51722 & 250,0.010D0,100,129,124, 8,117, 0,
51723 & 250,0.005D0,100,131,126, 8,117, 0,
51724 & 250,0.242D0,100, 7, 2, 10,117, 0,
51725 & 250,0.242D0,100, 9, 4, 10,117, 0,
51726 & 250,0.027D0,100, 7, 2, 8,117, 0,
51727 & 250,0.027D0,100, 9, 4, 8,117, 0,
51728 & 250,0.012D0,100, 9, 2, 10,117, 0,
51729 & 250,0.012D0,100, 7, 4, 10,117, 0,
51730 & 250,0.081D0,100, 10, 2, 7,117, 0,
51731 & 250,0.081D0,100, 10, 4, 9,117, 0,
51732 & 250,0.009D0,100, 8, 2, 7,117, 0,
51733 & 250,0.009D0,100, 8, 4, 9,117, 0,
51734 & 250,0.004D0,100, 10, 2, 9,117, 0,
51735 & 250,0.004D0,100, 10, 4, 7,117, 0/
51736 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1616,1634)/
51737 & 251,0.090D0,100,127,122, 10,118, 0,
51738 & 251,0.090D0,100,129,124, 10,118, 0,
51739 & 251,0.045D0,100,131,126, 10,118, 0,
51740 & 251,0.010D0,100,127,122, 8,118, 0,
51741 & 251,0.010D0,100,129,124, 8,118, 0,
51742 & 251,0.005D0,100,131,126, 8,118, 0,
51743 & 251,0.242D0,100, 7, 2, 10,118, 0,
51744 & 251,0.242D0,100, 9, 4, 10,118, 0,
51745 & 251,0.027D0,100, 7, 2, 8,118, 0,
51746 & 251,0.027D0,100, 9, 4, 8,118, 0,
51747 & 251,0.012D0,100, 9, 2, 10,118, 0,
51748 & 251,0.012D0,100, 7, 4, 10,118, 0,
51749 & 251,0.081D0,100, 10, 2, 7,118, 0,
51750 & 251,0.081D0,100, 10, 4, 9,118, 0,
51751 & 251,0.009D0,100, 8, 2, 7,118, 0,
51752 & 251,0.009D0,100, 8, 4, 9,118, 0,
51753 & 251,0.004D0,100, 10, 2, 9,118, 0,
51754 & 251,0.004D0,100, 10, 4, 7,118, 0,
51755 & 252,0.090D0,100,127,122, 10,119, 0/
51756 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1635,1653)/
51757 & 252,0.090D0,100,129,124, 10,119, 0,
51758 & 252,0.045D0,100,131,126, 10,119, 0,
51759 & 252,0.010D0,100,127,122, 8,119, 0,
51760 & 252,0.010D0,100,129,124, 8,119, 0,
51761 & 252,0.005D0,100,131,126, 8,119, 0,
51762 & 252,0.242D0,100, 7, 2, 10,119, 0,
51763 & 252,0.242D0,100, 9, 4, 10,119, 0,
51764 & 252,0.027D0,100, 7, 2, 8,119, 0,
51765 & 252,0.027D0,100, 9, 4, 8,119, 0,
51766 & 252,0.012D0,100, 9, 2, 10,119, 0,
51767 & 252,0.012D0,100, 7, 4, 10,119, 0,
51768 & 252,0.081D0,100, 10, 2, 7,119, 0,
51769 & 252,0.081D0,100, 10, 4, 9,119, 0,
51770 & 252,0.009D0,100, 8, 2, 7,119, 0,
51771 & 252,0.009D0,100, 8, 4, 9,119, 0,
51772 & 252,0.004D0,100, 10, 2, 9,119, 0,
51773 & 252,0.004D0,100, 10, 4, 7,119, 0,
51774 & 253,0.090D0,100,127,122, 10,120, 0,
51775 & 253,0.090D0,100,129,124, 10,120, 0/
51776 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1654,1672)/
51777 & 253,0.045D0,100,131,126, 10,120, 0,
51778 & 253,0.010D0,100,127,122, 8,120, 0,
51779 & 253,0.010D0,100,129,124, 8,120, 0,
51780 & 253,0.005D0,100,131,126, 8,120, 0,
51781 & 253,0.242D0,100, 7, 2, 10,120, 0,
51782 & 253,0.242D0,100, 9, 4, 10,120, 0,
51783 & 253,0.027D0,100, 7, 2, 8,120, 0,
51784 & 253,0.027D0,100, 9, 4, 8,120, 0,
51785 & 253,0.012D0,100, 9, 2, 10,120, 0,
51786 & 253,0.012D0,100, 7, 4, 10,120, 0,
51787 & 253,0.081D0,100, 10, 2, 7,120, 0,
51788 & 253,0.081D0,100, 10, 4, 9,120, 0,
51789 & 253,0.009D0,100, 8, 2, 7,120, 0,
51790 & 253,0.009D0,100, 8, 4, 9,120, 0,
51791 & 253,0.004D0,100, 10, 2, 9,120, 0,
51792 & 253,0.004D0,100, 10, 4, 7,120, 0,
51793 & 254,0.080D0,100,127,122, 10, 4, 0,
51794 & 254,0.080D0,100,129,124, 10, 4, 0,
51795 & 254,0.040D0,100,131,126, 10, 4, 0/
51796 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1673,1691)/
51797 & 254,0.080D0,100,127,122, 3, 11, 0,
51798 & 254,0.080D0,100,129,124, 3, 11, 0,
51799 & 254,0.228D0,100, 7, 2, 10, 4, 0,
51800 & 254,0.228D0,100, 9, 4, 10, 4, 0,
51801 & 254,0.012D0,100, 9, 2, 10, 4, 0,
51802 & 254,0.012D0,100, 7, 4, 10, 4, 0,
51803 & 254,0.076D0,100, 10, 2, 7, 4, 0,
51804 & 254,0.076D0,100, 10, 4, 9, 4, 0,
51805 & 254,0.004D0,100, 10, 2, 9, 4, 0,
51806 & 254,0.004D0,100, 10, 4, 7, 4, 0,
51807 & 265,1.000D0, 0,221, 59, 0, 0, 0,
51808 & 266,1.000D0, 0,222, 59, 0, 0, 0,
51809 & 267,1.000D0, 0,223, 59, 0, 0, 0,
51810 & 268,0.667D0, 0,266, 38, 0, 0, 0,
51811 & 268,0.333D0, 0,265, 21, 0, 0, 0,
51812 & 269,0.667D0, 0,265, 30, 0, 0, 0,
51813 & 269,0.333D0, 0,266, 21, 0, 0, 0,
51814 & 270,0.500D0, 0,265, 50, 0, 0, 0,
51815 & 270,0.500D0, 0,266, 46, 0, 0, 0/
51816 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1692,1710)/
51817 & 271,0.290D0, 0,266, 38, 0, 0, 0,
51818 & 271,0.150D0, 0,265, 21, 0, 0, 0,
51819 & 271,0.290D0, 0,222, 38, 0, 0, 0,
51820 & 271,0.150D0, 0,221, 21, 0, 0, 0,
51821 & 271,0.060D0, 0,266, 38, 21, 0, 0,
51822 & 271,0.020D0, 0,265, 38, 30, 0, 0,
51823 & 271,0.010D0, 0,265, 21, 21, 0, 0,
51824 & 271,0.020D0, 0,222, 38, 21, 0, 0,
51825 & 271,0.010D0, 0,221, 38, 30, 0, 0,
51826 & 272,0.290D0, 0,265, 30, 0, 0, 0,
51827 & 272,0.150D0, 0,266, 21, 0, 0, 0,
51828 & 272,0.290D0, 0,221, 30, 0, 0, 0,
51829 & 272,0.150D0, 0,222, 21, 0, 0, 0,
51830 & 272,0.060D0, 0,265, 30, 21, 0, 0,
51831 & 272,0.020D0, 0,266, 38, 30, 0, 0,
51832 & 272,0.010D0, 0,266, 21, 21, 0, 0,
51833 & 272,0.020D0, 0,221, 30, 21, 0, 0,
51834 & 272,0.010D0, 0,222, 38, 30, 0, 0,
51835 & 273,0.350D0, 0,221, 50, 0, 0, 0/
51836 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1711,1729)/
51837 & 273,0.350D0, 0,222, 46, 0, 0, 0,
51838 & 273,0.150D0, 0,265, 50, 0, 0, 0,
51839 & 273,0.150D0, 0,266, 46, 0, 0, 0,
51840 & 274,1.000D0, 0,245, 59, 0, 0, 0,
51841 & 275,1.000D0, 0,246, 59, 0, 0, 0,
51842 & 276,1.000D0, 0,247, 59, 0, 0, 0,
51843 & 277,0.667D0, 0,275, 30, 0, 0, 0,
51844 & 277,0.333D0, 0,274, 21, 0, 0, 0,
51845 & 278,0.667D0, 0,274, 38, 0, 0, 0,
51846 & 278,0.333D0, 0,275, 21, 0, 0, 0,
51847 & 279,0.500D0, 0,274, 42, 0, 0, 0,
51848 & 279,0.500D0, 0,275, 34, 0, 0, 0,
51849 & 280,0.290D0, 0,275, 30, 0, 0, 0,
51850 & 280,0.150D0, 0,274, 21, 0, 0, 0,
51851 & 280,0.290D0, 0,246, 30, 0, 0, 0,
51852 & 280,0.150D0, 0,245, 21, 0, 0, 0,
51853 & 280,0.060D0, 0,275, 30, 21, 0, 0,
51854 & 280,0.020D0, 0,274, 38, 30, 0, 0,
51855 & 280,0.010D0, 0,274, 21, 21, 0, 0/
51856 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1730,1748)/
51857 & 280,0.020D0, 0,246, 30, 21, 0, 0,
51858 & 280,0.010D0, 0,245, 38, 30, 0, 0,
51859 & 281,0.290D0, 0,274, 38, 0, 0, 0,
51860 & 281,0.150D0, 0,275, 21, 0, 0, 0,
51861 & 281,0.290D0, 0,245, 38, 0, 0, 0,
51862 & 281,0.150D0, 0,246, 21, 0, 0, 0,
51863 & 281,0.060D0, 0,274, 38, 21, 0, 0,
51864 & 281,0.020D0, 0,275, 38, 30, 0, 0,
51865 & 281,0.010D0, 0,275, 21, 21, 0, 0,
51866 & 281,0.020D0, 0,245, 38, 21, 0, 0,
51867 & 281,0.010D0, 0,246, 38, 30, 0, 0,
51868 & 282,0.350D0, 0,245, 42, 0, 0, 0,
51869 & 282,0.350D0, 0,246, 34, 0, 0, 0,
51870 & 282,0.150D0, 0,274, 42, 0, 0, 0,
51871 & 282,0.150D0, 0,275, 34, 0, 0, 0,
51872 & 285,1.000D0, 0, 24, 21, 0, 0, 0,
51873 & 286,0.998D0, 0, 24, 38, 0, 0, 0,
51874 & 286,0.002D0, 0, 38, 59, 0, 0, 0,
51875 & 287,0.998D0, 0, 24, 30, 0, 0, 0/
51876 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1749,1767)/
51877 & 287,0.002D0, 0, 30, 59, 0, 0, 0,
51878 & 288,0.330D0, 0, 39, 30, 0, 0, 0,
51879 & 288,0.340D0, 0, 23, 21, 0, 0, 0,
51880 & 288,0.330D0, 0, 31, 38, 0, 0, 0,
51881 & 289,0.250D0, 0, 46, 35, 0, 0, 0,
51882 & 289,0.250D0, 0, 34, 47, 0, 0, 0,
51883 & 289,0.250D0, 0, 50, 43, 0, 0, 0,
51884 & 289,0.250D0, 0, 42, 51, 0, 0, 0,
51885 & 290,0.996D0, 0, 22, 21, 0, 0, 0,
51886 & 290,0.002D0, 0, 46, 34, 0, 0, 0,
51887 & 290,0.002D0, 0, 50, 42, 0, 0, 0,
51888 & 291,0.996D0, 0, 22, 38, 0, 0, 0,
51889 & 291,0.004D0, 0, 46, 42, 0, 0, 0,
51890 & 292,0.996D0, 0, 22, 30, 0, 0, 0,
51891 & 292,0.004D0, 0, 50, 34, 0, 0, 0,
51892 & 293,0.520D0, 0, 38, 30, 0, 0, 0,
51893 & 293,0.260D0, 0, 21, 21, 0, 0, 0,
51894 & 293,0.110D0, 0, 46, 34, 0, 0, 0,
51895 & 293,0.110D0, 0, 50, 42, 0, 0, 0/
51896 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1768,1786)/
51897 & 294,0.620D0, 0, 38, 30, 0, 0, 0,
51898 & 294,0.310D0, 0, 21, 21, 0, 0, 0,
51899 & 294,0.035D0, 0, 46, 34, 0, 0, 0,
51900 & 294,0.035D0, 0, 50, 42, 0, 0, 0,
51901 & 295,1.000D0, 0,254, 59, 0, 0, 0,
51902 & 296,1.000D0, 0,230, 59, 0, 0, 0,
51903 & 297,1.000D0, 0,254, 59, 0, 0, 0,
51904 & 298,1.000D0, 0,230, 59, 0, 0, 0,
51905 & 299,1.000D0, 0,254, 59, 0, 0, 0,
51906 & 300,1.000D0, 0,230, 59, 0, 0, 0,
51907 & 301,0.050D0, 0,121,127, 0, 0, 0,
51908 & 301,0.050D0, 0,123,129, 0, 0, 0,
51909 & 301,0.017D0, 0, 1, 7, 0, 0, 0,
51910 & 301,0.066D0, 0, 2, 8, 0, 0, 0,
51911 & 301,0.017D0, 0, 3, 9, 0, 0, 0,
51912 & 301,0.640D0,130, 13, 13, 13, 0, 0,
51913 & 301,0.160D0,130, 13, 13, 59, 0, 0,
51914 & 302,0.022D0, 0, 38, 30, 38, 30, 23,
51915 & 302,0.016D0, 0, 38, 30, 38, 30, 0/
51916 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1787,1805)/
51917 & 302,0.009D0, 0, 38, 30, 46, 34, 0,
51918 & 302,0.004D0, 0, 23, 38, 30, 0, 0,
51919 & 302,0.002D0, 0, 46, 43, 30, 0, 0,
51920 & 302,0.002D0, 0, 34, 51, 38, 0, 0,
51921 & 302,0.001D0, 0, 38, 30, 73, 91, 0,
51922 & 302,0.273D0, 0, 59,164, 0, 0, 0,
51923 & 302,0.671D0, 0, 13, 13, 0, 0, 0,
51924 & 303,0.022D0, 0, 38, 30, 38, 30, 0,
51925 & 303,0.019D0, 0, 38, 30, 46, 34, 0,
51926 & 303,0.012D0, 0, 38, 30, 38, 30, 23,
51927 & 303,0.007D0, 0, 23, 38, 30, 0, 0,
51928 & 303,0.002D0, 0, 46, 43, 30, 0, 0,
51929 & 303,0.002D0, 0, 34, 51, 38, 0, 0,
51930 & 303,0.003D0, 0, 38, 30, 73, 91, 0,
51931 & 303,0.002D0, 0, 38, 30, 0, 0, 0,
51932 & 303,0.002D0, 0, 46, 34, 0, 0, 0,
51933 & 303,0.001D0, 0, 21, 21, 0, 0, 0,
51934 & 303,0.135D0, 0, 59,164, 0, 0, 0,
51935 & 303,0.793D0, 0, 13, 13, 0, 0, 0/
51936 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1806,1824)/
51937 & 304,1.000D0, 0, 13, 13, 0, 0, 0,
51938 & 305,1.000D0, 0, 13, 13, 0, 0, 0,
51939 & 306,0.050D0, 0, 59,231, 0, 0, 0,
51940 & 306,0.950D0, 0, 13, 13, 0, 0, 0,
51941 & 307,0.350D0, 0, 59,231, 0, 0, 0,
51942 & 307,0.650D0, 0, 13, 13, 0, 0, 0,
51943 & 308,0.220D0, 0, 59,231, 0, 0, 0,
51944 & 308,0.780D0, 0, 13, 13, 0, 0, 0,
51945 & 309,0.280D0, 0, 46, 31, 0, 0, 0,
51946 & 309,0.140D0, 0, 50, 23, 0, 0, 0,
51947 & 309,0.187D0, 0,327, 30, 0, 0, 0,
51948 & 309,0.093D0, 0,328, 21, 0, 0, 0,
51949 & 309,0.110D0, 0, 50, 24, 0, 0, 0,
51950 & 309,0.107D0, 0, 47, 30, 0, 0, 0,
51951 & 309,0.053D0, 0, 51, 21, 0, 0, 0,
51952 & 309,0.030D0, 0, 50,293, 0, 0, 0,
51953 & 310,0.280D0, 0, 50, 39, 0, 0, 0,
51954 & 310,0.140D0, 0, 46, 23, 0, 0, 0,
51955 & 310,0.187D0, 0,328, 38, 0, 0, 0/
51956 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1825,1843)/
51957 & 310,0.093D0, 0,327, 21, 0, 0, 0,
51958 & 310,0.110D0, 0, 46, 24, 0, 0, 0,
51959 & 310,0.107D0, 0, 51, 38, 0, 0, 0,
51960 & 310,0.053D0, 0, 47, 21, 0, 0, 0,
51961 & 310,0.030D0, 0, 46,293, 0, 0, 0,
51962 & 311,0.280D0, 0, 34, 39, 0, 0, 0,
51963 & 311,0.140D0, 0, 42, 23, 0, 0, 0,
51964 & 311,0.187D0, 0,330, 38, 0, 0, 0,
51965 & 311,0.093D0, 0,329, 21, 0, 0, 0,
51966 & 311,0.110D0, 0, 42, 24, 0, 0, 0,
51967 & 311,0.107D0, 0, 35, 38, 0, 0, 0,
51968 & 311,0.053D0, 0, 43, 21, 0, 0, 0,
51969 & 311,0.030D0, 0, 42,293, 0, 0, 0,
51970 & 312,0.280D0, 0, 42, 31, 0, 0, 0,
51971 & 312,0.140D0, 0, 34, 23, 0, 0, 0,
51972 & 312,0.187D0, 0,329, 30, 0, 0, 0,
51973 & 312,0.093D0, 0,330, 21, 0, 0, 0,
51974 & 312,0.110D0, 0, 34, 24, 0, 0, 0,
51975 & 312,0.107D0, 0, 43, 30, 0, 0, 0/
51976 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1844,1862)/
51977 & 312,0.053D0, 0, 35, 21, 0, 0, 0,
51978 & 312,0.030D0, 0, 34,293, 0, 0, 0,
51979 & 313,0.430D0, 0,140, 38, 0, 0, 0,
51980 & 313,0.215D0, 0,136, 21, 0, 0, 0,
51981 & 313,0.235D0, 0,140, 38, 21, 0, 0,
51982 & 313,0.120D0, 0,136, 38, 30, 0, 0,
51983 & 314,0.430D0, 0,136, 30, 0, 0, 0,
51984 & 314,0.215D0, 0,140, 21, 0, 0, 0,
51985 & 314,0.235D0, 0,136, 30, 21, 0, 0,
51986 & 314,0.120D0, 0,140, 38, 30, 0, 0,
51987 & 315,0.480D0, 0,136, 50, 0, 0, 0,
51988 & 315,0.480D0, 0,140, 46, 0, 0, 0,
51989 & 315,0.040D0, 0,145, 59, 0, 0, 0,
51990 & 316,0.430D0, 0,175, 30, 0, 0, 0,
51991 & 316,0.215D0, 0,171, 21, 0, 0, 0,
51992 & 316,0.235D0, 0,175, 30, 21, 0, 0,
51993 & 316,0.120D0, 0,171, 38, 30, 0, 0,
51994 & 317,0.430D0, 0,171, 38, 0, 0, 0,
51995 & 317,0.215D0, 0,175, 21, 0, 0, 0/
51996 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1863,1881)/
51997 & 317,0.235D0, 0,171, 38, 21, 0, 0,
51998 & 317,0.120D0, 0,175, 38, 30, 0, 0,
51999 & 318,0.480D0, 0,171, 42, 0, 0, 0,
52000 & 318,0.480D0, 0,175, 34, 0, 0, 0,
52001 & 318,0.040D0, 0,180, 59, 0, 0, 0,
52002 & 319,0.540D0, 0,275, 30, 0, 0, 0,
52003 & 319,0.270D0, 0,274, 21, 0, 0, 0,
52004 & 319,0.030D0, 0,275, 30, 21, 0, 0,
52005 & 319,0.010D0, 0,274, 38, 30, 0, 0,
52006 & 319,0.010D0, 0,274, 21, 21, 0, 0,
52007 & 319,0.090D0, 0,246, 30, 21, 0, 0,
52008 & 319,0.030D0, 0,245, 38, 30, 0, 0,
52009 & 319,0.020D0, 0,245, 21, 21, 0, 0,
52010 & 320,0.540D0, 0,274, 38, 0, 0, 0,
52011 & 320,0.270D0, 0,275, 21, 0, 0, 0,
52012 & 320,0.030D0, 0,274, 38, 21, 0, 0,
52013 & 320,0.010D0, 0,275, 38, 30, 0, 0,
52014 & 320,0.010D0, 0,275, 21, 21, 0, 0,
52015 & 320,0.090D0, 0,245, 38, 21, 0, 0/
52016 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1882,1900)/
52017 & 320,0.030D0, 0,246, 38, 30, 0, 0,
52018 & 320,0.020D0, 0,246, 21, 21, 0, 0,
52019 & 321,0.500D0, 0,266, 46, 0, 0, 0,
52020 & 321,0.500D0, 0,265, 50, 0, 0, 0,
52021 & 322,1.000D0, 0,254, 59, 0, 0, 0,
52022 & 323,0.540D0, 0,266, 38, 0, 0, 0,
52023 & 323,0.270D0, 0,265, 21, 0, 0, 0,
52024 & 323,0.030D0, 0,266, 38, 21, 0, 0,
52025 & 323,0.010D0, 0,265, 38, 30, 0, 0,
52026 & 323,0.010D0, 0,265, 21, 21, 0, 0,
52027 & 323,0.090D0, 0,222, 38, 21, 0, 0,
52028 & 323,0.030D0, 0,221, 38, 30, 0, 0,
52029 & 323,0.020D0, 0,221, 21, 21, 0, 0,
52030 & 324,0.540D0, 0,265, 30, 0, 0, 0,
52031 & 324,0.270D0, 0,266, 21, 0, 0, 0,
52032 & 324,0.030D0, 0,265, 30, 21, 0, 0,
52033 & 324,0.010D0, 0,266, 38, 30, 0, 0,
52034 & 324,0.010D0, 0,266, 21, 21, 0, 0,
52035 & 324,0.090D0, 0,221, 30, 21, 0, 0/
52036 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1901,1919)/
52037 & 324,0.030D0, 0,222, 38, 30, 0, 0,
52038 & 324,0.020D0, 0,222, 21, 21, 0, 0,
52039 & 325,0.500D0, 0,275, 34, 0, 0, 0,
52040 & 325,0.500D0, 0,274, 42, 0, 0, 0,
52041 & 326,1.000D0, 0,230, 59, 0, 0, 0,
52042 & 327,0.667D0, 0, 50, 38, 0, 0, 0,
52043 & 327,0.333D0, 0, 46, 21, 0, 0, 0,
52044 & 328,0.667D0, 0, 46, 30, 0, 0, 0,
52045 & 328,0.333D0, 0, 50, 21, 0, 0, 0,
52046 & 329,0.667D0, 0, 34, 38, 0, 0, 0,
52047 & 329,0.333D0, 0, 42, 21, 0, 0, 0,
52048 & 330,0.667D0, 0, 42, 30, 0, 0, 0,
52049 & 330,0.333D0, 0, 34, 21, 0, 0, 0,
52050 & 331,0.667D0, 0,140, 38, 0, 0, 0,
52051 & 331,0.333D0, 0,136, 21, 0, 0, 0,
52052 & 332,0.667D0, 0,136, 30, 0, 0, 0,
52053 & 332,0.333D0, 0,140, 21, 0, 0, 0,
52054 & 333,0.500D0, 0,136, 50, 0, 0, 0,
52055 & 333,0.500D0, 0,140, 46, 0, 0, 0/
52056 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1920,1938)/
52057 & 334,0.667D0, 0,175, 30, 0, 0, 0,
52058 & 334,0.333D0, 0,171, 21, 0, 0, 0,
52059 & 335,0.667D0, 0,171, 38, 0, 0, 0,
52060 & 335,0.333D0, 0,175, 21, 0, 0, 0,
52061 & 336,0.500D0, 0,171, 42, 0, 0, 0,
52062 & 336,0.500D0, 0,175, 34, 0, 0, 0,
52063 & 337,0.667D0, 0,246, 30, 0, 0, 0,
52064 & 337,0.333D0, 0,245, 21, 0, 0, 0,
52065 & 338,0.667D0, 0,245, 38, 0, 0, 0,
52066 & 338,0.333D0, 0,246, 21, 0, 0, 0,
52067 & 339,0.500D0, 0,246, 34, 0, 0, 0,
52068 & 339,0.500D0, 0,245, 42, 0, 0, 0,
52069 & 340,1.000D0, 0,254, 59, 0, 0, 0,
52070 & 341,0.667D0, 0,222, 38, 0, 0, 0,
52071 & 341,0.333D0, 0,221, 21, 0, 0, 0,
52072 & 342,0.667D0, 0,221, 30, 0, 0, 0,
52073 & 342,0.333D0, 0,222, 21, 0, 0, 0,
52074 & 343,0.500D0, 0,222, 46, 0, 0, 0,
52075 & 343,0.500D0, 0,221, 50, 0, 0, 0/
52076 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1939,1957)/
52077 & 344,1.000D0, 0,230, 59, 0, 0, 0,
52078 & 345,1.000D0, 0,225, 30, 0, 0, 0,
52079 & 346,1.000D0, 0,225, 21, 0, 0, 0,
52080 & 347,1.000D0, 0,225, 21, 0, 0, 0,
52081 & 348,1.000D0, 0,225, 38, 0, 0, 0,
52082 & 349,0.600D0, 0,228, 38, 0, 0, 0,
52083 & 349,0.300D0, 0,227, 21, 0, 0, 0,
52084 & 349,0.100D0, 0,227, 59, 0, 0, 0,
52085 & 350,0.600D0, 0,228, 38, 0, 0, 0,
52086 & 350,0.300D0, 0,227, 21, 0, 0, 0,
52087 & 350,0.100D0, 0,227, 59, 0, 0, 0,
52088 & 351,0.600D0, 0,227, 30, 0, 0, 0,
52089 & 351,0.300D0, 0,228, 21, 0, 0, 0,
52090 & 351,0.100D0, 0,228, 59, 0, 0, 0,
52091 & 352,0.600D0, 0,227, 30, 0, 0, 0,
52092 & 352,0.300D0, 0,228, 21, 0, 0, 0,
52093 & 352,0.100D0, 0,228, 59, 0, 0, 0,
52094 & 353,1.000D0, 0,229, 59, 0, 0, 0,
52095 & 354,1.000D0, 0,249, 38, 0, 0, 0/
52096 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1958,1976)/
52097 & 355,1.000D0, 0,249, 21, 0, 0, 0,
52098 & 356,1.000D0, 0,249, 21, 0, 0, 0,
52099 & 357,1.000D0, 0,249, 30, 0, 0, 0,
52100 & 358,0.600D0, 0,252, 30, 0, 0, 0,
52101 & 358,0.300D0, 0,251, 21, 0, 0, 0,
52102 & 358,0.100D0, 0,251, 59, 0, 0, 0,
52103 & 359,0.600D0, 0,252, 30, 0, 0, 0,
52104 & 359,0.300D0, 0,251, 21, 0, 0, 0,
52105 & 359,0.100D0, 0,251, 59, 0, 0, 0,
52106 & 360,0.600D0, 0,251, 38, 0, 0, 0,
52107 & 360,0.300D0, 0,252, 21, 0, 0, 0,
52108 & 360,0.100D0, 0,252, 59, 0, 0, 0,
52109 & 361,0.600D0, 0,251, 38, 0, 0, 0,
52110 & 361,0.300D0, 0,252, 21, 0, 0, 0,
52111 & 361,0.100D0, 0,252, 59, 0, 0, 0,
52112 & 362,1.000D0, 0,253, 59, 0, 0, 0,
52113 & 363,0.400D0, 0, 53, 38, 0, 0, 0,
52114 & 363,0.200D0, 0, 49, 21, 0, 0, 0,
52115 & 363,0.100D0, 0, 51, 38, 0, 0, 0/
52116 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1977,1995)/
52117 & 363,0.050D0, 0, 47, 21, 0, 0, 0,
52118 & 363,0.150D0, 0, 46, 26, 0, 0, 0,
52119 & 363,0.050D0, 0, 46, 56, 0, 0, 0,
52120 & 363,0.050D0, 0, 46, 24, 0, 0, 0,
52121 & 364,0.400D0, 0, 49, 30, 0, 0, 0,
52122 & 364,0.200D0, 0, 53, 21, 0, 0, 0,
52123 & 364,0.100D0, 0, 47, 30, 0, 0, 0,
52124 & 364,0.050D0, 0, 51, 21, 0, 0, 0,
52125 & 364,0.150D0, 0, 50, 26, 0, 0, 0,
52126 & 364,0.050D0, 0, 50, 56, 0, 0, 0,
52127 & 364,0.050D0, 0, 50, 24, 0, 0, 0,
52128 & 365,0.400D0, 0, 37, 38, 0, 0, 0,
52129 & 365,0.200D0, 0, 45, 21, 0, 0, 0,
52130 & 365,0.100D0, 0, 35, 38, 0, 0, 0,
52131 & 365,0.050D0, 0, 43, 21, 0, 0, 0,
52132 & 365,0.150D0, 0, 42, 26, 0, 0, 0,
52133 & 365,0.050D0, 0, 42, 56, 0, 0, 0,
52134 & 365,0.050D0, 0, 42, 24, 0, 0, 0,
52135 & 366,0.400D0, 0, 45, 30, 0, 0, 0/
52136 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=1996,2014)/
52137 & 366,0.200D0, 0, 37, 21, 0, 0, 0,
52138 & 366,0.100D0, 0, 43, 30, 0, 0, 0,
52139 & 366,0.050D0, 0, 35, 21, 0, 0, 0,
52140 & 366,0.150D0, 0, 34, 26, 0, 0, 0,
52141 & 366,0.050D0, 0, 34, 56, 0, 0, 0,
52142 & 366,0.050D0, 0, 34, 24, 0, 0, 0,
52143 & 367,0.258D0, 0, 50, 38, 0, 0, 0,
52144 & 367,0.129D0, 0, 46, 21, 0, 0, 0,
52145 & 367,0.209D0, 0, 50, 39, 0, 0, 0,
52146 & 367,0.105D0, 0, 46, 23, 0, 0, 0,
52147 & 367,0.199D0, 0, 51, 38, 0, 0, 0,
52148 & 367,0.100D0, 0, 47, 21, 0, 0, 0,
52149 & 368,0.258D0, 0, 46, 30, 0, 0, 0,
52150 & 368,0.129D0, 0, 50, 21, 0, 0, 0,
52151 & 368,0.209D0, 0, 46, 31, 0, 0, 0,
52152 & 368,0.105D0, 0, 50, 23, 0, 0, 0,
52153 & 368,0.199D0, 0, 47, 30, 0, 0, 0,
52154 & 368,0.100D0, 0, 51, 21, 0, 0, 0,
52155 & 369,0.258D0, 0, 34, 38, 0, 0, 0/
52156 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=2015,2033)/
52157 & 369,0.129D0, 0, 42, 21, 0, 0, 0,
52158 & 369,0.209D0, 0, 34, 39, 0, 0, 0,
52159 & 369,0.105D0, 0, 42, 23, 0, 0, 0,
52160 & 369,0.199D0, 0, 35, 38, 0, 0, 0,
52161 & 369,0.100D0, 0, 43, 21, 0, 0, 0,
52162 & 370,0.258D0, 0, 42, 30, 0, 0, 0,
52163 & 370,0.129D0, 0, 34, 21, 0, 0, 0,
52164 & 370,0.209D0, 0, 42, 31, 0, 0, 0,
52165 & 370,0.105D0, 0, 34, 23, 0, 0, 0,
52166 & 370,0.199D0, 0, 43, 30, 0, 0, 0,
52167 & 370,0.100D0, 0, 35, 21, 0, 0, 0,
52168 & 371,0.400D0, 0, 53, 38, 0, 0, 0,
52169 & 371,0.200D0, 0, 49, 21, 0, 0, 0,
52170 & 371,0.100D0, 0, 51, 38, 0, 0, 0,
52171 & 371,0.050D0, 0, 47, 21, 0, 0, 0,
52172 & 371,0.150D0, 0, 46, 26, 0, 0, 0,
52173 & 371,0.050D0, 0, 46, 56, 0, 0, 0,
52174 & 371,0.050D0, 0, 46, 24, 0, 0, 0,
52175 & 372,0.400D0, 0, 49, 30, 0, 0, 0/
52176 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=2034,2052)/
52177 & 372,0.200D0, 0, 53, 21, 0, 0, 0,
52178 & 372,0.100D0, 0, 47, 30, 0, 0, 0,
52179 & 372,0.050D0, 0, 51, 21, 0, 0, 0,
52180 & 372,0.150D0, 0, 50, 26, 0, 0, 0,
52181 & 372,0.050D0, 0, 50, 56, 0, 0, 0,
52182 & 372,0.050D0, 0, 50, 24, 0, 0, 0,
52183 & 373,0.400D0, 0, 37, 38, 0, 0, 0,
52184 & 373,0.200D0, 0, 45, 21, 0, 0, 0,
52185 & 373,0.100D0, 0, 35, 38, 0, 0, 0,
52186 & 373,0.050D0, 0, 43, 21, 0, 0, 0,
52187 & 373,0.150D0, 0, 42, 26, 0, 0, 0,
52188 & 373,0.050D0, 0, 42, 56, 0, 0, 0,
52189 & 373,0.050D0, 0, 42, 24, 0, 0, 0,
52190 & 374,0.400D0, 0, 45, 30, 0, 0, 0,
52191 & 374,0.200D0, 0, 37, 21, 0, 0, 0,
52192 & 374,0.100D0, 0, 43, 30, 0, 0, 0,
52193 & 374,0.050D0, 0, 35, 21, 0, 0, 0,
52194 & 374,0.150D0, 0, 34, 26, 0, 0, 0,
52195 & 374,0.050D0, 0, 34, 56, 0, 0, 0/
52196 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=2053,2071)/
52197 & 374,0.050D0, 0, 34, 24, 0, 0, 0,
52198 & 375,0.208D0, 0, 50, 39, 0, 0, 0,
52199 & 375,0.104D0, 0, 46, 23, 0, 0, 0,
52200 & 375,0.134D0, 0, 51, 38, 0, 0, 0,
52201 & 375,0.067D0, 0, 47, 21, 0, 0, 0,
52202 & 375,0.124D0, 0, 50, 38, 0, 0, 0,
52203 & 375,0.062D0, 0, 46, 21, 0, 0, 0,
52204 & 375,0.301D0, 0, 46, 22, 0, 0, 0,
52205 & 376,0.208D0, 0, 46, 31, 0, 0, 0,
52206 & 376,0.104D0, 0, 50, 23, 0, 0, 0,
52207 & 376,0.134D0, 0, 47, 30, 0, 0, 0,
52208 & 376,0.067D0, 0, 51, 21, 0, 0, 0,
52209 & 376,0.124D0, 0, 46, 30, 0, 0, 0,
52210 & 376,0.062D0, 0, 50, 21, 0, 0, 0,
52211 & 376,0.301D0, 0, 50, 22, 0, 0, 0,
52212 & 377,0.208D0, 0, 34, 39, 0, 0, 0,
52213 & 377,0.104D0, 0, 42, 23, 0, 0, 0,
52214 & 377,0.134D0, 0, 35, 38, 0, 0, 0,
52215 & 377,0.067D0, 0, 43, 21, 0, 0, 0/
52216 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=2072,2090)/
52217 & 377,0.124D0, 0, 34, 38, 0, 0, 0,
52218 & 377,0.062D0, 0, 42, 21, 0, 0, 0,
52219 & 377,0.301D0, 0, 42, 22, 0, 0, 0,
52220 & 378,0.208D0, 0, 42, 31, 0, 0, 0,
52221 & 378,0.104D0, 0, 34, 23, 0, 0, 0,
52222 & 378,0.134D0, 0, 43, 30, 0, 0, 0,
52223 & 378,0.067D0, 0, 35, 21, 0, 0, 0,
52224 & 378,0.124D0, 0, 42, 30, 0, 0, 0,
52225 & 378,0.062D0, 0, 34, 21, 0, 0, 0,
52226 & 378,0.301D0, 0, 34, 22, 0, 0, 0,
52227 & 379,0.562D0, 0, 26, 38, 0, 0, 0,
52228 & 379,0.155D0, 0, 39, 21, 0, 0, 0,
52229 & 379,0.155D0, 0, 23, 38, 0, 0, 0,
52230 & 379,0.088D0, 0,293, 38, 0, 0, 0,
52231 & 379,0.020D0, 0, 46, 43, 0, 0, 0,
52232 & 379,0.020D0, 0, 42, 47, 0, 0, 0,
52233 & 380,0.562D0, 0, 26, 21, 0, 0, 0,
52234 & 380,0.155D0, 0, 39, 30, 0, 0, 0,
52235 & 380,0.155D0, 0, 31, 38, 0, 0, 0/
52236 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=2091,2109)/
52237 & 380,0.088D0, 0,293, 21, 0, 0, 0,
52238 & 380,0.010D0, 0, 46, 35, 0, 0, 0,
52239 & 380,0.010D0, 0, 50, 43, 0, 0, 0,
52240 & 380,0.010D0, 0, 34, 47, 0, 0, 0,
52241 & 380,0.010D0, 0, 42, 51, 0, 0, 0,
52242 & 381,0.562D0, 0, 26, 30, 0, 0, 0,
52243 & 381,0.155D0, 0, 31, 21, 0, 0, 0,
52244 & 381,0.155D0, 0, 23, 30, 0, 0, 0,
52245 & 381,0.088D0, 0,293, 30, 0, 0, 0,
52246 & 381,0.020D0, 0, 34, 51, 0, 0, 0,
52247 & 381,0.020D0, 0, 50, 35, 0, 0, 0,
52248 & 382,0.360D0, 0, 31, 38, 38, 0, 0,
52249 & 382,0.180D0, 0, 23, 38, 21, 0, 0,
52250 & 382,0.040D0, 0, 39, 21, 21, 0, 0,
52251 & 382,0.020D0, 0, 39, 38, 30, 0, 0,
52252 & 382,0.300D0, 0, 38, 21, 0, 0, 0,
52253 & 382,0.040D0, 0, 46, 43, 0, 0, 0,
52254 & 382,0.040D0, 0, 42, 47, 0, 0, 0,
52255 & 382,0.020D0, 0, 22, 39, 0, 0, 0/
52256 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=2110,2128)/
52257 & 383,0.180D0, 0, 39, 30, 21, 0, 0,
52258 & 383,0.180D0, 0, 31, 38, 21, 0, 0,
52259 & 383,0.160D0, 0, 23, 21, 21, 0, 0,
52260 & 383,0.080D0, 0, 23, 38, 30, 0, 0,
52261 & 383,0.300D0, 0, 38, 30, 0, 0, 0,
52262 & 383,0.020D0, 0, 46, 35, 0, 0, 0,
52263 & 383,0.020D0, 0, 50, 43, 0, 0, 0,
52264 & 383,0.020D0, 0, 34, 47, 0, 0, 0,
52265 & 383,0.020D0, 0, 42, 51, 0, 0, 0,
52266 & 383,0.020D0, 0, 22, 23, 0, 0, 0,
52267 & 384,0.360D0, 0, 39, 30, 30, 0, 0,
52268 & 384,0.180D0, 0, 23, 30, 21, 0, 0,
52269 & 384,0.040D0, 0, 31, 21, 21, 0, 0,
52270 & 384,0.020D0, 0, 31, 30, 38, 0, 0,
52271 & 384,0.300D0, 0, 30, 21, 0, 0, 0,
52272 & 384,0.040D0, 0, 34, 51, 0, 0, 0,
52273 & 384,0.040D0, 0, 50, 35, 0, 0, 0,
52274 & 384,0.020D0, 0, 22, 31, 0, 0, 0,
52275 & 385,0.184D0, 0, 41, 21, 0, 0, 0/
52276 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=2129,2147)/
52277 & 385,0.184D0, 0, 29, 38, 0, 0, 0,
52278 & 385,0.184D0, 0, 39, 23, 0, 0, 0,
52279 & 385,0.236D0, 0, 38, 21, 0, 0, 0,
52280 & 385,0.160D0, 0, 24, 38, 0, 0, 0,
52281 & 385,0.018D0, 0, 46, 43, 0, 0, 0,
52282 & 385,0.018D0, 0, 42, 47, 0, 0, 0,
52283 & 385,0.016D0, 0, 46, 42, 0, 0, 0,
52284 & 386,0.184D0, 0, 41, 30, 0, 0, 0,
52285 & 386,0.184D0, 0, 33, 38, 0, 0, 0,
52286 & 386,0.184D0, 0, 39, 31, 0, 0, 0,
52287 & 386,0.236D0, 0, 38, 30, 0, 0, 0,
52288 & 386,0.160D0, 0, 24, 21, 0, 0, 0,
52289 & 386,0.009D0, 0, 46, 35, 0, 0, 0,
52290 & 386,0.009D0, 0, 50, 43, 0, 0, 0,
52291 & 386,0.009D0, 0, 34, 47, 0, 0, 0,
52292 & 386,0.009D0, 0, 42, 51, 0, 0, 0,
52293 & 386,0.008D0, 0, 46, 34, 0, 0, 0,
52294 & 386,0.008D0, 0, 42, 50, 0, 0, 0,
52295 & 387,0.184D0, 0, 33, 21, 0, 0, 0/
52296 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=2148,2166)/
52297 & 387,0.184D0, 0, 29, 30, 0, 0, 0,
52298 & 387,0.184D0, 0, 31, 23, 0, 0, 0,
52299 & 387,0.236D0, 0, 30, 21, 0, 0, 0,
52300 & 387,0.160D0, 0, 24, 30, 0, 0, 0,
52301 & 387,0.018D0, 0, 34, 51, 0, 0, 0,
52302 & 387,0.018D0, 0, 50, 35, 0, 0, 0,
52303 & 387,0.016D0, 0, 34, 50, 0, 0, 0,
52304 & 388,0.183D0, 0,231, 38, 30, 0, 0,
52305 & 388,0.091D0, 0,231, 21, 21, 0, 0,
52306 & 388,0.067D0, 0, 59,307, 0, 0, 0,
52307 & 388,0.066D0, 0, 59,308, 0, 0, 0,
52308 & 388,0.043D0, 0, 59,309, 0, 0, 0,
52309 & 388,0.446D0,130, 13, 13, 13, 0, 0,
52310 & 388,0.023D0,130, 13, 13, 59, 0, 0,
52311 & 388,0.013D0, 0,121,127, 0, 0, 0,
52312 & 388,0.013D0, 0,123,129, 0, 0, 0,
52313 & 388,0.013D0, 0,125,131, 0, 0, 0,
52314 & 388,0.004D0, 0, 1, 7, 0, 0, 0,
52315 & 388,0.017D0, 0, 2, 8, 0, 0, 0/
52316 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=2167,2185)/
52317 & 388,0.004D0, 0, 3, 9, 0, 0, 0,
52318 & 388,0.017D0, 0, 4, 10, 0, 0, 0,
52319 & 389,0.046D0, 0, 59,388, 0, 0, 0,
52320 & 389,0.009D0, 0, 59,231, 0, 0, 0,
52321 & 389,0.755D0, 0, 13, 13, 0, 0, 0,
52322 & 389,0.030D0, 0,121,127, 0, 0, 0,
52323 & 389,0.030D0, 0,123,129, 0, 0, 0,
52324 & 389,0.030D0, 0,125,131, 0, 0, 0,
52325 & 389,0.010D0, 0, 1, 7, 0, 0, 0,
52326 & 389,0.040D0, 0, 2, 8, 0, 0, 0,
52327 & 389,0.010D0, 0, 3, 9, 0, 0, 0,
52328 & 389,0.040D0, 0, 4, 10, 0, 0, 0,
52329 & 390,0.210D0, 0, 59,388, 0, 0, 0,
52330 & 390,0.085D0, 0, 59,231, 0, 0, 0,
52331 & 390,0.565D0, 0, 13, 13, 0, 0, 0,
52332 & 390,0.022D0, 0,121,127, 0, 0, 0,
52333 & 390,0.022D0, 0,123,129, 0, 0, 0,
52334 & 390,0.022D0, 0,125,131, 0, 0, 0,
52335 & 390,0.007D0, 0, 1, 7, 0, 0, 0/
52336 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=2186,2204)/
52337 & 390,0.030D0, 0, 2, 8, 0, 0, 0,
52338 & 390,0.007D0, 0, 3, 9, 0, 0, 0,
52339 & 390,0.030D0, 0, 4, 10, 0, 0, 0,
52340 & 391,0.162D0, 0, 59,388, 0, 0, 0,
52341 & 391,0.071D0, 0, 59,231, 0, 0, 0,
52342 & 391,0.615D0, 0, 13, 13, 0, 0, 0,
52343 & 391,0.024D0, 0,121,127, 0, 0, 0,
52344 & 391,0.024D0, 0,123,129, 0, 0, 0,
52345 & 391,0.024D0, 0,125,131, 0, 0, 0,
52346 & 391,0.008D0, 0, 1, 7, 0, 0, 0,
52347 & 391,0.032D0, 0, 2, 8, 0, 0, 0,
52348 & 391,0.008D0, 0, 3, 9, 0, 0, 0,
52349 & 391,0.032D0, 0, 4, 10, 0, 0, 0,
52350 & 392,0.034D0, 0,267, 38, 30, 0, 0,
52351 & 392,0.017D0, 0,267, 21, 21, 0, 0,
52352 & 392,0.044D0, 0,231, 38, 30, 0, 0,
52353 & 392,0.022D0, 0,231, 21, 21, 0, 0,
52354 & 392,0.050D0, 0,267, 59, 59, 0, 0,
52355 & 392,0.114D0, 0, 59,389, 0, 0, 0/
52356 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=2205,2223)/
52357 & 392,0.113D0, 0, 59,390, 0, 0, 0,
52358 & 392,0.054D0, 0, 59,391, 0, 0, 0,
52359 & 392,0.403D0,130, 13, 13, 13, 0, 0,
52360 & 392,0.021D0,130, 13, 13, 59, 0, 0,
52361 & 392,0.020D0, 0,121,127, 0, 0, 0,
52362 & 392,0.020D0, 0,123,129, 0, 0, 0,
52363 & 392,0.020D0, 0,125,131, 0, 0, 0,
52364 & 392,0.007D0, 0, 1, 7, 0, 0, 0,
52365 & 392,0.027D0, 0, 2, 8, 0, 0, 0,
52366 & 392,0.007D0, 0, 3, 9, 0, 0, 0,
52367 & 392,0.027D0, 0, 4, 10, 0, 0, 0,
52368 & 393,0.250D0, 0,246,222, 0, 0, 0,
52369 & 393,0.250D0, 0,245,221, 0, 0, 0,
52370 & 393,0.385D0,130, 13, 13, 13, 0, 0,
52371 & 393,0.020D0,130, 13, 13, 59, 0, 0,
52372 & 393,0.015D0, 0,121,127, 0, 0, 0,
52373 & 393,0.015D0, 0,123,129, 0, 0, 0,
52374 & 393,0.015D0, 0,125,131, 0, 0, 0,
52375 & 393,0.005D0, 0, 1, 7, 0, 0, 0/
52376 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=2224,2242)/
52377 & 393,0.020D0, 0, 2, 8, 0, 0, 0,
52378 & 393,0.005D0, 0, 3, 9, 0, 0, 0,
52379 & 393,0.020D0, 0, 4, 10, 0, 0, 0,
52380 & 395,0.195D0, 0, 39, 30, 0, 0, 0,
52381 & 395,0.195D0, 0, 23, 21, 0, 0, 0,
52382 & 395,0.195D0, 0, 31, 38, 0, 0, 0,
52383 & 395,0.105D0, 0,286, 30, 0, 0, 0,
52384 & 395,0.105D0, 0,285, 21, 0, 0, 0,
52385 & 395,0.105D0, 0,287, 38, 0, 0, 0,
52386 & 395,0.065D0, 0, 24, 38, 30, 0, 0,
52387 & 395,0.035D0, 0, 24, 21, 21, 0, 0,
52388 & 396,0.320D0, 0, 46, 34, 0, 0, 0,
52389 & 396,0.320D0, 0, 60, 61, 0, 0, 0,
52390 & 396,0.090D0, 0, 46, 35, 0, 0, 0,
52391 & 396,0.090D0, 0, 42, 51, 0, 0, 0,
52392 & 396,0.090D0, 0, 50, 43, 0, 0, 0,
52393 & 396,0.090D0, 0, 34, 47, 0, 0, 0,
52394 & 397,0.312D0, 0, 41, 30, 0, 0, 0,
52395 & 397,0.312D0, 0, 29, 21, 0, 0, 0/
52396 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=2243,2261)/
52397 & 397,0.312D0, 0, 33, 38, 0, 0, 0,
52398 & 397,0.016D0, 0, 46, 35, 0, 0, 0,
52399 & 397,0.016D0, 0, 42, 51, 0, 0, 0,
52400 & 397,0.016D0, 0, 50, 43, 0, 0, 0,
52401 & 397,0.016D0, 0, 34, 47, 0, 0, 0,
52402 & 398,0.805D0, 0, 26, 22, 0, 0, 0,
52403 & 398,0.065D0, 0, 41, 30, 0, 0, 0,
52404 & 398,0.065D0, 0, 29, 21, 0, 0, 0,
52405 & 398,0.065D0, 0, 33, 38, 0, 0, 0,
52406 & 399,0.667D0, 0, 24, 38, 30, 0, 0,
52407 & 399,0.333D0, 0, 24, 21, 21, 0, 0,
52408 & 62,0.440D0, 0, 21, 22, 0, 0, 0,
52409 & 62,0.160D0, 0, 21, 25, 0, 0, 0,
52410 & 62,0.200D0, 0, 50, 42, 0, 0, 0,
52411 & 62,0.200D0, 0, 46, 34, 0, 0, 0,
52412 & 63,0.440D0, 0, 38, 22, 0, 0, 0,
52413 & 63,0.160D0, 0, 38, 25, 0, 0, 0,
52414 & 63,0.400D0, 0, 46, 42, 0, 0, 0,
52415 & 64,0.440D0, 0, 30, 22, 0, 0, 0/
52416 DATA (IDK(I),BRFRAC(I),NME(I),(IDKPRD(J,I),J=1,5),I=2262,2263)/
52417 & 64,0.160D0, 0, 30, 25, 0, 0, 0,
52418 & 64,0.400D0, 0, 50, 34, 0, 0, 0/
52419 C--data for MRST98 LO PDF's
52420 DATA (FMRS(1,1,I, 1),I=1,49)/
52421 & 0.01518D0, 0.01868D0, 0.02298D0, 0.02594D0, 0.02828D0,
52422 & 0.03023D0, 0.03724D0, 0.04592D0, 0.05197D0, 0.05679D0,
52423 & 0.06085D0, 0.07576D0, 0.09547D0, 0.11035D0, 0.12307D0,
52424 & 0.13453D0, 0.15525D0, 0.18319D0, 0.22542D0, 0.26441D0,
52425 & 0.33553D0, 0.39881D0, 0.45451D0, 0.51363D0, 0.56120D0,
52426 & 0.59755D0, 0.62324D0, 0.63889D0, 0.64529D0, 0.64295D0,
52427 & 0.63335D0, 0.61691D0, 0.59464D0, 0.56748D0, 0.53621D0,
52428 & 0.50180D0, 0.46495D0, 0.42660D0, 0.38735D0, 0.34791D0,
52429 & 0.30888D0, 0.27105D0, 0.23455D0, 0.16807D0, 0.11197D0,
52430 & 0.06774D0, 0.03566D0, 0.00443D0, 0.00000D0/
52431 DATA (FMRS(1,1,I, 2),I=1,49)/
52432 & 0.01534D0, 0.01889D0, 0.02325D0, 0.02625D0, 0.02862D0,
52433 & 0.03061D0, 0.03771D0, 0.04653D0, 0.05268D0, 0.05757D0,
52434 & 0.06171D0, 0.07691D0, 0.09707D0, 0.11230D0, 0.12533D0,
52435 & 0.13708D0, 0.15827D0, 0.18678D0, 0.22968D0, 0.26907D0,
52436 & 0.34038D0, 0.40321D0, 0.45801D0, 0.51556D0, 0.56122D0,
52437 & 0.59551D0, 0.61905D0, 0.63261D0, 0.63699D0, 0.63286D0,
52438 & 0.62162D0, 0.60381D0, 0.58043D0, 0.55244D0, 0.52060D0,
52439 & 0.48591D0, 0.44902D0, 0.41090D0, 0.37213D0, 0.33332D0,
52440 & 0.29514D0, 0.25827D0, 0.22283D0, 0.15873D0, 0.10506D0,
52441 & 0.06310D0, 0.03294D0, 0.00399D0, 0.00000D0/
52442 DATA (FMRS(1,1,I, 3),I=1,49)/
52443 & 0.01559D0, 0.01920D0, 0.02365D0, 0.02672D0, 0.02914D0,
52444 & 0.03116D0, 0.03842D0, 0.04744D0, 0.05374D0, 0.05876D0,
52445 & 0.06301D0, 0.07866D0, 0.09949D0, 0.11525D0, 0.12874D0,
52446 & 0.14090D0, 0.16278D0, 0.19212D0, 0.23598D0, 0.27589D0,
52447 & 0.34735D0, 0.40941D0, 0.46279D0, 0.51792D0, 0.56073D0,
52448 & 0.59195D0, 0.61237D0, 0.62289D0, 0.62439D0, 0.61773D0,
52449 & 0.60419D0, 0.58448D0, 0.55962D0, 0.53052D0, 0.49799D0,
52450 & 0.46298D0, 0.42617D0, 0.38844D0, 0.35048D0, 0.31268D0,
52451 & 0.27573D0, 0.24031D0, 0.20643D0, 0.14575D0, 0.09554D0,
52452 & 0.05679D0, 0.02927D0, 0.00342D0, 0.00000D0/
52453 DATA (FMRS(1,1,I, 4),I=1,49)/
52454 & 0.01577D0, 0.01944D0, 0.02395D0, 0.02707D0, 0.02952D0,
52455 & 0.03158D0, 0.03895D0, 0.04812D0, 0.05453D0, 0.05964D0,
52456 & 0.06398D0, 0.07996D0, 0.10128D0, 0.11743D0, 0.13126D0,
52457 & 0.14371D0, 0.16610D0, 0.19602D0, 0.24052D0, 0.28078D0,
52458 & 0.35225D0, 0.41367D0, 0.46596D0, 0.51926D0, 0.56000D0,
52459 & 0.58897D0, 0.60716D0, 0.61554D0, 0.61505D0, 0.60661D0,
52460 & 0.59150D0, 0.57049D0, 0.54465D0, 0.51484D0, 0.48194D0,
52461 & 0.44680D0, 0.41012D0, 0.37271D0, 0.33536D0, 0.29833D0,
52462 & 0.26227D0, 0.22791D0, 0.19519D0, 0.13692D0, 0.08913D0,
52463 & 0.05257D0, 0.02685D0, 0.00306D0, 0.00000D0/
52464 DATA (FMRS(1,1,I, 5),I=1,49)/
52465 & 0.01597D0, 0.01969D0, 0.02427D0, 0.02744D0, 0.02993D0,
52466 & 0.03202D0, 0.03952D0, 0.04885D0, 0.05537D0, 0.06058D0,
52467 & 0.06501D0, 0.08134D0, 0.10319D0, 0.11975D0, 0.13393D0,
52468 & 0.14669D0, 0.16958D0, 0.20009D0, 0.24521D0, 0.28578D0,
52469 & 0.35715D0, 0.41781D0, 0.46887D0, 0.52022D0, 0.55877D0,
52470 & 0.58539D0, 0.60126D0, 0.60744D0, 0.60489D0, 0.59469D0,
52471 & 0.57807D0, 0.55581D0, 0.52903D0, 0.49861D0, 0.46535D0,
52472 & 0.43012D0, 0.39368D0, 0.35672D0, 0.32002D0, 0.28380D0,
52473 & 0.24878D0, 0.21549D0, 0.18398D0, 0.12819D0, 0.08284D0,
52474 & 0.04845D0, 0.02451D0, 0.00272D0, 0.00000D0/
52475 DATA (FMRS(1,1,I, 6),I=1,49)/
52476 & 0.01613D0, 0.01990D0, 0.02455D0, 0.02776D0, 0.03029D0,
52477 & 0.03241D0, 0.04001D0, 0.04949D0, 0.05611D0, 0.06141D0,
52478 & 0.06592D0, 0.08256D0, 0.10485D0, 0.12178D0, 0.13626D0,
52479 & 0.14927D0, 0.17260D0, 0.20361D0, 0.24924D0, 0.29005D0,
52480 & 0.36128D0, 0.42124D0, 0.47121D0, 0.52086D0, 0.55750D0,
52481 & 0.58213D0, 0.59603D0, 0.60035D0, 0.59612D0, 0.58445D0,
52482 & 0.56659D0, 0.54334D0, 0.51581D0, 0.48493D0, 0.45142D0,
52483 & 0.41618D0, 0.37998D0, 0.34345D0, 0.30732D0, 0.27182D0,
52484 & 0.23768D0, 0.20532D0, 0.17482D0, 0.12110D0, 0.07777D0,
52485 & 0.04515D0, 0.02267D0, 0.00245D0, 0.00000D0/
52486 DATA (FMRS(1,1,I, 7),I=1,49)/
52487 & 0.01630D0, 0.02011D0, 0.02482D0, 0.02807D0, 0.03063D0,
52488 & 0.03278D0, 0.04049D0, 0.05010D0, 0.05683D0, 0.06221D0,
52489 & 0.06680D0, 0.08373D0, 0.10647D0, 0.12373D0, 0.13849D0,
52490 & 0.15175D0, 0.17549D0, 0.20695D0, 0.25304D0, 0.29403D0,
52491 & 0.36506D0, 0.42430D0, 0.47319D0, 0.52118D0, 0.55597D0,
52492 & 0.57870D0, 0.59079D0, 0.59337D0, 0.58760D0, 0.57458D0,
52493 & 0.55556D0, 0.53145D0, 0.50329D0, 0.47196D0, 0.43832D0,
52494 & 0.40316D0, 0.36719D0, 0.33110D0, 0.29555D0, 0.26076D0,
52495 & 0.22742D0, 0.19600D0, 0.16642D0, 0.11467D0, 0.07318D0,
52496 & 0.04221D0, 0.02103D0, 0.00223D0, 0.00000D0/
52497 DATA (FMRS(1,1,I, 8),I=1,49)/
52498 & 0.01647D0, 0.02033D0, 0.02511D0, 0.02840D0, 0.03100D0,
52499 & 0.03318D0, 0.04101D0, 0.05076D0, 0.05760D0, 0.06307D0,
52500 & 0.06774D0, 0.08499D0, 0.10819D0, 0.12581D0, 0.14088D0,
52501 & 0.15440D0, 0.17856D0, 0.21047D0, 0.25702D0, 0.29817D0,
52502 & 0.36893D0, 0.42735D0, 0.47507D0, 0.52128D0, 0.55411D0,
52503 & 0.57487D0, 0.58505D0, 0.58586D0, 0.57850D0, 0.56412D0,
52504 & 0.54397D0, 0.51898D0, 0.49021D0, 0.45851D0, 0.42474D0,
52505 & 0.38970D0, 0.35404D0, 0.31842D0, 0.28351D0, 0.24949D0,
52506 & 0.21700D0, 0.18654D0, 0.15795D0, 0.10821D0, 0.06861D0,
52507 & 0.03930D0, 0.01942D0, 0.00201D0, 0.00000D0/
52508 DATA (FMRS(1,1,I, 9),I=1,49)/
52509 & 0.01662D0, 0.02053D0, 0.02536D0, 0.02869D0, 0.03133D0,
52510 & 0.03353D0, 0.04146D0, 0.05135D0, 0.05828D0, 0.06382D0,
52511 & 0.06856D0, 0.08610D0, 0.10971D0, 0.12764D0, 0.14296D0,
52512 & 0.15670D0, 0.18121D0, 0.21352D0, 0.26045D0, 0.30172D0,
52513 & 0.37220D0, 0.42986D0, 0.47655D0, 0.52120D0, 0.55234D0,
52514 & 0.57141D0, 0.57995D0, 0.57927D0, 0.57058D0, 0.55506D0,
52515 & 0.53402D0, 0.50830D0, 0.47904D0, 0.44709D0, 0.41323D0,
52516 & 0.37832D0, 0.34296D0, 0.30776D0, 0.27344D0, 0.24008D0,
52517 & 0.20833D0, 0.17868D0, 0.15093D0, 0.10287D0, 0.06487D0,
52518 & 0.03693D0, 0.01812D0, 0.00183D0, 0.00000D0/
52519 DATA (FMRS(1,1,I,10),I=1,49)/
52520 & 0.01676D0, 0.02072D0, 0.02560D0, 0.02898D0, 0.03164D0,
52521 & 0.03388D0, 0.04190D0, 0.05191D0, 0.05894D0, 0.06456D0,
52522 & 0.06937D0, 0.08718D0, 0.11117D0, 0.12940D0, 0.14497D0,
52523 & 0.15892D0, 0.18377D0, 0.21643D0, 0.26368D0, 0.30503D0,
52524 & 0.37520D0, 0.43209D0, 0.47774D0, 0.52089D0, 0.55041D0,
52525 & 0.56787D0, 0.57486D0, 0.57280D0, 0.56285D0, 0.54631D0,
52526 & 0.52442D0, 0.49810D0, 0.46842D0, 0.43624D0, 0.40236D0,
52527 & 0.36762D0, 0.33255D0, 0.29778D0, 0.26402D0, 0.23132D0,
52528 & 0.20029D0, 0.17139D0, 0.14445D0, 0.09798D0, 0.06147D0,
52529 & 0.03479D0, 0.01695D0, 0.00168D0, 0.00000D0/
52530 DATA (FMRS(1,1,I,11),I=1,49)/
52531 & 0.01688D0, 0.02087D0, 0.02580D0, 0.02920D0, 0.03189D0,
52532 & 0.03415D0, 0.04225D0, 0.05236D0, 0.05946D0, 0.06515D0,
52533 & 0.07001D0, 0.08804D0, 0.11234D0, 0.13081D0, 0.14657D0,
52534 & 0.16068D0, 0.18579D0, 0.21873D0, 0.26622D0, 0.30762D0,
52535 & 0.37751D0, 0.43378D0, 0.47859D0, 0.52054D0, 0.54880D0,
52536 & 0.56500D0, 0.57079D0, 0.56765D0, 0.55675D0, 0.53942D0,
52537 & 0.51689D0, 0.49012D0, 0.46015D0, 0.42782D0, 0.39393D0,
52538 & 0.35936D0, 0.32453D0, 0.29009D0, 0.25678D0, 0.22461D0,
52539 & 0.19416D0, 0.16583D0, 0.13951D0, 0.09427D0, 0.05892D0,
52540 & 0.03318D0, 0.01609D0, 0.00157D0, 0.00000D0/
52541 DATA (FMRS(1,1,I,12),I=1,49)/
52542 & 0.01713D0, 0.02119D0, 0.02622D0, 0.02969D0, 0.03243D0,
52543 & 0.03474D0, 0.04300D0, 0.05334D0, 0.06060D0, 0.06641D0,
52544 & 0.07140D0, 0.08989D0, 0.11485D0, 0.13381D0, 0.14997D0,
52545 & 0.16442D0, 0.19008D0, 0.22357D0, 0.27152D0, 0.31299D0,
52546 & 0.38219D0, 0.43708D0, 0.48008D0, 0.51946D0, 0.54505D0,
52547 & 0.55859D0, 0.56192D0, 0.55654D0, 0.54370D0, 0.52483D0,
52548 & 0.50100D0, 0.47335D0, 0.44283D0, 0.41025D0, 0.37649D0,
52549 & 0.34225D0, 0.30799D0, 0.27433D0, 0.24202D0, 0.21092D0,
52550 & 0.18167D0, 0.15459D0, 0.12954D0, 0.08683D0, 0.05380D0,
52551 & 0.03001D0, 0.01438D0, 0.00136D0, 0.00000D0/
52552 DATA (FMRS(1,1,I,13),I=1,49)/
52553 & 0.01734D0, 0.02147D0, 0.02658D0, 0.03011D0, 0.03290D0,
52554 & 0.03525D0, 0.04366D0, 0.05419D0, 0.06158D0, 0.06752D0,
52555 & 0.07261D0, 0.09150D0, 0.11703D0, 0.13641D0, 0.15292D0,
52556 & 0.16765D0, 0.19375D0, 0.22769D0, 0.27599D0, 0.31747D0,
52557 & 0.38599D0, 0.43964D0, 0.48105D0, 0.51822D0, 0.54152D0,
52558 & 0.55284D0, 0.55412D0, 0.54689D0, 0.53251D0, 0.51240D0,
52559 & 0.48756D0, 0.45925D0, 0.42833D0, 0.39563D0, 0.36202D0,
52560 & 0.32809D0, 0.29438D0, 0.26143D0, 0.22998D0, 0.19977D0,
52561 & 0.17155D0, 0.14553D0, 0.12155D0, 0.08091D0, 0.04976D0,
52562 & 0.02753D0, 0.01306D0, 0.00120D0, 0.00000D0/
52563 DATA (FMRS(1,1,I,14),I=1,49)/
52564 & 0.01759D0, 0.02179D0, 0.02699D0, 0.03059D0, 0.03343D0,
52565 & 0.03582D0, 0.04441D0, 0.05515D0, 0.06270D0, 0.06876D0,
52566 & 0.07397D0, 0.09331D0, 0.11948D0, 0.13933D0, 0.15621D0,
52567 & 0.17125D0, 0.19782D0, 0.23224D0, 0.28086D0, 0.32228D0,
52568 & 0.38998D0, 0.44216D0, 0.48181D0, 0.51649D0, 0.53727D0,
52569 & 0.54619D0, 0.54525D0, 0.53606D0, 0.52007D0, 0.49864D0,
52570 & 0.47286D0, 0.44390D0, 0.41261D0, 0.37987D0, 0.34645D0,
52571 & 0.31295D0, 0.27985D0, 0.24773D0, 0.21718D0, 0.18802D0,
52572 & 0.16091D0, 0.13605D0, 0.11323D0, 0.07479D0, 0.04562D0,
52573 & 0.02500D0, 0.01174D0, 0.00105D0, 0.00000D0/
52574 DATA (FMRS(1,1,I,15),I=1,49)/
52575 & 0.01784D0, 0.02212D0, 0.02742D0, 0.03109D0, 0.03399D0,
52576 & 0.03643D0, 0.04519D0, 0.05616D0, 0.06388D0, 0.07007D0,
52577 & 0.07541D0, 0.09522D0, 0.12203D0, 0.14235D0, 0.15961D0,
52578 & 0.17496D0, 0.20199D0, 0.23684D0, 0.28574D0, 0.32703D0,
52579 & 0.39374D0, 0.44435D0, 0.48208D0, 0.51422D0, 0.53243D0,
52580 & 0.53888D0, 0.53581D0, 0.52470D0, 0.50714D0, 0.48444D0,
52581 & 0.45778D0, 0.42824D0, 0.39670D0, 0.36400D0, 0.33079D0,
52582 & 0.29784D0, 0.26546D0, 0.23422D0, 0.20462D0, 0.17657D0,
52583 & 0.15056D0, 0.12684D0, 0.10517D0, 0.06893D0, 0.04169D0,
52584 & 0.02264D0, 0.01051D0, 0.00091D0, 0.00000D0/
52585 DATA (FMRS(1,1,I,16),I=1,49)/
52586 & 0.01807D0, 0.02243D0, 0.02782D0, 0.03155D0, 0.03450D0,
52587 & 0.03698D0, 0.04591D0, 0.05708D0, 0.06495D0, 0.07127D0,
52588 & 0.07672D0, 0.09696D0, 0.12435D0, 0.14510D0, 0.16268D0,
52589 & 0.17830D0, 0.20573D0, 0.24094D0, 0.29002D0, 0.33115D0,
52590 & 0.39689D0, 0.44603D0, 0.48202D0, 0.51185D0, 0.52778D0,
52591 & 0.53213D0, 0.52713D0, 0.51440D0, 0.49550D0, 0.47182D0,
52592 & 0.44444D0, 0.41444D0, 0.38277D0, 0.35014D0, 0.31726D0,
52593 & 0.28479D0, 0.25306D0, 0.22258D0, 0.19389D0, 0.16682D0,
52594 & 0.14175D0, 0.11905D0, 0.09839D0, 0.06403D0, 0.03844D0,
52595 & 0.02069D0, 0.00951D0, 0.00080D0, 0.00000D0/
52596 DATA (FMRS(1,1,I,17),I=1,49)/
52597 & 0.01831D0, 0.02273D0, 0.02822D0, 0.03202D0, 0.03502D0,
52598 & 0.03755D0, 0.04663D0, 0.05802D0, 0.06604D0, 0.07249D0,
52599 & 0.07805D0, 0.09872D0, 0.12670D0, 0.14787D0, 0.16578D0,
52600 & 0.18165D0, 0.20947D0, 0.24500D0, 0.29423D0, 0.33515D0,
52601 & 0.39986D0, 0.44747D0, 0.48171D0, 0.50924D0, 0.52291D0,
52602 & 0.52522D0, 0.51836D0, 0.50409D0, 0.48395D0, 0.45934D0,
52603 & 0.43132D0, 0.40095D0, 0.36919D0, 0.33668D0, 0.30419D0,
52604 & 0.27223D0, 0.24118D0, 0.21147D0, 0.18368D0, 0.15756D0,
52605 & 0.13343D0, 0.11172D0, 0.09203D0, 0.05947D0, 0.03543D0,
52606 & 0.01891D0, 0.00861D0, 0.00070D0, 0.00000D0/
52607 DATA (FMRS(1,1,I,18),I=1,49)/
52608 & 0.01851D0, 0.02299D0, 0.02855D0, 0.03241D0, 0.03546D0,
52609 & 0.03802D0, 0.04724D0, 0.05881D0, 0.06696D0, 0.07351D0,
52610 & 0.07917D0, 0.10019D0, 0.12865D0, 0.15015D0, 0.16833D0,
52611 & 0.18440D0, 0.21252D0, 0.24831D0, 0.29761D0, 0.33832D0,
52612 & 0.40212D0, 0.44845D0, 0.48121D0, 0.50687D0, 0.51871D0,
52613 & 0.51934D0, 0.51104D0, 0.49556D0, 0.47446D0, 0.44911D0,
52614 & 0.42066D0, 0.39005D0, 0.35822D0, 0.32587D0, 0.29370D0,
52615 & 0.26224D0, 0.23174D0, 0.20270D0, 0.17561D0, 0.15023D0,
52616 & 0.12693D0, 0.10599D0, 0.08707D0, 0.05595D0, 0.03312D0,
52617 & 0.01756D0, 0.00793D0, 0.00063D0, 0.00000D0/
52618 DATA (FMRS(1,1,I,19),I=1,49)/
52619 & 0.01875D0, 0.02330D0, 0.02896D0, 0.03288D0, 0.03599D0,
52620 & 0.03859D0, 0.04798D0, 0.05977D0, 0.06807D0, 0.07475D0,
52621 & 0.08052D0, 0.10198D0, 0.13101D0, 0.15292D0, 0.17139D0,
52622 & 0.18771D0, 0.21617D0, 0.25222D0, 0.30155D0, 0.34198D0,
52623 & 0.40461D0, 0.44935D0, 0.48033D0, 0.50374D0, 0.51343D0,
52624 & 0.51210D0, 0.50212D0, 0.48526D0, 0.46307D0, 0.43693D0,
52625 & 0.40797D0, 0.37715D0, 0.34533D0, 0.31321D0, 0.28148D0,
52626 & 0.25058D0, 0.22080D0, 0.19255D0, 0.16635D0, 0.14187D0,
52627 & 0.11948D0, 0.09946D0, 0.08142D0, 0.05198D0, 0.03054D0,
52628 & 0.01606D0, 0.00718D0, 0.00056D0, 0.00000D0/
52629 DATA (FMRS(1,1,I,20),I=1,49)/
52630 & 0.01896D0, 0.02358D0, 0.02932D0, 0.03331D0, 0.03646D0,
52631 & 0.03911D0, 0.04864D0, 0.06062D0, 0.06906D0, 0.07585D0,
52632 & 0.08173D0, 0.10357D0, 0.13310D0, 0.15536D0, 0.17410D0,
52633 & 0.19062D0, 0.21937D0, 0.25563D0, 0.30495D0, 0.34510D0,
52634 & 0.40666D0, 0.44998D0, 0.47941D0, 0.50085D0, 0.50868D0,
52635 & 0.50571D0, 0.49430D0, 0.47628D0, 0.45320D0, 0.42642D0,
52636 & 0.39707D0, 0.36611D0, 0.33435D0, 0.30245D0, 0.27113D0,
52637 & 0.24074D0, 0.21159D0, 0.18404D0, 0.15862D0, 0.13491D0,
52638 & 0.11330D0, 0.09405D0, 0.07676D0, 0.04872D0, 0.02844D0,
52639 & 0.01484D0, 0.00658D0, 0.00050D0, 0.00000D0/
52640 DATA (FMRS(1,1,I,21),I=1,49)/
52641 & 0.01916D0, 0.02384D0, 0.02966D0, 0.03370D0, 0.03689D0,
52642 & 0.03958D0, 0.04926D0, 0.06141D0, 0.06998D0, 0.07687D0,
52643 & 0.08284D0, 0.10503D0, 0.13502D0, 0.15758D0, 0.17655D0,
52644 & 0.19325D0, 0.22223D0, 0.25866D0, 0.30794D0, 0.34779D0,
52645 & 0.40831D0, 0.45032D0, 0.47832D0, 0.49795D0, 0.50413D0,
52646 & 0.49968D0, 0.48705D0, 0.46802D0, 0.44417D0, 0.41690D0,
52647 & 0.38723D0, 0.35619D0, 0.32452D0, 0.29287D0, 0.26194D0,
52648 & 0.23205D0, 0.20344D0, 0.17655D0, 0.15180D0, 0.12880D0,
52649 & 0.10792D0, 0.08934D0, 0.07273D0, 0.04591D0, 0.02665D0,
52650 & 0.01381D0, 0.00607D0, 0.00045D0, 0.00000D0/
52651 DATA (FMRS(1,1,I,22),I=1,49)/
52652 & 0.01941D0, 0.02417D0, 0.03009D0, 0.03420D0, 0.03745D0,
52653 & 0.04018D0, 0.05003D0, 0.06241D0, 0.07114D0, 0.07817D0,
52654 & 0.08426D0, 0.10688D0, 0.13744D0, 0.16039D0, 0.17965D0,
52655 & 0.19656D0, 0.22582D0, 0.26244D0, 0.31163D0, 0.35107D0,
52656 & 0.41025D0, 0.45056D0, 0.47676D0, 0.49416D0, 0.49829D0,
52657 & 0.49204D0, 0.47792D0, 0.45768D0, 0.43295D0, 0.40511D0,
52658 & 0.37512D0, 0.34401D0, 0.31250D0, 0.28120D0, 0.25076D0,
52659 & 0.22150D0, 0.19361D0, 0.16754D0, 0.14361D0, 0.12149D0,
52660 & 0.10149D0, 0.08376D0, 0.06796D0, 0.04260D0, 0.02455D0,
52661 & 0.01262D0, 0.00549D0, 0.00039D0, 0.00000D0/
52662 DATA (FMRS(1,1,I,23),I=1,49)/
52663 & 0.01965D0, 0.02448D0, 0.03049D0, 0.03467D0, 0.03797D0,
52664 & 0.04075D0, 0.05077D0, 0.06336D0, 0.07225D0, 0.07940D0,
52665 & 0.08560D0, 0.10863D0, 0.13972D0, 0.16302D0, 0.18254D0,
52666 & 0.19964D0, 0.22916D0, 0.26592D0, 0.31498D0, 0.35400D0,
52667 & 0.41189D0, 0.45060D0, 0.47511D0, 0.49045D0, 0.49274D0,
52668 & 0.48487D0, 0.46938D0, 0.44808D0, 0.42260D0, 0.39428D0,
52669 & 0.36409D0, 0.33294D0, 0.30164D0, 0.27069D0, 0.24070D0,
52670 & 0.21203D0, 0.18488D0, 0.15951D0, 0.13633D0, 0.11502D0,
52671 & 0.09581D0, 0.07887D0, 0.06380D0, 0.03974D0, 0.02273D0,
52672 & 0.01159D0, 0.00500D0, 0.00035D0, 0.00000D0/
52673 DATA (FMRS(1,1,I,24),I=1,49)/
52674 & 0.01987D0, 0.02478D0, 0.03088D0, 0.03511D0, 0.03847D0,
52675 & 0.04129D0, 0.05147D0, 0.06426D0, 0.07329D0, 0.08055D0,
52676 & 0.08686D0, 0.11027D0, 0.14184D0, 0.16546D0, 0.18521D0,
52677 & 0.20248D0, 0.23220D0, 0.26906D0, 0.31795D0, 0.35654D0,
52678 & 0.41317D0, 0.45035D0, 0.47330D0, 0.48677D0, 0.48734D0,
52679 & 0.47799D0, 0.46135D0, 0.43917D0, 0.41301D0, 0.38430D0,
52680 & 0.35392D0, 0.32282D0, 0.29171D0, 0.26113D0, 0.23164D0,
52681 & 0.20355D0, 0.17701D0, 0.15231D0, 0.12990D0, 0.10928D0,
52682 & 0.09079D0, 0.07455D0, 0.06012D0, 0.03723D0, 0.02116D0,
52683 & 0.01072D0, 0.00459D0, 0.00031D0, 0.00000D0/
52684 DATA (FMRS(1,1,I,25),I=1,49)/
52685 & 0.02010D0, 0.02507D0, 0.03126D0, 0.03556D0, 0.03897D0,
52686 & 0.04183D0, 0.05216D0, 0.06515D0, 0.07433D0, 0.08171D0,
52687 & 0.08812D0, 0.11191D0, 0.14397D0, 0.16790D0, 0.18786D0,
52688 & 0.20530D0, 0.23522D0, 0.27216D0, 0.32085D0, 0.35900D0,
52689 & 0.41434D0, 0.45001D0, 0.47142D0, 0.48304D0, 0.48197D0,
52690 & 0.47120D0, 0.45346D0, 0.43043D0, 0.40367D0, 0.37460D0,
52691 & 0.34407D0, 0.31306D0, 0.28215D0, 0.25197D0, 0.22296D0,
52692 & 0.19546D0, 0.16953D0, 0.14549D0, 0.12381D0, 0.10387D0,
52693 & 0.08608D0, 0.07049D0, 0.05669D0, 0.03490D0, 0.01971D0,
52694 & 0.00991D0, 0.00421D0, 0.00028D0, 0.00000D0/
52695 DATA (FMRS(1,1,I,26),I=1,49)/
52696 & 0.02032D0, 0.02536D0, 0.03164D0, 0.03600D0, 0.03946D0,
52697 & 0.04236D0, 0.05285D0, 0.06604D0, 0.07535D0, 0.08285D0,
52698 & 0.08936D0, 0.11352D0, 0.14603D0, 0.17026D0, 0.19043D0,
52699 & 0.20801D0, 0.23810D0, 0.27509D0, 0.32355D0, 0.36123D0,
52700 & 0.41527D0, 0.44945D0, 0.46936D0, 0.47919D0, 0.47657D0,
52701 & 0.46453D0, 0.44572D0, 0.42188D0, 0.39463D0, 0.36526D0,
52702 & 0.33462D0, 0.30373D0, 0.27307D0, 0.24328D0, 0.21472D0,
52703 & 0.18782D0, 0.16253D0, 0.13914D0, 0.11811D0, 0.09886D0,
52704 & 0.08171D0, 0.06673D0, 0.05353D0, 0.03277D0, 0.01840D0,
52705 & 0.00919D0, 0.00387D0, 0.00025D0, 0.00000D0/
52706 DATA (FMRS(1,1,I,27),I=1,49)/
52707 & 0.02054D0, 0.02564D0, 0.03200D0, 0.03642D0, 0.03992D0,
52708 & 0.04287D0, 0.05350D0, 0.06688D0, 0.07633D0, 0.08394D0,
52709 & 0.09053D0, 0.11504D0, 0.14798D0, 0.17249D0, 0.19284D0,
52710 & 0.21055D0, 0.24079D0, 0.27781D0, 0.32602D0, 0.36325D0,
52711 & 0.41604D0, 0.44883D0, 0.46732D0, 0.47551D0, 0.47145D0,
52712 & 0.45823D0, 0.43846D0, 0.41392D0, 0.38625D0, 0.35664D0,
52713 & 0.32595D0, 0.29518D0, 0.26477D0, 0.23536D0, 0.20725D0,
52714 & 0.18088D0, 0.15618D0, 0.13340D0, 0.11297D0, 0.09435D0,
52715 & 0.07779D0, 0.06337D0, 0.05071D0, 0.03088D0, 0.01724D0,
52716 & 0.00855D0, 0.00357D0, 0.00023D0, 0.00000D0/
52717 DATA (FMRS(1,1,I,28),I=1,49)/
52718 & 0.02074D0, 0.02591D0, 0.03234D0, 0.03682D0, 0.04037D0,
52719 & 0.04335D0, 0.05412D0, 0.06768D0, 0.07725D0, 0.08496D0,
52720 & 0.09165D0, 0.11648D0, 0.14982D0, 0.17457D0, 0.19509D0,
52721 & 0.21292D0, 0.24327D0, 0.28031D0, 0.32827D0, 0.36504D0,
52722 & 0.41665D0, 0.44811D0, 0.46527D0, 0.47196D0, 0.46656D0,
52723 & 0.45228D0, 0.43165D0, 0.40650D0, 0.37846D0, 0.34867D0,
52724 & 0.31800D0, 0.28733D0, 0.25718D0, 0.22812D0, 0.20048D0,
52725 & 0.17458D0, 0.15043D0, 0.12823D0, 0.10834D0, 0.09029D0,
52726 & 0.07427D0, 0.06037D0, 0.04820D0, 0.02920D0, 0.01621D0,
52727 & 0.00800D0, 0.00332D0, 0.00021D0, 0.00000D0/
52728 DATA (FMRS(1,1,I,29),I=1,49)/
52729 & 0.02094D0, 0.02617D0, 0.03269D0, 0.03722D0, 0.04081D0,
52730 & 0.04383D0, 0.05475D0, 0.06848D0, 0.07818D0, 0.08599D0,
52731 & 0.09277D0, 0.11792D0, 0.15165D0, 0.17664D0, 0.19733D0,
52732 & 0.21527D0, 0.24574D0, 0.28277D0, 0.33045D0, 0.36674D0,
52733 & 0.41715D0, 0.44728D0, 0.46313D0, 0.46834D0, 0.46164D0,
52734 & 0.44631D0, 0.42488D0, 0.39917D0, 0.37077D0, 0.34082D0,
52735 & 0.31017D0, 0.27964D0, 0.24978D0, 0.22107D0, 0.19390D0,
52736 & 0.16849D0, 0.14488D0, 0.12325D0, 0.10390D0, 0.08640D0,
52737 & 0.07092D0, 0.05751D0, 0.04581D0, 0.02761D0, 0.01524D0,
52738 & 0.00748D0, 0.00308D0, 0.00019D0, 0.00000D0/
52739 DATA (FMRS(1,1,I,30),I=1,49)/
52740 & 0.02115D0, 0.02644D0, 0.03303D0, 0.03762D0, 0.04125D0,
52741 & 0.04431D0, 0.05536D0, 0.06927D0, 0.07910D0, 0.08701D0,
52742 & 0.09387D0, 0.11934D0, 0.15345D0, 0.17867D0, 0.19951D0,
52743 & 0.21755D0, 0.24811D0, 0.28512D0, 0.33251D0, 0.36831D0,
52744 & 0.41752D0, 0.44634D0, 0.46092D0, 0.46470D0, 0.45678D0,
52745 & 0.44042D0, 0.41827D0, 0.39206D0, 0.36329D0, 0.33323D0,
52746 & 0.30260D0, 0.27226D0, 0.24270D0, 0.21435D0, 0.18761D0,
52747 & 0.16271D0, 0.13963D0, 0.11853D0, 0.09974D0, 0.08276D0,
52748 & 0.06777D0, 0.05484D0, 0.04358D0, 0.02615D0, 0.01436D0,
52749 & 0.00700D0, 0.00286D0, 0.00017D0, 0.00000D0/
52750 DATA (FMRS(1,1,I,31),I=1,49)/
52751 & 0.02134D0, 0.02669D0, 0.03336D0, 0.03800D0, 0.04168D0,
52752 & 0.04477D0, 0.05595D0, 0.07003D0, 0.07997D0, 0.08798D0,
52753 & 0.09492D0, 0.12069D0, 0.15515D0, 0.18059D0, 0.20157D0,
52754 & 0.21970D0, 0.25034D0, 0.28732D0, 0.33440D0, 0.36974D0,
52755 & 0.41780D0, 0.44538D0, 0.45878D0, 0.46121D0, 0.45216D0,
52756 & 0.43488D0, 0.41206D0, 0.38539D0, 0.35634D0, 0.32619D0,
52757 & 0.29560D0, 0.26544D0, 0.23618D0, 0.20818D0, 0.18185D0,
52758 & 0.15743D0, 0.13483D0, 0.11423D0, 0.09594D0, 0.07945D0,
52759 & 0.06492D0, 0.05243D0, 0.04157D0, 0.02483D0, 0.01357D0,
52760 & 0.00658D0, 0.00267D0, 0.00016D0, 0.00000D0/
52761 DATA (FMRS(1,1,I,32),I=1,49)/
52762 & 0.02153D0, 0.02693D0, 0.03367D0, 0.03836D0, 0.04208D0,
52763 & 0.04521D0, 0.05651D0, 0.07075D0, 0.08080D0, 0.08890D0,
52764 & 0.09592D0, 0.12197D0, 0.15676D0, 0.18239D0, 0.20349D0,
52765 & 0.22170D0, 0.25240D0, 0.28933D0, 0.33609D0, 0.37098D0,
52766 & 0.41793D0, 0.44434D0, 0.45663D0, 0.45780D0, 0.44772D0,
52767 & 0.42965D0, 0.40618D0, 0.37910D0, 0.34986D0, 0.31963D0,
52768 & 0.28912D0, 0.25913D0, 0.23015D0, 0.20249D0, 0.17658D0,
52769 & 0.15257D0, 0.13044D0, 0.11030D0, 0.09247D0, 0.07643D0,
52770 & 0.06234D0, 0.05026D0, 0.03976D0, 0.02365D0, 0.01287D0,
52771 & 0.00620D0, 0.00250D0, 0.00014D0, 0.00000D0/
52772 DATA (FMRS(1,1,I,33),I=1,49)/
52773 & 0.02171D0, 0.02717D0, 0.03398D0, 0.03872D0, 0.04248D0,
52774 & 0.04565D0, 0.05708D0, 0.07147D0, 0.08164D0, 0.08983D0,
52775 & 0.09693D0, 0.12326D0, 0.15838D0, 0.18421D0, 0.20543D0,
52776 & 0.22371D0, 0.25448D0, 0.29136D0, 0.33779D0, 0.37222D0,
52777 & 0.41806D0, 0.44331D0, 0.45449D0, 0.45441D0, 0.44330D0,
52778 & 0.42446D0, 0.40038D0, 0.37291D0, 0.34349D0, 0.31319D0,
52779 & 0.28277D0, 0.25295D0, 0.22427D0, 0.19695D0, 0.17145D0,
52780 & 0.14785D0, 0.12618D0, 0.10650D0, 0.08912D0, 0.07353D0,
52781 & 0.05986D0, 0.04817D0, 0.03803D0, 0.02252D0, 0.01220D0,
52782 & 0.00585D0, 0.00235D0, 0.00013D0, 0.00000D0/
52783 DATA (FMRS(1,1,I,34),I=1,49)/
52784 & 0.02190D0, 0.02741D0, 0.03429D0, 0.03909D0, 0.04289D0,
52785 & 0.04609D0, 0.05764D0, 0.07219D0, 0.08247D0, 0.09075D0,
52786 & 0.09793D0, 0.12453D0, 0.15996D0, 0.18597D0, 0.20731D0,
52787 & 0.22565D0, 0.25646D0, 0.29325D0, 0.33935D0, 0.37330D0,
52788 & 0.41800D0, 0.44209D0, 0.45219D0, 0.45092D0, 0.43883D0,
52789 & 0.41923D0, 0.39461D0, 0.36679D0, 0.33718D0, 0.30687D0,
52790 & 0.27654D0, 0.24693D0, 0.21853D0, 0.19159D0, 0.16650D0,
52791 & 0.14332D0, 0.12207D0, 0.10288D0, 0.08593D0, 0.07076D0,
52792 & 0.05749D0, 0.04618D0, 0.03639D0, 0.02146D0, 0.01157D0,
52793 & 0.00552D0, 0.00220D0, 0.00012D0, 0.00000D0/
52794 DATA (FMRS(1,1,I,35),I=1,49)/
52795 & 0.02208D0, 0.02764D0, 0.03459D0, 0.03943D0, 0.04327D0,
52796 & 0.04650D0, 0.05818D0, 0.07288D0, 0.08327D0, 0.09162D0,
52797 & 0.09888D0, 0.12574D0, 0.16147D0, 0.18765D0, 0.20909D0,
52798 & 0.22750D0, 0.25834D0, 0.29505D0, 0.34083D0, 0.37432D0,
52799 & 0.41794D0, 0.44094D0, 0.45002D0, 0.44763D0, 0.43463D0,
52800 & 0.41432D0, 0.38921D0, 0.36108D0, 0.33130D0, 0.30099D0,
52801 & 0.27077D0, 0.24136D0, 0.21322D0, 0.18665D0, 0.16193D0,
52802 & 0.13915D0, 0.11830D0, 0.09955D0, 0.08301D0, 0.06823D0,
52803 & 0.05533D0, 0.04437D0, 0.03490D0, 0.02050D0, 0.01100D0,
52804 & 0.00523D0, 0.00207D0, 0.00011D0, 0.00000D0/
52805 DATA (FMRS(1,1,I,36),I=1,49)/
52806 & 0.02225D0, 0.02787D0, 0.03488D0, 0.03977D0, 0.04364D0,
52807 & 0.04690D0, 0.05869D0, 0.07354D0, 0.08402D0, 0.09246D0,
52808 & 0.09978D0, 0.12689D0, 0.16290D0, 0.18924D0, 0.21077D0,
52809 & 0.22923D0, 0.26010D0, 0.29672D0, 0.34217D0, 0.37521D0,
52810 & 0.41781D0, 0.43978D0, 0.44789D0, 0.44447D0, 0.43062D0,
52811 & 0.40968D0, 0.38412D0, 0.35571D0, 0.32579D0, 0.29550D0,
52812 & 0.26538D0, 0.23618D0, 0.20831D0, 0.18206D0, 0.15771D0,
52813 & 0.13531D0, 0.11485D0, 0.09649D0, 0.08034D0, 0.06592D0,
52814 & 0.05337D0, 0.04272D0, 0.03354D0, 0.01963D0, 0.01049D0,
52815 & 0.00496D0, 0.00196D0, 0.00011D0, 0.00000D0/
52816 DATA (FMRS(1,1,I,37),I=1,49)/
52817 & 0.02242D0, 0.02809D0, 0.03517D0, 0.04010D0, 0.04401D0,
52818 & 0.04731D0, 0.05921D0, 0.07420D0, 0.08479D0, 0.09331D0,
52819 & 0.10070D0, 0.12805D0, 0.16433D0, 0.19082D0, 0.21245D0,
52820 & 0.23095D0, 0.26184D0, 0.29836D0, 0.34345D0, 0.37604D0,
52821 & 0.41760D0, 0.43853D0, 0.44568D0, 0.44123D0, 0.42654D0,
52822 & 0.40499D0, 0.37899D0, 0.35034D0, 0.32029D0, 0.29001D0,
52823 & 0.26003D0, 0.23104D0, 0.20345D0, 0.17752D0, 0.15354D0,
52824 & 0.13153D0, 0.11147D0, 0.09348D0, 0.07771D0, 0.06366D0,
52825 & 0.05147D0, 0.04112D0, 0.03222D0, 0.01879D0, 0.01000D0,
52826 & 0.00471D0, 0.00185D0, 0.00010D0, 0.00000D0/
52827 DATA (FMRS(1,1,I,38),I=1,49)/
52828 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52829 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52830 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52831 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52832 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52833 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52834 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52835 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52836 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
52837 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
52838 DATA (FMRS(1,2,I, 1),I=1,49)/
52839 & 0.00513D0, 0.00648D0, 0.00818D0, 0.00938D0, 0.01034D0,
52840 & 0.01116D0, 0.01418D0, 0.01818D0, 0.02118D0, 0.02372D0,
52841 & 0.02613D0, 0.03576D0, 0.05040D0, 0.06228D0, 0.07266D0,
52842 & 0.08202D0, 0.09864D0, 0.12002D0, 0.14955D0, 0.17387D0,
52843 & 0.21184D0, 0.23954D0, 0.25956D0, 0.27606D0, 0.28502D0,
52844 & 0.28790D0, 0.28586D0, 0.27985D0, 0.27060D0, 0.25918D0,
52845 & 0.24535D0, 0.23028D0, 0.21416D0, 0.19735D0, 0.18044D0,
52846 & 0.16347D0, 0.14671D0, 0.13049D0, 0.11512D0, 0.10018D0,
52847 & 0.08630D0, 0.07360D0, 0.06172D0, 0.04171D0, 0.02610D0,
52848 & 0.01478D0, 0.00721D0, 0.00074D0, 0.00000D0/
52849 DATA (FMRS(1,2,I, 2),I=1,49)/
52850 & 0.00518D0, 0.00654D0, 0.00828D0, 0.00950D0, 0.01049D0,
52851 & 0.01133D0, 0.01443D0, 0.01854D0, 0.02162D0, 0.02423D0,
52852 & 0.02670D0, 0.03657D0, 0.05155D0, 0.06366D0, 0.07421D0,
52853 & 0.08371D0, 0.10052D0, 0.12206D0, 0.15163D0, 0.17583D0,
52854 & 0.21329D0, 0.24028D0, 0.25950D0, 0.27498D0, 0.28295D0,
52855 & 0.28491D0, 0.28206D0, 0.27535D0, 0.26555D0, 0.25365D0,
52856 & 0.23952D0, 0.22423D0, 0.20802D0, 0.19123D0, 0.17441D0,
52857 & 0.15763D0, 0.14114D0, 0.12520D0, 0.11019D0, 0.09565D0,
52858 & 0.08218D0, 0.06990D0, 0.05847D0, 0.03927D0, 0.02442D0,
52859 & 0.01373D0, 0.00665D0, 0.00066D0, 0.00000D0/
52860 DATA (FMRS(1,2,I, 3),I=1,49)/
52861 & 0.00524D0, 0.00664D0, 0.00843D0, 0.00970D0, 0.01072D0,
52862 & 0.01159D0, 0.01481D0, 0.01908D0, 0.02229D0, 0.02501D0,
52863 & 0.02757D0, 0.03781D0, 0.05328D0, 0.06572D0, 0.07653D0,
52864 & 0.08622D0, 0.10330D0, 0.12505D0, 0.15465D0, 0.17864D0,
52865 & 0.21528D0, 0.24119D0, 0.25922D0, 0.27320D0, 0.27971D0,
52866 & 0.28035D0, 0.27635D0, 0.26864D0, 0.25807D0, 0.24551D0,
52867 & 0.23101D0, 0.21544D0, 0.19911D0, 0.18240D0, 0.16578D0,
52868 & 0.14929D0, 0.13320D0, 0.11772D0, 0.10322D0, 0.08926D0,
52869 & 0.07639D0, 0.06473D0, 0.05394D0, 0.03591D0, 0.02212D0,
52870 & 0.01231D0, 0.00589D0, 0.00057D0, 0.00000D0/
52871 DATA (FMRS(1,2,I, 4),I=1,49)/
52872 & 0.00529D0, 0.00672D0, 0.00855D0, 0.00985D0, 0.01090D0,
52873 & 0.01179D0, 0.01510D0, 0.01949D0, 0.02279D0, 0.02558D0,
52874 & 0.02822D0, 0.03873D0, 0.05456D0, 0.06724D0, 0.07823D0,
52875 & 0.08806D0, 0.10532D0, 0.12720D0, 0.15680D0, 0.18061D0,
52876 & 0.21663D0, 0.24172D0, 0.25888D0, 0.27177D0, 0.27723D0,
52877 & 0.27696D0, 0.27213D0, 0.26373D0, 0.25262D0, 0.23966D0,
52878 & 0.22489D0, 0.20919D0, 0.19281D0, 0.17616D0, 0.15968D0,
52879 & 0.14345D0, 0.12763D0, 0.11250D0, 0.09838D0, 0.08485D0,
52880 & 0.07242D0, 0.06118D0, 0.05083D0, 0.03363D0, 0.02058D0,
52881 & 0.01136D0, 0.00539D0, 0.00050D0, 0.00000D0/
52882 DATA (FMRS(1,2,I, 5),I=1,49)/
52883 & 0.00534D0, 0.00680D0, 0.00868D0, 0.01001D0, 0.01108D0,
52884 & 0.01200D0, 0.01540D0, 0.01993D0, 0.02332D0, 0.02620D0,
52885 & 0.02891D0, 0.03971D0, 0.05590D0, 0.06884D0, 0.08000D0,
52886 & 0.08997D0, 0.10741D0, 0.12941D0, 0.15897D0, 0.18257D0,
52887 & 0.21790D0, 0.24212D0, 0.25836D0, 0.27010D0, 0.27446D0,
52888 & 0.27326D0, 0.26762D0, 0.25853D0, 0.24692D0, 0.23356D0,
52889 & 0.21851D0, 0.20270D0, 0.18633D0, 0.16975D0, 0.15345D0,
52890 & 0.13751D0, 0.12199D0, 0.10721D0, 0.09351D0, 0.08043D0,
52891 & 0.06843D0, 0.05765D0, 0.04775D0, 0.03138D0, 0.01907D0,
52892 & 0.01045D0, 0.00491D0, 0.00045D0, 0.00000D0/
52893 DATA (FMRS(1,2,I, 6),I=1,49)/
52894 & 0.00539D0, 0.00688D0, 0.00879D0, 0.01015D0, 0.01125D0,
52895 & 0.01219D0, 0.01567D0, 0.02031D0, 0.02379D0, 0.02674D0,
52896 & 0.02951D0, 0.04056D0, 0.05708D0, 0.07022D0, 0.08154D0,
52897 & 0.09162D0, 0.10921D0, 0.13130D0, 0.16082D0, 0.18422D0,
52898 & 0.21894D0, 0.24239D0, 0.25783D0, 0.26859D0, 0.27204D0,
52899 & 0.27005D0, 0.26373D0, 0.25409D0, 0.24206D0, 0.22838D0,
52900 & 0.21313D0, 0.19724D0, 0.18088D0, 0.16440D0, 0.14826D0,
52901 & 0.13257D0, 0.11731D0, 0.10284D0, 0.08950D0, 0.07679D0,
52902 & 0.06517D0, 0.05477D0, 0.04524D0, 0.02956D0, 0.01786D0,
52903 & 0.00972D0, 0.00453D0, 0.00040D0, 0.00000D0/
52904 DATA (FMRS(1,2,I, 7),I=1,49)/
52905 & 0.00544D0, 0.00695D0, 0.00890D0, 0.01029D0, 0.01141D0,
52906 & 0.01237D0, 0.01593D0, 0.02068D0, 0.02425D0, 0.02727D0,
52907 & 0.03010D0, 0.04138D0, 0.05820D0, 0.07155D0, 0.08301D0,
52908 & 0.09319D0, 0.11091D0, 0.13308D0, 0.16253D0, 0.18572D0,
52909 & 0.21983D0, 0.24255D0, 0.25721D0, 0.26706D0, 0.26966D0,
52910 & 0.26692D0, 0.25996D0, 0.24983D0, 0.23740D0, 0.22344D0,
52911 & 0.20806D0, 0.19209D0, 0.17575D0, 0.15940D0, 0.14342D0,
52912 & 0.12794D0, 0.11298D0, 0.09881D0, 0.08579D0, 0.07344D0,
52913 & 0.06219D0, 0.05213D0, 0.04295D0, 0.02791D0, 0.01677D0,
52914 & 0.00906D0, 0.00419D0, 0.00037D0, 0.00000D0/
52915 DATA (FMRS(1,2,I, 8),I=1,49)/
52916 & 0.00549D0, 0.00703D0, 0.00902D0, 0.01044D0, 0.01159D0,
52917 & 0.01257D0, 0.01622D0, 0.02109D0, 0.02474D0, 0.02783D0,
52918 & 0.03073D0, 0.04227D0, 0.05940D0, 0.07296D0, 0.08456D0,
52919 & 0.09485D0, 0.11270D0, 0.13493D0, 0.16429D0, 0.18726D0,
52920 & 0.22070D0, 0.24263D0, 0.25647D0, 0.26535D0, 0.26707D0,
52921 & 0.26357D0, 0.25596D0, 0.24532D0, 0.23250D0, 0.21829D0,
52922 & 0.20276D0, 0.18675D0, 0.17045D0, 0.15424D0, 0.13845D0,
52923 & 0.12321D0, 0.10855D0, 0.09470D0, 0.08203D0, 0.07005D0,
52924 & 0.05917D0, 0.04947D0, 0.04065D0, 0.02627D0, 0.01569D0,
52925 & 0.00842D0, 0.00386D0, 0.00033D0, 0.00000D0/
52926 DATA (FMRS(1,2,I, 9),I=1,49)/
52927 & 0.00553D0, 0.00711D0, 0.00913D0, 0.01057D0, 0.01174D0,
52928 & 0.01274D0, 0.01647D0, 0.02144D0, 0.02517D0, 0.02833D0,
52929 & 0.03129D0, 0.04304D0, 0.06045D0, 0.07418D0, 0.08591D0,
52930 & 0.09629D0, 0.11425D0, 0.13653D0, 0.16579D0, 0.18855D0,
52931 & 0.22139D0, 0.24264D0, 0.25577D0, 0.26380D0, 0.26479D0,
52932 & 0.26063D0, 0.25250D0, 0.24142D0, 0.22830D0, 0.21390D0,
52933 & 0.19824D0, 0.18222D0, 0.16597D0, 0.14988D0, 0.13426D0,
52934 & 0.11924D0, 0.10484D0, 0.09128D0, 0.07889D0, 0.06724D0,
52935 & 0.05666D0, 0.04727D0, 0.03875D0, 0.02492D0, 0.01480D0,
52936 & 0.00790D0, 0.00360D0, 0.00030D0, 0.00000D0/
52937 DATA (FMRS(1,2,I,10),I=1,49)/
52938 & 0.00558D0, 0.00718D0, 0.00923D0, 0.01071D0, 0.01190D0,
52939 & 0.01291D0, 0.01671D0, 0.02178D0, 0.02559D0, 0.02881D0,
52940 & 0.03183D0, 0.04379D0, 0.06146D0, 0.07536D0, 0.08720D0,
52941 & 0.09766D0, 0.11571D0, 0.13802D0, 0.16719D0, 0.18973D0,
52942 & 0.22198D0, 0.24256D0, 0.25502D0, 0.26225D0, 0.26252D0,
52943 & 0.25776D0, 0.24914D0, 0.23766D0, 0.22428D0, 0.20968D0,
52944 & 0.19393D0, 0.17791D0, 0.16173D0, 0.14575D0, 0.13032D0,
52945 & 0.11552D0, 0.10136D0, 0.08807D0, 0.07596D0, 0.06462D0,
52946 & 0.05433D0, 0.04524D0, 0.03701D0, 0.02369D0, 0.01400D0,
52947 & 0.00743D0, 0.00336D0, 0.00028D0, 0.00000D0/
52948 DATA (FMRS(1,2,I,11),I=1,49)/
52949 & 0.00562D0, 0.00723D0, 0.00932D0, 0.01081D0, 0.01202D0,
52950 & 0.01305D0, 0.01691D0, 0.02206D0, 0.02593D0, 0.02920D0,
52951 & 0.03226D0, 0.04438D0, 0.06226D0, 0.07629D0, 0.08822D0,
52952 & 0.09874D0, 0.11687D0, 0.13920D0, 0.16827D0, 0.19064D0,
52953 & 0.22242D0, 0.24246D0, 0.25439D0, 0.26100D0, 0.26071D0,
52954 & 0.25548D0, 0.24648D0, 0.23472D0, 0.22112D0, 0.20638D0,
52955 & 0.19059D0, 0.17454D0, 0.15845D0, 0.14257D0, 0.12728D0,
52956 & 0.11265D0, 0.09869D0, 0.08561D0, 0.07373D0, 0.06261D0,
52957 & 0.05256D0, 0.04369D0, 0.03568D0, 0.02275D0, 0.01339D0,
52958 & 0.00707D0, 0.00318D0, 0.00026D0, 0.00000D0/
52959 DATA (FMRS(1,2,I,12),I=1,49)/
52960 & 0.00570D0, 0.00736D0, 0.00950D0, 0.01104D0, 0.01228D0,
52961 & 0.01335D0, 0.01733D0, 0.02266D0, 0.02665D0, 0.03003D0,
52962 & 0.03319D0, 0.04566D0, 0.06397D0, 0.07827D0, 0.09038D0,
52963 & 0.10102D0, 0.11928D0, 0.14164D0, 0.17050D0, 0.19247D0,
52964 & 0.22321D0, 0.24211D0, 0.25293D0, 0.25822D0, 0.25677D0,
52965 & 0.25059D0, 0.24082D0, 0.22847D0, 0.21448D0, 0.19945D0,
52966 & 0.18361D0, 0.16759D0, 0.15163D0, 0.13598D0, 0.12100D0,
52967 & 0.10676D0, 0.09321D0, 0.08058D0, 0.06917D0, 0.05856D0,
52968 & 0.04898D0, 0.04057D0, 0.03301D0, 0.02089D0, 0.01219D0,
52969 & 0.00638D0, 0.00284D0, 0.00022D0, 0.00000D0/
52970 DATA (FMRS(1,2,I,13),I=1,49)/
52971 & 0.00578D0, 0.00747D0, 0.00966D0, 0.01124D0, 0.01252D0,
52972 & 0.01361D0, 0.01770D0, 0.02318D0, 0.02729D0, 0.03076D0,
52973 & 0.03400D0, 0.04677D0, 0.06545D0, 0.07997D0, 0.09223D0,
52974 & 0.10297D0, 0.12133D0, 0.14370D0, 0.17234D0, 0.19395D0,
52975 & 0.22379D0, 0.24170D0, 0.25156D0, 0.25575D0, 0.25334D0,
52976 & 0.24638D0, 0.23598D0, 0.22317D0, 0.20887D0, 0.19364D0,
52977 & 0.17776D0, 0.16180D0, 0.14597D0, 0.13054D0, 0.11583D0,
52978 & 0.10193D0, 0.08873D0, 0.07648D0, 0.06548D0, 0.05529D0,
52979 & 0.04609D0, 0.03806D0, 0.03088D0, 0.01941D0, 0.01124D0,
52980 & 0.00583D0, 0.00257D0, 0.00020D0, 0.00000D0/
52981 DATA (FMRS(1,2,I,14),I=1,49)/
52982 & 0.00586D0, 0.00760D0, 0.00985D0, 0.01147D0, 0.01278D0,
52983 & 0.01391D0, 0.01812D0, 0.02377D0, 0.02801D0, 0.03158D0,
52984 & 0.03491D0, 0.04802D0, 0.06710D0, 0.08186D0, 0.09428D0,
52985 & 0.10512D0, 0.12358D0, 0.14593D0, 0.17430D0, 0.19551D0,
52986 & 0.22431D0, 0.24113D0, 0.24990D0, 0.25292D0, 0.24948D0,
52987 & 0.24168D0, 0.23063D0, 0.21737D0, 0.20273D0, 0.18735D0,
52988 & 0.17142D0, 0.15550D0, 0.13986D0, 0.12470D0, 0.11033D0,
52989 & 0.09680D0, 0.08400D0, 0.07217D0, 0.06162D0, 0.05183D0,
52990 & 0.04308D0, 0.03546D0, 0.02866D0, 0.01788D0, 0.01027D0,
52991 & 0.00528D0, 0.00231D0, 0.00017D0, 0.00000D0/
52992 DATA (FMRS(1,2,I,15),I=1,49)/
52993 & 0.00596D0, 0.00773D0, 0.01005D0, 0.01171D0, 0.01307D0,
52994 & 0.01423D0, 0.01857D0, 0.02439D0, 0.02876D0, 0.03244D0,
52995 & 0.03586D0, 0.04932D0, 0.06880D0, 0.08380D0, 0.09637D0,
52996 & 0.10730D0, 0.12584D0, 0.14815D0, 0.17622D0, 0.19694D0,
52997 & 0.22466D0, 0.24034D0, 0.24804D0, 0.24983D0, 0.24536D0,
52998 & 0.23677D0, 0.22506D0, 0.21136D0, 0.19645D0, 0.18096D0,
52999 & 0.16500D0, 0.14922D0, 0.13378D0, 0.11890D0, 0.10488D0,
53000 & 0.09171D0, 0.07933D0, 0.06793D0, 0.05781D0, 0.04848D0,
53001 & 0.04016D0, 0.03293D0, 0.02652D0, 0.01642D0, 0.00936D0,
53002 & 0.00477D0, 0.00206D0, 0.00015D0, 0.00000D0/
53003 DATA (FMRS(1,2,I,16),I=1,49)/
53004 & 0.00604D0, 0.00786D0, 0.01023D0, 0.01194D0, 0.01333D0,
53005 & 0.01452D0, 0.01898D0, 0.02497D0, 0.02945D0, 0.03323D0,
53006 & 0.03674D0, 0.05050D0, 0.07034D0, 0.08554D0, 0.09824D0,
53007 & 0.10925D0, 0.12785D0, 0.15009D0, 0.17786D0, 0.19815D0,
53008 & 0.22486D0, 0.23952D0, 0.24625D0, 0.24698D0, 0.24163D0,
53009 & 0.23233D0, 0.22009D0, 0.20603D0, 0.19091D0, 0.17529D0,
53010 & 0.15938D0, 0.14374D0, 0.12849D0, 0.11388D0, 0.10016D0,
53011 & 0.08733D0, 0.07533D0, 0.06433D0, 0.05458D0, 0.04564D0,
53012 & 0.03769D0, 0.03082D0, 0.02473D0, 0.01521D0, 0.00860D0,
53013 & 0.00435D0, 0.00186D0, 0.00013D0, 0.00000D0/
53014 DATA (FMRS(1,2,I,17),I=1,49)/
53015 & 0.00614D0, 0.00799D0, 0.01042D0, 0.01217D0, 0.01359D0,
53016 & 0.01482D0, 0.01940D0, 0.02555D0, 0.03016D0, 0.03404D0,
53017 & 0.03763D0, 0.05170D0, 0.07188D0, 0.08729D0, 0.10010D0,
53018 & 0.11119D0, 0.12983D0, 0.15200D0, 0.17943D0, 0.19928D0,
53019 & 0.22497D0, 0.23860D0, 0.24438D0, 0.24406D0, 0.23786D0,
53020 & 0.22788D0, 0.21517D0, 0.20077D0, 0.18546D0, 0.16976D0,
53021 & 0.15392D0, 0.13841D0, 0.12338D0, 0.10905D0, 0.09563D0,
53022 & 0.08314D0, 0.07152D0, 0.06090D0, 0.05152D0, 0.04295D0,
53023 & 0.03537D0, 0.02883D0, 0.02306D0, 0.01409D0, 0.00791D0,
53024 & 0.00396D0, 0.00168D0, 0.00011D0, 0.00000D0/
53025 DATA (FMRS(1,2,I,18),I=1,49)/
53026 & 0.00621D0, 0.00810D0, 0.01058D0, 0.01236D0, 0.01382D0,
53027 & 0.01507D0, 0.01975D0, 0.02604D0, 0.03075D0, 0.03471D0,
53028 & 0.03837D0, 0.05269D0, 0.07316D0, 0.08872D0, 0.10163D0,
53029 & 0.11277D0, 0.13143D0, 0.15352D0, 0.18066D0, 0.20012D0,
53030 & 0.22496D0, 0.23774D0, 0.24276D0, 0.24159D0, 0.23471D0,
53031 & 0.22421D0, 0.21113D0, 0.19645D0, 0.18102D0, 0.16532D0,
53032 & 0.14952D0, 0.13412D0, 0.11930D0, 0.10519D0, 0.09201D0,
53033 & 0.07983D0, 0.06850D0, 0.05818D0, 0.04914D0, 0.04085D0,
53034 & 0.03356D0, 0.02728D0, 0.02176D0, 0.01322D0, 0.00738D0,
53035 & 0.00367D0, 0.00154D0, 0.00010D0, 0.00000D0/
53036 DATA (FMRS(1,2,I,19),I=1,49)/
53037 & 0.00631D0, 0.00824D0, 0.01077D0, 0.01261D0, 0.01410D0,
53038 & 0.01538D0, 0.02018D0, 0.02663D0, 0.03146D0, 0.03553D0,
53039 & 0.03927D0, 0.05390D0, 0.07469D0, 0.09044D0, 0.10345D0,
53040 & 0.11464D0, 0.13332D0, 0.15529D0, 0.18206D0, 0.20106D0,
53041 & 0.22486D0, 0.23661D0, 0.24071D0, 0.23855D0, 0.23089D0,
53042 & 0.21978D0, 0.20626D0, 0.19133D0, 0.17575D0, 0.16006D0,
53043 & 0.14433D0, 0.12911D0, 0.11452D0, 0.10069D0, 0.08783D0,
53044 & 0.07600D0, 0.06503D0, 0.05507D0, 0.04638D0, 0.03845D0,
53045 & 0.03149D0, 0.02552D0, 0.02030D0, 0.01225D0, 0.00679D0,
53046 & 0.00335D0, 0.00139D0, 0.00009D0, 0.00000D0/
53047 DATA (FMRS(1,2,I,20),I=1,49)/
53048 & 0.00640D0, 0.00837D0, 0.01095D0, 0.01282D0, 0.01434D0,
53049 & 0.01565D0, 0.02057D0, 0.02717D0, 0.03210D0, 0.03625D0,
53050 & 0.04007D0, 0.05496D0, 0.07605D0, 0.09195D0, 0.10504D0,
53051 & 0.11628D0, 0.13496D0, 0.15682D0, 0.18325D0, 0.20182D0,
53052 & 0.22471D0, 0.23557D0, 0.23887D0, 0.23587D0, 0.22753D0,
53053 & 0.21592D0, 0.20204D0, 0.18691D0, 0.17123D0, 0.15556D0,
53054 & 0.13990D0, 0.12485D0, 0.11047D0, 0.09690D0, 0.08432D0,
53055 & 0.07279D0, 0.06213D0, 0.05248D0, 0.04407D0, 0.03646D0,
53056 & 0.02978D0, 0.02408D0, 0.01910D0, 0.01145D0, 0.00631D0,
53057 & 0.00309D0, 0.00127D0, 0.00008D0, 0.00000D0/
53058 DATA (FMRS(1,2,I,21),I=1,49)/
53059 & 0.00648D0, 0.00848D0, 0.01111D0, 0.01302D0, 0.01457D0,
53060 & 0.01591D0, 0.02092D0, 0.02766D0, 0.03269D0, 0.03692D0,
53061 & 0.04081D0, 0.05593D0, 0.07728D0, 0.09331D0, 0.10647D0,
53062 & 0.11774D0, 0.13641D0, 0.15816D0, 0.18425D0, 0.20243D0,
53063 & 0.22446D0, 0.23452D0, 0.23710D0, 0.23336D0, 0.22443D0,
53064 & 0.21239D0, 0.19820D0, 0.18290D0, 0.16716D0, 0.15148D0,
53065 & 0.13595D0, 0.12104D0, 0.10685D0, 0.09353D0, 0.08121D0,
53066 & 0.06995D0, 0.05958D0, 0.05021D0, 0.04207D0, 0.03472D0,
53067 & 0.02829D0, 0.02282D0, 0.01806D0, 0.01077D0, 0.00590D0,
53068 & 0.00287D0, 0.00118D0, 0.00007D0, 0.00000D0/
53069 DATA (FMRS(1,2,I,22),I=1,49)/
53070 & 0.00659D0, 0.00863D0, 0.01133D0, 0.01328D0, 0.01487D0,
53071 & 0.01624D0, 0.02138D0, 0.02828D0, 0.03345D0, 0.03777D0,
53072 & 0.04174D0, 0.05717D0, 0.07882D0, 0.09501D0, 0.10826D0,
53073 & 0.11956D0, 0.13822D0, 0.15980D0, 0.18547D0, 0.20313D0,
53074 & 0.22408D0, 0.23313D0, 0.23482D0, 0.23017D0, 0.22053D0,
53075 & 0.20797D0, 0.19344D0, 0.17794D0, 0.16215D0, 0.14650D0,
53076 & 0.13110D0, 0.11639D0, 0.10245D0, 0.08944D0, 0.07745D0,
53077 & 0.06653D0, 0.05651D0, 0.04748D0, 0.03968D0, 0.03265D0,
53078 & 0.02652D0, 0.02133D0, 0.01682D0, 0.00997D0, 0.00542D0,
53079 & 0.00262D0, 0.00106D0, 0.00006D0, 0.00000D0/
53080 DATA (FMRS(1,2,I,23),I=1,49)/
53081 & 0.00669D0, 0.00878D0, 0.01153D0, 0.01352D0, 0.01515D0,
53082 & 0.01655D0, 0.02181D0, 0.02888D0, 0.03416D0, 0.03858D0,
53083 & 0.04263D0, 0.05833D0, 0.08027D0, 0.09661D0, 0.10992D0,
53084 & 0.12125D0, 0.13987D0, 0.16129D0, 0.18654D0, 0.20370D0,
53085 & 0.22365D0, 0.23178D0, 0.23266D0, 0.22717D0, 0.21689D0,
53086 & 0.20387D0, 0.18906D0, 0.17340D0, 0.15758D0, 0.14198D0,
53087 & 0.12670D0, 0.11220D0, 0.09851D0, 0.08577D0, 0.07408D0,
53088 & 0.06350D0, 0.05377D0, 0.04507D0, 0.03757D0, 0.03084D0,
53089 & 0.02497D0, 0.02003D0, 0.01574D0, 0.00927D0, 0.00500D0,
53090 & 0.00240D0, 0.00096D0, 0.00006D0, 0.00000D0/
53091 DATA (FMRS(1,2,I,24),I=1,49)/
53092 & 0.00679D0, 0.00892D0, 0.01172D0, 0.01376D0, 0.01542D0,
53093 & 0.01685D0, 0.02222D0, 0.02944D0, 0.03483D0, 0.03934D0,
53094 & 0.04345D0, 0.05941D0, 0.08161D0, 0.09806D0, 0.11144D0,
53095 & 0.12278D0, 0.14136D0, 0.16260D0, 0.18745D0, 0.20414D0,
53096 & 0.22314D0, 0.23041D0, 0.23054D0, 0.22429D0, 0.21345D0,
53097 & 0.20006D0, 0.18498D0, 0.16918D0, 0.15336D0, 0.13783D0,
53098 & 0.12271D0, 0.10840D0, 0.09494D0, 0.08246D0, 0.07106D0,
53099 & 0.06075D0, 0.05132D0, 0.04292D0, 0.03570D0, 0.02922D0,
53100 & 0.02361D0, 0.01888D0, 0.01480D0, 0.00867D0, 0.00465D0,
53101 & 0.00221D0, 0.00088D0, 0.00005D0, 0.00000D0/
53102 DATA (FMRS(1,2,I,25),I=1,49)/
53103 & 0.00689D0, 0.00906D0, 0.01192D0, 0.01399D0, 0.01569D0,
53104 & 0.01715D0, 0.02264D0, 0.03000D0, 0.03550D0, 0.04009D0,
53105 & 0.04429D0, 0.06049D0, 0.08294D0, 0.09952D0, 0.11294D0,
53106 & 0.12429D0, 0.14282D0, 0.16389D0, 0.18832D0, 0.20454D0,
53107 & 0.22261D0, 0.22902D0, 0.22843D0, 0.22145D0, 0.21007D0,
53108 & 0.19632D0, 0.18101D0, 0.16509D0, 0.14928D0, 0.13382D0,
53109 & 0.11886D0, 0.10475D0, 0.09153D0, 0.07931D0, 0.06819D0,
53110 & 0.05815D0, 0.04900D0, 0.04089D0, 0.03393D0, 0.02770D0,
53111 & 0.02232D0, 0.01781D0, 0.01392D0, 0.00811D0, 0.00432D0,
53112 & 0.00204D0, 0.00081D0, 0.00004D0, 0.00000D0/
53113 DATA (FMRS(1,2,I,26),I=1,49)/
53114 & 0.00699D0, 0.00920D0, 0.01211D0, 0.01423D0, 0.01596D0,
53115 & 0.01744D0, 0.02304D0, 0.03056D0, 0.03616D0, 0.04084D0,
53116 & 0.04510D0, 0.06154D0, 0.08423D0, 0.10091D0, 0.11437D0,
53117 & 0.12573D0, 0.14419D0, 0.16508D0, 0.18909D0, 0.20485D0,
53118 & 0.22201D0, 0.22760D0, 0.22631D0, 0.21867D0, 0.20676D0,
53119 & 0.19266D0, 0.17717D0, 0.16120D0, 0.14536D0, 0.12999D0,
53120 & 0.11520D0, 0.10128D0, 0.08831D0, 0.07633D0, 0.06548D0,
53121 & 0.05572D0, 0.04685D0, 0.03900D0, 0.03228D0, 0.02629D0,
53122 & 0.02113D0, 0.01682D0, 0.01311D0, 0.00760D0, 0.00403D0,
53123 & 0.00189D0, 0.00074D0, 0.00004D0, 0.00000D0/
53124 DATA (FMRS(1,2,I,27),I=1,49)/
53125 & 0.00708D0, 0.00933D0, 0.01230D0, 0.01445D0, 0.01621D0,
53126 & 0.01773D0, 0.02343D0, 0.03108D0, 0.03678D0, 0.04155D0,
53127 & 0.04587D0, 0.06253D0, 0.08544D0, 0.10221D0, 0.11571D0,
53128 & 0.12707D0, 0.14546D0, 0.16617D0, 0.18977D0, 0.20509D0,
53129 & 0.22139D0, 0.22623D0, 0.22430D0, 0.21604D0, 0.20367D0,
53130 & 0.18926D0, 0.17361D0, 0.15759D0, 0.14176D0, 0.12648D0,
53131 & 0.11185D0, 0.09812D0, 0.08537D0, 0.07364D0, 0.06303D0,
53132 & 0.05352D0, 0.04490D0, 0.03729D0, 0.03081D0, 0.02503D0,
53133 & 0.02007D0, 0.01594D0, 0.01240D0, 0.00714D0, 0.00376D0,
53134 & 0.00176D0, 0.00068D0, 0.00004D0, 0.00000D0/
53135 DATA (FMRS(1,2,I,28),I=1,49)/
53136 & 0.00718D0, 0.00946D0, 0.01247D0, 0.01467D0, 0.01646D0,
53137 & 0.01800D0, 0.02380D0, 0.03158D0, 0.03738D0, 0.04221D0,
53138 & 0.04660D0, 0.06346D0, 0.08657D0, 0.10342D0, 0.11695D0,
53139 & 0.12830D0, 0.14663D0, 0.16715D0, 0.19037D0, 0.20527D0,
53140 & 0.22075D0, 0.22489D0, 0.22237D0, 0.21353D0, 0.20079D0,
53141 & 0.18610D0, 0.17031D0, 0.15425D0, 0.13844D0, 0.12326D0,
53142 & 0.10877D0, 0.09523D0, 0.08268D0, 0.07119D0, 0.06080D0,
53143 & 0.05153D0, 0.04314D0, 0.03575D0, 0.02948D0, 0.02390D0,
53144 & 0.01913D0, 0.01516D0, 0.01177D0, 0.00675D0, 0.00353D0,
53145 & 0.00164D0, 0.00063D0, 0.00003D0, 0.00000D0/
53146 DATA (FMRS(1,2,I,29),I=1,49)/
53147 & 0.00727D0, 0.00959D0, 0.01265D0, 0.01488D0, 0.01670D0,
53148 & 0.01827D0, 0.02417D0, 0.03208D0, 0.03797D0, 0.04288D0,
53149 & 0.04733D0, 0.06440D0, 0.08769D0, 0.10463D0, 0.11818D0,
53150 & 0.12952D0, 0.14777D0, 0.16810D0, 0.19092D0, 0.20540D0,
53151 & 0.22008D0, 0.22352D0, 0.22043D0, 0.21103D0, 0.19791D0,
53152 & 0.18297D0, 0.16705D0, 0.15095D0, 0.13519D0, 0.12011D0,
53153 & 0.10577D0, 0.09241D0, 0.08008D0, 0.06881D0, 0.05866D0,
53154 & 0.04961D0, 0.04145D0, 0.03427D0, 0.02822D0, 0.02282D0,
53155 & 0.01822D0, 0.01441D0, 0.01116D0, 0.00637D0, 0.00332D0,
53156 & 0.00153D0, 0.00059D0, 0.00003D0, 0.00000D0/
53157 DATA (FMRS(1,2,I,30),I=1,49)/
53158 & 0.00737D0, 0.00972D0, 0.01283D0, 0.01510D0, 0.01695D0,
53159 & 0.01854D0, 0.02454D0, 0.03258D0, 0.03856D0, 0.04354D0,
53160 & 0.04805D0, 0.06532D0, 0.08879D0, 0.10580D0, 0.11936D0,
53161 & 0.13069D0, 0.14886D0, 0.16900D0, 0.19141D0, 0.20548D0,
53162 & 0.21937D0, 0.22213D0, 0.21850D0, 0.20855D0, 0.19507D0,
53163 & 0.17994D0, 0.16388D0, 0.14775D0, 0.13208D0, 0.11709D0,
53164 & 0.10291D0, 0.08973D0, 0.07760D0, 0.06655D0, 0.05664D0,
53165 & 0.04779D0, 0.03985D0, 0.03289D0, 0.02702D0, 0.02182D0,
53166 & 0.01738D0, 0.01372D0, 0.01060D0, 0.00602D0, 0.00312D0,
53167 & 0.00143D0, 0.00055D0, 0.00003D0, 0.00000D0/
53168 DATA (FMRS(1,2,I,31),I=1,49)/
53169 & 0.00746D0, 0.00985D0, 0.01300D0, 0.01530D0, 0.01718D0,
53170 & 0.01880D0, 0.02489D0, 0.03306D0, 0.03912D0, 0.04417D0,
53171 & 0.04873D0, 0.06619D0, 0.08983D0, 0.10690D0, 0.12048D0,
53172 & 0.13179D0, 0.14987D0, 0.16982D0, 0.19186D0, 0.20553D0,
53173 & 0.21868D0, 0.22081D0, 0.21666D0, 0.20623D0, 0.19242D0,
53174 & 0.17710D0, 0.16093D0, 0.14478D0, 0.12919D0, 0.11430D0,
53175 & 0.10026D0, 0.08726D0, 0.07533D0, 0.06447D0, 0.05479D0,
53176 & 0.04614D0, 0.03840D0, 0.03163D0, 0.02594D0, 0.02091D0,
53177 & 0.01662D0, 0.01309D0, 0.01009D0, 0.00571D0, 0.00295D0,
53178 & 0.00134D0, 0.00051D0, 0.00003D0, 0.00000D0/
53179 DATA (FMRS(1,2,I,32),I=1,49)/
53180 & 0.00755D0, 0.00997D0, 0.01317D0, 0.01550D0, 0.01741D0,
53181 & 0.01905D0, 0.02522D0, 0.03351D0, 0.03966D0, 0.04477D0,
53182 & 0.04938D0, 0.06700D0, 0.09079D0, 0.10792D0, 0.12151D0,
53183 & 0.13280D0, 0.15080D0, 0.17056D0, 0.19223D0, 0.20552D0,
53184 & 0.21797D0, 0.21951D0, 0.21489D0, 0.20403D0, 0.18991D0,
53185 & 0.17441D0, 0.15817D0, 0.14202D0, 0.12646D0, 0.11170D0,
53186 & 0.09780D0, 0.08498D0, 0.07322D0, 0.06257D0, 0.05306D0,
53187 & 0.04463D0, 0.03708D0, 0.03049D0, 0.02496D0, 0.02008D0,
53188 & 0.01594D0, 0.01252D0, 0.00963D0, 0.00542D0, 0.00279D0,
53189 & 0.00126D0, 0.00048D0, 0.00002D0, 0.00000D0/
53190 DATA (FMRS(1,2,I,33),I=1,49)/
53191 & 0.00764D0, 0.01009D0, 0.01333D0, 0.01570D0, 0.01763D0,
53192 & 0.01930D0, 0.02556D0, 0.03396D0, 0.04019D0, 0.04537D0,
53193 & 0.05004D0, 0.06783D0, 0.09177D0, 0.10895D0, 0.12254D0,
53194 & 0.13381D0, 0.15173D0, 0.17130D0, 0.19261D0, 0.20552D0,
53195 & 0.21726D0, 0.21822D0, 0.21313D0, 0.20185D0, 0.18743D0,
53196 & 0.17175D0, 0.15545D0, 0.13931D0, 0.12379D0, 0.10917D0,
53197 & 0.09540D0, 0.08276D0, 0.07118D0, 0.06072D0, 0.05139D0,
53198 & 0.04317D0, 0.03581D0, 0.02938D0, 0.02402D0, 0.01929D0,
53199 & 0.01528D0, 0.01198D0, 0.00920D0, 0.00516D0, 0.00264D0,
53200 & 0.00119D0, 0.00045D0, 0.00002D0, 0.00000D0/
53201 DATA (FMRS(1,2,I,34),I=1,49)/
53202 & 0.00773D0, 0.01021D0, 0.01350D0, 0.01590D0, 0.01786D0,
53203 & 0.01955D0, 0.02590D0, 0.03441D0, 0.04072D0, 0.04597D0,
53204 & 0.05068D0, 0.06863D0, 0.09272D0, 0.10994D0, 0.12353D0,
53205 & 0.13477D0, 0.15260D0, 0.17197D0, 0.19290D0, 0.20543D0,
53206 & 0.21649D0, 0.21688D0, 0.21134D0, 0.19965D0, 0.18497D0,
53207 & 0.16913D0, 0.15278D0, 0.13665D0, 0.12121D0, 0.10669D0,
53208 & 0.09308D0, 0.08060D0, 0.06921D0, 0.05894D0, 0.04980D0,
53209 & 0.04176D0, 0.03458D0, 0.02833D0, 0.02311D0, 0.01853D0,
53210 & 0.01465D0, 0.01147D0, 0.00879D0, 0.00491D0, 0.00250D0,
53211 & 0.00112D0, 0.00042D0, 0.00002D0, 0.00000D0/
53212 DATA (FMRS(1,2,I,35),I=1,49)/
53213 & 0.00781D0, 0.01033D0, 0.01366D0, 0.01609D0, 0.01808D0,
53214 & 0.01979D0, 0.02622D0, 0.03484D0, 0.04123D0, 0.04653D0,
53215 & 0.05129D0, 0.06941D0, 0.09362D0, 0.11088D0, 0.12448D0,
53216 & 0.13569D0, 0.15342D0, 0.17260D0, 0.19318D0, 0.20535D0,
53217 & 0.21576D0, 0.21562D0, 0.20966D0, 0.19759D0, 0.18266D0,
53218 & 0.16668D0, 0.15028D0, 0.13418D0, 0.11882D0, 0.10439D0,
53219 & 0.09094D0, 0.07861D0, 0.06739D0, 0.05729D0, 0.04834D0,
53220 & 0.04048D0, 0.03346D0, 0.02736D0, 0.02228D0, 0.01784D0,
53221 & 0.01408D0, 0.01100D0, 0.00842D0, 0.00468D0, 0.00237D0,
53222 & 0.00106D0, 0.00039D0, 0.00002D0, 0.00000D0/
53223 DATA (FMRS(1,2,I,36),I=1,49)/
53224 & 0.00790D0, 0.01044D0, 0.01382D0, 0.01628D0, 0.01829D0,
53225 & 0.02002D0, 0.02653D0, 0.03525D0, 0.04172D0, 0.04707D0,
53226 & 0.05188D0, 0.07013D0, 0.09447D0, 0.11177D0, 0.12535D0,
53227 & 0.13654D0, 0.15418D0, 0.17318D0, 0.19341D0, 0.20524D0,
53228 & 0.21505D0, 0.21440D0, 0.20805D0, 0.19563D0, 0.18048D0,
53229 & 0.16438D0, 0.14795D0, 0.13186D0, 0.11657D0, 0.10226D0,
53230 & 0.08894D0, 0.07676D0, 0.06571D0, 0.05578D0, 0.04700D0,
53231 & 0.03929D0, 0.03242D0, 0.02648D0, 0.02153D0, 0.01720D0,
53232 & 0.01356D0, 0.01058D0, 0.00808D0, 0.00448D0, 0.00226D0,
53233 & 0.00101D0, 0.00037D0, 0.00002D0, 0.00000D0/
53234 DATA (FMRS(1,2,I,37),I=1,49)/
53235 & 0.00798D0, 0.01056D0, 0.01397D0, 0.01646D0, 0.01850D0,
53236 & 0.02025D0, 0.02684D0, 0.03567D0, 0.04221D0, 0.04762D0,
53237 & 0.05247D0, 0.07087D0, 0.09532D0, 0.11265D0, 0.12622D0,
53238 & 0.13738D0, 0.15492D0, 0.17373D0, 0.19361D0, 0.20510D0,
53239 & 0.21429D0, 0.21315D0, 0.20641D0, 0.19365D0, 0.17829D0,
53240 & 0.16207D0, 0.14561D0, 0.12954D0, 0.11434D0, 0.10013D0,
53241 & 0.08696D0, 0.07493D0, 0.06406D0, 0.05429D0, 0.04567D0,
53242 & 0.03812D0, 0.03141D0, 0.02561D0, 0.02079D0, 0.01659D0,
53243 & 0.01305D0, 0.01017D0, 0.00775D0, 0.00428D0, 0.00215D0,
53244 & 0.00095D0, 0.00035D0, 0.00002D0, 0.00000D0/
53245 DATA (FMRS(1,2,I,38),I=1,49)/
53246 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53247 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53248 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53249 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53250 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53251 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53252 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53253 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53254 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53255 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53256 DATA (FMRS(1,3,I, 1),I=1,49)/
53257 & 3.68244D0, 3.61785D0, 3.55346D0, 3.51555D0, 3.48837D0,
53258 & 3.46702D0, 3.39811D0, 3.32177D0, 3.27072D0, 3.23000D0,
53259 & 3.19378D0, 3.05765D0, 2.86346D0, 2.71339D0, 2.58651D0,
53260 & 2.47572D0, 2.28777D0, 2.06245D0, 1.78178D0, 1.57726D0,
53261 & 1.30519D0, 1.14076D0, 1.03654D0, 0.95264D0, 0.89447D0,
53262 & 0.84663D0, 0.80090D0, 0.75325D0, 0.70217D0, 0.64784D0,
53263 & 0.59048D0, 0.53173D0, 0.47263D0, 0.41459D0, 0.35887D0,
53264 & 0.30634D0, 0.25757D0, 0.21335D0, 0.17415D0, 0.13936D0,
53265 & 0.10957D0, 0.08459D0, 0.06372D0, 0.03369D0, 0.01574D0,
53266 & 0.00625D0, 0.00195D0, 0.00005D0, 0.00000D0/
53267 DATA (FMRS(1,3,I, 2),I=1,49)/
53268 & 6.24307D0, 5.86376D0, 5.50631D0, 5.30646D0, 5.16844D0,
53269 & 5.06337D0, 4.74657D0, 4.44005D0, 4.26242D0, 4.13555D0,
53270 & 4.03502D0, 3.71094D0, 3.34882D0, 3.11051D0, 2.92600D0,
53271 & 2.77355D0, 2.52821D0, 2.24967D0, 1.91859D0, 1.68481D0,
53272 & 1.37946D0, 1.19535D0, 1.07673D0, 0.97819D0, 0.90750D0,
53273 & 0.84881D0, 0.79381D0, 0.73852D0, 0.68149D0, 0.62276D0,
53274 & 0.56254D0, 0.50226D0, 0.44285D0, 0.38548D0, 0.33123D0,
53275 & 0.28073D0, 0.23437D0, 0.19279D0, 0.15633D0, 0.12427D0,
53276 & 0.09707D0, 0.07445D0, 0.05572D0, 0.02906D0, 0.01339D0,
53277 & 0.00524D0, 0.00161D0, 0.00004D0, 0.00000D0/
53278 DATA (FMRS(1,3,I, 3),I=1,49)/
53279 & 11.05139D0, 9.94786D0, 8.95244D0, 8.41536D0, 8.05287D0,
53280 & 7.78166D0, 6.98996D0, 6.26416D0, 5.86369D0, 5.58758D0,
53281 & 5.37431D0, 4.72923D0, 4.08790D0, 3.70661D0, 3.43015D0,
53282 & 3.21204D0, 2.87740D0, 2.51734D0, 2.11023D0, 1.83283D0,
53283 & 1.47833D0, 1.26530D0, 1.12571D0, 1.00618D0, 0.91793D0,
53284 & 0.84442D0, 0.77712D0, 0.71204D0, 0.64770D0, 0.58389D0,
53285 & 0.52071D0, 0.45928D0, 0.40030D0, 0.34459D0, 0.29298D0,
53286 & 0.24576D0, 0.20309D0, 0.16540D0, 0.13284D0, 0.10462D0,
53287 & 0.08093D0, 0.06152D0, 0.04560D0, 0.02333D0, 0.01054D0,
53288 & 0.00404D0, 0.00122D0, 0.00003D0, 0.00000D0/
53289 DATA (FMRS(1,3,I, 4),I=1,49)/
53290 & 15.37825D0, 13.53065D0, 11.90193D0, 11.03924D0, 10.46378D0,
53291 & 10.03696D0, 8.81034D0, 7.71341D0, 7.12073D0, 6.71781D0,
53292 & 6.40918D0, 5.49848D0, 4.63276D0, 4.13943D0, 3.79203D0,
53293 & 3.52386D0, 3.12196D0, 2.70149D0, 2.23890D0, 1.93011D0,
53294 & 1.54059D0, 1.30714D0, 1.15286D0, 1.01886D0, 0.91881D0,
53295 & 0.83562D0, 0.76055D0, 0.68952D0, 0.62095D0, 0.55452D0,
53296 & 0.49011D0, 0.42861D0, 0.37052D0, 0.31647D0, 0.26702D0,
53297 & 0.22241D0, 0.18246D0, 0.14751D0, 0.11769D0, 0.09209D0,
53298 & 0.07074D0, 0.05343D0, 0.03933D0, 0.01985D0, 0.00885D0,
53299 & 0.00335D0, 0.00100D0, 0.00002D0, 0.00000D0/
53300 DATA (FMRS(1,3,I, 5),I=1,49)/
53301 & 20.54786D0, 17.73643D0, 15.30522D0, 14.03720D0, 13.19955D0,
53302 & 12.58273D0, 10.83264D0, 9.29877D0, 8.48369D0, 7.93560D0,
53303 & 7.51848D0, 6.31010D0, 5.19808D0, 4.58383D0, 4.16067D0,
53304 & 3.83948D0, 3.36690D0, 2.88348D0, 2.36367D0, 2.02276D0,
53305 & 1.59751D0, 1.34336D0, 1.17440D0, 1.02619D0, 0.91484D0,
53306 & 0.82260D0, 0.74049D0, 0.66431D0, 0.59227D0, 0.52387D0,
53307 & 0.45886D0, 0.39784D0, 0.34106D0, 0.28898D0, 0.24193D0,
53308 & 0.20003D0, 0.16291D0, 0.13075D0, 0.10361D0, 0.08049D0,
53309 & 0.06141D0, 0.04606D0, 0.03367D0, 0.01676D0, 0.00737D0,
53310 & 0.00275D0, 0.00081D0, 0.00002D0, 0.00000D0/
53311 DATA (FMRS(1,3,I, 6),I=1,49)/
53312 & 25.87997D0, 22.00579D0, 18.70564D0, 17.00514D0, 15.89031D0,
53313 & 15.07400D0, 12.78092D0, 10.80231D0, 9.76436D0, 9.07223D0,
53314 & 8.54820D0, 7.05063D0, 5.70461D0, 4.97765D0, 4.48471D0,
53315 & 4.11512D0, 3.57867D0, 3.03899D0, 2.46867D0, 2.09967D0,
53316 & 1.64344D0, 1.37152D0, 1.19009D0, 1.03003D0, 0.90944D0,
53317 & 0.81000D0, 0.72245D0, 0.64242D0, 0.56795D0, 0.49835D0,
53318 & 0.43318D0, 0.37285D0, 0.31739D0, 0.26712D0, 0.22217D0,
53319 & 0.18254D0, 0.14775D0, 0.11786D0, 0.09285D0, 0.07171D0,
53320 & 0.05439D0, 0.04056D0, 0.02948D0, 0.01450D0, 0.00631D0,
53321 & 0.00232D0, 0.00067D0, 0.00002D0, 0.00000D0/
53322 DATA (FMRS(1,3,I, 7),I=1,49)/
53323 & 31.48650D0, 26.43816D0, 22.19174D0, 20.02570D0, 18.61470D0,
53324 & 17.58636D0, 14.72161D0, 12.28168D0, 11.01532D0, 10.17669D0,
53325 & 9.54456D0, 7.75761D0, 6.18119D0, 5.34474D0, 4.78459D0,
53326 & 4.36861D0, 3.77149D0, 3.17878D0, 2.56125D0, 2.16614D0,
53327 & 1.68135D0, 1.39321D0, 1.20050D0, 1.02990D0, 0.90129D0,
53328 & 0.79577D0, 0.70378D0, 0.62075D0, 0.54457D0, 0.47435D0,
53329 & 0.40939D0, 0.34999D0, 0.29601D0, 0.24758D0, 0.20467D0,
53330 & 0.16718D0, 0.13453D0, 0.10670D0, 0.08361D0, 0.06425D0,
53331 & 0.04845D0, 0.03594D0, 0.02598D0, 0.01264D0, 0.00544D0,
53332 & 0.00198D0, 0.00057D0, 0.00001D0, 0.00000D0/
53333 DATA (FMRS(1,3,I, 8),I=1,49)/
53334 & 38.19562D0, 31.67731D0, 26.26192D0, 23.52700D0, 21.75654D0,
53335 & 20.47217D0, 16.92324D0, 13.93891D0, 12.40615D0, 11.39793D0,
53336 & 10.64140D0, 8.52490D0, 6.69053D0, 5.73328D0, 5.09966D0,
53337 & 4.63338D0, 3.97084D0, 3.32155D0, 2.65414D0, 2.23167D0,
53338 & 1.71719D0, 1.41235D0, 1.20819D0, 1.02708D0, 0.89064D0,
53339 & 0.77934D0, 0.68328D0, 0.59764D0, 0.52014D0, 0.44964D0,
53340 & 0.38523D0, 0.32704D0, 0.27476D0, 0.22832D0, 0.18758D0,
53341 & 0.15228D0, 0.12182D0, 0.09604D0, 0.07484D0, 0.05719D0,
53342 & 0.04288D0, 0.03164D0, 0.02275D0, 0.01095D0, 0.00466D0,
53343 & 0.00168D0, 0.00048D0, 0.00001D0, 0.00000D0/
53344 DATA (FMRS(1,3,I, 9),I=1,49)/
53345 & 44.69263D0, 36.69535D0, 30.11768D0, 26.82255D0, 24.70025D0,
53346 & 23.16639D0, 18.95601D0, 15.45187D0, 13.66736D0, 12.49995D0,
53347 & 11.62724D0, 9.20581D0, 7.13631D0, 6.07035D0, 5.37118D0,
53348 & 4.86033D0, 4.14011D0, 3.44140D0, 2.73081D0, 2.28485D0,
53349 & 1.74506D0, 1.42613D0, 1.21246D0, 1.02274D0, 0.88003D0,
53350 & 0.76424D0, 0.66513D0, 0.57765D0, 0.49935D0, 0.42889D0,
53351 & 0.36519D0, 0.30820D0, 0.25746D0, 0.21275D0, 0.17388D0,
53352 & 0.14043D0, 0.11178D0, 0.08767D0, 0.06799D0, 0.05171D0,
53353 & 0.03859D0, 0.02834D0, 0.02028D0, 0.00968D0, 0.00408D0,
53354 & 0.00146D0, 0.00041D0, 0.00001D0, 0.00000D0/
53355 DATA (FMRS(1,3,I,10),I=1,49)/
53356 & 51.42669D0, 41.84610D0, 34.03689D0, 30.15309D0, 27.66303D0,
53357 & 25.86942D0, 20.97504D0, 16.93923D0, 14.89954D0, 13.57172D0,
53358 & 12.58248D0, 9.85775D0, 7.55746D0, 6.38605D0, 5.62372D0,
53359 & 5.07013D0, 4.29501D0, 3.54959D0, 2.79853D0, 2.33075D0,
53360 & 1.76763D0, 1.43584D0, 1.21358D0, 1.01625D0, 0.86814D0,
53361 & 0.74860D0, 0.64707D0, 0.55827D0, 0.47958D0, 0.40941D0,
53362 & 0.34660D0, 0.29089D0, 0.24172D0, 0.19871D0, 0.16160D0,
53363 & 0.12988D0, 0.10289D0, 0.08032D0, 0.06202D0, 0.04695D0,
53364 & 0.03489D0, 0.02551D0, 0.01818D0, 0.00860D0, 0.00360D0,
53365 & 0.00128D0, 0.00036D0, 0.00001D0, 0.00000D0/
53366 DATA (FMRS(1,3,I,11),I=1,49)/
53367 & 57.20334D0, 46.22931D0, 37.34534D0, 32.95134D0, 30.14391D0,
53368 & 28.12686D0, 22.64741D0, 18.16087D0, 15.90648D0, 14.44434D0,
53369 & 13.35786D0, 10.38182D0, 7.89242D0, 6.63544D0, 5.82215D0,
53370 & 5.23423D0, 4.41529D0, 3.63279D0, 2.84983D0, 2.36499D0,
53371 & 1.78374D0, 1.44206D0, 1.21326D0, 1.01023D0, 0.85815D0,
53372 & 0.73593D0, 0.63273D0, 0.54312D0, 0.46430D0, 0.39449D0,
53373 & 0.33248D0, 0.27783D0, 0.22993D0, 0.18826D0, 0.15250D0,
53374 & 0.12212D0, 0.09637D0, 0.07495D0, 0.05770D0, 0.04352D0,
53375 & 0.03223D0, 0.02349D0, 0.01668D0, 0.00784D0, 0.00326D0,
53376 & 0.00115D0, 0.00032D0, 0.00001D0, 0.00000D0/
53377 DATA (FMRS(1,3,I,12),I=1,49)/
53378 & 70.62117D0, 56.29525D0, 44.85603D0, 39.26056D0, 35.71024D0,
53379 & 33.17249D0, 26.34026D0, 20.82458D0, 18.08508D0, 16.32156D0,
53380 & 15.01807D0, 11.48651D0, 8.58576D0, 7.14521D0, 6.22372D0,
53381 & 5.56345D0, 4.65284D0, 3.79371D0, 2.94559D0, 2.42633D0,
53382 & 1.80899D0, 1.44797D0, 1.20662D0, 0.99291D0, 0.83369D0,
53383 & 0.70687D0, 0.60112D0, 0.51056D0, 0.43209D0, 0.36357D0,
53384 & 0.30359D0, 0.25146D0, 0.20630D0, 0.16753D0, 0.13462D0,
53385 & 0.10696D0, 0.08376D0, 0.06466D0, 0.04944D0, 0.03702D0,
53386 & 0.02722D0, 0.01971D0, 0.01390D0, 0.00645D0, 0.00265D0,
53387 & 0.00093D0, 0.00026D0, 0.00001D0, 0.00000D0/
53388 DATA (FMRS(1,3,I,13),I=1,49)/
53389 & 83.50434D0, 65.82890D0, 51.87140D0, 45.10521D0, 40.83618D0,
53390 & 37.79736D0, 29.67546D0, 23.19327D0, 20.00393D0, 17.96325D0,
53391 & 16.46149D0, 12.42825D0, 9.16326D0, 7.56303D0, 6.54853D0,
53392 & 5.82663D0, 4.83880D0, 3.91602D0, 3.01472D0, 2.46779D0,
53393 & 1.82202D0, 1.44614D0, 1.19543D0, 0.97402D0, 0.80992D0,
53394 & 0.68027D0, 0.57325D0, 0.48262D0, 0.40504D0, 0.33808D0,
53395 & 0.28014D0, 0.23033D0, 0.18761D0, 0.15130D0, 0.12077D0,
53396 & 0.09534D0, 0.07419D0, 0.05692D0, 0.04326D0, 0.03220D0,
53397 & 0.02354D0, 0.01696D0, 0.01189D0, 0.00546D0, 0.00222D0,
53398 & 0.00077D0, 0.00021D0, 0.00001D0, 0.00000D0/
53399 DATA (FMRS(1,3,I,14),I=1,49)/
53400 & 99.26808D0, 77.34151D0, 60.22972D0, 52.01289D0, 46.85941D0,
53401 & 43.20707D0, 33.52017D0, 25.88194D0, 22.16110D0, 19.79557D0,
53402 & 18.06292D0, 13.45200D0, 9.77556D0, 7.99825D0, 6.88178D0,
53403 & 6.09288D0, 5.02224D0, 4.03207D0, 3.07569D0, 2.50055D0,
53404 & 1.82658D0, 1.43637D0, 1.17694D0, 0.94870D0, 0.78062D0,
53405 & 0.64903D0, 0.54156D0, 0.45166D0, 0.37564D0, 0.31084D0,
53406 & 0.25547D0, 0.20834D0, 0.16843D0, 0.13481D0, 0.10686D0,
53407 & 0.08378D0, 0.06476D0, 0.04934D0, 0.03727D0, 0.02756D0,
53408 & 0.02003D0, 0.01435D0, 0.01000D0, 0.00454D0, 0.00183D0,
53409 & 0.00063D0, 0.00017D0, 0.00000D0, 0.00000D0/
53410 DATA (FMRS(1,3,I,15),I=1,49)/
53411 & 117.13634D0, 90.22787D0, 69.46667D0, 59.58908D0, 53.42973D0,
53412 & 49.08310D0, 37.64029D0, 28.72286D0, 24.42074D0, 21.70264D0,
53413 & 19.72087D0, 14.49332D0, 10.38573D0, 8.42544D0, 7.20484D0,
53414 & 6.34818D0, 5.19436D0, 4.13748D0, 3.12707D0, 2.52493D0,
53415 & 1.82437D0, 1.42118D0, 1.15415D0, 0.92032D0, 0.74934D0,
53416 & 0.61673D0, 0.50955D0, 0.42103D0, 0.34703D0, 0.28471D0,
53417 & 0.23205D0, 0.18777D0, 0.15064D0, 0.11967D0, 0.09419D0,
53418 & 0.07336D0, 0.05631D0, 0.04263D0, 0.03201D0, 0.02354D0,
53419 & 0.01700D0, 0.01211D0, 0.00839D0, 0.00377D0, 0.00151D0,
53420 & 0.00052D0, 0.00014D0, 0.00000D0, 0.00000D0/
53421 DATA (FMRS(1,3,I,16),I=1,49)/
53422 & 134.87820D0,102.87527D0, 78.42588D0, 66.88609D0, 59.72612D0,
53423 & 54.69190D0, 41.52393D0, 31.36570D0, 26.50579D0, 23.45176D0,
53424 & 21.23395D0, 15.42784D0, 10.92244D0, 8.79593D0, 7.48170D0,
53425 & 6.56462D0, 5.33723D0, 4.22208D0, 3.16533D0, 2.54035D0,
53426 & 1.81781D0, 1.40424D0, 1.13142D0, 0.89365D0, 0.72095D0,
53427 & 0.58811D0, 0.48181D0, 0.39483D0, 0.32289D0, 0.26295D0,
53428 & 0.21278D0, 0.17100D0, 0.13629D0, 0.10758D0, 0.08415D0,
53429 & 0.06517D0, 0.04972D0, 0.03744D0, 0.02797D0, 0.02046D0,
53430 & 0.01470D0, 0.01042D0, 0.00719D0, 0.00321D0, 0.00127D0,
53431 & 0.00043D0, 0.00012D0, 0.00000D0, 0.00000D0/
53432 DATA (FMRS(1,3,I,17),I=1,49)/
53433 & 154.38010D0,116.63111D0, 88.06633D0, 74.68806D0, 66.42747D0,
53434 & 60.64011D0, 45.59593D0, 34.10384D0, 28.65021D0, 25.24085D0,
53435 & 22.77463D0, 16.36506D0, 11.45095D0, 9.15610D0, 7.74790D0,
53436 & 6.77064D0, 5.47057D0, 4.29852D0, 3.19720D0, 2.55058D0,
53437 & 1.80771D0, 1.38488D0, 1.10716D0, 0.86634D0, 0.69264D0,
53438 & 0.56014D0, 0.45511D0, 0.36997D0, 0.30026D0, 0.24276D0,
53439 & 0.19507D0, 0.15573D0, 0.12333D0, 0.09676D0, 0.07524D0,
53440 & 0.05794D0, 0.04395D0, 0.03292D0, 0.02447D0, 0.01781D0,
53441 & 0.01274D0, 0.00899D0, 0.00618D0, 0.00274D0, 0.00108D0,
53442 & 0.00037D0, 0.00010D0, 0.00000D0, 0.00000D0/
53443 DATA (FMRS(1,3,I,18),I=1,49)/
53444 & 171.60985D0,128.66806D0, 96.41977D0, 81.40891D0, 72.17590D0,
53445 & 65.72558D0, 49.04064D0, 36.39427D0, 30.43144D0, 26.71914D0,
53446 & 24.04215D0, 17.12464D0, 11.87120D0, 9.43856D0, 7.95410D0,
53447 & 6.92832D0, 5.57016D0, 4.35322D0, 3.21721D0, 2.55406D0,
53448 & 1.79608D0, 1.36671D0, 1.08575D0, 0.84319D0, 0.66925D0,
53449 & 0.53749D0, 0.43376D0, 0.35041D0, 0.28267D0, 0.22722D0,
53450 & 0.18154D0, 0.14418D0, 0.11359D0, 0.08871D0, 0.06865D0,
53451 & 0.05262D0, 0.03976D0, 0.02965D0, 0.02195D0, 0.01592D0,
53452 & 0.01135D0, 0.00798D0, 0.00547D0, 0.00241D0, 0.00095D0,
53453 & 0.00032D0, 0.00009D0, 0.00000D0, 0.00000D0/
53454 DATA (FMRS(1,3,I,19),I=1,49)/
53455 & 193.78899D0,144.01862D0,106.97157D0, 89.85031D0, 79.36631D0,
53456 & 72.06629D0, 53.29134D0, 39.18974D0, 32.59051D0, 28.50177D0,
53457 & 25.56394D0, 18.02311D0, 12.35926D0, 9.76179D0, 8.18702D0,
53458 & 7.10431D0, 5.67841D0, 4.40968D0, 3.23437D0, 2.55292D0,
53459 & 1.77867D0, 1.34261D0, 1.05865D0, 0.81484D0, 0.64125D0,
53460 & 0.51082D0, 0.40904D0, 0.32798D0, 0.26269D0, 0.20975D0,
53461 & 0.16651D0, 0.13145D0, 0.10293D0, 0.07994D0, 0.06153D0,
53462 & 0.04691D0, 0.03527D0, 0.02618D0, 0.01929D0, 0.01394D0,
53463 & 0.00989D0, 0.00693D0, 0.00473D0, 0.00207D0, 0.00081D0,
53464 & 0.00027D0, 0.00007D0, 0.00000D0, 0.00000D0/
53465 DATA (FMRS(1,3,I,20),I=1,49)/
53466 & 214.89481D0,158.49641D0,116.83355D0, 97.69725D0, 86.02460D0,
53467 & 77.91979D0, 57.17770D0, 41.71972D0, 34.53225D0, 30.09744D0,
53468 & 26.92084D0, 18.81368D0, 12.78187D0, 10.03830D0, 8.38419D0,
53469 & 7.25181D0, 5.76723D0, 4.45410D0, 3.24560D0, 2.54901D0,
53470 & 1.76164D0, 1.32048D0, 1.03446D0, 0.79010D0, 0.61721D0,
53471 & 0.48824D0, 0.38835D0, 0.30938D0, 0.24629D0, 0.19551D0,
53472 & 0.15438D0, 0.12122D0, 0.09444D0, 0.07299D0, 0.05594D0,
53473 & 0.04245D0, 0.03178D0, 0.02349D0, 0.01725D0, 0.01242D0,
53474 & 0.00879D0, 0.00614D0, 0.00418D0, 0.00182D0, 0.00071D0,
53475 & 0.00024D0, 0.00007D0, 0.00000D0, 0.00000D0/
53476 DATA (FMRS(1,3,I,21),I=1,49)/
53477 & 234.93695D0,172.12665D0,126.03609D0,104.98046D0, 92.18044D0,
53478 & 83.31506D0, 60.72429D0, 44.00365D0, 36.27307D0, 31.52044D0,
53479 & 28.12565D0, 19.50453D0, 13.14306D0, 10.27071D0, 8.54710D0,
53480 & 7.37140D0, 5.83642D0, 4.48556D0, 3.24949D0, 2.54059D0,
53481 & 1.74309D0, 1.29840D0, 1.01128D0, 0.76711D0, 0.59538D0,
53482 & 0.46805D0, 0.37012D0, 0.29319D0, 0.23219D0, 0.18337D0,
53483 & 0.14410D0, 0.11261D0, 0.08738D0, 0.06725D0, 0.05133D0,
53484 & 0.03881D0, 0.02895D0, 0.02133D0, 0.01562D0, 0.01121D0,
53485 & 0.00791D0, 0.00551D0, 0.00374D0, 0.00162D0, 0.00063D0,
53486 & 0.00021D0, 0.00006D0, 0.00000D0, 0.00000D0/
53487 DATA (FMRS(1,3,I,22),I=1,49)/
53488 & 261.98752D0,190.37146D0,138.25069D0,114.59908D0,100.28083D0,
53489 & 90.39440D0, 65.33586D0, 46.94503D0, 38.50155D0, 33.33386D0,
53490 & 29.65516D0, 20.37022D0, 13.58831D0, 10.55348D0, 8.74295D0,
53491 & 7.51340D0, 5.91633D0, 4.51953D0, 3.25037D0, 2.52703D0,
53492 & 1.71812D0, 1.26985D0, 0.98192D0, 0.73853D0, 0.56860D0,
53493 & 0.44359D0, 0.34825D0, 0.27396D0, 0.21556D0, 0.16918D0,
53494 & 0.13216D0, 0.10269D0, 0.07927D0, 0.06069D0, 0.04611D0,
53495 & 0.03471D0, 0.02577D0, 0.01891D0, 0.01380D0, 0.00987D0,
53496 & 0.00694D0, 0.00482D0, 0.00326D0, 0.00141D0, 0.00055D0,
53497 & 0.00018D0, 0.00005D0, 0.00000D0, 0.00000D0/
53498 DATA (FMRS(1,3,I,23),I=1,49)/
53499 & 289.01031D0,208.43709D0,150.23653D0,123.98669D0,108.15595D0,
53500 & 97.25583D0, 69.76177D0, 49.73855D0, 40.60409D0, 35.03629D0,
53501 & 31.08496D0, 21.16773D0, 13.99081D0, 10.80513D0, 8.91469D0,
53502 & 7.63597D0, 5.98282D0, 4.54504D0, 3.24687D0, 2.51128D0,
53503 & 1.69316D0, 1.24243D0, 0.95435D0, 0.71223D0, 0.54431D0,
53504 & 0.42170D0, 0.32889D0, 0.25710D0, 0.20110D0, 0.15697D0,
53505 & 0.12195D0, 0.09429D0, 0.07242D0, 0.05518D0, 0.04175D0,
53506 & 0.03132D0, 0.02316D0, 0.01693D0, 0.01232D0, 0.00878D0,
53507 & 0.00615D0, 0.00426D0, 0.00288D0, 0.00124D0, 0.00048D0,
53508 & 0.00016D0, 0.00004D0, 0.00000D0, 0.00000D0/
53509 DATA (FMRS(1,3,I,24),I=1,49)/
53510 & 315.12421D0,225.74153D0,161.61246D0,132.84715D0,115.55888D0,
53511 & 103.68510D0, 73.86555D0, 52.29894D0, 42.51674D0, 36.57598D0,
53512 & 32.37159D0, 21.87235D0, 14.33730D0, 11.01653D0, 9.05547D0,
53513 & 7.73389D0, 6.03187D0, 4.55934D0, 3.23736D0, 2.49207D0,
53514 & 1.66734D0, 1.21544D0, 0.92800D0, 0.68769D0, 0.52210D0,
53515 & 0.40197D0, 0.31164D0, 0.24228D0, 0.18850D0, 0.14640D0,
53516 & 0.11322D0, 0.08715D0, 0.06666D0, 0.05059D0, 0.03813D0,
53517 & 0.02850D0, 0.02101D0, 0.01531D0, 0.01111D0, 0.00790D0,
53518 & 0.00552D0, 0.00382D0, 0.00258D0, 0.00111D0, 0.00043D0,
53519 & 0.00014D0, 0.00004D0, 0.00000D0, 0.00000D0/
53520 DATA (FMRS(1,3,I,25),I=1,49)/
53521 & 342.80673D0,243.95296D0,173.49684D0,142.06322D0,123.23465D0,
53522 & 110.33495D0, 78.07693D0, 54.90473D0, 44.45325D0, 38.12883D0,
53523 & 33.66507D0, 22.57285D0, 14.67683D0, 11.22134D0, 9.19035D0,
53524 & 7.82660D0, 6.07682D0, 4.57070D0, 3.22605D0, 2.47181D0,
53525 & 1.64130D0, 1.18872D0, 0.90224D0, 0.66398D0, 0.50084D0,
53526 & 0.38326D0, 0.29541D0, 0.22842D0, 0.17680D0, 0.13666D0,
53527 & 0.10521D0, 0.08063D0, 0.06143D0, 0.04643D0, 0.03487D0,
53528 & 0.02598D0, 0.01909D0, 0.01388D0, 0.01004D0, 0.00712D0,
53529 & 0.00496D0, 0.00343D0, 0.00231D0, 0.00099D0, 0.00038D0,
53530 & 0.00013D0, 0.00004D0, 0.00000D0, 0.00000D0/
53531 DATA (FMRS(1,3,I,26),I=1,49)/
53532 & 370.71918D0,262.16998D0,185.28712D0,151.16048D0,130.78375D0,
53533 & 116.85600D0, 82.16776D0, 57.40948D0, 46.30192D0, 39.60334D0,
53534 & 34.88776D0, 23.22383D0, 14.98428D0, 11.40259D0, 9.30664D0,
53535 & 7.90402D0, 6.11093D0, 4.57472D0, 3.21035D0, 2.44880D0,
53536 & 1.61427D0, 1.16192D0, 0.87693D0, 0.64114D0, 0.48063D0,
53537 & 0.36570D0, 0.28035D0, 0.21566D0, 0.16615D0, 0.12784D0,
53538 & 0.09801D0, 0.07482D0, 0.05679D0, 0.04277D0, 0.03202D0,
53539 & 0.02378D0, 0.01743D0, 0.01263D0, 0.00912D0, 0.00645D0,
53540 & 0.00449D0, 0.00310D0, 0.00208D0, 0.00089D0, 0.00034D0,
53541 & 0.00012D0, 0.00003D0, 0.00000D0, 0.00000D0/
53542 DATA (FMRS(1,3,I,27),I=1,49)/
53543 & 398.31635D0,280.05777D0,196.78310D0,159.99336D0,138.09111D0,
53544 & 123.15311D0, 86.08746D0, 59.78946D0, 48.04917D0, 40.99130D0,
53545 & 36.03455D0, 23.82682D0, 15.26416D0, 11.56505D0, 9.40909D0,
53546 & 7.97073D0, 6.13825D0, 4.57511D0, 3.19349D0, 2.42581D0,
53547 & 1.58834D0, 1.13668D0, 0.85340D0, 0.62017D0, 0.46227D0,
53548 & 0.34987D0, 0.26689D0, 0.20435D0, 0.15674D0, 0.12011D0,
53549 & 0.09172D0, 0.06977D0, 0.05278D0, 0.03962D0, 0.02958D0,
53550 & 0.02190D0, 0.01601D0, 0.01157D0, 0.00834D0, 0.00589D0,
53551 & 0.00409D0, 0.00282D0, 0.00189D0, 0.00081D0, 0.00031D0,
53552 & 0.00010D0, 0.00003D0, 0.00000D0, 0.00000D0/
53553 DATA (FMRS(1,3,I,28),I=1,49)/
53554 & 425.10541D0,297.30496D0,207.79007D0,168.41481D0,145.03664D0,
53555 & 129.12375D0, 89.77434D0, 62.00834D0, 49.66874D0, 42.27205D0,
53556 & 37.08847D0, 24.37295D0, 15.51221D0, 11.70602D0, 9.49577D0,
53557 & 8.02523D0, 6.15776D0, 4.57120D0, 3.17506D0, 2.40249D0,
53558 & 1.56325D0, 1.11278D0, 0.83141D0, 0.60084D0, 0.44554D0,
53559 & 0.33559D0, 0.25483D0, 0.19432D0, 0.14844D0, 0.11333D0,
53560 & 0.08624D0, 0.06537D0, 0.04932D0, 0.03692D0, 0.02748D0,
53561 & 0.02030D0, 0.01481D0, 0.01068D0, 0.00768D0, 0.00541D0,
53562 & 0.00376D0, 0.00258D0, 0.00173D0, 0.00074D0, 0.00028D0,
53563 & 0.00010D0, 0.00003D0, 0.00000D0, 0.00000D0/
53564 DATA (FMRS(1,3,I,29),I=1,49)/
53565 & 452.96622D0,315.13217D0,219.09509D0,177.03108D0,152.12305D0,
53566 & 135.20210D0, 93.50108D0, 64.23380D0, 51.28493D0, 43.54515D0,
53567 & 38.13279D0, 24.90754D0, 15.75054D0, 11.83897D0, 9.57579D0,
53568 & 8.07414D0, 6.17308D0, 4.56436D0, 3.15482D0, 2.37807D0,
53569 & 1.53780D0, 1.08891D0, 0.80971D0, 0.58195D0, 0.42935D0,
53570 & 0.32187D0, 0.24333D0, 0.18479D0, 0.14060D0, 0.10697D0,
53571 & 0.08112D0, 0.06130D0, 0.04611D0, 0.03442D0, 0.02556D0,
53572 & 0.01884D0, 0.01371D0, 0.00987D0, 0.00709D0, 0.00499D0,
53573 & 0.00346D0, 0.00237D0, 0.00159D0, 0.00068D0, 0.00026D0,
53574 & 0.00009D0, 0.00002D0, 0.00000D0, 0.00000D0/
53575 DATA (FMRS(1,3,I,30),I=1,49)/
53576 & 481.05176D0,332.98895D0,230.34398D0,185.57016D0,159.12541D0,
53577 & 141.19426D0, 97.14677D0, 66.39220D0, 52.84356D0, 44.76743D0,
53578 & 39.13180D0, 25.41137D0, 15.96984D0, 11.95815D0, 9.64523D0,
53579 & 8.11468D0, 6.18265D0, 4.55389D0, 3.13269D0, 2.35270D0,
53580 & 1.51231D0, 1.06542D0, 0.78862D0, 0.56381D0, 0.41396D0,
53581 & 0.30893D0, 0.23257D0, 0.17592D0, 0.13335D0, 0.10111D0,
53582 & 0.07645D0, 0.05760D0, 0.04319D0, 0.03217D0, 0.02383D0,
53583 & 0.01753D0, 0.01273D0, 0.00915D0, 0.00656D0, 0.00461D0,
53584 & 0.00319D0, 0.00219D0, 0.00146D0, 0.00062D0, 0.00024D0,
53585 & 0.00008D0, 0.00002D0, 0.00000D0, 0.00000D0/
53586 DATA (FMRS(1,3,I,31),I=1,49)/
53587 & 508.69336D0,350.46606D0,241.29128D0,193.85184D0,165.89978D0,
53588 & 146.97998D0,100.64462D0, 68.44891D0, 54.32217D0, 45.92301D0,
53589 & 40.07352D0, 25.88124D0, 16.17098D0, 12.06571D0, 9.70659D0,
53590 & 8.14933D0, 6.18899D0, 4.54214D0, 3.11075D0, 2.32815D0,
53591 & 1.48813D0, 1.04340D0, 0.76902D0, 0.54710D0, 0.39988D0,
53592 & 0.29718D0, 0.22284D0, 0.16794D0, 0.12688D0, 0.09590D0,
53593 & 0.07230D0, 0.05433D0, 0.04063D0, 0.03020D0, 0.02232D0,
53594 & 0.01639D0, 0.01188D0, 0.00852D0, 0.00610D0, 0.00428D0,
53595 & 0.00296D0, 0.00203D0, 0.00136D0, 0.00057D0, 0.00022D0,
53596 & 0.00007D0, 0.00002D0, 0.00000D0, 0.00000D0/
53597 DATA (FMRS(1,3,I,32),I=1,49)/
53598 & 535.18030D0,367.11212D0,251.65173D0,201.65910D0,172.26764D0,
53599 & 152.40591D0,103.89980D0, 70.34598D0, 55.67789D0, 46.97741D0,
53600 & 40.92907D0, 26.30087D0, 16.34517D0, 12.15570D0, 9.75539D0,
53601 & 8.17448D0, 6.18955D0, 4.52735D0, 3.08788D0, 2.30359D0,
53602 & 1.46475D0, 1.02248D0, 0.75063D0, 0.53161D0, 0.38695D0,
53603 & 0.28648D0, 0.21405D0, 0.16077D0, 0.12112D0, 0.09128D0,
53604 & 0.06863D0, 0.05145D0, 0.03839D0, 0.02847D0, 0.02101D0,
53605 & 0.01540D0, 0.01114D0, 0.00798D0, 0.00571D0, 0.00400D0,
53606 & 0.00276D0, 0.00189D0, 0.00126D0, 0.00054D0, 0.00020D0,
53607 & 0.00007D0, 0.00002D0, 0.00000D0, 0.00000D0/
53608 DATA (FMRS(1,3,I,33),I=1,49)/
53609 & 563.08673D0,384.57391D0,262.47256D0,209.79239D0,178.88937D0,
53610 & 158.04028D0,107.26506D0, 72.29848D0, 57.06943D0, 48.05758D0,
53611 & 41.80413D0, 26.72791D0, 16.52149D0, 12.24650D0, 9.80451D0,
53612 & 8.19975D0, 6.19012D0, 4.51259D0, 3.06514D0, 2.27926D0,
53613 & 1.44171D0, 1.00196D0, 0.73265D0, 0.51654D0, 0.37443D0,
53614 & 0.27615D0, 0.20559D0, 0.15389D0, 0.11561D0, 0.08687D0,
53615 & 0.06514D0, 0.04872D0, 0.03627D0, 0.02685D0, 0.01977D0,
53616 & 0.01446D0, 0.01045D0, 0.00747D0, 0.00534D0, 0.00374D0,
53617 & 0.00258D0, 0.00176D0, 0.00118D0, 0.00050D0, 0.00019D0,
53618 & 0.00006D0, 0.00002D0, 0.00000D0, 0.00000D0/
53619 DATA (FMRS(1,3,I,34),I=1,49)/
53620 & 590.49207D0,401.61096D0,272.95639D0,217.63766D0,185.25558D0,
53621 & 163.44283D0,110.46277D0, 74.13376D0, 58.36747D0, 49.05885D0,
53622 & 42.61046D0, 27.11206D0, 16.67322D0, 12.31989D0, 9.84041D0,
53623 & 8.21457D0, 6.18338D0, 4.49312D0, 3.03982D0, 2.25340D0,
53624 & 1.41818D0, 0.98144D0, 0.71494D0, 0.50189D0, 0.36238D0,
53625 & 0.26631D0, 0.19763D0, 0.14748D0, 0.11046D0, 0.08279D0,
53626 & 0.06193D0, 0.04622D0, 0.03434D0, 0.02537D0, 0.01865D0,
53627 & 0.01362D0, 0.00983D0, 0.00702D0, 0.00501D0, 0.00351D0,
53628 & 0.00242D0, 0.00165D0, 0.00110D0, 0.00046D0, 0.00018D0,
53629 & 0.00006D0, 0.00002D0, 0.00000D0, 0.00000D0/
53630 DATA (FMRS(1,3,I,35),I=1,49)/
53631 & 617.67798D0,418.44214D0,283.27148D0,225.33791D0,191.49365D0,
53632 & 168.72942D0,113.57884D0, 75.91459D0, 59.62379D0, 50.02613D0,
53633 & 43.38823D0, 27.48080D0, 16.81807D0, 12.38969D0, 9.87443D0,
53634 & 8.22855D0, 6.17694D0, 4.47470D0, 3.01600D0, 2.22915D0,
53635 & 1.39622D0, 0.96237D0, 0.69854D0, 0.48839D0, 0.35132D0,
53636 & 0.25731D0, 0.19037D0, 0.14164D0, 0.10579D0, 0.07911D0,
53637 & 0.05904D0, 0.04396D0, 0.03261D0, 0.02405D0, 0.01765D0,
53638 & 0.01287D0, 0.00928D0, 0.00662D0, 0.00472D0, 0.00330D0,
53639 & 0.00227D0, 0.00155D0, 0.00103D0, 0.00044D0, 0.00017D0,
53640 & 0.00006D0, 0.00002D0, 0.00000D0, 0.00000D0/
53641 DATA (FMRS(1,3,I,36),I=1,49)/
53642 & 643.85529D0,434.56937D0,293.10349D0,232.65437D0,197.40677D0,
53643 & 173.73129D0,116.50865D0, 77.57690D0, 60.79072D0, 50.92106D0,
53644 & 44.10533D0, 27.81589D0, 16.94600D0, 12.44906D0, 9.90141D0,
53645 & 8.23759D0, 6.16791D0, 4.45540D0, 2.99242D0, 2.20560D0,
53646 & 1.37532D0, 0.94442D0, 0.68324D0, 0.47589D0, 0.34114D0,
53647 & 0.24908D0, 0.18375D0, 0.13636D0, 0.10159D0, 0.07580D0,
53648 & 0.05645D0, 0.04195D0, 0.03106D0, 0.02287D0, 0.01676D0,
53649 & 0.01221D0, 0.00879D0, 0.00626D0, 0.00446D0, 0.00311D0,
53650 & 0.00214D0, 0.00146D0, 0.00097D0, 0.00041D0, 0.00016D0,
53651 & 0.00005D0, 0.00001D0, 0.00000D0, 0.00000D0/
53652 DATA (FMRS(1,3,I,37),I=1,49)/
53653 & 670.62598D0,450.98129D0,303.05762D0,240.03790D0,203.35986D0,
53654 & 178.75746D0,119.43383D0, 79.22430D0, 61.94125D0, 51.79964D0,
53655 & 44.80675D0, 28.13850D0, 17.06516D0, 12.50182D0, 9.92310D0,
53656 & 8.24227D0, 6.15572D0, 4.43398D0, 2.96756D0, 2.18122D0,
53657 & 1.35409D0, 0.92638D0, 0.66799D0, 0.46354D0, 0.33115D0,
53658 & 0.24105D0, 0.17731D0, 0.13125D0, 0.09756D0, 0.07262D0,
53659 & 0.05397D0, 0.04005D0, 0.02960D0, 0.02176D0, 0.01592D0,
53660 & 0.01159D0, 0.00833D0, 0.00593D0, 0.00422D0, 0.00294D0,
53661 & 0.00202D0, 0.00138D0, 0.00092D0, 0.00039D0, 0.00015D0,
53662 & 0.00005D0, 0.00001D0, 0.00000D0, 0.00000D0/
53663 DATA (FMRS(1,3,I,38),I=1,49)/
53664 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53665 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53666 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53667 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53668 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53669 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53670 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53671 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53672 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
53673 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53674 DATA (FMRS(1,4,I, 1),I=1,49)/
53675 & 0.86800D0, 0.76598D0, 0.67520D0, 0.62675D0, 0.59428D0,
53676 & 0.57013D0, 0.50046D0, 0.43816D0, 0.40484D0, 0.38253D0,
53677 & 0.36613D0, 0.31874D0, 0.27654D0, 0.25397D0, 0.23882D0,
53678 & 0.22750D0, 0.21099D0, 0.19387D0, 0.17401D0, 0.15872D0,
53679 & 0.13363D0, 0.11222D0, 0.09356D0, 0.07392D0, 0.05824D0,
53680 & 0.04613D0, 0.03700D0, 0.03017D0, 0.02498D0, 0.02125D0,
53681 & 0.01786D0, 0.01513D0, 0.01268D0, 0.01040D0, 0.00852D0,
53682 & 0.00674D0, 0.00520D0, 0.00388D0, 0.00299D0, 0.00201D0,
53683 & 0.00134D0, 0.00094D0, 0.00051D0, 0.00021D0, 0.00007D0,
53684 & 0.00003D0, -0.00001D0, 0.00000D0, 0.00000D0/
53685 DATA (FMRS(1,4,I, 2),I=1,49)/
53686 & 0.88205D0, 0.77983D0, 0.68869D0, 0.63997D0, 0.60729D0,
53687 & 0.58296D0, 0.51264D0, 0.44961D0, 0.41580D0, 0.39312D0,
53688 & 0.37640D0, 0.32792D0, 0.28442D0, 0.26097D0, 0.24515D0,
53689 & 0.23328D0, 0.21590D0, 0.19782D0, 0.17683D0, 0.16077D0,
53690 & 0.13467D0, 0.11273D0, 0.09381D0, 0.07406D0, 0.05839D0,
53691 & 0.04632D0, 0.03722D0, 0.03037D0, 0.02516D0, 0.02135D0,
53692 & 0.01792D0, 0.01513D0, 0.01262D0, 0.01032D0, 0.00842D0,
53693 & 0.00664D0, 0.00510D0, 0.00380D0, 0.00291D0, 0.00197D0,
53694 & 0.00130D0, 0.00091D0, 0.00051D0, 0.00020D0, 0.00007D0,
53695 & 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0/
53696 DATA (FMRS(1,4,I, 3),I=1,49)/
53697 & 0.91886D0, 0.81356D0, 0.71953D0, 0.66920D0, 0.63541D0,
53698 & 0.61023D0, 0.53738D0, 0.47189D0, 0.43666D0, 0.41295D0,
53699 & 0.39539D0, 0.34428D0, 0.29794D0, 0.27277D0, 0.25567D0,
53700 & 0.24279D0, 0.22388D0, 0.20416D0, 0.18131D0, 0.16398D0,
53701 & 0.13630D0, 0.11352D0, 0.09418D0, 0.07425D0, 0.05857D0,
53702 & 0.04653D0, 0.03744D0, 0.03056D0, 0.02532D0, 0.02139D0,
53703 & 0.01791D0, 0.01504D0, 0.01246D0, 0.01016D0, 0.00822D0,
53704 & 0.00648D0, 0.00493D0, 0.00368D0, 0.00278D0, 0.00188D0,
53705 & 0.00124D0, 0.00086D0, 0.00051D0, 0.00020D0, 0.00006D0,
53706 & 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0/
53707 DATA (FMRS(1,4,I, 4),I=1,49)/
53708 & 0.95997D0, 0.84981D0, 0.75147D0, 0.69884D0, 0.66351D0,
53709 & 0.63718D0, 0.56100D0, 0.49247D0, 0.45556D0, 0.43069D0,
53710 & 0.41221D0, 0.35830D0, 0.30918D0, 0.28239D0, 0.26415D0,
53711 & 0.25039D0, 0.23017D0, 0.20908D0, 0.18474D0, 0.16642D0,
53712 & 0.13752D0, 0.11409D0, 0.09444D0, 0.07437D0, 0.05864D0,
53713 & 0.04662D0, 0.03752D0, 0.03063D0, 0.02535D0, 0.02135D0,
53714 & 0.01783D0, 0.01492D0, 0.01232D0, 0.01000D0, 0.00803D0,
53715 & 0.00631D0, 0.00479D0, 0.00358D0, 0.00268D0, 0.00180D0,
53716 & 0.00120D0, 0.00084D0, 0.00049D0, 0.00020D0, 0.00006D0,
53717 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
53718 DATA (FMRS(1,4,I, 5),I=1,49)/
53719 & 1.02269D0, 0.90363D0, 0.79759D0, 0.74093D0, 0.70294D0,
53720 & 0.67465D0, 0.59289D0, 0.51944D0, 0.47990D0, 0.45324D0,
53721 & 0.43337D0, 0.37541D0, 0.32249D0, 0.29359D0, 0.27391D0,
53722 & 0.25907D0, 0.23726D0, 0.21456D0, 0.18851D0, 0.16906D0,
53723 & 0.13883D0, 0.11469D0, 0.09468D0, 0.07442D0, 0.05863D0,
53724 & 0.04662D0, 0.03753D0, 0.03061D0, 0.02531D0, 0.02124D0,
53725 & 0.01767D0, 0.01472D0, 0.01211D0, 0.00977D0, 0.00782D0,
53726 & 0.00614D0, 0.00464D0, 0.00341D0, 0.00257D0, 0.00173D0,
53727 & 0.00113D0, 0.00080D0, 0.00046D0, 0.00018D0, 0.00005D0,
53728 & 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0/
53729 DATA (FMRS(1,4,I, 6),I=1,49)/
53730 & 1.08763D0, 0.95875D0, 0.84428D0, 0.78326D0, 0.74239D0,
53731 & 0.71199D0, 0.62427D0, 0.54563D0, 0.50333D0, 0.47482D0,
53732 & 0.45353D0, 0.39146D0, 0.33478D0, 0.30385D0, 0.28279D0,
53733 & 0.26692D0, 0.24362D0, 0.21944D0, 0.19183D0, 0.17138D0,
53734 & 0.13995D0, 0.11519D0, 0.09486D0, 0.07444D0, 0.05860D0,
53735 & 0.04659D0, 0.03750D0, 0.03056D0, 0.02523D0, 0.02111D0,
53736 & 0.01751D0, 0.01454D0, 0.01191D0, 0.00957D0, 0.00764D0,
53737 & 0.00598D0, 0.00450D0, 0.00328D0, 0.00247D0, 0.00167D0,
53738 & 0.00107D0, 0.00076D0, 0.00044D0, 0.00016D0, 0.00005D0,
53739 & 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0/
53740 DATA (FMRS(1,4,I, 7),I=1,49)/
53741 & 1.16556D0, 1.02401D0, 0.89875D0, 0.83219D0, 0.78769D0,
53742 & 0.75465D0, 0.65951D0, 0.57450D0, 0.52889D0, 0.49818D0,
53743 & 0.47520D0, 0.40838D0, 0.34748D0, 0.31432D0, 0.29177D0,
53744 & 0.27481D0, 0.24995D0, 0.22424D0, 0.19505D0, 0.17361D0,
53745 & 0.14101D0, 0.11563D0, 0.09500D0, 0.07441D0, 0.05852D0,
53746 & 0.04652D0, 0.03740D0, 0.03045D0, 0.02509D0, 0.02093D0,
53747 & 0.01733D0, 0.01434D0, 0.01170D0, 0.00939D0, 0.00744D0,
53748 & 0.00582D0, 0.00436D0, 0.00318D0, 0.00238D0, 0.00161D0,
53749 & 0.00104D0, 0.00073D0, 0.00042D0, 0.00014D0, 0.00005D0,
53750 & 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0/
53751 DATA (FMRS(1,4,I, 8),I=1,49)/
53752 & 1.26306D0, 1.10484D0, 0.96554D0, 0.89180D0, 0.84263D0,
53753 & 0.80618D0, 0.70157D0, 0.60853D0, 0.55877D0, 0.52532D0,
53754 & 0.50028D0, 0.42768D0, 0.36175D0, 0.32597D0, 0.30171D0,
53755 & 0.28349D0, 0.25687D0, 0.22944D0, 0.19851D0, 0.17597D0,
53756 & 0.14210D0, 0.11607D0, 0.09509D0, 0.07433D0, 0.05839D0,
53757 & 0.04638D0, 0.03725D0, 0.03028D0, 0.02490D0, 0.02071D0,
53758 & 0.01710D0, 0.01411D0, 0.01147D0, 0.00917D0, 0.00724D0,
53759 & 0.00565D0, 0.00421D0, 0.00306D0, 0.00228D0, 0.00155D0,
53760 & 0.00101D0, 0.00070D0, 0.00040D0, 0.00013D0, 0.00005D0,
53761 & 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0/
53762 DATA (FMRS(1,4,I, 9),I=1,49)/
53763 & 1.36120D0, 1.18550D0, 1.03156D0, 0.95040D0, 0.89642D0,
53764 & 0.85647D0, 0.74219D0, 0.64102D0, 0.58710D0, 0.55092D0,
53765 & 0.52385D0, 0.44558D0, 0.37481D0, 0.33656D0, 0.31068D0,
53766 & 0.29130D0, 0.26304D0, 0.23405D0, 0.20153D0, 0.17803D0,
53767 & 0.14303D0, 0.11643D0, 0.09515D0, 0.07423D0, 0.05825D0,
53768 & 0.04622D0, 0.03709D0, 0.03010D0, 0.02471D0, 0.02052D0,
53769 & 0.01688D0, 0.01389D0, 0.01125D0, 0.00895D0, 0.00706D0,
53770 & 0.00550D0, 0.00409D0, 0.00295D0, 0.00220D0, 0.00150D0,
53771 & 0.00098D0, 0.00067D0, 0.00039D0, 0.00013D0, 0.00005D0,
53772 & 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0/
53773 DATA (FMRS(1,4,I,10),I=1,49)/
53774 & 1.47041D0, 1.27446D0, 1.10370D0, 1.01406D0, 0.95460D0,
53775 & 0.91068D0, 0.78549D0, 0.67526D0, 0.61674D0, 0.57757D0,
53776 & 0.54827D0, 0.46388D0, 0.38797D0, 0.34713D0, 0.31960D0,
53777 & 0.29901D0, 0.26910D0, 0.23853D0, 0.20444D0, 0.17998D0,
53778 & 0.14388D0, 0.11673D0, 0.09517D0, 0.07410D0, 0.05807D0,
53779 & 0.04602D0, 0.03690D0, 0.02989D0, 0.02450D0, 0.02029D0,
53780 & 0.01665D0, 0.01365D0, 0.01102D0, 0.00875D0, 0.00689D0,
53781 & 0.00534D0, 0.00396D0, 0.00285D0, 0.00213D0, 0.00144D0,
53782 & 0.00094D0, 0.00064D0, 0.00038D0, 0.00013D0, 0.00004D0,
53783 & 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0/
53784 DATA (FMRS(1,4,I,11),I=1,49)/
53785 & 1.56638D0, 1.35212D0, 1.16625D0, 1.06903D0, 1.00469D0,
53786 & 0.95725D0, 0.82240D0, 0.70420D0, 0.64167D0, 0.59990D0,
53787 & 0.56868D0, 0.47904D0, 0.39878D0, 0.35576D0, 0.32683D0,
53788 & 0.30525D0, 0.27397D0, 0.24210D0, 0.20674D0, 0.18151D0,
53789 & 0.14453D0, 0.11694D0, 0.09517D0, 0.07398D0, 0.05791D0,
53790 & 0.04585D0, 0.03673D0, 0.02971D0, 0.02433D0, 0.02010D0,
53791 & 0.01646D0, 0.01346D0, 0.01083D0, 0.00860D0, 0.00675D0,
53792 & 0.00520D0, 0.00385D0, 0.00277D0, 0.00207D0, 0.00139D0,
53793 & 0.00090D0, 0.00062D0, 0.00037D0, 0.00013D0, 0.00004D0,
53794 & 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0/
53795 DATA (FMRS(1,4,I,12),I=1,49)/
53796 & 1.80214D0, 1.54109D0, 1.31694D0, 1.20067D0, 1.12412D0,
53797 & 1.06789D0, 0.90916D0, 0.77146D0, 0.69919D0, 0.65116D0,
53798 & 0.61534D0, 0.51323D0, 0.42280D0, 0.37478D0, 0.34269D0,
53799 & 0.31886D0, 0.28449D0, 0.24976D0, 0.21162D0, 0.18471D0,
53800 & 0.14585D0, 0.11732D0, 0.09509D0, 0.07364D0, 0.05748D0,
53801 & 0.04542D0, 0.03629D0, 0.02928D0, 0.02389D0, 0.01964D0,
53802 & 0.01603D0, 0.01303D0, 0.01043D0, 0.00824D0, 0.00644D0,
53803 & 0.00493D0, 0.00365D0, 0.00261D0, 0.00193D0, 0.00129D0,
53804 & 0.00082D0, 0.00058D0, 0.00033D0, 0.00012D0, 0.00003D0,
53805 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
53806 DATA (FMRS(1,4,I,13),I=1,49)/
53807 & 2.04055D0, 1.73004D0, 1.46588D0, 1.32988D0, 1.24076D0,
53808 & 1.17553D0, 0.99250D0, 0.83521D0, 0.75328D0, 0.69907D0,
53809 & 0.65875D0, 0.54456D0, 0.44445D0, 0.39176D0, 0.35673D0,
53810 & 0.33084D0, 0.29368D0, 0.25636D0, 0.21574D0, 0.18736D0,
53811 & 0.14688D0, 0.11755D0, 0.09493D0, 0.07328D0, 0.05705D0,
53812 & 0.04498D0, 0.03587D0, 0.02887D0, 0.02347D0, 0.01921D0,
53813 & 0.01564D0, 0.01265D0, 0.01010D0, 0.00793D0, 0.00617D0,
53814 & 0.00472D0, 0.00348D0, 0.00248D0, 0.00181D0, 0.00123D0,
53815 & 0.00077D0, 0.00054D0, 0.00031D0, 0.00011D0, 0.00003D0,
53816 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
53817 DATA (FMRS(1,4,I,14),I=1,49)/
53818 & 2.34878D0, 1.97162D0, 1.65417D0, 1.49212D0, 1.38650D0,
53819 & 1.30951D0, 1.09500D0, 0.91263D0, 0.81846D0, 0.75649D0,
53820 & 0.71054D0, 0.58140D0, 0.46952D0, 0.41122D0, 0.37271D0,
53821 & 0.34438D0, 0.30396D0, 0.26367D0, 0.22023D0, 0.19019D0,
53822 & 0.14790D0, 0.11770D0, 0.09464D0, 0.07279D0, 0.05650D0,
53823 & 0.04444D0, 0.03534D0, 0.02838D0, 0.02299D0, 0.01873D0,
53824 & 0.01518D0, 0.01221D0, 0.00971D0, 0.00758D0, 0.00587D0,
53825 & 0.00448D0, 0.00329D0, 0.00233D0, 0.00171D0, 0.00117D0,
53826 & 0.00073D0, 0.00051D0, 0.00028D0, 0.00010D0, 0.00003D0,
53827 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
53828 DATA (FMRS(1,4,I,15),I=1,49)/
53829 & 2.72076D0, 2.25974D0, 1.87603D0, 1.68193D0, 1.55614D0,
53830 & 1.46482D0, 1.21228D0, 1.00004D0, 0.89145D0, 0.82040D0,
53831 & 0.76790D0, 0.62156D0, 0.49638D0, 0.43184D0, 0.38951D0,
53832 & 0.35852D0, 0.31456D0, 0.27109D0, 0.22467D0, 0.19292D0,
53833 & 0.14878D0, 0.11770D0, 0.09423D0, 0.07216D0, 0.05583D0,
53834 & 0.04380D0, 0.03471D0, 0.02777D0, 0.02242D0, 0.01821D0,
53835 & 0.01468D0, 0.01176D0, 0.00931D0, 0.00721D0, 0.00560D0,
53836 & 0.00425D0, 0.00310D0, 0.00215D0, 0.00160D0, 0.00107D0,
53837 & 0.00067D0, 0.00046D0, 0.00026D0, 0.00009D0, 0.00003D0,
53838 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
53839 DATA (FMRS(1,4,I,16),I=1,49)/
53840 & 3.10372D0, 2.55317D0, 2.09952D0, 1.87189D0, 1.72513D0,
53841 & 1.61899D0, 1.32738D0, 1.08482D0, 0.96174D0, 0.88163D0,
53842 & 0.82262D0, 0.65935D0, 0.52128D0, 0.45078D0, 0.40481D0,
53843 & 0.37132D0, 0.32407D0, 0.27766D0, 0.22852D0, 0.19522D0,
53844 & 0.14943D0, 0.11759D0, 0.09376D0, 0.07153D0, 0.05518D0,
53845 & 0.04316D0, 0.03411D0, 0.02721D0, 0.02189D0, 0.01771D0,
53846 & 0.01421D0, 0.01135D0, 0.00894D0, 0.00691D0, 0.00532D0,
53847 & 0.00403D0, 0.00292D0, 0.00202D0, 0.00150D0, 0.00098D0,
53848 & 0.00063D0, 0.00043D0, 0.00024D0, 0.00009D0, 0.00003D0,
53849 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
53850 DATA (FMRS(1,4,I,17),I=1,49)/
53851 & 3.53791D0, 2.88253D0, 2.34786D0, 2.08172D0, 1.91099D0,
53852 & 1.78798D0, 1.45224D0, 1.17581D0, 1.03669D0, 0.94660D0,
53853 & 0.88048D0, 0.69881D0, 0.54694D0, 0.47011D0, 0.42034D0,
53854 & 0.38424D0, 0.33357D0, 0.28414D0, 0.23224D0, 0.19739D0,
53855 & 0.14997D0, 0.11738D0, 0.09322D0, 0.07083D0, 0.05448D0,
53856 & 0.04248D0, 0.03349D0, 0.02663D0, 0.02135D0, 0.01720D0,
53857 & 0.01373D0, 0.01094D0, 0.00857D0, 0.00662D0, 0.00504D0,
53858 & 0.00382D0, 0.00275D0, 0.00191D0, 0.00140D0, 0.00091D0,
53859 & 0.00060D0, 0.00040D0, 0.00021D0, 0.00008D0, 0.00002D0,
53860 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
53861 DATA (FMRS(1,4,I,18),I=1,49)/
53862 & 3.93600D0, 3.18179D0, 2.57144D0, 2.26962D0, 2.07679D0,
53863 & 1.93828D0, 1.56224D0, 1.25519D0, 1.10169D0, 1.00271D0,
53864 & 0.93026D0, 0.73238D0, 0.56848D0, 0.48622D0, 0.43319D0,
53865 & 0.39487D0, 0.34131D0, 0.28936D0, 0.23517D0, 0.19905D0,
53866 & 0.15030D0, 0.11713D0, 0.09270D0, 0.07021D0, 0.05385D0,
53867 & 0.04190D0, 0.03295D0, 0.02612D0, 0.02087D0, 0.01677D0,
53868 & 0.01334D0, 0.01060D0, 0.00827D0, 0.00637D0, 0.00486D0,
53869 & 0.00366D0, 0.00263D0, 0.00181D0, 0.00134D0, 0.00088D0,
53870 & 0.00056D0, 0.00038D0, 0.00020D0, 0.00007D0, 0.00002D0,
53871 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
53872 DATA (FMRS(1,4,I,19),I=1,49)/
53873 & 4.46512D0, 3.57604D0, 2.86339D0, 2.51369D0, 2.29136D0,
53874 & 2.13222D0, 1.70289D0, 1.35573D0, 1.18356D0, 1.07308D0,
53875 & 0.99248D0, 0.77387D0, 0.59477D0, 0.50571D0, 0.44864D0,
53876 & 0.40759D0, 0.35048D0, 0.29545D0, 0.23852D0, 0.20087D0,
53877 & 0.15057D0, 0.11671D0, 0.09200D0, 0.06939D0, 0.05304D0,
53878 & 0.04116D0, 0.03225D0, 0.02548D0, 0.02030D0, 0.01627D0,
53879 & 0.01289D0, 0.01018D0, 0.00793D0, 0.00608D0, 0.00462D0,
53880 & 0.00346D0, 0.00247D0, 0.00170D0, 0.00124D0, 0.00082D0,
53881 & 0.00052D0, 0.00036D0, 0.00020D0, 0.00007D0, 0.00002D0,
53882 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
53883 DATA (FMRS(1,4,I,20),I=1,49)/
53884 & 4.98110D0, 3.95717D0, 3.14315D0, 2.74636D0, 2.49515D0,
53885 & 2.31589D0, 1.83490D0, 1.44924D0, 1.25928D0, 1.13790D0,
53886 & 1.04961D0, 0.81156D0, 0.61839D0, 0.52309D0, 0.46234D0,
53887 & 0.41880D0, 0.35851D0, 0.30072D0, 0.24136D0, 0.20237D0,
53888 & 0.15073D0, 0.11629D0, 0.09134D0, 0.06865D0, 0.05232D0,
53889 & 0.04048D0, 0.03163D0, 0.02492D0, 0.01980D0, 0.01582D0,
53890 & 0.01251D0, 0.00983D0, 0.00765D0, 0.00583D0, 0.00441D0,
53891 & 0.00330D0, 0.00234D0, 0.00161D0, 0.00116D0, 0.00076D0,
53892 & 0.00049D0, 0.00034D0, 0.00019D0, 0.00006D0, 0.00002D0,
53893 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
53894 DATA (FMRS(1,4,I,21),I=1,49)/
53895 & 5.48855D0, 4.32906D0, 3.41400D0, 2.97058D0, 2.69088D0,
53896 & 2.49185D0, 1.96033D0, 1.53734D0, 1.33025D0, 1.19843D0,
53897 & 1.10279D0, 0.84628D0, 0.63987D0, 0.53877D0, 0.47461D0,
53898 & 0.42879D0, 0.36557D0, 0.30530D0, 0.24373D0, 0.20356D0,
53899 & 0.15074D0, 0.11580D0, 0.09065D0, 0.06792D0, 0.05161D0,
53900 & 0.03984D0, 0.03104D0, 0.02440D0, 0.01932D0, 0.01538D0,
53901 & 0.01214D0, 0.00950D0, 0.00738D0, 0.00561D0, 0.00423D0,
53902 & 0.00315D0, 0.00224D0, 0.00152D0, 0.00110D0, 0.00072D0,
53903 & 0.00045D0, 0.00032D0, 0.00018D0, 0.00006D0, 0.00002D0,
53904 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53905 DATA (FMRS(1,4,I,22),I=1,49)/
53906 & 6.18910D0, 4.83835D0, 3.78189D0, 3.27368D0, 2.95458D0,
53907 & 2.72828D0, 2.12748D0, 1.65375D0, 1.42355D0, 1.27771D0,
53908 & 1.17223D0, 0.89116D0, 0.66734D0, 0.55867D0, 0.49010D0,
53909 & 0.44134D0, 0.37438D0, 0.31092D0, 0.24658D0, 0.20493D0,
53910 & 0.15066D0, 0.11512D0, 0.08974D0, 0.06696D0, 0.05069D0,
53911 & 0.03901D0, 0.03030D0, 0.02374D0, 0.01874D0, 0.01485D0,
53912 & 0.01168D0, 0.00911D0, 0.00704D0, 0.00533D0, 0.00400D0,
53913 & 0.00297D0, 0.00211D0, 0.00142D0, 0.00104D0, 0.00068D0,
53914 & 0.00042D0, 0.00029D0, 0.00017D0, 0.00005D0, 0.00002D0,
53915 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
53916 DATA (FMRS(1,4,I,23),I=1,49)/
53917 & 6.90776D0, 5.35634D0, 4.15288D0, 3.57780D0, 3.21822D0,
53918 & 2.96398D0, 2.29266D0, 1.76775D0, 1.51442D0, 1.35462D0,
53919 & 1.23937D0, 0.93411D0, 0.69332D0, 0.57734D0, 0.50454D0,
53920 & 0.45297D0, 0.38246D0, 0.31600D0, 0.24910D0, 0.20608D0,
53921 & 0.15048D0, 0.11442D0, 0.08886D0, 0.06603D0, 0.04982D0,
53922 & 0.03823D0, 0.02961D0, 0.02314D0, 0.01820D0, 0.01437D0,
53923 & 0.01125D0, 0.00875D0, 0.00671D0, 0.00507D0, 0.00380D0,
53924 & 0.00282D0, 0.00198D0, 0.00134D0, 0.00099D0, 0.00065D0,
53925 & 0.00039D0, 0.00026D0, 0.00015D0, 0.00005D0, 0.00002D0,
53926 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
53927 DATA (FMRS(1,4,I,24),I=1,49)/
53928 & 7.62426D0, 5.86871D0, 4.51692D0, 3.87481D0, 3.47482D0,
53929 & 3.19280D0, 2.45168D0, 1.87657D0, 1.60070D0, 1.42736D0,
53930 & 1.30266D0, 0.97414D0, 0.71722D0, 0.59437D0, 0.51760D0,
53931 & 0.46341D0, 0.38962D0, 0.32042D0, 0.25117D0, 0.20694D0,
53932 & 0.15017D0, 0.11367D0, 0.08795D0, 0.06511D0, 0.04897D0,
53933 & 0.03748D0, 0.02894D0, 0.02253D0, 0.01769D0, 0.01392D0,
53934 & 0.01087D0, 0.00842D0, 0.00645D0, 0.00484D0, 0.00362D0,
53935 & 0.00267D0, 0.00187D0, 0.00128D0, 0.00093D0, 0.00060D0,
53936 & 0.00037D0, 0.00024D0, 0.00014D0, 0.00004D0, 0.00002D0,
53937 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53938 DATA (FMRS(1,4,I,25),I=1,49)/
53939 & 8.39819D0, 6.41814D0, 4.90446D0, 4.18965D0, 3.74601D0,
53940 & 3.43405D0, 2.61811D0, 1.98959D0, 1.68991D0, 1.50231D0,
53941 & 1.36770D0, 1.01493D0, 0.74134D0, 0.61144D0, 0.53063D0,
53942 & 0.47380D0, 0.39668D0, 0.32474D0, 0.25316D0, 0.20772D0,
53943 & 0.14981D0, 0.11289D0, 0.08703D0, 0.06420D0, 0.04813D0,
53944 & 0.03673D0, 0.02828D0, 0.02194D0, 0.01719D0, 0.01349D0,
53945 & 0.01049D0, 0.00810D0, 0.00620D0, 0.00463D0, 0.00344D0,
53946 & 0.00252D0, 0.00177D0, 0.00122D0, 0.00086D0, 0.00056D0,
53947 & 0.00034D0, 0.00023D0, 0.00012D0, 0.00004D0, 0.00001D0,
53948 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53949 DATA (FMRS(1,4,I,26),I=1,49)/
53950 & 9.19912D0, 6.98269D0, 5.29980D0, 4.50945D0, 4.02062D0,
53951 & 3.67776D0, 2.78497D0, 2.10203D0, 1.77824D0, 1.57626D0,
53952 & 1.43169D0, 1.05466D0, 0.76454D0, 0.62772D0, 0.54298D0,
53953 & 0.48357D0, 0.40325D0, 0.32867D0, 0.25488D0, 0.20830D0,
53954 & 0.14936D0, 0.11205D0, 0.08608D0, 0.06328D0, 0.04729D0,
53955 & 0.03598D0, 0.02762D0, 0.02140D0, 0.01669D0, 0.01307D0,
53956 & 0.01014D0, 0.00780D0, 0.00595D0, 0.00443D0, 0.00330D0,
53957 & 0.00240D0, 0.00168D0, 0.00114D0, 0.00081D0, 0.00053D0,
53958 & 0.00032D0, 0.00022D0, 0.00012D0, 0.00004D0, 0.00001D0,
53959 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53960 DATA (FMRS(1,4,I,27),I=1,49)/
53961 & 10.00621D0, 7.54783D0, 5.69293D0, 4.82623D0, 4.29189D0,
53962 & 3.91798D0, 2.94832D0, 2.21133D0, 1.86373D0, 1.64761D0,
53963 & 1.49327D0, 1.09257D0, 0.78647D0, 0.64301D0, 0.55451D0,
53964 & 0.49265D0, 0.40930D0, 0.33223D0, 0.25638D0, 0.20876D0,
53965 & 0.14886D0, 0.11122D0, 0.08517D0, 0.06240D0, 0.04650D0,
53966 & 0.03528D0, 0.02702D0, 0.02089D0, 0.01623D0, 0.01267D0,
53967 & 0.00980D0, 0.00752D0, 0.00573D0, 0.00425D0, 0.00316D0,
53968 & 0.00230D0, 0.00159D0, 0.00107D0, 0.00077D0, 0.00050D0,
53969 & 0.00030D0, 0.00020D0, 0.00011D0, 0.00003D0, 0.00001D0,
53970 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53971 DATA (FMRS(1,4,I,28),I=1,49)/
53972 & 10.80590D0, 8.10435D0, 6.07766D0, 5.13510D0, 4.55568D0,
53973 & 4.15111D0, 3.10583D0, 2.31601D0, 1.94527D0, 1.71546D0,
53974 & 1.55167D0, 1.12822D0, 0.80689D0, 0.65715D0, 0.56511D0,
53975 & 0.50095D0, 0.41476D0, 0.33539D0, 0.25764D0, 0.20907D0,
53976 & 0.14833D0, 0.11039D0, 0.08428D0, 0.06155D0, 0.04576D0,
53977 & 0.03462D0, 0.02647D0, 0.02040D0, 0.01582D0, 0.01230D0,
53978 & 0.00949D0, 0.00726D0, 0.00551D0, 0.00409D0, 0.00302D0,
53979 & 0.00221D0, 0.00152D0, 0.00102D0, 0.00073D0, 0.00048D0,
53980 & 0.00029D0, 0.00019D0, 0.00010D0, 0.00004D0, 0.00001D0,
53981 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53982 DATA (FMRS(1,4,I,29),I=1,49)/
53983 & 11.65207D0, 8.68978D0, 6.48001D0, 5.45700D0, 4.82993D0,
53984 & 4.39300D0, 3.26826D0, 2.42329D0, 2.02852D0, 1.78454D0,
53985 & 1.61099D0, 1.16415D0, 0.82729D0, 0.67117D0, 0.57557D0,
53986 & 0.50910D0, 0.42008D0, 0.33842D0, 0.25880D0, 0.20930D0,
53987 & 0.14773D0, 0.10953D0, 0.08337D0, 0.06069D0, 0.04500D0,
53988 & 0.03397D0, 0.02591D0, 0.01991D0, 0.01541D0, 0.01194D0,
53989 & 0.00919D0, 0.00702D0, 0.00530D0, 0.00393D0, 0.00290D0,
53990 & 0.00211D0, 0.00145D0, 0.00096D0, 0.00070D0, 0.00045D0,
53991 & 0.00028D0, 0.00018D0, 0.00010D0, 0.00003D0, 0.00001D0,
53992 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
53993 DATA (FMRS(1,4,I,30),I=1,49)/
53994 & 12.52131D0, 9.28774D0, 6.88859D0, 5.78276D0, 5.10678D0,
53995 & 4.63673D0, 3.43094D0, 2.53005D0, 2.11104D0, 1.85281D0,
53996 & 1.66948D0, 1.19929D0, 0.84705D0, 0.68466D0, 0.58556D0,
53997 & 0.51685D0, 0.42507D0, 0.34121D0, 0.25979D0, 0.20942D0,
53998 & 0.14709D0, 0.10866D0, 0.08245D0, 0.05983D0, 0.04425D0,
53999 & 0.03334D0, 0.02536D0, 0.01943D0, 0.01501D0, 0.01160D0,
54000 & 0.00891D0, 0.00678D0, 0.00511D0, 0.00378D0, 0.00279D0,
54001 & 0.00202D0, 0.00138D0, 0.00091D0, 0.00067D0, 0.00043D0,
54002 & 0.00026D0, 0.00018D0, 0.00010D0, 0.00003D0, 0.00001D0,
54003 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54004 DATA (FMRS(1,4,I,31),I=1,49)/
54005 & 13.38978D0, 9.88200D0, 7.29246D0, 6.10376D0, 5.37897D0,
54006 & 4.87592D0, 3.58970D0, 2.63365D0, 2.19084D0, 1.91866D0,
54007 & 1.72578D0, 1.23288D0, 0.86578D0, 0.69738D0, 0.59494D0,
54008 & 0.52409D0, 0.42970D0, 0.34375D0, 0.26065D0, 0.20947D0,
54009 & 0.14644D0, 0.10781D0, 0.08158D0, 0.05902D0, 0.04354D0,
54010 & 0.03274D0, 0.02484D0, 0.01899D0, 0.01463D0, 0.01128D0,
54011 & 0.00865D0, 0.00657D0, 0.00493D0, 0.00364D0, 0.00268D0,
54012 & 0.00194D0, 0.00132D0, 0.00087D0, 0.00064D0, 0.00041D0,
54013 & 0.00025D0, 0.00017D0, 0.00009D0, 0.00003D0, 0.00001D0,
54014 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54015 DATA (FMRS(1,4,I,32),I=1,49)/
54016 & 14.23688D0, 10.45864D0, 7.68231D0, 6.41264D0, 5.64030D0,
54017 & 5.10517D0, 3.74102D0, 2.73180D0, 2.26617D0, 1.98065D0,
54018 & 1.77865D0, 1.26417D0, 0.88305D0, 0.70902D0, 0.60346D0,
54019 & 0.53062D0, 0.43382D0, 0.34595D0, 0.26134D0, 0.20941D0,
54020 & 0.14577D0, 0.10696D0, 0.08072D0, 0.05825D0, 0.04287D0,
54021 & 0.03215D0, 0.02436D0, 0.01857D0, 0.01428D0, 0.01098D0,
54022 & 0.00840D0, 0.00638D0, 0.00476D0, 0.00351D0, 0.00258D0,
54023 & 0.00187D0, 0.00127D0, 0.00083D0, 0.00061D0, 0.00039D0,
54024 & 0.00024D0, 0.00016D0, 0.00009D0, 0.00002D0, 0.00001D0,
54025 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54026 DATA (FMRS(1,4,I,33),I=1,49)/
54027 & 15.13941D0, 11.07021D0, 8.09390D0, 6.73786D0, 5.91493D0,
54028 & 5.34574D0, 3.89907D0, 2.83385D0, 2.34427D0, 2.04479D0,
54029 & 1.83327D0, 1.29634D0, 0.90070D0, 0.72088D0, 0.61213D0,
54030 & 0.53725D0, 0.43798D0, 0.34817D0, 0.26202D0, 0.20935D0,
54031 & 0.14510D0, 0.10612D0, 0.07988D0, 0.05749D0, 0.04221D0,
54032 & 0.03158D0, 0.02388D0, 0.01816D0, 0.01393D0, 0.01069D0,
54033 & 0.00816D0, 0.00620D0, 0.00459D0, 0.00338D0, 0.00248D0,
54034 & 0.00179D0, 0.00121D0, 0.00080D0, 0.00058D0, 0.00037D0,
54035 & 0.00022D0, 0.00014D0, 0.00008D0, 0.00002D0, 0.00001D0,
54036 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54037 DATA (FMRS(1,4,I,34),I=1,49)/
54038 & 16.04276D0, 11.67919D0, 8.50158D0, 7.05899D0, 6.18548D0,
54039 & 5.58230D0, 4.05359D0, 2.93300D0, 2.41985D0, 2.10667D0,
54040 & 1.88583D0, 1.32700D0, 0.91732D0, 0.73194D0, 0.62013D0,
54041 & 0.54331D0, 0.44171D0, 0.35007D0, 0.26248D0, 0.20913D0,
54042 & 0.14434D0, 0.10523D0, 0.07901D0, 0.05671D0, 0.04155D0,
54043 & 0.03102D0, 0.02340D0, 0.01777D0, 0.01360D0, 0.01042D0,
54044 & 0.00793D0, 0.00600D0, 0.00446D0, 0.00326D0, 0.00238D0,
54045 & 0.00173D0, 0.00118D0, 0.00076D0, 0.00055D0, 0.00036D0,
54046 & 0.00022D0, 0.00014D0, 0.00007D0, 0.00002D0, 0.00001D0,
54047 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54048 DATA (FMRS(1,4,I,35),I=1,49)/
54049 & 16.94849D0, 12.28721D0, 8.90688D0, 7.37746D0, 6.45332D0,
54050 & 5.81617D0, 4.20570D0, 3.03017D0, 2.49373D0, 2.16705D0,
54051 & 1.93704D0, 1.35674D0, 0.93336D0, 0.74257D0, 0.62781D0,
54052 & 0.54911D0, 0.44527D0, 0.35187D0, 0.26291D0, 0.20892D0,
54053 & 0.14363D0, 0.10440D0, 0.07819D0, 0.05599D0, 0.04092D0,
54054 & 0.03050D0, 0.02296D0, 0.01740D0, 0.01329D0, 0.01017D0,
54055 & 0.00772D0, 0.00583D0, 0.00433D0, 0.00315D0, 0.00229D0,
54056 & 0.00167D0, 0.00114D0, 0.00073D0, 0.00053D0, 0.00035D0,
54057 & 0.00021D0, 0.00013D0, 0.00007D0, 0.00002D0, 0.00001D0,
54058 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54059 DATA (FMRS(1,4,I,36),I=1,49)/
54060 & 17.83243D0, 12.87802D0, 9.29900D0, 7.68475D0, 6.71127D0,
54061 & 6.04107D0, 4.35129D0, 3.12272D0, 2.56388D0, 2.22424D0,
54062 & 1.98545D0, 1.38466D0, 0.94830D0, 0.75241D0, 0.63488D0,
54063 & 0.55441D0, 0.44848D0, 0.35346D0, 0.26323D0, 0.20867D0,
54064 & 0.14292D0, 0.10358D0, 0.07741D0, 0.05529D0, 0.04033D0,
54065 & 0.03000D0, 0.02255D0, 0.01705D0, 0.01300D0, 0.00993D0,
54066 & 0.00753D0, 0.00566D0, 0.00421D0, 0.00306D0, 0.00221D0,
54067 & 0.00161D0, 0.00110D0, 0.00071D0, 0.00051D0, 0.00034D0,
54068 & 0.00020D0, 0.00013D0, 0.00007D0, 0.00002D0, 0.00001D0,
54069 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54070 DATA (FMRS(1,4,I,37),I=1,49)/
54071 & 18.74867D0, 13.48785D0, 9.70200D0, 7.99976D0, 6.97522D0,
54072 & 6.27087D0, 4.49936D0, 3.21639D0, 2.63465D0, 2.28182D0,
54073 & 2.03408D0, 1.41252D0, 0.96307D0, 0.76207D0, 0.64176D0,
54074 & 0.55956D0, 0.45155D0, 0.35492D0, 0.26347D0, 0.20834D0,
54075 & 0.14216D0, 0.10274D0, 0.07660D0, 0.05459D0, 0.03974D0,
54076 & 0.02950D0, 0.02213D0, 0.01670D0, 0.01272D0, 0.00970D0,
54077 & 0.00733D0, 0.00550D0, 0.00408D0, 0.00297D0, 0.00214D0,
54078 & 0.00155D0, 0.00105D0, 0.00068D0, 0.00049D0, 0.00032D0,
54079 & 0.00018D0, 0.00012D0, 0.00007D0, 0.00002D0, 0.00001D0,
54080 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54081 DATA (FMRS(1,4,I,38),I=1,49)/
54082 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54083 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54084 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54085 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54086 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54087 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54088 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54089 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54090 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54091 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54092 DATA (FMRS(1,5,I, 1),I=1,49)/
54093 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54094 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54095 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54096 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54097 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54098 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54099 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54100 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54101 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54102 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54103 DATA (FMRS(1,5,I, 2),I=1,49)/
54104 & 0.00003D0, 0.00003D0, 0.00002D0, 0.00002D0, 0.00002D0,
54105 & 0.00002D0, 0.00002D0, 0.00002D0, 0.00002D0, 0.00002D0,
54106 & 0.00002D0, 0.00002D0, 0.00002D0, 0.00002D0, 0.00002D0,
54107 & 0.00002D0, 0.00002D0, 0.00001D0, 0.00001D0, 0.00001D0,
54108 & 0.00001D0, 0.00001D0, 0.00001D0, 0.00001D0, 0.00001D0,
54109 & 0.00001D0, 0.00001D0, 0.00001D0, 0.00001D0, 0.00001D0,
54110 & 0.00001D0, 0.00001D0, 0.00001D0, 0.00000D0, 0.00000D0,
54111 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54112 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54113 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54114 DATA (FMRS(1,5,I, 3),I=1,49)/
54115 & 0.03227D0, 0.02900D0, 0.02605D0, 0.02445D0, 0.02338D0,
54116 & 0.02257D0, 0.02019D0, 0.01798D0, 0.01674D0, 0.01586D0,
54117 & 0.01516D0, 0.01302D0, 0.01084D0, 0.00956D0, 0.00865D0,
54118 & 0.00795D0, 0.00692D0, 0.00587D0, 0.00477D0, 0.00405D0,
54119 & 0.00317D0, 0.00263D0, 0.00225D0, 0.00190D0, 0.00163D0,
54120 & 0.00139D0, 0.00119D0, 0.00101D0, 0.00085D0, 0.00072D0,
54121 & 0.00059D0, 0.00048D0, 0.00039D0, 0.00031D0, 0.00025D0,
54122 & 0.00019D0, 0.00015D0, 0.00011D0, 0.00008D0, 0.00006D0,
54123 & 0.00004D0, 0.00003D0, 0.00002D0, 0.00001D0, 0.00000D0,
54124 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54125 DATA (FMRS(1,5,I, 4),I=1,49)/
54126 & 0.08412D0, 0.07493D0, 0.06672D0, 0.06231D0, 0.05935D0,
54127 & 0.05713D0, 0.05068D0, 0.04474D0, 0.04144D0, 0.03913D0,
54128 & 0.03731D0, 0.03177D0, 0.02623D0, 0.02303D0, 0.02077D0,
54129 & 0.01905D0, 0.01652D0, 0.01397D0, 0.01129D0, 0.00957D0,
54130 & 0.00745D0, 0.00615D0, 0.00525D0, 0.00441D0, 0.00375D0,
54131 & 0.00320D0, 0.00272D0, 0.00230D0, 0.00193D0, 0.00161D0,
54132 & 0.00132D0, 0.00108D0, 0.00087D0, 0.00069D0, 0.00054D0,
54133 & 0.00042D0, 0.00032D0, 0.00024D0, 0.00018D0, 0.00013D0,
54134 & 0.00009D0, 0.00006D0, 0.00004D0, 0.00001D0, 0.00000D0,
54135 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54136 DATA (FMRS(1,5,I, 5),I=1,49)/
54137 & 0.14877D0, 0.13082D0, 0.11499D0, 0.10659D0, 0.10097D0,
54138 & 0.09680D0, 0.08477D0, 0.07388D0, 0.06791D0, 0.06379D0,
54139 & 0.06056D0, 0.05091D0, 0.04152D0, 0.03619D0, 0.03249D0,
54140 & 0.02969D0, 0.02561D0, 0.02153D0, 0.01729D0, 0.01459D0,
54141 & 0.01127D0, 0.00925D0, 0.00785D0, 0.00655D0, 0.00553D0,
54142 & 0.00469D0, 0.00396D0, 0.00333D0, 0.00278D0, 0.00231D0,
54143 & 0.00189D0, 0.00153D0, 0.00123D0, 0.00097D0, 0.00076D0,
54144 & 0.00059D0, 0.00045D0, 0.00034D0, 0.00025D0, 0.00018D0,
54145 & 0.00012D0, 0.00009D0, 0.00006D0, 0.00001D0, 0.00000D0,
54146 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54147 DATA (FMRS(1,5,I, 6),I=1,49)/
54148 & 0.22202D0, 0.19306D0, 0.16779D0, 0.15452D0, 0.14570D0,
54149 & 0.13918D0, 0.12051D0, 0.10386D0, 0.09484D0, 0.08868D0,
54150 & 0.08388D0, 0.06972D0, 0.05624D0, 0.04872D0, 0.04355D0,
54151 & 0.03966D0, 0.03405D0, 0.02848D0, 0.02274D0, 0.01911D0,
54152 & 0.01466D0, 0.01197D0, 0.01011D0, 0.00838D0, 0.00703D0,
54153 & 0.00592D0, 0.00498D0, 0.00416D0, 0.00346D0, 0.00286D0,
54154 & 0.00233D0, 0.00188D0, 0.00150D0, 0.00118D0, 0.00092D0,
54155 & 0.00071D0, 0.00054D0, 0.00041D0, 0.00030D0, 0.00021D0,
54156 & 0.00015D0, 0.00010D0, 0.00007D0, 0.00001D0, 0.00000D0,
54157 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54158 DATA (FMRS(1,5,I, 7),I=1,49)/
54159 & 0.30272D0, 0.26063D0, 0.22430D0, 0.20535D0, 0.19284D0,
54160 & 0.18362D0, 0.15743D0, 0.13433D0, 0.12195D0, 0.11355D0,
54161 & 0.10705D0, 0.08808D0, 0.07034D0, 0.06058D0, 0.05394D0,
54162 & 0.04898D0, 0.04185D0, 0.03485D0, 0.02767D0, 0.02316D0,
54163 & 0.01766D0, 0.01434D0, 0.01204D0, 0.00992D0, 0.00828D0,
54164 & 0.00693D0, 0.00580D0, 0.00482D0, 0.00399D0, 0.00328D0,
54165 & 0.00266D0, 0.00214D0, 0.00170D0, 0.00133D0, 0.00104D0,
54166 & 0.00080D0, 0.00060D0, 0.00045D0, 0.00033D0, 0.00024D0,
54167 & 0.00016D0, 0.00011D0, 0.00007D0, 0.00001D0, 0.00000D0,
54168 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54169 DATA (FMRS(1,5,I, 8),I=1,49)/
54170 & 0.40640D0, 0.34641D0, 0.29514D0, 0.26863D0, 0.25121D0,
54171 & 0.23843D0, 0.20237D0, 0.17095D0, 0.15427D0, 0.14303D0,
54172 & 0.13440D0, 0.10944D0, 0.08650D0, 0.07407D0, 0.06568D0,
54173 & 0.05945D0, 0.05056D0, 0.04189D0, 0.03309D0, 0.02757D0,
54174 & 0.02089D0, 0.01686D0, 0.01408D0, 0.01153D0, 0.00956D0,
54175 & 0.00796D0, 0.00662D0, 0.00548D0, 0.00451D0, 0.00369D0,
54176 & 0.00298D0, 0.00239D0, 0.00189D0, 0.00148D0, 0.00114D0,
54177 & 0.00087D0, 0.00066D0, 0.00049D0, 0.00037D0, 0.00026D0,
54178 & 0.00018D0, 0.00012D0, 0.00007D0, 0.00001D0, 0.00000D0,
54179 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54180 DATA (FMRS(1,5,I, 9),I=1,49)/
54181 & 0.51210D0, 0.43288D0, 0.36574D0, 0.33126D0, 0.30871D0,
54182 & 0.29222D0, 0.24594D0, 0.20601D0, 0.18499D0, 0.17091D0,
54183 & 0.16014D0, 0.12927D0, 0.10130D0, 0.08631D0, 0.07626D0,
54184 & 0.06885D0, 0.05833D0, 0.04813D0, 0.03783D0, 0.03141D0,
54185 & 0.02366D0, 0.01900D0, 0.01580D0, 0.01287D0, 0.01061D0,
54186 & 0.00880D0, 0.00728D0, 0.00600D0, 0.00491D0, 0.00401D0,
54187 & 0.00322D0, 0.00257D0, 0.00203D0, 0.00158D0, 0.00122D0,
54188 & 0.00093D0, 0.00070D0, 0.00052D0, 0.00039D0, 0.00028D0,
54189 & 0.00018D0, 0.00012D0, 0.00007D0, 0.00001D0, 0.00000D0,
54190 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54191 DATA (FMRS(1,5,I,10),I=1,49)/
54192 & 0.62615D0, 0.52524D0, 0.44038D0, 0.39709D0, 0.36888D0,
54193 & 0.34831D0, 0.29091D0, 0.24179D0, 0.21613D0, 0.19903D0,
54194 & 0.18601D0, 0.14895D0, 0.11579D0, 0.09820D0, 0.08649D0,
54195 & 0.07789D0, 0.06575D0, 0.05404D0, 0.04228D0, 0.03498D0,
54196 & 0.02621D0, 0.02095D0, 0.01734D0, 0.01405D0, 0.01153D0,
54197 & 0.00952D0, 0.00784D0, 0.00644D0, 0.00525D0, 0.00426D0,
54198 & 0.00342D0, 0.00272D0, 0.00213D0, 0.00166D0, 0.00127D0,
54199 & 0.00097D0, 0.00073D0, 0.00054D0, 0.00040D0, 0.00029D0,
54200 & 0.00019D0, 0.00013D0, 0.00007D0, 0.00001D0, 0.00000D0,
54201 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54202 DATA (FMRS(1,5,I,11),I=1,49)/
54203 & 0.72756D0, 0.60673D0, 0.50572D0, 0.45443D0, 0.42111D0,
54204 & 0.39687D0, 0.32951D0, 0.27226D0, 0.24251D0, 0.22276D0,
54205 & 0.20777D0, 0.16535D0, 0.12775D0, 0.10795D0, 0.09484D0,
54206 & 0.08524D0, 0.07175D0, 0.05879D0, 0.04583D0, 0.03782D0,
54207 & 0.02821D0, 0.02247D0, 0.01853D0, 0.01496D0, 0.01223D0,
54208 & 0.01005D0, 0.00826D0, 0.00676D0, 0.00549D0, 0.00445D0,
54209 & 0.00355D0, 0.00282D0, 0.00221D0, 0.00171D0, 0.00131D0,
54210 & 0.00099D0, 0.00074D0, 0.00055D0, 0.00041D0, 0.00029D0,
54211 & 0.00019D0, 0.00013D0, 0.00007D0, 0.00001D0, 0.00000D0,
54212 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54213 DATA (FMRS(1,5,I,12),I=1,49)/
54214 & 0.97596D0, 0.80419D0, 0.66232D0, 0.59100D0, 0.54494D0,
54215 & 0.51159D0, 0.41968D0, 0.34257D0, 0.30297D0, 0.27688D0,
54216 & 0.25720D0, 0.20210D0, 0.15417D0, 0.12932D0, 0.11303D0,
54217 & 0.10119D0, 0.08465D0, 0.06892D0, 0.05333D0, 0.04376D0,
54218 & 0.03235D0, 0.02557D0, 0.02094D0, 0.01675D0, 0.01359D0,
54219 & 0.01109D0, 0.00904D0, 0.00734D0, 0.00594D0, 0.00477D0,
54220 & 0.00379D0, 0.00299D0, 0.00233D0, 0.00179D0, 0.00137D0,
54221 & 0.00103D0, 0.00077D0, 0.00057D0, 0.00042D0, 0.00030D0,
54222 & 0.00019D0, 0.00013D0, 0.00007D0, 0.00001D0, 0.00000D0,
54223 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54224 DATA (FMRS(1,5,I,13),I=1,49)/
54225 & 1.22977D0, 1.00344D0, 0.81836D0, 0.72605D0, 0.66675D0,
54226 & 0.62396D0, 0.50684D0, 0.40963D0, 0.36016D0, 0.32776D0,
54227 & 0.30345D0, 0.23597D0, 0.17813D0, 0.14851D0, 0.12924D0,
54228 & 0.11531D0, 0.09599D0, 0.07773D0, 0.05977D0, 0.04882D0,
54229 & 0.03581D0, 0.02811D0, 0.02289D0, 0.01818D0, 0.01465D0,
54230 & 0.01187D0, 0.00963D0, 0.00777D0, 0.00625D0, 0.00500D0,
54231 & 0.00395D0, 0.00310D0, 0.00241D0, 0.00185D0, 0.00140D0,
54232 & 0.00105D0, 0.00078D0, 0.00058D0, 0.00043D0, 0.00031D0,
54233 & 0.00019D0, 0.00013D0, 0.00007D0, 0.00001D0, 0.00000D0,
54234 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54235 DATA (FMRS(1,5,I,14),I=1,49)/
54236 & 1.55816D0, 1.25825D0, 1.01555D0, 0.89552D0, 0.81883D0,
54237 & 0.76371D0, 0.61389D0, 0.49095D0, 0.42897D0, 0.38864D0,
54238 & 0.35854D0, 0.27572D0, 0.20581D0, 0.17047D0, 0.14766D0,
54239 & 0.13128D0, 0.10869D0, 0.08751D0, 0.06683D0, 0.05430D0,
54240 & 0.03950D0, 0.03078D0, 0.02489D0, 0.01962D0, 0.01569D0,
54241 & 0.01264D0, 0.01018D0, 0.00817D0, 0.00653D0, 0.00519D0,
54242 & 0.00408D0, 0.00319D0, 0.00246D0, 0.00188D0, 0.00142D0,
54243 & 0.00106D0, 0.00078D0, 0.00058D0, 0.00043D0, 0.00031D0,
54244 & 0.00019D0, 0.00012D0, 0.00007D0, 0.00001D0, 0.00000D0,
54245 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54246 DATA (FMRS(1,5,I,15),I=1,49)/
54247 & 1.94525D0, 1.55494D0, 1.24230D0, 1.08896D0, 0.99149D0,
54248 & 0.92172D0, 0.73335D0, 0.58046D0, 0.50409D0, 0.45471D0,
54249 & 0.41801D0, 0.31797D0, 0.23473D0, 0.19316D0, 0.16655D0,
54250 & 0.14754D0, 0.12149D0, 0.09725D0, 0.07376D0, 0.05961D0,
54251 & 0.04299D0, 0.03326D0, 0.02672D0, 0.02089D0, 0.01659D0,
54252 & 0.01327D0, 0.01061D0, 0.00847D0, 0.00673D0, 0.00532D0,
54253 & 0.00416D0, 0.00323D0, 0.00248D0, 0.00188D0, 0.00142D0,
54254 & 0.00105D0, 0.00077D0, 0.00057D0, 0.00042D0, 0.00031D0,
54255 & 0.00019D0, 0.00012D0, 0.00007D0, 0.00001D0, 0.00000D0,
54256 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54257 DATA (FMRS(1,5,I,16),I=1,49)/
54258 & 2.34531D0, 1.85826D0, 1.47159D0, 1.28330D0, 1.16416D0,
54259 & 1.07915D0, 0.85101D0, 0.66758D0, 0.57668D0, 0.51821D0,
54260 & 0.47495D0, 0.35786D0, 0.26164D0, 0.21408D0, 0.18385D0,
54261 & 0.16236D0, 0.13305D0, 0.10596D0, 0.07987D0, 0.06425D0,
54262 & 0.04599D0, 0.03535D0, 0.02822D0, 0.02192D0, 0.01729D0,
54263 & 0.01375D0, 0.01093D0, 0.00867D0, 0.00685D0, 0.00540D0,
54264 & 0.00420D0, 0.00325D0, 0.00248D0, 0.00188D0, 0.00141D0,
54265 & 0.00104D0, 0.00076D0, 0.00056D0, 0.00041D0, 0.00030D0,
54266 & 0.00018D0, 0.00011D0, 0.00006D0, 0.00001D0, 0.00000D0,
54267 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54268 DATA (FMRS(1,5,I,17),I=1,49)/
54269 & 2.80142D0, 2.20072D0, 1.72790D0, 1.49927D0, 1.35523D0,
54270 & 1.25280D0, 0.97945D0, 0.76167D0, 0.65458D0, 0.58603D0,
54271 & 0.53553D0, 0.39978D0, 0.28955D0, 0.23561D0, 0.20153D0,
54272 & 0.17743D0, 0.14473D0, 0.11467D0, 0.08591D0, 0.06880D0,
54273 & 0.04888D0, 0.03733D0, 0.02963D0, 0.02285D0, 0.01791D0,
54274 & 0.01415D0, 0.01119D0, 0.00883D0, 0.00694D0, 0.00544D0,
54275 & 0.00421D0, 0.00324D0, 0.00247D0, 0.00186D0, 0.00139D0,
54276 & 0.00102D0, 0.00075D0, 0.00055D0, 0.00040D0, 0.00029D0,
54277 & 0.00018D0, 0.00011D0, 0.00006D0, 0.00001D0, 0.00000D0,
54278 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54279 DATA (FMRS(1,5,I,18),I=1,49)/
54280 & 3.21652D0, 2.50960D0, 1.95700D0, 1.69126D0, 1.52443D0,
54281 & 1.40610D0, 1.09176D0, 0.84313D0, 0.72161D0, 0.64414D0,
54282 & 0.58724D0, 0.43516D0, 0.31280D0, 0.25339D0, 0.21606D0,
54283 & 0.18974D0, 0.15419D0, 0.12166D0, 0.09071D0, 0.07236D0,
54284 & 0.05109D0, 0.03882D0, 0.03067D0, 0.02352D0, 0.01834D0,
54285 & 0.01442D0, 0.01135D0, 0.00892D0, 0.00699D0, 0.00545D0,
54286 & 0.00421D0, 0.00322D0, 0.00245D0, 0.00184D0, 0.00137D0,
54287 & 0.00100D0, 0.00073D0, 0.00053D0, 0.00039D0, 0.00029D0,
54288 & 0.00017D0, 0.00010D0, 0.00006D0, 0.00001D0, 0.00000D0,
54289 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54290 DATA (FMRS(1,5,I,19),I=1,49)/
54291 & 3.76652D0, 2.91536D0, 2.25532D0, 1.93997D0, 1.74280D0,
54292 & 1.60338D0, 1.23496D0, 0.94601D0, 0.80577D0, 0.71678D0,
54293 & 0.65167D0, 0.47873D0, 0.34109D0, 0.27487D0, 0.23349D0,
54294 & 0.20445D0, 0.16541D0, 0.12988D0, 0.09628D0, 0.07646D0,
54295 & 0.05359D0, 0.04046D0, 0.03178D0, 0.02422D0, 0.01877D0,
54296 & 0.01467D0, 0.01149D0, 0.00898D0, 0.00700D0, 0.00543D0,
54297 & 0.00418D0, 0.00319D0, 0.00241D0, 0.00180D0, 0.00134D0,
54298 & 0.00098D0, 0.00071D0, 0.00052D0, 0.00038D0, 0.00028D0,
54299 & 0.00017D0, 0.00010D0, 0.00006D0, 0.00001D0, 0.00000D0,
54300 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54301 DATA (FMRS(1,5,I,20),I=1,49)/
54302 & 4.30575D0, 3.30993D0, 2.54302D0, 2.17866D0, 1.95165D0,
54303 & 1.79153D0, 1.37036D0, 1.04242D0, 0.88422D0, 0.78423D0,
54304 & 0.71130D0, 0.51866D0, 0.36673D0, 0.29419D0, 0.24910D0,
54305 & 0.21757D0, 0.17534D0, 0.13711D0, 0.10112D0, 0.07999D0,
54306 & 0.05571D0, 0.04184D0, 0.03270D0, 0.02477D0, 0.01909D0,
54307 & 0.01486D0, 0.01158D0, 0.00901D0, 0.00699D0, 0.00541D0,
54308 & 0.00414D0, 0.00315D0, 0.00237D0, 0.00177D0, 0.00131D0,
54309 & 0.00095D0, 0.00069D0, 0.00050D0, 0.00037D0, 0.00027D0,
54310 & 0.00016D0, 0.00009D0, 0.00005D0, 0.00001D0, 0.00000D0,
54311 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54312 DATA (FMRS(1,5,I,21),I=1,49)/
54313 & 4.82956D0, 3.69021D0, 2.81808D0, 2.40576D0, 2.14966D0,
54314 & 1.96944D0, 1.49728D0, 1.13198D0, 0.95669D0, 0.84628D0,
54315 & 0.76597D0, 0.55486D0, 0.38968D0, 0.31136D0, 0.26288D0,
54316 & 0.22909D0, 0.18399D0, 0.14333D0, 0.10523D0, 0.08295D0,
54317 & 0.05744D0, 0.04293D0, 0.03340D0, 0.02518D0, 0.01931D0,
54318 & 0.01496D0, 0.01161D0, 0.00900D0, 0.00696D0, 0.00536D0,
54319 & 0.00409D0, 0.00310D0, 0.00233D0, 0.00173D0, 0.00128D0,
54320 & 0.00093D0, 0.00067D0, 0.00049D0, 0.00036D0, 0.00027D0,
54321 & 0.00015D0, 0.00009D0, 0.00005D0, 0.00001D0, 0.00000D0,
54322 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54323 DATA (FMRS(1,5,I,22),I=1,49)/
54324 & 5.55546D0, 4.21326D0, 3.19353D0, 2.71436D0, 2.41786D0,
54325 & 2.20981D0, 1.66741D0, 1.25104D0, 1.05255D0, 0.92807D0,
54326 & 0.83783D0, 0.60198D0, 0.41926D0, 0.33333D0, 0.28043D0,
54327 & 0.24370D0, 0.19489D0, 0.15111D0, 0.11032D0, 0.08657D0,
54328 & 0.05953D0, 0.04421D0, 0.03422D0, 0.02563D0, 0.01955D0,
54329 & 0.01506D0, 0.01163D0, 0.00897D0, 0.00690D0, 0.00529D0,
54330 & 0.00403D0, 0.00304D0, 0.00227D0, 0.00168D0, 0.00124D0,
54331 & 0.00090D0, 0.00064D0, 0.00047D0, 0.00035D0, 0.00026D0,
54332 & 0.00015D0, 0.00008D0, 0.00005D0, 0.00001D0, 0.00000D0,
54333 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54334 DATA (FMRS(1,5,I,23),I=1,49)/
54335 & 6.30033D0, 4.74567D0, 3.57260D0, 3.02443D0, 2.68642D0,
54336 & 2.44984D0, 1.83585D0, 1.36787D0, 1.14612D0, 1.00758D0,
54337 & 0.90746D0, 0.64718D0, 0.44730D0, 0.35401D0, 0.29686D0,
54338 & 0.25731D0, 0.20497D0, 0.15824D0, 0.11492D0, 0.08982D0,
54339 & 0.06136D0, 0.04532D0, 0.03489D0, 0.02598D0, 0.01971D0,
54340 & 0.01511D0, 0.01161D0, 0.00892D0, 0.00683D0, 0.00522D0,
54341 & 0.00395D0, 0.00297D0, 0.00222D0, 0.00163D0, 0.00120D0,
54342 & 0.00087D0, 0.00062D0, 0.00045D0, 0.00034D0, 0.00025D0,
54343 & 0.00014D0, 0.00008D0, 0.00005D0, 0.00001D0, 0.00000D0,
54344 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54345 DATA (FMRS(1,5,I,24),I=1,49)/
54346 & 7.03684D0, 5.26796D0, 3.94145D0, 3.32468D0, 2.94556D0,
54347 & 2.68082D0, 1.99651D0, 1.47829D0, 1.23404D0, 1.08198D0,
54348 & 0.97239D0, 0.68884D0, 0.47281D0, 0.37266D0, 0.31157D0,
54349 & 0.26944D0, 0.21386D0, 0.16445D0, 0.11886D0, 0.09256D0,
54350 & 0.06285D0, 0.04618D0, 0.03539D0, 0.02621D0, 0.01979D0,
54351 & 0.01510D0, 0.01155D0, 0.00884D0, 0.00675D0, 0.00513D0,
54352 & 0.00387D0, 0.00290D0, 0.00216D0, 0.00159D0, 0.00116D0,
54353 & 0.00084D0, 0.00060D0, 0.00044D0, 0.00033D0, 0.00024D0,
54354 & 0.00014D0, 0.00007D0, 0.00004D0, 0.00001D0, 0.00000D0,
54355 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54356 DATA (FMRS(1,5,I,25),I=1,49)/
54357 & 7.83575D0, 5.83079D0, 4.33631D0, 3.64485D0, 3.22112D0,
54358 & 2.92590D0, 2.16582D0, 1.59383D0, 1.32566D0, 1.15927D0,
54359 & 1.03966D0, 0.73165D0, 0.49881D0, 0.39156D0, 0.32642D0,
54360 & 0.28163D0, 0.22275D0, 0.17063D0, 0.12274D0, 0.09523D0,
54361 & 0.06428D0, 0.04699D0, 0.03585D0, 0.02642D0, 0.01984D0,
54362 & 0.01507D0, 0.01148D0, 0.00875D0, 0.00665D0, 0.00505D0,
54363 & 0.00380D0, 0.00284D0, 0.00210D0, 0.00154D0, 0.00112D0,
54364 & 0.00081D0, 0.00058D0, 0.00042D0, 0.00031D0, 0.00024D0,
54365 & 0.00014D0, 0.00007D0, 0.00004D0, 0.00001D0, 0.00000D0,
54366 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54367 DATA (FMRS(1,5,I,26),I=1,49)/
54368 & 8.65815D0, 6.40607D0, 4.73699D0, 3.96832D0, 3.49865D0,
54369 & 3.17213D0, 2.33459D0, 1.70806D0, 1.41577D0, 1.23500D0,
54370 & 1.10538D0, 0.77305D0, 0.52365D0, 0.40947D0, 0.34040D0,
54371 & 0.29306D0, 0.23101D0, 0.17630D0, 0.12625D0, 0.09761D0,
54372 & 0.06550D0, 0.04766D0, 0.03620D0, 0.02654D0, 0.01984D0,
54373 & 0.01501D0, 0.01139D0, 0.00864D0, 0.00655D0, 0.00495D0,
54374 & 0.00371D0, 0.00276D0, 0.00204D0, 0.00149D0, 0.00108D0,
54375 & 0.00078D0, 0.00056D0, 0.00041D0, 0.00030D0, 0.00023D0,
54376 & 0.00014D0, 0.00007D0, 0.00004D0, 0.00001D0, 0.00000D0,
54377 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54378 DATA (FMRS(1,5,I,27),I=1,49)/
54379 & 9.48773D0, 6.98283D0, 5.13620D0, 4.28942D0, 3.77342D0,
54380 & 3.41540D0, 2.50025D0, 1.81942D0, 1.50325D0, 1.30829D0,
54381 & 1.16884D0, 0.81270D0, 0.54722D0, 0.42638D0, 0.35354D0,
54382 & 0.30375D0, 0.23869D0, 0.18153D0, 0.12945D0, 0.09975D0,
54383 & 0.06658D0, 0.04823D0, 0.03648D0, 0.02662D0, 0.01982D0,
54384 & 0.01493D0, 0.01129D0, 0.00853D0, 0.00645D0, 0.00486D0,
54385 & 0.00363D0, 0.00270D0, 0.00199D0, 0.00145D0, 0.00105D0,
54386 & 0.00075D0, 0.00054D0, 0.00039D0, 0.00030D0, 0.00022D0,
54387 & 0.00014D0, 0.00007D0, 0.00004D0, 0.00001D0, 0.00000D0,
54388 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54389 DATA (FMRS(1,5,I,28),I=1,49)/
54390 & 10.30763D0, 7.54945D0, 5.52601D0, 4.60181D0, 4.04004D0,
54391 & 3.65097D0, 2.65960D0, 1.92581D0, 1.58647D0, 1.37780D0,
54392 & 1.22885D0, 0.84989D0, 0.56911D0, 0.44198D0, 0.36560D0,
54393 & 0.31352D0, 0.24565D0, 0.18623D0, 0.13228D0, 0.10162D0,
54394 & 0.06750D0, 0.04868D0, 0.03669D0, 0.02666D0, 0.01976D0,
54395 & 0.01484D0, 0.01118D0, 0.00842D0, 0.00635D0, 0.00477D0,
54396 & 0.00355D0, 0.00263D0, 0.00193D0, 0.00141D0, 0.00102D0,
54397 & 0.00073D0, 0.00052D0, 0.00038D0, 0.00029D0, 0.00022D0,
54398 & 0.00014D0, 0.00007D0, 0.00004D0, 0.00001D0, 0.00000D0,
54399 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54400 DATA (FMRS(1,5,I,29),I=1,49)/
54401 & 11.17527D0, 8.14579D0, 5.93397D0, 4.92768D0, 4.31749D0,
54402 & 3.89565D0, 2.82415D0, 2.03499D0, 1.67156D0, 1.44867D0,
54403 & 1.28991D0, 0.88743D0, 0.59103D0, 0.45751D0, 0.37756D0,
54404 & 0.32318D0, 0.25249D0, 0.19081D0, 0.13501D0, 0.10341D0,
54405 & 0.06835D0, 0.04909D0, 0.03686D0, 0.02667D0, 0.01969D0,
54406 & 0.01473D0, 0.01106D0, 0.00831D0, 0.00624D0, 0.00467D0,
54407 & 0.00347D0, 0.00257D0, 0.00188D0, 0.00136D0, 0.00099D0,
54408 & 0.00070D0, 0.00050D0, 0.00037D0, 0.00028D0, 0.00021D0,
54409 & 0.00014D0, 0.00007D0, 0.00004D0, 0.00001D0, 0.00000D0,
54410 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54411 DATA (FMRS(1,5,I,30),I=1,49)/
54412 & 12.06456D0, 8.75358D0, 6.34740D0, 5.25678D0, 4.59701D0,
54413 & 4.14168D0, 2.98858D0, 2.14338D0, 1.75569D0, 1.51853D0,
54414 & 1.34994D0, 0.92405D0, 0.61221D0, 0.47241D0, 0.38898D0,
54415 & 0.33235D0, 0.25894D0, 0.19508D0, 0.13752D0, 0.10502D0,
54416 & 0.06908D0, 0.04942D0, 0.03697D0, 0.02664D0, 0.01960D0,
54417 & 0.01461D0, 0.01093D0, 0.00819D0, 0.00613D0, 0.00458D0,
54418 & 0.00339D0, 0.00250D0, 0.00183D0, 0.00132D0, 0.00095D0,
54419 & 0.00068D0, 0.00049D0, 0.00036D0, 0.00027D0, 0.00021D0,
54420 & 0.00014D0, 0.00007D0, 0.00004D0, 0.00001D0, 0.00000D0,
54421 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54422 DATA (FMRS(1,5,I,31),I=1,49)/
54423 & 12.95374D0, 9.35831D0, 6.75669D0, 5.58162D0, 4.87232D0,
54424 & 4.38360D0, 3.14942D0, 2.24882D0, 1.83726D0, 1.58610D0,
54425 & 1.40790D0, 0.95916D0, 0.63237D0, 0.48653D0, 0.39975D0,
54426 & 0.34099D0, 0.26498D0, 0.19905D0, 0.13983D0, 0.10648D0,
54427 & 0.06974D0, 0.04970D0, 0.03705D0, 0.02660D0, 0.01950D0,
54428 & 0.01449D0, 0.01081D0, 0.00807D0, 0.00603D0, 0.00449D0,
54429 & 0.00332D0, 0.00244D0, 0.00178D0, 0.00129D0, 0.00093D0,
54430 & 0.00066D0, 0.00047D0, 0.00035D0, 0.00026D0, 0.00020D0,
54431 & 0.00013D0, 0.00007D0, 0.00004D0, 0.00001D0, 0.00000D0,
54432 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54433 DATA (FMRS(1,5,I,32),I=1,49)/
54434 & 13.81822D0, 9.94319D0, 7.15042D0, 5.89310D0, 5.13569D0,
54435 & 4.61461D0, 3.30209D0, 2.34827D0, 1.91389D0, 1.64940D0,
54436 & 1.46205D0, 0.99170D0, 0.65086D0, 0.49940D0, 0.40952D0,
54437 & 0.34877D0, 0.27037D0, 0.20256D0, 0.14182D0, 0.10773D0,
54438 & 0.07026D0, 0.04989D0, 0.03708D0, 0.02652D0, 0.01938D0,
54439 & 0.01436D0, 0.01068D0, 0.00795D0, 0.00592D0, 0.00440D0,
54440 & 0.00325D0, 0.00238D0, 0.00174D0, 0.00125D0, 0.00090D0,
54441 & 0.00064D0, 0.00046D0, 0.00034D0, 0.00026D0, 0.00020D0,
54442 & 0.00013D0, 0.00007D0, 0.00004D0, 0.00001D0, 0.00000D0,
54443 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54444 DATA (FMRS(1,5,I,33),I=1,49)/
54445 & 14.74174D0, 10.56553D0, 7.56770D0, 6.22245D0, 5.41371D0,
54446 & 4.85814D0, 3.46239D0, 2.45228D0, 1.99384D0, 1.71531D0,
54447 & 1.51837D0, 1.02539D0, 0.66993D0, 0.51263D0, 0.41953D0,
54448 & 0.35674D0, 0.27589D0, 0.20614D0, 0.14386D0, 0.10899D0,
54449 & 0.07078D0, 0.05009D0, 0.03711D0, 0.02645D0, 0.01927D0,
54450 & 0.01422D0, 0.01055D0, 0.00784D0, 0.00582D0, 0.00432D0,
54451 & 0.00318D0, 0.00233D0, 0.00169D0, 0.00122D0, 0.00087D0,
54452 & 0.00062D0, 0.00044D0, 0.00033D0, 0.00025D0, 0.00020D0,
54453 & 0.00013D0, 0.00007D0, 0.00004D0, 0.00001D0, 0.00000D0,
54454 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54455 DATA (FMRS(1,5,I,34),I=1,49)/
54456 & 15.66159D0, 11.18202D0, 7.97872D0, 6.54573D0, 5.68591D0,
54457 & 5.09611D0, 3.61802D0, 2.55254D0, 2.07056D0, 1.77835D0,
54458 & 1.57208D0, 1.05721D0, 0.68771D0, 0.52486D0, 0.42872D0,
54459 & 0.36401D0, 0.28085D0, 0.20931D0, 0.14560D0, 0.11004D0,
54460 & 0.07117D0, 0.05019D0, 0.03707D0, 0.02633D0, 0.01912D0,
54461 & 0.01408D0, 0.01041D0, 0.00771D0, 0.00572D0, 0.00423D0,
54462 & 0.00311D0, 0.00227D0, 0.00165D0, 0.00118D0, 0.00085D0,
54463 & 0.00060D0, 0.00043D0, 0.00032D0, 0.00025D0, 0.00020D0,
54464 & 0.00013D0, 0.00007D0, 0.00004D0, 0.00001D0, 0.00000D0,
54465 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54466 DATA (FMRS(1,5,I,35),I=1,49)/
54467 & 16.58568D0, 11.79905D0, 8.38856D0, 6.86738D0, 5.95633D0,
54468 & 5.33223D0, 3.77185D0, 2.65127D0, 2.14594D0, 1.84019D0,
54469 & 1.62469D0, 1.08825D0, 0.70498D0, 0.53670D0, 0.43761D0,
54470 & 0.37103D0, 0.28563D0, 0.21235D0, 0.14727D0, 0.11103D0,
54471 & 0.07154D0, 0.05029D0, 0.03704D0, 0.02622D0, 0.01898D0,
54472 & 0.01394D0, 0.01028D0, 0.00760D0, 0.00562D0, 0.00415D0,
54473 & 0.00304D0, 0.00222D0, 0.00161D0, 0.00115D0, 0.00082D0,
54474 & 0.00058D0, 0.00042D0, 0.00031D0, 0.00024D0, 0.00019D0,
54475 & 0.00013D0, 0.00007D0, 0.00004D0, 0.00001D0, 0.00000D0,
54476 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54477 DATA (FMRS(1,5,I,36),I=1,49)/
54478 & 17.48656D0, 12.39804D0, 8.78469D0, 7.17746D0, 6.21652D0,
54479 & 5.55909D0, 3.91895D0, 2.74520D0, 2.21743D0, 1.89869D0,
54480 & 1.67437D0, 1.11736D0, 0.72106D0, 0.54767D0, 0.44580D0,
54481 & 0.37747D0, 0.28999D0, 0.21509D0, 0.14875D0, 0.11190D0,
54482 & 0.07184D0, 0.05035D0, 0.03698D0, 0.02610D0, 0.01884D0,
54483 & 0.01380D0, 0.01016D0, 0.00749D0, 0.00553D0, 0.00407D0,
54484 & 0.00298D0, 0.00217D0, 0.00157D0, 0.00112D0, 0.00080D0,
54485 & 0.00057D0, 0.00041D0, 0.00031D0, 0.00024D0, 0.00019D0,
54486 & 0.00013D0, 0.00007D0, 0.00004D0, 0.00001D0, 0.00000D0,
54487 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54488 DATA (FMRS(1,5,I,37),I=1,49)/
54489 & 18.41889D0, 13.01534D0, 9.19117D0, 7.49481D0, 6.48233D0,
54490 & 5.79049D0, 4.06828D0, 2.84006D0, 2.28940D0, 1.95745D0,
54491 & 1.72416D0, 1.14634D0, 0.73693D0, 0.55843D0, 0.45379D0,
54492 & 0.38373D0, 0.29419D0, 0.21770D0, 0.15013D0, 0.11269D0,
54493 & 0.07209D0, 0.05037D0, 0.03690D0, 0.02596D0, 0.01869D0,
54494 & 0.01365D0, 0.01003D0, 0.00738D0, 0.00543D0, 0.00399D0,
54495 & 0.00291D0, 0.00212D0, 0.00153D0, 0.00109D0, 0.00078D0,
54496 & 0.00055D0, 0.00040D0, 0.00030D0, 0.00023D0, 0.00019D0,
54497 & 0.00013D0, 0.00007D0, 0.00004D0, 0.00001D0, 0.00000D0,
54498 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54499 DATA (FMRS(1,5,I,38),I=1,49)/
54500 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54501 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54502 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54503 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54504 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54505 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54506 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54507 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54508 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54509 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54510 DATA (FMRS(1,6,I, 1),I=1,49)/
54511 & 0.44989D0, 0.39539D0, 0.34747D0, 0.32216D0, 0.30531D0,
54512 & 0.29285D0, 0.25722D0, 0.22578D0, 0.20909D0, 0.19792D0,
54513 & 0.18955D0, 0.16547D0, 0.14378D0, 0.13212D0, 0.12429D0,
54514 & 0.11845D0, 0.11003D0, 0.10150D0, 0.09208D0, 0.08532D0,
54515 & 0.07497D0, 0.06641D0, 0.05872D0, 0.04993D0, 0.04200D0,
54516 & 0.03492D0, 0.02867D0, 0.02327D0, 0.01867D0, 0.01463D0,
54517 & 0.01149D0, 0.00885D0, 0.00675D0, 0.00511D0, 0.00375D0,
54518 & 0.00275D0, 0.00200D0, 0.00140D0, 0.00092D0, 0.00067D0,
54519 & 0.00045D0, 0.00028D0, 0.00020D0, 0.00007D0, 0.00002D0,
54520 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54521 DATA (FMRS(1,6,I, 2),I=1,49)/
54522 & 0.46639D0, 0.41136D0, 0.36279D0, 0.33706D0, 0.31990D0,
54523 & 0.30719D0, 0.27073D0, 0.23840D0, 0.22115D0, 0.20956D0,
54524 & 0.20084D0, 0.17557D0, 0.15249D0, 0.13993D0, 0.13142D0,
54525 & 0.12504D0, 0.11578D0, 0.10635D0, 0.09591D0, 0.08845D0,
54526 & 0.07719D0, 0.06805D0, 0.05996D0, 0.05084D0, 0.04269D0,
54527 & 0.03544D0, 0.02909D0, 0.02361D0, 0.01895D0, 0.01488D0,
54528 & 0.01169D0, 0.00902D0, 0.00689D0, 0.00524D0, 0.00385D0,
54529 & 0.00283D0, 0.00206D0, 0.00146D0, 0.00096D0, 0.00071D0,
54530 & 0.00048D0, 0.00029D0, 0.00022D0, 0.00008D0, 0.00002D0,
54531 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54532 DATA (FMRS(1,6,I, 3),I=1,49)/
54533 & 0.50684D0, 0.44821D0, 0.39632D0, 0.36876D0, 0.35036D0,
54534 & 0.33670D0, 0.29743D0, 0.26242D0, 0.24363D0, 0.23094D0,
54535 & 0.22132D0, 0.19327D0, 0.16725D0, 0.15293D0, 0.14314D0,
54536 & 0.13576D0, 0.12501D0, 0.11402D0, 0.10188D0, 0.09328D0,
54537 & 0.08055D0, 0.07049D0, 0.06177D0, 0.05212D0, 0.04362D0,
54538 & 0.03613D0, 0.02960D0, 0.02400D0, 0.01926D0, 0.01513D0,
54539 & 0.01189D0, 0.00918D0, 0.00704D0, 0.00535D0, 0.00395D0,
54540 & 0.00290D0, 0.00211D0, 0.00152D0, 0.00101D0, 0.00074D0,
54541 & 0.00051D0, 0.00031D0, 0.00023D0, 0.00008D0, 0.00002D0,
54542 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54543 DATA (FMRS(1,6,I, 4),I=1,49)/
54544 & 0.55058D0, 0.48672D0, 0.43021D0, 0.40019D0, 0.38014D0,
54545 & 0.36526D0, 0.32246D0, 0.28426D0, 0.26371D0, 0.24981D0,
54546 & 0.23922D0, 0.20826D0, 0.17939D0, 0.16343D0, 0.15249D0,
54547 & 0.14425D0, 0.13221D0, 0.11993D0, 0.10640D0, 0.09689D0,
54548 & 0.08300D0, 0.07224D0, 0.06305D0, 0.05299D0, 0.04421D0,
54549 & 0.03653D0, 0.02989D0, 0.02420D0, 0.01939D0, 0.01523D0,
54550 & 0.01197D0, 0.00924D0, 0.00709D0, 0.00537D0, 0.00399D0,
54551 & 0.00293D0, 0.00213D0, 0.00154D0, 0.00102D0, 0.00074D0,
54552 & 0.00053D0, 0.00032D0, 0.00024D0, 0.00009D0, 0.00002D0,
54553 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54554 DATA (FMRS(1,6,I, 5),I=1,49)/
54555 & 0.61607D0, 0.54291D0, 0.47835D0, 0.44415D0, 0.42133D0,
54556 & 0.40441D0, 0.35583D0, 0.31254D0, 0.28927D0, 0.27353D0,
54557 & 0.26150D0, 0.22639D0, 0.19363D0, 0.17555D0, 0.16316D0,
54558 & 0.15384D0, 0.14026D0, 0.12643D0, 0.11130D0, 0.10077D0,
54559 & 0.08558D0, 0.07403D0, 0.06431D0, 0.05381D0, 0.04474D0,
54560 & 0.03686D0, 0.03008D0, 0.02432D0, 0.01945D0, 0.01528D0,
54561 & 0.01199D0, 0.00925D0, 0.00709D0, 0.00537D0, 0.00398D0,
54562 & 0.00293D0, 0.00214D0, 0.00154D0, 0.00103D0, 0.00074D0,
54563 & 0.00052D0, 0.00032D0, 0.00024D0, 0.00008D0, 0.00002D0,
54564 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54565 DATA (FMRS(1,6,I, 6),I=1,49)/
54566 & 0.68336D0, 0.60005D0, 0.52679D0, 0.48807D0, 0.46228D0,
54567 & 0.44318D0, 0.38846D0, 0.33984D0, 0.31375D0, 0.29611D0,
54568 & 0.28263D0, 0.24332D0, 0.20674D0, 0.18660D0, 0.17283D0,
54569 & 0.16249D0, 0.14745D0, 0.13219D0, 0.11560D0, 0.10414D0,
54570 & 0.08779D0, 0.07555D0, 0.06535D0, 0.05447D0, 0.04515D0,
54571 & 0.03709D0, 0.03021D0, 0.02439D0, 0.01946D0, 0.01528D0,
54572 & 0.01197D0, 0.00923D0, 0.00707D0, 0.00536D0, 0.00396D0,
54573 & 0.00291D0, 0.00213D0, 0.00154D0, 0.00103D0, 0.00073D0,
54574 & 0.00051D0, 0.00032D0, 0.00023D0, 0.00008D0, 0.00002D0,
54575 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54576 DATA (FMRS(1,6,I, 7),I=1,49)/
54577 & 0.76355D0, 0.66723D0, 0.58292D0, 0.53852D0, 0.50902D0,
54578 & 0.48721D0, 0.42490D0, 0.36978D0, 0.34030D0, 0.32042D0,
54579 & 0.30522D0, 0.26107D0, 0.22021D0, 0.19782D0, 0.18257D0,
54580 & 0.17114D0, 0.15457D0, 0.13784D0, 0.11976D0, 0.10736D0,
54581 & 0.08987D0, 0.07693D0, 0.06629D0, 0.05503D0, 0.04547D0,
54582 & 0.03726D0, 0.03027D0, 0.02439D0, 0.01942D0, 0.01523D0,
54583 & 0.01190D0, 0.00918D0, 0.00701D0, 0.00533D0, 0.00392D0,
54584 & 0.00287D0, 0.00209D0, 0.00153D0, 0.00101D0, 0.00073D0,
54585 & 0.00050D0, 0.00032D0, 0.00022D0, 0.00007D0, 0.00002D0,
54586 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54587 DATA (FMRS(1,6,I, 8),I=1,49)/
54588 & 0.86343D0, 0.75010D0, 0.65144D0, 0.59973D0, 0.56547D0,
54589 & 0.54018D0, 0.46822D0, 0.40492D0, 0.37123D0, 0.34856D0,
54590 & 0.33127D0, 0.28125D0, 0.23529D0, 0.21028D0, 0.19331D0,
54591 & 0.18063D0, 0.16233D0, 0.14394D0, 0.12420D0, 0.11077D0,
54592 & 0.09202D0, 0.07835D0, 0.06722D0, 0.05555D0, 0.04575D0,
54593 & 0.03737D0, 0.03028D0, 0.02434D0, 0.01934D0, 0.01514D0,
54594 & 0.01181D0, 0.00909D0, 0.00694D0, 0.00526D0, 0.00387D0,
54595 & 0.00282D0, 0.00206D0, 0.00150D0, 0.00100D0, 0.00072D0,
54596 & 0.00049D0, 0.00031D0, 0.00021D0, 0.00008D0, 0.00002D0,
54597 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54598 DATA (FMRS(1,6,I, 9),I=1,49)/
54599 & 0.96361D0, 0.83251D0, 0.71897D0, 0.65971D0, 0.62055D0,
54600 & 0.59171D0, 0.50993D0, 0.43838D0, 0.40047D0, 0.37504D0,
54601 & 0.35567D0, 0.29991D0, 0.24906D0, 0.22156D0, 0.20298D0,
54602 & 0.18914D0, 0.16924D0, 0.14933D0, 0.12809D0, 0.11373D0,
54603 & 0.09387D0, 0.07954D0, 0.06798D0, 0.05596D0, 0.04595D0,
54604 & 0.03743D0, 0.03026D0, 0.02427D0, 0.01926D0, 0.01505D0,
54605 & 0.01172D0, 0.00900D0, 0.00687D0, 0.00519D0, 0.00383D0,
54606 & 0.00278D0, 0.00203D0, 0.00148D0, 0.00098D0, 0.00071D0,
54607 & 0.00048D0, 0.00031D0, 0.00021D0, 0.00008D0, 0.00002D0,
54608 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54609 DATA (FMRS(1,6,I,10),I=1,49)/
54610 & 1.07479D0, 0.92315D0, 0.79255D0, 0.72469D0, 0.67997D0,
54611 & 0.64711D0, 0.55427D0, 0.47353D0, 0.43097D0, 0.40251D0,
54612 & 0.38089D0, 0.31894D0, 0.26290D0, 0.23280D0, 0.21256D0,
54613 & 0.19753D0, 0.17599D0, 0.15455D0, 0.13181D0, 0.11654D0,
54614 & 0.09559D0, 0.08062D0, 0.06865D0, 0.05629D0, 0.04608D0,
54615 & 0.03743D0, 0.03019D0, 0.02416D0, 0.01913D0, 0.01493D0,
54616 & 0.01161D0, 0.00890D0, 0.00677D0, 0.00511D0, 0.00377D0,
54617 & 0.00274D0, 0.00200D0, 0.00145D0, 0.00096D0, 0.00068D0,
54618 & 0.00046D0, 0.00030D0, 0.00020D0, 0.00008D0, 0.00002D0,
54619 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54620 DATA (FMRS(1,6,I,11),I=1,49)/
54621 & 1.17232D0, 1.00213D0, 0.85623D0, 0.78069D0, 0.73104D0,
54622 & 0.69461D0, 0.59200D0, 0.50321D0, 0.45658D0, 0.42550D0,
54623 & 0.40194D0, 0.33467D0, 0.27424D0, 0.24195D0, 0.22032D0,
54624 & 0.20431D0, 0.18142D0, 0.15872D0, 0.13477D0, 0.11875D0,
54625 & 0.09692D0, 0.08144D0, 0.06915D0, 0.05653D0, 0.04615D0,
54626 & 0.03741D0, 0.03011D0, 0.02406D0, 0.01902D0, 0.01482D0,
54627 & 0.01152D0, 0.00881D0, 0.00669D0, 0.00505D0, 0.00371D0,
54628 & 0.00270D0, 0.00197D0, 0.00143D0, 0.00094D0, 0.00066D0,
54629 & 0.00045D0, 0.00029D0, 0.00020D0, 0.00008D0, 0.00002D0,
54630 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54631 DATA (FMRS(1,6,I,12),I=1,49)/
54632 & 1.41135D0, 1.19389D0, 1.00931D0, 0.91452D0, 0.85253D0,
54633 & 0.80723D0, 0.68048D0, 0.57199D0, 0.51554D0, 0.47813D0,
54634 & 0.44992D0, 0.37007D0, 0.29939D0, 0.26209D0, 0.23729D0,
54635 & 0.21905D0, 0.19312D0, 0.16764D0, 0.14100D0, 0.12337D0,
54636 & 0.09965D0, 0.08309D0, 0.07010D0, 0.05694D0, 0.04624D0,
54637 & 0.03729D0, 0.02989D0, 0.02378D0, 0.01873D0, 0.01456D0,
54638 & 0.01128D0, 0.00861D0, 0.00651D0, 0.00490D0, 0.00360D0,
54639 & 0.00260D0, 0.00189D0, 0.00137D0, 0.00090D0, 0.00062D0,
54640 & 0.00043D0, 0.00028D0, 0.00019D0, 0.00007D0, 0.00002D0,
54641 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54642 DATA (FMRS(1,6,I,13),I=1,49)/
54643 & 1.65256D0, 1.38522D0, 1.16028D0, 1.04559D0, 0.97092D0,
54644 & 0.91653D0, 0.76529D0, 0.63704D0, 0.57085D0, 0.52722D0,
54645 & 0.49446D0, 0.40243D0, 0.32201D0, 0.28002D0, 0.25230D0,
54646 & 0.23200D0, 0.20332D0, 0.17533D0, 0.14629D0, 0.12724D0,
54647 & 0.10187D0, 0.08438D0, 0.07080D0, 0.05719D0, 0.04622D0,
54648 & 0.03712D0, 0.02965D0, 0.02350D0, 0.01845D0, 0.01430D0,
54649 & 0.01104D0, 0.00841D0, 0.00634D0, 0.00476D0, 0.00349D0,
54650 & 0.00251D0, 0.00182D0, 0.00132D0, 0.00086D0, 0.00060D0,
54651 & 0.00042D0, 0.00026D0, 0.00018D0, 0.00006D0, 0.00002D0,
54652 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54653 DATA (FMRS(1,6,I,14),I=1,49)/
54654 & 1.96387D0, 1.62942D0, 1.35081D0, 1.20988D0, 1.11860D0,
54655 & 1.05236D0, 0.86939D0, 0.71589D0, 0.63738D0, 0.58593D0,
54656 & 0.54750D0, 0.44041D0, 0.34815D0, 0.30054D0, 0.26935D0,
54657 & 0.24663D0, 0.21473D0, 0.18383D0, 0.15206D0, 0.13140D0,
54658 & 0.10419D0, 0.08567D0, 0.07145D0, 0.05736D0, 0.04609D0,
54659 & 0.03684D0, 0.02930D0, 0.02313D0, 0.01809D0, 0.01398D0,
54660 & 0.01074D0, 0.00816D0, 0.00615D0, 0.00459D0, 0.00334D0,
54661 & 0.00240D0, 0.00174D0, 0.00125D0, 0.00082D0, 0.00057D0,
54662 & 0.00038D0, 0.00024D0, 0.00016D0, 0.00006D0, 0.00002D0,
54663 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54664 DATA (FMRS(1,6,I,15),I=1,49)/
54665 & 2.33902D0, 1.92024D0, 1.57497D0, 1.40179D0, 1.29021D0,
54666 & 1.20956D0, 0.98833D0, 0.80477D0, 0.71175D0, 0.65116D0,
54667 & 0.60614D0, 0.48174D0, 0.37612D0, 0.32226D0, 0.28724D0,
54668 & 0.26188D0, 0.22649D0, 0.19248D0, 0.15783D0, 0.13549D0,
54669 & 0.10637D0, 0.08680D0, 0.07195D0, 0.05738D0, 0.04585D0,
54670 & 0.03646D0, 0.02886D0, 0.02269D0, 0.01768D0, 0.01360D0,
54671 & 0.01043D0, 0.00789D0, 0.00592D0, 0.00441D0, 0.00321D0,
54672 & 0.00230D0, 0.00166D0, 0.00118D0, 0.00078D0, 0.00054D0,
54673 & 0.00037D0, 0.00022D0, 0.00015D0, 0.00006D0, 0.00002D0,
54674 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54675 DATA (FMRS(1,6,I,16),I=1,49)/
54676 & 2.72482D0, 2.21608D0, 1.80052D0, 1.59364D0, 1.46096D0,
54677 & 1.36541D0, 1.10490D0, 0.89086D0, 0.78327D0, 0.71357D0,
54678 & 0.66200D0, 0.52058D0, 0.40200D0, 0.34217D0, 0.30354D0,
54679 & 0.27569D0, 0.23704D0, 0.20015D0, 0.16285D0, 0.13900D0,
54680 & 0.10817D0, 0.08767D0, 0.07227D0, 0.05729D0, 0.04554D0,
54681 & 0.03606D0, 0.02842D0, 0.02227D0, 0.01728D0, 0.01326D0,
54682 & 0.01012D0, 0.00763D0, 0.00571D0, 0.00425D0, 0.00307D0,
54683 & 0.00219D0, 0.00158D0, 0.00112D0, 0.00073D0, 0.00051D0,
54684 & 0.00035D0, 0.00021D0, 0.00014D0, 0.00005D0, 0.00002D0,
54685 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54686 DATA (FMRS(1,6,I,17),I=1,49)/
54687 & 3.16184D0, 2.54784D0, 2.05090D0, 1.80533D0, 1.64858D0,
54688 & 1.53608D0, 1.23122D0, 0.98314D0, 0.85944D0, 0.77972D0,
54689 & 0.72099D0, 0.56109D0, 0.42865D0, 0.36249D0, 0.32006D0,
54690 & 0.28962D0, 0.24759D0, 0.20774D0, 0.16775D0, 0.14236D0,
54691 & 0.10984D0, 0.08843D0, 0.07249D0, 0.05712D0, 0.04518D0,
54692 & 0.03560D0, 0.02794D0, 0.02182D0, 0.01686D0, 0.01291D0,
54693 & 0.00980D0, 0.00737D0, 0.00550D0, 0.00408D0, 0.00294D0,
54694 & 0.00209D0, 0.00150D0, 0.00107D0, 0.00069D0, 0.00049D0,
54695 & 0.00034D0, 0.00019D0, 0.00014D0, 0.00005D0, 0.00001D0,
54696 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54697 DATA (FMRS(1,6,I,18),I=1,49)/
54698 & 3.56226D0, 2.84906D0, 2.27616D0, 1.99475D0, 1.81581D0,
54699 & 1.68774D0, 1.34241D0, 1.06358D0, 0.92544D0, 0.83679D0,
54700 & 0.77171D0, 0.59551D0, 0.45100D0, 0.37940D0, 0.33372D0,
54701 & 0.30107D0, 0.25620D0, 0.21386D0, 0.17164D0, 0.14499D0,
54702 & 0.11108D0, 0.08895D0, 0.07258D0, 0.05692D0, 0.04483D0,
54703 & 0.03518D0, 0.02753D0, 0.02142D0, 0.01651D0, 0.01260D0,
54704 & 0.00954D0, 0.00717D0, 0.00532D0, 0.00393D0, 0.00284D0,
54705 & 0.00201D0, 0.00144D0, 0.00103D0, 0.00066D0, 0.00045D0,
54706 & 0.00032D0, 0.00018D0, 0.00013D0, 0.00004D0, 0.00001D0,
54707 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54708 DATA (FMRS(1,6,I,19),I=1,49)/
54709 & 4.09416D0, 3.24567D0, 2.57011D0, 2.24065D0, 2.03209D0,
54710 & 1.88332D0, 1.48448D0, 1.16540D0, 1.00850D0, 0.90831D0,
54711 & 0.83504D0, 0.63803D0, 0.47827D0, 0.39987D0, 0.35015D0,
54712 & 0.31478D0, 0.26640D0, 0.22104D0, 0.17612D0, 0.14797D0,
54713 & 0.11241D0, 0.08943D0, 0.07259D0, 0.05659D0, 0.04434D0,
54714 & 0.03464D0, 0.02699D0, 0.02092D0, 0.01606D0, 0.01221D0,
54715 & 0.00922D0, 0.00691D0, 0.00511D0, 0.00375D0, 0.00271D0,
54716 & 0.00191D0, 0.00136D0, 0.00097D0, 0.00063D0, 0.00043D0,
54717 & 0.00030D0, 0.00017D0, 0.00012D0, 0.00004D0, 0.00001D0,
54718 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54719 DATA (FMRS(1,6,I,20),I=1,49)/
54720 & 4.61257D0, 3.62885D0, 2.85161D0, 2.47491D0, 2.23738D0,
54721 & 2.06842D0, 1.61774D0, 1.26001D0, 1.08527D0, 0.97415D0,
54722 & 0.89315D0, 0.67662D0, 0.50274D0, 0.41811D0, 0.36471D0,
54723 & 0.32688D0, 0.27534D0, 0.22728D0, 0.17996D0, 0.15048D0,
54724 & 0.11349D0, 0.08979D0, 0.07253D0, 0.05626D0, 0.04389D0,
54725 & 0.03414D0, 0.02651D0, 0.02047D0, 0.01566D0, 0.01187D0,
54726 & 0.00894D0, 0.00668D0, 0.00493D0, 0.00361D0, 0.00261D0,
54727 & 0.00182D0, 0.00129D0, 0.00093D0, 0.00059D0, 0.00040D0,
54728 & 0.00028D0, 0.00016D0, 0.00011D0, 0.00004D0, 0.00001D0,
54729 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54730 DATA (FMRS(1,6,I,21),I=1,49)/
54731 & 5.12222D0, 4.00261D0, 3.12404D0, 2.70057D0, 2.43446D0,
54732 & 2.24566D0, 1.74429D0, 1.34911D0, 1.15718D0, 1.03559D0,
54733 & 0.94721D0, 0.71215D0, 0.52500D0, 0.43455D0, 0.37776D0,
54734 & 0.33766D0, 0.28323D0, 0.23271D0, 0.18324D0, 0.15257D0,
54735 & 0.11432D0, 0.08998D0, 0.07237D0, 0.05588D0, 0.04342D0,
54736 & 0.03365D0, 0.02604D0, 0.02004D0, 0.01529D0, 0.01156D0,
54737 & 0.00869D0, 0.00646D0, 0.00477D0, 0.00348D0, 0.00251D0,
54738 & 0.00175D0, 0.00124D0, 0.00088D0, 0.00057D0, 0.00038D0,
54739 & 0.00026D0, 0.00015D0, 0.00010D0, 0.00004D0, 0.00001D0,
54740 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54741 DATA (FMRS(1,6,I,22),I=1,49)/
54742 & 5.82554D0, 4.51423D0, 3.49391D0, 3.00548D0, 2.69986D0,
54743 & 2.48370D0, 1.91285D0, 1.46678D0, 1.25167D0, 1.11601D0,
54744 & 1.01775D0, 0.75806D0, 0.55345D0, 0.45543D0, 0.39424D0,
54745 & 0.35121D0, 0.29307D0, 0.23942D0, 0.18722D0, 0.15507D0,
54746 & 0.11526D0, 0.09014D0, 0.07211D0, 0.05536D0, 0.04279D0,
54747 & 0.03301D0, 0.02543D0, 0.01950D0, 0.01483D0, 0.01117D0,
54748 & 0.00837D0, 0.00620D0, 0.00456D0, 0.00332D0, 0.00238D0,
54749 & 0.00166D0, 0.00117D0, 0.00083D0, 0.00053D0, 0.00035D0,
54750 & 0.00024D0, 0.00015D0, 0.00010D0, 0.00003D0, 0.00001D0,
54751 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54752 DATA (FMRS(1,6,I,23),I=1,49)/
54753 & 6.54676D0, 5.03439D0, 3.86673D0, 3.31126D0, 2.96506D0,
54754 & 2.72090D0, 2.07933D0, 1.58195D0, 1.34364D0, 1.19398D0,
54755 & 1.08591D0, 0.80195D0, 0.58033D0, 0.47501D0, 0.40960D0,
54756 & 0.36377D0, 0.30212D0, 0.24551D0, 0.19078D0, 0.15726D0,
54757 & 0.11602D0, 0.09021D0, 0.07181D0, 0.05483D0, 0.04218D0,
54758 & 0.03240D0, 0.02486D0, 0.01900D0, 0.01440D0, 0.01081D0,
54759 & 0.00808D0, 0.00597D0, 0.00437D0, 0.00317D0, 0.00227D0,
54760 & 0.00157D0, 0.00111D0, 0.00080D0, 0.00050D0, 0.00034D0,
54761 & 0.00022D0, 0.00014D0, 0.00009D0, 0.00003D0, 0.00001D0,
54762 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54763 DATA (FMRS(1,6,I,24),I=1,49)/
54764 & 7.26565D0, 5.54876D0, 4.23247D0, 3.60982D0, 3.22311D0,
54765 & 2.95109D0, 2.23956D0, 1.69183D0, 1.43093D0, 1.26769D0,
54766 & 1.15015D0, 0.84286D0, 0.60508D0, 0.49288D0, 0.42351D0,
54767 & 0.37509D0, 0.31017D0, 0.25086D0, 0.19381D0, 0.15905D0,
54768 & 0.11655D0, 0.09013D0, 0.07142D0, 0.05426D0, 0.04157D0,
54769 & 0.03180D0, 0.02431D0, 0.01852D0, 0.01399D0, 0.01048D0,
54770 & 0.00780D0, 0.00574D0, 0.00419D0, 0.00304D0, 0.00217D0,
54771 & 0.00149D0, 0.00106D0, 0.00075D0, 0.00048D0, 0.00032D0,
54772 & 0.00021D0, 0.00013D0, 0.00009D0, 0.00003D0, 0.00001D0,
54773 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54774 DATA (FMRS(1,6,I,25),I=1,49)/
54775 & 8.04192D0, 6.10017D0, 4.62168D0, 3.92618D0, 3.49572D0,
54776 & 3.19370D0, 2.40717D0, 1.80591D0, 1.52114D0, 1.34361D0,
54777 & 1.21613D0, 0.88453D0, 0.63003D0, 0.51078D0, 0.43739D0,
54778 & 0.38633D0, 0.31813D0, 0.25609D0, 0.19674D0, 0.16076D0,
54779 & 0.11701D0, 0.09001D0, 0.07101D0, 0.05368D0, 0.04095D0,
54780 & 0.03121D0, 0.02377D0, 0.01805D0, 0.01359D0, 0.01015D0,
54781 & 0.00753D0, 0.00553D0, 0.00402D0, 0.00291D0, 0.00207D0,
54782 & 0.00142D0, 0.00101D0, 0.00071D0, 0.00045D0, 0.00030D0,
54783 & 0.00020D0, 0.00012D0, 0.00008D0, 0.00003D0, 0.00001D0,
54784 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54785 DATA (FMRS(1,6,I,26),I=1,49)/
54786 & 8.84513D0, 6.66663D0, 5.01863D0, 4.24745D0, 3.77171D0,
54787 & 3.43873D0, 2.57518D0, 1.91937D0, 1.61043D0, 1.41849D0,
54788 & 1.28102D0, 0.92509D0, 0.65405D0, 0.52788D0, 0.45056D0,
54789 & 0.39694D0, 0.32555D0, 0.26091D0, 0.19936D0, 0.16223D0,
54790 & 0.11732D0, 0.08979D0, 0.07053D0, 0.05307D0, 0.04031D0,
54791 & 0.03061D0, 0.02325D0, 0.01759D0, 0.01321D0, 0.00982D0,
54792 & 0.00728D0, 0.00532D0, 0.00387D0, 0.00279D0, 0.00197D0,
54793 & 0.00136D0, 0.00096D0, 0.00067D0, 0.00043D0, 0.00029D0,
54794 & 0.00019D0, 0.00011D0, 0.00007D0, 0.00003D0, 0.00001D0,
54795 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54796 DATA (FMRS(1,6,I,27),I=1,49)/
54797 & 9.65435D0, 7.23356D0, 5.41328D0, 4.56560D0, 4.04426D0,
54798 & 3.68017D0, 2.73960D0, 2.02962D0, 1.69683D0, 1.49072D0,
54799 & 1.34344D0, 0.96379D0, 0.67674D0, 0.54393D0, 0.46286D0,
54800 & 0.40680D0, 0.33241D0, 0.26531D0, 0.20171D0, 0.16351D0,
54801 & 0.11755D0, 0.08953D0, 0.07005D0, 0.05247D0, 0.03970D0,
54802 & 0.03004D0, 0.02275D0, 0.01715D0, 0.01284D0, 0.00953D0,
54803 & 0.00704D0, 0.00513D0, 0.00373D0, 0.00268D0, 0.00189D0,
54804 & 0.00130D0, 0.00092D0, 0.00064D0, 0.00040D0, 0.00027D0,
54805 & 0.00018D0, 0.00010D0, 0.00007D0, 0.00002D0, 0.00001D0,
54806 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54807 DATA (FMRS(1,6,I,28),I=1,49)/
54808 & 10.45602D0, 7.79175D0, 5.79941D0, 4.87575D0, 4.30926D0,
54809 & 3.91444D0, 2.89810D0, 2.13519D0, 1.77921D0, 1.55938D0,
54810 & 1.40263D0, 1.00018D0, 0.69787D0, 0.55877D0, 0.47417D0,
54811 & 0.41582D0, 0.33862D0, 0.26925D0, 0.20376D0, 0.16459D0,
54812 & 0.11767D0, 0.08923D0, 0.06955D0, 0.05189D0, 0.03911D0,
54813 & 0.02950D0, 0.02227D0, 0.01675D0, 0.01249D0, 0.00926D0,
54814 & 0.00681D0, 0.00496D0, 0.00359D0, 0.00258D0, 0.00181D0,
54815 & 0.00125D0, 0.00088D0, 0.00062D0, 0.00038D0, 0.00026D0,
54816 & 0.00017D0, 0.00010D0, 0.00007D0, 0.00002D0, 0.00001D0,
54817 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54818 DATA (FMRS(1,6,I,29),I=1,49)/
54819 & 11.30416D0, 8.37884D0, 6.20316D0, 5.19892D0, 4.58469D0,
54820 & 4.15747D0, 3.06152D0, 2.24335D0, 1.86330D0, 1.62927D0,
54821 & 1.46273D0, 1.03685D0, 0.71898D0, 0.57351D0, 0.48535D0,
54822 & 0.42471D0, 0.34469D0, 0.27305D0, 0.20570D0, 0.16558D0,
54823 & 0.11773D0, 0.08889D0, 0.06902D0, 0.05129D0, 0.03852D0,
54824 & 0.02896D0, 0.02179D0, 0.01634D0, 0.01216D0, 0.00899D0,
54825 & 0.00659D0, 0.00479D0, 0.00347D0, 0.00248D0, 0.00174D0,
54826 & 0.00119D0, 0.00084D0, 0.00059D0, 0.00036D0, 0.00024D0,
54827 & 0.00016D0, 0.00009D0, 0.00006D0, 0.00002D0, 0.00001D0,
54828 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54829 DATA (FMRS(1,6,I,30),I=1,49)/
54830 & 12.17534D0, 8.97841D0, 6.61310D0, 5.52592D0, 4.86271D0,
54831 & 4.40230D0, 3.22516D0, 2.35097D0, 1.94663D0, 1.69833D0,
54832 & 1.52199D0, 1.07270D0, 0.73942D0, 0.58770D0, 0.49605D0,
54833 & 0.43317D0, 0.35042D0, 0.27659D0, 0.20745D0, 0.16642D0,
54834 & 0.11771D0, 0.08850D0, 0.06847D0, 0.05068D0, 0.03793D0,
54835 & 0.02842D0, 0.02132D0, 0.01595D0, 0.01184D0, 0.00872D0,
54836 & 0.00639D0, 0.00464D0, 0.00334D0, 0.00238D0, 0.00167D0,
54837 & 0.00115D0, 0.00081D0, 0.00056D0, 0.00034D0, 0.00023D0,
54838 & 0.00015D0, 0.00009D0, 0.00006D0, 0.00002D0, 0.00000D0,
54839 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54840 DATA (FMRS(1,6,I,31),I=1,49)/
54841 & 13.04562D0, 9.57419D0, 7.01826D0, 5.84808D0, 5.13599D0,
54842 & 4.64254D0, 3.38483D0, 2.45538D0, 2.02720D0, 1.76492D0,
54843 & 1.57901D0, 1.10697D0, 0.75881D0, 0.60107D0, 0.50610D0,
54844 & 0.44109D0, 0.35574D0, 0.27985D0, 0.20903D0, 0.16716D0,
54845 & 0.11764D0, 0.08810D0, 0.06793D0, 0.05010D0, 0.03737D0,
54846 & 0.02791D0, 0.02089D0, 0.01558D0, 0.01154D0, 0.00848D0,
54847 & 0.00620D0, 0.00450D0, 0.00323D0, 0.00230D0, 0.00160D0,
54848 & 0.00110D0, 0.00077D0, 0.00053D0, 0.00032D0, 0.00022D0,
54849 & 0.00015D0, 0.00008D0, 0.00006D0, 0.00002D0, 0.00000D0,
54850 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54851 DATA (FMRS(1,6,I,32),I=1,49)/
54852 & 13.89443D0, 10.15226D0, 7.40931D0, 6.15805D0, 5.39834D0,
54853 & 4.87276D0, 3.53699D0, 2.55429D0, 2.10325D0, 1.82761D0,
54854 & 1.63256D0, 1.13890D0, 0.77669D0, 0.61332D0, 0.51524D0,
54855 & 0.44825D0, 0.36050D0, 0.28271D0, 0.21036D0, 0.16773D0,
54856 & 0.11750D0, 0.08767D0, 0.06738D0, 0.04952D0, 0.03683D0,
54857 & 0.02743D0, 0.02048D0, 0.01524D0, 0.01125D0, 0.00826D0,
54858 & 0.00603D0, 0.00436D0, 0.00312D0, 0.00222D0, 0.00155D0,
54859 & 0.00106D0, 0.00074D0, 0.00051D0, 0.00031D0, 0.00021D0,
54860 & 0.00014D0, 0.00008D0, 0.00005D0, 0.00002D0, 0.00001D0,
54861 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54862 DATA (FMRS(1,6,I,33),I=1,49)/
54863 & 14.79866D0, 10.76526D0, 7.82209D0, 6.48437D0, 5.67399D0,
54864 & 5.11430D0, 3.69589D0, 2.65710D0, 2.18207D0, 1.89245D0,
54865 & 1.68785D0, 1.17170D0, 0.79496D0, 0.62581D0, 0.52453D0,
54866 & 0.45551D0, 0.36532D0, 0.28560D0, 0.21171D0, 0.16831D0,
54867 & 0.11736D0, 0.08724D0, 0.06684D0, 0.04896D0, 0.03630D0,
54868 & 0.02696D0, 0.02007D0, 0.01490D0, 0.01098D0, 0.00805D0,
54869 & 0.00586D0, 0.00423D0, 0.00302D0, 0.00214D0, 0.00150D0,
54870 & 0.00102D0, 0.00071D0, 0.00049D0, 0.00030D0, 0.00020D0,
54871 & 0.00013D0, 0.00008D0, 0.00005D0, 0.00002D0, 0.00001D0,
54872 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54873 DATA (FMRS(1,6,I,34),I=1,49)/
54874 & 15.70368D0, 11.37564D0, 8.23095D0, 6.80656D0, 5.94554D0,
54875 & 5.35181D0, 3.85123D0, 2.75698D0, 2.25835D0, 1.95501D0,
54876 & 1.74107D0, 1.20298D0, 0.81219D0, 0.63747D0, 0.53315D0,
54877 & 0.46219D0, 0.36968D0, 0.28814D0, 0.21281D0, 0.16870D0,
54878 & 0.11711D0, 0.08674D0, 0.06626D0, 0.04836D0, 0.03575D0,
54879 & 0.02649D0, 0.01967D0, 0.01456D0, 0.01071D0, 0.00784D0,
54880 & 0.00568D0, 0.00409D0, 0.00292D0, 0.00207D0, 0.00144D0,
54881 & 0.00098D0, 0.00068D0, 0.00047D0, 0.00029D0, 0.00019D0,
54882 & 0.00012D0, 0.00007D0, 0.00005D0, 0.00002D0, 0.00000D0,
54883 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54884 DATA (FMRS(1,6,I,35),I=1,49)/
54885 & 16.61098D0, 11.98498D0, 8.63737D0, 7.12604D0, 6.21432D0,
54886 & 5.58657D0, 4.00413D0, 2.85486D0, 2.33290D0, 2.01603D0,
54887 & 1.79291D0, 1.23331D0, 0.82880D0, 0.64868D0, 0.54141D0,
54888 & 0.46858D0, 0.37384D0, 0.29056D0, 0.21385D0, 0.16907D0,
54889 & 0.11687D0, 0.08628D0, 0.06571D0, 0.04780D0, 0.03525D0,
54890 & 0.02604D0, 0.01929D0, 0.01425D0, 0.01046D0, 0.00764D0,
54891 & 0.00552D0, 0.00397D0, 0.00283D0, 0.00200D0, 0.00139D0,
54892 & 0.00095D0, 0.00066D0, 0.00045D0, 0.00028D0, 0.00019D0,
54893 & 0.00012D0, 0.00007D0, 0.00005D0, 0.00002D0, 0.00000D0,
54894 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54895 DATA (FMRS(1,6,I,36),I=1,49)/
54896 & 17.49641D0, 12.57703D0, 9.03053D0, 7.43428D0, 6.47316D0,
54897 & 5.81232D0, 4.15045D0, 2.94807D0, 2.40367D0, 2.07383D0,
54898 & 1.84191D0, 1.26179D0, 0.84428D0, 0.65906D0, 0.54902D0,
54899 & 0.47444D0, 0.37762D0, 0.29271D0, 0.21474D0, 0.16935D0,
54900 & 0.11660D0, 0.08580D0, 0.06517D0, 0.04726D0, 0.03476D0,
54901 & 0.02562D0, 0.01894D0, 0.01396D0, 0.01022D0, 0.00745D0,
54902 & 0.00538D0, 0.00386D0, 0.00274D0, 0.00194D0, 0.00135D0,
54903 & 0.00092D0, 0.00063D0, 0.00044D0, 0.00027D0, 0.00018D0,
54904 & 0.00011D0, 0.00007D0, 0.00005D0, 0.00002D0, 0.00000D0,
54905 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54906 DATA (FMRS(1,6,I,37),I=1,49)/
54907 & 18.41415D0, 13.18812D0, 9.43458D0, 7.75025D0, 6.73800D0,
54908 & 6.04297D0, 4.29926D0, 3.04240D0, 2.47507D0, 2.13202D0,
54909 & 1.89114D0, 1.29020D0, 0.85959D0, 0.66927D0, 0.55646D0,
54910 & 0.48015D0, 0.38126D0, 0.29476D0, 0.21554D0, 0.16955D0,
54911 & 0.11628D0, 0.08530D0, 0.06461D0, 0.04672D0, 0.03427D0,
54912 & 0.02520D0, 0.01858D0, 0.01367D0, 0.00999D0, 0.00727D0,
54913 & 0.00525D0, 0.00375D0, 0.00266D0, 0.00188D0, 0.00131D0,
54914 & 0.00088D0, 0.00061D0, 0.00042D0, 0.00026D0, 0.00017D0,
54915 & 0.00011D0, 0.00006D0, 0.00004D0, 0.00001D0, 0.00000D0,
54916 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54917 DATA (FMRS(1,6,I,38),I=1,49)/
54918 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54919 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54920 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54921 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54922 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54923 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54924 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54925 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54926 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54927 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54928 DATA (FMRS(1,7,I, 1),I=1,49)/
54929 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54930 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54931 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54932 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54933 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54934 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54935 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54936 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54937 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54938 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54939 DATA (FMRS(1,7,I, 2),I=1,49)/
54940 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54941 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54942 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54943 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54944 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54945 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54946 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54947 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54948 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54949 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54950 DATA (FMRS(1,7,I, 3),I=1,49)/
54951 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54952 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54953 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54954 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54955 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54956 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54957 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54958 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54959 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54960 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54961 DATA (FMRS(1,7,I, 4),I=1,49)/
54962 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54963 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54964 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54965 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54966 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54967 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54968 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54969 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54970 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54971 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54972 DATA (FMRS(1,7,I, 5),I=1,49)/
54973 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54974 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54975 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54976 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54977 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54978 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54979 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54980 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54981 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54982 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54983 DATA (FMRS(1,7,I, 6),I=1,49)/
54984 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54985 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54986 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54987 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54988 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54989 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54990 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54991 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54992 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54993 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
54994 DATA (FMRS(1,7,I, 7),I=1,49)/
54995 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54996 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
54997 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
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/
55005 DATA (FMRS(1,7,I, 8),I=1,49)/
55006 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55007 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55008 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55009 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55010 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55011 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55012 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55013 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55014 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55015 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55016 DATA (FMRS(1,7,I, 9),I=1,49)/
55017 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55018 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55019 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55020 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55021 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55022 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55023 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55024 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55025 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55026 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55027 DATA (FMRS(1,7,I,10),I=1,49)/
55028 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55029 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55030 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55031 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55032 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55033 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55034 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55035 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55036 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55037 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55038 DATA (FMRS(1,7,I,11),I=1,49)/
55039 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55040 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55041 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55042 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55043 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55044 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55045 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55046 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55047 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55048 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55049 DATA (FMRS(1,7,I,12),I=1,49)/
55050 & 0.00042D0, 0.00036D0, 0.00032D0, 0.00030D0, 0.00028D0,
55051 & 0.00027D0, 0.00023D0, 0.00020D0, 0.00019D0, 0.00018D0,
55052 & 0.00017D0, 0.00014D0, 0.00012D0, 0.00011D0, 0.00010D0,
55053 & 0.00009D0, 0.00008D0, 0.00007D0, 0.00006D0, 0.00005D0,
55054 & 0.00005D0, 0.00004D0, 0.00003D0, 0.00003D0, 0.00003D0,
55055 & 0.00002D0, 0.00002D0, 0.00002D0, 0.00002D0, 0.00001D0,
55056 & 0.00001D0, 0.00001D0, 0.00001D0, 0.00001D0, 0.00001D0,
55057 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55058 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55059 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55060 DATA (FMRS(1,7,I,13),I=1,49)/
55061 & 0.21520D0, 0.16773D0, 0.13065D0, 0.11283D0, 0.10165D0,
55062 & 0.09372D0, 0.07266D0, 0.05600D0, 0.04786D0, 0.04266D0,
55063 & 0.03883D0, 0.02862D0, 0.02044D0, 0.01649D0, 0.01402D0,
55064 & 0.01228D0, 0.00994D0, 0.00781D0, 0.00579D0, 0.00460D0,
55065 & 0.00322D0, 0.00243D0, 0.00191D0, 0.00146D0, 0.00114D0,
55066 & 0.00089D0, 0.00070D0, 0.00055D0, 0.00043D0, 0.00034D0,
55067 & 0.00026D0, 0.00020D0, 0.00015D0, 0.00011D0, 0.00009D0,
55068 & 0.00006D0, 0.00005D0, 0.00003D0, 0.00002D0, 0.00001D0,
55069 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55070 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55071 DATA (FMRS(1,7,I,14),I=1,49)/
55072 & 0.62424D0, 0.48455D0, 0.37589D0, 0.32385D0, 0.29126D0,
55073 & 0.26818D0, 0.20706D0, 0.15892D0, 0.13546D0, 0.12053D0,
55074 & 0.10954D0, 0.08034D0, 0.05707D0, 0.04589D0, 0.03892D0,
55075 & 0.03403D0, 0.02747D0, 0.02151D0, 0.01589D0, 0.01258D0,
55076 & 0.00876D0, 0.00658D0, 0.00515D0, 0.00391D0, 0.00303D0,
55077 & 0.00236D0, 0.00185D0, 0.00144D0, 0.00112D0, 0.00088D0,
55078 & 0.00067D0, 0.00051D0, 0.00039D0, 0.00029D0, 0.00022D0,
55079 & 0.00016D0, 0.00011D0, 0.00008D0, 0.00006D0, 0.00004D0,
55080 & 0.00002D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
55081 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55082 DATA (FMRS(1,7,I,15),I=1,49)/
55083 & 1.00765D0, 0.77678D0, 0.59844D0, 0.51350D0, 0.46049D0,
55084 & 0.42306D0, 0.32436D0, 0.24719D0, 0.20981D0, 0.18611D0,
55085 & 0.16874D0, 0.12279D0, 0.08652D0, 0.06923D0, 0.05850D0,
55086 & 0.05102D0, 0.04100D0, 0.03196D0, 0.02347D0, 0.01849D0,
55087 & 0.01279D0, 0.00955D0, 0.00743D0, 0.00560D0, 0.00430D0,
55088 & 0.00334D0, 0.00260D0, 0.00202D0, 0.00157D0, 0.00121D0,
55089 & 0.00093D0, 0.00071D0, 0.00053D0, 0.00040D0, 0.00029D0,
55090 & 0.00021D0, 0.00015D0, 0.00011D0, 0.00007D0, 0.00005D0,
55091 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
55092 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55093 DATA (FMRS(1,7,I,16),I=1,49)/
55094 & 1.42250D0, 1.08981D0, 0.83442D0, 0.71339D0, 0.63810D0,
55095 & 0.58505D0, 0.44575D0, 0.33755D0, 0.28542D0, 0.25249D0,
55096 & 0.22841D0, 0.16506D0, 0.11545D0, 0.09197D0, 0.07747D0,
55097 & 0.06738D0, 0.05394D0, 0.04186D0, 0.03057D0, 0.02399D0,
55098 & 0.01648D0, 0.01223D0, 0.00946D0, 0.00708D0, 0.00541D0,
55099 & 0.00417D0, 0.00323D0, 0.00250D0, 0.00193D0, 0.00149D0,
55100 & 0.00113D0, 0.00086D0, 0.00064D0, 0.00048D0, 0.00035D0,
55101 & 0.00026D0, 0.00018D0, 0.00013D0, 0.00009D0, 0.00005D0,
55102 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
55103 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55104 DATA (FMRS(1,7,I,17),I=1,49)/
55105 & 1.90329D0, 1.44918D0, 1.10274D0, 0.93938D0, 0.83807D0,
55106 & 0.76686D0, 0.58064D0, 0.43692D0, 0.36805D0, 0.32470D0,
55107 & 0.29309D0, 0.21032D0, 0.14604D0, 0.11582D0, 0.09725D0,
55108 & 0.08437D0, 0.06728D0, 0.05198D0, 0.03776D0, 0.02950D0,
55109 & 0.02012D0, 0.01485D0, 0.01142D0, 0.00850D0, 0.00645D0,
55110 & 0.00494D0, 0.00381D0, 0.00293D0, 0.00225D0, 0.00172D0,
55111 & 0.00131D0, 0.00098D0, 0.00073D0, 0.00054D0, 0.00040D0,
55112 & 0.00029D0, 0.00021D0, 0.00014D0, 0.00010D0, 0.00006D0,
55113 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
55114 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55115 DATA (FMRS(1,7,I,18),I=1,49)/
55116 & 2.33137D0, 1.76616D0, 1.33713D0, 1.13567D0, 1.01106D0,
55117 & 0.92363D0, 0.69576D0, 0.52083D0, 0.43738D0, 0.38501D0,
55118 & 0.34690D0, 0.24753D0, 0.17085D0, 0.13502D0, 0.11307D0,
55119 & 0.09789D0, 0.07781D0, 0.05991D0, 0.04333D0, 0.03374D0,
55120 & 0.02288D0, 0.01680D0, 0.01286D0, 0.00952D0, 0.00719D0,
55121 & 0.00549D0, 0.00420D0, 0.00322D0, 0.00246D0, 0.00188D0,
55122 & 0.00142D0, 0.00107D0, 0.00079D0, 0.00059D0, 0.00043D0,
55123 & 0.00031D0, 0.00022D0, 0.00015D0, 0.00010D0, 0.00006D0,
55124 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
55125 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55126 DATA (FMRS(1,7,I,19),I=1,49)/
55127 & 2.89798D0, 2.18213D0, 1.64207D0, 1.38971D0, 1.23410D0,
55128 & 1.12518D0, 0.84241D0, 0.62670D0, 0.52435D0, 0.46034D0,
55129 & 0.41389D0, 0.29333D0, 0.20103D0, 0.15819D0, 0.13206D0,
55130 & 0.11405D0, 0.09031D0, 0.06924D0, 0.04982D0, 0.03863D0,
55131 & 0.02602D0, 0.01899D0, 0.01446D0, 0.01064D0, 0.00798D0,
55132 & 0.00606D0, 0.00462D0, 0.00352D0, 0.00268D0, 0.00204D0,
55133 & 0.00153D0, 0.00115D0, 0.00085D0, 0.00062D0, 0.00046D0,
55134 & 0.00034D0, 0.00024D0, 0.00016D0, 0.00010D0, 0.00006D0,
55135 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
55136 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55137 DATA (FMRS(1,7,I,20),I=1,49)/
55138 & 3.45978D0, 2.59142D0, 1.93977D0, 1.63658D0, 1.45012D0,
55139 & 1.31987D0, 0.98290D0, 0.72728D0, 0.60655D0, 0.53126D0,
55140 & 0.47676D0, 0.33590D0, 0.22879D0, 0.17936D0, 0.14933D0,
55141 & 0.12869D0, 0.10156D0, 0.07757D0, 0.05556D0, 0.04293D0,
55142 & 0.02875D0, 0.02087D0, 0.01582D0, 0.01157D0, 0.00864D0,
55143 & 0.00653D0, 0.00495D0, 0.00376D0, 0.00285D0, 0.00216D0,
55144 & 0.00162D0, 0.00120D0, 0.00089D0, 0.00065D0, 0.00048D0,
55145 & 0.00035D0, 0.00025D0, 0.00017D0, 0.00010D0, 0.00006D0,
55146 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
55147 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55148 DATA (FMRS(1,7,I,21),I=1,49)/
55149 & 3.99390D0, 2.97724D0, 2.21795D0, 1.86604D0, 1.65015D0,
55150 & 1.49961D0, 1.11138D0, 0.81834D0, 0.68051D0, 0.59480D0,
55151 & 0.53289D0, 0.37345D0, 0.25296D0, 0.19764D0, 0.16415D0,
55152 & 0.14119D0, 0.11109D0, 0.08457D0, 0.06032D0, 0.04645D0,
55153 & 0.03094D0, 0.02236D0, 0.01688D0, 0.01228D0, 0.00913D0,
55154 & 0.00687D0, 0.00519D0, 0.00392D0, 0.00296D0, 0.00223D0,
55155 & 0.00167D0, 0.00124D0, 0.00091D0, 0.00067D0, 0.00049D0,
55156 & 0.00036D0, 0.00025D0, 0.00017D0, 0.00010D0, 0.00006D0,
55157 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
55158 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55159 DATA (FMRS(1,7,I,22),I=1,49)/
55160 & 4.74104D0, 3.51318D0, 2.60162D0, 2.18119D0, 1.92405D0,
55161 & 1.74515D0, 1.28558D0, 0.94085D0, 0.77956D0, 0.67959D0,
55162 & 0.60758D0, 0.42298D0, 0.28453D0, 0.22138D0, 0.18331D0,
55163 & 0.15728D0, 0.12329D0, 0.09346D0, 0.06632D0, 0.05087D0,
55164 & 0.03366D0, 0.02418D0, 0.01815D0, 0.01313D0, 0.00971D0,
55165 & 0.00726D0, 0.00546D0, 0.00411D0, 0.00309D0, 0.00232D0,
55166 & 0.00172D0, 0.00128D0, 0.00094D0, 0.00068D0, 0.00049D0,
55167 & 0.00036D0, 0.00026D0, 0.00017D0, 0.00010D0, 0.00006D0,
55168 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
55169 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55170 DATA (FMRS(1,7,I,23),I=1,49)/
55171 & 5.50879D0, 4.05964D0, 2.98973D0, 2.49849D0, 2.19888D0,
55172 & 1.99086D0, 1.45844D0, 1.06135D0, 0.87646D0, 0.76222D0,
55173 & 0.68014D0, 0.47060D0, 0.31455D0, 0.24380D0, 0.20130D0,
55174 & 0.17233D0, 0.13462D0, 0.10166D0, 0.07179D0, 0.05486D0,
55175 & 0.03607D0, 0.02577D0, 0.01926D0, 0.01386D0, 0.01019D0,
55176 & 0.00758D0, 0.00568D0, 0.00425D0, 0.00318D0, 0.00238D0,
55177 & 0.00176D0, 0.00130D0, 0.00095D0, 0.00069D0, 0.00050D0,
55178 & 0.00037D0, 0.00026D0, 0.00017D0, 0.00010D0, 0.00006D0,
55179 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
55180 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55181 DATA (FMRS(1,7,I,24),I=1,49)/
55182 & 6.25919D0, 4.58931D0, 3.36270D0, 2.80183D0, 2.46064D0,
55183 & 2.22421D0, 1.62105D0, 1.17360D0, 0.96617D0, 0.83838D0,
55184 & 0.74677D0, 0.51381D0, 0.34143D0, 0.26369D0, 0.21716D0,
55185 & 0.18553D0, 0.14447D0, 0.10870D0, 0.07643D0, 0.05820D0,
55186 & 0.03805D0, 0.02705D0, 0.02012D0, 0.01441D0, 0.01054D0,
55187 & 0.00781D0, 0.00582D0, 0.00434D0, 0.00324D0, 0.00241D0,
55188 & 0.00178D0, 0.00131D0, 0.00095D0, 0.00069D0, 0.00050D0,
55189 & 0.00037D0, 0.00026D0, 0.00017D0, 0.00010D0, 0.00006D0,
55190 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
55191 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55192 DATA (FMRS(1,7,I,25),I=1,49)/
55193 & 7.07966D0, 5.16501D0, 3.76564D0, 3.12838D0, 2.74171D0,
55194 & 2.47426D0, 1.79422D0, 1.29235D0, 1.06071D0, 0.91840D0,
55195 & 0.81663D0, 0.55877D0, 0.36917D0, 0.28412D0, 0.23339D0,
55196 & 0.19900D0, 0.15447D0, 0.11582D0, 0.08108D0, 0.06153D0,
55197 & 0.03999D0, 0.02830D0, 0.02096D0, 0.01493D0, 0.01087D0,
55198 & 0.00803D0, 0.00595D0, 0.00442D0, 0.00329D0, 0.00244D0,
55199 & 0.00180D0, 0.00131D0, 0.00096D0, 0.00069D0, 0.00050D0,
55200 & 0.00036D0, 0.00026D0, 0.00017D0, 0.00010D0, 0.00006D0,
55201 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
55202 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55203 DATA (FMRS(1,7,I,26),I=1,49)/
55204 & 7.91829D0, 5.74916D0, 4.17141D0, 3.45573D0, 3.02255D0,
55205 & 2.72346D0, 1.96537D0, 1.40870D0, 1.15285D0, 0.99608D0,
55206 & 0.88421D0, 0.60182D0, 0.39541D0, 0.30330D0, 0.24854D0,
55207 & 0.21150D0, 0.16368D0, 0.12231D0, 0.08527D0, 0.06448D0,
55208 & 0.04169D0, 0.02937D0, 0.02165D0, 0.01535D0, 0.01113D0,
55209 & 0.00818D0, 0.00604D0, 0.00447D0, 0.00331D0, 0.00245D0,
55210 & 0.00180D0, 0.00131D0, 0.00095D0, 0.00068D0, 0.00049D0,
55211 & 0.00036D0, 0.00026D0, 0.00017D0, 0.00010D0, 0.00006D0,
55212 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
55213 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55214 DATA (FMRS(1,7,I,27),I=1,49)/
55215 & 8.76657D0, 6.33661D0, 4.57707D0, 3.78184D0, 3.30161D0,
55216 & 2.97059D0, 2.13403D0, 1.52261D0, 1.24269D0, 1.07161D0,
55217 & 0.94977D0, 0.64324D0, 0.42046D0, 0.32150D0, 0.26285D0,
55218 & 0.22328D0, 0.17230D0, 0.12835D0, 0.08912D0, 0.06719D0,
55219 & 0.04322D0, 0.03031D0, 0.02226D0, 0.01571D0, 0.01134D0,
55220 & 0.00830D0, 0.00611D0, 0.00451D0, 0.00333D0, 0.00245D0,
55221 & 0.00180D0, 0.00131D0, 0.00095D0, 0.00068D0, 0.00048D0,
55222 & 0.00036D0, 0.00026D0, 0.00017D0, 0.00010D0, 0.00006D0,
55223 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
55224 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55225 DATA (FMRS(1,7,I,28),I=1,49)/
55226 & 9.60252D0, 6.91204D0, 4.97199D0, 4.09813D0, 3.57154D0,
55227 & 3.20914D0, 2.29574D0, 1.63105D0, 1.32784D0, 1.14296D0,
55228 & 1.01154D0, 0.68194D0, 0.44362D0, 0.33823D0, 0.27595D0,
55229 & 0.23401D0, 0.18011D0, 0.13377D0, 0.09255D0, 0.06957D0,
55230 & 0.04454D0, 0.03111D0, 0.02277D0, 0.01600D0, 0.01150D0,
55231 & 0.00839D0, 0.00616D0, 0.00453D0, 0.00333D0, 0.00245D0,
55232 & 0.00179D0, 0.00130D0, 0.00094D0, 0.00067D0, 0.00048D0,
55233 & 0.00035D0, 0.00025D0, 0.00017D0, 0.00010D0, 0.00006D0,
55234 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
55235 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55236 DATA (FMRS(1,7,I,29),I=1,49)/
55237 & 10.48807D0, 7.51842D0, 5.38590D0, 4.42859D0, 3.85291D0,
55238 & 3.45734D0, 2.46302D0, 1.74255D0, 1.41507D0, 1.21586D0,
55239 & 1.07451D0, 0.72111D0, 0.46688D0, 0.35494D0, 0.28897D0,
55240 & 0.24464D0, 0.18781D0, 0.13908D0, 0.09587D0, 0.07187D0,
55241 & 0.04579D0, 0.03185D0, 0.02323D0, 0.01626D0, 0.01165D0,
55242 & 0.00847D0, 0.00619D0, 0.00454D0, 0.00333D0, 0.00244D0,
55243 & 0.00178D0, 0.00129D0, 0.00093D0, 0.00066D0, 0.00047D0,
55244 & 0.00035D0, 0.00025D0, 0.00017D0, 0.00010D0, 0.00006D0,
55245 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
55246 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55247 DATA (FMRS(1,7,I,30),I=1,49)/
55248 & 11.39334D0, 8.13482D0, 5.80422D0, 4.76138D0, 4.13555D0,
55249 & 3.70617D0, 2.62967D0, 1.85288D0, 1.50103D0, 1.28747D0,
55250 & 1.13621D0, 0.75917D0, 0.48927D0, 0.37093D0, 0.30137D0,
55251 & 0.25473D0, 0.19506D0, 0.14404D0, 0.09894D0, 0.07396D0,
55252 & 0.04691D0, 0.03251D0, 0.02363D0, 0.01647D0, 0.01175D0,
55253 & 0.00851D0, 0.00621D0, 0.00454D0, 0.00332D0, 0.00243D0,
55254 & 0.00176D0, 0.00127D0, 0.00091D0, 0.00065D0, 0.00046D0,
55255 & 0.00034D0, 0.00025D0, 0.00017D0, 0.00010D0, 0.00006D0,
55256 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
55257 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55258 DATA (FMRS(1,7,I,31),I=1,49)/
55259 & 12.30020D0, 8.74942D0, 6.21933D0, 5.09070D0, 4.41468D0,
55260 & 3.95152D0, 2.79315D0, 1.96055D0, 1.58465D0, 1.35697D0,
55261 & 1.19598D0, 0.79580D0, 0.51068D0, 0.38615D0, 0.31314D0,
55262 & 0.26427D0, 0.20189D0, 0.14868D0, 0.10179D0, 0.07589D0,
55263 & 0.04793D0, 0.03309D0, 0.02397D0, 0.01665D0, 0.01184D0,
55264 & 0.00855D0, 0.00621D0, 0.00453D0, 0.00330D0, 0.00241D0,
55265 & 0.00174D0, 0.00126D0, 0.00090D0, 0.00064D0, 0.00046D0,
55266 & 0.00034D0, 0.00025D0, 0.00017D0, 0.00010D0, 0.00006D0,
55267 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
55268 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55269 DATA (FMRS(1,7,I,32),I=1,49)/
55270 & 13.17835D0, 9.34137D0, 6.61692D0, 5.40505D0, 4.68045D0,
55271 & 4.18467D0, 2.94753D0, 2.06155D0, 1.66276D0, 1.42169D0,
55272 & 1.25150D0, 0.82954D0, 0.53019D0, 0.39993D0, 0.32374D0,
55273 & 0.27283D0, 0.20796D0, 0.15278D0, 0.10427D0, 0.07755D0,
55274 & 0.04878D0, 0.03356D0, 0.02424D0, 0.01677D0, 0.01189D0,
55275 & 0.00856D0, 0.00621D0, 0.00451D0, 0.00328D0, 0.00239D0,
55276 & 0.00173D0, 0.00124D0, 0.00089D0, 0.00063D0, 0.00045D0,
55277 & 0.00033D0, 0.00025D0, 0.00017D0, 0.00010D0, 0.00006D0,
55278 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
55279 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55280 DATA (FMRS(1,7,I,33),I=1,49)/
55281 & 14.12059D0, 9.97430D0, 7.04054D0, 5.73929D0, 4.96264D0,
55282 & 4.43195D0, 3.11069D0, 2.16791D0, 1.74484D0, 1.48959D0,
55283 & 1.30967D0, 0.86476D0, 0.55049D0, 0.41422D0, 0.33471D0,
55284 & 0.28168D0, 0.21423D0, 0.15699D0, 0.10682D0, 0.07925D0,
55285 & 0.04965D0, 0.03404D0, 0.02451D0, 0.01690D0, 0.01194D0,
55286 & 0.00857D0, 0.00620D0, 0.00449D0, 0.00326D0, 0.00237D0,
55287 & 0.00171D0, 0.00123D0, 0.00088D0, 0.00062D0, 0.00044D0,
55288 & 0.00032D0, 0.00025D0, 0.00017D0, 0.00010D0, 0.00006D0,
55289 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
55290 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55291 DATA (FMRS(1,7,I,34),I=1,49)/
55292 & 15.05309D0, 10.59701D0, 7.45476D0, 6.06488D0, 5.23678D0,
55293 & 4.67164D0, 3.26773D0, 2.26948D0, 1.82284D0, 1.55389D0,
55294 & 1.36460D0, 0.89767D0, 0.56921D0, 0.42730D0, 0.34468D0,
55295 & 0.28967D0, 0.21983D0, 0.16070D0, 0.10902D0, 0.08069D0,
55296 & 0.05036D0, 0.03441D0, 0.02470D0, 0.01698D0, 0.01196D0,
55297 & 0.00856D0, 0.00617D0, 0.00446D0, 0.00323D0, 0.00234D0,
55298 & 0.00168D0, 0.00121D0, 0.00086D0, 0.00061D0, 0.00043D0,
55299 & 0.00032D0, 0.00024D0, 0.00017D0, 0.00010D0, 0.00006D0,
55300 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
55301 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55302 DATA (FMRS(1,7,I,35),I=1,49)/
55303 & 15.99294D0, 11.22254D0, 7.86947D0, 6.39022D0, 5.51032D0,
55304 & 4.91055D0, 3.42373D0, 2.37005D0, 1.89992D0, 1.61733D0,
55305 & 1.41872D0, 0.92998D0, 0.58753D0, 0.44006D0, 0.35440D0,
55306 & 0.29744D0, 0.22527D0, 0.16430D0, 0.11114D0, 0.08207D0,
55307 & 0.05103D0, 0.03476D0, 0.02489D0, 0.01705D0, 0.01198D0,
55308 & 0.00855D0, 0.00615D0, 0.00444D0, 0.00321D0, 0.00232D0,
55309 & 0.00166D0, 0.00119D0, 0.00085D0, 0.00060D0, 0.00042D0,
55310 & 0.00031D0, 0.00024D0, 0.00017D0, 0.00010D0, 0.00006D0,
55311 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
55312 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55313 DATA (FMRS(1,7,I,36),I=1,49)/
55314 & 16.90825D0, 11.82917D0, 8.26989D0, 6.70353D0, 5.77324D0,
55315 & 5.13985D0, 3.57272D0, 2.46560D0, 1.97292D0, 1.67727D0,
55316 & 1.46976D0, 0.96025D0, 0.60456D0, 0.45187D0, 0.36334D0,
55317 & 0.30458D0, 0.23023D0, 0.16756D0, 0.11304D0, 0.08330D0,
55318 & 0.05162D0, 0.03506D0, 0.02503D0, 0.01710D0, 0.01198D0,
55319 & 0.00853D0, 0.00612D0, 0.00440D0, 0.00318D0, 0.00229D0,
55320 & 0.00164D0, 0.00117D0, 0.00083D0, 0.00059D0, 0.00042D0,
55321 & 0.00031D0, 0.00024D0, 0.00017D0, 0.00010D0, 0.00006D0,
55322 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
55323 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55324 DATA (FMRS(1,7,I,37),I=1,49)/
55325 & 17.85379D0, 12.45318D0, 8.67996D0, 7.02354D0, 6.04126D0,
55326 & 5.37323D0, 3.72362D0, 2.56187D0, 2.04622D0, 1.73730D0,
55327 & 1.52078D0, 0.99029D0, 0.62133D0, 0.46343D0, 0.37206D0,
55328 & 0.31151D0, 0.23502D0, 0.17068D0, 0.11483D0, 0.08444D0,
55329 & 0.05214D0, 0.03531D0, 0.02515D0, 0.01713D0, 0.01196D0,
55330 & 0.00850D0, 0.00608D0, 0.00437D0, 0.00315D0, 0.00226D0,
55331 & 0.00162D0, 0.00115D0, 0.00082D0, 0.00058D0, 0.00041D0,
55332 & 0.00030D0, 0.00024D0, 0.00017D0, 0.00010D0, 0.00006D0,
55333 & 0.00003D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
55334 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55335 DATA (FMRS(1,7,I,38),I=1,49)/
55336 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55337 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55338 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55339 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55340 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55341 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55342 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55343 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55344 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55345 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55346 DATA (FMRS(1,8,I, 1),I=1,49)/
55347 & 0.88043D0, 0.77333D0, 0.67888D0, 0.62888D0, 0.59555D0,
55348 & 0.57086D0, 0.50019D0, 0.43775D0, 0.40464D0, 0.38254D0,
55349 & 0.36610D0, 0.31885D0, 0.27689D0, 0.25464D0, 0.23989D0,
55350 & 0.22903D0, 0.21364D0, 0.19859D0, 0.18303D0, 0.17273D0,
55351 & 0.15826D0, 0.14656D0, 0.13527D0, 0.12062D0, 0.10522D0,
55352 & 0.08955D0, 0.07420D0, 0.05981D0, 0.04692D0, 0.03554D0,
55353 & 0.02630D0, 0.01878D0, 0.01298D0, 0.00870D0, 0.00554D0,
55354 & 0.00339D0, 0.00198D0, 0.00110D0, 0.00049D0, 0.00026D0,
55355 & 0.00012D0, 0.00002D0, 0.00002D0, 0.00000D0, -0.00001D0,
55356 & -0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
55357 DATA (FMRS(1,8,I, 2),I=1,49)/
55358 & 0.89442D0, 0.78714D0, 0.69235D0, 0.64208D0, 0.60853D0,
55359 & 0.58367D0, 0.51236D0, 0.44919D0, 0.41561D0, 0.39314D0,
55360 & 0.37639D0, 0.32808D0, 0.28485D0, 0.26176D0, 0.24637D0,
55361 & 0.23501D0, 0.21882D0, 0.20291D0, 0.18634D0, 0.17532D0,
55362 & 0.15979D0, 0.14730D0, 0.13538D0, 0.12014D0, 0.10435D0,
55363 & 0.08847D0, 0.07306D0, 0.05873D0, 0.04595D0, 0.03477D0,
55364 & 0.02571D0, 0.01837D0, 0.01273D0, 0.00855D0, 0.00550D0,
55365 & 0.00340D0, 0.00204D0, 0.00117D0, 0.00055D0, 0.00031D0,
55366 & 0.00017D0, 0.00006D0, 0.00005D0, 0.00001D0, 0.00000D0,
55367 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55368 DATA (FMRS(1,8,I, 3),I=1,49)/
55369 & 0.93116D0, 0.82082D0, 0.72315D0, 0.67127D0, 0.63662D0,
55370 & 0.61092D0, 0.53708D0, 0.47148D0, 0.43647D0, 0.41299D0,
55371 & 0.39541D0, 0.34450D0, 0.29850D0, 0.27374D0, 0.25714D0,
55372 & 0.24483D0, 0.22722D0, 0.20981D0, 0.19154D0, 0.17933D0,
55373 & 0.16210D0, 0.14837D0, 0.13550D0, 0.11937D0, 0.10300D0,
55374 & 0.08681D0, 0.07133D0, 0.05711D0, 0.04449D0, 0.03362D0,
55375 & 0.02480D0, 0.01774D0, 0.01234D0, 0.00831D0, 0.00539D0,
55376 & 0.00338D0, 0.00208D0, 0.00122D0, 0.00062D0, 0.00038D0,
55377 & 0.00022D0, 0.00010D0, 0.00007D0, 0.00002D0, 0.00001D0,
55378 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55379 DATA (FMRS(1,8,I, 4),I=1,49)/
55380 & 0.97222D0, 0.85703D0, 0.75505D0, 0.70088D0, 0.66470D0,
55381 & 0.63785D0, 0.56070D0, 0.49207D0, 0.45539D0, 0.43075D0,
55382 & 0.41225D0, 0.35857D0, 0.30984D0, 0.28350D0, 0.26581D0,
55383 & 0.25266D0, 0.23382D0, 0.21514D0, 0.19549D0, 0.18234D0,
55384 & 0.16379D0, 0.14912D0, 0.13552D0, 0.11873D0, 0.10198D0,
55385 & 0.08556D0, 0.07005D0, 0.05591D0, 0.04344D0, 0.03278D0,
55386 & 0.02413D0, 0.01727D0, 0.01201D0, 0.00813D0, 0.00530D0,
55387 & 0.00334D0, 0.00207D0, 0.00123D0, 0.00065D0, 0.00042D0,
55388 & 0.00025D0, 0.00012D0, 0.00009D0, 0.00002D0, 0.00002D0,
55389 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55390 DATA (FMRS(1,8,I, 5),I=1,49)/
55391 & 1.03488D0, 0.91080D0, 0.80113D0, 0.74294D0, 0.70410D0,
55392 & 0.67529D0, 0.59258D0, 0.51904D0, 0.47974D0, 0.45332D0,
55393 & 0.43343D0, 0.37573D0, 0.32325D0, 0.29486D0, 0.27577D0,
55394 & 0.26158D0, 0.24123D0, 0.22104D0, 0.19979D0, 0.18555D0,
55395 & 0.16552D0, 0.14984D0, 0.13548D0, 0.11801D0, 0.10084D0,
55396 & 0.08422D0, 0.06865D0, 0.05459D0, 0.04229D0, 0.03183D0,
55397 & 0.02342D0, 0.01674D0, 0.01163D0, 0.00790D0, 0.00517D0,
55398 & 0.00326D0, 0.00204D0, 0.00126D0, 0.00069D0, 0.00044D0,
55399 & 0.00027D0, 0.00014D0, 0.00010D0, 0.00004D0, 0.00001D0,
55400 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55401 DATA (FMRS(1,8,I, 6),I=1,49)/
55402 & 1.09976D0, 0.96588D0, 0.84779D0, 0.78524D0, 0.74353D0,
55403 & 0.71261D0, 0.62395D0, 0.54523D0, 0.50318D0, 0.47492D0,
55404 & 0.45362D0, 0.39183D0, 0.33563D0, 0.30525D0, 0.28482D0,
55405 & 0.26964D0, 0.24787D0, 0.22628D0, 0.20357D0, 0.18835D0,
55406 & 0.16700D0, 0.15043D0, 0.13540D0, 0.11734D0, 0.09983D0,
55407 & 0.08303D0, 0.06744D0, 0.05346D0, 0.04131D0, 0.03103D0,
55408 & 0.02280D0, 0.01628D0, 0.01131D0, 0.00768D0, 0.00506D0,
55409 & 0.00319D0, 0.00201D0, 0.00126D0, 0.00071D0, 0.00044D0,
55410 & 0.00028D0, 0.00015D0, 0.00010D0, 0.00005D0, 0.00001D0,
55411 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55412 DATA (FMRS(1,8,I, 7),I=1,49)/
55413 & 1.17764D0, 1.03108D0, 0.90223D0, 0.83415D0, 0.78882D0,
55414 & 0.75526D0, 0.65918D0, 0.57411D0, 0.52875D0, 0.49829D0,
55415 & 0.47532D0, 0.40880D0, 0.34842D0, 0.31585D0, 0.29397D0,
55416 & 0.27773D0, 0.25447D0, 0.23144D0, 0.20722D0, 0.19102D0,
55417 & 0.16837D0, 0.15091D0, 0.13525D0, 0.11665D0, 0.09880D0,
55418 & 0.08184D0, 0.06625D0, 0.05236D0, 0.04036D0, 0.03026D0,
55419 & 0.02219D0, 0.01583D0, 0.01099D0, 0.00745D0, 0.00494D0,
55420 & 0.00313D0, 0.00199D0, 0.00124D0, 0.00071D0, 0.00044D0,
55421 & 0.00028D0, 0.00014D0, 0.00011D0, 0.00005D0, 0.00001D0,
55422 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55423 DATA (FMRS(1,8,I, 8),I=1,49)/
55424 & 1.27508D0, 1.11188D0, 0.96899D0, 0.89374D0, 0.84374D0,
55425 & 0.80677D0, 0.70124D0, 0.60814D0, 0.55864D0, 0.52545D0,
55426 & 0.50042D0, 0.42815D0, 0.36279D0, 0.32765D0, 0.30409D0,
55427 & 0.28664D0, 0.26167D0, 0.23701D0, 0.21111D0, 0.19383D0,
55428 & 0.16977D0, 0.15136D0, 0.13503D0, 0.11586D0, 0.09768D0,
55429 & 0.08056D0, 0.06499D0, 0.05119D0, 0.03935D0, 0.02943D0,
55430 & 0.02154D0, 0.01534D0, 0.01065D0, 0.00723D0, 0.00480D0,
55431 & 0.00305D0, 0.00194D0, 0.00121D0, 0.00071D0, 0.00043D0,
55432 & 0.00029D0, 0.00014D0, 0.00011D0, 0.00005D0, 0.00001D0,
55433 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55434 DATA (FMRS(1,8,I, 9),I=1,49)/
55435 & 1.37316D0, 1.19249D0, 1.03498D0, 0.95232D0, 0.89751D0,
55436 & 0.85705D0, 0.74185D0, 0.64064D0, 0.58699D0, 0.55108D0,
55437 & 0.52402D0, 0.44610D0, 0.37594D0, 0.33836D0, 0.31323D0,
55438 & 0.29464D0, 0.26809D0, 0.24193D0, 0.21452D0, 0.19627D0,
55439 & 0.17094D0, 0.15171D0, 0.13480D0, 0.11515D0, 0.09667D0,
55440 & 0.07946D0, 0.06388D0, 0.05018D0, 0.03847D0, 0.02871D0,
55441 & 0.02099D0, 0.01493D0, 0.01036D0, 0.00705D0, 0.00466D0,
55442 & 0.00297D0, 0.00189D0, 0.00119D0, 0.00071D0, 0.00043D0,
55443 & 0.00029D0, 0.00015D0, 0.00010D0, 0.00005D0, 0.00002D0,
55444 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55445 DATA (FMRS(1,8,I,10),I=1,49)/
55446 & 1.48232D0, 1.28141D0, 1.10710D0, 1.01596D0, 0.95567D0,
55447 & 0.91125D0, 0.78516D0, 0.67489D0, 0.61664D0, 0.57774D0,
55448 & 0.54846D0, 0.46445D0, 0.38919D0, 0.34906D0, 0.32230D0,
55449 & 0.30254D0, 0.27439D0, 0.24670D0, 0.21778D0, 0.19857D0,
55450 & 0.17201D0, 0.15198D0, 0.13451D0, 0.11441D0, 0.09567D0,
55451 & 0.07837D0, 0.06280D0, 0.04920D0, 0.03762D0, 0.02802D0,
55452 & 0.02045D0, 0.01454D0, 0.01009D0, 0.00685D0, 0.00453D0,
55453 & 0.00289D0, 0.00185D0, 0.00117D0, 0.00069D0, 0.00044D0,
55454 & 0.00029D0, 0.00015D0, 0.00011D0, 0.00004D0, 0.00002D0,
55455 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55456 DATA (FMRS(1,8,I,11),I=1,49)/
55457 & 1.57825D0, 1.35904D0, 1.16962D0, 1.07091D0, 1.00575D0,
55458 & 0.95780D0, 0.82207D0, 0.70384D0, 0.64159D0, 0.60009D0,
55459 & 0.56890D0, 0.47964D0, 0.40007D0, 0.35779D0, 0.32966D0,
55460 & 0.30893D0, 0.27945D0, 0.25052D0, 0.22036D0, 0.20038D0,
55461 & 0.17283D0, 0.15216D0, 0.13426D0, 0.11380D0, 0.09487D0,
55462 & 0.07750D0, 0.06195D0, 0.04843D0, 0.03696D0, 0.02748D0,
55463 & 0.02002D0, 0.01423D0, 0.00988D0, 0.00669D0, 0.00443D0,
55464 & 0.00283D0, 0.00181D0, 0.00116D0, 0.00068D0, 0.00044D0,
55465 & 0.00028D0, 0.00016D0, 0.00011D0, 0.00004D0, 0.00001D0,
55466 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55467 DATA (FMRS(1,8,I,12),I=1,49)/
55468 & 1.81391D0, 1.54794D0, 1.32027D0, 1.20251D0, 1.12515D0,
55469 & 1.06843D0, 0.90882D0, 0.77111D0, 0.69913D0, 0.65138D0,
55470 & 0.61560D0, 0.51392D0, 0.42424D0, 0.37702D0, 0.34578D0,
55471 & 0.32285D0, 0.29039D0, 0.25868D0, 0.22580D0, 0.20412D0,
55472 & 0.17445D0, 0.15244D0, 0.13361D0, 0.11242D0, 0.09312D0,
55473 & 0.07561D0, 0.06012D0, 0.04679D0, 0.03556D0, 0.02636D0,
55474 & 0.01913D0, 0.01356D0, 0.00940D0, 0.00637D0, 0.00422D0,
55475 & 0.00270D0, 0.00172D0, 0.00112D0, 0.00066D0, 0.00042D0,
55476 & 0.00027D0, 0.00016D0, 0.00011D0, 0.00004D0, 0.00001D0,
55477 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55478 DATA (FMRS(1,8,I,13),I=1,49)/
55479 & 2.05224D0, 1.73683D0, 1.46916D0, 1.33169D0, 1.24177D0,
55480 & 1.17604D0, 0.99216D0, 0.83488D0, 0.75325D0, 0.69933D0,
55481 & 0.65905D0, 0.54532D0, 0.44603D0, 0.39419D0, 0.36006D0,
55482 & 0.33511D0, 0.29992D0, 0.26571D0, 0.23041D0, 0.20724D0,
55483 & 0.17571D0, 0.15255D0, 0.13296D0, 0.11116D0, 0.09157D0,
55484 & 0.07397D0, 0.05855D0, 0.04538D0, 0.03436D0, 0.02540D0,
55485 & 0.01839D0, 0.01299D0, 0.00900D0, 0.00610D0, 0.00403D0,
55486 & 0.00259D0, 0.00165D0, 0.00107D0, 0.00064D0, 0.00040D0,
55487 & 0.00027D0, 0.00015D0, 0.00011D0, 0.00004D0, 0.00001D0,
55488 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55489 DATA (FMRS(1,8,I,14),I=1,49)/
55490 & 2.36037D0, 1.97834D0, 1.65740D0, 1.49390D0, 1.38749D0,
55491 & 1.31001D0, 1.09465D0, 0.91231D0, 0.81846D0, 0.75678D0,
55492 & 0.71089D0, 0.58224D0, 0.47125D0, 0.41385D0, 0.37630D0,
55493 & 0.34896D0, 0.31058D0, 0.27348D0, 0.23541D0, 0.21054D0,
55494 & 0.17694D0, 0.15252D0, 0.13212D0, 0.10968D0, 0.08980D0,
55495 & 0.07213D0, 0.05680D0, 0.04381D0, 0.03304D0, 0.02434D0,
55496 & 0.01758D0, 0.01241D0, 0.00857D0, 0.00582D0, 0.00382D0,
55497 & 0.00247D0, 0.00159D0, 0.00103D0, 0.00060D0, 0.00038D0,
55498 & 0.00026D0, 0.00014D0, 0.00011D0, 0.00004D0, 0.00001D0,
55499 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55500 DATA (FMRS(1,8,I,15),I=1,49)/
55501 & 2.73224D0, 2.26638D0, 1.87922D0, 1.68367D0, 1.55710D0,
55502 & 1.46530D0, 1.21194D0, 0.99975D0, 0.89148D0, 0.82073D0,
55503 & 0.76831D0, 0.62250D0, 0.49828D0, 0.43470D0, 0.39338D0,
55504 & 0.36342D0, 0.32158D0, 0.28138D0, 0.24036D0, 0.21374D0,
55505 & 0.17800D0, 0.15230D0, 0.13108D0, 0.10804D0, 0.08789D0,
55506 & 0.07017D0, 0.05499D0, 0.04222D0, 0.03170D0, 0.02325D0,
55507 & 0.01673D0, 0.01178D0, 0.00810D0, 0.00551D0, 0.00361D0,
55508 & 0.00232D0, 0.00150D0, 0.00098D0, 0.00058D0, 0.00036D0,
55509 & 0.00025D0, 0.00014D0, 0.00010D0, 0.00004D0, 0.00001D0,
55510 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55511 DATA (FMRS(1,8,I,16),I=1,49)/
55512 & 3.11511D0, 2.55975D0, 2.10267D0, 1.87361D0, 1.72607D0,
55513 & 1.61945D0, 1.32704D0, 1.08455D0, 0.96180D0, 0.88200D0,
55514 & 0.82308D0, 0.66038D0, 0.52333D0, 0.45384D0, 0.40893D0,
55515 & 0.37652D0, 0.33144D0, 0.28836D0, 0.24465D0, 0.21643D0,
55516 & 0.17877D0, 0.15196D0, 0.13002D0, 0.10649D0, 0.08613D0,
55517 & 0.06841D0, 0.05335D0, 0.04078D0, 0.03051D0, 0.02230D0,
55518 & 0.01601D0, 0.01123D0, 0.00772D0, 0.00522D0, 0.00344D0,
55519 & 0.00221D0, 0.00143D0, 0.00094D0, 0.00056D0, 0.00035D0,
55520 & 0.00023D0, 0.00014D0, 0.00009D0, 0.00004D0, 0.00001D0,
55521 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55522 DATA (FMRS(1,8,I,17),I=1,49)/
55523 & 3.54920D0, 2.88904D0, 2.35096D0, 2.08340D0, 1.91191D0,
55524 & 1.78843D0, 1.45191D0, 1.17555D0, 1.03678D0, 0.94701D0,
55525 & 0.88099D0, 0.69993D0, 0.54914D0, 0.47339D0, 0.42472D0,
55526 & 0.38973D0, 0.34130D0, 0.29525D0, 0.24881D0, 0.21897D0,
55527 & 0.17941D0, 0.15149D0, 0.12887D0, 0.10488D0, 0.08433D0,
55528 & 0.06664D0, 0.05172D0, 0.03936D0, 0.02933D0, 0.02138D0,
55529 & 0.01531D0, 0.01070D0, 0.00735D0, 0.00494D0, 0.00327D0,
55530 & 0.00210D0, 0.00135D0, 0.00089D0, 0.00053D0, 0.00034D0,
55531 & 0.00022D0, 0.00013D0, 0.00009D0, 0.00004D0, 0.00001D0,
55532 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55533 DATA (FMRS(1,8,I,18),I=1,49)/
55534 & 3.94722D0, 3.18825D0, 2.57451D0, 2.27128D0, 2.07769D0,
55535 & 1.93872D0, 1.56191D0, 1.25495D0, 1.10181D0, 1.00316D0,
55536 & 0.93081D0, 0.73357D0, 0.57081D0, 0.48966D0, 0.43777D0,
55537 & 0.40060D0, 0.34934D0, 0.30080D0, 0.25209D0, 0.22090D0,
55538 & 0.17980D0, 0.15100D0, 0.12785D0, 0.10349D0, 0.08283D0,
55539 & 0.06518D0, 0.05037D0, 0.03822D0, 0.02839D0, 0.02063D0,
55540 & 0.01472D0, 0.01026D0, 0.00705D0, 0.00475D0, 0.00313D0,
55541 & 0.00200D0, 0.00129D0, 0.00084D0, 0.00049D0, 0.00033D0,
55542 & 0.00020D0, 0.00013D0, 0.00009D0, 0.00003D0, 0.00001D0,
55543 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55544 DATA (FMRS(1,8,I,19),I=1,49)/
55545 & 4.47623D0, 3.58243D0, 2.86642D0, 2.51532D0, 2.29224D0,
55546 & 2.13264D0, 1.70256D0, 1.35552D0, 1.18371D0, 1.07357D0,
55547 & 0.99309D0, 0.77516D0, 0.59726D0, 0.50937D0, 0.45348D0,
55548 & 0.41360D0, 0.35886D0, 0.30730D0, 0.25582D0, 0.22304D0,
55549 & 0.18010D0, 0.15028D0, 0.12653D0, 0.10177D0, 0.08099D0,
55550 & 0.06341D0, 0.04879D0, 0.03686D0, 0.02728D0, 0.01973D0,
55551 & 0.01404D0, 0.00977D0, 0.00668D0, 0.00449D0, 0.00295D0,
55552 & 0.00189D0, 0.00122D0, 0.00079D0, 0.00046D0, 0.00031D0,
55553 & 0.00019D0, 0.00011D0, 0.00008D0, 0.00003D0, 0.00001D0,
55554 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55555 DATA (FMRS(1,8,I,20),I=1,49)/
55556 & 4.99213D0, 3.96349D0, 3.14614D0, 2.74797D0, 2.49601D0,
55557 & 2.31631D0, 1.83458D0, 1.44905D0, 1.25946D0, 1.13844D0,
55558 & 1.05027D0, 0.81294D0, 0.62102D0, 0.52694D0, 0.46740D0,
55559 & 0.42508D0, 0.36719D0, 0.31292D0, 0.25900D0, 0.22482D0,
55560 & 0.18028D0, 0.14958D0, 0.12531D0, 0.10024D0, 0.07938D0,
55561 & 0.06186D0, 0.04742D0, 0.03568D0, 0.02633D0, 0.01896D0,
55562 & 0.01347D0, 0.00937D0, 0.00636D0, 0.00427D0, 0.00280D0,
55563 & 0.00180D0, 0.00116D0, 0.00076D0, 0.00045D0, 0.00029D0,
55564 & 0.00019D0, 0.00009D0, 0.00007D0, 0.00003D0, 0.00001D0,
55565 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55566 DATA (FMRS(1,8,I,21),I=1,49)/
55567 & 5.49949D0, 4.33534D0, 3.41695D0, 2.97216D0, 2.69173D0,
55568 & 2.49225D0, 1.96002D0, 1.53717D0, 1.33047D0, 1.19901D0,
55569 & 1.10350D0, 0.84773D0, 0.64263D0, 0.54279D0, 0.47988D0,
55570 & 0.43530D0, 0.37453D0, 0.31778D0, 0.26166D0, 0.22622D0,
55571 & 0.18027D0, 0.14882D0, 0.12412D0, 0.09878D0, 0.07788D0,
55572 & 0.06045D0, 0.04618D0, 0.03463D0, 0.02546D0, 0.01831D0,
55573 & 0.01296D0, 0.00899D0, 0.00611D0, 0.00409D0, 0.00268D0,
55574 & 0.00172D0, 0.00111D0, 0.00073D0, 0.00045D0, 0.00028D0,
55575 & 0.00018D0, 0.00010D0, 0.00007D0, 0.00003D0, 0.00001D0,
55576 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55577 DATA (FMRS(1,8,I,22),I=1,49)/
55578 & 6.19994D0, 4.84455D0, 3.78480D0, 3.27524D0, 2.95541D0,
55579 & 2.72867D0, 2.12718D0, 1.65361D0, 1.42381D0, 1.27834D0,
55580 & 1.17300D0, 0.89272D0, 0.67027D0, 0.56291D0, 0.49563D0,
55581 & 0.44814D0, 0.38367D0, 0.32378D0, 0.26487D0, 0.22786D0,
55582 & 0.18016D0, 0.14778D0, 0.12256D0, 0.09693D0, 0.07601D0,
55583 & 0.05870D0, 0.04463D0, 0.03333D0, 0.02440D0, 0.01750D0,
55584 & 0.01234D0, 0.00854D0, 0.00580D0, 0.00388D0, 0.00253D0,
55585 & 0.00162D0, 0.00104D0, 0.00069D0, 0.00042D0, 0.00026D0,
55586 & 0.00018D0, 0.00010D0, 0.00006D0, 0.00003D0, 0.00001D0,
55587 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55588 DATA (FMRS(1,8,I,23),I=1,49)/
55589 & 6.91850D0, 5.36248D0, 4.15576D0, 3.57933D0, 3.21903D0,
55590 & 2.96436D0, 2.29236D0, 1.76765D0, 1.51472D0, 1.35530D0,
55591 & 1.24020D0, 0.93576D0, 0.69640D0, 0.58179D0, 0.51031D0,
55592 & 0.46004D0, 0.39207D0, 0.32922D0, 0.26771D0, 0.22925D0,
55593 & 0.17994D0, 0.14672D0, 0.12105D0, 0.09521D0, 0.07427D0,
55594 & 0.05708D0, 0.04320D0, 0.03213D0, 0.02345D0, 0.01676D0,
55595 & 0.01179D0, 0.00813D0, 0.00551D0, 0.00368D0, 0.00240D0,
55596 & 0.00152D0, 0.00099D0, 0.00064D0, 0.00039D0, 0.00024D0,
55597 & 0.00017D0, 0.00009D0, 0.00006D0, 0.00003D0, 0.00001D0,
55598 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55599 DATA (FMRS(1,8,I,24),I=1,49)/
55600 & 7.63491D0, 5.87479D0, 4.51976D0, 3.87632D0, 3.47562D0,
55601 & 3.19317D0, 2.45140D0, 1.87649D0, 1.60104D0, 1.42808D0,
55602 & 1.30355D0, 0.97589D0, 0.72045D0, 0.59900D0, 0.52360D0,
55603 & 0.47074D0, 0.39952D0, 0.33394D0, 0.27005D0, 0.23029D0,
55604 & 0.17956D0, 0.14561D0, 0.11956D0, 0.09355D0, 0.07262D0,
55605 & 0.05557D0, 0.04190D0, 0.03105D0, 0.02258D0, 0.01609D0,
55606 & 0.01128D0, 0.00777D0, 0.00525D0, 0.00350D0, 0.00227D0,
55607 & 0.00145D0, 0.00095D0, 0.00060D0, 0.00036D0, 0.00023D0,
55608 & 0.00015D0, 0.00008D0, 0.00006D0, 0.00003D0, 0.00001D0,
55609 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55610 DATA (FMRS(1,8,I,25),I=1,49)/
55611 & 8.40875D0, 6.42416D0, 4.90727D0, 4.19114D0, 3.74679D0,
55612 & 3.43441D0, 2.61784D0, 1.98954D0, 1.69029D0, 1.50308D0,
55613 & 1.36865D0, 1.01677D0, 0.74472D0, 0.61626D0, 0.53686D0,
55614 & 0.48138D0, 0.40687D0, 0.33856D0, 0.27230D0, 0.23124D0,
55615 & 0.17912D0, 0.14448D0, 0.11807D0, 0.09190D0, 0.07100D0,
55616 & 0.05410D0, 0.04063D0, 0.03001D0, 0.02174D0, 0.01545D0,
55617 & 0.01080D0, 0.00742D0, 0.00500D0, 0.00332D0, 0.00215D0,
55618 & 0.00138D0, 0.00091D0, 0.00056D0, 0.00034D0, 0.00022D0,
55619 & 0.00014D0, 0.00008D0, 0.00005D0, 0.00002D0, 0.00001D0,
55620 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55621 DATA (FMRS(1,8,I,26),I=1,49)/
55622 & 9.20959D0, 6.98865D0, 5.30257D0, 4.51092D0, 4.02140D0,
55623 & 3.67813D0, 2.78472D0, 2.10201D0, 1.77866D0, 1.57708D0,
55624 & 1.43269D0, 1.05659D0, 0.76808D0, 0.63273D0, 0.54942D0,
55625 & 0.49139D0, 0.41371D0, 0.34277D0, 0.27426D0, 0.23197D0,
55626 & 0.17855D0, 0.14327D0, 0.11656D0, 0.09025D0, 0.06944D0,
55627 & 0.05268D0, 0.03941D0, 0.02899D0, 0.02094D0, 0.01485D0,
55628 & 0.01035D0, 0.00708D0, 0.00476D0, 0.00316D0, 0.00205D0,
55629 & 0.00131D0, 0.00085D0, 0.00054D0, 0.00031D0, 0.00021D0,
55630 & 0.00013D0, 0.00008D0, 0.00005D0, 0.00002D0, 0.00001D0,
55631 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55632 DATA (FMRS(1,8,I,27),I=1,49)/
55633 & 10.01660D0, 7.55374D0, 5.69567D0, 4.82767D0, 4.29265D0,
55634 & 3.91834D0, 2.94808D0, 2.21134D0, 1.86419D0, 1.64848D0,
55635 & 1.49433D0, 1.09459D0, 0.79015D0, 0.64820D0, 0.56116D0,
55636 & 0.50070D0, 0.42001D0, 0.34660D0, 0.27598D0, 0.23256D0,
55637 & 0.17794D0, 0.14210D0, 0.11511D0, 0.08871D0, 0.06797D0,
55638 & 0.05137D0, 0.03829D0, 0.02806D0, 0.02022D0, 0.01430D0,
55639 & 0.00994D0, 0.00679D0, 0.00455D0, 0.00301D0, 0.00196D0,
55640 & 0.00124D0, 0.00081D0, 0.00052D0, 0.00030D0, 0.00020D0,
55641 & 0.00013D0, 0.00008D0, 0.00005D0, 0.00002D0, 0.00001D0,
55642 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55643 DATA (FMRS(1,8,I,28),I=1,49)/
55644 & 10.81622D0, 8.11020D0, 6.08037D0, 5.13653D0, 4.55643D0,
55645 & 4.15146D0, 3.10560D0, 2.31605D0, 1.94577D0, 1.71637D0,
55646 & 1.55278D0, 1.13032D0, 0.81070D0, 0.66250D0, 0.57195D0,
55647 & 0.50921D0, 0.42571D0, 0.35000D0, 0.27744D0, 0.23299D0,
55648 & 0.17730D0, 0.14094D0, 0.11373D0, 0.08726D0, 0.06658D0,
55649 & 0.05015D0, 0.03725D0, 0.02723D0, 0.01957D0, 0.01380D0,
55650 & 0.00957D0, 0.00653D0, 0.00437D0, 0.00288D0, 0.00188D0,
55651 & 0.00119D0, 0.00077D0, 0.00050D0, 0.00029D0, 0.00019D0,
55652 & 0.00012D0, 0.00007D0, 0.00005D0, 0.00002D0, 0.00001D0,
55653 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55654 DATA (FMRS(1,8,I,29),I=1,49)/
55655 & 11.66230D0, 8.69558D0, 6.48269D0, 5.45841D0, 4.83067D0,
55656 & 4.39335D0, 3.26805D0, 2.42336D0, 2.02906D0, 1.78549D0,
55657 & 1.61215D0, 1.16634D0, 0.83123D0, 0.67669D0, 0.58260D0,
55658 & 0.51757D0, 0.43126D0, 0.35327D0, 0.27879D0, 0.23332D0,
55659 & 0.17659D0, 0.13975D0, 0.11233D0, 0.08581D0, 0.06521D0,
55660 & 0.04895D0, 0.03623D0, 0.02642D0, 0.01893D0, 0.01332D0,
55661 & 0.00922D0, 0.00628D0, 0.00420D0, 0.00276D0, 0.00179D0,
55662 & 0.00113D0, 0.00073D0, 0.00048D0, 0.00028D0, 0.00018D0,
55663 & 0.00012D0, 0.00007D0, 0.00004D0, 0.00001D0, 0.00001D0,
55664 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55665 DATA (FMRS(1,8,I,30),I=1,49)/
55666 & 12.53147D0, 9.29349D0, 6.89124D0, 5.78416D0, 5.10752D0,
55667 & 4.63707D0, 3.43073D0, 2.53015D0, 2.11162D0, 1.85381D0,
55668 & 1.67070D0, 1.20157D0, 0.85112D0, 0.69035D0, 0.59278D0,
55669 & 0.52552D0, 0.43648D0, 0.35628D0, 0.27996D0, 0.23352D0,
55670 & 0.17581D0, 0.13853D0, 0.11093D0, 0.08439D0, 0.06389D0,
55671 & 0.04778D0, 0.03525D0, 0.02563D0, 0.01832D0, 0.01286D0,
55672 & 0.00888D0, 0.00603D0, 0.00403D0, 0.00265D0, 0.00171D0,
55673 & 0.00109D0, 0.00070D0, 0.00046D0, 0.00026D0, 0.00017D0,
55674 & 0.00011D0, 0.00006D0, 0.00004D0, 0.00001D0, 0.00000D0,
55675 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55676 DATA (FMRS(1,8,I,31),I=1,49)/
55677 & 13.39986D0, 9.88770D0, 7.29509D0, 6.10513D0, 5.37969D0,
55678 & 4.87627D0, 3.58951D0, 2.63377D0, 2.19145D0, 1.91971D0,
55679 & 1.72706D0, 1.23525D0, 0.86997D0, 0.70322D0, 0.60234D0,
55680 & 0.53296D0, 0.44131D0, 0.35903D0, 0.28099D0, 0.23364D0,
55681 & 0.17503D0, 0.13736D0, 0.10960D0, 0.08305D0, 0.06264D0,
55682 & 0.04669D0, 0.03435D0, 0.02491D0, 0.01775D0, 0.01244D0,
55683 & 0.00857D0, 0.00581D0, 0.00387D0, 0.00255D0, 0.00164D0,
55684 & 0.00105D0, 0.00067D0, 0.00044D0, 0.00025D0, 0.00016D0,
55685 & 0.00011D0, 0.00006D0, 0.00004D0, 0.00002D0, 0.00000D0,
55686 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55687 DATA (FMRS(1,8,I,32),I=1,49)/
55688 & 14.24690D0, 10.46430D0, 7.68491D0, 6.41400D0, 5.64102D0,
55689 & 5.10551D0, 3.74084D0, 2.73196D0, 2.26682D0, 1.98174D0,
55690 & 1.77998D0, 1.26662D0, 0.88736D0, 0.71501D0, 0.61103D0,
55691 & 0.53966D0, 0.44562D0, 0.36142D0, 0.28180D0, 0.23363D0,
55692 & 0.17423D0, 0.13620D0, 0.10832D0, 0.08177D0, 0.06147D0,
55693 & 0.04567D0, 0.03352D0, 0.02425D0, 0.01724D0, 0.01204D0,
55694 & 0.00828D0, 0.00559D0, 0.00373D0, 0.00245D0, 0.00158D0,
55695 & 0.00099D0, 0.00065D0, 0.00042D0, 0.00024D0, 0.00015D0,
55696 & 0.00010D0, 0.00006D0, 0.00004D0, 0.00002D0, 0.00000D0,
55697 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55698 DATA (FMRS(1,8,I,33),I=1,49)/
55699 & 15.14936D0, 11.07583D0, 8.09647D0, 6.73922D0, 5.91564D0,
55700 & 5.34608D0, 3.89891D0, 2.83403D0, 2.34496D0, 2.04593D0,
55701 & 1.83464D0, 1.29886D0, 0.90513D0, 0.72701D0, 0.61986D0,
55702 & 0.54647D0, 0.44998D0, 0.36383D0, 0.28262D0, 0.23362D0,
55703 & 0.17343D0, 0.13505D0, 0.10704D0, 0.08050D0, 0.06032D0,
55704 & 0.04468D0, 0.03270D0, 0.02360D0, 0.01675D0, 0.01165D0,
55705 & 0.00800D0, 0.00538D0, 0.00360D0, 0.00236D0, 0.00153D0,
55706 & 0.00094D0, 0.00062D0, 0.00040D0, 0.00024D0, 0.00014D0,
55707 & 0.00010D0, 0.00005D0, 0.00004D0, 0.00002D0, 0.00000D0,
55708 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55709 DATA (FMRS(1,8,I,34),I=1,49)/
55710 & 16.05264D0, 11.68476D0, 8.50413D0, 7.06033D0, 6.18619D0,
55711 & 5.58264D0, 4.05344D0, 2.93321D0, 2.42057D0, 2.10785D0,
55712 & 1.88726D0, 1.32960D0, 0.92187D0, 0.73821D0, 0.62802D0,
55713 & 0.55270D0, 0.45389D0, 0.36590D0, 0.28320D0, 0.23345D0,
55714 & 0.17251D0, 0.13385D0, 0.10575D0, 0.07924D0, 0.05918D0,
55715 & 0.04371D0, 0.03189D0, 0.02297D0, 0.01625D0, 0.01129D0,
55716 & 0.00773D0, 0.00520D0, 0.00346D0, 0.00227D0, 0.00146D0,
55717 & 0.00090D0, 0.00059D0, 0.00038D0, 0.00022D0, 0.00014D0,
55718 & 0.00009D0, 0.00005D0, 0.00004D0, 0.00001D0, 0.00000D0,
55719 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55720 DATA (FMRS(1,8,I,35),I=1,49)/
55721 & 16.95831D0, 12.29275D0, 8.90942D0, 7.37879D0, 6.45402D0,
55722 & 5.81651D0, 4.20556D0, 3.03041D0, 2.49449D0, 2.16827D0,
55723 & 1.93852D0, 1.35941D0, 0.93802D0, 0.74899D0, 0.63586D0,
55724 & 0.55868D0, 0.45763D0, 0.36787D0, 0.28375D0, 0.23328D0,
55725 & 0.17165D0, 0.13272D0, 0.10453D0, 0.07807D0, 0.05811D0,
55726 & 0.04281D0, 0.03114D0, 0.02238D0, 0.01579D0, 0.01096D0,
55727 & 0.00748D0, 0.00503D0, 0.00334D0, 0.00218D0, 0.00141D0,
55728 & 0.00087D0, 0.00056D0, 0.00036D0, 0.00021D0, 0.00013D0,
55729 & 0.00009D0, 0.00005D0, 0.00004D0, 0.00001D0, 0.00000D0,
55730 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55731 DATA (FMRS(1,8,I,36),I=1,49)/
55732 & 17.84218D0, 12.88352D0, 9.30151D0, 7.68607D0, 6.71197D0,
55733 & 6.04141D0, 4.35117D0, 3.12299D0, 2.56467D0, 2.22550D0,
55734 & 1.98697D0, 1.38741D0, 0.95307D0, 0.75895D0, 0.64306D0,
55735 & 0.56414D0, 0.46100D0, 0.36960D0, 0.28418D0, 0.23305D0,
55736 & 0.17079D0, 0.13162D0, 0.10337D0, 0.07695D0, 0.05711D0,
55737 & 0.04196D0, 0.03045D0, 0.02184D0, 0.01537D0, 0.01065D0,
55738 & 0.00725D0, 0.00488D0, 0.00323D0, 0.00211D0, 0.00135D0,
55739 & 0.00084D0, 0.00054D0, 0.00035D0, 0.00020D0, 0.00012D0,
55740 & 0.00009D0, 0.00005D0, 0.00003D0, 0.00001D0, 0.00000D0,
55741 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55742 DATA (FMRS(1,8,I,37),I=1,49)/
55743 & 18.75837D0, 13.49331D0, 9.70449D0, 8.00107D0, 6.97591D0,
55744 & 6.27121D0, 4.49926D0, 3.21668D0, 2.63548D0, 2.28312D0,
55745 & 2.03566D0, 1.41534D0, 0.96795D0, 0.76874D0, 0.65009D0,
55746 & 0.56943D0, 0.46423D0, 0.37122D0, 0.28450D0, 0.23274D0,
55747 & 0.16989D0, 0.13050D0, 0.10219D0, 0.07583D0, 0.05612D0,
55748 & 0.04112D0, 0.02978D0, 0.02129D0, 0.01496D0, 0.01035D0,
55749 & 0.00703D0, 0.00473D0, 0.00312D0, 0.00203D0, 0.00130D0,
55750 & 0.00081D0, 0.00052D0, 0.00034D0, 0.00019D0, 0.00012D0,
55751 & 0.00008D0, 0.00005D0, 0.00003D0, 0.00001D0, 0.00000D0,
55752 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55753 DATA (FMRS(1,8,I,38),I=1,49)/
55754 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55755 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55756 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55757 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55758 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55759 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55760 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55761 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55762 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
55763 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
55764 DATA (FMRS(2,1,I, 1),I=1,49)/
55765 & 0.01616D0, 0.01968D0, 0.02397D0, 0.02690D0, 0.02921D0,
55766 & 0.03113D0, 0.03797D0, 0.04639D0, 0.05222D0, 0.05685D0,
55767 & 0.06076D0, 0.07508D0, 0.09409D0, 0.10852D0, 0.12095D0,
55768 & 0.13220D0, 0.15265D0, 0.18041D0, 0.22265D0, 0.26180D0,
55769 & 0.33338D0, 0.39710D0, 0.45318D0, 0.51262D0, 0.56037D0,
55770 & 0.59685D0, 0.62256D0, 0.63820D0, 0.64458D0, 0.64218D0,
55771 & 0.63256D0, 0.61605D0, 0.59381D0, 0.56668D0, 0.53544D0,
55772 & 0.50113D0, 0.46441D0, 0.42608D0, 0.38703D0, 0.34764D0,
55773 & 0.30873D0, 0.27101D0, 0.23457D0, 0.16829D0, 0.11224D0,
55774 & 0.06802D0, 0.03588D0, 0.00449D0, 0.00000D0/
55775 DATA (FMRS(2,1,I, 2),I=1,49)/
55776 & 0.01632D0, 0.01989D0, 0.02423D0, 0.02721D0, 0.02954D0,
55777 & 0.03149D0, 0.03843D0, 0.04698D0, 0.05290D0, 0.05761D0,
55778 & 0.06159D0, 0.07621D0, 0.09566D0, 0.11046D0, 0.12320D0,
55779 & 0.13473D0, 0.15566D0, 0.18401D0, 0.22694D0, 0.26649D0,
55780 & 0.33826D0, 0.40154D0, 0.45671D0, 0.51456D0, 0.56041D0,
55781 & 0.59481D0, 0.61838D0, 0.63191D0, 0.63628D0, 0.63211D0,
55782 & 0.62085D0, 0.60298D0, 0.57964D0, 0.55165D0, 0.51988D0,
55783 & 0.48526D0, 0.44851D0, 0.41042D0, 0.37182D0, 0.33308D0,
55784 & 0.29500D0, 0.25823D0, 0.22287D0, 0.15893D0, 0.10532D0,
55785 & 0.06336D0, 0.03315D0, 0.00405D0, 0.00000D0/
55786 DATA (FMRS(2,1,I, 3),I=1,49)/
55787 & 0.01657D0, 0.02020D0, 0.02463D0, 0.02767D0, 0.03005D0,
55788 & 0.03204D0, 0.03912D0, 0.04786D0, 0.05393D0, 0.05876D0,
55789 & 0.06285D0, 0.07791D0, 0.09803D0, 0.11338D0, 0.12658D0,
55790 & 0.13853D0, 0.16018D0, 0.18937D0, 0.23326D0, 0.27335D0,
55791 & 0.34527D0, 0.40778D0, 0.46152D0, 0.51696D0, 0.55995D0,
55792 & 0.59126D0, 0.61170D0, 0.62221D0, 0.62369D0, 0.61697D0,
55793 & 0.60343D0, 0.58371D0, 0.55889D0, 0.52978D0, 0.49735D0,
55794 & 0.46237D0, 0.42568D0, 0.38804D0, 0.35014D0, 0.31246D0,
55795 & 0.27562D0, 0.24027D0, 0.20650D0, 0.14595D0, 0.09580D0,
55796 & 0.05701D0, 0.02946D0, 0.00347D0, 0.00000D0/
55797 DATA (FMRS(2,1,I, 4),I=1,49)/
55798 & 0.01676D0, 0.02044D0, 0.02493D0, 0.02801D0, 0.03042D0,
55799 & 0.03244D0, 0.03964D0, 0.04852D0, 0.05470D0, 0.05962D0,
55800 & 0.06379D0, 0.07918D0, 0.09980D0, 0.11554D0, 0.12909D0,
55801 & 0.14134D0, 0.16349D0, 0.19329D0, 0.23784D0, 0.27828D0,
55802 & 0.35023D0, 0.41207D0, 0.46471D0, 0.51833D0, 0.55923D0,
55803 & 0.58830D0, 0.60648D0, 0.61486D0, 0.61433D0, 0.60584D0,
55804 & 0.59072D0, 0.56980D0, 0.54398D0, 0.51418D0, 0.48131D0,
55805 & 0.44619D0, 0.40966D0, 0.37236D0, 0.33505D0, 0.29814D0,
55806 & 0.26220D0, 0.22791D0, 0.19528D0, 0.13713D0, 0.08936D0,
55807 & 0.05277D0, 0.02703D0, 0.00310D0, 0.00000D0/
55808 DATA (FMRS(2,1,I, 5),I=1,49)/
55809 & 0.01695D0, 0.02068D0, 0.02524D0, 0.02837D0, 0.03082D0,
55810 & 0.03287D0, 0.04018D0, 0.04922D0, 0.05552D0, 0.06053D0,
55811 & 0.06480D0, 0.08053D0, 0.10168D0, 0.11784D0, 0.13174D0,
55812 & 0.14430D0, 0.16698D0, 0.19737D0, 0.24257D0, 0.28331D0,
55813 & 0.35517D0, 0.41625D0, 0.46767D0, 0.51932D0, 0.55801D0,
55814 & 0.58472D0, 0.60061D0, 0.60677D0, 0.60420D0, 0.59394D0,
55815 & 0.57732D0, 0.55511D0, 0.52831D0, 0.49795D0, 0.46473D0,
55816 & 0.42958D0, 0.39324D0, 0.35636D0, 0.31976D0, 0.28363D0,
55817 & 0.24869D0, 0.21549D0, 0.18405D0, 0.12838D0, 0.08307D0,
55818 & 0.04866D0, 0.02468D0, 0.00276D0, 0.00000D0/
55819 DATA (FMRS(2,1,I, 6),I=1,49)/
55820 & 0.01712D0, 0.02090D0, 0.02552D0, 0.02868D0, 0.03117D0,
55821 & 0.03325D0, 0.04066D0, 0.04984D0, 0.05623D0, 0.06133D0,
55822 & 0.06568D0, 0.08172D0, 0.10333D0, 0.11984D0, 0.13405D0,
55823 & 0.14688D0, 0.17001D0, 0.20090D0, 0.24663D0, 0.28761D0,
55824 & 0.35934D0, 0.41972D0, 0.47004D0, 0.51998D0, 0.55675D0,
55825 & 0.58145D0, 0.59540D0, 0.59970D0, 0.59545D0, 0.58373D0,
55826 & 0.56587D0, 0.54263D0, 0.51509D0, 0.48426D0, 0.45082D0,
55827 & 0.41570D0, 0.37956D0, 0.34309D0, 0.30710D0, 0.27167D0,
55828 & 0.23758D0, 0.20532D0, 0.17488D0, 0.12129D0, 0.07799D0,
55829 & 0.04537D0, 0.02283D0, 0.00249D0, 0.00000D0/
55830 DATA (FMRS(2,1,I, 7),I=1,49)/
55831 & 0.01728D0, 0.02111D0, 0.02578D0, 0.02899D0, 0.03151D0,
55832 & 0.03361D0, 0.04113D0, 0.05044D0, 0.05693D0, 0.06211D0,
55833 & 0.06653D0, 0.08287D0, 0.10492D0, 0.12178D0, 0.13628D0,
55834 & 0.14936D0, 0.17290D0, 0.20425D0, 0.25045D0, 0.29164D0,
55835 & 0.36316D0, 0.42280D0, 0.47203D0, 0.52030D0, 0.55522D0,
55836 & 0.57804D0, 0.59016D0, 0.59271D0, 0.58692D0, 0.57390D0,
55837 & 0.55488D0, 0.53075D0, 0.50265D0, 0.47135D0, 0.43776D0,
55838 & 0.40267D0, 0.36679D0, 0.33078D0, 0.29535D0, 0.26064D0,
55839 & 0.22735D0, 0.19600D0, 0.16649D0, 0.11484D0, 0.07339D0,
55840 & 0.04241D0, 0.02117D0, 0.00226D0, 0.00000D0/
55841 DATA (FMRS(2,1,I, 8),I=1,49)/
55842 & 0.01745D0, 0.02133D0, 0.02606D0, 0.02931D0, 0.03187D0,
55843 & 0.03400D0, 0.04163D0, 0.05108D0, 0.05768D0, 0.06295D0,
55844 & 0.06745D0, 0.08411D0, 0.10662D0, 0.12385D0, 0.13865D0,
55845 & 0.15200D0, 0.17596D0, 0.20780D0, 0.25445D0, 0.29582D0,
55846 & 0.36707D0, 0.42589D0, 0.47392D0, 0.52041D0, 0.55338D0,
55847 & 0.57422D0, 0.58442D0, 0.58519D0, 0.57783D0, 0.56344D0,
55848 & 0.54329D0, 0.51831D0, 0.48960D0, 0.45793D0, 0.42423D0,
55849 & 0.38922D0, 0.35366D0, 0.31814D0, 0.28333D0, 0.24940D0,
55850 & 0.21696D0, 0.18656D0, 0.15803D0, 0.10837D0, 0.06882D0,
55851 & 0.03949D0, 0.01956D0, 0.00204D0, 0.00000D0/
55852 DATA (FMRS(2,1,I, 9),I=1,49)/
55853 & 0.01760D0, 0.02152D0, 0.02631D0, 0.02960D0, 0.03218D0,
55854 & 0.03434D0, 0.04207D0, 0.05164D0, 0.05833D0, 0.06368D0,
55855 & 0.06825D0, 0.08519D0, 0.10811D0, 0.12566D0, 0.14073D0,
55856 & 0.15430D0, 0.17863D0, 0.21087D0, 0.25789D0, 0.29938D0,
55857 & 0.37036D0, 0.42844D0, 0.47541D0, 0.52034D0, 0.55162D0,
55858 & 0.57077D0, 0.57932D0, 0.57861D0, 0.56993D0, 0.55438D0,
55859 & 0.53332D0, 0.50767D0, 0.47844D0, 0.44653D0, 0.41277D0,
55860 & 0.37787D0, 0.34261D0, 0.30753D0, 0.27327D0, 0.24001D0,
55861 & 0.20832D0, 0.17873D0, 0.15102D0, 0.10304D0, 0.06508D0,
55862 & 0.03712D0, 0.01826D0, 0.00186D0, 0.00000D0/
55863 DATA (FMRS(2,1,I,10),I=1,49)/
55864 & 0.01775D0, 0.02171D0, 0.02655D0, 0.02988D0, 0.03249D0,
55865 & 0.03468D0, 0.04249D0, 0.05219D0, 0.05897D0, 0.06440D0,
55866 & 0.06904D0, 0.08625D0, 0.10956D0, 0.12741D0, 0.14273D0,
55867 & 0.15651D0, 0.18119D0, 0.21379D0, 0.26115D0, 0.30273D0,
55868 & 0.37339D0, 0.43070D0, 0.47663D0, 0.52004D0, 0.54971D0,
55869 & 0.56723D0, 0.57424D0, 0.57214D0, 0.56221D0, 0.54564D0,
55870 & 0.52375D0, 0.49748D0, 0.46783D0, 0.43572D0, 0.40192D0,
55871 & 0.36718D0, 0.33221D0, 0.29755D0, 0.26385D0, 0.23124D0,
55872 & 0.20028D0, 0.17145D0, 0.14454D0, 0.09813D0, 0.06166D0,
55873 & 0.03497D0, 0.01708D0, 0.00171D0, 0.00000D0/
55874 DATA (FMRS(2,1,I,11),I=1,49)/
55875 & 0.01786D0, 0.02185D0, 0.02674D0, 0.03010D0, 0.03274D0,
55876 & 0.03494D0, 0.04284D0, 0.05263D0, 0.05949D0, 0.06497D0,
55877 & 0.06967D0, 0.08709D0, 0.11072D0, 0.12880D0, 0.14432D0,
55878 & 0.15827D0, 0.18322D0, 0.21609D0, 0.26371D0, 0.30535D0,
55879 & 0.37572D0, 0.43240D0, 0.47751D0, 0.51970D0, 0.54811D0,
55880 & 0.56435D0, 0.57017D0, 0.56701D0, 0.55612D0, 0.53878D0,
55881 & 0.51626D0, 0.48950D0, 0.45957D0, 0.42732D0, 0.39351D0,
55882 & 0.35893D0, 0.32420D0, 0.28986D0, 0.25663D0, 0.22452D0,
55883 & 0.19414D0, 0.16588D0, 0.13961D0, 0.09442D0, 0.05909D0,
55884 & 0.03336D0, 0.01621D0, 0.00160D0, 0.00000D0/
55885 DATA (FMRS(2,1,I,12),I=1,49)/
55886 & 0.01811D0, 0.02217D0, 0.02715D0, 0.03057D0, 0.03326D0,
55887 & 0.03551D0, 0.04357D0, 0.05358D0, 0.06059D0, 0.06620D0,
55888 & 0.07102D0, 0.08890D0, 0.11320D0, 0.13179D0, 0.14772D0,
55889 & 0.16201D0, 0.18751D0, 0.22095D0, 0.26905D0, 0.31076D0,
55890 & 0.38043D0, 0.43573D0, 0.47902D0, 0.51865D0, 0.54434D0,
55891 & 0.55794D0, 0.56131D0, 0.55592D0, 0.54308D0, 0.52418D0,
55892 & 0.50041D0, 0.47277D0, 0.44227D0, 0.40979D0, 0.37605D0,
55893 & 0.34185D0, 0.30765D0, 0.27411D0, 0.24188D0, 0.21085D0,
55894 & 0.18166D0, 0.15463D0, 0.12966D0, 0.08698D0, 0.05397D0,
55895 & 0.03017D0, 0.01449D0, 0.00138D0, 0.00000D0/
55896 DATA (FMRS(2,1,I,13),I=1,49)/
55897 & 0.01832D0, 0.02245D0, 0.02751D0, 0.03099D0, 0.03372D0,
55898 & 0.03601D0, 0.04421D0, 0.05440D0, 0.06155D0, 0.06727D0,
55899 & 0.07220D0, 0.09048D0, 0.11535D0, 0.13437D0, 0.15065D0,
55900 & 0.16524D0, 0.19119D0, 0.22510D0, 0.27356D0, 0.31528D0,
55901 & 0.38427D0, 0.43832D0, 0.48002D0, 0.51742D0, 0.54081D0,
55902 & 0.55220D0, 0.55352D0, 0.54629D0, 0.53189D0, 0.51174D0,
55903 & 0.48699D0, 0.45870D0, 0.42778D0, 0.39517D0, 0.36159D0,
55904 & 0.32774D0, 0.29406D0, 0.26124D0, 0.22984D0, 0.19975D0,
55905 & 0.17155D0, 0.14556D0, 0.12166D0, 0.08107D0, 0.04993D0,
55906 & 0.02767D0, 0.01316D0, 0.00122D0, 0.00000D0/
55907 DATA (FMRS(2,1,I,14),I=1,49)/
55908 & 0.01856D0, 0.02276D0, 0.02791D0, 0.03145D0, 0.03424D0,
55909 & 0.03657D0, 0.04493D0, 0.05533D0, 0.06263D0, 0.06849D0,
55910 & 0.07353D0, 0.09227D0, 0.11778D0, 0.13727D0, 0.15393D0,
55911 & 0.16884D0, 0.19528D0, 0.22966D0, 0.27847D0, 0.32014D0,
55912 & 0.38833D0, 0.44089D0, 0.48079D0, 0.51572D0, 0.53660D0,
55913 & 0.54555D0, 0.54466D0, 0.53550D0, 0.51948D0, 0.49806D0,
55914 & 0.47232D0, 0.44337D0, 0.41209D0, 0.37941D0, 0.34606D0,
55915 & 0.31264D0, 0.27962D0, 0.24761D0, 0.21707D0, 0.18804D0,
55916 & 0.16093D0, 0.13609D0, 0.11331D0, 0.07496D0, 0.04577D0,
55917 & 0.02513D0, 0.01183D0, 0.00106D0, 0.00000D0/
55918 DATA (FMRS(2,1,I,15),I=1,49)/
55919 & 0.01882D0, 0.02309D0, 0.02833D0, 0.03194D0, 0.03478D0,
55920 & 0.03716D0, 0.04569D0, 0.05632D0, 0.06378D0, 0.06977D0,
55921 & 0.07493D0, 0.09414D0, 0.12031D0, 0.14028D0, 0.15732D0,
55922 & 0.17254D0, 0.19946D0, 0.23430D0, 0.28337D0, 0.32492D0,
55923 & 0.39212D0, 0.44309D0, 0.48109D0, 0.51344D0, 0.53176D0,
55924 & 0.53830D0, 0.53520D0, 0.52410D0, 0.50654D0, 0.48389D0,
55925 & 0.45725D0, 0.42772D0, 0.39621D0, 0.36351D0, 0.33050D0,
55926 & 0.29757D0, 0.26525D0, 0.23404D0, 0.20451D0, 0.17653D0,
55927 & 0.15059D0, 0.12691D0, 0.10526D0, 0.06909D0, 0.04183D0,
55928 & 0.02276D0, 0.01059D0, 0.00092D0, 0.00000D0/
55929 DATA (FMRS(2,1,I,16),I=1,49)/
55930 & 0.01904D0, 0.02338D0, 0.02872D0, 0.03239D0, 0.03528D0,
55931 & 0.03770D0, 0.04639D0, 0.05722D0, 0.06483D0, 0.07094D0,
55932 & 0.07621D0, 0.09585D0, 0.12261D0, 0.14301D0, 0.16039D0,
55933 & 0.17588D0, 0.20321D0, 0.23842D0, 0.28769D0, 0.32908D0,
55934 & 0.39530D0, 0.44481D0, 0.48105D0, 0.51110D0, 0.52712D0,
55935 & 0.53155D0, 0.52655D0, 0.51382D0, 0.49491D0, 0.47126D0,
55936 & 0.44390D0, 0.41395D0, 0.38228D0, 0.34968D0, 0.31695D0,
55937 & 0.28453D0, 0.25288D0, 0.22245D0, 0.19380D0, 0.16677D0,
55938 & 0.14180D0, 0.11912D0, 0.09847D0, 0.06418D0, 0.03856D0,
55939 & 0.02081D0, 0.00959D0, 0.00081D0, 0.00000D0/
55940 DATA (FMRS(2,1,I,17),I=1,49)/
55941 & 0.01928D0, 0.02369D0, 0.02911D0, 0.03284D0, 0.03578D0,
55942 & 0.03825D0, 0.04709D0, 0.05813D0, 0.06589D0, 0.07213D0,
55943 & 0.07751D0, 0.09758D0, 0.12493D0, 0.14576D0, 0.16348D0,
55944 & 0.17924D0, 0.20696D0, 0.24251D0, 0.29193D0, 0.33312D0,
55945 & 0.39831D0, 0.44629D0, 0.48077D0, 0.50852D0, 0.52228D0,
55946 & 0.52463D0, 0.51781D0, 0.50355D0, 0.48335D0, 0.45879D0,
55947 & 0.43078D0, 0.40049D0, 0.36872D0, 0.33629D0, 0.30386D0,
55948 & 0.27197D0, 0.24101D0, 0.21137D0, 0.18360D0, 0.15751D0,
55949 & 0.13349D0, 0.11178D0, 0.09210D0, 0.05961D0, 0.03555D0,
55950 & 0.01901D0, 0.00868D0, 0.00071D0, 0.00000D0/
55951 DATA (FMRS(2,1,I,18),I=1,49)/
55952 & 0.01947D0, 0.02394D0, 0.02943D0, 0.03322D0, 0.03621D0,
55953 & 0.03871D0, 0.04769D0, 0.05889D0, 0.06678D0, 0.07312D0,
55954 & 0.07860D0, 0.09903D0, 0.12687D0, 0.14804D0, 0.16603D0,
55955 & 0.18199D0, 0.21002D0, 0.24583D0, 0.29534D0, 0.33632D0,
55956 & 0.40060D0, 0.44729D0, 0.48029D0, 0.50614D0, 0.51810D0,
55957 & 0.51876D0, 0.51049D0, 0.49502D0, 0.47387D0, 0.44861D0,
55958 & 0.42013D0, 0.38960D0, 0.35780D0, 0.32553D0, 0.29342D0,
55959 & 0.26197D0, 0.23158D0, 0.20258D0, 0.17557D0, 0.15022D0,
55960 & 0.12699D0, 0.10608D0, 0.08715D0, 0.05607D0, 0.03324D0,
55961 & 0.01765D0, 0.00799D0, 0.00064D0, 0.00000D0/
55962 DATA (FMRS(2,1,I,19),I=1,49)/
55963 & 0.01970D0, 0.02424D0, 0.02983D0, 0.03369D0, 0.03672D0,
55964 & 0.03927D0, 0.04841D0, 0.05983D0, 0.06787D0, 0.07433D0,
55965 & 0.07993D0, 0.10079D0, 0.12921D0, 0.15080D0, 0.16909D0,
55966 & 0.18531D0, 0.21368D0, 0.24977D0, 0.29932D0, 0.34002D0,
55967 & 0.40312D0, 0.44820D0, 0.47944D0, 0.50301D0, 0.51281D0,
55968 & 0.51154D0, 0.50156D0, 0.48470D0, 0.46252D0, 0.43645D0,
55969 & 0.40748D0, 0.37672D0, 0.34495D0, 0.31293D0, 0.28123D0,
55970 & 0.25036D0, 0.22064D0, 0.19244D0, 0.16630D0, 0.14187D0,
55971 & 0.11955D0, 0.09954D0, 0.08152D0, 0.05209D0, 0.03065D0,
55972 & 0.01614D0, 0.00723D0, 0.00056D0, 0.00000D0/
55973 DATA (FMRS(2,1,I,20),I=1,49)/
55974 & 0.01991D0, 0.02452D0, 0.03019D0, 0.03410D0, 0.03718D0,
55975 & 0.03977D0, 0.04905D0, 0.06066D0, 0.06884D0, 0.07541D0,
55976 & 0.08111D0, 0.10235D0, 0.13129D0, 0.15323D0, 0.17180D0,
55977 & 0.18822D0, 0.21689D0, 0.25320D0, 0.30276D0, 0.34318D0,
55978 & 0.40521D0, 0.44885D0, 0.47855D0, 0.50013D0, 0.50806D0,
55979 & 0.50515D0, 0.49374D0, 0.47571D0, 0.45269D0, 0.42596D0,
55980 & 0.39662D0, 0.36569D0, 0.33399D0, 0.30222D0, 0.27090D0,
55981 & 0.24056D0, 0.21144D0, 0.18393D0, 0.15855D0, 0.13491D0,
55982 & 0.11336D0, 0.09413D0, 0.07687D0, 0.04883D0, 0.02854D0,
55983 & 0.01493D0, 0.00663D0, 0.00051D0, 0.00000D0/
55984 DATA (FMRS(2,1,I,21),I=1,49)/
55985 & 0.02011D0, 0.02477D0, 0.03051D0, 0.03448D0, 0.03760D0,
55986 & 0.04023D0, 0.04965D0, 0.06143D0, 0.06973D0, 0.07641D0,
55987 & 0.08220D0, 0.10379D0, 0.13319D0, 0.15544D0, 0.17424D0,
55988 & 0.19085D0, 0.21976D0, 0.25625D0, 0.30577D0, 0.34590D0,
55989 & 0.40689D0, 0.44921D0, 0.47746D0, 0.49725D0, 0.50352D0,
55990 & 0.49914D0, 0.48649D0, 0.46748D0, 0.44367D0, 0.41645D0,
55991 & 0.38678D0, 0.35582D0, 0.32417D0, 0.29264D0, 0.26169D0,
55992 & 0.23187D0, 0.20335D0, 0.17646D0, 0.15176D0, 0.12881D0,
55993 & 0.10798D0, 0.08943D0, 0.07284D0, 0.04602D0, 0.02675D0,
55994 & 0.01389D0, 0.00613D0, 0.00046D0, 0.00000D0/
55995 DATA (FMRS(2,1,I,22),I=1,49)/
55996 & 0.02035D0, 0.02509D0, 0.03093D0, 0.03496D0, 0.03814D0,
55997 & 0.04081D0, 0.05040D0, 0.06241D0, 0.07087D0, 0.07768D0,
55998 & 0.08359D0, 0.10562D0, 0.13559D0, 0.15824D0, 0.17734D0,
55999 & 0.19417D0, 0.22338D0, 0.26006D0, 0.30949D0, 0.34920D0,
56000 & 0.40885D0, 0.44948D0, 0.47592D0, 0.49348D0, 0.49770D0,
56001 & 0.49152D0, 0.47736D0, 0.45716D0, 0.43246D0, 0.40467D0,
56002 & 0.37468D0, 0.34367D0, 0.31217D0, 0.28097D0, 0.25052D0,
56003 & 0.22133D0, 0.19355D0, 0.16747D0, 0.14359D0, 0.12150D0,
56004 & 0.10155D0, 0.08384D0, 0.06806D0, 0.04272D0, 0.02464D0,
56005 & 0.01269D0, 0.00554D0, 0.00040D0, 0.00000D0/
56006 DATA (FMRS(2,1,I,23),I=1,49)/
56007 & 0.02058D0, 0.02539D0, 0.03132D0, 0.03542D0, 0.03865D0,
56008 & 0.04137D0, 0.05112D0, 0.06333D0, 0.07195D0, 0.07888D0,
56009 & 0.08490D0, 0.10735D0, 0.13786D0, 0.16087D0, 0.18023D0,
56010 & 0.19726D0, 0.22673D0, 0.26356D0, 0.31287D0, 0.35216D0,
56011 & 0.41052D0, 0.44953D0, 0.47430D0, 0.48980D0, 0.49215D0,
56012 & 0.48435D0, 0.46885D0, 0.44758D0, 0.42215D0, 0.39387D0,
56013 & 0.36366D0, 0.33261D0, 0.30132D0, 0.27045D0, 0.24050D0,
56014 & 0.21190D0, 0.18476D0, 0.15947D0, 0.13635D0, 0.11504D0,
56015 & 0.09587D0, 0.07894D0, 0.06387D0, 0.03984D0, 0.02282D0,
56016 & 0.01167D0, 0.00505D0, 0.00036D0, 0.00000D0/
56017 DATA (FMRS(2,1,I,24),I=1,49)/
56018 & 0.02080D0, 0.02568D0, 0.03170D0, 0.03585D0, 0.03914D0,
56019 & 0.04189D0, 0.05180D0, 0.06421D0, 0.07296D0, 0.08001D0,
56020 & 0.08614D0, 0.10897D0, 0.13997D0, 0.16330D0, 0.18290D0,
56021 & 0.20010D0, 0.22978D0, 0.26672D0, 0.31586D0, 0.35473D0,
56022 & 0.41182D0, 0.44931D0, 0.47248D0, 0.48612D0, 0.48676D0,
56023 & 0.47750D0, 0.46081D0, 0.43866D0, 0.41258D0, 0.38389D0,
56024 & 0.35352D0, 0.32245D0, 0.29140D0, 0.26089D0, 0.23143D0,
56025 & 0.20340D0, 0.17690D0, 0.15229D0, 0.12990D0, 0.10931D0,
56026 & 0.09084D0, 0.07461D0, 0.06021D0, 0.03734D0, 0.02125D0,
56027 & 0.01078D0, 0.00462D0, 0.00032D0, 0.00000D0/
56028 DATA (FMRS(2,1,I,25),I=1,49)/
56029 & 0.02102D0, 0.02596D0, 0.03207D0, 0.03629D0, 0.03962D0,
56030 & 0.04242D0, 0.05248D0, 0.06508D0, 0.07398D0, 0.08115D0,
56031 & 0.08738D0, 0.11059D0, 0.14207D0, 0.16573D0, 0.18556D0,
56032 & 0.20292D0, 0.23281D0, 0.26985D0, 0.31879D0, 0.35722D0,
56033 & 0.41303D0, 0.44900D0, 0.47060D0, 0.48240D0, 0.48138D0,
56034 & 0.47074D0, 0.45292D0, 0.42993D0, 0.40324D0, 0.37421D0,
56035 & 0.34370D0, 0.31266D0, 0.28186D0, 0.25172D0, 0.22275D0,
56036 & 0.19528D0, 0.16943D0, 0.14547D0, 0.12379D0, 0.10391D0,
56037 & 0.08611D0, 0.07055D0, 0.05678D0, 0.03501D0, 0.01980D0,
56038 & 0.00997D0, 0.00424D0, 0.00029D0, 0.00000D0/
56039 DATA (FMRS(2,1,I,26),I=1,49)/
56040 & 0.02124D0, 0.02625D0, 0.03244D0, 0.03672D0, 0.04010D0,
56041 & 0.04294D0, 0.05315D0, 0.06595D0, 0.07499D0, 0.08227D0,
56042 & 0.08860D0, 0.11218D0, 0.14413D0, 0.16809D0, 0.18813D0,
56043 & 0.20564D0, 0.23571D0, 0.27281D0, 0.32152D0, 0.35948D0,
56044 & 0.41398D0, 0.44847D0, 0.46857D0, 0.47858D0, 0.47599D0,
56045 & 0.46404D0, 0.44519D0, 0.42139D0, 0.39420D0, 0.36490D0,
56046 & 0.33431D0, 0.30337D0, 0.27282D0, 0.24304D0, 0.21455D0,
56047 & 0.18765D0, 0.16244D0, 0.13911D0, 0.11808D0, 0.09890D0,
56048 & 0.08174D0, 0.06681D0, 0.05361D0, 0.03286D0, 0.01847D0,
56049 & 0.00924D0, 0.00390D0, 0.00026D0, 0.00000D0/
56050 DATA (FMRS(2,1,I,27),I=1,49)/
56051 & 0.02145D0, 0.02652D0, 0.03279D0, 0.03713D0, 0.04055D0,
56052 & 0.04343D0, 0.05378D0, 0.06677D0, 0.07594D0, 0.08333D0,
56053 & 0.08975D0, 0.11368D0, 0.14607D0, 0.17031D0, 0.19054D0,
56054 & 0.20819D0, 0.23841D0, 0.27555D0, 0.32402D0, 0.36153D0,
56055 & 0.41478D0, 0.44786D0, 0.46655D0, 0.47490D0, 0.47088D0,
56056 & 0.45773D0, 0.43795D0, 0.41346D0, 0.38583D0, 0.35628D0,
56057 & 0.32564D0, 0.29483D0, 0.26454D0, 0.23512D0, 0.20709D0,
56058 & 0.18074D0, 0.15610D0, 0.13337D0, 0.11295D0, 0.09439D0,
56059 & 0.07783D0, 0.06346D0, 0.05079D0, 0.03096D0, 0.01730D0,
56060 & 0.00860D0, 0.00360D0, 0.00023D0, 0.00000D0/
56061 DATA (FMRS(2,1,I,28),I=1,49)/
56062 & 0.02164D0, 0.02677D0, 0.03312D0, 0.03751D0, 0.04098D0,
56063 & 0.04390D0, 0.05439D0, 0.06755D0, 0.07684D0, 0.08433D0,
56064 & 0.09084D0, 0.11510D0, 0.14789D0, 0.17239D0, 0.19279D0,
56065 & 0.21056D0, 0.24091D0, 0.27806D0, 0.32630D0, 0.36334D0,
56066 & 0.41540D0, 0.44716D0, 0.46451D0, 0.47135D0, 0.46602D0,
56067 & 0.45177D0, 0.43117D0, 0.40606D0, 0.37805D0, 0.34829D0,
56068 & 0.31763D0, 0.28699D0, 0.25693D0, 0.22788D0, 0.20031D0,
56069 & 0.17447D0, 0.15036D0, 0.12818D0, 0.10834D0, 0.09032D0,
56070 & 0.07432D0, 0.06046D0, 0.04827D0, 0.02929D0, 0.01628D0,
56071 & 0.00804D0, 0.00334D0, 0.00021D0, 0.00000D0/
56072 DATA (FMRS(2,1,I,29),I=1,49)/
56073 & 0.02184D0, 0.02703D0, 0.03346D0, 0.03790D0, 0.04142D0,
56074 & 0.04437D0, 0.05500D0, 0.06833D0, 0.07775D0, 0.08534D0,
56075 & 0.09195D0, 0.11653D0, 0.14972D0, 0.17447D0, 0.19503D0,
56076 & 0.21292D0, 0.24339D0, 0.28054D0, 0.32851D0, 0.36507D0,
56077 & 0.41592D0, 0.44635D0, 0.46240D0, 0.46773D0, 0.46111D0,
56078 & 0.44581D0, 0.42442D0, 0.39875D0, 0.37037D0, 0.34044D0,
56079 & 0.30980D0, 0.27932D0, 0.24952D0, 0.22085D0, 0.19375D0,
56080 & 0.16840D0, 0.14482D0, 0.12320D0, 0.10392D0, 0.08643D0,
56081 & 0.07097D0, 0.05759D0, 0.04588D0, 0.02770D0, 0.01531D0,
56082 & 0.00752D0, 0.00311D0, 0.00019D0, 0.00000D0/
56083 DATA (FMRS(2,1,I,30),I=1,49)/
56084 & 0.02204D0, 0.02729D0, 0.03379D0, 0.03829D0, 0.04185D0,
56085 & 0.04484D0, 0.05560D0, 0.06911D0, 0.07865D0, 0.08634D0,
56086 & 0.09303D0, 0.11793D0, 0.15151D0, 0.17649D0, 0.19722D0,
56087 & 0.21521D0, 0.24577D0, 0.28291D0, 0.33057D0, 0.36667D0,
56088 & 0.41631D0, 0.44543D0, 0.46021D0, 0.46408D0, 0.45622D0,
56089 & 0.43995D0, 0.41780D0, 0.39163D0, 0.36293D0, 0.33287D0,
56090 & 0.30229D0, 0.27195D0, 0.24246D0, 0.21416D0, 0.18750D0,
56091 & 0.16265D0, 0.13957D0, 0.11850D0, 0.09976D0, 0.08278D0,
56092 & 0.06783D0, 0.05492D0, 0.04366D0, 0.02623D0, 0.01442D0,
56093 & 0.00705D0, 0.00289D0, 0.00017D0, 0.00000D0/
56094 DATA (FMRS(2,1,I,31),I=1,49)/
56095 & 0.02222D0, 0.02753D0, 0.03410D0, 0.03866D0, 0.04226D0,
56096 & 0.04528D0, 0.05617D0, 0.06985D0, 0.07951D0, 0.08729D0,
56097 & 0.09407D0, 0.11927D0, 0.15320D0, 0.17841D0, 0.19928D0,
56098 & 0.21737D0, 0.24802D0, 0.28513D0, 0.33249D0, 0.36812D0,
56099 & 0.41660D0, 0.44449D0, 0.45808D0, 0.46059D0, 0.45160D0,
56100 & 0.43442D0, 0.41159D0, 0.38497D0, 0.35599D0, 0.32584D0,
56101 & 0.29532D0, 0.26514D0, 0.23594D0, 0.20800D0, 0.18176D0,
56102 & 0.15738D0, 0.13478D0, 0.11421D0, 0.09597D0, 0.07947D0,
56103 & 0.06498D0, 0.05251D0, 0.04166D0, 0.02491D0, 0.01363D0,
56104 & 0.00662D0, 0.00270D0, 0.00016D0, 0.00000D0/
56105 DATA (FMRS(2,1,I,32),I=1,49)/
56106 & 0.02240D0, 0.02776D0, 0.03441D0, 0.03901D0, 0.04265D0,
56107 & 0.04571D0, 0.05672D0, 0.07055D0, 0.08032D0, 0.08819D0,
56108 & 0.09505D0, 0.12053D0, 0.15480D0, 0.18021D0, 0.20120D0,
56109 & 0.21937D0, 0.25009D0, 0.28716D0, 0.33421D0, 0.36938D0,
56110 & 0.41675D0, 0.44346D0, 0.45593D0, 0.45721D0, 0.44717D0,
56111 & 0.42917D0, 0.40572D0, 0.37869D0, 0.34947D0, 0.31928D0,
56112 & 0.28882D0, 0.25885D0, 0.22992D0, 0.20233D0, 0.17646D0,
56113 & 0.15252D0, 0.13038D0, 0.11028D0, 0.09251D0, 0.07647D0,
56114 & 0.06240D0, 0.05033D0, 0.03984D0, 0.02372D0, 0.01293D0,
56115 & 0.00625D0, 0.00253D0, 0.00015D0, 0.00000D0/
56116 DATA (FMRS(2,1,I,33),I=1,49)/
56117 & 0.02258D0, 0.02800D0, 0.03471D0, 0.03936D0, 0.04304D0,
56118 & 0.04613D0, 0.05727D0, 0.07126D0, 0.08114D0, 0.08911D0,
56119 & 0.09604D0, 0.12181D0, 0.15642D0, 0.18202D0, 0.20315D0,
56120 & 0.22140D0, 0.25219D0, 0.28920D0, 0.33594D0, 0.37065D0,
56121 & 0.41690D0, 0.44243D0, 0.45378D0, 0.45384D0, 0.44278D0,
56122 & 0.42397D0, 0.39993D0, 0.37250D0, 0.34307D0, 0.31283D0,
56123 & 0.28245D0, 0.25269D0, 0.22404D0, 0.19681D0, 0.17131D0,
56124 & 0.14780D0, 0.12613D0, 0.10648D0, 0.08918D0, 0.07357D0,
56125 & 0.05991D0, 0.04824D0, 0.03811D0, 0.02259D0, 0.01226D0,
56126 & 0.00589D0, 0.00237D0, 0.00014D0, 0.00000D0/
56127 DATA (FMRS(2,1,I,34),I=1,49)/
56128 & 0.02276D0, 0.02823D0, 0.03502D0, 0.03972D0, 0.04344D0,
56129 & 0.04656D0, 0.05782D0, 0.07197D0, 0.08196D0, 0.09001D0,
56130 & 0.09702D0, 0.12306D0, 0.15799D0, 0.18378D0, 0.20502D0,
56131 & 0.22334D0, 0.25418D0, 0.29111D0, 0.33751D0, 0.37174D0,
56132 & 0.41686D0, 0.44123D0, 0.45149D0, 0.45035D0, 0.43832D0,
56133 & 0.41874D0, 0.39416D0, 0.36638D0, 0.33679D0, 0.30651D0,
56134 & 0.27625D0, 0.24670D0, 0.21831D0, 0.19144D0, 0.16636D0,
56135 & 0.14329D0, 0.12204D0, 0.10286D0, 0.08597D0, 0.07080D0,
56136 & 0.05755D0, 0.04624D0, 0.03646D0, 0.02153D0, 0.01162D0,
56137 & 0.00556D0, 0.00222D0, 0.00012D0, 0.00000D0/
56138 DATA (FMRS(2,1,I,35),I=1,49)/
56139 & 0.02294D0, 0.02846D0, 0.03531D0, 0.04006D0, 0.04381D0,
56140 & 0.04697D0, 0.05834D0, 0.07264D0, 0.08274D0, 0.09087D0,
56141 & 0.09796D0, 0.12426D0, 0.15949D0, 0.18547D0, 0.20682D0,
56142 & 0.22520D0, 0.25608D0, 0.29293D0, 0.33900D0, 0.37277D0,
56143 & 0.41683D0, 0.44010D0, 0.44933D0, 0.44706D0, 0.43413D0,
56144 & 0.41383D0, 0.38877D0, 0.36068D0, 0.33093D0, 0.30063D0,
56145 & 0.27049D0, 0.24114D0, 0.21302D0, 0.18649D0, 0.16180D0,
56146 & 0.13914D0, 0.11828D0, 0.09955D0, 0.08303D0, 0.06826D0,
56147 & 0.05540D0, 0.04443D0, 0.03497D0, 0.02057D0, 0.01106D0,
56148 & 0.00526D0, 0.00209D0, 0.00012D0, 0.00000D0/
56149 DATA (FMRS(2,1,I,36),I=1,49)/
56150 & 0.02310D0, 0.02867D0, 0.03558D0, 0.04038D0, 0.04417D0,
56151 & 0.04736D0, 0.05885D0, 0.07328D0, 0.08348D0, 0.09170D0,
56152 & 0.09885D0, 0.12540D0, 0.16092D0, 0.18705D0, 0.20850D0,
56153 & 0.22693D0, 0.25784D0, 0.29461D0, 0.34036D0, 0.37368D0,
56154 & 0.41672D0, 0.43895D0, 0.44722D0, 0.44390D0, 0.43013D0,
56155 & 0.40920D0, 0.38369D0, 0.35531D0, 0.32545D0, 0.29515D0,
56156 & 0.26511D0, 0.23598D0, 0.20812D0, 0.18191D0, 0.15758D0,
56157 & 0.13530D0, 0.11483D0, 0.09649D0, 0.08034D0, 0.06595D0,
56158 & 0.05344D0, 0.04278D0, 0.03361D0, 0.01970D0, 0.01054D0,
56159 & 0.00499D0, 0.00197D0, 0.00011D0, 0.00000D0/
56160 DATA (FMRS(2,1,I,37),I=1,49)/
56161 & 0.02327D0, 0.02889D0, 0.03587D0, 0.04071D0, 0.04453D0,
56162 & 0.04775D0, 0.05935D0, 0.07393D0, 0.08423D0, 0.09253D0,
56163 & 0.09975D0, 0.12655D0, 0.16235D0, 0.18864D0, 0.21018D0,
56164 & 0.22866D0, 0.25959D0, 0.29626D0, 0.34166D0, 0.37452D0,
56165 & 0.41652D0, 0.43771D0, 0.44502D0, 0.44067D0, 0.42606D0,
56166 & 0.40453D0, 0.37859D0, 0.34994D0, 0.31996D0, 0.28968D0,
56167 & 0.25976D0, 0.23084D0, 0.20328D0, 0.17738D0, 0.15341D0,
56168 & 0.13150D0, 0.11145D0, 0.09348D0, 0.07773D0, 0.06369D0,
56169 & 0.05153D0, 0.04117D0, 0.03229D0, 0.01885D0, 0.01005D0,
56170 & 0.00474D0, 0.00186D0, 0.00010D0, 0.00000D0/
56171 DATA (FMRS(2,1,I,38),I=1,49)/
56172 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56173 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56174 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56175 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56176 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56177 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56178 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56179 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56180 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56181 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56182 DATA (FMRS(2,2,I, 1),I=1,49)/
56183 & 0.00683D0, 0.00832D0, 0.01013D0, 0.01138D0, 0.01237D0,
56184 & 0.01320D0, 0.01619D0, 0.02004D0, 0.02286D0, 0.02522D0,
56185 & 0.02744D0, 0.03623D0, 0.04952D0, 0.06032D0, 0.06982D0,
56186 & 0.07843D0, 0.09385D0, 0.11395D0, 0.14220D0, 0.16592D0,
56187 & 0.20382D0, 0.23228D0, 0.25344D0, 0.27158D0, 0.28216D0,
56188 & 0.28647D0, 0.28570D0, 0.28068D0, 0.27216D0, 0.26127D0,
56189 & 0.24773D0, 0.23281D0, 0.21663D0, 0.19968D0, 0.18252D0,
56190 & 0.16522D0, 0.14809D0, 0.13153D0, 0.11576D0, 0.10050D0,
56191 & 0.08631D0, 0.07335D0, 0.06127D0, 0.04098D0, 0.02531D0,
56192 & 0.01409D0, 0.00672D0, 0.00064D0, 0.00000D0/
56193 DATA (FMRS(2,2,I, 2),I=1,49)/
56194 & 0.00687D0, 0.00838D0, 0.01023D0, 0.01151D0, 0.01252D0,
56195 & 0.01336D0, 0.01643D0, 0.02037D0, 0.02327D0, 0.02569D0,
56196 & 0.02797D0, 0.03698D0, 0.05059D0, 0.06162D0, 0.07129D0,
56197 & 0.08004D0, 0.09567D0, 0.11595D0, 0.14429D0, 0.16793D0,
56198 & 0.20539D0, 0.23318D0, 0.25356D0, 0.27069D0, 0.28025D0,
56199 & 0.28363D0, 0.28200D0, 0.27624D0, 0.26713D0, 0.25572D0,
56200 & 0.24185D0, 0.22669D0, 0.21040D0, 0.19345D0, 0.17637D0,
56201 & 0.15928D0, 0.14242D0, 0.12615D0, 0.11076D0, 0.09591D0,
56202 & 0.08215D0, 0.06963D0, 0.05800D0, 0.03856D0, 0.02367D0,
56203 & 0.01309D0, 0.00619D0, 0.00057D0, 0.00000D0/
56204 DATA (FMRS(2,2,I, 3),I=1,49)/
56205 & 0.00693D0, 0.00848D0, 0.01038D0, 0.01170D0, 0.01274D0,
56206 & 0.01362D0, 0.01679D0, 0.02088D0, 0.02389D0, 0.02641D0,
56207 & 0.02877D0, 0.03812D0, 0.05220D0, 0.06356D0, 0.07349D0,
56208 & 0.08244D0, 0.09836D0, 0.11888D0, 0.14732D0, 0.17082D0,
56209 & 0.20757D0, 0.23434D0, 0.25356D0, 0.26918D0, 0.27725D0,
56210 & 0.27927D0, 0.27642D0, 0.26960D0, 0.25969D0, 0.24758D0,
56211 & 0.23327D0, 0.21778D0, 0.20136D0, 0.18446D0, 0.16756D0,
56212 & 0.15079D0, 0.13434D0, 0.11852D0, 0.10371D0, 0.08946D0,
56213 & 0.07631D0, 0.06442D0, 0.05345D0, 0.03522D0, 0.02142D0,
56214 & 0.01172D0, 0.00548D0, 0.00049D0, 0.00000D0/
56215 DATA (FMRS(2,2,I, 4),I=1,49)/
56216 & 0.00697D0, 0.00855D0, 0.01050D0, 0.01184D0, 0.01291D0,
56217 & 0.01380D0, 0.01706D0, 0.02126D0, 0.02435D0, 0.02694D0,
56218 & 0.02937D0, 0.03897D0, 0.05339D0, 0.06499D0, 0.07510D0,
56219 & 0.08419D0, 0.10031D0, 0.12100D0, 0.14949D0, 0.17285D0,
56220 & 0.20905D0, 0.23506D0, 0.25342D0, 0.26794D0, 0.27493D0,
56221 & 0.27599D0, 0.27230D0, 0.26475D0, 0.25426D0, 0.24171D0,
56222 & 0.22712D0, 0.21140D0, 0.19495D0, 0.17811D0, 0.16138D0,
56223 & 0.14485D0, 0.12869D0, 0.11323D0, 0.09881D0, 0.08500D0,
56224 & 0.07230D0, 0.06086D0, 0.05034D0, 0.03297D0, 0.01992D0,
56225 & 0.01081D0, 0.00501D0, 0.00044D0, 0.00000D0/
56226 DATA (FMRS(2,2,I, 5),I=1,49)/
56227 & 0.00702D0, 0.00863D0, 0.01062D0, 0.01200D0, 0.01309D0,
56228 & 0.01401D0, 0.01735D0, 0.02167D0, 0.02485D0, 0.02751D0,
56229 & 0.03001D0, 0.03988D0, 0.05465D0, 0.06649D0, 0.07678D0,
56230 & 0.08602D0, 0.10233D0, 0.12317D0, 0.15168D0, 0.17488D0,
56231 & 0.21046D0, 0.23564D0, 0.25309D0, 0.26645D0, 0.27234D0,
56232 & 0.27243D0, 0.26786D0, 0.25959D0, 0.24854D0, 0.23557D0,
56233 & 0.22068D0, 0.20486D0, 0.18841D0, 0.17163D0, 0.15506D0,
56234 & 0.13880D0, 0.12296D0, 0.10788D0, 0.09387D0, 0.08052D0,
56235 & 0.06829D0, 0.05730D0, 0.04726D0, 0.03074D0, 0.01844D0,
56236 & 0.00993D0, 0.00456D0, 0.00039D0, 0.00000D0/
56237 DATA (FMRS(2,2,I, 6),I=1,49)/
56238 & 0.00706D0, 0.00870D0, 0.01073D0, 0.01213D0, 0.01325D0,
56239 & 0.01419D0, 0.01761D0, 0.02203D0, 0.02528D0, 0.02801D0,
56240 & 0.03057D0, 0.04067D0, 0.05575D0, 0.06780D0, 0.07825D0,
56241 & 0.08760D0, 0.10408D0, 0.12504D0, 0.15354D0, 0.17659D0,
56242 & 0.21162D0, 0.23607D0, 0.25274D0, 0.26511D0, 0.27006D0,
56243 & 0.26933D0, 0.26403D0, 0.25518D0, 0.24367D0, 0.23035D0,
56244 & 0.21525D0, 0.19935D0, 0.18289D0, 0.16620D0, 0.14980D0,
56245 & 0.13377D0, 0.11822D0, 0.10346D0, 0.08981D0, 0.07685D0,
56246 & 0.06502D0, 0.05441D0, 0.04475D0, 0.02894D0, 0.01725D0,
56247 & 0.00923D0, 0.00420D0, 0.00035D0, 0.00000D0/
56248 DATA (FMRS(2,2,I, 7),I=1,49)/
56249 & 0.00711D0, 0.00877D0, 0.01083D0, 0.01227D0, 0.01340D0,
56250 & 0.01436D0, 0.01785D0, 0.02237D0, 0.02570D0, 0.02850D0,
56251 & 0.03112D0, 0.04143D0, 0.05680D0, 0.06905D0, 0.07964D0,
56252 & 0.08911D0, 0.10573D0, 0.12679D0, 0.15527D0, 0.17816D0,
56253 & 0.21263D0, 0.23638D0, 0.25229D0, 0.26373D0, 0.26781D0,
56254 & 0.26630D0, 0.26033D0, 0.25095D0, 0.23903D0, 0.22536D0,
56255 & 0.21011D0, 0.19416D0, 0.17766D0, 0.16111D0, 0.14488D0,
56256 & 0.12910D0, 0.11382D0, 0.09936D0, 0.08606D0, 0.07347D0,
56257 & 0.06201D0, 0.05178D0, 0.04247D0, 0.02732D0, 0.01619D0,
56258 & 0.00860D0, 0.00389D0, 0.00031D0, 0.00000D0/
56259 DATA (FMRS(2,2,I, 8),I=1,49)/
56260 & 0.00716D0, 0.00885D0, 0.01095D0, 0.01241D0, 0.01357D0,
56261 & 0.01455D0, 0.01812D0, 0.02275D0, 0.02616D0, 0.02902D0,
56262 & 0.03170D0, 0.04225D0, 0.05792D0, 0.07038D0, 0.08112D0,
56263 & 0.09070D0, 0.10747D0, 0.12863D0, 0.15707D0, 0.17976D0,
56264 & 0.21362D0, 0.23661D0, 0.25172D0, 0.26218D0, 0.26535D0,
56265 & 0.26303D0, 0.25640D0, 0.24647D0, 0.23413D0, 0.22018D0,
56266 & 0.20477D0, 0.18875D0, 0.17228D0, 0.15585D0, 0.13983D0,
56267 & 0.12430D0, 0.10932D0, 0.09519D0, 0.08225D0, 0.07005D0,
56268 & 0.05898D0, 0.04912D0, 0.04018D0, 0.02570D0, 0.01514D0,
56269 & 0.00799D0, 0.00358D0, 0.00028D0, 0.00000D0/
56270 DATA (FMRS(2,2,I, 9),I=1,49)/
56271 & 0.00720D0, 0.00891D0, 0.01105D0, 0.01254D0, 0.01372D0,
56272 & 0.01472D0, 0.01836D0, 0.02308D0, 0.02656D0, 0.02948D0,
56273 & 0.03221D0, 0.04297D0, 0.05891D0, 0.07154D0, 0.08241D0,
56274 & 0.09208D0, 0.10897D0, 0.13020D0, 0.15860D0, 0.18111D0,
56275 & 0.21443D0, 0.23674D0, 0.25116D0, 0.26078D0, 0.26316D0,
56276 & 0.26017D0, 0.25299D0, 0.24260D0, 0.22991D0, 0.21577D0,
56277 & 0.20023D0, 0.18414D0, 0.16776D0, 0.15141D0, 0.13557D0,
56278 & 0.12027D0, 0.10555D0, 0.09171D0, 0.07908D0, 0.06721D0,
56279 & 0.05646D0, 0.04691D0, 0.03829D0, 0.02437D0, 0.01428D0,
56280 & 0.00749D0, 0.00333D0, 0.00026D0, 0.00000D0/
56281 DATA (FMRS(2,2,I,10),I=1,49)/
56282 & 0.00724D0, 0.00898D0, 0.01115D0, 0.01266D0, 0.01386D0,
56283 & 0.01488D0, 0.01859D0, 0.02340D0, 0.02695D0, 0.02993D0,
56284 & 0.03271D0, 0.04366D0, 0.05985D0, 0.07265D0, 0.08364D0,
56285 & 0.09340D0, 0.11040D0, 0.13168D0, 0.16002D0, 0.18235D0,
56286 & 0.21512D0, 0.23679D0, 0.25054D0, 0.25935D0, 0.26099D0,
56287 & 0.25738D0, 0.24967D0, 0.23885D0, 0.22588D0, 0.21153D0,
56288 & 0.19588D0, 0.17977D0, 0.16345D0, 0.14723D0, 0.13156D0,
56289 & 0.11648D0, 0.10202D0, 0.08846D0, 0.07613D0, 0.06457D0,
56290 & 0.05413D0, 0.04488D0, 0.03655D0, 0.02315D0, 0.01349D0,
56291 & 0.00703D0, 0.00311D0, 0.00024D0, 0.00000D0/
56292 DATA (FMRS(2,2,I,11),I=1,49)/
56293 & 0.00727D0, 0.00904D0, 0.01123D0, 0.01276D0, 0.01398D0,
56294 & 0.01501D0, 0.01877D0, 0.02366D0, 0.02727D0, 0.03029D0,
56295 & 0.03311D0, 0.04422D0, 0.06061D0, 0.07353D0, 0.08461D0,
56296 & 0.09444D0, 0.11152D0, 0.13285D0, 0.16112D0, 0.18330D0,
56297 & 0.21564D0, 0.23680D0, 0.25001D0, 0.25818D0, 0.25925D0,
56298 & 0.25517D0, 0.24705D0, 0.23591D0, 0.22272D0, 0.20821D0,
56299 & 0.19248D0, 0.17638D0, 0.16011D0, 0.14399D0, 0.12847D0,
56300 & 0.11356D0, 0.09932D0, 0.08597D0, 0.07388D0, 0.06256D0,
56301 & 0.05235D0, 0.04334D0, 0.03522D0, 0.02223D0, 0.01290D0,
56302 & 0.00670D0, 0.00295D0, 0.00022D0, 0.00000D0/
56303 DATA (FMRS(2,2,I,12),I=1,49)/
56304 & 0.00735D0, 0.00915D0, 0.01141D0, 0.01298D0, 0.01423D0,
56305 & 0.01529D0, 0.01917D0, 0.02422D0, 0.02794D0, 0.03106D0,
56306 & 0.03397D0, 0.04541D0, 0.06221D0, 0.07541D0, 0.08668D0,
56307 & 0.09664D0, 0.11388D0, 0.13528D0, 0.16340D0, 0.18523D0,
56308 & 0.21662D0, 0.23667D0, 0.24876D0, 0.25560D0, 0.25550D0,
56309 & 0.25041D0, 0.24145D0, 0.22968D0, 0.21606D0, 0.20125D0,
56310 & 0.18540D0, 0.16932D0, 0.15319D0, 0.13731D0, 0.12210D0,
56311 & 0.10759D0, 0.09378D0, 0.08090D0, 0.06929D0, 0.05847D0,
56312 & 0.04874D0, 0.04022D0, 0.03256D0, 0.02039D0, 0.01173D0,
56313 & 0.00603D0, 0.00263D0, 0.00019D0, 0.00000D0/
56314 DATA (FMRS(2,2,I,13),I=1,49)/
56315 & 0.00742D0, 0.00926D0, 0.01156D0, 0.01317D0, 0.01446D0,
56316 & 0.01554D0, 0.01952D0, 0.02471D0, 0.02853D0, 0.03173D0,
56317 & 0.03472D0, 0.04644D0, 0.06360D0, 0.07703D0, 0.08845D0,
56318 & 0.09852D0, 0.11589D0, 0.13732D0, 0.16529D0, 0.18680D0,
56319 & 0.21735D0, 0.23643D0, 0.24757D0, 0.25329D0, 0.25220D0,
56320 & 0.24629D0, 0.23665D0, 0.22439D0, 0.21043D0, 0.19540D0,
56321 & 0.17949D0, 0.16343D0, 0.14746D0, 0.13180D0, 0.11686D0,
56322 & 0.10269D0, 0.08926D0, 0.07677D0, 0.06556D0, 0.05517D0,
56323 & 0.04584D0, 0.03772D0, 0.03044D0, 0.01893D0, 0.01082D0,
56324 & 0.00551D0, 0.00238D0, 0.00017D0, 0.00000D0/
56325 DATA (FMRS(2,2,I,14),I=1,49)/
56326 & 0.00750D0, 0.00938D0, 0.01173D0, 0.01339D0, 0.01471D0,
56327 & 0.01583D0, 0.01992D0, 0.02526D0, 0.02920D0, 0.03250D0,
56328 & 0.03557D0, 0.04761D0, 0.06516D0, 0.07882D0, 0.09041D0,
56329 & 0.10060D0, 0.11809D0, 0.13955D0, 0.16731D0, 0.18846D0,
56330 & 0.21802D0, 0.23605D0, 0.24613D0, 0.25062D0, 0.24846D0,
56331 & 0.24169D0, 0.23135D0, 0.21858D0, 0.20428D0, 0.18902D0,
56332 & 0.17309D0, 0.15708D0, 0.14130D0, 0.12590D0, 0.11127D0,
56333 & 0.09745D0, 0.08445D0, 0.07239D0, 0.06165D0, 0.05170D0,
56334 & 0.04281D0, 0.03511D0, 0.02824D0, 0.01743D0, 0.00988D0,
56335 & 0.00499D0, 0.00213D0, 0.00015D0, 0.00000D0/
56336 DATA (FMRS(2,2,I,15),I=1,49)/
56337 & 0.00758D0, 0.00950D0, 0.01192D0, 0.01362D0, 0.01498D0,
56338 & 0.01613D0, 0.02034D0, 0.02584D0, 0.02990D0, 0.03330D0,
56339 & 0.03646D0, 0.04882D0, 0.06676D0, 0.08067D0, 0.09242D0,
56340 & 0.10271D0, 0.12031D0, 0.14177D0, 0.16927D0, 0.19002D0,
56341 & 0.21855D0, 0.23546D0, 0.24445D0, 0.24771D0, 0.24448D0,
56342 & 0.23683D0, 0.22584D0, 0.21262D0, 0.19799D0, 0.18255D0,
56343 & 0.16661D0, 0.15073D0, 0.13511D0, 0.12003D0, 0.10571D0,
56344 & 0.09233D0, 0.07973D0, 0.06812D0, 0.05781D0, 0.04834D0,
56345 & 0.03990D0, 0.03259D0, 0.02612D0, 0.01599D0, 0.00899D0,
56346 & 0.00450D0, 0.00190D0, 0.00013D0, 0.00000D0/
56347 DATA (FMRS(2,2,I,16),I=1,49)/
56348 & 0.00766D0, 0.00962D0, 0.01210D0, 0.01384D0, 0.01522D0,
56349 & 0.01640D0, 0.02073D0, 0.02638D0, 0.03055D0, 0.03403D0,
56350 & 0.03728D0, 0.04992D0, 0.06822D0, 0.08234D0, 0.09422D0,
56351 & 0.10460D0, 0.12228D0, 0.14371D0, 0.17097D0, 0.19133D0,
56352 & 0.21891D0, 0.23481D0, 0.24283D0, 0.24499D0, 0.24085D0,
56353 & 0.23246D0, 0.22090D0, 0.20727D0, 0.19242D0, 0.17687D0,
56354 & 0.16094D0, 0.14517D0, 0.12974D0, 0.11493D0, 0.10094D0,
56355 & 0.08792D0, 0.07568D0, 0.06448D0, 0.05456D0, 0.04548D0,
56356 & 0.03743D0, 0.03047D0, 0.02435D0, 0.01480D0, 0.00826D0,
56357 & 0.00410D0, 0.00171D0, 0.00011D0, 0.00000D0/
56358 DATA (FMRS(2,2,I,17),I=1,49)/
56359 & 0.00775D0, 0.00975D0, 0.01228D0, 0.01406D0, 0.01548D0,
56360 & 0.01669D0, 0.02112D0, 0.02692D0, 0.03120D0, 0.03478D0,
56361 & 0.03810D0, 0.05104D0, 0.06968D0, 0.08400D0, 0.09602D0,
56362 & 0.10648D0, 0.12423D0, 0.14563D0, 0.17261D0, 0.19256D0,
56363 & 0.21918D0, 0.23405D0, 0.24112D0, 0.24221D0, 0.23719D0,
56364 & 0.22809D0, 0.21600D0, 0.20198D0, 0.18694D0, 0.17130D0,
56365 & 0.15541D0, 0.13976D0, 0.12455D0, 0.11000D0, 0.09636D0,
56366 & 0.08368D0, 0.07182D0, 0.06101D0, 0.05149D0, 0.04278D0,
56367 & 0.03510D0, 0.02849D0, 0.02269D0, 0.01370D0, 0.00759D0,
56368 & 0.00374D0, 0.00155D0, 0.00010D0, 0.00000D0/
56369 DATA (FMRS(2,2,I,18),I=1,49)/
56370 & 0.00782D0, 0.00985D0, 0.01243D0, 0.01424D0, 0.01569D0,
56371 & 0.01692D0, 0.02146D0, 0.02738D0, 0.03175D0, 0.03540D0,
56372 & 0.03879D0, 0.05197D0, 0.07089D0, 0.08537D0, 0.09749D0,
56373 & 0.10801D0, 0.12581D0, 0.14716D0, 0.17390D0, 0.19349D0,
56374 & 0.21930D0, 0.23333D0, 0.23963D0, 0.23986D0, 0.23413D0,
56375 & 0.22447D0, 0.21197D0, 0.19769D0, 0.18248D0, 0.16678D0,
56376 & 0.15094D0, 0.13543D0, 0.12040D0, 0.10608D0, 0.09270D0,
56377 & 0.08031D0, 0.06878D0, 0.05828D0, 0.04908D0, 0.04068D0,
56378 & 0.03329D0, 0.02694D0, 0.02140D0, 0.01285D0, 0.00708D0,
56379 & 0.00346D0, 0.00142D0, 0.00009D0, 0.00000D0/
56380 DATA (FMRS(2,2,I,19),I=1,49)/
56381 & 0.00791D0, 0.00998D0, 0.01261D0, 0.01447D0, 0.01595D0,
56382 & 0.01722D0, 0.02186D0, 0.02794D0, 0.03242D0, 0.03616D0,
56383 & 0.03963D0, 0.05310D0, 0.07234D0, 0.08702D0, 0.09924D0,
56384 & 0.10983D0, 0.12767D0, 0.14895D0, 0.17537D0, 0.19453D0,
56385 & 0.21933D0, 0.23238D0, 0.23773D0, 0.23696D0, 0.23039D0,
56386 & 0.22010D0, 0.20715D0, 0.19257D0, 0.17716D0, 0.16147D0,
56387 & 0.14570D0, 0.13034D0, 0.11556D0, 0.10152D0, 0.08847D0,
56388 & 0.07643D0, 0.06526D0, 0.05515D0, 0.04631D0, 0.03827D0,
56389 & 0.03122D0, 0.02519D0, 0.01995D0, 0.01190D0, 0.00650D0,
56390 & 0.00315D0, 0.00128D0, 0.00008D0, 0.00000D0/
56391 DATA (FMRS(2,2,I,20),I=1,49)/
56392 & 0.00799D0, 0.01010D0, 0.01278D0, 0.01467D0, 0.01619D0,
56393 & 0.01748D0, 0.02223D0, 0.02844D0, 0.03302D0, 0.03684D0,
56394 & 0.04038D0, 0.05409D0, 0.07362D0, 0.08846D0, 0.10078D0,
56395 & 0.11143D0, 0.12930D0, 0.15050D0, 0.17662D0, 0.19539D0,
56396 & 0.21931D0, 0.23148D0, 0.23602D0, 0.23438D0, 0.22712D0,
56397 & 0.21628D0, 0.20296D0, 0.18814D0, 0.17260D0, 0.15692D0,
56398 & 0.14124D0, 0.12600D0, 0.11146D0, 0.09768D0, 0.08490D0,
56399 & 0.07317D0, 0.06233D0, 0.05253D0, 0.04400D0, 0.03627D0,
56400 & 0.02950D0, 0.02375D0, 0.01875D0, 0.01112D0, 0.00604D0,
56401 & 0.00291D0, 0.00117D0, 0.00007D0, 0.00000D0/
56402 DATA (FMRS(2,2,I,21),I=1,49)/
56403 & 0.00806D0, 0.01021D0, 0.01293D0, 0.01486D0, 0.01641D0,
56404 & 0.01772D0, 0.02256D0, 0.02890D0, 0.03357D0, 0.03747D0,
56405 & 0.04106D0, 0.05501D0, 0.07479D0, 0.08976D0, 0.10217D0,
56406 & 0.11285D0, 0.13073D0, 0.15184D0, 0.17768D0, 0.19608D0,
56407 & 0.21918D0, 0.23055D0, 0.23436D0, 0.23195D0, 0.22407D0,
56408 & 0.21277D0, 0.19913D0, 0.18411D0, 0.16851D0, 0.15282D0,
56409 & 0.13724D0, 0.12215D0, 0.10780D0, 0.09426D0, 0.08175D0,
56410 & 0.07030D0, 0.05975D0, 0.05024D0, 0.04199D0, 0.03453D0,
56411 & 0.02802D0, 0.02251D0, 0.01772D0, 0.01045D0, 0.00564D0,
56412 & 0.00270D0, 0.00108D0, 0.00006D0, 0.00000D0/
56413 DATA (FMRS(2,2,I,22),I=1,49)/
56414 & 0.00816D0, 0.01035D0, 0.01313D0, 0.01511D0, 0.01669D0,
56415 & 0.01803D0, 0.02299D0, 0.02949D0, 0.03427D0, 0.03826D0,
56416 & 0.04194D0, 0.05616D0, 0.07626D0, 0.09141D0, 0.10390D0,
56417 & 0.11463D0, 0.13252D0, 0.15350D0, 0.17897D0, 0.19689D0,
56418 & 0.21895D0, 0.22932D0, 0.23223D0, 0.22887D0, 0.22024D0,
56419 & 0.20839D0, 0.19437D0, 0.17913D0, 0.16346D0, 0.14778D0,
56420 & 0.13233D0, 0.11744D0, 0.10335D0, 0.09011D0, 0.07794D0,
56421 & 0.06684D0, 0.05665D0, 0.04749D0, 0.03958D0, 0.03245D0,
56422 & 0.02625D0, 0.02103D0, 0.01650D0, 0.00967D0, 0.00518D0,
56423 & 0.00246D0, 0.00097D0, 0.00005D0, 0.00000D0/
56424 DATA (FMRS(2,2,I,23),I=1,49)/
56425 & 0.00826D0, 0.01049D0, 0.01333D0, 0.01534D0, 0.01695D0,
56426 & 0.01833D0, 0.02340D0, 0.03004D0, 0.03494D0, 0.03901D0,
56427 & 0.04276D0, 0.05725D0, 0.07764D0, 0.09293D0, 0.10551D0,
56428 & 0.11628D0, 0.13416D0, 0.15502D0, 0.18011D0, 0.19758D0,
56429 & 0.21867D0, 0.22812D0, 0.23018D0, 0.22598D0, 0.21667D0,
56430 & 0.20434D0, 0.19000D0, 0.17460D0, 0.15883D0, 0.14320D0,
56431 & 0.12787D0, 0.11321D0, 0.09934D0, 0.08640D0, 0.07454D0,
56432 & 0.06376D0, 0.05389D0, 0.04504D0, 0.03744D0, 0.03063D0,
56433 & 0.02471D0, 0.01973D0, 0.01544D0, 0.00899D0, 0.00479D0,
56434 & 0.00225D0, 0.00088D0, 0.00005D0, 0.00000D0/
56435 DATA (FMRS(2,2,I,24),I=1,49)/
56436 & 0.00835D0, 0.01062D0, 0.01351D0, 0.01556D0, 0.01721D0,
56437 & 0.01861D0, 0.02378D0, 0.03057D0, 0.03556D0, 0.03972D0,
56438 & 0.04354D0, 0.05827D0, 0.07891D0, 0.09434D0, 0.10698D0,
56439 & 0.11778D0, 0.13564D0, 0.15636D0, 0.18108D0, 0.19811D0,
56440 & 0.21829D0, 0.22687D0, 0.22819D0, 0.22319D0, 0.21330D0,
56441 & 0.20053D0, 0.18593D0, 0.17036D0, 0.15459D0, 0.13902D0,
56442 & 0.12383D0, 0.10936D0, 0.09573D0, 0.08306D0, 0.07149D0,
56443 & 0.06100D0, 0.05144D0, 0.04289D0, 0.03556D0, 0.02901D0,
56444 & 0.02335D0, 0.01859D0, 0.01451D0, 0.00840D0, 0.00444D0,
56445 & 0.00208D0, 0.00081D0, 0.00004D0, 0.00000D0/
56446 DATA (FMRS(2,2,I,25),I=1,49)/
56447 & 0.00844D0, 0.01075D0, 0.01369D0, 0.01578D0, 0.01746D0,
56448 & 0.01889D0, 0.02417D0, 0.03109D0, 0.03619D0, 0.04043D0,
56449 & 0.04431D0, 0.05929D0, 0.08018D0, 0.09573D0, 0.10844D0,
56450 & 0.11926D0, 0.13709D0, 0.15767D0, 0.18202D0, 0.19861D0,
56451 & 0.21788D0, 0.22561D0, 0.22620D0, 0.22044D0, 0.20998D0,
56452 & 0.19681D0, 0.18196D0, 0.16625D0, 0.15048D0, 0.13499D0,
56453 & 0.11994D0, 0.10567D0, 0.09228D0, 0.07987D0, 0.06858D0,
56454 & 0.05838D0, 0.04911D0, 0.04085D0, 0.03379D0, 0.02749D0,
56455 & 0.02207D0, 0.01753D0, 0.01364D0, 0.00785D0, 0.00413D0,
56456 & 0.00192D0, 0.00074D0, 0.00004D0, 0.00000D0/
56457 DATA (FMRS(2,2,I,26),I=1,49)/
56458 & 0.00853D0, 0.01088D0, 0.01388D0, 0.01600D0, 0.01772D0,
56459 & 0.01917D0, 0.02456D0, 0.03161D0, 0.03680D0, 0.04112D0,
56460 & 0.04508D0, 0.06028D0, 0.08140D0, 0.09707D0, 0.10983D0,
56461 & 0.12067D0, 0.13846D0, 0.15889D0, 0.18286D0, 0.19901D0,
56462 & 0.21739D0, 0.22430D0, 0.22419D0, 0.21773D0, 0.20672D0,
56463 & 0.19320D0, 0.17811D0, 0.16233D0, 0.14654D0, 0.13113D0,
56464 & 0.11622D0, 0.10216D0, 0.08901D0, 0.07686D0, 0.06584D0,
56465 & 0.05592D0, 0.04692D0, 0.03894D0, 0.03214D0, 0.02608D0,
56466 & 0.02089D0, 0.01655D0, 0.01285D0, 0.00735D0, 0.00384D0,
56467 & 0.00177D0, 0.00068D0, 0.00003D0, 0.00000D0/
56468 DATA (FMRS(2,2,I,27),I=1,49)/
56469 & 0.00862D0, 0.01100D0, 0.01405D0, 0.01622D0, 0.01796D0,
56470 & 0.01944D0, 0.02492D0, 0.03211D0, 0.03739D0, 0.04178D0,
56471 & 0.04580D0, 0.06121D0, 0.08256D0, 0.09833D0, 0.11114D0,
56472 & 0.12198D0, 0.13974D0, 0.16000D0, 0.18361D0, 0.19934D0,
56473 & 0.21688D0, 0.22303D0, 0.22227D0, 0.21516D0, 0.20368D0,
56474 & 0.18983D0, 0.17455D0, 0.15870D0, 0.14292D0, 0.12759D0,
56475 & 0.11282D0, 0.09895D0, 0.08604D0, 0.07413D0, 0.06336D0,
56476 & 0.05370D0, 0.04495D0, 0.03722D0, 0.03066D0, 0.02482D0,
56477 & 0.01983D0, 0.01568D0, 0.01214D0, 0.00691D0, 0.00359D0,
56478 & 0.00164D0, 0.00063D0, 0.00003D0, 0.00000D0/
56479 DATA (FMRS(2,2,I,28),I=1,49)/
56480 & 0.00871D0, 0.01113D0, 0.01422D0, 0.01642D0, 0.01819D0,
56481 & 0.01970D0, 0.02527D0, 0.03257D0, 0.03795D0, 0.04240D0,
56482 & 0.04648D0, 0.06209D0, 0.08364D0, 0.09950D0, 0.11235D0,
56483 & 0.12320D0, 0.14090D0, 0.16101D0, 0.18426D0, 0.19960D0,
56484 & 0.21635D0, 0.22178D0, 0.22043D0, 0.21273D0, 0.20082D0,
56485 & 0.18670D0, 0.17123D0, 0.15532D0, 0.13957D0, 0.12434D0,
56486 & 0.10972D0, 0.09602D0, 0.08332D0, 0.07164D0, 0.06111D0,
56487 & 0.05170D0, 0.04318D0, 0.03568D0, 0.02933D0, 0.02371D0,
56488 & 0.01889D0, 0.01491D0, 0.01151D0, 0.00652D0, 0.00337D0,
56489 & 0.00153D0, 0.00058D0, 0.00003D0, 0.00000D0/
56490 DATA (FMRS(2,2,I,29),I=1,49)/
56491 & 0.00880D0, 0.01125D0, 0.01439D0, 0.01662D0, 0.01842D0,
56492 & 0.01995D0, 0.02562D0, 0.03305D0, 0.03850D0, 0.04303D0,
56493 & 0.04716D0, 0.06297D0, 0.08471D0, 0.10067D0, 0.11354D0,
56494 & 0.12440D0, 0.14205D0, 0.16199D0, 0.18487D0, 0.19981D0,
56495 & 0.21577D0, 0.22050D0, 0.21856D0, 0.21030D0, 0.19797D0,
56496 & 0.18358D0, 0.16796D0, 0.15200D0, 0.13629D0, 0.12116D0,
56497 & 0.10670D0, 0.09318D0, 0.08069D0, 0.06924D0, 0.05894D0,
56498 & 0.04976D0, 0.04148D0, 0.03421D0, 0.02806D0, 0.02263D0,
56499 & 0.01799D0, 0.01417D0, 0.01091D0, 0.00615D0, 0.00316D0,
56500 & 0.00143D0, 0.00054D0, 0.00003D0, 0.00000D0/
56501 DATA (FMRS(2,2,I,30),I=1,49)/
56502 & 0.00889D0, 0.01137D0, 0.01456D0, 0.01683D0, 0.01865D0,
56503 & 0.02021D0, 0.02596D0, 0.03351D0, 0.03906D0, 0.04365D0,
56504 & 0.04784D0, 0.06384D0, 0.08576D0, 0.10180D0, 0.11470D0,
56505 & 0.12555D0, 0.14314D0, 0.16292D0, 0.18544D0, 0.19997D0,
56506 & 0.21516D0, 0.21921D0, 0.21670D0, 0.20790D0, 0.19518D0,
56507 & 0.18054D0, 0.16480D0, 0.14880D0, 0.13314D0, 0.11810D0,
56508 & 0.10380D0, 0.09048D0, 0.07819D0, 0.06696D0, 0.05688D0,
56509 & 0.04793D0, 0.03987D0, 0.03282D0, 0.02686D0, 0.02162D0,
56510 & 0.01715D0, 0.01347D0, 0.01036D0, 0.00581D0, 0.00297D0,
56511 & 0.00134D0, 0.00050D0, 0.00002D0, 0.00000D0/
56512 DATA (FMRS(2,2,I,31),I=1,49)/
56513 & 0.00897D0, 0.01149D0, 0.01472D0, 0.01702D0, 0.01887D0,
56514 & 0.02045D0, 0.02630D0, 0.03396D0, 0.03958D0, 0.04424D0,
56515 & 0.04848D0, 0.06466D0, 0.08676D0, 0.10286D0, 0.11579D0,
56516 & 0.12663D0, 0.14416D0, 0.16377D0, 0.18594D0, 0.20009D0,
56517 & 0.21455D0, 0.21797D0, 0.21493D0, 0.20563D0, 0.19256D0,
56518 & 0.17769D0, 0.16185D0, 0.14582D0, 0.13021D0, 0.11528D0,
56519 & 0.10112D0, 0.08798D0, 0.07588D0, 0.06486D0, 0.05500D0,
56520 & 0.04626D0, 0.03841D0, 0.03155D0, 0.02578D0, 0.02071D0,
56521 & 0.01640D0, 0.01285D0, 0.00986D0, 0.00551D0, 0.00280D0,
56522 & 0.00125D0, 0.00046D0, 0.00002D0, 0.00000D0/
56523 DATA (FMRS(2,2,I,32),I=1,49)/
56524 & 0.00905D0, 0.01160D0, 0.01487D0, 0.01721D0, 0.01909D0,
56525 & 0.02069D0, 0.02661D0, 0.03438D0, 0.04008D0, 0.04480D0,
56526 & 0.04909D0, 0.06543D0, 0.08768D0, 0.10385D0, 0.11679D0,
56527 & 0.12763D0, 0.14509D0, 0.16454D0, 0.18637D0, 0.20016D0,
56528 & 0.21393D0, 0.21676D0, 0.21323D0, 0.20346D0, 0.19008D0,
56529 & 0.17502D0, 0.15909D0, 0.14304D0, 0.12749D0, 0.11266D0,
56530 & 0.09863D0, 0.08567D0, 0.07376D0, 0.06293D0, 0.05328D0,
56531 & 0.04474D0, 0.03708D0, 0.03039D0, 0.02479D0, 0.01988D0,
56532 & 0.01572D0, 0.01229D0, 0.00941D0, 0.00524D0, 0.00265D0,
56533 & 0.00118D0, 0.00043D0, 0.00002D0, 0.00000D0/
56534 DATA (FMRS(2,2,I,33),I=1,49)/
56535 & 0.00914D0, 0.01172D0, 0.01503D0, 0.01740D0, 0.01930D0,
56536 & 0.02092D0, 0.02693D0, 0.03481D0, 0.04058D0, 0.04536D0,
56537 & 0.04970D0, 0.06621D0, 0.08862D0, 0.10485D0, 0.11781D0,
56538 & 0.12863D0, 0.14602D0, 0.16531D0, 0.18679D0, 0.20022D0,
56539 & 0.21330D0, 0.21555D0, 0.21154D0, 0.20131D0, 0.18763D0,
56540 & 0.17238D0, 0.15637D0, 0.14031D0, 0.12482D0, 0.11010D0,
56541 & 0.09620D0, 0.08342D0, 0.07168D0, 0.06106D0, 0.05161D0,
56542 & 0.04326D0, 0.03580D0, 0.02928D0, 0.02384D0, 0.01908D0,
56543 & 0.01506D0, 0.01176D0, 0.00899D0, 0.00498D0, 0.00251D0,
56544 & 0.00111D0, 0.00041D0, 0.00002D0, 0.00000D0/
56545 DATA (FMRS(2,2,I,34),I=1,49)/
56546 & 0.00922D0, 0.01183D0, 0.01519D0, 0.01758D0, 0.01951D0,
56547 & 0.02116D0, 0.02725D0, 0.03523D0, 0.04108D0, 0.04592D0,
56548 & 0.05030D0, 0.06698D0, 0.08953D0, 0.10581D0, 0.11878D0,
56549 & 0.12959D0, 0.14690D0, 0.16601D0, 0.18715D0, 0.20021D0,
56550 & 0.21262D0, 0.21429D0, 0.20982D0, 0.19916D0, 0.18519D0,
56551 & 0.16977D0, 0.15369D0, 0.13763D0, 0.12221D0, 0.10760D0,
56552 & 0.09385D0, 0.08123D0, 0.06969D0, 0.05926D0, 0.05001D0,
56553 & 0.04183D0, 0.03456D0, 0.02822D0, 0.02295D0, 0.01833D0,
56554 & 0.01444D0, 0.01126D0, 0.00858D0, 0.00473D0, 0.00238D0,
56555 & 0.00105D0, 0.00038D0, 0.00002D0, 0.00000D0/
56556 DATA (FMRS(2,2,I,35),I=1,49)/
56557 & 0.00930D0, 0.01194D0, 0.01534D0, 0.01777D0, 0.01972D0,
56558 & 0.02138D0, 0.02755D0, 0.03564D0, 0.04156D0, 0.04645D0,
56559 & 0.05088D0, 0.06771D0, 0.09039D0, 0.10673D0, 0.11970D0,
56560 & 0.13050D0, 0.14773D0, 0.16667D0, 0.18748D0, 0.20020D0,
56561 & 0.21197D0, 0.21309D0, 0.20820D0, 0.19714D0, 0.18290D0,
56562 & 0.16734D0, 0.15119D0, 0.13514D0, 0.11978D0, 0.10528D0,
56563 & 0.09167D0, 0.07922D0, 0.06786D0, 0.05760D0, 0.04853D0,
56564 & 0.04052D0, 0.03343D0, 0.02726D0, 0.02213D0, 0.01765D0,
56565 & 0.01387D0, 0.01080D0, 0.00822D0, 0.00451D0, 0.00226D0,
56566 & 0.00099D0, 0.00036D0, 0.00002D0, 0.00000D0/
56567 DATA (FMRS(2,2,I,36),I=1,49)/
56568 & 0.00938D0, 0.01205D0, 0.01549D0, 0.01794D0, 0.01992D0,
56569 & 0.02160D0, 0.02784D0, 0.03602D0, 0.04201D0, 0.04696D0,
56570 & 0.05143D0, 0.06840D0, 0.09121D0, 0.10758D0, 0.12056D0,
56571 & 0.13134D0, 0.14849D0, 0.16728D0, 0.18776D0, 0.20016D0,
56572 & 0.21132D0, 0.21194D0, 0.20664D0, 0.19522D0, 0.18074D0,
56573 & 0.16504D0, 0.14884D0, 0.13281D0, 0.11752D0, 0.10313D0,
56574 & 0.08965D0, 0.07735D0, 0.06616D0, 0.05608D0, 0.04717D0,
56575 & 0.03933D0, 0.03239D0, 0.02637D0, 0.02137D0, 0.01702D0,
56576 & 0.01336D0, 0.01038D0, 0.00788D0, 0.00431D0, 0.00215D0,
56577 & 0.00094D0, 0.00034D0, 0.00001D0, 0.00000D0/
56578 DATA (FMRS(2,2,I,37),I=1,49)/
56579 & 0.00946D0, 0.01216D0, 0.01563D0, 0.01812D0, 0.02011D0,
56580 & 0.02182D0, 0.02814D0, 0.03641D0, 0.04247D0, 0.04747D0,
56581 & 0.05199D0, 0.06909D0, 0.09202D0, 0.10844D0, 0.12142D0,
56582 & 0.13217D0, 0.14925D0, 0.16786D0, 0.18802D0, 0.20008D0,
56583 & 0.21063D0, 0.21075D0, 0.20506D0, 0.19327D0, 0.17856D0,
56584 & 0.16274D0, 0.14648D0, 0.13048D0, 0.11526D0, 0.10099D0,
56585 & 0.08766D0, 0.07551D0, 0.06448D0, 0.05458D0, 0.04583D0,
56586 & 0.03816D0, 0.03137D0, 0.02550D0, 0.02064D0, 0.01641D0,
56587 & 0.01285D0, 0.00997D0, 0.00756D0, 0.00412D0, 0.00204D0,
56588 & 0.00089D0, 0.00032D0, 0.00001D0, 0.00000D0/
56589 DATA (FMRS(2,2,I,38),I=1,49)/
56590 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56591 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56592 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56593 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56594 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56595 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56596 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56597 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56598 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
56599 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
56600 DATA (FMRS(2,3,I, 1),I=1,49)/
56601 & 2.49594D0, 2.59678D0, 2.70121D0, 2.76381D0, 2.80882D0,
56602 & 2.84400D0, 2.95410D0, 3.06293D0, 3.12376D0, 3.16433D0,
56603 & 3.19612D0, 3.26381D0, 3.24185D0, 3.15396D0, 3.04339D0,
56604 & 2.92461D0, 2.68378D0, 2.34265D0, 1.85814D0, 1.47710D0,
56605 & 0.96403D0, 0.68739D0, 0.56164D0, 0.53053D0, 0.57114D0,
56606 & 0.63752D0, 0.70266D0, 0.75190D0, 0.77864D0, 0.78165D0,
56607 & 0.76223D0, 0.72410D0, 0.67143D0, 0.60861D0, 0.54010D0,
56608 & 0.46946D0, 0.39966D0, 0.33340D0, 0.27271D0, 0.21796D0,
56609 & 0.17035D0, 0.13022D0, 0.09678D0, 0.04919D0, 0.02174D0,
56610 & 0.00799D0, 0.00226D0, 0.00004D0, 0.00000D0/
56611 DATA (FMRS(2,3,I, 2),I=1,49)/
56612 & 4.92533D0, 4.79050D0, 4.65910D0, 4.58370D0, 4.53079D0,
56613 & 4.49006D0, 4.36491D0, 4.24084D0, 4.16793D0, 4.11560D0,
56614 & 4.07957D0, 3.94076D0, 3.72768D0, 3.53640D0, 3.35786D0,
56615 & 3.19001D0, 2.88282D0, 2.48367D0, 1.95213D0, 1.55132D0,
56616 & 1.02835D0, 0.75268D0, 0.62744D0, 0.59181D0, 0.62218D0,
56617 & 0.67462D0, 0.72413D0, 0.75779D0, 0.77032D0, 0.76124D0,
56618 & 0.73236D0, 0.68747D0, 0.63069D0, 0.56612D0, 0.49789D0,
56619 & 0.42912D0, 0.36239D0, 0.29993D0, 0.24354D0, 0.19324D0,
56620 & 0.14994D0, 0.11382D0, 0.08400D0, 0.04209D0, 0.01833D0,
56621 & 0.00664D0, 0.00185D0, 0.00003D0, 0.00000D0/
56622 DATA (FMRS(2,3,I, 3),I=1,49)/
56623 & 9.56993D0, 8.80858D0, 8.10702D0, 7.72221D0, 7.45989D0,
56624 & 7.26226D0, 6.67868D0, 6.13604D0, 5.83460D0, 5.62657D0,
56625 & 5.47187D0, 4.98498D0, 4.45878D0, 4.10350D0, 3.81920D0,
56626 & 3.57625D0, 3.16921D0, 2.68460D0, 2.08542D0, 1.65674D0,
56627 & 1.11953D0, 0.84374D0, 0.71690D0, 0.67195D0, 0.68567D0,
56628 & 0.71718D0, 0.74433D0, 0.75653D0, 0.75014D0, 0.72558D0,
56629 & 0.68509D0, 0.63243D0, 0.57149D0, 0.50592D0, 0.43925D0,
56630 & 0.37400D0, 0.31223D0, 0.25550D0, 0.20529D0, 0.16120D0,
56631 & 0.12380D0, 0.09303D0, 0.06796D0, 0.03337D0, 0.01425D0,
56632 & 0.00506D0, 0.00138D0, 0.00002D0, 0.00000D0/
56633 DATA (FMRS(2,3,I, 4),I=1,49)/
56634 & 13.80940D0, 12.36505D0, 11.07010D0, 10.37511D0, 9.90777D0,
56635 & 9.55916D0, 8.54772D0, 7.63175D0, 7.13319D0, 6.79336D0,
56636 & 6.53831D0, 5.76591D0, 4.99154D0, 4.51033D0, 4.14636D0,
56637 & 3.84778D0, 3.36791D0, 2.82235D0, 2.17611D0, 1.72845D0,
56638 & 1.18134D0, 0.90432D0, 0.77478D0, 0.72147D0, 0.72239D0,
56639 & 0.73883D0, 0.75059D0, 0.74861D0, 0.73014D0, 0.69610D0,
56640 & 0.64889D0, 0.59216D0, 0.52949D0, 0.46423D0, 0.39938D0,
56641 & 0.33717D0, 0.27919D0, 0.22665D0, 0.18078D0, 0.14088D0,
56642 & 0.10742D0, 0.08015D0, 0.05814D0, 0.02814D0, 0.01185D0,
56643 & 0.00415D0, 0.00112D0, 0.00002D0, 0.00000D0/
56644 DATA (FMRS(2,3,I, 5),I=1,49)/
56645 & 18.88911D0, 16.54105D0, 14.48190D0, 13.39606D0, 12.67388D0,
56646 & 12.13950D0, 10.61083D0, 9.25560D0, 8.52999D0, 8.04031D0,
56647 & 7.67199D0, 6.58349D0, 5.54112D0, 4.92668D0, 4.47939D0,
56648 & 4.12305D0, 3.56848D0, 2.96102D0, 2.26733D0, 1.80038D0,
56649 & 1.24179D0, 0.96142D0, 0.82726D0, 0.76409D0, 0.75165D0,
56650 & 0.75317D0, 0.75022D0, 0.73504D0, 0.70570D0, 0.66340D0,
56651 & 0.61066D0, 0.55093D0, 0.48745D0, 0.42321D0, 0.36077D0,
56652 & 0.30193D0, 0.24792D0, 0.19962D0, 0.15797D0, 0.12220D0,
56653 & 0.09245D0, 0.06850D0, 0.04934D0, 0.02353D0, 0.00976D0,
56654 & 0.00337D0, 0.00090D0, 0.00002D0, 0.00000D0/
56655 DATA (FMRS(2,3,I, 6),I=1,49)/
56656 & 24.17862D0, 20.81157D0, 17.90894D0, 16.39907D0, 15.40344D0,
56657 & 14.67132D0, 12.59987D0, 10.79385D0, 9.83948D0, 9.20057D0,
56658 & 8.72036D0, 7.32519D0, 6.02998D0, 5.29291D0, 4.77007D0,
56659 & 4.36196D0, 3.74120D0, 3.07968D0, 2.34504D0, 1.86151D0,
56660 & 1.29269D0, 1.00884D0, 0.87005D0, 0.79769D0, 0.77342D0,
56661 & 0.76224D0, 0.74721D0, 0.72151D0, 0.68376D0, 0.63535D0,
56662 & 0.57871D0, 0.51714D0, 0.45352D0, 0.39051D0, 0.33033D0,
56663 & 0.27444D0, 0.22374D0, 0.17892D0, 0.14065D0, 0.10811D0,
56664 & 0.08127D0, 0.05985D0, 0.04284D0, 0.02018D0, 0.00827D0,
56665 & 0.00283D0, 0.00075D0, 0.00001D0, 0.00000D0/
56666 DATA (FMRS(2,3,I, 7),I=1,49)/
56667 & 29.73861D0, 25.23818D0, 21.41267D0, 19.44500D0, 18.15658D0,
56668 & 17.21404D0, 14.57125D0, 12.29875D0, 11.11092D0, 10.32111D0,
56669 & 9.72854D0, 8.02926D0, 6.48794D0, 5.63342D0, 5.03891D0,
56670 & 4.58210D0, 3.89945D0, 3.18799D0, 2.41570D0, 1.91680D0,
56671 & 1.33767D0, 1.04936D0, 0.90523D0, 0.82366D0, 0.78841D0,
56672 & 0.76591D0, 0.74039D0, 0.70578D0, 0.66114D0, 0.60793D0,
56673 & 0.54844D0, 0.48585D0, 0.42265D0, 0.36114D0, 0.30329D0,
56674 & 0.25030D0, 0.20271D0, 0.16106D0, 0.12587D0, 0.09616D0,
56675 & 0.07187D0, 0.05262D0, 0.03744D0, 0.01745D0, 0.00707D0,
56676 & 0.00239D0, 0.00063D0, 0.00001D0, 0.00000D0/
56677 DATA (FMRS(2,3,I, 8),I=1,49)/
56678 & 36.41777D0, 30.48425D0, 25.50925D0, 22.97827D0, 21.33235D0,
56679 & 20.13434D0, 16.80486D0, 13.98059D0, 12.52029D0, 11.55588D0,
56680 & 10.83420D0, 8.78991D0, 6.97511D0, 5.99232D0, 5.32046D0,
56681 & 4.81154D0, 4.06330D0, 3.29938D0, 2.48793D0, 1.97297D0,
56682 & 1.38262D0, 1.08896D0, 0.93866D0, 0.84707D0, 0.80034D0,
56683 & 0.76640D0, 0.73057D0, 0.68748D0, 0.63647D0, 0.57905D0,
56684 & 0.51730D0, 0.45416D0, 0.39180D0, 0.33216D0, 0.27689D0,
56685 & 0.22693D0, 0.18251D0, 0.14405D0, 0.11189D0, 0.08494D0,
56686 & 0.06310D0, 0.04592D0, 0.03248D0, 0.01496D0, 0.00600D0,
56687 & 0.00201D0, 0.00052D0, 0.00001D0, 0.00000D0/
56688 DATA (FMRS(2,3,I, 9),I=1,49)/
56689 & 42.89913D0, 35.51439D0, 29.39055D0, 26.30256D0, 24.30551D0,
56690 & 22.85784D0, 18.86316D0, 15.51177D0, 13.79420D0, 12.66617D0,
56691 & 11.82423D0, 9.46212D0, 7.39982D0, 6.30264D0, 5.56252D0,
56692 & 5.00794D0, 4.20275D0, 3.39360D0, 2.54868D0, 2.01994D0,
56693 & 1.41958D0, 1.12075D0, 0.96469D0, 0.86425D0, 0.80777D0,
56694 & 0.76439D0, 0.72030D0, 0.67061D0, 0.61480D0, 0.55436D0,
56695 & 0.49120D0, 0.42796D0, 0.36659D0, 0.30874D0, 0.25576D0,
56696 & 0.20835D0, 0.16660D0, 0.13075D0, 0.10101D0, 0.07629D0,
56697 & 0.05637D0, 0.04082D0, 0.02872D0, 0.01310D0, 0.00521D0,
56698 & 0.00173D0, 0.00045D0, 0.00001D0, 0.00000D0/
56699 DATA (FMRS(2,3,I,10),I=1,49)/
56700 & 49.61974D0, 40.67585D0, 33.33157D0, 29.65726D0, 27.29273D0,
56701 & 25.58490D0, 20.90223D0, 17.01226D0, 15.03449D0, 13.74211D0,
56702 & 12.78005D0, 10.10345D0, 7.80003D0, 6.59295D0, 5.78776D0,
56703 & 5.18997D0, 4.33113D0, 3.47979D0, 2.60379D0, 2.06215D0,
56704 & 1.45191D0, 1.14765D0, 0.98577D0, 0.87686D0, 0.81144D0,
56705 & 0.75966D0, 0.70838D0, 0.65310D0, 0.59339D0, 0.53065D0,
56706 & 0.46666D0, 0.40372D0, 0.34354D0, 0.28753D0, 0.23679D0,
56707 & 0.19183D0, 0.15254D0, 0.11910D0, 0.09155D0, 0.06880D0,
56708 & 0.05059D0, 0.03647D0, 0.02554D0, 0.01155D0, 0.00456D0,
56709 & 0.00150D0, 0.00039D0, 0.00001D0, 0.00000D0/
56710 DATA (FMRS(2,3,I,11),I=1,49)/
56711 & 55.39180D0, 45.07076D0, 36.65840D0, 32.47479D0, 29.79258D0,
56712 & 27.86062D0, 22.58892D0, 18.24235D0, 16.04583D0, 14.61602D0,
56713 & 13.55394D0, 10.61757D0, 8.11747D0, 6.82180D0, 5.96451D0,
56714 & 5.33234D0, 4.43100D0, 3.54652D0, 2.64619D0, 2.09446D0,
56715 & 1.47626D0, 1.16746D0, 1.00084D0, 0.88523D0, 0.81292D0,
56716 & 0.75482D0, 0.69824D0, 0.63893D0, 0.57653D0, 0.51229D0,
56717 & 0.44790D0, 0.38538D0, 0.32625D0, 0.27173D0, 0.22275D0,
56718 & 0.17969D0, 0.14226D0, 0.11063D0, 0.08472D0, 0.06341D0,
56719 & 0.04647D0, 0.03337D0, 0.02328D0, 0.01046D0, 0.00410D0,
56720 & 0.00135D0, 0.00035D0, 0.00001D0, 0.00000D0/
56721 DATA (FMRS(2,3,I,12),I=1,49)/
56722 & 68.81419D0, 55.16745D0, 44.20809D0, 38.82247D0, 35.39534D0,
56723 & 32.94036D0, 26.30577D0, 20.91710D0, 18.22705D0, 16.48958D0,
56724 & 15.20488D0, 11.69679D0, 8.77186D0, 7.28789D0, 6.32113D0,
56725 & 5.61724D0, 4.62839D0, 3.67636D0, 2.72714D0, 2.15522D0,
56726 & 1.52072D0, 1.20219D0, 1.02548D0, 0.89610D0, 0.81011D0,
56727 & 0.73981D0, 0.67337D0, 0.60686D0, 0.53995D0, 0.47362D0,
56728 & 0.40911D0, 0.34808D0, 0.29158D0, 0.24046D0, 0.19523D0,
56729 & 0.15609D0, 0.12251D0, 0.09445D0, 0.07178D0, 0.05329D0,
56730 & 0.03875D0, 0.02763D0, 0.01914D0, 0.00848D0, 0.00328D0,
56731 & 0.00107D0, 0.00027D0, 0.00001D0, 0.00000D0/
56732 DATA (FMRS(2,3,I,13),I=1,49)/
56733 & 81.72071D0, 64.73620D0, 51.25830D0, 44.69851D0, 40.54929D0,
56734 & 37.59021D0, 29.65526D0, 23.28836D0, 20.14139D0, 18.12166D0,
56735 & 16.63424D0, 12.61228D0, 9.31401D0, 7.66787D0, 6.60816D0,
56736 & 5.84402D0, 4.78269D0, 3.77556D0, 2.78721D0, 2.19932D0,
56737 & 1.55169D0, 1.22492D0, 1.03973D0, 0.89912D0, 0.80240D0,
56738 & 0.72291D0, 0.64937D0, 0.57800D0, 0.50838D0, 0.44121D0,
56739 & 0.37732D0, 0.31807D0, 0.26412D0, 0.21603D0, 0.17402D0,
56740 & 0.13809D0, 0.10760D0, 0.08235D0, 0.06220D0, 0.04588D0,
56741 & 0.03314D0, 0.02349D0, 0.01618D0, 0.00709D0, 0.00272D0,
56742 & 0.00088D0, 0.00022D0, 0.00001D0, 0.00000D0/
56743 DATA (FMRS(2,3,I,14),I=1,49)/
56744 & 97.52657D0, 76.29261D0, 59.65305D0, 51.63612D0, 46.59734D0,
56745 & 43.02061D0, 33.50751D0, 25.97167D0, 22.28590D0, 19.93624D0,
56746 & 18.21366D0, 13.60275D0, 9.88582D0, 8.06142D0, 6.90102D0,
56747 & 6.07241D0, 4.93443D0, 3.87015D0, 2.84210D0, 2.23830D0,
56748 & 1.57740D0, 1.24193D0, 1.04776D0, 0.89562D0, 0.78827D0,
56749 & 0.70003D0, 0.62012D0, 0.54473D0, 0.47326D0, 0.40608D0,
56750 & 0.34362D0, 0.28678D0, 0.23589D0, 0.19121D0, 0.15279D0,
56751 & 0.12024D0, 0.09296D0, 0.07060D0, 0.05295D0, 0.03880D0,
56752 & 0.02782D0, 0.01961D0, 0.01341D0, 0.00581D0, 0.00221D0,
56753 & 0.00071D0, 0.00018D0, 0.00000D0, 0.00000D0/
56754 DATA (FMRS(2,3,I,15),I=1,49)/
56755 & 115.42858D0, 89.21046D0, 68.91241D0, 59.22810D0, 53.17852D0,
56756 & 48.90368D0, 37.62299D0, 28.79719D0, 24.52433D0, 21.81818D0,
56757 & 19.84305D0, 14.60749D0, 10.45530D0, 8.44881D0, 7.18665D0,
56758 & 6.29326D0, 5.07912D0, 3.95881D0, 2.89174D0, 2.27205D0,
56759 & 1.59726D0, 1.25251D0, 1.04935D0, 0.88634D0, 0.76946D0,
56760 & 0.67380D0, 0.58880D0, 0.51059D0, 0.43833D0, 0.37190D0,
56761 & 0.31141D0, 0.25732D0, 0.20974D0, 0.16850D0, 0.13349D0,
56762 & 0.10422D0, 0.07994D0, 0.06028D0, 0.04489D0, 0.03267D0,
56763 & 0.02328D0, 0.01630D0, 0.01109D0, 0.00475D0, 0.00179D0,
56764 & 0.00057D0, 0.00015D0, 0.00000D0, 0.00000D0/
56765 DATA (FMRS(2,3,I,16),I=1,49)/
56766 & 133.20726D0,101.88441D0, 77.88580D0, 66.53202D0, 59.47687D0,
56767 & 54.51081D0, 41.49468D0, 31.41946D0, 26.58451D0, 23.53963D0,
56768 & 21.32609D0, 15.50695D0, 10.95547D0, 8.78473D0, 7.43186D0,
56769 & 6.48132D0, 5.20052D0, 4.03146D0, 2.93090D0, 2.29753D0,
56770 & 1.61041D0, 1.25744D0, 1.04659D0, 0.87462D0, 0.75027D0,
56771 & 0.64906D0, 0.56054D0, 0.48074D0, 0.40844D0, 0.34317D0,
56772 & 0.28476D0, 0.23329D0, 0.18860D0, 0.15037D0, 0.11827D0,
56773 & 0.09171D0, 0.06985D0, 0.05235D0, 0.03876D0, 0.02805D0,
56774 & 0.01988D0, 0.01385D0, 0.00937D0, 0.00398D0, 0.00150D0,
56775 & 0.00048D0, 0.00012D0, 0.00000D0, 0.00000D0/
56776 DATA (FMRS(2,3,I,17),I=1,49)/
56777 & 152.75288D0,115.66533D0, 87.53463D0, 74.33386D0, 66.17272D0,
56778 & 60.44971D0, 45.54741D0, 34.13087D0, 28.69873D0, 25.29647D0,
56779 & 22.83273D0, 16.40709D0, 11.44748D0, 9.11138D0, 7.66812D0,
56780 & 6.66113D0, 5.31487D0, 4.09842D0, 2.96558D0, 2.31899D0,
56781 & 1.61977D0, 1.25878D0, 1.04063D0, 0.86046D0, 0.72956D0,
56782 & 0.62377D0, 0.53260D0, 0.45191D0, 0.38010D0, 0.31636D0,
56783 & 0.26019D0, 0.21141D0, 0.16955D0, 0.13419D0, 0.10481D0,
56784 & 0.08073D0, 0.06109D0, 0.04550D0, 0.03350D0, 0.02411D0,
56785 & 0.01700D0, 0.01178D0, 0.00794D0, 0.00335D0, 0.00125D0,
56786 & 0.00040D0, 0.00010D0, 0.00000D0, 0.00000D0/
56787 DATA (FMRS(2,3,I,18),I=1,49)/
56788 & 170.01192D0,127.71370D0, 95.88535D0, 81.04548D0, 71.90795D0,
56789 & 65.51928D0, 48.96956D0, 36.39437D0, 30.45131D0, 26.74517D0,
56790 & 24.06967D0, 17.13549D0, 11.83889D0, 9.36824D0, 7.85201D0,
56791 & 6.79985D0, 5.40144D0, 4.14772D0, 2.98965D0, 2.33267D0,
56792 & 1.62383D0, 1.25653D0, 1.03280D0, 0.84662D0, 0.71111D0,
56793 & 0.60235D0, 0.50969D0, 0.42880D0, 0.35778D0, 0.29558D0,
56794 & 0.24138D0, 0.19483D0, 0.15529D0, 0.12217D0, 0.09488D0,
56795 & 0.07271D0, 0.05474D0, 0.04057D0, 0.02974D0, 0.02131D0,
56796 & 0.01497D0, 0.01034D0, 0.00694D0, 0.00291D0, 0.00108D0,
56797 & 0.00035D0, 0.00009D0, 0.00000D0, 0.00000D0/
56798 DATA (FMRS(2,3,I,19),I=1,49)/
56799 & 192.21783D0,143.06714D0,106.42301D0, 89.46533D0, 79.07272D0,
56800 & 71.83153D0, 53.18588D0, 39.15232D0, 32.57201D0, 28.48916D0,
56801 & 25.55252D0, 17.99626D0, 12.29353D0, 9.66291D0, 8.06074D0,
56802 & 6.95556D0, 5.49677D0, 4.20023D0, 3.01333D0, 2.34451D0,
56803 & 1.62470D0, 1.25025D0, 1.02039D0, 0.82787D0, 0.68779D0,
56804 & 0.57628D0, 0.48256D0, 0.40194D0, 0.33226D0, 0.27214D0,
56805 & 0.22041D0, 0.17653D0, 0.13970D0, 0.10915D0, 0.08422D0,
56806 & 0.06416D0, 0.04803D0, 0.03538D0, 0.02582D0, 0.01841D0,
56807 & 0.01287D0, 0.00885D0, 0.00592D0, 0.00247D0, 0.00092D0,
56808 & 0.00029D0, 0.00008D0, 0.00000D0, 0.00000D0/
56809 DATA (FMRS(2,3,I,20),I=1,49)/
56810 & 213.34880D0,157.54303D0,116.26574D0, 97.28644D0, 85.70139D0,
56811 & 77.65329D0, 57.03621D0, 41.64487D0, 34.47643D0, 30.04790D0,
56812 & 26.87277D0, 18.75275D0, 12.68704D0, 9.91527D0, 8.23788D0,
56813 & 7.08656D0, 5.57571D0, 4.24254D0, 3.03117D0, 2.35234D0,
56814 & 1.62325D0, 1.24282D0, 1.00799D0, 0.81051D0, 0.66705D0,
56815 & 0.55370D0, 0.45951D0, 0.37948D0, 0.31121D0, 0.25302D0,
56816 & 0.20347D0, 0.16190D0, 0.12732D0, 0.09891D0, 0.07590D0,
56817 & 0.05752D0, 0.04285D0, 0.03141D0, 0.02283D0, 0.01621D0,
56818 & 0.01129D0, 0.00774D0, 0.00517D0, 0.00215D0, 0.00079D0,
56819 & 0.00025D0, 0.00007D0, 0.00000D0, 0.00000D0/
56820 DATA (FMRS(2,3,I,21),I=1,49)/
56821 & 233.39284D0,171.15466D0,125.43786D0,104.53514D0, 91.82097D0,
56822 & 83.01126D0, 60.54451D0, 43.89167D0, 36.18145D0, 31.43626D0,
56823 & 28.04374D0, 19.41375D0, 13.02433D0, 10.12820D0, 8.38525D0,
56824 & 7.19405D0, 5.63853D0, 4.27419D0, 3.04230D0, 2.35510D0,
56825 & 1.61821D0, 1.23292D0, 0.99418D0, 0.79299D0, 0.64721D0,
56826 & 0.53284D0, 0.43872D0, 0.35966D0, 0.29291D0, 0.23658D0,
56827 & 0.18910D0, 0.14961D0, 0.11702D0, 0.09045D0, 0.06907D0,
56828 & 0.05212D0, 0.03865D0, 0.02823D0, 0.02044D0, 0.01446D0,
56829 & 0.01004D0, 0.00687D0, 0.00457D0, 0.00189D0, 0.00070D0,
56830 & 0.00022D0, 0.00006D0, 0.00000D0, 0.00000D0/
56831 DATA (FMRS(2,3,I,22),I=1,49)/
56832 & 260.44016D0,189.36696D0,137.60457D0,114.10131D0, 99.86725D0,
56833 & 90.03576D0, 65.10178D0, 46.78208D0, 38.36169D0, 33.20363D0,
56834 & 29.52871D0, 20.24143D0, 13.44020D0, 10.38777D0, 8.56307D0,
56835 & 7.32250D0, 5.71195D0, 4.30962D0, 3.05294D0, 2.35572D0,
56836 & 1.60960D0, 1.21865D0, 0.97551D0, 0.77034D0, 0.62226D0,
56837 & 0.50716D0, 0.41356D0, 0.33596D0, 0.27128D0, 0.21734D0,
56838 & 0.17244D0, 0.13547D0, 0.10527D0, 0.08085D0, 0.06139D0,
56839 & 0.04607D0, 0.03398D0, 0.02471D0, 0.01781D0, 0.01255D0,
56840 & 0.00868D0, 0.00593D0, 0.00393D0, 0.00162D0, 0.00060D0,
56841 & 0.00019D0, 0.00005D0, 0.00000D0, 0.00000D0/
56842 DATA (FMRS(2,3,I,23),I=1,49)/
56843 & 287.44696D0,207.38838D0,149.53354D0,123.42919D0,107.68206D0,
56844 & 96.83708D0, 69.47065D0, 49.52397D0, 40.41636D0, 34.86102D0,
56845 & 30.91543D0, 21.00356D0, 13.81644D0, 10.61949D0, 8.71986D0,
56846 & 7.43441D0, 5.77408D0, 4.33783D0, 3.05923D0, 2.35324D0,
56847 & 1.59919D0, 1.20346D0, 0.95679D0, 0.74861D0, 0.59903D0,
56848 & 0.48379D0, 0.39106D0, 0.31505D0, 0.25241D0, 0.20076D0,
56849 & 0.15822D0, 0.12352D0, 0.09541D0, 0.07286D0, 0.05504D0,
56850 & 0.04110D0, 0.03018D0, 0.02185D0, 0.01570D0, 0.01103D0,
56851 & 0.00760D0, 0.00518D0, 0.00342D0, 0.00141D0, 0.00052D0,
56852 & 0.00017D0, 0.00004D0, 0.00000D0, 0.00000D0/
56853 DATA (FMRS(2,3,I,24),I=1,49)/
56854 & 313.51825D0,224.63136D0,160.84229D0,132.22295D0,115.01953D0,
56855 & 103.20245D0, 73.51698D0, 52.03463D0, 42.28400D0, 36.35911D0,
56856 & 32.16307D0, 21.67765D0, 14.14149D0, 10.81558D0, 8.84983D0,
56857 & 7.52509D0, 5.82169D0, 4.35654D0, 3.05952D0, 2.34629D0,
56858 & 1.58590D0, 1.18656D0, 0.93734D0, 0.72724D0, 0.57702D0,
56859 & 0.46218D0, 0.37070D0, 0.29646D0, 0.23590D0, 0.18642D0,
56860 & 0.14603D0, 0.11337D0, 0.08712D0, 0.06621D0, 0.04979D0,
56861 & 0.03702D0, 0.02708D0, 0.01953D0, 0.01399D0, 0.00980D0,
56862 & 0.00674D0, 0.00458D0, 0.00302D0, 0.00124D0, 0.00046D0,
56863 & 0.00015D0, 0.00004D0, 0.00000D0, 0.00000D0/
56864 DATA (FMRS(2,3,I,25),I=1,49)/
56865 & 341.15173D0,242.77290D0,172.65150D0,141.36496D0,122.62321D0,
56866 & 109.78229D0, 77.66644D0, 54.58787D0, 44.17350D0, 37.86890D0,
56867 & 33.41642D0, 22.34751D0, 14.46016D0, 11.00588D0, 8.97477D0,
56868 & 7.61137D0, 5.86592D0, 4.37273D0, 3.05810D0, 2.33803D0,
56869 & 1.57177D0, 1.16920D0, 0.91780D0, 0.70620D0, 0.55570D0,
56870 & 0.44154D0, 0.35145D0, 0.27905D0, 0.22057D0, 0.17322D0,
56871 & 0.13490D0, 0.10417D0, 0.07964D0, 0.06025D0, 0.04510D0,
56872 & 0.03340D0, 0.02434D0, 0.01749D0, 0.01249D0, 0.00873D0,
56873 & 0.00599D0, 0.00406D0, 0.00268D0, 0.00110D0, 0.00041D0,
56874 & 0.00013D0, 0.00004D0, 0.00000D0, 0.00000D0/
56875 DATA (FMRS(2,3,I,26),I=1,49)/
56876 & 368.98822D0,260.90195D0,184.35516D0,150.38000D0,130.09390D0,
56877 & 116.22827D0, 81.69344D0, 57.04021D0, 45.97627D0, 39.30195D0,
56878 & 34.60083D0, 22.97047D0, 14.74975D0, 11.17543D0, 9.08370D0,
56879 & 7.68467D0, 5.90104D0, 4.38251D0, 3.05244D0, 2.32659D0,
56880 & 1.55551D0, 1.15047D0, 0.89759D0, 0.68521D0, 0.53495D0,
56881 & 0.42187D0, 0.33342D0, 0.26295D0, 0.20656D0, 0.16128D0,
56882 & 0.12493D0, 0.09597D0, 0.07303D0, 0.05500D0, 0.04100D0,
56883 & 0.03027D0, 0.02198D0, 0.01575D0, 0.01122D0, 0.00782D0,
56884 & 0.00536D0, 0.00363D0, 0.00239D0, 0.00098D0, 0.00036D0,
56885 & 0.00012D0, 0.00003D0, 0.00000D0, 0.00000D0/
56886 DATA (FMRS(2,3,I,27),I=1,49)/
56887 & 396.49847D0,278.69458D0,195.76036D0,159.12776D0,137.32101D0,
56888 & 122.44904D0, 85.54959D0, 59.36906D0, 47.67925D0, 40.65031D0,
56889 & 35.71157D0, 23.54779D0, 15.01388D0, 11.32784D0, 9.18018D0,
56890 & 7.74858D0, 5.93008D0, 4.38884D0, 3.04508D0, 2.31422D0,
56891 & 1.53913D0, 1.13220D0, 0.87829D0, 0.66558D0, 0.51586D0,
56892 & 0.40401D0, 0.31721D0, 0.24862D0, 0.19419D0, 0.15083D0,
56893 & 0.11625D0, 0.08889D0, 0.06736D0, 0.05053D0, 0.03753D0,
56894 & 0.02761D0, 0.01999D0, 0.01428D0, 0.01015D0, 0.00707D0,
56895 & 0.00483D0, 0.00327D0, 0.00215D0, 0.00088D0, 0.00033D0,
56896 & 0.00011D0, 0.00003D0, 0.00000D0, 0.00000D0/
56897 DATA (FMRS(2,3,I,28),I=1,49)/
56898 & 423.18488D0,295.83777D0,206.67247D0,167.46211D0,144.18538D0,
56899 & 128.34305D0, 89.17443D0, 61.53922D0, 49.25727D0, 41.89430D0,
56900 & 36.73269D0, 24.07136D0, 15.24876D0, 11.46075D0, 9.26257D0,
56901 & 7.80186D0, 5.95221D0, 4.39115D0, 3.03561D0, 2.30059D0,
56902 & 1.52239D0, 1.11417D0, 0.85969D0, 0.64709D0, 0.49822D0,
56903 & 0.38776D0, 0.30261D0, 0.23584D0, 0.18326D0, 0.14166D0,
56904 & 0.10869D0, 0.08277D0, 0.06247D0, 0.04670D0, 0.03458D0,
56905 & 0.02536D0, 0.01831D0, 0.01305D0, 0.00927D0, 0.00644D0,
56906 & 0.00439D0, 0.00297D0, 0.00195D0, 0.00080D0, 0.00030D0,
56907 & 0.00010D0, 0.00003D0, 0.00000D0, 0.00000D0/
56908 DATA (FMRS(2,3,I,29),I=1,49)/
56909 & 450.92862D0,313.54996D0,217.87523D0,175.98549D0,151.18591D0,
56910 & 134.34097D0, 92.83694D0, 63.71518D0, 50.83173D0, 43.13081D0,
56911 & 37.74429D0, 24.58404D0, 15.47489D0, 11.58672D0, 9.33925D0,
56912 & 7.85026D0, 5.97071D0, 4.39081D0, 3.02434D0, 2.28559D0,
56913 & 1.50481D0, 1.09565D0, 0.84093D0, 0.62877D0, 0.48096D0,
56914 & 0.37201D0, 0.28863D0, 0.22371D0, 0.17297D0, 0.13307D0,
56915 & 0.10166D0, 0.07711D0, 0.05798D0, 0.04320D0, 0.03189D0,
56916 & 0.02332D0, 0.01680D0, 0.01195D0, 0.00847D0, 0.00587D0,
56917 & 0.00400D0, 0.00270D0, 0.00178D0, 0.00073D0, 0.00027D0,
56918 & 0.00009D0, 0.00002D0, 0.00000D0, 0.00000D0/
56919 DATA (FMRS(2,3,I,30),I=1,49)/
56920 & 478.88074D0,331.28183D0,229.01660D0,184.42841D0,158.10007D0,
56921 & 140.25114D0, 96.41853D0, 65.82523D0, 52.35015D0, 44.31818D0,
56922 & 38.71195D0, 25.06767D0, 15.68364D0, 11.70050D0, 9.40671D0,
56923 & 7.89123D0, 5.98412D0, 4.38708D0, 3.01099D0, 2.26914D0,
56924 & 1.48646D0, 1.07684D0, 0.82225D0, 0.61085D0, 0.46437D0,
56925 & 0.35704D0, 0.27550D0, 0.21242D0, 0.16347D0, 0.12519D0,
56926 & 0.09525D0, 0.07197D0, 0.05394D0, 0.04005D0, 0.02949D0,
56927 & 0.02151D0, 0.01546D0, 0.01097D0, 0.00776D0, 0.00538D0,
56928 & 0.00366D0, 0.00247D0, 0.00162D0, 0.00067D0, 0.00025D0,
56929 & 0.00008D0, 0.00002D0, 0.00000D0, 0.00000D0/
56930 DATA (FMRS(2,3,I,31),I=1,49)/
56931 & 506.38092D0,348.62979D0,239.85460D0,192.61319D0,164.78622D0,
56932 & 145.95520D0, 99.85363D0, 67.83522D0, 53.79026D0, 45.44058D0,
56933 & 39.62410D0, 25.51892D0, 15.87554D0, 11.80362D0, 9.46678D0,
56934 & 7.92687D0, 5.99445D0, 4.38186D0, 2.99723D0, 2.25276D0,
56935 & 1.46868D0, 1.05889D0, 0.80464D0, 0.59419D0, 0.44909D0,
56936 & 0.34338D0, 0.26361D0, 0.20228D0, 0.15498D0, 0.11820D0,
56937 & 0.08960D0, 0.06746D0, 0.05040D0, 0.03731D0, 0.02741D0,
56938 & 0.01994D0, 0.01431D0, 0.01014D0, 0.00716D0, 0.00495D0,
56939 & 0.00337D0, 0.00227D0, 0.00149D0, 0.00061D0, 0.00023D0,
56940 & 0.00007D0, 0.00002D0, 0.00000D0, 0.00000D0/
56941 DATA (FMRS(2,3,I,32),I=1,49)/
56942 & 532.71063D0,365.14023D0,250.10423D0,200.32385D0,171.06720D0,
56943 & 151.30153D0,103.04897D0, 69.68893D0, 55.11074D0, 46.46502D0,
56944 & 40.45333D0, 25.92270D0, 16.04272D0, 11.89083D0, 9.51556D0,
56945 & 7.95409D0, 5.99947D0, 4.37358D0, 2.98195D0, 2.23557D0,
56946 & 1.45083D0, 1.04132D0, 0.78773D0, 0.57848D0, 0.43489D0,
56947 & 0.33086D0, 0.25280D0, 0.19316D0, 0.14738D0, 0.11200D0,
56948 & 0.08461D0, 0.06352D0, 0.04732D0, 0.03494D0, 0.02560D0,
56949 & 0.01860D0, 0.01332D0, 0.00942D0, 0.00665D0, 0.00459D0,
56950 & 0.00312D0, 0.00210D0, 0.00138D0, 0.00057D0, 0.00021D0,
56951 & 0.00007D0, 0.00002D0, 0.00000D0, 0.00000D0/
56952 DATA (FMRS(2,3,I,33),I=1,49)/
56953 & 560.44952D0,382.45715D0,260.80753D0,208.35481D0,177.59706D0,
56954 & 156.85155D0,106.35128D0, 71.59602D0, 56.46558D0, 47.51407D0,
56955 & 41.30114D0, 26.33344D0, 16.21190D0, 11.97881D0, 9.56466D0,
56956 & 7.98144D0, 6.00450D0, 4.36531D0, 2.96673D0, 2.21850D0,
56957 & 1.43317D0, 1.02401D0, 0.77116D0, 0.56317D0, 0.42112D0,
56958 & 0.31878D0, 0.24243D0, 0.18443D0, 0.14015D0, 0.10612D0,
56959 & 0.07989D0, 0.05980D0, 0.04442D0, 0.03272D0, 0.02392D0,
56960 & 0.01734D0, 0.01239D0, 0.00875D0, 0.00617D0, 0.00426D0,
56961 & 0.00289D0, 0.00195D0, 0.00128D0, 0.00052D0, 0.00020D0,
56962 & 0.00006D0, 0.00002D0, 0.00000D0, 0.00000D0/
56963 DATA (FMRS(2,3,I,34),I=1,49)/
56964 & 587.66711D0,399.34082D0,271.17145D0,216.09799D0,183.87283D0,
56965 & 162.17198D0,109.48943D0, 73.38959D0, 57.73061D0, 48.48780D0,
56966 & 42.08379D0, 26.70440D0, 16.35846D0, 12.05124D0, 9.60203D0,
56967 & 7.99942D0, 6.00308D0, 4.35260D0, 2.94870D0, 2.19937D0,
56968 & 1.41431D0, 1.00609D0, 0.75435D0, 0.54797D0, 0.40769D0,
56969 & 0.30718D0, 0.23257D0, 0.17622D0, 0.13341D0, 0.10068D0,
56970 & 0.07556D0, 0.05639D0, 0.04179D0, 0.03071D0, 0.02240D0,
56971 & 0.01621D0, 0.01157D0, 0.00816D0, 0.00575D0, 0.00396D0,
56972 & 0.00269D0, 0.00181D0, 0.00119D0, 0.00049D0, 0.00018D0,
56973 & 0.00006D0, 0.00002D0, 0.00000D0, 0.00000D0/
56974 DATA (FMRS(2,3,I,35),I=1,49)/
56975 & 614.66376D0,416.01791D0,281.36646D0,223.69629D0,190.02084D0,
56976 & 167.37685D0,112.54659D0, 75.12943D0, 58.95456D0, 49.42817D0,
56977 & 42.83852D0, 27.06040D0, 16.49837D0, 12.12015D0, 9.63748D0,
56978 & 8.01641D0, 6.00168D0, 4.34055D0, 2.93168D0, 2.18137D0,
56979 & 1.39666D0, 0.98938D0, 0.73876D0, 0.53395D0, 0.39535D0,
56980 & 0.29658D0, 0.22360D0, 0.16878D0, 0.12732D0, 0.09577D0,
56981 & 0.07167D0, 0.05334D0, 0.03944D0, 0.02892D0, 0.02106D0,
56982 & 0.01521D0, 0.01085D0, 0.00764D0, 0.00537D0, 0.00370D0,
56983 & 0.00251D0, 0.00169D0, 0.00111D0, 0.00046D0, 0.00017D0,
56984 & 0.00006D0, 0.00002D0, 0.00000D0, 0.00000D0/
56985 DATA (FMRS(2,3,I,36),I=1,49)/
56986 & 640.64490D0,431.98953D0,291.07977D0,230.91319D0,195.84616D0,
56987 & 172.29993D0,115.42027D0, 76.75350D0, 60.09168D0, 50.29848D0,
56988 & 43.53482D0, 27.38445D0, 16.62263D0, 12.17943D0, 9.66642D0,
56989 & 8.02868D0, 5.99763D0, 4.32731D0, 2.91439D0, 2.16350D0,
56990 & 1.37952D0, 0.97339D0, 0.72400D0, 0.52085D0, 0.38394D0,
56991 & 0.28684D0, 0.21543D0, 0.16204D0, 0.12184D0, 0.09139D0,
56992 & 0.06820D0, 0.05064D0, 0.03736D0, 0.02734D0, 0.01987D0,
56993 & 0.01434D0, 0.01021D0, 0.00718D0, 0.00505D0, 0.00348D0,
56994 & 0.00236D0, 0.00159D0, 0.00104D0, 0.00043D0, 0.00016D0,
56995 & 0.00005D0, 0.00001D0, 0.00000D0, 0.00000D0/
56996 DATA (FMRS(2,3,I,37),I=1,49)/
56997 & 667.19971D0,448.23413D0,300.90906D0,238.19307D0,201.70891D0,
56998 & 177.24495D0,118.28902D0, 78.36304D0, 61.21302D0, 51.15329D0,
56999 & 44.21644D0, 27.69705D0, 16.73916D0, 12.23290D0, 9.69072D0,
57000 & 8.03703D0, 5.99069D0, 4.31202D0, 2.89571D0, 2.14460D0,
57001 & 1.36178D0, 0.95706D0, 0.70912D0, 0.50779D0, 0.37268D0,
57002 & 0.27731D0, 0.20750D0, 0.15552D0, 0.11658D0, 0.08719D0,
57003 & 0.06491D0, 0.04808D0, 0.03540D0, 0.02586D0, 0.01877D0,
57004 & 0.01352D0, 0.00961D0, 0.00676D0, 0.00475D0, 0.00327D0,
57005 & 0.00222D0, 0.00149D0, 0.00098D0, 0.00040D0, 0.00015D0,
57006 & 0.00005D0, 0.00001D0, 0.00000D0, 0.00000D0/
57007 DATA (FMRS(2,3,I,38),I=1,49)/
57008 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57009 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57010 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57011 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57012 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57013 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57014 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57015 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57016 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57017 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57018 DATA (FMRS(2,4,I, 1),I=1,49)/
57019 & 0.96883D0, 0.83010D0, 0.71060D0, 0.64853D0, 0.60767D0,
57020 & 0.57770D0, 0.49346D0, 0.42161D0, 0.38501D0, 0.36146D0,
57021 & 0.34535D0, 0.30095D0, 0.26559D0, 0.24803D0, 0.23669D0,
57022 & 0.22831D0, 0.21597D0, 0.20255D0, 0.18524D0, 0.17029D0,
57023 & 0.14323D0, 0.11890D0, 0.09745D0, 0.07499D0, 0.05725D0,
57024 & 0.04365D0, 0.03351D0, 0.02602D0, 0.02043D0, 0.01653D0,
57025 & 0.01318D0, 0.01067D0, 0.00853D0, 0.00671D0, 0.00530D0,
57026 & 0.00405D0, 0.00296D0, 0.00217D0, 0.00162D0, 0.00103D0,
57027 & 0.00065D0, 0.00047D0, 0.00023D0, 0.00008D0, 0.00004D0,
57028 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
57029 DATA (FMRS(2,4,I, 2),I=1,49)/
57030 & 0.97285D0, 0.83723D0, 0.71985D0, 0.65865D0, 0.61827D0,
57031 & 0.58859D0, 0.50491D0, 0.43319D0, 0.39649D0, 0.37279D0,
57032 & 0.35657D0, 0.31149D0, 0.27487D0, 0.25626D0, 0.24402D0,
57033 & 0.23487D0, 0.22125D0, 0.20637D0, 0.18739D0, 0.17135D0,
57034 & 0.14312D0, 0.11837D0, 0.09689D0, 0.07465D0, 0.05719D0,
57035 & 0.04386D0, 0.03391D0, 0.02652D0, 0.02098D0, 0.01703D0,
57036 & 0.01365D0, 0.01107D0, 0.00885D0, 0.00698D0, 0.00550D0,
57037 & 0.00421D0, 0.00309D0, 0.00226D0, 0.00169D0, 0.00108D0,
57038 & 0.00069D0, 0.00049D0, 0.00025D0, 0.00010D0, 0.00003D0,
57039 & 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0/
57040 DATA (FMRS(2,4,I, 3),I=1,49)/
57041 & 0.99630D0, 0.86193D0, 0.74498D0, 0.68373D0, 0.64319D0,
57042 & 0.61334D0, 0.52882D0, 0.45586D0, 0.41827D0, 0.39388D0,
57043 & 0.37707D0, 0.32984D0, 0.29034D0, 0.26968D0, 0.25582D0,
57044 & 0.24531D0, 0.22956D0, 0.21234D0, 0.19077D0, 0.17310D0,
57045 & 0.14315D0, 0.11778D0, 0.09624D0, 0.07426D0, 0.05716D0,
57046 & 0.04417D0, 0.03445D0, 0.02716D0, 0.02168D0, 0.01765D0,
57047 & 0.01422D0, 0.01151D0, 0.00919D0, 0.00726D0, 0.00569D0,
57048 & 0.00437D0, 0.00323D0, 0.00233D0, 0.00177D0, 0.00113D0,
57049 & 0.00072D0, 0.00052D0, 0.00028D0, 0.00011D0, 0.00003D0,
57050 & 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0/
57051 DATA (FMRS(2,4,I, 4),I=1,49)/
57052 & 1.02892D0, 0.89240D0, 0.77327D0, 0.71073D0, 0.66929D0,
57053 & 0.63873D0, 0.55202D0, 0.47687D0, 0.43798D0, 0.41263D0,
57054 & 0.39503D0, 0.34528D0, 0.30287D0, 0.28033D0, 0.26505D0,
57055 & 0.25342D0, 0.23594D0, 0.21688D0, 0.19336D0, 0.17449D0,
57056 & 0.14328D0, 0.11746D0, 0.09586D0, 0.07403D0, 0.05716D0,
57057 & 0.04437D0, 0.03479D0, 0.02755D0, 0.02207D0, 0.01800D0,
57058 & 0.01451D0, 0.01172D0, 0.00935D0, 0.00736D0, 0.00577D0,
57059 & 0.00444D0, 0.00328D0, 0.00236D0, 0.00178D0, 0.00114D0,
57060 & 0.00075D0, 0.00052D0, 0.00029D0, 0.00011D0, 0.00004D0,
57061 & 0.00003D0, 0.00000D0, 0.00000D0, 0.00000D0/
57062 DATA (FMRS(2,4,I, 5),I=1,49)/
57063 & 1.08451D0, 0.94133D0, 0.81630D0, 0.75061D0, 0.70706D0,
57064 & 0.67493D0, 0.58367D0, 0.50437D0, 0.46318D0, 0.43623D0,
57065 & 0.41737D0, 0.36373D0, 0.31732D0, 0.29240D0, 0.27539D0,
57066 & 0.26243D0, 0.24295D0, 0.22186D0, 0.19623D0, 0.17608D0,
57067 & 0.14355D0, 0.11725D0, 0.09556D0, 0.07384D0, 0.05715D0,
57068 & 0.04453D0, 0.03504D0, 0.02784D0, 0.02236D0, 0.01824D0,
57069 & 0.01470D0, 0.01187D0, 0.00949D0, 0.00742D0, 0.00580D0,
57070 & 0.00445D0, 0.00328D0, 0.00235D0, 0.00175D0, 0.00116D0,
57071 & 0.00074D0, 0.00053D0, 0.00029D0, 0.00011D0, 0.00004D0,
57072 & 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0/
57073 DATA (FMRS(2,4,I, 6),I=1,49)/
57074 & 1.14357D0, 0.99242D0, 0.86045D0, 0.79114D0, 0.74518D0,
57075 & 0.71127D0, 0.61492D0, 0.53108D0, 0.48742D0, 0.45878D0,
57076 & 0.43857D0, 0.38094D0, 0.33056D0, 0.30333D0, 0.28470D0,
57077 & 0.27048D0, 0.24918D0, 0.22626D0, 0.19875D0, 0.17749D0,
57078 & 0.14383D0, 0.11711D0, 0.09533D0, 0.07370D0, 0.05713D0,
57079 & 0.04464D0, 0.03521D0, 0.02805D0, 0.02256D0, 0.01839D0,
57080 & 0.01482D0, 0.01197D0, 0.00955D0, 0.00745D0, 0.00580D0,
57081 & 0.00443D0, 0.00326D0, 0.00233D0, 0.00174D0, 0.00116D0,
57082 & 0.00074D0, 0.00053D0, 0.00029D0, 0.00011D0, 0.00004D0,
57083 & 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0/
57084 DATA (FMRS(2,4,I, 7),I=1,49)/
57085 & 1.21691D0, 1.05450D0, 0.91294D0, 0.83868D0, 0.78948D0,
57086 & 0.75319D0, 0.65015D0, 0.56049D0, 0.51374D0, 0.48302D0,
57087 & 0.46120D0, 0.39885D0, 0.34401D0, 0.31429D0, 0.29395D0,
57088 & 0.27845D0, 0.25529D0, 0.23055D0, 0.20123D0, 0.17890D0,
57089 & 0.14416D0, 0.11703D0, 0.09514D0, 0.07357D0, 0.05711D0,
57090 & 0.04471D0, 0.03532D0, 0.02818D0, 0.02268D0, 0.01846D0,
57091 & 0.01487D0, 0.01199D0, 0.00952D0, 0.00742D0, 0.00577D0,
57092 & 0.00441D0, 0.00322D0, 0.00229D0, 0.00172D0, 0.00114D0,
57093 & 0.00072D0, 0.00051D0, 0.00029D0, 0.00010D0, 0.00004D0,
57094 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
57095 DATA (FMRS(2,4,I, 8),I=1,49)/
57096 & 1.31000D0, 1.13230D0, 0.97784D0, 0.89699D0, 0.84348D0,
57097 & 0.80406D0, 0.69226D0, 0.59511D0, 0.54444D0, 0.51110D0,
57098 & 0.48726D0, 0.41913D0, 0.35898D0, 0.32638D0, 0.30408D0,
57099 & 0.28713D0, 0.26192D0, 0.23518D0, 0.20389D0, 0.18042D0,
57100 & 0.14454D0, 0.11697D0, 0.09497D0, 0.07342D0, 0.05705D0,
57101 & 0.04474D0, 0.03539D0, 0.02827D0, 0.02275D0, 0.01851D0,
57102 & 0.01488D0, 0.01197D0, 0.00947D0, 0.00737D0, 0.00571D0,
57103 & 0.00437D0, 0.00318D0, 0.00224D0, 0.00169D0, 0.00111D0,
57104 & 0.00070D0, 0.00049D0, 0.00029D0, 0.00010D0, 0.00004D0,
57105 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
57106 DATA (FMRS(2,4,I, 9),I=1,49)/
57107 & 1.40457D0, 1.21051D0, 1.04237D0, 0.95458D0, 0.89657D0,
57108 & 0.85387D0, 0.73299D0, 0.62815D0, 0.57350D0, 0.53752D0,
57109 & 0.51167D0, 0.43783D0, 0.37258D0, 0.33726D0, 0.31316D0,
57110 & 0.29488D0, 0.26778D0, 0.23925D0, 0.20624D0, 0.18177D0,
57111 & 0.14489D0, 0.11694D0, 0.09483D0, 0.07330D0, 0.05698D0,
57112 & 0.04474D0, 0.03543D0, 0.02831D0, 0.02277D0, 0.01852D0,
57113 & 0.01487D0, 0.01192D0, 0.00942D0, 0.00732D0, 0.00564D0,
57114 & 0.00433D0, 0.00313D0, 0.00219D0, 0.00166D0, 0.00109D0,
57115 & 0.00068D0, 0.00049D0, 0.00028D0, 0.00010D0, 0.00003D0,
57116 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
57117 DATA (FMRS(2,4,I,10),I=1,49)/
57118 & 1.51092D0, 1.29750D0, 1.11331D0, 1.01744D0, 0.95421D0,
57119 & 0.90772D0, 0.77643D0, 0.66288D0, 0.60378D0, 0.56488D0,
57120 & 0.53682D0, 0.45681D0, 0.38616D0, 0.34803D0, 0.32208D0,
57121 & 0.30246D0, 0.27350D0, 0.24321D0, 0.20851D0, 0.18308D0,
57122 & 0.14525D0, 0.11692D0, 0.09469D0, 0.07316D0, 0.05689D0,
57123 & 0.04470D0, 0.03541D0, 0.02828D0, 0.02274D0, 0.01846D0,
57124 & 0.01479D0, 0.01184D0, 0.00933D0, 0.00722D0, 0.00556D0,
57125 & 0.00426D0, 0.00307D0, 0.00215D0, 0.00161D0, 0.00106D0,
57126 & 0.00067D0, 0.00048D0, 0.00027D0, 0.00010D0, 0.00003D0,
57127 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
57128 DATA (FMRS(2,4,I,11),I=1,49)/
57129 & 1.60472D0, 1.37368D0, 1.17498D0, 1.07183D0, 1.00391D0,
57130 & 0.95405D0, 0.81348D0, 0.69224D0, 0.62923D0, 0.58777D0,
57131 & 0.55781D0, 0.47247D0, 0.39725D0, 0.35677D0, 0.32928D0,
57132 & 0.30856D0, 0.27807D0, 0.24637D0, 0.21032D0, 0.18413D0,
57133 & 0.14554D0, 0.11692D0, 0.09459D0, 0.07304D0, 0.05681D0,
57134 & 0.04465D0, 0.03537D0, 0.02823D0, 0.02270D0, 0.01839D0,
57135 & 0.01471D0, 0.01176D0, 0.00923D0, 0.00712D0, 0.00549D0,
57136 & 0.00419D0, 0.00301D0, 0.00213D0, 0.00157D0, 0.00105D0,
57137 & 0.00065D0, 0.00047D0, 0.00027D0, 0.00010D0, 0.00004D0,
57138 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
57139 DATA (FMRS(2,4,I,12),I=1,49)/
57140 & 1.83637D0, 1.55987D0, 1.32404D0, 1.20242D0, 1.12267D0,
57141 & 1.06429D0, 0.90056D0, 0.76032D0, 0.68777D0, 0.64012D0,
57142 & 0.60555D0, 0.50757D0, 0.42172D0, 0.37588D0, 0.34496D0,
57143 & 0.32177D0, 0.28792D0, 0.25312D0, 0.21417D0, 0.18636D0,
57144 & 0.14617D0, 0.11691D0, 0.09435D0, 0.07276D0, 0.05658D0,
57145 & 0.04447D0, 0.03521D0, 0.02807D0, 0.02254D0, 0.01819D0,
57146 & 0.01452D0, 0.01154D0, 0.00905D0, 0.00695D0, 0.00533D0,
57147 & 0.00404D0, 0.00292D0, 0.00205D0, 0.00149D0, 0.00100D0,
57148 & 0.00062D0, 0.00045D0, 0.00024D0, 0.00010D0, 0.00003D0,
57149 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
57150 DATA (FMRS(2,4,I,13),I=1,49)/
57151 & 2.07152D0, 1.74663D0, 1.47172D0, 1.33085D0, 1.23884D0,
57152 & 1.17167D0, 0.98420D0, 0.82476D0, 0.74268D0, 0.68890D0,
57153 & 0.64981D0, 0.53955D0, 0.44363D0, 0.39281D0, 0.35874D0,
57154 & 0.33333D0, 0.29647D0, 0.25893D0, 0.21746D0, 0.18826D0,
57155 & 0.14670D0, 0.11688D0, 0.09412D0, 0.07248D0, 0.05632D0,
57156 & 0.04424D0, 0.03500D0, 0.02787D0, 0.02234D0, 0.01798D0,
57157 & 0.01431D0, 0.01132D0, 0.00886D0, 0.00679D0, 0.00517D0,
57158 & 0.00390D0, 0.00284D0, 0.00195D0, 0.00143D0, 0.00095D0,
57159 & 0.00059D0, 0.00043D0, 0.00023D0, 0.00009D0, 0.00002D0,
57160 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
57161 DATA (FMRS(2,4,I,14),I=1,49)/
57162 & 2.37643D0, 1.98603D0, 1.65879D0, 1.49235D0, 1.38415D0,
57163 & 1.30543D0, 1.08702D0, 0.90288D0, 0.80867D0, 0.74716D0,
57164 & 0.70240D0, 0.57696D0, 0.46881D0, 0.41209D0, 0.37432D0,
57165 & 0.34632D0, 0.30599D0, 0.26535D0, 0.22106D0, 0.19032D0,
57166 & 0.14723D0, 0.11682D0, 0.09381D0, 0.07211D0, 0.05596D0,
57167 & 0.04392D0, 0.03471D0, 0.02757D0, 0.02204D0, 0.01767D0,
57168 & 0.01400D0, 0.01105D0, 0.00862D0, 0.00657D0, 0.00496D0,
57169 & 0.00374D0, 0.00270D0, 0.00182D0, 0.00137D0, 0.00090D0,
57170 & 0.00057D0, 0.00039D0, 0.00023D0, 0.00007D0, 0.00002D0,
57171 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
57172 DATA (FMRS(2,4,I,15),I=1,49)/
57173 & 2.74566D0, 2.27231D0, 1.87960D0, 1.68150D0, 1.55338D0,
57174 & 1.46052D0, 1.20454D0, 0.99082D0, 0.88227D0, 0.81170D0,
57175 & 0.76034D0, 0.61745D0, 0.49560D0, 0.43237D0, 0.39059D0,
57176 & 0.35980D0, 0.31580D0, 0.27191D0, 0.22470D0, 0.19238D0,
57177 & 0.14774D0, 0.11669D0, 0.09344D0, 0.07165D0, 0.05549D0,
57178 & 0.04347D0, 0.03429D0, 0.02720D0, 0.02166D0, 0.01729D0,
57179 & 0.01366D0, 0.01073D0, 0.00832D0, 0.00636D0, 0.00476D0,
57180 & 0.00357D0, 0.00255D0, 0.00175D0, 0.00131D0, 0.00086D0,
57181 & 0.00052D0, 0.00037D0, 0.00021D0, 0.00007D0, 0.00002D0,
57182 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
57183 DATA (FMRS(2,4,I,16),I=1,49)/
57184 & 3.12622D0, 2.56414D0, 2.10216D0, 1.87087D0, 1.72199D0,
57185 & 1.61445D0, 1.31978D0, 1.07596D0, 0.95298D0, 0.87335D0,
57186 & 0.81544D0, 0.65540D0, 0.52031D0, 0.45090D0, 0.40535D0,
57187 & 0.37197D0, 0.32458D0, 0.27772D0, 0.22787D0, 0.19414D0,
57188 & 0.14813D0, 0.11651D0, 0.09303D0, 0.07117D0, 0.05501D0,
57189 & 0.04302D0, 0.03385D0, 0.02678D0, 0.02128D0, 0.01692D0,
57190 & 0.01332D0, 0.01043D0, 0.00806D0, 0.00611D0, 0.00459D0,
57191 & 0.00341D0, 0.00242D0, 0.00166D0, 0.00123D0, 0.00082D0,
57192 & 0.00050D0, 0.00034D0, 0.00020D0, 0.00006D0, 0.00003D0,
57193 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
57194 DATA (FMRS(2,4,I,17),I=1,49)/
57195 & 3.55799D0, 2.89188D0, 2.34954D0, 2.08007D0, 1.90742D0,
57196 & 1.78316D0, 1.44470D0, 1.16721D0, 1.02825D0, 0.93863D0,
57197 & 0.87356D0, 0.69490D0, 0.54567D0, 0.46976D0, 0.42028D0,
57198 & 0.38422D0, 0.33334D0, 0.28346D0, 0.23097D0, 0.19583D0,
57199 & 0.14845D0, 0.11627D0, 0.09257D0, 0.07063D0, 0.05448D0,
57200 & 0.04252D0, 0.03337D0, 0.02631D0, 0.02087D0, 0.01652D0,
57201 & 0.01297D0, 0.01012D0, 0.00778D0, 0.00585D0, 0.00440D0,
57202 & 0.00326D0, 0.00231D0, 0.00157D0, 0.00115D0, 0.00076D0,
57203 & 0.00047D0, 0.00031D0, 0.00019D0, 0.00006D0, 0.00003D0,
57204 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
57205 DATA (FMRS(2,4,I,18),I=1,49)/
57206 & 3.95423D0, 3.18985D0, 2.57232D0, 2.26740D0, 2.07281D0,
57207 & 1.93314D0, 1.55464D0, 1.24668D0, 1.09337D0, 0.99486D0,
57208 & 0.92342D0, 0.72838D0, 0.56689D0, 0.48541D0, 0.43260D0,
57209 & 0.39429D0, 0.34049D0, 0.28810D0, 0.23344D0, 0.19715D0,
57210 & 0.14866D0, 0.11602D0, 0.09214D0, 0.07013D0, 0.05399D0,
57211 & 0.04205D0, 0.03295D0, 0.02591D0, 0.02050D0, 0.01618D0,
57212 & 0.01266D0, 0.00984D0, 0.00753D0, 0.00565D0, 0.00424D0,
57213 & 0.00314D0, 0.00221D0, 0.00150D0, 0.00109D0, 0.00072D0,
57214 & 0.00043D0, 0.00030D0, 0.00018D0, 0.00006D0, 0.00002D0,
57215 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
57216 DATA (FMRS(2,4,I,19),I=1,49)/
57217 & 4.48113D0, 3.58253D0, 2.86323D0, 2.51070D0, 2.28676D0,
57218 & 2.12659D0, 1.69508D0, 1.34718D0, 1.17523D0, 1.06522D0,
57219 & 0.98559D0, 0.76963D0, 0.59272D0, 0.50431D0, 0.44739D0,
57220 & 0.40630D0, 0.34895D0, 0.29355D0, 0.23628D0, 0.19863D0,
57221 & 0.14882D0, 0.11566D0, 0.09156D0, 0.06947D0, 0.05334D0,
57222 & 0.04144D0, 0.03238D0, 0.02540D0, 0.02000D0, 0.01574D0,
57223 & 0.01227D0, 0.00950D0, 0.00724D0, 0.00541D0, 0.00404D0,
57224 & 0.00298D0, 0.00211D0, 0.00142D0, 0.00103D0, 0.00067D0,
57225 & 0.00041D0, 0.00028D0, 0.00016D0, 0.00006D0, 0.00002D0,
57226 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
57227 DATA (FMRS(2,4,I,20),I=1,49)/
57228 & 4.99499D0, 3.96212D0, 3.14196D0, 2.74258D0, 2.48991D0,
57229 & 2.30973D0, 1.82681D0, 1.44056D0, 1.25085D0, 1.12995D0,
57230 & 1.04258D0, 0.80704D0, 0.61586D0, 0.52113D0, 0.46048D0,
57231 & 0.41689D0, 0.35636D0, 0.29827D0, 0.23871D0, 0.19986D0,
57232 & 0.14892D0, 0.11531D0, 0.09101D0, 0.06887D0, 0.05276D0,
57233 & 0.04087D0, 0.03186D0, 0.02494D0, 0.01954D0, 0.01534D0,
57234 & 0.01192D0, 0.00921D0, 0.00699D0, 0.00520D0, 0.00387D0,
57235 & 0.00284D0, 0.00201D0, 0.00135D0, 0.00099D0, 0.00063D0,
57236 & 0.00039D0, 0.00027D0, 0.00014D0, 0.00005D0, 0.00002D0,
57237 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57238 DATA (FMRS(2,4,I,21),I=1,49)/
57239 & 5.50061D0, 4.33261D0, 3.41176D0, 2.96594D0, 2.68491D0,
57240 & 2.48503D0, 1.95181D0, 1.52837D0, 1.32157D0, 1.19023D0,
57241 & 1.09549D0, 0.84140D0, 0.63686D0, 0.53627D0, 0.47219D0,
57242 & 0.42632D0, 0.36291D0, 0.30239D0, 0.24078D0, 0.20086D0,
57243 & 0.14892D0, 0.11489D0, 0.09045D0, 0.06826D0, 0.05215D0,
57244 & 0.04031D0, 0.03135D0, 0.02446D0, 0.01914D0, 0.01497D0,
57245 & 0.01162D0, 0.00892D0, 0.00678D0, 0.00502D0, 0.00373D0,
57246 & 0.00273D0, 0.00191D0, 0.00128D0, 0.00093D0, 0.00060D0,
57247 & 0.00037D0, 0.00026D0, 0.00014D0, 0.00005D0, 0.00001D0,
57248 & 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
57249 DATA (FMRS(2,4,I,22),I=1,49)/
57250 & 6.19859D0, 4.83989D0, 3.77815D0, 3.26780D0, 2.94753D0,
57251 & 2.72049D0, 2.11828D0, 1.64429D0, 1.41443D0, 1.26909D0,
57252 & 1.16448D0, 0.88574D0, 0.66367D0, 0.55547D0, 0.48697D0,
57253 & 0.43816D0, 0.37106D0, 0.30748D0, 0.24329D0, 0.20204D0,
57254 & 0.14885D0, 0.11433D0, 0.08969D0, 0.06745D0, 0.05136D0,
57255 & 0.03959D0, 0.03069D0, 0.02386D0, 0.01861D0, 0.01451D0,
57256 & 0.01121D0, 0.00856D0, 0.00649D0, 0.00480D0, 0.00355D0,
57257 & 0.00258D0, 0.00180D0, 0.00120D0, 0.00087D0, 0.00057D0,
57258 & 0.00034D0, 0.00024D0, 0.00013D0, 0.00004D0, 0.00001D0,
57259 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57260 DATA (FMRS(2,4,I,23),I=1,49)/
57261 & 6.91462D0, 5.35579D0, 4.14753D0, 3.57056D0, 3.20996D0,
57262 & 2.95511D0, 2.28266D0, 1.75769D0, 1.50477D0, 1.34548D0,
57263 & 1.23109D0, 0.92809D0, 0.68898D0, 0.57345D0, 0.50073D0,
57264 & 0.44914D0, 0.37855D0, 0.31211D0, 0.24552D0, 0.20305D0,
57265 & 0.14871D0, 0.11376D0, 0.08894D0, 0.06666D0, 0.05060D0,
57266 & 0.03890D0, 0.03007D0, 0.02332D0, 0.01811D0, 0.01408D0,
57267 & 0.01081D0, 0.00824D0, 0.00620D0, 0.00458D0, 0.00337D0,
57268 & 0.00246D0, 0.00171D0, 0.00112D0, 0.00082D0, 0.00053D0,
57269 & 0.00032D0, 0.00022D0, 0.00013D0, 0.00004D0, 0.00001D0,
57270 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57271 DATA (FMRS(2,4,I,24),I=1,49)/
57272 & 7.62855D0, 5.86601D0, 4.50985D0, 3.86607D0, 3.46522D0,
57273 & 3.18268D0, 2.44073D0, 1.86575D0, 1.59038D0, 1.41758D0,
57274 & 1.29375D0, 0.96750D0, 0.71223D0, 0.58984D0, 0.51319D0,
57275 & 0.45902D0, 0.38523D0, 0.31616D0, 0.24739D0, 0.20383D0,
57276 & 0.14846D0, 0.11312D0, 0.08817D0, 0.06586D0, 0.04986D0,
57277 & 0.03821D0, 0.02946D0, 0.02275D0, 0.01763D0, 0.01365D0,
57278 & 0.01046D0, 0.00797D0, 0.00597D0, 0.00439D0, 0.00323D0,
57279 & 0.00235D0, 0.00162D0, 0.00107D0, 0.00078D0, 0.00051D0,
57280 & 0.00031D0, 0.00021D0, 0.00012D0, 0.00003D0, 0.00001D0,
57281 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57282 DATA (FMRS(2,4,I,25),I=1,49)/
57283 & 8.39955D0, 6.41302D0, 4.89545D0, 4.17923D0, 3.73489D0,
57284 & 3.42253D0, 2.60607D0, 1.97793D0, 1.67884D0, 1.49183D0,
57285 & 1.35810D0, 1.00761D0, 0.73567D0, 0.60627D0, 0.52562D0,
57286 & 0.46884D0, 0.39183D0, 0.32012D0, 0.24919D0, 0.20455D0,
57287 & 0.14818D0, 0.11246D0, 0.08739D0, 0.06506D0, 0.04911D0,
57288 & 0.03752D0, 0.02885D0, 0.02220D0, 0.01716D0, 0.01324D0,
57289 & 0.01012D0, 0.00771D0, 0.00575D0, 0.00422D0, 0.00309D0,
57290 & 0.00225D0, 0.00154D0, 0.00103D0, 0.00074D0, 0.00048D0,
57291 & 0.00030D0, 0.00020D0, 0.00010D0, 0.00002D0, 0.00001D0,
57292 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57293 DATA (FMRS(2,4,I,26),I=1,49)/
57294 & 9.19737D0, 6.97494D0, 5.28863D0, 4.49714D0, 4.00779D0,
57295 & 3.66466D0, 2.77170D0, 2.08938D0, 1.76629D0, 1.56497D0,
57296 & 1.42130D0, 1.04661D0, 0.75821D0, 0.62194D0, 0.53740D0,
57297 & 0.47810D0, 0.39797D0, 0.32376D0, 0.25078D0, 0.20510D0,
57298 & 0.14782D0, 0.11174D0, 0.08657D0, 0.06424D0, 0.04835D0,
57299 & 0.03684D0, 0.02824D0, 0.02168D0, 0.01670D0, 0.01284D0,
57300 & 0.00977D0, 0.00742D0, 0.00552D0, 0.00404D0, 0.00296D0,
57301 & 0.00214D0, 0.00146D0, 0.00097D0, 0.00071D0, 0.00044D0,
57302 & 0.00028D0, 0.00017D0, 0.00010D0, 0.00003D0, 0.00001D0,
57303 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57304 DATA (FMRS(2,4,I,27),I=1,49)/
57305 & 10.00116D0, 7.53729D0, 5.67949D0, 4.81192D0, 4.27724D0,
57306 & 3.90320D0, 2.93374D0, 2.19765D0, 1.85088D0, 1.63549D0,
57307 & 1.48207D0, 1.08380D0, 0.77950D0, 0.63664D0, 0.54841D0,
57308 & 0.48671D0, 0.40364D0, 0.32707D0, 0.25218D0, 0.20556D0,
57309 & 0.14742D0, 0.11104D0, 0.08576D0, 0.06344D0, 0.04762D0,
57310 & 0.03619D0, 0.02766D0, 0.02119D0, 0.01627D0, 0.01248D0,
57311 & 0.00947D0, 0.00716D0, 0.00532D0, 0.00389D0, 0.00284D0,
57312 & 0.00205D0, 0.00139D0, 0.00092D0, 0.00068D0, 0.00042D0,
57313 & 0.00026D0, 0.00016D0, 0.00009D0, 0.00003D0, 0.00001D0,
57314 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57315 DATA (FMRS(2,4,I,28),I=1,49)/
57316 & 10.79744D0, 8.09092D0, 6.06186D0, 5.11871D0, 4.53915D0,
57317 & 4.13458D0, 3.08987D0, 2.30126D0, 1.93148D0, 1.70248D0,
57318 & 1.53966D0, 1.11875D0, 0.79931D0, 0.65024D0, 0.55853D0,
57319 & 0.49459D0, 0.40879D0, 0.33003D0, 0.25337D0, 0.20589D0,
57320 & 0.14698D0, 0.11033D0, 0.08498D0, 0.06267D0, 0.04691D0,
57321 & 0.03557D0, 0.02711D0, 0.02071D0, 0.01586D0, 0.01214D0,
57322 & 0.00920D0, 0.00692D0, 0.00514D0, 0.00376D0, 0.00272D0,
57323 & 0.00196D0, 0.00133D0, 0.00087D0, 0.00064D0, 0.00040D0,
57324 & 0.00025D0, 0.00016D0, 0.00009D0, 0.00003D0, 0.00001D0,
57325 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57326 DATA (FMRS(2,4,I,29),I=1,49)/
57327 & 11.63983D0, 8.67317D0, 6.46161D0, 5.43834D0, 4.81133D0,
57328 & 4.37457D0, 3.25082D0, 2.40738D0, 2.01373D0, 1.77063D0,
57329 & 1.59811D0, 1.15395D0, 0.81909D0, 0.66374D0, 0.56853D0,
57330 & 0.50235D0, 0.41381D0, 0.33288D0, 0.25448D0, 0.20616D0,
57331 & 0.14650D0, 0.10959D0, 0.08417D0, 0.06189D0, 0.04620D0,
57332 & 0.03495D0, 0.02656D0, 0.02024D0, 0.01545D0, 0.01181D0,
57333 & 0.00893D0, 0.00670D0, 0.00496D0, 0.00362D0, 0.00261D0,
57334 & 0.00187D0, 0.00127D0, 0.00083D0, 0.00060D0, 0.00038D0,
57335 & 0.00023D0, 0.00015D0, 0.00008D0, 0.00003D0, 0.00001D0,
57336 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57337 DATA (FMRS(2,4,I,30),I=1,49)/
57338 & 12.50504D0, 9.26774D0, 6.86743D0, 5.76168D0, 5.08599D0,
57339 & 4.61626D0, 3.41191D0, 2.51292D0, 2.09519D0, 1.83795D0,
57340 & 1.65570D0, 1.18836D0, 0.83825D0, 0.67674D0, 0.57810D0,
57341 & 0.50972D0, 0.41855D0, 0.33552D0, 0.25546D0, 0.20633D0,
57342 & 0.14597D0, 0.10882D0, 0.08334D0, 0.06111D0, 0.04550D0,
57343 & 0.03432D0, 0.02602D0, 0.01977D0, 0.01507D0, 0.01148D0,
57344 & 0.00865D0, 0.00649D0, 0.00478D0, 0.00347D0, 0.00250D0,
57345 & 0.00177D0, 0.00121D0, 0.00078D0, 0.00056D0, 0.00036D0,
57346 & 0.00022D0, 0.00014D0, 0.00008D0, 0.00002D0, 0.00001D0,
57347 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57348 DATA (FMRS(2,4,I,31),I=1,49)/
57349 & 13.36928D0, 9.85846D0, 7.26844D0, 6.08018D0, 5.35592D0,
57350 & 4.85338D0, 3.56907D0, 2.61529D0, 2.17393D0, 1.90285D0,
57351 & 1.71111D0, 1.22123D0, 0.85642D0, 0.68899D0, 0.58709D0,
57352 & 0.51663D0, 0.42295D0, 0.33794D0, 0.25632D0, 0.20644D0,
57353 & 0.14544D0, 0.10808D0, 0.08256D0, 0.06036D0, 0.04483D0,
57354 & 0.03373D0, 0.02551D0, 0.01933D0, 0.01470D0, 0.01117D0,
57355 & 0.00840D0, 0.00629D0, 0.00462D0, 0.00334D0, 0.00240D0,
57356 & 0.00170D0, 0.00116D0, 0.00075D0, 0.00053D0, 0.00034D0,
57357 & 0.00021D0, 0.00014D0, 0.00007D0, 0.00002D0, 0.00001D0,
57358 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57359 DATA (FMRS(2,4,I,32),I=1,49)/
57360 & 14.21204D0, 10.43149D0, 7.65538D0, 6.38652D0, 5.61495D0,
57361 & 5.08051D0, 3.71876D0, 2.71221D0, 2.24821D0, 1.96390D0,
57362 & 1.76311D0, 1.25185D0, 0.87317D0, 0.70020D0, 0.59526D0,
57363 & 0.52288D0, 0.42687D0, 0.34005D0, 0.25702D0, 0.20645D0,
57364 & 0.14487D0, 0.10733D0, 0.08179D0, 0.05963D0, 0.04417D0,
57365 & 0.03317D0, 0.02503D0, 0.01893D0, 0.01436D0, 0.01089D0,
57366 & 0.00816D0, 0.00610D0, 0.00447D0, 0.00322D0, 0.00232D0,
57367 & 0.00164D0, 0.00111D0, 0.00072D0, 0.00051D0, 0.00033D0,
57368 & 0.00020D0, 0.00013D0, 0.00007D0, 0.00002D0, 0.00001D0,
57369 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57370 DATA (FMRS(2,4,I,33),I=1,49)/
57371 & 15.10980D0, 11.03912D0, 8.06381D0, 6.70901D0, 5.88712D0,
57372 & 5.31881D0, 3.87508D0, 2.81294D0, 2.32519D0, 2.02704D0,
57373 & 1.81681D0, 1.28330D0, 0.89029D0, 0.71163D0, 0.60357D0,
57374 & 0.52922D0, 0.43085D0, 0.34218D0, 0.25771D0, 0.20646D0,
57375 & 0.14430D0, 0.10659D0, 0.08103D0, 0.05890D0, 0.04353D0,
57376 & 0.03261D0, 0.02455D0, 0.01854D0, 0.01403D0, 0.01061D0,
57377 & 0.00794D0, 0.00591D0, 0.00432D0, 0.00310D0, 0.00224D0,
57378 & 0.00159D0, 0.00107D0, 0.00069D0, 0.00049D0, 0.00032D0,
57379 & 0.00019D0, 0.00012D0, 0.00006D0, 0.00002D0, 0.00001D0,
57380 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57381 DATA (FMRS(2,4,I,34),I=1,49)/
57382 & 16.00814D0, 11.64399D0, 8.46821D0, 7.02730D0, 6.15513D0,
57383 & 5.55303D0, 4.02783D0, 2.91076D0, 2.39965D0, 2.08793D0,
57384 & 1.86846D0, 1.31328D0, 0.90643D0, 0.72231D0, 0.61128D0,
57385 & 0.53505D0, 0.43443D0, 0.34403D0, 0.25822D0, 0.20634D0,
57386 & 0.14366D0, 0.10580D0, 0.08022D0, 0.05817D0, 0.04288D0,
57387 & 0.03206D0, 0.02408D0, 0.01814D0, 0.01369D0, 0.01034D0,
57388 & 0.00771D0, 0.00572D0, 0.00418D0, 0.00300D0, 0.00216D0,
57389 & 0.00152D0, 0.00103D0, 0.00065D0, 0.00048D0, 0.00031D0,
57390 & 0.00018D0, 0.00012D0, 0.00006D0, 0.00002D0, 0.00001D0,
57391 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57392 DATA (FMRS(2,4,I,35),I=1,49)/
57393 & 16.90871D0, 12.24779D0, 8.87019D0, 7.34290D0, 6.42039D0,
57394 & 5.78454D0, 4.17816D0, 3.00661D0, 2.47242D0, 2.14733D0,
57395 & 1.91876D0, 1.34235D0, 0.92199D0, 0.73258D0, 0.61867D0,
57396 & 0.54063D0, 0.43786D0, 0.34580D0, 0.25870D0, 0.20622D0,
57397 & 0.14305D0, 0.10506D0, 0.07947D0, 0.05749D0, 0.04228D0,
57398 & 0.03154D0, 0.02364D0, 0.01777D0, 0.01338D0, 0.01009D0,
57399 & 0.00750D0, 0.00555D0, 0.00406D0, 0.00290D0, 0.00208D0,
57400 & 0.00145D0, 0.00100D0, 0.00062D0, 0.00047D0, 0.00030D0,
57401 & 0.00017D0, 0.00012D0, 0.00005D0, 0.00002D0, 0.00000D0,
57402 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57403 DATA (FMRS(2,4,I,36),I=1,49)/
57404 & 17.78739D0, 12.83436D0, 9.25897D0, 7.64732D0, 6.67578D0,
57405 & 6.00710D0, 4.32199D0, 3.09786D0, 2.54148D0, 2.20357D0,
57406 & 1.96631D0, 1.36964D0, 0.93649D0, 0.74208D0, 0.62547D0,
57407 & 0.54573D0, 0.44096D0, 0.34736D0, 0.25907D0, 0.20605D0,
57408 & 0.14244D0, 0.10433D0, 0.07874D0, 0.05683D0, 0.04170D0,
57409 & 0.03105D0, 0.02321D0, 0.01741D0, 0.01309D0, 0.00985D0,
57410 & 0.00731D0, 0.00540D0, 0.00394D0, 0.00282D0, 0.00201D0,
57411 & 0.00140D0, 0.00096D0, 0.00060D0, 0.00045D0, 0.00029D0,
57412 & 0.00016D0, 0.00012D0, 0.00005D0, 0.00001D0, 0.00000D0,
57413 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57414 DATA (FMRS(2,4,I,37),I=1,49)/
57415 & 18.69798D0, 13.43965D0, 9.65843D0, 7.95932D0, 6.93703D0,
57416 & 6.23444D0, 4.46823D0, 3.19019D0, 2.61115D0, 2.26017D0,
57417 & 2.01407D0, 1.39688D0, 0.95084D0, 0.75143D0, 0.63213D0,
57418 & 0.55070D0, 0.44393D0, 0.34881D0, 0.25937D0, 0.20581D0,
57419 & 0.14178D0, 0.10356D0, 0.07799D0, 0.05614D0, 0.04110D0,
57420 & 0.03053D0, 0.02278D0, 0.01705D0, 0.01280D0, 0.00961D0,
57421 & 0.00713D0, 0.00525D0, 0.00382D0, 0.00273D0, 0.00195D0,
57422 & 0.00136D0, 0.00092D0, 0.00058D0, 0.00043D0, 0.00028D0,
57423 & 0.00015D0, 0.00011D0, 0.00005D0, 0.00001D0, 0.00000D0,
57424 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57425 DATA (FMRS(2,4,I,38),I=1,49)/
57426 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57427 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57428 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57429 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57430 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57431 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57432 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57433 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57434 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57435 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57436 DATA (FMRS(2,5,I, 1),I=1,49)/
57437 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57438 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57439 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57440 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57441 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57442 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57443 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57444 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57445 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57446 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57447 DATA (FMRS(2,5,I, 2),I=1,49)/
57448 & 0.00003D0, 0.00002D0, 0.00002D0, 0.00002D0, 0.00002D0,
57449 & 0.00002D0, 0.00002D0, 0.00002D0, 0.00002D0, 0.00002D0,
57450 & 0.00002D0, 0.00002D0, 0.00002D0, 0.00002D0, 0.00002D0,
57451 & 0.00002D0, 0.00002D0, 0.00001D0, 0.00001D0, 0.00001D0,
57452 & 0.00001D0, 0.00001D0, 0.00001D0, 0.00001D0, 0.00001D0,
57453 & 0.00001D0, 0.00001D0, 0.00001D0, 0.00001D0, 0.00001D0,
57454 & 0.00001D0, 0.00001D0, 0.00001D0, 0.00001D0, 0.00001D0,
57455 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57456 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57457 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57458 DATA (FMRS(2,5,I, 3),I=1,49)/
57459 & 0.02821D0, 0.02609D0, 0.02411D0, 0.02301D0, 0.02226D0,
57460 & 0.02169D0, 0.01996D0, 0.01827D0, 0.01727D0, 0.01654D0,
57461 & 0.01595D0, 0.01400D0, 0.01174D0, 0.01027D0, 0.00917D0,
57462 & 0.00829D0, 0.00696D0, 0.00558D0, 0.00415D0, 0.00329D0,
57463 & 0.00239D0, 0.00200D0, 0.00182D0, 0.00170D0, 0.00161D0,
57464 & 0.00151D0, 0.00140D0, 0.00127D0, 0.00113D0, 0.00099D0,
57465 & 0.00084D0, 0.00071D0, 0.00058D0, 0.00047D0, 0.00038D0,
57466 & 0.00029D0, 0.00023D0, 0.00017D0, 0.00013D0, 0.00009D0,
57467 & 0.00006D0, 0.00004D0, 0.00003D0, 0.00001D0, 0.00000D0,
57468 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57469 DATA (FMRS(2,5,I, 4),I=1,49)/
57470 & 0.07423D0, 0.06794D0, 0.06215D0, 0.05896D0, 0.05679D0,
57471 & 0.05514D0, 0.05023D0, 0.04550D0, 0.04276D0, 0.04079D0,
57472 & 0.03919D0, 0.03404D0, 0.02827D0, 0.02460D0, 0.02188D0,
57473 & 0.01974D0, 0.01650D0, 0.01320D0, 0.00980D0, 0.00778D0,
57474 & 0.00567D0, 0.00475D0, 0.00430D0, 0.00399D0, 0.00376D0,
57475 & 0.00351D0, 0.00322D0, 0.00290D0, 0.00256D0, 0.00223D0,
57476 & 0.00189D0, 0.00158D0, 0.00129D0, 0.00104D0, 0.00083D0,
57477 & 0.00064D0, 0.00049D0, 0.00037D0, 0.00027D0, 0.00020D0,
57478 & 0.00014D0, 0.00009D0, 0.00006D0, 0.00002D0, 0.00000D0,
57479 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57480 DATA (FMRS(2,5,I, 5),I=1,49)/
57481 & 0.13335D0, 0.12014D0, 0.10818D0, 0.10170D0, 0.09731D0,
57482 & 0.09401D0, 0.08430D0, 0.07519D0, 0.07001D0, 0.06635D0,
57483 & 0.06344D0, 0.05426D0, 0.04442D0, 0.03837D0, 0.03396D0,
57484 & 0.03053D0, 0.02541D0, 0.02025D0, 0.01501D0, 0.01192D0,
57485 & 0.00870D0, 0.00726D0, 0.00654D0, 0.00602D0, 0.00561D0,
57486 & 0.00519D0, 0.00472D0, 0.00422D0, 0.00370D0, 0.00319D0,
57487 & 0.00269D0, 0.00224D0, 0.00183D0, 0.00146D0, 0.00116D0,
57488 & 0.00089D0, 0.00068D0, 0.00051D0, 0.00038D0, 0.00027D0,
57489 & 0.00019D0, 0.00013D0, 0.00008D0, 0.00003D0, 0.00000D0,
57490 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57491 DATA (FMRS(2,5,I, 6),I=1,49)/
57492 & 0.20163D0, 0.17920D0, 0.15918D0, 0.14846D0, 0.14125D0,
57493 & 0.13587D0, 0.12018D0, 0.10574D0, 0.09768D0, 0.09205D0,
57494 & 0.08763D0, 0.07395D0, 0.05979D0, 0.05130D0, 0.04521D0,
57495 & 0.04052D0, 0.03360D0, 0.02669D0, 0.01976D0, 0.01569D0,
57496 & 0.01145D0, 0.00954D0, 0.00855D0, 0.00780D0, 0.00720D0,
57497 & 0.00661D0, 0.00597D0, 0.00530D0, 0.00461D0, 0.00396D0,
57498 & 0.00333D0, 0.00275D0, 0.00223D0, 0.00178D0, 0.00140D0,
57499 & 0.00108D0, 0.00082D0, 0.00061D0, 0.00045D0, 0.00032D0,
57500 & 0.00022D0, 0.00015D0, 0.00010D0, 0.00003D0, 0.00000D0,
57501 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57502 DATA (FMRS(2,5,I, 7),I=1,49)/
57503 & 0.27774D0, 0.24395D0, 0.21415D0, 0.19835D0, 0.18780D0,
57504 & 0.17996D0, 0.15730D0, 0.13677D0, 0.12547D0, 0.11766D0,
57505 & 0.11157D0, 0.09303D0, 0.07437D0, 0.06341D0, 0.05566D0,
57506 & 0.04974D0, 0.04109D0, 0.03255D0, 0.02405D0, 0.01909D0,
57507 & 0.01394D0, 0.01158D0, 0.01033D0, 0.00936D0, 0.00857D0,
57508 & 0.00780D0, 0.00699D0, 0.00616D0, 0.00533D0, 0.00455D0,
57509 & 0.00380D0, 0.00313D0, 0.00253D0, 0.00201D0, 0.00157D0,
57510 & 0.00121D0, 0.00091D0, 0.00068D0, 0.00050D0, 0.00036D0,
57511 & 0.00024D0, 0.00016D0, 0.00011D0, 0.00003D0, 0.00000D0,
57512 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57513 DATA (FMRS(2,5,I, 8),I=1,49)/
57514 & 0.37644D0, 0.32674D0, 0.28346D0, 0.26073D0, 0.24565D0,
57515 & 0.23449D0, 0.20256D0, 0.17404D0, 0.15854D0, 0.14793D0,
57516 & 0.13972D0, 0.11511D0, 0.09095D0, 0.07707D0, 0.06738D0,
57517 & 0.06004D0, 0.04941D0, 0.03901D0, 0.02877D0, 0.02283D0,
57518 & 0.01667D0, 0.01381D0, 0.01226D0, 0.01101D0, 0.01000D0,
57519 & 0.00902D0, 0.00803D0, 0.00703D0, 0.00604D0, 0.00513D0,
57520 & 0.00426D0, 0.00349D0, 0.00280D0, 0.00222D0, 0.00173D0,
57521 & 0.00132D0, 0.00099D0, 0.00074D0, 0.00054D0, 0.00039D0,
57522 & 0.00026D0, 0.00017D0, 0.00011D0, 0.00003D0, 0.00000D0,
57523 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57524 DATA (FMRS(2,5,I, 9),I=1,49)/
57525 & 0.47784D0, 0.41072D0, 0.35284D0, 0.32270D0, 0.30279D0,
57526 & 0.28813D0, 0.24646D0, 0.20968D0, 0.18991D0, 0.17647D0,
57527 & 0.16612D0, 0.13548D0, 0.10603D0, 0.08938D0, 0.07787D0,
57528 & 0.06921D0, 0.05678D0, 0.04472D0, 0.03292D0, 0.02612D0,
57529 & 0.01906D0, 0.01575D0, 0.01392D0, 0.01241D0, 0.01119D0,
57530 & 0.01003D0, 0.00887D0, 0.00772D0, 0.00660D0, 0.00557D0,
57531 & 0.00461D0, 0.00376D0, 0.00301D0, 0.00237D0, 0.00184D0,
57532 & 0.00140D0, 0.00105D0, 0.00077D0, 0.00057D0, 0.00041D0,
57533 & 0.00027D0, 0.00018D0, 0.00011D0, 0.00003D0, 0.00000D0,
57534 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57535 DATA (FMRS(2,5,I,10),I=1,49)/
57536 & 0.58781D0, 0.50078D0, 0.42641D0, 0.38796D0, 0.36269D0,
57537 & 0.34414D0, 0.29176D0, 0.24601D0, 0.22164D0, 0.20518D0,
57538 & 0.19257D0, 0.15561D0, 0.12070D0, 0.10126D0, 0.08794D0,
57539 & 0.07799D0, 0.06379D0, 0.05011D0, 0.03684D0, 0.02922D0,
57540 & 0.02130D0, 0.01755D0, 0.01544D0, 0.01368D0, 0.01225D0,
57541 & 0.01090D0, 0.00959D0, 0.00830D0, 0.00706D0, 0.00594D0,
57542 & 0.00489D0, 0.00397D0, 0.00316D0, 0.00248D0, 0.00192D0,
57543 & 0.00146D0, 0.00109D0, 0.00080D0, 0.00059D0, 0.00042D0,
57544 & 0.00027D0, 0.00018D0, 0.00012D0, 0.00003D0, 0.00000D0,
57545 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57546 DATA (FMRS(2,5,I,11),I=1,49)/
57547 & 0.68602D0, 0.58051D0, 0.49095D0, 0.44491D0, 0.41476D0,
57548 & 0.39269D0, 0.33066D0, 0.27690D0, 0.24847D0, 0.22936D0,
57549 & 0.21477D0, 0.17232D0, 0.13275D0, 0.11095D0, 0.09613D0,
57550 & 0.08510D0, 0.06944D0, 0.05445D0, 0.03997D0, 0.03169D0,
57551 & 0.02308D0, 0.01898D0, 0.01663D0, 0.01466D0, 0.01306D0,
57552 & 0.01157D0, 0.01013D0, 0.00872D0, 0.00740D0, 0.00620D0,
57553 & 0.00508D0, 0.00411D0, 0.00327D0, 0.00256D0, 0.00197D0,
57554 & 0.00149D0, 0.00111D0, 0.00081D0, 0.00060D0, 0.00042D0,
57555 & 0.00028D0, 0.00018D0, 0.00012D0, 0.00003D0, 0.00000D0,
57556 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57557 DATA (FMRS(2,5,I,12),I=1,49)/
57558 & 0.92772D0, 0.77438D0, 0.64603D0, 0.58078D0, 0.53835D0,
57559 & 0.50746D0, 0.42147D0, 0.34811D0, 0.30983D0, 0.28433D0,
57560 & 0.26501D0, 0.20960D0, 0.15924D0, 0.13208D0, 0.11385D0,
57561 & 0.10043D0, 0.08155D0, 0.06370D0, 0.04663D0, 0.03692D0,
57562 & 0.02683D0, 0.02195D0, 0.01909D0, 0.01665D0, 0.01467D0,
57563 & 0.01287D0, 0.01115D0, 0.00952D0, 0.00801D0, 0.00666D0,
57564 & 0.00542D0, 0.00436D0, 0.00344D0, 0.00268D0, 0.00205D0,
57565 & 0.00155D0, 0.00115D0, 0.00083D0, 0.00061D0, 0.00043D0,
57566 & 0.00028D0, 0.00018D0, 0.00011D0, 0.00003D0, 0.00000D0,
57567 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57568 DATA (FMRS(2,5,I,13),I=1,49)/
57569 & 1.17595D0, 0.97076D0, 0.80093D0, 0.71538D0, 0.66007D0,
57570 & 0.61997D0, 0.50921D0, 0.41588D0, 0.36771D0, 0.33586D0,
57571 & 0.31184D0, 0.24377D0, 0.18310D0, 0.15092D0, 0.12956D0,
57572 & 0.11394D0, 0.09216D0, 0.07174D0, 0.05238D0, 0.04143D0,
57573 & 0.03003D0, 0.02446D0, 0.02114D0, 0.01827D0, 0.01595D0,
57574 & 0.01387D0, 0.01193D0, 0.01011D0, 0.00845D0, 0.00698D0,
57575 & 0.00565D0, 0.00451D0, 0.00355D0, 0.00275D0, 0.00209D0,
57576 & 0.00157D0, 0.00116D0, 0.00084D0, 0.00061D0, 0.00043D0,
57577 & 0.00028D0, 0.00018D0, 0.00011D0, 0.00003D0, 0.00000D0,
57578 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57579 DATA (FMRS(2,5,I,14),I=1,49)/
57580 & 1.49839D0, 1.22261D0, 0.99703D0, 0.88447D0, 0.81213D0,
57581 & 0.75993D0, 0.61688D0, 0.49791D0, 0.43718D0, 0.39731D0,
57582 & 0.36742D0, 0.28369D0, 0.21052D0, 0.17237D0, 0.14732D0,
57583 & 0.12915D0, 0.10402D0, 0.08067D0, 0.05873D0, 0.04638D0,
57584 & 0.03352D0, 0.02715D0, 0.02331D0, 0.01995D0, 0.01725D0,
57585 & 0.01486D0, 0.01267D0, 0.01065D0, 0.00884D0, 0.00725D0,
57586 & 0.00583D0, 0.00463D0, 0.00362D0, 0.00279D0, 0.00211D0,
57587 & 0.00158D0, 0.00116D0, 0.00083D0, 0.00061D0, 0.00043D0,
57588 & 0.00027D0, 0.00018D0, 0.00011D0, 0.00003D0, 0.00000D0,
57589 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57590 DATA (FMRS(2,5,I,15),I=1,49)/
57591 & 1.87945D0, 1.51634D0, 1.22268D0, 1.07750D0, 0.98475D0,
57592 & 0.91809D0, 0.73686D0, 0.58798D0, 0.51279D0, 0.46377D0,
57593 & 0.42722D0, 0.32591D0, 0.23902D0, 0.19443D0, 0.16545D0,
57594 & 0.14459D0, 0.11596D0, 0.08960D0, 0.06503D0, 0.05127D0,
57595 & 0.03691D0, 0.02973D0, 0.02534D0, 0.02147D0, 0.01838D0,
57596 & 0.01569D0, 0.01327D0, 0.01107D0, 0.00912D0, 0.00743D0,
57597 & 0.00594D0, 0.00469D0, 0.00364D0, 0.00279D0, 0.00210D0,
57598 & 0.00156D0, 0.00114D0, 0.00082D0, 0.00059D0, 0.00041D0,
57599 & 0.00026D0, 0.00017D0, 0.00010D0, 0.00003D0, 0.00000D0,
57600 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57601 DATA (FMRS(2,5,I,16),I=1,49)/
57602 & 2.27429D0, 1.81716D0, 1.45106D0, 1.27151D0, 1.15736D0,
57603 & 1.07564D0, 0.85491D0, 0.67549D0, 0.58568D0, 0.52749D0,
57604 & 0.48429D0, 0.36563D0, 0.26542D0, 0.21469D0, 0.18200D0,
57605 & 0.15862D0, 0.12673D0, 0.09760D0, 0.07063D0, 0.05559D0,
57606 & 0.03988D0, 0.03195D0, 0.02705D0, 0.02273D0, 0.01930D0,
57607 & 0.01634D0, 0.01371D0, 0.01136D0, 0.00930D0, 0.00753D0,
57608 & 0.00599D0, 0.00470D0, 0.00364D0, 0.00277D0, 0.00208D0,
57609 & 0.00154D0, 0.00112D0, 0.00080D0, 0.00058D0, 0.00040D0,
57610 & 0.00025D0, 0.00016D0, 0.00010D0, 0.00003D0, 0.00000D0,
57611 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57612 DATA (FMRS(2,5,I,17),I=1,49)/
57613 & 2.72539D0, 2.15724D0, 1.70653D0, 1.48715D0, 1.34837D0,
57614 & 1.24937D0, 0.98364D0, 0.76983D0, 0.66373D0, 0.59537D0,
57615 & 0.54484D0, 0.40724D0, 0.29272D0, 0.23547D0, 0.19888D0,
57616 & 0.17287D0, 0.13761D0, 0.10564D0, 0.07622D0, 0.05987D0,
57617 & 0.04278D0, 0.03409D0, 0.02869D0, 0.02390D0, 0.02012D0,
57618 & 0.01691D0, 0.01408D0, 0.01159D0, 0.00943D0, 0.00759D0,
57619 & 0.00600D0, 0.00469D0, 0.00361D0, 0.00273D0, 0.00204D0,
57620 & 0.00151D0, 0.00109D0, 0.00078D0, 0.00056D0, 0.00039D0,
57621 & 0.00024D0, 0.00015D0, 0.00009D0, 0.00003D0, 0.00000D0,
57622 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57623 DATA (FMRS(2,5,I,18),I=1,49)/
57624 & 3.13641D0, 2.46418D0, 1.93488D0, 1.67881D0, 1.51744D0,
57625 & 1.40264D0, 1.09608D0, 0.85138D0, 0.73076D0, 0.65340D0,
57626 & 0.59642D0, 0.44225D0, 0.31539D0, 0.25259D0, 0.21272D0,
57627 & 0.18450D0, 0.14644D0, 0.11211D0, 0.08069D0, 0.06328D0,
57628 & 0.04506D0, 0.03575D0, 0.02993D0, 0.02476D0, 0.02070D0,
57629 & 0.01729D0, 0.01432D0, 0.01172D0, 0.00949D0, 0.00760D0,
57630 & 0.00598D0, 0.00466D0, 0.00357D0, 0.00269D0, 0.00201D0,
57631 & 0.00147D0, 0.00106D0, 0.00075D0, 0.00054D0, 0.00038D0,
57632 & 0.00023D0, 0.00015D0, 0.00009D0, 0.00003D0, 0.00000D0,
57633 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57634 DATA (FMRS(2,5,I,19),I=1,49)/
57635 & 3.68153D0, 2.86757D0, 2.23222D0, 1.92702D0, 1.73553D0,
57636 & 1.59976D0, 1.23927D0, 0.95419D0, 0.81477D0, 0.72581D0,
57637 & 0.66053D0, 0.48527D0, 0.34292D0, 0.27324D0, 0.22931D0,
57638 & 0.19839D0, 0.15691D0, 0.11975D0, 0.08593D0, 0.06725D0,
57639 & 0.04768D0, 0.03762D0, 0.03130D0, 0.02569D0, 0.02130D0,
57640 & 0.01766D0, 0.01453D0, 0.01182D0, 0.00951D0, 0.00757D0,
57641 & 0.00594D0, 0.00459D0, 0.00350D0, 0.00264D0, 0.00195D0,
57642 & 0.00143D0, 0.00103D0, 0.00072D0, 0.00052D0, 0.00036D0,
57643 & 0.00022D0, 0.00014D0, 0.00008D0, 0.00003D0, 0.00000D0,
57644 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57645 DATA (FMRS(2,5,I,20),I=1,49)/
57646 & 4.21665D0, 3.26014D0, 2.51906D0, 2.16522D0, 1.94405D0,
57647 & 1.78768D0, 1.37455D0, 1.05042D0, 0.89295D0, 0.79293D0,
57648 & 0.71977D0, 0.52460D0, 0.36780D0, 0.29178D0, 0.24415D0,
57649 & 0.21076D0, 0.16620D0, 0.12648D0, 0.09052D0, 0.07070D0,
57650 & 0.04993D0, 0.03920D0, 0.03244D0, 0.02644D0, 0.02178D0,
57651 & 0.01794D0, 0.01467D0, 0.01187D0, 0.00951D0, 0.00753D0,
57652 & 0.00588D0, 0.00453D0, 0.00344D0, 0.00258D0, 0.00191D0,
57653 & 0.00139D0, 0.00099D0, 0.00070D0, 0.00050D0, 0.00035D0,
57654 & 0.00021D0, 0.00013D0, 0.00008D0, 0.00003D0, 0.00000D0,
57655 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57656 DATA (FMRS(2,5,I,21),I=1,49)/
57657 & 4.73651D0, 3.63839D0, 2.79314D0, 2.39169D0, 2.14159D0,
57658 & 1.96521D0, 1.50121D0, 1.13968D0, 0.96506D0, 0.85456D0,
57659 & 0.77398D0, 0.56020D0, 0.39006D0, 0.30823D0, 0.25724D0,
57660 & 0.22164D0, 0.17431D0, 0.13232D0, 0.09445D0, 0.07364D0,
57661 & 0.05181D0, 0.04050D0, 0.03335D0, 0.02701D0, 0.02212D0,
57662 & 0.01812D0, 0.01474D0, 0.01187D0, 0.00946D0, 0.00747D0,
57663 & 0.00580D0, 0.00446D0, 0.00337D0, 0.00252D0, 0.00185D0,
57664 & 0.00135D0, 0.00096D0, 0.00068D0, 0.00049D0, 0.00034D0,
57665 & 0.00020D0, 0.00013D0, 0.00007D0, 0.00003D0, 0.00000D0,
57666 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57667 DATA (FMRS(2,5,I,22),I=1,49)/
57668 & 5.45753D0, 4.15887D0, 3.16726D0, 2.69936D0, 2.40907D0,
57669 & 2.20495D0, 1.67083D0, 1.25820D0, 1.06032D0, 0.93568D0,
57670 & 0.84511D0, 0.60646D0, 0.41869D0, 0.32928D0, 0.27391D0,
57671 & 0.23544D0, 0.18455D0, 0.13964D0, 0.09936D0, 0.07728D0,
57672 & 0.05411D0, 0.04206D0, 0.03442D0, 0.02766D0, 0.02248D0,
57673 & 0.01829D0, 0.01478D0, 0.01184D0, 0.00938D0, 0.00736D0,
57674 & 0.00570D0, 0.00435D0, 0.00328D0, 0.00244D0, 0.00179D0,
57675 & 0.00129D0, 0.00092D0, 0.00065D0, 0.00046D0, 0.00032D0,
57676 & 0.00019D0, 0.00012D0, 0.00007D0, 0.00003D0, 0.00000D0,
57677 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57678 DATA (FMRS(2,5,I,23),I=1,49)/
57679 & 6.19783D0, 4.68879D0, 3.54494D0, 3.00840D0, 2.67675D0,
57680 & 2.44420D0, 1.83862D0, 1.37436D0, 1.15316D0, 1.01443D0,
57681 & 0.91394D0, 0.65074D0, 0.44579D0, 0.34906D0, 0.28951D0,
57682 & 0.24830D0, 0.19403D0, 0.14639D0, 0.10384D0, 0.08058D0,
57683 & 0.05616D0, 0.04343D0, 0.03534D0, 0.02820D0, 0.02276D0,
57684 & 0.01841D0, 0.01478D0, 0.01177D0, 0.00929D0, 0.00725D0,
57685 & 0.00558D0, 0.00425D0, 0.00319D0, 0.00236D0, 0.00173D0,
57686 & 0.00124D0, 0.00088D0, 0.00062D0, 0.00044D0, 0.00031D0,
57687 & 0.00018D0, 0.00011D0, 0.00007D0, 0.00003D0, 0.00000D0,
57688 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57689 DATA (FMRS(2,5,I,24),I=1,49)/
57690 & 6.92966D0, 5.20839D0, 3.91218D0, 3.30740D0, 2.93482D0,
57691 & 2.67420D0, 1.99847D0, 1.48399D0, 1.24028D0, 1.08801D0,
57692 & 0.97803D0, 0.69152D0, 0.47043D0, 0.36691D0, 0.30350D0,
57693 & 0.25978D0, 0.20243D0, 0.15231D0, 0.10773D0, 0.08341D0,
57694 & 0.05788D0, 0.04454D0, 0.03605D0, 0.02858D0, 0.02293D0,
57695 & 0.01844D0, 0.01473D0, 0.01167D0, 0.00917D0, 0.00713D0,
57696 & 0.00547D0, 0.00415D0, 0.00310D0, 0.00229D0, 0.00167D0,
57697 & 0.00120D0, 0.00085D0, 0.00059D0, 0.00043D0, 0.00030D0,
57698 & 0.00017D0, 0.00011D0, 0.00006D0, 0.00003D0, 0.00000D0,
57699 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57700 DATA (FMRS(2,5,I,25),I=1,49)/
57701 & 7.72396D0, 5.76848D0, 4.30532D0, 3.62618D0, 3.20915D0,
57702 & 2.91815D0, 2.16681D0, 1.59861D0, 1.33097D0, 1.16435D0,
57703 & 1.04435D0, 0.73337D0, 0.49551D0, 0.38498D0, 0.31761D0,
57704 & 0.27133D0, 0.21084D0, 0.15821D0, 0.11158D0, 0.08620D0,
57705 & 0.05955D0, 0.04560D0, 0.03673D0, 0.02893D0, 0.02307D0,
57706 & 0.01845D0, 0.01466D0, 0.01156D0, 0.00904D0, 0.00700D0,
57707 & 0.00535D0, 0.00404D0, 0.00301D0, 0.00221D0, 0.00161D0,
57708 & 0.00115D0, 0.00081D0, 0.00057D0, 0.00041D0, 0.00028D0,
57709 & 0.00017D0, 0.00010D0, 0.00006D0, 0.00003D0, 0.00000D0,
57710 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57711 DATA (FMRS(2,5,I,26),I=1,49)/
57712 & 8.54145D0, 6.34073D0, 4.70401D0, 3.94803D0, 3.48525D0,
57713 & 3.16305D0, 2.33446D0, 1.71181D0, 1.42007D0, 1.23908D0,
57714 & 1.10907D0, 0.77380D0, 0.51947D0, 0.40212D0, 0.33092D0,
57715 & 0.28218D0, 0.21869D0, 0.16367D0, 0.11510D0, 0.08871D0,
57716 & 0.06103D0, 0.04651D0, 0.03727D0, 0.02918D0, 0.02314D0,
57717 & 0.01840D0, 0.01456D0, 0.01142D0, 0.00889D0, 0.00686D0,
57718 & 0.00522D0, 0.00393D0, 0.00292D0, 0.00214D0, 0.00155D0,
57719 & 0.00111D0, 0.00078D0, 0.00054D0, 0.00039D0, 0.00027D0,
57720 & 0.00016D0, 0.00009D0, 0.00005D0, 0.00003D0, 0.00000D0,
57721 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57722 DATA (FMRS(2,5,I,27),I=1,49)/
57723 & 9.36625D0, 6.91445D0, 5.10115D0, 4.26741D0, 3.75848D0,
57724 & 3.40490D0, 2.49891D0, 1.82207D0, 1.50649D0, 1.31134D0,
57725 & 1.17150D0, 0.81249D0, 0.54219D0, 0.41829D0, 0.34343D0,
57726 & 0.29234D0, 0.22601D0, 0.16873D0, 0.11834D0, 0.09101D0,
57727 & 0.06235D0, 0.04731D0, 0.03774D0, 0.02938D0, 0.02318D0,
57728 & 0.01834D0, 0.01444D0, 0.01128D0, 0.00875D0, 0.00672D0,
57729 & 0.00510D0, 0.00383D0, 0.00283D0, 0.00207D0, 0.00150D0,
57730 & 0.00107D0, 0.00075D0, 0.00052D0, 0.00038D0, 0.00026D0,
57731 & 0.00015D0, 0.00009D0, 0.00005D0, 0.00003D0, 0.00000D0,
57732 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57733 DATA (FMRS(2,5,I,28),I=1,49)/
57734 & 10.18132D0, 7.47793D0, 5.48877D0, 4.57798D0, 4.02345D0,
57735 & 3.63894D0, 2.65699D0, 1.92733D0, 1.58864D0, 1.37981D0,
57736 & 1.23051D0, 0.84875D0, 0.56329D0, 0.43322D0, 0.35493D0,
57737 & 0.30165D0, 0.23267D0, 0.17330D0, 0.12123D0, 0.09305D0,
57738 & 0.06349D0, 0.04798D0, 0.03811D0, 0.02952D0, 0.02317D0,
57739 & 0.01825D0, 0.01431D0, 0.01114D0, 0.00861D0, 0.00659D0,
57740 & 0.00498D0, 0.00373D0, 0.00275D0, 0.00201D0, 0.00145D0,
57741 & 0.00103D0, 0.00072D0, 0.00050D0, 0.00036D0, 0.00026D0,
57742 & 0.00014D0, 0.00008D0, 0.00005D0, 0.00003D0, 0.00000D0,
57743 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57744 DATA (FMRS(2,5,I,29),I=1,49)/
57745 & 11.04388D0, 8.07089D0, 5.89435D0, 4.90182D0, 4.29909D0,
57746 & 3.88193D0, 2.82014D0, 2.03528D0, 1.67258D0, 1.44958D0,
57747 & 1.29048D0, 0.88533D0, 0.58442D0, 0.44808D0, 0.36634D0,
57748 & 0.31085D0, 0.23922D0, 0.17778D0, 0.12404D0, 0.09501D0,
57749 & 0.06457D0, 0.04859D0, 0.03843D0, 0.02962D0, 0.02314D0,
57750 & 0.01814D0, 0.01416D0, 0.01098D0, 0.00846D0, 0.00645D0,
57751 & 0.00486D0, 0.00363D0, 0.00267D0, 0.00194D0, 0.00140D0,
57752 & 0.00099D0, 0.00069D0, 0.00048D0, 0.00035D0, 0.00025D0,
57753 & 0.00014D0, 0.00008D0, 0.00005D0, 0.00003D0, 0.00000D0,
57754 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57755 DATA (FMRS(2,5,I,30),I=1,49)/
57756 & 11.92777D0, 8.67505D0, 6.30518D0, 5.22873D0, 4.57663D0,
57757 & 4.12613D0, 2.98306D0, 2.14237D0, 1.75551D0, 1.51831D0,
57758 & 1.34943D0, 0.92100D0, 0.60483D0, 0.46237D0, 0.37725D0,
57759 & 0.31962D0, 0.24543D0, 0.18198D0, 0.12665D0, 0.09681D0,
57760 & 0.06554D0, 0.04912D0, 0.03869D0, 0.02967D0, 0.02307D0,
57761 & 0.01801D0, 0.01401D0, 0.01082D0, 0.00830D0, 0.00632D0,
57762 & 0.00475D0, 0.00353D0, 0.00259D0, 0.00188D0, 0.00135D0,
57763 & 0.00095D0, 0.00066D0, 0.00047D0, 0.00034D0, 0.00024D0,
57764 & 0.00014D0, 0.00008D0, 0.00004D0, 0.00002D0, 0.00000D0,
57765 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57766 DATA (FMRS(2,5,I,31),I=1,49)/
57767 & 12.81161D0, 9.27611D0, 6.71181D0, 5.55130D0, 4.84990D0,
57768 & 4.36615D0, 3.14234D0, 2.24650D0, 1.83587D0, 1.58474D0,
57769 & 1.40629D0, 0.95519D0, 0.62425D0, 0.47590D0, 0.38756D0,
57770 & 0.32788D0, 0.25125D0, 0.18591D0, 0.12907D0, 0.09846D0,
57771 & 0.06642D0, 0.04959D0, 0.03891D0, 0.02970D0, 0.02299D0,
57772 & 0.01788D0, 0.01385D0, 0.01067D0, 0.00816D0, 0.00619D0,
57773 & 0.00464D0, 0.00344D0, 0.00252D0, 0.00182D0, 0.00130D0,
57774 & 0.00092D0, 0.00064D0, 0.00045D0, 0.00033D0, 0.00023D0,
57775 & 0.00013D0, 0.00007D0, 0.00004D0, 0.00002D0, 0.00000D0,
57776 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57777 DATA (FMRS(2,5,I,32),I=1,49)/
57778 & 13.67059D0, 9.85720D0, 7.10279D0, 5.86046D0, 5.11119D0,
57779 & 4.59523D0, 3.29346D0, 2.34466D0, 1.91134D0, 1.64694D0,
57780 & 1.45941D0, 0.98687D0, 0.64209D0, 0.48825D0, 0.39691D0,
57781 & 0.33535D0, 0.25648D0, 0.18940D0, 0.13119D0, 0.09990D0,
57782 & 0.06714D0, 0.04995D0, 0.03906D0, 0.02968D0, 0.02289D0,
57783 & 0.01773D0, 0.01369D0, 0.01051D0, 0.00801D0, 0.00606D0,
57784 & 0.00453D0, 0.00335D0, 0.00245D0, 0.00177D0, 0.00126D0,
57785 & 0.00089D0, 0.00062D0, 0.00043D0, 0.00032D0, 0.00023D0,
57786 & 0.00013D0, 0.00007D0, 0.00004D0, 0.00002D0, 0.00000D0,
57787 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57788 DATA (FMRS(2,5,I,33),I=1,49)/
57789 & 14.58850D0, 10.47558D0, 7.51716D0, 6.18731D0, 5.38695D0,
57790 & 4.83668D0, 3.45207D0, 2.44727D0, 1.99002D0, 1.71168D0,
57791 & 1.51462D0, 1.01965D0, 0.66046D0, 0.50094D0, 0.40651D0,
57792 & 0.34300D0, 0.26182D0, 0.19296D0, 0.13335D0, 0.10136D0,
57793 & 0.06788D0, 0.05032D0, 0.03921D0, 0.02967D0, 0.02278D0,
57794 & 0.01759D0, 0.01353D0, 0.01035D0, 0.00787D0, 0.00594D0,
57795 & 0.00443D0, 0.00327D0, 0.00238D0, 0.00172D0, 0.00122D0,
57796 & 0.00086D0, 0.00060D0, 0.00042D0, 0.00031D0, 0.00022D0,
57797 & 0.00013D0, 0.00007D0, 0.00004D0, 0.00002D0, 0.00000D0,
57798 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57799 DATA (FMRS(2,5,I,34),I=1,49)/
57800 & 15.50215D0, 11.08776D0, 7.92505D0, 6.50796D0, 5.65681D0,
57801 & 5.07248D0, 3.60600D0, 2.54615D0, 2.06552D0, 1.77359D0,
57802 & 1.56726D0, 1.05062D0, 0.67763D0, 0.51270D0, 0.41535D0,
57803 & 0.35001D0, 0.26666D0, 0.19615D0, 0.13524D0, 0.10260D0,
57804 & 0.06847D0, 0.05058D0, 0.03928D0, 0.02960D0, 0.02264D0,
57805 & 0.01742D0, 0.01336D0, 0.01019D0, 0.00772D0, 0.00581D0,
57806 & 0.00432D0, 0.00318D0, 0.00232D0, 0.00166D0, 0.00118D0,
57807 & 0.00083D0, 0.00058D0, 0.00041D0, 0.00030D0, 0.00022D0,
57808 & 0.00013D0, 0.00007D0, 0.00004D0, 0.00002D0, 0.00000D0,
57809 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57810 DATA (FMRS(2,5,I,35),I=1,49)/
57811 & 16.42021D0, 11.70052D0, 8.33176D0, 6.82695D0, 5.92484D0,
57812 & 5.30641D0, 3.75809D0, 2.64348D0, 2.13966D0, 1.83429D0,
57813 & 1.61881D0, 1.08081D0, 0.69429D0, 0.52409D0, 0.42389D0,
57814 & 0.35678D0, 0.27133D0, 0.19921D0, 0.13706D0, 0.10380D0,
57815 & 0.06904D0, 0.05083D0, 0.03934D0, 0.02953D0, 0.02251D0,
57816 & 0.01726D0, 0.01320D0, 0.01004D0, 0.00759D0, 0.00569D0,
57817 & 0.00422D0, 0.00310D0, 0.00225D0, 0.00162D0, 0.00115D0,
57818 & 0.00080D0, 0.00056D0, 0.00039D0, 0.00029D0, 0.00021D0,
57819 & 0.00013D0, 0.00007D0, 0.00004D0, 0.00002D0, 0.00000D0,
57820 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57821 DATA (FMRS(2,5,I,36),I=1,49)/
57822 & 17.31499D0, 12.29519D0, 8.72473D0, 7.13436D0, 6.18265D0,
57823 & 5.53107D0, 3.90347D0, 2.73604D0, 2.20994D0, 1.89170D0,
57824 & 1.66747D0, 1.10914D0, 0.70980D0, 0.53464D0, 0.43178D0,
57825 & 0.36300D0, 0.27560D0, 0.20200D0, 0.13869D0, 0.10485D0,
57826 & 0.06952D0, 0.05103D0, 0.03937D0, 0.02945D0, 0.02237D0,
57827 & 0.01710D0, 0.01303D0, 0.00989D0, 0.00746D0, 0.00558D0,
57828 & 0.00413D0, 0.00303D0, 0.00220D0, 0.00157D0, 0.00111D0,
57829 & 0.00078D0, 0.00054D0, 0.00038D0, 0.00028D0, 0.00021D0,
57830 & 0.00013D0, 0.00007D0, 0.00004D0, 0.00002D0, 0.00000D0,
57831 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57832 DATA (FMRS(2,5,I,37),I=1,49)/
57833 & 18.24071D0, 12.90782D0, 9.12782D0, 7.44886D0, 6.44591D0,
57834 & 5.76014D0, 4.05101D0, 2.82949D0, 2.28068D0, 1.94934D0,
57835 & 1.71624D0, 1.13734D0, 0.72513D0, 0.54501D0, 0.43949D0,
57836 & 0.36907D0, 0.27974D0, 0.20467D0, 0.14023D0, 0.10583D0,
57837 & 0.06996D0, 0.05118D0, 0.03937D0, 0.02934D0, 0.02221D0,
57838 & 0.01693D0, 0.01286D0, 0.00973D0, 0.00732D0, 0.00547D0,
57839 & 0.00404D0, 0.00296D0, 0.00214D0, 0.00153D0, 0.00108D0,
57840 & 0.00076D0, 0.00052D0, 0.00037D0, 0.00027D0, 0.00020D0,
57841 & 0.00013D0, 0.00007D0, 0.00004D0, 0.00002D0, 0.00000D0,
57842 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57843 DATA (FMRS(2,5,I,38),I=1,49)/
57844 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57845 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57846 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57847 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57848 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57849 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57850 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57851 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57852 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
57853 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57854 DATA (FMRS(2,6,I, 1),I=1,49)/
57855 & 0.49855D0, 0.42587D0, 0.36389D0, 0.33197D0, 0.31109D0,
57856 & 0.29584D0, 0.25332D0, 0.21750D0, 0.19938D0, 0.18774D0,
57857 & 0.17961D0, 0.15726D0, 0.13904D0, 0.12982D0, 0.12379D0,
57858 & 0.11933D0, 0.11282D0, 0.10593D0, 0.09760D0, 0.09090D0,
57859 & 0.07946D0, 0.06933D0, 0.06013D0, 0.04980D0, 0.04078D0,
57860 & 0.03302D0, 0.02641D0, 0.02091D0, 0.01639D0, 0.01253D0,
57861 & 0.00964D0, 0.00728D0, 0.00545D0, 0.00406D0, 0.00291D0,
57862 & 0.00211D0, 0.00151D0, 0.00106D0, 0.00067D0, 0.00051D0,
57863 & 0.00036D0, 0.00020D0, 0.00015D0, 0.00005D0, 0.00001D0,
57864 & -0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0/
57865 DATA (FMRS(2,6,I, 2),I=1,49)/
57866 & 0.50643D0, 0.43610D0, 0.37562D0, 0.34428D0, 0.32368D0,
57867 & 0.30859D0, 0.26628D0, 0.23029D0, 0.21194D0, 0.20007D0,
57868 & 0.19176D0, 0.16857D0, 0.14897D0, 0.13868D0, 0.13176D0,
57869 & 0.12655D0, 0.11883D0, 0.11060D0, 0.10078D0, 0.09314D0,
57870 & 0.08065D0, 0.07007D0, 0.06069D0, 0.05033D0, 0.04135D0,
57871 & 0.03363D0, 0.02706D0, 0.02157D0, 0.01702D0, 0.01315D0,
57872 & 0.01020D0, 0.00777D0, 0.00589D0, 0.00442D0, 0.00323D0,
57873 & 0.00236D0, 0.00171D0, 0.00122D0, 0.00079D0, 0.00059D0,
57874 & 0.00042D0, 0.00024D0, 0.00018D0, 0.00006D0, 0.00002D0,
57875 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57876 DATA (FMRS(2,6,I, 3),I=1,49)/
57877 & 0.53555D0, 0.46535D0, 0.40441D0, 0.37256D0, 0.35153D0,
57878 & 0.33606D0, 0.29238D0, 0.25475D0, 0.23531D0, 0.22262D0,
57879 & 0.21361D0, 0.18804D0, 0.16542D0, 0.15305D0, 0.14451D0,
57880 & 0.13799D0, 0.12824D0, 0.11785D0, 0.10571D0, 0.09664D0,
57881 & 0.08259D0, 0.07132D0, 0.06165D0, 0.05118D0, 0.04219D0,
57882 & 0.03449D0, 0.02794D0, 0.02243D0, 0.01784D0, 0.01392D0,
57883 & 0.01089D0, 0.00837D0, 0.00641D0, 0.00486D0, 0.00360D0,
57884 & 0.00265D0, 0.00193D0, 0.00138D0, 0.00092D0, 0.00067D0,
57885 & 0.00048D0, 0.00029D0, 0.00022D0, 0.00008D0, 0.00002D0,
57886 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57887 DATA (FMRS(2,6,I, 4),I=1,49)/
57888 & 0.57226D0, 0.49911D0, 0.43533D0, 0.40188D0, 0.37974D0,
57889 & 0.36342D0, 0.31717D0, 0.27704D0, 0.25615D0, 0.24242D0,
57890 & 0.23256D0, 0.20428D0, 0.17865D0, 0.16439D0, 0.15446D0,
57891 & 0.14683D0, 0.13543D0, 0.12334D0, 0.10944D0, 0.09929D0,
57892 & 0.08411D0, 0.07232D0, 0.06240D0, 0.05181D0, 0.04280D0,
57893 & 0.03507D0, 0.02851D0, 0.02298D0, 0.01835D0, 0.01437D0,
57894 & 0.01128D0, 0.00872D0, 0.00670D0, 0.00509D0, 0.00378D0,
57895 & 0.00278D0, 0.00204D0, 0.00149D0, 0.00099D0, 0.00072D0,
57896 & 0.00050D0, 0.00032D0, 0.00023D0, 0.00009D0, 0.00003D0,
57897 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57898 DATA (FMRS(2,6,I, 5),I=1,49)/
57899 & 0.63213D0, 0.55147D0, 0.48109D0, 0.44417D0, 0.41970D0,
57900 & 0.40166D0, 0.35046D0, 0.30587D0, 0.28254D0, 0.26712D0,
57901 & 0.25592D0, 0.22358D0, 0.19384D0, 0.17718D0, 0.16554D0,
57902 & 0.15661D0, 0.14330D0, 0.12931D0, 0.11348D0, 0.10220D0,
57903 & 0.08579D0, 0.07344D0, 0.06325D0, 0.05250D0, 0.04341D0,
57904 & 0.03561D0, 0.02901D0, 0.02344D0, 0.01875D0, 0.01473D0,
57905 & 0.01158D0, 0.00897D0, 0.00690D0, 0.00525D0, 0.00392D0,
57906 & 0.00287D0, 0.00212D0, 0.00153D0, 0.00104D0, 0.00075D0,
57907 & 0.00052D0, 0.00033D0, 0.00023D0, 0.00009D0, 0.00002D0,
57908 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57909 DATA (FMRS(2,6,I, 6),I=1,49)/
57910 & 0.69484D0, 0.60548D0, 0.52759D0, 0.48675D0, 0.45969D0,
57911 & 0.43974D0, 0.38311D0, 0.33372D0, 0.30779D0, 0.29059D0,
57912 & 0.27800D0, 0.24152D0, 0.20772D0, 0.18874D0, 0.17549D0,
57913 & 0.16535D0, 0.15028D0, 0.13457D0, 0.11704D0, 0.10475D0,
57914 & 0.08728D0, 0.07444D0, 0.06400D0, 0.05308D0, 0.04390D0,
57915 & 0.03605D0, 0.02939D0, 0.02378D0, 0.01903D0, 0.01499D0,
57916 & 0.01179D0, 0.00914D0, 0.00703D0, 0.00535D0, 0.00400D0,
57917 & 0.00293D0, 0.00217D0, 0.00156D0, 0.00107D0, 0.00077D0,
57918 & 0.00053D0, 0.00034D0, 0.00024D0, 0.00009D0, 0.00002D0,
57919 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57920 DATA (FMRS(2,6,I, 7),I=1,49)/
57921 & 0.77164D0, 0.67034D0, 0.58230D0, 0.53624D0, 0.50577D0,
57922 & 0.48332D0, 0.41966D0, 0.36421D0, 0.33508D0, 0.31572D0,
57923 & 0.30145D0, 0.26012D0, 0.22178D0, 0.20031D0, 0.18536D0,
57924 & 0.17396D0, 0.15711D0, 0.13969D0, 0.12049D0, 0.10724D0,
57925 & 0.08874D0, 0.07542D0, 0.06472D0, 0.05362D0, 0.04433D0,
57926 & 0.03642D0, 0.02969D0, 0.02403D0, 0.01923D0, 0.01516D0,
57927 & 0.01193D0, 0.00926D0, 0.00710D0, 0.00541D0, 0.00405D0,
57928 & 0.00297D0, 0.00219D0, 0.00158D0, 0.00108D0, 0.00077D0,
57929 & 0.00052D0, 0.00033D0, 0.00024D0, 0.00008D0, 0.00002D0,
57930 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57931 DATA (FMRS(2,6,I, 8),I=1,49)/
57932 & 0.86838D0, 0.75105D0, 0.64953D0, 0.59658D0, 0.56163D0,
57933 & 0.53592D0, 0.46317D0, 0.39995D0, 0.36678D0, 0.34473D0,
57934 & 0.32838D0, 0.28112D0, 0.23740D0, 0.21303D0, 0.19616D0,
57935 & 0.18334D0, 0.16450D0, 0.14520D0, 0.12419D0, 0.10991D0,
57936 & 0.09031D0, 0.07647D0, 0.06547D0, 0.05416D0, 0.04475D0,
57937 & 0.03674D0, 0.02994D0, 0.02423D0, 0.01939D0, 0.01529D0,
57938 & 0.01202D0, 0.00932D0, 0.00715D0, 0.00545D0, 0.00407D0,
57939 & 0.00298D0, 0.00220D0, 0.00159D0, 0.00108D0, 0.00077D0,
57940 & 0.00052D0, 0.00033D0, 0.00024D0, 0.00008D0, 0.00002D0,
57941 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57942 DATA (FMRS(2,6,I, 9),I=1,49)/
57943 & 0.96608D0, 0.83177D0, 0.71606D0, 0.65593D0, 0.61632D0,
57944 & 0.58722D0, 0.50510D0, 0.43397D0, 0.39671D0, 0.37195D0,
57945 & 0.35355D0, 0.30046D0, 0.25156D0, 0.22448D0, 0.20581D0,
57946 & 0.19169D0, 0.17103D0, 0.15004D0, 0.12743D0, 0.11224D0,
57947 & 0.09169D0, 0.07737D0, 0.06612D0, 0.05461D0, 0.04508D0,
57948 & 0.03697D0, 0.03013D0, 0.02435D0, 0.01949D0, 0.01536D0,
57949 & 0.01207D0, 0.00933D0, 0.00718D0, 0.00545D0, 0.00407D0,
57950 & 0.00298D0, 0.00219D0, 0.00159D0, 0.00106D0, 0.00076D0,
57951 & 0.00052D0, 0.00033D0, 0.00024D0, 0.00009D0, 0.00002D0,
57952 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57953 DATA (FMRS(2,6,I,10),I=1,49)/
57954 & 1.07543D0, 0.92116D0, 0.78892D0, 0.72047D0, 0.67548D0,
57955 & 0.64249D0, 0.54968D0, 0.46963D0, 0.42782D0, 0.40008D0,
57956 & 0.37941D0, 0.32003D0, 0.26568D0, 0.23578D0, 0.21528D0,
57957 & 0.19985D0, 0.17739D0, 0.15473D0, 0.13057D0, 0.11449D0,
57958 & 0.09302D0, 0.07823D0, 0.06672D0, 0.05501D0, 0.04535D0,
57959 & 0.03715D0, 0.03025D0, 0.02442D0, 0.01953D0, 0.01538D0,
57960 & 0.01207D0, 0.00932D0, 0.00717D0, 0.00543D0, 0.00405D0,
57961 & 0.00296D0, 0.00217D0, 0.00158D0, 0.00105D0, 0.00075D0,
57962 & 0.00051D0, 0.00033D0, 0.00023D0, 0.00008D0, 0.00002D0,
57963 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57964 DATA (FMRS(2,6,I,11),I=1,49)/
57965 & 1.17158D0, 0.99923D0, 0.85209D0, 0.77617D0, 0.72639D0,
57966 & 0.68993D0, 0.58762D0, 0.49971D0, 0.45391D0, 0.42357D0,
57967 & 0.40096D0, 0.33616D0, 0.27719D0, 0.24495D0, 0.22293D0,
57968 & 0.20642D0, 0.18248D0, 0.15848D0, 0.13306D0, 0.11628D0,
57969 & 0.09406D0, 0.07891D0, 0.06718D0, 0.05531D0, 0.04555D0,
57970 & 0.03727D0, 0.03032D0, 0.02446D0, 0.01953D0, 0.01537D0,
57971 & 0.01205D0, 0.00930D0, 0.00714D0, 0.00540D0, 0.00402D0,
57972 & 0.00294D0, 0.00214D0, 0.00155D0, 0.00104D0, 0.00074D0,
57973 & 0.00050D0, 0.00032D0, 0.00022D0, 0.00008D0, 0.00002D0,
57974 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57975 DATA (FMRS(2,6,I,12),I=1,49)/
57976 & 1.40820D0, 1.18938D0, 1.00430D0, 0.90953D0, 0.84767D0,
57977 & 0.80252D0, 0.67658D0, 0.56932D0, 0.51382D0, 0.47719D0,
57978 & 0.44989D0, 0.37226D0, 0.30256D0, 0.26497D0, 0.23955D0,
57979 & 0.22062D0, 0.19343D0, 0.16648D0, 0.13836D0, 0.12007D0,
57980 & 0.09626D0, 0.08032D0, 0.06811D0, 0.05588D0, 0.04588D0,
57981 & 0.03745D0, 0.03039D0, 0.02446D0, 0.01948D0, 0.01531D0,
57982 & 0.01197D0, 0.00921D0, 0.00706D0, 0.00532D0, 0.00395D0,
57983 & 0.00288D0, 0.00209D0, 0.00151D0, 0.00101D0, 0.00072D0,
57984 & 0.00049D0, 0.00031D0, 0.00021D0, 0.00008D0, 0.00002D0,
57985 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57986 DATA (FMRS(2,6,I,13),I=1,49)/
57987 & 1.64756D0, 1.37951D0, 1.15467D0, 1.04031D0, 0.96596D0,
57988 & 0.91188D0, 0.76181D0, 0.63505D0, 0.56988D0, 0.52704D0,
57989 & 0.49515D0, 0.40510D0, 0.32525D0, 0.28268D0, 0.25415D0,
57990 & 0.23303D0, 0.20292D0, 0.17336D0, 0.14288D0, 0.12329D0,
57991 & 0.09812D0, 0.08148D0, 0.06886D0, 0.05629D0, 0.04609D0,
57992 & 0.03753D0, 0.03037D0, 0.02438D0, 0.01937D0, 0.01519D0,
57993 & 0.01185D0, 0.00910D0, 0.00695D0, 0.00523D0, 0.00387D0,
57994 & 0.00281D0, 0.00204D0, 0.00147D0, 0.00097D0, 0.00069D0,
57995 & 0.00048D0, 0.00029D0, 0.00020D0, 0.00007D0, 0.00002D0,
57996 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
57997 DATA (FMRS(2,6,I,14),I=1,49)/
57998 & 1.95709D0, 1.62260D0, 1.34467D0, 1.20438D0, 1.11362D0,
57999 & 1.04783D0, 0.86639D0, 0.71460D0, 0.63715D0, 0.58648D0,
58000 & 0.54885D0, 0.44345D0, 0.35130D0, 0.30283D0, 0.27064D0,
58001 & 0.24698D0, 0.21351D0, 0.18099D0, 0.14786D0, 0.12681D0,
58002 & 0.10011D0, 0.08269D0, 0.06959D0, 0.05666D0, 0.04624D0,
58003 & 0.03752D0, 0.03025D0, 0.02422D0, 0.01919D0, 0.01499D0,
58004 & 0.01165D0, 0.00893D0, 0.00678D0, 0.00510D0, 0.00375D0,
58005 & 0.00271D0, 0.00197D0, 0.00141D0, 0.00093D0, 0.00065D0,
58006 & 0.00045D0, 0.00028D0, 0.00019D0, 0.00007D0, 0.00002D0,
58007 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58008 DATA (FMRS(2,6,I,15),I=1,49)/
58009 & 2.33106D0, 1.91266D0, 1.56849D0, 1.39616D0, 1.28524D0,
58010 & 1.20514D0, 0.98569D0, 0.80398D0, 0.71204D0, 0.65222D0,
58011 & 0.60792D0, 0.48491D0, 0.37897D0, 0.32402D0, 0.28785D0,
58012 & 0.26145D0, 0.22441D0, 0.18878D0, 0.15289D0, 0.13035D0,
58013 & 0.10206D0, 0.08383D0, 0.07023D0, 0.05691D0, 0.04625D0,
58014 & 0.03736D0, 0.03004D0, 0.02396D0, 0.01891D0, 0.01473D0,
58015 & 0.01139D0, 0.00872D0, 0.00659D0, 0.00494D0, 0.00362D0,
58016 & 0.00261D0, 0.00189D0, 0.00136D0, 0.00089D0, 0.00062D0,
58017 & 0.00043D0, 0.00026D0, 0.00018D0, 0.00006D0, 0.00002D0,
58018 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58019 DATA (FMRS(2,6,I,16),I=1,49)/
58020 & 2.71585D0, 2.20785D0, 1.79373D0, 1.58787D0, 1.45597D0,
58021 & 1.36104D0, 1.10250D0, 0.89041D0, 0.78391D0, 0.71494D0,
58022 & 0.66403D0, 0.52372D0, 0.40449D0, 0.34337D0, 0.30346D0,
58023 & 0.27452D0, 0.23417D0, 0.19570D0, 0.15732D0, 0.13343D0,
58024 & 0.10373D0, 0.08475D0, 0.07072D0, 0.05705D0, 0.04617D0,
58025 & 0.03716D0, 0.02977D0, 0.02366D0, 0.01861D0, 0.01445D0,
58026 & 0.01114D0, 0.00850D0, 0.00640D0, 0.00478D0, 0.00350D0,
58027 & 0.00251D0, 0.00181D0, 0.00130D0, 0.00086D0, 0.00058D0,
58028 & 0.00040D0, 0.00024D0, 0.00016D0, 0.00006D0, 0.00002D0,
58029 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58030 DATA (FMRS(2,6,I,17),I=1,49)/
58031 & 3.15180D0, 2.53892D0, 2.04375D0, 1.79938D0, 1.64351D0,
58032 & 1.53170D0, 1.22899D0, 0.98294D0, 0.86032D0, 0.78129D0,
58033 & 0.72315D0, 0.56409D0, 0.43066D0, 0.36305D0, 0.31926D0,
58034 & 0.28768D0, 0.24394D0, 0.20257D0, 0.16168D0, 0.13644D0,
58035 & 0.10531D0, 0.08560D0, 0.07112D0, 0.05711D0, 0.04602D0,
58036 & 0.03691D0, 0.02945D0, 0.02332D0, 0.01829D0, 0.01415D0,
58037 & 0.01087D0, 0.00826D0, 0.00621D0, 0.00462D0, 0.00337D0,
58038 & 0.00241D0, 0.00173D0, 0.00124D0, 0.00082D0, 0.00055D0,
58039 & 0.00038D0, 0.00023D0, 0.00015D0, 0.00005D0, 0.00002D0,
58040 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58041 DATA (FMRS(2,6,I,18),I=1,49)/
58042 & 3.55145D0, 2.83962D0, 2.26870D0, 1.98860D0, 1.81061D0,
58043 & 1.68328D0, 1.34021D0, 1.06346D0, 0.92638D0, 0.83839D0,
58044 & 0.77383D0, 0.59827D0, 0.45255D0, 0.37938D0, 0.33229D0,
58045 & 0.29849D0, 0.25191D0, 0.20813D0, 0.16517D0, 0.13882D0,
58046 & 0.10653D0, 0.08622D0, 0.07137D0, 0.05708D0, 0.04584D0,
58047 & 0.03664D0, 0.02914D0, 0.02300D0, 0.01798D0, 0.01388D0,
58048 & 0.01064D0, 0.00807D0, 0.00604D0, 0.00448D0, 0.00326D0,
58049 & 0.00232D0, 0.00166D0, 0.00119D0, 0.00077D0, 0.00053D0,
58050 & 0.00036D0, 0.00022D0, 0.00015D0, 0.00005D0, 0.00001D0,
58051 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58052 DATA (FMRS(2,6,I,19),I=1,49)/
58053 & 4.08243D0, 3.23554D0, 2.56218D0, 2.23414D0, 2.02661D0,
58054 & 1.87862D0, 1.48217D0, 1.16519D0, 1.00935D0, 0.90979D0,
58055 & 0.83697D0, 0.64037D0, 0.47917D0, 0.39910D0, 0.34794D0,
58056 & 0.31141D0, 0.26137D0, 0.21468D0, 0.16924D0, 0.14156D0,
58057 & 0.10788D0, 0.08686D0, 0.07159D0, 0.05697D0, 0.04554D0,
58058 & 0.03624D0, 0.02871D0, 0.02258D0, 0.01759D0, 0.01353D0,
58059 & 0.01034D0, 0.00780D0, 0.00582D0, 0.00431D0, 0.00313D0,
58060 & 0.00222D0, 0.00159D0, 0.00113D0, 0.00073D0, 0.00050D0,
58061 & 0.00034D0, 0.00021D0, 0.00014D0, 0.00005D0, 0.00001D0,
58062 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58063 DATA (FMRS(2,6,I,20),I=1,49)/
58064 & 4.59984D0, 3.61795D0, 2.84314D0, 2.46798D0, 2.23154D0,
58065 & 2.06341D0, 1.61522D0, 1.25965D0, 1.08594D0, 0.97542D0,
58066 & 0.89482D0, 0.67853D0, 0.50302D0, 0.41664D0, 0.36179D0,
58067 & 0.32280D0, 0.26966D0, 0.22039D0, 0.17274D0, 0.14391D0,
58068 & 0.10901D0, 0.08736D0, 0.07173D0, 0.05682D0, 0.04524D0,
58069 & 0.03586D0, 0.02831D0, 0.02220D0, 0.01723D0, 0.01322D0,
58070 & 0.01007D0, 0.00756D0, 0.00563D0, 0.00415D0, 0.00301D0,
58071 & 0.00213D0, 0.00152D0, 0.00108D0, 0.00071D0, 0.00046D0,
58072 & 0.00032D0, 0.00019D0, 0.00013D0, 0.00004D0, 0.00001D0,
58073 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58074 DATA (FMRS(2,6,I,21),I=1,49)/
58075 & 5.10866D0, 3.99099D0, 3.11497D0, 2.69310D0, 2.42814D0,
58076 & 2.24021D0, 1.74141D0, 1.34843D0, 1.15753D0, 1.03651D0,
58077 & 0.94850D0, 0.71355D0, 0.52465D0, 0.43244D0, 0.37419D0,
58078 & 0.33296D0, 0.27700D0, 0.22539D0, 0.17578D0, 0.14590D0,
58079 & 0.10992D0, 0.08772D0, 0.07175D0, 0.05660D0, 0.04490D0,
58080 & 0.03547D0, 0.02791D0, 0.02182D0, 0.01688D0, 0.01291D0,
58081 & 0.00980D0, 0.00735D0, 0.00546D0, 0.00401D0, 0.00289D0,
58082 & 0.00204D0, 0.00145D0, 0.00103D0, 0.00067D0, 0.00045D0,
58083 & 0.00030D0, 0.00018D0, 0.00012D0, 0.00004D0, 0.00001D0,
58084 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58085 DATA (FMRS(2,6,I,22),I=1,49)/
58086 & 5.81063D0, 4.50144D0, 3.48388D0, 2.99716D0, 2.69275D0,
58087 & 2.47752D0, 1.90937D0, 1.46556D0, 1.25149D0, 1.11639D0,
58088 & 1.01845D0, 0.75875D0, 0.55228D0, 0.45248D0, 0.38985D0,
58089 & 0.34573D0, 0.28616D0, 0.23159D0, 0.17950D0, 0.14831D0,
58090 & 0.11099D0, 0.08809D0, 0.07172D0, 0.05628D0, 0.04443D0,
58091 & 0.03495D0, 0.02738D0, 0.02132D0, 0.01642D0, 0.01252D0,
58092 & 0.00947D0, 0.00708D0, 0.00524D0, 0.00384D0, 0.00275D0,
58093 & 0.00194D0, 0.00137D0, 0.00097D0, 0.00062D0, 0.00042D0,
58094 & 0.00028D0, 0.00017D0, 0.00011D0, 0.00004D0, 0.00001D0,
58095 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58096 DATA (FMRS(2,6,I,23),I=1,49)/
58097 & 6.53035D0, 5.02028D0, 3.85558D0, 3.30194D0, 2.95702D0,
58098 & 2.71384D0, 2.07512D0, 1.58008D0, 1.34283D0, 1.19373D0,
58099 & 1.08596D0, 0.80189D0, 0.57834D0, 0.47125D0, 0.40444D0,
58100 & 0.35757D0, 0.29461D0, 0.23726D0, 0.18285D0, 0.15046D0,
58101 & 0.11188D0, 0.08836D0, 0.07162D0, 0.05593D0, 0.04396D0,
58102 & 0.03443D0, 0.02686D0, 0.02084D0, 0.01599D0, 0.01216D0,
58103 & 0.00917D0, 0.00683D0, 0.00504D0, 0.00368D0, 0.00262D0,
58104 & 0.00186D0, 0.00129D0, 0.00092D0, 0.00058D0, 0.00038D0,
58105 & 0.00026D0, 0.00015D0, 0.00010D0, 0.00004D0, 0.00001D0,
58106 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58107 DATA (FMRS(2,6,I,24),I=1,49)/
58108 & 7.24769D0, 5.53321D0, 4.22004D0, 3.59932D0, 3.21397D0,
58109 & 2.94299D0, 2.23445D0, 1.68918D0, 1.42937D0, 1.26671D0,
58110 & 1.14944D0, 0.84202D0, 0.60229D0, 0.48837D0, 0.41766D0,
58111 & 0.36826D0, 0.30216D0, 0.24227D0, 0.18575D0, 0.15227D0,
58112 & 0.11258D0, 0.08849D0, 0.07143D0, 0.05553D0, 0.04345D0,
58113 & 0.03390D0, 0.02636D0, 0.02037D0, 0.01559D0, 0.01181D0,
58114 & 0.00887D0, 0.00659D0, 0.00484D0, 0.00353D0, 0.00252D0,
58115 & 0.00176D0, 0.00124D0, 0.00088D0, 0.00055D0, 0.00037D0,
58116 & 0.00025D0, 0.00014D0, 0.00009D0, 0.00003D0, 0.00001D0,
58117 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58118 DATA (FMRS(2,6,I,25),I=1,49)/
58119 & 8.02203D0, 6.08288D0, 4.60775D0, 3.91431D0, 3.48531D0,
58120 & 3.18439D0, 2.40103D0, 1.80237D0, 1.51875D0, 1.34182D0,
58121 & 1.21461D0, 0.88286D0, 0.62643D0, 0.50552D0, 0.43085D0,
58122 & 0.37888D0, 0.30963D0, 0.24719D0, 0.18858D0, 0.15401D0,
58123 & 0.11322D0, 0.08857D0, 0.07120D0, 0.05510D0, 0.04294D0,
58124 & 0.03336D0, 0.02585D0, 0.01990D0, 0.01519D0, 0.01146D0,
58125 & 0.00858D0, 0.00636D0, 0.00466D0, 0.00338D0, 0.00242D0,
58126 & 0.00168D0, 0.00119D0, 0.00083D0, 0.00052D0, 0.00035D0,
58127 & 0.00023D0, 0.00013D0, 0.00009D0, 0.00003D0, 0.00001D0,
58128 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58129 DATA (FMRS(2,6,I,26),I=1,49)/
58130 & 8.82307D0, 6.64735D0, 5.00295D0, 4.23399D0, 3.75981D0,
58131 & 3.42801D0, 2.56785D0, 1.91480D0, 1.60708D0, 1.41578D0,
58132 & 1.27859D0, 0.92256D0, 0.64966D0, 0.52190D0, 0.44338D0,
58133 & 0.38892D0, 0.31662D0, 0.25175D0, 0.19114D0, 0.15555D0,
58134 & 0.11371D0, 0.08855D0, 0.07090D0, 0.05462D0, 0.04239D0,
58135 & 0.03281D0, 0.02532D0, 0.01944D0, 0.01478D0, 0.01112D0,
58136 & 0.00830D0, 0.00614D0, 0.00448D0, 0.00324D0, 0.00231D0,
58137 & 0.00160D0, 0.00113D0, 0.00079D0, 0.00049D0, 0.00033D0,
58138 & 0.00022D0, 0.00013D0, 0.00008D0, 0.00003D0, 0.00001D0,
58139 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58140 DATA (FMRS(2,6,I,27),I=1,49)/
58141 & 9.62987D0, 7.21210D0, 5.39571D0, 4.55043D0, 4.03076D0,
58142 & 3.66794D0, 2.73100D0, 2.02398D0, 1.69250D0, 1.48708D0,
58143 & 1.34010D0, 0.96040D0, 0.67159D0, 0.53727D0, 0.45509D0,
58144 & 0.39827D0, 0.32310D0, 0.25593D0, 0.19347D0, 0.15692D0,
58145 & 0.11411D0, 0.08848D0, 0.07058D0, 0.05414D0, 0.04185D0,
58146 & 0.03228D0, 0.02482D0, 0.01900D0, 0.01440D0, 0.01080D0,
58147 & 0.00804D0, 0.00593D0, 0.00431D0, 0.00312D0, 0.00222D0,
58148 & 0.00152D0, 0.00108D0, 0.00075D0, 0.00046D0, 0.00031D0,
58149 & 0.00020D0, 0.00012D0, 0.00008D0, 0.00003D0, 0.00001D0,
58150 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58151 DATA (FMRS(2,6,I,28),I=1,49)/
58152 & 10.42894D0, 7.76794D0, 5.77982D0, 4.85875D0, 4.29406D0,
58153 & 3.90061D0, 2.88817D0, 2.12844D0, 1.77387D0, 1.55479D0,
58154 & 1.39837D0, 0.99596D0, 0.69200D0, 0.55150D0, 0.46587D0,
58155 & 0.40684D0, 0.32899D0, 0.25970D0, 0.19552D0, 0.15809D0,
58156 & 0.11441D0, 0.08837D0, 0.07023D0, 0.05366D0, 0.04133D0,
58157 & 0.03176D0, 0.02435D0, 0.01859D0, 0.01405D0, 0.01051D0,
58158 & 0.00780D0, 0.00573D0, 0.00416D0, 0.00301D0, 0.00213D0,
58159 & 0.00146D0, 0.00103D0, 0.00071D0, 0.00045D0, 0.00029D0,
58160 & 0.00020D0, 0.00011D0, 0.00008D0, 0.00003D0, 0.00001D0,
58161 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58162 DATA (FMRS(2,6,I,29),I=1,49)/
58163 & 11.27410D0, 8.35239D0, 6.18132D0, 5.17989D0, 4.56762D0,
58164 & 4.14187D0, 3.05014D0, 2.23540D0, 1.85687D0, 1.62366D0,
58165 & 1.45750D0, 1.03178D0, 0.71238D0, 0.56563D0, 0.47653D0,
58166 & 0.41529D0, 0.33476D0, 0.26336D0, 0.19748D0, 0.15919D0,
58167 & 0.11465D0, 0.08820D0, 0.06985D0, 0.05316D0, 0.04080D0,
58168 & 0.03125D0, 0.02388D0, 0.01817D0, 0.01370D0, 0.01022D0,
58169 & 0.00757D0, 0.00554D0, 0.00401D0, 0.00290D0, 0.00205D0,
58170 & 0.00140D0, 0.00098D0, 0.00068D0, 0.00043D0, 0.00028D0,
58171 & 0.00019D0, 0.00011D0, 0.00007D0, 0.00002D0, 0.00001D0,
58172 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58173 DATA (FMRS(2,6,I,30),I=1,49)/
58174 & 12.14199D0, 8.94909D0, 6.58882D0, 5.50470D0, 4.84361D0,
58175 & 4.38480D0, 3.21222D0, 2.34175D0, 1.93908D0, 1.69167D0,
58176 & 1.51576D0, 1.06678D0, 0.73213D0, 0.57923D0, 0.48674D0,
58177 & 0.42334D0, 0.34023D0, 0.26678D0, 0.19927D0, 0.16016D0,
58178 & 0.11481D0, 0.08798D0, 0.06944D0, 0.05264D0, 0.04025D0,
58179 & 0.03073D0, 0.02343D0, 0.01777D0, 0.01335D0, 0.00994D0,
58180 & 0.00734D0, 0.00536D0, 0.00388D0, 0.00278D0, 0.00196D0,
58181 & 0.00135D0, 0.00094D0, 0.00065D0, 0.00041D0, 0.00027D0,
58182 & 0.00017D0, 0.00010D0, 0.00007D0, 0.00002D0, 0.00001D0,
58183 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58184 DATA (FMRS(2,6,I,31),I=1,49)/
58185 & 13.00875D0, 9.54182D0, 6.99142D0, 5.82458D0, 5.11479D0,
58186 & 4.62308D0, 3.37031D0, 2.44489D0, 2.01852D0, 1.75723D0,
58187 & 1.57179D0, 1.10022D0, 0.75086D0, 0.59207D0, 0.49634D0,
58188 & 0.43089D0, 0.34532D0, 0.26994D0, 0.20090D0, 0.16103D0,
58189 & 0.11492D0, 0.08774D0, 0.06903D0, 0.05213D0, 0.03973D0,
58190 & 0.03024D0, 0.02300D0, 0.01739D0, 0.01303D0, 0.00968D0,
58191 & 0.00712D0, 0.00520D0, 0.00375D0, 0.00268D0, 0.00188D0,
58192 & 0.00130D0, 0.00090D0, 0.00063D0, 0.00039D0, 0.00025D0,
58193 & 0.00016D0, 0.00009D0, 0.00006D0, 0.00002D0, 0.00001D0,
58194 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58195 DATA (FMRS(2,6,I,32),I=1,49)/
58196 & 13.85388D0, 10.11672D0, 7.37984D0, 6.13221D0, 5.37500D0,
58197 & 4.85130D0, 3.52087D0, 2.54252D0, 2.09344D0, 1.81889D0,
58198 & 1.62437D0, 1.13136D0, 0.76814D0, 0.60383D0, 0.50509D0,
58199 & 0.43774D0, 0.34990D0, 0.27275D0, 0.20231D0, 0.16173D0,
58200 & 0.11495D0, 0.08745D0, 0.06859D0, 0.05162D0, 0.03921D0,
58201 & 0.02977D0, 0.02256D0, 0.01702D0, 0.01273D0, 0.00943D0,
58202 & 0.00693D0, 0.00505D0, 0.00364D0, 0.00260D0, 0.00181D0,
58203 & 0.00125D0, 0.00086D0, 0.00060D0, 0.00037D0, 0.00024D0,
58204 & 0.00016D0, 0.00009D0, 0.00006D0, 0.00002D0, 0.00001D0,
58205 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58206 DATA (FMRS(2,6,I,33),I=1,49)/
58207 & 14.75398D0, 10.72621D0, 7.78974D0, 6.45599D0, 5.64833D0,
58208 & 5.09068D0, 3.67806D0, 2.64398D0, 2.17108D0, 1.88265D0,
58209 & 1.67867D0, 1.16335D0, 0.78579D0, 0.61581D0, 0.51399D0,
58210 & 0.44470D0, 0.35453D0, 0.27558D0, 0.20373D0, 0.16245D0,
58211 & 0.11497D0, 0.08717D0, 0.06816D0, 0.05112D0, 0.03871D0,
58212 & 0.02930D0, 0.02213D0, 0.01666D0, 0.01243D0, 0.00919D0,
58213 & 0.00674D0, 0.00490D0, 0.00353D0, 0.00251D0, 0.00175D0,
58214 & 0.00120D0, 0.00083D0, 0.00058D0, 0.00036D0, 0.00023D0,
58215 & 0.00015D0, 0.00009D0, 0.00006D0, 0.00002D0, 0.00001D0,
58216 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58217 DATA (FMRS(2,6,I,34),I=1,49)/
58218 & 15.65461D0, 11.33290D0, 8.19558D0, 6.77553D0, 5.91747D0,
58219 & 5.32596D0, 3.83165D0, 2.74249D0, 2.24617D0, 1.94414D0,
58220 & 1.73088D0, 1.19385D0, 0.80244D0, 0.62703D0, 0.52226D0,
58221 & 0.45111D0, 0.35875D0, 0.27811D0, 0.20493D0, 0.16299D0,
58222 & 0.11490D0, 0.08681D0, 0.06768D0, 0.05059D0, 0.03819D0,
58223 & 0.02883D0, 0.02172D0, 0.01631D0, 0.01213D0, 0.00895D0,
58224 & 0.00656D0, 0.00475D0, 0.00341D0, 0.00243D0, 0.00169D0,
58225 & 0.00116D0, 0.00080D0, 0.00055D0, 0.00034D0, 0.00022D0,
58226 & 0.00015D0, 0.00008D0, 0.00005D0, 0.00002D0, 0.00000D0,
58227 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58228 DATA (FMRS(2,6,I,35),I=1,49)/
58229 & 16.55734D0, 11.93842D0, 8.59892D0, 7.09231D0, 6.18381D0,
58230 & 5.55847D0, 3.98278D0, 2.83900D0, 2.31954D0, 2.00411D0,
58231 & 1.78173D0, 1.22341D0, 0.81850D0, 0.63782D0, 0.53020D0,
58232 & 0.45726D0, 0.36278D0, 0.28052D0, 0.20606D0, 0.16351D0,
58233 & 0.11482D0, 0.08647D0, 0.06722D0, 0.05009D0, 0.03770D0,
58234 & 0.02838D0, 0.02133D0, 0.01598D0, 0.01187D0, 0.00873D0,
58235 & 0.00639D0, 0.00462D0, 0.00330D0, 0.00235D0, 0.00163D0,
58236 & 0.00111D0, 0.00077D0, 0.00053D0, 0.00033D0, 0.00021D0,
58237 & 0.00014D0, 0.00008D0, 0.00005D0, 0.00002D0, 0.00000D0,
58238 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58239 DATA (FMRS(2,6,I,36),I=1,49)/
58240 & 17.43806D0, 12.52661D0, 8.98898D0, 7.39784D0, 6.44021D0,
58241 & 5.78196D0, 4.12737D0, 2.93087D0, 2.38917D0, 2.06088D0,
58242 & 1.82979D0, 1.25117D0, 0.83346D0, 0.64781D0, 0.53752D0,
58243 & 0.46291D0, 0.36645D0, 0.28268D0, 0.20706D0, 0.16393D0,
58244 & 0.11470D0, 0.08612D0, 0.06676D0, 0.04960D0, 0.03723D0,
58245 & 0.02796D0, 0.02096D0, 0.01566D0, 0.01161D0, 0.00852D0,
58246 & 0.00623D0, 0.00449D0, 0.00321D0, 0.00227D0, 0.00158D0,
58247 & 0.00107D0, 0.00074D0, 0.00051D0, 0.00031D0, 0.00020D0,
58248 & 0.00013D0, 0.00008D0, 0.00005D0, 0.00002D0, 0.00000D0,
58249 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58250 DATA (FMRS(2,6,I,37),I=1,49)/
58251 & 18.35067D0, 13.13351D0, 9.38971D0, 7.71095D0, 6.70247D0,
58252 & 6.01024D0, 4.27436D0, 3.02381D0, 2.45940D0, 2.11802D0,
58253 & 1.87806D0, 1.27887D0, 0.84828D0, 0.65765D0, 0.54469D0,
58254 & 0.46841D0, 0.37001D0, 0.28475D0, 0.20797D0, 0.16429D0,
58255 & 0.11453D0, 0.08573D0, 0.06628D0, 0.04909D0, 0.03675D0,
58256 & 0.02752D0, 0.02059D0, 0.01535D0, 0.01135D0, 0.00831D0,
58257 & 0.00606D0, 0.00437D0, 0.00311D0, 0.00220D0, 0.00153D0,
58258 & 0.00103D0, 0.00072D0, 0.00049D0, 0.00030D0, 0.00019D0,
58259 & 0.00013D0, 0.00007D0, 0.00005D0, 0.00001D0, 0.00000D0,
58260 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58261 DATA (FMRS(2,6,I,38),I=1,49)/
58262 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58263 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58264 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58265 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58266 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58267 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58268 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58269 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58270 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58271 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58272 DATA (FMRS(2,7,I, 1),I=1,49)/
58273 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58274 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58275 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58276 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58277 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58278 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58279 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58280 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58281 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58282 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58283 DATA (FMRS(2,7,I, 2),I=1,49)/
58284 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58285 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58286 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58287 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58288 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58289 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58290 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58291 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58292 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58293 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58294 DATA (FMRS(2,7,I, 3),I=1,49)/
58295 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58296 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58297 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58298 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58299 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58300 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58301 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58302 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58303 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58304 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58305 DATA (FMRS(2,7,I, 4),I=1,49)/
58306 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58307 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58308 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58309 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58310 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58311 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58312 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58313 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58314 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58315 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58316 DATA (FMRS(2,7,I, 5),I=1,49)/
58317 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58318 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58319 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58320 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58321 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58322 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58323 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58324 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58325 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58326 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58327 DATA (FMRS(2,7,I, 6),I=1,49)/
58328 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58329 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58330 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58331 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58332 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58333 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58334 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58335 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58336 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58337 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58338 DATA (FMRS(2,7,I, 7),I=1,49)/
58339 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58340 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58341 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58342 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58343 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58344 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58345 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58346 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58347 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58348 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58349 DATA (FMRS(2,7,I, 8),I=1,49)/
58350 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58351 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58352 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58353 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58354 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58355 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58356 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58357 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58358 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58359 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58360 DATA (FMRS(2,7,I, 9),I=1,49)/
58361 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58362 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58363 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58364 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58365 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58366 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58367 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58368 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58369 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58370 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58371 DATA (FMRS(2,7,I,10),I=1,49)/
58372 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58373 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58374 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58375 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58376 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58377 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58378 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58379 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58380 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58381 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58382 DATA (FMRS(2,7,I,11),I=1,49)/
58383 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58384 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58385 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58386 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58387 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58388 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58389 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58390 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58391 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58392 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58393 DATA (FMRS(2,7,I,12),I=1,49)/
58394 & 0.00041D0, 0.00036D0, 0.00032D0, 0.00030D0, 0.00028D0,
58395 & 0.00027D0, 0.00023D0, 0.00021D0, 0.00019D0, 0.00018D0,
58396 & 0.00017D0, 0.00014D0, 0.00012D0, 0.00011D0, 0.00010D0,
58397 & 0.00009D0, 0.00008D0, 0.00007D0, 0.00006D0, 0.00005D0,
58398 & 0.00004D0, 0.00004D0, 0.00003D0, 0.00003D0, 0.00003D0,
58399 & 0.00003D0, 0.00002D0, 0.00002D0, 0.00002D0, 0.00002D0,
58400 & 0.00001D0, 0.00001D0, 0.00001D0, 0.00001D0, 0.00001D0,
58401 & 0.00001D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
58402 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58403 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58404 DATA (FMRS(2,7,I,13),I=1,49)/
58405 & 0.21131D0, 0.16558D0, 0.12967D0, 0.11232D0, 0.10141D0,
58406 & 0.09365D0, 0.07296D0, 0.05647D0, 0.04835D0, 0.04314D0,
58407 & 0.03929D0, 0.02893D0, 0.02049D0, 0.01636D0, 0.01376D0,
58408 & 0.01193D0, 0.00947D0, 0.00725D0, 0.00522D0, 0.00409D0,
58409 & 0.00289D0, 0.00226D0, 0.00187D0, 0.00153D0, 0.00127D0,
58410 & 0.00106D0, 0.00087D0, 0.00071D0, 0.00058D0, 0.00046D0,
58411 & 0.00037D0, 0.00028D0, 0.00022D0, 0.00016D0, 0.00012D0,
58412 & 0.00009D0, 0.00007D0, 0.00005D0, 0.00003D0, 0.00002D0,
58413 & 0.00001D0, 0.00001D0, 0.00000D0, 0.00000D0, 0.00000D0,
58414 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58415 DATA (FMRS(2,7,I,14),I=1,49)/
58416 & 0.61374D0, 0.47881D0, 0.37330D0, 0.32254D0, 0.29066D0,
58417 & 0.26804D0, 0.20788D0, 0.16016D0, 0.13675D0, 0.12177D0,
58418 & 0.11072D0, 0.08109D0, 0.05711D0, 0.04545D0, 0.03813D0,
58419 & 0.03299D0, 0.02611D0, 0.01996D0, 0.01434D0, 0.01121D0,
58420 & 0.00789D0, 0.00617D0, 0.00509D0, 0.00414D0, 0.00341D0,
58421 & 0.00282D0, 0.00231D0, 0.00188D0, 0.00151D0, 0.00120D0,
58422 & 0.00094D0, 0.00073D0, 0.00056D0, 0.00042D0, 0.00031D0,
58423 & 0.00023D0, 0.00016D0, 0.00012D0, 0.00008D0, 0.00005D0,
58424 & 0.00003D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
58425 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58426 DATA (FMRS(2,7,I,15),I=1,49)/
58427 & 0.99259D0, 0.76862D0, 0.59480D0, 0.51168D0, 0.45967D0,
58428 & 0.42287D0, 0.32549D0, 0.24886D0, 0.21152D0, 0.18775D0,
58429 & 0.17025D0, 0.12366D0, 0.08636D0, 0.06840D0, 0.05719D0,
58430 & 0.04937D0, 0.03895D0, 0.02967D0, 0.02125D0, 0.01657D0,
58431 & 0.01162D0, 0.00903D0, 0.00740D0, 0.00597D0, 0.00488D0,
58432 & 0.00399D0, 0.00325D0, 0.00263D0, 0.00210D0, 0.00166D0,
58433 & 0.00130D0, 0.00100D0, 0.00076D0, 0.00057D0, 0.00042D0,
58434 & 0.00031D0, 0.00022D0, 0.00015D0, 0.00011D0, 0.00007D0,
58435 & 0.00004D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
58436 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58437 DATA (FMRS(2,7,I,16),I=1,49)/
58438 & 1.40334D0, 1.07950D0, 0.82983D0, 0.71109D0, 0.63704D0,
58439 & 0.58478D0, 0.44710D0, 0.33953D0, 0.28741D0, 0.25436D0,
58440 & 0.23011D0, 0.16589D0, 0.11498D0, 0.09067D0, 0.07559D0,
58441 & 0.06510D0, 0.05120D0, 0.03889D0, 0.02777D0, 0.02161D0,
58442 & 0.01509D0, 0.01166D0, 0.00950D0, 0.00760D0, 0.00617D0,
58443 & 0.00501D0, 0.00405D0, 0.00325D0, 0.00258D0, 0.00203D0,
58444 & 0.00158D0, 0.00121D0, 0.00091D0, 0.00068D0, 0.00050D0,
58445 & 0.00037D0, 0.00026D0, 0.00018D0, 0.00012D0, 0.00008D0,
58446 & 0.00005D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
58447 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58448 DATA (FMRS(2,7,I,17),I=1,49)/
58449 & 1.88020D0, 1.43681D0, 1.09723D0, 0.93659D0, 0.83676D0,
58450 & 0.76647D0, 0.58212D0, 0.43908D0, 0.37019D0, 0.32667D0,
58451 & 0.29484D0, 0.21099D0, 0.14515D0, 0.11396D0, 0.09473D0,
58452 & 0.08141D0, 0.06382D0, 0.04833D0, 0.03440D0, 0.02672D0,
58453 & 0.01856D0, 0.01428D0, 0.01156D0, 0.00918D0, 0.00739D0,
58454 & 0.00596D0, 0.00478D0, 0.00381D0, 0.00301D0, 0.00236D0,
58455 & 0.00181D0, 0.00138D0, 0.00104D0, 0.00077D0, 0.00057D0,
58456 & 0.00041D0, 0.00030D0, 0.00020D0, 0.00014D0, 0.00009D0,
58457 & 0.00005D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
58458 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58459 DATA (FMRS(2,7,I,18),I=1,49)/
58460 & 2.30534D0, 1.75221D0, 1.33088D0, 1.13244D0, 1.00946D0,
58461 & 0.92305D0, 0.69723D0, 0.52301D0, 0.43952D0, 0.38693D0,
58462 & 0.34856D0, 0.24795D0, 0.16954D0, 0.13265D0, 0.11000D0,
58463 & 0.09436D0, 0.07379D0, 0.05574D0, 0.03958D0, 0.03067D0,
58464 & 0.02123D0, 0.01626D0, 0.01309D0, 0.01033D0, 0.00826D0,
58465 & 0.00663D0, 0.00529D0, 0.00419D0, 0.00329D0, 0.00257D0,
58466 & 0.00197D0, 0.00150D0, 0.00112D0, 0.00083D0, 0.00061D0,
58467 & 0.00044D0, 0.00032D0, 0.00022D0, 0.00015D0, 0.00009D0,
58468 & 0.00005D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
58469 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58470 DATA (FMRS(2,7,I,19),I=1,49)/
58471 & 2.86856D0, 2.16633D0, 1.63487D0, 1.38587D0, 1.23207D0,
58472 & 1.12426D0, 0.84372D0, 0.62876D0, 0.52633D0, 0.46206D0,
58473 & 0.41530D0, 0.29334D0, 0.19914D0, 0.15517D0, 0.12832D0,
58474 & 0.10984D0, 0.08563D0, 0.06450D0, 0.04565D0, 0.03529D0,
58475 & 0.02431D0, 0.01851D0, 0.01482D0, 0.01161D0, 0.00922D0,
58476 & 0.00734D0, 0.00582D0, 0.00458D0, 0.00358D0, 0.00278D0,
58477 & 0.00212D0, 0.00160D0, 0.00119D0, 0.00088D0, 0.00064D0,
58478 & 0.00047D0, 0.00033D0, 0.00023D0, 0.00015D0, 0.00009D0,
58479 & 0.00005D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
58480 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58481 DATA (FMRS(2,7,I,20),I=1,49)/
58482 & 3.42748D0, 2.57399D0, 1.93167D0, 1.63211D0, 1.44759D0,
58483 & 1.31854D0, 0.98395D0, 0.72909D0, 0.60825D0, 0.53267D0,
58484 & 0.47783D0, 0.33544D0, 0.22632D0, 0.17572D0, 0.14495D0,
58485 & 0.12384D0, 0.09630D0, 0.07234D0, 0.05105D0, 0.03938D0,
58486 & 0.02701D0, 0.02047D0, 0.01631D0, 0.01268D0, 0.01001D0,
58487 & 0.00793D0, 0.00625D0, 0.00489D0, 0.00380D0, 0.00294D0,
58488 & 0.00223D0, 0.00168D0, 0.00125D0, 0.00091D0, 0.00066D0,
58489 & 0.00048D0, 0.00035D0, 0.00024D0, 0.00016D0, 0.00009D0,
58490 & 0.00005D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
58491 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58492 DATA (FMRS(2,7,I,21),I=1,49)/
58493 & 3.95907D0, 2.95830D0, 2.20894D0, 1.86088D0, 1.64705D0,
58494 & 1.49778D0, 1.11204D0, 0.81980D0, 0.68185D0, 0.59583D0,
58495 & 0.53354D0, 0.37251D0, 0.24993D0, 0.19343D0, 0.15921D0,
58496 & 0.13581D0, 0.10535D0, 0.07895D0, 0.05557D0, 0.04278D0,
58497 & 0.02922D0, 0.02205D0, 0.01748D0, 0.01352D0, 0.01061D0,
58498 & 0.00835D0, 0.00655D0, 0.00511D0, 0.00395D0, 0.00304D0,
58499 & 0.00230D0, 0.00172D0, 0.00128D0, 0.00093D0, 0.00067D0,
58500 & 0.00049D0, 0.00035D0, 0.00024D0, 0.00016D0, 0.00009D0,
58501 & 0.00005D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
58502 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58503 DATA (FMRS(2,7,I,22),I=1,49)/
58504 & 4.70301D0, 3.49223D0, 2.59131D0, 2.17500D0, 1.92006D0,
58505 & 1.74251D0, 1.28559D0, 0.94171D0, 0.78029D0, 0.68000D0,
58506 & 0.60759D0, 0.42132D0, 0.28074D0, 0.21641D0, 0.17764D0,
58507 & 0.15121D0, 0.11695D0, 0.08738D0, 0.06130D0, 0.04706D0,
58508 & 0.03198D0, 0.02400D0, 0.01891D0, 0.01452D0, 0.01131D0,
58509 & 0.00885D0, 0.00690D0, 0.00535D0, 0.00412D0, 0.00314D0,
58510 & 0.00237D0, 0.00177D0, 0.00130D0, 0.00095D0, 0.00068D0,
58511 & 0.00049D0, 0.00036D0, 0.00024D0, 0.00016D0, 0.00009D0,
58512 & 0.00005D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
58513 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58514 DATA (FMRS(2,7,I,23),I=1,49)/
58515 & 5.46775D0, 4.03669D0, 2.97803D0, 2.49113D0, 2.19384D0,
58516 & 1.98726D0, 1.45764D0, 1.06148D0, 0.87647D0, 0.76190D0,
58517 & 0.67941D0, 0.46817D0, 0.30998D0, 0.23809D0, 0.19493D0,
58518 & 0.16562D0, 0.12774D0, 0.09517D0, 0.06655D0, 0.05097D0,
58519 & 0.03446D0, 0.02573D0, 0.02017D0, 0.01538D0, 0.01190D0,
58520 & 0.00925D0, 0.00718D0, 0.00553D0, 0.00424D0, 0.00322D0,
58521 & 0.00242D0, 0.00179D0, 0.00132D0, 0.00095D0, 0.00069D0,
58522 & 0.00049D0, 0.00036D0, 0.00024D0, 0.00016D0, 0.00009D0,
58523 & 0.00005D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
58524 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58525 DATA (FMRS(2,7,I,24),I=1,49)/
58526 & 6.21519D0, 4.56429D0, 3.34948D0, 2.79317D0, 2.45443D0,
58527 & 2.21950D0, 1.61934D0, 1.17290D0, 0.96539D0, 0.83728D0,
58528 & 0.74526D0, 0.51062D0, 0.33614D0, 0.25732D0, 0.21020D0,
58529 & 0.17828D0, 0.13715D0, 0.10192D0, 0.07106D0, 0.05428D0,
58530 & 0.03653D0, 0.02714D0, 0.02117D0, 0.01604D0, 0.01234D0,
58531 & 0.00954D0, 0.00736D0, 0.00565D0, 0.00431D0, 0.00326D0,
58532 & 0.00243D0, 0.00180D0, 0.00132D0, 0.00095D0, 0.00068D0,
58533 & 0.00049D0, 0.00035D0, 0.00024D0, 0.00016D0, 0.00009D0,
58534 & 0.00005D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
58535 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58536 DATA (FMRS(2,7,I,25),I=1,49)/
58537 & 7.03262D0, 5.13776D0, 3.75072D0, 3.11823D0, 2.73413D0,
58538 & 2.46827D0, 1.79141D0, 1.29068D0, 1.05901D0, 0.91641D0,
58539 & 0.81423D0, 0.55475D0, 0.36312D0, 0.27706D0, 0.22581D0,
58540 & 0.19119D0, 0.14672D0, 0.10875D0, 0.07559D0, 0.05760D0,
58541 & 0.03859D0, 0.02852D0, 0.02214D0, 0.01668D0, 0.01276D0,
58542 & 0.00981D0, 0.00753D0, 0.00575D0, 0.00436D0, 0.00329D0,
58543 & 0.00245D0, 0.00180D0, 0.00132D0, 0.00095D0, 0.00068D0,
58544 & 0.00048D0, 0.00035D0, 0.00024D0, 0.00016D0, 0.00009D0,
58545 & 0.00005D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
58546 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58547 DATA (FMRS(2,7,I,26),I=1,49)/
58548 & 7.86804D0, 5.71947D0, 4.15459D0, 3.44391D0, 3.01342D0,
58549 & 2.71602D0, 1.96133D0, 1.40596D0, 1.15014D0, 0.99314D0,
58550 & 0.88088D0, 0.59694D0, 0.38863D0, 0.29560D0, 0.24039D0,
58551 & 0.20320D0, 0.15555D0, 0.11500D0, 0.07970D0, 0.06059D0,
58552 & 0.04040D0, 0.02973D0, 0.02296D0, 0.01720D0, 0.01308D0,
58553 & 0.01001D0, 0.00765D0, 0.00581D0, 0.00439D0, 0.00330D0,
58554 & 0.00245D0, 0.00180D0, 0.00131D0, 0.00094D0, 0.00067D0,
58555 & 0.00048D0, 0.00034D0, 0.00024D0, 0.00016D0, 0.00009D0,
58556 & 0.00005D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
58557 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58558 DATA (FMRS(2,7,I,27),I=1,49)/
58559 & 8.71308D0, 6.30440D0, 4.55822D0, 3.76823D0, 3.29083D0,
58560 & 2.96160D0, 2.12868D0, 1.51874D0, 1.23894D0, 1.06767D0,
58561 & 0.94548D0, 0.63752D0, 0.41296D0, 0.31319D0, 0.25418D0,
58562 & 0.21452D0, 0.16385D0, 0.12085D0, 0.08351D0, 0.06334D0,
58563 & 0.04205D0, 0.03081D0, 0.02369D0, 0.01765D0, 0.01336D0,
58564 & 0.01017D0, 0.00773D0, 0.00586D0, 0.00441D0, 0.00330D0,
58565 & 0.00244D0, 0.00178D0, 0.00129D0, 0.00092D0, 0.00066D0,
58566 & 0.00047D0, 0.00034D0, 0.00024D0, 0.00016D0, 0.00009D0,
58567 & 0.00005D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
58568 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58569 DATA (FMRS(2,7,I,28),I=1,49)/
58570 & 9.54571D0, 6.87720D0, 4.95101D0, 4.08263D0, 3.55902D0,
58571 & 3.19851D0, 2.28903D0, 1.62602D0, 1.32303D0, 1.13803D0,
58572 & 1.00630D0, 0.67540D0, 0.43546D0, 0.32936D0, 0.26680D0,
58573 & 0.22485D0, 0.17138D0, 0.12612D0, 0.08693D0, 0.06579D0,
58574 & 0.04350D0, 0.03173D0, 0.02430D0, 0.01801D0, 0.01357D0,
58575 & 0.01029D0, 0.00779D0, 0.00587D0, 0.00441D0, 0.00329D0,
58576 & 0.00242D0, 0.00177D0, 0.00128D0, 0.00091D0, 0.00065D0,
58577 & 0.00046D0, 0.00033D0, 0.00024D0, 0.00016D0, 0.00009D0,
58578 & 0.00005D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
58579 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58580 DATA (FMRS(2,7,I,29),I=1,49)/
58581 & 10.42768D0, 7.48069D0, 5.36257D0, 4.41099D0, 3.83846D0,
58582 & 3.44489D0, 2.45481D0, 1.73627D0, 1.40913D0, 1.20986D0,
58583 & 1.06825D0, 0.71372D0, 0.45804D0, 0.34552D0, 0.27937D0,
58584 & 0.23511D0, 0.17881D0, 0.13130D0, 0.09026D0, 0.06816D0,
58585 & 0.04488D0, 0.03260D0, 0.02487D0, 0.01834D0, 0.01375D0,
58586 & 0.01038D0, 0.00783D0, 0.00588D0, 0.00440D0, 0.00327D0,
58587 & 0.00240D0, 0.00175D0, 0.00126D0, 0.00090D0, 0.00063D0,
58588 & 0.00045D0, 0.00033D0, 0.00024D0, 0.00016D0, 0.00009D0,
58589 & 0.00005D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
58590 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58591 DATA (FMRS(2,7,I,30),I=1,49)/
58592 & 11.32906D0, 8.09395D0, 5.77834D0, 4.74153D0, 4.11903D0,
58593 & 3.69178D0, 2.61985D0, 1.84528D0, 1.49390D0, 1.28038D0,
58594 & 1.12893D0, 0.75094D0, 0.47979D0, 0.36099D0, 0.29135D0,
58595 & 0.24485D0, 0.18584D0, 0.13617D0, 0.09335D0, 0.07035D0,
58596 & 0.04613D0, 0.03338D0, 0.02536D0, 0.01861D0, 0.01389D0,
58597 & 0.01045D0, 0.00785D0, 0.00587D0, 0.00438D0, 0.00324D0,
58598 & 0.00237D0, 0.00172D0, 0.00124D0, 0.00088D0, 0.00062D0,
58599 & 0.00044D0, 0.00032D0, 0.00024D0, 0.00016D0, 0.00009D0,
58600 & 0.00005D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
58601 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58602 DATA (FMRS(2,7,I,31),I=1,49)/
58603 & 12.23197D0, 8.70533D0, 6.19083D0, 5.06852D0, 4.39601D0,
58604 & 3.93512D0, 2.78170D0, 1.95161D0, 1.57633D0, 1.34878D0,
58605 & 1.18767D0, 0.78675D0, 0.50057D0, 0.37571D0, 0.30272D0,
58606 & 0.25408D0, 0.19247D0, 0.14074D0, 0.09625D0, 0.07237D0,
58607 & 0.04728D0, 0.03408D0, 0.02579D0, 0.01885D0, 0.01401D0,
58608 & 0.01049D0, 0.00785D0, 0.00586D0, 0.00435D0, 0.00321D0,
58609 & 0.00235D0, 0.00170D0, 0.00122D0, 0.00086D0, 0.00061D0,
58610 & 0.00043D0, 0.00031D0, 0.00023D0, 0.00016D0, 0.00009D0,
58611 & 0.00005D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
58612 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58613 DATA (FMRS(2,7,I,32),I=1,49)/
58614 & 13.10605D0, 9.29397D0, 6.58574D0, 5.38050D0, 4.65963D0,
58615 & 4.16627D0, 2.93446D0, 2.05131D0, 1.65329D0, 1.41245D0,
58616 & 1.24220D0, 0.81972D0, 0.51953D0, 0.38906D0, 0.31298D0,
58617 & 0.26237D0, 0.19840D0, 0.14478D0, 0.09878D0, 0.07413D0,
58618 & 0.04825D0, 0.03465D0, 0.02614D0, 0.01902D0, 0.01408D0,
58619 & 0.01051D0, 0.00784D0, 0.00583D0, 0.00432D0, 0.00318D0,
58620 & 0.00232D0, 0.00167D0, 0.00120D0, 0.00085D0, 0.00060D0,
58621 & 0.00042D0, 0.00031D0, 0.00023D0, 0.00016D0, 0.00009D0,
58622 & 0.00005D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
58623 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58624 DATA (FMRS(2,7,I,33),I=1,49)/
58625 & 14.04396D0, 9.92333D0, 7.00645D0, 5.71217D0, 4.93947D0,
58626 & 4.41134D0, 3.09586D0, 2.15625D0, 1.73413D0, 1.47923D0,
58627 & 1.29933D0, 0.85413D0, 0.53923D0, 0.40291D0, 0.32360D0,
58628 & 0.27095D0, 0.20451D0, 0.14895D0, 0.10139D0, 0.07594D0,
58629 & 0.04925D0, 0.03524D0, 0.02649D0, 0.01920D0, 0.01416D0,
58630 & 0.01053D0, 0.00783D0, 0.00580D0, 0.00428D0, 0.00315D0,
58631 & 0.00229D0, 0.00165D0, 0.00118D0, 0.00083D0, 0.00058D0,
58632 & 0.00041D0, 0.00030D0, 0.00022D0, 0.00016D0, 0.00009D0,
58633 & 0.00005D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
58634 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58635 DATA (FMRS(2,7,I,34),I=1,49)/
58636 & 14.97171D0, 10.54223D0, 7.41762D0, 6.03510D0, 5.21118D0,
58637 & 4.64879D0, 3.25111D0, 2.25643D0, 1.81093D0, 1.54244D0,
58638 & 1.35325D0, 0.88628D0, 0.55744D0, 0.41560D0, 0.33329D0,
58639 & 0.27873D0, 0.21001D0, 0.15267D0, 0.10367D0, 0.07749D0,
58640 & 0.05007D0, 0.03571D0, 0.02675D0, 0.01931D0, 0.01419D0,
58641 & 0.01051D0, 0.00779D0, 0.00576D0, 0.00424D0, 0.00311D0,
58642 & 0.00225D0, 0.00162D0, 0.00115D0, 0.00081D0, 0.00057D0,
58643 & 0.00041D0, 0.00030D0, 0.00022D0, 0.00016D0, 0.00009D0,
58644 & 0.00005D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
58645 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58646 DATA (FMRS(2,7,I,35),I=1,49)/
58647 & 15.90678D0, 11.16388D0, 7.82922D0, 6.35772D0, 5.48225D0,
58648 & 4.88541D0, 3.40531D0, 2.35558D0, 1.88678D0, 1.60477D0,
58649 & 1.40636D0, 0.91783D0, 0.57524D0, 0.42799D0, 0.34272D0,
58650 & 0.28629D0, 0.21535D0, 0.15626D0, 0.10587D0, 0.07899D0,
58651 & 0.05087D0, 0.03616D0, 0.02700D0, 0.01941D0, 0.01421D0,
58652 & 0.01050D0, 0.00776D0, 0.00572D0, 0.00420D0, 0.00307D0,
58653 & 0.00222D0, 0.00159D0, 0.00113D0, 0.00080D0, 0.00056D0,
58654 & 0.00040D0, 0.00029D0, 0.00022D0, 0.00016D0, 0.00009D0,
58655 & 0.00005D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
58656 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58657 DATA (FMRS(2,7,I,36),I=1,49)/
58658 & 16.81722D0, 11.76659D0, 8.22652D0, 6.66831D0, 5.74271D0,
58659 & 5.11243D0, 3.55252D0, 2.44976D0, 1.95860D0, 1.66366D0,
58660 & 1.45643D0, 0.94739D0, 0.59179D0, 0.43945D0, 0.35142D0,
58661 & 0.29325D0, 0.22023D0, 0.15953D0, 0.10786D0, 0.08033D0,
58662 & 0.05156D0, 0.03654D0, 0.02720D0, 0.01949D0, 0.01422D0,
58663 & 0.01047D0, 0.00772D0, 0.00567D0, 0.00416D0, 0.00303D0,
58664 & 0.00219D0, 0.00157D0, 0.00111D0, 0.00078D0, 0.00055D0,
58665 & 0.00039D0, 0.00029D0, 0.00022D0, 0.00016D0, 0.00009D0,
58666 & 0.00005D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
58667 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58668 DATA (FMRS(2,7,I,37),I=1,49)/
58669 & 17.75747D0, 12.38637D0, 8.63327D0, 6.98544D0, 6.00814D0,
58670 & 5.34342D0, 3.70158D0, 2.54461D0, 2.03070D0, 1.72263D0,
58671 & 1.50647D0, 0.97674D0, 0.60811D0, 0.45069D0, 0.35992D0,
58672 & 0.30003D0, 0.22496D0, 0.16268D0, 0.10975D0, 0.08160D0,
58673 & 0.05220D0, 0.03687D0, 0.02737D0, 0.01954D0, 0.01421D0,
58674 & 0.01044D0, 0.00767D0, 0.00562D0, 0.00411D0, 0.00299D0,
58675 & 0.00215D0, 0.00154D0, 0.00109D0, 0.00077D0, 0.00053D0,
58676 & 0.00038D0, 0.00028D0, 0.00021D0, 0.00016D0, 0.00009D0,
58677 & 0.00005D0, 0.00002D0, 0.00000D0, 0.00000D0, 0.00000D0,
58678 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58679 DATA (FMRS(2,7,I,38),I=1,49)/
58680 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58681 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58682 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58683 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58684 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58685 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58686 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58687 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58688 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
58689 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58690 DATA (FMRS(2,8,I, 1),I=1,49)/
58691 & 0.98494D0, 0.83942D0, 0.71517D0, 0.65113D0, 0.60921D0,
58692 & 0.57857D0, 0.49313D0, 0.42114D0, 0.38478D0, 0.36147D0,
58693 & 0.34532D0, 0.30109D0, 0.26601D0, 0.24883D0, 0.23797D0,
58694 & 0.23013D0, 0.21908D0, 0.20797D0, 0.19531D0, 0.18554D0,
58695 & 0.16898D0, 0.15367D0, 0.13862D0, 0.11992D0, 0.10161D0,
58696 & 0.08421D0, 0.06813D0, 0.05380D0, 0.04148D0, 0.03102D0,
58697 & 0.02276D0, 0.01618D0, 0.01125D0, 0.00763D0, 0.00500D0,
58698 & 0.00317D0, 0.00203D0, 0.00121D0, 0.00069D0, 0.00043D0,
58699 & 0.00027D0, 0.00012D0, 0.00011D0, 0.00003D0, 0.00000D0,
58700 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58701 DATA (FMRS(2,8,I, 2),I=1,49)/
58702 & 0.98889D0, 0.84649D0, 0.72438D0, 0.66122D0, 0.61978D0,
58703 & 0.58944D0, 0.50458D0, 0.43271D0, 0.39626D0, 0.37282D0,
58704 & 0.35655D0, 0.31168D0, 0.27538D0, 0.25719D0, 0.24547D0,
58705 & 0.23690D0, 0.22464D0, 0.21217D0, 0.19794D0, 0.18712D0,
58706 & 0.16930D0, 0.15330D0, 0.13787D0, 0.11894D0, 0.10059D0,
58707 & 0.08325D0, 0.06732D0, 0.05317D0, 0.04104D0, 0.03076D0,
58708 & 0.02264D0, 0.01619D0, 0.01134D0, 0.00776D0, 0.00516D0,
58709 & 0.00334D0, 0.00218D0, 0.00135D0, 0.00080D0, 0.00052D0,
58710 & 0.00034D0, 0.00018D0, 0.00014D0, 0.00004D0, 0.00001D0,
58711 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58712 DATA (FMRS(2,8,I, 3),I=1,49)/
58713 & 1.01222D0, 0.87111D0, 0.74946D0, 0.68626D0, 0.64467D0,
58714 & 0.61416D0, 0.52846D0, 0.45538D0, 0.41806D0, 0.39393D0,
58715 & 0.37708D0, 0.33010D0, 0.29099D0, 0.27082D0, 0.25752D0,
58716 & 0.24766D0, 0.23338D0, 0.21871D0, 0.20204D0, 0.18963D0,
58717 & 0.16990D0, 0.15288D0, 0.13686D0, 0.11759D0, 0.09914D0,
58718 & 0.08186D0, 0.06611D0, 0.05221D0, 0.04030D0, 0.03030D0,
58719 & 0.02237D0, 0.01612D0, 0.01138D0, 0.00788D0, 0.00532D0,
58720 & 0.00353D0, 0.00233D0, 0.00151D0, 0.00092D0, 0.00061D0,
58721 & 0.00042D0, 0.00024D0, 0.00016D0, 0.00005D0, 0.00002D0,
58722 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58723 DATA (FMRS(2,8,I, 4),I=1,49)/
58724 & 1.04476D0, 0.90153D0, 0.77771D0, 0.71324D0, 0.67074D0,
58725 & 0.63953D0, 0.55166D0, 0.47640D0, 0.43777D0, 0.41269D0,
58726 & 0.39507D0, 0.34558D0, 0.30362D0, 0.28161D0, 0.26695D0,
58727 & 0.25601D0, 0.24007D0, 0.22367D0, 0.20514D0, 0.19155D0,
58728 & 0.17043D0, 0.15264D0, 0.13620D0, 0.11664D0, 0.09810D0,
58729 & 0.08084D0, 0.06518D0, 0.05144D0, 0.03971D0, 0.02989D0,
58730 & 0.02211D0, 0.01600D0, 0.01135D0, 0.00790D0, 0.00539D0,
58731 & 0.00362D0, 0.00238D0, 0.00157D0, 0.00098D0, 0.00066D0,
58732 & 0.00045D0, 0.00026D0, 0.00018D0, 0.00006D0, 0.00003D0,
58733 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58734 DATA (FMRS(2,8,I, 5),I=1,49)/
58735 & 1.10026D0, 0.95040D0, 0.82069D0, 0.75308D0, 0.70848D0,
58736 & 0.67571D0, 0.58330D0, 0.50390D0, 0.46299D0, 0.43632D0,
58737 & 0.41743D0, 0.36409D0, 0.31818D0, 0.29384D0, 0.27750D0,
58738 & 0.26527D0, 0.24742D0, 0.22908D0, 0.20853D0, 0.19368D0,
58739 & 0.17108D0, 0.15248D0, 0.13556D0, 0.11567D0, 0.09702D0,
58740 & 0.07977D0, 0.06421D0, 0.05061D0, 0.03905D0, 0.02941D0,
58741 & 0.02179D0, 0.01578D0, 0.01121D0, 0.00787D0, 0.00539D0,
58742 & 0.00363D0, 0.00243D0, 0.00163D0, 0.00101D0, 0.00068D0,
58743 & 0.00046D0, 0.00028D0, 0.00020D0, 0.00007D0, 0.00002D0,
58744 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58745 DATA (FMRS(2,8,I, 6),I=1,49)/
58746 & 1.15923D0, 1.00143D0, 0.86481D0, 0.79358D0, 0.74658D0,
58747 & 0.71202D0, 0.61454D0, 0.53061D0, 0.48723D0, 0.45888D0,
58748 & 0.43867D0, 0.38135D0, 0.33152D0, 0.30491D0, 0.28699D0,
58749 & 0.27355D0, 0.25394D0, 0.23384D0, 0.21150D0, 0.19554D0,
58750 & 0.17166D0, 0.15236D0, 0.13502D0, 0.11484D0, 0.09608D0,
58751 & 0.07883D0, 0.06335D0, 0.04988D0, 0.03847D0, 0.02897D0,
58752 & 0.02148D0, 0.01557D0, 0.01108D0, 0.00781D0, 0.00536D0,
58753 & 0.00363D0, 0.00245D0, 0.00167D0, 0.00103D0, 0.00070D0,
58754 & 0.00046D0, 0.00029D0, 0.00021D0, 0.00007D0, 0.00002D0,
58755 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58756 DATA (FMRS(2,8,I, 7),I=1,49)/
58757 & 1.23248D0, 1.06345D0, 0.91726D0, 0.84109D0, 0.79085D0,
58758 & 0.75393D0, 0.64976D0, 0.56002D0, 0.51357D0, 0.48314D0,
58759 & 0.46132D0, 0.39931D0, 0.34507D0, 0.31602D0, 0.29642D0,
58760 & 0.28173D0, 0.26034D0, 0.23848D0, 0.21438D0, 0.19736D0,
58761 & 0.17224D0, 0.15227D0, 0.13452D0, 0.11404D0, 0.09516D0,
58762 & 0.07789D0, 0.06251D0, 0.04914D0, 0.03786D0, 0.02851D0,
58763 & 0.02113D0, 0.01532D0, 0.01096D0, 0.00772D0, 0.00530D0,
58764 & 0.00360D0, 0.00243D0, 0.00166D0, 0.00104D0, 0.00071D0,
58765 & 0.00048D0, 0.00030D0, 0.00020D0, 0.00008D0, 0.00002D0,
58766 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58767 DATA (FMRS(2,8,I, 8),I=1,49)/
58768 & 1.32548D0, 1.14118D0, 0.98212D0, 0.89937D0, 0.84484D0,
58769 & 0.80478D0, 0.69187D0, 0.59465D0, 0.54428D0, 0.51124D0,
58770 & 0.48741D0, 0.41964D0, 0.36014D0, 0.32825D0, 0.30675D0,
58771 & 0.29065D0, 0.26725D0, 0.24348D0, 0.21747D0, 0.19931D0,
58772 & 0.17288D0, 0.15217D0, 0.13398D0, 0.11319D0, 0.09418D0,
58773 & 0.07689D0, 0.06158D0, 0.04833D0, 0.03719D0, 0.02798D0,
58774 & 0.02073D0, 0.01504D0, 0.01077D0, 0.00760D0, 0.00523D0,
58775 & 0.00355D0, 0.00240D0, 0.00165D0, 0.00105D0, 0.00070D0,
58776 & 0.00048D0, 0.00029D0, 0.00020D0, 0.00007D0, 0.00002D0,
58777 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58778 DATA (FMRS(2,8,I, 9),I=1,49)/
58779 & 1.41996D0, 1.21934D0, 1.04662D0, 0.95694D0, 0.89790D0,
58780 & 0.85457D0, 0.73259D0, 0.62769D0, 0.57336D0, 0.53768D0,
58781 & 0.51185D0, 0.43840D0, 0.37384D0, 0.33927D0, 0.31599D0,
58782 & 0.29859D0, 0.27338D0, 0.24788D0, 0.22018D0, 0.20102D0,
58783 & 0.17344D0, 0.15210D0, 0.13351D0, 0.11246D0, 0.09333D0,
58784 & 0.07602D0, 0.06075D0, 0.04762D0, 0.03659D0, 0.02749D0,
58785 & 0.02036D0, 0.01479D0, 0.01057D0, 0.00748D0, 0.00516D0,
58786 & 0.00349D0, 0.00238D0, 0.00163D0, 0.00104D0, 0.00069D0,
58787 & 0.00047D0, 0.00028D0, 0.00019D0, 0.00006D0, 0.00002D0,
58788 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58789 DATA (FMRS(2,8,I,10),I=1,49)/
58790 & 1.52623D0, 1.30628D0, 1.11753D0, 1.01977D0, 0.95552D0,
58791 & 0.90841D0, 0.77603D0, 0.66243D0, 0.60365D0, 0.56506D0,
58792 & 0.53703D0, 0.45743D0, 0.38751D0, 0.35017D0, 0.32507D0,
58793 & 0.30636D0, 0.27933D0, 0.25214D0, 0.22280D0, 0.20266D0,
58794 & 0.17397D0, 0.15202D0, 0.13306D0, 0.11174D0, 0.09248D0,
58795 & 0.07516D0, 0.05994D0, 0.04691D0, 0.03600D0, 0.02702D0,
58796 & 0.02000D0, 0.01454D0, 0.01039D0, 0.00736D0, 0.00507D0,
58797 & 0.00344D0, 0.00235D0, 0.00162D0, 0.00103D0, 0.00069D0,
58798 & 0.00047D0, 0.00027D0, 0.00019D0, 0.00006D0, 0.00002D0,
58799 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58800 DATA (FMRS(2,8,I,11),I=1,49)/
58801 & 1.61996D0, 1.38242D0, 1.17917D0, 1.07414D0, 1.00521D0,
58802 & 0.95472D0, 0.81307D0, 0.69180D0, 0.62911D0, 0.58797D0,
58803 & 0.55803D0, 0.47313D0, 0.39867D0, 0.35901D0, 0.33241D0,
58804 & 0.31262D0, 0.28411D0, 0.25553D0, 0.22487D0, 0.20396D0,
58805 & 0.17439D0, 0.15196D0, 0.13270D0, 0.11116D0, 0.09180D0,
58806 & 0.07446D0, 0.05929D0, 0.04635D0, 0.03552D0, 0.02665D0,
58807 & 0.01972D0, 0.01433D0, 0.01024D0, 0.00726D0, 0.00500D0,
58808 & 0.00340D0, 0.00233D0, 0.00161D0, 0.00102D0, 0.00069D0,
58809 & 0.00047D0, 0.00027D0, 0.00019D0, 0.00006D0, 0.00002D0,
58810 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58811 DATA (FMRS(2,8,I,12),I=1,49)/
58812 & 1.85147D0, 1.56851D0, 1.32816D0, 1.20469D0, 1.12394D0,
58813 & 1.06494D0, 0.90014D0, 0.75989D0, 0.68768D0, 0.64036D0,
58814 & 0.60582D0, 0.50832D0, 0.42330D0, 0.37835D0, 0.34837D0,
58815 & 0.32616D0, 0.29437D0, 0.26278D0, 0.22928D0, 0.20671D0,
58816 & 0.17525D0, 0.15178D0, 0.13188D0, 0.10989D0, 0.09032D0,
58817 & 0.07294D0, 0.05789D0, 0.04511D0, 0.03448D0, 0.02582D0,
58818 & 0.01907D0, 0.01385D0, 0.00987D0, 0.00700D0, 0.00482D0,
58819 & 0.00328D0, 0.00224D0, 0.00154D0, 0.00100D0, 0.00066D0,
58820 & 0.00045D0, 0.00027D0, 0.00019D0, 0.00006D0, 0.00002D0,
58821 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58822 DATA (FMRS(2,8,I,13),I=1,49)/
58823 & 2.08649D0, 1.75519D0, 1.47580D0, 1.33308D0, 1.24007D0,
58824 & 1.17230D0, 0.98378D0, 0.82434D0, 0.74261D0, 0.68917D0,
58825 & 0.65012D0, 0.54038D0, 0.44535D0, 0.39548D0, 0.36240D0,
58826 & 0.33801D0, 0.30327D0, 0.26901D0, 0.23303D0, 0.20903D0,
58827 & 0.17595D0, 0.15158D0, 0.13113D0, 0.10875D0, 0.08901D0,
58828 & 0.07161D0, 0.05666D0, 0.04403D0, 0.03356D0, 0.02508D0,
58829 & 0.01848D0, 0.01341D0, 0.00954D0, 0.00676D0, 0.00467D0,
58830 & 0.00317D0, 0.00216D0, 0.00148D0, 0.00096D0, 0.00064D0,
58831 & 0.00043D0, 0.00027D0, 0.00018D0, 0.00006D0, 0.00002D0,
58832 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58833 DATA (FMRS(2,8,I,14),I=1,49)/
58834 & 2.39126D0, 1.99450D0, 1.66281D0, 1.49454D0, 1.38536D0,
58835 & 1.30604D0, 1.08660D0, 0.90248D0, 0.80863D0, 0.74747D0,
58836 & 0.70276D0, 0.57787D0, 0.47070D0, 0.41497D0, 0.37825D0,
58837 & 0.35132D0, 0.31319D0, 0.27591D0, 0.23714D0, 0.21153D0,
58838 & 0.17666D0, 0.15129D0, 0.13023D0, 0.10742D0, 0.08751D0,
58839 & 0.07010D0, 0.05525D0, 0.04280D0, 0.03250D0, 0.02426D0,
58840 & 0.01784D0, 0.01291D0, 0.00918D0, 0.00650D0, 0.00451D0,
58841 & 0.00308D0, 0.00210D0, 0.00146D0, 0.00091D0, 0.00061D0,
58842 & 0.00040D0, 0.00024D0, 0.00017D0, 0.00007D0, 0.00002D0,
58843 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58844 DATA (FMRS(2,8,I,15),I=1,49)/
58845 & 2.76033D0, 2.28068D0, 1.88356D0, 1.68366D0, 1.55456D0,
58846 & 1.46111D0, 1.20412D0, 0.99043D0, 0.88227D0, 0.81205D0,
58847 & 0.76076D0, 0.61847D0, 0.49766D0, 0.43549D0, 0.39480D0,
58848 & 0.36513D0, 0.32340D0, 0.28293D0, 0.24126D0, 0.21400D0,
58849 & 0.17728D0, 0.15089D0, 0.12922D0, 0.10598D0, 0.08590D0,
58850 & 0.06852D0, 0.05375D0, 0.04146D0, 0.03141D0, 0.02338D0,
58851 & 0.01716D0, 0.01238D0, 0.00882D0, 0.00618D0, 0.00431D0,
58852 & 0.00292D0, 0.00200D0, 0.00136D0, 0.00088D0, 0.00058D0,
58853 & 0.00038D0, 0.00023D0, 0.00015D0, 0.00006D0, 0.00002D0,
58854 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58855 DATA (FMRS(2,8,I,16),I=1,49)/
58856 & 3.14075D0, 2.57242D0, 2.10607D0, 1.87299D0, 1.72314D0,
58857 & 1.61501D0, 1.31935D0, 1.07560D0, 0.95301D0, 0.87374D0,
58858 & 0.81592D0, 0.65651D0, 0.52253D0, 0.45423D0, 0.40982D0,
58859 & 0.37760D0, 0.33254D0, 0.28915D0, 0.24485D0, 0.21612D0,
58860 & 0.17773D0, 0.15044D0, 0.12821D0, 0.10460D0, 0.08439D0,
58861 & 0.06702D0, 0.05238D0, 0.04027D0, 0.03041D0, 0.02258D0,
58862 & 0.01653D0, 0.01190D0, 0.00847D0, 0.00593D0, 0.00412D0,
58863 & 0.00279D0, 0.00191D0, 0.00129D0, 0.00084D0, 0.00056D0,
58864 & 0.00036D0, 0.00023D0, 0.00014D0, 0.00006D0, 0.00002D0,
58865 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58866 DATA (FMRS(2,8,I,17),I=1,49)/
58867 & 3.57238D0, 2.90007D0, 2.35339D0, 2.08215D0, 1.90855D0,
58868 & 1.78371D0, 1.44428D0, 1.16687D0, 1.02831D0, 0.93907D0,
58869 & 0.87409D0, 0.69611D0, 0.54805D0, 0.47331D0, 0.42502D0,
58870 & 0.39015D0, 0.34166D0, 0.29530D0, 0.24836D0, 0.21814D0,
58871 & 0.17810D0, 0.14991D0, 0.12715D0, 0.10317D0, 0.08284D0,
58872 & 0.06549D0, 0.05101D0, 0.03909D0, 0.02941D0, 0.02178D0,
58873 & 0.01590D0, 0.01142D0, 0.00811D0, 0.00570D0, 0.00393D0,
58874 & 0.00267D0, 0.00181D0, 0.00123D0, 0.00079D0, 0.00053D0,
58875 & 0.00034D0, 0.00022D0, 0.00013D0, 0.00006D0, 0.00001D0,
58876 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58877 DATA (FMRS(2,8,I,18),I=1,49)/
58878 & 3.96850D0, 3.19797D0, 2.57613D0, 2.26945D0, 2.07391D0,
58879 & 1.93368D0, 1.55423D0, 1.24636D0, 1.09346D0, 0.99533D0,
58880 & 0.92399D0, 0.72966D0, 0.56941D0, 0.48914D0, 0.43755D0,
58881 & 0.40046D0, 0.34910D0, 0.30027D0, 0.25115D0, 0.21971D0,
58882 & 0.17833D0, 0.14941D0, 0.12622D0, 0.10197D0, 0.08154D0,
58883 & 0.06423D0, 0.04986D0, 0.03809D0, 0.02858D0, 0.02112D0,
58884 & 0.01538D0, 0.01101D0, 0.00783D0, 0.00549D0, 0.00377D0,
58885 & 0.00256D0, 0.00173D0, 0.00118D0, 0.00076D0, 0.00050D0,
58886 & 0.00033D0, 0.00020D0, 0.00012D0, 0.00005D0, 0.00002D0,
58887 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58888 DATA (FMRS(2,8,I,19),I=1,49)/
58889 & 4.49525D0, 3.59055D0, 2.86699D0, 2.51271D0, 2.28784D0,
58890 & 2.12710D0, 1.69466D0, 1.34689D0, 1.17536D0, 1.06574D0,
58891 & 0.98622D0, 0.77102D0, 0.59540D0, 0.50826D0, 0.45260D0,
58892 & 0.41278D0, 0.35791D0, 0.30610D0, 0.25436D0, 0.22147D0,
58893 & 0.17849D0, 0.14870D0, 0.12502D0, 0.10045D0, 0.07994D0,
58894 & 0.06271D0, 0.04847D0, 0.03689D0, 0.02761D0, 0.02033D0,
58895 & 0.01477D0, 0.01056D0, 0.00749D0, 0.00523D0, 0.00359D0,
58896 & 0.00243D0, 0.00165D0, 0.00112D0, 0.00070D0, 0.00047D0,
58897 & 0.00031D0, 0.00018D0, 0.00012D0, 0.00004D0, 0.00002D0,
58898 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58899 DATA (FMRS(2,8,I,20),I=1,49)/
58900 & 5.00899D0, 3.97007D0, 3.14567D0, 2.74457D0, 2.49097D0,
58901 & 2.31023D0, 1.82640D0, 1.44029D0, 1.25101D0, 1.13051D0,
58902 & 1.04327D0, 0.80852D0, 0.61869D0, 0.52527D0, 0.46592D0,
58903 & 0.42363D0, 0.36563D0, 0.31116D0, 0.25711D0, 0.22294D0,
58904 & 0.17857D0, 0.14803D0, 0.12392D0, 0.09909D0, 0.07852D0,
58905 & 0.06137D0, 0.04727D0, 0.03584D0, 0.02676D0, 0.01965D0,
58906 & 0.01424D0, 0.01018D0, 0.00720D0, 0.00501D0, 0.00343D0,
58907 & 0.00232D0, 0.00157D0, 0.00107D0, 0.00066D0, 0.00045D0,
58908 & 0.00029D0, 0.00018D0, 0.00012D0, 0.00004D0, 0.00001D0,
58909 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58910 DATA (FMRS(2,8,I,21),I=1,49)/
58911 & 5.51448D0, 4.34048D0, 3.41543D0, 2.96790D0, 2.68596D0,
58912 & 2.48552D0, 1.95141D0, 1.52811D0, 1.32176D0, 1.19083D0,
58913 & 1.09623D0, 0.84295D0, 0.63982D0, 0.54059D0, 0.47785D0,
58914 & 0.43329D0, 0.37244D0, 0.31558D0, 0.25945D0, 0.22413D0,
58915 & 0.17852D0, 0.14733D0, 0.12285D0, 0.09781D0, 0.07721D0,
58916 & 0.06012D0, 0.04616D0, 0.03490D0, 0.02597D0, 0.01904D0,
58917 & 0.01376D0, 0.00981D0, 0.00692D0, 0.00481D0, 0.00330D0,
58918 & 0.00222D0, 0.00150D0, 0.00102D0, 0.00064D0, 0.00042D0,
58919 & 0.00028D0, 0.00017D0, 0.00011D0, 0.00004D0, 0.00001D0,
58920 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58921 DATA (FMRS(2,8,I,22),I=1,49)/
58922 & 6.21231D0, 4.84766D0, 3.78177D0, 3.26973D0, 2.94855D0,
58923 & 2.72097D0, 2.11789D0, 1.64406D0, 1.41467D0, 1.26974D0,
58924 & 1.16528D0, 0.88741D0, 0.66681D0, 0.56001D0, 0.49289D0,
58925 & 0.44543D0, 0.38094D0, 0.32104D0, 0.26228D0, 0.22553D0,
58926 & 0.17838D0, 0.14638D0, 0.12146D0, 0.09617D0, 0.07554D0,
58927 & 0.05855D0, 0.04477D0, 0.03372D0, 0.02502D0, 0.01828D0,
58928 & 0.01316D0, 0.00936D0, 0.00658D0, 0.00457D0, 0.00313D0,
58929 & 0.00210D0, 0.00142D0, 0.00097D0, 0.00060D0, 0.00039D0,
58930 & 0.00026D0, 0.00016D0, 0.00010D0, 0.00004D0, 0.00001D0,
58931 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58932 DATA (FMRS(2,8,I,23),I=1,49)/
58933 & 6.92819D0, 5.36347D0, 4.15110D0, 3.57245D0, 3.21096D0,
58934 & 2.95557D0, 2.28227D0, 1.75749D0, 1.50504D0, 1.34618D0,
58935 & 1.23195D0, 0.92986D0, 0.69228D0, 0.57821D0, 0.50690D0,
58936 & 0.45669D0, 0.38876D0, 0.32601D0, 0.26481D0, 0.22674D0,
58937 & 0.17816D0, 0.14541D0, 0.12011D0, 0.09461D0, 0.07396D0,
58938 & 0.05707D0, 0.04348D0, 0.03263D0, 0.02417D0, 0.01758D0,
58939 & 0.01264D0, 0.00894D0, 0.00628D0, 0.00436D0, 0.00298D0,
58940 & 0.00199D0, 0.00135D0, 0.00091D0, 0.00057D0, 0.00037D0,
58941 & 0.00024D0, 0.00015D0, 0.00010D0, 0.00004D0, 0.00001D0,
58942 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58943 DATA (FMRS(2,8,I,24),I=1,49)/
58944 & 7.64199D0, 5.87362D0, 4.51337D0, 3.86793D0, 3.46620D0,
58945 & 3.18314D0, 2.44035D0, 1.86558D0, 1.59069D0, 1.41834D0,
58946 & 1.29468D0, 0.96937D0, 0.71569D0, 0.59480D0, 0.51959D0,
58947 & 0.46683D0, 0.39572D0, 0.33035D0, 0.26693D0, 0.22767D0,
58948 & 0.17780D0, 0.14441D0, 0.11876D0, 0.09309D0, 0.07246D0,
58949 & 0.05571D0, 0.04226D0, 0.03164D0, 0.02333D0, 0.01693D0,
58950 & 0.01213D0, 0.00857D0, 0.00600D0, 0.00415D0, 0.00282D0,
58951 & 0.00189D0, 0.00128D0, 0.00086D0, 0.00054D0, 0.00035D0,
58952 & 0.00022D0, 0.00014D0, 0.00009D0, 0.00003D0, 0.00001D0,
58953 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58954 DATA (FMRS(2,8,I,25),I=1,49)/
58955 & 8.41285D0, 6.42055D0, 4.89893D0, 4.18106D0, 3.73585D0,
58956 & 3.42298D0, 2.60571D0, 1.97779D0, 1.67919D0, 1.49264D0,
58957 & 1.35909D0, 1.00958D0, 0.73928D0, 0.61142D0, 0.53225D0,
58958 & 0.47690D0, 0.40260D0, 0.33461D0, 0.26898D0, 0.22853D0,
58959 & 0.17741D0, 0.14339D0, 0.11741D0, 0.09159D0, 0.07099D0,
58960 & 0.05437D0, 0.04108D0, 0.03067D0, 0.02252D0, 0.01631D0,
58961 & 0.01165D0, 0.00822D0, 0.00574D0, 0.00396D0, 0.00268D0,
58962 & 0.00180D0, 0.00120D0, 0.00081D0, 0.00050D0, 0.00033D0,
58963 & 0.00021D0, 0.00013D0, 0.00008D0, 0.00003D0, 0.00001D0,
58964 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58965 DATA (FMRS(2,8,I,26),I=1,49)/
58966 & 9.21054D0, 6.98238D0, 5.29207D0, 4.49895D0, 4.00873D0,
58967 & 3.66510D0, 2.77134D0, 2.08927D0, 1.76669D0, 1.56583D0,
58968 & 1.42235D0, 1.04868D0, 0.76198D0, 0.62728D0, 0.54426D0,
58969 & 0.48640D0, 0.40901D0, 0.33853D0, 0.27078D0, 0.22922D0,
58970 & 0.17691D0, 0.14232D0, 0.11604D0, 0.09010D0, 0.06954D0,
58971 & 0.05305D0, 0.03996D0, 0.02972D0, 0.02176D0, 0.01572D0,
58972 & 0.01122D0, 0.00790D0, 0.00548D0, 0.00378D0, 0.00255D0,
58973 & 0.00171D0, 0.00115D0, 0.00078D0, 0.00048D0, 0.00031D0,
58974 & 0.00020D0, 0.00012D0, 0.00008D0, 0.00002D0, 0.00001D0,
58975 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58976 DATA (FMRS(2,8,I,27),I=1,49)/
58977 & 10.01421D0, 7.54466D0, 5.68289D0, 4.81371D0, 4.27818D0,
58978 & 3.90363D0, 2.93340D0, 2.19757D0, 1.85131D0, 1.63639D0,
58979 & 1.48318D0, 1.08596D0, 0.78341D0, 0.64217D0, 0.55547D0,
58980 & 0.49525D0, 0.41494D0, 0.34210D0, 0.27239D0, 0.22977D0,
58981 & 0.17638D0, 0.14126D0, 0.11473D0, 0.08869D0, 0.06818D0,
58982 & 0.05182D0, 0.03892D0, 0.02884D0, 0.02107D0, 0.01518D0,
58983 & 0.01082D0, 0.00760D0, 0.00526D0, 0.00363D0, 0.00244D0,
58984 & 0.00163D0, 0.00110D0, 0.00075D0, 0.00046D0, 0.00030D0,
58985 & 0.00019D0, 0.00012D0, 0.00007D0, 0.00002D0, 0.00001D0,
58986 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58987 DATA (FMRS(2,8,I,28),I=1,49)/
58988 & 10.81038D0, 8.09822D0, 6.06522D0, 5.12048D0, 4.54007D0,
58989 & 4.13500D0, 3.08954D0, 2.30121D0, 1.93196D0, 1.70343D0,
58990 & 1.54082D0, 1.12100D0, 0.80336D0, 0.65594D0, 0.56579D0,
58991 & 0.50334D0, 0.42032D0, 0.34528D0, 0.27377D0, 0.23019D0,
58992 & 0.17582D0, 0.14022D0, 0.11347D0, 0.08735D0, 0.06690D0,
58993 & 0.05067D0, 0.03795D0, 0.02804D0, 0.02043D0, 0.01468D0,
58994 & 0.01043D0, 0.00733D0, 0.00506D0, 0.00348D0, 0.00235D0,
58995 & 0.00155D0, 0.00105D0, 0.00071D0, 0.00043D0, 0.00029D0,
58996 & 0.00018D0, 0.00011D0, 0.00007D0, 0.00002D0, 0.00001D0,
58997 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
58998 DATA (FMRS(2,8,I,29),I=1,49)/
58999 & 11.65265D0, 8.68040D0, 6.46494D0, 5.44008D0, 4.81224D0,
59000 & 4.37498D0, 3.25050D0, 2.40736D0, 2.01424D0, 1.77163D0,
59001 & 1.59933D0, 1.15629D0, 0.82328D0, 0.66961D0, 0.57598D0,
59002 & 0.51130D0, 0.42557D0, 0.34836D0, 0.27505D0, 0.23054D0,
59003 & 0.17519D0, 0.13914D0, 0.11219D0, 0.08600D0, 0.06563D0,
59004 & 0.04954D0, 0.03699D0, 0.02726D0, 0.01981D0, 0.01419D0,
59005 & 0.01006D0, 0.00705D0, 0.00487D0, 0.00334D0, 0.00225D0,
59006 & 0.00148D0, 0.00100D0, 0.00068D0, 0.00041D0, 0.00027D0,
59007 & 0.00017D0, 0.00010D0, 0.00006D0, 0.00002D0, 0.00001D0,
59008 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
59009 DATA (FMRS(2,8,I,30),I=1,49)/
59010 & 12.51775D0, 9.27489D0, 6.87071D0, 5.76340D0, 5.08688D0,
59011 & 4.61667D0, 3.41161D0, 2.51293D0, 2.09575D0, 1.83900D0,
59012 & 1.65698D0, 1.19078D0, 0.84258D0, 0.68277D0, 0.58574D0,
59013 & 0.51889D0, 0.43052D0, 0.35121D0, 0.27618D0, 0.23078D0,
59014 & 0.17451D0, 0.13804D0, 0.11091D0, 0.08467D0, 0.06438D0,
59015 & 0.04844D0, 0.03605D0, 0.02651D0, 0.01920D0, 0.01373D0,
59016 & 0.00970D0, 0.00677D0, 0.00468D0, 0.00321D0, 0.00215D0,
59017 & 0.00142D0, 0.00096D0, 0.00064D0, 0.00040D0, 0.00026D0,
59018 & 0.00017D0, 0.00010D0, 0.00006D0, 0.00002D0, 0.00001D0,
59019 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
59020 DATA (FMRS(2,8,I,31),I=1,49)/
59021 & 13.38188D0, 9.86555D0, 7.27170D0, 6.08188D0, 5.35680D0,
59022 & 4.85378D0, 3.56878D0, 2.61532D0, 2.17453D0, 1.90394D0,
59023 & 1.71244D0, 1.22374D0, 0.86087D0, 0.69518D0, 0.59491D0,
59024 & 0.52599D0, 0.43513D0, 0.35383D0, 0.27719D0, 0.23095D0,
59025 & 0.17383D0, 0.13697D0, 0.10968D0, 0.08342D0, 0.06322D0,
59026 & 0.04742D0, 0.03518D0, 0.02580D0, 0.01865D0, 0.01331D0,
59027 & 0.00937D0, 0.00652D0, 0.00451D0, 0.00308D0, 0.00206D0,
59028 & 0.00136D0, 0.00092D0, 0.00061D0, 0.00038D0, 0.00024D0,
59029 & 0.00016D0, 0.00010D0, 0.00006D0, 0.00002D0, 0.00001D0,
59030 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
59031 DATA (FMRS(2,8,I,32),I=1,49)/
59032 & 14.22455D0, 10.43853D0, 7.65861D0, 6.38821D0, 5.61583D0,
59033 & 5.08091D0, 3.71848D0, 2.71227D0, 2.24884D0, 1.96503D0,
59034 & 1.76449D0, 1.25443D0, 0.87775D0, 0.70654D0, 0.60325D0,
59035 & 0.53242D0, 0.43925D0, 0.35613D0, 0.27800D0, 0.23100D0,
59036 & 0.17312D0, 0.13592D0, 0.10849D0, 0.08223D0, 0.06212D0,
59037 & 0.04645D0, 0.03438D0, 0.02514D0, 0.01814D0, 0.01292D0,
59038 & 0.00909D0, 0.00631D0, 0.00435D0, 0.00297D0, 0.00198D0,
59039 & 0.00130D0, 0.00088D0, 0.00059D0, 0.00036D0, 0.00023D0,
59040 & 0.00015D0, 0.00009D0, 0.00006D0, 0.00002D0, 0.00000D0,
59041 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
59042 DATA (FMRS(2,8,I,33),I=1,49)/
59043 & 15.12220D0, 11.04609D0, 8.06700D0, 6.71068D0, 5.88799D0,
59044 & 5.31921D0, 3.87481D0, 2.81304D0, 2.32586D0, 2.02823D0,
59045 & 1.81825D0, 1.28597D0, 0.89499D0, 0.71812D0, 0.61173D0,
59046 & 0.53894D0, 0.44342D0, 0.35844D0, 0.27882D0, 0.23104D0,
59047 & 0.17241D0, 0.13488D0, 0.10730D0, 0.08105D0, 0.06103D0,
59048 & 0.04549D0, 0.03359D0, 0.02450D0, 0.01765D0, 0.01253D0,
59049 & 0.00880D0, 0.00610D0, 0.00420D0, 0.00286D0, 0.00191D0,
59050 & 0.00125D0, 0.00083D0, 0.00057D0, 0.00034D0, 0.00022D0,
59051 & 0.00014D0, 0.00008D0, 0.00005D0, 0.00002D0, 0.00000D0,
59052 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
59053 DATA (FMRS(2,8,I,34),I=1,49)/
59054 & 16.02044D0, 11.65091D0, 8.47137D0, 7.02895D0, 6.15599D0,
59055 & 5.55343D0, 4.02757D0, 2.91088D0, 2.40036D0, 2.08916D0,
59056 & 1.86995D0, 1.31603D0, 0.91125D0, 0.72894D0, 0.61960D0,
59057 & 0.54494D0, 0.44718D0, 0.36046D0, 0.27943D0, 0.23094D0,
59058 & 0.17160D0, 0.13377D0, 0.10610D0, 0.07985D0, 0.05994D0,
59059 & 0.04455D0, 0.03282D0, 0.02388D0, 0.01715D0, 0.01216D0,
59060 & 0.00853D0, 0.00590D0, 0.00405D0, 0.00275D0, 0.00184D0,
59061 & 0.00120D0, 0.00080D0, 0.00054D0, 0.00033D0, 0.00021D0,
59062 & 0.00013D0, 0.00008D0, 0.00005D0, 0.00002D0, 0.00000D0,
59063 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
59064 DATA (FMRS(2,8,I,35),I=1,49)/
59065 & 16.92092D0, 12.25466D0, 8.87333D0, 7.34454D0, 6.42124D0,
59066 & 5.78493D0, 4.17791D0, 3.00675D0, 2.47316D0, 2.14860D0,
59067 & 1.92031D0, 1.34518D0, 0.92693D0, 0.73935D0, 0.62715D0,
59068 & 0.55068D0, 0.45078D0, 0.36238D0, 0.28002D0, 0.23083D0,
59069 & 0.17082D0, 0.13273D0, 0.10496D0, 0.07873D0, 0.05891D0,
59070 & 0.04367D0, 0.03209D0, 0.02331D0, 0.01669D0, 0.01182D0,
59071 & 0.00827D0, 0.00571D0, 0.00391D0, 0.00265D0, 0.00178D0,
59072 & 0.00117D0, 0.00077D0, 0.00052D0, 0.00031D0, 0.00020D0,
59073 & 0.00012D0, 0.00008D0, 0.00005D0, 0.00002D0, 0.00000D0,
59074 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
59075 DATA (FMRS(2,8,I,36),I=1,49)/
59076 & 17.79951D0, 12.84117D0, 9.26208D0, 7.64895D0, 6.67663D0,
59077 & 6.00749D0, 4.32176D0, 3.09803D0, 2.54226D0, 2.20489D0,
59078 & 1.96790D0, 1.37254D0, 0.94153D0, 0.74899D0, 0.63410D0,
59079 & 0.55594D0, 0.45404D0, 0.36409D0, 0.28048D0, 0.23067D0,
59080 & 0.17006D0, 0.13172D0, 0.10387D0, 0.07767D0, 0.05796D0,
59081 & 0.04286D0, 0.03142D0, 0.02277D0, 0.01627D0, 0.01150D0,
59082 & 0.00803D0, 0.00554D0, 0.00379D0, 0.00256D0, 0.00172D0,
59083 & 0.00113D0, 0.00074D0, 0.00050D0, 0.00030D0, 0.00019D0,
59084 & 0.00012D0, 0.00007D0, 0.00005D0, 0.00002D0, 0.00000D0,
59085 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
59086 DATA (FMRS(2,8,I,37),I=1,49)/
59087 & 18.71000D0, 13.44641D0, 9.66151D0, 7.96092D0, 6.93787D0,
59088 & 6.23483D0, 4.46802D0, 3.19039D0, 2.61196D0, 2.26153D0,
59089 & 2.01571D0, 1.39986D0, 0.95599D0, 0.75847D0, 0.64090D0,
59090 & 0.56106D0, 0.45717D0, 0.36568D0, 0.28085D0, 0.23044D0,
59091 & 0.16924D0, 0.13067D0, 0.10276D0, 0.07660D0, 0.05700D0,
59092 & 0.04204D0, 0.03075D0, 0.02224D0, 0.01586D0, 0.01118D0,
59093 & 0.00780D0, 0.00537D0, 0.00367D0, 0.00247D0, 0.00167D0,
59094 & 0.00108D0, 0.00071D0, 0.00047D0, 0.00029D0, 0.00018D0,
59095 & 0.00011D0, 0.00006D0, 0.00004D0, 0.00002D0, 0.00000D0,
59096 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
59097 DATA (FMRS(2,8,I,38),I=1,49)/
59098 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
59099 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
59100 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
59101 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
59102 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
59103 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
59104 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
59105 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
59106 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0,
59107 & 0.00000D0, 0.00000D0, 0.00000D0, 0.00000D0/
59110 *CMZ :- -27/07/99 13.33.03 by Mike Seymour
59111 *-- Author : Ian Knowles
59112 C-----------------------------------------------------------------------
59113 SUBROUTINE HWUDKL(ID,PMOM,DISP)
59114 C-----------------------------------------------------------------------
59115 C Given a real or virtual particle, flavour ID and 4-momentum PMOM,
59116 C returns DISP its distance travelled in mm.
59118 C Modified 16/01/01 by BRW to force particle on mass shell if
59119 C p^2-m^2 < 10^-10 GeV^2 (rounding errors)
59120 C-----------------------------------------------------------------------
59121 INCLUDE 'herwig65.inc'
59122 DOUBLE PRECISION HWRGEN,PMOM(4),DISP(4),PMOM2,SCALE,OFFSH
59125 PMOM2=(PMOM(4)+PMOM(3))*(PMOM(4)-PMOM(3))-PMOM(1)**2-PMOM(2)**2
59126 OFFSH=PMOM2-RMASS(ID)**2
59127 IF (OFFSH.LT.1D-10) OFFSH=ZERO
59128 SCALE=-GEV2MM*LOG(HWRGEN(0))/SQRT(OFFSH**2+(PMOM2/DKLTM(ID))**2)
59129 IF (ID.GT.197.AND.ID.LT.203) SCALE=SCALE*EXAG
59130 CALL HWVSCA(4,SCALE,PMOM,DISP)
59132 C-----------------------------------------------------------------------
59134 *CMZ :- -27/07/99 13.33.03 by Mike Seymour
59135 *-- Author : Ian Knowles
59136 C-----------------------------------------------------------------------
59138 C-----------------------------------------------------------------------
59139 C Sets up internal pointers based on the decay table in HWUDAT or as
59140 C supplied via HWIODK. Computes CoM momenta of two-body decay modes.
59141 C Particles with long lifetimes or no allowed decay (excepting light
59142 C b hadrons when CLEO/EURODEC decays requested) are set stable, else
59143 C calculate DKLTM(I) = mass/width ( = mass * lifetime/hbar).
59144 C Gives warnings if: a particle has no decay modes or antiparticle's
59145 C modes are not the charge conjugates of the particles.
59146 C (N.B. CP violation permits this).
59147 C-----------------------------------------------------------------------
59148 INCLUDE 'herwig65.inc'
59149 DOUBLE PRECISION HWUPCM,HWUAEM,HWUALF,BRSUM,EPS,SCALE,
59150 & BRTMP(NMXDKS),FN,X,W,Q,FAC
59151 INTEGER HWUANT,I,IDKY,LAST,LTMP(NMXMOD),J,L,K,M,N,INDX(NMXMOD),
59152 & IRES,IAPDG,IPART,LR,LP,KPRDLR
59153 LOGICAL BPDK,TOPDKS,MATCH(5),PMATCH(NMXMOD),IFGO
59154 CHARACTER*7 CVETO(2)
59156 EXTERNAL HWUPCM,HWUAEM,HWUALF,HWUANT
59157 PARAMETER(EPS=1.E-6)
59158 FN(X,Q,W)=X**4/(((X*X-Q*Q)**2+W*W*(X*X+Q*Q)-2.*W**4)
59159 & *SQRT(X**4+Q**4+W**4-2.*(X*X*Q*Q+X*X*W*W+Q*Q*W*W)))
59161 10 FORMAT(/10X,'Checking consistency of decay tables'/)
59163 C First zero arrays
59171 BPDK=BDECAY.NE.'HERW'
59173 C Search for next decaying particle type
59175 C Skip if particle is not recognised or already dealt with
59176 IF (IDKY.EQ.0.OR.IDKY.EQ.20) THEN
59178 40 FORMAT(1X,'Line ',I4,': decaying particle not recognised')
59181 IF (NMODES(IDKY).GT.0) GOTO 180
59182 C Check and include first decay mode, storing a copy
59183 CALL HWDCHK(IDKY,I,IFGO)
59189 BRTMP(1)=-BRFRAC(I)
59191 C Sets CMMOM(IDKY) = CoM momentum for first 2-body decay mode I (else 0)
59192 IF (NPRODS(I).EQ.2) CMMOM(I)=
59193 & HWUPCM(RMASS(IDKY),RMASS(IDKPRD(1,I)),RMASS(IDKPRD(2,I)))
59194 C Include any other decay modes of IDKY
59196 IF (IDK(J).EQ.IDKY) THEN
59197 C First see if it is a copy of the same decay channel
59198 IF ((IDKPRD(2,J).GE.1.AND.IDKPRD(2,J).LE.13).OR.
59199 & (IDKPRD(3,J).GE.1.AND.IDKPRD(3,J).LE.13)) THEN
59200 C Partonic respect order
59202 DO 50 K=1,NMODES(IDKY)
59203 IF (IDKPRD(1,L).EQ.IDKPRD(1,J).AND.
59204 & IDKPRD(2,L).EQ.IDKPRD(2,J).AND.
59205 & IDKPRD(3,L).EQ.IDKPRD(3,J).AND.
59206 & IDKPRD(4,L).EQ.IDKPRD(4,J).AND.
59207 & IDKPRD(5,L).EQ.IDKPRD(5,J)) GOTO 100
59210 C Allow for different order in matching
59212 DO 90 K=1,NMODES(IDKY)
59214 60 MATCH(M)=.FALSE.
59217 IF (.NOT.MATCH(N).AND.IDKPRD(N,L).EQ.IDKPRD(M,J)) THEN
59223 IF (MATCH(1).AND.MATCH(2).AND.MATCH(3).AND.
59224 & MATCH(4).AND.MATCH(5)) GOTO 100
59227 CALL HWDCHK(IDKY,J,IFGO)
59229 NMODES(IDKY)=NMODES(IDKY)+1
59230 IF (NMODES(IDKY).GT.NMXMOD) THEN
59231 CALL HWWARN('HWUDKS',100)
59235 BRSUM=BRSUM+BRFRAC(J)
59236 LTMP(NMODES(IDKY))=J
59237 BRTMP(NMODES(IDKY))=-BRFRAC(J)
59239 C Sets CMMOM(IDKY) = CoM momentum for next 2-body decay mode J (else 0)
59240 IF (NPRODS(J).EQ.2) CMMOM(J)=
59241 & HWUPCM(RMASS(IDKY),RMASS(IDKPRD(1,J)),RMASS(IDKPRD(2,J)))
59244 100 WRITE(6,110) L,J,BRFRAC(J),NME(J)
59245 BRSUM=BRSUM-BRFRAC(L)+BRFRAC(J)
59246 BRFRAC(L)=BRFRAC(J)
59247 BRTMP(L)=-BRFRAC(L)
59249 110 FORMAT(1X,'Line ',I4,' is the same as line ',I4/
59250 & 1X,'Take BR ',F5.3,' and ME code ',I3,' from second entry')
59252 C Set sum of branching ratios to 1. if necessary
59253 IF (ABS(BRSUM-1.).GT.EPS) THEN
59254 WRITE(6,130) RNAME(IDKY),BRSUM
59255 130 FORMAT(1X,A8,': BR sum =',F8.5)
59256 IF (ABS(BRSUM).LT.EPS) THEN
59258 140 FORMAT(1X,'Setting particle stable'/)
59262 150 FORMAT(1X,'Rescaling to 1'/)
59265 DO 160 J=1,NMODES(IDKY)
59266 BRFRAC(K)=SCALE*BRFRAC(K)
59270 C Sort branching ratios into descending order and rearrange pointers
59271 CALL HWUSOR(BRTMP,NMODES(IDKY),INDX,2)
59272 LSTRT(IDKY)=LTMP(INDX(1))
59273 LNEXT(LTMP(INDX(1)))=LTMP(INDX(1))
59274 DO 170 J=2,NMODES(IDKY)
59275 IF (ABS(BRFRAC(LTMP(INDX(J)))).LT.EPS) THEN
59279 170 LNEXT(LTMP(INDX(J-1)))=LTMP(INDX(J))
59280 175 LNEXT(LTMP(INDX(NMODES(IDKY))))=LTMP(INDX(NMODES(IDKY)))
59282 C If not a short lived particle with a decay mode then set stable
59284 IF (.NOT.RSTAB(I).AND.RLTIM(I).LT.PLTCUT.AND.
59285 & (NMODES(I).GT.0.OR.
59286 & (BPDK.AND.((I.GE.221.AND.I.LE.231).OR.
59287 & (I.GE.245.AND.I.LE.254))))) THEN
59288 DKLTM(I)=RLTIM(I)*RMASS(I)/HBAR
59293 C Set up DKLTM for light quarks
59295 DKLTM(I)=RMASS(I)**2/VMIN2
59296 200 DKLTM(I+6)=DKLTM(I)
59298 DKLTM(13)=RMASS(13)**2/VMIN2
59301 DKLTM(I)=RMASS(I)**2/VMIN2
59302 210 DKLTM(I+6)=DKLTM(I)
59303 C Set up DKLTM for weak bosons
59304 DKLTM(198)=RMASS(198)/GAMW
59305 DKLTM(199)=DKLTM(198)
59306 DKLTM(200)=RMASS(200)/GAMZ
59307 DKLTM(201)=RMASS(201)/GAMH
59308 DKLTM(202)=RMASS(202)/GAMZP
59309 C Set up DKTRM for massive quarks (plus check m_Q > M_W + m_q)
59310 FAC=SWEIN*(FOUR*RMASS(198))**2/HWUAEM(RMASS(198)**2)
59311 IF (.NOT.SUSYIN) THEN
59312 IF (RMASS(6).GT.RMASS(5)+RMASS(198)) THEN
59313 DKLTM(6)=FAC*FN(RMASS(6 ),RMASS(5 ),RMASS(198))
59314 & /(1-HWUALF(1,RMASS(6))*2*(2*PIFAC**2/3-5/2)/(3*PIFAC))
59317 WRITE(6,220) RNAME(6),RNAME(5),RNAME(198)
59320 IF (RMASS(209).GT.RMASS(4)+RMASS(198)) THEN
59321 DKLTM(209)=FAC*FN(RMASS(209),RMASS(4 ),RMASS(198))
59322 DKLTM(215)=DKLTM(209)
59324 WRITE(6,220) RNAME(209),RNAME(4),RNAME(198)
59326 IF (RMASS(210).GT.RMASS(209)+RMASS(198)) THEN
59327 DKLTM(210)=FAC*FN(RMASS(210),RMASS(209),RMASS(198))
59328 DKLTM(216)=DKLTM(210)
59330 WRITE(6,220) RNAME(210),RNAME(209),RNAME(198)
59332 IF (RMASS(211).GT.RMASS(6)+RMASS(198)) THEN
59333 DKLTM(211)=FAC*FN(RMASS(211),RMASS(6 ),RMASS(198))
59334 DKLTM(217)=DKLTM(211)
59336 WRITE(6,220) RNAME(211),RNAME(6),RNAME(198)
59338 IF (RMASS(212).GT.RMASS(211)+RMASS(198)) THEN
59339 DKLTM(212)=FAC*FN(RMASS(212),RMASS(211),RMASS(198))
59340 DKLTM(218)=DKLTM(212)
59342 WRITE(6,220) RNAME(212),RNAME(211),RNAME(198)
59344 220 FORMAT(1X,'W not real in the decay: ',A8,' --> ',A8,' + ',A8)
59345 C Now carry out diagnostic checks on decay table
59346 CALL HWDTOP(TOPDKS)
59348 IAPDG=ABS(IDPDG(IRES))
59349 C Do not check (di-)quarks, gauge bosons, higgses or special particles
59350 IF ((IAPDG.GE.1.AND.IAPDG.LE.9).OR.
59351 & (MOD(IAPDG/10,10).EQ.0.AND.MOD(IAPDG/1000,10).NE.0).OR.
59352 & (IAPDG.GE.21.AND.IAPDG.LE.26).OR.
59354 & (IAPDG.GE.35.AND.IAPDG.LE.37).OR.
59356 & IAPDG.EQ.98.OR.IAPDG.EQ.99) THEN
59358 C Ignore top hadrons if top decays
59359 ELSEIF(TOPDKS.AND.((IRES.GE.232.AND.IRES.LE.244).OR.
59360 & (IRES.GE.255.AND.IRES.LE.264))) THEN
59362 C Ignore particles not produced in cluster or particle decays
59363 ELSEIF(VTOCDK(IRES).AND.VTORDK(IRES)) THEN
59365 C Ignore B's if EURO or CLEO decay package used
59366 ELSEIF(((IRES.GE.221.AND.IRES.LE.223).OR.
59367 & (IRES.GE.245.AND.IRES.LE.247)).AND.BDECAY.NE.'HERW') THEN
59368 WRITE(6,320) BDECAY,RNAME(IRES)
59369 C Check decay modes exist for massive, short lived particles
59370 ELSEIF (NMODES(IRES).EQ.0.AND.RMASS(IRES).NE.ZERO.AND.
59371 & RLTIM(IRES).LT.PLTCUT) THEN
59372 IF (VTOCDK(IRES)) THEN
59377 IF (VTORDK(IRES)) THEN
59382 WRITE(6,330) RNAME(IRES),CVETO(1),CVETO(2)
59383 C ignore particles with no modes if massless or long lived
59384 ELSEIF (NMODES(IRES).EQ.0.AND.
59385 & (RMASS(IRES).EQ.ZERO.OR.RLTIM(IRES).GT.PLTCUT)) THEN
59387 ELSEIF (IDPDG(IRES).LT.0) THEN
59388 C Antiparticle: check decays are charge conjugates of particle decays
59389 CALL HWUIDT(1,-IDPDG(IRES),IPART,CDUM)
59390 IF (NMODES(IPART).EQ.0) THEN
59391 C Nothing to compare to
59392 WRITE(6,340) RNAME(IPART),RNAME(IRES)
59394 C First initialize particle matching array
59395 DO 230 I=1,NMODES(IPART)
59396 230 PMATCH(I)=.FALSE.
59397 C Loop through antiparticle decay modes
59399 DO 290 I=1,NMODES(IRES)
59400 C Search for conjugate mode allowing for different particle order
59402 DO 270 J=1,NMODES(IPART)
59403 IF (PMATCH(J)) GOTO 270
59405 240 MATCH(K)=.FALSE.
59407 KPRDLR=HWUANT(IDKPRD(K,LR))
59409 IF (.NOT.MATCH(L).AND.KPRDLR.EQ.IDKPRD(L,LP) ) THEN
59415 IF (MATCH(1).AND.MATCH(2).AND.MATCH(3).AND.
59416 & MATCH(4).AND.MATCH(5)) GOTO 280
59419 WRITE(6,350) LR,RNAME(IRES),(RNAME(IDKPRD(J,LR)),J=1,5)
59421 C Match found, check branching ratios and matrix element codes
59422 280 PMATCH(J)=.TRUE.
59423 IF (BRFRAC(LR).NE.BRFRAC(LP))
59424 & WRITE(6,360) LR,RNAME(IRES),(RNAME(IDKPRD(J,LR)),J=1,5),
59425 & BRFRAC(LR),BRFRAC(LP)
59426 IF (NME(LR).NE.NME(LP))
59427 & WRITE(6,370) LR,RNAME(IRES),(RNAME(IDKPRD(J,LR)),J=1,5),
59430 C Check for unmatched modes of particle conjugate to antiparticle
59432 DO 300 I=1,NMODES(IPART)
59433 IF (.NOT.PMATCH(I))
59434 & WRITE(6,350) LP,RNAME(IPART),(RNAME(IDKPRD(J,LP)),J=1,5)
59439 320 FORMAT(1X,A8,' decay package to be used for particle ',A8)
59440 330 FORMAT(1X,'No decay modes available for particle ',A8/
59441 & 1X,'Production in cluster decays ',A7,' and particle decays ',A7)
59442 340 FORMAT(1X,A8,' has no modes conjugate to those of ',A8)
59443 350 FORMAT(1X,'Line, ',I4,' decay: ',A8,' --> ',4(A8,1X),A8/
59444 & 1X,'A charge conjugate decay mode does not exist')
59445 360 FORMAT(1X,'Line, ',I4,' decay: ',A8,' --> ',4(A8,1X),A8/
59446 & 1X,'BR ',F5.3,' unequal to that of conjugate mode ',F5.3)
59447 370 FORMAT(1X,'Line, ',I4,' decay: ',A8,' --> ',4(A8,1X),A8/
59448 & 1X,'ME code ',I3,' unequal to that of conjugate mode ',I3)
59452 *CMZ :- -27/07/99 13.33.03 by Mike Seymour
59453 *-- Author : Ian Knowles, Bryan Webber & Kosuke Odagiri
59454 C-----------------------------------------------------------------------
59456 C-----------------------------------------------------------------------
59457 C Prints out particle properies/decay tables in a number of formats:
59458 C If (PRNDEF) ASCII to stout
59459 C If (PRNTEX) LaTeX to the file HW_decays.tex
59460 C Paper size and offsets as set in HWUEPR
59461 C Uses the package longtable.sty
59462 C Designed to be printed as landscape
59463 C If (PRNWEB) HTML to the file HW_decays/index.html
59464 C /PART0000001.html etc.
59465 C-----------------------------------------------------------------------
59466 INCLUDE 'herwig65.inc'
59467 INTEGER MMWIDE,MMLONG,MMHOFF,MMVOFF,IUNITT,IUNTW1,IUNTW2,I,NM,J,K,
59470 CHARACTER*2 ZZ,ACHRG
59471 CHARACTER*3 ASPIN(0:10)
59472 CHARACTER*6 BGCOLS(5),TBCOLS(3)
59473 CHARACTER*7 HWUNST,TMPNME
59474 CHARACTER*17 FNAMEP
59475 CHARACTER*33 FNAMEW
59476 COMMON/PAPER/MMWIDE,MMLONG,MMHOFF,MMVOFF
59478 SAVE BGCOLS,TBCOLS,ASPIN
59479 DATA BGCOLS/'ffffff','0000aa','aa0000','00aa00','aa00ff'/
59480 DATA TBCOLS/'ccccff','9966ff','ffff00'/
59481 DATA ASPIN/' 0 ','1/2',' 1 ','3/2',' 2 ','5/2',' 3 ','7/2',
59482 & ' 4 ','9/2',' 5 '/
59490 C Open and write out file header information for index file
59492 IF (NPRFMT.LE.1) THEN
59499 OPEN(IUNITT,STATUS='UNKNOWN',FILE='HW_decays.tex')
59500 IF (NPRFMT.LE.1) THEN
59501 WRITE(IUNITT,30) Z,Z,Z,MMWIDE,Z,MMLONG,Z,MMHOFF,Z,MMVOFF,
59502 & Z,Z,Z,Z,Z,ZZ,Z,Z,Z,Z,Z,Z,NRES,ZZ,Z,Z,ZZ,Z,Z
59504 WRITE(IUNITT,40) Z,Z,Z,MMLONG,Z,MMWIDE,Z,MMHOFF,Z,MMVOFF,
59505 & Z,Z,Z,Z,Z,Z,ZZ,Z,Z,Z,Z,Z,Z,NRES,ZZ,Z,Z,Z,ZZ,Z,Z
59509 OPEN(IUNTW1,STATUS='UNKNOWN',FILE='HW_decays/index.html')
59510 WRITE(IUNTW1,50) BGCOLS,TBCOLS,NRES,((TBCOLS(I),I=2,3),J=1,7)
59512 10 FORMAT(1H1//15X,'TABLE OF PROPERTIES OF',I4,' PARTICLES USED'/)
59513 20 FORMAT(1H1//30X,'TABLE OF PROPERTIES OF',I4,' PARTICLES USED'//
59514 & 5X,'Name IDPDG Mass Chg Spn Lifetime Modes ',
59515 & ' Branching fractions ME codes and decay products')
59516 30 FORMAT(A1,'documentclass{article}'/A1,'usepackage{longtable}'/
59517 & A1,'textwidth ',I4,'mm ',A1,'textheight ',I4,'mm'/
59518 & A1,'hoffset ',I4,'mm ',A1,'voffset ',I4,'mm'/
59519 & A1,'pagestyle{empty}'/A1,'begin{document}'/
59520 & A1,'begin{center}'/A1,'begin{longtable}{|r|c|r|r|r|r|r|r|}'/
59521 & A1,'hline'/'Id HW & Name & Id PDG & Mass & Charge & Spin ',
59522 & '& Lifetime & Modes ',A2/A1,'hline'/
59523 & A1,'endhead'/A1,'hline'/A1,'endfoot'/A1,'hline'/
59524 & A1,'multicolumn{8}{|c|}{HERWIG 6.5: Table of properties',
59525 & ' of the ',I3,' particles used} ',A2/A1,'hline',A1,'hline'/
59526 & 'Id HW & Name & Id PDG & Mass & Charge & Spin & ',
59527 & 'Lifetime & Modes ',A2/A1,'hline'/A1,'endfirsthead')
59528 40 FORMAT(A1,'documentclass{article}'/A1,'usepackage{longtable}'/
59529 & A1,'textwidth ',I4,'mm ',A1,'textheight ',I4,'mm'/
59530 & A1,'hoffset ',I4,'mm ',A1,'voffset ',I4,'mm'/
59531 & A1,'pagestyle{empty}'/A1,'begin{document}'/A1,'begin{center}'/
59532 & A1,'begin{longtable}{|r|c|r|r|r|r|r|r|c|r|ccccc|}'/
59533 & A1,'hline'/'Id HW & Name & Id PDG & Mass & Charge & Spin ',
59534 & '& Lifetime & Modes & B.R. & M.E. & ' /
59535 & A1,'multicolumn{5}{|c|}{Decay Products} ',A2/A1,'hline'/
59536 & A1,'endhead'/A1,'hline'/A1,'endfoot'/A1,'hline'/
59537 & A1,'multicolumn{15}{|c|}{HERWIG 6.5: Table of properties',
59538 & ' of the ',I3,' particles used} ',A2/A1,'hline',A1,'hline'/
59539 & 'Id HW & Name & Id PDG & Mass & Charge & Spin & ',
59540 & 'Lifetime & Modes & B.R. & M.E. & '/
59541 & A1,'multicolumn{5}{|c|}{Decay Products} ',A2/A1,'hline'/
59542 & A1,'endfirsthead')
59543 50 FORMAT('<!-- No Less productions -->'/'<HTML>'/'<HEAD>'/
59544 & '<TITLE>HERWIG 6.5 Particle Properties</TITLE>'/'</HEAD>'/
59545 & '<BODY BGCOLOR=#',A6,' TEXT=#',A6,' LINK=#',A6,
59546 & ' ALINK=#',A6,' VLINK=#',A6,'>'/'<CENTER>'/
59547 & '<TABLE ALIGN="CENTER" BGCOLOR=#',A6,'>',
59548 & '<TR>'/'<TH COLSPAN=8 BGCOLOR=#',A6,' ALIGN="CENTER">',
59549 & '<A HREF=="http://hepwww.rl.ac.uk/theory/seymour/herwig/">',
59550 & 'HERWIG 6.5:</A><FONT COLOR=#',A6,'> Table of properties of',
59551 & ' the ',I3,' particles used</FONT></TH>'/'<TR>'/'<TH></TH>'/
59552 & '<TH BGCOLOR=#',A6,'><FONT COLOR=#',A6,'>Name</FONT></TH>'/
59553 & '<TH BGCOLOR=#',A6,' ALIGN="CENTER"><FONT COLOR=#',A6,'>',
59554 & 'Id PDG</FONT></TH>'/
59555 & '<TH BGCOLOR=#',A6,'><FONT COLOR=#',A6,'>Mass</FONT></TH>'/
59556 & '<TH BGCOLOR=#',A6,'><FONT COLOR=#',A6,'>Charge</FONT></TH>'/
59557 & '<TH BGCOLOR=#',A6,'><FONT COLOR=#',A6,'>Spin</FONT></TH>'/
59558 & '<TH BGCOLOR=#',A6,'><FONT COLOR=#',A6,'>Lifetime</FONT></TH>'/
59559 & '<TH BGCOLOR=#',A6,'><FONT COLOR=#',A6,'>Modes</FONT></TH>'/
59561 C Loop through resonances
59563 C Skip particles that can't be produced or blank lines
59564 IF ((VTOCDK(I).AND.VTORDK(I)).OR.
59565 & (RNAME(I).EQ.' ')) GOTO 260
59566 C Open and write out header information for particle file
59569 WRITE(FNAMEP,'(A5,A7,A5)') 'PART_',TMPNME,'.html'
59570 WRITE(FNAMEW,'(A,A17)') 'HW_decays/',FNAMEP
59571 OPEN(IUNTW2,STATUS='UNKNOWN',FILE=FNAMEW)
59572 WRITE(IUNTW2,60) RNAME(I),BGCOLS
59573 WRITE(IUNTW2,70) TBCOLS,((TBCOLS(L),L=2,3),M=1,6)
59575 60 FORMAT('<!-- No Less productions -->'/'<HTML>'/'<HEAD>'/
59576 & '<TITLE>HERWIG 6.5: ',A8,' properties</TITLE>'/'</HEAD>'/
59577 & '<BODY BGCOLOR=#',A6,' TEXT=#',A6,' LINK=#',A6,
59578 & ' ALINK=#',A6,' VLINK=#',A6,'>'/'<CENTER>')
59579 70 FORMAT('<TABLE ALIGN="CENTER" BGCOLOR=#',A6,'>'/
59580 & '<TR>'/'<TH></TH>'/
59581 & '<TH BGCOLOR=#',A6,'><FONT COLOR=#',A6,'>Name</FONT></TH>'/
59582 & '<TH BGCOLOR=#',A6,' ALIGN="CENTER"><FONT COLOR=#',A6,
59583 & '>Id PDG</FONT></TH>'/
59584 & '<TH BGCOLOR=#',A6,'><FONT COLOR=#',A6,'>Mass</FONT></TH>'/
59585 & '<TH BGCOLOR=#',A6,'><FONT COLOR=#',A6,'>Charge</FONT></TH>'/
59586 & '<TH BGCOLOR=#',A6,'><FONT COLOR=#',A6,'>Spin</FONT></TH>'/
59587 & '<TH BGCOLOR=#',A6,'><FONT COLOR=#',A6,'>Lifetime</FONT></TH>'/
59588 & '<TH BGCOLOR=#',A6,'><FONT COLOR=#',A6,'>Modes</FONT></TH>'/
59590 C Trick to output charge in fractions for di/s - quarks
59591 IF ((I.GE. 1.AND.I.LE. 12).OR.(I.GE.109.AND.I.LE.120).OR.
59592 & (I.GE.209.AND.I.LE.218).OR.(I.GE.401.AND.I.LE.424)) THEN
59597 C Write out special particles with no decay modes
59598 IF (NMODES(I).EQ.0) THEN
59600 IF (NPRFMT.LE.1) THEN
59601 WRITE(6,80) I,RNAME(I),IDPDG(I),RMASS(I),ICHRG(I),
59602 & ASPIN(INT(TWO*RSPIN(I))),RLTIM(I),0
59604 WRITE(6,90) I,RNAME(I),IDPDG(I),RMASS(I),ICHRG(I),
59605 & ASPIN(INT(TWO*RSPIN(I))),RLTIM(I),0
59608 C Add particle to LaTeX file
59610 IF (NPRFMT.LE.1) THEN
59611 WRITE(IUNITT,100) Z,I,TXNAME(1,I),IDPDG(I),RMASS(I),
59612 & ICHRG(I),ACHRG,ASPIN(INT(TWO*RSPIN(I))),RLTIM(I),0,ZZ
59614 WRITE(IUNITT,110) Z,I,TXNAME(1,I),IDPDG(I),RMASS(I),
59615 & ICHRG(I),ACHRG,ASPIN(INT(TWO*RSPIN(I))),RLTIM(I),0,Z,ZZ
59619 C Add properties to Web index
59620 WRITE(IUNTW1,120) TBCOLS(2),TBCOLS(3),I,FNAMEP,TXNAME(2,I),
59621 & IDPDG(I),RMASS(I),ICHRG(I),ACHRG,
59622 & ASPIN(INT(TWO*RSPIN(I))),RLTIM(I),0
59623 C Add properties to Web particle file
59624 WRITE(IUNTW2,130) TBCOLS(2),TBCOLS(3),I,TXNAME(2,I),
59625 & IDPDG(I),RMASS(I),ICHRG(I),ACHRG,
59626 & ASPIN(INT(TWO*RSPIN(I))),RLTIM(I),0
59628 80 FORMAT(/1X,I3,1X,A8,' IDPDG=',I8,', M=',F8.3,', Q=',I2,', J=',
59629 & A3,', T=',1P,E9.3,',',I3,' Modes')
59630 90 FORMAT(/1X,I3,1X,A8,1X,I8,1X,F8.3,1X,I2,1X,A3,1X,1P,E9.3,1X,I3)
59631 100 FORMAT(A1,'hline',I4,' & ',A37,' & $',I8,'$ & ',F8.3,' & $',I2,
59632 & A2,'$ & ',A3,' & $',1P,E9.3,'$ & ',I3,' ',A2)
59633 110 FORMAT(A1,'cline{1-8}'/
59634 & I4,' & ',A37,' & $',I8,'$ & ',F8.3,' & $',I2,A2,'$ & ',A3,
59635 & ' & $',1P,E9.3,'$ & ',I3,' & ',A1,'multicolumn{7}{|c|}{} ',A2)
59637 & '<TD ALIGN="RIGHT" BGCOLOR=#',A6,'><FONT COLOR=#',A6,'>',I3,
59639 & '<TD ALIGN="CENTER"><A HREF="',A17,'">',A37,'</A></TD>'/
59640 & '<TD ALIGN="RIGHT">',I8,'</TD>'/
59641 & '<TD ALIGN="RIGHT">',F8.3,'</TD>'/
59642 & '<TD ALIGN="RIGHT">',I2,A2,'</TD>'/
59643 & '<TD ALIGN="RIGHT">',A3,'</TD>'/
59644 & '<TD ALIGN="RIGHT">',1P,E9.3,'</TD>'/
59645 & '<TD ALIGN="RIGHT">',I3,'</TD>'/'</TR>')
59647 & '<TD ALIGN="RIGHT" BGCOLOR=#',A6,'><FONT COLOR=#',A6,'>',I3,
59649 & '<TD ALIGN="CENTER">',A37,'</TD>'/
59650 & '<TD ALIGN="RIGHT">',I8,'</TD>'/
59651 & '<TD ALIGN="RIGHT">',F8.3,'</TD>'/
59652 & '<TD ALIGN="RIGHT">',I2,A2,'</TD>'/
59653 & '<TD ALIGN="RIGHT">',A3,'</TD>'/
59654 & '<TD ALIGN="RIGHT">',1P,E9.3,'</TD>'/
59655 & '<TD ALIGN="RIGHT">',I3,'</TD>'/'</TR>'/'</TABLE>'/'<P>')
59657 C Particle with decay modes
59660 ELSEIF (VTOCDK(I)) THEN
59666 C Write out properties and first decay mode
59668 IF (NPRFMT.LE.1) THEN
59669 WRITE(6, 80) I,RNAME(I),IDPDG(I),RMASS(I),ICHRG(I),
59670 & ASPIN(INT(TWO*RSPIN(I))),RLTIM(I),NM
59671 WRITE(6,140) (RNAME(IDKPRD(L,K)),L=1,5),BRFRAC(K),NME(K)
59673 WRITE(6,150) I,RNAME(I),IDPDG(I),RMASS(I),ICHRG(I),
59674 & ASPIN(INT(TWO*RSPIN(I))),RLTIM(I),NM,BRFRAC(K),NME(K),
59675 & (RNAME(IDKPRD(L,K)),L=1,5)
59679 IF (NPRFMT.LE.1) THEN
59680 WRITE(IUNITT,160) Z,I,TXNAME(1,I),IDPDG(I),RMASS(I),
59681 & ICHRG(I),ACHRG,ASPIN(INT(TWO*RSPIN(I))),RLTIM(I),NM,ZZ,Z
59682 WRITE(IUNITT,170) Z,Z,(TXNAME(1,IDKPRD(L,K)),L=1,5),Z,
59683 & BRFRAC(K),Z,NME(K),ZZ
59685 WRITE(IUNITT,180) Z,I,TXNAME(1,I),IDPDG(I),RMASS(I),
59686 & ICHRG(I),ACHRG,ASPIN(INT(TWO*RSPIN(I))),RLTIM(I),NM,
59687 & BRFRAC(K),NME(K),(TXNAME(1,IDKPRD(L,K)),L=1,5),ZZ,Z
59691 C Add properties to index
59692 WRITE(IUNTW1,120) TBCOLS(2),TBCOLS(3),I,FNAMEP,TXNAME(2,I),
59693 & IDPDG(I),RMASS(I),ICHRG(I),ACHRG,ASPIN(INT(TWO*RSPIN(I))),
59695 C Add properties to Web particle file
59696 WRITE(IUNTW2,130) TBCOLS(2),TBCOLS(3),I,TXNAME(2,I),IDPDG(I),
59697 & RMASS(I),ICHRG(I),ACHRG,ASPIN(INT(TWO*RSPIN(I))),RLTIM(I),NM
59698 WRITE(IUNTW2,190) TBCOLS,TXNAME(2,I),
59699 & ((TBCOLS(L),L=2,3),M=1,3)
59700 WRITE(IUNTW2,200) TBCOLS(2),TBCOLS(3),1,BRFRAC(K),NME(K),
59701 & (TXNAME(2,IDKPRD(L,K)),L=1,5)
59703 140 FORMAT(5X,'BR[ -->',5(1X,A8),']=',F5.3,', ME code',I5)
59704 150 FORMAT(/1X,I3,1X,A8,1X,I8,1X,F8.3,1X,I2,1X,A3,1X,1P,E9.3,1X,I3,
59705 & 2X,F5.3,1X,I3,5(1X,A8))
59706 160 FORMAT(A1,'hline',
59707 & I4,' & ',A37,' & $',I8,'$ & ',F8.3,' & $',I2,A2,'$ & ',
59708 & A3,' & $',1P,E9.3,'$ & ',I3,' ',A2/A1,'cline{2-8}')
59709 170 FORMAT(' & & ',A1,'multicolumn{2}{l}{$',A1,'longrightarrow$'/
59710 & 5(A37,' '),'}'/' & ',A1,'multicolumn{2}{l}{BR = ',F5.3,'} & ',
59711 & A1,'multicolumn{2}{l|}{ME code = ',I3,'} ',A2)
59712 180 FORMAT(A1,'hline'/
59713 & I4,' & ',A37,' & $',I8,'$ & ',F8.3,' & $',I2,A2,'$ & ',
59714 & A3,' & $',1P,E9.3,'$ & ',I3,' & ',F5.3,' & ',I3,
59715 & 5(' & ',A37), ' ',A2/A1,'cline{2-8}')
59716 190 FORMAT('<TABLE ALIGN="CENTER" BGCOLOR=#',A6,'>'/'<TR>'/
59717 & '<TH COLSPAN=8 BGCOLOR=#',A6,'><FONT COLOR=#',A6,'>',A37,
59718 & ' Decay Modes</FONT></TH>'/'</TR>'/'<TR>'/'<TH></TH>',
59719 & '<TH BGCOLOR=#',A6,'><FONT COLOR=#',A6,'>B.R.</FONT></TH>'/
59720 & '<TH BGCOLOR=#',A6,'><FONT COLOR=#',A6,'>M.E.</FONT></TH>'/
59721 & '<TH BGCOLOR=#',A6,' ALIGN="CENTER" COLSPAN=5>',
59722 & '<FONT COLOR=#',A6,'>Decay products</FONT></TH>'/'</TR>')
59724 & '<TD ALIGN="RIGHT" BGCOLOR=#',A6,'><FONT COLOR=#',A6,'>',
59725 & I3,'</FONT></TD>'/
59726 & '<TD ALIGN="RIGHT">',F5.3,'</TD>'/
59727 & '<TD ALIGN="RIGHT">',I3,'</TD>'/
59728 & 5('<TD ALIGN="CENTER">',A37,'</TD>'/),'</TR>')
59729 C Write out additional decay modes
59730 IF (NMODES(I).GE.2) THEN
59731 DO 210 J=2,NMODES(I)
59734 IF (NPRFMT.LE.1) THEN
59735 WRITE(6,140) (RNAME(IDKPRD(L,K)),L=1,5),BRFRAC(K),NME(K)
59737 WRITE(6,220) BRFRAC(K),NME(K),(RNAME(IDKPRD(L,K)),L=1,5)
59741 IF (NPRFMT.LE.1) THEN
59742 WRITE(IUNITT,170) Z,Z,(TXNAME(1,IDKPRD(L,K)),L=1,5),Z,
59743 & BRFRAC(K),Z,NME(K),ZZ
59745 WRITE(IUNITT,230) Z,BRFRAC(K),NME(K),
59746 & (TXNAME(1,IDKPRD(L,K)),L=1,5),ZZ
59749 IF (PRNWEB) WRITE(IUNTW2,200) TBCOLS(2),TBCOLS(3),J,
59750 & BRFRAC(K),NME(K),(TXNAME(2,IDKPRD(L,K)),L=1,5)
59752 IF (PRNTEX.AND.NPRFMT.EQ.2.AND.NMODES(I+1).EQ.0)
59753 & WRITE(IUNITT,240) Z
59754 220 FORMAT(54X,F5.3,1X,I3,5(1X,A8))
59755 230 FORMAT(' & ',A1,'multicolumn{7}{|c|}{} & ',F5.3,' & ',I3,
59756 & 5(' & ',A37),' ',A2)
59757 240 FORMAT(A1,'hline')
59760 C Close Web particle file
59765 250 FORMAT('</TABLE>'/'</CENTER>'/'<P>'/
59766 & 'Main particle <A HREF="index.html">index</A>'/
59767 & '</BODY>'/'</HTML>')
59769 C Close the LaTeX file
59771 WRITE(IUNITT,270) Z,Z,Z
59774 C Close the index file
59779 270 FORMAT(A1,'end{longtable}'/A1,'end{center}'/A1,'end{document}')
59780 280 FORMAT('</TABLE>'/'</CENTER>'/'</BODY>'/'</HTML>')
59783 *CMZ :- -29/01/93 11.11.55 by Bryan Webber
59784 *-- Author : Giovanni Abbiendi & Luca Stanco
59785 C---------------------------------------------------------------------
59786 FUNCTION HWUECM (S,M1QUAD,M2QUAD)
59787 C-----------------------------------------------------------------------
59788 C C.M. ENERGY OF A PARTICLE IN 1-->2 BRANCH, MAY BE SPACELIKE
59789 C---------------------------------------------------------------------
59791 DOUBLE PRECISION HWUECM,S,M1QUAD,M2QUAD
59792 HWUECM = (S+M1QUAD-M2QUAD)/(2.D0*SQRT(S))
59795 *CMZ :- -09/12/91 12.07.08 by Mike Seymour
59796 *-- Author : Mike Seymour
59797 C-----------------------------------------------------------------------
59798 SUBROUTINE HWUEDT(N,IEDT)
59799 C-----------------------------------------------------------------------
59800 C EDIT THE EVENT RECORD
59801 C IF N>0 DELETE THE N ENTRIES IN IEDT FROM EVENT RECORD
59802 C IF N<0 INSERT LINES AFTER THE -N ENTRIES IN IEDT
59803 C-----------------------------------------------------------------------
59804 INCLUDE 'herwig65.inc'
59805 INTEGER N,IEDT(*),IMAP(0:NMXHEP),IHEP,I,J,I1,I2
59806 COMMON /HWUMAP/IMAP
59807 C---MOVE ENTRIES AND CALCULATE MAPPING OF POINTERS
59810 ELSEIF (N.GT.0) THEN
59819 DO 110 IHEP=I1,I2,SIGN(1,I2-I1)
59822 IF (IHEP.EQ.IEDT(J)) THEN
59823 IF (N.GT.0) IMAP(IHEP)=0
59825 IF (N.LT.0) IMAP(IHEP)=I
59828 IF (IMAP(IHEP).EQ.I .AND. IHEP.NE.I) THEN
59829 ISTHEP(I)=ISTHEP(IHEP)
59831 IDHEP(I)=IDHEP(IHEP)
59832 JMOHEP(1,I)=JMOHEP(1,IHEP)
59833 JMOHEP(2,I)=JMOHEP(2,IHEP)
59834 JDAHEP(1,I)=JDAHEP(1,IHEP)
59835 JDAHEP(2,I)=JDAHEP(2,IHEP)
59836 CALL HWVEQU(5,PHEP(1,IHEP),PHEP(1,I))
59837 CALL HWVEQU(4,VHEP(1,IHEP),VHEP(1,I))
59845 CALL HWVZRO(5,PHEP(1,IHEP))
59846 CALL HWVZRO(4,VHEP(1,IHEP))
59851 C---RELABEL POINTERS, SETTING ANY WHICH WERE TO DELETED ENTRIES TO ZERO
59854 JMOHEP(1,IHEP)=IMAP(JMOHEP(1,IHEP))
59855 JMOHEP(2,IHEP)=IMAP(JMOHEP(2,IHEP))
59856 JDAHEP(1,IHEP)=IMAP(JDAHEP(1,IHEP))
59857 JDAHEP(2,IHEP)=IMAP(JDAHEP(2,IHEP))
59861 *CMZ :- -26/04/91 14.22.30 by Federico Carminati
59862 *-- Author : Bryan Webber and Ian Knowles
59863 C-----------------------------------------------------------------------
59864 SUBROUTINE HWUEEC(IL)
59865 C-----------------------------------------------------------------------
59866 C Loads cross-section coefficients, for kinematically open channels,
59867 C in llbar-->qqbar; lepton label IL=1-6: e,nu_e,mu,nu_mu,tau,nu_tau.
59868 C-----------------------------------------------------------------------
59869 INCLUDE 'herwig65.inc'
59870 DOUBLE PRECISION Q2
59877 IF (EMSCA.GT.2.*RMASS(IQ)) THEN
59880 CALL HWUCFF(JL,IQ,Q2,CLQ(1,MAXFL))
59881 TQWT=TQWT+CLQ(1,MAXFL)
59884 IF (MAXFL.EQ.0) CALL HWWARN('HWUEEC',100)
59887 *CMZ :- -30/06/94 19.31.08 by Mike Seymour
59888 *-- Author : Mike Seymour
59889 C-----------------------------------------------------------------------
59890 SUBROUTINE HWUEMV(N,IFROM,ITO)
59891 C-----------------------------------------------------------------------
59892 C MOVE A BLOCK OF ENTRIES IN THE EVENT RECORD
59893 C N ENTRIES IN HEPEVT STARTING AT IFROM ARE MOVED TO AFTER ITO
59894 C-----------------------------------------------------------------------
59895 INCLUDE 'herwig65.inc'
59896 INTEGER N,IFROM,ITO,IMAP(0:NMXHEP),LFROM,LTO,I,IEDT(NMXHEP),IHEP,
59898 COMMON /HWUMAP/IMAP
59903 CALL HWUEDT(-N,IEDT)
59906 JHEP=IMAP(LFROM+I-1)
59907 ISTHEP(IHEP)=ISTHEP(JHEP)
59908 IDHW(IHEP)=IDHW(JHEP)
59909 IDHEP(IHEP)=IDHEP(JHEP)
59910 JMOHEP(1,IHEP)=JMOHEP(1,JHEP)
59911 JMOHEP(2,IHEP)=JMOHEP(2,JHEP)
59912 JDAHEP(1,IHEP)=JDAHEP(1,JHEP)
59913 JDAHEP(2,IHEP)=JDAHEP(2,JHEP)
59914 CALL HWVEQU(5,PHEP(1,JHEP),PHEP(1,IHEP))
59915 CALL HWVEQU(4,VHEP(1,JHEP),VHEP(1,IHEP))
59917 IF (JMOHEP(1,KHEP).EQ.JHEP) JMOHEP(1,KHEP)=IHEP
59918 IF (JMOHEP(2,KHEP).EQ.JHEP) JMOHEP(2,KHEP)=IHEP
59919 IF (JDAHEP(1,KHEP).EQ.JHEP) JDAHEP(1,KHEP)=IHEP
59920 IF (JDAHEP(2,KHEP).EQ.JHEP) JDAHEP(2,KHEP)=IHEP
59924 CALL HWUEDT(N,IEDT)
59927 *CMZ :- -27/07/99 13.33.03 by Mike Seymour
59928 *-- Author : Ian Knowles, Bryan Webber & Kosuke Odagiri
59929 C-----------------------------------------------------------------------
59931 C-----------------------------------------------------------------------
59932 C Prints out event data in a number of possible formats:
59933 C If (PRNDEF) ASCII to stout
59934 C If (PRNTEX) LaTeX to the file HWEV_*******.tex
59935 C Please check paper size and offsets given in mm
59936 C Uses the package longtable.sty
59937 C If (PRVTX>OR.NPRFMT.EQ.2) designed to be printed
59939 C If (PRNWEB) HTML to the file HWEV_*******.html
59940 C Call HWUDPR to create particle property files in
59941 C the subdirectory HW_decays/
59942 C ******* gives the event number 0000001 etc.
59943 C-----------------------------------------------------------------------
59944 INCLUDE 'herwig65.inc'
59945 INTEGER MMWIDE,MMLONG,MMHOFF,MMVOFF,I,IST,IS,ID,MS,J,K,IUNITW,
59949 CHARACTER*6 BGCOLS(5),TBCOLS(3),THEAD(17,3)
59950 CHARACTER*7 HWUNST,TMPNME
59951 CHARACTER*16 FNAMET
59952 CHARACTER*17 FNAMEW
59953 CHARACTER*27 FNAMEP
59954 CHARACTER*28 TITLE(11),SECTXT
59955 LOGICAL FIRST(11),NEWSEC
59956 COMMON/PAPER/MMWIDE,MMLONG,MMHOFF,MMVOFF
59959 SAVE BGCOLS,TBCOLS,THEAD,TITLE
59960 DATA BGCOLS/'ffffff','0000aa','aa0000','00aa00','aa00ff'/
59961 DATA TBCOLS/'ccccff','9966ff','ffff00'/
59962 DATA THEAD/ 17*'9966ff',17*'ffff00',
59963 & 'IHEP ',' ID ',' IDPDG',' IST ',' MO1 ',' MO2 ',
59964 & ' DA1 ',' DA2 ',' P-X ',' P-Y ',' P-Z ','ENERGY',
59965 & ' MASS ',' V-X ',' V-Y ',' V-Z ',' V-C*T'/
59966 DATA TITLE/' ---INITIAL STATE--- ',
59967 & ' ---HARD SUBPROCESS--- ',
59968 & ' ---PARTON SHOWERS--- ',
59969 & ' ---GLUON SPLITTING--- ',
59970 & ' ---CLUSTER FORMATION--- ',
59971 & ' ---CLUSTER DECAYS--- ',
59972 & ' ---STRONG HADRON DECAYS--- ',
59973 & ' ---HEAVY PARTICLE DECAYS---',
59974 & ' ---H/W/Z BOSON DECAYS--- ',
59975 & ' ---SOFT UNDERLYING EVENT---',
59976 & ' ---MULTIPLE SCATTERING--- '/
59982 C Write out any required file header information
59983 TMPNME=HWUNST(NEVHEP)
59985 WRITE(FNAMET,'(A5,A7,A4)') 'HWEV_',TMPNME,'.tex'
59986 OPEN(IUNITT,STATUS='UNKNOWN',FILE=FNAMET)
59987 IF (PRVTX.OR.NPRFMT.EQ.2) THEN
59988 WRITE(IUNITT,10) Z,Z,Z,MMLONG,Z,MMWIDE,Z,MMVOFF,Z,MMHOFF,Z,Z,Z
59990 WRITE(IUNITT,10) Z,Z,Z,MMWIDE,Z,MMLONG,Z,MMHOFF,Z,MMVOFF,Z,Z,Z
59994 WRITE(FNAMEW,'(A5,A7,A5)') 'HWEV_',TMPNME,'.html'
59995 OPEN(IUNITW,STATUS='UNKNOWN',FILE=FNAMEW)
59996 WRITE(IUNITW,20) BGCOLS
59998 10 FORMAT(A1,'documentclass{article}'/A1,'usepackage{longtable}'/
59999 & A1,'textwidth ',I4,'mm ',A1,'textheight ',I4,'mm'/
60000 & A1,'hoffset ',I4,'mm ',A1,'voffset ',I4,'mm'/
60001 & A1,'pagestyle{empty}'/A1,'begin{document}'/A1,'begin{center}')
60002 20 FORMAT('<!-- No Less productions -->'/'<HTML>'/'<HEAD>'/
60003 & '<TITLE>HERWIG Event Record</TITLE>'/'</HEAD>'/
60004 & '<BODY BGCOLOR=#',A6,' TEXT=#',A6,' LINK=#',A6,
60005 & ' ALINK=#',A6,' VLINK=#',A6,'>')
60006 C Write out event header details and set up tables
60008 WRITE(6,30) NEVHEP,PBEAM1,PART1,PBEAM2,PART2,
60009 & IPROC,NRN,ISTAT,IERROR,EVWGT
60012 WRITE(IUNITT,40) Z,Z,Z,ISTAT,ZZ,Z,
60013 & IPROC,PBEAM1,PBEAM2,NRN(1),
60014 & IERROR,ZZ,Z,Z,NEVHEP,TXNAME(1,IDHW(1)),TXNAME(1,IDHW(2)),
60015 & NRN(2),EVWGT,ZZ,Z,Z,Z
60017 WRITE(IUNITT,50) Z,Z,Z,Z,Z
60019 WRITE(IUNITT,60) Z,Z,Z,Z,Z
60023 WRITE(IUNITW,70) TBCOLS(1),TBCOLS(2),(TBCOLS(2),TBCOLS(3),
60024 & I=1,4),ISTAT,TBCOLS(2),TBCOLS(3),
60025 & IPROC,PBEAM1,PBEAM2,NRN(1),
60026 & TBCOLS(2),TBCOLS(3),IERROR
60027 WRITE(IUNITW,71) TBCOLS(2),TBCOLS(3),NEVHEP,TXNAME(2,IDHW(1)),
60028 & TXNAME(2,IDHW(2)),NRN(2),TBCOLS(2),TBCOLS(3),EVWGT,TBCOLS(1)
60030 30 FORMAT(///1X,'EVENT ',I7,':',F8.2,' GEV/C ',A8,' ON ',F8.2,
60031 & ' GEV/C ',A8,' PROCESS:',I6/1X,'SEEDS: ',I11,' & ',I11,
60032 & ' STATUS: ',I4,' ERROR:',I4,' WEIGHT: ',1P,E11.4/)
60033 40 FORMAT(A1,'begin{tabular}{|l|r|c|c|r|l|c|}'/A1,'hline'/
60034 & A1,'multicolumn{2}{|c|}{HERWIG 6.5} & Beam 1: & Beam 2: & ',
60035 & 'Seeds: & Status: & ',I4, ' ',A2/A1,'hline'/'Process: & ',I6,
60036 & ' & ',F8.2,'~GeV/c & ',F8.2,'~GeV/c',' & ',I11,' & Error: & ',
60037 & I4,' ',A2/A1,'cline{1-2} ',A1,'cline{6-7}'/'Event: & ',I7,' & ',
60038 & A37,' & ',A37,' & ',I11,' & Weight: & ',1P,E11.4,' ',A2/A1,
60039 & 'hline'/A1,'end{tabular}'/A1,'vskip 5mm')
60040 50 FORMAT(A1,'begin{longtable}{|r|c|r|r|r|r|r|r|r|r|r|r|r|r|r|r|r|}'/
60041 & A1,'hline'/A1,'endhead'/A1,'hline'/A1,'endfoot')
60042 60 FORMAT(A1,'begin{longtable}{|r|c|r|r|r|r|r|r|r|r|r|r|r|}'/
60043 & A1,'hline'/A1,'endhead'/A1,'hline'/A1,'endfoot')
60044 70 FORMAT(/'<CENTER>'/'<TABLE ALIGN="CENTER" BGCOLOR=#',A6,'>'/
60045 & '<TR>'/'<TH BGCOLOR=#',A6,' COLSPAN=2>',
60046 & '<A HREF="http://hepwww.rl.ac.uk/theory/seymour/herwig/">',
60047 & 'HERWIG 6.5</A></TH>'/
60048 & '<TH BGCOLOR=#',A6,'><FONT COLOR=#',A6,'>Beam 1:</FONT></TH>'/
60049 & '<TH BGCOLOR=#',A6,'><FONT COLOR=#',A6,'>Beam 2:</FONT></TH>'/
60050 & '<TH BGCOLOR=#',A6,'><FONT COLOR=#',A6,'>Seeds:</FONT></TH>'/
60051 & '<TH BGCOLOR=#',A6,' ALIGN="LEFTT"><FONT COLOR=#',A6,
60052 & '>Status:</FONT></TH>'/'<TD ALIGN="RIGHT">',I4,'</TD>'/'</TR>'/
60054 & '<TH BGCOLOR=#',A6,' ALIGN="LEFTT"><FONT COLOR=#',A6,
60055 & '>Process:</Th>'/'<TD>',I6,'</TD>'/
60056 & '<TD>',F8.2,' GeV/c</TD>'/'<TD>',F8.2,' GeV/c</TD>'/
60057 & '<TD ALIGN="RIGHT">',I11,'</TD>'/
60058 & '<TH BGCOLOR=#',A6,' ALIGN="LEFT"><FONT COLOR=#',A6,
60059 & '>Error:</FONT></TH>'/'<TD ALIGN="RIGHT">',I4,'</TD>'/'</TR>')
60061 & '<TH BGCOLOR=#',A6,' ALIGN="LEFT"><FONT COLOR=#',A6,
60062 & '>Event:</Th>'/'<TD ALIGN="RIGHT">',I7,'</TD>'/
60063 & '<TD ALIGN="CENTER">',A37,'</TD>'/
60064 & '<TD ALIGN="CENTER">',A37,'</TD>'/
60065 & '<TD ALIGN="RIGHT">',I11,'</TD>'/
60066 & '<TH BGCOLOR=#',A6,' ALIGN="LEFT"><FONT COLOR=#',A6,
60067 & '>Weight:</FONT></TH>'/'<TD>',1P,E11.4,'</TD>'/'</TR>'/
60068 & '</TABLE>'//'<P>'/
60069 & '<TABLE ALIGN="CENTER" BGCOLOR=#',A6,'>')
60070 C Initialize control flags
60073 C Loop through event record
60076 C First find start of new sections
60080 IF (IST.EQ.101) THEN
60083 ELSEIF (FIRST(2).AND.IS.EQ.12) THEN
60087 ELSEIF (FIRST(3).AND.IS.EQ.14) THEN
60094 ELSEIF (FIRST(4).AND.IST.GE.158.AND.IST.NE.160
60095 & .AND.IST.LE.162) THEN
60099 ELSEIF (FIRST(5).AND.(IS.EQ.16.OR.IS.EQ.18)
60100 & .AND.IST.GT.162) THEN
60104 ELSEIF (IS.EQ.19.OR.IST.EQ.1.OR.IST.EQ.200) THEN
60105 MS=ISTHEP(JMOHEP(1,I))/10
60106 IF (MS.EQ.15.OR.MS.EQ.16.OR.MS.EQ.18) THEN
60112 ELSEIF (FIRST(7).AND.(.NOT.FIRST(6))) THEN
60117 ELSEIF (FIRST(8).AND.(IST.EQ.125.OR.IST.EQ.155.OR.
60118 & (IST.EQ.123.AND.ISTHEP(JMOHEP(1,I)).EQ.199))) THEN
60127 ELSEIF (FIRST(9).AND.(IST.EQ.123.OR.IST.EQ.124)) THEN
60128 MS=ABS(IDHEP(JMOHEP(1,I)))
60129 IF (MS.EQ.23.OR.MS.EQ.24.OR.MS.EQ.25) THEN
60140 ELSEIF (IST.EQ.170) THEN
60146 ELSEIF (FIRST(11).AND.(ID.EQ.71.OR.ID.EQ.72)) THEN
60152 C Print out section heading
60156 IF (NPRFMT.EQ.1) THEN
60157 WRITE(6, 90) SECTXT,(THEAD(J,3),J=1,17)
60159 WRITE(6,100) SECTXT,(THEAD(J,3),J=1,17)
60162 IF (PRNTEX) WRITE(IUNITT,110) Z,Z,SECTXT,ZZ,Z,
60163 & (Z,THEAD(J,3),J=1,17),ZZ,Z
60164 IF (PRNWEB) WRITE(IUNITW,120) TBCOLS(2),TBCOLS(3),
60165 & SECTXT,((THEAD(K,J),J=1,3),K=1,17)
60166 90 FORMAT(/46X,A28//1X,A4,2X,A6,3X,A6,5A4,3(2X,A6),A6,3X,A5,
60168 100 FORMAT(/58X,A28//1X,A4,2X,A6,3X,A6,5A4,3(6X,A6),5X,A6,8X,A5,
60169 & 4X,A6,2(5X,A6),6X,A6)
60170 110 FORMAT(A1,'hline'/A1,'multicolumn{17}{|c|}{',A28,'} ',A2/A1,
60171 & 'hline'/16(A1,'multicolumn{1}{|c|}{',A6,'} & '),
60172 & A1,'multicolumn{1}{|c|}{',A6,'} ',A2/A1,'hline')
60173 120 FORMAT('<TR><TH COLSPAN=17 BGCOLOR=#',A6,'>',
60174 & '<FONT COLOR=#',A6,'>',A28,'</FONT></TH></TR>'/
60175 & '<TR>',17(/,1X,'<TH BGCOLOR=#',A6,'>
60176 & <FONT COLOR=',A6,'>',A6,'</FONT></TH>'),'</TR>')
60179 IF (NPRFMT.EQ.1) THEN
60180 WRITE(6,130) SECTXT,(THEAD(J,3),J=1,13)
60182 WRITE(6,140) SECTXT,(THEAD(J,3),J=1,13)
60185 IF (PRNTEX) WRITE(IUNITT,150) Z,Z,SECTXT,ZZ,Z,
60186 & (Z,THEAD(J,3),J=1,13),ZZ,Z
60187 IF (PRNWEB) WRITE(IUNITW,160) TBCOLS(2),TBCOLS(3),
60188 & SECTXT,((THEAD(K,J),J=1,3),K=1,13)
60189 130 FORMAT(/26X,A28//1X,A4,2X,A6,3X,A6,5A4,3(2X,A6),A6,3X,A5)
60190 140 FORMAT(/36X,A28//1X,A4,2X,A6,3X,A6,5A4,3(6X,A6),5X,A6,8X,A5)
60191 150 FORMAT(A1,'hline'/A1,'multicolumn{13}{|c|}{',A28,'} ',A2/A1,
60192 & 'hline'/12(A1,'multicolumn{1}{|c|}{',A6,'} & '),
60193 & A1,'multicolumn{1}{|c|}{',A6,'} ',A2/A1,'hline')
60194 160 FORMAT('<TR><TH COLSPAN=13 BGCOLOR=#',A6,'>',
60195 & '<FONT COLOR=#',A6,'>',A28,'</FONT></TH></TR>'/
60196 & '<TR>',13(/'<TH BGCOLOR=#',A6,'>',
60197 & '<FONT COLOR=#',A6,'>',A6,'</FONT></TH>'),'</TR>')
60200 C Now print out the data line
60202 C Include vertex information
60205 IF (NPRFMT.EQ.1) THEN
60206 WRITE(6,190) I,RNAME(IDHW(I)),IDHEP(I),IST,
60207 & JMOHEP(1,I),JMOHEP(2,I),JDAHEP(1,I),JDAHEP(2,I),
60208 & (PHEP(J,I),J=1,5),(VHEP(J,I),J=1,4)
60210 WRITE(6,200) I,RNAME(IDHW(I)),IDHEP(I),IST,
60211 & JMOHEP(1,I),JMOHEP(2,I),JDAHEP(1,I),JDAHEP(2,I),
60212 & (PHEP(J,I),J=1,5),(VHEP(J,I),J=1,4)
60215 IF (NPRFMT.EQ.1) THEN
60216 WRITE(6,210) I,RNAME(IDHW(I)),IDHEP(I),IST,
60217 & JMOHEP(1,I),JMOHEP(2,I),JDAHEP(1,I),JDAHEP(2,I),
60218 & (PHEP(J,I),J=1,5),(VHEP(J,I),J=1,4)
60220 WRITE(6,220) I,RNAME(IDHW(I)),IDHEP(I),IST,
60221 & JMOHEP(1,I),JMOHEP(2,I),JDAHEP(1,I),JDAHEP(2,I),
60222 & (PHEP(J,I),J=1,5),(VHEP(J,I),J=1,4)
60226 IF (PRNTEX) WRITE(IUNITT,230) I,TXNAME(1,IDHW(I)),IDHEP(I),
60227 & IST,JMOHEP(1,I),JMOHEP(2,I),JDAHEP(1,I),JDAHEP(2,I),
60228 & (PHEP(J,I),J=1,5),(VHEP(J,I),J=1,4),ZZ
60230 WRITE(IUNITW,240) TBCOLS(2),TBCOLS(3),I,I
60231 IF (IDHEP(I).EQ.0.OR.IDHEP(I).EQ.91) THEN
60232 WRITE(IUNITW,250) TXNAME(2,IDHW(I)),IDHEP(I),IST
60234 TMPNME=HWUNST(IDHW(I))
60235 WRITE(FNAMEP,'(A15,A7,A5)')
60236 & 'HW_decays/PART_',TMPNME,'.html'
60237 WRITE(IUNITW,260) FNAMEP,TXNAME(2,IDHW(I)),IDHEP(I),IST
60240 IF (JMOHEP(J,I).NE.0) THEN
60241 WRITE(IUNITW,270) JMOHEP(J,I),JMOHEP(J,I)
60243 WRITE(IUNITW,280) JMOHEP(J,I)
60247 IF (JDAHEP(J,I).NE.0) THEN
60248 WRITE(IUNITW,270) JDAHEP(J,I),JDAHEP(J,I)
60250 WRITE(IUNITW,280) JDAHEP(J,I)
60253 IF (NPRFMT.EQ.1) THEN
60254 WRITE(IUNITW,290) (PHEP(J,I),J=1,5),(VHEP(J,I),J=1,4)
60256 WRITE(IUNITW,300) (PHEP(J,I),J=1,5),(VHEP(J,I),J=1,4)
60259 190 FORMAT(1X,I4,1X,A8,I8,5I4, 2F8.2,2F7.1,F8.2,1P,4E10.3)
60260 200 FORMAT(1X,I4,1X,A8,I8,5I4, 5F12.5,1P,4E11.4)
60261 210 FORMAT(1X,Z4,1X,A8,I8,I4,4Z4,2F8.2,2F7.1,F8.2,1P,4E10.3)
60262 220 FORMAT(1X,Z4,1X,A8,I8,I4,4Z4,5F12.5,1P,4E11.4)
60263 230 FORMAT(I4,' & ',A37,' & $',I8,'$',5(' & ',I4),
60264 & 5(' & $',F8.2,'$'),4(' & $',1P,E11.3,'$'),' ',A2)
60265 240 FORMAT('<TR>'/'<TD BGCOLOR=#',A6,' ALIGN="RIGHT">',
60266 & '<FONT COLOR=#',A6,'><A NAME="',I4,'">',I4,'</A></FONT></TD>'/)
60267 250 FORMAT('<TD ALIGN="CENTER">',A37,'</TD>'/'<TD ALIGN="RIGHT">',
60268 & I8,'</TD>'/'<TD ALIGN="RIGHT">',I4,'</TD>')
60269 260 FORMAT('<TD ALIGN="CENTER"><A HREF="',A27,'">',A37,'</A></TD>'/
60270 & '<TD ALIGN="RIGHT">',I8,'</TD>'/
60271 & '<TD ALIGN="RIGHT">',I4,'</TD>')
60272 270 FORMAT(/'<TD ALIGN="RIGHT"><A HREF="#',I4,'">',I4,'</A></TD>')
60273 280 FORMAT(/'<TD ALIGN="RIGHT">',I4,'</TD>')
60274 290 FORMAT(5(/'<TD ALIGN="RIGHT">',F8.2,'</TD>'),1P,
60275 & 4(/'<TD ALIGN="RIGHT">',E10.3,'</TD>')/'</TR>')
60276 300 FORMAT(5(/'<TD ALIGN="RIGHT">',F12.5,'</TD>'),1P,
60277 & 4(/'<TD ALIGN="RIGHT">',E11.4,'</TD>')/'</TR>')
60279 C Do not include vertex information
60282 IF (NPRFMT.EQ.1) THEN
60283 WRITE(6,330) I,RNAME(IDHW(I)),IDHEP(I),IST,
60284 & JMOHEP(1,I),JMOHEP(2,I),JDAHEP(1,I),JDAHEP(2,I),
60285 & (PHEP(J,I),J=1,5)
60287 WRITE(6,340) I,RNAME(IDHW(I)),IDHEP(I),IST,
60288 & JMOHEP(1,I),JMOHEP(2,I),JDAHEP(1,I),JDAHEP(2,I),
60289 & (PHEP(J,I),J=1,5)
60292 IF (NPRFMT.EQ.1) THEN
60293 WRITE(6,350) I,RNAME(IDHW(I)),IDHEP(I),IST,
60294 & JMOHEP(1,I),JMOHEP(2,I),JDAHEP(1,I),JDAHEP(2,I),
60295 & (PHEP(J,I),J=1,5)
60297 WRITE(6,360) I,RNAME(IDHW(I)),IDHEP(I),IST,
60298 & JMOHEP(1,I),JMOHEP(2,I),JDAHEP(1,I),JDAHEP(2,I),
60299 & (PHEP(J,I),J=1,5)
60304 IF (NPRFMT.EQ.1) THEN
60305 WRITE(IUNITT,370) I,TXNAME(1,IDHW(I)),IDHEP(I),
60306 & IST,JMOHEP(1,I),JMOHEP(2,I),JDAHEP(1,I),JDAHEP(2,I),
60307 & (PHEP(J,I),J=1,5),ZZ
60309 WRITE(IUNITT,380) I,TXNAME(1,IDHW(I)),IDHEP(I),
60310 & IST,JMOHEP(1,I),JMOHEP(2,I),JDAHEP(1,I),JDAHEP(2,I),
60311 & (PHEP(J,I),J=1,5),ZZ
60315 WRITE(IUNITW,240) TBCOLS(2),TBCOLS(3),I,I
60316 IF (IDHEP(I).EQ.0.OR.IDHEP(I).EQ.91) THEN
60317 WRITE(IUNITW,250) TXNAME(2,IDHW(I)),IDHEP(I),IST
60319 TMPNME = HWUNST(IDHW(I))
60320 WRITE(FNAMEP,'(A15,A7,A5)')
60321 & 'HW_decays/PART_',TMPNME,'.html'
60322 WRITE(IUNITW,260) FNAMEP,TXNAME(2,IDHW(I)),IDHEP(I),IST
60325 IF (JMOHEP(J,I).NE.0) THEN
60326 WRITE(IUNITW,270) JMOHEP(J,I),JMOHEP(J,I)
60328 WRITE(IUNITW,280) JMOHEP(J,I)
60332 IF (JDAHEP(J,I).NE.0) THEN
60333 WRITE(IUNITW,270) JDAHEP(J,I),JDAHEP(J,I)
60335 WRITE(IUNITW,280) JDAHEP(J,I)
60338 IF (NPRFMT.EQ.1) THEN
60339 WRITE(IUNITW,390) (PHEP(J,I),J=1,5)
60341 WRITE(IUNITW,400) (PHEP(J,I),J=1,5)
60344 330 FORMAT(1X,I4,1X,A8,I8,5I4 ,2F8.2,2F7.1,F8.2)
60345 340 FORMAT(1X,I4,1X,A8,I8,5I4 ,5F12.5)
60346 350 FORMAT(1X,Z4,1X,A8,I8,I4,4Z4,2F8.2,2F7.1,F8.2)
60347 360 FORMAT(1X,Z4,1X,A8,I8,I4,4Z4,5F12.5)
60348 370 FORMAT(I4,' & ',A37,' & $',I8,'$',5(' & ',I4),
60349 & 5(' & $',F8.2,'$'),' ',A2)
60350 380 FORMAT(I4,' & ',A37,' & $',I8,'$',5(' & ',I4),
60351 & 5(' & $',F12.5,'$'),' ',A2)
60352 390 FORMAT(5(/'<TD ALIGN="RIGHT">',F8.2,'</TD>')/'</TR>')
60353 400 FORMAT(5(/'<TD ALIGN="RIGHT">',F12.5,'</TD>')/'</TR>')
60358 WRITE(IUNITT,420) Z,Z,Z
60359 420 FORMAT(A1,'end{longtable}'/A1,'end{center}'/A1,'end{document}')
60364 430 FORMAT('</TABLE>'/'</CENTER>'/'</BODY>'/'</HTML>')
60369 *CMZ :- -13/02/02 07.20.46 by Peter Richardson
60370 *-- Author : Peter Richardson
60371 C-----------------------------------------------------------------------
60373 C-----------------------------------------------------------------------
60374 C Subroutine to handle termination of HERWIG if reaches end of event
60376 C-----------------------------------------------------------------------
60377 INCLUDE 'herwig65.inc'
60378 C--reset the number of events to the correct value
60380 C--output information on the events
60385 *CMZ :- -16/10/93 12.42.15 by Mike Seymour
60386 *-- Author : Mike Seymour
60387 C-----------------------------------------------------------------------
60389 C-----------------------------------------------------------------------
60390 C FINALISES THE EVENT BY UNDOING THE LORENTZ BOOST IF THERE WAS ONE,
60391 C CHECKING FOR ERRORS, AND PRINTING
60392 C-----------------------------------------------------------------------
60393 INCLUDE 'herwig65.inc'
60396 COMMON/HWDBUG/CALLED
60398 C---UNBOOST EVENT RECORD IF NECESSARY
60400 C---CHECK FOR NEGATIVE ENERGY PARTICLES (REMNANT BUG?)
60402 IF (ISTHEP(IHEP).EQ.1.AND.PHEP(4,IHEP).LT.ZERO) THEN
60403 CALL HWWARN('HWUFNE',100)
60408 C---CHANGE LIGHTEST SUSY HIGGS CODE TO THE PDG VALUE
60410 IF (IDHEP(IHEP).EQ.26) IDHEP(IHEP)=25
60412 C---CHECK FOR FATAL ERROR
60413 IF (IERROR.NE.0) THEN
60414 IF (IERROR.GT.0) THEN
60419 IF (NUMER.GT.MAXER) CALL HWWARN('HWUFNE',300)
60421 IF (NEGWTS.AND.EVWGT.LT.ZERO) NNEGEV=NNEGEV-1
60422 C---PRINT FIRST MAXPR EVENTS
60423 ELSEIF (NEVHEP.LE.MAXPR) THEN
60428 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
60429 *-- Author : Adapted by Bryan Webber
60430 C-----------------------------------------------------------------------
60431 FUNCTION HWUGAU(F,A,B,EPS)
60432 C-----------------------------------------------------------------------
60433 C ADAPTIVE GAUSSIAN INTEGRATION OF FUNCTION F
60434 C IN INTERVAL (A,B) WITH PRECISION EPS
60435 C (MODIFIED CERN LIBRARY ROUTINE GAUSS)
60436 C-----------------------------------------------------------------------
60438 DOUBLE PRECISION HWUGAU,F,A,B,EPS,CONST,AA,BB,C1,C2,S8,U,S16,
60442 PARAMETER (ZERO=0.0D0)
60444 DATA W/.1012285363D0,.2223810345D0,.3137066459D0,
60445 & .3626837834D0,.0271524594D0,.0622535239D0,
60446 & .0951585117D0,.1246289713D0,.1495959888D0,
60447 & .1691565194D0,.1826034150D0,.1894506105D0/
60448 DATA X/.9602898565D0,.7966664774D0,.5255324099D0,
60449 & .1834346425D0,.9894009350D0,.9445750231D0,
60450 & .8656312024D0,.7554044084D0,.6178762444D0,
60451 & .4580167777D0,.2816035508D0,.0950125098D0/
60454 CONST=.005/ABS(B-A)
60463 S8=S8+W(I)*(F(C1+U)+F(C1-U))
60469 S16=S16+W(I)*(F(C1+U)+F(C1-U))
60472 IF (ABS(S16-S8).LE.EPS*(1.+ABS(S16))) GOTO 5
60474 IF (CONST*ABS(C2).NE.ZERO) GOTO 2
60475 C---TOO HIGH ACCURACY REQUESTED
60476 CALL HWWARN('HWUGAU',500)
60477 5 HWUGAU=HWUGAU+S16
60478 IF (BB.NE.B) GOTO 1
60481 *CMZ :- -26/04/91 10.18.58 by Bryan Webber
60482 *-- Author : Bryan Webber
60483 C-----------------------------------------------------------------------
60484 SUBROUTINE HWUIDT(IOPT,IPDG,IWIG,NWIG)
60485 C-----------------------------------------------------------------------
60486 C TRANSLATES PARTICLE IDENTIFIERS:
60487 C IPDG = PARTICLE DATA GROUP CODE
60488 C IWIG = HERWIG IDENTITY CODE
60489 C NWIG = HERWIG CHARACTER*8 NAME
60491 C IOPT= 1 GIVEN IPDG, RETURNS IWIG AND NWIG
60492 C IOPT= 2 GIVEN IWIG, RETURNS IPDG AND NWIG
60493 C IOPT= 3 GIVEN NWIG, RETURNS IPDG AND IWIG
60494 C-----------------------------------------------------------------------
60495 INCLUDE 'herwig65.inc'
60496 INTEGER IOPT,IPDG,IWIG,I
60498 IF (IOPT.EQ.1) THEN
60500 IF (IDPDG(I).EQ.IPDG) THEN
60507 20 FORMAT(1X,'Particle not recognised, PDG code: ',I8)
60510 CALL HWWARN('HWUIDT',101)
60512 ELSEIF (IOPT.EQ.2) THEN
60513 IF (IWIG.LT.0.OR.IWIG.GT.NRES) THEN
60515 30 FORMAT(1X,'Particle not recognised, HERWIG code: ',I3)
60518 CALL HWWARN('HWUIDT',102)
60525 ELSEIF (IOPT.EQ.3) THEN
60527 IF (RNAME(I).EQ.NWIG) THEN
60534 50 FORMAT(1X,'Particle not recognised, HERWIG name: ',A8)
60537 CALL HWWARN('HWUIDT',103)
60540 CALL HWWARN('HWUIDT',404)
60545 *CMZ :- -12/10/01 09.56.07 by Peter Richardson
60546 *-- Author : Bryan Webber
60547 C-----------------------------------------------------------------------
60549 C-----------------------------------------------------------------------
60550 C COMPUTES CONSTANTS AND LOOKUP TABLES
60551 C---BRW change 27/8/04: include Frixione's fix to reduce PDFSET calls
60552 C-----------------------------------------------------------------------
60553 INCLUDE 'herwig65.inc'
60554 DOUBLE PRECISION HWBVMC,HWUALF,HWUPCM,XMIN,XMAX,XPOW,QR,DQKWT,
60555 & UQKWT,SQKWT,DIQWT,QMAX,PMAX,PTLIM,ETLIM,PGS,PTELM,X,QSCA,UPV,DNV,
60556 & USEA,DSEA,STR,CHM,BTM,TOP,GLU,VAL(20),CLMXPW,RCLPOW,TEST,RPM(2)
60557 INTEGER ISTOP,I,J,IQK,IDB,IDT,ISET,IOP1,IOP2,IP2,ID,IH,IV
60558 INTEGER LPROC,KPROC
60559 INTEGER IS,IP(3),IQ
60560 COMMON/SQSQH/JHIGGS,ILBL,JH,IF1MIN,IF1MAX,IF2MIN,IF2MAX
60561 INTEGER JHIGGS,ILBL,JH,IF1MIN,IF1MAX,IF2MIN,IF2MAX
60563 INTEGER IHLP,JHLP,KHLP,ISIGN,ITMP(8)
60564 LOGICAL FIRST,FSTPDF
60565 CHARACTER*20 PARM(20)
60566 EXTERNAL HWBVMC,HWUALF,HWUPCM
60567 COMMON/HWRPIN/XMIN,XMAX,XPOW,FIRST
60568 COMMON/W50516/FSTPDF
60569 CHARACTER*20 PARMSAVE
60570 DOUBLE PRECISION VALSAVE
60571 COMMON/HWSFSA/PARMSAVE
60572 COMMON/HWSFSB/VALSAVE
60574 DATA ITMP/0,12,-12,0,0,12,-12,0/
60575 C--read in the information frmo the Les Houches common block if needed
60576 IF(IPROC.LE.0) CALL HWIGUP
60577 C---MSSM Higgs processes: additional IDs to distinguish from SM-like ones.
60580 C---Sets even parity of Higgs bosons (in the coupling to fermions) as default.
60582 C...define parity of Neutral MSSM Higgses.
60586 C---IPRO=9,11 (lepton-lepton); 31...38 (hadron-hadron) MSSM Higgs production.
60587 LPROC=MOD(IPROC,10000)
60588 IF((LPROC.LT.3100).OR.(LPROC.GE.3900))THEN
60589 C...add here MSSM Higgs processes in lepton-lepton collisions.
60590 IF((LPROC/100.NE.9).AND.(LPROC/100.NE.11))GOTO 666
60592 C-----------------------------------------------------------------------
60593 C HARD 2 LEPTON/PARTON -> HIGGS + X PROCESSES IN MSSM
60594 C IH = 1 MSSM h^0 IV = 0 SM W+/- IQ = 1,3,5 d,s,b-quark
60595 C = 2 MSSM H^0 = 1 SM Z 2,4,6 u,c,t-quark
60596 C = 3 MSSM A^0 ID = IQ, IL
60597 C = 4/5 MSSM H^+/- IL = 1,2,3 e,mu,tau-lepton
60598 C-----------------------------------------------------------------------
60599 C...leptonic processes.
60600 IF(LPROC/100.EQ.9)THEN
60601 IF(LPROC.EQ.955)THEN
60604 ELSE IF(LPROC.EQ.965)THEN
60607 ELSE IF(LPROC.EQ.975)THEN
60610 ELSE IF((LPROC.EQ.910).OR.(LPROC.EQ.920).OR.
60611 & (LPROC.EQ.960).OR.(LPROC.EQ.970))THEN
60612 KPROC=MIN(951,LPROC)
60613 IV=MAX(KPROC-950,0)
60614 IF((IV.LT.0).OR.(IV.GT.1)) CALL HWWARN('HWUINC',627)
60615 IH=LPROC/10-90-5*IV
60616 IF((IH.LE.0).OR.(IH.GT.2)) CALL HWWARN('HWUINC',626)
60617 IF(LPROC.LE.920)IMSSM=LPROC-400
60618 IF(LPROC.GE.960)IMSSM=LPROC-300
60619 C...assign enhancement for MSSM Higgs-VV couplings, V->W,Z-gauge bosons.
60621 ENHANC(I )=GHWWSS(IH)
60622 ENHANC(I+1)=GHZZSS(IH)
60624 IF(IH.EQ.1)IHIGGS=203-201
60625 IF(IH.EQ.2)IHIGGS=204-201
60626 IF(IH.EQ.3)IHIGGS=205-201
60628 CALL HWWARN('HWUINC',625)
60630 ELSE IF(LPROC/100.EQ.11)THEN
60632 IF(LPROC.GE.1140)THEN
60637 IF(LPROC.LT.1140)IH=3
60638 IF(LPROC.LT.1130)IH=2
60639 IF(LPROC.LT.1120)IH=1
60640 IF((IH.LE.0).OR.(IH.GT.3)) CALL HWWARN('HWUINC',624)
60641 IQ=LPROC-1100-10*IH
60642 IF((IQ.LE.0).OR.(IQ.GT.9)) CALL HWWARN('HWUINC',623)
60643 C...assign Neutral MSSM Higgs parity.
60645 C...assign enhancement for MSSM Higgs-QQ couplings, Q->U,D-type quarks.
60647 ENHANC(I )=GHDDSS(IH)
60648 ENHANC(I+1)=GHUUSS(IH)
60650 C...assign enhancement for MSSM Higgs-LL couplings, L->D-type leptons.
60651 ENHANC(7)=GHDDSS(IH)
60652 ENHANC(8)=GHDDSS(IH)
60653 ENHANC(9)=GHDDSS(IH)
60654 C...assign enhancement for MSSM Higgs-VV couplings, V->W,Z-gauge bosons.
60656 ENHANC(I )=GHWWSS(IH)
60657 ENHANC(I+1)=GHZZSS(IH)
60659 IF(IH.EQ.1)IHIGGS=203-201
60660 IF(IH.EQ.2)IHIGGS=204-201
60661 IF(IH.EQ.3)IHIGGS=205-201
60663 C...hadronic processes.
60664 ELSE IF((LPROC/100.EQ.31).OR.(LPROC/100.EQ.32))THEN
60665 IF(LPROC/100.EQ.31)THEN
60666 IF((LPROC.LE.3109).OR.
60667 & ((LPROC.GE.3119).AND.(LPROC.LE.3139)).OR.
60668 & ((LPROC.GE.3149).AND.(LPROC.LE.3169)).OR.
60669 & (LPROC.GE.3179)) CALL HWWARN('HWUINC',622)
60671 IF(LPROC/100-LPROC/10*10.LE.4)IHIGGS=5
60672 IF(LPROC/100-LPROC/10*10.GE.5)IHIGGS=6
60673 ELSE IF(LPROC/100.EQ.32)THEN
60674 IF(LPROC.LE.3209) CALL HWWARN('HWUINC',621)
60675 IF(LPROC.EQ.3219) CALL HWWARN('HWUINC',620)
60676 IF(LPROC.EQ.3229) CALL HWWARN('HWUINC',619)
60677 IF(LPROC.EQ.3239) CALL HWWARN('HWUINC',618)
60678 IF(LPROC.EQ.3249) CALL HWWARN('HWUINC',617)
60679 IF(LPROC.EQ.3259) CALL HWWARN('HWUINC',616)
60680 IF(LPROC.EQ.3269) CALL HWWARN('HWUINC',615)
60681 IF(LPROC.EQ.3279) CALL HWWARN('HWUINC',614)
60682 IF(LPROC.EQ.3289) CALL HWWARN('HWUINC',613)
60683 IF(LPROC.GE.3299) CALL HWWARN('HWUINC',612)
60685 IF(LPROC.LT.3300)IHIGGS=4
60686 IF(LPROC.LT.3290)IHIGGS=3
60687 IF(LPROC.LT.3280)IHIGGS=2
60688 IF(LPROC.LT.3270)IHIGGS=4
60689 IF(LPROC.LT.3260)IHIGGS=3
60690 IF(LPROC.LT.3250)IHIGGS=2
60691 IF(LPROC.LT.3240)IHIGGS=4
60692 IF(LPROC.LT.3230)IHIGGS=3
60693 IF(LPROC.LT.3220)IHIGGS=2
60695 C...assign squarks/Higgs-flavours.
60696 IF(LPROC/100.EQ.31)JHIGGS=1
60697 IF(LPROC/100.EQ.32)JHIGGS=IHIGGS-1
60698 IF(LPROC/100.EQ.31)ILBL=3100
60699 IF(LPROC/100.EQ.32)ILBL=3200
60700 IHLP=LPROC-ILBL-60-JHIGGS*10
60701 IF(LPROC.LT.ILBL+70)IHLP=LPROC-ILBL-30-JHIGGS*10
60702 IF(LPROC.LT.ILBL+40)IHLP=LPROC-ILBL -JHIGGS*10
60703 IF(IHLP.LE.8)ISIGN=-1
60704 IF(IHLP.LE.4)ISIGN=+1
60706 KHLP=IHLP/(3+4*JHLP)
60707 ISQ1=405+JHLP+12*KHLP
60708 IF(ILBL.EQ.3100)THEN
60709 ISQ2=ISQ1+ITMP(IHLP)+6+ISIGN
60710 IF(ISIGN.EQ.+1)JH=206
60711 IF(ISIGN.EQ.-1)JH=207
60712 IF(ISIGN.EQ.+1)JHIGGS=4
60713 IF(ISIGN.EQ.-1)JHIGGS=5
60714 ELSE IF(ILBL.EQ.3200)THEN
60715 ISQ2=ISQ1+ITMP(IHLP)+6
60716 IF(JHIGGS.EQ.1)JH=203
60717 IF(JHIGGS.EQ.2)JH=204
60718 IF(JHIGGS.EQ.3)JH=205
60724 IF((LPROC.EQ.3110).OR.(LPROC.EQ.3210).OR.
60725 & (LPROC.EQ.3220).OR.(LPROC.EQ.3230).OR.
60726 & (LPROC.EQ.3140).OR.(LPROC.EQ.3240).OR.
60727 & (LPROC.EQ.3250).OR.(LPROC.EQ.3260).OR.
60728 & (LPROC.EQ.3170).OR.(LPROC.EQ.3270).OR.
60729 & (LPROC.EQ.3280).OR.(LPROC.EQ.3290))THEN
60735 ELSE IF(LPROC/100.EQ.33)THEN
60736 IF((LPROC.EQ.3350).OR.(LPROC.EQ.3355))THEN
60739 ELSE IF((LPROC.EQ.3310).OR.(LPROC.EQ.3320).OR.
60740 & (LPROC.EQ.3360).OR.(LPROC.EQ.3370))THEN
60741 KPROC=MIN(3351,LPROC)
60742 IV=MAX(KPROC-3350,0)
60743 IF((IV.LT.0).OR.(IV.GT.1)) CALL HWWARN('HWUINC',611)
60744 IH=LPROC/10-330-5*IV
60745 IF((IH.LE.0).OR.(IH.GT.2)) CALL HWWARN('HWUINC',610)
60746 IF(LPROC.LE.3320)IMSSM=LPROC-2600
60747 IF(LPROC.GE.3360)IMSSM=LPROC-2700
60748 C...assign enhancement for MSSM Higgs-VV couplings, V->W,Z-gauge bosons.
60750 ENHANC(I )=GHWWSS(IH)
60751 ENHANC(I+1)=GHZZSS(IH)
60753 IF(IH.EQ.1)IHIGGS=203-201
60754 IF(IH.EQ.2)IHIGGS=204-201
60755 IF(IH.EQ.3)IHIGGS=205-201
60756 ELSE IF((LPROC.EQ.3315).OR.(LPROC.EQ.3365))THEN
60759 ELSE IF((LPROC.EQ.3325).OR.(LPROC.EQ.3375))THEN
60762 ELSE IF(LPROC.EQ.3335)THEN
60766 CALL HWWARN('HWUINC',609)
60768 ELSE IF(LPROC/100.EQ.34)THEN
60770 IF(LPROC.EQ.3410)IHIGGS=203-201
60771 IF(LPROC.EQ.3420)IHIGGS=204-201
60772 IF(LPROC.EQ.3430)IHIGGS=205-201
60773 IF(LPROC.EQ.3450)IHIGGS=206-201
60774 IF(IHIGGS.EQ.0) CALL HWWARN('HWUINC',608)
60775 ELSE IF(LPROC/100.EQ.35)THEN
60778 ELSE IF(LPROC/100.EQ.36)THEN
60779 IF((LPROC.NE.3610).AND.(LPROC.NE.3620).AND.
60780 & (LPROC.NE.3630)) CALL HWWARN('HWUINC',607)
60782 IF((IH.LE.0).OR.(IH.GT.3)) CALL HWWARN('HWUINC',606)
60783 ID=LPROC-3600-10*IH
60784 IF((ID.LT.0).OR.(ID.GT.9)) CALL HWWARN('HWUINC',605)
60785 IMSSM=LPROC-(1600+ID)
60786 C...assign Neutral MSSM Higgs parity.
60787 IF(IH.EQ.3)PARITY=-1
60789 C...assign enhancement for Neutral MSSM Higgs-QQ couplings, Q->U,D-type quarks.
60790 ENHANC(I)=GHDDSS(IH)
60791 ENHANC(I+1)=GHUUSS(IH)
60793 C...assign enhancement for Neutral MSSM Higgs-Q~Q~ couplings,
60794 C Q~->U,D-type squarks.
60796 SENHNC(I )=RMASS(198)*GHSQSS(IH,I,1,1)/RMASS(400+I)**2
60797 SENHNC(I+12)=RMASS(198)*GHSQSS(IH,I,2,2)/RMASS(412+I)**2
60799 IF(IH.EQ.1)IHIGGS=203-201
60800 IF(IH.EQ.2)IHIGGS=204-201
60801 IF(IH.EQ.3)IHIGGS=205-201
60802 ELSE IF(LPROC/100.EQ.37)THEN
60804 IF((IH.LE.0).OR.(IH.GT.2)) CALL HWWARN('HWUINC',604)
60806 C...assign enhancement for MSSM Higgs-VV couplings, V->W,Z-gauge bosons.
60808 ENHANC(I )=GHWWSS(IH)
60809 ENHANC(I+1)=GHZZSS(IH)
60811 IF(IH.EQ.1)IHIGGS=203-201
60812 IF(IH.EQ.2)IHIGGS=204-201
60813 IF(IH.EQ.3)IHIGGS=205-201
60814 ELSE IF(LPROC/100.EQ.38)THEN
60816 IF((LPROC.EQ.3839).OR.(LPROC.EQ.3869).OR.(LPROC.EQ.3899))THEN
60821 IF(LPROC.LT.4000)IS=6
60822 IF(LPROC.LT.3870)IS=3
60823 IF(LPROC.LT.3840)IS=0
60825 IF((IH.LE.0).OR.(IH.GT.3)) CALL HWWARN('HWUINC',603)
60826 IQ=LPROC-3800-10*(IH+IS)
60827 IF((IQ.LE.0).OR.(IQ.GT.6)) CALL HWWARN('HWUINC',602)
60828 C...assign Neutral MSSM Higgs parity.
60830 C...assign enhancement for MSSM Higgs-QQ couplings, Q->U,D-type quarks.
60832 ENHANC(I )=GHDDSS(IH)
60833 ENHANC(I+1)=GHUUSS(IH)
60835 IF(IH.EQ.1)IHIGGS=203-201
60836 IF(IH.EQ.2)IHIGGS=204-201
60837 IF(IH.EQ.3)IHIGGS=205-201
60840 IF((IMSSM.NE.-1).AND.(IPROC.GE.10000))IMSSM=IMSSM+10000
60842 IPRO=MOD(IPROC/100,100)
60845 CALL HWUIDT(3,IDB,IPART1,PART1)
60846 CALL HWUIDT(3,IDT,IPART2,PART2)
60847 EBEAM1=SQRT(PBEAM1**2+RMASS(IPART1)**2)
60848 EBEAM2=SQRT(PBEAM2**2+RMASS(IPART2)**2)
60849 C---PHOTON CUTOFF DEFAULTS TO ROOT S
60850 PTLIM=SQRT(HALF*(EBEAM1*EBEAM2+PBEAM1*PBEAM2))
60852 IF (VPCUT.GT.ETLIM) VPCUT=ETLIM
60853 IF (Q2MAX.GT.ETLIM**2) Q2MAX=ETLIM**2
60854 C---PRINT OUT MOST IMPORTANT INPUT PARAMETERS
60855 IF (IPRINT.EQ.0) GOTO 50
60856 WRITE (6,10) PART1,PBEAM1,PART2,PBEAM2,IPROC,
60857 & NFLAV,NSTRU,AZSPIN,AZSOFT,QCDLAM,(RMASS(I),I=1,6),RMASS(13)
60858 IF (ISPAC.LE.1) THEN
60859 WRITE (6,20) VQCUT,VGCUT,VPCUT,CLMAX,QSPAC,PTRMS
60861 WRITE (6,30) VQCUT,VGCUT,VPCUT,CLMAX,QSPAC,PTRMS
60863 C--switch on three body matrix elements if doing spin correlations
60864 IF(SYSPIN) THREEB=.TRUE.
60865 C--output spin correlation options
60866 WRITE(6,35) SYSPIN,THREEB,FOURB
60867 IF (NOSPAC) WRITE (6,40)
60868 10 FORMAT(/10X,'INPUT CONDITIONS FOR THIS RUN'//
60869 & 10X,'BEAM 1 (',A8,') MOM. =',F10.2/
60870 & 10X,'BEAM 2 (',A8,') MOM. =',F10.2/
60871 & 10X,'PROCESS CODE (IPROC) =',I8/
60872 & 10X,'NUMBER OF FLAVOURS =',I5/
60873 & 10X,'STRUCTURE FUNCTION SET =',I5/
60874 & 10X,'AZIM SPIN CORRELATIONS =',L5/
60875 & 10X,'AZIM SOFT CORRELATIONS =',L5/
60876 & 10X,'QCD LAMBDA (GEV) =',F10.4/
60877 & 10X,'DOWN QUARK MASS =',F10.4/
60878 & 10X,'UP QUARK MASS =',F10.4/
60879 & 10X,'STRANGE QUARK MASS =',F10.4/
60880 & 10X,'CHARMED QUARK MASS =',F10.4/
60881 & 10X,'BOTTOM QUARK MASS =',F10.4/
60882 & 10X,'TOP QUARK MASS =',F10.4/
60883 & 10X,'GLUON EFFECTIVE MASS =',F10.4)
60884 20 FORMAT(10X,'EXTRA SHOWER CUTOFF (Q)=',F10.4/
60885 & 10X,'EXTRA SHOWER CUTOFF (G)=',F10.4/
60886 & 10X,'PHOTON SHOWER CUTOFF =',F10.4/
60887 & 10X,'CLUSTER MASS PARAMETER =',F10.4/
60888 & 10X,'SPACELIKE EVOLN CUTOFF =',F10.4/
60889 & 10X,'INTRINSIC P-TRAN (RMS) =',F10.4)
60890 30 FORMAT(10X,'EXTRA SHOWER CUTOFF (Q)=',F10.4/
60891 & 10X,'EXTRA SHOWER CUTOFF (G)=',F10.4/
60892 & 10X,'PHOTON SHOWER CUTOFF =',F10.4/
60893 & 10X,'CLUSTER MASS PARAMETER =',F10.4/
60894 & 10X,'PDF FREEZING CUTOFF =',F10.4/
60895 & 10X,'INTRINSIC P-TRAN (RMS) =',F10.4)
60896 35 FORMAT(10X,'DECAY SPIN CORRELATIONS=',L5/
60897 & 10X,'SUSY THREE BODY ME =',L5/
60898 & 10X,'SUSY FOUR BODY ME =',L5)
60899 40 FORMAT(10X,'NO SPACE-LIKE SHOWERS')
60901 C---INITIALIZE ALPHA-STRONG
60902 IF (QLIM.GT.ETLIM) QLIM=ETLIM
60904 C---DO SOME SAFETY CHECKS ON INPUT PARAMETERS
60905 C Check beam order for point-like photon/QCD processes
60906 IF (IPRO.GE.50.AND.IPRO.LE.59.AND.
60907 & IDB.NE.22.AND.ABS(IDB).NE.11.AND.ABS(IDB).NE.13) THEN
60909 60 FORMAT(1X,'WARNING: require FIRST beam to be a photon/lepton')
60914 IF (QR.GE.2.01) GOTO 80
60915 WRITE (6,70) QG,QCDLAM,QCDL3
60916 70 FORMAT(//10X,'SHOWER GLUON VIRTUAL MASS CUTOFF =',F8.5/
60917 & 10X,'TOO SMALL RELATIVE TO QCD LAMBDA =',F8.5/
60918 & 10X,'CORRESPONDS TO 3-FLAV MC LAMBDA =',F8.5)
60920 80 QV=MIN(HWBVMC(1),HWBVMC(2))
60921 IF (QV.GE.QG/(QR-1.)) GOTO 100
60923 WRITE (6,90) QV,QCDLAM,QCDL3
60924 90 FORMAT(//10X,'SHOWER QUARK VIRTUAL MASS CUTOFF =',F8.5/
60925 & 10X,'TOO SMALL RELATIVE TO QCD LAMBDA =',F8.5/
60926 & 10X,'CORRESPONDS TO 3-FLAV MC LAMBDA =',F8.5)
60927 100 IF (ISTOP.NE.0) THEN
60928 WRITE (6,110) ISTOP
60929 110 FORMAT(//10X,'EXECUTION PREVENTED BY',I2,
60930 & ' ERRORS IN INPUT PARAMETERS.')
60934 120 RMASS(I+6)=RMASS(I)
60935 RMASS(199)=RMASS(198)
60936 C---A PRIORI WEIGHTS FOR QUARK AND DIQUARKS
60945 PWT(4)=UQKWT*UQKWT*DIQWT
60946 PWT(5)=UQKWT*DQKWT*DIQWT*HALF
60947 PWT(6)=DQKWT*DQKWT*DIQWT
60948 PWT(7)=UQKWT*SQKWT*DIQWT*HALF
60949 PWT(8)=DQKWT*SQKWT*DIQWT*HALF
60950 PWT(9)=SQKWT*SQKWT*DIQWT
60951 QMAX=MAX(PWT(1),PWT(2),PWT(3))
60952 PMAX=MAX(PWT(4),PWT(5),PWT(6),PWT(7),PWT(8),PWT(9),
60953 & PWT(10),PWT(11),PWT(12),QMAX)
60957 130 QWT(I)=PWT(I)*QMAX
60959 140 PWT(I)=PWT(I)*PMAX
60960 C MASSES OF DIQUARKS (ASSUME BINDING NEGLIGIBLE)
60961 RMASS(109)=RMASS(2)+RMASS(2)
60962 RMASS(110)=RMASS(1)+RMASS(2)
60963 RMASS(111)=RMASS(1)+RMASS(1)
60964 RMASS(112)=RMASS(2)+RMASS(3)
60965 RMASS(113)=RMASS(1)+RMASS(3)
60966 RMASS(114)=RMASS(3)+RMASS(3)
60968 150 RMASS(I+6)=RMASS(I)
60969 C MASSES OF TOP HADRONS (ASSUME BINDING NEGLIGIBLE)
60970 RMASS(232)=RMASS(6)+RMASS(5)
60971 RMASS(233)=RMASS(6)+RMASS(1)
60972 RMASS(234)=RMASS(6)+RMASS(2)
60973 RMASS(235)=RMASS(6)+RMASS(3)
60974 RMASS(236)=RMASS(6)+RMASS(2)+RMASS(2)
60975 RMASS(237)=RMASS(6)+RMASS(1)+RMASS(2)
60976 RMASS(238)=RMASS(6)+RMASS(1)+RMASS(1)
60977 RMASS(239)=RMASS(6)+RMASS(2)+RMASS(3)
60978 RMASS(240)=RMASS(6)+RMASS(1)+RMASS(3)
60979 RMASS(241)=RMASS(6)+RMASS(3)+RMASS(3)
60980 RMASS(242)=RMASS(6)+RMASS(4)
60981 RMASS(243)=RMASS(6)+RMASS(5)
60982 RMASS(244)=RMASS(6)+RMASS(6)
60983 RMASS(232)=RMASS(243)
60985 160 RMASS(I+22)=RMASS(I)
60986 C Set up an array of cluster mass threholds
60987 CLMXPW=CLMAX**CLPOW
60989 CALL HWVZRO(144,CTHRPW(1,1))
60992 CTHRPW(I ,J )=(CLMXPW+(RMASS(I )+RMASS(J+6 ))**CLPOW)**RCLPOW
60993 CTHRPW(I ,J+6)=(CLMXPW+(RMASS(I )+RMASS(J+108))**CLPOW)**RCLPOW
60994 170 CTHRPW(I+6,J )=(CLMXPW+(RMASS(I+114)+RMASS(J+6 ))**CLPOW)**RCLPOW
60995 C Decay length conversion factor GEV2MM hbar.c/e
60996 GEV2MM=1.D-15*SQRT(GEV2NB/10.)
60997 C Plank's constant/2pi (GeV.s)
60999 C Check the SUSY DATA has been read in (if needed)
61000 IF((IPRO.EQ.7.OR.IPRO.EQ.8.OR.IPRO.EQ.9.OR.IPRO.EQ.11.OR.
61001 & (IPRO.GE.30.AND.IPRO.LE.41)).AND..NOT.SUSYIN)
61002 & CALL HWWARN('HWUINC',601)
61003 C---IMPORTANCE SAMPLING
61008 IF (IPRO.EQ.5) THEN
61009 IF (EMMAX.GT.ETLIM) EMMAX=ETLIM
61010 IF (PTMAX.GT.PTLIM) PTMAX=PTLIM
61011 ELSEIF (IPRO.EQ.13) THEN
61012 IF (EMMIN.EQ.ZERO) EMMIN=10
61013 IF (EMMAX.GT.ETLIM) EMMAX=ETLIM
61014 IF (IQK.GT.0.AND.IQK.LE.6) EMMIN=MAX(EMMIN,2*RMASS(IQK))
61018 ELSEIF (IPRO.EQ.15.OR.IPRO.EQ.17.OR.IPRO.EQ.18.OR.IPRO.EQ.21
61019 & .OR.IPRO.EQ.22.OR.IPRO.EQ.23.OR.IPRO.EQ.24.OR.IPRO.EQ.50
61020 & .OR.IPRO.EQ.51.OR.IPRO.EQ.53.OR.IPRO.EQ.55.OR.IPRO.EQ.60) THEN
61021 IF (PTMAX.GT.PTLIM) PTMAX=PTLIM
61022 IF (IQK.NE.0.AND.IQK.LT.7.AND.IPRO.NE.23) THEN
61023 XMIN=2.*SQRT(PTMIN**2+RMASS(IQK)**2)
61024 XMAX=2.*SQRT(PTMAX**2+RMASS(IQK)**2)
61025 IF (XMAX.GT.ETLIM) XMAX=ETLIM
61031 C--Gauge Boson pairs in hadron-hadron
61032 ELSEIF(IPRO.EQ.28) THEN
61033 IF(EMMIN.EQ.ZERO) EMMIN=20.0D0
61034 C--Drell-Yan + 2 jets processes
61035 ELSEIF(IPRO.EQ.29) THEN
61036 IF(EMMIN.EQ.ZERO) EMMIN=20.0D0
61037 IF(PTMAX.GT.ETLIM) PTMAX = ETLIM
61038 C--Cuts on the graviton to avoid unitarity violations
61039 C--If the width exceeds 0.1 times the mass this should be reset
61040 ELSEIF(IPRO.EQ.42) THEN
61041 EMMIN = 0.9D0*EMGRV
61042 EMMAX = 1.1D0*EMGRV
61043 ELSEIF (IPRO.EQ.52) THEN
61044 PTELM=PTLIM-RMASS(IQK)**2/(4.*PTLIM)
61045 IF (PTMAX.GT.PTELM) PTMAX=PTELM
61049 ELSEIF (IPRO.EQ.30) THEN
61050 IF (PTMAX.GT.PTLIM) PTMAX=PTLIM
61051 XMIN=2.*SQRT(PTMIN**2+RMMNSS**2)
61052 XMAX=2.*SQRT(PTMAX**2+RMMNSS**2)
61053 IF (XMAX.GT.ETLIM) XMAX=ETLIM
61056 ELSEIF(IPRO.EQ.40.OR.IPRO.EQ.41) THEN
61057 IF (PTMAX.GT.PTLIM) PTMAX=PTLIM
61058 ID = MOD(IPROC,100)
61061 IF(ID.GE.10.AND.ID.LT.20) THEN
61062 RPM(1) = ABS(RMASS(450))
61063 IF(ID.GT.10) RPM(1) = ABS(RMASS(449+MOD(ID,10)))
61064 ELSEIF(ID.GE.20.AND.ID.LT.30) THEN
61065 RPM(1) = ABS(RMASS(454))
61066 IF(ID.GT.20) RPM(1) = ABS(RMASS(453+MOD(ID,20)))
61067 ELSEIF(ID.EQ.30) THEN
61068 RPM(1) = RMASS(449)
61069 ELSEIF(ID.EQ.40) THEN
61070 IF(IPRO.EQ.40) THEN
61071 RPM(1) = RMASS(425)
61073 RPM(1) = MIN(RPM(1),RMASS(425+I))
61076 RPM(1) = MIN(RMASS(405),RMASS(406))
61078 RPM(2) = RMASS(198)
61079 ELSEIF(ID.EQ.50) THEN
61080 IF(IPRO.EQ.40) THEN
61081 RPM(1) = RMASS(425)
61083 RPM(1) = MIN(RPM(1),RMASS(425+I))
61086 RPM(2) = MIN(RPM(1),RMASS(433+2*I))
61088 RPM(1) = MIN(RPM(1),RPM(2))
61089 RPM(2) = RMASS(203)
61091 RPM(2) = MIN(RPM(2),RMASS(204+I))
61094 RPM(1) = RMASS(401)
61095 RPM(2) = RMASS(413)
61097 RPM(1) = MIN(RPM(1),RMASS(401+I))
61098 RPM(2) = MIN(RPM(2),RMASS(413+I))
61100 RPM(1) = MIN(RPM(1),RPM(2))
61101 RPM(2) = RMASS(203)
61103 RPM(2) = MIN(RPM(2),RMASS(204+I))
61106 RPM(2) = RMASS(203)
61108 RPM(2) = MIN(RPM(2),RMASS(204+I))
61110 ELSEIF(ID.GE.60) THEN
61115 XMIN = SQRT(RPM(1)+RPM(2)+TWO*(PTMIN**2+
61116 & SQRT(RPM(1)*RPM(2)+PTMIN**2*(RPM(1)+RPM(2)+PTMIN**2))))
61117 XMAX = SQRT(RPM(1)+RPM(2)+TWO*(PTMAX**2+
61118 & SQRT(RPM(1)*RPM(2)+PTMAX**2*(RPM(1)+RPM(2)+PTMAX**2))))
61119 IF (XMAX.GT.ETLIM) XMAX=ETLIM
61121 ELSEIF (IPRO.EQ.90) THEN
61125 ELSEIF (IPRO.EQ.91) THEN
61126 IF (EMMAX.GT.ETLIM) EMMAX=ETLIM
61128 C---CALCULATE HIGGS WIDTH
61129 IF (IPRO.EQ. 3.OR.IPRO.EQ. 4.OR.IPRO.EQ.10.OR.IPRO.EQ.16
61130 &.OR.IPRO.EQ.19.OR.IPRO.EQ.23.OR.IPRO.EQ.25.OR.IPRO.EQ.26
61131 &.OR.IPRO.EQ.27.OR.IPRO.EQ.95) THEN
61135 C---IF Q**2 CAN BE TOO SMALL, BREIT FRAME MAKES NO SENSE
61136 IF ((IPRO/10.EQ.9.AND.Q2MIN.LE.1.D-2).OR.
61137 & (IPRO.EQ.91.AND.IQK.EQ.7)) BREIT=.FALSE.
61138 IF (IPRINT.NE.0) THEN
61139 IF (PBEAM1.NE.PBEAM2) WRITE (6,180) USECMF
61140 IF (IPRO.EQ.91.OR.IPRO.EQ.92)
61141 & WRITE (6,190) PTMIN
61142 IF (IPRO.EQ.90.OR.(IPRO.EQ.91.AND.IQK.NE.7).OR.IPRO.EQ.92)
61143 & WRITE (6,200) Q2MIN,Q2MAX,BREIT
61144 IF (IPRO.EQ.90.OR.(IPRO.EQ.91.AND.IQK.NE.7).OR.IPRO.EQ.92)
61145 & WRITE (6,210) YBMIN,YBMAX
61146 IF (IPRO.EQ.91.AND.IQK.EQ.7)
61147 & WRITE (6,220) Q2WWMN,Q2WWMX,BREIT,ZJMAX
61148 IF (IPROC/10.EQ.11) WRITE (6,230) THMAX
61149 IF (IPRO.EQ.13) WRITE (6,240) EMMIN,EMMAX
61150 IF (IPRO.EQ.15.OR.IPRO.EQ.17.OR.IPRO.EQ.18.OR.IPRO.EQ.21
61151 & .OR.IPRO.EQ.22.OR.IPRO.EQ.23.OR.IPRO.EQ.24.OR.IPRO.EQ.50
61152 & .OR.IPRO.EQ.51.OR.IPRO.EQ.52.OR.IPRO.EQ.53.OR.IPRO.EQ.55
61154 & WRITE (6,250) PTMIN,PTMAX
61155 IF (IPRO.EQ. 3.OR.IPRO.EQ. 4.OR.IPRO.EQ.10.OR.IPRO.EQ.16
61156 & .OR.IPRO.EQ.19.OR.IPRO.EQ.23.OR.IPRO.EQ.25.OR.IPRO.EQ.26
61157 & .OR.IPRO.EQ.27.OR.IPRO.EQ.95)
61158 & WRITE (6,260) RMASS(201),GAMH,
61159 & GAMMAX,RMASS(201)+GAMMAX*GAMH,(BRHIG(I)*100,I=1,12)
61160 IF (IPRO.EQ.91) WRITE (6,270) BGSHAT,EMMIN,EMMAX
61161 IF (IPRO.EQ.5.AND.IQK.LT.50)
61162 & WRITE (6,280) EMMIN,EMMAX,PTMIN,PTMAX,CTMAX
61163 IF (IPRO.EQ.5.AND.IQK.GE.50)
61164 & WRITE (6,290) EMMIN,EMMAX,Q2MIN,Q2MAX,PTMIN
61165 IF (IPRO.GT.12.AND.
61166 & (IPRO.LT.90.AND.(ABS(IDB).EQ.11.OR.ABS(IDB).EQ.13).OR.
61167 & (ABS(IDT).EQ.11.OR.ABS(IDT).EQ.13))) THEN
61168 WRITE (6,300) Q2WWMN,Q2WWMX,YWWMIN,YWWMAX
61169 IF (PHOMAS.GT.ZERO) WRITE (6,310) PHOMAS
61171 IF (IPROC/10.EQ.10.OR.IPRO.EQ.90)
61172 & WRITE (6,320) HARDME,SOFTME
61173 C Check minimum mass threshold if ISR switched on
61174 IF ((IPRO.LE.3.OR.IPRO.EQ.6).AND.ZMXISR.GT.ZERO) THEN
61175 TEST=TWO*RMASS(IPART1)**2+ETLIM**2
61176 TEST=FOUR*RMASS(2)**2/TEST
61177 IF (TMNISR.LT.TEST) THEN
61178 WRITE(6,175) TMNISR,TEST
61179 175 FORMAT(10X,'Minimum invariant mass',F10.6,' too low'/
61180 & 10X,'increasing to TMNISR=',F10.6)
61183 WRITE (6,330) TMNISR,ONE-ZMXISR
61185 IF (WHMIN.GT.ZERO .AND. IPRO.GT.12.AND.(IPRO.EQ.90.OR.
61186 & (ABS(IDB).EQ.11.OR.ABS(IDB).EQ.13).OR.
61187 & (ABS(IDT).EQ.11.OR.ABS(IDT).EQ.13))) WRITE (6,340) WHMIN
61188 180 FORMAT(10X,'USE BEAM-TARGET C.M.F. =',L5)
61189 190 FORMAT(10X,'MIN P-T FOR O(AS) DILS =',F10.4)
61190 200 FORMAT(10X,'MIN ABS(Q**2) FOR DILS =',E10.4/
61191 & 10X,'MAX ABS(Q**2) FOR DILS =',E10.4/
61192 & 10X,'BREIT FRAME SHOWERING =',L5)
61193 210 FORMAT(10X,'MIN BJORKEN Y FOR DILS =',F10.4/
61194 & 10X,'MAX BJORKEN Y FOR DILS =',F10.4)
61195 220 FORMAT(10X,'MIN ABS(Q**2) FOR J/PSI=',E10.4/
61196 & 10X,'MAX ABS(Q**2) FOR J/PSI=',E10.4/
61197 & 10X,'BREIT FRAME SHOWERING =',L5/
61198 & 10X,'MAX Z FOR J/PSI =',F10.4)
61199 230 FORMAT(10X,'MAX THRUST FOR 2->3 =',F10.4)
61200 240 FORMAT(10X,'MIN MASS FOR DRELL-YAN =',F10.4/
61201 & 10X,'MAX MASS FOR DRELL-YAN =',F10.4)
61202 250 FORMAT(10X,'MIN P-TRAN FOR 2->2 =',F10.4/
61203 & 10X,'MAX P-TRAN FOR 2->2 =',F10.4)
61204 260 FORMAT(10X,'HIGGS BOSON MASS =',F10.4/
61205 & 10X,'HIGGS BOSON WIDTH =',F10.4/
61206 & 10X,'CUTOFF = EMH +',F4.1,'*GAMH=',F10.4/
61207 & 10X,'HIGGS D DBAR =',F10.4/
61208 & 10X,'BRANCHING U UBAR =',F10.4/
61209 & 10X,'FRACTIONS S SBAR =',F10.4/
61210 & 10X,'(PER CENT) C CBAR =',F10.4/
61211 & 10X,' B BBAR =',F10.4/
61212 & 10X,' T TBAR =',F10.4/
61213 & 10X,' E+ E- =',F10.4/
61214 & 10X,' MU+ MU- =',F10.4/
61215 & 10X,' TAU+ TAU- =',F10.4/
61216 & 10X,' W W =',F10.4/
61217 & 10X,' Z Z =',F10.4/
61218 & 10X,' GAMMA GAMMA =',F10.4)
61219 270 FORMAT(10X,'SCALE FOR BGF IS S-HAT =',L5/
61220 & 10X,'MIN MASS FOR BGF =',F10.4/
61221 & 10X,'MAX MASS FOR BGF =',F10.4)
61222 280 FORMAT(10X,'MIN MASS FOR 2 PHOTONS =',F10.4/
61223 & 10X,'MAX MASS FOR 2 PHOTONS =',F10.4/
61224 & 10X,'MIN PT OF 2 PHOTON CMF =',F10.4/
61225 & 10X,'MAX PT OF 2 PHOTON CMF =',F10.4/
61226 & 10X,'MAX COS THETA IN CMF =',F10.4)
61227 290 FORMAT(10X,'MIN MASS FOR GAMMA + W =',F10.4/
61228 & 10X,'MAX MASS FOR GAMMA + W =',F10.4/
61229 & 10X,'MIN ABS(Q**2) =',E10.4/
61230 & 10X,'MAX ABS(Q**2) =',E10.4/
61231 & 10X,'MIN PT =',F10.4)
61232 300 FORMAT(10X,'MIN Q**2 FOR WW PHOTON =',F10.4/
61233 & 10X,'MAX Q**2 FOR WW PHOTON =',F10.4/
61234 & 10X,'MIN MOMENTUM FRACTION =',F10.4/
61235 & 10X,'MAX MOMENTUM FRACTION =',F10.4)
61236 310 FORMAT(10X,'GAMMA* S.F. MASS PARAM =',F10.4)
61237 320 FORMAT(10X,'HARD M.E. MATCHING =',L5/
61238 & 10X,'SOFT M.E. MATCHING =',L5)
61239 330 FORMAT(10X,'MIN MTM FRAC FOR ISR =',1PE10.4/
61240 & 10X,'1-MAX MTM FRAC FOR ISR =',1PE10.4)
61241 340 FORMAT(10X,'MINIMUM HADRONIC MASS =',F10.4)
61242 IF (LWEVT.LE.0) THEN
61245 WRITE (6,360) LWEVT
61247 350 FORMAT(/10X,'NO EVENTS WILL BE WRITTEN TO DISK')
61248 360 FORMAT(/10X,'EVENTS WILL BE OUTPUT ON UNIT',I4)
61250 C Verify and print beam polarisations
61251 IF((IPRO.EQ.1.OR.IPRO.EQ.3).OR.
61252 & ((IPRO.EQ.9).AND.(MOD(IPROC,10000).EQ.960)).OR.
61253 & ((IPRO.EQ.9).AND.(MOD(IPROC,10000).EQ.970)))THEN
61254 C Set up transverse polarisation parameters for e+e-
61255 IF ((EPOLN(1)**2+EPOLN(2)**2)
61256 & *(PPOLN(1)**2+PPOLN(2)**2).GT.ZERO) THEN
61258 COSS=EPOLN(1)*PPOLN(1)-EPOLN(2)*PPOLN(2)
61259 SINS=EPOLN(2)*PPOLN(1)+EPOLN(1)*PPOLN(2)
61263 C print out lepton beam polarisation(s)
61264 IF (IPRINT.NE.0) THEN
61265 IF (IPART1.EQ.121) THEN
61266 WRITE (6,370) PART1,EPOLN,PART2,PPOLN
61268 WRITE (6,370) PART1,PPOLN,PART2,EPOLN
61270 370 FORMAT(/10X,A8,'Beam polarisation=',3F10.4/
61271 & 10X,A8,'Beam polarisation=',3F10.4)
61273 ELSEIF (IPRO.GE.90.AND.IPRO.LE.99) THEN
61274 IF (IDB.GE.11.AND.IDB.LE.16) THEN
61275 CALL HWVZRO(3,PPOLN)
61276 C Check neutrino polarisations for DIS
61277 IF (IDB.EQ. 12.OR.IDB.EQ. 14.OR.IDB.EQ. 16.AND.
61278 & EPOLN(3).NE.-ONE) EPOLN(3)=-ONE
61279 IF (IPRINT.NE.0) WRITE(6,380) PART1,EPOLN(3)
61281 CALL HWVZRO(3,EPOLN)
61282 C Check anti-neutrino polarisations for DIS
61283 IF (IDB.EQ.-12.OR.IDB.EQ.-14.OR.IDB.EQ.-16.AND.
61284 & PPOLN(3).NE.ONE) PPOLN(3)=ONE
61285 IF (IPRINT.NE.0) WRITE(6,380) PART1,PPOLN(3)
61287 380 FORMAT(/10X,A8,1X,'Longitudinal beam polarisation=',F10.4/)
61289 IF (IPRINT.NE.0) THEN
61291 WRITE(6,390) RMASS(200),RMASS(202),GAMZ,GAMZP
61292 WRITE(6,400) (RNAME(I),VFCH(I,1),AFCH(I,1),VFCH(I,2),
61294 WRITE(6,400) (RNAME(110+I),VFCH(I,1),AFCH(I,1),
61295 & VFCH(I,2),AFCH(I,2),I=11,16)
61296 390 FORMAT(/10X,'MASSIVE NEUTRAL VECTOR BOSON PARAMS'/
61297 & 10X,'Z MASS=',F10.4,7X,'Z-PRIME MASS=',F10.4/
61298 & 10X,' WIDTH=',F10.4,7X,' WIDTH=',F10.4/
61299 & 10X,'FERMION COUPLINGS: e.(V.1+A.G_5)G_mu'/
61300 & 10X,'FERMION: VECTOR AXIAL',6X,
61302 400 FORMAT(10X,A8,2X,F10.4,1X,F10.4,1X,F10.4,1X,F10.4)
61305 WRITE(6,410) XMIX(2),YMIX(2),XMIX(1),YMIX(1)
61306 410 FORMAT(/10X,'B_d: Delt-M/Gam =',F6.4,
61307 & ' Delt-Gam/2*Gam =',F6.4,/
61308 & 10X,'B_s: Delt-M/Gam =',F6.2,
61309 & ' Delt-Gam/2*Gam =',F6.4)
61311 IF (CLRECO) WRITE(6,420) PRECO,EXAG
61312 420 FORMAT(/10X,'Colour rearrangement ALLOWED, probability =',F6.4,/
61313 & 10x,'Weak boson life-time exaggeration factor =',F10.6)
61314 C---PDF STRUCTURE FUNCTIONS
61317 IF (MODPDF(I).GE.0) THEN
61318 WRITE (6,430) I,MODPDF(I),AUTPDF(I)
61322 430 FORMAT(10X,'PDFLIB USED FOR BEAM',I2,': SET',I3,' OF ',A20)
61323 440 FORMAT(10X,'PDFLIB NOT USED FOR BEAM',I2)
61325 C---GET THE UGLY INITIALISATION MESSAGES OVER AND DONE WITH NOW TOO
61327 IF (MODPDF(I).GE.0) THEN
61329 VAL(1)=FLOAT(MODPDF(I))
61335 C---FIX TO CALL SCHULER-SJOSTRAND CODE
61336 IF (AUTPDF(I).EQ.'SaSph') THEN
61337 ISET=MOD(MODPDF(I),10)
61338 IOP1=MOD(MODPDF(I)/10,2)
61339 IOP2=MOD(MODPDF(I)/20,2)
61341 IF (ISET.EQ.1) THEN
61342 WRITE (6,'(10X,A)')'SCHULER-SJOSTRAND PHOTON PDF SET 1D'
61343 ELSEIF (ISET.EQ.2) THEN
61344 WRITE (6,'(10X,A)')'SCHULER-SJOSTRAND PHOTON PDF SET 1M'
61345 ELSEIF (ISET.EQ.3) THEN
61346 WRITE (6,'(10X,A)')'SCHULER-SJOSTRAND PHOTON PDF SET 2D'
61347 ELSEIF (ISET.EQ.4) THEN
61348 WRITE (6,'(10X,A)')'SCHULER-SJOSTRAND PHOTON PDF SET 2M'
61350 WRITE (6,'(10X,A)')'UNKNOWN SCHULER-SJOSTRAND PDF SET'
61351 CALL HWWARN('HWUINC',500)
61353 IF (IOP1.EQ.1) THEN
61354 WRITE (6,'(10X,A)') 'WITH DIRECT COMPONENT IN DIS'
61355 IF (IPRO.NE.90) WRITE (6,'(10X,A)')
61356 $ 'NOT RECOMMENDED FOR NON-DIS PROCESSES'
61358 IF (IOP2.EQ.1) THEN
61359 WRITE (6,'(10X,A)') 'WITH P**2 DEPENDENCE INCLUDED'
61360 IF (PHOMAS.GT.ZERO)
61361 $ WRITE (6,'(10X,A)') 'NOT RECOMMENDED WITH PHOMAS.GT.0'
61363 $ WRITE (6,'(10X,A,I2)') 'WITH IP2 OPTION EQUAL TO',IP2
61365 ELSEIF (AUTPDF(I).EQ.'SSph') THEN
61366 WRITE (6,'(10X,A)') 'THE ACRONYM FOR SCHULER-SJOSTRAND'
61367 WRITE (6,'(10X,A)') 'HAS CHANGED TO SaSph ACCORDING TO'
61368 WRITE (6,'(10X,A)') 'THEIR WISHES. SSph NO LONGER WORKS'
61371 CALL PDFSET_HERWIG(PARM,VAL)
61372 CALL STRUCTM(X,QSCA,UPV,DNV,USEA,DSEA,STR,CHM,BTM,TOP,GLU)
61378 C Set up neutral B meson mixing parameters
61379 IF (MIXING.AND..NOT.(RSTAB(223).AND.RSTAB(247))) THEN
61380 XMRCT(1)=XMIX(1)*RMASS(223)/(CSPEED*RLTIM(223))
61381 YMRCT(1)=YMIX(1)*RMASS(223)/(CSPEED*RLTIM(223))
61383 IF (MIXING.AND..NOT.(RSTAB(221).AND.RSTAB(245))) THEN
61384 XMRCT(2)=XMIX(2)*RMASS(221)/(CSPEED*RLTIM(221))
61385 YMRCT(2)=YMIX(2)*RMASS(221)/(CSPEED*RLTIM(221))
61387 C---B DECAY PACKAGE
61388 IF (BDECAY.EQ.'EURO') THEN
61389 IF (IPRINT.NE.0) WRITE (6,470) 'EURODEC'
61390 ELSEIF (BDECAY.EQ.'CLEO') THEN
61391 IF (IPRINT.NE.0) WRITE (6,470) 'CLEO'
61395 470 FORMAT (10X,A,' B DECAY PACKAGE WILL BE USED')
61396 C---TAU DECAY PACKAGE
61397 IF(TAUDEC.EQ.'TAUOLA') THEN
61398 IF(IPRINT.NE.0) WRITE(6,475) 'TAUOLA'
61399 CALL HWDTAU(-1,0,0.0D0)
61401 475 FORMAT(10X,A,' TAU DECAY PACKAGE WILL BE USED'/)
61402 C---COMPUTE PARTICLE PROPERTIES FOR HADRONIZATION
61404 C Prepare internal decay tables and do diagnostic checks
61406 C Convert ampersands to backslahes in particle LaTeX names
61408 C---MISCELLANEOUS DERIVED QUANTITIES
61409 TMTOP=2.*LOG(RMASS(6)/30.)
61410 PXRMS=PTRMS/SQRT(2.)
61412 PSPLT(1)=1./PSPLT(1)
61413 PSPLT(2)=1./PSPLT(2)
61418 PGS=HWUPCM(RMASS(13),RMASS(I),RMASS(I))
61419 IF (PGS.GE.ZERO) NGSPL=I
61420 IF (PGS.GE.PGSMX) PGSMX=PGS
61422 CALL HWVZRO(6,PTINT)
61423 IF (IPRO.NE.80) THEN
61424 C---SET UP TABLES OF SUDAKOV FORM FACTORS, GIVING
61425 C PROBABILITY DISTRIBUTION IN VARIABLE Q = E*SQRT(XI)
61428 C---SET PARAMETERS FOR SPACELIKE BRANCHING
61431 IF (QEV(J,I).GT.QSPAC) GOTO 500
61437 C--optimize the weights for the channels if needed
61439 C--perform the initialisation of the SUSY ME's
61440 IF(SYSPIN.OR.THREEB.OR.FOURB) THEN
61442 IF (IPRINT.NE.0) WRITE (6,510)
61443 510 FORMAT(/10X,'CHECKING SUSY DECAY MATRIX ELEMENTS')
61445 C Print particle decay tables here
61446 IF (IPRINT.GE.2) CALL HWUDPR
61447 C-- initialise photos if needed
61448 IF ((TAUDEC.EQ.'TAUOLA'.AND.IFPHOT.EQ.1).OR.ITOPRD.EQ.1)
61452 *CMZ :- -16/10/93 12.42.15 by Mike Seymour
61453 *-- Author : Bryan Webber
61454 C-----------------------------------------------------------------------
61456 C-----------------------------------------------------------------------
61457 C INITIALISES AN EVENT
61458 C-----------------------------------------------------------------------
61459 INCLUDE 'herwig65.inc'
61460 DOUBLE PRECISION HWRGEN,HWRGET,DUMMY
61462 LOGICAL CALLED,HWRLOG
61463 EXTERNAL HWRGEN,HWRGET,HWRLOG
61464 COMMON/HWDBUG/CALLED
61465 C---CHECK THAT MAIN PROGRAM HAS BEEN MODIFIED CORRECTLY
61466 IF (NEVHEP.GT.0.AND..NOT.CALLED) THEN
61468 10 FORMAT (1X,'A call to the subroutine HWUFNE should be added to',
61469 & /,' the main program, immediately after the call to HWMEVT')
61470 CALL HWWARN('HWUINE',500)
61473 C---CHECK TIME LEFT
61475 IF (TL.LT.TLOUT) CALL HWWARN('HWUINE',200)
61476 C---UPDATE RANDOM NUMBER SEED
61477 DUMMY = HWRGET(NRN)
61479 IF (NEGWTS.AND.EVWGT.LT.ZERO) NNEGEV=NNEGEV+1
61487 C---DECIDE WHETHER TO GENERATE SOFT UNDERLYING EVENT
61488 GENSOF=IPROC.GE.1300.AND.IPROC.LT.10000.AND.
61489 & (IPROC.EQ.8000.OR.HWRLOG(PRSOF))
61491 CALL HWVZRI(2*NMXHEP,JMOHEP)
61492 CALL HWVZRI(2*NMXHEP,JDAHEP)
61493 CALL HWVZRO(4*NMXHEP,VHEP)
61494 CALL HWVZRO(3*NMXHEP,RHOHEP)
61498 CALL HWVZRI( NMXHEP,ISNHEP)
61499 CALL HWVZRI( NMXSPN,JMOSPN)
61500 CALL HWVZRI(2*NMXSPN,JDASPN)
61501 CALL HWVZRI( NMXSPN, IDSPN)
61505 *CMZ :- -05/11/95 19.33.42 by Mike Seymour
61506 *-- Author : Adapted by Bryan Webber
61507 C-----------------------------------------------------------------------
61508 SUBROUTINE HWULB4(PS,PI,PF)
61509 C-----------------------------------------------------------------------
61510 C TRANSFORMS PI (GIVEN IN REST FRAME OF PS) INTO PF (IN LAB)
61511 C N.B. P(1,2,3,4) = (PX,PY,PZ,E); PS(5)=M
61512 C-----------------------------------------------------------------------
61514 DOUBLE PRECISION PF4,FN,PS(5),PI(4),PF(4)
61515 IF (PS(4).EQ.PS(5)) THEN
61521 PF4 = (PI(1)*PS(1)+PI(2)*PS(2)
61522 & +PI(3)*PS(3)+PI(4)*PS(4))/PS(5)
61523 FN = (PF4+PI(4)) / (PS(4)+PS(5))
61524 PF(1)= PI(1) + FN*PS(1)
61525 PF(2)= PI(2) + FN*PS(2)
61526 PF(3)= PI(3) + FN*PS(3)
61531 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
61532 *-- Author : Bryan Webber
61533 C----------------------------------------------------------------------
61534 FUNCTION HWULDO(P,Q)
61535 C----------------------------------------------------------------------
61536 C LORENTZ 4-VECTOR DOT PRODUCT
61537 C----------------------------------------------------------------------
61539 DOUBLE PRECISION HWULDO,P(4),Q(4)
61540 HWULDO=P(4)*Q(4)-(P(1)*Q(1)+P(2)*Q(2)+P(3)*Q(3))
61543 *CMZ :- -05/11/95 19.33.42 by Mike Seymour
61544 *-- Author : Adapted by Bryan Webber
61545 C-----------------------------------------------------------------------
61546 SUBROUTINE HWULF4(PS,PI,PF)
61547 C-----------------------------------------------------------------------
61548 C TRANSFORMS PI (GIVEN IN LAB) INTO PF (IN REST FRAME OF PS)
61549 C N.B. P(1,2,3,4) = (PX,PY,PZ,E); PS(5)=M
61550 C-----------------------------------------------------------------------
61552 DOUBLE PRECISION PF4,FN,PS(5),PI(4),PF(4)
61553 IF (PS(4).EQ.PS(5)) THEN
61559 PF4 = (PI(4)*PS(4)-PI(3)*PS(3)
61560 & -PI(2)*PS(2)-PI(1)*PS(1))/PS(5)
61561 FN = (PF4+PI(4)) / (PS(4)+PS(5))
61562 PF(1)= PI(1) - FN*PS(1)
61563 PF(2)= PI(2) - FN*PS(2)
61564 PF(3)= PI(3) - FN*PS(3)
61569 *CMZ :- -23/08/94 13.22.29 by Mike Seymour
61570 *-- Author : Ulrich Baur & Nigel Glover, adapted by Ian Knowles
61571 C-----------------------------------------------------------------------
61573 C-----------------------------------------------------------------------
61574 C Complex dilogarithm function, Li_2 (Spence function)
61575 C-----------------------------------------------------------------------
61577 DOUBLE COMPLEX HWULI2,PROD,Y,Y2,X,Z
61578 DOUBLE PRECISION XR,XI,R2,A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,ZETA2,
61580 PARAMETER (ZERO=0.0D0, ONE=1.0D0, HALF=0.5D0)
61581 SAVE A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,ZETA2
61582 DATA A1,A2,A3,A4,A5,A6,A7,A8,A9,A10,ZETA2/ -0.250000000000000D0,
61583 & -0.111111111111111D0,-0.010000000000000D0,-0.017006802721088D0,
61584 & -0.019444444444444D0,-0.020661157024793D0,-0.021417300648069D0,
61585 & -0.021948866377231D0,-0.022349233811171D0,-0.022663689135191D0,
61586 & 1.644934066848226D0/
61587 PROD(Y,Y2)=Y*(ONE+A1*Y*(ONE+A2*Y*(ONE+A3*Y2*(ONE+A4*Y2*(ONE+A5*Y2*
61588 & (ONE+A6*Y2*(ONE+A7*Y2*(ONE+A8*Y2*(ONE+A9*Y2*(ONE+A10*Y2))))))))))
61592 IF (R2.GT.ONE.AND.(XR/R2).GT.HALF) THEN
61594 HWULI2=PROD(Z,Z*Z)+ZETA2-LOG(X)*LOG(ONE-X)+HALF*LOG(X)**2
61595 ELSEIF (R2.GT.ONE.AND.(XR/R2).LE.HALF) THEN
61597 HWULI2=-PROD(Z,Z*Z)-ZETA2-HALF*LOG(-X)**2
61598 ELSEIF (R2.EQ.ONE.AND.XI.EQ.ZERO) THEN
61600 ELSEIF (R2.LE.ONE.AND.XR.GT.HALF) THEN
61602 HWULI2=-PROD(Z,Z*Z)+ZETA2-LOG(X)*LOG(ONE-X)
61609 *CMZ :- -05/11/95 19.33.42 by Mike Seymour
61610 *-- Author : Adapted by Bryan Webber
61611 C-----------------------------------------------------------------------
61612 SUBROUTINE HWULOB(PS,PI,PF)
61613 C-----------------------------------------------------------------------
61614 C TRANSFORMS PI (GIVEN IN REST FRAME OF PS) INTO PF (IN LAB)
61615 C N.B. P(1,2,3,4,5) = (PX,PY,PZ,E,M)
61616 C-----------------------------------------------------------------------
61618 DOUBLE PRECISION PS(5),PI(5),PF(5)
61619 CALL HWULB4(PS,PI,PF)
61623 *CMZ :- -05/11/95 19.33.42 by Mike Seymour
61624 *-- Author : Adapted by Bryan Webber
61625 C-----------------------------------------------------------------------
61626 SUBROUTINE HWULOF(PS,PI,PF)
61627 C-----------------------------------------------------------------------
61628 C TRANSFORMS PI (GIVEN IN LAB) INTO PF (IN REST FRAME OF PS)
61629 C N.B. P(1,2,3,4,5) = (PX,PY,PZ,E,M)
61630 C-----------------------------------------------------------------------
61632 DOUBLE PRECISION PS(5),PI(5),PF(5)
61633 CALL HWULF4(PS,PI,PF)
61637 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
61638 *-- Author : Giovanni Abbiendi & Luca Stanco
61639 C-----------------------------------------------------------------------
61640 SUBROUTINE HWULOR (TRANSF,PI,PF)
61641 C-----------------------------------------------------------------------
61642 C Makes the HWULOR transformation specified by TRANSF on the
61643 C quadrivector PI(5), giving PF(5).
61644 C-----------------------------------------------------------------------
61646 DOUBLE PRECISION TRANSF(4,4),PI(5),PF(5)
61653 PF(I) = PF(I) + TRANSF(I,J) * PI(J)
61659 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
61660 *-- Author : Bryan Webber
61661 C-----------------------------------------------------------------------
61662 SUBROUTINE HWUMAS(P)
61663 C-----------------------------------------------------------------------
61664 C PUTS INVARIANT MASS IN 5TH COMPONENT OF VECTOR
61665 C (NEGATIVE SIGN IF SPACELIKE)
61666 C-----------------------------------------------------------------------
61668 DOUBLE PRECISION HWUSQR,P(5)
61670 P(5)=HWUSQR((P(4)+P(3))*(P(4)-P(3))-P(1)**2-P(2)**2)
61673 *CMZ :- -21/02/98 11.11.56 by Bryan Webber
61674 *-- Author : Bryan Webber
61675 C-----------------------------------------------------------------------
61676 FUNCTION HWUMBW(ID)
61677 C-----------------------------------------------------------------------
61678 C CHOOSES MASS ACCORDING TO BREIT-WIGNER DISTRIBUTION
61679 C--BRW fix 27/8/04: changed from mass to mass-squared BW formula
61680 C-----------------------------------------------------------------------
61681 INCLUDE 'herwig65.inc'
61682 DOUBLE PRECISION HWUMBW,HWRGEN,WMX,TAU,GAM,T,TM
61684 C--WMX IS MAX NUMBER OF WIDTHS FROM NOMINAL MASS
61687 IF(ID.EQ.198.OR.ID.EQ.199) THEN
61689 ELSEIF(ID.EQ.200) THEN
61691 ELSEIF(ID.EQ.201) THEN
61696 IF (TAU.EQ.ZERO.OR.TAU.GT.1D-18) RETURN
61698 1 T=TAN(PIFAC*(HWRGEN(0)-HALF))
61699 TM=RMASS(ID)*(RMASS(ID)+GAM*T)
61700 IF(TM.LT.ZERO) GOTO 1
61702 IF (ABS(TM-RMASS(ID)).GT.WMX*GAM) GOTO 1
61706 *CMZ :- -27/07/99 13.33.03 by Mike Seymour
61707 *-- Author : Ian Knowles
61708 C-----------------------------------------------------------------------
61710 C-----------------------------------------------------------------------
61711 C Creates a character string of length 7 equivalent to integer N
61712 C-----------------------------------------------------------------------
61714 INTEGER N,I,M,NN(7)
61715 CHARACTER*1 NCHAR(0:9)
61718 DATA NCHAR/'0','1','2','3','4','5','6','7','8','9'/
61723 WRITE(HWUNST,'(7A1)') (NCHAR(NN(I)),I=1,7)
61726 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
61727 *-- Author : Bryan Webber
61728 C-----------------------------------------------------------------------
61729 FUNCTION HWUPCM(EM0,EM1,EM2)
61730 C-----------------------------------------------------------------------
61731 C C.M. MOMENTUM FOR DECAY MASSES EM0 -> EM1 + EM2
61732 C SET TO -1 BELOW THRESHOLD
61733 C-----------------------------------------------------------------------
61735 DOUBLE PRECISION HWUPCM,EM0,EM1,EM2,EMS,EMD
61738 IF (EM0.LT.EMS.OR.EM0.LT.EMD) THEN
61740 ELSEIF (EM0.EQ.EMS.OR.EM0.EQ.EMD) THEN
61743 HWUPCM=SQRT((EM0+EMD)*(EM0-EMD)*
61744 & (EM0+EMS)*(EM0-EMS))*.5/EM0
61748 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
61749 *-- Author : Bryan Webber
61750 C-----------------------------------------------------------------------
61752 C-----------------------------------------------------------------------
61753 C LONGITUDINAL RAPIDITY (SET TO +/-1000 IF TOO LARGE)
61754 C-----------------------------------------------------------------------
61756 DOUBLE PRECISION HWURAP,EMT2,P(5),ZERO
61757 PARAMETER (ZERO=0.D0)
61758 EMT2=P(1)**2+P(2)**2+P(5)**2
61759 IF (P(3).GT.ZERO) THEN
61760 IF (EMT2.EQ.ZERO) THEN
61763 HWURAP= 0.5*LOG((P(3)+P(4))**2/EMT2)
61765 ELSEIF (P(3).LT.ZERO) THEN
61766 IF (EMT2.EQ.ZERO) THEN
61769 HWURAP=-0.5*LOG((P(3)-P(4))**2/EMT2)
61776 *CMZ :- -26/11/00 17.21.55 by Bryan Webber
61777 *-- Author : Kosuke Odagiri
61778 C-----------------------------------------------------------------------
61779 SUBROUTINE HWUMPO(P,M,PMM,MGAM,PPROJ,FPROP)
61780 C-----------------------------------------------------------------------
61781 C RETURNS PROJECTION OPERATOR 1/(P-SLASH - M + I*MGAM) IN WEYL-BASIS
61782 C USED IN SUBROUTINE HWH2QH
61783 C-----------------------------------------------------------------------
61785 DOUBLE PRECISION P(0:3),M,PMM,MGAM,ZERO,ONE
61786 DOUBLE COMPLEX PROP, PPROJ(4,4), CZERO
61788 PARAMETER (ZERO=0.D0,CZERO=(0.D0,0.D0),ONE=1.D0)
61790 PROP=ONE/DCMPLX(PMM,MGAM)
61792 PROP=DCMPLX(ONE/PMM, ZERO)
61794 PPROJ(1,1) = M*PROP
61797 PPROJ(2,2) = PPROJ(1,1)
61798 PPROJ(1,3) = (P(0)-P(3))*PROP
61799 PPROJ(1,4) = DCMPLX(-P(1),P(2))*PROP
61800 PPROJ(2,3) = DCMPLX(-P(1),-P(2))*PROP
61801 PPROJ(2,4) = (P(0)+P(3))*PROP
61802 PPROJ(3,1) = PPROJ(2,4)
61803 PPROJ(3,2) = -PPROJ(1,4)
61804 PPROJ(4,1) = -PPROJ(2,3)
61805 PPROJ(4,2) = PPROJ(1,3)
61806 PPROJ(3,3) = PPROJ(1,1)
61809 PPROJ(4,4) = PPROJ(1,1)
61812 *CMZ :- -26/11/00 17.21.55 by Bryan Webber
61813 *-- Author : Kosuke Odagiri
61814 C-----------------------------------------------------------------------
61815 SUBROUTINE HWUMPP(M,GPM,PERM,U,UU,LR)
61816 C-----------------------------------------------------------------------
61817 C APPLIES OPERATOR FROM HWUMPO ON SPINORS.
61818 C SPINOR COMPONENTS CAN BE PERMUTATED (PERM) AND TRANSVERSED (LR)
61819 C-----------------------------------------------------------------------
61821 DOUBLE COMPLEX U(4), TEMP, A(4,4), M(16), UU(4), CZERO
61822 DOUBLE PRECISION GPM(2), FAC, ZERO, ONE, MONE
61823 INTEGER LR,TV(4,4,2),I,J, PERM(4), IZERO, GTOF(4)
61824 PARAMETER (ZERO=0.D0,CZERO=(0.D0,0.D0),IZERO=0)
61825 PARAMETER (ONE =1.D0,MONE = -1.D0)
61828 DATA TV/1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,
61829 & 1,5,9,13,2,6,10,14,3,7,11,15,4,8,12,16/
61832 IF ((PERM(I).EQ.IZERO).OR.(FAC.EQ.ZERO)) THEN
61837 IF(FAC.EQ.ONE) THEN
61839 ELSEIF(FAC.EQ.MONE) THEN
61842 TEMP = FAC*U(PERM(I))
61844 IF(TEMP.NE.ZERO) THEN
61846 IF(M(TV(I,J,LR)).NE.ZERO) THEN
61847 A(I,J)=TEMP*M(TV(I,J,LR))
61860 UU(J)=A(1,J)+A(2,J)+A(3,J)+A(4,J)
61864 *CMZ :- -13/02/02 16.42.23 by Peter Richardson
61865 *-- Author : Bryan Webber
61866 C----------------------------------------------------------------------
61868 C----------------------------------------------------------------------
61869 C Prints contents of the GUPI (Generic User Process Interface)
61870 C common block HEPEUP
61871 C----------------------------------------------------------------------
61872 INCLUDE 'herwig65.inc'
61874 PARAMETER (MAXNUP=500)
61875 INTEGER NUP,IDPRUP,IDUP,ISTUP,MOTHUP,ICOLUP
61876 DOUBLE PRECISION XWGTUP,SCALUP,AQEDUP,AQCDUP,PUP,VTIMUP,SPINUP
61877 COMMON/HEPEUP/NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP,
61878 & IDUP(MAXNUP),ISTUP(MAXNUP),MOTHUP(2,MAXNUP),
61879 & ICOLUP(2,MAXNUP),PUP(5,MAXNUP),VTIMUP(MAXNUP),
61884 PRINT *, ' I ISTUP IDUP NAME MOTHUP ICOLUP PUP'
61886 CALL HWUIDT(1,IDUP(IUP),IWIG,NAME)
61887 PRINT 11,IUP,ISTUP(IUP),IDUP(IUP),NAME,MOTHUP(1,IUP),
61888 & MOTHUP(2,IUP),ICOLUP(1,IUP),ICOLUP(2,IUP),(PUP(I,IUP),I=1,5)
61890 11 Format(2I3,I4,2X,A8,2I3,2I4,5F8.1)
61893 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
61894 *-- Author : Ian Knowles & Bryan Webber
61895 C-----------------------------------------------------------------------
61897 C-----------------------------------------------------------------------
61898 C Using properties of particle I supplied in HWUDAT checks particles
61899 C and antiparticles have compatible properties and sets SWTEF(I) =
61900 C ( rep. enhancement factor)^2 - used in cluster decays
61901 C Finds iso-flavour hadrons and creates pointers for cluster decays.
61902 C Sets CLDKWT(K) =(2J+1) spin weight normalizing largest value to 1.
61903 C-----------------------------------------------------------------------
61904 INCLUDE 'herwig65.inc'
61906 PARAMETER (NMXTMP=20)
61907 DOUBLE PRECISION EPS,WTMX,REMMN,RWTMX,WTMP,RESTMP(91),WTMX2,
61908 & REMMN2,WT,CDWTMP(NMXTMP)
61909 INTEGER HWUANT,MAPF(89),MAPC(12,12),I,IANT,IABPDG,J,L,N,K,LTMP,
61910 & NCDKS,IMN,ITMP,LOCTMP(91),NTMP,NCDTMP(NMXTMP),IMN2
61912 PARAMETER (EPS=1.D-6)
61914 DATA MAPF/21,31,41,51,61,12,32,42,52,62,13,23,43,53,63,14,24,34,
61915 & 44,54,64,15,25,35,45,55,65,16,26,36,46,56,66,111,112,113,122,123,
61916 & 133,222,223,233,333,-111,-112,-113,-122,-123,-133,-222,-223,-233,
61917 & -333,114,124,134,224,234,334,-114,-124,-134,-224,-234,-334,115,
61918 & 125,135,225,235,335,-115,-125,-135,-225,-235,-335,116,126,136,
61919 & 226,236,336,-116,-126,-136,-226,-236,-336/
61920 DATA MAPC/90,1,2,47,45,44,48,46,49,3,4,5,6,90,7,50,47,45,51,48,52,
61921 & 8,9,10,11,12,91,51,48,46,52,49,53,13,14,15,37,40,41,6*0,57,69,81,
61922 & 35,37,38,6*0,55,67,79,34,35,36,6*0,54,66,78,38,41,42,6*0,58,70,
61923 & 82,36,38,39,6*0,56,68,80,39,42,43,6*0,59,71,83,16,17,18,63,61,60,
61924 & 64,62,65,19,20,21,22,23,24,75,73,72,76,74,77,25,26,27,28,29,30,
61925 & 87,85,84,88,86,89,31,32,33/
61926 C Check particle/anti-particle properties are compatible
61928 10 FORMAT(/10X,'Checking consistency of particle properties'/)
61930 IF (IDPDG(I).GT.0) THEN
61932 IF (IANT.EQ.20) GOTO 20
61933 IF (MOD(IDPDG(I)/1000,10).EQ.0.AND.
61934 & MOD(IDPDG(I)/100 ,10).NE.0) THEN
61935 IF (MOD(IFLAV(I)/10-IFLAV(IANT),10).NE.0.OR.
61936 & MOD(IFLAV(I)-IFLAV(IANT)/10,10).NE.0)
61937 & WRITE(6,30) RNAME(I),IFLAV(I),IFLAV(IANT)
61939 IF (IFLAV(I)+IFLAV(IANT).NE.0)
61940 & WRITE(6,30) RNAME(I),IFLAV(I),IFLAV(IANT)
61942 IF (ICHRG(I)+ICHRG(IANT).NE.0)
61943 & WRITE(6,40) RNAME(I),RNAME(IANT),ICHRG(I),ICHRG(IANT)
61944 IF (ABS(RMASS(I)-RMASS(IANT)).GT.EPS)
61945 & WRITE(6,50) RNAME(I),RMASS(I),RMASS(IANT)
61946 IF (ABS(RLTIM(I)-RLTIM(IANT)).GT.EPS)
61947 & WRITE(6,60) RNAME(I),RLTIM(I),RLTIM(IANT)
61948 IF (ABS(RSPIN(I)-RSPIN(IANT)).GT.EPS)
61949 & WRITE(6,70) RNAME(I),RSPIN(I),RSPIN(IANT)
61952 30 FORMAT(10X,A8,' flavour code=',I4,5X,' antiparticle=',I4)
61953 40 FORMAT(10X,2A8,' charge =',I2,7X,' antiparticle=',I2)
61954 50 FORMAT(10X,A8,' mass =',F7.3,2X,' antiparticle=',F7.3)
61955 60 FORMAT(10X,A8,' life time =',E9.3,' antiparticle=',E9.3)
61956 70 FORMAT(10X,A8,' spin =',F3.1,6X,' antiparticle=',F3.1)
61957 C Compute resonance properties
61959 C Compute representation weights for hadrons, used in cluster decays
61960 IABPDG=ABS(IDPDG(I))
61962 IF (J.EQ.2.AND.MOD(IABPDG/100,10).LT.MOD(IABPDG/10,10)) THEN
61963 C Singlet (Lambda-like) baryon
61965 ELSEIF (J.EQ.4) THEN
61968 ELSEIF(2*(J/2).NE.J) THEN
61969 C Mesons: identify by spin, angular momentum & radial excitation
61971 L= MOD(IABPDG/10000 ,10)
61972 N= MOD(IABPDG/100000,10)
61973 IF (L.EQ.0.AND.J.EQ.0.AND.N.EQ.0.OR.
61974 & L.GT.3.OR. J.GT.4.OR .N.GT.4) THEN
61977 SWTEF(I)=REPWT(L,J,N)**2
61984 C Prepare tables for cluster decays, except flavourless light mesons
61988 C Store particles, flavour MAPF(I), noting highest spin and lowest mass
61992 IF (VTOCDK(J).OR.IFLAV(J).NE.MAPF(I)) GOTO 90
61994 IF (NCDKS.GT.NMXCDK) THEN
61995 CALL HWWARN('HWURES',101)
61999 CLDKWT(NCDKS)=TWO*RSPIN(J)+ONE
62000 IF (CLDKWT(NCDKS).GT.WTMX) WTMX=CLDKWT(NCDKS)
62001 IF (RMASS(J).LT.REMMN) THEN
62006 IF (NCDKS+1-LTMP.EQ.0) THEN
62007 WRITE(6,100) MAPF(I)
62008 100 FORMAT(1X,'No particles exist for a cluster with flavour, ',I4,
62009 & ' to decay into')
62010 CALL HWWARN('HWURES',51)
62013 C Set scaled spin weights
62015 DO 110 J=LTMP,NCDKS
62016 110 CLDKWT(J)=CLDKWT(J)*RWTMX
62017 C Swap order if lightest hadron of given flavour not first
62018 IF (IMN.NE.LTMP) THEN
62021 NCLDK(LTMP)=NCLDK(IMN)
62022 CLDKWT(LTMP)=CLDKWT(IMN)
62028 RESTMP(I)=FLOAT(NCDKS+1-LTMP)
62031 C Now do flavourless light mesons, allowing for mixing in weights
62038 IF (VTOCDK(J)) THEN
62040 C Calculate mixing weight for (|uubar>+|ddbar>)/sqrt(2) component
62041 ELSEIF (IFLAV(J).EQ.11) THEN
62043 ELSEIF (IFLAV(J).EQ.33) THEN
62046 WT=COS(ETAMIX*PIFAC/180.+ATAN(SQRT(TWO)))**2
62047 ELSEIF (J.EQ.25 ) THEN
62048 WT=SIN(ETAMIX*PIFAC/180.+ATAN(SQRT(TWO)))**2
62050 ELSEIF (J.EQ.56 ) THEN
62051 WT=COS(PHIMIX*PIFAC/180.+ATAN(SQRT(TWO)))**2
62052 ELSEIF (J.EQ.24 ) THEN
62053 WT=SIN(PHIMIX*PIFAC/180.+ATAN(SQRT(TWO)))**2
62055 ELSEIF (J.EQ.58 ) THEN
62056 WT=COS(F2MIX *PIFAC/180.+ATAN(SQRT(TWO)))**2
62057 ELSEIF (J.EQ.26 ) THEN
62058 WT=SIN(F2MIX *PIFAC/180.+ATAN(SQRT(TWO)))**2
62059 C f_1(1420) - f_1(1285)
62060 ELSEIF (J.EQ.57 ) THEN
62061 WT=COS(F1MIX *PIFAC/180.+ATAN(SQRT(TWO)))**2
62062 ELSEIF (J.EQ.28 ) THEN
62063 WT=SIN(F1MIX *PIFAC/180.+ATAN(SQRT(TWO)))**2
62064 C h_1(1380) - h_1(1170)
62065 ELSEIF (J.EQ.289) THEN
62066 WT=COS(H1MIX *PIFAC/180.+ATAN(SQRT(TWO)))**2
62067 ELSEIF (J.EQ.288) THEN
62068 WT=SIN(H1MIX *PIFAC/180.+ATAN(SQRT(TWO)))**2
62069 C MISSING - f_0(1370)
62070 ELSEIF (J.EQ.294) THEN
62071 WT=SIN(F0MIX *PIFAC/180.+ATAN(SQRT(TWO)))**2
62073 ELSEIF (J.EQ.396) THEN
62074 WT=COS(PH3MIX*PIFAC/180.+ATAN(SQRT(TWO)))**2
62075 ELSEIF (J.EQ.395) THEN
62076 WT=SIN(PH3MIX*PIFAC/180.+ATAN(SQRT(TWO)))**2
62077 C eta_2(1645) - eta_2(1870)
62078 ELSEIF (J.EQ.397) THEN
62079 WT=COS(ET2MIX*PIFAC/180.+ATAN(SQRT(TWO)))**2
62080 ELSEIF (J.EQ.398) THEN
62081 WT=SIN(ET2MIX*PIFAC/180.+ATAN(SQRT(TWO)))**2
62082 C MISSING - omega(1600)
62083 ELSEIF (J.EQ.399) THEN
62084 WT=SIN(OMHMIX*PIFAC/180.+ATAN(SQRT(TWO)))**2
62088 130 FORMAT(1X,'Isoscalar particle ',I3,' not recognised,',
62089 & ' no I=0 mixing assumed')
62094 IF (WT.GT.EPS) THEN
62096 IF (NCDKS.GT.NMXCDK) THEN
62097 CALL HWWARN('HWURES',102)
62101 CLDKWT(NCDKS)=WT*(TWO*RSPIN(J)+ONE)
62102 IF (CLDKWT(NCDKS).GT.WTMX) WTMX=CLDKWT(NCDKS)
62103 IF (RMASS(J).LT.REMMN) THEN
62108 IF (ONE-WT.GT.EPS) THEN
62110 IF (NTMP.GT.NMXTMP) THEN
62111 CALL HWWARN('HWURES',103)
62115 CDWTMP(NTMP)=(ONE-WT)*(TWO*RSPIN(J)+ONE)
62116 IF (CDWTMP(NTMP).GT.WTMX2) WTMX2=CDWTMP(NTMP)
62117 IF (RMASS(J).LT.REMMN2) THEN
62123 IF (NCDKS+1-LTMP.EQ.0) THEN
62125 CALL HWWARN('HWURES',52)
62128 C Normalize scaled spin weights
62130 DO 150 I=LTMP,NCDKS
62131 150 CLDKWT(I)=CLDKWT(I)*RWTMX
62132 C Swap order if lightest hadron of flavour 11 not first
62133 IF (IMN.NE.LTMP) THEN
62136 NCLDK(LTMP)=NCLDK(IMN)
62137 CLDKWT(LTMP)=CLDKWT(IMN)
62141 160 IF (NTMP.EQ.0) THEN
62143 CALL HWWARN('HWURES',53)
62146 IF (NCDKS+NTMP.GT.NMXCDK) THEN
62147 CALL HWWARN('HWURES',104)
62150 C Store hadrons for |ssbar> channel and normalize their weights
62155 170 CLDKWT(J)=CDWTMP(I)*RWTMX
62156 C Swap order if lightest hadron of flavour 33 not first
62157 IF (IMN2.NE.1) THEN
62158 ITMP=NCLDK(NCDKS+1)
62159 WTMP=CLDKWT(NCDKS+1)
62160 NCLDK(NCDKS+1)=NCLDK(NCDKS+IMN2)
62161 CLDKWT(NCDKS+1)=CLDKWT(NCDKS+IMN2)
62162 NCLDK(NCDKS+IMN2)=ITMP
62163 CLDKWT(NCDKS+IMN2)=WTMP
62166 180 LOCTMP(90)=LTMP
62167 RESTMP(90)=FLOAT(NCDKS+1-LTMP)
62169 RESTMP(91)=FLOAT(NTMP)
62170 C Set pointers to hadrons of given flavours for cluster decays
62177 RMIN(I,J)=MIN(RMASS(NCLDK(LOCN(I,1)))+RMASS(NCLDK(LOCN(1,J))),
62178 $ RMASS(NCLDK(LOCN(I,2)))+RMASS(NCLDK(LOCN(2,J))))+1.D-2
62180 LOCN(I,J)=LOCTMP(K)
62181 RESN(I,J)=RESTMP(K)
62182 RMIN(I,J)=RMASS(NCLDK(LOCN(I,J)))
62188 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
62189 *-- Author : Bryan Webber
62190 C-----------------------------------------------------------------------
62191 SUBROUTINE HWUROB(R,P,Q)
62192 C-----------------------------------------------------------------------
62193 C ROTATES VECTORS BY INVERSE OF ROTATION MATRIX R
62194 C-----------------------------------------------------------------------
62196 DOUBLE PRECISION S1,S2,S3,R(3,3),P(3),Q(3)
62197 S1=P(1)*R(1,1)+P(2)*R(2,1)+P(3)*R(3,1)
62198 S2=P(1)*R(1,2)+P(2)*R(2,2)+P(3)*R(3,2)
62199 S3=P(1)*R(1,3)+P(2)*R(2,3)+P(3)*R(3,3)
62205 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
62206 *-- Author : Bryan Webber
62207 C-----------------------------------------------------------------------
62208 SUBROUTINE HWUROF(R,P,Q)
62209 C-----------------------------------------------------------------------
62210 C ROTATES VECTORS BY ROTATION MATRIX R
62211 C-----------------------------------------------------------------------
62213 DOUBLE PRECISION S1,S2,S3,R(3,3),P(3),Q(3)
62214 S1=R(1,1)*P(1)+R(1,2)*P(2)+R(1,3)*P(3)
62215 S2=R(2,1)*P(1)+R(2,2)*P(2)+R(2,3)*P(3)
62216 S3=R(3,1)*P(1)+R(3,2)*P(2)+R(3,3)*P(3)
62222 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
62223 *-- Author : Bryan Webber
62224 C-----------------------------------------------------------------------
62225 SUBROUTINE HWUROT(P,CP,SP,R)
62226 C-----------------------------------------------------------------------
62227 C R IS ROTATION MATRIX TO GET FROM VECTOR P TO Z AXIS, FOLLOWED BY
62228 C A ROTATION BY PSI ABOUT Z AXIS, WHERE CP = COS-PSI, SP = SIN-PSI
62229 C-----------------------------------------------------------------------
62231 DOUBLE PRECISION WN,CP,SP,PTCUT,PP,PT,CT,ST,CF,SF,P(3),R(3,3)
62233 DATA WN,PTCUT/1.D0,1.D-20/
62236 IF (PT.LE.PP*PTCUT) THEN
62249 R(1,1)= CP*CF*CT+SP*SF
62250 R(1,2)= CP*SF*CT-SP*CF
62252 R(2,1)=-CP*SF+SP*CF*CT
62253 R(2,2)= CP*CF+SP*SF*CT
62260 *CMZ :- -17/07/03 11.11.56 by Bryan Webber
62261 *-- Author : Bryan Webber
62262 C----------------------------------------------------------------------
62263 SUBROUTINE HWURQM(SCALE,RQM)
62264 C-----------------------------------------------------------------------
62265 C RUNNING QUARK MASSES (MSBAR, 2-LOOP, 5 FLAVOUR, NO THRESHOLDS)
62266 C ASSUMING RMASS(IQ) IS POLE MASS
62267 C-----------------------------------------------------------------------
62268 INCLUDE 'herwig65.inc'
62269 DOUBLE PRECISION HWUALF,SCALE,ALFAS,P0,C1,CC,MHAT(6),RQM(6)
62272 SAVE P0,C1,MHAT,FIRST
62275 C---INITIALIZE CONSTANTS
62277 C1=3731./(3174.*PIFAC)
62278 CC=C1+4./(3.*PIFAC)
62280 ALFAS=HWUALF(1,RMASS(IQ))
62281 IF (ALFAS.GT.ZERO) THEN
62282 MHAT(IQ)=RMASS(IQ)/(1.+CC*ALFAS)/ALFAS**P0
62284 CALL HWWARN('HWURQM',IQ)
62290 ALFAS=HWUALF(1,SCALE)
62291 CC=(1.+C1*ALFAS)*ALFAS**P0
62293 RQM(IQ)=MHAT(IQ)*CC
62297 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
62298 *-- Author : Adapted by Bryan Webber
62299 C-----------------------------------------------------------------------
62300 SUBROUTINE HWUSOR(A,N,K,IOPT)
62301 C-----------------------------------------------------------------------
62302 C Sort A(N) into ascending order
62303 C IOPT = 1 : return sorted A and index array K
62304 C IOPT = 2 : return index array K only
62305 C-----------------------------------------------------------------------
62307 INTEGER N,I,J,IOPT,K(N),IL(500),IR(500)
62308 DOUBLE PRECISION A(N),B(500)
62310 CALL HWWARN('HWUSOR',100)
62319 2 IF(A(I).GT.A(J)) GOTO 5
62320 IF(IL(J).EQ.0) GOTO 4
62326 5 IF(IR(J).LE.0) GOTO 6
62336 8 IF(IL(J).GT.0) GOTO 20
62340 C---REMOVED OBSOLESCENT ARITHMETIC IF STATEMENT
62341 C$$$ IF(IR(J)) 12,30,13
62342 IF (IR(J).LT.0) THEN
62344 ELSEIF (IR(J).EQ.0) THEN
62349 C---END OF REPLACEMENT ARITHMETIC IF STATEMENT
62354 30 IF(IOPT.EQ.2) RETURN
62360 *CMZ :- -17/10/01 13:59:28 by Peter Richardson
62361 *-- Author : Peter Richardson
62362 C-----------------------------------------------------------------------
62364 C-----------------------------------------------------------------------
62365 C Subroutine to output the contents of the spin common block
62366 C-----------------------------------------------------------------------
62367 INCLUDE 'herwig65.inc'
62369 C--write out the header
62372 WRITE(6,1010) I,IDSPN(I),DECSPN(I),JMOSPN(I),JDASPN(1,I),
62375 1000 FORMAT(/1X,'ISPN',1X,'IDSPN',1X,'DECS',1X,'JMOSPN',1X,' JDASPN '/)
62376 1010 FORMAT( 1X, I4 ,1X, I5 ,1X, L4 ,1X, I6 ,1X, I3,2X,I3)
62379 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
62380 *-- Author : Bryan Webber
62381 C-----------------------------------------------------------------------
62383 C-----------------------------------------------------------------------
62384 C SQUARE ROOT WITH SIGN RETENTION
62385 C-----------------------------------------------------------------------
62387 DOUBLE PRECISION HWUSQR,X
62388 HWUSQR=SIGN(SQRT(ABS(X)),X)
62391 *CMZ :- -26/04/91 10.18.58 by Bryan Webber
62392 *-- Author : Bryan Webber
62393 C-----------------------------------------------------------------------
62394 SUBROUTINE HWUSTA(NAME)
62395 C-----------------------------------------------------------------------
62396 C MAKES PARTICLE TYPE 'NAME' STABLE
62397 C-----------------------------------------------------------------------
62398 INCLUDE 'herwig65.inc'
62401 CALL HWUIDT(3,IPDG,IWIG,NAME)
62402 IF (IWIG.EQ.20) CALL HWWARN('HWUSTA',500)
62404 WRITE (6,10) IWIG,NAME
62405 10 FORMAT(/10X,'PARTICLE TYPE',I4,'=',A8,' SET STABLE')
62408 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
62409 *-- Author : Adapted by Bryan Webber
62410 C-----------------------------------------------------------------------
62411 FUNCTION HWUTAB(F,A,NN,X,MM)
62412 C-----------------------------------------------------------------------
62413 C MODIFIED CERN INTERPOLATION ROUTINE DIVDIF
62414 C-----------------------------------------------------------------------
62416 INTEGER NN,MM,MMAX,N,M,MPLUS,IX,IY,MID,NPTS,IP,I,J,L,ISUB
62417 DOUBLE PRECISION HWUTAB,SUM,X,F(NN),A(NN),T(20),D(20)
62426 IF (A(1).GT.A(N)) GOTO 4
62428 IF (X.GE.A(MID)) GOTO 2
62432 3 IF (IY-IX.GT.1) GOTO 1
62435 IF (X.LE.A(MID)) GOTO 5
62439 6 IF (IY-IX.GT.1) GOTO 4
62440 7 NPTS=M+2-MOD(M,2)
62447 IF ((1.LE.ISUB).AND.(ISUB.LE.N)) GOTO 10
62453 11 IF (IP.LT.NPTS) GOTO 8
62454 EXTRA=NPTS.NE.MPLUS
62456 IF (.NOT.EXTRA) GOTO 12
62458 D(M+2)=(D(M+2)-D(M))/(T(M+2)-T(ISUB))
62462 D(I)=(D(I)-D(I-1))/(T(I)-T(ISUB))
62467 IF (EXTRA) SUM=0.5*(SUM+D(M+2))
62470 SUM=D(J)+(X-T(J))*SUM
62476 *CMZ :- -26/04/91 11.38.43 by Federico Carminati
62477 *-- Author : Federico Carminati
62478 C-----------------------------------------------------------------------
62479 SUBROUTINE HWUTIM(TRES)
62480 C-----------------------------------------------------------------------
62486 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
62487 *-- Author : Bryan Webber
62488 C-----------------------------------------------------------------------
62489 SUBROUTINE HWVDIF(N,P,Q,R)
62490 C-----------------------------------------------------------------------
62491 C VECTOR DIFFERENCE
62492 C-----------------------------------------------------------------------
62495 DOUBLE PRECISION P(N),Q(N),R(N)
62500 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
62501 *-- Author : Bryan Webber
62502 C-----------------------------------------------------------------------
62503 FUNCTION HWVDOT(N,P,Q)
62504 C-----------------------------------------------------------------------
62505 C VECTOR DOT PRODUCT
62506 C-----------------------------------------------------------------------
62509 DOUBLE PRECISION HWVDOT,PQ,P(N),Q(N)
62516 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
62517 *-- Author : Bryan Webber
62518 C-----------------------------------------------------------------------
62519 SUBROUTINE HWVEQU(N,P,Q)
62520 C-----------------------------------------------------------------------
62522 C-----------------------------------------------------------------------
62525 DOUBLE PRECISION P(N),Q(N)
62530 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
62531 *-- Author : Bryan Webber
62532 C-----------------------------------------------------------------------
62533 SUBROUTINE HWVSCA(N,C,P,Q)
62534 C-----------------------------------------------------------------------
62535 C VECTOR TIMES SCALAR
62536 C-----------------------------------------------------------------------
62539 DOUBLE PRECISION C,P(N),Q(N)
62544 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
62545 *-- Author : Bryan Webber
62546 C-----------------------------------------------------------------------
62547 SUBROUTINE HWVSUM(N,P,Q,R)
62548 C-----------------------------------------------------------------------
62550 C-----------------------------------------------------------------------
62553 DOUBLE PRECISION P(N),Q(N),R(N)
62558 *CMZ :- -05/02/98 11.11.56 by Bryan Webber
62559 *-- Author : Bryan Webber
62560 C-----------------------------------------------------------------------
62561 SUBROUTINE HWVZRI(N,IP)
62562 C-----------------------------------------------------------------------
62563 C ZERO INTEGER VECTOR
62564 C-----------------------------------------------------------------------
62571 *CMZ :- -26/04/91 11.11.56 by Bryan Webber
62572 *-- Author : Bryan Webber
62573 C-----------------------------------------------------------------------
62574 SUBROUTINE HWVZRO(N,P)
62575 C-----------------------------------------------------------------------
62577 C-----------------------------------------------------------------------
62580 DOUBLE PRECISION P(N)
62585 *CMZ :- -26/04/91 10.18.58 by Bryan Webber
62586 *-- Author : Bryan Webber
62587 C-----------------------------------------------------------------------
62588 SUBROUTINE HWWARN(SUBRTN,ICODE)
62589 C-----------------------------------------------------------------------
62590 C DEALS WITH ERRORS DURING EXECUTION
62591 C SUBRTN = NAME OF CALLING SUBROUTINE
62592 C ICODE = ERROR CODE: - -1 NONFATAL, KILL EVENT & PRINT NOTHING
62593 C 0- 49 NONFATAL, PRINT WARNING & CONTINUE
62594 C 50- 99 NONFATAL, PRINT WARNING & JUMP
62595 C 100-199 NONFATAL, DUMP & KILL EVENT
62596 C 200-299 FATAL, TERMINATE RUN
62597 C 300-399 FATAL, DUMP EVENT & TERMINATE RUN
62598 C 400-499 FATAL, DUMP EVENT & STOP DEAD
62599 C 500- FATAL, STOP DEAD WITH NO DUMP
62600 C-----------------------------------------------------------------------
62601 INCLUDE 'herwig65.inc'
62604 IF (ICODE.GE.0) WRITE (6,10) SUBRTN,ICODE
62605 10 FORMAT(/' HWWARN CALLED FROM SUBPROGRAM ',A6,': CODE =',I4)
62606 IF (ICODE.LT.0) THEN
62609 ELSEIF (ICODE.LT.100) THEN
62610 WRITE (6,20) NEVHEP,NRN,EVWGT
62611 20 FORMAT(' EVENT',I8,': SEEDS =',I11,' &',I11,
62612 &' WEIGHT =',E11.4/' EVENT SURVIVES. EXECUTION CONTINUES')
62613 IF (ICODE.GT.49) RETURN
62614 ELSEIF (ICODE.LT.200) THEN
62615 WRITE (6,30) NEVHEP,NRN,EVWGT
62616 30 FORMAT(' EVENT',I8,': SEEDS =',I11,' &',I11,
62617 &' WEIGHT =',E11.4/' EVENT KILLED. EXECUTION CONTINUES')
62620 ELSEIF (ICODE.LT.300) THEN
62622 40 FORMAT(' EVENT SURVIVES. RUN ENDS GRACEFULLY')
62625 ELSEIF (ICODE.LT.400) THEN
62627 50 FORMAT(' EVENT KILLED: DUMP FOLLOWS. RUN ENDS GRACEFULLY')
62633 ELSEIF (ICODE.LT.500) THEN
62635 60 FORMAT(' EVENT KILLED: DUMP FOLLOWS. RUN STOPS DEAD')
62642 70 FORMAT(' RUN CANNOT CONTINUE')
62647 *CMZ :- -28/01/92 12.34.44 by Mike Seymour
62648 *-- Author : Luca Stanco
62649 C-----------------------------------------------------------------------
62651 C-----------------------------------------------------------------------
62652 C DUMMY SUBROUTINE: DELETE AND SET BDECAY='EURO'
62653 C IN MAIN PROGRAM IF YOU USE EURODEC DECAY PACKAGE
62654 C-----------------------------------------------------------------------
62658 10 FORMAT(/10X,'IEUPDG CALLED BUT NOT LINKED')
62663 *CMZ :- -28/01/92 12.34.44 by Mike Seymour
62664 *-- Author : Luca Stanco
62665 C-----------------------------------------------------------------------
62667 C-----------------------------------------------------------------------
62668 C DUMMY SUBROUTINE: DELETE AND SET BDECAY='EURO'
62669 C IN MAIN PROGRAM IF YOU USE EURODEC DECAY PACKAGE
62670 C-----------------------------------------------------------------------
62674 10 FORMAT(/10X,'IPDGEU CALLED BUT NOT LINKED')
62679 *CMZ :- -17/10/01 10.03.37 by Peter Richardson
62680 *-- Author : Peter Richardson
62681 C-----------------------------------------------------------------------
62682 SUBROUTINE INIETC(JAK1,JAK2,ITDKRC,IFPHOT)
62683 C-----------------------------------------------------------------------
62684 C DUMMY SUBROUTINE: DELETE AND SET TAUDEC='TAUOLA'
62685 C IN MAIN PROGRAM IF YOU USE TAUOLA DECAY PACKAGE
62686 C-----------------------------------------------------------------------
62688 INTEGER JAK1,JAK2,ITDKRC,IFPHOT
62690 10 FORMAT(/10X,'INIETC CALLED BUT NOT LINKED')
62694 *CMZ :- -17/10/01 10.03.37 by Peter Richardson
62695 *-- Author : Peter Richardson
62696 C-----------------------------------------------------------------------
62698 C-----------------------------------------------------------------------
62699 C DUMMY SUBROUTINE: DELETE AND SET TAUDEC='TAUOLA'
62700 C IN MAIN PROGRAM IF YOU USE TAUOLA DECAY PACKAGE
62701 C-----------------------------------------------------------------------
62704 10 FORMAT(/10X,'INIMAS CALLED BUT NOT LINKED')
62708 *CMZ :- -17/10/01 10.03.37 by Peter Richardson
62709 *-- Author : Peter Richardson
62710 C-----------------------------------------------------------------------
62711 SUBROUTINE INIPHX(CUT)
62712 C-----------------------------------------------------------------------
62713 C DUMMY SUBROUTINE: DELETE AND SET TAUDEC='TAUOLA'
62714 C IN MAIN PROGRAM IF YOU USE TAUOLA DECAY PACKAGE
62715 C-----------------------------------------------------------------------
62717 DOUBLE PRECISION CUT
62719 10 FORMAT(/10X,'INIPHX CALLED BUT NOT LINKED')
62723 *CMZ :- -17/10/01 10.03.37 by Peter Richardson
62724 *-- Author : Peter Richardson
62725 C-----------------------------------------------------------------------
62727 C-----------------------------------------------------------------------
62728 C DUMMY SUBROUTINE: DELETE AND SET TAUDEC='TAUOLA'
62729 C IN MAIN PROGRAM IF YOU USE TAUOLA DECAY PACKAGE
62730 C-----------------------------------------------------------------------
62733 10 FORMAT(/10X,'INITDK CALLED BUT NOT LINKED')
62737 *CMZ :- -17/10/01 10.03.37 by Peter Richardson
62738 *-- Author : Peter Richardson
62739 C-----------------------------------------------------------------------
62741 C-----------------------------------------------------------------------
62742 C DUMMY SUBROUTINE: DELETE AND SET TAUDEC='TAUOLA'
62743 C IN MAIN PROGRAM IF YOU USE TAUOLA DECAY PACKAGE
62744 C-----------------------------------------------------------------------
62747 10 FORMAT(/10X,'PHOINI CALLED BUT NOT LINKED')
62751 *CMZ :- -17/10/01 10.03.37 by Peter Richardson
62752 *-- Author : Peter Richardson
62753 C-----------------------------------------------------------------------
62754 SUBROUTINE PHOTOS(IHEP)
62755 C-----------------------------------------------------------------------
62756 C DUMMY SUBROUTINE: DELETE AND SET TAUDEC='TAUOLA'
62757 C IN MAIN PROGRAM IF YOU USE TAUOLA DECAY PACKAGE
62758 C-----------------------------------------------------------------------
62762 10 FORMAT(/10X,'PHOTOS CALLED BUT NOT LINKED')
62766 *CMZ :- -28/01/92 12.34.44 by Mike Seymour
62767 *-- Author : Luca Stanco
62768 C-----------------------------------------------------------------------
62769 SUBROUTINE QQINIT(QQLERR)
62770 C-----------------------------------------------------------------------
62771 C DUMMY SUBROUTINE: DELETE AND SET BDECAY='CLEO'
62772 C IN MAIN PROGRAM IF YOU USE CLEO DECAY PACKAGE
62773 C-----------------------------------------------------------------------
62777 10 FORMAT(/10X,'QQINIT CALLED BUT NOT LINKED')
62781 *CMZ :- -28/01/92 12.34.44 by Mike Seymour
62782 *-- Author : Luca Stanco
62783 C-----------------------------------------------------------------------
62784 INTEGER FUNCTION QQLMAT(IDL,NDIR)
62785 C-----------------------------------------------------------------------
62786 C. QQLMAT - Given a particle flavor (KF), converts it to QQ particle number
62787 C. (KF = IDPDG code)
62789 C. Inputs : IDL (input particle code)
62790 C NDIR = 1 LUND --> QQ
62791 C NDIR = 2 QQ --> LUND
62793 C. Outputs : QQLMAT (output particle code)
62795 C-----------------------------------------------------------------------
62797 C-- Calling variable
62799 C-- External declaration
62800 C-- Local variables
62803 DATA (AKF(I), I=1,151) /
62804 + 0, 0, 0, 0, 0, 0, 0, 21, -6, -5,
62805 + -4, -3, -1, -2, 6, 5, 4, 3, 1, 2,
62807 + 22, 23, 24, -24, 90, 0, 11, -11, 12, -12,
62808 + 13, -13, 14, -14, 15, -15, 16, -16,20313,-20313,
62809 + 211, -211, 321, -321, 311, -311, 421, -421, 411, -411,
62810 + 431, -431, -521, 521, -511, 511, -531, 531, -541, 541,
62811 + 621, -621, 611, -611, 631, -631, 641, -641, 651, -651,
62812 + 111, 221, 331, 441,20551, 661, 310, 130,10313,-10313,
62813 + 213, -213, 323, -323, 313, -313, 423, -423, 413, -413,
62814 + 433, -433, -523, 523, -513, 513, -533, 533, -543, 543,
62815 + 623, -623, 613, -613, 633, -633, 643, -643, 653, -653,
62816 + 113, 223, 333, 443, 553, 136, 20553, 30553, 40553, 551,
62817 + 10553, 555, 10551,70553,10555, 0, 20213, 20113, -20213, 10441,
62819 + 3122, -3122, 4122, -4122, 4232, -4232, 4132, -4132, 3212, -3212/
62820 DATA (AKF(I), I=152,321) /
62821 + 4212, -4212, 4322, -4322, 4312, -4312, 2212, -2212, 3222, -3222,
62822 + 4222, -4222, 2112, -2112, 3112, -3112, 4112, -4112, 3322, -3322,
62823 + 3312, -3312, 4332, -4332, 6*0,
62824 + 3214, -3214, 4214, -4214, 4324, -4324, 4314, -4314, 2214, -2214,
62825 + 3224, -3224, 4224, -4224, 2114, -2114, 3114, -3114, 4114, -4114,
62826 + 3324, -3324, 3314, -3314, 4334, -4334, 4*0,
62827 + 0, 0, 2224, -2224, 1114, -1114, 3334, -3334, 0, 0,
62828 + 10323, -10323, 20323, -20323, 6*0,
62829 + 30443, 0, 0, 0, 70443, 50553, 60553, 80553, 20443, 0,
62830 + 10411, 20413, 10413, 415,
62831 + -10411,-20413,-10413,-415,
62832 + 10421, 20423, 10423, 425,
62833 + -10421,-20423,-10423,-425,
62834 + 10431, 20433, 10433, 435,
62835 + -10431,-20433,-10433,-435, 0,0,0,0,0,0,
62836 + 10111, 10211,-10211, 115, 215, -215,10221,10331,20223,20333,
62837 + 225, 335, 10223, 10333, 10113, 10213,-10213, 33*0 /
62840 IF (IDL.EQ.AKF(I)) THEN
62847 20 FORMAT(1X,'Lund code particle ',I6,' not recognized')
62848 ELSEIF(NDIR.EQ.2) THEN
62849 QQLMAT = AKF(IDL+21)
62853 30 FORMAT(1X,'Unrecognized option in QQLMAT')
62856 C-----------------------------------------------------------------------
62857 C...SaSgam version 2 - parton distributions of the photon
62858 C...by Gerhard A. Schuler and Torbjorn Sjostrand
62859 C...For further information see Z. Phys. C68 (1995) 607
62860 C...and CERN-TH/96-04 and LU TP 96-2.
62861 C...Program last changed on 18 January 1996.
62863 C!!!Note that one further call parameter - IP2 - has been added
62864 C!!!to the SASGAM argument list compared with version 1.
62866 C...The user should only need to call the SASGAM routine,
62867 C...which in turn calls the auxiliary routines SASVMD, SASANO,
62868 C...SASBEH and SASDIR. The package is self-contained.
62870 C...One particular aspect of these parametrizations is that F2 for
62871 C...the photon is not obtained just as the charge-squared-weighted
62872 C...sum of quark distributions, but differ in the treatment of
62873 C...heavy flavours (in F2 the DIS relation W2 = Q2*(1-x)/x restricts
62874 C...the kinematics range of heavy-flavour production, but the same
62875 C...kinematics is not relevant e.g. for jet production) and, for the
62876 C...'MSbar' fits, in the addition of a Cgamma term related to the
62877 C...separation of direct processes. Schematically:
62878 C...PDF = VMD (rho, omega, phi) + anomalous (d, u, s, c, b).
62879 C...F2 = VMD (rho, omega, phi) + anomalous (d, u, s) +
62880 C... Bethe-Heitler (c, b) (+ Cgamma (d, u, s)).
62881 C...The J/psi and Upsilon states have not been included in the VMD sum,
62882 C...but low c and b masses in the other components should compensate
62883 C...for this in a duality sense.
62885 C...The calling sequence is the following:
62886 C CALL SASGAM(ISET,X,Q2,P2,IP2,F2GM,XPDFGM)
62887 C...with the following declaration statement:
62888 C DIMENSION XPDFGM(-6:6)
62889 C...and, optionally, further information in:
62890 C COMMON/SASCOM/XPVMD(-6:6),XPANL(-6:6),XPANH(-6:6),XPBEH(-6:6),
62892 C COMMON/SASVAL/VXPVMD(-6:6),VXPANL(-6:6),VXPANH(-6:6),VXPDGM(-6:6)
62893 C...Input: ISET = 1 : SaS set 1D ('DIS', Q0 = 0.6 GeV)
62894 C = 2 : SaS set 1M ('MSbar', Q0 = 0.6 GeV)
62895 C = 3 : SaS set 2D ('DIS', Q0 = 2 GeV)
62896 C = 4 : SaS set 2M ('MSbar', Q0 = 2 GeV)
62899 C P2 : P2 value; should be = 0. for an on-shell photon.
62900 C IP2 : scheme used to evaluate off-shell anomalous component.
62901 C = 0 : recommended default, see = 7.
62902 C = 1 : dipole dampening by integration; very time-consuming.
62903 C = 2 : P_0^2 = max( Q_0^2, P^2 )
62904 C = 3 : P'_0^2 = Q_0^2 + P^2.
62905 C = 4 : P_{eff} that preserves momentum sum.
62906 C = 5 : P_{int} that preserves momentum and average
62908 C = 6 : P_{eff}, matched to P_0 in P2 -> Q2 limit.
62909 C = 7 : P_{eff}, matched to P_0 in P2 -> Q2 limit.
62910 C...Output: F2GM : F2 value of the photon (including factors of alpha_em).
62911 C XPFDGM : x times parton distribution functions of the photon,
62912 C with elements 0 = g, 1 = d, 2 = u, 3 = s, 4 = c, 5 = b,
62913 C 6 = t (always empty!), - for antiquarks (result is same).
62914 C...The breakdown by component is stored in the commonblock SASCOM,
62915 C with elements as above.
62916 C XPVMD : rho, omega, phi VMD part only of output.
62917 C XPANL : d, u, s anomalous part only of output.
62918 C XPANH : c, b anomalous part only of output.
62919 C XPBEH : c, b Bethe-Heitler part only of output.
62920 C XPDIR : Cgamma (direct contribution) part only of output.
62921 C...The above arrays do not distinguish valence and sea contributions,
62922 C...although this information is available internally. The additional
62923 C...commonblock SASVAL provides the valence part only of the above
62924 C...distributions. Array names VXPVMD, VXPANL and VXPANH correspond
62925 C...to XPVMD, XPANL and XPANH, while XPBEH and XPDIR are valence only
62926 C...and therefore not given doubly. VXPDGM gives the sum of valence
62927 C...parts, and so matches XPDFGM. The difference, i.e. XPVMD-VXPVMD
62928 C...and so on, gives the sea part only.
62930 SUBROUTINE SASGAM(ISET,X,Q2,P2,IP2,F2GM,XPDFGM)
62931 C...Purpose: to construct the F2 and parton distributions of the photon
62932 C...by summing homogeneous (VMD) and inhomogeneous (anomalous) terms.
62933 C...For F2, c and b are included by the Bethe-Heitler formula;
62934 C...in the 'MSbar' scheme additionally a Cgamma term is added.
62935 DIMENSION XPDFGM(-6:6)
62936 COMMON/SASCOM/XPVMD(-6:6),XPANL(-6:6),XPANH(-6:6),XPBEH(-6:6),
62938 COMMON/SASVAL/VXPVMD(-6:6),VXPANL(-6:6),VXPANH(-6:6),VXPDGM(-6:6)
62939 SAVE /SASCOM/,/SASVAL/
62941 C...Temporary array.
62942 DIMENSION XPGA(-6:6), VXPGA(-6:6)
62943 SAVE PMC,PMB,AEM,AEM2PI,ALAM,FRACU,FRHO,FOMEGA,FPHI,PMRHO,PMPHI,
62945 C...Charm and bottom masses (low to compensate for J/psi etc.).
62946 DATA PMC/1.3/, PMB/4.6/
62947 C...alpha_em and alpha_em/(2*pi).
62948 DATA AEM/0.007297/, AEM2PI/0.0011614/
62949 C...Lambda value for 4 flavours.
62951 C...Mixture u/(u+d), = 0.5 for incoherent and = 0.8 for coherent sum.
62953 C...VMD couplings f_V**2/(4*pi).
62954 DATA FRHO/2.20/, FOMEGA/23.6/, FPHI/18.4/
62955 C...Masses for rho (=omega) and phi.
62956 DATA PMRHO/0.770/, PMPHI/1.020/
62957 C...Number of points in integration for IP2=1.
62975 C...Check that input sensible.
62976 IF(ISET.LE.0.OR.ISET.GE.5) THEN
62977 WRITE(*,*) ' FATAL ERROR: SaSgam called for unknown set'
62978 WRITE(*,*) ' ISET = ',ISET
62981 IF(X.LE.0..OR.X.GT.1.) THEN
62982 WRITE(*,*) ' FATAL ERROR: SaSgam called for unphysical x'
62983 WRITE(*,*) ' X = ',X
62987 C...Set Q0 cut-off parameter as function of set used.
62995 C...Scale choice for off-shell photon; common factors.
63000 Q2A=Q2+P2*Q02/MAX(Q02,Q2)
63001 FACNOR=LOG(Q2/Q02)/NSTEP
63002 ELSEIF(IP2.EQ.2) THEN
63004 ELSEIF(IP2.EQ.3) THEN
63006 Q2A=Q2+P2*Q02/MAX(Q02,Q2)
63007 ELSEIF(IP2.EQ.4) THEN
63008 P2MX=Q2*(Q02+P2)/(Q2+P2)*EXP(P2*(Q2-Q02)/
63009 & ((Q2+P2)*(Q02+P2)))
63010 ELSEIF(IP2.EQ.5) THEN
63011 P2MXA=Q2*(Q02+P2)/(Q2+P2)*EXP(P2*(Q2-Q02)/
63012 & ((Q2+P2)*(Q02+P2)))
63013 P2MX=Q0*SQRT(P2MXA)
63014 FACNOR=LOG(Q2/P2MXA)/LOG(Q2/P2MX)
63015 ELSEIF(IP2.EQ.6) THEN
63016 P2MX=Q2*(Q02+P2)/(Q2+P2)*EXP(P2*(Q2-Q02)/
63017 & ((Q2+P2)*(Q02+P2)))
63018 P2MX=MAX(0.,1.-P2/Q2)*P2MX+MIN(1.,P2/Q2)*MAX(P2,Q02)
63020 P2MXA=Q2*(Q02+P2)/(Q2+P2)*EXP(P2*(Q2-Q02)/
63021 & ((Q2+P2)*(Q02+P2)))
63022 P2MX=Q0*SQRT(P2MXA)
63024 P2MX=MAX(0.,1.-P2/Q2)*P2MX+MIN(1.,P2/Q2)*MAX(P2,Q02)
63025 P2MXB=MAX(0.,1.-P2/Q2)*P2MXB+MIN(1.,P2/Q2)*P2MXA
63026 FACNOR=LOG(Q2/P2MXA)/LOG(Q2/P2MXB)
63029 C...Call VMD parametrization for d quark and use to give rho, omega,
63030 C...phi. Note dipole dampening for off-shell photon.
63031 CALL SASVMD(ISET,1,X,Q2A,P2MX,ALAM,XPGA,VXPGA)
63035 FACUD=AEM*(1./FRHO+1./FOMEGA)*(PMRHO**2/(PMRHO**2+P2))**2
63036 FACS=AEM*(1./FPHI)*(PMPHI**2/(PMPHI**2+P2))**2
63038 XPVMD(KFL)=(FACUD+FACS)*XPGA(KFL)
63040 XPVMD(1)=XPVMD(1)+(1.-FRACU)*FACUD*XFVAL
63041 XPVMD(2)=XPVMD(2)+FRACU*FACUD*XFVAL
63042 XPVMD(3)=XPVMD(3)+FACS*XFVAL
63043 XPVMD(-1)=XPVMD(-1)+(1.-FRACU)*FACUD*XFVAL
63044 XPVMD(-2)=XPVMD(-2)+FRACU*FACUD*XFVAL
63045 XPVMD(-3)=XPVMD(-3)+FACS*XFVAL
63046 VXPVMD(1)=(1.-FRACU)*FACUD*XFVAL
63047 VXPVMD(2)=FRACU*FACUD*XFVAL
63048 VXPVMD(3)=FACS*XFVAL
63049 VXPVMD(-1)=(1.-FRACU)*FACUD*XFVAL
63050 VXPVMD(-2)=FRACU*FACUD*XFVAL
63051 VXPVMD(-3)=FACS*XFVAL
63054 C...Anomalous parametrizations for different strategies
63055 C...for off-shell photons; except full integration.
63057 C...Call anomalous parametrization for d + u + s.
63058 CALL SASANO(-3,X,Q2A,P2MX,ALAM,XPGA,VXPGA)
63060 XPANL(KFL)=FACNOR*XPGA(KFL)
63061 VXPANL(KFL)=FACNOR*VXPGA(KFL)
63064 C...Call anomalous parametrization for c and b.
63065 CALL SASANO(4,X,Q2A,P2MX,ALAM,XPGA,VXPGA)
63067 XPANH(KFL)=FACNOR*XPGA(KFL)
63068 VXPANH(KFL)=FACNOR*VXPGA(KFL)
63070 CALL SASANO(5,X,Q2A,P2MX,ALAM,XPGA,VXPGA)
63072 XPANH(KFL)=XPANH(KFL)+FACNOR*XPGA(KFL)
63073 VXPANH(KFL)=VXPANH(KFL)+FACNOR*VXPGA(KFL)
63077 C...Special option: loop over flavours and integrate over k2.
63079 DO 160 ISTEP=1,NSTEP
63080 Q2STEP=Q02*(Q2/Q02)**((ISTEP-0.5)/NSTEP)
63081 IF((KF.EQ.4.AND.Q2STEP.LT.PMC**2).OR.
63082 & (KF.EQ.5.AND.Q2STEP.LT.PMB**2)) GOTO 160
63083 CALL SASVMD(0,KF,X,Q2,Q2STEP,ALAM,XPGA,VXPGA)
63084 FACQ=AEM2PI*(Q2STEP/(Q2STEP+P2))**2*FACNOR
63085 IF(MOD(KF,2).EQ.0) FACQ=FACQ*(8./9.)
63086 IF(MOD(KF,2).EQ.1) FACQ=FACQ*(2./9.)
63088 IF(KF.LE.3) XPANL(KFL)=XPANL(KFL)+FACQ*XPGA(KFL)
63089 IF(KF.GE.4) XPANH(KFL)=XPANH(KFL)+FACQ*XPGA(KFL)
63090 IF(KF.LE.3) VXPANL(KFL)=VXPANL(KFL)+FACQ*VXPGA(KFL)
63091 IF(KF.GE.4) VXPANH(KFL)=VXPANH(KFL)+FACQ*VXPGA(KFL)
63097 C...Call Bethe-Heitler term expression for charm and bottom.
63098 CALL SASBEH(4,X,Q2,P2,PMC**2,XPBH)
63101 CALL SASBEH(5,X,Q2,P2,PMB**2,XPBH)
63105 C...For MSbar subtraction call C^gamma term expression for d, u, s.
63106 IF(ISET.EQ.2.OR.ISET.EQ.4) THEN
63107 CALL SASDIR(X,Q2,P2,Q02,XPGA)
63109 XPDIR(KFL)=XPGA(KFL)
63113 C...Store result in output array.
63116 IF(IABS(KFL).EQ.2.OR.IABS(KFL).EQ.4) CHSQ=4./9.
63117 XPF2=XPVMD(KFL)+XPANL(KFL)+XPBEH(KFL)+XPDIR(KFL)
63118 IF(KFL.NE.0) F2GM=F2GM+CHSQ*XPF2
63119 XPDFGM(KFL)=XPVMD(KFL)+XPANL(KFL)+XPANH(KFL)
63120 VXPDGM(KFL)=VXPVMD(KFL)+VXPANL(KFL)+VXPANH(KFL)
63125 C*********************************************************************
63127 SUBROUTINE SASVMD(ISET,KF,X,Q2,P2,ALAM,XPGA,VXPGA)
63128 C...Purpose: to evaluate the VMD parton distributions of a photon,
63129 C...evolved homogeneously from an initial scale P2 to Q2.
63130 C...Does not include dipole suppression factor.
63131 C...ISET is parton distribution set, see above;
63132 C...additionally ISET=0 is used for the evolution of an anomalous photon
63133 C...which branched at a scale P2 and then evolved homogeneously to Q2.
63134 C...ALAM is the 4-flavour Lambda, which is automatically converted
63135 C...to 3- and 5-flavour equivalents as needed.
63136 DIMENSION XPGA(-6:6), VXPGA(-6:6)
63138 DATA PMC/1.3/, PMB/4.6/
63147 C...Calculate Lambda; protect against unphysical Q2 and P2 input.
63148 ALAM3=ALAM*(PMC/ALAM)**(2./27.)
63149 ALAM5=ALAM*(ALAM/PMB)**(2./23.)
63150 P2EFF=MAX(P2,1.2*ALAM3**2)
63151 IF(KFA.EQ.4) P2EFF=MAX(P2EFF,PMC**2)
63152 IF(KFA.EQ.5) P2EFF=MAX(P2EFF,PMB**2)
63153 Q2EFF=MAX(Q2,P2EFF)
63155 C...Find number of flavours at lower and upper scale.
63157 IF(P2EFF.LT.PMC**2) NFP=3
63158 IF(P2EFF.GT.PMB**2) NFP=5
63160 IF(Q2EFF.LT.PMC**2) NFQ=3
63161 IF(Q2EFF.GT.PMB**2) NFQ=5
63163 C...Find s as sum of 3-, 4- and 5-flavour parts.
63167 IF(NFQ.EQ.3) Q2DIV=Q2EFF
63168 S=S+(6./27.)*LOG(LOG(Q2DIV/ALAM3**2)/LOG(P2EFF/ALAM3**2))
63170 IF(NFP.LE.4.AND.NFQ.GE.4) THEN
63172 IF(NFP.EQ.3) P2DIV=PMC**2
63174 IF(NFQ.EQ.5) Q2DIV=PMB**2
63175 S=S+(6./25.)*LOG(LOG(Q2DIV/ALAM**2)/LOG(P2DIV/ALAM**2))
63179 IF(NFP.EQ.5) P2DIV=P2EFF
63180 S=S+(6./23.)*LOG(LOG(Q2EFF/ALAM5**2)/LOG(P2DIV/ALAM5**2))
63183 C...Calculate frequent combinations of x and s.
63190 C...Evaluate homogeneous anomalous parton distributions below or
63191 C...above threshold.
63193 IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR.
63194 &(KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN
63195 XVAL = X * 1.5 * (X**2+X1**2)
63199 XVAL = (1.5/(1.-0.197*S+4.33*S2)*X**2 + (1.5+2.10*S)/
63200 & (1.+3.29*S)*X1**2 + 5.23*S/(1.+1.17*S+19.9*S3)*X*X1) *
63201 & X**(1./(1.+1.5*S)) * (1.-X**2)**(2.667*S)
63202 XGLU = 4.*S/(1.+4.76*S+15.2*S2+29.3*S4) *
63203 & X**(-2.03*S/(1.+2.44*S)) * (X1*XL)**(1.333*S) *
63204 & ((4.*X**2+7.*X+4.)*X1/3. - 2.*X*(1.+X)*XL)
63205 XSEA = S2/(1.+4.54*S+8.19*S2+8.05*S3) *
63206 & X**(-1.54*S/(1.+1.29*S)) * X1**(2.667*S) *
63207 & ((8.-73.*X+62.*X**2)*X1/9. + (3.-8.*X**2/3.)*X*XL +
63208 & (2.*X-1.)*X*XL**2)
63211 C...Evaluate set 1D parton distributions below or above threshold.
63212 ELSEIF(ISET.EQ.1) THEN
63213 IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR.
63214 &(KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN
63215 XVAL = 1.294 * X**0.80 * X1**0.76
63216 XGLU = 1.273 * X**0.40 * X1**1.76
63217 XSEA = 0.100 * X1**3.76
63219 XVAL = 1.294/(1.+0.252*S+3.079*S2) * X**(0.80-0.13*S) *
63220 & X1**(0.76+0.667*S) * XL**(2.*S)
63221 XGLU = 7.90*S/(1.+5.50*S) * EXP(-5.16*S) *
63222 & X**(-1.90*S/(1.+3.60*S)) * X1**1.30 * XL**(0.50+3.*S) +
63223 & 1.273 * EXP(-10.*S) * X**0.40 * X1**(1.76+3.*S)
63224 XSEA = (0.1-0.397*S2+1.121*S3)/(1.+5.61*S2+5.26*S3) *
63225 & X**(-7.32*S2/(1.+10.3*S2)) *
63226 & X1**((3.76+15.*S+12.*S2)/(1.+4.*S))
63227 XSEA0 = 0.100 * X1**3.76
63230 C...Evaluate set 1M parton distributions below or above threshold.
63231 ELSEIF(ISET.EQ.2) THEN
63232 IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR.
63233 &(KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN
63234 XVAL = 0.8477 * X**0.51 * X1**1.37
63235 XGLU = 3.42 * X**0.255 * X1**2.37
63238 XVAL = 0.8477/(1.+1.37*S+2.18*S2+3.73*S3) * X**(0.51+0.21*S)
63239 & * X1**1.37 * XL**(2.667*S)
63240 XGLU = 24.*S/(1.+9.6*S+0.92*S2+14.34*S3) * EXP(-5.94*S) *
63241 & X**((-0.013-1.80*S)/(1.+3.14*S)) * X1**(2.37+0.4*S) *
63242 & XL**(0.32+3.6*S) + 3.42 * EXP(-12.*S) * X**0.255 *
63244 XSEA = 0.842*S/(1.+21.3*S-33.2*S2+229.*S3) *
63245 & X**((0.13-2.90*S)/(1.+5.44*S)) * X1**(3.45+0.5*S) *
63250 C...Evaluate set 2D parton distributions below or above threshold.
63251 ELSEIF(ISET.EQ.3) THEN
63252 IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR.
63253 &(KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN
63254 XVAL = X**0.46 * X1**0.64 + 0.76 * X
63255 XGLU = 1.925 * X1**2
63256 XSEA = 0.242 * X1**4
63258 XVAL = (1.+0.186*S)/(1.-0.209*S+1.495*S2) * X**(0.46+0.25*S)
63259 & * X1**((0.64+0.14*S+5.*S2)/(1.+S)) * XL**(1.9*S) +
63260 & (0.76+0.4*S) * X * X1**(2.667*S)
63261 XGLU = (1.925+5.55*S+147.*S2)/(1.-3.59*S+3.32*S2) *
63262 & EXP(-18.67*S) * X**((-5.81*S-5.34*S2)/(1.+29.*S-4.26*S2))
63263 & * X1**((2.-5.9*S)/(1.+1.7*S)) * XL**(9.3*S/(1.+1.7*S))
63264 XSEA = (0.242-0.252*S+1.19*S2)/(1.-0.607*S+21.95*S2) *
63265 & X**(-12.1*S2/(1.+2.62*S+16.7*S2)) * X1**4 * XL**S
63266 XSEA0 = 0.242 * X1**4
63269 C...Evaluate set 2M parton distributions below or above threshold.
63270 ELSEIF(ISET.EQ.4) THEN
63271 IF(Q2.LE.P2.OR.(KFA.EQ.4.AND.Q2.LT.PMC**2).OR.
63272 &(KFA.EQ.5.AND.Q2.LT.PMB**2)) THEN
63273 XVAL = 1.168 * X**0.50 * X1**2.60 + 0.965 * X
63274 XGLU = 1.808 * X1**2
63275 XSEA = 0.209 * X1**4
63277 XVAL = (1.168+1.771*S+29.35*S2) * EXP(-5.776*S) *
63278 & X**((0.5+0.208*S)/(1.-0.794*S+1.516*S2)) *
63279 & X1**((2.6+7.6*S)/(1.+5.*S)) * XL**(5.15*S/(1.+2.*S)) +
63280 & (0.965+22.35*S)/(1.+18.4*S) * X * X1**(2.667*S)
63281 XGLU = (1.808+29.9*S)/(1.+26.4*S) * EXP(-5.28*S) *
63282 & X**((-5.35*S-10.11*S2)/(1.+31.71*S)) *
63283 & X1**((2.-7.3*S+4.*S2)/(1.+2.5*S)) *
63284 & XL**(10.9*S/(1.+2.5*S))
63285 XSEA = (0.209+0.644*S2)/(1.+0.319*S+17.6*S2) *
63286 & X**((-0.373*S-7.71*S2)/(1.+0.815*S+11.0*S2)) *
63287 & X1**(4.+S) * XL**(0.45*S)
63288 XSEA0 = 0.209 * X1**4
63292 C...Threshold factors for c and b sea.
63293 SLL=LOG(LOG(Q2EFF/ALAM**2)/LOG(P2EFF/ALAM**2))
63295 IF(Q2.GT.PMC**2.AND.Q2.GT.1.001*P2EFF) THEN
63296 SCH=MAX(0.,LOG(LOG(PMC**2/ALAM**2)/LOG(P2EFF/ALAM**2)))
63298 XCHM=XSEA*(1.-(SCH/SLL)**2)
63300 XCHM=MAX(0.,XSEA-XSEA0*X1**(2.667*S))*(1.-SCH/SLL)
63304 IF(Q2.GT.PMB**2.AND.Q2.GT.1.001*P2EFF) THEN
63305 SBT=MAX(0.,LOG(LOG(PMB**2/ALAM**2)/LOG(P2EFF/ALAM**2)))
63307 XBOT=XSEA*(1.-(SBT/SLL)**2)
63309 XBOT=MAX(0.,XSEA-XSEA0*X1**(2.667*S))*(1.-SBT/SLL)
63313 C...Fill parton distributions.
63320 XPGA(KFA)=XPGA(KFA)+XVAL
63322 XPGA(-KFL)=XPGA(KFL)
63329 C*********************************************************************
63331 SUBROUTINE SASANO(KF,X,Q2,P2,ALAM,XPGA,VXPGA)
63332 C...Purpose: to evaluate the parton distributions of the anomalous
63333 C...photon, inhomogeneously evolved from a scale P2 (where it vanishes)
63335 C...KF=0 gives the sum over (up to) 5 flavours,
63336 C...KF<0 limits to flavours up to abs(KF),
63337 C...KF>0 is for flavour KF only.
63338 C...ALAM is the 4-flavour Lambda, which is automatically converted
63339 C...to 3- and 5-flavour equivalents as needed.
63340 DIMENSION XPGA(-6:6), VXPGA(-6:6), ALAMSQ(3:5)
63341 SAVE PMC,PMB,AEM2PI
63342 DATA PMC/1.3/, PMB/4.6/, AEM2PI/0.0011614/
63349 IF(Q2.LE.P2) RETURN
63352 C...Calculate Lambda; protect against unphysical Q2 and P2 input.
63353 ALAMSQ(3)=(ALAM*(PMC/ALAM)**(2./27.))**2
63355 ALAMSQ(5)=(ALAM*(ALAM/PMB)**(2./23.))**2
63356 P2EFF=MAX(P2,1.2*ALAMSQ(3))
63357 IF(KF.EQ.4) P2EFF=MAX(P2EFF,PMC**2)
63358 IF(KF.EQ.5) P2EFF=MAX(P2EFF,PMB**2)
63359 Q2EFF=MAX(Q2,P2EFF)
63362 C...Find number of flavours at lower and upper scale.
63364 IF(P2EFF.LT.PMC**2) NFP=3
63365 IF(P2EFF.GT.PMB**2) NFP=5
63367 IF(Q2EFF.LT.PMC**2) NFQ=3
63368 IF(Q2EFF.GT.PMB**2) NFQ=5
63370 C...Define range of flavour loop.
63374 ELSEIF(KF.LT.0) THEN
63382 C...Loop over flavours the photon can branch into.
63383 DO 110 KFL=KFLMN,KFLMX
63385 C...Light flavours: calculate t range and (approximate) s range.
63386 IF(KFL.LE.3.AND.(KFL.EQ.1.OR.KFL.EQ.KF)) THEN
63387 TDIFF=LOG(Q2EFF/P2EFF)
63388 S=(6./(33.-2.*NFQ))*LOG(LOG(Q2EFF/ALAMSQ(NFQ))/
63389 & LOG(P2EFF/ALAMSQ(NFQ)))
63390 IF(NFQ.GT.NFP) THEN
63392 IF(NFQ.EQ.4) Q2DIV=PMC**2
63393 SNFQ=(6./(33.-2.*NFQ))*LOG(LOG(Q2DIV/ALAMSQ(NFQ))/
63394 & LOG(P2EFF/ALAMSQ(NFQ)))
63395 SNFP=(6./(33.-2.*(NFQ-1)))*LOG(LOG(Q2DIV/ALAMSQ(NFQ-1))/
63396 & LOG(P2EFF/ALAMSQ(NFQ-1)))
63397 S=S+(LOG(Q2DIV/P2EFF)/LOG(Q2EFF/P2EFF))*(SNFP-SNFQ)
63399 IF(NFQ.EQ.5.AND.NFP.EQ.3) THEN
63401 SNF4=(6./(33.-2.*4))*LOG(LOG(Q2DIV/ALAMSQ(4))/
63402 & LOG(P2EFF/ALAMSQ(4)))
63403 SNF3=(6./(33.-2.*3))*LOG(LOG(Q2DIV/ALAMSQ(3))/
63404 & LOG(P2EFF/ALAMSQ(3)))
63405 S=S+(LOG(Q2DIV/P2EFF)/LOG(Q2EFF/P2EFF))*(SNF3-SNF4)
63408 C...u and s quark do not need a separate treatment when d has been done.
63409 ELSEIF(KFL.EQ.2.OR.KFL.EQ.3) THEN
63411 C...Charm: as above, but only include range above c threshold.
63412 ELSEIF(KFL.EQ.4) THEN
63413 IF(Q2.LE.PMC**2) GOTO 110
63414 P2EFF=MAX(P2EFF,PMC**2)
63415 Q2EFF=MAX(Q2EFF,P2EFF)
63416 TDIFF=LOG(Q2EFF/P2EFF)
63417 S=(6./(33.-2.*NFQ))*LOG(LOG(Q2EFF/ALAMSQ(NFQ))/
63418 & LOG(P2EFF/ALAMSQ(NFQ)))
63419 IF(NFQ.EQ.5.AND.NFP.EQ.4) THEN
63421 SNFQ=(6./(33.-2.*NFQ))*LOG(LOG(Q2DIV/ALAMSQ(NFQ))/
63422 & LOG(P2EFF/ALAMSQ(NFQ)))
63423 SNFP=(6./(33.-2.*(NFQ-1)))*LOG(LOG(Q2DIV/ALAMSQ(NFQ-1))/
63424 & LOG(P2EFF/ALAMSQ(NFQ-1)))
63425 S=S+(LOG(Q2DIV/P2EFF)/LOG(Q2EFF/P2EFF))*(SNFP-SNFQ)
63428 C...Bottom: as above, but only include range above b threshold.
63429 ELSEIF(KFL.EQ.5) THEN
63430 IF(Q2.LE.PMB**2) GOTO 110
63431 P2EFF=MAX(P2EFF,PMB**2)
63432 Q2EFF=MAX(Q2,P2EFF)
63433 TDIFF=LOG(Q2EFF/P2EFF)
63434 S=(6./(33.-2.*NFQ))*LOG(LOG(Q2EFF/ALAMSQ(NFQ))/
63435 & LOG(P2EFF/ALAMSQ(NFQ)))
63438 C...Evaluate flavour-dependent prefactor (charge^2 etc.).
63440 IF(KFL.EQ.2.OR.KFL.EQ.4) CHSQ=4./9.
63441 FAC=AEM2PI*2.*CHSQ*TDIFF
63443 C...Evaluate parton distributions (normalized to unit momentum sum).
63444 IF(KFL.EQ.1.OR.KFL.EQ.4.OR.KFL.EQ.5.OR.KFL.EQ.KF) THEN
63445 XVAL= ((1.5+2.49*S+26.9*S**2)/(1.+32.3*S**2)*X**2 +
63446 & (1.5-0.49*S+7.83*S**2)/(1.+7.68*S**2)*(1.-X)**2 +
63447 & 1.5*S/(1.-3.2*S+7.*S**2)*X*(1.-X)) *
63448 & X**(1./(1.+0.58*S)) * (1.-X**2)**(2.5*S/(1.+10.*S))
63449 XGLU= 2.*S/(1.+4.*S+7.*S**2) *
63450 & X**(-1.67*S/(1.+2.*S)) * (1.-X**2)**(1.2*S) *
63451 & ((4.*X**2+7.*X+4.)*(1.-X)/3. - 2.*X*(1.+X)*XL)
63452 XSEA= 0.333*S**2/(1.+4.90*S+4.69*S**2+21.4*S**3) *
63453 & X**(-1.18*S/(1.+1.22*S)) * (1.-X)**(1.2*S) *
63454 & ((8.-73.*X+62.*X**2)*(1.-X)/9. + (3.-8.*X**2/3.)*X*XL +
63455 & (2.*X-1.)*X*XL**2)
63457 C...Threshold factors for c and b sea.
63458 SLL=LOG(LOG(Q2EFF/ALAM**2)/LOG(P2EFF/ALAM**2))
63460 IF(Q2.GT.PMC**2.AND.Q2.GT.1.001*P2EFF) THEN
63461 SCH=MAX(0.,LOG(LOG(PMC**2/ALAM**2)/LOG(P2EFF/ALAM**2)))
63462 XCHM=XSEA*(1.-(SCH/SLL)**3)
63465 IF(Q2.GT.PMB**2.AND.Q2.GT.1.001*P2EFF) THEN
63466 SBT=MAX(0.,LOG(LOG(PMB**2/ALAM**2)/LOG(P2EFF/ALAM**2)))
63467 XBOT=XSEA*(1.-(SBT/SLL)**3)
63471 C...Add contribution of each valence flavour.
63472 XPGA(0)=XPGA(0)+FAC*XGLU
63473 XPGA(1)=XPGA(1)+FAC*XSEA
63474 XPGA(2)=XPGA(2)+FAC*XSEA
63475 XPGA(3)=XPGA(3)+FAC*XSEA
63476 XPGA(4)=XPGA(4)+FAC*XCHM
63477 XPGA(5)=XPGA(5)+FAC*XBOT
63478 XPGA(KFL)=XPGA(KFL)+FAC*XVAL
63479 VXPGA(KFL)=VXPGA(KFL)+FAC*XVAL
63482 XPGA(-KFL)=XPGA(KFL)
63483 VXPGA(-KFL)=VXPGA(KFL)
63488 C*********************************************************************
63490 SUBROUTINE SASBEH(KF,X,Q2,P2,PM2,XPBH)
63491 C...Purpose: to evaluate the Bethe-Heitler cross section for
63492 C...heavy flavour production.
63494 DATA AEM2PI/0.0011614/
63500 C...Check kinematics limits.
63501 IF(X.GE.Q2/(4.*PM2+Q2+P2)) RETURN
63504 IF(BETA2.LT.1E-10) RETURN
63508 C...Simple case: P2 = 0.
63509 IF(P2.LT.1E-4) THEN
63510 IF(BETA.LT.0.99) THEN
63511 XBL=LOG((1.+BETA)/(1.-BETA))
63513 XBL=LOG((1.+BETA)**2*W2/(4.*PM2))
63515 SIGBH=BETA*(8.*X*(1.-X)-1.-RMQ*X*(1.-X))+
63516 & XBL*(X**2+(1.-X)**2+RMQ*X*(1.-3.*X)-0.5*RMQ**2*X**2)
63518 C...Complicated case: P2 > 0, based on approximation of
63519 C...C.T. Hill and G.G. Ross, Nucl. Phys. B148 (1979) 373
63521 RPQ=1.-4.*X**2*P2/Q2
63522 IF(RPQ.GT.1E-10) THEN
63523 RPBE=SQRT(RPQ*BETA2)
63524 IF(RPBE.LT.0.99) THEN
63525 XBL=LOG((1.+RPBE)/(1.-RPBE))
63526 XBI=2.*RPBE/(1.-RPBE**2)
63528 RPBESN=4.*PM2/W2+(4.*X**2*P2/Q2)*BETA2
63529 XBL=LOG((1.+RPBE)**2/RPBESN)
63532 SIGBH=BETA*(6.*X*(1.-X)-1.)+
63533 & XBL*(X**2+(1.-X)**2+RMQ*X*(1.-3.*X)-0.5*RMQ**2*X**2)+
63534 & XBI*(2.*X/Q2)*(PM2*X*(2.-RMQ)-P2*X)
63538 C...Multiply by charge-squared etc. to get parton distribution.
63540 IF(IABS(KF).EQ.2.OR.IABS(KF).EQ.4) CHSQ=4./9.
63541 XPBH=3.*CHSQ*AEM2PI*X*SIGBH
63545 C*********************************************************************
63547 SUBROUTINE SASDIR(X,Q2,P2,Q02,XPGA)
63548 C...Purpose: to evaluate the direct contribution, i.e. the C^gamma term,
63549 C...as needed in MSbar parametrizations.
63550 DIMENSION XPGA(-6:6)
63552 DATA AEM2PI/0.0011614/
63559 C...Evaluate common x-dependent expression.
63560 XTMP = (X**2+(1.-X)**2) * (-LOG(X)) - 1.
63561 CGAM = 3.*AEM2PI*X * (XTMP*(1.+P2/(P2+Q02)) + 6.*X*(1.-X))
63563 C...d, u, s part by simple charge factor.
63564 XPGA(1)=(1./9.)*CGAM
63565 XPGA(2)=(4./9.)*CGAM
63566 XPGA(3)=(1./9.)*CGAM
63568 C...Also fill for antiquarks.
63574 C-----------------------------------------------------------------------
63576 *CMZ :- -28/06/01 16.55.32 by Bryan Webber
63577 *-- Author : Bryan Webber
63578 C-----------------------------------------------------------------------
63579 SUBROUTINE TIMEL(TRES)
63580 C-----------------------------------------------------------------------
63581 C DUMMY TIME SUBROUTINE: DELETE AND REPLACE BY SYSTEM
63582 C ROUTINE GIVING TRES = CPU TIME REMAINING (SECONDS)
63583 C-----------------------------------------------------------------------
63591 10 FORMAT(/10X,'SUBROUTINE TIMEL CALLED BUT NOT LINKED.'/
63592 & 10X,'DUMMY TIMEL WILL BE USED. DELETE DUMMY'/
63593 & 10X,'AND LINK CERNLIB FOR CPU TIME REMAINING.')