]>
Commit | Line | Data |
---|---|---|
3820ca8e | 1 | |
2 | CDECK ID>, HWURES. | |
3 | ||
4 | *CMZ :- -26/04/91 11.11.56 by Bryan Webber | |
5 | ||
6 | *-- Author : Ian Knowles & Bryan Webber | |
7 | ||
8 | C----------------------------------------------------------------------- | |
9 | ||
10 | SUBROUTINE HWURES | |
11 | ||
12 | C----------------------------------------------------------------------- | |
13 | ||
14 | C Using properties of particle I supplied in HWUDAT checks particles | |
15 | ||
16 | C and antiparticles have compatible properties and sets SWTEF(I) = | |
17 | ||
18 | C ( rep. enhancement factor)^2 - used in cluster decays | |
19 | ||
20 | C Finds iso-flavour hadrons and creates pointers for cluster decays. | |
21 | ||
22 | C Sets CLDKWT(K) =(2J+1) spin weight normalizing largest value to 1. | |
23 | ||
24 | C----------------------------------------------------------------------- | |
25 | ||
26 | INCLUDE 'HERWIG61.INC' | |
27 | ||
28 | INTEGER NMXTMP | |
29 | ||
30 | PARAMETER (NMXTMP=20) | |
31 | ||
32 | DOUBLE PRECISION EPS,WTMX,REMMN,RWTMX,WTMP,RESTMP(91),WTMX2, | |
33 | ||
34 | & REMMN2,WT,CDWTMP(NMXTMP) | |
35 | ||
36 | INTEGER HWUANT,MAPF(89),MAPC(12,12),I,IANT,IABPDG,J,L,N,K,LTMP, | |
37 | ||
38 | & NCDKS,IMN,ITMP,LOCTMP(91),NTMP,NCDTMP(NMXTMP),IMN2 | |
39 | ||
40 | EXTERNAL HWUANT | |
41 | ||
42 | PARAMETER (EPS=1.D-6) | |
43 | ||
44 | DATA MAPF/21,31,41,51,61,12,32,42,52,62,13,23,43,53,63,14,24,34, | |
45 | ||
46 | & 44,54,64,15,25,35,45,55,65,16,26,36,46,56,66,111,112,113,122,123, | |
47 | ||
48 | & 133,222,223,233,333,-111,-112,-113,-122,-123,-133,-222,-223,-233, | |
49 | ||
50 | & -333,114,124,134,224,234,334,-114,-124,-134,-224,-234,-334,115, | |
51 | ||
52 | & 125,135,225,235,335,-115,-125,-135,-225,-235,-335,116,126,136, | |
53 | ||
54 | & 226,236,336,-116,-126,-136,-226,-236,-336/ | |
55 | ||
56 | DATA MAPC/90,1,2,47,45,44,48,46,49,3,4,5,6,90,7,50,47,45,51,48,52, | |
57 | ||
58 | & 8,9,10,11,12,91,51,48,46,52,49,53,13,14,15,37,40,41,6*0,57,69,81, | |
59 | ||
60 | & 35,37,38,6*0,55,67,79,34,35,36,6*0,54,66,78,38,41,42,6*0,58,70, | |
61 | ||
62 | & 82,36,38,39,6*0,56,68,80,39,42,43,6*0,59,71,83,16,17,18,63,61,60, | |
63 | ||
64 | & 64,62,65,19,20,21,22,23,24,75,73,72,76,74,77,25,26,27,28,29,30, | |
65 | ||
66 | & 87,85,84,88,86,89,31,32,33/ | |
67 | ||
68 | C Check particle/anti-particle properties are compatible | |
69 | ||
70 | WRITE(6,10) | |
71 | ||
72 | 10 FORMAT(/10X,'Checking consistency of particle properties'/) | |
73 | ||
74 | DO 20 I=10,NRES | |
75 | ||
76 | IF (IDPDG(I).GT.0) THEN | |
77 | ||
78 | IANT=HWUANT(I) | |
79 | ||
80 | IF (IANT.EQ.20) GOTO 20 | |
81 | ||
82 | IF (MOD(IDPDG(I)/1000,10).EQ.0.AND. | |
83 | ||
84 | & MOD(IDPDG(I)/100 ,10).NE.0) THEN | |
85 | ||
86 | IF (MOD(IFLAV(I)/10-IFLAV(IANT),10).NE.0.OR. | |
87 | ||
88 | & MOD(IFLAV(I)-IFLAV(IANT)/10,10).NE.0) | |
89 | ||
90 | & WRITE(6,30) RNAME(I),IFLAV(I),IFLAV(IANT) | |
91 | ||
92 | ELSE | |
93 | ||
94 | IF (IFLAV(I)+IFLAV(IANT).NE.0) | |
95 | ||
96 | & WRITE(6,30) RNAME(I),IFLAV(I),IFLAV(IANT) | |
97 | ||
98 | ENDIF | |
99 | ||
100 | IF (ICHRG(I)+ICHRG(IANT).NE.0) | |
101 | ||
102 | & WRITE(6,40) RNAME(I),RNAME(IANT),ICHRG(I),ICHRG(IANT) | |
103 | ||
104 | IF (ABS(RMASS(I)-RMASS(IANT)).GT.EPS) | |
105 | ||
106 | & WRITE(6,50) RNAME(I),RMASS(I),RMASS(IANT) | |
107 | ||
108 | IF (ABS(RLTIM(I)-RLTIM(IANT)).GT.EPS) | |
109 | ||
110 | & WRITE(6,60) RNAME(I),RLTIM(I),RLTIM(IANT) | |
111 | ||
112 | IF (ABS(RSPIN(I)-RSPIN(IANT)).GT.EPS) | |
113 | ||
114 | & WRITE(6,70) RNAME(I),RSPIN(I),RSPIN(IANT) | |
115 | ||
116 | ENDIF | |
117 | ||
118 | 20 CONTINUE | |
119 | ||
120 | 30 FORMAT(10X,A8,' flavour code=',I4,5X,' antiparticle=',I4) | |
121 | ||
122 | 40 FORMAT(10X,2A8,' charge =',I2,7X,' antiparticle=',I2) | |
123 | ||
124 | 50 FORMAT(10X,A8,' mass =',F7.3,2X,' antiparticle=',F7.3) | |
125 | ||
126 | 60 FORMAT(10X,A8,' life time =',E9.3,' antiparticle=',E9.3) | |
127 | ||
128 | 70 FORMAT(10X,A8,' spin =',F3.1,6X,' antiparticle=',F3.1) | |
129 | ||
130 | C Compute resonance properties | |
131 | ||
132 | DO 80 I=21,NRES | |
133 | ||
134 | C Compute representation weights for hadrons, used in cluster decays | |
135 | ||
136 | IABPDG=ABS(IDPDG(I)) | |
137 | ||
138 | J=MOD(IABPDG,10) | |
139 | ||
140 | IF (J.EQ.2.AND.MOD(IABPDG/100,10).LT.MOD(IABPDG/10,10)) THEN | |
141 | ||
142 | C Singlet (Lambda-like) baryon | |
143 | ||
144 | SWTEF(I)=SNGWT**2 | |
145 | ||
146 | ELSEIF (J.EQ.4) THEN | |
147 | ||
148 | C Decuplet baryon | |
149 | ||
150 | SWTEF(I)=DECWT**2 | |
151 | ||
152 | ELSEIF(2*(J/2).NE.J) THEN | |
153 | ||
154 | C Mesons: identify by spin, angular momentum & radial excitation | |
155 | ||
156 | J=(J-1)/2 | |
157 | ||
158 | L= MOD(IABPDG/10000 ,10) | |
159 | ||
160 | N= MOD(IABPDG/100000,10) | |
161 | ||
162 | IF (L.EQ.0.AND.J.EQ.0.AND.N.EQ.0.OR. | |
163 | ||
164 | & L.GT.3.OR. J.GT.4.OR .N.GT.4) THEN | |
165 | ||
166 | SWTEF(I)=1. | |
167 | ||
168 | ELSE | |
169 | ||
170 | SWTEF(I)=REPWT(L,J,N)**2 | |
171 | ||
172 | ENDIF | |
173 | ||
174 | ELSE | |
175 | ||
176 | C Not recognized | |
177 | ||
178 | SWTEF(I)=1. | |
179 | ||
180 | ENDIF | |
181 | ||
182 | 80 CONTINUE | |
183 | ||
184 | C Prepare tables for cluster decays, except flavourless light mesons | |
185 | ||
186 | LTMP=1 | |
187 | ||
188 | NCDKS=0 | |
189 | ||
190 | DO 120 I=1,89 | |
191 | ||
192 | C Store particles, flavour MAPF(I), noting highest spin and lowest mass | |
193 | ||
194 | WTMX=0. | |
195 | ||
196 | REMMN=1000. | |
197 | ||
198 | DO 90 J=21,NRES | |
199 | ||
200 | IF (VTOCDK(J).OR.IFLAV(J).NE.MAPF(I)) GOTO 90 | |
201 | ||
202 | NCDKS=NCDKS+1 | |
203 | ||
204 | IF (NCDKS.GT.NMXCDK) CALL HWWARN('HWURES',101,*999) | |
205 | ||
206 | NCLDK(NCDKS)=J | |
207 | ||
208 | CLDKWT(NCDKS)=TWO*RSPIN(J)+ONE | |
209 | ||
210 | IF (CLDKWT(NCDKS).GT.WTMX) WTMX=CLDKWT(NCDKS) | |
211 | ||
212 | IF (RMASS(J).LT.REMMN) THEN | |
213 | ||
214 | REMMN=RMASS(J) | |
215 | ||
216 | IMN=NCDKS | |
217 | ||
218 | ENDIF | |
219 | ||
220 | 90 CONTINUE | |
221 | ||
222 | IF (NCDKS+1-LTMP.EQ.0) THEN | |
223 | ||
224 | WRITE(6,100) MAPF(I) | |
225 | ||
226 | 100 FORMAT(1X,'No particles exist for a cluster with flavour, ',I4, | |
227 | ||
228 | & ' to decay into') | |
229 | ||
230 | CALL HWWARN('HWURES',51,*120) | |
231 | ||
232 | ENDIF | |
233 | ||
234 | C Set scaled spin weights | |
235 | ||
236 | RWTMX=1./WTMX | |
237 | ||
238 | DO 110 J=LTMP,NCDKS | |
239 | ||
240 | 110 CLDKWT(J)=CLDKWT(J)*RWTMX | |
241 | ||
242 | C Swap order if lightest hadron of given flavour not first | |
243 | ||
244 | IF (IMN.NE.LTMP) THEN | |
245 | ||
246 | ITMP=NCLDK(LTMP) | |
247 | ||
248 | WTMP=CLDKWT(LTMP) | |
249 | ||
250 | NCLDK(LTMP)=NCLDK(IMN) | |
251 | ||
252 | CLDKWT(LTMP)=CLDKWT(IMN) | |
253 | ||
254 | NCLDK(IMN)=ITMP | |
255 | ||
256 | CLDKWT(IMN)=WTMP | |
257 | ||
258 | ENDIF | |
259 | ||
260 | C Set pointers etc | |
261 | ||
262 | LOCTMP(I)=LTMP | |
263 | ||
264 | RESTMP(I)=FLOAT(NCDKS+1-LTMP) | |
265 | ||
266 | LTMP=NCDKS+1 | |
267 | ||
268 | 120 CONTINUE | |
269 | ||
270 | C Now do flavourless light mesons, allowing for mixing in weights | |
271 | ||
272 | WTMX=0. | |
273 | ||
274 | REMMN=1000. | |
275 | ||
276 | WTMX2=0. | |
277 | ||
278 | REMMN2=1000. | |
279 | ||
280 | NTMP=0 | |
281 | ||
282 | DO 140 J=21,NRES | |
283 | ||
284 | IF (VTOCDK(J)) THEN | |
285 | ||
286 | GOTO 140 | |
287 | ||
288 | C Calculate mixing weight for (|uubar>+|ddbar>)/sqrt(2) component | |
289 | ||
290 | ELSEIF (IFLAV(J).EQ.11) THEN | |
291 | ||
292 | WT=1. | |
293 | ||
294 | ELSEIF (IFLAV(J).EQ.33) THEN | |
295 | ||
296 | C eta - eta' | |
297 | ||
298 | IF (J.EQ.22 ) THEN | |
299 | ||
300 | WT=COS(ETAMIX*PIFAC/180.+ATAN(SQRT(TWO)))**2 | |
301 | ||
302 | ELSEIF (J.EQ.25 ) THEN | |
303 | ||
304 | WT=SIN(ETAMIX*PIFAC/180.+ATAN(SQRT(TWO)))**2 | |
305 | ||
306 | C phi - omega | |
307 | ||
308 | ELSEIF (J.EQ.56 ) THEN | |
309 | ||
310 | WT=COS(PHIMIX*PIFAC/180.+ATAN(SQRT(TWO)))**2 | |
311 | ||
312 | ELSEIF (J.EQ.24 ) THEN | |
313 | ||
314 | WT=SIN(PHIMIX*PIFAC/180.+ATAN(SQRT(TWO)))**2 | |
315 | ||
316 | C f'_2 - f_2 | |
317 | ||
318 | ELSEIF (J.EQ.58 ) THEN | |
319 | ||
320 | WT=COS(F2MIX *PIFAC/180.+ATAN(SQRT(TWO)))**2 | |
321 | ||
322 | ELSEIF (J.EQ.26 ) THEN | |
323 | ||
324 | WT=SIN(F2MIX *PIFAC/180.+ATAN(SQRT(TWO)))**2 | |
325 | ||
326 | C f_1(1420) - f_1(1285) | |
327 | ||
328 | ELSEIF (J.EQ.57 ) THEN | |
329 | ||
330 | WT=COS(F1MIX *PIFAC/180.+ATAN(SQRT(TWO)))**2 | |
331 | ||
332 | ELSEIF (J.EQ.28 ) THEN | |
333 | ||
334 | WT=SIN(F1MIX *PIFAC/180.+ATAN(SQRT(TWO)))**2 | |
335 | ||
336 | C h_1(1380) - h_1(1170) | |
337 | ||
338 | ELSEIF (J.EQ.289) THEN | |
339 | ||
340 | WT=COS(H1MIX *PIFAC/180.+ATAN(SQRT(TWO)))**2 | |
341 | ||
342 | ELSEIF (J.EQ.288) THEN | |
343 | ||
344 | WT=SIN(H1MIX *PIFAC/180.+ATAN(SQRT(TWO)))**2 | |
345 | ||
346 | C MISSING - f_0(1370) | |
347 | ||
348 | ELSEIF (J.EQ.294) THEN | |
349 | ||
350 | WT=SIN(F0MIX *PIFAC/180.+ATAN(SQRT(TWO)))**2 | |
351 | ||
352 | C phi_3 - omega_3 | |
353 | ||
354 | ELSEIF (J.EQ.396) THEN | |
355 | ||
356 | WT=COS(PH3MIX*PIFAC/180.+ATAN(SQRT(TWO)))**2 | |
357 | ||
358 | ELSEIF (J.EQ.395) THEN | |
359 | ||
360 | WT=SIN(PH3MIX*PIFAC/180.+ATAN(SQRT(TWO)))**2 | |
361 | ||
362 | C eta_2(1645) - eta_2(1870) | |
363 | ||
364 | ELSEIF (J.EQ.397) THEN | |
365 | ||
366 | WT=COS(ET2MIX*PIFAC/180.+ATAN(SQRT(TWO)))**2 | |
367 | ||
368 | ELSEIF (J.EQ.398) THEN | |
369 | ||
370 | WT=SIN(ET2MIX*PIFAC/180.+ATAN(SQRT(TWO)))**2 | |
371 | ||
372 | C MISSING - omega(1600) | |
373 | ||
374 | ELSEIF (J.EQ.399) THEN | |
375 | ||
376 | WT=SIN(OMHMIX*PIFAC/180.+ATAN(SQRT(TWO)))**2 | |
377 | ||
378 | ELSE | |
379 | ||
380 | WT=1./3. | |
381 | ||
382 | WRITE(6,130) J | |
383 | ||
384 | 130 FORMAT(1X,'Isoscalar particle ',I3,' not recognised,', | |
385 | ||
386 | & ' no I=0 mixing assumed') | |
387 | ||
388 | ENDIF | |
389 | ||
390 | ELSE | |
391 | ||
392 | GOTO 140 | |
393 | ||
394 | ENDIF | |
395 | ||
396 | IF (WT.GT.EPS) THEN | |
397 | ||
398 | NCDKS=NCDKS+1 | |
399 | ||
400 | IF (NCDKS.GT.NMXCDK) CALL HWWARN('HWURES',102,*999) | |
401 | ||
402 | NCLDK(NCDKS)=J | |
403 | ||
404 | CLDKWT(NCDKS)=WT*(TWO*RSPIN(J)+ONE) | |
405 | ||
406 | IF (CLDKWT(NCDKS).GT.WTMX) WTMX=CLDKWT(NCDKS) | |
407 | ||
408 | IF (RMASS(J).LT.REMMN) THEN | |
409 | ||
410 | REMMN=RMASS(J) | |
411 | ||
412 | IMN=NCDKS | |
413 | ||
414 | ENDIF | |
415 | ||
416 | ENDIF | |
417 | ||
418 | IF (ONE-WT.GT.EPS) THEN | |
419 | ||
420 | NTMP=NTMP+1 | |
421 | ||
422 | IF (NTMP.GT.NMXTMP) CALL HWWARN('HWURES',103,*999) | |
423 | ||
424 | NCDTMP(NTMP)=J | |
425 | ||
426 | CDWTMP(NTMP)=(ONE-WT)*(TWO*RSPIN(J)+ONE) | |
427 | ||
428 | IF (CDWTMP(NTMP).GT.WTMX2) WTMX2=CDWTMP(NTMP) | |
429 | ||
430 | IF (RMASS(J).LT.REMMN2) THEN | |
431 | ||
432 | REMMN2=RMASS(J) | |
433 | ||
434 | IMN2=NTMP | |
435 | ||
436 | ENDIF | |
437 | ||
438 | ENDIF | |
439 | ||
440 | 140 CONTINUE | |
441 | ||
442 | IF (NCDKS+1-LTMP.EQ.0) THEN | |
443 | ||
444 | WRITE(6,100) 11 | |
445 | ||
446 | CALL HWWARN('HWURES',52,*160) | |
447 | ||
448 | ENDIF | |
449 | ||
450 | C Normalize scaled spin weights | |
451 | ||
452 | RWTMX=1./WTMX | |
453 | ||
454 | DO 150 I=LTMP,NCDKS | |
455 | ||
456 | 150 CLDKWT(I)=CLDKWT(I)*RWTMX | |
457 | ||
458 | C Swap order if lightest hadron of flavour 11 not first | |
459 | ||
460 | IF (IMN.NE.LTMP) THEN | |
461 | ||
462 | ITMP=NCLDK(LTMP) | |
463 | ||
464 | WTMP=CLDKWT(LTMP) | |
465 | ||
466 | NCLDK(LTMP)=NCLDK(IMN) | |
467 | ||
468 | CLDKWT(LTMP)=CLDKWT(IMN) | |
469 | ||
470 | NCLDK(IMN)=ITMP | |
471 | ||
472 | CLDKWT(IMN)=WTMP | |
473 | ||
474 | ENDIF | |
475 | ||
476 | 160 IF (NTMP.EQ.0) THEN | |
477 | ||
478 | WRITE(6,100) 33 | |
479 | ||
480 | CALL HWWARN('HWURES',53,*180) | |
481 | ||
482 | ENDIF | |
483 | ||
484 | IF (NCDKS+NTMP.GT.NMXCDK) CALL HWWARN('HWURES',104,*999) | |
485 | ||
486 | C Store hadrons for |ssbar> channel and normalize their weights | |
487 | ||
488 | RWTMX=1./WTMX2 | |
489 | ||
490 | DO 170 I=1,NTMP | |
491 | ||
492 | J=NCDKS+I | |
493 | ||
494 | NCLDK(J)=NCDTMP(I) | |
495 | ||
496 | 170 CLDKWT(J)=CDWTMP(I)*RWTMX | |
497 | ||
498 | C Swap order if lightest hadron of flavour 33 not first | |
499 | ||
500 | IF (IMN2.NE.1) THEN | |
501 | ||
502 | ITMP=NCLDK(NCDKS+1) | |
503 | ||
504 | WTMP=CLDKWT(NCDKS+1) | |
505 | ||
506 | NCLDK(NCDKS+1)=NCLDK(NCDKS+IMN2) | |
507 | ||
508 | CLDKWT(NCDKS+1)=CLDKWT(NCDKS+IMN2) | |
509 | ||
510 | NCLDK(NCDKS+IMN2)=ITMP | |
511 | ||
512 | CLDKWT(NCDKS+IMN2)=WTMP | |
513 | ||
514 | ENDIF | |
515 | ||
516 | C Set pointers etc | |
517 | ||
518 | 180 LOCTMP(90)=LTMP | |
519 | ||
520 | RESTMP(90)=FLOAT(NCDKS+1-LTMP) | |
521 | ||
522 | LOCTMP(91)=NCDKS+1 | |
523 | ||
524 | RESTMP(91)=FLOAT(NTMP) | |
525 | ||
526 | C Set pointers to hadrons of given flavours for cluster decays | |
527 | ||
528 | DO 190 I=1,12 | |
529 | ||
530 | DO 190 J=1,12 | |
531 | ||
532 | K=MAPC(I,J) | |
533 | ||
534 | IF (K.EQ.0) THEN | |
535 | ||
536 | RMIN(I,J)=RMASS(NCLDK(LOCN(I,2)))+RMASS(NCLDK(LOCN(I,2)))+1.D-2 | |
537 | ||
538 | ELSE | |
539 | ||
540 | LOCN(I,J)=LOCTMP(K) | |
541 | ||
542 | RESN(I,J)=RESTMP(K) | |
543 | ||
544 | RMIN(I,J)=RMASS(NCLDK(LOCN(I,J))) | |
545 | ||
546 | ENDIF | |
547 | ||
548 | 190 CONTINUE | |
549 | ||
550 | 999 END | |
551 | ||
552 | CDECK ID>, HWUROB. | |
553 | ||
554 | *CMZ :- -26/04/91 11.11.56 by Bryan Webber | |
555 | ||
556 | *-- Author : Bryan Webber | |
557 | ||
558 | C----------------------------------------------------------------------- | |
559 | ||
560 | SUBROUTINE HWUROB(R,P,Q) | |
561 | ||
562 | C----------------------------------------------------------------------- | |
563 | ||
564 | C ROTATES VECTORS BY INVERSE OF ROTATION MATRIX R | |
565 | ||
566 | C----------------------------------------------------------------------- | |
567 | ||
568 | DOUBLE PRECISION S1,S2,S3,R(3,3),P(3),Q(3) | |
569 | ||
570 | S1=P(1)*R(1,1)+P(2)*R(2,1)+P(3)*R(3,1) | |
571 | ||
572 | S2=P(1)*R(1,2)+P(2)*R(2,2)+P(3)*R(3,2) | |
573 | ||
574 | S3=P(1)*R(1,3)+P(2)*R(2,3)+P(3)*R(3,3) | |
575 | ||
576 | Q(1)=S1 | |
577 | ||
578 | Q(2)=S2 | |
579 | ||
580 | Q(3)=S3 | |
581 | ||
582 | END |