HERWIG/src/hwhrbb.f

   1
   2 CDECK  ID>, HWHRBB.
   3
   4 *CMZ :-        -20/10/99  09:46:43  by  Peter Richardson
   5
   6 *-- Author :    Peter Richardson
   7
   8 C-----------------------------------------------------------------------
   9
  10       SUBROUTINE HWHRBB
  11
  12 C-----------------------------------------------------------------------
  13
  14 C  Subroutine for 2 parton -> 2 parton via UDD resonant squarks
  15
  16 C-----------------------------------------------------------------------
  17
  18       INCLUDE 'HERWIG61.INC'
  19
  20       DOUBLE PRECISION HCS,S,RCS,HWR,MQ1,MQ2,TAU,LOWTLM,UPPTLM,RTAB,
  21
  22      &                 SQSH,MATELM,SCF(12),CHANPB(2),HWRUNI,PCM,MIX(12),
  23
  24      &                 ME(2,3,3,3,3),WD,MS(12),SWD(12),RAND,TAUA,
  25
  26      &                 CHAN(12),EPS,SH,FAC,TAUB,LAM(6,3,3,3,3),
  27
  28      &                 XMIN,XMAX,XPOW,XUPP,MS2(12),MSWD(12)
  29
  30       INTEGER I,J,K,L,I1,J1,K1,L1,N,THEP,CONECT(4,5),HWRINT,
  31
  32      &        GENR,GN,MIG,MXG,GEN
  33
  34       LOGICAL FIRST
  35
  36       EXTERNAL HWR,HWRUNI
  37
  38       PARAMETER(EPS=1D-20)
  39
  40       COMMON/HWRPIN/XMIN,XMAX,XPOW,FIRST
  41
  42       SAVE HCS,ME,MS,SWD,CHAN,LAM,MIX,FAC,SH,SQSH,SCF,MS2,MSWD
  43
  44       DATA CONECT/1,1,3,4,-1,-1,2,3,0,0,0,0,1,1,-2,-3,-1,-1,-3,-4/
  45
  46       IF(GENEV) THEN
  47
  48         RCS = HCS*HWR()
  49
  50       ELSE
  51
  52         IF(FSTWGT) THEN
  53
  54 C--Extract masses and width's needed
  55
  56           DO I=1,3
  57
  58             MS(2*I-1)  = RMASS(399+2*I)
  59
  60             MS(2*I)    = RMASS(411+2*I)
  61
  62             MS(2*I+5)  = RMASS(400+2*I)
  63
  64             MS(2*I+6)  = RMASS(412+2*I)
  65
  66             SWD(2*I-1) = HBAR/RLTIM(399+2*I)
  67
  68             SWD(2*I)   = HBAR/RLTIM(411+2*I)
  69
  70             SWD(2*I+5) = HBAR/RLTIM(400+2*I)
  71
  72             SWD(2*I+6) = HBAR/RLTIM(412+2*I)
  73
  74           ENDDO
  75
  76           DO I=1,12
  77
  78              MS2(I)  = MS(I)**2
  79
  80              MSWD(I) = MS(I)*SWD(I)
  81
  82           ENDDO
  83
  84 C--Now set up the parmaters for multichannel integration
  85
  86           RAND = ZERO
  87
  88           DO K=1,3
  89
  90             CHANPB(1) = ZERO
  91
  92             CHANPB(2) = ZERO
  93
  94             DO I=1,3
  95
  96               DO J=1,3
  97
  98                 CHANPB(1)=CHANPB(1)+LAMDA3(I,J,K)**2
  99
 100                 CHANPB(2)=CHANPB(2)+LAMDA3(K,I,J)**2
 101
 102               ENDDO
 103
 104             ENDDO
 105
 106             RAND=RAND+CHANPB(1)+CHANPB(2)
 107
 108             DO J=1,2
 109
 110               CHAN(2*K-2+J) = CHANPB(1)*QMIXSS(2*K-1,2,J)**2
 111
 112               CHAN(2*K+4+J) = CHANPB(2)*QMIXSS(2*K  ,2,J)**2
 113
 114               MIX(2*K-2+J) = QMIXSS(2*K-1,2,J)**2
 115
 116               MIX(2*K+4+J) = QMIXSS(2*K,2,J)**2
 117
 118             ENDDO
 119
 120           ENDDO
 121
 122           IF(RAND.GT.ZERO) THEN
 123
 124             DO I=1,12
 125
 126               CHAN(I)=CHAN(I)/RAND
 127
 128             ENDDO
 129
 130           ELSE
 131
 132             HCS =ZERO
 133
 134             CALL HWWARN('HWHRBB',500,*999)
 135
 136           ENDIF
 137
 138 C--find the couplings
 139
 140           DO GN=1,3
 141
 142             DO I=1,3
 143
 144               DO J=1,3
 145
 146                 DO K=1,3
 147
 148                   DO L=1,3
 149
 150                     LAM(GN,I,J,K,L)  =LAMDA3(I,J,GN)*LAMDA3(K,L,GN)
 151
 152                     LAM(GN+3,I,J,K,L)=LAMDA3(GN,I,J)*LAMDA3(GN,K,L)
 153
 154                   ENDDO
 155
 156                 ENDDO
 157
 158               ENDDO
 159
 160             ENDDO
 161
 162           ENDDO
 163
 164         ENDIF
 165
 166         EVWGT = ZERO
 167
 168         S     = PHEP(5,3)**2
 169
 170         COSTH = HWRUNI(0,-ONE,ONE)
 171
 172 C--Generate the smoothing
 173
 174         RAND=HWRUNI(0,ZERO,ONE)
 175
 176         DO I=1,12
 177
 178           IF(CHAN(I).GT.RAND) GOTO 20
 179
 180           RAND=RAND-CHAN(I)
 181
 182         ENDDO
 183
 184  20     GENR=I
 185
 186 C--Calculate hard scale and obtain parton distributions
 187
 188         TAUA   = MS2(GENR)/S
 189
 190         TAUB   = SWD(GENR)**2/S
 191
 192         RTAB   = SQRT(TAUA*TAUB)
 193
 194         XUPP = XMAX
 195
 196         IF(XMAX**2.GT.S) XUPP = SQRT(S)
 197
 198         LOWTLM = DATAN((XMIN**2/S-TAUA)/RTAB)/RTAB
 199
 200         UPPTLM = DATAN((XUPP**2/S-TAUA)/RTAB)/RTAB
 201
 202         TAU    = HWRUNI(0,LOWTLM,UPPTLM)
 203
 204         TAU    = RTAB*TAN(RTAB*TAU)+TAUA
 205
 206         SH     = S*TAU
 207
 208         SQSH   = SQRT(SH)
 209
 210         EMSCA  = SQSH
 211
 212         XX(1)  = EXP(HWRUNI(0,ZERO,LOG(TAU)))
 213
 214         XX(2)  = TAU/XX(1)
 215
 216         CALL HWSGEN(.FALSE.)
 217
 218 C--Calculate the prefactor due multichannel approach
 219
 220         FAC = ZERO
 221
 222         DO GN=1,12
 223
 224          SCF(GN)=1/((SH-MS2(GN))**2+MSWD(GN)**2)
 225
 226          FAC=FAC+CHAN(GN)*SCF(GN)
 227
 228         ENDDO
 229
 230         FAC=-(UPPTLM-LOWTLM)*LOG(TAU)*GEV2NB
 231
 232      &        /(24*PIFAC*SQSH*SH*TAU*FAC*S**2)
 233
 234       ENDIF
 235
 236 C--loop over the quarks
 237
 238       HCS = ZERO
 239
 240 C--temp mod
 241
 242       DO GN=1,2
 243
 244         IF(GN.EQ.1) THEN
 245
 246           MIG = 1
 247
 248           MXG = 6
 249
 250         ELSE
 251
 252           MIG = 7
 253
 254           MXG = 12
 255
 256         ENDIF
 257
 258         DO K1=1,3
 259
 260           DO 70 L1=1,3
 261
 262             IF(GN.EQ.1) THEN
 263
 264               K = 2*K1
 265
 266               L = 2*L1-1
 267
 268             ELSE
 269
 270               K=2*K1-1
 271
 272               L=2*L1-1
 273
 274               IF(GN.EQ.2.AND.L1.GE.K1) GOTO 70
 275
 276             ENDIF
 277
 278             MQ1=RMASS(K)
 279
 280             MQ2=RMASS(L)
 281
 282             IF(SQSH.GT.(MQ1+MQ2)) THEN
 283
 284               PCM=SQRT((SH-(MQ1+MQ2)**2)*(SH-(MQ1-MQ2)**2)/(4*SH))
 285
 286               WD = SH*(SH-MQ1**2-MQ2**2)*PCM
 287
 288             ELSE
 289
 290               GOTO 70
 291
 292             ENDIF
 293
 294             DO I1=1,3
 295
 296               DO 60 J1=1,3
 297
 298                 IF(GN.EQ.1) THEN
 299
 300                   I = 2*I1
 301
 302                   J = 2*J1-1
 303
 304                 ELSE
 305
 306                   I=2*I1-1
 307
 308                   J=2*J1-1
 309
 310                   IF(J1.GT.I1) GOTO 60
 311
 312                 ENDIF
 313
 314                 IF(GENEV) GOTO 50
 315
 316                 MATELM = ZERO
 317
 318                 DO 40 GEN=MIG,MXG
 319
 320                   IF(ABS(MIX(GEN)).LT.EPS.OR.
 321
 322      &             ABS(LAM(INT((GEN+1)/2),I1,J1,K1,L1)).LT.EPS) GOTO 40
 323
 324                   DO 30 GENR=MIG,MXG
 325
 326                     IF(ABS(LAM(INT((GENR+1)/2),I1,J1,K1,L1)).LT.EPS.
 327
 328      &                OR.ABS(MIX(GENR)).LT.EPS) GOTO 30
 329
 330                     MATELM =MATELM+SCF(GEN)*SCF(GENR)*WD*
 331
 332      &                  ((SH-MS2(GEN))*(SH-MS2(GENR))+
 333
 334      &                  MSWD(GEN)*MSWD(GENR))
 335
 336      &                  *LAM(INT((GEN+1)/2),I1,J1,K1,L1)*MIX(GEN)
 337
 338      &                  *LAM(INT((GENR+1)/2),I1,J1,K1,L1)*MIX(GENR)
 339
 340  30               CONTINUE
 341
 342  40             CONTINUE
 343
 344                 ME(GN,I1,J1,K1,L1) = MATELM*FAC
 345
 346 C--Add up the term to get the cross-section
 347
 348  50             HCS = HCS+ME(GN,I1,J1,K1,L1)*DISF(I,1)*DISF(J,2)
 349
 350                 IF(HCS.GT.RCS.AND.GENEV)
 351
 352      &                           CALL HWHRSS(1,I,J,K,L,0,0,*100)
 353
 354                 HCS = HCS+ME(GN,I1,J1,K1,L1)*DISF(J,1)*DISF(I,2)
 355
 356                 IF(HCS.GT.RCS.AND.GENEV)
 357
 358      &                           CALL HWHRSS(2,J,I,K,L,0,0,*100)
 359
 360                 HCS = HCS+ME(GN,I1,J1,K1,L1)*DISF(I+6,1)*DISF(J+6,2)
 361
 362                 IF(HCS.GT.RCS.AND.GENEV)
 363
 364      &                           CALL HWHRSS(1,I,J,K,L,1,0,*100)
 365
 366                 HCS = HCS+ME(GN,I1,J1,K1,L1)*DISF(J+6,1)*DISF(I+6,2)
 367
 368                 IF(HCS.GT.RCS.AND.GENEV)
 369
 370      &                           CALL HWHRSS(2,J,I,K,L,1,0,*100)
 371
 372  60           CONTINUE
 373
 374             ENDDO
 375
 376  70       CONTINUE
 377
 378         ENDDO
 379
 380       ENDDO
 381
 382  100  IF(GENEV) THEN
 383
 384         CALL HWETWO
 385
 386 C--first stage of the colour connection corrections
 387
 388         DO THEP=1,5
 389
 390           IF(THEP.NE.3) THEN
 391
 392             JMOHEP(2,THEP+NHEP-5)=NHEP-5+THEP+CONECT(HWRINT(1,4),THEP)
 393
 394             JDAHEP(2,THEP+NHEP-5) = JMOHEP(2,THEP+NHEP-5)
 395
 396           ENDIF
 397
 398         ENDDO
 399
 400         THEP = NHEP-4
 401
 402         IF(HWRINT(1,2).EQ.1) THEN
 403
 404           HRDCOL(2,1) = THEP+3
 405
 406           HRDCOL(2,2) = THEP+4
 407
 408           HRDCOL(1,4) = THEP
 409
 410           HRDCOL(1,5) = THEP+1
 411
 412         ELSE
 413
 414           HRDCOL(2,1) = THEP+4
 415
 416           HRDCOL(2,2) = THEP+3
 417
 418           HRDCOL(1,4) = THEP+1
 419
 420           HRDCOL(1,5) = THEP
 421
 422         ENDIF
 423
 424         DO N=1,5
 425
 426           IF(N.LE.2) THEN
 427
 428             HRDCOL(1,N)=HRDCOL(2,N)
 429
 430           ELSEIF(N.GE.4) THEN
 431
 432             HRDCOL(2,N)=HRDCOL(1,N)
 433
 434           ENDIF
 435
 436         ENDDO
 437
 438         HRDCOL(1,3) = 4
 439
 440         COLUPD = .TRUE.
 441
 442       ELSE
 443
 444         EVWGT = HCS
 445
 446       ENDIF
 447
 448  999  END
 449
 450 CDECK  ID>, HWHRBS.
 451
 452 *CMZ :-        -20/10/99  09:46:43  by  Peter Richardson
 453
 454 *-- Author :    Peter Richardson
 455
 456 C-----------------------------------------------------------------------
 457
 458       SUBROUTINE HWHRBS
 459
 460 C-----------------------------------------------------------------------
 461
 462 C  Subroutine for 2 parton -> parton SUSY particle via UDD resonant
 463
 464 C  squarks.
 465
 466 C-----------------------------------------------------------------------
 467
 468       INCLUDE 'HERWIG61.INC'
 469
 470       DOUBLE PRECISION HCS,S,RCS,HWR,ME(4),CW,MER(6),MZ,TAU,TAUA,
 471
 472      &                 TAUB,LOWTLM,UPPTLM,HWRUNI,SH,SQSH,SCF(12),MW2,
 473
 474      &                 LAMC(3),CHANPB(2),PCM,ECM,RAND,MEN(7,6,3,3),
 475
 476      &                 MEC(2,6,3,3),RTAB,MS(12),SWD(12),AS,HWUALF,
 477
 478      &                 MQ,MN,MQS,SIN2B,TH,UH,FAC,MX(14),CHAN(12),MC(2),
 479
 480      &                 MNS,HWUAEM,SW,G,EC,MW,A(7,14),B(7,14),EPS,XUPP,
 481
 482      &                 MEH(3,42),XMIN,XMAX,XPOW,FAC2,MH(4),ZSQU(2,2),
 483
 484      &                 ZQRK(2),MZ2,GUU(4),GDD(4),ME2,MS2(12),MSWD(12)
 485
 486       INTEGER I,J,K,I1,J1,GEN,THEP,HWRINT,L,GT,GU,GR,I2,
 487
 488      &        CONECT(2,6,5),GN,GENR,SP,SPMN,SPMX,CON,CHARMN,CHARMX,
 489
 490      &        CM,CN
 491
 492       LOGICAL RAD,NEUT,CHAR,HIGGS,FIRST
 493
 494       EXTERNAL HWR,HWRUNI,HWUAEM,HWUALF,HWRINT
 495
 496       COMMON/HWRPIN/XMIN,XMAX,XPOW,FIRST
 497
 498       SAVE HCS,MS,SWD,MX,CHAN,A,B,SPMN,SPMX,RAD,MEN,MEC,HIGGS,
 499
 500      &     CHARMN,CHARMX,NEUT,CHAR,SQSH,MEH,SW,CW,MW,MZ,MER,SH,MH,
 501
 502      &     AS,EC,FAC,G,SCF,ZSQU,ZQRK,MW2,MZ2,MS2,MSWD
 503
 504       PARAMETER(EPS=1D-20)
 505
 506       DATA CONECT/ 4, 4, 2, 3, 0, 0, 1,-2,-1,-3,-4,-4,
 507
 508      &             3, 4, 3, 3, 0, 0, 1,-3,-1,-4,-3,-3,
 509
 510      &             1, 4,-1, 3, 0, 0, 1, 1,-3,-4,-1,-1,
 511
 512      &             1, 3,-1, 2, 0, 0,-3,-2, 0, 0, 0, 0,
 513
 514      &             1, 4,-1, 3, 0, 0,-3,-2,-1,-1,-1,-1/
 515
 516       IF(GENEV) THEN
 517
 518         RCS = HCS*HWR()
 519
 520       ELSE
 521
 522         IF(FSTWGT) THEN
 523
 524 C--Extract masses and width's needed
 525
 526           DO I=1,3
 527
 528             MS(2*I-1) = RMASS(399+2*I)
 529
 530             MS(2*I)   = RMASS(411+2*I)
 531
 532             MS(2*I+5) = RMASS(400+2*I)
 533
 534             MS(2*I+6) = RMASS(412+2*I)
 535
 536             SWD(2*I-1) = HBAR/RLTIM(399+2*I)
 537
 538             SWD(2*I)   = HBAR/RLTIM(411+2*I)
 539
 540             SWD(2*I+5) = HBAR/RLTIM(400+2*I)
 541
 542             SWD(2*I+6) = HBAR/RLTIM(412+2*I)
 543
 544           ENDDO
 545
 546           DO I=1,12
 547
 548              MS2(I)  = MS(I)**2
 549
 550              MSWD(I) = MS(I)*SWD(I)
 551
 552           ENDDO
 553
 554 C--Electroweak parameters
 555
 556           SW = SQRT(SWEIN)
 557
 558           CW = SQRT(1-SWEIN)
 559
 560           MW    = RMASS(198)
 561
 562           MZ    = RMASS(200)
 563
 564           MW2   = MW**2
 565
 566           MZ2   = MZ**2
 567
 568           SIN2B = TWO*SINB*COSB
 569
 570 C--Now set up the parmaters for multichannel integration
 571
 572           RAND = ZERO
 573
 574           DO K=1,3
 575
 576             CHANPB(1) = ZERO
 577
 578             CHANPB(2) = ZERO
 579
 580             DO I=1,3
 581
 582               DO J=1,3
 583
 584                 CHANPB(1)=CHANPB(1)+LAMDA3(I,J,K)**2
 585
 586                 CHANPB(2)=CHANPB(2)+LAMDA3(K,I,J)**2
 587
 588               ENDDO
 589
 590             ENDDO
 591
 592             RAND=RAND+CHANPB(1)+CHANPB(2)
 593
 594             DO J=1,2
 595
 596               CHAN(2*K-2+J) = CHANPB(1)*QMIXSS(2*K-1,2,J)**2
 597
 598               CHAN(2*K+4+J) = CHANPB(2)*QMIXSS(2*K  ,2,J)**2
 599
 600               MX(2*K-2+J) = QMIXSS(2*K-1,2,J)
 601
 602               MX(2*K+4+J) = QMIXSS(2*K,2,J)
 603
 604             ENDDO
 605
 606             MX(13) = ZERO
 607
 608             MX(14) = ZERO
 609
 610           ENDDO
 611
 612           IF(RAND.GT.ZERO) THEN
 613
 614             DO I=1,12
 615
 616               CHAN(I)=CHAN(I)/RAND
 617
 618             ENDDO
 619
 620           ELSE
 621
 622             CALL HWWARN('HWHRBS',500,*999)
 623
 624           ENDIF
 625
 626 C--Couplings we need for the various processes
 627
 628 C--Gluino
 629
 630           DO I=1,3
 631
 632             DO J=1,2
 633
 634               A(1,2*I-2+J) =  QMIXSS(2*I-1,2,J)
 635
 636               B(1,2*I-2+J) = -QMIXSS(2*I-1,1,J)
 637
 638               A(1,2*I+4+J) =  QMIXSS(2*I,2,J)
 639
 640               B(1,2*I+4+J) = -QMIXSS(2*I,1,J)
 641
 642             ENDDO
 643
 644           ENDDO
 645
 646 C--Now the neutralinos
 647
 648           DO L=1,4
 649
 650             MC(1) =  ZMIXSS(L,3)/(2*MW*COSB*SW)
 651
 652             MC(2) =  ZMIXSS(L,4)/(2*MW*SINB*SW)
 653
 654             DO I=1,3
 655
 656               DO J=1,2
 657
 658                 A(L+1,2*I-2+J) = ZSGNSS(L)*(MC(1)*QMIXSS(2*I-1,1,J)*
 659
 660      &                    RMASS(2*I-1)+SRFCH(2*I-1,L)*QMIXSS(2*I-1,2,J))
 661
 662                 B(L+1,2*I-2+J) = MC(1)*QMIXSS(2*I-1,2,J)*
 663
 664      &                    RMASS(2*I-1)+SLFCH(2*I-1,L)*QMIXSS(2*I-1,1,J)
 665
 666                 A(L+1,2*I+4+J) = ZSGNSS(L)*(MC(2)*QMIXSS(2*I,1,J)*
 667
 668      &                    RMASS(2*I)+SRFCH(2*I  ,L)*QMIXSS(2*I,2,J))
 669
 670                 B(L+1,2*I+4+J) = MC(2)*QMIXSS(2*I,2,J)*
 671
 672      &                    RMASS(2*I)+SLFCH(2*I,  L)*QMIXSS(2*I,1,J)
 673
 674               ENDDO
 675
 676             ENDDO
 677
 678           ENDDO
 679
 680 C--Now for the charginos
 681
 682           DO L=1,2
 683
 684             MC(1) = 1/(SQRT(2.0D0)*MW*COSB)
 685
 686             MC(2) = 1/(SQRT(2.0D0)*MW*SINB)
 687
 688             DO I=1,3
 689
 690               DO J=1,2
 691
 692                 A(5+L,2*I-2+J) = -WSGNSS(L)*WMXVSS(L,2)*MC(2)*
 693
 694      &                            RMASS(2*I)*QMIXSS(2*I-1,1,J)
 695
 696                 B(5+L,2*I-2+J) = WMXUSS(L,1)*QMIXSS(2*I-1,1,J)
 697
 698      &              -WMXUSS(L,2)*MC(1)*RMASS(2*I-1)*QMIXSS(2*I-1,2,J)
 699
 700                 A(5+L,2*I+4+J) = -WMXUSS(L,2)*MC(1)*RMASS(2*I-1)
 701
 702      &                            *QMIXSS(2*I,1,J)
 703
 704                 B(5+L,2*I+4+J) = WSGNSS(L)*(WMXVSS(L,1)*QMIXSS(2*I,1,J)
 705
 706      &              -WMXVSS(L,2)*MC(2)*RMASS(2*I)*QMIXSS(2*I,2,J))
 707
 708               ENDDO
 709
 710             ENDDO
 711
 712           ENDDO
 713
 714 C--Zero couplings
 715
 716           DO I=1,7
 717
 718             A(I,13) = ZERO
 719
 720             B(I,13) = ZERO
 721
 722             A(I,14) = ZERO
 723
 724             B(I,14) = ZERO
 725
 726           ENDDO
 727
 728 C--Couplings to the Z boson of squarks and right-handed quarks
 729
 730           ZQRK(1)   = -SW**2/6.0D0/CW
 731
 732           ZQRK(2)   =  SW**2/3.0D0/CW
 733
 734           ZSQU(1,1) =  HALF*(QMIXSS(5,1,1)**2-2.0D0*SW**2/3.0D0)/CW
 735
 736           ZSQU(1,2) =  HALF*QMIXSS(5,1,1)*QMIXSS(5,1,2)/CW
 737
 738           ZSQU(2,1) = -HALF*(QMIXSS(6,1,1)**2-4.0D0*SW**2/3.0D0)/CW
 739
 740           ZSQU(2,2) = -HALF*QMIXSS(6,1,1)*QMIXSS(6,1,2)/CW
 741
 742 C--Higgs Masses
 743
 744           DO I=1,4
 745
 746             MH(I) = RMASS(202+I)
 747
 748           ENDDO
 749
 750 C--Higgs couplings to quarks
 751
 752           DO I=1,3
 753
 754             GUU(I) = GHUUSS(I)**2*HALF**2/MW2
 755
 756             GDD(I) = GHDDSS(I)**2*HALF**2/MW2
 757
 758           ENDDO
 759
 760           GUU(4) = ONE/TANB**2/MW2/8.0D0
 761
 762           GDD(4) = ONE*TANB**2/MW2/8.0D0
 763
 764 C--decide which processes to generate from IPROC
 765
 766           RAD   = .FALSE.
 767
 768           NEUT  = .FALSE.
 769
 770           CHAR  = .FALSE.
 771
 772           HIGGS = .FALSE.
 773
 774           SPMN = 1
 775
 776           SPMX = 5
 777
 778           CHARMN = 1
 779
 780           CHARMX = 2
 781
 782           IF(IPROC.EQ.4100) THEN
 783
 784             RAD   = .TRUE.
 785
 786             NEUT  = .TRUE.
 787
 788             CHAR  = .TRUE.
 789
 790             HIGGS = .TRUE.
 791
 792           ELSEIF(IPROC.LT.4120) THEN
 793
 794             SPMN = 2
 795
 796             IF(IPROC.NE.4110) THEN
 797
 798               SPMN = MOD(IPROC,10)+1
 799
 800               SPMX = SPMN
 801
 802             ENDIF
 803
 804             NEUT=.TRUE.
 805
 806           ELSEIF(IPROC.LT.4130) THEN
 807
 808             IF(IPROC.NE.4120) THEN
 809
 810               CHARMN = MOD(IPROC,10)
 811
 812               CHARMX=CHARMN
 813
 814             ENDIF
 815
 816             CHAR = .TRUE.
 817
 818           ELSEIF(IPROC.EQ.4130) THEN
 819
 820             SPMX = 1
 821
 822             NEUT=.TRUE.
 823
 824           ELSEIF(IPROC.EQ.4140) THEN
 825
 826             RAD = .TRUE.
 827
 828           ELSEIF(IPROC.EQ.4150) THEN
 829
 830             HIGGS = .TRUE.
 831
 832           ELSE
 833
 834             CALL HWWARN('HWHRBS',501,*999)
 835
 836           ENDIF
 837
 838         ENDIF
 839
 840         EVWGT = ZERO
 841
 842         S     = PHEP(5,3)**2
 843
 844         COSTH = HWRUNI(0,-ONE,ONE)
 845
 846 C--zero the array
 847
 848         DO I=1,6
 849
 850           DO J=1,3
 851
 852             DO K=1,3
 853
 854               DO L=1,7
 855
 856                 MEN(L,I,J,K)=ZERO
 857
 858               ENDDO
 859
 860               DO L=1,2
 861
 862                 MEC(L,I,J,K)=ZERO
 863
 864               ENDDO
 865
 866             ENDDO
 867
 868           ENDDO
 869
 870         ENDDO
 871
 872 C--Multichannel peak
 873
 874         RAND=HWRUNI(0,ZERO,ONE)
 875
 876         DO I=1,12
 877
 878           IF(CHAN(I).GT.RAND) GOTO 25
 879
 880           RAND=RAND-CHAN(I)
 881
 882         ENDDO
 883
 884  25     GENR=I
 885
 886 C--Calculate the hard scale and obtain parton distributions
 887
 888         TAUA   = MS2(GENR)/S
 889
 890         TAUB   = SWD(GENR)**2/S
 891
 892         RTAB   = SQRT(TAUA*TAUB)
 893
 894         XUPP = XMAX
 895
 896         IF(XMAX**2.GT.S) XUPP = SQRT(S)
 897
 898         LOWTLM = DATAN((XMIN**2/S-TAUA)/RTAB)/RTAB
 899
 900         UPPTLM = DATAN((XUPP**2/S-TAUA)/RTAB)/RTAB
 901
 902         TAU    = HWRUNI(0,LOWTLM,UPPTLM)
 903
 904         TAU    = RTAB*TAN(RTAB*TAU)+TAUA
 905
 906         SH   = S*TAU
 907
 908         SQSH = SQRT(SH)
 909
 910         EMSCA  = SQSH
 911
 912         XX(1)  = EXP(HWRUNI(0,ZERO,LOG(TAU)))
 913
 914         XX(2)  = TAU/XX(1)
 915
 916         CALL HWSGEN(.FALSE.)
 917
 918 C--Strong, EM coupling and weak couplings
 919
 920         AS = HWUALF(1,EMSCA)
 921
 922         EC = SQRT(4*PIFAC*HWUAEM(SH))
 923
 924         G  = EC/SW
 925
 926 C--Calculate the prefactor due multichannel approach
 927
 928         FAC = ZERO
 929
 930         DO GN=1,12
 931
 932          SCF(GN)=1/((SH-MS2(GN))**2+MSWD(GN)**2)
 933
 934          FAC=FAC+CHAN(GN)*SCF(GN)
 935
 936         ENDDO
 937
 938         FAC=-(UPPTLM-LOWTLM)*LOG(TAU)*GEV2NB
 939
 940      &        /(48*PIFAC*SQSH*SH*TAU*FAC*S**2)
 941
 942       ENDIF
 943
 944       HCS = ZERO
 945
 946       IF(.NOT.NEUT) GOTO 200
 947
 948       DO 140 GN=1,6
 949
 950         GR=2*GN
 951
 952         IF(CHAN(GR).LT.EPS) GOTO 140
 953
 954         DO 130 L=SPMN,SPMX
 955
 956           K = 2*GN+5
 957
 958           IF(GN.GT.3) K = 2*GN
 959
 960           MQ = RMASS(K)
 961
 962           MN = ABS(RMASS(448+L))
 963
 964           MQS = MQ**2
 965
 966           MNS = MN**2
 967
 968           IF(SQSH.LT.(MQ+MN)) GOTO 130
 969
 970           PCM=SQRT((SH-(MQ+MN)**2)*(SH-(MQ-MN)**2)/(4*SH))
 971
 972           ECM=SQRT(PCM**2+MQS)
 973
 974           TH = MQS-SQSH*(ECM-PCM*COSTH)
 975
 976           UH = MQS-SQSH*(ECM+PCM*COSTH)
 977
 978           DO I=1,3
 979
 980             DO 120 J=1,3
 981
 982               IF(GN.LE.3) THEN
 983
 984                 GU = 6+2*I
 985
 986                 I1 = 2*I
 987
 988                 LAMC(1) = LAMDA3(I,J,GN)**2
 989
 990               ELSE
 991
 992                 GU = 2*I
 993
 994                 I1 = 2*I-1
 995
 996                 LAMC(1) = LAMDA3(GN-3,I,J)**2
 997
 998                 IF(J.GT.I) LAMC(1) = ZERO
 999
1000               ENDIF
1001
1002               GT = 2*J
1003
1004               J1 = 2*J-1
1005
1006 C--Now the matrix elements
1007
1008               IF(LAMC(1).LT.EPS) GOTO 120
1009
1010               IF(GENEV) GOTO 110
1011
1012 C--S channel
1013
1014               ME(3) = MX(GR)**2*SCF(GR)*SH*((SH-MQS-MNS)*(A(L,GR)**2+
1015
1016      &                 B(L,GR)**2)-4*MQ*MN*A(L,GR)*B(L,GR))
1017
1018               ME(4) =-TWO*MX(GU)*MX(GT)*(MQS*MNS-UH*TH)*A(L,GT)*A(L,GU)
1019
1020      &                 /(TH-MS2(GT))/(UH-MS2(GU))
1021
1022      &               +TWO*MX(GR)*MX(GU)*(SH-MS2(GR))*SCF(GR)*SH*
1023
1024      &                 A(L,GU)*(A(L,GR)*UH+B(L,GR)*MQ*MN)/(UH-MS2(GU))
1025
1026      &               +TWO*MX(GR)*MX(GT)*(SH-MS2(GR))*SCF(GR)*SH*
1027
1028      &                 A(L,GT)*(A(L,GR)*TH+B(L,GR)*MQ*MN)/(TH-MS2(GT))
1029
1030 C--L/R s channel and interference
1031
1032               IF(ABS(MX(GR-1)).GT.EPS) THEN
1033
1034                 ME(3) = ME(3)+
1035
1036      &             MX(GR-1)**2*SCF(GR-1)*SH*((SH-MQS-MNS)*(A(L,GR-1)**2
1037
1038      &                +B(L,GR-1)**2)-4*MQ*MN*A(L,GR-1)*B(L,GR-1))
1039
1040      &            +TWO*MX(GR)*MX(GR-1)*SCF(GR)*SCF(GR-1)*SH*
1041
1042      &                ((SH-MS2(GR))*(SH-MS2(GR-1))+MSWD(GR)*MSWD(GR-1))*
1043
1044      &                ((SH-MQS-MNS)*(A(L,GR)*A(L,GR-1)
1045
1046      &                +B(L,GR)*B(L,GR-1))
1047
1048      &                -TWO*MQ*MN*(A(L,GR)*B(L,GR-1)+A(L,GR-1)*B(L,GR)))
1049
1050                ME(4) = ME(4)+TWO*MX(GR-1)*MX(GU)*(SH-MS2(GR-1))
1051
1052      &           *SCF(GR-1)*A(L,GU)*SH*(A(L,GR-1)*UH+B(L,GR-1)*MQ*MN)
1053
1054      &            /(UH-MS2(GU))
1055
1056      &          +TWO*MX(GR-1)*MX(GT)*(SH-MS2(GR-1))*SCF(GR-1)*SH*
1057
1058      &            A(L,GT)*(A(L,GR-1)*TH+B(L,GR-1)*MQ*MN)/(TH-MS2(GT))
1059
1060                 IF(ABS(MX(GU-1)).GT.EPS) ME(4)=ME(4)+TWO*MX(GR-1)*
1061
1062      &                MX(GU-1)*(SH-MS2(GR-1))*SCF(GR-1)*A(L,GU-1)*SH*(
1063
1064      &                A(L,GR-1)*UH+B(L,GR-1)*MQ*MN)/(UH-MS2(GU-1))
1065
1066                 IF(ABS(MX(GT-1)).GT.EPS) ME(4)=ME(4)+TWO*MX(GR-1)*
1067
1068      &                MX(GT-1)*(SH-MS2(GR-1))*SCF(GR-1)*A(L,GT-1)*SH*
1069
1070      &                (A(L,GR-1)*TH+B(L,GR-1)*MQ*MN)/(TH-MS2(GT-1))
1071
1072               ENDIF
1073
1074 C--u channel and L/R mixing
1075
1076               ME(1)= MX(GU)**2*(MQS-UH)*(MNS-UH)*
1077
1078      &               (A(L,GU)**2+B(L,GU)**2)/(UH-MS2(GU))**2
1079
1080               IF(ABS(MX(GU-1)).GT.EPS) THEN
1081
1082                 ME(1) = ME(1)+MX(GU-1)**2*(MQS-UH)*(MNS-UH)*
1083
1084      &                   (A(L,GU-1)**2+B(L,GU-1)**2)/(UH-MS2(GU-1))**2
1085
1086      &                 +TWO*MX(GU)*MX(GU-1)*(MQS-UH)*(MNS-UH)*
1087
1088      &                   (A(L,GU)*A(L,GU-1)+B(L,GU)*B(L,GU-1))
1089
1090      &                   /(UH-MS2(GU))/(UH-MS2(GU-1))
1091
1092                 ME(4) =ME(4)+TWO*MX(GR)*MX(GU-1)*(SH-MS2(GR))*
1093
1094      &                   SCF(GR)*A(L,GU-1)*SH*(A(L,GR)*UH+B(L,GR)*MQ*MN)
1095
1096      &                   /(UH-MS2(GU-1))
1097
1098      &                -2*MX(GU-1)*MX(GT)*(MQS*MNS-UH*TH)*A(L,GT)*
1099
1100      &                   A(L,GU-1)/(TH-MS2(GT))/(UH-MS2(GU-1))
1101
1102                 IF(ABS(MX(GT-1)).GT.EPS) ME(4)=ME(4)-2*MX(GU-1)*MX(GT-1)
1103
1104      &               *(MQS*MNS-UH*TH)*A(L,GT-1)*A(L,GU-1)
1105
1106      &               /(TH-MS2(GT-1))/(UH-MS2(GU-1))
1107
1108               ENDIF
1109
1110 C--t channel and t channel L/R mixing
1111
1112               ME(2) = MX(GT)**2*(MQS-TH)*(MNS-TH)*
1113
1114      &                  (A(L,GT)**2+B(L,GT)**2)/(TH-MS2(GT))**2
1115
1116               IF(ABS(MX(GT-1)).GT.EPS) THEN
1117
1118                 ME(2) = ME(2)+MX(GT-1)**2*(MQS-TH)*(MNS-TH)*
1119
1120      &                   (A(L,GT-1)**2+B(L,GT-1)**2)/(TH-MS2(GT-1))**2
1121
1122      &                 +TWO*MX(GT)*MX(GT-1)*(MQS-TH)*(MNS-TH)*(A(L,GT)*
1123
1124      &                   A(L,GT-1)+ B(L,GT)*B(L,GT-1))
1125
1126      &                   /(TH-MS2(GT))/(TH-MS2(GT-1))
1127
1128                 ME(4)=ME(4)-TWO*MX(GU)*MX(GT-1)*(MQS*MNS-UH*TH)*
1129
1130      &                 A(L,GT-1)*A(L,GU)/(TH-MS2(GT-1))/(UH-MS2(GU))
1131
1132      &               +TWO*MX(GR)*MX(GT-1)*(SH-MS2(GR))*SCF(GR)*
1133
1134      &                 A(L,GT-1)*SH*(A(L,GR)*TH+B(L,GR)*MQ*MN)
1135
1136      &                 /(TH-MS2(GT-1))
1137
1138               ENDIF
1139
1140 C--Angular ordering and the phase space factors
1141
1142               IF(L.EQ.1) THEN
1143
1144                ME(4)=-HALF*ME(4)/(ME(1)+ME(2)+ME(3))
1145
1146                LAMC(1) = 32.0D0*LAMC(1)*AS*PIFAC/THREE
1147
1148                DO GEN=1,3
1149
1150                  MEN(GEN,GN,I,J) = FAC*PCM*LAMC(1)*ME(GEN)*(ONE+ME(4))
1151
1152                ENDDO
1153
1154               ELSE
1155
1156                LAMC(1) = TWO*LAMC(1)*EC**2
1157
1158                MEN(L+2,GN,I,J)=FAC*PCM*LAMC(1)*(ME(1)+ME(2)+ME(3)+ME(4))
1159
1160               ENDIF
1161
1162 C--Multiply by the pdf's
1163
1164  110          IF(L.EQ.1) THEN
1165
1166                 CM = 1
1167
1168                 CN = 3
1169
1170               ELSE
1171
1172                 CM = L+2
1173
1174                 CN = L+2
1175
1176               ENDIF
1177
1178               DO GEN=CM,CN
1179
1180               CON = 4
1181
1182               IF(GEN.LE.3) CON = GEN
1183
1184            HCS=HCS+MEN(GEN,GN,I,J)*DISF(I1,1)*DISF(J1,2)
1185
1186            IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(3,I1,J1,K,GEN,0,0,*900)
1187
1188            HCS=HCS+MEN(GEN,GN,I,J)*DISF(J1,1)*DISF(I1,2)
1189
1190            IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(4,J1,I1,K,GEN,0,0,*900)
1191
1192            HCS=HCS+MEN(GEN,GN,I,J)*DISF(I1+6,1)*DISF(J1+6,2)
1193
1194            IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(3,I1,J1,K,GEN,1,0,*900)
1195
1196            HCS=HCS+MEN(GEN,GN,I,J)*DISF(J1+6,1)*DISF(I1+6,2)
1197
1198            IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(4,J1,I1,K,GEN,1,0,*900)
1199
1200               ENDDO
1201
1202  120        CONTINUE
1203
1204           ENDDO
1205
1206  130    CONTINUE
1207
1208  140  CONTINUE
1209
1210 C--Now the chargino processes if wanted
1211
1212  200  IF(.NOT.CHAR) GOTO 300
1213
1214         DO 240 GN=1,6
1215
1216           GR=2*GN
1217
1218           IF(CHAN(GR).LT.EPS) GOTO 240
1219
1220           DO 230 L=CHARMN,CHARMX
1221
1222           SP =5+L
1223
1224           K = 2*GN+6
1225
1226           IF(GN.GT.3) K = 2*GN-1
1227
1228           MQ = RMASS(K)
1229
1230           MN = ABS(RMASS(453+L))
1231
1232           MQS = MQ**2
1233
1234           MNS = MN**2
1235
1236           IF(SQSH.LT.(MQ+MN)) GOTO 230
1237
1238           PCM=SQRT((SH-(MQ+MN)**2)*(SH-(MQ-MN)**2)/(4*SH))
1239
1240           ECM=SQRT(PCM**2+MQS)
1241
1242           TH = MQS-SQSH*(ECM-PCM*COSTH)
1243
1244           UH = MQS-SQSH*(ECM+PCM*COSTH)
1245
1246           DO I=1,3
1247
1248             DO 220 J=1,3
1249
1250               IF(GN.LE.3) THEN
1251
1252                 GU = 2*I
1253
1254                 GT = 14
1255
1256                 I1 = 2*I
1257
1258                 LAMC(1) = LAMDA3(I,J,GN)
1259
1260                 LAMC(2) = LAMDA3(GN,I,J)
1261
1262                 LAMC(3) = ZERO
1263
1264               ELSE
1265
1266                 GU = 6+2*I
1267
1268                 GT = 6+2*J
1269
1270                 I1 = 2*I-1
1271
1272                 LAMC(1) = LAMDA3(GN-3,I,J)
1273
1274                 LAMC(2) = LAMDA3(I,J,GN-3)
1275
1276                 LAMC(3) = LAMDA3(J,GN-3,I)
1277
1278                 IF(J.GT.I) LAMC(1) = ZERO
1279
1280               ENDIF
1281
1282               J1 = 2*J-1
1283
1284               IF(ABS(LAMC(1)).LT.EPS) GOTO 220
1285
1286               IF(GENEV) GOTO 210
1287
1288 C--Matrix element
1289
1290 C--S channel
1291
1292               ME(1) = LAMC(1)**2*MX(GR)**2*SCF(GR)*SH*((SH-MQS-MNS)*
1293
1294      &              (A(SP,GR)**2+B(SP,GR)**2)-4*MQ*MN*A(SP,GR)*B(SP,GR))
1295
1296               IF(ABS(MX(GU)).GT.EPS) THEN
1297
1298                 ME(1) = ME(1)+LAMC(2)**2*MX(GU)**2*(MQS-UH)*(MNS-UH)*
1299
1300      &                       (A(SP,GU)**2+B(SP,GU)**2)/(UH-MS2(GU))**2
1301
1302      &                 +LAMC(1)*LAMC(2)*TWO*MX(GR)*MX(GU)*
1303
1304      &                       (SH-MS2(GR))*SCF(GR)*A(SP,GU)*SH*
1305
1306      &                       (A(SP,GR)*UH+B(SP,GR)*MQ*MN)/(UH-MS2(GU))
1307
1308                 IF(ABS(MX(GT)).GT.EPS) ME(1) = ME(1)-LAMC(2)*LAMC(3)*
1309
1310      &                       TWO*MX(GU)*MX(GT)*(MQS*MNS-UH*TH)*A(SP,GT)*
1311
1312      &                       A(SP,GU)/(TH-MS2(GT))/(UH-MS2(GU))
1313
1314              ENDIF
1315
1316              IF(ABS(MX(GT)).GT.EPS) THEN
1317
1318                ME(1) = ME(1)+LAMC(3)**2*MX(GT)**2*(MQS-TH)*(MNS-TH)*
1319
1320      &                       (A(SP,GT)**2+B(SP,GT)**2)/(TH-MS2(GT))**2
1321
1322      &                +LAMC(1)*LAMC(3)*TWO*MX(GR)*MX(GT)*
1323
1324      &                       (SH-MS2(GR))*SCF(GR)*A(SP,GT)*SH*
1325
1326      &                       (A(SP,GR)*TH+B(SP,GR)*MQ*MN)/(TH-MS2(GT))
1327
1328              ENDIF
1329
1330 c--L/R s channel and interference
1331
1332               IF(ABS(MX(GR-1)).GT.EPS) THEN
1333
1334                 ME(1) = ME(1)+LAMC(1)**2*MX(GR-1)**2*SCF(GR-1)*SH*
1335
1336      &                       ((SH-MQS-MNS)*(A(SP,GR-1)**2+B(SP,GR-1)**2)
1337
1338      &                       -4*MQ*MN*A(SP,GR-1)*B(SP,GR-1))
1339
1340      &                 +LAMC(1)**2*TWO*MX(GR)*MX(GR-1)*SCF(GR)*
1341
1342      &                       SCF(GR-1)*SH*
1343
1344      &                       ((SH-MS2(GR))*(SH-MS2(GR-1))+
1345
1346      &                       MSWD(GR)*MSWD(GR-1))*
1347
1348      &                       ((SH-MQS-MNS)*(A(SP,GR)*A(SP,GR-1)+
1349
1350      &                       B(SP,GR)*B(SP,GR-1))-TWO*MQ*MN*
1351
1352      &                       (A(SP,GR)*B(SP,GR-1)+A(SP,GR-1)*B(SP,GR)))
1353
1354                  IF(ABS(MX(GU)).GT.EPS) ME(1) = ME(1)+LAMC(1)*LAMC(2)*
1355
1356      &                   TWO*MX(GR-1)*MX(GU)*(SH-MS2(GR-1))*SCF(GR-1)*
1357
1358      &                   A(SP,GU)*SH*(A(SP,GR-1)*UH+B(SP,GR-1)*MQ*MN)
1359
1360      &                   /(UH-MS2(GU))
1361
1362                  IF(ABS(MX(GT)).GT.EPS) ME(1) = ME(1)+LAMC(1)*LAMC(3)*
1363
1364      &                   TWO*MX(GR-1)*MX(GT)*(SH-MS2(GR-1))*SCF(GR-1)*
1365
1366      &                   A(SP,GT)*SH*(A(SP,GR-1)*TH+B(SP,GR-1)*MQ*MN)
1367
1368      &                   /(TH-MS2(GT))
1369
1370                  IF(ABS(MX(GU-1)).GT.EPS) ME(1)=ME(1)+LAMC(1)*LAMC(2)*
1371
1372      &                   TWO*MX(GR-1)*MX(GU-1)*(SH-MS2(GR-1))*
1373
1374      &                   SCF(GR-1)*A(SP,GU-1)*SH*(A(SP,GR-1)*UH+
1375
1376      &                   B(SP,GR-1)*MQ*MN)/(UH-MS2(GU-1))
1377
1378                 IF(ABS(MX(GT-1)).GT.EPS) ME(1)=ME(1)+LAMC(1)*LAMC(3)*
1379
1380      &                   TWO*MX(GR-1)*MX(GT-1)*(SH-MS2(GR-1))*
1381
1382      &                   SCF(GR-1)*A(SP,GT-1)*SH*(A(SP,GR-1)*TH+
1383
1384      &                    B(SP,GR-1)*MQ*MN)/(TH-MS2(GT-1))
1385
1386               ENDIF
1387
1388 C--u channel and L/R mixing
1389
1390               IF(ABS(MX(GU-1)).GT.EPS) THEN
1391
1392                 ME(1) = ME(1)+LAMC(2)**2*MX(GU-1)**2*(MQS-UH)*(MNS-UH)*
1393
1394      &                 (A(SP,GU-1)**2+B(SP,GU-1)**2)/(UH-MS2(GU-1))**2
1395
1396      &             +LAMC(2)**2*TWO*MX(GU)*MX(GU-1)*(MQS-UH)*(MNS-UH)*
1397
1398      &                 (A(SP,GU)*A(SP,GU-1)+B(SP,GU)*B(SP,GU-1))
1399
1400      &                 /(UH-MS2(GU))/(UH-MS2(GU-1))
1401
1402      &             +TWO*LAMC(1)*LAMC(2)*MX(GR)*MX(GU-1)*
1403
1404      &                 (SH-MS2(GR))*SCF(GR)*A(SP,GU-1)*SH*
1405
1406      &                 (A(SP,GR)*UH+B(SP,GR)*MQ*MN)/(UH-MS2(GU-1))
1407
1408                 IF(ABS(MX(GT)).GT.EPS) ME(1)=ME(1)-LAMC(2)*LAMC(3)*TWO*
1409
1410      &               MX(GU-1)*MX(GT)*(MQS*MNS-UH*TH)*A(SP,GT)*A(SP,GU-1)
1411
1412      &               /(TH-MS2(GT))/(UH-MS2(GU-1))
1413
1414                 IF(ABS(MX(GT-1)).GT.EPS) ME(1)=ME(1)-LAMC(2)*LAMC(3)*
1415
1416      &               TWO*MX(GU-1)*MX(GT-1)*(MQS*MNS-UH*TH)*A(SP,GT-1)*
1417
1418      &               A(SP,GU-1)/(TH-MS2(GT-1))/(UH-MS2(GU-1))
1419
1420               ENDIF
1421
1422 C--t channel and t channel L/R mixing
1423
1424              IF(ABS(MX(GT-1)).GT.EPS) THEN
1425
1426                 ME(1) = ME(1)+LAMC(3)**2*MX(GT-1)**2*(MQS-TH)*(MNS-TH)*
1427
1428      &                 (A(SP,GT-1)**2+B(SP,GT-1)**2)/(TH-MS2(GT-1))**2
1429
1430      &              +LAMC(3)**2*TWO*MX(GT)*MX(GT-1)*(MQS-TH)*(MNS-TH)*
1431
1432      &                 (A(SP,GT)*A(SP,GT-1)+B(SP,GT)*B(SP,GT-1))
1433
1434      &                 /(TH-MS2(GT))/(TH-MS2(GT-1))
1435
1436      &              +LAMC(1)*LAMC(3)*TWO*MX(GR)*MX(GT-1)*
1437
1438      &                 (SH-MS2(GR))*SCF(GR)*A(SP,GT-1)*SH*
1439
1440      &                 (A(SP,GR)*TH+B(SP,GR)*MQ*MN)/(TH-MS2(GT-1))
1441
1442                 IF(ABS(MX(GU)).GT.EPS) ME(1)=ME(1)-LAMC(2)*LAMC(3)*TWO*
1443
1444      &               MX(GU)*MX(GT-1)*(MQS*MNS-UH*TH)*A(SP,GT-1)*A(SP,GU)
1445
1446      &               /(TH-MS2(GT-1))/(UH-MS2(GU))
1447
1448               ENDIF
1449
1450 c--phase space factors
1451
1452               MEC(L,GN,I,J) = G**2*FAC*ME(1)*PCM
1453
1454  210       CON = 4
1455
1456            I2 = SP+2
1457
1458            IF(MOD(K,2).EQ.1) I2 =I2+2
1459
1460            HCS=HCS+MEC(L,GN,I,J)*DISF(I1,1)*DISF(J1,2)
1461
1462            IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(3,I1,J1,K,I2,0,0,*900)
1463
1464            HCS=HCS+MEC(L,GN,I,J)*DISF(J1,1)*DISF(I1,2)
1465
1466            IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(4,J1,I1,K,I2,0,0,*900)
1467
1468            HCS=HCS+MEC(L,GN,I,J)*DISF(I1+6,1)*DISF(J1+6,2)
1469
1470            IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(3,I1,J1,K,I2+2,1,0,*900)
1471
1472            HCS=HCS+MEC(L,GN,I,J)*DISF(J1+6,1)*DISF(I1+6,2)
1473
1474            IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(4,J1,I1,K,I2+2,1,0,*900)
1475
1476  220       CONTINUE
1477
1478           ENDDO
1479
1480  230      CONTINUE
1481
1482  240      CONTINUE
1483
1484 C--Now the radiative decays, if possible
1485
1486  300  IF(.NOT.RAD.OR.(CHAN(5).LT.EPS.AND.CHAN(11).LT.EPS)) GOTO 400
1487
1488       IF(GENEV) GOTO 320
1489
1490       DO 310 I=1,6
1491
1492  310  MER(I)=ZERO
1493
1494 C--stop to light stop and Z
1495
1496       IF(SH.GT.(MZ+MS(11))**2) THEN
1497
1498         PCM = SQRT((SH-(MZ+MS(11))**2)*(SH-(MZ-MS(11))**2))*HALF/SQSH
1499
1500         ECM=SQRT(PCM**2+MZ2)
1501
1502         TH = MZ2-SQSH*(ECM-PCM*COSTH)
1503
1504         UH = MZ2-SQSH*(ECM+PCM*COSTH)
1505
1506         MER(3) = SH**2*PCM**2*(SCF(11)*ZSQU(2,1)**2*QMIXSS(6,2,1)**2
1507
1508      &             +SCF(12)*ZSQU(2,2)**2*QMIXSS(6,2,2)**2
1509
1510      &             +TWO*SCF(11)*SCF(12)*QMIXSS(6,2,1)*QMIXSS(6,2,2)*
1511
1512      &                ZSQU(2,1)*ZSQU(2,2)*((SH-MS2(11))*
1513
1514      &                (SH-MS2(12))+MSWD(11)*MSWD(12)))
1515
1516      &       +QMIXSS(6,2,1)**2/UH**2*ZQRK(1)**2*(
1517
1518      &             TWO*MZ2*(UH*TH-MS2(11)*MZ2)+UH**2*SH)
1519
1520      &       +QMIXSS(6,2,1)**2/TH**2*ZQRK(1)**2*(
1521
1522      &             TWO*MZ2*(UH*TH-MS2(11)*MZ2)+TH**2*SH)
1523
1524      &       +ZQRK(1)*SH*QMIXSS(6,2,1)*
1525
1526      &            (QMIXSS(6,2,1)*ZSQU(2,1)*(SH-MS2(11))*SCF(11)
1527
1528      &            +QMIXSS(6,2,2)*ZSQU(2,2)*(SH-MS2(12))*SCF(12))
1529
1530      &            *((MZ2*(TWO*MS2(11)-TH)+TH*(SH-MS2(11)))/TH
1531
1532      &             +(MZ2*(TWO*MS2(11)-UH)+UH*(SH-MS2(11)))/UH)
1533
1534      &       -TWO*QMIXSS(6,2,1)**2/UH/TH*ZQRK(1)**2*
1535
1536      &            (TWO*MZ2*(MS2(11)-UH)*(MS2(11)-TH)-SH*TH*UH)
1537
1538         MER(3) = MER(3)*FOUR*PCM/MZ2
1539
1540       ENDIF
1541
1542 C--sbottom to light sbottom and Z
1543
1544       IF(SH.GT.(MZ+MS(5))**2) THEN
1545
1546         PCM = SQRT((SH-(MZ+MS(5))**2)*(SH-(MZ-MS(5))**2))*HALF/SQSH
1547
1548         ECM=SQRT(PCM**2+MZ2)
1549
1550         TH = MZ2-SQSH*(ECM-PCM*COSTH)
1551
1552         UH = MZ2-SQSH*(ECM+PCM*COSTH)
1553
1554         MER(6) = SH**2*PCM**2*(SCF(5)*QMIXSS(5,2,1)**2*ZSQU(1,1)**2
1555
1556      &                +SCF(6)*QMIXSS(5,2,2)**2*ZSQU(1,2)**2
1557
1558      &                +TWO*SCF(5)*SCF(6)*QMIXSS(5,2,1)*QMIXSS(5,2,2)*
1559
1560      &                 ZSQU(1,1)*ZSQU(1,2)*((SH-MS2(5))*
1561
1562      &                 (SH-MS2(6))+MSWD(5)*MSWD(6)))
1563
1564      &       +QMIXSS(5,2,1)**2/UH**2*ZQRK(1)**2*
1565
1566      &           (TWO*MZ2*(UH*TH-MS2(5)*MZ2)+UH**2*SH)
1567
1568      &       +QMIXSS(5,2,1)**2/TH**2*ZQRK(2)**2*
1569
1570      &           (TWO*MZ2*(UH*TH-MS2(5)*MZ2)+TH**2*SH)
1571
1572      &       +QMIXSS(5,2,1)*SH*
1573
1574      &           (QMIXSS(5,2,1)*ZSQU(1,1)*(SH-MS2(5))*SCF(5)
1575
1576      &           +QMIXSS(5,2,2)*ZSQU(1,2)*(SH-MS2(6))*SCF(6))*
1577
1578      &            (ZQRK(1)/UH*(MZ2*(TWO*MS2(5)-UH)+(SH-MS2(5))*UH)
1579
1580      &            +ZQRK(2)/TH*(MZ2*(TWO*MS2(5)-TH)+(SH-MS2(5))*TH))
1581
1582      &       -TWO*QMIXSS(5,2,1)**2*ZQRK(1)*ZQRK(2)/UH/TH*
1583
1584      &            (TWO*MZ2*(MS2(5)-UH)*(MS2(5)-TH)-SH*TH*UH)
1585
1586         MER(6) = MER(6)*FOUR*PCM/MZ2
1587
1588       ENDIF
1589
1590 C--stop to sbottom and W
1591
1592       DO J=1,2
1593
1594         IF(SH.GT.(MW+MS(4+J))**2) THEN
1595
1596           PCM =SQRT((SH-(MW+MS(4+J))**2)*(SH-(MW-MS(4+J))**2))*HALF/SQSH
1597
1598 C--diagram square pieces
1599
1600           DO I=1,2
1601
1602             MER(J)=MER(J)+SCF(10+I)*
1603
1604      &             (QMIXSS(6,2,I)*QMIXSS(6,1,I)*QMIXSS(5,1,J))**2
1605
1606           ENDDO
1607
1608 C--light/heavy interference
1609
1610           MER(J)=TWO*SH**2*PCM**3/MW2*(MER(J)+TWO*SCF(11)*SCF(12)*
1611
1612      &          ((SH-MS2(11))*(SH-MS2(12))
1613
1614      &          +MSWD(11)*MSWD(12))*QMIXSS(5,1,J)**2*
1615
1616      &          QMIXSS(6,2,1)*QMIXSS(6,2,2)*QMIXSS(6,1,1)*QMIXSS(6,1,2))
1617
1618         ENDIF
1619
1620 C--sbottom to stop and W
1621
1622         IF(SH.GT.(MW+MS(10+J))**2) THEN
1623
1624          PCM=SQRT((SH-(MW+MS(10+J))**2)*(SH-(MW-MS(10+J))**2))*HALF/SQSH
1625
1626 C--diagram square pieces
1627
1628           DO I=1,2
1629
1630             MER(J+3)=MER(J+3)+SCF(4+I)*
1631
1632      &           (QMIXSS(5,2,I)*QMIXSS(5,1,I)*QMIXSS(6,1,J))**2
1633
1634           ENDDO
1635
1636 C--light/heavy interference
1637
1638           MER(J+3)=TWO*SH**2*PCM**3/MW2*(MER(J+3)+TWO*SCF(5)*SCF(6)*
1639
1640      &          ((SH-MS2(5))*(SH-MS2(6))+
1641
1642      &          MSWD(5)*MSWD(6))*QMIXSS(6,1,J)**2*
1643
1644      &          QMIXSS(5,2,1)*QMIXSS(5,2,2)*QMIXSS(5,1,1)*QMIXSS(5,1,2))
1645
1646         ENDIF
1647
1648       ENDDO
1649
1650 C--Now multiply by the parton distributions and phase space factors
1651
1652  320  DO J=1,3
1653
1654         DO K=1,3
1655
1656           CON = 5
1657
1658 C--resonant stop's
1659
1660           IF(ABS(LAMDA3(3,J,K)).GT.EPS.AND.J.LT.K) THEN
1661
1662             FAC2 = LAMDA3(3,J,K)**2*FAC*G**2
1663
1664             DO I=1,3
1665
1666             I1=2*J-1
1667
1668             J1=2*K-1
1669
1670             ME2 = MER(I)*FAC2
1671
1672             HCS=HCS+ME2*DISF(I1,1)*DISF(J1,2)
1673
1674             IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(5,I1,J1,I,I,0,0,*900)
1675
1676             HCS=HCS+ME2*DISF(J1,1)*DISF(I1,2)
1677
1678             IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(6,J1,I1,I,I,0,0,*900)
1679
1680             HCS=HCS+ME2*DISF(I1+6,1)*DISF(J1+6,2)
1681
1682             IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(5,I1,J1,I,I,1,0,*900)
1683
1684             HCS=HCS+ME2*DISF(J1+6,1)*DISF(I1+6,2)
1685
1686             IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(6,J1,I1,I,I,1,0,*900)
1687
1688             ENDDO
1689
1690           ENDIF
1691
1692 C--resonant sbottom's
1693
1694           IF(ABS(LAMDA3(J,K,3)).GT.EPS) THEN
1695
1696             FAC2 = LAMDA3(J,K,3)**2*FAC*G**2
1697
1698             DO I=4,6
1699
1700             I1=2*J
1701
1702             J1=2*K-1
1703
1704             ME2 = MER(I)*FAC2
1705
1706             HCS=HCS+ME2*DISF(I1,1)*DISF(J1,2)
1707
1708             IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(5,I1,J1,I,I,0,0,*900)
1709
1710             HCS=HCS+ME2*DISF(J1,1)*DISF(I1,2)
1711
1712             IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(6,J1,I1,I,I,0,0,*900)
1713
1714             HCS=HCS+ME2*DISF(I1+6,1)*DISF(J1+6,2)
1715
1716             IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(5,I1,J1,I,I,1,0,*900)
1717
1718             HCS=HCS+ME2*DISF(J1+6,1)*DISF(I1+6,2)
1719
1720             IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(6,J1,I1,I,I,1,0,*900)
1721
1722             ENDDO
1723
1724           ENDIF
1725
1726         ENDDO
1727
1728       ENDDO
1729
1730 C--Now the Higgs decays if possible
1731
1732  400  IF(.NOT.HIGGS) GOTO 900
1733
1734       IF(GENEV) GOTO 490
1735
1736       DO I=1,3
1737
1738          DO 405 J=1,42
1739
1740  405        MEH(I,J) = ZERO
1741
1742       ENDDO
1743
1744       DO I=1,3
1745
1746         DO 420 J=1,3
1747
1748 C--Neutral Higgs down type squark
1749
1750         IF(SQSH.LT.MH(J)+MS(2*I-1)) GOTO 410
1751
1752         PCM = SQRT((SH-(MH(J)+MS(2*I-1))**2)*
1753
1754      &             (SH-(MH(J)-MS(2*I-1))**2))*HALF/SQSH
1755
1756         ECM=SQRT(PCM**2+MH(J)**2)
1757
1758         TH = MH(J)**2-SQSH*(ECM-PCM*COSTH)
1759
1760         UH = MH(J)**2-SQSH*(ECM+PCM*COSTH)
1761
1762         MEH(1,3*I-3+J) = PCM*SH*(
1763
1764      &            QMIXSS(2*I-1,2,1)**2*SCF(2*I-1)*GHSQSS(J,2*I-1,1,1)**2
1765
1766      &             +QMIXSS(2*I-1,2,2)**2*SCF(2*I)*GHSQSS(J,2*I-1,2,1)**2
1767
1768      &              +TWO*QMIXSS(2*I-1,2,1)*QMIXSS(2*I-1,2,2)*SCF(2*I-1)
1769
1770      &               *SCF(2*I)*GHSQSS(J,2*I-1,1,1)*GHSQSS(J,2*I-1,2,1)*
1771
1772      &            ((SH-MS2(2*I-1))*(SH-MS2(2*I))+MSWD(2*I-1)*MSWD(2*I)))
1773
1774         MEH(2,3*I-3+J) = PCM*GUU(J)*QMIXSS(2*I,2,1)**2/TH**2*
1775
1776      &                   (TH*UH-MH(J)**2*MS2(2*I-1))
1777
1778         MEH(3,3*I-3+J) = PCM*GDD(J)*QMIXSS(2*I,2,1)**2/UH**2*
1779
1780      &                   (TH*UH-MH(J)**2*MS2(2*I-1))
1781
1782 C--Neutral Higgs up type squarks
1783
1784  410    IF(SQSH.LT.MH(J)+MS(2*I+5)) GOTO 420
1785
1786         PCM = SQRT((SH-(MH(J)+MS(2*I+5))**2)*
1787
1788      &             (SH-(MH(J)-MS(2*I+5))**2))*HALF/SQSH
1789
1790         ECM=SQRT(PCM**2+MH(J)**2)
1791
1792         TH = MH(J)**2-SQSH*(ECM-PCM*COSTH)
1793
1794         UH = MH(J)**2-SQSH*(ECM+PCM*COSTH)
1795
1796         MEH(1,3*I+6+J) = PCM*SH*(
1797
1798      &               QMIXSS(2*I,2,1)**2*SCF(2*I+5)*GHSQSS(J,2*I,1,1)**2
1799
1800      &              +QMIXSS(2*I,2,2)**2*SCF(2*I+6)*GHSQSS(J,2*I,2,1)**2
1801
1802      &              +TWO*QMIXSS(2*I,2,1)*QMIXSS(2*I,2,2)*SCF(2*I+5)
1803
1804      &               *SCF(2*I+6)*GHSQSS(J,2*I,1,1)*GHSQSS(J,2*I,2,1)*
1805
1806      &              ((SH-MS2(2*I+5))*(SH-MS2(2*I+6))+
1807
1808      &               MSWD(2*I+5)*MSWD(2*I+6)))
1809
1810         MEH(2,3*I+6+J) = PCM*GDD(J)*QMIXSS(2*I-1,2,1)**2/TH**2*
1811
1812      &                   (TH*UH-MH(J)**2*MS2(2*I+5))
1813
1814         MEH(3,3*I+6+J) = PCM*GDD(J)*QMIXSS(2*I-1,2,1)**2/UH**2*
1815
1816      &                   (TH*UH-MH(J)**2*MS2(2*I+5))
1817
1818  420    CONTINUE
1819
1820 C--Charged Higgs up type squark
1821
1822         DO 440 J=1,2
1823
1824         IF(SQSH.LT.MH(4)+MS(2*I+4+J)) GOTO 430
1825
1826         PCM = SQRT((SH-(MH(4)+MS(2*I+4+J))**2)*
1827
1828      &             (SH-(MH(4)-MS(2*I+4+J))**2))*HALF/SQSH
1829
1830         ECM=SQRT(PCM**2+MH(4)**2)
1831
1832         TH = MH(4)**2-SQSH*(ECM-PCM*COSTH)
1833
1834         UH = MH(4)**2-SQSH*(ECM+PCM*COSTH)
1835
1836         MEH(1,4*I+14+J) = PCM*SH*(
1837
1838      &              QMIXSS(2*I-1,2,1)**2*GHSQSS(4,2*I,J,1)**2*SCF(2*I-1)
1839
1840      &             +QMIXSS(2*I-1,2,2)**2*GHSQSS(4,2*I,J,2)**2*SCF(2*I)
1841
1842      &              +TWO*QMIXSS(2*I-1,2,1)*QMIXSS(2*I-1,2,2)*SCF(2*I-1)
1843
1844      &               *SCF(2*I)*GHSQSS(4,2*I,J,1)*GHSQSS(4,2*I,J,2)*
1845
1846      &              ((SH-MS2(2*I-1))*(SH-MS2(2*I))+
1847
1848      &                   MSWD(2*I-1)*MSWD(2*I)))
1849
1850         MEH(2,4*I+14+J) = PCM*QMIXSS(2*I,2,J)**2*GDD(4)/TH**2*
1851
1852      &                    (UH*TH-MS2(2*I+4+J)*MH(4)**2)
1853
1854 C--Charged Higgs down type squark
1855
1856  430    IF(SQSH.LT.MH(4)+MS(2*I-2+J)) GOTO 440
1857
1858         PCM = SQRT((SH-(MH(4)+MS(2*I-2+J))**2)*
1859
1860      &             (SH-(MH(4)-MS(2*I-2+J))**2))*HALF/SQSH
1861
1862         ECM=SQRT(PCM**2+MH(4)**2)
1863
1864         TH = MH(4)**2-SQSH*(ECM-PCM*COSTH)
1865
1866         UH = MH(4)**2-SQSH*(ECM+PCM*COSTH)
1867
1868         MEH(1,4*I+16+J) = PCM*SH*(
1869
1870      &              QMIXSS(2*I,2,1)**2*GHSQSS(4,2*I-1,J,1)**2*SCF(2*I+5)
1871
1872      &             +QMIXSS(2*I,2,2)**2*GHSQSS(4,2*I-1,J,2)**2*SCF(2*I+6)
1873
1874      &              +TWO*QMIXSS(2*I,2,1)*QMIXSS(2*I,2,2)*SCF(2*I+5)
1875
1876      &              *SCF(2*I+6)*GHSQSS(4,2*I-1,J,1)*GHSQSS(4,2*I-1,J,2)*
1877
1878      &              ((SH-MS2(2*I+5))*(SH-MS2(2*I+6))+
1879
1880      &              MSWD(2*I+5)*MSWD(2*I+6)))
1881
1882         MEH(2,4*I+16+J) = PCM*QMIXSS(2*I-1,2,J)**2*GUU(4)/TH**2*
1883
1884      &                    (UH*TH-MS2(2*I-2+J)*MH(4)**2)
1885
1886         MEH(3,4*I+16+J) = PCM*QMIXSS(2*I-1,2,J)**2*GUU(4)/UH**2*
1887
1888      &                    (UH*TH-MS2(2*I-2+J)*MH(4)**2)
1889
1890  440    CONTINUE
1891
1892       ENDDO
1893
1894  490  DO I=1,3
1895
1896       DO J=1,3
1897
1898         DO K=1,3
1899
1900           CON = 5
1901
1902           DO L=1,3
1903
1904           IF(ABS(LAMDA3(J,K,I)).GT.EPS) THEN
1905
1906 C--neutral higgs and sdown
1907
1908             FAC2 = FAC*G**2*LAMDA3(J,K,I)**2
1909
1910             I1=2*J
1911
1912             J1=2*K-1
1913
1914             ME2 = FAC2*(MEH(1,3*I-3+L)+RMASS(I1)**2*MEH(2,3*I-3+L)
1915
1916      &                  +RMASS(J1)**2*MEH(3,3*I-3+L))
1917
1918             HCS=HCS+ME2*DISF(I1,1)*DISF(J1,2)
1919
1920           IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(7,I1,J1,L,2*I-1,0,0,*900)
1921
1922              HCS=HCS+ME2*DISF(J1,1)*DISF(I1,2)
1923
1924           IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(8,J1,I1,L,2*I-1,0,0,*900)
1925
1926             IF(I2.NE.200) I2=198
1927
1928             HCS=HCS+ME2*DISF(I1+6,1)*DISF(J1+6,2)
1929
1930           IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(7,I1,J1,L,2*I-1,1,0,*900)
1931
1932             HCS=HCS+ME2*DISF(J1+6,1)*DISF(I1+6,2)
1933
1934           IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(8,J1,I1,L,2*I-1,1,0,*900)
1935
1936           ENDIF
1937
1938           IF(ABS(LAMDA3(I,J,K)).GT.EPS.AND.J.LT.K) THEN
1939
1940             FAC2 = FAC*G**2*LAMDA3(I,J,K)**2
1941
1942 C--neutral higgs and sup
1943
1944             I1=2*J-1
1945
1946             J1=2*K-1
1947
1948             ME2 = FAC2*(MEH(1,3*I+6+L)+RMASS(I1)**2*MEH(2,3*I+6+L)
1949
1950      &                  +RMASS(J1)**2*MEH(3,3*I+6+L))
1951
1952             HCS=HCS+ME2*DISF(I1,1)*DISF(J1,2)
1953
1954           IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(7,I1,J1,L,2*I+5,0,0,*900)
1955
1956             HCS=HCS+ME2*DISF(J1,1)*DISF(I1,2)
1957
1958           IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(8,J1,I1,L,2*I+5,0,0,*900)
1959
1960             HCS=HCS+ME2*DISF(I1+6,1)*DISF(J1+6,2)
1961
1962           IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(7,I1,J1,L,2*I+5,1,0,*900)
1963
1964             HCS=HCS+ME2*DISF(J1+6,1)*DISF(I1+6,2)
1965
1966           IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(8,J1,I1,L,2*I+5,1,0,*900)
1967
1968           ENDIF
1969
1970           ENDDO
1971
1972           DO L=1,2
1973
1974           IF(ABS(LAMDA3(J,K,I)).GT.EPS) THEN
1975
1976 C--charged higgs and sup
1977
1978             I1=2*J
1979
1980             J1=2*K-1
1981
1982             FAC2 = FAC*G**2
1983
1984             ME2 = FAC2*(LAMDA3(J,K,I)**2*MEH(1,4*I+L+14)
1985
1986      &                 +LAMDA3(I,J,K)**2*RMASS(I1-1)**2*MEH(2,4*I+L+14))
1987
1988             HCS= HCS+ME2*DISF(I1,1)*DISF(J1,2)
1989
1990         IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(7,I1,J1,4,2*I+4+L,0,0,*900)
1991
1992             HCS= HCS+ME2*DISF(J1,1)*DISF(I1,2)
1993
1994         IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(8,J1,I1,4,2*I+4+L,0,0,*900)
1995
1996             HCS= HCS+ME2*DISF(I1+6,1)*DISF(J1+6,2)
1997
1998         IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(7,I1,J1,5,2*I+4+L,1,0,*900)
1999
2000             HCS= HCS+ME2*DISF(J1+6,1)*DISF(I1+6,2)
2001
2002         IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(8,J1,I1,5,2*I+4+L,1,0,*900)
2003
2004            ENDIF
2005
2006 C--charged higgs and sdown
2007
2008           IF(ABS(LAMDA3(I,J,K)).GT.EPS.AND.J.LT.K) THEN
2009
2010             I1=2*J-1
2011
2012             J1=2*K-1
2013
2014             FAC2 = FAC*G**2
2015
2016             ME2 = FAC2*(MEH(1,4*I+L+16)*LAMDA3(I,J,K)**2
2017
2018      &                 +RMASS(I1+1)**2*LAMDA3(J,I,K)**2*MEH(2,4*I+L+16)
2019
2020      &                 +RMASS(J1+1)**2*LAMDA3(K,I,J)**2*MEH(3,4*I+L+16))
2021
2022             HCS=HCS+ME2*DISF(I1,1)*DISF(J1,2)
2023
2024         IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(7,I1,J1,5,2*I-2+L,0,0,*900)
2025
2026             HCS=HCS+ME2*DISF(J1,1)*DISF(I1,2)
2027
2028         IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(8,J1,I1,5,2*I-2+L,0,0,*900)
2029
2030             HCS=HCS+ME2*DISF(I1+6,1)*DISF(J1+6,2)
2031
2032         IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(7,I1,J1,4,2*I-2+L,1,0,*900)
2033
2034             HCS=HCS+ME2*DISF(J1+6,1)*DISF(I1+6,2)
2035
2036         IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(8,J1,I1,4,2*I-2+L,1,0,*900)
2037
2038           ENDIF
2039
2040           ENDDO
2041
2042         ENDDO
2043
2044       ENDDO
2045
2046       ENDDO
2047
2048 C--calculate of the matrix elements
2049
2050  900  IF(GENEV) THEN
2051
2052         CALL HWETWO
2053
2054         IF(IERROR.NE.0) RETURN
2055
2056         HVFCEN = .TRUE.
2057
2058 C--first stage of the colour connection corrections
2059
2060         DO THEP=1,5
2061
2062           IF(THEP.NE.3) THEN
2063
2064             JMOHEP(2,THEP+NHEP-5)=NHEP-5+THEP
2065
2066      &                       +CONECT(HWRINT(1,2),THEP,CON)
2067
2068             JDAHEP(2,THEP+NHEP-5) = JMOHEP(2,THEP+NHEP-5)
2069
2070           ENDIF
2071
2072         ENDDO
2073
2074         IF(IDHEP(NHEP-4).LT.0) THEN
2075
2076           JDAHEP(2,NHEP-4)=NHEP-1
2077
2078           JDAHEP(2,NHEP-3)=NHEP-3
2079
2080           JDAHEP(2,NHEP-1)=NHEP-4
2081
2082           IF(CON.EQ.5) JDAHEP(2,NHEP-4)=NHEP
2083
2084           JDAHEP(2,NHEP)=CONECT(1,6,CON)+NHEP
2085
2086         ELSE
2087
2088           JMOHEP(2,NHEP-4)=NHEP-1
2089
2090           JMOHEP(2,NHEP-3)=NHEP-3
2091
2092           JMOHEP(2,NHEP-1)=NHEP-4
2093
2094           IF(CON.EQ.5) JMOHEP(2,NHEP-4)=NHEP
2095
2096           JMOHEP(2,NHEP)=CONECT(1,6,CON)+NHEP
2097
2098         ENDIF
2099
2100         IF(CON.EQ.5) THEN
2101
2102           SP=JDAHEP(2,NHEP)
2103
2104           JDAHEP(2,NHEP) = JDAHEP(2,NHEP-1)
2105
2106           JDAHEP(2,NHEP-1) = SP
2107
2108           SP=JMOHEP(2,NHEP)
2109
2110           JMOHEP(2,NHEP) = JMOHEP(2,NHEP-1)
2111
2112           JMOHEP(2,NHEP-1) = SP
2113
2114         ENDIF
2115
2116         HRDCOL(1,1) = NHEP
2117
2118         HRDCOL(1,2) = NHEP-2
2119
2120       ELSE
2121
2122         EVWGT = HCS
2123
2124       ENDIF
2125
2126  999  END
2127
2128 CDECK  ID>, HWHREM.
2129
2130 *CMZ :-        -01/06/94  17.03.31  by  Mike Seymour
2131
2132 *-- Author :    Mike Seymour
2133
2134 C-----------------------------------------------------------------------
2135
2136       SUBROUTINE HWHREM(IBEAM,ITARG)
2137
2138 C-----------------------------------------------------------------------
2139
2140 C     IDENTIFY THE REMNANTS OF THE HARD SCATTERING
2141
2142 C     AND BREAK THEIR COLOUR CONNECTION IF NECESSARY
2143
2144 C-----------------------------------------------------------------------
2145
2146       INCLUDE 'HERWIG61.INC'
2147
2148       DOUBLE PRECISION PCL(5)
2149
2150       INTEGER IBEAM,ITARG,IHEP,NTEMP,I,ICOL,IANT
2151
2152       LOGICAL LTEMP,T,COL,ANT
2153
2154       PARAMETER (T=.TRUE.)
2155
2156       COL(I)=I.EQ.13 .OR. I.GE.1.AND.I.LE.6 .OR. I.GE.115.AND.I.LE.120
2157
2158       ANT(I)=I.EQ.13 .OR. I.GE.7.AND.I.LE.12.OR. I.GE.109.AND.I.LE.114
2159
2160 C---LOOK FOR UNTREATED BEAM AND TARGET REMNANTS
2161
2162       IBEAM=0
2163
2164       ITARG=0
2165
2166       DO 10 IHEP=1,NHEP
2167
2168         IF (ISTHEP(IHEP).EQ.148) THEN
2169
2170           IF (ITARG.NE.0) CALL HWWARN('HWHREM',100,*999)
2171
2172           ITARG=IHEP
2173
2174         ELSEIF (ISTHEP(IHEP).EQ.147) THEN
2175
2176           IF (IBEAM.NE.0) CALL HWWARN('HWHREM',101,*999)
2177
2178           IBEAM=IHEP
2179
2180         ENDIF
2181
2182   10  CONTINUE
2183
2184       IF (ITARG.EQ.0) CALL HWWARN('HWHREM',102,*999)
2185
2186       IF (IBEAM.EQ.0) CALL HWWARN('HWHREM',103,*999)
2187
2188 C---IF THEY ARE COLOUR CONNECTED, DISCONNECT THEM BY EMITTING A SOFT
2189
2190 C   GLUON AND SPLITTING THAT GLUON TO LIGHT QUARKS
2191
2192 C  (WHICH NORMALLY GETS DONE AS THE FIRST STAGE OF CLUSTER FORMATION)
2193
2194 C---LOOP OVER COLOUR/ANTICOLOUR LINE
2195
2196       DO 20 I=1,2
2197
2198         IF (I.EQ.1) THEN
2199
2200           ICOL=IBEAM
2201
2202           IANT=ITARG
2203
2204         ELSE
2205
2206           ICOL=ITARG
2207
2208           IANT=IBEAM
2209
2210         ENDIF
2211
2212         IF (COL(IDHW(ICOL)).AND.ANT(IDHW(IANT)).AND.
2213
2214      $       JMOHEP(2,ICOL).EQ.IANT.AND.JDAHEP(2,IANT).EQ.ICOL) THEN
2215
2216           CALL HWVSUM(4,PHEP(1,ICOL),PHEP(1,IANT),PCL)
2217
2218           CALL HWUMAS(PCL)
2219
2220           NTEMP=NHEP
2221
2222           CALL HWCCUT(ICOL,IANT,PCL,T,LTEMP)
2223
2224 C---IF NOTHING WAS CREATED THEY MUST BE BELOW THRESHOLD, SO GIVE UP
2225
2226           IF (NHEP.NE.NTEMP+2) RETURN
2227
2228 C---RELABEL THEM AS PERTUBATIVE JUST TO NEATEN UP THE EVENT RECORD
2229
2230           ISTHEP(NHEP-1)=149
2231
2232           ISTHEP(NHEP)=149
2233
2234         ENDIF
2235
2236  20   CONTINUE
2237
2238  999  END
2239
2240 CDECK  ID>, HWHRLL.
2241
2242 *CMZ :-        -13/12/99  15:12:21  by  Peter Richardson
2243
2244 *-- Author :    Peter Richardson
2245
2246 C-----------------------------------------------------------------------
2247
2248       SUBROUTINE HWHRLL
2249
2250 C-----------------------------------------------------------------------
2251
2252 C  Subroutine for resonant sleptons to standard model particles
2253
2254 C-----------------------------------------------------------------------
2255
2256       INCLUDE 'HERWIG61.INC'
2257
2258       DOUBLE PRECISION HCS,S,RCS,HWR,FAC,ECM,TH,PCM,CFAC,CHANPB,SH,
2259
2260      &                 TAU,TAUA,TAUB,LOWTLM,UPPTLM,HWRUNI,MSL(12),
2261
2262      &                 SQSH,MET(2),SCF(12),MIX(12),ME(4,3,3,3,3,2),
2263
2264      &                 RAND,CHAN(12),LAM(2,7,3,3,3,3),SLWD(12),RTAB,
2265
2266      &                 WD,MQ1,MQ2,EPS,XMIN,XMAX,XPOW,XUPP,MSL2(12),
2267
2268      &                 MSWD(12)
2269
2270       INTEGER I,J,K,L,I1,J1,K1,L1,GEN,GN,GR,GNMX,GNMN,MIG,MXG,CUP,CF
2271
2272       LOGICAL FIRST
2273
2274       EXTERNAL HWR,HWRUNI
2275
2276       PARAMETER(EPS=1D-20)
2277
2278       COMMON/HWRPIN/XMIN,XMAX,XPOW,FIRST
2279
2280       SAVE HCS,ME,MSL,SLWD,LAM,MIX,CHAN,GNMN,GNMX,SH,SQSH,FAC,SCF
2281
2282       IF(GENEV) THEN
2283
2284         RCS = HCS*HWR()
2285
2286       ELSE
2287
2288         IF(FSTWGT) THEN
2289
2290           DO I=1,3
2291
2292             MSL(2*I-1)  = RMASS(423+2*I)
2293
2294             MSL(2*I)    = RMASS(435+2*I)
2295
2296             MSL(2*I+5)  = RMASS(424+2*I)
2297
2298             MSL(2*I+6)  = RMASS(436+2*I)
2299
2300             SLWD(2*I-1) = HBAR/RLTIM(423+2*I)
2301
2302             SLWD(2*I)   = HBAR/RLTIM(435+2*I)
2303
2304             SLWD(2*I+5) = HBAR/RLTIM(424+2*I)
2305
2306             SLWD(2*I+6) = HBAR/RLTIM(436+2*I)
2307
2308           ENDDO
2309
2310           DO I=1,12
2311
2312              MSL2(I) = MSL(I)**2
2313
2314              MSWD(I) = MSL(I)*SLWD(I)
2315
2316           ENDDO
2317
2318           RAND = ZERO
2319
2320           DO I=1,3
2321
2322             CHANPB=ZERO
2323
2324             DO J=1,3
2325
2326               DO K=1,3
2327
2328                 CHANPB=CHANPB+LAMDA2(I,J,K)**4
2329
2330               ENDDO
2331
2332             ENDDO
2333
2334             RAND=RAND+2*CHANPB
2335
2336             DO J=1,2
2337
2338               CHAN(2*I-2+J) = LMIXSS(2*I-1,1,J)**2*CHANPB
2339
2340               CHAN(2*I+4+J) = LMIXSS(2*I  ,1,J)**2*CHANPB
2341
2342               MIX(2*I-2+J)  = LMIXSS(2*I-1,1,J)**2
2343
2344               MIX(2*I+4+J)  = LMIXSS(2*I  ,1,J)**2
2345
2346             ENDDO
2347
2348           ENDDO
2349
2350           IF(RAND.GT.ZERO) THEN
2351
2352             DO I=1,12
2353
2354               CHAN(I)=CHAN(I)/RAND
2355
2356             ENDDO
2357
2358           ELSE
2359
2360             CALL HWWARN('HWHRLL',500,*999)
2361
2362           ENDIF
2363
2364 C--find the couplings
2365
2366           DO GN=1,3
2367
2368             DO I=1,3
2369
2370               DO J=1,3
2371
2372                 DO K=1,3
2373
2374                   DO L=1,3
2375
2376                     LAM(1,GN,I,J,K,L)  =LAMDA2(GN,I,J)*LAMDA1(GN,K,L)
2377
2378                     LAM(2,GN,I,J,K,L)  =LAMDA2(GN,I,J)*LAMDA2(GN,K,L)
2379
2380                     LAM(1,GN+3,I,J,K,L)=LAM(1,GN,I,J,K,L)
2381
2382                     LAM(2,GN+3,I,J,K,L)=LAM(2,GN,I,J,K,L)
2383
2384                   ENDDO
2385
2386                 ENDDO
2387
2388               ENDDO
2389
2390             ENDDO
2391
2392           ENDDO
2393
2394 C--select the process from the IPROC code
2395
2396           GNMN = 1
2397
2398           GNMX = 4
2399
2400           IF(IPROC.EQ.4070) THEN
2401
2402             GNMX = 2
2403
2404           ELSEIF(IPROC.EQ.4080) THEN
2405
2406             GNMN = 3
2407
2408           ENDIF
2409
2410         ENDIF
2411
2412         EVWGT = ZERO
2413
2414         S     = PHEP(5,3)**2
2415
2416         COSTH = HWRUNI(0,-ONE,ONE)
2417
2418 C--Generate the smoothing
2419
2420         RAND=HWRUNI(0,ZERO,ONE)
2421
2422         DO I=1,12
2423
2424           IF(CHAN(I).GT.RAND) GOTO 20
2425
2426           RAND=RAND-CHAN(I)
2427
2428         ENDDO
2429
2430  20     GR = I
2431
2432 C--Calculate hard scale and obtain parton distributions
2433
2434         TAUA   = MSL2(GR)/S
2435
2436         TAUB   = SLWD(GR)**2/S
2437
2438         RTAB   = SQRT(TAUA*TAUB)
2439
2440         XUPP = XMAX
2441
2442         IF(XMAX**2.GT.S) XUPP = SQRT(S)
2443
2444         LOWTLM = DATAN((XMIN**2/S-TAUA)/RTAB)/RTAB
2445
2446         UPPTLM = DATAN((XUPP**2/S-TAUA)/RTAB)/RTAB
2447
2448         TAU    = HWRUNI(0,LOWTLM,UPPTLM)
2449
2450         TAU    = RTAB*TAN(RTAB*TAU)+TAUA
2451
2452         SH     = S*TAU
2453
2454         SQSH   = SQRT(SH)
2455
2456         EMSCA  = SQSH
2457
2458         XX(1)  = EXP(HWRUNI(0,ZERO,LOG(TAU)))
2459
2460         XX(2)  = TAU/XX(1)
2461
2462         CALL HWSGEN(.FALSE.)
2463
2464 C--Calculate the prefactor due multichannel approach
2465
2466         FAC = ZERO
2467
2468         DO GN=1,12
2469
2470          SCF(GN)=1/((SH-MSL2(GN))**2+MSWD(GN)**2)
2471
2472          FAC=FAC+CHAN(GN)*SCF(GN)
2473
2474         ENDDO
2475
2476         FAC=-(UPPTLM-LOWTLM)*LOG(TAU)*GEV2NB
2477
2478      &         /(96*PIFAC*SQSH*SH*TAU*FAC*S**2)
2479
2480       ENDIF
2481
2482 C--Now the loop to actually calculate the cross-sections
2483
2484       HCS = ZERO
2485
2486       DO GN=GNMN,GNMX
2487
2488         IF(MOD(GN,2).EQ.1) THEN
2489
2490           MIG = 1
2491
2492           MXG = 6
2493
2494         ELSE
2495
2496           MIG = 7
2497
2498           MXG = 12
2499
2500         ENDIF
2501
2502         IF(GN.LE.2) THEN
2503
2504           CFAC = THREE*FAC
2505
2506           CUP=2
2507
2508         ELSE
2509
2510           CFAC = FAC
2511
2512           CUP=1
2513
2514         ENDIF
2515
2516         DO K1=1,3
2517
2518           DO 80 L1=1,3
2519
2520             IF(GN.EQ.1) THEN
2521
2522               K = 2*K1
2523
2524               L = 2*L1+5
2525
2526             ELSEIF(GN.EQ.2) THEN
2527
2528               K = 2*K1-1
2529
2530               L = 2*L1+5
2531
2532             ELSEIF(GN.EQ.3) THEN
2533
2534               K = 120+2*K1
2535
2536               L = 125+2*L1
2537
2538             ELSEIF(GN.EQ.4) THEN
2539
2540               K = 119+2*K1
2541
2542               L = 125+2*L1
2543
2544             ENDIF
2545
2546             MQ1 = RMASS(K)
2547
2548             MQ2 = RMASS(L)
2549
2550             IF(SQSH.GT.(MQ1+MQ2)) THEN
2551
2552               PCM = SQRT((SH-(MQ1+MQ2)**2)*(SH-(MQ1-MQ2)**2))/(2*SQSH)
2553
2554               WD = (SH-MQ1**2-MQ2**2)*SH*PCM
2555
2556             ELSE
2557
2558               GOTO 80
2559
2560             ENDIF
2561
2562             DO I1=1,3
2563
2564               DO 70 J1=1,3
2565
2566                 IF(MOD(GN,2).EQ.1) THEN
2567
2568                   I=2*I1
2569
2570                   J=2*J1+5
2571
2572                 ELSE
2573
2574                   I=2*I1-1
2575
2576                   J=2*J1+5
2577
2578                 ENDIF
2579
2580                 DO GR =1,2
2581
2582                   MET(GR) = ZERO
2583
2584                 ENDDO
2585
2586                 IF(GENEV) GOTO 60
2587
2588                 DO 50 GEN=MIG,MXG
2589
2590                   IF(ABS(LAM(CUP,INT((GEN+1)/2),I1,J1,K1,L1)).LT.EPS.
2591
2592      &                OR.ABS(MIX(GEN)).LT.EPS) GOTO 50
2593
2594                   DO GR=MIG,MXG
2595
2596                     IF(ABS(LAM(CUP,INT((GR+1)/2),I1,J1,K1,L1)).GT.EPS.
2597
2598      &                AND.ABS(MIX(GR)).GT.EPS) THEN
2599
2600                       MET(1) =MET(1)+SCF(GEN)*SCF(GR)*WD*
2601
2602      &                 ((SH-MSL2(GEN))*(SH-MSL2(GR))+MSWD(GEN)*MSWD(GR))
2603
2604      &                 *LAM(CUP,INT((GEN+1)/2),I1,J1,K1,L1)*MIX(GEN)
2605
2606      &                 *LAM(CUP,INT((GR+1)/2),I1,J1,K1,L1)*MIX(GR)
2607
2608                     ENDIF
2609
2610                   ENDDO
2611
2612 C--Now the t-channel diagrams if the s-channel particles is a sneutrino
2613
2614                   IF(GN.EQ.2) THEN
2615
2616                     ECM=SQRT(PCM**2+MQ1**2)
2617
2618                     TH=MQ1**2-SQSH*(ECM-PCM*COSTH)
2619
2620                     DO GR=MIG,MXG
2621
2622                       MET(2)=MET(2)+(MQ1**2-TH)*(MQ2**2-TH)*PCM*
2623
2624      &                       LAM(2,INT((GEN+1)/2),I1,K1,J1,L1)*MIX(GEN)*
2625
2626      &                       LAM(2,INT((GR+1)/2),I1,K1,J1,L1)*MIX(GR)
2627
2628      &                       /((TH-MSL2(GEN))*(TH-MSL2(GR)))
2629
2630                     ENDDO
2631
2632                    ENDIF
2633
2634  50              CONTINUE
2635
2636 C--final phase space factors
2637
2638                 IF(MET(1).LT.EPS.AND.MET(2).LT.EPS) GOTO 70
2639
2640                 DO GR = 1,2
2641
2642                   ME(GN,I1,J1,K1,L1,GR) = MET(GR)*CFAC
2643
2644                 ENDDO
2645
2646  60             DO GR = 1,2
2647
2648                   CF = GR
2649
2650                   IF(CUP.EQ.1) CF=0
2651
2652                   HCS = HCS+ME(GN,I1,J1,K1,L1,GR)*DISF(I,1)*DISF(J,2)
2653
2654                   IF(HCS.GT.RCS.AND.GENEV)
2655
2656      &                           CALL HWHRSS(9,I,J,K,L,0,CF,*100)
2657
2658                   HCS = HCS+ME(GN,I1,J1,K1,L1,GR)*DISF(J,1)*DISF(I,2)
2659
2660                   IF(HCS.GT.RCS.AND.GENEV)
2661
2662      &                           CALL HWHRSS(10,J,I,K,L,0,CF,*100)
2663
2664                   HCS = HCS+ME(GN,I1,J1,K1,L1,GR)
2665
2666      &                                       *DISF(I+6,1)*DISF(J-6,2)
2667
2668                   IF(HCS.GT.RCS.AND.GENEV)
2669
2670      &                           CALL HWHRSS(9,I,J,K,L,1,CF,*100)
2671
2672                   HCS = HCS+ME(GN,I1,J1,K1,L1,GR)
2673
2674      &                                       *DISF(J-6,1)*DISF(I+6,2)
2675
2676                   IF(HCS.GT.RCS.AND.GENEV)
2677
2678      &                           CALL HWHRSS(10,J,I,K,L,1,CF,*100)
2679
2680                 ENDDO
2681
2682  70           CONTINUE
2683
2684             ENDDO
2685
2686  80       CONTINUE
2687
2688         ENDDO
2689
2690       ENDDO
2691
2692  100  IF(GENEV) THEN
2693
2694         CALL HWETWO
2695
2696       ELSE
2697
2698         EVWGT = HCS
2699
2700       ENDIF
2701
2702  999  END
2703
2704 CDECK  ID>, HWHRLS.
2705
2706 *CMZ :-        -20/10/99  09:46:43  by  Peter Richardson
2707
2708 *-- Author :    Peter Richardson
2709
2710 C-----------------------------------------------------------------------
2711
2712       SUBROUTINE HWHRLS
2713
2714 C-----------------------------------------------------------------------
2715
2716 C  Subroutine for 2 parton -> sparticle + X via LQD
2717
2718 C-----------------------------------------------------------------------
2719
2720       INCLUDE 'HERWIG61.INC'
2721
2722       DOUBLE PRECISION HCS,A(6,12),B(6,12),S,RCS,HWR,CW,FAC2,EC,ME2,
2723
2724      &               MW,G,TAU,TAUA,TAUB,LOWTLM,UPPTLM,HWRUNI,SW,SQSH,LC,
2725
2726      &               SH,MSL(12),MSU(12),MST(6),C(2,6,12),D(2,6,12),UH,
2727
2728      &               TH,MEN(4,6,3,3),SCF(12),SLWD(12),MLT(6),MNT(4),PCM,
2729
2730      &               MXS(12),MER(8),MCR(2),RTAB,H(18),MEH(3,18),MXT(12),
2731
2732      &               CHAN(12),MXU(12),RAND,FAC,ECM,MC(2),MEC(2,6,3,3),
2733
2734      &               MZ,CHPROB,EPS,HWUAEM,XMIN,XMAX,XPOW,SIN2B,GUU(4),
2735
2736      &               ML,MN,MLS,MNS,XUPP,MW2,MZ2,ZSLP(2),ZQRK(2),GDD(4),
2737
2738      &               MSL2(12),MH(4),MSWD(12)
2739
2740       INTEGER I,J,K,L,J1,K1,GN,GR,SP,GU,GT,I2,I1,NEUTMN
2741
2742      &        ,NEUTMX,CHARMN,CHARMX,P
2743
2744       LOGICAL RAD,NEUT,CHAR,HIGGS,FIRST
2745
2746       EXTERNAL HWR,HWRUNI,HWUAEM
2747
2748       COMMON/HWRPIN/XMIN,XMAX,XPOW,FIRST
2749
2750       SAVE HCS,A,B,C,D,FAC,MER,MEC,MEN,MLT,MSL,MSU,MST,SLWD,MNT,MXT,MXU,
2751
2752      &     SW,CW,MXS,H,MEH,CHAN,NEUTMN,NEUTMX,CHARMN,CHARMX,RAD,NEUT,
2753
2754      &     CHAR,HIGGS,MW,MZ,MW2,MZ2,MCR,SH,SQSH,EC,G,SCF,ZSLP,ZQRK,GUU,
2755
2756      &     GDD,MSL2,MH,MSWD
2757
2758       PARAMETER(EPS=1D-20)
2759
2760       IF(GENEV) THEN
2761
2762         RCS = HCS*HWR()
2763
2764       ELSE
2765
2766         IF(FSTWGT) THEN
2767
2768 C--Calculate Electroweak parameters needed
2769
2770           SW  = SQRT(SWEIN)
2771
2772           CW  = SQRT(1-SWEIN)
2773
2774           MW  = RMASS(198)
2775
2776           MZ  = RMASS(200)
2777
2778           MW2 = MW**2
2779
2780           MZ2 = MZ**2
2781
2782           SIN2B = TWO*SINB*COSB
2783
2784 C--Masses and widths
2785
2786           DO I=1,3
2787
2788             MSL(2*I-1)  = RMASS(423+2*I)
2789
2790             MSL(2*I)    = RMASS(435+2*I)
2791
2792             MSL(2*I+5)  = RMASS(424+2*I)
2793
2794             MSL(2*I+6)  = RMASS(436+2*I)
2795
2796             SLWD(2*I-1) = HBAR/RLTIM(423+2*I)
2797
2798             SLWD(2*I)   = HBAR/RLTIM(435+2*I)
2799
2800             SLWD(2*I+5) = HBAR/RLTIM(424+2*I)
2801
2802             SLWD(2*I+6) = HBAR/RLTIM(436+2*I)
2803
2804             MSU(2*I-1)  = RMASS(400+2*I)**2
2805
2806             MSU(2*I)    = RMASS(412+2*I)**2
2807
2808             MSU(2*I+5)  = RMASS(399+2*I)**2
2809
2810             MSU(2*I+6)  = RMASS(411+2*I)**2
2811
2812             MST(2*I-1)  = RMASS(399+2*I)**2
2813
2814             MST(2*I)    = RMASS(411+2*I)**2
2815
2816             MLT(2*I)    = ZERO
2817
2818             MLT(2*I-1)  = RMASS(119+2*I)
2819
2820           ENDDO
2821
2822           DO I=1,12
2823
2824              MSL2(I) = MSL(I)**2
2825
2826              MSWD(I) = MSL(I)*SLWD(I)
2827
2828           ENDDO
2829
2830           DO I=1,4
2831
2832             MNT(I)   = ABS(RMASS(449+I))
2833
2834           ENDDO
2835
2836           MCR(1) = ABS(RMASS(454))
2837
2838           MCR(2) = ABS(RMASS(455))
2839
2840 C--Couplings for the neutralinos
2841
2842           DO L=1,4
2843
2844             MC(1) =  ZMIXSS(L,3)/(2*MW*COSB*SW)
2845
2846             MC(2) =  ZMIXSS(L,4)/(2*MW*SINB*SW)
2847
2848             DO I=1,3
2849
2850               DO J=1,2
2851
2852 C--resonant charged sleptons
2853
2854                 A(L,2*I-2+J) = MC(1)*MLT(2*I-1)*LMIXSS(2*I-1,2,J)
2855
2856      &                         +SLFCH(9+2*I,L)*LMIXSS(2*I-1,1,J)
2857
2858                 B(L,2*I-2+J) = ZSGNSS(L)*(MC(1)*MLT(2*I-1)*
2859
2860      &            LMIXSS(2*I-1,1,J)+SRFCH(9+2*I,L)*LMIXSS(2*I-1,2,J))
2861
2862 C--resonant sneutrinos
2863
2864                 A(L,2*I+4+J) = SLFCH(10+2*I,L)*LMIXSS(2*I,1,J)
2865
2866                 B(L,2*I+4+J) = ZERO
2867
2868 C--u channel up type squarks
2869
2870                 C(1,L,2*I-2+J) = MC(2)*QMIXSS(2*I,2,J)*
2871
2872      &                    RMASS(2*I)+SLFCH(2*I,L)*QMIXSS(2*I,1,J)
2873
2874                 D(1,L,2*I-2+J) = ZSGNSS(L)*(MC(2)*QMIXSS(2*I,1,J)*
2875
2876      &                    RMASS(2*I)+SRFCH(2*I  ,L)*QMIXSS(2*I,2,J))
2877
2878 C--u channel down type squarks
2879
2880                 C(1,L,2*I+4+J) = MC(1)*QMIXSS(2*I-1,2,J)*
2881
2882      &                    RMASS(2*I-1)+SLFCH(2*I-1,L)*QMIXSS(2*I-1,1,J)
2883
2884                 D(1,L,2*I+4+J) = ZSGNSS(L)*(MC(1)*QMIXSS(2*I-1,1,J)*
2885
2886      &                    RMASS(2*I-1)+SRFCH(2*I-1,L)*QMIXSS(2*I-1,2,J))
2887
2888 C--t channel down type squarks
2889
2890                 C(2,L,2*I-2+J) = ZSGNSS(L)*(MC(1)*QMIXSS(2*I-1,1,J)*
2891
2892      &                    RMASS(2*I-1)+SRFCH(2*I-1,L)*QMIXSS(2*I-1,2,J))
2893
2894                 D(2,L,2*I-2+J) = MC(1)*QMIXSS(2*I-1,2,J)*
2895
2896      &                    RMASS(2*I-1)+SLFCH(2*I-1,L)*QMIXSS(2*I-1,1,J)
2897
2898               ENDDO
2899
2900             ENDDO
2901
2902             DO I=1,6
2903
2904               C(2,L,6+I) = C(2,L,I)
2905
2906               D(2,L,6+I) = D(2,L,I)
2907
2908             ENDDO
2909
2910           ENDDO
2911
2912 C--Couplings for charginos
2913
2914           DO L=1,2
2915
2916             MC(1) = 1/(SQRT(2.0D0)*MW*COSB)
2917
2918             MC(2) = 1/(SQRT(2.0D0)*MW*SINB)
2919
2920             SP=L+4
2921
2922             DO I=1,3
2923
2924               DO J=1,2
2925
2926 C--resonant charged slepton
2927
2928                 A(SP,2*I-2+J) = WMXUSS(L,1)*LMIXSS(2*I-1,1,J)
2929
2930      &                          -LMIXSS(2*I-1,2,J)*WMXUSS(L,2)*
2931
2932      &                             MLT(2*I-1)*MC(1)
2933
2934                 B(SP,2*I-2+J) = ZERO
2935
2936 C--resonant sneutrinos
2937
2938                 A(SP,2*I+4+J) = WSGNSS(L)*WMXVSS(L,1)*LMIXSS(2*I,1,J)
2939
2940                 B(SP,2*I+4+J) = -MLT(2*I-1)*WMXUSS(L,2)*LMIXSS(2*I,1,J)
2941
2942      &                           *MC(1)
2943
2944 C--u channel sup
2945
2946                 C(1,SP,2*I-2+J) = WSGNSS(L)*(WMXVSS(L,1)*QMIXSS(2*I,1,J)
2947
2948      &              -WMXVSS(L,2)*MC(2)*RMASS(2*I)*QMIXSS(2*I,2,J))
2949
2950                 D(1,SP,2*I-2+J) = -WMXUSS(L,2)*MC(1)*RMASS(2*I-1)
2951
2952      &                            *QMIXSS(2*I,1,J)
2953
2954 C--u channel sdown
2955
2956                 C(1,SP,2*I+4+J) = WMXUSS(L,1)*QMIXSS(2*I-1,1,J)
2957
2958      &              -WMXUSS(L,2)*MC(1)*RMASS(2*I-1)*QMIXSS(2*I-1,2,J)
2959
2960                 D(1,SP,2*I+4+J) = -WSGNSS(L)*WMXVSS(L,2)*MC(2)*
2961
2962      &                            RMASS(2*I)*QMIXSS(2*I-1,1,J)
2963
2964               ENDDO
2965
2966             ENDDO
2967
2968           ENDDO
2969
2970 C--Couplings and massesfor Higgs
2971
2972           DO I=1,4
2973
2974              MH(I) = RMASS(202+I)
2975
2976           ENDDO
2977
2978 C--first the neutral Higgs
2979
2980           DO I=1,3
2981
2982             H(I)  = -MLT(2*I-1)*HALF/MW/COSB*MUSS*COSA
2983
2984             H(I+4)  = -MLT(2*I-1)*HALF/MW/COSB*MUSS*SINA
2985
2986             H(I+8) =  MLT(2*I-1)*HALF/MW*MUSS
2987
2988           ENDDO
2989
2990           H(3) = (H(3)-MLT(5)*HALF/MW/COSB*ALSS*SINA)*TWO*
2991
2992      &           LMIXSS(5,2,1)*LMIXSS(5,1,1)
2993
2994      &           -MZ*SINBPA/CW*(LMIXSS(5,1,1)**2*(HALF-SWEIN)
2995
2996      &           +SWEIN*LMIXSS(5,2,1)**2)+MLT(5)**2*SINA/MW/COSB
2997
2998           H(4) = -MZ*SINBPA/CW*(LMIXSS(5,1,1)*LMIXSS(5,1,2)*(HALF-SWEIN)
2999
3000      &            +SWEIN*LMIXSS(5,2,1)*LMIXSS(5,2,2))
3001
3002      &            -MLT(5)*HALF/COSB/MW*(MUSS*COSA+ALSS*SINA)*
3003
3004      &         (LMIXSS(5,2,2)*LMIXSS(5,1,1)+LMIXSS(5,1,2)*LMIXSS(5,2,1))
3005
3006           H(7) = (H(7)+MLT(5)*HALF/MW/COSB*ALSS*COSA)*TWO*
3007
3008      &            LMIXSS(5,2,1)*LMIXSS(5,1,1)
3009
3010      &            +MZ*COSBPA/CW*(LMIXSS(5,1,1)**2*(HALF-SWEIN)
3011
3012      &            +LMIXSS(5,2,1)**2*SWEIN)-MLT(5)**2*COSA/MW/COSB
3013
3014           H(8) = MZ*COSBPA/CW*(LMIXSS(5,1,2)*LMIXSS(5,1,1)*(HALF-SWEIN)
3015
3016      &            +LMIXSS(5,2,2)*LMIXSS(5,2,1)*SWEIN)
3017
3018      &            -MLT(5)*HALF/MW/COSB*(MUSS*SINA-ALSS*COSA)*
3019
3020      &         (LMIXSS(5,2,2)*LMIXSS(5,1,1)+LMIXSS(5,1,2)*LMIXSS(5,2,1))
3021
3022           H(12) = H(11)+MLT(5)*HALF/MW*ALSS*TANB
3023
3024           H(11) = ZERO
3025
3026 C--Now the charged Higgs
3027
3028           DO J=1,2
3029
3030             DO I=1,3
3031
3032               H(10+2*I+J) = LMIXSS(2*I-1,1,J)*
3033
3034      &                                  (MLT(2*I-1)**2*TANB-MW2*SIN2B)
3035
3036      &                      -LMIXSS(2*I-1,2,J)*MLT(2*I-1)*MUSS
3037
3038             ENDDO
3039
3040             H(16+J) = H(16+J)-LMIXSS(5,2,J)*MLT(5)*ALSS*TANB
3041
3042           ENDDO
3043
3044 C--couplings of the Higgs to Squarks
3045
3046           DO I=1,3
3047
3048              GUU(I) = GHUUSS(I)**2/MW2*HALF**2
3049
3050              GDD(I) = GHDDSS(I)**2/MW2*HALF**2
3051
3052           ENDDO
3053
3054           GUU(4) = ONE/TANB**2/MW2/8.0D0
3055
3056           GDD(4) = ONE*TANB**2/MW2/8.0D0
3057
3058 C--Couplings of the Z to quarks, left up right down, and charged sleptons
3059
3060           ZQRK(1) = -SW**2/6.0D0/CW
3061
3062           ZQRK(2) =  (SW**2/3.0D0-HALF**2)/CW
3063
3064           ZSLP(1) =  HALF*(LMIXSS(5,1,1)**2-2.0D0*SW**2)/CW
3065
3066           ZSLP(2) =  HALF*LMIXSS(5,1,1)*LMIXSS(5,1,2)/CW
3067
3068 C--parameters for multichannel integration
3069
3070           RAND = ZERO
3071
3072           DO I=1,3
3073
3074             CHPROB = ZERO
3075
3076             DO J=1,3
3077
3078               DO K=1,3
3079
3080                 CHPROB=CHPROB+LAMDA2(I,J,K)**2
3081
3082               ENDDO
3083
3084             ENDDO
3085
3086             RAND = RAND+2*CHPROB
3087
3088             DO J=1,2
3089
3090               MXS(2*I-2+J)  = LMIXSS(2*I-1,1,J)
3091
3092               MXS(2*I+4+J)  = LMIXSS(2*I,1,J)
3093
3094               MXU(2*I-2+J)   = QMIXSS(2*I,1,J)
3095
3096               MXU(2*I+4+J)   = QMIXSS(2*I-1,1,J)
3097
3098               MXT(2*I-2+J)   = QMIXSS(2*I-1,2,J)
3099
3100               MXT(2*I+4+J)   = QMIXSS(2*I-1,2,J)
3101
3102               CHAN(2*I-2+J) = LMIXSS(2*I-1,1,J)**2*CHPROB
3103
3104               CHAN(2*I+4+J) = LMIXSS(2*I,1,J)**2*CHPROB
3105
3106             ENDDO
3107
3108           ENDDO
3109
3110           IF(RAND.GT.ZERO) THEN
3111
3112             DO I=1,12
3113
3114               CHAN(I)=CHAN(I)/RAND
3115
3116             ENDDO
3117
3118           ELSE
3119
3120             CALL HWWARN('HWHRLS',500,*999)
3121
3122           ENDIF
3123
3124 C--decide what processes to generate
3125
3126           RAD   = .FALSE.
3127
3128           NEUT  = .FALSE.
3129
3130           CHAR  = .FALSE.
3131
3132           HIGGS = .FALSE.
3133
3134           NEUTMN= 1
3135
3136           NEUTMX = 4
3137
3138           CHARMN = 1
3139
3140           CHARMX = 2
3141
3142 C--Decide which process to generate
3143
3144           IF(IPROC.EQ.4000) THEN
3145
3146             RAD   = .TRUE.
3147
3148             NEUT  = .TRUE.
3149
3150             CHAR  = .TRUE.
3151
3152             HIGGS = .TRUE.
3153
3154           ELSEIF(IPROC.LT.4020) THEN
3155
3156             IF(IPROC.NE.4010) THEN
3157
3158               NEUTMN = MOD(IPROC,10)
3159
3160               NEUTMX = NEUTMN
3161
3162             ENDIF
3163
3164             NEUT=.TRUE.
3165
3166           ELSEIF(IPROC.LT.4030) THEN
3167
3168             IF(IPROC.NE.4020) THEN
3169
3170               CHARMN = MOD(IPROC,10)
3171
3172               CHARMX=CHARMN
3173
3174             ENDIF
3175
3176             CHAR  = .TRUE.
3177
3178           ELSEIF(IPROC.EQ.4040) THEN
3179
3180             RAD   = .TRUE.
3181
3182           ELSEIF(IPROC.EQ.4050) THEN
3183
3184             HIGGS = .TRUE.
3185
3186           ENDIF
3187
3188         ENDIF
3189
3190 C--basic parameters
3191
3192         EVWGT = ZERO
3193
3194         S     = PHEP(5,3)**2
3195
3196         COSTH = HWRUNI(0,-ONE,ONE)
3197
3198         RAND  = HWRUNI(0,ZERO,ONE)
3199
3200 C--zero arrays
3201
3202         DO I=1,6
3203
3204           DO J=1,3
3205
3206             DO K=1,3
3207
3208               DO L=1,2
3209
3210                MEN(L,I,J,K)   = ZERO
3211
3212                MEN(L+2,I,J,K) = ZERO
3213
3214                MEC(L,I,J,K)   = ZERO
3215
3216               ENDDO
3217
3218             ENDDO
3219
3220           ENDDO
3221
3222         ENDDO
3223
3224         DO I=1,8
3225
3226           MER(I)=ZERO
3227
3228         ENDDO
3229
3230 C--Perform multichannel integration
3231
3232         DO I=1,12
3233
3234           IF(CHAN(I).GT.RAND) THEN
3235
3236              GR=I
3237
3238              GOTO 25
3239
3240           ENDIF
3241
3242           RAND=RAND-CHAN(I)
3243
3244         ENDDO
3245
3246 C--Calculate the hard scale and obtain parton distributions
3247
3248  25     TAUA   = MSL2(GR)/S
3249
3250         TAUB   = SLWD(GR)**2/S
3251
3252         RTAB   = SQRT(TAUA*TAUB)
3253
3254         XUPP = XMAX
3255
3256         IF(XMAX**2.GT.S) XUPP = SQRT(S)
3257
3258         LOWTLM = DATAN((XMIN**2/S-TAUA)/RTAB)/RTAB
3259
3260         UPPTLM = DATAN((XUPP**2/S-TAUA)/RTAB)/RTAB
3261
3262         TAU    = HWRUNI(0,LOWTLM,UPPTLM)
3263
3264         TAU    = RTAB*TAN(RTAB*TAU)+TAUA
3265
3266         SH   = S*TAU
3267
3268         SQSH = SQRT(SH)
3269
3270         EMSCA  = SQSH
3271
3272         XX(1)  = EXP(HWRUNI(0,LOG(TAU),ZERO))
3273
3274         XX(2)  = TAU/XX(1)
3275
3276         CALL HWSGEN(.FALSE.)
3277
3278 C--EM and Weak couplings
3279
3280         EC = SQRT(4*PIFAC*HWUAEM(SH))
3281
3282         G  = EC/SW
3283
3284 C--Calculate the prefactor due multichannel approach
3285
3286         FAC = ZERO
3287
3288         DO GN=1,12
3289
3290          SCF(GN)=1/((SH-MSL2(GN))**2+MSWD(GN)**2)
3291
3292          FAC=FAC+CHAN(GN)*SCF(GN)
3293
3294         ENDDO
3295
3296         FAC=-(UPPTLM-LOWTLM)*GEV2NB*LOG(TAU)/
3297
3298      &       (48*TAU*FAC*PIFAC*S**2*SH*SQSH)
3299
3300       ENDIF
3301
3302       HCS = ZERO
3303
3304 C--First we do the neutralino production
3305
3306       IF(.NOT.NEUT) GOTO 200
3307
3308       DO 140 GN=1,6
3309
3310       I=GN
3311
3312       GR = 2*GN-1
3313
3314       I1 = 2*GN-1
3315
3316       IF(GN.GT.3) THEN
3317
3318         I=I-3
3319
3320         I1=I1-5
3321
3322       ENDIF
3323
3324       IF(CHAN(GR).LT.EPS) GOTO 140
3325
3326         DO 130 L=NEUTMN,NEUTMX
3327
3328         MN  = MNT(L)
3329
3330         MNS = MN**2
3331
3332         ML  = MLT(I1)
3333
3334         MLS = ML**2
3335
3336         IF((ML+MN).GT.SQSH) GOTO 130
3337
3338 C--that and uhat
3339
3340         PCM = SQRT((SH-(ML+MN)**2)*(SH-(ML-MN)**2))*HALF/SQSH
3341
3342         ECM = SQRT(PCM**2+MLS)
3343
3344         TH = MLS-SQSH*(ECM-PCM*COSTH)
3345
3346         UH = MLS-SQSH*(ECM+PCM*COSTH)
3347
3348         DO J=1,3
3349
3350           DO 120 K=1,3
3351
3352             IF(ABS(LAMDA2(I,J,K)).LT.EPS) GOTO 120
3353
3354             J1 = 2*J
3355
3356             K1 = 2*K+5
3357
3358             IF(GN.GT.3) J1=J1-1
3359
3360             IF(GENEV) GOTO 110
3361
3362 C--squarks in u and t channels
3363
3364             GU = 6*INT((GN-1)/3)+2*J-1
3365
3366             GT = 2*K
3367
3368 C--calulate the matrix element
3369
3370             ME2=MXS(GR)**2*SCF(GR)*SH*((SH-MLS-MNS)*
3371
3372      &            (A(L,GR)**2+B(L,GR)**2)-4*ML*MN*A(L,GR)*B(L,GR))
3373
3374      &          +MXU(GU)**2*(MLS-UH)*(MNS-UH)*
3375
3376      &               (C(1,L,GU)**2+D(1,L,GU)**2)/(UH-MSU(GU))**2
3377
3378      &          +MXT(GT)**2*(MLS-TH)*(MNS-TH)*
3379
3380      &               (C(2,L,GT)**2+D(2,L,GT)**2)/(TH-MST(GT))**2
3381
3382      &          -TWO*MXT(GT)*MXU(GU)*C(1,L,GU)*C(2,L,GT)*(MLS*MNS-UH*TH)
3383
3384      &                 /(UH-MSU(GU))/(TH-MST(GT))
3385
3386      &          +TWO*MXS(GR)*MXU(GU)*(SH-MSL2(GR))*SCF(GR)*C(1,L,GU)*
3387
3388      &                 SH*(UH*A(L,GR)+ML*MN*B(L,GR))/(UH-MSU(GU))
3389
3390      &          +TWO*MXS(GR)*MXT(GT)*(SH-MSL2(GR))*SCF(GR)*C(2,L,GT)*
3391
3392      &                 SH*(TH*A(L,GR)+ML*MN*B(L,GR))/(TH-MST(GT))
3393
3394 C--s channel mixing L/R mixing
3395
3396             IF(ABS(MXS(GR+1)).GT.EPS) THEN
3397
3398               ME2=ME2+MXS(GR+1)**2*SCF(GR+1)*SH*((SH-MLS-MNS)*
3399
3400      &               (A(L,GR+1)**2+B(L,GR+1)**2)
3401
3402      &               -4*ML*MN*A(L,GR+1)*B(L,GR+1))
3403
3404      &            +TWO*MXS(GR)*MXS(GR+1)*SCF(GR)*SCF(GR+1)*
3405
3406      &               ((SH-MSL2(GR))*(SH-MSL2(GR+1))+
3407
3408      &               MSWD(GR)*MSWD(GR+1))*SH*
3409
3410      &               ((SH-MLS-MNS)*(A(L,GR)*A(L,GR+1)+B(L,GR)*B(L,GR+1))
3411
3412      &               -2*ML*MN*(A(L,GR)*B(L,GR+1)+A(L,GR+1)*B(L,GR)))
3413
3414      &            +TWO*MXS(GR+1)*MXU(GU)*(SH-MSL2(GR+1))*SCF(GR+1)*
3415
3416      &               SH*C(1,L,GU)*(UH*A(L,GR+1)+ML*MN*B(L,GR+1))
3417
3418      &               /(UH-MSU(GU))
3419
3420      &            +TWO*MXS(GR+1)*MXT(GT)*(SH-MSL2(GR+1))*SCF(GR+1)*
3421
3422      &               SH*C(2,L,GT)*(TH*A(L,GR+1)+ML*MN*B(L,GR+1))
3423
3424      &               /(TH-MST(GT))
3425
3426               IF(ABS(MXU(GU+1)).GT.EPS) ME2=ME2+TWO*MXS(GR+1)*MXU(GU+1)*
3427
3428      &               (SH-MSL2(GR+1))*SCF(GR+1)*SH*C(1,L,GU+1)*
3429
3430      &               (UH*A(L,GR+1)+ML*MN*B(L,GR+1))/(UH-MSU(GU+1))
3431
3432               IF(ABS(MXT(GT-1)).GT.EPS) ME2=ME2+TWO*MXS(GR+1)*MXT(GT-1)*
3433
3434      &               (SH-MSL2(GR+1))*SCF(GR+1)*SH*C(2,L,GT-1)*
3435
3436      &               (TH*A(L,GR+1)+ML*MN*B(L,GR+1))/(TH-MST(GT-1))
3437
3438             ENDIF
3439
3440 C--u channel L/R mixing
3441
3442             IF(ABS(MXU(GU+1)).GT.EPS) THEN
3443
3444               ME2=ME2+MXU(GU+1)**2*(MLS-UH)*(MNS-UH)*(C(1,L,GU+1)**2+
3445
3446      &               D(1,L,GU+1)**2)/(UH-MSU(GU+1))**2
3447
3448      &            +TWO*MXU(GU)*MXU(GU+1)*(MLS-UH)*(MNS-UH)*
3449
3450      &               (C(1,L,GU)*C(1,L,GU+1)+D(1,L,GU)*D(1,L,GU+1))
3451
3452      &               /(UH-MSU(GU))/(UH-MSU(GU+1))
3453
3454      &            -TWO*MXT(GT)*MXU(GU+1)*C(1,L,GU+1)*C(2,L,GT)*
3455
3456      &               (MLS*MNS-UH*TH)/(UH-MSU(GU+1))/(TH-MST(GT))
3457
3458      &            +TWO*MXS(GR)*MXU(GU+1)*(SH-MSL2(GR))*SCF(GR)*
3459
3460      &               SH*C(1,L,GU+1)*(UH*A(L,GR)+ML*MN*B(L,GR))
3461
3462      &               /(UH-MSU(GU+1))
3463
3464               IF(ABS(MXT(GT-1)).GT.EPS) ME2=ME2-TWO*MXT(GT-1)*MXU(GU+1)*
3465
3466      &               C(1,L,GU+1)*C(2,L,GT-1)*(MLS*MNS-UH*TH)
3467
3468      &               /(UH-MSU(GU+1))/(TH-MST(GT-1))
3469
3470             ENDIF
3471
3472 C--t channel L/R mixing
3473
3474             IF(ABS(MXT(GT-1)).GT.EPS) THEN
3475
3476               ME2=ME2+MXT(GT-1)**2*(MLS-TH)*(MNS-TH)*(C(2,L,GT-1)**2
3477
3478      &                +D(2,L,GT-1)**2)/(TH-MST(GT-1))**2
3479
3480      &            +TWO*MXT(GT)*MXT(GT-1)*(MLS-TH)*(MNS-TH)*
3481
3482      &               (C(2,L,GT)*C(2,L,GT-1)+D(2,L,GT)*D(2,L,GT-1))
3483
3484      &               /(TH-MST(GT))/(TH-MST(GT-1))
3485
3486      &            -TWO*MXT(GT-1)*MXU(GU)*C(1,L,GU)*C(2,L,GT-1)*
3487
3488      &               (MLS*MNS-UH*TH)/(UH-MSU(GU))/(TH-MST(GT-1))
3489
3490      &            +TWO*MXS(GR)*MXT(GT-1)*(SH-MSL2(GR))*SCF(GR)*
3491
3492      &               SH*C(2,L,GT-1)*(TH*A(L,GR)+ML*MN*B(L,GR))
3493
3494      &               /(TH-MST(GT-1))
3495
3496             ENDIF
3497
3498 C--multiply by lamda and factors
3499
3500             MEN(L,GN,J,K) = FAC*ME2*EC**2*LAMDA2(I,J,K)**2*PCM
3501
3502  110        I2=I1+6
3503
3504             HCS = HCS+MEN(L,GN,J,K)*DISF(J1,1)*DISF(K1,2)
3505
3506             IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(11,J1,K1,I2,L,0,0,*500)
3507
3508             HCS = HCS+MEN(L,GN,J,K)*DISF(K1,1)*DISF(J1,2)
3509
3510             IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(12,K1,J1,I2,L,0,0,*500)
3511
3512             HCS = HCS+MEN(L,GN,J,K)*DISF(J1+6,1)*DISF(K1-6,2)
3513
3514             IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(11,J1,K1,I2,L,1,0,*500)
3515
3516             HCS = HCS+MEN(L,GN,J,K)*DISF(K1-6,1)*DISF(J1+6,2)
3517
3518             IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(12,K1,J1,I2,L,1,0,*500)
3519
3520  120      CONTINUE
3521
3522         ENDDO
3523
3524  130    CONTINUE
3525
3526  140  CONTINUE
3527
3528  200  IF(.NOT.CHAR) GOTO 300
3529
3530 C--Chargino production
3531
3532       DO 240 GN=1,6
3533
3534       GR=2*GN-1
3535
3536       I=GN
3537
3538       I1 = 2*GN
3539
3540       IF(GN.GT.3) THEN
3541
3542         I1=I1-7
3543
3544         I=GN-3
3545
3546       ENDIF
3547
3548       IF(CHAN(GR).LT.EPS) GOTO 240
3549
3550       DO 230 L=CHARMN,CHARMX
3551
3552         MN  = MCR(L)
3553
3554         MNS = MN**2
3555
3556         ML  = MLT(I1)
3557
3558         MLS = ML**2
3559
3560         SP = L+4
3561
3562         IF((ML+MN).GT.EMSCA) GOTO 230
3563
3564         PCM = SQRT((SH-(ML+MN)**2)*(SH-(ML-MN)**2))*HALF/SQSH
3565
3566         ECM = SQRT(PCM**2+MLS)
3567
3568         TH = MLS-SQSH*(ECM-PCM*COSTH)
3569
3570         UH = MLS-SQSH*(ECM+PCM*COSTH)
3571
3572         DO J=1,3
3573
3574           DO 220 K=1,3
3575
3576             IF(ABS(LAMDA2(I,J,K)).LT.EPS) GOTO 220
3577
3578             J1=2*J
3579
3580             K1=2*K+5
3581
3582             IF(GN.GT.3) J1=J1-1
3583
3584             IF(GENEV) GOTO 210
3585
3586             GU = 2*J-1
3587
3588             IF(GN.LE.3) GU=GU+6
3589
3590 C--Calculate the matrix element, s and u terms
3591
3592              ME2 =MXS(GR)**2*SCF(GR)*SH*(
3593
3594      &             (SH-MLS-MNS)*(A(SP,GR)**2+B(SP,GR)**2)
3595
3596      &             -4*ML*MN*A(SP,GR)*B(SP,GR))
3597
3598      &          +MXU(GU)**2*(MLS-UH)*(MNS-UH)*
3599
3600      &             (C(1,SP,GU)**2+D(1,SP,GU)**2)/(UH-MSU(GU))**2
3601
3602      &          -2*MXS(GR)*MXU(GU)*(SH-MSL2(GR))*SCF(GR)*C(1,SP,GU)*
3603
3604      &             SH*(UH*A(SP,GR)+B(SP,GR)*ML*MN)/(UH-MSU(GU))
3605
3606 C--s channel L/R mixing
3607
3608             IF(ABS(MXS(GR+1)).GT.EPS) THEN
3609
3610               ME2=ME2+MXS(GR+1)**2*SCF(GR+1)*SH*((SH-MLS-MNS)*
3611
3612      &               (A(SP,GR+1)**2+B(SP,GR+1)**2)
3613
3614      &                -4*ML*MN*A(SP,GR+1)*B(SP,GR+1))
3615
3616      &           +2*MXS(GR)*MXS(GR+1)*SCF(GR)*SCF(GR+1)*
3617
3618      &               ((SH-MSL2(GR))*(SH-MSL2(GR+1))+
3619
3620      &               MSWD(GR)*MSWD(GR+1))*SH*
3621
3622      &               ((SH-MLS-MNS)*(A(SP,GR)*A(SP,GR+1)
3623
3624      &               +B(SP,GR)*B(SP,GR+1))-4*ML*MN*
3625
3626      &               (A(SP,GR)*B(SP,GR+1)+B(SP,GR)*A(SP,GR+1)))
3627
3628      &           -2*MXS(GR+1)*MXU(GU)*(SH-MSL2(GR+1))*SCF(GR+1)*SH*
3629
3630      &               C(1,SP,GU)*(UH*A(SP,GR+1)+B(SP,GR+1)*ML*MN)
3631
3632      &               /(UH-MSU(GU))
3633
3634               IF(ABS(MXU(GU+1)).GT.EPS) ME2=ME2-2*MXS(GR+1)*MXU(GU+1)*
3635
3636      &               (SH-MSL2(GR+1))*SCF(GR+1)*C(1,SP,GU+1)*SH*
3637
3638      &         (UH*A(SP,GR+1)+B(SP,GR+1)*ML*MN)/(UH-MSU(GU+1))
3639
3640             ENDIF
3641
3642 C--u channel L/R mixing
3643
3644             IF(ABS(MXU(GU+1)).GT.EPS) ME2 = ME2+MXU(GU+1)**2*(MLS-UH)*
3645
3646      &             (MNS-UH)*(C(1,SP,GU+1)**2+D(1,SP,GU+1)**2)
3647
3648      &             /(UH-MSU(GU+1))**2
3649
3650      &          +2*MXU(GU)*MXU(GU+1)*(MLS-UH)*(MNS-UH)*
3651
3652      &             (C(1,SP,GU)*C(1,SP,GU+1)+D(1,SP,GU)*D(1,SP,GU+1))
3653
3654      &             /(UH-MSU(GU))/(UH-MSU(GU+1))
3655
3656      &          -2*MXS(GR)*MXU(GU+1)*(SH-MSL2(GR))*SCF(GR)*SH*
3657
3658      &             C(1,SP,GU+1)*(UH*A(SP,GR)+B(SP,GR)*ML*MN)
3659
3660      &             /(UH-MSU(GU+1))
3661
3662             MEC(L,GN,J,K) = FAC*ME2*G**2*LAMDA2(I,J,K)**2*PCM*HALF
3663
3664  210        I2 = I1+6
3665
3666             P = L+4
3667
3668             HCS = HCS+MEC(L,GN,J,K)*DISF(J1,1)*DISF(K1,2)
3669
3670             IF(GN.GT.3) P = P+2
3671
3672             IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(11,J1,K1,I2,P,0,0,*500)
3673
3674             HCS = HCS+MEC(L,GN,J,K)*DISF(K1,1)*DISF(J1,2)
3675
3676             IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(12,K1,J1,I2,P,0,0,*500)
3677
3678             HCS = HCS+MEC(L,GN,J,K)*DISF(J1+6,1)*DISF(K1-6,2)
3679
3680             IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(11,J1,K1,I2,P,1,0,*500)
3681
3682             HCS = HCS+MEC(L,GN,J,K)*DISF(K1-6,1)*DISF(J1+6,2)
3683
3684             IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(12,K1,J1,I2,P,1,0,*500)
3685
3686  220      CONTINUE
3687
3688         ENDDO
3689
3690  230  CONTINUE
3691
3692  240  CONTINUE
3693
3694  300   IF(.NOT.RAD) GOTO 400
3695
3696 C--Radiative decays
3697
3698        IF(GENEV) GOTO 320
3699
3700        DO 310 GN=1,3
3701
3702        I1= 2*GN+5
3703
3704        I = 2*GN-1
3705
3706 C--charged slepton to sneutrino W
3707
3708        IF(SQSH.GT.(MW+MSL(I1))) THEN
3709
3710        PCM = SQRT((SH-(MW+MSL(I1))**2)*(SH-(MW-MSL(I1))**2))*HALF/SQSH
3711
3712        ECM = SQRT(PCM**2+MW2)
3713
3714        TH = MW2-SQSH*(ECM-PCM*COSTH)
3715
3716        UH = MW2-SQSH*(ECM+PCM*COSTH)
3717
3718        ME2 = MXS(I)**4*SCF(I)*SH**2*PCM**2
3719
3720      &       +HALF**2/TH**2*(TWO*MW2*(UH*TH-MSL2(I1)*MW2)+TH**2*SH)
3721
3722      &       +HALF*MXS(I)*SH*(SH-MSL2(I))*SCF(I)/TH*
3723
3724      &         (MW2*(TWO*MSL2(I1)-TH)+(SH-MSL2(I1))*TH)
3725
3726        IF(GN.EQ.3) ME2 = ME2+MXS(I+1)**4*SCF(I+1)*SH**2*PCM**2
3727
3728      &         +2*MXS(I)**2*MXS(I+1)**2*SCF(I)*SCF(I+1)*SH**2*PCM**2
3729
3730      &         *((SH-MSL2(I))*(SH-MSL2(I+1))+MSWD(I)*MSWD(I+1))
3731
3732      &         +HALF*MXS(I+1)*SH*(SH-MSL2(I+1))*SCF(I+1)/TH*
3733
3734      &         (MW2*(TWO*MSL2(I1)-TH)+(SH-MSL2(I))*TH)
3735
3736        MER(GN) = ME2*PCM/MW2
3737
3738        ENDIF
3739
3740 C--sneutrino to charged slepton W
3741
3742        IF(SQSH.GT.(MW+MSL(I))) THEN
3743
3744        PCM = SQRT((SH-(MW+MSL(I))**2)*(SH-(MW-MSL(I))**2))*HALF/SQSH
3745
3746        ECM = SQRT(PCM**2+MW2)
3747
3748        TH = MW2-SQSH*(ECM-PCM*COSTH)
3749
3750        UH = MW2-SQSH*(ECM+PCM*COSTH)
3751
3752        ME2 = MXS(I)**2*SCF(I1)*SH**2*PCM**2
3753
3754      &       +HALF**2*MXS(I)**2/TH**2*
3755
3756      &                      (TWO*MW2*(UH*TH-MW2*MSL2(I))+TH**2*SH)
3757
3758      &       +HALF*MXS(I)**2*SH*(SH-MSL2(I1))*SCF(I1)/TH*
3759
3760      &        (MW2*(TWO*MSL2(I)-TH)+(SH-MSL2(I))*TH)
3761
3762        MER(GN+4) = ME2*PCM/MW2
3763
3764        ENDIF
3765
3766  310   CONTINUE
3767
3768 C--now the decay stau_2 to stau_1 Z
3769
3770        IF(SQSH.GT.(MZ+MSL(5))) THEN
3771
3772        PCM = SQRT((SH-(MZ+MSL(5))**2)*(SH-(MZ-MSL(5))**2))*HALF/SQSH
3773
3774        ECM = SQRT(PCM**2+MZ2)
3775
3776        TH = MZ2-SQSH*(ECM-PCM*COSTH)
3777
3778        UH = MZ2-SQSH*(ECM+PCM*COSTH)
3779
3780        ME2 = SH**2*PCM**2*(SCF(5)*MXS(5)**2*ZSLP(1)**2
3781
3782      &              +SCF(6)*MXS(6)**2*ZSLP(2)**2+TWO*SCF(5)*SCF(6)*
3783
3784      &              MXS(5)*MXS(6)*ZSLP(1)*ZSLP(2)*((SH-MSL2(5))*
3785
3786      &              (SH-MSL2(6))+MSWD(5)*MSWD(6)))
3787
3788      &      +MXS(5)**2*ZQRK(2)**2/TH**2*
3789
3790      &              (TWO*MZ2*(UH*TH-MZ2*MSL2(5))+TH**2*SH)
3791
3792      &      +MXS(5)**2*ZQRK(1)**2/UH**2*
3793
3794      &              (TWO*MZ2*(UH*TH-MZ2*MSL2(5))+UH**2*SH)
3795
3796      &      +MXS(5)*SH*(MXS(5)*SCF(5)*ZSLP(1)*(SH-MSL2(5))
3797
3798      &              +MXS(6)*SCF(6)*ZSLP(2)*(SH-MSL2(6)))*
3799
3800      &              ( ZQRK(2)/TH*(MZ2*(TWO*MSL2(5)-TH)+TH*(SH-MSL2(5)))
3801
3802      &               +ZQRK(1)/UH*(MZ2*(TWO*MSL2(5)-UH)+UH*(SH-MSL2(5))))
3803
3804      &      -TWO*MXS(5)**2*ZQRK(1)*ZQRK(2)/UH/TH*
3805
3806      &               (TWO*MZ2*(MSL2(5)-UH)*(MSL2(5)-TH)-SH*UH*TH)
3807
3808        MER(4) = TWO*ME2*PCM/MZ2
3809
3810        ENDIF
3811
3812 C--now the decay tau sneutrino to tau_2 W
3813
3814        IF(SQSH.GT.(MW+MSL(6))) THEN
3815
3816        PCM = SQRT((SH-(MW+MSL(6))**2)*(SH-(MW-MSL(6))**2))*HALF/SQSH
3817
3818        ECM = SQRT(PCM**2+MW2)
3819
3820        TH = MW2-SQSH*(ECM-PCM*COSTH)
3821
3822        UH = MW2-SQSH*(ECM+PCM*COSTH)
3823
3824        ME2 = MXS(6)**2*SCF(11)*SH**2*PCM**2
3825
3826      &       +HALF**2*MXS(6)**2/TH**2*
3827
3828      &                      (TWO*MW2*(UH*TH-MW2*MSL2(6))+TH**2*SH)
3829
3830      &       +HALF*MXS(6)**2*SH*(SH-MSL2(11))*SCF(11)/TH*
3831
3832      &        (MW2*(2*MSL2(6)-TH)+(SH-MSL2(6))*TH)
3833
3834        MER(8) = ME2*PCM/MW2
3835
3836        ENDIF
3837
3838 C--Multiply by the parton distributions
3839
3840  320   DO I=1,4
3841
3842         DO J=1,3
3843
3844          DO 330 K=1,3
3845
3846          IF(I.LE.3) THEN
3847
3848            LC = LAMDA2(I,J,K)**2
3849
3850          ELSE
3851
3852            LC = LAMDA2(3,J,K)**2
3853
3854          ENDIF
3855
3856          IF(LC.LT.EPS) GOTO 330
3857
3858          FAC2 = G**2*LC*FAC
3859
3860 C--radiative cross-sections
3861
3862          J1=2*J
3863
3864          K1=2*K+5
3865
3866          ME2 = FAC2*MER(I)
3867
3868          HCS = HCS+ME2*DISF(J1,1)*DISF(K1,2)
3869
3870          IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(13,J1,K1,I,I,0,0,*500)
3871
3872          HCS = HCS+ME2*DISF(K1,1)*DISF(J1,2)
3873
3874          IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(14,K1,J1,I,I,0,0,*500)
3875
3876          HCS = HCS+ME2*DISF(J1+6,1)*DISF(K1-6,2)
3877
3878          IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(13,J1,K1,I,I,1,0,*500)
3879
3880          HCS = HCS+ME2*DISF(K1-6,1)*DISF(J1+6,2)
3881
3882          IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(14,K1,J1,I,I,1,0,*500)
3883
3884          J1=2*J-1
3885
3886          K1=2*K+5
3887
3888          ME2 = FAC2*MER(I+4)
3889
3890          HCS = HCS+ME2*DISF(J1,1)*DISF(K1,2)
3891
3892          IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(13,J1,K1,I+4,I+4,0,0,*500)
3893
3894          HCS = HCS+ME2*DISF(K1,1)*DISF(J1,2)
3895
3896          IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(14,K1,J1,I+4,I+4,0,0,*500)
3897
3898          HCS = HCS+ME2*DISF(J1+6,1)*DISF(K1-6,2)
3899
3900          IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(13,J1,K1,I+4,I+4,1,0,*500)
3901
3902          HCS = HCS+ME2*DISF(K1-6,1)*DISF(J1+6,2)
3903
3904          IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(14,K1,J1,I+4,I+4,1,0,*500)
3905
3906  330     CONTINUE
3907
3908         ENDDO
3909
3910        ENDDO
3911
3912  400   IF(.NOT.HIGGS) GOTO 500
3913
3914        IF(GENEV) GOTO 480
3915
3916        DO I=1,3
3917
3918           DO 405 J=1,18
3919
3920  405      MEH(I,J) = ZERO
3921
3922        ENDDO
3923
3924 C--Neutral higgs charged slepton
3925
3926        DO 420 L=1,3
3927
3928          DO 410 I=1,2
3929
3930 C--first two generations
3931
3932            IF(SQSH.LT.MH(L)+MSL(2*I)) GOTO 410
3933
3934            PCM = SQRT((SH-(MSL(2*I)+MH(L))**2)*
3935
3936      &                (SH-(MSL(2*I)-MH(L))**2))*HALF/SQSH
3937
3938            MEH(1,3*L-3+I) = PCM*SH*SCF(2*I-1)*H(4*L+I-4)**2
3939
3940  410     CONTINUE
3941
3942 C--third generation
3943
3944          IF(SQSH.LT.MH(L)+MSL(5)) GOTO 420
3945
3946          PCM = SQRT((SH-(MSL(5)+MH(L))**2)*
3947
3948      &              (SH-(MSL(5)-MH(L))**2))*HALF/SQSH
3949
3950          ECM = SQRT(PCM**2+MH(L)**2)
3951
3952          TH = MH(L)**2-SQSH*(ECM-PCM*COSTH)
3953
3954          UH = MH(L)**2-SQSH*(ECM+PCM*COSTH)
3955
3956          MEH(1,3*L) = PCM*SH*(MXS(5)**2*SCF(5)*H(4*L-1)**2
3957
3958      &                 +MXS(6)**2*SCF(6)*H(4*L)**2
3959
3960      &                 +TWO*MXS(5)*MXS(6)*SCF(5)*SCF(6)*H(4*L-1)*
3961
3962      &                 H(4*L)*((SH-MSL2(5))*(SH-MSL2(6))+
3963
3964      &                 MSWD(5)*MSWD(6)) )
3965
3966          ME2        = MXS(5)**2*PCM*(UH*TH-MSL2(5)*MH(L)**2)
3967
3968          MEH(2,3*L) =ME2*GUU(L)/TH**2
3969
3970          MEH(3,3*L) =ME2*GDD(L)/UH**2
3971
3972  420     CONTINUE
3973
3974 C--Charged higgs
3975
3976         DO 440 I=1,3
3977
3978 C--charged slepton charged Higgs
3979
3980           DO 430 J=1,2
3981
3982           IF(SQSH.LT.(MH(4)+MSL(2*I-2+J))) GOTO 430
3983
3984           PCM = SQRT((SH-(MH(4)+MSL(2*I-2+J))**2)*
3985
3986      &               (SH-(MH(4)-MSL(2*I-2+J))**2))*HALF/SQSH
3987
3988           ECM = SQRT(PCM**2+MH(4)**2)
3989
3990           TH = MH(4)**2-SQSH*(ECM-PCM*COSTH)
3991
3992           UH = MH(4)**2-SQSH*(ECM+PCM*COSTH)
3993
3994           MEH(1,2*I+J+7) = PCM*SH*HALF/MW2*H(2*I+J+10)**2*SCF(5+2*I)
3995
3996           MEH(2,2*I+J+7) = PCM*GDD(4)*MXS(2*I-2+J)**2*
3997
3998      &                      (UH*TH-MH(4)**2*MSL2(2*I-2+J))/TH**2
3999
4000  430      CONTINUE
4001
4002 C--Sneutrino Charged Higgs
4003
4004           IF(SQSH.LT.(MH(4)+MSL(2*I+5))) GOTO 440
4005
4006           PCM = SQRT((SH-(MH(4)+MSL(2*I+5))**2)*
4007
4008      &               (SH-(MH(4)-MSL(2*I+5))**2))*HALF/SQSH
4009
4010           ECM = SQRT(PCM**2+MH(4)**2)
4011
4012           TH = MH(4)**2-SQSH*(ECM-PCM*COSTH)
4013
4014           UH = MH(4)**2-SQSH*(ECM+PCM*COSTH)
4015
4016           MEH(1,15+I) = PCM*SH*HALF/MW2*(
4017
4018      &                MXS(2*I-1)**2*SCF(2*I-1)*H(11+2*I)**2
4019
4020      &               +MXS(2*I)**2*SCF(2*I)*H(12+2*I)**2
4021
4022      &               +TWO*MXS(2*I-1)*MXS(2*I)*SCF(2*I-1)*
4023
4024      &                SCF(2*I)*H(11+2*I)*H(12+2*I)*
4025
4026      &             ((SH-MSL2(2*I-1))*(SH-MSL2(2*I))+
4027
4028      &              MSWD(2*I-1)*MSWD(2*I)))
4029
4030           MEH(2,15+I) = PCM*GUU(4)*
4031
4032      &                    (UH*TH-MH(4)**2*MSL2(2*I+5))/TH**2
4033
4034  440    CONTINUE
4035
4036 C--Multiply by the parton distributions
4037
4038  480    DO I=1,3
4039
4040         DO J=1,3
4041
4042          DO 490 K=1,3
4043
4044          IF(LAMDA2(I,J,K).LT.EPS) GOTO 490
4045
4046 C--Higgs cross-sections
4047
4048          J1=2*J
4049
4050          K1=2*K+5
4051
4052          FAC2 = G**2*LAMDA2(I,J,K)**2*FAC*HALF
4053
4054          DO L=1,3
4055
4056          ME2 = FAC2*(MEH(1,3*L-3+I)+RMASS(J1)**2*MEH(2,3*L-3+I)
4057
4058      &            +RMASS(K1)**2*MEH(3,3*L-3+I))
4059
4060          HCS = HCS+ME2*DISF(J1,1)*DISF(K1,2)
4061
4062          IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(15,J1,K1,I,L,0,0,*500)
4063
4064          HCS = HCS+ME2*DISF(K1,1)*DISF(J1,2)
4065
4066          IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(16,K1,J1,I,L,0,0,*500)
4067
4068          HCS = HCS+ME2*DISF(J1+6,1)*DISF(K1-6,2)
4069
4070          IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(15,J1,K1,I,L,1,0,*500)
4071
4072          HCS = HCS+ME2*DISF(K1-6,1)*DISF(J1+6,2)
4073
4074          IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(16,K1,J1,I,L,1,0,*500)
4075
4076          ENDDO
4077
4078          ME2 = FAC2*(MEH(1,15+I)+RMASS(J1)**2*MEH(2,15+I))
4079
4080          HCS = HCS+ME2*DISF(J1,1)*DISF(K1,2)
4081
4082          IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(15,J1,K1,9+I,4,0,0,*500)
4083
4084          HCS = HCS+ME2*DISF(K1,1)*DISF(J1,2)
4085
4086          IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(16,K1,J1,9+I,4,0,0,*500)
4087
4088          HCS = HCS+ME2*DISF(J1+6,1)*DISF(K1-6,2)
4089
4090          IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(15,J1,K1,9+I,5,1,0,*500)
4091
4092          HCS = HCS+ME2*DISF(K1-6,1)*DISF(J1+6,2)
4093
4094          IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(16,K1,J1,9+I,5,1,0,*500)
4095
4096          J1=2*J-1
4097
4098          K1=2*K+5
4099
4100          DO L=2,3
4101
4102          ME2 = FAC2*(MEH(1,2*I+L+6)+RMASS(J1)**2*MEH(2,2*I+L+6))
4103
4104          HCS = HCS+ME2*DISF(J1,1)*DISF(K1,2)
4105
4106          IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(15,J1,K1,2*I+L,5,0,0,*500)
4107
4108          HCS = HCS+ME2*DISF(K1,1)*DISF(J1,2)
4109
4110          IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(16,K1,J1,2*I+L,5,0,0,*500)
4111
4112          HCS = HCS+ME2*DISF(J1+6,1)*DISF(K1-6,2)
4113
4114          IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(15,J1,K1,2*I+L,4,1,0,*500)
4115
4116          HCS = HCS+ME2*DISF(K1-6,1)*DISF(J1+6,2)
4117
4118          IF(GENEV.AND.HCS.GT.RCS) CALL HWHRSS(16,K1,J1,2*I+L,4,1,0,*500)
4119
4120          ENDDO
4121
4122  490     CONTINUE
4123
4124         ENDDO
4125
4126        ENDDO
4127
4128 C--Setup to generate the event
4129
4130  500  IF(GENEV) THEN
4131
4132         CALL HWETWO
4133
4134       ELSE
4135
4136         EVWGT = HCS
4137
4138       ENDIF
4139
4140  999  END
4141
4142 CDECK  ID>, HWHRSP.
4143
4144 *CMZ :-        -20/07/99  10:56:12  by  Peter Richardson
4145
4146 *-- Author :    Peter Richardson
4147
4148 C-----------------------------------------------------------------------
4149
4150       SUBROUTINE HWHRSP
4151
4152 C-----------------------------------------------------------------------
4153
4154 C     Subroutine for all hadron-hadron Rparity violating processes
4155
4156 C-----------------------------------------------------------------------
4157
4158       INCLUDE 'HERWIG61.INC'
4159
4160       IF(IPROC.GE.4000.AND.IPROC.LT.4060) THEN
4161
4162 C--SINGLE SPARTICLE VIA LQD
4163
4164         CALL HWHRLS
4165
4166       ELSEIF(IPROC.GE.4060.AND.IPROC.LT.4100) THEN
4167
4168 C--RESONANT SLEPTONS TO STANDARD MODEL VIA LQD
4169
4170         CALL HWHRLL
4171
4172       ELSEIF(IPROC.GE.4100.AND.IPROC.LT.4160) THEN
4173
4174 C--SINGLE SPARTICLE VIA UDD
4175
4176         CALL HWHRBS
4177
4178 C--RESONANT SQUARKS TO STANDARD MODEL VIA UDD
4179
4180       ELSEIF(IPROC.EQ.4160) THEN
4181
4182         CALL HWHRBB
4183
4184       ELSE
4185
4186 C--UNKNOWN PROCESS
4187
4188         CALL HWWARN('HWHRSP',500,*999)
4189
4190       ENDIF
4191
4192  999  END
4193
4194 CDECK  ID>, HWHRSS.
4195
4196 *CMZ :-        -20/07/99  10:56:12  by  Peter Richardson
4197
4198 *-- Author :    Peter Richardson
4199
4200 C-----------------------------------------------------------------------
4201
4202       SUBROUTINE HWHRSS(TYPE,ID1,ID2,ID3,ID4,R4,IPERM,*)
4203
4204 C-----------------------------------------------------------------------
4205
4206 C     IDENTIDY HARD R-PARITY VIOLATING PROCESS
4207
4208 C-----------------------------------------------------------------------
4209
4210       INCLUDE 'HERWIG61.INC'
4211
4212       INTEGER ID3, ID4, R4, IPERM,TYPE,ID1,ID2,NEUTD1(8),SLEPID(8),
4213
4214      &        NEUTD2(13),SQUID(6),SGN,HWUANT,SQUID2(12),SLPID2(12),
4215
4216      &        GAGID1(6),GAGID2(8)
4217
4218       EXTERNAL HWUANT
4219
4220       DATA NEUTD1 /450,451,452,453,454,455,456,457/
4221
4222       DATA NEUTD2 /449,449,449,450,451,452,453,454,455,456,457,454,455/
4223
4224       DATA SLEPID /432,434,436,435,431,433,435,447/
4225
4226       DATA SQUID  /411,423,412,412,424,411/
4227
4228       DATA SQUID2 /407,419,409,421,411,423,408,420,410,422,412,424/
4229
4230       DATA SLPID2 /443,445,435,431,443,433,445,435,447,432,434,436/
4231
4232       DATA GAGID1 /199,199,200,198,198,200/
4233
4234       DATA GAGID2 /198,198,198,200,199,199,199,199/
4235
4236       IDCMF = 15
4237
4238       IF(IPERM.EQ.0) THEN
4239
4240         ICO(1) = 2
4241
4242         ICO(2) = 1
4243
4244         ICO(3) = 3
4245
4246         ICO(4) = 4
4247
4248       ELSEIF(IPERM.EQ.1) THEN
4249
4250         ICO(1) = 2
4251
4252         ICO(2) = 1
4253
4254         ICO(3) = 4
4255
4256         ICO(4) = 3
4257
4258       ELSEIF(IPERM.EQ.2) THEN
4259
4260         ICO(1) = 3
4261
4262         ICO(2) = 4
4263
4264         ICO(3) = 1
4265
4266         ICO(4) = 2
4267
4268       ELSE
4269
4270         CALL HWWARN('HWHRSS',100,*999)
4271
4272       ENDIF
4273
4274       IF(TYPE.LE.8) THEN
4275
4276         IDN(1) = ID1+R4*6
4277
4278         IDN(2) = ID2+R4*6
4279
4280       ELSE
4281
4282         SGN = 1
4283
4284         IF(MOD(TYPE,2).EQ.0) SGN = -1
4285
4286         IDN(1) = ID1+R4*6*SGN
4287
4288         IDN(2) = ID2-R4*6*SGN
4289
4290       ENDIF
4291
4292       IF(TYPE.LE.2) THEN
4293
4294         IDN(3) = ID3+6*R4
4295
4296         IDN(4) = ID4+6*R4
4297
4298       ELSEIF(TYPE.GE.3.AND.TYPE.LE.4) THEN
4299
4300         IDN(3) = ID3-R4*6
4301
4302         IDN(4) = NEUTD2(ID4)
4303
4304       ELSEIF(TYPE.GE.5.AND.TYPE.LE.6) THEN
4305
4306         IDN(3) = GAGID1(ID3)
4307
4308         IDN(4) = SQUID(ID4)-R4*6
4309
4310         IF(R4.EQ.1) IDN(3) = HWUANT(IDN(3))
4311
4312       ELSEIF(TYPE.GE.7.AND.TYPE.LE.8) THEN
4313
4314         IDN(3) =202+ID3
4315
4316         IDN(4) =  SQUID2(ID4)-R4*6
4317
4318       ELSEIF(TYPE.GE.9.AND.TYPE.LE.10) THEN
4319
4320         IDN(3) = ID3+6*R4
4321
4322         IDN(4) = ID4-6*R4
4323
4324         IF(IPERM.EQ.2.AND.TYPE.EQ.10) THEN
4325
4326           SGN=IDN(3)
4327
4328           IDN(3) = IDN(4)
4329
4330           IDN(4) = SGN
4331
4332         ENDIF
4333
4334       ELSEIF(TYPE.GE.11.AND.TYPE.LE.12) THEN
4335
4336         IDN(3) = 120+ID3-R4*6
4337
4338         IDN(4) = NEUTD1(ID4)
4339
4340         IF(R4.EQ.1) IDN(4) = HWUANT(IDN(4))
4341
4342       ELSEIF(TYPE.GE.13.AND.TYPE.LE.14) THEN
4343
4344         IDN(3) = SLEPID(ID3)-R4*6
4345
4346         IDN(4) = GAGID2(ID4)
4347
4348         IF(R4.NE.0) IDN(4) = HWUANT(IDN(4))
4349
4350       ELSEIF(TYPE.GE.15.AND.TYPE.LE.16) THEN
4351
4352         IDN(3) = SLPID2(ID3)-R4*6
4353
4354         IDN(4) = 202+ID4
4355
4356       ENDIF
4357
4358       IF(MOD(TYPE,2).EQ.0.AND.TYPE.NE.8) COSTH=-COSTH
4359
4360       RETURN 1
4361
4362  999  END
4363
4364 CDECK  ID>, HWHSCT.
4365
4366 *CMZ :-        -30/05/94  18.42.43  by  Mike Seymour
4367
4368 *-- Author :    Mike Seymour
4369
4370 C-----------------------------------------------------------------------
4371
4372       SUBROUTINE HWHSCT(REPORT)
4373
4374 C-----------------------------------------------------------------------
4375
4376 C     RELABEL THE EVENT RECORD FOR EXTRA HARD SCATTERING,
4377
4378 C     DO THE SCATTERING, PARTON SHOWER IT, AND CLEAN UP THE EVENT RECORD
4379
4380 C     REPORT RETURNS THE OUTCOME:
4381
4382 C     0 = SUCCESSFUL
4383
4384 C     1 = FAILED DUE TO ERROR IN HARD SCATTERING GENERATION
4385
4386 C     2 = FAILED DUE TO ENERGY CONSERVATION IN HARD SCATTERING
4387
4388 C     3 = FAILED DUE TO ERROR IN PARTON EVOLUTION
4389
4390 C     4 = FAILED DUE TO ENERGY CONSERVATION IN PARTON EVOLUTION
4391
4392 C     5 = COMPLETELY FAILED (IERROR IS ALSO NON-ZERO TO CANCEL EVENT)
4393
4394 C-----------------------------------------------------------------------
4395
4396       INCLUDE 'HERWIG61.INC'
4397
4398       DOUBLE PRECISION HWR,TMPWGT,PBOOST(5),RBOOST(3,3)
4399
4400       INTEGER IHEP,IBM,ITG,IBMN,ITGN,IBMT,ITGT,I,REPORT
4401
4402       LOGICAL COL
4403
4404       EXTERNAL HWR
4405
4406       COL(I)=I.EQ.13 .OR. I.GE.1.AND.I.LE.6 .OR. I.GE.115.AND.I.LE.120
4407
4408       REPORT=5
4409
4410       IF (IERROR.NE.0) RETURN
4411
4412 C---FIND BEAM AND TARGET REMNANTS
4413
4414       CALL HWHREM(IBM,ITG)
4415
4416       IF (IERROR.NE.0) RETURN
4417
4418 C---RECALCULATE THEIR MASS CORRECTLY
4419
4420       CALL HWUMAS(PHEP(1,IBM))
4421
4422       CALL HWUMAS(PHEP(1,ITG))
4423
4424 C---SET UP NEW ENTRIES IN THE EVENT RECORD
4425
4426       NHEP=NHEP+1
4427
4428       CALL HWVEQU(5,PHEP(1,IBM),PHEP(1,NHEP))
4429
4430       ISTHEP(NHEP)=3
4431
4432       IBMN=NHEP
4433
4434       IBMT=JDAHEP(1,1)
4435
4436       IF (IBMT.EQ.0) THEN
4437
4438         JMOHEP(1,NHEP)=1
4439
4440         IDHW(NHEP)=72
4441
4442       ELSE
4443
4444         JMOHEP(1,NHEP)=IBMT
4445
4446         IDHW(NHEP)=71
4447
4448       ENDIF
4449
4450       JMOHEP(2,NHEP)=0
4451
4452       JDAHEP(1,NHEP)=0
4453
4454       JDAHEP(2,NHEP)=0
4455
4456       IDHEP(NHEP)=IDPDG(IDHW(NHEP))
4457
4458       NHEP=NHEP+1
4459
4460       CALL HWVEQU(5,PHEP(1,ITG),PHEP(1,NHEP))
4461
4462       ISTHEP(NHEP)=3
4463
4464       ITGN=NHEP
4465
4466       ITGT=JDAHEP(1,2)
4467
4468       IF (ITGT.EQ.0) THEN
4469
4470         JMOHEP(1,NHEP)=2
4471
4472         IDHW(NHEP)=72
4473
4474       ELSE
4475
4476         JMOHEP(1,NHEP)=ITGT
4477
4478         IDHW(NHEP)=71
4479
4480       ENDIF
4481
4482       JMOHEP(2,NHEP)=0
4483
4484       JDAHEP(1,NHEP)=0
4485
4486       JDAHEP(2,NHEP)=0
4487
4488       IDHEP(NHEP)=IDPDG(IDHW(NHEP))
4489
4490 C---BOOST TO THEIR CENTRE-OF-MASS FRAME
4491
4492       CALL HWVSUM(4,PHEP(1,IBMN),PHEP(1,ITGN),PBOOST)
4493
4494       CALL HWUMAS(PBOOST)
4495
4496       DO 100 IHEP=IBMN,NHEP
4497
4498         CALL HWULOF(PBOOST,PHEP(1,IHEP),PHEP(1,IHEP))
4499
4500  100  CONTINUE
4501
4502       CALL HWUROT(PHEP(1,IBMN),ONE,ZERO,RBOOST)
4503
4504       DO 110 IHEP=IBMN,NHEP
4505
4506         CALL HWUROF(RBOOST,PHEP(1,IHEP),PHEP(1,IHEP))
4507
4508  110  CONTINUE
4509
4510 C---GENERATE A NEW HARD SCATTERING
4511
4512       TMPWGT=EVWGT
4513
4514       GENEV=.FALSE.
4515
4516  10   CALL HWHQCD
4517
4518       IF (IERROR.NE.0.OR.GAMWT*EVWGT.LE.WGTMAX*HWR()) THEN
4519
4520         IERROR=0
4521
4522         GOTO 10
4523
4524       ENDIF
4525
4526       GENEV=.TRUE.
4527
4528       CALL HWHQCD
4529
4530       EVWGT=TMPWGT
4531
4532 C---IF MOMENTUM CANNOT BE CONSERVED, STOP GENERATING HARD SCATTERS
4533
4534       IF (  PHEP(4,IBMN+2) .GT. PHEP(4,IBMN).OR.
4535
4536      $      PHEP(4,ITGN+2) .GT. PHEP(4,ITGN).OR.
4537
4538      $      PHEP(3,IBMN+2) .GT. PHEP(3,IBMN).OR.
4539
4540      $     -PHEP(3,ITGN+2) .GT.-PHEP(3,ITGN).OR.IERROR.NE.0) THEN
4541
4542         IF (IERROR.GT.0) THEN
4543
4544           WRITE (6,'(A/A)')
4545
4546      $       ' THIS ERROR OCCURED DURING A SECONDARY SCATTER AND WAS',
4547
4548      $       ' CAUGHT BY HWHSCT, SO EVENT IS NOT KILLED AFTER ALL'
4549
4550           REPORT=1
4551
4552         ELSE
4553
4554           REPORT=2
4555
4556         ENDIF
4557
4558         NHEP=IBMN-1
4559
4560         IERROR=0
4561
4562         RETURN
4563
4564       ENDIF
4565
4566 C---RELABEL OUTGOING REMNANTS AS INCOMING HADRONS
4567
4568       JDAHEP(1,1)=IBMN
4569
4570       JDAHEP(1,2)=ITGN
4571
4572 C---EVOLVE THEM
4573
4574       ISLENT=-1
4575
4576       CALL HWBGEN
4577
4578       ISLENT=1
4579
4580 C---PUT THE LABELS BACK
4581
4582       JDAHEP(1,1)=IBMT
4583
4584       JDAHEP(1,2)=ITGT
4585
4586 C---IF THERE WERE ANY PROBLEMS, STOP GENERATING HARD SCATTERS
4587
4588       IF (IERROR.NE.0) THEN
4589
4590         IF (IERROR.GT.0) THEN
4591
4592           WRITE (6,'(A/A)')
4593
4594      $       ' THIS ERROR OCCURED DURING A SECONDARY SCATTER AND WAS',
4595
4596      $       ' CAUGHT BY HWHSCT, SO EVENT IS NOT KILLED AFTER ALL'
4597
4598           REPORT=3
4599
4600         ELSE
4601
4602           REPORT=4
4603
4604         ENDIF
4605
4606         NHEP=IBMN-1
4607
4608         IERROR=0
4609
4610         RETURN
4611
4612       ENDIF
4613
4614 C---UNDO THE LORENTZ BOOST
4615
4616       DO 200 IHEP=IBMN,NHEP
4617
4618         CALL HWUROB(RBOOST,PHEP(1,IHEP),PHEP(1,IHEP))
4619
4620         CALL HWULOB(PBOOST,PHEP(1,IHEP),PHEP(1,IHEP))
4621
4622  200  CONTINUE
4623
4624 C---FIND THE NEW BEAM AND TARGET REMNANTS
4625
4626       ISTHEP(IBM)=3
4627
4628       ISTHEP(ITG)=3
4629
4630       CALL HWHREM(IBMN,ITGN)
4631
4632       IF (IERROR.NE.0) RETURN
4633
4634 C---CONNECT UP THE COLOUR/FLAVOUR LINES OF THE TWO SCATTERS
4635
4636       IDHW(IBMN)=IDHW(IBM)
4637
4638       IDHEP(IBMN)=IDHEP(IBM)
4639
4640       IF (COL(IDHW(IBM))) THEN
4641
4642         JMOHEP(2,JDAHEP(2,IBMN))=JMOHEP(2,IBM)
4643
4644         JDAHEP(2,JMOHEP(2,IBM))=JDAHEP(2,IBMN)
4645
4646         JDAHEP(2,IBMN)=JDAHEP(2,IBM)
4647
4648         JMOHEP(2,JDAHEP(2,IBM))=IBMN
4649
4650       ELSE
4651
4652         JDAHEP(2,JMOHEP(2,IBMN))=JDAHEP(2,IBM)
4653
4654         JMOHEP(2,JDAHEP(2,IBM))=JMOHEP(2,IBMN)
4655
4656         JMOHEP(2,IBMN)=JMOHEP(2,IBM)
4657
4658         JDAHEP(2,JMOHEP(2,IBM))=IBMN
4659
4660       ENDIF
4661
4662       JMOHEP(2,IBM)=0
4663
4664       JDAHEP(1,IBM)=IBMN
4665
4666       JDAHEP(2,IBM)=0
4667
4668       IDHW(ITGN)=IDHW(ITG)
4669
4670       IDHEP(ITGN)=IDHEP(ITG)
4671
4672       IF (COL(IDHW(ITG))) THEN
4673
4674         JMOHEP(2,JDAHEP(2,ITGN))=JMOHEP(2,ITG)
4675
4676         JDAHEP(2,JMOHEP(2,ITG))=JDAHEP(2,ITGN)
4677
4678         JDAHEP(2,ITGN)=JDAHEP(2,ITG)
4679
4680         JMOHEP(2,JDAHEP(2,ITG))=ITGN
4681
4682       ELSE
4683
4684         JDAHEP(2,JMOHEP(2,ITGN))=JDAHEP(2,ITG)
4685
4686         JMOHEP(2,JDAHEP(2,ITG))=JMOHEP(2,ITGN)
4687
4688         JMOHEP(2,ITGN)=JMOHEP(2,ITG)
4689
4690         JDAHEP(2,JMOHEP(2,ITG))=ITGN
4691
4692       ENDIF
4693
4694       JMOHEP(2,ITG)=0
4695
4696       JDAHEP(1,ITG)=ITGN
4697
4698       JDAHEP(2,ITG)=0
4699
4700 C---LOOK FOR COLOUR SINGLET GLUONS (A RARE BUT ANNOYING SPECIAL CASE)
4701
4702       DO 20 IHEP=1,NHEP
4703
4704         IF (IDHW(IHEP).EQ.13.AND.JMOHEP(2,IHEP).EQ.IHEP)
4705
4706      $       CALL HWWARN('HWHSCT',120,*999)
4707
4708  20   CONTINUE
4709
4710       REPORT=0
4711
4712  999  END
4713
4714 CDECK  ID>, HWHSNG.
4715
4716 *CMZ :-        -20/09/95  14.59.15  by  Mike Seymour
4717
4718 *-- Author :    Mike Seymour
4719
4720 C-----------------------------------------------------------------------
4721
4722       SUBROUTINE HWHSNG
4723
4724 C     PARTON-PARTON SCATTERING VIA COLOUR SINGLET
4725
4726 C     MEAN EVWGT = SIGMA IN NB
4727
4728 C     TREATS ALL PARTONS ON EQUAL FOOTING WITH HWHSNM(ID1,ID2,S,T)
4729
4730 C     PROVIDING THE MATRIX ELEMENT SQUARED FOR PARTON TYPES ID1 AND ID2
4731
4732 C-----------------------------------------------------------------------
4733
4734       INCLUDE 'HERWIG61.INC'
4735
4736       INTEGER ID1,ID2
4737
4738       DOUBLE PRECISION HWR,HWRUNI,HWHSNM,EPS,RCS,ET,EJ,KK,KK2,
4739
4740      & YJ1INF,YJ1SUP,Z1,YJ2INF,YJ2SUP,Z2,FACT,S,T,U,HCS
4741
4742       SAVE HCS,FACT,S,T
4743
4744       PARAMETER (EPS=1.D-9)
4745
4746       IF (GENEV) THEN
4747
4748         RCS=HCS*HWR()
4749
4750       ELSE
4751
4752         EVWGT=0.
4753
4754         CALL HWRPOW(ET,EJ)
4755
4756         KK=ET/PHEP(5,3)
4757
4758         KK2=KK**2
4759
4760         IF (KK.GE.ONE) RETURN
4761
4762         YJ1INF=MAX( YJMIN , LOG((1.-SQRT(1.-KK2))/KK) )
4763
4764         YJ1SUP=MIN( YJMAX , LOG((1.+SQRT(1.-KK2))/KK) )
4765
4766         IF (YJ1INF.GE.YJ1SUP) RETURN
4767
4768         Z1=EXP(HWRUNI(1,YJ1INF,YJ1SUP))
4769
4770         YJ2INF=MAX( YJMIN , -LOG(2./KK-1./Z1) )
4771
4772         YJ2SUP=MIN( YJMAX ,  LOG(2./KK-Z1) )
4773
4774         IF (YJ2INF.GE.YJ2SUP) RETURN
4775
4776         Z2=EXP(HWRUNI(2,YJ2INF,YJ2SUP))
4777
4778         XX(1)=0.5*(Z1+Z2)*KK
4779
4780         IF (XX(1).GE.ONE) RETURN
4781
4782         XX(2)=XX(1)/(Z1*Z2)
4783
4784         IF (XX(2).GE.ONE) RETURN
4785
4786         COSTH=(Z1-Z2)/(Z1+Z2)
4787
4788         S=XX(1)*XX(2)*PHEP(5,3)**2
4789
4790         T=-0.5*S*(1.-COSTH)
4791
4792         U=-S-T
4793
4794 C---SET EMSCA TO HARD PROCESS SCALE (APPROX ET-JET)
4795
4796         EMSCA=SQRT(2.*S*T*U/(S*S+T*T+U*U))
4797
4798         FACT=GEV2NB*0.5*ET*EJ*(YJ1SUP-YJ1INF)*(YJ2SUP-YJ2INF)
4799
4800      $      /(16*PIFAC*S**2)
4801
4802         CALL HWSGEN(.FALSE.)
4803
4804       ENDIF
4805
4806 C
4807
4808       HCS=0.
4809
4810       DO 20 ID1=1,13
4811
4812         IF (DISF(ID1,1).LT.EPS) GOTO 20
4813
4814         DO 10 ID2=1,13
4815
4816           IF (DISF(ID2,1).LT.EPS) GOTO 10
4817
4818           HCS=HCS+FACT*DISF(ID1,1)*DISF(ID2,2)*HWHSNM(ID1,ID2,S,T)
4819
4820           IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,ID2,3412,90,*30)
4821
4822  10     CONTINUE
4823
4824  20   CONTINUE
4825
4826       EVWGT=HCS
4827
4828       RETURN
4829
4830 C---GENERATE EVENT
4831
4832  30   IDN(1)=ID1
4833
4834       IDN(2)=ID2
4835
4836       IDCMF=15
4837
4838       CALL HWETWO
4839
4840  999  END
4841
4842 CDECK  ID>, HWHSNM.
4843
4844 *CMZ :-        -20/09/95  15.28.53  by  Mike Seymour
4845
4846 *-- Author :    Mike Seymour
4847
4848 C-----------------------------------------------------------------------
4849
4850       FUNCTION HWHSNM(ID1,ID2,S,T)
4851
4852 C     MATRIX ELEMENT SQUARED FOR COLOUR-SINGLET PARTON-PARTON SCATTERING
4853
4854 C     INCLUDES SPIN AND COLOUR AVERAGES AND SUMS.
4855
4856 C     FOR PHOTON EXCHANGE, INTERFERENCE WITH U-CHANNEL CONTRIBUTION IS
4857
4858 C     INCLUDED FOR IDENTICAL QUARKS AND LIKEWISE S-CHANNEL CONTRIBUTION
4859
4860 C     FOR IDENTICAL QUARK-ANTIQUARK PAIRS.
4861
4862 C-----------------------------------------------------------------------
4863
4864       INCLUDE 'HERWIG61.INC'
4865
4866       DOUBLE PRECISION HWHSNM,HWUAEM,HWUALF,S,T,ASQ,AINU,AINS,Y,SOLD,
4867
4868      $ TOLD,QQ(13,13),ZETA3
4869
4870       INTEGER ID1,ID2
4871
4872       LOGICAL PHOTON
4873
4874 C---ZETA3=RIEMANN ZETA FUNCTION(3)
4875
4876       PARAMETER (ZETA3=1.202056903159594D0)
4877
4878 C---PHOTON=.TRUE. FOR PHOTON EXCHANGE, .FALSE. FOR MUELLER-TANG
4879
4880       PHOTON=MOD(IPROC,100).GE.50
4881
4882       DATA ASQ,AINU,AINS,SOLD,TOLD,QQ/5*0,169*-1/
4883
4884 C---QQ CACHES THE KINEMATIC-INDEPENDENT FACTORS, TO MAKE IT RUN FASTER
4885
4886 C  (BEARING IN MIND THAT THIS ROUTINE IS CALLED 169 TIMES PER EVENT)
4887
4888       IF (QQ(ID1,ID2).LT.ZERO) THEN
4889
4890         IF (PHOTON) THEN
4891
4892           IF (ID1.EQ.13.OR.ID2.EQ.13) THEN
4893
4894             QQ(ID1,ID2)=0
4895
4896           ELSE
4897
4898             QQ(ID1,ID2)=(QFCH(MOD(ID1-1,6)+1)*QFCH(MOD(ID2-1,6)+1))**2
4899
4900      $           *(4*PIFAC)**2
4901
4902           ENDIF
4903
4904         ELSE
4905
4906           IF (ID1.EQ.13.AND.ID2.EQ.13) THEN
4907
4908             QQ(ID1,ID2)=CAFAC**4
4909
4910           ELSEIF (ID1.EQ.13.OR.ID2.EQ.13) THEN
4911
4912             QQ(ID1,ID2)=(CAFAC*CFFAC)**2
4913
4914           ELSE
4915
4916             QQ(ID1,ID2)=CFFAC**4
4917
4918           ENDIF
4919
4920           QQ(ID1,ID2)=QQ(ID1,ID2)*
4921
4922      $         PIFAC**3/(4*(3.5*ASFIXD*CAFAC*ZETA3)**3)
4923
4924      $         *(16*PIFAC)
4925
4926         ENDIF
4927
4928       ENDIF
4929
4930 C---THE KINEMATIC-DEPENDENT PART IS ALSO CACHED
4931
4932       IF (S.NE.SOLD.OR.T.NE.TOLD) THEN
4933
4934         IF (PHOTON) THEN
4935
4936           AINS=HWUAEM(T)**2
4937
4938           ASQ=2*(S**2+(S+T)**2)/T**2*AINS
4939
4940           AINU=-4*S/T*AINS/NCOLO
4941
4942           AINS=4*AINS/NCOLO-AINU
4943
4944         ELSE
4945
4946           Y=LOG(S/(-T))+ONE
4947
4948           ASQ=HWUALF(1,EMSCA)**4*(S/T)**2*EXP(2*OMEGA0*Y)/Y**3
4949
4950           AINU=0
4951
4952           AINS=0
4953
4954         ENDIF
4955
4956       ENDIF
4957
4958 C---THE FINAL ANSWER IS JUST THEIR PRODUCT
4959
4960       IF (ID1.EQ.ID2) THEN
4961
4962         HWHSNM=QQ(ID1,ID2)*(ASQ+AINU)
4963
4964       ELSEIF (ABS(ID1-ID2).EQ.6) THEN
4965
4966         HWHSNM=QQ(ID1,ID2)*(ASQ+AINS)
4967
4968       ELSE
4969
4970         HWHSNM=QQ(ID1,ID2)*ASQ
4971
4972       ENDIF
4973
4974       END