]>
Commit | Line | Data |
---|---|---|
0795afa3 | 1 | #include "isajet/pilot.h" |
2 | LOGICAL FUNCTION SETTYP(LPRT) | |
3 | C | |
4 | C Set JETTYPE flags and WMODE flags for WPAIR. | |
5 | C Set WMODES and ZMODES flags for secondary W+- and Z0. | |
6 | C Return .FALSE. if no error, .TRUE. otherwise. | |
7 | C | |
8 | C Ver 7.18: Initialize all GOQ to false (limit = MXGOQ) | |
9 | C Use LISTSS for Higgs if GOMSSM | |
10 | C Ver 7.29: SUSY Higgs decays are done in SETHSS and SIGHSS | |
11 | C using LISTSS order, so SUSY list should be used. | |
12 | C I.e., 7.18 fix was wrong. | |
13 | C | |
14 | #if defined(CERNLIB_IMPNONE) | |
15 | IMPLICIT NONE | |
16 | #endif | |
17 | #include "isajet/itapes.inc" | |
18 | #include "isajet/keys.inc" | |
19 | #include "isajet/types.inc" | |
20 | #include "isajet/q1q2.inc" | |
21 | #include "isajet/xmssm.inc" | |
22 | C | |
23 | INTEGER JET,K,I,IW,LPRT | |
24 | INTEGER NLIST | |
25 | CHARACTER*8 WORD,BLANK,LIST(30),LISTW(4),LISTXY(4),LISTSS(85) | |
26 | DATA BLANK/' '/ | |
27 | DATA LIST/'GL','UP','UB','DN','DB','ST','SB','CH','CB','BT','BB', | |
28 | $'TP','TB','NUE','ANUE','E-','E+','NUM','ANUM','MU-','MU+', | |
29 | $'NUT','ANUT','TAU-','TAU+','GM','W+','W-','Z0','HIGGS'/ | |
30 | DATA LISTW/'GM','W+','W-','Z0'/ | |
31 | DATA LISTXY/'Y','YB','X','XB'/ | |
32 | DATA LISTSS/'GLSS', | |
33 | $'UPSSL','UBSSL','DNSSL','DBSSL','STSSL','SBSSL','CHSSL','CBSSL', | |
34 | $'BTSS1','BBSS1','TPSS1','TBSS1', | |
35 | $'UPSSR','UBSSR','DNSSR','DBSSR','STSSR','SBSSR','CHSSR','CBSSR', | |
36 | $'BTSS2','BBSS2','TPSS2','TBSS2', | |
37 | $'W1SS+','W1SS-','W2SS+','W2SS-','Z1SS','Z2SS','Z3SS','Z4SS', | |
38 | $'NUEL','ANUEL','EL-','EL+','NUML','ANUML','MUL-','MUL+', | |
39 | $'NUTL','ANUTL','TAU1-','TAU1+','ER-','ER+','MUR-','MUR+', | |
40 | $'TAU2-','TAU2+', | |
41 | $'GL','UP','UB','DN','DB','ST','SB','CH','CB','BT','BB', | |
42 | $'TP','TB','NUE','ANUE','E-','E+','NUM','ANUM','MU-','MU+', | |
43 | $'NUT','ANUT','TAU-','TAU+','GM','W+','W-','Z0', | |
44 | $'HL0','HH0','HA0','H+','H-'/ | |
45 | C | |
46 | SETTYP=.FALSE. | |
47 | C | |
48 | IF(KEYS(5)) GO TO 5 | |
49 | IF(KEYS(2).AND.GOMSSM) GO TO 5 | |
50 | IF(KEYS(6).OR.KEYS(9)) GO TO 6 | |
51 | IF(KEYS(7).AND..NOT.GOMSSM) GO TO 7 | |
52 | IF(KEYS(7).AND.GOMSSM) GO TO 5 | |
53 | IF(KEYS(10).AND.GOMSSM) GO TO 5 | |
54 | C | |
55 | C JETTYPE flags all processes except WPAIR and HIGGS. | |
56 | C NJTTYP is set in READIN to number of non-blank values read. | |
57 | C Check for legal jet type names and set appropriate flags. | |
58 | C | |
59 | DO 1000 JET=1,MXGOJ | |
60 | IF(NJTTYP(JET).EQ.0) GO TO 1000 | |
61 | C Initialize everything to .FALSE. | |
62 | GOALL(JET)=.FALSE. | |
63 | DO 1100 K=1,MXGOQ | |
64 | GOQ(K,JET)=.FALSE. | |
65 | 1100 CONTINUE | |
66 | C Loop over non-blank JETTYPE entries | |
67 | DO 1200 I=1,NJTTYP(JET) | |
68 | WORD=JETYP(I,JET) | |
69 | C Blank | |
70 | IF(WORD.EQ.BLANK) THEN | |
71 | GO TO 1200 | |
72 | ENDIF | |
73 | C All | |
74 | IF(WORD.EQ.'ALL ') THEN | |
75 | GOALL(JET)=.TRUE. | |
76 | DO 1210 K=1,MXGOQ | |
77 | 1210 GOQ(K,JET)=.TRUE. | |
78 | GO TO 1000 | |
79 | ENDIF | |
80 | C Quarks | |
81 | IF(WORD.EQ.'QUARKS ') THEN | |
82 | DO 1220 K=2,13 | |
83 | 1220 GOQ(K,JET)=.TRUE. | |
84 | GO TO 1200 | |
85 | ENDIF | |
86 | C Charged leptons | |
87 | IF(WORD.EQ.'LEPTONS ') THEN | |
88 | DO 1230 K=16,24,4 | |
89 | GOQ(K,JET)=.TRUE. | |
90 | 1230 GOQ(K+1,JET)=.TRUE. | |
91 | GO TO 1200 | |
92 | ENDIF | |
93 | C Neutrinos | |
94 | IF(WORD.EQ.'NUS ') THEN | |
95 | DO 1240 K=14,22,4 | |
96 | GOQ(K,JET)=.TRUE. | |
97 | 1240 GOQ(K+1,JET)=.TRUE. | |
98 | GO TO 1200 | |
99 | ENDIF | |
100 | C Explicit types | |
101 | C E+E- now also contains W+, W-, Z0 | |
102 | IF(KEYS(10).OR.KEYS(11).OR.KEYS(12)) THEN | |
103 | NLIST=30 | |
104 | ELSE IF(KEYS(2)) THEN | |
105 | NLIST=29 | |
106 | ELSE | |
107 | NLIST=25 | |
108 | ENDIF | |
109 | DO 1250 K=1,NLIST | |
110 | IF(WORD.EQ.LIST(K)) THEN | |
111 | GOQ(K,JET)=.TRUE. | |
112 | GO TO 1200 | |
113 | ENDIF | |
114 | 1250 CONTINUE | |
115 | C Special types for TWOJET | |
116 | DO 1270 K=1,4 | |
117 | IF(KEYS(1).AND.WORD.EQ.LISTXY(K)) THEN | |
118 | GOQ(13+K,JET)=.TRUE. | |
119 | GO TO 1200 | |
120 | ENDIF | |
121 | 1270 CONTINUE | |
122 | C Special type for PHOTON | |
123 | IF(KEYS(8).AND.WORD.EQ.LISTW(1)) THEN | |
124 | GOQ(26,JET)=.TRUE. | |
125 | GO TO 1200 | |
126 | ENDIF | |
127 | C Error | |
128 | WRITE(ITLIS,1300) WORD,JET | |
129 | 1300 FORMAT(1X,A8,' IS NOT RECOGNIZABLE FOR JETTYPE',I1) | |
130 | SETTYP=.TRUE. | |
131 | 1200 CONTINUE | |
132 | 1000 CONTINUE | |
133 | GO TO 4000 | |
134 | C | |
135 | C JETTYPE flags for SUSY | |
136 | C | |
137 | 5 DO 5000 JET=1,2 | |
138 | IF(NJTTYP(JET).EQ.0) GO TO 5000 | |
139 | GOALL(JET)=.FALSE. | |
140 | DO 5100 K=1,MXGOQ | |
141 | 5100 GOQ(K,JET)=.FALSE. | |
142 | DO 5200 I=1,NJTTYP(JET) | |
143 | WORD=JETYP(I,JET) | |
144 | C Blank | |
145 | IF(WORD.EQ.BLANK) THEN | |
146 | GO TO 5200 | |
147 | ENDIF | |
148 | C All | |
149 | IF(WORD.EQ.'ALL ') THEN | |
150 | GOALL(JET)=.TRUE. | |
151 | DO 5210 K=1,85 | |
152 | 5210 GOQ(K,JET)=.TRUE. | |
153 | GO TO 5000 | |
154 | ENDIF | |
155 | C Squarks | |
156 | IF(WORD.EQ.'SQUARKS ') THEN | |
157 | DO 5220 K=2,25 | |
158 | 5220 GOQ(K,JET)=.TRUE. | |
159 | GO TO 5200 | |
160 | ENDIF | |
161 | C Gauginos | |
162 | IF(WORD.EQ.'GAUGINOS') THEN | |
163 | DO 5230 K=26,33 | |
164 | 5230 GOQ(K,JET)=.TRUE. | |
165 | GO TO 5200 | |
166 | ENDIF | |
167 | C Sleptons | |
168 | IF(WORD.EQ.'SLEPTONS') THEN | |
169 | DO 5240 K=34,51 | |
170 | 5240 GOQ(K,JET)=.TRUE. | |
171 | GO TO 5200 | |
172 | ENDIF | |
173 | C Explicit susy types | |
174 | DO 5300 K=1,85 | |
175 | IF(WORD.EQ.LISTSS(K)) THEN | |
176 | GOQ(K,JET)=.TRUE. | |
177 | GO TO 5200 | |
178 | ENDIF | |
179 | 5300 CONTINUE | |
180 | 5200 CONTINUE | |
181 | 5000 CONTINUE | |
182 | GO TO 4000 | |
183 | C | |
184 | C JETTYPE and WMODE flags for WPAIR | |
185 | C NJTTYP and NWWTYP are the number of non-blank values. | |
186 | C | |
187 | 6 DO 2000 JET=1,2 | |
188 | IF(NJTTYP(JET).EQ.0) GO TO 2300 | |
189 | C Initialize to FALSE | |
190 | GOALL(JET)=.FALSE. | |
191 | DO 2100 K=1,4 | |
192 | 2100 GOQ(K,JET)=.FALSE. | |
193 | C | |
194 | C Loop over non-blank JETTYPE flags | |
195 | C | |
196 | DO 2200 I=1,NJTTYP(JET) | |
197 | WORD=JETYP(I,JET) | |
198 | C Blank | |
199 | IF(WORD.EQ.BLANK) THEN | |
200 | GO TO 2200 | |
201 | ENDIF | |
202 | C All | |
203 | IF(WORD.EQ.'ALL ') THEN | |
204 | GOALL(JET)=.TRUE. | |
205 | DO 2210 K=1,4 | |
206 | 2210 GOQ(K,JET)=.TRUE. | |
207 | GO TO 2300 | |
208 | ENDIF | |
209 | C Explicit types | |
210 | DO 2220 K=1,4 | |
211 | IF(WORD.EQ.LISTW(K)) THEN | |
212 | GOQ(K,JET)=.TRUE. | |
213 | GO TO 2200 | |
214 | ENDIF | |
215 | 2220 CONTINUE | |
216 | C Error | |
217 | WRITE(ITLIS,1300) WORD,JET | |
218 | SETTYP=.TRUE. | |
219 | 2200 CONTINUE | |
220 | C | |
221 | C Loop over nonblank WMODE flags | |
222 | C | |
223 | 2300 IF(NWWTYP(JET).EQ.0) GO TO 2000 | |
224 | ALLWW(JET)=.FALSE. | |
225 | C Initialize everything to FALSE | |
226 | DO 2350 K=1,25 | |
227 | 2350 GOWW(K,JET)=.FALSE. | |
228 | C | |
229 | DO 2400 I=1,NWWTYP(JET) | |
230 | WORD=WWTYP(I,JET) | |
231 | IF(WORD.NE.BLANK) NWWTYP(JET)=I | |
232 | C Blank | |
233 | IF(WORD.EQ.BLANK) THEN | |
234 | GO TO 2400 | |
235 | ENDIF | |
236 | C All | |
237 | IF(WORD.EQ.'ALL ') THEN | |
238 | ALLWW(JET)=.TRUE. | |
239 | DO 2410 K=1,25 | |
240 | 2410 GOWW(K,JET)=.TRUE. | |
241 | GO TO 2000 | |
242 | ENDIF | |
243 | C Quarks | |
244 | IF(WORD.EQ.'QUARKS ') THEN | |
245 | DO 2420 K=2,13 | |
246 | 2420 GOWW(K,JET)=.TRUE. | |
247 | GO TO 2400 | |
248 | ENDIF | |
249 | C Charged leptons | |
250 | IF(WORD.EQ.'LEPTONS ') THEN | |
251 | DO 2430 K=16,24,4 | |
252 | GOWW(K,JET)=.TRUE. | |
253 | 2430 GOWW(K+1,JET)=.TRUE. | |
254 | GO TO 2400 | |
255 | ENDIF | |
256 | C Neutrinos | |
257 | IF(WORD.EQ.'NUS ') THEN | |
258 | DO 2440 K=14,22,4 | |
259 | GOWW(K,JET)=.TRUE. | |
260 | 2440 GOWW(K+1,JET)=.TRUE. | |
261 | GO TO 2400 | |
262 | ENDIF | |
263 | C Explicit types | |
264 | DO 2450 K=1,25 | |
265 | IF(WORD.EQ.LIST(K)) THEN | |
266 | GOWW(K,JET)=.TRUE. | |
267 | GO TO 2400 | |
268 | ENDIF | |
269 | 2450 CONTINUE | |
270 | C Error | |
271 | WRITE(ITLIS,2500) WORD,JET | |
272 | 2500 FORMAT(1X,A8,' IS NOT A VALID CODE FOR WMODE',I1) | |
273 | SETTYP=.TRUE. | |
274 | 2400 CONTINUE | |
275 | 2000 CONTINUE | |
276 | GO TO 4000 | |
277 | C | |
278 | C JETTYPE and WMODE flags for HIGGS | |
279 | C SUSY HIGGS uses LISTSS order and hence SUSY part | |
280 | C | |
281 | 7 DO 3000 JET=1,2 | |
282 | IF(NJTTYP(JET).EQ.0) GO TO 3300 | |
283 | C Initialize to FALSE | |
284 | GOALL(JET)=.FALSE. | |
285 | DO 3100 K=1,MXGOQ | |
286 | 3100 GOQ(K,JET)=.FALSE. | |
287 | C | |
288 | C Loop over non-blank JETTYPE flags | |
289 | C | |
290 | DO 3200 I=1,NJTTYP(JET) | |
291 | WORD=JETYP(I,JET) | |
292 | C Blank | |
293 | IF(WORD.EQ.BLANK) THEN | |
294 | GO TO 3200 | |
295 | ENDIF | |
296 | C All | |
297 | IF(WORD.EQ.'ALL ') THEN | |
298 | GOALL(JET)=.TRUE. | |
299 | DO 3210 K=1,MXGOQ | |
300 | 3210 GOQ(K,JET)=.TRUE. | |
301 | GO TO 3300 | |
302 | ENDIF | |
303 | C Quarks | |
304 | IF(WORD.EQ.'QUARKS ') THEN | |
305 | DO 3220 K=2,13 | |
306 | 3220 GOQ(K,JET)=.TRUE. | |
307 | GO TO 3200 | |
308 | ENDIF | |
309 | C Charged leptons | |
310 | IF(WORD.EQ.'LEPTONS ') THEN | |
311 | DO 3240 K=16,24,4 | |
312 | GOQ(K,JET)=.TRUE. | |
313 | 3240 GOQ(K+1,JET)=.TRUE. | |
314 | GO TO 3200 | |
315 | ENDIF | |
316 | DO 3250 K=1,85 | |
317 | IF(WORD.EQ.LIST(K)) THEN | |
318 | GOQ(K,JET)=.TRUE. | |
319 | GO TO 3200 | |
320 | ENDIF | |
321 | 3250 CONTINUE | |
322 | C Error | |
323 | WRITE(ITLIS,1300) WORD,JET | |
324 | SETTYP=.TRUE. | |
325 | 3200 CONTINUE | |
326 | C | |
327 | C Loop over nonblank WMODE flags | |
328 | C | |
329 | 3300 IF(NWWTYP(JET).EQ.0) GO TO 3000 | |
330 | ALLWW(JET)=.FALSE. | |
331 | C Initialize everything to FALSE | |
332 | DO 3350 K=1,25 | |
333 | 3350 GOWW(K,JET)=.FALSE. | |
334 | C | |
335 | DO 3400 I=1,NWWTYP(JET) | |
336 | WORD=WWTYP(I,JET) | |
337 | IF(WORD.NE.BLANK) NWWTYP(JET)=I | |
338 | C Blank | |
339 | IF(WORD.EQ.BLANK) THEN | |
340 | GO TO 3400 | |
341 | ENDIF | |
342 | C All | |
343 | IF(WORD.EQ.'ALL ') THEN | |
344 | ALLWW(JET)=.TRUE. | |
345 | DO 3410 K=1,25 | |
346 | 3410 GOWW(K,JET)=.TRUE. | |
347 | GO TO 3000 | |
348 | ENDIF | |
349 | C Quarks | |
350 | IF(WORD.EQ.'QUARKS ') THEN | |
351 | DO 3420 K=2,13 | |
352 | 3420 GOWW(K,JET)=.TRUE. | |
353 | GO TO 3400 | |
354 | ENDIF | |
355 | C Charged leptons | |
356 | IF(WORD.EQ.'LEPTONS ') THEN | |
357 | DO 3430 K=16,24,4 | |
358 | GOWW(K,JET)=.TRUE. | |
359 | 3430 GOWW(K+1,JET)=.TRUE. | |
360 | GO TO 3400 | |
361 | ENDIF | |
362 | C Neutrinos | |
363 | IF(WORD.EQ.'NUS ') THEN | |
364 | DO 3440 K=14,22,4 | |
365 | GOWW(K,JET)=.TRUE. | |
366 | 3440 GOWW(K+1,JET)=.TRUE. | |
367 | GO TO 3400 | |
368 | ENDIF | |
369 | C Explicit types | |
370 | DO 3450 K=1,25 | |
371 | IF(WORD.EQ.LIST(K)) THEN | |
372 | GOWW(K,JET)=.TRUE. | |
373 | GO TO 3400 | |
374 | ENDIF | |
375 | 3450 CONTINUE | |
376 | C Error | |
377 | WRITE(ITLIS,2500) WORD,JET | |
378 | 3500 FORMAT(1X,A8,' IS NOT A VALID CODE FOR WMODE',I1) | |
379 | SETTYP=.TRUE. | |
380 | 3400 CONTINUE | |
381 | 3000 CONTINUE | |
382 | C | |
383 | C Set WMODES and ZMODES flags for secondary W+- and Z0 | |
384 | C | |
385 | 4000 DO 4100 IW=1,3 | |
386 | IF(NWMODE(IW).EQ.0) GO TO 4100 | |
387 | C Initialize everything to .FALSE. | |
388 | DO 4200 K=1,25 | |
389 | 4200 GOWMOD(K,IW)=.FALSE. | |
390 | C Loop over non-blank WMODE entries | |
391 | DO 4300 I=1,NWMODE(IW) | |
392 | WORD=WMODES(I,IW) | |
393 | C Blank | |
394 | IF(WORD.EQ.BLANK) THEN | |
395 | GO TO 4300 | |
396 | ENDIF | |
397 | C All | |
398 | IF(WORD.EQ.'ALL ') THEN | |
399 | DO 4310 K=1,25 | |
400 | 4310 GOWMOD(K,IW)=.TRUE. | |
401 | GO TO 4100 | |
402 | ENDIF | |
403 | C Quarks | |
404 | IF(WORD.EQ.'QUARKS ') THEN | |
405 | DO 4320 K=2,13 | |
406 | 4320 GOWMOD(K,IW)=.TRUE. | |
407 | GO TO 4300 | |
408 | ENDIF | |
409 | C Charged leptons | |
410 | IF(WORD.EQ.'LEPTONS ') THEN | |
411 | DO 4330 K=16,24,4 | |
412 | GOWMOD(K,IW)=.TRUE. | |
413 | 4330 GOWMOD(K+1,IW)=.TRUE. | |
414 | GO TO 4300 | |
415 | ENDIF | |
416 | C Neutrinos | |
417 | IF(WORD.EQ.'NUS ') THEN | |
418 | DO 4340 K=14,22,4 | |
419 | GOWMOD(K,IW)=.TRUE. | |
420 | 4340 GOWMOD(K+1,IW)=.TRUE. | |
421 | GO TO 4300 | |
422 | ENDIF | |
423 | C Explicit types | |
424 | DO 4350 K=1,25 | |
425 | IF(WORD.EQ.LIST(K)) THEN | |
426 | GOWMOD(K,IW)=.TRUE. | |
427 | GO TO 4300 | |
428 | ENDIF | |
429 | 4350 CONTINUE | |
430 | C Error | |
431 | WRITE(ITLIS,4380) WORD | |
432 | 4380 FORMAT(1X,A8,' IS NOT RECOGNIZABLE FOR SECONDARY WS') | |
433 | SETTYP=.TRUE. | |
434 | 4300 CONTINUE | |
435 | 4100 CONTINUE | |
436 | C | |
437 | C Loop over nonblank WMODE flags FOR WHIGGS | |
438 | C | |
439 | IF (KEYS(10)) THEN | |
440 | DO 6000 JET=1,2 | |
441 | 6300 IF(NWWTYP(JET).EQ.0) GO TO 6000 | |
442 | ALLWW(JET)=.FALSE. | |
443 | C Initialize everything to FALSE | |
444 | DO 6350 K=1,25 | |
445 | 6350 GOWW(K,JET)=.FALSE. | |
446 | C | |
447 | DO 6400 I=1,NWWTYP(JET) | |
448 | WORD=WWTYP(I,JET) | |
449 | IF(WORD.NE.BLANK) NWWTYP(JET)=I | |
450 | C Blank | |
451 | IF(WORD.EQ.BLANK) THEN | |
452 | GO TO 6400 | |
453 | ENDIF | |
454 | C All | |
455 | IF(WORD.EQ.'ALL ') THEN | |
456 | ALLWW(JET)=.TRUE. | |
457 | DO 6410 K=1,25 | |
458 | 6410 GOWW(K,JET)=.TRUE. | |
459 | GO TO 6000 | |
460 | ENDIF | |
461 | C Quarks | |
462 | IF(WORD.EQ.'QUARKS ') THEN | |
463 | DO 6420 K=2,13 | |
464 | 6420 GOWW(K,JET)=.TRUE. | |
465 | GO TO 6400 | |
466 | ENDIF | |
467 | C Charged leptons | |
468 | IF(WORD.EQ.'LEPTONS ') THEN | |
469 | DO 6430 K=16,24,4 | |
470 | GOWW(K,JET)=.TRUE. | |
471 | 6430 GOWW(K+1,JET)=.TRUE. | |
472 | GO TO 6400 | |
473 | ENDIF | |
474 | C Neutrinos | |
475 | IF(WORD.EQ.'NUS ') THEN | |
476 | DO 6440 K=14,22,4 | |
477 | GOWW(K,JET)=.TRUE. | |
478 | 6440 GOWW(K+1,JET)=.TRUE. | |
479 | GO TO 6400 | |
480 | ENDIF | |
481 | C Explicit types | |
482 | DO 6450 K=1,25 | |
483 | IF(WORD.EQ.LIST(K)) THEN | |
484 | GOWW(K,JET)=.TRUE. | |
485 | GO TO 6400 | |
486 | ENDIF | |
487 | 6450 CONTINUE | |
488 | C Error | |
489 | WRITE(ITLIS,6500) WORD,JET | |
490 | 6500 FORMAT(1X,A8,' IS NOT A VALID CODE FOR WMODE',I1) | |
491 | SETTYP=.TRUE. | |
492 | 6400 CONTINUE | |
493 | 6000 CONTINUE | |
494 | END IF | |
495 | RETURN | |
496 | END |