]>
Commit | Line | Data |
---|---|---|
3820ca8e | 1 | |
2 | CDECK ID>, HWHIGZ. | |
3 | ||
4 | *CMZ :- -02/05/91 11.18.44 by Federico Carminati | |
5 | ||
6 | *-- Author : Mike Seymour | |
7 | ||
8 | C----------------------------------------------------------------------- | |
9 | ||
10 | SUBROUTINE HWHIGZ | |
11 | ||
12 | C----------------------------------------------------------------------- | |
13 | ||
14 | C HIGGS PRODUCTION VIA THE BJORKEN PROCESS: E+E- --> Z(*) --> Z(*)H | |
15 | ||
16 | C WHERE ONE OR BOTH OF THE Zs IS OFF-SHELL | |
17 | ||
18 | C USES ALGORITHM OF BERENDS AND KLEISS: NUCL.PHYS. B260(1985)32 | |
19 | ||
20 | C | |
21 | ||
22 | C MEAN EVWGT = CROSS-SECTION (IN NB) * HIGGS BRANCHING FRACTION | |
23 | ||
24 | C----------------------------------------------------------------------- | |
25 | ||
26 | INCLUDE 'HERWIG61.INC' | |
27 | ||
28 | DOUBLE PRECISION HWUAEM,HWHIGY,HWRUNI,HWR,HWULDO,EMZ,CVE,CAE, | |
29 | ||
30 | & POL1,POL2,CE1,CE2,CE3,PMAX,EMZ2,S,B,FACTR,EMH,EMFAC,EMH2,A,XP, | |
31 | ||
32 | & CV,CA,BRHIGQ,BR,X1,X2,FAC1,FAC2,XPP,XPPSQ,COEF,X,XSQ,PROB,C1,C2, | |
33 | ||
34 | & CHIGG,PTHETA,SHIGG,C3,PHIMAX,CPHI,SPHI,C2PHI,S2PHI,PCM,ELST | |
35 | ||
36 | INTEGER IDEC,I,NLOOP,ICMF,IHIG,IZED,IFER,IANT,ID1,ID2,IN1,IN2 | |
37 | ||
38 | EXTERNAL HWUAEM,HWHIGY,HWRUNI,HWR,HWULDO | |
39 | ||
40 | SAVE CVE,CAE,CE1,CE2,CE3,PMAX,EMZ2,S,EMH,B,FACTR,A,EMH2 | |
41 | ||
42 | EQUIVALENCE (EMZ,RMASS(200)) | |
43 | ||
44 | DATA ELST/0/ | |
45 | ||
46 | C---SET UP CONSTANTS | |
47 | ||
48 | IN1=1 | |
49 | ||
50 | IF (JDAHEP(1,IN1).NE.0) IN1=JDAHEP(1,IN1) | |
51 | ||
52 | IN2=2 | |
53 | ||
54 | IF (JDAHEP(1,IN2).NE.0) IN2=JDAHEP(1,IN2) | |
55 | ||
56 | IF (FSTWGT.OR.ELST.NE.PHEP(5,3)) THEN | |
57 | ||
58 | ELST=PHEP(5,3) | |
59 | ||
60 | CVE=VFCH(11,1) | |
61 | ||
62 | CAE=AFCH(11,1) | |
63 | ||
64 | POL1=1.-EPOLN(3)*PPOLN(3) | |
65 | ||
66 | POL2=EPOLN(3)-PPOLN(3) | |
67 | ||
68 | CE1=(POL1*(CVE**2+CAE**2)+POL2*2.*CVE*CAE) | |
69 | ||
70 | CE2=(POL1*2.*CVE*CAE+POL2*(CVE**2+CAE**2)) | |
71 | ||
72 | IF ((IDHW(IN1).GT.IDHW(IN2).AND.PHEP(3,IN1).LT.ZERO).OR. | |
73 | ||
74 | & (IDHW(IN2).GT.IDHW(IN1).AND.PHEP(3,IN2).LT.ZERO)) CE2=-CE2 | |
75 | ||
76 | IF (TPOL) CE3=(CVE**2-CAE**2) | |
77 | ||
78 | PMAX=4 | |
79 | ||
80 | EMZ2=EMZ**2 | |
81 | ||
82 | S=PHEP(5,3)**2 | |
83 | ||
84 | B=EMZ*GAMZ/S | |
85 | ||
86 | FACTR=GEV2NB*CE1*(HWUAEM(RMASS(201)**2)*ENHANC(11))**2 | |
87 | ||
88 | & /(12.*S*SWEIN*(1.-SWEIN))*B/((1-EMZ2/S)**2+B**2) | |
89 | ||
90 | ENDIF | |
91 | ||
92 | IF (.NOT.GENEV) THEN | |
93 | ||
94 | C---CHOOSE HIGGS MASS, AND CALCULATE EVENT WEIGHT | |
95 | ||
96 | EVWGT=0D0 | |
97 | ||
98 | CALL HWHIGM(EMH,EMFAC) | |
99 | ||
100 | IF (EMH.LE.ZERO .OR. EMH.GT.PHEP(5,3)) RETURN | |
101 | ||
102 | EMSCA=EMH | |
103 | ||
104 | EMH2=EMH**2 | |
105 | ||
106 | A=4*EMH2/S | |
107 | ||
108 | XP=1+(EMH2-EMZ2)/S | |
109 | ||
110 | EVWGT=FACTR*HWHIGY(A,B,XP)*EMFAC | |
111 | ||
112 | C---INCLUDE BRANCHING RATIO OF HIGGS | |
113 | ||
114 | IDEC=MOD(IPROC,100) | |
115 | ||
116 | IF (IDEC.GT.0.AND.IDEC.LE.12) EVWGT=EVWGT*BRHIG(IDEC) | |
117 | ||
118 | IF (IDEC.EQ.0) THEN | |
119 | ||
120 | BRHIGQ=0 | |
121 | ||
122 | DO 10 I=1,6 | |
123 | ||
124 | 10 BRHIGQ=BRHIGQ+BRHIG(I) | |
125 | ||
126 | EVWGT=EVWGT*BRHIGQ | |
127 | ||
128 | ENDIF | |
129 | ||
130 | C Add Z branching fractions | |
131 | ||
132 | CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,0) | |
133 | ||
134 | EVWGT=EVWGT*BR | |
135 | ||
136 | IF (IDEC.EQ.10) THEN | |
137 | ||
138 | CALL HWDBOZ(198,ID1,ID2,CV,CA,BR,1) | |
139 | ||
140 | CALL HWDBOZ(199,ID1,ID2,CV,CA,BR,1) | |
141 | ||
142 | EVWGT=EVWGT*BR | |
143 | ||
144 | ELSEIF (IDEC.EQ.11) THEN | |
145 | ||
146 | CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,1) | |
147 | ||
148 | CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,1) | |
149 | ||
150 | EVWGT=EVWGT*BR | |
151 | ||
152 | ENDIF | |
153 | ||
154 | ELSE | |
155 | ||
156 | C---GENERATE EVENT | |
157 | ||
158 | ICMF=NHEP+1 | |
159 | ||
160 | IHIG=NHEP+2 | |
161 | ||
162 | IZED=NHEP+3 | |
163 | ||
164 | IFER=NHEP+4 | |
165 | ||
166 | IANT=NHEP+5 | |
167 | ||
168 | CALL HWVEQU(5,PHEP(1,3),PHEP(1,ICMF)) | |
169 | ||
170 | NHEP=NHEP+5 | |
171 | ||
172 | C---CHOOSE ENERGY FRACTION OF HIGGS | |
173 | ||
174 | X1=SQRT(A) | |
175 | ||
176 | X2=1+0.25*A | |
177 | ||
178 | XP=1+(EMH2-EMZ2)/S | |
179 | ||
180 | FAC1=ATAN((X1-XP)/B) | |
181 | ||
182 | FAC2=ATAN((X2-XP)/B) | |
183 | ||
184 | XPP=MIN(X2,MAX(X1+B,XP)) | |
185 | ||
186 | XPPSQ=XPP**2 | |
187 | ||
188 | NLOOP=0 | |
189 | ||
190 | COEF=1./((12+2*A-12*XPP+XPPSQ)*SQRT(XPPSQ-A)) | |
191 | ||
192 | 20 NLOOP=NLOOP+1 | |
193 | ||
194 | IF (NLOOP.GT.NBTRY) CALL HWWARN('HWHIGZ',101,*999) | |
195 | ||
196 | X=XP+B*TAN(HWRUNI(1,FAC1,FAC2)) | |
197 | ||
198 | XSQ=X**2 | |
199 | ||
200 | PROB=COEF*((12+2*A-12*X+XSQ)*SQRT(XSQ-A)) | |
201 | ||
202 | IF (PROB.GT.PMAX) THEN | |
203 | ||
204 | PMAX=1.1*PROB | |
205 | ||
206 | CALL HWWARN('HWHIGZ',1,*999) | |
207 | ||
208 | WRITE (6,21) PMAX | |
209 | ||
210 | 21 FORMAT(7X,'NEW HWHIGZ MAX WEIGHT =',F8.4) | |
211 | ||
212 | ENDIF | |
213 | ||
214 | IF (PROB.LT.PMAX*HWR()) GOTO 20 | |
215 | ||
216 | C Choose Z decay mode | |
217 | ||
218 | CALL HWDBOZ(200,IDHW(IFER),IDHW(IANT),CV,CA,BR,0) | |
219 | ||
220 | C1=CE1*(CV**2+CA**2) | |
221 | ||
222 | C2=CE2*2.*CV*CA | |
223 | ||
224 | C---CHOOSE HIGGS DIRECTION | |
225 | ||
226 | C First polar angle | |
227 | ||
228 | NLOOP=0 | |
229 | ||
230 | COEF=(XSQ-A)/(8.*(1.-X)+XSQ+A) | |
231 | ||
232 | 30 NLOOP=NLOOP+1 | |
233 | ||
234 | IF (NLOOP.GT.NBTRY) CALL HWWARN('HWHIGZ',102,*999) | |
235 | ||
236 | CHIGG=HWRUNI(2,-ONE, ONE) | |
237 | ||
238 | PTHETA=1-COEF*CHIGG**2 | |
239 | ||
240 | IF (PTHETA.LT.HWR()) GOTO 30 | |
241 | ||
242 | SHIGG=SQRT(1-CHIGG**2) | |
243 | ||
244 | C Now azimuthal angle | |
245 | ||
246 | IF (TPOL) THEN | |
247 | ||
248 | C3=CE3*(CV*2+CA**2) | |
249 | ||
250 | COEF=COEF*SHIGG**2*C3/C1 | |
251 | ||
252 | PHIMAX=PTHETA+ABS(COEF) | |
253 | ||
254 | 40 CALL HWRAZM(ONE,CPHI,SPHI) | |
255 | ||
256 | C2PHI=2.*CPHI**2-1. | |
257 | ||
258 | S2PHI=2.*CPHI*SPHI | |
259 | ||
260 | PROB=PTHETA-COEF*(C2PHI*COSS+S2PHI*SINS) | |
261 | ||
262 | IF (PROB.LT.HWR()*PHIMAX) GOTO 40 | |
263 | ||
264 | ELSE | |
265 | ||
266 | CALL HWRAZM(ONE,CPHI,SPHI) | |
267 | ||
268 | ENDIF | |
269 | ||
270 | C Construct Higgs and Z momenta | |
271 | ||
272 | PHEP(5,IHIG)=EMH | |
273 | ||
274 | PHEP(4,IHIG)=X*PHEP(5,ICMF)/2 | |
275 | ||
276 | PCM=SQRT(PHEP(4,IHIG)**2-EMH2) | |
277 | ||
278 | PHEP(3,IHIG)=CHIGG*PCM | |
279 | ||
280 | PHEP(1,IHIG)=SHIGG*PCM*CPHI | |
281 | ||
282 | PHEP(2,IHIG)=SHIGG*PCM*SPHI | |
283 | ||
284 | CALL HWVDIF(4,PHEP(1,ICMF),PHEP(1,IHIG),PHEP(1,IZED)) | |
285 | ||
286 | CALL HWUMAS(PHEP(1,IZED)) | |
287 | ||
288 | C Choose orientation of Z decay | |
289 | ||
290 | NLOOP=0 | |
291 | ||
292 | COEF=2.*(C1+ABS(C2))*HWULDO(PHEP(1,IN1),PHEP(1,IZED)) | |
293 | ||
294 | & *HWULDO(PHEP(1,IN2),PHEP(1,IZED))/S | |
295 | ||
296 | IF (TPOL) COEF=COEF*(C1+ABS(C2)+ABS(C3))/(C1+ABS(C2)) | |
297 | ||
298 | PCM=PHEP(5,IZED)/2 | |
299 | ||
300 | PHEP(5,IFER)=0 | |
301 | ||
302 | PHEP(5,IANT)=0 | |
303 | ||
304 | 50 NLOOP=NLOOP+1 | |
305 | ||
306 | IF (NLOOP.GT.NBTRY) CALL HWWARN('HWHIGZ',103,*999) | |
307 | ||
308 | CALL HWDTWO(PHEP(1,IZED),PHEP(1,IFER),PHEP(1,IANT), | |
309 | ||
310 | & PCM,TWO,.TRUE.) | |
311 | ||
312 | PROB=C1*(PHEP(4,IFER)*PHEP(4,IANT)-PHEP(3,IFER)*PHEP(3,IANT)) | |
313 | ||
314 | & +C2*(PHEP(4,IFER)*PHEP(3,IANT)-PHEP(3,IFER)*PHEP(4,IANT)) | |
315 | ||
316 | IF (TPOL) PROB=PROB+C3* | |
317 | ||
318 | & (COSS*(PHEP(1,IFER)*PHEP(1,IANT)-PHEP(2,IFER)*PHEP(2,IANT)) | |
319 | ||
320 | & +SINS*(PHEP(1,IFER)*PHEP(2,IANT)+PHEP(2,IFER)*PHEP(1,IANT))) | |
321 | ||
322 | IF (PROB.LT.HWR()*COEF) GOTO 50 | |
323 | ||
324 | C---SET UP STATUS CODES, | |
325 | ||
326 | ISTHEP(ICMF)=120 | |
327 | ||
328 | ISTHEP(IHIG)=190 | |
329 | ||
330 | ISTHEP(IZED)=195 | |
331 | ||
332 | ISTHEP(IFER)=113 | |
333 | ||
334 | ISTHEP(IANT)=114 | |
335 | ||
336 | C---COLOR CONNECTIONS, | |
337 | ||
338 | JMOHEP(1,ICMF)=1 | |
339 | ||
340 | JMOHEP(2,ICMF)=2 | |
341 | ||
342 | JDAHEP(1,ICMF)=IHIG | |
343 | ||
344 | JDAHEP(2,ICMF)=IZED | |
345 | ||
346 | JMOHEP(1,IHIG)=ICMF | |
347 | ||
348 | JMOHEP(1,IZED)=ICMF | |
349 | ||
350 | JMOHEP(1,IFER)=IZED | |
351 | ||
352 | JMOHEP(1,IANT)=IZED | |
353 | ||
354 | JMOHEP(2,IFER)=IANT | |
355 | ||
356 | JMOHEP(2,IANT)=IFER | |
357 | ||
358 | JDAHEP(1,IZED)=IFER | |
359 | ||
360 | JDAHEP(2,IZED)=IANT | |
361 | ||
362 | JDAHEP(2,IFER)=IANT | |
363 | ||
364 | JDAHEP(2,IANT)=IFER | |
365 | ||
366 | C---IDENTITY CODES | |
367 | ||
368 | IDHW(ICMF)=200 | |
369 | ||
370 | IDHW(IHIG)=201 | |
371 | ||
372 | IDHW(IZED)=200 | |
373 | ||
374 | IDHEP(ICMF)=IDPDG(IDHW(ICMF)) | |
375 | ||
376 | IDHEP(IHIG)=IDPDG(IDHW(IHIG)) | |
377 | ||
378 | IDHEP(IZED)=IDPDG(IDHW(IZED)) | |
379 | ||
380 | IDHEP(IFER)=IDPDG(IDHW(IFER)) | |
381 | ||
382 | IDHEP(IANT)=IDPDG(IDHW(IANT)) | |
383 | ||
384 | ENDIF | |
385 | ||
386 | 999 END | |
387 | ||
388 | CDECK ID>, HWHPH2. | |
389 | ||
390 | *CMZ :- -12/01/93 10.12.43 by Bryan Webber | |
391 | ||
392 | *-- Author : Ian Knowles | |
393 | ||
394 | C----------------------------------------------------------------------- | |
395 | ||
396 | SUBROUTINE HWHPH2 | |
397 | ||
398 | C----------------------------------------------------------------------- | |
399 | ||
400 | C QQD direct photon pair production: mean EVWGT = sigma in nb | |
401 | ||
402 | C----------------------------------------------------------------------- | |
403 | ||
404 | INCLUDE 'HERWIG61.INC' | |
405 | ||
406 | DOUBLE PRECISION HWR,HWRUNI,HWUALF,HWHPPB,EPS,RCS,ET,EJ,KK,KK2, | |
407 | ||
408 | & YJ1INF,YJ1SUP,Z1,YJ2INF,YJ2SUP,Z2,FACT,FACTR,RS,S,T,U,CSTU,TQSQ, | |
409 | ||
410 | & DSTU,HCS | |
411 | ||
412 | INTEGER ID,ID1,ID2 | |
413 | ||
414 | EXTERNAL HWR,HWRUNI,HWUALF,HWHPPB | |
415 | ||
416 | SAVE HCS,CSTU,DSTU,FACT | |
417 | ||
418 | PARAMETER (EPS=1.D-9) | |
419 | ||
420 | IF (GENEV) THEN | |
421 | ||
422 | RCS=HCS*HWR() | |
423 | ||
424 | ELSE | |
425 | ||
426 | EVWGT=0. | |
427 | ||
428 | CALL HWRPOW(ET,EJ) | |
429 | ||
430 | KK=ET/PHEP(5,3) | |
431 | ||
432 | KK2=KK**2 | |
433 | ||
434 | IF (KK.GE.ONE) RETURN | |
435 | ||
436 | YJ1INF=MAX( YJMIN , LOG((1.-SQRT(1.-KK2))/KK) ) | |
437 | ||
438 | YJ1SUP=MIN( YJMAX , LOG((1.+SQRT(1.-KK2))/KK) ) | |
439 | ||
440 | IF (YJ1INF.GE.YJ1SUP) RETURN | |
441 | ||
442 | Z1=EXP(HWRUNI(1,YJ1INF,YJ1SUP)) | |
443 | ||
444 | YJ2INF=MAX( YJMIN , -LOG(2./KK-1./Z1) ) | |
445 | ||
446 | YJ2SUP=MIN( YJMAX , LOG(2./KK-Z1) ) | |
447 | ||
448 | IF (YJ2INF.GE.YJ2SUP) RETURN | |
449 | ||
450 | Z2=EXP(HWRUNI(2,YJ2INF,YJ2SUP)) | |
451 | ||
452 | XX(1)=0.5*(Z1+Z2)*KK | |
453 | ||
454 | IF (XX(1).GE.ONE) RETURN | |
455 | ||
456 | XX(2)=XX(1)/(Z1*Z2) | |
457 | ||
458 | IF (XX(2).GE.ONE) RETURN | |
459 | ||
460 | COSTH=(Z1-Z2)/(Z1+Z2) | |
461 | ||
462 | S=XX(1)*XX(2)*PHEP(5,3)**2 | |
463 | ||
464 | RS=0.5*SQRT(S) | |
465 | ||
466 | T=-0.5*S*(1.-COSTH) | |
467 | ||
468 | U=-S-T | |
469 | ||
470 | EMSCA=SQRT(2.*S*T*U/(S*S+T*T+U*U)) | |
471 | ||
472 | FACT=GEV2NB*PIFAC*0.5*ET*EJ*(YJ1SUP-YJ1INF)*(YJ2SUP-YJ2INF) | |
473 | ||
474 | & *(ALPHEM/S)**2 | |
475 | ||
476 | CALL HWSGEN(.FALSE.) | |
477 | ||
478 | CSTU=2.*(U/T+T/U)/CAFAC | |
479 | ||
480 | IF (DISF(13,1).GT.EPS.AND.DISF(13,2).GT.EPS) THEN | |
481 | ||
482 | TQSQ=0. | |
483 | ||
484 | DO 10 ID=1,6 | |
485 | ||
486 | 10 IF (RMASS(ID).LT.RS) TQSQ=TQSQ+QFCH(ID)**2 | |
487 | ||
488 | DSTU=DISF(13,1)*DISF(13,2)*FACT*HWHPPB(S,T,U) | |
489 | ||
490 | & /64.*(HWUALF(1,EMSCA)*TQSQ/PIFAC)**2 | |
491 | ||
492 | ENDIF | |
493 | ||
494 | ENDIF | |
495 | ||
496 | HCS=0. | |
497 | ||
498 | DO 30 ID=1,6 | |
499 | ||
500 | FACTR=FACT*CSTU*QFCH(ID)**4 | |
501 | ||
502 | C q+qbar ---> gamma+gamma | |
503 | ||
504 | ID1=ID | |
505 | ||
506 | ID2=ID+6 | |
507 | ||
508 | IF (DISF(ID1,1).LT.EPS.OR.DISF(ID2,2).LT.EPS) GOTO 20 | |
509 | ||
510 | HCS=HCS+FACTR*DISF(ID1,1)*DISF(ID2,2) | |
511 | ||
512 | IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(59,59,2134,61,*99) | |
513 | ||
514 | C qbar+q ---> gamma+gamma | |
515 | ||
516 | 20 ID1=ID+6 | |
517 | ||
518 | ID2=ID | |
519 | ||
520 | IF (DISF(ID1,1).LT.EPS.OR.DISF(ID2,2).LT.EPS) GOTO 30 | |
521 | ||
522 | HCS=HCS+FACTR*DISF(ID1,1)*DISF(ID2,2) | |
523 | ||
524 | IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(59,59,2134,62,*99) | |
525 | ||
526 | 30 CONTINUE | |
527 | ||
528 | C g+g ---> gamma+gamma | |
529 | ||
530 | ID1=13 | |
531 | ||
532 | ID2=13 | |
533 | ||
534 | HCS=HCS+DSTU | |
535 | ||
536 | IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(59,59,2134,63,*99) | |
537 | ||
538 | EVWGT=HCS | |
539 | ||
540 | RETURN | |
541 | ||
542 | C Generate event | |
543 | ||
544 | 99 IDN(1)=ID1 | |
545 | ||
546 | IDN(2)=ID2 | |
547 | ||
548 | IDCMF=15 | |
549 | ||
550 | CALL HWETWO | |
551 | ||
552 | 999 END | |
553 | ||
554 | CDECK ID>, HWHPHO. | |
555 | ||
556 | *CMZ :- -26/04/91 14.55.45 by Federico Carminati | |
557 | ||
558 | *-- Author : Bryan Webber | |
559 | ||
560 | C----------------------------------------------------------------------- | |
561 | ||
562 | SUBROUTINE HWHPHO | |
563 | ||
564 | C----------------------------------------------------------------------- | |
565 | ||
566 | C QCD DIRECT PHOTON + JET PRODUCTION: MEAN EVWGT = SIGMA IN NB | |
567 | ||
568 | C----------------------------------------------------------------------- | |
569 | ||
570 | INCLUDE 'HERWIG61.INC' | |
571 | ||
572 | DOUBLE PRECISION HWR,HWRUNI,HWUALF,HWHPPB,EPS,RCS,ET,EJ,KK,KK2, | |
573 | ||
574 | & YJ1INF,YJ1SUP,Z1,YJ2INF,YJ2SUP,Z2,FACT,FACTR,FACTF,RS,S,T,U,CF, | |
575 | ||
576 | & AF,CSTU,CTSU,CUST,DSTU,HCS,TQCH | |
577 | ||
578 | INTEGER ID,ID1,ID2 | |
579 | ||
580 | EXTERNAL HWR,HWRUNI,HWUALF,HWHPPB | |
581 | ||
582 | SAVE HCS | |
583 | ||
584 | PARAMETER (EPS=1.D-9) | |
585 | ||
586 | IF (GENEV) THEN | |
587 | ||
588 | RCS=HCS*HWR() | |
589 | ||
590 | ELSE | |
591 | ||
592 | EVWGT=0. | |
593 | ||
594 | CALL HWRPOW(ET,EJ) | |
595 | ||
596 | KK=ET/PHEP(5,3) | |
597 | ||
598 | KK2=KK**2 | |
599 | ||
600 | IF (KK.GE.ONE) RETURN | |
601 | ||
602 | YJ1INF=MAX( YJMIN , LOG((1.-SQRT(1.-KK2))/KK) ) | |
603 | ||
604 | YJ1SUP=MIN( YJMAX , LOG((1.+SQRT(1.-KK2))/KK) ) | |
605 | ||
606 | IF (YJ1INF.GE.YJ1SUP) RETURN | |
607 | ||
608 | Z1=EXP(HWRUNI(1,YJ1INF,YJ1SUP)) | |
609 | ||
610 | YJ2INF=MAX( YJMIN , -LOG(2./KK-1./Z1) ) | |
611 | ||
612 | YJ2SUP=MIN( YJMAX , LOG(2./KK-Z1) ) | |
613 | ||
614 | IF (YJ2INF.GE.YJ2SUP) RETURN | |
615 | ||
616 | Z2=EXP(HWRUNI(2,YJ2INF,YJ2SUP)) | |
617 | ||
618 | XX(1)=0.5*(Z1+Z2)*KK | |
619 | ||
620 | IF (XX(1).GE.ONE) RETURN | |
621 | ||
622 | XX(2)=XX(1)/(Z1*Z2) | |
623 | ||
624 | IF (XX(2).GE.ONE) RETURN | |
625 | ||
626 | COSTH=(Z1-Z2)/(Z1+Z2) | |
627 | ||
628 | S=XX(1)*XX(2)*PHEP(5,3)**2 | |
629 | ||
630 | RS=0.5*SQRT(S) | |
631 | ||
632 | T=-0.5*S*(1.-COSTH) | |
633 | ||
634 | U=-S-T | |
635 | ||
636 | C---SET EMSCA TO HARD PROCESS SCALE (APPROX ET-JET) | |
637 | ||
638 | EMSCA=SQRT(2.*S*T*U/(S*S+T*T+U*U)) | |
639 | ||
640 | FACT=GEV2NB*PIFAC*0.5*ET*EJ*ALPHEM | |
641 | ||
642 | & *HWUALF(1,EMSCA)*(YJ1SUP-YJ1INF)*(YJ2SUP-YJ2INF)/S**2 | |
643 | ||
644 | CALL HWSGEN(.FALSE.) | |
645 | ||
646 | C | |
647 | ||
648 | CF=2.*CFFAC/CAFAC | |
649 | ||
650 | AF=-1./CAFAC | |
651 | ||
652 | CSTU=CF*(U/T+T/U) | |
653 | ||
654 | CTSU=AF*(U/S+S/U) | |
655 | ||
656 | CUST=AF*(T/S+S/T) | |
657 | ||
658 | IF (DISF(13,1).GT.EPS.AND.DISF(13,2).GT.EPS) THEN | |
659 | ||
660 | TQCH=0. | |
661 | ||
662 | DO 10 ID=1,6 | |
663 | ||
664 | 10 IF (RMASS(ID).LT.RS) TQCH=TQCH+QFCH(ID) | |
665 | ||
666 | DSTU=DISF(13,1)*DISF(13,2)*FACT*HWHPPB(S,T,U) | |
667 | ||
668 | & *5./768.*(HWUALF(1,EMSCA)*TQCH/PIFAC)**2 | |
669 | ||
670 | ENDIF | |
671 | ||
672 | ENDIF | |
673 | ||
674 | C | |
675 | ||
676 | HCS=0. | |
677 | ||
678 | DO 30 ID=1,6 | |
679 | ||
680 | FACTR=FACT*QFCH(ID)**2 | |
681 | ||
682 | C---QUARK FIRST | |
683 | ||
684 | ID1=ID | |
685 | ||
686 | IF (DISF(ID1,1).LT.EPS) GOTO 20 | |
687 | ||
688 | ID2=ID1+6 | |
689 | ||
690 | HCS=HCS+CSTU*FACTR*DISF(ID1,1)*DISF(ID2,2) | |
691 | ||
692 | IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP( 13, 59,2314,41,*9) | |
693 | ||
694 | ID2=13 | |
695 | ||
696 | HCS=HCS+CTSU*FACTR*DISF(ID1,1)*DISF(ID2,2) | |
697 | ||
698 | IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1, 59,3124,42,*9) | |
699 | ||
700 | C---QBAR FIRST | |
701 | ||
702 | 20 ID1=ID+6 | |
703 | ||
704 | IF (DISF(ID1,1).LT.EPS) GOTO 30 | |
705 | ||
706 | ID2=ID | |
707 | ||
708 | HCS=HCS+CSTU*FACTR*DISF(ID1,1)*DISF(ID2,2) | |
709 | ||
710 | IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP( 13, 59,3124,43,*9) | |
711 | ||
712 | ID2=13 | |
713 | ||
714 | HCS=HCS+CTSU*FACTR*DISF(ID1,1)*DISF(ID2,2) | |
715 | ||
716 | IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1, 59,2314,44,*9) | |
717 | ||
718 | 30 CONTINUE | |
719 | ||
720 | C---GLUON FIRST | |
721 | ||
722 | ID1=13 | |
723 | ||
724 | FACTF=FACT*CUST*DISF(ID1,1) | |
725 | ||
726 | DO 50 ID=1,6 | |
727 | ||
728 | FACTR=FACTF*QFCH(ID)**2 | |
729 | ||
730 | ID2=ID | |
731 | ||
732 | IF (DISF(ID2,2).LT.EPS) GOTO 40 | |
733 | ||
734 | HCS=HCS+FACTR*DISF(ID2,2) | |
735 | ||
736 | IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID2, 59,2314,45,*9) | |
737 | ||
738 | 40 ID2=ID+6 | |
739 | ||
740 | IF (DISF(ID2,2).LT.EPS) GOTO 50 | |
741 | ||
742 | HCS=HCS+FACTR*DISF(ID2,2) | |
743 | ||
744 | IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID2, 59,3124,46,*9) | |
745 | ||
746 | 50 CONTINUE | |
747 | ||
748 | C g+g ---> g+gamma | |
749 | ||
750 | ID2=13 | |
751 | ||
752 | HCS=HCS+DSTU | |
753 | ||
754 | IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP( 13, 59,2314,47,*9) | |
755 | ||
756 | EVWGT=HCS | |
757 | ||
758 | RETURN | |
759 | ||
760 | C---GENERATE EVENT | |
761 | ||
762 | 9 IDN(1)=ID1 | |
763 | ||
764 | IDN(2)=ID2 | |
765 | ||
766 | IDCMF=15 | |
767 | ||
768 | CALL HWETWO | |
769 | ||
770 | 999 END | |
771 | ||
772 | CDECK ID>, HWHPPB. | |
773 | ||
774 | *CMZ :- -12/01/93 10.12.43 by Bryan Webber | |
775 | ||
776 | *-- Author : Ian Knowles | |
777 | ||
778 | C----------------------------------------------------------------------- | |
779 | ||
780 | FUNCTION HWHPPB(S,T,U) | |
781 | ||
782 | C----------------------------------------------------------------------- | |
783 | ||
784 | C Quark box diagram contribution to photon/gluon scattering | |
785 | ||
786 | C Internal quark mass neglected: m_q << U,T,S | |
787 | ||
788 | C----------------------------------------------------------------------- | |
789 | ||
790 | IMPLICIT NONE | |
791 | ||
792 | DOUBLE PRECISION HWHPPB,S,T,U,S2,T2,U2,PI2,ALNTU,ALNST,ALNSU | |
793 | ||
794 | PI2=ACOS(-1.D0)**2 | |
795 | ||
796 | S2=S**2 | |
797 | ||
798 | T2=T**2 | |
799 | ||
800 | U2=U**2 | |
801 | ||
802 | ALNTU=LOG(T/U) | |
803 | ||
804 | ALNST=LOG(-S/T) | |
805 | ||
806 | ALNSU=ALNST+ALNTU | |
807 | ||
808 | HWHPPB=5.*4. | |
809 | ||
810 | & +((2.*S2+2.*(U2-T2)*ALNTU+(T2+U2)*(ALNTU**2+PI2))/S2)**2 | |
811 | ||
812 | & +((2.*U2+2.*(T2-S2)*ALNST+(T2+S2)* ALNST**2 )/U2)**2 | |
813 | ||
814 | & +((2.*T2+2.*(U2-S2)*ALNSU+(U2+S2)* ALNSU**2 )/T2)**2 | |
815 | ||
816 | & +4.*PI2*(((T2-S2+(T2+S2)*ALNST)/U2)**2 | |
817 | ||
818 | & +((U2-S2+(U2+S2)*ALNSU)/T2)**2) | |
819 | ||
820 | END |