]> git.uio.no Git - u/mrichter/AliRoot.git/blame - HERWIG/hwlhin.f
git://git.uio.no / u / mrichter / AliRoot.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
change order of bookkeeping events
[u/mrichter/AliRoot.git] / HERWIG / hwlhin.f
CommitLineData
31d78ebd 1C Collects all of the Les Houches interface routines, plus utilities
2C for colour codes
3C
4C----------------------------------------------------------------------
5 SUBROUTINE UPEVNT_GUP
6C----------------------------------------------------------------------
7C Reads MC@NLO input files and fills Les Houches event common HEPEUP
8C----------------------------------------------------------------------
c63d70bc 9 INCLUDE 'herwig65.inc'
31d78ebd 10C---Les Houches Event Common Block
11 INTEGER MAXNUP
12 PARAMETER (MAXNUP=500)
13 INTEGER NUP,IDPRUP,IDUP,ISTUP,MOTHUP,ICOLUP
14 DOUBLE PRECISION XWGTUP,SCALUP,AQEDUP,AQCDUP,PUP,VTIMUP,SPINUP,
15 & XMP2,XMA2,XMB2,BETA,VA,VB,SIGMA,DELTA,S2,XKA,XKB,PTF,E,PL
16 COMMON/HEPEUP/NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP,
17 & IDUP(MAXNUP),ISTUP(MAXNUP),MOTHUP(2,MAXNUP),
18 & ICOLUP(2,MAXNUP),PUP(5,MAXNUP),VTIMUP(MAXNUP),
19 & SPINUP(MAXNUP)
cf0c7e04 20 DOUBLE PRECISION PCM(5),PTR,XMTR,HWVDOT,HWULDO,PDB(5)
21 INTEGER I,J,IC,JPR,MQQ,NQQ,IUNIT,ISCALE,I1HPRO,IBOS,NP,IG,
22 & ILEP,ID,IA,IB,ICOL4(4,4),ICOL5(5,18),JJPROC,IVHVEC,IVHLEP,MUP
31d78ebd 23 PARAMETER (IUNIT=61)
cf0c7e04 24 LOGICAL BOPRO,NODEC,REMIT
31d78ebd 25 COMMON/NQQCOM/MQQ,NQQ
cf0c7e04 26 COMMON/VHLIN/IVHVEC,IVHLEP
31d78ebd 27C---Colour flows for heavy quark pair production
28 DATA ICOL4/
29 & 10,02,10,02,01,20,20,01,12,23,10,03,12,31,30,02/
30 DATA ICOL5/
31 & 10,02,13,30,02, 10,02,32,10,03,
32 & 10,21,30,20,03, 10,23,20,10,03,
33 & 01,20,23,30,01, 01,20,31,20,03,
34 & 01,23,03,20,01, 01,12,03,30,02,
35 & 12,20,30,10,03, 12,30,10,30,02,
36 & 12,03,02,10,03, 12,01,03,30,02,
37 & 12,23,14,40,03, 12,34,32,10,04,
38 & 12,23,43,10,04, 12,31,34,40,02,
39 & 12,34,14,30,02, 12,31,42,30,04/
40 IF (IERROR.NE.0) RETURN
cf0c7e04 41C---READ AN EVENT
31d78ebd 42 IF(NQQ.GE.MQQ)CALL HWWARN('UPEVNT',201,*999)
cf0c7e04 43 READ(IUNIT,901) I1HPRO,IC,NP
44 READ(IUNIT,902) (IDUP(I),I=1,NP)
45 READ(IUNIT,903) XWGTUP
46C---Les Houches expects mean weight to be the cross section in pb
47 XWGTUP= XWGTUP*MQQ
48 READ(IUNIT,904) ((PUP(J,I),J=1,4),I=1,NP)
31d78ebd 49 NQQ=NQQ+1
cf0c7e04 50C---Input format is now (px,py,pz,m)
51 DO I=1,NP
52 E=SQRT(HWVDOT(4,PUP(1,I),PUP(1,I)))
53 PUP(5,I)=PUP(4,I)
54 PUP(4,I)=E
55 ENDDO
56 CALL HWVSUM(4,PUP(1,1),PUP(1,2),PCM)
57 CALL HWUMAS(PCM)
58C---REMIT MEANS A REAL PARTON EMISSION OCCURRED
59 REMIT=PUP(4,3).NE.ZERO
60C---NODEC MEANS DECAYS NOT YET DONE
61 NODEC=NP.EQ.5
62 NUP=NP
31d78ebd 63C---CHECK PROCESS CODE
cf0c7e04 64 JJPROC=MOD(ABS(IPROC),10000)
65 JPR=JJPROC/100
31d78ebd 66 BOPRO=JPR.EQ.13.OR.JPR.EQ.14.OR.JPR.EQ.16.OR.JPR.EQ.36
67 IF (BOPRO) THEN
68C----------------------------------------------------------------------
69C SINGLE GAUGE OR HIGGS BOSON PRODUCTION
70C B = Z/gamma, W or H (SM or any MSSM neutral Higgs)
71C-----------------------------------------------------------------------
72C I1HPRO IDENTIFIES THE PARTONIC SUBPROCESS, WITH THE FOLLOWING CONVENTIONS:
73C I1HPRO PROCESS
74C 401 q qbar -> g B
75C 402 q g -> q B
76C 403 qbar q -> g B
77C 404 qbar g -> qbar B
78C 405 g q -> q B
79C 406 g qbar -> qbar B
80C 407 g g -> g B
81C-----------------------------------------------------------------------
cf0c7e04 82C---NODEC=.TRUE. FOR HIGGS AND UNDECAYED EW BOSON
83 NODEC=NP.EQ.4
31d78ebd 84 IHPRO=I1HPRO-400
85 ISCALE=0
86 IF(JPR.EQ.16)ISCALE=2
cf0c7e04 87 ELSEIF (JPR.EQ.17.OR.JPR.EQ.20) THEN
31d78ebd 88C----------------------------------------------------------------------
cf0c7e04 89C HEAVY Q and/or QBAR PRODUCTION
31d78ebd 90C IPROC=-1705,-1706 for Q=b,t
cf0c7e04 91C IPROC=-2000 for single top
31d78ebd 92C-----------------------------------------------------------------------
93C I1HPRO IDENTIFIES THE PARTONIC SUBPROCESS, WITH THE FOLLOWING CONVENTIONS:
94C I1HPRO PROCESS
95C 401 q qbar -> g Q Qbar
96C 402 q g -> q Q Qbar
97C 403 qbar q -> g Q Qbar
98C 404 qbar g -> qbar Q Qbar
99C 405 g q -> q Q Qbar
100C 406 g qbar -> qbar Q Qbar
101C 407 g g -> g Q Qbar
cf0c7e04 102C 408 q q -> g t q
103C 409 qbar qbar -> g tbar qbar
31d78ebd 104C-----------------------------------------------------------------------
105C IC SPECIFIES THE COLOUR CONNECTION (NOW IN INPUT FILE)
106C-----------------------------------------------------------------------
31d78ebd 107C---SET IHPRO AS FOR DIRECT PHOTON (IPROC=1800)
108 IHPRO=I1HPRO-360
109 ISCALE=0
110 IF(ABS(IPROC).EQ.1705.OR.ABS(IPROC).EQ.11705)ISCALE=5
111 ELSEIF (JPR.EQ.28) THEN
112C----------------------------------------------------------------------
113C GAUGE BOSON PAIR PRODUCTION
114C VV=WW,ZZ,ZW+,ZW- FOR IPROC=-2850,-2860,-2870,-2880
115C-----------------------------------------------------------------------
116C I1HPRO IDENTIFIES THE PARTONIC SUBPROCESS, WITH THE FOLLOWING CONVENTIONS:
117C I1HPRO PROCESS
118C 401 q qbar -> g V V
119C 402 q g -> q V V
120C 403 qbar q -> g V V
121C 404 qbar g -> qbar V V
122C 405 g q -> q V V
123C 406 g qbar -> qbar V V
124C-----------------------------------------------------------------------
cf0c7e04 125 IHPRO=I1HPRO-400
126 ISCALE=0
127 ELSEIF (JPR.EQ.26.OR.JPR.EQ.27) THEN
128C----------------------------------------------------------------------
129C GAUGE BOSON PLUS HIGGS PRODUCTION
130C VH=WH,ZH FOR IPROC=-2600-ID,-2700-ID
131C WHERE ID CONTROLS HIGGS DECAY AS IN STANDARD HERWIG
132C-----------------------------------------------------------------------
31d78ebd 133 IHPRO=I1HPRO-400
134 ISCALE=0
135 ELSE
136 CALL HWWARN('UPEVNT',202,*999)
137 ENDIF
31d78ebd 138C---HARD SCALE
139 SCALUP=PCM(5)
31d78ebd 140 IF (REMIT) THEN
141 IF (ISCALE.EQ.0) THEN
142 PTR=SQRT(PUP(1,3)**2+PUP(2,3)**2)
143 SCALUP=PCM(5)-2.*PTR
144 ELSEIF(ISCALE.EQ.1)THEN
145 SCALUP=PCM(5)
146 ELSEIF (ISCALE.EQ.2) THEN
147 SCALUP=SQRT(PUP(1,3)**2+PUP(2,3)**2)
148 ELSEIF (ISCALE.EQ.3.OR.ISCALE.EQ.4.OR.ISCALE.EQ.5) THEN
149 PTR=SQRT(PUP(1,3)**2+PUP(2,3)**2)
150 IA=4
151 IB=5
152 XMP2=PUP(5,3)**2
153 XMA2=PUP(5,IA)**2
154 XMB2=PUP(5,IB)**2
155 S2=XMA2+XMB2+2*HWULDO(PUP(1,IA),PUP(1,IB))
156 SIGMA=XMA2+XMB2
157 DELTA=XMA2-XMB2
158 BETA=SQRT(1-2*SIGMA/S2+(DELTA/S2)**2)
159 VA=BETA/(1+DELTA/S2)
160 VB=BETA/(1-DELTA/S2)
161 XKA=HWULDO(PUP(1,3),PUP(1,IA))
162 XKB=HWULDO(PUP(1,3),PUP(1,IB))
163 E=(XKA+XKB)/SQRT(S2)
164 PL=-2.0/((VA+VB)*BETA*SQRT(S2))*(VA*XKA-VB*XKB)
165 PTF=E**2-PL**2-XMP2
cf0c7e04 166 IF (PTF.LE.ZERO) CALL HWWARN('UPEVNT',103,*999)
31d78ebd 167 PTF=SQRT(PTF)
168 IF(ISCALE.EQ.3)THEN
169 SCALUP=PCM(5)-2.*MIN(PTR,PTF)
170 ELSEIF(ISCALE.EQ.4)THEN
171 SCALUP=MIN(PTR,PTF)
172 ELSE
173 SCALUP=(MIN(PTR,PTF))**2+(XMA2+XMB2)/2.D0
174 SCALUP=SQRT(SCALUP)
175 ENDIF
176 IF (SCALUP.LE.ZERO) CALL HWWARN('UPEVNT',100,*999)
177 ELSEIF (ISCALE.EQ.6) THEN
178 XMTR=SQRT(PUP(5,4)**2+PUP(1,4)**2+PUP(2,4)**2)
179 PTR=SQRT(PUP(1,3)**2+PUP(2,3)**2)
180 SCALUP=PCM(5)-PTR-XMTR
181 IF (SCALUP.LE.ZERO) CALL HWWARN('UPEVNT',100,*999)
182 ELSEIF (ISCALE.EQ.7) THEN
183 SCALUP=SQRT(PUP(5,4)**2+PUP(1,4)**2+PUP(2,4)**2)
184 ELSE
185 CALL HWWARN('UPEVNT',501,*999)
186 ENDIF
187 ELSE
188 NUP=NUP-1
189 ENDIF
190C---INITIAL STATE
191 DO I=1,2
192 ISTUP(I)=-1
193 MOTHUP(1,I)=0
194 MOTHUP(2,I)=0
195 ENDDO
196C---FINAL STATE
197 DO I=3,NUP
198 ISTUP(I)=1
199 MOTHUP(1,I)=1
200 MOTHUP(2,I)=2
201 ENDDO
cf0c7e04 202 IF (BOPRO.AND.NODEC) THEN
203C---SINGLE BOSON (UNDECAYED)
31d78ebd 204 IF (REMIT) THEN
205C---SET COLOUR CONNECTIONS
206 DO I=1,3
207 ICOLUP(1,I)=501
208 ICOLUP(2,I)=502
209 ENDDO
210 IF (IHPRO.EQ.1) THEN
211 ICOLUP(2,1)=0
212 ICOLUP(1,2)=0
213 ELSEIF (IHPRO.EQ.2) THEN
214 ICOLUP(1,1)=502
215 ICOLUP(2,1)=0
216 ICOLUP(2,3)=0
217 ELSEIF (IHPRO.EQ.3) THEN
218 ICOLUP(1,1)=0
219 ICOLUP(2,2)=0
220 ELSEIF (IHPRO.EQ.4) THEN
221 ICOLUP(1,1)=0
222 ICOLUP(2,1)=501
223 ICOLUP(1,3)=0
224 ELSEIF (IHPRO.EQ.5) THEN
225 ICOLUP(1,2)=502
226 ICOLUP(2,2)=0
227 ICOLUP(2,3)=0
228 ELSEIF (IHPRO.EQ.6) THEN
229 ICOLUP(1,2)=0
230 ICOLUP(2,2)=501
231 ICOLUP(1,3)=0
232 ELSEIF (IHPRO.EQ.7) THEN
233 ICOLUP(1,2)=502
234 ICOLUP(2,2)=503
235 ICOLUP(2,3)=503
236 ELSE
cf0c7e04 237 CALL HWWARN('UPEVNT',101,*999)
31d78ebd 238 ENDIF
239 ELSE
240 CALL HWVEQU(5,PUP(1,4),PUP(1,3))
241C---SET COLOUR CONNECTIONS
242 DO I=1,2
243 ICOLUP(1,I)=0
244 ICOLUP(2,I)=0
245 ENDDO
246 IF (IDUP(1).GT.0) THEN
247 ICOLUP(1,1)=501
248 ICOLUP(2,2)=501
249 IF (IDUP(1).GT.0) THEN
250C---GG FUSION
251 ICOLUP(2,1)=502
252 ICOLUP(1,2)=502
253 ENDIF
254 ELSE
255C---QBAR Q
256 ICOLUP(2,1)=501
257 ICOLUP(1,2)=501
258 ENDIF
259 ENDIF
260 ICOLUP(1,NUP)=0
261 ICOLUP(2,NUP)=0
cf0c7e04 262C---LOAD BOSON ID
31d78ebd 263 IF (JPR.EQ.13) THEN
264 IDUP(NUP)=23
265 ELSEIF (JPR.EQ.16) THEN
266 IDUP(NUP)=25
267 ELSEIF (JPR.EQ.36) THEN
cf0c7e04 268 IBOS=MOD(JJPROC,100)
31d78ebd 269 IF (IBOS.EQ.10) THEN
270 IDUP(NUP)=26
271 ELSEIF (IBOS.EQ.20) THEN
272 IDUP(NUP)=35
273 ELSEIF (IBOS.EQ.30) THEN
cf0c7e04 274 IDUP(NUP)=36
31d78ebd 275 ELSE
cf0c7e04 276 CALL HWWARN('UPEVNT',502,*999)
31d78ebd 277 ENDIF
278 ELSEIF (JPR.EQ.14) THEN
279 IBOS=0
280 DO I=1,NUP-1
281 ID=IDUP(I)
282 IF (ID.EQ.21) THEN
283 IC=0
284 ELSEIF (ID.GT.0) THEN
285 IC=ICHRG(ID)
286 ELSE
287 IC=ICHRG(6-ID)
288 ENDIF
289 IBOS=IBOS+IC
290 ENDDO
291 IF (REMIT) IBOS=IBOS-2*IC
292 IF (ABS(IBOS).NE.3) CALL HWWARN('UPEVNT',503,*999)
293 IDUP(NUP)=8*IBOS
294 ENDIF
295 ELSEIF (JPR.EQ.17) THEN
296C---HEAVY QUARKS
297 IF (REMIT) THEN
298C---3-BODY FINAL STATE
299C---SET COLOUR CONNECTIONS
300 IF (IC.LE.18) THEN
301 DO I=1,5
302 CALL UPCODE(ICOL5(I,IC),ICOLUP(1,I))
303 ENDDO
304 ELSE
305 CALL HWWARN('UPEVNT',105,*999)
306 ENDIF
307 ELSE
308C---2-BODY FINAL STATE
cf0c7e04 309 IDUP(3)=IDUP(4)
310 IDUP(4)=IDUP(5)
31d78ebd 311 CALL HWVEQU(5,PUP(1,4),PUP(1,3))
312 CALL HWVEQU(5,PUP(1,5),PUP(1,4))
313C---SET COLOUR CONNECTIONS
314 IF (IC.LE.4) THEN
315 DO I=1,4
316 CALL UPCODE(ICOL4(I,IC),ICOLUP(1,I))
317 ENDDO
318 ELSE
319 CALL HWWARN('UPEVNT',104,*999)
320 ENDIF
321 ENDIF
cf0c7e04 322 ELSEIF (JPR.EQ.20) THEN
323C---SINGLE TOP: IA,IB ARE THE QUARKS THAT ARE COLOUR CONNECTED
324C I.E. (FOR H EVENTS) THOSE THAT ARE NOT CONNECTED TO GLUON
325 IA=IC/10
326 IB=IC-10*IA
327 IF (IA.LT.1.OR.IA.GT.5) CALL HWWARN('UPEVNT',108,*999)
328 IF (IB.LT.1.OR.IB.GT.5) CALL HWWARN('UPEVNT',109,*999)
329 IF (IA.EQ.IB) CALL HWWARN('UPEVNT',110,*999)
330 DO I=1,5
331 IF (I.EQ.IA.OR.I.EQ.IB) THEN
332 IF (IDUP(I).GT.0) THEN
333 ICOLUP(1,I)=501
334 ICOLUP(2,I)=0
335 ELSE
336 ICOLUP(1,I)=0
337 ICOLUP(2,I)=501
338 ENDIF
339 ELSEIF (IDUP(I).EQ.21) THEN
340 IG=I
341 ICOLUP(1,I)=502
342 ICOLUP(2,I)=503
343 ELSEIF (IDUP(I).GT.0) THEN
344 ICOLUP(1,I)=502
345 ICOLUP(2,I)=0
346 ELSE
347 ICOLUP(1,I)=0
348 ICOLUP(2,I)=502
349 ENDIF
350 ENDDO
31d78ebd 351 IF (REMIT) THEN
cf0c7e04 352C---3-BODY FINAL STATE
353C---COMPLETE GLUON COLOUR CONNECTIONS
354 DO I=1,5
355 IF (I.NE.IA.AND.I.NE.IB.AND.I.NE.IG) THEN
356 IF (IDUP(I).GT.0) THEN
357 IF((I.LT.3.AND.IG.LT.3)
358 & .OR.(I.GT.2.AND.IG.GT.2)) ICOLUP(1,I)=503
359 ELSE
360 IF((I.LT.3.AND.IG.GT.2)
361 & .OR.(I.GT.2.AND.IG.LT.3)) ICOLUP(2,I)=503
362 ENDIF
363 ENDIF
364 ENDDO
365 ELSE
366C---2-BODY FINAL STATE
367 IDUP(3)=IDUP(4)
368 IDUP(4)=IDUP(5)
369 ICOLUP(1,3)=ICOLUP(1,4)
370 ICOLUP(2,3)=ICOLUP(2,4)
371 ICOLUP(1,4)=ICOLUP(1,5)
372 ICOLUP(2,4)=ICOLUP(2,5)
373 CALL HWVEQU(5,PUP(1,4),PUP(1,3))
374 CALL HWVEQU(5,PUP(1,5),PUP(1,4))
375 ENDIF
376 ELSE
377C---BOSON PAIR OR LEPTON PAIR
378 IF (BOPRO.OR.NODEC) THEN
31d78ebd 379 NUP=6
cf0c7e04 380 DO I=6,5,-1
381 CALL HWVEQU(5,PUP(1,I-1),PUP(1,I))
382 IDUP(I)=IDUP(I-1)
383 ISTUP(I)=1
384 ENDDO
385 ELSE
386C---BOSON PAIR: ONE OR BOTH DECAYED
387C---ADD BOSON(S) TO EVENT RECORD
388 IF (ABS(IDUP(6)).LT.20) THEN
389 NUP=8
390 I=2
391 IF (ABS(IDUP(4)).LT.20) THEN
392 NUP=10
393 I=3
394 ENDIF
395 MUP=NUP-1
396 CALL HWVEQU(5,PUP(1,MUP-I),PUP(1,MUP))
397 CALL HWVEQU(5,PUP(1,NUP-I),PUP(1,NUP))
398 CALL HWVSUM(4,PUP(1,MUP),PUP(1,NUP),PUP(1,6))
399 CALL HWUMAS(PUP(1,6))
400 IDUP(MUP)=IDUP(MUP-I)
401 IDUP(NUP)=IDUP(NUP-I)
402 ISTUP(MUP)=1
403 ISTUP(NUP)=1
404 MOTHUP(1,MUP)=6
405 MOTHUP(2,MUP)=6
406 MOTHUP(1,NUP)=6
407 MOTHUP(2,NUP)=6
408 ISTUP(6)=2
409 ID=IDUP(MUP)+IDUP(NUP)
410 IF (ID.EQ.0) THEN
411 IDUP(6)=23
412 ELSEIF (ABS(ID).EQ.1) THEN
413 IDUP(6)=24*ID
414 ELSE
415 CALL HWWARN('UPEVNT',106,*999)
416 ENDIF
417 ENDIF
418 IF (ABS(IDUP(4)).LT.20) THEN
419 CALL HWVZRO(4,PDB)
420 DO I=8,7,-1
421 CALL HWVEQU(5,PUP(1,I-3),PUP(1,I))
422 CALL HWVSUM(4,PUP(1,I),PDB,PDB)
423 IDUP(I)=IDUP(I-3)
424 ISTUP(I)=1
425 MOTHUP(1,I)=5
426 MOTHUP(2,I)=5
427 ENDDO
428 CALL HWUMAS(PDB)
429 CALL HWVEQU(5,PDB,PUP(1,5))
430 ISTUP(5)=2
431 ID=IDUP(7)+IDUP(8)
432 IF (ID.EQ.0) THEN
433 IDUP(5)=23
434 ELSEIF (ABS(ID).EQ.1) THEN
435 IDUP(5)=24*ID
436 ELSE
437 CALL HWWARN('UPEVNT',107,*999)
438 ENDIF
439 ELSE
440 CALL HWVEQU(5,PUP(1,4),PUP(1,5))
441 IDUP(5)=IDUP(4)
442 ISTUP(5)=1
443 MOTHUP(1,5)=4
444 MOTHUP(2,5)=4
445 ENDIF
446 ENDIF
447C---ADD DIBOSON OR DILEPTON TO EVENT RECORD (TO FIX ITS MASS)
448 CALL HWVZRO(4,PDB)
449 DO I=6,5,-1
450 CALL HWVSUM(4,PUP(1,I),PDB,PDB)
451 MOTHUP(1,I)=4
452 MOTHUP(2,I)=4
453 ENDDO
454 CALL HWUMAS(PDB)
455 CALL HWVEQU(5,PDB,PUP(1,4))
456 ISTUP(4)=2
457 IDUP(4)=0
458 IF (REMIT) THEN
31d78ebd 459C---SET COLOUR CONNECTIONS
460 DO I=1,3
461 ICOLUP(1,I)=501
462 ICOLUP(2,I)=502
463 ENDDO
464 IF (IHPRO.EQ.1) THEN
465 ICOLUP(2,1)=0
466 ICOLUP(1,2)=0
467 ELSEIF (IHPRO.EQ.2) THEN
468 ICOLUP(1,1)=502
469 ICOLUP(2,1)=0
470 ICOLUP(2,3)=0
471 ELSEIF (IHPRO.EQ.3) THEN
472 ICOLUP(1,1)=0
473 ICOLUP(2,2)=0
474 ELSEIF (IHPRO.EQ.4) THEN
475 ICOLUP(1,1)=0
476 ICOLUP(2,1)=501
477 ICOLUP(1,3)=0
478 ELSEIF (IHPRO.EQ.5) THEN
479 ICOLUP(1,2)=502
480 ICOLUP(2,2)=0
481 ICOLUP(2,3)=0
482 ELSEIF (IHPRO.EQ.6) THEN
483 ICOLUP(1,2)=0
484 ICOLUP(2,2)=501
485 ICOLUP(1,3)=0
486 ELSE
cf0c7e04 487 CALL HWWARN('UPEVNT',102,*999)
31d78ebd 488 ENDIF
cf0c7e04 489 DO I=4,NUP
31d78ebd 490 ICOLUP(1,I)=0
491 ICOLUP(2,I)=0
492 ENDDO
493 ELSE
cf0c7e04 494 DO I=5,NUP
495 CALL HWVEQU(5,PUP(1,I),PUP(1,I-2))
496 IDUP(I-2)=IDUP(I)
497 ISTUP(I-2)=ISTUP(I)
498 MOTHUP(1,I-2)=MOTHUP(1,I)-2
499 MOTHUP(2,I-2)=MOTHUP(1,I)-2
500 ENDDO
501 MOTHUP(1,3)=1
502 MOTHUP(1,4)=1
503 NUP=NUP-2
31d78ebd 504C---SET COLOUR CONNECTIONS
cf0c7e04 505 DO I=1,NUP
31d78ebd 506 ICOLUP(1,I)=0
507 ICOLUP(2,I)=0
508 ENDDO
509 IF (IDUP(1).GT.0) THEN
510 ICOLUP(1,1)=501
511 ICOLUP(2,2)=501
512 ELSE
513 ICOLUP(2,1)=501
514 ICOLUP(1,2)=501
515 ENDIF
516 ENDIF
cf0c7e04 517 IF (BOPRO) THEN
518C---DILEPTON PRODUCTION
519 IBOS=MOD(JJPROC,100)
520 ILEP=MOD(JJPROC,10)
521 IBOS=IBOS-ILEP
522C---LOAD LEPTON AND BOSON ID
523 I=NUP-1
524 J=NUP
525 IF ( IBOS.EQ.50 .OR.
526 # (IBOS.EQ.60.AND.JPR.EQ.13) .OR.
527 # (IBOS.EQ.70.AND.JPR.EQ.13) ) THEN
528 IDUP(I)=-ILEP-10
529 IDUP(J)=-IDUP(I)
530 IF (REMIT) IDUP(4)=23
531 ELSEIF (IBOS.EQ.60.AND.JPR.EQ.14) THEN
532 IDUP(I)=-9-2*ILEP
533 IDUP(J)=1-IDUP(I)
534 IF (REMIT) IDUP(4)=24
535 ELSEIF (IBOS.EQ.70.AND.JPR.EQ.14) THEN
536 IDUP(I)=-10-2*ILEP
537 IDUP(J)=-1-IDUP(I)
538 IF (REMIT) IDUP(4)=-24
539 ELSE
540 CALL HWWARN('UPEVNT',504,*999)
541 ENDIF
31d78ebd 542 ENDIF
543 ENDIF
cf0c7e04 544 999 CONTINUE
545 IF(IERROR.LT.100) RETURN
546 PRINT *
547 DO I=1,NUP
548 PRINT '(4I4,3F8.2)',IDUP(I),ISTUP(I),(ICOLUP(J,I),J=1,2),
549 & (PUP(J,I),J=1,3)
550 ENDDO
551c IPR, IC, NP
552 901 FORMAT(1X,I3,2(1X,I2))
553c (ID(I),I=1,NP)
554 902 FORMAT(7(1X,I3))
555c XEVWGT
556 903 FORMAT(1X,D14.8)
557c ((P(J,I),J=1,4),I=1,NP)
558 904 FORMAT(28(1X,D14.8))
559c 901 FORMAT(1X,I3,4(1X,I2))
560c 902 FORMAT(1X,D14.8)
561c 903 FORMAT(16(1X,D14.8))
562 END
31d78ebd 563C----------------------------------------------------------------------
564 SUBROUTINE UPCODE(ICODE,ICOL)
565C--DECODES COLOUR CONNECTIONS
566C----------------------------------------------------------------------
567 IMPLICIT NONE
568 INTEGER ICODE,ICOL(2)
569 ICOL(1)=ICODE/10
570 IF (ICOL(1).NE.0) ICOL(1)=ICOL(1)+500
571 ICOL(2)=MOD(ICODE,10)
572 IF (ICOL(2).NE.0) ICOL(2)=ICOL(2)+500
573 END
574C----------------------------------------------------------------------
575 SUBROUTINE UPINIT_GUP
576C----------------------------------------------------------------------
cf0c7e04 577C Reads MC@NLO input headers and fills Les Houches run common HEPRUP
31d78ebd 578C----------------------------------------------------------------------
c63d70bc 579 INCLUDE 'herwig65.inc'
31d78ebd 580C--Les Houches Common Blocks
581 INTEGER MAXPUP
582 PARAMETER(MAXPUP=100)
583 INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP
584 DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP
585 COMMON /HEPRUP/ IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2),
586 & IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),
587 & XMAXUP(MAXPUP),LPRUP(MAXPUP)
588 INTEGER MAXNUP
589 PARAMETER (MAXNUP=500)
590 INTEGER NUP,IDPRUP,IDUP,ISTUP,MOTHUP,ICOLUP
591 DOUBLE PRECISION XWGTUP,SCALUP,AQEDUP,AQCDUP,PUP,VTIMUP,SPINUP
592 COMMON/HEPEUP/NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP,
593 & IDUP(MAXNUP),ISTUP(MAXNUP),MOTHUP(2,MAXNUP),
594 & ICOLUP(2,MAXNUP),PUP(5,MAXNUP),VTIMUP(MAXNUP),
595 & SPINUP(MAXNUP)
596 DOUBLE PRECISION XCKECM,XTMP1,XTMP2,XTMP3,XTMP4,XMT,XMW,XMZ,
597 & XMH,XMV,XM1,XM2,XM3,XM4,XM5,XM21,XLAM,GAH,TINY
cf0c7e04 598 DOUBLE PRECISION XMV1,GAV1,GAMAX1,XMV2,GAV2,GAMAX2
599 INTEGER IVVCODE,IFAIL,MQQ,NQQ,IHW,I,NDNS,JPR,JPR0,IH,
600 & IVHVEC,IVHLEP,IVLEP1,IVLEP2
31d78ebd 601 CHARACTER*60 TMPSTR
602 CHARACTER*4 STRP1,STRP2
603 CHARACTER*8 STRGRP
604 CHARACTER*2 STRSCH
cf0c7e04 605 CHARACTER*3 STRFMT
31d78ebd 606 CHARACTER*50 QQIN
607 LOGICAL FK88STRNOEQ
608 DATA TINY/1.D-3/
609 COMMON/NQQCOM/MQQ,NQQ
610 COMMON/VVJIN/QQIN
cf0c7e04 611 COMMON/VHLIN/IVHVEC,IVHLEP
612 COMMON/VVLIN/IVLEP1,IVLEP2
31d78ebd 613C
614 IF (IERROR.NE.0) RETURN
615C--SET UP INPUT FILES
616 OPEN(UNIT=61,FILE=QQIN,STATUS='UNKNOWN')
31d78ebd 617C--READ HEADERS OF EVENT FILE
618 READ(61,801)XCKECM,XTMP1,XTMP2,XTMP3,XTMP4,TMPSTR
31d78ebd 619 READ(61,802)IVVCODE,TMPSTR
620 IVVCODE=MOD(IVVCODE,10000)
621C---CHECK PROCESS CODE
622 JPR0=MOD(ABS(IPROC),10000)
623 JPR=JPR0/100
624 IF (JPR.NE.IVVCODE/100) CALL HWWARN('UPINIT',500,*999)
625 IF ((JPR.EQ.17.OR.JPR.EQ.28.OR.JPR.EQ.36).AND.
626 & IVVCODE.NE.MOD(ABS(IPROC),10000)) CALL HWWARN('UPINIT',501,*999)
627 IF (JPR.EQ.13.OR.JPR.EQ.14) THEN
cf0c7e04 628 IF(JPR0.EQ.1396.OR.JPR0.EQ.1371.OR.
629 # JPR0.EQ.1372.OR.JPR0.EQ.1373)THEN
31d78ebd 630 READ(61,808)EMMIN,EMMAX,TMPSTR
631 ELSE
632 READ(61,809)XMV,GAH,GAMMAX,TMPSTR
633 ENDIF
634C-- CHECK VECTOR BOSON MASS
635 IF( (IVVCODE.EQ.1397.AND.ABS(XMV-RMASS(200)).GT.TINY) .OR.
636 # (IVVCODE.EQ.1497.AND.ABS(XMV-RMASS(198)).GT.TINY) .OR.
637 # (IVVCODE.EQ.1498.AND.ABS(XMV-RMASS(199)).GT.TINY) )
638 # CALL HWWARN('UPINIT',502,*999)
cf0c7e04 639 ELSEIF (JPR.EQ.26.OR.JPR.EQ.27) THEN
640 READ(61,810)IVHVEC,IVHLEP,TMPSTR
641 READ(61,809)XMV,GAH,GAMMAX,TMPSTR
642 READ(61,809)XMH,GAH,GAMMAX,TMPSTR
643 IF( (JPR.EQ.26.AND.ABS(XMV-RMASS(199)).GT.TINY) .OR.
644 # (JPR.EQ.27.AND.ABS(XMV-RMASS(200)).GT.TINY) )
645 # CALL HWWARN('UPINIT',508,*999)
646 IF(ABS(XMH-RMASS(201)).GT.TINY) CALL HWWARN('UPINIT',509,*999)
31d78ebd 647 ELSEIF (JPR.EQ.28) THEN
648 READ(61,808)XMW,XMZ,TMPSTR
649C-- CHECK VECTOR BOSON MASSES
650 IF(ABS(XMW-RMASS(198)).GT.TINY .OR.
651 # ABS(XMZ-RMASS(200)).GT.TINY) CALL HWWARN('UPINIT',502,*999)
cf0c7e04 652 READ(61,810)IVLEP1,IVLEP2,TMPSTR
653 READ(61,809)XMV1,GAV1,GAMAX1,TMPSTR
654 READ(61,809)XMV2,GAV2,GAMAX2,TMPSTR
31d78ebd 655 ELSEIF (JPR.EQ.16.OR.JPR.EQ.36) THEN
656 READ(61,809)XMH,GAH,XMT,TMPSTR
657C-- CHECK HIGGS AND TOP MASSES
658 IH=201
659 IF (JPR.EQ.36) IH=IVVCODE/10-158
660 IF(ABS(XMH-RMASS(IH)).GT.TINY) CALL HWWARN('UPINIT',503,*999)
661 IF(ABS(XMT-RMASS(6)) .GT.TINY) CALL HWWARN('UPINIT',504,*999)
662 ELSEIF (JPR.EQ.17) THEN
663 READ(61,803)XMT,TMPSTR
664C-- CHECK HEAVY QUARK MASS
665 IF( (IVVCODE.EQ.1706.AND.ABS(XMT-RMASS(6)).GT.TINY) .OR.
666 # (IVVCODE.EQ.1705.AND.ABS(XMT-RMASS(5)).GT.TINY) .OR.
cf0c7e04 667 # (IVVCODE.EQ.1704.AND.ABS(XMT-RMASS(4)).GT.TINY) )
668 # CALL HWWARN('UPINIT',505,*999)
669 ELSEIF (JPR.EQ.20) THEN
670 READ(61,803)XMT,TMPSTR
671C-- CHECK HEAVY QUARK MASS
672 IF(ABS(XMT-RMASS(6)).GT.TINY) CALL HWWARN('UPINIT',511,*999)
31d78ebd 673 ELSE
674 CALL HWWARN('UPINIT',506,*999)
675 ENDIF
676 READ(61,804)XM1,XM2,XM3,XM4,XM5,XM21,TMPSTR
677 READ(61,805)STRP1,STRP2,TMPSTR
678 READ(61,806)STRGRP,NDNS,TMPSTR
679 READ(61,807)XLAM,STRSCH,TMPSTR
cf0c7e04 680C--CHECK THAT EVENT FILE HAS BEEN GENERATED CONSISTENTLY WITH
31d78ebd 681C--HERWIG PARAMETERS ADOPTED HERE
682 IFAIL=0
683C-- CM ENERGY
684 IF( ABS(XCKECM-PBEAM1-PBEAM2).GT.TINY .OR.
685C-- QUARK AND GLUON MASSES
686 # ABS(XM1-RMASS(1)).GT.TINY .OR.
687 # ABS(XM2-RMASS(2)).GT.TINY .OR.
688 # ABS(XM3-RMASS(3)).GT.TINY .OR.
689 # ABS(XM4-RMASS(4)).GT.TINY .OR.
690 # ABS(XM5-RMASS(5)).GT.TINY .OR.
691 # ABS(XM21-RMASS(13)).GT.TINY .OR.
692C-- LAMBDA_QCD: NOW REMOVED TO ALLOW MORE FLEXIBILITY (NNLO EFFECT ANYHOW)
693C # ABS(XLAM-QCDLAM).GT.TINY .OR.
cf0c7e04 694C-- REPLACE THE FOLLOWING WITH A CONDITION ON STRSCH, IF CONSISTENT
31d78ebd 695C-- INFORMATION ON PDF SCHEME WILL BE AVAILABLE FROM PDF LIBRARIES AND HERWIG
696C-- COLLIDING PARTICLE TYPE
697 # FK88STRNOEQ(STRP1,PART1) .OR.
cf0c7e04 698 # FK88STRNOEQ(STRP2,PART2) ) IFAIL=1
31d78ebd 699C--IF PDF LIBRARY IS USED, CHECK PDF CONSISTENCY
700 IF( IFAIL.EQ.0 .AND. MODPDF(1).NE.-1)THEN
cf0c7e04 701 IF( ABS(NDNS-MODPDF(1)).GT.TINY .OR.
702 # ABS(NDNS-MODPDF(2)).GT.TINY .OR.
703C--IF LHAPDF IS USED, STRGRP AND AUTPDF ARE DIFFERENT
704 # STRGRP.NE.'LHAPDF'.AND.FK88STRNOEQ(STRGRP,AUTPDF(1)))THEN
705 IFAIL=0
706 ENDIF
707C--WHEN LHAPDF IS LINKED, AUTPDF() IS A MC@NLO-DEFINED STRING
708 IF(AUTPDF(1).EQ.'HWLHAPDF'.OR.AUTPDF(1).EQ.'LHAEXT')THEN
709 AUTPDF(1)='DEFAULT'
710 AUTPDF(2)='DEFAULT'
711 ENDIF
31d78ebd 712 ENDIF
713 IF(IFAIL.EQ.1) CALL HWWARN('UPINIT',507,*999)
714 CALL HWUIDT(3,IDBMUP(1),IHW,PART1)
715 CALL HWUIDT(3,IDBMUP(2),IHW,PART2)
716 DO I=1,2
717 EBMUP(I)=HALF*XCKECM
718 PDFGUP(I)=-1
719 PDFSUP(I)=-1
720 ENDDO
721 IDWTUP=-4
722 NPRUP=1
723 LPRUP(1)=IVVCODE
cf0c7e04 724C-- TEST FOR NEW FORMAT INPUT MOMENTA: (PX,PY,PZ,M)
725 READ(61,811) STRFMT,TMPSTR
726 IF (STRFMT.NE.'P,M') CALL HWWARN('UPINIT',510,*999)
31d78ebd 727 READ(61,900) MQQ
728 NQQ=0
cf0c7e04 729C-- LARGEST EXPECTED NUMBER OF LEGS
730 NUP=10
31d78ebd 731 AQEDUP=ZERO
732 AQCDUP=ZERO
733 DO I=1,NUP
734 VTIMUP(I)=ZERO
735 SPINUP(I)=9.
736 ENDDO
31d78ebd 737 801 FORMAT(5(1X,D10.4),1X,A)
738 802 FORMAT(1X,I6,1X,A)
739 803 FORMAT(1X,D10.4,1X,A)
740 804 FORMAT(6(1X,D10.4),1X,A)
741 805 FORMAT(2(1X,A4),1X,A)
cf0c7e04 742 806 FORMAT(1X,A8,1X,I6,1X,A)
31d78ebd 743 807 FORMAT(1X,D10.4,1X,A2,1X,A)
744 808 FORMAT(2(1X,D10.4),1X,A)
745 809 FORMAT(3(1X,D10.4),1X,A)
cf0c7e04 746 810 FORMAT(2(1X,I2),1X,A)
747 811 FORMAT(1X,A3,1X,A)
31d78ebd 748 900 FORMAT(I9)
749 999 END