source: trunk/MagicSoft/Simulation/Corsika/Mmcs/SIBYLL.f@ 1118

Last change on this file since 1118 was 286, checked in by harald, 26 years ago
This is the start point for further developments of the Magic Monte Carlo Simulation written by Jose Carlos Gonzales. Now it is under control of one CVS repository for the whole collaboration. Everyone should use this CVS repository for further developments.
File size: 206.5 KB
Line 
1C============================================================
2C SSSSSS IIIIIII BBBBB YY YY L L
3C S I B B YY YY L L
4C SSSSS I BBBBB YY L L
5C S I B B YY L L
6C SSSSSS IIIIIII BBBBB YY LLLLLLL LLLLLLL
7C=============================================================
8C Code for SIBYLL: hadronic interaction Montecarlo
9C=============================================================
10C
11C Version 1.6
12C
13C By R.S. Fletcher
14C T.K. Gaisser
15C Paolo Lipari
16C Todor Stanev
17C
18C~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
19C***** Please have people who want this code contact one of the authors.
20C***** Please report any problems. *******
21C
22C For a correct copy contact:
23C Decnet 6360::Gaisser
24C 6360::Stanev
25C JHUP::Fletcher
26C 40808::Lipari
27C
28C Internet Gaisser@brivs2.bartol.udel.edu
29C Stanev@udbri.bartol.udel.edu
30C Fletcher@JHUP.pha.jhu.edu
31C Lipari@roma1.infn.it
32C
33C 16-4-97 Bug in IFLAV eliminated by D.H.
34C
35C 15-4-97 Bugs in PART_INT eliminated by D.H.
36C
37C 17-3-97 Bounds_check fixed in FPNI, NJETR, SIB_SIGMA_HAIR,
38C SIB_SIGMA_PIP, SIB_SIGMA_PP, SIGMA_PIP,SIGMA_PP by D.H.
39C
40C 18-6-96 Bugs in ZSAMPLE and NUC_CONF eliminated by D.H.
41C
42C 10-5-96 Bug in treatment of antinucleons eliminated
43C
44C 15-9-95 random number generator as RNDM(0)
45C minor corrections
46C
47C 6-15-94: minor changes suggested by O. Palamara
48C for compatiblility with
49C MACRO codes. Parameter statements made standard.
50C Bug in Parton found by S. Kashahara fixed.
51C NUCLIB code moved to the end of the file for
52C easy removal.
53C
54C 2-4-94: Bug fix to avoid infinite loop at low energies. BEAM_SPLIT
55C
56C 4-93 This version is the first to include the NUCLIB like
57C treatment of the wounded nucleon distributions.
58C
59C=============================================================
60C==========SIBYLL=============================================
61C=============================================================
62C+++++ Code for SIBYLL: hadronic interaction Montecarlo
63C=============================================================
64C
65C SIBYLL is an hadronic interaction Monte Carlo simulation
66C based on the dual parton Model, String Fragmentation
67c and the minijet model. It reproduces data
68C resonably well from around 200. GeV up.
69C The program runs from Sqrt(s)=Sqrt(2.*Mp*E_beam)= 10 GeV
70C up to sqrt(s)=10**6 GeV (around 10**21 eV in the laboratory system).
71C
72C The program gets inefficient at low energies
73C (below sqrt[s] = 20 GeV or so)
74C Results at very high energy are subject to all the usual
75C problems associated with extrapolating over several
76C orders of magnitude in energy.
77C===========================================================================
78 function A_pip (b)
79C...Convolution of parton distribution for pip interaction
80 IMPLICIT REAL*4 (A-Z)
81 COMMON /S_CH0CNV/ NU2, MU2, NUPI2, NU, MU, NUPI
82 data pi / 3.1415926/
83
84 eta = nu2/nupi2
85 c = nu2/(2.*pi) * 1./(1.-eta)
86
87 if (b .gt. 0.) then
88 b1 = b*nu
89 b2 = b*nupi
90 f1 = 0.5*b1 * bessk1(b1)
91 f2 = eta/(1.-eta)*(bessk0(b2)- bessk0(b1))
92 A_pip = c*(f1+f2)
93 else
94 A_pip = c*(0.5 + eta/(1.-eta)*log(nu/nupi))
95 endif
96 return
97 end
98 function A_pp (b)
99C...Convolution of parton distribution for pp interaction
100 IMPLICIT REAL*4 (A-Z)
101 COMMON /S_CH0CNV/ NU2, MU2, NUPI2, NU, MU, NUPI
102 data pi / 3.1415926/
103 c = nu**5/(96.*pi)
104 if (b .gt. 0.) then
105 A_pp = c*b**3 * bessk (3, b*nu)
106 else
107 A_pp = nu**2/(12.*pi)
108 endif
109 return
110 end
111 REAL FUNCTION BDIFFRACT(SQS,ipart)
112C
113C INPUT SQS (GeV)
114C ipart is the code for the scattering particle(p,pi)
115C OUTPUT: DIFFRACT is the single diffractive cross
116C section parameterized with a log.
117c in mB
118C RSF
119C......................................................
120 real a(2),b(2)
121 data a/0.0,1.2/
122 data b/1.56,0.66/
123 BDIFFRACT = (a(ipart)+b(ipart)*log(sqs))/2.0
124 RETURN
125 END
126 SUBROUTINE BEAM_SPLIT (L, NW, XX, IFL, XJET, LXBAD,stringmas0)
127C...This subroutine split a hadron of code L
128C. into 2*NW partons, each of energy XX(j) and
129C. flavor IFL. The minimum fractional energy of
130C. each parton is X_min = 2*stringmas0/sqrt(s)
131c.
132c. Variable qmas changed to stringmas0 to agree with name in SIBYLL
133c. and added to calling sequenceto insure symetry.
134c Also a factor of (1-xjet) is added to the def. of xmin for nw=1
135c. RSF Apr-2-92
136C---------------------------------------------------------------------
137 COMMON /S_RUN/ SQS, S, Q2MIN, XMIN, ZMIN , kb ,kt
138 DIMENSION XX(30), IFL(30)
139 DATA AC /-0.2761856692/ ! log(2) - gamma(Eulero)
140 DATA GAMMA /2./
141 DATA NBAD / 0 /
142c-------
143c New code to handle low energy p nuc problem.
144c------
145 LXBAD = 0
146 XMIN = 2.*stringmas0/SQS
147 IF (1.-XJET .LT. FLOAT(2*NW)*XMIN) THEN
148 NBAD = NBAD + 1
149 LXBAD = 1
150 IF (NBAD .LE. 100) THEN
151 WRITE (6, *) 'BEAM_SPLIT: kinematically forbidden situation'
152 WRITE (6, 5) NBAD, SQS, XJET, NW
153 ENDIF
154 5 FORMAT(1X,'NBAD = ',I3,3X,'sqs = ',E10.3,
155 & 3X, 'x_jet = ', F9.3, 3X, ' NW = ',I2)
156 IF (NBAD .eq. 100) THEN
157 WRITE (6, *)
158 & ' BEAM_SPLIT : Last warning about bad splittings '
159 WRITE (6, *) ' The energy threshold is probably too low.'
160 ENDIF
161 RETURN
162 ENDIF
163
164 IF (NW .EQ. 1) THEN
165 XVAL = 1.-XJET
166 GOTO 200
167 ENDIF
168
169C...Choose total energy of sea partons
170 N = 2*(NW-1)
171 Z1 = LOG(FLOAT(N))
172 Z2 = LOG(0.5*SQS*(1.-XJET)/stringmas0-2.)
173100 R=RNDM(0)
174 Z=(Z1+AC)*(1.+R*(((Z2+AC)/(Z1+AC))**N-1.))**(1./FLOAT(N))-AC
175 XSEA = XMIN*EXP(Z)
176 IF ( (1.-XSEA)**GAMMA .LT. RNDM(0)) GOTO 100
177C...Split the energy of sea partons among the different partons
178 XREM = XSEA - FLOAT(N)*XMIN
179 DO J=3,N+1
180 XA = XREM*RNDM(0)
181 XREM = XREM - XA
182 XX(J) = XMIN + XA
183 ENDDO
184 XX(N+2) = XMIN + XREM
185 XVAL = 1.-XSEA-XJET
186C...Flavor of sea partons
187 DO J=1,N/2
188 J1 = 3 + (J-1)*2
189 IFL(J1) = INT(1.+1.99*RNDM(0))
190 IFL(J1+1) = -IFL(J1)
191 ENDDO
192C...Prepare the valence partons
193200 CALL HSPLI (L,IFL(1),IFL(2))
194 CHI = CHIDIS(L,IFL(1),IFL(2))
195 XX(1) = MAX(CHI*XVAL,XMIN)
196 XX(1) = MIN(XX(1),XVAL-XMIN)
197C FOR MESONS, SPLIT ENERGY SYMETRICALLY.
198C????? SPLIT K'S WITH ENERGY TO S QUARK?
199C
200 if (abs(l).le.12.and.RNDM(0).le.0.5) xx(1)=XVAL-XX(1)
201 XX(2) = XVAL-XX(1)
202 RETURN
203 END
204
205 FUNCTION BESSI0(X)
206C----------------------------------------------------------------------------
207C Bessel functions
208C----------------------------------------------------------------------------
209 REAL*8 Y,P1,P2,P3,P4,P5,P6,P7,
210 * Q1,Q2,Q3,Q4,Q5,Q6,Q7,Q8,Q9
211 DATA P1,P2,P3,P4,P5,P6,P7/1.0D0,3.5156229D0,3.0899424D0,
212 * 1.2067492D0,
213 * 0.2659732D0,0.360768D-1,0.45813D-2/
214 DATA Q1,Q2,Q3,Q4,Q5,Q6,Q7,Q8,Q9/0.39894228D0,0.1328592D-1,
215 * 0.225319D-2,-0.157565D-2,0.916281D-2,-0.2057706D-1,
216 * 0.2635537D-1,-0.1647633D-1,0.392377D-2/
217 IF (ABS(X).LT.3.75) THEN
218 Y=(X/3.75)**2
219 BESSI0=P1+Y*(P2+Y*(P3+Y*(P4+Y*(P5+Y*(P6+Y*P7)))))
220 ELSE
221 AX=ABS(X)
222 Y=3.75/AX
223 BESSI0=(EXP(AX)/SQRT(AX))*(Q1+Y*(Q2+Y*(Q3+Y*(Q4
224 * +Y*(Q5+Y*(Q6+Y*(Q7+Y*(Q8+Y*Q9))))))))
225 ENDIF
226 RETURN
227 END
228 FUNCTION BESSI1(X)
229C----------------------------------------------------------------------------
230C Bessel functions
231C----------------------------------------------------------------------------
232 REAL*8 Y,P1,P2,P3,P4,P5,P6,P7,
233 * Q1,Q2,Q3,Q4,Q5,Q6,Q7,Q8,Q9
234 DATA P1,P2,P3,P4,P5,P6,P7/0.5D0,0.87890594D0,0.51498869D0,
235 * 0.15084934D0,0.2658733D-1,0.301532D-2,0.32411D-3/
236 DATA Q1,Q2,Q3,Q4,Q5,Q6,Q7,Q8,Q9/0.39894228D0,-0.3988024D-1,
237 * -0.362018D-2,0.163801D-2,-0.1031555D-1,0.2282967D-1,
238 * -0.2895312D-1,0.1787654D-1,-0.420059D-2/
239 IF (ABS(X).LT.3.75) THEN
240 Y=(X/3.75)**2
241 BESSI1=X*(P1+Y*(P2+Y*(P3+Y*(P4+Y*(P5+Y*(P6+Y*P7))))))
242 ELSE
243 AX=ABS(X)
244 Y=3.75/AX
245 BESSI1=(EXP(AX)/SQRT(AX))*(Q1+Y*(Q2+Y*(Q3+Y*(Q4+
246 * Y*(Q5+Y*(Q6+Y*(Q7+Y*(Q8+Y*Q9))))))))
247 ENDIF
248 RETURN
249 END
250 FUNCTION BESSK(N,X)
251C----------------------------------------------------------------------------
252C Bessel functions
253C----------------------------------------------------------------------------
254 IF (N.LT.2) PAUSE 'bad argument N in BESSK'
255 TOX=2.0/X
256 BKM=BESSK0(X)
257 BK=BESSK1(X)
258 DO 11 J=1,N-1
259 BKP=BKM+J*TOX*BK
260 BKM=BK
261 BK=BKP
26211 CONTINUE
263 BESSK=BK
264 RETURN
265 END
266 FUNCTION BESSK0(X)
267C----------------------------------------------------------------------------
268C Bessel functions
269C----------------------------------------------------------------------------
270 REAL*8 Y,P1,P2,P3,P4,P5,P6,P7,
271 * Q1,Q2,Q3,Q4,Q5,Q6,Q7
272 DATA P1,P2,P3,P4,P5,P6,P7/-0.57721566D0,0.42278420D0,
273 * 0.23069756D0,0.3488590D-1,0.262698D-2,0.10750D-3,0.74D-5/
274 DATA Q1,Q2,Q3,Q4,Q5,Q6,Q7/1.25331414D0,-0.7832358D-1,
275 * 0.2189568D-1,-0.1062446D-1,0.587872D-2,-0.251540D-2,0.53208D-3/
276 IF (X.LE.2.0) THEN
277 Y=X*X/4.0
278 BESSK0=(-LOG(X/2.0)*BESSI0(X))+(P1+Y*(P2+Y*(P3+
279 * Y*(P4+Y*(P5+Y*(P6+Y*P7))))))
280 ELSE
281 Y=(2.0/X)
282 BESSK0=(EXP(-X)/SQRT(X))*(Q1+Y*(Q2+Y*(Q3+
283 * Y*(Q4+Y*(Q5+Y*(Q6+Y*Q7))))))
284 ENDIF
285 RETURN
286 END
287 FUNCTION BESSK1(X)
288C----------------------------------------------------------------------------
289C Bessel functions
290C----------------------------------------------------------------------------
291 REAL*8 Y,P1,P2,P3,P4,P5,P6,P7,
292 * Q1,Q2,Q3,Q4,Q5,Q6,Q7
293 DATA P1,P2,P3,P4,P5,P6,P7/1.0D0,0.15443144D0,-0.67278579D0,
294 * -0.18156897D0,-0.1919402D-1,-0.110404D-2,-0.4686D-4/
295 DATA Q1,Q2,Q3,Q4,Q5,Q6,Q7/1.25331414D0,0.23498619D0,
296 * -0.3655620D-1,0.1504268D-1,-0.780353D-2,0.325614D-2,
297 * -0.68245D-3/
298 IF (X.LE.2.0) THEN
299 Y=X*X/4.0
300 BESSK1=(LOG(X/2.0)*BESSI1(X))+(1.0/X)*(P1+Y*(P2+
301 * Y*(P3+Y*(P4+Y*(P5+Y*(P6+Y*P7))))))
302 ELSE
303 Y=2.0/X
304 BESSK1=(EXP(-X)/SQRT(X))*(Q1+Y*(Q2+Y*(Q3+
305 * Y*(Q4+Y*(Q5+Y*(Q6+Y*Q7))))))
306 ENDIF
307 RETURN
308 END
309 SUBROUTINE BLOCK(SQS,SIG1,SIG2,SLOP1,SLOP2,
310 + RHO1,RHO2,SIGEL1,SIGEL2)
311C------------------------------------------------------------------------
312C. Fit of Block and Cahn to pp and pbar-p cross sections
313C------------------------------------------------------------------------
314C...p-p and pbar-p cross sections
315C. Parametrization of Block and Cahn
316C
317C. INPUT : SQS (GeV) = c.m. energy
318C.
319C. OUPUT : SIG1 (mbarn) = pp total cross section
320C. SLOP1 (GeV**2) = slope of elastic scattering
321C. RHO1 = Real/Imaginary part of the amplitude
322C. for forward elastic scattering (pp)
323C. SIGEL1 (mbarn) = pp elastic scattering cross section
324C. [1 -> 2 : pp -> pbar p]
325C-----------------------------------------------------------------------
326 DATA PI /3.1415926/
327 DATA CMBARN /0.389385/
328 S = SQS*SQS
329 CALL FPLUS (S, FR, FI)
330 CALL FMINUS (S, GR, GI)
331 SIG1 = FI-GI
332 SIG2 = FI+GI
333 RHO1 = (FR-GR)/(FI-GI)
334 RHO2 = (FR+GR)/(FI+GI)
335 CALL SSLOPE (S, BP, BM)
336 SLOP1 = BP - GI/FI*(BM-BP)
337 SLOP2 = BP + GI/FI*(BM-BP)
338 SIGEL1 = SIG1**2*(1.+RHO1**2)/(16.*PI*SLOP1)/CMBARN
339 SIGEL2 = SIG2**2*(1.+RHO2**2)/(16.*PI*SLOP2)/CMBARN
340 RETURN
341 END
342
343 SUBROUTINE BLOCK_INI
344C...Parameters of fit IFIT=1 of Block and Cahn
345 COMMON /BLOCKC/ AA, BETA, S0, CC, AMU, DD, ALPHA, A0
346 COMMON /BLOCKD/ CP, DP, EP, CM, DM
347 AA = 41.74
348 BETA = 0.66
349 S0 = 338.5
350 CC = 0.
351 AMU = 0.
352 DD = -39.37
353 ALPHA = 0.48
354 A0 = 0.
355 CP = 10.90
356 DP = -0.08
357 EP = 0.043
358 CM = 23.27
359 DM = 0.93
360 RETURN
361 END
362
363 FUNCTION CHIDIS (KPARTin, IFL1, IFL2)
364C...Generate CHI (fraction of energy of a hadron carried by
365C. the valence quark, or diquark, as specified by IFL1)
366C. INPUT KPART = code of particle
367C. IFL1, IFL2 = codes of partons (3, 3bar of color)
368C.........................................................
369 COMMON /S_RUN/ SQS, S, Q2MIN, XMIN, ZMIN , kb ,kt
370 COMMON /S_CPSPL/ CCHIK(3,7:14)
371 COMMON/S_cutof/stringmas0
372C O. Palamara 27/8/1993
373C parameter QMAS=0.35
374 parameter (QMAS=0.35)
375 kpart=IABS(kpartin)
376 IFQ=IABS(IFL1)
377 IF (IFQ.GT.10) IFQ=IABS(IFL2)
378c CUT=2.*QMAS/SQS
379 CUT=2.*stringmas0/SQS
380100 CHIDIS=RNDM(0)**2
381 if (chidis.lt.cut) goto 100
382 if (chidis.gt.(1.-cut)) goto 100
383c IF((CHIDIS**2/(CHIDIS**2+CUT**2))**0.25
384 IF((CHIDIS**2/(CHIDIS**2+CUT**2))**0.5
385 + *(1.-CHIDIS)**CCHIK(IFQ,KPART).LT.RNDM(0)) GOTO 100
386 CHIDIS = MAX(0.5*CUT,CHIDIS)
387 CHIDIS = MIN(1.-CUT,CHIDIS)
388 IF (IABS(IFL1).GT.10) CHIDIS=1.-CHIDIS
389 RETURN
390 END
391 REAL FUNCTION DDIFFRACT(SQS,ipart)
392C... This routine only includes pp scattering.
393C INPUT SQS (GeV)
394C ipart is the code for the scattering particle(p,pi)
395C OUTPUT: dDIFFRACT is the Double Diffractive cross
396C section parameterized with a log.
397C in mb.
398C RSF
399C......................................................
400 real a(2),b(2)
401 data a/-1.23,.41/
402 data b/.7,0.12/
403 DDIFFRACT =( a(ipart)+b(ipart)*log(sqs))
404 RETURN
405 END
406 FUNCTION DENSA (Z)
407C....Woods Saxon nuclear density (normalised to 1)
408C. for a nucleus of mass number A.
409C. INPUT z = z coordinate (fm)
410C. JA = integer mass number
411C. B (in common /CC01/) impact parameter (fm)
412C. OUTPUT (fm**-3)
413C--------------------------------------------------------
414 COMMON /CC01/ B
415 COMMON /CCDA/ JA
416 COMMON /CWOOD/ RR0(19:56), AA0(19:56), CC0(19:56)
417 R = SQRT (Z*Z + B*B)
418 DENSA = CC0(JA)/(1.+EXP((R-RR0(JA))/AA0(JA)))
419 RETURN
420 END
421
422 FUNCTION DENS_NUC (R, JA)
423C===========================================================================
424C. Code about nuclear densities
425C===========================================================================
426C....Nuclear density (normalised to 1)
427C. for a nucleus of mass number JA
428C. INPUT R = radial coordinate (fm)
429C. JA = integer mass number
430C. OUTPUT (fm**-3)
431C--------------------------------------------------------
432 COMMON /CWOOD/ RR0(19:56), AA0(19:56), CC0(19:56)
433 IF (JA .GT. 18) THEN
434 DENS_NUC = WOOD_SAXON(R,JA)
435 ELSE IF (JA .NE. 4) THEN
436 DENS_NUC = HELIUM(R)
437 ELSE
438 DENS_NUC = SHELL(R,JA)
439 ENDIF
440 RETURN
441 END
442
443 SUBROUTINE DIFDEC (L0, P0)
444C..."decay" of an excited state with the quantum numbers
445C. of particle L0 and the 5-momentum P0
446C........................................................
447 COMMON /S_PLIST/ NP, P(5000,5), LLIST(5000)
448 COMMON /S_MASS1/ AM(49), AM2(49)
449 COMMON /S_CHP/ ICHP(49), ISTR(49), IBAR(49)
450 DIMENSION P0(5), LL(10), PD(10,5), BE(3), LCON(7:14)
451 DATA EMIN /0.7/
452 DATA LCON /6,6,11,11,9,9,14,13/
453 DATA PCHEX /0.33/ ! probability of charge exchange
454
455 LA = IABS(L0)
456 DELTAE = P0(5) - AM(LA)
457
458C..."string-like" decay
459 IF (DELTAE .GT. EMIN) THEN
460 N1 = NP+1
461 CALL HSPLI(L0,IFL1,IFL2)
462 IF (P0(3) .GT. 0.) THEN
463 IFLA = IFL2
464 IFL2 = IFL1
465 IFL1 = IFLA
466 ENDIF
46710 CALL STRING_FRAG (P0(5), IFL1, IFL2, 0.,0.,0.,0.,IFBAD)
468 IF (IFBAD .EQ. 1) GOTO 10
469 DO J=1,3
470 BE(J)=P0(J)/P0(4)
471 ENDDO
472 GA=P0(4)/P0(5)
473 DO I=N1,NP
474 BEP=BE(1)*P(I,1)+BE(2)*P(I,2)+BE(3)*P(I,3)
475 DO J=1,3
476 P(I,J)=P(I,J)+GA*(GA*BEP/(1.+GA)+P(I,4))*BE(J)
477 ENDDO
478 P(I,4)=GA*(P(I,4)+BEP)
479 ENDDO
480
481C...Phase space decay of the excited state
482 ELSE
483 AV = 2.*SQRT(DELTAE)
484100 NPI = AV*(1.+0.5*GASDEV(0))
485 IF(NPI.LE.0.OR.NPI.GT.9.OR.AM(LA)+NPI*AM(7)+0.02
486 . .GT.P0(5)) GOTO 100
487 IF (RNDM(0).LT.PCHEX) THEN
488 LL(NPI+1) = LCON(LA)*ISIGN(1,L0)
489 IF(L0 .EQ. 11) LL(NPI+1) = LL(NPI+1)+INT(2.*RNDM(0))
490 ELSE
491 LL(NPI+1) = L0
492 ENDIF
493 JQQ = ICHP(LA)*ISIGN(1,L0)-
494 . ICHP(IABS(LL(NPI+1)))*ISIGN(1,LL(NPI+1))
495120 JQTOT = 0.
496 DO K=1,NPI-1
497 LL(K) = 6+INT(RNDM(0)*2.99999)
498 JQTOT = JQTOT + ICHP(LL(K))
499 ENDDO
500 JQR = JQQ-JQTOT
501 IF (JQR.LT.-1.OR.JQR.GT.1) GOTO 120
502 LL(NPI) = 6+JQR
503 IF (LL(NPI) .EQ. 5) LL(NPI)=8
504 CALL DECPAR (0,P0,NPI+1,LL, PD)
505 DO J=1,NPI+1
506 NP = NP+1
507 LLIST(NP) = LL(J)
508 DO K=1,5
509 P(NP,K) = PD(J,K)
510 ENDDO
511 ENDDO
512 ENDIF
513 RETURN
514 END
515
516
517 SUBROUTINE DIFF_GEN (L0, JDIF)
518C----------------------------------------------------------------------------
519C Code for diffraction
520C----------------------------------------------------------------------------
521C...Single diffractive interaction
522C. INPUT L0 = index of "beam particle"
523C. the target is assumed to be a proton.
524C. JDIF = 1 "beam diffraction"
525C. = 2 "target diffraction"
526C. = 3 "double diffraction"
527C......................................................
528 COMMON /S_PLIST/ NP, P(5000,5), LLIST(5000)
529 COMMON /S_RUN/ SQS, S, Q2MIN, XMIN, ZMIN , kb ,kt
530 COMMON /S_MASS1/ AM(49), AM2(49)
531 COMMON /S_CHIST/ NW,NJET,NNJET(15),XX1JET(100)
532 + ,XX2JET(100),PPTJET(100),PHIJET(100),NNPJET(100),NNPSTR(30)
533 + , JJDIF, XMB, XMT
534 DIMENSION XM2MIN(3), ALXMIN(3)
535 DIMENSION P0(5)
536 DIMENSION KK(7:14)
537
538 DATA PI /3.1415926/
539 DATA KK /2*2,4*3,2*1/
540 DATA XM2MIN /1.5, 0.2, 0.6/ ! M_x**2(min) GeV**2
541 DATA ALXMIN /0.405465,-1.6094379,-0.5108256/ ! log[M_x**2(min)]
542 DATA SLOP0 /6.5/ ! b (slope_ for Mx**2 > 5 GeV**2
543 DATA ASLOP /31.10362/ ! fit to the slope parameter.
544 DATA BSLOP /-15.29012/
545
546 LA = IABS(L0)
547 XM2MAX = 0.10*S
548
549C...Double diffraction
550 IF (JDIF .EQ. 3) THEN
551 K = KK(LA)
552 AL = LOG(XM2MAX/XM2MIN(K))
553 ALX = ALXMIN(K) + AL*RNDM(0)
554 XMB2 = EXP(ALX)
555 XMB = SQRT (XMB2)
556 AL = LOG(XM2MAX/XM2MIN(1))
557 ALX = ALXMIN(1) + AL*RNDM(0)
558 XMT2 = EXP(ALX)
559 XMT = SQRT (XMT2)
560 X1 = 1.+(XMB2-XMT2)/S
561 X2 = 2.-X1
562 SLOPE = MAX(SLOP0, ASLOP+BSLOP*ALX)
56350 T = -LOG(RNDM(0))/SLOPE
564 PT = SQRT(T)
565 PZ1 = 0.25*S*X1*X1-XMB2-PT*PT
566 PZ2 = 0.25*S*X2*X2-XMT2-PT*PT
567 IF (PZ1.LT.0. .OR. PZ2.LT.0.) GOTO 50
568 PHI = PI*RNDM(0)
569 P0(5) = XMB
570 P0(4) = 0.5*SQS*X1
571 P0(1) = PT*COS(PHI)
572 P0(2) = PT*SIN(PHI)
573 P0(3) = SQRT(PZ1)
574 CALL DIFDEC (L0, P0)
575 P0(5) = XMT
576 P0(4) = 0.5*SQS*X2
577 P0(1) = -P0(1)
578 P0(2) = -P0(2)
579 P0(3) = -SQRT(PZ2)
580 CALL DIFDEC (13, P0)
581 RETURN
582 ENDIF
583
584C...Single diffraction
585 IF (JDIF.EQ. 1) THEN
586 K = KK(LA)
587 EM = AM(13)
588 EM2 = AM2(13)
589 L = 13
590 ZD = -1.
591 ELSE
592 K = 1
593 EM = AM(LA)
594 EM2 = AM2(LA)
595 L = L0
596 ZD = +1.
597 ENDIF
598C Generate the mass of the diffracted system Mx (1/Mx**2 distribution)
599 AL = LOG(XM2MAX/XM2MIN(K))
600 ALX = ALXMIN(K) + AL*RNDM(0)
601 XM2 = EXP(ALX)
602 XM = SQRT (XM2)
603 XMB = XM
604 XMT = XM
605C Generate the Kinematics of the pseudoelastic hadron
606 X = 1.-(XM2-EM2)/S
607 NP = NP+1
608 P(NP,4) = 0.5*SQS*X
609 SLOPE = MAX(SLOP0, ASLOP+BSLOP*ALX)
61060 T = -LOG(MAX(1.E-10,RNDM(0)))/SLOPE
611 PT = SQRT(T*X)
612 PZ2 = P(NP,4)**2-EM2 - PT*PT
613 IF (PZ2 .LT.0.) GOTO 60
614 PHI = PI*RNDM(0)
615 P(NP,3) = SQRT(PZ2)*ZD
616 P(NP,1) = PT*COS(PHI)
617 P(NP,2) = PT*SIN(PHI)
618 P(NP,5) = EM
619 LLIST(NP) = L
620C Generating the hadronic system recoling against the produced particle
621 P0(5) = SQRT(XM2)
622 P0(4) = 0.5*SQS*(2.-X)
623 DO J=1,3
624 P0(J) = -P(NP,J)
625 ENDDO
626 CALL DIFDEC (L0, P0)
627 RETURN
628 END
629 function estar(ap,at,b)
630 implicit real*8(a-h,o-z)
631 real*4 ap,at,b,estar
632 sigma=4.5 !total n-n cross section in fm**2
633 rt=.82*at**.3333 !target radius
634 rp=.82*ap**.3333 !projectile radius
635 alpha=rt**2/rp**2
636 beta=b**2/rt**2
637 f=at*sigma/(3.14159*rt**2)
638 alf = log(f)
639 alalf = log(alpha)
640 gfac=0
641 gfac1=0
642 s1=0.
643 s2=0.
644 s3=0.
645 ii=1
646 do n=0,10 ! This limit may not need to be so high.
647 if(n.ge.2) then
648 gfac1=gfac
649 gfac=gfac+log(float(n))
650 endif
651 g0=n*alf -n*beta*alpha/(n+alpha)+alalf
652 g1=g0-log(alpha+n)-gfac
653 g2=(n+2)*log(f)-(n+2)*beta*alpha/(n+2+alpha)
654 > +log(n+2+alpha+beta*alpha**2)-3*log(n+2+alpha)-gfac
655 g3=g0-2*log(n+alpha)-gfac1
656 ii=-ii
657 s1=s1+ii*exp(g1)
658 s2=s2+ii*exp(g2)
659 if(n.ge.1) s3=s3+ii*exp(g3)
660 enddo
661
662 pb=s1
663 e1b=197.**2/(2*938.*rp**2*pb) *s2
664c a=b*(s3/pb-1)
665c a=-b*s3/pb
666c e2b=-.5* 938. * (41./(ap**.333))**2 * a**2 /(197.**2)
667c estar=e1b+e2b
668 estar = e1b
669 return
670 end
671
672 FUNCTION ESTARP (NPF, NW)
673C CONTRIBUTION TO E* FROM ENERGY DEPOSITED BY SECONDARIES
674C VERY NAIVE VERSION INCORPORATING HUEFFNER'S IDEAS
675 APF = NPF
676 F1 = 15.3/APF**0.666666666
677C AVERAGE KINETIC ENERGY/NUCLEON IN PREFRAGMENT (MeV)
678C PER PATHLENGTH EQUAL TO THE PREFRAGMENT RADIUS
679 ESTARP = 0.
680 DO I=1,NW
681 IF (RNDM(0) .GT. 0.5) THEN
682 F2 = F1*RDIS(0)
683 ESTARP = ESTARP + F2
684 ENDIF
685 ENDDO
686C SAMPLE RANDOMLY PER WOUNDED NUCLEON, x NW
687 RETURN
688 END
689 SUBROUTINE ESUM(N1,N2,ETOT,PXT,PYT,PZT,NF)
690C...Return the energy,px,py,pz and the number of stable
691C. particles in the list between N1 and N2
692 COMMON /S_PLIST/ NP, P(5000,5), LLIST(5000)
693 NF=0
694 ETOT=0.
695 PXT=0.
696 PYT=0.
697 PZT=0.
698 DO J=N1,N2
699 L = LLIST(J)
700 IF (IABS(L) .LT. 10000) THEN
701 NF = NF+1
702 ETOT = ETOT + P(J,4)
703 PXT = PXT + P(J,1)
704 PYT = PYT + P(J,2)
705 PZT = PZT + P(J,3)
706 ENDIF
707 ENDDO
708 RETURN
709 END
710 subroutine evap(npf,eb,eps,nnuc,nalp)
711 eps=7.5+sqrt(8*eb)
712 n=min(npf*int(eb/eps),npf)
713 nalp=n/5
714 nnuc=n-4*nalp
715 return
716 end
717 SUBROUTINE FACT_INI
718 COMMON /S_CFACT/ FACT (0:20), CO_BIN(0:20,0:20)
719 FACT(0) = 1.
720 DO J=1,20
721 FACT(J) = FACT(J-1)*FLOAT(J)
722 ENDDO
723 DO J=0,20
724 DO K=0,J
725 CO_BIN(J,K) = FACT(J)/(FACT(K)*FACT(J-K))
726 ENDDO
727 ENDDO
728 RETURN
729 END
730 REAL FUNCTION FDIFFRACT(SQS,ipart)
731C==================================================================
732C..Diffractive cross sections
733C==================================================================
734C... This routine only includes pp scattering.
735C INPUT SQS (GeV)
736C ipart is the code for the scattering particle(p,pi)
737C OUTPUT: DIFFRACT is the single diffractive cross
738C section parameterized with a log.
739c in mb.
740C RSF
741C......................................................
742 real a(2),b(2)
743 data a/0.0,1.42/
744 data b/1.56,0.72/
745 FDIFFRACT =( a(ipart)+b(ipart)*log(sqs))/2.0
746 RETURN
747 END
748 FUNCTION FERMK(A)
749 DIMENSION AA(6), FK(6)
750 DATA AA/4., 6., 12., 24., 40., 57./
751 DATA FK/130.,169.,221.,235.,251.,260./
752 DO I=2,4
753 IF (A .LT. AA(I)) GO TO 25
754 ENDDO
755 I = 5
756 25 F11 = AA(I-1)
757 F12 = AA(I)
758 F13 = AA(I+1)
759 F21 = FK(I-1)
760 F22 = FK(I)
761 F23 = FK(I+1)
762 FERMK = QUAD_INT(A,F11,F12,F13, F21,F22,F23)
763 RETURN
764 END
765
766 SUBROUTINE FMINUS (S, FR, FI)
767 COMMON /BLOCKC/ AA, BETA, S0, CC, AMU, DD, ALPHA, A0
768 DATA PI /3.1415926/
769 F1 = S**(ALPHA-1.)
770 F2 = 0.5*PI*(1.-ALPHA)
771 FR = -DD*F1*COS(F2)
772 FI = -DD*F1*SIN(F2)
773 RETURN
774 END
775
776 SUBROUTINE FPLUS (S, FR, FI)
777 COMMON /BLOCKC/ AA, BETA, S0, CC, AMU, DD, ALPHA, A0
778 COMPLEX Z1, Z2, Z3
779 DATA PI /3.1415926/
780 F1 = LOG(S/S0)
781 Z1 = CMPLX(F1,-PI/2.)
782 Z1 = Z1*Z1
783 Z2 = 1. + A0*Z1
784 Z3 = Z1/Z2
785 F2 = CC*S**(AMU-1.)
786 F3 = 0.5*PI*(1.-AMU)
787 FI = AA + F2*COS(F3) + BETA*REAL(Z3)
788 FR = -BETA*AIMAG(Z3)+F2*SIN(F3)
789 RETURN
790 END
791
792 FUNCTION FPNI (E,L)
793C...This function returns the interaction length
794C. of an hadronic particle travelling in air
795C. INPUT: E (TeV) particle energy
796C. L particle code
797C. OUTPUT: FPNI (g cm-2)
798C...................................................
799 COMMON /CSAIR/ NSQS, ASQSMIN, ASQSMAX, DASQS,
800 + SSIG0(41,2),SSIGA(41,2),ALINT(41,2)
801 DIMENSION KK(7:14)
802 DATA KK /6*2, 2*1/
803 SQS = SQRT(2000.*E*0.937) ! GeV
804 AL = LOG10 (SQS)
805 T = (AL-ASQSMIN)/DASQS
806 J = INT(T)
807C D.H.
808 J = MIN(J,39)
809 J = MAX(J,0)
810
811 T = T-FLOAT(J)
812 FPNI = (1.-T)*ALINT(J+1,KK(L)) + T*ALINT(J+2,KK(L)) ! g cm-2
813 RETURN
814 END
815
816 SUBROUTINE FRAGM (IAT,IAP, NW,B, NF, IAF)
817C...Nuclear Fragmentation, Abrasion-ablation model,
818C...Based on Jon Engel's routines ABRABL
819C...This most recent version adds for all prefragment
820C...masses > 10 the model calculation for the fragment
821C...mass distribution and the energy carried by the fragment
822C...of W. Friedmann
823C...The average values are used to implement the model
824C...in the montecarlo fashion / TSS, Dec '91
825C...Needs INITFRAG to fill in the model data from INITFRAG.TAB
826C.
827C. INPUT: IAP = mass of incident nucleus
828C. IAT = mass of target nucleus
829C. NW = number of wounded nucleons in the beam nucleus
830C. B = impact parameter in the interaction
831C.
832C. OUTPUT : NF = number of fragments of the spectator nucleus
833C. IAF(1:NF) = mass number of each fragment
834C. PF(3,60) in common block /FRAGMENTS/ contains
835C. the three momentum components (MeV/c) of each
836C. fragment in the projectile frame
837C..............................................................
838 COMMON /FRAGMENTS/ PPP(3,60)
839 COMMON /FRAGMOD/A(10,10,20),AE(10,10,20),ERES(10,10),NFLAGG(10,10)
840 DIMENSION IAF(60)
841 DIMENSION AA(10), EAA(10)
842 DATA AA/10.,15.,20.,25.,30.,35.,40.,45.,50.,56./
843 DATA EAA/1.,2.,4.,6.,8.,10.,12.,16.,20.,30/
844 AP=IAP
845 AT=IAT
846 NPF = IAP - NW
847 IF (NPF .EQ. 0) THEN
848 NF = 0
849 RETURN
850 ENDIF
851
852 EB = ESTAR(AP,AT, B)
853 EBP = ESTARP (NPF, NW)
854C CONTRIBUTION TO E* FROM ENERGY DEPOSITED BY SECONDARIES
855 EB = EB + EBP
856C TOTAL E* IS THE SUM OF THE TWO COMPONENTS
857
858C.....Prefragment transverse momentum (MeV/nucleon)...
859 FK = FERMK(AP)
860C FERMI MOMENTUM OF THE PROJECTILE NUCLEUS
861 IF (NW .LT. IAP) THEN
862 SIG = FK*SQRT(NW*NPF/(AP-1.))/3.162
863C GAUSSIAN SIGMA IN ALL THREE DIRECTION
864 ELSE
865 SIG = FK/3.162
866C THIS IS NOT CORRECT, TOO LARGE !!!!!!!!!!!!!!
867 ENDIF
868 PPFX = SIG*GASDEV(0)/NPF
869 PPFY = SIG*GASDEV(0)/NPF
870C THREE MOMENTUM COMPONENTS PER NUCLEON FOR THE PREFRAGMENT
871
872C.............Crude model for small prefragment mass .......
873 IF (NPF .LT. 10) THEN
874 CALL EVAP(NPF, EB, EPS, NNUC, NALP)
875C EPS IS THE KINETIC ENERGY CARRIED BY THE EVAPORATED NUCLEONS
876 ETOT = 938. + EPS
877 PP = SQRT((ETOT*ETOT - 8.79844E5)/3.)
878C AVERAGE MOMENTUM OF EVAPORATED NUCLEONS IN EACH DIRECTION
879 NUC = NPF - NNUC - 4*NALP
880 NF = 0
881 IF (NUC .GT. 0) THEN
882 NF = NF + 1
883 IAF(NF) = NUC
884 PPP(1,NF) = NUC*PPFX
885 PPP(2,NF) = NUC*PPFY
886 ENDIF
887 IF (NALP .NE. 0) THEN
888 DO I=1,NALP
889 NF = NF + 1
890 IAF(NF) = 4
891 CALL SINCO(S1,C1)
892 CALL SINCO(S2,C2)
893 PXE = 4.*PP*S1*S2
894 PYE = 4.*PP*S1*C2
895 PPP(1,NF) = 4.*PPFX + PXE
896 PPP(2,NF) = 4.*PPFY + PYE
897 PPP(1,1) = PPP(1,1) - PXE
898 PPP(2,1) = PPP(2,1) - PYE
899 ENDDO
900 ENDIF
901 IF (NNUC .NE. 0) THEN
902 DO I=1,NNUC
903 NF = NF + 1
904 IAF(NF) = 1
905 CALL SINCO(S1,C1)
906 CALL SINCO(S2,C2)
907 PXE = PP*S1*S2
908 PYE = PP*S1*C2
909 PPP(1,NF) = 4.*PPFX + PXE
910 PPP(2,NF) = 4.*PPFY + PYE
911 PPP(1,1) = PPP(1,1) - PXE
912 PPP(2,1) = PPP(2,1) - PYE
913 ENDDO
914 ENDIF
915 RETURN
916 ENDIF
917
918C.........More refined model calculation .............
919 JA = NPF/5 -1
920 IF (JA .LT. 10) THEN
921 IF ((NPF - AA(JA)) .GT. (AA(JA+1)-NPF)) JA = JA + 1
922 ENDIF
923 ARAT = FLOAT(NPF)/AA(JA)
924 DO J=1,10
925 IF (EB .LT. EAA(J)) GO TO 29
926 ENDDO
927 JE = 10
928 GO TO 39
929 29 JE = J
930 39 IF (JE .GT. 1 .AND. JE .NE. 10) THEN
931 IF ((EB - EAA(J-1)) .LT. (EAA(J)-EB)) JE = J - 1
932 ENDIF
933 ERAT = EB/EAA(JE)
934 IF (EB .LT. 1.) THEN
935 ERAT = EB
936 ENDIF
937C INTERPOLATE BETWEEN EB=0. (NOTHING HAPPENS) AND EB = 1. MeV
938
939 IF (JA .EQ. 10 .AND. JE .GT. 6) THEN
940 WRITE(*,*)' JA=',JA,', JE=',JE
941 ENDIF
942 43 ESUM = 0.
943 NSUM = 0
944 JF = 0
945 DO J=20,1,-1
946 FR = A(JA, JE, J)*ARAT*ERAT
947 N1 = 1 + FR
948 FR1 = FR/FLOAT(N1)
949 DO K=1, N1
950 IF (RNDM(0) .LT. FR1) THEN
951 JF = JF + 1
952 IAF(JF) = J
953 NSUM = NSUM + J
954 EKIN = ERAT*AE(JA,JE, J)
955 IF (EKIN .GT. 0.) THEN
956 ESUM = ESUM + EKIN
957 ETOT = 938.*IAF(JF) + EKIN
958 PP = SQRT(2.*(ETOT*ETOT - IAF(JF)**2*8.79844E5)/3.)
959 CALL SINCO(S1,C1)
960 CALL SINCO(S2,C2)
961 PPP(1,JF) = PP*S1*S2 + IAF(JF)*PPFX
962 PPP(2,JF) = PP*S1*C2 + IAF(JF)*PPFY
963 ENDIF
964 IF (NSUM .GT. NPF) THEN
965C WRITE(*,*)' WARNING, NSUM=', NSUM,', NPF=',NPF
966C WRITE(*,*)' ARAT =', ARAT
967 GO TO 43
968 ELSE
969 IF (NSUM .EQ. NPF) THEN
970 GO TO 44
971 ENDIF
972 ENDIF
973 ENDIF
974 ENDDO
975 ENDDO
976 IF (NFLAGG(JA,JE) .EQ. 0) THEN
977C 'THE RESIDUE' IS A NUCLEAR FRAGMENT
978 JF = JF + 1
979 IAF(JF) = NPF - NSUM
980 F1 = NPF*EB - ESUM
981 IF (F1 .LT. 0.) F1 = 0.
982C GIVE THE REST OF EB TO THE FRAGMENT
983 EKIN = F1
984 IF (EKIN .GT. 0.) THEN
985 ETOT = 938.*IAF(JF) + EKIN
986 PP = SQRT(2.*(ETOT*ETOT - IAF(JF)**2*8.79844E5)/3.)
987 CALL SINCO(S1,C1)
988 CALL SINCO(S2,C2)
989 PPP(1,JF) = PP*S1*S2 + IAF(JF)*PPFX
990 PPP(2,JF) = PP*S1*C2 + IAF(JF)*PPFY
991 ENDIF
992 ELSE
993C 'THE RESIDUE' CONSISTS OF SPECTATOR NUCLEONS
994 N1 = NPF - NSUM
995 DO K=1,N1
996 JF = JF + 1
997 IAF(JF) = 1
998 EKIN = ERAT*ERES(JA,JE)
999 IF (EKIN .GT. 0.) THEN
1000 ETOT = 938.*IAF(JF) + EKIN
1001 PP = SQRT(2.*(ETOT*ETOT - IAF(JF)**2*8.79844E5)/3.)
1002 CALL SINCO(S1,C1)
1003 CALL SINCO(S2,C2)
1004 PPP(1,JF) = PP*S1*S2 + PPFX
1005 PPP(2,JF) = PP*S1*C2 + PPFY
1006 ENDIF
1007 ENDDO
1008 ENDIF
1009 44 NF = JF
1010 RETURN
1011 END
1012 SUBROUTINE FRAGM1 (IA,NW, NF, IAF)
1013C...Nuclear Fragmentation
1014C. total dissolution of nucleus
1015C..........................................
1016 DIMENSION IAF(60)
1017 NF = IA-NW
1018 DO J=1,NF
1019 IAF(J) = 1
1020 ENDDO
1021 RETURN
1022 END
1023 SUBROUTINE FRAGM2 (IA,NW, NF, IAF)
1024C...Nuclear Fragmentation
1025C. Spectator in one single fragment
1026C..........................................
1027 DIMENSION IAF(60)
1028 IF (IA-NW .GT. 0) THEN
1029 NF = 1
1030 IAF(1) = IA-NW
1031 ELSE
1032 NF = 0
1033 ENDIF
1034 RETURN
1035 END
1036 BLOCK DATA FRAG_DATA
1037C====================================================================
1038C...Code of fragmentation of spectator nucleons
1039C. based on Jon Engel abrasion-ablation algorithms
1040C...Data for the fragmentation of nucleus projectiles
1041 COMMON /FRAGMOD/A(10,10,20),AE(10,10,20),ERES(10,10),NFLAGG(10,10)
1042 DATA (NFLAGG(I, 1),I=1,10) /
1043 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /
1044 DATA (NFLAGG(I, 2),I=1,10) /
1045 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /
1046 DATA (NFLAGG(I, 3),I=1,10) /
1047 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /
1048 DATA (NFLAGG(I, 4),I=1,10) /
1049 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /
1050 DATA (NFLAGG(I, 5),I=1,10) /
1051 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 /
1052 DATA (NFLAGG(I, 6),I=1,10) /
1053 + 0, 0, 0, 0, 0, 0, 0, 1, 1, 1 /
1054 DATA (NFLAGG(I, 7),I=1,10) /
1055 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 /
1056 DATA (NFLAGG(I, 8),I=1,10) /
1057 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 /
1058 DATA (NFLAGG(I, 9),I=1,10) /
1059 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 /
1060 DATA (NFLAGG(I,10),I=1,10) /
1061 + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 /
1062 DATA (A(I, 1, 1),I=1,10) /
1063 + .438E-01,.172 ,.283 ,.511 ,.715 ,.920 ,1.19 ,
1064 + 1.37 ,1.65 ,2.14 /
1065 DATA (A(I, 1, 2),I=1,10) /
1066 + .147E-01,.249E-01,.439E-01,.592E-01,.776E-01,.886E-01,.108 ,
1067 + .117 ,.126 ,.128 /
1068 DATA (A(I, 1, 3),I=1,10) /
1069 + .216E-02,.627E-02,.834E-02,.108E-01,.144E-01,.152E-01,.196E-01,
1070 + .200E-01,.210E-01,.224E-01 /
1071 DATA (A(I, 1, 4),I=1,10) /
1072 + .593E-01,.653E-01,.116 ,.145 ,.184 ,.204 ,.234 ,
1073 + .257 ,.271 ,.248 /
1074 DATA (A(I, 1, 5),I=1,10) /
1075 + .000E+00,.918E-02,.362E-02,.805E-02,.436E-02,.728E-02,.466E-02,
1076 + .707E-02,.932E-02,.130E-01 /
1077 DATA (A(I, 1, 6),I=1,10) /
1078 + .000E+00,.180E-02,.247E-02,.208E-02,.224E-02,.214E-02,.226E-02,
1079 + .233E-02,.230E-02,.194E-02 /
1080 DATA (A(I, 1, 7),I=1,10) /
1081 + .000E+00,.106E-02,.703E-03,.687E-03,.739E-03,.674E-03,.819E-03,
1082 + .768E-03,.756E-03,.720E-03 /
1083 DATA (A(I, 1, 8),I=1,10) /
1084 + .000E+00,.000E+00,.188E-02,.130E-02,.138E-02,.117E-02,.124E-02,
1085 + .119E-02,.111E-02,.829E-03 /
1086 DATA (A(I, 1, 9),I=1,10) /
1087 + .000E+00,.000E+00,.302E-03,.258E-03,.249E-03,.208E-03,.248E-03,
1088 + .222E-03,.210E-03,.187E-03 /
1089 DATA (A(I, 1,10),I=1,10) /
1090 + .000E+00,.000E+00,.000E+00,.235E-03,.222E-03,.172E-03,.181E-03,
1091 + .166E-03,.152E-03,.124E-03 /
1092 DATA (A(I, 1,11),I=1,10) /
1093 + .000E+00,.000E+00,.000E+00,.238E-03,.179E-03,.145E-03,.156E-03,
1094 + .138E-03,.129E-03,.111E-03 /
1095 DATA (A(I, 1,12),I=1,10) /
1096 + .000E+00,.000E+00,.000E+00,.368E-03,.400E-03,.255E-03,.262E-03,
1097 + .221E-03,.182E-03,.112E-03 /
1098 DATA (A(I, 1,13),I=1,10) /
1099 + .000E+00,.000E+00,.000E+00,.000E+00,.753E-04,.712E-04,.527E-04,
1100 + .537E-04,.538E-04,.487E-04 /
1101 DATA (A(I, 1,14),I=1,10) /
1102 + .000E+00,.000E+00,.000E+00,.000E+00,.103E-03,.589E-04,.578E-04,
1103 + .468E-04,.385E-04,.269E-04 /
1104 DATA (A(I, 1,15),I=1,10) /
1105 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.444E-04,.372E-04,
1106 + .318E-04,.284E-04,.218E-04 /
1107 DATA (A(I, 1,16),I=1,10) /
1108 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.487E-04,.473E-04,
1109 + .338E-04,.243E-04,.122E-04 /
1110 DATA (A(I, 1,17),I=1,10) /
1111 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.121E-04,.117E-04,
1112 + .932E-05,.792E-05,.583E-05 /
1113 DATA (A(I, 1,18),I=1,10) /
1114 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.147E-04,
1115 + .101E-04,.756E-05,.496E-05 /
1116 DATA (A(I, 1,19),I=1,10) /
1117 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.755E-05,
1118 + .612E-05,.505E-05,.341E-05 /
1119 DATA (A(I, 1,20),I=1,10) /
1120 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,
1121 + .630E-05,.444E-05,.282E-05 /
1122 DATA (A(I, 2, 1),I=1,10) /
1123 + .269 ,.510 ,.738 ,1.12 ,1.46 ,1.83 ,2.22 ,
1124 + 2.57 ,3.00 ,3.67 /
1125 DATA (A(I, 2, 2),I=1,10) /
1126 + .121 ,.133 ,.190 ,.234 ,.293 ,.332 ,.395 ,
1127 + .431 ,.468 ,.502 /
1128 DATA (A(I, 2, 3),I=1,10) /
1129 + .227E-01,.374E-01,.474E-01,.578E-01,.722E-01,.794E-01,.960E-01,
1130 + .102 ,.110 ,.120 /
1131 DATA (A(I, 2, 4),I=1,10) /
1132 + .287 ,.196 ,.270 ,.314 ,.373 ,.408 ,.462 ,
1133 + .498 ,.529 ,.523 /
1134 DATA (A(I, 2, 5),I=1,10) /
1135 + .000E+00,.433E-01,.218E-01,.384E-01,.263E-01,.385E-01,.298E-01,
1136 + .405E-01,.504E-01,.671E-01 /
1137 DATA (A(I, 2, 6),I=1,10) /
1138 + .000E+00,.151E-01,.177E-01,.159E-01,.173E-01,.173E-01,.187E-01,
1139 + .196E-01,.201E-01,.191E-01 /
1140 DATA (A(I, 2, 7),I=1,10) /
1141 + .000E+00,.457E-02,.607E-02,.610E-02,.677E-02,.670E-02,.784E-02,
1142 + .787E-02,.806E-02,.803E-02 /
1143 DATA (A(I, 2, 8),I=1,10) /
1144 + .000E+00,.000E+00,.702E-02,.536E-02,.558E-02,.510E-02,.554E-02,
1145 + .546E-02,.538E-02,.489E-02 /
1146 DATA (A(I, 2, 9),I=1,10) /
1147 + .000E+00,.000E+00,.190E-02,.199E-02,.205E-02,.191E-02,.221E-02,
1148 + .214E-02,.213E-02,.204E-02 /
1149 DATA (A(I, 2,10),I=1,10) /
1150 + .000E+00,.000E+00,.000E+00,.226E-02,.219E-02,.195E-02,.208E-02,
1151 + .204E-02,.203E-02,.194E-02 /
1152 DATA (A(I, 2,11),I=1,10) /
1153 + .000E+00,.000E+00,.000E+00,.213E-02,.195E-02,.175E-02,.191E-02,
1154 + .183E-02,.179E-02,.166E-02 /
1155 DATA (A(I, 2,12),I=1,10) /
1156 + .000E+00,.000E+00,.000E+00,.588E-03,.186E-02,.137E-02,.141E-02,
1157 + .128E-02,.117E-02,.947E-03 /
1158 DATA (A(I, 2,13),I=1,10) /
1159 + .000E+00,.000E+00,.000E+00,.000E+00,.554E-03,.562E-03,.454E-03,
1160 + .485E-03,.505E-03,.509E-03 /
1161 DATA (A(I, 2,14),I=1,10) /
1162 + .000E+00,.000E+00,.000E+00,.000E+00,.490E-03,.533E-03,.531E-03,
1163 + .476E-03,.437E-03,.369E-03 /
1164 DATA (A(I, 2,15),I=1,10) /
1165 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.427E-03,.382E-03,
1166 + .358E-03,.340E-03,.294E-03 /
1167 DATA (A(I, 2,16),I=1,10) /
1168 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.239E-03,.298E-03,
1169 + .238E-03,.196E-03,.134E-03 /
1170 DATA (A(I, 2,17),I=1,10) /
1171 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.299E-04,.893E-04,
1172 + .796E-04,.744E-04,.683E-04 /
1173 DATA (A(I, 2,18),I=1,10) /
1174 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.127E-03,
1175 + .107E-03,.916E-04,.720E-04 /
1176 DATA (A(I, 2,19),I=1,10) /
1177 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.397E-04,
1178 + .630E-04,.565E-04,.461E-04 /
1179 DATA (A(I, 2,20),I=1,10) /
1180 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,
1181 + .511E-04,.459E-04,.402E-04 /
1182 DATA (A(I, 3, 1),I=1,10) /
1183 + .708 ,1.02 ,1.41 ,1.91 ,2.42 ,3.00 ,3.53 ,
1184 + 4.09 ,4.71 ,5.57 /
1185 DATA (A(I, 3, 2),I=1,10) /
1186 + .397 ,.410 ,.539 ,.648 ,.795 ,.910 ,1.06 ,
1187 + 1.17 ,1.29 ,1.42 /
1188 DATA (A(I, 3, 3),I=1,10) /
1189 + .845E-01,.122 ,.157 ,.190 ,.232 ,.262 ,.307 ,
1190 + .335 ,.366 ,.402 /
1191 DATA (A(I, 3, 4),I=1,10) /
1192 + .210 ,.379 ,.450 ,.490 ,.574 ,.636 ,.709 ,
1193 + .769 ,.820 ,.849 /
1194 DATA (A(I, 3, 5),I=1,10) /
1195 + .000E+00,.102 ,.675E-01,.104 ,.858E-01,.115 ,.102 ,
1196 + .129 ,.154 ,.194 /
1197 DATA (A(I, 3, 6),I=1,10) /
1198 + .000E+00,.392E-01,.615E-01,.593E-01,.649E-01,.674E-01,.735E-01,
1199 + .779E-01,.817E-01,.828E-01 /
1200 DATA (A(I, 3, 7),I=1,10) /
1201 + .000E+00,.539E-02,.222E-01,.238E-01,.269E-01,.280E-01,.320E-01,
1202 + .334E-01,.350E-01,.361E-01 /
1203 DATA (A(I, 3, 8),I=1,10) /
1204 + .000E+00,.000E+00,.838E-02,.130E-01,.133E-01,.131E-01,.141E-01,
1205 + .144E-01,.149E-01,.152E-01 /
1206 DATA (A(I, 3, 9),I=1,10) /
1207 + .000E+00,.000E+00,.228E-02,.647E-02,.688E-02,.687E-02,.772E-02,
1208 + .786E-02,.811E-02,.824E-02 /
1209 DATA (A(I, 3,10),I=1,10) /
1210 + .000E+00,.000E+00,.000E+00,.664E-02,.828E-02,.802E-02,.845E-02,
1211 + .869E-02,.902E-02,.930E-02 /
1212 DATA (A(I, 3,11),I=1,10) /
1213 + .000E+00,.000E+00,.000E+00,.338E-02,.735E-02,.710E-02,.767E-02,
1214 + .767E-02,.776E-02,.756E-02 /
1215 DATA (A(I, 3,12),I=1,10) /
1216 + .000E+00,.000E+00,.000E+00,.280E-03,.262E-02,.349E-02,.342E-02,
1217 + .322E-02,.312E-02,.291E-02 /
1218 DATA (A(I, 3,13),I=1,10) /
1219 + .000E+00,.000E+00,.000E+00,.000E+00,.618E-03,.161E-02,.138E-02,
1220 + .148E-02,.155E-02,.166E-02 /
1221 DATA (A(I, 3,14),I=1,10) /
1222 + .000E+00,.000E+00,.000E+00,.000E+00,.313E-03,.128E-02,.161E-02,
1223 + .150E-02,.144E-02,.134E-02 /
1224 DATA (A(I, 3,15),I=1,10) /
1225 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.645E-03,.118E-02,
1226 + .115E-02,.111E-02,.103E-02 /
1227 DATA (A(I, 3,16),I=1,10) /
1228 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.117E-03,.497E-03,
1229 + .581E-03,.501E-03,.401E-03 /
1230 DATA (A(I, 3,17),I=1,10) /
1231 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.115E-04,.997E-04,
1232 + .202E-03,.203E-03,.206E-03 /
1233 DATA (A(I, 3,18),I=1,10) /
1234 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.877E-04,
1235 + .242E-03,.263E-03,.226E-03 /
1236 DATA (A(I, 3,19),I=1,10) /
1237 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.158E-04,
1238 + .881E-04,.152E-03,.136E-03 /
1239 DATA (A(I, 3,20),I=1,10) /
1240 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,
1241 + .358E-04,.997E-04,.117E-03 /
1242 DATA (A(I, 4, 1),I=1,10) /
1243 + .945 ,1.29 ,1.40 ,1.98 ,2.73 ,3.17 ,3.77 ,
1244 + 4.29 ,4.78 ,5.54 /
1245 DATA (A(I, 4, 2),I=1,10) /
1246 + .581 ,.599 ,.645 ,.839 ,1.10 ,1.25 ,1.47 ,
1247 + 1.64 ,1.78 ,1.99 /
1248 DATA (A(I, 4, 3),I=1,10) /
1249 + .127 ,.182 ,.202 ,.264 ,.344 ,.387 ,.455 ,
1250 + .504 ,.549 ,.611 /
1251 DATA (A(I, 4, 4),I=1,10) /
1252 + .183 ,.464 ,.351 ,.444 ,.642 ,.659 ,.772 ,
1253 + .830 ,.882 ,.930 /
1254 DATA (A(I, 4, 5),I=1,10) /
1255 + .000E+00,.122 ,.803E-01,.136 ,.134 ,.173 ,.164 ,
1256 + .203 ,.239 ,.300 /
1257 DATA (A(I, 4, 6),I=1,10) /
1258 + .000E+00,.393E-01,.766E-01,.872E-01,.108 ,.111 ,.123 ,
1259 + .132 ,.139 ,.145 /
1260 DATA (A(I, 4, 7),I=1,10) /
1261 + .000E+00,.416E-02,.289E-01,.360E-01,.454E-01,.477E-01,.549E-01,
1262 + .583E-01,.618E-01,.654E-01 /
1263 DATA (A(I, 4, 8),I=1,10) /
1264 + .000E+00,.000E+00,.761E-02,.157E-01,.214E-01,.205E-01,.233E-01,
1265 + .241E-01,.255E-01,.271E-01 /
1266 DATA (A(I, 4, 9),I=1,10) /
1267 + .000E+00,.000E+00,.238E-02,.803E-02,.123E-01,.123E-01,.140E-01,
1268 + .145E-01,.153E-01,.160E-01 /
1269 DATA (A(I, 4,10),I=1,10) /
1270 + .000E+00,.000E+00,.000E+00,.695E-02,.150E-01,.154E-01,.166E-01,
1271 + .172E-01,.181E-01,.192E-01 /
1272 DATA (A(I, 4,11),I=1,10) /
1273 + .000E+00,.000E+00,.000E+00,.355E-02,.104E-01,.143E-01,.156E-01,
1274 + .158E-01,.164E-01,.165E-01 /
1275 DATA (A(I, 4,12),I=1,10) /
1276 + .000E+00,.000E+00,.000E+00,.112E-03,.276E-02,.568E-02,.736E-02,
1277 + .684E-02,.691E-02,.661E-02 /
1278 DATA (A(I, 4,13),I=1,10) /
1279 + .000E+00,.000E+00,.000E+00,.000E+00,.740E-03,.222E-02,.339E-02,
1280 + .352E-02,.382E-02,.409E-02 /
1281 DATA (A(I, 4,14),I=1,10) /
1282 + .000E+00,.000E+00,.000E+00,.000E+00,.369E-03,.160E-02,.322E-02,
1283 + .375E-02,.375E-02,.355E-02 /
1284 DATA (A(I, 4,15),I=1,10) /
1285 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.750E-03,.190E-02,
1286 + .298E-02,.319E-02,.299E-02 /
1287 DATA (A(I, 4,16),I=1,10) /
1288 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.260E-03,.673E-03,
1289 + .117E-02,.156E-02,.126E-02 /
1290 DATA (A(I, 4,17),I=1,10) /
1291 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.283E-05,.131E-03,
1292 + .363E-03,.618E-03,.690E-03 /
1293 DATA (A(I, 4,18),I=1,10) /
1294 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.205E-03,
1295 + .378E-03,.709E-03,.844E-03 /
1296 DATA (A(I, 4,19),I=1,10) /
1297 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.654E-05,
1298 + .150E-03,.341E-03,.527E-03 /
1299 DATA (A(I, 4,20),I=1,10) /
1300 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,
1301 + .957E-04,.197E-03,.406E-03 /
1302 DATA (A(I, 5, 1),I=1,10) /
1303 + 1.16 ,1.70 ,2.19 ,2.79 ,3.33 ,3.90 ,4.49 ,
1304 + 5.07 ,5.66 ,6.38 /
1305 DATA (A(I, 5, 2),I=1,10) /
1306 + .779 ,.899 ,1.09 ,1.28 ,1.51 ,1.71 ,1.96 ,
1307 + 2.18 ,2.39 ,2.62 /
1308 DATA (A(I, 5, 3),I=1,10) /
1309 + .167 ,.263 ,.334 ,.408 ,.482 ,.548 ,.632 ,
1310 + .700 ,.767 ,.840 /
1311 DATA (A(I, 5, 4),I=1,10) /
1312 + .203 ,.565 ,.845 ,.867 ,.906 ,.961 ,1.08 ,
1313 + 1.13 ,1.21 ,1.25 /
1314 DATA (A(I, 5, 5),I=1,10) /
1315 + .000E+00,.129 ,.152 ,.237 ,.208 ,.268 ,.258 ,
1316 + .312 ,.368 ,.450 /
1317 DATA (A(I, 5, 6),I=1,10) /
1318 + .000E+00,.460E-01,.126 ,.174 ,.182 ,.188 ,.208 ,
1319 + .219 ,.233 ,.239 /
1320 DATA (A(I, 5, 7),I=1,10) /
1321 + .000E+00,.289E-02,.380E-01,.611E-01,.788E-01,.845E-01,.974E-01,
1322 + .103 ,.111 ,.117 /
1323 DATA (A(I, 5, 8),I=1,10) /
1324 + .000E+00,.000E+00,.137E-01,.223E-01,.374E-01,.436E-01,.488E-01,
1325 + .488E-01,.524E-01,.547E-01 /
1326 DATA (A(I, 5, 9),I=1,10) /
1327 + .000E+00,.000E+00,.162E-02,.114E-01,.198E-01,.263E-01,.315E-01,
1328 + .323E-01,.348E-01,.364E-01 /
1329 DATA (A(I, 5,10),I=1,10) /
1330 + .000E+00,.000E+00,.000E+00,.149E-01,.240E-01,.320E-01,.428E-01,
1331 + .436E-01,.469E-01,.493E-01 /
1332 DATA (A(I, 5,11),I=1,10) /
1333 + .000E+00,.000E+00,.000E+00,.562E-02,.194E-01,.290E-01,.408E-01,
1334 + .460E-01,.492E-01,.500E-01 /
1335 DATA (A(I, 5,12),I=1,10) /
1336 + .000E+00,.000E+00,.000E+00,.476E-04,.106E-01,.134E-01,.191E-01,
1337 + .227E-01,.264E-01,.253E-01 /
1338 DATA (A(I, 5,13),I=1,10) /
1339 + .000E+00,.000E+00,.000E+00,.000E+00,.281E-02,.679E-02,.879E-02,
1340 + .123E-01,.165E-01,.190E-01 /
1341 DATA (A(I, 5,14),I=1,10) /
1342 + .000E+00,.000E+00,.000E+00,.000E+00,.542E-04,.847E-02,.125E-01,
1343 + .144E-01,.173E-01,.192E-01 /
1344 DATA (A(I, 5,15),I=1,10) /
1345 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.652E-02,.982E-02,
1346 + .129E-01,.159E-01,.192E-01 /
1347 DATA (A(I, 5,16),I=1,10) /
1348 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.109E-03,.688E-02,
1349 + .751E-02,.845E-02,.905E-02 /
1350 DATA (A(I, 5,17),I=1,10) /
1351 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.823E-06,.237E-02,
1352 + .318E-02,.446E-02,.569E-02 /
1353 DATA (A(I, 5,18),I=1,10) /
1354 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.604E-03,
1355 + .610E-02,.673E-02,.827E-02 /
1356 DATA (A(I, 5,19),I=1,10) /
1357 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.716E-06,
1358 + .412E-02,.519E-02,.617E-02 /
1359 DATA (A(I, 5,20),I=1,10) /
1360 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,
1361 + .710E-03,.543E-02,.674E-02 /
1362 DATA (A(I, 6, 1),I=1,10) /
1363 + 1.36 ,2.08 ,2.67 ,3.30 ,3.94 ,4.62 ,5.18 ,
1364 + 3.60 ,3.64 ,3.95 /
1365 DATA (A(I, 6, 2),I=1,10) /
1366 + 1.07 ,1.33 ,1.58 ,1.82 ,2.10 ,2.44 ,2.74 ,
1367 + 1.78 ,1.73 ,1.80 /
1368 DATA (A(I, 6, 3),I=1,10) /
1369 + .158 ,.276 ,.402 ,.506 ,.609 ,.700 ,.802 ,
1370 + .638 ,.629 ,.658 /
1371 DATA (A(I, 6, 4),I=1,10) /
1372 + .308 ,.739 ,1.02 ,1.12 ,1.26 ,1.35 ,1.57 ,
1373 + 1.94 ,1.71 ,1.55 /
1374 DATA (A(I, 6, 5),I=1,10) /
1375 + .000E+00,.217 ,.183 ,.324 ,.276 ,.395 ,.393 ,
1376 + .558 ,.602 ,.681 /
1377 DATA (A(I, 6, 6),I=1,10) /
1378 + .000E+00,.658E-01,.251 ,.267 ,.299 ,.326 ,.386 ,
1379 + .452 ,.475 ,.409 /
1380 DATA (A(I, 6, 7),I=1,10) /
1381 + .000E+00,.198E-02,.774E-01,.136 ,.149 ,.164 ,.187 ,
1382 + .210 ,.238 ,.256 /
1383 DATA (A(I, 6, 8),I=1,10) /
1384 + .000E+00,.000E+00,.290E-01,.122 ,.139 ,.128 ,.129 ,
1385 + .137 ,.147 ,.167 /
1386 DATA (A(I, 6, 9),I=1,10) /
1387 + .000E+00,.000E+00,.699E-03,.617E-01,.750E-01,.801E-01,.905E-01,
1388 + .974E-01,.105 ,.122 /
1389 DATA (A(I, 6,10),I=1,10) /
1390 + .000E+00,.000E+00,.000E+00,.310E-01,.112 ,.127 ,.140 ,
1391 + .143 ,.155 ,.176 /
1392 DATA (A(I, 6,11),I=1,10) /
1393 + .000E+00,.000E+00,.000E+00,.277E-02,.889E-01,.143 ,.150 ,
1394 + .175 ,.184 ,.208 /
1395 DATA (A(I, 6,12),I=1,10) /
1396 + .000E+00,.000E+00,.000E+00,.202E-04,.343E-01,.959E-01,.109 ,
1397 + .115 ,.112 ,.116 /
1398 DATA (A(I, 6,13),I=1,10) /
1399 + .000E+00,.000E+00,.000E+00,.000E+00,.186E-02,.435E-01,.512E-01,
1400 + .744E-01,.856E-01,.103 /
1401 DATA (A(I, 6,14),I=1,10) /
1402 + .000E+00,.000E+00,.000E+00,.000E+00,.144E-04,.427E-01,.786E-01,
1403 + .911E-01,.993E-01,.108 /
1404 DATA (A(I, 6,15),I=1,10) /
1405 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.466E-02,.518E-01,
1406 + .848E-01,.109 ,.119 /
1407 DATA (A(I, 6,16),I=1,10) /
1408 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.655E-05,.330E-01,
1409 + .586E-01,.617E-01,.594E-01 /
1410 DATA (A(I, 6,17),I=1,10) /
1411 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.228E-06,.328E-02,
1412 + .190E-01,.301E-01,.454E-01 /
1413 DATA (A(I, 6,18),I=1,10) /
1414 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.218E-04,
1415 + .272E-01,.501E-01,.707E-01 /
1416 DATA (A(I, 6,19),I=1,10) /
1417 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.146E-06,
1418 + .441E-02,.378E-01,.556E-01 /
1419 DATA (A(I, 6,20),I=1,10) /
1420 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,
1421 + .160E-03,.204E-01,.679E-01 /
1422 DATA (A(I, 7, 1),I=1,10) /
1423 + .522 ,.862 ,1.14 ,1.40 ,1.70 ,1.94 ,2.26 ,
1424 + 2.48 ,2.72 ,3.95 /
1425 DATA (A(I, 7, 2),I=1,10) /
1426 + .314 ,.450 ,.588 ,.692 ,.834 ,.936 ,1.09 ,
1427 + 1.18 ,1.28 ,1.80 /
1428 DATA (A(I, 7, 3),I=1,10) /
1429 + .814E-01,.147 ,.189 ,.226 ,.272 ,.302 ,.351 ,
1430 + .378 ,.406 ,.658 /
1431 DATA (A(I, 7, 4),I=1,10) /
1432 + .252 ,.864 ,1.01 ,.851 ,.837 ,.774 ,.763 ,
1433 + .757 ,.748 ,1.55 /
1434 DATA (A(I, 7, 5),I=1,10) /
1435 + .000E+00,.225 ,.180 ,.276 ,.193 ,.240 ,.190 ,
1436 + .228 ,.259 ,.681 /
1437 DATA (A(I, 7, 6),I=1,10) /
1438 + .000E+00,.485E-01,.272 ,.273 ,.253 ,.216 ,.206 ,
1439 + .197 ,.191 ,.409 /
1440 DATA (A(I, 7, 7),I=1,10) /
1441 + .000E+00,.137E-02,.752E-01,.137 ,.152 ,.134 ,.125 ,
1442 + .119 ,.116 ,.256 /
1443 DATA (A(I, 7, 8),I=1,10) /
1444 + .000E+00,.000E+00,.220E-01,.155 ,.175 ,.155 ,.116 ,
1445 + .977E-01,.858E-01,.167 /
1446 DATA (A(I, 7, 9),I=1,10) /
1447 + .000E+00,.000E+00,.326E-03,.695E-01,.881E-01,.106 ,.897E-01,
1448 + .782E-01,.706E-01,.122 /
1449 DATA (A(I, 7,10),I=1,10) /
1450 + .000E+00,.000E+00,.000E+00,.261E-01,.124 ,.131 ,.156 ,
1451 + .141 ,.121 ,.176 /
1452 DATA (A(I, 7,11),I=1,10) /
1453 + .000E+00,.000E+00,.000E+00,.785E-03,.864E-01,.130 ,.170 ,
1454 + .182 ,.172 ,.208 /
1455 DATA (A(I, 7,12),I=1,10) /
1456 + .000E+00,.000E+00,.000E+00,.896E-05,.225E-01,.105 ,.126 ,
1457 + .126 ,.135 ,.116 /
1458 DATA (A(I, 7,13),I=1,10) /
1459 + .000E+00,.000E+00,.000E+00,.000E+00,.542E-03,.427E-01,.553E-01,
1460 + .744E-01,.980E-01,.103 /
1461 DATA (A(I, 7,14),I=1,10) /
1462 + .000E+00,.000E+00,.000E+00,.000E+00,.515E-05,.377E-01,.831E-01,
1463 + .985E-01,.104 ,.108 /
1464 DATA (A(I, 7,15),I=1,10) /
1465 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.285E-02,.495E-01,
1466 + .871E-01,.106 ,.119 /
1467 DATA (A(I, 7,16),I=1,10) /
1468 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.110E-05,.284E-01,
1469 + .588E-01,.657E-01,.594E-01 /
1470 DATA (A(I, 7,17),I=1,10) /
1471 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.722E-07,.176E-02,
1472 + .170E-01,.305E-01,.454E-01 /
1473 DATA (A(I, 7,18),I=1,10) /
1474 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.148E-05,
1475 + .213E-01,.492E-01,.707E-01 /
1476 DATA (A(I, 7,19),I=1,10) /
1477 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.323E-07,
1478 + .722E-02,.359E-01,.556E-01 /
1479 DATA (A(I, 7,20),I=1,10) /
1480 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,
1481 + .461E-05,.155E-01,.679E-01 /
1482 DATA (A(I, 8, 1),I=1,10) /
1483 + .630 ,.974 ,1.29 ,1.58 ,1.89 ,2.16 ,2.49 ,
1484 + 2.75 ,3.02 ,3.95 /
1485 DATA (A(I, 8, 2),I=1,10) /
1486 + .328 ,.459 ,.613 ,.735 ,.879 ,.994 ,1.15 ,
1487 + 1.27 ,1.38 ,1.80 /
1488 DATA (A(I, 8, 3),I=1,10) /
1489 + .748E-01,.121 ,.164 ,.197 ,.235 ,.265 ,.310 ,
1490 + .339 ,.370 ,.658 /
1491 DATA (A(I, 8, 4),I=1,10) /
1492 + .194 ,.211 ,.337 ,.344 ,.339 ,.351 ,.390 ,
1493 + .419 ,.442 ,1.55 /
1494 DATA (A(I, 8, 5),I=1,10) /
1495 + .000E+00,.869E-01,.725E-01,.113 ,.810E-01,.106 ,.951E-01,
1496 + .120 ,.143 ,.681 /
1497 DATA (A(I, 8, 6),I=1,10) /
1498 + .000E+00,.288E-01,.102 ,.922E-01,.857E-01,.845E-01,.932E-01,
1499 + .983E-01,.102 ,.409 /
1500 DATA (A(I, 8, 7),I=1,10) /
1501 + .000E+00,.668E-03,.533E-01,.575E-01,.493E-01,.482E-01,.539E-01,
1502 + .558E-01,.582E-01,.256 /
1503 DATA (A(I, 8, 8),I=1,10) /
1504 + .000E+00,.000E+00,.205E-01,.808E-01,.510E-01,.409E-01,.406E-01,
1505 + .394E-01,.389E-01,.167 /
1506 DATA (A(I, 8, 9),I=1,10) /
1507 + .000E+00,.000E+00,.999E-04,.647E-01,.385E-01,.325E-01,.325E-01,
1508 + .316E-01,.314E-01,.122 /
1509 DATA (A(I, 8,10),I=1,10) /
1510 + .000E+00,.000E+00,.000E+00,.169E-01,.834E-01,.611E-01,.565E-01,
1511 + .533E-01,.519E-01,.176 /
1512 DATA (A(I, 8,11),I=1,10) /
1513 + .000E+00,.000E+00,.000E+00,.107E-03,.769E-01,.922E-01,.805E-01,
1514 + .745E-01,.711E-01,.208 /
1515 DATA (A(I, 8,12),I=1,10) /
1516 + .000E+00,.000E+00,.000E+00,.180E-05,.143E-01,.983E-01,.775E-01,
1517 + .627E-01,.541E-01,.116 /
1518 DATA (A(I, 8,13),I=1,10) /
1519 + .000E+00,.000E+00,.000E+00,.000E+00,.157E-04,.346E-01,.507E-01,
1520 + .479E-01,.455E-01,.103 /
1521 DATA (A(I, 8,14),I=1,10) /
1522 + .000E+00,.000E+00,.000E+00,.000E+00,.752E-06,.248E-01,.721E-01,
1523 + .728E-01,.611E-01,.108 /
1524 DATA (A(I, 8,15),I=1,10) /
1525 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.686E-04,.356E-01,
1526 + .731E-01,.791E-01,.119 /
1527 DATA (A(I, 8,16),I=1,10) /
1528 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.838E-07,.151E-01,
1529 + .470E-01,.567E-01,.594E-01 /
1530 DATA (A(I, 8,17),I=1,10) /
1531 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.759E-08,.400E-04,
1532 + .193E-01,.313E-01,.454E-01 /
1533 DATA (A(I, 8,18),I=1,10) /
1534 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.385E-07,
1535 + .921E-02,.353E-01,.707E-01 /
1536 DATA (A(I, 8,19),I=1,10) /
1537 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.219E-08,
1538 + .348E-03,.226E-01,.556E-01 /
1539 DATA (A(I, 8,20),I=1,10) /
1540 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,
1541 + .212E-07,.149E-01,.679E-01 /
1542 DATA (A(I, 9, 1),I=1,10) /
1543 + .736 ,1.13 ,1.49 ,1.82 ,2.20 ,2.49 ,2.86 ,
1544 + 3.17 ,3.49 ,3.95 /
1545 DATA (A(I, 9, 2),I=1,10) /
1546 + .339 ,.492 ,.658 ,.789 ,.958 ,1.08 ,1.25 ,
1547 + 1.37 ,1.50 ,1.80 /
1548 DATA (A(I, 9, 3),I=1,10) /
1549 + .680E-01,.110 ,.150 ,.180 ,.222 ,.247 ,.289 ,
1550 + .318 ,.349 ,.658 /
1551 DATA (A(I, 9, 4),I=1,10) /
1552 + .110 ,.104 ,.157 ,.156 ,.210 ,.205 ,.246 ,
1553 + .274 ,.300 ,1.55 /
1554 DATA (A(I, 9, 5),I=1,10) /
1555 + .000E+00,.379E-01,.347E-01,.477E-01,.486E-01,.576E-01,.569E-01,
1556 + .732E-01,.893E-01,.681 /
1557 DATA (A(I, 9, 6),I=1,10) /
1558 + .000E+00,.223E-01,.354E-01,.312E-01,.436E-01,.400E-01,.489E-01,
1559 + .548E-01,.600E-01,.409 /
1560 DATA (A(I, 9, 7),I=1,10) /
1561 + .000E+00,.338E-03,.149E-01,.142E-01,.215E-01,.188E-01,.248E-01,
1562 + .278E-01,.307E-01,.256 /
1563 DATA (A(I, 9, 8),I=1,10) /
1564 + .000E+00,.000E+00,.553E-02,.862E-02,.150E-01,.106E-01,.145E-01,
1565 + .165E-01,.181E-01,.167 /
1566 DATA (A(I, 9, 9),I=1,10) /
1567 + .000E+00,.000E+00,.375E-04,.641E-02,.111E-01,.792E-02,.112E-01,
1568 + .127E-01,.140E-01,.122 /
1569 DATA (A(I, 9,10),I=1,10) /
1570 + .000E+00,.000E+00,.000E+00,.112E-01,.200E-01,.127E-01,.176E-01,
1571 + .200E-01,.220E-01,.176 /
1572 DATA (A(I, 9,11),I=1,10) /
1573 + .000E+00,.000E+00,.000E+00,.244E-04,.261E-01,.162E-01,.232E-01,
1574 + .263E-01,.287E-01,.208 /
1575 DATA (A(I, 9,12),I=1,10) /
1576 + .000E+00,.000E+00,.000E+00,.455E-06,.635E-02,.121E-01,.186E-01,
1577 + .201E-01,.207E-01,.116 /
1578 DATA (A(I, 9,13),I=1,10) /
1579 + .000E+00,.000E+00,.000E+00,.000E+00,.146E-05,.922E-02,.116E-01,
1580 + .145E-01,.165E-01,.103 /
1581 DATA (A(I, 9,14),I=1,10) /
1582 + .000E+00,.000E+00,.000E+00,.000E+00,.135E-06,.128E-01,.202E-01,
1583 + .215E-01,.220E-01,.108 /
1584 DATA (A(I, 9,15),I=1,10) /
1585 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.237E-05,.229E-01,
1586 + .259E-01,.271E-01,.119 /
1587 DATA (A(I, 9,16),I=1,10) /
1588 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.100E-07,.534E-02,
1589 + .210E-01,.193E-01,.594E-01 /
1590 DATA (A(I, 9,17),I=1,10) /
1591 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.915E-09,.847E-06,
1592 + .119E-01,.125E-01,.454E-01 /
1593 DATA (A(I, 9,18),I=1,10) /
1594 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.298E-08,
1595 + .101E-01,.242E-01,.707E-01 /
1596 DATA (A(I, 9,19),I=1,10) /
1597 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.196E-09,
1598 + .243E-05,.234E-01,.556E-01 /
1599 DATA (A(I, 9,20),I=1,10) /
1600 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,
1601 + .575E-09,.364E-02,.679E-01 /
1602 DATA (A(I,10, 1),I=1,10) /
1603 + .959 ,1.46 ,1.92 ,2.34 ,2.80 ,3.24 ,3.64 ,
1604 + 4.05 ,4.48 ,3.95 /
1605 DATA (A(I,10, 2),I=1,10) /
1606 + .343 ,.516 ,.692 ,.836 ,1.01 ,1.16 ,1.31 ,
1607 + 1.46 ,1.61 ,1.80 /
1608 DATA (A(I,10, 3),I=1,10) /
1609 + .512E-01,.837E-01,.115 ,.138 ,.169 ,.195 ,.220 ,
1610 + .245 ,.270 ,.658 /
1611 DATA (A(I,10, 4),I=1,10) /
1612 + .274E-01,.361E-01,.510E-01,.562E-01,.703E-01,.828E-01,.877E-01,
1613 + .996E-01,.111 ,1.55 /
1614 DATA (A(I,10, 5),I=1,10) /
1615 + .000E+00,.850E-02,.875E-02,.118E-01,.124E-01,.170E-01,.154E-01,
1616 + .194E-01,.237E-01,.681 /
1617 DATA (A(I,10, 6),I=1,10) /
1618 + .000E+00,.345E-02,.519E-02,.533E-02,.691E-02,.842E-02,.844E-02,
1619 + .987E-02,.113E-01,.409 /
1620 DATA (A(I,10, 7),I=1,10) /
1621 + .000E+00,.722E-04,.130E-02,.135E-02,.189E-02,.240E-02,.235E-02,
1622 + .281E-02,.331E-02,.256 /
1623 DATA (A(I,10, 8),I=1,10) /
1624 + .000E+00,.000E+00,.283E-03,.272E-03,.394E-03,.557E-03,.480E-03,
1625 + .616E-03,.775E-03,.167 /
1626 DATA (A(I,10, 9),I=1,10) /
1627 + .000E+00,.000E+00,.457E-05,.122E-03,.192E-03,.275E-03,.225E-03,
1628 + .292E-03,.373E-03,.122 /
1629 DATA (A(I,10,10),I=1,10) /
1630 + .000E+00,.000E+00,.000E+00,.119E-03,.185E-03,.278E-03,.201E-03,
1631 + .274E-03,.364E-03,.176 /
1632 DATA (A(I,10,11),I=1,10) /
1633 + .000E+00,.000E+00,.000E+00,.140E-05,.129E-03,.200E-03,.137E-03,
1634 + .188E-03,.252E-03,.208 /
1635 DATA (A(I,10,12),I=1,10) /
1636 + .000E+00,.000E+00,.000E+00,.207E-07,.307E-04,.518E-04,.278E-04,
1637 + .421E-04,.608E-04,.116 /
1638 DATA (A(I,10,13),I=1,10) /
1639 + .000E+00,.000E+00,.000E+00,.000E+00,.306E-07,.252E-04,.111E-04,
1640 + .188E-04,.295E-04,.103 /
1641 DATA (A(I,10,14),I=1,10) /
1642 + .000E+00,.000E+00,.000E+00,.000E+00,.321E-08,.220E-04,.104E-04,
1643 + .162E-04,.243E-04,.108 /
1644 DATA (A(I,10,15),I=1,10) /
1645 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.770E-08,.632E-05,
1646 + .105E-04,.162E-04,.119 /
1647 DATA (A(I,10,16),I=1,10) /
1648 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.117E-09,.199E-05,
1649 + .321E-05,.492E-05,.594E-01 /
1650 DATA (A(I,10,17),I=1,10) /
1651 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.888E-11,.323E-09,
1652 + .106E-05,.192E-05,.454E-01 /
1653 DATA (A(I,10,18),I=1,10) /
1654 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.174E-10,
1655 + .131E-05,.218E-05,.707E-01 /
1656 DATA (A(I,10,19),I=1,10) /
1657 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.994E-12,
1658 + .233E-09,.104E-05,.556E-01 /
1659 DATA (A(I,10,20),I=1,10) /
1660 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,
1661 + .144E-11,.724E-06,.679E-01 /
1662 DATA (AE(I, 1, 1),I=1,10) /
1663 + 7.27 ,6.29 ,7.76 ,6.70 ,8.17 ,7.34 ,8.70 ,
1664 + 8.02 ,7.37 ,6.18 /
1665 DATA (AE(I, 1, 2),I=1,10) /
1666 + 7.41 ,7.52 ,8.14 ,8.20 ,8.96 ,9.05 ,9.96 ,
1667 + 10.0 ,10.1 ,9.86 /
1668 DATA (AE(I, 1, 3),I=1,10) /
1669 + 7.72 ,7.69 ,9.17 ,8.99 ,10.6 ,10.5 ,12.1 ,
1670 + 12.1 ,12.0 ,11.5 /
1671 DATA (AE(I, 1, 4),I=1,10) /
1672 + 7.90 ,8.48 ,9.50 ,9.94 ,10.8 ,11.4 ,12.2 ,
1673 + 12.8 ,13.3 ,13.8 /
1674 DATA (AE(I, 1, 5),I=1,10) /
1675 + .000E+00,8.52 ,9.59 ,10.1 ,11.1 ,11.8 ,12.7 ,
1676 + 13.3 ,13.8 ,14.4 /
1677 DATA (AE(I, 1, 6),I=1,10) /
1678 + .000E+00,9.00 ,10.7 ,11.7 ,13.2 ,14.2 ,15.6 ,
1679 + 16.5 ,17.3 ,18.0 /
1680 DATA (AE(I, 1, 7),I=1,10) /
1681 + .000E+00,9.01 ,11.1 ,11.9 ,14.3 ,15.0 ,17.4 ,
1682 + 18.0 ,18.6 ,18.8 /
1683 DATA (AE(I, 1, 8),I=1,10) /
1684 + .000E+00,.000E+00,11.2 ,12.4 ,14.5 ,15.7 ,17.6 ,
1685 + 18.8 ,19.9 ,20.9 /
1686 DATA (AE(I, 1, 9),I=1,10) /
1687 + .000E+00,.000E+00,11.4 ,12.7 ,15.5 ,16.6 ,19.3 ,
1688 + 20.2 ,21.1 ,21.7 /
1689 DATA (AE(I, 1,10),I=1,10) /
1690 + .000E+00,.000E+00,.000E+00,13.2 ,15.8 ,17.3 ,19.9 ,
1691 + 21.2 ,22.4 ,23.2 /
1692 DATA (AE(I, 1,11),I=1,10) /
1693 + .000E+00,.000E+00,.000E+00,13.2 ,16.3 ,17.8 ,20.8 ,
1694 + 22.1 ,23.3 ,24.2 /
1695 DATA (AE(I, 1,12),I=1,10) /
1696 + .000E+00,.000E+00,.000E+00,13.4 ,16.2 ,18.2 ,21.0 ,
1697 + 22.8 ,24.4 ,25.9 /
1698 DATA (AE(I, 1,13),I=1,10) /
1699 + .000E+00,.000E+00,.000E+00,.000E+00,16.5 ,18.4 ,21.6 ,
1700 + 23.2 ,24.8 ,26.2 /
1701 DATA (AE(I, 1,14),I=1,10) /
1702 + .000E+00,.000E+00,.000E+00,.000E+00,16.7 ,19.0 ,22.3 ,
1703 + 24.3 ,26.1 ,27.4 /
1704 DATA (AE(I, 1,15),I=1,10) /
1705 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,19.1 ,22.8 ,
1706 + 24.7 ,26.6 ,28.2 /
1707 DATA (AE(I, 1,16),I=1,10) /
1708 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,19.2 ,23.0 ,
1709 + 25.3 ,27.5 ,29.5 /
1710 DATA (AE(I, 1,17),I=1,10) /
1711 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,19.6 ,23.3 ,
1712 + 25.6 ,27.8 ,29.6 /
1713 DATA (AE(I, 1,18),I=1,10) /
1714 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,23.6 ,
1715 + 26.2 ,28.5 ,30.4 /
1716 DATA (AE(I, 1,19),I=1,10) /
1717 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,23.7 ,
1718 + 26.3 ,28.8 ,31.0 /
1719 DATA (AE(I, 1,20),I=1,10) /
1720 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,
1721 + 26.5 ,29.2 ,31.5 /
1722 DATA (AE(I, 2, 1),I=1,10) /
1723 + 8.74 ,8.16 ,9.25 ,8.45 ,9.46 ,8.90 ,9.83 ,
1724 + 9.38 ,8.96 ,8.15 /
1725 DATA (AE(I, 2, 2),I=1,10) /
1726 + 8.96 ,9.30 ,9.95 ,10.0 ,10.8 ,10.9 ,11.7 ,
1727 + 11.8 ,11.9 ,11.8 /
1728 DATA (AE(I, 2, 3),I=1,10) /
1729 + 9.44 ,9.66 ,11.0 ,11.0 ,12.3 ,12.5 ,13.7 ,
1730 + 13.9 ,14.0 ,13.8 /
1731 DATA (AE(I, 2, 4),I=1,10) /
1732 + 8.86 ,9.81 ,10.8 ,11.2 ,12.0 ,12.6 ,13.4 ,
1733 + 14.0 ,14.5 ,15.1 /
1734 DATA (AE(I, 2, 5),I=1,10) /
1735 + .000E+00,10.2 ,11.4 ,12.0 ,12.9 ,13.6 ,14.5 ,
1736 + 15.1 ,15.7 ,16.3 /
1737 DATA (AE(I, 2, 6),I=1,10) /
1738 + .000E+00,10.7 ,12.5 ,13.5 ,15.1 ,16.0 ,17.5 ,
1739 + 18.3 ,19.2 ,19.9 /
1740 DATA (AE(I, 2, 7),I=1,10) /
1741 + .000E+00,11.5 ,12.9 ,13.9 ,16.1 ,17.0 ,19.1 ,
1742 + 19.8 ,20.6 ,21.0 /
1743 DATA (AE(I, 2, 8),I=1,10) /
1744 + .000E+00,.000E+00,12.4 ,13.8 ,15.9 ,17.2 ,19.1 ,
1745 + 20.3 ,21.4 ,22.3 /
1746 DATA (AE(I, 2, 9),I=1,10) /
1747 + .000E+00,.000E+00,13.4 ,14.5 ,17.1 ,18.3 ,20.9 ,
1748 + 21.9 ,23.0 ,23.7 /
1749 DATA (AE(I, 2,10),I=1,10) /
1750 + .000E+00,.000E+00,.000E+00,14.9 ,17.5 ,19.1 ,21.6 ,
1751 + 22.9 ,24.1 ,25.0 /
1752 DATA (AE(I, 2,11),I=1,10) /
1753 + .000E+00,.000E+00,.000E+00,15.0 ,18.0 ,19.6 ,22.4 ,
1754 + 23.8 ,25.2 ,26.2 /
1755 DATA (AE(I, 2,12),I=1,10) /
1756 + .000E+00,.000E+00,.000E+00,16.2 ,17.3 ,19.4 ,22.2 ,
1757 + 24.0 ,25.7 ,27.2 /
1758 DATA (AE(I, 2,13),I=1,10) /
1759 + .000E+00,.000E+00,.000E+00,.000E+00,17.8 ,19.8 ,22.9 ,
1760 + 24.6 ,26.2 ,27.7 /
1761 DATA (AE(I, 2,14),I=1,10) /
1762 + .000E+00,.000E+00,.000E+00,.000E+00,19.1 ,20.4 ,23.7 ,
1763 + 25.7 ,27.6 ,29.1 /
1764 DATA (AE(I, 2,15),I=1,10) /
1765 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,20.5 ,24.1 ,
1766 + 26.1 ,28.1 ,29.9 /
1767 DATA (AE(I, 2,16),I=1,10) /
1768 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,20.9 ,23.9 ,
1769 + 26.4 ,28.7 ,30.7 /
1770 DATA (AE(I, 2,17),I=1,10) /
1771 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,22.4 ,24.2 ,
1772 + 26.7 ,29.0 ,30.9 /
1773 DATA (AE(I, 2,18),I=1,10) /
1774 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,24.8 ,
1775 + 27.3 ,29.7 ,31.8 /
1776 DATA (AE(I, 2,19),I=1,10) /
1777 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,26.1 ,
1778 + 27.3 ,29.9 ,32.3 /
1779 DATA (AE(I, 2,20),I=1,10) /
1780 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,
1781 + 27.4 ,30.1 ,32.6 /
1782 DATA (AE(I, 3, 1),I=1,10) /
1783 + 11.0 ,11.0 ,11.7 ,11.3 ,11.9 ,11.4 ,12.1 ,
1784 + 11.7 ,11.5 ,11.0 /
1785 DATA (AE(I, 3, 2),I=1,10) /
1786 + 11.2 ,12.0 ,12.7 ,12.9 ,13.6 ,13.7 ,14.4 ,
1787 + 14.6 ,14.7 ,14.6 /
1788 DATA (AE(I, 3, 3),I=1,10) /
1789 + 12.1 ,12.6 ,13.7 ,13.9 ,15.0 ,15.2 ,16.3 ,
1790 + 16.5 ,16.7 ,16.7 /
1791 DATA (AE(I, 3, 4),I=1,10) /
1792 + 12.6 ,11.3 ,12.4 ,13.0 ,13.8 ,14.2 ,15.0 ,
1793 + 15.6 ,16.1 ,16.6 /
1794 DATA (AE(I, 3, 5),I=1,10) /
1795 + .000E+00,12.6 ,13.7 ,14.4 ,15.3 ,16.0 ,16.8 ,
1796 + 17.5 ,18.1 ,18.6 /
1797 DATA (AE(I, 3, 6),I=1,10) /
1798 + .000E+00,14.0 ,14.6 ,15.8 ,17.4 ,18.4 ,19.8 ,
1799 + 20.6 ,21.5 ,22.2 /
1800 DATA (AE(I, 3, 7),I=1,10) /
1801 + .000E+00,16.0 ,15.2 ,16.3 ,18.3 ,19.3 ,21.1 ,
1802 + 22.0 ,22.8 ,23.5 /
1803 DATA (AE(I, 3, 8),I=1,10) /
1804 + .000E+00,.000E+00,15.6 ,15.1 ,17.2 ,18.6 ,20.6 ,
1805 + 21.8 ,22.9 ,23.8 /
1806 DATA (AE(I, 3, 9),I=1,10) /
1807 + .000E+00,.000E+00,17.8 ,16.3 ,18.8 ,20.1 ,22.5 ,
1808 + 23.6 ,24.7 ,25.6 /
1809 DATA (AE(I, 3,10),I=1,10) /
1810 + .000E+00,.000E+00,.000E+00,17.5 ,19.0 ,20.7 ,23.1 ,
1811 + 24.5 ,25.8 ,26.8 /
1812 DATA (AE(I, 3,11),I=1,10) /
1813 + .000E+00,.000E+00,.000E+00,19.2 ,19.4 ,21.1 ,23.8 ,
1814 + 25.4 ,26.8 ,28.0 /
1815 DATA (AE(I, 3,12),I=1,10) /
1816 + .000E+00,.000E+00,.000E+00,20.7 ,19.6 ,19.7 ,22.4 ,
1817 + 24.4 ,26.2 ,27.9 /
1818 DATA (AE(I, 3,13),I=1,10) /
1819 + .000E+00,.000E+00,.000E+00,.000E+00,21.6 ,20.4 ,23.2 ,
1820 + 25.1 ,26.9 ,28.5 /
1821 DATA (AE(I, 3,14),I=1,10) /
1822 + .000E+00,.000E+00,.000E+00,.000E+00,23.5 ,22.0 ,23.8 ,
1823 + 26.1 ,28.1 ,29.9 /
1824 DATA (AE(I, 3,15),I=1,10) /
1825 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,23.7 ,24.2 ,
1826 + 26.3 ,28.5 ,30.4 /
1827 DATA (AE(I, 3,16),I=1,10) /
1828 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,25.4 ,24.8 ,
1829 + 25.6 ,28.1 ,30.5 /
1830 DATA (AE(I, 3,17),I=1,10) /
1831 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,26.9 ,26.8 ,
1832 + 26.1 ,28.4 ,30.8 /
1833 DATA (AE(I, 3,18),I=1,10) /
1834 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,28.8 ,
1835 + 27.6 ,29.0 ,31.5 /
1836 DATA (AE(I, 3,19),I=1,10) /
1837 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,30.5 ,
1838 + 29.2 ,28.9 ,31.5 /
1839 DATA (AE(I, 3,20),I=1,10) /
1840 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,
1841 + 31.0 ,30.0 ,31.7 /
1842 DATA (AE(I, 4, 1),I=1,10) /
1843 + 13.0 ,13.2 ,14.8 ,14.2 ,14.2 ,14.1 ,14.5 ,
1844 + 14.4 ,14.3 ,14.0 /
1845 DATA (AE(I, 4, 2),I=1,10) /
1846 + 13.5 ,14.5 ,16.1 ,15.9 ,16.0 ,16.3 ,16.8 ,
1847 + 17.0 ,17.1 ,17.2 /
1848 DATA (AE(I, 4, 3),I=1,10) /
1849 + 14.9 ,15.3 ,17.2 ,17.1 ,17.5 ,17.8 ,18.6 ,
1850 + 18.9 ,19.1 ,19.3 /
1851 DATA (AE(I, 4, 4),I=1,10) /
1852 + 15.1 ,13.5 ,16.4 ,16.7 ,16.4 ,17.3 ,17.8 ,
1853 + 18.5 ,19.0 ,19.6 /
1854 DATA (AE(I, 4, 5),I=1,10) /
1855 + .000E+00,15.6 ,17.5 ,17.7 ,17.8 ,18.6 ,19.2 ,
1856 + 19.9 ,20.3 ,21.1 /
1857 DATA (AE(I, 4, 6),I=1,10) /
1858 + .000E+00,18.0 ,18.4 ,19.2 ,19.8 ,20.9 ,22.0 ,
1859 + 23.1 ,23.6 ,24.7 /
1860 DATA (AE(I, 4, 7),I=1,10) /
1861 + .000E+00,27.4 ,19.1 ,19.8 ,20.7 ,21.8 ,23.2 ,
1862 + 24.4 ,24.9 ,25.9 /
1863 DATA (AE(I, 4, 8),I=1,10) /
1864 + .000E+00,.000E+00,18.9 ,18.9 ,19.3 ,21.1 ,22.5 ,
1865 + 24.0 ,24.7 ,26.0 /
1866 DATA (AE(I, 4, 9),I=1,10) /
1867 + .000E+00,.000E+00,21.1 ,19.7 ,20.7 ,22.3 ,24.0 ,
1868 + 25.6 ,26.3 ,27.7 /
1869 DATA (AE(I, 4,10),I=1,10) /
1870 + .000E+00,.000E+00,.000E+00,21.0 ,21.1 ,22.9 ,24.6 ,
1871 + 26.5 ,27.3 ,29.0 /
1872 DATA (AE(I, 4,11),I=1,10) /
1873 + .000E+00,.000E+00,.000E+00,21.3 ,22.4 ,23.1 ,25.0 ,
1874 + 27.1 ,27.9 ,29.8 /
1875 DATA (AE(I, 4,12),I=1,10) /
1876 + .000E+00,.000E+00,.000E+00,36.6 ,21.5 ,22.2 ,23.1 ,
1877 + 25.6 ,26.8 ,29.1 /
1878 DATA (AE(I, 4,13),I=1,10) /
1879 + .000E+00,.000E+00,.000E+00,.000E+00,22.9 ,23.1 ,23.7 ,
1880 + 26.2 ,27.3 ,29.6 /
1881 DATA (AE(I, 4,14),I=1,10) /
1882 + .000E+00,.000E+00,.000E+00,.000E+00,30.5 ,23.6 ,25.0 ,
1883 + 26.9 ,28.2 ,30.7 /
1884 DATA (AE(I, 4,15),I=1,10) /
1885 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,25.4 ,26.2 ,
1886 + 27.2 ,28.3 ,31.0 /
1887 DATA (AE(I, 4,16),I=1,10) /
1888 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,24.5 ,25.9 ,
1889 + 27.4 ,27.6 ,30.7 /
1890 DATA (AE(I, 4,17),I=1,10) /
1891 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,43.3 ,28.4 ,
1892 + 27.5 ,27.9 ,30.9 /
1893 DATA (AE(I, 4,18),I=1,10) /
1894 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,27.2 ,
1895 + 29.1 ,29.0 ,31.4 /
1896 DATA (AE(I, 4,19),I=1,10) /
1897 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,51.3 ,
1898 + 30.6 ,29.5 ,31.4 /
1899 DATA (AE(I, 4,20),I=1,10) /
1900 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,
1901 + 28.8 ,30.6 ,32.4 /
1902 DATA (AE(I, 5, 1),I=1,10) /
1903 + 15.0 ,14.9 ,15.5 ,15.4 ,15.9 ,15.8 ,16.2 ,
1904 + 16.2 ,16.1 ,15.9 /
1905 DATA (AE(I, 5, 2),I=1,10) /
1906 + 15.4 ,16.1 ,17.0 ,17.4 ,18.0 ,18.2 ,18.7 ,
1907 + 18.9 ,19.0 ,19.1 /
1908 DATA (AE(I, 5, 3),I=1,10) /
1909 + 17.1 ,17.2 ,18.3 ,18.7 ,19.3 ,19.6 ,20.3 ,
1910 + 20.6 ,20.8 ,20.9 /
1911 DATA (AE(I, 5, 4),I=1,10) /
1912 + 14.7 ,14.8 ,15.0 ,16.0 ,17.0 ,17.7 ,18.1 ,
1913 + 19.0 ,19.4 ,20.0 /
1914 DATA (AE(I, 5, 5),I=1,10) /
1915 + .000E+00,16.7 ,17.6 ,18.1 ,18.6 ,19.2 ,19.7 ,
1916 + 20.4 ,20.8 ,21.2 /
1917 DATA (AE(I, 5, 6),I=1,10) /
1918 + .000E+00,17.8 ,18.2 ,19.2 ,20.0 ,21.0 ,21.9 ,
1919 + 23.0 ,23.6 ,24.3 /
1920 DATA (AE(I, 5, 7),I=1,10) /
1921 + .000E+00,35.2 ,18.9 ,20.3 ,20.6 ,21.5 ,22.6 ,
1922 + 23.7 ,24.2 ,24.7 /
1923 DATA (AE(I, 5, 8),I=1,10) /
1924 + .000E+00,.000E+00,16.4 ,18.9 ,18.8 ,19.6 ,20.7 ,
1925 + 22.3 ,23.1 ,23.9 /
1926 DATA (AE(I, 5, 9),I=1,10) /
1927 + .000E+00,.000E+00,33.9 ,19.8 ,20.3 ,20.7 ,21.9 ,
1928 + 23.4 ,24.1 ,24.8 /
1929 DATA (AE(I, 5,10),I=1,10) /
1930 + .000E+00,.000E+00,.000E+00,18.0 ,20.0 ,21.4 ,22.0 ,
1931 + 23.8 ,24.6 ,25.4 /
1932 DATA (AE(I, 5,11),I=1,10) /
1933 + .000E+00,.000E+00,.000E+00,26.4 ,20.4 ,21.2 ,22.3 ,
1934 + 23.8 ,24.7 ,25.5 /
1935 DATA (AE(I, 5,12),I=1,10) /
1936 + .000E+00,.000E+00,.000E+00,41.7 ,18.2 ,19.8 ,21.1 ,
1937 + 22.6 ,23.4 ,24.6 /
1938 DATA (AE(I, 5,13),I=1,10) /
1939 + .000E+00,.000E+00,.000E+00,.000E+00,22.5 ,20.0 ,21.7 ,
1940 + 22.8 ,23.7 ,24.7 /
1941 DATA (AE(I, 5,14),I=1,10) /
1942 + .000E+00,.000E+00,.000E+00,.000E+00,54.1 ,19.9 ,21.9 ,
1943 + 23.2 ,24.3 ,25.3 /
1944 DATA (AE(I, 5,15),I=1,10) /
1945 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,21.2 ,22.2 ,
1946 + 23.6 ,24.9 ,25.5 /
1947 DATA (AE(I, 5,16),I=1,10) /
1948 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,44.9 ,21.9 ,
1949 + 23.8 ,25.2 ,25.6 /
1950 DATA (AE(I, 5,17),I=1,10) /
1951 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,47.8 ,22.7 ,
1952 + 23.8 ,24.9 ,26.3 /
1953 DATA (AE(I, 5,18),I=1,10) /
1954 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,35.5 ,
1955 + 23.9 ,25.9 ,26.6 /
1956 DATA (AE(I, 5,19),I=1,10) /
1957 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,64.3 ,
1958 + 24.1 ,25.7 ,27.1 /
1959 DATA (AE(I, 5,20),I=1,10) /
1960 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,
1961 + 34.0 ,25.7 ,27.7 /
1962 DATA (AE(I, 6, 1),I=1,10) /
1963 + 16.6 ,16.5 ,16.8 ,16.7 ,17.0 ,16.5 ,16.7 ,
1964 + 18.3 ,18.9 ,19.0 /
1965 DATA (AE(I, 6, 2),I=1,10) /
1966 + 16.2 ,16.6 ,17.2 ,17.4 ,17.9 ,17.4 ,17.7 ,
1967 + 20.7 ,22.0 ,22.6 /
1968 DATA (AE(I, 6, 3),I=1,10) /
1969 + 18.9 ,18.7 ,18.8 ,18.6 ,18.9 ,18.6 ,18.9 ,
1970 + 21.0 ,22.3 ,22.9 /
1971 DATA (AE(I, 6, 4),I=1,10) /
1972 + 18.3 ,12.7 ,14.2 ,15.0 ,15.7 ,16.1 ,16.3 ,
1973 + 16.5 ,17.9 ,19.0 /
1974 DATA (AE(I, 6, 5),I=1,10) /
1975 + .000E+00,15.7 ,15.1 ,15.3 ,16.5 ,16.4 ,16.4 ,
1976 + 17.0 ,18.3 ,19.4 /
1977 DATA (AE(I, 6, 6),I=1,10) /
1978 + .000E+00,22.9 ,14.9 ,15.2 ,16.2 ,16.9 ,17.4 ,
1979 + 18.2 ,19.5 ,21.1 /
1980 DATA (AE(I, 6, 7),I=1,10) /
1981 + .000E+00,40.7 ,18.4 ,15.9 ,17.1 ,17.7 ,18.9 ,
1982 + 19.5 ,20.3 ,21.1 /
1983 DATA (AE(I, 6, 8),I=1,10) /
1984 + .000E+00,.000E+00,23.3 ,16.2 ,16.3 ,17.3 ,18.7 ,
1985 + 19.5 ,20.3 ,21.1 /
1986 DATA (AE(I, 6, 9),I=1,10) /
1987 + .000E+00,.000E+00,49.2 ,19.0 ,19.1 ,19.4 ,20.2 ,
1988 + 20.8 ,21.6 ,22.0 /
1989 DATA (AE(I, 6,10),I=1,10) /
1990 + .000E+00,.000E+00,.000E+00,27.2 ,21.2 ,20.8 ,21.4 ,
1991 + 22.3 ,22.8 ,23.3 /
1992 DATA (AE(I, 6,11),I=1,10) /
1993 + .000E+00,.000E+00,.000E+00,45.6 ,25.0 ,22.8 ,23.9 ,
1994 + 23.6 ,24.3 ,24.4 /
1995 DATA (AE(I, 6,12),I=1,10) /
1996 + .000E+00,.000E+00,.000E+00,45.8 ,29.7 ,25.1 ,25.3 ,
1997 + 25.3 ,26.0 ,26.3 /
1998 DATA (AE(I, 6,13),I=1,10) /
1999 + .000E+00,.000E+00,.000E+00,.000E+00,42.7 ,29.0 ,28.0 ,
2000 + 27.0 ,27.2 ,27.6 /
2001 DATA (AE(I, 6,14),I=1,10) /
2002 + .000E+00,.000E+00,.000E+00,.000E+00,62.0 ,32.0 ,30.0 ,
2003 + 29.8 ,29.5 ,29.6 /
2004 DATA (AE(I, 6,15),I=1,10) /
2005 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,44.5 ,34.4 ,
2006 + 32.7 ,31.5 ,31.8 /
2007 DATA (AE(I, 6,16),I=1,10) /
2008 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,75.6 ,37.1 ,
2009 + 34.6 ,34.4 ,34.4 /
2010 DATA (AE(I, 6,17),I=1,10) /
2011 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,51.2 ,45.2 ,
2012 + 39.0 ,37.5 ,36.4 /
2013 DATA (AE(I, 6,18),I=1,10) /
2014 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,74.9 ,
2015 + 42.3 ,39.9 ,38.3 /
2016 DATA (AE(I, 6,19),I=1,10) /
2017 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,69.5 ,
2018 + 50.7 ,42.3 ,41.4 /
2019 DATA (AE(I, 6,20),I=1,10) /
2020 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,
2021 + 66.3 ,48.0 ,43.4 /
2022 DATA (AE(I, 7, 1),I=1,10) /
2023 + 27.0 ,25.8 ,26.3 ,26.2 ,26.7 ,26.7 ,27.1 ,
2024 + 27.1 ,27.2 ,19.0 /
2025 DATA (AE(I, 7, 2),I=1,10) /
2026 + 29.1 ,28.9 ,29.7 ,30.3 ,31.0 ,31.4 ,32.0 ,
2027 + 32.3 ,32.7 ,22.6 /
2028 DATA (AE(I, 7, 3),I=1,10) /
2029 + 31.6 ,29.7 ,30.9 ,31.4 ,32.5 ,33.1 ,34.0 ,
2030 + 34.6 ,35.1 ,22.9 /
2031 DATA (AE(I, 7, 4),I=1,10) /
2032 + 27.4 ,19.9 ,20.8 ,22.8 ,24.6 ,26.4 ,28.2 ,
2033 + 29.6 ,30.8 ,19.0 /
2034 DATA (AE(I, 7, 5),I=1,10) /
2035 + .000E+00,24.6 ,24.1 ,25.0 ,27.2 ,28.7 ,30.7 ,
2036 + 31.8 ,32.9 ,19.4 /
2037 DATA (AE(I, 7, 6),I=1,10) /
2038 + .000E+00,35.6 ,25.2 ,25.6 ,27.9 ,30.4 ,32.7 ,
2039 + 34.6 ,36.3 ,21.1 /
2040 DATA (AE(I, 7, 7),I=1,10) /
2041 + .000E+00,45.4 ,30.9 ,28.2 ,29.0 ,31.2 ,34.0 ,
2042 + 35.8 ,37.4 ,21.1 /
2043 DATA (AE(I, 7, 8),I=1,10) /
2044 + .000E+00,.000E+00,38.2 ,29.6 ,29.4 ,30.3 ,33.2 ,
2045 + 35.5 ,37.6 ,21.1 /
2046 DATA (AE(I, 7, 9),I=1,10) /
2047 + .000E+00,.000E+00,59.3 ,34.5 ,33.7 ,32.9 ,35.4 ,
2048 + 37.6 ,39.6 ,22.0 /
2049 DATA (AE(I, 7,10),I=1,10) /
2050 + .000E+00,.000E+00,.000E+00,44.5 ,37.8 ,37.5 ,37.2 ,
2051 + 39.0 ,41.4 ,23.3 /
2052 DATA (AE(I, 7,11),I=1,10) /
2053 + .000E+00,.000E+00,.000E+00,67.0 ,43.6 ,42.0 ,40.8 ,
2054 + 41.4 ,43.0 ,24.4 /
2055 DATA (AE(I, 7,12),I=1,10) /
2056 + .000E+00,.000E+00,.000E+00,49.9 ,50.9 ,44.6 ,43.9 ,
2057 + 44.2 ,44.2 ,26.3 /
2058 DATA (AE(I, 7,13),I=1,10) /
2059 + .000E+00,.000E+00,.000E+00,.000E+00,67.2 ,50.5 ,48.7 ,
2060 + 48.1 ,47.2 ,27.6 /
2061 DATA (AE(I, 7,14),I=1,10) /
2062 + .000E+00,.000E+00,.000E+00,.000E+00,68.1 ,55.2 ,52.3 ,
2063 + 51.5 ,51.6 ,29.6 /
2064 DATA (AE(I, 7,15),I=1,10) /
2065 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,68.7 ,58.6 ,
2066 + 56.5 ,55.7 ,31.8 /
2067 DATA (AE(I, 7,16),I=1,10) /
2068 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,89.3 ,62.9 ,
2069 + 60.0 ,59.1 ,34.4 /
2070 DATA (AE(I, 7,17),I=1,10) /
2071 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,56.0 ,72.9 ,
2072 + 66.3 ,64.2 ,36.4 /
2073 DATA (AE(I, 7,18),I=1,10) /
2074 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,105. ,
2075 + 71.3 ,68.3 ,38.3 /
2076 DATA (AE(I, 7,19),I=1,10) /
2077 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,73.4 ,
2078 + 76.8 ,72.4 ,41.4 /
2079 DATA (AE(I, 7,20),I=1,10) /
2080 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,
2081 + 107. ,79.9 ,43.4 /
2082 DATA (AE(I, 8, 1),I=1,10) /
2083 + 35.5 ,35.3 ,35.7 ,35.7 ,36.3 ,36.3 ,36.7 ,
2084 + 36.7 ,36.7 ,19.0 /
2085 DATA (AE(I, 8, 2),I=1,10) /
2086 + 40.6 ,41.4 ,41.9 ,42.3 ,43.2 ,43.5 ,44.0 ,
2087 + 44.3 ,44.5 ,22.6 /
2088 DATA (AE(I, 8, 3),I=1,10) /
2089 + 45.4 ,45.7 ,46.4 ,47.0 ,48.1 ,48.7 ,49.4 ,
2090 + 49.8 ,50.2 ,22.9 /
2091 DATA (AE(I, 8, 4),I=1,10) /
2092 + 43.9 ,44.3 ,43.4 ,45.1 ,47.3 ,48.7 ,49.6 ,
2093 + 50.5 ,51.3 ,19.0 /
2094 DATA (AE(I, 8, 5),I=1,10) /
2095 + .000E+00,49.3 ,49.6 ,50.5 ,53.2 ,54.2 ,55.4 ,
2096 + 56.1 ,56.8 ,19.4 /
2097 DATA (AE(I, 8, 6),I=1,10) /
2098 + .000E+00,59.1 ,53.0 ,55.4 ,58.0 ,60.0 ,61.2 ,
2099 + 62.5 ,63.6 ,21.1 /
2100 DATA (AE(I, 8, 7),I=1,10) /
2101 + .000E+00,54.5 ,57.1 ,59.2 ,62.3 ,64.4 ,66.0 ,
2102 + 67.3 ,68.5 ,21.1 /
2103 DATA (AE(I, 8, 8),I=1,10) /
2104 + .000E+00,.000E+00,65.9 ,62.1 ,65.1 ,67.6 ,69.4 ,
2105 + 71.1 ,72.6 ,21.1 /
2106 DATA (AE(I, 8, 9),I=1,10) /
2107 + .000E+00,.000E+00,72.2 ,67.1 ,70.5 ,73.1 ,75.1 ,
2108 + 76.8 ,78.4 ,22.0 /
2109 DATA (AE(I, 8,10),I=1,10) /
2110 + .000E+00,.000E+00,.000E+00,80.1 ,75.0 ,78.0 ,80.0 ,
2111 + 82.1 ,83.9 ,23.3 /
2112 DATA (AE(I, 8,11),I=1,10) /
2113 + .000E+00,.000E+00,.000E+00,94.5 ,82.2 ,82.8 ,85.1 ,
2114 + 87.3 ,89.2 ,24.4 /
2115 DATA (AE(I, 8,12),I=1,10) /
2116 + .000E+00,.000E+00,.000E+00,56.8 ,92.5 ,87.2 ,89.4 ,
2117 + 91.9 ,94.1 ,26.3 /
2118 DATA (AE(I, 8,13),I=1,10) /
2119 + .000E+00,.000E+00,.000E+00,.000E+00,116. ,96.2 ,94.4 ,
2120 + 97.0 ,99.2 ,27.6 /
2121 DATA (AE(I, 8,14),I=1,10) /
2122 + .000E+00,.000E+00,.000E+00,.000E+00,78.1 ,104. ,102. ,
2123 + 102. ,105. ,29.6 /
2124 DATA (AE(I, 8,15),I=1,10) /
2125 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,128. ,111. ,
2126 + 109. ,110. ,31.8 /
2127 DATA (AE(I, 8,16),I=1,10) /
2128 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,104. ,118. ,
2129 + 117. ,115. ,34.4 /
2130 DATA (AE(I, 8,17),I=1,10) /
2131 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,64.4 ,138. ,
2132 + 124. ,122. ,36.4 /
2133 DATA (AE(I, 8,18),I=1,10) /
2134 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,133. ,
2135 + 133. ,132. ,38.3 /
2136 DATA (AE(I, 8,19),I=1,10) /
2137 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,83.6 ,
2138 + 146. ,139. ,41.4 /
2139 DATA (AE(I, 8,20),I=1,10) /
2140 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,
2141 + 166. ,147. ,43.4 /
2142 DATA (AE(I, 9, 1),I=1,10) /
2143 + 43.3 ,43.2 ,43.6 ,43.8 ,44.1 ,44.3 ,44.7 ,
2144 + 44.8 ,44.8 ,19.0 /
2145 DATA (AE(I, 9, 2),I=1,10) /
2146 + 50.9 ,51.4 ,52.0 ,52.6 ,53.1 ,53.6 ,54.2 ,
2147 + 54.5 ,54.7 ,22.6 /
2148 DATA (AE(I, 9, 3),I=1,10) /
2149 + 58.0 ,58.4 ,59.3 ,60.1 ,60.7 ,61.5 ,62.3 ,
2150 + 62.7 ,63.1 ,22.9 /
2151 DATA (AE(I, 9, 4),I=1,10) /
2152 + 62.0 ,63.9 ,63.7 ,65.7 ,65.5 ,67.5 ,68.2 ,
2153 + 68.9 ,69.7 ,19.0 /
2154 DATA (AE(I, 9, 5),I=1,10) /
2155 + .000E+00,72.2 ,72.5 ,74.2 ,74.2 ,76.1 ,77.0 ,
2156 + 77.8 ,78.6 ,19.4 /
2157 DATA (AE(I, 9, 6),I=1,10) /
2158 + .000E+00,80.4 ,80.5 ,83.1 ,83.0 ,85.5 ,86.8 ,
2159 + 88.1 ,89.2 ,21.1 /
2160 DATA (AE(I, 9, 7),I=1,10) /
2161 + .000E+00,63.4 ,88.5 ,91.3 ,91.1 ,94.0 ,95.8 ,
2162 + 97.3 ,98.6 ,21.1 /
2163 DATA (AE(I, 9, 8),I=1,10) /
2164 + .000E+00,.000E+00,98.8 ,98.6 ,97.8 ,102. ,104. ,
2165 + 106. ,108. ,21.1 /
2166 DATA (AE(I, 9, 9),I=1,10) /
2167 + .000E+00,.000E+00,84.1 ,107. ,107. ,111. ,113. ,
2168 + 116. ,117. ,22.0 /
2169 DATA (AE(I, 9,10),I=1,10) /
2170 + .000E+00,.000E+00,.000E+00,116. ,115. ,119. ,122. ,
2171 + 125. ,127. ,23.3 /
2172 DATA (AE(I, 9,11),I=1,10) /
2173 + .000E+00,.000E+00,.000E+00,111. ,123. ,127. ,131. ,
2174 + 134. ,137. ,24.4 /
2175 DATA (AE(I, 9,12),I=1,10) /
2176 + .000E+00,.000E+00,.000E+00,65.6 ,136. ,135. ,140. ,
2177 + 143. ,146. ,26.3 /
2178 DATA (AE(I, 9,13),I=1,10) /
2179 + .000E+00,.000E+00,.000E+00,.000E+00,146. ,144. ,149. ,
2180 + 152. ,155. ,27.6 /
2181 DATA (AE(I, 9,14),I=1,10) /
2182 + .000E+00,.000E+00,.000E+00,.000E+00,88.7 ,152. ,158. ,
2183 + 162. ,165. ,29.6 /
2184 DATA (AE(I, 9,15),I=1,10) /
2185 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,181. ,167. ,
2186 + 171. ,174. ,31.8 /
2187 DATA (AE(I, 9,16),I=1,10) /
2188 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,117. ,174. ,
2189 + 180. ,183. ,34.4 /
2190 DATA (AE(I, 9,17),I=1,10) /
2191 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,72.0 ,201. ,
2192 + 189. ,192. ,36.4 /
2193 DATA (AE(I, 9,18),I=1,10) /
2194 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,151. ,
2195 + 198. ,201. ,38.3 /
2196 DATA (AE(I, 9,19),I=1,10) /
2197 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,95.2 ,
2198 + 220. ,210. ,41.4 /
2199 DATA (AE(I, 9,20),I=1,10) /
2200 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,
2201 + 192. ,217. ,43.4 /
2202 DATA (AE(I,10, 1),I=1,10) /
2203 + 62.1 ,62.1 ,62.6 ,62.9 ,63.3 ,63.3 ,64.0 ,
2204 + 64.0 ,64.0 ,19.0 /
2205 DATA (AE(I,10, 2),I=1,10) /
2206 + 75.1 ,75.4 ,76.3 ,76.8 ,77.6 ,77.9 ,78.8 ,
2207 + 79.0 ,79.3 ,22.6 /
2208 DATA (AE(I,10, 3),I=1,10) /
2209 + 87.5 ,88.3 ,89.4 ,90.2 ,91.3 ,91.9 ,93.0 ,
2210 + 93.5 ,93.9 ,22.9 /
2211 DATA (AE(I,10, 4),I=1,10) /
2212 + 104. ,104. ,105. ,106. ,107. ,108. ,109. ,
2213 + 110. ,110. ,19.0 /
2214 DATA (AE(I,10, 5),I=1,10) /
2215 + .000E+00,122. ,122. ,123. ,124. ,125. ,126. ,
2216 + 127. ,128. ,19.4 /
2217 DATA (AE(I,10, 6),I=1,10) /
2218 + .000E+00,138. ,139. ,140. ,142. ,143. ,144. ,
2219 + 146. ,147. ,21.1 /
2220 DATA (AE(I,10, 7),I=1,10) /
2221 + .000E+00,85.3 ,158. ,159. ,161. ,162. ,164. ,
2222 + 166. ,167. ,21.1 /
2223 DATA (AE(I,10, 8),I=1,10) /
2224 + .000E+00,.000E+00,176. ,177. ,179. ,181. ,183. ,
2225 + 184. ,186. ,21.1 /
2226 DATA (AE(I,10, 9),I=1,10) /
2227 + .000E+00,.000E+00,114. ,199. ,201. ,202. ,205. ,
2228 + 206. ,207. ,22.0 /
2229 DATA (AE(I,10,10),I=1,10) /
2230 + .000E+00,.000E+00,.000E+00,218. ,219. ,220. ,224. ,
2231 + 225. ,226. ,23.3 /
2232 DATA (AE(I,10,11),I=1,10) /
2233 + .000E+00,.000E+00,.000E+00,150. ,238. ,238. ,243. ,
2234 + 244. ,245. ,24.4 /
2235 DATA (AE(I,10,12),I=1,10) /
2236 + .000E+00,.000E+00,.000E+00,85.8 ,255. ,255. ,261. ,
2237 + 262. ,263. ,26.3 /
2238 DATA (AE(I,10,13),I=1,10) /
2239 + .000E+00,.000E+00,.000E+00,.000E+00,195. ,272. ,279. ,
2240 + 279. ,280. ,27.6 /
2241 DATA (AE(I,10,14),I=1,10) /
2242 + .000E+00,.000E+00,.000E+00,.000E+00,115. ,290. ,296. ,
2243 + 297. ,298. ,29.6 /
2244 DATA (AE(I,10,15),I=1,10) /
2245 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,263. ,313. ,
2246 + 314. ,315. ,31.8 /
2247 DATA (AE(I,10,16),I=1,10) /
2248 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,150. ,330. ,
2249 + 331. ,332. ,34.4 /
2250 DATA (AE(I,10,17),I=1,10) /
2251 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,90.0 ,319. ,
2252 + 349. ,349. ,36.4 /
2253 DATA (AE(I,10,18),I=1,10) /
2254 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,196. ,
2255 + 366. ,367. ,38.3 /
2256 DATA (AE(I,10,19),I=1,10) /
2257 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,122. ,
2258 + 387. ,384. ,41.4 /
2259 DATA (AE(I,10,20),I=1,10) /
2260 + .000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,.000E+00,
2261 + 247. ,401. ,43.4 /
2262 DATA (ERES(I, 1),I=1,10) / 10*0./
2263 DATA (ERES(I, 2),I=1,10) / 10*0./
2264 DATA (ERES(I, 3),I=1,10) / 10*0./
2265 DATA (ERES(I, 4),I=1,10) / 10*0./
2266 DATA (ERES(I, 5),I=1,10) / 10*0./
2267 DATA (ERES(I, 6),I=1,10) /
2268 + 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000,
2269 + 2.780, 2.880, 2.890 /
2270 DATA (ERES(I, 7),I=1,10) /
2271 + 1.500, 2.460, 2.510, 2.610, 2.700, 2.920, 3.070,
2272 + 3.200, 3.330, 2.890 /
2273 DATA (ERES(I, 8),I=1,10) /
2274 + 4.470, 4.350, 4.390, 4.550, 4.660, 4.890, 4.980,
2275 + 5.100, 5.220, 2.890 /
2276 DATA (ERES(I, 9),I=1,10) /
2277 + 7.480, 7.380, 7.370, 7.480, 7.510, 7.630, 7.660,
2278 + 7.750, 7.820, 2.890 /
2279 DATA (ERES(I,10),I=1,10) /
2280 + 15.270, 15.190, 15.200, 15.370, 15.380, 15.430, 15.540,
2281 + 15.590, 15.630, 2.890 /
2282 END
2283 FUNCTION GASDEV(IDUMMY)
2284C...Gaussian deviation
2285 SAVE GSET
2286 DATA ISET/0/
2287 IF (ISET.EQ.0) THEN
22881 V1=2.*RNDM(0)-1.
2289 V2=2.*RNDM(0)-1.
2290 R=V1**2+V2**2
2291 IF(R.GE.1.)GO TO 1
2292 FAC=SQRT(-2.*LOG(R)/R)
2293 GSET=V1*FAC
2294 GASDEV=V2*FAC
2295 ISET=1
2296 ELSE
2297 GASDEV=GSET
2298 ISET=0
2299 ENDIF
2300 RETURN
2301 END
2302
2303 FUNCTION GAUSS (FUN, A,B)
2304C...Returns the 8 points Gauss-Legendre integral
2305C. of function FUN from A to B
2306C...........................................................
2307 DIMENSION X(8), W(8)
2308 DATA X / .0950125098, .2816035507, .4580167776, .6178762444
2309 1 ,.7554044083, .8656312023, .9445750230, .9894009349/
2310 DATA W / .1894506104, .1826034150, .1691565193, .1495959888
2311 1 ,.1246289712, .0951585116, .0622535239, .0271524594/
2312 XM = 0.5*(B+A)
2313 XR = 0.5*(B-A)
2314 SS = 0.
2315 DO J=1,8
2316 DX = XR*X(J)
2317 SS = SS + W(J) * (FUN(XM+DX) + FUN(XM-DX))
2318 ENDDO
2319 GAUSS = XR*SS
2320 RETURN
2321 END
2322
2323 SUBROUTINE GG_FRAG (E0)
2324C...This routine fragments a gluon-gluon system
2325C. of mass E0 (GeV)
2326C. the particles produced are in the jet-jet frame
2327C. oriented along the z axis
2328C...........................................................
2329 COMMON /S_PLIST/ NP, P(5000,5), LLIST(5000)
2330 COMMON /S_MASS1/ AM(49), AM2(49)
2331 DIMENSION WW(2,2),PTOT(4),PX(3),PY(3),IFL(3),PMQ(3)
2332
2333C...Generate the 'forward' leading particle.
2334100 I = NP+1
2335 I0 = -1 + 2.*INT(1.9999*RNDM(0))
2336 CALL IFLAV(I0,0,IFL1, LDUM)
2337 CALL IFLAV(IFL1,0,IFL2, LLIST(I))
2338 CALL PTDIS(IFL1,PX1,PY1)
2339 CALL PTDIS(IFL2,PX2,PY2)
2340 P(I,1) = PX1+PX2
2341 P(I,2) = PY1+PY2
2342 P(I,5) = AM(IABS(LLIST(I)))
2343 XM1 = P(I,5)**2+P(I,1)**2+P(I,2)**2
2344 Z1 = ZDIS (IFL1,1,0.25*XM1)
2345 Z2 = ZDIS (IFL2,1,0.25*XM1)
2346 T1 = 4.*XM1/(E0*E0*(Z1+Z2))
2347 P(I,4) = 0.25*E0*(Z1+Z2 + T1)
2348 P(I,3) = 0.25*E0*(Z1+Z2 - T1)
2349
2350C...Generate the 'backward' leading particle.
2351 I = I+1
2352 CALL IFLAV(-I0,0,IFL3, LDUM)
2353 CALL IFLAV(IFL3,0,IFL4, LLIST(I))
2354 CALL PTDIS(IFL3,PX3,PY3)
2355 CALL PTDIS(IFL4,PX4,PY4)
2356 P(I,1) = PX3+PX4
2357 P(I,2) = PY3+PY4
2358 P(I,5) = AM(IABS(LLIST(I)))
2359 XM2 = P(I,5)**2+P(I,1)**2+P(I,2)**2
2360 Z3 = ZDIS (IFL3,1,0.25*XM2)
2361 Z4 = ZDIS (IFL4,1,0.25*XM2)
2362 T2 = 4.*XM2/(E0*E0*(Z3+Z4))
2363 P(I,4) = 0.25*E0*( Z3+Z4 + T2)
2364 P(I,3) = 0.25*E0*(-Z3-Z4 + T2)
2365
2366C...Fragment the two remaning strings
2367 N0 = 0
2368 DO KS=1,2
2369
2370 NTRY = 0
2371200 NTRY = NTRY+1
2372 I = NP+2+N0
2373 IF (NTRY .GT. 30) GOTO 100
2374
2375 IF (KS .EQ. 1) THEN
2376 WW(1,1) = 0.5 * (1 - Z1 - 0.5*T2)
2377 WW(2,1) = 0.5 * (1 - Z3 - 0.5*T1)
2378 PX(1) = -PX1
2379 PY(1) = -PY1
2380 PX(2) = -PX3
2381 PY(2) = -PY3
2382 IFL(1) = -IFL1
2383 IFL(2) = -IFL3
2384 ELSE
2385 WW(1,1) = 0.5 * (1 - Z2 - 0.5*T2)
2386 WW(2,1) = 0.5 * (1 - Z4 - 0.5*T1)
2387 PX(1) = -PX2
2388 PY(1) = -PY2
2389 PX(2) = -PX4
2390 PY(2) = -PY4
2391 IFL(1) = -IFL2
2392 IFL(2) = -IFL4
2393 ENDIF
2394 PX(3) = 0.
2395 PY(3) = 0.
2396 PTOT (1) = PX(1)+PX(2)
2397 PTOT (2) = PY(1)+PY(2)
2398 PTOT (3) = 0.5*E0*(WW(1,1)-WW(2,1))
2399 PTOT (4) = 0.5*E0*(WW(1,1)+WW(2,1))
2400
2401 PMQ(1) = QMASS(IFL(1))
2402 PMQ(2) = QMASS(IFL(2))
2403
2404C...produce new particle: side, pT
2405300 I=I+1
2406 JT=1.5+RNDM(0)
2407 JR=3-JT
2408c CALL PTDIS (IFL(JT), PX(3),PY(3))
2409
2410C...particle ID
2411 CALL IFLAV (IFL(JT), 0, IFL(3), LLIST(I))
2412 PMQ(3) = QMASS(IFL(3))
2413 P(I,5) = AM(IABS(LLIST(I)))
2414
2415 CALL PTDIS (IFL(3), PX(3),PY(3))
2416
2417C...test end of fragmentation
2418 WREM2 = PTOT(4)**2-PTOT(1)**2-PTOT(2)**2-PTOT(3)**2
2419 IF (WREM2 .LT. 0.1) GOTO 200
2420 WMIN = PMQ(1)+PMQ(2)+2.*PMQ(3)+1.1 + (2.*RNDM(0)-1.)*0.2
2421 IF (WREM2 .LT. WMIN**2) GOTO 400
2422
2423C...fill transverse momentum
2424 P(I,1) = PX(JT) + PX(3)
2425 P(I,2) = PY(JT) + PY(3)
2426
2427C...Choose z
2428 XMT2 = P(I,5)**2+P(I,1)**2+P(I,2)**2
2429 Z = ZDIS (ifl(3),IFL(JT), XMT2)
2430
2431 WW(JT,2) = Z*WW(JT,1)
2432 WW(JR,2) = XMT2/(WW(JT,2)*E0**2)
2433
2434 P(I,3) = WW(1,2)*0.5*E0 - WW(2,2)*0.5*E0
2435 P(I,4) = WW(1,2)*0.5*E0 + WW(2,2)*0.5*E0
2436
2437 DO J=1,4
2438 PTOT (J) = PTOT(J) - P(I,J)
2439 ENDDO
2440 DO K=1,2
2441 WW(K,1) = WW(K,1) - WW(K,2)
2442 ENDDO
2443
2444C...Reset pT and flavor at ends of the string
2445 PX(JT) = -PX(3)
2446 PY(JT) = -PY(3)
2447 IFL(JT) =-IFL(3)
2448 PMQ(JT) = PMQ(3)
2449 GOTO 300
2450
2451C...Final two hadrons
2452400 IF (IFL(JR)*IFL(3) .GT. 100) GOTO 200
2453 CALL IFLAV (IFL(JR), -IFL(3), IFLA, LLIST(I+1))
2454 P(I+1,5) = AM(IABS(LLIST(I+1)))
2455 P(I,1) = PX(JT)+PX(3)
2456 P(I,2) = PY(JT)+PY(3)
2457 I1 = I+1
2458 P(I1,1) = PX(JR)-PX(3)
2459 P(I1,2) = PY(JR)-PY(3)
2460 XM1 = P(I,5)**2+P(I,1)**2+P(I,2)**2
2461 XM2 = P(I1,5)**2+P(I1,1)**2+P(I1,2)**2
2462 IF (SQRT(XM1)+SQRT(XM2) .GT. SQRT(WREM2)) GOTO 200
2463 if (ptot(4).le.0) goto 200
2464 WREM = SQRT(WREM2)
2465 EA1 = (WREM2+XM1-XM2)/(2.*WREM)
2466 PA2 = (EA1**2-XM1)
2467 if (pa2.ge.0.0) then
2468 PA = SQRT(pa2)
2469 else
2470 goto 200
2471 endif
2472 BA = PTOT(3)/PTOT(4)
2473 GA = PTOT(4)/WREM
2474 S = FLOAT(3-2*JT)
2475 P(I,3) = GA*(BA*EA1+S*PA)
2476 P(I,4) = GA*(EA1+BA*S*PA)
2477 P(I+1,3) = PTOT(3)-P(I,3)
2478 P(I+1,4) = PTOT(4)-P(I,4)
2479 N0 = I-NP-1
2480 ENDDO ! loop on two `remaining strings'
2481 NP = I+1
2482 RETURN
2483 END
2484 SUBROUTINE GLAUBER(JA,SSIG,SLOPE,ALPHA,SIGT,SIGEL,SIGQEL)
2485C...Subroutine to compute hadron-Nucleus cross sections
2486C. according to:
2487C. R.J. Glauber and G.Matthiae Nucl.Phys. B21, 135, (1970)
2488C.
2489C. This formulas assume that the target nucleus density is
2490C. modeled by a shell-model form. A reasonable range of models
2491C is 4 < JA < 18
2492C.
2493C. INPUT : A = mass number of the nucleus
2494C. SSIG (mbarn) total pp cross section
2495C. SLOPE (GeV**-2) elastic scattering slope for pp
2496C. ALPHA real/imaginary part of the forward pp elastic
2497C. scattering amplitude
2498C. OUTPUT : SIGT = Total cross section
2499C. SIGEL = Elastic cross section
2500C. SIGQEL = Elastic + Quasi elastic cross section
2501C.
2502C. Internally everything is computed in GeV (length = GeV**-1)
2503C......................................................................
2504 COMMON /CA0SH/ R0, R02
2505 COMPLEX ZZ, ZS, ZP, ZC
2506 DIMENSION RR(18)
2507 DATA CMBARN /0.389385/
2508 DATA PI /3.1415926/
2509 DATA BMAX /50./ ! GeV**-1
2510 DATA NB /100/
2511C...data on Sqrt[<r**2>] (fm). (A=5,8 are not correct). From Barett and Jackson
2512 DATA RR /0.81,2.095,1.88,1.674, 2.56,2.56,2.41,2.5,2.519,2.45
2513 + ,2.37, 2.460, 2.440, 2.54, 2.58, 2.718, 2.662,2.789 /
2514 A = FLOAT(JA)
2515C...Parameter of shell model density
2516 R0 = RR(JA)/0.197/SQRT(5./2. - 4./A) ! GeV**-1
2517 R02 = R0*R0
2518 SIG = SSIG/CMBARN ! GeV**-2
2519 DB = BMAX/FLOAT(NB)
2520 SUM = 0.
2521 SUM1 = 0.
2522 SUM2 = 0.
2523 DO JB=1,NB
2524 B = DB*(FLOAT(JB)-0.5)
2525 GS = GLAUBGS (B,SLOPE, SIG)
2526 GP = GLAUBGP (B,SLOPE, SIG)
2527 XS = (1.- GS)
2528 YS = GS*ALPHA
2529 ZS = CMPLX(XS,YS)
2530 XP = (1.- GP)
2531 YP = GP*ALPHA
2532 ZP = CMPLX(XP,YP)
2533 ZZ = ZS**4. * ZP**(A-4.)
2534 X = REAL (ZZ)
2535 Y = AIMAG(ZZ)
2536 ZC = CMPLX(X,-Y)
2537 SUM = SUM + (1.-X)*B
2538 SUM1 = SUM1 + ((1.-X)**2 + Y**2)*B
2539 OMS = OMEGAS(B,SIG,SLOPE,ALPHA)
2540 OMP = OMEGAP(B,SIG,SLOPE,ALPHA)
2541 OM = (1.- 2.*GS + OMS)**4. * (1. -2.*GP + OMP)**(A-4.)
2542 SUM2 = SUM2 + (1.-2.*X + OM)*B
2543 ENDDO
2544 SIGT = SUM * DB * 4.*PI * CMBARN
2545 SIGEL = SUM1 * DB * 2.*PI * CMBARN
2546 SIGQEL = SUM2 * DB * 2.*PI * CMBARN
2547 RETURN
2548 END
2549 FUNCTION GLAUBGP (B,SLOPE, SIG)
2550 COMMON /CA0SH/ A0, A02
2551 DATA PI /3.1415926/
2552 GAMMA2 = A02/4. + 0.5*SLOPE
2553 ARG = B**2/(4.*GAMMA2)
2554 C1 = 1.- A02/(6.*GAMMA2)*(1.-ARG)
2555 GLAUBGP = SIG/(8.*PI*GAMMA2) * C1 * EXP(-ARG)
2556 RETURN
2557 END
2558 FUNCTION GLAUBGS (B,SLOPE, SIG)
2559 COMMON /CA0SH/ A0, A02
2560 DATA PI /3.1415926/
2561 GAMMA2 = A02/4. + 0.5*SLOPE
2562 ARG = B**2/(4.*GAMMA2)
2563 GLAUBGS = SIG/(8.*PI*GAMMA2) * EXP(-ARG)
2564 RETURN
2565 END
2566 SUBROUTINE HAD_CONV
2567C----------------------------------------------------------------------------
2568C Code for the convolution of hadrons
2569C----------------------------------------------------------------------------
2570C...Convolution of hadrons profile
2571C. [function A(b) of Durand and Pi]
2572C. precalculate and put in COMMON block
2573C.........................................
2574 COMMON /S_CHDCNV/NB,DB,ABPP(200),ABPIP(200),ABPPH(200),
2575 + ABPIPH(200)
2576 REAL*4 NU2, MU2, NUPI2, NU, MU, NUPI
2577
2578 COMMON /S_CH0CNV/ NU2, MU2, NUPI2, NU, MU, NUPI
2579
2580 NU2 = 0.71
2581 MU2 = 0.88
2582 NUPI2 = 0.54
2583
2584 NU = SQRT(NU2)
2585 MU = SQRT(MU2)
2586 NUPI = SQRT(NUPI2)
2587
2588C...integration constants
2589 BMAX = 15.
2590 NB = 200
2591 DB = BMAX/FLOAT(NB)
2592
2593 DO JB=1,NB
2594 B = DB*FLOAT(JB-1)
2595 ABPP(JB) = A_PP(B)
2596 ABPIP(JB) = A_PIP(B)
2597 ENDDO
2598 NU2 = 0.71
2599 MU2 = 0.88
2600 NUPI2 = 0.54
2601
2602 NU = SQRT(NU2)
2603 MU = SQRT(MU2)
2604 NUPI = SQRT(NUPI2)
2605
2606 DB = BMAX/FLOAT(NB)
2607 DO JB=1,NB
2608 B = DB*FLOAT(JB-1)
2609 ABPPh(JB) = A_PP(B)
2610 ABPIPh(JB) = A_PIP(B)
2611 ENDDO
2612 RETURN
2613 END
2614 FUNCTION HELIUM (R)
2615C... Helium density from Barrett and Jackson
2616C. INPUT R = r coordinate (fm)
2617C. OUTPUT (fm**-3)
2618C........................................................
2619 DATA R0 /0.964/, CA /0.322/ ! fm
2620 DATA W /0.517/, CC /5.993224E-02/
2621 HELIUM = CC*(1.+W*(R/R0)**2)/(1. + EXP((R-R0)/CA))
2622 RETURN
2623 END
2624
2625 SUBROUTINE HSPLI (KF, KP1,KP2)
2626C...This subroutine splits one hadron of code KF
2627C. into 2 partons of code KP1 and KP2
2628C. KP1 refers to a color triplet [q or (qq)bar]
2629C. KP2 to a a color anti-triplet [qbar or (qq)]
2630C. allowed inputs:
2631C. KF = 7:14 pi+-,k+-,k0L,k0s, p,n
2632C. = -13,-14 pbar,nbar
2633C.................................................
2634
2635 L = IABS(KF)-6
2636 GOTO (100,200,300,400,500,500,600,700), L
2637
2638100 KP1 = 1 ! pi+
2639 KP2 = -2
2640 RETURN
2641200 KP1 = 2 ! pi-
2642 KP2 = -1
2643 RETURN
2644300 KP1 = 1 ! k+
2645 KP2 = -3
2646 RETURN
2647400 KP1 = 3 ! k-
2648 KP2 = -1
2649 RETURN
2650500 KP1 = 2 ! k0l, k0s
2651 KP2 = -3
2652 IF (RNDM(0).GT. 0.5) THEN
2653 KP1 = 3
2654 KP2 = -2
2655 ENDIF
2656 return ! bug fix 5-91
2657600 R = 6.*RNDM(0) ! p/pbar
2658 IF (R .LT.3.) THEN
2659 KP1 = 1
2660 KP2 = 12
2661 ELSEIF (R .LT. 4.) THEN
2662 KP1 = 1
2663 KP2 = 21
2664 ELSE
2665 KP1 = 2
2666 KP2 = 11
2667 ENDIF
2668 IF (KF .LT. 0) THEN
2669 KPP = KP1
2670 KP1 = -KP2
2671 KP2 = -KPP
2672 ENDIF
2673 RETURN
2674
2675700 R = 6.*RNDM(0) ! n/nbar
2676 IF (R .LT.3.) THEN
2677 KP1 = 2
2678 KP2 = 12
2679 ELSEIF (R .LT. 4.) THEN
2680 KP1 = 2
2681 KP2 = 21
2682 ELSE
2683 KP1 = 1
2684 KP2 = 22
2685 ENDIF
2686 IF (KF .LT. 0) THEN
2687 KPP = KP1
2688 KP1 = -KP2
2689 KP2 = -KPP
2690 ENDIF
2691 RETURN
2692 END
2693 SUBROUTINE IFLAV (IFL1,IFL2A, IFL2, KF)
2694C...This subroutine receives as input IFL1 the flavor code
2695C. of a quark (antiquark) and generates the antiquark (quark)
2696C. of flavor code IFL2 that combine with the original parton
2697C. to compose an hadron of code KF. ONLY 3 FLAVORS
2698C. If (IFL2A.NE.0) returns an hadron KF composed of IFL1 and IFL2A
2699C...................................................................
2700 COMMON /S_CFLAFR/ PAR(8)
2701 DIMENSION KFLA(3,3,2), CDIAG(12), KDIAG(6)
2702 DIMENSION KBAR(30), CFR(12), KFR(80)
2703 DATA KFLA /0,8,10,7,0,22,9,21,0,0,26,29,25,0,31,28,30,0/
2704 DATA CDIAG /0.5,0.25,0.5,0.25,1.,0.5,0.5,0.,0.5,0.,1.,1./
2705 DATA KDIAG /6,23,24,27,32,33/
2706 DATA KBAR /13,14,34,35,36,37,38,9*0,39,3*0,40,41,42,43,44,
2707 + 45,46,47,48,49/
2708 DATA CFR /0.75,0.,0.5,0.,0.,1.,0.1667,0.3333,0.0833,0.6667,
2709 + 0.1667,0.3333/
2710 DATA KFR/0,16,17,19,100,104,109,115,0,26,27,29,122,126,131,137
2711 + ,0,40,42,47,144,158,178,205,0,1,3,6,10,15,21,28,0,0,56,57,240,
2712 + 246,256,271,0,0,1,3,6,10,15,21,60,61,64,70,292,307,328,356,
2713 + 0,1,3,6,10,15,21,28,16*0/
2714
2715
2716 IFLA = IABS(IFL1)
2717 IF (IFL2A .NE. 0) THEN
2718 IFL2A = MOD(IFL2A,100)
2719 IFL2 = IFL2A
2720 IFLB = IABS(IFL2A)
2721 MB = 0
2722 IF (IFLB .GT. 10) MB=1
2723 IF (IFLA .GT. 10) MB=2
2724 ELSE
2725 MB = 2
2726 IF (IFLA .LT. 10) THEN
2727 MB = 1
2728 IF ((1.+PAR(1))*RNDM(0).LT. 1.) MB=0
2729 ENDIF
2730 ENDIF
2731
2732 IF (MB .EQ. 0) THEN
2733 IF (IFL2A.EQ.0)
2734 + IFL2=ISIGN(1+INT((2.+PAR(2))*RNDM(0)),-IFL1)
2735 IFLD = MAX(IFL1,IFL2)
2736 IFLE = MIN(IFL1,IFL2)
2737 GOTO 100
2738 ENDIF
2739
2740C...Decide if the diquark must be split
2741 IF (MB .EQ. 2 .AND. IFLA .GT. 100) THEN
2742 IFLA = MOD(IFLA,100)
2743 GOTO 200
2744 ENDIF
2745 IF (MB .EQ. 2 .AND. IFLA .EQ. 0) THEN
2746 IF (RNDM(0) .LT. PAR(8)) THEN
2747 MB = 0
2748 IFLG = MOD(IFL1,10)
2749 IFLH =(IFL1-IFLG)/10
2750 IF (RNDM(0) .GT. 0.5) THEN
2751 IFLDUM = IFLG
2752 IFLG = IFLH
2753 IFLH = IFLDUM
2754 ENDIF
2755 IFL11=IFLG
2756 IFL22=ISIGN(1+INT((2.+PAR(2))*RNDM(0)),-IFL1)
2757 IFLD = MAX(IFL11,IFL22)
2758 IFLE = MIN(IFL11,IFL22)
2759 IFL2 = -IFLH*10+IFL22
2760 IF (RNDM(0) .GT. 0.5) IFL2 = IFL22*10-IFLH
2761 IFL2 = IFL2+ISIGN(100,IFL2)
2762 ENDIF
2763 ENDIF
2764
2765C...Form a meson: consider spin and flavor mixing for the diagonal states
2766100 IF (MB .EQ. 0) THEN
2767 IF1 = IABS(IFLD)
2768 IF2 = IABS(IFLE)
2769 IFLC = MAX(IF1,IF2)
2770 KSP = INT(PAR(5)+RNDM(0))
2771 IF (IFLC.EQ.3) KSP = INT(PAR(6)+RNDM(0))
2772C D.H.
2773 KSP = MIN(KSP,1)
2774
2775 IF (IF1 .NE. IF2) THEN
2776 KF = KFLA(IF1,IF2,KSP+1)
2777 ELSE
2778 R = RNDM(0)
2779 JF=1+INT(R+CDIAG(6*KSP+2*IF1-1))+
2780 + INT(R+CDIAG(6*KSP+2*IF1))
2781C D.H.
2782 JF = MIN(JF,3)
2783
2784 KF=KDIAG(JF+3*KSP)
2785 ENDIF
2786 RETURN
2787 ENDIF
2788
2789C...Form a baryon
2790200 IF (IFL2A .NE. 0) THEN
2791 IF (MB .EQ. 1) THEN
2792 IFLD = IFLA
2793 IFLE = IFLB/10
2794 IFLF = MOD(IFLB,10)
2795 ELSE
2796 IFLD = IFLB
2797 IFLE = IFLA/10
2798 IFLF = MOD(IFLA,10)
2799 ENDIF
2800 LFR = 3+2*((2*(IFLE-IFLF))/(1+IABS(IFLE-IFLF)))
2801 IF(IFLD.NE.IFLE.AND.IFLD.NE.IFLF) LFR=LFR+1
2802 ELSE
2803110 CONTINUE
2804 IF(MB.EQ.1) THEN ! generate diquark
2805 IFLD = IFLA
2806120 IFLE = 1+INT((2.+PAR(2)*PAR(3))*RNDM(0))
2807 IFLF = 1+INT((2.+PAR(2)*PAR(3))*RNDM(0))
2808 IF(IFLE.GE.IFLF.AND.PAR(4).LT.RNDM(0)) GOTO 120
2809 IF(IFLE.LT.IFLF.AND.PAR(4)*RNDM(0).GT.1.) GOTO 120
2810 IFL2=ISIGN(10*IFLE+IFLF,IFL1)
2811 ELSE ! generate quark
2812 IFL2=ISIGN(1+INT((2.+PAR(2))*RNDM(0)),IFL1)
2813 IFLD=IABS(IFL2)
2814 IFLE=IFLA/10
2815 IFLF=MOD(IFLA,10)
2816 ENDIF
2817C...SU(6) factors for baryon formation
2818 LFR=3+2*((2*(IFLE-IFLF))/(1+IABS(IFLE-IFLF)))
2819 IF(IFLD.NE.IFLE.AND.IFLD.NE.IFLF) LFR=LFR+1
2820 WT = CFR(2*LFR-1)+PAR(7)*CFR(2*LFR)
2821 IF(IFLE.LT.IFLF) WT=WT/3.
2822 IF (WT.LT.RNDM(0)) GOTO 110
2823 ENDIF
2824
2825C...Form Baryon
2826 IFLG=MAX(IFLD,IFLE,IFLF)
2827 IFLI=MIN(IFLD,IFLE,IFLF)
2828 IFLH=IFLD+IFLE+IFLF-IFLG-IFLI
2829 KSP=2+2*INT(1.-CFR(2*LFR-1)+(CFR(2*LFR-1)+PAR(7)*
2830 1 CFR(2*LFR))*RNDM(0))
2831
2832C...Distinguish Lambda- and Sigma- like particles
2833 IF (KSP.EQ.2.AND.IFLG.GT.IFLH.AND.IFLH.GT.IFLI) THEN
2834 IF(IFLE.GT.IFLF.AND.IFLD.NE.IFLG) KSP=2+INT(0.75+RNDM(0))
2835 IF(IFLE.LT.IFLF.AND.IFLD.EQ.IFLG) KSP=3
2836 IF(IFLE.LT.IFLF.AND.IFLD.NE.IFLG) KSP=2+INT(0.25+RNDM(0))
2837 ENDIF
2838 KF=KFR(16*KSP-16+IFLG)+KFR(16*KSP-8+IFLH)+IFLI
2839 KF=ISIGN(KBAR(KF-40),IFL1)
2840
2841 RETURN
2842 END
2843 SUBROUTINE INI_WRITE (LUN)
2844C...This subroutine prints on unit LUN
2845C. a table of the cross sections used in the program
2846C. and of the average number of jets, and the average
2847C. number of wounded nucleons in a hadron-air interaction
2848C---------------------------------------------------------
2849 COMMON /S_CCSIG/ NSQS, ASQSMIN, ASQSMAX, DASQS,
2850 + SSIG(51,2), PJETC(0:20,51,2),SSIGN(51,2), ALINT(51,2)
2851 DIMENSION PJ(2), PW(2)
2852 DATA ATARG /14.514/
2853C CALL PARAM_PRINT(LUN)
2854 WRITE (LUN, 10)
2855 WRITE (LUN, 15)
2856 WRITE (LUN, 16)
2857 WRITE (LUN, 18)
285810 FORMAT(//,' Table of cross sections, and average number',
2859 + ' of minijets and wounded nucleons ')
286015 FORMAT(' [sqrt(s) in GeV, cross sections in mbarn]. ')
286116 FORMAT(' sqrt(s) sig(pp) sig(pAir) <n_j> <n_w> ',
2862 + ' sig(pip) sig(piAir) <n_j> <n_w> ')
286318 FORMAT(1X,77('-') )
2864 DO J=1,51,1
2865 SQS = 10.**(ASQSMIN + DASQS*FLOAT(J-1))
2866 DO K=1,2
2867 PW(K) = ATARG*SSIG(J,K)/SSIGN(J,K)
2868 PJ(K) = 0.
2869 DO JJ=1,20
2870 PJ(K)=PJ(K)+FLOAT(JJ)*(PJETC(JJ,J,K)-PJETC(JJ-1,J,K))
2871 ENDDO
2872 ENDDO
2873 WRITE(LUN,20) SQS,SSIG(J,1),SSIGN(J,1),PJ(1),PW(1)
2874 + ,SSIG(J,2),SSIGN(J,2),PJ(2),PW(2)
2875 ENDDO
2876 WRITE (LUN, 18)
287720 FORMAT (1X,E8.2, 2(2F8.1,2X,2F7.2,3X))
2878 RETURN
2879 END
2880 SUBROUTINE INT_H_NUC (IA, SIGT, SLOPE, RHO)
2881C...Compute with a montecarlo method the "multiple interaction structure"
2882C. of an hadron-nucleus collision.
2883C.
2884C.
2885C. INPUT : IA = mass of target nucleus
2886C. SIGT (mbarn) = total hp cross section
2887C. SLOPE (GeV**-2) = slope of hp elastic scattering
2888C. RHO = real/imaginary part of forward elastic
2889C. scattering amplitude
2890C.
2891C. OUTPUT : in COMMON block /CNCMS0/
2892C. B = impact parameter (fm)
2893C. BMAX = maximum impact parameter for generation
2894C. NTRY = number of "trials" before one interaction
2895C. NA = number of wounded nucleons in A
2896C. Author : P.Lipari (may 1993)
2897C---------------------------------------------------------------------------
2898C D.H.PARAMETER (IAMAX=110)
2899 PARAMETER (IAMAX=56)
2900 COMMON /S_CNCM0/ B, BMAX, NTRY, NA
2901 DIMENSION XA(IAMAX), YA(IAMAX)
2902 DATA PI /3.1415926/
2903 DATA CMBARN /0.389385/
2904 CC = SIGT/(4.*PI*SLOPE*CMBARN)
2905 DEN = 2.*SLOPE*CMBARN*0.1
2906 BMAX = 10. ! fm
2907 NTRY = 0
2908 CALL NUC_CONF (IA, XA, YA)
29091000 B = BMAX*SQRT(RNDM(0))
2910 PHI = 2.*PI*RNDM(0)
2911 BX = B*COS(PHI)
2912 BY = B*SIN(PHI)
2913 NTRY = NTRY+1
2914 NA = 0
2915 DO JA=1,IA
2916 S = (XA(JA)-BX)**2 + (YA(JA)-BY)**2
2917 F = EXP(-S/DEN)
2918 PEL = CC*CC*(1.+RHO*RHO)*F*F
2919 PINEL = 2.*CC*F-PEL
2920 R = RNDM(0)
2921 IF (R .LT. PINEL) THEN
2922 NA = NA + 1
2923 ENDIF
2924 ENDDO
2925 IF (NA .EQ. 0) GOTO 1000
2926 RETURN
2927 END
2928
2929 SUBROUTINE INT_NUC (IA, IB, SIG0, SIGEL)
2930C========================================================================
2931C. Multiple interaction structure
2932C========================================================================
2933C...Compute with a montecarlo code the "multiple interaction structure"
2934C. of a nucleus-nucleus interaction
2935C.
2936C. INPUT : IA = mass of target nucleus
2937C. IB = mass of projectile nucleus
2938C. SIG0 (mbarn) = inelastic pp cross section
2939C. SIGEL(mbarn) = elastic pp cross section
2940C.
2941C. OUTPUT : in common block /CNUCMS/
2942C. B = impact parameter (fm)
2943C. BMAX = maximum impact parameter for generation
2944C. NTRY = number of "trials" before one interaction
2945C. NA = number of wounded nucleons in A
2946C. NB = " " " in B
2947C. NI = number of nucleon-nucleon inelastic interactions
2948C. NAEL = number of elastically scattered nucleons in A
2949C. NBEL = " " " " in B
2950C. JJA(J) [J=1:IA] = number of inelastic interactions
2951C. of J-th nucleon of nucleus A
2952C. JJB(J) [J=1:IB] = number of inelastic interactions
2953C. of J-th nucleon of nucleus B
2954C. JJAEL(J) [J=1:IA] = number of elastic interactions
2955C. of J-th nucleon of nucleus A
2956C. JJBEL(J) [J=1:IB] = number of elastic interactions
2957C. of J-th nucleon of nucleus B
2958C. JJINT(J,K) [J=1:NB, K=1:NA] (0 = no interaction)
2959C. (1 = interaction )
2960C. between nucleon J of A and K of B
2961C-----------------------------------------------------------------------------
2962 PARAMETER (IAMAX=56)
2963 COMMON /CNUCMS/ B, BMAX, NTRY, NA, NB, NI, NAEL, NBEL
2964 + ,JJA(IAMAX), JJB(IAMAX), JJINT(IAMAX,IAMAX)
2965 + ,JJAEL(IAMAX), JJBEL(IAMAX)
2966 DIMENSION XA(IAMAX), YA(IAMAX), XB(IAMAX), YB(IAMAX)
2967 DATA PI /3.1415926/
2968 SIGT = SIG0 + SIGEL
2969 R2 = 0.1 * SIG0/PI
2970 R2T = 0.1 * SIGT/PI
2971 BMAX = 15. ! fm
2972 NTRY = 0
2973 CALL NUC_CONF (IA, XA, YA)
2974 CALL NUC_CONF (IB, XB, YB)
2975 NI = 0
2976 NIEL = 0
2977 DO JA=1,IA
2978 JJA(JA) = 0
2979 JJAEL(JA) = 0
2980 ENDDO
2981 DO JB=1,IB
2982 JJB(JB) = 0
2983 JJBEL(JB) = 0
2984 DO JA=1,IA
2985 JJINT(JB,JA) = 0
2986 ENDDO
2987 ENDDO
29881000 B = BMAX*SQRT(RNDM(0))
2989 PHI = 2.*PI*RNDM(0)
2990 BX = B*COS(PHI)
2991 BY = B*SIN(PHI)
2992 NTRY = NTRY+1
2993 DO JA=1,IA
2994 DO JB=1,IB
2995 S = (XA(JA)-XB(JB)-BX)**2 + (YA(JA)-YB(JB)-BY)**2
2996 IF (S .LT. R2) THEN
2997 NI = NI + 1
2998 JJA(JA) = JJA(JA)+1
2999 JJB(JB) = JJB(JB)+1
3000 JJINT(JB,JA) = 1
3001 ELSE IF (S .LT. R2T) THEN
3002 NIEL = NIEL + 1
3003 JJAEL(JA) = JJAEL(JA)+1
3004 JJBEL(JB) = JJBEL(JB)+1
3005 ENDIF
3006 ENDDO
3007 ENDDO
3008 IF (NI + NIEL .EQ. 0) GOTO 1000
3009 NA = 0
3010 NB = 0
3011 NAEL = 0
3012 NBEL = 0
3013 DO JA=1,IA
3014 IF (JJA(JA) .GT. 0) THEN
3015 NA = NA + 1
3016 ELSE
3017 IF (JJAEL(JA) .GT. 0) NAEL = NAEL+1
3018 ENDIF
3019 ENDDO
3020 DO JB=1,IB
3021 IF (JJB(JB) .GT. 0) THEN
3022 NB = NB + 1
3023 ELSE
3024 IF (JJBEL(JB) .GT. 0) NBEL = NBEL+1
3025 ENDIF
3026 ENDDO
3027 RETURN
3028 END
3029
3030 subroutine invert_array (yy, xmin, dx, n, xnew, ymin, dy)
3031C.. This subroutine receives one array
3032C of n y values in input yy(1:n)
3033C that correspond to equispaced values of x_j = xmin + dx*(j-1)
3034C
3035C and "reverse" the array returning an array of x values
3036C xnew (1:n) that corresponds to equispaced values of y
3037C The relation is assumed monotonous but can be
3038C increasing or decreasing
3039C..............................................................
3040 dimension yy(n), xnew (n)
3041 ymin = yy(1)
3042 ymax = yy(n)
3043 dy = (ymax - ymin)/float(n-1)
3044 xnew (1) = xmin
3045 xnew (n) = xmin + dx*float(n-1)
3046 k0 = 1
3047 do j=2,n-1
3048 y = ymin + float(j-1)*dy
3049 do k=k0,n
3050 if((yy(k) .gt. y) .eqv. (yy(n) .gt. yy(1))) goto 100
3051 enddo
3052100 y2 = yy(k)
3053 y1 = yy(k-1)
3054 k0 = k-1
3055 x1 = xmin + dx*float(k-2)
3056 x2 = x1+dx
3057 xnew (j) = x1 + dx* (y-y1)/(y2-y1)
3058 enddo
3059 return
3060 end
3061 SUBROUTINE JET_FRAG (X1J,X2J,PTJET)
3062C....Fragmentation of a jet-jet system
3063C. Input : Kinematical variables of a
3064C. jet-jet system
3065C............................................
3066 REAL*8 DX1J, DX2J, DBETJ
3067 COMMON /S_PLIST/ NP, P(5000,5), LLIST(5000)
3068 COMMON /S_RUN/ SQS, S, Q2MIN, XMIN, ZMIN , kb ,kt
3069 COMMON /S_CHIST/ NW,NJET,NNJET(15),XX1JET(100)
3070 + ,XX2JET(100),PPTJET(100),PHIJET(100),NNPJET(100),NNPSTR(30)
3071 + ,JDIF, EMXB, EMXT
3072 DATA PGG /1./
3073 E0 = SQRT(S*X1J*X2J)
3074 TH = ASIN(MIN(0.999999,2.*PTJET/E0))
3075 FI = 6.283185*RNDM(0)
3076 NOLD = NP
3077 IF ( (E0.LT.8.) .OR. (RNDM(0).GT.PGG)) THEN
3078 IS = -1 + 2.*INT(1.9999*RNDM(0))
3079 IFL1 = IS*(INT((2.+0.3)*RNDM(0))+1)
3080 CALL STRING_FRAG (E0,IFL1,-IFL1,0.,0.,0.,0.,IFBAD)
3081 ELSE
3082 CALL GG_FRAG(E0)
3083 ENDIF
3084 DX1J = X1J
3085 DX2J = X2J
3086 DBETJ = (DX1J-DX2J)/(DX1J+DX2J)
3087 CALL SIROBO (NOLD+1,NP,TH,FI,0.D0,0.D0,DBETJ)
3088 NNPJET (NJET) = NP-NOLD
3089 XX1JET (NJET) = X1J
3090 XX2JET (NJET) = X2J
3091 PPTJET (NJET) = PTJET
3092 PHIJET (NJET) = FI
3093 RETURN
3094 END
3095 SUBROUTINE JET_INI
3096C...Compute table of cross sections, and table of probability
3097C. for the production of N (jet pairs)
3098C. The OUTPUT of this routine is the COMMON block /CCSIG/
3099C. that contains the cross sections h-p, h-Air, and the
3100C. cumulative probability of n_jets.
3101C------------------------------------------------------------
3102 COMMON /S_CSIGINP/ QQ2MIN, SSQCD (51,2), SSQCD2 (51,2),SSIG0(2),
3103 @ factork(2),isfchoice
3104 COMMON /S_CCSIG2/ SSIG_TOT(51,2),SSIG_B(51,2)
3105 COMMON /S_CCSIG/ NSQS, ASQSMIN, ASQSMAX, DASQS,
3106 + SSIG(51,2), PJETC(0:20,51,2),SSIGN(51,2), ALINT(51,2)
3107 COMMON /S_RUN/ SQS, S, Q2MIN, XMIN, ZMIN , kb ,kt
3108 DIMENSION PJET (0:20)
3109
3110 DATA CMBARN /0.389385/
3111
3112 Q2MIN = QQ2MIN
3113 CALL FACT_INI ! Initialise the factorial
3114 CALL HAD_CONV ! Initialise profile convolution
3115
3116C...spacing in energy for the table of cross sections.
3117 NSQS = 51
3118 ASQSMIN = 1.
3119 ASQSMAX = 6.
3120 DASQS = (ASQSMAX-ASQSMIN)/FLOAT(NSQS-1)
3121
3122 DO KK=1,2
3123 JINT = KK
3124 DO J=1, NSQS
3125 ASQS = ASQSMIN + DASQS*FLOAT(J-1)
3126 if (isfchoice.eq.1) then
3127 SIG_QCD =factork(1)* SSQCD(J,KK)
3128 else if (isfchoice.eq.2) then
3129 SIG_QCD =factork(2)* SSQCD2(J,KK)
3130 endif
3131 SIG_SOFT = SSIG0(KK)
3132 CALL SIG_JET (SIG_QCD,SIG_SOFT,JINT,SIG_inel,PJET,
3133 + SIG_TOT,B_EL)
3134 SSIG(J,KK) = SIG_inel*CMBARN
3135c SSIG_TOT(J,KK) = SIG_TOT*CMBARN
3136c SSIG_B(J,KK) = B_EL
3137 PJETC (0,J,KK) = PJET(0)
3138 DO NJET=1,20
3139 PJETC(NJET,J,KK) = PJETC(NJET-1,J,KK) + PJET(NJET)
3140 ENDDO
3141 ENDDO
3142 ENDDO
3143 RETURN
3144 END
3145 SUBROUTINE KCODE (J,CODE,NC)
3146C...Produce the code for parton J
3147C. Input K, Output CODE, NC=number of characters
3148C..................................................
3149 CHARACTER*5 CODE
3150 CHARACTER*1 NAMQ(3)
3151 DATA NAMQ /'U','D','S'/
3152 CODE = ' '
3153 IF(J.EQ.0) THEN
3154 CODE(1:3) = 'GLU'
3155 NC = 3
3156 RETURN
3157 ENDIF
3158 JA = IABS(J)
3159 J1 = MOD(JA,10)
3160 J2 = (JA-J1)/10
3161 IF(JA .GT. 10) THEN
3162 CODE(1:1) = NAMQ(J2)
3163 CODE(2:2) = NAMQ(J1)
3164 NC = 2
3165 ELSE
3166 CODE(1:1) = NAMQ(J1)
3167 NC = 1
3168 ENDIF
3169 IF (J .LT. 0) THEN
3170 CODE(NC+1:NC+3) = 'bar'
3171 NC = NC+3
3172 ENDIF
3173 RETURN
3174 END
3175
3176 FUNCTION NJETR (K,SQS)
3177C...Generate a number of jet-pairs for a 'projectile'
3178C. (K=1:p),(K=2:pi) interacting with a nucleon at sqrt(s)=SQS(GeV)
3179C..................................................................
3180 COMMON /S_CCSIG/ NSQS, ASQSMIN, ASQSMAX, DASQS,
3181 + SSIG(51,2), PJETC(0:20,51,2),SSIGN(51,2), ALINT(51,2)
3182 AL = LOG10 (SQS)
3183 IF (AL .LT. ASQSMIN) THEN
3184 NJETR = 0
3185 RETURN
3186 ENDIF
3187 IF (AL .GT. ASQSMAX) THEN
3188 WRITE(*,*) ' NJETR: sqrt(s) out of bounds ', SQS
3189 NJETR = 0
3190 RETURN
3191 ENDIF
3192 J1 = (AL - ASQSMIN)/DASQS + 1
3193C D.H.
3194 J1 = MIN(J1,50)
3195 J1 = MAX(J1,1)
3196
3197 J2 = J1+1
3198 T = (AL-ASQSMIN)/DASQS - FLOAT(J1-1)
3199 R = 0.999*RNDM(0)
3200 DO J=0,20
3201 IF (R .LT. (1.-T)*PJETC(J,J1,K)+T*PJETC(J,J2,K)) GOTO 100
3202 ENDDO
3203100 NJETR = J
3204 RETURN
3205 END
3206 SUBROUTINE NUC1_PROFIL (AA)
3207C...Compute the profile function T(b)
3208C. normalised as INT[d2b T(b) = 1]
3209C. INPUT : AA = mass number of nucleus
3210C...............................................
3211 PARAMETER (NB=401)
3212 EXTERNAL DENSA
3213 COMMON /CC01/ B
3214 COMMON /CCDA/ JJA
3215 COMMON /CPROF/ DB, BMAX, BB(NB), TB(NB), A
3216 A = AA
3217 IA1 = INT(AA)
3218 IA2 = IA1 + 1
3219 U = AA - FLOAT(IA1)
3220 BMAX = 7.5
3221 DB = BMAX/FLOAT(NB-1)
3222 DO JB=1,NB
3223 B = DB*FLOAT(JB-1)
3224 BB(JB) = B
3225 IF (A .LE. 18.) THEN
3226 T1 = PROFNUC (B, IA1)
3227 T2 = PROFNUC (B, IA2)
3228 ELSE
3229 JJA = IA1
3230 T1 = 2.*GAUSS (DENSA,0.,BMAX)
3231 JJA = IA2
3232 T2 = 2.*GAUSS (DENSA,0.,BMAX)
3233 ENDIF
3234 TB(JB) = (1.-U)*T1 + U*T2
3235 ENDDO
3236 RETURN
3237 END
3238
3239 SUBROUTINE NUC_CONF (IA, XX, YY)
3240C...This routine generates the configuration of a nucleus
3241C. need an initialization call to NUC_GEOM_INI
3242C.
3243C. INPUT : IA = mass number of the nucleus
3244C. OUTPUT : XX(1:IA), YY(1:IA) (fm) = position in impact parameter
3245C. space of the IA nucleons
3246C...................................................................
3247 PARAMETER (IAMAX=56)
3248 DIMENSION XX(IAMAX), YY(IAMAX)
3249 PARAMETER (NB=401)
3250 COMMON /CPROFA/ ZMIN, DZ, BBZ(NB,IAMAX)
3251 DATA PI /3.1415926/
3252 DO J=1,IA
3253 Z = RNDM(0)
3254 JZ = INT((Z-ZMIN)/DZ)+1
3255C D.H.
3256 JZ = MIN(JZ,400)
3257
3258 T = (Z-ZMIN)/DZ - FLOAT(JZ-1)
3259 B = BBZ(JZ,IA)*(1.-T) + BBZ(JZ+1,IA)*T
3260 PHI = 2.*PI*RNDM(0)
3261 XX(J) = B*COS(PHI)
3262 YY(J) = B*SIN(PHI)
3263 ENDDO
3264 RETURN
3265 END
3266
3267 SUBROUTINE NUC_GEOM_INI
3268C...Initialize all nucleus profiles
3269 PARAMETER (NB=401)
3270 PARAMETER (IAMAX=56)
3271 COMMON /CPROF/ DB, BMAX, BB(NB), TB(NB), A
3272 COMMON /CPROFA/ ZMIN, DZ, BBZ(NB,IAMAX)
3273 DIMENSION FFB(NB), GGB(NB)
3274 DATA PI /3.1415926/
3275 CALL SHELL_INI
3276 CALL WOOD_SAXON_INI
3277 DO IA= 2,IAMAX
3278 JA = IA
3279 CALL NUC_PROFIL(JA)
3280 DO K=1,NB
3281 FFB(K) = BB(K)*TB(K) * (2.*PI)
3282 ENDDO
3283 GGB(1) = 0.
3284 GGB(NB) = 1.
3285 DO K=2,NB-1
3286 GGB(K) = GGB(K-1) + FFB(K-1)*DB
3287 ENDDO
3288 CALL INVERT_ARRAY(GGB,0.,DB,NB, BBZ(1,IA), ZMIN, DZ)
3289 ENDDO
3290 RETURN
3291 END
3292
3293 SUBROUTINE NUC_NUC_INI
3294C...Initialization for the generation of nucleus-nucleus interactions
3295C. INPUT : E0 (TeV) Energy per nucleon of the beam nucleus
3296C........................................................................
3297 CALL NUC_GEOM_INI ! nucleus profiles
3298 CALL SIGMA_INI ! initialize pp cross sections
3299 RETURN
3300 END
3301 SUBROUTINE NUC_PROFIL (JA)
3302C...Compute the profile function T(b)
3303C. normalised as INT[d2b T(b) = 1]
3304C. INPUT : JA = integer mass number of nucleus
3305C...............................................
3306 PARAMETER (NB=401)
3307 EXTERNAL DENSA
3308 COMMON /CC01/ B
3309 COMMON /CCDA/ JJA
3310 COMMON /CPROF/ DB, BMAX, BB(NB), TB(NB), A
3311 BMAX = 7.5
3312 DB = BMAX/FLOAT(NB-1)
3313 JJA = JA
3314 A = JA
3315 DO JB=1,NB
3316 B = DB*FLOAT(JB-1)
3317 BB(JB) = B
3318 IF (JA .LE. 18) THEN
3319 TB(JB) = PROFNUC (B, JA)
3320 ELSE
3321 TB(JB) = 2.*GAUSS (DENSA,0.,BMAX)
3322 ENDIF
3323 ENDDO
3324 RETURN
3325 END
3326
3327 FUNCTION OMEGAP (B, SIG, SLOPE, RHO)
3328 COMMON /CA0SH/ A0, A02
3329 DATA PI /3.1415926/
3330 ETA2 = 0.25*(A02 + SLOPE)
3331 F02 = SIG*SIG*(1.+RHO*RHO)/(16.*PI**2)
3332 ARG = -B*B/(4.*ETA2)
3333 OMEGAP=F02/(4.*ETA2*SLOPE)*(1.-A02/(6.*ETA2)*(1.+ARG))*EXP(ARG)
3334 RETURN
3335 END
3336
3337 FUNCTION OMEGAS (B, SIG, SLOPE, RHO)
3338 COMMON /CA0SH/ A0, A02
3339 DATA PI /3.1415926/
3340 ETA2 = 0.25*(A02 + SLOPE)
3341 F02 = SIG*SIG*(1.+RHO*RHO)/(16.*PI**2)
3342 ARG = -B*B/(4.*ETA2)
3343 OMEGAS = F02/(4.*ETA2*SLOPE) *EXP(ARG)
3344 RETURN
3345 END
3346 BLOCK DATA PARAM_INI
3347C....This block data contains default values
3348C. of the parameters used in fragmentation
3349C................................................
3350 COMMON /S_CZDIS/ FA, FB0
3351 COMMON /S_CZDISs/ FAs1, fAs2
3352 COMMON /S_CZLEAD/ CLEAD, FLEAD
3353 COMMON /S_CPSPL/ CCHIK(3,7:14)
3354 COMMON /S_CQDIS/ PPT0 (33),ptflag
3355 COMMON /S_CDIF0/ FFD, FBD, FDD
3356 COMMON /S_CFLAFR/ PAR(8)
3357 COMMON/S_cutof/stringmas0
3358 data stringmas0/.35/
3359C...Diffraction
3360c not used in this version.DATA FFD /0.09/, FBD /0.09/, FDD /0.04/
3361c see function fdiffract
3362C...Longitudinal Fragmentation function
3363 DATA FA /0.5/, FB0 /0.8/
3364C...Longitudinal Fragmentation function for leading baryons
3365 DATA CLEAD /0.6/, FLEAD /0.6/
3366c strange fragmentation
3367 data FAs1 /3./, fAs2 /3./
3368c data FAs1 /0./, fAs2 /0./
3369C...pT of sea partons
3370 DATA PTFLAG /1./
3371 DATA PPT0 /0.30,0.30,0.450,30*0.60/
3372C...Splitting parameters
3373c DATA CCHIK /18*2.,1.5,2.5,2.5,1.5,2.5,2.5/
3374 DATA CCHIK /18*2.,6*3./
3375C...Parameters of flavor formation
3376 DATA PAR /0.04,0.25,0.25,0.14,0.3,0.3,0.15,0./
3377 END
3378 SUBROUTINE PARAM_PRINT(LUN)
3379 COMMON /S_CZDIS/ FA, FB0
3380 COMMON /S_CZLEAD/ CLEAD, FLEAD
3381 COMMON /S_CPSPL/ CCHIK(3,7:14)
3382 COMMON /S_RUN/ SQS, S, Q2MIN, XMIN, ZMIN , kb ,kt
3383 COMMON /S_CQDIS/ PPT0 (33),ptflag
3384 COMMON /S_CDIF0/ FFD, FBD, FDD
3385 COMMON /S_CFLAFR/ PAR(8)
3386
3387 WRITE (LUN, 25)
338825 FORMAT( //,1x,40('-'), /
3389 + ' SIBYLL MONTECARLO PROGRAM. Version 1.00',/,1x,40('-'),/
3390 + ' List of parameters: ' )
3391
3392 WRITE (LUN, 27) FFD, FBD, FDD
339327 FORMAT(' Fraction of beam/target/double diffraction = ',
3394 + 3F8.3)
3395
3396 WRITE (LUN, 28) Q2MIN
339728 FORMAT (' Q2min = ', F10.2, ' GeV**2 ')
3398 WRITE (LUN, 31) FA, FB0
339931 FORMAT (' Parameters of longitudinal fragmentation: ', /,
3400 + ' f(z) = (1-z)**a * exp(-b * mt**2/z) ', /,
3401 + ' a = ', f9.3, 3x, ' b = ', f9.3, ' GeV**-2' )
3402 WRITE (LUN, 32) CLEAD, 1./FLEAD-1.
340332 FORMAT (' Parameters of leading fragmentation: ', /,
3404 + ' f(z) = c + (1-z)**a ', /,
3405 + ' c = ',f9.3,3x,' a = ',f9.3)
3406
3407 WRITE (LUN, 35) PPT0(1), PPT0(3), PPT0(11),ppt0(10)
340835 FORMAT (' <pT> of sea partons ', /,
3409 + 2x,'<pT>(u/d) ',F8.3,2x,'<pT>(s) ',f8.3,2x,'<pT>(qq) ',f8.3,
3410 + 2x,'<pT>(val) ',f8.3)
3411
3412 WRITE (LUN, 120) PAR
3413120 FORMAT (1x, 'Parameters of flavor formation: ',/,
3414 + 3x,'PAR(1) = Prob(qq)/Prob(q) = ',F10.2,/,
3415 + 3x,'PAR(2) = Prob(s)/Prob(u) = ',F10.2,/,
3416 + 3x,'PAR(3) = Prob(us)/Prob(ud) = ',F10.2,/,
3417 + 3x,'PAR(4) = Prob(ud_0)/Prob(ud_1) = ',F10.2,/,
3418 + 3x,'PAR(5) = Prob(Vector)/Prob(Scalar) = ',F10.2,/,
3419 + 3x,'PAR(6) = Prob(K*)/Prob(K) = ',F10.2,/,
3420 + 3x,'PAR(7) = Prob(spin 3/2)/Prob(spin=1/2) = ',F10.2,/,
3421 + 3x,'PAR(8) = Prob(B-M-Bbar)/Prob(B-Bbar) = ',F10.2)
3422
3423 WRITE (LUN, 40)
3424 WRITE (LUN, 41) CCHIK (1,13), CCHIK(2,13)
342540 FORMAT(' Parameters of hadron splitting ' )
342641 FORMAT(' p -> [(ud) u] splitting: alpha = ', F10.3, /,
3427 + ' p -> [(uu) d] splitting: alpha = ', F10.3 )
3428
3429 RETURN
3430 END
3431 FUNCTION PARTON(X,L)
3432C...This function returns the structure function
3433C. f(x) = x * [ g(x) + 4/9 *(q(x) + qbar(x)) ]
3434C. for a proton. In COMMON /S_CSTR/ JSTR controls
3435C. the choice of structure function
3436C................................................
3437 COMMON /S_CSTR/ JSTR, JSTRPI
3438C O. Palamara 27/8/1993
3439c parameter beta=1.925978
3440 parameter (beta=1.925978)
3441 IF (L .EQ. 2) GOTO 1000
3442
3443C...Eichten et al. (set 1)
3444100 uv = 1.78 * x**0.5 * (1.-x**1.51)**3.5
3445 dv = 0.67 * x**0.4 * (1.-x**1.51)**4.5
3446 us = 0.182 * (1.-x)**8.54
3447 ss = 0.081 * (1.-x)**8.54
3448 qq0 = uv + dv + 4.*us + 2.*ss
3449 glu0 = (2.62 + 9.17*x)* (1.-x)**5.90
3450 parton = glu0 + 4./9.*qq0
3451 return
3452
3453
34541000 continue ! goto (1100,1200), jstrpi
3455
3456C...Owens set 1 from STRF from Wisc. Pheno. group. for q2=q2_min
3457 AV=.4
3458 BV=.7
3459c BETA=GGAMMA(AV)*GGAMMA(BV+1.)/GGAMMA(AV+BV+1.) =1.925978
3460 uv=X**(AV)*(1.-X)**BV/BETA
3461 dv=uv
3462c
3463 A=.9
3464 BET=5.
3465 us=(A*(1.-X)**BET)/6.
3466c
3467 A=.888
3468 BET=3.11
3469 GA1=6.0
3470 glu0=A*(1.-X)**BET*(1.+GA1*X)
3471c Bug Fix thanks to Sue Kashahara- correct factor in front of
3472c sea quarks for Owens S.F. 5-94
3473 qq0 = uv + dv + 6.*us
3474 parton = (glu0 + 4./9.*qq0)
3475 return
3476 end
3477
3478 FUNCTION PART_INT (ZMIN,L)
3479C...This function returns as output the integral of
3480C. the parton structure function:
3481C. f(x) = g(x) + 4/9 *(q(x) + qbar(x))
3482C. from xmin = exp(zmin) to 1
3483C. for a proton (L=1) or a pi (L=2)
3484C. needs to be initialised with: CALL ZSAMPLE_INI
3485C.....................................................
3486 COMMON /S_CZGEN/ XA,XB,XMAX,ZA,ZB,ZMAX,DX,DZ,NX,NZ,APART(2),
3487 + FFA(2),FFB(2),
3488 + DFX(2),DFZ(2),XX(200,2),ZZ(200,2),FFX(200,2),FFZ(200,2)
3489
3490C D.H.IF (ZMIN .LT. ZA) THEN
3491 IF (ZMIN .LE. ZA) THEN
3492 PART_INT = FFA(L) + APART(L)*(ZA-ZMIN)
3493C D.H.ELSE IF (ZMIN .LT. ZB) THEN
3494 ELSE IF (ZMIN .LE. ZB) THEN
3495 JZ = (ZB-ZMIN)/DZ+1
3496 Z0 = ZB-DZ*FLOAT(JZ-1)
3497 T = (Z0-ZMIN)/DZ
3498 PART_INT = FFZ(JZ,L)*(1.-T) + FFZ(JZ+1,L)*T
3499 ELSE
3500 X = EXP(ZMIN)
3501 JX = (XMAX-X)/DX+1
3502 X0 = XMAX-DX*FLOAT(JX-1)
3503 T = (X0-X)/DX
3504 PART_INT = FFX(JX,L)*(1.-T) + FFX(JX+1,L)*T
3505 ENDIF
3506 RETURN
3507 END
3508 SUBROUTINE PJET_PRINT (L,SQS, LUN)
3509C...Write the jet probability:
3510C. L = particle code, SQS = sqrt(s), LUN = unit of output
3511C..................................................................
3512 COMMON /S_CCSIG/ NSQS, ASQSMIN, ASQSMAX, DASQS,
3513 + SSIG(51,2), PJETC(0:20,51,2),SSIGN(51,2), ALINT(51,2)
3514 DIMENSION LL(7:14)
3515 DATA LL /6*2,2*1/
3516 AL = LOG10 (SQS)
3517 IF (AL .LT. ASQSMIN .OR. AL .GT. ASQSMAX) RETURN
3518
3519 K = LL(IABS(L))
3520 J1 = (AL - ASQSMIN)/DASQS + 1
3521 J2 = J1+1
3522 T = (AL-ASQSMIN)/DASQS - FLOAT(J1-1)
3523 R = 0.999*RNDM(0)
3524 J = 0
3525 P = (1.-T)*PJETC(0,J1,K)+T*PJETC(0,J2,K)
3526 WRITE (LUN, 20)
3527 WRITE (LUN, 25) J, P
3528 AMED = 0.
3529 ASUM = P
3530 DO J=0,19
3531 PA = (1.-T)*PJETC(J,J1,K)+T*PJETC(J,J2,K)
3532 PB = (1.-T)*PJETC(J+1,J1,K)+T*PJETC(J+1,J2,K)
3533 P = PB-PA
3534 IF (P .GT. 1.E-04) WRITE (LUN, 25) J+1, P
3535 AMED = AMED + FLOAT(J+1)*P
3536 ASUM = ASUM + P
3537 ENDDO
3538 WRITE (LUN, 26) AMED, ASUM
3539 RETURN
354020 FORMAT (/,' Minijet expected frequencies: ')
354125 FORMAT (' n(jet-pairs) = ',i3, F12.4)
354226 FORMAT (' <n(jet-pairs)> = ',F10.2, ' norm = ', F9.3)
3543 END
3544 FUNCTION PROFNUC (B, JA)
3545C...This function return
3546C. the profile T(b) for a nucleus of mass number A
3547C. INPUT B = impact parameter (GeV**-1)
3548C. JA = integer mass number
3549C. OUTPUT (fm**-2)
3550C.
3551C. The density of the nucleus is the `shell model density'
3552C. the parameter r0 must beinitialized in the common block
3553C.............................................................
3554 COMMON /CSHELL/ RR0(18), RR02(18)
3555 DATA PI /3.1415926/
3556 B2 = B*B
3557 ARG = B2/RR02(JA)
3558 TS = EXP(-ARG)
3559 TP = TS*(2.*B2+RR02(JA))/(3.*RR02(JA))
3560 CS = MIN(1.,4./FLOAT(JA))
3561 PROFNUC = (CS*TS + (1.-CS)*TP)/(PI*RR02(JA))
3562 RETURN
3563 END
3564
3565 SUBROUTINE PTDIS (IFL,PX,PY)
3566C...Generate pT
3567 COMMON /S_CQDIS/ PPT0(33),ptflag
3568 PT = PPT0(IABS(IFL))*SQRT(-ALOG(MAX(1E-10,RNDM(0))))
3569 PHI= 6.2831853*RNDM(0)
3570 PX=PT*COS(PHI)
3571 PY=PT*SIN(PHI)
3572 RETURN
3573 END
3574 FUNCTION QMASS(IFL)
3575C...Return quark or diquark constituent masses
3576 DIMENSION QMAS(3)
3577 DATA QMAS /0.325,0.325,0.5/
3578 IFLA = IABS(IFL)
3579 IF (IFLA .LE. 3) THEN
3580 QMASS = QMAS(IFLA)
3581 ELSE
3582 QMA = QMAS(IFLA/10)
3583 QMB = QMAS(MOD(IFLA,10))
3584 QMASS = QMA+QMB
3585 ENDIF
3586 RETURN
3587 END
3588 SUBROUTINE QNUM (JQ,JS,JB,JBA, NC, NF)
3589C...Return the quantum numbers of one event
3590C. JQ = charge, JB = baryon number, JS = strangeness
3591C. JBA = (number of baryons+antibaryons)
3592C. NC = number of charged particles
3593C. NF = number of final particles
3594C..................................................
3595 COMMON /S_PLIST/ NP, P(5000,5), LLIST(5000)
3596 COMMON /S_CHP/ ICHP(49), ISTR(49), IBAR(49)
3597 JQ = 0
3598 JB = 0
3599 JS = 0
3600 JBA= 0
3601 NC = 0
3602 NF = 0
3603 DO J=1,NP
3604 L = LLIST(J)
3605 LL = IABS(L)
3606 IF (LL .LT. 10000) THEN
3607 IF(ICHP(LL) .NE. 0) NC = NC + 1
3608 NF = NF + 1
3609 JQ = JQ + ICHP(LL)*ISIGN(1,L)
3610 JB = JB + IBAR(LL)*ISIGN(1,L)
3611 JBA= JBA+ IBAR(LL)
3612 JS = JS + ISTR(LL)*ISIGN(1,L)
3613 ENDIF
3614 ENDDO
3615 RETURN
3616 END
3617 FUNCTION QUAD_INT (R,X0,X1,X2,V0,V1,V2)
3618c quadratic interpolation?
3619 R0=R-X0
3620 R1=R-X1
3621 R2=R-X2
3622 S0=X0-X1
3623 S1=X0-X2
3624 S2=X1-X2
3625 QUAD_INT = V0*R1*R2/(S0*S1)-V1*R0*R2/(S0*S2)+V2*R0*R1/(S1*S2)
3626 RETURN
3627 END
3628
3629 function rdis(idummy)
3630 dimension probr(20)
3631 data probr/
3632 * 0.10000, 0.15748, 0.21778, 0.28605, 0.36060,
3633 * 0.43815, 0.51892, 0.60631, 0.70002, 0.79325,
3634 * 0.88863, 0.98686, 1.10129, 1.21202, 1.32932,
3635 * 1.44890, 1.57048, 1.70139, 1.83417, 2.00000/
3636 nr = 20.*RNDM(0) + 1
3637 if (nr .eq. 1) then
3638 f1 = 0.
3639 else
3640 f1 = probr(nr-1)
3641 endif
3642 dr = probr(nr) - f1
3643 rdis = f1 + dr*RNDM(0)
3644 return
3645 end
3646 SUBROUTINE SAMPLE (L, X1,X2,PT)
3647C...Routine for the sampling the kinematical variables
3648C. that determine a jet-jet system (x1,x2, pT)
3649C. from the differential cross section:
3650C. d3sigma/(dx1 dx2 dpT)
3651C. This version assumes the `single parton approximation'
3652C. INPUT: L=1 incident proton, L=2 incident pi
3653C. OUTPUT: X1, X2, PT (GeV)
3654C.................................................................
3655 COMMON /S_RUN/ SQS, S, Q2MIN, XMIN, ZMIN , kb ,kt
3656100 Z1=ZSAMPLE (ZMIN,L)
3657 Z2=ZSAMPLE (ZMIN,1)
3658 SIG=1.-XMIN*EXP(-Z1-Z2)
3659 IF (SIG .LT. RNDM(0)) GOTO 100
3660 X1=EXP(Z1)
3661 X2=EXP(Z2)
3662 Q2=Q2MIN/(1.-RNDM(0)*SIG)
3663 PT=SQRT(Q2*(1.-Q2/(S*X1*X2)))
3664 RETURN
3665 END
3666 FUNCTION SHELL (R,JA)
3667C...Density in the shell model
3668 COMMON /CSHELL/ RR0(18), RR02(18)
3669 DATA PI /3.1415926/
3670 R0 = RR0(JA)
3671 C1 = MIN(1.,4./FLOAT(JA))
3672 CS = 1./(R0**3*PI**(1.5))
3673 CP = 2.*CS/3.
3674 FS = EXP(-(R/R0)**2)
3675 FP = (R/R0)**2 * FS
3676 SHELL = C1*CS*FS + (1.-C1)*CP*FP
3677 RETURN
3678 END
3679
3680 SUBROUTINE SHELL_INI
3681C...Initialize the parameter of the shell model
3682C. for the nuclei with 6 < A < 18
3683C..............................................
3684 COMMON /CSHELL/ RR0(18), RR02(18)
3685 DIMENSION RR(18)
3686C...Data on Sqrt[<r**2>] in fermi
3687 DATA RR /0.81,2.095,1.88,1.674, -1.,2.56,2.41,-1.,2.519,2.45
3688 + ,2.37, 2.460, 2.440, 2.54, 2.58, 2.718, 2.662,2.789 /
3689 DO JA=1,18
3690 A = FLOAT(JA)
3691 RMED = RR(JA)
3692 IF (RMED .LE. 0.) RMED = 0.5*(RR(JA-1) + RR(JA+1))
3693 C = MAX(1.5,(5./2. - 4./A) )
3694 R0 = RMED/SQRT(C)
3695 RR0 (JA) = R0
3696 RR02(JA) = R0*R0
3697 ENDDO
3698 RETURN
3699 END
3700 SUBROUTINE SIBLIST(LUN)
3701C...This routine prints the event record for the
3702C. current event on unit LUN
3703C.................................................
3704 COMMON /S_PLIST/ NP, P(5000,5), LLIST(5000)
3705 COMMON /S_PLIST1/ LLIST1(5000)
3706 COMMON /S_RUN/ SQS, S, Q2MIN, XMIN, ZMIN , kb ,kt
3707 COMMON /S_CHIST/ NW,NJET,NNJET(15),XX1JET(100)
3708 + ,XX2JET(100),PPTJET(100),PHIJET(100),NNPJET(100),NNPSTR(30)
3709 + , JDIF, EMXB, EMXT
3710 COMMON /S_CCSTR/ X1(30),X2(30),IFLB(30),IFLT(30),PXB(30),
3711 + PYB(30),PXT(30),PYT(30)
3712 COMMON /S_CNAM/ NAMP (0:49)
3713 CHARACTER*6 NAMP
3714 CHARACTER CODE*18, COD1*5, COD2*5
3715 CHARACTER*18 NAMDIF(3)
3716 DATA NAMDIF /'Beam diffraction ','Target diffraction',
3717 + 'Double diffraction'/
3718* WRITE (LUN,*)
3719 WRITE (LUN,*) ' Event record '
3720 WRITE (LUN,100)
3721 IF(JDIF .GT. 0) THEN
3722 WRITE (LUN,*) ' ',NAMDIF(JDIF)
3723 GOTO 10
3724 ENDIF
3725 NA = -(NJET+2*NW+1)
3726 N = 0
3727 DO J=1,NJET
3728 NA = NA+1
3729 DO K=1,NNPJET(J)
3730 N=N+1
3731 LLIST1(N) = NA
3732 ENDDO
3733 ENDDO
3734 DO J=1,2*NW
3735 NA = NA+1
3736 DO K=1,NNPSTR(J)
3737 N=N+1
3738 LLIST1(N) = NA
3739 ENDDO
3740 ENDDO
3741C...Jet-Jet strings
3742 K = 0
3743 JA = -(NJET+2*NW+1)
3744 DO J=1,NJET
3745 JA = JA+1
3746 CODE = 'Jet-Jet '
3747 PX = PPTJET(J)
3748 PY = 0.
3749 PZ = SQS*(XX1JET(J)-XX2JET(J))
3750 EE = SQS*(XX1JET(J)+XX2JET(J))
3751 WRITE (LUN,120) JA, CODE, K, PX,PY,PZ,EE
3752 ENDDO
3753C...Beam strings
3754 DO J=1,2*NW
3755 JA = JA+1
3756 CALL KCODE(IFLT(J),COD1,NC1)
3757 CALL KCODE(IFLB(J),COD2,NC2)
3758 CODE(1:7) = 'String '
3759 CODE(7+1:18) = ' '
3760 CODE(7+1:7+6)=COD1
3761 CODE(NC1+1+7:NC1+1+7) = '-'
3762 CODE(NC1+2+7:NC1+6+7) = COD2
3763 PX = PXB(J)+PXT(J)
3764 PY = PYB(J)+PYT(J)
3765 PZ = SQS*(X1(J)-X2(J))
3766 EE = SQS*(X1(J)+X2(J))
3767 WRITE (LUN,120) JA, CODE, K, PX,PY,PZ,EE
3768 ENDDO
3769C...Print particle list
377010 DO J=1,NP
3771 L = MOD(LLIST(J),10000)
3772 CODE = ' '
3773 CODE(1:6) = NAMP(IABS(L))
3774 IF (L .LT. 0) CODE(7:9) = 'bar'
3775 IF(IABS(LLIST(J)) .GT. 10000) CODE(10:10) = '*'
3776 WRITE (LUN,120) J, CODE, LLIST1(J), (P(J,K),K=1,4)
3777 ENDDO
3778 CALL ESUM(1,NP,EE,PX,PY,PZ,NF)
3779 WRITE(LUN,140) PX,PY,PZ,EE
3780100 FORMAT(3X,'N Particle',12X,'Ori',6x,'PX',9x,'PY',9x,'PZ'
3781 + ,9x,'E', /, 3X,70('-'))
3782120 FORMAT(1X,I4,1X,A18,1X,I4,2X,2(F9.3,2X),2(E9.3,2X))
3783140 FORMAT(1X,'Tot = ',24X,2(F9.3,2X),G9.3,2X,E9.3)
3784 RETURN
3785 END
3786 SUBROUTINE SIBNUC (IAB, IAT, SQS)
3787C...Routine that generates the interaction of a nucleus of
3788C. mass number IAB with a target nucleus of mass IAT
3789C. (IAT=0 : air).
3790C. SQS (GeV) is the center of mass energy of each
3791C. nucleon - nucleon cross section
3792C---------------------------------------------------------------
3793 COMMON /S_PLIST/ NP, P(5000,5), LLIST(5000)
3794 COMMON /S_PLNUC/ NPA, PA(5000,5), LLA(5000)
3795 COMMON /S_MASS1/ AM(49), AM2(49)
3796 COMMON /CKFRAG/ KODFRAG
3797 PARAMETER (IAMAX=56)
3798 COMMON /CNUCMS/ B, BMAX, NTRY, NA, NB, NI, NAEL, NBEL
3799 + ,JJA(IAMAX), JJB(IAMAX), JJINT(IAMAX,IAMAX)
3800 + ,JJAEL(IAMAX), JJBEL(IAMAX)
3801 COMMON /FRAGMENTS/ PPP(3,60)
3802 DIMENSION IAF(60)
3803 DATA RPOX /0.3624/
3804
3805C...Target mass
3806 IF (IAT .EQ. 0) THEN
3807 IATARGET = 14 + 2*INT((1.+RPOX)*RNDM(0))
3808 ELSE
3809 IATARGET = IAT
3810 ENDIF
3811
3812C...Single nucleon (proton) case
3813 IF (IAB .EQ. 1) THEN
3814 NPA = 0
3815 CALL SIBYLL (13,IATARGET, SQS)
3816 CALL DECSIB
3817 DO J=1,NP
3818 LA = IABS(LLIST(J))
3819 IF (LA .LT. 10000) THEN
3820 NPA = NPA + 1
3821 LLA(NPA) = LLIST(J)
3822 DO K=1,5
3823 PA(NPA,K) = P(J,K) (J,K)
3824 ENDDO
3825 ENDIF
3826 ENDDO
3827 RETURN
3828 ENDIF
3829
3830
3831C...Nuclei
3832 E0 = (SQS*SQS-2.*AM2(13))/(2.*AM(13))
3833 E0 = E0*1.E-03 ! TeV
3834 CALL SIGMA_PP (E0, SIGT, SIGEL, SIG0, SLOPE, RHO)
3835 CALL INT_NUC (IATARGET, IAB, SIG0, SIGEL)
3836C...fragment the spectator nucleons
3837 NBT = NB + NBEL
3838 IF (KODFRAG .EQ. 1) THEN
3839 CALL FRAGM1(IAB,NBT, NF, IAF)
3840 ELSE IF(KODFRAG .EQ. 2) THEN
3841 CALL FRAGM2(IAB,NBT, NF, IAF)
3842 ELSE
3843 CALL FRAGM (IATARGET, IAB, NBT,B, NF, IAF)
3844 ENDIF
3845
3846C...Spectator fragments
3847 NPA = 0
3848 DO J=1,NF
3849 NPA = NPA+1
3850 LLA(NPA) = 1000+IAF(J)
3851 PA(NPA,1) = 0.
3852 PA(NPA,2) = 0.
3853 PA(NPA,3) = SQS/2.
3854 PA(NPA,4) = SQS/2.
3855 PA(NPA,5) = FLOAT(IAF(J))*0.5*(AM(13)+AM(14))
3856 ENDDO
3857C...Elastically scattered fragments
3858 DO J=1,NBEL
3859 NPA = NPA+1
3860 LLA(NPA) = 1001
3861 PA(NPA,1) = 0.
3862 PA(NPA,2) = 0.
3863 PA(NPA,3) = SQS/2.
3864 PA(NPA,4) = SQS/2.
3865 PA(NPA,5) = 0.5*(AM(13)+AM(14))
3866 ENDDO
3867C...Superimpose NB nucleon interactions
3868 DO JJ=1,NB
3869 CALL SIBYLL (13,IATARGET, SQS)
3870 CALL DECSIB
3871 DO J=1,NP
3872 LA = IABS(LLIST(J))
3873 IF (LA .LT. 10000) THEN
3874 NPA = NPA + 1
3875 LLA(NPA) = LLIST(J)
3876 DO K=1,5
3877 PA(NPA,K) = P(J,K)
3878 ENDDO
3879 ENDIF
3880 ENDDO
3881 ENDDO
3882 RETURN
3883 END
3884 SUBROUTINE SIBYLL (KB, IATARG, SQS)
3885C...Main routine for the production of hadronic events,
3886C. Generates an inelastic hadronic interaction of
3887C. a `projectile particle' of code KB with a
3888C. target nucleus of mass number A = IATARG (integer)
3889C. IATARG = 0 is an "air" nucleus (superposition of oxygen and nitrogen)
3890C. with c.m. energy for the hadron-nucleon system SQS (GeV)
3891C.
3892C. Allowed values of KB: 7,8,9,10,11,12,13,14,-13,-14
3893C. pi+-,K+-,KL,KS,p,n,pbar,nbar
3894C.
3895C. The output is contained in COMMON /S_PLIST/ that contains:
3896C.
3897C. NP number of final particles
3898C. P(1:NP, 1:5) 4-momenta + masses of the final particles
3899C. LLIST (1:NP) codes of final particles.
3900C. the reaction is studied in the c.m. of hadron-nucleon system
3901C.
3902C. The COMMON block /S_CHIST/ contains information about the
3903C. the structure of the generated event:
3904C. NW = number of wounded nucleons
3905C. NJET = number of jet pairs
3906C. NNJET (1:NW) = number of minijets produced in each interaction
3907C. XX1JET (1:NJET) = x1 for each jet-pair
3908C. XX2JET (1:NJET) = x2 " " "
3909C. PPTJET (1:NJET) = pT " " "
3910C. NNPJET (1:NJET) = total number of particles in each jet pair
3911C. NNPSTR (1:2*NW) = number of particles in each `beam string'
3912C. JDIF = diffraction code
3913C----------------------------------------------------------------------
3914 COMMON /S_PLIST/ NP, P(5000,5), LLIST(5000)
3915 COMMON /S_RUN/ SQSA, S, Q2MIN, XMIN, ZMIN , kbc ,kt
3916 COMMON /S_CHIST/ NW,NJET,NNJET(15),XX1JET(100),XX2JET(100)
3917 + ,PPTJET(100),PHIJET(100),NNPJET(100),NNPSTR(30)
3918 + ,JDIF, EMXB, EMXT
3919 COMMON /S_CLDIF/ LDIFF
3920 COMMON /S_CCSTR/ X1(30),X2(30),IFLB(30),IFLT(30),PXB(30),
3921 + PYB(30),PXT(30),PYT(30)
3922 COMMON /S_CQDIS/ PPT0 (33),ptflag
3923 DIMENSION QMAS(33),X2JET(30),LL(7:14),BET(30),GAM(30),EE(30)
3924 DATA QMAS
3925 . /2*0.35,0.6,7*0.,2*1.1,1.25,7*0.,1.25,1.1,1.25,7*0,2*1.25,1.5/
3926 DATA LL /6*2,2*1/
3927 DATA FOX /0.257/
3928 COMMON/S_cutof/stringmas0
3929
3930 kbc=kb
3931 SQSA = SQS
3932 S = SQS*SQS
3933 XMIN = 2.*Q2MIN/S
3934 ZMIN = LOG(XMIN)
3935
3936C...`soft increase of pT'
3937C Setting ptflag = 0 will result in
3938C underestimating the P_t at high energies.
3939 if (ptflag.gt.0.0) then
3940 ptu=.3+.08*log10(sqs/30.)
3941 pts=.45+.08*log10(sqs/30.)
3942 ptqq=.6+.08*log10(sqs/30.)
3943 PPT0 (1) = PTU
3944 PPT0 (2) = PTU
3945 PPT0 (3) = PTS
3946 PPT0 (10) = PTQQ
3947 DO J=11,33
3948 PPT0(J) = PTQQ
3949 ENDDO
3950 endif
3951
3952 NP = 0
3953 NJET = 0
3954 IATARGET = IATARG
3955C
3956C Generate an 'air' interaction by choosing Nitrogen or Oxygen
3957C
3958 IF (IATARGET .EQ. 0) THEN
3959 R = RNDM(0)
3960 IATARGET = 14
3961 IF (R .LT. FOX) IATARGET = 16
3962 ENDIF
3963 IATARG = IATARGET
3964 L = LL(IABS(KB))
3965C
3966C Generate number ow wounded nucleons, and diffraction code.
3967C
39681000 CALL SIB_START_EV (SQS,L,IATARGET, NW,JDIF)
3969 IF (LDIFF .NE. 0) THEN
3970 IF((LDIFF.EQ.-1) .AND. (JDIF.NE.0) ) GOTO 1000
3971 IF((LDIFF.EQ. 1) .AND. ((JDIF.NE.0).AND.(JDIF.NE.3)))
3972 + GOTO 1000
3973 IF((LDIFF.EQ. 5) .AND. (JDIF.EQ.2)) GOTO 1000
3974 IF((LDIFF.GE. 2) .AND. (LDIFF.LE.4)) THEN
3975 NW = 1
3976 JDIF = LDIFF-1
3977 ENDIF
3978 ENDIF
3979C...Diffractive interactions
3980 IF (JDIF .NE. 0) THEN
3981 CALL DIFF_GEN (KB, JDIF)
3982 RETURN
3983 ENDIF
3984
3985C...Non-diffractive interactions
39862000 L = LL(IABS(KB))
3987C...Production of minijets
39883000 NP = 0
3989 NJET = 0
3990 X1JET = 0.
3991 DO JW=1,NW
3992 NNJET (JW) = NJETR (L,SQS)
3993 X2JET(JW) = 0.
3994 DO JJ=1,NNJET(JW)
3995 NJET=NJET+1
3996 NOLD=NP
3997 CALL SAMPLE (L,X1J,X2J,PTJET)
3998 CALL JET_FRAG (X1J,X2J,PTJET)
3999 X1JET = X1JET + X1J
4000 X2JET(JW) = X2JET(JW)+X2J
4001 ENDDO
4002 IF (X2JET (JW) .GT. 0.7) GOTO 3000
4003 ENDDO
4004 IF (X1JET .GT. 0.7) GOTO 3000
4005C
4006C ...Prepare 2*NW color strings.
4007C
4008 CALL BEAM_SPLIT (KB, NW, X1, IFLB, X1JET, LXBAD,stringmas0)
4009C IF (LXBAD .EQ. 1) GOTO 2000 Bug fix 2-4-94 PL/RSF
4010 IF (LXBAD .EQ. 1) GOTO 1000
4011 DO J=1,NW
4012 J1=2*(J-1)+1
4013 J2=J1+1
4014 KT=13
4015 IF (IATARGET .GT. 1) KT = 13+INT(2.*RNDM(0))
4016 CALL HSPLI (KT,IFLT(J2),IFLT(J1))
4017 XMINA = 2.*stringmas0/(SQS*(1.-X2JET(J)))
4018C XMINA = 2.*0.20/(SQS*(1.-X2JET(J))) ! change RSF. 5-92
4019 CHI=CHIDIS (KT,IFLT(J2),IFLT(J1))
4020 XVAL=1.-X2JET(J)
4021 IF (XVAL.LT.XMINA) GOTO 3000
4022 X2(J2) = MAX(CHI*XVAL,XMINA)
4023 X2(J2) = MIN(X2(J2),XVAL-XMINA)
4024 X2(J1) = XVAL-X2(J2)
4025 ENDDO
4026C...Generates primordial pT for the partons
4027 DO J=1,NW
4028 J1 = 2*(J-1)+1
4029 J2 = J1+1
4030 CALL PTDIS (10,PXT(J1),PYT(J1))
4031 if (j.eq.1) then
4032 CALL PTDIS (10,PXB(J2),PYB(J2))
4033 else
4034 CALL PTDIS (IFLB(J2),PXB(J2),PYB(J2))
4035 endif
4036 PXB(J1) = -PXB(J2)
4037 PYB(J1) = -PYB(J2)
4038 PXT(J2) = -PXT(J1)
4039 PYT(J2) = -PYT(J1)
4040 ENDDO
4041C...Check consistency of kinematics
4042 DO J=1,2*NW
4043 EE(J) = SQS*SQRT(X1(J)*X2(J))
4044 XM1 = SQRT(PXB(J)**2+PYB(J)**2+QMAS(IABS(IFLB(J)))**2)
4045 XM2 = SQRT(PXT(J)**2+PYT(J)**2+QMAS(IABS(IFLT(J)))**2)
4046 IF (EE(J) .LT. XM1+XM2+0.3) GOTO 2000
4047 ENDDO
4048C...Fragment the 2*NW color strings
4049 DO J=1,2*NW
4050 EE (J) = SQS*SQRT(X1(J)*X2(J))
4051 BET(J) = (X1(J)-X2(J))/(X1(J)+X2(J))
4052 GAM(J) = (X1(J)+X2(J))/(2.*SQRT(X1(J)*X2(J)))
4053 NOLD=NP
4054 CALL STRING_FRAG
4055 + (EE(J),IFLB(J),IFLT(J),PXB(J),PYB(J),PXT(J),PYT(J),IFBAD)
4056 IF (IFBAD .EQ. 1) GOTO 2000
4057 DO K=NOLD+1,NP
4058 PZ = P(K,3)
4059 P(K,3) = GAM(J)*(PZ+BET(J)*P(K,4))
4060 P(K,4) = GAM(J)*(P(K,4)+BET(J)*PZ)
4061 ENDDO
4062 NNPSTR(J) = NP-NOLD
4063 ENDDO
4064
4065C...Check energy conservation
4066 CALL ESUM(1,NP,ETOT,PXT,PYT,PZT,NF)
4067 IF (ABS(ETOT/(0.5*SQS*FLOAT(NW+1)) - 1.) .GT. 1.E-03) THEN
4068 WRITE(*,*) ' Energy non conserved. L, SQS : ',L,SQS
4069 WRITE(*,*) ' sqs = ', SQS, ' E_f = ', ETOT
4070 WRITE(*,*) ' diff/N_w/N_j = ', JDIF, NW, NJET
4071 ENDIF
4072 RETURN
4073 END
4074
4075 SUBROUTINE SIBYLL_INI
4076C Initialization routine for the the routine
4077C. SYBILL for simulation of hadronic interactions
4078C.
4079C. the routine fills the COMMON block /CCSIG/ that contains
4080C. important information for the generation of events
4081C.
4082C* COMMON /S_CCSIG/ NSQS, ASQSMIN, ASQSMAX, DASQS,
4083C* + SSIG(51,2), PJETC(0:20,51,2),SSIGN(51,2), ALINT(51,2)
4084C.
4085C. NSQS = number of energy points (51 is current version)
4086C. ASQSMIN = log_10 [sqrt(s) GeV] minimum value
4087C. ASQSMIN = log_10 [sqrt(s) GeV] maximum value
4088C. DASQS = step in log_10[sqrt(s)]
4089C. DASQS = (ASQSMAX - ASQSMIN)/(NSQS-1)
4090C.
4091C. SSIG(J,1) inelastic cross section for pp interaction
4092C. at energy: sqrt(s)(GeV) = 10**[ASQSMIN+DASQS*(J-1)]
4093C. SSIG(J,2) inelastic cross section for pi-p interaction
4094C. SSIGN(J,1) inelastic cross section for p-Air interaction
4095C. SSIGN(J,2) inelastic cross section for pi-Air interaction
4096C.
4097C. PJETC(n_j,J,1) Cumulative probability distribution
4098C. for the production of n_j (n_j=0:20) jet pairs
4099C. at sqrt(s) labeled by J, for p-p interaction
4100C. PJETC(n_j,J,2) Same as above for pi-p interaction
4101C. ALINT(J,1) proton-air interaction length (g cm-2)
4102C. ALINT(J,2) pi-air interaction length (g cm-2)
4103C------------------------------------------------------------------
4104 WRITE(*,*) ' Initialization of the SIBYLL event generator '
4105 WRITE(*,100)
4106 100 FORMAT(' ','====================================================',
4107 * /,' ','| |',
4108 * /,' ','| S I B Y L L 1.6 |',
4109 * /,' ','| |',
4110 * /,' ','| HADRONIC INTERACTION MONTE CARLO |',
4111 * /,' ','| BY |',
4112 * /,' ','| R.S. FLETCHER, T.K. GAISSER |',
4113 * /,' ','| P. LIPARI, T. STANEV |',
4114 * /,' ','| |',
4115 * /,' ','| LAST MODIFICATIONS: Apr 15, 1997 by D. Heck |',
4116 * /,' ','====================================================',
4117 * /)
4118 CALL JET_INI
4119 CALL ZSAMPLE_INI
4120 CALL BLOCK_INI
4121 CALL NUC_GEOM_INI
4122 CALL SIG_AIR_INI
4123 RETURN
4124 END
4125 SUBROUTINE sib_SIGMA_HAIR (SQS,L0,SIGINEL)
4126C
4127C Sibyll P-air cross section
4128C
4129C...pi,p air cross sections
4130C. INPUT: SQS = c.m.s. energy (GeV)
4131C.
4132C. OUTPUT:
4133C. SIGINEL = inelastic cross section
4134C---------------------------------------------------------------------------
4135 COMMON /S_CCSIG/ NSQS, ASQSMIN, ASQSMAX, DASQS,
4136 + SSIG(51,2), PJETC(0:20,51,2),SSIGN(51,2), ALINT(51,2)
4137 AL = LOG10(SQS)
4138 J1 = (AL - 1.)*10. + 1
4139C D.H.
4140 J1 = MAX(J1,1)
4141 J1 = MIN(J1,50)
4142
4143 T = (AL-1.)*10. - FLOAT(J1-1)
4144 SIGINEL = SSIGN(J1,L0)*(1.-T) + SSIGN(J1+1,L0)*T
4145 RETURN
4146 END
4147 SUBROUTINE sib_SIGMA_PIP (SQS, SIGT, SIGEL, SIGINEL, SLOPE, RHO)
4148C...pip cross sections
4149C. INPUT: SQS = c.m.s. energy (GeV)
4150C.
4151C. OUTPUT: SIGT = total cross section
4152C. SIGEL = elastic cross section
4153C. SIGINEL = inelastic cross section
4154C. SLOPE = slope of elastic scattering (GeV**-2)
4155C. RHO = Imaginary/Real part of forward elastic scattering amplitude
4156C---------------------------------------------------------------------------
4157 COMMON /S_CCSIG/ NSQS, ASQSMIN, ASQSMAX, DASQS,
4158 + SSIG(51,2), PJETC(0:20,51,2),SSIGN(51,2), ALINT(51,2)
4159 DATA PI /3.1415926/
4160 DATA CMBARN /0.389385/
4161 AL = LOG10(SQS)
4162 J1 = (AL - 1.)*10. + 1
4163C D.H.
4164 J1 = MAX(J1,1)
4165 J1 = MIN(J1,50)
4166
4167 T = (AL-1.)*10. - FLOAT(J1-1)
4168 SIGINEL = SSIG(J1,2)*(1.-T) + SSIG(J1+1,2)*T
4169 CALL BLOCK(SQS,SIGT1,SIGT2,SLOP1,SLOP2,RHO1,RHO2,SIGEL1,SIGEL2)
4170 R = SIGEL1/SIGT1
4171 RHO = RHO1
4172 SIGT = SIGINEL/(1.-R)
4173 SIGEL = SIGINEL*R/(1.-R)
4174 SLOPE = SIGT**2/(SIGEL * 16.*PI) * (1.+RHO1**2) /CMBARN
4175 RETURN
4176 END
4177 SUBROUTINE sib_SIGMA_PP (SQS, SIGT, SIGEL, SIGINEL, SLOPE, RHO)
4178C...pp cross sections
4179C. INPUT: SQS = c.m.s. energy (GeV)
4180C.
4181C. OUTPUT: SIGT = total cross section
4182C. SIGEL = elastic cross section
4183C. SIGINEL = inelastic cross section
4184C. SLOPE = slope of elastic scattering (GeV**-2)
4185C. RHO = Imaginary/Real part of forward elastic scattering amplitude
4186C---------------------------------------------------------------------------
4187 COMMON /S_CCSIG/ NSQS, ASQSMIN, ASQSMAX, DASQS,
4188 + SSIG(51,2), PJETC(0:20,51,2),SSIGN(51,2), ALINT(51,2)
4189 COMMON /S_CCSIG2/ SSIG_TOT(51,2),SSIG_B(51,2)
4190 DATA PI /3.1415926/
4191 DATA CMBARN /0.389385/
4192 common/s_icr/icross_fit
4193 ICROSS_FIT = 1
4194 AL = LOG10(SQS)
4195 J1 = (AL - 1.)*10. + 1
4196C D.H.
4197 J1 = MAX(J1,1)
4198 J1 = MIN(J1,50)
4199
4200 T = (AL-1.)*10. - FLOAT(J1-1)
4201 SIGINEL = SSIG(J1,1)*(1.-T) + SSIG(J1+1,1)*T
4202 IF (ICROSS_FIT.EQ.1) THEN
4203 CALL BLOCK(SQS,SIGT1,SIGT2,SLOP1,SLOP2,RHO1,RHO2,
4204 + SIGEL1,SIGEL2)
4205 R = SIGEL1/SIGT1
4206 RHO = RHO1
4207 SIGT = SIGINEL/(1.-R)
4208 SIGEL = SIGINEL*R/(1.-R)
4209 SLOPE = SIGT**2/(SIGEL * 16.*PI) * (1.+RHO1**2) /CMBARN
4210 ELSE
4211 SIGT = SSIG_TOT(J1,1)*(1.-T) + SSIG_TOT(J1+1,1)*T
4212 SLOPE = SSIG_B(J1,1) *(1.-T) + SSIG_B(J1+1,1) *T
4213 RHO=0.0
4214 SIGEL=SIGT-SIGINEL
4215 ENDIF
4216 RETURN
4217 END
4218 SUBROUTINE SIB_START_EV (SQS,L,IA, NW,JDIF)
4219C=======================================================================
4220C. Code for the wounded nucleon distribution
4221C=======================================================================
4222C..Beginning of a SIBYLL interaction
4223C. INPUT : SQS = c.m.s. energy (GeV)
4224C. L = 1:proton, 2:charged pion
4225C. IA = mass of target nucleon
4226C.
4227C. OUTPUT: NW = number of wounded nucleons
4228C. JDIF = diffraction code
4229C. (0 : non diffractive)
4230C. (1 : forward diffraction)
4231C. (2 : backward diffraction)
4232C. (0 : double diffraction)
4233C. Author : P.Lipari (may 1993)
4234C------------------------------------------------
4235 COMMON /S_CNCM0/ B, BMAX, NTRY, NA
4236 CALL SIGMA_HP (L, SQS, SIGT, SIGEL, SIGINEL, SLOPE, RHO)
4237 IF (IA .GT. 1) THEN
4238 CALL INT_H_NUC (IA, SIGT, SLOPE, RHO)
4239 ELSE
4240 NA = 1
4241 ENDIF
4242C...diffraction
4243 PF = FDIFFRACT(SQS,L)/SIGINEL
4244 PB = BDIFFRACT(SQS,L)/SIGINEL
4245 PD = DDIFFRACT(SQS,L)/SIGINEL
4246 P0 = 1.-PF-PB-PD
4247 P1 = P0 + PF
4248 P2 = P1 + PB
4249 NW = 0
4250 JF = 0
4251 JB = 0
4252 JD = 0
4253 DO K=1, NA
4254 R = RNDM(0)
4255 IF (R .LT. P0) THEN
4256 NW = NW + 1
4257 ELSE IF (R .LT. P1) THEN
4258 JF = 1
4259 ELSE IF (R .LT. P2) THEN
4260 JB = 1
4261 ELSE
4262 JD = 1
4263 ENDIF
4264 ENDDO
4265 JDIF = 0
4266 IF (NW .EQ. 0) THEN
4267 NW = 1
4268 JDIF = 3
4269 IF((JF.EQ.1) .AND. (JB.EQ.0) .AND. (JD.EQ.0)) JDIF=1
4270 IF((JF.EQ.0) .AND. (JB.EQ.1) .AND. (JD.EQ.0)) JDIF=2
4271 ENDIF
4272 RETURN
4273 END
4274 SUBROUTINE SIGMA_AIR (IB,SIG0,SIGEL,NINT,
4275 + SIGMA,DSIGMA,SIGQE,DSIGQE)
4276C==========================================================================
4277C. Cross sections
4278C==========================================================================
4279C...Compute with a montecarlo method the "production"
4280C. and "quasi-elastic" cross section for
4281C. a nucleus-air interaction
4282C.
4283C. INPUT : IB = mass of projectile nucleus
4284C. SIG0 (mbarn) = inelastic pp cross section
4285C. NINT = number of interactions to generate
4286C. OUTPUT : SIGMA (mbarn) = "production" cross section
4287C. DSIGMA " = error
4288C. SIGQE " = "quasi-elastic" cross section
4289C. DSIGQE " = error
4290C. additional output is in the common block /CPROBAB/
4291C..........................................................................
4292 PARAMETER (IAMAX=56)
4293 PARAMETER (IAMAX2=3136) ! IAMAX*IAMAX
4294 COMMON /CPROBAB/ PROBA(IAMAX), DPROBA(IAMAX),
4295 + PROBB(IAMAX), DPROBB(IAMAX), PROBI(IAMAX2), DPROBI(IAMAX2),
4296 + P1AEL(0:IAMAX),DP1AEL(0:IAMAX),P1BEL(0:IAMAX), DP1BEL(0:IAMAX),
4297 + P2AEL(0:IAMAX),DP2AEL(0:IAMAX),P2BEL(0:IAMAX), DP2BEL(0:IAMAX)
4298 COMMON /CNUCMS/ B, BMAX, NTRY, NA, NB, NI, NAEL, NBEL
4299 + ,JJA(IAMAX), JJB(IAMAX), JJINT(IAMAX,IAMAX)
4300 + ,JJAEL(IAMAX), JJBEL(IAMAX)
4301 DIMENSION MMA(0:IAMAX), MMB(0:IAMAX), MMI(0:IAMAX2)
4302 DIMENSION M1AEL(0:IAMAX), M1BEL(0:IAMAX)
4303 DIMENSION M2AEL(0:IAMAX), M2BEL(0:IAMAX)
4304 DATA WOX /0.346/
4305 DATA PI /3.1415926/
4306 R2 = 0.1 * SIG0/PI
4307 BMAX = 15. ! fm
4308 SIGMA0 = PI*BMAX*BMAX*10. ! mbarn
4309 IA = 16
4310 DO J=1,IA
4311 MMA(J) = 0
4312 M1AEL(J) = 0
4313 M2AEL(J) = 0
4314 ENDDO
4315 DO J=1,IB
4316 MMB(J) = 0
4317 M1BEL(J) = 0
4318 M2BEL(J) = 0
4319 ENDDO
4320 DO J=1,IA*IB
4321 MMI(J) = 0
4322 ENDDO
4323 NN = 0
4324 M = 0
4325 DO KK=1,NINT
4326 IA = 14 + 2*INT((1.+WOX)*RNDM(0))
4327 CALL INT_NUC (IA, IB, SIG0, SIGEL)
4328 NN = NN + NTRY
4329 MMI(NI) = MMI(NI) + 1
4330 MMA(NA) = MMA(NA)+1
4331 MMB(NB) = MMB(NB)+1
4332 IF (NI .GT. 0) THEN
4333 M = M+1
4334 M1AEL(NAEL) = M1AEL(NAEL)+1
4335 M1BEL(NBEL) = M1BEL(NBEL)+1
4336 ELSE
4337 M2AEL(NAEL) = M2AEL(NAEL)+1
4338 M2BEL(NBEL) = M2BEL(NBEL)+1
4339 ENDIF
4340 ENDDO
4341 MQE = NINT - M
4342 SIGMA = SIGMA0 * FLOAT(M)/FLOAT(NN)
4343 DSIGMA = SIGMA0 * SQRT(FLOAT(M))/FLOAT(NN)
4344 SIGQE = SIGMA0 * FLOAT(MQE)/FLOAT(NN)
4345 DSIGQE = SIGMA0 * SQRT(FLOAT(MQE))/FLOAT(NN)
4346 DO J=1,IA
4347 PROBA(J) = FLOAT(MMA(J))/FLOAT(M)
4348 DPROBA(J) = SQRT(FLOAT(MMA(J)))/FLOAT(M)
4349 ENDDO
4350 DO J=1,IB
4351 PROBB(J) = FLOAT(MMB(J))/FLOAT(M)
4352 DPROBB(J) = SQRT(FLOAT(MMB(J)))/FLOAT(M)
4353 ENDDO
4354 DO J=1,IA*IB
4355 PROBI(J) = FLOAT(MMI(J))/FLOAT(M)
4356 DPROBI(J) = SQRT(FLOAT(MMI(J)))/FLOAT(M)
4357 ENDDO
4358 DO J=0,IA
4359 P1AEL(J) = FLOAT(M1AEL(J))/FLOAT(M)
4360 DP1AEL(J) = SQRT(FLOAT(M1AEL(J)))/FLOAT(M)
4361 P2AEL(J) = FLOAT(M2AEL(J))/FLOAT(MQE)
4362 DP2AEL(J) = SQRT(FLOAT(M2AEL(J)))/FLOAT(MQE)
4363 ENDDO
4364 DO J=0,IB
4365 P1BEL(J) = FLOAT(M1BEL(J))/FLOAT(M)
4366 DP1BEL(J) = SQRT(FLOAT(M1BEL(J)))/FLOAT(M)
4367 P2BEL(J) = FLOAT(M2BEL(J))/FLOAT(MQE)
4368 DP2BEL(J) = SQRT(FLOAT(M2BEL(J)))/FLOAT(MQE)
4369 ENDDO
4370 RETURN
4371 END
4372 SUBROUTINE SIGMA_HP (L, SQS, SIGT, SIGEL, SIGINEL, SLOPE, RHO)
4373C--------------------------------------------------------------------------
4374C. Hadron-proton cross sections
4375C--------------------------------------------------------------------------
4376 IF(L .EQ. 2) THEN
4377 CALL sib_SIGMA_PIP(SQS,SIGT,SIGEL,SIGINEL,SLOPE,RHO)
4378 ELSE
4379 CALL sib_SIGMA_PP(SQS,SIGT,SIGEL,SIGINEL,SLOPE,RHO)
4380 ENDIF
4381 RETURN
4382 END
4383
4384 SUBROUTINE SIGMA_INI
4385C...Initialize the cross section and interaction lengths on air
4386 COMMON /CSAIR/ NSQS, ASQSMIN, ASQSMAX, DASQS,
4387 + SSIG0(41,2),SSIGA(41,2),ALINT(41,2)
4388 DATA AVOG /6.0221367E-04/
4389 CALL BLOCK_INI
4390 ATARGET = 14.514
4391C...Loop on c.m. energy
4392 NSQS = 41
4393 SQSMIN = 10.
4394 SQSMAX = 1.E+05
4395 ASQSMIN = LOG10(SQSMIN)
4396 ASQSMAX = LOG10(SQSMAX)
4397 DASQS = (ASQSMAX-ASQSMIN)/FLOAT(NSQS-1)
4398 DO J=1,NSQS
4399 ASQS = ASQSMIN + DASQS*FLOAT(J-1)
4400 SQS = 10.**ASQS
4401 E0 = SQS*SQS/(2.*0.938) * 1.E-03
4402 CALL SIGMA_PP (E0, SIGT, SIGEL, SIGINEL, SLOPE, RHO)
4403 CALL SIG_H_AIR (SIGT, SLOPE, RHO, SSIGT, SSIGEL, SSIGQE)
4404 SSIGA(J,1) = SSIGT-SSIGQE
4405 SSIG0(J,1) = SIGINEL
4406 ALINT(J,1) = 1./(AVOG*SSIGA(J,1)/ATARGET)
4407 CALL SIGMA_PIP (E0, SIGT, SIGEL, SIGINEL, SLOPE, RHO)
4408 CALL SIG_H_AIR (SIGT, SLOPE, RHO, SSIGT, SSIGEL, SSIGQE)
4409 SSIGA(J,2) = SSIGT-SSIGQE
4410 SSIG0(J,2) = SIGINEL
4411 ALINT(J,2) = 1./(AVOG*SSIGA(J,2)/ATARGET)
4412 ENDDO
4413 RETURN
4414 END
4415
4416 SUBROUTINE SIGMA_MC (IA,IB,SIG0,SIGEL,NINT,
4417 + SIGMA,DSIGMA,SIGQE,DSIGQE)
4418C...Compute with a montecarlo method the "production"
4419C. and "quasi-elastic" cross section for
4420C. a nucleus-nucleus interaction
4421C.
4422C. INPUT : IA = mass of target nucleus
4423C. IB = mass of projectile nucleus
4424C. SIG0 (mbarn) = inelastic pp cross section
4425C. NINT = number of interactions to generate
4426C. OUTPUT : SIGMA (mbarn) = "production" cross section
4427C. DSIGMA " = error
4428C. SIGQE " = "quasi-elastic" cross section
4429C. DSIGQE " = error
4430C. additional output is in the common block /CPROBAB/
4431C. Prob(n_A), Prob(n_B), Prob(n_int)
4432C..........................................................................
4433 PARAMETER (IAMAX=56)
4434 PARAMETER (IAMAX2=3136) ! IAMAX*IAMAX
4435 COMMON /CPROBAB/ PROBA(IAMAX), DPROBA(IAMAX),
4436 + PROBB(IAMAX), DPROBB(IAMAX), PROBI(IAMAX2), DPROBI(IAMAX2),
4437 + P1AEL(0:IAMAX),DP1AEL(0:IAMAX),P1BEL(0:IAMAX), DP1BEL(0:IAMAX),
4438 + P2AEL(0:IAMAX),DP2AEL(0:IAMAX),P2BEL(0:IAMAX), DP2BEL(0:IAMAX)
4439 COMMON /CNUCMS/ B, BMAX, NTRY, NA, NB, NI, NAEL, NBEL
4440 + ,JJA(IAMAX), JJB(IAMAX), JJINT(IAMAX,IAMAX)
4441 + ,JJAEL(IAMAX), JJBEL(IAMAX)
4442 DIMENSION MMA(0:IAMAX), MMB(0:IAMAX), MMI(0:IAMAX2)
4443 DIMENSION M1AEL(0:IAMAX), M1BEL(0:IAMAX)
4444 DIMENSION M2AEL(0:IAMAX), M2BEL(0:IAMAX)
4445 DATA PI /3.1415926/
4446 R2 = 0.1 * SIG0/PI
4447 BMAX = 15. ! fm
4448 SIGMA0 = PI*BMAX*BMAX*10. ! mbarn
4449 DO J=1,IA
4450 MMA(J) = 0
4451 M1AEL(J) = 0
4452 M2AEL(J) = 0
4453 ENDDO
4454 DO J=1,IB
4455 MMB(J) = 0
4456 M1BEL(J) = 0
4457 M2BEL(J) = 0
4458 ENDDO
4459 DO J=1,IA*IB
4460 MMI(J) = 0
4461 ENDDO
4462 NN = 0
4463 M = 0
4464 DO KK=1,NINT
4465 CALL INT_NUC (IA, IB, SIG0, SIGEL)
4466 NN = NN + NTRY
4467 MMI(NI) = MMI(NI) + 1
4468 MMA(NA) = MMA(NA)+1
4469 MMB(NB) = MMB(NB)+1
4470 IF (NI .GT. 0) THEN
4471 M = M+1
4472 M1AEL(NAEL) = M1AEL(NAEL)+1
4473 M1BEL(NBEL) = M1BEL(NBEL)+1
4474 ELSE
4475 M2AEL(NAEL) = M2AEL(NAEL)+1
4476 M2BEL(NBEL) = M2BEL(NBEL)+1
4477 ENDIF
4478 ENDDO
4479 MQE = NINT - M
4480 SIGMA = SIGMA0 * FLOAT(M)/FLOAT(NN)
4481 DSIGMA = SIGMA0 * SQRT(FLOAT(M))/FLOAT(NN)
4482 SIGQE = SIGMA0 * FLOAT(MQE)/FLOAT(NN)
4483 DSIGQE = SIGMA0 * SQRT(FLOAT(MQE))/FLOAT(NN)
4484 DO J=1,IA
4485 PROBA(J) = FLOAT(MMA(J))/FLOAT(M)
4486 DPROBA(J) = SQRT(FLOAT(MMA(J)))/FLOAT(M)
4487 ENDDO
4488 DO J=1,IB
4489 PROBB(J) = FLOAT(MMB(J))/FLOAT(M)
4490 DPROBB(J) = SQRT(FLOAT(MMB(J)))/FLOAT(M)
4491 ENDDO
4492 DO J=1,IA*IB
4493 PROBI(J) = FLOAT(MMI(J))/FLOAT(M)
4494 DPROBI(J) = SQRT(FLOAT(MMI(J)))/FLOAT(M)
4495 ENDDO
4496 DO J=0,IA
4497 P1AEL(J) = FLOAT(M1AEL(J))/FLOAT(M)
4498 DP1AEL(J) = SQRT(FLOAT(M1AEL(J)))/FLOAT(M)
4499 P2AEL(J) = FLOAT(M2AEL(J))/FLOAT(MQE)
4500 DP2AEL(J) = SQRT(FLOAT(M2AEL(J)))/FLOAT(MQE)
4501 ENDDO
4502 DO J=0,IB
4503 P1BEL(J) = FLOAT(M1BEL(J))/FLOAT(M)
4504 DP1BEL(J) = SQRT(FLOAT(M1BEL(J)))/FLOAT(M)
4505 P2BEL(J) = FLOAT(M2BEL(J))/FLOAT(MQE)
4506 DP2BEL(J) = SQRT(FLOAT(M2BEL(J)))/FLOAT(MQE)
4507 ENDDO
4508 RETURN
4509 END
4510
4511 SUBROUTINE SIGMA_PIP (E0, SIGT, SIGEL, SIGINEL, SLOPE, RHO)
4512C=============================================================
4513C. Cross sections
4514C=============================================================
4515C...pp cross sections
4516C. INPUT: E0 = Laboratory Energy (TeV)
4517C.
4518C. OUTPUT: SIGT = total cross section
4519C. SIGEL = elastic cross section
4520C. SIGINEL = inelastic cross section
4521C. SLOPE = slope of elastic scattering (GeV**-2)
4522C. RHO = Imaginary/Real part of forward elastic scattering amplitude
4523C...........................................................................
4524 DIMENSION SSIG0(41)
4525 DATA PI /3.1415926/
4526 DATA CMBARN /0.389385/
4527C...pi-p inelastic cross sections (mbarn)
4528 DATA (SSIG0(J),J=1,41) /
4529 + 20.28, 20.36, 20.48, 20.66, 20.91, 21.22,
4530 + 21.62, 22.09, 22.64, 23.27, 23.99, 24.79,
4531 + 25.66, 26.62, 27.65, 28.76, 29.94, 31.21,
4532 + 32.55, 33.97, 35.47, 37.04, 38.70, 40.46,
4533 + 42.29, 44.23, 46.26, 48.40, 50.64, 53.01,
4534 + 55.48, 58.12, 60.87, 63.75, 66.78, 69.98,
4535 + 73.38, 76.91, 80.62, 84.56, 88.68 /
4536 SQS = SQRT(2000.*0.938*E0)
4537 AL = LOG10(SQS)
4538 J1 = (AL - 1.)*10. + 1
4539C D.H.
4540 J1 = MAX(J1,1)
4541 J1 = MIN(J1,40)
4542
4543 T = (AL-1.)*10. - FLOAT(J1-1)
4544 SIGINEL = SSIG0(J1)*(1.-T) + SSIG0(J1+1)*T
4545 CALL BLOCK(SQS,SIGT1,SIGT2,SLOP1,SLOP2,RHO1,RHO2,SIGEL1,SIGEL2)
4546 R = SIGEL1/SIGT1
4547 RHO = RHO1
4548 SIGT = SIGINEL/(1.-R)
4549 SIGEL = SIGINEL*R/(1.-R)
4550 SLOPE = SIGT**2/(SIGEL * 16.*PI) * (1.+RHO1**2) /CMBARN
4551 RETURN
4552 END
4553
4554 SUBROUTINE SIGMA_PP (E0, SIGT, SIGEL, SIGINEL, SLOPE, RHO)
4555C...pp cross sections
4556C. INPUT: E0 = Laboratory Energy (TeV)
4557C.
4558C. OUTPUT: SIGT = total cross section
4559C. SIGEL = elastic cross section
4560C. SIGINEL = inelastic cross section
4561C. SLOPE = slope of elastic scattering (GeV**-2)
4562C. RHO = Imaginary/Real part of forward elastic scattering amplitude
4563C...........................................................................
4564 DIMENSION SSIG0(41)
4565 DATA PI /3.1415926/
4566 DATA CMBARN /0.389385/
4567C...p-p inelastic cross sections (mbarn)
4568 DATA (SSIG0(J),J=1,41) /
4569 + 32.08, 32.15, 32.26, 32.45, 32.73, 33.12,
4570 + 33.63, 34.28, 35.08, 36.01, 37.09, 38.31,
4571 + 39.67, 41.15, 42.75, 44.47, 46.29, 48.22,
4572 + 50.24, 52.35, 54.55, 56.81, 59.15, 61.57,
4573 + 64.04, 66.57, 69.17, 71.81, 74.51, 77.27,
4574 + 80.06, 82.93, 85.82, 88.74, 91.71, 94.76,
4575 + 97.86, 100.97, 104.12, 107.31, 110.54 /
4576 SQS = SQRT(2000.*0.938*E0)
4577 AL = LOG10(SQS)
4578 J1 = (AL - 1.)*10. + 1
4579C D.H.
4580 J1 = MAX(J1,1)
4581 J1 = MIN(J1,40)
4582
4583 T = (AL-1.)*10. - FLOAT(J1-1)
4584 SIGINEL = SSIG0(J1)*(1.-T) + SSIG0(J1+1)*T
4585 CALL BLOCK(SQS,SIGT1,SIGT2,SLOP1,SLOP2,RHO1,RHO2,SIGEL1,SIGEL2)
4586 R = SIGEL1/SIGT1
4587 RHO = RHO1
4588 SIGT = SIGINEL/(1.-R)
4589 SIGEL = SIGINEL*R/(1.-R)
4590 SLOPE = SIGT**2/(SIGEL * 16.*PI) * (1.+RHO1**2) /CMBARN
4591 RETURN
4592 END
4593
4594 SUBROUTINE SIGNUC_INI (IA,E0)
4595C=============================================================
4596C. Nucleus-nucleus cross sections
4597C=============================================================
4598C...This subroutine receives in INPUT E0 (TeV)
4599C. energy per nucleon and computes the cross sections
4600C. and interactions lengths for all nuclei
4601C. with A between 2 and IA
4602C. The output is contained in common block /CLENNN/
4603C........................................................
4604 COMMON /CLENNN/ SSIGNUC(60), ALNUC(60)
4605 DIMENSION SIGMA(5,56), SIGQE(5,56)
4606 DIMENSION AA(5)
4607 DATA NE /5/, AMIN /1./, DA /1./
4608 DATA AA /1.,2.,3.,4.,5./
4609 DATA AVOG /6.0221367E-04/
4610 DATA ATARGET /14.514/ ! effective masss of air
4611C...Data on `inelastic-production' nucleus-air cross section
4612 DATA (SIGMA(J, 2),J=1,5) / 396., 427., 497., 603., 702./
4613 DATA (SIGMA(J, 3),J=1,5) / 464., 490., 570., 680., 794./
4614 DATA (SIGMA(J, 4),J=1,5) / 497., 524., 600., 711., 813./
4615 DATA (SIGMA(J, 5),J=1,5) / 593., 629., 708., 826., 934./
4616 DATA (SIGMA(J, 6),J=1,5) / 701., 739., 839., 954.,1066./
4617 DATA (SIGMA(J, 7),J=1,5) / 708., 755., 845., 985.,1102./
4618 DATA (SIGMA(J, 8),J=1,5) / 777., 790., 909.,1015.,1130./
4619 DATA (SIGMA(J, 9),J=1,5) / 808., 845., 952.,1051.,1186./
4620 DATA (SIGMA(J,10),J=1,5) / 809., 862., 958.,1077.,1193./
4621 DATA (SIGMA(J,11),J=1,5) / 821., 870., 955.,1085.,1191./
4622 DATA (SIGMA(J,12),J=1,5) / 861., 897., 985.,1132.,1251./
4623 DATA (SIGMA(J,13),J=1,5) / 875., 909., 989.,1129.,1272./
4624 DATA (SIGMA(J,14),J=1,5) / 919., 952.,1043.,1202.,1315./
4625 DATA (SIGMA(J,15),J=1,5) / 954., 969.,1085.,1217.,1370./
4626 DATA (SIGMA(J,16),J=1,5) /1014.,1041.,1148.,1308.,1430./
4627 DATA (SIGMA(J,17),J=1,5) /1005.,1028.,1139.,1277.,1434./
4628 DATA (SIGMA(J,18),J=1,5) /1065.,1088.,1178.,1324.,1494./
4629 DATA (SIGMA(J,19),J=1,5) /1113.,1122.,1238.,1397.,1532./
4630 DATA (SIGMA(J,20),J=1,5) /1143.,1169.,1321.,1471.,1615./
4631 DATA (SIGMA(J,21),J=1,5) /1167.,1194.,1315.,1488.,1650./
4632 DATA (SIGMA(J,22),J=1,5) /1183.,1195.,1318.,1454.,1638./
4633 DATA (SIGMA(J,23),J=1,5) /1206.,1264.,1394.,1524.,1653./
4634 DATA (SIGMA(J,24),J=1,5) /1244.,1297.,1400.,1557.,1672./
4635 DATA (SIGMA(J,25),J=1,5) /1272.,1298.,1449.,1600.,1712./
4636 DATA (SIGMA(J,26),J=1,5) /1269.,1332.,1459.,1603.,1743./
4637 DATA (SIGMA(J,27),J=1,5) /1262.,1312.,1443.,1598.,1723./
4638 DATA (SIGMA(J,28),J=1,5) /1309.,1333.,1469.,1619.,1763./
4639 DATA (SIGMA(J,29),J=1,5) /1433.,1505.,1621.,1802.,1935./
4640 DATA (SIGMA(J,30),J=1,5) /1346.,1391.,1536.,1678.,1844./
4641 DATA (SIGMA(J,31),J=1,5) /1376.,1432.,1556.,1696.,1878./
4642 DATA (SIGMA(J,32),J=1,5) /1392.,1418.,1582.,1713.,1857./
4643 DATA (SIGMA(J,33),J=1,5) /1412.,1438.,1602.,1742.,1944./
4644 DATA (SIGMA(J,34),J=1,5) /1414.,1471.,1633.,1774.,1928./
4645 DATA (SIGMA(J,35),J=1,5) /1444.,1498.,1634.,1773.,1944./
4646 DATA (SIGMA(J,36),J=1,5) /1455.,1507.,1638.,1815.,1943./
4647 DATA (SIGMA(J,37),J=1,5) /1458.,1526.,1660.,1781.,1992./
4648 DATA (SIGMA(J,38),J=1,5) /1520.,1515.,1671.,1838.,2052./
4649 DATA (SIGMA(J,39),J=1,5) /1492.,1545.,1707.,1863.,2049./
4650 DATA (SIGMA(J,40),J=1,5) /1511.,1577.,1719.,1878.,2032./
4651 DATA (SIGMA(J,41),J=1,5) /1541.,1581.,1729.,1878.,2072./
4652 DATA (SIGMA(J,42),J=1,5) /1540.,1591.,1718.,1919.,2075./
4653 DATA (SIGMA(J,43),J=1,5) /1590.,1610.,1783.,1925.,2077./
4654 DATA (SIGMA(J,44),J=1,5) /1582.,1614.,1785.,1961.,2106./
4655 DATA (SIGMA(J,45),J=1,5) /1580.,1629.,1774.,1939.,2115./
4656 DATA (SIGMA(J,46),J=1,5) /1628.,1673.,1812.,1981.,2089./
4657 DATA (SIGMA(J,47),J=1,5) /1594.,1672.,1820.,1999.,2163./
4658 DATA (SIGMA(J,48),J=1,5) /1639.,1695.,1824.,1986.,2150./
4659 DATA (SIGMA(J,49),J=1,5) /1647.,1728.,1856.,2008.,2188./
4660 DATA (SIGMA(J,50),J=1,5) /1637.,1714.,1902.,2040.,2210./
4661 DATA (SIGMA(J,51),J=1,5) /1682.,1741.,1918.,2042.,2258./
4662 DATA (SIGMA(J,52),J=1,5) /1673.,1746.,1933.,2067.,2238./
4663 DATA (SIGMA(J,53),J=1,5) /1705.,1763.,1880.,2102.,2249./
4664 DATA (SIGMA(J,54),J=1,5) /1699.,1748.,1917.,2142.,2265./
4665 DATA (SIGMA(J,55),J=1,5) /1751.,1764.,1934.,2129.,2289./
4666 DATA (SIGMA(J,56),J=1,5) /1753.,1828.,1973.,2187.,2335./
4667C...Data on `quasi-elastic' nucleus-air cross section
4668 DATA (SIGQE(J, 2),J=1,5) / 41., 42., 75., 138., 236./
4669 DATA (SIGQE(J, 3),J=1,5) / 41., 41., 79., 138., 244./
4670 DATA (SIGQE(J, 4),J=1,5) / 39., 41., 78., 145., 246./
4671 DATA (SIGQE(J, 5),J=1,5) / 44., 47., 83., 152., 256./
4672 DATA (SIGQE(J, 6),J=1,5) / 48., 53., 96., 169., 288./
4673 DATA (SIGQE(J, 7),J=1,5) / 53., 52., 95., 171., 282./
4674 DATA (SIGQE(J, 8),J=1,5) / 53., 52., 95., 179., 295./
4675 DATA (SIGQE(J, 9),J=1,5) / 51., 49., 94., 180., 301./
4676 DATA (SIGQE(J,10),J=1,5) / 52., 52., 93., 183., 308./
4677 DATA (SIGQE(J,11),J=1,5) / 52., 51., 91., 179., 301./
4678 DATA (SIGQE(J,12),J=1,5) / 53., 53., 92., 179., 284./
4679 DATA (SIGQE(J,13),J=1,5) / 55., 55., 97., 184., 308./
4680 DATA (SIGQE(J,14),J=1,5) / 54., 55., 102., 182., 310./
4681 DATA (SIGQE(J,15),J=1,5) / 57., 53., 102., 193., 305./
4682 DATA (SIGQE(J,16),J=1,5) / 56., 53., 105., 195., 331./
4683 DATA (SIGQE(J,17),J=1,5) / 57., 54., 101., 192., 327./
4684 DATA (SIGQE(J,18),J=1,5) / 53., 54., 107., 204., 328./
4685 DATA (SIGQE(J,19),J=1,5) / 59., 63., 105., 209., 345./
4686 DATA (SIGQE(J,20),J=1,5) / 59., 64., 109., 195., 343./
4687 DATA (SIGQE(J,21),J=1,5) / 55., 64., 114., 212., 348./
4688 DATA (SIGQE(J,22),J=1,5) / 60., 63., 117., 206., 340./
4689 DATA (SIGQE(J,23),J=1,5) / 63., 68., 119., 202., 345./
4690 DATA (SIGQE(J,24),J=1,5) / 59., 61., 114., 213., 354./
4691 DATA (SIGQE(J,25),J=1,5) / 60., 65., 121., 216., 357./
4692 DATA (SIGQE(J,26),J=1,5) / 61., 66., 124., 232., 342./
4693 DATA (SIGQE(J,27),J=1,5) / 63., 61., 119., 222., 365./
4694 DATA (SIGQE(J,28),J=1,5) / 63., 68., 121., 218., 354./
4695 DATA (SIGQE(J,29),J=1,5) / 67., 77., 119., 239., 371./
4696 DATA (SIGQE(J,30),J=1,5) / 63., 63., 120., 230., 379./
4697 DATA (SIGQE(J,31),J=1,5) / 67., 66., 124., 223., 371./
4698 DATA (SIGQE(J,32),J=1,5) / 62., 68., 125., 230., 357./
4699 DATA (SIGQE(J,33),J=1,5) / 65., 70., 128., 227., 377./
4700 DATA (SIGQE(J,34),J=1,5) / 63., 70., 120., 222., 359./
4701 DATA (SIGQE(J,35),J=1,5) / 66., 71., 124., 233., 358./
4702 DATA (SIGQE(J,36),J=1,5) / 70., 70., 118., 228., 376./
4703 DATA (SIGQE(J,37),J=1,5) / 69., 73., 131., 209., 381./
4704 DATA (SIGQE(J,38),J=1,5) / 68., 73., 128., 221., 369./
4705 DATA (SIGQE(J,39),J=1,5) / 68., 72., 129., 224., 377./
4706 DATA (SIGQE(J,40),J=1,5) / 72., 73., 123., 232., 384./
4707 DATA (SIGQE(J,41),J=1,5) / 67., 73., 131., 240., 384./
4708 DATA (SIGQE(J,42),J=1,5) / 71., 72., 131., 236., 392./
4709 DATA (SIGQE(J,43),J=1,5) / 69., 76., 137., 249., 395./
4710 DATA (SIGQE(J,44),J=1,5) / 71., 73., 136., 235., 385./
4711 DATA (SIGQE(J,45),J=1,5) / 71., 67., 127., 236., 401./
4712 DATA (SIGQE(J,46),J=1,5) / 76., 68., 133., 241., 399./
4713 DATA (SIGQE(J,47),J=1,5) / 73., 69., 133., 227., 382./
4714 DATA (SIGQE(J,48),J=1,5) / 67., 81., 131., 247., 402./
4715 DATA (SIGQE(J,49),J=1,5) / 69., 78., 133., 247., 400./
4716 DATA (SIGQE(J,50),J=1,5) / 73., 76., 131., 239., 401./
4717 DATA (SIGQE(J,51),J=1,5) / 73., 75., 131., 246., 394./
4718 DATA (SIGQE(J,52),J=1,5) / 72., 77., 135., 242., 408./
4719 DATA (SIGQE(J,53),J=1,5) / 75., 76., 136., 236., 394./
4720 DATA (SIGQE(J,54),J=1,5) / 76., 78., 137., 228., 398./
4721 DATA (SIGQE(J,55),J=1,5) / 75., 82., 133., 238., 390./
4722 DATA (SIGQE(J,56),J=1,5) / 76., 71., 136., 255., 408./
4723 ASQS = 0.5*LOG10(1.876E+03*E0)
4724 JE = MIN(INT((ASQS-AMIN)/DA)+1,NE-2)
4725 DO JA=2,IA
4726 ABEAM = FLOAT(JA)
4727 S1 = QUAD_INT(ASQS, AA(JE),AA(JE+1),AA(JE+2),
4728 + SIGMA(JE,JA),SIGMA(JE+1,JA),SIGMA(JE+2,JA))
4729 S2 = QUAD_INT(ASQS, AA(JE),AA(JE+1),AA(JE+2),
4730 + SIGQE(JE,JA),SIGQE(JE+1,JA),SIGQE(JE+2,JA))
4731 SSIGNUC(JA) = S1 + S2
4732 ALNUC(JA) = ATARGET/(AVOG*SSIGNUC(JA))
4733 ENDDO
4734 ALNUC(1) = FPNI(E0, 13)
4735 SSIGNUC(1) = ATARGET/(AVOG*ALNUC(1))
4736 RETURN
4737 END
4738 SUBROUTINE SIG_AIR_INI
4739C==========================================================================
4740C. Cross sections
4741C==========================================================================
4742C...Initialize the cross section and interaction lengths on air
4743 COMMON /S_CCSIG/ NSQS, ASQSMIN, ASQSMAX, DASQS,
4744 + SSIG(51,2), PJETC(0:20,51,2),SSIGN(51,2), ALINT(51,2)
4745 COMMON /S_CCSIG2/ SSIG_TOT(51,2),SSIG_B(51,2)
4746 COMMON /S_SIGEL/ielastic,FIN(51,2),FEL(51,2),FQE(0:6,51,2)
4747 DATA AVOG /6.0221367E-04/
4748 parameter (pi=3.1415927)
4749 ATARGET = 14.514
4750C...Loop on c.m. energy
4751 DO J=1,NSQS
4752 ASQS = ASQSMIN + DASQS*FLOAT(J-1)
4753 IF (J .EQ. NSQS) ASQS = ASQS-1.E-04
4754 SQS = 10.**ASQS
4755 CALL sib_SIGMA_PP (SQS, SIGT, SIGEL, SIGINEL, SLOPE, RHO)
4756 CALL SIG_H_AIR (SIGT, SLOPE, RHO, SSIGT, SSIGEL, SSIGQE)
4757 SSIGN(J,1) = SSIGT-SSIGQE
4758 if (ielastic.eq.1) then
4759 ALINT(J,1) = 1./(AVOG*SSIGT/ATARGET)
4760 else
4761 ALINT(J,1) = 1./(AVOG*SSIGn(j,1)/ATARGET)
4762 endif
4763 ssig_tot(j,1) = sigt
4764 ssig_B(j,1) = slope
4765 FIN(J,1) = ssign(j,1)/SSIGT
4766 FEL(J,1) = SSIGEL/SSIGT
4767 FQE(0,J,1) = (SSIGQE-SSIGEL)/SSIGT
4768 eps=ssigt/slope/16./pi*(1+rho**2)
4769 FQE(1,J,1) = eps
4770 do nqe=2,6
4771 FQE(nqe,J,1) = eps**nqe/nqe + fqe(nqe-1,j,1)
4772 enddo
4773 do nqe=1,6
4774 FQE(nqe,J,1) = fqe(nqe,j,1)/fqe(6,j,1)
4775 enddo
4776
4777 CALL sib_SIGMA_PIP (SQS, SIGT, SIGEL, SIGINEL, SLOPE, RHO)
4778 CALL SIG_H_AIR (SIGT, SLOPE, RHO, SSIGT, SSIGEL, SSIGQE)
4779 SSIGN(J,2) = SSIGT-SSIGQE
4780 if (ielastic.eq.1) then
4781 ALINT(J,2) = 1./(AVOG*SSIGT/ATARGET)
4782 else
4783 ALINT(J,2) = 1./(AVOG*SSIGn(j,2)/ATARGET)
4784 endif
4785 ssig_tot(J,2) = sigt
4786 ssig_B(J,2) = slope
4787
4788 FIN(j,2) = ssign(J,2)/SSIGT
4789 FEL(j,2) = ssigEL/SSIGT
4790 FQE(0,J,2) = SSIGQE/SSIGT
4791 eps=ssigt/slope/16./pi*(1+rho**2)
4792 FQE(1,J,2) = eps
4793 do nqe=2,6
4794 FQE(nqe,J,2) = eps**nqe/nqe + fqe(nqe-1,j,2)
4795 enddo
4796 do nqe=1,6
4797 FQE(nqe,J,2) = fqe(nqe,j,2)/fqe(6,j,2)
4798 enddo
4799
4800 ENDDO
4801 RETURN
4802 END
4803 BLOCK DATA SIG_DAT
4804C...Precalculated table of cross sections
4805 COMMON /S_CSIGINP/ QQ2MIN, SSQCD (51,2), SSQCD2 (51,2),
4806 @ SSIG0(2), factork(2),isfchoice
4807C...Structure functions
4808 COMMON /S_CSTR/ JSTR, JSTRPI
4809C...EHLQ set 1 for proton Duke-Owens set 1 for pion
4810 DATA JSTR /1/, JSTRPI /1/
4811C...Q2min (GeV**2) for minijets
4812 DATA QQ2MIN /5.0/
4813C...Soft cross section in the eikonal factor
4814 DATA SSIG0 /123., 73./
4815 DATA factork/1.7,2.2/
4816 data isfchoice/1/
4817C...Sigma_qcd (GeV**-2) for p-p computed with EHLQ set 1 Q2min = 5. GeV**2
4818c... with scaling violations. THis is the default choice in SIBYLL.
4819c... A K-factor of 1.7 should be used to fit. the Tevatron data.
4820 DATA (SSQCD(K,1),K=1,51) /
4821 @ 1.1983993E-02, 4.4127252E-02, 0.1238399, 0.2868755, 0.5772045,
4822 @ 1.045294, 1.744142, 2.731708, 4.065390, 5.807725,
4823 @ 8.020122, 10.77380, 14.13659, 18.20087, 23.08322,
4824 @ 28.82062, 35.58009, 43.48313, 52.64074, 63.20496,
4825 @ 75.42126, 89.40395, 105.5904, 123.8777, 144.6305,
4826 @ 168.2220, 195.0619, 225.1132, 259.1954, 297.7083,
4827 @ 340.8559, 389.3647, 443.2799, 503.9778, 571.3537,
4828 @ 647.0132, 731.9388, 825.9186, 932.3583, 1049.230,
4829 @ 1178.351, 1320.911, 1479.186, 1656.306, 1851.798,
4830 @ 2071.153, 2311.224, 2576.411, 2869.631, 3194.693,
4831 @ 3556.603/
4832C...Sigma_qcd (GeV**-2) for pi-p computed with EHLQ set 1 for p
4833C Owens set 1 for pi Q2min = 5. GeV**2
4834c... with scaling violations. THis is the default choice in SIBYLL.
4835c... A K-factor of 1.7 should be used to fit. the Tevatron data.
4836 DATA (SSQCD(K,2),K=1,51) /
4837 @ 2.6713109E-02, 7.6703623E-02, 0.1787110, 0.3587718, 0.6452169,
4838 @ 1.067511, 1.656302, 2.442088, 3.459795, 4.740401,
4839 @ 6.328330, 8.265375, 10.59707, 13.38726, 16.70245,
4840 @ 20.60534, 25.20829, 30.61100, 36.92186, 44.27321,
4841 @ 52.88524, 62.90113, 74.63335, 88.24413, 104.0870,
4842 @ 122.5886, 144.2660, 169.4464, 199.1269, 233.9357,
4843 @ 274.6917, 322.6675, 378.8712, 445.5984, 524.2751,
4844 @ 617.7631, 729.1132, 860.6794, 1019.997, 1208.843,
4845 @ 1433.871, 1703.056, 2026.311, 2417.850, 2889.604,
4846 @ 3463.152, 4152.619, 4989.879, 6001.615, 7231.195,
4847 @ 8747.169/
4848C...Sigma_qcd (GeV**-2) for pi-p computed with EHLQ set 1 for p
4849C Owens set 1 for pi Q2min = 5. GeV**2
4850c... WITHOUT scaling violations. THis is an alternate choice in SIBYLL.
4851c... A K-factor of 2.2 should be used to fit. the Tevatron data.
4852 DATA (SSQCD2(K,1),K=1,51) /
4853 @ 1.4302040E-02, 5.3822853E-02, 0.1535475, 0.3596057, 0.7277440,
4854 @ 1.318651, 2.191311, 3.401969, 4.996748, 7.020068,
4855 @ 9.494884, 12.44863, 15.89774, 19.85705, 24.34084,
4856 @ 29.32943, 34.83667, 40.86320, 47.40503, 54.46183,
4857 @ 62.03970, 70.14349, 78.79037, 87.91505, 97.56121,
4858 @ 107.7228, 118.4118, 129.5977, 141.3069, 153.5433,
4859 @ 166.2887, 179.5711, 193.3551, 207.6443, 222.4576,
4860 @ 237.7850, 253.7659, 270.1528, 287.0669, 304.5056,
4861 @ 322.4221, 340.8359, 359.7802, 379.2549, 399.2404,
4862 @ 419.7521, 440.7868, 462.3503, 484.4333, 507.0548,
4863 @ 530.2106/
4864 DATA (SSQCD2(K,2),K=1,51) /
4865 @ 3.2613490E-02, 9.5264249E-02, 0.2243170, 0.4523652, 0.8127463,
4866 @ 1.336795, 2.052137, 2.981797, 4.145481, 5.557004,
4867 @ 7.229480, 9.172240, 11.39208, 13.89822, 16.69263,
4868 @ 19.78566, 23.18154, 26.88788, 30.90883, 35.25125,
4869 @ 39.92667, 44.94619, 50.30739, 56.02631, 62.11592,
4870 @ 68.57966, 75.43336, 82.67727, 90.33365, 98.41272,
4871 @ 106.9134, 115.8630, 125.2634, 135.1346, 145.4902,
4872 @ 156.3337, 167.7068, 179.5899, 192.0124, 204.9890,
4873 @ 218.5388, 232.6741, 247.4235, 262.8056, 278.8209,
4874 @ 295.4990, 312.8557, 330.9224, 349.6995, 369.2270,
4875 @ 389.5247/
4876 END
4877
4878 SUBROUTINE SIG_H_AIR (SSIG, SLOPE, ALPHA, SIGT, SIGEL, SIGQE)
4879C...Subroutine to compute hadron-air cross sections
4880C. according to:
4881C. R.J. Glauber and G.Matthiae Nucl.Phys. B21, 135, (1970)
4882C.
4883C. Air is a linear combination of Nitrogen and oxygen
4884C.
4885C. INPUT : SSIG (mbarn) total pp cross section
4886C. SLOPE (GeV**-2) elastic scattering slope for pp
4887C. ALPHA real/imaginary part of the forward pp elastic
4888C. scattering amplitude
4889C. OUTPUT : SIGT = Total cross section
4890C. SIGEL = Elastic cross section
4891C. SIGQEL = Elastic + Quasi elastic cross section
4892C......................................................................
4893 DATA FOX /0.257/
4894 CALL GLAUBER(14,SSIG,SLOPE,ALPHA,SIG1,SIGEL1,SIGQE1)
4895 CALL GLAUBER(16,SSIG,SLOPE,ALPHA,SIG2,SIGEL2,SIGQE2)
4896 SIGT = (1.-FOX)*SIG1 + FOX*SIG2
4897 SIGEL = (1.-FOX)*SIGEL1 + FOX*SIGEL2
4898 SIGQE = (1.-FOX)*SIGQE1 + FOX*SIGQE2
4899 RETURN
4900 END
4901
4902 SUBROUTINE SIG_JET (SIG_QCD, SIG_SOFT, JINT, SIG_inel, PJET,
4903 + SIG_TOT,B_EL)
4904C...This subroutine receives in INPUT:
4905C. sig_qcd (GeV-2)
4906C. sig_soft (GeV-2)
4907C. JINT (1 = pp interaction) (2 pi-p interaction)
4908C.
4909C. and returns as output:
4910C. SIG_inel
4911C. and PJET (1:20) probability of n-jets
4912C.
4913C. USES THE OLD GEOMETRY OF:
4914C L.Durand and H.Pi,
4915c
4916C....................................................................
4917 COMMON /S_CFACT/ FACT (0:20), CO_BIN(0:20,0:20)
4918 COMMON /S_CHDCNV/NB,DB,ABPP(200),ABPIP(200),ABPPH(200),
4919 + ABPIPH(200)
4920c COMMON /S_CHDCNV/NB,DB,ABPP(200),ABPIP(200)
4921 DIMENSION PJET (0:20)
4922 DATA PI /3.1415926/
4923
4924 DO J=1,20
4925 PJET(J) = 0.
4926 ENDDO
4927 SUM = 0.
4928 SUM_tot = 0.
4929 SUM_B = 0.
4930
4931 DO JB=1,NB
4932 B = DB*FLOAT(JB-1)
4933 IF (JINT .EQ. 1) THEN
4934 ABSOFT = ABPP (JB)
4935 ABHARD = ABPPh (JB)
4936 ENDIF
4937 IF (JINT .EQ. 2) THEN
4938 ABSOFT = ABPIP (JB)
4939 ABHARD = ABPIPh (JB)
4940 ENDIF
4941 F1 = EXP(-ABHARD*SIG_QCD)
4942 F2 = EXP(-ABSOFT*SIG_SOFT)
4943 F = B*(1.-F1*F2)
4944 SUM = SUM+F
4945 f4= sqrt(f1*f2)
4946 F_tot=B*(1-f4)
4947 sum_tot=sum_tot+f_tot
4948 F_B=B**3*(1-f4)
4949 sum_B=sum_b+f_b
4950 PJET(0) = PJET(0) + (1.-F2)*F1*B
4951 G = SIG_QCD*ABHARD
4952 F3 = G*F1*B
4953 PJET(1) = PJET(1) + F3
4954 DO J=2,20
4955 F3 = F3*G
4956 PJET (J) = PJET(J) + F3
4957 ENDDO
4958 ENDDO
4959 SIG_inel = SUM*2.*PI*DB
4960 sig_tot= SUM_TOT*4.*PI*DB
4961 B_EL= SUM_B*PI*DB/sig_tot*2.
4962 SA = 0.
4963 DO J=0,20
4964 SA = SA + PJET(J)/FACT(J)
4965 ENDDO
4966 DO J=0,20
4967 PJET(J) = PJET(J)/FACT(J)/SA
4968 ENDDO
4969
4970 RETURN
4971 END
4972
4973 SUBROUTINE SINCO(S,C)
4974 DATA PI /3.1415926/
4975 F = 2.*PI*RNDM(0)
4976 C = COS (F)
4977 S = SIN (F)
4978 RETURN
4979 END
4980
4981
4982 SUBROUTINE SIROBO( NBEG, NEND, THE, PHI, DBEX, DBEY, DBEZ)
4983C **********************************************************************
4984C THIS IS A SLIGHTLY ALTERED VERSION OF "LUROBO" [JETSET63.PYTHIA] *
4985C SET TO WORK IN THE SIBYL ENVIROMENT. THE TRANSFORMATION IS PERFORMED *
4986C ON PARTICLES NUMBER FROM NBEG TO NEND. COMMON BLOCKS CHANGED. *
4987C TSS, Oct '87 *
4988C modification use directly BETA in double precision in input (PL) *
4989C **********************************************************************
4990 COMMON /S_PLIST/ NP, PLIST(5000,5), LLIST(5000)
4991 DIMENSION ROT(3,3),PV(3)
4992 DOUBLE PRECISION DP(4),DBEX,DBEY,DBEZ,DGA,DBEP,DGABEP
4993 IF(THE**2+PHI**2 .LE. 1E-20) GO TO 131
4994C...ROTATE (TYPICALLY FROM Z AXIS TO DIRECTION THETA,PHI)
4995 ROT(1,1)=COS(THE)*COS(PHI)
4996 ROT(1,2)=-SIN(PHI)
4997 ROT(1,3)=SIN(THE)*COS(PHI)
4998 ROT(2,1)=COS(THE)*SIN(PHI)
4999 ROT(2,2)=COS(PHI)
5000 ROT(2,3)=SIN(THE)*SIN(PHI)
5001 ROT(3,1)=-SIN(THE)
5002 ROT(3,2)=0.
5003 ROT(3,3)=COS(THE)
5004 DO 120 I=NBEG,NEND
5005 DO 100 J=1,3
5006 100 PV(J)=PLIST(I,J)
5007 DO 110 J=1,3
5008 110 PLIST(I,J)=ROT(J,1)*PV(1)+ROT(J,2)*PV(2)+ROT(J,3)*PV(3)
5009 120 CONTINUE
5010 131 IF(DBEX**2+DBEY**2+DBEZ**2 .LE. 1D-20) GO TO 151
5011C...LORENTZ BOOST (TYPICALLY FROM REST TO MOMENTUM/ENERGY=BETA)
5012 DGA=1D0/DSQRT(1D0-DBEX**2-DBEY**2-DBEZ**2)
5013 DO 140 I=NBEG, NEND
5014 DO 130 J=1,4
5015 130 DP(J)=PLIST(I,J)
5016 DBEP=DBEX*DP(1)+DBEY*DP(2)+DBEZ*DP(3)
5017 DGABEP=DGA*(DGA*DBEP/(1D0+DGA)+DP(4))
5018 PLIST(I,1)=DP(1)+DGABEP*DBEX
5019 PLIST(I,2)=DP(2)+DGABEP*DBEY
5020 PLIST(I,3)=DP(3)+DGABEP*DBEZ
5021 PLIST(I,4)=DGA*(DP(4)+DBEP)
5022 140 CONTINUE
5023 151 RETURN
5024 END
5025 SUBROUTINE SSLOPE (S, BP, BM)
5026 COMMON /BLOCKD/ CP, DP, EP, CM, DM
5027 AL = LOG(S)
5028 BP = CP + DP*AL + EP*AL*AL
5029 BM = CM + DM*AL
5030 RETURN
5031 END
5032
5033 SUBROUTINE STRING_FRAG(E0,IFL1,IFL2,PX1,PY1,PX2,PY2,IFBAD)
5034C...This routine fragments a string of energy E0
5035C. the ends of the strings have flavors IFL1 and IFL2
5036C. the particles produced are in the jet-jet frame
5037C. with IFL1 going in the +z direction
5038C. E0 = total energy in jet-jet system
5039C. This version consider also a primordial pT attached
5040C. to the ends of the string PX1,PY1, PX2,PY2
5041C. OUTPUT: IFBAD =1 kinematically impossible decay
5042c
5043c Modified Nov. 91. RSF and TSS to fragment symetrically
5044c ie forward and backward are fragmented as leading.
5045c Change- Dec. 92 RSF. call to ptdis moved- to use flavor
5046c of NEW quark in fragmentation.
5047C...........................................................
5048 COMMON /S_PLIST/ NP, P(5000,5), LLIST(5000)
5049 COMMON /S_MASS1/ AM(49), AM2(49)
5050 COMMON /S_diagnostics/ntry,Iflag(5000),xm(5000),zst(5000)
5051 DIMENSION WW(2,2), PTOT(4), PX(3),PY(3),IFL(3)
5052 DIMENSION LPOINT(3000), PMQ(3)
5053 LOGICAL LRANK
5054 DATA LRANK/.true./
5055
5056C...initialise
5057 NTRY = 0
5058 IFBAD = 0
5059200 NTRY = NTRY + 1
5060 IF (NTRY .GT. 50) THEN
5061 IFBAD = 1
5062 RETURN
5063 ENDIF
5064 I = NP
5065 DO K=1,2
5066 WW(K,1) = 1.
5067 WW(K,2) = 0.
5068 ENDDO
5069 PX(1) = PX1
5070 PY(1) = PY1
5071 PX(2) = PX2
5072 PY(2) = PY2
5073 PX(3) = 0.
5074 PY(3) = 0.
5075 PTOT (1) = PX1+PX2
5076 PTOT (2) = PY1+PY2
5077 PTOT (3) = 0.
5078 PTOT (4) = E0
5079 IFL(1) = IFL1
5080 IFL(2) = IFL2
5081 PMQ(1) = QMASS(IFL(1))
5082 PMQ(2) = QMASS(IFL(2))
5083
5084 IBLEAD = 0
5085C
5086C SET FLAG FOR GENERATION OF LEADING PARTICLES.
5087C "AND" IS FOR PPBAR ( DIQUARK AT BOTH ENDS)
5088C "OR" IS FOR PP, PPI, ( DIQUARK AT ONE END.)
5089C
5090 IF (IABS(IFL1) .GT. 10 .AND. IABS(IFL2) .GT. 10) THEN
5091 IBLEAD = 2
5092 I = I+1
5093 JT = 1.5+RNDM(0)
5094 GOTO 350
5095 ENDIF
5096 IF (IABS(IFL1) .GT. 10 .OR. IABS(IFL2) .GT. 10) THEN
5097 IBLEAD = 1
5098 I = I+1
5099 JT = 1
5100 IF (IABS(IFL2) .GT. 10) JT = 2
5101 GOTO 350
5102 ENDIF
5103
5104C...produce new particle: side, pT
5105300 I=I+1
5106 IF (IBLEAD .GT. 0) THEN
5107 JT = 3 - JT
5108 GO TO 350
5109 ENDIF
5110c
5111 349 continue
5112 JT=1.5+RNDM(0)
5113 350 JR=3-JT
5114 LPOINT(I) = JT
5115 Iflag(i)=0
5116c old call to Ptdis. pre Dec. 92
5117c CALL PTDIS (IFL(JT), PX(3),PY(3))
5118
5119C...particle ID and pt.
5120 999 continue
5121 CALL IFLAV (IFL(JT), 0, IFL(3), LLIST(I))
5122 991 continue
5123 PMQ(3) = QMASS(IFL(3))
5124 P(I,5) = AM(IABS(LLIST(I)))
5125 CALL PTDIS (IFL(3), PX(3),PY(3))
5126C...fill transverse momentum
5127 P(I,1) = PX(JT) + PX(3)
5128 P(I,2) = PY(JT) + PY(3)
5129 XMT2 = P(I,5)**2+P(I,1)**2+P(I,2)**2
5130
5131
5132C...test end of fragmentation
5133
5134 WREM2 = PTOT(4)**2-PTOT(1)**2-PTOT(2)**2-PTOT(3)**2
5135 IF (WREM2 .LT. 0.1) GOTO 200
5136 WMIN = PMQ(1)+PMQ(2)+2.*PMQ(3)+ 1.1 + (2.*RNDM(0)-1.)*0.2
5137c WMIN = PMQ(jr)+sqrt(xmt2)+pmq(3)+ 1.1 +(2.*RNDM(0)-1.)*0.2
5138c IF (WREM2 .LT. WMIN**2) goto 400
5139 IF (WREM2 .LT. WMIN**2) Then! goto 400
5140 if (abs(ifl(3)).ne.3) GOTO 400
5141 goto 200
5142 endif
5143
5144c
5145C...Choose z
5146 xm(i)=xmt2
5147 IF (IBLEAD .GT. 0.and.abs(ifl(jt)).gt.10) THEN
5148c Special frag. for leading Baryon only
5149 Z = ZBLEAD (IABS(LLIST(I)))
5150 IBLEAD = IBLEAD - 1
5151 ELSE
5152 Z = ZDIS (IFL(3),ifl(jt),XMT2)
5153 ENDIF
5154c store z for spliting
5155 if (z.le.0) WRITE (6,*) 'z less than 0 =',z
5156 zst(i)=z
5157 WW(JT,2) = Z*WW(JT,1)
5158 WW(JR,2) = XMT2/(WW(JT,2)*E0**2)
5159
5160 P(I,3) = WW(1,2)*0.5*E0 - WW(2,2)*0.5*E0
5161 P(I,4) = WW(1,2)*0.5*E0 + WW(2,2)*0.5*E0
5162
5163 DO J=1,4
5164 PTOT (J) = PTOT(J) - P(I,J)
5165 ENDDO
5166 DO K=1,2
5167 WW(K,1) = WW(K,1) - WW(K,2)
5168 ENDDO
5169
5170C...Reset pT and flavor at ebds of the string
5171 PX(JT) = -PX(3)
5172 PY(JT) = -PY(3)
5173 IFL(JT) =-IFL(3)
5174 PMQ(JT) = PMQ(3)
5175 GOTO 300
5176
5177C...Final two hadrons
5178400 IF (IFL(JR)*IFL(3) .GT. 100) GOTO 200
5179c debug- output ptot
5180 iflag(i)=1
5181 iflag(i+1)=1
5182 do iii=1,4
5183 p(4999,iii)=ptot(iii)
5184 enddo
5185c p(4999,5)=sqrt(wrem2)
5186 CALL IFLAV (IFL(JR), -IFL(3), IFLA, LLIST(I+1))
5187 P(I+1,5) = AM(IABS(LLIST(I+1)))
5188 P(I,1) = PX(JT)+PX(3)
5189 P(I,2) = PY(JT)+PY(3)
5190 I1 = I+1
5191 P(I+1,1) = PX(JR)-PX(3)
5192 P(I+1,2) = PY(JR)-PY(3)
5193 XM1 = P(I,5)**2+P(I,1)**2+P(I,2)**2
5194 XM2 = P(I1,5)**2+P(I1,1)**2+P(I1,2)**2
5195 IF (SQRT(XM1)+SQRT(XM2) .GT. SQRT(WREM2)) GOTO 200
5196 WREM = SQRT(WREM2)
5197 EA1 = (WREM2+XM1-XM2)/(2.*WREM)
5198 PA2 = (EA1**2-XM1)
5199 if (pa2.gt.0) then
5200 PA = SQRT(PA2)
5201 else
5202 goto 200
5203 endif
5204 BA = PTOT(3)/PTOT(4)
5205 GA = PTOT(4)/WREM
5206 S = FLOAT(3-2*JT)
5207 P(I,3) = GA*(BA*EA1+S*PA)
5208 P(I,4) = GA*(EA1+BA*S*PA)
5209 P(I+1,3) = PTOT(3)-P(I,3)
5210 P(I+1,4) = PTOT(4)-P(I,4)
5211 NA= NP+1
5212 NP=I+1
5213
5214C...reorder particles along chain (in rank)
5215 IF (LRANK) THEN
5216 N1 = NA-1
5217 N2 = 0
5218 DO J=NA,NP
5219 IF(LPOINT(J) .EQ. 2) THEN
5220 N2=N2+1
5221 LLIST (NP+N2) = LLIST(J)
5222 DO K=1,5
5223 P(NP+N2,K)=P(J,K)
5224 ENDDO
5225 ELSE
5226 N1= N1+1
5227 IF (N1.LT.J) THEN
5228 LLIST(N1) = LLIST(J)
5229 DO K=1,5
5230 P(N1,K) = P(J,K)
5231 ENDDO
5232 ENDIF
5233 ENDIF
5234 ENDDO
5235 JJ=N1
5236 DO J=NP+N2,NP+1,-1
5237 JJ= JJ+1
5238 LLIST(JJ) = LLIST(J)
5239 DO K=1,5
5240 P(JJ,K) = P(J,K)
5241 ENDDO
5242 ENDDO
5243 ENDIF
5244
5245 RETURN
5246 END
5247 FUNCTION WOOD_SAXON (R, JA)
5248C....Woods Saxon nuclear density (normalised to 1)
5249C. for a nucleus of mass number A.
5250C. INPUT R = (fm)
5251C. JA = mass number
5252C. OUTPUT (fm**-3)
5253C......................................................
5254 COMMON /CWOOD/ RR0(19:56), AA0(19:56), CC0(19:56)
5255 WOOD_SAXON = CC0(JA)/(1.+EXP((R-RR0(JA))/AA0(JA)))
5256 RETURN
5257 END
5258
5259 SUBROUTINE WOOD_SAXON_INI
5260 COMMON /CWOOD/ RR0(19:56), AA0(19:56), CC0(19:56)
5261 DATA PI /3.1415926/
5262C...Wood-Saxon parameters from table 6.2 of Barrett and Jackson
5263 RR0 (19) = 2.59
5264 AA0 (19) = 0.564
5265 RR0 (20) = 2.74
5266 AA0 (20) = 0.569
5267 RR0 (22) = 2.782
5268 AA0 (22) = 0.549
5269 RR0 (24) = 2.99
5270 AA0 (24) = 0.548
5271 RR0 (27) = 2.84
5272 AA0 (27) = 0.569
5273 RR0 (28) = 3.14
5274 AA0 (28) = 0.537
5275 RR0 (29) = 3.77
5276 AA0 (29) = 0.52
5277 RR0 (48) = 3.912
5278 AA0 (48) = 0.5234
5279 RR0 (56) = 3.98
5280 AA0 (56) = 0.569
5281 DO J=19, 56
5282 IF (RR0(J) .LE. 0.) THEN
5283 RR0(J) = 1.05*FLOAT(J)**0.333333
5284 AA0(J) = 0.545
5285 ENDIF
5286 CC0(J)=3./(4.*PI*RR0(J)**3)/(1.+((AA0(J)*PI)/RR0(J))**2)
5287 ENDDO
5288 RETURN
5289 END
5290
5291 FUNCTION ZBLEAD (LB)
5292C...fragmentation function for leading baryon
5293C. simple form: f(z) = a + x**b
5294C INPUT : LB = particle code.
5295C..................................................
5296 COMMON /S_CZLEAD/ CLEAD, FLEAD
5297c COMMON /S_SZLEAD/ CLEADs, FLEADs
5298 COMMON /S_CHP/ ICHP(49), ISTR(49), IBAR(49)
5299
5300 IC = ICHP(Lb)*ISIGN(1,Lb)
5301
5302 if (lb.ge.34.and.lb.le.39) then ! Lambda's and Sigma's
5303 665 ZBLEAD = RNDM(0)
5304 if (zblead.le..01) goto 665
5305c zblead=zdisn(1) ! blead**2 ! soft
5306 else if (ic.eq.0) then
5307 zblead=zdisn(1) ! blead**2 !soft
5308 else if (ic.eq.1) then ! fast protons only
5309 if (abs(lb).eq.13) then
5310 IF (RNDM(0) .LT. CLEAD) THEN
5311 666 ZBLEAD = RNDM(0)
5312 if (zblead.le..01) goto 666
5313 ELSE
5314 zblead=1.-zdisn(1) ! zblead**2 !hard
5315 ENDIF
5316 continue
5317 else
5318 zblead=zdisn(1) ! zblead**2 !hard
5319 endif
5320 else if (ic.eq.2) then ! fast delta++
5321 zblead=1.- zdisn(1) ! (zblead)**.3333
5322 else
5323 zblead=RNDM(0) ! zdisn(1) !hard
5324 endif
5325 RETURN
5326 END
5327 FUNCTION ZDIS (IFL1,ifl2, XMT2)
5328C...z distribution
5329 COMMON /S_CZDIS/ FAin, FB0in
5330 COMMON /S_CZDISs/ FAs1, fAs2
5331 COMMON /S_RUN/ SQS, S, Q2MIN, XMIN, ZMIN , kb ,kt
5332 fa=fain
5333 fb0=fb0in
5334C following statement corrected by D.H. may 10, 1996
5335 if (abs(kb).ge.13) then ! baryons only
5336 if (abs(ifl2).eq.3) fa=fain+fas2
5337 if (abs(ifl1).eq.3) fa=fain+fas1
5338 endif
5339 FB = FB0*XMT2
5340 IF(FA.GT.0.01.AND.ABS(FA-1.)/FB.LE.0.01) ZMAX=FB/(1.+FB)+
5341 + (1.-FA)*FB**2/(1.+FB)**3
5342 IF(FA.GT.0.01.AND.ABS(FA-1.)/FB.GT.0.01) ZMAX=0.5*(1.+FB-
5343 + SQRT((1.-FB)**2+4.*FA*FB))/(1.-FA)
5344 IF(ZMAX.LT.0.1) ZDIV=2.75*ZMAX
5345 IF(ZMAX.GT.0.85)
5346 + ZDIV=ZMAX-0.6/FB**2+(FA/FB)*ALOG((0.01+FA)/FB)
5347C...Choice if z, preweighted for peaks at low or high z
5348100 Z=RNDM(0)
5349 IDIV=1
5350 FPRE=1.
5351 IF (ZMAX.LT.0.1) THEN
5352 IF(1..LT.RNDM(0)*(1.-ALOG(ZDIV))) IDIV=2
5353 IF (IDIV.EQ.1) Z=ZDIV*Z
5354 IF (IDIV.EQ.2) Z=ZDIV**Z
5355 IF (IDIV.EQ.2) FPRE=ZDIV/Z
5356 ELSEIF (ZMAX.GT.0.85) THEN
5357 IF(1..LT.RNDM(0)*(FB*(1.-ZDIV)+1.)) IDIV=2
5358 IF (IDIV.EQ.1) Z=ZDIV+ALOG(Z)/FB
5359 IF (IDIV.EQ.1) FPRE=EXP(FB*(Z-ZDIV))
5360 IF (IDIV.EQ.2) Z=ZDIV+Z*(1.-ZDIV)
5361 ENDIF
5362C...weighting according to the correct formula
5363 IF (Z.LE.FB/(50.+FB).OR.Z.GE.1.) GOTO 100
5364 FVAL=(ZMAX/Z)*EXP(FB*(1./ZMAX-1./Z))
5365 IF(FA.GT.0.01) FVAL=((1.-Z)/(1.-ZMAX))**FA*FVAL
5366 IF(FVAL.LT.RNDM(0)*FPRE) GOTO 100
5367 ZDIS=Z
5368 RETURN
5369 END
5370 FUNCTION ZDISN (n)
5371C...Generate (1-x)**n
5372 continue
5373666 rmin=1.1
5374 do i=1,n+1
5375 R1=RNDM(0)
5376 IF (R1.LE.RMIN) RMIN=R1
5377 ENDDO
5378 ZDISn=RMIN
5379 if (zdisn.le..01) goto 666
5380 if (zdisn.ge..99) goto 666
5381 END
5382 FUNCTION ZSAMPLE (ZMIN,L)
5383C...This function returns as output a value z=log(x)
5384C. distributed as f(x) = g(x) + 4/9 *(q(x) + qbar(x))
5385C. from a minimum value ZMIN to 0,
5386C. for a proton (L=1) or a pi (L=2)
5387C. needs to be initialised with: CALL ZSAMPLE_INI
5388C.....................................................
5389 COMMON /S_CZGEN/ XA,XB,XMAX,ZA,ZB,ZMAX,DX,DZ,NX,NZ,APART(2),
5390 + FFA(2),FFB(2),
5391 + DFX(2),DFZ(2),XX(200,2),ZZ(200,2),FFX(200,2),FFZ(200,2)
5392
5393 F = PART_INT(ZMIN,L)*RNDM(0)
5394C D.H.
5395 IF (F .GE. FFA(L)) THEN
5396 ZSAMPLE = ZA - (F-FFA(L))/APART(L)
5397C D.H.
5398 ELSE IF (F .GE. FFB(L)) THEN
5399 JF = (F-FFB(L))/DFZ(L) + 1
5400 F0 = FFB(L) + DFZ(L)*FLOAT(JF-1)
5401 T = (F-F0)/DFZ(L)
5402 ZSAMPLE = ZZ(JF,L)*(1.-T)+ZZ(JF+1,L)*T
5403 ELSE
5404 JF = F/DFX(L)+1
5405 F0 = DFX(L)*FLOAT(JF-1)
5406 T = (F-F0)/DFX(L)
5407 X = XX(JF,L)*(1.-T)+XX(JF+1,L)*T
5408 ZSAMPLE = LOG(X)
5409 ENDIF
5410 RETURN
5411 END
5412 SUBROUTINE ZSAMPLE_INI
5413C...This subroutine initialise the generation of
5414C. z = log(x) for the generation of z according
5415C. to the structure functions
5416C..................................................
5417 COMMON /S_CZGEN/ XA,XB,XMAX,ZA,ZB,ZMAX,DX,DZ,NX,NZ,APART(2),
5418 + FFA(2),FFB(2),
5419 + DFX(2),DFZ(2),XX(200,2),ZZ(200,2),FFX(200,2),FFZ(200,2)
5420
5421 XA = 1.E-04
5422 XB = 1.E-01
5423 XMAX = 0.80
5424 ZA = LOG(XA)
5425 ZB = LOG(XB)
5426 ZMAX = LOG(XMAX)
5427 NX = 200
5428 NZ = 200
5429 DX = (XMAX-XB)/FLOAT(NX-1)
5430 DZ = (ZB-ZA)/FLOAT(NZ-1)
5431
5432 DO L=1,2
5433C very small x: f(x) = A/x
5434 APART(L) = PARTON(0.,L)
5435
5436C large x: interpolation in x
5437 FFX(1,L) = 0.
5438 DO J=2,NX
5439 X = XMAX - DX*(FLOAT(J)-0.5)
5440 G = PARTON(X,L)/X
5441 FFX(J,L) = FFX(J-1,L)+G*DX
5442 ENDDO
5443 CALL INVERT_ARRAY (FFX(1,L),XMAX,-DX,NX,XX(1,L),FMIN,
5444 + DFX(L))
5445
5446C small x: interpolation in log(x)
5447 FFZ(1,L) = FFX(NX,L)
5448 DO J=2,NZ
5449 Z = ZB - DZ*(FLOAT(J)-0.5)
5450 X = EXP(Z)
5451 G = PARTON(X,L)
5452 FFZ(J,L) = FFZ(J-1,L)+G*DZ
5453 ENDDO
5454 CALL INVERT_ARRAY (FFZ(1,L),ZB,-DZ,NZ,ZZ(1,L),FMIN,DFZ(L))
5455 FFA(L) = FFZ(NZ,L)
5456 FFB(L) = FFX(NX,L)
5457 ENDDO
5458 RETURN
5459 END
5460 BLOCK DATA DATDEC
5461 COMMON /S_CSYDEC/ IDB(49), CBR(102), KDEC(612), LBARP(49)
5462 COMMON /S_MASS1/ AM(49), AM2(49)
5463 COMMON /S_CHP/ ICHP(49), ISTR(49), IBAR(49)
5464 COMMON /S_CNAM/ NAMP (0:49)
5465 CHARACTER NAMP*6
5466 DATA CBR /3*1.,0.,1.,1.,0.6351,0.8468,0.9027,0.9200,0.9518,1.,
5467 + 0.6351,0.8468,0.9027,0.9200,0.9518,1.,0.2160,0.3398,0.4748,
5468 + 0.6098,0.8049,1.,0.6861,1.,3*0.,0.5,1.,0.5,1.,
5469 + 0.3890,0.7080,0.9440,0.9930,1.,0.,0.4420,0.6470,0.9470,0.9770,
5470 + 0.9990,4*1.,0.6670,1.,9*0.,0.6670,1.,0.6670,1.,0.6670,1.,
5471 + 0.8880,0.9730,1.,0.4950,0.8390,0.9870,1.,0.5160,5*1.,0.6410,1.,
5472 + 1.,0.67,1.,0.33,1.,1.,0.88,0.94,1.,0.88,0.94,1.,0.88,0.94,1.,
5473 + 0.33,1.,0.67,1.,0.678,0.914,1./
5474 DATA AM / 0.,2*0.511E-3, 2*0.10566, 0.13497, 2*0.13957,
5475 + 2*0.49365, 2*0.49767, 0.93827, 0.93957, 4*0.,0.93827,
5476 + 0.93957, 2*0.49767, 0.54880,0.95750,2*0.76830,0.76860,
5477 + 2*0.89183,2*0.89610,0.78195,1.01941,1.18937,1.19255,
5478 + 1.19743,1.31490,1.32132,1.11563,1.23100,1.23500,
5479 + 1.23400,1.23300,1.38280,1.38370,1.38720,
5480 + 1.53180,1.53500,1.67243 /
5481 DATA AM2 /0.,2*2.61121E-07,2*0.011164,0.018217,0.019480,
5482 + 0.019480,0.243690,0.243690,0.247675,0.247675,0.880351,0.882792,
5483 + 0.000000,0.000000,0.000000,0.000000,0.880351,0.882792,0.247675,
5484 + 0.247675,0.301181,0.916806,0.590285,0.590285,0.590746,0.795361,
5485 + 0.795361,0.802995,0.802995,0.611446,1.039197,1.414601,1.422176,
5486 + 1.433839,1.728962,1.745887,1.244630,1.515361,1.525225,1.522765,
5487 + 1.520289,1.912136,1.914626,1.924324,2.346411,2.356225,2.797022/
5488 DATA IDB /
5489 + 0,0,0,1,2,3,5,6,7,13,19,25,8*0,30,32,34,40,46,47,48,49,60,62,
5490 + 64,66,69,73,75,76,77,78,79,81,82,84,86,87,90,93,96,98,100/
5491 DATA KDEC /
5492 + 3,1,15,2,18,0,3,1,16,3,17,0,2,0,1,1,8*0,2,0,4,17,0,0,2,0,5,18,0,
5493 + 0,2,0,4,17,0,0,2,0,7,6,0,0,3,0,7,7,8,0,3,0,7,6,6,0,3,1,17,4,6,0,
5494 + 3,1,15,2,6,0,2,0,5,18,0,0,2,0,8,6,0,0,3,0,8,8,7,0,3,0,8,6,6,0,3,
5495 + 1,18,5,6,0,3,1,16,3,6,0,3,0,6,6,6,0,3,0,7,8,6,0,3,1,18,5,7,0,3,
5496 + 1,17,4,8,0,3,1,16,3,7,0,3,1,15,2,8,0,2,0,7,8,0,0,2,0,6,6,20*0,1,
5497 + 0,11,3*0,1,0,12,0,0,0,1,0,11,0,0,0,1,0,12,0,0,0,2,0,1,1,0,0,3,0,
5498 + 6,6,6,0,3,0,7,8,6,0,3,0,1,7,8,0,3,0,1,3,2,7*0,3,0,7,8,23,0,3,0,6
5499 + ,6,23,0,2,0,1,27,0,0,2,0,1,32,0,0,2,0,1,1,0,0,3,0,6,6,6,0,2,0,7,
5500 + 6,0,0,2,0,8,6,0,0,2,0,7,8,0,0,2,0,21,7,0,0,2,0,9,6,0,0,54*0,2,0,
5501 + 22,8,0,0,2,0,10,6,0,0,2,0,9,8,0,0,2,0,21,6,0,0,2,0,10,7,0,0,
5502 + 2,0,22,6,0,0,3,0,7,8,6,0,2,0,1,6,0,0,2,0,7,8,0,0,2,0,9,10,0,
5503 + 0,2,0,11,12,0,0,3,0,7,
5504 + 8,6,0,2,0,1,23,0,0,2,0,13,6,0,0,2,0,14,7,0,0,2,0,39,1,0,0,2,
5505 + 0,14,8,0,0,2,0,39,6,0,0,2,0,39,8,0,0,2,0,13,8,0,0,2,0,
5506 + 14,6,0,0,2,0,13,7,0,0,2,0,13,6,
5507 + 0,0,2,0,14,7,0,0,2,0,13,8,0,0,2,0,14,6,0,0,2,0,14,8,0,0,2,0,
5508 + 39,7,0,0,2,0,34,6,0,0,2,0,35,7,0,0,2,0,39,6,0,0,2,0,34,8,0,0,
5509 + 2,0,36,7,0,0,2,0,39,8,0,0,2,
5510 + 0,35,8,0,0,2,0,36,6,0,0,2,0,37,6,0,0,2,0,38,7,0,0,2,0,
5511 + 37,8,0,0,2,0,38,6,0,0,2,0,39,10,0,0,2,0,37,8,0,0,2,0,38,6,0,0/
5512 DATA LBARP/1,3,2,5,4,6,8,7,10,9,11,12,-13,-14,16,15,18,17,13,14,
5513 + 22,21,23,24,26,25,27,29,28,31,30,32,33,-34,-35,-36,-37,-38,-39,
5514 + -40,-41,-42,-43,-44,-45,-46,-47,-48,-49/
5515 DATA ICHP /0,1,-1,1,-1,0,1,-1,1,-1,0,0,1,0,4*0,-1,0,4*0,
5516 + 1,-1,0,1,-1,4*0,1,0,-1,0,-1,0,2,1,0,-1,1,0,-1,0,-1,-1/
5517 DATA ISTR /8*0,-1,+1,10,10,8*0,-1,+1,5*0,-1,+1,-1,+1,2*0,
5518 + 3*1,2*2,1,4*0,3*1,2*2,3 /
5519 DATA IBAR /12*0,2*1,4*0,2*-1,13*0,16*1/
5520 DATA NAMP /
5521 + ' ','gam ','e+','e-','mu+','mu-','pi0',
5522 + 'pi+','pi-','k+', 'k-', 'k0l','k0s',
5523 + 'p', 'n', 'nue', 'nueb', 'num', 'numb', 'pbar', 'nbar',
5524 + 'k0', 'k0b', 'eta', 'etap', 'rho+', 'rho-','rho0',
5525 + 'k*+','k*-','k*0','k*0b','omeg', 'phi', 'SIG+', 'SIG0',
5526 + 'SIG-','XI0','XI-','LAM','DELT++','DELT+','DELT0','DELT-',
5527 + 'SIG*+ ','SIG*0','SIG*-', 'XI*0', 'XI*-', 'OME*-'/
5528 END
5529 SUBROUTINE DECPAR (LA,P0,ND,LL,P)
5530C...This subroutine generates the decay of a particle
5531C. with ID = LA, and 5-momentum P0(1:5)
5532C. into ND particles of 5-momenta P(j,1:5) (j=1:ND)
5533C.
5534C. If the initial particle code is LA=0
5535C. then ND and LL(1:ND) are considered as input and
5536C. the routine generates a phase space decay into ND
5537C. particles of codes LL(1:nd)
5538C.
5539C. june 1992
5540C. This version contains the decay of polarized muons
5541C. The muon codes are L = 4 : mu+ R
5542C. -4 : mu+ L
5543C. 5 : mu- L
5544C. -5 : mu- R
5545C------------------------------------------------------
5546 COMMON /S_CSYDEC/ IDB(49), CBR(102), KDEC(612), LBARP(49)
5547 COMMON /S_MASS1/ AM(49), AM2(49)
5548 DIMENSION P0(5), LL(10), P(10,5)
5549 DIMENSION PV(10,5), RORD(10), UE(3),BE(3), FACN(3:10)
5550 DATA FACN /2.,5.,15.,60.,250.,1500.,12000.,120000./
5551 DATA PI /3.1415926/
5552
5553C...c.m.s. Momentum in two particle decays
5554 PAWT(A,B,C) = SQRT((A**2-(B+C)**2)*(A**2-(B-C)**2))/(2.*A)
5555
5556C...Phase space decay into the particles in the list
5557 IF (LA .EQ. 0) THEN
5558 MAT = 0
5559 MBST = 0
5560 PS = 0.
5561 DO J=1,ND
5562 P (J,5) = AM(IABS(LL(J)))
5563 PV(J,5) = AM(IABS(LL(J)))
5564 PS = PS+P(J,5)
5565 ENDDO
5566 DO J=1,4
5567 PV(1,J) = P0(J)
5568 ENDDO
5569 PV(1,5) = P0(5)
5570 GOTO 140
5571 ENDIF
5572
5573C...Choose decay channel
5574 L = IABS(LA)
5575 ND=0
5576 IDC = IDB(L)-1
5577 IF (IDC+1 .LE.0) RETURN
5578 RBR = RNDM(0)
5579110 IDC=IDC+1
5580 IF(RBR.GT.CBR(IDC)) GOTO 110
5581
5582 KD =6*(IDC-1)+1
5583 ND = KDEC(KD)
5584 MAT= KDEC(KD+1)
5585 MBST=0
5586 IF (MAT .GT.0 .AND. P0(4) .GT. 20*P0(5)) MBST=1
5587 IF (MAT .GT.0 .AND. MBST .EQ. 0)
5588 + BETA = SQRT(P0(1)**2+P0(2)**2+P0(3)**2)/P0(4)
5589 PS = 0.
5590 DO J=1,ND
5591 LL(J) = KDEC(KD+1+J)
5592 P(J,5) = AM(LL(J))
5593 PV(J,5) = AM(LL(J))
5594 PS = PS + P(J,5)
5595 ENDDO
5596 DO J=1,4
5597 PV(1,J) = 0.
5598 IF (MBST .EQ. 0) PV(1,J) = P0(J)
5599 ENDDO
5600 IF (MBST .EQ. 1) PV(1,4) = P0(5)
5601 PV(1,5) = P0(5)
5602
5603140 IF (ND .EQ. 2) GOTO 280
5604
5605 IF (ND .EQ. 1) THEN
5606 DO J=1,4
5607 P(1,J) = P0(J)
5608 ENDDO
5609 RETURN
5610 ENDIF
5611
5612C...Calculate maximum weight for ND-particle decay
5613 WWTMAX = 1./FACN(ND)
5614 PMAX=PV(1,5)-PS+P(ND,5)
5615 PMIN=0.
5616 DO IL=ND-1,1,-1
5617 PMAX = PMAX+P(IL,5)
5618 PMIN = PMIN+P(IL+1,5)
5619 WWTMAX = WWTMAX*PAWT(PMAX,PMIN,P(IL,5))
5620 ENDDO
5621
5622C...generation of the masses, compute weight, if rejected try again
5623240 RORD(1) = 1.
5624 DO 260 IL1=2,ND-1
5625 RSAV = RNDM(0)
5626 DO 250 IL2=IL1-1,1,-1
5627 IF(RSAV.LE.RORD(IL2)) GOTO 260
5628250 RORD(IL2+1)=RORD(IL2)
5629260 RORD(IL2+1)=RSAV
5630 RORD(ND) = 0.
5631 WT = 1.
5632 DO 270 IL=ND-1,1,-1
5633 PV(IL,5)=PV(IL+1,5)+P(IL,5)+(RORD(IL)-RORD(IL+1))*(PV(1,5)-PS)
5634270 WT=WT*PAWT(PV(IL,5),PV(IL+1,5),P(IL,5))
5635 IF (WT.LT.RNDM(0)*WWTMAX) GOTO 240
5636
5637C...Perform two particle decays in respective cm frame
5638280 DO 300 IL=1,ND-1
5639 PA=PAWT(PV(IL,5),PV(IL+1,5),P(IL,5))
5640 UE(3)=2.*RNDM(0)-1.
5641 PHI=2.*PI*RNDM(0)
5642 UT = SQRT(1.-UE(3)**2)
5643 UE(1) = UT*COS(PHI)
5644 UE(2) = UT*SIN(PHI)
5645 DO 290 J=1,3
5646 P(IL,J)=PA*UE(J)
5647290 PV(IL+1,J)=-PA*UE(J)
5648 P(IL,4)=SQRT(PA**2+P(IL,5)**2)
5649300 PV(IL+1,4)=SQRT(PA**2+PV(IL+1,5)**2)
5650
5651C...Lorentz transform decay products to lab frame
5652 DO 310 J=1,4
5653310 P(ND,J)=PV(ND,J)
5654 DO 340 IL=ND-1,1,-1
5655 DO 320 J=1,3
5656320 BE(J)=PV(IL,J)/PV(IL,4)
5657 GA=PV(IL,4)/PV(IL,5)
5658 DO 340 I=IL,ND
5659 BEP = BE(1)*P(I,1)+BE(2)*P(I,2)+BE(3)*P(I,3)
5660 DO 330 J=1,3
5661330 P(I,J)=P(I,J)+GA*(GA*BEP/(1.+GA)+P(I,4))*BE(J)
5662340 P(I,4)=GA*(P(I,4)+BEP)
5663
5664C...Weak decays
5665 IF (MAT .EQ. 1) THEN
5666 F1=P(2,4)*P(3,4)-P(2,1)*P(3,1)-P(2,2)*P(3,2)-P(2,3)*P(3,3)
5667 IF (MBST.EQ.1) THEN
5668C WT = P0(5)*P(1,4)*F1
5669 WT = P0(5)*(P(1,4)+FLOAT(LA/L)*P(1,3))*F1
5670 ENDIF
5671 IF (MBST.EQ.0) THEN
5672 WT=F1*(P(1,4)*P0(4)-P(1,1)*P0(1)-P(1,2)*P0(2)-P(1,3)*P0(3))
5673 WT= WT-FLOAT(LA/L)*(P0(4)*BETA*P(1,4)-P0(4)*P(1,3))*F1
5674 ENDIF
5675 WTMAX = P0(5)**4/8.
5676 IF(WT.LT.RNDM(0)*WTMAX) GOTO 240
5677 ENDIF
5678
5679C...Boost back for rapidly moving particle
5680 IF (MBST .EQ. 1) THEN
5681 DO 440 J=1,3
5682440 BE(J)=P0(J)/P0(4)
5683 GA= P0(4)/P0(5)
5684 DO 460 I=1,ND
5685 BEP=BE(1)*P(I,1)+BE(2)*P(I,2)+BE(3)*P(I,3)
5686 DO 450 J=1,3
5687450 P(I,J)=P(I,J)+GA*(GA*BEP/(1.+GA)+P(I,4))*BE(J)
5688460 P(I,4)=GA*(P(I,4)+BEP)
5689 ENDIF
5690
5691C...labels for antiparticle decay
5692 IF (LA .LT. 0 .AND. L .GT. 18) THEN
5693 DO J=1,ND
5694 LL(J) = LBARP(LL(J))
5695 ENDDO
5696 ENDIF
5697
5698 RETURN
5699 END
5700 SUBROUTINE DECPR (LUN)
5701C...Print on unit LUN the list of particles and decay channels
5702 COMMON /S_CSYDEC/ IDB(49), CBR(102), KDEC(612), LBARP(49)
5703 COMMON /S_MASS1/ AM(49), AM2(49)
5704 COMMON /S_CNAM/ NAMP (0:49)
5705 CHARACTER*6 NAMP
5706 DIMENSION LL(3)
5707
5708 DO L=1,49
5709 IDC = IDB(L)-1
5710 NC = 0
5711 WRITE (LUN,10) L,NAMP(L), AM(L)
5712 IF(IDC+1 .GT. 0) THEN
5713 CB = 0.
5714110 IDC=IDC+1
5715 NC = NC+1
5716 CBOLD = CB
5717 CB = CBR(IDC)
5718 BR = CB-CBOLD
5719 KD = 6*(IDC-1)+1
5720 ND = KDEC(KD)
5721 MAT= KDEC(KD+1)
5722 DO J=1,ND
5723 LL(J) = KDEC(KD+1+J)
5724 ENDDO
5725 WRITE (LUN,15) NC,BR,ND,MAT, (NAMP(LL(J)),J=1,ND)
5726 IF (CB .LT. 1.) GOTO 110
5727 ENDIF
5728 ENDDO
5729 RETURN
573010 FORMAT(1X,I3,2X,A6,3X,F10.4)
573115 FORMAT(5X,I2,2X,F9.4,I4,I4,2X,3(A6,2X))
5732 END
5733 SUBROUTINE DECSIB
5734C----------------------------------------------------------------------------
5735C Code for Decay developed for the SIBYLL montecarlo
5736C----------------------------------------------------------------------------
5737C...Decay all unstable particle in Sibyll
5738C. decayed particle have the code increased by 10000
5739 COMMON /S_CSYDEC/ IDB(49), CBR(102), KDEC(612), LBARP(49)
5740 COMMON /S_PLIST/ NP, P(5000,5), LLIST(5000)
5741 COMMON /S_PLIST1/ LLIST1(5000)
5742 DIMENSION P0(5), LL(10), PD(10,5)
5743 NN = 1
5744 DO J=1,NP
5745 LLIST1(J) = 0
5746 ENDDO
5747 DO WHILE (NN .LE. NP)
5748 L= LLIST(NN)
5749 IF (IDB(IABS(L)) .GT. 0) THEN
5750 DO K=1,5
5751 P0(K) = P(NN,K)
5752 ENDDO
5753 CALL DECPAR (L,P0,ND,LL,PD)
5754 LLIST(NN) = LLIST(NN)+ISIGN(10000,LLIST(NN))
5755 DO J=1,ND
5756 DO K=1,5
5757 P(NP+J,K) = PD(J,K)
5758 ENDDO
5759 LLIST(NP+J)=LL(J)
5760 LLIST1(NP+J)=NN
5761 ENDDO
5762 NP=NP+ND
5763 ENDIF
5764 NN = NN+1
5765 ENDDO
5766 RETURN
5767 END
5768 SUBROUTINE DEC_DEBUG (L,P0, ND, LL, PD)
5769 COMMON /S_CNAM/ NAMP (0:49)
5770 CHARACTER*6 NAMP
5771 DIMENSION P0(5), LL(10), PD(10,5)
5772 ETOT = 0.
5773 DO J=1,ND
5774 ETOT = ETOT + PD(J,4)
5775 ENDDO
5776 WRITE(*,*) NAMP(IABS(L)),' -> ', (NAMP(IABS(LL(J))),J=1,ND)
5777 WRITE(*,*) ' Ei, Ef = ', P0(4), ETOT, ' L = ', L
5778 RETURN
5779 END
Note: See TracBrowser for help on using the repository browser.