]> git.uio.no Git - u/mrichter/AliRoot.git/blame - GEANT321/fluka/hadevv.F
git://git.uio.no / u / mrichter / AliRoot.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Bugfix in AliPoints2Memory
[u/mrichter/AliRoot.git] / GEANT321 / fluka / hadevv.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.1.1.1 1995/10/24 10:19:56 cernlib
6* Geant
7*
8*
9#include "geant321/pilot.h"
10*CMZ : 3.21/02 29/03/94 15.41.43 by S.Giani
11*-- Author :
12*$ CREATE HADEVV.FOR
13*COPY HADEVV
14*
15*=== hadevv ===========================================================*
16*
17 SUBROUTINE HADEVV ( NHAD, KPROJ, KTARG, PPROJ, EPROJ, UMO )
18
19#include "geant321/dblprc.inc"
20#include "geant321/dimpar.inc"
21#include "geant321/iounit.inc"
22*
23*----------------------------------------------------------------------*
24* *
25* Modified version of Hadevt created by Alfredo Ferrari, INFN-Milan *
26* *
27* Last change on 20-jun-93 by Alfredo Ferrari, INFN - MIlan *
28* *
29* Hadevt90: kinematics completed revised by A. Ferrari, before it was *
30* always wrong every time the second jet to be sampled was *
31* a "parjet". A few other bugs corrected: maybe others are *
32* still in!!! *
33*----------------------------------------------------------------------*
34*
35C
36C GENERATE HADRON PRODC
37C GENERATE HADRON PRODUCTION EVENT IN KPROJ - KTARG COLLISION
38C WITH LAB PROJECTILE MOMENTUM PPROJ
39C INCLUDING MESON MESON AND MESON ANTIBARYON COLLISIONS
40C
41C********************************************************************
42C
43#include "geant321/auxpar.inc"
44#include "geant321/balanc.inc"
45#include "geant321/cmsres.inc"
46#include "geant321/finpar.inc"
47#include "geant321/hadpar.inc"
48#include "geant321/inpdat2.inc"
49#include "geant321/part.inc"
50#include "geant321/qquark.inc"
51 COMMON /FKINVT/PNUC(3),INUCVT
52 COMMON /FKPRIN/ IPRI, INIT
53 REAL RNDM(2)
54 LOGICAL LISSU, LQTARG, LQPROJ
55*
56 SAVE UNON,UNOM,UNOMS
57 DATA UNON/2.0D0/
58 DATA UNOM/1.5D0/
59 DATA UNOMS/0.5D0/
60*
61C
62C*******************************************************************"
63C
64C KINEMATICS
65C
66C********************************************************************
67C
68 8899 CONTINUE
69* Ijproj = paprop numbering
70 IJPROJ = KPTOIP (KPROJ)
71 IJTARG = KPTOIP (KTARG)
72 AMPROJ = AM(KPROJ)
73 AMTAR = AM(KTARG)
74* The usual gamma and sqrt[beta**2/(1-beta**2)]=eta=gamma*beta factors
75* for the CMS system
76*
77 GAMCM = (EPROJ+AMTAR)/UMO
78 BGCM = PPROJ / UMO
79C
80*or IF(IPRI.EQ.1) WRITE(LUNOUT,101)KPROJ,KTARG,PPROJ,AMPROJ,AMTAR,
81*or &EPROJ,UMO,GAMCM,BGCM
82*or 101 FORMAT(2I5,10F11.5)
83C
84C********************************************************************
85C
86C SELECTION OF QUARK - DIQUARK - CHAINS
87C
88C********************************************************************
89C
90*
91* Ibproj = baryonic charge of the projectile
92*
93 IBPROJ = IBAR(KPROJ)
94*
95* Ibtarg = baryonic charge of the target nucleon
96*
97 IBTARG = IBAR(KTARG)
98*
99* Ipq1,ipq2,ipq3 = quarks of the projectile
100*
101 IQP1 = MQUARK(1,IJPROJ)
102 IQP2 = MQUARK(2,IJPROJ)
103 IQP3 = MQUARK(3,IJPROJ)
104*
105* Iqt1,iqt2,iqt3 = quarks of the projectile
106*
107 IQT1 = MQUARK(1,IJTARG)
108 IQT2 = MQUARK(2,IJTARG)
109 IQT3 = MQUARK(3,IJTARG)
110*or IF (IPRI .EQ. 1)
111*or &WRITE(LUNOUT,102)IBPROJ, IQP1,IQP2,IQP3,IQT1,IQT2,
112*or &IQT3
113*or 102 FORMAT(12I10)
114 IF (IBPROJ) 11, 12, 13
115 11 CONTINUE
116C
117C********************************************************************
118C
119C SELECTION OF CHAINS
120C ANTIBARYON - BARYON COLLISION
121C
122C********************************************************************
123C
124* +-------------------------------------------------------------------*
125* | The incoming projectile is an antibaryon!!!
126* |
127 CALL GRNDM(RNDM,1)
128 ISAM1 = 1.D0 + 3.D0*RNDM(1)
129 GO TO (111,112,113),ISAM1
130 111 CONTINUE
131 IBF = IQP1
132 IFF1 = IQP2
133 IFF2 = IQP3
134 GO TO 114
135 112 CONTINUE
136 IBF = IQP2
137 IFF1 = IQP1
138 IFF2 = IQP3
139 GO TO 114
140 113 CONTINUE
141 IBF = IQP3
142 IFF1 = IQP1
143 IFF2 = IQP2
144 114 CONTINUE
145 CALL GRNDM(RNDM,1)
146 ISAM2 = 1.D0 + 3.D0*RNDM(1)
147 GO TO (115,116,117),ISAM2
148 115 CONTINUE
149 IBB = IQT1
150 IFB1 = IQT2
151 IFB2 = IQT3
152 GO TO 118
153 116 CONTINUE
154 IBB = IQT2
155 IFB1 = IQT1
156 IFB2 = IQT3
157 GO TO 118
158 117 CONTINUE
159 IBB = IQT3
160 IFB1 = IQT1
161 IFB2 = IQT2
162 118 CONTINUE
163 GO TO 14
164* | Quark selection for incoming antibaryon has been completed
165* +-->-->-->-->-->-->-->-->-->--> go to 14 continue
166
167 12 CONTINUE
168* +-------------------------------------------------------------------*
169* | The incoming projectile is a meson!!!
170* |
171 IF (IBTARG)712,812,912
172* | +----------------------------------------------------------------*
173* | | The target nucleon is a baryon (meson projectile)
174* | |
175 912 CONTINUE
176C
177C********************************************************************
178C
179C SELECTION OF CHAINS
180C MESON - BARYON COLLISION
181C
182C********************************************************************
183C
184 CALL GRNDM(RNDM,1)
185 ISAM3 = 1.D0 + 2.D0*RNDM(1)
186 GO TO (121,122),ISAM3
187 121 CONTINUE
188 IFF = IQP1
189 IBF = IQP2
190 GO TO 123
191 122 CONTINUE
192 IFF = IQP2
193 IBF = IQP1
194 123 CONTINUE
195 CALL GRNDM(RNDM,1)
196 ISAM4 = 1.D0 + 3.D0*RNDM(1)
197 GO TO (124,125,126),ISAM4
198 124 CONTINUE
199 GO TO (1241,1242),ISAM3
2001241 CONTINUE
201 IBB = IQT1
202 IFB1 = IQT2
203 IFB2 = IQT3
204 GO TO 127
2051242 CONTINUE
206 IBB1 = IQT2
207 IBB2 = IQT3
208 IFB = IQT1
209 GO TO 127
210 125 CONTINUE
211 GO TO (1251,1252),ISAM3
2121251 CONTINUE
213 IBB = IQT2
214 IFB1 = IQT1
215 IFB2 = IQT3
216 GO TO 127
2171252 CONTINUE
218 IBB1 = IQT1
219 IBB2 = IQT3
220 IFB = IQT2
221 GO TO 127
222 126 CONTINUE
223 GO TO (1261,1262),ISAM3
2241261 CONTINUE
225 IBB = IQT3
226 IFB1 = IQT1
227 IFB2 = IQT2
228 GO TO 127
2291262 CONTINUE
230 IBB1 = IQT1
231 IBB2 = IQT2
232 IFB = IQT3
233 127 CONTINUE
234 GO TO 14
235* | | Quark selection for incoming meson and baryon target completed
236* | +-->-->-->-->-->-->-->-->-->--> go to 114 continue
237
238* | +----------------------------------------------------------------*
239* | | The target nucleon is a meson (meson projectile)
240* | |
241 812 CONTINUE
242C===============================================================
243C
244C SELECTION OF CHAINS
245C MESON MESON COLLISIONS
246C
247C================================================================
248 CALL GRNDM(RNDM,1)
249 ISAM3 = 1.D0 + 2.D0*RNDM(1)
250 GO TO (1218,1228),ISAM3
2511218 CONTINUE
252 IFF = IQP1
253 IBF = IQP2
254 IBB = IQT1
255 IFB = IQT2
256 GO TO 1238
2571228 CONTINUE
258 IFF = IQP2
259 IBF = IQP1
260 IBB = IQT2
261 IFB = IQT1
2621238 CONTINUE
263 GO TO 14
264* | | Quark selection for incoming meson and meson target completed
265* | +-->-->-->-->-->-->-->-->-->--> go to 14 continue
266
267* | +----------------------------------------------------------------*
268* | | The target nucleon is an anti-baryon (meson projectile)
269* | |
270 712 CONTINUE
271C=================================================================
272C
273C SELECTION OF CHAINS
274C MESON ANTIBARYON COLLISIONS
275C
276C==================================================================
277 ISAM3 = 2
278 IFF = IQP1
279 IBF = IQP2
280 CALL GRNDM(RNDM,1)
281 ISAM4 = 1.D0 + 3.D0*RNDM(1)
282 GO TO (1247,1257,1267),ISAM4
2831247 CONTINUE
284 GO TO (12417,12427),ISAM3
28512417 CONTINUE
286 IBB = IQT1
287 IFB1 = IQT2
288 IFB2 = IQT3
289 GO TO 1277
29012427 CONTINUE
291 IBB1 = IQT2
292 IBB2 = IQT3
293 IFB = IQT1
294 GO TO 1277
2951257 CONTINUE
296 GO TO (12517,12527),ISAM3
29712517 CONTINUE
298 IBB = IQT2
299 IFB1 = IQT1
300 IFB2 = IQT3
301 GO TO 1277
30212527 CONTINUE
303 IBB1 = IQT1
304 IBB2 = IQT3
305 IFB = IQT2
306 GO TO 1277
3071267 CONTINUE
308 GO TO (12617,12627),ISAM3
30912617 CONTINUE
310 IBB = IQT3
311 IFB1 = IQT1
312 IFB2 = IQT2
313 GO TO 1277
31412627 CONTINUE
315 IBB1 = IQT1
316 IBB2 = IQT2
317 IFB = IQT3
3181277 CONTINUE
319 GO TO 14
320* | | Quark selection for incoming meson and a-baryon target completed
321* | +-->-->-->-->-->-->-->-->-->--> go to 14 continue
322* |
323* | end meson projectile
324* +-------------------------------------------------------------------*
325
326* +-------------------------------------------------------------------*
327* | The incoming projectile is a baryon!!!
328* |
329 13 CONTINUE
330C
331C********************************************************************
332C
333C SELECTION OF CHAINS
334C BARYON - BARYON COLLISION
335C
336C********************************************************************
337C
338 CALL GRNDM(RNDM,1)
339 ISAM5 = 1.D0 + 3.D0*RNDM(1)
340 GO TO (131,132,133),ISAM5
341 131 CONTINUE
342 IBF = IQP1
343 IFF1 = IQP2
344 IFF2 = IQP3
345 GO TO 134
346 132 CONTINUE
347 IBF = IQP2
348 IFF1 = IQP1
349 IFF2 = IQP3
350 GO TO 134
351 133 CONTINUE
352 IBF = IQP3
353 IFF1 = IQP1
354 IFF2 = IQP2
355 134 CONTINUE
356 CALL GRNDM(RNDM,1)
357 ISAM6 = 1.D0 + 3.D0*RNDM(1)
358 GO TO (135,136,137),ISAM6
359 135 CONTINUE
360 IFB = IQT1
361 IBB1 = IQT2
362 IBB2 = IQT3
363 GO TO 138
364 136 CONTINUE
365 IFB = IQT2
366 IBB1 = IQT1
367 IBB2 = IQT3
368 GO TO 138
369 137 CONTINUE
370 IFB = IQT3
371 IBB1 = IQT1
372 IBB2 = IQT2
373 138 CONTINUE
374* | | Quark selection for incoming baryon and baryon target completed
375* + |-->-->-->-->-->-->-->-->-->--> go to 14 continue
376 14 CONTINUE
377* | Quark selection completed
378* +-------------------------------------------------------------------*
379
380*or IF (IPRI.EQ.1) WRITE(LUNOUT,102)IFF,IBF,IFF1,IFF2,IFB1,IFB2,
381*or &IFB,IBB,IBB1,IBB2
382C
383C********************************************************************
384C
385C*** SAMPLING MOMENTUM FRACTIONS OF QUARKS AND DIQUARKS
386C
387C********************************************************************
388C
389 IXPXT = 0
390 25 CONTINUE
391 IXPXT = IXPXT + 1
392* +-------------------------------------------------------------------*
393* | Selection of xp and xt from beta distribution:
394* | xp and xt are then used to select the fraction of momentum and
395* | energy for each jet, according to the following relations:
396* | (where we assume to use xp, xt for the jet n. 1)
397* |
398* | xxp = 1 - xp
399* | xxt = 1 - xt
400* | Ech1 = umo * (xp + xt ) / 2
401* | Ech2 = umo * (xxp + xxt) / 2
402* | Pch1 = umo * (xp - xt ) / 2
403* | Pch2 = umo * (xxp - xxt) / 2
404* | Amch1 = umo * sqrt (xp * xt )
405* | Amch2 = umo * sqrt (xxp * xxt)
406* |
407 IF (IBPROJ) 21,22,23
408 21 CONTINUE
409* | Note for antibaryon projectile xp and xt are sampled from the
410* | same distribution, ===> no difference in exchanging them!
411 UNO = UNON
412 XP = BETARN(HLFHLF,UNO)
413 XXP = 1.D0 - XP
414 UNO = UNON
415 XT = BETARN(HLFHLF,UNO)
416 XXT = 1.D0 - XT
417 GO TO 24
418 23 CONTINUE
419* | Note for baryon projectile xp and xt are sampled from the
420* | same distribution, ===> no difference in exchanging them!
421 UNO = UNON
422 XP = BETARN(HLFHLF,UNO)
423 XXP = 1.D0 - XP
424 UNO = UNON
425 XT = BETARN(HLFHLF,UNO)
426 XXT = 1.D0 - XT
427 GO TO 24
428 22 CONTINUE
429* | Note for meson projectile xp and xt are not sampled from the
430* | same distribution, ===> difference in exchanging them!
431 UNO = UNOM
432 IF (IFF.EQ.3 .OR. IFF.EQ.-3) UNO = UNOMS
433 XP = BETARN(HLFHLF,UNO)
434 XXP = 1.D0 - XP
435 IF (IBTARG .EQ. 0) GO TO 2288
436 UNO = UNON
4372288 CONTINUE
438 XT = BETARN(HLFHLF,UNO)
439 XXT = 1.D0 - XT
440 24 CONTINUE
441* | Now xp and xt have been selected from the appropriate beta
442* | distributions, xxp and xxt are the complements to one of xp and xt
443* +-------------------------------------------------------------------*
444
445* +-------------------------------------------------------------------*
446* | From here to 1124 it is likely to be obsolete (inucvt is now used
447* | nowhere in the code, the same for pnuc
448* |
449*or RNDMVV=RNDM(V)
450*or IF (INUCVT.EQ.0) GO TO 1124
451*or IF (RNDMVV.LT.PNUC(1)) GO TO 1124
452*or XT=2.D0*BETARN(0.5D0,UNO+6.D0)
453*or XXT=1.D0-XT
454*or IF (XXT.LE.0.D0) XXT=RNDM(V)
455*or IF (RNDMVV.LT.PNUC(2)) GO TO 1124
456*or XT=3.D0*BETARN(0.5D0,UNO+12.D0)
457*or XXT=1.D0-XT
458*or IF (XXT.LE.0.D0) XXT=RNDM(V)
459*or 1124 CONTINUE
460* |
461* +-------------------------------------------------------------------*
462*or IF (IPRI .EQ. 1) WRITE(LUNOUT,103)XP,XT,XXP,XXT
463*or 103 FORMAT (10F10.5)
464C
465C********************************************************************
466C
467C*** KINEMATICAL PARAMETERS OF BOTH CHAINS IN CMS
468C
469C********************************************************************
470C
471****
472****===================================================================*
473* | Now selecting the kinematical parameters for the two jets:
474* |
475* | amch1 = invariant mass of the 1st jet
476* | ech1 = total energy of the 1st jet in CMS
477* | pch1 = total momentum of the 1st jet in CMS (with sign)
478* |
479* | amch2 = invariant mass of the 2nd jet
480* | ech2 = total energy of the 2nd jet in CMS
481* | pch2 = total momentum of the 2nd jet in CMS (with sign)
482* |
483* | The following relations must be fulfilled:
484* |
485* | ech1 + ech2 = umo (energy in CMS = inv. mass of the system)
486* | ech1 = sqrt (pch1**2 + amch1**2)
487* | ech2 = sqrt (pch2**2 + amch2**2)
488* | pch1 + pch2 = 0
489* |
490****===================================================================*
491****
492 IF (IBPROJ) 31,32,33
493* +-------------------------------------------------------------------*
494* | antibaryon projectile!!! (note that only antibaryon projectile
495* | baryon target is allowed, antibaryon projectile meson target is
496* | considered as meson projectile antibaryon target)
497* |
498 31 CONTINUE
499C
500C********************************************************************
501C
502C*** KINEMATICAL PARAMETERS OF BOTH CHAINS IN CMS
503C*** ANTINUCLEON-NUCLEUON
504C*** LONG ANTIDIQUARK - DIQUARK CHAIN
505C
506C********************************************************************
507C
508* | Ibb, ifb1, ifb2 contain the quark numbers of the target, ibf,
509* | iff1, iff2 the quark numbers of the projectile
510* | iff...= forward chain, forward quark (diquark)
511* | ifb...= forward chain, backward quark (diquark)
512* | ibf...= backward chain, forward quark
513* | ibb...= backward chain, backward quark
514* | By definition all i..f.. come from the projectile and all
515* | i..b.. from the target
516* | Of course, since we are treating an antibaryon projectile and
517* | a baryon target all i..f.. are antiquark and all i..b.. are
518* | quark
519* | Of course the two following cards are equivalent to
520* | IIFF1 = IABS (IFF1) ...
521 IIFF1 = -IFF1
522 IIFF2 = -IFF2
523 IF (IIFF1 .EQ. IFB1) GO TO 3111
524 IF (IIFF1 .EQ. IFB2) GO TO 3112
525 IF (IIFF2 .EQ. IFB1) GO TO 3113
526 IF (IIFF2 .EQ. IFB2) GO TO 3114
527* | Get the index and the mass of the pseudoscalar meson corre-
528* | sponding to the lowest energy for chain 2 ("b")
529 IIBF = IABS(IBF)
530 IBPS = IMPS(IIBF,IBB)
531 AMBPS = AM(IBPS)
532* | *****************************************************************
533* | New version: of course, as it is explained below it is not *
534* | correct to comment the "go to 3115", however it is not correct*
535* | also to use it in its original form, we need to compute a de- *
536* | tailed threshold, also for the Amff value: we can believe that*
537* | the lowest threshold is given by the two scalar mesons resul- *
538* | ting from the combinations of the 4 quarks (iff1,iff2,ibf1, *
539* | ibf2). Remember that the Imps(i,j) array gives the index of *
540* | the pseudoscalar meson with antiquark -i and quark j, the same*
541* | apply to the Imve array but for vector mesons *
542* | But, since bamjev it is likely to produce at least one baryon *
543* | and one antibaryon when called with Iopt=5 (since it hadroni- *
544* | zes a chain with a diquark and an anti-diquark at the extremi-*
545* | ties) a more realistic threshold could be to check for the *
546* | masses of the baryon-antibaryon combinations corresponding to *
547* | a uubar or a ddbar sea pair added to the original diquarks *
548* | *****************************************************************
549* | Selection of the mass threshold from the two pseudoscalar mesons
550* IMPS11 = IMPS(IIFF1,IFB1)
551* IMPS21 = IMPS(IIFF2,IFB2)
552* IMPS12 = IMPS(IIFF1,IFB2)
553* IMPS22 = IMPS(IIFF2,IFB1)
554* | Amff is selected as the maximum of the two possible meson configu-
555* | rations, to be sure that no problem will result during frag-
556* | mentation
557* AMFF = MAX ( AM (IMPS11) + AM (IMPS21), AM (IMPS12) +
558* & AM (IMPS22) )
559* | Of course at least two mesons must be produced
560* | First check that the total invariant mass is enough (it must
561* | be larger than the two meson masses and the pseudoscalar
562* | meson mass of the second chain)
563* AMFF = AMFF
564* | Selection of the mass threshold from the two baryon configura-
565* | tions
566 CALL BKLASS (-1, IFF1, IFF2, IA1F8, IA1F10 )
567 CALL BKLASS ( 1, IFB1, IFB2, I1F8, I1F10 )
568 CALL BKLASS (-2, IFF1, IFF2, IA2F8, IA2F10 )
569 CALL BKLASS ( 2, IFB1, IFB2, I2F8, I2F10 )
570 AMFF = MIN ( AM (IA1F8) + AM (I1F8), AM (IA2F8) + AM (I2F8) )
571 & + 0.3D+00
572* | +----------------------------------------------------------------*
573* | | New treatment: check the mass threshold
574 IF ( AMFF + AMBPS .LT. UMO ) THEN
575 XSQ = SQRT(XXP*XXT)
576 AMCH1 = UMO*XSQ
577 NNCH1 = 0
578 AMCH2 = UMO*UMO*XP*XT
579* | | +------------------------------------------------------------*
580* | | | Check if we have enough energy for the "f" jet
581 IF ( AMCH1 .LE. AMFF .OR. AMCH2 .LE. AMBPS * AMBPS ) THEN
582 IXPXT = IXPXT + 1
583 IF ( IXPXT .LT. 5 ) GO TO 25
584* | | | if amch1 < amfps xp and xt are resampled, but if we are
585* | | | resampling too often force amch1 to be above
586* | | | the minimum required, anyway the kinematic region
587* | | | allowed for xp, xt seems to be marginal
588* | | *-->-->-->-->-->-->-->-->-->--> xp, xt resampling
589 XSQ1 = ( AMFF / UMO )**2
590 XSQ2 = ( AMBPS / UMO )**2
591 XXXMN = XSQ1
592 XXYMX = 0.5D+00 * ( 1.D+00 + XSQ1 - XSQ2 )
593 XXYMN = SQRT ( 1.D+00 - XSQ1 / ( XXYMX * XXYMX ) )
594 XXXMN = MAX ( XSQ1, XXYMX * ( ONEONE - XXYMN ) )
595 XXXMX = MIN ( 1.D+00, XXYMX * ( 1.D+00 + XXYMN ) )
596* | | | +----------------------------------------------------------*
597* | | | |
598 3161 CONTINUE
599 CALL GRNDM(RNDM,1)
600 XXP = XXXMN + ( XXXMX - XXXMN ) * RNDM (1)
601 XP = 1.D+00 - XXP
602 XXYMN = XSQ1 / XXP
603 XXYMX = 1.D+00 - XSQ2 / XP
604* | | | | +-------------------------------------------------------*
605* | | | | |
606 IF ( XXYMN .GT. XXYMX ) THEN
607 XXXMN = XXP
608 GO TO 3161
609* | | | |-<|--<--<--<--< no allowed interval for xxt, resample
610 END IF
611* | | | | |
612* | | | | +-------------------------------------------------------*
613* | | | |
614* | | | +----------------------------------------------------------*
615 CALL GRNDM(RNDM,1)
616 XXT = XXYMN + ( XXYMX - XXYMN ) * RNDM (1)
617 XT = 1.D+00 - XXT
618 XSQ = SQRT(XXP*XXT)
619 AMCH1 = UMO*XSQ
620 NNCH1 = 0
621 END IF
622* | | |
623* | | +------------------------------------------------------------*
624 IOPBAM = 5
625 GO TO 3116
626* | |
627* | +----------------------------------------------------------------*
628* | | We are in troubles: the selected quark combinations
629* | | for the two chains are unphysical since the invariant
630* | | mass is too low to produce the required three mesons
631* | | First try to change the quark combinations:
632 ELSE
633 CALL GRNDM(RNDM,1)
634 IRNDM = 1.D+00 + RNDM (1)
635 LQPROJ = .FALSE.
636 LQTARG = .FALSE.
637 GO TO (3171,3181) IRNDM
638* | | +-------------------------------------------------------------*
639* | | | Try to change one of the projectile quarks in the
640* | | | first chain
641 3171 CONTINUE
642 LQPROJ = .TRUE.
643* | | | +----------------------------------------------------------*
644* | | | | The third antibaryon quark can combine with the
645* | | | | first or/and the second quark of the target diquark
646 IF ( -IBF .EQ. IFB1 .OR. -IBF .EQ. IFB2 ) THEN
647* | | | | +-------------------------------------------------------*
648* | | | | | Make a random choiche of the quark to be substituted
649 CALL GRNDM(RNDM,1)
650 IF ( RNDM (1) .LT. 0.5D+00 ) THEN
651 IBF0 = IBF
652 IBF = IFF1
653 IFF1 = IBF0
654* | | | | |
655* | | | | +-------------------------------------------------------*
656* | | | | |
657 ELSE
658 IBF0 = IBF
659 IBF = IFF2
660 IFF2 = IBF0
661 END IF
662* | | | | |
663* | | | | +-------------------------------------------------------*
664 GO TO 31
665* | | | |
666* | | | +----------------------------------------------------------*
667* | | | | No possibility to solve the situation changing one of
668* | | | | the projectile quarks inside the "f" chain, try with
669* | | | | the projectile quarks (if not yet tried)
670 ELSE
671 IF ( .NOT. LQTARG ) GO TO 3181
672 GO TO 3191
673 END IF
674* | | | |
675* | | | +----------------------------------------------------------*
676* | | |
677* | | +-------------------------------------------------------------*
678* | | +-------------------------------------------------------------*
679* | | | Try to change one of the target quarks in the
680* | | | first chain (for uud and udd targets this is usually
681* | | | useless, but it has been included for the sake of
682* | | | completness )
683 3181 CONTINUE
684 LQTARG = .TRUE.
685* | | | +----------------------------------------------------------*
686* | | | | The third target quark can combine with the first
687* | | | | or/and the second quark of the projectile diquark
688 IF ( IBB .EQ. -IFF1 .OR. IBB .EQ. -IFF2 ) THEN
689* | | | | +-------------------------------------------------------*
690* | | | | | Make a random choiche of the quark to be substituted
691 CALL GRNDM(RNDM,1)
692 IF ( RNDM (1) .LT. 0.5D+00 ) THEN
693 IBB0 = IBB
694 IBB = IFB1
695 IFB1 = IBB0
696* | | | | |
697* | | | | +-------------------------------------------------------*
698* | | | | |
699 ELSE
700 IBB0 = IBB
701 IBB = IFB2
702 IFB2 = IBB0
703 END IF
704* | | | | |
705* | | | | +-------------------------------------------------------*
706 GO TO 31
707* | | | |
708* | | | +----------------------------------------------------------*
709* | | | | No possibility to solve the situation changing one of
710* | | | | the target quarks inside the "f" chain, try with
711* | | | | the projectile quarks (if not yet tried)
712 ELSE
713 IF ( .NOT. LQPROJ ) GO TO 3171
714 END IF
715* | | | |
716* | | | +----------------------------------------------------------*
717* | | |
718* | | +-------------------------------------------------------------*
719 3191 CONTINUE
720* | | If we are here we cannot perform an interaction conserving
721* | | all additive quantum numbers: ignore one (typically it is
722* | | strangeness) and go on
723 WRITE (LUNERR,*)
724 & ' *** Hadevv, impossible interaction, kp,kt, Umo',
725 & KPROJ,KTARG,UMO
726 WRITE (LUNOUT,*)
727 & ' *** Hadevv, impossible interaction, kp,kt, Umo',
728 & KPROJ,KTARG,UMO
729 END IF
730* | |
731* | +----------------------------------------------------------------*
732* | Now we want to get the indexes of the pseudo-scalar and vector
733* | mesons which can be created from the first (forward) chain.
734* | Of course if one of the ff quark is the antiquark of one of
735* | fb quarks then the mesons are defined completely by the remaining
736* | two quarks: we have anyway to deal also with the situation
737* | were no ff quark is the antiquark of a fb quark (the goto 3115...)
738* | which clearly requires at least two mesons!!! So no Amfps and
739* | Amfv can be defined in this situation, and the "go to 3115" was
740* | really important to assure that we are not producing single
741* | particle jets which are not possible, we have only to substitute
742* | the 1.5 threshold with the proper threshold for the two
743* | mesons (at least the two scalar mesons): this is also true for
744* | the Amff value which of course should be equal to the sum
745* | of the two scalar mesons resulting from the combinations
746* | of the 4 quarks (see above)
7473111 CONTINUE
748 IIFF2 = IABS(IFF2)
749 IFPS = IMPS(IIFF2,IFB2)
750 IAIFF = IFF2
751 IFB = IFB2
752 IFPS2 = IMPS(IIFF1,IFB1)
753 IFV = IMVE(IIFF2,IFB2)
754 GO TO 3117
7553112 CONTINUE
756 IIFF2 = IABS(IFF2)
757 IFPS = IMPS(IIFF2,IFB1)
758 IAIFF = IFF2
759 IFB = IFB1
760 IFPS2 = IMPS(IIFF1,IFB2)
761 IFV = IMVE(IIFF2,IFB1)
762 GO TO 3117
7633113 CONTINUE
764 IIFF1 = IABS(IFF1)
765 IFPS = IMPS(IIFF1,IFB2)
766 IAIFF = IFF1
767 IFB = IFB2
768 IFPS2 = IMPS(IIFF2,IFB1)
769 IFV = IMVE(IIFF1,IFB2)
770 GO TO 3117
7713114 CONTINUE
772 IIFF1 = IABS(IIFF1)
773 IFPS = IMPS(IIFF1,IFB1)
774 IAIFF = IFF1
775 IFB = IFB1
776 IFPS2 = IMPS(IIFF2,IFB2)
777 IFV = IMVE(IIFF1,IFB1)
7783117 CONTINUE
779* Amfps, amfv are the masses of the pseudoscalar and vector mesons
780* corresponding to the two unpaired quarks of the 1 (f) chain
781 AMFPS = AM(IFPS)
782 AMFV = AM(IFV )
783 AMFPS2= AM(IFPS2)
784 NNCH1 = 0
785C ATTENTION THIS MIGHT LEAD TO TOO LOW ANNIHILATION MULTIPLICITIES
786C AMFF = AMFV+0.3D0
787* AMFF = 2.3D0
788 AMFF = MAX ( AMFV + 0.3D+00, AMFV + AMFPS2 + 0.1D+00 )
789* | This expression for Amff0 (threshold for a complete diquark-diquark
790* | jet) is not correct: this jet will fragment at least into two
791* | hadrons corresponding to the lowest energy hadrons with respecti-
792* | vely the first and the second diquark. Of corse one will be an
793* | antibaryon. It must be checked that bamjet produces a baryon-
794* | antibaryon pair any time it is called with iopt = 5 (corresponding
795* | to the fragmentation of a complete diquark-antidiquark jet)
796* | It is also questionable if it is correct to call bamjet with
797* | iopt=5 whenever energetically possible: this clearly implies
798* | that no annihilation takes place (an antibaryon will emerge
799* | from the interaction). This is a question to be addressed
800* | to Hannes!!
801* AMFF0 = 2.D+00 * AMFF
802* | A tentative way could be to check for the masses of the
803* | baryon-antibaryon combinations corresponding to a uubar
804* | or a ddbar sea pair
805 CALL BKLASS (-1, IFF1, IFF2, IA1F8, IA1F10 )
806 CALL BKLASS ( 1, IFB1, IFB2, I1F8, I1F10 )
807 CALL BKLASS (-2, IFF1, IFF2, IA2F8, IA2F10 )
808 CALL BKLASS ( 2, IFB1, IFB2, I2F8, I2F10 )
809 AMFF0 = MIN ( AM (IA1F8) + AM (I1F8), AM (IA2F8) + AM (I2F8) )
810 & + 0.3D+00
811* |
812* | here xxt and xxp are used for the first jet
813* |
814 XSQ = SQRT(XXP*XXT)
815 AMCH1 = UMO*XSQ
816 AAPS = IFPS
817 AAV = IFV
818*or IF (IPRI.EQ.1) WRITE(LUNOUT,103)XSQ,AMCH1,AMCH2,AAPS,AAV,
819*or & AMFPS,AMFV
820
821* | +----------------------------------------------------------------*
822* | |
823 IF (AMCH1 .LT. AMFPS) GO TO 25
824* | | if amch1 < amfps xp and xt are resampled
825* | *-->-->-->-->-->-->-->-->-->--> xp, xt resampling
826
827* | Kinematical parameters xxp, xxt for the 1st jet
828 IF (AMCH1 .GT. AMFV ) GO TO 3151
829C*** PRODUCE AMFPS
830 AMCH1 = AMFPS
831 NNCH1 = -1
832 XSQ = AMFPS/UMO
833* | | recalculating xxp, xp
834 XXP = XSQ**2/XXT
835 XP = 1.D0 - XXP
836 GO TO 3153
8373151 CONTINUE
838 IF (AMCH1 .GT. AMFF) GO TO 3153
839C*** PRODUCE AMFV
840 AMCH1 = AMFV
841 NNCH1 = 1
842 XSQ = AMFV/UMO
843* | | recalculating xxp, xp
844 XXP = XSQ**2/XXT
845 XP = 1.D0 - XXP
846 GO TO 3153
8473153 CONTINUE
848 IF (AMCH1 .LE. AMFF0) THEN
849 IOPBAM = 3
850 ELSE
851 IOPBAM = 5
852 END IF
853 GO TO 3116
8543116 CONTINUE
855C
856C********************************************************************
857C
858C*** KINEMATICAL PARAMETERS OF BOTH CHAINS IN CMS
859C ANTINUCLEON NUCLEON
860C*** SHORT ANTIQUARK - QUARK CHAIN
861C
862C********************************************************************
863C
864 IIBF = IABS(IBF)
865 IBPS = IMPS(IIBF,IBB)
866 IBV = IMVE(IIBF,IBB)
867 AMBPS = AM(IBPS)
868 AMBV = AM(IBV)
869 NNCH2 = 0
870 AMBB = AMBV + 0.3D0
871 AAPS = IBPS
872 AAV = IBV
873* | +----------------------------------------------------------------*1
874* | |
875* | | Now commented, is useless!!!
876* IF (XP .LE. 0.D0 .OR. XT .LE. 0.D0) GO TO 25
877* | | resample xp and xt if one is negative or zero
878* | +-->-->-->-->-->-->-->-->-->--> xp, xt resampling
879
880* | Now xp and xt are used for the second jet
881 XXSQ = SQRT(XP*XT)
882 AMCH2 = UMO*XXSQ
883*or IF (IPRI.EQ.1) WRITE(LUNOUT,103)XSQ,AMCH1,AMCH2
884*or & ,AAPS,AAV,AMBPS,AMBV
885
886* | +----------------------------------------------------------------*
887* | |
888 IF (AMCH2 .LT. AMBPS) THEN
889 IXPXT = IXPXT + 1
890 GO TO 25
891* | | if amch1 < amfps xp and xt are resampled
892* | *-->-->-->-->-->-->-->-->-->--> xp, xt resampling
893 END IF
894* | |
895* | +----------------------------------------------------------------*
896
897 IF (AMCH2 .GT. AMBV ) GO TO 3121
898C*** PRODUCE AMBPS
899* For Prof. Ranft: here there was a "large" mistake, amch2 = ambps
900* was missing
901 AMCH2 = AMBPS
902 NNCH2 = -1
903 XXSQ = AMBPS/UMO
904*or IF (INUCVT .EQ. 1) GO TO 3123
905 GO TO 31236
9063121 CONTINUE
907 IF (AMCH2 .GT. AMBB) GO TO 3123
908C*** PRODUCE AMBV
909 AMCH2 = AMBV
910 NNCH2 = 1
911 XXSQ = AMBV/UMO
912*or IF (INUCVT .EQ. 1) GO TO 3123
913 GO TO 31236
914* | +----------------------------------------------------------------*
915* | | Here adjusting kinematics!!!!!
916* | | Now, chain 2 is a single particle jet, so we have to reset the
917* | | kinematical parameters xp, xxp, xt and xxt
918* | |
91931236 CONTINUE
920 XXSQ2 = XXSQ * XXSQ
921* | | +-------------------------------------------------------------*
922* | | | If also chain 1 is a parjet (nnch1 .ne. 0) then the paramet.
923* | | | to be recomputed are xp and xt, from alpha and beta, in
924* | | | such a way to conserve the original momentum direction
925* | | |
926 IF (NNCH1 .NE. 0) THEN
927 XSQ2 = XSQ * XSQ
928 HELP = XSQ2 * (XSQ2 - 2.D0) + XXSQ2 * (XXSQ2 - 2.D0)
929 & - 2.D0 * XSQ2 * XXSQ2
930 DDIFF = SQRT (HELP + 1.D0)
931 SSUM = SQRT (HELP + 1.D0 + 4.D0 * XXSQ2)
932 ALPHA = (SSUM + DDIFF) * 0.5D0
933 BETA = (SSUM - DDIFF) * 0.5D0
934 IF (XP .GT. XT) THEN
935 XP = ALPHA
936 XT = BETA
937 ELSE
938 XT = ALPHA
939 XP = BETA
940 END IF
941 XXP = 1.D0 - XP
942 XXT = 1.D0 - XT
943* | | |
944* | | +-------------------------------------------------------------*
945 ELSE
946* | | +-------------------------------------------------------------*
947* | | | If chain 1 is not a parjet (nnch1 .eq. 0) then the paramet.
948* | | | xp, xt are to be recomputed in such a way to conserve the
949* | | | original momentum direction and modulus
950* | | |
951 DDIFF = XP - XT
952 SSUM = SQRT (4.D0 * XXSQ2 + DDIFF**2)
953 XP = (SSUM + DDIFF) * 0.5D0
954 XT = (SSUM - DDIFF) * 0.5D0
955 XXP = 1.D0 - XP
956 XXT = 1.D0 - XT
957 XSQ = SQRT (XXP * XXT)
958 AMCH1 = XSQ * UMO
959 END IF
960* | | |
961* | | +-------------------------------------------------------------*
962* | | end kinematics correction
963* | +----------------------------------------------------------------*
964
9653123 CONTINUE
966C
967 PCH1 = UMO*(XXP - XXT)*.5D0
968 ECH1 = UMO*(XXP + XXT)*.5D0
969 GAMCH1 = ECH1/AMCH1
970 BGCH1 = PCH1/AMCH1
971 PCH2 = UMO*(XP - XT)*.5D0
972 ECH2 = UMO*(XP + XT)*.5D0
973 GAMCH2 = ECH2/AMCH2
974 BGCH2 = PCH2/AMCH2
975 GO TO 34
976* | end kin. sel. for antibaryon projectile
977* +-->-->-->-->-->-->-->-->-->--> go to 34
978
979* +-------------------------------------------------------------------*
980* | baryon projectile!!!
981* |
982 33 CONTINUE
983C
984C********************************************************************
985C
986C*** KINEMATICAL PARAMETERS OF BOTH CHAINS IN CMS
987C*** NUCLEON - NUCLEON
988C*** FORWARD DIQUARK - QUARK CHAIN
989C
990C********************************************************************
991C
992 GO TO 332
993* |
994* +-->-->-->-->-->-->-->-->-->--> jump # 1 to 332
995
996* +--<--<--<--<--<--<--<--<--<--< here from jump # 3
997* |
998
9993310 CONTINUE
1000 CALL BKLASS (IFB,IFF1,IFF2,IF8,IF10)
1001 AMF8 = AM(IF8)
1002 AMF10 = AM(IF10)
1003 AMFF = AMF10 + 0.3D0
1004 NNCH1 = 0
1005* | here xxp, xt are used for the jet # 1
1006 XSQ = SQRT(ABS(XXP*XT))
1007 AMCH1 = UMO*XSQ
1008 AA8 = IF8
1009 AA10 = IF10
1010*or IF (IPRI .EQ. 1) WRITE(LUNOUT,103)XSQ,AMCH1,AMCH2
1011*or & ,AA8,AA10,AMF8,AMF10
1012
1013* | +----------------------------------------------------------------*
1014* | | This check added by A. Ferrari, to avoid negative x(x)p or
1015* | | x(x)t !!!!!?????? Maybe also "go to 33366" if we want to create
1016* | | the jet anyway
1017* I (A. Ferrari) think this check was missing and is
1018* actually needed, else we can get negative energies
1019 IF (AMCH1 .LT. AMF8) GO TO 25
1020* | | if amch1 < amf8 xp and xt are resampled
1021* | +-->-->-->-->-->-->-->-->-->--> xp, xt resampling
1022
1023 IF (AMCH1 .GT. AMF10) GO TO 331
1024C*** PRODUCE AMF8
1025 AMCH1 = AMF8
1026 NNCH1 = -1
1027 XSQ = AMF8/UMO
1028 GO TO 33366
1029 331 CONTINUE
1030 IF (AMCH1 .GT. AMFF) GO TO 333
1031C*** PRODUCE AMF10
1032 AMCH1 = AMF10
1033 NNCH1 = 1
1034 XSQ = AMF10/UMO
1035 GO TO 33366
1036* | +----------------------------------------------------------------*
1037* | | Here adjusting kinematics!!!!!
1038* | | Now, chain 1 is a single particle jet, so we have to reset the
1039* | | kinematical parameters xp, xxp, xt and xxt
1040* | |
104133366 CONTINUE
1042 XSQ2 = XSQ * XSQ
1043* | | +-------------------------------------------------------------*
1044* | | | If also chain 2 is a parjet (nnch2 .ne. 0) then the paramet.
1045* | | | to be recomputed are xxp and xt, from alpha and beta, in
1046* | | | such a way to conserve the original momentum direction
1047* | | |
1048 IF (NNCH2 .NE. 0) THEN
1049 XXSQ2 = XXSQ * XXSQ
1050 HELP = XSQ2 * (XSQ2 - 2.D0) + XXSQ2 * (XXSQ2 - 2.D0)
1051 & - 2.D0 * XSQ2 * XXSQ2
1052 DDIFF = SQRT (HELP + 1.D0)
1053 SSUM = SQRT (HELP + 1.D0 + 4.D0 * XSQ2)
1054 ALPHA = (SSUM + DDIFF) * 0.5D0
1055 BETA = (SSUM - DDIFF) * 0.5D0
1056 IF (XXP .GT. XT) THEN
1057 XXP = ALPHA
1058 XT = BETA
1059 ELSE
1060 XT = ALPHA
1061 XXP = BETA
1062 END IF
1063 XP = 1.D0 - XXP
1064 XXT = 1.D0 - XT
1065* | | |
1066* | | +-------------------------------------------------------------*
1067 ELSE
1068* | | +-------------------------------------------------------------*
1069* | | | If chain 2 is not a parjet (nnch2 .eq. 0) then the paramet.
1070* | | | xxp,xt have to be recomputed in such a way to conserve the
1071* | | | original momentum direction and modulus
1072* | | |
1073 DDIFF = XXP - XT
1074 SSUM = SQRT (4.D0 * XSQ2 + DDIFF**2)
1075 XXP = (SSUM + DDIFF) * 0.5D0
1076 XT = (SSUM - DDIFF) * 0.5D0
1077 XP = 1.D0 - XXP
1078 XXT = 1.D0 - XT
1079 XXSQ = SQRT (XP * XXT)
1080 AMCH2 = XXSQ * UMO
1081 END IF
1082* | | |
1083* | | +-------------------------------------------------------------*
1084* | | end kinematics correction
1085* | +----------------------------------------------------------------*
1086
1087 333 CONTINUE
1088* | we are using xp and xxt for chain 2
1089 PCH1 = UMO*(XXP - XT)*.5D0
1090 ECH1 = UMO*(XXP + XT)*.5D0
1091 GAMCH1 = ECH1/AMCH1
1092 BGCH1 = PCH1/AMCH1
1093 PCH2 = UMO*(XP - XXT)*.5D0
1094 ECH2 = UMO*(XP + XXT)*.5D0
1095 GAMCH2 = ECH2/AMCH2
1096 BGCH2 = PCH2/AMCH2
1097 GO TO 34
1098* | end kin. sel. for baryon projectile
1099* +-->-->-->-->-->-->-->-->-->--> go to 34
1100
1101C
1102C********************************************************************
1103C
1104C*** KINEMATICAL PARAMETERS OF BOTH CHAINS IN CMS
1105C NUCLEON NUCLEON
1106C*** BACKWARD QUARK - DIQUARK CHAIN
1107C
1108C********************************************************************
1109C
1110* +--<--<--<--<--<--<--<--<--<--< here from the previous jump # 1
1111* |
1112 332 CONTINUE
1113* | Starting from chain # 2!!!
1114 CALL BKLASS (IBF,IBB1,IBB2,IB8,IBIO)
1115 NNCH2 = 0
1116 AMB8 = AM(IB8)
1117 AMB10 = AM(IBIO)
1118 AMBB = AMB10 + 0.3D0
1119* | here xp, xxt are used for the jet # 2
1120 XXSQ = SQRT(XP*XXT)
1121 AMCH2 = UMO*XXSQ
1122 AAB8 = IB8
1123 AAB10 = IBIO
1124*or IF (IPRI.EQ.1) WRITE(LUNOUT,103)XSQ,AMCH1,AMCH2
1125*or & ,AAB8,AAB10,AMB8,AMB10
1126
1127* | +----------------------------------------------------------------*
1128* | | This check added by A. Ferrari, to avoid negative x(x)p or
1129* | | x(x)t !!!!!?????? Maybe also "go to 335" if we want to create
1130* | | the jet anyway
1131* I (A. Ferrari) think this check was missing and is
1132* actually needed, else we can get negative energies
1133 IF (AMCH2 .LT. AMB8) GO TO 25
1134* | | if amch2 < amb8 xp and xt are resampled
1135* | +-->-->-->-->-->-->-->-->-->--> xp, xt resampling
1136
1137 IF (AMCH2 .GT. AMB10) GO TO 334
1138C*** PRODUCE AMB8
1139 AMCH2 = AMB8
1140 NNCH2 = -1
1141 XXSQ = AMB8/UMO
1142 XP = XXSQ**2/XXT
1143 XXP = 1.D0 - XP
1144 GO TO 335
1145 334 CONTINUE
1146 IF (AMCH2 .GT. AMBB) GO TO 335
1147C*** PRODUCE AMB10
1148 AMCH2 = AMB10
1149 NNCH2 = 1
1150 XXSQ = AMB10/UMO
1151 XP = XXSQ**2/XXT
1152 XXP = 1.D0 - XP
1153
1154C PCH1=UMO*(XXP-XT)*.5D0
1155C ECH1=UMO*(XXP+XT)*.5D0
1156C GAMCH1=ECH1/AMCH1
1157C BGCH1=PCH1/AMCH1
1158C GO TO 335
1159
1160 335 CONTINUE
1161 GO TO 3310
1162* |
1163* +-->-->-->-->-->-->-->-->-->--> jump # 3 to 3310
1164
1165* +-------------------------------------------------------------------*
1166* | meson projectile!!!
1167* |
1168 32 CONTINUE
1169C
1170C********************************************************************
1171C
1172C*** KINEMATICAL PARAMETERS OF BOTH CHAINS IN CMS
1173C*** MESON NUCLEON
1174C
1175C********************************************************************
1176C
1177 IF (IBTARG)3277,3288,3299
1178* | +----------------------------------------------------------------*
1179* | | meson projectile, baryon target!!!!
1180* | |
11813299 CONTINUE
1182 GO TO (321,325),ISAM3
1183* | | +-------------------------------------------------------------*
1184* | | | meson projectile, baryon target, isam3 = 1
1185* | | |
1186 321 CONTINUE
1187C*** MESON NUCLEON Q(XXP)-QQ(XXT)+AQ(XP-Q(XT)
1188 GO TO 322
1189* | | |
1190* | | +-->-->-->-->-->-->-->-->-->--> jump # 4 to 322
1191
1192* | | +--<--<--<--<--<--<--<--<--<--< here from jump # 5
1193* | | |
11943259 CONTINUE
1195C=================================================================
1196C
1197C*** KINEMATICAL PARAMETERS OF BOTH CHAINS IN CMS
1198C MESON NUCLEON
1199C*** FIRST LONG Q(XXP)-QQ(XXT) CHAIN
1200C
1201C===================================================================
1202 CALL BKLASS (IFF,IFB1,IFB2,IF8,IFIO)
1203 AMF8 = AM(IF8)
1204 AMF10 = AM(IFIO)
1205 NNCH1 = 0
1206 AMFF = AMF10 + 0.3D0
1207* | here xxp, xxt are used for the jet # 1
1208 XSQ = SQRT(XXP*XXT)
1209 AMCH1 = UMO*XSQ
1210 AA8 = IF8
1211 AA10 = IFIO
1212*or IF (IPRI .EQ. 1) WRITE(LUNOUT,103)XSQ,AMCH1,AMCH2
1213*or & ,AA8,AA10,AMF8,AMF10
1214
1215* | | | +----------------------------------------------------------*
1216* | | | |
1217 IF (AMCH1 .LT. AMF8) GO TO 25
1218* | | | | if amch1 < amf8 xp and xt are resampled
1219* | | | +-->-->-->-->-->-->-->-->-->--> xp, xt resampling
1220
1221 IF (AMCH1 .GT. AMF10) GO TO 3211
1222C*** PRODUCE AMF8
1223 AMCH1 = AMF8
1224 NNCH1 = -1
1225 XSQ = AMF8/UMO
1226 GO TO 32136
12273211 CONTINUE
1228 IF (AMCH1 .GT. AMFF) GO TO 3213
1229C*** PRODUCE AMF10
1230 AMCH1 = AMF10
1231 NNCH1 = 1
1232 XSQ = AMF10/UMO
1233 GO TO 32136
1234* | | | +----------------------------------------------------------*
1235* | | | | Here adjusting kinematics!!!!!
1236* | | | | Now, chain 1 is a single particle jet, so we have to
1237* | | | | reset the kinematical parameters xp, xxp, xt and xxt
1238* | | | |
123932136 CONTINUE
1240 XSQ2 = XSQ * XSQ
1241* | | | | +-------------------------------------------------------*
1242* | | | | | If also chain 2 is a parjet (nnch2 .ne. 0) then the
1243* | | | | | param. to be recomputed are xxp and xxt, from alpha
1244* | | | | | and beta, in such a way to conserve the original
1245* | | | | | momentum direction
1246* | | | | |
1247 IF (NNCH2 .NE. 0) THEN
1248 XXSQ2 = XXSQ * XXSQ
1249 HELP = XSQ2 * (XSQ2 - 2.D0) + XXSQ2 *
1250 & (XXSQ2 - 2.D0) - 2.D0 * XSQ2 * XXSQ2
1251 DDIFF = SQRT (HELP + 1.D0)
1252 SSUM = SQRT (HELP + 1.D0 + 4.D0 * XSQ2)
1253 ALPHA = (SSUM + DDIFF) * 0.5D0
1254 BETA = (SSUM - DDIFF) * 0.5D0
1255 IF (XXP .GT. XXT) THEN
1256 XXP = ALPHA
1257 XXT = BETA
1258 ELSE
1259 XXT = ALPHA
1260 XXP = BETA
1261 END IF
1262 XP = 1.D0 - XXP
1263 XT = 1.D0 - XXT
1264* | | | | |
1265* | | | | +-------------------------------------------------------*
1266 ELSE
1267* | | | | +-------------------------------------------------------*
1268* | | | | | If chain 2 is not a parjet (nnch2 .eq. 0) then the
1269* | | | | | paramet. xxp,xxt have to be recomputed in such a way
1270* | | | | | to conserve the original momentum direction and
1271* | | | | | modulus
1272* | | | | |
1273 DDIFF = XXP - XXT
1274 SSUM = SQRT (4.D0 * XSQ2 + DDIFF**2)
1275 XXP = (SSUM + DDIFF) * 0.5D0
1276 XXT = (SSUM - DDIFF) * 0.5D0
1277 XP = 1.D0 - XXP
1278 XT = 1.D0 - XXT
1279 XXSQ = SQRT (XP * XT)
1280 AMCH2 = XXSQ * UMO
1281 END IF
1282* | | | | |
1283* | | | | +-------------------------------------------------------*
1284* | | | | end kinematics correction
1285* | | | +----------------------------------------------------------*
1286
12873213 CONTINUE
1288 PCH1 = UMO*(XXP - XXT)*.5D0
1289 ECH1 = UMO*(XXP + XXT)*.5D0
1290 GAMCH1 = ECH1/AMCH1
1291 BGCH1 = PCH1/AMCH1
1292 PCH2 = UMO*(XP - XT)*.5D0
1293 ECH2 = UMO*(XP + XT)*.5D0
1294 GAMCH2 = ECH2/AMCH2
1295 BGCH2 = PCH2/AMCH2
1296 GO TO 34
1297* | | | end kin. sel. for meson proj. (baryon target), isam3 = 1
1298* | | +-->-->-->-->-->-->-->-->-->--> go to 34
1299
1300* | | +--<--<--<--<--<--<--<--<--<--< here from jump # 4
1301* | | |
1302 322 CONTINUE
1303C===============================================================
1304C
1305C*** KINEMATICAL PARAMETERS OF BOTH CHAINS IN CMS
1306C MESON NUCLEON
1307C*** SHORT AQ(XP)-Q(XT) CHAIN
1308C
1309C================================================================
1310 IIBF = IABS(IBF)
1311 IBPS = IMPS(IIBF,IBB)
1312 IBV = IMVE(IIBF,IBB)
1313 AMBPS = AM(IBPS)
1314 AMBV = AM(IBV)
1315 NNCH2 = 0
1316 AMBB = AMBV + 0.3D0
1317* | here xp, xt are used for the jet # 2
1318 XXSQ = SQRT(XP*XT)
1319 AMCH2 = UMO*XXSQ
1320 AAPS = IBPS
1321 AAV = IBV
1322*or IF (IPRI.EQ.1) WRITE(LUNOUT,103)XSQ,AMCH1,AMCH2
1323*or & ,AAPS,AAV,AMBPS,AMBV
1324
1325* | | | +----------------------------------------------------------*
1326* | | | |
1327 IF (AMCH2 .LT. AMBPS) GO TO 25
1328* | | | | if amch2 < ambps xp and xt are resampled
1329* | | | +-->-->-->-->-->-->-->-->-->--> xp, xt resampling
1330
1331 IF (AMCH2 .GT. AMBV) GO TO 3221
1332C*** PRODUCE AMBPS
1333 AMCH2 = AMBPS
1334 NNCH2 = -1
1335 XXSQ = AMBPS/UMO
1336 XT = XXSQ**2/XP
1337*or IF (INUCVT .EQ. 1) GO TO 3223
1338 XXT = 1.D0 - XT
1339 GO TO 3223
13403221 CONTINUE
1341 IF (AMCH2 .GT. AMBB) GO TO 3223
1342C*** PRODUCE AMBV
1343 AMCH2 = AMBV
1344 NNCH2 = 1
1345 XXSQ = AMBV/UMO
1346 XT = XXSQ**2/XP
1347*or IF (INUCVT .EQ. 1) GO TO 3223
1348 XXT = 1.D0 - XT
1349
1350C PCH1=UMO*(XXP-XXT)*.5D0
1351C ECH1=UMO*(XXP+XXT)*.5D0
1352C GAMCH1=ECH1/AMCH1
1353C BGCH1=PCH1/AMCH1
1354C GO TO 3223
1355
13563223 CONTINUE
1357 GO TO 3259
1358* | | |
1359* | | +-->-->-->-->-->-->-->-->-->--> jump # 5 to 3259
1360
1361* | | +-------------------------------------------------------------*
1362* | | | meson projectile, baryon target, isam3 = 2
1363* | | |
1364 325 CONTINUE
1365C=================================================================
1366C
1367C*** KINEMATICAL PARAMETERS OF BOTH CHAINS IN CMS
1368C*** MESON NUCLEUS
1369C*** FORWARD ANTIQUARK-DIQUARK CHAIN
1370C
1371C=================================================================
1372 GO TO 326
1373* | | |
1374* | | +-->-->-->-->-->-->-->-->-->--> jump # 6 to 326
1375
1376* | | +--<--<--<--<--<--<--<--<--<--< here from jump # 7
1377* | | |
13783250 CONTINUE
1379C*** MESON NUCLEON FORWARD AQ(XXP)-Q(XT) AND BACKWARD CHAINS Q(XP)-QQ(
1380C*** XXT) CHAINS
1381C=====================================================================
1382C
1383C*** KINEMATICAL PARAMETERS OF BOTH CHAINS IN CMS
1384C MESON NUCLEON
1385C*** FORWARD AQ(XXP)-Q(XT) CHAIN
1386C
1387C====================================================================
1388 IIFF = IABS(IFF)
1389 IFPS = IMPS(IIFF,IFB)
1390 IFV = IMVE(IIFF,IFB)
1391 AMFPS = AM(IFPS)
1392 AMFV = AM(IFV)
1393 NNCH1 = 0
1394 AMFF = AMFV + 0.3D0
1395* | | | here xxp, xt are used for the jet # 1
1396 XSQ = SQRT(XXP*XT)
1397 AMCH1 = UMO*XSQ
1398 AAPS = IFPS
1399 AAV = IFV
1400*or IF (IPRI .EQ. 1) WRITE(LUNOUT,103)XSQ,AMCH1,AMCH2
1401*or & ,AAPS,AAV,AMFPS,AMFV
1402
1403* | | +-------------------------------------------------------------*
1404* | | |
1405 IF (AMCH1 .LT. AMFPS) GO TO 25
1406* | | | if amch1 < amfps xp and xt are resampled
1407* | | +-->-->-->-->-->-->-->-->-->--> xp, xt resampling
1408
1409 IF (AMCH1 .GT. AMFV) GO TO 3251
1410C*** PRODUCE AMFPS
1411 AMCH1 = AMFPS
1412 NNCH1 = -1
1413 XSQ = AMFPS/UMO
1414 GO TO 32536
14153251 CONTINUE
1416 IF (AMCH1.GT.AMFF) GO TO 3253
1417C*** PRODUCE AMFV
1418 AMCH1 = AMFV
1419 NNCH1 = 1
1420 XSQ = AMFV/UMO
1421 GO TO 32536
1422* | | | +----------------------------------------------------------*
1423* | | | | Here adjusting kinematics!!!!!
1424* | | | | Now, chain 1 is a single particle jet, so we have to
1425* | | | | reset the kinematical parameters xp, xxp, xt and xxt
1426* | | | |
142732536 CONTINUE
1428 XSQ2 = XSQ * XSQ
1429* | | | | +-------------------------------------------------------*
1430* | | | | | If also chain 2 is a parjet (nnch2 .ne. 0) then the
1431* | | | | | param. to be recomputed are xxp and xt, from alpha
1432* | | | | | and beta, in such a way to conserve the original
1433* | | | | | momentum direction
1434* | | | | |
1435 IF (NNCH2 .NE. 0) THEN
1436 XXSQ2 = XXSQ * XXSQ
1437 HELP = XSQ2 * (XSQ2 - 2.D0) + XXSQ2 *
1438 & (XXSQ2 - 2.D0) - 2.D0 * XSQ2 * XXSQ2
1439 DDIFF = SQRT (HELP + 1.D0)
1440 SSUM = SQRT (HELP + 1.D0 + 4.D0 * XSQ2)
1441 ALPHA = (SSUM + DDIFF) * 0.5D0
1442 BETA = (SSUM - DDIFF) * 0.5D0
1443 IF (XXP .GT. XT) THEN
1444 XXP = ALPHA
1445 XT = BETA
1446 ELSE
1447 XT = ALPHA
1448 XXP = BETA
1449 END IF
1450 XP = 1.D0 - XXP
1451 XXT = 1.D0 - XT
1452* | | | | |
1453* | | | | +-------------------------------------------------------*
1454 ELSE
1455* | | | | +-------------------------------------------------------*
1456* | | | | | If chain 2 is not a parjet (nnch2 .eq. 0) then the
1457* | | | | | paramet. xxp,xt have to be recomputed in such a way
1458* | | | | | to conserve the original momentum direction and
1459* | | | | | modulus
1460* | | | | |
1461 DDIFF = XXP - XT
1462 SSUM = SQRT (4.D0 * XSQ2 + DDIFF**2)
1463 XXP = (SSUM + DDIFF) * 0.5D0
1464 XT = (SSUM - DDIFF) * 0.5D0
1465 XP = 1.D0 - XXP
1466 XXT = 1.D0 - XT
1467 XXSQ = SQRT (XP * XXT)
1468 AMCH2 = XXSQ * UMO
1469 END IF
1470* | | | | |
1471* | | | | +-------------------------------------------------------*
1472* | | | | end kinematics correction
1473* | | | +----------------------------------------------------------*
1474
14753253 CONTINUE
1476 PCH1 = UMO*(XXP - XT)*.5D0
1477 ECH1 = UMO*(XXP + XT)*.5D0
1478 GAMCH1 = ECH1/AMCH1
1479 BGCH1 = PCH1/AMCH1
1480 PCH2 = UMO*(XP - XXT)*.5D0
1481 ECH2 = UMO*(XP + XXT)*.5D0
1482 GAMCH2 = ECH2/AMCH2
1483 BGCH2 = PCH2/AMCH2
1484 GO TO 34
1485* | | | end kin. sel. for meson proj. (baryon target), isam3 = 2
1486* | | +-->-->-->-->-->-->-->-->-->--> go to 34
1487
1488* | | +--<--<--<--<--<--<--<--<--<--< here from jump # 6
1489* | | |
1490 326 CONTINUE
1491C*** BACKWARD Q(XP)-QQ(XXT) CHAIN
1492 CALL BKLASS (IBF,IBB1,IBB2,IB8,IBIO)
1493 AMB8 = AM(IB8)
1494 AMB10 = AM(IBIO)
1495 NNCH2 = 0
1496 AMBB = AMB10 + 0.3D0
1497C===================================================================
1498C
1499C*** KINEMATICAL PARAMETERS OF BOTH CHAINS IN CMS
1500C MESON NUCLEON
1501C*** BACKWARD QUARK -DIQUARK CHAIN
1502C
1503C====================================================================
1504* | | | here xp, xxt are used for the jet # 2
1505 XXSQ = SQRT(XP*XXT)
1506 AMCH2 = UMO*XXSQ
1507 AA8 = IB8
1508 AA10 = IBIO
1509*or IF (IPRI .EQ. 1) WRITE(LUNOUT,103)XXSQ,AMCH1,AMCH2
1510*or & ,AA8,AA10,AMB8,AMB10
1511
1512* | | | +----------------------------------------------------------*
1513* | | | |
1514 IF (AMCH2 .LT. AMB8 ) GO TO 25
1515* | | | | if amch2 < amb8 xp and xt are resampled
1516* | | | +-->-->-->-->-->-->-->-->-->--> xp, xt resampling
1517
1518 IF (AMCH2 .GT. AMB10) GO TO 3261
1519C*** PRODUCE AMB8
1520 AMCH2 = AMB8
1521 NNCH2 = -1
1522 XXSQ = AMB8/UMO
1523 XXT = XXSQ**2/XP
1524*or IF (INUCVT .EQ. 1) GO TO 3263
1525 XT = 1.D0 - XXT
1526 GO TO 3263
15273261 CONTINUE
1528 IF (AMCH2 .GT. AMBB) GO TO 3263
1529C*** PRODUCE AMB10
1530 AMCH2 = AMB10
1531 NNCH2 = 1
1532 XXSQ = AMB10/UMO
1533 XXT = XXSQ**2/XP
1534*or IF (INUCVT .EQ. 1) GO TO 3263
1535 XT = 1.D0 - XXT
1536
1537C PCH1=UMO*(XXP-XT)*.5D0
1538C ECH1=UMO*(XXP+XT)*.5D0
1539C GAMCH1=ECH1/AMCH1
1540C BGCH1=PCH1/AMCH1
1541
1542 GO TO 3263
15433263 CONTINUE
1544 GO TO 3250
1545* | | |
1546* | | +-->-->-->-->-->-->-->-->-->--> jump # 7 to 3250
1547* | +----------------------------------------------------------------*
1548* |
1549* | +----------------------------------------------------------------*
1550* | | Meson projectile, meson target!!!
1551* | |
15523288 CONTINUE
1553
1554C================================================================
1555C
1556C*** KINEMATICAL PARAMETERS OF BOTH CHAINS IN CMS
1557C MESON MESON
1558C
1559C================================================================
1560 CALL GRNDM(RNDM,1)
1561 IF (RNDM(1) .LE. 0.5D0) GO TO 93288
1562 XT = XXT
1563 XXT = 1.D0 - XT
156493288 CONTINUE
1565 GO TO (3218,3258),ISAM3
1566* | | +-------------------------------------------------------------*
1567* | | | Meson projectile, meson target, isam3 = 1
1568* | | |
15693218 CONTINUE
1570C==================================================================
1571C*** MESON MESON Q(XXP)-AQ(XXT)+AQ(XP)-Q(XT)
1572C=================================================================
1573 GO TO 3228
1574* | | |
1575* | | +-->-->-->-->-->-->-->-->-->--> jump # 8 to 3228
1576
1577* | | +--<--<--<--<--<--<--<--<--<--< here from jump # 9
1578* | | |
157932598 CONTINUE
1580C=================================================================
1581C
1582C*** KINEMATICAL PARAMETERS OF BOTH CHAINS IN CMS
1583C MESON MESON
1584C*** FIRST LONG Q(XXP)-AQ(XXT) CHAIN
1585C
1586C===================================================================
1587 IIFB = IABS(IFB)
1588 IFPS = IMPS(IIFB,IFF)
1589 IFV = IMVE(IIFB,IFF)
1590 AMFPS = AM(IFPS)
1591* | | | Of course AMPV seems to be a mistyping for AMFV
1592* AMPV = AM(IFV)
1593 AMFV = AM(IFV)
1594 NNCH1 = 0
1595 AMFF = AMFV + 0.3D0
1596* | | | here we are using xxp, xxt for the jet # 1
1597 XSQ = SQRT(XXP*XXT)
1598 AMCH1 = UMO*XSQ
1599 AAPS = IFPS
1600 AAV = IFV
1601*or IF (IPRI .EQ. 1) WRITE(LUNOUT,103)XSQ,AMCH1,AMCH2
1602*or & ,AAPS,AAV,AMFPS,AMFV
1603
1604* | | +-------------------------------------------------------------*
1605* | | |
1606 IF (AMCH1 .LT. AMFPS) GO TO 25
1607* | | | if amch2 < amfps xp and xt are resampled
1608* | | +-->-->-->-->-->-->-->-->-->--> xp, xt resampling
1609
1610 IF (AMCH1 .GT. AMFV ) GO TO 32118
1611C*** PRODUCE AMFPS
1612 AMCH1 = AMFPS
1613 NNCH1 = -1
1614 XSQ = AMFPS/UMO
1615 GO TO 32133
161632118 CONTINUE
1617 IF (AMCH1 .GT. AMFF) GO TO 32138
1618C*** PRODUCE AMFV
1619 AMCH1 = AMFV
1620 NNCH1 = 1
1621 XSQ = AMFV/UMO
1622 GO TO 32133
1623* | | | +----------------------------------------------------------*
1624* | | | | Here adjusting kinematics!!!!!
1625* | | | | Now, chain 1 is a single particle jet, so we have to
1626* | | | | reset the kinematical parameters xp, xxp, xt and xxt
1627* | | | |
162832133 CONTINUE
1629 XSQ2 = XSQ * XSQ
1630* | | | | +-------------------------------------------------------*
1631* | | | | | If also chain 2 is a parjet (nnch2 .ne. 0) then the
1632* | | | | | param. to be recomputed are xxp and xxt, from alpha
1633* | | | | | and beta, in such a way to conserve the original
1634* | | | | | momentum direction
1635* | | | | |
1636 IF (NNCH2 .NE. 0) THEN
1637 XXSQ2 = XXSQ * XXSQ
1638 HELP = XSQ2 * (XSQ2 - 2.D0) + XXSQ2 *
1639 & (XXSQ2 - 2.D0) - 2.D0 * XSQ2 * XXSQ2
1640 DDIFF = SQRT (HELP + 1.D0)
1641 SSUM = SQRT (HELP + 1.D0 + 4.D0 * XSQ2)
1642 ALPHA = (SSUM + DDIFF) * 0.5D0
1643 BETA = (SSUM - DDIFF) * 0.5D0
1644 IF (XXP .GT. XXT) THEN
1645 XXP = ALPHA
1646 XXT = BETA
1647 ELSE
1648 XXT = ALPHA
1649 XXP = BETA
1650 END IF
1651 XP = 1.D0 - XXP
1652 XT = 1.D0 - XXT
1653* | | | | |
1654* | | | | +-------------------------------------------------------*
1655 ELSE
1656* | | | | +-------------------------------------------------------*
1657* | | | | | If chain 2 is not a parjet (nnch2 .eq. 0) then the
1658* | | | | | paramet. xxp,xxt have to be recomputed in such a way
1659* | | | | | to conserve the original momentum direction and
1660* | | | | | modulus
1661* | | | | |
1662 DDIFF = XXP - XXT
1663 SSUM = SQRT (4.D0 * XSQ2 + DDIFF**2)
1664 XXP = (SSUM + DDIFF) * 0.5D0
1665 XXT = (SSUM - DDIFF) * 0.5D0
1666 XP = 1.D0 - XXP
1667 XT = 1.D0 - XXT
1668 XXSQ = SQRT (XP * XT)
1669 AMCH2 = XXSQ * UMO
1670 END IF
1671* | | | | |
1672* | | | | +-------------------------------------------------------*
1673* | | | | end kinematics correction
1674* | | | +----------------------------------------------------------*
1675
167632138 CONTINUE
1677 PCH1 = UMO*(XXP - XXT)*.5D0
1678 ECH1 = UMO*(XXP + XXT)*.5D0
1679 GAMCH1 = ECH1/AMCH1
1680 BGCH1 = PCH1/AMCH1
1681 PCH2 = UMO*(XP - XT)*.5D0
1682 ECH2 = UMO*(XP + XT)*.5D0
1683 GAMCH2 = ECH2/AMCH2
1684 BGCH2 = PCH2/AMCH2
1685 GO TO 348
1686* | | | end kin. sel. for meson proj. (meson target), isam3 = 1
1687* | | +-->-->-->-->-->-->-->-->-->--> go to 348
1688
1689* | | +--<--<--<--<--<--<--<--<--<--< here from jump # 8
1690* | | |
16913228 CONTINUE
1692C===============================================================
1693C
1694C*** KINEMATICAL PARAMETERS OF BOTH CHAINS IN CMS
1695C MESON MESON
1696C*** SHORT AQ(XP)-Q(XT) CHAIN
1697C
1698C================================================================
1699 IIBF = IABS(IBF)
1700 IBPS = IMPS(IIBF,IBB)
1701 IBV = IMVE(IIBF,IBB)
1702 AMBPS = AM(IBPS)
1703 AMBV = AM(IBV)
1704 NNCH2 = 0
1705 AMBB = AMBV + 0.3D0
1706* | | | here we are using xp, xt for the jet # 2
1707 XXSQ = SQRT(XP*XT)
1708 AMCH2 = UMO*XXSQ
1709 AAPS = IBPS
1710 AAV = IBV
1711*or IF (IPRI .EQ. 1) WRITE(LUNOUT,103)XXSQ,AMCH1,AMCH2
1712*or & ,AAPS,AAV,AMBPS,AMBV
1713
1714* | | | +----------------------------------------------------------*
1715* | | | |
1716 IF (AMCH2 .LT. AMBPS) GO TO 25
1717* | | | | if amch2 < ambps xp and xt are resampled
1718* | | | +-->-->-->-->-->-->-->-->-->--> xp, xt resampling
1719
1720 IF (AMCH2 .GT. AMBV ) GO TO 32218
1721C*** PRODUCE AMBPS
1722 AMCH2 = AMBPS
1723 NNCH2 = -1
1724 XXSQ = AMBPS/UMO
1725 XT = XXSQ**2/XP
1726*or IF (INUCVT .EQ. 1) GO TO 32238
1727 XXT = 1.D0 - XT
1728 GO TO 32238
172932218 CONTINUE
1730 IF (AMCH2 .GT. AMBB) GO TO 32238
1731C*** PRODUCE AMBV
1732 AMCH2 = AMBV
1733 NNCH2 = 1
1734 XXSQ = AMBV/UMO
1735 XT = XXSQ**2/XP
1736*or IF (INUCVT .EQ. 1) GO TO 32238
1737 XXT = 1.D0 - XT
1738
1739C PCH1=UMO*(XXP-XXT)*.5D0
1740C ECH1=UMO*(XXP+XXT)*.5D0
1741C GAMCH1=ECH1/AMCH1
1742C BGCH1=PCH1/AMCH1
1743C GO TO 32238
1744
174532238 CONTINUE
1746 GO TO 32598
1747* | | |
1748* | | +-->-->-->-->-->-->-->-->-->--> jump # 9 to 32598
1749
1750* | | +-------------------------------------------------------------*
1751* | | | Meson projectile, meson target, isam3 = 2
1752* | | |
17533258 CONTINUE
1754C=================================================================
1755C
1756C*** KINEMATICAL PARAMETERS OF BOTH CHAINS IN CMS
1757C*** MESON MESON
1758C*** FORWARD ANTIQUARK-DIQUARK CHAIN
1759C
1760C=================================================================
1761 GO TO 3268
1762* | | |
1763* | | +-->-->-->-->-->-->-->-->-->--> jump # 10 to 3268
1764
1765* | | +--<--<--<--<--<--<--<--<--<--< here from jump # 11
1766* | | |
176732508 CONTINUE
1768C===================================================================
1769C*** MESON MESON FORWARD AQ(XXP)-Q(XT) AND BACKWARD CHAINS Q(XP)-AQ(
1770C*** XXT) CHAINS
1771C====================================================================
1772C=====================================================================
1773C
1774C*** KINEMATICAL PARAMETERS OF BOTH CHAINS IN CMS
1775C MESON MESON
1776C*** FORWARD AQ(XXP)-Q(XT) CHAIN
1777C
1778C====================================================================
1779 IIFF = IABS(IFF)
1780 IFPS = IMPS(IIFF,IFB)
1781 IFV = IMVE(IIFF,IFB)
1782 AMFPS = AM(IFPS)
1783 AMFV = AM(IFV)
1784 NNCH1 = 0
1785 AMFF = AMFV + 0.3D0
1786* | | | here we are using xxp, xt for the jet # 1
1787 XSQ = SQRT(XXP*XT)
1788 AMCH1 = UMO*XSQ
1789 AAPS = IFPS
1790 AAV = IFV
1791*or IF (IPRI .EQ. 1) WRITE(LUNOUT,103)XSQ,AMCH1,AMCH2
1792*or & ,AAPS,AAV,AMFPS,AMFV
1793
1794* | | | +----------------------------------------------------------*
1795* | | | |
1796 IF (AMCH1 .LT. AMFPS) GO TO 25
1797* | | | | if amch1 < amfps xp and xt are resampled
1798* | | | +-->-->-->-->-->-->-->-->-->--> xp, xt resampling
1799
1800 IF (AMCH1 .GT. AMFV) GO TO 32518
1801C*** PRODUCE AMFPS
1802 AMCH1 = AMFPS
1803 NNCH1 = -1
1804 XSQ = AMFPS/UMO
1805 GO TO 32535
180632518 CONTINUE
1807 IF (AMCH1 .GT. AMFF) GO TO 32538
1808C*** PRODUCE AMFV
1809 AMCH1 = AMFV
1810 NNCH1 = 1
1811 XSQ = AMFV/UMO
1812 GO TO 32535
1813* | | | +----------------------------------------------------------*
1814* | | | | Here adjusting kinematics!!!!!
1815* | | | | Now, chain 1 is a single particle jet, so we have to
1816* | | | | reset the kinematical parameters xp, xxp, xt and xxt
1817* | | | |
181832535 CONTINUE
1819 XSQ2 = XSQ * XSQ
1820* | | | | +-------------------------------------------------------*
1821* | | | | | If also chain 2 is a parjet (nnch2 .ne. 0) then the
1822* | | | | | param. to be recomputed are xxp and xt, from alpha
1823* | | | | | and beta, in such a way to conserve the original
1824* | | | | | momentum direction
1825* | | | | |
1826 IF (NNCH2 .NE. 0) THEN
1827 XXSQ2 = XXSQ * XXSQ
1828 HELP = XSQ2 * (XSQ2 - 2.D0) + XXSQ2 *
1829 & (XXSQ2 - 2.D0) - 2.D0 * XSQ2 * XXSQ2
1830 DDIFF = SQRT (HELP + 1.D0)
1831 SSUM = SQRT (HELP + 1.D0 + 4.D0 * XSQ2)
1832 ALPHA = (SSUM + DDIFF) * 0.5D0
1833 BETA = (SSUM - DDIFF) * 0.5D0
1834 IF (XXP .GT. XT) THEN
1835 XXP = ALPHA
1836 XT = BETA
1837 ELSE
1838 XT = ALPHA
1839 XXP = BETA
1840 END IF
1841 XP = 1.D0 - XXP
1842 XXT = 1.D0 - XT
1843* | | | | |
1844* | | | | +-------------------------------------------------------*
1845 ELSE
1846* | | | | +-------------------------------------------------------*
1847* | | | | | If chain 2 is not a parjet (nnch2 .eq. 0) then the
1848* | | | | | paramet. xxp,xt have to be recomputed in such a way
1849* | | | | | to conserve the original momentum direction and
1850* | | | | | modulus
1851* | | | | |
1852 DDIFF = XXP - XT
1853 SSUM = SQRT (4.D0 * XSQ2 + DDIFF**2)
1854 XXP = (SSUM + DDIFF) * 0.5D0
1855 XT = (SSUM - DDIFF) * 0.5D0
1856 XP = 1.D0 - XXP
1857 XXT = 1.D0 - XT
1858 XXSQ = SQRT (XP * XXT)
1859 AMCH2 = XXSQ * UMO
1860 END IF
1861* | | | | |
1862* | | | | +-------------------------------------------------------*
1863* | | | | end kinematics correction
1864* | | | +----------------------------------------------------------*
1865
186632538 CONTINUE
1867 PCH1 = UMO*(XXP - XT)*.5D0
1868 ECH1 = UMO*(XXP + XT)*.5D0
1869 GAMCH1 = ECH1/AMCH1
1870 BGCH1 = PCH1/AMCH1
1871 PCH2 = UMO*(XP - XXT)*.5D0
1872 ECH2 = UMO*(XP + XXT)*.5D0
1873 GAMCH2 = ECH2/AMCH2
1874 BGCH2 = PCH2/AMCH2
1875 GO TO 348
1876* | | | end kin. sel. meson proj. (meson target), isam3 = 2
1877* | | +-->-->-->-->-->-->-->-->-->--> go to 348
1878
1879* | | +--<--<--<--<--<--<--<--<--<--< here from jump # 10
1880* | | |
18813268 CONTINUE
1882C*** BACKWARD Q(XP)-AQ(XXT) CHAIN
1883 IIBB = IABS(IBB)
1884 IBPS = IMPS(IIBB,IBF)
1885 IBV = IMVE(IIBB,IBF)
1886 AMBPS = AM(IBPS)
1887 AMBV = AM(IBV)
1888 NNCH2 = 0
1889 AMBB = AMBV + 0.3D0
1890C===================================================================
1891C
1892C*** KINEMATICAL PARAMETERS OF BOTH CHAINS IN CMS
1893C MESON MESON
1894C*** BACKWARD QUARK -ANTIQUARK CHAIN
1895C
1896C====================================================================
1897* | | | here we are using xp, xxt for the jet # 2
1898 XXSQ = SQRT(XP*XXT)
1899 AMCH2 = UMO*XXSQ
1900 AAPS = IBPS
1901 AAV = IBV
1902*or IF (IPRI .EQ. 1) WRITE(LUNOUT,103)XSQ,AMCH1,AMCH2
1903*or & ,AAPS,AAV,AMBPS,AMBV
1904
1905* | | | +----------------------------------------------------------*
1906* | | | |
1907 IF (AMCH2 .LT. AMBPS) GO TO 25
1908* | | | | if amch2 < ambps xp and xt are resampled
1909* | | | +-->-->-->-->-->-->-->-->-->--> xp, xt resampling
1910
1911 IF (AMCH2 .GT. AMBV) GO TO 32618
1912C*** PRODUCE AMBPS
1913 AMCH2 = AMBPS
1914 NNCH2 = -1
1915 XXSQ = AMBPS/UMO
1916 XXT = XXSQ**2/XP
1917*or IF (INUCVT .EQ. 1) GO TO 32638
1918 XT = 1.D0 - XXT
1919 GO TO 32638
192032618 CONTINUE
1921 IF (AMCH2 .GT. AMBB) GO TO 32638
1922C*** PRODUCE AMBV
1923 AMCH2 = AMBV
1924 NNCH2 = 1
1925 XXSQ = AMBV /UMO
1926 XXT = XXSQ**2/XP
1927*or IF (INUCVT .EQ. 1) GO TO 32638
1928 XT = 1.D0 - XXT
1929
1930C PCH1=UMO*(XXP-XT)*.5D0
1931C ECH1=UMO*(XXP+XT)*.5D0
1932C GAMCH1=ECH1/AMCH1
1933C BGCH1=PCH1/AMCH1
1934
1935 GO TO 32638
193632638 CONTINUE
1937 GO TO 32508
1938* | | |
1939* | | +-->-->-->-->-->-->-->-->-->--> jump # 11 to 32508
1940* | +----------------------------------------------------------------*
1941
1942 348 CONTINUE
1943*or IF (IPRI .EQ. 1) WRITE(LUNOUT,103)XP,XT,XXP,XXT
1944*or IF (IPRI .EQ. 1) WRITE(LUNOUT,103)AMCH1,AMCH2,PCH1,PCH2,ECH1,
1945*or &ECH2,GAMCH1,GAMCH2,BGCH1,BGCH2
1946 GO TO 34
1947* | | end kin. sel. meson proj. (meson target)
1948* | +-->-->-->-->-->-->-->-->-->--> go to 34
1949
1950* | +----------------------------------------------------------------*
1951* | | meson projectile, antibaryon target!!!
1952* | |
19533277 CONTINUE
1954C=================================================================
1955C
1956C*** KINEMATICAL PARAMETERS OF BOTH CHAINS IN CMS
1957C MESON ANTIBARYON
1958C
1959C===============================================================
1960C====================================================================
1961C====================================================================
1962C TO BE CORRECTED
1963C
1964C====================================================================
1965C`===================================================================
1966 GO TO (3217,3257),ISAM3
1967* | | +-------------------------------------------------------------*
1968* | | | meson projectile, antibaryon target, isam = 2
1969* | | |
19703257 CONTINUE
1971C*** MESON NUCLEON AQ(XXP)-AQAQ(XXT)+Q(XP)-AQ(XT)
1972 GO TO 3227
1973* | | |
1974* | | +-->-->-->-->-->-->-->-->-->--> jump # 12 to 3227
1975
1976* | | +--<--<--<--<--<--<--<--<--<--< here from jump # 13
1977* | | |
197832597 CONTINUE
1979C=================================================================
1980C
1981C*** KINEMATICAL PARAMETERS OF BOTH CHAINS IN CMS
1982C MESON ANTINUCLEON
1983C*** FIRST LONG AQ(XXP)-AQAQ(XXT) CHAIN
1984C
1985C===================================================================
1986 CALL BKLASS (IBF,IBB1,IBB2,IF8,IFIO)
1987 AMF8 = AM(IF8)
1988 AMF10 = AM(IFIO)
1989 NNCH1 = 0
1990 AMFF = AMF10 + 0.3D0
1991* | | | here we are using xxp, xxt for the jet # 1
1992 XSQ = SQRT(XXP*XXT)
1993 AMCH1 = UMO*XSQ
1994 AA8 = IF8
1995 AA10 = IFIO
1996*or IF (IPRI .EQ. 1) WRITE(LUNOUT,103)XSQ,AMCH1,AMCH2
1997*or & ,AA8,AA10,AMF8,AMF10
1998
1999* | | | +----------------------------------------------------------*
2000* | | | |
2001 IF (AMCH1 .LT. AMF8) GO TO 25
2002* | | | | if amch1 < amf8 xp and xt are resampled
2003* | | | +-->-->-->-->-->-->-->-->-->--> xp, xt resampling
2004
2005 IF (AMCH1 .GT. AMF10) GO TO 32117
2006C*** PRODUCE AMF8
2007 AMCH1 = AMF8
2008 NNCH1 = -1
2009 XSQ = AMF8/UMO
2010 GO TO 32135
201132117 CONTINUE
2012 IF (AMCH1 .GT. AMFF) GO TO 32137
2013C*** PRODUCE AMF10
2014 AMCH1 = AMF10
2015 NNCH1 = 1
2016 XSQ = AMF10/UMO
2017 GO TO 32135
2018* | | | +----------------------------------------------------------*
2019* | | | | Here adjusting kinematics!!!!!
2020* | | | | Now, chain 1 is a single particle jet, so we have to
2021* | | | | reset the kinematical parameters xp, xxp, xt and xxt
2022* | | | |
202332135 CONTINUE
2024 XSQ2 = XSQ * XSQ
2025* | | | | +-------------------------------------------------------*
2026* | | | | | If also chain 2 is a parjet (nnch2 .ne. 0) then the
2027* | | | | | param. to be recomputed are xxp and xxt, from alpha
2028* | | | | | and beta, in such a way to conserve the original
2029* | | | | | momentum direction
2030* | | | | |
2031 IF (NNCH2 .NE. 0) THEN
2032 XXSQ2 = XXSQ * XXSQ
2033 HELP = XSQ2 * (XSQ2 - 2.D0) + XXSQ2 *
2034 & (XXSQ2 - 2.D0) - 2.D0 * XSQ2 * XXSQ2
2035 DDIFF = SQRT (HELP + 1.D0)
2036 SSUM = SQRT (HELP + 1.D0 + 4.D0 * XSQ2)
2037 ALPHA = (SSUM + DDIFF) * 0.5D0
2038 BETA = (SSUM - DDIFF) * 0.5D0
2039 IF (XXP .GT. XXT) THEN
2040 XXP = ALPHA
2041 XXT = BETA
2042 ELSE
2043 XXT = ALPHA
2044 XXP = BETA
2045 END IF
2046 XP = 1.D0 - XXP
2047 XT = 1.D0 - XXT
2048* | | | | |
2049* | | | | +-------------------------------------------------------*
2050 ELSE
2051* | | | | +-------------------------------------------------------*
2052* | | | | | If chain 2 is not a parjet (nnch2 .eq. 0) then the
2053* | | | | | paramet. xxp,xxt have to be recomputed in such a way
2054* | | | | | to conserve the original momentum direction and
2055* | | | | | modulus
2056* | | | | |
2057 DDIFF = XXP - XXT
2058 SSUM = SQRT (4.D0 * XSQ2 + DDIFF**2)
2059 XXP = (SSUM + DDIFF) * 0.5D0
2060 XXT = (SSUM - DDIFF) * 0.5D0
2061 XP = 1.D0 - XXP
2062 XT = 1.D0 - XXT
2063 XXSQ = SQRT (XP * XT)
2064 AMCH2 = XXSQ * UMO
2065 END IF
2066* | | | | |
2067* | | | | +-------------------------------------------------------*
2068* | | | | end kinematics correction
2069* | | | +----------------------------------------------------------*
2070
207132137 CONTINUE
2072 PCH1 = UMO*(XXP - XXT)*.5D0
2073 ECH1 = UMO*(XXP + XXT)*.5D0
2074 GAMCH1 = ECH1/AMCH1
2075 BGCH1 = PCH1/AMCH1
2076 PCH2 = UMO*(XP - XT)*.5D0
2077 ECH2 = UMO*(XP + XT)*.5D0
2078 GAMCH2 = ECH2/AMCH2
2079 BGCH2 = PCH2/AMCH2
2080 GO TO 34
2081* | | | end kin. sel. meson proj. (abaryon target), isam3 = 2
2082* | | +-->-->-->-->-->-->-->-->-->--> go to 34
2083
2084* | | +--<--<--<--<--<--<--<--<--<--< here from jump # 12
2085* | | |
20863227 CONTINUE
2087C===============================================================
2088C
2089C*** KINEMATICAL PARAMETERS OF BOTH CHAINS IN CMS
2090C MESON ANTINUCLEON
2091C*** SHORT AQ(XP)-Q(XT) CHAIN
2092C
2093C================================================================
2094 IIFB = IABS(IFB)
2095 IBPS = IMPS(IIFB,IFF)
2096 IBV = IMVE(IIFB,IFF)
2097 AMBPS = AM(IBPS)
2098 AMBV = AM(IBV)
2099 NNCH2 = 0
2100 AMBB = AMBV + 0.3D0
2101* | | | here we are using xp,xt for jet # 2
2102 XXSQ = SQRT(XP*XT)
2103 AMCH2 = UMO*XXSQ
2104 AAPS = IBPS
2105 AAV = IBV
2106*or IF (IPRI .EQ. 1) WRITE(LUNOUT,103)XSQ,AMCH1,AMCH2
2107*or & ,AAPS,AAV,AMBPS,AMBV
2108
2109* | | | +----------------------------------------------------------*
2110* | | | |
2111 IF (AMCH2 .LT. AMBPS) GO TO 25
2112* | | | | if amch2 < ambps xp and xt are resampled
2113* | | | +-->-->-->-->-->-->-->-->-->--> xp, xt resampling
2114
2115 IF (AMCH2 .GT. AMBV) GO TO 32217
2116C*** PRODUCE AMBPS
2117 AMCH2 = AMBPS
2118 NNCH2 = -1
2119 XXSQ = AMBPS/UMO
2120 XT = XXSQ**2/XP
2121*or IF (INUCVT .EQ. 1) GO TO 32237
2122 XXT = 1.D0 - XT
2123 GO TO 32237
212432217 CONTINUE
2125 IF (AMCH2 .GT. AMBB) GO TO 32237
2126C*** PRODUCE AMBV
2127 AMCH2 = AMBV
2128 NNCH2 = 1
2129 XXSQ = AMBV/UMO
2130 XT = XXSQ**2/XP
2131*or IF (INUCVT .EQ. 1) GO TO 32237
2132 XXT = 1.D0 - XT
2133
2134C PCH1=UMO*(XXP-XXT)*.5D0
2135C ECH1=UMO*(XXP+XXT)*.5D0
2136C GAMCH1=ECH1/AMCH1
2137C BGCH1=PCH1/AMCH1
2138C GO TO 32237
2139
214032237 CONTINUE
2141 GO TO 32597
2142* | | |
2143* | | +-->-->-->-->-->-->-->-->-->--> jump # 13 to 32597
2144
2145* | | +-------------------------------------------------------------*
2146* | | | meson projectile, antibaryon target, isam = 1
2147* | | |
21483217 CONTINUE
2149C=================================================================
2150C
2151C*** KINEMATICAL PARAMETERS OF BOTH CHAINS IN CMS
2152C*** MESON ANTINUCLEUS
2153C*** BACKWARD QUARK- ANTIQUARK CHAIN
2154C
2155C=================================================================
215632507 CONTINUE
2157C=====================================================================
2158C
2159C MESON ANTINUCLEON
2160C*** BACKWARD Q(XP)-AQ(XT) CHAIN
2161C
2162C====================================================================
2163 IIBB = IABS(IBB)
2164 IFPS = IMPS(IIBB,IBF)
2165 IFV = IMVE(IIBB,IBF)
2166 AMFPS = AM(IFPS)
2167 AMFV = AM(IFV)
2168 NNCH1 = 0
2169 AMFF = AMFV + 0.3D0
2170* | | | here we are using xp,xt for jet # 1
2171 XSQ = SQRT(XP*XT)
2172 AMCH1 = UMO*XSQ
2173 AAPS = IFPS
2174 AAV = IFV
2175*or IF (IPRI .EQ. 1) WRITE(LUNOUT,103)XSQ,AMCH1,AMCH2
2176*or & ,AAPS,AAV,AMFPS,AMFV
2177
2178* | | | +----------------------------------------------------------*
2179* | | | |
2180 IF (AMCH1 .LT. AMFPS) GO TO 25
2181* | | | | if amch1 < amfps xp and xt are resampled
2182* | | | +-->-->-->-->-->-->-->-->-->--> xp, xt resampling
2183
2184 IF (AMCH1 .GT. AMFV) GO TO 32517
2185C*** PRODUCE AMFPS
2186 AMCH1 = AMFPS
2187 NNCH1 = -1
2188 XSQ = AMFPS/UMO
2189 XP = XSQ**2/XT
2190 XXP = 1.D0 - XP
2191 GO TO 32537
219232517 CONTINUE
2193 IF (AMCH1 .GT. AMFF) GO TO 32537
2194C*** PRODUCE AMFV
2195 AMCH1 = AMFV
2196 NNCH1 = 1
2197 XSQ = AMFV/UMO
2198 XP = XSQ**2/XT
2199 XXP = 1.D0 - XP
2200 GO TO 32537
220132537 CONTINUE
2202 GO TO 3267
22033267 CONTINUE
2204C***FORWARD AQ(XXP)-AQAQ(XXT) CHAIN
2205 CALL BKLASS(IFF,IFB1,IFB2,IB8,IBIO)
2206 AMB8 = AM(IB8)
2207 AMB10 = AM(IBIO)
2208 NNCH2 = 0
2209 AMBB = AMB10 + 0.3D0
2210C===================================================================
2211C
2212C*** KINEMATICAL PARAMETERS OF BOTH CHAINS IN CMS
2213C MESON ANTINUCLEON
2214C*** FORWARD ANTIQUARK -ANTIDIQUARK CHAIN
2215C
2216C====================================================================
2217* | | | here we are using xxp,xXt for jet # 2
2218 XXSQ = SQRT(XXP*XXT)
2219 AMCH2 = UMO*XXSQ
2220 AA8 = IB8
2221 AA10 = IBIO
2222*or IF (IPRI .EQ. 1) WRITE(LUNOUT,103)XSQ,AMCH1,AMCH2
2223*or & ,AA8,AA10,AMB8,AMB10
2224
2225* | | | +----------------------------------------------------------*
2226* | | | |
2227 IF (AMCH2 .LT. AMB8 ) GO TO 25
2228* | | | | if amch2 < amb8 xp and xt are resampled
2229* | | | +-->-->-->-->-->-->-->-->-->--> xp, xt resampling
2230
2231 IF (AMCH2 .GT. AMB10) GO TO 32617
2232C*** PRODUCE AMB8
2233 AMCH2 = AMB8
2234 NNCH2 = -1
2235 XXSQ = AMB8/UMO
2236*or IF (INUCVT .EQ. 1) GO TO 32637
2237 GO TO 32636
223832617 CONTINUE
2239 IF (AMCH2 .GT. AMBB) GO TO 32637
2240C*** PRODUCE AMB10
2241 AMCH2 = AMB10
2242 NNCH2 = 1
2243 XXSQ = AMB10/UMO
2244*or IF (INUCVT .EQ. 1) GO TO 32637
2245
2246C PCH1=UMO*(XXP-XT)*.5D0
2247C ECH1=UMO*(XXP+XT)*.5D0
2248C GAMCH1=ECH1/AMCH1
2249C BGCH1=PCH1/AMCH1
2250* Here there was a "large" mistake in the old Hadevt!!!
2251 GO TO 32636
2252* | | | +----------------------------------------------------------*
2253* | | | | Here adjusting kinematics!!!!!
2254* | | | | Now, chain 2 is a single particle jet, so we have to
2255* | | | | reset the kinematical parameters xp, xxp, xt and xxt
2256* | | | |
225732636 CONTINUE
2258 XXSQ2 = XXSQ * XXSQ
2259* | | | | +-------------------------------------------------------*
2260* | | | | | If also chain 1 is a parjet (nnch1 .ne. 0) then the
2261* | | | | | param. to be recomputed are xxp and xxt, from alpha
2262* | | | | | and beta, in such a way to conserve the original
2263* | | | | | momentum direction
2264* | | | | |
2265 IF (NNCH1 .NE. 0) THEN
2266 XSQ2 = XSQ * XSQ
2267 HELP = XSQ2 * (XSQ2 - 2.D0) + XXSQ2 *
2268 & (XXSQ2 - 2.D0) - 2.D0 * XSQ2 * XXSQ2
2269 DDIFF = SQRT (HELP + 1.D0)
2270 SSUM = SQRT (HELP + 1.D0 + 4.D0 * XXSQ2)
2271 ALPHA = (SSUM + DDIFF) * 0.5D0
2272 BETA = (SSUM - DDIFF) * 0.5D0
2273 IF (XXP .GT. XXT) THEN
2274 XXP = ALPHA
2275 XXT = BETA
2276 ELSE
2277 XXT = ALPHA
2278 XXP = BETA
2279 END IF
2280 XP = 1.D0 - XXP
2281 XT = 1.D0 - XXT
2282* | | | | |
2283* | | | | +-------------------------------------------------------*
2284 ELSE
2285* | | | | +-------------------------------------------------------*
2286* | | | | | If chain 1 is not a parjet (nnch1 .eq. 0) then the
2287* | | | | | paramet. xxp,xxt have to be recomputed in such a way
2288* | | | | | to conserve the original momentum direction and
2289* | | | | | modulus
2290* | | | | |
2291 DDIFF = XXP - XXT
2292 SSUM = SQRT (4.D0 * XXSQ2 + DDIFF**2)
2293 XXP = (SSUM + DDIFF) * 0.5D0
2294 XXT = (SSUM - DDIFF) * 0.5D0
2295 XP = 1.D0 - XXP
2296 XT = 1.D0 - XXT
2297 XSQ = SQRT (XP * XT)
2298 AMCH1 = XSQ * UMO
2299 END IF
2300* | | | | |
2301* | | | | +-------------------------------------------------------*
2302* | | | | end kinematics correction
2303* | | | +----------------------------------------------------------*
2304
230532637 CONTINUE
2306 PCH1 = UMO*(XP - XT)*.5D0
2307 ECH1 = UMO*(XP + XT)*.5D0
2308 GAMCH1 = ECH1/AMCH1
2309 BGCH1 = PCH1/AMCH1
2310 PCH2 = UMO*(XXP - XXT)*.5D0
2311 ECH2 = UMO*(XXP + XXT)*.5D0
2312 GAMCH2 = ECH2/AMCH2
2313 BGCH2 = PCH2/AMCH2
2314 GO TO 34
2315* | | | end kin. sel. meson proj. (abaryon target), isam3 = 1
2316* | | +-->-->-->-->-->-->-->-->-->--> go to 34
2317* | +----------------------------------------------------------------*
2318 34 CONTINUE
2319* | end of kinematical selections!!!!!!!!!
2320* +-------------------------------------------------------------------*
2321*or IF (IPRI .EQ. 1) WRITE(LUNOUT,103)XP,XT,XXP,XXT
2322*or IF (IPRI .EQ. 1) WRITE(LUNOUT,103)AMCH1,AMCH2,PCH1,PCH2,
2323*or &ECH1,ECH2,GAMCH1,GAMCH2,BGCH1,BGCH2
2324C
2325C********************************************************************
2326C
2327C*** MC SAMPLING OF FORWARD CHAIN
2328C
2329C********************************************************************
2330C
2331 IF (IBPROJ) 41,42,43
2332C==================================================================
2333C FORWARD CHAIN OF ANTIBARYON BARYON
2334C==================================================================
2335 41 CONTINUE
2336 IF (NNCH1) 4111,4112,4113
23374111 CONTINUE
2338 ICH1 = IFPS
2339 GO TO 4114
23404113 CONTINUE
2341 ICH1 = IFV
2342 GO TO 4114
23434112 CONTINUE
2344 IF (IOPBAM .EQ. 5) THEN
2345 IAIFF1 = IABS(IFF1) + 6
2346 IAIFF2 = IABS(IFF2) + 6
2347*or IF (IPRI .EQ. 1)WRITE(LUNOUT,991)IFB1,IFB2,IAIFF1
2348*or 991 FORMAT (' BAMJEV 4112',5I5)
2349 CALL BAMJEV(IHAD,IFB1,IFB2,IAIFF1,IAIFF2,AMCH1,5)
2350 ELSE
2351 IAIFF = IABS(IAIFF) + 6
2352 CALL BAMJEV(IHAD,IFB,IAIFF,IFB,IFB,AMCH1,IOPBAM)
2353 END IF
2354 GO TO 4115
23554114 CONTINUE
2356*or IF (IPRI .EQ. 1) WRITE(LUNOUT,992)ICH1
2357*or 992 FORMAT (' PARJET 4114 ',5I5)
2358 CALL PARJET(IHAD,ICH1)
23594115 CONTINUE
2360C
2361C
2362C
2363C CALL DECAY(IHAD,2)
2364 GO TO 44
236542 CONTINUE
2366C=====================================================================
2367C*** FORWARD CHAIN OF MESON NUCLEON
2368C======================================================================
2369 IF (IBTARG) 427,428,429
2370 429 CONTINUE
2371 GO TO (421,422),ISAM3
2372 421 CONTINUE
2373 IF (NNCH1) 4211,4212,4213
23744211 CONTINUE
2375 ICH1 = IF8
2376 GO TO 4214
23774213 CONTINUE
2378 ICH1 = IFIO
2379 GO TO 4214
23804212 CONTINUE
2381 CALL BAMJEV(IHAD,IFF,IFB1,IFB2,IFF,AMCH1,4)
2382 GO TO 4215
23834214 CONTINUE
2384 CALL PARJET(IHAD,ICH1)
23854215 CONTINUE
2386C CALL DECAY(IHAD,2)
2387 GO TO 44
2388422 CONTINUE
2389C*** IFA - IFB AQ - Q EXISTIERT NICHT
2390 IF (NNCH1) 4221,4222,4223
23914221 CONTINUE
2392 ICH1 = IFPS
2393 GO TO 4224
23944223 CONTINUE
2395 ICH1 = IFV
2396 GO TO 4224
23974222 CONTINUE
2398 IAIFF = IABS(IFF) + 6
2399 CALL BAMJEV(IHAD,IFB,IAIFF,IFB,IFB,AMCH1,3)
2400 GO TO 4225
24014224 CONTINUE
2402 CALL PARJET(IHAD,ICH1)
24034225 CONTINUE
2404C CALL DECAY(IHAD,2)
2405 GO TO 44
2406C===================================================================
2407C
2408C FORWARD CHAIN OF MESON MESON
2409C
2410C====================================================================
2411C=====================================================================
2412 428 CONTINUE
2413 GO TO (4218,4228),ISAM3
24144218 CONTINUE
2415 IF (NNCH1) 42118,42128,42138
241642118 CONTINUE
2417 ICH1 = IFPS
2418 GO TO 42148
241942138 CONTINUE
2420 ICH1 = IFV
2421 GO TO 42148
242242128 CONTINUE
2423 IAIFB = IABS(IFB) + 6
2424 CALL BAMJEV(IHAD,IFF,IAIFB,IFB2,IFF,AMCH1,3)
2425 GO TO 42158
242642148 CONTINUE
2427 CALL PARJET(IHAD,ICH1)
242842158 CONTINUE
2429C CALL DECAY(IHAD,2)
2430 GO TO 44
24314228 CONTINUE
2432C*** IFA - IFB AQ - Q EXISTIERT NICHT
2433 IF (NNCH1) 42218,42228,42238
243442218 CONTINUE
2435 ICH1 = IFPS
2436 GO TO 42248
243742238 CONTINUE
2438 ICH1 = IFV
2439 GO TO 42248
244042228 CONTINUE
2441 IAIFF = IABS(IFF) + 6
2442 CALL BAMJEV(IHAD,IFB,IAIFF,IFB,IFB,AMCH1,3)
2443 GO TO 42258
244442248 CONTINUE
2445 CALL PARJET(IHAD,ICH1)
244642258 CONTINUE
2447C CALL DECAY(IHAD,2)
2448 GO TO 44
2449C================================================================
2450C
2451C FORWARD CHAIN OF MESON ANTIBARYON
2452C
2453C==================================================================
2454 427 CONTINUE
2455C=================================================================
2456C TO BE CORRECTED
2457C=================================================================
2458 GO TO (4217,4227),ISAM3
24594227 CONTINUE
2460 IF (NNCH1) 42117,42127,42137
246142117 CONTINUE
2462 ICH1 = IF8
2463 GO TO 42147
246442137 CONTINUE
2465 ICH1 = IFIO
2466 GO TO 42147
246742127 CONTINUE
2468 IAIBF = IABS(IBF) + 6
2469 IAIBB1= IABS(IBB1) + 6
2470 IAIBB2= IABS(IBB2) + 6
2471*or IF (IPRI.EQ.1) WRITE(LUNOUT,994)IAIBF,IAIBB1,IAIBB2
2472*or 994 FORMAT(' BAMJEV 43147',5I5)
2473 CALL BAMJEV(IHAD,IAIBF,IAIBB1,IAIBB2,IBB,AMCH1,4)
2474 GO TO 42157
247542147 CONTINUE
2476*or IF (IPRI.EQ.1) WRITE(LUNOUT,993)ICH1
2477*or 993 FORMAT (' PARJET 42147',5I5)
2478 CALL PARJET(IHAD,ICH1)
247942157 CONTINUE
2480C CALL DECAY(IHAD,2)
2481 GO TO 44
24824217 CONTINUE
2483C*** IFA - IFB AQ - Q EXISTIERT NICHT
2484 IF (NNCH2) 42217,42227,42237
248542217 CONTINUE
2486 ICH1 = IB8
2487 GO TO 42247
248842237 CONTINUE
2489 ICH1 = IBIO
2490 GO TO 42247
249142227 CONTINUE
2492 IAIFF = IABS(IFF) + 6
2493 IAIFB1= IABS(IFB1) + 6
2494 IAIFB2= IABS(IFB2) + 6
2495*or IF (IPRI.EQ.1) WRITE(LUNOUT,995)IAIFF,IAIFB1,IAIFB2
2496*or 995 FORMAT (' BAMJEV 42227',5I5)
2497 CALL BAMJEV(IHAD,IAIFF,IAIFB1,IAIFB2,IFB,AMCH2,4)
2498 GO TO 42257
249942247 CONTINUE
2500*or IF (IPRI.EQ.1) WRITE(LUNOUT,996)ICH1
2501*or 996 FORMAT ('PARJET 42247',5I5)
2502 CALL PARJET(IHAD,ICH1)
250342257 CONTINUE
2504C CALL DECAY(IHAD,2)
2505 GO TO 44
2506 43 CONTINUE
2507C==================================================================
2508C*** FORWARD CHAIN OF NUCLEON NUCLEON
2509C===================================================================
2510 IF (NNCH1) 431,432,433
2511 431 CONTINUE
2512 ICH1 = IF8
2513 GO TO 434
2514 433 CONTINUE
2515 ICH1 = IF10
2516 GO TO 434
2517 432 CONTINUE
2518 CALL BAMJEV(IHAD,IFB,IFF1,IFF2,IFB,AMCH1,4)
2519 GO TO 435
2520 434 CONTINUE
2521 CALL PARJET(IHAD,ICH1)
2522 435 CONTINUE
2523C CALL DECAY(IHAD,2)
2524 44 CONTINUE
2525C*** TURN CHAINS AROUND IF NECESSARY
2526 IF (IBPROJ) 51,52,53
2527 51 CONTINUE
2528 GO TO 55
2529 52 CONTINUE
2530C*** MESON NUCLEON
2531 GO TO (521,522),ISAM3
2532 521 CONTINUE
2533 GO TO 54
2534 522 CONTINUE
2535C*** TURN JET
2536 GO TO 55
2537 53 CONTINUE
2538C*** NUCLEON-NUCLEON
2539C*** TURN JET
2540 GO TO 55
2541 55 CONTINUE
2542C*** TURN JET AROUND
2543 DO 56 I=1,IHAD
2544 PZF(I) = -PZF(I)
2545 56 CONTINUE
2546 54 CONTINUE
2547 IIIHAD = IHAD
2548C*** AND INT. CHAIN TRANSVERSE MOMENTA
2549 B3SAVE = B3BAMJ
2550* This is consistent with b3bamj = 10 for an initial value of 6
2551 B3BAMJ = 1.666666666666667D+00 * B3BAMJ
2552* B3BAMJ = 5.D+00 / ( LOG10 ( 1.D+00 + ( UMO / E00 )**1.5D+00 )
2553* & + 1.D+00 )
2554 CALL GRNDM(RNDM,2)
2555 ES = -2.D0/(B3BAMJ**2)*LOG(RNDM(1)*RNDM(2))
2556 B3BAMJ = B3SAVE
2557* HPS = SQRT(ES*ES+2.D0*ES*AMCH1)
2558 HPS = SQRT(ES*ES+2.D0*ES*AM(1))
2559 CALL SFECFE(SFE,CFE)
2560*
2561* tentative guess
2562*
2563 PTXCH1 = HPS * CFE
2564 PTYCH1 = HPS * SFE
2565* +-------------------------------------------------------------------*
2566* | Loop to establish the transverse momentum
2567 GO TO 6171
25686170 CONTINUE
2569 PTXCH1 = 0.75D0 * PTXCH1
2570 PTYCH1 = 0.75D0 * PTYCH1
25716171 CONTINUE
2572 IHAD = IIIHAD
2573* | The following two cards provide momentum conservation for
2574* | x and y components
2575 PTXCH2 = -PTXCH1
2576 PTYCH2 = -PTYCH1
2577 BGCH1X = PTXCH1/AMCH1
2578 BGCH1Y = PTYCH1/AMCH1
2579 ACH1 = BGCH1**2-(PTXCH1**2+PTYCH1**2)/AMCH1**2
2580 IF (ACH1.LE.0.D0) GO TO 6170
2581* |
2582* +--<--<--<--<--< if Pt is too large loop again on the forward jet
2583 BGCH2X = PTXCH2/AMCH2
2584 BGCH2Y = PTYCH2/AMCH2
2585 ACH2 = BGCH2**2-(PTXCH2**2+PTYCH2**2)/AMCH2**2
2586 IF (ACH2.LE.0.D0) GO TO 6170
2587* |
2588* +--<--<--<--<--<--<--<--<--<--< if Pt is too large loop again
2589 BGCH1Z = SQRT(ACH1)
2590 BGCH1Z = SIGN(BGCH1Z,BGCH1)
2591 BGCH2Z = SQRT(ACH2)
2592 BGCH2Z = SIGN(BGCH2Z,BGCH2)
2593
2594 CALL LORTRA(IHAD,1,GAMCH1,BGCH1X,BGCH1Y,BGCH1Z)
2595C==============================================================
2596C
2597C*** TRANSFORM FORWARD JET INTO CMS
2598C
2599C================================================================
2600 IHAD = IIIHAD
2601 NAUX = IHAD
2602C===============================================================
2603C
2604C*** SAMPLING OF BACKWARD CHAIN
2605C
2606C===============================================================
2607 IF (IBPROJ) 61,62,63
2608 61 CONTINUE
2609C================================================================
2610C BACKWARD CHAIN OF ANTINUCLEON NUCLEON
2611C=================================================================
2612 IF (NNCH2) 6111,6112,6113
26136111 CONTINUE
2614 ICH2 = IBPS
2615 GO TO 6114
26166113 CONTINUE
2617 ICH2 = IBV
2618 GO TO 6114
26196112 CONTINUE
2620 IAIBF = IABS(IBF) + 6
2621 CALL BAMJEV(IHAD,IBB,IAIBF,IBB,IBB,AMCH2,3)
2622 GO TO 6115
26236114 CONTINUE
2624 CALL PARJET(IHAD,ICH2)
26256115 CONTINUE
2626C
2627C
2628C CALL DECAY(IHAD,2)
2629 GO TO 64
2630 62 CONTINUE
2631C================================================================
2632C*** BACKWARD CHAIN OF MESON - BARYON
2633C==================================================================
2634 IF (IBTARG) 627,628,629
2635 629 CONTINUE
2636 GO TO (621,622),ISAM3
2637 621 CONTINUE
2638 IF (NNCH2) 6211,6212,6213
26396211 CONTINUE
2640 ICH2 = IBPS
2641 GO TO 6214
26426213 CONTINUE
2643 ICH2 = IBV
2644 GO TO 6214
26456212 CONTINUE
2646 IAIBF = IABS(IBF) + 6
2647 CALL BAMJEV(IHAD,IBB,IAIBF,IBB,IBB,AMCH2,3)
2648 GO TO 6215
26496214 CONTINUE
2650 CALL PARJET(IHAD,ICH2)
26516215 CONTINUE
2652C CALL DECAY(IHAD,2)
2653 GO TO 64
2654622 CONTINUE
2655 IF (NNCH2) 6221,6222,6223
26566221 CONTINUE
2657 ICH2 = IB8
2658 GO TO 6224
26596223 CONTINUE
2660 ICH2 = IBIO
2661 GO TO 6224
26626222 CONTINUE
2663 CALL BAMJEV(IHAD,IBF,IBB1,IBB2,IBF,AMCH2,4)
2664 GO TO 6225
26656224 CONTINUE
2666 CALL PARJET(IHAD,ICH2)
26676225 CONTINUE
2668C CALL DECAY(IHAD,2)
2669 GO TO 64
2670C==================================================================
2671C
2672C BACKWARD CHAIN OF MESON MESON
2673C
2674C===================================================================
2675C TO BE CORRECTED
2676C===================================================================
2677 628 CONTINUE
2678 GO TO(6218,6228),ISAM3
26796218 CONTINUE
2680 IF (NNCH2) 62118,62128,62138
268162118 CONTINUE
2682 ICH2 = IBPS
2683 GO TO 62148
268462138 CONTINUE
2685 ICH2 = IBV
2686 GO TO 62148
268762128 CONTINUE
2688 IAIBF = IABS(IBF) + 6
2689 CALL BAMJEV(IHAD,IBB,IAIBF,IBB,IBB,AMCH2,3)
2690 GO TO 62158
269162148 CONTINUE
2692 CALL PARJET(IHAD,ICH2)
269362158 CONTINUE
2694C CALL DECAY(IHAD,2)
2695 GO TO 64
26966228 CONTINUE
2697 IF (NNCH2) 62218,62228,62238
269862218 CONTINUE
2699 ICH2 = IBPS
2700 GO TO 62248
270162238 CONTINUE
2702 ICH2 = IBV
2703 GO TO 62248
270462228 CONTINUE
2705 IAIBB = IABS(IBB) + 6
2706 CALL BAMJEV(IHAD,IBF,IAIBB,IBB2,IBF,AMCH2,3)
2707 GO TO 62258
270862248 CONTINUE
2709 CALL PARJET(IHAD,ICH2)
271062258 CONTINUE
2711C CALL DECAY(IHAD,2)
2712 GO TO 64
2713C================================================================
2714C
2715C BACKWARD CHAIN OF MESON ANTIBARYON
2716C=================================================================
2717C TO BE CORRECTED
2718C=================================================================
2719 627 CONTINUE
2720 GO TO(6217,6227),ISAM3
27216227 CONTINUE
2722 IF (NNCH2) 62117,62127,62137
272362117 CONTINUE
2724 ICH2 = IBPS
2725 GO TO 62147
272662137 CONTINUE
2727 ICH2 = IBV
2728 GO TO 62147
272962127 CONTINUE
2730 IAIFB = IABS(IFB) + 6
2731*or IF (IPRI.EQ.1) WRITE(LUNOUT,997)IFF,IAIFB
2732*or 997 FORMAT (' BAMJEV 62127',5I5)
2733 CALL BAMJEV(IHAD,IFF,IAIFB,IBB,IBB,AMCH2,3)
2734 GO TO 62157
273562147 CONTINUE
2736*or IF (IPRI.EQ.1) WRITE(LUNOUT,998)ICH2
2737*or 998 FORMAT ('PARJET 62147',5I5)
2738 CALL PARJET(IHAD,ICH2)
273962157 CONTINUE
2740C CALL DECAY(IHAD,2)
2741 GO TO 64
27426217 CONTINUE
2743 IF (NNCH1) 62217,62227,62237
274462217 CONTINUE
2745 ICH2 = IFPS
2746 GO TO 62247
274762237 CONTINUE
2748 ICH2 = IFV
2749 GO TO 62247
275062227 CONTINUE
2751 IAIBB = IABS(IBB) + 6
2752*or IF (IPR1.EQ.1) WRITE(LUNOUT,9911)IBF,IAIBB
2753*or9911 FORMAT (' BAMJEV 62227',5I5)
2754 CALL BAMJEV(IHAD,IBF,IAIBB,IAIFB2,IBF,AMCH1,3)
2755 GO TO 62257
275662247 CONTINUE
2757*or IF (IPRI .EQ. 1) WRITE(LUNOUT,9912)ICH2
2758*or9912 FORMAT ('PARJET 62247',5I5)
2759 CALL PARJET(IHAD,ICH2)
276062257 CONTINUE
2761C CALL DECAY(IHAD,2)
2762 GO TO 64
276363 CONTINUE
2764C==================================================================
2765C*** BACKWARD CHAIN OF BARYON BARYON
2766C==================================================================
2767 IF (NNCH2) 631,632,633
2768631 CONTINUE
2769 ICH2 = IB8
2770 GO TO 634
2771633 CONTINUE
2772 ICH2 = IBIO
2773 GO TO 634
2774632 CONTINUE
2775 CALL BAMJEV(IHAD,IBF,IBB1,IBB2,IBF,AMCH2,4)
2776 GO TO 635
2777 634 CONTINUE
2778 CALL PARJET(IHAD,ICH2)
2779 635 CONTINUE
2780C CALL DECAY(IHAD,2)
2781*
2782* We arrive here after jet creation: created particles are in
2783* /finpar/ common (there are ihad particles)
2784*
2785 64 CONTINUE
2786C*** TURN CHAIN AROUND IF NECESSARY
2787 IF (IBPROJ) 71,72,73
2788 71 CONTINUE
2789 GO TO 75
2790 72 CONTINUE
2791 GO TO (721,722),ISAM3
2792 721 CONTINUE
2793C*** TURN JET
2794 GO TO 75
2795 722 CONTINUE
2796 GO TO 74
2797 73 CONTINUE
2798C*** KEEP JET
2799 GO TO 74
2800 75 CONTINUE
2801C*** TURN JET AROUND
2802 DO 76 I=1,IHAD
2803 PZF(I) = -PZF(I)
2804 76 CONTINUE
2805 74 CONTINUE
2806C================================================================
2807C
2808C*** TRANSFORM BACKWARD JET INTO CMS
2809C
2810C=================================================================
2811 NAUX = NAUX+1
2812
2813
2814 CALL LORTRA(IHAD,NAUX,GAMCH2,BGCH2X,BGCH2Y,BGCH2Z)
2815 NAUX = IHAD + NAUX - 1
2816 DO 181 I=1,NAUX
2817 PXR(I) = PXA(I)
2818 PYR(I) = PYA(I)
2819 PZR(I) = PZA(I)
2820 AMR(I) = AMA(I)
2821 ICHR(I) = ICHA(I)
2822 ANR(I) = ANA(I)
2823 IBARR(I)= IBARA(I)
2824 NRER(I) = NREA(I)
2825 HER(I) = HEPA(I)
2826 181 CONTINUE
2827
2828 NRES=NAUX
2829 CALL DECAUX(NAUX,3)
2830
2831
2832*or IF (IPRI.EQ.1) WRITE(LUNOUT,85)(I,NREA(I),ICHA(I),IBARA(I),
2833*or &ANA(I)PXA(I),PYA(I),PZA(I),HEPA(I),AMA(I),I=1,NAUX)
2834
2835 EVZ = 0.D0
2836 PVX = 0.D0
2837 PVY = 0.D0
2838 PVZ = 0.D0
2839 ICCU = 0
2840 IBBU = 0
2841 ISSU = 0
2842 LISSU = .TRUE.
2843
2844C*** TRANSFORM INTO LABSYSTEM
2845* +-------------------------------------------------------------------*
2846* | particles from /auxpar/ common are transformed back in the lab
2847* | system (which is actually the system of the target nucleon with
2848* | the projectile along the z-axis)
2849* | and put in /hadpar/ common
2850* |
2851* | The transformation is:
2852* | Elab = Ecms * gamma + ETAzlab * Pzcms
2853* | Pzlab = Pzcms * gamma + ETAzlab * Ecms
2854* | note ETAzlab = -ETAzcms!!!!
2855* |
2856 DO 81 I=1,NAUX
2857 HEPH(I) = GAMCM*HEPA(I) + BGCM*PZA(I)
2858 PZH(I) = GAMCM*PZA(I) + BGCM*HEPA(I)
2859 PXH(I) = PXA(I)
2860 PYH(I) = PYA(I)
2861 AMH(I) = AMA(I)
2862 ICHH(I) = ICHA(I)
2863 ANH(I) = ANA(I)
2864 IBARH(I)= IBARA(I)
2865 NREH(I) = NREA(I)
2866 EVZ = EVZ + HEPH(I)
2867 PVX = PVX + PXH(I)
2868 PVY = PVY + PYH(I)
2869 PVZ = PVZ + PZH(I)
2870 ICCU = ICCU + ICHH(I)
2871 IBBU = IBBU + IBARH(I)
2872 IJNREH = KPTOIP ( NREH (I) )
2873 IF (IJNREH .LE. 0 .OR. IJNREH .GT. 39) THEN
2874 WRITE (LUNOUT,*)' Hadevt: Ijnreh = 0, > 39 after decay!!',
2875 & IJNREH,NREH(I),I,HEPH(I)
2876 WRITE (LUNERR,*)' Hadevt: Ijnreh = 0, > 39 after decay!!',
2877 & IJNREH,NREH(I),I,HEPH(I)
2878 LISSU = .FALSE.
2879 ELSE
2880 DO 8011 J=1,3
2881 ISSU = ISSU + IQSCHR (MQUARK(J,IJNREH))
28828011 CONTINUE
2883 END IF
2884 81 CONTINUE
2885* |
2886* +-------------------------------------------------------------------*
2887
2888 NHAD = NAUX
2889 ICHTOT = ICH(KPROJ) + ICH(KTARG)
2890 IBTOT = IBPROJ + IBTARG
2891 ISTOT = 0
2892 DO 8111 J=1,3
2893 ISTOT = ISTOT + IQSCHR(MQUARK(J,IJPROJ))
2894 & + IQSCHR(MQUARK(J,IJTARG))
28958111 CONTINUE
2896* +-------------------------------------------------------------------*
2897* |
2898 IF (ICCU .NE. ICHTOT) THEN
2899* | write an error message and then resample!!!
2900 WRITE(LUNOUT,*)' Hadevt: charge conservation failure: ',
2901 & ' ICCU,ICHTOT,IBBU,IBTOT,ISSU,ISTOT',
2902 & ICCU,ICHTOT,IBBU,IBTOT,ISSU,ISTOT
2903 WRITE(LUNERR,*)' Hadevt: charge conservation failure: ',
2904 & ' ICCU,ICHTOT,IBBU,IBTOT,ISSU,ISTOT',
2905 & ICCU,ICHTOT,IBBU,IBTOT,ISSU,ISTOT
2906 LRESMP = .TRUE.
2907 ELSE IF (IBBU .NE. IBTOT) THEN
2908* | write an error message and then resample!!!
2909 WRITE(LUNOUT,*)' Hadevt: baryon conservation failure: ',
2910 & ' ICCU,ICHTOT,IBBU,IBTOT,ISSU,ISTOT',
2911 & ICCU,ICHTOT,IBBU,IBTOT,ISSU,ISTOT
2912 WRITE(LUNERR,*)' Hadevt: baryon conservation failure: ',
2913 & ' ICCU,ICHTOT,IBBU,IBTOT,ISSU,ISTOT',
2914 & ICCU,ICHTOT,IBBU,IBTOT,ISSU,ISTOT
2915 LRESMP = .TRUE.
2916 ELSE IF (ISSU .NE. ISTOT .AND. LISSU) THEN
2917* | write an error message and then resample!!!
2918 WRITE(LUNOUT,*)' Hadevt: strangeness conservation failure: ',
2919 & ' ICCU,ICHTOT,IBBU,IBTOT,ISSU,ISTOT',
2920 & ICCU,ICHTOT,IBBU,IBTOT,ISSU,ISTOT
2921 WRITE(LUNERR,*)' Hadevt: strangeness conservation failure: ',
2922 & ' ICCU,ICHTOT,IBBU,IBTOT,ISSU,ISTOT',
2923 & ICCU,ICHTOT,IBBU,IBTOT,ISSU,ISTOT
2924 LRESMP = .TRUE.
2925 ELSE
2926 END IF
2927* |
2928* +-------------------------------------------------------------------*
2929 EPSEPS = MAX ( 10.D+00*ANGLGB, 1.D-12 )
2930* +-------------------------------------------------------------------*
2931* |
2932 IF (ABS(EVZ-AMTAR-EPROJ)/(AMTAR+EPROJ) .GT. EPSEPS) THEN
2933 ELSE IF (ABS(PVX)/PPROJ .GT. EPSEPS) THEN
2934 ELSE IF (ABS(PVY)/PPROJ .GT. EPSEPS) THEN
2935 ELSE IF (ABS(PVZ-PPROJ)/PPROJ .GT. EPSEPS) THEN
2936 ELSE
2937 GO TO 90
2938 END IF
2939* |
2940* +-------------------------------------------------------------------*
2941
2942C
2943C********************************************************************
2944C
2945C*** PRINT AND TEST ENERGY CONSERVATION
2946C
2947C********************************************************************
2948C
2949*or PVZ = 0.D0
2950*or EVZ = 0.D0
2951*or PVX = 0.D0
2952*or PVY = 0.D0
2953*or ICCU = 0
2954*or IBBU = 0
2955*or DO 82 I=1,NHAD
2956*or PVX = PVX + PXH(I)
2957*or PVY = PVY + PYH(I)
2958*or PVZ = PVZ + PZH(I)
2959*or EVZ = EVZ + HEPH(I)
2960*or ICCU = ICCU + ICHH(I)
2961*or IBBU = IBBU + IBARH(I)
2962*or 82 CONTINUE
2963*or IF (IBTOT .NE. IBBU) GO TO 9999
2964*or IF (ICHTOT .NE. ICCU) GO TO 9999
2965*or IF (ABS(PVX).GE.0.01D0) GO TO 9999
2966*or IF (ABS(PVY).GE.0.01D0) GO TO 9999
2967*or IF ((PVZ.GT.1.02D0*PPROJ).OR.(PVZ.LT.0.98D0*PPROJ)) GO TO 9999
2968*or IF (IPRI.NE.1) GO TO 90
29699999 CONTINUE
2970*
2971* If a failure occured the event is resampled!!!
2972*
2973 GO TO 8899
2974*or IF (IPRI.EQ.0) GO TO 8899
2975*or WRITE(LUNOUT,83)NHAD,KPROJ,KTARG,PPROJ,EPROJ,PVX,PVY,PVZ,EVZ,
2976*or &ICCU,IBBU,NHAD
2977*or 83 FORMAT (3I5,6F12.6,3I5)
2978*or DO 84 I=1,NHAD
2979*or WRITE(LUNOUT,85)I,NREH(I),ICHH(I),IBARH(I),ANH(I),PXH(I),
2980*or & PYH(I),PZH(I),HEPH(I),AMH(I)
2981*or 85 FORMAT (4I5,A8,5F12.6)
2982*or 84 CONTINUE
2983*
2984* If a failure occured the event is resampled!!!
2985*
2986*or IF (IPRI.EQ.0)GO TO 8899
2987
2988 90 CONTINUE
2989 RETURN
2990 END