]>
Commit | Line | Data |
---|---|---|
9ef1c2d9 | 1 | c------------------------------------------------------------------------ |
2 | function ffsigiut(xx1,xx2,jpp,je1,je2) | |
3 | c------------------------------------------------------------------------ | |
4 | c | |
5 | c \int(dt) \int(du) ffsig *s/sh**3 *2*pi*alpha**2 *delta(uh+th+sh) | |
6 | c | |
7 | c----------------------------------------------------------------------- | |
8 | common /ar3/ x1(7),a1(7) | |
9 | include 'epos.incsem' | |
10 | include 'epos.inc' | |
11 | double precision tmin,tmax,t,sh2,sqrtq2s | |
12 | ||
13 | ig=3 | |
14 | s=engy**2 | |
15 | sh=s*xx1*xx2 | |
16 | ffsigiut=0. | |
17 | if(sh.le.4.*q2min)return | |
18 | sh2=dble(sh/2.) | |
19 | c tmin=sh/2-sqrt(sh*sh/4-q2min*sh) | |
20 | sqrtq2s=sqrt(dble(q2min*sh)) | |
21 | tmin=sh2-sqrt((sh2-sqrtq2s)*(sh2+sqrtq2s)) | |
22 | tmax=sh2 | |
23 | do i=1,ig | |
24 | do m=1,2 | |
25 | t=2d0*tmin/(1d0+tmin/tmax-dble(tgss(ig,i)*(2*m-3)) | |
26 | & *(1d0-tmin/tmax)) | |
27 | qq=sngl(t*(1d0-t/dble(sh))) | |
28 | ft=ffsigj(sngl(t),qq,xx1,xx2,jpp,je1,je2)/sh**3 | |
29 | * * (2*pi*pssalf(qq/qcdlam))**2 | |
30 | ffsigiut=ffsigiut+wgss(ig,i)*ft*sngl(t)**2 | |
31 | enddo | |
32 | enddo | |
33 | ffsigiut=ffsigiut | |
34 | * *0.5*sngl(1d0/tmin-1d0/tmax) | |
35 | * *2*pi*s | |
36 | * /2 !CS for parton pair | |
37 | return | |
38 | end | |
39 | ||
40 | c----------------------------------------------------------------------- | |
41 | function ffsigj(t,qt,x1,x2,jpp,je1,je2) | |
42 | c----------------------------------------------------------------------- | |
43 | c | |
44 | c \sum x1*f_i(x1,qt) * x2*f_k(x2,qt) * B_ik | |
45 | c | |
46 | c B_ik = psbori = contribution to Born xsection: | |
47 | c dsigmaBorn/d2pt/dy | |
48 | c = s/pi * delta(s+t+u) * 2*pi*alpha**2 /s**2 * B_ik | |
49 | c | |
50 | c qt = virtuality scale | |
51 | c x1, x2 = light cone momentum fractions | |
52 | c | |
53 | c x*f_j(x,qt) = function fparton(x,qt,j) | |
54 | c | |
55 | c----------------------------------------------------------------------- | |
56 | c jpp: type of Pomeron | |
57 | c 1 ... sea-sea | |
58 | c 2 ... val-sea | |
59 | c 3 ... sea-val | |
60 | c 4 ... val-val | |
61 | c 5 ... all | |
62 | c je = emission type | |
63 | c 0 ... no emissions | |
64 | c 1 ... emissions | |
65 | c 2 ... all | |
66 | c----------------------------------------------------------------------- | |
67 | include 'epos.incsem' | |
68 | include 'epos.inc' | |
69 | ||
70 | s=engy**2*x1*x2 | |
71 | ||
72 | if(jpp.ne.5)then | |
73 | ji1=mod(jpp+1,2)+1 | |
74 | ji2=(jpp+1)/2 | |
75 | sea1=pifpartone(x1,qt,-1,je1,ji1) | |
76 | g1= pifpartone(x1,qt, 0,je1,ji1) | |
77 | uv1= pifpartone(x1,qt, 1,je1,ji1) | |
78 | dv1= pifpartone(x1,qt, 2,je1,ji1) | |
79 | sea2=pifpartone(x2,qt,-1,je2,ji2) | |
80 | g2= pifpartone(x2,qt, 0,je2,ji2) | |
81 | uv2= pifpartone(x2,qt, 1,je2,ji2) | |
82 | dv2= pifpartone(x2,qt, 2,je2,ji2) | |
83 | else | |
84 | sea1=pifpartone(x1,qt,-1,je1,1)+pifpartone(x1,qt,-1,je1,2) | |
85 | g1= pifpartone(x1,qt, 0,je1,1)+pifpartone(x1,qt, 0,je1,2) | |
86 | uv1= pifpartone(x1,qt, 1,je1,1)+pifpartone(x1,qt, 1,je1,2) | |
87 | dv1= pifpartone(x1,qt, 2,je1,1)+pifpartone(x1,qt, 2,je1,2) | |
88 | sea2=pifpartone(x2,qt,-1,je2,1)+pifpartone(x2,qt,-1,je2,2) | |
89 | g2= pifpartone(x2,qt, 0,je2,1)+pifpartone(x2,qt, 0,je2,2) | |
90 | uv2= pifpartone(x2,qt, 1,je2,1)+pifpartone(x2,qt, 1,je2,2) | |
91 | dv2= pifpartone(x2,qt, 2,je2,1)+pifpartone(x2,qt, 2,je2,2) | |
92 | endif | |
93 | ||
94 | ffsigj= ffborn(s,t, g1*g2 !gg | |
95 | ||
96 | * ,(uv1+dv1+2.*naflav*sea1)*g2+g1*(uv2+dv2+2.*naflav*sea2) !gq | |
97 | ||
98 | * ,(uv1+sea1)*(uv2+sea2) !qq | |
99 | * +(dv1+sea1)*(dv2+sea2)+sea1*sea2*(naflav-1)*2. | |
100 | ||
101 | * ,(uv1+sea1)*sea2+(uv2+sea2)*sea1 !qa | |
102 | * +(dv1+sea1)*sea2+(dv2+sea2)*sea1+sea1*sea2*(naflav-2)*2. | |
103 | ||
104 | * ,dv1*uv2+dv2*uv1+(uv2+dv2)*sea1*(naflav-1)*2. !qqp | |
105 | * +(uv1+dv1)*sea2*(naflav-1)*2. | |
106 | * +sea1*sea2*naflav*(naflav-1)*4. | |
107 | ||
108 | *) | |
109 | end | |
110 | ||
111 | c----------------------------------------------------------------------- | |
112 | function ffsig(t,qt,x1,x2) !former psjy | |
113 | c----------------------------------------------------------------------- | |
114 | include 'epos.incsem' | |
115 | include 'epos.inc' | |
116 | ||
117 | s=engy**2*x1*x2 | |
118 | ||
119 | g1= pifpartone(x1,qt, 0,2,1)+pifpartone(x1,qt, 0,2,2) | |
120 | uv1= pifpartone(x1,qt, 1,2,1)+pifpartone(x1,qt, 1,2,2) | |
121 | dv1= pifpartone(x1,qt, 2,2,1)+pifpartone(x1,qt, 2,2,2) | |
122 | sea1=pifpartone(x1,qt,-1,2,1)+pifpartone(x1,qt,-1,2,2) | |
123 | g2= pifpartone(x2,qt, 0,2,1)+pifpartone(x2,qt, 0,2,2) | |
124 | uv2= pifpartone(x2,qt, 1,2,1)+pifpartone(x2,qt, 1,2,2) | |
125 | dv2= pifpartone(x2,qt, 2,2,1)+pifpartone(x2,qt, 2,2,2) | |
126 | sea2=pifpartone(x2,qt,-1,2,1)+pifpartone(x2,qt,-1,2,2) | |
127 | ||
128 | ffsig= ffborn(s,t, g1*g2 !gg | |
129 | ||
130 | * ,(uv1+dv1+2.*naflav*sea1)*g2+g1*(uv2+dv2+2.*naflav*sea2) !gq | |
131 | ||
132 | * ,(uv1+sea1)*(uv2+sea2) !qq | |
133 | * +(dv1+sea1)*(dv2+sea2)+sea1*sea2*(naflav-1)*2. | |
134 | ||
135 | * ,(uv1+sea1)*sea2+(uv2+sea2)*sea1 !qa | |
136 | * +(dv1+sea1)*sea2+(dv2+sea2)*sea1+sea1*sea2*(naflav-2)*2. | |
137 | ||
138 | * ,dv1*uv2+dv2*uv1+(uv2+dv2)*sea1*(naflav-1)*2. !qqp | |
139 | * +(uv1+dv1)*sea2*(naflav-1)*2. | |
140 | * +sea1*sea2*naflav*(naflav-1)*4. | |
141 | ||
142 | *) | |
143 | end | |
144 | ||
145 | c------------------------------------------------------------------------ | |
146 | function ffborn(s,t,gg,gq,qq,qa,qqp) | |
147 | c------------------------------------------------------------------------ | |
148 | ||
149 | ffborn= | |
150 | *( psbori(s,t,0,0,1)+psbori(s,s-t,0,0,1) | |
151 | * +psbori(s,t,0,0,2)+psbori(s,s-t,0,0,2)) /2. *gg !gg | |
152 | ||
153 | *+(psbori(s,t,0,1,1)+psbori(s,s-t,0,1,1)) *gq !gq | |
154 | ||
155 | *+(psbori(s,t,1,1,1)+psbori(s,s-t,1,1,1))/2. *qq !qq | |
156 | ||
157 | *+(psbori(s,t,1,-1,1)+psbori(s,s-t,1,-1,1)+psbori(s,t,1,-1,2)+ | |
158 | * psbori(s,s-t,1,-1,2)+psbori(s,t,1,-1,3)+psbori(s,s-t,1,-1,3)) !qa | |
159 | * *qa | |
160 | ||
161 | *+(psbori(s,t,1,2,1)+psbori(s,s-t,1,2,1)) *qqp !qq' | |
162 | ||
163 | end | |
164 | ||
165 | c----------------------------------------------------------------------- | |
166 | function pifpartone(xx,qq,j,je,ji) ! pol interpolation of partone | |
167 | c----------------------------------------------------------------------- | |
168 | include 'epos.incsem' | |
169 | include 'epos.inc' | |
170 | common/tabfptn/kxxmax,kqqmax,fptn(20,20,-1:2,0:2,2) | |
171 | real wi(3),wj(3) | |
172 | common /cpifpartone/npifpartone | |
173 | data npifpartone /0/ | |
174 | npifpartone=npifpartone+1 | |
175 | if(npifpartone.eq.1)call MakeFpartonTable | |
176 | ||
177 | qqmax=engy**2/4. | |
178 | xxmin=0.01/engy | |
179 | xxmax=1 | |
180 | ||
181 | xxk=1.+log(xx/xxmin)/log(xxmax/xxmin)*(kxxmax-1) | |
182 | qqk=1.+log(qq/q2min)/log(qqmax/q2min)*(kqqmax-1) | |
183 | kxx=int(xxk) | |
184 | kqq=int(qqk) | |
185 | if(kxx.lt.1)kxx=1 | |
186 | if(kqq.lt.1)kqq=1 | |
187 | if(kxx.gt.(kxxmax-2))kxx=kxxmax-2 | |
188 | if(kqq.gt.(kqqmax-2))kqq=kqqmax-2 | |
189 | ||
190 | wi(2)=xxk-kxx | |
191 | wi(3)=wi(2)*(wi(2)-1.)*.5 | |
192 | wi(1)=1.-wi(2)+wi(3) | |
193 | wi(2)=wi(2)-2.*wi(3) | |
194 | ||
195 | wj(2)=qqk-kqq | |
196 | wj(3)=wj(2)*(wj(2)-1.)*.5 | |
197 | wj(1)=1.-wj(2)+wj(3) | |
198 | wj(2)=wj(2)-2.*wj(3) | |
199 | pifpartone=0 | |
200 | do kx=1,3 | |
201 | do kq=1,3 | |
202 | pifpartone=pifpartone+fptn(kxx+kx-1,kqq+kq-1,j,je,ji) | |
203 | * *wi(kx)*wj(kq) | |
204 | enddo | |
205 | enddo | |
206 | end | |
207 | ||
208 | c----------------------------------------------------------------------- | |
209 | subroutine MakeFpartonTable | |
210 | c----------------------------------------------------------------------- | |
211 | include 'epos.incsem' | |
212 | include 'epos.inc' | |
213 | common/tabfptn/kxxmax,kqqmax,fptn(20,20,-1:2,0:2,2) | |
214 | write (*,'(a,$)')'(Fparton table' | |
215 | kxxmax=10 | |
216 | kqqmax=10 | |
217 | qqmax=engy**2/4. | |
218 | xxmin=0.01/engy | |
219 | xxmax=1 | |
220 | do ji=1,2 | |
221 | do je=0,2 | |
222 | write(*,'(a,$)')'.' | |
223 | do j=-1,2 | |
224 | do kxx=1,kxxmax | |
225 | xx=xxmin*(xxmax/xxmin)**((kxx-1.)/(kxxmax-1.)) | |
226 | do kqq=1,kqqmax | |
227 | qq=q2min*(qqmax/q2min)**((kqq-1.)/(kqqmax-1.)) | |
228 | fptn(kxx,kqq,j,je,ji)= fpartone(xx,qq,j,je,ji) | |
229 | enddo | |
230 | enddo | |
231 | enddo | |
232 | enddo | |
233 | enddo | |
234 | write (*,'(a,$)')'done)' | |
235 | end | |
236 | ||
237 | c------------------------------------------------------------------------ | |
238 | function fpartone(xx,qq,j,je,ji) !former pspdf0 (sha) | |
239 | c----------------------------------------------------------------------- | |
240 | c | |
241 | c parton distribution function for proton ( actually x*f(x) !!!!!!! ) | |
242 | c | |
243 | c xx = light cone momentum fraction | |
244 | c qq = virtuality scale | |
245 | c j = parton type | |
246 | c -1 ... sea (distribution function per flavor) | |
247 | c 0 ... g | |
248 | c 1 ... u | |
249 | c 2 ... d | |
250 | c je = emission type | |
251 | c 0 ... no emissions | |
252 | c 1 ... emissions | |
253 | c 2 ... all | |
254 | c ji = initial parton type | |
255 | c 1 ... sea (q et g) | |
256 | c 2 ... val | |
257 | c----------------------------------------------------------------------- | |
258 | double precision z,xmin,xm,zx,psuds | |
259 | common/ar3/ x1(7),a1(7) | |
260 | include 'epos.inc' | |
261 | include 'epos.incsem' | |
262 | ||
263 | fpartone=0 | |
264 | if(je.eq.1)goto888 | |
265 | ||
266 | c ...... f_0 * sudakov......... | |
267 | ||
268 | if(j.eq.0.and.ji.eq.1)then | |
269 | fpartone=fzeroGlu(xx,2,1) !hadron class 2, projectile side | |
270 | elseif((j.eq.1.or.j.eq.2).and.ji.eq.2)then | |
271 | fpartone=psdfh4(xx,q2min,0.,2,j) | |
272 | elseif(j.eq.-1.and.ji.eq.1)then | |
273 | fpartone=fzeroSea(xx,2,1) | |
274 | endif | |
275 | fpartone=fpartone*sngl(psuds(qq,j)/psuds(q2min,j)) | |
276 | if(je.eq.0)goto999 | |
277 | ||
278 | c......... integral f_0 E_qcd............ | |
279 | ||
280 | 888 continue | |
281 | xmin=dble(xx)/(1.d0-dble(q2ini/qq)) | |
282 | if(xmin.lt.1.d0)then | |
283 | dpd1=0. | |
284 | dpd2=0. | |
285 | xm=max(xmin,0.3d0) | |
286 | ||
287 | !numerical integration xm -> 1 | |
288 | ||
289 | do i=1,7 | |
290 | do m=1,2 | |
291 | zx=1.d0-(1.d0-xm)*(.5d0+(dble(m)-1.5d0)*dble(x1(i)))**.25d0 | |
292 | z=xx/zx | |
293 | ||
294 | gl=fzeroGlu(sngl(zx),2,1) | |
295 | uv=psdfh4(sngl(zx),q2min,0.,2,1) | |
296 | dv=psdfh4(sngl(zx),q2min,0.,2,2) | |
297 | sea=fzeroSea(sngl(zx),2,1) | |
298 | ||
299 | fz=0 | |
300 | if(j.eq.0)then | |
301 | if(ji.eq.1) | |
302 | * fz=gl *psevi(q2min,qq,z,1,1) | |
303 | * +sea*psevi(q2min,qq,z,2,1) !ccccc | |
304 | if(ji.eq.2) | |
305 | * fz=(uv+dv)*psevi(q2min,qq,z,2,1) | |
306 | elseif(j.eq.1.and.ji.eq.2)then | |
307 | fz=psevi(q2min,qq,z,3,2)*uv | |
308 | elseif(j.eq.2.and.ji.eq.2)then | |
309 | fz=psevi(q2min,qq,z,3,2)*dv | |
310 | elseif(j.eq.-1)then | |
311 | akns=psevi(q2min,qq,z,3,2) !nonsinglet contribution | |
312 | aks=(psevi(q2min,qq,z,2,2)-akns) !singlet contribution | |
313 | if(ji.eq.1) | |
314 | * fz=psevi(q2min,qq,z,1,2)*gl | |
315 | * +sea*aks+sea*akns !ccccc | |
316 | if(ji.eq.2) | |
317 | * fz=(uv+dv)*aks | |
318 | endif | |
319 | dpd1=dpd1+a1(i)*fz/sngl(zx)**2/sngl(1.d0-zx)**3 | |
320 | enddo | |
321 | enddo | |
322 | dpd1=dpd1*sngl(1.d0-xm)**4/8.*xx | |
323 | ||
324 | !numerical integration xmin -> xm | |
325 | ||
326 | if(xm.gt.xmin)then | |
327 | do i=1,7 | |
328 | do m=1,2 | |
329 | zx=xx+(xm-xx) | |
330 | & *((xmin-xx)/(xm-xx))**(.5d0-(dble(m)-1.5d0)*dble(x1(i))) | |
331 | z=xx/zx | |
332 | ||
333 | gl=fzeroGlu(sngl(zx),2,1) | |
334 | uv=psdfh4(sngl(zx),q2min,0.,2,1) | |
335 | dv=psdfh4(sngl(zx),q2min,0.,2,2) | |
336 | sea=fzeroSea(sngl(zx),2,1) | |
337 | ||
338 | fz=0 | |
339 | if(j.eq.0)then | |
340 | if(ji.eq.1) | |
341 | * fz=gl *psevi(q2min,qq,z,1,1) | |
342 | * +sea*psevi(q2min,qq,z,2,1) !ccccc | |
343 | if(ji.eq.2) | |
344 | * fz=(uv+dv)*psevi(q2min,qq,z,2,1) | |
345 | elseif(j.eq.1.and.ji.eq.2)then | |
346 | fz=psevi(q2min,qq,z,3,2)*uv | |
347 | elseif(j.eq.2.and.ji.eq.2)then | |
348 | fz=psevi(q2min,qq,z,3,2)*dv | |
349 | elseif(j.eq.-1)then | |
350 | akns=psevi(q2min,qq,z,3,2) !nonsinglet contribution | |
351 | aks=(psevi(q2min,qq,z,2,2)-akns) !singlet contribution | |
352 | if(ji.eq.1) | |
353 | * fz=psevi(q2min,qq,z,1,2)*gl | |
354 | * +sea*aks+sea*akns !ccccc | |
355 | if(ji.eq.2) | |
356 | * fz=(uv+dv)*aks | |
357 | endif | |
358 | dpd2=dpd2+a1(i)*fz*sngl((1.d0-xx/zx)/zx) | |
359 | enddo | |
360 | enddo | |
361 | dpd2=dpd2*sngl(log((xm-xx)/(xmin-xx))*.5d0*xx) | |
362 | endif | |
363 | fpartone=fpartone+dpd2+dpd1 | |
364 | endif | |
365 | ||
366 | 999 continue | |
367 | if(j.lt.0)fpartone=fpartone/naflav/2. | |
368 | return | |
369 | end | |
370 | ||
371 | c------------------------------------------------------------------------ | |
372 | function fparton(xx,qq,j) !former pspdf0 (sha) | |
373 | c----------------------------------------------------------------------- | |
374 | c | |
375 | c parton distribution function for proton ( actually x*f(x) !!!!!!! ) | |
376 | c | |
377 | c xx = light cone momentum fraction | |
378 | c qq = virtuality scale | |
379 | c j = parton type | |
380 | c -1 ... sea (dsistribution fuction per flavor) | |
381 | c 0 ... g | |
382 | c 1 ... u | |
383 | c 2 ... d | |
384 | c | |
385 | c----------------------------------------------------------------------- | |
386 | c (see pages 105 - 107 of our report) | |
387 | c | |
388 | c fparton(xx) = xx * f(xx) !!!!! | |
389 | c | |
390 | c f_j(xx,qq) = \sum_k \int(xx<x<1) dx/x f0_k(x) Eqcd_k_j(xx/x,qq) | |
391 | c | |
392 | c f0_k = fzeroGlu or fzeroSea | |
393 | c | |
394 | c Eqcd=E~qcd+delta*sudakov, E~qcd: at least one emission | |
395 | c | |
396 | c----------------------------------------------------------------------- | |
397 | double precision z,xmin,xm,zx,psuds | |
398 | common/ar3/ x1(7),a1(7) | |
399 | include 'epos.inc' | |
400 | include 'epos.incsem' | |
401 | ||
402 | c ...... f_0 * sudakov......... | |
403 | ||
404 | if(j.eq.0)then | |
405 | fparton=fzeroGlu(xx,2,1) | |
406 | elseif(j.eq.1.or.j.eq.2)then | |
407 | fparton=psdfh4(xx,q2min,0.,2,j) | |
408 | else | |
409 | fparton=fzeroSea(xx,2,1) | |
410 | endif | |
411 | fparton=fparton*sngl(psuds(qq,j)/psuds(q2min,j)) | |
412 | ||
413 | c......... integral f_0 E_qcd............ | |
414 | ||
415 | xmin=xx/(1.d0-dble(q2ini/qq)) | |
416 | if(xmin.lt.1.d0)then | |
417 | dpd1=0. | |
418 | dpd2=0. | |
419 | xm=max(xmin,.3d0) | |
420 | ||
421 | !numerical integration xm -> 1 | |
422 | ||
423 | do i=1,7 | |
424 | do m=1,2 | |
425 | zx=1.d0-(1.d0-xm)*(.5d0+(dble(m)-1.5d0)*dble(x1(i)))**.25d0 | |
426 | z=xx/zx | |
427 | ||
428 | gl=fzeroGlu(sngl(zx),2,1) | |
429 | uv=psdfh4(sngl(zx),q2min,0.,2,1) | |
430 | dv=psdfh4(sngl(zx),q2min,0.,2,2) | |
431 | sea=fzeroSea(sngl(zx),2,1) | |
432 | ||
433 | if(j.eq.0)then | |
434 | fz=psevi(q2min,qq,z,1,1)*gl | |
435 | * +(uv+dv+sea)*psevi(q2min,qq,z,2,1) | |
436 | elseif(j.eq.1)then | |
437 | fz=psevi(q2min,qq,z,3,2)*uv | |
438 | elseif(j.eq.2)then | |
439 | fz=psevi(q2min,qq,z,3,2)*dv | |
440 | else | |
441 | akns=psevi(q2min,qq,z,3,2) !nonsinglet contribution | |
442 | aks=(psevi(q2min,qq,z,2,2)-akns) !singlet contribution | |
443 | fz=(psevi(q2min,qq,z,1,2)*gl+(uv+dv+sea)*aks+sea*akns) | |
444 | endif | |
445 | dpd1=dpd1+a1(i)*fz/sngl(zx)**2/sngl(1.d0-zx)**3 | |
446 | enddo | |
447 | enddo | |
448 | dpd1=dpd1*sngl((1.d0-xm)**4/8.*xx) | |
449 | ||
450 | !numerical integration xmin -> xm | |
451 | ||
452 | if(xm.gt.xmin)then | |
453 | do i=1,7 | |
454 | do m=1,2 | |
455 | zx=xx+(xm-xx)*((xmin-xx)/(xm-xx)) | |
456 | * **(.5d0-(dble(m)-1.5)*dble(x1(i))) | |
457 | z=xx/zx | |
458 | ||
459 | gl=fzeroGlu(sngl(zx),2,1) | |
460 | uv=psdfh4(sngl(zx),q2min,0.,2,1) | |
461 | dv=psdfh4(sngl(zx),q2min,0.,2,2) | |
462 | sea=fzeroSea(sngl(zx),2,1) | |
463 | ||
464 | if(j.eq.0)then | |
465 | fz=psevi(q2min,qq,z,1,1)*gl+(uv+dv+sea)* | |
466 | * psevi(q2min,qq,z,2,1) | |
467 | elseif(j.eq.1)then | |
468 | fz=psevi(q2min,qq,z,3,2)*uv | |
469 | elseif(j.eq.2)then | |
470 | fz=psevi(q2min,qq,z,3,2)*dv | |
471 | else | |
472 | akns=psevi(q2min,qq,z,3,2) !nonsinglet contribution | |
473 | aks=(psevi(q2min,qq,z,2,2)-akns) !singlet contribution | |
474 | fz=(psevi(q2min,qq,z,1,2)*gl+(uv+dv+sea)*aks+sea*akns) | |
475 | endif | |
476 | dpd2=dpd2+a1(i)*fz*sngl((1.d0-xx/zx)/zx) | |
477 | enddo | |
478 | enddo | |
479 | dpd2=dpd2*sngl(log((xm-xx)/(xmin-xx))*.5d0*xx) | |
480 | endif | |
481 | fparton=fparton+dpd2+dpd1 | |
482 | endif | |
483 | if(j.lt.0)fparton=fparton/naflav/2. | |
484 | return | |
485 | end | |
486 | ||
487 | c------------------------------------------------------------------------ | |
488 | function fzeroGlu(z,k,ipt) | |
489 | c----------------------------------------------------------------------- | |
490 | c | |
491 | c x*f(x) | |
492 | c | |
493 | c f = F & EsoftGluon &=convolution | |
494 | c | |
495 | c F(x) = alpff(k)*x**betff(ipt)*(1-x)**alplea(k) | |
496 | c | |
497 | c EsoftGluon(x) = x**(-1-dels) * EsoftGluonTil(x) | |
498 | c | |
499 | c z - light cone x | |
500 | c k - hadron class | |
501 | c ipt - 1=proj 2=targ | |
502 | c----------------------------------------------------------------------- | |
503 | double precision xpmin,xp | |
504 | include 'epos.inc' | |
505 | common /ar3/ x1(7),a1(7) | |
506 | include 'epos.incsem' | |
507 | ||
508 | fzeroGlu=0. | |
509 | xpmin=z | |
510 | xpmin=xpmin**(1+betff(ipt)+dels) | |
511 | do i=1,7 | |
512 | do m=1,2 | |
513 | xp=(.5*(1.+xpmin+(2*m-3)*x1(i)*(1.-xpmin)))**(1./ | |
514 | * (1+betff(ipt)+dels)) | |
515 | zz=z/xp | |
516 | fzeroGlu=fzeroGlu+a1(i)*(1.-xp)**alplea(k)*EsoftGluonTil(zz) | |
517 | enddo | |
518 | enddo | |
519 | fzeroGlu=fzeroGlu*.5*(1.-xpmin)/(1+betff(ipt)+dels) | |
520 | ||
521 | fzeroGlu=fzeroGlu *alpff(k) *z**(-dels) | |
522 | ||
523 | end | |
524 | ||
525 | c------------------------------------------------------------------------ | |
526 | function fzeroSea(z,k,ipt) | |
527 | c----------------------------------------------------------------------- | |
528 | c | |
529 | c x*f(x) | |
530 | c | |
531 | c f = F & EsoftQuark &=convolution | |
532 | c | |
533 | c F(x) = alpff(k)*x**betff(ipt)*(1-x)**alplea(k) | |
534 | c | |
535 | c EsoftQuark(x) = x**(-1-dels) * EsoftQuarkTil(x) | |
536 | c | |
537 | c z - light cone x of the quark, | |
538 | c k - hadron class | |
539 | c----------------------------------------------------------------------- | |
540 | double precision xpmin,xp | |
541 | common /ar3/ x1(7),a1(7) | |
542 | include 'epos.inc' | |
543 | include 'epos.incsem' | |
544 | ||
545 | fzeroSea=0. | |
546 | xpmin=z | |
547 | xpmin=xpmin**(1+betff(ipt)+dels) | |
548 | do i=1,7 | |
549 | do m=1,2 | |
550 | xp=(.5*(1.+xpmin+(2*m-3)*x1(i)*(1.-xpmin)))**(1./ | |
551 | * (1+betff(ipt)+dels)) | |
552 | zz=z/xp | |
553 | fzeroSea=fzeroSea+a1(i)*(1.-xp)**alplea(k)*EsoftQuarkTil(zz) | |
554 | enddo | |
555 | enddo | |
556 | fzeroSea=fzeroSea*.5*(1.-xpmin)/(1+betff(ipt)+dels) | |
557 | ||
558 | fzeroSea=fzeroSea *alpff(k) *z**(-dels) | |
559 | ||
560 | end | |
561 | ||
562 | c------------------------------------------------------------------------ | |
563 | function EsoftGluonTil(zz) | |
564 | c----------------------------------------------------------------------- | |
565 | c EsoftGluon = zz^(-1-dels) * EsoftGluonTil | |
566 | c----------------------------------------------------------------------- | |
567 | include 'epos.inc' | |
568 | include 'epos.incsem' | |
569 | EsoftGluonTil=gamsoft*(1-glusea)*(1.-zz)**betpom | |
570 | end | |
571 | ||
572 | c------------------------------------------------------------------------ | |
573 | function EsoftQuarkTil(zz) | |
574 | c----------------------------------------------------------------------- | |
575 | c EsoftQuark = zz^(-1-dels) * EsoftQuarkTil | |
576 | c----------------------------------------------------------------------- | |
577 | double precision zmin,z | |
578 | common /ar3/ x1(7),a1(7) | |
579 | include 'epos.inc' | |
580 | include 'epos.incsem' | |
581 | ||
582 | EsoftQuarkTil=0. | |
583 | zmin=zz | |
584 | zmin=zmin**(1.+dels) | |
585 | do i=1,7 | |
586 | do m=1,2 | |
587 | z=(.5d0*(1.+zmin+(2*m-3)*x1(i)*(1.d0-zmin))) | |
588 | * **(1.d0/(1.d0+dels)) | |
589 | EsoftQuarkTil=EsoftQuarkTil+a1(i)*max(1.d-5,(1.d0-zz/z))**betpom | |
590 | * *(z**2+(1.-z)**2) | |
591 | enddo | |
592 | enddo | |
593 | EsoftQuarkTil=EsoftQuarkTil*1.5*(1.d0-zmin)/(1.+dels) | |
594 | !1.5=naflav/2 at Q0 | |
595 | EsoftQuarkTil=gamsoft*glusea*EsoftQuarkTil | |
596 | ||
597 | end | |
598 | ||
599 | c------------------------------------------------------------------------ | |
600 | function EsoftQZero(zz) ! former psftilf | |
601 | c----------------------------------------------------------------------- | |
602 | c | |
603 | c EsoftQuark = EsoftQZero * wsplit * z^(-1-dels) * gamsoft | |
604 | c | |
605 | c zz - ratio of the quark and pomeron light cone x (zz=x_G/x_P) | |
606 | c integration over quark to gluon light cone momentum ratio (z=x/x_G): | |
607 | c | |
608 | c EsoftQZero = int(dz) z^dels * (1-zz/z)^betpom * P_qG(z) | |
609 | c | |
610 | c----------------------------------------------------------------------- | |
611 | double precision zmin,z | |
612 | common /ar3/ x1(7),a1(7) | |
613 | include 'epos.incsem' | |
614 | ||
615 | EsoftQZero=0. | |
616 | zmin=zz | |
617 | zmin=zmin**(1.+dels) | |
618 | do i=1,7 | |
619 | do m=1,2 | |
620 | z=(.5d0*(1.+zmin+(2*m-3)*x1(i)*(1.d0-zmin))) | |
621 | * **(1.d0/(1.d0+dels)) | |
622 | EsoftQZero=EsoftQZero+a1(i)*max(1.d-5,(1.d0-zz/z))**betpom | |
623 | * *(z**2+(1.-z)**2) | |
624 | enddo | |
625 | enddo | |
626 | EsoftQZero=EsoftQZero*1.5*(1.d0-zmin)/(1.+dels) !1.5=naflav/2 at Q0 | |
627 | return | |
628 | end | |
629 | ||
630 | c------------------------------------------------------------------------ | |
631 | function ffsigi(qq,y0) !former psjx1 (sto) | |
632 | c------------------------------------------------------------------------ | |
633 | c | |
634 | c dsigma/dpt_jet = \int dy \int dx1 ffsig(x1,x2(x1)) | |
635 | c | |
636 | c x1=xplus, x2=xminus | |
637 | c x2=x2(x1) due to u+t+s=0 | |
638 | c ( s=x1*x2*spp, t/spp=-x1*xt*exp(-y)/2, u/spp=-x2*xt*exp(y)/2 ) | |
639 | c | |
640 | c qq = pt**2, xt=2.*sqrt(qq/s) | |
641 | c rapidity range: 0 to y0 | |
642 | c | |
643 | c ffsig = function ffsig(t,qq,x1,x2) | |
644 | c | |
645 | c----------------------------------------------------------------------- | |
646 | include 'epos.incsem' | |
647 | include 'epos.inc' | |
648 | double precision xx1,xx2,xt,ymax,ymin,y,xmin,xmax | |
649 | ig=3 | |
650 | ig1=3 | |
651 | s=engy**2 | |
652 | ffsigi=0. | |
653 | if(s.le.4.*qq)return | |
654 | if(qq.lt.q2min)return | |
655 | xt=2d0*sqrt(dble(qq)/dble(s)) | |
656 | ymax=min(dble(y0),log(1d0/xt+sqrt((1d0/xt-1d0)*(1d0/xt+1d0)))) | |
657 | ymin=-ymax !final result must be divided by 2 | |
658 | do i=1,ig | |
659 | do m=1,2 | |
660 | y=.5d0*(ymax+ymin+(ymin-ymax)*dble((2*m-3)*tgss(ig,i))) | |
661 | !for xx1-integration, use variable x=xx1-xt*exp(y)/2.,with xmin<x<xmax | |
662 | xmin=xt**2/2.d0/(2.d0-xt*exp(-y)) !condition x2<1 | |
663 | xmax=1.d0-xt*exp(y)/2.d0 !condition x1<1 | |
664 | fx=0. | |
665 | do i1=1,ig1 | |
666 | do m1=1,2 | |
667 | xx1=xt*exp(y)/2.d0+xmin*(xmax/xmin)**dble(.5 | |
668 | & +tgss(ig1,i1)*(m1-1.5)) | |
669 | xx2=xt*exp(-y)*xx1/(2.d0*xx1-xt*exp(y)) | |
670 | z=sngl(xx1*xx2) | |
671 | sh=z*s | |
672 | aa=1.-4.*qq/sh | |
673 | aa=max(1e-10,aa) | |
674 | t=sh/2.*(1.-sqrt(aa)) !formula in parton-parton cms | |
675 | ft=ffsig(t,qq,sngl(xx1),sngl(xx2)) | |
676 | fx=fx+wgss(ig1,i1)*ft/sh**2 | |
677 | enddo | |
678 | enddo | |
679 | fx=fx*0.5*sngl(log(xmax/xmin)) !dx/x=0.5*log(xmax/xmin)dt (gauss) | |
680 | ffsigi=ffsigi+wgss(ig,i)*fx | |
681 | enddo | |
682 | enddo | |
683 | ffsigi=ffsigi*0.5*sngl(ymax-ymin) !dy=0.5*(ymax-ymin)dt (gauss) | |
684 | * *2*pi*(2*pi*pssalf(qq/qcdlam))**2 !alpha = 2*pi*pssalf | |
685 | * *2*sqrt(qq) !d2pt=2*pi*pt*dpt | |
686 | * /2 ! y interval 2 * Delta_y | |
687 | * /2 ! condition t < sqrt(s)/2, | |
688 | ! since t > sqrt(s)/2 is automatically included, | |
689 | ! see psbori | |
690 | return | |
691 | end | |
692 | ||
693 | c------------------------------------------------------------------------ | |
694 | function psbori(s,t,j,l,n) | |
695 | c----------------------------------------------------------------------- | |
696 | c contribution to the born cross-section: | |
697 | c | |
698 | c dsigmaBorn/d2pt/dy = s/pi * delta(s+t+u) * 2*pi*alpha**2 /s**2 *psbori | |
699 | c | |
700 | c s - c.m. energy squared for the born scattering, | |
701 | c t - invariant variable for the born scattering |(p1-p3)**2|, | |
702 | c j - parton type at current end of the ladder (0 - g, 1,-1,2,... - q) | |
703 | c l - parton type at opposite end of the ladder (0 - g, 1,-1,2,... - q) | |
704 | c n - subprocess number | |
705 | c----------------------------------------------------------------------- | |
706 | include 'epos.incsem' | |
707 | ||
708 | psbori=0. | |
709 | u=s-t | |
710 | if(u.le.0.d0)return | |
711 | ||
712 | if(iabs(j).ne.4)then !light quarks and gluons | |
713 | if(n.eq.1)then | |
714 | if(j.eq.0.and.l.eq.0)then !gg->gg | |
715 | psbori=(3.-t*u/s**2+s*u/t**2+s*t/u**2)*4.5 | |
716 | elseif(j*l.eq.0)then !gq->gq | |
717 | psbori=(s**2+u**2)/t**2+(s/u+u/s)/2.25 | |
718 | elseif(j.eq.l)then !qq->qq | |
719 | psbori=((s**2+u**2)/t**2+(s**2+t**2)/u**2)/2.25 | |
720 | * -s**2/t/u/3.375 | |
721 | elseif(j.eq.-l)then !qq~->qq~ | |
722 | psbori=((s**2+u**2)/t**2+(u**2+t**2)/s**2)/2.25 | |
723 | * +u**2/t/s/3.375 | |
724 | else !qq'->qq' | |
725 | psbori=(s**2+u**2)/t**2/2.25 | |
726 | endif | |
727 | elseif(n.eq.2)then | |
728 | if(j.eq.0.and.l.eq.0)then !gg->qq~ | |
729 | psbori=.5*(t/u+u/t)-1.125*(t*t+u*u)/s**2 | |
730 | elseif(j.eq.-l)then !qq~->q'q'~ | |
731 | psbori=(t*t+u*u)/s**2/1.125 | |
732 | else | |
733 | psbori=0. | |
734 | endif | |
735 | elseif(n.eq.3)then | |
736 | if(j.ne.0.and.j.eq.-l)then !qq~->gg | |
737 | psbori=32./27.*(t/u+u/t)-(t*t+u*u)/s**2/.375 | |
738 | else | |
739 | psbori=0. | |
740 | endif | |
741 | ||
742 | c............ n=4 for photon product processes, make e_q**2 =2/9., | |
743 | c the average value of charge squared for all types of quarks. | |
744 | elseif(n.eq.4) then | |
745 | if(j.ne.0.and.j.eq.-l)then !qq~->g+gamma | |
746 | psbori=16*factgam*(u/t+t/u)/81. | |
747 | elseif (j*l.eq.0.and.j+l.ne.0) then !q(q~)g->q(q~)+gamma | |
748 | psbori=2*factgam*(u/s+s/u)/27. | |
749 | else | |
750 | psbori=0. | |
751 | endif | |
752 | elseif(n.eq.5) then | |
753 | if(j.ne.0.and.j.eq.-l)then !qq~->gamma+gamma | |
754 | psbori=4*factgam*(t/u+u/t)/81. | |
755 | else | |
756 | psbori=0. | |
757 | endif | |
758 | endif | |
759 | ||
760 | elseif(n.eq.1)then !c-quark | |
761 | ||
762 | if(l.eq.0)then !cg->cg | |
763 | xm=qcmass**2/s/u | |
764 | psbori=(s**2+u**2)/t**2+(s/u+u/s)/2.25 | |
765 | * -4.*qcmass**2/t+xm*(xm*t**2-t)/.5625+4.*qcmass**2*xm | |
766 | else !cq->cq | |
767 | psbori=(s**2+u**2)/t**2/2.25-qcmass**2/t/1.125 | |
768 | endif | |
769 | ||
770 | else | |
771 | ||
772 | psbori=0. | |
773 | ||
774 | endif | |
775 | return | |
776 | end | |
777 | ||
778 | c----------------------------------------------------------------------- | |
779 | double precision function om51p(sy,xh,yp,b,iqq) | |
780 | c----------------------------------------------------------------------- | |
781 | c om5p - chi~(x,y) | |
782 | c xh - fraction of the energy squared s for the pomeron; | |
783 | c yp - rapidity for the pomeron; | |
784 | c b - impact parameter between the pomeron ends; | |
785 | c iqq =-1 - 0+1+2+3+4, | |
786 | c iqq = 0 - soft pomeron, | |
787 | c iqq = 1 - gg, | |
788 | c iqq = 2 - qg, | |
789 | c iqq = 3 - gq, | |
790 | c iqq = 4 - qq, | |
791 | c iqq = 5 - soft(int)|b, | |
792 | c iqq = 6 - gg(int)|b, | |
793 | c iqq = 7 - soft(proj)|b, | |
794 | c iqq = 8 - gg(proj)|b, | |
795 | c iqq = 9 - qg(proj)|b, | |
796 | c iqq = 10 - total fro-uncut integrated, | |
797 | c iqq = 11 - total uncut integrated, | |
798 | c iqq = 12 - soft(int), | |
799 | c iqq = 13 - gg(int), | |
800 | c iqq = 14 - <b^2*soft(int)>, | |
801 | c iqq = 15 - <b^2*gg(int)>, | |
802 | c iqq = 16 - soft(proj-int), | |
803 | c iqq = 17 - gg(proj-int), | |
804 | c iqq = 18 - qg(proj-int), | |
805 | c iqq = 19 - <b^2*soft(proj)>, | |
806 | c iqq = 20 - <b^2*gg(proj)>, | |
807 | c iqq = 21 - <b^2*qg(proj)> | |
808 | c----------------------------------------------------------------------- | |
809 | double precision xh,yp!,coefom1,coefom2 | |
810 | common /psar7/ delx,alam3p,gam3p | |
811 | common /psar37/ coefom1,coefom2 | |
812 | include 'epos.inc' | |
813 | include 'epos.incsem' | |
814 | ||
815 | xp=dsqrt(xh)*exp(yp) | |
816 | if(xh.ne.0.d0)then | |
817 | xm=xh/xp | |
818 | else | |
819 | xm=0. | |
820 | endif | |
821 | rp=r2had(iclpro)+r2had(icltar)+slopom*log(max(1.,sy)) | |
822 | zb=exp(-b**2/(4.*.0389*rp)) | |
823 | rh=r2had(iclpro)+r2had(icltar) | |
824 | ||
825 | if(iqq.eq.0)then !soft | |
826 | c rp=r2hads(iclpro)+r2hads(icltar)+slopoms*log(max(1.,sy)) | |
827 | zb=exp(-b**2/(4.*.0389*rp)) | |
828 | om51p=chad(iclpro)*chad(icltar)*gamhads(iclpro) | |
829 | * *gamhads(icltar)*sy**dels*(xp*xm)**(-alppar)*zb/rp | |
830 | elseif(iqq.le.4)then !gg,qg,gq,qq | |
831 | om51p=psvin(sy,xp,xm,zb,iqq) | |
832 | elseif(iqq.eq.5)then !soft(int)|b | |
833 | c rh=alam3p+slopoms*log(max(1.,sy)) | |
834 | om51p=sy**dels*zb**(rp/rh)/rh | |
835 | elseif(iqq.eq.6)then !gg(int)|b | |
836 | om51p=psvin(sy,xp,xm,zb,14) | |
837 | elseif(iqq.eq.7)then !soft(proj)b | |
838 | c rh=r2hads(iclpro)+.5*alam3p+slopoms*log(max(1.,sy)) | |
839 | om51p=chad(iclpro)*gamhads(iclpro)*sy**dels | |
840 | * *xp**(-alppar)*zb**(rp/rh)/rh | |
841 | elseif(iqq.eq.8)then !gg(proj)b | |
842 | om51p=psvin(sy,xp,xm,zb,16) | |
843 | elseif(iqq.eq.9)then !qg(proj)b | |
844 | om51p=psvin(sy,xp,xm,zb,18) | |
845 | elseif(iqq.eq.10)then !total fro-uncut integrated | |
846 | om51p=0.d0 | |
847 | return | |
848 | elseif(iqq.eq.11)then !total uncut integrated | |
849 | om51p=psvin(sy,xp,xm,zb,9) | |
850 | c om51p=om51p+dble(coefom1)/2.d0*om51p**2+dble(coefom2)/6.d0*om51p**3 !!!!!!!!!! | |
851 | c if(om51p.gt.100.d0)om51p=100.d0 | |
852 | elseif(iqq.eq.12)then !soft(int) | |
853 | om51p=sy**dels*4.*.0389 | |
854 | elseif(iqq.eq.13)then !gg(int) | |
855 | om51p=psvin(sy,xp,xm,zb,5) | |
856 | elseif(iqq.eq.14)then !<b^2*soft(int)> | |
857 | c rh=alam3p+slopoms*log(max(1.,sy)) | |
858 | om51p=sy**dels*rh*(4.*.0389)**2 | |
859 | elseif(iqq.eq.15)then !<b^2*gg(int)> | |
860 | om51p=psvin(sy,xp,xm,zb,15) | |
861 | elseif(iqq.eq.16)then !soft(proj-int) | |
862 | om51p=chad(iclpro)*gamhads(iclpro)*sy**dels | |
863 | * *xp**(-alppar)*4.*.0389 | |
864 | elseif(iqq.eq.17)then !gg(proj-int) | |
865 | om51p=psvin(sy,xp,xm,zb,6) | |
866 | elseif(iqq.eq.18)then !qg(proj-int) | |
867 | om51p=psvin(sy,xp,xm,zb,7) | |
868 | elseif(iqq.eq.19)then !<b^2*soft(proj)> | |
869 | c rh=r2hads(iclpro)+.5*alam3p+slopoms*log(max(1.,sy)) | |
870 | om51p=chad(iclpro)*gamhads(iclpro)*sy**dels | |
871 | * *xp**(-alppar)*rh*(4.*.0389)**2 | |
872 | elseif(iqq.eq.20)then !<b^2*gg(proj)> | |
873 | om51p=psvin(sy,xp,xm,zb,17) | |
874 | elseif(iqq.eq.21)then !<b^2*qg(proj)> | |
875 | om51p=psvin(sy,xp,xm,zb,19) | |
876 | endif | |
877 | ||
878 | return | |
879 | end | |
880 | ||
881 | cc----------------------------------------------------------------------- | |
882 | c double precision function om2p(xh,yp,xprem0,xmrem0,b,iqq) | |
883 | cc----------------------------------------------------------------------- | |
884 | cc om2p - chi~(x,y) for cut pomeron | |
885 | cc xh - fraction of the energy squared s for the pomeron; | |
886 | cc yp - rapidity for the pomeron; | |
887 | cc xprem - x+ for the projectile remnant; | |
888 | cc xmrem - x- for the target remnant; | |
889 | cc b - impact parameter between the pomeron ends; | |
890 | cc iqq = 0 - total, | |
891 | cc iqq = 1 - 1-cut, | |
892 | cc iqq = 2 - Y+, | |
893 | cc iqq = -2 - Y-, | |
894 | cc iqq = 3 - 1-cut(soft), | |
895 | cc iqq = 4 - 1+(gg), | |
896 | cc iqq = 5 - 1+(qg), | |
897 | cc iqq = 6 - 1+(gq), | |
898 | cc iqq = 7 - 1+(difr) | |
899 | cc iqq = -7 - 1-(difr) | |
900 | cc----------------------------------------------------------------------- | |
901 | c double precision xh,yp,xprem0,xmrem0 | |
902 | c include 'epos.inc' | |
903 | c include 'epos.incsem' | |
904 | c | |
905 | c om2p=0.d0 | |
906 | c sy=xh*engy**2 | |
907 | c xprem=sngl(xprem0) | |
908 | c xmrem=sngl(xmrem0) | |
909 | c xp=dsqrt(xh)*dexp(yp) | |
910 | c if(xh.ne.0.d0)then | |
911 | c xm=xh/xp | |
912 | c else | |
913 | c xm=0. | |
914 | c endif | |
915 | c rp=r2had(iclpro)+r2had(icltar)+slopom*log(max(1.,sy)) | |
916 | c zb=exp(-b**2/(4.*.0389*rp)) | |
917 | c | |
918 | c if(iqq.eq.0)then | |
919 | c om2p=psvy(xp,xprem,xm,xmrem,b,2) | |
920 | c * +psvy(xp,xprem,xm,xmrem,b,-2) | |
921 | c * +psvy(xp,xprem,xm,xmrem,b,3) | |
922 | c * +psvy(xp,xprem,xm,xmrem,b,-3) | |
923 | c * +psvy(xp,xprem,xm,xmrem,b,9) | |
924 | c * +psvy(xp,xprem,xm,xmrem,b,-9) | |
925 | c * +psvx(xp,xprem,xm,xmrem,b,1) | |
926 | c * +psvx(xp,xprem,xm,xmrem,b,2) | |
927 | c * +psvx(xp,xprem,xm,xmrem,b,-2) | |
928 | c * +psvx(xp,xprem,xm,xmrem,b,6) | |
929 | c * +psvx(xp,xprem,xm,xmrem,b,-6) | |
930 | c om2p=om2p+(chad(iclpro)*chad(icltar)*gamhad(iclpro) | |
931 | c * *gamhad(icltar)*sy**dels*(xp*xm)**(-alppar)*zb/rp | |
932 | c * +psvin(sy,xp,xm,zb,1)+psvin(sy,xp,xm,zb,2) | |
933 | c * +psvin(sy,xp,xm,zb,3)+psvin(sy,xp,xm,zb,4)) | |
934 | c elseif(iqq.eq.1)then | |
935 | c om2p=psvy(xp,xprem,xm,xmrem,b,2)+psvy(xp,xprem,xm,xmrem,b,-2) | |
936 | c * +psvx(xp,xprem,xm,xmrem,b,1) | |
937 | c elseif(iqq.eq.2)then | |
938 | c om2p=psvy(xp,xprem,xm,xmrem,b,3) | |
939 | c * +psvx(xp,xprem,xm,xmrem,b,2) | |
940 | c elseif(iqq.eq.-2)then | |
941 | c om2p=psvy(xp,xprem,xm,xmrem,b,-3) | |
942 | c * +psvx(xp,xprem,xm,xmrem,b,-2) | |
943 | c elseif(iqq.eq.3)then | |
944 | c om2p=psvy(xp,xprem,xm,xmrem,b,4)+psvy(xp,xprem,xm,xmrem,b,-4) | |
945 | c * +psvx(xp,xprem,xm,xmrem,b,3) | |
946 | c elseif(iqq.eq.4)then | |
947 | c om2p=psvy(xp,xprem,xm,xmrem,b,5)+psvy(xp,xprem,xm,xmrem,b,7) | |
948 | c * +psvy(xp,xprem,xm,xmrem,b,-5)+psvy(xp,xprem,xm,xmrem,b,-7) | |
949 | c * +psvx(xp,xprem,xm,xmrem,b,4)+psvx(xp,xprem,xm,xmrem,b,-4) | |
950 | c elseif(iqq.eq.5)then | |
951 | c om2p=psvy(xp,xprem,xm,xmrem,b,6)+psvy(xp,xprem,xm,xmrem,b,-8) | |
952 | c * +psvx(xp,xprem,xm,xmrem,b,5) | |
953 | c elseif(iqq.eq.6)then | |
954 | c om2p=psvy(xp,xprem,xm,xmrem,b,-6)+psvy(xp,xprem,xm,xmrem,b,8) | |
955 | c * +psvx(xp,xprem,xm,xmrem,b,-5) | |
956 | c elseif(iqq.eq.7)then | |
957 | c om2p=psvy(xp,xprem,xm,xmrem,b,9) | |
958 | c * +psvx(xp,xprem,xm,xmrem,b,6) | |
959 | c elseif(iqq.eq.-7)then | |
960 | c om2p=psvy(xp,xprem,xm,xmrem,b,-9) | |
961 | c * +psvx(xp,xprem,xm,xmrem,b,-6) | |
962 | c else | |
963 | c stop'om2p-wrong iqq!!!' | |
964 | c endif | |
965 | c return | |
966 | c end | |
967 | c | |
968 | cc----------------------------------------------------------------------- | |
969 | c double precision function om3p(xh,yp,xleg,xprem,xmrem,xlrem | |
970 | c *,b1,b2,b12,iqq) | |
971 | cc----------------------------------------------------------------------- | |
972 | cc om3p - chi~(x,y) for cut pomeron (nuclear effects) | |
973 | cc xh - fraction of the energy squared s for the pomeron; | |
974 | cc yp - rapidity for the pomeron; | |
975 | cc xleg - x for the pomeron leg; | |
976 | cc xprem - x+ for the projectile remnant; | |
977 | cc xmrem - x- for the target remnant; | |
978 | cc xlrem - x for the leg remnant; | |
979 | cc b1 - impact parameter between the pomeron ends; | |
980 | cc b2 - impact parameter for the second pomeron end; | |
981 | cc iqq = 1 - uncut+, | |
982 | cc iqq = 2 - cut+, | |
983 | cc iqq = 3 - scr+, | |
984 | cc iqq = 4 - diffr+, | |
985 | cc iqq = 5 - uncut-, | |
986 | cc iqq = 6 - cut-, | |
987 | cc iqq = 7 - scr-, | |
988 | cc iqq = 8 - diff- | |
989 | cc iqq = 9 - uncut-h+, | |
990 | cc iqq = 10 - uncut-h-, | |
991 | cc iqq = 11 - uncut-YY+, | |
992 | cc iqq = 12 - uncut-YY-, | |
993 | cc----------------------------------------------------------------------- | |
994 | c double precision xh,yp,xleg,xprem,xmrem,xlrem | |
995 | c | |
996 | c om3p=0.d0 | |
997 | c return !!!!!!!!!!!!!!! | |
998 | cc if(iqq.ne.1.and.iqq.ne.5.and.iqq.ne.9.and.iqq.ne.10 | |
999 | cc *.and.iqq.ne.11.and.iqq.ne.12)return | |
1000 | c | |
1001 | cc$$$ xp=dsqrt(xh)*exp(yp) | |
1002 | cc$$$ if(xh.ne.0.d0)then | |
1003 | cc$$$ xm=xh/xp | |
1004 | cc$$$ else | |
1005 | cc$$$ xm=0.d0 | |
1006 | cc$$$ endif | |
1007 | cc$$$ | |
1008 | cc$$$ return | |
1009 | c end | |
1010 | c | |
1011 | cc----------------------------------------------------------------------- | |
1012 | c double precision function om4p(xx1,xx2,xx3,xx4 | |
1013 | c *,b12,b13,b14,b23,b24,b34,iqq) | |
1014 | cc----------------------------------------------------------------------- | |
1015 | cc om4p - chi for 2-leg contributions | |
1016 | cc xx_i - x+- for pomeron ends; | |
1017 | cc b_ij - impact parameter diff. between pomeron ends; | |
1018 | cc iqq = 1 - uncut-H, | |
1019 | cc iqq = 2 - uncut-YY+, | |
1020 | cc iqq = 3 - uncut-YY- | |
1021 | cc----------------------------------------------------------------------- | |
1022 | c double precision xx1,xx2xx3,xx4 | |
1023 | c om4p=0.d0 | |
1024 | c return | |
1025 | c end | |
1026 | c | |
1027 | cc------------------------------------------------------------------------ | |
1028 | c function omi5pp(sy,xpp,xpm,z,iqq) !former psfsh1 | |
1029 | cc----------------------------------------------------------------------- | |
1030 | cc omi5pp - integrated semihard interaction eikonal | |
1031 | cc sy - energy squared for the hard interaction, | |
1032 | cc z - impact parameter factor, z=exp(-b**2/rp), | |
1033 | cc iqq - type of the hard interaction: | |
1034 | cc 0 - soft, 1 - gg, 2 - qg, 3 - gq | |
1035 | cc----------------------------------------------------------------------- | |
1036 | c common /ar3/ x1(7),a1(7) | |
1037 | c common /ar9/ x9(3),a9(3) | |
1038 | c include 'epos.inc' | |
1039 | c include 'epos.incsem' | |
1040 | c fsy(zsy)=zsy**dels !*(1.-1./zsy)**betpom | |
1041 | c | |
1042 | c omi5pp=0. | |
1043 | c if(iclpro.eq.4.and.iqq.eq.2.or.icltar.eq.4.and.iqq.eq.3)then | |
1044 | c spmin=4.*q2min+2.*qcmass**2 | |
1045 | c elseif(iqq.ne.0)then | |
1046 | c spmin=4.*q2min | |
1047 | c else | |
1048 | c spmin=0. | |
1049 | c endif | |
1050 | c if(sy.le.spmin)return | |
1051 | c | |
1052 | c rp=r2had(iclpro)+r2had(icltar)+slopom*log(max(1.,sy)) | |
1053 | c alpq=(alppar+1.)/2. | |
1054 | c if(iqq.eq.3)then | |
1055 | c iclt=iclpro | |
1056 | c iclp=icltar | |
1057 | c else | |
1058 | c iclp=iclpro | |
1059 | c iclt=icltar | |
1060 | c endif | |
1061 | c | |
1062 | c if(iqq.eq.0)then | |
1063 | c xpmax=(1.-spmin/sy)**(1.+alplea(iclp)) | |
1064 | c do i=1,3 | |
1065 | c do m=1,2 | |
1066 | c xp=1.-(xpmax*(.5+x9(i)*(m-1.5)))**(1./(1.+alplea(iclp))) | |
1067 | c xmmax=(1.-spmin/sy/xp)**(1.+alplea(iclt)) | |
1068 | c do i1=1,3 | |
1069 | c do m1=1,2 | |
1070 | c xm=1.-(xmmax*(.5+x9(i1)*(m1-1.5)))**(1./(1.+alplea(iclt))) | |
1071 | c | |
1072 | c sy1=sy*xp*xm | |
1073 | c rh=r2had(iclpro)+r2had(icltar)+slopom*log(max(1.,sy1)) | |
1074 | c omi5pp=omi5pp+a9(i)*a9(i1)*fsy(sy1)*xmmax*z**(rp/rh)/rh | |
1075 | c * *(xp*xm)**(-alppar) | |
1076 | c enddo | |
1077 | c enddo | |
1078 | c enddo | |
1079 | c enddo | |
1080 | c omi5pp=omi5pp*xpmax/(1.+alplea(iclp))/(1.+alplea(iclt)) | |
1081 | c * *chad(iclpro)*chad(icltar)*gamhad(iclpro)*gamhad(icltar) | |
1082 | c * *(xpp*xpm)**(1.-alppar)/4. | |
1083 | c return | |
1084 | c else | |
1085 | c | |
1086 | c xmin=(spmin/sy)**(delh-dels) | |
1087 | c do i=1,3 | |
1088 | c do m=1,2 | |
1089 | c zh=(.5*(1.+xmin-(2*m-3)*x9(i)*(1.-xmin)))**(1./(delh-dels)) | |
1090 | c if(iclpro.eq.4.and.iqq.eq.2.or.icltar.eq.4.and.iqq.eq.3)then | |
1091 | c call psjti0(zh*sy,sgq,sgqb,4,0) | |
1092 | c call psjti0(zh*sy,sqq,sqqb,4,1) | |
1093 | c else | |
1094 | c call psjti0(zh*sy,sgg,sggb,0,0) | |
1095 | c call psjti0(zh*sy,sgq,sgqb,0,1) | |
1096 | c call psjti0(zh*sy,sqq,sqqb,1,1) | |
1097 | c call psjti0(zh*sy,sqaq,sqaqb,-1,1) | |
1098 | c call psjti0(zh*sy,sqqp,sqqpb,1,2) | |
1099 | c sqq=(sqq+sqaq+2.*(naflav-1)*sqqp)/naflav/2. | |
1100 | c endif | |
1101 | c | |
1102 | c if(iqq.eq.1)then | |
1103 | c stg=0. | |
1104 | c do i1=1,3 | |
1105 | c do m1=1,2 | |
1106 | c xx=.5+x9(i1)*(m1-1.5) | |
1107 | c xp=zh**xx | |
1108 | c xm=zh/xp | |
1109 | c | |
1110 | c xp1max=(1.-xp)**(1.+alplea(iclp)) | |
1111 | c xm1max=(1.-xm)**(1.+alplea(iclt)) | |
1112 | c do i2=1,3 | |
1113 | c do m2=1,2 | |
1114 | c xp1=1.-(xp1max*(.5+x9(i2)*(m2-1.5))) | |
1115 | c * **(1./(1.+alplea(iclp))) | |
1116 | c do i3=1,3 | |
1117 | c do m3=1,2 | |
1118 | c xm1=1.-(xm1max*(.5+x9(i3)*(m3-1.5))) | |
1119 | c * **(1./(1.+alplea(iclt))) | |
1120 | c if(xp1.lt.xp.or.xm1.lt.xm)write (*,*)'xp1,xm1,xp,xm' | |
1121 | c * ,xp1,xm1,xp,xm | |
1122 | c | |
1123 | c rh=r2had(iclpro)+r2had(icltar)+slopom | |
1124 | c * *log(xp1*xm1/xp/xm) | |
1125 | c glu1=(1.-xp/xp1)**betpom*(1.-glusea) | |
1126 | c sea1=EsoftQZero(xp/xp1)*glusea | |
1127 | c glu2=(1.-xm/xm1)**betpom*(1.-glusea) | |
1128 | c sea2=EsoftQZero(xm/xm1)*glusea | |
1129 | c stg=stg+a9(i1)*a9(i2)*a9(i3)*(glu1*glu2*sgg | |
1130 | c * +(glu1*sea2+sea1*glu2)*sgq+sea1*sea2*sqq) | |
1131 | c * *xp1max*xm1max*(xp1*xm1)**(dels-alppar) | |
1132 | c * *z**(rp/rh)/rh | |
1133 | c enddo | |
1134 | c enddo | |
1135 | c enddo | |
1136 | c enddo | |
1137 | c enddo | |
1138 | c enddo | |
1139 | c omi5pp=omi5pp-a9(i)*log(zh)*stg/zh**delh | |
1140 | c | |
1141 | c else | |
1142 | c stq=0. | |
1143 | c xpmin=zh**(dels+.5) | |
1144 | c do i1=1,3 | |
1145 | c do m1=1,2 | |
1146 | c xp=(.5*(1.+xpmin-(2*m1-3)*x9(i1)*(1.-xpmin))) | |
1147 | c * **(1./(dels+.5)) | |
1148 | c xm=zh/xp | |
1149 | c if(xp*xpp.lt..99999)then | |
1150 | c uv1=psdfh4(xp*xpp,q2min,0.,iclp,1) | |
1151 | c dv1=psdfh4(xp*xpp,q2min,0.,iclp,2) | |
1152 | c xm1max=(1.-xm)**(1.+alplea(iclt)) | |
1153 | c do i2=1,3 | |
1154 | c do m2=1,2 | |
1155 | c xm1=1.-(xm1max*(.5+x9(i2)*(m2-1.5))) | |
1156 | c * **(1./(1.+alplea(iclt))) | |
1157 | c | |
1158 | c rh=r2had(iclpro)+r2had(icltar)+slopom*log(xm1/xm) | |
1159 | c glu2=(1.-xm/xm1)**betpom*(1.-glusea) | |
1160 | c sea2=EsoftQZero(xm/xm1)*glusea | |
1161 | c stq=stq+a9(i1)*a9(i2)*(glu2*sgq+sea2*sqq)*(uv1+dv1) | |
1162 | c * *z**(rp/rh)/rh*xm1max*xm1**(dels-alppar)/sqrt(xp) | |
1163 | c * *((1.-xp)/(1.-xp*xpp))**(1.-alpq+alplea(iclp)) | |
1164 | c enddo | |
1165 | c enddo | |
1166 | c endif | |
1167 | c enddo | |
1168 | c enddo | |
1169 | c stq=stq*(1.-xpmin) | |
1170 | c omi5pp=omi5pp+a9(i)*stq/zh**delh | |
1171 | c endif | |
1172 | c enddo | |
1173 | c enddo | |
1174 | c endif | |
1175 | c | |
1176 | c omi5pp=omi5pp*(1.-xmin)/(delh-dels) | |
1177 | c if(iqq.eq.1)then | |
1178 | c omi5pp=omi5pp*chad(iclp)*chad(iclt)*gamhad(iclp) | |
1179 | c * *gamhad(iclt)*rr**2*(xpp*xpm)**(1.-alppar) | |
1180 | c * /(1.+alplea(iclp))/(1.+alplea(iclt))*pi/8.*factk | |
1181 | c else | |
1182 | c omi5pp=omi5pp*chad(iclp)*chad(iclt)*rr*gamhad(iclt) | |
1183 | c * *xpp**(1.-alpq)*xpm**(1.-alppar)/(.5+dels) | |
1184 | c * /(1.+alplea(iclt))/16.*factk | |
1185 | c endif | |
1186 | c return | |
1187 | c end | |
1188 | c | |
1189 | c------------------------------------------------------------------------ | |
1190 | function om52pi(sy,xpp,xpm,iqq,je1,je2) !modified om51pp | |
1191 | c----------------------------------------------------------------------- | |
1192 | c sy - energy squared for the hard interaction | |
1193 | c | |
1194 | c iqq = 0 - sea-sea, | |
1195 | c iqq = 1 - val-sea, | |
1196 | c iqq = 2 - sea-val, | |
1197 | c iqq = 3 - val-val, | |
1198 | c | |
1199 | c je = emission type | |
1200 | c 0 ... no emissions | |
1201 | c 1 ... emissions | |
1202 | c else ... all | |
1203 | c | |
1204 | c already b-averaged (\int d2b /sigine*10) | |
1205 | c----------------------------------------------------------------------- | |
1206 | common /ar3/ x1(7),a1(7) | |
1207 | common /psar7/ delx,alam3p,gam3p | |
1208 | include 'epos.inc' | |
1209 | include 'epos.incsem' | |
1210 | if(iqq.lt.0.or.iqq.gt.3)stop'om52pi: unvalid iqq' | |
1211 | ||
1212 | om52pi=0. | |
1213 | ||
1214 | ef1=0 | |
1215 | ef2=0 | |
1216 | ef3=0 | |
1217 | ef4=0 | |
1218 | if( je1.ge.1 .and. je2.ge.1) ef1=1 | |
1219 | if( je1.ge.1 .and.(je2.eq.0.or.je2.eq.2))ef2=1 | |
1220 | if((je1.eq.0.or.je1.eq.2).and. je2.ge.1) ef3=1 | |
1221 | if((je1.eq.0.or.je1.eq.2).and.(je2.eq.0.or.je2.eq.2))ef4=1 | |
1222 | ||
1223 | spmin=4.*q2min | |
1224 | if(sy.le.spmin)goto999 | |
1225 | ||
1226 | if(iqq.eq.1)then | |
1227 | iclv=iclpro | |
1228 | ctp060829 icls=icltar | |
1229 | elseif(iqq.eq.2)then | |
1230 | ctp060829 icls=iclpro | |
1231 | iclv=icltar | |
1232 | endif | |
1233 | ||
1234 | delss=dels | |
1235 | if(iqq.eq.3)delss=-0.5 | |
1236 | xmin=spmin/sy | |
1237 | xmin=xmin**(delh-delss) | |
1238 | alpq=(alppar+1.)/2. | |
1239 | ||
1240 | c numerical integration over zh | |
1241 | do i=1,7 | |
1242 | do m=1,2 | |
1243 | zh=(.5*(1.+xmin-(2*m-3)*x1(i)*(1.-xmin)))**(1./(delh-delss)) | |
1244 | sgg= ef1 *pijet(2,q2min,q2min,zh*sy,0,0) | |
1245 | * + (ef2+ef3)*pijet(1,q2min,q2min,zh*sy,0,0) | |
1246 | * + ef4 *pijet(0,q2min,q2min,zh*sy,0,0) | |
1247 | sgq= ef1 *pijet(2,q2min,q2min,zh*sy,0,1) | |
1248 | * + (ef2+ef3)*pijet(1,q2min,q2min,zh*sy,0,1) | |
1249 | * + ef4 *pijet(0,q2min,q2min,zh*sy,0,1) | |
1250 | sqq= ef1 *pijet(2,q2min,q2min,zh*sy,1,1) | |
1251 | * + (ef2+ef3)*pijet(1,q2min,q2min,zh*sy,1,1) | |
1252 | * + ef4 *pijet(0,q2min,q2min,zh*sy,1,1) | |
1253 | sqaq= ef1 *pijet(2,q2min,q2min,zh*sy,-1,1) | |
1254 | * + (ef2+ef3)*pijet(1,q2min,q2min,zh*sy,-1,1) | |
1255 | * + ef4 *pijet(0,q2min,q2min,zh*sy,-1,1) | |
1256 | sqqp= ef1 *pijet(2,q2min,q2min,zh*sy,1,2) | |
1257 | * + (ef2+ef3)*pijet(1,q2min,q2min,zh*sy,1,2) | |
1258 | * + ef4 *pijet(0,q2min,q2min,zh*sy,1,2) | |
1259 | sqqi=sqq | |
1260 | sqq=(sqq+sqaq+2.*(naflav-1)*sqqp)/naflav/2. | |
1261 | if(iqq.eq.0)then | |
1262 | stg=0. | |
1263 | do i1=1,7 | |
1264 | do m1=1,2 | |
1265 | xx=.5+x1(i1)*(m1-1.5) | |
1266 | xp=zh**xx | |
1267 | xm=zh/xp | |
1268 | glu1=EsoftGluonTil(xp) | |
1269 | sea1=EsoftQuarkTil(xp) | |
1270 | glu2=EsoftGluonTil(xm) | |
1271 | sea2=EsoftQuarkTil(xm) | |
1272 | dstg= glu1*glu2*sgg | |
1273 | * +(glu1*sea2+sea1*glu2)*sgq !ccccc | |
1274 | * +sea1*sea2*sqq !ccccc | |
1275 | stg=stg+a1(i1)*dstg | |
1276 | enddo | |
1277 | enddo | |
1278 | om52pi=om52pi-a1(i)*log(zh)*stg/zh**delh | |
1279 | elseif(iqq.eq.3)then | |
1280 | stq=0. !int^1_(sqrt(z)) dx_p / x_p / sqrt(1-x_p) =int^(tmax)_(0) dt | |
1281 | tmax=sqrt(1.-sqrt(zh)) !t=ln((1+sqrt(1-x_p))/(1-sqrt(1-x_p))) | |
1282 | tmax=log((1.+tmax)/(1.-tmax)) | |
1283 | if(tmax.gt.1.e-20)then | |
1284 | do i1=1,7 | |
1285 | do m1=1,2 | |
1286 | t=tmax*(.5+x1(i1)*(m1-1.5)) | |
1287 | z01=((1.d0-exp(-1.d0*t))/(1.d0+exp(-1.d0*t)))**2 | |
1288 | xp=1.-z01 | |
1289 | xm=zh/xp | |
1290 | if(xp*xpp.le..9999.and.xm*xpm.le..9999 | |
1291 | * .or.xm*xpp.le..9999.and.xp*xpm.le..9999)then | |
1292 | stq=stq+a1(i1) | |
1293 | * *(psharg(xp*xpp,xm*xpm,sqqi,sqqp,sqaq) | |
1294 | * +psharg(xm*xpp,xp*xpm,sqqi,sqqp,sqaq)) | |
1295 | * *max(1e-20,1.-xp)**(.5-alpq) | |
1296 | * *max(1e-20,1.-xm)**(-alpq) | |
1297 | * *xp**delss*xm**delss | |
1298 | * *xpp**alppar/gamhad(iclpro) ! Eval | |
1299 | * *xpm**alppar/gamhad(icltar) ! Eval | |
1300 | endif | |
1301 | enddo | |
1302 | enddo | |
1303 | stq=stq*tmax | |
1304 | endif | |
1305 | om52pi=om52pi+a1(i)*stq/zh**delh | |
1306 | elseif(iqq.eq.1.or.iqq.eq.2)then | |
1307 | stq=0. | |
1308 | tmax=acos(sqrt(zh)) | |
1309 | do i1=1,7 | |
1310 | do m1=1,2 | |
1311 | t=tmax*(.5+x1(i1)*(m1-1.5)) | |
1312 | xp=cos(t)**2 | |
1313 | xm=zh/xp | |
1314 | if(xp*xpp.lt..99999)then | |
1315 | uv1=psdfh4(xp*xpp,q2min,0.,iclv,1) ! Eval | |
1316 | dv1=psdfh4(xp*xpp,q2min,0.,iclv,2) ! Eval | |
1317 | glu2=EsoftGluonTil(xm) | |
1318 | sea2=EsoftQuarkTil(xm) | |
1319 | dstq=0 | |
1320 | if(xp.ne.1.) | |
1321 | * dstq=(glu2*sgq+sea2*sqq)*(uv1+dv1) | |
1322 | * *(1.-xp*xpp)**(-1.+alpq-alplea(iclv)) ! Eval | |
1323 | * *xp**(delss-.5)*(1.-xp)**(-alpq+.5) ! Eval *sqrt(1-x)/sqrt(x) | |
1324 | * *xpp**alppar/gamhad(iclv) ! Eval | |
1325 | stq=stq+a1(i1)*dstq | |
1326 | endif | |
1327 | enddo | |
1328 | enddo | |
1329 | stq=stq*tmax | |
1330 | om52pi=om52pi+a1(i)*stq/zh**delh | |
1331 | else | |
1332 | stop'om52pi: unvalid iqq (2). ' | |
1333 | endif | |
1334 | enddo | |
1335 | enddo | |
1336 | ||
1337 | om52pi=om52pi*(1.-xmin)/(delh-delss) | |
1338 | ||
1339 | if(iqq.eq.0)then | |
1340 | om52pi=om52pi/4 | |
1341 | elseif(iqq.eq.3)then | |
1342 | om52pi=om52pi/4 | |
1343 | * * utgam1(2.+alplea(iclpro)-alpq) ! Eval | |
1344 | * /utgam1(1.+alplea(iclpro))/utgam1(1.-alpq) ! Eval | |
1345 | * * utgam1(2.+alplea(icltar)-alpq) ! Eval | |
1346 | * /utgam1(1.+alplea(icltar))/utgam1(1.-alpq) ! Eval | |
1347 | * /xpp**alpq/xpm**alpq ! Eval | |
1348 | elseif(iqq.le.2)then | |
1349 | om52pi=om52pi/2 | |
1350 | * *utgam1(2.+alplea(iclv)-alpq)/utgam1(1.+alplea(iclv)) ! Eval | |
1351 | * /utgam1(1.-alpq) ! Eval | |
1352 | * /xpp**alpq ! Eval | |
1353 | endif | |
1354 | ||
1355 | 999 continue | |
1356 | om52pi=om52pi*factk * .0390 /sigine*10 /2. | |
1357 | end | |
1358 | ||
1359 | c------------------------------------------------------------------------ | |
1360 | function psharg(zh1,zh2,sqq,sqqp,sqaq) | |
1361 | c----------------------------------------------------------------------- | |
1362 | include 'epos.incsem' | |
1363 | include 'epos.inc' | |
1364 | ||
1365 | alpq=(alppar+1.)/2. | |
1366 | if(zh1.le..9999.and.zh2.le..9999)then | |
1367 | uv1=psdfh4(zh1,q2min,0.,iclpro,1) | |
1368 | dv1=psdfh4(zh1,q2min,0.,iclpro,2) | |
1369 | uv2=psdfh4(zh2,q2min,0.,icltar,1) | |
1370 | dv2=psdfh4(zh2,q2min,0.,icltar,2) | |
1371 | if(iclpro.eq.2.and.icltar.eq.2)then !proton | |
1372 | fff=sqq*(uv1*uv2+dv1*dv2)+sqqp*(uv1*dv2+dv1*uv2) | |
1373 | elseif(iclpro.eq.1.or.icltar.eq.1)then !pion | |
1374 | fff=sqq*uv1*uv2+sqaq*dv1*dv2+sqqp*(uv1*dv2+dv1*uv2) | |
1375 | elseif(iclpro.eq.3.or.icltar.eq.3)then !kaon | |
1376 | fff=sqq*uv1*uv2+sqqp*(uv1*dv2+dv1*uv2+dv1*dv2) | |
1377 | elseif(iclpro.eq.4.or.icltar.eq.4)then !J/psi | |
1378 | fff=sqq*uv1*(uv2+dv2) | |
1379 | endif | |
1380 | psharg=fff | |
1381 | * *(1.-zh1)**(-1.+alpq-alplea(iclpro)) | |
1382 | * *(1.-zh2)**(-1.+alpq-alplea(icltar)) | |
1383 | else | |
1384 | psharg=0. | |
1385 | endif | |
1386 | return | |
1387 | end | |
1388 | ||
1389 | c------------------------------------------------------------------------ | |
1390 | function om51pp(sy,xpp,z,iqq) !former psfsh | |
1391 | c----------------------------------------------------------------------- | |
1392 | c om51pp - semihard interaction eikonal | |
1393 | c sy - energy squared for the hard interaction, | |
1394 | c z - impact parameter factor, z=exp(-b**2/rp), | |
1395 | c iqq - type of the hard interaction: | |
1396 | c 0 - gg, 1 - qg, 2 - gq, 3 - gg(int), 4 - gg(proj), 5 - qg(proj), | |
1397 | c 6 - gg(int)|b=0, 7 - <b^2*gg(int)>, 8 - gg(proj)|b=0, | |
1398 | c 9 - <b^2*gg(proj)>, 10 - qg(proj)|b=0, 11 - <b^2*qg(proj)> | |
1399 | c----------------------------------------------------------------------- | |
1400 | common /ar3/ x1(7),a1(7) | |
1401 | common /psar7/ delx,alam3p,gam3p | |
1402 | include 'epos.inc' | |
1403 | include 'epos.incsem' | |
1404 | ||
1405 | om51pp=0. | |
1406 | if(iqq.eq.0.or.iqq.eq.3.or.iqq.eq.4 | |
1407 | *.or.iqq.eq.6.or.iqq.eq.7.or.iqq.eq.8.or.iqq.eq.9 | |
1408 | *.or.iclpro.ne.4.and.(iqq.eq.1.or.iqq.eq.5 | |
1409 | *.or.iqq.eq.10.or.iqq.eq.11) | |
1410 | *.or.icltar.ne.4.and.iqq.eq.2)then | |
1411 | spmin=4.*q2min | |
1412 | else | |
1413 | spmin=4.*q2min+2.*qcmass**2 | |
1414 | endif | |
1415 | if(sy.le.spmin)goto999 | |
1416 | ||
1417 | if(iqq.eq.1.or.iqq.eq.5.or.iqq.eq.10.or.iqq.eq.11)then | |
1418 | iclv=iclpro | |
1419 | icls=icltar | |
1420 | elseif(iqq.eq.2)then | |
1421 | icls=iclpro | |
1422 | iclv=icltar | |
1423 | endif | |
1424 | ||
1425 | xmin=spmin/sy | |
1426 | xmin=xmin**(delh-dels) | |
1427 | rp=r2had(iclpro)+r2had(icltar)+slopom*log(max(1.,sy)) | |
1428 | alpq=(alppar+1.)/2. | |
1429 | ||
1430 | c numerical integration over zh | |
1431 | do i=1,7 | |
1432 | do m=1,2 | |
1433 | zh=(.5*(1.+xmin-(2*m-3)*x1(i)*(1.-xmin)))**(1./ | |
1434 | * (delh-dels)) | |
1435 | if(iqq.eq.0.or.iqq.eq.3.or.iqq.eq.4 | |
1436 | * .or.iqq.eq.6.or.iqq.eq.7.or.iqq.eq.8.or.iqq.eq.9 | |
1437 | * .or.iclpro.ne.4.and.(iqq.eq.1.or.iqq.eq.5 | |
1438 | * .or.iqq.eq.10.or.iqq.eq.11) | |
1439 | * .or.icltar.ne.4.and.iqq.eq.2)then | |
1440 | call psjti0(zh*sy,sgg,sggb,0,0) !inclusive (sj) and born (sjb) | |
1441 | call psjti0(zh*sy,sgq,sgqb,0,1) | |
1442 | call psjti0(zh*sy,sqq,sqqb,1,1) | |
1443 | call psjti0(zh*sy,sqaq,sqaqb,-1,1) | |
1444 | call psjti0(zh*sy,sqqp,sqqpb,1,2) | |
1445 | sqq=(sqq+sqaq+2.*(naflav-1)*sqqp)/naflav/2. | |
1446 | c...........test....... | |
1447 | c tgg= psjet(q2min,q2min,q2min,zh*sy,0,0,0) | |
1448 | c * +2*psjet1(q2min,q2min,q2min,zh*sy,0,0,0) | |
1449 | c * + psborn(q2min,q2min,q2min,zh*sy,0,0,0,1) | |
1450 | c tgq= psjet(q2min,q2min,q2min,zh*sy,0,1,0) | |
1451 | c * +2*psjet1(q2min,q2min,q2min,zh*sy,0,1,0) | |
1452 | c * + psborn(q2min,q2min,q2min,zh*sy,0,1,0,1) | |
1453 | c tqq= psjet(q2min,q2min,q2min,zh*sy,1,1,0) | |
1454 | c * +2*psjet1(q2min,q2min,q2min,zh*sy,1,1,0) | |
1455 | c * + psborn(q2min,q2min,q2min,zh*sy,1,1,0,1) | |
1456 | c tqa= psjet(q2min,q2min,q2min,zh*sy,-1,1,0) | |
1457 | c * +2*psjet1(q2min,q2min,q2min,zh*sy,-1,1,0) | |
1458 | c * + psborn(q2min,q2min,q2min,zh*sy,-1,1,0,1) | |
1459 | c tqqp= psjet(q2min,q2min,q2min,zh*sy,1,2,0) | |
1460 | c * +2*psjet1(q2min,q2min,q2min,zh*sy,1,2,0) | |
1461 | c * + psborn(q2min,q2min,q2min,zh*sy,1,2,0,1) | |
1462 | c write(6,'(f12.2,3x,2f7.3,2(3x,2f7.3))') | |
1463 | c * zh*sy,tgg,sgg, tgq,sgq, tqqp,sqqp | |
1464 | c....................... | |
1465 | else | |
1466 | call psjti0(zh*sy,sgq,sgqb,4,0) | |
1467 | call psjti0(zh*sy,sqq,sqqb,4,1) | |
1468 | endif | |
1469 | ||
1470 | if(iqq.eq.0.or.iqq.eq.3.or.iqq.eq.4 | |
1471 | * .or.iqq.eq.6.or.iqq.eq.7.or.iqq.eq.8.or.iqq.eq.9)then | |
1472 | stg=0. | |
1473 | do i1=1,7 | |
1474 | do m1=1,2 | |
1475 | xx=.5+x1(i1)*(m1-1.5) | |
1476 | xp=zh**xx | |
1477 | xm=zh/xp | |
1478 | glu1=(1.-xp)**betpom*(1.-glusea) | |
1479 | sea1=EsoftQZero(xp)*glusea | |
1480 | glu2=(1.-xm)**betpom*(1.-glusea) | |
1481 | sea2=EsoftQZero(xm)*glusea | |
1482 | if(iqq.eq.0)then | |
1483 | rh=r2had(iclpro)+r2had(icltar)-slopom*log(zh) | |
1484 | elseif(iqq.eq.3.or.iqq.eq.4)then | |
1485 | rh=1. | |
1486 | elseif(iqq.eq.6.or.iqq.eq.7)then | |
1487 | rh=alam3p-slopom*log(zh) | |
1488 | elseif(iqq.eq.8.or.iqq.eq.9)then | |
1489 | rh=r2had(iclpro)+.5*alam3p-slopom*log(zh) | |
1490 | endif | |
1491 | dstg=(glu1*glu2*sgg+ | |
1492 | * (glu1*sea2+sea1*glu2)*sgq+sea1*sea2*sqq) | |
1493 | * *z**(rp/rh)/rh | |
1494 | if(iqq.eq.7.or.iqq.eq.9)dstg=dstg*rh**2 | |
1495 | stg=stg+a1(i1)*dstg | |
1496 | enddo | |
1497 | enddo | |
1498 | om51pp=om51pp-a1(i)*log(zh)*stg/zh**delh | |
1499 | else | |
1500 | stq=0. | |
1501 | tmax=acos(sqrt(zh)) | |
1502 | do i1=1,7 | |
1503 | do m1=1,2 | |
1504 | t=tmax*(.5+x1(i1)*(m1-1.5)) | |
1505 | xp=cos(t)**2 | |
1506 | xm=zh/xp | |
1507 | if(xp*xpp.lt..99999)then | |
1508 | uv1=psdfh4(xp*xpp,q2min,0.,iclv,1) | |
1509 | dv1=psdfh4(xp*xpp,q2min,0.,iclv,2) | |
1510 | glu2=(1.-xm)**betpom*(1.-glusea) | |
1511 | sea2=EsoftQZero(xm)*glusea | |
1512 | if(iqq.le.2)then | |
1513 | rh=r2had(iclpro)+r2had(icltar)-slopom*log(xm) | |
1514 | elseif(iqq.eq.5)then | |
1515 | rh=1. | |
1516 | elseif(iqq.le.10.or.iqq.le.11)then | |
1517 | rh=r2had(iclpro)+.5*alam3p-slopom*log(xm) | |
1518 | endif | |
1519 | dstq=0 | |
1520 | if(xp.ne.1.) | |
1521 | * dstq=(glu2*sgq+sea2*sqq)*(uv1+dv1) | |
1522 | * *z**(rp/rh)/rh | |
1523 | * *(1.-xp*xpp)**(-1.+alpq-alplea(iclv)) | |
1524 | * *xp**(dels-.5)*(1.-xp)**(-alpq+.5) | |
1525 | if(iqq.eq.11)dstq=dstq*rh**2 | |
1526 | stq=stq+a1(i1)*dstq | |
1527 | endif | |
1528 | enddo | |
1529 | enddo | |
1530 | stq=stq*tmax | |
1531 | om51pp=om51pp+a1(i)*stq/zh**delh | |
1532 | endif | |
1533 | enddo | |
1534 | enddo | |
1535 | ||
1536 | om51pp=om51pp*(1.-xmin)/(delh-dels)/sy**delh/2. | |
1537 | if(iqq.eq.0)then | |
1538 | om51pp=om51pp*chad(iclpro)*chad(icltar)*gamhad(iclpro) | |
1539 | * *gamhad(icltar)*rr**2*pi | |
1540 | elseif(iqq.eq.3)then | |
1541 | om51pp=om51pp*rr**2*pi*4.*.0389 | |
1542 | elseif(iqq.eq.6)then | |
1543 | om51pp=om51pp*rr**2*pi | |
1544 | elseif(iqq.eq.7)then | |
1545 | om51pp=om51pp*rr**2*pi*(4.*.0389)**2 | |
1546 | elseif(iqq.eq.4.or.iqq.eq.8.or.iqq.eq.9)then | |
1547 | om51pp=om51pp*rr**2*pi*chad(iclpro)*gamhad(iclpro) | |
1548 | if(iqq.eq.4)om51pp=om51pp*4.*.0389 | |
1549 | if(iqq.eq.9)om51pp=om51pp*(4.*.0389)**2 | |
1550 | elseif(iqq.le.2)then | |
1551 | om51pp=om51pp*chad(iclpro)*chad(icltar)*rr*gamhad(icls) | |
1552 | * *utgam1(2.+alplea(iclv)-alpq)/utgam1(1.+alplea(iclv)) | |
1553 | * /utgam1(1.-alpq)/2./xpp**alpq | |
1554 | elseif(iqq.eq.5.or.iqq.eq.10.or.iqq.eq.11)then | |
1555 | om51pp=om51pp*chad(iclv)*rr | |
1556 | * *utgam1(2.+alplea(iclv)-alpq)/utgam1(1.+alplea(iclv)) | |
1557 | * /utgam1(1.-alpq)/2./xpp**alpq | |
1558 | if(iqq.eq.5)om51pp=om51pp*4.*.0389 | |
1559 | if(iqq.eq.11)om51pp=om51pp*(4.*.0389)**2 | |
1560 | endif | |
1561 | 999 continue | |
1562 | end | |
1563 | ||
1564 | c------------------------------------------------------------------------ | |
1565 | subroutine psfz(gz2,b) | |
1566 | c----------------------------------------------------------------------- | |
1567 | c hadron-nucleus cross sections calculation | |
1568 | c b - impact parameter squared | |
1569 | c----------------------------------------------------------------------- | |
1570 | double precision PhiExpo | |
1571 | include 'epos.inc' | |
1572 | common /ar3/ x1(7),a1(7) | |
1573 | external pttcs,pprcs | |
1574 | ||
1575 | gz2=0. | |
1576 | e1=exp(-1.) | |
1577 | rs=r2had(iclpro)+r2had(icltar)+max(slopom,slopoms)*log(engy**2) | |
1578 | & +gwidth*(r2had(iclpro)+r2had(icltar)) | |
1579 | & +bmxdif(iclpro,icltar)/4./0.0389 | |
1580 | rpom=4.*.0389*rs | |
1581 | ||
1582 | ||
1583 | do i1=1,7 | |
1584 | do m=1,2 | |
1585 | z=.5+x1(i1)*(m-1.5) | |
1586 | zv1=exp(-z) | |
1587 | zv2=(e1*z) | |
1588 | b1=sqrt(-rpom*log(zv1)) | |
1589 | b2=sqrt(-rpom*log(zv2)) | |
1590 | ||
1591 | vv21=sngl(PhiExpo(1.,1.d0,1.d0,engy**2,b1)) | |
1592 | vv22=sngl(PhiExpo(1.,1.d0,1.d0,engy**2,b2)) | |
1593 | ||
1594 | if(maproj.eq.1.and.matarg.eq.1)then | |
1595 | cg1=1. | |
1596 | cg2=1. | |
1597 | elseif(matarg.eq.1)then | |
1598 | cg1=ptrot(pprcs,b,b1) | |
1599 | cg2=ptrot(pprcs,b,b2) | |
1600 | else | |
1601 | cg1=ptrot(pttcs,b,b1) | |
1602 | cg2=ptrot(pttcs,b,b2) | |
1603 | endif | |
1604 | ||
1605 | gz2=gz2+a1(i1)*(cg1*(1.-vv21)+cg2*(1.-vv22)/z) | |
1606 | enddo | |
1607 | enddo | |
1608 | gz2=gz2*rpom/2. | |
1609 | ||
1610 | return | |
1611 | end | |
1612 | ||
1613 | ||
1614 | c------------------------------------------------------------------------ | |
1615 | function ptgau(func,bm,iqq) | |
1616 | c----------------------------------------------------------------------- | |
1617 | c impact parameter integration for impact parameters <bm - | |
1618 | c for nucleus-nucleus and hadron-nucleus cross-sections calculation | |
1619 | c iqq=1 : projectile, iqq=2 : target | |
1620 | c----------------------------------------------------------------------- | |
1621 | include 'epos.inc' | |
1622 | common /ar3/ x1(7),a1(7) | |
1623 | external func | |
1624 | ||
1625 | ptgau=0. | |
1626 | do i=1,7 | |
1627 | do m=1,2 | |
1628 | b=bm*sqrt(.5+x1(i)*(m-1.5)) | |
1629 | ptgau=ptgau+func(b,iqq)*a1(i) | |
1630 | enddo | |
1631 | enddo | |
1632 | ptgau=ptgau*bm**2*pi*.5 | |
1633 | return | |
1634 | end | |
1635 | ||
1636 | c------------------------------------------------------------------------ | |
1637 | function ptgau1(bm,iqq) | |
1638 | c----------------------------------------------------------------------- | |
1639 | c impact parameter integration for impact parameters >bm - | |
1640 | c for hadron-nucleus cross-sections calculation | |
1641 | c iqq=1 : projectile, iqq=2 : target | |
1642 | c----------------------------------------------------------------------- | |
1643 | include 'epos.inc' | |
1644 | common /ar5/ x5(2),a5(2) | |
1645 | ||
1646 | ptgau1=0. | |
1647 | if(iqq.eq.1)then | |
1648 | difn=difnuc(maproj) | |
1649 | else | |
1650 | difn=difnuc(matarg) | |
1651 | endif | |
1652 | do i=1,2 | |
1653 | b=bm+x5(i)*difn | |
1654 | ptgau1=ptgau1+ptfau(b,iqq)*a5(i)*exp(x5(i))*b*2.*pi*difn | |
1655 | enddo | |
1656 | return | |
1657 | end | |
1658 | c------------------------------------------------------------------------ | |
1659 | function ptgau2(bm) | |
1660 | c----------------------------------------------------------------------- | |
1661 | c impact parameter integration for impact parameters >bm - | |
1662 | c for nucleus-nucleus cross-sections calculation | |
1663 | c----------------------------------------------------------------------- | |
1664 | include 'epos.inc' | |
1665 | common /ar5/ x5(2),a5(2) | |
1666 | ||
1667 | ptgau2=0. | |
1668 | difn=difnuc(maproj)+difnuc(matarg) | |
1669 | do i=1,2 | |
1670 | b=bm+x5(i)*difn | |
1671 | ptgau2=ptgau2+ptfauAA(b)*a5(i)*exp(x5(i))*b*2.*pi*difn | |
1672 | enddo | |
1673 | return | |
1674 | end | |
1675 | ||
1676 | ||
1677 | c------------------------------------------------------------------------ | |
1678 | function ptfau(b,iqq) | |
1679 | c----------------------------------------------------------------------- | |
1680 | c ptfau - integrands for hadron-nucleus cross-sections calculation | |
1681 | c iqq=1 : projectile, iqq=2 : target | |
1682 | c----------------------------------------------------------------------- | |
1683 | include 'epos.inc' | |
1684 | common /psar35/ anorm,anormp | |
1685 | ||
1686 | call psfz(gz2,b) | |
1687 | ||
1688 | if(iqq.eq.1)then | |
1689 | ptfau=1.-max(0.,(1.-anormp*gz2))**maproj | |
1690 | else | |
1691 | ptfau=1.-max(0.,(1.-anorm*gz2))**matarg | |
1692 | endif | |
1693 | ||
1694 | return | |
1695 | end | |
1696 | ||
1697 | c------------------------------------------------------------------------ | |
1698 | function ptfauAA(b) | |
1699 | c----------------------------------------------------------------------- | |
1700 | c ptfau - integrands for hadron-nucleus cross-sections calculation | |
1701 | c----------------------------------------------------------------------- | |
1702 | include 'epos.inc' | |
1703 | common /ar3/ x1(7),a1(7) | |
1704 | common /psar35/ anorm,anormp | |
1705 | external pprcs | |
1706 | ||
1707 | ptfauAA=0. | |
1708 | e1=exp(-1.) | |
1709 | rs=r2had(iclpro)+r2had(icltar)+max(slopom,slopoms)*log(engy**2) | |
1710 | & +gwidth*(r2had(iclpro)+r2had(icltar)) | |
1711 | & +bmxdif(iclpro,icltar)/4./0.0389 | |
1712 | rpom=4.*.0389*rs | |
1713 | do i1=1,7 | |
1714 | do m=1,2 | |
1715 | z=.5+x1(i1)*(m-1.5) | |
1716 | zv1=exp(-z) | |
1717 | zv2=(e1*z) | |
1718 | b1=sqrt(-rpom*log(zv1)) | |
1719 | b2=sqrt(-rpom*log(zv2)) | |
1720 | call psfz(gz21,b1) | |
1721 | call psfz(gz22,b2) | |
1722 | ptfau1=max(0.,(1.-anorm*gz21))**matarg | |
1723 | ptfau2=max(0.,(1.-anorm*gz22))**matarg | |
1724 | cg1=ptrot(pprcs,b,b1) | |
1725 | cg2=ptrot(pprcs,b,b2) | |
1726 | ptfauAA=ptfauAA+a1(i1)*(cg1*(1.-ptfau1)+cg2*(1.-ptfau2)/z) | |
1727 | enddo | |
1728 | enddo | |
1729 | ptfauAA=ptfauAA*rpom/2. | |
1730 | ptfauAA=1.-max(0.,(1.-anormp*ptfauAA))**maproj | |
1731 | ||
1732 | return | |
1733 | end | |
1734 | ||
1735 | c------------------------------------------------------------------------ | |
1736 | function ptrot(func,s,b) | |
1737 | c----------------------------------------------------------------------- | |
1738 | c convolution of nuclear profile functions (axial angle integration) | |
1739 | c----------------------------------------------------------------------- | |
1740 | common /ar8/ x2(4),a2 | |
1741 | external func | |
1742 | ||
1743 | ptrot=0. | |
1744 | do i=1,4 | |
1745 | sb1=b**2+s**2-2.*b*s*(2.*x2(i)-1.) | |
1746 | sb2=b**2+s**2-2.*b*s*(1.-2.*x2(i)) | |
1747 | ptrot=ptrot+(func(sb1)+func(sb2)) | |
1748 | enddo | |
1749 | ptrot=ptrot*a2 | |
1750 | return | |
1751 | end | |
1752 | ||
1753 | c------------------------------------------------------------------------ | |
1754 | function pttcs(b0) | |
1755 | c----------------------------------------------------------------------- | |
1756 | c ptt - nuclear profile function value at imp param squared b*difnuc**2 | |
1757 | c----------------------------------------------------------------------- | |
1758 | include 'epos.inc' | |
1759 | common /psar34/ rrr,rrrm | |
1760 | common /ar5/ x5(2),a5(2) | |
1761 | common /ar9/ x9(3),a9(3) | |
1762 | ||
1763 | b=b0/difnuc(matarg)**2 | |
1764 | pttcs=0. | |
1765 | zm=rrrm**2-b | |
1766 | if(zm.gt.4.*b)then | |
1767 | zm=sqrt(zm) | |
1768 | else | |
1769 | zm=2.*sqrt(b) | |
1770 | endif | |
1771 | ||
1772 | do i=1,3 | |
1773 | z1=zm*(1.+x9(i))*0.5 | |
1774 | z2=zm*(1.-x9(i))*0.5 | |
1775 | quq=sqrt(b+z1**2)-rrr | |
1776 | if (quq.lt.85.)pttcs=pttcs+a9(i)/(1.+exp(quq)) | |
1777 | quq=sqrt(b+z2**2)-rrr | |
1778 | if (quq.lt.85.)pttcs=pttcs+a9(i)/(1.+exp(quq)) | |
1779 | enddo | |
1780 | pttcs=pttcs*zm*0.5 | |
1781 | ||
1782 | dt=0. | |
1783 | do i=1,2 | |
1784 | z1=x5(i)+zm | |
1785 | quq=sqrt(b+z1**2)-rrr-x5(i) | |
1786 | if (quq.lt.85.)dt=dt+a5(i)/(exp(-x5(i))+exp(quq)) | |
1787 | enddo | |
1788 | ||
1789 | pttcs=pttcs+dt | |
1790 | return | |
1791 | end | |
1792 | ||
1793 | c------------------------------------------------------------------------ | |
1794 | function pprcs(b0) | |
1795 | c----------------------------------------------------------------------- | |
1796 | c ptt - nuclear profile function value at imp param squared b*difnuc**2 | |
1797 | c----------------------------------------------------------------------- | |
1798 | include 'epos.inc' | |
1799 | common /psar41/ rrrp,rrrmp | |
1800 | common /ar5/ x5(2),a5(2) | |
1801 | common /ar9/ x9(3),a9(3) | |
1802 | ||
1803 | b=b0/difnuc(maproj)**2 | |
1804 | pprcs=0. | |
1805 | zm=rrrmp**2-b | |
1806 | if(zm.gt.4.*b)then | |
1807 | zm=sqrt(zm) | |
1808 | else | |
1809 | zm=2.*sqrt(b) | |
1810 | endif | |
1811 | ||
1812 | do i=1,3 | |
1813 | z1=zm*(1.+x9(i))*0.5 | |
1814 | z2=zm*(1.-x9(i))*0.5 | |
1815 | quq=sqrt(b+z1**2)-rrrp | |
1816 | if (quq.lt.85.)pprcs=pprcs+a9(i)/(1.+exp(quq)) | |
1817 | quq=sqrt(b+z2**2)-rrrp | |
1818 | if (quq.lt.85.)pprcs=pprcs+a9(i)/(1.+exp(quq)) | |
1819 | enddo | |
1820 | pprcs=pprcs*zm*0.5 | |
1821 | ||
1822 | dt=0. | |
1823 | do i=1,2 | |
1824 | z1=x5(i)+zm | |
1825 | quq=sqrt(b+z1**2)-rrrp-x5(i) | |
1826 | if (quq.lt.85.)dt=dt+a5(i)/(exp(-x5(i))+exp(quq)) | |
1827 | enddo | |
1828 | ||
1829 | pprcs=pprcs+dt | |
1830 | return | |
1831 | end | |
1832 | ||
1833 | c------------------------------------------------------------------------------ | |
1834 | function pscrse(ek,mapr,matg) | |
1835 | c------------------------------------------------------------------------------ | |
1836 | c hadron-nucleus (hadron-proton) and nucl-nucl particle production cross section | |
1837 | c ek - lab kinetic energy for the interaction | |
1838 | c maproj - projec mass number (1<maproj<64) | |
1839 | c matarg - target mass number (1<matarg<64) | |
1840 | c------------------------------------------------------------------------------ | |
1841 | dimension wk(3),wa(3),wb(3) | |
1842 | include 'epos.inc' | |
1843 | common /psar33/ asect(7,4,7),asectn(7,7,7) | |
1844 | common /psar34/ rrr,rrrm | |
1845 | common /psar35/ anorm,anormp | |
1846 | common /psar41/ rrrp,rrrmp | |
1847 | external ptfau,ptfauAA | |
1848 | ||
1849 | pscrse=0. | |
1850 | call idmass(1120,amt1) | |
1851 | call idmass(1220,amt2) | |
1852 | amtar=0.5*(amt1+amt2) | |
1853 | if(matg.eq.1)amtar=amt1 | |
1854 | if(mapr.eq.1)then | |
1855 | call idmass(idproj,ampro) | |
1856 | else | |
1857 | ampro=amtar | |
1858 | endif | |
1859 | egy=ek+ampro | |
1860 | c p=sqrt(max(0.,egy**2-ampro**2)) | |
1861 | egy=sqrt( 2*egy*amtar+amtar**2+ampro**2 ) | |
1862 | ||
1863 | if(isetcs.le.1)then | |
1864 | maprojsave=maproj | |
1865 | matargsave=matarg | |
1866 | engysave=engy | |
1867 | maproj=mapr | |
1868 | matarg=matg | |
1869 | engy=egy | |
1870 | if(matg.eq.1.and.mapr.eq.1)then | |
1871 | call psfz(gz2,0.) | |
1872 | gin=gz2*pi*10. | |
1873 | elseif(mapr.eq.1)then | |
1874 | rad=radnuc(matg) | |
1875 | bm=rad+2. | |
1876 | rrr=rad/difnuc(matg) | |
1877 | rrrm=rrr+log(9.) | |
1878 | anorm=1.5/pi/rrr**3/(1.+(pi/rrr)**2)/difnuc(matg)**2 | |
1879 | gin=(ptgau(ptfau,bm,2)+ptgau1(bm,2))*10. !sig_in | |
1880 | elseif(matg.eq.1)then | |
1881 | rad=radnuc(mapr) | |
1882 | bm=rad+2. | |
1883 | rrrp=rad/difnuc(mapr) | |
1884 | rrrmp=rrrp+log(9.) | |
1885 | anormp=1.5/pi/rrrp**3/(1.+(pi/rrrp)**2)/difnuc(mapr)**2 | |
1886 | gin=(ptgau(ptfau,bm,1)+ptgau1(bm,1))*10. !sig_in | |
1887 | else | |
1888 | rad=radnuc(matg)+1. | |
1889 | radp=radnuc(mapr)+1. | |
1890 | bm=rad+radp+2. | |
1891 | rrr=rad/difnuc(matg) | |
1892 | rrrm=rrr+log(9.) | |
1893 | rrrp=radp/difnuc(mapr) | |
1894 | rrrmp=rrrp+log(9.) | |
1895 | anorm=1.5/pi/rrr**3/(1.+(pi/rrr)**2)/difnuc(matg)**2 | |
1896 | anormp=1.5/pi/rrrp**3/(1.+(pi/rrrp)**2)/difnuc(mapr)**2 | |
1897 | gin=(ptgau(ptfauAA,bm,2)+ptgau2(bm))*10. | |
1898 | endif | |
1899 | pscrse=gin | |
1900 | maproj=maprojsave | |
1901 | matarg=matargsave | |
1902 | engy=engysave | |
1903 | else | |
1904 | ye=log10(max(1.,egy/1.5))+1. | |
1905 | je=min(5,int(ye)) | |
1906 | ||
1907 | wk(2)=ye-je | |
1908 | wk(3)=wk(2)*(wk(2)-1.)*.5 | |
1909 | wk(1)=1.-wk(2)+wk(3) | |
1910 | wk(2)=wk(2)-2.*wk(3) | |
1911 | ||
1912 | ya=matg | |
1913 | ya=log(ya)/.69315+1. | |
1914 | ja=min(int(ya),4) | |
1915 | wa(2)=ya-ja | |
1916 | wa(3)=wa(2)*(wa(2)-1.)*.5 | |
1917 | wa(1)=1.-wa(2)+wa(3) | |
1918 | wa(2)=wa(2)-2.*wa(3) | |
1919 | ||
1920 | if(mapr.eq.1)then | |
1921 | ||
1922 | do i=1,3 | |
1923 | do m=1,3 | |
1924 | pscrse=pscrse+asect(je+i-1,iclpro,ja+m-1)*wk(i)*wa(m) | |
1925 | enddo | |
1926 | enddo | |
1927 | ||
1928 | else | |
1929 | ||
1930 | yb=mapr | |
1931 | yb=log(yb)/.69315+1. | |
1932 | jb=min(int(yb),4) | |
1933 | wb(2)=yb-jb | |
1934 | wb(3)=wb(2)*(wb(2)-1.)*.5 | |
1935 | wb(1)=1.-wb(2)+wb(3) | |
1936 | wb(2)=wb(2)-2.*wb(3) | |
1937 | ||
1938 | do i=1,3 | |
1939 | do m=1,3 | |
1940 | do n=1,3 | |
1941 | pscrse=pscrse+asectn(je+i-1,jb+n-1,ja+m-1)*wk(i)*wa(m)*wb(n) | |
1942 | enddo | |
1943 | enddo | |
1944 | enddo | |
1945 | ||
1946 | endif | |
1947 | ||
1948 | pscrse=exp(pscrse) | |
1949 | endif | |
1950 | return | |
1951 | end | |
1952 | ||
1953 | c------------------------------------------------------------------------------ | |
1954 | function eposcrse(ek,mapro,matar,id) | |
1955 | c------------------------------------------------------------------------------ | |
1956 | c inelastic cross section of epos | |
1957 | c (id=0 corresponds to air) | |
1958 | c ek - kinetic energy for the interaction | |
1959 | c maproj - projec mass number (1<maproj<64) | |
1960 | c matarg - target mass number (1<matarg<64) | |
1961 | c------------------------------------------------------------------------------ | |
1962 | include 'epos.inc' | |
1963 | ||
1964 | eposcrse=0. | |
1965 | if(id.eq.0)then | |
1966 | do k=1,3 | |
1967 | mt=int(airanxs(k)) | |
1968 | eposcrse=eposcrse+airwnxs(k)*pscrse(ek,mapro,mt) | |
1969 | enddo | |
1970 | else | |
1971 | eposcrse=pscrse(ek,mapro,matar) | |
1972 | endif | |
1973 | ||
1974 | return | |
1975 | end | |
1976 | ||
1977 | ||
1978 | cc------------------------------------------------------------------------ | |
1979 | c function pshard1(sy,xpp,xpm,z) | |
1980 | cc----------------------------------------------------------------------- | |
1981 | cc pshard - qq-pomeron eikonal | |
1982 | cc sy - energy squared for the pomeron, | |
1983 | cc xpp - lc+ for the pomeron, | |
1984 | cc xpm - lc- for the pomeron | |
1985 | cc----------------------------------------------------------------------- | |
1986 | c common /ar3/ x1(7),a1(7) | |
1987 | c common /ar9/ x9(3),a9(3) | |
1988 | c include 'epos.inc' | |
1989 | c include 'epos.incsem' | |
1990 | c | |
1991 | c pshard1=0. | |
1992 | c if(iclpro.ne.4.and.icltar.ne.4)then | |
1993 | c spmin=4.*q2min | |
1994 | c else | |
1995 | c spmin=4.*q2min+2.*qcmass**2 | |
1996 | c endif | |
1997 | c if(sy.le.spmin)return | |
1998 | c | |
1999 | c rp=r2had(iclpro)+r2had(icltar)+slopom*log(max(1.,sy)) | |
2000 | c alpq=(alppar+1.)/2. | |
2001 | c xmin=spmin/sy !min hard pomeron mass share | |
2002 | c xminl=xmin**(delh+.5) | |
2003 | c | |
2004 | c do i=1,3 | |
2005 | c do m=1,2 | |
2006 | c zh=(.5*(1.+xminl-(2*m-3)*x9(i)*(1.-xminl)))**(1./(delh+.5)) | |
2007 | c if(iclpro.ne.4.and.icltar.ne.4)then | |
2008 | c call psjti0(zh*sy,sqq,sqqb,1,1) | |
2009 | c call psjti0(zh*sy,sqqp,sqqpb,1,2) | |
2010 | c call psjti0(zh*sy,sqaq,sqaqb,-1,1) | |
2011 | c else | |
2012 | c call psjti0(zh*sy,sqq,sqqb,4,1) | |
2013 | c sqq=0. | |
2014 | c sqaq=0. | |
2015 | c endif | |
2016 | c | |
2017 | c stq=0. | |
2018 | c do i1=1,3 | |
2019 | c do m1=1,2 | |
2020 | c xx=.5+x9(i1)*(m1-1.5) | |
2021 | c xp=zh**xx | |
2022 | c xm=zh/xp | |
2023 | c if(xp*xpp.le..9999.and.xm*xpm.le..9999.or. | |
2024 | c * xm*xpp.le..9999.and.xp*xpm.le..9999)then | |
2025 | c stq=stq+a9(i1)*psharf(xp*xpp,xm*xpm,sqq,sqqp,sqaq) | |
2026 | c * *(1.-xp)**(1.+alplea(iclpro)-alpq) | |
2027 | c * *(1.-xm)**(1.+alplea(icltar)-alpq) | |
2028 | c endif | |
2029 | c enddo | |
2030 | c enddo | |
2031 | c pshard1=pshard1-a9(i)*stq/zh**(delh+0.5)*log(zh) | |
2032 | c enddo | |
2033 | c enddo | |
2034 | c pshard1=pshard1*(1.-xminl)/(delh+.5)/4.*factk | |
2035 | c **chad(iclpro)*chad(icltar)*(xpp*xpm)**(1.-alpq) | |
2036 | c **z**(rp/(r2had(iclpro)+r2had(icltar))) | |
2037 | c */(8.*pi*(r2had(iclpro)+r2had(icltar))) | |
2038 | c return | |
2039 | c end | |
2040 | c | |
2041 | c------------------------------------------------------------------------ | |
2042 | function pshard(sy,xpp,xpm) | |
2043 | c----------------------------------------------------------------------- | |
2044 | c pshard - qq-pomeron eikonal | |
2045 | c sy - energy squared for the pomeron, | |
2046 | c xpp - lc+ for the pomeron, | |
2047 | c xpm - lc- for the pomeron | |
2048 | c----------------------------------------------------------------------- | |
2049 | double precision z01 | |
2050 | common /ar3/ x1(7),a1(7) | |
2051 | include 'epos.inc' | |
2052 | include 'epos.incsem' | |
2053 | ||
2054 | pshard=0. | |
2055 | if(iclpro.ne.4.and.icltar.ne.4)then | |
2056 | spmin=4.*q2min | |
2057 | else | |
2058 | spmin=4.*q2min+2.*qcmass**2 | |
2059 | endif | |
2060 | if(sy.le.spmin)return | |
2061 | ||
2062 | alpq=(alppar+1.)/2. | |
2063 | xmin=spmin/sy !min hard pomeron mass share | |
2064 | xminl=xmin**(delh+.5) | |
2065 | ||
2066 | do i=1,7 | |
2067 | do m=1,2 | |
2068 | zh=(.5*(1.+xminl-(2*m-3)*x1(i)*(1.-xminl)))**(1./(delh+.5)) | |
2069 | if(iclpro.ne.4.and.icltar.ne.4)then | |
2070 | call psjti0(zh*sy,sqq,sqqb,1,1) | |
2071 | call psjti0(zh*sy,sqqp,sqqpb,1,2) | |
2072 | call psjti0(zh*sy,sqaq,sqaqb,-1,1) | |
2073 | else | |
2074 | call psjti0(zh*sy,sqq,sqqb,4,1) | |
2075 | sqqp=0. | |
2076 | sqaq=0. | |
2077 | endif | |
2078 | ||
2079 | stq=0. !int^1_(sqrt(z)) dx_p / x_p / sqrt(1-x_p) =int^(tmax)_(0) dt | |
2080 | tmax=sqrt(1.-sqrt(zh)) !t=ln((1+sqrt(1-x_p))/(1-sqrt(1-x_p))) | |
2081 | tmax=log((1.+tmax)/(1.-tmax)) | |
2082 | if(tmax.gt.1.e-20)then | |
2083 | do i1=1,7 | |
2084 | do m1=1,2 | |
2085 | t=tmax*(.5+x1(i1)*(m1-1.5)) | |
2086 | z01=((1.d0-exp(-1.d0*t))/(1.d0+exp(-1.d0*t)))**2 | |
2087 | xp=1.-z01 | |
2088 | xm=zh/xp | |
2089 | if(xp*xpp.le..9999.and.xm*xpm.le..9999.or. | |
2090 | * xm*xpp.le..9999.and.xp*xpm.le..9999)then | |
2091 | stq=stq+a1(i1)*(psharf(xp*xpp,xm*xpm,sqq,sqqp,sqaq)+ | |
2092 | * psharf(xm*xpp,xp*xpm,sqq,sqqp,sqaq)) | |
2093 | * *z01**(.5-alpq)/(1.-xm)**alpq | |
2094 | endif | |
2095 | enddo | |
2096 | enddo | |
2097 | stq=stq*tmax | |
2098 | endif | |
2099 | pshard=pshard+a1(i)*stq/zh**(delh+0.5) | |
2100 | enddo | |
2101 | enddo | |
2102 | pshard=pshard*(1.-xminl)/(delh+.5)/4.* | |
2103 | *utgam1(2.+alplea(iclpro)-alpq)/utgam1(1.+alplea(iclpro))/ | |
2104 | *utgam1(1.-alpq)* | |
2105 | *utgam1(2.+alplea(icltar)-alpq)/utgam1(1.+alplea(icltar))/ | |
2106 | *utgam1(1.-alpq)* | |
2107 | *chad(iclpro)*chad(icltar)/(8.*pi*(r2had(iclpro)+r2had(icltar)))* | |
2108 | *(xpp*xpm)**(-alpq)/sy**delh | |
2109 | return | |
2110 | end | |
2111 | ||
2112 | c------------------------------------------------------------------------ | |
2113 | function psharf(zh1,zh2,sqq,sqqp,sqaq) | |
2114 | c----------------------------------------------------------------------- | |
2115 | include 'epos.incsem' | |
2116 | include 'epos.inc' | |
2117 | ||
2118 | alpq=(alppar+1.)/2. | |
2119 | if(zh1.le..9999.and.zh2.le..9999)then | |
2120 | uv1=psdfh4(zh1,q2min,0.,iclpro,1) | |
2121 | dv1=psdfh4(zh1,q2min,0.,iclpro,2) | |
2122 | uv2=psdfh4(zh2,q2min,0.,icltar,1) | |
2123 | dv2=psdfh4(zh2,q2min,0.,icltar,2) | |
2124 | if(iclpro.eq.2.and.icltar.eq.2)then !proton | |
2125 | fff=sqq*(uv1*uv2+dv1*dv2)+sqqp*(uv1*dv2+dv1*uv2) | |
2126 | elseif(iclpro.eq.1.or.icltar.eq.1)then !pion | |
2127 | fff=sqq*uv1*uv2+sqaq*dv1*dv2+sqqp*(uv1*dv2+dv1*uv2) | |
2128 | elseif(iclpro.eq.3.or.icltar.eq.3)then !kaon | |
2129 | fff=sqq*uv1*uv2+sqqp*(uv1*dv2+dv1*uv2+dv1*dv2) | |
2130 | elseif(iclpro.eq.4.or.icltar.eq.4)then !J/psi | |
2131 | fff=sqq*uv1*(uv2+dv2) | |
2132 | endif | |
2133 | psharf=fff*(1.-zh1)**(-1.+alpq-alplea(iclpro))* | |
2134 | * (1.-zh2)**(-1.+alpq-alplea(icltar)) | |
2135 | else | |
2136 | psharf=0. | |
2137 | endif | |
2138 | return | |
2139 | end | |
2140 | ||
2141 | c------------------------------------------------------------------------ | |
2142 | function psvin(sy,xpp,xpm,z,iqq) | |
2143 | c----------------------------------------------------------------------- | |
2144 | c psvin - contributions to the interaction eikonal | |
2145 | c sy - energy squared for the hard interaction, | |
2146 | c xpp - lc+ for the sh pomeron, | |
2147 | c xpm - lc- for the sh pomeron, | |
2148 | c z - impact parameter factor, z=exp(-b**2/4*rp), | |
2149 | c iqq = 1 - gg, | |
2150 | c iqq = 2 - qg, | |
2151 | c iqq = 3 - gq, | |
2152 | c iqq = 4 - qq, | |
2153 | c iqq = 5 - gg(int), | |
2154 | c iqq = 6 - gg(proj), | |
2155 | c iqq = 7 - qg(proj), | |
2156 | c iqq = 9 - total uncut-integrated, | |
2157 | c iqq = 10 - total cut, | |
2158 | c iqq = 14 - gg(int)|b=0, | |
2159 | c iqq = 15 - <b^2*gg(int)>, | |
2160 | c iqq = 16 - gg(proj)|b=0, | |
2161 | c iqq = 17 - <b^2*gg(proj)>, | |
2162 | c iqq = 18 - qg(proj)|b=0, | |
2163 | c iqq = 19 - <b^2*qg(proj)> | |
2164 | c----------------------------------------------------------------------- | |
2165 | dimension wk(3),wi(3),wj(3),wz(3),fa(3) | |
2166 | common /psar2/ edmax,epmax | |
2167 | common /psar4/ fhgg(11,10,8),fhqg(11,10,80) | |
2168 | *,fhgq(11,10,80),fhqq(11,10,80),fhgg0(11,10),fhgg1(11,10,4) | |
2169 | *,fhqg1(11,10,40),fhgg01(11),fhgg02(11),fhgg11(11,4) | |
2170 | *,fhgg12(11,4),fhqg11(11,10,4),fhqg12(11,10,4) | |
2171 | *,ftoint(11,14,2,2,3) | |
2172 | common /psar7/ delx,alam3p,gam3p | |
2173 | include 'epos.inc' | |
2174 | include 'epos.incsem' | |
2175 | ||
2176 | if(iqq.eq.3)then | |
2177 | xp=xpm | |
2178 | xm=xpp | |
2179 | iclp=icltar | |
2180 | iclt=iclpro | |
2181 | else | |
2182 | xp=xpp | |
2183 | xm=xpm | |
2184 | iclp=iclpro | |
2185 | iclt=icltar | |
2186 | endif | |
2187 | rp=r2had(iclpro)+r2had(icltar)+slopom*log(max(1.,sy)) | |
2188 | ||
2189 | psvin=0. | |
2190 | if(iqq.eq.1.or.iqq.eq.5.or.iqq.eq.6.or.iqq.eq.14 | |
2191 | *.or.iqq.eq.15.or.iqq.eq.16.or.iqq.eq.17 | |
2192 | *.or.iclpro.ne.4.and.(iqq.eq.2.or.iqq.eq.7 | |
2193 | *.or.iqq.eq.18.or.iqq.eq.19) | |
2194 | *.or.icltar.ne.4.and.iqq.eq.3 | |
2195 | *.or.iclpro.ne.4.and.icltar.ne.4)then | |
2196 | spmin=4.*q2min | |
2197 | else | |
2198 | spmin=4.*q2min+2.*qcmass**2 | |
2199 | endif | |
2200 | if(sy.le.spmin.and.(iqq.le.7.or.iqq.gt.13))return | |
2201 | ||
2202 | if(iqq.le.7.or.iqq.gt.13)then | |
2203 | yl=log(sy/spmin)/log(epmax/2./spmin)*10.+1 | |
2204 | k=int(yl) | |
2205 | if(k.gt.9)k=9 | |
2206 | wk(2)=yl-k | |
2207 | wk(3)=wk(2)*(wk(2)-1.)*.5 | |
2208 | wk(1)=1.-wk(2)+wk(3) | |
2209 | wk(2)=wk(2)-2.*wk(3) | |
2210 | ||
2211 | if(iqq.ne.4)then !---------------- not 4 ------------------ | |
2212 | ||
2213 | if(iqq.eq.5)then | |
2214 | if(k.eq.1)then | |
2215 | psvin=max(0.,exp(fhgg01(k+1))*wk(2) | |
2216 | * +exp(fhgg01(k+2))*wk(3)) | |
2217 | else | |
2218 | psvin=exp(fhgg01(k)*wk(1)+fhgg01(k+1)*wk(2) | |
2219 | * +fhgg01(k+2)*wk(3)) | |
2220 | endif | |
2221 | psvin=psvin*factk*sy**delh | |
2222 | return | |
2223 | ||
2224 | elseif(iqq.eq.15)then | |
2225 | if(k.eq.1)then | |
2226 | psvin=max(0.,exp(fhgg02(k+1))*wk(2) | |
2227 | * +exp(fhgg02(k+2))*wk(3)) | |
2228 | else | |
2229 | psvin=exp(fhgg02(k)*wk(1)+fhgg02(k+1)*wk(2) | |
2230 | * +fhgg02(k+2)*wk(3)) | |
2231 | endif | |
2232 | psvin=psvin*factk*sy**delh | |
2233 | return | |
2234 | ||
2235 | elseif(iqq.eq.6)then | |
2236 | if(k.eq.1)then | |
2237 | psvin=max(0.,exp(fhgg11(k+1,iclpro))*wk(2) | |
2238 | * +exp(fhgg11(k+2,iclpro))*wk(3)) | |
2239 | else | |
2240 | psvin=exp(fhgg11(k,iclpro)*wk(1)+fhgg11(k+1,iclpro)*wk(2) | |
2241 | * +fhgg11(k+2,iclpro)*wk(3)) | |
2242 | endif | |
2243 | psvin=psvin*factk*sy**delh*xp**(-alppar) | |
2244 | return | |
2245 | ||
2246 | elseif(iqq.eq.17)then | |
2247 | if(k.eq.1)then | |
2248 | psvin=max(0.,exp(fhgg12(k+1,iclpro))*wk(2) | |
2249 | * +exp(fhgg12(k+2,iclpro))*wk(3)) | |
2250 | else | |
2251 | psvin=exp(fhgg12(k,iclpro)*wk(1)+fhgg12(k+1,iclpro)*wk(2) | |
2252 | * +fhgg12(k+2,iclpro)*wk(3)) | |
2253 | endif | |
2254 | psvin=psvin*factk*sy**delh*xp**(-alppar) | |
2255 | return | |
2256 | ||
2257 | elseif(iqq.eq.7.or.iqq.eq.19)then | |
2258 | if(xp.lt..2)then | |
2259 | xl=log(10.*xp)/log(2.)+5. | |
2260 | else | |
2261 | xl=5.*xp+5. | |
2262 | endif | |
2263 | i=int(xl) | |
2264 | if(i.lt.1)i=1 | |
2265 | if(i.eq.5)i=4 | |
2266 | if(i.gt.8)i=8 | |
2267 | wi(2)=xl-i | |
2268 | wi(3)=wi(2)*(wi(2)-1.)*.5 | |
2269 | wi(1)=1.-wi(2)+wi(3) | |
2270 | wi(2)=wi(2)-2.*wi(3) | |
2271 | do k1=1,3 | |
2272 | fa(k1)=0. | |
2273 | do i1=1,3 | |
2274 | k2=k+k1-1 | |
2275 | if(iqq.eq.7)then | |
2276 | fhhh=fhqg11(k2,i+i1-1,iclpro) | |
2277 | elseif(iqq.eq.19)then | |
2278 | fhhh=fhqg12(k2,i+i1-1,iclpro) | |
2279 | endif | |
2280 | fa(k1)=fa(k1)+fhhh*wi(i1) | |
2281 | enddo | |
2282 | enddo | |
2283 | if(k.eq.1)then | |
2284 | psvin=max(0.,exp(fa(2))*wk(2)+exp(fa(3))*wk(3)) | |
2285 | else | |
2286 | psvin=exp(fa(1)*wk(1)+fa(2)*wk(2)+fa(3)*wk(3)) | |
2287 | endif | |
2288 | psvin=psvin*factk*sy**delh | |
2289 | return | |
2290 | endif | |
2291 | ||
2292 | jz=int(10.*z) | |
2293 | if(jz.gt.8)jz=8 | |
2294 | if(jz.lt.1)jz=1 | |
2295 | wz(2)=10.*z-jz | |
2296 | wz(3)=wz(2)*(wz(2)-1.)*.5 | |
2297 | wz(1)=1.-wz(2)+wz(3) | |
2298 | wz(2)=wz(2)-2.*wz(3) | |
2299 | ||
2300 | if(iqq.eq.14)then | |
2301 | do k1=1,3 | |
2302 | k2=k+k1-1 | |
2303 | fa(k1)=fhgg0(k2,jz)*wz(1)+fhgg0(k2,jz+1) | |
2304 | * *wz(2)+fhgg0(k2,jz+2)*wz(3) | |
2305 | enddo | |
2306 | if(k.eq.1)then | |
2307 | psvin=max(0.,exp(fa(2))*wk(2)+exp(fa(3))*wk(3)) | |
2308 | else | |
2309 | psvin=exp(fa(1)*wk(1)+fa(2)*wk(2)+fa(3)*wk(3)) | |
2310 | endif | |
2311 | psvin=psvin*z*factk*sy**delh | |
2312 | ||
2313 | elseif(iqq.eq.16)then | |
2314 | do k1=1,3 | |
2315 | k2=k+k1-1 | |
2316 | fa(k1)=fhgg1(k2,jz,iclpro)*wz(1)+fhgg1(k2,jz+1,iclpro) | |
2317 | * *wz(2)+fhgg1(k2,jz+2,iclpro)*wz(3) | |
2318 | enddo | |
2319 | if(k.eq.1)then | |
2320 | psvin=max(0.,exp(fa(2))*wk(2)+exp(fa(3))*wk(3)) | |
2321 | else | |
2322 | psvin=exp(fa(1)*wk(1)+fa(2)*wk(2)+fa(3)*wk(3)) | |
2323 | endif | |
2324 | psvin=psvin*z*factk*sy**delh*xp**(-alppar) | |
2325 | ||
2326 | elseif(iqq.eq.18)then | |
2327 | if(xp.lt..2)then | |
2328 | xl=log(10.*xp)/log(2.)+5. | |
2329 | else | |
2330 | xl=5.*xp+5. | |
2331 | endif | |
2332 | i=int(xl) | |
2333 | if(i.lt.1)i=1 | |
2334 | if(i.eq.5)i=4 | |
2335 | if(i.gt.8)i=8 | |
2336 | wi(2)=xl-i | |
2337 | wi(3)=wi(2)*(wi(2)-1.)*.5 | |
2338 | wi(1)=1.-wi(2)+wi(3) | |
2339 | wi(2)=wi(2)-2.*wi(3) | |
2340 | do k1=1,3 | |
2341 | fa(k1)=0. | |
2342 | do i1=1,3 | |
2343 | do l1=1,3 | |
2344 | k2=k+k1-1 | |
2345 | l2=jz+l1-1+10*(iclpro-1) | |
2346 | fhhh=fhqg1(k2,i+i1-1,l2) | |
2347 | fa(k1)=fa(k1)+fhhh*wi(i1)*wz(l1) | |
2348 | enddo | |
2349 | enddo | |
2350 | enddo | |
2351 | if(k.eq.1)then | |
2352 | psvin=max(0.,exp(fa(2))*wk(2)+exp(fa(3))*wk(3)) | |
2353 | else | |
2354 | psvin=exp(fa(1)*wk(1)+fa(2)*wk(2)+fa(3)*wk(3)) | |
2355 | endif | |
2356 | psvin=psvin*z*factk*sy**delh | |
2357 | ||
2358 | elseif(iqq.eq.1)then !1111111111111111111111111111111111 | |
2359 | ||
2360 | do k1=1,3 | |
2361 | k2=k+k1-1 | |
2362 | iclpt=iclpro+4*(icltar-1) | |
2363 | fa(k1)=fhgg(k2,jz,iclpt)*wz(1)+fhgg(k2,jz+1,iclpt) | |
2364 | * *wz(2)+fhgg(k2,jz+2,iclpt)*wz(3) | |
2365 | enddo | |
2366 | if(k.eq.1)then | |
2367 | psvin=max(0.,exp(fa(2))*wk(2)+exp(fa(3))*wk(3)) | |
2368 | else | |
2369 | psvin=exp(fa(1)*wk(1)+fa(2)*wk(2)+fa(3)*wk(3)) | |
2370 | endif | |
2371 | psvin=psvin*z*factk*sy**delh*(xp*xm)**(-alppar) | |
2372 | ||
2373 | else ! 2222222222222222222222 3333333333333333333333 .... | |
2374 | ||
2375 | if(xp.lt..2)then | |
2376 | xl=log(10.*xp)/log(2.)+5. | |
2377 | else | |
2378 | xl=5.*xp+5. | |
2379 | endif | |
2380 | i=int(xl) | |
2381 | if(i.lt.1)i=1 | |
2382 | if(i.eq.5)i=4 | |
2383 | if(i.gt.8)i=8 | |
2384 | wi(2)=xl-i | |
2385 | wi(3)=wi(2)*(wi(2)-1.)*.5 | |
2386 | wi(1)=1.-wi(2)+wi(3) | |
2387 | wi(2)=wi(2)-2.*wi(3) | |
2388 | do k1=1,3 | |
2389 | fa(k1)=0. | |
2390 | do i1=1,3 | |
2391 | do l1=1,3 | |
2392 | k2=k+k1-1 | |
2393 | if(iqq.eq.2)then | |
2394 | l2=jz+l1-1+10*(iclpro+4*(icltar-1)-1) | |
2395 | fhhh=fhqg(k2,i+i1-1,l2) | |
2396 | elseif(iqq.eq.3)then | |
2397 | l2=jz+l1-1+10*(iclpro+4*(icltar-1)-1) | |
2398 | fhhh=fhgq(k2,i+i1-1,l2) | |
2399 | endif | |
2400 | fa(k1)=fa(k1)+fhhh*wi(i1)*wz(l1) | |
2401 | enddo | |
2402 | enddo | |
2403 | enddo | |
2404 | if(k.eq.1)then | |
2405 | psvin=max(0.,exp(fa(2))*wk(2)+exp(fa(3))*wk(3)) | |
2406 | else | |
2407 | psvin=exp(fa(1)*wk(1)+fa(2)*wk(2)+fa(3)*wk(3)) | |
2408 | endif | |
2409 | psvin=psvin*xm**(-alppar)*z*factk*sy**delh | |
2410 | endif | |
2411 | ||
2412 | else ! ------------- 4444444444444444444 ----------------------- | |
2413 | ||
2414 | if(xp.lt..2)then | |
2415 | xl1=log(10.*xp)/log(2.)+5. | |
2416 | else | |
2417 | xl1=5.*xp+5. | |
2418 | endif | |
2419 | i=max(1,int(xl1)) | |
2420 | if(i.eq.5)i=4 | |
2421 | i=min(8,i) | |
2422 | wi(2)=xl1-i | |
2423 | wi(3)=wi(2)*(wi(2)-1.)*.5 | |
2424 | wi(1)=1.-wi(2)+wi(3) | |
2425 | wi(2)=wi(2)-2.*wi(3) | |
2426 | ||
2427 | if(xm.lt..2)then | |
2428 | xl2=log(10.*xm)/log(2.)+5. | |
2429 | else | |
2430 | xl2=5.*xm+5. | |
2431 | endif | |
2432 | j=max(1,int(xl2)) | |
2433 | if(j.eq.5)j=4 | |
2434 | j=min(8,j) | |
2435 | wj(2)=xl2-j | |
2436 | wj(3)=wj(2)*(wj(2)-1.)*.5 | |
2437 | wj(1)=1.-wj(2)+wj(3) | |
2438 | wj(2)=wj(2)-2.*wj(3) | |
2439 | ||
2440 | do k1=1,3 | |
2441 | fa(k1)=0. | |
2442 | do i1=1,3 | |
2443 | do j1=1,3 | |
2444 | k2=k+k1-1 | |
2445 | j2=j+j1-1+10*(iclp+4*(iclt-1)-1) | |
2446 | fa(k1)=fa(k1)+fhqq(k2,i+i1-1,j2)*wi(i1)*wj(j1) | |
2447 | enddo | |
2448 | enddo | |
2449 | enddo | |
2450 | if(k.eq.1)then | |
2451 | psvin=max(0.,exp(fa(2))*wk(2)+exp(fa(3))*wk(3)) | |
2452 | else | |
2453 | psvin=exp(fa(1)*wk(1)+fa(2)*wk(2)+fa(3)*wk(3)) | |
2454 | endif | |
2455 | psvin=psvin*z**(rp/(r2had(iclpro)+r2had(icltar)))* | |
2456 | * factk*sy**delh | |
2457 | ||
2458 | endif !-------------------------------------------- | |
2459 | ||
2460 | return | |
2461 | endif | |
2462 | ||
2463 | yl=log(sy)/log(1.e8)*10.+1 | |
2464 | k=max(1,int(yl)) | |
2465 | k=min(k,9) !?????????????9 | |
2466 | wk(2)=yl-k | |
2467 | wk(3)=wk(2)*(wk(2)-1.)*.5 | |
2468 | wk(1)=1.-wk(2)+wk(3) | |
2469 | wk(2)=wk(2)-2.*wk(3) | |
2470 | ||
2471 | if(z.gt..1)then | |
2472 | zz=10.*z+4 | |
2473 | else | |
2474 | zz=50.*z | |
2475 | endif | |
2476 | jz=min(12,int(zz)) | |
2477 | if(jz.eq.0)jz=1 | |
2478 | if(jz.eq.4)jz=3 | |
2479 | wz(2)=zz-jz | |
2480 | wz(3)=wz(2)*(wz(2)-1.)*.5 | |
2481 | wz(1)=1.-wz(2)+wz(3) | |
2482 | wz(2)=wz(2)-2.*wz(3) | |
2483 | ||
2484 | if(iqq.eq.9)then | |
2485 | do k1=1,3 | |
2486 | do l1=1,3 | |
2487 | k2=k+k1-1 | |
2488 | l2=jz+l1-1 | |
2489 | psvin=psvin+ftoint(k2,l2,icdp,icdt,iclp)*wk(k1)*wz(l1) | |
2490 | enddo | |
2491 | enddo | |
2492 | psvin=exp(psvin)*z | |
2493 | ||
2494 | endif | |
2495 | return | |
2496 | end | |
2497 | ||
2498 | c------------------------------------------------------------------------ | |
2499 | function psbint(q1,q2,qqcut,ss,m1,l1,jdis) | |
2500 | c----------------------------------------------------------------------- | |
2501 | c psbint - born cross-section interpolation | |
2502 | c q1 - virtuality cutoff at current end of the ladder; | |
2503 | c q2 - virtuality cutoff at opposite end of the ladder; | |
2504 | c qqcut - p_t cutoff for the born process; | |
2505 | c s - total c.m. energy squared for the scattering, | |
2506 | c m1 - parton type at current end of the ladder (0 - g, 1,-1,2,... - q) | |
2507 | c l1 - parton type at opposite end of the ladder (0 - g, 1,-1,2,... - q) | |
2508 | c----------------------------------------------------------------------- | |
2509 | dimension wi(3),wk(3) | |
2510 | common /psar2/ edmax,epmax | |
2511 | common /psar21/ csbor(20,160,2) | |
2512 | include 'epos.incsem' | |
2513 | double precision psuds | |
2514 | ||
2515 | psbint=0. | |
2516 | if(jdis.eq.0)then | |
2517 | qq=max(q1,q2) | |
2518 | else | |
2519 | qq=max(q1/4.,q2) | |
2520 | endif | |
2521 | qq=max(qq,qqcut) | |
2522 | if(iabs(m1).ne.4)then | |
2523 | q2mass=0. | |
2524 | if(m1.ne.0.and.m1.eq.l1)then | |
2525 | m=2 | |
2526 | l=2 | |
2527 | elseif(m1.ne.0.and.m1.eq.-l1)then | |
2528 | m=3 | |
2529 | l=1 | |
2530 | elseif(m1.ne.0.and.l1.ne.0.and.m1.ne.l1)then | |
2531 | m=3 | |
2532 | l=2 | |
2533 | else | |
2534 | m=min(1,iabs(m1))+1 | |
2535 | l=min(1,iabs(l1))+1 | |
2536 | endif | |
2537 | else | |
2538 | q2mass=qcmass**2 | |
2539 | m=4 | |
2540 | l=min(1,iabs(l1))+1 | |
2541 | endif | |
2542 | s=ss-q2mass | |
2543 | spmin=4.*q2min+q2mass | |
2544 | s2min=4.*qq+q2mass | |
2545 | if(s.le.s2min)return | |
2546 | ||
2547 | p1=s/(1.+q2mass/s) | |
2548 | if(p1.gt.4.*qq)then | |
2549 | tmin=2.*qq/(1.+sqrt(1.-4.*qq/p1)) | |
2550 | else | |
2551 | tmin=2.*qq | |
2552 | endif | |
2553 | qmax=p1/4. | |
2554 | tmax=p1/2. | |
2555 | ||
2556 | ml=20*(m-1)+80*(l-1) | |
2557 | qli=log(qq/q2min)/log(qmax/q2min)*19.+1. | |
2558 | sl=log(s/spmin)/log(epmax/2./spmin)*19.+1. | |
2559 | k=int(sl) | |
2560 | i=int(qli) | |
2561 | if(k.lt.1)k=1 | |
2562 | if(i.lt.1)i=1 | |
2563 | if(k.gt.18)k=18 | |
2564 | if(i.gt.18)i=18 | |
2565 | ||
2566 | wi(2)=qli-i | |
2567 | wi(3)=wi(2)*(wi(2)-1.)*.5 | |
2568 | wi(1)=1.-wi(2)+wi(3) | |
2569 | wi(2)=wi(2)-2.*wi(3) | |
2570 | ||
2571 | wk(2)=sl-k | |
2572 | wk(3)=wk(2)*(wk(2)-1.)*.5 | |
2573 | wk(1)=1.-wk(2)+wk(3) | |
2574 | wk(2)=wk(2)-2.*wk(3) | |
2575 | ||
2576 | do i1=1,3 | |
2577 | do k1=1,3 | |
2578 | psbint=psbint+csbor(i+i1-1,k+k1+ml-1,jdis+1) | |
2579 | * *wi(i1)*wk(k1) | |
2580 | enddo | |
2581 | enddo | |
2582 | psbint=exp(psbint)*(1./tmin-1./tmax) | |
2583 | if(jdis.eq.0.and.qq.gt.q1)then | |
2584 | psbint=psbint*sngl(psuds(qq,m1)/psuds(q1,m1)) | |
2585 | elseif(jdis.eq.1.and.4.*qq.gt.q1)then | |
2586 | psbint=psbint*sngl(psuds(4.*qq,m1)/psuds(q1,m1)) | |
2587 | endif | |
2588 | if(qq.gt.q2)psbint=psbint*sngl(psuds(qq,l1)/psuds(q2,l1)) | |
2589 | return | |
2590 | end | |
2591 | ||
2592 | c----------------------------------------------------------------------- | |
2593 | function psborn(q1,q2,qqcut,s,j,l,jdis,md) | |
2594 | c----------------------------------------------------------------------- | |
2595 | c | |
2596 | c hard 2->2 parton scattering born cross-section | |
2597 | c including sudakov on both sides | |
2598 | c | |
2599 | c q1 - virtuality cutoff at current end of the ladder; | |
2600 | c q2 - virtuality cutoff at opposite end of the ladder; | |
2601 | c qqcut - p_t cutoff for the born process; | |
2602 | c s - c.m. energy squared for the scattering; | |
2603 | c j - parton type at current end of the ladder (0 - g, 1,2 etc. - q); | |
2604 | c l - parton type at opposite end of the ladder (0 - g, 1,2 etc. - q). | |
2605 | c----------------------------------------------------------------------- | |
2606 | common /ar3/ x1(7),a1(7) | |
2607 | double precision sud0,psbornd,psuds | |
2608 | include 'epos.inc' | |
2609 | include 'epos.incsem' | |
2610 | ||
2611 | psborn=0 | |
2612 | ||
2613 | if(jdis.eq.0)then | |
2614 | qq=max(q1,q2) | |
2615 | else | |
2616 | qq=max(q1/4.,q2) | |
2617 | endif | |
2618 | qq=max(qq,qqcut) | |
2619 | c if(j.ne.3)then !kkkkkkkkkk charm is 3 ??? | |
2620 | if(j.ne.4)then | |
2621 | j1=j | |
2622 | q2mass=0. | |
2623 | else | |
2624 | j1=4 | |
2625 | q2mass=qcmass**2 | |
2626 | endif | |
2627 | p1=s/(1.+q2mass/s) | |
2628 | if(p1.gt.4.*qq)then | |
2629 | tmin=2.*qq/(1.+sqrt(1.-4.*qq/p1)) | |
2630 | else | |
2631 | tmin=2.*qq | |
2632 | ! return !tmin=2.*qq !kkkkkkk !????????????? tp why not ? | |
2633 | endif | |
2634 | tmax=p1/2. | |
2635 | sud0=psuds(q1,j1)*psuds(q2,l) | |
2636 | ||
2637 | psbornd=0.d0 | |
2638 | do i=1,7 | |
2639 | do m=1,2 | |
2640 | t=2.*tmin/(1.+tmin/tmax-x1(i)*(2*m-3) | |
2641 | & *(1.-tmin/tmax)) | |
2642 | qt=t*(1.-t/p1) | |
2643 | if(qt.lt..999*qq.and.ish.ge.1)write(ifch,*)'psborn:qt,qq,q1,q2' | |
2644 | & ,qq,qt,q1,q2 | |
2645 | ||
2646 | if(jdis.eq.0)then | |
2647 | scale=qt | |
2648 | else | |
2649 | scale=qt*4. | |
2650 | endif | |
2651 | if(j1.eq.0.and.l.eq.0)then | |
2652 | fb=ffborn(s,t, 1. , 0. , 0. , 0. , 0. ) !gg | |
2653 | elseif(j1*l.eq.0)then | |
2654 | fb=ffborn(s,t, 0. , 1. , 0. , 0. , 0.) !qg | |
2655 | elseif(j1.eq.l)then | |
2656 | fb=ffborn(s,t, 0. , 0. , 1. , 0. , 0.) !qq | |
2657 | elseif(j1.eq.-l)then | |
2658 | fb=ffborn(s,t, 0. , 0. , 0. , 1. , 0.) !qq | |
2659 | else | |
2660 | fb=ffborn(s,t, 0. , 0. , 0. , 0. , 1.) !qq | |
2661 | endif | |
2662 | fb=fb*pssalf(qt/qcdlam)**2 | |
2663 | psbornd=psbornd+dble(a1(i)*fb)*dble(t)**2 | |
2664 | & *psuds(scale,j1)*psuds(qt,l) | |
2665 | enddo | |
2666 | enddo | |
2667 | psbornd=psbornd*dble(2.*pi**3)/dble(s)**2/sud0*2 | |
2668 | * /2 !CS for parton pair | |
2669 | if(md.eq.1)psbornd=psbornd*(1./tmin-1./tmax) | |
2670 | psborn=sngl(psbornd) | |
2671 | return | |
2672 | end | |
2673 | ||
2674 | c------------------------------------------------------------------------ | |
2675 | function psdgh(s,qq,long) | |
2676 | c----------------------------------------------------------------------- | |
2677 | c psdgh | |
2678 | c s - energy squared for the interaction (hadron-hadron), | |
2679 | c----------------------------------------------------------------------- | |
2680 | common/ar3/ x1(7),a1(7) | |
2681 | common /cnsta/ pi,pii,hquer,prom,piom,ainfin | |
2682 | include 'epos.incsem' | |
2683 | double precision psuds | |
2684 | ||
2685 | xd=qq/s | |
2686 | if(long.eq.0)then | |
2687 | psdgh=(psdfh4(xd,q2min,0.,2,1)/2.25+psdfh4(xd,q2min,0.,2,2)/9. | |
2688 | * +psdfh4(xd,q2min,0.,2,3)/9.+ | |
2689 | * 2.*(psdfh4(xd,q2min,0.,2,-1)+psdfh4(xd,q2min,0.,2,-2)+ | |
2690 | * psdfh4(xd,q2min,0.,2,-3))/4.5) | |
2691 | * *sngl(psuds(qq,1)/psuds(q2min,1))*4.*pi**2*alfe/qq | |
2692 | else | |
2693 | psdgh=0. | |
2694 | endif | |
2695 | ||
2696 | dgh=0. | |
2697 | if(long.eq.0)then | |
2698 | s2min=qq/(1.-q2ini/qq) | |
2699 | else | |
2700 | s2min=4.*max(q2min,qcmass**2)+qq | |
2701 | s2min=s2min/(1.-4.*q2ini/(s2min-qq)) | |
2702 | endif | |
2703 | xmin=s2min/s | |
2704 | ||
2705 | if(xmin.lt.1.)then | |
2706 | do i=1,7 !numerical integration over z1 | |
2707 | do m=1,2 | |
2708 | if(long.eq.0)then | |
2709 | z1=qq/s+(xmin-qq/s)*((1.-qq/s)/(xmin-qq/s)) | |
2710 | * **(.5+(m-1.5)*x1(i)) | |
2711 | else | |
2712 | z1=.5*(1.+xmin+(2*m-3)*x1(i)*(1.-xmin)) | |
2713 | endif | |
2714 | call psdint(z1*s,qq,sds,sdn,sdb,sdt,sdr,1,long) | |
2715 | call psdint(z1*s,qq,sdsg,sdng,sdbg,sdtg,sdrg,0,long) | |
2716 | tu=psdfh4(z1,q2min,0.,2,1) | |
2717 | td=psdfh4(z1,q2min,0.,2,2) | |
2718 | ts=psdfh4(z1,q2min,0.,2,3) | |
2719 | tg=psdfh4(z1,q2min,0.,2,0) | |
2720 | tsea=2.*(psdfh4(z1,q2min,0.,2,-1)+psdfh4(z1,q2min,0.,2,-2) | |
2721 | * +psdfh4(z1,q2min,0.,2,-3)) | |
2722 | gy=sdn*(tu/2.25+td/9.+ts/9.+tsea/4.5)+sdtg*tg/4.5 | |
2723 | * +sdt*(tu+td+ts+tsea)/4.5 | |
2724 | dgh=dgh+a1(i)*gy*(1.-qq/s/z1) | |
2725 | enddo | |
2726 | enddo | |
2727 | dgh=dgh*log((1.-qq/s)/(xmin-qq/s))*.5 | |
2728 | endif | |
2729 | psdgh=psdgh+dgh | |
2730 | return | |
2731 | end | |
2732 | ||
2733 | c------------------------------------------------------------------------ | |
2734 | function psdh(s,qq,iclpro0,long) | |
2735 | c----------------------------------------------------------------------- | |
2736 | c pshard - hard quark-quark interaction cross-section | |
2737 | c s - energy squared for the interaction (hadron-hadron), | |
2738 | c iclpro0 - type of the primary hadron (nucleon) | |
2739 | c----------------------------------------------------------------------- | |
2740 | common /ar3/ x1(7),a1(7) | |
2741 | include 'epos.incsem' | |
2742 | include 'epos.inc' | |
2743 | double precision psuds | |
2744 | ||
2745 | xd=qq/s | |
2746 | qqs=q2min | |
2747 | if(long.eq.0.and.(idisco.eq.0.or.idisco.eq.1))then | |
2748 | psdh=(psdfh4(xd,qqs,0.,iclpro0,1)/2.25+ | |
2749 | * psdfh4(xd,qqs,0.,iclpro0,2)/9.) | |
2750 | * *sngl(psuds(qq,1)/psuds(qqs,1)) | |
2751 | * *4.*pi**2*alfe/qq | |
2752 | else | |
2753 | psdh=0. | |
2754 | endif | |
2755 | ||
2756 | dh=0. | |
2757 | if(long.eq.0)then | |
2758 | s2min=qq/(1.-q2ini/qq) | |
2759 | else | |
2760 | s2min=4.*max(q2min,qcmass**2)+qq | |
2761 | s2min=s2min/(1.-4.*q2ini/(s2min-qq)) | |
2762 | endif | |
2763 | xmin=s2min/s | |
2764 | if(xmin.lt.1.)then | |
2765 | do i=1,7 !numerical integration over z1 | |
2766 | do m=1,2 | |
2767 | if(long.eq.0)then | |
2768 | z1=qq/s+(xmin-qq/s)*((1.-qq/s)/(xmin-qq/s)) | |
2769 | * **(.5+(m-1.5)*x1(i)) | |
2770 | else | |
2771 | z1=.5*(1.+xmin+(2*m-3)*x1(i)*(1.-xmin)) | |
2772 | endif | |
2773 | call psdint(z1*s,qq,sds,sdn,sdb,sdt,sdr,1,long) | |
2774 | tu=psdfh4(z1,qqs,0.,iclpro0,1) | |
2775 | td=psdfh4(z1,qqs,0.,iclpro0,2) | |
2776 | gy=sdt*(tu+td)/4.5+sdn*(tu/2.25+td/9.) | |
2777 | if(long.eq.0)then | |
2778 | gy=gy*(1.-qq/s/z1) | |
2779 | else | |
2780 | gy=gy/z1 | |
2781 | endif | |
2782 | dh=dh+a1(i)*gy | |
2783 | enddo | |
2784 | enddo | |
2785 | if(long.eq.0)then | |
2786 | dh=dh*log((1.-qq/s)/(xmin-qq/s))*.5 | |
2787 | else | |
2788 | dh=dh*(1.-xmin)*.5 | |
2789 | endif | |
2790 | endif | |
2791 | psdh=psdh+dh | |
2792 | return | |
2793 | end | |
2794 | ||
2795 | c------------------------------------------------------------------------ | |
2796 | function psdsh(s,qq,iclpro0,dqsh,long) | |
2797 | c----------------------------------------------------------------------- | |
2798 | c psdsh - semihard interaction eikonal | |
2799 | c s - energy squared for the interaction (hadron-hadron), | |
2800 | c iclpro0 - hadron class, | |
2801 | c z - impact parameter factor, z=exp(-b**2/rp), | |
2802 | c iqq - type of the hard interaction (0 - gg, 1 - qg, 2 - gq) | |
2803 | c----------------------------------------------------------------------- | |
2804 | common /ar3/ x1(7),a1(7) | |
2805 | include 'epos.inc' | |
2806 | include 'epos.incsem' | |
2807 | double precision psuds | |
2808 | ||
2809 | xd=qq/s | |
2810 | if(long.eq.0.and.(idisco.eq.0.or.idisco.eq.1))then | |
2811 | dqsh=fzeroSeaZZ(xd,iclpro0)/xd**dels | |
2812 | * *rr*4.*pi*gamhad(iclpro0)/ | |
2813 | * 4.5*sngl(psuds(qq,1)/psuds(q2min,1)) | |
2814 | * *4.*pi**2*alfe/qq | |
2815 | else | |
2816 | dqsh=0. | |
2817 | endif | |
2818 | ||
2819 | if(long.eq.0)then | |
2820 | s2min=qq/(1.-q2ini/qq) | |
2821 | else | |
2822 | s2min=qq+4.*max(q2min,qcmass**2) | |
2823 | endif | |
2824 | xmin=s2min/s | |
2825 | xmin=xmin**(delh-dels) | |
2826 | dsh=0. | |
2827 | if(xmin.lt.1.)then | |
2828 | c numerical integration over z1 | |
2829 | do i=1,7 | |
2830 | do m=1,2 | |
2831 | z1=(.5*(1.+xmin-(2*m-3)*x1(i)*(1.-xmin)))**(1./ | |
2832 | * (delh-dels)) | |
2833 | call psdint(z1*s,qq,sdsg,sdng,sdbg,sdtg,sdrg,0,long) | |
2834 | call psdint(z1*s,qq,sdsq,sdnq,sdbq,sdtq,sdrq,1,long) | |
2835 | dsh=dsh+a1(i)/z1**delh*(sdtg*fzeroGluZZ(z1,iclpro0) | |
2836 | * +(sdtq+sdnq)*fzeroSeaZZ(z1,iclpro0)) | |
2837 | enddo | |
2838 | enddo | |
2839 | dsh=dsh*(1.-xmin)/(delh-dels)/2. | |
2840 | endif | |
2841 | psdsh=dqsh+dsh*rr*4.*pi*gamhad(iclpro0)/4.5 !*ccorr(1,1,iclpro0) | |
2842 | return | |
2843 | end | |
2844 | ||
2845 | c------------------------------------------------------------------------ | |
2846 | function psdsh1(s,qq,iclpro0,dqsh,long) | |
2847 | c----------------------------------------------------------------------- | |
2848 | c psdsh - semihard interaction eikonal | |
2849 | c s - energy squared for the interaction (hadron-hadron), | |
2850 | c iclpro0 - hadron class, | |
2851 | c z - impact parameter factor, z=exp(-b**2/rp), | |
2852 | c iqq - type of the hard interaction (0 - gg, 1 - qg, 2 - gq) | |
2853 | c----------------------------------------------------------------------- | |
2854 | common /ar3/ x1(7),a1(7) | |
2855 | include 'epos.inc' | |
2856 | include 'epos.incsem' | |
2857 | c double precision psuds | |
2858 | ||
2859 | psdsh1=0. !only for plotting in psaevp : not use any more | |
2860 | ||
2861 | c$$$ xd=qq/s | |
2862 | c$$$ write(ifch,*)'Psdsh1 for xd,qq',xd,qq | |
2863 | c$$$ if(long.eq.0.and.(idisco.eq.0.or.idisco.eq.1))then | |
2864 | c$$$ dqsh=psftist(xd)/4.5*sngl(psuds(qq,1)/psuds(q2min,1)) | |
2865 | c$$$ * *4.*pi**2*alfe/qq | |
2866 | c$$$ else | |
2867 | c$$$ dqsh=0. | |
2868 | c$$$ endif | |
2869 | c$$$ | |
2870 | c$$$ if(long.eq.0)then | |
2871 | c$$$ s2min=qq/(1.-q2ini/qq) | |
2872 | c$$$ else | |
2873 | c$$$ s2min=qq+4.*max(q2min,qcmass**2) | |
2874 | c$$$ endif | |
2875 | c$$$ xmin=s2min/s | |
2876 | c$$$ xmin=xmin**(delh-dels) | |
2877 | c$$$ dsh=0. | |
2878 | c$$$ if(xmin.lt.1.)then | |
2879 | c$$$c numerical integration over z1 | |
2880 | c$$$ do i=1,7 | |
2881 | c$$$ do m=1,2 | |
2882 | c$$$ z1=(.5*(1.+xmin-(2*m-3)*x1(i)*(1.-xmin)))**(1./ | |
2883 | c$$$ * (delh-dels)) | |
2884 | c$$$ call psdint(z1*s,qq,sdsg,sdng,sdbg,sdtg,sdrg,0,long) | |
2885 | c$$$ call psdint(z1*s,qq,sdsq,sdnq,sdbq,sdtq,sdrq,1,long) | |
2886 | c$$$ dsh=dsh+a1(i)/z1**delh*(sdtg*psftigt(z1) | |
2887 | c$$$ * +(sdtq+sdnq)*psftist(z1))*z1**dels | |
2888 | c$$$ enddo | |
2889 | c$$$ enddo | |
2890 | c$$$ dsh=dsh*(1.-xmin)/(delh-dels)/2. | |
2891 | c$$$ endif | |
2892 | c$$$ psdsh1=dqsh+dsh/4.5 | |
2893 | return | |
2894 | end | |
2895 | ||
2896 | ||
2897 | c------------------------------------------------------------------------ | |
2898 | function psev0(q1,qq,xx,j) | |
2899 | c----------------------------------------------------------------------- | |
2900 | double precision xx,psuds,psev00 | |
2901 | common /ar3/ x1(7),a1(7) | |
2902 | include 'epos.incsem' | |
2903 | ||
2904 | psev0=0. | |
2905 | psev00=0.d0 | |
2906 | do i=1,7 | |
2907 | do m=1,2 | |
2908 | if(j.eq.1)then !g->q | |
2909 | qi=2.*q1/(1.+q1/qq+(1.-q1/qq)*(2.*m-3.)*x1(i)) | |
2910 | psev00=psev00+a1(i)*qi*psuds(qi,0)/psuds(qi,1) | |
2911 | * /log(qi*(1.d0-xx)/qcdlam) | |
2912 | else !q->g | |
2913 | qi=(.5*(q1+qq+(q1-qq)*(2.*m-3.)*x1(i))) | |
2914 | psev00=psev00+a1(i)/qi/psuds(qi,0)*psuds(qi,1) | |
2915 | * /log(qi*(1.d0-xx)/qcdlam) | |
2916 | endif | |
2917 | enddo | |
2918 | enddo | |
2919 | ||
2920 | if(j.eq.1)then | |
2921 | psev00=psev00*(1.d0/q1-1.d0/qq)*psuds(qq,1)/psuds(qq,0)/2.d0 | |
2922 | else | |
2923 | psev00=psev00*(qq-q1)*psuds(qq,0)/psuds(qq,1)/2.d0 | |
2924 | endif | |
2925 | psev00=psev00/log(log(qq*(1.d0-xx)/qcdlam) | |
2926 | & /log(q1*(1.d0-xx)/qcdlam)) | |
2927 | psev0=sngl(psev00) | |
2928 | return | |
2929 | end | |
2930 | ||
2931 | c------------------------------------------------------------------------ | |
2932 | function psev(q1,qq,xx,j,l,n) | |
2933 | c------------------------------------------------------------------------ | |
2934 | double precision xx,zmax,zmax1,zmin,zmin1,z,psuds,fk,fq | |
2935 | &,fz1,fz2 | |
2936 | common /ar3/ x1(7),a1(7) | |
2937 | include 'epos.incsem' | |
2938 | ||
2939 | zmax=1.d0-q2ini/qq | |
2940 | zmin=xx/zmax | |
2941 | qmax=qq | |
2942 | fz1=0.d0 | |
2943 | fz2=0.d0 | |
2944 | ||
2945 | if(zmin.lt.zmax)then | |
2946 | if(zmin.lt..1d0)then | |
2947 | zmax1=min(.1d0,zmax) | |
2948 | do i=1,7 | |
2949 | do m=1,2 | |
2950 | if(n.eq.2)then | |
2951 | z=xx+(zmin-xx)*((zmax1-xx)/(zmin-xx))**(.5+(m-1.5)*x1(i)) | |
2952 | elseif(j.eq.1)then | |
2953 | z=zmin*(zmax1/zmin)**(.5+(m-1.5)*x1(i)) | |
2954 | else | |
2955 | z=(.5d0*(zmax1+zmin+(zmax1-zmin)*(2*m-3)*x1(i))) | |
2956 | endif | |
2957 | qmin=max(q2ini/(1.d0-xx/z),q2ini/(1.d0-z)) | |
2958 | qmin=max(qmin,q1) | |
2959 | ||
2960 | do k=1,2 | |
2961 | fq=0.d0 | |
2962 | do i1=1,7 | |
2963 | do m1=1,2 | |
2964 | if(n.eq.2)then | |
2965 | qi=qmin*(qmax/qmin)**(.5+x1(i1)*(m1-1.5)) | |
2966 | else | |
2967 | qi=(.5*(qmax+qmin+(qmax-qmin)*(2.*m1-3.)*x1(i1))) | |
2968 | endif | |
2969 | ||
2970 | if(j.eq.3.and.k.eq.1)then | |
2971 | fk=0.d0 | |
2972 | else | |
2973 | if(n.eq.2)then | |
2974 | fk=dble(psevi0(q1,qi,xx/z,min(2,j),k)) | |
2975 | else | |
2976 | fk=dble(psevi(q1,qi,xx/z,j,k)/qi) | |
2977 | endif | |
2978 | endif | |
2979 | qt=qi*(1.d0-z) | |
2980 | fq=fq+a1(i1)*fk/psuds(qi,l-1)*pssalf(qt/qcdlam) | |
2981 | enddo | |
2982 | enddo | |
2983 | if(n.eq.2)then | |
2984 | fq=fq*log(qmax/qmin)*(1.d0-xx/z) | |
2985 | elseif(j.eq.1)then | |
2986 | fq=fq*(qmax-qmin) | |
2987 | else | |
2988 | fq=fq*(qmax-qmin)/z | |
2989 | endif | |
2990 | fz1=fz1+a1(i)*fq*psfap(z,k-1,l-1) | |
2991 | enddo | |
2992 | enddo | |
2993 | enddo | |
2994 | if(n.eq.2)then | |
2995 | fz1=fz1*log((zmax1-xx)/(zmin-xx))/4. | |
2996 | elseif(j.eq.1)then | |
2997 | fz1=fz1*log(zmax1/zmin)/4. | |
2998 | else | |
2999 | fz1=fz1*(zmax1-zmin)/4. | |
3000 | endif | |
3001 | endif | |
3002 | ||
3003 | if(zmax.gt..1d0)then | |
3004 | zmin1=max(.1d0,zmin) | |
3005 | do i=1,7 | |
3006 | do m=1,2 | |
3007 | z=1.d0-(1.d0-zmax)*((1.d0-zmin1)/(1.d0-zmax))** | |
3008 | * (.5+x1(i)*(m-1.5)) | |
3009 | qmin=max(q2ini/(1.d0-z),q2ini/(1.d0-xx/z)) | |
3010 | qmin=max(qmin,q1) | |
3011 | ||
3012 | do k=1,2 | |
3013 | fq=0. | |
3014 | do i1=1,7 | |
3015 | do m1=1,2 | |
3016 | if(n.eq.2)then | |
3017 | qi=qmin*(qmax/qmin)**(.5+x1(i1)*(m1-1.5)) | |
3018 | else | |
3019 | qi=(.5*(qmax+qmin+(qmax-qmin)*(2.*m1-3.)*x1(i1))) | |
3020 | endif | |
3021 | ||
3022 | if(j.eq.3.and.k.eq.1)then | |
3023 | fk=0.d0 | |
3024 | else | |
3025 | if(n.eq.2)then | |
3026 | fk=dble(psevi0(q1,qi,xx/z,min(2,j),k)) | |
3027 | else | |
3028 | fk=dble(psevi(q1,qi,xx/z,j,k)/qi) | |
3029 | endif | |
3030 | endif | |
3031 | qt=qi*(1.d0-z) | |
3032 | fq=fq+a1(i1)*fk/psuds(qi,l-1)*pssalf(qt/qcdlam) | |
3033 | enddo | |
3034 | enddo | |
3035 | if(n.eq.2)then | |
3036 | fq=fq*log(qmax/qmin) | |
3037 | else | |
3038 | fq=fq*(qmax-qmin) | |
3039 | endif | |
3040 | fz2=fz2+a1(i)*fq*psfap(z,k-1,l-1)*(1.d0/z-1.d0) | |
3041 | enddo | |
3042 | enddo | |
3043 | enddo | |
3044 | fz2=fz2*log((1.d0-zmin1)/(1.d0-zmax))/4. | |
3045 | endif | |
3046 | endif | |
3047 | psev=sngl((fz1+fz2)*psuds(qq,l-1)) | |
3048 | return | |
3049 | end | |
3050 | ||
3051 | c------------------------------------------------------------------------ | |
3052 | function psevi0(q1,qq,xx,m,l) | |
3053 | c------------------------------------------------------------------------ | |
3054 | double precision xx,xmax,psuds | |
3055 | dimension wi(3),wj(3),wk(3) | |
3056 | common /psar2/ edmax,epmax | |
3057 | common /psar31/ evk0(21,21,54) | |
3058 | include 'epos.inc' | |
3059 | include 'epos.incsem' | |
3060 | ||
3061 | xmax=1.d0-2.d0*q2ini/epmax | |
3062 | qmin=max(1.d0*q2min,q2ini/(1.d0-xx)) | |
3063 | qm1=max(q1,qmin) | |
3064 | if(qq.gt..5001*epmax.and.ish.ge.1)then | |
3065 | write(ifch,*)'0-extrap.:q1,qq,epmax,xx,m,l:',q1,qq,epmax,xx,m,l | |
3066 | c stop | |
3067 | endif | |
3068 | if(xx.ge.xmax.or.qq.le.1.000*qm1)then | |
3069 | psevi0=0. | |
3070 | c write (*,*)'xx,xmax,qq,qm1,qmin,q1',xx,xmax,qq,qm1,qmin,q1 | |
3071 | return | |
3072 | endif | |
3073 | ||
3074 | if(m.eq.l)then | |
3075 | psevi0=1. | |
3076 | else | |
3077 | if(xx.lt..1d0)then | |
3078 | yx=log(10.d0*xx)+13. | |
3079 | k=int(yx) | |
3080 | if(k.gt.11)k=11 | |
3081 | if(k.lt.1)k=1 | |
3082 | elseif(xx.lt..9d0)then | |
3083 | yx=10.*xx+12. | |
3084 | k=int(yx) | |
3085 | if(k.gt.19)k=19 | |
3086 | else | |
3087 | yx=log(10.d0*(1.d0-xx))/log(10.d0*(1.d0-xmax))*6.+21 | |
3088 | k=int(yx) | |
3089 | if(k.gt.25)k=25 | |
3090 | endif | |
3091 | wk(2)=yx-k | |
3092 | wk(3)=wk(2)*(wk(2)-1.)*.5 | |
3093 | wk(1)=1.-wk(2)+wk(3) | |
3094 | wk(2)=wk(2)-2.*wk(3) | |
3095 | ||
3096 | qli=log(qq/qmin)/log(.5*epmax/qmin)*20.+1. | |
3097 | qlj=log(qm1/qmin)/log(qq/qmin)*20.+1. | |
3098 | i=int(qli) | |
3099 | if(i.gt.19)i=19 | |
3100 | if(i.lt.1)i=1 | |
3101 | wi(2)=qli-i | |
3102 | wi(3)=wi(2)*(wi(2)-1.)*.5 | |
3103 | wi(1)=1.-wi(2)+wi(3) | |
3104 | wi(2)=wi(2)-2.*wi(3) | |
3105 | ||
3106 | j=int(qlj) | |
3107 | if(j.lt.1)j=1 | |
3108 | if(j.gt.19)j=19 | |
3109 | wj(2)=qlj-j | |
3110 | wj(3)=wj(2)*(wj(2)-1.)*.5 | |
3111 | wj(1)=1.-wj(2)+wj(3) | |
3112 | wj(2)=wj(2)-2.*wj(3) | |
3113 | ||
3114 | psevi0=0. | |
3115 | do i1=1,3 | |
3116 | do j1=1,3 | |
3117 | do k1=1,3 | |
3118 | psevi0=psevi0+evk0(i+i1-1,j+j1-1,k+k1-1+27*(m-1)) | |
3119 | * *wi(i1)*wj(j1)*wk(k1) | |
3120 | enddo | |
3121 | enddo | |
3122 | enddo | |
3123 | psevi0=exp(psevi0) | |
3124 | endif | |
3125 | psevi0=psevi0*psfap(xx,m-1,l-1)*log(log(qq*(1.d0-xx)/qcdlam) | |
3126 | */log(qm1*(1.d0-xx)/qcdlam))*sngl(psuds(qq,m-1)/psuds(q1,m-1))/4.5 | |
3127 | return | |
3128 | end | |
3129 | ||
3130 | c------------------------------------------------------------------------ | |
3131 | function psevi(q1,qq,xx,m,l) | |
3132 | c------------------------------------------------------------------------ | |
3133 | c m l: 1 1 ... gluon -> gluon | |
3134 | c 2 1 ... quark -> gluon | |
3135 | c 1 2 ... gluon -> quark | |
3136 | c 3 2 ... quark -> quark non singlet | |
3137 | c 2 2 ... quark -> quark all | |
3138 | c singlet = all - non singlet | |
3139 | c----------------------------------------------------------------------- | |
3140 | double precision xx,xmax,psuds | |
3141 | dimension wi(3),wj(3),wk(3) | |
3142 | common /psar2/ edmax,epmax | |
3143 | common /psar32/ evk(21,21,135) | |
3144 | include 'epos.inc' | |
3145 | include 'epos.incsem' | |
3146 | ||
3147 | psevi=0. | |
3148 | xmax=1.d0-2.d0*q2ini/epmax | |
3149 | if(qq.gt..5001*epmax.and.ish.ge.1)then | |
3150 | write(ifch,*)'1-extrap.:q1,qq,epmax,xx,m,l:',q1,qq,epmax,xx,m,l | |
3151 | c stop | |
3152 | endif | |
3153 | qmin=max(1.d0*q2min,q2ini/(1.d0-xx)) | |
3154 | qm1=max(q1,qmin) | |
3155 | if(xx.ge.xmax.or.qq.le.1.0001*qm1)then | |
3156 | return | |
3157 | endif | |
3158 | qmin1=max(1.d0*qmin,q2ini/(1.d0-dsqrt(xx))) | |
3159 | if(qq.le.1.0001*qmin1)then | |
3160 | psevi=psevi0(q1,qq,xx,min(m,2),l) | |
3161 | return | |
3162 | endif | |
3163 | ||
3164 | if(xx.lt..1d0)then | |
3165 | yx=log(10.d0*xx)+13. | |
3166 | k=int(yx) | |
3167 | if(k.gt.11)k=11 | |
3168 | if(k.lt.1)k=1 | |
3169 | elseif(xx.lt..9d0)then | |
3170 | yx=10.*xx+12. | |
3171 | k=int(yx) | |
3172 | if(k.gt.19)k=19 | |
3173 | else | |
3174 | yx=log(10.d0*(1.d0-xx))/log(10.d0*(1.d0-xmax))*6.+21 | |
3175 | k=int(yx) | |
3176 | if(k.gt.25)k=25 | |
3177 | endif | |
3178 | wk(2)=yx-k | |
3179 | wk(3)=wk(2)*(wk(2)-1.)*.5 | |
3180 | wk(1)=1.-wk(2)+wk(3) | |
3181 | wk(2)=wk(2)-2.*wk(3) | |
3182 | ||
3183 | qli=log(qq/qmin)/log(.5*epmax/qmin)*20.+1. | |
3184 | qlj=log(qm1/qmin)/log(qq/qmin)*20.+1. | |
3185 | i=int(qli) | |
3186 | if(i.lt.1)i=1 | |
3187 | if(i.gt.19)i=19 | |
3188 | wi(2)=qli-i | |
3189 | wi(3)=wi(2)*(wi(2)-1.)*.5 | |
3190 | wi(1)=1.-wi(2)+wi(3) | |
3191 | wi(2)=wi(2)-2.*wi(3) | |
3192 | ||
3193 | j=int(qlj) | |
3194 | if(j.lt.1)j=1 | |
3195 | if(j.gt.19)j=19 | |
3196 | wj(2)=qlj-j | |
3197 | wj(3)=wj(2)*(wj(2)-1.)*.5 | |
3198 | wj(1)=1.-wj(2)+wj(3) | |
3199 | wj(2)=wj(2)-2.*wj(3) | |
3200 | ||
3201 | do i1=1,3 | |
3202 | do j1=1,3 | |
3203 | do k1=1,3 | |
3204 | if(m.eq.3)then | |
3205 | k2=k+k1-1+108 | |
3206 | else | |
3207 | k2=k+k1-1+27*(m-1)+54*(l-1) | |
3208 | endif | |
3209 | psevi=psevi+evk(i+i1-1,j+j1-1,k2) | |
3210 | * *wi(i1)*wj(j1)*wk(k1) | |
3211 | enddo | |
3212 | enddo | |
3213 | enddo | |
3214 | psevi=exp(psevi)*psfap(xx,m-1,l-1)*log(log(qq*(1.d0-xx)/qcdlam) | |
3215 | */log(qm1*(1.d0-xx)/qcdlam))/4.5 | |
3216 | if(q1.lt.qm1)psevi=psevi*sngl(psuds(qm1,m-1)/psuds(q1,m-1)) | |
3217 | return | |
3218 | end | |
3219 | ||
3220 | c------------------------------------------------------------------------ | |
3221 | function psjci(q1,s,l1) | |
3222 | c----------------------------------------------------------------------- | |
3223 | c psjci - inclusive ordered ladder cross-section interpolation for c-quark | |
3224 | c q1 - virtuality cutoff at current end of the ladder | |
3225 | c s - total c.m. energy squared for the ladder, | |
3226 | c l1 - parton type at current end of the ladder (0-g, 1,2,etc.-q) | |
3227 | c----------------------------------------------------------------------- | |
3228 | dimension wi(3),wk(3) | |
3229 | common /psar2/ edmax,epmax | |
3230 | common /psar23/ cschar(20,20,2) | |
3231 | include 'epos.incsem' | |
3232 | ||
3233 | psjci=0. | |
3234 | q2mass=qcmass**2 | |
3235 | spmin=4.*q2min+q2mass | |
3236 | qq=q1 | |
3237 | s2min=4.*qq+q2mass | |
3238 | if(s.le.s2min)return | |
3239 | ||
3240 | smins=s2min/(1.-q2ini/q1) | |
3241 | c if(s.le.smins)goto 1 | |
3242 | if(s.le.smins.or.qq.le.q2min)goto 1 !??????? ctp070618 | |
3243 | ||
3244 | p1=s/(1.+q2mass/s) | |
3245 | if(p1.gt.4.*qq)then | |
3246 | tmin=2.*qq/(1.+sqrt(1.-4.*qq/p1)) | |
3247 | else | |
3248 | tmin=2.*qq | |
3249 | endif | |
3250 | tmax=p1/2. | |
3251 | qmax=p1/4. | |
3252 | ||
3253 | l=min(1,iabs(l1))+1 | |
3254 | qli=log(qq/q2min)/log(qmax/q2min)*19.+1. | |
3255 | sl=log(s/spmin)/log(epmax/2./spmin)*19.+1. | |
3256 | k=int(sl) | |
3257 | i=int(qli) | |
3258 | if(i.lt.1)i=1 | |
3259 | if(k.gt.18)k=18 | |
3260 | if(i.gt.18)i=18 | |
3261 | ||
3262 | wi(2)=qli-i | |
3263 | wi(3)=wi(2)*(wi(2)-1.)*.5 | |
3264 | wi(1)=1.-wi(2)+wi(3) | |
3265 | wi(2)=wi(2)-2.*wi(3) | |
3266 | ||
3267 | wk(2)=sl-k | |
3268 | wk(3)=wk(2)*(wk(2)-1.)*.5 | |
3269 | wk(1)=1.-wk(2)+wk(3) | |
3270 | wk(2)=wk(2)-2.*wk(3) | |
3271 | ||
3272 | do i1=1,3 | |
3273 | do k1=1,3 | |
3274 | psjci=psjci+cschar(i+i1-1,k+k1-1,l)*wi(i1)*wk(k1) | |
3275 | enddo | |
3276 | enddo | |
3277 | psjci=exp(psjci)*(1./tmin-1./tmax) | |
3278 | return | |
3279 | 1 psjci=psbint(q2min,q1,0.,s,4,l1,0) | |
3280 | return | |
3281 | end | |
3282 | ||
3283 | c----------------------------------------------------------------------- | |
3284 | function psjct(s,l) | |
3285 | c----------------------------------------------------------------------- | |
3286 | c psjct - unordered ladder cross-section for c-quark | |
3287 | c s - c.m. energy squared for the scattering; | |
3288 | c l - parton type at opposite end of the ladder (0 - g, 1,2 etc. - q). | |
3289 | c----------------------------------------------------------------------- | |
3290 | double precision xx,zmax,qmax,qmin,qi,zmin,fsj,z,s2,sj | |
3291 | common /ar3/ x1(7),a1(7) | |
3292 | include 'epos.inc' | |
3293 | include 'epos.incsem' | |
3294 | ||
3295 | psjct=0. | |
3296 | q2mass=qcmass**2 | |
3297 | zmax=dble(s)/(dble(s)+dble(5.*q2mass)) | |
3298 | qmax=zmax**2*dble(q2mass)/(1.d0-zmax) | |
3299 | qmin=dble(q2min) | |
3300 | ||
3301 | if(qmax.lt.qmin.and.ish.ge.1)write(ifch,*)'psjct:qmin,qmax' | |
3302 | * ,qmin,qmax | |
3303 | do i=1,7 | |
3304 | do m=1,2 | |
3305 | qi=2.d0*qmin/(1.d0+qmin/qmax+dble((2*m-3)*x1(i)) | |
3306 | * *(1.d0-qmin/qmax)) | |
3307 | zmax=(2.d0/(1.d0+dsqrt(1.d0+4.d0*dble(q2mass)/qi)))**delh | |
3308 | zmin=(5.d0*qi/dble(s))**delh | |
3309 | ||
3310 | fsj=0.d0 | |
3311 | if(zmax.lt.zmin.and.ish.ge.1)write(ifch,*)'psjct:zmin,zmax' | |
3312 | * ,zmin,zmax | |
3313 | do i1=1,7 | |
3314 | do m1=1,2 | |
3315 | z=(.5d0*(zmax+zmin+dble((2*m1-3)*x1(i1)) | |
3316 | * *(zmax-zmin)))**(1./delh) | |
3317 | s2=z*dble(s)-qi | |
3318 | xx=z | |
3319 | sj=dble(psjti(sngl(qi),q2min,sngl(s2),0,l,0)*psfap(xx,1,0))*z | |
3320 | fsj=fsj+dble(a1(i1))*sj*dble(pssalf(sngl(qi)/qcdlam))/z**delh | |
3321 | enddo | |
3322 | enddo | |
3323 | fsj=fsj*(zmax-zmin) | |
3324 | psjct=psjct+a1(i)*sngl(fsj*qi) | |
3325 | enddo | |
3326 | enddo | |
3327 | psjct=psjct*sngl(1./qmin-1./qmax)/delh/4. | |
3328 | return | |
3329 | end | |
3330 | ||
3331 | c------------------------------------------------------------------------ | |
3332 | function psjet1(q1,q2,qqcut,s,j,l,jdis) | |
3333 | c----------------------------------------------------------------------- | |
3334 | c psjet1 - ordered parton ladder cross-section | |
3335 | c q1 - virtuality cutoff at current end of the ladder; | |
3336 | c q2 - virtuality cutoff at opposite end of the ladder; | |
3337 | c qqcut - p_t cutoff for the born process; | |
3338 | c s - c.m. energy squared for the scattering; | |
3339 | c j - parton type at current end of the ladder (0 - g, 1,2 etc. - q); | |
3340 | c l - parton type at opposite end of the ladder (0 - g, 1,2 etc. - q). | |
3341 | c----------------------------------------------------------------------- | |
3342 | double precision xx,z,qq,xmax,xmin,s2min,smin,p1,q2ms,q2inis,xmin1 | |
3343 | *,sh,qtmin,t,xmax1,fx1,fx2,psuds | |
3344 | common /ar3/ x1(7),a1(7) | |
3345 | common /ar9/ x9(3),a9(3) | |
3346 | include 'epos.inc' | |
3347 | include 'epos.incsem' | |
3348 | ||
3349 | psjet1=0. | |
3350 | if(jdis.eq.0)then | |
3351 | qq=dble(max(q1,q2)) | |
3352 | elseif(jdis.eq.1)then | |
3353 | qq=dble(max(q1/4.,q2)) | |
3354 | else | |
3355 | qq=dble(max(q1,q2/4.)) | |
3356 | endif | |
3357 | qq=max(qq,dble(qqcut)) | |
3358 | if(l.ne.3)then | |
3359 | q2mass=0. | |
3360 | else | |
3361 | q2mass=qcmass**2 | |
3362 | endif | |
3363 | s2min=dble(q2mass)+4.d0*qq | |
3364 | if(jdis.eq.0.or.jdis.eq.2)then | |
3365 | smin=s2min/(1.d0-dble(q2ini)/qq) | |
3366 | else | |
3367 | smin=s2min/(1.d0-dble(q2ini)/qq/4.d0) | |
3368 | endif | |
3369 | if(dble(s).le.smin)return | |
3370 | ||
3371 | q2ms=dble(q2mass)/dble(s) | |
3372 | q2inis=dble(q2ini)/dble(s) | |
3373 | p1=dble(s)/(1.d0+q2ms) | |
3374 | ||
3375 | ||
3376 | if(jdis.eq.0.or.jdis.eq.2)then | |
3377 | xmax=.5d0*(1.d0+q2ms)+dsqrt(.25d0*(1.d0-q2ms)**2-4.d0*q2inis) | |
3378 | else | |
3379 | xmax=.5d0*(1.+q2ms)+dsqrt(.25d0*(1.-q2ms)**2-q2inis) | |
3380 | endif | |
3381 | xmin=max(1.d0+q2ms-xmax,s2min/dble(s)) | |
3382 | if(xmin.ge.xmax.and.ish.ge.1)then | |
3383 | write(ifch,*)'jti1,xmin,xmax',xmin,xmax | |
3384 | c return | |
3385 | endif | |
3386 | ||
3387 | fx1=0.d0 | |
3388 | fx2=0.d0 | |
3389 | if(xmax.gt..8d0)then | |
3390 | xmin1=max(xmin,.8d0) | |
3391 | do i=1,3 | |
3392 | do m=1,2 | |
3393 | z=1.d0-(1.d0-xmax)*((1.d0-xmin1)/(1.d0-xmax))** | |
3394 | * (.5d0+dble(x9(i)*(m-1.5))) | |
3395 | sh=z*dble(s) | |
3396 | xx=z | |
3397 | p1=sh/(1.d0+dble(q2mass)/sh) | |
3398 | ||
3399 | if(jdis.eq.0.or.jdis.eq.2)then | |
3400 | qtmin=max(qq,dble(q2ini)/(1.d0-z)) | |
3401 | else | |
3402 | qtmin=max(qq,dble(q2ini)/(1.d0-z)/4.d0) | |
3403 | endif | |
3404 | tmin=2.d0*dble(qtmin)/(1.d0+dsqrt(1.d0-4.d0*dble(qtmin)/p1)) | |
3405 | tmax=p1/2.d0 | |
3406 | ||
3407 | ft=0. | |
3408 | if(tmin.ge.tmax.and.ish.ge.1)write(ifch,*)'psjet1:tmin,tmax' | |
3409 | * ,tmin,tmax | |
3410 | do i1=1,3 | |
3411 | do m1=1,2 | |
3412 | t=2.d0*tmin/(1.d0+tmin/tmax-dble(x9(i1)*(2*m1-3)) | |
3413 | & *(1.d0-tmin/tmax)) | |
3414 | qt=sngl(t*(1.d0-t/p1)) | |
3415 | c if(qt.lt.qtmin)write (*,*)'psjet1:qt,qq',qt,qq | |
3416 | ||
3417 | if(jdis.eq.0)then | |
3418 | scale1=qt | |
3419 | scale2=qt | |
3420 | elseif(jdis.eq.1)then | |
3421 | scale1=qt*4. | |
3422 | scale2=qt | |
3423 | elseif(jdis.eq.2)then | |
3424 | scale1=qt | |
3425 | scale2=qt*4. | |
3426 | endif | |
3427 | fb=0. | |
3428 | do n=1,3 | |
3429 | fb=fb+psjetj(q1,scale1,sngl(t),xx,sngl(sh),j,l,n) | |
3430 | enddo | |
3431 | ft=ft+a9(i1)*fb*pssalf(qt/qcdlam)**2*sngl(t**2 | |
3432 | * *psuds(scale2,l)) | |
3433 | enddo | |
3434 | enddo | |
3435 | fx1=fx1+dble(a9(i)*ft)*(1.d0/tmin-1.d0/tmax)/sh**2*(1.d0-z) | |
3436 | enddo | |
3437 | enddo | |
3438 | fx1=fx1*dlog((1.d0-xmin1)/(1.d0-xmax)) | |
3439 | endif | |
3440 | ||
3441 | if(xmin.lt..8d0)then | |
3442 | xmax1=min(xmax,.8d0)**(-delh) | |
3443 | xmin1=xmin**(-delh) | |
3444 | do i=1,3 | |
3445 | do m=1,2 | |
3446 | z=(.5d0*(xmax1+xmin1+(xmin1-xmax1)*dble((2*m-3)*x9(i)))) | |
3447 | * **(-1./delh) | |
3448 | sh=z*dble(s) | |
3449 | xx=z | |
3450 | p1=sh/(1.d0+dble(q2mass)/sh) | |
3451 | ||
3452 | if(jdis.eq.0.or.jdis.eq.2)then | |
3453 | qtmin=max(qq,dble(q2ini)/(1.d0-z)) | |
3454 | else | |
3455 | qtmin=max(qq,dble(q2ini)/(1.d0-z)/4.d0) | |
3456 | endif | |
3457 | tmin=2.d0*dble(qtmin)/(1.d0+dsqrt(1.d0-4.d0*dble(qtmin)/p1)) | |
3458 | tmax=p1/2.d0 | |
3459 | ||
3460 | ft=0. | |
3461 | if(tmin.ge.tmax.and.ish.ge.1)write(ifch,*)'psjet1:tmin,tmax' | |
3462 | & ,tmin,tmax | |
3463 | do i1=1,3 | |
3464 | do m1=1,2 | |
3465 | t=2.d0*tmin/(1.d0+tmin/tmax-dble(x9(i1)*(2*m1-3)) | |
3466 | & *(1.d0-tmin/tmax)) | |
3467 | qt=sngl(t*(1.d0-t/p1)) | |
3468 | if(qt.lt.sngl(qtmin).and.ish.ge.1)write(ifch,*)'psjet1:qt,qq' | |
3469 | & ,qt,qq | |
3470 | ||
3471 | if(jdis.eq.0)then | |
3472 | scale1=qt | |
3473 | scale2=qt | |
3474 | elseif(jdis.eq.1)then | |
3475 | scale1=qt*4. | |
3476 | scale2=qt | |
3477 | elseif(jdis.eq.2)then | |
3478 | scale1=qt | |
3479 | scale2=qt*4. | |
3480 | endif | |
3481 | fb=0. | |
3482 | do n=1,3 | |
3483 | fb=fb+psjetj(q1,scale1,sngl(t),xx,sngl(sh),j,l,n) | |
3484 | enddo | |
3485 | ft=ft+a9(i1)*fb*pssalf(qt/qcdlam)**2*sngl(t**2 | |
3486 | * *psuds(scale2,l)) | |
3487 | enddo | |
3488 | enddo | |
3489 | fx2=fx2+dble(a9(i)*ft)*(1.d0/tmin-1.d0/tmax)/sh**2*z**(1.+delh) | |
3490 | enddo | |
3491 | enddo | |
3492 | fx2=fx2*(xmin1-xmax1)/dble(delh) | |
3493 | endif | |
3494 | psjet1=sngl((fx1+fx2)/psuds(q2,l))*pi**3*2 | |
3495 | * /2 !CS for parton pair | |
3496 | return | |
3497 | end | |
3498 | ||
3499 | c----------------------------------------------------------------------- | |
3500 | function psjet(q1,q2,qqcut,s,j,l,jdis) | |
3501 | c----------------------------------------------------------------------- | |
3502 | c parton ladder cross-section | |
3503 | c with at least one emission on each side | |
3504 | c | |
3505 | c q1 - virtuality cutoff at current end of the ladder; | |
3506 | c q2 - virtuality cutoff at opposite end of the ladder; | |
3507 | c qqcut - p_t cutoff for the born process; | |
3508 | c s - c.m. energy squared for the scattering; | |
3509 | c j - parton type at current end of the ladder (0 - g, 1,2 etc. - q); | |
3510 | c l - parton type at opposite end of the ladder (0 - g, 1,2 etc. - q). | |
3511 | c----------------------------------------------------------------------- | |
3512 | double precision xx1,xx2,qq,s2min,xmin,xmax,xmin1,xmax1,t,tmin | |
3513 | *,tmax,sh,z,qtmin,ft,fx1,fx2 | |
3514 | common /ar3/ x1(7),a1(7) | |
3515 | common /ar9/ x9(3),a9(3) | |
3516 | include 'epos.inc' | |
3517 | include 'epos.incsem' | |
3518 | common/ccctest/iiitest | |
3519 | iiitest=0 | |
3520 | ||
3521 | psjet=0. | |
3522 | if(jdis.eq.0)then | |
3523 | qq=dble(max(q1,q2)) | |
3524 | else | |
3525 | qq=dble(max(q1/4.,q2)) | |
3526 | endif | |
3527 | qq=max(qq,dble(qqcut)) | |
3528 | s2min=4.d0*qq | |
3529 | if(dble(s).le.s2min/(1.d0-dble(q2ini)/qq)**2)return !kkkkkkk | |
3530 | ||
3531 | phi=acos(1.-54.*q2ini/s)/3. | |
3532 | zmax=(1.+2.*cos(phi))**2/9. !kkkkkkk | |
3533 | zmin=(1.-cos(phi)+sqrt(3.d0)*sin(phi))/3. !kkkkkkk | |
3534 | zmin=max(zmin**2,sngl(s2min/dble(s))) | |
3535 | if(zmin.gt.zmax.and.ish.ge.1)write(ifch,*)'psjet:zmin,zmax' | |
3536 | * ,zmin,zmax | |
3537 | zmin=zmin**(-delh) | |
3538 | zmax=zmax**(-delh) | |
3539 | do i=1,3 | |
3540 | do m=1,2 | |
3541 | z=dble(.5*(zmax+zmin+(zmin-zmax)*(2*m-3)*x9(i)))**(-1./delh) | |
3542 | xmin=dsqrt(z) | |
3543 | sh=z*dble(s) | |
3544 | ||
3545 | qtmin=max(qq,dble(q2ini)/(1.d0-dsqrt(z))) | |
3546 | tmin=max(0.d0,1.d0-4.d0*qtmin/sh) | |
3547 | tmin=2.d0*qtmin/(1.d0+dsqrt(tmin)) !kkkkkkk | |
3548 | tmax=sh/2.d0 | |
3549 | ||
3550 | ft=0.d0 | |
3551 | c if(tmin.gt.tmax)write (*,*)'psjet:tmin,tmax',tmin,tmax | |
3552 | do i1=1,3 | |
3553 | do m1=1,2 | |
3554 | t=2.d0*tmin/(1.d0+tmin/tmax-dble(x9(i1)*(2*m1-3)) | |
3555 | & *(1.d0-tmin/tmax)) | |
3556 | qt=t*(1.d0-t/sh) | |
3557 | c if(qt.lt.qtmin)write (*,*)'psjet:qt,qq',qt,qq | |
3558 | xmax=1.d0-q2ini/qt | |
3559 | xmin=max(dsqrt(z),z/xmax) !xm>xp !!! | |
3560 | if(xmin.gt.xmax.and.ish.ge.1)write(ifch,*)'psjet:xmin,xmax' | |
3561 | * ,xmin,xmax | |
3562 | fx1=0.d0 | |
3563 | fx2=0.d0 | |
3564 | if(xmax.gt..8d0)then | |
3565 | xmin1=max(xmin,.8d0) | |
3566 | do i2=1,3 | |
3567 | do m2=1,2 | |
3568 | xx1=1.d0-(1.d0-xmax)*((1.d0-xmin1)/(1.d0-xmax))** | |
3569 | * dble(.5+x9(i2)*(m2-1.5)) | |
3570 | xx2=z/xx1 | |
3571 | ||
3572 | fb=0. | |
3573 | fb=fb+psjeti(q1,q2,qt,sngl(t),xx1,xx2,sngl(sh) | |
3574 | * ,j,l,jdis) | |
3575 | * +psjeti(q1,q2,qt,sngl(t),xx2,xx1,sngl(sh) | |
3576 | * ,j,l,jdis) | |
3577 | fx1=fx1+dble(a9(i2)*fb)*(1.d0/xx1-1.d0) | |
3578 | * *pssalf(qt/qcdlam)**2 | |
3579 | enddo | |
3580 | enddo | |
3581 | fx1=fx1*dlog((1.d0-xmin1)/(1.d0-xmax)) | |
3582 | endif | |
3583 | if(xmin.lt..8d0)then | |
3584 | xmax1=min(xmax,.8d0) | |
3585 | do i2=1,3 | |
3586 | do m2=1,2 | |
3587 | xx1=xmin*(xmax1/xmin)**dble(.5+x9(i2)*(m2-1.5)) | |
3588 | xx2=z/xx1 | |
3589 | ||
3590 | fb=0. | |
3591 | fb=fb+psjeti(q1,q2,qt,sngl(t),xx1,xx2,sngl(sh) | |
3592 | * ,j,l,jdis) | |
3593 | * +psjeti(q1,q2,qt,sngl(t),xx2,xx1,sngl(sh) | |
3594 | * ,j,l,jdis) | |
3595 | fx2=fx2+dble(a9(i2))*fb*pssalf(qt/qcdlam)**2 | |
3596 | enddo | |
3597 | enddo | |
3598 | fx2=fx2*dlog(xmax1/xmin) | |
3599 | endif | |
3600 | ft=ft+dble(a9(i1))*(fx1+fx2)*t**2 | |
3601 | enddo | |
3602 | enddo | |
3603 | ft=ft*(1.d0/tmin-1.d0/tmax) | |
3604 | psjet=psjet+a9(i)*sngl(ft*z**(1.+delh)/sh**2) | |
3605 | enddo | |
3606 | enddo | |
3607 | psjet=psjet*(zmin-zmax)/delh*pi**3 | |
3608 | * /2. !CS for parton pair | |
3609 | return | |
3610 | end | |
3611 | ||
3612 | c----------------------------------------------------------------------- | |
3613 | function pijet(ii,qi,qq,sk,m1,l1) !polynomial interpol of jet CS | |
3614 | c----------------------------------------------------------------------- | |
3615 | c ii ..... type of CS (2 = bothside, 1 = oneside, 0 = no emission, Born) | |
3616 | c qi ..... virtuality cutoff at current end of the ladder | |
3617 | c qq ..... virtuality cutoff of Born | |
3618 | c sk ..... energy squared for the scattering | |
3619 | c m1,l1 .. parton types | |
3620 | c----------------------------------------------------------------------- | |
3621 | include 'epos.incsem' | |
3622 | common/psar2/edmax,epmax | |
3623 | common/tabcsjet/ksmax,iqmax,jqmax,csjet(0:2,2,20,20,20,3,2) | |
3624 | real wi(3),wj(3),wk(3) | |
3625 | common/cpijet/npijet | |
3626 | data npijet/0/ | |
3627 | npijet=npijet+1 | |
3628 | if(npijet.eq.1)call MakeCSTable | |
3629 | ||
3630 | if(m1.ne.0.and.m1.eq.l1)then | |
3631 | m=2 | |
3632 | l=2 | |
3633 | elseif(m1.ne.0.and.m1.eq.-l1)then | |
3634 | m=3 | |
3635 | l=1 | |
3636 | elseif(m1.ne.0.and.l1.ne.0.and.m1.ne.l1)then | |
3637 | m=3 | |
3638 | l=2 | |
3639 | else | |
3640 | m=min(1,iabs(m1))+1 | |
3641 | l=min(1,iabs(l1))+1 | |
3642 | endif | |
3643 | ||
3644 | qqmin=min(qi,qq) | |
3645 | qmax=sk/4. | |
3646 | spmin=4.*q2min | |
3647 | spmed=spmin*(epmax/2./spmin)**(1./(ksmax-1.)) | |
3648 | if(sk.le.spmed)then | |
3649 | kk=2 | |
3650 | spmax=spmed | |
3651 | else | |
3652 | kk=1 | |
3653 | spmax=epmax/2. | |
3654 | endif | |
3655 | ||
3656 | qli=1.+log(qi/q2min)/log(qmax/q2min)*(iqmax-1) | |
3657 | qlj=1.+log(qq/qqmin)/log(qmax/qqmin)*(jqmax-1) | |
3658 | sl= 1.+log(sk/spmin)/log(spmax/spmin)*(ksmax-1) | |
3659 | k=int(sl) | |
3660 | i=int(qli) | |
3661 | j=int(qlj) | |
3662 | if(k.lt.1)k=1 | |
3663 | if(j.lt.1)j=1 | |
3664 | if(i.lt.1)i=1 | |
3665 | if(k.gt.(ksmax-2))k=ksmax-2 | |
3666 | if(i.gt.(iqmax-2))i=iqmax-2 | |
3667 | if(j.gt.(jqmax-2))j=jqmax-2 | |
3668 | ||
3669 | wi(2)=qli-i | |
3670 | wi(3)=wi(2)*(wi(2)-1.)*.5 | |
3671 | wi(1)=1.-wi(2)+wi(3) | |
3672 | wi(2)=wi(2)-2.*wi(3) | |
3673 | ||
3674 | wj(2)=qlj-j | |
3675 | wj(3)=wj(2)*(wj(2)-1.)*.5 | |
3676 | wj(1)=1.-wj(2)+wj(3) | |
3677 | wj(2)=wj(2)-2.*wj(3) | |
3678 | ||
3679 | wk(2)=sl-k | |
3680 | wk(3)=wk(2)*(wk(2)-1.)*.5 | |
3681 | wk(1)=1.-wk(2)+wk(3) | |
3682 | wk(2)=wk(2)-2.*wk(3) | |
3683 | ||
3684 | pijet=0 | |
3685 | do i1=1,3 | |
3686 | do j1=1,3 | |
3687 | do k1=1,3 | |
3688 | pijet=pijet+csjet(ii,kk,k+k1-1,i+i1-1,j+j1-1,m,l) | |
3689 | * *wi(i1)*wj(j1)*wk(k1) | |
3690 | enddo | |
3691 | enddo | |
3692 | enddo | |
3693 | ! if(ii.eq.2)print*,' ' | |
3694 | ! write(*,'(i2,f6.0,i2,3x,3(2f5.2,2x),f5.2)') | |
3695 | !* ii,sk,k,(wk(kk1),csjet(ii,kk,k+kk1-1,1,1,m,l),kk1=1,3) ,pijet | |
3696 | end | |
3697 | ||
3698 | c----------------------------------------------------------------------- | |
3699 | subroutine MakeCSTable !tabulates psjet | |
3700 | c----------------------------------------------------------------------- | |
3701 | c last two indices of table: parton types | |
3702 | c 1 1 ... gg | |
3703 | c 1 2 ... gq | |
3704 | c 2 1 ... qg | |
3705 | c 2 2 ... qq | |
3706 | c 3 1 ... qa | |
3707 | c 3 2 ... qq' | |
3708 | c----------------------------------------------------------------------- | |
3709 | include 'epos.incsem' | |
3710 | common/psar2/edmax,epmax | |
3711 | common/tabcsjet/ksmax,iqmax,jqmax,csjet(0:2,2,20,20,20,3,2) | |
3712 | write (*,'(a,$)')'(CS table' | |
3713 | ksmax=10 | |
3714 | iqmax=3 | |
3715 | jqmax=3 | |
3716 | spmin=4.*q2min | |
3717 | do kk=1,2 | |
3718 | if(kk.eq.1)spmax=epmax/2. | |
3719 | if(kk.eq.2)spmax=spmin*(epmax/2./spmin)**(1./(ksmax-1.)) | |
3720 | do m=1,3 !parton type at upper end of the ladder | |
3721 | write (*,'(a,$)')'.' | |
3722 | do l=1,2 !parton type at lower end of the ladder | |
3723 | m1=m-1 | |
3724 | l1=l-1 | |
3725 | if(m.eq.3.and.l.eq.1)l1=-m1 | |
3726 | do k=1,ksmax | |
3727 | sk=spmin*(spmax/spmin)**((k-1.)/(ksmax-1.)) | |
3728 | qmax=sk/4. | |
3729 | do i=1,iqmax | |
3730 | qi=q2min*(qmax/q2min)**((i-1.)/(iqmax-1.)) | |
3731 | do j=1,jqmax | |
3732 | qq=qi*(qmax/qi)**((j-1.)/(jqmax-1.)) | |
3733 | !write(*,'(i3,4f8.3,2i4,$)')j, qi,q2min,qq,sk,m1,l1 | |
3734 | csjet(2,kk,k,i,j,m,l)= psjet(qi,q2min,qq,sk,m1,l1,0) | |
3735 | csjet(1,kk,k,i,j,m,l)=psjet1(qi,q2min,qq,sk,m1,l1,0) | |
3736 | csjet(0,kk,k,i,j,m,l)=psborn(qi,q2min,qq,sk,m1,l1,0,1) | |
3737 | ! if(i.eq.1.and.j.eq.1.and.m.eq.1.and.l.eq.1) | |
3738 | ! *write(*,'(2f8.2,f13.2,2i3,3x,i3,3f8.3)') | |
3739 | ! * qi,qq,sk,m1,l1,k,csjet(2,kk,k,i,j,m,l) | |
3740 | ! * ,csjet(1,kk,k,i,j,m,l),csjet(0,kk,k,i,j,m,l) | |
3741 | enddo | |
3742 | enddo | |
3743 | enddo | |
3744 | enddo | |
3745 | enddo | |
3746 | enddo | |
3747 | write (*,'(a,$)')'done)' | |
3748 | end | |
3749 | ||
3750 | c----------------------------------------------------------------------- | |
3751 | function psjeti(q1,q2,qt,t,xx1,xx2,s,j,l,jdis) | |
3752 | c----------------------------------------------------------------------- | |
3753 | c | |
3754 | c E~qcd_ji * E~qcd_lk * B_ik | |
3755 | c | |
3756 | c B_ik = psbori = contribution to Born xsection: | |
3757 | c dsigmaBorn/d2pt/dy | |
3758 | c = s/pi * delta(s+t+u) * 2*pi*alpha**2 /s**2 * B_ik | |
3759 | c | |
3760 | c E~qcd: at least one emission | |
3761 | c | |
3762 | c q1 - virtuality cutoff at current end of the ladder | |
3763 | c q2 - virtuality cutoff at opposite end of the ladder | |
3764 | c xx1 - feinman x for the first parton for the born process | |
3765 | c xx2 - feinman x for the second parton for the born process | |
3766 | c s - c.m. energy squared for the born scattering | |
3767 | c t - invariant variable for the scattering |(p1-p3)**2|, | |
3768 | c j - parton type at current end of the ladder (0 - g, 1,-1,2,... - q) | |
3769 | c l - parton type at opposite end of the ladder (0 - g, 1,-1,2,... - q) | |
3770 | c----------------------------------------------------------------------- | |
3771 | c reminder | |
3772 | c psevi: 1 1 ... gluon -> gluon | |
3773 | c 2 1 ... quark -> gluon | |
3774 | c 1 2 ... gluon -> quark | |
3775 | c 3 2 ... quark -> quark non singlet | |
3776 | c 2 2 ... quark -> quark all | |
3777 | c singlet = all - non singlet | |
3778 | c----------------------------------------------------------------------- | |
3779 | double precision xx1,xx2 | |
3780 | include 'epos.incsem' | |
3781 | common/ccctest/iiitest | |
3782 | ||
3783 | if(jdis.eq.0)then | |
3784 | scale=qt | |
3785 | else | |
3786 | scale=qt*4. | |
3787 | endif | |
3788 | if(j.eq.0.and.l.eq.0)then ! gluon-gluon ---> | |
3789 | akg1=psevi(q1,scale,xx1,1,1) !gluon contribution | |
3790 | akg2=psevi(q2,qt,xx2,1,1) !gluon contribution | |
3791 | aks1=psevi(q1,scale,xx1,1,2)/naflav/2. !singlet contribution per quark | |
3792 | aks2=psevi(q2,qt,xx2,1,2)/naflav/2. !singlet contribution per quark | |
3793 | psjeti=ffborn(s,t,akg1*akg2 | |
3794 | * ,(akg1*aks2+aks1*akg2)*naflav*2. !ccccc | |
3795 | * ,aks1*aks2*naflav*2. | |
3796 | * ,aks1*aks2*naflav*2. | |
3797 | * ,aks1*aks2*naflav*2.*(naflav-1)*2. | |
3798 | *) | |
3799 | elseif(j.eq.0)then ! gluon-quark ---> | |
3800 | akg1=psevi(q1,scale,xx1,1,1) !gluon contribution | |
3801 | akg2=psevi(q2,qt,xx2,2,1) !gluon contribution | |
3802 | aks1=psevi(q1,scale,xx1,1,2)/naflav/2. !singlet contribution | |
3803 | akns2=psevi(q2,qt,xx2,3,2) !nonsinglet contribution | |
3804 | aks2=(psevi(q2,qt,xx2,2,2)-akns2)/naflav/2. !singlet contribution | |
3805 | psjeti=ffborn(s,t,akg1*akg2 | |
3806 | * ,(akg1*(akns2+aks2*naflav*2.)+aks1*akg2*naflav*2.) | |
3807 | * ,aks1*(akns2+aks2*naflav*2.) | |
3808 | * ,aks1*(akns2+aks2*naflav*2.) | |
3809 | * ,aks1*(akns2+aks2*naflav*2.)*(naflav-1)*2.) | |
3810 | elseif(l.eq.0)then ! quark-gluon ---> | |
3811 | akg1=psevi(q1,scale,xx1,2,1) !gluon contribution | |
3812 | akg2=psevi(q2,qt,xx2,1,1) !gluon contribution | |
3813 | akns1=psevi(q1,scale,xx1,3,2) !nonsinglet contribution | |
3814 | aks1=(psevi(q1,scale,xx1,2,2)-akns1)/naflav/2. !singlet contribution | |
3815 | aks2=psevi(q2,qt,xx2,1,2)/naflav/2. !singlet contribution | |
3816 | psjeti=ffborn(s,t,akg1*akg2 | |
3817 | * ,(akg2*(akns1+aks1*naflav*2.)+aks2*akg1*naflav*2.) | |
3818 | * ,aks2*(akns1+aks1*naflav*2.) | |
3819 | * ,aks2*(akns1+aks1*naflav*2.) | |
3820 | * ,aks2*(akns1+aks1*naflav*2.)*(naflav-1)*2.) | |
3821 | else ! quark-quark ---> | |
3822 | akg1=psevi(q1,scale,xx1,2,1) !gluon contribution | |
3823 | akg2=psevi(q2,qt,xx2,2,1) !gluon contribution | |
3824 | akns1=psevi(q1,scale,xx1,3,2) !nonsinglet contribution | |
3825 | aks1=(psevi(q1,scale,xx1,2,2)-akns1)/naflav/2.!singlet contribution | |
3826 | akns2=psevi(q2,qt,xx2,3,2) !nonsinglet contribution | |
3827 | aks2=(psevi(q2,qt,xx2,2,2)-akns2)/naflav/2.!singlet contribution | |
3828 | ||
3829 | if(j.eq.l)then | |
3830 | psjeti=ffborn(s,t,akg1*akg2 | |
3831 | * ,(akg2*(akns1+aks1*naflav*2.)+akg1*(akns2+aks2*naflav*2.)) | |
3832 | * ,((akns1+aks1)*(akns2+aks2)+aks1*aks2*(2.*naflav-1.)) | |
3833 | * ,(akns1*aks2+akns2*aks1+aks1*aks2*naflav*2.) | |
3834 | * ,(akns1*aks2+akns2*aks1+aks1*aks2*naflav*2.)*(naflav-1)*2.) | |
3835 | elseif(j.eq.-l)then | |
3836 | psjeti=ffborn(s,t,akg1*akg2 | |
3837 | * ,(akg2*(akns1+aks1*naflav*2.)+akg1*(akns2+aks2*naflav*2.)) | |
3838 | * ,(akns1*aks2+akns2*aks1+aks1*aks2*naflav*2.) | |
3839 | * ,((akns1+aks1)*(akns2+aks2)+aks1*aks2*(2.*naflav-1.)) | |
3840 | * ,(akns1*aks2+akns2*aks1+aks1*aks2*naflav*2.)*(naflav-1)*2.) | |
3841 | else !j.ne.l,-l | |
3842 | psjeti=ffborn(s,t,akg1*akg2 | |
3843 | * ,(akg2*(akns1+aks1*naflav*2.)+akg1*(akns2+aks2*naflav*2.)) | |
3844 | * ,(akns1*aks2+akns2*aks1+aks1*aks2*naflav*2.) | |
3845 | * ,(akns1*aks2+akns2*aks1+aks1*aks2*naflav*2.) | |
3846 | * ,(akns1*akns2+akns1*aks2*(naflav-1)*2. | |
3847 | * +akns2*aks1*(naflav-1)*2.+aks1*aks2*naflav*2.*(naflav-1)*2.)) | |
3848 | endif | |
3849 | endif | |
3850 | return | |
3851 | end | |
3852 | ||
3853 | c----------------------------------------------------------------------- | |
3854 | function psjetj(q1,scale,t,xx,s,j,l,n) | |
3855 | c----------------------------------------------------------------------- | |
3856 | c psjetj - integrand for the ordered ladder cross-section | |
3857 | c q1 - virtuality cutoff at current end of the ladder, | |
3858 | c scale - born process scale, | |
3859 | c t - invariant variable for the scattering |(p1-p3)**2|, | |
3860 | c xx - feinman x for the first parton for the born process | |
3861 | c s - c.m. energy squared for the born scattering, | |
3862 | c j - parton type at current end of the ladder (0 - g, 1,-1,2,... - q) | |
3863 | c l - parton type at opposite end of the ladder (0 - g, 1,-1,2,... - q) | |
3864 | c n - subprocess number | |
3865 | c----------------------------------------------------------------------- | |
3866 | double precision xx | |
3867 | include 'epos.incsem' | |
3868 | ||
3869 | m=min(1,iabs(j))+1 | |
3870 | if(l.ne.3)then | |
3871 | if(l.eq.0)then | |
3872 | psjetj=psevi(q1,scale,xx,m,1)*(psbori(s,t,0,0,n)+ !gg | |
3873 | * psbori(s,s-t,0,0,n))/2. | |
3874 | * +psevi(q1,scale,xx,m,2)*(psbori(s,t,1,0,n)+ !qg | |
3875 | * psbori(s,s-t,1,0,n)) | |
3876 | elseif(j.eq.0)then | |
3877 | aks=psevi(q1,scale,xx,1,2)/naflav/2. !singlet contribution per quark | |
3878 | psjetj=psevi(q1,scale,xx,1,1)*(psbori(s,t,0,1,n)+ !gq | |
3879 | * psbori(s,s-t,0,1,n)) | |
3880 | * +aks*(psbori(s,t,1,1,n)+psbori(s,s-t,1,1,n))/2. !qq | |
3881 | * +aks*(psbori(s,t,-1,1,n)+psbori(s,s-t,-1,1,n)) !qq~ | |
3882 | * +aks*(psbori(s,t,1,2,n)+psbori(s,s-t,1,2,n))*(naflav-1)*2. !qq' | |
3883 | else | |
3884 | akg=psevi(q1,scale,xx,2,1) !gluon contribution | |
3885 | akns=psevi(q1,scale,xx,3,2) !nonsinglet contribution | |
3886 | aks=(psevi(q1,scale,xx,2,2)-akns)/naflav/2. !singlet contribution | |
3887 | if(j.eq.l)then | |
3888 | psjetj=akg*(psbori(s,t,0,1,n)+psbori(s,s-t,0,1,n)) !gq | |
3889 | * +(akns+aks)*(psbori(s,t,1,1,n)+psbori(s,s-t,1,1,n))/2. !qq | |
3890 | * +aks*(psbori(s,t,-1,1,n)+psbori(s,s-t,-1,1,n)) !qq~ | |
3891 | * +aks*(psbori(s,t,1,2,n)+psbori(s,s-t,1,2,n))*(naflav-1)*2. !qq' | |
3892 | elseif(j.eq.-l)then | |
3893 | psjetj=akg*(psbori(s,t,0,1,n)+psbori(s,s-t,0,1,n)) !gq | |
3894 | * +aks*(psbori(s,t,1,1,n)+psbori(s,s-t,1,1,n))/2. !qq | |
3895 | * +(akns+aks)*(psbori(s,t,-1,1,n)+psbori(s,s-t,-1,1,n)) !qq~ | |
3896 | * +aks*(psbori(s,t,1,2,n)+psbori(s,s-t,1,2,n))*(naflav-1)*2.!qq' | |
3897 | else | |
3898 | psjetj=akg*(psbori(s,t,0,1,n)+psbori(s,s-t,0,1,n)) !gq | |
3899 | * +aks*(psbori(s,t,1,1,n)+psbori(s,s-t,1,1,n))/2. !qq | |
3900 | * +aks*(psbori(s,t,-1,1,n)+psbori(s,s-t,-1,1,n)) !qq~ | |
3901 | * +(akns+aks*(naflav-1)*2.)* | |
3902 | * (psbori(s,t,1,2,n)+psbori(s,s-t,1,2,n)) !qq' | |
3903 | endif | |
3904 | endif | |
3905 | elseif(n.eq.1)then | |
3906 | p1=s/(1.+qcmass**2/s) | |
3907 | psjetj=psevi(q1,scale,xx,m,1)*(psbori(s,t,4,0,n)+ !cg | |
3908 | * psbori(s,p1-t,4,0,n)) | |
3909 | * +psevi(q1,scale,xx,m,2)*(psbori(s,t,4,1,n)+ !cq | |
3910 | * psbori(s,p1-t,4,1,n)) | |
3911 | else | |
3912 | psjetj=0. | |
3913 | endif | |
3914 | return | |
3915 | end | |
3916 | ||
3917 | c------------------------------------------------------------------------ | |
3918 | function psjti(q1,qqcut,s,m1,l1,jdis) | |
3919 | c----------------------------------------------------------------------- | |
3920 | c psjti - inclusive hard cross-section interpolation - for any ordering | |
3921 | c in the ladder | |
3922 | c q1 - virtuality cutoff at current end of the ladder | |
3923 | c qqcut - p_t cutoff for the born process; | |
3924 | c s - total c.m. energy squared for the ladder | |
3925 | c m1 - parton type at current end of the ladder (0-g, 1,2,etc.-q) | |
3926 | c l1 - parton type at opposite end of the ladder (0-g, 1,2,etc.-q) | |
3927 | c----------------------------------------------------------------------- | |
3928 | dimension wi(3),wj(3),wk(3) | |
3929 | common /psar2/ edmax,epmax | |
3930 | common /psar19/ cstot(20,20,240) | |
3931 | include 'epos.incsem' | |
3932 | ||
3933 | psjti=0. | |
3934 | c jdis1=jdis | |
3935 | if(jdis.eq.0)then | |
3936 | qqmin=q1 | |
3937 | qmax=s/4. | |
3938 | else | |
3939 | qqmin=max(q2min,q1/4.) | |
3940 | qmax=s | |
3941 | endif | |
3942 | qq=max(qqmin,qqcut) | |
3943 | spmin=4.*q2min | |
3944 | s2min=4.*qq | |
3945 | if(s.le.s2min)return | |
3946 | ||
3947 | if(jdis.eq.0)then | |
3948 | smins=s2min/(1.-q2ini/qq) | |
3949 | else | |
3950 | smins=s2min/(1.-q2ini/qq/4.) | |
3951 | endif | |
3952 | if(s.le.smins)goto 1 | |
3953 | ||
3954 | if(s.gt.4.*qq)then | |
3955 | tmin=2.*qq/(1.+sqrt(1.-4.*qq/s)) | |
3956 | else | |
3957 | tmin=2.*qq | |
3958 | endif | |
3959 | tmax=s/2. | |
3960 | ||
3961 | if(m1.ne.0.and.m1.eq.l1)then | |
3962 | m=2 | |
3963 | l=2 | |
3964 | elseif(m1.ne.0.and.m1.eq.-l1)then | |
3965 | m=3 | |
3966 | l=1 | |
3967 | elseif(m1.ne.0.and.l1.ne.0.and.m1.ne.l1)then | |
3968 | m=3 | |
3969 | l=2 | |
3970 | else | |
3971 | m=min(1,iabs(m1))+1 | |
3972 | l=min(1,iabs(l1))+1 | |
3973 | endif | |
3974 | ||
3975 | ml=20*(m-1)+60*(l-1)+120*jdis | |
3976 | qli=log(q1/q2min)/log(qmax/q2min)*19.+1. | |
3977 | qlj=log(qq/qqmin)/log(s/4./qqmin)*19.+1. | |
3978 | sl=log(s/spmin)/log(epmax/2./spmin)*19.+1. | |
3979 | k=int(sl) | |
3980 | i=int(qli) | |
3981 | j=int(qlj) | |
3982 | if(j.lt.1)j=1 | |
3983 | if(i.lt.1)i=1 | |
3984 | if(k.gt.18)k=18 | |
3985 | if(i.gt.18)i=18 | |
3986 | if(j.gt.18)j=18 | |
3987 | ||
3988 | wi(2)=qli-i | |
3989 | wi(3)=wi(2)*(wi(2)-1.)*.5 | |
3990 | wi(1)=1.-wi(2)+wi(3) | |
3991 | wi(2)=wi(2)-2.*wi(3) | |
3992 | ||
3993 | wj(2)=qlj-j | |
3994 | wj(3)=wj(2)*(wj(2)-1.)*.5 | |
3995 | wj(1)=1.-wj(2)+wj(3) | |
3996 | wj(2)=wj(2)-2.*wj(3) | |
3997 | ||
3998 | wk(2)=sl-k | |
3999 | wk(3)=wk(2)*(wk(2)-1.)*.5 | |
4000 | wk(1)=1.-wk(2)+wk(3) | |
4001 | wk(2)=wk(2)-2.*wk(3) | |
4002 | ||
4003 | do i1=1,3 | |
4004 | do j1=1,3 | |
4005 | do k1=1,3 | |
4006 | psjti=psjti+cstot(i+i1-1,j+j1-1,k+k1+ml-1) | |
4007 | * *wi(i1)*wj(j1)*wk(k1) | |
4008 | enddo | |
4009 | enddo | |
4010 | enddo | |
4011 | psjti=exp(psjti)*(1./tmin-1./tmax) | |
4012 | return | |
4013 | 1 continue | |
4014 | psjti=psbint(q1,q2min,qqcut,s,m1,l1,jdis) | |
4015 | return | |
4016 | end | |
4017 | ||
4018 | c------------------------------------------------------------------------ | |
4019 | subroutine psjti0(ss,sj,sjb,m1,l1) | |
4020 | c----------------------------------------------------------------------- | |
4021 | c psjti0 - inclusive hard cross-section interpolation - | |
4022 | c for minimal virtuality cutoff in the ladder | |
4023 | c s - total c.m. energy squared for the ladder, | |
4024 | c sj - inclusive jet cross-section, | |
4025 | c sjb - born cross-section, | |
4026 | c m1 - parton type at current end of the ladder (0-g, 1,2,etc.-q) | |
4027 | c l1 - parton type at opposite end of the ladder (0-g, 1,2,etc.-q) | |
4028 | c----------------------------------------------------------------------- | |
4029 | dimension wk(3) | |
4030 | common /psar2/ edmax,epmax | |
4031 | common /psar22/ cstotzero(20,4,2),csborzer(20,4,2) | |
4032 | include 'epos.incsem' | |
4033 | ||
4034 | sj=0. | |
4035 | sjb=0. | |
4036 | if(iabs(m1).ne.4)then | |
4037 | q2mass=0. | |
4038 | if(m1.ne.0.and.m1.eq.l1)then | |
4039 | m=2 | |
4040 | l=2 | |
4041 | elseif(m1.ne.0.and.m1.eq.-l1)then | |
4042 | m=3 | |
4043 | l=1 | |
4044 | elseif(m1.ne.0.and.l1.ne.0.and.m1.ne.l1)then | |
4045 | m=3 | |
4046 | l=2 | |
4047 | else | |
4048 | m=min(1,iabs(m1))+1 | |
4049 | l=min(1,iabs(l1))+1 | |
4050 | endif | |
4051 | else | |
4052 | q2mass=qcmass**2 | |
4053 | m=4 | |
4054 | l=min(1,iabs(l1))+1 | |
4055 | endif | |
4056 | s=ss-q2mass | |
4057 | qq=q2min | |
4058 | spmin=4.*qq+q2mass | |
4059 | if(s.le.spmin)return | |
4060 | ||
4061 | p1=s/(1.+q2mass/s) | |
4062 | if(p1.gt.4.*qq)then | |
4063 | tmin=2.*qq/(1.+sqrt(1.-4.*qq/p1)) | |
4064 | else | |
4065 | tmin=2.*qq | |
4066 | endif | |
4067 | tmax=.5*p1 | |
4068 | ||
4069 | sl=log(s/spmin)/log(epmax/2./spmin)*19.+1. | |
4070 | k=int(sl) | |
4071 | if(k.gt.18)k=18 | |
4072 | wk(2)=sl-k | |
4073 | wk(3)=wk(2)*(wk(2)-1.)*.5 | |
4074 | wk(1)=1.-wk(2)+wk(3) | |
4075 | wk(2)=wk(2)-2.*wk(3) | |
4076 | ||
4077 | do k1=1,3 | |
4078 | sj=sj+cstotzero(k+k1-1,m,l)*wk(k1) | |
4079 | sjb=sjb+csborzer(k+k1-1,m,l)*wk(k1) | |
4080 | enddo | |
4081 | ||
4082 | sjb=exp(sjb)*(1./tmin-1./tmax) | |
4083 | sj=max(sjb,exp(sj)*(1./tmin-1./tmax)) | |
4084 | return | |
4085 | end | |
4086 | ||
4087 | c------------------------------------------------------------------------ | |
4088 | function psjti1(q1,q2,qqcut,s,m1,l1,jdis) | |
4089 | c----------------------------------------------------------------------- | |
4090 | c psjti1 - inclusive hard cross-section interpolation - for strict order | |
4091 | c in the ladder | |
4092 | c q1 - virtuality cutoff at current end of the ladder | |
4093 | c q2 - virtuality cutoff at opposite end of the ladder | |
4094 | c qqcut - p_t cutoff for the born process; | |
4095 | c s - total c.m. energy squared for the ladder, | |
4096 | c m1 - parton type at current end of the ladder (0-g, 1,2,etc.-q) | |
4097 | c l1 - parton type at opposite end of the ladder (0-g, 1,2,etc.-q) | |
4098 | c----------------------------------------------------------------------- | |
4099 | dimension wi(3),wj(3),wk(3) | |
4100 | common /psar2/ edmax,epmax | |
4101 | common /psar20/ csord(20,20,240) | |
4102 | include 'epos.incsem' | |
4103 | double precision psuds | |
4104 | ||
4105 | psjti1=0. | |
4106 | if(jdis.eq.0)then | |
4107 | qqmin=max(q1,q2) | |
4108 | else | |
4109 | qqmin=max(q1,q2/4.) | |
4110 | endif | |
4111 | qq=max(qqmin,qqcut) | |
4112 | spmin=4.*q2min | |
4113 | s2min=4.*qq | |
4114 | if(s.le.s2min)return | |
4115 | ||
4116 | smins=s2min/(1.-q2ini/qq) | |
4117 | if(s.le.smins)goto 1 | |
4118 | ||
4119 | if(s.gt.4.*qq)then | |
4120 | tmin=2.*qq/(1.+sqrt(1.-4.*qq/s)) | |
4121 | else | |
4122 | tmin=2.*qq | |
4123 | endif | |
4124 | tmax=s/2. | |
4125 | ||
4126 | if(m1.ne.0.and.m1.eq.l1)then | |
4127 | m=2 | |
4128 | l=2 | |
4129 | elseif(m1.ne.0.and.m1.eq.-l1)then | |
4130 | m=3 | |
4131 | l=1 | |
4132 | elseif(m1.ne.0.and.l1.ne.0.and.m1.ne.l1)then | |
4133 | m=3 | |
4134 | l=2 | |
4135 | else | |
4136 | m=min(1,iabs(m1))+1 | |
4137 | l=min(1,iabs(l1))+1 | |
4138 | endif | |
4139 | ||
4140 | ml=20*(m-1)+60*(l-1)+120*jdis | |
4141 | qli=log(q1/q2min)/log(s/4./q2min)*19.+1. | |
4142 | qlj=log(qq/qqmin)/log(s/4./qqmin)*19.+1. | |
4143 | sl=log(s/spmin)/log(epmax/2./spmin)*19.+1. | |
4144 | k=int(sl) | |
4145 | i=int(qli) | |
4146 | j=int(qlj) | |
4147 | if(j.lt.1)j=1 | |
4148 | if(i.lt.1)i=1 | |
4149 | if(k.gt.18)k=18 | |
4150 | if(i.gt.18)i=18 | |
4151 | if(j.gt.18)j=18 | |
4152 | ||
4153 | wi(2)=qli-i | |
4154 | wi(3)=wi(2)*(wi(2)-1.)*.5 | |
4155 | wi(1)=1.-wi(2)+wi(3) | |
4156 | wi(2)=wi(2)-2.*wi(3) | |
4157 | ||
4158 | wj(2)=qlj-j | |
4159 | wj(3)=wj(2)*(wj(2)-1.)*.5 | |
4160 | wj(1)=1.-wj(2)+wj(3) | |
4161 | wj(2)=wj(2)-2.*wj(3) | |
4162 | ||
4163 | wk(2)=sl-k | |
4164 | wk(3)=wk(2)*(wk(2)-1.)*.5 | |
4165 | wk(1)=1.-wk(2)+wk(3) | |
4166 | wk(2)=wk(2)-2.*wk(3) | |
4167 | ||
4168 | do i1=1,3 | |
4169 | do j1=1,3 | |
4170 | do k1=1,3 | |
4171 | k2=k+k1+ml-1 | |
4172 | psjti1=psjti1+csord(i+i1-1,j+j1-1,k2) | |
4173 | * *wi(i1)*wj(j1)*wk(k1) | |
4174 | enddo | |
4175 | enddo | |
4176 | enddo | |
4177 | psjti1=exp(psjti1)*(1./tmin-1./tmax) | |
4178 | ||
4179 | if(jdis.eq.0.and.qq.gt.q2)then | |
4180 | psjti1=psjti1*sngl(psuds(qq,l1)/psuds(q2,l1)) | |
4181 | elseif(jdis.eq.1.and.4.*qq.gt.q2)then | |
4182 | psjti1=psjti1*sngl(psuds(4.*qq,l1)/psuds(q2,l1)) | |
4183 | endif | |
4184 | return | |
4185 | 1 continue | |
4186 | if(jdis.eq.0)then | |
4187 | psjti1=psbint(q1,q2,qqcut,s,m1,l1,0) | |
4188 | else | |
4189 | psjti1=psbint(q2,q1,qqcut,s,l1,m1,1) | |
4190 | endif | |
4191 | return | |
4192 | end | |
4193 | ||
4194 | c------------------------------------------------------------------------ | |
4195 | function pspdfg(xx,qqs,qq,iclpro0,j) | |
4196 | c----------------------------------------------------------------------- | |
4197 | c pspdf - parton distribution function | |
4198 | c qq - virtuality scale | |
4199 | c qqs - initial virtuality for the input distributions | |
4200 | c iclpro0 - hadron class | |
4201 | c j - parton type | |
4202 | c----------------------------------------------------------------------- | |
4203 | double precision z | |
4204 | common/ar3/ x1(7),a1(7) | |
4205 | include 'epos.incsem' | |
4206 | double precision psuds | |
4207 | ||
4208 | pspdfg=psdfh4(xx,qqs,0.,iclpro0,j) | |
4209 | if(j.gt.0)pspdfg=pspdfg+psdfh4(xx,qqs,0.,iclpro0,-j) !+sea contr. | |
4210 | pspdfg=pspdfg*sngl(psuds(qq,j)/psuds(qqs,j)) | |
4211 | ||
4212 | xmin=xx/(1.-q2ini/qq) | |
4213 | if(xmin.ge.1.)return | |
4214 | ||
4215 | dpd1=0. | |
4216 | dpd2=0. | |
4217 | xm=max(xmin,.3) | |
4218 | do i=1,7 !numerical integration over zx | |
4219 | do m=1,2 | |
4220 | zx=1.-(1.-xm)*(.5+(m-1.5)*x1(i))**.25 | |
4221 | z=xx/zx | |
4222 | ||
4223 | if(j.eq.0)then | |
4224 | aks=psevi(qqs,qq,z,2,1) !quark contribution | |
4225 | akg=psevi(qqs,qq,z,1,1) !gluon contribution | |
4226 | akns=0. | |
4227 | else | |
4228 | akg=psevi(qqs,qq,z,1,2)/naflav/2. !gluon contribution | |
4229 | akns=psevi(qqs,qq,z,3,2) !nonsinglet contribution | |
4230 | aks=(psevi(qqs,qq,z,2,2)-akns)/naflav/2. !quark contribution | |
4231 | endif | |
4232 | ||
4233 | fz=akg*psdfh4(zx,qqs,0.,iclpro0,0) | |
4234 | * +akns*psdfh4(zx,qqs,0.,iclpro0,j) | |
4235 | * +aks*(psdfh4(zx,qqs,0.,iclpro0,1)+ | |
4236 | * 2.*psdfh4(zx,qqs,0.,iclpro0,-1) | |
4237 | * +psdfh4(zx,qqs,0.,iclpro0,2)+2.*psdfh4(zx,qqs,0.,iclpro0,-2) | |
4238 | * +2.*psdfh4(zx,qqs,0.,iclpro0,-3)) | |
4239 | if(j.gt.0)fz=fz+akns*psdfh4(zx,qqs,0.,iclpro0,-j) | |
4240 | ||
4241 | dpd1=dpd1+a1(i)*fz/zx**2/(1.-zx)**3 | |
4242 | enddo | |
4243 | enddo | |
4244 | dpd1=dpd1*(1.-xm)**4/8.*xx | |
4245 | ||
4246 | if(xm.gt.xmin)then | |
4247 | do i=1,7 !numerical integration | |
4248 | do m=1,2 | |
4249 | zx=xx+(xm-xx)*((xmin-xx)/(xm-xx))**(.5-(m-1.5)*x1(i)) | |
4250 | z=xx/zx | |
4251 | ||
4252 | if(j.eq.0)then | |
4253 | aks=psevi(qqs,qq,z,2,1) !quark contribution | |
4254 | akg=psevi(qqs,qq,z,1,1) !gluon contribution | |
4255 | akns=0. | |
4256 | else | |
4257 | akg=psevi(qqs,qq,z,1,2)/naflav/2. !gluon contribution | |
4258 | akns=psevi(qqs,qq,z,3,2) !nonsinglet contribution | |
4259 | aks=(psevi(qqs,qq,z,2,2)-akns)/naflav/2. !quark contribution | |
4260 | endif | |
4261 | ||
4262 | fz=akg*psdfh4(zx,qqs,0.,iclpro0,0) | |
4263 | * +akns*psdfh4(zx,qqs,0.,iclpro0,j) | |
4264 | * +aks*(psdfh4(zx,qqs,0.,iclpro0,1) | |
4265 | * +2.*psdfh4(zx,qqs,0.,iclpro0,-1) | |
4266 | * +psdfh4(zx,qqs,0.,iclpro0,2)+2.*psdfh4(zx,qqs,0.,iclpro0,-2) | |
4267 | * +2.*psdfh4(zx,qqs,0.,iclpro0,-3)) | |
4268 | if(j.gt.0)fz=fz+akns*psdfh4(zx,qqs,0.,iclpro0,-j) | |
4269 | ||
4270 | dpd2=dpd2+a1(i)*fz*(1.-xx/zx)/zx | |
4271 | enddo | |
4272 | enddo | |
4273 | dpd2=dpd2*log((xm-xx)/(xmin-xx))*.5*xx | |
4274 | endif | |
4275 | pspdfg=pspdfg+dpd2+dpd1 | |
4276 | return | |
4277 | end | |
4278 | ||
4279 | c----------------------------------------------------------------------- | |
4280 | subroutine psaevp | |
4281 | c----------------------------------------------------------------------- | |
4282 | include 'epos.inc' | |
4283 | include 'epos.incsem' | |
4284 | qq=xpar1 | |
4285 | jmod=nint(xpar2) | |
4286 | iologb=1 | |
4287 | ||
4288 | if(jmod.eq.0)then !??????????????ttttttt | |
4289 | write(*,*)"no more triple Pomeron, xpar2=0 in psaevp not accepted" | |
4290 | write(*,*)"use xpar2=1 instead" | |
4291 | jmod=1 | |
4292 | endif | |
4293 | ||
4294 | do i=1,nrbins | |
4295 | if(iologb.eq.0)then | |
4296 | xx=xminim+(xmaxim-xminim)*(i-.5)/nrbins | |
4297 | else | |
4298 | xx=xminim*(xmaxim/xminim)**((i-.5)/nrbins) | |
4299 | endif | |
4300 | ar(i,1)=xx | |
4301 | ar(i,2)=0. | |
4302 | if(jmod.eq.0)then !evolution+matrix element +3P (ours) | |
4303 | ww=qq/xx | |
4304 | ar(i,3)=(psdh(ww,qq,2,0)+psdh(ww,qq,2,1)+ | |
4305 | * psdsh1(ww,qq,2,dqsh,0)+psdsh1(ww,qq,2,dqsh,1) | |
4306 | * )/(4.*pi**2*alfe)*qq | |
4307 | elseif(jmod.eq.1)then !evolution+matrix element (ours) | |
4308 | ww=qq/xx | |
4309 | ar(i,3)=(psdh(ww,qq,2,0)+psdh(ww,qq,2,1)+ | |
4310 | * psdsh(ww,qq,2,dqsh,0)+psdsh(ww,qq,2,dqsh,1) | |
4311 | * )/(4.*pi**2*alfe)*qq | |
4312 | elseif(jmod.eq.2)then !just evolution (grv) | |
4313 | ar(i,3)=(pspdfg(xx,q2min,qq,2,1)/2.25+ | |
4314 | * pspdfg(xx,q2min,qq,2,2)/9.+ | |
4315 | * pspdfg(xx,q2min,qq,2,-1)*2./3.6+ | |
4316 | * pspdfg(xx,q2min,qq,2,-3)*2./9.) | |
4317 | if(naflav.eq.4)ar(i,3)=ar(i,3)+pspdfg(xx,q2min,qq,2,-4) | |
4318 | * *2./2.25 | |
4319 | elseif(jmod.eq.3)then !grv | |
4320 | ar(i,3)=(psdfh4(xx,qq,0.,2,1)+2.*psdfh4(xx,qq,0.,2,-1))/2.25 | |
4321 | * +(psdfh4(xx,qq,0.,2,2)+2.*psdfh4(xx,qq,0.,2,-2))/9. | |
4322 | * +2.*psdfh4(xx,qq,0.,2,-3)/9. ! | |
4323 | elseif(jmod.eq.4)then !just evolution (ours) | |
4324 | ar(i,3)=(fparton(xx,qq,1)/2.25+fparton(xx,qq,2)/9.+ | |
4325 | * fparton(xx,qq,-1)*6./4.5) !uv+dv+6*sea | |
4326 | if(naflav.eq.4)ar(i,3)=ar(i,3)+fparton(xx,qq,-4)*2./2.25 | |
4327 | elseif(jmod.eq.5)then !grv+res | |
4328 | ww=qq/xx | |
4329 | ar(i,3)=(psdgh(ww,qq,0)+psdgh(ww,qq,1) | |
4330 | * )/(4.*pi**2*alfe)*qq | |
4331 | endif | |
4332 | ar(i,4)=0. | |
4333 | enddo | |
4334 | return | |
4335 | end | |
4336 | ||
4337 | c------------------------------------------------------------------------ | |
4338 | subroutine pscs(c,s) | |
4339 | c----------------------------------------------------------------------- | |
4340 | c pscs - cos (c) and sin (s) generation for uniformly distributed angle | |
4341 | c----------------------------------------------------------------------- | |
4342 | 1 s1=2.*rangen()-1. | |
4343 | s2=2.*rangen()-1. | |
4344 | s3=s1*s1+s2*s2 | |
4345 | if(s3.gt.1.)goto 1 | |
4346 | s3=sqrt(s3) | |
4347 | c=s1/s3 | |
4348 | s=s2/s3 | |
4349 | return | |
4350 | end | |
4351 | ||
4352 | c------------------------------------------------------------------------ | |
4353 | subroutine psdefrot(ep,s0x,c0x,s0,c0) | |
4354 | c----------------------------------------------------------------------- | |
4355 | c psdefrot - determination of the parameters the spacial rotation to the | |
4356 | c system for 4-vector ep | |
4357 | c s0, c0 - sin and cos for the zx-rotation; | |
4358 | c s0x, c0x - sin and cos for the xy-rotation | |
4359 | c----------------------------------------------------------------------- | |
4360 | dimension ep(4) | |
4361 | ||
4362 | c transverse momentum square for the current parton (ep) | |
4363 | pt2=ep(3)**2+ep(4)**2 | |
4364 | if(pt2.ne.0.)then | |
4365 | pt=sqrt(pt2) | |
4366 | c system rotation to get pt=0 - euler angles are determined (c0x = cos t | |
4367 | c s0x = sin theta, c0 = cos phi, s0 = sin phi) | |
4368 | c0x=ep(3)/pt | |
4369 | s0x=ep(4)/pt | |
4370 | c total momentum for the gluon | |
4371 | pl=sqrt(pt2+ep(2)**2) | |
4372 | s0=pt/pl | |
4373 | c0=ep(2)/pl | |
4374 | else | |
4375 | c0x=1. | |
4376 | s0x=0. | |
4377 | pl=abs(ep(2)) | |
4378 | s0=0. | |
4379 | c0=ep(2)/pl | |
4380 | endif | |
4381 | ||
4382 | ep(2)=pl | |
4383 | ep(3)=0. | |
4384 | ep(4)=0. | |
4385 | return | |
4386 | end | |
4387 | ||
4388 | c------------------------------------------------------------------------ | |
4389 | subroutine psdeftr(s,ep,ey) | |
4390 | c----------------------------------------------------------------------- | |
4391 | c psdeftr - determination of the parameters for the lorentz transform to | |
4392 | c rest frame system for 4-vector ep of mass squared s | |
4393 | c----------------------------------------------------------------------- | |
4394 | dimension ey(3) | |
4395 | double precision ep(4) | |
4396 | ||
4397 | do i=1,3 | |
4398 | if(ep(i+1).eq.0.d0)then | |
4399 | ey(i)=1. | |
4400 | else | |
4401 | wp=ep(1)+ep(i+1) | |
4402 | wm=ep(1)-ep(i+1) | |
4403 | if(wp.gt.1.e-8.and.wm/wp.lt.1.e-8)then | |
4404 | ww=s | |
4405 | do l=1,3 | |
4406 | if(l.ne.i)ww=ww+ep(l+1)**2 | |
4407 | enddo | |
4408 | wm=ww/wp | |
4409 | elseif(wm.gt.1.e-8.and.wp/wm.lt.1.e-8)then | |
4410 | ww=s | |
4411 | do l=1,3 | |
4412 | if(l.ne.i)ww=ww+ep(l+1)**2 | |
4413 | enddo | |
4414 | wp=ww/wm | |
4415 | endif | |
4416 | ey(i)=sqrt(wm/wp) | |
4417 | ep(1)=wp*ey(i) | |
4418 | ep(i+1)=0. | |
4419 | endif | |
4420 | enddo | |
4421 | ep(1)=dsqrt(dble(s)) | |
4422 | return | |
4423 | end | |
4424 | ||
4425 | c------------------------------------------------------------------------ | |
4426 | function psdfh4(x,qqs,qq,icq,iq) | |
4427 | c------------------------------------------------------------------------ | |
4428 | c psdfh4 - GRV structure functions | |
4429 | c------------------------------------------------------------------------ | |
4430 | common /psar36/ alvc | |
4431 | ||
4432 | if(x.gt..99999)then | |
4433 | psdfh4=0. | |
4434 | return | |
4435 | endif | |
4436 | if(icq.eq.2)then | |
4437 | sq=log(log(qqs/.232**2)/log(.23/.232**2)) | |
4438 | if(iq.eq.0)then !gluon | |
4439 | alg=.524 | |
4440 | betg=1.088 | |
4441 | aag=1.742-.93*sq | |
4442 | bbg=-.399*sq**2 | |
4443 | ag=7.486-2.185*sq | |
4444 | bg=16.69-22.74*sq+5.779*sq*sq | |
4445 | cg=-25.59+29.71*sq-7.296*sq*sq | |
4446 | dg=2.792+2.215*sq+.422*sq*sq-.104*sq*sq*sq | |
4447 | eg=.807+2.005*sq | |
4448 | eeg=3.841+.361*sq | |
4449 | psdfh4=(1.-x)**dg*(x**aag*(ag+bg*x+cg*x**2)*log(1./x)**bbg | |
4450 | * +sq**alg*exp(-eg+sqrt(eeg*sq**betg*log(1./x)))) | |
4451 | elseif(iq.eq.1.or.iq.eq.2)then !u_v or d_v | |
4452 | aau=.59-.024*sq | |
4453 | bbu=.131+.063*sq | |
4454 | auu=2.284+.802*sq+.055*sq*sq | |
4455 | au=-.449-.138*sq-.076*sq*sq | |
4456 | bu=.213+2.669*sq-.728*sq*sq | |
4457 | cu=8.854-9.135*sq+1.979*sq*sq | |
4458 | du=2.997+.753*sq-.076*sq*sq | |
4459 | uv=auu*x**aau*(1.-x)**du* | |
4460 | * (1.+au*x**bbu+bu*x+cu*x**1.5) | |
4461 | ||
4462 | aad=.376 | |
4463 | bbd=.486+.062*sq | |
4464 | add=.371+.083*sq+.039*sq*sq | |
4465 | ad=-.509+3.31*sq-1.248*sq*sq | |
4466 | bd=12.41-10.52*sq+2.267*sq*sq | |
4467 | ccd=6.373-6.208*sq+1.418*sq*sq | |
4468 | dd=3.691+.799*sq-.071*sq*sq | |
4469 | dv=add*x**aad*(1.-x)**dd* | |
4470 | * (1.+ad*x**bbd+bd*x+ccd*x**1.5) | |
4471 | ||
4472 | if(iq.eq.1)then !u_v | |
4473 | psdfh4=uv | |
4474 | elseif(iq.eq.2)then !d_v | |
4475 | psdfh4=dv | |
4476 | endif | |
4477 | elseif(iq.eq.-3)then !s_sea | |
4478 | als=.914 | |
4479 | bets=.577 | |
4480 | aas=1.798-.596*sq | |
4481 | as=-5.548+3.669*sqrt(sq)-.616*sq | |
4482 | bs=18.92-16.73*sqrt(sq)+5.168*sq | |
4483 | ds=6.379-.35*sq+.142*sq*sq | |
4484 | es=3.981+1.638*sq | |
4485 | ees=6.402 | |
4486 | psdfh4=(1.-x)**ds*sq**als/log(1./x)**aas*(1.+as*sqrt(x) | |
4487 | * +bs*x)*exp(-es+sqrt(ees*sq**bets*log(1./x))) | |
4488 | elseif(iabs(iq).lt.3)then !u_sea or d_sea | |
4489 | aadel=.409-.005*sq | |
4490 | bbdel=.799+.071*sq | |
4491 | addel=.082+.014*sq+.008*sq*sq | |
4492 | adel=-38.07+36.13*sq-.656*sq*sq | |
4493 | bdel=90.31-74.15*sq+7.645*sq*sq | |
4494 | ccdel=0. | |
4495 | ddel=7.486+1.217*sq-.159*sq*sq | |
4496 | delv=addel*x**aadel*(1.-x)**ddel* | |
4497 | * (1.+adel*x**bbdel+bdel*x+ccdel*x**1.5) | |
4498 | ||
4499 | alud=1.451 | |
4500 | betud=.271 | |
4501 | aaud=.41-.232*sq | |
4502 | bbud=.534-.457*sq | |
4503 | aud=.89-.14*sq | |
4504 | bud=-.981 | |
4505 | cud=.32+.683*sq | |
4506 | dud=4.752+1.164*sq+.286*sq*sq | |
4507 | eud=4.119+1.713*sq | |
4508 | eeud=.682+2.978*sq | |
4509 | udsea=(1.-x)**dud*(x**aaud*(aud+bud*x+cud*x**2) | |
4510 | * *log(1./x)**bbud+sq**alud*exp(-eud+sqrt(eeud*sq**betud* | |
4511 | * log(1./x)))) | |
4512 | ||
4513 | if(iq.eq.-1)then !u_sea | |
4514 | psdfh4=(udsea-delv)/2. | |
4515 | elseif(iq.eq.-2)then !d_sea | |
4516 | psdfh4=(udsea+delv)/2. | |
4517 | endif | |
4518 | else | |
4519 | psdfh4=0. | |
4520 | endif | |
4521 | elseif(icq.eq.1.or.icq.eq.3)then | |
4522 | sq=log(log(qqs/.204**2)/log(.26/.204**2)) | |
4523 | if(iq.eq.1.or.iq.eq.2)then | |
4524 | aapi=.517-.02*sq | |
4525 | api=-.037-.578*sq | |
4526 | bpi=.241+.251*sq | |
4527 | dpi=.383+.624*sq | |
4528 | anorm=1.212+.498*sq+.009*sq**2 | |
4529 | psdfh4=.5*anorm*x**aapi*(1.-x)**dpi* | |
4530 | * (1.+api*sqrt(x)+bpi*x) | |
4531 | elseif(iq.eq.0)then | |
4532 | alfpi=.504 | |
4533 | betpi=.226 | |
4534 | aapi=2.251-1.339*sqrt(sq) | |
4535 | api=2.668-1.265*sq+.156*sq**2 | |
4536 | bbpi=0. | |
4537 | bpi=-1.839+.386*sq | |
4538 | cpi=-1.014+.92*sq-.101*sq**2 | |
4539 | dpi=-.077+1.466*sq | |
4540 | epi=1.245+1.833*sq | |
4541 | eppi=.51+3.844*sq | |
4542 | psdfh4=(1.-x)**dpi*(x**aapi*(api+bpi*sqrt(x)+cpi*x)* | |
4543 | * log(1./x)**bbpi+sq**alfpi* | |
4544 | * exp(-epi+sqrt(eppi*sq**betpi*log(1./x)))) | |
4545 | elseif(iq.eq.-3)then | |
4546 | alfpi=.823 | |
4547 | betpi=.65 | |
4548 | aapi=1.036-.709*sq | |
4549 | api=-1.245+.713*sq | |
4550 | bpi=5.58-1.281*sq | |
4551 | dpi=2.746-.191*sq | |
4552 | epi=5.101+1.294*sq | |
4553 | eppi=4.854-.437*sq | |
4554 | psdfh4=sq**alfpi/log(1./x)**aapi*(1.-x)**dpi* | |
4555 | * (1.+api*sqrt(x)+bpi*x)* | |
4556 | * exp(-epi+sqrt(eppi*sq**betpi*log(1./x))) | |
4557 | elseif(iabs(iq).lt.3)then | |
4558 | alfpi=1.147 | |
4559 | betpi=1.241 | |
4560 | aapi=.309-.134*sqrt(sq) | |
4561 | api=.219-.054*sq | |
4562 | bbpi=.893-.264*sqrt(sq) | |
4563 | bpi=-.593+.24*sq | |
4564 | cpi=1.1-.452*sq | |
4565 | dpi=3.526+.491*sq | |
4566 | epi=4.521+1.583*sq | |
4567 | eppi=3.102 | |
4568 | psdfh4=(1.-x)**dpi*(x**aapi*(api+bpi*sqrt(x)+cpi*x)* | |
4569 | * log(1./x)**bbpi+sq**alfpi* | |
4570 | * exp(-epi+sqrt(eppi*sq**betpi*log(1./x)))) | |
4571 | else | |
4572 | psdfh4=0. | |
4573 | endif | |
4574 | elseif(icq.eq.0)then | |
4575 | sq=log(log(qqs/.204**2)/log(.26/.204**2)) | |
4576 | if(iq.eq.0)then | |
4577 | alfpi=.504 | |
4578 | betpi=.226 | |
4579 | aapi=2.251-1.339*sqrt(sq) | |
4580 | api=2.668-1.265*sq+.156*sq**2 | |
4581 | bbpi=0. | |
4582 | bpi=-1.839+.386*sq | |
4583 | cpi=-1.014+.92*sq-.101*sq**2 | |
4584 | dpi=-.077+1.466*sq | |
4585 | epi=1.245+1.833*sq | |
4586 | eppi=.51+3.844*sq | |
4587 | psdfh4=(1.-x)**dpi*(x**aapi*(api+bpi*sqrt(x)+cpi*x)* | |
4588 | * log(1./x)**bbpi+sq**alfpi* | |
4589 | * exp(-epi+sqrt(eppi*sq**betpi*log(1./x)))) | |
4590 | * *.543 | |
4591 | else | |
4592 | alfpi=.823 | |
4593 | betpi=.65 | |
4594 | aapi=1.036-.709*sq | |
4595 | api=-1.245+.713*sq | |
4596 | bpi=5.58-1.281*sq | |
4597 | dpi=2.746-.191*sq | |
4598 | epi=5.101+1.294*sq | |
4599 | eppi=4.854-.437*sq | |
4600 | str=sq**alfpi/log(1./x)**aapi*(1.-x)**dpi* | |
4601 | * (1.+api*sqrt(x)+bpi*x)* | |
4602 | * exp(-epi+sqrt(eppi*sq**betpi*log(1./x))) | |
4603 | if(iq.eq.3)then | |
4604 | psdfh4=str*.543*2. | |
4605 | else | |
4606 | aapi=.517-.02*sq | |
4607 | api=-.037-.578*sq | |
4608 | bpi=.241+.251*sq | |
4609 | dpi=.383+.624*sq | |
4610 | anorm=1.212+.498*sq+.009*sq**2 | |
4611 | val=.5*anorm*x**aapi*(1.-x)**dpi* | |
4612 | * (1.+api*sqrt(x)+bpi*x) | |
4613 | ||
4614 | alfpi=1.147 | |
4615 | betpi=1.241 | |
4616 | aapi=.309-.134*sqrt(sq) | |
4617 | api=.219-.054*sq | |
4618 | bbpi=.893-.264*sqrt(sq) | |
4619 | bpi=-.593+.24*sq | |
4620 | cpi=1.1-.452*sq | |
4621 | dpi=3.526+.491*sq | |
4622 | epi=4.521+1.583*sq | |
4623 | eppi=3.102 | |
4624 | sea=(1.-x)**dpi*(x**aapi*(api+bpi*sqrt(x)+cpi*x)* | |
4625 | * log(1./x)**bbpi+sq**alfpi* | |
4626 | * exp(-epi+sqrt(eppi*sq**betpi*log(1./x)))) | |
4627 | if(iq.eq.1)then | |
4628 | psdfh4=(.836*(val+2.*sea)-.587*str) | |
4629 | elseif(iq.eq.2)then | |
4630 | psdfh4=(.25*(val+2.*sea)+.587*str) | |
4631 | else | |
4632 | psdfh4=0. | |
4633 | endif | |
4634 | endif | |
4635 | endif | |
4636 | psdfh4=psdfh4/(1.+qq/.59)**2 | |
4637 | ||
4638 | elseif(icq.eq.4.and.iq.eq.1)then | |
4639 | psdfh4=x**3*(1.-x)**alvc*(alvc+3.)*(alvc+2.)*(alvc+1.) | |
4640 | else | |
4641 | psdfh4=0. | |
4642 | endif | |
4643 | return | |
4644 | end | |
4645 | ||
4646 | ||
4647 | c------------------------------------------------------------------------ | |
4648 | function psfap(x,j,l) | |
4649 | c----------------------------------------------------------------------- | |
4650 | c psfap - altarelli-parisi function (multiplied by x) | |
4651 | c x - light cone momentum share value, | |
4652 | c j - type of the parent parton (0-g;1,2,etc.-q) | |
4653 | c l - type of the daughter parton (0-g;1,2,etc.-q) | |
4654 | c----------------------------------------------------------------------- | |
4655 | double precision x | |
4656 | include 'epos.incsem' | |
4657 | ||
4658 | if(j.eq.0)then | |
4659 | if(l.eq.0)then | |
4660 | psfap=((1.d0-x)/x+x/(1.d0-x)+x*(1.d0-x))*6.d0 | |
4661 | else | |
4662 | psfap=(x**2+(1.d0-x)**2)*naflav | |
4663 | endif | |
4664 | else | |
4665 | if(l.eq.0)then | |
4666 | psfap=(1.d0+(1.d0-x)**2)/x/.75d0 | |
4667 | else | |
4668 | psfap=(x**2+1.d0)/(1.d0-x)/.75d0 | |
4669 | endif | |
4670 | endif | |
4671 | return | |
4672 | end | |
4673 | ||
4674 | cc------------------------------------------------------------------------ | |
4675 | c function psgen(a1,a2) | |
4676 | cc----------------------------------------------------------------------- | |
4677 | cc psgen - x-values generation according to distribution | |
4678 | cc x1^(-a1) x2^(-0.5) | |
4679 | cc----------------------------------------------------------------------- | |
4680 | c common/lept1/engy,elepti,elepto,angmue,icinpu | |
4681 | c | |
4682 | c aa=max(a1,a2) | |
4683 | c1 continue | |
4684 | c if(aa.lt.1.)then | |
4685 | c x1=.5*rangen()**(1./(1.-aa)) | |
4686 | c elseif(aa.eq.1.)then | |
4687 | c x1=.5/engy**rangen() | |
4688 | c else | |
4689 | c x1=.5*(1.+rangen()*(engy**(aa-1.)-1.))**(1./(1.-aa)) | |
4690 | c endif | |
4691 | c if(x1.lt.1.e-7.or.x1.gt..999999)then | |
4692 | c goto 1 | |
4693 | c endif | |
4694 | c if(rangen().lt..5)then | |
4695 | c gb=x1**(aa-a1)*.5**aa/(1.-x1)**a2 | |
4696 | c else | |
4697 | c x1=1.-x1 | |
4698 | c gb=(1.-x1)**(aa-a2)*.5**aa/x1**a1 | |
4699 | c endif | |
4700 | c if(rangen().gt.gb)goto 1 | |
4701 | c psgen=x1 | |
4702 | c return | |
4703 | c end | |
4704 | c | |
4705 | c------------------------------------------------------------------------ | |
4706 | function psidd(icc) | |
4707 | c----------------------------------------------------------------------- | |
4708 | c psidd - kink type decoder | |
4709 | c----------------------------------------------------------------------- | |
4710 | if(icc.eq.0)then !g | |
4711 | psidd=9 | |
4712 | elseif(iabs(icc).le.2)then !u,u~,d,d~ | |
4713 | psidd=icc | |
4714 | elseif(iabs(icc).eq.4)then !s,s~ | |
4715 | psidd=icc/4*3 | |
4716 | elseif(iabs(icc).gt.10)then !c,c~ etc. | |
4717 | psidd=icc/10 | |
4718 | elseif(icc.eq.3)then !ud | |
4719 | psidd=1200 | |
4720 | elseif(icc.eq.-3)then !u~d~ | |
4721 | psidd=-1200 | |
4722 | elseif(icc.eq.6)then !uu | |
4723 | psidd=1100 | |
4724 | elseif(icc.eq.-6)then !u~u~ | |
4725 | psidd=-1100 | |
4726 | elseif(icc.eq.7)then !dd | |
4727 | psidd=2200 | |
4728 | elseif(icc.eq.-7)then !d~d~ | |
4729 | psidd=-2200 | |
4730 | else | |
4731 | write (*,*)'psidd?????????',icc | |
4732 | endif | |
4733 | return | |
4734 | end | |
4735 | ||
4736 | cc------------------------------------------------------------------------ | |
4737 | c function pslam(s,a,b) | |
4738 | cc----------------------------------------------------------------------- | |
4739 | cc kinematical function for two particle decay - maximal pt-value | |
4740 | cc a - first particle mass squared, | |
4741 | cc b - second particle mass squared, | |
4742 | cc s - two particle invariant mass squared | |
4743 | cc----------------------------------------------------------------------- | |
4744 | c pslam=.25/s*(s+a-b)**2-a | |
4745 | c return | |
4746 | c end | |
4747 | c | |
4748 | c------------------------------------------------------------------------ | |
4749 | function psjvrg1(qt,s,y0) | |
4750 | c----------------------------------------------------------------------- | |
4751 | common /ar3/ x1(7),a1(7) | |
4752 | common /cnsta/ pi,pii,hquer,prom,piom,ainfin | |
4753 | include 'epos.incsem' | |
4754 | double precision xt,ymin,ymax,y,xmin,xmax,xx1,xx2 | |
4755 | ||
4756 | psjvrg1=0. | |
4757 | if(s.le.4.*qt)return | |
4758 | ||
4759 | xt=2.d0*sqrt(dble(qt)/dble(s)) | |
4760 | ymax=min(dble(y0),log(1d0/xt+sqrt((1d0/xt-1d0)*(1d0/xt+1d0)))) | |
4761 | ymin=-ymax | |
4762 | ||
4763 | do i=1,7 | |
4764 | do m=1,2 | |
4765 | y=.5d0*(ymax+ymin+(ymin-ymax)*dble((2*m-3)*x1(i))) | |
4766 | xmin=xt**2/2.d0/(2.d0-xt*exp(-y)) | |
4767 | xmax=1.d0-xt*exp(y)/2.d0 | |
4768 | ||
4769 | fx=0. | |
4770 | do i1=1,7 | |
4771 | do m1=1,2 | |
4772 | xx1=xt*exp(y)/2d0+xmin*(xmax/xmin)**dble(.5+x1(i1)*(m1-1.5)) | |
4773 | xx2=xt*exp(-y)*xx1/(2.d0*xx1-xt*exp(y)) | |
4774 | z=sngl(xx1*xx2) | |
4775 | sh=z*s | |
4776 | t=sngl(dble(sh)/2d0*(1d0 | |
4777 | & -sqrt(max(0d0,1d0-4d0*dble(qt)/dble(sh))))) | |
4778 | ft=psjvrx(t,qt,sngl(xx1),sngl(xx2),sh) | |
4779 | fx=fx+a1(i1)*ft/sh**2 | |
4780 | enddo | |
4781 | enddo | |
4782 | fx=fx*sngl(log(xmax/xmin)) | |
4783 | psjvrg1=psjvrg1+a1(i)*fx | |
4784 | enddo | |
4785 | enddo | |
4786 | psjvrg1=psjvrg1*sngl(ymax-ymin)*pi**3 | |
4787 | **pssalf(qt/qcdlam)**2*sqrt(qt) | |
4788 | return | |
4789 | end | |
4790 | ||
4791 | c----------------------------------------------------------------------- | |
4792 | function psjvrx(t,qt,xx1,xx2,s) | |
4793 | c----------------------------------------------------------------------- | |
4794 | include 'epos.incsem' | |
4795 | ||
4796 | g1=psdfh4(xx1,qt,0.,2,0) | |
4797 | ub1=psdfh4(xx1,qt,0.,2,-1) | |
4798 | u1=psdfh4(xx1,qt,0.,2,1)+ub1 | |
4799 | db1=psdfh4(xx1,qt,0.,2,-2) | |
4800 | d1=psdfh4(xx1,qt,0.,2,2)+db1 | |
4801 | sb1=psdfh4(xx1,qt,0.,2,-3) | |
4802 | s1=sb1 | |
4803 | g2=psdfh4(xx2,qt,0.,2,0) | |
4804 | ub2=psdfh4(xx2,qt,0.,2,-1) | |
4805 | u2=psdfh4(xx2,qt,0.,2,1)+ub2 | |
4806 | db2=psdfh4(xx2,qt,0.,2,-2) | |
4807 | d2=psdfh4(xx2,qt,0.,2,2)+db2 | |
4808 | sb2=psdfh4(xx2,qt,0.,2,-3) | |
4809 | s2=sb2 | |
4810 | ||
4811 | psjvrx=g1*g2*(psbori(s,t,0,0,1)+psbori(s,s-t,0,0,1) | |
4812 | *+psbori(s,t,0,0,2)+psbori(s,s-t,0,0,2))/2. | |
4813 | *+(psbori(s,t,0,1,1)+psbori(s,s-t,0,1,1))* | |
4814 | *(g2*(u1+ub1+d1+db1+s1+sb1)+g1*(u2+ub2+d2+db2+s2+sb2)) | |
4815 | *+(psbori(s,t,1,1,1)+psbori(s,s-t,1,1,1))/2.* | |
4816 | *(u1*u2+ub1*ub2+d1*d2+db1*db2+s1*s2+sb1*sb2) | |
4817 | *+(psbori(s,t,1,-1,1)+psbori(s,s-t,1,-1,1)+psbori(s,t,1,-1,2)+ | |
4818 | *psbori(s,s-t,1,-1,2)+psbori(s,t,1,-1,3)+psbori(s,s-t,1,-1,3))* | |
4819 | *(u1*ub2+ub1*u2+d1*db2+db1*d2+s1*sb2+sb1*s2) | |
4820 | *+(psbori(s,t,1,2,1)+psbori(s,s-t,1,2,1))* | |
4821 | *((u1+ub1)*(d2+db2+s2+sb2)+(u2+ub2)*(d1+db1+s1+sb1)+ | |
4822 | *(d1+db1)*(u2+ub2+s2+sb2)+(d2+db2)*(u1+ub1+s1+sb1)+ | |
4823 | *(s1+sb1)*(u2+ub2+d2+db2)+(s2+sb2)*(u1+ub1+d1+db1)) | |
4824 | return | |
4825 | end | |
4826 | ||
4827 | c------------------------------------------------------------------------ | |
4828 | function psjwo1(qt,s,y0) | |
4829 | c----------------------------------------------------------------------- | |
4830 | common /ar3/ x1(7),a1(7) | |
4831 | common /cnsta/ pi,pii,hquer,prom,piom,ainfin | |
4832 | double precision xt,ymax,ymin,y,xmin,xmax,xx1,xx2 | |
4833 | include 'epos.incsem' | |
4834 | ||
4835 | psjwo1=0. | |
4836 | if(s.le.4.*qt)return | |
4837 | ||
4838 | xt=2.d0*sqrt(dble(qt)/dble(s)) | |
4839 | ymax=min(dble(y0),log(1d0/xt+sqrt((1d0/xt-1d0)*(1d0/xt+1d0)))) | |
4840 | ymin=-ymax | |
4841 | ||
4842 | do i=1,7 | |
4843 | do m=1,2 | |
4844 | y=.5d0*(ymax+ymin+(ymin-ymax)*dble(2*m-3)*dble(x1(i))) | |
4845 | xmin=xt**2/2.d0/(2.d0-xt*exp(-y)) | |
4846 | xmax=1.d0-xt*exp(y)/2.d0 | |
4847 | ||
4848 | fx=0. | |
4849 | do i1=1,7 | |
4850 | do m1=1,2 | |
4851 | xx1=xt*exp(y)/2.d0+xmin*(xmax/xmin)**dble(.5+x1(i1)*(m1-1.5)) | |
4852 | xx2=xt*exp(-y)/(2.d0-xt*exp(y)/xx1) | |
4853 | z=sngl(xx1*xx2) | |
4854 | sh=z*s | |
4855 | t=sngl(dble(sh)/2d0*(1d0-sqrt(1d0-4d0*dble(qt)/dble(sh)))) | |
4856 | ft=psjwox(t,qt,sngl(xx1),sngl(xx2),sh) | |
4857 | fx=fx+a1(i1)*ft/sh**2 | |
4858 | enddo | |
4859 | enddo | |
4860 | fx=fx*log(xmax/xmin) | |
4861 | psjwo1=psjwo1+a1(i)*fx | |
4862 | enddo | |
4863 | enddo | |
4864 | psjwo1=psjwo1*sngl(ymax-ymin)*pi**3 | |
4865 | **pssalf(qt/qcdlam)**2*sqrt(qt) | |
4866 | return | |
4867 | end | |
4868 | ||
4869 | c----------------------------------------------------------------------- | |
4870 | function psjwox(t,qt,xx1,xx2,s) | |
4871 | c----------------------------------------------------------------------- | |
4872 | double precision x,scale,upv1,dnv1,sea1,str1,chm1,gl1, | |
4873 | *upv2,dnv2,sea2,str2,chm2,gl2 | |
4874 | scale=sqrt(qt) | |
4875 | x=xx1 | |
4876 | call strdo1(x,scale,upv1,dnv1,sea1,str1,chm1,gl1) | |
4877 | x=xx2 | |
4878 | call strdo1(x,scale,upv2,dnv2,sea2,str2,chm2,gl2) | |
4879 | ||
4880 | psjwox=gl1*gl2*(psbori(s,t,0,0,1)+psbori(s,s-t,0,0,1) | |
4881 | *+psbori(s,t,0,0,2)+psbori(s,s-t,0,0,2)+psbori(s,t,0,0,3) | |
4882 | *+psbori(s,s-t,0,0,3))/2. | |
4883 | *+(psbori(s,t,0,1,1)+psbori(s,s-t,0,1,1) | |
4884 | *+psbori(s,t,0,1,2)+psbori(s,s-t,0,1,2)+psbori(s,t,0,1,3) | |
4885 | *+psbori(s,s-t,0,1,3))*(gl2*(upv1+dnv1+4.*sea1+2.*str1+2.*chm1)+ | |
4886 | *gl1*(upv2+dnv2+4.*sea2+2.*str2+2.*chm2)) | |
4887 | *+(psbori(s,t,1,1,1)+psbori(s,s-t,1,1,1) | |
4888 | *+psbori(s,t,1,1,2)+psbori(s,s-t,1,1,2)+psbori(s,t,1,1,3)+ | |
4889 | *psbori(s,s-t,1,1,3))/2.* | |
4890 | *((upv1+sea1)*(upv2+sea2)+(dnv1+sea1)*(dnv2+sea2)+2.*sea1*sea2 | |
4891 | *+2.*str1*str2+2.*chm1*chm2) | |
4892 | *+(psbori(s,t,1,-1,1)+psbori(s,s-t,1,-1,1)+psbori(s,t,1,-1,2)+ | |
4893 | *psbori(s,s-t,1,-1,2)+psbori(s,t,1,-1,3)+psbori(s,s-t,1,-1,3))* | |
4894 | *((upv1+sea1)*sea2+sea1*(upv2+sea2)+(dnv1+sea1)*sea2+ | |
4895 | *sea1*(dnv2+sea2)+2.*str1*str2+2.*chm1*chm2) | |
4896 | *+(psbori(s,t,1,2,1) | |
4897 | *+psbori(s,s-t,1,2,1)+psbori(s,t,1,2,2)+psbori(s,s-t,1,2,2) | |
4898 | *+psbori(s,t,1,2,3)+psbori(s,s-t,1,2,3))* | |
4899 | *(upv1*dnv2+upv2*dnv1+(upv1+dnv1)*(2.*sea2+2.*str2+2.*chm2)+ | |
4900 | *(upv2+dnv2)*(2.*sea1+2.*str1+2.*chm1)+ | |
4901 | *4.*sea1*(2.*sea2+2.*str2+2.*chm2)+2.*str1*(4.*sea2+2.*chm2)+ | |
4902 | *2.*chm1*(4.*sea2+2.*str2)) | |
4903 | return | |
4904 | end | |
4905 | ||
4906 | c------------------------------------------------------------------------ | |
4907 | subroutine pslcsh(wp1,wm1,wp2,wm2,samqt,amqpt) | |
4908 | c----------------------------------------------------------------------- | |
4909 | c pslcsh - sh pomeron lc momentum sharing between two strings | |
4910 | c------------------------------------------------------------------------ | |
4911 | double precision amqt(4),yqm(4),yqm1(4),xlp(4),xlm(4),am23,sx,y2 | |
4912 | *,wp1,wp2,wm1,wm2,s,sq,psutz,yqmax,y,amjp,amjm,y1,s12,s34,x34,amqpt | |
4913 | dimension samqt(4) | |
4914 | include 'epos.inc' | |
4915 | ||
4916 | s=wp1*wm1 | |
4917 | sq=dsqrt(s) | |
4918 | do i=1,4 | |
4919 | amqt(i)=dble(samqt(i)) | |
4920 | yqm(i)=dlog(sq/amqt(i)*psutz(s,amqt(i)**2,(amqpt-amqt(i))**2)) | |
4921 | enddo | |
4922 | yqmax=max(yqm(1),yqm(2)) | |
4923 | ||
4924 | 1 y=yqmax*dble(rangen()) | |
4925 | j=int(1.5+rangen()) | |
4926 | if(y.gt.yqm(j))goto 1 | |
4927 | ||
4928 | amjp=amqt(j)*dexp(y) | |
4929 | amjm=amqt(j)*dexp(-y) | |
4930 | do i=3,4 | |
4931 | am23=amqt(3-j)+amqt(7-i) | |
4932 | sx=(am23+amjp)*(am23+amjm) | |
4933 | yqm1(i)=dlog(sq/amqt(i)*psutz(s,amqt(i)**2,sx)) | |
4934 | enddo | |
4935 | yqmax1=max(yqm1(3),yqm1(4)) | |
4936 | if(dble(rangen()).gt.yqmax1/max(yqm(3),yqm(4)))goto 1 | |
4937 | ||
4938 | y1=yqmax1*dble(rangen()) | |
4939 | j1=int(3.5+rangen()) | |
4940 | if(y1.gt.yqm1(j1))goto 1 | |
4941 | ||
4942 | amjp1=amqt(j1)*exp(y1) | |
4943 | amjm1=amqt(j1)*exp(-y1) | |
4944 | s12=(amqt(3-j)+amjp)*(amqt(3-j)+amjm) | |
4945 | s34=(amqt(7-j1)+amjp1)*(amqt(7-j1)+amjm1) | |
4946 | y2=dlog(sq/(amqt(3-j)+amjp)*psutz(s,s12,s34)) | |
4947 | ||
4948 | xlp(j)=amqt(j)/sq*dexp(y+y2) | |
4949 | xlm(j)=amqt(j)/sq*dexp(-y-y2) | |
4950 | xlp(3-j)=amqt(3-j)/sq*dexp(y2) | |
4951 | xlm(3-j)=amqt(3-j)/sq*dexp(-y2) | |
4952 | x34=1.-xlm(1)-xlm(2) | |
4953 | xlm(7-j1)=x34/(1.+amjp1/amqt(7-j1)) | |
4954 | xlm(j1)=x34-xlm(7-j1) | |
4955 | c write (*,*)'xlc',xlp(1),xlp(2),xlm(3),xlm(4) | |
4956 | if(dble(rangen()).gt.(xlp(1)*xlp(2)*xlm(3)*xlm(4))**(-alpqua)* | |
4957 | *(xlp(j)*(1.d0-xlp(j))*xlm(j1)*(1.d0-xlm(j1))))goto 1 | |
4958 | ||
4959 | wp2=xlp(2)*wp1 | |
4960 | wp1=xlp(1)*wp1 | |
4961 | wm2=xlm(4)*wm1 | |
4962 | wm1=xlm(3)*wm1 | |
4963 | c write (*,*)'wp1,wm1,wp2,wm2',wp1,wm1,wp2,wm2 | |
4964 | return | |
4965 | end | |
4966 | ||
4967 | c------------------------------------------------------------------------ | |
4968 | function psnorm(ep) | |
4969 | c----------------------------------------------------------------------- | |
4970 | c 4-vector squared calculation | |
4971 | c----------------------------------------------------------------------- | |
4972 | double precision sm2,ep(4) | |
4973 | sm2=ep(1)**2 | |
4974 | do i=1,3 | |
4975 | sm2=sm2-ep(i+1)**2 | |
4976 | enddo | |
4977 | psnorm=sm2 | |
4978 | return | |
4979 | end | |
4980 | ||
4981 | c------------------------------------------------------------------------ | |
4982 | subroutine psrotat(ep,s0x,c0x,s0,c0) | |
4983 | c----------------------------------------------------------------------- | |
4984 | c psrotat - spacial rotation to the lab. system for 4-vector ep | |
4985 | c s0, c0 - sin and cos for the zx-rotation; | |
4986 | c s0x, c0x - sin and cos for the xy-rotation | |
4987 | c----------------------------------------------------------------------- | |
4988 | dimension ep(4),ep1(3) | |
4989 | ||
4990 | ep1(3)=ep(4) | |
4991 | ep1(2)=ep(2)*s0+ep(3)*c0 | |
4992 | ep1(1)=ep(2)*c0-ep(3)*s0 | |
4993 | ||
4994 | ep(2)=ep1(1) | |
4995 | ep(4)=ep1(2)*s0x+ep1(3)*c0x | |
4996 | ep(3)=ep1(2)*c0x-ep1(3)*s0x | |
4997 | return | |
4998 | end | |
4999 | ||
5000 | cc------------------------------------------------------------------------ | |
5001 | c subroutine psrotat1(ep,s0x,c0x,s0,c0) | |
5002 | cc----------------------------------------------------------------------- | |
5003 | cc psrotat - spacial rotation to the lab. system for 4-vector ep | |
5004 | cc s0, c0 - sin and cos for the zx-rotation; | |
5005 | cc s0x, c0x - sin and cos for the xy-rotation | |
5006 | cc----------------------------------------------------------------------- | |
5007 | c dimension ep(4),ep1(3) | |
5008 | c | |
5009 | c ep1(1)=ep(2) | |
5010 | c ep1(3)=-ep(3)*s0x+ep(4)*c0x | |
5011 | c ep1(2)=ep(3)*c0x+ep(4)*s0x | |
5012 | c | |
5013 | c ep(4)=ep1(3) | |
5014 | c ep(3)=-ep1(1)*s0+ep1(2)*c0 | |
5015 | c ep(2)=ep1(1)*c0+ep1(2)*s0 | |
5016 | c return | |
5017 | c end | |
5018 | c | |
5019 | c----------------------------------------------------------------------- | |
5020 | function pssalf(qq) | |
5021 | c----------------------------------------------------------------------- | |
5022 | c pssalf - effective qcd coupling (alpha_s/2/pi) | |
5023 | c----------------------------------------------------------------------- | |
5024 | include "epos.incsem" | |
5025 | pssalf=2./(11.-naflav/1.5)/log(qq) | |
5026 | return | |
5027 | end | |
5028 | ||
5029 | c------------------------------------------------------------------------ | |
5030 | subroutine pstrans(ep,ey,jj) | |
5031 | c----------------------------------------------------------------------- | |
5032 | c pstrans - lorentz boosts according to the parameters ey ( determining | |
5033 | c shift along the z,x,y-axis respectively (ey(1),ey(2),ey(3))) | |
5034 | c jj=1 - inverse transformation to the lab. system; | |
5035 | c jj=-1 - direct transformation | |
5036 | c----------------------------------------------------------------------- | |
5037 | dimension ey(3),ep(4) | |
5038 | ||
5039 | if(jj.eq.1)then | |
5040 | c lorentz transform to lab. system according to 1/ey(i) parameters | |
5041 | do i=1,3 | |
5042 | if(ey(4-i).ne.1.)then | |
5043 | wp=(ep(1)+ep(5-i))/ey(4-i) | |
5044 | wm=(ep(1)-ep(5-i))*ey(4-i) | |
5045 | ep(1)=.5*(wp+wm) | |
5046 | ep(5-i)=.5*(wp-wm) | |
5047 | endif | |
5048 | enddo | |
5049 | else | |
5050 | c lorentz transform to lab. system according to ey(i) parameters | |
5051 | do i=1,3 | |
5052 | if(ey(i).ne.1.)then | |
5053 | wp=(ep(1)+ep(i+1))*ey(i) | |
5054 | wm=(ep(1)-ep(i+1))/ey(i) | |
5055 | ep(1)=.5*(wp+wm) | |
5056 | ep(i+1)=.5*(wp-wm) | |
5057 | endif | |
5058 | enddo | |
5059 | endif | |
5060 | return | |
5061 | end | |
5062 | ||
5063 | c------------------------------------------------------------------------ | |
5064 | double precision function psuds(q,m) | |
5065 | c----------------------------------------------------------------------- | |
5066 | c psuds - spacelike sudakov formfactor | |
5067 | c q - maximal value of the effective momentum, | |
5068 | c m - type of parton (0 - g, 1,2, etc. - q) | |
5069 | c----------------------------------------------------------------------- | |
5070 | dimension wi(3) | |
5071 | common /psar15/ sudx(40,2) | |
5072 | include 'epos.incsem' | |
5073 | double precision dps,qlm,ffacs,qlm0,qlmi | |
5074 | ||
5075 | j=min(iabs(m),1)+1 | |
5076 | ||
5077 | if(q.gt.q2ini)then | |
5078 | qli=log(q/q2min)*2.+1. | |
5079 | i=int(qli) | |
5080 | if(i.lt.1)i=1 | |
5081 | if(i.gt.38)i=38 | |
5082 | wi(2)=qli-i | |
5083 | wi(3)=wi(2)*(wi(2)-1.)*.5 | |
5084 | wi(1)=1.-wi(2)+wi(3) | |
5085 | wi(2)=wi(2)-2.*wi(3) | |
5086 | dps=0.d0 | |
5087 | do i1=1,3 | |
5088 | dps=dps+dble(sudx(i+i1-1,j)*wi(i1)) | |
5089 | enddo | |
5090 | ||
5091 | qlm0=dble(log(q2ini/qcdlam)) | |
5092 | qlm=dble(log(q/qcdlam)) | |
5093 | qlmi=qlm-qlm0 !=log(q/q2ini) | |
5094 | psuds=(qlm*log(qlm/qlm0)-qlmi) | |
5095 | ||
5096 | ffacs=(11.d0-dble(naflav)/1.5d0)/12.d0 | |
5097 | if(j.eq.1)then | |
5098 | psuds=(psuds-ffacs*log(qlm/qlm0) | |
5099 | * +dps*(1.d0-dble(q2ini/q)))/ffacs | |
5100 | else | |
5101 | psuds=(psuds-log(qlm/qlm0)*.75d0 | |
5102 | * +dps*(1.d0-dble(q2ini/q)))*4.d0/9.d0/ffacs | |
5103 | endif | |
5104 | psuds=exp(-psuds) | |
5105 | else | |
5106 | psuds=1.d0 | |
5107 | endif | |
5108 | return | |
5109 | end | |
5110 | ||
5111 | c------------------------------------------------------------------------ | |
5112 | function psudx(q,j) | |
5113 | c----------------------------------------------------------------------- | |
5114 | c psudx - part of the bspacelike sudakov formfactor | |
5115 | c q - maximal value of the effective momentum, | |
5116 | c j - type of parton (1 - g, 2 - q) | |
5117 | c----------------------------------------------------------------------- | |
5118 | common /ar3/ x1(7),a1(7) | |
5119 | include 'epos.incsem' | |
5120 | ||
5121 | psudx=0. | |
5122 | ||
5123 | do i=1,7 | |
5124 | do m=1,2 | |
5125 | qt=.5*(q2ini+q-x1(i)*(2.*m-3.)*(q2ini-q)) | |
5126 | if(j.eq.1)then | |
5127 | zm=1.-qt/q | |
5128 | dps=((11.-naflav/1.5)/12.-zm**2*(1.-naflav/12.)+ | |
5129 | * (zm**3/3.-zm**4/4.)*(1.-naflav/3.))*q/qt | |
5130 | else | |
5131 | dps=(1.-qt/q/4.) | |
5132 | endif | |
5133 | psudx=psudx+a1(i)*dps/log(qt/qcdlam) | |
5134 | enddo | |
5135 | enddo | |
5136 | psudx=psudx*.5 | |
5137 | return | |
5138 | end | |
5139 | ||
5140 | c------------------------------------------------------------------------ | |
5141 | double precision function psutz(s,a,b) | |
5142 | c----------------------------------------------------------------------- | |
5143 | c psutz - kinematical function for two particle decay - light cone momen | |
5144 | c share for the particle of mass squared a, | |
5145 | c b - partner's mass squared, | |
5146 | c s - two particle invariant mass | |
5147 | c----------------------------------------------------------------------- | |
5148 | double precision a1,b1,s1,x,dx,s,a,b | |
5149 | a1=dsqrt(a) | |
5150 | b1=dsqrt(b) | |
5151 | s1=dsqrt(s) | |
5152 | x=(1.d0+(a1-b1)*(a1+b1)/s)/2.d0 | |
5153 | dx=(x-a1/s1)*(x+a1/s1) | |
5154 | c x=.5*(1.+(a-b)/s) | |
5155 | c dx=(x*x-a/s) | |
5156 | if(dx.gt.0.d0)then | |
5157 | x=x+dsqrt(dx) | |
5158 | else | |
5159 | x=a1/s1 | |
5160 | endif | |
5161 | psutz=min(0.999999999d0,x) | |
5162 | return | |
5163 | end | |
5164 | ||
5165 | c------------------------------------------------------------------------ | |
5166 | block data ptdata | |
5167 | c----------------------------------------------------------------------- | |
5168 | c constants for numerical integration (gaussian weights) | |
5169 | c----------------------------------------------------------------------- | |
5170 | common /ar3/ x1(7),a1(7) | |
5171 | common /ar4/ x4(2),a4(2) | |
5172 | common /ar5/ x5(2),a5(2) | |
5173 | common /ar8/ x2(4),a2 | |
5174 | common /ar9/ x9(3),a9(3) | |
5175 | ||
5176 | data x1/.9862838,.9284349,.8272013,.6872929,.5152486, | |
5177 | *.3191124,.1080549/ | |
5178 | data a1/.03511946,.08015809,.1215186,.1572032, | |
5179 | *.1855384,.2051985,.2152639/ | |
5180 | data x2/.00960736,.0842652,.222215,.402455/ | |
5181 | data a2/.392699/ | |
5182 | data x4/ 0.339981,0.861136/ | |
5183 | data a4/ 0.652145,0.347855/ | |
5184 | data x5/.585786,3.41421/ | |
5185 | data a5/.853553,.146447/ | |
5186 | data x9/.93247,.661209,.238619/ | |
5187 | data a9/.171324,.360762,.467914/ | |
5188 | end | |
5189 | ||
5190 | c------------------------------------------------------------------------ | |
5191 | subroutine strdo1(x,scale,upv,dnv,sea,str,chm,gl) | |
5192 | c------------------------------------------------------------------------ | |
5193 | c :::::::::::: duke owens set 1 :::::::::::::::::::::::::::: | |
5194 | c------------------------------------------------------------------------ | |
5195 | implicit double precision(a-h,o-z) | |
5196 | double precision | |
5197 | + f(5),a(6,5),b1(3,6,5) | |
5198 | data q0,ql1/2.d0,.2d0/ | |
5199 | data b1/3.d0,0.d0,0.d0,.419d0,.004383d0,-.007412d0, | |
5200 | &3.46d0,.72432d0,-.065998d0,4.4d0,-4.8644d0,1.3274d0, | |
5201 | &6*0.d0,1.d0, | |
5202 | &0.d0,0.d0,.763d0,-.23696d0,.025836d0,4.d0,.62664d0,-.019163d0, | |
5203 | &0.d0,-.42068d0,.032809d0,6*0.d0,1.265d0,-1.1323d0,.29268d0, | |
5204 | &0.d0,-.37162d0,-.028977d0,8.05d0,1.5877d0,-.15291d0, | |
5205 | &0.d0,6.3059d0,-.27342d0,0.d0,-10.543d0,-3.1674d0, | |
5206 | &0.d0,14.698d0,9.798d0,0.d0,.13479d0,-.074693d0, | |
5207 | &-.0355d0,-.22237d0,-.057685d0,6.3494d0,3.2649d0,-.90945d0, | |
5208 | &0.d0,-3.0331d0,1.5042d0,0.d0,17.431d0,-11.255d0, | |
5209 | &0.d0,-17.861d0,15.571d0,1.564d0,-1.7112d0,.63751d0, | |
5210 | &0.d0,-.94892d0,.32505d0,6.d0,1.4345d0,-1.0485d0, | |
5211 | &9.d0,-7.1858d0,.25494d0,0.d0,-16.457d0,10.947d0, | |
5212 | &0.d0,15.261d0,-10.085d0/ | |
5213 | wn=1.d0 | |
5214 | s= log( log( max(q0,scale)/ql1)/ log(q0/ql1)) | |
5215 | do 10 i=1,5 | |
5216 | do 10 j=1,6 | |
5217 | 10 a(j,i)=b1(1,j,i)+s*(b1(2,j,i)+s*b1(3,j,i)) | |
5218 | do 40 i=1,5 | |
5219 | 40 f(i)=a(1,i)*x**a(2,i)*(wn-x)**a(3,i)*(wn+x* | |
5220 | & (a(4,i)+x*(a(5,i)+x*a(6,i)))) | |
5221 | do 50 i=1,2 | |
5222 | aa=wn+a(2,i)+a(3,i) | |
5223 | 50 f(i)=f(i)*utgam2(aa)/((wn+a(2,i)*a(4,i)/aa) | |
5224 | &*utgam2(a(2,i))*utgam2(wn+a(3,i))) | |
5225 | upv=f(1)-f(2) | |
5226 | dnv=f(2) | |
5227 | sea=f(3)/6.d0 | |
5228 | str=sea | |
5229 | chm=f(4) | |
5230 | gl =f(5) | |
5231 | return | |
5232 | end | |
5233 | ||
5234 | ||
5235 | ||
5236 | c------------------------------------------------------------------------ | |
5237 | function fzeroGluZZ(z,k) ! former psftild | |
5238 | c----------------------------------------------------------------------- | |
5239 | c | |
5240 | c fzeroGluZZComplete = fzeroGluZZ * z^(-1-dels) * gamsoft * gamhad | |
5241 | c | |
5242 | c A = 8*pi*s0*gampar*gamtilde | |
5243 | c integration over semihard pomeron light cone momentum share xp==u | |
5244 | c | |
5245 | c fzeroGluZZ = (1-glusea) * engy^epszero | |
5246 | c * int(du) u^(epszero-alppar+dels) (1-u)^alplea * (1-z/u)**betpom | |
5247 | c | |
5248 | c z - light cone x of the gluon, | |
5249 | c k - hadron class | |
5250 | c----------------------------------------------------------------------- | |
5251 | double precision xpmin,xp | |
5252 | include 'epos.inc' | |
5253 | common /ar3/ x1(7),a1(7) | |
5254 | include 'epos.incsem' | |
5255 | ||
5256 | fzeroGluZZ=0. | |
5257 | xpmin=z | |
5258 | xpmin=xpmin**(1.-alppar+dels+epszero) | |
5259 | do i=1,7 | |
5260 | do m=1,2 | |
5261 | xp=(.5*(1.+xpmin+(2*m-3)*x1(i)*(1.-xpmin)))**(1./ | |
5262 | * (1.-alppar+dels+epszero)) | |
5263 | fzeroGluZZ=fzeroGluZZ+a1(i)*(1.-xp)**alplea(k)*(1.-z/xp)**betpom | |
5264 | enddo | |
5265 | enddo | |
5266 | fzeroGluZZ= | |
5267 | * fzeroGluZZ*.5*(1.-xpmin)/(1.-alppar+dels+epszero) | |
5268 | * *(1.-glusea) *engy**epszero | |
5269 | return | |
5270 | end | |
5271 | ||
5272 | c------------------------------------------------------------------------ | |
5273 | function fzeroSeaZZ(z,k) ! former psftile | |
5274 | c----------------------------------------------------------------------- | |
5275 | c | |
5276 | c fzeroSeaZZComplete = fzeroSeaZZ * z^(-1-dels) * gamsoft * gamhad | |
5277 | c | |
5278 | c gamsoft = 8*pi*s0*gampar*gamtilde | |
5279 | c integration over semihard pomeron light cone momentum share xp==u | |
5280 | c | |
5281 | c fzeroSeaZZ = glusea * engy^epszero | |
5282 | c * int(du) u^(epszero-alppar+dels) (1-u)^alplea * EsoftQZero(z/u) | |
5283 | c | |
5284 | c z - light cone x of the quark, | |
5285 | c k - hadron class | |
5286 | c----------------------------------------------------------------------- | |
5287 | double precision xpmin,xp | |
5288 | common /ar3/ x1(7),a1(7) | |
5289 | include 'epos.inc' | |
5290 | include 'epos.incsem' | |
5291 | ||
5292 | fzeroSeaZZ=0. | |
5293 | xpmin=z | |
5294 | xpmin=xpmin**(1.-alppar+dels+epszero) | |
5295 | do i=1,7 | |
5296 | do m=1,2 | |
5297 | xp=(.5*(1.+xpmin+(2*m-3)*x1(i)*(1.-xpmin)))**(1./ | |
5298 | * (1.-alppar+dels+epszero)) | |
5299 | zz=z/xp | |
5300 | fzeroSeaZZ=fzeroSeaZZ+a1(i)*(1.-xp)**alplea(k)*EsoftQZero(zz) | |
5301 | enddo | |
5302 | enddo | |
5303 | fzeroSeaZZ=fzeroSeaZZ*.5*(1.-xpmin)/(1.-alppar+dels+epszero) | |
5304 | * *glusea *engy**epszero | |
5305 | return | |
5306 | end | |
5307 | ||
5308 | ||
5309 | c######################################################################## | |
5310 | c######################################################################## | |
5311 | subroutine psaini | |
5312 | c######################################################################## | |
5313 | c######################################################################## | |
5314 | ||
5315 | c----------------------------------------------------------------------- | |
5316 | c common initialization procedure | |
5317 | c if isetcs = 0, alpD, betD, etc ... in inirj are not used and xkappa=1 | |
5318 | c if isetcs = 1, alpD, betD, etc ... in inirj are not used but xkappa.ne.1 | |
5319 | c if isetcs = 2, alpD, betD, xkappa, etc ... in inirj are used and | |
5320 | c cross section from calculation in inics are read. | |
5321 | c if epos.inics doesn't exist, it produces only the calculated part of it. | |
5322 | c if isetcs = 3, alpD, betD, xkappa, etc ... in inirj are used and | |
5323 | c cross section from simulation in inics are read. | |
5324 | c if epos.inics doesn't exist, it produces the calculated AND the | |
5325 | c simulated part of it. | |
5326 | c----------------------------------------------------------------------- | |
5327 | include 'epos.inc' | |
5328 | include 'epos.incpar' | |
5329 | include 'epos.incsem' | |
5330 | logical lcalc!,lcalc2 | |
5331 | c double precision om5p,xh,yh,v3pom(4),om2p | |
5332 | dimension gamhad0(nclha),r2had0(nclha),chad0(nclha) | |
5333 | *,alplea0(nclha),asect1(7,4,7),asect2(7,4,7),asect3(7,7,7) | |
5334 | *,asect4(7,7,7)!,cgam(idxD) | |
5335 | common /psar2/ edmax,epmax | |
5336 | common /psar4/ fhgg(11,10,8),fhqg(11,10,80) | |
5337 | *,fhgq(11,10,80),fhqq(11,10,80),fhgg0(11,10),fhgg1(11,10,4) | |
5338 | *,fhqg1(11,10,40),fhgg01(11),fhgg02(11),fhgg11(11,4) | |
5339 | *,fhgg12(11,4),fhqg11(11,10,4),fhqg12(11,10,4) | |
5340 | *,ftoint(11,14,2,2,3) | |
5341 | common /psar7/ delx,alam3p,gam3p | |
5342 | common /psar9/ alpr | |
5343 | common /psar15/ sudx(40,2) | |
5344 | common /psar19/ cstot(20,20,240) | |
5345 | common /psar20/ csord(20,20,240) | |
5346 | common /psar21/ csbor(20,160,2) | |
5347 | common /psar22/ cstotzero(20,4,2),csborzer(20,4,2) | |
5348 | common /psar23/ cschar(20,20,2) | |
5349 | common /psar25/ csdsi(21,21,104) | |
5350 | common /psar27/ csds(21,26,4),csdt(21,26,2),csdr(21,26,2) | |
5351 | common /psar33/ asect(7,4,7),asectn(7,7,7) | |
5352 | common /psar34/ rrr,rrrm | |
5353 | common /psar35/ anorm,anormp | |
5354 | common /psar41/ rrrp,rrrmp | |
5355 | common /psar36/ alvc | |
5356 | common /psar37/ coefom1,coefom2 | |
5357 | common /psar38/ vfro(11,14,3,2) | |
5358 | common /psar39/ vnorm(11,14,3,2,2) | |
5359 | c$$$ common /psar40/ coefxu1(idxD,nclha,10) | |
5360 | c$$$ *,coefxu2(idxD,idxD,nclha,10),coefxc2(idxD,idxD,nclha,10) | |
5361 | common /ar3/ x1(7),a1(7) | |
5362 | common /testj/ ajeth(4),ajete(5),ajet0(7) | |
5363 | parameter(nbkbin=40) | |
5364 | common /kfitd/ xkappafit(nclegy,nclha,nclha,nbkbin),xkappa,bkbin | |
5365 | common/geom/rmproj,rmtarg,bmax,bkmx | |
5366 | character textini*38 | |
5367 | external ptfau,ptfauAA | |
5368 | ||
5369 | ||
5370 | call utpri('psaini',ish,ishini,4) | |
5371 | ||
5372 | do i=1,4 | |
5373 | ajeth(i)=0. | |
5374 | enddo | |
5375 | do i=1,5 | |
5376 | ajete(i)=0. | |
5377 | ajet0(i)=0. | |
5378 | enddo | |
5379 | ajet0(6)=0. | |
5380 | ajet0(7)=0. | |
5381 | ||
5382 | ||
5383 | if(isetcs.le.1)then !for Kfit | |
5384 | bkbin=0.3 | |
5385 | else | |
5386 | bkbin=0.1 | |
5387 | endif | |
5388 | xkappa=1. | |
5389 | ||
5390 | edmax=edmaxi !1.e12 defined in epos-bas | |
5391 | epmax=epmaxi !1.e12 defined in epos-bas | |
5392 | ||
5393 | c fix enhanced diagrams at minimum energy = 2.5 | |
5394 | delx=1.5 !sqrt(egymin*egymin/exp(1.)) | |
5395 | alam3p=.6 | |
5396 | gam3p=.1 | |
5397 | ||
5398 | ||
5399 | ||
5400 | c interface to 'bas' | |
5401 | c ---------------- | |
5402 | ||
5403 | dels=alppom-1. | |
5404 | alpqua=(alppar+1.)/2. | |
5405 | if(abs(alpqua).lt.1.e-6)call utstop('alpar should not be -1 !&') | |
5406 | alpr=-2.+alpqua !x-exponent for remnant mass | |
5407 | ||
5408 | c omega coeffs | |
5409 | c ---------------- | |
5410 | coefom0=utgam1(1.+dels-alppar)*utgam1(1.+alplea(iclpro)) | |
5411 | */utgam1(2.+alplea(iclpro)+dels-alppar) | |
5412 | **utgam1(1.+dels-alppar)*utgam1(1.+alplea(icltar)) | |
5413 | */utgam1(2.+alplea(icltar)+dels-alppar) | |
5414 | coefom1=1.-utgam1(1.+dels-alppar)**2*utgam1(1.+alplea(iclpro)) | |
5415 | */utgam1(1.+alplea(iclpro)+2.*(1.+dels-alppar)) | |
5416 | **utgam1(1.+dels-alppar)**2*utgam1(1.+alplea(icltar)) | |
5417 | */utgam1(1.+alplea(icltar)+2.*(1.+dels-alppar))/coefom0**2 | |
5418 | coefom2=3.*coefom1-1. | |
5419 | *+utgam1(1.+dels-alppar)**3*utgam1(1.+alplea(iclpro)) | |
5420 | */utgam1(1.+alplea(iclpro)+3.*(1.+dels-alppar)) | |
5421 | **utgam1(1.+dels-alppar)**3*utgam1(1.+alplea(icltar)) | |
5422 | */utgam1(1.+alplea(icltar)+3.*(1.+dels-alppar))/coefom0**3 | |
5423 | if(ish.ge.4)write(ifch,*)'coefom',coefom0,coefom1,coefom2,delx | |
5424 | ||
5425 | c soft pomeron: abbreviations | |
5426 | c--------------------------------------- | |
5427 | if(iappl.eq.1.or.iappl.eq.8.or.iappl.eq.9)then | |
5428 | ||
5429 | ||
5430 | c--------------------------------------- | |
5431 | c auxiliary constants: | |
5432 | c--------------------------------------- | |
5433 | stmass=.05 !string mass cutoff | |
5434 | ||
5435 | c--------------------------------------- | |
5436 | c parton density normalization | |
5437 | sq=log(log(q2min/.232**2)/log(.23/.232**2)) | |
5438 | du=2.997+.753*sq-.076*sq*sq | |
5439 | qnorm=0. | |
5440 | do i=1,7 | |
5441 | do m=1,2 | |
5442 | xx=.5+x1(i)*(m-1.5) | |
5443 | xxq=1.-xx**(1./(1.+du)) | |
5444 | qnorm=qnorm+a1(i)*(psdfh4(xxq,q2min,0.,2,1)+ | |
5445 | * psdfh4(xxq,q2min,0.,2,2))/(1.-xxq)**du | |
5446 | enddo | |
5447 | enddo | |
5448 | qnorm=qnorm*.5/(1.+du) | |
5449 | qnormp=qnorm | |
5450 | ckkkkk----------------------------- | |
5451 | c rr=(1.-qnorm)/4./pi/gamhad(2) | |
5452 | c * *utgam1(2.+betpom-dels)/utgam1(1.-dels) | |
5453 | c * /utgam1(1.+betpom)/utgam1(1.+alplea(2))/ | |
5454 | c * utgam1(2.-alppar)*utgam1(3.+alplea(2)-alppar) | |
5455 | c ffrr=(1.-qnorm)/4./pi/gamhad(2) | |
5456 | c * *utgam1(2.+betpom-dels)/utgam1(1.-dels) | |
5457 | c * /utgam1(1.+betpom) | |
5458 | c write(6,*)'===========',ffrr | |
5459 | ffrr=gamtil | |
5460 | rr=ffrr | |
5461 | * /utgam1(1.+alplea(2))/ | |
5462 | * utgam1(2.-alppar)*utgam1(3.+alplea(2)-alppar) | |
5463 | gamsoft=rr*4.*pi | |
5464 | ckkkkkkk------------------------------- | |
5465 | if(ish.ge.4)write (ifch,*)'rr,qnorm',rr,qnorm | |
5466 | ||
5467 | ||
5468 | sq=log(log(q2min/.232**2)/log(.25/.232**2)) | |
5469 | dpi=.367+.563*sq | |
5470 | qnorm=0. | |
5471 | do i=1,7 | |
5472 | do m=1,2 | |
5473 | xx=.5+x1(i)*(m-1.5) | |
5474 | xxq=1.-xx**(1./(1.+dpi)) | |
5475 | qnorm=qnorm+a1(i)*(psdfh4(xxq,q2min,0.,1,1)+ | |
5476 | * psdfh4(xxq,q2min,0.,1,2))/(1.-xxq)**dpi | |
5477 | enddo | |
5478 | enddo | |
5479 | qnorm=qnorm*.5/(1.+dpi) | |
5480 | cftmp=1./(1.-qnormp)*(1.-qnorm) | |
5481 | * *utgam1(alplea(2)+1.)/utgam1(alplea(2)+3.-alppar) | |
5482 | * /utgam1(alplea(1)+1.)*utgam1(alplea(1)+3.-alppar) | |
5483 | gamhad(1)=gamhad(2)*cftmp | |
5484 | if(gamhadsi(1).lt.0.)then | |
5485 | gamhads(1)=gamhad(1) | |
5486 | else | |
5487 | gamhads(1)=gamhadsi(1) | |
5488 | endif | |
5489 | if(ish.ge.4) | |
5490 | * write (ifch,*)'gamhad(1),gamhads(1)',gamhad(1),gamhads(1) | |
5491 | ||
5492 | if(gamhadsi(2).lt.0.)then | |
5493 | gamhads(2)=gamhad(2) | |
5494 | else | |
5495 | gamhads(2)=gamhadsi(2) | |
5496 | endif | |
5497 | if(ish.ge.4) | |
5498 | * write (ifch,*)'gamhad(2),gamhads(2)',gamhad(2),gamhads(2) | |
5499 | ||
5500 | qnorm=0. | |
5501 | do i=1,7 | |
5502 | do m=1,2 | |
5503 | xx=.5+x1(i)*(m-1.5) | |
5504 | xxq=1.-xx**(1./(1.+dpi)) | |
5505 | qnorm=qnorm+a1(i)*(psdfh4(xxq,q2min,0.,1,1)+ | |
5506 | * psdfh4(xxq,q2min,0.,1,2))/(1.-xxq)**dpi | |
5507 | enddo | |
5508 | enddo | |
5509 | qnorm=qnorm*.5/(1.+dpi) | |
5510 | cftmp=1./(1.-qnormp)*(1.-qnorm) | |
5511 | * *utgam1(alplea(2)+1.)/utgam1(alplea(2)+3.-alppar) | |
5512 | * /utgam1(alplea(3)+1.)*utgam1(alplea(3)+3.-alppar) | |
5513 | gamhad(3)=gamhad(2)*cftmp | |
5514 | if(gamhadsi(3).lt.0.)then | |
5515 | gamhads(3)=gamhad(3) | |
5516 | else | |
5517 | gamhads(3)=gamhadsi(3) | |
5518 | endif | |
5519 | if(ish.ge.4) | |
5520 | * write (ifch,*)'gamhad(3),gamhads(3)',gamhad(3),gamhads(3) | |
5521 | ||
5522 | quamas=.35 | |
5523 | gamhad(4)=gamhad(1)*(quamas/qcmass)**2 | |
5524 | if(gamhadsi(4).lt.0.)then | |
5525 | gamhads(4)=gamhad(4) | |
5526 | else | |
5527 | gamhads(4)=gamhadsi(4) | |
5528 | endif | |
5529 | if(ish.ge.4) | |
5530 | * write (ifch,*)'gamhad(4),gamhads(4)',gamhad(4),gamhads(4) | |
5531 | gnorm=0. | |
5532 | do i=1,7 | |
5533 | do m=1,2 | |
5534 | xx=.5+x1(i)*(m-1.5) | |
5535 | xxg=xx**(1./(1.-dels)) | |
5536 | gnorm=gnorm+a1(i)*(fzeroGluZZ(xxg,4)+fzeroSeaZZ(xxg,4)) | |
5537 | enddo | |
5538 | enddo | |
5539 | gnorm=gnorm/(1.-dels)*2.*pi*gamhad(4)*rr | |
5540 | alvc=6./(1.-gnorm)-4. | |
5541 | if(ish.ge.4) write (ifch,*)'rr,qnorm,gnorm,alvc', | |
5542 | * rr,qnorm,gnorm,alvc | |
5543 | ||
5544 | c write (*,*)'rr-c,qnorm,gnorm,alvc',rr,qnorm,gnorm,alvc | |
5545 | endif | |
5546 | ||
5547 | c----------------------------------------------- | |
5548 | c tabulation of inclusive jet cross sections | |
5549 | c-------------------------------------------------- | |
5550 | ||
5551 | do i=1,40 | |
5552 | qi=q2min*exp(.5*(i-1)) | |
5553 | sudx(i,1)=psudx(qi,1) | |
5554 | sudx(i,2)=psudx(qi,2) | |
5555 | enddo | |
5556 | if(ish.ge.4)write(ifch,*)'bare cross sections ...' | |
5557 | ||
5558 | call psaevc | |
5559 | ||
5560 | ccc call MakeCSTable | |
5561 | ||
5562 | inquire(file=fnii(1:nfnii),exist=lcalc) | |
5563 | if(lcalc)then | |
5564 | if(inicnt.eq.1)then | |
5565 | write(ifmt,'(3a)')'read from ',fnii(1:nfnii),' ...' | |
5566 | open(1,file=fnii(1:nfnii),status='old') | |
5567 | read (1,*)qcdlam0,q2min0,q2ini0,naflav0,epmax0,pt2cut0 | |
5568 | if(qcdlam0.ne.qcdlam)write(ifmt,'(a)')'initl: wrong qcdlam' | |
5569 | if(q2min0 .ne.q2min )write(ifmt,'(a)')'initl: wrong q2min' | |
5570 | if(q2ini0 .ne.q2ini )write(ifmt,'(a)')'initl: wrong q2ini' | |
5571 | if(naflav0.ne.naflav)write(ifmt,'(a)')'initl: wrong naflav' | |
5572 | if(epmax0 .ne.epmax )write(ifmt,'(a)')'initl: wrong epmax' | |
5573 | if(pt2cut0 .ne.pt2cut )write(ifmt,'(a)')'initl: wrong pt2cut' | |
5574 | if(qcdlam0.ne.qcdlam.or.q2min0 .ne.q2min .or.q2ini0 .ne.q2ini | |
5575 | * .or.naflav0.ne.naflav.or.epmax0 .ne.epmax.or. pt2cut.ne.pt2cut0) | |
5576 | * then | |
5577 | write(ifmt,'(//a//)')' initl has to be reinitialized!!!' | |
5578 | stop | |
5579 | endif | |
5580 | read (1,*)csbor,csord,cstot,cstotzero,csborzer | |
5581 | close(1) | |
5582 | endif | |
5583 | ||
5584 | goto 1 | |
5585 | endif | |
5586 | ||
5587 | write(ifmt,'(a)')'initl does not exist -> calculate tables ...' | |
5588 | ||
5589 | write (*,*)'Born xsection csbor' | |
5590 | spmin=4.*q2min | |
5591 | spminc=4.*q2min+qcmass**2 | |
5592 | do m=1,4 !parton type at upper end of the ladder (1...4 - g,u,d,c) | |
5593 | do k=1,20 | |
5594 | if(m.ne.4)then | |
5595 | sk=spmin*(epmax/2./spmin)**((k-1)/19.) | |
5596 | p1=sk | |
5597 | else | |
5598 | sk=spminc*(epmax/2./spminc)**((k-1)/19.) | |
5599 | p1=sk/(1.+qcmass**2/sk) | |
5600 | endif | |
5601 | qmax=p1/4. | |
5602 | do i=1,20 | |
5603 | qq=q2min*(qmax/q2min)**((i-1)/19.) | |
5604 | do l=1,2 !parton type at lower end of the ladder | |
5605 | k1=k+20*(m-1)+80*(l-1) | |
5606 | m1=m-1 | |
5607 | if(m.eq.3.and.l.eq.1)then !dd~ | |
5608 | l1=-m1 | |
5609 | else !du | |
5610 | l1=l-1 | |
5611 | endif !born cr.-sect. | |
5612 | csbor(i,k1,1)=log(max(1.e-30,psborn(qq,qq,qq,sk,m1,l1,0,0))) | |
5613 | if(m.ne.4)then | |
5614 | csbor(i,k1,2)=log(max(1.e-30,psborn(4.*qq,qq,qq,sk,m1,l1,1,0))) | |
5615 | endif | |
5616 | enddo | |
5617 | enddo | |
5618 | enddo | |
5619 | enddo | |
5620 | ||
5621 | write (*,*)'ordered jet xsection csord' | |
5622 | do m=1,4 !parton type at upper end of the ladder | |
5623 | do k=1,20 | |
5624 | write (*,*)' m=',m,'/4 k=',k,'/20' | |
5625 | if(m.ne.4)then | |
5626 | sk=spmin*(epmax/2./spmin)**((k-1)/19.) !c.m. energy squared for the hard | |
5627 | p1=sk | |
5628 | else | |
5629 | sk=spminc*(epmax/2./spminc)**((k-1)/19.) | |
5630 | p1=sk/(1.+qcmass**2/sk) | |
5631 | endif | |
5632 | qmax=p1/4. | |
5633 | tmax=p1/2. | |
5634 | do i=1,20 !cross-sections initialization | |
5635 | qi=q2min*(qmax/q2min)**((i-1)/19.) | |
5636 | do j=1,20 | |
5637 | qq=qi*(qmax/qi)**((j-1)/19.) | |
5638 | if(p1.gt.4.*qq)then | |
5639 | tmin=2.*qq/(1.+sqrt(1.-4.*qq/p1)) | |
5640 | else | |
5641 | tmin=2.*qq | |
5642 | endif | |
5643 | do l=1,2 !parton type at lower end of the ladder | |
5644 | m1=m-1 | |
5645 | if(m.eq.3.and.l.eq.1)then | |
5646 | l1=-m1 | |
5647 | else | |
5648 | l1=l-1 | |
5649 | endif | |
5650 | if(m.ne.4)then | |
5651 | k1=k+20*(m-1)+60*(l-1) | |
5652 | if(k.eq.1.or.i.eq.20.or.j.eq.20)then | |
5653 | csord(i,j,k1)=log(max(1.e-30,psborn(qi,qq,qq,sk,m1,l1,0,0))) | |
5654 | csord(i,j,k1+120)= | |
5655 | * log(max(1.e-30,psborn(4.*qq,qi,qq,sk,l1,m1,1,0))) | |
5656 | else | |
5657 | csord(i,j,k1)=log(psjet1(qi,qq,qq,sk,m1,l1,0) | |
5658 | * /(1./tmin-1./tmax)+psborn(qi,qq,qq,sk,m1,l1,0,0)) | |
5659 | csord(i,j,k1+120)=log(psjet1(qi,4.*qq,qq,sk,m1,l1,2) | |
5660 | * /(1./tmin-1./tmax)+psborn(4.*qq,qi,qq,sk,l1,m1,1,0)) | |
5661 | ||
5662 | endif | |
5663 | elseif(j.eq.1)then | |
5664 | if(k.eq.1.or.i.eq.20)then | |
5665 | cschar(i,k,l)=log(max(1.e-30,psborn(q2min,qi,qq,sk,m1,l1,0,0))) | |
5666 | else | |
5667 | cschar(i,k,l)=log(psjet1(qi,q2min,qq,sk,l1,m1,0) | |
5668 | * /(1./tmin-1./tmax)+psborn(q2min,qi,qq,sk,m1,l1,0,0)) | |
5669 | endif | |
5670 | endif | |
5671 | enddo | |
5672 | enddo | |
5673 | enddo | |
5674 | enddo | |
5675 | enddo | |
5676 | ||
5677 | write (ifmt,*)'tests:' | |
5678 | write (ifmt,'(a,a)')' n-1 sk qi qj qq ' | |
5679 | * ,' born born-i ord ord-i ' | |
5680 | do k=1,7 | |
5681 | sk=spmin*(epmax/2./spmin)**((k-1)/19.) | |
5682 | if(k.ge.5)sk=spmin*1.5**(k-4) | |
5683 | do n=1,2 | |
5684 | if(n.eq.1)then | |
5685 | qmax1=sk/4. | |
5686 | qmax2=sk/4. | |
5687 | elseif(n.eq.2)then | |
5688 | qmax1=sk/4. | |
5689 | qmax2=sk | |
5690 | endif | |
5691 | do i=1,3 | |
5692 | qi=q2min*(qmax1/q2min)**((i-1)/3.) | |
5693 | do j=1,3 | |
5694 | qj=q2min*(qmax2/q2min)**((j-1)/3.) | |
5695 | qqmax=sk/4. | |
5696 | if(n.eq.1)then | |
5697 | qqmin=max(qi,qj) | |
5698 | else | |
5699 | qqmin=max(qi,qj/4.) | |
5700 | endif | |
5701 | do lq=1,3 | |
5702 | qq=qqmin*(qqmax/qqmin)**((lq-1)/3.) | |
5703 | if(sk.gt.4.*qq)then | |
5704 | tmin=2.*qq/(1.+sqrt(1.-4.*qq/sk)) | |
5705 | else | |
5706 | tmin=2.*qq | |
5707 | endif | |
5708 | tmax=sk/2. | |
5709 | do m=1,1 !parton type at upper end of the ladder (1 | |
5710 | do l=1,1 !parton type at lower end of the ladder (1 | |
5711 | m1=m-1 | |
5712 | if(m.eq.3.and.l.eq.1)then | |
5713 | l1=-m1 | |
5714 | else | |
5715 | l1=l-1 | |
5716 | endif | |
5717 | a=psborn(qj,qi,qq,sk,l1,m1,n-1,0)*(1./tmin-1./tmax) | |
5718 | b=psbint(qj,qi,qq,sk,l1,m1,n-1) | |
5719 | c=psjet1(qi,qj,qq,sk,m1,l1,2*(n-1)) | |
5720 | * +psborn(qj,qi,qq,sk,l1,m1,n-1,0)*(1./tmin-1./tmax) | |
5721 | d=psjti1(qi,qj,qq,sk,m1,l1,n-1) | |
5722 | write (ifmt,'(i3,4f9.1,3x,4f9.4)')n-1,sk,qi,qj,qq,a,b,c,d | |
5723 | enddo | |
5724 | enddo | |
5725 | enddo | |
5726 | enddo | |
5727 | enddo | |
5728 | enddo | |
5729 | enddo | |
5730 | ||
5731 | write (*,*)'jet xsection cstot' | |
5732 | do k=1,20 | |
5733 | write (*,*)'k=',k,'/20' | |
5734 | sk=spmin*(epmax/2./spmin)**((k-1)/19.) !c.m. energy squared for the hard | |
5735 | qmax=sk/4. | |
5736 | tmax=sk/2. | |
5737 | do i=1,20 !cross-sections initialization | |
5738 | do n=1,2 | |
5739 | if(n.eq.1)then | |
5740 | qi=q2min*(qmax/q2min)**((i-1)/19.) | |
5741 | else | |
5742 | qi=q2min*(4.*qmax/q2min)**((i-1)/19.) | |
5743 | endif | |
5744 | do j=1,20 | |
5745 | if(n.eq.1)then | |
5746 | qq=qi*(qmax/qi)**((j-1)/19.) | |
5747 | else | |
5748 | qq=max(q2min,qi/4.)*(qmax/max(q2min,qi/4.))** | |
5749 | * ((j-1)/19.) | |
5750 | endif | |
5751 | if(sk.gt.4.*qq)then | |
5752 | tmin=2.*qq/(1.+sqrt(1.-4.*qq/sk)) | |
5753 | else | |
5754 | tmin=2.*qq | |
5755 | endif | |
5756 | do m=1,3 !parton type at upper end of the ladder (1 | |
5757 | do l=1,2 !parton type at lower end of the ladder (1 | |
5758 | m1=m-1 | |
5759 | if(m.eq.3.and.l.eq.1)then | |
5760 | l1=-m1 | |
5761 | else | |
5762 | l1=l-1 | |
5763 | endif | |
5764 | k1=k+20*(m-1)+60*(l-1)+120*(n-1) | |
5765 | if(k.eq.1.or.i.eq.20.or.j.eq.20)then | |
5766 | cstot(i,j,k1)=log(max(1.e-30,psborn(qi,q2min,qq,sk,m1,l1,n-1,0))) | |
5767 | else | |
5768 | if(n.eq.1)then | |
5769 | cstot(i,j,k1)=log((psjet(qi,q2min,qq,sk,m1,l1,0)+ | |
5770 | * psjti1(qi,q2min,qq,sk,m1,l1,0)+ | |
5771 | * psjti1(q2min,qi,qq,sk,l1,m1,0) | |
5772 | * -psbint(qi,q2min,qq,sk,m1,l1,0))/(1./tmin-1./tmax)) | |
5773 | else | |
5774 | cstot(i,j,k1)=log((psjet(qi,q2min,qq,sk,m1,l1,1)+ | |
5775 | * psjet1(qi,q2min,qq,sk,m1,l1,1)+ | |
5776 | * psjti1(q2min,qi,qq,sk,l1,m1,1))/(1./tmin-1./tmax)) | |
5777 | endif | |
5778 | endif | |
5779 | enddo | |
5780 | enddo | |
5781 | enddo | |
5782 | enddo | |
5783 | enddo | |
5784 | enddo | |
5785 | ||
5786 | c total and born hard cross-sections logarithms for minimal cutoff | |
5787 | c (q2min), interpolated in the psjti0 procedure | |
5788 | 2 spmin=4.*q2min | |
5789 | spminc=4.*q2min+qcmass**2 | |
5790 | do m=1,4 | |
5791 | do l=1,2 | |
5792 | m1=m-1 | |
5793 | if(m.eq.3.and.l.eq.1)then | |
5794 | l1=-m1 | |
5795 | else | |
5796 | l1=l-1 | |
5797 | endif | |
5798 | do k=1,20 | |
5799 | if(m.ne.4)then | |
5800 | sk=spmin*(epmax/2./spmin)**((k-1)/19.) !c.m. energy squared for the hard | |
5801 | p1=sk | |
5802 | qq=q2min | |
5803 | else | |
5804 | sk=spminc*(epmax/2./spminc)**((k-1)/19.) | |
5805 | p1=sk/(1.+qcmass**2/sk) | |
5806 | qq=q2min | |
5807 | endif | |
5808 | if(p1.gt.4.*qq)then | |
5809 | tmin=2.*qq/(1.+sqrt(1.-4.*qq/p1)) | |
5810 | else | |
5811 | tmin=2.*qq | |
5812 | endif | |
5813 | tmax=p1/2. | |
5814 | ||
5815 | k1=k+20*(m-1)+80*(l-1) | |
5816 | csborzer(k,m,l) | |
5817 | * =log(max(1.e-30,psborn(q2min,q2min,qq,sk,m1,l1,0,0))) | |
5818 | if(k.eq.1)then | |
5819 | cstotzero(k,m,l)=csborzer(k,m,l) | |
5820 | elseif(m.ne.4)then | |
5821 | cstotzero(k,m,l)=log(psjti(q2min,qq,sk,m1,l1,0)/ | |
5822 | * (1./tmin-1./tmax)) | |
5823 | else | |
5824 | smins=2.5*q2min*(1.+sqrt(1.+4.*qcmass**2/q2min)) | |
5825 | if(sk.le.smins)then | |
5826 | cstotzero(k,m,l)=log(psjci(q2min,sk,l1)/(1./tmin-1./tmax)) | |
5827 | else | |
5828 | cstotzero(k,m,l)=log((psjci(q2min,sk,l1)+psjct(sk,l1)) | |
5829 | * /(1./tmin-1./tmax)) | |
5830 | endif | |
5831 | endif | |
5832 | enddo | |
5833 | enddo | |
5834 | enddo | |
5835 | ||
5836 | write(ifmt,'(a)')'write to initl ...' | |
5837 | open(1,file=fnii(1:nfnii),status='unknown') | |
5838 | write (1,*)qcdlam,q2min,q2ini,naflav,epmax,pt2cut | |
5839 | write (1,*)csbor,csord,cstot,cstotzero,csborzer,cschar | |
5840 | close(1) | |
5841 | ||
5842 | 1 continue | |
5843 | ||
5844 | if(iappl.ne.8)goto 3 | |
5845 | if(ish.ge.3)write(ifch,*)'dis cross sections ...' | |
5846 | inquire(file=fnid(1:nfnid),exist=lcalc) | |
5847 | if(lcalc)then | |
5848 | if(inicnt.eq.1)then | |
5849 | write(ifmt,'(3a)')'read from ',fnid(1:nfnid),' ...' | |
5850 | open(1,file=fnid(1:nfnid),status='old') | |
5851 | read (1,*)qcdlam0,q2min0,q2ini0,naflav0,epmax0,edmax0 | |
5852 | if(qcdlam0.ne.qcdlam)write(ifmt,'(a)')'inidi: wrong qcdlam' | |
5853 | if(q2min0 .ne.q2min )write(ifmt,'(a)')'inidi: wrong q2min' | |
5854 | if(q2ini0 .ne.q2ini )write(ifmt,'(a)')'inidi: wrong q2ini' | |
5855 | if(naflav0.ne.naflav)write(ifmt,'(a)')'inidi: wrong naflav' | |
5856 | if(epmax0 .ne.epmax )write(ifmt,'(a)')'inidi: wrong epmax' | |
5857 | if(edmax0 .ne.edmax )write(ifmt,'(a)')'inidi: wrong edmax' | |
5858 | if(qcdlam0.ne.qcdlam.or.q2min0 .ne.q2min.or.q2ini0 .ne.q2ini | |
5859 | * .or.naflav0.ne.naflav.or.epmax0 .ne.epmax | |
5860 | * .or.edmax0 .ne.edmax)then | |
5861 | write(ifmt,'(//a//)')' inidi has to be reinitialized!!!' | |
5862 | stop | |
5863 | endif | |
5864 | read (1,*)csdsi,csds,csdt,csdr | |
5865 | close(1) | |
5866 | endif | |
5867 | goto 3 | |
5868 | endif | |
5869 | ||
5870 | write(ifmt,'(a)')'inidi does not exist -> calculate tables ...' | |
5871 | do j=1,21 | |
5872 | qq=q2min*exp(.5*(j-1)) !photon virtuality | |
5873 | ||
5874 | do m=1,2 !parton type at the end of the ladder | |
5875 | q2mass=qcmass**2 | |
5876 | s2min=4.*max(q2mass,q2min)+qq | |
5877 | if(m.eq.2)s2min=s2min/(1.-4.*q2ini/(s2min-qq)) | |
5878 | do k=1,26 | |
5879 | write (*,*)'sin,j,m,k',j,m,k | |
5880 | sk=s2min*(edmax/s2min)**(.04*(k-1)) !c.m. energy squared | |
5881 | if(k.eq.26)sk=1.01*sk | |
5882 | qmin=q2min | |
5883 | if(m.eq.1)then | |
5884 | qmax=(sk-qq)/4. | |
5885 | else | |
5886 | qmax=(sk-qq+sqrt((sk-qq)**2-16.*sk*q2ini))/8. | |
5887 | endif | |
5888 | ||
5889 | do i=1,21 !cross-sections calculation | |
5890 | qi=qmin*(qmax/qmin)**((i-1)/20.) | |
5891 | tmax=.5*sk | |
5892 | qtq=4.*max(q2mass,qi)/(sk-qq) | |
5893 | if(qtq.lt.1.)then | |
5894 | tmin=.5*sk*qtq/(1.+sqrt(1.-qtq)) | |
5895 | else | |
5896 | tmin=.5*sk | |
5897 | endif | |
5898 | ||
5899 | do ilong=1,2 | |
5900 | k1=k+26*(m-1)+52*(ilong-1) | |
5901 | if(m.eq.1)then | |
5902 | if(tmax.gt.1.01*tmin)then | |
5903 | sij=psds(qi,qq,sk,m-1,ilong-1) | |
5904 | if(sij.lt.0.)write (*,*)'qi,qq,sk,m,long,sij', | |
5905 | * qi,qq,sk,m,ilong,sij | |
5906 | csdsi(i,j,k1)=log(max(0.,sij)/(1./tmin-1./tmax) | |
5907 | * +psdbor(qi,qq,sk,ilong-1)) | |
5908 | else | |
5909 | csdsi(i,j,k1)= | |
5910 | * log(max(1.e-25,psdbor(qi,qq,sk,ilong-1))) | |
5911 | endif | |
5912 | else | |
5913 | csdsi(i,j,k1)=psds(qi,qq,sk,m-1,ilong-1) | |
5914 | endif | |
5915 | enddo | |
5916 | enddo | |
5917 | enddo | |
5918 | enddo | |
5919 | enddo | |
5920 | ||
5921 | 800 continue | |
5922 | do j=1,21 | |
5923 | qq=q2min*exp(.5*(j-1)) !photon virtuality | |
5924 | s2min=max(4.*qq,16.*q2min) !pt2dis=qq | |
5925 | do m=1,2 | |
5926 | do k=1,26 | |
5927 | do ilong=1,2 | |
5928 | k1=k+26*(m-1)+52*(ilong-1) | |
5929 | csds(j,k,m+2*(ilong-1))=csdsi(1,j,k1) | |
5930 | enddo | |
5931 | ||
5932 | sk=(s2min+qq)*(edmax/(s2min+qq))**(.04*(k-1)) | |
5933 | csdt(j,k,m)=psdres(qq,sk,s2min,m-1) | |
5934 | csdr(j,k,m)=psdrga(qq,sk-qq,s2min,m-1) | |
5935 | enddo | |
5936 | enddo | |
5937 | enddo | |
5938 | ||
5939 | write(ifmt,'(a)')'write to inidi ...' | |
5940 | ||
5941 | write(ifmt,'(a)')'write to inidi ...' | |
5942 | open(1,file=fnid(1:nfnid),status='unknown') | |
5943 | write (1,*)qcdlam,q2min,q2ini,naflav,epmax,edmax | |
5944 | write (1,*)csdsi,csds,csdt,csdr | |
5945 | close(1) | |
5946 | 3 continue | |
5947 | ||
5948 | c--------------------------------------- | |
5949 | c tabulation of semihard eikonals | |
5950 | c--------------------------------------- | |
5951 | ||
5952 | !!!!!!!!! if(iappl.eq.1)then | |
5953 | ||
5954 | if(ish.ge.4)write(ifch,*)'semihard eikonals ...' | |
5955 | 5 continue | |
5956 | inquire(file=fnrj,exist=lcalc) | |
5957 | if(lcalc)then | |
5958 | if(inicnt.eq.1)then | |
5959 | write(ifmt,'(3a)')'read from ',fnrj(1:nfnrj),' ...' | |
5960 | open(1,file=fnrj(1:nfnrj),status='old') | |
5961 | read (1,*)alpqua0,alplea0,alppom0,slopom0, | |
5962 | * gamhad0,r2had0,chad0, | |
5963 | * qcdlam0,q2min0,q2ini0,betpom0,glusea0,naflav0, | |
5964 | * factk0,pt2cut0,gamtil0 | |
5965 | if(alpqua0.ne.alpqua)write(ifmt,'(a,2f8.4)') | |
5966 | * 'inirj: wrong alpqua',alpqua0,alpqua | |
5967 | if(alppom0.ne.alppom)write(ifmt,'(a,2f8.4)') | |
5968 | * 'inirj: wrong alppom',alppom0,alppom | |
5969 | if(slopom0.ne.slopom)write(ifmt,'(a,2f8.4)') | |
5970 | * 'inirj: wrong slopom',slopom0,slopom | |
5971 | iii=2 | |
5972 | if(gamhad0(iii).ne.gamhad(iii))write(ifmt,'(a,i1,a,2f8.4)') | |
5973 | * 'inirj: wrong gamhad(',iii,')',gamhad0(iii),gamhad(iii) | |
5974 | do iii=1,3 | |
5975 | if(r2had0(iii) .ne.r2had(iii) )write(ifmt,'(a,i1,a,2f8.4)') | |
5976 | * 'inirj: wrong r2had(',iii,')',r2had0(iii),r2had(iii) | |
5977 | if(chad0(iii) .ne.chad(iii) )write(ifmt,'(a,i1,a,2f8.4)') | |
5978 | * 'inirj: wrong chad(',iii,')',chad0(iii),chad(iii) | |
5979 | if(alplea0(iii).ne.alplea0(iii))write(ifmt,'(a,i1,a,2f8.4)') | |
5980 | * 'inirj: wrong alplea(',iii,')',alplea0(iii),alplea(iii) | |
5981 | enddo | |
5982 | if(qcdlam0.ne.qcdlam)write(ifmt,'(a,2f8.4)') | |
5983 | * 'inirj: wrong qcdlam',qcdlam0,qcdlam | |
5984 | if(q2min0 .ne.q2min )write(ifmt,'(a,2f8.4)') | |
5985 | * 'inirj: wrong q2min',q2min0,q2min | |
5986 | if(q2ini0 .ne.q2ini )write(ifmt,'(a,2f8.4)') | |
5987 | * 'inirj: wrong q2ini',q2ini0,q2ini | |
5988 | if(betpom0.ne.betpom)write(ifmt,'(a,2f8.4)') | |
5989 | * 'inirj: wrong betpom',betpom0,betpom | |
5990 | if(glusea0.ne.glusea)write(ifmt,'(a,2f8.4)') | |
5991 | * 'inirj: wrong glusea',glusea0,glusea | |
5992 | if(naflav0.ne.naflav)write(ifmt,'(a,2f8.4)') | |
5993 | * 'inirj: wrong naflav',naflav0,naflav | |
5994 | if(factk0 .ne.factk )write(ifmt,'(a,2f8.4)') | |
5995 | * 'inirj: wrong factk', factk0,factk | |
5996 | if(pt2cut0 .ne.pt2cut )write(ifmt,'(a,2f8.4)') | |
5997 | * 'inirj: wrong pt2cut', pt2cut0,pt2cut | |
5998 | if(gamtil0 .ne.gamtil )write(ifmt,'(a,2f8.4)') | |
5999 | * 'inirj: wrong gamtil', gamtil0,gamtil | |
6000 | if(alpqua0.ne.alpqua.or.alppom0.ne.alppom | |
6001 | * .or.slopom0.ne.slopom.or.gamhad0(2).ne.gamhad(2) | |
6002 | * .or.r2had0(1).ne.r2had(1).or.r2had0(2).ne.r2had(2) | |
6003 | * .or.r2had0(3).ne.r2had(3) | |
6004 | * .or.chad0(1).ne.chad(1).or.chad0(2).ne.chad(2) | |
6005 | * .or.chad0(3).ne.chad(3) | |
6006 | * .or.alplea0(1).ne.alplea(1).or.alplea0(2).ne.alplea(2) | |
6007 | * .or.alplea0(3).ne.alplea(3) | |
6008 | * .or.qcdlam0.ne.qcdlam.or.q2min0 .ne.q2min | |
6009 | * .or.q2ini0 .ne.q2ini.or.gamtil0.ne.gamtil | |
6010 | * .or.betpom0.ne.betpom.or.glusea0.ne.glusea.or.naflav0.ne.naflav | |
6011 | * .or.factk0 .ne.factk .or.pt2cut0.ne.pt2cut)then | |
6012 | write(ifmt,'(//a//)')' inirj has to be reinitialized!!!!' | |
6013 | stop | |
6014 | endif | |
6015 | ||
6016 | read(1,*)fhgg,fhqg,fhgq,fhqq,fhgg0,fhgg1,fhqg1 | |
6017 | * ,fhgg01,fhgg02,fhgg11,fhgg12,fhqg11,fhqg12 | |
6018 | * ,ftoint,vfro,vnorm,coefxu1,coefxu2,coefxc2 | |
6019 | read(1,*)bkbin0,iclpro10,iclpro20,icltar10,icltar20,iclegy10 | |
6020 | * ,iclegy20,egylow0,egymax0,iomega0,egyscr0,epscrw0,epscrp0 | |
6021 | if(isetcs.gt.1)then | |
6022 | textini=' ' | |
6023 | if(iclpro10.ne.iclpro1)write(textini,'(a,2i8)') | |
6024 | * 'inirj: wrong iclpro1 ',iclpro10,iclpro1 | |
6025 | if(iclpro20.ne.iclpro2)write(textini,'(a,2i8)') | |
6026 | * 'inirj: wrong iclpro2 ',iclpro20,iclpro2 | |
6027 | if(icltar10.ne.icltar1)write(textini,'(a,2i8)') | |
6028 | * 'inirj: wrong icltar1 ',icltar10,icltar1 | |
6029 | if(icltar20.ne.icltar2)write(textini,'(a,2i8)') | |
6030 | * 'inirj: wrong icltar2 ',icltar20,icltar2 | |
6031 | if(iclegy10.ne.iclegy1)write(textini,'(a,2i8)') | |
6032 | * 'inirj: wrong iclegy1 ',iclegy10,iclegy1 | |
6033 | if(iclegy20.ne.iclegy2)write(textini,'(a,2i8)') | |
6034 | * 'inirj: wrong iclegy2 ',iclegy20,iclegy2 | |
6035 | if(egylow0.ne.egylow)write(textini,'(a,2f8.4)') | |
6036 | * 'inirj: wrong egylow ',egylow0,egylow | |
6037 | if(egymax0.ne.egymax)write(textini,'(a,2f8.4)') | |
6038 | * 'inirj: wrong egymax ',egymax0,egymax | |
6039 | if(epscrw0.ne.epscrw)write(textini,'(a,2f8.4)') | |
6040 | * 'inirj: wrong epscrw ',epscrw0,epscrw | |
6041 | if(epscrp0.ne.epscrp)write(textini,'(a,2f8.4)') | |
6042 | * 'inirj: wrong epscrp ',epscrp0,epscrp | |
6043 | if(bkbin0.ne.bkbin)write(textini,'(a,2f8.4)') | |
6044 | * 'inirj: wrong bkbin',bkbin0,bkbin | |
6045 | if(textini.ne.' ')then | |
6046 | write(ifmt,'(//10x,a//10x,a//)')textini, | |
6047 | * 'inirj has to be reinitialized!!!!' | |
6048 | stop | |
6049 | endif | |
6050 | do iiipro=iclpro1,iclpro2 | |
6051 | do iiitar=icltar1,icltar2 | |
6052 | do iiiegy=iclegy1,iclegy2 | |
6053 | do iiib=1,nbkbin | |
6054 | read(1,*)xkappafit(iiiegy,iiipro,iiitar,iiib) | |
6055 | enddo | |
6056 | xkappafit(iiiegy,iiipro,iiitar,nbkbin)=1. | |
6057 | do iiib=2,nbkbin-1 | |
6058 | if(xkappafit(iiiegy,iiipro,iiitar,iiib).lt.1.)then | |
6059 | xkappafit(iiiegy,iiipro,iiitar,iiib)=max(1.,0.5* | |
6060 | * (xkappafit(iiiegy,iiipro,iiitar,iiib-1) | |
6061 | * +xkappafit(iiiegy,iiipro,iiitar,iiib+1))) | |
6062 | endif | |
6063 | enddo | |
6064 | do iiidf=idxD0,idxD | |
6065 | read(1,*)alpDs(iiidf,iiiegy,iiipro,iiitar), | |
6066 | * alpDps(iiidf,iiiegy,iiipro,iiitar), | |
6067 | * alpDpps(iiidf,iiiegy,iiipro,iiitar), | |
6068 | * betDs(iiidf,iiiegy,iiipro,iiitar), | |
6069 | * betDps(iiidf,iiiegy,iiipro,iiitar), | |
6070 | * betDpps(iiidf,iiiegy,iiipro,iiitar), | |
6071 | * gamDs(iiidf,iiiegy,iiipro,iiitar), | |
6072 | * delDs(iiidf,iiiegy,iiipro,iiitar) | |
6073 | enddo | |
6074 | enddo | |
6075 | enddo | |
6076 | enddo | |
6077 | endif | |
6078 | ||
6079 | close(1) | |
6080 | ||
6081 | endif | |
6082 | ||
6083 | ||
6084 | goto 4 | |
6085 | endif | |
6086 | ||
6087 | write(ifmt,'(a)')'inirj does not exist -> calculate tables ...' | |
6088 | ||
6089 | engysave=engy | |
6090 | maprojsave=maproj | |
6091 | matargsave=matarg | |
6092 | iclpros=iclpro | |
6093 | icltars=icltar | |
6094 | spmin=4.*q2min | |
6095 | spminc=4.*q2min+2.*qcmass**2 | |
6096 | icltar=2 | |
6097 | ||
6098 | write(ifmt,'(a)')' tabulate om5 ...' | |
6099 | ||
6100 | do iy=1,11 | |
6101 | sy=spmin*(epmax/2./spmin)**((iy-1)/10.) | |
6102 | syc=spminc*(epmax/2./spminc)**((iy-1)/10.) | |
6103 | iclpro=2 | |
6104 | icltar=2 | |
6105 | if(iy.eq.1)then | |
6106 | fhgg01(iy)=-80. | |
6107 | fhgg02(iy)=-80. | |
6108 | else | |
6109 | fhgg01(iy)=log(om51pp(sy,1.,1.,3)) | |
6110 | fhgg02(iy)=log(om51pp(sy,1.,1.,7)) | |
6111 | endif | |
6112 | ||
6113 | do iclpro=iclpro1,iclpro2 | |
6114 | if(iy.eq.1)then | |
6115 | fhgg11(iy,iclpro)=-80. | |
6116 | fhgg12(iy,iclpro)=-80. | |
6117 | else | |
6118 | fhgg11(iy,iclpro)=log(om51pp(sy,1.,1.,4)) | |
6119 | fhgg12(iy,iclpro)=log(om51pp(sy,1.,1.,9)) | |
6120 | endif | |
6121 | do ix=1,10 | |
6122 | if(ix.le.5)then | |
6123 | xp=.1*2.**(ix-5) | |
6124 | else | |
6125 | xp=.2*(ix-5) | |
6126 | endif | |
6127 | if(iy.eq.1)then | |
6128 | fhqg11(iy,ix,iclpro)=-80. | |
6129 | fhqg12(iy,ix,iclpro)=-80. | |
6130 | elseif(iclpro.eq.4)then | |
6131 | fhqg11(iy,ix,iclpro)=log(om51pp(syc,1.,1.,5)) | |
6132 | fhqg12(iy,ix,iclpro)=log(om51pp(syc,1.,1.,11)) | |
6133 | else | |
6134 | fhqg11(iy,ix,iclpro)=log(om51pp(sy,xp,1.,5)) | |
6135 | fhqg12(iy,ix,iclpro)=log(om51pp(sy,xp,1.,11)) | |
6136 | endif | |
6137 | enddo | |
6138 | enddo | |
6139 | ||
6140 | do iz=1,10 | |
6141 | z=.1*iz | |
6142 | ||
6143 | iclpro=2 | |
6144 | icltar=2 | |
6145 | if(iy.eq.1)then | |
6146 | fhgg0(iy,iz)=-80. | |
6147 | else | |
6148 | fhgg0(iy,iz)=log(om51pp(sy,1.,z,6)/z) | |
6149 | endif | |
6150 | ||
6151 | do iclpro=iclpro1,iclpro2 | |
6152 | if(iy.eq.1)then | |
6153 | fhgg1(iy,iz,iclpro)=-80. | |
6154 | else | |
6155 | fhgg1(iy,iz,iclpro)=log(om51pp(sy,1.,z,8)/z) | |
6156 | endif | |
6157 | ||
6158 | do ix=1,10 | |
6159 | if(ix.le.5)then | |
6160 | xp=.1*2.**(ix-5) | |
6161 | else | |
6162 | xp=.2*(ix-5) | |
6163 | endif | |
6164 | if(iy.eq.1)then | |
6165 | fhqg1(iy,ix,iz+10*(iclpro-1))=-80. | |
6166 | elseif(iclpro.eq.4)then | |
6167 | fhqg1(iy,ix,iz+10*(iclpro-1))=log(om51pp(syc,xp,z,10)/z) | |
6168 | else | |
6169 | fhqg1(iy,ix,iz+10*(iclpro-1))=log(om51pp(sy,xp,z,10)/z) | |
6170 | endif | |
6171 | enddo | |
6172 | enddo | |
6173 | enddo | |
6174 | enddo | |
6175 | ||
6176 | do iclpro=iclpro1,iclpro2 !hadron type (1 - pion, 2 - nucleon, 3 - kaon, 4 - charm) | |
6177 | do icltar=icltar1,icltar2 !hadron type (2 - nucleon) | |
6178 | do iy=1,11 | |
6179 | sy=spmin*(epmax/2./spmin)**((iy-1)/10.) | |
6180 | syc=spminc*(epmax/2./spminc)**((iy-1)/10.) | |
6181 | do iz=1,10 | |
6182 | z=.1*iz | |
6183 | if(iy.eq.1)then | |
6184 | fhgg(iy,iz,iclpro+4*(icltar-1))=-80. | |
6185 | else | |
6186 | fhgg(iy,iz,iclpro+4*(icltar-1))=log(om51pp(sy,1.,z,0)/z) | |
6187 | endif | |
6188 | ||
6189 | do ix=1,10 | |
6190 | if(ix.le.5)then | |
6191 | xp=.1*2.**(ix-5) | |
6192 | else | |
6193 | xp=.2*(ix-5) | |
6194 | endif | |
6195 | if(iy.eq.1)then | |
6196 | fhqg(iy,ix,iz+10*(iclpro+4*(icltar-1)-1))=-80. | |
6197 | fhgq(iy,ix,iz+10*(iclpro+4*(icltar-1)-1))=-80. | |
6198 | else | |
6199 | if(iclpro.ne.4)then | |
6200 | syx=sy | |
6201 | else | |
6202 | syx=syc | |
6203 | endif | |
6204 | fhqg(iy,ix,iz+10*(iclpro+4*(icltar-1)-1))= | |
6205 | * log(om51pp(syx,xp,z,1)/z) | |
6206 | if(icltar.ne.4)then | |
6207 | syx=sy | |
6208 | else | |
6209 | syx=syc | |
6210 | endif | |
6211 | fhgq(iy,ix,iz+10*(iclpro+4*(icltar-1)-1))= | |
6212 | * log(om51pp(syx,xp,z,2)/z) | |
6213 | endif | |
6214 | enddo | |
6215 | enddo | |
6216 | ||
6217 | do ix1=1,10 | |
6218 | if(ix1.le.5)then | |
6219 | xpp=.1*2.**(ix1-5) | |
6220 | else | |
6221 | xpp=.2*(ix1-5) | |
6222 | endif | |
6223 | do ix2=1,10 | |
6224 | if(ix2.le.5)then | |
6225 | xmm=.1*2.**(ix2-5) | |
6226 | else | |
6227 | xmm=.2*(ix2-5) | |
6228 | endif | |
6229 | ||
6230 | if(iy.eq.1)then | |
6231 | fhqq(iy,ix1,ix2+10*(iclpro+4*(icltar-1)-1))=-80. | |
6232 | else | |
6233 | if(iclpro.ne.4.and.icltar.ne.4)then | |
6234 | syx=sy | |
6235 | else | |
6236 | syx=syc | |
6237 | endif | |
6238 | fhqq(iy,ix1,ix2+10*(iclpro+4*(icltar-1)-1))= | |
6239 | * log(pshard(syx,xpp,xmm)) | |
6240 | endif | |
6241 | enddo | |
6242 | enddo | |
6243 | enddo | |
6244 | enddo | |
6245 | ||
6246 | enddo | |
6247 | ||
6248 | if(isetcs.gt.1)then | |
6249 | ||
6250 | ||
6251 | write(ifmt,'(a)')' tabulate fit parameters ...' | |
6252 | ||
6253 | engysave=engy | |
6254 | do iclpro=iclpro1,iclpro2 !hadron type (1 - pion, 2 - nucleon, 3 - kaon, 4 - charm) | |
6255 | do icltar=icltar1,icltar2 !hadron type (2 - nucleon) | |
6256 | do iclegy=iclegy2,iclegy1,-1 | |
6257 | call param | |
6258 | enddo | |
6259 | do iiclegy=iclegy2,iclegy1,-1 | |
6260 | engy=egyfac**(iiclegy-1)*egylow | |
6261 | call paramini(0) | |
6262 | call Kfit(iiclegy) | |
6263 | enddo | |
6264 | enddo | |
6265 | enddo | |
6266 | engy=engysave | |
6267 | ||
6268 | endif | |
6269 | ||
6270 | write(ifmt,'(a)')' write to inirj ...' | |
6271 | open(1,file=fnrj,status='unknown') | |
6272 | write (1,*)alpqua,alplea,alppom,slopom,gamhad,r2had,chad, | |
6273 | *qcdlam,q2min,q2ini,betpom,glusea,naflav,factk,pt2cut,gamtil | |
6274 | write (1,*)fhgg,fhqg,fhgq,fhqq,fhgg0,fhgg1,fhqg1 | |
6275 | *,fhgg01,fhgg02,fhgg11,fhgg12,fhqg11,fhqg12 | |
6276 | *,ftoint,vfro,vnorm,coefxu1,coefxu2,coefxc2 | |
6277 | write(1,*)bkbin,iclpro1,iclpro2,icltar1,icltar2,iclegy1,iclegy2 | |
6278 | *,egylow,egymax,iomega,egyscr,epscrw,epscrp | |
6279 | do iiipro=iclpro1,iclpro2 | |
6280 | do iiitar=icltar1,icltar2 | |
6281 | do iiiegy=iclegy1,iclegy2 | |
6282 | do iiib=1,nbkbin | |
6283 | write(1,*)xkappafit(iiiegy,iiipro,iiitar,iiib) | |
6284 | enddo | |
6285 | do iiidf=idxD0,idxD | |
6286 | write(1,*)alpDs(iiidf,iiiegy,iiipro,iiitar), | |
6287 | * alpDps(iiidf,iiiegy,iiipro,iiitar), | |
6288 | * alpDpps(iiidf,iiiegy,iiipro,iiitar), | |
6289 | * betDs(iiidf,iiiegy,iiipro,iiitar), | |
6290 | * betDps(iiidf,iiiegy,iiipro,iiitar), | |
6291 | * betDpps(iiidf,iiiegy,iiipro,iiitar), | |
6292 | * gamDs(iiidf,iiiegy,iiipro,iiitar), | |
6293 | * delDs(iiidf,iiiegy,iiipro,iiitar) | |
6294 | enddo | |
6295 | enddo | |
6296 | enddo | |
6297 | enddo | |
6298 | ||
6299 | close(1) | |
6300 | ||
6301 | engy=engysave | |
6302 | maproj=maprojsave | |
6303 | matarg=matargsave | |
6304 | iclpro=iclpros | |
6305 | icltar=icltars | |
6306 | inicnt=1 | |
6307 | goto 5 | |
6308 | ||
6309 | 4 continue | |
6310 | ||
6311 | c-------------------------------------- | |
6312 | c inelastic cross sections | |
6313 | c--------------------------------------- | |
6314 | ||
6315 | if(isetcs.ge.2)then !-------------------- | |
6316 | ||
6317 | if(ish.ge.4)write(ifch,*)'cross sections ...' | |
6318 | 6 continue | |
6319 | inquire(file=fncs,exist=lcalc) | |
6320 | if(lcalc)then | |
6321 | if(inicnt.eq.1)then | |
6322 | write(ifmt,'(3a)')'read from ',fncs(1:nfncs),' ...' | |
6323 | open(1,file=fncs(1:nfncs),status='old') | |
6324 | read (1,*)alpqua0,alplea0,alppom0,slopom0, | |
6325 | * gamhad0,r2had0,chad0, | |
6326 | * qcdlam0,q2min0,q2ini0,betpom0,glusea0,naflav0, | |
6327 | * factk0,pt2cut0 | |
6328 | if(alpqua0.ne.alpqua)write(ifmt,'(a,2f8.4)') | |
6329 | * 'inics: wrong alpqua',alpqua0,alpqua | |
6330 | if(alppom0.ne.alppom)write(ifmt,'(a,2f8.4)') | |
6331 | * 'inics: wrong alppom',alppom0,alppom | |
6332 | if(slopom0.ne.slopom)write(ifmt,'(a,2f8.4)') | |
6333 | * 'inics: wrong slopom',slopom0,slopom | |
6334 | iii=2 | |
6335 | if(gamhad0(iii).ne.gamhad(iii))write(ifmt,'(a,i1,a,2f8.4)') | |
6336 | * 'inics: wrong gamhad(',iii,')',gamhad0(iii),gamhad(iii) | |
6337 | do iii=1,3 | |
6338 | if(r2had0(iii) .ne.r2had(iii) )write(ifmt,'(a,i1,a,2f8.4)') | |
6339 | * 'inics: wrong r2had(',iii,')',r2had0(iii),r2had(iii) | |
6340 | if(chad0(iii) .ne.chad(iii) )write(ifmt,'(a,i1,a,2f8.4)') | |
6341 | * 'inics: wrong chad(',iii,')',chad0(iii),chad(iii) | |
6342 | if(alplea0(iii).ne.alplea0(iii))write(ifmt,'(a,i1,a,2f8.4)') | |
6343 | * 'inics: wrong alplea(',iii,')',alplea0(iii),alplea(iii) | |
6344 | enddo | |
6345 | if(qcdlam0.ne.qcdlam)write(ifmt,'(a,2f8.4)') | |
6346 | * 'inics: wrong qcdlam',qcdlam0,qcdlam | |
6347 | if(q2min0 .ne.q2min )write(ifmt,'(a,2f8.4)') | |
6348 | * 'inics: wrong q2min',q2min0,q2min | |
6349 | if(q2ini0 .ne.q2ini )write(ifmt,'(a,2f8.4)') | |
6350 | * 'inics: wrong q2ini',q2ini0,q2ini | |
6351 | if(betpom0.ne.betpom)write(ifmt,'(a,2f8.4)') | |
6352 | * 'inics: wrong betpom',betpom0,betpom | |
6353 | if(glusea0.ne.glusea)write(ifmt,'(a,2f8.4)') | |
6354 | * 'inics: wrong glusea',glusea0,glusea | |
6355 | if(naflav0.ne.naflav)write(ifmt,'(a,2f8.4)') | |
6356 | * 'inics: wrong naflav',naflav0,naflav | |
6357 | if(factk0 .ne.factk )write(ifmt,'(a,2f8.4)') | |
6358 | * 'inics: wrong factk', factk0,factk | |
6359 | if(pt2cut0 .ne.pt2cut )write(ifmt,'(a,2f8.4)') | |
6360 | * 'inics: wrong pt2cut', pt2cut0,pt2cut | |
6361 | if(alpqua0.ne.alpqua.or.alppom0.ne.alppom | |
6362 | * .or.slopom0.ne.slopom.or.gamhad0(2).ne.gamhad(2) | |
6363 | * .or.r2had0(1).ne.r2had(1).or.r2had0(2).ne.r2had(2) | |
6364 | * .or.r2had0(3).ne.r2had(3) | |
6365 | * .or.chad0(1).ne.chad(1).or.chad0(2).ne.chad(2) | |
6366 | * .or.chad0(3).ne.chad(3) | |
6367 | * .or.alplea0(1).ne.alplea(1).or.alplea0(2).ne.alplea(2) | |
6368 | * .or.alplea0(3).ne.alplea(3) | |
6369 | * .or.qcdlam0.ne.qcdlam.or.q2min0 .ne.q2min | |
6370 | * .or.q2ini0 .ne.q2ini | |
6371 | * .or.betpom0.ne.betpom.or.glusea0.ne.glusea.or.naflav0.ne.naflav | |
6372 | * .or.factk0 .ne.factk .or.pt2cut0.ne.pt2cut)then | |
6373 | write(ifmt,'(//a//)')' inics has to be reinitialized!!!!' | |
6374 | stop | |
6375 | endif | |
6376 | ||
6377 | read(1,*)isetcs0,iclpro10,iclpro20,icltar10,icltar20,iclegy10 | |
6378 | * ,iclegy20,egylow0,egymax0,iomega0,egyscr0,epscrw0,epscrp0 | |
6379 | ||
6380 | if(iclpro10.ne.iclpro1)write(ifmt,'(a,2i2)') | |
6381 | * 'inics: wrong iclpro1',iclpro10,iclpro1 | |
6382 | if(iclpro20.ne.iclpro2)write(ifmt,'(a,2i2)') | |
6383 | * 'inics: wrong iclpro2',iclpro20,iclpro2 | |
6384 | if(icltar10.ne.icltar1)write(ifmt,'(a,2i2)') | |
6385 | * 'inics: wrong icltar1',icltar10,icltar1 | |
6386 | if(icltar20.ne.icltar2)write(ifmt,'(a,2i2)') | |
6387 | * 'inics: wrong icltar2',icltar20,icltar2 | |
6388 | if(iclegy10.ne.iclegy1)write(ifmt,'(a,2i4)') | |
6389 | * 'inics: wrong iclegy1',iclegy10,iclegy1 | |
6390 | if(iclegy20.ne.iclegy2)write(ifmt,'(a,2i4)') | |
6391 | * 'inics: wrong iclegy2',iclegy20,iclegy2 | |
6392 | if(egylow0.ne.egylow)write(ifmt,'(a,2f8.4)') | |
6393 | * 'inics: wrong egylow',egylow0,egylow | |
6394 | if(egymax0.ne.egymax)write(ifmt,'(a,2f12.4)') | |
6395 | * 'inics: wrong egymax',egymax0,egymax | |
6396 | if(egyscr0.ne.egyscr)write(ifmt,'(a,2f8.4)') | |
6397 | * 'inics: wrong egyscr ',egyscr0,egyscr | |
6398 | if(epscrw0.ne.epscrw)write(ifmt,'(a,2f8.4)') | |
6399 | * 'inics: wrong epscrw',epscrw0,epscrw | |
6400 | if(epscrp0.ne.epscrp)write(ifmt,'(a,2f8.4)') | |
6401 | * 'inics: wrong epscrp',epscrp0,epscrp | |
6402 | if(isetcs0.lt.isetcs)write(ifmt,'(a,2f8.4)') | |
6403 | * 'inics: wrong isetcs',isetcs0,isetcs | |
6404 | if(iclpro10.ne.iclpro1.or.iclpro20.ne.iclpro2 | |
6405 | * .or.icltar10.ne.icltar1.or.icltar20.ne.icltar2 | |
6406 | * .or.iclegy10.ne.iclegy1.or.iclegy20.ne.iclegy2 | |
6407 | * .or.egylow0.ne.egylow.or.egymax0.ne.egymax | |
6408 | * .or.egyscr0.ne.egyscr.or.epscrw0.ne.epscrw.or.isetcs0.lt.isetcs | |
6409 | * .or.epscrp0.ne.epscrp)then | |
6410 | write(ifmt,'(//a//)')' inics has to be reinitialized!!!!' | |
6411 | stop | |
6412 | endif | |
6413 | if(isetcs.eq.2)then | |
6414 | read (1,*)asect,asect2,asectn,asect4 | |
6415 | elseif(isetcs.eq.3)then | |
6416 | read (1,*)asect1,asect,asect3,asectn | |
6417 | else | |
6418 | write(ifmt,'(//a//)')' Wrong isetcs in psaini !!!!' | |
6419 | endif | |
6420 | ||
6421 | close(1) | |
6422 | ||
6423 | endif | |
6424 | ||
6425 | ||
6426 | goto 7 | |
6427 | ||
6428 | endif | |
6429 | ||
6430 | ifradesave=ifrade | |
6431 | idprojsave=idproj | |
6432 | idprojinsave=idprojin | |
6433 | idtargsave=idtarg | |
6434 | idtarginsave=idtargin | |
6435 | laprojsave=laproj | |
6436 | latargsave=latarg | |
6437 | maprojsave=maproj | |
6438 | matargsave=matarg | |
6439 | icltarsave=icltar | |
6440 | iclprosave=iclpro | |
6441 | engysave=engy | |
6442 | pnllsave=pnll | |
6443 | elabsave=elab | |
6444 | ecmssave=ecms | |
6445 | iclegysave=iclegy | |
6446 | nrevtsave=nrevt | |
6447 | neventsave=nevent | |
6448 | ntevtsave=ntevt | |
6449 | isetcssave=isetcs | |
6450 | noebinsave=noebin | |
6451 | isigmasave=isigma | |
6452 | bminimsave=bminim | |
6453 | bmaximsave=bmaxim | |
6454 | bimevtsave=bimevt | |
6455 | fctrmxsave=fctrmx | |
6456 | ||
6457 | ||
6458 | isetcs=2 | |
6459 | isigma=1 | |
6460 | noebin=1 | |
6461 | nevent=100 | |
6462 | idtarg=1120 | |
6463 | idtargin=1120 | |
6464 | bminim=0. | |
6465 | bmaxim=10000. | |
6466 | fctrmx=100. !to get stable pA and AA cross section, this number has to be large | |
6467 | ifrade=0 !to save time, no fragmentation | |
6468 | ||
6469 | write(ifmt,'(a)')'inics does not exist -> calculate tables ...' | |
6470 | ||
6471 | laproj=-1 | |
6472 | maproj=1 | |
6473 | icltar=2 | |
6474 | do iclpro=1,4 | |
6475 | if(iclpro.lt.iclpro1.or.iclpro.gt.iclpro2)then | |
6476 | do ie=1,7 | |
6477 | do iia=1,7 | |
6478 | asect1(ie,iclpro,iia)=0. | |
6479 | asect2(ie,iclpro,iia)=0. | |
6480 | enddo | |
6481 | enddo | |
6482 | else | |
6483 | do ie=1,7 | |
6484 | engy=1.5*10.**(ie-1) | |
6485 | call paramini(0) | |
6486 | write(ifmt,*)' calcul. ',ie,' (',iclpro,')',engy | |
6487 | ||
6488 | do iia=1,7 | |
6489 | matarg=2**(iia-1) | |
6490 | sigine=0. | |
6491 | if(matarg.eq.1)then !hadron-proton interaction | |
6492 | call psfz(gz2,0.) | |
6493 | gin=gz2*pi*10. | |
6494 | else | |
6495 | call conini | |
6496 | rad=radnuc(matarg) | |
6497 | bm=rad+2. | |
6498 | rrr=rad/difnuc(matarg) | |
6499 | rrrm=rrr+log(9.) | |
6500 | anorm=1.5/pi/rrr**3/(1.+(pi/rrr)**2)/difnuc(matarg)**2 | |
6501 | gin=(ptgau(ptfau,bm,2)+ptgau1(bm,2))*10. !sig_in | |
6502 | endif | |
6503 | if(ish.ge.3)write (ifch,226)gin | |
6504 | 226 format(2x,'psaini: hadron-nucleus cross sections:'/ | |
6505 | * 4x,'gin=',e10.3) | |
6506 | asect1(ie,iclpro,iia)=log(gin) | |
6507 | asect(ie,iclpro,iia)=asect1(ie,iclpro,iia) | |
6508 | write(ifmt,*)' matarg,gin :' | |
6509 | * ,matarg,gin | |
6510 | enddo | |
6511 | enddo | |
6512 | ||
6513 | if(isetcssave.ge.3)then | |
6514 | ||
6515 | if(iclpro.eq.1)then | |
6516 | idprojin=120 | |
6517 | elseif(iclpro.eq.2)then | |
6518 | idprojin=1120 | |
6519 | elseif(iclpro.eq.3)then | |
6520 | idprojin=130 | |
6521 | endif | |
6522 | do ie=1,7 | |
6523 | engy=1.5*10.**(ie-1) | |
6524 | if(engy.le.egymin)engy=egymin | |
6525 | if(engy.ge.egymax)engy=egymax | |
6526 | write(ifmt,*)' simul. ',ie,' (',iclpro,')',engy | |
6527 | write(ifch,*)' simul. ',ie,' (',iclpro,')',engy | |
6528 | do iia=1,7 | |
6529 | matarg=2**(iia-1) | |
6530 | latarg=min(1,matarg/2) | |
6531 | ntevt=0 | |
6532 | nrevt=0 | |
6533 | pnll=-1. | |
6534 | elab=-1. | |
6535 | ecms=-1. | |
6536 | ekin=-1. | |
6537 | call conini | |
6538 | call ainit | |
6539 | do n=1,nevent | |
6540 | ntry=0 | |
6541 | 222 ntevt=ntevt+1 | |
6542 | iret=0 | |
6543 | ntry=ntry+1 | |
6544 | bimevt=-1. | |
6545 | if(ntry.lt.10000)then | |
6546 | c if random sign for projectile, set it here | |
6547 | idproj=idprojin*(1-2*int(rangen()+0.5d0)) | |
6548 | call emsaaa(iret) | |
6549 | if(iret.gt.0)goto 222 | |
6550 | else | |
6551 | ntevt=ntry | |
6552 | endif | |
6553 | enddo | |
6554 | a=pi*bmax**2 | |
6555 | if(a.gt.0..and.ntevt.gt.0.)then | |
6556 | xs=float(nevent)/float(ntevt)*a*10. | |
6557 | write(ifmt,*)' matarg,nevent,ntevt,bmax,xs :' | |
6558 | . ,matarg,nevent,ntevt,bmax,xs | |
6559 | write(ifch,*)' matarg,nevent,ntevt,bmax,xs :' | |
6560 | . ,matarg,nevent,ntevt,bmax,xs | |
6561 | asect2(ie,iclpro,iia)=log(xs) | |
6562 | else | |
6563 | write(ifmt,*)' Problem ? ',iclpro,matarg,bmax,ntevt | |
6564 | asect2(ie,iclpro,iia)=0. | |
6565 | endif | |
6566 | enddo | |
6567 | enddo | |
6568 | else | |
6569 | do ie=1,7 | |
6570 | do iia=1,7 | |
6571 | asect2(ie,iclpro,iia)=0. | |
6572 | enddo | |
6573 | enddo | |
6574 | endif | |
6575 | endif | |
6576 | enddo | |
6577 | ||
6578 | idprojin=1120 | |
6579 | iclpro=2 | |
6580 | icltar=2 | |
6581 | do ie=1,7 | |
6582 | engy=1.5*10.**(ie-1) | |
6583 | call paramini(0) | |
6584 | write(ifmt,*)' calcul. AB ',ie,engy | |
6585 | ||
6586 | do iia=1,7 | |
6587 | maproj=2**(iia-1) | |
6588 | laproj=max(1,maproj/2) | |
6589 | do iib=1,7 | |
6590 | matarg=2**(iib-1) | |
6591 | latarg=max(1,matarg/2) | |
6592 | sigine=0. | |
6593 | if(matarg.eq.1.and.maproj.eq.1)then !proton-proton interaction | |
6594 | call psfz(gz2,0.) | |
6595 | gin=gz2*pi*10. | |
6596 | else | |
6597 | call conini | |
6598 | if(maproj.eq.1)then | |
6599 | rad=radnuc(matarg) | |
6600 | bm=rad+2. | |
6601 | rrr=rad/difnuc(matarg) | |
6602 | rrrm=rrr+log(9.) | |
6603 | anorm=1.5/pi/rrr**3/(1.+(pi/rrr)**2)/difnuc(matarg)**2 | |
6604 | gin=(ptgau(ptfau,bm,2)+ptgau1(bm,2))*10. !sig_in | |
6605 | elseif(matarg.eq.1)then | |
6606 | radp=radnuc(maproj) | |
6607 | bm=radp+2. | |
6608 | rrrp=radp/difnuc(maproj) | |
6609 | rrrmp=rrrp+log(9.) | |
6610 | anormp=1.5/pi/rrrp**3/(1.+(pi/rrrp)**2)/difnuc(maproj)**2 | |
6611 | gin=(ptgau(ptfau,bm,1)+ptgau1(bm,1))*10. !sig_in | |
6612 | else | |
6613 | rad=radnuc(matarg)+1. | |
6614 | radp=radnuc(maproj)+1. | |
6615 | bm=rad+radp+2. | |
6616 | rrr=rad/difnuc(matarg) | |
6617 | rrrm=rrr+log(9.) | |
6618 | rrrp=radp/difnuc(maproj) | |
6619 | rrrmp=rrrp+log(9.) | |
6620 | anorm=1.5/pi/rrr**3/(1.+(pi/rrr)**2)/difnuc(matarg)**2 | |
6621 | anormp=1.5/pi/rrrp**3/(1.+(pi/rrrp)**2)/difnuc(maproj)**2 | |
6622 | gin=(ptgau(ptfauAA,bm,2)+ptgau2(bm))*10. | |
6623 | endif | |
6624 | endif | |
6625 | if(ish.ge.3)write (ifch,227)gin | |
6626 | 227 format(2x,'psaini: nucleus-nucleus cross sections:'/ | |
6627 | * 4x,'gin=',e10.3) | |
6628 | asect3(ie,iia,iib)=log(gin) | |
6629 | asectn(ie,iia,iib)=asect3(ie,iia,iib) | |
6630 | write(ifmt,*)' maproj,matarg,gin :' | |
6631 | * ,maproj,matarg,gin | |
6632 | ||
6633 | enddo | |
6634 | enddo | |
6635 | enddo | |
6636 | ||
6637 | if(isetcssave.ge.3)then | |
6638 | ||
6639 | do ie=1,7 | |
6640 | engy=1.5*10.**(ie-1) | |
6641 | if(engy.le.egymin)engy=egymin | |
6642 | if(engy.ge.egymax)engy=egymax | |
6643 | write(ifmt,*)' AB xs ',ie,engy | |
6644 | write(ifch,*)' AB xs ',ie,engy | |
6645 | do iia=1,7 | |
6646 | maproj=2**(iia-1) | |
6647 | laproj=max(1,maproj/2) | |
6648 | do iib=1,7 | |
6649 | matarg=2**(iib-1) | |
6650 | latarg=max(1,matarg/2) | |
6651 | ntevt=0 | |
6652 | nrevt=0 | |
6653 | pnll=-1. | |
6654 | elab=-1. | |
6655 | ecms=-1. | |
6656 | ekin=-1. | |
6657 | call conini | |
6658 | call ainit | |
6659 | ||
6660 | do n=1,nevent | |
6661 | ntry=0 | |
6662 | 223 ntevt=ntevt+1 | |
6663 | iret=0 | |
6664 | ntry=ntry+1 | |
6665 | bimevt=-1. | |
6666 | if(ntry.lt.10000)then | |
6667 | call emsaaa(iret) | |
6668 | if(iret.gt.0)goto 223 | |
6669 | else | |
6670 | ntevt=ntry | |
6671 | endif | |
6672 | enddo | |
6673 | a=pi*bmax**2 | |
6674 | if(a.gt.0..and.ntevt.gt.0.)then | |
6675 | xs=float(nevent)/float(ntevt)*a*10. | |
6676 | write(ifmt,*)' maproj,matarg,nevent,ntevt,bmax,xs :' | |
6677 | & ,maproj,matarg,nevent,ntevt,bmax,xs | |
6678 | write(ifch,*)' maproj,matarg,nevent,ntevt,bmax,xs :' | |
6679 | & ,maproj,matarg,nevent,ntevt,bmax,xs | |
6680 | asect4(ie,iia,iib)=log(xs) | |
6681 | else | |
6682 | write(ifmt,*)' Problem ? ',maproj,matarg,bmax,ntevt | |
6683 | asect4(ie,iia,iib)=0. | |
6684 | endif | |
6685 | enddo | |
6686 | enddo | |
6687 | enddo | |
6688 | else | |
6689 | do ie=1,7 | |
6690 | do iia=1,7 | |
6691 | do iib=1,7 | |
6692 | asect4(ie,iia,iib)=0. | |
6693 | enddo | |
6694 | enddo | |
6695 | enddo | |
6696 | endif | |
6697 | ||
6698 | ifrade=ifradesave | |
6699 | idproj=idprojsave | |
6700 | idprojin=idprojinsave | |
6701 | idtarg=idtargsave | |
6702 | idtargin=idtarginsave | |
6703 | laproj=laprojsave | |
6704 | latarg=latargsave | |
6705 | maproj=maprojsave | |
6706 | matarg=matargsave | |
6707 | icltar=icltarsave | |
6708 | iclpro=iclprosave | |
6709 | engy=engysave | |
6710 | pnll=pnllsave | |
6711 | elab=elabsave | |
6712 | ecms=ecmssave | |
6713 | iclegy=iclegysave | |
6714 | nrevt=nrevtsave | |
6715 | nevent=neventsave | |
6716 | ntevt=ntevtsave | |
6717 | isetcs=isetcssave | |
6718 | noebin=noebinsave | |
6719 | isigma=isigmasave | |
6720 | bminim=bminimsave | |
6721 | bmaxim=bmaximsave | |
6722 | bimevt=bimevtsave | |
6723 | fctrmx=fctrmxsave | |
6724 | inicnt=1 | |
6725 | ||
6726 | write(ifmt,'(a)')'write to inics ...' | |
6727 | open(1,file=fncs,status='unknown') | |
6728 | write (1,*)alpqua,alplea,alppom,slopom,gamhad,r2had,chad, | |
6729 | *qcdlam,q2min,q2ini,betpom,glusea,naflav,factk,pt2cut | |
6730 | write(1,*)isetcs,iclpro1,iclpro2,icltar1,icltar2,iclegy1,iclegy2 | |
6731 | *,egylow,egymax,iomega,egyscr,epscrw,epscrp | |
6732 | write (1,*)asect1,asect2,asect3,asect4 | |
6733 | ||
6734 | close(1) | |
6735 | ||
6736 | ||
6737 | goto 6 | |
6738 | ||
6739 | 7 continue | |
6740 | ||
6741 | endif !----------isetcs.ge.2----------- | |
6742 | ||
6743 | call utprix('psaini',ish,ishini,4) | |
6744 | ||
6745 | return | |
6746 | end | |
6747 | ||
6748 | cc----------------------------------------------------------------------- | |
6749 | c function fjetxx(jpp,je1,je2) | |
6750 | cc----------------------------------------------------------------------- | |
6751 | cc almost exactly psjet, just with Eqcd replaced by fparton | |
6752 | cc for testing | |
6753 | cc gives indeed the same result as jetx | |
6754 | cc so the integration seems correct | |
6755 | cc----------------------------------------------------------------------- | |
6756 | c double precision xx1,xx2,s2min,xmin,xmax,xmin1,xmax1,t,tmin | |
6757 | c *,tmax,sh,z,qtmin,ft,fx1,fx2 | |
6758 | c common /ar3/ x1(7),a1(7) | |
6759 | c common /ar9/ x9(3),a9(3) | |
6760 | c include 'epos.inc' | |
6761 | c include 'epos.incsem' | |
6762 | c | |
6763 | c fjetxx=0. | |
6764 | c s=engy*engy | |
6765 | c s2min=4.d0*q2min | |
6766 | c | |
6767 | c zmin=s2min/dble(s) | |
6768 | c zmax=1 | |
6769 | c | |
6770 | c zmin=zmin**(-delh) | |
6771 | c zmax=zmax**(-delh) | |
6772 | c do i=1,3 | |
6773 | c do m=1,2 | |
6774 | c z=dble(.5*(zmax+zmin+(zmin-zmax)*(2*m-3)*x9(i)))**(-1./delh) | |
6775 | c xmin=dsqrt(z) | |
6776 | c sh=z*dble(s) | |
6777 | c qtmin=max(dble(q2min),dble(q2ini)/(1.d0-dsqrt(z))) | |
6778 | c tmin=max(0.d0,1.d0-4.d0*qtmin/sh) | |
6779 | c tmin=2.d0*qtmin/(1.d0+dsqrt(tmin)) | |
6780 | c tmax=sh/2.d0 | |
6781 | c ft=0.d0 | |
6782 | c do i1=1,3 | |
6783 | c do m1=1,2 | |
6784 | c t=2.d0*tmin/(1.d0+tmin/tmax-dble(x9(i1)*(2*m1-3)) | |
6785 | c & *(1.d0-tmin/tmax)) | |
6786 | c qt=t*(1.d0-t/sh) | |
6787 | c xmax=1.d0-q2ini/qt | |
6788 | c xmin=max(dsqrt(z),z/xmax) !xm<xp !!! | |
6789 | c if(xmin.gt.xmax.and.ish.ge.1)write(ifmt,*)'fjetxx:xmin,xmax' | |
6790 | c * ,xmin,xmax | |
6791 | c fx1=0.d0 | |
6792 | c fx2=0.d0 | |
6793 | c if(xmax.gt..8d0)then | |
6794 | c xmin1=max(xmin,.8d0) | |
6795 | c do i2=1,3 | |
6796 | c do m2=1,2 | |
6797 | c xx1=1.d0-(1.d0-xmax)*((1.d0-xmin1)/(1.d0-xmax))** | |
6798 | c * dble(.5+x9(i2)*(m2-1.5)) | |
6799 | c xx2=z/xx1 | |
6800 | c fb=ffsigj(sngl(t),qt,sngl(xx1),sngl(xx2),jpp,je1,je2) | |
6801 | c * +ffsigj(sngl(t),qt,sngl(xx2),sngl(xx1),jpp,je1,je2) | |
6802 | c fx1=fx1+dble(a9(i2)*fb)*(1.d0/xx1-1.d0) | |
6803 | c * *pssalf(qt/qcdlam)**2 | |
6804 | c enddo | |
6805 | c enddo | |
6806 | c fx1=fx1*dlog((1.d0-xmin1)/(1.d0-xmax)) | |
6807 | c endif | |
6808 | c if(xmin.lt..8d0)then | |
6809 | c xmax1=min(xmax,.8d0) | |
6810 | c do i2=1,3 | |
6811 | c do m2=1,2 | |
6812 | c xx1=xmin*(xmax1/xmin)**dble(.5+x9(i2)*(m2-1.5)) | |
6813 | c xx2=z/xx1 | |
6814 | c | |
6815 | c fb=0. | |
6816 | c fb=fb | |
6817 | c * +ffsigj(sngl(t),qt,sngl(xx1),sngl(xx2),jpp,je1,je2) | |
6818 | c * +ffsigj(sngl(t),qt,sngl(xx2),sngl(xx1),jpp,je1,je2) | |
6819 | c fx2=fx2+dble(a9(i2))*fb*pssalf(qt/qcdlam)**2 | |
6820 | c enddo | |
6821 | c enddo | |
6822 | c fx2=fx2*dlog(xmax1/xmin) | |
6823 | c endif | |
6824 | c ft=ft+dble(a9(i1))*(fx1+fx2)*t**2 | |
6825 | c enddo | |
6826 | c enddo | |
6827 | c ft=ft*(1.d0/tmin-1.d0/tmax) | |
6828 | c fjetxx=fjetxx+a9(i)*sngl(ft*z**(1.+delh)/sh**2) | |
6829 | c * /z ! ffsig = xp f xm f sigma | |
6830 | c enddo | |
6831 | c enddo | |
6832 | c fjetxx=fjetxx*(zmin-zmax)/delh*pi**3 | |
6833 | c ! * /2. !??????????????? kkkkkkkkk | |
6834 | c return | |
6835 | c end | |
6836 | c | |
6837 | c |