]> git.uio.no Git - u/mrichter/AliRoot.git/blame - HERWIG/src/hwhssq.f
git://git.uio.no / u / mrichter / AliRoot.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Additional protection in Digitize, which was moved to the implementation file
[u/mrichter/AliRoot.git] / HERWIG / src / hwhssq.f
CommitLineData
3820ca8e 1
2CDECK ID>, HWHSSQ.
3
4*CMZ :- -18/05/99 20.33.45 by Kosuke Odagiri
5
6*-- Author : Kosuke Odagiri
7
8C-----------------------------------------------------------------------
9
10 SUBROUTINE HWHSSQ
11
12C-----------------------------------------------------------------------
13
14C SUSY HARD 2 PARTON -> 2 SPARTON PROCESSES
15
16C-----------------------------------------------------------------------
17
18 INCLUDE 'HERWIG61.INC'
19
20 DOUBLE PRECISION HWR, HWUALF, EPS, HCS, RCS, DIST, NC, NC2,
21
22 & NC2C, ML2(6), ML4(6), MR2(6), MR4(6), MG2, SM, DM, QPE,
23
24 & SQPE, FACTR, AFAC, AF, BONE, CFAC, CFC2, CFC3, CONE,
25
26 & CONN, CONT, CONU, CONL, CONR, DFAC, DONE, PF, S,
27
28 & S2, TT, TT2, TMG, TMG2, UU, UU2, UMG, UMG2,
29
30 & L, L2, TTML, UUML, R, R2, TTMR, UUMR, SN2TH
31
32 DOUBLE PRECISION
33
34 & AUSTLL(6), AUSTRR(6),
35
36 & ASTULL(6,6), ASTURR(6,6), ASTULR(6,6), ASTURL(6,6),
37
38 & AUTSLL(6,6), AUTSRR(6,6), AUTSLR(6,6), AUTSRL(6,6),
39
40 & BSTULL(6), BSTURR(6), BSTULR(6), BSTURL(6),
41
42 & BSUTLL(6), BSUTRR(6), BSUTLR(6), BSUTRL(6),
43
44 & BUTSLL(6), BUTSRR(6), BUTSLR(6), BUTSRL(6),
45
46 & BUSTLL(6), BUSTRR(6), BUSTLR(6), BUSTRL(6),
47
48 & CSTU(6), CSUT(6), CSTUL(6), CSTUR(6), CSUTL(6), CSUTR(6),
49
50 & CTSUL(6), CTSUR(6), CTUSL(6), CTUSR(6), DUTS, DTSU, DSTU
51
52 INTEGER IQ, IQ1, IQ2, ID1, ID2, ID2MIN, IGL, SSL, SSR, GLU
53
54 EXTERNAL HWR, HWUALF
55
56 SAVE HCS, AUSTLL, AUSTRR, ASTULL, ASTURR, ASTULR, ASTURL,
57
58 & AUTSLL, AUTSRR, AUTSLR, AUTSRL, BSTULL, BSTURR, BSTULR,
59
60 & BSTURL, BSUTLL, BSUTRR, BSUTLR, BSUTRL, BUTSLL, BUTSRR, BUTSLR,
61
62 & BUTSRL, BUSTLL, BUSTRR, BUSTLR, BUSTRL, CSTU, CSUT, CSTUL, CSTUR,
63
64 & CSUTL, CSUTR, CTSUL, CTSUR, CTUSL, CTUSR, DUTS, DTSU, DSTU
65
66 PARAMETER (EPS = 1.D-9, IGL = 49, SSL = 400, SSR = 412, GLU = 449)
67
68 CALL HWSGEN(.FALSE.)
69
70 IF (GENEV) THEN
71
72 RCS = HCS*HWR()
73
74 ELSE
75
76 SN2TH = 0.25D0 - 0.25D0*COSTH**2
77
78 S = XX(1)*XX(2)*PHEP(5,3)**2
79
80 FACTR = FACTSS*HWUALF(1,EMSCA)**2
81
82 NC = CAFAC
83
84 NC2 = NC**2
85
86 NC2C = ONE - ONE/NC2
87
88 AFAC = FACTR*NC2C/FOUR
89
90 CFAC = FACTR*CFFAC/FOUR
91
92 CFC2 = FACTR/CFFAC/FOUR
93
94 CFC3 = FACTR/FOUR
95
96 DFAC = FACTR/NC2C
97
98 S2 = S**2
99
100 MG2 = RMASS(GLU)**2
101
102 DO 10 IQ = 1, 6
103
104 IQ1 = SSL + IQ
105
106 IQ2 = SSR + IQ
107
108 ML2(IQ) = RMASS(IQ1)**2
109
110 ML4(IQ) = ML2(IQ)**2
111
112 MR2(IQ) = RMASS(IQ2)**2
113
114 MR4(IQ) = MR2(IQ)**2
115
116 10 CONTINUE
117
118c gluino pair production
119
120 QPE = S - FOUR*MG2
121
122 IF (QPE.GE.ZERO) THEN
123
124 SQPE = SQRT(S*QPE)
125
126 PF = SQPE/S
127
128 TT = (SQPE*COSTH - S) / TWO
129
130 TT2 = TT**2
131
132 UU = - S - TT
133
134 UU2 = UU**2
135
136c ~ ~
137
138c g g -> g g
139
140c
141
142 DONE =
143
144 & DFAC*PF/TWO*(UU2+TT2+FOUR*MG2*S*SQPE**2*SN2TH/TT/UU)/S2/TT/UU
145
146 DUTS = DONE*UU2
147
148 DTSU = DONE*TT2
149
150 DSTU = DONE*S2
151
152c _ ~ ~
153
154c q q -> g g
155
156c
157
158 DO 21 IQ = 1, 6
159
160 L = ML2(IQ)-MG2
161
162 L2 = L**2
163
164 TTML = TT-L
165
166 UUML = UU-L
167
168 R = MR2(IQ)-MG2
169
170 R2 = R**2
171
172 TTMR = TT-R
173
174 UUMR = UU-R
175
176 CONE = TWO*PF**2*SN2TH
177
178 CONL = CONE/UUML/TTML
179
180 CONR = CONE/UUMR/TTMR
181
182 CONT = (UU2-L2)*CONL+(UU2-R2)*CONR+L2/TTML**2+R2/TTMR**2
183
184 CONU = (TT2-L2)*CONL+(TT2-R2)*CONR+L2/UUML**2+R2/UUMR**2
185
186 CONN = CFAC*(PF-PF/NC2/(CONT+CONU)*( S2*(CONL+CONR)+
187
188 & L2*((TT-UU)*CONL/CONE)**2+R2*((TT-UU)*CONR/CONE)**2 ))
189
190 CSTU(IQ) = CONT*CONN
191
192 CSUT(IQ) = CONU*CONN
193
194 21 CONTINUE
195
196 ELSE
197
198 DUTS = ZERO
199
200 DTSU = ZERO
201
202 DSTU = ZERO
203
204 DO 23 IQ = 1, 6
205
206 CSTU(IQ) = ZERO
207
208 CSUT(IQ) = ZERO
209
210 23 CONTINUE
211
212 END IF
213
214c left handed squark (identical flavour) pair production
215
216 DO 22 IQ = 1, 6
217
218 QPE = S - FOUR*ML2(IQ)
219
220 IF (QPE.GE.ZERO) THEN
221
222 SQPE = SQRT(S*QPE)
223
224 PF = SQPE/S
225
226 TT = (SQPE*COSTH - S) / TWO
227
228 TT2 = TT**2
229
230 UU = - S - TT
231
232 UU2 = UU**2
233
234c ~ ~*
235
236c g g -> q q
237
238c L L
239
240 CONE = CFC2*PF*((SQPE*PF*SN2TH)**2+ML4(IQ))/TT2/UU2
241
242 CONN = CONE-CONE*S2/(TT2+UU2)/NC2
243
244 CSTUL(IQ) = CONN*UU2
245
246 CSUTL(IQ) = CONN*TT2
247
248c ~ ~
249
250c q q -> q q
251
252c L L
253
254 TMG = TT+ML2(IQ)-MG2
255
256 TMG2 = TMG**2
257
258 UMG = UU+ML2(IQ)-MG2
259
260 UMG2 = UMG**2
261
262 BONE = AFAC*PF*MG2*S*(HALF-TMG*UMG/(TMG2+UMG2)/NC)
263
264 BSTULL(IQ) = BONE/TMG2
265
266 BSUTLL(IQ) = BONE/UMG2
267
268c _ ~ ~*
269
270c q q -> q q
271
272c L L
273
274 AF = AFAC*PF*PF**2*SN2TH
275
276 BONE = AF/TMG2-AF*S/(HALF*S2+TMG2)/TMG/NC
277
278 BUTSLL(IQ) = BONE*S2
279
280 BUSTLL(IQ) = BONE*TWO*TMG2
281
282c _ ~ ~*
283
284c q q -> q'q' q =/= q'
285
286c L L
287
288 AUSTLL(IQ) = TWO*AF
289
290 ELSE
291
292 CSTUL(IQ) = ZERO
293
294 CSUTL(IQ) = ZERO
295
296 BSTULL(IQ) = ZERO
297
298 BSUTLL(IQ) = ZERO
299
300 BUTSLL(IQ) = ZERO
301
302 BUSTLL(IQ) = ZERO
303
304 AUSTLL(IQ) = ZERO
305
306 END IF
307
308c right handed squark (identical flavour) pair production
309
310 QPE = S - FOUR*MR2(IQ)
311
312 IF (QPE.GE.ZERO) THEN
313
314 SQPE = SQRT(S*QPE)
315
316 PF = SQPE/S
317
318 TT = (SQPE*COSTH - S) / TWO
319
320 TT2 = TT**2
321
322 UU = - S - TT
323
324 UU2 = UU**2
325
326c ~ ~*
327
328c g g -> q q
329
330c R R
331
332 CONE = CFC2*PF*((SQPE*PF*SN2TH)**2+MR4(IQ))/TT2/UU2
333
334 CONN = CONE-CONE*S2/(TT2+UU2)/NC2
335
336 CSTUR(IQ) = CONN*UU2
337
338 CSUTR(IQ) = CONN*TT2
339
340c ~ ~
341
342c q q -> q q
343
344c R R
345
346 TMG = TT+MR2(IQ)-MG2
347
348 TMG2 = TMG**2
349
350 UMG = UU+MR2(IQ)-MG2
351
352 UMG2 = UMG**2
353
354 BONE = AFAC*PF*MG2*S*(HALF-TMG*UMG/(TMG2+UMG2)/NC)
355
356 BSTURR(IQ) = BONE/TMG2
357
358 BSUTRR(IQ) = BONE/UMG2
359
360c _ ~ ~*
361
362c q q -> q q
363
364c R R
365
366 AF = AFAC*PF*PF**2*SN2TH
367
368 BONE = AF/TMG2-AF*S/(HALF*S2+TMG2)/TMG/NC
369
370 BUTSRR(IQ) = BONE*S2
371
372 BUSTRR(IQ) = BONE*TWO*TMG2
373
374c _ ~ ~*
375
376c q q -> q'q' q =/= q'
377
378c R R
379
380 AUSTRR(IQ) = TWO*AF
381
382 ELSE
383
384 CSTUR(IQ) = ZERO
385
386 CSUTR(IQ) = ZERO
387
388 BSTURR(IQ) = ZERO
389
390 BSUTRR(IQ) = ZERO
391
392 BUTSRR(IQ) = ZERO
393
394 BUSTRR(IQ) = ZERO
395
396 AUSTRR(IQ) = ZERO
397
398 END IF
399
400c left and right handed squark (identical flavour) pair production
401
402 IQ1 = SSL + IQ
403
404 IQ2 = SSR + IQ
405
406 SM = RMASS(IQ1)+RMASS(IQ2)
407
408 QPE = S - SM**2
409
410 IF (QPE.GE.ZERO) THEN
411
412 DM = RMASS(IQ1)-RMASS(IQ2)
413
414 SQPE = SQRT( QPE*(S-DM**2) )
415
416 PF = SQPE/S
417
418 AF = AFAC*PF
419
420 TT = (SQPE*COSTH - S - SM*DM) / TWO
421
422 UU = - S - TT
423
424 TMG = TT + ML2(IQ) - MG2
425
426 TMG2 = TMG**2
427
428 UMG = UU + MR2(IQ) - MG2
429
430 UMG2 = UMG**2
431
432c ~ ~
433
434c q q -> q q
435
436c L R
437
438 BONE = AFAC*PF*SQPE**2*SN2TH
439
440 BSTULR(IQ) = BONE/TMG2
441
442 BSUTLR(IQ) = BONE/UMG2
443
444c _ ~ ~*
445
446c q q -> q q
447
448c L R
449
450 BUTSLR(IQ) = AFAC*PF*MG2*S/TMG2
451
452 BUSTLR(IQ) = ZERO
453
454 TT = (SQPE*COSTH - S + SM*DM) / TWO
455
456 UU = - S - TT
457
458 TMG = TT + MR2(IQ) - MG2
459
460 TMG2 = TMG**2
461
462 UMG = UU + ML2(IQ) - MG2
463
464 UMG2 = UMG**2
465
466c ~ ~
467
468c q q -> q q
469
470c R L
471
472c BONE = AFAC*PF*SQPE**2*SN2TH
473
474c BSTURL(IQ) = BONE/TMG2
475
476c BSUTRL(IQ) = BONE/UMG2
477
478 BSTURL(IQ) = ZERO
479
480 BSUTRL(IQ) = ZERO
481
482c _ ~ ~*
483
484c q q -> q q
485
486c R L
487
488 BUTSRL(IQ) = AFAC*PF*MG2*S/TMG2
489
490 BUSTRL(IQ) = ZERO
491
492 ELSE
493
494 BSTULR(IQ) = ZERO
495
496 BSUTLR(IQ) = ZERO
497
498 BUTSLR(IQ) = ZERO
499
500 BUSTLR(IQ) = ZERO
501
502 BSTURL(IQ) = ZERO
503
504 BSUTRL(IQ) = ZERO
505
506 BUTSRL(IQ) = ZERO
507
508 BUSTRL(IQ) = ZERO
509
510 END IF
511
512 22 CONTINUE
513
514c distinct flavours - gq, qq'
515
516 DO 11 ID1 = 1, 6
517
518 IQ1 = SSL + ID1
519
520 SM = RMASS(GLU)+RMASS(IQ1)
521
522 QPE = S - SM**2
523
524 IF (QPE.GE.ZERO) THEN
525
526 DM = RMASS(GLU)-RMASS(IQ1)
527
528 SQPE = SQRT( QPE*(S-DM**2) )
529
530 PF = SQPE/S
531
532 TT = (SQPE*COSTH - S - SM*DM) / TWO
533
534 TT2 = TT**2
535
536 UU = - S - TT
537
538 UU2 = UU**2
539
540c ~ ~
541
542c g q -> g q
543
544c L
545
546 CONE = (-UU+TWO*SM*DM*(ONE+MG2/TT+ML2(ID1)/UU))/S/TT/UU
547
548 CONN = CFC3*PF*CONE*(ONE-TT2/(UU2+S2)/NC2)
549
550 CTSUL(ID1) = CONN*UU2
551
552 CTUSL(ID1) = CONN*S2
553
554 ELSE
555
556 CTSUL(ID1) = ZERO
557
558 CTUSL(ID1) = ZERO
559
560 END IF
561
562 IQ2 = SSR + ID1
563
564 SM = RMASS(GLU)+RMASS(IQ2)
565
566 QPE = S - SM**2
567
568 IF (QPE.GE.ZERO) THEN
569
570 DM = RMASS(GLU)-RMASS(IQ2)
571
572 SQPE = SQRT( QPE*(S-DM**2) )
573
574 PF = SQPE/S
575
576 TT = (SQPE*COSTH - S - SM*DM) / TWO
577
578 TT2 = TT**2
579
580 UU = - S - TT
581
582 UU2 = UU**2
583
584c ~ ~
585
586c g q -> g q
587
588c R
589
590 CONE = (-UU+TWO*SM*DM*(ONE+MG2/TT+MR2(ID1)/UU))/S/TT/UU
591
592 CONN = CFC3*PF*CONE*(ONE-TT2/(UU2+S2)/NC2)
593
594 CTSUR(ID1) = CONN*UU2
595
596 CTUSR(ID1) = CONN*S2
597
598 ELSE
599
600 CTSUR(ID1) = ZERO
601
602 CTUSR(ID1) = ZERO
603
604 END IF
605
606 IF(ID1.EQ.6) GOTO 11
607
608 ID2MIN = ID1+1
609
610 DO 12 ID2 = ID2MIN, 6
611
612 IQ1 = SSL + ID1
613
614 IQ2 = SSL + ID2
615
616 SM = RMASS(IQ1)+RMASS(IQ2)
617
618 QPE = S - SM**2
619
620 IF (QPE.GE.ZERO) THEN
621
622 DM = RMASS(IQ1)-RMASS(IQ2)
623
624 SQPE = SQRT( QPE*(S-DM**2) )
625
626 PF = SQPE/S
627
628 TT = (SQPE*COSTH - S - SM*DM) / TWO
629
630 UU = - S - TT
631
632 TMG = TT+ML2(ID1)-MG2
633
634 AF = AFAC*PF/TMG/TMG
635
636c ~ ~
637
638c q q' -> q q'
639
640c L L
641
642 ASTULL(ID1,ID2) = AF*MG2*S
643
644 ASTULL(ID2,ID1) = ASTULL(ID1,ID2)
645
646c _ ~ ~*
647
648c q q' -> q q'
649
650c L L
651
652 AUTSLL(ID1,ID2) = AF*SQPE**2*SN2TH
653
654 AUTSLL(ID2,ID1) = AUTSLL(ID1,ID2)
655
656 ELSE
657
658 ASTULL(ID1,ID2) = ZERO
659
660 ASTULL(ID2,ID1) = ZERO
661
662 AUTSLL(ID1,ID2) = ZERO
663
664 AUTSLL(ID2,ID1) = ZERO
665
666 END IF
667
668 IQ1 = SSR + ID1
669
670 IQ2 = SSR + ID2
671
672 SM = RMASS(IQ1)+RMASS(IQ2)
673
674 QPE = S - SM**2
675
676 IF (QPE.GE.ZERO) THEN
677
678 DM = RMASS(IQ1)-RMASS(IQ2)
679
680 SQPE = SQRT( QPE*(S-DM**2) )
681
682 PF = SQPE/S
683
684 TT = (SQPE*COSTH - S - SM*DM) / TWO
685
686 UU = - S - TT
687
688 TMG = TT+MR2(ID1)-MG2
689
690 AF = AFAC*PF/TMG/TMG
691
692c ~ ~
693
694c q q' -> q q'
695
696c R R
697
698 ASTURR(ID1,ID2) = AF*MG2*S
699
700 ASTURR(ID2,ID1) = ASTURR(ID1,ID2)
701
702c _ ~ ~*
703
704c q q' -> q q'
705
706c R R
707
708 AUTSRR(ID1,ID2) = AF*SQPE**2*SN2TH
709
710 AUTSRR(ID2,ID1) = AUTSRR(ID1,ID2)
711
712 ELSE
713
714 ASTURR(ID1,ID2) = ZERO
715
716 ASTURR(ID2,ID1) = ZERO
717
718 AUTSRR(ID1,ID2) = ZERO
719
720 AUTSRR(ID2,ID1) = ZERO
721
722 END IF
723
724 IQ1 = SSL + ID1
725
726 IQ2 = SSR + ID2
727
728 SM = RMASS(IQ1)+RMASS(IQ2)
729
730 QPE = S - SM**2
731
732 IF (QPE.GE.ZERO) THEN
733
734 DM = RMASS(IQ1)-RMASS(IQ2)
735
736 SQPE = SQRT( QPE*(S-DM**2) )
737
738 PF = SQPE/S
739
740 TT = (SQPE*COSTH - S - SM*DM) / TWO
741
742 UU = - S - TT
743
744 TMG = TT+ML2(ID1)-MG2
745
746 AF = AFAC*PF/TMG/TMG
747
748c ~ ~
749
750c q q' -> q q'
751
752c L R
753
754 ASTULR(ID1,ID2) = AF*SQPE**2*SN2TH
755
756 ASTULR(ID2,ID1) = ASTULR(ID1,ID2)
757
758c _ ~ ~*
759
760c q q' -> q q'
761
762c L R
763
764 AUTSLR(ID1,ID2) = AF*MG2*S
765
766 AUTSLR(ID2,ID1) = AUTSLR(ID1,ID2)
767
768 TT = (SQPE*COSTH - S + SM*DM) / TWO
769
770 UU = - S - TT
771
772 TMG = TT+MR2(ID1)-MG2
773
774 AF = AFAC*PF/TMG/TMG
775
776c ~ ~
777
778c q q' -> q q'
779
780c R L
781
782 ASTURL(ID1,ID2) = AF*SQPE**2*SN2TH
783
784 ASTURL(ID2,ID1) = ASTULR(ID1,ID2)
785
786c _ ~ ~*
787
788c q q' -> q q'
789
790c R L
791
792 AUTSRL(ID1,ID2) = AF*MG2*S
793
794 AUTSRL(ID2,ID1) = AUTSLR(ID1,ID2)
795
796 ELSE
797
798 ASTULR(ID1,ID2) = ZERO
799
800 ASTULR(ID2,ID1) = ZERO
801
802 AUTSLR(ID1,ID2) = ZERO
803
804 AUTSLR(ID2,ID1) = ZERO
805
806 ASTURL(ID1,ID2) = ZERO
807
808 ASTURL(ID2,ID1) = ZERO
809
810 AUTSRL(ID1,ID2) = ZERO
811
812 AUTSRL(ID2,ID1) = ZERO
813
814 END IF
815
816 12 CONTINUE
817
818 11 CONTINUE
819
820 END IF
821
822 HCS = ZERO
823
824 DO 6 ID1 = 1, 13
825
826 IF (DISF(ID1,1).LT.EPS) GOTO 6
827
828 DO 5 ID2 = 1, 13
829
830 IF (DISF(ID2,2).LT.EPS) GOTO 5
831
832 DIST = DISF(ID1,1)*DISF(ID2,2)
833
834
835
836 IF (ID1.LT.7) THEN
837
838 IQ1 = ID1
839
840 IF (ID2.LT.7) THEN
841
842 IQ2 = ID2
843
844 IF (IQ1.NE.IQ2) THEN
845
846c ~ ~
847
848c qq' -> q q'
849
850 HCS = HCS + ASTULL(IQ1,IQ2)*DIST
851
852 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,0,3421,10,*9)
853
854 HCS = HCS + ASTURR(IQ1,IQ2)*DIST
855
856 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,2,IQ2,2,3421,10,*9)
857
858 HCS = HCS + ASTULR(IQ1,IQ2)*DIST
859
860 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,2,3421,10,*9)
861
862 HCS = HCS + ASTURL(IQ1,IQ2)*DIST
863
864 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,2,IQ2,0,3421,10,*9)
865
866 ELSE
867
868c ~ ~
869
870c qq -> q q
871
872 HCS = HCS + BSTULL(IQ1)*DIST
873
874 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,0,3421,10,*9)
875
876 HCS = HCS + BSTURR(IQ1)*DIST
877
878 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,2,IQ2,2,3421,10,*9)
879
880 HCS = HCS + BSTULR(IQ1)*DIST
881
882 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,2,3421,10,*9)
883
884 HCS = HCS + BSTURL(IQ1)*DIST
885
886 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,2,IQ2,0,3421,10,*9)
887
888 HCS = HCS + BSUTLL(IQ1)*DIST
889
890 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,0,4312,10,*9)
891
892 HCS = HCS + BSUTRR(IQ1)*DIST
893
894 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,2,IQ2,2,4312,10,*9)
895
896 HCS = HCS + BSUTLR(IQ1)*DIST
897
898 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,2,4312,10,*9)
899
900 HCS = HCS + BSUTRL(IQ1)*DIST
901
902 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,2,IQ2,0,4312,10,*9)
903
904 END IF
905
906 ELSEIF (ID2.NE.13) THEN
907
908 IQ2 = ID2-6
909
910 IF (IQ1.NE.IQ2) THEN
911
912c _ ~ ~*
913
914c qq' -> q q'
915
916 HCS = HCS + AUTSLL(IQ1,IQ2)*DIST
917
918 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,1,3142,10,*9)
919
920 HCS = HCS + AUTSRR(IQ1,IQ2)*DIST
921
922 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,2,IQ2,3,3142,10,*9)
923
924 HCS = HCS + AUTSLR(IQ1,IQ2)*DIST
925
926 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,3,3142,10,*9)
927
928 HCS = HCS + AUTSRL(IQ1,IQ2)*DIST
929
930 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,2,IQ2,1,3142,10,*9)
931
932 ELSE
933
934c _ ~ ~*
935
936c qq -> q'q' (q =/= q')
937
938 DO 30 IQ = 1, 6
939
940 IF (IQ .EQ.IQ1) GOTO 30
941
942 HCS = HCS + AUSTLL(IQ )*DIST
943
944 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ ,0,IQ ,1,2413,10,*9)
945
946 HCS = HCS + AUSTRR(IQ )*DIST
947
948 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ ,2,IQ ,3,2413,10,*9)
949
950 30 CONTINUE
951
952c _ ~ ~*
953
954c qq -> q q
955
956 HCS = HCS + BUTSLL(IQ1)*DIST
957
958 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,1,3142,10,*9)
959
960 HCS = HCS + BUTSRR(IQ1)*DIST
961
962 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,2,IQ2,3,3142,10,*9)
963
964 HCS = HCS + BUTSLR(IQ1)*DIST
965
966 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,3,3142,10,*9)
967
968 HCS = HCS + BUTSRL(IQ1)*DIST
969
970 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,2,IQ2,1,3142,10,*9)
971
972 HCS = HCS + BUSTLL(IQ1)*DIST
973
974 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,1,2413,10,*9)
975
976 HCS = HCS + BUSTRR(IQ1)*DIST
977
978 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,2,IQ2,3,2413,10,*9)
979
980 HCS = HCS + BUSTLR(IQ1)*DIST
981
982 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,3,2413,10,*9)
983
984 HCS = HCS + BUSTRL(IQ1)*DIST
985
986 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,2,IQ2,1,2413,10,*9)
987
988 IQ = IGL
989
990c _ ~ ~
991
992c qq -> g g
993
994 HCS = HCS + CSTU(IQ1)*DIST
995
996 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ ,0,IQ ,0,2413,10,*9)
997
998 HCS = HCS + CSUT(IQ1)*DIST
999
1000 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ ,0,IQ ,0,2341,10,*9)
1001
1002 END IF
1003
1004 ELSE
1005
1006 IQ2 = IGL
1007
1008c ~ ~
1009
1010c qg -> q g
1011
1012 HCS = HCS + CTSUL(IQ1)*DIST
1013
1014 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,0,3142,10,*9)
1015
1016 HCS = HCS + CTSUR(IQ1)*DIST
1017
1018 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,2,IQ2,0,3142,10,*9)
1019
1020 HCS = HCS + CTUSL(IQ1)*DIST
1021
1022 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,0,3421,10,*9)
1023
1024 HCS = HCS + CTUSR(IQ1)*DIST
1025
1026 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,2,IQ2,0,3421,10,*9)
1027
1028 END IF
1029
1030 ELSEIF (ID1.NE.13) THEN
1031
1032 IQ1 = ID1 - 6
1033
1034 IF (ID2.LT.7) THEN
1035
1036 IQ2 = ID2
1037
1038 IF (IQ1.NE.IQ2) THEN
1039
1040c _ ~*~
1041
1042c qq' -> q q'
1043
1044 HCS = HCS + AUTSLL(IQ1,IQ2)*DIST
1045
1046 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,1,IQ2,0,2413,10,*9)
1047
1048 HCS = HCS + AUTSRR(IQ1,IQ2)*DIST
1049
1050 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,3,IQ2,2,2413,10,*9)
1051
1052 HCS = HCS + AUTSLR(IQ1,IQ2)*DIST
1053
1054 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,1,IQ2,2,2413,10,*9)
1055
1056 HCS = HCS + AUTSRL(IQ1,IQ2)*DIST
1057
1058 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,3,IQ2,0,2413,10,*9)
1059
1060 ELSE
1061
1062c _ ~*~
1063
1064c qq -> q'q' (q =/= q')
1065
1066 DO 31 IQ = 1, 6
1067
1068 IF (IQ .EQ.IQ1) GOTO 31
1069
1070 HCS = HCS + AUSTLL(IQ)*DIST
1071
1072 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ ,1,IQ ,0,3142,10,*9)
1073
1074 HCS = HCS + AUSTRR(IQ)*DIST
1075
1076 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ ,3,IQ ,2,3142,10,*9)
1077
1078 31 CONTINUE
1079
1080c _ ~*~
1081
1082c qq -> q q
1083
1084 HCS = HCS + BUTSLL(IQ1)*DIST
1085
1086 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,1,IQ2,0,2413,10,*9)
1087
1088 HCS = HCS + BUTSRR(IQ1)*DIST
1089
1090 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,3,IQ2,2,2413,10,*9)
1091
1092 HCS = HCS + BUTSLR(IQ1)*DIST
1093
1094 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,1,IQ2,2,2413,10,*9)
1095
1096 HCS = HCS + BUTSRL(IQ1)*DIST
1097
1098 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,3,IQ2,0,2413,10,*9)
1099
1100 HCS = HCS + BUSTLL(IQ1)*DIST
1101
1102 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,1,IQ2,0,3142,10,*9)
1103
1104 HCS = HCS + BUSTRR(IQ1)*DIST
1105
1106 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,3,IQ2,2,3142,10,*9)
1107
1108 HCS = HCS + BUSTLR(IQ1)*DIST
1109
1110 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,1,IQ2,2,3142,10,*9)
1111
1112 HCS = HCS + BUSTRL(IQ1)*DIST
1113
1114 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,3,IQ2,0,3142,10,*9)
1115
1116c _ ~ ~
1117
1118c qq -> g g
1119
1120 HCS = HCS + CSTU(IQ1)*DIST
1121
1122 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IGL,0,IGL,0,3142,10,*9)
1123
1124 HCS = HCS + CSUT(IQ1)*DIST
1125
1126 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IGL,0,IGL,0,4123,10,*9)
1127
1128 END IF
1129
1130 ELSEIF (ID2.NE.13) THEN
1131
1132 IQ2 = ID2 - 6
1133
1134 IF (IQ1.NE.IQ2) THEN
1135
1136c __ ~*~*
1137
1138c qq' -> q q'
1139
1140 HCS = HCS + ASTULL(IQ1,IQ2)*DIST
1141
1142 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,1,IQ2,1,4312,10,*9)
1143
1144 HCS = HCS + ASTURR(IQ1,IQ2)*DIST
1145
1146 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,3,IQ2,3,4312,10,*9)
1147
1148 HCS = HCS + ASTULR(IQ1,IQ2)*DIST
1149
1150 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,1,IQ2,3,4312,10,*9)
1151
1152 HCS = HCS + ASTURL(IQ1,IQ2)*DIST
1153
1154 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,3,IQ2,1,4312,10,*9)
1155
1156 ELSE
1157
1158c __ ~*~*
1159
1160c qq -> q q
1161
1162 HCS = HCS + BSTULL(IQ1)*DIST
1163
1164 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,1,IQ2,1,4312,10,*9)
1165
1166 HCS = HCS + BSTURR(IQ1)*DIST
1167
1168 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,3,IQ2,3,4312,10,*9)
1169
1170 HCS = HCS + BSTULR(IQ1)*DIST
1171
1172 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,1,IQ2,3,4312,10,*9)
1173
1174 HCS = HCS + BSTURL(IQ1)*DIST
1175
1176 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,3,IQ2,1,4312,10,*9)
1177
1178 HCS = HCS + BSUTLL(IQ1)*DIST
1179
1180 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,1,IQ2,1,3421,10,*9)
1181
1182 HCS = HCS + BSUTRR(IQ1)*DIST
1183
1184 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,3,IQ2,3,3421,10,*9)
1185
1186 HCS = HCS + BSUTLR(IQ1)*DIST
1187
1188 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,1,IQ2,3,3421,10,*9)
1189
1190 HCS = HCS + BSUTRL(IQ1)*DIST
1191
1192 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,3,IQ2,1,3421,10,*9)
1193
1194 END IF
1195
1196 ELSE
1197
1198 IQ2 = IGL
1199
1200c _ ~*~
1201
1202c qg -> q g
1203
1204 HCS = HCS + CTSUL(IQ1)*DIST
1205
1206 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,1,IQ2,0,2413,10,*9)
1207
1208 HCS = HCS + CTSUR(IQ1)*DIST
1209
1210 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,3,IQ2,0,2413,10,*9)
1211
1212 HCS = HCS + CTUSL(IQ1)*DIST
1213
1214 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,1,IQ2,0,4312,10,*9)
1215
1216 HCS = HCS + CTUSR(IQ1)*DIST
1217
1218 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,3,IQ2,0,4312,10,*9)
1219
1220 END IF
1221
1222 ELSE
1223
1224 IQ1 = IGL
1225
1226 IF (ID2.LT.7) THEN
1227
1228 IQ2 = ID2
1229
1230c ~ ~
1231
1232c gq -> g q
1233
1234 HCS = HCS + CTSUL(IQ2)*DIST
1235
1236 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,0,2413,10,*9)
1237
1238 HCS = HCS + CTSUR(IQ2)*DIST
1239
1240 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,2,2413,10,*9)
1241
1242 HCS = HCS + CTUSL(IQ2)*DIST
1243
1244 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,0,3421,10,*9)
1245
1246 HCS = HCS + CTUSR(IQ2)*DIST
1247
1248 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,2,3421,10,*9)
1249
1250 ELSEIF (ID2.LT.13) THEN
1251
1252 IQ2 = ID2 - 6
1253
1254c _ ~ ~*
1255
1256c gq -> g q
1257
1258 HCS = HCS + CTSUL(IQ2)*DIST
1259
1260 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,1,3142,10,*9)
1261
1262 HCS = HCS + CTSUR(IQ2)*DIST
1263
1264 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,3,3142,10,*9)
1265
1266 HCS = HCS + CTUSL(IQ2)*DIST
1267
1268 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,1,4312,10,*9)
1269
1270 HCS = HCS + CTUSR(IQ2)*DIST
1271
1272 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,3,4312,10,*9)
1273
1274 ELSE
1275
1276 IQ2 = IGL
1277
1278c ~ ~*
1279
1280c gg -> q q
1281
1282 DO 32 IQ = 1, 6
1283
1284 HCS = HCS + CSTUL(IQ)*DIST
1285
1286 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ ,0,IQ ,1,2413,10,*9)
1287
1288 HCS = HCS + CSTUR(IQ)*DIST
1289
1290 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ ,2,IQ ,3,2413,10,*9)
1291
1292 HCS = HCS + CSUTL(IQ)*DIST
1293
1294 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ ,0,IQ ,1,4123,10,*9)
1295
1296 HCS = HCS + CSUTR(IQ)*DIST
1297
1298 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ ,2,IQ ,3,4123,10,*9)
1299
1300 32 CONTINUE
1301
1302c ~ ~
1303
1304c gg -> g g
1305
1306 HCS = HCS + DTSU*DIST
1307
1308 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,0,2341,10,*9)
1309
1310 HCS = HCS + DSTU*DIST
1311
1312 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,0,3421,10,*9)
1313
1314 HCS = HCS + DUTS*DIST
1315
1316 IF (GENEV.AND.HCS.GT.RCS) CALL HWHSSS(IQ1,0,IQ2,0,2413,10,*9)
1317
1318 END IF
1319
1320 END IF
1321
1322 5 CONTINUE
1323
1324 6 CONTINUE
1325
1326 EVWGT = HCS
1327
1328 RETURN
1329
1330C---GENERATE EVENT
1331
1332 9 IDN(1)=ID1
1333
1334 IDN(2)=ID2
1335
1336 IDCMF=15
1337
1338 CALL HWETWO
1339
1340 IF (AZSPIN) THEN
1341
1342C Calculate coefficients for constructing spin density matrices
1343
1344C Set to zero for now
1345
1346 CALL HWVZRO(7,GCOEF)
1347
1348 END IF
1349
1350 999 END
1351
1352CDECK ID>, HWHSSP.
1353
1354*CMZ :- -25/06/99 20.33.45 by Kosuke Odagiri
1355
1356*-- Author : Kosuke Odagiri & Bryan Webber
1357
1358C-----------------------------------------------------------------------
1359
1360 SUBROUTINE HWHSSP
1361
1362C-----------------------------------------------------------------------
1363
1364C SUSY HARD 2 PARTON -> 2 SPARTON/GAUGINO/SLEPTON PROCESSES
1365
1366C-----------------------------------------------------------------------
1367
1368 INCLUDE 'HERWIG61.INC'
1369
1370 DOUBLE PRECISION SAVWT(3),RANWT,HWR,HWRUNI,Z1,Z2,ET,EJ,
1371
1372 & QPE,S,T,U,KK,KK2,YJ1INF,YJ1SUP,YJ2INF,YJ2SUP,SVEMSC
1373
1374 INTEGER ISP
1375
1376 EXTERNAL HWR,HWRUNI
1377
1378 SAVE SAVWT,SVEMSC
1379
1380 IF (.NOT.GENEV) THEN
1381
1382 EVWGT=ZERO
1383
1384 CALL HWRPOW(ET,EJ)
1385
1386 KK = ET/PHEP(5,3)
1387
1388 KK2=KK**2
1389
1390 IF (KK.GE.ONE) RETURN
1391
1392 YJ1INF = MAX( YJMIN, LOG((ONE-SQRT(ONE-KK2))/KK) )
1393
1394 YJ1SUP = MIN( YJMAX, LOG((ONE+SQRT(ONE-KK2))/KK) )
1395
1396 IF (YJ1INF.GE.YJ1SUP) RETURN
1397
1398 Z1=EXP(HWRUNI(1,YJ1INF,YJ1SUP))
1399
1400 YJ2INF = MAX( YJMIN, -LOG(TWO/KK-ONE/Z1) )
1401
1402 YJ2SUP = MIN( YJMAX, LOG(TWO/KK-Z1) )
1403
1404 IF (YJ2INF.GE.YJ2SUP) RETURN
1405
1406 Z2=EXP(HWRUNI(2,YJ2INF,YJ2SUP))
1407
1408 XX(1)=HALF*(Z1+Z2)*KK
1409
1410 IF (XX(1).GE.ONE) RETURN
1411
1412 XX(2)=XX(1)/(Z1*Z2)
1413
1414 IF (XX(2).GE.ONE) RETURN
1415
1416 S=XX(1)*XX(2)*PHEP(5,3)**2
1417
1418 QPE=S-(TWO*RMMNSS)**2
1419
1420 IF (QPE.LE.ZERO) RETURN
1421
1422 COSTH=HALF*ET*(Z1-Z2)/SQRT(Z1*Z2*QPE)
1423
1424 IF (ABS(COSTH).GT.ONE) RETURN
1425
1426 T=-(ONE+Z2/Z1)*(HALF*ET)**2
1427
1428 U=-S-T
1429
1430C---SET EMSCA TO HEAVY HARD PROCESS SCALE
1431
1432 SVEMSC = SQRT(TWO*S*T*U/(S*S+T*T+U*U))
1433
1434 FACTSS = GEV2NB*HALF*PIFAC*EJ*ET/S**2
1435
1436 & * (YJ1SUP-YJ1INF)*(YJ2SUP-YJ2INF)
1437
1438 & * SQRT(S/QPE)
1439
1440 ENDIF
1441
1442 EMSCA=SVEMSC
1443
1444 ISP=MOD(IPROC,100)
1445
1446 IF (ISP.EQ.0) THEN
1447
1448 IF (GENEV) THEN
1449
1450 RANWT=SAVWT(3)*HWR()
1451
1452 IF (RANWT.LT.SAVWT(1)) THEN
1453
1454 CALL HWHSSQ
1455
1456 ELSEIF (RANWT.LT.SAVWT(2)) THEN
1457
1458 CALL HWHSSG
1459
1460 ELSE
1461
1462 CALL HWHSSL
1463
1464 ENDIF
1465
1466 ELSE
1467
1468 CALL HWHSSQ
1469
1470 SAVWT(1)=EVWGT
1471
1472 CALL HWHSSG
1473
1474 SAVWT(2)=SAVWT(1)+EVWGT
1475
1476 CALL HWHSSL
1477
1478 SAVWT(3)=SAVWT(2)+EVWGT
1479
1480 EVWGT=SAVWT(3)
1481
1482 ENDIF
1483
1484 ELSEIF (ISP.EQ.10) THEN
1485
1486 CALL HWHSSQ
1487
1488 ELSEIF (ISP.EQ.20) THEN
1489
1490 CALL HWHSSG
1491
1492 ELSEIF (ISP.EQ.30) THEN
1493
1494 CALL HWHSSL
1495
1496 ELSE
1497
1498C---UNRECOGNIZED PROCESS
1499
1500 CALL HWWARN('HWHSSP',500,*999)
1501
1502 ENDIF
1503
1504 999 END
1505
1506CDECK ID>, HWHSSS.
1507
1508*CMZ :- -18/05/99 20.33.45 by Kosuke Odagiri
1509
1510*-- Author : Kosuke Odagiri
1511
1512C-----------------------------------------------------------------------
1513
1514 SUBROUTINE HWHSSS(ID3,R3,ID4,R4,IPERM,IHPR,*)
1515
1516C-----------------------------------------------------------------------
1517
1518C IDENTIFIES HARD SUSY SUBPROCESS
1519
1520C-----------------------------------------------------------------------
1521
1522 INCLUDE 'HERWIG61.INC'
1523
1524 INTEGER ID3, R3, ID4, R4, IPERM, IHPR, SSL
1525
1526 PARAMETER (SSL = 400)
1527
1528 IHPRO = 3000 + IHPR
1529
1530 IDN(3) = SSL + ID3 + R3*6
1531
1532 IDN(4) = SSL + ID4 + R4*6
1533
1534 ICO(1) = IPERM/1000
1535
1536 ICO(2) = IPERM/100 - 10*ICO(1)
1537
1538 ICO(3) = IPERM/10 - 10*(IPERM/100)
1539
1540 ICO(4) = IPERM - 10*(IPERM/10)
1541
1542 RETURN 1
1543
1544 END