1 | SUBROUTINE PPARAM
|
---|
2 |
|
---|
3 | C-----------------------------------------------------------------------
|
---|
4 | C P(ARTICLE) PARAM(ETERS)
|
---|
5 | C
|
---|
6 | C SETS PARAMETERS (PARTICLE TYP, TRANSVERSE MOMENTUM)
|
---|
7 | C OF SECONDARY PARTICLES IN HDPM
|
---|
8 | C THIS SUBROUTINE IS CALLED FROM HDPM
|
---|
9 | C
|
---|
10 | C DESIGN : D. HECK IK3 FZK KARLSRUHE
|
---|
11 | C CHANGES : J.N. CAPDEVIELLE CDF PARIS
|
---|
12 | C-----------------------------------------------------------------------
|
---|
13 |
|
---|
14 | IMPLICIT DOUBLE PRECISION (A-H,O-Z)
|
---|
15 | *KEEP,AVPT.
|
---|
16 | COMMON /AVPT/ AVPT,AVPK,AVPN,AVPH,AVPE
|
---|
17 | DOUBLE PRECISION AVPT,AVPK,AVPN,AVPH,AVPE
|
---|
18 | *KEEP,DPMFLG.
|
---|
19 | COMMON /DPMFLG/ NFLAIN,NFLDIF,NFLPI0,NFLCHE,NFLPIF,NFRAGM
|
---|
20 | INTEGER NFLAIN,NFLDIF,NFLPI0,NFLCHE,NFLPIF,NFRAGM
|
---|
21 | *KEEP,INDICE.
|
---|
22 | COMMON /INDICE/ NNUCN,NKA0,NHYPN,NETA,NETAS,NPIZER,
|
---|
23 | * NNC,NKC,NHC,NPC,NCH,NNN,NKN,NHN,NET,NPN
|
---|
24 | INTEGER NNUCN(2:3),NKA0(2:3),NHYPN(2:3),NETA(2:3,1:4),
|
---|
25 | * NETAS(2:3),NPIZER(2:3),
|
---|
26 | * NNC,NKC,NHC,NPC,NCH,NNN,NKN,NHN,NET,NPN
|
---|
27 | *KEEP,INTER.
|
---|
28 | COMMON /INTER/ AVCH,AVCH3,DC0,DLOG,DMLOG,ECMDIF,ECMDPM,ELAB,
|
---|
29 | * FNEUT,FNEUT2,GNU,PLAB,POSC2,POSC3,POSN2,POSN3,
|
---|
30 | * RC3TO2,S,SEUGF,SEUGP,SLOG,SLOGSQ,SMLOG,
|
---|
31 | * WIDC2,WIDC3,WIDN2,WIDN3,YCM,YY0,ZN,
|
---|
32 | * IDIF,ITAR
|
---|
33 | DOUBLE PRECISION AVCH,AVCH3,DC0,DLOG,DMLOG,ECMDIF,ECMDPM,ELAB,
|
---|
34 | * FNEUT,FNEUT2,GNU,PLAB,POSC2,POSC3,POSN2,POSN3,
|
---|
35 | * RC3TO2,S,SEUGF,SEUGP,SLOG,SLOGSQ,SMLOG,
|
---|
36 | * WIDC2,WIDC3,WIDN2,WIDN3,YCM,YY0,ZN
|
---|
37 | INTEGER IDIF,ITAR
|
---|
38 | *KEEP,LEPAR.
|
---|
39 | COMMON /LEPAR/ LEPAR1,LEPAR2,LASTPI,NRESPC,NRESPN,NCPLUS
|
---|
40 | INTEGER LEPAR1,LEPAR2,LASTPI,NRESPC,NRESPN,NCPLUS
|
---|
41 | *KEEP,NEWPAR.
|
---|
42 | COMMON /NEWPAR/ EA,PT2,PX,PY,TMAS,YR,ITYP,
|
---|
43 | * IA1,IA2,IB1,IB2,IC1,IC2,ID1,ID2,IE1,IE2,IF1,IF2,
|
---|
44 | * IG1,IG2,IH1,IH2,II1,II2,IJ1,NTOT
|
---|
45 | DOUBLE PRECISION EA(3000),PT2(3000),PX(3000),PY(3000),TMAS(3000),
|
---|
46 | * YR(3000)
|
---|
47 | INTEGER ITYP(3000),
|
---|
48 | * IA1,IA2,IB1,IB2,IC1,IC2,ID1,ID2,IE1,IE2,IF1,IF2,
|
---|
49 | * IG1,IG2,IH1,IH2,II1,II2,IJ1,NTOT
|
---|
50 | *KEEP,PAM.
|
---|
51 | COMMON /PAM/ PAMA,SIGNUM
|
---|
52 | DOUBLE PRECISION PAMA(6000),SIGNUM(6000)
|
---|
53 | *KEEP,RANDPA.
|
---|
54 | COMMON /RANDPA/ FAC,U1,U2,RD,NSEQ,ISEED,KNOR
|
---|
55 | DOUBLE PRECISION FAC,U1,U2
|
---|
56 | REAL RD(3000)
|
---|
57 | INTEGER ISEED(103,10),NSEQ
|
---|
58 | LOGICAL KNOR
|
---|
59 | *KEEP,RUNPAR.
|
---|
60 | COMMON /RUNPAR/ FIXHEI,THICK0,HILOECM,HILOELB,
|
---|
61 | * STEPFC,NRRUN,NSHOW,PATAPE,MONIIN,
|
---|
62 | * MONIOU,MDEBUG,NUCNUC,
|
---|
63 | * CETAPE,
|
---|
64 | * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
|
---|
65 | * N1STTR,MDBASE,
|
---|
66 | * DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
|
---|
67 | * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
|
---|
68 | * ,GHEISH,GHESIG
|
---|
69 | COMMON /RUNPAC/ DSN,HOST,USER
|
---|
70 | DOUBLE PRECISION FIXHEI,THICK0,HILOECM,HILOELB
|
---|
71 | REAL STEPFC
|
---|
72 | INTEGER NRRUN,NSHOW,PATAPE,MONIIN,MONIOU,MDEBUG,NUCNUC,
|
---|
73 | * SHOWNO,ISHW,NOPART,NRECS,NBLKS,MAXPRT,NDEBDL,
|
---|
74 | * N1STTR,MDBASE
|
---|
75 | INTEGER CETAPE
|
---|
76 | CHARACTER*79 DSN
|
---|
77 | CHARACTER*20 HOST,USER
|
---|
78 |
|
---|
79 | LOGICAL DEBDEL,DEBUG,FDECAY,FEGS,FIRSTI,FIXINC,FIXTAR,
|
---|
80 | * FIX1I,FMUADD,FNKG,FPRINT,FDBASE
|
---|
81 | * ,GHEISH,GHESIG
|
---|
82 | *KEND.
|
---|
83 |
|
---|
84 | C-----------------------------------------------------------------------
|
---|
85 |
|
---|
86 | IF ( DEBUG ) WRITE(MDEBUG,*) 'PPARAM: NTOT,NPC,NCPLUS=',
|
---|
87 | * NTOT,NPC,NCPLUS
|
---|
88 |
|
---|
89 | C FILL PARTICLES INTO ARRAYS, CALCULATE PT AND SUM UP
|
---|
90 | SPX = 0.D0
|
---|
91 | SPY = 0.D0
|
---|
92 | NPART = 3
|
---|
93 | C PROTON ANTIPROTON PAIRS
|
---|
94 | DO 1003 K = 1,NNC
|
---|
95 | CALL RMMAR( RD,1,1 )
|
---|
96 | IF ( RD(1) .LT. 0.5 ) THEN
|
---|
97 | ITYP(NPART) = 14
|
---|
98 | ITYP(NPART+1) = 15
|
---|
99 | ELSE
|
---|
100 | ITYP(NPART) = 15
|
---|
101 | ITYP(NPART+1) = 14
|
---|
102 | ENDIF
|
---|
103 | CALL PTRAM( ZN,AVPN,PX(NPART),PY(NPART) )
|
---|
104 | CALL PTRAM( ZN,AVPN,PX(NPART+1),PY(NPART+1) )
|
---|
105 | SPX = SPX + PX(NPART) + PX(NPART+1)
|
---|
106 | SPY = SPY + PY(NPART) + PY(NPART+1)
|
---|
107 | NPART = NPART + 2
|
---|
108 | 1003 CONTINUE
|
---|
109 | C K+ K- PAIRS
|
---|
110 | DO 1004 K = 1,NKC
|
---|
111 | CALL RMMAR( RD,1,1 )
|
---|
112 | IF ( RD(1) .LT. 0.5 ) THEN
|
---|
113 | ITYP(NPART) = 11
|
---|
114 | ITYP(NPART+1) = 12
|
---|
115 | ELSE
|
---|
116 | ITYP(NPART) = 12
|
---|
117 | ITYP(NPART+1) = 11
|
---|
118 | ENDIF
|
---|
119 | CALL PTRAM( ZN,AVPK,PX(NPART),PY(NPART) )
|
---|
120 | CALL PTRAM( ZN,AVPK,PX(NPART+1),PY(NPART+1) )
|
---|
121 | SPX = SPX + PX(NPART) + PX(NPART+1)
|
---|
122 | SPY = SPY + PY(NPART) + PY(NPART+1)
|
---|
123 | NPART = NPART + 2
|
---|
124 | 1004 CONTINUE
|
---|
125 | C SIGMA PAIRS
|
---|
126 | DO 1005 K = 1,NHC
|
---|
127 | CALL RMMAR( RD,2,1 )
|
---|
128 | IF ( RD(1) .LT. 0.5 ) THEN
|
---|
129 | IF ( RD(2) .LT. 0.5 ) THEN
|
---|
130 | ITYP(NPART) = 19
|
---|
131 | ITYP(NPART+1) = 27
|
---|
132 | ELSE
|
---|
133 | ITYP(NPART) = 27
|
---|
134 | ITYP(NPART+1) = 19
|
---|
135 | ENDIF
|
---|
136 | ELSE
|
---|
137 | IF ( RD(2) .LT. 0.5 ) THEN
|
---|
138 | ITYP(NPART) = 21
|
---|
139 | ITYP(NPART+1) = 29
|
---|
140 | ELSE
|
---|
141 | ITYP(NPART) = 29
|
---|
142 | ITYP(NPART+1) = 21
|
---|
143 | ENDIF
|
---|
144 | ENDIF
|
---|
145 | CALL PTRAM( ZN,AVPH,PX(NPART),PY(NPART) )
|
---|
146 | CALL PTRAM( ZN,AVPH,PX(NPART+1),PY(NPART+1) )
|
---|
147 | SPX = SPX + PX(NPART) + PX(NPART+1)
|
---|
148 | SPY = SPY + PY(NPART) + PY(NPART+1)
|
---|
149 | NPART = NPART + 2
|
---|
150 | 1005 CONTINUE
|
---|
151 |
|
---|
152 | C DECIDE WITH WHICH CHARGED PION TO START WITH
|
---|
153 | C NUMBER OF PIONS MAY BE ODD IN THE CASE IF ISEL IS 1
|
---|
154 | CALL RMMAR( RD,1,1 )
|
---|
155 | IF ( RD(1) .GT. 0.5 ) THEN
|
---|
156 | NPIOCH = 0
|
---|
157 | ELSE
|
---|
158 | NPIOCH = 1
|
---|
159 | ENDIF
|
---|
160 | NPOS = NCPLUS
|
---|
161 | C PI +-
|
---|
162 | DO 1007 K = 1,NPC
|
---|
163 | IF ( NPC-K+1 .LE. NPOS ) THEN
|
---|
164 | NPIOCH = 1
|
---|
165 | IF ( DEBUG ) WRITE(MDEBUG,*) ' NPC,K,NPOS,NPIOCH=',
|
---|
166 | * NPC,K,NPOS,NPIOCH
|
---|
167 | ELSEIF ( NPC-K+1 .LE. -NPOS ) THEN
|
---|
168 | NPIOCH = 0
|
---|
169 | IF ( DEBUG ) WRITE(MDEBUG,*) ' NPC,K,-NPOS,NPIOCH=',
|
---|
170 | * NPC,K,-NPOS,NPIOCH
|
---|
171 | ENDIF
|
---|
172 | IF ( NPIOCH .EQ. 0 ) THEN
|
---|
173 | ITYP(NPART) = 8
|
---|
174 | NPIOCH = 1
|
---|
175 | NPOS = NPOS + 1
|
---|
176 | ELSE
|
---|
177 | ITYP(NPART) = 9
|
---|
178 | NPIOCH = 0
|
---|
179 | NPOS = NPOS - 1
|
---|
180 | ENDIF
|
---|
181 | CALL PTRAM( ZN,AVPT,PX(NPART),PY(NPART) )
|
---|
182 | SPX = SPX + PX(NPART)
|
---|
183 | SPY = SPY + PY(NPART)
|
---|
184 | NPART = NPART + 1
|
---|
185 | 1007 CONTINUE
|
---|
186 | C NEUTRON ANTINEUTRON PAIRS
|
---|
187 | DO 1008 K = 1,NNN
|
---|
188 | CALL RMMAR( RD,1,1 )
|
---|
189 | IF ( RD(1) .LT. 0.5 ) THEN
|
---|
190 | ITYP(NPART) = 13
|
---|
191 | ITYP(NPART+1) = 25
|
---|
192 | ELSE
|
---|
193 | ITYP(NPART) = 25
|
---|
194 | ITYP(NPART+1) = 13
|
---|
195 | ENDIF
|
---|
196 | CALL PTRAM( ZN,AVPN,PX(NPART),PY(NPART) )
|
---|
197 | CALL PTRAM( ZN,AVPN,PX(NPART+1),PY(NPART+1) )
|
---|
198 | SPX = SPX + PX(NPART) + PX(NPART+1)
|
---|
199 | SPY = SPY + PY(NPART) + PY(NPART+1)
|
---|
200 | NPART = NPART + 2
|
---|
201 | 1008 CONTINUE
|
---|
202 | C K0L K0S PAIRS
|
---|
203 | DO 1009 K = 1,NKN
|
---|
204 | CALL RMMAR( RD,1,1 )
|
---|
205 | IF ( RD(1) .LT. 0.5 ) THEN
|
---|
206 | ITYP(NPART) = 10
|
---|
207 | ITYP(NPART+1) = 16
|
---|
208 | ELSE
|
---|
209 | ITYP(NPART) = 16
|
---|
210 | ITYP(NPART+1) = 10
|
---|
211 | ENDIF
|
---|
212 | CALL PTRAM( ZN,AVPK,PX(NPART),PY(NPART) )
|
---|
213 | CALL PTRAM( ZN,AVPK,PX(NPART+1),PY(NPART+1) )
|
---|
214 | SPX = SPX + PX(NPART) + PX(NPART+1)
|
---|
215 | SPY = SPY + PY(NPART) + PY(NPART+1)
|
---|
216 | NPART = NPART + 2
|
---|
217 | 1009 CONTINUE
|
---|
218 | C LAMDA/SIGMA0 PAIRS
|
---|
219 | DO 1010 K = 1,NHN
|
---|
220 | CALL RMMAR( RD,2,1 )
|
---|
221 | IF ( RD(1) .LT. 0.5 ) THEN
|
---|
222 | IF ( RD(2) .LT. 0.5 ) THEN
|
---|
223 | ITYP(NPART) = 18
|
---|
224 | ITYP(NPART+1) = 28
|
---|
225 | ELSE
|
---|
226 | ITYP(NPART) = 28
|
---|
227 | ITYP(NPART+1) = 18
|
---|
228 | ENDIF
|
---|
229 | ELSE
|
---|
230 | IF ( RD(2) .LT. 0.5 ) THEN
|
---|
231 | ITYP(NPART) = 26
|
---|
232 | ITYP(NPART+1) = 20
|
---|
233 | ELSE
|
---|
234 | ITYP(NPART) = 20
|
---|
235 | ITYP(NPART+1) = 26
|
---|
236 | ENDIF
|
---|
237 | ENDIF
|
---|
238 | C ----- CHANGE BY JNC DEC.96)
|
---|
239 | IF ( ECMDPM .LE. 500.D0 ) THEN
|
---|
240 | CALL PTRAN( ZN,AVPH,PX(NPART),PY(NPART) )
|
---|
241 | CALL PTRAN( ZN,AVPH,PX(NPART+1),PY(NPART+1) )
|
---|
242 | ELSE
|
---|
243 | CALL PTRAM( ZN,AVPH,PX(NPART),PY(NPART) )
|
---|
244 | CALL PTRAM( ZN,AVPH,PX(NPART+1),PY(NPART+1) )
|
---|
245 | ENDIF
|
---|
246 | SPX = SPX + PX(NPART) + PX(NPART+1)
|
---|
247 | SPY = SPY + PY(NPART) + PY(NPART+1)
|
---|
248 | NPART = NPART + 2
|
---|
249 | 1010 CONTINUE
|
---|
250 | C ETA
|
---|
251 | DO 1013 K = 1,NET
|
---|
252 | C FIRST FOR ETAS FROM THIRD STRING
|
---|
253 | IF ( K .LE. NETA(3,1) ) THEN
|
---|
254 | ITYP(NPART) = 71
|
---|
255 | ELSEIF ( K .LE. NETA(3,1)+NETA(3,2) ) THEN
|
---|
256 | ITYP(NPART) = 72
|
---|
257 | ELSEIF ( K .LE. NETA(3,1)+NETA(3,2)+NETA(3,3) ) THEN
|
---|
258 | ITYP(NPART) = 73
|
---|
259 | ELSEIF ( K .LE. NETA(3,1)+NETA(3,2)+NETA(3,3)+NETA(3,4)) THEN
|
---|
260 | ITYP(NPART) = 74
|
---|
261 | C NOW FOR ETAS FROM FIRST AND SECOND STRING
|
---|
262 | ELSEIF ( K .LE. NETAS(3)+NETA(2,1) ) THEN
|
---|
263 | ITYP(NPART) = 71
|
---|
264 | ELSEIF ( K .LE. NETAS(3)+NETA(2,1)+NETA(2,2) ) THEN
|
---|
265 | ITYP(NPART) = 72
|
---|
266 | ELSEIF ( K .LE. NETAS(3)+NETA(2,1)+NETA(2,2)+NETA(2,3) ) THEN
|
---|
267 | ITYP(NPART) = 73
|
---|
268 | ELSE
|
---|
269 | ITYP(NPART) = 74
|
---|
270 | ENDIF
|
---|
271 | C ----- CHANGE BY JNC DEC.96)
|
---|
272 | IF ( ECMDPM .LE. 500.D0 ) THEN
|
---|
273 | CALL PTRAN( ZN,AVPE,PX(NPART),PY(NPART) )
|
---|
274 | ELSE
|
---|
275 | CALL PTRAM( ZN,AVPE,PX(NPART),PY(NPART) )
|
---|
276 | ENDIF
|
---|
277 | SPX = SPX + PX(NPART)
|
---|
278 | SPY = SPY + PY(NPART)
|
---|
279 | NPART = NPART + 1
|
---|
280 | 1013 CONTINUE
|
---|
281 | C PI(0)
|
---|
282 | DO 1014 K = 1,NPN
|
---|
283 | ITYP(NPART) = 7
|
---|
284 | C ----- CHANGE BY JNC DEC.96)
|
---|
285 | IF ( ECMDPM .LE. 500.D0 ) THEN
|
---|
286 | CALL PTRAN( ZN,AVPT,PX(NPART),PY(NPART) )
|
---|
287 | ELSE
|
---|
288 | CALL PTRAM( ZN,AVPT,PX(NPART),PY(NPART) )
|
---|
289 | ENDIF
|
---|
290 | SPX = SPX + PX(NPART)
|
---|
291 | SPY = SPY + PY(NPART)
|
---|
292 | NPART = NPART + 1
|
---|
293 | 1014 CONTINUE
|
---|
294 |
|
---|
295 | C ANTILEADER (FROM TARGET, THEREFORE ALWAYS NUCLEON OR DELTA RESONANCE)
|
---|
296 | ITYP(2) = LEPAR2
|
---|
297 | C ----- CHANGE BY JNC DEC.96)
|
---|
298 | IF ( ECMDPM .LE. 500.D0 ) THEN
|
---|
299 | CALL PTRAN( ZN,AVPN,PX(2),PY(2) )
|
---|
300 | ELSE
|
---|
301 | CALL PTRAM( ZN,AVPN,PX(2),PY(2) )
|
---|
302 | ENDIF
|
---|
303 |
|
---|
304 | C FIRST PARTICLE IS LEADING PARTICLE
|
---|
305 | ITYP(1) = LEPAR1
|
---|
306 | IF ( (LEPAR1 .GE. 7 .AND. LEPAR1 .LE. 9) .OR.
|
---|
307 | * (LEPAR1 .GE. 51 .AND. LEPAR1 .LE. 53) ) THEN
|
---|
308 | C LEADING PARTICLE IS PION OR RHO RESONANCE
|
---|
309 | AVERPT = AVPT
|
---|
310 | C LEADING PARTICLE IS KAON OR KAON RESONANCE
|
---|
311 | ELSEIF ( LEPAR1 .EQ. 10 .OR. LEPAR1 .EQ. 11 .OR.
|
---|
312 | * LEPAR1 .EQ. 12 .OR. LEPAR1 .EQ. 16 .OR.
|
---|
313 | * (LEPAR1 .GE. 62 .AND. LEPAR1 .LE. 68) ) THEN
|
---|
314 | AVERPT = AVPK
|
---|
315 | ELSE
|
---|
316 | C LEADING PARTICLE IS NUCLEON OR ANTINUCLEON OR DELTA RESONANCE
|
---|
317 | C OR STRANGE BARYON
|
---|
318 | AVERPT = AVPN
|
---|
319 | ENDIF
|
---|
320 | C ----- CHANGE BY JNC DEC.96)
|
---|
321 | IF ( ECMDPM .LE. 500.D0 ) THEN
|
---|
322 | CALL PTRAN( ZN,AVERPT,PX(1),PY(1) )
|
---|
323 | ELSE
|
---|
324 | CALL PTRAM( ZN,AVERPT,PX(1),PY(1) )
|
---|
325 | ENDIF
|
---|
326 | SPX = SPX + PX(1) + PX(2)
|
---|
327 | SPY = SPY + PY(1) + PY(2)
|
---|
328 |
|
---|
329 | C AVERAGE EXCESS PT PER PARTICLE
|
---|
330 | SPX = SPX / NTOT
|
---|
331 | SPY = SPY / NTOT
|
---|
332 |
|
---|
333 | C RENORMALIZATION OF PT AND CALCULATION OF TRANSVERSE MASSES
|
---|
334 | DO 130 I = 1,NTOT
|
---|
335 | PX(I) = PX(I) - SPX
|
---|
336 | PY(I) = PY(I) - SPY
|
---|
337 | PT2(I) = PX(I)**2 + PY(I)**2
|
---|
338 | TMAS(I) = SQRT( PAMA(ITYP(I))**2 + PT2(I) )
|
---|
339 | 130 CONTINUE
|
---|
340 |
|
---|
341 | RETURN
|
---|
342 | END
|
---|