Bugfix in AliPoints2Memory
[u/mrichter/AliRoot.git] / GEANT321 / fluka / bamjev.F
CommitLineData
fe4da5cc 1*
2* $Id$
3*
4* $Log$
5* Revision 1.1.1.1 1995/10/24 10:19:53 cernlib
6* Geant
7*
8*
9#include "geant321/pilot.h"
10*CMZ : 3.21/02 29/03/94 15.41.41 by S.Giani
11*-- Author :
12*$ CREATE BAMJEV.FOR
13*COPY BAMJEV
14*
15*=== bamjev ===========================================================*
16*
17 SUBROUTINE BAMJEV ( IHAD, KFA1, KFA2, KFA3, KFA4, AE0, IOPT )
18
19#include "geant321/dblprc.inc"
20#include "geant321/dimpar.inc"
21#include "geant321/iounit.inc"
22*
23*----------------------------------------------------------------------*
24* Bamjet90: slight revision by A. Ferrari *
25*----------------------------------------------------------------------*
26*
27*----------------------------------------------------------------------*
28* Ihad = number of final hadrons and hadron resonances *
29* Ae0 = initial energy in GeV *
30* Kfai = initial quark flavours (u=1,d=2,s=3,c=4,ubar=7,dbar=8, *
31* sbar=9, cbar=10) *
32* Iopt = 1,2,3,4,5 means: *
33* 1: single (anti)quark jet, (kfa1) *
34* 2: single (anti)diquark jet, (kfa1-kfa2) *
35* 3: complete quark antiquark twojet event, (kfa1,kfa2) *
36* 4: complete (anti)quark-(anti)diquark two jet event, *
37* (kfa1,kfa2-kfa3) *
38* 5: complete diquark-(anti)diquark two jet event, *
39* (kfa1-kfa2,kfa3-kfa4) *
40* Common/finpar/ contains the momenta,energies and quantum numbers *
41* of the created hadrons *
42* Iv = actual vertex,iv=1,4,5,6,9,10 are meson verteces *
43* iv=2,3,7,8 are baryon verteces *
44* La = 1 means cut-off *
45* Ll = 0,1 means quark jet, antiquark jet, (diquark jet, anti- *
46* diquark jet) *
47* Common/remain/ contains rest jet energy,momenta and quantumnum- *
48* bers *
49*----------------------------------------------------------------------*
50*
51#include "geant321/bamjcm.inc"
52#include "geant321/finpar2.inc"
53#include "geant321/part.inc"
54#include "geant321/inpdat.inc"
55
56 COMMON/FKREMA/ RPXR,RPYR,RPZR,RER,KR1R,KR2R
57 SAVE NCOU, ITMX
58*
59 DATA NCOU/0/
60 DATA ITMX/0/
61 NCOU=NCOU+1
62 A1SAVE = A1
63 B1SAVE = B1
64 B2SAVE = B2
65 B3SAVE = B3
66 IF ( AE0 .LE. 4.D+00 )THEN
67 A1 = 0.88D+00
68 ELSE IF ( AE0 .LE. 8.0D+00 ) THEN
69 A1 = 0.88D+00
70 ELSE IF ( AE0 .LT. 30.D+00 ) THEN
71 A1 = 0.88D+00
72 ELSE
73 A1 = 0.88D+00
74 END IF
75 FRB12 = 0.5D+00
76 B1 = 4.D+00 + 1.D+00 / ( FRB12 * AE0 )**2
77 B2 = 4.D+00 + 1.D+00 / ( FRB12 * AE0 )**2
78 E00 = 40.D+00
79* The following is consistent with B3=6
80 B3 = B3 * LOG10 ( E00 ) /
81 & ( LOG10 ( 1.D+00 + ( AE0 / E00 )**2 ) + LOG10 ( E00 ) )
82C IF (NCOU.EQ.4701)LT=1
83*or IF (LT.EQ.1)WRITE(LUNOUT,3399)IOPT,NCOU
84 3399 FORMAT(' BAMJET',2I10 )
85*or IF (LT.EQ.1)WRITE(LUNOUT,288)IHAD,KFA1,KFA2,KFA3,KFA4,AE0,IOPT
86 288 FORMAT (5I5,2E12.4,' BAMJET,IHAD,KFA1,KFA2,KFA3,KFA4,AE0,IOPT')
87 63 CONTINUE
88 DO 62 I=1,ITMX
89 KFR1(I) = 0
90 KFR2(I) = 0
91 62 CONTINUE
92 ITMX=0
93 60 CONTINUE
94 IYY=0
95 IHAD=0
96 IT=0
97 E0=AE0*.5D0
98 IF(IOPT.EQ.1.OR.IOPT.EQ.2) E0=AE0
99 LL=0
100 IF(KFA1.GT.6.AND.IOPT.EQ.1) LL=1
101 IF(KFA1.LE.6.AND.IOPT.EQ.2) LL=1
102 IF(KFA1.GT.6.AND.IOPT.EQ.4) LL=1
103 PGX = 0.D0
104 PGY = 0.D0
105 PGZ = 0.D0
106 RPX0 = 0.D0
107 RPY0 = 0.D0
108* The following 6 initializations might be useless, but they make the
109* code much clearer
110 KR1R = 0
111 KR2R = 0
112 KR1L = 0
113 KR2L = 0
114 RER = 0.D+00
115 REL = 0.D+00
116 DO 10 I=1,KMXJCM
117 KFR1(I) = 0
118 KFR2(I) = 0
119 LA = 0
120 IT = IT+1
121 J = IT-1
122* The following line seems useless
123* K = IT+1
124 40 CONTINUE
125C*****CUT OFF TASK
126* | Abbrch is called to cut the chain
127 CALL ABBRCH(IT,LL,LA,LT,E0,PGX,PGY,PGZ,KFR1,KFR2,RE,
128 & KR1R,KR2R,KR1L,KR2L,RPX,RPY,RPZ,RPXR,RPYR,RPZR,RPXL,RPYL,RPZL,
129 & RER,REL,IV,B1,B2,KFA1,KFA2,KFA3,KFA4,IOPT,IYY)
130 ITMX=MAX(ITMX,IT)
131 IF(LA .EQ. 0) GO TO 20
132 IT=IT-1
133 IF(IOPT.EQ.3.AND.LL.EQ.0) GO TO 70
134 IF(IOPT.EQ.4.AND.KFA1.LE.6.AND.LL.EQ.0) GO TO 70
135 IF(IOPT.EQ.4.AND.KFA1.GT.6.AND.LL.EQ.1) GO TO 70
136 IF(IOPT.EQ.5.AND.LL.EQ.0) GO TO 70
137 GO TO 50
138 70 CONTINUE
139 IYY = 1
140 LL = 1
141 IF(IOPT.EQ.4.AND.KFA1.GT.6) LL = 0
142 IAR=IT
143 GO TO 30
144 20 CONTINUE
145C*****CHOICE OF THE VERTEX
146 CALL FKVERT(IT,LT,LL,KFA1,E0,IV,RE,KFR1,KFR2,AME,IOPT)
147C*****CHOICE OF THE FLAVOUR
148 CALL FKFLAV(IT,LT,LL,E0,IV,RE,KFR1,KFR2,ISU,BET,KFA1,KFA2,
149 & KFA3,KFA4,IOPT)
150C*****CLASSIFICATION OF THE PARTICLES
151 CALL HKLASS(IT,LT,LA,LL,KFR1,KFR2,KR1R,KR2R,KR1L,KR2L,IV,IMPS,
152 & IMVE,IB08,IA08,IB10,IA10,AS,B8,KFA1,KFA2,KFA3,KFA4,IOPT)
153 ITMX=MAX(ITMX,IT)
154 IF (IT .EQ. 1) RX = E0
155 IF (IT .GT. 1) RX = RE(J)
156 IF(AMF(IT) .GT. RX) GO TO 63
157 IF(AMF(IT) .LE. RX) GO TO 19
158 LA = 1
159 GO TO 40
160 19 CONTINUE
161 IHAD = IHAD + 1
162*or IF(LT .EQ. 0) GO TO 31
163*or WRITE(LUNOUT,32)IHAD
164*or 31 CONTINUE
165C*****CHOICE OF THE ENERGY
166 CALL ENERGI(IT,LL,LT,IV,RE,HMA,HE,E0,A1)
167C*****CHOICE OF THE MOMENTUM
168* |
169* | He is the total energy, hma the mass one (input) hpx, hpy, hpz
170* | the momentum components (output values), hps the transversal
171* | momentum (output)
172* |
173 CALL FKIMPU(HE,HMA,HPS,HPX,HPY,HPZ,LT,LL,B3)
174 IF (IT .GT. 1) GO TO 13
175 RPX(IT)=RPX0-HPX
176 RPY(IT)=RPY0-HPY
177 GO TO 14
178 13 RPX(IT)=RPX(J)-HPX
179 RPY(IT)=RPY(J)-HPY
180 14 CONTINUE
181 IF (IOPT.EQ.1.AND.LL.EQ.1)HPZ=-HPZ
182 IF(IOPT.EQ.2.AND.LL.EQ.1) HPZ=-HPZ
183 IF(IOPT.EQ.4.AND.KFA1.GT.6) HPZ=-HPZ
184 IF(IOPT.EQ.5) HPZ=-HPZ
185 PGX=PGX+HPX
186 PGY=PGY+HPY
187 PGZ=PGZ+HPZ
188 PXF(IT)=HPX
189 PYF(IT)=HPY
190 PZF(IT)=HPZ
191*or IF (LT .EQ. 0) GO TO 15
192*or WRITE(LUNOUT,16)PGX,PGY,PGZ
193*or 16 FORMAT(1H0,12HPGX,PGY,PGZ=,3F8.4)
194*or 15 CONTINUE
195 30 CONTINUE
196
197 10 CONTINUE
198*
199* we suppose that exiting from loop must be achieved via " go to 50
200*
201 WRITE (LUNERR,*)' BAMJEV: EXITING FROM LOOP ABNORMALLY!!!! '
202 WRITE (LUNOUT,*)' BAMJEV: EXITING FROM LOOP ABNORMALLY!!!! '
203 50 CONTINUE
204 ITMX=MAX(ITMX,IT)
205 IF(IOPT.EQ.1.OR.IOPT.EQ.2) GO TO 51
206C*****PUT THE RIGHT AND LEFT JET TOGETHER
207 CALL VEREIN(IT,LA,LT,RER,REL,RPXR,RPYR,RPZR,RPXL,RPYL,RPZL,
208 &KR1R,KR2R,KR1L,KR2L,IHAD,LL,KFR1,KFR2,IMPS,IMVE,IB08,IA08,
209 &IB10,IA10,B3,AS,B8,IAR,KFA1,KFA2,KFA3,KFA4,IOPT)
210 IF(LA.EQ.3) GO TO 63
211 IF(LA.EQ.2) GO TO 63
212 51 CONTINUE
213 IF(IOPT.EQ.3.OR.IOPT.EQ.4.OR.IOPT.EQ.5) GO TO 52
214 IF(LL.EQ.0) GO TO 52
215 RPXR=RPXL
216 RPYR=RPYL
217 RPZR=RPZL
218 RER=REL
219 KR1R=KR1L
220 KR2R=KR2L
221 52 CONTINUE
222 IF(LE.EQ.0) GO TO 1000
223 WRITE(LUNOUT,92)
224 92 FORMAT(2X,'NF,NAME,MASS,IQ,IB,PX,PY,PZ,E')
225 DO 91 J=1,IT
226 WRITE(LUNOUT,90)NREF(J),ANF(J),AMF(J),ICHF(J),IBARF(J),PXF(J),
227 & PYF(J),PZF(J),HEF(J)
228 90 FORMAT(2X,I3,A6,F6.3,2I4,4F8.4)
229 91 CONTINUE
230 1000 CONTINUE
231 64 FORMAT(1H0,38HNUMBER OF EVENTS WITH PREST GT. EREST=,I4,
232 */,21HNUMBER OF ALL EVENTS=,I4)
233 2000 FORMAT(1H0,'NUMBER OF EVENTS WITH ONLY ONE PARTICLE=',I4)
234*or IF(LT.EQ.0) GO TO 17
235*or WRITE(LUNOUT,18)IHAD
236*or 18 FORMAT(1H0,15HMULTIPLIZITAET=,I3)
237*or 32 FORMAT(1H0,13HHADRONANZAHL=,I3)
238*or 17 CONTINUE
239 A1 = A1SAVE
240 B1 = B1SAVE
241 B2 = B2SAVE
242 B3 = B3SAVE
243 RETURN
244 END