]> git.uio.no Git - u/mrichter/AliRoot.git/blame - HERWIG/hwlhin.f
Updates needed to be in synch with TDPMjet.
[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----------------------------------------------------------------------
9 INCLUDE 'HERWIG65.INC'
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)
20 DOUBLE PRECISION PCM(5),PTR,XMTR,HWULDO
21 INTEGER I,J,IC,JPR,IHVY,MQQ,NQQ,IUNIT,ISCALE,I1HPRO,IBOS,
22 & ID,IA,IB,ICOL4(4,4),ICOL5(5,18)
23 PARAMETER (IUNIT=61)
24 LOGICAL BOPRO,REMIT
25 COMMON/NQQCOM/MQQ,NQQ
26C---Colour flows for heavy quark pair production
27 DATA ICOL4/
28 & 10,02,10,02,01,20,20,01,12,23,10,03,12,31,30,02/
29 DATA ICOL5/
30 & 10,02,13,30,02, 10,02,32,10,03,
31 & 10,21,30,20,03, 10,23,20,10,03,
32 & 01,20,23,30,01, 01,20,31,20,03,
33 & 01,23,03,20,01, 01,12,03,30,02,
34 & 12,20,30,10,03, 12,30,10,30,02,
35 & 12,03,02,10,03, 12,01,03,30,02,
36 & 12,23,14,40,03, 12,34,32,10,04,
37 & 12,23,43,10,04, 12,31,34,40,02,
38 & 12,34,14,30,02, 12,31,42,30,04/
39 IF (IERROR.NE.0) RETURN
40C---READ AN EVENT
41! PRINT*,'NQQ= ',NQQ,' MQQ=',MQQ
42 IF(NQQ.GE.MQQ)CALL HWWARN('UPEVNT',201,*999)
43 NQQ=NQQ+1
44 NUP=5
45C---CHECK PROCESS CODE
46 JPR=MOD(IDPRUP,10000)/100
47 BOPRO=JPR.EQ.13.OR.JPR.EQ.14.OR.JPR.EQ.16.OR.JPR.EQ.36
48 IF (BOPRO) THEN
49C----------------------------------------------------------------------
50C SINGLE GAUGE OR HIGGS BOSON PRODUCTION
51C B = Z/gamma, W or H (SM or any MSSM neutral Higgs)
52C-----------------------------------------------------------------------
53C I1HPRO IDENTIFIES THE PARTONIC SUBPROCESS, WITH THE FOLLOWING CONVENTIONS:
54C I1HPRO PROCESS
55C 401 q qbar -> g B
56C 402 q g -> q B
57C 403 qbar q -> g B
58C 404 qbar g -> qbar B
59C 405 g q -> q B
60C 406 g qbar -> qbar B
61C 407 g g -> g B
62C-----------------------------------------------------------------------
63 NUP=4
64 READ(IUNIT,901) I1HPRO,(IDUP(I),I=1,3)
65 IHPRO=I1HPRO-400
66 ISCALE=0
67 IF(JPR.EQ.16)ISCALE=2
68 ELSEIF (JPR.EQ.17) THEN
69C----------------------------------------------------------------------
70C HEAVY Q QBAR PRODUCTION
71C IPROC=-1705,-1706 for Q=b,t
72C-----------------------------------------------------------------------
73C I1HPRO IDENTIFIES THE PARTONIC SUBPROCESS, WITH THE FOLLOWING CONVENTIONS:
74C I1HPRO PROCESS
75C 401 q qbar -> g Q Qbar
76C 402 q g -> q Q Qbar
77C 403 qbar q -> g Q Qbar
78C 404 qbar g -> qbar Q Qbar
79C 405 g q -> q Q Qbar
80C 406 g qbar -> qbar Q Qbar
81C 407 g g -> g Q Qbar
82C-----------------------------------------------------------------------
83C IC SPECIFIES THE COLOUR CONNECTION (NOW IN INPUT FILE)
84C-----------------------------------------------------------------------
85 READ(IUNIT,901) I1HPRO,(IDUP(I),I=1,3),IC
86C---SET IHPRO AS FOR DIRECT PHOTON (IPROC=1800)
87 IHPRO=I1HPRO-360
88 ISCALE=0
89 IF(ABS(IPROC).EQ.1705.OR.ABS(IPROC).EQ.11705)ISCALE=5
90 ELSEIF (JPR.EQ.28) THEN
91C----------------------------------------------------------------------
92C GAUGE BOSON PAIR PRODUCTION
93C VV=WW,ZZ,ZW+,ZW- FOR IPROC=-2850,-2860,-2870,-2880
94C-----------------------------------------------------------------------
95C I1HPRO IDENTIFIES THE PARTONIC SUBPROCESS, WITH THE FOLLOWING CONVENTIONS:
96C I1HPRO PROCESS
97C 401 q qbar -> g V V
98C 402 q g -> q V V
99C 403 qbar q -> g V V
100C 404 qbar g -> qbar V V
101C 405 g q -> q V V
102C 406 g qbar -> qbar V V
103C-----------------------------------------------------------------------
104 READ(IUNIT,901) I1HPRO,(IDUP(I),I=1,3)
105 IHPRO=I1HPRO-400
106 ISCALE=0
107 ELSE
108 CALL HWWARN('UPEVNT',202,*999)
109 ENDIF
110 READ(IUNIT,902) XWGTUP
111C---Les Houches expects mean weight to be the cross section in pb
112 XWGTUP= XWGTUP*MQQ
113 READ(IUNIT,903) ((PUP(J,I),J=1,4),I=1,2)
114 READ(IUNIT,904) ((PUP(J,I),J=1,4),I=3,NUP)
115 DO I=1,NUP
116 CALL HWUMAS(PUP(1,I))
117 ENDDO
118 CALL HWVSUM(4,PUP(1,1),PUP(1,2),PCM)
119 CALL HWUMAS(PCM)
120C---HARD SCALE
121 SCALUP=PCM(5)
122C---REMIT MEANS A REAL PARTON EMISSION OCCURRED
123 REMIT=PUP(4,3).NE.ZERO
124 IF (REMIT) THEN
125 IF (ISCALE.EQ.0) THEN
126 PTR=SQRT(PUP(1,3)**2+PUP(2,3)**2)
127 SCALUP=PCM(5)-2.*PTR
128 ELSEIF(ISCALE.EQ.1)THEN
129 SCALUP=PCM(5)
130 ELSEIF (ISCALE.EQ.2) THEN
131 SCALUP=SQRT(PUP(1,3)**2+PUP(2,3)**2)
132 ELSEIF (ISCALE.EQ.3.OR.ISCALE.EQ.4.OR.ISCALE.EQ.5) THEN
133 PTR=SQRT(PUP(1,3)**2+PUP(2,3)**2)
134 IA=4
135 IB=5
136 XMP2=PUP(5,3)**2
137 XMA2=PUP(5,IA)**2
138 XMB2=PUP(5,IB)**2
139 S2=XMA2+XMB2+2*HWULDO(PUP(1,IA),PUP(1,IB))
140 SIGMA=XMA2+XMB2
141 DELTA=XMA2-XMB2
142 BETA=SQRT(1-2*SIGMA/S2+(DELTA/S2)**2)
143 VA=BETA/(1+DELTA/S2)
144 VB=BETA/(1-DELTA/S2)
145 XKA=HWULDO(PUP(1,3),PUP(1,IA))
146 XKB=HWULDO(PUP(1,3),PUP(1,IB))
147 E=(XKA+XKB)/SQRT(S2)
148 PL=-2.0/((VA+VB)*BETA*SQRT(S2))*(VA*XKA-VB*XKB)
149 PTF=E**2-PL**2-XMP2
150 PTF=SQRT(PTF)
151 IF(ISCALE.EQ.3)THEN
152 SCALUP=PCM(5)-2.*MIN(PTR,PTF)
153 ELSEIF(ISCALE.EQ.4)THEN
154 SCALUP=MIN(PTR,PTF)
155 ELSE
156 SCALUP=(MIN(PTR,PTF))**2+(XMA2+XMB2)/2.D0
157 SCALUP=SQRT(SCALUP)
158 ENDIF
159 IF (SCALUP.LE.ZERO) CALL HWWARN('UPEVNT',100,*999)
160 ELSEIF (ISCALE.EQ.6) THEN
161 XMTR=SQRT(PUP(5,4)**2+PUP(1,4)**2+PUP(2,4)**2)
162 PTR=SQRT(PUP(1,3)**2+PUP(2,3)**2)
163 SCALUP=PCM(5)-PTR-XMTR
164 IF (SCALUP.LE.ZERO) CALL HWWARN('UPEVNT',100,*999)
165 ELSEIF (ISCALE.EQ.7) THEN
166 SCALUP=SQRT(PUP(5,4)**2+PUP(1,4)**2+PUP(2,4)**2)
167 ELSE
168 CALL HWWARN('UPEVNT',501,*999)
169 ENDIF
170 ELSE
171 NUP=NUP-1
172 ENDIF
173C---INITIAL STATE
174 DO I=1,2
175 ISTUP(I)=-1
176 MOTHUP(1,I)=0
177 MOTHUP(2,I)=0
178 ENDDO
179C---FINAL STATE
180 DO I=3,NUP
181 ISTUP(I)=1
182 MOTHUP(1,I)=1
183 MOTHUP(2,I)=2
184 ENDDO
185 IF (BOPRO) THEN
186C---SINGLE BOSON
187 IF (REMIT) THEN
188C---SET COLOUR CONNECTIONS
189 DO I=1,3
190 ICOLUP(1,I)=501
191 ICOLUP(2,I)=502
192 ENDDO
193 IF (IHPRO.EQ.1) THEN
194 ICOLUP(2,1)=0
195 ICOLUP(1,2)=0
196 ELSEIF (IHPRO.EQ.2) THEN
197 ICOLUP(1,1)=502
198 ICOLUP(2,1)=0
199 ICOLUP(2,3)=0
200 ELSEIF (IHPRO.EQ.3) THEN
201 ICOLUP(1,1)=0
202 ICOLUP(2,2)=0
203 ELSEIF (IHPRO.EQ.4) THEN
204 ICOLUP(1,1)=0
205 ICOLUP(2,1)=501
206 ICOLUP(1,3)=0
207 ELSEIF (IHPRO.EQ.5) THEN
208 ICOLUP(1,2)=502
209 ICOLUP(2,2)=0
210 ICOLUP(2,3)=0
211 ELSEIF (IHPRO.EQ.6) THEN
212 ICOLUP(1,2)=0
213 ICOLUP(2,2)=501
214 ICOLUP(1,3)=0
215 ELSEIF (IHPRO.EQ.7) THEN
216 ICOLUP(1,2)=502
217 ICOLUP(2,2)=503
218 ICOLUP(2,3)=503
219 ELSE
220 CALL HWWARN('UPEVT',101,*999)
221 ENDIF
222 ELSE
223 CALL HWVEQU(5,PUP(1,4),PUP(1,3))
224C---SET COLOUR CONNECTIONS
225 DO I=1,2
226 ICOLUP(1,I)=0
227 ICOLUP(2,I)=0
228 ENDDO
229 IF (IDUP(1).GT.0) THEN
230 ICOLUP(1,1)=501
231 ICOLUP(2,2)=501
232 IF (IDUP(1).GT.0) THEN
233C---GG FUSION
234 ICOLUP(2,1)=502
235 ICOLUP(1,2)=502
236 ENDIF
237 ELSE
238C---QBAR Q
239 ICOLUP(2,1)=501
240 ICOLUP(1,2)=501
241 ENDIF
242 ENDIF
243 ICOLUP(1,NUP)=0
244 ICOLUP(2,NUP)=0
245C---LOAD BOSON DATA
246 IF (JPR.EQ.13) THEN
247 IDUP(NUP)=23
248 ELSEIF (JPR.EQ.16) THEN
249 IDUP(NUP)=25
250 ELSEIF (JPR.EQ.36) THEN
251 IBOS=MOD(IDPRUP,100)
252 IF (IBOS.EQ.10) THEN
253 IDUP(NUP)=26
254 ELSEIF (IBOS.EQ.20) THEN
255 IDUP(NUP)=35
256 ELSEIF (IBOS.EQ.30) THEN
257 IDUP(NUP)=36
258 ELSE
259 CALL HWWARN('UPEVNT',502,*999)
260 ENDIF
261 ELSEIF (JPR.EQ.14) THEN
262 IBOS=0
263 DO I=1,NUP-1
264 ID=IDUP(I)
265 IF (ID.EQ.21) THEN
266 IC=0
267 ELSEIF (ID.GT.0) THEN
268 IC=ICHRG(ID)
269 ELSE
270 IC=ICHRG(6-ID)
271 ENDIF
272 IBOS=IBOS+IC
273 ENDDO
274 IF (REMIT) IBOS=IBOS-2*IC
275 IF (ABS(IBOS).NE.3) CALL HWWARN('UPEVNT',503,*999)
276 IDUP(NUP)=8*IBOS
277 ENDIF
278 ELSEIF (JPR.EQ.17) THEN
279C---HEAVY QUARKS
280 IF (REMIT) THEN
281C---3-BODY FINAL STATE
282C---SET COLOUR CONNECTIONS
283 IF (IC.LE.18) THEN
284 DO I=1,5
285 CALL UPCODE(ICOL5(I,IC),ICOLUP(1,I))
286 ENDDO
287 ELSE
288 CALL HWWARN('UPEVNT',105,*999)
289 ENDIF
290 ELSE
291C---2-BODY FINAL STATE
292 CALL HWVEQU(5,PUP(1,4),PUP(1,3))
293 CALL HWVEQU(5,PUP(1,5),PUP(1,4))
294C---SET COLOUR CONNECTIONS
295 IF (IC.LE.4) THEN
296 DO I=1,4
297 CALL UPCODE(ICOL4(I,IC),ICOLUP(1,I))
298 ENDDO
299 ELSE
300 CALL HWWARN('UPEVNT',104,*999)
301 ENDIF
302 ENDIF
303 IHVY=MOD(IDPRUP,100)
304 IDUP(NUP-1)=IHVY
305 IDUP(NUP)=-IHVY
306 ELSE
307C---GAUGE BOSON PAIR
308 IF (REMIT) THEN
309C---ADD DIBOSON TO EVENT RECORD (TO FIX ITS MASS)
310 NUP=6
311 CALL HWVEQU(5,PUP(1,5),PUP(1,6))
312 CALL HWVEQU(5,PUP(1,4),PUP(1,5))
313 CALL HWVSUM(4,PUP(1,5),PUP(1,6),PUP(1,4))
314 CALL HWUMAS(PUP(1,4))
315 ISTUP(3)=1
316 ISTUP(4)=2
317 ISTUP(5)=1
318 ISTUP(6)=1
319 IDUP(4)=0
320 MOTHUP(1,3)=1
321 MOTHUP(2,3)=2
322 MOTHUP(1,4)=1
323 MOTHUP(2,4)=2
324 MOTHUP(1,5)=4
325 MOTHUP(2,5)=4
326 MOTHUP(1,6)=4
327 MOTHUP(2,6)=4
328C---SET COLOUR CONNECTIONS
329 DO I=1,3
330 ICOLUP(1,I)=501
331 ICOLUP(2,I)=502
332 ENDDO
333 IF (IHPRO.EQ.1) THEN
334 ICOLUP(2,1)=0
335 ICOLUP(1,2)=0
336 ELSEIF (IHPRO.EQ.2) THEN
337 ICOLUP(1,1)=502
338 ICOLUP(2,1)=0
339 ICOLUP(2,3)=0
340 ELSEIF (IHPRO.EQ.3) THEN
341 ICOLUP(1,1)=0
342 ICOLUP(2,2)=0
343 ELSEIF (IHPRO.EQ.4) THEN
344 ICOLUP(1,1)=0
345 ICOLUP(2,1)=501
346 ICOLUP(1,3)=0
347 ELSEIF (IHPRO.EQ.5) THEN
348 ICOLUP(1,2)=502
349 ICOLUP(2,2)=0
350 ICOLUP(2,3)=0
351 ELSEIF (IHPRO.EQ.6) THEN
352 ICOLUP(1,2)=0
353 ICOLUP(2,2)=501
354 ICOLUP(1,3)=0
355 ELSE
356 CALL HWWARN('UPEVT',101,*999)
357 ENDIF
358 DO I=4,6
359 ICOLUP(1,I)=0
360 ICOLUP(2,I)=0
361 ENDDO
362 ELSE
363 CALL HWVEQU(5,PUP(1,4),PUP(1,3))
364 CALL HWVEQU(5,PUP(1,5),PUP(1,4))
365C---SET COLOUR CONNECTIONS
366 DO I=1,4
367 ICOLUP(1,I)=0
368 ICOLUP(2,I)=0
369 ENDDO
370 IF (IDUP(1).GT.0) THEN
371 ICOLUP(1,1)=501
372 ICOLUP(2,2)=501
373 ELSE
374 ICOLUP(2,1)=501
375 ICOLUP(1,2)=501
376 ENDIF
377 ENDIF
378 IBOS=MOD(IDPRUP,100)
379C---LOAD BOSON DATA
380 I=NUP-1
381 J=NUP
382 IF (IBOS.EQ.50) THEN
383 IDUP(I)=24
384 IDUP(J)=-24
385 ELSEIF (IBOS.EQ.60) THEN
386 IDUP(I)=23
387 IDUP(J)=23
388 ELSEIF (IBOS.EQ.70) THEN
389 IDUP(I)=24
390 IDUP(J)=23
391 ELSEIF (IBOS.EQ.80) THEN
392 IDUP(I)=-24
393 IDUP(J)=23
394 ELSE
395 CALL HWWARN('UPEVNT',505,*999)
396 ENDIF
397 ENDIF
398 901 FORMAT(1X,I3,4(1X,I2))
399 902 FORMAT(1X,D14.8)
400 903 FORMAT(8(1X,D14.8))
401 904 FORMAT(12(1X,D14.8))
402 999 END
403C----------------------------------------------------------------------
404 SUBROUTINE UPCODE(ICODE,ICOL)
405C--DECODES COLOUR CONNECTIONS
406C----------------------------------------------------------------------
407 IMPLICIT NONE
408 INTEGER ICODE,ICOL(2)
409 ICOL(1)=ICODE/10
410 IF (ICOL(1).NE.0) ICOL(1)=ICOL(1)+500
411 ICOL(2)=MOD(ICODE,10)
412 IF (ICOL(2).NE.0) ICOL(2)=ICOL(2)+500
413 END
414C----------------------------------------------------------------------
415 SUBROUTINE UPINIT_GUP
416C----------------------------------------------------------------------
417C Reads MC@NLO input headers for heavy quark and gauge boson pair
418C production and fills Les Houches run common HEPRUP
419C----------------------------------------------------------------------
420 INCLUDE 'HERWIG65.INC'
421C--Les Houches Common Blocks
422 INTEGER MAXPUP
423 PARAMETER(MAXPUP=100)
424 INTEGER IDBMUP,PDFGUP,PDFSUP,IDWTUP,NPRUP,LPRUP
425 DOUBLE PRECISION EBMUP,XSECUP,XERRUP,XMAXUP
426 COMMON /HEPRUP/ IDBMUP(2),EBMUP(2),PDFGUP(2),PDFSUP(2),
427 & IDWTUP,NPRUP,XSECUP(MAXPUP),XERRUP(MAXPUP),
428 & XMAXUP(MAXPUP),LPRUP(MAXPUP)
429 INTEGER MAXNUP
430 PARAMETER (MAXNUP=500)
431 INTEGER NUP,IDPRUP,IDUP,ISTUP,MOTHUP,ICOLUP
432 DOUBLE PRECISION XWGTUP,SCALUP,AQEDUP,AQCDUP,PUP,VTIMUP,SPINUP
433 COMMON/HEPEUP/NUP,IDPRUP,XWGTUP,SCALUP,AQEDUP,AQCDUP,
434 & IDUP(MAXNUP),ISTUP(MAXNUP),MOTHUP(2,MAXNUP),
435 & ICOLUP(2,MAXNUP),PUP(5,MAXNUP),VTIMUP(MAXNUP),
436 & SPINUP(MAXNUP)
437 DOUBLE PRECISION XCKECM,XTMP1,XTMP2,XTMP3,XTMP4,XMT,XMW,XMZ,
438 & XMH,XMV,XM1,XM2,XM3,XM4,XM5,XM21,XLAM,GAH,TINY
439 INTEGER IVVCODE,IFAIL,MQQ,NQQ,IHW,I,NDNS,JPR,JPR0,IH
440 CHARACTER*60 TMPSTR
441 CHARACTER*4 STRP1,STRP2
442 CHARACTER*8 STRGRP
443 CHARACTER*2 STRSCH
444 CHARACTER*50 QQIN
445 LOGICAL FK88STRNOEQ
446 DATA TINY/1.D-3/
447 COMMON/NQQCOM/MQQ,NQQ
448 COMMON/VVJIN/QQIN
449C
450 PRINT*,'UPINIT'
451C
452 IF (IERROR.NE.0) RETURN
453C--SET UP INPUT FILES
454 OPEN(UNIT=61,FILE=QQIN,STATUS='UNKNOWN')
455
456 PRINT*,'OPENED ',QQIN
457
458C--READ HEADERS OF EVENT FILE
459 READ(61,801)XCKECM,XTMP1,XTMP2,XTMP3,XTMP4,TMPSTR
460
461 PRINT*,'READ'
462
463 READ(61,802)IVVCODE,TMPSTR
464 IVVCODE=MOD(IVVCODE,10000)
465C---CHECK PROCESS CODE
466 JPR0=MOD(ABS(IPROC),10000)
467 JPR=JPR0/100
468 IF (JPR.NE.IVVCODE/100) CALL HWWARN('UPINIT',500,*999)
469 IF ((JPR.EQ.17.OR.JPR.EQ.28.OR.JPR.EQ.36).AND.
470 & IVVCODE.NE.MOD(ABS(IPROC),10000)) CALL HWWARN('UPINIT',501,*999)
471 IF (JPR.EQ.13.OR.JPR.EQ.14) THEN
472 IF(JPR0.EQ.1396)THEN
473 READ(61,808)EMMIN,EMMAX,TMPSTR
474 ELSE
475 READ(61,809)XMV,GAH,GAMMAX,TMPSTR
476 ENDIF
477C-- CHECK VECTOR BOSON MASS
478 IF( (IVVCODE.EQ.1397.AND.ABS(XMV-RMASS(200)).GT.TINY) .OR.
479 # (IVVCODE.EQ.1497.AND.ABS(XMV-RMASS(198)).GT.TINY) .OR.
480 # (IVVCODE.EQ.1498.AND.ABS(XMV-RMASS(199)).GT.TINY) )
481 # CALL HWWARN('UPINIT',502,*999)
482 ELSEIF (JPR.EQ.28) THEN
483 READ(61,808)XMW,XMZ,TMPSTR
484C-- CHECK VECTOR BOSON MASSES
485 IF(ABS(XMW-RMASS(198)).GT.TINY .OR.
486 # ABS(XMZ-RMASS(200)).GT.TINY) CALL HWWARN('UPINIT',502,*999)
487 ELSEIF (JPR.EQ.16.OR.JPR.EQ.36) THEN
488 READ(61,809)XMH,GAH,XMT,TMPSTR
489C-- CHECK HIGGS AND TOP MASSES
490 IH=201
491 IF (JPR.EQ.36) IH=IVVCODE/10-158
492 IF(ABS(XMH-RMASS(IH)).GT.TINY) CALL HWWARN('UPINIT',503,*999)
493 IF(ABS(XMT-RMASS(6)) .GT.TINY) CALL HWWARN('UPINIT',504,*999)
494 ELSEIF (JPR.EQ.17) THEN
495 READ(61,803)XMT,TMPSTR
496C-- CHECK HEAVY QUARK MASS
497 IF( (IVVCODE.EQ.1706.AND.ABS(XMT-RMASS(6)).GT.TINY) .OR.
498 # (IVVCODE.EQ.1705.AND.ABS(XMT-RMASS(5)).GT.TINY) .OR.
499 # (IVVCODE.EQ.1704.AND.ABS(XMT-RMASS(4)).GT.TINY) ) then
500 print*,' XMT=',XMT
501 print*,' RMASS(5)', RMASS(5)
502 CALL HWWARN('UPINIT',505,*999)
503 endif
504 ELSE
505 CALL HWWARN('UPINIT',506,*999)
506 ENDIF
507 READ(61,804)XM1,XM2,XM3,XM4,XM5,XM21,TMPSTR
508 READ(61,805)STRP1,STRP2,TMPSTR
509 READ(61,806)STRGRP,NDNS,TMPSTR
510 READ(61,807)XLAM,STRSCH,TMPSTR
511C--CHECK THAT EVENT FILE HAS BEEN GENERATED CONSISTENTLY WITH
512C--HERWIG PARAMETERS ADOPTED HERE
513 IFAIL=0
514C-- CM ENERGY
515 IF( ABS(XCKECM-PBEAM1-PBEAM2).GT.TINY .OR.
516C-- QUARK AND GLUON MASSES
517 # ABS(XM1-RMASS(1)).GT.TINY .OR.
518 # ABS(XM2-RMASS(2)).GT.TINY .OR.
519 # ABS(XM3-RMASS(3)).GT.TINY .OR.
520 # ABS(XM4-RMASS(4)).GT.TINY .OR.
521 # ABS(XM5-RMASS(5)).GT.TINY .OR.
522 # ABS(XM21-RMASS(13)).GT.TINY .OR.
523C-- LAMBDA_QCD: NOW REMOVED TO ALLOW MORE FLEXIBILITY (NNLO EFFECT ANYHOW)
524C # ABS(XLAM-QCDLAM).GT.TINY .OR.
525C-- REPLACE THE FOLLOWING WITH A CONDITION ON STRSCH, IF CONSISTENT
526C-- INFORMATION ON PDF SCHEME WILL BE AVAILABLE FROM PDF LIBRARIES AND HERWIG
527C-- COLLIDING PARTICLE TYPE
528 # FK88STRNOEQ(STRP1,PART1) .OR.
529 # FK88STRNOEQ(STRP2,PART2) )IFAIL=1
530C--IF PDF LIBRARY IS USED, CHECK PDF CONSISTENCY
531 IF( IFAIL.EQ.0 .AND. MODPDF(1).NE.-1)THEN
532 IF(
533 # FK88STRNOEQ(STRGRP,AUTPDF(1)) .OR.
534 # FK88STRNOEQ(STRGRP,AUTPDF(2)) .OR.
535 # ABS(NDNS-MODPDF(1)).GT.TINY .OR.
536 # ABS(NDNS-MODPDF(2)).GT.TINY )IFAIL=1
537 ENDIF
538 IF(IFAIL.EQ.1) CALL HWWARN('UPINIT',507,*999)
539 CALL HWUIDT(3,IDBMUP(1),IHW,PART1)
540 CALL HWUIDT(3,IDBMUP(2),IHW,PART2)
541 DO I=1,2
542 EBMUP(I)=HALF*XCKECM
543 PDFGUP(I)=-1
544 PDFSUP(I)=-1
545 ENDDO
546 IDWTUP=-4
547 NPRUP=1
548 LPRUP(1)=IVVCODE
549 READ(61,900) MQQ
550 NQQ=0
551 NUP=6
552 AQEDUP=ZERO
553 AQCDUP=ZERO
554 DO I=1,NUP
555 VTIMUP(I)=ZERO
556 SPINUP(I)=9.
557 ENDDO
558
559 PRINT*,'END OF UPINIT'
560
561 PRINT*,'PDFGUP(1)=',PDFGUP(1)
562 PRINT*,'PDFGUP(2)=',PDFGUP(2)
563
564
565 801 FORMAT(5(1X,D10.4),1X,A)
566 802 FORMAT(1X,I6,1X,A)
567 803 FORMAT(1X,D10.4,1X,A)
568 804 FORMAT(6(1X,D10.4),1X,A)
569 805 FORMAT(2(1X,A4),1X,A)
570 806 FORMAT(1X,A8,1X,I4,1X,A)
571 807 FORMAT(1X,D10.4,1X,A2,1X,A)
572 808 FORMAT(2(1X,D10.4),1X,A)
573 809 FORMAT(3(1X,D10.4),1X,A)
574 900 FORMAT(I9)
575 999 END
576
577