]>
Commit | Line | Data |
---|---|---|
3820ca8e | 1 | |
2 | CDECK ID>, HWHIGJ. | |
3 | ||
4 | *CMZ :- -23/08/94 13.22.29 by Mike Seymour | |
5 | ||
6 | *-- Author : Ian Knowles | |
7 | ||
8 | C----------------------------------------------------------------------- | |
9 | ||
10 | SUBROUTINE HWHIGJ | |
11 | ||
12 | C----------------------------------------------------------------------- | |
13 | ||
14 | C QCD Higgs plus jet production; mean EVWGT = Sigma in nb*Higgs B.R. | |
15 | ||
16 | C Adapted from the program of U. Baur and E.W.N. Glover | |
17 | ||
18 | C See: Nucl. Phys. B339 (1990) 38 | |
19 | ||
20 | C----------------------------------------------------------------------- | |
21 | ||
22 | INCLUDE 'HERWIG61.INC' | |
23 | ||
24 | DOUBLE PRECISION HWR,HWRUNI,HWUALF,HWUAEM,EPS,RCS,EMH,EMHWT, | |
25 | ||
26 | & EMHTMP,BR,CV,CA,EMH2,ET,EJ,PT,EMT,EMAX,YMAX,YHINF,YHSUP,EXYH, | |
27 | ||
28 | & YMIN,YJINF,YJSUP,EXYJ,S,T,U,FACT,AMPQQ,AMPQG,AMPGQ,AMPGG,HCS, | |
29 | ||
30 | & FACTR | |
31 | ||
32 | INTEGER I,IDEC,ID1,ID2 | |
33 | ||
34 | EXTERNAL HWR,HWRUNI,HWUALF,HWUAEM | |
35 | ||
36 | SAVE HCS,AMPGG,AMPGQ,AMPQG,AMPQQ,EMH,FACT | |
37 | ||
38 | PARAMETER (EPS=1.D-9) | |
39 | ||
40 | IF (GENEV) THEN | |
41 | ||
42 | RCS=HCS*HWR() | |
43 | ||
44 | ELSE | |
45 | ||
46 | EVWGT=0. | |
47 | ||
48 | C Select a Higgs mass | |
49 | ||
50 | CALL HWHIGM(EMH,EMHWT) | |
51 | ||
52 | IF (EMH.LE.ZERO .OR. EMH.GE.PHEP(5,3)) RETURN | |
53 | ||
54 | C Store branching ratio for specified Higgs deacy channel | |
55 | ||
56 | IDEC=MOD(IPROC,100) | |
57 | ||
58 | BR=1. | |
59 | ||
60 | IF (IDEC.EQ.0) THEN | |
61 | ||
62 | BR=0. | |
63 | ||
64 | DO 10 I=1,6 | |
65 | ||
66 | 10 BR=BR+BRHIG(I) | |
67 | ||
68 | ELSEIF (IDEC.EQ.10) THEN | |
69 | ||
70 | CALL HWDBOZ(198,ID1,ID2,CV,CA,BR,1) | |
71 | ||
72 | CALL HWDBOZ(199,ID1,ID2,CV,CA,BR,1) | |
73 | ||
74 | BR=BR*BRHIG(IDEC) | |
75 | ||
76 | ELSEIF (IDEC.EQ.11) THEN | |
77 | ||
78 | CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,1) | |
79 | ||
80 | CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,1) | |
81 | ||
82 | BR=BR*BRHIG(IDEC) | |
83 | ||
84 | ELSEIF (IDEC.LE.12) THEN | |
85 | ||
86 | BR=BRHIG(IDEC) | |
87 | ||
88 | ENDIF | |
89 | ||
90 | C Select subprocess kinematics | |
91 | ||
92 | EMH2=EMH**2 | |
93 | ||
94 | CALL HWRPOW(ET,EJ) | |
95 | ||
96 | PT=.5*ET | |
97 | ||
98 | EMT=SQRT(PT**2+EMH2) | |
99 | ||
100 | EMAX=0.5*(PHEP(5,3)+EMH2/PHEP(5,3)) | |
101 | ||
102 | IF (EMAX.LE.EMT) RETURN | |
103 | ||
104 | YMAX=LOG((EMAX+SQRT(EMAX**2-EMT**2))/EMT) | |
105 | ||
106 | YHINF=MAX(YJMIN,-YMAX) | |
107 | ||
108 | YHSUP=MIN(YJMAX, YMAX) | |
109 | ||
110 | IF (YHSUP.LE.YHINF) RETURN | |
111 | ||
112 | EXYH=EXP(HWRUNI(1,YHINF,YHSUP)) | |
113 | ||
114 | YMIN=LOG(PT/(PHEP(5,3)-EMT/EXYH)) | |
115 | ||
116 | YMAX=LOG((PHEP(5,3)-EMT*EXYH)/PT) | |
117 | ||
118 | YJINF=MAX(YJMIN,YMIN) | |
119 | ||
120 | YJSUP=MIN(YJMAX,YMAX) | |
121 | ||
122 | IF (YJSUP.LE.YJINF) RETURN | |
123 | ||
124 | EXYJ=EXP(HWRUNI(2,YJINF,YJSUP)) | |
125 | ||
126 | XX(1)=(EMT*EXYH+PT*EXYJ)/PHEP(5,3) | |
127 | ||
128 | XX(2)=(EMT/EXYH+PT/EXYJ)/PHEP(5,3) | |
129 | ||
130 | S=XX(1)*XX(2)*PHEP(5,3)**2 | |
131 | ||
132 | T=EMH2-XX(1)*EMT*PHEP(5,3)/EXYH | |
133 | ||
134 | U=EMH2-S-T | |
135 | ||
136 | COSTH=(S+2.*T-EMH2)/(S-EMH2) | |
137 | ||
138 | C Set subprocess scale | |
139 | ||
140 | EMSCA=EMT | |
141 | ||
142 | CALL HWSGEN(.FALSE.) | |
143 | ||
144 | FACT=GEV2NB*PT*EJ*(YHSUP-YHINF)*(YJSUP-YJINF)*BR*EMHWT | |
145 | ||
146 | & *HWUALF(1,EMSCA)**3*HWUAEM(EMH2)/(SWEIN*16*PIFAC*S**2) | |
147 | ||
148 | CALL HWHIGA(S,T,U,EMH2,AMPQQ,AMPQG,AMPGQ,AMPGG) | |
149 | ||
150 | ENDIF | |
151 | ||
152 | HCS=0. | |
153 | ||
154 | DO 30 ID1=1,13 | |
155 | ||
156 | IF (DISF(ID1,1).LT.EPS) GOTO 30 | |
157 | ||
158 | FACTR=FACT*DISF(ID1,1) | |
159 | ||
160 | IF (ID1.LT.7) THEN | |
161 | ||
162 | C Quark first: | |
163 | ||
164 | ID2=ID1+6 | |
165 | ||
166 | HCS=HCS+FACTR*DISF(ID2,2)*AMPQQ | |
167 | ||
168 | IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(13 ,201,2314,81,*99) | |
169 | ||
170 | ID2=13 | |
171 | ||
172 | HCS=HCS+FACTR*DISF(ID2,2)*AMPQG | |
173 | ||
174 | IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,201,3124,82,*99) | |
175 | ||
176 | ELSEIF (ID1.LT.13) THEN | |
177 | ||
178 | C Antiquark first: | |
179 | ||
180 | ID2=ID1-6 | |
181 | ||
182 | HCS=HCS+FACTR*DISF(ID2,2)*AMPQQ | |
183 | ||
184 | IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(13 ,201,3124,83,*99) | |
185 | ||
186 | ID2=13 | |
187 | ||
188 | HCS=HCS+FACTR*DISF(ID2,2)*AMPQG | |
189 | ||
190 | IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID1,201,2314,84,*99) | |
191 | ||
192 | ELSE | |
193 | ||
194 | C Gluon first: | |
195 | ||
196 | DO 20 ID2=1,12 | |
197 | ||
198 | IF (DISF(ID2,2).LT.EPS) GOTO 20 | |
199 | ||
200 | IF (ID2.LT.7) THEN | |
201 | ||
202 | HCS=HCS+FACTR*DISF(ID2,2)*AMPGQ | |
203 | ||
204 | IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID2,201,2314,85,*99) | |
205 | ||
206 | ELSE | |
207 | ||
208 | HCS=HCS+FACTR*DISF(ID2,2)*AMPGQ | |
209 | ||
210 | IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(ID2,201,3124,86,*99) | |
211 | ||
212 | ENDIF | |
213 | ||
214 | 20 CONTINUE | |
215 | ||
216 | HCS=HCS+FACTR*DISF(13,2)*AMPGG | |
217 | ||
218 | IF (GENEV.AND.HCS.GT.RCS) CALL HWHQCP(13 ,201,2314,87,*99) | |
219 | ||
220 | ENDIF | |
221 | ||
222 | 30 CONTINUE | |
223 | ||
224 | EVWGT=HCS | |
225 | ||
226 | RETURN | |
227 | ||
228 | C Generate event | |
229 | ||
230 | 99 IDN(1)=ID1 | |
231 | ||
232 | IDN(2)=ID2 | |
233 | ||
234 | IDCMF=15 | |
235 | ||
236 | C Trick HWETWO into using off-shell Higgs mass | |
237 | ||
238 | EMHTMP=RMASS(IDN(4)) | |
239 | ||
240 | RMASS(IDN(4))=EMH | |
241 | ||
242 | CALL HWETWO | |
243 | ||
244 | RMASS(IDN(4))=EMHTMP | |
245 | ||
246 | 999 END | |
247 | ||
248 | CDECK ID>, HWHIGM. | |
249 | ||
250 | *CMZ :- -02/05/91 11.17.14 by Federico Carminati | |
251 | ||
252 | *-- Author : Mike Seymour | |
253 | ||
254 | C----------------------------------------------------------------------- | |
255 | ||
256 | SUBROUTINE HWHIGM(EM,WEIGHT) | |
257 | ||
258 | C----------------------------------------------------------------------- | |
259 | ||
260 | C CHOOSE HIGGS MASS: | |
261 | ||
262 | C IF (IOPHIG.EQ.0.OR.IOPHIG.EQ.2) THEN | |
263 | ||
264 | C CHOOSE HIGGS MASS ACCORDING TO | |
265 | ||
266 | C EM**4 / (EM**2-EMH**2)**2 + (GAMH*EMH)**2 | |
267 | ||
268 | C ELSE | |
269 | ||
270 | C CHOOSE HIGGS MASS ACCORDING TO | |
271 | ||
272 | C EMH * GAMH / (EM**2-EMH**2)**2 + (GAMH*EMH)**2 | |
273 | ||
274 | C ENDIF | |
275 | ||
276 | C IF (IOPHIG.EQ.0.OR.IOPHIG.EQ.1) THEN | |
277 | ||
278 | C SUPPLY WEIGHT FACTOR TO YIELD | |
279 | ||
280 | C EM * GAM(EM)/ (EM**2-EMH**2)**2 + (GAM(EM)*EM)**2 | |
281 | ||
282 | C ELSE | |
283 | ||
284 | C SUPPLY WEIGHT FACTOR TO YIELD | |
285 | ||
286 | C EM*(EMH/EM)**4 * GAM(EM) | |
287 | ||
288 | C / (EM**2-EMH**2)**2 + (GAM(EM)*EMH**2/EM)**2 | |
289 | ||
290 | C AS SUGGESTED IN M.H.SEYMOUR, PHYS.LETT.B354(1995)409. | |
291 | ||
292 | C ENDIF | |
293 | ||
294 | C----------------------------------------------------------------------- | |
295 | ||
296 | INCLUDE 'HERWIG61.INC' | |
297 | ||
298 | DOUBLE PRECISION HWRUNI,EM,WEIGHT,EMH,DIF,FUN,THETA,T,EMHLST,W0, | |
299 | ||
300 | & W1,EMM,GAMEM,T0,TMIN,TMAX,THEMIN,THEMAX,ZMIN,ZMAX,Z,F,GAMOFS | |
301 | ||
302 | INTEGER I | |
303 | ||
304 | EXTERNAL HWRUNI | |
305 | ||
306 | SAVE EMHLST,GAMEM,T0,TMIN,TMAX,THEMIN,THEMAX,ZMIN,ZMAX,W0,W1 | |
307 | ||
308 | EQUIVALENCE (EMH,RMASS(201)) | |
309 | ||
310 | DATA EMHLST/0D0/ | |
311 | ||
312 | C---SET UP INTEGRAND AND INDEFINITE INTEGRAL OF DISTRIBUTION | |
313 | ||
314 | C THETA=ATAN((EM**2-EMH**2)/(GAMH*EMH)); T=TAN(THETA); T0=EMH/GAMH | |
315 | ||
316 | DIF(T,T0)=(T+T0)**2 | |
317 | ||
318 | FUN(THETA,T,T0)=T + (T0*T0-1)*THETA + T0*LOG(1+T*T) | |
319 | ||
320 | C---SET UP CONSTANTS | |
321 | ||
322 | IF (EMH.NE.EMHLST .OR. FSTWGT) THEN | |
323 | ||
324 | EMHLST=EMH | |
325 | ||
326 | GAMEM=GAMH*EMH | |
327 | ||
328 | T0=EMH/GAMH | |
329 | ||
330 | TMIN=(MAX(ONE*1E-10,EMH-GAMMAX*GAMH))**2/GAMEM-T0 | |
331 | ||
332 | TMAX=( EMH+GAMMAX*GAMH )**2/GAMEM-T0 | |
333 | ||
334 | THEMIN=ATAN(TMIN) | |
335 | ||
336 | THEMAX=ATAN(TMAX) | |
337 | ||
338 | ZMIN=FUN(THEMIN,TMIN,T0) | |
339 | ||
340 | ZMAX=FUN(THEMAX,TMAX,T0) | |
341 | ||
342 | W0=(ZMAX-ZMIN) / PIFAC * GAMEM | |
343 | ||
344 | W1=(THEMAX-THEMIN) / PIFAC | |
345 | ||
346 | ENDIF | |
347 | ||
348 | C---CHOOSE HIGGS MASS | |
349 | ||
350 | IF (IOPHIG.EQ.0.OR.IOPHIG.EQ.2) THEN | |
351 | ||
352 | 1 EM=0 | |
353 | ||
354 | WEIGHT=0 | |
355 | ||
356 | Z=HWRUNI(1,ZMIN,ZMAX) | |
357 | ||
358 | C---SOLVE FUN(THETA,TAN(THETA))=Z BY NEWTON'S METHOD | |
359 | ||
360 | THETA=MAX(THEMIN, MIN(THEMAX, Z/T0**2 )) | |
361 | ||
362 | I=1 | |
363 | ||
364 | F=0 | |
365 | ||
366 | 10 IF (I.LE.20 .AND. ABS(1-F/Z).GT.1E-4) THEN | |
367 | ||
368 | I=I+1 | |
369 | ||
370 | IF (2*ABS(THETA).GT.PIFAC) CALL HWWARN('HWHIGM',51,*999) | |
371 | ||
372 | T=TAN(THETA) | |
373 | ||
374 | F=FUN(THETA,T,T0) | |
375 | ||
376 | THETA=THETA-(F-Z)/DIF(T,T0) | |
377 | ||
378 | GOTO 10 | |
379 | ||
380 | ENDIF | |
381 | ||
382 | IF (I.GT.20) CALL HWWARN('HWHIGM',1,*999) | |
383 | ||
384 | ELSE | |
385 | ||
386 | THETA=HWRUNI(0,THEMIN,THEMAX) | |
387 | ||
388 | ENDIF | |
389 | ||
390 | EM=SQRT(GAMEM*(T0+TAN(THETA))) | |
391 | ||
392 | C---NOW CALCULATE WEIGHT FACTOR FOR NON-CONSTANT HIGGS WIDTH | |
393 | ||
394 | GAMOFS=EM | |
395 | ||
396 | CALL HWDHIG(GAMOFS) | |
397 | ||
398 | IF (IOPHIG.EQ.0) THEN | |
399 | ||
400 | WEIGHT=W0*GAMOFS*EM /EM**4 *((EM**2-EMH**2)**2 + GAMEM**2) | |
401 | ||
402 | & /((EM**2-EMH**2)**2 +(GAMOFS*EM)**2) | |
403 | ||
404 | ELSEIF (IOPHIG.EQ.1) THEN | |
405 | ||
406 | WEIGHT=W1*GAMOFS*EM /GAMEM *((EM**2-EMH**2)**2 + GAMEM**2) | |
407 | ||
408 | & /((EM**2-EMH**2)**2 +(GAMOFS*EM)**2) | |
409 | ||
410 | ELSEIF (IOPHIG.EQ.2) THEN | |
411 | ||
412 | EMM=EM*(EMH/EM)**4 | |
413 | ||
414 | WEIGHT=W0*GAMOFS*EMM/EM**4 *((EM**2-EMH**2)**2 + GAMEM**2) | |
415 | ||
416 | & /((EM**2-EMH**2)**2 +(GAMOFS*EMM)**2) | |
417 | ||
418 | ELSEIF (IOPHIG.EQ.3) THEN | |
419 | ||
420 | EMM=EM*(EMH/EM)**4 | |
421 | ||
422 | WEIGHT=W1*GAMOFS*EMM/GAMEM *((EM**2-EMH**2)**2 + GAMEM**2) | |
423 | ||
424 | & /((EM**2-EMH**2)**2 +(GAMOFS*EMM)**2) | |
425 | ||
426 | ELSE | |
427 | ||
428 | CALL HWWARN('HWHIGM',500,*999) | |
429 | ||
430 | ENDIF | |
431 | ||
432 | 999 END | |
433 | ||
434 | CDECK ID>, HWHIGS. | |
435 | ||
436 | *CMZ :- -26/04/91 11.11.55 by Bryan Webber | |
437 | ||
438 | *-- Author : Mike Seymour | |
439 | ||
440 | C----------------------------------------------------------------------- | |
441 | ||
442 | SUBROUTINE HWHIGS | |
443 | ||
444 | C----------------------------------------------------------------------- | |
445 | ||
446 | C HIGGS PRODUCTION VIA GLUON OR QUARK FUSION | |
447 | ||
448 | C MEAN EVWGT = HIGGS PRODN C-S * BRANCHING FRACTION IN NB | |
449 | ||
450 | C----------------------------------------------------------------------- | |
451 | ||
452 | INCLUDE 'HERWIG61.INC' | |
453 | ||
454 | DOUBLE PRECISION HWUALF,HWHIGT,HWR,HWUSQR,HWUAEM,BRHIGQ,EMH, | |
455 | ||
456 | & CSFAC(13),EVSUM(13),EMFAC,CV,CA,BR,RWGT,E1,E2,EMQ,GFACTR | |
457 | ||
458 | INTEGER IDEC,I,J,ID1,ID2 | |
459 | ||
460 | EXTERNAL HWUALF,HWHIGT,HWR,HWUSQR,HWUAEM | |
461 | ||
462 | SAVE CSFAC,BR,EVSUM | |
463 | ||
464 | IF (GENEV) THEN | |
465 | ||
466 | RWGT=HWR()*EVSUM(13) | |
467 | ||
468 | IDN(1)=1 | |
469 | ||
470 | DO 10 I=1,12 | |
471 | ||
472 | 10 IF (RWGT.GT.EVSUM(I)) IDN(1)=I+1 | |
473 | ||
474 | IDN(2)=13 | |
475 | ||
476 | IF (IDN(1).LE.12) IDN(2)=IDN(1)-6 | |
477 | ||
478 | IF (IDN(1).LE. 6) IDN(2)=IDN(1)+6 | |
479 | ||
480 | IDCMF=201 | |
481 | ||
482 | CALL HWEONE | |
483 | ||
484 | ELSE | |
485 | ||
486 | EVWGT=0. | |
487 | ||
488 | CALL HWHIGM(EMH,EMFAC) | |
489 | ||
490 | IF (EMH.LE.ZERO .OR. EMH.GE.PHEP(5,3)) RETURN | |
491 | ||
492 | EMSCA=EMH | |
493 | ||
494 | IF (EMSCA.NE.EMLST) THEN | |
495 | ||
496 | EMLST=EMH | |
497 | ||
498 | XXMIN=(EMH/PHEP(5,3))**2 | |
499 | ||
500 | XLMIN=LOG(XXMIN) | |
501 | ||
502 | GFACTR=GEV2NB*HWUAEM(EMH**2)/(288.*SWEIN*RMASS(198)**2) | |
503 | ||
504 | DO 20 I=1,13 | |
505 | ||
506 | EMQ=RMASS(I) | |
507 | ||
508 | IF (I.EQ.13) THEN | |
509 | ||
510 | CSFAC(I)=-GFACTR*HWHIGT(RMASS(NFLAV)/EMH)*XLMIN | |
511 | ||
512 | & *HWUALF(1,EMH)**2 *EMFAC*ENHANC(NFLAV)**2 | |
513 | ||
514 | ELSEIF (I.GT.6) THEN | |
515 | ||
516 | CSFAC(I)=CSFAC(I-6) | |
517 | ||
518 | ELSEIF (EMH.GT.2*EMQ) THEN | |
519 | ||
520 | CSFAC(I)=-GFACTR*96.*PIFAC**2 *(1-(2*EMQ/EMH)**2) | |
521 | ||
522 | & *(EMQ/EMH)**2 *XLMIN *EMFAC*ENHANC(I)**2 | |
523 | ||
524 | ELSE | |
525 | ||
526 | CSFAC(I)=0 | |
527 | ||
528 | ENDIF | |
529 | ||
530 | 20 CONTINUE | |
531 | ||
532 | C INCLUDE BRANCHING RATIO OF HIGGS | |
533 | ||
534 | IDEC=MOD(IPROC,100) | |
535 | ||
536 | BR=1 | |
537 | ||
538 | IF (IDEC.EQ.0) THEN | |
539 | ||
540 | BRHIGQ=0 | |
541 | ||
542 | DO 30 I=1,6 | |
543 | ||
544 | 30 BRHIGQ=BRHIGQ+BRHIG(I) | |
545 | ||
546 | BR=BRHIGQ | |
547 | ||
548 | ELSEIF (IDEC.EQ.10) THEN | |
549 | ||
550 | CALL HWDBOZ(198,ID1,ID2,CV,CA,BR,1) | |
551 | ||
552 | CALL HWDBOZ(199,ID1,ID2,CV,CA,BR,1) | |
553 | ||
554 | BR=BR*BRHIG(IDEC) | |
555 | ||
556 | ELSEIF (IDEC.EQ.11) THEN | |
557 | ||
558 | CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,1) | |
559 | ||
560 | CALL HWDBOZ(200,ID1,ID2,CV,CA,BR,1) | |
561 | ||
562 | BR=BR*BRHIG(IDEC) | |
563 | ||
564 | ELSEIF (IDEC.LE.12) THEN | |
565 | ||
566 | BR=BRHIG(IDEC) | |
567 | ||
568 | ENDIF | |
569 | ||
570 | ENDIF | |
571 | ||
572 | CALL HWSGEN(.TRUE.) | |
573 | ||
574 | EVWGT=0 | |
575 | ||
576 | E1=PHEP(4,MAX(1,JDAHEP(1,1))) | |
577 | ||
578 | E2=PHEP(4,MAX(2,JDAHEP(1,2))) | |
579 | ||
580 | DO 40 I=1,13 | |
581 | ||
582 | EMQ=RMASS(I) | |
583 | ||
584 | IF (EMH.GT.2*EMQ) THEN | |
585 | ||
586 | J=13 | |
587 | ||
588 | IF (I.LE.12) J=I-6 | |
589 | ||
590 | IF (I.LE. 6) J=I+6 | |
591 | ||
592 | IF (XX(1).LT.HALF*(ONE-EMQ/E1+HWUSQR(ONE-TWO*EMQ/E1)) .AND. | |
593 | ||
594 | & XX(2).LT.HALF*(ONE-EMQ/E2+HWUSQR(ONE-TWO*EMQ/E2))) | |
595 | ||
596 | & EVWGT=EVWGT+DISF(I,1)*DISF(J,2)*CSFAC(I)*BR | |
597 | ||
598 | ENDIF | |
599 | ||
600 | EVSUM(I)=EVWGT | |
601 | ||
602 | 40 CONTINUE | |
603 | ||
604 | ENDIF | |
605 | ||
606 | 999 END | |
607 | ||
608 | CDECK ID>, HWHIGT. | |
609 | ||
610 | *CMZ :- -26/04/91 11.11.55 by Bryan Webber | |
611 | ||
612 | *-- Author : Mike Seymour | |
613 | ||
614 | C----------------------------------------------------------------------- | |
615 | ||
616 | FUNCTION HWHIGT(RATIO) | |
617 | ||
618 | C----------------------------------------------------------------------- | |
619 | ||
620 | C CALCULATE MOD SQUARED I FOR RATIO = Mtop / Mhiggs | |
621 | ||
622 | C I DEFINED AS IN BARGER & PHILLIPS p433 | |
623 | ||
624 | C WARNING: THIS IS A FACTOR OF 3 GREATER THAN EHLQ'S ETA FUNCTION | |
625 | ||
626 | C----------------------------------------------------------------------- | |
627 | ||
628 | INCLUDE 'HERWIG61.INC' | |
629 | ||
630 | DOUBLE PRECISION HWHIGT,RATIO,RAT2,FREAL,FIMAG,ETALOG,AIREAL, | |
631 | ||
632 | & AIIMAG | |
633 | ||
634 | RAT2=RATIO**2 | |
635 | ||
636 | IF (FOUR*RAT2.GT.ONE) THEN | |
637 | ||
638 | FREAL=-TWO*ASIN(HALF/RATIO)**2 | |
639 | ||
640 | FIMAG=ZERO | |
641 | ||
642 | ELSEIF (FOUR*RAT2.LT.ONE) THEN | |
643 | ||
644 | ETALOG=LOG((HALF+SQRT(0.25-RAT2)) / (HALF-SQRT(0.25-RAT2)) ) | |
645 | ||
646 | FREAL=HALF * (ETALOG**2 - PIFAC**2) | |
647 | ||
648 | FIMAG=PIFAC * ETALOG | |
649 | ||
650 | ELSE | |
651 | ||
652 | FREAL=HALF * ( - PIFAC**2) | |
653 | ||
654 | FIMAG=ZERO | |
655 | ||
656 | ENDIF | |
657 | ||
658 | AIREAL=THREE*( TWO*RAT2 + RAT2*(FOUR*RAT2-ONE)*FREAL ) | |
659 | ||
660 | AIIMAG=THREE*( RAT2*(FOUR*RAT2-ONE)*FIMAG ) | |
661 | ||
662 | HWHIGT=AIREAL**2 + AIIMAG**2 | |
663 | ||
664 | END |